$CONTROL MAP,CODE,SUBPROGRAM,SEGMENT=MAINSEG1                           00040000
begin                                                                   00060000
                                                                        00080000
   byte pointer bps0 = s-0;                                             00100000
   define abs = absolute#;                                              00120000
   equate chanpgm = %1410;                                              00140000
   equate chanstat = 3;                                                 00160000
                                                                        00180000
   procedure printline;                                                 00200000
      option external;                                                  00220000
                                                                        00240000
   integer procedure rioc( drt, data);                                  00260000
      value drt, data;                                                  00280000
      integer drt, data;                                                00300000
      option external;                                                  00320000
                                                                        00340000
   procedure wioc( drt, command, data);                                 00360000
      value drt, command, data;                                         00380000
      integer drt, command, data;                                       00400000
      option external;                                                  00420000
                                                                        00440000
   logical procedure testbit( bits, bitnr);                             00460000
      value bitnr;                                                      00480000
      array bits;                                                       00500000
      integer bitnr;                                                    00520000
      option external;                                                  00540000
                                                                        00560000
   integer procedure rclk;                                              00580000
      option external;                                                  00600000
                                                                        00620000
   procedure setbit( bits, bitnr);                                      00640000
      value bitnr;                                                      00660000
      array bits;                                                       00680000
      integer bitnr;                                                    00700000
      option external;                                                  00720000
                                                                        00740000
   procedure zerobuf( buf, count);                                      00760000
      value count;                                                      00780000
      array buf;                                                        00800000
      integer count;                                                    00820000
      option  external;                                                 00840000
                                                                        00860000
   integer procedure getdrt( drt, word);                                00880000
      value drt, word;                                                  00900000
      integer drt, word;                                                00920000
      option external;                                                  00940000
                                                                        00960000
   procedure init( drt);                                                00980000
      value drt;                                                        01000000
      integer drt;                                                      01020000
      option external;                                                  01040000
                                                                        01060000
   procedure siop( drt, abs'adr);                                       01080000
      value drt, abs'adr;                                               01100000
      integer drt, abs'adr;                                             01120000
      option external;                                                  01140000
                                                                        01160000
   procedure mabs( tbank, tadr, sbank, sadr, count);                    01180000
      value tbank, tadr, sbank, sadr, count;                            01200000
      integer tbank, tadr, sbank, sadr, count;                          01220000
      option external;                                                  01240000
                                                                        01260000
   procedure initdrt( drt);                                             01280000
      value drt;                                                        01300000
      integer drt;                                                      01320000
      option external;                                                  01340000
                                                                        01360000
   integer procedure identify( drt);                                    01380000
      value drt;                                                        01400000
      integer drt;                                                      01420000
      option external;                                                  01440000
                                                                        01460000
   integer procedure lntoa( num, base, str);                            01480000
      value num, base;                                                  01500000
      integer num, base;                                                01520000
      byte array str;                                                   01540000
      option external;                                                  01560000
                                                                        01580000
   procedure ntoa( num, base, str);                                     01600000
      value num, base;                                                  01620000
      integer num, base;                                                01640000
      byte array str;                                                   01660000
      option external;                                                  01680000
                                                                        01700000
procedure mh7905(ldev,drt,unit,stype,func,record,buf,wc);               01720000
   value ldev,drt,unit,stype,func,record,buf,wc;                        01740000
   integer ldev,drt,unit,stype,func,wc;                                 01760000
   double record,buf;                                                   01780000
   option external;                                                     01800000
                                                                        01820000
procedure cs80'driver(ldev,drt,unit,stype,func,record,buf,wc);          01840000
   value ldev,drt,unit,stype,func,record,buf,wc;                        01860000
   integer ldev,drt,unit,stype,func,wc;                                 01880000
   double record,buf;                                                   01900000
   option external;                                                     01920000
                                                                        01940000
integer procedure mtape(fcode,buff,words);                              01960000
   value fcode,words;                                                   01980000
   integer fcode,words;                                                 02000000
   array buff;                                                          02020000
   option external;                                                     02040000
                                                                        02060000
integer procedure thiscpu;                                              02080000
   option external;                                                     02100000
                                                                        02120000
procedure delay( time);                                                 02140000
   value time;                                                          02160000
   double time;                                                         02180000
   option external;                                                     02200000
                                                                        02220000
                                                                        02240000
                                                                        02260000
                                                                        02280000
                                                                        02300000
                                                                        02320000
                                                                        02340000
                                                                        02360000
procedure iomap;                                                        02380000
begin                                                                   02400000
   integer array idcodes(*) = pb :=                                     02420000
      <<id code  special handling code>>                                02440000
      %(16)2,     1, << 7906/7920/7925 disc controller       >>         02460000
      %(16)f,     0, << advanced terminal processor (atp)    >>         02480000
      %(16)10,    0, << adcc --- fake id code ---            >>         02500000
      %(16)11,    0, << tic  --- fake id code ---            >>         02520000
      %(16)80,    0, << flexible disc unit (single sided)    >>         02540000
      %(16)81,    0, << flexible disc unit (double-sided)    >>         02560000
      %(16)101,   0, << 2893 card reader                     >>         02580000
      %(16)174,   0, << 7974 mag tape (antelope)             >>         02600000
      %(16)176,   0, << 7976 mag tape controller             >>         02620000
      %(16)178,   0, << 7978 mag tape (buckhorn)             >>         02640000
      %(16)183,   2, << 7970e mag tape controller            >>         02660000
      %(16)204,   3, << 7911 disc drive                      >>         02680000
      %(16)205,   3, << 7911 disc with cartridge tape        >>         02700000
      %(16)208,   3, << 7912 disc drive                      >>         02720000
      %(16)209,   3, << 7912 disc with cartridge tape        >>         02740000
      %(16)20a,   3, << 7914 disc drive                      >>         02760000
      %(16)210,   3, << 7931 disc drive                      >>         02780000
      %(16)212,   3, << 7933/35 disc drive                   >>         02800000
      %(16)220,   3, << 7941/45 disc drive                   >><<*8665>>02820000
      %(16)240,   0, << 9140 cartridge tape drive (linus)    >><<b9019>>02840000
      %(16)260,   3, << 9144 cartridge tape drive (buffalo)  >><<b9019>>02860000
      %(16)2000,  0, << 9871 character printer               >>         02880000
      %(16)2001,  0, << 2608 dot matrix printer              >>         02900000
      %(16)2002,  0, << 2631a serial printer                 >>         02920000
      %(16)2004,  0, << 2680/2688 page printer               >><<b9019>>02940000
      %(16)200a,  0, << 2613/2617/2619a line printer         >>         02960000
      %(16)2101,  0, << 2608s/2563/2566/2569 dot mat printer>> <<*8665>>02980000
      %(16)4002,  0, << 30020a intelligent network processor >>         03000000
      %(16)4003,  0, << 30020b intelligent network processor >>         03020000
      %(16)6000,  0, << 31262 gic acting as a device         >>         03040000
      %(16)ff01,  0, << 7905 disc drive  -  fake id          >>         03060000
      %(16)ff02,  0, << 7906 disc drive  -  fake id          >>         03080000
      %(16)ff03,  0, << 7920 disc drive  -  fake id          >>         03100000
      %(16)ff04,  0, << 7925 disc drive  -  fake id          >>         03120000
      %(16)ffff,  0; << terminator >>                                   03140000
   integer array chanproc(0:15) = pb :=                                 03160000
      << chan id >>   << chan type >>                                   03180000
           <<  0 >>         3,     << gic   >>                          03200000
           <<  1 >>         0,     << adcc  >>                          03220000
           <<  2 >>         3,     << pic   >>                          03240000
           <<  3 >>         5,     << unkwn >>                          03260000
           <<  4 >>         2,     << tic   >>                          03280000
           <<5-14>>     10(5),     << unkwn >>                          03300000
           << %17>>         1;     << atp   >>                          03320000
   integer                                                              03340000
      channr,                                                           03360000
      nrimb,                                                            03380000
      imb,                                                              03400000
      chan,                                                             03420000
      drt,                                                              03440000
      dev,                                                              03460000
      unit,                                                             03480000
      type,                                                             03500000
      aib,                                                              03520000
      aibmask,                                                          03540000
      data,                                                             03560000
      boards,                                                           03580000
      id,                                                               03600000
      chanid,                                                           03620000
      i,                                                                03640000
      j,                                                                03660000
      k,                                                                03680000
      x=x;                                                              03700000
   integer                                                              03720000
      oldimb,                                                           03740000
      oldchan,                                                          03760000
      olddev,                                                           03780000
      oldunit;                                                          03800000
   integer array                                                        03820000
      buf(0:127);                                                       03840000
   byte array                                                           03860000
      bbuf(*) = buf;                                                    03880000
   byte pointer bp;                                                     03900000
   double                                                               03920000
      status,                                                           03940000
      memadr;                                                           03960000
   integer                                                              03980000
      bank   = memadr,                                                  04000000
      adr    = memadr+1;                                                04020000
   integer                                                              04040000
      status1    = status,                                              04060000
      status2    = status+1;                                            04080000
   define multi'imb'sys = (thiscpu = 5 or thiscpu = 6)#;                04100000
   << disc driver commands >>                                           04120000
   equate                                                               04140000
      read    = 0,                                                      04160000
      write   = 1,                                                      04180000
      rstat   = 5,                                                      04200000
      nfread  = 6; << non-fatal read >>                                 04220000
   equate                                                               04240000
      highestnextid = 999*3;                                            04260000
   integer                                                              04280000
      nextid := -1;                                                     04300000
   external array                                                       04320000
      idinfo(@);                                                        04340000
   external integer array                                               04360000
      line(@);                                                          04380000
   byte pointer                                                         04400000
      bline;                                                            04420000
   << define output buffer >>                                           04440000
   define                                                               04460000
      strimb        = bline(2)#,                                        04480000
      strchan       = bline(7)#,                                        04500000
      strdev        = bline(11)#,                                       04520000
      strdrt        = bline(16)#,                                       04540000
      strunit       = bline(21)#,                                       04560000
      strdescp      = bline(24)#,                                       04580000
      strlabel      = bline(60)#;                                       04600000
   << define i/o cms >>                                                 04620000
   equate                                                               04640000
      reg1    =    %400,                                                04660000
      reg9    =   %4400,                                                04680000
      rega    =   %5000,                                                04700000
      rege    =   %7000,                                                04720000
      rocl    = %120000;                                                04740000
   << id's that require special handleing >>                            04760000
   equate                                                               04780000
      c13037    =        2,                                             04800000
      c7970     = %(16)183,                                             04820000
      catp      =   %(16)f;                                             04840000
   integer array                                                        04860000
      imbs(0:3);                                                        04880000
                                                                        04900000
subroutine search( id, buff);                                           04920000
   value id;                                                            04940000
   integer id;                                                          04960000
   byte array buff;                                                     04980000
begin                                                                   05000000
                                                                        05020000
   << search id list >>                                                 05040000
   j := 0;                                                              05060000
   while idcodes(j) <> -1 and idcodes(j) <> id do j := j+2;             05080000
                                                                        05100000
   if idcodes(j) = -1 then                                              05120000
      begin                                                             05140000
      move buff := "UNKNOWN DEVICE, ID=",2;                             05160000
      @bp := tos;                                                       05180000
      lntoa( id, 8, bp);                                                05200000
      end                                                               05220000
   else                                                                 05240000
      case j/2 of                                                       05260000
         begin                                                          05280000
         move buff := "7905/06/20/25";                                  05300000
         move buff := "Advanced Terminal Processor (ATP)";              05320000
         move buff := "ADCC Terminal Controller";                       05340000
         move buff := "TIC Terminal Controller";                        05360000
         move buff := "Flexible disc unit (Single sided)";              05380000
         move buff := "Flexible Disc Unit (Double-sided)";              05400000
         move buff := "2893 Card Reader";                               05420000
         move buff := "7974 Mag Tape";                                  05440000
         move buff := "7976 Mag Tape";                                  05460000
         move buff := "7978 Mag Tape";                                  05480000
         move buff := "7970E Mag Tape";                                 05500000
         move buff := "7911 Disc Drive";                                05520000
         move buff := "7911 Disc with Cartridge Tape";                  05540000
         move buff := "7912 Disc Drive";                                05560000
         move buff := "7912 Disc with Cartridge Tape";                  05580000
         move buff := "7914 Disc Drive";                                05600000
         move buff := "7931 Disc Drive";                                05620000
         move buff := "7933/35 Disc Drive";                             05640000
         move buff := "7941/45 Disc Drive";                    <<*8665>>05660000
         move buff := "9140 Cartridge Tape Drive";             <<b9019>>05680000
         move buff := "9144 Cartridge Tape Drive";             <<b9019>>05700000
         move buff := "9871 Character printer";                         05720000
         move buff := "2608 Dot Matrix Printer";                        05740000
         move buff := "2631A Serial Printer";                           05760000
         move buff := "2680/2688 Page Printer";                <<b9019>>05780000
         move buff := "2613/2617/2619A Line Printer";                   05800000
         move buff := "2608S/2563/2566/2569 Dot Mat Printer";  <<*8665>>05820000
         move buff := "30020A Intelligent Network Processor";           05840000
         move buff := "30020B Intelligent Network Processor";           05860000
         move buff := "31262 GIC acting as a device";                   05880000
         move buff := "7905 Disc Drive";                                05900000
         move buff := "7906 Disc Drive";                                05920000
         move buff := "7920 Disc Drive";                                05940000
         move buff := "7925 Disc Drive";                                05960000
         end;                                                           05980000
end;                                                                    06000000
subroutine add'dev'id( drt, unit, id);                                  06020000
   value drt, unit, id;                                                 06040000
   integer drt, unit, id;                                               06060000
begin                                                                   06080000
   if nextid < highestnextid then                                       06100000
      begin                                                             06120000
      idinfo( nextid:=nextid+1) := drt;                                 06140000
      idinfo( nextid:=nextid+1) := unit;                                06160000
      idinfo( nextid:=nextid+1) := id;                                  06180000
      end;                                                              06200000
end;                                                                    06220000
integer subroutine searchtype( id);                                     06240000
   value id;                                                            06260000
   integer id;                                                          06280000
begin                                                                   06300000
   j := 0;                                                              06320000
   while idcodes(j) <> -1 and idcodes(j) <> id do j := j+2;             06340000
   searchtype := idcodes(j+1);                                          06360000
end;                                                                    06380000
integer subroutine chantype( drt, chanid);                              06400000
   value drt;                                                           06420000
   integer drt, chanid;                                                 06440000
begin                                                                   06460000
   if drt = 8 then delay( 200d); << wait for i/o to complete >>         06480000
   init( drt);                                                          06500000
   if > then                                                            06520000
      chantype := 4                                                     06540000
   else                                                                 06560000
      begin                                                             06580000
      chanid := rioc( drt, rege); << read register e >>                 06600000
      chantype := chanproc( chanid.(12:4) );                            06620000
      end                                                               06640000
end;                                                                    06660000
subroutine build'str( drt, id);                                         06680000
   value drt, id;                                                       06700000
   integer drt, id;                                                     06720000
begin                                                                   06740000
                                                                        06760000
   imb  := drt.(7:2);                                                   06780000
   chan := drt.(9:4);                                                   06800000
   dev  := drt.(13:3);                                                  06820000
                                                                        06840000
   if oldimb <> imb then                                                06860000
      begin                                                             06880000
      ntoa( imb, 10, strimb);                                           06900000
      oldimb := imb;                                                    06920000
      oldchan := -1;                                                    06940000
      olddev := -1;                                                     06960000
      end;                                                              06980000
   if oldchan <> chan then                                              07000000
      begin                                                             07020000
      ntoa( chan, 10, strchan);                                         07040000
      oldchan := chan;                                                  07060000
      olddev := -1;                                                     07080000
      end;                                                              07100000
   if olddev <> dev then                                                07120000
      begin                                                             07140000
      ntoa( dev, 10, strdev);                                           07160000
      olddev := dev;                                                    07180000
      end;                                                              07200000
   ntoa( drt, 10, strdrt);                                              07220000
   ntoa( 0, 10, strunit);                                               07240000
   search( id, strdescp);                                               07260000
end;                                                                    07280000
subroutine print'devid( drt, id);                                       07300000
   value drt, id;                                                       07320000
   integer drt, id;                                                     07340000
begin                                                                   07360000
   add'dev'id( drt, 0, id);                                             07380000
   build'str( drt, id);                                                 07400000
   printline;                                                           07420000
end;                                                                    07440000
subroutine print'atp( drt, chanid);                                     07460000
   value drt, chanid;                                                   07480000
   integer drt, chanid;                                                 07500000
begin                                                                   07520000
   aibmask := 0;                                                        07540000
   << determine which aib boards exist >>                               07560000
                                                                        07580000
   for *aib := 0 until 7 do                                             07600000
      begin                                                             07620000
      tos := %377;                                                      07640000
      x := aib;                                                         07660000
      assemble( trbc 8,x );                                             07680000
      data := tos;                                                      07700000
      init( drt);                                                       07720000
      wioc( drt, rega, %(16)bf89);                                      07740000
      wioc( drt, reg9, data);                                           07760000
      data := rioc( drt, rega);                                         07780000
      if data.(9:1) = 0 then                                            07800000
         begin                                                          07820000
         setbit( aibmask, aib);                                         07840000
         for *unit := aib*12 until aib*12+11 do                         07860000
            add'dev'id( drt, unit, catp);                               07880000
         end;                                                           07900000
      end;                                                              07920000
   init( drt);                                                          07940000
                                                                        07960000
   << print out configuable units >>                                    07980000
                                                                        08000000
   boards := 0;                                                         08020000
   for *aib := 0 until 8 do                                             08040000
      begin                                                             08060000
      if testbit( aibmask, aib) then                                    08080000
         boards := boards+1                                             08100000
      else                                                              08120000
         begin                                                          08140000
         if boards <> 0 then                                            08160000
            begin                                                       08180000
            build'str( drt, catp);                                      08200000
            tos := @bline(18);                                          08220000
            tos := tos+lntoa( (aib-boards)*12, 10, bps0);               08240000
            move * := "-",2;                                            08260000
            tos := tos+lntoa( aib*12-1, 10, bps0);                      08280000
            del;                                                        08300000
            boards := 0;                                                08320000
            printline;                                                  08340000
            end;                                                        08360000
         end;                                                           08380000
      end;                                                              08400000
end;                                                                    08420000
subroutine print'tic( drt, chanid);                                     08440000
   value drt, chanid;                                                   08460000
   integer drt, chanid;                                                 08480000
begin                                                                   08500000
   id := %(16)11;  << force id for search! >>                           08520000
   for *unit := 0 until 5 do                                            08540000
      add'dev'id( drt, unit, id);                                       08560000
   add'dev'id( drt, 7, id); << modem port >>                            08580000
   build'str( drt, id);                                                 08600000
   move bline(19) := "0-5";  << units >>                                08620000
   printline;                                                           08640000
   build'str( drt, id);                                                 08660000
   move bline(19) := "  7";  << units >>                                08680000
   printline;                                                           08700000
end;                                                                    08720000
subroutine print'adcc( drt, chanid);                                    08740000
   value drt, chanid;                                                   08760000
   integer drt, chanid;                                                 08780000
begin                                                                   08800000
   id := %(16)10;  << force id for search! >>                           08820000
   for *unit := 0 until (if chanid.(11:1)=0 then 3 else 7) do           08840000
      add'dev'id( drt+unit, 0, id);                                     08860000
   build'str( drt, id);                                                 08880000
   if chanid.(11:1) = 0 then                                            08900000
      move bline(9) := "0-3"                                            08920000
   else                                                                 08940000
      move bline(9) := "0-7";                                           08960000
   printline;                                                           08980000
end;                                                                    09000000
subroutine print'unkwnchan( drt, chanid);                               09020000
   value drt, chanid;                                                   09040000
   integer drt, chanid;                                                 09060000
begin                                                                   09080000
   build'str( drt, 0);                                                  09100000
   move strdescp := "UNKNOWN CHANNEL, ID=",2;                           09120000
   @bp := tos;                                                          09140000
   lntoa( chanid, 8, bp);                                               09160000
   printline;                                                           09180000
end;                                                                    09200000
subroutine get'label'name;                                              09220000
begin                                                                   09240000
   @bp := @strlabel;                                                    09260000
   for *k := 0 until 7 do                                               09280000
      bp(k) := if 32 <= integer(bbuf(k+20)) <= 122 then                 09300000
         bbuf(k+20)  else  ".";                                         09320000
end;                                                                    09340000
                                                                        09360000
subroutine print'c13037( drt, chanid);                                  09380000
   value drt, chanid;                                                   09400000
   integer drt, chanid;                                                 09420000
begin                                                                   09440000
   i := 0;                                                              09460000
   for *unit := 0 until 7 do                                            09480000
      begin                                                             09500000
      push( db );                                                       09520000
      tos := tos + @status;                                             09540000
      memadr := tos;                                                    09560000
      mh7905( 0, drt, unit, 8, rstat, 0d, memadr, 2);                   09580000
      if status2 <> -1 and status2.(14:2) <> 2 then                     09600000
         begin                                                          09620000
         type := status2.(4:4);                                         09640000
         if type = 0 then id := %(16)ff02; <<7906>>                     09660000
         if type = 2 then id := %(16)ff03; <<7920>>                     09680000
         if type = 4 then id := %(16)ff01; <<7905>>                     09700000
         if type = 6 then id := %(16)ff04; <<7925>>                     09720000
         build'str( drt, id);                                           09740000
         add'dev'id( drt, unit, id);                                    09760000
         ntoa( unit, 10, strunit);                                      09780000
         if status2.(14:1) = 1 then                                     09800000
            move strlabel := "NOT READY"                                09820000
         else                                                           09840000
            begin                                                       09860000
            push( db );                                                 09880000
            tos := tos + @buf;                                          09900000
            memadr := tos;                                              09920000
            mh7905(0,drt,unit,8,nfread,0d,memadr,128);                  09940000
            if = then                                                   09960000
               get'label'name                                           09980000
            else                                                        10000000
               move strlabel := "READ ERROR";                           10020000
            end;                                                        10040000
         printline;                                                     10060000
         i := i+1;                                                      10080000
         end;                                                           10100000
      end;                                                              10120000
                                                                        10140000
   if i = 0 then                                                        10160000
      begin                                                             10180000
      build'str( drt, id);                                              10200000
      strunit := "?";                                                   10220000
      printline;                                                        10240000
      end;                                                              10260000
end;                                                                    10280000
subroutine print'cs80( drt, chanid);                                    10300000
   value drt, chanid;                                                   10320000
   integer drt, chanid;                                                 10340000
begin                                                                   10360000
   add'dev'id( drt, 0, id);                                             10380000
   build'str( drt, id);                                                 10400000
   push( db );                                                          10420000
   tos := tos + @status;                                                10440000
   memadr := tos;                                                       10460000
   cs80'driver( 0, drt, 0, 8, rstat, 0d, memadr, 2);                    10480000
   if status2.(14:1) = 1 then                                           10500000
      move strlabel := "NOT READY"                                      10520000
   else                                                                 10540000
      begin                                                             10560000
      push( db );                                                       10580000
      tos := tos + @buf;                                                10600000
      memadr := tos;                                                    10620000
      cs80'driver( 0, drt, 0, 8, nfread, 0d, memadr, 128);              10640000
      if = then                                                         10660000
         get'label'name                                                 10680000
      else                                                              10700000
         move strlabel := "READ ERROR";                                 10720000
      end;                                                              10740000
   printline;                                                           10760000
end;                                                                    10780000
subroutine print'c7970( drt, chanid);                                   10800000
   value drt, chanid;                                                   10820000
   integer drt, chanid;                                                 10840000
begin                                                                   10860000
   i := 0;                                                              10880000
   for *unit := 0 until 3 do                                            10900000
      begin                                                             10920000
      add'dev'id( drt, unit, id);                                       10940000
      move buf := ( %2001,1,0,%42000,0,  <<sel unit>>                   10960000
                    %1000,0,             <<wait>>                       10980000
                    %2401,0,0,0,         <<dsj>>                        11000000
                    %1401,3,0,%2000,0,   <<rd stat>>                    11020000
                    %600,0,              <<int,h>>                      11040000
                    0,                   <<cmd buf>>                    11060000
                    0,0);                <<stat buf>>                   11080000
      buf(18) := unit+1; <<unit sel cmd>>                               11100000
      buf(4) := abs(chanpgm)+18;                                        11120000
      buf(15) := abs(chanpgm)+19;                                       11140000
      push( db );                                                       11160000
      tos := tos+@buf;                                                  11180000
      memadr := tos;                                                    11200000
      mabs( 0, abs(chanpgm), bank, adr, 21);                            11220000
      siop( drt, abs(chanpgm));                                         11240000
      << wait for channel program to complete >>                        11260000
      x := rclk;                                                        11280000
      while getdrt(drt,chanstat).(0:2) <> 0 and                         11300000
            rclk <> x+10 do;                                            11320000
      if abs(abs(chanpgm)+19).(7:1) then                                11340000
         begin                                                          11360000
         build'str( drt, id);                                           11380000
         ntoa( unit, 10, strunit);                                      11400000
         printline;                                                     11420000
         i := i+1;                                                      11440000
         end;                                                           11460000
      end;                                                              11480000
                                                                        11500000
   if i = 0 then                                                        11520000
      begin                                                             11540000
      build'str( drt, id);                                              11560000
      strunit := "?";                                                   11580000
      printline;                                                        11600000
      end;                                                              11620000
end;                                                                    11640000
subroutine print'gic( drt, chanid);                                     11660000
   value drt, chanid;                                                   11680000
   integer drt, chanid;                                                 11700000
begin                                                                   11720000
   << loop through each device on the channel >>                        11740000
                                                                        11760000
   for *dev := 0 until 7 do                                             11780000
      begin                                                             11800000
      initdrt( drt);                                                    11820000
      id := identify( drt);                                             11840000
      if id <> 0 then                                                   11860000
         case searchtype( id) of                                        11880000
            begin                                                       11900000
            print'devid( drt, id);                                      11920000
            print'c13037( drt, id);                                     11940000
            print'c7970( drt, id);                                      11960000
            print'cs80( drt, id);                                       11980000
            end;                                                        12000000
      drt := drt+1;                                                     12020000
      end;                                                              12040000
end;                                                                    12060000
subroutine print'gicdev( drt, chanid);                                  12080000
   value drt, chanid;                                                   12100000
   integer drt, chanid;                                                 12120000
begin                                                                   12140000
   chanid := %(16)6000;                                                 12160000
   build'str( drt, chanid);                                             12180000
   printline;                                                           12200000
end;                                                                    12220000
                                                                        12240000
                                                                        12260000
   @bline := @line &lsl(1);                                             12280000
   zerobuf( idinfo, highestnextid+1);                                   12300000
                                                                        12320000
   oldimb := -1;                                                        12340000
   oldchan := -1;                                                       12360000
   olddev := -1;                                                        12380000
                                                                        12400000
   move bline := "IMB CHAN DEV  DRT UNIT  DESCRIPTION";                 12420000
   move strlabel := "LABEL/STATUS";                                     12440000
   printline;                                                           12460000
   printline;                                                           12480000
                                                                        12500000
   nrimb := if multi'imb'sys then 3 else 0;                             12520000
   move imbs := (0,0,0,0);                                              12540000
                                                                        12560000
   << imb's that don't exist will return a 0 from smsk >>               12580000
                                                                        12600000
   tos := -1d;                                                          12620000
   tos := -1d;                                                          12640000
   assemble( smsk;                                                      12660000
             rmsk );                                                    12680000
                                                                        12700000
   x := 0;                                                              12720000
   do begin                                                             12740000
      imbs(x) := tos;                                                   12760000
      x := x+1;                                                         12780000
      end                                                               12800000
   until x > nrimb;                                                     12820000
                                                                        12840000
   << do a roll call on all imb's that exist >>                         12860000
                                                                        12880000
   i := 0;                                                              12900000
   do begin                                                             12920000
      if imbs(i) <> 0 then  << imb exists? >>                           12940000
         imbs(i) := rioc( i & lsl(7), rocl);                            12960000
      i := i+1;                                                         12980000
      end                                                               13000000
   until i > nrimb;                                                     13020000
                                                                        13040000
   << loop through each channel on the imb >>                           13060000
                                                                        13080000
   channr := 0;                                                         13100000
   while (channr:=channr+1) <= 63 do                                    13120000
      begin                                                             13140000
      if testbit( imbs, channr) then                                    13160000
         begin   << chan exists >>                                      13180000
         drt := channr*8;                                               13200000
         case chantype( drt, chanid) of                                 13220000
            begin                                                       13240000
                                                                        13260000
            begin   << adcc >>                                          13280000
            print'adcc( drt, chanid);                                   13300000
            end;                                                        13320000
                                                                        13340000
            begin   << atp >>                                           13360000
            print'atp( drt, chanid);                                    13380000
            end;                                                        13400000
                                                                        13420000
            begin   << tic >>                                           13440000
            print'tic( drt, chanid);                                    13460000
            end;                                                        13480000
                                                                        13500000
            begin   << gic >>                                           13520000
            print'gic( drt, chanid);                                    13540000
            end;                                                        13560000
                                                                        13580000
            begin   << gic acting as device >>                          13600000
            print'gicdev( drt, chanid);                                 13620000
            end;                                                        13640000
                                                                        13660000
            begin   << unknown >>                                       13680000
            print'unkwnchan( drt, chanid);                              13700000
            end;                                                        13720000
                                                                        13740000
            end;                                                        13760000
         end;                                                           13780000
      end;                                                              13800000
end;                                                                    13820000
end.                                                                    13840000
