$CONTROL USLINIT,MAP,CODE                                      <<03627>>00010000
$control subprogram                                                     00012000
$thirty                                                                 00014000
begin                                                                   00016000
comment                                                                 00018000
                                                                        00020000
   this is the relocatable library(rl) for all ser-30 cold-load,        00022000
   stand-alone programs.  it contains the basic i/o procedures          00024000
   necessary in the stand alone environment, i.e. console and           00026000
   optional lineprinter.  for a program to be accepted by sdupii        00028000
   as a type=2 (non-cpu) and put on tape in a cold loadable form        00030000
   it must contain one call to "PUT" and one to "GET" and must be       00032000
   prepped with this rl. ( rl= ).                                       00034000
                                                                        00036000
   basic i/o procedures:                                                00038000
                                                                        00040000
     rc(max)                          --  read  1 char on console       00042000
     wc(chr)                          --  write 1 char on console       00044000
     copy(chr)                        --  copy 1 char to drt#7 u#0      00046000
     put(string,length,control)       --  print string on console       00048000
     get(buffer,length,control)       --  read  string on console       00050000
     putfast(string,length,control)   --  print string on printer       00052000
                                                                        00054000
   utility procedures:                                                  00056000
                                                                        00058000
     length:=ascii(word,string,base)  --  same as intrinsic             00060000
     word:=binary(string,length)      --  same as intrinsic             00062000
     help                             --  s-a debug routine             00064000
                                                                        00066000
                                                                        00068000
   low core pointers and flags                                          00070000
                                                                        00072000
     word    field    name    use                                       00074000
                                                                        00076000
     % 0             cstp     pointer to code segment table             00078000
     % 1  .(9:7)   lpi'drtn   drt# of printer configured by sdupii      00080000
          .(6:2)   lpi'type   type configured by sdupii (0/1)           00082000
          .(0:1)   lpi'cctl   if 1 causes putfast to issue pageout      00084000
     % 2           put'addr   external p-lable for "PUT"                00086000
     % 3           flg'cell                                             00088000
          .(15:1)  cta'flag   ok for control-a to cause trapout         00090000
          .(14:1)  brk'flag   ok for break to cause trapout             00092000
     % 4           tdi'drtn   drt# of tdi for current console port      00094000
     % 5              q-i     interrupt control stack q-pointer         00096000
     % 6              q-z     interrupt control stack limit             00098000
     % 7           prg'main   pb offset to main entry point of          00100000
                              stand alone program ( cst 3 )             00102000
     % 10          tdi'baud   baudrate of current console port          00104000
     % 11             qi2       reserved                                00106000
     % 12             qz2       reserved                                00108000
     % 13          con'cnfg   confg/info to allow moving console        00110000
          .(12:4)  con'unit   unit# of current console port             00112000
          .( 4:8)  con'baud   for hard-console drt#7/u#0 if known       00114000
          .( 2:1)  con'modem  modem flag for speedsense                 00116000
          .( 1:1)  con'copy   copy flag if console to be copied         00118000
          .( 0:1)  handshake  flags put to use "ENQ/ACK" exchange       00120000
                                                                        00122000
                                                                        00124000
   <<fx1>> general cleanup of source to make it readable.               00126000
           eliminate duplicate defines & equates.                       00128000
                                                                        00130000
   <<fx2>> fixup response to backspace on input                         00132000
                                                                        00134000
              get - reverse sense of branch on baudrate                 00136000
                    -  fast trms (send space,backspace)                 00138000
                    -  slow trms (send "/",linefeed)                    00140000
                                                                        00142000
   <<fx3>> add padd chars to eor to stop overprint on slow terms        00144000
                                                                        00146000
              put - insert null char after cr and after lf              00148000
                                                                        00150000
   <<fx4>> get rid of the bad parity "SYNC" char (%377) on output       00152000
                                                                        00154000
              put - replace "SYNC" (%377) with "NULL" (%0)              00156000
                                                                        00158000
   <<fx5>> delete unuseable code from help routine                      00160000
                                                                        00162000
              help- remove subroutine printioqs                         00164000
                    -  remove call from case on com                     00166000
                    -  make command illegal                             00168000
                                                                        00170000
   <<fx6>> fix putfast to reset page-up flag after use         <<04831>>00172000
                                                               <<04831>>00174000
                                                               <<04831>>00176000
   <<eh1>> trap on control-a if enabled and break in console i/o        00178000
                                                                        00180000
              put - special calling parms cause trap to main prog       00182000
                    -  pb of main is in low core %7                     00184000
                    -  seg# of main program is always 3                 00186000
                    -  pb of put entry from low core %2                 00188000
                    -  control-a trap flag is low core %3               00190000
                    -  if count parm<0 will print err & trap            00192000
                    -  if count=-1: type=0: prints break ...            00194000
                    -               type=1: prints ctl-a ...            00196000
              rc  - uses special put call to trap to main prog.         00198000
                    -  checks incoming data for control-a               00200000
                    -  checks status on recieve char for break          00202000
              wc  - uses special put call to trap to main prog.         00204000
                    -  checks for recieve char during transmit.         00206000
                    -  checks for ctl-a and break                       00208000
                                                                        00210000
   <<eh2>> use (enq-ack)handshake for output if device is capable       00212000
                                                                        00214000
              rc  - if max<-1 does timed read                           00216000
                    -  max is used to preset timeout                    00218000
                    -  cr is returned if timeout occurs                 00220000
              get - speedsense sets handshake flag                      00222000
                    -  uses rc(0) to setup recieve parms                00224000
                    -  issues a enq                                     00226000
                    -  does a timed read (rc(%100000))                  00228000
                    -  sets handshake true if ack recieved              00230000
                    -  handshake flag = low core %13 bit-0              00232000
              put - uses enq-ack protocol if handshake true             00234000
                                                                        00236000
   <<eh3>> make unit# a variable so that console may be redesignated    00238000
                                                                        00240000
              rc  - make all defaults to unit#0 use a variable          00242000
                    -  unit# of console at low core %13.(11:5)          00244000
                    -  include unit# in send comm to set rcv parms      00246000
                    -  use unit# from last read in ack-int comm         00248000
                    -  use variable in unit# check on rcv data          00250000
              wc  - (same as rc)                                        00252000
              get - speedsense (same as rc)                             00254000
                                                                        00256000
   <<eh4>> check for un-speedsensed port on entry to put.               00258000
                                                                        00260000
              put - speedsense port if tdi'baud=0                       00262000
                    -  uses dummy call to get                           00264000
                    -  tdi'baud is low-core %10                         00266000
                                                                        00268000
   <<eh5>> handle modem protocol for dial-up connection.                00270000
                                                                        00272000
              get - speedsense routine will                             00274000
                    -  check for modem flag low-core %13 bit-2          00276000
                    -  if set: - assume a tci at drt# of tdi+1          00278000
                               - issue a master clear to tci            00280000
                               - assert "DTR" & "RQS" to unit#          00282000
                               - then wait for "DSR" & "CD"             00284000
                                 before speedsensing the port           00286000
                                                                        00288000
   <<eh6>> copy remote console traffic to hard console.                 00290000
                                                                        00292000
              get - speedsense will record baud-rate sensed             00294000
                    in a seperate place - low core %13 .(4:8)           00296000
                    if the console drt#=7 and unit#=0.                  00298000
                                                                        00300000
              rc& - if copy flag is = 0 - low core %13 bit-1            00302000
              wc  - will call "COPY" for each character in or out       00304000
                                                                        00306000
              copy- if current console not at drt#=7 & unit#-0          00308000
                    and the baud-rate is available, will copy           00310000
                    character by character all console traffic.         00312000
                                                                        00314000
   <<eh7>> printer type-2 works with 2608a on univ i/f.                 00316000
                                                                        00318000
              putfast - uses appropriate control bytes for 2608a        00320000
                                                                        00322000
                      - rewritten to use only dio programing to         00324000
                        eliminate the need to be in bank 0. all         00326000
                        output is wait mode anyway.                     00328000
                                                                        00330000
   <<eh8>> add new procedures for cta'trap handling and lp.             00332000
                                                                        00334000
              xcontrap - set up plabel to cta'trap procedure.           00336000
              startidle- set flags to enable traps.                     00338000
              stopidle - clear flags to disable traps.                  00340000
              testcontrolytrap - checks for ctl-a while trapoff.        00342000
              setoffline-sets up lp as output for putfast.              00344000
              doapage  - page ejects on lp if configured.               00346000
              clearoffline - redirects putfast to console.              00348000
                                                                        00350000
   ;                                                                    00352000
                                                                        00354000
                                                                        00356000
integer  x  = x,   << define registers and tos variables >>             00358000
         xreg = x,                                                      00360000
         s0 = s-0,                                                      00362000
         s1 = s-1,                                                      00364000
         s2 = s-2,                                                      00366000
         s3 = s-3,                                                      00368000
         s4 = s-4,                                                      00370000
         s5 = s-5,                                                      00372000
         s7 = s-7;                                                      00374000
                                                                        00376000
logical  status = q-1,                                        <<eh1>>   00378000
         deltap = q-2,                                        <<eh1>>   00380000
         stackx = q-3;                                        <<eh1>>   00382000
                                                                        00384000
logical  stat   = q-1;                                                  00386000
integer qm0=q-0,qm1=q-1,qm2=q-2,qm5=q-5,qm7=q-7;                        00388000
double ds3=s-3,ds6=s-6;                                                 00390000
                                                                        00392000
define    hardhalt = assemble(halt 0;br*-1)#,                           00394000
          duplicate= assemble(dup)#,                                    00396000
          delete   = assemble(del)#;                                    00398000
                                                                        00400000
<<field specifications                                      >>          00402000
                                                                        00404000
define   drtf  =   (0:8)#, <<drt feild                      >>          00406000
         unitf =   (12:4)#;<<unit feild                     >>          00408000
                                                                        00410000
equate   << mag. tape information >>                                    00412000
     tapedrt         =    6,                                            00414000
     tape'rec'len    = 4096,                                            00416000
     sect'tape'rec   =   32;                                            00418000
define hp7976=switch'register.(0:1)=1#;                                 00420000
                                                                        00422000
                                                                        00424000
equate  << 7905/7920/7925 subtypes >>                                   00426000
     type'fhdisk = 1, <<fixed head disk type    >>                      00428000
     type'cs80   = 3, <<cs80 7935 supported on series ii/iii>> <<03627>>00430000
     r7905 = 4,  <<7905 -- removeable part>>                            00432000
     f7905 = 5,  <<7905 -- fixed part>>                                 00434000
     t7905 = 6,  <<7905 -- total - fixed and removeable>>               00436000
     s7920 = 8,  <<7920>>                                               00438000
     s7925 = 9;  <<7925>>                                               00440000
                                                                        00442000
                                                                        00444000
equate  << mhinfo offsets within entries >>                             00446000
     mhinfosize = 10,  << entry size >>                                 00448000
     mhdeflps   =  0,  << default logical pack size >>                  00450000
     mhmaxlps   =  1,  << maximum logical pack size >>                  00452000
     mhtrkcyl   =  2,  << tracks per cylinder >>                        00454000
     mhsectrk   =  3,  << sectors per track >>                          00456000
     mhtrkmult  =  4,  << physical tracks per logical track >>          00458000
     mhsthead   =  5,  << physical starting head location >>            00460000
     mhseccyl   =  6,  << sectors per cylinder >>                       00462000
     mhfrspctab =  7,  << sectors in disc free space table >>           00464000
     mhtrklen   =  8,  << words per track >>                            00466000
     mhfilemask =  9;  << 7905/20/25/xx file mask values >>             00468000
                                                                        00470000
                                                               <<02657>>00472000
equate  << disc types >>                                                00474000
     mhdisctype   = 0,                                                  00476000
     fhdisctype   = 1,                                                  00478000
     nmhsubtypes  = 10,                                        <<01.01>>00480000
     nfhsubtypes  = 3;                                                  00482000
                                                                        00484000
equate <<disc and tape functions>>                                      00486000
     readd        = 0,                                                  00488000
     writed       = 1,                                                  00490000
                                                                        00492000
     readt        = 0,                                                  00494000
     writet       = 1,                                                  00496000
                                                                        00498000
     readfs       = 4,                                                  00500000
     flagdt       =3;                                                   00502000
                                                                        00504000
                                                                        00506000
define   abs      = absolute#,      << contractions >>        <<fx1>>   00508000
         asmb     = assemble#,                                <<fx1>>   00510000
                                                              <<fx1>>   00512000
         lpi'cnfg = abs(% 1)#,      << low core locations >>  <<eh7>>   00514000
         put'addr = abs(% 2)#,                                <<eh1>>   00516000
         flg'cell = abs(% 3)#,                                <<eh1>>   00518000
         tdi'drtn = abs(% 4)#,                                          00520000
         ics'qval = abs(% 5)#,                                <<eh8>>   00522000
         ics'zval = abs(% 6)#,                                <<eh8>>   00524000
         prg'main = abs(% 7)#,                                <<eh1>>   00526000
         tdi'baud = abs(%10)#,                                          00528000
         cta'trap = abs(%11)#,                                <<eh8>>   00530000
         lpi'cell = abs(%12)#,                                <<eh8>>   00532000
         con'cnfg = abs(%13)#,                                <<eh2>>   00534000
         lpi'drtn = lpi'cnfg.( 8: 8)#,                        <<eh7>>   00536000
         lpi'type = lpi'cnfg.( 6: 2)#,                        <<eh7>>   00538000
         lpi'page = lpi'cnfg.( 0: 1)#,                        <<eh7>>   00540000
         cta'flag = flg'cell.(15: 1)#,                        <<eh1>>   00542000
         brk'flag = flg'cell.(14: 1)#,                        <<eh1>>   00544000
         outputmode = lpi'cell.(15:1)#,                                 00546000
         handshake= con'cnfg.( 0: 1)#,                        <<eh2>>   00548000
         con'copy = con'cnfg.( 1: 1)#,                        <<eh6>>   00550000
         con'modem= con'cnfg.( 2: 1)#,                        <<eh5>>   00552000
         con'baud = con'cnfg.( 4: 8)#,                        <<eh5>>   00554000
         con'unit = con'cnfg.(12: 4)#,                        <<eh3>>   00556000
         tdi'unit = con'unit &lsl(9)#,                        <<eh3>>   00558000
         tci'unit = con'unit &lsl(8)#,                        <<eh5>>   00560000
         tci'drtn = tdi'drtn+1#,                              <<eh5>>   00562000
         clk'drtn = 3#,                                       <<eh8>>   00564000
         cst'size = 4#,                                       <<fx1>>   00566000
         ack'wait = -tdi'baud/4#,                             <<eh2>>   00568000
                                                                        00570000
         tio0 = asmb(tio 0;bl*-1)#, <<ser-ii/iii i/o instr>>  <<fx1>>   00572000
         tio1 = asmb(tio 1;bl*-1)#,                           <<eh5>>   00574000
         cio1 = asmb(cio 1;bl*-1)#,                                     00576000
         cio2 = asmb(cio 2;bl*-1)#,                                     00578000
         cio3 = asmb(cio 3;bl*-1)#,                           <<eh3>>   00580000
         rio0 = asmb(rio 0;be*+4;bl*-2;del;br*-4)#,                     00582000
         rio1 = asmb(rio 1;be*+4;bl*-2;del;br*-4)#,                     00584000
         wio1 = asmb(wio 1;be*+4;bl*-2;del;br*-4)#,                     00586000
         wio2 = asmb(wio 2;be*+4;bl*-2;del;br*-4)#,                     00588000
                                                                        00590000
         enbl = asmb( sed 1 )#,     <<machine instructions>>  <<fx1>>   00592000
         dsbl = asmb( sed 0 )#,                               <<fx1>>   00594000
         stad = asmb( ssea  )#,                               <<fx1>>   00596000
         ldad = asmb( lsea  )#,                               <<fx1>>   00598000
         dupl = asmb(  dup  )#,                               <<fx1>>   00600000
                                                              <<fx1>>   00602000
         cc   = status.(6:2)#;                                          00604000
                                                                        00606000
equate   ccg =    0,                                                    00608000
         ccl =    1,                                                    00610000
         cce =    2,                                                    00612000
                                                                        00614000
                                                                        00616000
         nul'  = %  0,                                        <<fx3>>   00618000
         ctl'a = %  1,                                        <<eh1>>   00620000
         enq'  = %  5,                                        <<eh2>>   00622000
         ack'  = %  6,                                        <<eh2>>   00624000
         bksp' = % 10,                                        <<fx2>>   00626000
         lf'   = % 12,                                                  00628000
         cr'   = % 15,                                                  00630000
         x'on  = % 21,                                                  00632000
         dc3'  = % 23,                                                  00634000
         ctl'x = % 30,                                                  00636000
         ctl'y = % 31,                                                  00638000
         spc'  = % 40,                                        <<fx2>>   00640000
         excl' = % 41,                                                  00642000
         slsh' = %134,                                        <<fx2>>   00644000
         rbo'  = %177,                                                  00646000
         syn'  = %377,                                                  00648000
                                                                        00650000
                                                                        00652000
         cps240 = %  5 ,  <<2400 baud>>                                 00654000
         cps120 = % 13 ,  <<1200 baud>>                                 00656000
         cps60  = % 27 ,  << 600 baud>>                                 00658000
         cps30  = % 57 ,  << 300 baud>>                                 00660000
         cps15  = %137 ,  << 150 baud>>                                 00662000
         cps10  = %202 ,  << 110 baud>>                                 00664000
                                                                        00666000
         rcv'parm  = [ 1/1,            <<      output       >>          00668000
                       1/0,            << recieve parameter >>          00670000
                       1/1,            << interupt enabled  >>          00672000
                       1/0,            <<     echo-off      >>          00674000
                       1/0,            << no data to aux-chn>>          00676000
                       3/2,            <<    10-bit chr     >>          00678000
                       8/0  ],         <<    baud - rate    >>          00680000
                                                                        00682000
         rcv'echon = rcv'parm + %10000,<<     echo-on       >>          00684000
                                                                        00686000
         tci'cntrl = [ 8/0,                                   <<eh5>>   00688000
                       1/1,    <<ec2>> <<enable control 2>>   <<eh5>>   00690000
                       1/1,    <<ec1>> <<enable control 1>>   <<eh5>>   00692000
                       1/1,    <<c2 >> <<  set rqs high  >>   <<eh5>>   00694000
                       1/1,    <<c1 >> <<  set dtr high  >>   <<eh5>>   00696000
                       4/0  ],                                <<eh5>>   00698000
                                                              <<eh5>>   00700000
         tci'inten = [ 3/0,                                   <<eh5>>   00702000
                       1/1,    <<upd>> <<change expected >>   <<eh5>>   00704000
                       8/0,            <<   state for    >>   <<eh5>>   00706000
                       1/1,    <<es2>> <<enable int on s2>>   <<eh5>>   00708000
                       1/1,    <<es1>> <<enable int on s1>>   <<eh5>>   00710000
$page                                                                   00712000
                       1/1,    <<s2 >> << int on s2 drop >>   <<eh5>>   00714000
                       1/1  ]; <<s1 >> << int on s1 drop >>   <<eh5>>   00716000
                                                              <<eh5>>   00718000
                                                                        00720000
<<**********************************************************>>          00722000
<<mailbox variables used by sadutil.  put there by sdupii   >>          00724000
<<used for a variety of reasons.                            >>          00726000
<<                                                          >>          00728000
<<   mb1 contains the switch registar of load tape          >>          00730000
<<**********************************************************>>          00732000
                                                                        00734000
define  mb0   =   absolute ( %770 )#,                                   00736000
        mb1   =   absolute ( %771 )#,                                   00738000
        mb2   =   absolute ( %772 )#,                                   00740000
        mb3   =   absolute ( %773 )#,                                   00742000
        mb4   =   absolute ( %774 )#;                                   00744000
                                                                        00746000
equate  adapterdrt = %175;                                              00748000
                                                                        00750000
define  starfish   = absolute(absflags).(15:1)#;                        00752000
                                                                        00754000
define  sio1 = do begin                                                 00756000
                  assemble ( sio 1);                                    00758000
                  if <> then hardhalt;                                  00760000
                  if >  then del;                                       00762000
                  end until = #;                                        00764000
                                                                        00766000
<<outputmode can by console or lineprinter                  >>          00768000
                                                                        00770000
equate                                                                  00772000
  console       =  0,                                                   00774000
  lineprinter   =  1;                                                   00776000
                                                                        00778000
$page                                                                   00780000
<<**********************************************************>><<eh5>>   00782000
                                                              <<eh5>>   00784000
   integer procedure ascii(wrd,str,bse);                      <<eh7>>   00786000
    value wrd,bse; logical wrd; integer bse;                  <<eh7>>   00788000
    byte array str; option forward,variable;                  <<eh7>>   00790000
                                                              <<eh5>>   00792000
                                                              <<eh5>>   00794000
                                                              <<eh6>>   00796000
<<***********************  copy  ***************************>><<eh6>>   00798000
                                                              <<eh6>>   00800000
   procedure copy(chr);           << copy one character of  >><<eh6>>   00802000
    value chr;integer chr;        << data read or written to>><<eh6>>   00804000
    option privileged;            <<current confg console to>><<eh6>>   00806000
                                  <<old cons @ drt#7, unit#0>><<eh6>>   00808000
                                                              <<eh6>>   00810000
     begin                                                    <<eh6>>   00812000
                                                              <<eh6>>   00814000
      if tdi'drtn<>7 or con'unit<>0 then                      <<eh6>>   00816000
       if con'baud<>0 then                                    <<eh6>>   00818000
        begin                                                 <<eh6>>   00820000
         tos:=7;                                              <<eh6>>   00822000
         tos:=con'baud+%161000;                               <<eh6>>   00824000
         if con'baud=cps10 then tos.(7:1):=1;                 <<eh6>>   00826000
         wio1;                                                <<eh6>>   00828000
         tos:=2;                                              <<eh6>>   00830000
         cio1;                                                <<eh6>>   00832000
         tos:=chr.(8:8)+%43400;                               <<eh6>>   00834000
         wio1;                                                <<eh6>>   00836000
         tos:=2;                                              <<eh6>>   00838000
         cio1;                                                <<eh6>>   00840000
         x:=-1;                                               <<eh6>>   00842000
         do tio0 until tos.(4:1)<>0 or dxbz;                  <<eh6>>   00844000
        end;                                                  <<eh6>>   00846000
     end;   << copy >>                                        <<eh6>>   00848000
                                                              <<eh6>>   00850000
<<************************  rc  ****************************>>          00852000
                                                                        00854000
                                                                        00856000
   integer procedure rc(max);     <<reads one character from>>          00858000
    value max;integer max;        <<  async data interface  >>          00860000
    option privileged;                                                  00862000
                                  << low core %4 = tdi drt# >>          00864000
    begin                         << %13.(12:4) = con unit# >>          00866000
                                                                        00868000
     logical lrc = q-5;                                                 00870000
                                                                        00872000
entry rce;                        << dummy entry for sdupii >>          00874000
                                                                        00876000
     tos:=tdi'drtn;                                                     00878000
     tos:=tdi'baud+rcv'echon;<<enable int,echo--recve params>>          00880000
     if tdi'baud=cps10 then tos.(7:1):=1;  <<11 bits for tty>>          00882000
     wio1;                                 << set tdi'baud  >>          00884000
     tos:=tdi'unit+2;                      <<unit #/parm out>><<eh3>>   00886000
     cio1;                                 <<send to channel>>          00888000
rtry:if max = 0 then                                                    00890000
      rc:=cr'                                                           00892000
     else                                                               00894000
      begin                                                             00896000
       if max<0 then                       << if timed read >><<eh2>>   00898000
        max:=max+1;                        <<   bump timer  >><<eh2>>   00900000
       x:=%77777;                          << set wait delay>><<eh2>>   00902000
       do tio0 until tos.(4:1)<>0 or dxbz; << wait for char >><<eh2>>   00904000
       if x=0 then go rtry;                <<delay exhausted>><<eh2>>   00906000
       tio0;                                                            00908000
       rio1;                                                            00910000
       tos:=s0.(0:5) &lsl(9) +1;           << for unit # x  >><<eh3>>   00912000
       cio3;                               << ack interupt  >>          00914000
       if s1.(5:1)=1 or (s0.(0:5)<>con'unit) then <<wrong>>   <<eh3>>   00916000
        begin                                   << channel# >>          00918000
         ddel;      <<pop data & stat>>         <<    or    >>          00920000
         go rtry;   <<  go try again >>         << channel# >>          00922000
        end                                                             00924000
       else                                                             00926000
        begin                                                           00928000
         rc:=tos.(9:7);             <<pop data>><<retrn char>><<eh1>>   00930000
         if brk'flag then                       <<break ok ?>><<eh1>>   00932000
          if (tos:=tos.(7:1)-1)=0 then          <<break hit?>><<eh1>>   00934000
           go to rctrap;                        << trap-out >><<eh1>>   00936000
         del;                       <<pop stat>>              <<eh1>>   00938000
         if cta'flag and lrc=ctl'a then         <<ctl'a & ok>><<eh1>>   00940000
          begin <<cnt'a or break & trap ok>>                  <<eh1>>   00942000
           tos:=ctl'a;                                        <<eh1>>   00944000
rctrap:    tos:=-1;                      << flag for trapout>><<eh1>>   00946000
           tos:=put'addr;                << and force a pcal>><<eh1>>   00948000
           asmb(pcal 0);                 <<     to put      >><<eh1>>   00950000
          end;  <<cnt'a or break & trap ok>>                  <<eh1>>   00952000
         tos:=tdi'baud+rcv'parm;         <<  disable  echo  >>          00954000
         wio1;                                                          00956000
         tos:=tdi'unit+2;                << unit #/parm out >><<eh3>>   00958000
         cio1;                           << send to channel >>          00960000
        end;                                                            00962000
      end;                                                              00964000
     if not con'copy then copy(lrc);  <<copy to drt#7,unit#0>><<eh6>>   00966000
rce:                              << dummy entry for sdupii >>          00968000
    end;  << rc >>                                                      00970000
                                                                        00972000
                                                                        00974000
<<***********************  wc  *****************************>>          00976000
                                                                        00978000
   procedure wc(char);    <<output one character to tdi>>               00980000
    value char;                                                         00982000
    logical char;         <<watch out for incoming brk>>                00984000
    option privileged;    <<      and control-a       >>                00986000
                                                                        00988000
    begin                                                               00990000
                                                                        00992000
entry wce;                                                              00994000
                                                                        00996000
     tos:=tdi'drtn;                                                     00998000
start:                                                                  01000000
     tos:=tdi'baud+%161000;        <<enable ints-send params>>          01002000
     if tdi'baud=cps10 then tos.(7:1):=1;  <<11 bits for tty>>          01004000
     wio1;                                                              01006000
     tos:=tdi'unit+2;                      <<unit #/parm out>><<eh3>>   01008000
     cio1;                                 <<send to channel>>          01010000
     tos:=char.(8:8)+%43400;             <<character to send>>          01012000
     wio1;                                                              01014000
     tos:=tdi'unit+2;                      <<unit #/data out>><<eh3>>   01016000
     cio1;                                 <<send to channel>>          01018000
wait:x:= -1;                               <<set up counter >>          01020000
     do tio0 until tos.(4:1) <> 0 or dxbz; <<wait till compl>>          01022000
     if x= 0 then go start;             <<too long try again>>          01024000
     tio0;                                                              01026000
     rio1;                                                              01028000
     tos:=s0.(0:5) &lsl(9) +1;                 <<for unit x?>><<eh3>>   01030000
     cio3;                                     <<ack intrpt >>          01032000
     if s0.(0:5)<>con'unit then                <<this unit ?>><<eh3>>   01034000
      begin                                    <<wrong unit#>>          01036000
       ddel;                       <<pop data>>                         01038000
       go wait;                    <<pop stat>><< try again >>          01040000
      end;                                                              01042000
     if s1.(5:1)=0 then                        <<recve int? >><<eh1>>   01044000
      begin<<recieve intrpt>>                  <<   yes !   >><<eh1>>   01046000
       if (tos:=tos.(9:7))=ctl'a then          <<chr=ctr'a? >><<eh1>>   01048000
        if cta'flag then                       <<& trap ok? >><<eh1>>   01050000
         begin<<force trap call>>                             <<eh1>>   01052000
          delb;                    <<pop stat>><< tos=drt#  >><<eh1>>   01054000
wctrap:   tos:=-1;                             <<flag specl.>><<eh1>>   01056000
          tos:=put'addr;                       << & force a >><<eh1>>   01058000
          asmb(pcal 0);                        <<pcal to put>><<eh1>>   01060000
         end; <<force trap call>>                             <<eh1>>   01062000
       del;                        <<pop data>>               <<eh1>>   01064000
       if (tos:=tos.(7:1)-1)=0 then            << break hit?>><<eh1>>   01066000
        if brk'flag then                       << & break ok>><<eh1>>   01068000
         go wctrap;                            <<  trapout  >><<eh1>>   01070000
       del;                        <<pop stat>>               <<eh1>>   01072000
       go wait;                    <<tos=drt#>><< try again >><<eh1>>   01074000
      end; <<recieve intrpt>>                                 <<eh1>>   01076000
     if not con'copy then copy(char); <<copy to drt#7,unit#0>><<eh6>>   01078000
wce:                              << dummy entry for sdupii >>          01080000
    end;    <<wc>>                                                      01082000
                                                                        01084000
                                                                        01086000
<<**********************  get  *****************************>>          01088000
                                                                        01090000
                                                                        01092000
     procedure get(buf,cnt,ctl);   << input from >>                     01094000
      value      cnt;              << async  mux >>                     01096000
      integer    cnt,ctl;                                               01098000
      byte array buf;                                                   01100000
      option privileged;                                                01102000
                                                                        01104000
      begin                                                             01106000
                                                                        01108000
       entry gete;                                                      01110000
                                                                        01112000
                                                                        01114000
       integer array brparam(0:5)=pb:= <<baud rate params>>             01116000
                                                                        01118000
        cps240,  <<2400 baud>>                                          01120000
        cps120,  <<1200 baud>>                                          01122000
        cps60 ,  <<600  baud>>                                          01124000
        cps30 ,  <<300  baud>>                                          01126000
        cps15 ,  <<150  baud>>                                          01128000
        cps10 ;  <<110  baud>>                                          01130000
                                                                        01132000
                                                                        01134000
       equate  max'ctl =  8;                                            01136000
                                                                        01138000
       array ctl'chr(1:max'ctl-1)=pb:= <<special characters>>           01140000
                                                                        01142000
           ctl'x,bksp',ctl'y,rbo',nul',dc3',lf';                        01144000
                                                                        01146000
                                                                        01148000
       integer bptr,                                                    01150000
               unit = bptr,                                             01152000
               temp = bptr,                                             01154000
               x    = x;                                                01156000
                                                                        01158000
       logical chr;                                                     01160000
                                                                        01162000
       if tdi'baud=0 then go speedsense;                                01164000
       wc(x'on );                               << x on >>              01166000
       cnt:=cnt-1;                                                      01168000
start: bptr:=-1;                                                        01170000
       while ((chr:=rc(cnt-bptr))<>cr') do                              01172000
         begin                                                          01174000
          x:=max'ctl;                                                   01176000
          do x:=x-1 until x=0 or (chr=ctl'chr(x));                      01178000
          case x of                                                     01180000
           begin        <<case>>                                        01182000
            <<0>>               <<alpha or numeric>>                    01184000
            buf(bptr:=bptr+1):=chr;                                     01186000
            <<1>>               <<   control - x  >>                    01188000
            begin                                                       01190000
             wc(excl');                    << !!! >>                    01192000
             wc(excl');                                                 01194000
             wc(excl');                                                 01196000
             wc(cr'  );                     <<cr>>                      01198000
             wc(lf'  );                     <<lf>>                      01200000
             go start;                                                  01202000
            end;<<1>>                                                   01204000
            <<2>>               << back space one >>                    01206000
            if bptr>=0 then                                             01208000
             begin                                                      01210000
              bptr:=bptr-1;                                             01212000
              if tdi'baud < cps30 then                        <<fx2>>   01214000
               begin                                          <<fx2>>   01216000
                wc(spc' );                                    <<fx2>>   01218000
                wc(bksp');                                    <<fx2>>   01220000
               end                                            <<fx2>>   01222000
              else                                            <<fx2>>   01224000
               begin                                          <<fx2>>   01226000
                wc(slsh');                                    <<fx2>>   01228000
                wc(lf'  );                                    <<fx2>>   01230000
               end;                                           <<fx2>>   01232000
             end;<<2>>                                                  01234000
            <<3...max>>         << catch odd ctrl >>                    01236000
                                <<chars and ignore>>                    01238000
           end;         <<case>>                                        01240000
         end;           <<while>>   <<get next chr>>                    01242000
       ctl:=bptr+1;         <<pass back char count>>                    01244000
       wc(lf'  );                      <<line feed>>                    01246000
                                                                        01248000
       return;                                                          01250000
                                                                        01252000
speedsense:                                                             01254000
                                                                        01256000
       if con'modem then                                      <<eh5>>   01258000
        begin                                                 <<eh5>>   01260000
         tos:=tci'drtn;                                       <<eh5>>   01262000
         tos:=%100000;                 <<   master clear    >><<eh5>>   01264000
         cio1;                                                <<eh5>>   01266000
         tos:=tci'unit xor tci'cntrl;  <<  assert dtr & rqs >><<eh5>>   01268000
         cio1;                                                <<eh5>>   01270000
         do tio0 until tos.(14:2)=3;   << wait for dsr & cts>><<eh5>>   01272000
         tio0;                         <<get tci status word>><<eh5>>   01274000
         if tos.(4:4)<>con'unit then   <<check right unit # >><<eh5>>   01276000
          asmb(halt 5;br*-1);          <<if not halt %030365>><<eh5>>   01278000
         tos:=tci'unit xor tci'inten;  <<   set to int on   >><<eh5>>   01280000
         cio1;                         <<  modem disconect  >><<eh5>>   01282000
         tos:=%30000;                  <<     start scan    >><<eh5>>   01284000
         cio1;                                                <<eh5>>   01286000
         del;    << pop tci drt >>                            <<eh5>>   01288000
        end;                                                  <<eh5>>   01290000
                                                                        01292000
       tos:=tdi'drtn;                                                   01294000
       tos:=%100000;                                                    01296000
       cio1;                           <<master clear>>                 01298000
       tos:=rcv'parm+brparam;    <<output receive 2400-baud>>           01300000
       tos.(4:1):=1;            <<send data to aux channels>>           01302000
       wio1;                                                            01304000
       tos:=tdi'unit+2;                                       <<eh3>>   01306000
       cio1;                     << send to console unit # >>           01308000
       unit:=16;                                                        01310000
       do                             <<set up each aux chn>>           01312000
        begin                         <<for a diferent baud>>           01314000
         tos:=rcv'parm+brparam(unit-15);                                01316000
         if brparam(x)=%202 then tos.(7:1):=1;<<tty=11 bits>>           01318000
         wio1;                                                          01320000
         tos:=unit&lsl(9)+2;                 <<control word>>           01322000
         cio1;                        << send to aux chn # >>           01324000
        end                                                             01326000
       until (unit:=unit+1)=21;       << last diag channel >>           01328000
                                                                        01330000
readnext:                       <<come here if cr not found>>           01332000
                                                                        01334000
       do tio0 until tos.(4:1)<>0; <<wait for char complete>>           01336000
       tio0;                             <<get stat>>                   01338000
       rio1;                             <<get data>>                   01340000
       tos:=s0.(0:5) &lsl(9) +1;      << ack interrupt for >> <<eh3>>   01342000
       cio3;                          <<   whatever unit   >>           01344000
       if s1.(5:1)=0 then             <<character recieved?>>           01346000
        if s0.(9:7)=cr' then             <<  cr ?? >>                   01348000
         begin                                                          01350000
          if s0.(0:5)=con'unit then   <<  unit# = console  >> <<eh3>>   01352000
           tdi'baud:=brparam;         << set baud at 2400  >>           01354000
          if s0.(0:1)=1 then          <<  unit# = aux chn  >>           01356000
           tdi'baud:=brparam(s0.(1:4)+1);                               01358000
         end;                                                           01360000
       ddel;                                                            01362000
       if tdi'baud=0 then go readnext;<< if rate not found >>           01364000
       tos:=%100000;     <<master clear, stop diag channels>>           01366000
       cio1;                                                            01368000
       wc(cr'  );                      <<carriage return>>              01370000
       wc(lf'  );                         <<line feed>>                 01372000
       rc(0);                         <<set recieve parms>>   <<eh2>>   01374000
       wc(enq' );                      << issue enquiry >>    <<eh2>>   01376000
       temp:=rc(ack'wait);            <<timed read for ack>>  <<eh2>>   01378000
       if temp=ack' then               << if recieve ack >>   <<eh2>>   01380000
        handshake:=true;              <<set handshake flag>>  <<eh2>>   01382000
       if tdi'drtn=7 and con'unit=0 then << if con @ home >>  <<eh6>>   01384000
        con'baud:=tdi'baud;           <<keep baud for copy>>  <<eh6>>   01386000
       return;                                                          01388000
gete:                                                                   01390000
     end;     <<  get  >>                                               01392000
                                                                        01394000
<<********************  putaddr  ***************************>>          01396000
                                                                        01398000
   procedure putaddr;option external; <<special for sdupii>>            01400000
                                                                        01402000
                    << putaddr is placed in low-core (%2) >>            01404000
                    <<  so i can get here from anywhere   >>            01406000
                                                                        01408000
<<**********************  put  *****************************>>          01410000
                                                                        01412000
   procedure put(message,count,type); <<outputs strings to>>            01414000
    value count,type;                 <<async mux channel >>            01416000
    integer count,type;                                                 01418000
    byte array message;  << message must be (ba') by ref: >>            01420000
    option privileged;   << count must be pos byte count. >>            01422000
                         << type=0 for cr&lf/<>0 for none >>            01424000
     begin               <<                               >>            01426000
                         << special case:                 >>            01428000
entry pute;              << type =-1  to trap to prg'main >>            01430000
                         << count= 0  for break ...       >>            01432000
      array trmsg(0:6);  << count= 1  for ctl-a ...       >>            01434000
                                                                        01436000
      byte pointer bbuf := @message;                          <<eh1>>   01438000
      integer i:= -1;                                                   01440000
                                                                        01442000
      if type<0 then                          <<special call>><<eh1>>   01444000
       begin <<trap call>>                                    <<eh1>>   01446000
        tos:=tdi'drtn;                                                  01448000
        tos:=%140000;                                                   01450000
        cio1;                                                           01452000
        del;                                                            01454000
        rc(-1);            <<set recv parms on console chan#>><<eh1>>   01456000
        @bbuf:=@trmsg&lsl(1);                                 <<eh1>>   01458000
        trmsg:=0;                                             <<eh1>>   01460000
        trmsg(1):=[8/cr',8/lf'];                              <<eh1>>   01462000
        move bbuf(4):="PUT-ERR-";                             <<eh1>>   01464000
        if type=-1 then                                       <<eh1>>   01466000
         case count of                                        <<eh1>>   01468000
          begin                                               <<eh1>>   01470000
           move bbuf(4):="BREAK...";                          <<eh1>>   01472000
           move bbuf(4):="CTL-A...";                          <<eh1>>   01474000
           move bbuf(4):="IOERR...";                          <<eh7>>   01476000
          end;                                                <<eh1>>   01478000
        count:=12;                                            <<eh1>>   01480000
        goto out;                                             <<eh1>>   01482000
       end;  <<trap call>>                                    <<eh1>>   01484000
                                                                        01486000
      if tdi'baud=0 then                <<if not speedsensed>><<eh4>>   01488000
       get(bbuf,0,i);                   <<    do it now     >><<eh4>>   01490000
      if handshake then                    << if smart term >><<eh2>>   01492000
       do wc(enq') until rc(ack'wait)=ack';<<   do enq-ack  >><<eh2>>   01494000
out:  wc (nul');   <<synch char>>                             <<fx4>>   01496000
      while (i:=i+1) < count do wc(bbuf(i));    <<output it >>          01498000
      if type<1 then                                          <<eh1>>   01500000
       begin                                                            01502000
        wc(cr' );                                             <<fx3>>   01504000
        wc(nul');                                             <<fx3>>   01506000
        wc(lf' );                                             <<fx3>>   01508000
        wc(nul');                                             <<fx3>>   01510000
       end;                                                             01512000
      if type<>-1 then        << if not ctl'a or brk >>       <<eh1>>   01514000
       return;                    << just return >>           <<eh1>>   01516000
      tos:=cta'trap;                                          <<eh8>>   01518000
      if s0<>ics'qval and s0.(0:1)=1 and s0.(8:8)=3 then      <<eh8>>   01520000
       asmb(pcal 0);                                          <<eh8>>   01522000
      status:=%100003;        << force exit to main  >>       <<eh1>>   01524000
      deltap:=prg'main;       << program entry point >>       <<eh1>>   01526000
                                                                        01528000
      asmb(exit 0);  <<---these are dummy statements >>                 01530000
      putaddr;           <<---put here so that sdupii can>>             01532000
      put(*,*,*);        <<--- find the entry point for  >>             01534000
      asmb(exit 0);  <<---          put              >>                 01536000
                                                                        01538000
pute:                                                                   01540000
     end;    <<put>>                                                    01542000
                                                                        01544000
                                                                        01546000
                                                              <<eh7>>   01548000
<<********************  putfast  ***************************>><<eh7>>   01550000
                                                              <<eh7>>   01552000
                                                              <<eh7>>   01554000
   procedure putfast(message,count,type);                     <<eh7>>   01556000
    value count,type;                                         <<eh7>>   01558000
    integer count,type;                                       <<eh7>>   01560000
    byte array message;                                       <<eh7>>   01562000
    option privileged;                                        <<eh7>>   01564000
     begin                                                    <<eh7>>   01566000
                                                              <<eh7>>   01568000
      array prnt'cmd(0:2)=pb:=%63,%43,%1013;                  <<eh7>>   01570000
      array wmsg(0:64)=q;                                     <<eh7>>   01572000
      byte array bmsg(*)=wmsg;                                <<eh7>>   01574000
      integer cntr;                                           <<eh7>>   01576000
                                                              <<eh7>>   01578000
      tos:=lpi'drtn;                                          <<eh7>>   01580000
      if = then                 << if no lp config >>         <<eh7>>   01582000
        put(message,count,type) << send to console >>         <<eh7>>   01584000
      else                                                    <<eh7>>   01586000
       begin  << send to printer >>                           <<eh7>>   01588000
        tio0;                  <<s-1=drt, s=0=tio stat >>     <<eh7>>   01590000
        if<>then                                              <<eh7>>   01592000
         begin                                                <<eh7>>   01594000
          ddel;                                               <<eh7>>   01596000
          move bmsg:="TIO FAILED ON LP DRT#     ";            <<eh7>>   01598000
          cntr:=ascii(lpi'drtn,bmsg(22),10);                  <<eh7>>   01600000
          put(bmsg,24,0);                                     <<eh7>>   01602000
          put(bmsg,2,-1);                                     <<eh7>>   01604000
         end;                                                 <<eh7>>   01606000
        del;                   <<s-0=drt               >>     <<eh7>>   01608000
clrio:  tos:=%100000;          <<s-1=drt, s-0=%100000  >>     <<eh7>>   01610000
        cio1;                  <<s-0=drt               >>     <<eh7>>   01612000
        tio0;                  <<s-1=drt, s-0=tio stat >>     <<eh7>>   01614000
        if tos.(5:1)=1 then    <<s-0=drt               >>     <<eh7>>   01616000
         begin  << printer not ready >>                       <<eh7>>   01618000
          move bmsg:="MAKE PRINTER READY THEN HIT RETURN";    <<eh7>>   01620000
          put(bmsg,34,0);      <<tell operator console >>     <<eh7>>   01622000
          get(bmsg,1,cntr);    <<wait for reply or ctla>>     <<eh7>>   01624000
          goto clrio;          <<try again for lp ready>>     <<eh7>>   01626000
         end;   << printer not ready >>                       <<eh7>>   01628000
        if lpi'page then                                      <<eh7>>   01630000
         begin                                                <<eh7>>   01632000
          tos:=prnt'cmd(lpi'type);                            <<eh7>>   01634000
          cio1;         <<send respective print command>>     <<eh7>>   01636000
          tos:=(if lpi'type=2 then %200 else %100);           <<eh7>>   01638000
          wio1;         <<send skip to channel 0 comnd >>     <<eh7>>   01640000
          do tio0 until tos.(5:1)=0;<<wait for lp ready>>     <<eh7>>   01642000
          lpi'page := false;        << reset top of form flg>> <<04831>>01644000
         end;                                                 <<eh7>>   01646000
        if count > 0 then                                     <<eh7>>   01648000
         begin  << something to print >>                      <<eh7>>   01650000
          if count>130 then count:=130;                       <<eh7>>   01652000
          move bmsg:=message,(count);                         <<eh7>>   01654000
          if logical(count) then bmsg(count):=" ";            <<eh7>>   01656000
          count:=(count+1)/2;                                 <<eh7>>   01658000
          cntr:=0;                                            <<eh7>>   01660000
          tos:=%7;             <<s-1=drt, s-0=%7       >>     <<eh7>>   01662000
          cio1;                <<s-0=drt               >>     <<eh7>>   01664000
          do                                                  <<eh7>>   01666000
           begin                                              <<eh7>>   01668000
            tos:=wmsg(cntr);                                  <<eh7>>   01670000
            wio1;                                             <<eh7>>   01672000
           end                                                <<eh7>>   01674000
          until (cntr:=cntr+1)=count;                         <<eh7>>   01676000
          tos:=prnt'cmd(lpi'type);                            <<eh7>>   01678000
          cio1;                                               <<eh7>>   01680000
          tos:=(if lpi'type=2 then %202 else %102);           <<eh7>>   01682000
          wio1;                                               <<eh7>>   01684000
          do tio0 until tos.(5:1)=0;<<wait for lp ready>>     <<eh7>>   01686000
         end;   << something to print >>                      <<eh7>>   01688000
       end;   << send to printer >>                           <<eh7>>   01690000
     end;   << putfast >>                                     <<eh7>>   01692000
                                                              <<eh7>>   01694000
<<********************** xcontrap **************************>><<eh8>>   01696000
                                                                        01698000
procedure xcontrap(newtrapp,oldtrapp);                                  01700000
 value newtrapp; logical newtrapp,oldtrapp;                             01702000
 option privileged;                                                     01704000
                                                                        01706000
  begin                                                                 01708000
   if status.(8:8)=3 then                                               01710000
    begin                                                               01712000
     oldtrapp:=cta'trap;                                                01714000
     cta'trap:=newtrapp;                                                01716000
    end;                                                                01718000
  end;                                                                  01720000
                                                                        01722000
<<********************* startidle **************************>><<eh8>>   01724000
                                                                        01726000
procedure startidle;                                                    01728000
 begin                                                                  01730000
  cta'flag:=true;                                                       01732000
  brk'flag:=true;                                                       01734000
 end;                                                                   01736000
                                                                        01738000
<<*********************** stopidle *************************>><<eh8>>   01740000
                                                                        01742000
procedure stopidle;                                                     01744000
 begin                                                                  01746000
  cta'flag:=false;                                                      01748000
  brk'flag:=false;                                                      01750000
 end;                                                                   01752000
                                                                        01754000
<<******************* testcontrolytrap *********************>><<eh8>>   01756000
                                                                        01758000
procedure testcontrolytrap;                                             01760000
 begin                                                                  01762000
  tos:=rc(ack'wait);                                                    01764000
  del;                                                                  01766000
 end;                                                                   01768000
                                                                        01770000
<<*********************** doapage **************************>><<eh8>>   01772000
                                                                        01774000
procedure doapage;                                                      01776000
 begin                                                                  01778000
  logical char:=%20040;                                                 01780000
  byte pointer bchar:=@char;                                            01782000
                                                                        01784000
  if lpi'drtn<>0 then                                                   01786000
   begin                                                                01788000
    lpi'page:=true;                                                     01790000
    putfast(bchar,1,0);                                                 01792000
   end;                                                                 01794000
 end;                                                                   01796000
                                                                        01798000
$page                                                                   01800000
                                                                        01802000
                                                              <<fx1>>   01804000
<<********* mpe/30 standalone debugging procedure. *********>><<fx1>>   01806000
                                                              <<fx1>>   01808000
   procedure help;                                            <<fx1>>   01810000
    option privileged,uncallable;                             <<fx1>>   01812000
     begin                                                    <<fx1>>   01814000
                                                              <<fx1>>   01816000
                                                                        01818000
array  bp'tab(*) = pb := 60(0),-1;                                      01820000
comment                                                                 01822000
                                                                        01824000
   this array holds the information required for breakpoints.           01826000
   each entry in the table is 6 words long. the table is                01828000
   ended with a -1. it may be extended by  changing the number          01830000
   of initialization zeros in the above declaration. the words          01832000
   in  a table entry are used as follows:                               01834000
                                                                        01836000
   word0.(0:8) =  0    empty table entry                                01838000
                  1    user set breakpoint                              01840000
                  2    "FAKE" breakpoint                                01842000
                                                                        01844000
   word0.(8:8) =       cst for the breakpoint. if zero then             01846000
                       this table entry is free.                        01848000
                                                                        01850000
   word1       =       pb relative address for the breakpoint.          01852000
                       if zero then the entry is free.                  01854000
                                                                        01856000
   word2       =       saved instruction if a breakpoint is set.        01858000
                                                                        01860000
   word3.(0:8) =       relational operator for the conditional          01862000
                  0    no condition attached                            01864000
                  1    count attached                                   01866000
                  2    <                                                01868000
                  3    =                                                01870000
                  4    >                                                01872000
                  5    #                                                01874000
                                                                        01876000
   word3.(8:8) =       bank for comparison address                      01878000
                                                                        01880000
   word4       =       rest of the comparison address                   01882000
                                                                        01884000
   word5       =       comparison constant                              01886000
;                                                                       01888000
                                                                        01890000
integer array  bptab(*) = db+0;  << breakpoint table >>                 01892000
byte array input(0:39) = q;  << holds command string input >>           01894000
                                                                        01896000
byte array  io(0:15) = q;   << output buffer >>                         01898000
integer array  wrdio(*) = io;  << overlay for above >>                  01900000
                                                                        01902000
integer array  comm(*) = pb := %102,%103,%104,%115,%122,%121;           01904000
<< octal values of the character commands >>                            01906000
                                                                        01908000
integer array  rel(*) = pb := %74,%75,%76,%43;                          01910000
<<  the above are the allowable relational operators >>                 01912000
                                                                        01914000
integer array  pre(*) = pb := "HELP    . ";                             01916000
integer pointer ioqp = 5;                                               01918000
                                                                        01920000
double  p1, p2,   << parameters for commands >>                         01922000
        olddb,    << callers db >>                                      01924000
        k,  << temporary variable >>                                    01926000
        ds4 = s-4,   << s relative temps >>                             01928000
        ds5 = s-5,                                                      01930000
        ds1 = s-1;                                                      01932000
                                                                        01934000
logical  p2f,   << set if 2nd parameter exists >>                       01936000
         reg;   << set if a register appears in pri' >>                 01938000
                                                                        01940000
integer  token,  << output of char subroutine >>              <<fx1>>   01942000
         inpntr, << index to fetch next char from cmnd string >>        01944000
         i, j, l,  << temporary variables >>                            01946000
         olds,  << s value to reset in fail >>                          01948000
         com,  << command # >>                                          01950000
         cst,  << cst value for b and c commands >>                     01952000
         p,  << p value for above >>                                    01954000
         clkcr,  << cr from clock board >>                              01956000
         cpuclk,  << cpu clock >>                                       01958000
         smp = q-2,  << p from stack marker >>                          01960000
         smsta = q-1;  << status from stack marker >>                   01962000
                                                                        01964000
                                                                        01966000
subroutine  print(c);                                                   01968000
   value c; integer c;                                                  01970000
 begin comment                                                          01972000
                                                                        01974000
this subroutine prints the i/o buffer (io) on the teletype.             01976000
c is a count. its absolute value is the number of characters            01978000
to print. if c >= 0, then the line will be followed by a                01980000
return-linefeed.                                                        01982000
;                                                                       01984000
    put( wrdio, \c\, if c >= 0 then 0 else %320);                       01986000
 end;                                                                   01988000
                                                                        01990000
subroutine  fail;                                                       01992000
    begin  comment                                                      01994000
                                                                        01996000
this is called on a command failure. it cuts the stack                  01998000
back as needed and returns to the command input loop.                   02000000
;                                                                       02002000
    wrdio := "??";                                                      02004000
    print( 2 );  << print error indication >>                           02006000
    tos := olds;  << reset s as required >>                             02008000
    set (  s  );                                                        02010000
    go comin;                                                           02012000
    end;                                                                02014000
                                                                        02016000
                                                                        02018000
subroutine getinput;                                                    02020000
  begin comment                                                         02022000
                                                                        02024000
  << read command into input buffer, input.  first character of         02026000
     command is put into token and a lf is output on the cr.            02028000
     control h and x are processed in this routine.                     02030000
;                                                                       02032000
                                                                        02034000
     get( input, 39, i);                                                02036000
     input(i) := %15;  <<  add a cr to end of buffer   >>               02038000
                                                                        02040000
     <<         delete all blanks        >>                             02042000
     i:=j:=-1;                                                          02044000
     do begin                                                           02046000
       i:=i+1;                                                          02048000
       j:=j+1;                                                          02050000
       while input(j) = " " do j:=j+1;                                  02052000
       input(i):=input(j);                                              02054000
     end until input(i)=%15;                                            02056000
                                                                        02058000
     i := 0;                                                            02060000
     inpntr := 1;                                                       02062000
     token := input;                                                    02064000
  end;   << get input >>                                                02066000
                                                                        02068000
                                                                        02070000
subroutine  char;                                                       02072000
   begin  comment                                                       02074000
                                                                        02076000
this subroutine gets a character from the input buffer and              02078000
places it in token.                                                     02080000
;                                                                       02082000
     token := input(inpntr);                                            02084000
     inpntr := inpntr + 1;                                              02086000
   end;                                                                 02088000
                                                                        02090000
subroutine  numout( n, l, s );                                          02092000
   value  n,l,s;                                                        02094000
   double n;                                                            02096000
   integer l,s;                                                         02098000
begin  comment                                                          02100000
                                                                        02102000
n is the number to print. l is the location in io to place it.          02104000
s is the size in characters for the converted number.                   02106000
;                                                                       02108000
   x := l+s;  << set up the index >>                                    02110000
   tos := n;  << get number >>                                          02112000
   do                                                                   02114000
      begin  << convert one digit >>                                    02116000
      x := x-1;                                                         02118000
      dupl;                                                   <<fx1>>   02120000
      io(x) := (tos land 7) lor %60;                                    02122000
      tos := tos&dasr(3);                                               02124000
      end                                                               02126000
   until  s4 = x;                                                       02128000
   ddel;  << delete n's remains >>                                      02130000
   end;                                                                 02132000
                                                                        02134000
double subroutine octint;                                               02136000
   begin comment                                                        02138000
                                                                        02140000
computes and returns an octal integer. the integer must                 02142000
have between 1 and 6 digits inclusive                                   02144000
;                                                                       02146000
   l := 0;  << zero the digit counter >>                                02148000
   tos := 0d;  << initial value of octint >>                            02150000
   while  %60 <= token <= %67  do                                       02152000
      begin  << get a digit >>                                          02154000
      l := l+1;                                                         02156000
      tos := tos&dcsl(3);                                               02158000
      tos := 0;   << form double value for new digit >>                 02160000
      tos := token-%60;                                                 02162000
      asmb( dadd );                                                     02164000
      char;  << get the next character >>                               02166000
      end;                                                              02168000
   if not( 1 <= l <= 6 ) then  fail;  << too many or too few >>         02170000
   ds4 := tos;  << return the value >>                                  02172000
   end;                                                                 02174000
                                                                        02176000
double subroutine number;                                               02178000
                                                                        02180000
  <<   computes a signed number   >>                                    02182000
                                                                        02184000
   if  token = "-"  then                                                02186000
      begin                                                             02188000
      char;  << get next >>                                             02190000
      number := -octint;                                                02192000
      end                                                               02194000
   else                                                                 02196000
      begin                                                             02198000
      if  token = "+"  then  char;  << ignore it >>                     02200000
      number := octint;                                                 02202000
      end;                                                              02204000
                                                                        02206000
double subroutine cst'addr( cst );                                      02208000
   value cst; integer cst;                                              02210000
   begin  comment                                                       02212000
                                                                        02214000
computes the base address for a segment given the cst.                  02216000
fails if the segment is absent                                          02218000
;                                                                       02220000
   if  abs(abs(0)) < cst  then  fail;  << illegal cst >>      <<fx1>>   02222000
   x := x+cst*cst'size;                                                 02224000
   if  abs(x) < 0  then  fail;  << absent, error >>           <<fx1>>   02226000
   tos := abs(x:=x+2).(14:2);  << get bank >>                 <<fx1>>   02228000
   tos := abs(x:=x+1);  << get address in the bank >>         <<fx1>>   02230000
   ds5 := tos;  << return the value >>                                  02232000
   end;                                                                 02234000
                                                                        02236000
double subroutine pri';                                                 02238000
                                                                        02240000
  <<  computes a pri, see documentation for definition  >>              02242000
                                                                        02244000
   if  "D" <= token <= "Z"  then                                        02246000
      begin << a register is given >>                                   02248000
      reg := true;                                                      02250000
      push(sbank);  << get the stack bank >>                            02252000
      push( db );                                                       02254000
      delb;   << get rid of db bank >>                                  02256000
      if  token = "D"  then                                             02258000
         begin  << dl or db >>                                          02260000
         char;  << get the b or l >>                                    02262000
         if  token = "B"  then                                          02264000
            begin  << db >>                                             02266000
            ddel;  << cut db and sbank >>                               02268000
            tos := olddb;                                               02270000
            tos := 0;   << db rel db >>                                 02272000
            end                                                         02274000
         else  if  token  = "L"  then  push( dl )                       02276000
         else  fail;  << illegal register given >>                      02278000
         end                                                            02280000
      else                                                              02282000
         begin                                                          02284000
         if  token = "Q"  then                                          02286000
            begin  << q >>                                              02288000
            push( q );  << get q >>                                     02290000
            tos := tos+tos;   << make absolute q >>                     02292000
            ldad;  << get delta q from marker >>                        02294000
            tos := -tos;  << build user's q >>                          02296000
            end                                                         02298000
         else  if  token = "S"  then                                    02300000
            begin  << s >>                                              02302000
            push( q );                                                  02304000
            tos := tos-4;                                               02306000
            end                                                         02308000
         else  if  token = "Z"  then  push( z )                         02310000
         else  fail;                                                    02312000
         end;                                                           02314000
      char;  << scan off the register >>                                02316000
      tos := tos+tos;   << change db rel to abs >>                      02318000
      ds4 := tos;  << return the value >>                               02320000
      end                                                               02322000
   else                                                                 02324000
      pri' := number;                                                   02326000
                                                                        02328000
double subroutine sexp;                                                 02330000
                                                                        02332000
  <<    computes a <sexp>    >>                                         02334000
                                                                        02336000
   begin                                                                02338000
   reg := false;                                                        02340000
   tos := pri';  << get a <pri> >>                                      02342000
l: if  token = "+"  then                                                02344000
      begin                                                             02346000
      char;  << scan off + >>                                           02348000
      tos := pri'; if reg then asmb(delb,add)  else  asmb(dadd);        02350000
      go l;                                                             02352000
      end;                                                              02354000
   if  token = "-"  then                                                02356000
      begin                                                             02358000
      char;  << scan off the - >>                                       02360000
      tos := pri'; if reg then asmb(delb,sub)  else  asmb(dsub);        02362000
      go l;                                                             02364000
      end;                                                              02366000
   if  token = "I"  then                                                02368000
      begin  << indirect >>                                             02370000
      char;  << scan off the i >>                                       02372000
      ldad;  << get the address' contents >>                            02374000
      delb; delb;  << cut address >>                                    02376000
      if  reg  then  asmb(ldd olddb; cab,add)  else                     02378000
      asmb( zero,xch );  << form a double >>                            02380000
      go l;                                                             02382000
      end;                                                              02384000
   ds4 := tos;                                                          02386000
   end;                                                                 02388000
                                                                        02390000
double subroutine  exp;                                                 02392000
                                                                        02394000
  <<    computes a <exp>    >>                                          02396000
                                                                        02398000
   begin                                                                02400000
   tos := sexp;                                                         02402000
   if  token = "."  then                                                02404000
      begin                                                             02406000
      dupl;                                                   <<fx1>>   02408000
      cst := s0;                                                        02410000
      char;                                                             02412000
      tos := cst'addr(*);                                               02414000
      tos := sexp;                                                      02416000
      p := s0;                                                          02418000
      asmb(dadd);                                                       02420000
      end;                                                              02422000
   ds4 := tos;                                                          02424000
   end;                                                                 02426000
                                                                        02428000
logical subroutine find;                                                02430000
   begin comment                                                        02432000
                                                                        02434000
this subroutine is used to find entries in the bp'tab. it               02436000
returns true on a successful find. on success, i is set                 02438000
to the 16 bit index of the first word of the table entry.               02440000
;                                                                       02442000
   i := x := 0;                                                         02444000
   do                                                                   02446000
      if  bptab(x).(8:8) = cst  and  bptab(x:=x+1) = p then             02448000
         begin  find := true;  return;  end                             02450000
   until  bptab(i:=i+6) = -1;                                           02452000
   end;                                                                 02454000
                                                                        02456000
subroutine  impcst;                                                     02458000
                                                                        02460000
  <<  checks for an implied cst in the c or b commands  >>              02462000
                                                                        02464000
   if  cst = 0  then                                                    02466000
      begin  << implied cst >>                                          02468000
      cst := smsta.(8:8);                                               02470000
      tos := p1;  delb;  p := tos;                                      02472000
      end;                                                              02474000
                                                                        02476000
subroutine clear;                                                       02478000
                                                                        02480000
  <<  this subroutine is called to clear a breakpoint  >>               02482000
                                                                        02484000
   begin                                                                02486000
   impcst;                                                              02488000
   if  find  then                                                       02490000
      begin  << one exists, zap it >>                                   02492000
      tos := cst'addr( cst )+double( p );                               02494000
      bptab(i) := 0;                                                    02496000
      bptab(x:=x+1) := 0;                                               02498000
      tos := bptab(x:=x+1);  << get the instruction >>                  02500000
      stad;  << restore it in the code >>                               02502000
      ddel;                                                             02504000
      p := p+1;  << take out a possible fake >>                         02506000
      if  find  and  bptab(i).(0:8) = 2  then  clear;                   02508000
      p := p-1;                                                         02510000
      end                                                               02512000
   else  fail;                                                          02514000
   end;                                                                 02516000
                                                                        02518000
subroutine break( a );                                                  02520000
   value a; integer a;                                                  02522000
                                                                        02524000
  << this routine puts in break points.  >>                             02526000
  << the a passed is the type of breakpoint.  >>                        02528000
                                                                        02530000
   begin  << table entry will be built on the stack >>                  02532000
   impcst;                                                              02534000
   tos := 0;  << initialize the constant >>                             02536000
   tos := p2;  << get the address for the test >>                       02538000
   asmb( xch );  << reverse the address for as wanted >>                02540000
   if  p < 0  or  find then fail;  << bad p or already exists >>        02542000
   k := tos := cst'addr( cst )+double( p );                             02544000
   ldad;  << get the instruction to replace >>                          02546000
                                                                        02548000
   if  s7 = 1  then   << a is now at s7 >>                              02550000
      begin  << user breakpoint, check instruction >>                   02552000
      if  s0.(0:4) = %14   then  fail;  << branches >>                  02554000
      if  s0.(0:4) = 3  and  1<=s0.(4:4)<=4 then fail;                  02556000
      if  s0.(0:4) = 1  then                                            02558000
         begin  << check which ones >>                                  02560000
         tos := %117001703d;                                            02562000
         tos := tos&dcsl(s2.(5:5));                                     02564000
         if  <  then  fail;                                             02566000
         ddel;  << kick off magic constant >>                           02568000
         end;                                                           02570000
      << getting to this point says it is o.k. >>                       02572000
      end;                                                              02574000
                                                                        02576000
   asmb( cab,cab );  << put address above instruction >>                02578000
   tos :=tos-double(p)                                        <<fx1>>   02580000
            +double(abs(abs(0)+cst*cst'size).(4:12)*4)-1d;    <<fx1>>   02582000
   << the above monster is the address of pl >>                         02584000
   << check for p in bounds >>                                          02586000
   if  k > ds1  then  fail;                                             02588000
   ldad;  << get stt size >>                                            02590000
   x := tos.(8:8);                                                      02592000
   j :=  i := 0;  << initial pl values >>                               02594000
   do                                                                   02596000
      begin  << search the stt >>                                       02598000
      i := i+1;                                                         02600000
      s0 := s0-1;  << back up address pointer >>                        02602000
      ldad;  << get the label >>                                        02604000
      if  tos = @help  then  j := i;  << found it >>                    02606000
      end                                                               02608000
   until  dxbz;                                                         02610000
   push(status);  if  tos.(8:8) = cst  then  j := @help.(1:7);          02612000
   if  j = 0  then  fail;                                               02614000
   ddel;  << get rid of the address into the stt >>                     02616000
   tos := p;  p := 0;                                                   02618000
   tos := cst;  cst := 0;   << stack the vitals >>                      02620000
   tos.(0:8) := s7;  << a from the call >>                              02622000
   if  not find  then  fail;  << get a zero entry >>                    02624000
   << check for a <lexp> >>                                             02626000
   if  s7 <<a>> = 1  and  p2f  then                                     02628000
      if  token = %15  then                                             02630000
         begin  << just a count >>                                      02632000
         s3.(0:8) := 1;  << set the relop >>                            02634000
         s4 := s5 := integer(p2);  << set count >>                      02636000
         end                                                            02638000
      else                                                              02640000
         begin                                                          02642000
         tos := -1;                                                     02644000
         x := 0;                                                        02646000
         do  if  rel(x) = token  then  s0 := x+2                        02648000
         until  (x:=x+1) = 4;                                           02650000
         if  s0 = -1  then  fail;                                       02652000
         s4.(0:8) := tos;                                               02654000
         char;  << scan off the relop >>                                02656000
         s5 := integer(exp);                                            02658000
         if  token <> %15  then  fail;                                  02660000
         end;                                                           02662000
   x := i;  << set up entry >>                                          02664000
   i := 6;                                                              02666000
   do                                                                   02668000
      begin  << move from stack to table >>                             02670000
      bptab(x) := tos;                                                  02672000
      x := x+1;                                                         02674000
      i := i-1;                                                         02676000
      end                                                               02678000
   until  =;                                                            02680000
   << set up the pcal into the segment >>                               02682000
   tos := k;  << get address >>                                         02684000
   tos := j+%031000;  << form the pcal >>                               02686000
   stad;  << store it >>                                                02688000
   ddel;                                                                02690000
   end;                                                                 02692000
                                                                        02694000
subroutine dum(a);                                                      02696000
   value a;  integer a;                                                 02698000
                                                                        02700000
  <<    helper function for dump and modify   >>                        02702000
                                                                        02704000
   begin                                                                02706000
   numout( p1, 0, 6 );                                                  02708000
   wrdio(3) := ": ";                                                    02710000
   tos := p1;                                                           02712000
   ldad;                                                                02714000
   asmb( zero,xch );  << form into 32 bit value >>                      02716000
   numout( *, s5, 6 );                                                  02718000
   ddel;                                                                02720000
   p1 := p1+1d;                                                         02722000
   p2 := p2-1d;                                                         02724000
   end;                                                                 02726000
                                                                        02728000
subroutine dump;                                                        02730000
                                                                        02732000
  <<    dumps memory locations when called     >>                       02734000
                                                                        02736000
   do                                                                   02738000
      begin  << dump a word >>                                          02740000
      dum(8);                                                           02742000
      print( -14 );                                                     02744000
      i := 0;                                                           02746000
      while  (i:=i+1) < 8  and  p2 > 0d  do                             02748000
         begin                                                          02750000
         dum(2);                                                        02752000
         wrdio := "  ";                                                 02754000
         print(-8);                                                     02756000
         end;                                                           02758000
      print(0);                                                         02760000
      end                                                               02762000
   until  p2 <= 0d;                                                     02764000
                                                                        02766000
subroutine modify;                                                      02768000
                                                                        02770000
  <<    does modifications to memory     >>                             02772000
                                                                        02774000
   do                                                                   02776000
      begin  << do a word >>                                            02778000
      tos := p1;                                                        02780000
      dum(8);                                                           02782000
      wrdio(7) := " _";                                                 02784000
      print( -16 );                                                     02786000
      getinput;   << get modified value >>                              02788000
      tos := exp;  << get the new value >>                              02790000
      delb;  << shorten it >>                                           02792000
      stad;  << store it >>                                             02794000
      ddel;  << delete the address >>                                   02796000
      end                                                               02798000
   until  p2 <= 0d;                                                     02800000
                                                                        02802000
                                                                        02804000
subroutine  exit;                                                       02806000
                                                                        02808000
  <<    returns to the user program     >>                              02810000
                                                                        02812000
   begin                                                                02814000
   tos := olddb;  set(db);                                              02816000
   tos := cpuclk;                                                       02818000
   asmb( sclk );                                                        02820000
   flg'cell:=flg'cell & lsr(2); <<reset trap flags>><<eh8>>             02822000
   tos := p1;  tos := tos+%31400;                                       02824000
   asmb( xeq 0 );  << cut back stacked parameters, exit >>              02826000
   end;                                                                 02828000
                                                                        02830000
<<************** deleted subroutine printioqs **************>><<fx5>>   02832000
                                                              <<fx5>>   02834000
                                                              <<fx5>>   02836000
<<************** start of the procedure body  **************>><<fx5>>   02838000
                                                              <<fx5>>   02840000
dsbl;    << turn off interrupts >>                            <<fx1>>   02842000
flg'cell:=flg'cell & lsl(2); << prevent ctl-a or brk trap>>   <<eh8>>   02844000
<< decide why we stopped >>                                             02846000
tos := 0d;                                                              02848000
push(status);                                                           02850000
dupl;                                                         <<fx1>>   02852000
tos.(2:1) := 0;  set(status);  << turn off the traps >>                 02854000
tos := tos.(8:8);                                                       02856000
tos := cst'addr( * );   tos := tos+@bp'tab;                             02858000
asmb( xchd 0 );  olddb := tos;                                          02860000
p := smp-1;  << get p from stack marker >>                              02862000
cst := smsta.(8:8);  << get the status >>                               02864000
tos := double( p );  tos := double( cst );  << save to print >>         02866000
                                                                        02868000
if  find  then                                                          02870000
   begin  << in the breakpoint table >>                                 02872000
   tos := cst'addr( cst )+double( p );                                  02874000
   smp := p;  << decrement exit address >>                              02876000
   if  bptab(i).(0:8) = 2  then                                         02878000
      begin  << a fake breakpoint >>                                    02880000
      ldad;  << get the pcal from the word >>                           02882000
      j := tos;  << save it >>                                          02884000
      tos := bptab(i+2);                                                02886000
      stad;  << restore the instruction >>                              02888000
      clear;  << remove the fake breakpoint >>                          02890000
      tos := tos-1;                                                     02892000
      tos := j;                                                         02894000
      stad;  << put the pcal back into the location >>                  02896000
out:  tos := olddb;  set(db);  return;                                  02898000
      end;                                                              02900000
   tos := bptab(i+2);  << restore instruction at breakpoint >>          02902000
   stad;  ddel;                                                         02904000
   tos := i;  << save i >>                                              02906000
   p := p+1;  << set a fake breakpoint >>                               02908000
   break( 2 );                                                          02910000
   i := tos;  << restore i >>                                           02912000
   tos := bptab(i+3).(14:2);  << get the bank >>                        02914000
   tos := bptab(x:=x+1);  << get low order 16 bits >>                   02916000
   ldad;  << get test value >>                                          02918000
   tos := bptab(x:=x+1);   << get the constant >>                       02920000
   case  *bptab(i+3).(0:8)  of                                          02922000
      begin  << do the correct test >>                                  02924000
      ddel  << null >>;  << do it >>                                    02926000
         begin                                                          02928000
         x := i+4;                                                      02930000
         bptab(x) := bptab(x)-1;                                        02932000
         if  >  then  go out;  << not counted, so exit >>               02934000
         tos := bptab(x:=x+1);                                          02936000
         bptab(x:=x-1) := tos;  << reset the count >>                   02938000
         ddel;                                                          02940000
         end;                                                           02942000
      if  tos >= tos  then  go out;                                     02944000
      if  tos <> tos  then  go out;                                     02946000
      if  tos <= tos  then  go out;                                     02948000
      if  tos = tos  then  go out;                                      02950000
      end;                                                              02952000
   ddel;                                                                02954000
   end;                                                                 02956000
                                                                        02958000
<< save the clock values >>                                             02960000
tos := clk'drtn;  << read present clock values >>             <<fx1>>   02962000
do                                                                      02964000
   begin                                                                02966000
   tos := %70150;                                             <<fx1>>   02968000
   cio1;                                                      <<fx1>>   02970000
   rio0;                                                      <<fx1>>   02972000
   clkcr := tos;                                              <<fx1>>   02974000
   tio0;                                                      <<fx1>>   02976000
   end                                                                  02978000
until  not tos.(9:1);                                                   02980000
del;                                                                    02982000
asmb( rclk );  cpuclk := tos;                                           02984000
                                                                        02986000
<< print the welcome message >>                                         02988000
print( 0 );  << newline >>                                              02990000
x := 4;  do  wrdio(x) := pre(x)  until  (x:=x-1)<0;                     02992000
numout( *, 5, 3 );                                                      02994000
numout( *, 9, 5 );                                                      02996000
print( 14 );                                                            02998000
push( s );  olds := tos;  << save for fail >>                           03000000
                                                                        03002000
<< command input loop >>                                                03004000
                                                                        03006000
comin:                                                                  03008000
                                                                        03010000
io := "-";  print( -1 );  << print the prompt >>                        03012000
getinput;   << get command string >>                                    03014000
cst := 0;                                                               03016000
x := 5;                                                                 03018000
do                                                                      03020000
   begin                                                                03022000
   if comm(x) = token  then  go fnd;                                    03024000
   x := x-1;                                                            03026000
   end                                                                  03028000
until <;                                                                03030000
fail;  << illegal command >>                                            03032000
                                                                        03034000
fnd:  << legal command if you get here >>                               03036000
                                                                        03038000
com := x;  << save the command >>                                       03040000
char;  << scan off the command >>                                       03042000
p1 := 0d;                                                               03044000
if  com<>4  then                                                        03046000
   begin  << get the parameters >>                                      03048000
   p1 := exp;                                                           03050000
   p2 := 0d;                                                            03052000
   p2f := false;                                                        03054000
   if  token = ","  and  com <> 1 then                                  03056000
      begin  << get a second parameter >>                               03058000
      char;                                                             03060000
      p2 := exp;                                                        03062000
      p2f := true;                                                      03064000
      end;                                                              03066000
   end                                                                  03068000
else  if  token <> %15  then                                            03070000
   begin  << get stack cut back parameter >>                            03072000
   p1 := sexp;                                                          03074000
   if  p1 > 255d  then  fail;                                           03076000
   end;                                                                 03078000
                                                                        03080000
if  token <> %15  and  com <> 0  then  fail;  << error >>               03082000
                                                                        03084000
case  *com  of                                                          03086000
   begin                                                                03088000
   break( 1 );                                                          03090000
   clear;                                                               03092000
   dump;                                                                03094000
   modify;                                                              03096000
   exit;                                                                03098000
               <<***** deleted printioqs *****>>              <<fx5>>   03100000
   end;                                                                 03102000
go comin;                                                               03104000
end;  << help >>                                                        03106000
                                                                        03108000
$page                                                                   03110000
                                                                        03112000
logical procedure binary (string, length);                              03114000
   value length;                                                        03116000
<< input parameters: >>                                                 03118000
   byte array string;        <<ascii string to be converted>>           03120000
   integer length;           <<length of string>>                       03122000
   option privileged;                                                   03124000
comment                                                                 03126000
                                                                        03128000
function:                                                               03130000
   convert <string> to 1 binary word.                                   03132000
   octal conversion if string(0) = "%"                                  03134000
   (signed) decimal conversion if string(0) = "+", "-",                 03136000
   of digit.                                                            03138000
                                                                        03140000
returns:                                                                03142000
   cce- successful completion.                                          03144000
   ccg- overflow, including too many characters.                        03146000
   ccl- illegal character, including "8", and "9" for octal.            03148000
;                                                                       03150000
begin                                                                   03152000
   logical result:=0, base:=10;                               <<fx1>>   03154000
   integer lim := %71, pntr = x;                                        03156000
<< code >>                                                              03158000
   if length <> 0 then                                                  03160000
      begin                                                             03162000
        if < then goto setoverflow;                                     03164000
        if length > 8 then goto setoverflow;                            03166000
      end;                                                              03168000
   x:=0;                                                      <<fx1>>   03170000
   if string = "%" then                                                 03172000
      begin                                                             03174000
      lim:="7";                                               <<fx1>>   03176000
      base:=8;                                                <<fx1>>   03178000
      end                                                               03180000
   else if string <> "+" then                                           03182000
         if string = "-" then lim := %72                                03184000
         else x:=-1;                                          <<fx1>>   03186000
   push (status);                                                       03188000
   tos.(2:1) := 0;                                                      03190000
   set (status);                                                        03192000
   while (pntr:=pntr+1) < length do                           <<fx1>>   03194000
      begin                                                             03196000
      tos:=result*base;                                       <<fx1>>   03198000
      if carry then goto setoverflow;                                   03200000
      tos:=string(pntr);                                      <<fx1>>   03202000
      if <= then goto setbadchar;                                       03204000
      dupl;                                                   <<fx1>>   03206000
      if tos > lim then goto setbadchar;                                03208000
      result:=tos.(12:4)+tos;                                 <<fx1>>   03210000
      if carry then goto setoverflow;                                   03212000
      end;                                                              03214000
   if lim >= "9" then    <<a decimal conversion>>                       03216000
      if result > 32768 then goto setoverflow                           03218000
      else if = then    <<better be negative>>                          03220000
            if lim = "9" then goto setoverflow                          03222000
            else   <<smallest negative number>>                         03224000
         else if lim = %72 then result:=-result;              <<fx1>>   03226000
   binary:=result;                                            <<fx1>>   03228000
   tos := cce;                                                          03230000
exit:                                                                   03232000
   cc := tos;                                                           03234000
   return;     <<   return to user with condition code    >>            03236000
setoverflow:                                                            03238000
   tos := ccg;                                                          03240000
   goto exit;                                                           03242000
setbadchar:                                                             03244000
   tos := ccl;                                                          03246000
   goto exit;                                                           03248000
end  <<binary>>;                                                        03250000
$page                                                                   03252000
                                                                        03254000
                                                                        03256000
integer procedure ascii (word, string, base);                   <<1.01>>03258000
   value word, base;                                                    03260000
<< input parameters: >>                                                 03262000
   logical word;             <<word to be converted>>                   03264000
   integer base;          <<8 (octal), or 10 (signed decimal)>>         03266000
<< output parameters: >>                                                03268000
   byte array string;<<result. provide room for at least 6 byt>>        03270000
   option privileged,variable;                                  <<1.01>>03272000
comment                                                                 03274000
                                                                        03276000
function:                                                               03278000
   convert <word> to ascii.  for base= 10, perform signed               03280000
   decimal conversion (string(0) = "-", if necessary).  >>              03282000
;                                                                       03284000
begin                                                                   03286000
   byte array temp (0:5) = q;                                           03288000
   integer wordd  = word,                                     <<fx1>>   03290000
           length = q-7;                                      <<fx1>>   03292000
                                                              <<fx1>>   03294000
   logical flags := 0;                                        <<fx1>>   03296000
   logical pmap=q-4;                                                    03298000
   define  start  = flags.(15:1) #,                           <<fx1>>   03300000
           rtjust = flags.(14:1) #;                           <<fx1>>   03302000
                                                                        03304000
                                                                        03306000
<< main code >>                                                         03308000
   if not pmap then base:=10; <<base 10 default>>                       03310000
   if base <> 8 then                                                    03312000
      begin                                                             03314000
      if base <> 10 then                                                03316000
         begin    <<rt justify request>>                                03318000
         if base <> -10 then return;                                    03320000
         rtjust := true;                                                03322000
         base := 10;                                                    03324000
         end;                                                           03326000
      if wordd < 0 then                                                 03328000
         begin                                                          03330000
         push (status);                                                 03332000
         assemble (trbc 2);                                             03334000
         set (status);                                                  03336000
         wordd:=-wordd;                                       <<fx1>>   03338000
         if overflow then                                               03340000
            begin                                                       03342000
            move temp := "-32768";                                      03344000
            x := 0;                                           <<fx1>>   03346000
            goto setup;                                                 03348000
            end;                                                        03350000
         start := true;                                                 03352000
         end;                                                           03354000
      tos:=wordd;                                             <<fx1>>   03356000
      x := 6;                                                 <<fx1>>   03358000
      do begin                                                          03360000
         tos := base;                                                   03362000
         assemble (div, decx);                                          03364000
         temp(x) := tos +%60;                                 <<fx1>>   03366000
         assemble (test);                                               03368000
         end                                                            03370000
      until =;                                                          03372000
      if start then temp (x := x -1) := "-";                  <<fx1>>   03374000
setup:                                                                  03376000
      << x = left byte of result in temp >>                   <<fx1>>   03378000
      length := 6 -x;                                         <<fx1>>   03380000
      tos := @string;    <<setup for move>>                             03382000
      tos := @temp;                                                     03384000
      if rtjust then                                                    03386000
         begin    <<rt justification>>                                  03388000
         tos := tos +5;                                                 03390000
         tos := -length;                                                03392000
         end                                                            03394000
      else                                                              03396000
         begin    <<left justify>>                                      03398000
         tos := tos +x;                                       <<fx1>>   03400000
         tos := length;                                                 03402000
         end;                                                           03404000
      << s-0 = length 4 bound. check >>                                 03406000
      << (s-3):(s-1) = move setup >>                                    03408000
      assemble (mvb);                                                   03410000
      end                                                               03412000
   else                                                                 03414000
      begin    <<octal>>                                                03416000
      x := 5;                                                 <<fx1>>   03418000
      length := 1;                                                      03420000
      tos:=word;                                              <<fx1>>   03422000
      do begin                                                          03424000
         assemble(dup);                                       <<fx1>>   03426000
         tos := tos land 7;                                             03428000
         if <> then length := 6 -x;                           <<fx1>>   03430000
         string (x) := tos + %60;                             <<fx1>>   03432000
         tos := tos & lsr(3);                                           03434000
         x := x -1;                                           <<fx1>>   03436000
         end                                                            03438000
      until <;                                                          03440000
      end;                                                              03442000
                                                                        03444000
end  <<ascii>>;                                                         03446000
                                                                        03448000
                                                                        03450000
$page                                                                   03452000
<<**********************************************************>>          03454000
<< changedevice is a dummy procedure that is called by      >>          03456000
<<  sadutil for the hp-ib but is not used for series iii    >>          03458000
<<  set cc to good return.                                  >>          03460000
<<**********************************************************>>          03462000
                                                                        03464000
procedure changedevice;                                                 03466000
  begin                                                                 03468000
    cc:=cce;                                                            03470000
  end;                                                                  03472000
                                                                        03474000
procedure message(messnum);                                             03476000
  value messnum;                                                        03478000
  integer messnum;                                                      03480000
  begin                                                                 03482000
  end;                                                                  03484000
                                                                        03486000
<<**********************************************************>>          03488000
<<                                                          >>          03490000
<<             double binary procedure                      >>          03492000
<<                                                          >>          03494000
<<**********************************************************>>          03496000
                                                                        03498000
                                                                        03500000
                                                                        03502000
double procedure dbinary(string,length);                                03504000
   value length;  byte array string; integer length;                    03506000
   option privileged;                                                   03508000
begin                                                                   03510000
      logical stat = q-1;                                               03512000
      integer top = s-0;                                                03514000
      integer i:=0;                                                     03516000
      double topd = s-1;                                                03518000
      begin                                                             03520000
            if length=0 then                                            03522000
               begin  tos:=0d;                                          03524000
                      go to skip;                                       03526000
               end;                                                     03528000
            if length > 12 then go to err1;                             03530000
      end;                                                              03532000
      tos:=0d;                                                          03534000
      if string = "%" then                                              03536000
      begin if (length = 12) and (string(1) > %63) then go to err1;     03538000
            while (i:=i+1) < length do                                  03540000
            begin assemble(dlsl 3);                                     03542000
                  tos:=logical(string(i)) - %60;                        03544000
                  if (top>7) or (top<0) then go to err2;                03546000
                  assemble(or)                                          03548000
            end                                                         03550000
      end                                                               03552000
      else                                                              03554000
      begin push(status);                                               03556000
            assemble(trbc 2);                                           03558000
            set(status);                                                03560000
            if (string <> "+") and (string <> "-") then i:=i - 1;       03562000
            while (i:=i+1) < length do                                  03564000
            begin if topd >= %2000000000d then go to err1;              03566000
                  assemble(dlsl 1; ddup; dlsl 2; dadd);                 03568000
                  if overflow then go to err1;                          03570000
                  tos:=0;                                               03572000
                  tos:=logical(string(i)) - %60;                        03574000
                  if (top>9) or (top<0) then go to err2;                03576000
                  assemble(dadd);                                       03578000
                  if overflow then                                      03580000
                  begin if topd <> %20000000000d then go to err1;       03582000
                        if string <> "-" then go to err1;               03584000
                        go to skip                                      03586000
                  end                                                   03588000
            end;                                                        03590000
            if string = "-" then assemble(dneg);                        03592000
      end;                                                              03594000
skip: dbinary:=tos;                                                     03596000
      cc:=cce;                                                          03598000
exit:                                                                   03600000
   return;                                                              03602000
err1: cc:=ccg;                                                          03604000
   goto exit;                                                           03606000
err2: cc:=ccl;                                                          03608000
   goto exit;                                                           03610000
end  << dbinary >>;                                                     03612000
                                                                        03614000
$page                                                                   03616000
<<**********************************************************>>          03618000
<<                                                          >>          03620000
<<                     double ascii                         >>          03622000
<<                                                          >>          03624000
<<**********************************************************>>          03626000
                                                                        03628000
                                                                        03630000
                                                                        03632000
integer procedure dascii(word,base,string);                             03634000
   value word,base;                                                     03636000
   double word; integer base;                                           03638000
   byte array string;                                                   03640000
   option privileged;                                                   03642000
begin logical snflg:=false;                                             03644000
      integer j;                                                        03646000
      byte array lstring(0:10);                                         03648000
      integer length = q-8;                                             03650000
      logical k=s-0;                                                    03652000
      double top=s-1;                                                   03654000
      j:=11;                                                            03656000
      tos:=word;                                                        03658000
      if (-8<=base<=8) then  <<octal conversion>>                       03660000
      begin length:=1;                                                  03662000
            move lstring:="          0";                                03664000
            while (j:=j-1) >= 0 do                                      03666000
            begin tos:=k land 7;                                        03668000
                  if <> then length:=11-j;                              03670000
                  if s1 <> 0 then lstring(j):=tos+%60 else delete;      03672000
                  tos:=tos & dlsr(3);                                   03674000
            end;                                                        03676000
            if base < 0 then  <<left justify significant octades>>      03678000
            begin                                                       03680000
                 tos:=length;                                           03682000
                 j:=11-length;                                          03684000
            end else                                                    03686000
            begin                                                       03688000
                 tos:=11;                                               03690000
                 j:=j + 1;                                              03692000
            end;                                                        03694000
            go to finish                                                03696000
      end;                                                              03698000
      assemble(dtst);                                                   03700000
      if = then                                                         03702000
      begin lstring(10):=%60;                                           03704000
            tos:=(length:=1);                                           03706000
            j:=10;                                                      03708000
            go to finish                                                03710000
      end;                                                              03712000
      if < then                                                         03714000
      begin snflg:=true;                                                03716000
            if top <> %20000000000d then assemble(dneg);                03718000
      end;                                                              03720000
loop:                                                                   03722000
      j:=j - 1;                                                         03724000
      assemble(zero,cab);                                               03726000
      tos:=10;                                                          03728000
      assemble(divl,cab);                                               03730000
      tos:=10;                                                          03732000
      assemble(divl);                                                   03734000
      lstring(j):=tos + %60;                                            03736000
      assemble(dtst);                                                   03738000
      if = then                                                         03740000
      begin if snflg then                                               03742000
            begin j:=j - 1;                                             03744000
                  lstring(j):="-";                                      03746000
            end;                                                        03748000
            tos := (length:=11-j);                                      03750000
finish:                                                                 03752000
            move string:=lstring (j), (s0);                             03754000
            return;                                                     03756000
      end;                                                              03758000
      go to loop                                                        03760000
end   << dascii >>;                                                     03762000
                                                                        03764000
$page                                                                   03766000
<<**********************************************************>>          03768000
<< print prints out a message to either the console or to   >>          03770000
<< the lineprinter depending on the value of outputmode.    >>          03772000
<< the procedure putfast and put is called to do the actual >>          03774000
<< driver work.                                             >>          03776000
<<**********************************************************>>          03778000
                                                                        03780000
procedure print(message,length,type);                                   03782000
  value length,type;                                                    03784000
  integer length,type;                                                  03786000
  byte array message;                                                   03788000
                                                                        03790000
  begin                                                                 03792000
                                                                        03794000
                                                                        03796000
    <<change hpib types to series iii types.  in out simple >>          03798000
    << terminal driver, 0 is crlf and nocrlf is all else    >>          03800000
                                                                        03802000
    if type=%201                                                        03804000
       then type:=0;                                                    03806000
                                                                        03808000
    if outputmode=console                                               03810000
       then put(message,-length,type)                                   03812000
       else putfast(message,-length,0);                                 03814000
end;                                                                    03816000
                                                                        03818000
                                                                        03820000
$page                                                                   03822000
<<**********************************************************>>          03824000
<<  read reads from the console by calling the procedure get>>          03826000
<<  the expected length is sent to get as positive bytes.   >>          03828000
<<**********************************************************>>          03830000
                                                                        03832000
integer procedure read(message,expectedl);                              03834000
  value expectedl;                                                      03836000
  integer expectedl;                                                    03838000
  byte array message;                                                   03840000
  begin                                                                 03842000
    integer length; <<actual length of read, returned by get>>          03844000
                                                                        03846000
    expectedl:= if expectedl < 0                                        03848000
                   then -expectedl                                      03850000
                   else expectedl * 2;                                  03852000
    get(message,expectedl,length);                                      03854000
    read:=length;  <<return value of procedure              >>          03856000
  end;                                                                  03858000
                                                                        03860000
$page                                                                   03862000
<<**********************************************************>>          03864000
<< mhinfo simulates an array because the rl cannot have     >>          03866000
<< global arrays.  therefore, mhinfo accesses a pb relative >>          03868000
<< array and returns the value specified by index.          >>          03870000
<<**********************************************************>>          03872000
                                                                        03874000
integer procedure mhinfo(index);                                        03876000
  value index;                                                          03878000
  integer index; <<index value into the array.              >>          03880000
                                                                        03882000
  begin                                                                 03884000
    integer array mhinfo'pb(0:nmhsubtypes*mhinfosize-1)=pb:=            03886000
         200,203, 1,48,2,0, 48,12,6144,    0, << 7900 remov >>          03888000
         200,203, 1,48,2,2, 48,12,6144,    0, << 7900 fixed >>          03890000
         200,203, 2,48,2,0, 96,16,6144,    0, << 7900 both  >>          03892000
         400,406,20,23,1,0,460,32,2944,    0, << iss        >>          03894000
         400,411, 2,48,1,0, 96,20,6144,%7502, << 7905 remov >>          03896000
         400,411, 1,48,1,2, 48,16,6144,%7501, << 7905 fixed >>          03898000
         400,411, 3,48,1,0,144,24,6144,%7503, << 7905 both  >>          03900000
         120,125, 3,48,1,0,144,16,6144,%7503, << 7905 fh sim>>          03902000
         815,823, 5,48,1,0,240,32,6144,%7503, << 7920       >>          03904000
         815,823, 9,64,1,0,576,64,8192,%7503; << 7925       >>          03906000
                                                                        03908000
    mhinfo:=mhinfo'pb(index);                                           03910000
  end;                                                                  03912000
                                                                        03914000
<<**********************************************************>>          03916000
<< logical equivilence of mhinfo is mhinfol                 >>          03918000
<<**********************************************************>>          03920000
                                                                        03922000
logical procedure mhinfol(index);                                       03924000
  value index;                                                          03926000
  integer index;                                                        03928000
  begin                                                                 03930000
    mhinfol:=logical(mhinfo(index));                                    03932000
  end;                                                                  03934000
                                                                        03936000
                                                                        03938000
$page                                                                   03940000
<<**********************************************************>>          03942000
<<                                                          >>          03944000
<< below are all the tape driver routines needed to complete>>          03946000
<< tape i/o requests.  these were taken directly out of    >>           03948000
<< the old series iii version of sadutil.                   >>          03950000
<<                                                          >>          03952000
<<**********************************************************>>          03954000
                                                                        03956000
  integer procedure tapesio(addr);                                      03958000
    value addr;                                                         03960000
    logical addr;                                                       03962000
      begin                                                             03964000
        integer status=tapesio;                                         03966000
          tos := tapedrt;                                               03968000
          tos := addr;                                                  03970000
  dosio:  assemble(sio 1; bl *-1);                                      03972000
          if > then                                                     03974000
            begin  <<cmd rejected>>                                     03976000
              if tos.(2:1) then                                         03978000
                begin  <<interrupt>>                                    03980000
                  tos := %40000;                                        03982000
                  assemble(cio 2; bl *-1);                              03984000
                end;                                                    03986000
              goto dosio;                                               03988000
            end;                                                        03990000
  test:   assemble(tio 0; bl *-1);                                      03992000
          status := s0;                                                 03994000
          if tos.(2:1) then                <<interrupt on last  oper>>  03996000
            begin  <<interrupt>>                                        03998000
              tos := %40000;                                            04000000
              assemble(cio 1; bl*-1);                                   04002000
              if status.(3:2)=0 then return;                            04004000
            end;                                                        04006000
          goto test;                                                    04008000
      end << tapesio >>;                                                04010000
$page                                                                   04012000
logical procedure testio(drt,mask);                                     04014000
  value drt,mask;                                                       04016000
  integer drt;                                                          04018000
  logical mask;                                                         04020000
  option forward;                                                       04022000
                                                                        04024000
procedure tape'ready'check;                                             04026000
begin                                                                   04028000
                                                                        04030000
  logical tapestatus,ioresult;                                          04032000
  array lbufw(0:10);                                                    04034000
  array lbuf(*)=lbufw;                                                  04036000
  define wrfld=(6:1)#;                                                  04038000
                                                                        04040000
                                                                        04042000
logical subroutine tape'wait'status(iomask,waitmask,waitval);           04044000
value iomask,waitmask,waitval;                                          04046000
logical iomask,waitmask,waitval;                                        04048000
begin                                                                   04050000
     <<waitval must be non-zero>>                                       04052000
     ioresult:=0;  <<dummy testio result>>                              04054000
     while (ioresult land waitmask) <> waitval do                       04056000
     ioresult:=testio(tapedrt,iomask);                                  04058000
     tape'wait'status:=ioresult;                                        04060000
end <<tape'wait'status>>;                                               04062000
                                                                        04064000
subroutine program'master'clear;                                        04066000
begin                                                                   04068000
     tos:=tapedrt;  << tape drt # >>                                    04070000
     tos:=%100000;  << command control word >>                          04072000
     assemble(cio 1;bl *-1;del);  << prog. master clear >>              04074000
     while testio(tapedrt,%100000) = 0 do;  <<wait for sio ready>>      04076000
end <<program'master'clear>>;                                           04078000
                                                                        04080000
     program'master'clear;                                              04082000
     << test for write ring >>                                          04084000
     tapestatus:=tape'wait'status(%15600,%14600,%600);                  04086000
     if tapestatus.wrfld then      << no write ring >>                  04088000
     begin                                                              04090000
          move lbuf:=" NO WRITE RING";                                  04092000
          print(lbufw,-14,0);                             <<01.01>>     04094000
     end;                                                               04096000
     << test for unit 0, online, and bot >>                             04098000
     tape'wait'status(%15600,%15600,%600);                              04100000
     program'master'clear;                                              04102000
end <<tape'ready'check>>;                                               04104000
$page                                                                   04106000
                                                                        04108000
                                                                        04110000
                                                                        04112000
  procedure tapectrl(control);                                          04114000
    value control;                                                      04116000
    integer control;   <<control word>>                                 04118000
    comment                                                             04120000
      outputs a control word to the system tape drive;                  04122000
      begin                                                             04124000
        equate siocntrl  =    %40000,  <<sio control instruction>>      04126000
               sioend    =    %34000;                                   04128000
        define int       =    (2:1)#,      <<interrupt bit>>            04130000
               unit      =    (3:2)#,      <<current unit bits>>        04132000
               ready     =    tos.(7:1)#;  <<unit ready>>               04134000
        array lbufw(0:64);                                              04136000
        byte array lbuf(*)=lbufw;                                       04138000
        integer dbval;                                                  04140000
        logical array s(0:5)=q;                                         04142000
        logical tstatus;                                       <<00.01>>04144000
                                                                        04146000
          push(db);                                                     04148000
          dbval:=tos;                                                   04150000
          delete;                                                       04152000
          cc:=cce;                                                      04154000
          s := siocntrl;                                                04156000
          s(1) := 0;                                                    04158000
          s(2) := siocntrl;                                             04160000
          s(3) := control;                                              04162000
          s(4) := if control=%10 then %30000 else sioend;               04164000
          s(5) := 0;                                                    04166000
          tos := 0;                                                     04168000
          tos := dbval+@s;                                              04170000
          tstatus := tapesio(*);                               <<00.01>>04172000
          if tstatus.(5:1) then  <<eot detected>>              <<00.01>>04174000
          begin                                                <<00.01>>04176000
               cc:=ccg;                                        <<00.01>>04178000
               return;                                         <<00.01>>04180000
          end;                                                 <<00.01>>04182000
          if tstatus.(12:3) <> 7 then                          <<00.01>>04184000
            begin                                                       04186000
              move lbuf:=" DUMP TAPE MUST BE ON DRT 6,UNIT 0";          04188000
              print(lbufw,-34,0);                              <<01.01>>04190000
              cc:=ccl;                                                  04192000
            end;                                                        04194000
      end << tapectrl >>;                                               04196000
                                                                        04198000
$page                                                                   04200000
                                                                        04202000
integer procedure tapeio(iofunct,buf,words);                            04204000
value iofunct,words;                                                    04206000
array buf;      <<core buffer>>                                         04208000
integer iofunct,words;                                                  04210000
     <<  reads/write a record of length words from the system           04212000
         mag tape into the core buffer buf.                             04214000
         iofunct = 0: read                                              04216000
         iofunct = 1: write.                                            04218000
     >>                                                                 04220000
begin                                                                   04222000
     equate siocntrl  =    %40000,  <<sio control instruction>>         04224000
            sioend    =    %34000,  <<sio end with interrupt>>          04226000
            siores    =    %10000,  <<return residue>>                  04228000
            bscom     =    %12,     <<tape backspace command>>          04230000
            gapcom    =    %5,      <<tape gap command>>       <<00898>>04232000
            rdrcom    =    %6,      <<tape read record command>>        04234000
            wrrcom    =    %4;      <<tape write rec ord command>>      04236000
     define eoffld    =    (11:1)#, <<end of file>>                     04238000
            resfld    =    (12:3)#; <<residue>>                         04240000
     array lbufw(0:64);                                                 04242000
     array lbuf(*)=lbufw;                                               04244000
     integer sdb;                                                       04246000
     logical tstatus;                                                   04248000
     integer errcnt:=0;             <<number of tape errors>>           04250000
     logical array s(0:9)=q;                                            04252000
                                                                        04254000
     cc:=cce;                                                           04256000
     push(db);                                                          04258000
     sdb:=tos;                                                          04260000
     delete;                                                            04262000
again:                                                                  04264000
     s := siocntrl;                                                     04266000
     s(1) := 0;                                                         04268000
     s(2) := siocntrl;                                                  04270000
     if iofunct = readt then                                            04272000
        s(3):=rdrcom                                                    04274000
     else                                                               04276000
        s(3):=wrrcom;                                                   04278000
     tos := words;                                                      04280000
     if = then return;   <<no transfer>>                                04282000
     if iofunct = readt then                                            04284000
        s(4):=(-tos) cat 0(0:15:1)                                      04286000
     else                                                               04288000
        s(4):=(-tos) cat 6(0:12:4);                                     04290000
     if words=4096 then     <<special case>>                            04292000
        s(4).(4:12):=0;                                                 04294000
     s(5):=sdb + @buf;                                                  04296000
     s(6) := siores;                                                    04298000
     s(7) := 0;                                                         04300000
     s(8) := sioend;                                                    04302000
     s(9) := 0;                                                         04304000
     tstatus := tapesio(@s+sdb);                                        04306000
     tos := words;                                                      04308000
     tos := s(7);                                                       04310000
     assemble(neg; lsl 4; lsr 4; neg,add);                              04312000
     tapeio := tos;  <<# of words read>>                                04314000
     if not tstatus.(7:1) then                                          04316000
     begin                                                              04318000
          move lbuf:=" UNIT WENT OFF LINE";                             04320000
          print(lbufw,-18,0);                                  <<01.01>>04322000
          cc:=ccl;                                                      04324000
          return;                                                       04326000
     end;                                                               04328000
     if tstatus.(5:1) then                                              04330000
     begin  <<eot>>                                                     04332000
          cc:=ccg;                                                      04334000
          return;                                                       04336000
     end;  <<eot>>                                                      04338000
     move lbufw:=10(%020040);                                  <<01.01>>04340000
     case *tstatus.resfld of                                            04342000
     begin                                                              04344000
          move lbuf:=" NOT READY INTERRUPT";                            04346000
          move lbuf:=" TRANSFER ERROR";<<1>>                            04348000
          move lbuf:=" CMD. REJECT";   <<2>>                            04350000
          move lbuf:=" TAPE RUN AWAY"; <<3>>                            04352000
          begin                                                         04354000
               if (errcnt:=errcnt+1)>=10 then                           04356000
               begin                                                    04358000
                    move lbuf:=" TIMING ERROR";                         04360000
                    print(lbufw,-13,0);                        <<01.01>>04362000
                    cc:=ccl;                                            04364000
                    return;                                             04366000
               end;                                                     04368000
               go bs;                                                   04370000
          end;                                                          04372000
          begin                                                         04374000
               if (errcnt:=errcnt+1)>=10 then                           04376000
               begin                                                    04378000
                    move lbuf:=" TAPE PARITY ERROR";                    04380000
                    print(lbufw,-18,0);                        <<01.01>>04382000
                    cc:=ccl;                                            04384000
                    return;                                             04386000
               end;                                                     04388000
          bs:  tapectrl(bscom);                                         04390000
               tapectrl(gapcom);                               <<00898>>04392000
               go again;                                                04394000
          end;                                                          04396000
          move lbuf:=" NO SUCH CODE";                                   04398000
          return;                                                       04400000
     end; <<of cases>>                                                  04402000
     if tstatus.resfld<>7 then     <<error on tape>>                    04404000
     begin                                                              04406000
          print(lbufw,-20,0);                                  <<01.01>>04408000
          cc:=ccl;                                                      04410000
     end;                                                               04412000
end << tapeio >>;                                                       04414000
$page  " HP 7976 TAPE DRIVER AND UTILITIES "                   <<02657>>04416000
procedure sioproc ( devnr, chanadr );                          <<02657>>04418000
   value devnr, chanadr;                                       <<02657>>04420000
   integer devnr, chanadr;                                     <<02657>>04422000
begin                                                          <<02657>>04424000
   cc := cce;                                                  <<02657>>04426000
   mb0 := 0;                 << siop code >>                   <<02657>>04428000
   mb1 := devnr;             << channel device >>              <<02657>>04430000
   mb3 := chanadr;           << address of channel prog. >>    <<02657>>04432000
            << start up imb adapter >>                         <<02657>>04434000
   tos := adapterdrt;        << imb adapter dev # >>           <<02657>>04436000
   tos := -1;                                                  <<02657>>04438000
   sio1;                                                       <<02657>>04440000
   do until mb4 < 0; << wait for adapter to accept siop >>     <<02657>>04442000
   if mb4 then                                                 <<02657>>04444000
      begin                                                    <<02657>>04446000
        cc := if mb4.(5:1) then ccl else ccg;                  <<02657>>04448000
      end;                                                     <<02657>>04450000
end;  << end siop >>                                           <<02657>>04452000
                                                               <<02657>>04454000
                                                               <<02657>>04456000
procedure initproc ( channr );                                 <<02657>>04458000
   value channr;                                               <<02657>>04460000
   integer channr;                                             <<02657>>04462000
begin                                                          <<02657>>04464000
   cc := cce;                                                  <<02657>>04466000
   mb0 := 6;                                                   <<02657>>04468000
   mb1 := channr;            << channel nr. >>                 <<02657>>04470000
   mb4 := 0;                 << i/o status >>                  <<02657>>04472000
   tos := adapterdrt;        << imb adapter dev # >>           <<02657>>04474000
   tos := -1;                << sio pointer >>                 <<02657>>04476000
   sio1;                                                       <<02657>>04478000
   do until mb4 < 0;      << wait for adapter to respond >>    <<02657>>04480000
   if mb4 then cc := ccl;                                      <<02657>>04482000
end;   << end initproc >>                                      <<02657>>04484000
$page                                                                   04486000
<<    ********************************************     >>               04488000
<<    *                                          *     >>               04490000
<<    *   mag tape driver procedure  -  mtdvr76  *     >>               04492000
<<    *            hp 7976 driver                *     >>               04494000
<<    *                                          *     >>               04496000
<<    ********************************************     >>               04498000
<<                                                     >>               04500000
                                                                        04502000
                                                                        04504000
double procedure mtdvr76( function, drtunit, addr, length);             04506000
                                                                        04508000
<<    this procedure initiates and completes i/o requests    >>         04510000
<<    for the hp 7976 magnetic tape connected to the series  >>         04512000
<<    iii starfish.                                          >>         04514000
                                                                        04516000
  value function, drtunit, addr, length;                                04518000
  integer function, drtunit, length;                                    04520000
  double addr;                                                          04522000
  option privileged, uncallable;                                        04524000
                                                                        04526000
                                                                        04528000
  begin                                                                 04530000
<<                                                                      04532000
                                                                        04534000
                                                                        04536000
count - +word or -byte count.  note - if byte count is specified, the   04538000
        transmission log will reflect the actual transfer length, but   04540000
        if word count is specified for a read or back-read operation,   04542000
        odd byte transfers will be rounded up in the transmission log   04544000
        returned.                                                       04546000
                                                                        04548000
                                                                        04550000
                                                                        04552000
mag tape controller status                                              04554000
                                                                        04556000
  bits         use                                                      04558000
                                                                        04560000
    0     end of file                                                   04562000
                                                                        04564000
    1     beginning of tape                                             04566000
    2     end of tape                                                   04568000
    3     single track error (not logged for reads)                     04570000
                                                                        04572000
    4     command reject                                                04574000
    5     file protect                                                  04576000
    6     multiple track error                                          04578000
                                                                        04580000
    7     unit online                                                   04582000
    8     gcr (6250 bpi) mode                                     1.00  04584000
    9     reserved                                                1.00  04586000
                                                                        04588000
   10     reserved                                                1.00  04590000
   11     timing error                                                  04592000
   12     tape runaway                                                  04594000
                                                                        04596000
   13     rewinding       *                                             04598000
   14     reserved        **  (reported as unit not ready)        1.00  04600000
   15     interface busy  *                                             04602000
>>                                                                      04604000
                                                                <<1.00>>04606000
<< word 2 of status                                               1.00  04608000
                                                                  1.00  04610000
  bits         use                                                1.00  04612000
                                                                  1.00  04614000
    0     reserved                                                1.00  04616000
                                                                  1.00  04618000
    1     reserved                                                1.00  04620000
    2     power has been restored                                 1.00  04622000
    3     parity error                                            1.00  04624000
                                                                  1.00  04626000
    4     position unrecovered                                    1.00  04628000
    5     fcu/mtu error (isolation)                               1.00  04630000
    6     interface controller unit error(isolation incl fcu s.m.)1.00  04632000
                                                                  1.00  04634000
    7     interface controller unit error(isolation incl phi s.m.)1.00  04636000
    8-10  error details (binary)                                  1.00  04638000
          000 null code                                           1.00  04640000
          010 fcu/mtu reject                                      1.00  04642000
          110 protocol reject                                     1.00  04644000
          001 timeout reject                                      1.00  04646000
          101 prior error reject                                  1.00  04648000
          011 rom parity reject                                   1.00  04650000
          111 data parity error                                   1.00  04652000
    11-15 retry count                                             1.00  04654000
                                                                  1.00  04656000
   word 3 of status=additional info on specific error encountered 1.00>>04658000
$page                                                                   04660000
  equate                                                                04662000
                                                                        04664000
                                                                        04666000
                                                                        04668000
       << mag tape commands >>                                          04670000
                                                                        04672000
    backreadcmd  = %17,                                                 04674000
    bsfilecmd    = %14,                                                 04676000
    bsrecordcmd  = %12,                                                 04678000
    fsfilecmd    = %13,                                                 04680000
    fsrecordcmd  = %11,                                                 04682000
    readcmd      = %10,                                                 04684000
    rewindcmd    = %15,                                                 04686000
    rewunldcmd   = %16,                                                 04688000
    tapegapcmd   =   7,                                                 04690000
    writecmd     =   5,                                                 04692000
    wrtfmarkcmd  =   6,                                                 04694000
    setdenshic   = %20,                                                 04696000
    setdensloc   = %21,                                        <<02657>>04698000
                                                               <<02657>>04700000
            << magtape driver status returns >>                         04702000
                                                                        04704000
    chanfail     = %144, << i/o channel error >>                        04706000
    goodeot      =  %31, << eot after successful write >>               04708000
    goodeof      =  %12, << a tape mark was read >>         <<dus 1.00>>04710000
    goodio       =    1, << no errors >>                                04712000
    siofail      =  %44, << sio failure >>                              04714000
    unitfail     =  %54, << unit failure >>                             04716000
    bsfail       =  %73, << bot and backspace requested >>  <<dus 1.00>>04718000
    nowritering  =  %40, << write ring missing on a write >><<dus 1.00>>04720000
                                                                        04722000
                                                                        04724000
            << channel program array pointers >>                        04726000
                                                                        04728000
    baddr'rc     = 38,  << buffer address for transfer count read >>    04730000
    baddr1       = 28,  << buffer address for 1st data burst >>         04732000
    baddr2       = 85,  << buffer address for 2nd data burst >>         04734000
    rdbycnt      = 25,  << read byte count>>                            04736000
    wrbycnt      = 82,  << write byte count >>                          04738000
    cmdword      = 117, << motion command word >>                       04740000
    cpstat       = 43,  << beginning of chan prog status routine >>     04742000
    dsj'rwjmp    = 13,  << read/write data bypass switch >>             04744000
    endcmd       = 119, << end command >>                               04746000
    idle         = 94,  << beginning of idle channel program >>         04748000
    memx'rc      = 37,  << bank address for transfer count read >>      04750000
    memx1        = 27,  << bank address for 1st data burst >>           04752000
    memx2        = 84,  << bank address for 2nd data burst >>           04754000
    rwdata       = 14,  << read/write data command >>                   04756000
    slctunit     = 116, << unit number buffer for select command >>     04758000
    spfdcmd      = 118, << stop polling for data command >>             04760000
    srbuff       = 123, << short read buffer >>                         04762000
    status       = 120, << i/o status buffer >>                         04764000
    idlend       = 126, << end cmd for idle cham pgm >>                 04766000
                                                                        04768000
                                                                        04770000
         << table array pointers and program constants >>               04772000
                                                                        04774000
    errormask    = %150370,  << retry error dection mask >>             04776000
    isiop        =     7,  << channel program area pointer >>           04778000
    istap        =     8,  << chan prog status return area pointer >>   04780000
    maxbsize     = 32766,  << maximum buffer byte size >>               04782000
    maxwsize     = 16383,  << maximum buffer word size >>               04784000
    err'recoverable = %11020,                                           04786000
    sysdb        = %1000,  << set start of sysdb area >>                04788000
  endeq          =     0;                                               04790000
           << dstat bit definitions >>                                  04792000
                                                                        04794000
  define                                                                04796000
    busy         = (13:3)#,  << interface busy/unit busy/rewinding >>   04798000
    eof          = ( 0:1)#,  << end of file >>                          04800000
    eot          = ( 2:1)#,  << end of tape >>                          04802000
    fileprotect  = ( 5:1)#,  << file protect  >>                        04804000
    loadp        = ( 1:1)#,  << load point (bot) >>                     04806000
    online       = ( 7:1)#,  << unit online >>                          04808000
    reject       = ( 4:1)#,  << command rejected >>                     04810000
    sterr        = ( 3:1)#,  << single track error >>                   04812000
    taperun      = (12:1)#,  << tape runaway >>                         04814000
    timing       = (11:1)#,  << timing error >>                         04816000
    transfer     = ( 6:1)#,  << transfer error (mte) >>                 04818000
                                                                        04820000
                                                                        04822000
                                                                        04824000
                                                                        04826000
         << miscellaneous bit definitions >>                            04828000
                                                                        04830000
    bankad       = ( 8:8)#,  << bank address field >>                   04832000
    blockcnt     = ( 8:4)#,  << siop, data chain block count field >>   04834000
    errorcode    = ( 0:3)#,  << cpva, error code field >>               04836000
    parityerr    = ( 3:1)#,  << status, parity error occurred >>        04838000
    pfail        = (11:1)#,  << qflag, abort due to power failure >>    04840000
    powup        = ( 2:1)#,  << status, unit has powered up >>          04842000
    func         = (12:4)#,  << qfunc, function code >>                 04844000
    timedout     = (13:1)#,  << cpva, timed out transfer abort >>       04846000
  enddef         = 0#;                                                  04848000
equate crlf = %201;                                                     04850000
                                                                        04852000
     << channel program >>                                              04854000
                                                                        04856000
integer array cmds(0:1)=pb :=                                           04858000
                                                                        04860000
      << mpe cmd >>              << physical magtape cmd >>             04862000
<<  0 - read              >>                8,                          04864000
<<  1 - write             >>                5,                          04866000
<<  2 - open              >>                1,                          04868000
<<  3 - close file        >>                1,                          04870000
<<  4 - close device      >>               14,                          04872000
<<  5 - rewind            >>               13,                          04874000
<<  6 - wrt file mark     >>                6,                          04876000
<<  7 - fsf               >>               11,                          04878000
<<  8 - bsf               >>               12,                          04880000
<<  9 - rewind unload     >>               14,                          04882000
<< 10 - gap               >>                7,                          04884000
<< 11 - fsr               >>                9,                          04886000
<< 12 - bsr               >>               10,                          04888000
<< 13 - read backward     >>               15,                          04890000
<< 14 - total byte cnt    >>                1,                          04892000
<< 15 - set density 6250  >>               16,                 <<02657>>04894000
<< 16 - set density 1600  >>               17;                 <<02657>>04896000
                                                                        04898000
array chan'pgm(0:127) = pb :=                                           04900000
                                                                        04902000
                                                                        04904000
     << channel program >>                                              04906000
                                                                        04908000
<<  0>> <<jump>>             0, <<jump to start>>                       04910000
<<  1>>                      0,                                         04912000
                                                                        04914000
<<  2>> <<unit select>>  %2001, <<wr cmd(sel unit)>>                    04916000
<<  3>>                      1, <<byte count>>                          04918000
<<  4>>                      0,                                         04920000
<<  5>>                 %42000, <<lb,ud>>                               04922000
<<  6>>                      0, <<plug in ldev here>>                   04924000
                                                                        04926000
<<  7>> <<wrcmd mot>>    %2001, <<rd motion cmd>>                       04928000
<<  8>>                      1, <<byte count>>                          04930000
<<  9>>                      0,                                         04932000
<< 10>>                 %42000, <<lb,ud>>                               04934000
<< 11>>                      0, <<plug @rd cmd>>                        04936000
                                                                        04938000
<< 12>> <<jump>>             0, <<jump>>                                04940000
<< 13>>                      0, <<0 for rd. 2 for mtn>>                 04942000
                                                                        04944000
<< 14>> <<int/halt>>      %601, <<interrupt/halt>>                      04946000
<< 15>>                      0, <<code=0>>                              04948000
                                                                        04950000
                                                                        04952000
<<break here on read cmd. can now start up an additional>>              04954000
<<read request or allow a previous one to finish.       >>              04956000
                                                                        04958000
<< 16>> <<wait>>         %1000, <<wait for cmd completion>>             04960000
<< 17>>                      0,                                         04962000
                                                                        04964000
<< 18>> <<dsj>>          %2401, <<check mt condition>>                  04966000
<< 19>>                      0,                                         04968000
<< 20>>                      0, <<status vector=0>>                     04970000
<< 21>>                     33, <<status vector=1>>                     04972000
                                                                        04974000
<< 22>> <<jump>>             0, <<jump>>                                04976000
<< 23>>                      0, <<0 for rd. 19 for mtn>>                04978000
                                                                        04980000
<< 24>> <<read data>>    %1400, <<read record cmd>>                     04982000
<< 25>> <<rd bytecount>>     0,                                         04984000
<< 26>>                      0,                                         04986000
<< 27>> <<bank+>>            0,                                         04988000
<< 28>> <<@buffer>>          0,                                         04990000
                                                                        04992000
<< 29>> <<wr end>>       %2007, <<stop poll for data>>                  04994000
<< 30>>                      1,                                         04996000
<< 31>>                      0,                                         04998000
<< 32>>                 %42000,                                         05000000
<< 33>>                      0,                                         05002000
                                                                        05004000
<< 34>> <<read count>>   %1402, <<read transfer count>>                 05006000
<< 35>>                      2,                                         05008000
<< 36>>                      0,                                         05010000
<< 37>> <<%2000+bank>>       0,                                         05012000
<< 38>> <<@count buffer>>    0,                                         05014000
                                                                        05016000
<< 39>> <<dsj>>          %2401, <<check mt condition>>                  05018000
<< 40>>                      0,                                         05020000
<< 41>>                      0,                                         05022000
<< 42>>                     12,                                         05024000
                                                                        05026000
<< 43>> <<read status>>  %1401, <<read status bytes>>                   05028000
<< 44>>                      5,                                         05030000
<< 45>>                      0,                                         05032000
<< 46>>                  %2000,                                         05034000
<< 47>> <<@stat buffer>>     0,                                         05036000
                                                                        05038000
<< 48>> <<wr end>>       %2007, <<isu stop poll data>>                  05040000
<< 49>>                      1,                                         05042000
<< 50>>                      0,                                         05044000
<< 51>>                 %42000,                                         05046000
<< 52>>                      0,                                         05048000
                                                                        05050000
<< 53>> <<int/hlt>>       %601, <<interrupt/halt>>                      05052000
<< 54>>                      0, <<halt code=0>>                         05054000
                                                                        05056000
<< 55>> <<read status>>  %1401, <<read status bytes>>                   05058000
<< 56>>                      5,                                         05060000
<< 57>>                      0,                                         05062000
<< 58>>                  %2000,                                         05064000
<< 59>>   <<@stat buffer>>   0,                                         05066000
                                                                        05068000
<< 60>> <<wr end>>       %2007, <<isu stop poll data>>                  05070000
<< 61>>                      1,                                         05072000
<< 62>>                      0,                                         05074000
<< 63>>                 %42000,                                         05076000
<< 64>>                      0,                                         05078000
                                                                        05080000
<< 65>> <<int/hlt>>       %601, <<interrupt/halt>>                      05082000
<< 66>>                      1, <<halt code=1>>                         05084000
                                                                        05086000
<<here ends a complete read data sequence        >>                     05088000
                                                                        05090000
<< 67>> <<unit select>>  %2001, <<wr cmd unit sel>>                     05092000
<< 68>>                      1,                                         05094000
<< 69>>                      0,                                         05096000
<< 70>>                 %42000, <<lb,ud>>                               05098000
<< 71>>                      0, <<plug @ldev here>>                     05100000
                                                                        05102000
<< 72>> <<wr cmd motn>>  %2001, <<wr motion cmd>>                       05104000
<< 73>>                      1,                                         05106000
<< 74>>                      0,                                         05108000
<< 75>>                 %42000, <<lb,ud>>                               05110000
<< 76>> <<@wr cmd>>          0, <<plug @wrcmd here>>                    05112000
                                                                        05114000
<< 77>> <<dsj>>          %2401, <<check mt condition>>                  05116000
<< 78>>                      0,                                         05118000
<< 79>>                      0,                                         05120000
<< 80>>                    -26,                                         05122000
                                                                        05124000
<< 81>> <<wr data>>      %2000, <<wr record cmd>>                       05126000
<< 82>> <<bytecount>>        0,                                         05128000
<< 83>>                      0,                                         05130000
<< 84>> <<bank+>>            0,                                         05132000
<< 85>> <<@wr buffer>>       0,                                         05134000
                                                                        05136000
<< 86>> <<int/halt>>         0, <<sb %601 interrupt/halt>>              05138000
<< 87>>                      0, <<code=0>>                              05140000
                                                                        05142000
<<can now start another write operation or let a    >>                  05144000
<<previous write complete.                          >>                  05146000
                                                                        05148000
<< get here to finish off write command             >>                  05150000
                                                                        05152000
<< 88>> <<wait>>         %1000, <<wait for cmd completion>>             05154000
<< 89>>                      0,                                         05156000
                                                                        05158000
<< 90>> <<dsj>>          %2401, <<check mt condition>>                  05160000
<< 91>>                      0,                                         05162000
<< 92>>                    -51,                                         05164000
<< 93>>                    -39,                                         05166000
<< here ends a complete write sequence                >>                05168000
                                                                        05170000
<<here starts the idle channel program               >>                 05172000
<< 94>> <<wr end>>       %2007, <<isue end command>>                    05174000
<< 95>>                      1, <<idle channel pgm>>                    05176000
<< 96>>                      0,                                         05178000
<< 97>>                 %42000,                                         05180000
<< 98>>                      0,                                         05182000
                                                                        05184000
<< 99>> <<wait>>         %1000, <<wait for mt poll>>                    05186000
<<100>>                      0,                                         05188000
                                                                        05190000
<<101>> <<dsj>>          %2400, <<clear any pending dsjs>>              05192000
<<102>>                      0,                                         05194000
<<103>>                      0,                                         05196000
                                                                        05198000
<<104>> <<read status>>  %1401, <<read status to ilt>>                  05200000
<<105>>                      5,                                         05202000
<<106>>                      0,                                         05204000
<<107>>                  %2000,                                         05206000
<<108>> <<@stap>>            0,                                         05208000
                                                                        05210000
<<109>> <<wr end>>       %2007, <<issue end cmd>>                       05212000
<<110>>                      1,                                         05214000
<<111>>                      0,                                         05216000
<<112>>                 %42000,                                         05218000
<<113>>                      0,                                         05220000
                                                                        05222000
<<114>> <<int/hlt>>       %601, <<interrupt/halt>>                      05224000
<<115>>                      0, <<code=0>>                              05226000
                                                                        05228000
<<116>> <<ldev etc>>         0, <<sel cmd unit number>>                 05230000
<<117>> <<cmd word>>         0, <<motion cmd word>>                     05232000
<<118>>                      2, <<stop poll for data cmd>>              05234000
<<119>>                    %10, <<end command>>                         05236000
<<120>>                      0, <<6 byte status buffer>>                05238000
<<121>>                      0,                                         05240000
<<122>>                      0,                                         05242000
<<123>>                      0, <<6 byte short rd buffer>>              05244000
<<124>>                      0,                                         05246000
<<125>>                      0,                                         05248000
                                                                        05250000
<<126>>                      4;                                         05252000
                                                                        05254000
    byte array                                                          05256000
      message(0:71);                                                    05258000
                                                                        05260000
    array                                                               05262000
      chan'stat(0:1)=q,                                     <<dus 1.00>>05264000
      count(0:1);                                           <<dus 1.00>>05266000
                                                                        05268000
    double dchan'stat = chan'stat;                                      05270000
                                                                        05272000
    logical                                                             05274000
      dstatus := -1,                                                    05276000
      ls0 = s-0;                                                        05278000
                                                                        05280000
    integer pointer                                                     05282000
      siop,    << holds channel program >>                              05284000
      idlesio, << points to start of idle chan prog >>                  05286000
      statsio; << points to start of status chan prog >>                05288000
                                                                        05290000
    pointer                                                             05292000
      siopl = siop;                                                     05294000
                                                                        05296000
    byte pointer                                                        05298000
      bps0    = s-0;                                                    05300000
                                                                        05302000
    integer                                                             05304000
      xfercnt,            << buffer byte count >>                       05306000
      fcode,              << function code >>                           05308000
      len,                << mag tape state >>                          05310000
      drt,                << drt of mag tape controller >>              05312000
      unit,               << unit of mag tape >>                        05314000
      db,                 << current db register setting >>             05316000
      retry := 0,         << magtape error retry counter >>             05318000
      siobase,            << absolute address of siop >>                05320000
      mtdvr1    = mtdvr76, <<here's the name of the driver>><<dus 1.00>>05322000
      mtdvr2    = mtdvr76+1,                                <<dus 1.00>>05324000
      l,                                                                05326000
      s0        = s-0,                                                  05328000
      s1        = s-1,                                                  05330000
      s2        = s-2,                                                  05332000
      s3        = s-3,                                                  05334000
      mq1       = q-1,                                                  05336000
      x         = x;                                                    05338000
                                                                        05340000
    logical array cpvap(0:135);                                         05342000
    equate                                                              05344000
      cce       = 2,                                                    05346000
      ccg       = 0,                                                    05348000
      ccl       = 1;                                                    05350000
                                                                        05352000
    define                                                              05354000
      condcode  = mq1.(6:2)#;                                           05356000
subroutine error( stat );                                               05358000
   integer array stat;                                                  05360000
begin                                                                   05362000
  move message := "CPVA=XXXXXX XXXXXX STATUS=XXXXXX XXXXXX PTR= XXXXXX";05364000
  ascii( cpvap, message(5), 8);                                         05366000
  ascii( cpvap(1), message(12), 8);                                     05368000
  ascii( stat, message(26), 8);                                         05370000
  ascii( stat(1), message(33), 8);                                      05372000
  ascii( abs(drt&lsl(2)), message(44), 8);                              05374000
  print( message, -50, crlf);                                           05376000
end;                                                                    05378000
subroutine startio( wait );                                             05380000
   value wait;                                                          05382000
   logical wait;                                                        05384000
begin                                                                   05386000
   initproc ( drt );                                                    05388000
   if <> then                                                           05390000
   begin                                                                05392000
      move message := "CHANNEL NON-RESPONING";                          05394000
      print( message, -21, crlf);                                       05396000
      tos := chanfail;                                                  05398000
      go badio;                                                         05400000
   end;                                                                 05402000
   sioproc ( drt, siobase );                                            05404000
   if <> then                                                           05406000
   begin                                                                05408000
      move message := "MAGTAPE NON-RESPONDING";                         05410000
      print( message, -22, crlf);                                       05412000
      tos := siofail;                                                   05414000
      go badio;                                                         05416000
   end;                                                                 05418000
   if wait then                                                         05420000
      do until absolute(drt*4+3).(0:2) = 0;                             05422000
end;                                                                    05424000
   << initialize local pointers and variables >>                        05426000
                                                                        05428000
    tos := length;                   << xfercnt         >>              05430000
    if < then                        << byte count      >>              05432000
      tos := -tos                    << make positive   >>              05434000
    else                             << word count      >>              05436000
      tos := tos&asl(1);             << make byte count >>              05438000
    xfercnt := tos;                                                     05440000
    fcode := cmds( function.(11:5));                           <<02657>>05442000
                                                                        05444000
                                                                        05446000
    dchan'stat := 0d;                                                   05448000
    drt := drtunit.drtf;                                                05450000
    unit := drtunit.unitf;                                              05452000
    push( db ); delb;                                                   05454000
    db := tos;                                                          05456000
    siobase := @cpvap(8) + db;                                          05458000
    absolute(drt*4+2) := @cpvap + db;                                   05460000
    @siop := @cpvap(8);                                                 05462000
    @idlesio := @siop( idle);                                           05464000
    @statsio := @siop( cpstat);                                         05466000
    cpvap := 0;                                                         05468000
    move cpvap(1) := cpvap,(7);                                         05470000
start:                                                                  05472000
    move siop := chan'pgm,(128);                                        05474000
    siop( 6) := siobase + slctunit;                                     05476000
    siop(71) := siobase + slctunit;                                     05478000
    siop(11) := siobase + cmdword;                                      05480000
    siop(76) := siobase + cmdword;                                      05482000
    siop(33) := siobase + spfdcmd;                                      05484000
    siop(47) := siobase + status;                                       05486000
    siop(59) := siobase + status;                                       05488000
    siop(52) := siobase + endcmd;                                       05490000
    siop(64) := siobase + endcmd;                                       05492000
    siop(113):= siobase + endcmd;                                       05494000
    siop(98) := siobase + idlend;                                       05496000
    <<siop(dsj'rwjmp) := 0;     set switch to motion command branch >>  05498000
    siop(cmdword) := fcode;                                             05500000
                                                                        05502000
    if fcode=readcmd or fcode=writecmd or fcode=backreadcmd             05504000
       then                                                             05506000
    begin                                                               05508000
       if fcode=writecmd then                                           05510000
       begin  <<write command>>                                         05512000
        siop(  1) :=65;  <<jump to start>>                              05514000
        tos := addr;  <<get buffer address>>                            05516000
        siop(baddr2) := tos;  <<buffer address>>                        05518000
        siop(memx2) := tos;         <<bank number>>                     05520000
        siop(wrbycnt) := xfercnt;  <<transfer count>>                   05522000
        siop( 81) :=%2000;  <<reset>>                                   05524000
        siop( 73) :=1; <<reset byte count>>                             05526000
        siop( 72) :=%2001;  <<reset motion cmd>>                        05528000
        siop( 86) :=0;  << no cmd q break>>                             05530000
       end   <<write command>>                                          05532000
      else                                                              05534000
       begin  <<read command>>                                          05536000
          if xfercnt = 0 then                                           05538000
          begin                                                         05540000
             fcode := if fcode=readcmd then fsrecordcmd                 05542000
                      else bsrecordcmd;                                 05544000
             go start;                                                  05546000
          end;                                                          05548000
          siop(  1) :=0;  <<jump to start>>                             05550000
          siop(  7) :=%2001;  <<reset motion cmd>>                      05552000
          siop(  8) :=1;  <<reset byte count>>                          05554000
          siop(dsj'rwjmp) :=0;  <<jump around spare>>                   05556000
          siop( 24) :=%1400;  <<reset>>                                 05558000
          siop( 20) :=0;  <<reset>>                                     05560000
          siop( 23) :=0;                                                05562000
          siop( 14) :=0;                                                05564000
          tos :=addr;  <<get buffer address>>                           05566000
          siop(baddr1) :=tos;  <<buffer>>                               05568000
          siop(memx1) :=tos;         <<bank>>                           05570000
          siop(rdbycnt) :=xfercnt;                                      05572000
          siop( 37) :=%2000;                                            05574000
          siop(baddr'rc):=logical(db)+logical(@count);          <<1.00>>05576000
    end; <<read command>>                                               05578000
   end                                                                  05580000
  else                                                                  05582000
    begin   << must be a control request! >>                            05584000
       siop(dsj'rwjmp) :=  2; << branch around read/write data logic >> 05586000
       siop(20) := 21;  <<br around read logic>>                        05588000
       siop(21) := 33;                                                  05590000
       siop( 1) := 0;                                                   05592000
       siop( 7) := %2001;  <<reset>>                                    05594000
       siop( 8) := 1;  <<reset>>                                        05596000
    end;                                                                05598000
try'again:                                                              05600000
                                                                        05602000
    startio( true );                                                    05604000
                                                                        05606000
          << c o n t i n u a t o r   s e c t i o n >>                   05608000
                                                                        05610000
     if cpvap.errorcode=6 or cpvap.errorcode=7 then                     05612000
     begin                                                              05614000
        if cpvap.errorcode=7 and cpvap.timedout then                    05616000
        begin                                                           05618000
           startio( true );                                             05620000
           if (dstatus land err'recoverable) <> 0 then go retry'it;     05622000
        end;                                                            05624000
        move message := "CHAN ERR.";                                    05626000
        print( message, -9, crlf);                                      05628000
        error( siop(status) );                                          05630000
        tos := chanfail;                                                05632000
        go badio;                                                       05634000
     end;                                                               05636000
                                                                        05638000
                                                                        05640000
     dstatus := siop(status); << get status >>                          05642000
     if cpvap(1).(14:2) <> 0 then                                       05644000
     begin                                                              05646000
        move message := "MAG TAPE ",2;                                  05648000
        if dstatus.busy <> 0 then                                       05650000
        begin                                                           05652000
           startio( true );                                             05654000
           go try'again;                                                05656000
        end;                                                            05658000
                                                                        05660000
        if dstatus.reject then                                          05662000
        begin                                                           05664000
           if not dstatus.online then                                   05666000
           begin                                                        05668000
              move * := "UNIT #0 NOT READY",2;                          05670000
              message(15) := message(15)+byte(unit);                    05672000
              l := tos-@message;                                        05674000
              print( message, -l, crlf);                                05676000
              startio( true );                                          05678000
              go start;                                                 05680000
           end                                                          05682000
         else                                                           05684000
           begin                                                        05686000
              if (fcode=writecmd or fcode=wrtfmarkcmd or                05688000
                 fcode=tapegapcmd) and dstatus.fileprotect then         05690000
              begin                                                     05692000
                 move * := "UNIT #0 NO WRITE RING",2;                   05694000
                 message(15) := message(15)+byte(unit);                 05696000
                 l := tos-@message;                                     05698000
                 print( message, -l, crlf);                             05700000
                 startio( true );                                       05702000
                 go start;                                              05704000
              end;                                                      05706000
              move * := "COMMAND REJECTED",2;                           05708000
           end;                                                         05710000
        end;                                                            05712000
                                                                        05714000
        if dstatus.taperun then                                         05716000
        begin                                                           05718000
           move * := "RUN AWAY",2;                                      05720000
        end;                                                            05722000
                                                                        05724000
        if (dstatus land err'recoverable) <> 0 then                     05726000
        begin                                                           05728000
retry'it:  if retry <= 10 then                                          05730000
           begin                                                        05732000
              mtdvr76( 12, drtunit, 0d, 0);                             05734000
              if fcode=writecmd and (retry mod 3)=0 then                05736000
                 mtdvr76( 10, drtunit, 0d, 0);                          05738000
              retry := retry+1;                                         05740000
              go start;                                                 05742000
           end                                                          05744000
         else                                                           05746000
           move * := "PARITY ERROR",2;                                  05748000
        end;                                                            05750000
                                                                        05752000
        if dstatus.(0:3) <> 0 and (dstatus land %15037) = 0 then        05754000
           if dstatus.loadp then                                        05756000
              if fcode=readcmd or fcode=writecmd then                   05758000
                  << we didn't really move tape because we were at      05760000
                     load point !!!                                >>   05762000
                 go start                                               05764000
             else go eofout                                             05766000
          else go eofout;                                               05768000
        l := tos-@message;                                              05770000
        print( message, -l, crlf);                                      05772000
        error( siop(status) );                                          05774000
        tos := unitfail;                                                05776000
        go badio;                                                       05778000
     end;                                                               05780000
                                                                        05782000
     tos := goodio;                                                     05784000
     tos := cce;                                                        05786000
     go exit;                                                           05788000
                                                                        05790000
                                                                        05792000
                                                                        05794000
eofout:                                                                 05796000
     if dstatus.eot then tos := goodeot                                 05798000
    else                                                                05800000
     if dstatus.eof then tos := goodeof                     <<dus 1.00>>05802000
        else if dstatus.loadp then tos:=bsfail;             <<dus 1.00>>05804000
     tos := ccg;                                                        05806000
     go exit;                                                           05808000
                                                                        05810000
badio:                                                                  05812000
     tos := ccl;                                                        05814000
                                                                        05816000
exit:                                                                   05818000
     condcode := tos;                                                   05820000
     tos := xfercnt-siop(rdbycnt);                                      05822000
     if xfercnt > maxbsize then tos := tos -siop(wrbycnt);              05824000
     if length > 0 then tos := (tos+1)&lsr(1);                          05826000
     mtdvr2 := tos;                                                     05828000
     mtdvr1 := tos;                                                     05830000
end;                                                                    05832000
$page  "      DISC UTILITIES AND DRIVERS  "                             05834000
  procedure mhdisk(ldev,drtunit,stype,funct,record,buf,wc);             05836000
    value ldev,drtunit,stype,funct,record,wc;                           05838000
    integer ldev,                                                       05840000
            drtunit,     <<drt and unit number>>                        05842000
            stype,       <<subtype - for different sized disks>>        05844000
            wc;          <<word count>>                                 05846000
   logical funct ;                                                      05848000
    double record;       <<sector address>>                             05850000
    array buf;           <<core buffer>>                                05852000
    option forward;                                                     05854000
                                                                        05856000
                                                                        05858000
procedure mh7905(ldev,drtunit,stype,funct,record,buf,wc,lps);           05860000
value ldev,drtunit,stype,funct,record,wc,lps;                           05862000
    integer ldev,                                                       05864000
            drtunit,        <<drt and unit number>>                     05866000
            stype,          <<subtype>>                                 05868000
            wc,             <<word count>>                              05870000
            lps;            <<logical pack size>>                       05872000
    logical funct;                                                      05874000
    double record;          <<disc address>>                            05876000
    array buf;              <<core buffer>>                             05878000
    option forward;                                                     05880000
                                                                        05882000
                                                                        05884000
$page                                                                   05886000
<<**********************************************************>>          05888000
<<                                                          >>          05890000
<< below are all the disc driver routines needed to complete>>          05892000
<< disc i/o requests.  these were taken directly out og the >>          05894000
<< old series iii version of sadutil.                       >>          05896000
<<                                                          >>          05898000
<<**********************************************************>>          05900000
$title "CS80DISC STANDALONE DRIVER"                            <<03627>>05904000
<<***********************************************>>            <<03627>>05906000
<<                                               >>            <<03627>>05908000
<<    cs80dsc0 -- stand alone cs80-disc driver   >>            <<03627>>05910000
<<                                               >>            <<03627>>05912000
<<***********************************************>>            <<03627>>05914000
                                                               <<03627>>05916000
                                                               <<03627>>05918000
                                                               <<03627>>05920000
integer procedure cs80dsc0(drtunit, type, subtype, function,   <<03627>>05922000
                    disc'sector,buffer'address,length'trans);  <<03627>>05924000
                                                               <<03627>>05926000
value drtunit, type, subtype, function, disc'sector,           <<03627>>05928000
      buffer'address, length'trans;                            <<03627>>05930000
                                                               <<03627>>05932000
integer drtunit, type, subtype, function, length'trans;        <<03627>>05934000
                                                               <<03627>>05936000
double disc'sector, buffer'address;                            <<03627>>05938000
                                                               <<03627>>05940000
begin                                                          <<03627>>05942000
                                                               <<03627>>05944000
   equate                                                      <<03627>>05946000
          << cs'80 disc subtypes >>                            <<03627>>05948000
      hp7935   =   8,                                          <<03627>>05950000
      hp7911   =   1,                                          <<03627>>05952000
      hp7912   =   2,                                          <<03627>>05954000
                                                               <<03627>>05956000
          << cs'80 disc type >>                                <<03627>>05958000
                                                               <<03627>>05960000
      cs80     =   3,                                          <<03627>>05962000
                                                               <<03627>>05964000
          << cs'80 stand alone driver functions >>             <<03627>>05966000
                                                               <<03627>>05968000
      func'read        =    0,                                 <<03627>>05970000
      func'write       =    1,                                 <<03627>>05972000
      func'new'pack    =    2,                                 <<03627>>05974000
      func'clear'dev   =    3,                                 <<03627>>05976000
      func'rfs         =    4,                                 <<03627>>05978000
      illegal'func     =    5,                                 <<03627>>05980000
      max'func         =    5,                                 <<03627>>05982000
                                                               <<03627>>05984000
          << cs'80 stand alone driver return status >>         <<03627>>05986000
                                                               <<03627>>05988000
      successful'io    =    1,                                 <<03627>>05990000
      transfer'error   =  %14,                                 <<03627>>05992000
      unit'failure     =  %54,                                 <<03627>>05994000
      channel'error    = %144,                                 <<03627>>05996000
                                                               <<03627>>05998000
          << cs'80 secondaries >>                              <<03627>>06000000
                                                               <<03627>>06002000
      wrt'cmd'sec      =   %2005,   << wrt w/cmd msg sec >>    <<03627>>06004000
      read'trans'sec   =   %3402,   << read w/trans msg sec >> <<03627>>06006000
      wrt'trans'sec    =   %4002,   << wrt w/trans msg sec >>  <<03627>>06008000
      read'exec'sec    =   %1416,   << read w/exec msg sec >>  <<03627>>06010000
      wrt'exec'sec     =   %2016,   << wrt w/exec msg sec >>   <<03627>>06012000
                                                               <<03627>>06014000
$page                                                          <<03627>>06016000
          << cs'80 disc driver command data bytes >>           <<03627>>06018000
                                                               <<03627>>06020000
      cdb'blk'displ    =   %22,   << set block disp command >> <<03627>>06022000
      cdb'cancel       =   %11,   << cancel command >>         <<03627>>06024000
      cdb'clear        =   %10,   << clear command >>          <<03627>>06026000
      cdb'init'diag    =   %63,   << init diagnostic command >><<03627>>06028000
      cdb'init'media   =   %67,   <<initialize media command>> <<03627>>06030000
      cdb'init'util    =   %62, <<init utility with exec msg>> <<03627>>06032000
      cdb'nop          =   %64,   << no operation command >>   <<03627>>06034000
      cdb'parity'op    =     1,   << pariy opcode command >>   <<03627>>06036000
      cdb'read         =     0,   << locate & read command >>  <<03627>>06038000
      cdb'read'sector  =  %300,  << read full sector command >><<03627>>06040000
      cdb'release      =   %16,   << release command >>        <<03627>>06042000
      cdb'release'deny =   %17,   << release denied command >> <<03627>>06044000
      cdb'req'status   =   %15,   << request status command >> <<03627>>06046000
      cdb'set'length   =   %30,   << set length command >>     <<03627>>06048000
      cdb'set'release  =   %73,   << set release command >>    <<03627>>06050000
      cdb'set'retadr   =  %110,   << set ret addr mode cmd >>  <<03627>>06052000
    <<cdb'set'retry    =   %72,      set retry time command >> <<03627>>06054000
      cdb'set'sngl'vec =   %20,   << set sngl vec addr cmd >>  <<03627>>06056000
      cdb'set'3'vec    =   %21,   << set 3 vector addr cmd >>  <<03627>>06058000
      cdb'set'unit     =   %40,   << set unit# command >>      <<03627>>06060000
      cdb'set'vol      =  %100,   << set vol# command >>       <<03627>>06062000
      cdb'spare'blk    =    %6,   << spare block command >>    <<03627>>06064000
      cdb'verify       =    %4,   << verify command >>         <<03627>>06066000
      cdb'write        =    %2,   << locate & write command >> <<03627>>06068000
                                                               <<03627>>06070000
          << channel program offsets relative to siop >>       <<03627>>06072000
                                                               <<03627>>06074000
      branchpt       =    1,  << branchpt offset >>            <<03627>>06076000
      idle           =    2,  << idle cp offset >>             <<03627>>06078000
      dxfer          =   11,  << data xfer section offset >>   <<03627>>06080000
      rstat          =   32,  << read status offset >>         <<03627>>06082000
      diag           =   55,  << diag section offset >>        <<03627>>06084000
      pon            =   69,  << power on offset >>            <<03627>>06086000
      ident          =   80,  << identify section offset >>    <<03627>>06088000
      stat'cdb       =   84,  << status cdb offset >>          <<03627>>06090000
      initflg        =   85,  << init flag offset >>           <<03627>>06092000
    <<fill'wrd       =   86,     fill word offset >>           <<03627>>06094000
      stat'area      =   87,  << status area offset >>         <<03627>>06096000
      cdb'area'wrd   =   97,  << cdb storage area wrd offset >><<03627>>06098000
                                                               <<03627>>06100000
          << channel program entries & area byte offset >>     <<03627>>06102000
                                                               <<03627>>06104000
    cpbase        = 2,               << cp base >>             <<03627>>06106000
    dxfercp       = dxfer-cpbase,    << data xfer entry >>     <<03627>>06108000
    diagcp        = diag-cpbase,     << diag function entry >> <<03627>>06110000
                                                               <<03627>>06112000
    stat'area'byte = stat'area*2,    << stat area byte offst >><<03627>>06114000
    cdb'area'byte  = cdb'area'wrd*2, << cdb area byte offst >> <<03627>>06116000
                                                               <<03627>>06118000
$page                                                          <<03627>>06120000
                                                               <<03627>>06122000
       << channel program sections offsets >>                  <<03627>>06124000
                                                               <<03627>>06126000
    dxfer1        = dxfer+1,    << cmd buffer length >>        <<03627>>06128000
    dxfer3        = dxfer+3,    << command buffer bank >>      <<03627>>06130000
    dxfer4        = dxfer+4,    << cmd buffer abs addr >>      <<03627>>06132000
    dxfer5        = dxfer+5,    << wait command >>             <<03627>>06134000
    dxfer6        = dxfer+6,    << wait command >>             <<03627>>06136000
    dxfer7        = dxfer+7,    << exec msg secondary >>       <<03627>>06138000
    dxfer8        = dxfer+8,    << #bytes to read/wrt >>       <<03627>>06140000
    dxfer10       = dxfer+10,   << data bank >>                <<03627>>06142000
    dxfer11       = dxfer+11,   << data buffer abs addr >>     <<03627>>06144000
    diag1         = diag+1,     << cmd buffer length >>        <<03627>>06146000
    diag3         = diag+3,     << cmd buffer bank >>          <<03627>>06148000
    diag4         = diag+4,     << cmd buffer abs addr >>      <<03627>>06150000
    diag5         = diag+5,     << wait command >>             <<03627>>06152000
    diag6         = diag+6,     << wait command >>             <<03627>>06154000
    rstat4        = rstat+4,    << cmd buffer abs addr >>      <<03627>>06156000
    rstat11       = rstat+11,   << data buffer abs addr >>     <<03627>>06158000
                                                               <<03627>>06160000
                                                               <<03627>>06162000
      << offsets into status fields >>                         <<03627>>06164000
                                                               <<03627>>06166000
    id'field      = stat'area,    << identification field >>   <<03627>>06168000
    reject'field  = stat'area+1,  << reject errors field >>    <<03627>>06170000
    fault'field   = stat'area+2,  << fault errors field >>     <<03627>>06172000
    access'field  = stat'area+3,  << access errors field >>    <<03627>>06174000
    infor'field   = stat'area+4,  << infor errors field >>     <<03627>>06176000
    parm'field    = stat'area+5,  << parameter field >>        <<03627>>06178000
                                                               <<03627>>06180000
       << miscellaneous equates >>                             <<03627>>06182000
                                                               <<03627>>06184000
    ctrl'unit     = %17,    << controller unit >>              <<03627>>06186000
    max'stat'byte = 20,     << max# status bytes >>            <<03627>>06188000
    sysdb         = %1000,  << address of sysdb area >>        <<03627>>06190000
    crlf          = %201, <<carriage control for printing msg>><<03627>>06192000
    retry         = 0,      << retry the transaction >>        <<03627>>06194000
    max'retry     = 2,      << the maximum number of retries >><<03627>>06196000
                                                               <<03627>>06198000
   endeq          = 0;                                         <<03627>>06200000
                                                               <<03627>>06202000
$page                                                          <<03627>>06204000
                                                               <<03627>>06206000
       << i/o status bit definitions >>                        <<03627>>06208000
                                                               <<03627>>06210000
  define                                                       <<03627>>06212000
                                                               <<03627>>06214000
    unit'attn       =  (8:8)#,   << unit attention bit >>      <<03627>>06216000
                                                               <<03627>>06218000
    chan'parity     =  (2:1)=1#, << channel parity bit >>      <<03627>>06220000
    illeg'opcode    =  (5:1)=1#, << illegal opcode bit >>      <<03627>>06222000
    mod'addr'err    =  (6:1)=1#, << module addr error bit >>   <<03627>>06224000
    addr'bound      =  (7:1)=1#, << address bounds bit >>      <<03627>>06226000
    parm'bound      =  (8:1)=1#, << parameter bounds bit >>    <<03627>>06228000
    illeg'parm      =  (9:1)=1#, << illegal parameter bit >>   <<03627>>06230000
    msg'seq'viol    = (10:1)=1#, << msg seq violation bit >>   <<03627>>06232000
    msg'len'diff    = (12:1)=1#, << msg length differ bit >>   <<03627>>06234000
                                                               <<03627>>06236000
    cross'unit      =  (1:1)=1#, << error during copy oper >>  <<03627>>06238000
    ctrl'fault      =  (3:1)=1#, << controller fault bit >>    <<03627>>06240000
    unit'fault      =  (6:1)=1#, << unit fault bit >>          <<03627>>06242000
    diag'failed     =  (8:1)=1#, << diag failed bit >>         <<03627>>06244000
    oper'rel'reqrd  = (10:1)=1#, << oper rel required bit >>   <<03627>>06246000
    diag'rel'reqrd  = (11:1)=1#, << diag rel required bit >>   <<03627>>06248000
    int'maint'reqrd = (12:1)=1#, << int maint required bit >>  <<03627>>06250000
    power'fail      = (14:1)=1#, << power fail bit >>          <<03627>>06252000
    rel'completed   = (15:1)=1#, << release completed bit >>   <<03627>>06254000
                                                               <<03627>>06256000
    illeg'par'oper  = ( 0:1)=1#, << illegal // operation bit >><<03627>>06258000
    uninit'media    = ( 1:1)=1#, << uninitialized media bit >> <<03627>>06260000
    no'spare'avail  = ( 2:1)=1#, << no spare available bit >>  <<03627>>06262000
    dev'not'rdy     = ( 3:1)=1#, << device not ready bit >>    <<03627>>06264000
    wrt'protect     = ( 4:1)=1#, << write protect bit >>       <<03627>>06266000
    no'data'found   = ( 5:1)=1#, << no data found bit >>       <<03627>>06268000
    unrecov'data'ov = ( 8:1)=1#, <<unrecov data overflow bit>> <<03627>>06270000
    unrecov'data    = ( 9:1)=1#, << unrecov data bit >>        <<03627>>06272000
    end'of'file     = (11:1)=1#, << end of file bit >>         <<03627>>06274000
    end'of'volume   = (12:1)=1#, << end of volume bit >>       <<03627>>06276000
                                                               <<03627>>06278000
    oper'rel'reqst  = ( 0:1)=1#, << operator rel request bit >><<03627>>06280000
    diag'rel'reqst  = ( 1:1)=1#, << diag rel request bit >>    <<03627>>06282000
    int'maint'reqst = ( 2:1)=1#, << int maint request bit >>   <<03627>>06284000
    data'overrun    =  (4:1)=1#, << data overrun bit >>        <<03627>>06286000
    def'blk'spare   =  (7:1)=1#, <<defective blk auto spared>> <<03627>>06288000
    recov'data'ov   =  (9:1)=1#, << recov data overflow bit >> <<03627>>06290000
    marginal'data   = (10:1)=1#, << marginal data bit >>       <<03627>>06292000
    recov'data      = (11:1)=1#, << recov data bit >>          <<03627>>06294000
    maint'trk'ov    = (13:1)=1#, << maint trk overflow bit >>  <<03627>>06296000
                                                               <<03627>>06298000
       << miscellaneous definitions >>                         <<03627>>06300000
                                                               <<03627>>06302000
    errorcode       = (0:3)#,  << cpavp, error code >>         <<03627>>06304000
    unitfield       = (12:4)#,  << unit field of drtunit >>    <<03627>>06306000
    drtfield        =  (0:8)#,  << drt field series iii >>     <<03627>>06308000
    command'byte'area = double(siobase     + cdb'area'wrd)*2d#,<<03627>>06310000
<<this define gives us the absolute byte address of the>>      <<03627>>06312000
<<cs80 command area, (the channel program starts at>>          <<03627>>06314000
<<db on interrupt + 8>>                                        <<03627>>06316000
                                                               <<03627>>06318000
  enddef       = 0#;                                           <<03627>>06320000
                                                               <<03627>>06322000
                                                               <<03627>>06324000
                                                               <<03627>>06326000
                                                               <<03627>>06328000
                                                               <<03627>>06330000
$page                                                          <<03627>>06332000
                                                               <<03627>>06334000
        array chan'pgm(0:106) = pb :=                          <<03627>>06336000
                                                               <<03627>>06338000
                                                               <<03627>>06340000
        <<*******************************************>>        <<03627>>06342000
        <<*******************************************>>        <<03627>>06344000
        <<*                                         *>>        <<03627>>06346000
        <<*        channel program template         *>>        <<03627>>06348000
        <<*                                         *>>        <<03627>>06350000
        <<*******************************************>>        <<03627>>06352000
        <<*******************************************>>        <<03627>>06354000
                                                               <<03627>>06356000
                                                               <<03627>>06358000
<< 0>>  << jump >>              0,  << branch to cp section >> <<03627>>06360000
<< 1>>                          0,                             <<03627>>06362000
                                                               <<03627>>06364000
                                                               <<03627>>06366000
        <<------------------------------------------------->>  <<03627>>06368000
        << idle cp - on hard error, requests status and on >>  <<03627>>06370000
        <<           pon does a dev clear & enables parity >>  <<03627>>06372000
        <<------------------------------------------------->>  <<03627>>06374000
                                                               <<03627>>06376000
                                                               <<03627>>06378000
<< 0>>  << wait >>          %1000,  << wait for // poll >>     <<03627>>06380000
<< 1>>                          0,                             <<03627>>06382000
                                                               <<03627>>06384000
<< 2>>  << qstat>>          %2402,  <<reporting msg secondary>><<03627>>06386000
<< 3>>                          0,  << return byte >>          <<03627>>06388000
<< 4>>                          0,  << normal completion >>    <<03627>>06390000
<< 5>>                         23,  <<hard error - req status>><<03627>>06392000
<< 6>>                         60,  << power on occurred >>    <<03627>>06394000
                                                               <<03627>>06396000
<< 7>>  << int/hlt0 >>       %601,  << interrupt/halt >>       <<03627>>06398000
<< 8>>                          0,  << code of 0 in cpva(1) >> <<03627>>06400000
                                                               <<03627>>06402000
                                                               <<03627>>06404000
        <<------------------------------------------------->>  <<03627>>06406000
        << [dxfer] real-time & some general purpose cmds   >>  <<03627>>06408000
        << command - execution - reporting message section >>  <<03627>>06410000
        <<------------------------------------------------->>  <<03627>>06412000
                                                               <<03627>>06414000
                                                               <<03627>>06416000
<< 0>>  << write ctrl >>    %2005,  << command msg secondary >><<03627>>06418000
<< 1>>                          0,  <<cmd buffer byte length>> <<03627>>06420000
<< 2>>                          0,  << burst >>                <<03627>>06422000
<< 3>>                      %2000,  << cmd buffer bank >>      <<03627>>06424000
<< 4>>                          0,  << cmd buffer abs addr >>  <<03627>>06426000
                                                               <<03627>>06428000
<< 5>>  << wait >>          %1000,  << wait for // poll >>     <<03627>>06430000
<< 6>>                          0,                             <<03627>>06432000
                                                               <<03627>>06434000
<< 7>>  << rd/wrt ctrl >>   %1416,  <<execution msg secondary>><<03627>>06436000
<< 8>>                          0,  << #bytes to read/write >> <<03627>>06438000
<< 9>>                          0,  << burst >>                <<03627>>06440000
<<10>>                          0,  << data bank >>            <<03627>>06442000
<<11>>                          0,  << data buffer abs addr >> <<03627>>06444000
                                                               <<03627>>06446000
<<12>>  << wait >>          %1000,  << wait for // poll >>     <<03627>>06448000
<<13>>                          0,                             <<03627>>06450000
                                                               <<03627>>06452000
<<14>>  << qstat >>         %2402,  <<reporting msg secondary>><<03627>>06454000
<<15>>                          0,  << return byte >>          <<03627>>06456000
<<16>>                          0,  << normal completion >>    <<03627>>06458000
<<17>>                          2,  <<hard error - req status>><<03627>>06460000
<<18>>                         39,  << power on occurred >>    <<03627>>06462000
                                                               <<03627>>06464000
<<19>>  << int/hlt0 >>       %601,  << interrupt/halt >>       <<03627>>06466000
<<20>>                          0,  << code of 0 in cpva(1) >> <<03627>>06468000
                                                               <<03627>>06470000
                                                               <<03627>>06472000
        <<------------------------------------------------->>  <<03627>>06474000
        << [rstat] status interrogation section            >>  <<03627>>06476000
        << command - execution - reporting message section >>  <<03627>>06478000
        <<------------------------------------------------->>  <<03627>>06480000
                                                               <<03627>>06482000
                                                               <<03627>>06484000
<< 0>>  << write ctrl >>    %2005,  << command msg secondary >><<03627>>06486000
<< 1>>                          1,  <<cmd buffer byte length>> <<03627>>06488000
<< 2>>                          0,  << burst >>                <<03627>>06490000
<< 3>>                     %42000,  << cmd buffer bank >>      <<03627>>06492000
<< 4>>  << stat cdb >>          0,  << cmd buffer abs addr >>  <<03627>>06494000
                                                               <<03627>>06496000
<< 5>>  << wait >>          %1000,  << wait for // poll >>     <<03627>>06498000
<< 6>>                          0,                             <<03627>>06500000
                                                               <<03627>>06502000
<< 7>>  << read ctrl >>     %1416,  <<execution msg secondary>><<03627>>06504000
<< 8>>                         20,  << #status bytes to read >><<03627>>06506000
<< 9>>                          0,  << burst >>                <<03627>>06508000
<<10>>                      %2000,  << data bank >>            <<03627>>06510000
<<11>>  << stat area >>         0,  << data buffer abs addr >> <<03627>>06512000
                                                               <<03627>>06514000
<<12>>  << wait >>          %1000,  << wait for // poll >>     <<03627>>06516000
<<13>>                          0,                             <<03627>>06518000
                                                               <<03627>>06520000
<<14>>  << qstat >>         %2402,  <<reporting msg secondary>><<03627>>06522000
<<15>>                          0,  << return byte >>          <<03627>>06524000
<<16>>                          0,  << normal completion >>    <<03627>>06526000
<<17>>                          2,  <<hard error - req status>><<03627>>06528000
<<18>>                         18,  << power on occurred >>    <<03627>>06530000
                                                               <<03627>>06532000
<<19>>  << int/hlt1 >>       %601,  << interrupt/halt >>       <<03627>>06534000
<<20>>                          1,  << code of 1 in cpva(1) >> <<03627>>06536000
                                                               <<03627>>06538000
<<21>>  << int/hlt3 >>       %601,  << interrupt/halt >>       <<03627>>06540000
<<22>>                          3,  << code of 3 in cpva(1) >> <<03627>>06542000
                                                               <<03627>>06544000
                                                               <<03627>>06546000
        <<------------------------------------------------->>  <<03627>>06548000
        << [diag] complementary, gp, diag, trans commands  >>  <<03627>>06550000
        << command/trans - reporting message section       >>  <<03627>>06552000
        <<------------------------------------------------->>  <<03627>>06554000
                                                               <<03627>>06556000
                                                               <<03627>>06558000
<< 0>>  << write ctrl >>    %2005,  <<cmd/trans msg secondary>><<03627>>06560000
<< 1>>                          0,  <<cmd buffer byte length>> <<03627>>06562000
<< 2>>                          0,  << burst >>                <<03627>>06564000
<< 3>>  << sel dev clr >>   %2000,  << cmd buffer bank >>      <<03627>>06566000
<< 4>>                          0,  << cmd buffer abs addr >>  <<03627>>06568000
                                                               <<03627>>06570000
<< 5>>  << wait >>          %1000,  << wait for // poll >>     <<03627>>06572000
<< 6>>                          0,                             <<03627>>06574000
                                                               <<03627>>06576000
<< 7>>  << qstat >>         %2402,  <<reporting msg secondary>><<03627>>06578000
<< 8>>                          0,  << return byte >>          <<03627>>06580000
<< 9>>                          0,  << normal completion >>    <<03627>>06582000
<<10>>                        -35,  <<hard error - req status>><<03627>>06584000
<<11>>                          2,  << power on occurred >>    <<03627>>06586000
                                                               <<03627>>06588000
<<12>>  << int/hlt0 >>       %601,  << interrupt/halt >>       <<03627>>06590000
<<13>>                          0,  << code of 0 in cpva(1) >> <<03627>>06592000
                                                               <<03627>>06594000
                                                               <<03627>>06596000
        <<------------------------------------------------->>  <<03627>>06598000
        << [pon] sel dev clear/parity enabled on power on  >>  <<03627>>06600000
        <<------------------------------------------------->>  <<03627>>06602000
                                                               <<03627>>06604000
                                                               <<03627>>06606000
<< 0>>                      %4401,  << sel dev clr/parity on >><<03627>>06608000
<< 1>>                          0,                             <<03627>>06610000
                                                               <<03627>>06612000
<< 2>>                      %1000,  << wait for // poll >>     <<03627>>06614000
<< 3>>                          0,                             <<03627>>06616000
                                                               <<03627>>06618000
<< 4>>                      %2402,  <<reporting msg secondary>><<03627>>06620000
<< 5>>                          0,  << return byte >>          <<03627>>06622000
<< 6>>                          0,  << normal completion >>    <<03627>>06624000
<< 7>>                          0,  << hold off status >>      <<03627>>06626000
<< 8>>                         -9,  << power on occurred >>    <<03627>>06628000
                                                               <<03627>>06630000
<< 9>>  << int/hlt2 >>       %601,  << interrupt/halt >>       <<03627>>06632000
<<10>>                          2,  << code of 2 in cpva(1) >> <<03627>>06634000
                                                               <<03627>>06636000
                                                               <<03627>>06638000
        <<------------------------------------------------->>  <<03627>>06640000
        << [ident] channel instruction identify            >>  <<03627>>06642000
        <<------------------------------------------------->>  <<03627>>06644000
                                                               <<03627>>06646000
                                                               <<03627>>06648000
<< 0>>  << identify >>      %3000,                             <<03627>>06650000
<< 1>>                          0,  << id return byte >>       <<03627>>06652000
                                                               <<03627>>06654000
<< 2>>                       %601,  << interrupt/halt >>       <<03627>>06656000
<< 3>>                          0,  << code of 0 in cpva(1) >> <<03627>>06658000
                                                               <<03627>>06660000
                                                               <<03627>>06662000
        <<------------------------------------------------->>  <<03627>>06664000
        << miscellaneous storage and constants area        >>  <<03627>>06666000
        <<------------------------------------------------->>  <<03627>>06668000
                                                               <<03627>>06670000
                                                               <<03627>>06672000
<<  0>> << status'cdb >>      %15,  << cdb for req status >>   <<03627>>06674000
<<  0>> << initflg >>           0,  << initialization flag >>  <<03627>>06676000
<<  0>> << fill word >>         0,  <<for fill w/zeros,blanks>><<03627>>06678000
                                                               <<03627>>06680000
<<  0>> << status >>    0,0,0,0,0,  << status/describe area >> <<03627>>06682000
<<  5>>                 0,0,0,0,0,                             <<03627>>06684000
                                                               <<03627>>06686000
<<  0>> << cdb area >>  0,0,0,0,0,  <<cdb area/describe area>> <<03627>>06688000
<<  5>>                 0,0,0,0,0;                             <<03627>>06690000
                                                               <<03627>>06692000
                                                               <<03627>>06694000
                                                               <<03627>>06696000
        <<*********************************>>                  <<03627>>06698000
        <<*                               *>>                  <<03627>>06700000
        <<*   driver db area definition   *>>                  <<03627>>06702000
        <<*                               *>>                  <<03627>>06704000
        <<*********************************>>                  <<03627>>06706000
                                                               <<03627>>06708000
<<---------------------------------------------------->>       <<03627>>06710000
<<                                                    >>       <<03627>>06712000
<<       variable declarations for the driver         >>       <<03627>>06714000
<<                                                    >>       <<03627>>06716000
<<---------------------------------------------------->>       <<03627>>06718000
                                                               <<03627>>06720000
   integer pointer                                             <<03627>>06722000
      siop,    << holds channel program >>                     <<03627>>06724000
      statsio; << points to start of status chan prog >>       <<03627>>06726000
                                                               <<03627>>06728000
                                                               <<03627>>06730000
   byte array                                                  <<03627>>06732000
      message(0:71);                                           <<03627>>06734000
                                                               <<03627>>06736000
   array                                                       <<03627>>06738000
      buffer(*) = buffer'address,                              <<03627>>06740000
      sector(*) = disc'sector;                                 <<03627>>06742000
                                                               <<03627>>06744000
   integer                                                     <<03627>>06746000
      drt,                                                     <<03627>>06748000
      unit,                                                    <<03627>>06750000
                                                               <<03627>>06752000
      x   =  x,                                                <<03627>>06754000
                                                               <<03627>>06756000
      length = length'trans,                                   <<03627>>06758000
      temp'stat,                                               <<03627>>06760000
      num'of'retry;                                            <<03627>>06762000
                                                               <<03627>>06764000
   logical                                                     <<03627>>06766000
      dbbank,                                                  <<03627>>06768000
      dbpointer,                                               <<03627>>06770000
      xfercnt;                                                 <<03627>>06772000
                                                               <<03627>>06774000
                                                               <<03627>>06776000
   logical siobase;                                            <<03627>>06778000
                                                               <<03627>>06780000
   array cpvap(0:135);                                         <<03627>>06782000
                                                               <<03627>>06784000
                                                               <<03627>>06786000
$page                                                          <<03627>>06788000
                                                               <<03627>>06790000
<<****************************************************>>       <<03627>>06792000
<<                                                    >>       <<03627>>06794000
<<   cs'80 disc driver subroutines                    >>       <<03627>>06796000
<<                                                    >>       <<03627>>06798000
<<****************************************************>>       <<03627>>06800000
                                                               <<03627>>06802000
                                                               <<03627>>06804000
                                                               <<03627>>06806000
<<---------------------------------------------------->>       <<03627>>06808000
<<                                                    >>       <<03627>>06810000
<<   store'byte'abs -- subroutine to store the        >>       <<03627>>06812000
<<                     cs80 command bytes into        >>       <<03627>>06814000
<<                     the correct channel program    >>       <<03627>>06816000
<<                     area.  used to circumvent      >>       <<03627>>06818000
<<                     problems with storing bytes    >>       <<03627>>06820000
<<                     above the stack marker.        >>       <<03627>>06822000
<<                                                    >>       <<03627>>06824000
<<---------------------------------------------------->>       <<03627>>06826000
                                                               <<03627>>06828000
   subroutine store'byte'abs(d'byte'addr,abyte);               <<03627>>06830000
      value d'byte'addr,abyte;                                 <<03627>>06832000
      double d'byte'addr;                                      <<03627>>06834000
      logical abyte;                                           <<03627>>06836000
   begin                                                       <<03627>>06838000
      if not logical(d'byte'addr) then abyte:=abyte&lsl(8);    <<03627>>06840000
      if not logical(d'byte'addr)                              <<03627>>06842000
       then abs(logical(d'byte'addr/2d)):=                     <<03627>>06844000
          abs(logical(d'byte'addr/2d)) land %377 lor abyte     <<03627>>06846000
       else abs(logical(d'byte'addr/2d)):=                     <<03627>>06848000
          abs(logical(d'byte'addr/2d)) land %177400 lor abyte; <<03627>>06850000
   end;                                                        <<03627>>06852000
                                                               <<03627>>06854000
                                                               <<03627>>06856000
<<---------------------------------------------------->>       <<03627>>06858000
<<                                                    >>       <<03627>>06860000
<<   set'cmd'bytes -- subroutine to set up the        >>       <<03627>>06862000
<<                    command data bytes for read     >>       <<03627>>06864000
<<                    and write operations.           >>       <<03627>>06866000
<<                                                    >>       <<03627>>06868000
<<---------------------------------------------------->>       <<03627>>06870000
                                                               <<03627>>06872000
     subroutine set'cmd'bytes;                                 <<03627>>06874000
                                                               <<03627>>06876000
       begin                                                   <<03627>>06878000
         siop(rstat4) := siobase + stat'cdb;                   <<03627>>06880000
         siop(rstat11) := siobase + stat'area;                 <<03627>>06882000
         siop(dxfer3).(8:8) := dbbank;                         <<03627>>06884000
         siop(dxfer4):=siobase + cdb'area'wrd;                 <<03627>>06886000
         store'byte'abs(command'byte'area+0d,cdb'set'unit);    <<03627>>06888000
         store'byte'abs(command'byte'area+1d,cdb'set'vol);     <<03627>>06890000
                                                               <<03627>>06892000
         store'byte'abs(command'byte'area+2d,cdb'set'sngl'vec);<<03627>>06894000
         store'byte'abs(command'byte'area+3d,0);               <<03627>>06896000
         store'byte'abs(command'byte'area+4d,0);               <<03627>>06898000
         if sector(0).(0:8) <> 0 then assemble( halt );        <<03627>>06900000
         store'byte'abs(command'byte'area+5d,0);               <<03627>>06902000
         store'byte'abs(command'byte'area+6d,sector(0).(8:8)); <<03627>>06904000
         store'byte'abs(command'byte'area+7d,sector(1).(0:8)); <<03627>>06906000
         store'byte'abs(command'byte'area+8d,sector(1).(8:8)); <<03627>>06908000
         store'byte'abs(command'byte'area+9d,cdb'set'length);  <<03627>>06910000
         store'byte'abs(command'byte'area+10d,0);              <<03627>>06912000
         store'byte'abs(command'byte'area+11d,0);              <<03627>>06914000
         store'byte'abs(command'byte'area+12d,xfercnt.(0:8));  <<03627>>06916000
         store'byte'abs(command'byte'area+13d,xfercnt.(8:8));  <<03627>>06918000
       end;                                                    <<03627>>06920000
                                                               <<03627>>06922000
$page                                                          <<03627>>06924000
   <<----------------------------------------->>               <<03627>>06926000
   <<                                         >>               <<03627>>06928000
   <<  startio -- subroutine to start the     >>               <<03627>>06930000
   <<             channel program for a       >>               <<03627>>06932000
   <<             series iii                  >>               <<03627>>06934000
   <<                                         >>               <<03627>>06936000
   <<----------------------------------------->>               <<03627>>06938000
                                                               <<03627>>06940000
subroutine startio( chan'pgm, wait );                          <<03627>>06942000
   value chan'pgm, wait;                                       <<03627>>06944000
   logical  chan'pgm, wait;                                    <<03627>>06946000
begin                                                          <<03627>>06948000
   initproc ( drt );                                           <<03627>>06950000
   if <> then                                                  <<03627>>06952000
   begin                                                       <<03627>>06954000
      move message := "CHANNEL NON-RESPONING";                 <<03627>>06956000
      print( message, -21, crlf);                              <<03627>>06958000
      temp'stat:=channel'error;<<channel not responding>>      <<03627>>06960000
   end;                                                        <<03627>>06962000
   sioproc ( drt, siobase );                                   <<03627>>06964000
   if <> then                                                  <<03627>>06966000
   begin                                                       <<03627>>06968000
      move message := "CS80-DISC NON-RESPONDING";              <<03627>>06970000
      print( message, -22, crlf);                              <<03627>>06972000
      temp'stat:=unit'failure; <<unit fault>>                  <<03627>>06974000
   end;                                                        <<03627>>06976000
   if wait then                                                <<03627>>06978000
      do until absolute(drt*4+3).(0:2) = 0;                    <<03627>>06980000
end;                                                           <<03627>>06982000
$page                                                          <<03627>>06984000
                                                               <<03627>>06986000
                                                               <<03627>>06988000
      <<----------------------------------------->>            <<03627>>06990000
      <<                                         >>            <<03627>>06992000
      <<     request'device'status               >>            <<03627>>06994000
      <<                                         >>            <<03627>>06996000
      <<    get the status from the device       >>            <<03627>>06998000
      <<    being addressed                      >>            <<03627>>07000000
      <<                                         >>            <<03627>>07002000
      <<----------------------------------------->>            <<03627>>07004000
                                                               <<03627>>07006000
      subroutine request'dev'status;                           <<03627>>07008000
                                                               <<03627>>07010000
      begin                                                    <<03627>>07012000
                                                               <<03627>>07014000
         siop(rstat4) := siobase + stat'cdb;                   <<03627>>07016000
         siop(rstat11) := siobase + stat'area;                 <<03627>>07018000
         siop(diag1) := 7;   << cbd byte count >>              <<03627>>07020000
         siop(diag3).(8:8) := dbbank;                          <<03627>>07022000
         siop(diag4):=siobase + cdb'area'wrd;                  <<03627>>07024000
         store'byte'abs(command'byte'area+0d,cdb'set'unit);    <<03627>>07026000
         store'byte'abs(command'byte'area+1d,cdb'set'length);  <<03627>>07028000
         store'byte'abs(command'byte'area+2d,0);               <<03627>>07030000
         store'byte'abs(command'byte'area+3d,0);               <<03627>>07032000
         store'byte'abs(command'byte'area+4d,0);               <<03627>>07034000
         store'byte'abs(command'byte'area+5d,0);               <<03627>>07036000
         store'byte'abs(command'byte'area+6d,cdb'write);       <<03627>>07038000
         siop(branchpt) := diagcp;                             <<03627>>07040000
                                                               <<03627>>07042000
      end;                                                     <<03627>>07044000
                                                               <<03627>>07046000
                                                               <<03627>>07048000
   <<-------------------------------------------->>            <<03627>>07050000
   <<                                            >>            <<03627>>07052000
   <<   which'error -- i/o interrogatrion        >>            <<03627>>07054000
   <<                  to determine error        >>            <<03627>>07056000
   <<                                            >>            <<03627>>07058000
   <<-------------------------------------------->>            <<03627>>07060000
                                                               <<03627>>07062000
                                                               <<03627>>07064000
   integer subroutine which'error;                             <<03627>>07066000
                                                               <<03627>>07068000
   begin                                                       <<03627>>07070000
                                                               <<03627>>07072000
      << error defaults to unit failure if no bits are on >>   <<03627>>07074000
      which'error := unit'failure;                             <<03627>>07076000
                                                               <<03627>>07078000
      if siop(infor'field).data'overrun or                     <<03627>>07080000
         siop(infor'field).def'blk'spare or                    <<03627>>07082000
         siop(infor'field).recov'data'ov or                    <<03627>>07084000
         siop(infor'field).marginal'data or                    <<03627>>07086000
         siop(infor'field).recov'data then                     <<03627>>07088000
                           which'error := successful'io;       <<03627>>07090000
                                                               <<03627>>07092000
      if siop(access'field).no'data'found or                   <<03627>>07094000
         siop(access'field).unrecov'data or                    <<03627>>07096000
         siop(access'field).unrecov'data'ov then               <<03627>>07098000
                            which'error := transfer'error;     <<03627>>07100000
$page                                                          <<03627>>07102000
                                                               <<03627>>07104000
      if siop(reject'field) <> 0 or                            <<03627>>07106000
         siop(fault'field).cross'unit or                       <<03627>>07108000
         siop(fault'field).ctrl'fault or                       <<03627>>07110000
         siop(fault'field).unit'fault or                       <<03627>>07112000
         siop(fault'field).diag'failed or                      <<03627>>07114000
         siop(fault'field).power'fail or                       <<03627>>07116000
         siop(access'field).illeg'par'oper or                  <<03627>>07118000
         siop(access'field).uninit'media or                    <<03627>>07120000
         siop(access'field).no'spare'avail or                  <<03627>>07122000
         siop(access'field).wrt'protect or                     <<03627>>07124000
         siop(access'field).end'of'file or                     <<03627>>07126000
         siop(access'field).end'of'volume or                   <<03627>>07128000
         siop(infor'field).maint'trk'ov then                   <<03627>>07130000
                           which'error := unit'failure;        <<03627>>07132000
                                                               <<03627>>07134000
      if siop(infor'field).oper'rel'reqst or                   <<03627>>07136000
         siop(infor'field).diag'rel'reqst or                   <<03627>>07138000
         siop(infor'field).int'maint'reqst or                  <<03627>>07140000
         siop(fault'field).int'maint'reqrd or                  <<03627>>07142000
         siop(fault'field).oper'rel'reqrd or                   <<03627>>07144000
         siop(fault'field).diag'rel'reqrd then                 <<03627>>07146000
                                                               <<03627>>07148000
         begin                                                 <<03627>>07150000
                                                               <<03627>>07152000
            siop(diag) := wrt'cmd'sec;                         <<03627>>07154000
            siop(diag1) := 2;   << cdb byte count >>           <<03627>>07156000
            siop(diag3) := %2000;                              <<03627>>07158000
            siop(diag4) := @siop + sysdb + cdb'area'wrd;       <<03627>>07160000
            siop(diag5) := %1000;                              <<03627>>07162000
            siop(diag6) := 0;                                  <<03627>>07164000
            store'byte'abs(command'byte'area+0d,               <<03627>>07166000
                 cdb'set'unit+ctrl'unit);                      <<03627>>07168000
            store'byte'abs(command'byte'area+1d,               <<03627>>07170000
              if siop(fault'field).int'maint'reqrd or          <<03627>>07172000
                 siop(fault'field).oper'rel'reqrd or           <<03627>>07174000
                 siop(fault'field).diag'rel'reqrd or           <<03627>>07176000
                 siop(infor'field).int'maint'reqst or          <<03627>>07178000
                 siop(infor'field).oper'rel'reqst then         <<03627>>07180000
                   cdb'release                                 <<03627>>07182000
              else                                             <<03627>>07184000
                   cdb'release'deny);                          <<03627>>07186000
            siop(branchpt) := diagcp;   << schedule release >> <<03627>>07188000
            startio( @siop, true );     << or release deny  >> <<03627>>07190000
            if cpvap(1).(14:2) <> 0 then                       <<03627>>07192000
              which'error := unit'failure;  << unit fault >>   <<03627>>07194000
         end;                                                  <<03627>>07196000
                                                               <<03627>>07198000
      if siop(access'field).dev'not'rdy or                     <<03627>>07200000
         siop(reject'field).msg'seq'viol or                    <<03627>>07202000
         siop(fault'field).rel'completed then                  <<03627>>07204000
                            which'error := retry;              <<03627>>07206000
                                                               <<03627>>07208000
   end;                                                        <<03627>>07210000
                                                               <<03627>>07212000
                                                               <<03627>>07214000
$page                                                          <<03627>>07216000
                                                               <<03627>>07218000
   <<-------------------------------------------->>            <<03627>>07220000
   <<                                            >>            <<03627>>07222000
   <<   get'status -- get the status of the      >>            <<03627>>07224000
   <<                 last transaction and       >>            <<03627>>07226000
   <<                 return it                  >>            <<03627>>07228000
   <<                                            >>            <<03627>>07230000
   <<-------------------------------------------->>            <<03627>>07232000
                                                               <<03627>>07234000
   integer subroutine get'status;                              <<03627>>07236000
                                                               <<03627>>07238000
   begin                                                       <<03627>>07240000
      if cpvap.errorcode = 6 or                                <<03627>>07242000
         cpvap.errorcode = 7 then get'status := channel'error  <<03627>>07244000
      else                                                     <<03627>>07246000
                                                               <<03627>>07248000
                                             <<channel error>> <<03627>>07250000
        if temp'stat <> 0 then get'status := temp'stat         <<03627>>07252000
                                                               <<03627>>07254000
      << check cpgm halt return coder >>                       <<03627>>07256000
        else if cpvap(1).(14:2) = 0 then  << successful i/o >> <<03627>>07258000
                get'status := successful'io                    <<03627>>07260000
             else if cpvap(1).(14:2) = 2 then << power fail >> <<03627>>07262000
                     get'status := unit'failure                <<03627>>07264000
                                        << error occured >>    <<03627>>07266000
                  else get'status := which'error;              <<03627>>07268000
   end;                                                        <<03627>>07270000
                                                               <<03627>>07272000
   subroutine call'debug;                                      <<03627>>07274000
   begin                                                       <<03627>>07276000
      help;                                                    <<03627>>07278000
   end;                                                        <<03627>>07280000
                                                               <<03627>>07282000
$page                                                          <<03627>>07284000
                                                               <<03627>>07286000
<<***********************************************>>            <<03627>>07288000
<<***********************************************>>            <<03627>>07290000
<<**                                           **>>            <<03627>>07292000
<<**      beginning of main code               **>>            <<03627>>07294000
<<**                                           **>>            <<03627>>07296000
<<***********************************************>>            <<03627>>07298000
<<***********************************************>>            <<03627>>07300000
                                                               <<03627>>07302000
                                                               <<03627>>07304000
   if length'trans < 0 then          << check if byte count >> <<03627>>07306000
         xfercnt := -length'trans    << convert to unsigned >> <<03627>>07308000
      else                           << byte count          >> <<03627>>07310000
         xfercnt := length'trans & lsl(1);                     <<03627>>07312000
                                                               <<03627>>07314000
   drt := drtunit.drtfield;  << get drt number from drtunit >> <<03627>>07316000
   unit := drtunit.unitfield;  << get the unit# from drtunit >><<03627>>07318000
                                                               <<03627>>07320000
   push(db);    << get the db pointer and remove bank >>       <<03627>>07322000
   dbpointer := tos;                                           <<03627>>07324000
   dbbank := tos;                                              <<03627>>07326000
                                                               <<03627>>07328000
   siobase := logical(@cpvap(8)) + dbpointer;                  <<03627>>07330000
   absolute(drt*4+2) := logical(@cpvap) + dbpointer;           <<03627>>07332000
   @siop := @cpvap(8);                                         <<03627>>07334000
   cpvap := 0;                                                 <<03627>>07336000
   move cpvap(1) := cpvap,(7);                                 <<03627>>07338000
   move siop := chan'pgm,(107);                                <<03627>>07340000
                                                               <<03627>>07342000
                                                               <<03627>>07344000
                                                               <<03627>>07346000
   if function > max'func or                                   <<03627>>07348000
      function < func'read then function := illegal'func;      <<03627>>07350000
   if type <> cs80 then function := illegal'func; <<bad type>> <<03627>>07352000
   if subtype <> hp7911 and                                    <<03627>>07354000
      subtype <> hp7912 and                                    <<03627>>07356000
      subtype <> hp7935 then                                   <<03627>>07358000
                 function:=illegal'func;  << illegal subtype >><<03627>>07360000
                                                               <<03627>>07362000
      temp'stat := retry;                                      <<03627>>07364000
      num'of'retry := 0;                                       <<03627>>07366000
                                                               <<03627>>07368000
   while num'of'retry <= max'retry and                         <<03627>>07370000
         temp'stat = retry  do                                 <<03627>>07372000
   begin                                                       <<03627>>07374000
      num'of'retry := num'of'retry + 1;                        <<03627>>07376000
                                                               <<03627>>07378000
$page                                                          <<03627>>07380000
                                                               <<03627>>07382000
   <<-------------------------------------------->>            <<03627>>07384000
   <<                                            >>            <<03627>>07386000
   <<   case statement for function evaluation   >>            <<03627>>07388000
   <<                                            >>            <<03627>>07390000
   <<-------------------------------------------->>            <<03627>>07392000
                                                               <<03627>>07394000
   case function of                                            <<03627>>07396000
      begin                                                    <<03627>>07398000
                                                               <<03627>>07400000
      <<----------------------------------------->>            <<03627>>07402000
      <<                                         >>            <<03627>>07404000
      <<  function           operation           >>            <<03627>>07406000
      <<  ________           _________           >>            <<03627>>07408000
      <<                                         >>            <<03627>>07410000
      <<                                         >>            <<03627>>07412000
      <<      0              read                >>            <<03627>>07414000
      <<      1              write               >>            <<03627>>07416000
      <<      2              new'pack (7935)     >>            <<03627>>07418000
      <<      3              clear device        >>            <<03627>>07420000
      <<      4              read full sector    >>            <<03627>>07422000
      <<      5              error cases         >>            <<03627>>07424000
      <<                                         >>            <<03627>>07426000
      <<                                         >>            <<03627>>07428000
      <<----------------------------------------->>            <<03627>>07430000
                                                               <<03627>>07432000
$page                                                          <<03627>>07434000
                                                               <<03627>>07436000
      <<----------------------------------------->>            <<03627>>07438000
      <<                                         >>            <<03627>>07440000
      <<   read [ function = 0 ]                 >>            <<03627>>07442000
      <<                                         >>            <<03627>>07444000
      <<   xfercnt - transfer count              >>            <<03627>>07446000
      <<   sector - 2 wrd array with sector addr >>            <<03627>>07448000
      <<   buffer - 2 wrd array with buffer addr >>            <<03627>>07450000
      <<                                         >>            <<03627>>07452000
      <<----------------------------------------->>            <<03627>>07454000
                                                               <<03627>>07456000
      begin                                                    <<03627>>07458000
                                                               <<03627>>07460000
         set'cmd'bytes;                                        <<03627>>07462000
         siop(dxfer1) := 15;   << cdb byte count >>            <<03627>>07464000
                                                               <<03627>>07466000
         if xfercnt = 0 then  <<no transfer count>>            <<03627>>07468000
            begin                                              <<03627>>07470000
               siop(dxfer5) := 0; << bypass exec msg >>        <<03627>>07472000
               siop(dxfer6) := 5; << jump *+5 >>               <<03627>>07474000
            end                                                <<03627>>07476000
         else   << set up execution message >>                 <<03627>>07478000
            begin                                              <<03627>>07480000
               siop(dxfer7) := read'exec'sec;                  <<03627>>07482000
               siop(dxfer8) := xfercnt;  << data byte count >> <<03627>>07484000
               siop(dxfer10).(8:8) := buffer(0); <<data bank>> <<03627>>07486000
               siop(dxfer11) := buffer(1); <<abs data buffer>> <<03627>>07488000
            end;                                               <<03627>>07490000
                                                               <<03627>>07492000
         store'byte'abs(command'byte'area+14d,cdb'read);       <<03627>>07494000
         siop(branchpt) := dxfercp;                            <<03627>>07496000
                                                               <<03627>>07498000
      end;                                                     <<03627>>07500000
                                                               <<03627>>07502000
$page                                                          <<03627>>07504000
                                                               <<03627>>07506000
      <<----------------------------------------->>            <<03627>>07508000
      <<                                         >>            <<03627>>07510000
      <<   write [ function = 1 ]                >>            <<03627>>07512000
      <<                                         >>            <<03627>>07514000
      <<   xfercnt - transfer count              >>            <<03627>>07516000
      <<   sector - 2 wrd array with sector addr >>            <<03627>>07518000
      <<   buffer - 2 wrd array with buffer addr >>            <<03627>>07520000
      <<                                         >>            <<03627>>07522000
      <<----------------------------------------->>            <<03627>>07524000
                                                               <<03627>>07526000
      begin                                                    <<03627>>07528000
                                                               <<03627>>07530000
         set'cmd'bytes;                                        <<03627>>07532000
         siop(dxfer1) := 15;   << cdb byte count >>            <<03627>>07534000
                                                               <<03627>>07536000
         if xfercnt = 0 then  <<no transfer count>>            <<03627>>07538000
            begin                                              <<03627>>07540000
               siop(dxfer5) := 0; << bypass exec msg >>        <<03627>>07542000
               siop(dxfer6) := 5; << jump *+5 >>               <<03627>>07544000
            end                                                <<03627>>07546000
         else   << set up execution message >>                 <<03627>>07548000
            begin                                              <<03627>>07550000
               siop(dxfer7) := wrt'exec'sec;                   <<03627>>07552000
               siop(dxfer8) := xfercnt;  << data byte count >> <<03627>>07554000
               siop(dxfer10).(8:8) := buffer(0); <<data bank>> <<03627>>07556000
               siop(dxfer11) := buffer(1); <<abs data buffer>> <<03627>>07558000
            end;                                               <<03627>>07560000
                                                               <<03627>>07562000
         store'byte'abs(command'byte'area+14d,cdb'write);      <<03627>>07564000
         siop(branchpt) := dxfercp;                            <<03627>>07566000
                                                               <<03627>>07568000
      end;                                                     <<03627>>07570000
                                                               <<03627>>07572000
$page                                                          <<03627>>07574000
                                                               <<03627>>07576000
      <<----------------------------------------->>            <<03627>>07578000
      <<                                         >>            <<03627>>07580000
      <<   new'disk pack  [ function = 2 ]       >>            <<03627>>07582000
      <<                                         >>            <<03627>>07584000
      <<   wait for a new pack to bre inserted   >>            <<03627>>07586000
      <<   then return a successful status       >>            <<03627>>07588000
      <<   not supported on the series ii/iii    >>            <<03627>>07590000
      <<                                         >>            <<03627>>07592000
      <<----------------------------------------->>            <<03627>>07594000
                                                               <<03627>>07596000
      function:=illegal'func;                                  <<03627>>07598000
                                                               <<03627>>07600000
                                                               <<03627>>07602000
      <<---------------------------------------------------->> <<03627>>07604000
      <<                                                    >> <<03627>>07606000
      <<     clear device [ function code = 3 ]             >> <<03627>>07608000
      <<                                                    >> <<03627>>07610000
      <<---------------------------------------------------->> <<03627>>07612000
                                                               <<03627>>07614000
      begin                                                    <<03627>>07616000
                                                               <<03627>>07618000
         siop(diag3) := %4401;   <<sel dev clr parity enable>> <<03627>>07620000
         siop(diag4) := 0;                                     <<03627>>07622000
                                                               <<03627>>07624000
         siop(branchpt) := diagcp + 3;                         <<03627>>07626000
                                                               <<03627>>07628000
      end;                                                     <<03627>>07630000
                                                               <<03627>>07632000
$page                                                          <<03627>>07634000
                                                               <<03627>>07636000
      <<----------------------------------------->>            <<03627>>07638000
      <<                                         >>            <<03627>>07640000
      <<   read full sector [ function = 4 ]     >>            <<03627>>07642000
      <<                                         >>            <<03627>>07644000
      <<   sector - 2 wrd array with sector addr >>            <<03627>>07646000
      <<   buffer - 2 wrd array with buffer addr >>            <<03627>>07648000
      <<                                         >>            <<03627>>07650000
      <<----------------------------------------->>            <<03627>>07652000
                                                               <<03627>>07654000
      request'dev'status;                                      <<03627>>07656000
                                                               <<03627>>07658000
                                                               <<03627>>07660000
      ;  << illegal function invoked >>                        <<03627>>07662000
                                                               <<03627>>07664000
   end;  <<---------------------------->>                      <<03627>>07666000
         <<                            >>                      <<03627>>07668000
         <<    end of case statement   >>                      <<03627>>07670000
         <<                            >>                      <<03627>>07672000
         <<---------------------------->>                      <<03627>>07674000
$page                                                          <<03627>>07676000
                                                               <<03627>>07678000
<< start channel program >>                                    <<03627>>07680000
                                                               <<03627>>07682000
                                                               <<03627>>07684000
   if function < max'func then                                 <<03627>>07686000
      startio( @siop, true );  << start the channel program >> <<03627>>07688000
                                                               <<03627>>07690000
                                                               <<03627>>07692000
   <<-------------------------------------------->>            <<03627>>07694000
   <<                                            >>            <<03627>>07696000
   <<   status reporting                         >>            <<03627>>07698000
   <<   ________________                         >>            <<03627>>07700000
   <<                                            >>            <<03627>>07702000
   <<                                            >>            <<03627>>07704000
   <<     1        successful'io                 >>            <<03627>>07706000
   <<   %14        transfer'error                >>            <<03627>>07708000
   <<   %54        unit'failure                  >>            <<03627>>07710000
   <<  %144        channel error                 >>            <<03627>>07712000
   <<                                            >>            <<03627>>07714000
   <<                                            >>            <<03627>>07716000
   <<-------------------------------------------->>            <<03627>>07718000
                                                               <<03627>>07720000
                                                               <<03627>>07722000
   if function = illegal'func then temp'stat := unit'failure   <<03627>>07724000
      else temp'stat := get'status;                            <<03627>>07726000
                                                               <<03627>>07728000
   end;  << end of retry loop >>                               <<03627>>07730000
   if temp'stat = retry then cs80dsc0 := unit'failure          <<03627>>07732000
                        else cs80dsc0 := temp'stat;            <<03627>>07734000
end;                                                           <<03627>>07736000
$page                                                                   07738000
procedure discerror(ldev,errstat,addr,words,mode,errstat2);             07740000
value ldev,errstat,addr,words,mode,errstat2;                            07742000
integer ldev,errstat,words,mode,errstat2;                               07744000
double addr;                                                            07746000
begin                                                                   07748000
     integer l;                                                         07750000
     byte array mbuf(0:71);  <<message buffer>>                         07752000
     byte array errtypes(0:14)=pb:="READ WRITESEEK ";                   07754000
                                                                        07756000
     move mbuf:=" DISC ",2;                                             07758000
     move *:=errtypes(mode*5),(5),2;                                    07760000
     move *:=" ERR ON LDEV #";                                          07762000
     l:=ascii(ldev,mbuf(25));                                           07764000
     move mbuf(25+l):=" STATUS=%000000";                                07766000
     ascii(errstat,mbuf(34+l),8);                                       07768000
     l:=l+6;                                                            07770000
     if errstat2<>0 then                                                07772000
     begin                                                              07774000
          move mbuf(34+l):=",%000000";                                  07776000
          ascii(errstat2,mbuf(36+l),8);                                 07778000
          l:=l+8;                                                       07780000
     end;                                                               07782000
     move mbuf(34+l):=" ADDR=% ";                                       07784000
     tos:=dascii(addr,8,mbuf(xreg:=xreg+8));                            07786000
     l:=l+tos;                                                          07788000
     tos:=@mbuf & lsr(1);                                               07790000
     tos:=-(l+42);  << message length >>                                07792000
     print(*,*,0);                                                      07794000
     push(q);                                                           07796000
     tos:=qm0;                                                          07798000
     tos:=tos-tos;                                                      07800000
     set(q);  <<set q back one marker to that of discio>>               07802000
     cc:=ccl;                                                           07804000
     assemble(exit 8);  <<exit with # of parms of discio>>              07806000
end << discerror >>;                                                    07808000
                                                                        07810000
$page                                                                   07812000
procedure notready(ldev);                                               07814000
value ldev;                                                             07816000
integer ldev;                                                           07818000
begin                                                                   07820000
     integer l,offset;                                                  07822000
     array mbufw(0:14);  <<message buffer>>                    <<01.01>>07824000
     byte array mbuf(*) = mbufw;                               <<01.01>>07826000
     equate editfunct = 13;                                             07828000
                                                                        07830000
     move mbuf:="  ";                                                   07832000
     offset:= 2;                                                        07834000
     move mbuf(offset):="LDEV    ";                                     07836000
     tos:=ascii(ldev,mbuf(5+offset));                                   07838000
     l:=tos+5+offset;                                                   07840000
     move mbuf(l):=" NOT READY";                                        07842000
     print(mbufw,-(l+10),0);                                   <<01.01>>07844000
 end << notready >>;                                                    07846000
                                                                        07848000
$page                                                                   07850000
<<*********************************************************>>           07852000
                                                                        07854000
                                                                        07856000
integer procedure alttrack(ldev,drtunit,stype,track,lps);               07858000
  value   ldev,drtunit,stype,track,lps;                                 07860000
  integer ldev,drtunit,stype,track,lps;                                 07862000
  << returns alternate track number of track >>                         07864000
    << returns -1 if no good alternate track read >>                    07866000
  begin                                                                 07868000
        integer i := -1;                                                07870000
    integer index;                                                      07872000
    double sector;                                                      07874000
        integer array b(0:140) = q;                                     07876000
                                                                        07878000
          tos := mhinfo ((index:=mhinfosize*stype)+mhsectrk);  <<01.01>>07880000
          tos := track;                                                 07882000
          assemble(lmpy);                                               07884000
          sector := tos;                                                07886000
          if stype<4 then <<not 7905>>                                  07888000
    while (i:=i+1)<10 do                                                07890000
      begin                                                             07892000
        mhdisk(ldev,drtunit,stype,readfs,sector,b,                      07894000
          if stype=3 then 4 else 132);                                  07896000
        xreg := if stype=3 then 2 else 131;                             07898000
        if b=b(xreg) then                                               07900000
          begin                                                         07902000
            tos := b.(2:14);                                            07904000
            if stype=2 then assemble(tsbc 7);                           07906000
            alttrack := tos;                                            07908000
            return;                                                     07910000
          end;                                                          07912000
      end                                                               07914000
          else while (i:=i+1) < mhinfo(index+mhsectrk) -1 do   <<01.01>>07916000
            begin                                                       07918000
              mh7905(ldev,drtunit,stype,readfs,sector+double(i),b,      07920000
           141,lps);                                                    07922000
              if b(1)=b(139) and b(2).(3:5)=b(140).(3:5) then           07924000
                begin  <<valid alternate address>>                      07926000
                  if b(1)=-1 then alttrack := -1                        07928000
                  else if b(1)=0 and b(2).(3:5)=0 then alttrack:=0      07930000
                  else alttrack := b(1) * mhinfo(index         <<01.01>>07932000
                    +mhtrkcyl)+b(2).(3:5)-mhinfo(index+mhsthead);       07934000
                  return;                                               07936000
                end;                                                    07938000
            end;                                                        07940000
          alttrack := -2;  <<no good alt track read>>                   07942000
  end;  << alttrack >>                                                  07944000
                                                                        07946000
$page                                                                   07948000
logical procedure testio(drt,mask);                                     07950000
value drt,mask;                                                         07952000
integer drt;    <<drt number>>                                          07954000
logical mask;   <<status mask>>                                         07956000
     << executes a tio instruction on the indicated controller          07958000
        and returns the status anded with the mask;                     07960000
     >>                                                                 07962000
      begin                                                             07964000
          tos := drt;                                                   07966000
          assemble(tio 0;bl *-1);                                       07968000
          testio := logical(tos) land mask;                             07970000
      end << testio >> ;                                                07972000
                                                                        07974000
  logical procedure executesio(drt,address);                            07976000
    value drt,address;                                                  07978000
    integer drt;         <<drt number>>                                 07980000
    logical address;     <<address of sio program>>                     07982000
    comment                                                             07984000
      executes an sio instruction on the specified controller, waits    07986000
    for its completion, and returns the status;                         07988000
      begin                                                             07990000
        logical status=executesio;                                      07992000
          tos := drt;                                                   07994000
          tos := address;                                               07996000
          assemble(sio 1;bl *-1;be *+3;del;br *-4);                     07998000
          while status=0 do                                             08000000
          if testio(drt,%120000)<>0 then status:=testio(drt,%177777);   08002000
end << executesio >>;                                                   08004000
$page "HP/3000 DISC UTILITY - DISC DRIVERS"                             08006000
                                                                        08008000
          <<------------------------                                    08010000
            fixed-head disk driver                                      08012000
          ------------------------>>                                    08014000
  procedure fhdisk(ldev,drtunit,stype,write,record,buf,wc);             08016000
    value drtunit,stype,write,record,wc,ldev;                           08018000
    integer drtunit,     <<drt and unit number>>                        08020000
            ldev,         <<logical device #>>                          08022000
            stype,       <<subtype - for different sized disks>>        08024000
            wc;          <<word count>>                                 08026000
    logical write;       <<0 for read, 1 for write>>                    08028000
    double record;       <<sector address>>                             08030000
    array buf;           <<core buffer>>                                08032000
    comment                                                             08034000
      performs a disk transfer on the fixed-head disk;                  08036000
      begin                                                             08038000
        logical address=record+1;   <<all addresses <17 bits>>          08040000
        equate siocntrl  =    %40000,                                   08042000
       sioend      =    %30000,                                         08044000
       arcptrk     =    32,                                             08046000
       maxtrk      =    511;                                            08048000
        integer error := 0;                                             08050000
        integer sdb,drt,j;                                              08052000
   logical arcwrd,trkwrd,stat,                                          08054000
        com1:=%170000,                                                  08056000
        com2:=%070000;                                                  08058000
        array s(0:19)=q;   <<sio program area>>                         08060000
        integer track, xreg = x, s2 = s-2;                              08062000
        integer array tbuf(0:127);                                      08064000
        integer dbval;                                                  08066000
                                                                        08068000
   push(db);                                                            08070000
   dbval:=tos;                                                          08072000
   delete;                                                              08074000
   cc:=cce;  <<assume successful completion>>                           08076000
   tos:=dbval;  sdb:=tos;                                               08078000
   tos := drtunit&lsr(8);                                               08080000
   drt := s0;                                                           08082000
   assemble(tio 0; bl *-1);                                             08084000
   if s0.(2:1)=1 then                                                   08086000
     begin   <<reset previous interrupt>>                               08088000
       tos := %100000;                                                  08090000
       assemble(cio 1; bl*-1);                                          08092000
     end;                                                               08094000
   if tos.(3:1)=1 then                                                  08096000
     begin   <<device not ready>>                                       08098000
       notready(ldev);                                                  08100000
     waitfoready:                                                       08102000
       assemble(tio 0; bl *-1);                                         08104000
       if tos.(3:1)=1 then go waitfoready;                              08106000
     end;                                                               08108000
   if write then begin com1:=%160000; com2:=%60000 end;                 08110000
   tos:=0;                                                              08112000
   tos:=address;                                                        08114000
   tos:=arcptrk;                                                        08116000
   assemble(ldiv);                                                      08118000
   arcwrd:=tos;                                                         08120000
   trkwrd:=tos;                                                         08122000
   if trkwrd > maxtrk then  <<invalid disc address>>                    08124000
     begin                                                              08126000
       cc:=ccl;                                                         08128000
       message(1);                                                      08130000
       return;                                                          08132000
     end;                                                               08134000
  tryagain:                                                             08136000
          j := 0;                                                       08138000
          s := siocntrl lor arcwrd;                                     08140000
          s(1) := trkwrd;                                               08142000
          while wc>4096 do                                              08144000
            begin                                                       08146000
              s(xreg:=xreg+1) := com1;                                  08148000
              s(xreg:=xreg+1) := @buf+j+sdb;                            08150000
              j := j+4096;                                              08152000
              wc := wc-4096;                                            08154000
            end;                                                        08156000
          s(xreg:=xreg+1) := logical(-wc).(4:12) lor com2;              08158000
          s(xreg:=xreg+1) := @buf+sdb+j;                                08160000
          s(xreg:=xreg+1) := sioend;                                    08162000
          s(xreg:=xreg+1) := 0;                                         08164000
          tos := executesio(drt,@s+sdb);                                08166000
          if tos.(3:7) <> 0 then                                        08168000
          if (error:=error+1) < 10 then                                 08170000
            begin                                                       08172000
              tos := %100000;                                           08174000
              assemble(cio 1; bl *-1);                                  08176000
              go tryagain;                                              08178000
            end                                                         08180000
          else                                                          08182000
            begin   <<output error message>>                            08184000
              tos := ldev;                                              08186000
              if = then assemble(halt 0);  <<in bootstrap>>             08188000
              assemble(tio 1; bl *-1);    <<get normal status word>>    08190000
              tos := 0;  <<high order word of address>>                 08192000
              tos := 2;  <<select status word 2>>                       08194000
              assemble(cio 4; bl*-1; tio 3; bl*-1);                     08196000
              tos := tos.(4:12)&lsl(5);  <<bad track addr>>             08198000
              tos := 1;  <<select status word 2>>                       08200000
              assemble(cio 5; bl*-1; tio 4; bl*-1);                     08202000
              tos := tos.(10:6);  <<arc address>>                       08204000
              assemble(add);                                            08206000
              tos := s2;  << get status >>                              08208000
              if tos.(3:7)=%60 then  << track specific error >>         08210000
               begin                                                    08212000
                 tos := record&dasr(5);                                 08214000
                 delb;                                                  08216000
                  track := tos&lsl(2);                                  08218000
                  if = then goto t1;                                    08220000
                 fhdisk(ldev,drtunit,stype,readd, 1 d,tbuf,128);        08222000
                 xreg := 0;                                             08224000
                 while (xreg:=xreg+1)<=tbuf do                          08226000
                   if tbuf(xreg)=track then goto t1; << already there >>08228000
                  tbuf := tbuf+1;                                       08230000
                 if xreg>120 then goto t1; << table full >>             08232000
                 tbuf(xreg) := track;                                   08234000
                 fhdisk(ldev,drtunit,stype,writed, 1 d,tbuf,128);       08236000
                end;         << marking bad track in map >>             08238000
t1:                                                                     08240000
              discerror(*,*,*,0,write,0);                               08242000
            end;                                                        08244000
end << fhdisk >>;                                                       08246000
                                                                        08248000
$page                                                                   08250000
          <<----------------------------------                          08252000
            7900/iss moving head disc driver                            08254000
          ---------------------------------->>                          08256000
  procedure mhdisk(ldev,drtunit,stype,funct,record,buf,wc);             08258000
    value ldev,drtunit,stype,funct,record,wc;                           08260000
    integer ldev,                                                       08262000
            drtunit,     <<drt and unit number>>                        08264000
            stype,       <<subtype - for different sized disks>>        08266000
            wc;          <<word count>>                                 08268000
   logical funct ;                                                      08270000
       <<   0  -  read                                                  08272000
            1  -  write                                                 08274000
            2  -  read and return ccl if track flagged defective;       08276000
                    or ccg if track specific error else cce             08278000
            3  -  flag a track defective; alt trk number in buf(0)      08280000
                    requires a word count of 46 words and a buffer      08282000
                    of 46 words which may be modified                   08284000
            4  -  read address or read next full sector                 08286000
            bit 1  indicates transfer from alternate track              08288000
       >>                                                               08290000
    double record;       <<sector address>>                             08292000
    array buf;           <<core buffer>>                                08294000
    comment                                                             08296000
      performs a disk transfer on the specified moving-head disk;       08298000
      begin                                                             08300000
        equate ftd      =%040000,                                       08302000
               siosense =%050000,                                       08304000
               ra       =%040000,                                       08306000
               rnfs     =%120000,                                       08308000
               altflag  =%40000,                                        08310000
               wa       =%130000;                                       08312000
        equate siocntrl    =   %40000,                                  08314000
               sioread     =   %70000,                                  08316000
               siowrite    =   %60000,                                  08318000
               sioend      =   %30000;                                  08320000
        equate diskread    =   0,                                       08322000
               diskwrite   =   %100000,                                 08324000
               diskstatus  =   %30000,                                  08326000
               diskrecal   =   %10000,                                  08328000
               diskseek    =   %20000;                                  08330000
        equate resetint    =   %40000,                                  08332000
               diskintrpt =   %20000;                                   08334000
                                                               <<01.01>>08336000
        integer array sctperhd(0:3)=pb:=24,24,24,23;                    08338000
                                                               <<01.01>>08340000
        integer array maxsctpread(0:3)=pb:=48,48,48,460;                08342000
        array pbufw(0:35);                                              08344000
        byte array pbuf(*)=pbufw;                                       08346000
                                                               <<01.01>>08348000
        integer ns,           <<# of sectors>>                          08350000
                dbval,        <<value of db.          >>                08352000
                as,           <<# of available sectors>>                08354000
                wc1,          <<current word count>>                    08356000
                drt,          <<drt number>>                            08358000
                unit,         <<unit number>>                           08360000
                sctincyl,     <<number of sectors in cylinder>>         08362000
                index,        <<holds mhinfosize*stype>>       <<01.01>>08364000
                counter,                                                08366000
                i:=0,         <<buffer index>>                          08368000
                rwerror:=0,   <<number of read/write errors>>           08370000
                track,   << defective track number >>                   08372000
                constat,            <<controller status>>               08374000
                x = x,                                                  08376000
                status = q-1,                                           08378000
                seekerror:=0; <<number of seek errors>>                 08380000
        logical siocom:=sioread,  <<sio command>>                       08382000
                diskcom:=diskread,<<disk command>>                      08384000
                errstat,      <<error status>>                          08386000
                errorbits,    <<seek error bits>>                       08388000
                counting,      <<timing out sio>>                       08390000
                hdsctr,           <<head and sector>>                   08392000
                unitcyl;          <<unit and cylinder>>                 08394000
        logical array s(0:9)=q;   <<sio program buffer>>                08396000
        integer array tbuf (0:131) = q;                                 08398000
        double dtbuf = tbuf;                                            08400000
                                                                        08402000
        logical subroutine waitforint;                                  08404000
        begin                                                           08406000
          tos := drt;                                                   08408000
  wait:   assemble(tio 0; bl *-1);                                      08410000
          s3 := s0;  <<status>>                                         08412000
          if tos.(2:1)<>1 then goto wait                                08414000
          else                                                          08416000
            begin  <<reset interrupt>>                                  08418000
              tos := resetint;                                          08420000
              assemble(cio 1; bl*-1);                                   08422000
              if s2.(13:3)<>unit then goto wait  <<wrong unit>>         08424000
            end;                                                        08426000
          del;                                                          08428000
        end <<waitforint>> ;                                            08430000
                                                                        08432000
        logical subroutine exanwait(index,sameunit);                    08434000
        value index,sameunit;                                           08436000
        integer index;                                                  08438000
        logical sameunit;  <<true if intrpt on this unit is valid>>     08440000
        begin                                                           08442000
          counting := true;                                             08444000
          counter := -32000;  <<1 second>>                              08446000
          s(index) := sioend;                                           08448000
          s(x:=x+1) := 0;                                               08450000
          tos := drt;                                                   08452000
          tos := dbval;                                                 08454000
          tos := tos+@s;                                                08456000
          assemble(sio 1; bl*-1; be*+3; del; br*-4);                    08458000
  test:   assemble(tio 0; bl*-1);                                       08460000
          s5 := s0;   <<status>>                                        08462000
          if tos.(2:1)=1 then                                           08464000
            begin   <<interrupt>>                                       08466000
              tos := resetint;                                          08468000
              assemble (cio 1; bl *-1);                                 08470000
              if s4.(13:3)=unit and logical(s2) then                    08472000
                begin                                                   08474000
                  do assemble(tio 0;bl*-1) until tos<0;                 08476000
  getout:         del;                                                  08478000
                  return;                                               08480000
                end                                                     08482000
              else                                                      08484000
                begin                                                   08486000
                  counter := -32000;                                    08488000
                  goto test;                                            08490000
                end;                                                    08492000
            end;                                                        08494000
          if s4<0 then goto getout;   <<sio ok>>                        08496000
          if (counter:=counter+1)=0 and counting then                   08498000
            begin  <<unit 0 not ready>>                                 08500000
              if unit=0 and ldev<>0 then notready(ldev) else            08502000
                begin                                                   08504000
                  move pbuf := "DISC IN DRT ";                          08506000
                  counter := ascii(drt,pbuf(12));                       08508000
                  move pbuf(12+counter) := " UNIT 0 NOT READY";         08510000
                  print(pbufw,-29-counter,0);                  <<01.01>>08512000
                end;                                                    08514000
              counting := false;                                        08516000
            end;                                                        08518000
          goto test;  <<wait for sio ok or interrupt>>                  08520000
        end <<exanwait>> ;                                              08522000
                                                                        08524000
          push(db);                                                     08526000
          dbval:=tos;                                                   08528000
          delete;                                                       08530000
          index := mhinfosize * stype;                         <<01.01>>08532000
          cc:=cce;  <<assume successful completion>>                    08534000
          tos := drtunit;                                               08536000
          duplicate;                                                    08538000
          drt := tos&lsr(8);                                            08540000
          unit := logical(tos) land %17;                                08542000
          if stype=3 then tos := %7000  else tos := %47000;             08544000
          errorbits := tos;                                             08546000
          s := siocntrl+unit&lsl(9);                                    08548000
          s(1) := diskstatus;  <<status check>>                         08550000
  scagain:tos := exanwait(2,false);                                     08552000
          if s0.(13:3)<>unit then                                       08554000
            begin  <<wrong unit because unit 0 wasn't ready>>           08556000
              del;                                                      08558000
              goto scagain;                                             08560000
            end;                                                        08562000
          if tos.(3:4)<>%10 then                                        08564000
            begin  <<not ready>>                                        08566000
              notready(ldev);                                           08568000
              waitforint;                                               08570000
            end;                                                        08572000
          ns := logical(wc+127)&lsr(7);   <<number of sectors>>         08574000
          if funct then                                                 08576000
            begin                                                       08578000
              diskcom := diskwrite;                                     08580000
              siocom := siowrite;                                       08582000
            end;                                                        08584000
  again:  tos := record;                                                08586000
          tos := mhinfo (index+mhseccyl); <<sectors/cylinder>> <<01.01>>08588000
          assemble(ldiv,zero; xch,dup);                                 08590000
          sctincyl := tos;                                              08592000
          tos := sctperhd (stype);                             <<01.01>>08594000
          assemble(ldiv,xch);                                           08596000
          tos := (tos + mhinfo(index+mhsthead)) & lsl(6);      <<01.01>>08598000
          assemble(or);                                                 08600000
          hdsctr := tos;  <<head and sector>>                           08602000
          tos := unit&lsl(9);                                           08604000
          assemble(or);                                                 08606000
          unitcyl := tos;  <<unit and cylinder>>                        08608000
          tos := maxsctpread(stype)-sctincyl;                  <<00898>>08610000
          if s0<1 then tos := tos+maxsctpread(x);                       08612000
          as := tos;   <<number of available sectors>>                  08614000
          tos := wc;                                                    08616000
          if ns>as then                                                 08618000
            begin                                                       08620000
              del;                                                      08622000
              tos := as&lsl(7);   <<number of words we can do>>         08624000
            end;                                                        08626000
          if s0>4096 then                                               08628000
            begin                                                       08630000
              del;                                                      08632000
              tos := 4096;   <<maximum transfer>>                       08634000
            end;                                                        08636000
  shortrack:                                                            08638000
          wc1 := tos;  <<# of words to transfer>>                       08640000
  retry:  seekerror := 0;                                               08642000
          s := unitcyl lor siocntrl;                                    08644000
  reseek: s(1) := hdsctr lor diskseek;   <<seek command>>               08646000
          tos := exanwait(2,true);  <<execute seek>>                    08648000
          if s0.(2:1)=1 then                                            08650000
          if (tos land errorbits)<>0 then goto seekerr else goto com    08652000
          else del;                                                     08654000
          if ((errstat:=waitforint) land errorbits) <> 0 then           08656000
            begin                                                       08658000
  seekerr:    s(1) := diskrecal;  <<recalibrate>>                       08660000
              exanwait(2,true);                                         08662000
              waitforint;                                               08664000
              if (seekerror:=seekerror+1)>10 then                       08666000
                begin   <<seek error>>                                  08668000
                  discerror(ldev,errstat,record,0,2,0);                 08670000
                end;                                                    08672000
              go reseek;  <<try again>>                                 08674000
            end;                                                        08676000
  com:    s(1) := hdsctr lor diskcom;  <<read/write command>>           08678000
          if funct=3 then    << flag a track defective  >>              08680000
            begin                                                       08682000
              if stype=3 then                                           08684000
                begin      << set up for write address >>               08686000
                  buf := buf+%100000;                                   08688000
                  x := 0;                                               08690000
                  while (x:=x+1)<46 do buf(x) := buf;                   08692000
                  s(1) := wa lor hdsctr;                                08694000
                end                                                     08696000
              else                                                      08698000
                begin      << form flag track sio program >>            08700000
                  s := siocntrl lor logical(buf) +(unitcyl land %3000); 08702000
                  s(1) := ftd lor hdsctr;                               08704000
                  s(2) := siosense;                                     08706000
                  i := 1;                                               08708000
                  goto t4;                                              08710000
                end;                                                    08712000
            end;                                                        08714000
                                                                        08716000
          if funct=4 then  << read address or next full sector >>       08718000
            s(1) := (if stype=3 then ra else rnfs) lor hdsctr;          08720000
                                                                        08722000
          s(2) := siocom+(logical(-wc1) land %7777);                    08724000
t4:                                                                     08726000
          tos := dbval;                                                 08728000
          s(3) := tos+@buf(i);                                          08730000
          if ((errstat:=exanwait(4,true)).(2:1))<>0 then                08732000
            begin                                                       08734000
              constat := errstat.(8:5);  <<controller status>>          08736000
              if constat=6 then  <<track flagged defective>>            08738000
                begin                                                   08740000
                  if funct=2 then   << return condition code ccl >>     08742000
                    begin                                               08744000
                      status.(6:2) := ccl;   << ccl >>                  08746000
                      return;                                           08748000
                    end;                                                08750000
                  tos := mhinfo (index+mhsectrk);              <<01.01>>08752000
                  tos := record;                                        08754000
                  tos := mhinfo (x);                           <<01.01>>08756000
                  assemble(ldiv,delb; sub);                             08758000
                  tos := tos&lsl(7);                                    08760000
                  if wc1 > s0 then goto shortrack                       08762000
                  else del;                                             08764000
t1:               tos := ldev;                                          08766000
                  tos := drtunit;                                       08768000
                  tos := stype;                                         08770000
                  tos := readfs;  <<read alternate track>>              08772000
                  tos := record;                                        08774000
                  tos := tos lor 1;  <<for mv controller error>>        08776000
                  mhdisk(*,*,*,*,*,tbuf,if stype=3 then 4 else 132);    08778000
                  x := if stype=3 then 2 else 131;                      08780000
                  if tbuf<>tbuf(x) then  << no trk # agreement >>       08782000
                    if (rwerror:=rwerror+1)>10 then  << irrecoverable >>08784000
                     goto t5 else goto t1;  << try again >>             08786000
                  tos := tbuf.(2:14);                                   08788000
                  if stype=2 then assemble(tsbc 7);                     08790000
                  tos := mhinfo (index+mhsectrk);              <<01.01>>08792000
                  asmb(lmpy,zero);                                      08794000
                  tos := record;  tos := mhinfo (x);           <<01.01>>08796000
                  asmb(ldiv,delb);  << sector number in track >>        08798000
                  asmb(dadd     );                                      08800000
                  dtbuf := tos;                                         08802000
                  mhdisk(ldev,drtunit,stype,funct lor altflag,dtbuf,    08804000
                   buf(i),wc1);  <<transfer from alternate track>>      08806000
                  goto t2;  << continue on >>                           08808000
                end;                                                    08810000
              if (rwerror:=rwerror+1)>10 then                           08812000
                begin                                                   08814000
                  tos := ldev;                                          08816000
                  if 5<=constat<=%11 or constat=%13 or constat=%22 then 08818000
                    begin   << track specific error >>                  08820000
t5:                                                                     08822000
                      if funct=2 then << return ccg >>                  08824000
                        begin                                           08826000
                          status.(6:2) := ccg;  << ccg >>               08828000
                          return;                                       08830000
                        end;                                            08832000
                      tos:=record; tos:=mhinfo(index+mhsectrk);<<01.01>>08834000
                      asmb(ldiv,del );   << track number >>             08836000
                      tos := funct; tos := altflag;<< alt trk bit msk >>08838000
                      track := (tos land tos lor tos)&csl(2);           08840000
                      if = then goto t3;                                08842000
                      mhdisk(ldev,drtunit,stype,readd, 1 d,tbuf,128);   08844000
                      x := 0;                                           08846000
                      while (x:=x+1)<=tbuf do                           08848000
                        if tbuf(x)=track then                           08850000
                          goto t3;  << already in table >>              08852000
                      tbuf := tbuf+1;                                   08854000
                      if x>120 then goto t3;  << no room >>             08856000
                      tbuf(x) := track;                                 08858000
                      mhdisk(ldev,drtunit,stype,writed,1 d,tbuf,128);   08860000
                    end;                                                08862000
t3:                                                                     08864000
                  discerror(*,errstat,record,wc1,funct.(15:1),0);       08866000
                end;                                                    08868000
              goto retry;                                               08870000
            end;                                                        08872000
t2:                                                                     08874000
          tos := wc1;                                                   08876000
          assemble(dup,dup);                                            08878000
          i := tos+i;   <<update buffer pointer>>                       08880000
          wc := -tos+wc;   <<update word count>>                        08882000
          if <= then return;  <<transferred all words>>                 08884000
          assemble(zero,xch);                                           08886000
          tos := logical(tos+127)&lsr(7);  <<# of sectors done>>        08888000
          assemble(dup,neg);                                            08890000
          ns := tos+ns;  <<# of sectors left to do>>                    08892000
          record := tos+record;                                         08894000
          go again;                                                     08896000
end << mhdisk >>;                                                       08898000
                                                                        08900000
$page                                                                   08902000
          <<----------------------------                                08904000
            7905/7920/7925 disc driver                                  08906000
          ---------------------------->>                                08908000
procedure mh7905(ldev,drtunit,stype,funct,record,buf,wc,lps);           08910000
value ldev,drtunit,stype,funct,record,wc,lps;                           08912000
    integer ldev,                                                       08914000
            drtunit,        <<drt and unit number>>                     08916000
            stype,          <<subtype>>                                 08918000
            wc,             <<word count>>                              08920000
            lps;            <<logical pack size>>                       08922000
    logical funct;          <<0: read                                   08924000
                              1: write                                  08926000
                              2: read and set cce - ok                  08928000
                                              ccl - defective track     08930000
                                              ccg - track specific error08932000
                            3: flag track defective                     08934000
                              4: read full sector>>                     08936000
    double record;          <<disc address>>                            08938000
    array buf;              <<core buffer>>                             08940000
      begin                                                             08942000
        define errcode  = (3:5)#,   <<error bits in status>>            08944000
               notrdy   = (14:1)#;  <<drive not ready>>                 08946000
        equate sioend   = %30000,   <<sio end instruction>>             08948000
               siojumpc = %4000,    <<sio conditional jump>>            08950000
               siocntrl = %40000;   <<sio control instruction>>         08952000
        equate cderr    = %17,      <<correctable data error>>          08954000
               spt      = %20,      <<spare track>>                     08956000
               dttlps   = %177,                                         08958000
               tfd      = %21;      <<defective track>>                 08960000
        equate d        = 1,        <<defective track bit>>             08962000
               sp       = 4;        <<spare track bit>>                 08964000
        equate seekcom  = %1200,    <<seek command>>                    08966000
               reqstat  = %1400,    <<request status commaad>>          08968000
               reqadr   = %12000,   <<request address command>>         08970000
               endop    = %12400,   <<end command>>                     08972000
               reqsynd  = %6400,    <<request syndrome command>>        08974000
               vfy      = %3400,    <<verify command>>                  08976000
               initcom   =%5400,    <<initialize command>>              08978000
               adrrec   = %6000;    <<address record command>>          08980000
        logical array s(0:33)=q;    <<sio program buffer>>              08982000
        integer array synret(0:6)=q;<<syndrome return>>                 08984000
        integer pointer tracktab;   <<defective tracks table buffer>>   08986000
        double statwords,           <<status return>>                   08988000
               physadr,             <<cylinder, head & sector>>         08990000
               synadr=synret+1,     <<address of error>>                08992000
               altadr;              <<alternate cylinder, head & sect>> 08994000
        integer drt,                <<drt number>>                      08996000
                unit,               <<unit number>>                     08998000
                dbval,              <<value of db>>                     09000000
                sdb,                << absolute db value>>              09002000
                i:=0,                                                   09004000
                stypeinfo,          <<holds mhinfosize*stype>> <<01.01>>09006000
                n,                                                      09008000
                cwc,                <<current word count>>              09010000
                index,                                                  09012000
                rdwrt,              <<command>>                         09014000
                constat,            <<controller status>>               09016000
                xcnt,               <<word count>>                      09018000
                bufcnt,             <<words finished count>>            09020000
                track,              <<defective track entry>>           09022000
                cyladr=physadr,                                         09024000
                altadr1=altadr,                                         09026000
                altadr2=altadr+1;                                       09028000
        logical statword1=statwords,                                    09030000
                statword2=statwords+1;                                  09032000
        integer array statsioprog(0:9)=pb:=                             09034000
                %40001,0,           <<control-request status>>          09036000
                %77776,0,           <<read 2 status words>>             09038000
                %40001,reqadr,      <<control-rqst disc addr>> <<01.01>>09040000
                %77776,0,           <<read 2 word disc address>>        09042000
                %40000,%12400;      <<control-end>>                     09044000
        integer array xfersioprog(0:7)=pb:=                             09046000
                %40000,0,           <<control-set mask>>                09048000
                %40000,adrrec,      <<control-address record>> <<01.01>>09050000
                %67776,0,           <<write 2 word address>>            09052000
                %40000,0;           <<control-transfer order>>          09054000
        integer array reqsynsioprog(0:9)=pb:=                           09056000
                %40001,reqsynd,     <<control-request syndrome><<01.01>>09058000
                %77771,0,           <<read 7 words>>                    09060000
                %40001,0,           <<control-req. status>>             09062000
                %77776,0,           <<read 2 status words>>             09064000
                %40000,%12400;      <<control-end>>                     09066000
        integer array verifysioprog(0:3)=pb:=                           09068000
                %40000,0,           <<control-verify>>                  09070000
                %67777,0;           <<write 1 word sector count>>       09072000
        integer array initsioprog(0:11)=pb:=                            09074000
                %40000,adrrec,      <<control-address record>> <<01.01>>09076000
                %67776,0,           <<write 2 word address>>            09078000
                %40000,0,           <<control-iniaialize>>              09080000
                %160000,0,          <<write 4k from adddress 0>>        09082000
                %64000,%10000,      <<write 2k from address 4096>>      09084000
                                    <<  (write 4k if 7925)  >> <<01.01>>09086000
                %40000,%12400;      <<control-end>>                     09088000
        integer array seeksioprog(0:3)=pb:=                             09090000
                %40000,0,           <<control-seek>>                    09092000
                %67776,0;           <<write 2 word address>>            09094000
        integer array diskop(0:4)=pb:=%2400,%4000,%2400,0,%3000;        09096000
        integer array siordwrt(0:1)=pb:=%170000,%160000;                09098000
                                                                        09100000
        logical subroutine exanwait(index,sameunit);                    09102000
        value index,sameunit;                                           09104000
        integer index;   <<sio buffer index>>                           09106000
        logical sameunit;<<true if interrupt on this unit is valid>>    09108000
        begin                                                           09110000
          s(index) := sioend;                                           09112000
          s(xreg:=xreg+1) := 0;                                         09114000
          tos := drt;                                                   09116000
          tos := @s+sdb;                                                09118000
          assemble(sio 1; bl*-1; be*+3; del; br*-4);                    09120000
  test:   assemble(tio 0; bl*-1);                                       09122000
          s5 := s0;  <<tio status>>                                     09124000
          if tos.(2:1) then                                             09126000
            begin  <<interrupt>>                                        09128000
              tos := %40000;                                            09130000
              assemble(cio 1; bl *-1);                                  09132000
              if s4.(13:3)=unit and logical(s2) then                    09134000
                begin  <<valid interrupt>>                              09136000
   getout:        del;                                                  09138000
                  return;                                               09140000
                end                                                     09142000
              else goto test;                                           09144000
            end;                                                        09146000
          if s4<0 then goto getout;  <<sio ok>>                         09148000
          goto test;                                                    09150000
        end <<exanwait>> ;                                              09152000
        logical subroutine getstatus;                                   09154000
        begin                                                           09156000
          move s := statsioprog,(10);                                   09158000
                                                               <<01.01>>09160000
          s(3) := @synret+sdb;      <<for address return>>              09162000
          s(5) := reqstat+unit;     <<req. status command>>             09164000
          s(7) := @statwords+sdb;   <<for status words>>                09166000
          getstatus := exanwait(10,false);                              09168000
        end <<getstatus>> ;                                             09170000
                                                                        09172000
        subroutine seek;                                                09174000
        begin                                                           09176000
          move s := seeksioprog,(4);                                    09178000
          s(1) := seekcom+unit;                                         09180000
          s(3) := @physadr+sdb;                                         09182000
        end <<seek>> ;                                                  09184000
                                                                        09186000
        double subroutine l'padr(logadr);                               09188000
        value logadr;                                                   09190000
        double logadr;  <<logical address>>                             09192000
        begin                                                           09194000
          tos := logadr;                                                09196000
          tos := mhinfo (stypeinfo+mhseccyl);                  <<01.01>>09198000
          assemble(ldiv);                                               09200000
          if overflow then  <<invalid disc address>>                    09202000
          begin                                                         09204000
               cc:=ccl;                                                 09206000
               message(1);                                              09208000
               assemble(exit 8);  <<leave procedure>>                   09210000
          end;                                                          09212000
          tos := mhinfo (stypeinfo+mhsectrk);                  <<01.01>>09214000
          assemble(div,xch);                                            09216000
          tos := (tos+mhinfo(stypeinfo+mhsthead))&lsl(8)+tos;  <<01.01>>09218000
          ds6 := tos;                                                   09220000
        end <<l'padr>> ;                                                09222000
        double subroutine convertadr(physadr);                          09224000
        value physadr;                                                  09226000
        double physadr;  <<physical disc address>>                      09228000
        begin                                                           09230000
          tos := physadr;                                               09232000
          tos := s0;                                                    09234000
          tos := (tos&lsr(8) - mhinfo (stypeinfo+mhsthead)) *  <<01.01>>09236000
            mhinfo (stypeinfo+mhsectrk);                       <<01.01>>09238000
          assemble(xch);                                                09240000
          tos := tos.(8:8);  <<sector #>>                               09242000
          assemble(add,zero; xch,cab);                                  09244000
          tos := mhinfo (stypeinfo+mhseccyl);                  <<01.01>>09246000
          assemble(lmpy,dadd);                                          09248000
          ds6 := tos;  <<sector address>>                               09250000
        end <<convertadr>> ;                                            09252000
        subroutine initialize(sector,adrrecsect,bits,verify);           09254000
        value sector,adrrecsect,bits,verify;                            09256000
        double sector,       <<sector for seek>>                        09258000
               adrrecsect;   <<sector for address record>>              09260000
        integer bits;        <<spare, defective or zero>>               09262000
        logical verify;      <<true if verify com to be executed>>      09264000
        begin                                                           09266000
          physadr := l'padr(sector);                                    09268000
          seek;                                                         09270000
          s(4) := siocntrl;                                             09272000
          s(5) := mhinfo(stypeinfo+mhfilemask)+4; <<spr enbl>> <<01.01>>09274000
          if verify then                                                09276000
            begin                                                       09278000
              move s(6) := verifysioprog,(4);                           09280000
              s(7) := vfy+unit;                                         09282000
              s(9) := @xcnt+sdb;                                        09284000
              xcnt := 1;  <<verify one sector>>                         09286000
              n := 10;  <<sio prog index>>                              09288000
            end                                                         09290000
          else n := 6;                                                  09292000
          move s(n) := initsioprog,(12);                                09294000
                                                               <<01.01>>09296000
          s(n+3) := @altadr+sdb;  <<address record address>>            09298000
          altadr2 := 0;                                                 09300000
          if adrrecsect=-1d then altadr1 := -1                          09302000
          else if adrrecsect=0d then altadr1 := 0                       09304000
          else altadr := l'padr(adrrecsect);                            09306000
          tos := initcom+unit;                                          09308000
          tos.(0:3) := s3;  <<bits>>                                    09310000
          s(n+5) := tos;                                                09312000
                                                               <<01.01>>09314000
  << must initialize entire track.  default word count           01.01  09316000
     = 6144 (48 sectors).  if disc = 7925, one track = 64        01.01  09318000
     sectors, so adjust word count accordingly.                  01.01>>09320000
                                                               <<01.01>>09322000
          if stype = s7925 then s(n+8) := %60000;              <<01.01>>09324000
          if exanwait(n+12,true).errcode<>0 then goto geterrstat;       09326000
        end <<initialize>> ;                                            09328000
                                                               <<01.01>>09330000
          push(db);                                                     09332000
          dbval:=tos;                                                   09334000
          delete;                                                       09336000
          stypeinfo := mhinfosize * stype;                     <<01.01>>09338000
          tos := dbval;                                                 09340000
          sdb := tos;                                                   09342000
          tos := drtunit;                                               09344000
          drt := s0&lsr(8);                                             09346000
          unit := tos.unitf;                                            09348000
          if getstatus.errcode<>0 then goto error;                      09350000
          if statword2.notrdy then                                      09352000
            begin  <<drive not ready>>                                  09354000
              notready(ldev);   <<print message>>                       09356000
              tos := drt;                                               09358000
  waitforint: assemble(tio 0; bl *-1);                                  09360000
              if s0.(2:1)<>1 then                                       09362000
                begin  <<no interrupt yet>>                             09364000
                  del;                                                  09366000
                  goto waitforint;                                      09368000
                end                                                     09370000
              else                                                      09372000
                begin                                                   09374000
                  tos := %40000;  <<reset interrupt>>                   09376000
                  assemble(cio 2; bl *-1);                              09378000
                  if tos.(13:3)<>unit then goto waitforint;             09380000
                end;                                                    09382000
              del;                                                      09384000
            end;                                                        09386000
          if funct<>3 then                                              09388000
            begin  <<not flag track>>                                   09390000
  again:      physadr := l'padr(record);                                09392000
              seek;                                                     09394000
              move s(4) := xfersioprog,(8);                             09396000
              tos := mhinfo (stypeinfo+mhfilemask);            <<01.01>>09398000
              if funct<2 then tos.(13:1) := 1;  <<sparing enabled>>     09400000
              s(5) := tos;                                              09402000
                                                               <<01.01>>09404000
              s(9) := @physadr+sdb;  <<pointer to physical address>>    09406000
              s(11) := diskop(funct)+unit;                              09408000
              tos := wc;                                                09410000
              if stype=4 then                                           09412000
                begin  <<check for cylinder overflow>>                  09414000
                  tos := mhinfo (stypeinfo+mhseccyl);          <<01.01>>09416000
                  tos := record;                                        09418000
                  tos := s2;                                            09420000
                  assemble(ldiv,delb; sub);                             09422000
                  tos := tos&lsl(7);                                    09424000
                  assemble(ddup,lcmp);                                  09426000
                  if < then assemble(xch);                              09428000
                  delb;                                                 09430000
                end;                                                    09432000
              assemble(dup,dup);                                        09434000
              cwc := tos;  <<# of words to transfer>>                   09436000
              xcnt := i;  <<buffer index>>                              09438000
              rdwrt := siordwrt(funct.(15:1));  <<sio command>>         09440000
              xreg := 12;                                               09442000
              while tos>4096 do                                         09444000
                begin  <<form data transfer orders>>                    09446000
                  tos := tos-4096;                                      09448000
                  s(xreg) := rdwrt;                                     09450000
                  s(xreg:=xreg+1) := @buf+xcnt+sdb;                     09452000
                  xreg := xreg+1;                                       09454000
                  tos := s0;                                            09456000
                  xcnt := xcnt+4096;                                    09458000
                end;                                                    09460000
              tos := rdwrt;                                             09462000
              assemble(trbc 0; xch,neg);                                09464000
              tos := tos land %7777 lor tos;                            09466000
              s(xreg) := tos;                                           09468000
              s(xreg:=xreg+1) := @buf+xcnt+sdb;                         09470000
              s(xreg:=xreg+1) := siojumpc;                              09472000
              s(xreg:=xreg+1) := @s+6+sdb;  <<pt to address record>>    09474000
              s(xreg:=xreg+1) := siocntrl;                              09476000
              s(xreg:=xreg+1) := endop;                                 09478000
              if (constat:=exanwait(xreg+1,true).errcode)<>0 then       09480000
                begin  <<error>>                                        09482000
                  if constat=cderr then                                 09484000
                    begin  <<correctable data error>>                   09486000
                      move s := reqsynsioprog,(10);                     09488000
                                                               <<01.01>>09490000
                      s(3) := @synret+sdb;                              09492000
                      s(5) := reqstat+unit;                             09494000
                      s(7) := @statwords+sdb;                           09496000
                      if exanwait(10,true).errcode<>0 then              09498000
                      go geterrstat;                                    09500000
                      if synret.errcode=cderr then                      09502000
                        begin  <<correct error>>                        09504000
                          tos := convertadr(synadr)-record;             09506000
                          xcnt := tos&lsl(7);                           09508000
                          n := tos;  <<zero>>                           09510000
                          tos := xcnt+synret(3);  <<displacement>>      09512000
                          assemble(dup,neg);                            09514000
                          bufcnt := tos+cwc;  <<buffer limit>>          09516000
                          index := tos;  <<buffer index>>               09518000
                          do if 0<=(synret(3)+n)<=127 and (bufcnt-n)>0  09520000
                            then buf(xreg) := logical(synret(4+n)) xor  09522000
                            logical(buf(i+n+index))                     09524000
                          until (n:=n+1)=3;                             09526000
                          cwc := xcnt+128;                              09528000
                          goto contxfer;                                09530000
                        end;                                            09532000
                      statword1 := synret;                              09534000
                      goto uncorrectable;                               09536000
                    end;                                                09538000
                  if constat=spt then                                   09540000
                    begin  <<spare track>>                              09542000
                      tos := 0;                                         09544000
                      tos := ldev;                                      09546000
                      tos := drtunit;                                   09548000
                      tos := stype;                                     09550000
                      tos := record;                                    09552000
                      tos := mhinfo (stypeinfo+mhsectrk);      <<01.01>>09554000
                      assemble(ldiv,del);                               09556000
                      tos := alttrack(*,*,*,*,lps);                     09558000
                      if tos >= 0 then                                  09560000
                        begin  <<a former spare track>>                 09562000
                          if cyladr>=lps then initialize(record,        09564000
                            0d,sp,0)  <<spare track>>                   09566000
                          else initialize(record,record,0,0); <<normal>>09568000
                          cc := cce;  <<ok>>                            09570000
                          return;                                       09572000
                        end                                             09574000
                      else                                              09576000
                        begin  <<defective>>                            09578000
  defective:              if cyladr>=lps then initialize(record,        09580000
                            -1d,sp,0)   <<defective in spare area>>     09582000
                          else initialize(record,-1d,d,0);              09584000
                          cc := ccl;                                    09586000
                          return;                                       09588000
                        end;                                            09590000
                    end;                                                09592000
                  if constat=tfd then goto defective; <<flagged track>> 09594000
  geterrstat:     if getstatus.errcode<>0 then goto printerr;           09596000
  error:                                                                09598000
                  if 7<=constat<=%11 then                               09600000
                    begin  <<track specific error>>                     09602000
  uncorrectable:      if funct=2 then                                   09604000
                        begin  <<return ccg>>                           09606000
                          cc := ccg;                                    09608000
                          return;                                       09610000
                        end;                                            09612000
                      tos := convertadr(synadr);                        09614000
                      tos := mhinfo (stypeinfo+mhsectrk);      <<01.01>>09616000
                      assemble(ldiv,del);  <<track #>>                  09618000
                      tos := tos&lsl(2);                                09620000
                      if <> then                                        09622000
                        begin  <<add to defective tracks table>>        09624000
                          if statword1.(0:1) then tos:=tos+1;<<spare>>  09626000
                          track := tos;                                 09628000
                          push(s);                                      09630000
                          @tracktab := tos+1;                           09632000
                          assemble(adds 128);                           09634000
                          mh7905(ldev,drtunit,stype,readd,1d,tracktab,  09636000
                                 128,lps);                              09638000
                          xreg := 0;                                    09640000
                          while (xreg:=xreg+1)<=tracktab do             09642000
                          if tracktab(xreg)=track then goto printerr;   09644000
                          if xreg>120 then goto printerr;               09646000
                          tracktab := tracktab+1;                       09648000
                          tracktab(xreg) := track;                      09650000
                          mh7905(ldev,drtunit,stype,writed,1d,tracktab, 09652000
                                 128,lps);                              09654000
                        end;                                            09656000
                    end;                                                09658000
  printerr:       discerror(ldev,statword1,convertadr(synadr),0,        09660000
                   funct.(15:1),if integer(statword2)<0 then statword2  09662000
                   else 0);                                             09664000
                end;                                                    09666000
              if funct=2 then                                           09668000
                begin  <<type 2 read - ok>>                             09670000
                  cc := cce;                                            09672000
                   if cyladr>=lps then initialize(record,0d,sp,         09674000
                    0);  <<flag as spare>>                              09676000
                   return;                                              09678000
                end;                                                    09680000
  contxfer:   i := i+cwc;                                               09682000
              wc := wc-cwc;                                             09684000
              if <= then return;                                        09686000
              tos := 0;                                                 09688000
              tos := (cwc+127)&lsr(7);                                  09690000
              record := tos+record;                                     09692000
              goto again;                                               09694000
            end                                                         09696000
          else                                                          09698000
            begin  <<flag a track defective>>                           09700000
              if buf<>-1 then   << point alt trk at def trk >> <<01.01>>09702000
                initialize (logical(buf) ** mhinfol(stypeinfo+ <<01.01>>09704000
                mhsectrk), record, sp, 0);                     <<01.01>>09706000
              tos := 0;                                                 09708000
              tos := ldev;                                              09710000
              tos := drtunit;                                           09712000
              tos := stype;                                             09714000
              tos := record;                                            09716000
              tos := mhinfo (stypeinfo+mhsectrk);              <<01.01>>09718000
              assemble(ldiv,del);  <<track #>>                          09720000
              tos := alttrack(*,*,*,*,lps);                             09722000
              if tos<>-1 then initialize(record,-1d,sp,1);  <<garbage   09724000
                former spare track>>                                    09726000
              tos := record;                                            09728000
              if buf=-1 then                                            09730000
                begin  <<delete>>                                       09732000
                  physadr := l'padr(record);                            09734000
                  tos := -1d;                                           09736000
                  if cyladr >= lps then tos := sp else tos := d;        09738000
                end                                                     09740000
              else                                                      09742000
                begin  <<reassign>>                                     09744000
                  tos := logical(buf) **                       <<01.01>>09746000
                    mhinfol (stypeinfo+mhsectrk);              <<01.01>>09748000
                  tos := d;                                             09750000
                end;                                                    09752000
              initialize(*,*,*,0);                                      09754000
            end;                                                        09756000
end << mh7905 >>;                                                       09758000
$page                                                                   09760000
<<**********************************************************>>          09762000
<< performio is called by sadutil to perform the correct    >>          09764000
<< tape i/o function on either the hp7976 or hp7970e. it    >>          09766000
<< calls the proper tape driver routine and returns a status>>          09768000
<< and a corresponding cc to sadutil.  it returns the status>>          09770000
<< in the first word and the transfer count in the second   >>          09772000
<< word of the procedure return value.                      >>          09774000
<<**********************************************************>>          09776000
                                                                        09778000
double procedure performio(ldev,function,target,count,parm);            09780000
  value ldev,function,count,parm;                                       09782000
  integer                                                               09784000
    ldev,       <<logical device number, 2=serial device    >>          09786000
    function,   <<0 for read, 1 for write,                  >>          09788000
                << others for control functions.            >>          09790000
    count;      <<length of operation                       >>          09792000
  array target; <<db relative target array                  >>          09794000
  double parm;  <<not used in series iii version            >>          09796000
  option variable;                                                      09798000
                                                                        09800000
begin                                                                   09802000
                                                                        09804000
  logical tape'drtunit; <<drt is in field (0:8)             >>          09806000
                        <<UNIT "  "   "   (12:4)            >>          09808000
  double abstarget;     <<absolute target address           >>          09810000
  integer tape'status=performio;<<return status in word one>>           09812000
  integer switch'register;      <<switch register obtained  >>          09814000
                                <<from sdupii's mailbox 1   >>          09816000
                                                                        09818000
  equate bad'tapeio        =  0, <<bad return status        >>          09820000
         eot'tapeio        =%31, <<end of tape status       >>          09822000
         successful'tapeio =  1; <<successful status        >>          09824000
                                                                        09826000
  <<********************************************************>>          09828000
  << the control functions sent from sadutil in function are>>          09830000
  << the hpib fuction codes and some of these codes are     >>          09832000
  << different for our series iii drivers.  therefore a     >>          09834000
  << permutation must be made to obtain the proper codes.   >>          09836000
  <<********************************************************>>          09838000
                                                                        09840000
  equate                                                                09842000
    bsf'sent  = 8,  <<backspace file sent                   >>          09844000
    BSF'7976  = 12, <<  "  "     "   for 7976               >>          09846000
    bsf'7970  = 11, <<  "  "     "    "  7970               >>          09848000
    eof'sent  =  6, <<end of file sent                      >>          09850000
    EOF'7970  = 13; << "  "   "  for     7970               >>          09852000
                                                                        09854000
                                                                        09856000
  dsbl; <<disable external interupts for the tape drivers   >>          09858000
        <<they must!!! be disabled during execution of the  >>          09860000
        << drivers!.                                        >>          09862000
                                                                        09864000
  switch'register:=mb1;   <<sdupii's mailbox1 is switch'reg >>          09866000
                                                                        09868000
  if hp7976 then                                                        09870000
     begin <<we are using the hp 7976 tape drive for save   >>          09872000
       if function=bsf'sent                                             09874000
          then function:=bsf'7976;                                      09876000
     end                                                                09878000
  else                                                                  09880000
     begin                                                              09882000
        if function=bsf'sent                                            09884000
           then function:=bsf'7970                                      09886000
        else if function=eof'sent                                       09888000
           then function:=eof'7970;                                     09890000
     end;                                                               09892000
                                                                        09894000
  <<all other control codes are the same                    >>          09896000
                                                                        09898000
  <<obtain the tape's drt number from the switch register,  >>          09900000
  << sent over by sdupii.  the unit # is always 0           >>          09902000
                                                                        09904000
  tape'drtunit := 0;  <<clear out, making unit=0            >>          09906000
  tape'drtunit.drtf := switch'register.(8:8);                           09908000
                                                                        09910000
  <<call proper driver routine                              >>          09912000
                                                                        09914000
  if hp7976 then                                                        09916000
     begin                                                              09918000
       push(db); <<need absolute targer location            >>          09920000
       abstarget:=tos+double(@target);                                  09922000
       mtdvr76(function,tape'drtunit,abstarget,count);                  09924000
     end                                                                09926000
  else                                                                  09928000
     begin <<call either tapeio or tapectrl                 >>          09930000
       if function=readt or function=writet                             09932000
          then tapeio(function,target,count)                            09934000
          else tapectrl(function); <<a tape control function>>          09936000
     end;                                                               09938000
                                                                        09940000
  enbl; << enable external interupts again after the        >>          09942000
        << execution of the drivers                         >>          09944000
                                                                        09946000
                                                                        09948000
  <<return proper status and cc                             >>          09950000
                                                                        09952000
  if <  then <<bad tape i/o reported, pecato                >>          09954000
     begin                                                              09956000
       tape'status:=bad'tapeio;                                         09958000
       cc:=ccl;                                                         09960000
     end                                                                09962000
  else if >  then                                                       09964000
     begin   <<end of tape is encountered                   >>          09966000
       tape'status:=eot'tapeio;                                         09968000
       cc:=ccg;                                                         09970000
     end                                                                09972000
  else                                                                  09974000
     begin   <<good i/o call                                >>          09976000
       tape'status:=successful'tapeio;                                  09978000
       cc:=cce;                                                         09980000
     end;                                                               09982000
                                                                        09984000
end;                                                                    09986000
                                                                        09988000
$page                                                                   09990000
<<**********************************************************>>          09992000
<< discdriver calls the proper discdriver routine based on  >>          09994000
<< the type and subtype given.  it is called by sadutil to  >>          09996000
<< perform the disc operation and return the appropriate    >>          09998000
<< status and cc.                                           >>          10000000
<<**********************************************************>>          10002000
                                                                        10004000
integer procedure discdriver(ldev,drtunit,type,stype,function,          10006000
                             sect'address,db'target,count,lps);         10008000
  value ldev,drtunit,type,stype,function,sect'address,                  10010000
        count,lps;                                                      10012000
  integer                                                               10014000
    ldev,    <<logical device number of disc.               >>          10016000
    type,    <<type of disc                                 >>          10018000
    stype,   <<subtype                                      >>          10020000
    function,<< write =1,  read = 0                         >>          10022000
    drtunit, << drt(0:9), unit(12:4) of disc                >>          10024000
    count,   << word count of operation                     >>          10026000
    lps;     <<logical pack size                            >>          10028000
  double                                                                10030000
    sect'address;<<logical disc sector address              >>          10032000
  array db'target;<<db relative array>>                                 10034000
                                                                        10036000
begin                                                                   10038000
  double abs'target;                                           <<03627>>10040000
  integer new'drtunit:=0;                                      <<03627>>10042000
  equate                                                                10044000
    bad'discio        = 0,                                              10046000
    successful'discio  = 1;                                             10048000
                                                                        10050000
  cc:=cce;  <<assume successful i/o operation               >>          10052000
  discdriver:=successful'discio;                                        10054000
                                                                        10056000
  <<cs80dsco for the 7935 uses an absolute target address   >> <<03627>>10058000
                                                               <<03627>>10060000
  push(db);                                                    <<03627>>10062000
  tos:=tos+@db'target;                                         <<03627>>10064000
  abs'target:=tos;                                             <<03627>>10066000
                                                               <<03627>>10068000
  <<hpib uses drt field (0:9), series iii uses (0:8), so    >>          10070000
  << a shift of 1 bit left must be made on the drt field    >>          10072000
                                                                        10074000
  new'drtunit.drtf:=drtunit.(0:9);                             <<03627>>10076000
  new'drtunit.unitf:=drtunit.unitf;                            <<03627>>10078000
  drtunit:=new'drtunit;                                        <<03627>>10080000
                                                                        10082000
  dsbl;  <<disable external inturrupts for the drivers>>       <<03627>>10084000
                                                               <<03627>>10086000
  if type = type'fhdisk                                                 10088000
     then fhdisk(ldev,drtunit,stype,function,sect'address,              10090000
                 db'target,count)                                       10092000
  else if type=type'cs80                                       <<03627>>10094000
     then cs80dsc0(drtunit,type,stype,function,sect'address,   <<03627>>10096000
                   abs'target,count)                           <<03627>>10098000
  else if stype < r7905                                                 10100000
     then mhdisk(ldev,drtunit,stype,function,sect'address,              10102000
                 db'target,count)                                       10104000
     else mh7905(ldev,drtunit,stype,function,sect'address,              10106000
                 db'target,count,lps);                                  10108000
                                                               <<03627>>10110000
  enbl;  <<enable external interrupts again>>                  <<03627>>10112000
                                                               <<03627>>10114000
                                                                        10116000
  if <     <<bad return status encountered                  >>          10118000
     then discdriver:=bad'discio;                                       10120000
                                                                        10122000
end;                                                                    10124000
$page                                                                   10126000
<<**********************************************************>>          10128000
<<  setoffline is used to set a global flag signifying that >>          10130000
<< any i/o initiated by the print procedure will go to the  >>          10132000
<< current configured lineprinter.  it is called by sadutil >>          10134000
<< when outm is called with a p (printer) parameter.        >>          10136000
<<**********************************************************>>          10138000
                                                                        10140000
procedure setoffline;                                                   10142000
  begin                                                                 10144000
    outputmode:=lineprinter;                                            10146000
  end;                                                                  10148000
                                                                        10150000
<<**********************************************************>>          10152000
<<  clearoffline sets the globol flag to console so that any>>          10154000
<< output initiated by print will go to the console         >>          10156000
<<**********************************************************>>          10158000
                                                                        10160000
procedure clearoffline;                                                 10162000
  begin                                                                 10164000
    outputmode:=console;                                                10166000
  end;                                                                  10168000
                                                                        10170000
                                                                        10172000
<< *********************************************************>>          10174000
<<  setio is a dummy procedure for now                      >>          10176000
<<**********************************************************>>          10178000
                                                                        10180000
procedure setio;                                                        10182000
  begin                                                                 10184000
  end;                                                                  10186000
                                                                        10188000
end.                                                                    10190000
