$CONTROL USLINIT,LIST,PRIVILEGED,MAP,CODE                      <<03727>>00010000
$title "3000 CPU DIAGNOSTIC - ONLINE VERSION "                          00015000
begin  << hp3000 cpu diagnostic - online version >>                     00020000
                                                                        00025000
                                                                        00030000
integer intswreg:=%000000,<<internal switch register>>                  00035000
      sectionselect:=0,<<section select register>>                      00040000
      version:=%1000,                                                   00045000
      sectionno:=2,<<section 2>>                                        00050000
      sbank:=0,                                                         00055000
      stepno:=0;                                                        00060000
integer var0, var1, var2, var3, var4, var5, var6, var7;                 00065000
integer                                                                 00070000
 dbank:=0,                                                              00075000
      dla := %1770,   << @dl >>                                         00080000
      dba := %2000,   << @db >>                                         00085000
      qa := %6500,   << @q >>                                           00090000
      za := %7000,   << @z >>                                           00095000
      pba := %10000,  << @pb >>                                         00100000
      pbank:=0,<<pb bank>>                                              00105000
      cst3:=%1354,<<csts location for segment 3>>                       00110000
      pla:=0,<<@pl>>                                                    00115000
      csta := %1340,  << @ cst table >>                                 00120000
      segno := %301 ,   << code number of this segment >>               00125000
      dsta:=%1500,  <<data segment table address >>                     00130000
      savq,            << save q >>                                     00135000
      savs,            << save s >>                                     00140000
      q=q,                                                              00145000
      q1=q-1,                                                           00150000
      s0=s-0,                                                           00155000
      s1=s-1,                                                           00160000
      s2=s-2,                                                           00165000
      s3=s-3,                                                           00170000
      x=x;                                                              00175000
integer                                                                 00180000
      k0 := %000000,                                                    00185000
      p0 := %000000,                                                    00190000
      p1 := %000001,                                                    00195000
      m1 := %177777,                                                    00200000
      m2 := %177776,                                                    00205000
      m256 := %177400,                                                  00210000
      pmax := %077777,                                                  00215000
      nmax := %100000,                                                  00220000
      even := %125252,                                                  00225000
      odd := %052525,                                                   00230000
      bit0 = nmax,                                                      00235000
      bit1 := %040000,                                                  00240000
      bit5:=%2000,                                                      00245000
      bit6 := %001000,                                                  00250000
      pat402:=%402,                                                     00255000
      pat1777 := %001777,                                               00260000
      pat2500:=%2500,                                                   00265000
      pat20020:=%20020,                                                 00270000
      pat403:=%403,                                                     00275000
      pat177401:=%177401,                                               00280000
      pat177526:=%177526,                                               00285000
      pat177653:=%177653,                                               00290000
      pat377:=%377,                                                     00295000
      pat252:=%252,                                                     00300000
      pat125:=%125,                                                     00305000
      lb1 := %400,                                                      00310000
      lb2 := %1000,                                                     00315000
      lb3 := %1400,                                                     00320000
      endbits1 := %100001,                                              00325000
      pat40002:=%40002,                                                 00330000
      pattern:=0,                                                       00335000
      loopctn:=0;                                                       00340000
                                                                        00345000
                                                                        00350000
integer array ia1(0:4)=db;                                              00355000
integer array ia2(0:4)=db:=-5,0,-3,2,4;                                 00360000
integer i;   << repeat counter >>                                       00365000
byte array ba1(0:9);                                                    00370000
byte array ba2(0:9):="ABCDE01234";                                      00375000
byte array ba3(0:9):="FGHIJ56789";                                      00380000
byte array aaan(0:3):="ABC0";                                           00385000
byte array nnna(0:3):="012A";                                           00390000
byte array llls(0:3):=%141, %171, %172, %173;                           00395000
byte array ss(0:1):="?]";                                               00400000
byte array anans(0:4):="A0B1?";                                         00405000
byte array baa(0:5):="AAAAAB";                                          00410000
byte array ban(0:4):="00001";                                           00415000
byte array ba9(0:9):="ABCD0123?";                                       00420000
byte array ba1'(0:5) =db :="A0?B1]";                                    00425000
byte ba1byte2 = ba1'+1;                                                 00430000
byte ba1byte4 = ba1'+2;                                                 00435000
byte pointer bpt1 := @ba1';                                             00440000
integer array dst1(0:7)=db:=8(%125252);                                 00445000
integer array dst2(0:7)=db:=8(%052525);                                 00450000
integer array dst3(0:%1000):=%1000(0);                                  00455000
integer array dst4(0:%1000):=%1000(%177777);                            00460000
                                                                        00465000
logical no'error:=true;       << instruction error flag >>              00470000
integer location:=0;          << location where print inst'name >>      00475000
integer re'addrs;             << return address from subroutine >>      00480000
integer fnum,errornum;                                                  00485000
byte array outputfile(0:13) := "GUSEL.PUB.SYS ";               <<03727>>00490000
                                                                        00495000
byte array instruct'name(0:5);                                          00500000
byte array ermsg(0:22):="*** INSTRUCTION FAILURE";                      00505000
logical array lmessage(0:14):="CPU INSTRUCTION TEST";                   00510000
byte array bmessage(*)=lmessage;                                        00515000
logical batch, passcnt:=0, exp'trap;                                    00520000
logical array header(0:31):=                                   <<03727>>00525000
  "UPTIME VERIFIER V.UU.FF (C) HEWLETT-PACKARD CO. 1981";      <<04287>>00530000
$include inclvuf                                               <<04287>>00535000
equate vuuff'col   =  8 ,                                      <<04287>>00540000
       header'size = -52;                                      <<04287>>00545000
                                                                        00550000
intrinsic print,ascii,xaritrap,binary;                                  00555000
intrinsic fwrite,printfileinfo,fopen,terminate,fcheck,fclose,date'line, 00560000
          debug;                                                        00565000
define                                                                  00570000
 con10 = con 0,0,0,0,0,0,0,0,0,0#,   << 10 nop's >>                     00575000
                                                                        00580000
haltend=intswreg.(15:1)#,                                               00585000
loopswitch=intswreg.(11:1)#,                                            00590000
selectreg=intswreg.(0:2)#,                                              00595000
haltstep=intswreg.(13:1)#,                                              00600000
loopdefeat=sectionselect.(3:1)#;                                        00605000
                                                                        00610000
   logical parm=q-4;                                                    00615000
   equate                                                               00620000
      loopnumber = %2000,                                               00625000
      ccg = 0,                                                          00630000
      ccl = 1,                                                          00635000
      cce = 2;                                                          00640000
   define pushregs =                                                    00645000
      push( s, q, x, status, z, dl)#;                                   00650000
   define saveregs =                                                    00655000
      pushregs;                                                         00660000
      exp'dl := tos;                                                    00665000
      exp'z := tos;                                                     00670000
      exp'status := tos;                                                00675000
      exp'x := tos;                                                     00680000
      exp'q := tos;                                                     00685000
      exp's := tos#;                                                    00690000
   define                                                               00695000
   readswreg=assemble(rsw); <<pick up switch register>>                 00700000
             if < then intswreg:=tos else del;#,                        00705000
   warmstartend=intswreg.(14:1)#;                                       00710000
   integer exp'dl, exp'z, exp'status, exp'x, exp'q, exp's;              00715000
   byte array data(-4:44) :=                                            00720000
     "!!!!aBcDeFgHiJkLmNoPqRsTuVwXyZ0123456789%#,;!!!!";                00725000
   byte array data2(-4:45) :=                                           00730000
     "!!!!aBcDeFgHiJkLmNoPqRsTuVwXyZz0123456789%#,;!!!!";               00735000
   byte array buf(-4:71);                                               00740000
   array wbuf(0:3);                                                     00745000
   byte array blanks(0:71) := 72(" ");                                  00750000
equate  sysglob       = %1000;                                          00755000
logical syslastbank   = db + %361,                                      00760000
        syslastoffset = db + %362;                                      00765000
                                                                        00770000
equate  testaddru     = %2,                                             00775000
        testaddrl     = %177777,                                        00780000
        testaddrfirst = sysglob + %114,                                 00785000
        testval       = %177777;                                        00790000
define  testaddrlast  = lastoffset#;                                    00795000
   << disc test declarations >>                                         00800000
   equate                                                               00805000
      vtabdst = %35,                                                    00810000
      ldtdst  = %16,                                                    00815000
      lpdtdst = %15,                                                    00820000
      vtabsir = %26;                                                    00825000
   define                                                               00830000
      nrents   =    (0:8)#,                                             00835000
      entsize  =    (8:8)#;                                             00840000
   equate                                                               00845000
      read   = 0,                                                       00850000
      write  = 1;                                                       00855000
   equate  << error messages >>                                         00860000
      no'disc'space  = 1,                                               00865000
      discerr        = 2,                                               00870000
      comparerr      = 3;                                               00875000
   integer nr'sys'discs;                                                00880000
   integer array disc'ldevs(0:255);                                     00885000
   integer array lbuf(0:8191);                                          00890000
                                                                        00895000
   define movefromdseg =                                                00900000
      subroutine mfds( buf, dst, disp, len);                            00905000
         value dst, disp, len;                                          00910000
         array buf;                                                     00915000
         integer dst, disp, len;                                        00920000
      begin                                                             00925000
         x := tos; << save return address >>                            00930000
         assemble( mfds 0 );                                            00935000
         tos := x; << replace return address >>                         00940000
      end #;                                                            00945000
                                                                        00950000
equate filefeed = %40,                                                  00955000
       upper    = %0,                                                   00960000
       lower    = %177777;                                              00965000
logical procedure setsysdb;                                             00970000
    option external;                                                    00975000
procedure resetdb (where);                                              00980000
    value where;                                                        00985000
    integer where;                                                      00990000
    option external;                                                    00995000
                                                                        01000000
integer procedure getsir( sirnum);                                      01005000
   value sirnum;                                                        01010000
   integer sirnum;                                                      01015000
   option external;                                                     01020000
                                                                        01025000
procedure relsir( sirnum, getsir);                                      01030000
   value sirnum, getsir;                                                01035000
   integer sirnum, getsir;                                              01040000
   option external;                                                     01045000
                                                                        01050000
                                                               <<dfs00>>01055000
logical procedure get'disc'info (ldev, disc'label, read'label, <<dfs00>>01060000
                      dtt, type, subtype, disc'size,           <<dfs00>>01065000
                      bit'map'address, bit'map'size'pages,     <<dfs00>>01070000
                      dt'address, dt'size'words,               <<dfs00>>01075000
                      dt'dirty'flag, number'of'buffers,        <<dfs00>>01080000
                      dt'check'sum, sectors'per'track,         <<dfs00>>01085000
                      default'logical'pack'size,               <<dfs00>>01090000
                      max'logical'pack'size,                   <<dfs00>>01095000
                      tracks'per'cylinder,                     <<dfs00>>01100000
                      starting'head'number,                    <<dfs00>>01105000
                      track'multiplier);                       <<dfs00>>01110000
                                                               <<dfs00>>01115000
   value ldev, read'label;                                     <<dfs00>>01120000
   integer ldev;                                               <<dfs00>>01125000
   array disc'label;                                           <<dfs00>>01130000
   logical read'label;                                         <<dfs00>>01135000
   integer array dtt;                                          <<dfs00>>01140000
   integer type;                                               <<dfs00>>01145000
   integer subtype;                                            <<dfs00>>01150000
   double disc'size;                                           <<dfs00>>01155000
   double bit'map'address;                                     <<dfs00>>01160000
   integer bit'map'size'pages;                                 <<dfs00>>01165000
   double dt'address;                                          <<dfs00>>01170000
   integer dt'size'words;                                      <<dfs00>>01175000
   logical dt'dirty'flag;                                      <<dfs00>>01180000
   integer number'of'buffers;                                  <<dfs00>>01185000
   logical dt'check'sum;                                       <<dfs00>>01190000
   integer sectors'per'track;                                  <<dfs00>>01195000
   integer default'logical'pack'size;                          <<dfs00>>01200000
   integer max'logical'pack'size;                              <<dfs00>>01205000
   integer tracks'per'cylinder;                                <<dfs00>>01210000
   integer starting'head'number;                               <<dfs00>>01215000
   integer track'multiplier;                                   <<dfs00>>01220000
   option variable, external;                                  <<dfs00>>01225000
                                                               <<dfs00>>01230000
procedure return'disc'space (ldev, disc'address,               <<dfs00>>01235000
                             number'of'sectors);               <<dfs00>>01240000
   value ldev, disc'address, number'of'sectors;                <<dfs00>>01245000
   integer ldev;                                               <<dfs00>>01250000
   double disc'address, number'of'sectors;                     <<dfs00>>01255000
   option external;                                            <<dfs00>>01260000
                                                               <<dfs00>>01265000
integer procedure get'specific'disc'space (ldev, disc'address, <<dfs00>>01270000
                                           number'of'sectors); <<dfs00>>01275000
   value ldev, disc'address, number'of'sectors;                <<dfs00>>01280000
   integer ldev;                                               <<dfs00>>01285000
   double disc'address, number'of'sectors;                     <<dfs00>>01290000
   option external;                                            <<dfs00>>01295000
                                                               <<dfs00>>01300000
integer procedure get'disc'space (ldev, number'of'sectors,     <<dfs00>>01305000
                                  disc'address);               <<dfs00>>01310000
   value ldev, number'of'sectors;                              <<dfs00>>01315000
   integer ldev;                                               <<dfs00>>01320000
   double number'of'sectors, disc'address;                     <<dfs00>>01325000
   option external;                                            <<dfs00>>01330000
                                                               <<dfs00>>01335000
                                                                        01340000
double procedure attachio( ldev, qmisc, dstx, buf, func,                01345000
       count, p1, p2, flags);                                           01350000
   value ldev, qmisc, dstx, buf, func, count, p1, p2, flags;            01355000
   integer ldev, qmisc, dstx, buf, func, count, p1, p2, flags;          01360000
   option external;                                                     01365000
                                                                        01370000
                                                               <<p8653>>01375000
double procedure p'attachio (ldnum, qmisc, dstx, offset,       <<p8653>>01380000
                 function, count, p1, p2, flags,               <<p8653>>01385000
                 extent'base, extent'length);                  <<p8653>>01390000
   value   ldnum, qmisc, dstx, offset, function, count, p1,    <<p8653>>01395000
           p2, flags, extent'base, extent'length;              <<p8653>>01400000
   integer ldnum, qmisc, dstx, offset, function, count, p1,    <<p8653>>01405000
           p2, flags, extent'length;                           <<p8653>>01410000
   double extent'base;                                         <<p8653>>01415000
   option privileged, uncallable, external, variable;          <<p8653>>01420000
                                                               <<p8653>>01425000
                                                               <<p8653>>01430000
intrinsic debug, dascii;                                                01435000
                                                                        01440000
                                                                        01445000
                                                                        01450000
procedure  cia1;   for x:=0 until 4 do ia1(x):=0;   << clear target >>  01455000
                                                                        01460000
procedure  cba1;  for x:=0 until 9 do ba1(x):=0;  << clear target >>    01465000
                                                                        01470000
       procedure cleardst3;                                             01475000
          begin                                                         01480000
          x:=0;                                                         01485000
          do                                                            01490000
           begin                                                        01495000
                                                                        01500000
           dst3(x):=0;                                                  01505000
           x:=x+1;                                                      01510000
           end                                                          01515000
           until x=%1000;                                               01520000
          end;                                                          01525000
                                                                        01530000
                                                                        01535000
                                                                        01540000
       procedure setdst4(pattern);                                      01545000
           value pattern;                                               01550000
           logical pattern;                                             01555000
                                                                        01560000
           begin                                                        01565000
           x:=0;                                                        01570000
           do                                                           01575000
            begin                                                       01580000
            dst4(x):=pattern;                                           01585000
            x:=x+1;                                                     01590000
            end                                                         01595000
            until x=%1000;                                              01600000
            end;                                                        01605000
                                                                        01610000
                                                                        01615000
       procedure getpriv;  option privileged;                           01620000
       begin                                                            01625000
       integer retstat=q-1;                                             01630000
         retstat.(0:1):=1;<<set status to privilege>>                   01635000
       end;                                                             01640000
                                                                        01645000
                                                                        01650000
                                                                        01655000
                                                                        01660000
                                                                        01665000
                                                                        01670000
                                                                        01675000
                                                                        01680000
                                                                        01685000
                                                                        01690000
$control segment=section1                                               01695000
                                                                        01700000
procedure print'message(msg,msg'length,control);                        01705000
value msg'length,control;                                               01710000
integer msg'length,control;                                             01715000
byte array msg;                                                         01720000
begin                                                                   01725000
  pointer msg'pt;                                                       01730000
  @msg'pt := @msg&lsr(1);                                               01735000
  print(msg'pt,msg'length,control);                                     01740000
  fwrite(fnum,msg'pt,msg'length,control);                               01745000
  if <> then                                                            01750000
    begin                                                               01755000
      printfileinfo(fnum);                                              01760000
      terminate;                                                        01765000
    end;                                                                01770000
end;                                                                    01775000
procedure print'names;                                                  01780000
  begin                                                                 01785000
    i:=0;     << reset repeat counter >>                                01790000
    if not no'error then                                                01795000
      begin                                                             01800000
        print'message(ermsg,0,%202);                                    01805000
        print'message(ermsg,-23,%60);                                   01810000
        no'error := true;                                               01815000
        location := 0;                                                  01820000
      end                                                               01825000
      else                                                              01830000
        if location > 54 then                                           01835000
          begin                                                         01840000
            location := 0;                                              01845000
            print'message(instruct'name,0,0);                           01850000
          end;                                                          01855000
     print'message(instruct'name,-6,%320);                              01860000
     location := location + 6;                                          01865000
  end;                                                                  01870000
integer procedure get'seg'len;                                          01875000
begin                                                                   01880000
   integer stat = q-1;                                                  01885000
                                                                        01890000
   get'seg'len := absolute(absolute(0)+stat.(10:6)*4).(4:12)*4-1;       01895000
end;                                                                    01900000
    procedure blank;                                                    01905000
    begin                                                               01910000
       integer i;                                                       01915000
       for i := -4 until 71 do buf(i) := " ";                           01920000
    end;                                                                01925000
procedure checkregs( s, q, x, status, z, dl);                           01930000
   value s, q, x, status, z, dl;                                        01935000
   integer s, q, x, status, z, dl;                                      01940000
begin                                                                   01945000
   if dl <> exp'dl then no'error:=false;                                01950000
   if z <> exp'z then no'error:=false;                                  01955000
   if status <> exp'status then no'error:=false;                        01960000
   if x <> exp'x then no'error:=false;                                  01965000
   if q <> exp'q then no'error:=false;                                  01970000
   if s <> exp's then no'error:=false;                                  01975000
end;                                                                    01980000
procedure del'test;                                                     01985000
begin                                                                   01990000
   <<  del  >>                                                          01995000
                                                                        02000000
   tos := 1;                                                            02005000
   tos := 2;                                                            02010000
   tos := 3;                                                            02015000
   push( status );                                                      02020000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  02025000
   set( status );                                                       02030000
   saveregs;                                                            02035000
   assemble( del );                                                     02040000
   pushregs;                                                            02045000
   exp's := exp's-1;                                                    02050000
   checkregs(*,*,*,*,*,*);                                              02055000
   if tos <> 2 then no'error:=false;                                    02060000
   if tos <> 1 then no'error:=false;                                    02065000
end;                                                                    02070000
procedure ddel'test;                                                    02075000
begin                                                                   02080000
                                                                        02085000
   <<  ddel  >>                                                         02090000
                                                                        02095000
   tos := 11;                                                           02100000
   tos := 12;                                                           02105000
   tos := 13;                                                           02110000
   tos := 14;                                                           02115000
   push( status );                                                      02120000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  02125000
   set( status );                                                       02130000
   saveregs;                                                            02135000
   assemble( ddel );                                                    02140000
   pushregs;                                                            02145000
   exp's := exp's-2;                                                    02150000
   checkregs(*,*,*,*,*,*);                                              02155000
   if tos <> 12 then no'error:=false;                                   02160000
   if tos <> 11 then no'error:=false;                                   02165000
end;                                                                    02170000
procedure delb'test;                                                    02175000
begin                                                                   02180000
                                                                        02185000
   <<  delb  >>                                                         02190000
                                                                        02195000
   tos := 1;                                                            02200000
   tos := 2;                                                            02205000
   tos := 3;                                                            02210000
   tos := 4;                                                            02215000
   push( status );                                                      02220000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  02225000
   set( status );                                                       02230000
   saveregs;                                                            02235000
   assemble( delb );                                                    02240000
   pushregs;                                                            02245000
   exp's := exp's-1;                                                    02250000
   checkregs(*,*,*,*,*,*);                                              02255000
   if tos <> 4 then no'error:=false;                                    02260000
   if tos <> 2 then no'error:=false;                                    02265000
   if tos <> 1 then no'error:=false;                                    02270000
end;                                                                    02275000
procedure dup'test;                                                     02280000
begin                                                                   02285000
                                                                        02290000
   <<  dup  >>                                                          02295000
                                                                        02300000
   tos := -2;                                                           02305000
   tos := %77777;                                                       02310000
   push( status );                                                      02315000
   tos.(4:4) := %17;                                                    02320000
   set( status );                                                       02325000
   saveregs;                                                            02330000
   assemble( dup );                                                     02335000
   pushregs;                                                            02340000
   exp's := exp's+1;                                                    02345000
   exp'status.(6:2) := ccg;                                             02350000
   checkregs(*,*,*,*,*,*);                                              02355000
   if tos <> %77777 then no'error:=false;                               02360000
   if tos <> %77777 then no'error:=false;                               02365000
   if tos <> -2 then no'error:=false;                                   02370000
                                                                        02375000
   tos := %100000;                                                      02380000
   push( status );                                                      02385000
   tos.(4:4) := %17;                                                    02390000
   set( status );                                                       02395000
   saveregs;                                                            02400000
   assemble( dup );                                                     02405000
   pushregs;                                                            02410000
   exp's := exp's+1;                                                    02415000
   exp'status.(6:2) := ccl;                                             02420000
   checkregs(*,*,*,*,*,*);                                              02425000
   if tos <> %100000 then no'error:=false;                              02430000
   if tos <> %100000 then no'error:=false;                              02435000
                                                                        02440000
   tos := 0;                                                            02445000
   push( status );                                                      02450000
   tos.(4:4) := %17;                                                    02455000
   set( status );                                                       02460000
   saveregs;                                                            02465000
   assemble( dup );                                                     02470000
   pushregs;                                                            02475000
   exp's := exp's+1;                                                    02480000
   exp'status.(6:2) := cce;                                             02485000
   checkregs(*,*,*,*,*,*);                                              02490000
   if tos <> 0 then no'error:=false;                                    02495000
   if tos <> 0 then no'error:=false;                                    02500000
end;                                                                    02505000
procedure ddup'test;                                                    02510000
begin                                                                   02515000
                                                                        02520000
   <<  ddup  >>                                                         02525000
                                                                        02530000
   tos := -1d;                                                          02535000
   tos := %17777777777d;                                                02540000
   push( status );                                                      02545000
   tos.(4:4) := %17;                                                    02550000
   set( status );                                                       02555000
   saveregs;                                                            02560000
   assemble( ddup );                                                    02565000
   pushregs;                                                            02570000
   exp's := exp's+2;                                                    02575000
   exp'status.(6:2) := ccg;                                             02580000
   checkregs(*,*,*,*,*,*);                                              02585000
   if tos <> %17777777777d then no'error:=false;                        02590000
   if tos <> %17777777777d then no'error:=false;                        02595000
   if tos <> -1d then no'error:=false;                                  02600000
                                                                        02605000
   tos := %20000000000d;                                                02610000
   push( status );                                                      02615000
   tos.(4:4) := %17;                                                    02620000
   set( status );                                                       02625000
   saveregs;                                                            02630000
   assemble( ddup );                                                    02635000
   pushregs;                                                            02640000
   exp's := exp's+2;                                                    02645000
   exp'status.(6:2) := ccl;                                             02650000
   checkregs(*,*,*,*,*,*);                                              02655000
   if tos <> %20000000000d then no'error:=false;                        02660000
   if tos <> %20000000000d then no'error:=false;                        02665000
                                                                        02670000
   tos := 0d;                                                           02675000
   push( status );                                                      02680000
   tos.(4:4) := %17;                                                    02685000
   set( status );                                                       02690000
   saveregs;                                                            02695000
   assemble( ddup );                                                    02700000
   pushregs;                                                            02705000
   exp's := exp's+2;                                                    02710000
   exp'status.(6:2) := cce;                                             02715000
   checkregs(*,*,*,*,*,*);                                              02720000
   if tos <> 0d then no'error:=false;                                   02725000
   if tos <> 0d then no'error:=false;                                   02730000
end;                                                                    02735000
procedure zero'test;                                                    02740000
begin                                                                   02745000
                                                                        02750000
   <<  zero  >>                                                         02755000
                                                                        02760000
   tos := %377;                                                         02765000
   push( status );                                                      02770000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  02775000
   set( status );                                                       02780000
   saveregs;                                                            02785000
   assemble( zero );                                                    02790000
   pushregs;                                                            02795000
   exp's := exp's+1;                                                    02800000
   checkregs(*,*,*,*,*,*);                                              02805000
   if tos <> 0 then no'error:=false;                                    02810000
   if tos <> %377 then no'error:=false;                                 02815000
end;                                                                    02820000
procedure dzro'test;                                                    02825000
begin                                                                   02830000
                                                                        02835000
   <<  dzro  >>                                                         02840000
                                                                        02845000
   tos := %100;                                                         02850000
   push( status );                                                      02855000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  02860000
   set( status );                                                       02865000
   saveregs;                                                            02870000
   assemble( dzro );                                                    02875000
   pushregs;                                                            02880000
   exp's := exp's+2;                                                    02885000
   checkregs(*,*,*,*,*,*);                                              02890000
   if tos <> 0d then no'error:=false;                                   02895000
   if tos <> %100 then no'error:=false;                                 02900000
end;                                                                    02905000
procedure zrob'test;                                                    02910000
begin                                                                   02915000
                                                                        02920000
   <<  zrob  >>                                                         02925000
                                                                        02930000
   tos := %201;                                                         02935000
   tos := %202;                                                         02940000
   tos := %203;                                                         02945000
   push( status );                                                      02950000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  02955000
   set( status );                                                       02960000
   saveregs;                                                            02965000
   assemble( zrob );                                                    02970000
   pushregs;                                                            02975000
   checkregs(*,*,*,*,*,*);                                              02980000
   if tos <> %203 then no'error:=false;                                 02985000
   if tos <> 0 then no'error:=false;                                    02990000
   if tos <> %201 then no'error:=false;                                 02995000
end;                                                                    03000000
procedure or'test;                                                      03005000
begin                                                                   03010000
                                                                        03015000
   <<  or  >>                                                           03020000
                                                                        03025000
   tos := 0d;                                                           03030000
   tos := %125252;                                                      03035000
   tos := %52525;                                                       03040000
   push( status );                                                      03045000
   tos.(4:4) := %17;                                                    03050000
   set( status );                                                       03055000
   saveregs;                                                            03060000
   assemble( or );                                                      03065000
   pushregs;                                                            03070000
   exp'status.(6:2) := ccl;                                             03075000
   exp's := exp's-1;                                                    03080000
   checkregs(*,*,*,*,*,*);                                              03085000
   if tos <> %177777 then no'error:=false;                              03090000
   if tos <> 0d then no'error:=false;                                   03095000
                                                                        03100000
   tos := %377;                                                         03105000
   tos := %77400;                                                       03110000
   push( status );                                                      03115000
   tos.(4:4) := %17;                                                    03120000
   set( status );                                                       03125000
   saveregs;                                                            03130000
   assemble( or );                                                      03135000
   pushregs;                                                            03140000
   exp'status.(6:2) := ccg;                                             03145000
   exp's := exp's-1;                                                    03150000
   checkregs(*,*,*,*,*,*);                                              03155000
   if tos <> %77777 then no'error:=false;                               03160000
                                                                        03165000
   tos := 0;                                                            03170000
   tos := 0;                                                            03175000
   push( status );                                                      03180000
   tos.(4:4) := %17;                                                    03185000
   set( status );                                                       03190000
   saveregs;                                                            03195000
   assemble( or );                                                      03200000
   pushregs;                                                            03205000
   exp'status.(6:2) := cce;                                             03210000
   exp's := exp's-1;                                                    03215000
   checkregs(*,*,*,*,*,*);                                              03220000
   if tos <> 0 then no'error:=false;                                    03225000
end;                                                                    03230000
procedure xor'test;                                                     03235000
begin                                                                   03240000
                                                                        03245000
   <<  xor  >>                                                          03250000
                                                                        03255000
   tos := %7;                                                           03260000
   tos := %125252;                                                      03265000
   tos := -1;                                                           03270000
   push( status );                                                      03275000
   tos.(4:4) := %17;                                                    03280000
   set( status );                                                       03285000
   saveregs;                                                            03290000
   assemble( xor );                                                     03295000
   pushregs;                                                            03300000
   exp'status.(6:2) := ccg;                                             03305000
   exp's := exp's-1;                                                    03310000
   checkregs(*,*,*,*,*,*);                                              03315000
   if tos <> %52525 then no'error:=false;                               03320000
   if tos <> 7 then no'error:=false;                                    03325000
                                                                        03330000
   tos := -1;                                                           03335000
   tos := %52525;                                                       03340000
   push( status );                                                      03345000
   tos.(4:4) := %17;                                                    03350000
   set( status );                                                       03355000
   saveregs;                                                            03360000
   assemble( xor );                                                     03365000
   pushregs;                                                            03370000
   exp'status.(6:2) := ccl;                                             03375000
   exp's := exp's-1;                                                    03380000
   checkregs(*,*,*,*,*,*);                                              03385000
   if tos <> %125252 then no'error:=false;                              03390000
                                                                        03395000
   tos := %125252;                                                      03400000
   tos := %125252;                                                      03405000
   push( status );                                                      03410000
   tos.(4:4) := %17;                                                    03415000
   set( status );                                                       03420000
   saveregs;                                                            03425000
   assemble( xor );                                                     03430000
   pushregs;                                                            03435000
   exp'status.(6:2) := cce;                                             03440000
   exp's := exp's-1;                                                    03445000
   checkregs(*,*,*,*,*,*);                                              03450000
   if tos <> 0 then no'error:=false;                                    03455000
                                                                        03460000
   tos := %125252;                                                      03465000
   tos := %52525;                                                       03470000
   push( status );                                                      03475000
   tos.(4:4) := %17;                                                    03480000
   set( status );                                                       03485000
   saveregs;                                                            03490000
   assemble( xor );                                                     03495000
   pushregs;                                                            03500000
   exp'status.(6:2) := ccl;                                             03505000
   exp's := exp's-1;                                                    03510000
   checkregs(*,*,*,*,*,*);                                              03515000
   if tos <> -1 then no'error:=false;                                   03520000
end;                                                                    03525000
procedure and'test;                                                     03530000
begin                                                                   03535000
                                                                        03540000
   <<  and  >>                                                          03545000
                                                                        03550000
   tos := -2;                                                           03555000
   tos := %66666;                                                       03560000
   tos := %133333;                                                      03565000
   push( status );                                                      03570000
   tos.(4:4) := %17;                                                    03575000
   set( status );                                                       03580000
   saveregs;                                                            03585000
   assemble( and );                                                     03590000
   pushregs;                                                            03595000
   exp'status.(6:2) := ccg;                                             03600000
   exp's := exp's-1;                                                    03605000
   checkregs(*,*,*,*,*,*);                                              03610000
   if tos <> %22222 then no'error:=false;                               03615000
   if tos <> -2 then no'error:=false;                                   03620000
                                                                        03625000
   tos := %133333;                                                      03630000
   tos := %125252;                                                      03635000
   push( status );                                                      03640000
   tos.(4:4) := %17;                                                    03645000
   set( status );                                                       03650000
   saveregs;                                                            03655000
   assemble( and );                                                     03660000
   pushregs;                                                            03665000
   exp'status.(6:2) := ccl;                                             03670000
   exp's := exp's-1;                                                    03675000
   checkregs(*,*,*,*,*,*);                                              03680000
   if tos <> %121212 then no'error:=false;                              03685000
                                                                        03690000
   tos := %133333;                                                      03695000
   tos := %44444;                                                       03700000
   push( status );                                                      03705000
   tos.(4:4) := 3;                                                      03710000
   set( status );                                                       03715000
   saveregs;                                                            03720000
   assemble( and );                                                     03725000
   pushregs;                                                            03730000
   exp'status.(6:2) := cce;                                             03735000
   exp's := exp's-1;                                                    03740000
   checkregs(*,*,*,*,*,*);                                              03745000
   if tos <> 0 then no'error:=false;                                    03750000
end;                                                                    03755000
procedure inca'test;                                                    03760000
begin                                                                   03765000
                                                                        03770000
   <<  inca  >>                                                         03775000
                                                                        03780000
   tos := 6;                                                            03785000
   tos := 5;                                                            03790000
   tos := 0;                                                            03795000
   push( status );                                                      03800000
   tos.(4:4) := %17;                                                    03805000
   set( status );                                                       03810000
   saveregs;                                                            03815000
   assemble( inca );                                                    03820000
   pushregs;                                                            03825000
   exp'status.(4:4) := 0;  << ccg, no carry, no ovfl >>                 03830000
   checkregs(*,*,*,*,*,*);                                              03835000
   if tos <> 1 then no'error:=false;                                    03840000
   if tos <> 5 then no'error:=false;                                    03845000
   if tos <> 6 then no'error:=false;                                    03850000
                                                                        03855000
   tos := %77777;                                                       03860000
   push( status );                                                      03865000
   tos.(4:4) := 0;                                                      03870000
   set( status );                                                       03875000
   saveregs;                                                            03880000
   assemble( inca );                                                    03885000
   pushregs;                                                            03890000
   exp'status.(4:4) := %11; << ovfl, ccl >>                             03895000
   checkregs(*,*,*,*,*,*);                                              03900000
   if tos <> %100000 then no'error:=false;                              03905000
                                                                        03910000
   tos := %177777;                                                      03915000
   push( status );                                                      03920000
   tos.(4:4) := 0;                                                      03925000
   set( status );                                                       03930000
   saveregs;                                                            03935000
   assemble( inca );                                                    03940000
   pushregs;                                                            03945000
   exp'status.(4:4) := %6;  << carry, cce >>                            03950000
   checkregs(*,*,*,*,*,*);                                              03955000
   if tos <> 0 then no'error:=false;                                    03960000
end;                                                                    03965000
procedure deca'test;                                                    03970000
begin                                                                   03975000
                                                                        03980000
   <<  deca  >>                                                         03985000
                                                                        03990000
   tos := -%100;                                                        03995000
   tos := -%200;                                                        04000000
   tos := 2;                                                            04005000
   push( status );                                                      04010000
   tos.(4:4) := %13;                                                    04015000
   set( status );                                                       04020000
   saveregs;                                                            04025000
   assemble( deca );                                                    04030000
   pushregs;                                                            04035000
   exp'status.(4:4) := 4;                                               04040000
   checkregs(*,*,*,*,*,*);                                              04045000
   if tos <> 1 then no'error:=false;                                    04050000
   if tos <> -%200 then no'error:=false;                                04055000
   if tos <> -%100 then no'error:=false;                                04060000
                                                                        04065000
   tos := 0;                                                            04070000
   push( status );                                                      04075000
   tos.(4:4) := %17;                                                    04080000
   set( status );                                                       04085000
   saveregs;                                                            04090000
   assemble( deca );                                                    04095000
   pushregs;                                                            04100000
   exp'status.(4:4) := 1;                                               04105000
   checkregs(*,*,*,*,*,*);                                              04110000
   if tos <> %177777 then no'error:=false;                              04115000
                                                                        04120000
   tos := %100000;                                                      04125000
   push( status );                                                      04130000
   tos.(4:4) := 3;                                                      04135000
   set( status );                                                       04140000
   saveregs;                                                            04145000
   assemble( deca );                                                    04150000
   pushregs;                                                            04155000
   exp'status.(4:4) := %14;                                             04160000
   checkregs(*,*,*,*,*,*);                                              04165000
   if tos <> %77777 then no'error:=false;                               04170000
                                                                        04175000
   tos := %1;                                                           04180000
   push( status );                                                      04185000
   tos.(4:4) := %13;                                                    04190000
   set( status );                                                       04195000
   saveregs;                                                            04200000
   assemble( deca );                                                    04205000
   pushregs;                                                            04210000
   exp'status.(4:4) := 6;                                               04215000
   checkregs(*,*,*,*,*,*);                                              04220000
   if tos <> 0 then no'error:=false;                                    04225000
end;                                                                    04230000
procedure incb'test;                                                    04235000
begin                                                                   04240000
                                                                        04245000
   <<  incb  >>                                                         04250000
                                                                        04255000
   tos := -%300;                                                        04260000
   tos := 0;                                                            04265000
   tos := -%200;                                                        04270000
   push( status );                                                      04275000
   tos.(4:4) := %17;                                                    04280000
   set( status );                                                       04285000
   saveregs;                                                            04290000
   assemble( incb );                                                    04295000
   pushregs;                                                            04300000
   exp'status.(4:4) := 0;  << ccg, no carry, no ovfl >>                 04305000
   checkregs(*,*,*,*,*,*);                                              04310000
   if tos <> -%200 then no'error:=false;                                04315000
   if tos <> 1 then no'error:=false;                                    04320000
   if tos <> -%300 then no'error:=false;                                04325000
                                                                        04330000
   tos := %77777;                                                       04335000
   tos := 0;                                                            04340000
   push( status );                                                      04345000
   tos.(4:4) := 0;                                                      04350000
   set( status );                                                       04355000
   saveregs;                                                            04360000
   assemble( incb );                                                    04365000
   pushregs;                                                            04370000
   exp'status.(4:4) := %11; << ovfl, ccl >>                             04375000
   checkregs(*,*,*,*,*,*);                                              04380000
   if tos <> 0 then no'error:=false;                                    04385000
   if tos <> %100000 then no'error:=false;                              04390000
                                                                        04395000
   tos := %177777;                                                      04400000
   tos := %100000;                                                      04405000
   push( status );                                                      04410000
   tos.(4:4) := 0;                                                      04415000
   set( status );                                                       04420000
   saveregs;                                                            04425000
   assemble( incb );                                                    04430000
   pushregs;                                                            04435000
   exp'status.(4:4) := %6;  << carry, cce >>                            04440000
   checkregs(*,*,*,*,*,*);                                              04445000
   if tos <> %100000 then no'error:=false;                              04450000
   if tos <> 0 then no'error:=false;                                    04455000
end;                                                                    04460000
procedure add'test;                                                     04465000
begin                                                                   04470000
                                                                        04475000
   <<  add  >>                                                          04480000
                                                                        04485000
   tos := 1;                                                            04490000
   tos := %40000;                                                       04495000
   tos := %37777;                                                       04500000
   push( status );                                                      04505000
   tos.(4:4) := %17;                                                    04510000
   set( status );                                                       04515000
   saveregs;                                                            04520000
   assemble( add );                                                     04525000
   pushregs;                                                            04530000
   exp'status.(4:4) := 0;                                               04535000
   exp's := exp's-1;                                                    04540000
   checkregs(*,*,*,*,*,*);                                              04545000
   if tos <> %77777 then no'error:=false;                               04550000
   if tos <> 1 then no'error:=false;                                    04555000
                                                                        04560000
   tos := %100000;                                                      04565000
   tos := 0;                                                            04570000
   push( status );                                                      04575000
   tos.(4:4) := %17;                                                    04580000
   set( status );                                                       04585000
   saveregs;                                                            04590000
   assemble( add );                                                     04595000
   pushregs;                                                            04600000
   exp'status.(4:4) := 1;                                               04605000
   exp's := exp's-1;                                                    04610000
   checkregs(*,*,*,*,*,*);                                              04615000
   if tos <> %100000 then no'error:=false;                              04620000
                                                                        04625000
   tos := %40000;                                                       04630000
   tos := %40000;                                                       04635000
   push( status );                                                      04640000
   tos.(4:4) := %7;                                                     04645000
   set( status );                                                       04650000
   saveregs;                                                            04655000
   assemble( add );                                                     04660000
   pushregs;                                                            04665000
   exp'status.(4:4) := %11;                                             04670000
   exp's := exp's-1;                                                    04675000
   checkregs(*,*,*,*,*,*);                                              04680000
   if tos <> %100000 then no'error:=false;                              04685000
                                                                        04690000
   tos := %100000;                                                      04695000
   tos := %100000;                                                      04700000
   push( status );                                                      04705000
   tos.(4:4) := %3;                                                     04710000
   set( status );                                                       04715000
   saveregs;                                                            04720000
   assemble( add );                                                     04725000
   pushregs;                                                            04730000
   exp'status.(4:4) := %16;                                             04735000
   exp's := exp's-1;                                                    04740000
   checkregs(*,*,*,*,*,*);                                              04745000
   if tos <> 0 then no'error:=false;                                    04750000
                                                                        04755000
   tos := -1;                                                           04760000
   tos := -2;                                                           04765000
   push( status );                                                      04770000
   tos.(4:4) := %13;                                                    04775000
   set( status );                                                       04780000
   saveregs;                                                            04785000
   assemble( add );                                                     04790000
   pushregs;                                                            04795000
   exp'status.(4:4) := %5;                                              04800000
   exp's := exp's-1;                                                    04805000
   checkregs(*,*,*,*,*,*);                                              04810000
   if tos <> -3 then no'error:=false;                                   04815000
                                                                        04820000
   tos := -1;                                                           04825000
   tos := %100000;                                                      04830000
   push( status );                                                      04835000
   tos.(4:4) := %3;                                                     04840000
   set( status );                                                       04845000
   saveregs;                                                            04850000
   assemble( add );                                                     04855000
   pushregs;                                                            04860000
   exp'status.(4:4) := %14;                                             04865000
   exp's := exp's-1;                                                    04870000
   checkregs(*,*,*,*,*,*);                                              04875000
   if tos <> %77777 then no'error:=false;                               04880000
                                                                        04885000
   tos := -1;                                                           04890000
   tos := 1;                                                            04895000
   push( status );                                                      04900000
   tos.(4:4) := %13;                                                    04905000
   set( status );                                                       04910000
   saveregs;                                                            04915000
   assemble( add );                                                     04920000
   pushregs;                                                            04925000
   exp'status.(4:4) := 6;                                               04930000
   exp's := exp's-1;                                                    04935000
   checkregs(*,*,*,*,*,*);                                              04940000
   if tos <> 0 then no'error:=false;                                    04945000
                                                                        04950000
end;                                                                    04955000
procedure stax'test;                                                    04960000
begin                                                                   04965000
                                                                        04970000
   << ******** check stack op's dealing with x register ********** >>   04975000
   <<  stax  >>                                                         04980000
                                                                        04985000
   tos := %125252;                                                      04990000
   push( status );                                                      04995000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  05000000
   set( status );                                                       05005000
   saveregs;                                                            05010000
   assemble( stax );                                                    05015000
   pushregs;                                                            05020000
   exp's := exp's-1;                                                    05025000
   exp'status.(6:2) := ccl;                                             05030000
   exp'x := %125252;                                                    05035000
   checkregs(*,*,*,*,*,*);                                              05040000
                                                                        05045000
   tos := %52525;                                                       05050000
   push( status );                                                      05055000
   tos.(4:4) := %17;                                                    05060000
   set( status );                                                       05065000
   saveregs;                                                            05070000
   assemble( stax );                                                    05075000
   pushregs;                                                            05080000
   exp'status.(6:2) := ccg;                                             05085000
   exp's := exp's-1;                                                    05090000
   exp'x := %52525;                                                     05095000
   checkregs(*,*,*,*,*,*);                                              05100000
                                                                        05105000
   tos := 0;                                                            05110000
   push( status );                                                      05115000
   tos.(4:4) := %17;                                                    05120000
   set( status );                                                       05125000
   saveregs;                                                            05130000
   assemble( stax );                                                    05135000
   pushregs;                                                            05140000
   exp'status.(6:2) := cce;                                             05145000
   exp's := exp's-1;                                                    05150000
   exp'x := 0;                                                          05155000
   checkregs(*,*,*,*,*,*);                                              05160000
                                                                        05165000
end;                                                                    05170000
procedure ldxa'test;                                                    05175000
begin                                                                   05180000
   <<  ldxa  >>                                                         05185000
                                                                        05190000
   x := %100000;                                                        05195000
   push( status );                                                      05200000
   tos.(4:4) := %17;                                                    05205000
   set( status );                                                       05210000
   saveregs;                                                            05215000
   assemble( ldxa );                                                    05220000
   pushregs;                                                            05225000
   exp'status.(6:2) := ccl;                                             05230000
   exp's := exp's+1;                                                    05235000
   checkregs(*,*,*,*,*,*);                                              05240000
   if tos <> %100000 then no'error:=false;                              05245000
                                                                        05250000
   x := %77777;                                                         05255000
   push( status );                                                      05260000
   tos.(4:4) := 17;                                                     05265000
   set( status );                                                       05270000
   saveregs;                                                            05275000
   assemble( ldxa );                                                    05280000
   pushregs;                                                            05285000
   exp'status.(6:2) := ccg;                                             05290000
   exp's := exp's+1;                                                    05295000
   checkregs(*,*,*,*,*,*);                                              05300000
   if tos <> %77777 then no'error:=false;                               05305000
                                                                        05310000
   x := 0;                                                              05315000
   push( status );                                                      05320000
   tos.(4:4) := %17;                                                    05325000
   set( status );                                                       05330000
   saveregs;                                                            05335000
   assemble( ldxa );                                                    05340000
   pushregs;                                                            05345000
   exp'status.(6:2) := cce;                                             05350000
   exp's := exp's+1;                                                    05355000
   checkregs(*,*,*,*,*,*);                                              05360000
   if tos <> 0 then no'error:=false;                                    05365000
end;                                                                    05370000
procedure zrox'test;                                                    05375000
begin                                                                   05380000
                                                                        05385000
   <<  zrox  >>                                                         05390000
                                                                        05395000
   x := -1;                                                             05400000
   if x <> -1 then no'error:=false;                                     05405000
   push( status );                                                      05410000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  05415000
   set( status );                                                       05420000
   saveregs;                                                            05425000
   assemble( zrox );                                                    05430000
   pushregs;                                                            05435000
   exp'x := 0;                                                          05440000
   checkregs(*,*,*,*,*,*);                                              05445000
end;                                                                    05450000
procedure stbx'test;                                                    05455000
begin                                                                   05460000
                                                                        05465000
   <<  stbx  >>                                                         05470000
                                                                        05475000
   tos := 1;                                                            05480000
   tos := 2;                                                            05485000
   tos := 3;                                                            05490000
   push( status );                                                      05495000
   tos.(4:4) := %17;                                                    05500000
   set( status );                                                       05505000
   saveregs;                                                            05510000
   assemble( stbx );                                                    05515000
   pushregs;                                                            05520000
   exp'status.(6:2) := ccg;                                             05525000
   exp'x := 2;                                                          05530000
   checkregs(*,*,*,*,*,*);                                              05535000
   if tos <> 3 then no'error:=false;                                    05540000
   if tos <> 2 then no'error:=false;                                    05545000
   if tos <> 1 then no'error:=false;                                    05550000
                                                                        05555000
   tos := %100000;                                                      05560000
   tos := 5;                                                            05565000
   push( status );                                                      05570000
   tos.(4:4) := %17;                                                    05575000
   set( status );                                                       05580000
   saveregs;                                                            05585000
   assemble( stbx );                                                    05590000
   pushregs;                                                            05595000
   exp'status.(6:2) := ccl;                                             05600000
   exp'x := %100000;                                                    05605000
   checkregs(*,*,*,*,*,*);                                              05610000
   if tos <> 5 then no'error:=false;                                    05615000
   if tos <> %100000 then no'error:=false;                              05620000
                                                                        05625000
   tos := 0;                                                            05630000
   tos := -1;                                                           05635000
   push( status );                                                      05640000
   tos.(4:4) := %17;                                                    05645000
   set( status );                                                       05650000
   saveregs;                                                            05655000
   assemble( stbx );                                                    05660000
   pushregs;                                                            05665000
   exp'status.(6:2) := cce;                                             05670000
   exp'x := 0;                                                          05675000
   checkregs(*,*,*,*,*,*);                                              05680000
   if tos <> -1 then no'error:=false;                                   05685000
   if tos <> 0 then no'error:=false;                                    05690000
end;                                                                    05695000
procedure ldxb'test;                                                    05700000
begin                                                                   05705000
                                                                        05710000
   <<  ldxb  >>                                                         05715000
                                                                        05720000
   tos := %101;                                                         05725000
   tos := %102;                                                         05730000
   tos := %103;                                                         05735000
   x := %377;                                                           05740000
   push( status );                                                      05745000
   tos.(4:4) := %17;                                                    05750000
   set( status );                                                       05755000
   saveregs;                                                            05760000
   assemble( ldxb );                                                    05765000
   pushregs;                                                            05770000
   exp'status.(6:2) := ccg;                                             05775000
   checkregs(*,*,*,*,*,*);                                              05780000
   if tos <> %103 then no'error:=false;                                 05785000
   if tos <> %377 then no'error:=false;                                 05790000
   if tos <> %101 then no'error:=false;                                 05795000
                                                                        05800000
   tos := %17;                                                          05805000
   tos := -1;                                                           05810000
   x := -%377;                                                          05815000
   push( status );                                                      05820000
   tos.(4:4) := %17;                                                    05825000
   set( status );                                                       05830000
   saveregs;                                                            05835000
   assemble( ldxb );                                                    05840000
   pushregs;                                                            05845000
   exp'status.(6:2) := ccl;                                             05850000
   checkregs(*,*,*,*,*,*);                                              05855000
   if tos <> -1 then no'error:=false;                                   05860000
   if tos <> -%377 then no'error:=false;                                05865000
                                                                        05870000
   tos :=-1;                                                            05875000
   tos := 9;                                                            05880000
   x := 0;                                                              05885000
   push( status );                                                      05890000
   tos.(4:4) := %17;                                                    05895000
   set( status );                                                       05900000
   saveregs;                                                            05905000
   assemble( ldxb );                                                    05910000
   pushregs;                                                            05915000
   exp'status.(6:2) := cce;                                             05920000
   checkregs(*,*,*,*,*,*);                                              05925000
   if tos <> 9 then no'error:=false;                                    05930000
   if tos <> 0 then no'error:=false;                                    05935000
end;                                                                    05940000
procedure xax'test;                                                     05945000
begin                                                                   05950000
                                                                        05955000
   <<  xax  >>                                                          05960000
                                                                        05965000
   tos := 0;                                                            05970000
   tos := %40;                                                          05975000
   x := %100000;                                                        05980000
   push( status );                                                      05985000
   tos.(4:4) := %17;                                                    05990000
   set( status );                                                       05995000
   saveregs;                                                            06000000
   assemble( xax );                                                     06005000
   pushregs;                                                            06010000
   exp'status.(6:2) := ccl;                                             06015000
   exp'x := %40;                                                        06020000
   checkregs(*,*,*,*,*,*);                                              06025000
   if tos <> %100000 then no'error:=false;                              06030000
   if tos <> 0 then no'error:=false;                                    06035000
                                                                        06040000
   tos := -1;                                                           06045000
   x := 0;                                                              06050000
   push( status );                                                      06055000
   tos.(4:4) := %17;                                                    06060000
   set( status );                                                       06065000
   saveregs;                                                            06070000
   assemble( xax );                                                     06075000
   pushregs;                                                            06080000
   exp'status.(6:2) := cce;                                             06085000
   exp'x := -1;                                                         06090000
   checkregs(*,*,*,*,*,*);                                              06095000
   if tos <> 0 then no'error:=false;                                    06100000
                                                                        06105000
   tos := 0;                                                            06110000
   x := %377;                                                           06115000
   push( status );                                                      06120000
   tos.(4:4) := %17;                                                    06125000
   set( status );                                                       06130000
   saveregs;                                                            06135000
   assemble( xax );                                                     06140000
   pushregs;                                                            06145000
   exp'status.(6:2) := ccg;                                             06150000
   exp'x := 0;                                                          06155000
   checkregs(*,*,*,*,*,*);                                              06160000
end;                                                                    06165000
procedure xbx'test;                                                     06170000
begin                                                                   06175000
                                                                        06180000
   <<  xbx  >>                                                          06185000
                                                                        06190000
   x := -10;                                                            06195000
   if x <> -10 then no'error:=false;                                    06200000
   tos := %301;                                                         06205000
   tos := %302;                                                         06210000
   tos := %303;                                                         06215000
   push( status );                                                      06220000
   tos.(4:4) := %17;  << set, carry, overflow, cc=3 >>                  06225000
   set( status );                                                       06230000
   saveregs;                                                            06235000
   assemble( xbx );                                                     06240000
   pushregs;                                                            06245000
   exp'x := %302;                                                       06250000
   checkregs(*,*,*,*,*,*);                                              06255000
   if tos <> %303 then no'error:=false;                                 06260000
   if tos <> -10 then no'error:=false;                                  06265000
   if tos <> %301 then no'error:=false;                                 06270000
end;                                                                    06275000
procedure incx'test;                                                    06280000
begin                                                                   06285000
                                                                        06290000
   <<  incx  >>                                                         06295000
                                                                        06300000
   x := 0;                                                              06305000
   push( status );                                                      06310000
   tos.(4:4) := %17;                                                    06315000
   set( status );                                                       06320000
   saveregs;                                                            06325000
   assemble( incx );                                                    06330000
   pushregs;                                                            06335000
   exp'status.(4:4) := 0;  << ccg, no carry, no ovfl >>                 06340000
   exp'x := 1;                                                          06345000
   checkregs(*,*,*,*,*,*);                                              06350000
                                                                        06355000
   x := %77777;                                                         06360000
   push( status );                                                      06365000
   tos.(4:4) := 0;                                                      06370000
   set( status );                                                       06375000
   saveregs;                                                            06380000
   assemble( incx );                                                    06385000
   pushregs;                                                            06390000
   exp'status.(4:4) := %11; << ovfl, ccl >>                             06395000
   exp'x := %100000;                                                    06400000
   checkregs(*,*,*,*,*,*);                                              06405000
                                                                        06410000
   x := %177777;                                                        06415000
   push( status );                                                      06420000
   tos.(4:4) := 0;                                                      06425000
   set( status );                                                       06430000
   saveregs;                                                            06435000
   assemble( incx );                                                    06440000
   pushregs;                                                            06445000
   exp'status.(4:4) := %6;  << carry, cce >>                            06450000
   exp'x := 0;                                                          06455000
   checkregs(*,*,*,*,*,*);                                              06460000
end;                                                                    06465000
procedure decx'test;                                                    06470000
begin                                                                   06475000
                                                                        06480000
   <<  decx  >>                                                         06485000
                                                                        06490000
   x := 2;                                                              06495000
   push( status );                                                      06500000
   tos.(4:4) := %13;                                                    06505000
   set( status );                                                       06510000
   saveregs;                                                            06515000
   assemble( decx );                                                    06520000
   pushregs;                                                            06525000
   exp'status.(4:4) := 4;                                               06530000
   exp'x := 1;                                                          06535000
   checkregs(*,*,*,*,*,*);                                              06540000
                                                                        06545000
   x := 0;                                                              06550000
   push( status );                                                      06555000
   tos.(4:4) := %17;                                                    06560000
   set( status );                                                       06565000
   saveregs;                                                            06570000
   assemble( decx );                                                    06575000
   pushregs;                                                            06580000
   exp'status.(4:4) := 1;                                               06585000
   exp'x := %177777;                                                    06590000
   checkregs(*,*,*,*,*,*);                                              06595000
                                                                        06600000
   x := %100000;                                                        06605000
   push( status );                                                      06610000
   tos.(4:4) := 3;                                                      06615000
   set( status );                                                       06620000
   saveregs;                                                            06625000
   assemble( decx );                                                    06630000
   pushregs;                                                            06635000
   exp'x := %77777;                                                     06640000
   exp'status.(4:4) := %14;                                             06645000
   checkregs(*,*,*,*,*,*);                                              06650000
                                                                        06655000
   x := %1;                                                             06660000
   push( status );                                                      06665000
   tos.(4:4) := %13;                                                    06670000
   set( status );                                                       06675000
   saveregs;                                                            06680000
   assemble( decx );                                                    06685000
   pushregs;                                                            06690000
   exp'x := %0;                                                         06695000
   exp'status.(4:4) := 6;                                               06700000
   checkregs(*,*,*,*,*,*);                                              06705000
end;                                                                    06710000
procedure adax'test;                                                    06715000
begin                                                                   06720000
                                                                        06725000
   <<  adax  >>                                                         06730000
                                                                        06735000
   tos := 1;                                                            06740000
   tos := %40000;                                                       06745000
   x := %37777;                                                         06750000
   push( status );                                                      06755000
   tos.(4:4) := %17;                                                    06760000
   set( status );                                                       06765000
   saveregs;                                                            06770000
   assemble( adax );                                                    06775000
   pushregs;                                                            06780000
   exp'status.(4:4) := 0;                                               06785000
   exp'x := %77777;                                                     06790000
   exp's := exp's-1;                                                    06795000
   checkregs(*,*,*,*,*,*);                                              06800000
   if tos <> 1 then no'error:=false;                                    06805000
                                                                        06810000
   tos := %100000;                                                      06815000
   x := 0;                                                              06820000
   push( status );                                                      06825000
   tos.(4:4) := %17;                                                    06830000
   set( status );                                                       06835000
   saveregs;                                                            06840000
   assemble( adax );                                                    06845000
   pushregs;                                                            06850000
   exp'status.(4:4) := 1;                                               06855000
   exp'x := %100000;                                                    06860000
   exp's := exp's-1;                                                    06865000
   checkregs(*,*,*,*,*,*);                                              06870000
                                                                        06875000
   tos := %40000;                                                       06880000
   x := %40000;                                                         06885000
   push( status );                                                      06890000
   tos.(4:4) := %7;                                                     06895000
   set( status );                                                       06900000
   saveregs;                                                            06905000
   assemble( adax );                                                    06910000
   pushregs;                                                            06915000
   exp'status.(4:4) := %11;                                             06920000
   exp'x := %100000;                                                    06925000
   exp's := exp's-1;                                                    06930000
   checkregs(*,*,*,*,*,*);                                              06935000
                                                                        06940000
   tos := %100000;                                                      06945000
   x := %100000;                                                        06950000
   push( status );                                                      06955000
   tos.(4:4) := %3;                                                     06960000
   set( status );                                                       06965000
   saveregs;                                                            06970000
   assemble( adax );                                                    06975000
   pushregs;                                                            06980000
   exp'status.(4:4) := %16;                                             06985000
   exp'x := 0;                                                          06990000
   exp's := exp's-1;                                                    06995000
   checkregs(*,*,*,*,*,*);                                              07000000
                                                                        07005000
   tos := -1;                                                           07010000
   x := -2;                                                             07015000
   push( status );                                                      07020000
   tos.(4:4) := %13;                                                    07025000
   set( status );                                                       07030000
   saveregs;                                                            07035000
   assemble( adax );                                                    07040000
   pushregs;                                                            07045000
   exp'status.(4:4) := %5;                                              07050000
   exp'x := -3;                                                         07055000
   exp's := exp's-1;                                                    07060000
   checkregs(*,*,*,*,*,*);                                              07065000
                                                                        07070000
   tos := -1;                                                           07075000
   x := %100000;                                                        07080000
   push( status );                                                      07085000
   tos.(4:4) := %3;                                                     07090000
   set( status );                                                       07095000
   saveregs;                                                            07100000
   assemble( adax );                                                    07105000
   pushregs;                                                            07110000
   exp'status.(4:4) := %14;                                             07115000
   exp'x := %77777;                                                     07120000
   exp's := exp's-1;                                                    07125000
   checkregs(*,*,*,*,*,*);                                              07130000
                                                                        07135000
   tos := -1;                                                           07140000
   x := 1;                                                              07145000
   push( status );                                                      07150000
   tos.(4:4) := %13;                                                    07155000
   set( status );                                                       07160000
   saveregs;                                                            07165000
   assemble( adax );                                                    07170000
   pushregs;                                                            07175000
   exp'status.(4:4) := 6;                                               07180000
   exp'x := 0;                                                          07185000
   exp's := exp's-1;                                                    07190000
   checkregs(*,*,*,*,*,*);                                              07195000
end;                                                                    07200000
procedure adxa'test;                                                    07205000
begin                                                                   07210000
                                                                        07215000
   <<  adxa  >>                                                         07220000
                                                                        07225000
   tos := 1;                                                            07230000
   tos := %40000;                                                       07235000
   x := %37777;                                                         07240000
   push( status );                                                      07245000
   tos.(4:4) := %17;                                                    07250000
   set( status );                                                       07255000
   saveregs;                                                            07260000
   assemble( adxa );                                                    07265000
   pushregs;                                                            07270000
   exp'status.(4:4) := 0;                                               07275000
   checkregs(*,*,*,*,*,*);                                              07280000
   if tos <> %77777 then no'error:=false;                               07285000
   if tos <> 1 then no'error:=false;                                    07290000
                                                                        07295000
   tos := %100000;                                                      07300000
   x := 0;                                                              07305000
   push( status );                                                      07310000
   tos.(4:4) := %17;                                                    07315000
   set( status );                                                       07320000
   saveregs;                                                            07325000
   assemble( adxa );                                                    07330000
   pushregs;                                                            07335000
   exp'status.(4:4) := 1;                                               07340000
   checkregs(*,*,*,*,*,*);                                              07345000
   if tos <> %100000 then no'error:=false;                              07350000
                                                                        07355000
   tos := %40000;                                                       07360000
   x := %40000;                                                         07365000
   push( status );                                                      07370000
   tos.(4:4) := %7;                                                     07375000
   set( status );                                                       07380000
   saveregs;                                                            07385000
   assemble( adxa );                                                    07390000
   pushregs;                                                            07395000
   exp'status.(4:4) := %11;                                             07400000
   checkregs(*,*,*,*,*,*);                                              07405000
   if tos <> %100000 then no'error:=false;                              07410000
                                                                        07415000
   tos := %100000;                                                      07420000
   x := %100000;                                                        07425000
   push( status );                                                      07430000
   tos.(4:4) := %3;                                                     07435000
   set( status );                                                       07440000
   saveregs;                                                            07445000
   assemble( adxa );                                                    07450000
   pushregs;                                                            07455000
   exp'status.(4:4) := %16;                                             07460000
   checkregs(*,*,*,*,*,*);                                              07465000
   if tos <> 0 then no'error:=false;                                    07470000
                                                                        07475000
   tos := -1;                                                           07480000
   x := -2;                                                             07485000
   push( status );                                                      07490000
   tos.(4:4) := %13;                                                    07495000
   set( status );                                                       07500000
   saveregs;                                                            07505000
   assemble( adxa );                                                    07510000
   pushregs;                                                            07515000
   exp'status.(4:4) := %5;                                              07520000
   checkregs(*,*,*,*,*,*);                                              07525000
   if tos <> -3 then no'error:=false;                                   07530000
                                                                        07535000
   tos := -1;                                                           07540000
   x := %100000;                                                        07545000
   push( status );                                                      07550000
   tos.(4:4) := %3;                                                     07555000
   set( status );                                                       07560000
   saveregs;                                                            07565000
   assemble( adxa );                                                    07570000
   pushregs;                                                            07575000
   exp'status.(4:4) := %14;                                             07580000
   checkregs(*,*,*,*,*,*);                                              07585000
   if tos <> %77777 then no'error:=false;                               07590000
                                                                        07595000
   tos := -1;                                                           07600000
   x := 1;                                                              07605000
   push( status );                                                      07610000
   tos.(4:4) := %13;                                                    07615000
   set( status );                                                       07620000
   saveregs;                                                            07625000
   assemble( adxa );                                                    07630000
   pushregs;                                                            07635000
   exp'status.(4:4) := 6;                                               07640000
   checkregs(*,*,*,*,*,*);                                              07645000
   if tos <> 0 then no'error:=false;                                    07650000
end;                                                                    07655000
procedure adbx'test;                                                    07660000
begin                                                                   07665000
                                                                        07670000
   <<  adbx  >>                                                         07675000
                                                                        07680000
   tos := 0;                                                            07685000
   tos := %40000;                                                       07690000
   tos := -1;                                                           07695000
   x := %37777;                                                         07700000
   push( status );                                                      07705000
   tos.(4:4) := %17;                                                    07710000
   set( status );                                                       07715000
   saveregs;                                                            07720000
   assemble( adbx );                                                    07725000
   pushregs;                                                            07730000
   exp'status.(4:4) := 0;                                               07735000
   exp'x := %77777;                                                     07740000
   checkregs(*,*,*,*,*,*);                                              07745000
   if tos <> -1 then no'error:=false;                                   07750000
   if tos <> %40000 then no'error:=false;                               07755000
   if tos <> 0 then no'error:=false;                                    07760000
                                                                        07765000
   tos := %100000;                                                      07770000
   tos := -5;                                                           07775000
   x := 0;                                                              07780000
   push( status );                                                      07785000
   tos.(4:4) := %17;                                                    07790000
   set( status );                                                       07795000
   saveregs;                                                            07800000
   assemble( adbx );                                                    07805000
   pushregs;                                                            07810000
   exp'status.(4:4) := 1;                                               07815000
   exp'x := %100000;                                                    07820000
   checkregs(*,*,*,*,*,*);                                              07825000
   if tos <> -5 then no'error:=false;                                   07830000
   if tos <> %100000 then no'error:=false;                              07835000
                                                                        07840000
   tos := %40000;                                                       07845000
   tos := -5;                                                           07850000
   x := %40000;                                                         07855000
   push( status );                                                      07860000
   tos.(4:4) := %7;                                                     07865000
   set( status );                                                       07870000
   saveregs;                                                            07875000
   assemble( adbx );                                                    07880000
   pushregs;                                                            07885000
   exp'status.(4:4) := %11;                                             07890000
   exp'x := %100000;                                                    07895000
   checkregs(*,*,*,*,*,*);                                              07900000
   if tos <> -5 then no'error:=false;                                   07905000
   if tos <> %40000 then no'error:=false;                               07910000
                                                                        07915000
   tos := %100000;                                                      07920000
   tos := -5;                                                           07925000
   x := %100000;                                                        07930000
   push( status );                                                      07935000
   tos.(4:4) := %3;                                                     07940000
   set( status );                                                       07945000
   saveregs;                                                            07950000
   assemble( adbx );                                                    07955000
   pushregs;                                                            07960000
   exp'status.(4:4) := %16;                                             07965000
   exp'x := 0;                                                          07970000
   checkregs(*,*,*,*,*,*);                                              07975000
   if tos <> -5 then no'error:=false;                                   07980000
   if tos <> %100000 then no'error:=false;                              07985000
                                                                        07990000
   tos := -1;                                                           07995000
   tos := -5;                                                           08000000
   x := -2;                                                             08005000
   push( status );                                                      08010000
   tos.(4:4) := %13;                                                    08015000
   set( status );                                                       08020000
   saveregs;                                                            08025000
   assemble( adbx );                                                    08030000
   pushregs;                                                            08035000
   exp'status.(4:4) := %5;                                              08040000
   exp'x := -3;                                                         08045000
   checkregs(*,*,*,*,*,*);                                              08050000
   if tos <> -5 then no'error:=false;                                   08055000
   if tos <> -1 then no'error:=false;                                   08060000
                                                                        08065000
   tos := -1;                                                           08070000
   tos := -5;                                                           08075000
   x := %100000;                                                        08080000
   push( status );                                                      08085000
   tos.(4:4) := %3;                                                     08090000
   set( status );                                                       08095000
   saveregs;                                                            08100000
   assemble( adbx );                                                    08105000
   pushregs;                                                            08110000
   exp'status.(4:4) := %14;                                             08115000
   exp'x := %77777;                                                     08120000
   checkregs(*,*,*,*,*,*);                                              08125000
   if tos <> -5 then no'error:=false;                                   08130000
   if tos <> -1 then no'error:=false;                                   08135000
                                                                        08140000
   tos := -1;                                                           08145000
   tos := -5;                                                           08150000
   x := 1;                                                              08155000
   push( status );                                                      08160000
   tos.(4:4) := %13;                                                    08165000
   set( status );                                                       08170000
   saveregs;                                                            08175000
   assemble( adbx );                                                    08180000
   pushregs;                                                            08185000
   exp'status.(4:4) := 6;                                               08190000
   exp'x := 0;                                                          08195000
   checkregs(*,*,*,*,*,*);                                              08200000
   if tos <> -5 then no'error:=false;                                   08205000
   if tos <> -1 then no'error:=false;                                   08210000
end;                                                                    08215000
procedure adxb'test;                                                    08220000
begin                                                                   08225000
                                                                        08230000
   <<  adxb  >>                                                         08235000
                                                                        08240000
   tos := 1;                                                            08245000
   tos := %40000;                                                       08250000
   tos := -5;                                                           08255000
   x := %37777;                                                         08260000
   push( status );                                                      08265000
   tos.(4:4) := %17;                                                    08270000
   set( status );                                                       08275000
   saveregs;                                                            08280000
   assemble( adxb );                                                    08285000
   pushregs;                                                            08290000
   exp'status.(4:4) := 0;                                               08295000
   checkregs(*,*,*,*,*,*);                                              08300000
   if tos <> -5 then no'error:=false;                                   08305000
   if tos <> %77777 then no'error:=false;                               08310000
   if tos <> 1 then no'error:=false;                                    08315000
                                                                        08320000
   tos := %100000;                                                      08325000
   tos := -5;                                                           08330000
   x := 0;                                                              08335000
   push( status );                                                      08340000
   tos.(4:4) := %17;                                                    08345000
   set( status );                                                       08350000
   saveregs;                                                            08355000
   assemble( adxb );                                                    08360000
   pushregs;                                                            08365000
   exp'status.(4:4) := 1;                                               08370000
   checkregs(*,*,*,*,*,*);                                              08375000
   if tos <> -5 then no'error:=false;                                   08380000
   if tos <> %100000 then no'error:=false;                              08385000
                                                                        08390000
   tos := %40000;                                                       08395000
   tos := -5;                                                           08400000
   x := %40000;                                                         08405000
   push( status );                                                      08410000
   tos.(4:4) := %7;                                                     08415000
   set( status );                                                       08420000
   saveregs;                                                            08425000
   assemble( adxb );                                                    08430000
   pushregs;                                                            08435000
   exp'status.(4:4) := %11;                                             08440000
   checkregs(*,*,*,*,*,*);                                              08445000
   if tos <> -5 then no'error:=false;                                   08450000
   if tos <> %100000 then no'error:=false;                              08455000
                                                                        08460000
   tos := %100000;                                                      08465000
   tos := -5;                                                           08470000
   x := %100000;                                                        08475000
   push( status );                                                      08480000
   tos.(4:4) := %3;                                                     08485000
   set( status );                                                       08490000
   saveregs;                                                            08495000
   assemble( adxb );                                                    08500000
   pushregs;                                                            08505000
   exp'status.(4:4) := %16;                                             08510000
   checkregs(*,*,*,*,*,*);                                              08515000
   if tos <> -5 then no'error:=false;                                   08520000
   if tos <>0 then no'error:=false;                                     08525000
                                                                        08530000
   tos := -1;                                                           08535000
   tos := -5;                                                           08540000
   x := -2;                                                             08545000
   push( status );                                                      08550000
   tos.(4:4) := %13;                                                    08555000
   set( status );                                                       08560000
   saveregs;                                                            08565000
   assemble( adxb );                                                    08570000
   pushregs;                                                            08575000
   exp'status.(4:4) := %5;                                              08580000
   checkregs(*,*,*,*,*,*);                                              08585000
   if tos <> -5 then no'error:=false;                                   08590000
   if tos <> -3 then no'error:=false;                                   08595000
                                                                        08600000
   tos := -1;                                                           08605000
   tos := -5;                                                           08610000
   x := %100000;                                                        08615000
   push( status );                                                      08620000
   tos.(4:4) := %3;                                                     08625000
   set( status );                                                       08630000
   saveregs;                                                            08635000
   assemble( adxb );                                                    08640000
   pushregs;                                                            08645000
   exp'status.(4:4) := %14;                                             08650000
   checkregs(*,*,*,*,*,*);                                              08655000
   if tos <> -5 then no'error:=false;                                   08660000
   if tos <> %77777 then no'error:=false;                               08665000
                                                                        08670000
   tos := -1;                                                           08675000
   tos := -5;                                                           08680000
   x := 1;                                                              08685000
   push( status );                                                      08690000
   tos.(4:4) := %13;                                                    08695000
   set( status );                                                       08700000
   saveregs;                                                            08705000
   assemble( adxb );                                                    08710000
   pushregs;                                                            08715000
   exp'status.(4:4) := 6;                                               08720000
   checkregs(*,*,*,*,*,*);                                              08725000
   if tos <> -5 then no'error:=false;                                   08730000
   if tos <> 0 then no'error:=false;                                    08735000
                                                                        08740000
end;                                                                    08745000
                                                                        08750000
procedure sub'test;                                                     08755000
begin                                                                   08760000
                                                                        08765000
                                                                        08770000
   <<  sub  >>                                                          08775000
                                                                        08780000
   tos := 1;                                                            08785000
   tos := %40000;                                                       08790000
   tos := %37777;                                                       08795000
   push( status );                                                      08800000
   tos.(4:4) := %13;  << set o, cc=3 >>                                 08805000
   set( status );                                                       08810000
   saveregs;                                                            08815000
   assemble( sub );                                                     08820000
   pushregs;                                                            08825000
   exp'status.(4:4) := %4;      << carry >>                             08830000
   exp's := exp's-1;                                                    08835000
   checkregs(*,*,*,*,*,*);                                              08840000
   if tos <> %1 then no'error:=false;                                   08845000
   if tos <> %1 then no'error:=false;                                   08850000
                                                                        08855000
   tos := %77777;    << %77777 - 0 >>                                   08860000
   tos := 0;                                                            08865000
   push( status );                                                      08870000
   tos.(4:4) := %3;     << cc=3 >>                                      08875000
   set( status );                                                       08880000
   saveregs;                                                            08885000
   assemble( sub );                                                     08890000
   pushregs;                                                            08895000
   exp'status.(4:4) := %4;   << c, ccg >>                               08900000
   exp's := exp's-1;                                                    08905000
   checkregs(*,*,*,*,*,*);                                              08910000
   if tos <> %77777 then no'error:=false;                               08915000
                                                                        08920000
   tos := %77777;    << 32767 - 32767 >>                                08925000
   tos := %77777;                                                       08930000
   push( status );                                                      08935000
   tos.(4:4) := %13;       << o, cc=3 >>                                08940000
   set( status );                                                       08945000
   saveregs;                                                            08950000
   assemble( sub );                                                     08955000
   pushregs;                                                            08960000
   exp'status.(4:4) := %6;    << cce >>                                 08965000
   exp's := exp's-1;                                                    08970000
   checkregs(*,*,*,*,*,*);                                              08975000
   if tos <> %0 then no'error:=false;                                   08980000
                                                                        08985000
   tos := %0;       << 0 - #32767 >>                                    08990000
   tos := %77777;                                                       08995000
   push( status );                                                      09000000
   tos.(4:4) := %12;    << set o, cce >>                                09005000
   set( status );                                                       09010000
   saveregs;                                                            09015000
   assemble( sub );                                                     09020000
   pushregs;                                                            09025000
   exp'status.(4:4) := %1;     << ccl >>                                09030000
   exp's := exp's-1;                                                    09035000
   checkregs(*,*,*,*,*,*);                                              09040000
   if tos <> -32767 then no'error:=false;                               09045000
                                                                        09050000
   tos := -1;                                                           09055000
   tos := -2;                                                           09060000
   push( status );                                                      09065000
   tos.(4:4) := %3;    << cc=3 >>                                       09070000
   set( status );                                                       09075000
   saveregs;                                                            09080000
   assemble( sub );                                                     09085000
   pushregs;                                                            09090000
   exp'status.(4:4) := %4;  << c, ccg >>                                09095000
   exp's := exp's-1;                                                    09100000
   checkregs(*,*,*,*,*,*);                                              09105000
   if tos <> 1 then no'error:=false;                                    09110000
                                                                        09115000
   tos := 0;     << 0 - 32767 >>                                        09120000
   tos := %77777;                                                       09125000
   push( status );                                                      09130000
   tos.(4:4) := %3;   << cc=3 >>                                        09135000
   set( status );                                                       09140000
   saveregs;                                                            09145000
   assemble( sub );                                                     09150000
   pushregs;                                                            09155000
   exp'status.(4:4) := %1;   << ccl >>                                  09160000
   exp's := exp's-1;                                                    09165000
   checkregs(*,*,*,*,*,*);                                              09170000
   if tos <> -32767 then no'error:=false;                               09175000
                                                                        09180000
   tos := 0;      << 0 - 0 >>                                           09185000
   tos := 0;                                                            09190000
   push( status );                                                      09195000
   tos.(4:4) := %13; << o, cc=3 >>                                      09200000
   set( status );                                                       09205000
   saveregs;                                                            09210000
   assemble( sub );                                                     09215000
   pushregs;                                                            09220000
   exp'status.(4:4) := 6;  << c, cce >>                                 09225000
   exp's := exp's-1;                                                    09230000
   checkregs(*,*,*,*,*,*);                                              09235000
   if tos <> 0 then no'error:=false;                                    09240000
end;                                                                    09245000
                                                                        09250000
procedure mpy'test;                                                     09255000
begin                                                                   09260000
                                                                        09265000
   << mpy >>                                                            09270000
                                                                        09275000
   tos:=2;                                                              09280000
   tos:=5;                                                              09285000
   push( status );                                                      09290000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09295000
   set( status );                                                       09300000
   saveregs;                                                            09305000
   assemble( mpy ); << 2*5 >>                                           09310000
   pushregs;                                                            09315000
   exp'status.(4:4) := %0; << ccg >>                                    09320000
   exp's:=exp's-1;                                                      09325000
   checkregs(*,*,*,*,*,*);                                              09330000
   if tos <> 10 then no'error:=false;                                   09335000
                                                                        09340000
   tos:=-2;                                                             09345000
   tos:=5;                                                              09350000
   push( status );                                                      09355000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09360000
   set( status );                                                       09365000
   saveregs;                                                            09370000
   assemble( mpy ); << -2*5 >>                                          09375000
   pushregs;                                                            09380000
   exp'status.(4:4) := %1; << ccl >>                                    09385000
   exp's:=exp's-1;                                                      09390000
   checkregs(*,*,*,*,*,*);                                              09395000
   if tos <> -10 then no'error:=false;                                  09400000
                                                                        09405000
   tos:=2;                                                              09410000
   tos:=%77777;;                                                        09415000
   push( status );                                                      09420000
   tos.(4:4):=%3;  << set c, cc=3 >>                                    09425000
   set( status );                                                       09430000
   saveregs;                                                            09435000
   assemble( mpy ); << 2*%77777 >>                                      09440000
   pushregs;                                                            09445000
   exp'status.(4:4) := %11; << o, ccl >>                                09450000
   exp's:=exp's-1;                                                      09455000
   checkregs(*,*,*,*,*,*);                                              09460000
   if tos <> %177776 then no'error:=false;                              09465000
                                                                        09470000
   tos:=-1;                                                             09475000
   tos:=%100000;   << -32768 >>                                         09480000
   push( status );                                                      09485000
   tos.(4:4):=%3;  << set c, cc=3 >>                                    09490000
   set( status );                                                       09495000
   saveregs;                                                            09500000
   assemble( mpy ); << (-1) * (-32768) >>                               09505000
   pushregs;                                                            09510000
   exp'status.(4:4) := %11; << o, ccl >>                                09515000
   exp's:=exp's-1;                                                      09520000
   checkregs(*,*,*,*,*,*);                                              09525000
                                                                        09530000
   tos:=-2;                                                             09535000
   tos:=16384;                                                          09540000
   push( status );                                                      09545000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09550000
   set( status );                                                       09555000
   saveregs;                                                            09560000
   assemble( mpy ); << -2 * 16384 = -32768 >>                           09565000
   pushregs;                                                            09570000
   exp'status.(4:4) := %1; << ccl >>                                    09575000
   exp's:=exp's-1;                                                      09580000
   checkregs(*,*,*,*,*,*);                                              09585000
   if tos <> -32768 then no'error:=false;                               09590000
                                                                        09595000
end;                                                                    09600000
                                                                        09605000
procedure div'test;                                                     09610000
begin                                                                   09615000
                                                                        09620000
   << div >>                                                            09625000
                                                                        09630000
   tos:=20;                                                             09635000
   tos:=10;                                                             09640000
   push( status );                                                      09645000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09650000
   set( status );                                                       09655000
   saveregs;                                                            09660000
   assemble( div ); << 20 / 10 = 2 >>                                   09665000
   pushregs;                                                            09670000
   exp'status.(4:4) := %0; << ccg >>                                    09675000
   checkregs(*,*,*,*,*,*);                                              09680000
   if tos <> 0 then no'error:=false;                                    09685000
   if tos <> 2 then no'error:=false;                                    09690000
                                                                        09695000
   tos:=20;                                                             09700000
   tos:=3;                                                              09705000
   push( status );                                                      09710000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09715000
   set( status );                                                       09720000
   saveregs;                                                            09725000
   assemble( div ); << 20 / 3 = 6 ... 2 >>                              09730000
   pushregs;                                                            09735000
   exp'status.(4:4) := %0; << ccg >>                                    09740000
   checkregs(*,*,*,*,*,*);                                              09745000
   if tos <> 2 then no'error:=false;                                    09750000
   if tos <> 6 then no'error:=false;                                    09755000
                                                                        09760000
   tos:=20;                                                             09765000
   tos:=-3;                                                             09770000
   push( status );                                                      09775000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09780000
   set( status );                                                       09785000
   saveregs;                                                            09790000
   assemble( div ); << 20 / -3 = -6 ... 2 >>                            09795000
   pushregs;                                                            09800000
   exp'status.(4:4) := %1; << ccl >>                                    09805000
   checkregs(*,*,*,*,*,*);                                              09810000
   if tos <> 2 then no'error:=false;                                    09815000
   if tos <> -6 then no'error:=false;                                   09820000
                                                                        09825000
   tos:=-32768;                                                         09830000
   tos:=1;                                                              09835000
   push( status );                                                      09840000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09845000
   set( status );                                                       09850000
   saveregs;                                                            09855000
   assemble( div ); << -32768 / 1 = -32768 >>                           09860000
   pushregs;                                                            09865000
   exp'status.(4:4) := %1; << ccl >>                                    09870000
   checkregs(*,*,*,*,*,*);                                              09875000
   if tos <> 0 then no'error:=false;                                    09880000
   if tos <> -32768 then no'error:=false;                               09885000
                                                                        09890000
   tos:=-32768;                                                         09895000
   tos:=-1;                                                             09900000
   push( status );                                                      09905000
   tos.(4:4):=%13;  << set c, o, cc=3 >>                                09910000
   set( status );                                                       09915000
   saveregs;                                                            09920000
   assemble( div ); << -32768 / -1 = 32768 ?? >>                        09925000
   pushregs;                                                            09930000
   exp'status.(4:4) := %11; << o, ccl >>                                09935000
   checkregs(*,*,*,*,*,*);                                              09940000
end;                                                                    09945000
                                                                        09950000
procedure cmp'test;                                                     09955000
begin                                                                   09960000
                                                                        09965000
   <<  cmp  >>                                                          09970000
                                                                        09975000
   tos := 1;                                                            09980000
   tos := %40000;                                                       09985000
   tos := %37777;                                                       09990000
   push( status );                                                      09995000
   tos.(4:4) := %3;  << cc=3 >>                                         10000000
   set( status );                                                       10005000
   saveregs;                                                            10010000
   assemble( cmp );                                                     10015000
   pushregs;                                                            10020000
   exp'status.(4:4) := %0;      << ccg >>                               10025000
   exp's:=exp's-2;                                                      10030000
   checkregs(*,*,*,*,*,*);                                              10035000
   if tos <> %1 then no'error:=false;                                   10040000
                                                                        10045000
   tos := %77777;                                                       10050000
   tos := %77777;                                                       10055000
   push( status );                                                      10060000
   tos.(4:4) := %3;     << cc=3 >>                                      10065000
   set( status );                                                       10070000
   saveregs;                                                            10075000
   assemble( cmp );                                                     10080000
   pushregs;                                                            10085000
   exp'status.(4:4) := %2;   << cce >>                                  10090000
   exp's:=exp's-2;                                                      10095000
   checkregs(*,*,*,*,*,*);                                              10100000
                                                                        10105000
   tos := %177777;                                                      10110000
   tos := %177777;                                                      10115000
   push( status );                                                      10120000
   tos.(4:4) := %3;       << cc=3 >>                                    10125000
   set( status );                                                       10130000
   saveregs;                                                            10135000
   assemble( cmp );                                                     10140000
   pushregs;                                                            10145000
   exp'status.(4:4) := %2;    << cce >>                                 10150000
   exp's:=exp's-2;                                                      10155000
   checkregs(*,*,*,*,*,*);                                              10160000
                                                                        10165000
   tos := -1;                                                           10170000
   tos := -2;                                                           10175000
   push( status );                                                      10180000
   tos.(4:4) := %3;    << cc=3 >>                                       10185000
   set( status );                                                       10190000
   saveregs;                                                            10195000
   assemble( cmp );                                                     10200000
   pushregs;                                                            10205000
   exp'status.(4:4) := %0;     << ccg >>                                10210000
   exp's:=exp's-2;                                                      10215000
   checkregs(*,*,*,*,*,*);                                              10220000
                                                                        10225000
   tos := -1;                                                           10230000
   tos := 0;                                                            10235000
   push( status );                                                      10240000
   tos.(4:4) := %3;    << cc=3 >>                                       10245000
   set( status );                                                       10250000
   saveregs;                                                            10255000
   assemble( cmp );                                                     10260000
   pushregs;                                                            10265000
   exp'status.(4:4) := %1;  << ccl >>                                   10270000
   exp's:=exp's-2;                                                      10275000
   checkregs(*,*,*,*,*,*);                                              10280000
                                                                        10285000
   tos := 0;                                                            10290000
   tos := %77777;                                                       10295000
   push( status );                                                      10300000
   tos.(4:4) := %3;   << cc=3 >>                                        10305000
   set( status );                                                       10310000
   saveregs;                                                            10315000
   assemble( cmp );                                                     10320000
   pushregs;                                                            10325000
   exp'status.(4:4) := %1;   << ccl >>                                  10330000
   exp's:=exp's-2;                                                      10335000
   checkregs(*,*,*,*,*,*);                                              10340000
                                                                        10345000
   tos := 0;                                                            10350000
   tos := 0;                                                            10355000
   push( status );                                                      10360000
   tos.(4:4) := %3; << cc=3 >>                                          10365000
   set( status );                                                       10370000
   saveregs;                                                            10375000
   assemble( cmp );                                                     10380000
   pushregs;                                                            10385000
   exp'status.(4:4) := 2;  << cce >>                                    10390000
   exp's:=exp's-2;                                                      10395000
   checkregs(*,*,*,*,*,*);                                              10400000
end;                                                                    10405000
                                                                        10410000
procedure stackop;                                                      10415000
begin                                                                   10420000
   <<  disable traps >>                                                 10425000
                                                                        10430000
   push( status );                                                      10435000
   tos.(2:1) := 0;                                                      10440000
   set( status );                                                       10445000
                                                                        10450000
   move instruct'name:="DEL   ";                                        10455000
   print'names;                                                         10460000
   while no'error and (i:=i+1) < loopnumber do del'test;                10465000
   move instruct'name:="DDEL  ";                                        10470000
   print'names;                                                         10475000
   while no'error and (i:=i+1) < loopnumber do ddel'test;               10480000
   move instruct'name:="DELB  ";                                        10485000
   print'names;                                                         10490000
   while no'error and (i:=i+1) < loopnumber do delb'test;               10495000
   move instruct'name:="DUP   ";                                        10500000
   print'names;                                                         10505000
   while no'error and (i:=i+1) < loopnumber do dup'test;                10510000
   move instruct'name:="DDUP  ";                                        10515000
   print'names;                                                         10520000
   while no'error and (i:=i+1) < loopnumber do ddup'test;               10525000
   move instruct'name:="ZERO  ";                                        10530000
   print'names;                                                         10535000
   while no'error and (i:=i+1) < loopnumber do zero'test;               10540000
   move instruct'name:="DZRO  ";                                        10545000
   print'names;                                                         10550000
   while no'error and (i:=i+1) < loopnumber do dzro'test;               10555000
   move instruct'name:="ZROB  ";                                        10560000
   print'names;                                                         10565000
   while no'error and (i:=i+1) < loopnumber do zrob'test;               10570000
   move instruct'name:="OR    ";                                        10575000
   print'names;                                                         10580000
   while no'error and (i:=i+1) < loopnumber do or'test;                 10585000
   move instruct'name:="XOR   ";                                        10590000
   print'names;                                                         10595000
   while no'error and (i:=i+1) < loopnumber do xor'test;                10600000
   move instruct'name:="AND   ";                                        10605000
   print'names;                                                         10610000
   while no'error and (i:=i+1) < loopnumber do and'test;                10615000
   move instruct'name:="INCA  ";                                        10620000
   print'names;                                                         10625000
   while no'error and (i:=i+1) < loopnumber do inca'test;               10630000
   move instruct'name:="DECA  ";                                        10635000
   print'names;                                                         10640000
   while no'error and (i:=i+1) < loopnumber do deca'test;               10645000
   move instruct'name:="INCB      ";                                    10650000
   print'names;                                                         10655000
   while no'error and (i:=i+1) < loopnumber do incb'test;               10660000
   move instruct'name:="ADD   ";                                        10665000
   print'names;                                                         10670000
   while no'error and (i:=i+1) < loopnumber do add'test;                10675000
   move instruct'name:="STAX  ";                                        10680000
   print'names;                                                         10685000
   while no'error and (i:=i+1) < loopnumber do stax'test;               10690000
   move instruct'name:="LDXA  ";                                        10695000
   print'names;                                                         10700000
   while no'error and (i:=i+1) < loopnumber do ldxa'test;               10705000
   move instruct'name:="ZROX  ";                                        10710000
   print'names;                                                         10715000
   while no'error and (i:=i+1) < loopnumber do zrox'test;               10720000
   move instruct'name:="STBX  ";                                        10725000
   print'names;                                                         10730000
   while no'error and (i:=i+1) < loopnumber do stbx'test;               10735000
   move instruct'name:="LDXB  ";                                        10740000
   print'names;                                                         10745000
   while no'error and (i:=i+1) < loopnumber do ldxb'test;               10750000
   move instruct'name:="XAX   ";                                        10755000
   print'names;                                                         10760000
   while no'error and (i:=i+1) < loopnumber do xax'test;                10765000
   move instruct'name:="XBX   ";                                        10770000
   print'names;                                                         10775000
   while no'error and (i:=i+1) < loopnumber do xbx'test;                10780000
   move instruct'name:="INCX  ";                                        10785000
   print'names;                                                         10790000
   while no'error and (i:=i+1) < loopnumber do incx'test;               10795000
   move instruct'name:="DECX  ";                                        10800000
   print'names;                                                         10805000
   while no'error and (i:=i+1) < loopnumber do decx'test;               10810000
   move instruct'name:="ADAX  ";                                        10815000
   print'names;                                                         10820000
   while no'error and (i:=i+1) < loopnumber do adax'test;               10825000
   move instruct'name:="ADXA  ";                                        10830000
   print'names;                                                         10835000
   while no'error and (i:=i+1) < loopnumber do adxa'test;               10840000
   move instruct'name:="ADBX  ";                                        10845000
   print'names;                                                         10850000
   while no'error and (i:=i+1) < loopnumber do adbx'test;               10855000
   move instruct'name:="ADXB  ";                                        10860000
   print'names;                                                         10865000
   while no'error and (i:=i+1) < loopnumber do adxb'test;               10870000
   move instruct'name:="SUB   ";                                        10875000
   print'names;                                                         10880000
   while no'error and (i:=i+1) < loopnumber do sub'test;                10885000
   move instruct'name:="MPY   ";                                        10890000
   print'names;                                                         10895000
   while no'error and (i:=i+1) < loopnumber do mpy'test;                10900000
   move instruct'name:="DIV   ";                                        10905000
   print'names;                                                         10910000
   while no'error and (i:=i+1) < loopnumber do div'test;                10915000
   move instruct'name:="CMP   ";                                        10920000
   print'names;                                                         10925000
   while no'error and (i:=i+1) < loopnumber do cmp'test;                10930000
                                                                        10935000
   push(q);set(s); << reset stack >>                                    10940000
   readswreg;                                                           10945000
out: loopctn:=0;                                                        10950000
end;                                                                    10955000
                                                                        10960000
                                                                        10965000
procedure btst'test;                                                    10970000
  begin                                                                 10975000
      assemble(                                                         10980000
<< check btst instruction >>                                            10985000
                                                                        10990000
      dzro,dzro;                                               <<j8932>>10995000
      ldi 0;   << %0 is special >>                                      11000000
      dzro,dzro;                                               <<j8676>>11005000
      ddel,ddel; << sr=0>>                                     <<j8676>>11010000
      btst;                                                             11015000
      bl *+2;                                                           11020000
      br btsterror;                   << btst failed >>                 11025000
                                                                        11030000
      ldi %101;   << ascii a, capital >>                                11035000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>11040000
      btst;                                                             11045000
      be *+2;                                                           11050000
      br btsterror;                   << btst failed >>                 11055000
                                                                        11060000
      ldi %141;   << ascii a, small >>                                  11065000
      btst;                                                             11070000
      be *+2;                                                           11075000
      br btsterror;                   << btst failed >>                 11080000
                                                                        11085000
      ldi %60;   << numeric 0 >>                                        11090000
      btst;                                                             11095000
      bg *+2;                                                           11100000
      br btsterror;                   << btst failed >>                 11105000
                                                                        11110000
<< check btst instruction >>                                            11115000
                                                                        11120000
      ldi 0;   << %0 is special >>                                      11125000
      dzro,dzro;                                               <<j8676>>11130000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>11135000
      nop,btst;                                                         11140000
      bl *+2;                                                           11145000
      br btsterror;                   << btst failed >>                 11150000
                                                                        11155000
      ldi %101;   << ascii a, capital >>                                11160000
      dxch,dxch; xch,xch; << sr=4 >>                           <<j8676>>11165000
      nop,btst;                                                         11170000
      be *+2;                                                           11175000
      br btsterror;                   << btst failed >>                 11180000
                                                                        11185000
      ldi %141;   << ascii a, small >>                                  11190000
      nop,btst;                                                         11195000
      be *+2;                                                           11200000
      br btsterror;                   << btst failed >>                 11205000
                                                                        11210000
      ldi %60;   << numeric 0 >>                                        11215000
      nop,btst;                                                         11220000
      bg exit);                                                         11225000
btsterror:                                                              11230000
      no'error:=false;                << btst failure >>                11235000
exit:                                                                   11240000
  end;   << btst'test >>                                                11245000
                                                                        11250000
procedure testbtst;   << test btst - 256 combinations >>                11255000
   begin                                                                11260000
star: assemble(                                                         11265000
      zero;   << for tos:=0 thru %377 >>                                11270000
btc:  dup,stax;                                                         11275000
      ldi %60;                                                          11280000
      ldi %71;                                                          11285000
      cprb btg;   << expect ccg=numeric if %60<=x<=%71 >>               11290000
      ldi %101;                                                         11295000
      ldi %132;                                                         11300000
      cprb bte;  << expect cce=alpha if %101<=x<=%132 >>                11305000
      ldi %141;                                                         11310000
      ldi %172;                                                         11315000
      cprb bte;  << expect cce=alpha if %141<=x<=%172 >>                11320000
      btst;   << else expect ccl=special >>                             11325000
      bl *+2;                                                           11330000
      br btsterror;                   << not ccl >>                     11335000
      br btx;                                                           11340000
btg:  btst;                                                             11345000
      bg *+2;                                                           11350000
      br btsterror;                   << not ccg >>                     11355000
      br btx;                                                           11360000
bte:  btst;                                                             11365000
      be btx;                                                           11370000
      br btsterror);                       << not cce >>                11375000
      assemble(                                                         11380000
btx:  dup,incb;                                                         11385000
      cmpi %377;                                                        11390000
      bne btc);   << continue if not %400 >>                            11395000
       push(q);set(s);<<reset stack>>                                   11400000
       if(loopctn:=loopctn+1)=loopnumber then go out                    11405000
       else go star;                                                    11410000
                                                                        11415000
btsterror:                                                              11420000
      no'error:=false;                                                  11425000
                                                                        11430000
out:   loopctn:=0;                                                      11435000
                                                                        11440000
end;   << testbtst >>                                                   11445000
                                                                        11450000
<< check test instruction >>                                            11455000
                                                                        11460000
procedure test'test;                                                    11465000
  begin                                                                 11470000
      assemble(                                                         11475000
      dzro,dzro;                                               <<j8932>>11480000
      ldi 1;                                                            11485000
      zero;                                                             11490000
      ldni 1;                                                           11495000
      ldi 3;                                                            11500000
      dzro,dzro;                                               <<j8676>>11505000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>11510000
      test;                                                             11515000
      bg *+2;                                                           11520000
      br testerror;                   << not ccg when tos = 3 >>        11525000
      cmpi 3;                                                           11530000
      be *+2;                                                           11535000
      br testerror;                   << tos not 3 after test >>        11540000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>11545000
      test;                                                             11550000
      bl *+2;                                                           11555000
      br testerror;                   << not ccl when tos = -1 >>       11560000
      del;                                                              11565000
      nop,test;                                                         11570000
      be *+2;                                                           11575000
      br testerror;                   << not cce when tos = 0 >>        11580000
      del,test;                                                         11585000
      bg exit);                                                         11590000
testerror:                                                              11595000
      no'error:=false;                   << not ccg when tos = 1 >>     11600000
exit:                                                                   11605000
  end;                                                                  11610000
                                                                        11615000
<< check dtst instruction >>                                            11620000
                                                                        11625000
procedure dtst'test;                                                    11630000
  begin                                                                 11635000
      assemble(                                                         11640000
      dzro,dzro;                                               <<j8932>>11645000
      dzro,dtst;                                                        11650000
      be *+2;                                                           11655000
      br dtsterror;                   << not cce >>                     11660000
      bncy *+2;                                                         11665000
      br dtsterror;                   << c not 0 >>                     11670000
                                                                        11675000
      ldni 1;                                                           11680000
      dup,dtst;                                                         11685000
      bl *+2;                                                           11690000
      br dtsterror;                   << not ccl >>                     11695000
      bncy *+2;                                                         11700000
      br dtsterror;                   << c not 0 >>                     11705000
                                                                        11710000
      ldi 1;                                                            11715000
      dup,dtst;                                                         11720000
      bg *+2;                                                           11725000
      br dtsterror;                   << not ccb >>                     11730000
      bcy *+2;                                                          11735000
      br dtsterror;                   << c not 1 >>                     11740000
                                                                        11745000
      load nmax;   << %100000 >>                                        11750000
      dup, dtst;                                                        11755000
      bl *+2;                                                           11760000
      br dtsterror;                   << not ccl >>                     11765000
      bcy *+2;                                                          11770000
      br dtsterror;                   << c not 1 >>                     11775000
                                                                        11780000
      zero;                                                             11785000
      load pmax;   << %0777777 >>                                       11790000
      dzro,dzro;                                               <<j8676>>11795000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>11800000
      dtst;                                                             11805000
      bg *+2;                                                           11810000
      br dtsterror;                   << not ccg >>                     11815000
      bncy *+2;                                                         11820000
      br dtsterror;                   << c not 0 >>                     11825000
      zero;                                                             11830000
      load pmax;                                                        11835000
      dcmp;                                                             11840000
      be *+2;                                                           11845000
      br dtsterror;                 << tos not %0,077777 after dtst >>  11850000
                                                                        11855000
      ldni 1;                                                           11860000
      load nmax;                                                        11865000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>11870000
      dtst;                                                             11875000
      bl *+2;                                                           11880000
      br dtsterror;                   << not ccl >>                     11885000
      bncy exit);                                                       11890000
dtsterror:                                                              11895000
      no'error:=false;              << c not 0 >>                       11900000
exit:                                                                   11905000
end;                                                                    11910000
                                                                        11915000
<< check not instruction >>                                             11920000
                                                                        11925000
procedure not'test;                                                     11930000
  begin                                                                 11935000
      assemble(                                                         11940000
      dzro,dzro;                                               <<j8932>>11945000
      zero,not;                                                         11950000
      bl *+2;                                                           11955000
      br noterror;                   << not ccl >>                      11960000
      cmpn 1;                                                           11965000
      be *+2;                                                           11970000
      br noterror;                   << tos not -1 >>                   11975000
                                                                        11980000
      ldni 1;                                                           11985000
      dzro,dzro;                                               <<j8676>>11990000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>11995000
      not;                                                              12000000
      be *+2;                                                           12005000
      br noterror;                   << not cce >>                      12010000
                                                                        12015000
      ldni 2;                                                           12020000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>12025000
      not;                                                              12030000
      bg *+2;                                                           12035000
      br noterror;                   << not ccg >>                      12040000
      cmpi 1;                                                           12045000
      be *+2;                                                           12050000
      br noterror;                   << tos not 1 >>                    12055000
       zero;                                                            12060000
       not,not; <<two 'not' stack-ops tested>>                          12065000
       cmpi 0;                                                          12070000
       be exit);                                                        12075000
noterror:                                                               12080000
       no'error:=false;   <<tos not zero>>                              12085000
exit:                                                                   12090000
  end;                                                                  12095000
                                                                        12100000
<< check neg instruction >>                                             12105000
                                                                        12110000
procedure neg'test;                                                     12115000
  begin                                                                 12120000
      assemble(                                                         12125000
      dzro,dzro;                                               <<j8932>>12130000
      ldi 1;                                                            12135000
      dzro,dzro;                                               <<j8676>>12140000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>12145000
      neg;                                                              12150000
      bl *+2;                 << not ccl >>                             12155000
      br negerror;                                                      12160000
      cmpn 1;                                                           12165000
      be *+2;                                                           12170000
      br negerror;                   << tos not -1 >>                   12175000
                                                                        12180000
      ldni 30;                                                          12185000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>12190000
      neg;                                                              12195000
      bg *+2;                                                           12200000
      br negerror;                   << not ccg >>                      12205000
      cmpi 30;                                                          12210000
      be *+2;                                                           12215000
      br negerror;                   << tos not 30 >>                   12220000
                                                                        12225000
      zero,neg;                                                         12230000
      be *+2;                                                           12235000
      br negerror;                   << not cce >>                      12240000
      bnov *+2;                                                         12245000
      br negerror;                   << o not 0 >>                      12250000
                                                                        12255000
      load nmax;   << %100000 >>                                        12260000
      neg;                                                              12265000
      bl *+2;                                                           12270000
      br negerror;                   << not ccl >>                      12275000
      bov *+2;                                                          12280000
      br negerror;                   << o not 1 >>                      12285000
      cmpm nmax;                                                        12290000
      be *+2;                                                           12295000
      br negerror;                   << tos not %100000 >>              12300000
       zero;                                                            12305000
       neg,neg;                                                         12310000
       cmpi 0;                                                          12315000
       be exit);                                                        12320000
negerror:                                                               12325000
       no'error:=false; << tos not zero>>                               12330000
exit:                                                                   12335000
  end;                                                                  12340000
                                                                        12345000
<< check xch instruction >>                                             12350000
                                                                        12355000
procedure xch'test;                                                     12360000
  begin                                                                 12365000
      assemble(                                                         12370000
      dzro,dzro;                                               <<j8932>>12375000
      zero;                                                             12380000
      ldni 15;                                                          12385000
      ldi 34;                                                           12390000
      dzro,dzro;                                               <<j8676>>12395000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>12400000
      xch;                                                              12405000
      bl *+2;                                                           12410000
      br xcherror;                   << not ccl >>                      12415000
      cmpn 15;                                                          12420000
      be *+2;                                                           12425000
      br xcherror;                   << tos not -15 >>                  12430000
      cmpi 34;                                                          12435000
      be *+2;                                                           12440000
      br xcherror;                   << (s-1) not 34 after xch >>       12445000
      cmpi 0;                                                           12450000
      be *+2;                                                           12455000
      br xcherror;                   << (s-2) not 0 after xch >>        12460000
                                                                        12465000
      zero;                                                             12470000
      ldi 1;                                                            12475000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>12480000
      xch;                                                              12485000
      be *+2;                                                           12490000
      br xcherror;                   << not cce >>                      12495000
                                                                        12500000
      ldi 4;                                                            12505000
      ldni 19;                                                          12510000
      xch;                                                              12515000
      bg *+2;                                                           12520000
      br xcherror;                   << not ccg >>                      12525000
       xch,xch;                                                         12530000
       cmpi 4;                                                          12535000
       be *+2;                                                          12540000
       br xcherror; << tos not 4 >>                                     12545000
       cmpn 19;                                                         12550000
       be exit);                                                        12555000
xcherror:                                                               12560000
       no'error:=false; << tos not -19 >>                               12565000
exit:                                                                   12570000
  end;                                                                  12575000
                                                                        12580000
<< check dxch instruction >>                                            12585000
                                                                        12590000
procedure dxch'test;                                                    12595000
  begin                                                                 12600000
      assemble(                                                         12605000
      ldi 5;                                                            12610000
      ldni 4;                                                           12615000
      ldi 7;                                                            12620000
      zero;                                                             12625000
      ldni 3;   << sr=4 >>                                              12630000
      dxch;                                                             12635000
      bl *+2;                                                           12640000
      br dxcherror;                   << not ccl >>                     12645000
      cmpi 7;                                                           12650000
      be *+2;                                                           12655000
      br dxcherror;                   << tos not 7 after dxch >>        12660000
      cmpn 4;                                                           12665000
      be *+2;                                                           12670000
      br dxcherror;                   << (s-1) not -4 after dxch >>     12675000
      cmpn 3;                                                           12680000
      be *+2;                                                           12685000
      br dxcherror;                   << (s-2) not -3 after dxch >>     12690000
      cmpi 0;                                                           12695000
      be *+2;                                                           12700000
      br dxcherror;                   << (s-3) not 0 after dxch >>      12705000
      cmpi 5;                                                           12710000
      be *+2;                                                           12715000
      br dxcherror;                   << (s-4) not 5 after dxch >>      12720000
                                                                        12725000
      dzro;                                                             12730000
      ldni 3;                                                           12735000
      ldi 7;                                                            12740000
      ldi 4;                                                            12745000
      ldni 21;                                                          12750000
      dzro,dzro;                                               <<j8676>>12755000
      ddel,ddel;  << sr=0>>                                    <<j8676>>12760000
      dxch;                                                             12765000
      bl *+2;                                                           12770000
      br dxcherror;                   << not ccl >>                     12775000
      dxch;                                                             12780000
      bg *+2;                                                           12785000
      br dxcherror;                   << not ccg >>                     12790000
      ddel,dxch;                                                        12795000
      be exit);                                                         12800000
dxcherror:                                                              12805000
      no'error:=false;               << not cce >>                      12810000
exit:                                                                   12815000
  end;                                                                  12820000
                                                                        12825000
<< check cab instruction >>                                             12830000
                                                                        12835000
procedure cab'test;                                                     12840000
  begin                                                                 12845000
      assemble(                                                         12850000
      dzro,dzro;                                               <<j8932>>12855000
      ldi 14;                                                           12860000
      ldni 35;                                                          12865000
      zero;                                                             12870000
      ldi 21;                                                           12875000
      dzro,dzro;                                               <<j8676>>12880000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>12885000
      cab;                                                              12890000
      bl *+2;                 << not ccl >>                             12895000
      br caberror;                                                      12900000
      cmpn 35;                                                          12905000
      be *+2;                                                           12910000
      br caberror;                   << tos not - 35 after cab >>       12915000
      cmpi 21;                                                          12920000
      be *+2;                                                           12925000
      br caberror;                   << (s-1) not 21 after cab >>       12930000
      cmpi 0;                                                           12935000
      be *+2;                                                           12940000
      br caberror;                   << (s-2) not 0 after cab >>        12945000
      cmpi 14;                                                          12950000
      be *+2;                                                           12955000
      br caberror;                   << (s-3) not 14 after cab >>       12960000
                                                                        12965000
      ldni 4;                                                           12970000
      ldi 3;                                                            12975000
      zero;                                                             12980000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>12985000
      cab;                                                              12990000
      bl *+2;                                                           12995000
      br caberror;                   << not ccl >>                      13000000
      cab;                                                              13005000
      bg *+2;                                                           13010000
      br caberror;                   << not ccg >>                      13015000
      cab;                                                              13020000
      be *+2;                                                           13025000
      br caberror;                   << not cce >>                      13030000
      cab,cab;                                                          13035000
      bg exit);                                                         13040000
caberror:                                                               13045000
      no'error:=false; << not ccg >>                                    13050000
exit:                                                                   13055000
  end;                                                                  13060000
                                                                        13065000
<< check lcmp instruction >>                                            13070000
                                                                        13075000
procedure lcmp'test;                                                    13080000
  begin                                                                 13085000
      assemble(                                                         13090000
      dzro,dzro;                                               <<j8932>>13095000
      ldi 1;                                                            13100000
      load nmax;  << %100000 >>                                         13105000
      dup,lcmp;                                                         13110000
      be *+2;                                                           13115000
      br lcmperror;                   << not cce >>                     13120000
      cmpi 1;                                                           13125000
      be *+2;                                                           13130000
      br lcmperror;                   << stack not popped >>            13135000
                                                                        13140000
      ldni 1;                                                           13145000
      load nmax;   << %177777 : %100000 >>                              13150000
      dzro,dzro;                                               <<j8676>>13155000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>13160000
      lcmp;                                                             13165000
      bg *+2;                                                           13170000
      br lcmperror;                   << not ccg >>                     13175000
                                                                        13180000
      load nmax;                                                        13185000
      zero,lcmp;                                                        13190000
      bg *+2;                                                           13195000
      br lcmperror;                   << not ccg >>                     13200000
                                                                        13205000
      dzro,deca;                                                        13210000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>13215000
      lcmp;   << %000000:%177777 >>                                     13220000
      bl exit);                                                         13225000
lcmperror:                                                              13230000
      no'error:=false;                   << not ccl >>                  13235000
exit:                                                                   13240000
  end;                                                                  13245000
                                                                        13250000
<< check ladd instruction >>                                            13255000
                                                                        13260000
procedure ladd'test;                                                    13265000
  begin                                                                 13270000
      assemble(                                                         13275000
      dzro,dzro;                                               <<j8932>>13280000
      load bit1;                                                        13285000
      dup;                                                              13290000
      dzro,dzro;                                               <<j8676>>13295000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>13300000
      ladd;                                                             13305000
      bl *+2;                                                           13310000
      br ladderror;                   << not ccl >>                     13315000
      bnov *+2;                                                         13320000
      br ladderror;                   << o not 0 >>                     13325000
      bncy *+2;                                                         13330000
      br ladderror;                   << c not 0 >>                     13335000
      cmpm nmax;                                                        13340000
      be *+2;                                                           13345000
      br ladderror;                   << tos not %100000 >>             13350000
                                                                        13355000
      ldni 1;                                                           13360000
      ldni 2;                                                           13365000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>13370000
      ladd;                                                             13375000
      bl *+2;                                                           13380000
      br ladderror;                   << not ccl >>                     13385000
      bcy *+2;                                                          13390000
      br ladderror;                   << c not 1 >>                     13395000
      cmpn 3;                                                           13400000
      be *+2;                                                           13405000
      br ladderror;                   << tos not %177775 >>             13410000
                                                                        13415000
      ldi 4;                                                            13420000
      dup,ladd;                                                         13425000
      bg *+2;                                                           13430000
      br ladderror;                   << not ccg >>                     13435000
      bncy *+2;                                                         13440000
      br ladderror;                   << c not 0 >>                     13445000
      cmpi 8;                                                           13450000
      be exit);                                                         13455000
ladderror:                                                              13460000
      no'error:=false;               << tos not 8 >>                    13465000
exit:                                                                   13470000
  end;                                                                  13475000
                                                                        13480000
<< check lsub instruction >>                                            13485000
                                                                        13490000
procedure lsub'test;                                                    13495000
  begin                                                                 13500000
      assemble(                                                         13505000
      dzro,dzro;                                               <<j8932>>13510000
      ldni 1;                                                           13515000
      ldi 1;                                                            13520000
      dzro,dzro;                                               <<j8676>>13525000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>13530000
      lsub;                                                             13535000
      bl *+2;                                                           13540000
      br lsuberror;                   << not ccl >>                     13545000
      bcy *+2;                                                          13550000
      br lsuberror;                   << c not 1 >>                     13555000
      cmpn 2;                                                           13560000
      be *+2;                                                           13565000
      br lsuberror;                   << tos not %1777776 >>            13570000
                                                                        13575000
      ldi 3;                                                            13580000
      ldi 10;                                                           13585000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>13590000
      lsub;                                                             13595000
      bl *+2;                 << not ccl >>                             13600000
      br lsuberror;                   << not ccg >>                     13605000
      bncy *+2;                                                         13610000
      br lsuberror;                   << c not 0 >>                     13615000
      cmpn 7;                                                           13620000
      be *+2;                                                           13625000
      br lsuberror;                   << tos not -7 >>                  13630000
                                                                        13635000
<< check lsub instruction >>                                            13640000
                                                                        13645000
      ldni 1;                                                           13650000
      ldi 1;                                                            13655000
      dzro,dzro;                                               <<j8676>>13660000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>13665000
      nop,lsub;                                                         13670000
      bl *+2;                                                           13675000
      br lsuberror;                   << not ccl >>                     13680000
      bcy *+2;                                                          13685000
      br lsuberror;                   << c not 1 >>                     13690000
      cmpn 2;                                                           13695000
      be *+2;                                                           13700000
      br lsuberror;                   << tos not %1777776 >>            13705000
                                                                        13710000
      ldi 3;                                                            13715000
      ldi 10;                                                           13720000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>13725000
      nop,lsub;                                                         13730000
      bl *+2;                 << not ccl >>                             13735000
      br lsuberror;                   << not ccg >>                     13740000
      bncy *+2;                                                         13745000
      br lsuberror;                   << c not 0 >>                     13750000
      cmpn 7;                                                           13755000
      be exit);                                                         13760000
lsuberror:                                                              13765000
      no'error:=false;                 << tos not -7 >>                 13770000
exit:                                                                   13775000
  end;                                                                  13780000
                                                                        13785000
                                                                        13790000
<< check lmpy instruction >>                                            13795000
                                                                        13800000
procedure lmpy'test;                                                    13805000
  begin                                                                 13810000
      assemble(                                                         13815000
      dzro,dzro;                                               <<j8932>>13820000
      load pmax;  << %077777 >>                                         13825000
      ldi 2;                                                            13830000
      dzro,dzro;                                               <<j8676>>13835000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>13840000
      lmpy;                                                             13845000
      bg *+2;                                                           13850000
      br lmpyerror;                   << not ccg >>                     13855000
      bncy *+2;                                                         13860000
      br lmpyerror;                   << c not 0 >>                     13865000
      cmpn 2;                                                           13870000
      be *+2;                                                           13875000
      br lmpyerror;                   << tos not %177776 >>             13880000
      cmpi 0;                                                           13885000
      be *+2;                                                           13890000
      br lmpyerror;                   << (s-1) not 0 >>                 13895000
                                                                        13900000
      ldni 1;                                                           13905000
      ldi 4;                                                            13910000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>13915000
      lmpy;                                                             13920000
      bg *+2;                                                           13925000
      br lmpyerror;                   << not ccg >>                     13930000
      bcy *+2;                                                          13935000
      br lmpyerror;                   << c not 1 >>                     13940000
      cmpn 4;                                                           13945000
      be *+2;                                                           13950000
      br lmpyerror;                   << tos not %177774 >>             13955000
      cmpi 3;                                                           13960000
      be *+2;                                                           13965000
      br lmpyerror;                   << (s-1) not 3 >>                 13970000
                                                                        13975000
      ldni 1;                                                           13980000
      zero,lmpy;                                                        13985000
      be *+2;                                                           13990000
      br lmpyerror;                   << not cce >>                     13995000
      bncy *+2;                                                         14000000
      br lmpyerror;                   << c not 0 >>                     14005000
      dzro,lcmp;                                                        14010000
      be exit);                                                         14015000
lmpyerror:                                                              14020000
      no'error:=false;               << (s-1,s) not 0,0 >>              14025000
exit:                                                                   14030000
  end;                                                                  14035000
                                                                        14040000
<< check ldiv instruction >>                                            14045000
                                                                        14050000
procedure ldiv'test;                                                    14055000
  begin                                                                 14060000
      assemble(                                                         14065000
      dzro,dzro;                                               <<j8932>>14070000
      zero;   << try 19/5 >>                                            14075000
      ldi 19;                                                           14080000
      ldi 5;                                                            14085000
      dzro,dzro;                                               <<j8676>>14090000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>14095000
      ldiv;                                                             14100000
      bg *+2;                                                           14105000
      br ldiverror;                   << not ccg >>                     14110000
      bnov *+2;                                                         14115000
      br ldiverror;                   << o not 0 >>                     14120000
      cmpi 4;                                                           14125000
      be *+2;                                                           14130000
      br ldiverror;                   << tos not 4 --- remainder  >>    14135000
      cmpi 3;                                                           14140000
      be *+2;                                                           14145000
      br ldiverror;                   << (s-1) not 3 --- quotient >>    14150000
                                                                        14155000
      ldi 1;   << try 2**16/1 >>                                        14160000
      zero;                                                             14165000
      ldi 1;                                                            14170000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>14175000
      ldiv;                                                             14180000
      be *+2;                                                           14185000
      br ldiverror;                   << not cce >>                     14190000
      bov *+2;                                                          14195000
      br ldiverror;                                                     14200000
      dzro,dcmp;                                                        14205000
      be *+2;                                                           14210000
      br ldiverror;                   << (s-1,s) not 0,0 >>             14215000
                                                                        14220000
      ldi 7;  << (2**19-1)/8 >>                                         14225000
      ldni 1;                                                           14230000
      ldi 8;                                                            14235000
      ldiv;                                                             14240000
      bl *+2;                                                           14245000
      br ldiverror;                   << not ccl >>                     14250000
      bnov *+2;                                                         14255000
      br ldiverror;                   << o not 0 >>                     14260000
      cmpi 7;                                                           14265000
      be *+2;                                                           14270000
      br ldiverror;                   << remainder not 7 >>             14275000
      cmpn 1;                                                           14280000
      be *+2;                                                           14285000
      br ldiverror;                << quotient = (s-1) not 2**16-1 >>   14290000
                                                                        14295000
      ldi 1;                                                            14300000
      dup,zero;                                                         14305000
      ldiv;                                                             14310000
      bov *+2;                                                          14315000
      br ldiverror;                   << o not 1 >>                     14320000
                                                                        14325000
      zero;    << try (2**16-1)/2**15 >>                                14330000
      ldni 1;                                                           14335000
      load nmax;                                                        14340000
      ldiv;                                                             14345000
      bg *+2;                                                           14350000
      br ldiverror;                   << not ccg >>                     14355000
      bnov *+2;                                                         14360000
      br ldiverror;                   << o not 0 >>                     14365000
      cmpm pmax;                                                        14370000
      be *+2;                                                           14375000
      br ldiverror;                   << remainder not %177777 >>       14380000
      cmpi 1;                                                           14385000
      be *+2;                                                           14390000
      br ldiverror;                  << quotient not 1 >>               14395000
                                                                        14400000
<< check ldiv instruction >>                                            14405000
                                                                        14410000
      zero;   << try 19/5 >>                                            14415000
      ldi 19;                                                           14420000
      ldi 5;                                                            14425000
      dzro,dzro;                                               <<j8676>>14430000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>14435000
      nop,ldiv;                                                         14440000
      bg *+2;                                                           14445000
      br ldiverror;                   << not ccg >>                     14450000
      bnov *+2;                                                         14455000
      br ldiverror;                   << o not 0 >>                     14460000
      cmpi 4;                                                           14465000
      be *+2;                                                           14470000
      br ldiverror;                   << tos not 4 --- remainder  >>    14475000
      cmpi 3;                                                           14480000
      be *+2;                                                           14485000
      br ldiverror;                   << (s-1) not 3 --- quotient >>    14490000
                                                                        14495000
      ldi 1;   << try 2**16/1 >>                                        14500000
      zero;                                                             14505000
      ldi 1;                                                            14510000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>14515000
      nop,ldiv;                                                         14520000
      be *+2;                                                           14525000
      br ldiverror;                   << not cce >>                     14530000
      bov *+2;                                                          14535000
      br ldiverror;                                                     14540000
      dzro,dcmp;                                                        14545000
      be *+2;                                                           14550000
      br ldiverror;                   << (s-1,s) not 0,0 >>             14555000
                                                                        14560000
      ldi 7;  << (2**19-1)/8 >>                                         14565000
      ldni 1;                                                           14570000
      ldi 8;                                                            14575000
      nop,ldiv;                                                         14580000
      bl *+2;                                                           14585000
      br ldiverror;                   << not ccl >>                     14590000
      bnov *+2;                                                         14595000
      br ldiverror;                   << o not 0 >>                     14600000
      cmpi 7;                                                           14605000
      be *+2;                                                           14610000
      br ldiverror;                   << remainder not 7 >>             14615000
      cmpn 1;                                                           14620000
      be *+2;                                                           14625000
      br ldiverror;                   << quotient = (s-1) not 2**16-1 >>14630000
                                                                        14635000
      ldi 1;                                                            14640000
      dup,zero;                                                         14645000
      nop,ldiv;                                                         14650000
      bov *+2;                                                          14655000
      br ldiverror;                   << o not 1 >>                     14660000
                                                                        14665000
      zero;    << try (2**16-1)/2**15 >>                                14670000
      ldni 1;                                                           14675000
      load nmax;                                                        14680000
      nop,ldiv;                                                         14685000
      bg *+2;                                                           14690000
      br ldiverror;                   << not ccg >>                     14695000
      bnov *+2;                                                         14700000
      br ldiverror;                   << o not 0 >>                     14705000
      cmpm pmax;                                                        14710000
      be *+2;                                                           14715000
      br ldiverror;                   << remainder not %177777 >>       14720000
      cmpi 1;                                                           14725000
      be exit;                                                          14730000
      br ldiverror);                  << quotient not 1 >>              14735000
                                                                        14740000
ldiverror:                                                              14745000
       no'error:=false;                                                 14750000
exit:                                                                   14755000
  end;                                                                  14760000
                                                                        14765000
procedure soi;   << more stackop instructions >>                        14770000
   begin                                                                14775000
                                                                        14780000
       move instruct'name:="BTST  ";                                    14785000
       print'names;                                                     14790000
       while no'error and (i:=i+1) < loopnumber do btst'test;           14795000
       if no'error then testbtst;      << check 256 combinations >>     14800000
                                                                        14805000
       move instruct'name:="TEST  ";                                    14810000
       print'names;                                                     14815000
       while no'error and (i:=i+1) < loopnumber do test'test;           14820000
                                                                        14825000
       move instruct'name:="DTST  ";                                    14830000
       print'names;                                                     14835000
       while no'error and (i:=i+1) < loopnumber do dtst'test;           14840000
                                                                        14845000
       move instruct'name:="NOT   ";                                    14850000
       print'names;                                                     14855000
       while no'error and (i:=i+1) < loopnumber do not'test;            14860000
                                                                        14865000
       move instruct'name:="NEG   ";                                    14870000
       print'names;                                                     14875000
       while no'error and (i:=i+1) < loopnumber do neg'test;            14880000
                                                                        14885000
       move instruct'name:="XCH   ";                                    14890000
       print'names;                                                     14895000
       while no'error and (i:=i+1) < loopnumber do xch'test;            14900000
                                                                        14905000
       move instruct'name:="DXCH  ";                                    14910000
       print'names;                                                     14915000
       while no'error and (i:=i+1) < loopnumber do dxch'test;           14920000
                                                                        14925000
       move instruct'name:="CAB   ";                                    14930000
       print'names;                                                     14935000
       while no'error and (i:=i+1) < loopnumber do cab'test;            14940000
                                                                        14945000
       move instruct'name:="LCMP  ";                                    14950000
       print'names;                                                     14955000
       while no'error and (i:=i+1) < loopnumber do lcmp'test;           14960000
                                                                        14965000
       move instruct'name:="LADD  ";                                    14970000
       print'names;                                                     14975000
       while no'error and (i:=i+1) < loopnumber do ladd'test;           14980000
                                                                        14985000
       move instruct'name:="LSUB  ";                                    14990000
       print'names;                                                     14995000
       while no'error and (i:=i+1) < loopnumber do lsub'test;           15000000
                                                                        15005000
       move instruct'name:="LMPY  ";                                    15010000
       print'names;                                                     15015000
       while no'error and (i:=i+1) < loopnumber do lmpy'test;           15020000
                                                                        15025000
       move instruct'name:="LDIV  ";                                    15030000
       print'names;                                                     15035000
       while no'error and (i:=i+1) < loopnumber do ldiv'test;           15040000
                                                                        15045000
       loopctn:=0; x:=stepno;                                           15050000
       stepno:=stepno+1;                                                15055000
                                                                        15060000
   end;   << soi >>                                                     15065000
                                                                        15070000
procedure liam;   << load instruction - all addressing modes >>         15075000
   begin                                                                15080000
       move instruct'name:="LOAD  ";                                    15085000
       print'names;                                                     15090000
star: assemble(                                                         15095000
<< load instruction - all addressing modes >>                           15100000
                                                                        15105000
      load load1;   << mode 1: p+d >>                                   15110000
      cmpi 22;                                                          15115000
      be *+2;                                                           15120000
      br loaderror;                   << tos not 22 >>                  15125000
                                                                        15130000
      ldxi 1;                                                           15135000
      load load1,x;   << mode 2: p+d+x >>                               15140000
      cmpn 17;                                                          15145000
      be *+2;                                                           15150000
      br loaderror;                   << tos not -17 >>                 15155000
                                                                        15160000
      load load3,i;   << mode 3: (p+d)+p+d >>                           15165000
      cmpi 45;                                                          15170000
      be *+2;                                                           15175000
      br loaderror;                   << tos not 45 >>                  15180000
                                                                        15185000
      ldxn 1;                                                           15190000
      load load3,i,x;   << mode 4: (p+d)+p+d+x >>                       15195000
      cmpi 5;                                                           15200000
      be *+2;                                                           15205000
      br loaderror;                   << tos not 5 >>                   15210000
                                                                        15215000
      br loadcon;   << skip over constants >>                           15220000
load1: con 22;                                                          15225000
       con -17;                                                         15230000
load3: con 2;                                                           15235000
       con 5;                                                           15240000
       con 45;                                                          15245000
load5: con -24;                                                         15250000
load7: con -3;                                                          15255000
loadcon:                                                                15260000
                                                                        15265000
      load load5;   << mode 5: p-d >>                                   15270000
      cmpn 24;                                                          15275000
      be *+2;                                                           15280000
      br loaderror;                   << tos not -24 >>                 15285000
                                                                        15290000
      ldxi 3;                                                           15295000
      load load3,x;   << mode 6: p-d+x >>                               15300000
      cmpn 24;                                                          15305000
      be *+2;                                                           15310000
      br loaderror;                   << tos not -24 >>                 15315000
                                                                        15320000
      load load7,i;   << mode 7:   (p-d)+p-d  >>                        15325000
      cmpi 5;                                                           15330000
      be *+2;                                                           15335000
      br loaderror;                   << tos not 5 >>                   15340000
                                                                        15345000
      ldxi 2;                                                           15350000
      load load7,i,x;   << mode 8: (p-d)+x+p-d >>                       15355000
      cmpn 24;                                                          15360000
      be *+2;                                                           15365000
      br loaderror;                   << tos not -24 >>                 15370000
                                                                        15375000
      load m1;   << mode 9: db+d >>                                     15380000
      cmpn 1;                                                           15385000
      be *+2;                                                           15390000
      br loaderror;                   << tos not -1 >>                  15395000
                                                                        15400000
      ldi 17;                                                           15405000
      stor db+%13;                                                      15410000
      ldxi %12;                                                         15415000
      load db+1,x;   << mode 10: db+d+x >>                              15420000
      cmpi 17;                                                          15425000
      be *+2;                                                           15430000
      br loaderror;                   << tos not 17 >>                  15435000
                                                                        15440000
      ldni 69;                                                          15445000
      stor db+%10;                                                      15450000
      ldi %10;                                                          15455000
      stor db+%12;                                                      15460000
      load db+%12,i;   << mode 11: (db+d)+db >>                         15465000
      cmpn 69;                                                          15470000
      be *+2;                                                           15475000
      br loaderror;                   << tos not -69 >>                 15480000
                                                                        15485000
      ldi 99;                                                           15490000
      stor db+%13;                                                      15495000
      ldi %10;                                                          15500000
      stor db+7;                                                        15505000
      ldxi 3;                                                           15510000
      load db+7,i,x;   << mode 12: (db+d)+db+x >>                       15515000
      cmpi 99;                                                          15520000
      be *+2;                                                           15525000
      br loaderror;                   << tos not 99 >>                  15530000
                                                                        15535000
      ldni 17;                                                          15540000
      ldi 0;                                                            15545000
      ldi 26;                                                           15550000
      ldi %11;                                                          15555000
      ldni 2;                                                           15560000
      ldi 4;                                                            15565000
      load s-0;   << mode 21: s-d >>                                    15570000
      cmpi 4;                                                           15575000
      be *+2;                                                           15580000
      br loaderror;                   << tos not 4 >>                   15585000
      load s-1;                                                         15590000
      cmpn 2;                                                           15595000
      be *+2;                                                           15600000
      br loaderror;                   << tos not -2 >>                  15605000
      load s-2;                                                         15610000
      cmpi %11;                                                         15615000
      be *+2;                                                           15620000
      br loaderror;                   << tos not %11 >>                 15625000
      load s-3;                                                         15630000
      cmpi 26;                                                          15635000
      be *+2;                                                           15640000
      br loaderror;                   << tos not 26 >>                  15645000
      load s-4;                                                         15650000
      cmpi 0;                                                           15655000
      be *+2;                                                           15660000
      br loaderror;                   << tos not 0 >>                   15665000
      load s-5;                                                         15670000
      cmpn 17;                                                          15675000
      be *+2;                                                           15680000
      br loaderror;                   << tos not -17 >>                 15685000
                                                                        15690000
      ldxn 5;                                                           15695000
      load s-0,x;   << mode 22: s-d+x >>                                15700000
      cmpn 17;                                                          15705000
      be *+2;                                                           15710000
      br loaderror;                   << tos not -17 >>                 15715000
      ldxi 5;                                                           15720000
      load s-5,x;                                                       15725000
      cmpi 4;                                                           15730000
      be *+2;                                                           15735000
      br loaderror;                   << tos not 4 >>                   15740000
                                                                        15745000
      ldi 19;                                                           15750000
      stor db+%11;                                                      15755000
      load s-2,i;   << mode 23: (s-d)+db >>                             15760000
      cmpi 19;                                                          15765000
      be *+2;                                                           15770000
      br loaderror;                   << tos not 19 >>                  15775000
                                                                        15780000
      ldi 25;                                                           15785000
      stor db+%7;                                                       15790000
      ldxn 2;                                                           15795000
      load s-2,i,x;   << mode 24: (s-d)+x+db >>                         15800000
      cmpi 25;                                                          15805000
      be *+2;                                                           15810000
      br loaderror;                   << tos not 25 >>                  15815000
                                                                        15820000
      pshr 2;   << push q >>                                            15825000
      setr 1;   << set s >>                                             15830000
      ldi %12;  << will be (q-3) >>                                     15835000
      ldni 2;   << will be (q-2) >>                                     15840000
      ldi 1;    << will be (q-1) >>                                     15845000
      ldni 3;   << will be (q) >>                                       15850000
      pshr 2;   << push q >>                                            15855000
      addi 4;                                                           15860000
      dup;                                                              15865000
      setr 2;   << q := old q+4 >>                                      15870000
      setr 1;   << s := old q+4 >>                                      15875000
      ldi %13;  << q+1 >>                                               15880000
      ldni 7;   << q+2 >>                                               15885000
      ldi %14;   << q+3 >>                                              15890000
      ldni 6;   << q+4 >>                                               15895000
                                                                        15900000
      load q+2;   << mode 13: q+d >>                                    15905000
      cmpn 7;                                                           15910000
      be *+2;                                                           15915000
      br loaderror;                   << tos not -7 >>                  15920000
                                                                        15925000
      load q+0;                                                         15930000
      cmpn 3;                                                           15935000
      be *+2;                                                           15940000
      br loaderror;                   << tos not -3 >>                  15945000
                                                                        15950000
      ldxi 2;     << mode 14: q+d+x >>                                  15955000
      load q+1,x;                                                       15960000
      cmpi %14;                                                         15965000
      be *+2;                                                           15970000
      br loaderror;                   << tos not 14 >>                  15975000
                                                                        15980000
      ldi 58;     << mode 15: (q+d)+db >>                               15985000
      stor db+%13;                                                      15990000
      load q+1,i;                                                       15995000
      cmpi 58;                                                          16000000
      be *+2;                                                           16005000
      br loaderror;                   << tos not 58 >>                  16010000
                                                                        16015000
      ldni 34;    << mode 16: (q+d)+x+db >>                             16020000
      stor db+%10;                                                      16025000
      ldxn 4;                                                           16030000
      load q+3,i,x;                                                     16035000
      cmpn 34;                                                          16040000
      be *+2;                                                           16045000
      br loaderror;                   << tos not -34 >>                 16050000
                                                                        16055000
      load q-1;   << mode 17: q-d >>                                    16060000
      cmpi 1;                                                           16065000
      be *+2;                                                           16070000
      br loaderror;                   << tos not 1 >>                   16075000
                                                                        16080000
      ldxi 1;     << mode 18: q-d+x >>                                  16085000
      load q-3,x;                                                       16090000
      cmpn 2;                                                           16095000
      be *+2;                                                           16100000
      br loaderror;                   << tos not -2 >>                  16105000
                                                                        16110000
      ldni 23;    << mode 19: (q-d)+db >>                               16115000
      stor db+%12;                                                      16120000
      load q-3,i;                                                       16125000
      cmpn 23;                                                          16130000
      be *+2;                                                           16135000
      br loaderror;                   << tos not -23 >>                 16140000
                                                                        16145000
      ldi 77;     << mode 20: (q-d)+x+db >>                             16150000
      stor db+%11;                                                      16155000
      ldxi %10;                                                         16160000
      load q-1,i,x;                                                     16165000
      cmpi 77;                                                          16170000
      be noerror;                                                       16175000
      br loaderror);                      << tos not 77 >>              16180000
                                                                        16185000
noerror: assemble(                                                      16190000
      pshr 2;                                                           16195000
      subi 4;                                                           16200000
      setr 2);   << restore q >>                                        16205000
       push(q);set(s); <<reset stack>>                                  16210000
       if(loopctn:=loopctn+1)=loopnumber then go out                    16215000
       else go star;                                                    16220000
                                                                        16225000
loaderror:                                                              16230000
      no'error:=false;                                                  16235000
                                                                        16240000
out:   loopctn:=0;                                                      16245000
                                                                        16250000
end;   << liam >>                                                       16255000
                                                                        16260000
procedure stor'test;   << check stor instruction >>                     16265000
   begin                                                                16270000
      assemble(                                                         16275000
                                                                        16280000
                                                                        16285000
<< check stor q+ instruction >>                                         16290000
                                                                        16295000
      adds 10;                                                          16300000
      ldi 5;                                                            16305000
      stor q+2;                                                         16310000
      load q+2;                                                         16315000
      cmpi 5;                                                           16320000
      be *+2;                                                           16325000
      br storerror;                   << (q+2) not 5 >>                 16330000
                                                                        16335000
<< check stor q- instruction >>                                         16340000
                                                                        16345000
      load q-3;                                                         16350000
      stax;   << save (q-3) >>                                          16355000
      ldi 6;                                                            16360000
      stor q-3;                                                         16365000
      load q-3;                                                         16370000
      cmpi 6;                                                           16375000
      be *+2;                                                           16380000
      br storerror;                   << (q-3) not 6 >>                 16385000
      ldxa;                                                             16390000
      stor q-3;   << restore (q-3) >>                                   16395000
                                                                        16400000
<< check stor s- instruction >>                                         16405000
                                                                        16410000
      ldi 4;                                                            16415000
      ldi 5;                                                            16420000
      stor s-0;                                                         16425000
      cmpi 4;                                                           16430000
      be *+2;                                                           16435000
      br storerror;                   << tos not 4 >>                   16440000
                                                                        16445000
      ldi 1;                                                            16450000
      ldi 2;                                                            16455000
      ldi 3;                                                            16460000
      stor s-1;                                                         16465000
      cmpi 3;                                                           16470000
      be *+2;                                                           16475000
      br storerror;                   << tos not 3 >>                   16480000
      cmpi 1;                                                           16485000
      be *+2;                                                           16490000
      br storerror;                   << (s-1) not 1 >>                 16495000
                                                                        16500000
<< check stor q+d,i,x instruction >>                                    16505000
                                                                        16510000
      ldi 0;                                                            16515000
      stor var5;                                                        16520000
      ldi %10;                                                          16525000
      stor q+2;                                                         16530000
      ldxi 3;                                                           16535000
      ldi 7;                                                            16540000
      stor q+2,i,x;   << e=db+%13>>                                     16545000
      load var5;                                                        16550000
      cmpi 7;                                                           16555000
      be *+2;                                                           16560000
      br storerror;                   << (db+%13) not 7 >>              16565000
                                                                        16570000
<< check stor db+d,i,x instruction >>                                   16575000
                                                                        16580000
      ldi 0;                                                            16585000
      stor var6;                                                        16590000
      ldi %11;                                                          16595000
      stor var0;                                                        16600000
      ldxi 3;                                                           16605000
      ldi %111;                                                         16610000
      stor var0,i,x;   << e=db+%14 >>                                   16615000
      load var6;                                                        16620000
      cmpi %111;                                                        16625000
      be *+2;                                                           16630000
      br storerror;                   << (db+%14) not %111 >>           16635000
                                                                        16640000
<< check stor q-d,i,x instruction >>                                    16645000
                                                                        16650000
      load q-1;                                                         16655000
      stor var0;   << save (q-1) >>                                     16660000
      ldi %11;                                                          16665000
      stor q-1;                                                         16670000
      ldxi 4;                                                           16675000
      ldi 20;                                                           16680000
      stor q-1,i,x;   << e=db+%15 >>                                    16685000
      load var7;                                                        16690000
      cmpi 20;                                                          16695000
      be *+2;                                                           16700000
      br storerror;                   << (db+%15) not 20 >>             16705000
      load var0;                                                        16710000
      stor q-1;   << restore (q-1) >>                                   16715000
                                                                        16720000
<< check s-d,i,x instruction >>                                         16725000
                                                                        16730000
      ldxi 3;                                                           16735000
      ldi %10;                                                          16740000
      ldi 10;                                                           16745000
      stor s-1,i,x;   << e=db+%13 >>                                    16750000
      cmpi %10;                                                         16755000
      be *+2;                                                           16760000
      br storerror;                   << tos not 2 >>                   16765000
      load var5;                                                        16770000
      cmpi 10;                                                          16775000
      be exit);                                                         16780000
storerror:                                                              16785000
      no'error:=false;                   << (db+%13) not 10 >>          16790000
exit:                                                                   16795000
   end;                                                                 16800000
                                                                        16805000
<< check addm db+ instruction >>                                        16810000
                                                                        16815000
procedure addm'test;                                                    16820000
   begin                                                                16825000
      assemble(                                                         16830000
      dzro,dzro;                                               <<j8932>>16835000
      zero;                   << 0+1 = 1 >>                             16840000
      dzro,dzro;                                               <<j8676>>16845000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>16850000
      addm p1;                                                          16855000
      bg *+2;                                                           16860000
      br addmerror;                   << not ccg >>                     16865000
      bnov *+2;                                                         16870000
      br addmerror;                   << o not 0 >>                     16875000
      bncy *+2;                                                         16880000
      br addmerror;                   << c not 0 >>                     16885000
      cmpi 1;                                                           16890000
      be *+2;                                                           16895000
      br addmerror;                   << tos not 1 >>                   16900000
                                                                        16905000
      ldni 1;   << -1+1 = 0>>                                           16910000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>16915000
      addm p1;                                                          16920000
      be *+2;                                                           16925000
      br addmerror;                   << not cce >>                     16930000
      bnov *+2;                                                         16935000
      br addmerror;                   << o not 0 >>                     16940000
      bcy *+2;                                                          16945000
      br addmerror;                   << c not 1 >>                     16950000
      cmpi 0;                                                           16955000
      be *+2;                                                           16960000
      br addmerror;                   << tos not 0 >>                   16965000
                                                                        16970000
      ldi 1;     << 1+%077777 = %100000 >>                              16975000
      addm pmax;                                                        16980000
      bl *+2;                                                           16985000
      br addmerror;                   << not ccl >>                     16990000
      bov *+2;                                                          16995000
      br addmerror;                   << o not 1 >>                     17000000
      bncy *+2;                                                         17005000
      br addmerror;                   << c not 0 >>                     17010000
      cmpm nmax;                                                        17015000
      be *+2;                                                           17020000
      br addmerror;                   << tos not %100000 >>             17025000
                                                                        17030000
<< check addm s- instruction >>                                         17035000
                                                                        17040000
      ldi 2;                                                            17045000
      ldi 3;                                                            17050000
      addm s-1;                                                         17055000
      cmpi 5;                                                           17060000
      be *+2;                                                           17065000
      br addmerror;                   << tos not 5 >>                   17070000
      cmpi 2;                                                           17075000
      be *+2;                                                           17080000
      br addmerror;                   << (s-1) not 2 >>                 17085000
                                                                        17090000
      ldi 4;                                                            17095000
      ldi 5;                                                            17100000
      addm s-0;                                                         17105000
      cmpi 10;                                                          17110000
      be *+2;                                                           17115000
      br addmerror;                   << tos not 10 >>                  17120000
      cmpi 4;                                                           17125000
      be *+2;                                                           17130000
      br addmerror;                   << (s-1) not 4 >>                 17135000
                                                                        17140000
<< check addm p+ instruction >>                                         17145000
                                                                        17150000
      ldi 0;                                                            17155000
      addm c1;   << 1 >>                                                17160000
      cmpi 1;                                                           17165000
      be exit;                                                          17170000
      br addmerror;                                                     17175000
c1:   con 1;                                                            17180000
p1:    );                                                               17185000
addmerror:                                                              17190000
      no'error:=false;                                                  17195000
exit:                                                                   17200000
   end;                                                                 17205000
                                                                        17210000
<< check subm db+ instruction >>                                        17215000
                                                                        17220000
procedure subm'test;                                                    17225000
   begin                                                                17230000
      assemble(                                                         17235000
      dzro,dzro;                                               <<j8932>>17240000
      ldi 1;    << 1-1 =0 >>                                            17245000
      dzro,dzro;                                               <<j8676>>17250000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>17255000
      subm p1;                                                          17260000
      be *+2;                                                           17265000
      br submerror;                   << not cce >>                     17270000
      bnov *+2;                                                         17275000
      br submerror;                   << o not 0 >>                     17280000
      bcy *+2;                                                          17285000
      br submerror;                   << c not 1 >>                     17290000
      cmpi 0;                                                           17295000
      be *+2;                                                           17300000
      br submerror;                   << tos not 0 >>                   17305000
                                                                        17310000
      load pmax;   << %077777 -(-1) = %100000 >>                        17315000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>17320000
      subm m1;                                                          17325000
      bl *+2;                                                           17330000
      br submerror;                   << not ccl >>                     17335000
      bov *+2;                                                          17340000
      br submerror;                   << o not 1 >>                     17345000
      bncy *+2;                                                         17350000
      br submerror;                   << c not 0 >>                     17355000
      cmpm nmax;                                                        17360000
      be *+2;                                                           17365000
      br submerror;                   << tos not %100000 >>             17370000
                                                                        17375000
<< check subm s- instruction >>                                         17380000
                                                                        17385000
      ldi 1;                                                            17390000
      ldi 2;                                                            17395000
      ldi 5;                                                            17400000
      subm s-2;                                                         17405000
      cmpi 4;                                                           17410000
      be *+2;                                                           17415000
      br submerror;                   << tos not 4 >>                   17420000
      cmpi 2;                                                           17425000
      be *+2;                                                           17430000
      br submerror;                   << (s-1) not 2 >>                 17435000
                                                                        17440000
<< check subm p+ instruction >>                                         17445000
      ldi 1;                                                            17450000
      subm c2;   << -2 >>                                               17455000
      cmpn 1;                                                           17460000
      be exit;                                                          17465000
      br submerror;                                                     17470000
c2:   con 2;                                                            17475000
p1:    );                                                               17480000
submerror:                                                              17485000
      no'error:=false;                                                  17490000
exit:                                                                   17495000
   end;                                                                 17500000
                                                                        17505000
<< check mpym db+ instruction >>                                        17510000
procedure mpym'test;                                                    17515000
   begin                                                                17520000
                                                                        17525000
cmpym:assemble(                                                         17530000
      dzro,dzro;                                               <<j8932>>17535000
      ldi 17;   << 17*(-1) = -17 >>                                     17540000
      dzro,dzro;                                               <<j8676>>17545000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>17550000
      mpym m1;                                                          17555000
      bl *+2;                                                           17560000
      br mpymerror;                   << not ccl >>                     17565000
      bnov *+2;                                                         17570000
      br mpymerror;                   << o not 0 >>                     17575000
      cmpn 17;                                                          17580000
      be *+2;                                                           17585000
      br mpymerror;                   << tos not -17 >>                 17590000
                                                                        17595000
      ldi 2;   << 2 * %077777 = %177776 >>                              17600000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>17605000
      mpym pmax;                                                        17610000
      bl *+2;                                                           17615000
      br mpymerror;                   << not ccl >>                     17620000
      bov *+2;                                                          17625000
      br mpymerror;                   << o not 1 >>                     17630000
      cmpn 2;                                                           17635000
      be *+2;                                                           17640000
      br mpymerror;                   << tos not %177776 >>             17645000
                                                                        17650000
<< check mpym s- instruction >>                                         17655000
                                                                        17660000
      ldi 2;                                                            17665000
      ldi 3;                                                            17670000
      mpym s-1;                                                         17675000
      cmpi 6;                                                           17680000
      be *+2;                                                           17685000
      br mpymerror;                   << tos not 6 >>                   17690000
      cmpi 2;                                                           17695000
      be *+2;                                                           17700000
      br mpymerror;                   << (s-1) not 2 >>                 17705000
                                                                        17710000
<< check mpym p+ instruction >>                                         17715000
                                                                        17720000
      ldi 1;                                                            17725000
      mpym c3;                                                          17730000
      cmpi 3;                                                           17735000
      be exit;                                                          17740000
mpymerror:                                                              17745000
      br mpymerror;                                                     17750000
c3:   con 3);                                                           17755000
      no'error:=false;                   << tos not 3 >>                17760000
exit:                                                                   17765000
   end;                                                                 17770000
                                                                        17775000
procedure incm'test;                                                    17780000
   begin                                                                17785000
      integer i,j;   << dummy for local storage >>                      17790000
next1:assemble(                                                         17795000
      br *+6;  << skip over constants >>                                17800000
c1:   con 1;                                                            17805000
c2:   con 2;                                                            17810000
c3:   con 3;                                                            17815000
c4:   con 4;                                                            17820000
c5:   con 5;                                                            17825000
p1:                                                                     17830000
                                                                        17835000
<< check incm db+ instruction >>                                        17840000
                                                                        17845000
      ldni 1;                                                           17850000
      stor var0;  << var0 := -1 >>                                      17855000
      incm var0;                                                        17860000
      be *+2;                                                           17865000
      br incmerror;                   << not cce >>                     17870000
      bnov *+2;                                                         17875000
      br incmerror;                   << o not 0 >>                     17880000
      bcy *+2;                                                          17885000
      br incmerror;                   << c not 1 >>                     17890000
      load var0;                                                        17895000
      cmpi 0;                                                           17900000
      be *+2;                                                           17905000
      br incmerror;                   << (var0) not 0 >>                17910000
                                                                        17915000
      load pmax;                                                        17920000
      stor var1;                                                        17925000
      incm var1;                                                        17930000
      bl *+2;                                                           17935000
      br incmerror;                   << not ccl >>                     17940000
      bov *+2;                                                          17945000
      br incmerror;                   << o not 1 >>                     17950000
      bncy *+2;                                                         17955000
      br incmerror;                   << c not 0 >>                     17960000
      load var1;                                                        17965000
      cmpm bit0;                                                        17970000
      be *+2;                                                           17975000
      br incmerror;                   << (var1) not %100000 >>          17980000
                                                                        17985000
<< check incm q+d instruction >>                                        17990000
                                                                        17995000
      ldi 4;                                                            18000000
      stor q+2;                                                         18005000
      incm q+2;                                                         18010000
      load q+2;                                                         18015000
      cmpi 5;                                                           18020000
      be *+2;                                                           18025000
      br incmerror;                   << (q+2) not 5 >>                 18030000
                                                                        18035000
<< check incm q-d instruction >>                                        18040000
                                                                        18045000
      load q-1;                                                         18050000
      stor var0;                                                        18055000
      ldni 7;                                                           18060000
      stor q-1;                                                         18065000
      incm q-1;                                                         18070000
      load q-1;                                                         18075000
      cmpn 6;                                                           18080000
      be *+2;                                                           18085000
      br incmerror;                   << (q-1) not -6 >>                18090000
      load var0;                                                        18095000
      stor q-1;   << restore (q-1:= >>                                  18100000
                                                                        18105000
<< check incm s-d instruction >>                                        18110000
                                                                        18115000
      ldi 3;   << e in stack reg >>                                     18120000
      incm s-0;                                                         18125000
      cmpi 4;                                                           18130000
      be *+2;                                                           18135000
      br incmerror;                   << tos not 4 >>                   18140000
                                                                        18145000
<< check incm db+d,i,x instruction >>                                   18150000
                                                                        18155000
      ldi 0;                                                            18160000
      stor var5;                                                        18165000
      ldi %7;                                                           18170000
      stor var0;                                                        18175000
      ldxi 4;                                                           18180000
      incm var0,i,x;   << e=db+%13 >>                                   18185000
      load var5;                                                        18190000
      cmpi %1;                                                          18195000
      be *+2;                                                           18200000
      br incmerror;                   << (db+%13) not %1>>              18205000
                                                                        18210000
<< check incm q+d,i,x instruction >>                                    18215000
                                                                        18220000
      adds 4;                                                           18225000
      ldi 0;                                                            18230000
      stor var2;                                                        18235000
      ldxi %7;                                                          18240000
      load q+1;                                                         18245000
      stor var7;                                                        18250000
      ldi 1;                                                            18255000
      stor q+1;                                                         18260000
      incm q+1,i,x;   << e=db+%10 >>                                    18265000
      load var2;                                                        18270000
      cmpi 1;                                                           18275000
      be *+2;                                                           18280000
      br incmerror;                   << (db+%10) not 1 >>              18285000
      load var7;                                                        18290000
      stor q+1;   << restore (q+1) >>                                   18295000
                                                                        18300000
<< check incm q-d,i,x instruction >>                                    18305000
                                                                        18310000
      ldi 0;                                                            18315000
      stor var6;                                                        18320000
      ldxi %12;                                                         18325000
      load q-3;                                                         18330000
      stor var0;   << save (q-3) >>                                     18335000
      ldi 2;                                                            18340000
      stor q-3;                                                         18345000
      incm q-3,i,x;   << e=db+%14 >>                                    18350000
      load var6;                                                        18355000
      cmpi 1;                                                           18360000
      be *+2;                                                           18365000
      br incmerror;                   << (db+%14) not 1 >>              18370000
      load var0;                                                        18375000
      stor q-3;   << restore (q-3) >>                                   18380000
                                                                        18385000
<< check incm s-d,i,x instruction >>                                    18390000
                                                                        18395000
      ldxn 6;                                                           18400000
      ldi %15;                                                          18405000
      ldi 0;                                                            18410000
      stor var1;                                                        18415000
      adds 3;                                                           18420000
      incm s-3,i,x;   << e=db+%7>>                                      18425000
      load var1;                                                        18430000
      cmpi 1;                                                           18435000
      be exit);                                                         18440000
incmerror:                                                              18445000
      no'error:=false;                   << (db+%7) not 1 >>            18450000
exit:                                                                   18455000
   end;                                                                 18460000
                                                                        18465000
<< check decm db+ instruction >>                                        18470000
procedure decm'test;                                                    18475000
   begin                                                                18480000
                                                                        18485000
cdecm:assemble(                                                         18490000
      zero;                                                             18495000
      stor var0;                                                        18500000
      decm var0;                                                        18505000
      bl *+2;                                                           18510000
      br decmerror;                   << not ccl >>                     18515000
      bnov *+2;                                                         18520000
      br decmerror;                   << o not 0 >>                     18525000
      bncy *+2;                                                         18530000
      br decmerror;                   << c not 0 >>                     18535000
      load var0;                                                        18540000
      cmpn 1;                                                           18545000
      be *+2;                                                           18550000
      br decmerror;                   << (var0) not -1 >>               18555000
                                                                        18560000
      load bit0;                                                        18565000
      stor var1;                                                        18570000
      decm var1;                                                        18575000
      bg *+2;                                                           18580000
      br decmerror;                   << not ccg >>                     18585000
      bov *+2;                                                          18590000
      br decmerror;                   << o not 1 >>                     18595000
      bcy *+2;                                                          18600000
      br decmerror;                   << c not 1 >>                     18605000
      load var1;                                                        18610000
      cmpm pmax;                                                        18615000
      be *+2;                                                           18620000
      br decmerror;                   << (var1) not %077777 >>          18625000
                                                                        18630000
<< check decm s- instruction >>                                         18635000
                                                                        18640000
      ldi 3;                                                            18645000
      ldi 7;                                                            18650000
      decm s-1;                                                         18655000
      cmpi 7;                                                           18660000
      be *+2;                                                           18665000
      br decmerror;                   << tos not 7 >>                   18670000
      cmpi 2;                                                           18675000
      be exit);                                                         18680000
decmerror:                                                              18685000
      no'error:=false;                   << (s-1) not 2 >>              18690000
exit:                                                                   18695000
   end;                                                                 18700000
                                                                        18705000
<< check cmpm s- instruction >>                                         18710000
procedure cmpm'test;                                                    18715000
   begin                                                                18720000
                                                                        18725000
cmpm:assemble(                                                          18730000
      ldi 1;                                                            18735000
      ldi 2;                                                            18740000
      ldi 2;                                                            18745000
      cmpm s-1;                                                         18750000
      be *+2;                                                           18755000
      br cmpmerror;                   << not cce >>                     18760000
      cmpi 2;                                                           18765000
      be *+2;                                                           18770000
      br cmpmerror;                   << tos not 2 >>                   18775000
      cmpi 1;                                                           18780000
      be *+2;                                                           18785000
      br cmpmerror;                   << stack trouble >>               18790000
                                                                        18795000
      ldi 5;                                                            18800000
      ldi 6;                                                            18805000
      cmpm s-0;                                                         18810000
      be *+2;                                                           18815000
      br cmpmerror;                   << not cce >>                     18820000
      cmpi 5;                                                           18825000
      be *+2;                                                           18830000
      br cmpmerror;                   << stack trouble >>               18835000
                                                                        18840000
<< check cmpm p- instruction >>                                         18845000
                                                                        18850000
      ldi 4;                                                            18855000
      cmpm c4;   << 4 >>                                                18860000
      be exit;                                                          18865000
cmpmerror:                                                              18870000
      br cmpmerror;                                                     18875000
c4:   con 4);                                                           18880000
      no'error:=false;                   << not cce >>                  18885000
exit:                                                                   18890000
   end;                                                                 18895000
                                                                        18900000
<< check ldx s- instruction >>                                          18905000
procedure ldx'test;                                                     18910000
   begin                                                                18915000
                                                                        18920000
cldx:assemble(                                                          18925000
      ldi 8;                                                            18930000
      ldi 9;                                                            18935000
      ldx s-1;                                                          18940000
      ldxa;                                                             18945000
      cmpi 8;                                                           18950000
      be *+2;                                                           18955000
      br ldxerror;                   << x not 8 >>                      18960000
                                                                        18965000
<< check ldx p- instruction >>                                          18970000
                                                                        18975000
      ldx c5;   << 5 >>                                                 18980000
      ldxa;                                                             18985000
      cmpi 5;                                                           18990000
      be exit;                                                          18995000
ldxerror:                                                               19000000
     br ldxerror;                                                       19005000
c5:  con 5);                                                            19010000
      no'error:=false;                   << x not 5 >>                  19015000
exit:                                                                   19020000
   end;                                                                 19025000
                                                                        19030000
<< check lra s- instruction >>                                          19035000
procedure lra'test;                                                     19040000
   begin                                                                19045000
                                                                        19050000
clra:assemble(                                                          19055000
      pshr 1;   << s >>                                                 19060000
      lra s-1;                                                          19065000
      cmp;                                                              19070000
      be exit);                                                         19075000
      no'error:=false;                  << tos not db rel @ of s-1 >>   19080000
exit:                                                                   19085000
   end;                                                                 19090000
                                                                        19095000
procedure mrtests;   << more memory reference tests >>                  19100000
<< check stor, addm, subm, mpym, incm, decm, cmpm, ldx & lra instr's >> 19105000
                                                                        19110000
   begin                                                                19115000
       while no'error and (i:=i+1) < loopnumber do stor'test;           19120000
       move instruct'name:="STOR  ";                                    19125000
       print'names;                                                     19130000
                                                                        19135000
       while no'error and (i:=i+1) < loopnumber do addm'test;           19140000
       move instruct'name:="ADDM  ";                                    19145000
       print'names;                                                     19150000
                                                                        19155000
       move instruct'name:="SUBM  ";                                    19160000
       print'names;                                                     19165000
       while no'error and (i:=i+1) < loopnumber do subm'test;           19170000
                                                                        19175000
       move instruct'name:="MPYM  ";                                    19180000
       print'names;                                                     19185000
       while no'error and (i:=i+1) < loopnumber do mpym'test;           19190000
                                                                        19195000
       move instruct'name:="INCM  ";                                    19200000
       print'names;                                                     19205000
       while no'error and (i:=i+1) < loopnumber do incm'test;           19210000
                                                                        19215000
       move instruct'name:="DECM  ";                                    19220000
       print'names;                                                     19225000
       while no'error and (i:=i+1) < loopnumber do decm'test;           19230000
                                                                        19235000
       move instruct'name:="CMPM  ";                                    19240000
       print'names;                                                     19245000
       while no'error and (i:=i+1) < loopnumber do cmpm'test;           19250000
                                                                        19255000
       move instruct'name:="LDX   ";                                    19260000
       print'names;                                                     19265000
       while no'error and (i:=i+1) < loopnumber do ldx'test;            19270000
                                                                        19275000
       move instruct'name:="LRA   ";                                    19280000
       print'names;                                                     19285000
       while no'error and (i:=i+1) < loopnumber do lra'test;            19290000
                                                                        19295000
out:   loopctn:=0; x:=stepno;                                           19300000
       stepno:=stepno+1;                                                19305000
                                                                        19310000
end;   << mrtests >>                                                    19315000
                                                                        19320000
procedure brct;   << br instruction - cover test >>                     19325000
   begin                                                                19330000
star: assemble(                                                         19335000
      ldxi 1;                                                           19340000
      br t2;    << *+%125 >>                                            19345000
      br skip1;                   << unexpected >>                      19350000
                                                                        19355000
t3:   incx;                                                             19360000
      br t4;    << *+%252 >>                                            19365000
      br skip1;                   << unexpected >>                      19370000
                                                                        19375000
t5:   incx;                                                             19380000
      br t6;   << *+%377 >>                                             19385000
      br skip1;                   << unexpected >>                      19390000
                                                                        19395000
t7:   ldxa;                                                             19400000
      cmpi 6;                                                           19405000
      be  *+2;                                                          19410000
      br skip1;                   << unexpected >>                      19415000
                                                                        19420000
                                                                        19425000
      br exit;               << return >>                               19430000
      br brierror;                   << unexpected >>                   19435000
      con10; con10; con10; con10; con10; con10; con10;                  19440000
                                                                        19445000
skip1:br brierror;                   << unexpected >>                   19450000
t2:   incx;                                                             19455000
      nop;                                                              19460000
      br t3;   << *-%125 >>                                             19465000
      br brierror;                   << unexpected >>                   19470000
                                                                        19475000
      con10; con10; con10; con10; con10; con10; con10; con10;           19480000
      con 0,0,0;                                                        19485000
                                                                        19490000
      br brierror;                   << unexpected >>                   19495000
t4:   incx;                                                             19500000
      nop;                                                              19505000
      br t5;   << *-%252 >>                                             19510000
      br brierror;                   << unexpected >>                   19515000
                                                                        19520000
      con10; con10; con10; con10; con10; con10; con10; con10;           19525000
      con 0,0,0;                                                        19530000
                                                                        19535000
      br brierror;                   << unexpected >>                   19540000
t6:   incx;                                                             19545000
      nop;                                                              19550000
      br t7);   << *-%377 >>                                            19555000
brierror:                                                               19560000
      no'error:=false;                  << unexpected >>                19565000
exit:                                                                   19570000
                                                                        19575000
end;   << brct >>                                                       19580000
                                                                        19585000
                                                                        19590000
procedure biam;   << check br instruction - all modes >>                19595000
   begin                                                                19600000
       move instruct'name:="BR    ";                                    19605000
       print'names;                                                     19610000
star: assemble(                                                         19615000
      pshr 2;                                                           19620000
      dup;                                                              19625000
      stor savq;   << save q >>                                         19630000
      addi 20;                                                          19635000
      dup;                                                              19640000
      subi 10;                                                          19645000
      setr 3;   << q:=q+10;  s:=q+10 >>                                 19650000
                                                                        19655000
      ldi 1;                                                            19660000
      br *+2;  << mode 1: p+d >>                                        19665000
      br brierror;                                                      19670000
      cmpi 1;                                                           19675000
      be *+2;                                                           19680000
      br brierror;                   << tos not 1 >>                    19685000
                                                                        19690000
      ldi 2;                                                            19695000
      ldxi 1;                                                           19700000
      br *+1,x << mode 2: p+d+x >>                                      19705000
      br brierror;                                                      19710000
      cmpi 2;                                                           19715000
      be *+2;                                                           19720000
      br brierror;                   << tos not 2 >>                    19725000
                                                                        19730000
      ldi 3;                                                            19735000
      br *+3,i;  << mode 3: (p+d)+p+d >>                                19740000
      br brierror;                                                      19745000
      br *+3;                                                           19750000
      con 2;                                                            19755000
      br brierror;                                                      19760000
      cmpi 3;                                                           19765000
      be *+2;                                                           19770000
      br brierror;                   << tos not 3 >>                    19775000
                                                                        19780000
      ldi 4;                                                            19785000
      ldxi 1;                                                           19790000
      br *+3,i,x;  << mode 4: (p+d)+x+p+d >>                            19795000
      br brierror;                                                      19800000
      br *+3;                                                           19805000
      con 1;                                                            19810000
      br brierror;                                                      19815000
      cmpi 4;                                                           19820000
      be *+2;                                                           19825000
      br brierror;                   << tos not 4 >>                    19830000
                                                                        19835000
      ldi 5;                                                            19840000
      br *+2;                                                           19845000
      br *+3;   << mode 5: p-d >>                                       19850000
      br *-1;                                                           19855000
      br brierror;                                                      19860000
      cmpi 5;                                                           19865000
      be *+2;                                                           19870000
      br brierror;                   << tos not 5 >>                    19875000
                                                                        19880000
      ldi 6;                                                            19885000
      ldxi 3;                                                           19890000
      br *-1,x;  << mode 6: p-d+x >>                                    19895000
      br brierror;                                                      19900000
      cmpi 6;                                                           19905000
      be *+2;                                                           19910000
      br brierror;                   << tos not 6 >>                    19915000
                                                                        19920000
      ldi 7;                                                            19925000
      br *+2;                                                           19930000
      con 3;                                                            19935000
      br *-1,i;  << mode 7: (p-d)+p-d >>                                19940000
      br brierror;                                                      19945000
      cmpi 7;                                                           19950000
      be *+2;                                                           19955000
      br brierror;                   << tos not 7 >>                    19960000
                                                                        19965000
      ldi 8;                                                            19970000
      ldxi 4;                                                           19975000
      br *+2;                                                           19980000
      con -1;                                                           19985000
      br *-1,i,x;   << mode 8: (p-d)+x+p-d >>                           19990000
      br brierror;                                                      19995000
      cmpi 8;                                                           20000000
      be *+2;                                                           20005000
      br brierror;                   << tos not 8 >>                    20010000
                                                                        20015000
      ldi 11;                                                           20020000
      lra *+4;                                                          20025000
      stor db+7;                                                        20030000
      br db+7,i;  << mode 11: (db+d)+pb >>                              20035000
      br brierror;                                                      20040000
      cmpi 11;                                                          20045000
      be *+2;                                                           20050000
      br brierror;                   << tos not 11 >>                   20055000
                                                                        20060000
      ldi 12;                                                           20065000
      ldxi 3;                                                           20070000
      lra *+1;                                                          20075000
      stor db+%10;                                                      20080000
      br db+%10,i,x;  << mode 12: (db+d)+x+pb >>                        20085000
      br brierror;                                                      20090000
      cmpi 12;                                                          20095000
      be *+2;                                                           20100000
      br brierror;                   << tos not 12 >>                   20105000
                                                                        20110000
      ldi 15;                                                           20115000
      lra *+4;                                                          20120000
      stor q+1;                                                         20125000
      br q+1,i;  << mode 15:  (q+d)+pb >>                               20130000
      br brierror;                                                      20135000
      cmpi 15;                                                          20140000
      be *+2;                                                           20145000
      br brierror;                   << tos not 15 >>                   20150000
                                                                        20155000
      ldi 16;                                                           20160000
      ldxi 3;                                                           20165000
      lra *+1;                                                          20170000
      stor q+2;                                                         20175000
      br q+2,i,x;  << mode 16:  (q+d)+x+pb >>                           20180000
      br brierror;                                                      20185000
      cmpi 16;                                                          20190000
      be *+2;                                                           20195000
      br brierror;                   << tos not 16 >>                   20200000
                                                                        20205000
      ldi 19;                                                           20210000
      lra *+4;                                                          20215000
      stor q-1;                                                         20220000
      br q-1,i;   << mode 19:  (q-d)+pb >>                              20225000
      br brierror;                                                      20230000
      cmpi 19;                                                          20235000
      be *+2;                                                           20240000
      br brierror;                   << tos not 19 >>                   20245000
                                                                        20250000
      ldi 20;                                                           20255000
      ldxn 1;                                                           20260000
      lra *+5;                                                          20265000
      stor q-2;                                                         20270000
      br q-2,i,x;  << mode 20:  (q-d)+x+pb >>                           20275000
      br brierror;                                                      20280000
      cmpi 20;                                                          20285000
      be *+2;                                                           20290000
      br brierror;                   << tos not 20 >>                   20295000
                                                                        20300000
      lra *+5;                                                          20305000
      stor var0;                                                        20310000
      lra *+3;  << mode 23:  (s-d)+pb >>                                20315000
      br s-0,i;                                                         20320000
      br brierror;                                                      20325000
      cmpm var0;                                                        20330000
      be *+2;                                                           20335000
      br brierror;                   << tos not branch @ >>             20340000
                                                                        20345000
      ldi 23;                                                           20350000
      dzro,dzro;                                               <<j8676>>20355000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>20360000
      lra *+4;   << mode 23: (s-d)+pb >>                                20365000
      stor s-4;                                                         20370000
      br s-3,i;                                                         20375000
      br brierror;                                                      20380000
      cmpi 23;                                                          20385000
      be *+2;                                                           20390000
      br brierror;                   << tos not 23 >>                   20395000
                                                                        20400000
      ldi 24;                                                           20405000
      ldxn 2;                                                           20410000
      lra *+6;                                                          20415000
      stor s-2;                                                         20420000
      br s-1,i,x;  << mode 24: (s-d)+x+pb >>                            20425000
      br brierror;                                                      20430000
      cmpi 24;                                                          20435000
      be next;                                                          20440000
      br brierror);                        << tos not 24 >>             20445000
                                                                        20450000
next:assemble(                                                          20455000
      load savq;                                                        20460000
      setr 2);   << restore q >>                                        20465000
       push(q);set(s);<<reset stack>>                                   20470000
       if(loopctn:=loopctn+1)=loopnumber then go out                    20475000
       else go star;                                                    20480000
                                                                        20485000
brierror:                                                               20490000
       no'error:=false;                                                 20495000
                                                                        20500000
out:   loopctn:=0;                                                      20505000
       if no'error then brct;    << cover test of br instruction >>     20510000
                                                                        20515000
end;   << biam >>                                                       20520000
                                                                        20525000
procedure ldb'test;                                                     20530000
   begin                                                                20535000
<< does not include tests for e>s or e<dl or non-prvl mode >>           20540000
star: assemble(                                                         20545000
<< check ldb db+ instruction >>                                         20550000
                                                                        20555000
      adds 10;                                                          20560000
                                                                        20565000
      ldb ba1';     << "A" >>                                           20570000
      be *+2;                                                           20575000
      br ldberror;                   << not cce >>                      20580000
      cmpi %101;                                                        20585000
      be *+2;                                                           20590000
      br ldberror;                   << tos not %101 for "A" >>         20595000
                                                                        20600000
      dzro,dzro;                                               <<j8676>>20605000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>20610000
      ldb ba1byte2;   <<?>>                                             20615000
      bl *+2;                                                           20620000
      br ldberror;                   << not ccl >>                      20625000
      cmpi %77;                                                         20630000
      be *+2;                                                           20635000
      br ldberror;                   << tos not %77 for "?" >>          20640000
                                                                        20645000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>20650000
      ldb ba1byte4;   <<1>>                                             20655000
      bg *+2;                                                           20660000
      br ldberror;                   << not ccg >>                      20665000
      cmpi %61;                                                         20670000
      be *+2;                                                           20675000
      br ldberror;                   << tos not %61 for "1" >>          20680000
                                                                        20685000
<< check ldb s- instructions >>                                         20690000
                                                                        20695000
      ldni 2;   << byte in stack reg >>                                 20700000
      ldb s-0;                                                          20705000
      cmpi %377;                                                        20710000
      be *+2;                                                           20715000
      br ldberror;                   << tos not %377 >>                 20720000
      cmpn 2;                                                           20725000
      be *+2;                                                           20730000
      br ldberror;                   << stack trouble >>                20735000
                                                                        20740000
<< check ldb db+,x instruction >>                                       20745000
                                                                        20750000
      ldxi 0;                                                           20755000
      ldb ba1',x;                                                       20760000
      cmpi %101;                                                        20765000
      be *+2;                                                           20770000
      br ldberror;                   << tos not %101 = "A" >>           20775000
                                                                        20780000
      ldxi 1;                                                           20785000
      ldb ba1',x;                                                       20790000
      cmpi %60;                                                         20795000
      be *+2;                                                           20800000
      br ldberror;                   << tos not %60 = "0" >>            20805000
                                                                        20810000
      ldxi 4;                                                           20815000
      ldb ba1',x;                                                       20820000
      cmpi %61;                                                         20825000
      be *+2;                                                           20830000
      br ldberror;                   << tos not %61 = "1" >>            20835000
                                                                        20840000
      ldxi 5;                                                           20845000
      ldb ba1',x;                                                       20850000
      cmpi %135;                                                        20855000
      be *+2;                                                           20860000
      br ldberror;                   << tos not %135 = "^" >>           20865000
                                                                        20870000
<< check ldb db+,i instruction >>                                       20875000
                                                                        20880000
      ldb bpt1,i;                                                       20885000
      cmpi %101;                                                        20890000
      be *+2;                                                           20895000
      br ldberror;                      << tos not %101 = "A" >>        20900000
                                                                        20905000
<< check ldb db+,i,x instruction >>                                     20910000
                                                                        20915000
      ldxi 5;                                                           20920000
      ldb bpt1,i,x;                                                     20925000
      cmpi %135;                                                        20930000
      be *+2;                                                           20935000
      br ldberror;                   << tos not %135 = "^" >>           20940000
                                                                        20945000
<< check ldb q+ instruction >>                                          20950000
                                                                        20955000
      load q+3;                                                         20960000
      stor var0;   << save (q+3) >>                                     20965000
      load lb1;                                                         20970000
      stor q+3;                                                         20975000
      ldb q+3;                                                          20980000
      cmpi 1;                                                           20985000
      be *+2;                                                           20990000
      br ldberror;                   << tos not 1 >>                    20995000
      load var0;                                                        21000000
      stor q+3;   << restore (q+3) >>                                   21005000
                                                                        21010000
<< check ldb q- instruction >>                                          21015000
                                                                        21020000
      load q-2;                                                         21025000
      stor var0;   << save (q-2) >>                                     21030000
      load lb2;                                                         21035000
      stor q-2;                                                         21040000
      ldb q-2;                                                          21045000
      cmpi 2;                                                           21050000
      be *+2;                                                           21055000
      br ldberror;                   << tos not 2 >>                    21060000
      load var0;                                                        21065000
      stor q-2;   << restore (q-2) >>                                   21070000
                                                                        21075000
<< cover tests >>                                                       21080000
                                                                        21085000
      load lb1;                                                         21090000
      stor db+%125;                                                     21095000
      load lb2;                                                         21100000
      stor db+%252;                                                     21105000
      load lb3;                                                         21110000
      stor db+%377;                                                     21115000
      ldb db+%125;                                                      21120000
      cmpi 1;                                                           21125000
      be *+2;                                                           21130000
      br ldberror;                   << tos not 1 >>                    21135000
      ldb db+%252;                                                      21140000
      cmpi 2;                                                           21145000
      be *+2;                                                           21150000
      br ldberror;                   << tos not 2 >>                    21155000
      ldb db+%377;                                                      21160000
      cmpi 3;                                                           21165000
      be exit);                                                         21170000
ldberror:                                                               21175000
      no'error:=false;                   << tos not 3 >>                21180000
exit:                                                                   21185000
   end;                                                                 21190000
                                                                        21195000
<< check stb db+ instruction >>                                         21200000
                                                                        21205000
procedure stb'test;                                                     21210000
   begin                                                                21215000
      integer i;      << dummy for q+1 >>                               21220000
cstb: assemble(                                                         21225000
      dzro,dzro;                                               <<j8932>>21230000
      zero;                                                             21235000
      stor var0;                                                        21240000
      ldi 21;                                                           21245000
      ldi %377;                                                         21250000
      dzro,dzro;                                               <<j8676>>21255000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>21260000
      stb var0;                                                         21265000
      cmpi 21;                                                          21270000
      be *+2;                                                           21275000
      br stberror;                   << tos not 21 after stb >>         21280000
      load var0;                                                        21285000
      cmpm m256;                                                        21290000
      be *+2;                                                           21295000
      br stberror;                   << (var0) not %177400 >>           21300000
                                                                        21305000
      ldi %125;                                                         21310000
      dup;                                                              21315000
      stor var0;   << (var0 := %000125) >>                              21320000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>21325000
      stb var0;                                                         21330000
      load var0;                                                        21335000
      cmpm odd;                                                         21340000
      be *+2;                                                           21345000
      br stberror;                   << (var0) not %052525 >>           21350000
                                                                        21355000
<< check stb db+,x instruction >>                                       21360000
                                                                        21365000
      zero;                                                             21370000
      stor var2;   << var2 := 0 >>                                      21375000
      ldxi 5;                                                           21380000
      ldi 3;                                                            21385000
      stb var0,x;  << really var2(8:15) >>                              21390000
      load var2;                                                        21395000
      cmpi 3;                                                           21400000
      be *+2;                                                           21405000
      br stberror;                   << (var2) not 3 >>                 21410000
      ldxi 4;                                                           21415000
      ldi %377;                                                         21420000
      stb var0,x;  << really var2(0:7) >>                               21425000
      load var2;                                                        21430000
      cmpn 253;                                                         21435000
      be *+2;                                                           21440000
      br stberror;                   << (var2) not %177403 >>           21445000
                                                                        21450000
<< check stb s- instruction >>                                          21455000
                                                                        21460000
      ldi 3;                                                            21465000
      ldi 2;                                                            21470000
      ldi 1;                                                            21475000
      stb s-2;   << store into stack reg >>                             21480000
      cmpi 2;                                                           21485000
      be *+2;                                                           21490000
      br stberror;                   << stack not popped >>             21495000
      cmpm pat403;                                                      21500000
      be *+2;                                                           21505000
      br stberror;                   << (s-1) not %403 >>               21510000
                                                                        21515000
<< check stb db+,i instruction >>                                       21520000
                                                                        21525000
      ldi %17;                                                          21530000
      stor var0;   << (db+%6):=%17 >>                                   21535000
      ldi 0;                                                            21540000
      stor var1;   << (db+%7 ):=0;>>                                    21545000
      ldi %22;                                                          21550000
      stb var0,i;                                                       21555000
      load var1;                                                        21560000
      cmpi %22;                                                         21565000
      be *+2;                                                           21570000
      br stberror;                   << (db+7) not %22 >>               21575000
                                                                        21580000
<< check stb db+,i,x instruction >>                                     21585000
                                                                        21590000
      ldi 0;                                                            21595000
      stor var2;                                                        21600000
      ldi %14;                                                          21605000
      stor var0;                                                        21610000
      ldxi %4;                                                          21615000
      ldi %377;                                                         21620000
      stb var0,i,x;   << left byte of var2 >>                           21625000
      load var2;                                                        21630000
      cmpm m256;                                                        21635000
      be *+2;                                                           21640000
      br stberror;                   << (var2) not %177400 >>           21645000
                                                                        21650000
<< check stb q+ instruction >>                                          21655000
                                                                        21660000
      load q+1;                                                         21665000
      stor var0;   << save (q+1) >>                                     21670000
      zero;                                                             21675000
      stor q+1;   << (q+1):=0 >>                                        21680000
      ldi 1;                                                            21685000
      stb q+1;                                                          21690000
      load q+1;                                                         21695000
      cmpm lb1;                                                         21700000
      be *+2;                                                           21705000
      br stberror;                   << (q+1) not %400 >>               21710000
      load var0;                                                        21715000
      stor q+1;    << restore (q+1) >>                                  21720000
                                                                        21725000
<< check stb q- instruction >>                                          21730000
                                                                        21735000
      load q-1;                                                         21740000
      stor var0;   << save (q-1) >>                                     21745000
      zero;                                                             21750000
      stor q-1;   << (q-1):=0 >>                                        21755000
      ldi 2;                                                            21760000
      stb q-1;                                                          21765000
      load q-1;                                                         21770000
      cmpm lb2;                                                         21775000
      be next;                                                          21780000
      br stberror;                        << (q-1) not %1000 >>         21785000
next:                                                                   21790000
      load var0;                                                        21795000
      stor q-1;   << restore (q-1) >>                                   21800000
      br exit);                                                         21805000
stberror:                                                               21810000
      no'error:=false;                                                  21815000
exit:                                                                   21820000
   end; << stb >>                                                       21825000
                                                                        21830000
procedure testldbstb;   << test ldb & stb instructions >>               21835000
begin                                                                   21840000
                                                                        21845000
       move instruct'name:="LDB   ";                                    21850000
       print'names;                                                     21855000
       while no'error and (i:=i+1) < loopnumber do ldb'test;            21860000
                                                                        21865000
       move instruct'name:="STB   ";                                    21870000
       print'names;                                                     21875000
       while no'error and (i:=i+1) < loopnumber do stb'test;            21880000
                                                                        21885000
end;   << testldbstb >>                                                 21890000
                                                                        21895000
procedure ldd'test;                                                     21900000
   begin                                                                21905000
                                                                        21910000
star: assemble(                                                         21915000
      adds 10;                                                          21920000
<< test for ldd e>s done in section 5 >>                                21925000
                                                                        21930000
<< check ldd db+ instruction >>                                         21935000
                                                                        21940000
      ldni 11;                                                          21945000
      dzro,dzro;                                               <<j8676>>21950000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>21955000
      ldd p0;   << 0,1 >>                                               21960000
      bg *+2;                                                           21965000
      br ldderror;                   << not ccg >>                      21970000
      ldi 0;                                                            21975000
      ldi 1;                                                            21980000
      dcmp;                                                             21985000
      be *+2;                                                           21990000
      br ldderror;                   << (s,s-1) not 0,1 >>              21995000
      cmpn 11;                                                          22000000
      be *+2;                                                           22005000
      br ldderror;                   << stack trouble >>                22010000
                                                                        22015000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>22020000
      ldd k0;   << 0,0 >>                                               22025000
      be *+2;                                                           22030000
      br ldderror;                   << not cce >>                      22035000
      dzro,dcmp;                                                        22040000
      be *+2;                                                           22045000
      br ldderror;                   << result not 0,0 >>               22050000
                                                                        22055000
      ldd m1;   << -1,-2 >>                                             22060000
      bl *+2;                                                           22065000
      br ldderror;                   << not ccl >>                      22070000
      cmpn 2;                                                           22075000
      be *+2;                                                           22080000
      br ldderror;                                                      22085000
      cmpn 1;                                                           22090000
      be *+2;                                                           22095000
      br ldderror;                   << result not -1,-2 >>             22100000
                                                                        22105000
<< check ldd s- instruction >>                                          22110000
                                                                        22115000
      dzro,dzro;                                               <<j8676>>22120000
      ddel,ddel;  <<sr=0>>                                     <<j8676>>22125000
      ldi 1;                                                            22130000
      ldi 2;    << sr=2 >>                                              22135000
      ldd s-1;                                                          22140000
      cmpi 2;                                                           22145000
      be *+2;                                                           22150000
      br ldderror;                   << tos not 2 >>                    22155000
      cmpi 1;                                                           22160000
      be *+2;                                                           22165000
      br ldderror;                   << (s-1) not 1 >>                  22170000
      cmpi 2;                                                           22175000
      be *+2;                                                           22180000
      br ldderror;                   << (s-2) not 2 >>                  22185000
      cmpi 1;                                                           22190000
      be *+2;                                                           22195000
      br ldderror;                   << (s-3) not 1 >>                  22200000
                                                                        22205000
<< check ldd q+ instruction >>                                          22210000
                                                                        22215000
      ldd q+1;                                                          22220000
      load q+1;                                                         22225000
      load q+2;                                                         22230000
      dcmp;                                                             22235000
      be *+2;                                                           22240000
      br ldderror;                   << (si1,s) not (q+1,q+2) >>        22245000
                                                                        22250000
<< check ldd q- instruction >>                                          22255000
                                                                        22260000
      ldd q-1;                                                          22265000
      load q-1;                                                         22270000
      load q+0;                                                         22275000
      dcmp;                                                             22280000
      be *+2;                                                           22285000
      br ldderror;                   << (s-1,s) not (q-1,q) >>          22290000
                                                                        22295000
<< check ldd db+,x instruction >>                                       22300000
                                                                        22305000
      ldi 5;                                                            22310000
      stor var2;                                                        22315000
      ldi 6;                                                            22320000
      stor var3;                                                        22325000
      ldxi %1;                                                          22330000
      ldd var0,x;   << e=db+%10>>                                       22335000
      cmpi 6;                                                           22340000
      be *+2;                                                           22345000
      br ldderror;                   << tos not 6 >>                    22350000
      cmpi 5;                                                           22355000
      be *+2;                                                           22360000
      br ldderror;                   << tos not 5 >>                    22365000
                                                                        22370000
<< check ldd db+,i instruction >>                                       22375000
                                                                        22380000
      ldi 4;                                                            22385000
      stor var6;                                                        22390000
      ldi 5;                                                            22395000
      stor var7;                                                        22400000
      ldi %14;                                                          22405000
      stor var0;                                                        22410000
      ldd var0,i;   << e=db+%14>>                                       22415000
      ldi 4;                                                            22420000
      ldi 5;                                                            22425000
      dcmp;                                                             22430000
      be *+2;                                                           22435000
      br ldderror;                   << (s-1,s) not 4,5 >>              22440000
                                                                        22445000
<< check ldd db+,i,x instruction >>                                     22450000
                                                                        22455000
      ldi %10;                                                          22460000
      stor var0;                                                        22465000
      ldxi %1;                                                          22470000
      ldi 3;                                                            22475000
      stor var4;                                                        22480000
      ldi 7;                                                            22485000
      stor var5;                                                        22490000
      ldd var0,i,x;   << e=db+%12>>                                     22495000
      ldi 3;                                                            22500000
      ldi 7;                                                            22505000
      dcmp;                                                             22510000
      be *+2;                                                           22515000
      br ldderror;                   << (s-1,s) not 3,7 >>              22520000
                                                                        22525000
<< check ldd s-,i instruction >>                                        22530000
                                                                        22535000
      ldi 9;                                                            22540000
      stor var2;                                                        22545000
      ldi 10;                                                           22550000
      stor var3;                                                        22555000
      ldi %10;                                                          22560000
      ldd s-0,i;   << e=db+%10>>                                        22565000
      ldi 9;                                                            22570000
      ldi 10;                                                           22575000
      dcmp;                                                             22580000
      be *+2;                                                           22585000
      br ldderror;                   << (s-1,s) not 9,10 >>             22590000
                                                                        22595000
<< cover tests >>                                                       22600000
                                                                        22605000
      ldi 1;                                                            22610000
      ldi 2;                                                            22615000
      ddup;                                                             22620000
      stor db+%126;                                                     22625000
      stor db+%125;                                                     22630000
      ldd db+%125;                                                      22635000
      dcmp;                                                             22640000
      be *+2;                                                           22645000
      br ldderror;                   << (s-1,s) not 1,2 >>              22650000
                                                                        22655000
      ldi 3;                                                            22660000
      ldi 4;                                                            22665000
      ddup;                                                             22670000
      stor db+%253;                                                     22675000
      stor db+%252;                                                     22680000
      ldd db+%252;                                                      22685000
      dcmp;                                                             22690000
      be *+2;                                                           22695000
      br ldderror;                   << s-1,s) not 3,4 >>               22700000
                                                                        22705000
      ldi 5;                                                            22710000
      stor db+%377;                                                     22715000
      ldd db+%377;                                                      22720000
      ldi 5;                                                            22725000
      ldxi %377;                                                        22730000
      load db+1,x;                                                      22735000
      dcmp;                                                             22740000
      be out);                                                          22745000
ldderror:                                                               22750000
      no'error:=false;                   << (s-1,s) not 5,(db+%400) >>  22755000
out:                                                                    22760000
end;                                                                    22765000
procedure std'test;                                                     22770000
begin                                                                   22775000
                                                                        22780000
<< check std db+ instruction >>                                         22785000
                                                                        22790000
cstd: assemble(                                                         22795000
      dzro,dzro;                                               <<j8932>>22800000
      ldi 4;                                                            22805000
      ldi 7;                                                            22810000
      ldi 9;                                                            22815000
      dzro,dzro;                                               <<j8676>>22820000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>22825000
      std var0;  << (var0,var1) := 7,9 >>                               22830000
      cmpi 4;                                                           22835000
      be *+2;                                                           22840000
      br stderror;                   << stack trouble, tos not 4 >>     22845000
      load var0;                                                        22850000
      cmpi 7;                                                           22855000
      be *+2;                                                           22860000
      br stderror;                   << (varo) not 7 >>                 22865000
      load var1;                                                        22870000
      cmpi 9;                                                           22875000
      be *+2;                                                           22880000
      br stderror;                   << (var1) not 9 >>                 22885000
                                                                        22890000
      ldni 4;                                                           22895000
      zero;                                                             22900000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>22905000
      std var0;   << (var0,var1) := -4,0 >>                             22910000
      load var1;                                                        22915000
                                                                        22920000
      be *+2;                                                           22925000
      br stderror;                   << (var1) not 0 >>                 22930000
      load var0;                                                        22935000
      cmpn 4;                                                           22940000
      be *+2;                                                           22945000
      br stderror;                   << (var0) not - 4 >>               22950000
                                                                        22955000
<< check std s- instruction >>                                          22960000
                                                                        22965000
      ldi 1;                                                            22970000
      ldi 2;                                                            22975000
      ldi 3;                                                            22980000
      std s-1;                                                          22985000
      cmpi 1;                                                           22990000
      be *+2;                                                           22995000
      br stderror;                   << tos not 1 >>                    23000000
                                                                        23005000
      ldi 1;                                                            23010000
      ldi 2;                                                            23015000
      ldi 3;                                                            23020000
      ldi 4;                                                            23025000
      ldi 5;   << sr=4 >>                                               23030000
      std s-3;                                                          23035000
      cmpi 5;                                                           23040000
      be *+2;                                                           23045000
      br stderror;                   << tos not 5 >>                    23050000
      cmpi 4;                                                           23055000
      be *+2;                                                           23060000
      br stderror;                   << (s-1) not 4 >>                  23065000
      cmpi 1;                                                           23070000
      be *+2;                                                           23075000
      br stderror;                   << (s-2) not 1 >>                  23080000
                                                                        23085000
      ldi 5;                                                            23090000
      ldi 6;                                                            23095000
      dzro,dzro;                                               <<j8676>>23100000
      ddel,ddel;  << sr=0>>                                    <<j8676>>23105000
      ldi 7;                                                            23110000
      ldi 8;                                                            23115000
      ldi 9;   << sr=3 >>                                               23120000
      std s-3;   << (e) into core, (e+1) into stack reg >>              23125000
      cmpi 9;                                                           23130000
      be *+2;                                                           23135000
      br stderror;                   << tos not 9 >>                    23140000
      cmpi 8;                                                           23145000
      be *+2;                                                           23150000
      br stderror;                   << tos not 8 >>                    23155000
      cmpi 5;                                                           23160000
      be *+2;                                                           23165000
      br stderror;                   << tos not 5 >>                    23170000
                                                                        23175000
<< check std s-,i instruction >>                                        23180000
                                                                        23185000
      ldi %7;                                                           23190000
      ldi 2;                                                            23195000
      ldi 3;   << sr >=3 >>                                             23200000
      std s-2,i;   << e=db+%7>>                                         23205000
      load var1;                                                        23210000
      cmpi 2;                                                           23215000
      be *+2;                                                           23220000
      br stderror;                   << (db+7) not 2 >>                 23225000
      load var2;                                                        23230000
      cmpi 3;                                                           23235000
      be *+2;                                                           23240000
      br stderror;                   << (db+%10) not 3 >>               23245000
                                                                        23250000
<< test for std e>s done in section 5 >>                                23255000
                                                                        23260000
<< check std q+ instruction >>                                          23265000
                                                                        23270000
      adds 10;                                                          23275000
      load q+1;                                                         23280000
      load q+2;                                                         23285000
      std var0;    << save (q+1,q+2) >>                                 23290000
      ldi 3;                                                            23295000
      ldi 4;                                                            23300000
      std q+1;                                                          23305000
      load q+1;                                                         23310000
      cmpi 3;                                                           23315000
      be *+2;                                                           23320000
      br stderror;                   << (q+1) not 3 >>                  23325000
      load q+2;                                                         23330000
      cmpi 4;                                                           23335000
      be *+2;                                                           23340000
      br stderror;                   << (q+2) not 4 >>                  23345000
      ldd var0;                                                         23350000
      std q+1;   << restore (q+1,q+2) >>                                23355000
                                                                        23360000
<< check std q- instruction >>                                          23365000
                                                                        23370000
      load q-3;                                                         23375000
      load q-2;                                                         23380000
      std var0;   << save (q-3,q-2) >>                                  23385000
      ldi 6;                                                            23390000
      ldi 7;                                                            23395000
      std q-3;                                                          23400000
      load q-3;                                                         23405000
      cmpi 6;                                                           23410000
      be *+2;                                                           23415000
      br stderror;                   << (q-3) not 6 >>                  23420000
      load q-2;                                                         23425000
      cmpi 7;                                                           23430000
      be *+2;                                                           23435000
      br stderror;                   << (q-2) not 7 >>                  23440000
      ldd var0;                                                         23445000
      std q-3;   << restore (q-3,q-2) >>                                23450000
                                                                        23455000
<< check std db+,x instruction >>                                       23460000
                                                                        23465000
      ldi 4;                                                            23470000
      ldi 5;                                                            23475000
      ddup;                                                             23480000
      ldxi 1;                                                           23485000
      std var1,x;   << e=db+%11 >>                                      23490000
      load var3;                                                        23495000
      load var4;                                                        23500000
      dcmp;                                                             23505000
      be *+2;                                                           23510000
      br stderror;                   << (db+%11,db+%12) not 4,5 >>      23515000
                                                                        23520000
<< check std db+,i instruction >>                                       23525000
                                                                        23530000
      ldi %13;                                                          23535000
      stor var1;                                                        23540000
      ldi 10;                                                           23545000
      ldi 11;                                                           23550000
      ddup;                                                             23555000
      std var1,i;   << e=db+%13 >>                                      23560000
      load var5;                                                        23565000
      load var6;                                                        23570000
      dcmp;                                                             23575000
      be *+2;                                                           23580000
      br stderror;                   << (db+%13,db+%14 ) not 10,11 >>   23585000
                                                                        23590000
<< check std db,i,x instruction >>                                      23595000
                                                                        23600000
      ldxi 2;                                                           23605000
      ldi %10;                                                          23610000
      stor var0;                                                        23615000
      ldi 9;                                                            23620000
      ldi 10;                                                           23625000
      ddup;                                                             23630000
      std var0,i,x;   << e=db+%14 >>                                    23635000
      load var6;                                                        23640000
      load var7;                                                        23645000
      dcmp;                                                             23650000
      be next;                                                          23655000
      br stderror);                    << db+%14,db+%15) not 9,10 >>    23660000
next:                                                                   23665000
       push(q);set(s);<<reset stack>>                                   23670000
      return;                                                           23675000
                                                                        23680000
stderror:                                                               23685000
      no'error:=false;                                                  23690000
                                                                        23695000
out:   loopctn:=0;                                                      23700000
                                                                        23705000
end;                                                                    23710000
procedure testlddstd;                                                   23715000
begin                                                                   23720000
       move instruct'name := "LDD   ";                                  23725000
       print'names;                                                     23730000
       while no'error and (i:=i+1) < loopnumber do ldd'test;            23735000
       move instruct'name := "STD   ";                                  23740000
       print'names;                                                     23745000
       while no'error and (i:=i+1) < loopnumber do std'test;            23750000
end;                                                                    23755000
                                                                        23760000
procedure bcc'test;                                                     23765000
   begin                                                                23770000
star: assemble(                                                         23775000
<< check bcc p+l,i instruction >>                                       23780000
                                                                        23785000
      dzro,dzro;                                               <<j8932>>23790000
      ldi 1;   << ccg >>                                                23795000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>23800000
      bg *+3,i;                                                         23805000
      br bccerror;                   << did not branch >>               23810000
      br *+3;  << continue >>                                           23815000
      con 2;                                                            23820000
      br bccerror;                   << should never get here >>        23825000
                                                                        23830000
      ldni 1;   << ccl >>                                               23835000
      bg *+2,i;                                                         23840000
      br *+3;                                                           23845000
      con 1;                                                            23850000
      br bccerror;                   << unexpected branch >>            23855000
                                                                        23860000
      br *+2;  << br to test entry >>                                   23865000
      con 4;                                                            23870000
      ldi 0;   << cce >>                                                23875000
      be *-2,i;                                                         23880000
      br bccerror;                   << did not branch >>               23885000
                                                                        23890000
      ldi 3;   << ccg >>                                                23895000
      dzro,dzro;                                               <<j8676>>23900000
      ddel,ddel;  << sr=0>>                                    <<j8676>>23905000
      bg next1,i);                                                      23910000
bccerror:                                                               23915000
      no'error:=false;                   << did not branch >>           23920000
      go exit;                                                          23925000
      assemble(                                                         23930000
      br *+2;                                                           23935000
next1:con -1);                                                          23940000
exit: end;        << bcc >>                                             23945000
                                                                        23950000
                                                                        23955000
<< check iabz p+l,i instructions >>                                     23960000
                                                                        23965000
procedure iabz'test;                                                    23970000
  begin                                                                 23975000
      assemble(                                                         23980000
      dzro,dzro;                                               <<j8932>>23985000
      ldni 1;                                                           23990000
      iabz *+3,i;                                                       23995000
      br iabzerror;                   << did not branch >>              24000000
      br *+3;                                                           24005000
      con 2;                                                            24010000
      br iabzerror;                                                     24015000
                                                                        24020000
      zero;                                                             24025000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>24030000
      iabz *+2,i;                                                       24035000
      br *+3;                                                           24040000
      con 1;                                                            24045000
      br iabzerror;                   << unexpected branch >>           24050000
                                                                        24055000
      br *+2;                                                           24060000
      con 5;                                                            24065000
      ldni 1;                                                           24070000
      dzro,dzro;                                               <<j8676>>24075000
      ddel,ddel;  << sr=0>>                                    <<j8676>>24080000
      iabz *-4,i;                                              <<j8676>>24085000
      br iabzerror;                   << did not branch >>              24090000
                                                                        24095000
      ldni 1;                                                           24100000
      iabz next2,i);                                                    24105000
iabzerror:                                                              24110000
      no'error:=false;                   << did not branch >>           24115000
      go exit;                                                          24120000
      assemble(                                                         24125000
      br *+2;                                                           24130000
next2:con -1);                                                          24135000
exit: end;   << iabz >>                                                 24140000
                                                                        24145000
<< more indirect conditional branch tests >>                            24150000
                                                                        24155000
procedure icb'test;                                                     24160000
   begin                                                                24165000
      assemble(                                                         24170000
      ldxn 1;                                                           24175000
      ixbz *+3,i;                                                       24180000
      br icberror;                   << did not branch >>               24185000
      br *+3;                                                           24190000
      con 2;                                                            24195000
      br icberror;                   << unexpected >>                   24200000
                                                                        24205000
      ldxi 1;                                                           24210000
      dxbz *+3,i;                                                       24215000
      br icberror;                   << did not branch >>               24220000
      br *+3;                                                           24225000
      con 2;                                                            24230000
      br icberror;                   << unexpected >>                   24235000
                                                                        24240000
      ldni 1;                                                           24245000
      dup,add;   << c=1 >>                                              24250000
      bcy *+3,i;                                                        24255000
      br icberror;                   << did not branch >>               24260000
      br *+3;                                                           24265000
      con 2;                                                            24270000
      br icberror;                   << unexpected >>                   24275000
                                                                        24280000
      dzro,add;   << c=0 >>                                             24285000
      bncy *+3,i;                                                       24290000
      br icberror;                   << did not branch >>               24295000
      br *+3;                                                           24300000
      con 2;                                                            24305000
      br icberror;                   << unexpected >>                   24310000
                                                                        24315000
      ldi 1;                                                            24320000
      dabz *+3,i;                                                       24325000
      br icberror;                   << did not branch >>               24330000
      br *+3;                                                           24335000
      con 2;                                                            24340000
      br icberror;                   << unexpected >>                   24345000
                                                                        24350000
      load pmax;                                                        24355000
      dup,add;   << o=1 >>                                              24360000
      bov *+3,i;                                                        24365000
      br icberror;                   << did not branch >>               24370000
      br *+3;                                                           24375000
      con 2;                                                            24380000
      br icberror;                   << unexpected >>                   24385000
                                                                        24390000
      dzro,add;   << o=0 >>                                             24395000
      bnov *+3,i;                                                       24400000
      br icberror;                   << did not branch >>               24405000
      br *+3;                                                           24410000
      con 2;                                                            24415000
      br icberror;                   << unexpected >>                   24420000
                                                                        24425000
      ldi 1;                                                            24430000
      bro *+3,i;                                                        24435000
      br icberror;                   << did not branch >>               24440000
      br *+3;                                                           24445000
      con 2;                                                            24450000
      br icberror;                   << unexpected >>                   24455000
                                                                        24460000
      ldi 6;                                                            24465000
      bre exit;                                                         24470000
      br icberror;                   << did not branch >>               24475000
      br exit;                                                          24480000
      nop);                                                             24485000
icberror:                                                               24490000
      no'error:=false;                       << unexpected >>           24495000
exit: end;   << icb >>                                                  24500000
                                                                        24505000
<< check bre p+l,i with sr=0 >>                                         24510000
<< applies to all sub opcode 1 instructions >>                          24515000
                                                                        24520000
procedure bre'test;                                                     24525000
   begin                                                                24530000
cbre: assemble(                                                         24535000
      dzro,incb;                                                        24540000
      dzro,dzro;                                               <<j8676>>24545000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>24550000
      bre *+3,i;                                                        24555000
      br breerror;                  << did not branch >>                24560000
      br *+3;   << continue >>                                          24565000
      con 2;                                                            24570000
      br breerror;                  << should never end here >>         24575000
      cmpi 1;                                                           24580000
      be exit;                                                          24585000
      br breerror);                                                     24590000
                                                                        24595000
breerror:                                                               24600000
      no'error:=false;                  << stack trouble >>             24605000
                                                                        24610000
exit: end;  << bre >>                                                   24615000
                                                                        24620000
procedure ibt;   << indirect branch tests >>                            24625000
begin                                                                   24630000
      move instruct'name:="BCC   ";                                     24635000
      print'names;                                                      24640000
      while no'error and (i:=i+1) < loopnumber do bcc'test;             24645000
                                                                        24650000
      move instruct'name:="BRE   ";                                     24655000
      print'names;                                                      24660000
      while no'error and (i:=i+1) < loopnumber do bre'test;             24665000
                                                                        24670000
end;   << ibt >>                                                        24675000
                                                                        24680000
procedure ldi'test;                                                     24685000
   begin                                                                24690000
star: assemble(                                                         24695000
      ldi %125;                                                         24700000
      cmpm pat125;                                                      24705000
      be *+2;                                                           24710000
      br ldierror;                                                      24715000
                                                                        24720000
      ldi %252;                                                         24725000
      cmpm pat252;                                                      24730000
      be *+2;                                                           24735000
      br ldierror;                                                      24740000
                                                                        24745000
      ldi %377;                                                         24750000
      cmpm pat377;                                                      24755000
      be *+2;                                                           24760000
      br ldierror);                                                     24765000
      return;                                                           24770000
ldierror:                                                               24775000
      no'error := false;                                                24780000
end;                                                                    24785000
procedure ldni'test;                                                    24790000
begin                                                                   24795000
      assemble(                                                         24800000
                                                                        24805000
      ldni 1;                                                           24810000
      cmpm m1;                                                          24815000
      be *+2;                                                           24820000
      br ldierror;                                                      24825000
                                                                        24830000
      ldni %125;                                                        24835000
      cmpm pat177653;                                                   24840000
      be *+2;                                                           24845000
      br ldierror;                                                      24850000
                                                                        24855000
      ldni %252;                                                        24860000
      cmpm pat177526;                                                   24865000
      be *+2;                                                           24870000
      br ldierror;                                                      24875000
                                                                        24880000
      ldni %377;                                                        24885000
      cmpm pat177401;                                                   24890000
      be next;                                                          24895000
      br ldierror);                                                     24900000
                                                                        24905000
next:  push(q);set(s);<<reset stack>>                                   24910000
      return;                                                           24915000
ldierror:                                                               24920000
      no'error := false;                                                24925000
end;                                                                    24930000
procedure ctldi;                                                        24935000
begin                                                                   24940000
      move instruct'name := "LDI   ";                                   24945000
      print'names;                                                      24950000
      while no'error and (i:=i+1) < loopnumber do ldi'test;             24955000
      move instruct'name := "LDNI  ";                                   24960000
      print'names;                                                      24965000
      while no'error and (i:=i+1) < loopnumber do ldni'test;            24970000
end;                                                                    24975000
                                                                        24980000
procedure ctldpp;   << cover test - ldpp & ldpn instructions >>         24985000
   begin                                                                24990000
      move instruct'name := "LDPP  ";                                   24995000
      print'names;                                                      25000000
      move instruct'name := "LDPN  ";                                   25005000
      print'names;                                                      25010000
star: assemble(                                                         25015000
      ldpp k1;   << *+%377 >>                                           25020000
      ldi 1;                                                            25025000
      ldi 2;                                                            25030000
      dcmp;                                                             25035000
      be *+2;                                                           25040000
      br skip;                   << (s-1,s) not 1,2 >>                  25045000
                                                                        25050000
      ldpp k2;   << *+%252 >>                                           25055000
      ldi 3;                                                            25060000
      ldi 4;                                                            25065000
      dcmp;                                                             25070000
      be *+2;                                                           25075000
      br skip;                        << (s-1,s) not 3,4 >>             25080000
                                                                        25085000
      ldpp k3;   << *+%125 >>                                           25090000
      ldi 5;                                                            25095000
      ldi 6;                                                            25100000
      dcmp;                                                             25105000
      be *+2;                                                           25110000
      br skip;                        << (s-1,s) not 5,6 >>             25115000
                                                                        25120000
      br t4;                                                            25125000
                                                                        25130000
skip: br skip2;                                                         25135000
                                                                        25140000
k6:   con 11,12;                                                        25145000
      con10; con10; con10; con10; con10; con10; con10;                  25150000
      con 0,0,0,0,0;                                                    25155000
k3:   con 5,6;                                                          25160000
k5:   con 9,10;                                                         25165000
      con10; con10; con10; con10; con10; con10; con10;                  25170000
      con 0,0,0,0,0;                                                    25175000
k2:   con 3,4;                                                          25180000
k4:   con 7,8;                                                          25185000
      con10; con10; con10; con10; con10; con10; con10;                  25190000
      con 0,0,0,0,0;                                                    25195000
k1:   con 1,2;                                                          25200000
      con 0,0,0,0,0,0;                                                  25205000
                                                                        25210000
t4:   ldpn k4;   << *-%125 >>                                           25215000
      ldi 7;                                                            25220000
      ldi 8;                                                            25225000
      dcmp;                                                             25230000
      be *+2;                                                           25235000
skip2:br ldpperror;                   << (s-1,s not 7,8 >>              25240000
                                                                        25245000
      ldpn k5;   << *-%252 >>                                           25250000
      ldi 9;                                                            25255000
      ldi 10;                                                           25260000
      dcmp;                                                             25265000
      be *+2;                                                           25270000
      br ldpperror;                   << (s-1,s not 9,10 >>             25275000
                                                                        25280000
      ldpn k6;   << *-%377 >>                                           25285000
      ldi 11;                                                           25290000
      ldi 12;                                                           25295000
      dcmp;                                                             25300000
      be noerr;                                                         25305000
      br ldpperror);               << (s-1,s) not 11,12 >>              25310000
noerr: push(q);set(s);<<reset stack>>                                   25315000
       if(loopctn:=loopctn+1)=loopnumber then go out                    25320000
       else go star;                                                    25325000
                                                                        25330000
ldpperror:                                                              25335000
      no'error:=false;                                                  25340000
                                                                        25345000
out:   loopctn:=0;                                                      25350000
                                                                        25355000
end;   << ctldpp >>                                                     25360000
                                                                        25365000
procedure ctls;   << cover tests - load & stor instructions >>          25370000
   begin                                                                25375000
      move instruct'name := "LOAD  ";                                   25380000
      print'names;                                                      25385000
star: assemble(                                                         25390000
      ldi %125;                                                         25395000
      stor db+%125;                                                     25400000
      ldi %252;                                                         25405000
      stor db+%252;                                                     25410000
      ldi %377;                                                         25415000
      stor db+%377;                                                     25420000
      sed 0;                                                            25425000
      pshr %100;                                                        25430000
      addi %125;                                                        25435000
      lsea;                                                             25440000
      sed 1;                                                            25445000
      cmpi %125;                                                        25450000
      be *+2;                                                           25455000
      br loaderror;                   << tos not %125 >>                25460000
      sed 0;                                                            25465000
      pshr %100;                                                        25470000
      addi %252;                                                        25475000
      lsea;                                                             25480000
      sed 1;                                                            25485000
      cmpi %252;                                                        25490000
      be *+2;                                                           25495000
      br loaderror;                   << tos not %252 >>                25500000
      sed 0;                                                            25505000
      pshr %100;                                                        25510000
      addi %377;                                                        25515000
      lsea;                                                             25520000
      sed 1;                                                            25525000
      cmpi %377;                                                        25530000
      be *+2;                                                           25535000
      br loaderror;                   << tos not %377 >>                25540000
      load db+%125;                                                     25545000
      cmpi %125;                                                        25550000
      be *+2;                                                           25555000
      br loaderror;                   << tos not %125 >>                25560000
      load db+%252;                                                     25565000
      cmpi %252;                                                        25570000
      be *+2;                                                           25575000
      br loaderror;                   << tos not %252 >>                25580000
      load db+%377;                                                     25585000
      cmpi %377;                                                        25590000
      be noerr;                                                         25595000
      br loaderror);                      << tos not %377 >>            25600000
noerr: push(q);set(s);<<reset stack>>                                   25605000
       if(loopctn:=loopctn+1)=loopnumber then go out                    25610000
       else go star;                                                    25615000
                                                                        25620000
loaderror:                                                              25625000
      no'error:=false;                                                  25630000
                                                                        25635000
out:   loopctn:=0;                                                      25640000
                                                                        25645000
end;  <<ctls>>                                                          25650000
                                                                        25655000
procedure ctbcc;   << cover test - bcc instruction >>                   25660000
   begin                                                                25665000
      move instruct'name:="BCC  ";                                      25670000
      print'names;                                                      25675000
star: assemble(                                                         25680000
      ldi 1;   << make ccg >>                                           25685000
      ldxi 1;                                                           25690000
      bg t2;   << *+%37 >>                                              25695000
      br bccerror;                   << did not branch >>               25700000
                                                                        25705000
t3:   incx;                                                             25710000
      bg t4;   << *+%25 >>                                              25715000
      br bccerror;                   << did not branch >>               25720000
                                                                        25725000
t5:   incx;                                                             25730000
      bg t6;   << *+%12 >>                                              25735000
      br bccerror;                   << did not branch >>               25740000
                                                                        25745000
t7:   ldxa;                                                             25750000
      cmpi 6;                                                           25755000
      be *+2;                                                           25760000
      br bccerror);                   << x not 6 >>                     25765000
                                                                        25770000
      assemble( br exit;  << return >>                                  25775000
      nop;  nop;                                                        25780000
                                                                        25785000
      br bccerror;                   << unexpected >>                   25790000
t6:   incx;                                                             25795000
      nop;                                                              25800000
      bg t7;   << *-%12 >>                                              25805000
      br bccerror;                   << did not branch >>               25810000
                                                                        25815000
      nop; nop; nop;                                                    25820000
                                                                        25825000
      br bccerror;                   << unexpected >>                   25830000
t4:   incx;                                                             25835000
      nop;                                                              25840000
      bg t5;   << *-%25 >>                                              25845000
      br bccerror;                   << did not branch >>               25850000
                                                                        25855000
      nop; nop;                                                         25860000
                                                                        25865000
      br bccerror;                   << unexpected >>                   25870000
t2:   incx;                                                             25875000
      nop;                                                              25880000
      bg t3);   << *-%37 >>                                             25885000
bccerror:                                                               25890000
      no'error:=false;                  << did not branch >>            25895000
exit:                                                                   25900000
                                                                        25905000
                                                                        25910000
end;   << ctbcc >>                                                      25915000
                                                                        25920000
procedure ctdabz;   << cover test - dabz >>                             25925000
   begin                                                                25930000
      move instruct'name:="DABZ  ";                                     25935000
      print'names;                                                      25940000
star: assemble(                                                         25945000
      ldxi 1;                                                           25950000
      ldi 1;                                                            25955000
      dabz t2;   << *+%37 >>                                            25960000
      br dabzerror;                   << did not branch >>              25965000
                                                                        25970000
t3:   incx;                                                             25975000
      ldi 1;                                                            25980000
      dabz t4;   << *+%25 >>                                            25985000
      br dabzerror;                   << did not branch >>              25990000
                                                                        25995000
t5:   incx;                                                             26000000
      ldi 1;                                                            26005000
      dabz t6;   << *+%12 >>                                            26010000
      br dabzerror;                   << did not branch >>              26015000
                                                                        26020000
t7:   ldxa;                                                             26025000
      cmpi 6;                                                           26030000
      be *+2;                                                           26035000
      br dabzerror);                   << x not 6 >>                    26040000
                                                                        26045000
      assemble( br exit;  << return >>                                  26050000
      con 0,0;                                                          26055000
                                                                        26060000
      br dabzerror;                   << unexpected >>                  26065000
t6:   incx;                                                             26070000
      ldi 1;                                                            26075000
      dabz t7;   << *-%12 >>                                            26080000
      br dabzerror;                   << did not branch >>              26085000
                                                                        26090000
      con 0,0;                                                          26095000
                                                                        26100000
      br dabzerror;                   << unexpected >>                  26105000
t4:   incx;                                                             26110000
      ldi 1;                                                            26115000
      dabz t5;   << *-%25 >>                                            26120000
      br dabzerror;                   << did not branch >>              26125000
                                                                        26130000
      con 0;                                                            26135000
                                                                        26140000
      br dabzerror;                   << unexpected >>                  26145000
t2:   incx;                                                             26150000
      ldi 1;                                                            26155000
      dabz t3);   << *-%37 >>                                           26160000
dabzerror:                                                              26165000
      no'error:=false;                  << did not branch >>            26170000
exit:                                                                   26175000
                                                                        26180000
                                                                        26185000
end;   << ctdabz >>                                                     26190000
                                                                        26195000
procedure testcprb;   << test cprb instruction >>                       26200000
      begin                                                             26205000
       move instruct'name:="CPRB  ";                                    26210000
       print'names;                                                     26215000
star: assemble(                                                         26220000
      dzro,dzro;                                               <<j8932>>26225000
      ldni 1;                                                           26230000
      zero;                                                             26235000
      ldi 2;                                                            26240000
      ldxi 3;                                                           26245000
      dzro,dzro;                                               <<j8676>>26250000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>26255000
      cprb cprb1;                                                       26260000
      bg *+2;                                                           26265000
      br cprberror;                   << not ccg >>                     26270000
      cmpn 1;                                                           26275000
      be *+2;                                                           26280000
      br cprberror;                   << stack trouble >>               26285000
      br *+2;                                                           26290000
cprb1: br cprberror;                  << unexpected branch >>           26295000
                                                                        26300000
      dzro;                                                             26305000
      ldxn 1;                                                           26310000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>26315000
      cprb cprb2;                                                       26320000
      bl *+2;                                                           26325000
      br cprberror;                   << not ccl >>                     26330000
      br *+2;                                                           26335000
cprb2: br cprberror;                  << unexpected branch >>           26340000
                                                                        26345000
      ldni 3;                                                           26350000
      ldi 1;                                                            26355000
      ldi 3;                                                            26360000
      ldxi 2;                                                           26365000
      cprb *+2;                                                         26370000
      br cprberror;                   << did not branch >>              26375000
      be *+2;                                                           26380000
      br cprberror;                   << not cce >>                     26385000
      cmpn 3;                                                           26390000
      be *+2;                                                           26395000
      br cprberror;                   << stack trouble >>               26400000
                                                                        26405000
      zero;                                                             26410000
      load pmax;                                                        26415000
      ldx nmax;                                                         26420000
      cprb cprb3;                                                       26425000
      bl *+2;                                                           26430000
      br cprberror;                   << not ccl >>                     26435000
      br *+2;                                                           26440000
cprb3: br cprberror;                  << unexpected branch >>           26445000
                                                                        26450000
      ldni 2;                                                           26455000
      ldi 0;                                                            26460000
      ldxn 1;                                                           26465000
      cprb cprb4,i;                                                     26470000
      br cprberror;                   << did not branch >>              26475000
      br exit;                                                          26480000
cprb4:                                                                  26485000
      con 2;                                                            26490000
      br cprberror);                            << unexpected >>        26495000
exit:                                                                   26500000
       push(q);set(s);<<reset stack>>                                   26505000
       if(loopctn:=loopctn+1)=loopnumber then go out                    26510000
       else go star;                                                    26515000
                                                                        26520000
cprberror:                                                              26525000
      no'error:=false;                                                  26530000
                                                                        26535000
out:   loopctn:=0;                                                      26540000
                                                                        26545000
end;   << testcprb >>                                                   26550000
                                                                        26555000
                                                                        26560000
procedure testnop;    << test nop - for sake of completion >>           26565000
   begin                                                                26570000
       move instruct'name:="NOP   ";                                    26575000
       print'names;                                                     26580000
star:assemble(                                                          26585000
      dzro,dzro;                                               <<j8932>>26590000
      pshr %11;   << push(s,status) >>                                  26595000
      dzro,dzro;                                               <<j8676>>26600000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>26605000
      nop;                                                              26610000
      pshr %11;                                                         26615000
      incm s-3;                                                         26620000
      incm s-3;                                                         26625000
      dcmp;                                                             26630000
      be *+2;                                                           26635000
      br noperror;                   << s or status changed >>          26640000
                                                                        26645000
      ldni 5;                                                  <<c9058>>26650000
      del;    << change cce condition >>                       <<c9058>>26655000
      pshr %11;   << push(s,status) >>                                  26660000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>26665000
      nop;                                                              26670000
      pshr %11;                                                         26675000
      incm s-3;                                                         26680000
      incm s-3;                                                         26685000
      dcmp;                                                             26690000
      be next;                                                          26695000
      br noperror);                       << status or s changed >>     26700000
next:  push(q);set(s);<<reset stack>>                                   26705000
       if(loopctn:=loopctn+1)=loopnumber then go out                    26710000
       else go star;                                                    26715000
                                                                        26720000
noperror:                                                               26725000
      no'error:=false;                                                  26730000
                                                                        26735000
out:   loopctn:=0;                                                      26740000
                                                                        26745000
end;   << testnop >>                                                    26750000
                                                                        26755000
                                                                        26760000
$control segment=section2'part1                                         26765000
procedure grpx;   << test group x: field instructions >>                26770000
begin                                                                   26775000
                                                                        26780000
subroutine dpf'test;   << check dpf instruction >>                      26785000
   begin                                                                26790000
      re'addrs:=tos;    << save return address >>                       26795000
      assemble(                                                         26800000
      dzro,dzro;                                               <<j8932>>26805000
      zero;                                                             26810000
      ldi 5;                                                            26815000
      dzro,dzro;                                               <<j8676>>26820000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>26825000
      dpf 8:3;                                                          26830000
      bg *+2;                                                           26835000
      br dpferror;                   << not ccg >>                      26840000
      cmpi %240;                                                        26845000
      be *+2;                                                           26850000
      br dpferror;                   << tos not %240 >>                 26855000
                                                                        26860000
      ldi %70;                                                          26865000
      ldni 8;   <<< %177770 >>                                          26870000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>26875000
      dpf 10:3;                                                         26880000
      be *+2;                                                           26885000
      br dpferror;                   << not cce >>                      26890000
      cmpi 0;                                                           26895000
      be exit);                                                         26900000
dpferror:                                                               26905000
      no'error:=false;                   << tos not 0 >>                26910000
exit:                                                                   26915000
      push(q);set(s);   << reset stack >>                               26920000
      tos:=re'addrs;   << restore return address >>                     26925000
   end;                                                                 26930000
                                                                        26935000
<<< check exf instruction >>                                            26940000
                                                                        26945000
subroutine exf'test;                                                    26950000
   begin                                                                26955000
      re'addrs:=tos;    << save return address >>                       26960000
cexf: assemble(                                                         26965000
      dzro,dzro;                                               <<j8932>>26970000
      ldni 1;                                                           26975000
      ldi %307;                                                         26980000
      dzro,dzro;                                               <<j8676>>26985000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>26990000
      exf 7:6;                                                          26995000
      bg *+2;                                                           27000000
      br exferror;                   << not ccg >>                      27005000
      cmpi %30;                                                         27010000
      be *+2;                                                           27015000
      br exferror;                   << tos not %30 >>                  27020000
      cmpn 1;                                                           27025000
      be *+2;                                                           27030000
      br exferror;                   << stack popped >>                 27035000
                                                                        27040000
      ldni 1;                                                           27045000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>27050000
      exf 1:15;                                                         27055000
      bg *+2;                                                           27060000
      br exferror;                   << not ccg >>                      27065000
      cmpm pmax;                                                        27070000
      be *+2;                                                           27075000
      br exferror;                   << tos not %077777 >>              27080000
                                                                        27085000
      load m256;   << %177400 >>                                        27090000
      exf 8:8;                                                          27095000
      be *+2;                                                           27100000
      br exferror;                   << not cce >>                      27105000
      cmpi 0;                                                           27110000
      be *+2;                                                           27115000
      br exferror;                   << tos not 0 >>                    27120000
                                                                        27125000
<< cover tests >>                                                       27130000
                                                                        27135000
      ldi 1;                                                            27140000
      exf 15:15;                                                        27145000
      cmpm bit1;                                                        27150000
      be *+2;                                                           27155000
      br exferror;                   << tos not %40000 >>               27160000
                                                                        27165000
      load pat2500;   << %2500 >>                                       27170000
      exf 5:5;                                                          27175000
      cmpi %25;                                                         27180000
      be *+2;                                                           27185000
      br exferror;                   << tos not %25 >>                  27190000
                                                                        27195000
      load pat20020;   << %20020 >>                                     27200000
      exf 10:10;                                                        27205000
      cmpm pat402;                                                      27210000
      be exit;                                                          27215000
      br exferror);                        << tos not %402 >>           27220000
exferror:                                                               27225000
      no'error:=false;                                                  27230000
                                                                        27235000
exit:                                                                   27240000
       push(q);set(s); <<reset stack>>                                  27245000
       tos:=re'addrs;   << restore return address >>                    27250000
   end;                                                                 27255000
                                                                        27260000
       move instruct'name:="DPF   ";                                    27265000
       print'names;                                                     27270000
       while no'error and (i:=i+1) < loopnumber do dpf'test;            27275000
                                                                        27280000
       move instruct'name:="EXF   ";                                    27285000
       print'names;                                                     27290000
       while no'error and (i:=i+1) < loopnumber do exf'test;            27295000
                                                                        27300000
                                                                        27305000
end;   << grpx >>                                                       27310000
                                                                        27315000
procedure grpw;   << test group w: bit test instructions >>             27320000
begin                                                                   27325000
                                                                        27330000
<<< check tbc instruction >>                                            27335000
                                                                        27340000
subroutine tbc'test;                                                    27345000
   begin                                                                27350000
      re'addrs:=tos;    << save return address >>                       27355000
star: assemble(                                                         27360000
      dzro,dzro;                                               <<j8932>>27365000
      ldni 1;                                                           27370000
      zero;                                                             27375000
      dzro,dzro;                                               <<j8676>>27380000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>27385000
      tbc 0;                                                            27390000
      be *+2;                                                           27395000
      br tbcerror;                   << not cce >>                      27400000
      cmpi 0;                                                           27405000
      be *+2;                                                           27410000
      br tbcerror;                   << tos not 0 >>                    27415000
      cmpn 1;                                                           27420000
      be *+2;                                                           27425000
      br tbcerror;                   << stack trouble >>                27430000
                                                                        27435000
      ldi 2;                                                            27440000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>27445000
      tbc 14;                                                           27450000
      bne *+2;                                                 <<g8659>>27455000
      br tbcerror;                   << not ccg >>                      27460000
      cmpi 2;                                                           27465000
      be *+2;                                                           27470000
      br tbcerror;                   << tos not 2 >>                    27475000
                                                                        27480000
      ldni 1;                                                           27485000
      tbc 0;                                                            27490000
      bne *+2;                                                 <<g8659>>27495000
      br tbcerror;                   << not ccl >>                      27500000
      cmpn 1;                                                           27505000
      be *+2;                                                           27510000
      br tbcerror;                   << tos not -1 >>                   27515000
                                                                        27520000
      ldi 1;                                                            27525000
      ldxi 15;                                                          27530000
      tbc 0,x;   << cnt=15 >>                                           27535000
      bne *+2;                                                 <<g8659>>27540000
      br tbcerror;                   << not ccg >>                      27545000
                                                                        27550000
      ldi 2;                                                            27555000
      ldxi 0;                                                           27560000
      tbc 14,x;   << cnt=14 >>                                          27565000
      bne exit);                                               <<g8659>>27570000
tbcerror:                                                               27575000
      no'error:=false;                   << not ccg >>                  27580000
exit:                                                                   27585000
      push(q);set(s); << reset stack >>                                 27590000
      tos:=re'addrs;  << restore return address >>                      27595000
   end;                                                                 27600000
                                                                        27605000
<<< check trbc instruction >>                                           27610000
                                                                        27615000
subroutine trbc'test;                                                   27620000
   begin                                                                27625000
      re'addrs:=tos;    << save return address >>                       27630000
      assemble(                                                         27635000
      dzro,dzro;                                               <<j8932>>27640000
      ldi 7;                                                            27645000
      dzro,dzro;                                               <<j8676>>27650000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>27655000
      trbc 12;                                                          27660000
      be *+2;                 << not cce >>                             27665000
      br trbcerror;                                                     27670000
      cmpi 7;                                                           27675000
      be *+2;                                                           27680000
      br trbcerror;                   << tos not 7 >>                   27685000
                                                                        27690000
      ldi 7;                                                            27695000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>27700000
      trbc 15;                                                          27705000
      bg *+2;                                                           27710000
      br trbcerror;                   << not ccg >>                     27715000
      cmpi 6;                                                           27720000
      be exit);                                                         27725000
trbcerror:                                                              27730000
      no'error:=false;                   << tos not 6 >>                27735000
exit:                                                                   27740000
      push(q);set(s);  << reset stack >>                                27745000
      tos:=re'addrs;    << restore return address >>                    27750000
   end;                                                                 27755000
                                                                        27760000
<<< check tsbc instruction >>                                           27765000
                                                                        27770000
subroutine tsbc'test;                                                   27775000
   begin                                                                27780000
      re'addrs:=tos;    << save return address >>                       27785000
      assemble(                                                         27790000
      dzro,dzro;                                               <<j8932>>27795000
      ldi 2;                                                            27800000
      dzro,dzro;                                               <<j8676>>27805000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>27810000
      tsbc 15;                                                          27815000
      be *+2;                                                           27820000
      br tsbcerror;                   << not cce >>                     27825000
      cmpi 3;                                                           27830000
      be *+2;                                                           27835000
      br tsbcerror;                   << tos not 3 >>                   27840000
                                                                        27845000
      ldi 2;                                                            27850000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>27855000
      tsbc 14;                                                          27860000
      bg *+2;                                                           27865000
      br tsbcerror;                   << not ccg >>                     27870000
      cmpi 2;                                                           27875000
      be exit);                                                         27880000
tsbcerror:                                                              27885000
      no'error:=false;                   << tos not 2 >>                27890000
exit:                                                                   27895000
      push(q);set(s); << reset stack >>                                 27900000
      tos:=re'addrs;    << restore return address >>                    27905000
   end;                                                                 27910000
                                                                        27915000
<<< check tcbc instruction >>                                           27920000
                                                                        27925000
subroutine tcbc'test;                                                   27930000
   begin                                                                27935000
      re'addrs:=tos;    << save return address >>                       27940000
      assemble(                                                         27945000
      dzro,dzro;                                               <<j8932>>27950000
      ldi 4;                                                            27955000
      dzro,dzro;                                               <<j8676>>27960000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>27965000
      tcbc 14;                                                          27970000
      be *+2;                                                           27975000
      br tcbcerror;                   << not cce >>                     27980000
      cmpi 6;                                                           27985000
      be *+2;                                                           27990000
      br tcbcerror;                   << tos not 6 >>                   27995000
                                                                        28000000
      ldi 7;                                                            28005000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>28010000
      tcbc 13;                                                          28015000
      bg *+2;                                                           28020000
      br tcbcerror;                   << not ccg >>                     28025000
      cmpi 3;                                                           28030000
      be exit;                                                          28035000
      br tcbcerror;                       << tos not 3 >>               28040000
      nop);                                                             28045000
                                                                        28050000
                                                                        28055000
tcbcerror:                                                              28060000
      no'error:=false;                                                  28065000
                                                                        28070000
exit:                                                                   28075000
      push(q);set(s); << reset stack >>                                 28080000
      tos:=re'addrs;    << restore return address >>                    28085000
   end;                                                                 28090000
                                                                        28095000
      move instruct'name:="TBC   ";                                     28100000
      print'names;                                                      28105000
      while no'error and (i:=i+1) < loopnumber do tbc'test;             28110000
                                                                        28115000
      move instruct'name:="TRBC  ";                                     28120000
      print'names;                                                      28125000
      while no'error and (i:=i+1) < loopnumber do trbc'test;            28130000
                                                                        28135000
      move instruct'name:="TSBC  ";                                     28140000
      print'names;                                                      28145000
      while no'error and (i:=i+1) < loopnumber do tsbc'test;            28150000
                                                                        28155000
      move instruct'name:="TCBC  ";                                     28160000
      print'names;                                                      28165000
      while no'error and (i:=i+1) < loopnumber do tcbc'test;            28170000
                                                                        28175000
                                                                        28180000
end;   << grpw >>                                                       28185000
                                                                        28190000
procedure grpi;   << test group i: double integer instructions >>       28195000
begin                                                                   28200000
                                                                        28205000
<<< check dadd instruction >>                                           28210000
                                                                        28215000
subroutine dadd'test;                                                   28220000
   begin                                                                28225000
      re'addrs:=tos;    << save return address >>                       28230000
      assemble(                                                         28235000
      ldi 1;   <<< try %1,5 + %4,7 = %5,12 >>                           28240000
      ldi 5;                                                            28245000
      ldi 4;                                                            28250000
      ldi 7;                                                            28255000
      dzro,dzro;                                               <<j8676>>28260000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>28265000
      dadd;                                                             28270000
      bg *+2;                                                           28275000
      br dadderror;                   << not ccg >>                     28280000
      bnov *+2;                                                         28285000
      br dadderror;                   << o not 0 >>                     28290000
      bncy *+2;                                                         28295000
      br dadderror;                   << c not 0 >>                     28300000
      cmpi 12;                                                          28305000
      be *+2;                                                           28310000
      br dadderror;                   << tos not 12 >>                  28315000
      cmpi 5;                                                           28320000
      be *+2;                                                           28325000
      br dadderror;                   << (s-1) not 5 >>                 28330000
                                                                        28335000
      ldni 1;   << try -1d + -1d = -2d >>                               28340000
      dup,ddup;                                                         28345000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>28350000
      dadd;                                                             28355000
      bl *+2;                                                           28360000
      br dadderror;                   << not ccl >>                     28365000
      bnov *+2;                                                         28370000
      br dadderror;                   << o not 0 >>                     28375000
      bcy *+2;                                                          28380000
      br dadderror;                   << c not 1 >>                     28385000
      cmpn 2;                                                           28390000
      be *+2;                                                           28395000
      br dadderror;                   << tos not -2 >>                  28400000
      cmpn 1;                                                           28405000
      be *+2;                                                           28410000
      br dadderror;                   << (s-1) not -1 >>                28415000
                                                                        28420000
      load nmax;   <<< try %100000,000000 + %100000,000000 = 0 >>       28425000
      zero,ddup;                                                        28430000
      dadd;                                                             28435000
      be *+2;                                                           28440000
      br dadderror;                   << not cce >>                     28445000
      bcy *+2;                                                          28450000
      br dadderror;                   << c  not 1 >>                    28455000
      bov *+2;                                                          28460000
      br dadderror;                   << o not 1 >>                     28465000
      dzro,dcmp;                                                        28470000
      be exit);                                                         28475000
dadderror:                                                              28480000
      no'error:=false;                   << (s-1,s) not 0,0 >>          28485000
exit:                                                                   28490000
      push(q);set(s); << reset stack >>                                 28495000
      tos:=re'addrs;    << restore return address >>                    28500000
                                                                        28505000
  end;                                                                  28510000
                                                                        28515000
<<< check dneg instruction >>                                           28520000
                                                                        28525000
subroutine dneg'test;                                                   28530000
   begin                                                                28535000
      re'addrs:=tos;    << save return address >>                       28540000
      assemble(                                                         28545000
      dzro,dzro;                                               <<j8932>>28550000
      dzro,inca;   <<< try 0,1 >>                                       28555000
      dzro,dzro;                                               <<j8676>>28560000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>28565000
      dneg;                                                             28570000
      bl *+2;                                                           28575000
      br dnegerror;                   << not ccl >>                     28580000
      bnov *+2;                                                         28585000
      br dnegerror;                   << o not 0 >>                     28590000
      cmpn 1;                                                           28595000
      be *+2;                                                           28600000
      br dnegerror;                   << tos not %177777 >>             28605000
      cmpn 1;                                                           28610000
      be *+2;                                                           28615000
      br dnegerror;                   << (s-1) not %177777 >>           28620000
                                                                        28625000
      load nmax;   <<< try %100000,000000 >>                            28630000
      zero,dneg;                                                        28635000
      bl *+2;                                                           28640000
      br dnegerror;                   << not ccl >>                     28645000
      bov *+2;                                                          28650000
      br dnegerror;                   << o not 1 >>                     28655000
      cmpi 0;                                                           28660000
      be *+2;                                                           28665000
      br dnegerror;                   << tos not 0 >>                   28670000
      cmpm nmax;                                                        28675000
      be *+2;                                                           28680000
      br dnegerror;                   << (s-1) not %100000 >>           28685000
                                                                        28690000
      ldni 1;   <<< try -6d >>                                          28695000
      ldni 6;                                                           28700000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>28705000
      dneg;                                                             28710000
      bg *+2;                                                           28715000
      br dnegerror;                   << not ccg >>                     28720000
      bnov *+2;                                                         28725000
      br dnegerror;                   << o not 0 >>                     28730000
      cmpi 6;                                                           28735000
      be *+2;                                                           28740000
      br dnegerror;                   << tos not 6 >>                   28745000
      cmpi 0;                                                           28750000
      be exit);                                                         28755000
dnegerror:                                                              28760000
      no'error:=false;                   << (s-1) not 0 >>              28765000
exit:                                                                   28770000
      push(q);set(s);  << reset stack >>                                28775000
      tos:=re'addrs;    << restore return address >>                    28780000
                                                                        28785000
   end;                                                                 28790000
                                                                        28795000
<<< check dsub instruction >>                                           28800000
                                                                        28805000
subroutine dsub'test;                                                   28810000
   begin                                                                28815000
      re'addrs:=tos;    << save return address >>                       28820000
      assemble(                                                         28825000
      zero;   <<< try 3d - 4d = -1d >>                                  28830000
      ldi 3;                                                            28835000
      zero;                                                             28840000
      ldi 4;                                                            28845000
      dzro,dzro;                                               <<j8676>>28850000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>28855000
      dsub;                                                             28860000
      bl *+2;                                                           28865000
      br dsuberror;                   << not ccl >>                     28870000
      bnov *+2;                                                         28875000
      br dsuberror;                   << o not 0 >>                     28880000
      bncy *+2;                                                         28885000
      br dsuberror;                   << c not 0 >>                     28890000
      ldni 1;                                                           28895000
      dup,dcmp;                                                         28900000
      be *+2;                                                           28905000
      br dsuberror;                   << tos not -1d >>                 28910000
                                                                        28915000
      zero;   << try 4d-3d=1d >>                                        28920000
      ldi 4;                                                            28925000
      zero;                                                             28930000
      ldi 3;                                                            28935000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>28940000
      dsub;                                                             28945000
      bg *+2;                                                           28950000
      br dsuberror;                   << not ccg >>                     28955000
      bnov *+2;                                                         28960000
      br dsuberror;                   << o not 0 >>                     28965000
      bcy *+2;                                                          28970000
      br dsuberror;                   << c not 1 >>                     28975000
      ldi 0;                                                            28980000
      ldi 1;                                                            28985000
      dcmp;                                                             28990000
      be *+2;                                                           28995000
      br dsuberror;                   << result not 0,1 >>              29000000
                                                                        29005000
      ldni 1;   << try -1d-0d=-1d;  check carry=1 >>                    29010000
      dup,dzro;                                                         29015000
      dsub;                                                             29020000
      bcy *+2;                                                          29025000
      br dsuberror;                   << c not 1 >>                     29030000
      ldni 1;                                                           29035000
      dup,dcmp;                                                         29040000
      be *+2;                                                           29045000
      br dsuberror;                   << result not -1d >>              29050000
                                                                        29055000
      load nmax;   << try -1*2**31 - (-1*2**31) >>                      29060000
      zero,ddup;                                                        29065000
      dsub;                                                             29070000
      bnov *+2;                                                         29075000
      br dsuberror;                   << o not 0 >>                     29080000
      bcy *+2;                                                          29085000
      br dsuberror;                   << c not 1 >>                     29090000
      dzro,dcmp;                                                        29095000
      be *+2;                                                           29100000
      br dsuberror;                   << result not 0,0 >>              29105000
                                                                        29110000
      dzro;        << try 0d - (-1*2**31) >>                            29115000
      load nmax;                                                        29120000
      zero,dsub;                                                        29125000
      bov *+2;                                                          29130000
      br dsuberror;                   << o not 1 >>                     29135000
      bncy *+2;                                                         29140000
      br dsuberror;                   << c not 0 >>                     29145000
      load nmax;                                                        29150000
      zero,dcmp;                                                        29155000
      be *+2;                                                           29160000
      br dsuberror;                   << result not %100000, 0 >>       29165000
                                                                        29170000
      ldni 1;   << try -1d - (-1*2**31) >>                              29175000
      dup;                                                              29180000
      load nmax;                                                        29185000
      zero,dsub;                                                        29190000
      bnov *+2;                                                         29195000
      br dsuberror;                   << o not 0 >>                     29200000
      bcy *+2;                                                          29205000
      br dsuberror;                   << c not 1 >>                     29210000
      load pmax;                                                        29215000
      ldni 1;                                                           29220000
      dcmp;                                                             29225000
      be exit);                                                         29230000
dsuberror:                                                              29235000
      no'error:=false;                   << result not %77777, -1 >>    29240000
exit:                                                                   29245000
      push(q);set(s);  << reset stack >>                                29250000
      tos:=re'addrs;    << restore return address >>                    29255000
                                                                        29260000
   end;                                                                 29265000
                                                                        29270000
<<< check divl instruction >>                                           29275000
                                                                        29280000
subroutine divl'test;                                                   29285000
   begin                                                                29290000
      re'addrs:=tos;    << save return address >>                       29295000
      assemble(                                                         29300000
      dzro,dzro;                                               <<j8932>>29305000
      zero;   <<< try 25/7 >>                                           29310000
      ldi 25;                                                           29315000
      ldi 7;                                                            29320000
      dzro,dzro;                                               <<j8676>>29325000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>29330000
      divl;                                                             29335000
      bg *+2;                 << not ccg >>                             29340000
      br divlerror;                                                     29345000
      bnov *+2;                                                         29350000
      br divlerror;                   << o not 0 >>                     29355000
      cmpi 4;                                                           29360000
      be *+2;                                                           29365000
      br divlerror;                   << remainder not 4 >>             29370000
      cmpi 3;                                                           29375000
      be *+2;                                                           29380000
      br divlerror;                   << quotient not 3 >>              29385000
                                                                        29390000
      zero;   <<< try 25/(-7) >>                                        29395000
      ldi 25;                                                           29400000
      ldni 7;                                                           29405000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>29410000
      divl;                                                             29415000
      bl *+2;                 << not ccl >>                             29420000
      br divlerror;                                                     29425000
      bnov *+2;                                                         29430000
      br divlerror;                   << o not 0 >>                     29435000
      cmpi 4;                                                           29440000
      be *+2;                                                           29445000
      br divlerror;                   << remainder not 4 >>             29450000
      cmpn 3;                                                           29455000
      be *+2;                                                           29460000
      br divlerror;                   << quotient not -3 >>             29465000
                                                                        29470000
      ldni 1;   <<< try -25/7 >>                                        29475000
      ldni 25;                                                          29480000
      ldi 7;                                                            29485000
      divl;                                                             29490000
      bl *+2;                                                           29495000
      br divlerror;                   << not ccl >>                     29500000
      bnov *+2;                                                         29505000
      br divlerror;                   << o not 0 >>                     29510000
      cmpn 4;                                                           29515000
      be *+2;                                                           29520000
      br divlerror;                   << remainder not -4 >>            29525000
      cmpn 3;                                                           29530000
      be *+2;                                                           29535000
      br divlerror;                   << quotient not -3 >>             29540000
                                                                        29545000
      ldni 1;   << try -25/(-7) >>                                      29550000
      ldni 25;                                                          29555000
      ldni 7;                                                           29560000
      divl;                                                             29565000
      bg *+2;                                                           29570000
      br divlerror;                   << not ccg >>                     29575000
      bnov *+2;                                                         29580000
      br divlerror;                   << o not 0 >>                     29585000
      cmpn 4;                                                           29590000
      be *+2;                                                           29595000
      br divlerror;                   << remainder not -4 >>            29600000
      cmpi 3;                                                           29605000
      be *+2;                                                           29610000
      br divlerror;                   << quotient not 3 >>              29615000
                                                                        29620000
      ldni 1;   <<< try -2**16/2 >>                                     29625000
      zero;                                                             29630000
      ldi 2;                                                            29635000
      divl;                                                             29640000
      bl *+2;                                                           29645000
      br divlerror;                   << not ccl >>                     29650000
      bnov *+2;                                                         29655000
      br divlerror;                   << o not 0 >>                     29660000
      cmpi 0;                                                           29665000
      be *+2;                                                           29670000
      br divlerror;                   << remainder not 0 >>             29675000
      cmpm nmax;                                                        29680000
      be *+2;                                                           29685000
      br divlerror;                   << quotient not %100000 >>        29690000
                                                                        29695000
      zero;   <<< try 2**15/1 >>                                        29700000
      load nmax;                                                        29705000
      ldi 1;                                                            29710000
      divl;                                                             29715000
      bl *+2;                                                           29720000
      br divlerror;                   << not ccl >>                     29725000
      bov *+2;                                                          29730000
      br divlerror;                   << o not 1 >>                     29735000
      cmpi 0;                                                           29740000
      be *+2;                                                           29745000
      br divlerror;                   << remainder not 0 >>             29750000
      cmpm nmax;                                                        29755000
      be *+2;                                                           29760000
      br divlerror;                   << quotient not %100000 >>        29765000
                                                                        29770000
      ldi 127;   <<< try 127*2**16/127 >>                               29775000
      zero;                                                             29780000
      ldi 127;                                                          29785000
      divl;                                                             29790000
      bov *+2;                                                          29795000
      br divlerror;                   << o not 1 >>                     29800000
      ddel;                                                    <<03727>>29805000
                                                                        29810000
      ldi 5;   <<< try divide by 0 >>                                   29815000
      ldi 6;                                                            29820000
      ldi 0;                                                            29825000
      divl;                                                             29830000
      bov *+2;                                                          29835000
      br divlerror;                   << o not 1 >>                     29840000
      del;                                                              29845000
      cmpi 5;                                                           29850000
      be *+2;                                                           29855000
      br divlerror;                   << (s-1) not 5 >>                 29860000
                                                                        29865000
      zero;   <<< try (2**15-1)/-2**15 >>                               29870000
      load pmax;                                                        29875000
      load nmax;                                                        29880000
      divl;                                                             29885000
      be *+2;                                                           29890000
      br divlerror;                   << not cce >>                     29895000
      bnov *+2;                                                         29900000
      br divlerror;                   << o not 0 >>                     29905000
      cmpm pmax;                                                        29910000
      be *+2;                                                           29915000
      br divlerror;                   << remainder not %077777 >>       29920000
      cmpi 0;                                                           29925000
      be exit);                                                         29930000
divlerror:                                                              29935000
      no'error:=false;                   << quotient not 0 >>           29940000
exit:                                                                   29945000
      push(q);set(s);  << reset stack >>                                29950000
      tos:=re'addrs;    << restore return address >>                    29955000
                                                                        29960000
   end;                                                                 29965000
                                                                        29970000
<< check mpyl instruction >>                                            29975000
                                                                        29980000
subroutine mpyl'test;                                                   29985000
   begin                                                                29990000
      re'addrs:=tos;    << save return address >>                       29995000
      assemble(                                                         30000000
      dzro,dzro;                                               <<j8932>>30005000
      ldi 2;                                                            30010000
      ldi 5;                                                            30015000
      dzro,dzro;                                               <<j8676>>30020000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>30025000
      mpyl;   << 5*2 >>                                                 30030000
      bg *+2;                                                           30035000
      br mpylerror;                   << not ccg >>                     30040000
      bnov *+2;                                                         30045000
      br mpylerror;                   << o not 0 >>                     30050000
      bncy *+2;                                                         30055000
      br mpylerror;                   << c not 0 >>                     30060000
      ldi 0;                                                            30065000
      ldi 10;                                                           30070000
      dcmp;                                                             30075000
      be *+2;                                                           30080000
      br mpylerror;                   << result not 0,10 >>             30085000
                                                                        30090000
      load bit0;                                                        30095000
      dup,add;  << make c=o=1 >>                                        30100000
      ldni 1;                                                           30105000
      ldi 1;                                                            30110000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>30115000
      mpyl;   << -1*1 >>                                                30120000
      bl *+2;                                                           30125000
      br mpylerror;                   << not ccl >>                     30130000
      bnov *+2;                                                         30135000
      br mpylerror;                   << o not 0 >>                     30140000
      bncy *+2;                                                         30145000
      br mpylerror;                   << c not 0 >>                     30150000
      ldni 1;                                                           30155000
      dup,dcmp;                                                         30160000
      be *+2;                                                           30165000
      br mpylerror;                   << result not -1,-1 >>            30170000
                                                                        30175000
      ldni 1;                                                           30180000
      dup,add;  << c=1 >>                                               30185000
      ldni 1;                                                           30190000
      dup,mpyl;   << -1*(-1) >>                                         30195000
      bg *+2;                                                           30200000
      br mpylerror;                   << not ccg >>                     30205000
      bncy *+2;                                                         30210000
      br mpylerror;                   << c not 0 >>                     30215000
      dzro,inca;                                                        30220000
      dcmp;                                                             30225000
      be *+2;                                                           30230000
      br mpylerror;                   << result not 0,1 >>              30235000
                                                                        30240000
      load bit0;                                                        30245000
      ldi 2;    << %100000*2 >>                                         30250000
      mpyl;                                                             30255000
      bl *+2;                                                           30260000
      br mpylerror;                   << not ccl >>                     30265000
      bcy *+2;                                                          30270000
      br mpylerror;                   << c not 1 >>                     30275000
      bnov *+2;                                                         30280000
      br mpylerror;                   << o not 0 >>                     30285000
      ldni 1;                                                           30290000
      zero,dcmp;                                                        30295000
      be *+2;                                                           30300000
      br mpylerror;                   << result not -1,0 >>             30305000
                                                                        30310000
      load bit0;                                                        30315000
      dup,mpyl;                                                         30320000
      bg *+2;                                                           30325000
      br mpylerror;                   << not ccl >>                     30330000
      bcy *+2;                                                          30335000
      br mpylerror;                   << carry not 1 >>                 30340000
      load bit1;                                                        30345000
      zero,dcmp;                                                        30350000
      be exit;                                                          30355000
      br mpylerror);                        << result not %40000,0 >>   30360000
                                                                        30365000
mpylerror:                                                              30370000
      no'error:=false;                                                  30375000
                                                                        30380000
exit:                                                                   30385000
       push(q);set(s);  << reset stack >>                               30390000
       tos:=re'addrs;   << restore return address >>                    30395000
                                                                        30400000
  end;                                                                  30405000
                                                                        30410000
       move instruct'name:="DADD  ";                                    30415000
       print'names;                                                     30420000
       while no'error and (i:=i+1) < loopnumber do dadd'test;           30425000
                                                                        30430000
       move instruct'name:="DNEG  ";                                    30435000
       print'names;                                                     30440000
       while no'error and (i:=i+1) < loopnumber do dneg'test;           30445000
                                                                        30450000
       move instruct'name:="DSUB  ";                                    30455000
       print'names;                                                     30460000
       while no'error and (i:=i+1) < loopnumber do dsub'test;           30465000
                                                                        30470000
       move instruct'name:="DIVL  ";                                    30475000
       print'names;                                                     30480000
       while no'error and (i:=i+1) < loopnumber do divl'test;           30485000
                                                                        30490000
       move instruct'name:="MPYL  ";                                    30495000
       print'names;                                                     30500000
       while no'error and (i:=i+1) < loopnumber do mpyl'test;           30505000
                                                                        30510000
                                                                        30515000
end;   << grpi >>                                                       30520000
                                                                        30525000
procedure grpf;   << test group f: loop control branch instructions >>  30530000
begin                                                                   30535000
                                                                        30540000
<<< check tba instruction >>                                            30545000
                                                                        30550000
subroutine tba'test;                                                    30555000
   begin                                                                30560000
      re'addrs:=tos;    << save return address >>                       30565000
      assemble(                                                         30570000
      dzro,dzro;                                               <<j8932>>30575000
      ldni 1;                                                           30580000
      ldi 3;                                                            30585000
      stor var1;   <<< var=3 >>                                         30590000
      lra var1;                                                         30595000
      ldi 1;       <<< step=1 >>                                        30600000
      ldi 2;       <<< final=2 >>                                       30605000
      ldni 5;                                                           30610000
      del;   << make cc=ccl >>                                          30615000
      dzro,dzro;                                               <<j8676>>30620000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>30625000
      tba tbae;                                                         30630000
      bl *+2;                                                           30635000
      br tbaerror;                   << cc changed >>                   30640000
      cmpn 1;                                                           30645000
      be *+2;                                                           30650000
      br tbaerror;                   << tos not -1 >>                   30655000
      load var1;                                                        30660000
      cmpi 3;                                                           30665000
      be *+2;                                                           30670000
      br tbaerror;                   << var not 3 >>                    30675000
      br *+2;                                                           30680000
tbae: br tbaerror;                   << unexpected branch >>            30685000
                                                                        30690000
      ldni 2;                                                           30695000
      stor var0;   <<< var=-2 >>                                        30700000
      lra var0;                                                         30705000
      ldni 2;      <<< step=-2 >>                                       30710000
      dup;         <<< final =-2 >>                                     30715000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>30720000
      tba *+2;                                                          30725000
      br tbaerror;                   <<< did not branch >>              30730000
      ldni 2;                                                           30735000
      dup,dcmp;                                                         30740000
      be *+2;                                                           30745000
      br tbaerror;                   << (s-1,s) not -2,-2 >>            30750000
      lra var0;                                                         30755000
      cmp;                                                              30760000
      be *+2;                                                           30765000
      br tbaerror;                   << (s-2) was not db rel addr >>    30770000
      load var0;                                                        30775000
      cmpn 2;                                                           30780000
      be exit);                                                         30785000
tbaerror:                                                               30790000
      no'error:=false;                   << var not -2 >>               30795000
exit:                                                                   30800000
      push(q);set(s); << reset stack >>                                 30805000
      tos:=re'addrs;    << restore return address >>                    30810000
   end;                                                                 30815000
                                                                        30820000
<<< check mtba instruction >>                                           30825000
                                                                        30830000
subroutine mtba'test;                                                   30835000
   begin                                                                30840000
      re'addrs:=tos;    << save return address >>                       30845000
      assemble(                                                         30850000
      ldni 30;                                                          30855000
      zero;                                                             30860000
      stor var0;   <<< var=0 >>                                         30865000
      lra var0;                                                         30870000
      ldi 1;       <<< step=1 >>                                        30875000
      zero;        <<< final=0 >>                                       30880000
      mtba mtbae;                                                       30885000
      cmpn 30;                                                          30890000
      be *+2;                                                           30895000
      br mtbaerror;                   << tos not -30 >>                 30900000
      load var0;                                                        30905000
      cmpi 1;                                                           30910000
      be *+2;                                                           30915000
      br mtbaerror;                   << var not 1 >>                   30920000
      br *+2;                                                           30925000
mtbae: br mtbaerror;                  << unexpected branch >>           30930000
                                                                        30935000
      ldni 1;                                                           30940000
      stor var1;   <<< var=-1 >>                                        30945000
      lra var1;                                                         30950000
      ldni 1;      <<< step=-1 >>                                       30955000
      ldni 2;      <<< final=-2 >>                                      30960000
      mtba *+2;                                                         30965000
      br mtbaerror;                   << did not branch >>              30970000
      ldni 1;                                                           30975000
      ldni 2;                                                           30980000
      dcmp;                                                             30985000
      be *+2;                                                           30990000
      br mtbaerror;                   << (s-1,s) not -1,-2 >>           30995000
      load var1;                                                        31000000
      cmpn 2;                                                           31005000
      be exit);                                                         31010000
mtbaerror:                                                              31015000
      no'error:=false;                   << var not -2 >>               31020000
exit:                                                                   31025000
      push(q);set(s); << reset stack >>                                 31030000
      tos:=re'addrs;    << restore return address >>                    31035000
   end;                                                                 31040000
                                                                        31045000
<<< check tbx instruction >>                                            31050000
                                                                        31055000
subroutine tbx'test;                                                    31060000
   begin                                                                31065000
      re'addrs:=tos;    << save return address >>                       31070000
      assemble(                                                         31075000
      zrox;    <<< var=0 >>                                             31080000
      ldni 10;                                                          31085000
      ldi 1;   <<< step=1 >>                                            31090000
      ldni 1;  <<< final=-1 >>                                          31095000
      tbx tbxe;                                                         31100000
      cmpn 10;                                                          31105000
      be *+2;                                                           31110000
      br tbxerror;                   << tos not -10 >>                  31115000
      ldxa;                                                             31120000
      be *+2;                                                           31125000
      br tbxerror;                   << x not 0 after ldxa >>           31130000
      br exit);                                                         31135000
tbxe:                                                                   31140000
tbxerror:                                                               31145000
      no'error:=false;                   << unexpected branch >>        31150000
exit:                                                                   31155000
      push(q);set(s); << reset stack >>                                 31160000
      tos:=re'addrs;    << restore return address >>                    31165000
   end;                                                                 31170000
                                                                        31175000
<<< check mtbx instruction >>                                           31180000
                                                                        31185000
subroutine mtbx'test;                                                   31190000
   begin                                                                31195000
      re'addrs:=tos;    << save return address >>                       31200000
      assemble(                                                         31205000
      ldxi 4;  <<< var=4 >>                                             31210000
      ldi 3;   <<< step=3 >>                                            31215000
      ldi 27;  <<< limit=27 >>                                          31220000
      mtbx *+2;                                                         31225000
      br mtbxerror;                   << did not branch >>              31230000
      cmpi 27;                                                          31235000
      be *+2;                                                           31240000
      br mtbxerror;                   << tos not 27 >>                  31245000
      ldxa;                                                             31250000
      cmpi 7;                                                           31255000
      be exit;                                                          31260000
      br mtbxerror;                        << x not 7 >>                31265000
      nop);                                                             31270000
                                                                        31275000
                                                                        31280000
mtbxerror:                                                              31285000
      no'error:=false;                                                  31290000
                                                                        31295000
exit:                                                                   31300000
       push(q);set(s); << reset stack >>                                31305000
       tos:=re'addrs;   << restore return address >>                    31310000
  end;                                                                  31315000
                                                                        31320000
                                                                        31325000
       move instruct'name:="TBA   ";                                    31330000
       print'names;                                                     31335000
       while no'error and (i:=i+1) < loopnumber do tba'test;            31340000
                                                                        31345000
       move instruct'name:="MTBA  ";                                    31350000
       print'names;                                                     31355000
       while no'error and (i:=i+1) < loopnumber do mtba'test;           31360000
                                                                        31365000
       move instruct'name:="TBX   ";                                    31370000
       print'names;                                                     31375000
       while no'error and (i:=i+1) < loopnumber do tbx'test;            31380000
                                                                        31385000
       move instruct'name:="MTBX  ";                                    31390000
       print'names;                                                     31395000
       while no'error and (i:=i+1) < loopnumber do mtbx'test;           31400000
                                                                        31405000
                                                                        31410000
                                                                        31415000
end;   << grpf >>                                                       31420000
                                                                        31425000
procedure grpt;   << test group t: single word shift instructions >>    31430000
begin                                                                   31435000
                                                                        31440000
<<< check asl instruction >>                                            31445000
                                                                        31450000
subroutine asl'test;                                                    31455000
   begin                                                                31460000
      re'addrs:=tos;    << save return address >>                       31465000
      assemble(                                                         31470000
      dzro,dzro;                                               <<j8932>>31475000
      ldi 1;                                                            31480000
      dzro,dzro;                                               <<j8676>>31485000
      ddel,ddel;                                               <<j8676>>31490000
      asl 2;                                                            31495000
      bg *+2;                 << not ccg >>                             31500000
      br aslerror;                                                      31505000
      cmpi 4;                                                           31510000
      be *+2;                                                           31515000
      br aslerror;                   << tos not 4 >>                    31520000
                                                                        31525000
      ldni 1;                                                           31530000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>31535000
      asl 3;                                                            31540000
      bl *+2;                                                           31545000
      br aslerror;                   << not ccl >>                      31550000
      cmpn 8;                                                           31555000
      be *+2;                                                           31560000
      br aslerror;                   << tos not -8 >>                   31565000
                                                                        31570000
      ldi 4;                                                            31575000
      asl 13;                                                           31580000
      be *+2;                                                           31585000
      br aslerror;                   << not cce >>                      31590000
      cmpi 0;                                                           31595000
      be *+2;                                                           31600000
      br aslerror;                   << tos not 0 >>                    31605000
                                                                        31610000
      ldni 1;                                                           31615000
      asl 63;                                                           31620000
      cmpm nmax;                                                        31625000
      be *+2;                                                           31630000
      br aslerror;                   << tos not %100000 >>              31635000
                                                                        31640000
      ldi 5;                                                            31645000
      asl 0;                                                            31650000
      cmpi 5;                                                           31655000
      be exit);                                                         31660000
aslerror:                                                               31665000
      no'error:=false;                   << tos not 5 >>                31670000
exit:                                                                   31675000
      push(q);set(s);  << reset stack >>                                31680000
      tos:=re'addrs;    << restore return address >>                    31685000
   end;                                                                 31690000
                                                                        31695000
<<< check lsl instruction >>                                            31700000
                                                                        31705000
subroutine lsl'test;                                                    31710000
   begin                                                                31715000
      re'addrs:=tos;    << save return address >>                       31720000
     assemble(                                                          31725000
      dzro,dzro;                                               <<j8932>>31730000
      ldi 3;                                                            31735000
      dzro,dzro;                                               <<j8676>>31740000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>31745000
      lsl 4;                                                            31750000
      bg *+2;                                                           31755000
      br lslerror;                   << not ccg >>                      31760000
      cmpi 48;                                                          31765000
      be *+2;                                                           31770000
      br lslerror;                   << tos not 48 >>                   31775000
                                                                        31780000
      ldi 1;                                                            31785000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>31790000
      lsl 15;                                                           31795000
      cmpm nmax;                                                        31800000
      be *+2;                                                           31805000
      br lslerror;                   << tos not %100000 >>              31810000
                                                                        31815000
      ldni 1;                                                           31820000
      lsl 16;                                                           31825000
      cmpi 0;                                                           31830000
      be exit);                                                         31835000
lslerror:                                                               31840000
      no'error:=false;                   << tos not 0 >>                31845000
exit:                                                                   31850000
      push(q);set(s);  << reset stack >>                                31855000
      tos:=re'addrs;    << restore return address >>                    31860000
   end;                                                                 31865000
                                                                        31870000
<<< check csl instruction >>                                            31875000
                                                                        31880000
subroutine csl'test;                                                    31885000
   begin                                                                31890000
      re'addrs:=tos;    << save return address >>                       31895000
     assemble(                                                          31900000
      dzro,dzro;                                               <<j8932>>31905000
      ldi 2;                                                            31910000
      dzro,dzro;                                               <<j8676>>31915000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>31920000
      csl 15;                                                           31925000
      bg *+2;                                                           31930000
      br cslerror;                   << not ccg >>                      31935000
      cmpi 1;                                                           31940000
      be *+2;                                                           31945000
      br cslerror;                   << tos not 1 >>                    31950000
                                                                        31955000
      ldi 6;                                                            31960000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>31965000
      csl 14;                                                           31970000
      cmpm endbits1;                                                    31975000
      be *+2;                                                           31980000
      br cslerror;                   << tos not %100001 >>              31985000
                                                                        31990000
      ldi 62;                                                           31995000
      csl 48;                                                           32000000
      cmpi 62;                                                          32005000
      be *+2;                                                           32010000
      br cslerror;                   << tos not 62 >>                   32015000
                                                                        32020000
      ldi 8;                                                            32025000
      ldxi 65;                                                          32030000
      csl 0,x;   << cnt=65mod64=1 >>                                    32035000
      cmpi 16;                                                          32040000
      be exit);                                                         32045000
cslerror:                                                               32050000
      no'error:=false;                   << tos not 16 >>               32055000
exit:                                                                   32060000
      push(q);set(s);   << reset stack >>                               32065000
      tos:=re'addrs;    << restore return address >>                    32070000
   end;                                                                 32075000
                                                                        32080000
<<< check asr instruction >>                                            32085000
                                                                        32090000
subroutine asr'test;                                                    32095000
   begin                                                                32100000
      re'addrs:=tos;    << save return address >>                       32105000
      assemble(                                                         32110000
      dzro,dzro;                                               <<j8932>>32115000
      ldi 20;                                                           32120000
      dzro,dzro;                                               <<j8676>>32125000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>32130000
      asr 2;                                                            32135000
      bg *+2;                                                           32140000
      br asrerror;                   << not ccg >>                      32145000
      cmpi 5;                                                           32150000
      be *+2;                                                           32155000
      br asrerror;                   << tos not 5 >>                    32160000
                                                                        32165000
      ldi 2;                                                            32170000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>32175000
      asr 2;                                                            32180000
      be *+2;                 << not cce >>                             32185000
      br asrerror;                                                      32190000
      cmpi 0;                                                           32195000
      be *+2;                                                           32200000
      br asrerror;                   << tos not 0 >>                    32205000
                                                                        32210000
      load m256;                                                        32215000
      asr 4;                                                            32220000
      cmpn 16;                                                          32225000
      be *+2;                                                           32230000
      br asrerror;                   << tos not -16 >>                  32235000
                                                                        32240000
      load nmax;                                                        32245000
      asr 61;                                                           32250000
      cmpn 1;                                                           32255000
      be *+2;                                                           32260000
      br asrerror;                   << tos not -1 >>                   32265000
                                                                        32270000
      ldi 5;                                                            32275000
      asr 0;                                                            32280000
      cmpi 5;                                                           32285000
      be *+2;                                                           32290000
      br asrerror;                   << tos not 5 >>                    32295000
                                                                        32300000
      load bit0;                                                        32305000
      ldxi 14;                                                          32310000
      asr 0,x;   << cnt=14>>                                            32315000
      cmpn 2;                                                           32320000
      be *+2;                                                           32325000
      br asrerror;                   << tos not -2 >>                   32330000
                                                                        32335000
      ldi 37;                                                           32340000
      ldxi 64;                                                          32345000
      asr 0,x;   << cnt=64 >>                                           32350000
      cmpi 37;                                                          32355000
      be exit);                                                         32360000
asrerror:                                                               32365000
      no'error:=false;                   << tos not 37 >>               32370000
exit:                                                                   32375000
      push(q);set(s);  << reset stack >>                                32380000
      tos:=re'addrs;    << restore return address >>                    32385000
   end;                                                                 32390000
                                                                        32395000
<<< check lsr instruction >>                                            32400000
                                                                        32405000
subroutine lsr'test;                                                    32410000
   begin                                                                32415000
      re'addrs:=tos;    << save return address >>                       32420000
clsr:assemble(                                                          32425000
      dzro,dzro;                                               <<j8932>>32430000
      ldi 7;                                                            32435000
      dzro,dzro;                                               <<j8676>>32440000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>32445000
      lsr 1;                                                            32450000
      bg *+2;                                                           32455000
      br lsrerror;                   << not ccg >>                      32460000
      cmpi 3;                                                           32465000
      be *+2;                                                           32470000
      br lsrerror;                   << tos not 3 >>                    32475000
                                                                        32480000
      load nmax;                                                        32485000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>32490000
      lsr 13;                                                           32495000
      cmpi 4;                                                           32500000
      be *+2;                                                           32505000
      br lsrerror;                   << tos not 4 >>                    32510000
                                                                        32515000
      ldni 4;                                                           32520000
      lsr 16;                                                           32525000
      cmpi 0;                                                           32530000
      be *+2;                                                           32535000
      br lsrerror;                   << tos not 0 >>                    32540000
                                                                        32545000
      ldni 31;                                                          32550000
      ldxn 64;                                                          32555000
      lsr 0,x;                                                          32560000
      cmpn 31;                                                          32565000
      be *+2;                                                           32570000
      br lsrerror;                   << tos not -31 >>                  32575000
                                                                        32580000
      ldni 1;                                                           32585000
      ldxn 22;                                                          32590000
      lsr 31,x;   << cnt=9 >>                                           32595000
      cmpi 127;                                                         32600000
      be exit);                                                         32605000
lsrerror:                                                               32610000
      no'error:=false;                   << tos not %177 >>             32615000
exit:                                                                   32620000
      push(q);set(s);  << reset stack >>                                32625000
      tos:=re'addrs;    << restore return address >>                    32630000
   end;                                                                 32635000
                                                                        32640000
<<< check csr instruction >>                                            32645000
                                                                        32650000
subroutine csr'test;                                                    32655000
   begin                                                                32660000
      re'addrs:=tos;    << save return address >>                       32665000
      assemble(                                                         32670000
      dzro,dzro;                                               <<j8932>>32675000
      ldi 1;                                                            32680000
      dzro,dzro;                                               <<j8676>>32685000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>32690000
      csr 1;                                                            32695000
      bl *+2;                                                           32700000
      br csrerror;                   << not ccl >>                      32705000
      cmpm nmax;                                                        32710000
      be *+2;                                                           32715000
      br csrerror;                   << tos not %100000 >>              32720000
                                                                        32725000
      ldi 30;                                                           32730000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>32735000
      csr 17;                                                           32740000
      cmpi 15;                                                          32745000
      be *+2;                                                           32750000
      br csrerror;                   << tos not 15 >>                   32755000
                                                                        32760000
      ldi 2;                                                            32765000
      ldxi 2;                                                           32770000
      csr 61,x;   << cnt=63 >>                                          32775000
      cmpi 4;                                                           32780000
      be exit);                                                         32785000
csrerror:                                                               32790000
      no'error:=false;                   << tos not 4 >>                32795000
exit:                                                                   32800000
      push(q);set(s);  << reset stack >>                                32805000
      tos:=re'addrs;    << restore return address >>                    32810000
   end;                                                                 32815000
                                                                        32820000
<< check scan instruction >>                                            32825000
                                                                        32830000
subroutine scan'test;                                                   32835000
   begin                                                                32840000
      re'addrs:=tos;    << save return address >>                       32845000
      assemble(                                                         32850000
      dzro,dzro;                                               <<j8932>>32855000
      zero;   << tos=0, x=-4 >>                                         32860000
      ldxn 4;                                                           32865000
      dzro,dzro;                                               <<j8676>>32870000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>32875000
      scan 0;                                                           32880000
      be *+2;                                                           32885000
      br scanerror;                   << not cce >>                     32890000
      ldxa;                                                             32895000
      cmpi 16;                                                          32900000
      be *+2;                                                           32905000
      br scanerror;                   << x not 16 >>                    32910000
                                                                        32915000
      ldni 1;   << tos =-1, x=12 >>                                     32920000
      ldxi 12;                                                          32925000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>32930000
      scan 0;                                                           32935000
      bl *+2;                                                           32940000
      br scanerror;                   << not ccl >>                     32945000
      cmpn 2;                                                           32950000
      be *+2;                                                           32955000
      br scanerror;                   << tos not -2 >>                  32960000
      ldxa;                                                             32965000
      cmpi 0;                                                           32970000
      be *+2;                                                           32975000
      br scanerror;                   << x not 0 >>                     32980000
                                                                        32985000
      ldi 3;   << tos =3, x=100 >>                                      32990000
      ldxi 100;                                                         32995000
      scan 0;                                                           33000000
      bl *+2;                                                           33005000
      br scanerror;                   << not ccl >>                     33010000
      cmpm bit0;                                                        33015000
      be *+2;                                                           33020000
      br scanerror;                   << tos not %100000 >>             33025000
      ldxa;                                                             33030000
      cmpi 14;                                                          33035000
      be *+2;                                                           33040000
      br scanerror;                   << x not 14 >>                    33045000
                                                                        33050000
      ldi 1;   << tos =1 >>                                             33055000
      scan 0;                                                           33060000
      be *+2;                                                           33065000
      br scanerror;                   << not cce >>                     33070000
      cmpi 0;                                                           33075000
      be *+2;                                                           33080000
      br scanerror;                   << tos not 0 >>                   33085000
      ldxa;                                                             33090000
      cmpi 15;                                                          33095000
      be *+2;                                                           33100000
      br scanerror;                   << x not 15 >>                    33105000
                                                                        33110000
      ldxi 5;   << tos=0, x=5 >>                                        33115000
      zero;                                                             33120000
      scan 0,x;                                                         33125000
      ldxa;                                                             33130000
      cmpi 21;                                                          33135000
      be *+2;                                                           33140000
      br scanerror;                   << x not 21 >>                    33145000
                                                                        33150000
      ldxi 20;   << tos=%100001, x=20 >>                                33155000
      load endbits1;                                                    33160000
      scan 0,x;                                                         33165000
      bg *+2;                                                           33170000
      br scanerror;                   << not ccg >>                     33175000
      cmpi 2;                                                           33180000
      be *+2;                                                           33185000
      br scanerror;                   << tos not 2 >>                   33190000
      ldxa;                                                             33195000
      cmpi 21;                                                          33200000
      be *+2;                                                           33205000
      br scanerror;                   << x not 21 >>                    33210000
                                                                        33215000
      ldxi 4;   << tos =5, x=4 >>                                       33220000
      ldi 5;                                                            33225000
      scan 0,x;                                                         33230000
      bg *+2;                                                           33235000
      br scanerror;                   << not ccg >>                     33240000
      cmpm bit1;                                                        33245000
      be *+2;                                                           33250000
      br scanerror;                   << tos not %040000 >>             33255000
      ldxa;                                                             33260000
      cmpi 18;                                                          33265000
      be exit;                                                          33270000
      br scanerror);                       << x not 18 >>               33275000
                                                                        33280000
scanerror:                                                              33285000
      no'error:=false;                                                  33290000
                                                                        33295000
exit:                                                                   33300000
      push(q);set(s);  << reset stack >>                                33305000
      tos:=re'addrs;    << restore return address >>                    33310000
   end;                                                                 33315000
                                                                        33320000
                                                                        33325000
      move instruct'name:="ASL   ";                                     33330000
      print'names;                                                      33335000
      while no'error and (i:=i+1) < loopnumber do asl'test;             33340000
                                                                        33345000
      move instruct'name:="LSL   ";                                     33350000
      print'names;                                                      33355000
      while no'error and (i:=i+1) < loopnumber do lsl'test;             33360000
                                                                        33365000
      move instruct'name:="CSL   ";                                     33370000
      print'names;                                                      33375000
      while no'error and (i:=i+1) < loopnumber do csl'test;             33380000
                                                                        33385000
      move instruct'name:="ASR   ";                                     33390000
      print'names;                                                      33395000
      while no'error and (i:=i+1) < loopnumber do asr'test;             33400000
                                                                        33405000
      move instruct'name:="LSR   ";                                     33410000
      print'names;                                                      33415000
      while no'error and (i:=i+1) < loopnumber do lsr'test;             33420000
                                                                        33425000
      move instruct'name:="CSR   ";                                     33430000
      print'names;                                                      33435000
      while no'error and (i:=i+1) < loopnumber do csr'test;             33440000
                                                                        33445000
      move instruct'name:="SCAN  ";                                     33450000
      print'names;                                                      33455000
      while no'error and (i:=i+1) < loopnumber do scan'test;            33460000
end;   << grpt >>                                                       33465000
                                                                        33470000
procedure grpu;   << test group u: double word shift instructions >>    33475000
begin                                                                   33480000
subroutine dasl'test;                                                   33485000
   begin                                                                33490000
      re'addrs:=tos;    << save return address >>                       33495000
      assemble(                                                         33500000
                                                                        33505000
<<< check dasl instruction >>                                           33510000
                                                                        33515000
      zero;                                                             33520000
      ldi 1;                                                            33525000
      dzro,dzro;                                               <<j8676>>33530000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>33535000
      dasl 17;                                                          33540000
      bg *+2;                                                           33545000
      br daslerror;                   << not ccg >>                     33550000
      cmpi 0;                                                           33555000
      be *+2;                                                           33560000
      br daslerror;                   << tos not 0 after dasl >>        33565000
      cmpi 2;                                                           33570000
      be *+2;                                                           33575000
      br daslerror;                   << (s-1) not 2 after dasl >>      33580000
                                                                        33585000
      ldni 1;                                                           33590000
      zero;                                                             33595000
      ldni 1;                                                           33600000
      ldni 1;                                                           33605000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>33610000
      dasl 16;                                                          33615000
      bl *+2;                                                           33620000
      br daslerror;                   << not ccl >>                     33625000
      dcmp;                                                             33630000
      be *+2;                                                           33635000
      br daslerror;                   << (s-1,s) not -1,0 after dasl >> 33640000
                                                                        33645000
      ldni 41;                                                          33650000
      dup;                                                              33655000
      dasl 63;                                                          33660000
      bl *+2;                 << not ccl >>                             33665000
      br daslerror;                                                     33670000
      load nmax;                                                        33675000
      zero,dcmp;                                                        33680000
      be *+2;                                                           33685000
      br daslerror;                << (s-1,s) not %100000,0 after das >>33690000
                                                                        33695000
      ldi 121;                                                          33700000
      ldi 201;                                                          33705000
      ddup;                                                             33710000
      ldxn 31;                                                          33715000
      dasl 31,x;   << cnt=0 >>                                          33720000
      dcmp;                                                             33725000
      be exit);                                                         33730000
daslerror:                                                              33735000
      no'error:=false;                   << result not 121,201 >>       33740000
exit:                                                                   33745000
      push(q);set(s);    << reset stack >>                              33750000
      tos:=re'addrs;    << restore return address >>                    33755000
   end;                                                                 33760000
                                                                        33765000
<<< check dlsl instruction >>                                           33770000
                                                                        33775000
subroutine dlsl'test;                                                   33780000
   begin                                                                33785000
      re'addrs:=tos;    << save return address >>                       33790000
      assemble(                                                         33795000
      dzro,dzro;                                               <<j8932>>33800000
      zero;                                                             33805000
      ldi 14;                                                           33810000
      dzro,dzro;                                               <<j8676>>33815000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>33820000
      dlsl 18;                                                          33825000
      bg *+2;                                                           33830000
      br dlslerror;                   << not ccg >>                     33835000
      cmpi 0;                                                           33840000
      be *+2;                                                           33845000
      br dlslerror;                   << tos not 0 after dlsl >>        33850000
      cmpi 56;                                                          33855000
      be *+2;                                                           33860000
      br dlslerror;                   << (s-1) not 56 after dlsl >>     33865000
                                                                        33870000
      ldni 1;                                                           33875000
      dup;                                                              33880000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>33885000
      dlsl 31;                                                          33890000
      bl *+2;                                                           33895000
      br dlslerror;                   << not ccl >>                     33900000
      cmpi 0;                                                           33905000
      be *+2;                                                           33910000
      br dlslerror;                   << tos not 0 after dlsl >>        33915000
      cmpm nmax;                                                        33920000
      be *+2;                                                           33925000
      br dlslerror;                   << (s-1) not %100000 after dlsl >>33930000
                                                                        33935000
      dzro,zero;                                                        33940000
      ldi 1;                                                            33945000
      dlsl 32;                                                          33950000
      be *+2;                                                           33955000
      br dlslerror;                   << not cce >>                     33960000
      dcmp;                                                             33965000
      be exit);                                                         33970000
dlslerror:                                                              33975000
      no'error:=false;                << (s-1,s) not 0,0 after dlsl >>  33980000
exit:                                                                   33985000
      push(q);set(s);   << reset stack >>                               33990000
      tos:=re'addrs;    << restore return address >>                    33995000
   end;                                                                 34000000
                                                                        34005000
<<< check dcsl instruction >>                                           34010000
                                                                        34015000
subroutine dcsl'test;                                                   34020000
   begin                                                                34025000
      re'addrs:=tos;    << save return address >>                       34030000
      assemble(                                                         34035000
      dzro,dzro;                                               <<j8932>>34040000
      ldi 7;                                                            34045000
      ldi 3;                                                            34050000
      dzro,dzro;                                               <<j8676>>34055000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>34060000
      dcsl 17;                                                          34065000
      bg *+2;                 << not ccg >>                             34070000
      br dcslerror;                                                     34075000
      ldi 6;                                                            34080000
      ldi 14;                                                           34085000
      dcmp;                                                             34090000
      be *+2;                                                           34095000
      br dcslerror;                   << (s-1,s) not 6,14 >>            34100000
                                                                        34105000
      zero;                                                             34110000
      ldi 1;                                                            34115000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>34120000
      dcsl 63;                                                          34125000
      bl *+2;                                                           34130000
      br dcslerror;                   << not ccl >>                     34135000
      cmpi 0;                                                           34140000
      be *+2;                                                           34145000
      br dcslerror;                   << tos not 0 after dcsl >>        34150000
      cmpm nmax;                                                        34155000
      be exit);                                                         34160000
dcslerror:                                                              34165000
      no'error:=false;        << (s-1) not %100000 after after dcsl >>  34170000
exit:                                                                   34175000
      push(q);set(s);  << reset stack >>                                34180000
      tos:=re'addrs;    << restore return address >>                    34185000
   end;                                                                 34190000
<<< check dasr instruction >>                                           34195000
                                                                        34200000
subroutine dasr'test;                                                   34205000
   begin                                                                34210000
      re'addrs:=tos;    << save return address >>                       34215000
      assemble(                                                         34220000
      dzro,dzro;                                               <<j8932>>34225000
      ldi 10;                                                           34230000
      ldni 1;                                                           34235000
      dzro,dzro;                                               <<j8676>>34240000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>34245000
      dasr 15;                                                          34250000
      bg *+2;                 << not ccg >>                             34255000
      br dasrerror;                                                     34260000
      cmpi 21;                                                          34265000
      be *+2;                                                           34270000
      br dasrerror;                   << tos not 21 after dasr >>       34275000
      cmpi 0;                                                           34280000
      be *+2;                                                           34285000
      br dasrerror;                   << (s-1) not 0 after dasr >>      34290000
                                                                        34295000
      load nmax;  <<< %100000 >>                                        34300000
      zero;                                                             34305000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>34310000
      dasr 30;                                                          34315000
      bl *+2;                                                           34320000
      br dasrerror;                   << not ccl >>                     34325000
      cmpn 2;                                                           34330000
      be *+2;                                                           34335000
      br dasrerror;                   << tos not -2 after dasr >>       34340000
      cmpn 1;                                                           34345000
      be *+2;                                                           34350000
      br dasrerror;                   << tos not -1 after dasr >>       34355000
                                                                        34360000
      zero,dzro;                                                        34365000
      ldi 1;                                                            34370000
      dasr 1;                                                           34375000
      be *+2;                                                           34380000
      br dasrerror;                   << not cce >>                     34385000
      dcmp;                                                             34390000
      be *+2;                                                           34395000
      br dasrerror;                   << (s-1,s) not 0,0 after dasr  >> 34400000
                                                                        34405000
      ldi 1;                                                            34410000
      ldi 2;                                                            34415000
      dasr 0;                                                           34420000
      ldi 1;                                                            34425000
      ldi 2;                                                            34430000
      dcmp;                                                             34435000
      be exit);                                                         34440000
dasrerror:                                                              34445000
      no'error:=false;                   << result not 1,2 >>           34450000
exit:                                                                   34455000
      push(q);set(s);  << reset stack >>                                34460000
      tos:=re'addrs;    << restore return address >>                    34465000
   end;                                                                 34470000
                                                                        34475000
<<< check dlsr instruction >>                                           34480000
                                                                        34485000
subroutine dlsr'test;                                                   34490000
   begin                                                                34495000
      re'addrs:=tos;    << save return address >>                       34500000
      assemble(                                                         34505000
      ldi 212;                                                          34510000
      dup;                                                              34515000
      dzro,dzro;                                               <<j8676>>34520000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>34525000
      dlsr 16;                                                          34530000
      bg *+2;                                                           34535000
      br dlsrerror;                   << not ccg >>                     34540000
      cmpi 212;                                                         34545000
      be *+2;                                                           34550000
      br dlsrerror;                   << tos not 212 after dlsr >>      34555000
      cmpi 0;                                                           34560000
      be *+2;                                                           34565000
      br dlsrerror;                   << (s-1) not 0 after dlsr >>      34570000
                                                                        34575000
      dzro,dzro;                                                        34580000
      deca,decb;                                                        34585000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>34590000
      dlsr 32;                                                          34595000
      be *+2;                                                           34600000
      br dlsrerror;                   << not cce >>                     34605000
      dcmp;                                                             34610000
      be exit);                                                         34615000
dlsrerror:                                                              34620000
      no'error:=false;                << (s-1,s) not 0,0 after dlsr  >> 34625000
exit:                                                                   34630000
      push(q);set(s);    << reset stack >>                              34635000
      tos:=re'addrs;    << restore return address >>                    34640000
   end;                                                                 34645000
                                                                        34650000
<<< check dcsr instruction >>                                           34655000
                                                                        34660000
subroutine dcsr'test;                                                   34665000
   begin                                                                34670000
      re'addrs:=tos;    << save return address >>                       34675000
      assemble(                                                         34680000
      dzro,dzro;                                               <<j8932>>34685000
      ldni 1;                                                           34690000
      zero;                                                             34695000
      dzro,dzro;                                               <<j8676>>34700000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>34705000
      dcsr 14;                                                          34710000
      bg *+2;                                                           34715000
      br dcsrerror;                   << not ccg >>                     34720000
      cmpn 4;                                                           34725000
      be *+2;                                                           34730000
      br dcsrerror;                   << tos not %177774 after dcsr >>  34735000
      cmpi 3;                                                           34740000
      be *+2;                                                           34745000
      br dcsrerror;                   << (s-1) not 3 after dcsr >>      34750000
                                                                        34755000
      zero;                                                             34760000
      ldi 1;                                                            34765000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>34770000
      dcsr 1;                                                           34775000
      bl *+2;                                                           34780000
      br dcsrerror;                   << not ccl >>                     34785000
      cmpi 0;                                                           34790000
      be *+2;                                                           34795000
      br dcsrerror;                   << tos not 0 after dcsr >>        34800000
      cmpm nmax;                                                        34805000
      be *+2;                                                           34810000
      br dcsrerror;                   << (s-1) not %100000 after dcsr >>34815000
                                                                        34820000
      ldi 4;                                                            34825000
      ldi 8;                                                            34830000
      ldxn 1;                                                           34835000
      dcsr 0,x;   << cnt=%177777mod64=63 >>                             34840000
      ldi 8;                                                            34845000
      ldi 16;                                                           34850000
      dcmp;                                                             34855000
      be exit;                                                          34860000
      br dcsrerror);                       << result not 8,16 >>        34865000
dcsrerror:                                                              34870000
      no'error:=false;                                                  34875000
exit:                                                                   34880000
      push(q);set(s);   << reset stack >>                               34885000
      tos:=re'addrs;    << restore return address >>                    34890000
   end;                                                                 34895000
                                                                        34900000
                                                                        34905000
      move instruct'name:="DASL  ";                                     34910000
      print'names;                                                      34915000
      while no'error and (i:=i+1) < loopnumber do dasl'test;            34920000
                                                                        34925000
      move instruct'name:="DLSL  ";                                     34930000
      print'names;                                                      34935000
      while no'error and (i:=i+1) < loopnumber do dlsl'test;            34940000
                                                                        34945000
      move instruct'name:="DCSL  ";                                     34950000
      print'names;                                                      34955000
      while no'error and (i:=i+1) < loopnumber do dcsl'test;            34960000
                                                                        34965000
      move instruct'name:="DASR  ";                                     34970000
      print'names;                                                      34975000
      while no'error and (i:=i+1) < loopnumber do dasr'test;            34980000
                                                                        34985000
      move instruct'name:="DLSR  ";                                     34990000
      print'names;                                                      34995000
      while no'error and (i:=i+1) < loopnumber do dlsr'test;            35000000
                                                                        35005000
      move instruct'name:="DCSR  ";                                     35010000
      print'names;                                                      35015000
      while no'error and (i:=i+1) < loopnumber do dcsr'test;            35020000
                                                                        35025000
end;   << grpu >>                                                       35030000
                                                                        35035000
procedure grpv;   << test group v: triple word shift instructions >>    35040000
begin                                                                   35045000
subroutine tasr'test;                                                   35050000
   begin                                                                35055000
      re'addrs:=tos;    << save return address >>                       35060000
      assemble(                                                         35065000
                                                                        35070000
<<< check tasr instruction >>                                           35075000
                                                                        35080000
      dzro,dzro;                                               <<j8932>>35085000
      ldi 48;                                                           35090000
      ldi 100;                                                          35095000
      ldi 240;                                                          35100000
      dzro,dzro;                                               <<j8676>>35105000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>35110000
      tasr 2;                                                           35115000
      bg *+2;                                                           35120000
      br tasrerror;                   << not ccg >>                     35125000
      cmpi 60;                                                          35130000
      be *+2;                                                           35135000
      br tasrerror;                   << tos not 60 after tasr >>       35140000
      cmpi 25;                                                          35145000
      be *+2;                                                           35150000
      br tasrerror;                   << (s-1) not 25 after tasr >>     35155000
      cmpi 12;                                                          35160000
      be *+2;                                                           35165000
      br tasrerror;                   << (s-2) not 12 after tasr >>     35170000
                                                                        35175000
      load nmax;                                                        35180000
      dzro;                                                             35185000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>35190000
      tasr 39;                                                          35195000
      bl *+2;                                                           35200000
      br tasrerror;                   << not ccl >>                     35205000
      cmpm m256;                                                        35210000
      be *+2;                                                           35215000
      br tasrerror;                   << tos not %177400 after tasr >>  35220000
      ldni 1;                                                           35225000
      dup,dcmp;                                                         35230000
      be *+2;                                                           35235000
      br tasrerror;                   << (s-2,s-1) not -1 after tasr >> 35240000
                                                                        35245000
      load pmax;   << %077777,000333,000157 >>                          35250000
      ldi %333;                                                         35255000
      ldi %157;                                                         35260000
      tasr 47;                                                          35265000
      be *+2;                                                           35270000
      br tasrerror;                   << not cce >>                     35275000
                                                                        35280000
      ldi 16;                                                           35285000
      ldi 8;                                                            35290000
      ldi 4;                                                            35295000
      ldxi 1;                                                           35300000
      tasr 1,x;   << cnt=2 >>                                           35305000
      cmpi 1;                                                           35310000
      be *+2;                                                           35315000
      br tasrerror;                   << tos not 1 >>                   35320000
      ldi 4;                                                            35325000
      ldi 2;                                                            35330000
      dcmp;                                                             35335000
      be *+2;                                                           35340000
      br tasrerror;                   << (s-2,s-1) not 4,2 after tasr >>35345000
                                                                        35350000
      ldi 0;   << 0,5,0 >>                                              35355000
      ldi 5;                                                            35360000
      ldi 0;                                                            35365000
      tasr 0;   << cnt =0 >>                                            35370000
      bg *+2;                                                           35375000
      br tasrerror;                   << not ccg >>                     35380000
      cmpi 0;                                                           35385000
      be *+2;                                                           35390000
      br tasrerror;                   << tos not 0 after tasr >>        35395000
      ldi 0;                                                            35400000
      ldi 5;                                                            35405000
      dcmp;                                                             35410000
      be *+2;                                                           35415000
      br tasrerror;                   << (s-2,s-1) not 0,5 after tasr >>35420000
                                                                        35425000
      dzro;                                                             35430000
      ldi 63;                                                           35435000
      ldxn 64;                                                          35440000
      tasr 0,x;   << cnt=-64 >>                                         35445000
      cmpi 63;                                                          35450000
      be *+2;                                                           35455000
      br tasrerror;                   << tos not 63 >>                  35460000
                                                                        35465000
      dzro;                                                             35470000
      ldi 4;                                                            35475000
      tasr 1;                                                           35480000
      bg *+2;                                                           35485000
      br tasrerror;                   << not ccg >>                     35490000
      tasr 2;                                                           35495000
      be exit);                                                         35500000
tasrerror:                                                              35505000
      no'error:=false;                   << not cce >>                  35510000
exit:                                                                   35515000
      push(q);set(s);   << reset stack >>                               35520000
      tos:=re'addrs;    << restore return address >>                    35525000
   end;                                                                 35530000
                                                                        35535000
<<< check tasl instruction >>                                           35540000
                                                                        35545000
subroutine tasl'test;                                                   35550000
   begin                                                                35555000
      re'addrs:=tos;    << save return address >>                       35560000
      assemble(                                                         35565000
      dzro,dzro;                                               <<j8932>>35570000
      load pmax;   <<< 077777,177777,000001 >>                          35575000
      ldni 1;                                                           35580000
      ldi 1;                                                            35585000
      dzro,dzro;                                               <<j8676>>35590000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>35595000
      tasl 46;                                                          35600000
      bg *+2;                                                           35605000
      br taslerror;                   << not ccg >>                     35610000
      cmpi 0;                                                           35615000
      be *+2;                                                           35620000
      br taslerror;                   << tos not 0 >>                   35625000
      cmpi 0;                                                           35630000
      be *+2;                                                           35635000
      br taslerror;                   << (s-1) not 0 >>                 35640000
      cmpm bit1;                                                        35645000
      be *+2;                                                           35650000
      br taslerror;                   << (s-2) not %040000 >>           35655000
                                                                        35660000
      ldni 1;   <<< 177777,177777,177777 >>                             35665000
      dup,dup;                                                          35670000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>35675000
      tasl 63;                                                          35680000
      bl *+2;                                                           35685000
      br taslerror;                   << not ccl >>                     35690000
      dzro,dcmp;                                                        35695000
      be *+2;                                                           35700000
      br taslerror;                   << (s-1,s) not 0,0 after tasl >>  35705000
      cmpm nmax;                                                        35710000
      be *+2;                                                           35715000
      br taslerror;                   << (s-2) not %100000 after tasl >>35720000
                                                                        35725000
      ldi 3;   << %000003,177774,177771 >>                              35730000
      ldni 4;                                                           35735000
      ldni 7;                                                           35740000
      tasl 2;                                                           35745000
      bg *+2;                                                           35750000
      br taslerror;                   << not ccg >>                     35755000
      cmpn 28;                                                          35760000
      be *+2;                                                           35765000
      br taslerror;                   << tos not -28 after tasl >>      35770000
      cmpn 13;                                                          35775000
      be *+2;                                                           35780000
      br taslerror;                   << (s-1) not -13 after tasl >>    35785000
      cmpi 15;                                                          35790000
      be *+2;                                                           35795000
      br taslerror;                   << (s-2) not 15 after tasl >>     35800000
                                                                        35805000
      ldi 3;                                                            35810000
      ldi 4;                                                            35815000
      ldi 5;                                                            35820000
      ldxn 1;                                                           35825000
      tasl 4,x;   << cnt=3 >>                                           35830000
      cmpi 40;                                                          35835000
      be *+2;                                                           35840000
      br taslerror;                   << tos not 40 >>                  35845000
                                                                        35850000
      ldi 24;                                                           35855000
      ldi 32;                                                           35860000
      dcmp;                                                             35865000
      be *+2;                                                           35870000
      br taslerror;              << (s-2,s-1) not 24,32 after tasl >>   35875000
                                                                        35880000
      ldi 5;                                                            35885000
      ldi 6;                                                            35890000
      ldi 7;                                                            35895000
      tasl 0;                                                           35900000
      cmpi 7;                                                           35905000
      be *+2;                                                           35910000
      br taslerror;                   << tos not 7 after tasl >>        35915000
                                                                        35920000
      ldi 2;                                                            35925000
      ldi 3;                                                            35930000
      ldi 4;                                                            35935000
      ldxn 65;                                                          35940000
      tasl 1,x;   << cnt=-64 >>                                         35945000
      cmpi 4;                                                           35950000
      be *+2;                                                           35955000
      br taslerror;                   << tos not 4 after tasl >>        35960000
                                                                        35965000
      dzro;   << cover tests >>                                         35970000
      ldi 1;                                                            35975000
      tasl 21;                                                          35980000
      cmpi 0;                                                           35985000
      be *+2;                                                           35990000
      br taslerror;                   << tos not 0 >>                   35995000
      cmpi %40;                                                         36000000
      be *+2;                                                           36005000
      br taslerror;                   << (s-1) not %40 >>               36010000
      cmpi 0;                                                           36015000
      be *+2;                                                           36020000
      br taslerror;                   << (s-2) not 0 >>                 36025000
                                                                        36030000
      dzro;                                                             36035000
      ldi 1;                                                            36040000
      tasl 42;                                                          36045000
      cmpi 0;                                                           36050000
      be *+2;                                                           36055000
      br taslerror;                   << tos not 0 >>                   36060000
      cmpi 0;                                                           36065000
      be *+2;                                                           36070000
      br taslerror;                   << (s-1) not 0 >>                 36075000
      cmpm bit5;                                                        36080000
      be exit);                                                         36085000
taslerror:                                                              36090000
      no'error:=false;                   << (s-2) not %2000 >>          36095000
exit:                                                                   36100000
      push(q);set(s);   << reset stack >>                               36105000
      tos:=re'addrs;    << restore return address >>                    36110000
   end;                                                                 36115000
                                                                        36120000
<< check tnsl & tnsl,x instruction >>                                   36125000
                                                                        36130000
subroutine tnsl'test;                                                   36135000
   begin                                                                36140000
      re'addrs:=tos;    << save return address >>                       36145000
      assemble(                                                         36150000
      dzro,dzro;                                               <<j8932>>36155000
      dzro,dzro;  <<< 0 with cc not cce >>                              36160000
      inca,del;                                                         36165000
      dzro,dzro;                                               <<j8676>>36170000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>36175000
      tnsl 0;                                                           36180000
      be *+2;                                                           36185000
      br tnslerror;                   << not cce >>                     36190000
      dzro,dcmp;                                                        36195000
      be *+2;                                                           36200000
      br tnslerror;                   << (s-1,s) not 0,0 >>             36205000
      cmpi 0;                                                           36210000
      be *+2;                                                           36215000
      br tnslerror;                   << (s-2) not 0 >>                 36220000
      ldxa;                                                             36225000
      cmpi 42;                                                          36230000
      be *+2;                                                           36235000
      br tnslerror;                   << x not 42 >>                    36240000
                                                                        36245000
      dzro,zero;                                                        36250000
      ldxi 17;                                                          36255000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>36260000
      tnsl 0,x;                                                         36265000
      ldxa;                                                             36270000
      cmpi 59;                                                          36275000
      be *+2;                                                           36280000
      br tnslerror;                   << x not 42 + 17 = 59 >>          36285000
                                                                        36290000
      ldxi 5;                                                           36295000
      dzro;                                                             36300000
      ldi 1;                                                            36305000
      tnsl 0,x;                                                         36310000
      bg *+2;                                                           36315000
      br tnslerror;                   << not ccg >>                     36320000
      dzro,dcmp;                                                        36325000
      be *+2;                                                           36330000
      br tnslerror;                   << (s-1,s) not 0,0 >>             36335000
      cmpm bit6;                                                        36340000
      be *+2;                                                           36345000
      br tnslerror;                   << (s-2) not %001000 >>           36350000
      ldxa;                                                             36355000
      cmpi 46;                                                          36360000
      be *+2;                                                           36365000
      br tnslerror;                   << x not 41 + 5 = 46 >>           36370000
                                                                        36375000
      ldxn 6;                                                           36380000
      ldni 1;   <<< 3 words all 1's >>                                  36385000
      dup,dup;                                                          36390000
      tnsl 0,x;                                                         36395000
      bg *+2;                                                           36400000
      br tnslerror;                   << not ccg >>                     36405000
      ldni 1;                                                           36410000
      dup,dcmp;                                                         36415000
      be *+2;                                                           36420000
      br tnslerror;                   << (s,s-1) not -1,-1 >>           36425000
      cmpm pat1777;                                                     36430000
      be *+2;                                                           36435000
      br tnslerror;                   << (s-2) not %1777 >>             36440000
      ldxa;                                                             36445000
      cmpn 6;                                                           36450000
      be *+2;                                                           36455000
      br tnslerror;                   << x not -6 >>                    36460000
                                                                        36465000
      load bit6;                                                        36470000
      not;                                                              36475000
      ldni 1;                                                           36480000
      dup;                    << %175777,177777,177777 >>               36485000
      tnsl 0;                                                           36490000
      bg *+2;                                                           36495000
      br tnslerror;                   << not ccg >>                     36500000
      cmpn 2;                                                           36505000
      be *+2;                                                           36510000
      br tnslerror;                   << tos not %177776 >>             36515000
      cmpn 1;                                                           36520000
      be *+2;                                                           36525000
      br tnslerror;                   << (s-1) not -1 >>                36530000
      cmpm pat1777;                                                     36535000
      be *+2;                                                           36540000
      br tnslerror;                   << (s-2) not %001777 >>           36545000
      ldxa;                                                             36550000
      cmpi 1;                                                           36555000
      be *+2;                                                           36560000
      br tnslerror;                   << x not 1 >>                     36565000
                                                                        36570000
      ldi 1;   <<< bit 15 only >>                                       36575000
      dzro;                                                             36580000
      tnsl 0;                                                           36585000
      ddel,del;                                                         36590000
      ldxa;                                                             36595000
      cmpi 9;                                                           36600000
      be exit;                                                          36605000
      br tnslerror);                       << x not 9 >>                36610000
                                                                        36615000
tnslerror:                                                              36620000
      no'error:=false;                                                  36625000
exit:                                                                   36630000
      push(q);set(s);  << reset stack >>                                36635000
      tos:=re'addrs;    << restore return address >>                    36640000
   end;                                                                 36645000
                                                                        36650000
                                                                        36655000
      move instruct'name:="TASR  ";                                     36660000
      print'names;                                                      36665000
      while no'error and (i:=i+1) < loopnumber do tasr'test;            36670000
                                                                        36675000
      move instruct'name:="TASL  ";                                     36680000
      print'names;                                                      36685000
      while no'error and (i:=i+1) < loopnumber do tasl'test;            36690000
                                                                        36695000
      move instruct'name:="TNSL  ";                                     36700000
      print'names;                                                      36705000
      while no'error and (i:=i+1) < loopnumber do tnsl'test;            36710000
                                                                        36715000
                                                                        36720000
                                                                        36725000
end;   << grpv >>                                                       36730000
                                                                        36735000
                                                                        36740000
                                                                        36745000
                                                                        36750000
procedure dmulddivtst;                                                  36755000
<<this procedure tests the double word multipy and                      36760000
  the double word divide.>>                                             36765000
                                                                        36770000
      begin                                                             36775000
      double one,two,three,answer,remainder;                            36780000
      define dmul=assemble(con%020570)#,                                36785000
             ddiv=assemble(con%020571)#;                                36790000
                                                                        36795000
                                                                        36800000
       move instruct'name:="DMUL  ";                                    36805000
       print'names;                                                     36810000
       move instruct'name:="DDIV  ";                                    36815000
       print'names;                                                     36820000
      push(s);                                                          36825000
      savs:=tos;<<save s>>                                              36830000
                                                                        36835000
star:                                                                   36840000
                                                                        36845000
      push(status);<<get status>>                                       36850000
      tos.(2:1):=0;<<turn off traps>>                                   36855000
      set(status);                                                      36860000
                                                                        36865000
s1:                                                                     36870000
      one:=100d;                                                        36875000
      two:=2d;                                                          36880000
                                                                        36885000
      tos:=one;                                                         36890000
      tos:=two;<<put values on tos>>                                    36895000
      assemble(dxch,dxch; xch,xch); << sr=4 >>                 <<j8676>>36900000
      dmul;<<double multiply>>                                          36905000
      answer:=tos;<<store answer>>                                      36910000
      if <= then assemble( br dmulerror);<<not ccg>>                    36915000
     if overflow then assemble( br dmulerror);<<overflow set>>          36920000
     if answer <> 200d then assemble( br dmulerror);<<multply failed>>  36925000
                                                                        36930000
s3:                                                                     36935000
     tos:=answer;                                                       36940000
     tos:=two;                                                          36945000
     assemble(dxch,dxch; xch,xch); <<sr=4>>                    <<j8676>>36950000
                       <<stack= 0                                       36955000
                                200                                     36960000
                                0                                       36965000
                                2  >>                                   36970000
                                                                        36975000
      ddiv;<<divide 200/2>>                                             36980000
      remainder :=tos;<<store remainder>>                               36985000
      answer:=tos;<<store answer>>                                      36990000
      if <= then assemble( br dmulerror);<<not ccg>>                    36995000
      if overflow then assemble( br dmulerror);<<overflow set>>         37000000
      if answer <> 100d then assemble( br dmulerror);<<divide failed>>  37005000
      if remainder <> 0d then assemble(br dmulerror);<<remainder not 0>>37010000
                                                                        37015000
s1a:                                                                    37020000
      one:=100d;                                                        37025000
      two:=2d;                                                          37030000
                                                                        37035000
      tos:=one;                                                         37040000
      tos:=two;<<put values on tos>>                                    37045000
      assemble(dzro,dzro; ddel,ddel);                          <<j8676>>37050000
      dmul;<<double multiply>>                                          37055000
      answer:=tos;<<store answer>>                                      37060000
      if <= then assemble( br dmulerror);<<not ccg>>                    37065000
      if overflow then assemble( br dmulerror);<<overflow set>>         37070000
      if answer <> 200d then assemble( br dmulerror);<<multply failed>> 37075000
                                                                        37080000
s3a:                                                                    37085000
      tos:=answer;                                                      37090000
      tos:=two;                                                         37095000
      assemble(dzro,dzro;                                      <<j8676>>37100000
               ddel,ddel);  << sr=0 >>                         <<j8676>>37105000
                        <<stack= 0                                      37110000
                                 200                                    37115000
                                 0                                      37120000
                                 2  >>                                  37125000
                                                                        37130000
      ddiv;<<divid 200/2>>                                              37135000
      remainder :=tos;<<store remainder>>                               37140000
      answer:=tos;<<store answer>>                                      37145000
      if <= then assemble( br dmulerror);<<not ccg>>                    37150000
      if overflow then assemble( br dmulerror);<<overflow set>>         37155000
      if answer <> 100d then assemble( br dmulerror);<<divide failed>>  37160000
      if remainder <> 0d then assemble(br dmulerror);<<remainder not 0>>37165000
                                                                        37170000
s5:                                                                     37175000
      one:=0d;                                                          37180000
      two:=1d;                                                          37185000
      tos:=one;                                                         37190000
      tos:=two;                                                         37195000
      dmul;<<product should have all zeros-therefore                    37200000
             overflow should not be set>>                               37205000
      if overflow then assemble(br dmulerror);<<overflow set>>          37210000
                                                                        37215000
                                                                        37220000
                                                                        37225000
                                                                        37230000
s6:                                                                     37235000
      push(status);                                                     37240000
      tos.(4:1):=0;<<clear overflow>>                                   37245000
       set(status);                                                     37250000
                                                                        37255000
      one:= -2147483648d;<<max negative double integer>>                37260000
      two:= -1d;                                                        37265000
                                                                        37270000
      tos:=one;                                                         37275000
      tos:=two;                                                         37280000
      assemble(dxch,dxch; xch,xch); <<sr=4>>                   <<j8676>>37285000
      ddiv;<<divide the maximum negative number by -1>>                 37290000
      if noverflow then assemble(br dmulerror);<<ovrflw should be set>> 37295000
                                                                        37300000
                                                                        37305000
                                                                        37310000
      two:=1d;                                                          37315000
                                                                        37320000
      tos:=one;                                                         37325000
      tos:=two;                                                         37330000
      assemble(dxch,dxch; xch,xch); <<sr=4>>                   <<j8676>>37335000
      ddiv;<<divide the maximum negative number by one>>                37340000
      if overflow then assemble( br dmulerror);<<overflow set>>         37345000
      assemble(ddel);<<pop remainder>>                                  37350000
      if tos <> -2147483648d then assemble( br dmulerror);              37355000
                                          <<divide by 1 failed>>        37360000
                                                                        37365000
                                                                        37370000
                                                                        37375000
                                                                        37380000
                                                                        37385000
                                                                        37390000
       tos:=savs;set(s); <<reset stack>>                                37395000
       if(loopctn:=loopctn+1)= loopnumber then go out                   37400000
       else go star;                                                    37405000
                                                                        37410000
dmulerror:                                                              37415000
       no'error:=false;                                                 37420000
                                                                        37425000
out:   loopctn:=0;x:=stepno;                                            37430000
       stepno:=stepno+1;                                                37435000
                                                                        37440000
end;<<dmulddivtst>>                                                     37445000
                                                                        37450000
                                                                        37455000
procedure qaslqasrtst;<<test qasl and qasr inst >>                      37460000
begin                                                                   37465000
                                                                        37470000
       move instruct'name:="QASL  ";                                    37475000
       print'names;                                                     37480000
       move instruct'name:="QASR  ";                                    37485000
       print'names;                                                     37490000
star:                                                                   37495000
      x:=0;<<clear x>>                                                  37500000
<<test 1>>                                                              37505000
      tos:=%100000;                                                     37510000
      tos:=0d;                                                          37515000
      tos:=0;                                                           37520000
                                                                        37525000
      assemble( qasr 15);<<shift 15 right>>                             37530000
      if s0 <> 0 then assemble ( br qaslerror);<<s-0 not 0 >>           37535000
      if s1 <> 0 then assemble ( br qaslerror);<<s-1 not 0 >>           37540000
      if s2 <> 0 then assemble ( br qaslerror);<<s-2 not 0 >>           37545000
      if s3 <> -1 then assemble ( br qaslerror);<<s-3 not -1 >>         37550000
                                                                        37555000
<<test 2>>                                                              37560000
      x:=15;                                                            37565000
      assemble( qasl 0);<<shift 15 with count in x>>                    37570000
      if s0 <> 0 then assemble ( br qaslerror);<<s-0 not 0 >>           37575000
      if s1 <> 0 then assemble ( br qaslerror);<<s-1 not 0 >>           37580000
      if s2 <> 0 then assemble ( br qaslerror);<<s-2 not 0 >>           37585000
      if s3 <>%100000 then assemble ( br qaslerror);<<s-3 not 0 >>      37590000
                                                                        37595000
<<test 3>>                                                              37600000
                                                                        37605000
      x:=60;                                                            37610000
      assemble( qasr 3);<<shift 63 places right>>                       37615000
      if s0 <>-1 then assemble ( br qaslerror);<<s-0 not-1 >>           37620000
      if s1 <>-1 then assemble ( br qaslerror);<<s-1 not-1 >>           37625000
      if s2 <>-1 then assemble ( br qaslerror);<<s-2 not-1 >>           37630000
      if s3 <> -1 then assemble ( br qaslerror);<<s-3 not -1 >>         37635000
                                                                        37640000
<<test 4>>                                                              37645000
                                                                        37650000
      x:=0;                                                             37655000
      s3:=%077777;<<reset sign bit>>                                    37660000
                                                                        37665000
      assemble( qasr 63);<<right 63>>                                   37670000
      if s0 <> 0 then assemble ( br qaslerror);<<s-0 not 0 >>           37675000
      if s1 <> 0 then assemble ( br qaslerror);<<s-1 not 0 >>           37680000
      if s2 <> 0 then assemble ( br qaslerror);<<s-2 not 0 >>           37685000
      if s3 <> 0 then assemble ( br qaslerror);<<s-3 not 0 >>           37690000
                                                                        37695000
<<test 5>>                                                              37700000
                                                                        37705000
      x:=0;                                                             37710000
      s0:=-1;                                                           37715000
      assemble( qasl 48);<<48 left>>                                    37720000
      if s3 <> %077777 then assemble( br qaslerror);<<s-3 not           37725000
                                                  %077777>>             37730000
                                                                        37735000
<<test 6>>                                                              37740000
                                                                        37745000
      x:=0;                                                             37750000
      s3:=%100000;                                                      37755000
      x:=-25;                                                           37760000
      assemble( qasr 40);<<shift net 15 right>>                         37765000
      if s0 <> 0 then assemble ( br qaslerror);<<s-0 not 0 >>           37770000
      if s1 <> 0 then assemble ( br qaslerror);<<s-1 not 0 >>           37775000
      if s2 <> 0 then assemble ( br qaslerror);<<s-2 not 0 >>           37780000
      if s3 <> -1 then assemble ( br qaslerror);<<s-3 not -1 >>         37785000
                                                                        37790000
                                                                        37795000
                                                                        37800000
       push(q);set(s); <<reset stack>>                                  37805000
       if(loopctn:=loopctn+1)=loopnumber then go out                    37810000
       else go star;                                                    37815000
                                                                        37820000
qaslerror:                                                              37825000
       no'error:=false;                                                 37830000
                                                                        37835000
out:   loopctn:=0;x:=stepno;                                            37840000
       stepno:=stepno+1;                                                37845000
                                                                        37850000
                                                                        37855000
end; <<qaslqasrtst>>                                                    37860000
                                                                        37865000
                                                                        37870000
                                                                        37875000
$control segment=segment2'part2                                         37880000
                                                                        37885000
procedure grpj;   << test group j: floating point instructions >>       37890000
begin                                                                   37895000
                                                                        37900000
<<< check fneg instruction >>                                           37905000
subroutine fneg'test;                                                   37910000
   begin                                                                37915000
      re'addrs:=tos;    << save return address >>                       37920000
      assemble(                                                         37925000
      dzro,dzro;                                               <<j8932>>37930000
      ldpp f0; <<< 0.0 >>                                               37935000
      fneg;                                                             37940000
      be *+2;                                                           37945000
      br fnegerror;                   << not cce >>                     37950000
      dzro,dcmp;                                                        37955000
      be *+2;                                                           37960000
      br fnegerror;                   << result not 0,0 >>              37965000
                                                                        37970000
      ldpp f1; <<< 1.0>>                                                37975000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>37980000
      fneg;                                                             37985000
      bl *+2;                                                           37990000
      br fnegerror;                   << not ccl >>                     37995000
      ldpp fn1;                                                         38000000
      dcmp;                                                             38005000
      be *+2;                                                           38010000
      br fnegerror;                   << result not -1.0 >>             38015000
                                                                        38020000
      ldpp fn1; <<<  -1.0 >>                                            38025000
      dzro,dzro;                                               <<j8676>>38030000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>38035000
      fneg;                                                             38040000
      bg *+2;                                                           38045000
      br fnegerror;                   << not ccg >>                     38050000
      ldpp f1;                                                          38055000
      dcmp;                                                             38060000
      be *+2;                                                           38065000
      br fnegerror;                   << result not 1.0 >>              38070000
                                                                        38075000
      load bit0;   << %100000,177777 >>                                 38080000
      ldni 1;                                                           38085000
      nop,fneg;                                                         38090000
      bg *+2;                                                           38095000
      br fnegerror;                   << not ccg >>                     38100000
      zero;                                                             38105000
      ldni 1;                                                           38110000
      dcmp;                                                             38115000
      be exit;                                                          38120000
      br fnegerror;                                                     38125000
f0:   con 0.0;                                                          38130000
f1:   con 1.0;                                                          38135000
fn1:  con -1.0);                                                        38140000
fnegerror:                                                              38145000
      no'error:=false;                   << result not 0,-1 >>          38150000
exit:                                                                   38155000
      push(q);set(s);  << reset stack >>                                38160000
      tos:=re'addrs;    << restore return address >>                    38165000
   end;                                                                 38170000
                                                                        38175000
                                                                        38180000
<<< check fcmp instruction >>                                           38185000
                                                                        38190000
subroutine fcmp'test;                                                   38195000
   begin                                                                38200000
      re'addrs:=tos;    << save return address >>                       38205000
      assemble(                                                         38210000
      ldni 53;  <<< 0:-1 >>                                             38215000
      ldpp f0;                                                          38220000
      ldpp fn1;                                                         38225000
      fcmp;                                                             38230000
      bg *+2;                                                           38235000
      br fcmperror;                   << not ccg >>                     38240000
      cmpn 53;                                                          38245000
      be *+2;                                                           38250000
      br fcmperror;                   << stack trouble >>               38255000
                                                                        38260000
      ldpp fn1;  << -1:3>>                                              38265000
      ldpp f3;                                                          38270000
      dzro,dzro;                                               <<j8676>>38275000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>38280000
      fcmp;                                                             38285000
      bl *+2;                                                           38290000
      br fcmperror;                   << not ccl >>                     38295000
                                                                        38300000
      ldpp f4;   <<< 4:3 >>                                             38305000
      ldpp f3;                                                          38310000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>38315000
      fcmp;                                                             38320000
      bg *+2;                                                           38325000
      br fcmperror;                   << not ccg >>                     38330000
                                                                        38335000
      ldpp f4;   <<< -4:-3 >>                                           38340000
      fneg;                                                             38345000
      ldpp f3;                                                          38350000
      fneg,fcmp;                                                        38355000
      bl *+2;                                                           38360000
      br fcmperror;                   << not ccl >>                     38365000
                                                                        38370000
      ldi 21;    <<< 4:4 >>                                             38375000
      ldpp f4;                                                          38380000
      ddup,fcmp;                                                        38385000
      be *+2;                                                           38390000
      br fcmperror;                   << not cce >>                     38395000
      cmpi 21;                                                          38400000
      be *+2;                                                           38405000
      br fcmperror;                   << stack trouble >>               38410000
                                                                        38415000
      ldpp fm7;  <<< 2 nearly identical values >>                       38420000
      inca;      <<< (s-3,s-2) slightly smaller than (s-1,s) >>         38425000
      ldpp fm7;                                                         38430000
      fcmp;                                                             38435000
      bl *+2;                                                           38440000
      br fcmperror;                   << not ccl >>                     38445000
                                                                        38450000
      ldpp fm7;  <<< 2 nearly identical values >>                       38455000
      ddup,inca; << (s-3,s-2) slighly larger than (s-1,s) >>            38460000
      fcmp;                                                             38465000
      bg exit;                                                          38470000
      br fcmperror;                                                     38475000
f0:    con 0.0;                                                         38480000
fn1:   con -1.0;                                                        38485000
f3:    con 3.0;                                                         38490000
f4:    con 4.0;                                                         38495000
fm7:   con -7.0);                                                       38500000
fcmperror:                                                              38505000
      no'error:=false;                   << not ccg >>                  38510000
exit:                                                                   38515000
      push(q);set(s);  << reset stack >>                                38520000
      tos:=re'addrs;    << restore return address >>                    38525000
   end;                                                                 38530000
                                                                        38535000
<<< check flt instruction >>                                            38540000
                                                                        38545000
subroutine flt'test;                                                    38550000
    begin                                                               38555000
      re'addrs:=tos;    << save return address >>                       38560000
      assemble(                                                         38565000
      dzro,dzro;                                               <<j8932>>38570000
      ldni 15;  <<< 0 >>                                                38575000
      zero;                                                             38580000
      dzro,dzro;                                               <<j8676>>38585000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>38590000
      flt;                                                              38595000
      be *+2;                                                           38600000
      br flterror;                   << not cce >>                      38605000
      dzro,dcmp;                                                        38610000
      be *+2;                                                           38615000
      br flterror;                   << result not 0,0 >>               38620000
      cmpn 15;                                                          38625000
      be *+2;                                                           38630000
      br flterror;                   << stack trouble >>                38635000
                                                                        38640000
      ldi 1;   <<< 1 >>                                                 38645000
      flt;                                                              38650000
      dxch,dxch;           << sr=4 >>                          <<c9058>>38655000
      bg *+2;                                                           38660000
      br flterror;                   << not ccg >>                      38665000
      ldpp f1;                                                          38670000
      fcmp;                                                             38675000
      be *+2;                                                           38680000
      br flterror;                   << result not 1.0 = %040000,0 >>   38685000
                                                                        38690000
      dzro,dzro;                                               <<j8676>>38695000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>38700000
      ldi 9;                                                            38705000
      ldni 7;   << -7 >>   << sr=2 >>                                   38710000
      flt;                                                              38715000
      bl *+2;                                                           38720000
      br flterror;                   << not ccl >>                      38725000
      ldpp fm7;                                                         38730000
      dcmp;                                                             38735000
      be exit;                                                          38740000
      br flterror;                                                      38745000
f1:   con 1.0;                                                          38750000
fm7:  con -7.0);                                                        38755000
flterror:                                                               38760000
      no'error:=false;                   << result not -7.0 >>          38765000
 exit:                                                                  38770000
      push(q);set(s);  << reset stack >>                                38775000
      tos:=re'addrs;    << restore return address >>                    38780000
   end;                                                                 38785000
                                                                        38790000
<<< check dflt instruction >>                                           38795000
                                                                        38800000
subroutine dflt'test;                                                   38805000
   begin                                                                38810000
      re'addrs:=tos;    << save return address >>                       38815000
      assemble(                                                         38820000
      dzro,dzro;                                               <<j8932>>38825000
      ldni 33;   <<< 1d >>                                              38830000
      dzro,inca;                                                        38835000
      dzro,dzro;                                               <<j8676>>38840000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>38845000
      dflt;                                                             38850000
      bg *+2;                                                           38855000
      br dflterror;                   << not ccg >>                     38860000
      ldpp f1;                                                          38865000
      dcmp;                                                             38870000
      be *+2;                                                           38875000
      br dflterror;                   << result not 1.0 >>              38880000
      cmpn 33;                                                          38885000
      be *+2;                                                           38890000
      br dflterror;                   << stack trouble >>               38895000
                                                                        38900000
      ldni 1;   <<< -1d >>                                              38905000
      dup,dflt;                                                         38910000
      bl *+2;                                                           38915000
      br dflterror;                   << not ccl >>                     38920000
      ldpp fn1;                                                         38925000
      fcmp;                                                             38930000
      be *+2;                                                           38935000
      br dflterror;                   << result not -1.0 >>             38940000
                                                                        38945000
      ldpp fdf1;  << %001007,177774 -- check rounding >>                38950000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>38955000
      dflt;                                                             38960000
      ldpp pc43101;                                                     38965000
      dcmp;                                                             38970000
      be next);                                                         38975000
dflterror:                                                              38980000
      no'error:=false;                   << result not %43101, 0 >>     38985000
                                                                        38990000
next: assemble(                                                         38995000
      br nxt1;   << skip over constants >>                              39000000
                                                                        39005000
f0:   con 0.0;                                                          39010000
f1:   con 1.0;                                                          39015000
f3:   con 3.0;                                                          39020000
f4:   con 4.0;                                                          39025000
fn1:  con -1.0;                                                         39030000
fm7:  con -7.0;                                                         39035000
pc43101:  con %043101, 0;                                               39040000
fdf1:  con %1007, %177774);                                             39045000
                                                                        39050000
nxt1:                                                                   39055000
      push(q);set(s);  << reset stack >>                                39060000
      tos:=re'addrs;    << restore return address >>                    39065000
   end;                                                                 39070000
                                                                        39075000
<< check fixt instruction -- carry really checked by dtst instruction >>39080000
                                                                        39085000
subroutine fixt'test;                                                   39090000
   begin                                                                39095000
      re'addrs:=tos;    << save return address >>                       39100000
      assemble(                                                         39105000
      dzro,dzro;                                               <<j8932>>39110000
      ldni 1;                                                           39115000
      dzro,fixt;  << 0.0 >>                                             39120000
      be *+2;                                                           39125000
      br fixterror;                   << not cce >>                     39130000
      bncy *+2;                                                         39135000
      br fixterror;                   << c not 0 >>                     39140000
      dzro,dcmp;                                                        39145000
      be *+2;                                                           39150000
      br fixterror;                   << result not 0,0 >>              39155000
      cmpn 1;                                                           39160000
      be *+2;                                                           39165000
      br fixterror;                   << stack trouble >>               39170000
                                                                        39175000
      ldpp f0p25;   << 0.25 >>                                          39180000
      dzro,dzro;                                               <<j8676>>39185000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>39190000
      fixt;                                                             39195000
      be *+2;                                                           39200000
      br fixterror;                   << not cce >>                     39205000
      dzro,dcmp;                                                        39210000
      be *+2;                                                           39215000
      br fixterror;                   << result not 0,0 >>              39220000
                                                                        39225000
      ldpp f7p98;   << 7.98 >>                                          39230000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>39235000
      fixt;                                                             39240000
      bg *+2;                                                           39245000
      br fixterror;                   << not ccg >>                     39250000
      zero;                                                             39255000
      ldi 7;                                                            39260000
      dcmp;                                                             39265000
      be *+2;                                                           39270000
      br fixterror;                   << result not 0,7 >>              39275000
                                                                        39280000
      ldpp fm12p73;   << -12.73 >>                                      39285000
      fixt;                                                             39290000
      bl *+2;                                                           39295000
      br fixterror;                   << not ccl >>                     39300000
      ldni 1;                                                           39305000
      ldni 12;                                                          39310000
      dcmp;                                                             39315000
      be *+2;                                                           39320000
      br fixterror;                   << result not -1,-12 >>           39325000
                                                                        39330000
      ldpp pc42000;  << 1.0*2**16 >>                                    39335000
      fixt;                                                             39340000
      bg *+2;                                                           39345000
      br fixterror;                   << not ccg >>                     39350000
      bcy *+2;                                                          39355000
      br fixterror;                   << c not 1 >>                     39360000
      ldi 1;                                                            39365000
      zero,dcmp;                                                        39370000
      be *+2;                                                           39375000
      br fixterror;                   << result not 1,0 >>              39380000
                                                                        39385000
      ldpp pc142000;  << -1.0*2**16 >>                                  39390000
      fixt;                                                             39395000
      bl *+2;                                                           39400000
      br fixterror;                   << not ccl >>                     39405000
      bcy *+2;                                                          39410000
      br fixterror;                   << c not 1 >>                     39415000
      ldni 1;                                                           39420000
      zero,dcmp;                                                        39425000
      be *+2;                                                           39430000
      br fixterror;                   << result not -1,0 >>             39435000
                                                                        39440000
      ldpp pc1b22f;  << (1+fraction)*2*22 >>                            39445000
      fixt;                                                             39450000
      bg *+2;                                                           39455000
      br fixterror;                   << not ccg >>                     39460000
      bcy *+2;                                                          39465000
      br fixterror;                   << c not 1 >>                     39470000
      ldi %101;                                                         39475000
      ldni 7;                                                           39480000
      dcmp;                                                             39485000
      be *+2;                                                           39490000
      br fixterror;                   << result not %101,177771 >>      39495000
                                                                        39500000
      ldpp pc43600;   << 1.0*2**30 >>                                   39505000
      fixt;                                                             39510000
      load bit1;                                                        39515000
      zero,dcmp;                                                        39520000
      be *+2;                                                           39525000
      br fixterror;                   << result not %010000,0 >>        39530000
                                                                        39535000
      ldpp pc143700;  << -1.0*2**31 >>                                  39540000
      pcn;                                                     <<g8659>>39545000
      cmpi 5; << series 37 ? >>                                <<g8659>>39550000
      bne notmm;                                               <<g8659>>39555000
      fixt;                                                    <<g8659>>39560000
      bl *+2;                                                  <<g8659>>39565000
      br fixterror;                                            <<g8659>>39570000
      bnov *+2;                                                <<g8659>>39575000
      br fixterror;                                            <<g8659>>39580000
      bcy *+2;                                                 <<g8659>>39585000
      br fixterror;                                            <<g8659>>39590000
      load nmax;                                               <<g8659>>39595000
      zero,dcmp;                                               <<g8659>>39600000
      be *+2;                                                  <<g8659>>39605000
      br fixterror;                                            <<g8659>>39610000
      br exit;                                                 <<g8659>>39615000
                                                               <<g8659>>39620000
notmm:                                                         <<g8659>>39625000
      pcn;                                                     <<03727>>39630000
      cmpi 4;                                                  <<03727>>39635000
      be series64;                                             <<03727>>39640000
      fixt;                                                             39645000
      bov depart;                                              <<03727>>39650000
      br fixterror;                   << o not 1 >>                     39655000
      bncy depart;                                             <<03727>>39660000
      br fixterror;                                                     39665000
depart:                                                        <<03727>>39670000
      br exit;                                                 <<03727>>39675000
series64:                                                      <<03727>>39680000
      fixt;                                                    <<03727>>39685000
      bov fixterror;                                           <<03727>>39690000
      bncy exit;                                               <<03727>>39695000
      br fixterror;                                            <<03727>>39700000
f0p25: con 0.25;                                                        39705000
f7p98: con 7.98;                                                        39710000
fm12p73: con -12.73;                                                    39715000
pc42000: con %042000, 0;                                                39720000
pc142000: con %142000, 0;                                               39725000
pc1b22f: con %042601, -7;                                               39730000
pc43600: con %043600, 0;                                                39735000
pc143700: con%143700, 0;                                                39740000
f0p49: con 0.49;                                                        39745000
fm4p5: con -4.5;                                                        39750000
f43p49: con 43.49;                                                      39755000
approx2b16: con %041777, %177700);                                      39760000
fixterror:                                                              39765000
      no'error:=false;                   << c not 0 >>                  39770000
exit:                                                                   39775000
      push(q);set(s);    << reset stack >>                              39780000
      tos:=re'addrs;    << restore return address >>                    39785000
   end;                                                                 39790000
                                                                        39795000
<< check fixr instruction - similar to fixt instruction >>              39800000
                                                                        39805000
subroutine fixr'test;                                                   39810000
   begin                                                                39815000
      re'addrs:=tos;    << save return address >>                       39820000
      assemble(                                                         39825000
      dzro,dzro;                                               <<j8932>>39830000
      ldpp f0p49;   << 0.49 >>                                          39835000
      dzro,dzro;                                               <<j8676>>39840000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>39845000
      fixr;                                                             39850000
      be *+2;                                                           39855000
      br fixrerror;                   << not cce >>                     39860000
      dzro,dcmp;                                                        39865000
      be *+2;                                                           39870000
      br fixrerror;                   << result not 0,0 >>              39875000
                                                                        39880000
      ldpp fm4p5;  <<-4.5>>                                             39885000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>39890000
      fixr;                                                             39895000
      bl *+2;                                                           39900000
      br fixrerror;                   << not ccl >>                     39905000
      ldni 1;                                                           39910000
      ldni 5;                                                           39915000
      dcmp;                                                             39920000
      be *+2;                                                           39925000
      br fixrerror;                   << result not -1,-5 >>            39930000
                                                                        39935000
      ldpp f43p49;   << 43.49 >>                                        39940000
      fixr;                                                             39945000
      bg *+2;                                                           39950000
      br fixrerror;                   << not ccg >>                     39955000
      zero;                                                             39960000
      ldi 43;                                                           39965000
      dcmp;                                                             39970000
      be *+2;                                                           39975000
      br fixrerror;                   << result not 0,43 >>             39980000
                                                                        39985000
      ldpp approx2b16;   << 1.0*2**16 - 0.5 >>                          39990000
      fixr;                                                             39995000
      bg *+2;                                                           40000000
      br fixrerror;                   << not ccg >>                     40005000
      dzro,incb;                                                        40010000
      dcmp;                                                             40015000
      be next3);                                                        40020000
fixrerror:                                                              40025000
      no'error:=false;                   << result not 1,0 >>           40030000
                                                                        40035000
next3: assemble(                                                        40040000
      br nxt2;   << skip over constants >>                              40045000
                                                                        40050000
f0p25: con 0.25;                                                        40055000
f7p98: con 7.98;                                                        40060000
fm12p73: con -12.73;                                                    40065000
pc42000: con %042000, 0;                                                40070000
pc142000: con %142000, 0;                                               40075000
pc1b22f: con %042601, -7;                                               40080000
pc43600: con %043600, 0;                                                40085000
pc143700: con%143700, 0;                                                40090000
f0p49: con 0.49;                                                        40095000
fm4p5: con -4.5;                                                        40100000
f43p49: con 43.49;                                                      40105000
approx2b16: con %041777, %177700);                                      40110000
                                                                        40115000
nxt2:                                                                   40120000
      push(q);set(s);   << reset stack >>                               40125000
      tos:=re'addrs;    << restore return address >>                    40130000
   end;                                                                 40135000
                                                                        40140000
<< check fadd instruction >>                                            40145000
                                                                        40150000
subroutine fadd'test;                                                   40155000
   begin                                                                40160000
      re'addrs:=tos;    << save return address >>                       40165000
      assemble(                                                         40170000
      ldni 5;                                                           40175000
      ldpp fa18;   << 15.0 + 3.0 = 18.0 >>                              40180000
      ldpp fa3;                                                         40185000
      dzro,dzro;                                               <<j8676>>40190000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>40195000
      fadd;                                                             40200000
      bg *+2;                                                           40205000
      br fadderror;                   << not ccg >>                     40210000
      bnov *+2;                                                         40215000
      br fadderror;                   << o not 0 >>                     40220000
      ldpp fa21;                                                        40225000
      dcmp;                                                             40230000
      be *+2;                                                           40235000
      br fadderror;                   << result not 18.0 >>             40240000
      cmpn 5;                                                           40245000
      be *+2;                                                           40250000
      br fadderror;                   << stack trouble >>               40255000
                                                                        40260000
      ldpp fa2;   << 2.0 + 21.0 = 23.0 >>                               40265000
      ldpp fa21;                                                        40270000
      dxch,dxch; xch,xch; << sr=4 >>                           <<j8676>>40275000
      fadd;                                                             40280000
      bg *+2;                                                           40285000
      br fadderror;                   << not ccg >>                     40290000
      ldpp fa23;                                                        40295000
      dcmp;                                                             40300000
      be *+2;                                                           40305000
      br fadderror;                   << result not 23.0 >>             40310000
                                                                        40315000
      ldpp fa4p0001;   << 4.0001 + 4.0002  = 8.0003 >>                  40320000
      ldpp fa4p0002;                                                    40325000
      fadd;                                                             40330000
      bg *+2;                                                           40335000
      br fadderror;                   << not ccg >>                     40340000
      ldpp fa8p0003;                                                    40345000
      dcmp;                                                             40350000
      be *+2;                                                           40355000
      br fadderror;                   << result not 8.0003 >>           40360000
                                                                        40365000
      ldpp fa4p0002;   << 4.0002 + 4.0 = 8.0002 >>                      40370000
      ldpp fa4;                                                         40375000
      fadd;                                                             40380000
      bg *+2;                                                           40385000
      br fadderror;                   << not ccg >>                     40390000
      ldpp fa8p0002;                                                    40395000
      dcmp;                                                             40400000
      be *+2;                                                           40405000
      br fadderror;                   << result not 8.0002 >>           40410000
                                                                        40415000
      ldpp fa1;   << 1.0 + (-2.0) = -1.0 >>                             40420000
      ldpp fam2;                                                        40425000
      fadd;                                                             40430000
      bl *+2;                                                           40435000
      br fadderror;                   << not ccl >>                     40440000
      ldpp fam1;                                                        40445000
      dcmp;                                                             40450000
      be *+2;                                                           40455000
      br fadderror;                   << result not -1.0 >>             40460000
                                                                        40465000
      ldpp fam1p0015;   << -1.0015 + (-1.0016) >>                       40470000
      ldpp fam1p0016;                                                   40475000
      fadd;                                                             40480000
      bl *+2;                                                           40485000
      br fadderror;                   << not ccl >>                     40490000
      ldpp fam2p0031;                                                   40495000
      dcmp;                                                             40500000
      be *+2;                                                           40505000
      br fadderror;                   << result not -2.0031 >>          40510000
                                                                        40515000
      ldpp fam7;   << -7.0 + 0.0 = -7.0 >>                              40520000
      dzro,fadd;                                                        40525000
      bl *+2;                                                           40530000
      br fadderror;                   << not ccl >>                     40535000
      ldpp fam7;                                                        40540000
      dcmp;                                                             40545000
      be *+2;                                                           40550000
      br fadderror;                   << result not -7.0 >>             40555000
                                                                        40560000
      ldpp fa43p5;   << 43.5 + (-43.5) = 0.0 >>                         40565000
      ldpp fam43p5;                                                     40570000
      fadd;                                                             40575000
      be *+2;                                                           40580000
      br fadderror;                   << not cce >>                     40585000
      dzro,dcmp;                                                        40590000
      be *+2;                                                           40595000
      br fadderror;                   << result not 0.0 >>              40600000
                                                                        40605000
      ldpp facon0;   << %040000,100001 + %040000,100001 = >>            40610000
      ddup,fadd;           << %040100,100001 >>                         40615000
      bg *+2;                                                           40620000
      br fadderror;                   << not ccg >>                     40625000
      ldpp facon1;                                                      40630000
      dcmp;                                                             40635000
      be *+2;                                                           40640000
      br fadderror;                   << result not %040100,100001 >>   40645000
                                                                        40650000
      ldpp facon2;   << %143100,0 + %140077,177777 = >>                 40655000
      ldpp facon3;        << %143100,0 >>                               40660000
      fadd;                                                             40665000
      bl *+2;                                                           40670000
      br fadderror;                   << not ccl >>                     40675000
      ldpp facon2;                                                      40680000
      dcmp;                                                             40685000
      be *+2;                                                           40690000
      br fadderror;                   << result not %143100,0 >>        40695000
                                                                        40700000
      ldpp facon5;   << %077700,0 + %077700,0 = 0.0  >>                 40705000
      ddup,fadd;                                                        40710000
      bov *+2;                                                          40715000
      br fadderror;                   << o not 1 >>                     40720000
      bg *+2;                                                           40725000
      br fadderror;                   << not ccg >>                     40730000
      dzro,dcmp;                                                        40735000
      be *+2;                                                           40740000
      br fadderror;                   << result not 0,0 >>              40745000
                                                                        40750000
      ldpp facon7;   << %042677,177777 + %040077,177777 >>              40755000
      ldpp facon8;        << = %042700,000000 >>                        40760000
      fadd;                                                             40765000
      bg *+2;                 << not ccg >>                             40770000
      br fadderror;                                                     40775000
      ldpp facon9;                                                      40780000
      dcmp;                                                             40785000
      be *+2;                                                           40790000
      br fadderror;                   << result not %042700,000000 >>   40795000
                                                                        40800000
      ldpp af1;   << %040077, 0 + %040000, -1 >>                        40805000
      ldpp af2;                                                         40810000
      fadd;                                                             40815000
      ldpp fa3;                                                         40820000
      dcmp;                                                             40825000
      be next4);                                                        40830000
fadderror:                                                              40835000
      no'error:=false;                   << result not 3.0 >>           40840000
next4: assemble(                                                        40845000
                                                                        40850000
      br nxt3;   <<< skip over constants >>                             40855000
                                                                        40860000
fa3:      con  3.0;                                                     40865000
fa4:      con  4.0;                                                     40870000
fa18:     con  18.0;                                                    40875000
fa21:     con  21.0;                                                    40880000
fa23:     con  23.0;                                                    40885000
fa4p0001: con  4.0001;                                                  40890000
fa4p0002: con  4.0002;                                                  40895000
fa4p0003: con  4.0003;                                                  40900000
fa8p0002: con  8.0002;                                                  40905000
fa8p0003: con  %040300, %000236;                                        40910000
fa1:      con  1.0;                                                     40915000
fam2:     con  -2.0;                                                    40920000
fam1:     con  -1.0;                                                    40925000
fam1p0015: con -1.0015;                                                 40930000
fam1p0016: con -1.0016;                                                 40935000
fam2p0031: con -2.0031;                                                 40940000
fam7:     con  -7.0;                                                    40945000
fa43p5:   con  43.5;                                                    40950000
fam43p5:  con  -43.5;                                                   40955000
facon0:   con  %040000, %100001;                                        40960000
facon1:   con %040100, %100001;                                         40965000
facon2:   con  %143100, 0;                                              40970000
facon3:   con  %140077, -1;                                             40975000
facon5:   con  %077700, 0;                                              40980000
facon7:   con  %042677, -1;                                             40985000
facon8:   con  %040077, -1;                                             40990000
facon9:   con  %042700, 0;                                              40995000
fa5:      con  5.0;                                                     41000000
fa2:      con  2.0;                                                     41005000
fam12p125: con -12.125;                                                 41010000
fam6p0625: con -6.0625;                                                 41015000
af1:  con %40077, 0;                                                    41020000
af2:  con %40000, -1);                                                  41025000
                                                                        41030000
nxt3:                                                                   41035000
      push(q);set(s);   << reset stack >>                               41040000
      tos:=re'addrs;    << restore return address >>                    41045000
   end;   << fadd'test >>                                               41050000
                                                                        41055000
<< check fsub instruction - uses same rom code as fadd >>               41060000
                                                                        41065000
subroutine fsub'test;                                                   41070000
    begin                                                               41075000
      re'addrs:=tos;    << save return address >>                       41080000
      assemble(                                                         41085000
      ldpn fa5;   << 5.0 - 3.0 = 2.0 >>                                 41090000
      ldpn fa3;                                                         41095000
      dzro,dzro;                                               <<j8676>>41100000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>41105000
      fsub;                                                             41110000
      bg *+2);                                                          41115000
      go fsuberror;                   << not ccg >>                     41120000
      assemble(                                                         41125000
      ldpn fa2;                                                         41130000
      dcmp;                                                             41135000
      be *+2;                                                           41140000
      br fsuberror;                   << result not 2.0 >>              41145000
                                                                        41150000
      ldpn fa21;  << 21.0-23.0 >>                                       41155000
      ldpn fa23;                                                        41160000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>41165000
      fsub;                                                             41170000
      ldpn fam2;                                                        41175000
      dcmp;                                                             41180000
      be *+2;                                                           41185000
      br fsuberror;                   << result not -2 >>               41190000
                                                                        41195000
      ldpn fam12p125;   << -12.125 - (-6.0625) = -6.0625 >>             41200000
      ldpn fam6p0625;                                                   41205000
      nop,fsub;                                                         41210000
      bl *+2;                                                           41215000
      br fsuberror;                   << not ccl >>                     41220000
      ldpn fam6p0625;                                                   41225000
      dcmp;                                                             41230000
      be *+2;                                                           41235000
      br fsuberror;                   << result not -6.0625 >>          41240000
                                                                        41245000
      ldi %40;                                                          41250000
      zero;                                                             41255000
      ldi %20;                                                          41260000
      zero, fsub;                                                       41265000
      bov *+2;   << expect underflow >>                                 41270000
      br fsuberror;                   << o not 1 >>                     41275000
      bg *+2;                                                           41280000
      br fsuberror;                   << not ccg >>                     41285000
      ldpp af3;                                                         41290000
      dcmp;                                                             41295000
      be exit;                                                          41300000
      br fsuberror);                                                    41305000
fsuberror:                                                              41310000
      no'error:=false;                   << result not %77600, 0 >>     41315000
exit:                                                                   41320000
      push(q);set(s);   << reset stack >>                               41325000
      tos:=re'addrs;    << restore return address >>                    41330000
      return;                                                           41335000
      assemble(                                                         41340000
fa5:      con 5.0;                                                      41345000
af3:      con %77600, 0;                                                41350000
fa3:      con  3.0;                                                     41355000
fa4:      con  4.0;                                                     41360000
fa18:     con  18.0;                                                    41365000
fa21:     con  21.0;                                                    41370000
fa23:     con  23.0;                                                    41375000
fa4p0001: con  4.0001;                                                  41380000
fa4p0002: con  4.0002;                                                  41385000
fa4p0003: con  4.0003;                                                  41390000
fa8p0002: con  8.0002;                                                  41395000
fa8p0003: con  %040300, %000236;                                        41400000
fa1:      con  1.0;                                                     41405000
fam2:     con  -2.0;                                                    41410000
fam1:     con  -1.0;                                                    41415000
fam1p0015: con -1.0015;                                                 41420000
fam1p0016: con -1.0016;                                                 41425000
fam2p0031: con -2.0031;                                                 41430000
fam7:     con  -7.0;                                                    41435000
fa43p5:   con  43.5;                                                    41440000
fam43p5:  con  -43.5;                                                   41445000
facon0:   con  %040000, %100001;                                        41450000
facon1:   con %040100, %100001;                                         41455000
facon2:   con  %143100, 0;                                              41460000
facon3:   con  %140077, -1;                                             41465000
facon5:   con  %077700, 0;                                              41470000
facon7:   con  %042677, -1;                                             41475000
facon8:   con  %040077, -1;                                             41480000
facon9:   con  %042700, 0;                                              41485000
fa2:      con  2.0;                                                     41490000
fam12p125: con -12.125;                                                 41495000
fam6p0625: con -6.0625;                                                 41500000
af1:  con %40077, 0;                                                    41505000
af2:  con %40000, -1);                                                  41510000
   end;     << fsub'test >>                                             41515000
                                                                        41520000
<< check fmpy instruction >>                                            41525000
                                                                        41530000
subroutine fmpy'test;                                                   41535000
   begin                                                                41540000
      re'addrs:=tos;    << save return address >>                       41545000
      assemble(                                                         41550000
      ldpp fm5;   << 5.0 * 0.0 >>                                       41555000
      dzro,fmpy;                                                        41560000
      be *+2;                 << not cce >>                             41565000
      br fmpyerror;                                                     41570000
      bnov *+2;                                                         41575000
      br fmpyerror;                   << o not 0 >>                     41580000
      dzro,dcmp;                                                        41585000
      be *+2;                                                           41590000
      br fmpyerror;                   << result not 0.0 >>              41595000
                                                                        41600000
      dzro;                                                             41605000
      ldpp fmm7p995;   << 0.0 * -7.995 >>                               41610000
      dzro,dzro;                                               <<j8676>>41615000
      ddel,ddel; << sr=0 >>                                    <<j8676>>41620000
      fmpy;                                                             41625000
      be *+2;                                                           41630000
      br fmpyerror;                   << not cce >>                     41635000
      dzro,dcmp;                                                        41640000
      be *+2;                                                           41645000
      br fmpyerror;                   << result not 0.0 >>              41650000
                                                                        41655000
      ldpp fm1;   << 1.0 * 1.0 >>                                       41660000
      ddup,fmpy;                                                        41665000
      bg *+2;                                                           41670000
      br fmpyerror;                   << not ccg >>                     41675000
      ldpp fm1;                                                         41680000
      dcmp;                                                             41685000
      be *+2;                                                           41690000
      br fmpyerror;                   << result not 1.0 >>              41695000
                                                                        41700000
      ldpp fmm1;   << -1.0 * 1.0 >>                                     41705000
      ldpp fm1;                                                         41710000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>41715000
      fmpy;                                                             41720000
      bl *+2;                                                           41725000
      br fmpyerror;                   << not ccl >>                     41730000
      ldpp fmm1;                                                        41735000
      dcmp;                                                             41740000
      be *+2;                                                           41745000
      br fmpyerror;                   << result not -1.0 >>             41750000
                                                                        41755000
      ldpp k1;   << %40000,%2000 * %40077,%174000 >>                    41760000
      ldpp k2;                                                          41765000
      fmpy;                                                             41770000
      ldpp k3;                                                          41775000
      dcmp;                                                             41780000
      be *+2;                                                           41785000
      br fmpyerror;                   << result not %40100,0 >>         41790000
                                                                        41795000
      ldpp k4;   << %40040,0 * %40000,1 >>                              41800000
      ldpp k5;                                                          41805000
      fmpy;                                                             41810000
      ldpp k6;                                                          41815000
      dcmp;                                                             41820000
      be *+2;                                                           41825000
      br fmpyerror;                   << result no %40040,2 >>          41830000
                                                                        41835000
      ldpp fm1b128;   << 1.0*2**128 * 1.0*2**128 >>                     41840000
      ddup,fmpy;                                                        41845000
      bg *+2;                                                           41850000
      br fmpyerror;                   << not ccg >>                     41855000
      bov *+2;                                                          41860000
      br fmpyerror;                   << o not 1 (overflow) >>          41865000
      dzro,dcmp;                                                        41870000
      be *+2;                                                           41875000
      br fmpyerror;                   << result not 0.0 >>              41880000
                                                                        41885000
      ldpp fm1bm128; << 1.0*2**(-128) * 1.0*2**(-129) >>                41890000
      ldpp fm1bm129;                                                    41895000
      fmpy;                                                             41900000
      bg *+2;                                                           41905000
      br fmpyerror;                   << not ccg >>                     41910000
      bov *+2;                                                          41915000
      br fmpyerror;                   << o not 1  (underflow) >>        41920000
      ldpp fm1b255;                                                     41925000
      dcmp;                                                             41930000
      be *+2;                                                           41935000
      br fmpyerror;                   << result not %077700,0 >>        41940000
                                                                        41945000
      ldpp fm1bm128;   << 1.0*2**(-128) * 1.0*2**(-128) >>              41950000
      ddup,fmpy;                                                        41955000
      bov *+2;                                                          41960000
      br fmpyerror;                   << o not 1  (underflow) >>        41965000
      bg *+2;                                                           41970000
      br fmpyerror;                   << not ccg >>                     41975000
      dzro,dcmp;                                                        41980000
      be *+2;                                                           41985000
      br fmpyerror;                   << result not 0.0 >>              41990000
                                                                        41995000
      ldpp k11;  << -13.0 * -49.0 = +637.00 >>                          42000000
      ldpp k12;                                                         42005000
      fmpy;                                                             42010000
      ldpp k13;                                                         42015000
      dcmp;                                                             42020000
      be *+2;                                                           42025000
      br fmpyerror;                   << result not +637 >>             42030000
                                                                        42035000
      ldpp k14;   << 1+2**(-6)+2**(-7)+2**(-22)  * >>                   42040000
      ddup, fmpy;   << 1+2**(-6)+2**(-7)+2**(-22) >>                    42045000
      ldpp k15;                                                         42050000
      dcmp;                                                             42055000
      be *+2;                                                           42060000
      br fmpyerror;                   << result not %040003, %004402 >> 42065000
                                                                        42070000
      ldpp k16;   << 1+2**(-8) * 1+2**(-15) >>                          42075000
      ldpp k17;                                                         42080000
      fmpy;                                                             42085000
      ldpp k18;                                                         42090000
      dcmp;                                                             42095000
      be *+2;                                                           42100000
      br fmpyerror;                   << result not %40000, %40201 >>   42105000
                                                                        42110000
      ldpp fm1;   << 1.0 * %40077, %177777 >>                           42115000
      ldpp k19;                                                         42120000
      fmpy;                                                             42125000
      ldpp k19;                                                         42130000
      dcmp;                                                             42135000
      be *+2;                                                           42140000
      br fmpyerror;                   << result not %040077, %177777 >> 42145000
                                                                        42150000
      ldpp k19;   << 0040077, %177777 * %040077, %177777 >>             42155000
      ddup, fmpy;                                                       42160000
      ldpp k20;                                                         42165000
      dcmp;                                                             42170000
      be *+2;                                                           42175000
      br fmpyerror;                   << result not %040177, %177776 >> 42180000
                                                                        42185000
      ldpp k21;   << %040025, %052525 * 1.0 >>                          42190000
      ldpp fm1;                                                         42195000
      fmpy;                                                             42200000
      ldpp k21;                                                         42205000
      dcmp;                                                             42210000
      be *+2;                                                           42215000
      br fmpyerror;                   << result not %040025, %052525 >> 42220000
                                                                        42225000
      ldpp k21;   << %040025, %052525 * %040025, %052525 >>             42230000
      ddup, fmpy;                                                       42235000
      ldpp k22;                                                         42240000
      dcmp;                                                             42245000
      be *+2;                                                           42250000
      br fmpyerror;                   << result not %040061, %143434 >> 42255000
                                                                        42260000
      ldpp k23;   << %040052, %125252 * %040052, %125252 >>             42265000
      ddup, fmpy;                                                       42270000
      ldpp k24;                                                         42275000
      dcmp;                                                             42280000
      be *+2;                                                           42285000
      br fmpyerror;                   << result not %040130, %161615 >> 42290000
                                                                        42295000
      ldpp fm1bm128;   << 1*2(-128) * -1*2(-128) >>                     42300000
      ldpp nfm1bm128;                                                   42305000
      fmpy;                                                             42310000
      bov *+2;   << expect underflow >>                                 42315000
      br fmpyerror;                   << o not 1 >>                     42320000
      bl *+2;                                                           42325000
      br fmpyerror;                   << not ccl >>                     42330000
      load nmax;                                                        42335000
      zero, dcmp;                                                       42340000
      be next5);                                                        42345000
fmpyerror:                                                              42350000
      no'error:=false;                   << result not %100000, 0 >>    42355000
                                                                        42360000
next5: assemble(                                                        42365000
      br nxt10;   << skip over constants >>                             42370000
                                                                        42375000
af3:  con %77600, 0;                                                    42380000
k1:   con %40000, %2000;                                                42385000
k2:   con %40077, %174000;                                              42390000
k3:   con %40100,0;                                                     42395000
k4:   con %40040, 0;                                                    42400000
k5:   con %40000,1;                                                     42405000
k6:   con %40040,2;                                                     42410000
fm5:      con  5.0;                                                     42415000
fmm7p995: con  -7.995;                                                  42420000
fm1:      con  1.0;                                                     42425000
fmm1:     con  -1.0;                                                    42430000
fm1b128:  con  %060000, 0;                                              42435000
fm1bm128: con  %020000, 0;                                              42440000
fm1bm129: con  %017700, 0;                                              42445000
fm1b255:  con  %077700, 0;                                              42450000
k11:  con -13.0;                                                        42455000
k12:  con -49.0;                                                        42460000
k13:  con 637.0;                                                        42465000
k14:  con %40001, %100001;                                              42470000
k15:  con %40003, %4402;                                                42475000
k16:  con %40000, %40000;                                               42480000
k17:  con %40000, %200;                                                 42485000
k18:  con %40000, %40201;                                               42490000
k19:  con %40077, -1;                                                   42495000
k20:  con %40177, -2;                                                   42500000
k21:  con %40025, %52525;                                               42505000
k22:  con %40061, %143434;                                              42510000
k23:  con %40052, %125252;                                              42515000
k24:  con %40130, %161615;                                              42520000
nfm1bm128: con %120000, 0);                                             42525000
                                                                        42530000
nxt10:                                                                  42535000
      push(q);set(s);   << reset stack >>                               42540000
      tos:=re'addrs;    << restore return address >>                    42545000
   end;                                                                 42550000
                                                                        42555000
<< check fdiv instruction >>                                            42560000
                                                                        42565000
subroutine fdiv'test;                                                   42570000
   begin                                                                42575000
      re'addrs:=tos;    << save return address >>                       42580000
      assemble(                                                         42585000
      ldni 35;                                                          42590000
      dzro;      << 0.0/1.0 >>                                          42595000
      ldpn fm1;                                                         42600000
      fdiv;                                                             42605000
      be *+2;                                                           42610000
      br fdiverror;                   << not cce >>                     42615000
      bnov *+2;                                                         42620000
      br fdiverror;                   << o not 0 >>                     42625000
      dzro,dcmp;                                                        42630000
      be *+2;                                                           42635000
      br fdiverror;                   << result not 0.0 >>              42640000
      cmpn 35;                                                          42645000
      be *+2;                                                           42650000
      br fdiverror;                   << stack trouble >>               42655000
                                                                        42660000
      ldpn fm5    << 5.0/1.0 >>                                         42665000
      ldpn fm1;                                                         42670000
      dzro,dzro;                                               <<j8676>>42675000
      ddel,ddel;  << sr=0 >>                                   <<j8676>>42680000
      fdiv;                                                             42685000
      bg *+2;                                                           42690000
      br fdiverror;                   << not ccg >>                     42695000
      bnov *+2;                                                         42700000
      br fdiverror;                   << o not 0 >>                     42705000
      ldpn fm5;                                                         42710000
      dcmp;                                                             42715000
      be *+2;                                                           42720000
      br fdiverror;                   << result not 5.0 >>              42725000
                                                                        42730000
      ldpp fd1;   << 1.0/-(2.0) >>                                      42735000
      ldpp fdm2;                                                        42740000
      dxch,dxch; xch,xch;  << sr=4 >>                          <<j8676>>42745000
      fdiv;                                                             42750000
      bl *+2;                                                           42755000
      br fdiverror;                   << not ccl >>                     42760000
      ldpp fdm0p5;                                                      42765000
      dcmp;                                                             42770000
      be *+2;                                                           42775000
      br fdiverror;                   << result not -0.5 >>             42780000
                                                                        42785000
      ldpp fdm2;   << -2.0/6.0 >>                                       42790000
      ldpp fd6;                                                         42795000
      fdiv;                                                             42800000
      bl *+2;                                                           42805000
      br fdiverror;                   << not ccl >>                     42810000
      ldpp fdmp33;                                                      42815000
      dcmp;                                                             42820000
      be *+2;                                                           42825000
      br fdiverror;                   << result not -1/3 >>             42830000
                                                                        42835000
      ldpp fd6;   << 6.0/12.0 >>                                        42840000
      ldpp fd12;                                                        42845000
      fdiv;                                                             42850000
      bg *+2;                                                           42855000
      br fdiverror;                   << not ccg >>                     42860000
      ldpp fd0p5;                                                       42865000
      dcmp;                                                             42870000
      be *+2;                                                           42875000
      br fdiverror;                   << result not 0.5 >>              42880000
                                                                        42885000
      ldpp fd12;   << 12.0/-8.0 >>                                      42890000
      ldpp fdm8;                                                        42895000
      fdiv;                                                             42900000
      bl *+2;                                                           42905000
      br fdiverror;                   << not ccl >>                     42910000
      ldpp fdm1p5;                                                      42915000
      dcmp;                                                             42920000
      be *+2;                                                           42925000
      br fdiverror;                   << result not -1.5 >>             42930000
                                                                        42935000
      ldpp fdm8;   << -8.0/-3904 >>                                     42940000
      ldpp fdm3904;                                                     42945000
      fdiv;                                                             42950000
      bg *+2;                                                           42955000
      br fdiverror;                   << not ccg >>                     42960000
      ldpp fdk1;                                                        42965000
      dcmp;                                                             42970000
      be *+2;                                                           42975000
      br fdiverror;                   << result not .00204918 >>        42980000
                                                                        42985000
      ldpp fd1;   << 1.0/0.0 >>                                         42990000
      dzro,fdiv;                                                        42995000
      bg *+2;                                                           43000000
      br fdiverror;                   << not ccg >>                     43005000
      bov *+2;                                                          43010000
      br fdiverror;                   << o not 1 >>                     43015000
      ldpp fd1;                                                         43020000
      dcmp;                                                             43025000
      be *+2;                                                           43030000
      br fdiverror;                   << result not 1.0 >>              43035000
                                                                        43040000
      dzro,deca;                                                        43045000
      dzro,fdiv;                                                        43050000
      bg *+2;                                                           43055000
      br fdiverror;                   << not ccg >>                     43060000
      dzro,deca;                                                        43065000
      dcmp;                                                             43070000
      be *+2;                                                           43075000
      br fdiverror;                   << result not 0,-1 >>             43080000
                                                                        43085000
      br nxt11;   << skip over constants >>                             43090000
                                                                        43095000
fm1:      con 1.0;                                                      43100000
fm5:      con 5.0;                                                      43105000
fd1:      con 1.0;                                                      43110000
fdm2:     con -2.0;                                                     43115000
fdm0p5:   con -0.5;                                                     43120000
fd6:      con 6.0;                                                      43125000
fdmp33:   con %137625, %052525;                                         43130000
fd12:     con 12.0;                                                     43135000
fd0p5:    con 0.5;                                                      43140000
fdm8:     con -8.0;                                                     43145000
fdm1p5:   con -1.5;                                                     43150000
fdm3904:  con -3904.0;                                                  43155000
fdk1:     con %36703, %022705;                                          43160000
                                                                        43165000
nxt11:                                                                  43170000
                                                                        43175000
      ldpn fd1;   << 1.0/(1+2**(-22)) >>                                43180000
      ldpp pn22;                                                        43185000
      fdiv;                                                             43190000
      bg *+2;                                                           43195000
      br fdiverror;                   << not ccg >>                     43200000
      ldpp nn22;                                                        43205000
      dcmp;                                                             43210000
      be *+2;                                                           43215000
      br fdiverror;                   << result not 1-2**(-22) >>       43220000
                                                                        43225000
      ldpn fd1;   << 1.0/(1-2**(-23)) >>                                43230000
      ldpp nn23;                                                        43235000
      fdiv;                                                             43240000
      bg *+2;                                                           43245000
      br fdiverror;                   << not ccg >>                     43250000
      ldpp pn22;                                                        43255000
      dcmp;                                                             43260000
      be *+2;                                                           43265000
      br fdiverror;                   << result not 1+2**(-22) >>       43270000
                                                                        43275000
      ldpp nn23;   << 1-2**(-23)/1+2**(-22) >>                          43280000
      ldpp pn22;                                                        43285000
      fdiv;                                                             43290000
      bg *+2;                                                           43295000
      br fdiverror;                   << not ccg >>                     43300000
      ldpp nn22nn23;                                                    43305000
      dcmp;                                                             43310000
      be *+2;                                                           43315000
      br fdiverror;               << result not 1-2**(-22)-2**(-23)  >> 43320000
                                                                        43325000
      ldpp pn22;   << 1+2**(-22)/1-2**(-22) >>                          43330000
      ldpp nn22;                                                        43335000
      fdiv;                                                             43340000
      bg *+2;                                                           43345000
      br fdiverror;                   << not ccg >>                     43350000
      ldpp pn21;                                                        43355000
      dcmp;                                                             43360000
      be *+2;                                                           43365000
      br fdiverror;                   << result not 1+2**(-21) >>       43370000
                                                                        43375000
      ldpp nn22;   << 1-2**(22)/1+2**(-22) >>                           43380000
      ldpp pn22;                                                        43385000
      fdiv;                                                             43390000
      bg *+2;                                                           43395000
      br fdiverror;                   << not ccg >>                     43400000
      ldpp nn21;                                                        43405000
      dcmp;                                                             43410000
      be *+2;                                                           43415000
      br fdiverror;                   << result not 1-2**(-21) >>       43420000
                                                                        43425000
      ldpp nn12;   << 1-2**(-12)/1+2**(-12) >>                          43430000
      ldpp pn12;                                                        43435000
      fdiv;                                                             43440000
      bg *+2;                                                           43445000
      br fdiverror;                   << not ccg >>                     43450000
      ldpp nn11pn23;                                                    43455000
      dcmp;                                                             43460000
      be *+2;                                                           43465000
      br fdiverror;               << result not 1-2**(-11)+2**(-23) >>  43470000
                                                                        43475000
      ldpp nn13;   << 1-2**(-13)/1+2**(-13) >>                          43480000
      ldpp pn13;                                                        43485000
      fdiv;                                                             43490000
      bg *+2;                                                           43495000
      br fdiverror;                   << not ccg >>                     43500000
      ldpp nn12;                                                        43505000
      dcmp;                                                             43510000
      be *+2;                                                           43515000
      br fdiverror;                   << result not 1-2**(-12) >>       43520000
                                                                        43525000
      ldpp pn12;   << 1+2**(-12)/1-2**(-12) >>                          43530000
      ldpp nn12;                                                        43535000
      fdiv;                                                             43540000
      bg *+2;                                                           43545000
      br fdiverror;                   << not ccg >>                     43550000
      ldpp pn11pn22;                                                    43555000
      dcmp;                                                             43560000
      be *+2;                                                           43565000
      br fdiverror;               << result not 1+2**(-11)+2**(-22) >>  43570000
                                                                        43575000
<< test case where q2 >= 2**16 >>                                       43580000
                                                                        43585000
      ldpp pn10pn22;   << 1+2**(-10)+2**(-22)/1+2**(-22) >>             43590000
      ldpp pn22;                                                        43595000
      fdiv;                                                             43600000
      bg *+2;                                                           43605000
      br fdiverror;                   << not ccg >>                     43610000
      ldpp pn10;                                                        43615000
      dcmp;                                                             43620000
      be *+2;                                                           43625000
      br fdiverror;                   << result not 1*2**(-10) >>       43630000
                                                                        43635000
<< test case to check carry when r1b-q1v2:=r1b-q1v2+v1b+v2 >>           43640000
                                                                        43645000
      ldpp pn10;   << 1+2**(-10) >>                                     43650000
      ldpp pn15;   << 1+2**(-15) >>                                     43655000
      fdiv;                                                             43660000
      ldpp pn10nn15;                                                    43665000
      dcmp;                                                             43670000
      be exit;                                                          43675000
      br fdiverror);             << result not 1+2**(-10)-2**(-15) >>   43680000
                                                                        43685000
fdiverror:                                                              43690000
      no'error:=false;                                                  43695000
                                                                        43700000
exit:                                                                   43705000
       push(q);set(s);  << reset stack >>                               43710000
       tos:=re'addrs;   << restore return address >>                    43715000
                                                                        43720000
      assemble( exit 0;   << return >>                                  43725000
                                                                        43730000
pn10: con %040000, %010000;                                             43735000
pn22: con %040000, %000001;                                             43740000
nn22: con %037777, %177776;                                             43745000
nn23: con %037777, %177777;                                             43750000
nn22nn23: con %037777, %177775;                                         43755000
pn21: con %040000, 2;                                                   43760000
nn21: con %037777, %177774;                                             43765000
nn12: con %037777, %174000;                                             43770000
pn12: con %040000, %002000;                                             43775000
nn11pn23: con %037777, %170001;                                         43780000
nn13: con %037777, %176000;                                             43785000
pn13: con %040000, %001000;                                             43790000
pn11pn22: con %040000, %004001;                                         43795000
pn10pn22: con %040000, %010001;                                         43800000
pn15: con %40000, %200;                                                 43805000
pn10nn15: con %40000, %7600;                                            43810000
                                                                        43815000
      nop);                                                             43820000
   end;                                                                 43825000
                                                                        43830000
      move instruct'name:="FNEG  ";                                     43835000
      print'names;                                                      43840000
      while no'error and (i:=i+1) < loopnumber do fneg'test;            43845000
                                                                        43850000
      move instruct'name:="FCMP  ";                                     43855000
      print'names;                                                      43860000
      while no'error and (i:=i+1) < loopnumber do fcmp'test;            43865000
                                                                        43870000
      move instruct'name:="FLT   ";                                     43875000
      print'names;                                                      43880000
      while no'error and (i:=i+1) < loopnumber do flt'test;             43885000
                                                                        43890000
      move instruct'name:="DFLT  ";                                     43895000
      print'names;                                                      43900000
      while no'error and (i:=i+1) < loopnumber do dflt'test;            43905000
                                                                        43910000
      move instruct'name:="FIXT  ";                                     43915000
      print'names;                                                      43920000
      while no'error and (i:=i+1) < loopnumber do fixt'test;            43925000
                                                                        43930000
      move instruct'name:="FIXR  ";                                     43935000
      print'names;                                                      43940000
      while no'error and (i:=i+1) < loopnumber do fixr'test;            43945000
                                                                        43950000
      move instruct'name:="FADD  ";                                     43955000
      print'names;                                                      43960000
      while no'error and (i:=i+1) < loopnumber do fadd'test;            43965000
                                                                        43970000
      move instruct'name:="FSUB  ";                                     43975000
      print'names;                                                      43980000
      while no'error and (i:=i+1) < loopnumber do fsub'test;            43985000
                                                                        43990000
      move instruct'name:="FMPY  ";                                     43995000
      print'names;                                                      44000000
      while no'error and (i:=i+1) < loopnumber do fmpy'test;            44005000
                                                                        44010000
      move instruct'name:="FDIV  ";                                     44015000
      print'names;                                                      44020000
      while no'error and (i:=i+1) < loopnumber do fdiv'test;            44025000
                                                                        44030000
                                                                        44035000
end;   << grpj >>                                                       44040000
                                                                        44045000
procedure testmove;  << test move instruction >>                        44050000
begin                                                                   44055000
    integer array ia3(0:3)=pb:=-7,3,-6,2;                               44060000
                                                                        44065000
<< test 1:  move db to db  cnt=5, scec=3, sr=4 >>                       44070000
<<    check stack position, moved contents, cc unchanged >>             44075000
       move instruct'name:="MOVE  ";                                    44080000
       print'names;                                                     44085000
star:    cia1;                                                          44090000
  tos:=-1;                                                              44095000
  move ia1 := ia2,(5);                                                  44100000
  if <= then assemble(br moveerror);   << cc changed - not ccg >>       44105000
  if tos<>-1 then begin assemble(br moveerror); go move1; end;          44110000
  for i:=0 until 4 do                                                   44115000
    begin                                                               44120000
      if ia1(i)<>ia2(x) then begin assemble(br moveerror); go move1; end44125000
    end;                                                                44130000
move1:                                                                  44135000
                                                                        44140000
<< test 2:  move pb to db  cnt=4  sdec=3 >>                             44145000
<<   check moved contents >>                                            44150000
    cia1;                                                               44155000
    tos:=@ia3(0);                                                       44160000
    move ia1(0):=*pb,(4),3;                                             44165000
    for i:=0 until 3 do                                                 44170000
      begin                                                             44175000
        if ia1(i)<>ia3(i) then begin                                    44180000
                                 assemble(br moveerror);                44185000
                                 go mpbae;                              44190000
                               end;                                     44195000
      end;                                                              44200000
mpbae:                                                                  44205000
                                                                        44210000
<< test 3:  move db to db  cnt=-5  sdec=0 >>                            44215000
<<   check cnt, sa, ta, moved contents, cc unchanged >>                 44220000
  cia1;                                                                 44225000
  move ia1(4):=ia2(x),(-5),0;                                           44230000
  if >= then assemble(br moveerror);   << cc changed - not ccl >>       44235000
  if tos<>0 then begin assemble(br moveerror); go move2; end;           44240000
  if tos<>@ia2(-1) then begin assemble(br moveerror); go move2; end;    44245000
  if tos<>@ia1(-1) then begin assemble(br moveerror); go move2; end;    44250000
  for i:=0 until 4 do                                                   44255000
    begin                                                               44260000
      if ia1(i)<>ia2(x) then begin assemble(br moveerror); go move2; end44265000
    end;                                                                44270000
move2:                                                                  44275000
                                                                        44280000
<< test 4:  move db to db  cnt=0  sdec=0 >>                             44285000
<<   check cnt, sa, ta, nothing moved >>                                44290000
  cia1;                                                                 44295000
  move ia1:=ia2,(0),0;                                                  44300000
  if tos<>0 then begin assemble(br moveerror); go move3; end;           44305000
  if tos<>@ia2(0) then begin assemble(br moveerror); go move3; end;     44310000
  if tos<>@ia1(0) then begin assemble(br moveerror); go move3; end;     44315000
  for i:=0 until 4 do                                                   44320000
    begin                                                               44325000
      if ia1(i)<>0 then begin assemble(br moveerror); go move3; end;    44330000
    end;                                                                44335000
move3:                                                                  44340000
                                                                        44345000
<< test 5:  move db to db  cnt=5  sdec=1 >>                             44350000
<<   check sa >>                                                        44355000
  move ia1 := ia2,(5),1;                                                44360000
  if tos<>@ia2(5) then assemble(br moveerror);                          44365000
                                                                        44370000
<< test 6:  move db to db  cnt=5  sdec=2 >>                             44375000
<<   check ta >>                                                        44380000
  move ia1 := ia2,(5),2;                                                44385000
  if tos<>@ia1(5) then assemble(br moveerror);                          44390000
                                                                        44395000
<<  test 7:  move db to db  cnt=5  sdec=0  sr=0 >>                      44400000
<<   check cnt, sa, ta, moved contents >>                               44405000
  cia1;                                                                 44410000
assemble( ldi 3; lra ia1; lra ia2; ldi 5; ldi 98; subs 1; move 0);      44415000
  if tos<>0 then begin assemble(br moveerror); go move4; end;           44420000
  if tos<>@ia2(5) then begin assemble(br moveerror); go move4; end;     44425000
  if tos<>@ia1(5) then begin assemble(br moveerror); go move4; end;     44430000
  for i:=0 until 4 do                                                   44435000
    begin                                                               44440000
     if ia2(i)<>ia1(x) then begin assemble(br moveerror);go move4;end;  44445000
    end;                                                                44450000
move4:                                                                  44455000
                                                                        44460000
       push(q);set(s); <<reset stack>>                                  44465000
       if(loopctn:=loopctn+1)= loopnumber then go out                   44470000
       else go star;                                                    44475000
                                                                        44480000
moveerror:                                                              44485000
      no'error:=false;                                                  44490000
                                                                        44495000
out:   loopctn:=0;                                                      44500000
                                                                        44505000
                                                                        44510000
end;   << testmove >>                                                   44515000
                                                                        44520000
procedure testmvb;   << test mvb instruction >>                         44525000
begin                                                                   44530000
byte array ba4(0:9)=pb:="FGHIJ56789";                                   44535000
                                                                        44540000
<< test 1:  db to db  cnt=10  sdec=3 >>                                 44545000
<<   check moved contents, cc unchanged >>                              44550000
       move instruct'name:="MVB   ";                                    44555000
       print'names;                                                     44560000
star:    cba1;                                                          44565000
  move ba1:=ba2,(10);                                                   44570000
  if <= then assemble(br mbverror);  << cc changed - not ccg >>         44575000
  for x:=0 until 9 do                                                   44580000
    begin                                                               44585000
      if ba1(x)<>ba2(x) then begin assemble(br mbverror); go mvb1; end; 44590000
    end;                                                                44595000
mvb1:                                                                   44600000
                                                                        44605000
<< test 2:  pb to db  cnt=10  sdec=3 >>                                 44610000
<<   check moved contents >>                                            44615000
  cba1;                                                                 44620000
  move ba1:=ba4,(10);                                                   44625000
  for x:=0 until 9 do                                                   44630000
    begin                                                               44635000
      if ba1(x)<>ba3(x) then begin assemble(br mbverror); go mvb2; end; 44640000
    end;                                                                44645000
mvb2:                                                                   44650000
                                                                        44655000
<< test 3:  db to db  cnt=-5  sdec=0 >>                                 44660000
<<   check cnt, sa, ta, moved contents, cc unchanged >>                 44665000
  cba1;                                                                 44670000
  move ba1(8):=ba2(7),(-5),0;                                           44675000
  if >= then assemble(br mbverror);   << cc changed - not ccl >>        44680000
  if tos<>0 then begin assemble(br mbverror); go mvb3; end;             44685000
  if tos<>@ba2(2) then begin assemble(br mbverror); go mvb3; end;       44690000
  if tos<>@ba1(3) then begin assemble(br mbverror); go mvb3; end;       44695000
  for i:=8 step -1 until 4 do                                           44700000
    begin                                                               44705000
      if ba1(i)<>ba2(i-1) then begin assemble(br mbverror);go mvb3;end; 44710000
    end;                                                                44715000
  for x:=0 until 3 do                                                   44720000
    begin                                                               44725000
      if ba1(x)<>0 then begin assemble(br mbverror); go mvb3; end;      44730000
    end;                                                                44735000
  if ba1(9)<>0 then assemble(br mbverror);                              44740000
mvb3:                                                                   44745000
                                                                        44750000
       push(q);set(s); <<reset stack>>                                  44755000
       if(loopctn:=loopctn+1)= loopnumber then go out                   44760000
       else go star;                                                    44765000
                                                                        44770000
mbverror:                                                               44775000
      no'error:=false;                                                  44780000
                                                                        44785000
out:   loopctn:=0;                                                      44790000
                                                                        44795000
                                                                        44800000
end;   << testmvb >>                                                    44805000
procedure testmvbw;   << testmvbw instruction >>                        44810000
begin                                                                   44815000
                                                                        44820000
<< test 1:  ccf=a  sdec=0  source string is "ABC0" >>                   44825000
<<   check ccg, sa, ta, moved contents >>                               44830000
       move instruct'name:="MVBW  ";                                    44835000
       print'names;                                                     44840000
star:    cba1;                                                          44845000
  move ba1:=aaan while a,0;                                             44850000
  if <= then begin assemble(br mbvwerror); go mvbw1; end;               44855000
  if tos<>@aaan(3) then begin assemble(br mbvwerror); go mvbw1; end;    44860000
  if tos<>@ba1(3) then begin assemble(br mbvwerror); go mvbw1; end;     44865000
   for x:=0 until 2 do                                                  44870000
    begin                                                               44875000
      if ba1(x)<>aaan(x) then begin assemble(br mbvwerror);             44880000
                                    go mvbw1;                           44885000
                              end;                                      44890000
    end;                                                                44895000
  if ba1(3)<>0 then assemble(br mbvwerror);                             44900000
mvbw1:                                                                  44905000
                                                                        44910000
<< test 2:  ccf=n  sdec=0  source string is "012A" >>                   44915000
<<   check cce, sa, ta, moved contents >>                               44920000
  cba1;                                                                 44925000
  move ba1:=nnna while n,0;                                             44930000
  if <> then begin assemble(br mbvwerror); go mvbw2; end;               44935000
  if tos<>@nnna(3) then begin assemble(br mbvwerror); go mvbw2; end;    44940000
  if tos<>@ba1(3) then begin assemble(br mbvwerror); go mvbw2; end;     44945000
   for x:=0 until 2 do                                                  44950000
    begin                                                               44955000
      if ba1(x)<>nnna(x) then begin assemble(br mbvwerror); go mvbw2;   44960000
                              end;                                      44965000
    end;                                                                44970000
  if ba1(3)<>0 then assemble(br mbvwerror);                             44975000
mvbw2:                                                                  44980000
                                                                        44985000
<< test 3:  ccf=ans  sdec=0  string = 3 lower alpha & 1 spec char >>    44990000
<<   check ccl, sa, ta, moved contents >>                               44995000
<< all moved lower case alphas should be upshifted; ie. bit(10):=0>>    45000000
  cba1;                                                                 45005000
  move ba1:=llls while ans,0;                                           45010000
  if >= then begin assemble(br mbvwerror); go mvbw3; end;               45015000
  if tos<>@llls(3) then begin assemble(br mbvwerror); go mvbw3; end;    45020000
  if tos<>@ba1(3) then begin assemble(br mbvwerror); go mvbw3; end;     45025000
   for x:=0 until 2 do                                                  45030000
    begin                                                               45035000
         if logical(ba1(x))<>(logical(llls(x))land %337) then           45040000
            begin assemble(br mbvwerror); go mvbw3; end;                45045000
    end;                                                                45050000
  if ba1(3)<>0 then assemble(br mbvwerror);                             45055000
mvbw3:                                                                  45060000
                                                                        45065000
<< test 4:  ccf=ans  sdec=0  source string is "?'" >>                   45070000
<<   check ccl, sa, ta, nothing moved >>                                45075000
  cba1;                                                                 45080000
  move ba1:=ss while ans,0;                                             45085000
  if >= then begin assemble(br mbvwerror); go mvbw4; end;               45090000
  if tos<>@ss then begin assemble(br mbvwerror); go mvbw4; end;         45095000
  if ba1(0)<>0 then assemble(br mbvwerror);                             45100000
mvbw4:                                                                  45105000
                                                                        45110000
<< test 5:  ccf=a  sdec=3  source string is "ABC0" >>                   45115000
<< check ccl, stackposition, moved contents >>                          45120000
  cba1;                                                                 45125000
  tos:=-22;  tos:=-3;                                                   45130000
  move ba1:=aaan while a,3;                                             45135000
  if <= then begin assemble(br mbvwerror); go mvbw6; end;               45140000
  if tos<>-22 then begin assemble(br mbvwerror); go mvbw6; end;         45145000
  for x:=0 until 2 do                                                   45150000
    begin                                                               45155000
    if ba1(x)<>aaan(x) then begin assemble(br mbvwerror); go mvbw6; end;45160000
    end;                                                                45165000
  if ba1(3)<>0 then assemble(br mbvwerror);                             45170000
mvbw6:                                                                  45175000
                                                                        45180000
<< test 6:  ccf=ans  sdec=1  source string is "A0B1?" >>                45185000
<<   check ccl, ta, moved contents >>                                   45190000
  cba1;                                                                 45195000
  move ba1:=anans while ans,1;                                          45200000
  if>= then begin assemble(br mbvwerror); go mvbw7; end;                45205000
if tos<>@ba1(4) then begin assemble(br mbvwerror); go mvbw7; end;       45210000
   for x:=0 until 3 do                                                  45215000
    begin                                                               45220000
      if ba1(x)<>anans(x) then begin assemble(br mbvwerror);go mvbw7;   45225000
                               end;                                     45230000
    end;                                                                45235000
  if ba1(4)<>0 then assemble(br mbvwerror);                             45240000
mvbw7:                                                                  45245000
                                                                        45250000
<< test 7:  ccf=ans  sdec=0  source string is "A0B1?"  sr=0 >>          45255000
<<   check sa >>                                                        45260000
  assemble( load ba1;  load anans;                             <<j8676>>45265000
      dzro,dzro; ddel,ddel; mvbw ans,0);                       <<j8676>>45270000
                                                               <<j8676>>45275000
   if tos<>@anans(4) then assemble(br mbvwerror);                       45280000
                                                                        45285000
<< test 8:  ccf=ans  sdec=0  source string is "A0B1?"  sr=4 >>          45290000
<<   check sa >>                                                        45295000
  assemble( load ba1;  load anans;                             <<j8676>>45300000
       dxch,dxch; xch,xch; mvbw ans,0);                        <<j8676>>45305000
  if tos<>@anans(4) then assemble(br mbvwerror);                        45310000
                                                                        45315000
       push(q);set(s); <<reset stack>>                                  45320000
       if(loopctn:=loopctn+1)= loopnumber then go out                   45325000
       else go star;                                                    45330000
                                                                        45335000
mbvwerror:                                                              45340000
      no'error:=false;                                                  45345000
                                                                        45350000
out:   loopctn:=0;                                                      45355000
                                                                        45360000
                                                                        45365000
end;   << test mvbw >>                                                  45370000
                                                                        45375000
procedure testscw;   << test scw instruction >>                         45380000
begin                                                                   45385000
                                                                        45390000
<< test 1:  array is "AAAAAB"  testword is "BA"  sdec=1 >>              45395000
<<   check cce, carry=1, sa >>                                          45400000
       move instruct'name:="SCW   ";                                    45405000
       print'names;                                                     45410000
star:    tos := 0+0;  << clear carry >>                                 45415000
   scan baa while "BA",1;                                               45420000
  if <> then begin assemble(br scwerror); go scw1; end;                 45425000
   if nocarry then begin assemble(br scwerror); go scw1; end;           45430000
   if tos<>@baa(5) then assemble(br scwerror);                          45435000
scw1:                                                                   45440000
                                                                        45445000
<< test 2:  array is "AAAAAB"  testword is "CA"  sdec=1 >>              45450000
<<   check cce, carry=0, sa >>                                          45455000
  tos:=2-1;   << set carry >>                                           45460000
  scan baa while "CA",1;                                                45465000
  if <> then begin assemble(br scwerror); go scw2; end;                 45470000
  if carry then begin assemble(br scwerror); go scw2; end;              45475000
  if tos <>@baa(5) then assemble(br scwerror);                          45480000
scw2:                                                                   45485000
                                                                        45490000
<< test 3:  array is "0001"  testword is "10"  sdec=0  sa is odd >>     45495000
<<   check ccg, testword on tos, sa >>                                  45500000
  scan ban(1) while "10",0;                                             45505000
  if <= then begin assemble(br scwerror); go scw3; end;                 45510000
  if tos<>"10" then begin assemble(br scwerror); go scw3; end;          45515000
  if tos<>@ban(4) then assemble(br scwerror);                           45520000
scw3:                                                                   45525000
                                                                        45530000
<< test 4:  array is "AAAAAB"  testword is "10"  sdec=1 >>              45535000
<<   check sa >>                                                        45540000
  scan baa while "10",1;                                                45545000
  if tos<>@baa then assemble(br scwerror);                              45550000
                                                                        45555000
       push(q);set(s); <<reset stack>>                                  45560000
       if(loopctn:=loopctn+1)= loopnumber then go out                   45565000
       else go star;                                                    45570000
                                                                        45575000
scwerror:                                                               45580000
      no'error:=false;                                                  45585000
                                                                        45590000
out:   loopctn:=0;                                                      45595000
                                                                        45600000
                                                                        45605000
end;   << test scw >>                                                   45610000
                                                                        45615000
procedure testscu;   << test scu instruction >>                         45620000
begin                                                                   45625000
                                                                        45630000
<< test 1:  array is "ABCD0123?"  testword is "A0"  sdec=1 >>           45635000
<<   check carry=0, sa, cc unchanged >>                                 45640000
       move instruct'name:="SCU   ";                                    45645000
       print'names;                                                     45650000
star:    tos:=0+0;  << carry=0 >>                                       45655000
   scan ba9 until "A0",1;                                               45660000
  if <= then assemble(br scuerror);  << cc changed - not ccg >>         45665000
   if nocarry then begin assemble(br scuerror); go scu1; end;           45670000
  if tos<>@ba9 then assemble(br scuerror);                              45675000
scu1:                                                                   45680000
                                                                        45685000
<< test 2:  array is "ABCD0123?"  testword is "50"  sdec=1 >>           45690000
<<   check carry=0, sa >>                                               45695000
   tos:=2-1;   << set carry >>                                          45700000
   scan ba9 until "50",1;                                               45705000
   if carry then begin assemble(br scuerror); go scu2; end;             45710000
   if tos<>@ba9(4) then assemble(br scuerror);                          45715000
scu2:                                                                   45720000
                                                                        45725000
<<  test 3:  array is "ABCD0123?"  testword is "X?"  sdec=0 >>          45730000
<<   check tos="X?", sa >>                                              45735000
  scan ba9 until "X?",0;                                                45740000
  if tos<>"X?" then begin assemble(br scuerror); go scu3; end;          45745000
  if tos<>@ba9(8) then assemble(br scuerror);                           45750000
scu3:                                                                   45755000
                                                                        45760000
       push(q);set(s); <<reset stack>>                                  45765000
       if(loopctn:=loopctn+1)= loopnumber then go out                   45770000
       else go star;                                                    45775000
                                                                        45780000
scuerror:                                                               45785000
      no'error:=false;                                                  45790000
                                                                        45795000
out:   loopctn:=0;                                                      45800000
                                                                        45805000
                                                                        45810000
end;   << test scu >>                                                   45815000
                                                                        45820000
procedure testcmpb;   << test cmpb instruction >>                       45825000
begin                                                                   45830000
  byte array bac(0:4)=pb:="ABCDE";                                      45835000
                                                                        45840000
<< test 1:  2 identical db arrays, cnt=10, sdec=0 >>                    45845000
<<   check cce, cnt, sa, ta >>                                          45850000
       move instruct'name:="CMPB  ";                                    45855000
       print'names;                                                     45860000
star:   move ba1:=ba2,(10);    << get 2 indentical buffers >>           45865000
if ba1<>ba2,(10),0then<<not cce>>begin assemble(br cmpberror);          45870000
                                       go cmpb1;                        45875000
                                 end;                                   45880000
   if tos<>0 then begin assemble(br cmpberror); go cmpb1; end;          45885000
   if tos<>@ba2(10) then begin assemble(br cmpberror); go cmpb1; end;   45890000
   if tos<>@ba1(10) then assemble(br cmpberror);                        45895000
cmpb1:                                                                  45900000
                                                                        45905000
<<  test 2:  cnt=0  sdec=0 >>                                           45910000
<<   check cce, cnt, sa, ta >>                                          45915000
   if ba2 <> ba3,(0),0 then << not cce >>                               45920000
     begin assemble(br cmpberror); go cmpb2; end;                       45925000
   if tos<>0 then begin assemble(br cmpberror); go cmpb2; end;          45930000
   if tos<>@ba3 then begin assemble(br cmpberror); go cmpb2; end;       45935000
  if tos<>@ba2 then assemble(br cmpberror);                             45940000
cmpb2:                                                                  45945000
                                                                        45950000
<< test 3:  2 identical arrays except for element 7  cnt=10  sdec=0 >>  45955000
<<  ba1(7)="X";  ba2(7)="2"; >>                                         45960000
<<   check ccg, cnt=3, sa, ta >>                                        45965000
  move ba1:=ba2,(10);                                                   45970000
  ba1(7):="X";                                                          45975000
  if ba1 <= ba2,(10),0 then << not ccg >>                               45980000
    begin assemble(br cmpberror); go cmpb3; end;                        45985000
  if tos<>3 then begin assemble(br cmpberror); go cmpb3; end;           45990000
if tos<>@ba2(7) then begin assemble(br cmpberror); go cmpb3; end;       45995000
  if tos<>@ba1(7) then assemble(br cmpberror);                          46000000
cmpb3:                                                                  46005000
                                                                        46010000
<< test 4: 2 identical db arrays expect for element 7 cnt=-10 sdec=0 >> 46015000
<< ba1(7)="X";  ba2(7)="2" >>                                           46020000
<<   check ccl, cnt=-8, sa, ta >>                                       46025000
  move ba1:=ba2,(10);                                                   46030000
  ba1(7):="X";                                                          46035000
  if ba2(9)>=ba1(9),(-10),0 then   << not ccl >>                        46040000
    begin assemble(br cmpberror); go cmpb4; end;                        46045000
  if tos<>-8 then begin assemble(br cmpberror); go cmpb4; end;          46050000
  if tos<>@ba1(7) then begin assemble(br cmpberror); go cmpb4; end;     46055000
  if tos<>@ba2(7) then begin assemble(br cmpberror); go cmpb4; end;     46060000
cmpb4:                                                                  46065000
                                                                        46070000
<<  test 5:  identical pb and db arrays except for element 4            46075000
  ba1(4)="Z"  bac(4)="D"  cnt=5  sdec=0 >>                              46080000
<<   check ccg, cnt, sa, ta >>                                          46085000
  move ba1:=bac,(5);                                                    46090000
  ba1(4):="Z";  << change element 4 >>                                  46095000
  if ba1<=bac,(5),0 then << not ccg >>                                  46100000
    begin assemble(br cmpberror); go cmpbe; end;                        46105000
  if tos<>1 then begin assemble(br cmpberror); go cmpbe; end;           46110000
  if tos<>@bac(4) then begin assemble(br cmpberror); go cmpbe; end;     46115000
  if tos<>@ba1(4) then assemble(br cmpberror);                          46120000
cmpbe:                                                                  46125000
                                                                        46130000
       push(q);set(s); <<reset stack>>                                  46135000
       if(loopctn:=loopctn+1)= loopnumber then go out                   46140000
       else go star;                                                    46145000
                                                                        46150000
cmpberror:                                                              46155000
      no'error:=false;                                                  46160000
                                                                        46165000
out:   loopctn:=0;                                                      46170000
                                                                        46175000
                                                                        46180000
end;   << testcmpb >>                                                   46185000
                                                                        46190000
                                                                        46195000
procedure testxeq;   << test xeq instruction >>                         46200000
begin                                                                   46205000
                                                                        46210000
       move instruct'name:="XEQ   ";                                    46215000
       print'names;                                                     46220000
star: assemble(                                                         46225000
      ldi 0;                                                            46230000
      load instr1;   << ldni 1; instruction >>                          46235000
      xeq 0;  << execute instruction on top of stack >>                 46240000
      bl *+2;                                                           46245000
      br xeqerror;                   << not ccl >>                      46250000
      cmpn 1;                                                           46255000
      be *+2;                                                           46260000
      br xeqerror;                   << tos not -1 >>                   46265000
      cmpm instr1;                                                      46270000
      be *+2;                                                           46275000
      br xeqerror;                   << (s-1) not instr1 >>             46280000
      cmpn 0;                                                           46285000
      be *+2;                                                           46290000
      br xeqerror;                   << (s-2) not 0 >>                  46295000
                                                                        46300000
      load instr2;   << dadd instruction >>                             46305000
      dzro,inca;                                                        46310000
      ddup,inca;                                                        46315000
      xeq 4;                                                            46320000
      ldi 0;                                                            46325000
      ldi 3;                                                            46330000
      dcmp;                                                             46335000
      be *+2;                                                           46340000
      br xeqerror;                   << tos not 3d >>                   46345000
      cmpm instr2;                                                      46350000
      be *+2;                                                           46355000
      br xeqerror;                   << (s-2) not instr2 >>             46360000
                                                                        46365000
      load instr3;   << br *+2 instruction >>                           46370000
      xeq 0;                                                            46375000
      br xeqerror;                   << did not branch >>               46380000
      cmpm instr3;                                                      46385000
      be *+2;                                                           46390000
      br xeqerror;                   << tos not instr3 >>               46395000
                                                                        46400000
      load instr4;   << asl 3 instruction >>                            46405000
      ldni 1;                                                           46410000
      xeq 1;                                                            46415000
      cmpn 8;                                                           46420000
      be *+2;                                                           46425000
      br xeqerror;                   << result not -8 >>                46430000
      cmpm instr4;                                                      46435000
      be *+2;                                                           46440000
      br xeqerror;                   << (s-1) not instr4 >>             46445000
                                                                        46450000
      load instr4;  << xeq cover tests >>                               46455000
      adds 4;                                                           46460000
      ldni 1;                                                           46465000
      xeq 5;                                                            46470000
      cmpn 8;                                                           46475000
      be *+2;                                                           46480000
      br xeqerror;                   << tos not -8 >>                   46485000
      adds 5;                                                           46490000
      ldni 1;                                                           46495000
      xeq 10;                                                           46500000
      cmpn 8;                                                           46505000
      be next;                                                          46510000
      br xeqerror);                        << tos not -8 >>             46515000
                                                                        46520000
next:                                                                   46525000
       push(q);set(s); <<reset stack>>                                  46530000
       if(loopctn:=loopctn+1)= loopnumber then go out                   46535000
       else go star;                                                    46540000
                                                                        46545000
xeqerror:                                                               46550000
      no'error:=false;                                                  46555000
                                                                        46560000
out:   loopctn:=0;                                                      46565000
                                                                        46570000
      assemble( exit 0;   << return >>                                  46575000
                                                                        46580000
instr1:   ldni 1;                                                       46585000
instr2:   dadd;                                                         46590000
instr3:   br *+2;                                                       46595000
instr4:   asl 3);                                                       46600000
                                                                        46605000
end;   << testxeq >>                                                    46610000
                                                                        46615000
procedure npmi;   << test some instructions in non-prvl mode >>         46620000
begin                                                                   46625000
star:                                                                   46630000
      push(status);  assemble( trbc 0);  set(status);<< make non-prvl >>46635000
                                                                        46640000
<< check move:  move 1 word from label npm to db >>                     46645000
      var0:=0;                                                          46650000
      tos:=6;  assemble( lra npm);  tos:=1;                             46655000
npm:  assemble( con %20000);   << move pb 0 >>                          46660000
      if <= then assemble( br *);            << cc changed - not ccg >> 46665000
      if tos<>0 then assemble( br *);               << cnt not 0 >>     46670000
      del;  if tos<>7 then assemble( br *);      << ta in (s-2) not 7>> 46675000
      assemble(load npm);if tos<>var0 then assemble(br*);<<db+6<>npm>>  46680000
                                                                        46685000
<< check fcmp >>                                                        46690000
   assemble( ldni 53;  << 0:1 >>                                        46695000
      ldpp f0;                                                          46700000
      ldpp fn1;                                                         46705000
      fcmp;                                                             46710000
      bg *+2;                                                           46715000
      br *;                                  << not ccg >>              46720000
      cmpn 53;                                                          46725000
      be *+2;                                                           46730000
      br *);                                 << stack trouble >>        46735000
                                                                        46740000
<< check asl >>                                                         46745000
      tos:=5 & asl (2);                                                 46750000
      if tos<>20 then assemble( br *);              << tos not 20 >>    46755000
                                                                        46760000
<< check exf >>                                                         46765000
      tos:=%157777.(1:6);                                               46770000
      if <= then assemble( br *);                   << not ccg >>       46775000
      if tos<>%57 then assemble( br *);             << tos not %57 >>   46780000
       tos:= @getpriv;<<label of getpriv>>                              46785000
       assemble ( pcal 0);<<return to privilege mode >>                 46790000
       push(q);set(s); <<reset stack>>                                  46795000
       if(loopctn:=loopctn+1)= loopnumber then go out                   46800000
       else go star;                                                    46805000
                                                                        46810000
out:   loopctn:=0;                                                      46815000
                                                                        46820000
assemble(    exit 0;   << return >>                                     46825000
                                                                        46830000
f0:   con 0.0;                                                          46835000
fn1:  con -1.0);                                                        46840000
end;   << npmi >>                                                       46845000
                                                                        46850000
procedure tbxct;   << tbx instruction cover test >>                     46855000
begin                                                                   46860000
       move instruct'name:="TBX   ";                                    46865000
       print'names;                                                     46870000
star: assemble (                                                        46875000
      ldxi 1;   << var >>                                               46880000
      ldi 0;   << step >>                                               46885000
      ldi 7;   << final >>                                              46890000
      tbx t2;   << *+85 (%125) >>                                       46895000
      br skip1;                      << unexpected >>                   46900000
                                                                        46905000
t3:   incx;                                                             46910000
      tbx t4;   << *+170 (%252) >>                                      46915000
      br skip1;                      << unexpected >>                   46920000
                                                                        46925000
t5:   incx;                                                             46930000
      tbx t6;   << *+255 (%377) >>                                      46935000
      br skip1;                      << unexpected >>                   46940000
                                                                        46945000
t7:   ldxa;                                                             46950000
      cmpi 6;                                                           46955000
      be *+2;                                                           46960000
      br skip1;                      << x not 6 >>                      46965000
      br exit;  << return >>                                            46970000
                                                                        46975000
      con10; con10; con10; con10; con10; con10; con10; con 0;           46980000
                                                                        46985000
skip1:br tbxerror;                   << unexpected >>                   46990000
t2:   incx;                                                             46995000
      nop;                                                              47000000
      tbx t3;   << *-85 (%125) >>                                       47005000
      br tbxerror;                   << unexpected >>                   47010000
                                                                        47015000
      con10; con10; con10; con10; con10; con10; con10; con10;           47020000
      con 0,0,0;                                                        47025000
                                                                        47030000
      br tbxerror;                   << unexpected >>                   47035000
t4:   incx;                                                             47040000
      nop;                                                              47045000
      tbx t5;   << *-170 (%252) >>                                      47050000
      br tbxerror;                   << unexpected >>                   47055000
                                                                        47060000
      con10; con10; con10; con10; con10; con10; con10; con10;           47065000
      con 0,0,0;                                                        47070000
                                                                        47075000
      br tbxerror;                   << unexpected >>                   47080000
t6:   incx;                                                             47085000
      nop;                                                              47090000
      tbx t7);   << *-255 (%377) >>                                     47095000
tbxerror:                                                               47100000
      no'error:=false;                  << unexpected >>                47105000
exit:                                                                   47110000
                                                                        47115000
                                                                        47120000
                                                                        47125000
end;   << tbxct >>                                                      47130000
                                                                        47135000
procedure trap( param);  << user trap procedure >>                      47140000
  value param;                                                          47145000
    logical param;                                                      47150000
begin                                                                   47155000
  integer deltap=q-2;                                                   47160000
  if param <> exp'trap then                                             47165000
                        begin                                           47170000
                          no'error:=false;                              47175000
                        end;                                            47180000
  exp'trap:=0;                                                          47185000
  deltap:=deltap+1;    << return p+2 >>                                 47190000
end;                                                                    47195000
                                                                        47200000
procedure usertraps;                                                    47205000
begin                                                                   47210000
                                                                        47215000
       move instruct'name:="TRAP   ";                                   47220000
       print'names;                                                     47225000
       push( status);                                                   47230000
       assemble( tsbc 2);   << enable user traps >>                     47235000
       set( status);                                                    47240000
                                                                        47245000
    << arm user traps procedure - all user traps enter procedure trap >>47250000
       xaritrap( %37, @trap, var1, var2);                               47255000
       if <> then assemble( br traperror );                             47260000
star:                                                                   47265000
                                                                        47270000
     << test 1:  addition of 2 integers >>                              47275000
       exp'trap:=%20;                                                   47280000
       tos:=%77777+1;     << should trap-integer overflow >>            47285000
       assemble( br traperror ); << did not trap >>                     47290000
                                                                        47295000
     << test 2:  floating point overflow >>                             47300000
       exp'trap:=%10;                                                   47305000
       tos:=%60000;  tos:=0;  assemble( ddup);                          47310000
       assemble( fmpy);   << should trap-floating overflow >>           47315000
       assemble( br traperror ); << did not trap >>                     47320000
                                                                        47325000
     << test 3:  floating point underflow(exponent) >>                  47330000
       exp'trap:=4;                                                     47335000
       tos:=%20000;  tos:=0;  assemble( ddup);                          47340000
       assemble( fmpy);   << should trap-floating underflow >>          47345000
       assemble( br traperror ); << did not trap >>                     47350000
                                                                        47355000
     << test 4:  integer divide by 0 >>                                 47360000
       exp'trap:=2;                                                     47365000
       tos:=1/0;          << should trap-divide by 0 >>                 47370000
       assemble( br traperror ); << did not trap >>                     47375000
                                                                        47380000
     << test 5:  floating point divide by 0.0 >>                        47385000
       exp'trap:=1;                                                     47390000
       tos:=1.5/0.0;      << should trap-divide by 0.0 >>               47395000
       assemble( br traperror ); << did not trap >>                     47400000
                                                                        47405000
     << test 6:  floating point underflow(fractional) >>                47410000
       exp'trap:=4;                                                     47415000
       tos:=%20000;  tos:=0;   << 1*2**(-128) >>                        47420000
       tos:=%120000;  tos:=0;  << -1*2**(-128) >>                       47425000
       assemble( fmpy);   << should trap-floating underflow >>          47430000
                                                                        47435000
       push(q);set(s); <<reset stack>>                                  47440000
       if(loopctn:=loopctn+1)= loopnumber then go out                   47445000
       else go star;                                                    47450000
                                                                        47455000
traperror:                                                              47460000
       no'error:=false; << did not trap >>                              47465000
                                                                        47470000
out:   loopctn:=0;                                                      47475000
                                                                        47480000
       xaritrap( 0, 0, var1, var2);    << disarm user trap procedure >> 47485000
end;                                                                    47490000
                                                                        47495000
                                                                        47500000
                                                                        47505000
                                                                        47510000
      procedure rclksclktst;                                            47515000
      begin                                                             47520000
   <<this step tests the read and store process clock instruction >>    47525000
                                                                        47530000
       move instruct'name:="RCLK  ";                                    47535000
       print'names;                                                     47540000
star: var0:=%177777;                                                    47545000
      tos:=var0;                                                        47550000
      assemble (sclk);                                                  47555000
      assemble (rclk);<<sore and read the plck>>                        47560000
      if tos <> %177777 then assemble (br rclkerror);<<rclk or sclk     47565000
                                                   failed>>             47570000
      var0:=%125252;                                                    47575000
      tos:=var0;                                                        47580000
      assemble (sclk);                                                  47585000
      assemble (rclk); <<try again with %125252>>                       47590000
      if tos <> %125252 then assemble( br rclkerror);<<failed >>        47595000
                                                                        47600000
                                                                        47605000
      var0:=%052525;                                                    47610000
      tos:=var0;                                                        47615000
      assemble( sclk);                                                  47620000
      assemble( rclk);<<again with %052525>>                            47625000
      if tos <> %052525 then assemble ( br rclkerror);<<failed>>        47630000
                                                                        47635000
                                                                        47640000
      var0:=0;                                                          47645000
      tos:=var0;                                                        47650000
      assemble (sclk);                                                  47655000
      assemble (rclk);                                                  47660000
      if tos <> 0 then assemble ( br rclkerror);<<failed>>              47665000
                                                                        47670000
                                                                        47675000
                                                                        47680000
                                                                        47685000
       push(q);set(s); <<reset stack>>                                  47690000
       if(loopctn:=loopctn+1)= loopnumber then go out                   47695000
       else go star;                                                    47700000
                                                                        47705000
rclkerror:                                                              47710000
      no'error:=false;                                                  47715000
                                                                        47720000
out:   loopctn:=0;                                                      47725000
                                                                        47730000
       end; <<rclksclktst>>                                             47735000
                                                                        47740000
                                                                        47745000
      procedure covermabstst;                                           47750000
      begin                                                             47755000
      << this step uses the mabs instruction to test the sdec function  47760000
      of the move instructions and also to check other move             47765000
      functions >>                                                      47770000
                                                                        47775000
      define mabs1=assemble ( con %020111)#,                            47780000
             mabs2=assemble ( con %020112)#,                            47785000
             mabs3=assemble ( con %020113)#,                            47790000
             mabs4=assemble ( con %020114)#,                            47795000
             mabs5=assemble ( con %020115)#,                            47800000
             mabs6=assemble ( con %020116)#,                            47805000
             mabs7=assemble ( con %020117)#;                            47810000
                                                                        47815000
      << mabs1-mabs7 are move using absolute address instructions       47820000
         with sdecs of 1 to 7  >>                                       47825000
                                                                        47830000
       move instruct'name:="MOVE  ";                                    47835000
       print'names;                                                     47840000
      star:var0:=%10; <<count>>                                         47845000
           var1:=0;   <<source address>>                                47850000
           var2:=0;   <<source bank>>                                   47855000
           var3:=%1000; <<target address>>                              47860000
           var4:=0;   <<target bank >>                                  47865000
                                                                        47870000
      << test move using a sdec of 7 >>                                 47875000
                                                                        47880000
      tos:= -1;                                                         47885000
      tos:=-2;                                                          47890000
      tos:=-3;<<-2,-3 are extra parameters>>                            47895000
                                                                        47900000
      tos:=var4; <<target bank >>                                       47905000
      tos:=var3; <<target address>>                                     47910000
      tos:=var2; <<source bank>>                                        47915000
      tos:=var1; <<source address>>                                     47920000
      tos:=var0; <<count >>                                             47925000
      mabs7;<<move with sdec of 7>>                                     47930000
                                                                        47935000
      if tos <> -1 then assemble ( br moveerror);                       47940000
      <<sdec of 7 failed to pop stack of 7 parameters >>                47945000
                                                                        47950000
                                                                        47955000
      << test move using a sdec of 6 >>                                 47960000
                                                                        47965000
      tos:= -1;                                                         47970000
      tos:=-2;<<-2 is a extra paramter>>                                47975000
                                                                        47980000
      tos:=var4; <<target bank >>                                       47985000
      tos:=var3; <<target address>>                                     47990000
      tos:=var2; <<source bank>>                                        47995000
      tos:=var1; <<source address>>                                     48000000
      tos:=var0; <<count >>                                             48005000
      mabs6;<<move with sdec of 6>>                                     48010000
                                                                        48015000
      if tos <> -1 then assemble ( br moveerror);                       48020000
      <<sdec of 6 failed to pop stack of 6 parameters >>                48025000
                                                                        48030000
                                                                        48035000
                                                                        48040000
      << test move using a sdec of 5 >>                                 48045000
                                                                        48050000
      tos:= -1;                                                         48055000
                                                                        48060000
      tos:=var4; <<target bank >>                                       48065000
      tos:=var3; <<target address>>                                     48070000
      tos:=var2; <<source bank>>                                        48075000
      tos:=var1; <<source address>>                                     48080000
      tos:=var0; <<count >>                                             48085000
      mabs5;<<move with sdec of 5>>                                     48090000
                                                                        48095000
      if tos <> -1 then assemble ( br moveerror);                       48100000
      <<sdec of 5 failed to pop stack of 5 parameters >>                48105000
                                                                        48110000
                                                                        48115000
                                                                        48120000
      << test move using a sdec of 4 >>                                 48125000
                                                                        48130000
      tos:= -1;                                                         48135000
                                                                        48140000
      tos:=var4; <<target bank >>                                       48145000
      tos:=var3; <<target address>>                                     48150000
      tos:=var2; <<source bank>>                                        48155000
      tos:=var1; <<source address>>                                     48160000
      tos:=var0; <<count >>                                             48165000
      mabs4;<<move with sdec of 4>>                                     48170000
                                                                        48175000
      if tos <> 0 then assemble ( br moveerror);                        48180000
      << tos not target bank >>                                         48185000
      if tos <> -1 then assemble ( br moveerror);                       48190000
      << sdec of 4 failed to pop stack of 4 parameters >>               48195000
                                                                        48200000
                                                                        48205000
                                                                        48210000
      << test move using a sdec of 3 >>                                 48215000
                                                                        48220000
      tos:= -1;                                                         48225000
                                                                        48230000
      tos:=var4; <<target bank >>                                       48235000
      tos:=var3; <<target address>>                                     48240000
      tos:=var2; <<source bank>>                                        48245000
      tos:=var1; <<source address>>                                     48250000
      tos:=var0; <<count >>                                             48255000
      mabs3;<<move with sdec of 3>>                                     48260000
                                                                        48265000
      if tos <> %1010 then assemble ( br moveerror);                    48270000
      << tos not target +count >>                                       48275000
      if tos <> 0 then assemble ( br moveerror);                        48280000
      << tos not target bank >>                                         48285000
      if tos <> -1 then assemble ( br moveerror);                       48290000
      << sdec of 3 failed to pop stack of 3 parameters >>               48295000
                                                                        48300000
                                                                        48305000
      << test move using a sdec of 2 >>                                 48310000
                                                                        48315000
      tos:= -1;                                                         48320000
                                                                        48325000
      tos:=var4; <<target bank >>                                       48330000
      tos:=var3; <<target address>>                                     48335000
      tos:=var2; <<source bank>>                                        48340000
      tos:=var1; <<source address>>                                     48345000
      tos:=var0; <<count >>                                             48350000
      mabs2;<<move with sdec of 2>>                                     48355000
                                                                        48360000
                                                                        48365000
      if tos <> 0 then assemble ( br moveerror);                        48370000
      << tos not source bank >>                                         48375000
      if tos <> %1010 then assemble ( br moveerror);                    48380000
      <<tos not target + count >>                                       48385000
      if tos <> 0 then assemble ( br moveerror);                        48390000
      << tos not target bank >>                                         48395000
      if tos <> -1 then assemble ( br moveerror);                       48400000
      << sdec of 2 failed to pop stack of 2 parameters >>               48405000
                                                                        48410000
                                                                        48415000
                                                                        48420000
      << test move using a sdec of 1 >>                                 48425000
                                                                        48430000
      tos:= -1;                                                         48435000
                                                                        48440000
      tos:=var4; <<target bank >>                                       48445000
      tos:=var3; <<target address>>                                     48450000
      tos:=var2; <<source bank>>                                        48455000
      tos:=var1; <<source address>>                                     48460000
      tos:=var0; <<count >>                                             48465000
      mabs1;<<move with sdec of 1>>                                     48470000
                                                                        48475000
                                                                        48480000
      if tos <> %10 then assemble ( br moveerror);                      48485000
      << tos not source + count >>                                      48490000
      if tos <> 0 then assemble ( br moveerror);                        48495000
      << tos not source bank >>                                         48500000
      if tos <> %1010 then assemble ( br moveerror);                    48505000
      << tos not target + count>>                                       48510000
      if tos <> 0 then assemble ( br moveerror);                        48515000
      <<tos not target bank>>                                           48520000
      if tos <> -1 then assemble ( br moveerror);                       48525000
      << sdec of 1 failed to pop stack of 1 parameter>>                 48530000
                                                                        48535000
                                                                        48540000
                                                                        48545000
       << move %100 words to address %1000>>                            48550000
      var0:=%100;<<change count to %100>>                               48555000
      tos:=var4; <<target bank >>                                       48560000
      tos:=var3; <<target address>>                                     48565000
      tos:=var2; <<source bank>>                                        48570000
      tos:=var1; <<source address>>                                     48575000
      tos:=var0; <<count >>                                             48580000
      mabs5;<<move with sdec of 5>>                                     48585000
                                                                        48590000
      var6:=%1000;                                                      48595000
      var7:=%0;                                                         48600000
                                                                        48605000
      do                                                                48610000
      begin                                                             48615000
      if absolute(var6) <> absolute (var7) then assemble (br moveerror);48620000
      <<check data at addr %1000>>                                      48625000
      var6:=var6+1;                                                     48630000
      var7:=var7+1;                                                     48635000
      end                                                               48640000
      until var6=%1077;                                                 48645000
                                                                        48650000
      <<move %100 words from addr 0 to addr %1000>>                     48655000
                                                                        48660000
      tos:=0;<<target bank>>                                            48665000
      tos:=%1000;<<target address>>                                     48670000
      tos:=0;<<source bank>>                                            48675000
      tos:=%0;<<source address>>                                        48680000
      tos:=%100;<<count>>                                               48685000
      mabs5;<<move>>                                                    48690000
      << test mabs with target and source one address off >>            48695000
                                                                        48700000
                                                                        48705000
      tos:=0;<<target bank>>                                            48710000
      tos:=%1000;<<target address>>                                     48715000
      tos:=0; <<source bank>>                                           48720000
      tos:=%1001;<<source address>>                                     48725000
      tos:=%100;<<count>>                                               48730000
                                                                        48735000
      mabs5;<<move>>                                                    48740000
                                                                        48745000
      var6:=%1000;<<target>>                                            48750000
      var7:=1;<<address of correct data>>                              48755000
      do                                                                48760000
      begin                                                             48765000
      if absolute(var6) <> absolute(var7) then assemble ( br moveerror);48770000
      <<data not correct after move >>                                  48775000
      var6:=var6+1;                                                     48780000
      var7:=var7+1;                                                     48785000
      end                                                               48790000
      until var6=%1077;                                                 48795000
                                                                        48800000
      <<check mabs with target and source address the same>>            48805000
                                                                        48810000
      tos:=0;<<target bank>>                                            48815000
      tos:=%1000;<<target address>>                                     48820000
      tos:=0;<<source bank>>                                            48825000
      tos:=%0;<<source address>>                                        48830000
      tos:=%100;<<count>>                                               48835000
      mabs5;<<move>>                                                    48840000
      <<move %100 words from addr 0 to addr %1000>>                     48845000
                                                                        48850000
                                                                        48855000
      var6:=%1000;                                                      48860000
      var7:=0;                                                          48865000
                                                                        48870000
                                                                        48875000
      tos:=0;<<target bank>>                                            48880000
      tos:=%1000;<<target addrrss>>                                     48885000
      tos:=0;<<source bank>>                                            48890000
      tos:=%1000;<<source address>>                                     48895000
      tos:=%100;<<count>>                                               48900000
                                                                        48905000
      mabs5;<<move>>                                                    48910000
                                                                        48915000
      do                                                                48920000
      begin                                                             48925000
      if absolute(var6) <> absolute(var7) then assemble ( br moveerror);48930000
      << data errtoe in move >>                                         48935000
      var6:=var6+1;                                                     48940000
      var7:=var7+1;                                                     48945000
      end                                                               48950000
      until var6=%1077;                                                 48955000
                                                                        48960000
                                                                        48965000
       push(q);set(s); <<reset stack>>                                  48970000
       if(loopctn:=loopctn+1)= loopnumber then go out                   48975000
       else go star;                                                    48980000
                                                                        48985000
moveerror:                                                              48990000
      no'error:=false;                                                  48995000
                                                                        49000000
out:   loopctn:=0;x:=stepno;                                            49005000
       stepno:=stepno+1;                                                49010000
                                                                        49015000
      end; <<covermabstst>>                                             49020000
procedure testbank (bank,testaddr,region);                              49025000
value bank,testaddr,region;                                             49030000
logical bank,testaddr,region;                                           49035000
begin                                                                   49040000
  logical checkval,                                                     49045000
          saveval;                                                      49050000
                                                                        49055000
  <<send out bank number, region>>                                      49060000
                                                                        49065000
  <<test bank>>                                                         49070000
  assemble(sed 0);   <<disable: make sure no memory moves >>   <<d8652>>49075000
  tos := bank;       <<save current word at test site>>                 49080000
  tos := testaddr;                                                      49085000
  assemble(lsea);                                                       49090000
  saveval := tos;                                                       49095000
  tos := testval;    <<store and retrive testvalue>>                    49100000
  assemble (ssea);                                                      49105000
  assemble (lsea);                                                      49110000
  checkval := tos;                                                      49115000
  tos := saveval;    <<restore original word at test site>>             49120000
  assemble (ssea);                                                      49125000
  assemble(sed 1);   <<enable>>                                <<d8652>>49130000
  ddel;                                                                 49135000
                                                                        49140000
<<now check vailidity of store>>                                        49145000
  if checkval <> testval then no'error := false;                        49150000
end;                                                                    49155000
procedure testmachine;                                                  49160000
                                                                        49165000
comment: this procedure will get system information from sysglob,       49170000
         print it, and based on that information will test the          49175000
         machine;                                                       49180000
                                                                        49185000
begin                                                                   49190000
                                                                        49195000
  <<local variables>>                                                   49200000
  logical lastbank,                                                     49205000
          lastoffset,                                                   49210000
          updatelvl,                                                    49215000
          versionlvl,                                                   49220000
          olddb,                                                        49225000
          bank;                                                         49230000
  integer memsize;                                                      49235000
                                                                        49240000
  <<gather system data from sysglob>>                                   49245000
  olddb := setsysdb;                                                    49250000
  lastbank := syslastbank;                                              49255000
  lastoffset := syslastoffset;                                          49260000
  resetdb (olddb);                                                      49265000
                                                                        49270000
  <<determine and send out memory configuration>>                       49275000
  memsize := integer(lastbank) * 64 +                                   49280000
             integer ((double(lastoffset) + 1d)/1024d);                 49285000
  if not no'error then                                                  49290000
    begin                                                               49295000
      no'error := true;                                                 49300000
      print'message(lmessage,0,%202);                                   49305000
      print'message(ermsg,-23,%203);                                    49310000
    end                                                                 49315000
    else                                                                49320000
      print'message(lmessage,0,%203);                                   49325000
  move lmessage := "MEMORY BANK TEST     ";                             49330000
  move ermsg := "*** MEMORY FAILURE     ";                              49335000
  print'message(lmessage,-20,%60);                                      49340000
  location := 0;                                                        49345000
  <<now test all banks>>                                                49350000
  move instruct'name := "0     ";                                       49355000
  print'names;                                                          49360000
  testbank (0,testaddrfirst,upper);                                     49365000
  testbank (0,testaddrl,lower);                                         49370000
  bank := 1;                                                            49375000
  while bank < lastbank do                                              49380000
    begin                                                               49385000
      ascii(bank,8,data);                                               49390000
      if bank < 8 then                                                  49395000
        move instruct'name := data(5),(1)                               49400000
        else                                                            49405000
          move instruct'name := data(4),(2);                            49410000
      print'names;                                                      49415000
      testbank (bank, testaddru, upper);                                49420000
      testbank (bank, testaddrl, lower);                                49425000
      bank := bank + 1;                                                 49430000
    end;                                                                49435000
  ascii(bank,8,data);                                                   49440000
  if bank < 8 then                                                      49445000
    move instruct'name := data(5),(1)                                   49450000
    else                                                                49455000
      move instruct'name := data(4),(2);                                49460000
  print'names;                                                          49465000
  testbank (lastbank,testaddru,upper);                                  49470000
  testbank (lastbank,testaddrlast,lower);                               49475000
end;                                                                    49480000
procedure message( msg, parm1, parm2);                                  49485000
   value msg, parm1, parm2;                                             49490000
   integer msg, parm1;                                                  49495000
   double parm2;                                                        49500000
   option variable;                                                     49505000
begin                                                                   49510000
   byte array bbuf(0:71);                                               49515000
   byte array bbuf2(0:11);                                              49520000
   integer len;                                                         49525000
                                                                        49530000
   if msg = 0 then                                                      49535000
      begin                                                             49540000
      move instruct'name := "      ";                                   49545000
      ascii( parm1, 10, instruct'name);                                 49550000
      print'names;                                                      49555000
      return;                                                           49560000
      end;                                                              49565000
   if msg = 1 then                                                      49570000
      begin                                                             49575000
      move bbuf := "*** OUT OF DISC SPACE";                             49580000
      print'message(bbuf,0,%202);                                       49585000
      print'message(bbuf,-21,%60);                                      49590000
      location := 0;                                                    49595000
      return;                                                           49600000
      end;                                                              49605000
   if msg = 2 or msg = 3 then                                           49610000
      begin                                                             49615000
      move bbuf := "*** DISC FAILURE AT SECTOR %",2;                    49620000
      len := dascii( parm2, 8, bbuf2);                                  49625000
      move * := bbuf2(11-len),(len),2;                                  49630000
      len := tos-@bbuf;                                                 49635000
      print'message(bbuf,0,%202);                                       49640000
      print'message(bbuf,-len,%60);                                     49645000
      location := 0;                                                    49650000
      end;                                                              49655000
end;                                                                    49660000
integer procedure discio( ldev, func, buf, cnt, adr);                   49665000
   value ldev, func, cnt, adr;                                          49670000
   integer ldev, func, cnt;                                             49675000
   array buf;                                                           49680000
   double adr;                                                          49685000
begin                                                                   49690000
   double status;                                                       49695000
   integer                                                              49700000
      status1 = status,                                                 49705000
      status2 = status+1,                                               49710000
      adr1    = adr,                                                    49715000
      adr2    = adr+1;                                                  49720000
                                                                        49725000
   status := p'attachio(ldev,0,0,@buf,func,cnt,adr1,adr2,1);   <<p8653>>49730000
   if status1.(8:8) <> 1 then                                           49735000
      begin                                                             49740000
      message( discerr, status1, adr);                                  49745000
      discio := status1;                                                49750000
      end;                                                              49755000
end;                                                                    49760000
procedure test'disc (ldev, disc'address);                      <<dfs00>>49765000
   value ldev, disc'address;                                   <<dfs00>>49770000
   integer ldev;                                               <<dfs00>>49775000
   double disc'address;                                        <<dfs00>>49780000
begin                                                                   49785000
   equate nr'patterns = 7;                                              49790000
   array patterns(0:6) = pb :=                                          49795000
      %133333, %155555, %166666, %111111, %123456, 0, -1;               49800000
   integer pattern, cnt, err;                                           49805000
   array buf1(*) = lbuf;                                                49810000
   array buf2(*) = lbuf(128);                                           49815000
   array buf3(*) = lbuf(256);                                           49820000
   array buf4(*) = lbuf(384);                                           49825000
   double array dbuf1(*) = buf1;                                        49830000
   double array dbuf2(*) = buf2;                                        49835000
   double array dbuf3(*) = buf3;                                        49840000
   double array dbuf4(*) = buf4;                                        49845000
   byte array bbuf1(*) = buf1;                                          49850000
   byte array bbuf2(*) = buf2;                                          49855000
   byte array bbuf3(*) = buf3;                                          49860000
   byte array bbuf4(*) = buf4;                                          49865000
                                                                        49870000
   <<    address test     >>                                            49875000
                                                                        49880000
      dbuf1 := disc'address;                                   <<dfs00>>49885000
      move dbuf1(1) := dbuf1,(126);                                     49890000
      err := discio (ldev, write, dbuf1, 128, disc'address);   <<dfs00>>49895000
      if err <> 0 then return;                                          49900000
                                                                        49905000
      err := discio (ldev, read, dbuf3, 128, disc'address);    <<dfs00>>49910000
      if err <> 0 then return;                                          49915000
      if bbuf1 <> bbuf3,(256) then                                      49920000
         begin                                                          49925000
         message (comparerr,,disc'address);                    <<dfs00>>49930000
         return;                                                        49935000
         end;                                                           49940000
                                                                        49945000
   <<     data test     >>                                              49950000
                                                                        49955000
   pattern := 0;                                                        49960000
   while pattern <> nr'patterns do                                      49965000
      begin                                                             49970000
      buf1 := patterns(pattern);                                        49975000
      move buf1(1) := buf1,(127);                                       49980000
         err := discio (ldev, write, buf1, 128, disc'address); <<dfs00>>49985000
         if err <> 0 then return;                                       49990000
                                                                        49995000
         err := discio (ldev, read, buf2, 128, disc'address);  <<dfs00>>50000000
         if err <> 0 then return;                                       50005000
         if bbuf1 <> bbuf2,(256) then                                   50010000
            begin                                                       50015000
            message (comparerr,,disc'address);                 <<dfs00>>50020000
            return;                                                     50025000
            end;                                                        50030000
                                                                        50035000
      pattern := pattern+1;                                             50040000
      end;                                                              50045000
end;                                                                    50050000
double procedure get'a'beginning'sector (ldev, head,           <<dfs00>>50055000
                       sectors'per'track, tracks'per'cylinder,          50060000
                       disc'size);                                      50065000
    value ldev, head, sectors'per'track, tracks'per'cylinder,           50070000
          disc'size;                                                    50075000
    integer ldev, head, tracks'per'cylinder;                            50080000
    logical sectors'per'track;                                          50085000
    double disc'size;                                                   50090000
    option privileged;                                                  50095000
                                                                        50100000
<<===========================================================           50105000
                                                                        50110000
   this procedure tries to find a free sector on the specified          50115000
   ldev in the first half of the disc.  if one is not found,            50120000
   a message is printed.                                                50125000
                                                                        50130000
   parameters:                                                          50135000
      ldev - logical device number of the disc.                         50140000
      head - desired head number                                        50145000
      sectors'per'track - for this particular type of disc              50150000
      tracks'per'cylinder - for this particular type of disc            50155000
      disc'size - size of disc in sectors.                              50160000
                                                                        50165000
   returns:                                                             50170000
      sector address of sector, if found. if one is not                 50175000
      found, the zero.                                                  50180000
                                                                        50185000
   calls:                                                               50190000
      print                                                             50195000
      ascii                                                             50200000
      quit                                                              50205000
      get'specific'disc'space                                           50210000
      get'disc'space                                                    50215000
                                                                        50220000
   fixid:                                                               50225000
      the fix id on the procedure header applied to the                 50230000
      whole procedure.                                                  50235000
                                                                        50240000
===========================================================>>           50245000
                                                                        50250000
begin                                                                   50255000
                                                                        50260000
   double disc'address;                                                 50265000
   double disc'address'limit;                                           50270000
   double first'disc'address;                                           50275000
   integer track;                                                       50280000
   integer status;                                                      50285000
                                                                        50290000
   array l'buffer (0:39);                                               50295000
   byte array buffer (*) = l'buffer;                                    50300000
   integer len;                                                         50305000
   byte pointer bps0 = s-0;                                             50310000
                                                                        50315000
   double return'value = get'a'beginning'sector;                        50320000
                                                                        50325000
   intrinsic print, ascii, quit;                                        50330000
                                                                        50335000
   << - - - - - - - - - >>                                              50340000
                                                                        50345000
   << get address of first sector on track (head) >>                    50350000
                                                                        50355000
   disc'address := double (head) * double (sectors'per'track);          50360000
                                                                        50365000
   << get sector address of middle of disc, we don't want to            50370000
      try a sector after this.                               >>         50375000
                                                                        50380000
   disc'address'limit := disc'size / 2d;                                50385000
                                                                        50390000
   << get a sector and return it, this should be the first free         50395000
      sector on the disc.  we will then move disc address up until      50400000
      it is greater that this address, this will save a lot of          50405000
      search time.                                              >>      50410000
                                                                        50415000
   status := get'disc'space (ldev, 1d, first'disc'address);             50420000
   if status <> 0 then goto no'space;                                   50425000
   return'disc'space (ldev, first'disc'address, 1d);                    50430000
                                                                        50435000
   while disc'address <= disc'address'limit and                         50440000
         disc'address < first'disc'address do                           50445000
      disc'address := disc'address + (double (sectors'per'track) *      50450000
                      double (tracks'per'cylinder));                    50455000
                                                                        50460000
   << pre-set get'specific'disc'space status to not found >>            50465000
                                                                        50470000
   status := 1;                                                         50475000
                                                                        50480000
   << search for a sector on this head >>                               50485000
                                                                        50490000
   while disc'address <= disc'address'limit                             50495000
                     and                                                50500000
              status <> 0                                               50505000
   do                                                                   50510000
      begin  << look for a sector >>                                    50515000
                                                                        50520000
         status := get'specific'disc'space (ldev, disc'address, 1d);    50525000
                                                                        50530000
         case status of                                                 50535000
            begin                                                       50540000
                                                                        50545000
          <<0>> begin  << got the sector >>                             50550000
                                                                        50555000
                   return'value := disc'address;                        50560000
                                                                        50565000
                end;   << got the sector >>                             50570000
                                                                        50575000
          <<1>> begin  << not available >>                              50580000
                                                                        50585000
                   << try the next sector on the track (head) >>        50590000
                                                                        50595000
                   disc'address := disc'address + 1d;                   50600000
                                                                        50605000
                   << see if we have gone past the end of the           50610000
                      track, if so, go to the next cylinder   >>        50615000
                                                                        50620000
                   track := disc'address // sectors'per'track;          50625000
                   if head <> (track mod tracks'per'cylinder) then      50630000
                      disc'address := disc'address +                    50635000
                                   (double (sectors'per'track) *        50640000
                                     double (tracks'per'cylinder - 1)); 50645000
                                                                        50650000
                end;   << not available >>                              50655000
                                                                        50660000
          <<2>> begin  << i/o error >>                                  50665000
                                                                        50670000
                   move buffer := "Get'Specific'Disc'Space error #2",2; 50675000
                   len := -(tos - @buffer);                             50680000
                   print (l'buffer, len, 0);                            50685000
                   quit (1);                                            50690000
                                                                        50695000
                end;   << i/o error >>                                  50700000
                                                                        50705000
          <<3>> begin  << allocation disabled >>                        50710000
                                                                        50715000
                   move buffer := "Get'Specific'Disc'Space error #3",2; 50720000
                   len := -(tos - @buffer);                             50725000
                   print (l'buffer, len, 0);                            50730000
                   quit (1);                                            50735000
                                                                        50740000
                end;   << allocation disabled >>                        50745000
                                                                        50750000
            end;  << case status of >>                                  50755000
                                                                        50760000
      end;   << look for a sector >>                                    50765000
                                                                        50770000
                                                                        50775000
   if status <> 0 then                                                  50780000
      begin  << did not find a free sector >>                           50785000
                                                                        50790000
         no'space:                                                      50795000
                                                                        50800000
          print (l'buffer, 0, 0);                              <<03725>>50805000
         move buffer := "Did not find a free disc sector on ", 2;       50810000
         move * := "the first half of ldev ", 2;                        50815000
         tos := tos + ascii (ldev, 10, bps0);                           50820000
         move * := " to test head ",2;                                  50825000
         tos := tos + ascii (head, 10, bps0);                           50830000
         move * := "!", 2;                                              50835000
         len := -(tos - @buffer);                                       50840000
         print (l'buffer, len, 0);                                      50845000
                                                                        50850000
         return'value := 0d;  << indicate that we did not find one >>   50855000
                                                                        50860000
      end;   << did not find a free sector >>                           50865000
                                                                        50870000
end;  << get'a'beginning'sector >>                                      50875000
double procedure get'an'ending'sector (ldev, head,             <<dfs00>>50880000
                       sectors'per'track, tracks'per'cylinder,          50885000
                       disc'size);                                      50890000
    value ldev, head, sectors'per'track, tracks'per'cylinder,           50895000
          disc'size;                                                    50900000
    integer ldev, head, tracks'per'cylinder;                            50905000
    logical sectors'per'track;                                          50910000
    double disc'size;                                                   50915000
    option privileged;                                                  50920000
                                                                        50925000
<<===========================================================           50930000
                                                                        50935000
   this procedure tries to find a free sector on the specified          50940000
   ldev in the second half of the disc.  if one is not found,           50945000
   a message is printed.                                                50950000
                                                                        50955000
   parameters:                                                          50960000
      ldev - logical device number of the disc.                         50965000
      head - desired head number                                        50970000
      sectors'per'track - for this particular type of disc              50975000
      tracks'per'cylinder - for this particular disc                    50980000
      disc'size - size of disc in sectors.                              50985000
                                                                        50990000
   returns:                                                             50995000
      sector address of sector, if found. if one is not                 51000000
      found, the zero.                                                  51005000
                                                                        51010000
   calls:                                                               51015000
      print                                                             51020000
      ascii                                                             51025000
      quit                                                              51030000
      get'specific'disc'space                                           51035000
                                                                        51040000
   fixid:                                                               51045000
      the fix id on the procedure header applies to the                 51050000
      entire procedure.                                                 51055000
                                                                        51060000
===========================================================>>           51065000
begin                                                                   51070000
                                                                        51075000
   double disc'address;                                                 51080000
   double disc'address'limit;                                           51085000
   integer track;                                                       51090000
   integer last'cylinder;                                               51095000
   integer status;                                                      51100000
                                                                        51105000
   array l'buffer (0:39);                                               51110000
   byte array buffer (*) = l'buffer;                                    51115000
   integer len;                                                         51120000
   byte pointer bps0 = s-0;                                             51125000
                                                                        51130000
   double return'value = get'an'ending'sector;                          51135000
                                                                        51140000
   intrinsic print, ascii, quit;                                        51145000
                                                                        51150000
   << - - - - - - - - - >>                                              51155000
                                                                        51160000
   << get address of last sector on track (head) >>                     51165000
                                                                        51170000
   tos := disc'size / double (sectors'per'track);                       51175000
   last'cylinder := integer (tos / double (tracks'per'cylinder)) - 1;   51180000
   disc'address := (double (last'cylinder) *                            51185000
                   double (tracks'per'cylinder) *                       51190000
                   double (sectors'per'track)) +                        51195000
                   double (head * integer(sectors'per'track));          51200000
   if disc'address > disc'size then quit (2001);                        51205000
                                                                        51210000
   << get sector address of middle of disc, we don't want to            51215000
      try a sector before this.                               >>        51220000
                                                                        51225000
   disc'address'limit := disc'size / 2d;                                51230000
                                                                        51235000
   << pre-set get'specific'disc'space status to not found >>            51240000
                                                                        51245000
   status := 1;                                                         51250000
                                                                        51255000
   << search for a sector on this head >>                               51260000
                                                                        51265000
   while disc'address >= disc'address'limit                             51270000
                     and                                                51275000
              status <> 0                                               51280000
   do                                                                   51285000
      begin  << look for a sector >>                                    51290000
                                                                        51295000
         status := get'specific'disc'space (ldev, disc'address, 1d);    51300000
                                                                        51305000
         case status of                                                 51310000
            begin                                                       51315000
                                                                        51320000
          <<0>> begin  << got the sector >>                             51325000
                                                                        51330000
                   return'value := disc'address;                        51335000
                                                                        51340000
                end;   << got the sector >>                             51345000
                                                                        51350000
          <<1>> begin  << not available >>                              51355000
                                                                        51360000
                   << try the previous sector on the track (head) >>    51365000
                                                                        51370000
                   disc'address := disc'address - 1d;                   51375000
                                                                        51380000
                   << see if we have gone past the beginning of the     51385000
                      track, if so, go to the next cylinder        >>   51390000
                                                                        51395000
                   track := disc'address // sectors'per'track;          51400000
                   if head <> (track mod tracks'per'cylinder) then      51405000
                      disc'address := disc'address -                    51410000
                                   (double (sectors'per'track) *        51415000
                                    double (tracks'per'cylinder - 1));  51420000
                                                                        51425000
                end;   << not available >>                              51430000
                                                                        51435000
          <<2>> begin  << i/o error >>                                  51440000
                                                                        51445000
                   move buffer := "Get'Specific'Disc'Space error #2",2; 51450000
                   len := -(tos - @buffer);                             51455000
                   print (l'buffer, len, 0);                            51460000
                   quit (1);                                            51465000
                                                                        51470000
                end;   << i/o error >>                                  51475000
                                                                        51480000
          <<3>> begin  << allocation disabled >>                        51485000
                                                                        51490000
                   move buffer := "Get'Specific'Disc'Space error #3",2; 51495000
                   len := -(tos - @buffer);                             51500000
                   print (l'buffer, len, 0);                            51505000
                   quit (1);                                            51510000
                                                                        51515000
                end;   << allocation disabled >>                        51520000
                                                                        51525000
            end;  << case status of >>                                  51530000
                                                                        51535000
      end;   << look for a sector >>                                    51540000
                                                                        51545000
                                                                        51550000
   if status <> 0 then                                                  51555000
      begin  << did not find a free sector >>                           51560000
                                                                        51565000
          print (l'buffer, 0, 0);                              <<03725>>51570000
         move buffer := "Did not find a free disc sector on ", 2;       51575000
         move * := "the last half of ldev ", 2;                         51580000
         tos := tos + ascii (ldev, 10, bps0);                           51585000
         move * := " to test head ",2;                                  51590000
         tos := tos + ascii (head, 10, bps0);                           51595000
         move * := "!", 2;                                              51600000
         len := -(tos - @buffer);                                       51605000
         print (l'buffer, len, 0);                                      51610000
                                                                        51615000
         return'value := 0d;  << indicate that we did not find one >>   51620000
                                                                        51625000
      end;   << did not find a free sector >>                           51630000
                                                                        51635000
end;  << get'an'ending'sector >>                                        51640000
procedure check'disc (ldev);                                   <<dfs00>>51645000
   value ldev;                                                          51650000
   integer ldev;                                                        51655000
   option privileged;                                                   51660000
                                                                        51665000
<<===========================================================           51670000
                                                                        51675000
   this procedure allocates a sector at the beginning and               51680000
   end of the disc ldev, calles test'disc to test the sector            51685000
   and then returns the sector to the free space pool. if unable        51690000
   to get a sector for a head, the procedures that find the             51695000
   sectors will print a message.                                        51700000
                                                                        51705000
   parameters:                                                          51710000
      ldev - logical device number of the disc.                         51715000
                                                                        51720000
   calls:                                                               51725000
      get'disc'info                                                     51730000
      ascii                                                             51735000
      print                                                             51740000
      quit                                                              51745000
      get'a'beginning'sector                                            51750000
      get'an'ending'sector                                              51755000
      test'disc                                                         51760000
      return'disc'space                                                 51765000
                                                                        51770000
===========================================================>>           51775000
                                                                        51780000
begin                                                                   51785000
                                                                        51790000
   double disc'size;                                                    51795000
   integer sectors'per'track;                                           51800000
   integer tracks'per'cylinder;                                         51805000
   integer head;                                                        51810000
   double sector'address;                                               51815000
   logical stat;                                                        51820000
                                                                        51825000
   array l'buffer (0:49);                                               51830000
   byte array buffer (*) = l'buffer;                                    51835000
   integer len;                                                         51840000
   byte pointer bps0 = s-0;                                             51845000
                                                                        51850000
   intrinsic print, ascii, quit;                                        51855000
                                                                        51860000
                                                                        51865000
   << - - - - - - - - - - >>                                            51870000
                                                                        51875000
   << get the sectors per track and tracks per cylinder (which is       51880000
      the number of heads.                                       >>     51885000
                                                                        51890000
   stat := get'disc'info (ldev,  ,  ,  ,  ,  , disc'size,  ,  ,  ,  ,   51895000
                          ,  ,  , sectors'per'track,  ,  ,              51900000
                          tracks'per'cylinder);                         51905000
                                                                        51910000
   if not stat then                                                     51915000
      begin  << get'disc'info error >>                                  51920000
                                                                        51925000
         move buffer := "Get'Disc'Info error %", 2;                     51930000
         ascii (stat, 8, bps0);                                         51935000
         tos := tos + 6;                                                51940000
         move * := ", ldev = ", 2;                                      51945000
         tos := tos + ascii (ldev, 10, bps0);                           51950000
         len := -(tos - @buffer);                                       51955000
         print (l'buffer, len, 0);                                      51960000
         quit (1);                                                      51965000
                                                                        51970000
      end;   << get'disc'info error >>                                  51975000
                                                                        51980000
                                                                        51985000
   << test each head with a sector near the beginning and the           51990000
      end of the disc.                                        >>        51995000
                                                                        52000000
   head := 0;                                                           52005000
                                                                        52010000
   while head < tracks'per'cylinder do                                  52015000
      begin  << test each head >>                                       52020000
                                                                        52025000
         << check a sector on this head near the beginning of the       52030000
            disc.                                                >>     52035000
                                                                        52040000
         sector'address := get'a'beginning'sector (ldev, head,          52045000
                           sectors'per'track, tracks'per'cylinder,      52050000
                           disc'size);                                  52055000
                                                                        52060000
         if sector'address <> 0d then                                   52065000
            begin  << got a sector in the first half >>                 52070000
                                                                        52075000
               test'disc (ldev, sector'address);                        52080000
                                                                        52085000
               return'disc'space (ldev, sector'address, 1d);            52090000
                                                                        52095000
            end;   << got a sector in the first half >>                 52100000
                                                                        52105000
                                                                        52110000
         << check a sector on this head near the end of the             52115000
            disc.                                                >>     52120000
                                                                        52125000
         sector'address := get'an'ending'sector (ldev, head,            52130000
                           sectors'per'track, tracks'per'cylinder,      52135000
                           disc'size);                                  52140000
                                                                        52145000
         if sector'address <> 0d then                                   52150000
            begin  << got a sector in the second half >>                52155000
                                                                        52160000
               test'disc (ldev, sector'address);                        52165000
                                                                        52170000
               return'disc'space (ldev, sector'address, 1d);            52175000
                                                                        52180000
            end;   << got a sector in the second half >>                52185000
                                                                        52190000
         head := head + 1;                                              52195000
                                                                        52200000
      end;   << test each head >>                                       52205000
                                                                        52210000
end;  << check'disc >>                                                  52215000
procedure get'disc'ldevs;                                               52220000
begin                                                                   52225000
   integer array vtab(*) = lbuf;                                        52230000
   integer                                                              52235000
      i,                                                                52240000
      vtabsize;                                                         52245000
   integer pointer pntr;                                                52250000
   define                                                               52255000
      type      =    (13:3)#,                                           52260000
      ldev      =    (0:8) #;                                           52265000
                                                                        52270000
   movefromdseg; << ** subroutine mfds ** >>                            52275000
                                                                        52280000
   i := getsir( vtabsir);                                               52285000
   mfds( vtab, vtabdst, 0, 1);                                          52290000
   vtabsize := (vtab.nrents+1)*vtab.entsize;                            52295000
   mfds( vtab, vtabdst, 0, vtabsize);                                   52300000
   relsir( vtabsir, i);                                                 52305000
                                                                        52310000
   @pntr := @vtab(vtab.entsize);                                        52315000
   while @pntr < @vtab(vtabsize) do                                     52320000
      begin                                                             52325000
      if pntr <> 0 then                                                 52330000
         begin   << entry in use >>                                     52335000
         if pntr(12).type = 0 then                                      52340000
            begin  << system volume >>                                  52345000
            disc'ldevs(nr'sys'discs) := pntr(12).ldev;                  52350000
            nr'sys'discs := nr'sys'discs+1;                             52355000
            end;                                                        52360000
         end;                                                           52365000
      @pntr := @pntr(vtab.entsize);                                     52370000
      end;                                                              52375000
end;                                                                    52380000
                                                                        52385000
procedure testsysdiscs;                                                 52390000
begin                                                                   52395000
   integer                                                              52400000
      ldev,                                                             52405000
      cnt,                                                              52410000
      err,                                                              52415000
      sect'trk,                                                         52420000
      nr'heads,                                                         52425000
      sirrtn,                                                           52430000
      i,                                                                52435000
      j;                                                                52440000
                                                                        52445000
   cnt := 0;                                                            52450000
   while cnt <> nr'sys'discs do                                         52455000
      begin                                                             52460000
      ldev := disc'ldevs(cnt);                                          52465000
      message( 0, ldev);                                                52470000
                                                                        52475000
      check'disc (ldev);                                       <<dfs00>>52480000
next'disc:                                                              52485000
      cnt := cnt+1;                                                     52490000
      end;                                                              52495000
end;                                                                    52500000
                                                                        52505000
<< section entry point >>                                               52510000
      fnum := fopen(outputfile,5,1);                                    52515000
      if <> then                                                        52520000
        begin                                                           52525000
          fcheck(fnum,errornum);                                        52530000
          if errornum = 52 then                                         52535000
            begin                                                       52540000
              fnum := fopen(outputfile,4,4,40,,,,3,,1000d);             52545000
              if <> then                                                52550000
                begin                                                   52555000
                  printfileinfo(fnum);                                  52560000
                  terminate;                                            52565000
                end;                                                    52570000
            end                                                         52575000
            else                                                        52580000
              begin                                                     52585000
                printfileinfo(fnum);                                    52590000
                terminate;                                              52595000
              end;                                                      52600000
        end;                                                            52605000
      move header(vuuff'col) := official'vuuff;                <<04287>>52610000
      print'message(header,header'size,%60);                   <<04287>>52615000
      date'line(bmessage);                                              52620000
                                                               <<03727>>52625000
      assemble(  << test system compatability vs. program >>   <<03727>>52630000
      pcn;                                                     <<g8659>>52635000
      cmpi 5; << series 37 ? >>                                <<g8659>>52640000
      be start;                                                <<g8659>>52645000
      pcn;       << * * * * * * * * * * * * * * * * * * * >>   <<03727>>52650000
      cmpi 3;    <<  series 40/44 >>                           <<03727>>52655000
      be start;                                                <<03727>>52660000
      pcn;                                                     <<03727>>52665000
      cmpi 4;    <<  series 64 >>                              <<03727>>52670000
      be start);                                               <<03727>>52675000
go not'gus;                                                    <<03727>>52680000
start:                                                                  52685000
                                                                        52690000
      print'message(lmessage,-28,%60);                                  52695000
       stepno:=stepno+1;                                                52700000
                                                                        52705000
       push( status );                                                  52710000
       tos.(2:1) := 0;       << turn traps off >>                       52715000
       set( status );                                                   52720000
                                                                        52725000
                                                                        52730000
   << createdst;>><<set up the data segment table>>                     52735000
                                                                        52740000
                                                                        52745000
<<        start of section 1  tests                    >>               52750000
                                                                        52755000
      stackop;          << stackop instruction tests >>                 52760000
      soi;              << more stackop instruction tests >>            52765000
      liam;             << load - all addressing modes >>               52770000
      mrtests;          << more memory reference tests >>               52775000
      biam;             << br instruction - all addressing modes >>     52780000
      testldbstb;       << test ldb & stb instructions >>               52785000
      testlddstd;       << test ldd & std instructions >>               52790000
      ibt;              << indirect branch tests >>                     52795000
      ctldi;            << cover tests: ldi & ldni >>                   52800000
      ctldpp;           << cover tests:  ldpp & ldpn >>                 52805000
      ctls;             << cover tests:  load & stor instructions >>    52810000
      ctbcc;            << cover test:  bcc instruction >>              52815000
      ctdabz;           << cover test:  dabz instruction >>             52820000
      testcprb;         << test cprb instruction >>                     52825000
      testnop;          << test nop instruction >>                      52830000
                                                                        52835000
<<            start of section 2  tests                >>               52840000
                                                                        52845000
                                                                        52850000
      grpx;       << test group x: field instructions >>                52855000
      grpw;       << test group w: bit test instructions >>             52860000
      grpi;       << test group i: double integer instructions >>       52865000
      grpf;       << test group f: loop control branch instructions >>  52870000
      grpt;       << test group t: single word shift instructions >>    52875000
      grpu;       << test group u: double word shift instructions >>    52880000
      grpv;       << test group v: triple word shift instructions >>    52885000
      dmulddivtst;<< double word multipy and divide >>                  52890000
      qaslqasrtst;<<four word shift tests>>                             52895000
      grpj;       << test group j: floating point instructions >>       52900000
      testmove;   << test move instruction >>                           52905000
      testmvb;    << test mvb instruction >>                            52910000
      testmvbw;   << test mvbw instruction >>                           52915000
      testscw;    << test scw instruction >>                            52920000
      testscu;    << test scu instruction >>                            52925000
      testcmpb;   << test cmpb instruction >>                           52930000
<<    grpff; >>   << test group ff: list search instruction >>          52935000
<<    grpgg;  >>  << test group gg: load label instructions >>          52940000
<<    grphh; >>   << test group hh: privileged move instuuctions >>     52945000
      testxeq;    << test xeq instruction >>                            52950000
      npmi;       << some instructions in non-prvl mode >>              52955000
l1:   tbxct;      << cover test:   tbx instruction >>                   52960000
                                                                        52965000
                                                                        52970000
                                                                        52975000
      testmachine;<< test memory in each bank >>                        52980000
      << test system discs >>                                           52985000
      location := 0;                                                    52990000
      no'error := true;                                                 52995000
      move lmessage := "SYSTEM DOMAIN DISC TEST ";                      53000000
      print'message(lmessage,0,%203); << reset cl >>                    53005000
      print'message(lmessage,-23,%60);                                  53010000
      get'disc'ldevs;                                                   53015000
      testsysdiscs;                                                     53020000
                                                                        53025000
      fclose(fnum,1,0);                                                 53030000
      if <> then printfileinfo(fnum);                                   53035000
      go prog'exit;                                            <<03727>>53040000
                                                                        53045000
                                                                        53050000
      << error --- system incompatibility with program >>      <<03727>>53055000
      << * * * * * * * * * * * * * * * * * * * * * * * >>      <<03727>>53060000
not'gus:                                                       <<03727>>53065000
      move header := 27("  ");                                 <<03727>>53070000
      move header :=                                           <<03727>>53075000
"THIS PROGRAM EXECUTES ONLY ON HEWLETT-PACKARD ";              <<03727>>53080000
      print'message(header,23,%60);                            <<03727>>53085000
      move header :=                                           <<03727>>53090000
"COMPUTER SYSTEMS SERIES 37, 40, 44 AND SERIES 64.";        <<grpwj>>   53095000
      print'message(header,26,%70);                            <<g8659>>53100000
                                                                        53105000
                                                                        53110000
prog'exit:                                                     <<03727>>53115000
end.   << section 2 >>                                                  53120000
