$CONTROL MAP,CODE,USLINIT                                               00010000
<<ioptrd0 - module 13>>                                                 00015000
<< hp32002c mpe source c.00.00 >>                                       00020000
<< COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980.           >>  00025000
<<     this program may be used with one computer system at a       >>  00030000
<<     time and shall not otherwise be recorded, transmitted or     >>  00035000
<<     stored in a retrieval system.  copying or other reproduction >>  00040000
<<     of this program except for archival purposes is prohibited   >>  00045000
<<     without the prior written consent of hewlett-packard company.>>  00050000
<< **** note - dollar copyright cannot be used with this module *** >>  00055000
<<paper tape reader driver>>                                            00060000
$title "PTRDR0 - DRIVER FOR  PAPER TAPE READER"                         00065000
$control privileged,uncallable                                          00070000
$thirty                                                                 00075000
                                                                        00080000
                                                                        00085000
<<*******************************************************               00090000
                                                                        00095000
                                                                        00100000
*******************************************************>>               00105000
                                                                        00110000
driver request codes:                                                   00115000
                                                                        00120000
     0 - read                                                           00125000
         p1.(13:3)     eof specification                                00130000
                                                                        00135000
         p2 (0:8)      special read termination character               00140000
            (10:3)  - 0 ascii                                  <<00.05>>00145000
                    - 1 binary                                          00150000
                                                                        00155000
     2 - open file                                                      00160000
                                                                        00165000
     3 - close file                                                     00170000
                                                                        00175000
     4 - close device                                                   00180000
                                                                        00185000
                                                                        00190000
begin  << ioptrdr0 >>                                                   00195000
define                                                                  00200000
        disable    =    assemble(sed 0)#,                               00205000
        drt        =    (8:8)#,                                <<01300>>00210000
        enable     =    assemble(sed 1)#,                               00215000
        f          =    absolute#,                                      00220000
        iak        =    (8:1)#,                                         00225000
        riordy     =    ( 1: 1)#,                                       00230000
        eofbt      =    ( 8: 1)#,  <<lpdt>>                             00235000
        taperdy    =    ( 9: 1)#,                                       00240000
        eofabe     =    ( 7: 3)#,                                       00245000
        eofab      =    ( 7: 2)#,                                       00250000
        eofb       =    ( 8: 1)#,                                       00255000
        ebt        =    ( 9: 1)#,                                       00260000
        status     =    ioqp(qstat).(8:8)#,                             00265000
        pfailb     =    (11:1)#,                                        00270000
        qmisp      =    ioqp(qmisc)#,                                   00275000
        stopdefs   =    <<>>#;         <<stopper for defines        >>  00280000
equate                                                                  00285000
        mstrclear  =    %100000,       <<programmed master reset    >>  00290000
        clear      =    %040000,       <<reset ints               >>    00295000
        reset      =    %040002,       <<reset ints,enable ints>>       00300000
        initchr    =    %002023,       <<start next character>>         00305000
        inton      =          2,       <<enable u.i. card interrupts>>  00310000
        dstat      =          6, <<dit:  controller status>>   <<01334>>00315000
        dserr      =          7, <<dit:hardware status index>> <<01334>>00320000
        dlogerror  =         18, <<dit: error log status>>     <<01334>>00325000
        pfabort    =          %63,                                      00330000
        icntrl     =         %7,     <<index in ilt of drt>>   <<01300>>00335000
        qflag      =          0,       <<ioq:  request flags        >>  00340000
        qdstn      =          4,       <<ioq:  int ack. bit in bit 1>>  00345000
        qfunc      =          6,       <<ioq:  function code        >>  00350000
        qldev      =          2,       <<ioq: logical device>>          00355000
        qmisc      =          3,       <<ioq: driver state flags    >>  00360000
        qstat      =          10,      <<ioq: dev status>>              00365000
        qpar1      =          8,       <<ioq: parameter #1          >>  00370000
        qpar2      =          9,       <<ioq: parameter #2          >>  00375000
        qwbct      =          7,       <<ioq:  word/byte count      >>  00380000
        sysb    =3,                                                     00385000
        discpi  =%25,                                                   00390000
        dit0        =  0,                                               00395000
        msk         =  8,                                               00400000
        mxnull      =  9,                                      <<00.06>>00405000
        nullcnt     =  10,                                              00410000
        termchr     =  11,                                              00415000
        count       =  12,                                              00420000
        oddbytef    =  13,                                              00425000
        addr        =  14,                                              00430000
        banka       =  15,                                              00435000
        cnt         =  16,                                              00440000
        flg         =  17,                                              00445000
        deof        =  6,    <<eof detected and aux buffer>>            00450000
        okf     =0,                                                     00455000
        trblf   =1,                                                     00460000
        eotf    =2,                                                     00465000
        delf       =          3,                                        00470000
        waitf      =          4,                                        00475000
        tof         =         5,                                        00480000
        hdweof      =         2,       <<hardware eof>>                 00485000
        cr         =        %15,                                        00490000
        lf         =        %12,                                        00495000
        xc         =       %030,       <<control x>>                    00500000
        hc         =       %010,       <<control h>>                    00505000
        ro         =       %177,       <<rubout>>                       00510000
        xoff       =       %23,                                         00515000
        qc         =       %21,                                         00520000
        yc         =       %31,                                         00525000
        r0         =       %177,                                        00530000
        ditsize    =         20,       <<device info. table size    >>  00535000
        siosize    =        128,       <<sio program area size>>        00540000
        siosized2  =      siosize/2,<<sio pgm size/2 for init>><<01300>>00545000
        aborted    =        %33,       <<i/o aborted return status  >>  00550000
        badcntrl   =        %04,       <<invallid control function  >>  00555000
        notrdywt   =        %030,       <<not ready wait status      >> 00560000
        pending    =        %10,       <<i/o innitiated status      >>  00565000
        siofail    =        %45,       <<bad rtn frm startsiop intr >>  00570000
        successful =          1,       <<i/o successfully completed >>  00575000
        unitfail   =        %54,       <<unit failure return status >>  00580000
        xfererr    =        %14,       <<transfer error             >>  00585000
        callinit   =          2,       <<callinnitiator for retry   >>  00590000
        endio      =          5,       <<end of i/o request         >>  00595000
        wnew       =        7,       <<re-initiate after interrupt>>    00600000
       completion =         3,        <<completion>>                    00605000
        wcomp      =        %13,       <<call completor after int   >>  00610000
        wend       =        %15,       <<end i/o after next int     >>  00615000
        tlog       =          1,       <<iocb-transmission log      >>  00620000
        unpacked   =    %000042,       <<set unpacked mode, ints on >>  00625000
        nrdycw     =    %001002,       <<ints. on only              >>  00630000
        residue    =          5,       <<sio area:  index to residue>>  00635000
        setdevstat =        %10,       <<set status to device status>>  00640000
        stopeqts   =     000000;       <<stopper for equates        >>  00645000
$page "PTRDR0-DATA AREA-IOQH,DIT,SIO AREA"                              00650000
byte array config(0:7)=db :=                                            00655000
       ditsize,                                                         00660000
       1,                                                               00665000
       0,                                                               00670000
       0,                                                               00675000
       0,0,                                                             00680000
       siosized2,0;                                            <<01300>>00685000
<<------------------------------- dit ------------------------------>>  00690000
array  dita(1:ditsize) = db :=                                 <<01334>>00695000
        0,    <<dflag>>                                        <<01334>>00700000
        0,    <<dlink>>                                        <<01334>>00705000
        0,    <<dioqp>>                                        <<01334>>00710000
        0,    <<dldev>>                                        <<01334>>00715000
        0,    <<dltp>>                                         <<01334>>00720000
        0,    <<diltp>>                                        <<01334>>00725000
        0,    <<dstat>>                                        <<01334>>00730000
        0,    <<dserr>> <<count & index of harware status>>    <<01334>>00735000
     %177,  <<msk>>                                            <<01334>>00740000
      -30,  <<mxnull>>                                         <<01334>>00745000
        0,  <<nullcnt>>                                        <<01334>>00750000
      %15,  <<termchr>>                                        <<01334>>00755000
        0,  <<count>>                                          <<01334>>00760000
        0,  <<oddbytef>>                                       <<01334>>00765000
        0,  <<addr>>                                           <<01334>>00770000
        0,  <<bank>>                                           <<01334>>00775000
        0,  <<cnt>>                                            <<01334>>00780000
        0,  <<flg>>                                            <<01334>>00785000
        0,    << dlogerror>>                                   <<01334>>00790000
        0;                                                     <<01334>>00795000
                                                                        00800000
<<----------------------------- sio program storage ---------------->>  00805000
                                                                        00810000
array  sioa(1:siosize) = db := 0,0,0,0;                                 00815000
                                                                        00820000
$page "PTRDR0-EXTERNAL DECLARATIONS"                                    00825000
<<---------------------- external procedure declarations ----------->>  00830000
                                                                        00835000
procedure ioinitdummy(drtnumber);                                       00840000
value drtnumber; integer drtnumber; option external;                    00845000
                                                                        00850000
procedure startsiop(ditp,siop,flag,rate);                               00855000
value   ditp,siop,flag,rate;                                            00860000
integer flag,rate;                                                      00865000
pointer ditp, siop;                                                     00870000
option external;                                                        00875000
                                                                        00880000
procedure ldevnotrdy(ditp);                                    <<0u.eb>>00885000
value ditp; pointer ditp; option external;                     <<0u.eb>>00890000
                                                                        00895000
procedure delay(msec);value msec;double msec;option external;           00900000
                                                                        00905000
procedure eofcheck(ioqp,bufp,cnt,hardchk);                              00910000
value   ioqp,bufp,cnt,hardchk;                                          00915000
pointer ioqp;                                                           00920000
double bufp;                                                            00925000
integer cnt,hardchk;                                                    00930000
option external;                                                        00935000
procedure initptr(drtn);                                                00940000
value   drtn;                                                           00945000
integer drtn;                                                           00950000
option external;                                                        00955000
                                                                        00960000
procedure masterclear(ditpx);                                           00965000
array ditpx;                                                            00970000
option external;                                                        00975000
                                                                        00980000
procedure ptrip;                                                        00985000
option external;                                                        00990000
                                                                        00995000
procedure siodm(ditp,flags);                                            01000000
value ditp,flags;                                                       01005000
logical flags;                                                          01010000
pointer ditp;                                                           01015000
option external;                                                        01020000
                                                                        01025000
procedure help;                                                         01030000
option external;                                                        01035000
                                                                        01040000
                                                                        01045000
procedure iofailure(drtn,ditp);                                         01050000
value drtn; integer drtn;                                               01055000
array ditp;                                                             01060000
option external;                                                        01065000
                                                                        01070000
                                                                        01075000
procedure initz(iditp);                                                 01080000
integer array iditp;                                                    01085000
begin                                                                   01090000
  pointer ps0=s-0;                                                      01095000
  masterclear(iditp);                                                   01100000
  tos:=iditp(5);  <<get the drt number>>                                01105000
  tos:=ps0(icntrl).drt;                                        <<01300>>01110000
  tos:=2;         <<enable interrupts>>                                 01115000
  assemble(cio 1);                                                      01120000
  if <>then assemble(del);                                              01125000
end;                                                                    01130000
                                                                        01135000
                                                                        01140000
<<-------------------------- driver code procedure ----------------->>  01145000
                                                                        01150000
integer procedure ptrdvr(ioqp,ditp,bank,bufadr,siop,drtn);              01155000
value ioqp,ditp,bank,bufadr,siop,drtn;                                  01160000
integer bank,bufadr,drtn;                                               01165000
integer pointer ioqp,ditp,siop;                                         01170000
                                                                        01175000
begin  <<ptrdvr>>                                                       01180000
  double ubuf=bank;                                                     01185000
  double abuf;                                                          01190000
  integer mstate=ptrdvr;                                                01195000
  logical dstatus;                                                      01200000
  integer func;                                                         01205000
integer x=x, s0 = s-0, s1 = s-1, s2 = s-2, s3 = s-3;                    01210000
  define ldev=ioqp(qldev).(8:8)#;                                       01215000
  define siopbase=@siop+%1000#;                                         01220000
<< check for aborted request and reset interrupt acknowleged flag   >>  01225000
<< get function code                                                >>  01230000
   func:= ioqp(qfunc);                                                  01235000
   tos:=0;  <<set up aux buffer>>                                       01240000
   tos:=siopbase;                                                       01245000
   abuf:=tos;                                                           01250000
   if func =6 then                                                      01255000
   begin                                                                01260000
     help;                                                              01265000
     tos:=successful;                                                   01270000
     go to iodone;                                                      01275000
   end;                                                                 01280000
                                                                        01285000
   disable;                                                             01290000
   ditp(0).iak:=0;  <<reset iak>>                                       01295000
   tos := ioqp;                                                         01300000
   del;                                                                 01305000
   if < then                                                            01310000
    begin                              << i/o request aborted       >>  01315000
     enable;                                                            01320000
     masterclear(ditp);                                                 01325000
     if ioqp.pfailb=1 then tos:=pfabort else                            01330000
     tos := aborted;                                                    01335000
     go  iodone;                                                        01340000
    end;                                                                01345000
   enable;                                                              01350000
   if mstate = completion then go comp;                                 01355000
   tos:=drtn;                                                           01360000
   tos:= clear lor %10;  <<enable dev status clear ints>>               01365000
   assemble(cio 1;del);                                                 01370000
   if <> then                                                           01375000
   begin                                                                01380000
ufail:                                                                  01385000
     iofailure(drtn,ditp);   <<non responding device>>                  01390000
fail:                                                                   01395000
     masterclear(ditp);                                                 01400000
     tos:=unitfail;                                                     01405000
     tos:=endio;                                                        01410000
     go out;                                                            01415000
   end;                                                                 01420000
   tos:=drtn;                                                           01425000
   assemble(tio 0);                                                     01430000
   if < then go ufail;                                                  01435000
   dstatus:=tos;                                                        01440000
   if dstatus.(9:1) =0 then                                             01445000
    begin  <<device not ready>>                                         01450000
ntrdy:                                                                  01455000
     if ditp(flg) <> waitf then                                         01460000
      begin                                                             01465000
       ldevnotrdy(ditp); <<output not ready message>>          <<0u.eb>>01470000
      end;                                                              01475000
     go wait;                                                           01480000
    end;                                                                01485000
   assemble(del);                                                       01490000
$page "NEW REQ: GET FUNCTION,WORD CNT,ETC, & SET UP & START SIO PROG"   01495000
new:                                                                    01500000
                                                                        01505000
   if func = 1 then                                                     01510000
    begin  <<write attempted>>                                          01515000
     go invalidcntrl;  <<reject it>>                                    01520000
    end;                                                                01525000
   if func > 1 then go control;                                         01530000
$page                                                                   01535000
<<  r  e  a  d  >>                                                      01540000
                                                                        01545000
ditp(msk):=if ioqp(qpar2).(10:3)=0                             <<00.05>>01550000
then %177 else %377;                                                    01555000
if ioqp(qpar2) <> 0 then                                                01560000
ditp(termchr):=ioqp(qpar2).(0:8);                                       01565000
<<  check for end of file  >>                                           01570000
                                                                        01575000
   eofcheck(ioqp,0d,0,0);                                               01580000
   if <> then                                                           01585000
   begin                                                                01590000
     mstate:=endio;                                                     01595000
     return;                                                            01600000
   end;                                                                 01605000
<< determine word count                                             >>  01610000
   tos := ioqp(qwbct);                                                  01615000
   if > then tos := -tos & asl(1);                                      01620000
   if = then                                                            01625000
    begin  <<null length>>                                              01630000
     tos := successful;                                                 01635000
     go iodone;                                                         01640000
    end;                                                                01645000
   ditp(count) := tos;                                                  01650000
                                                                        01655000
<<  set up dit  >>                                                      01660000
   if ditp(flg)=deof then                                               01665000
   begin     <<move from aux buffer to users>>                          01670000
     tos:=ubuf;                                                         01675000
     tos:=abuf;                                                         01680000
     tos:=-(ditp(count));                                               01685000
     tos:=tos&asr(1);  <<set to word count>>                            01690000
     assemble(mabs);                                                    01695000
     ditp(flg):=0;                                                      01700000
     tos:=successful;                                                   01705000
     go iodone;                                                         01710000
   end;                                                                 01715000
   ditp(nullcnt) := ditp(mxnull);                                       01720000
   ditp(oddbytef):=0;                                                   01725000
   ditp(addr):=bufadr;                                                  01730000
   ditp(banka):=bank;                                                   01735000
   ditp(cnt):=0;                                                        01740000
   ditp(flg):=0;                                                        01745000
doio:                                                                   01750000
   tos:=drtn;                                                           01755000
   tos := initchr;                                                      01760000
   assemble(cio 1);                                                     01765000
   if < then go ufail;                                                  01770000
   tos := pending;                                                      01775000
   tos := wcomp;                                                        01780000
   go out;                                                              01785000
                                                                        01790000
$page "PTRDR0-CONTROL REQUEST"                                          01795000
<< control request                                                  >>  01800000
control:                                                                01805000
   if func > 4 then go invalidcntrl;                                    01810000
                                                                        01815000
                                                                        01820000
   if func = 2 then                                                     01825000
   begin                                                                01830000
     tos:=successful;                                                   01835000
     go iodone;                                                         01840000
   end;                                                                 01845000
                                                                        01850000
   <<c l o s e   d e v i c e >>                                         01855000
     ditp(msk) := %177;  <<reset to ascii mode>>                        01860000
     ditp(termchr) := %15;  <<reset termchr to carriage rtn>>           01865000
     ditp(mxnull) := -30;                                               01870000
     tos := successful;                                                 01875000
    go iodone;                                                          01880000
$page "PTRDR0-COMPLETION SECT: CHK STATUS & RETURN IOCB"                01885000
comp:                                                                   01890000
                                                                        01895000
<<check flg to see what happened>>                                      01900000
                                                                        01905000
   if ditp(flg) = tof then                                              01910000
      begin <<tape out flag, binary mode>>                              01915000
      tos:=hdweof;                                                      01920000
      goto iodone;                                                      01925000
      end;                                                              01930000
   if ditp(flg) = waitf then go new;                                    01935000
   if ditp(flg) = delf then go new;                                     01940000
   if ditp(flg)=trblf then go transerr;                                 01945000
   if ditp(flg)=eotf then                                               01950000
    begin  if ditp(msk)=%177 then begin                                 01955000
      tos:=hdweof; go iodone; end else go ntrdy;                        01960000
    end;                                                                01965000
                                                                        01970000
<< determine number of words transferred                            >>  01975000
                                                                        01980000
   tos := -ditp(cnt);                                                   01985000
   if ioqp(qwbct) >= 0 then                                             01990000
    begin  <<request was for words>>                                    01995000
     tos := -(tos & asr(1));  <<round up>>                              02000000
     if logical(ditp(cnt)) then                                         02005000
      begin  <<odd # of bytes transmitted>>                             02010000
       tos:=ditp(banka);                                                02015000
       tos:=ditp(addr);                                                 02020000
       assemble(lsea);                                                  02025000
       tos.(8:8):=" ";     <<blank last byte>>                          02030000
       assemble(ssea; ddel);  <<put it back>>                           02035000
      end;                                                              02040000
    end;                                                                02045000
     ioqp(qwbct):=tos;                                         <<00.02>>02050000
   go welldone;                                                         02055000
invalidcntrl:                                                           02060000
   tos := badcntrl;                                                     02065000
   go iodone;                                                           02070000
transerr:                                                               02075000
   ditp(dserr):= [8/1,8/dlogerror];  <<set log count & index>> <<01334>>02080000
   ditp(dlogerror):= ditp(dstat);         <<log error>>        <<01334>>02085000
   tos := xfererr;                                                      02090000
   go iodone;                                                           02095000
$page "PTRDR0-EXITS:  GOOD,BAD, AND INDIFFERENT"                        02100000
wait:                                                                   02105000
   ditp(flg) := waitf;                                                  02110000
   tos := drtn;                                                         02115000
   tos := reset;                                                        02120000
   assemble(cio 1);                                                     02125000
   tos := notrdywt;                                                     02130000
   tos := wnew;                                                         02135000
   go out;                                                              02140000
welldone:                                                               02145000
   if ditp(msk) <> %377 then                                            02150000
    begin  <<ascii mode>>                                               02155000
     eofcheck(ioqp,ubuf,ditp(count),if ditp(msk)=%177 then 1 else -1);  02160000
     if <> then                                                         02165000
     begin  <<eof found>>                                               02170000
       tos:=abuf;                                                       02175000
       tos:=ubuf;                                                       02180000
       tos:=-(ditp(count));                                             02185000
       tos:=tos&asr(1);  <<set to word count>>                          02190000
       assemble(mabs);                                                  02195000
       ditp(flg):=deof;                                                 02200000
       mstate:=endio;                                                   02205000
       return;                                                          02210000
     end;                                                               02215000
    end;                                                                02220000
    tos:=successful;                                           <<00.05>>02225000
iodone:                                                                 02230000
   ditp(count):=0;                                             <<00.06>>02235000
   masterclear(ditp);                                                   02240000
   tos := endio;                                                        02245000
   tos := drtn;                                                         02250000
   tos:= 2;  <<enable ints>>                                            02255000
   assemble(cio 1);                                                     02260000
   del;                                                                 02265000
out:                                                                    02270000
   mstate :=tos;                                                        02275000
   status:=tos;                                                         02280000
   return;                                                              02285000
end  <<ptrdvr >>  ;                                                     02290000
$page                                                                   02295000
                                                                        02300000
$page "PTRDR0-'DUMMY' OUTER BLOCK GIVES CONFIGURATION DATA"             02305000
 assemble(pcal siodm;      <<monitor>>                                  02310000
          pcal ptrdvr;     <<initiator>>                                02315000
          pcal ptrdvr;     <<completor>>                                02320000
          con  0;                                                       02325000
          pcal initz;      <<initialization>>                           02330000
          con  1;          <<i interrupt handler>>                      02335000
          pcal ptrip);     <<interrupt handler>>                        02340000
end  << ioptrd0  >> ;.............................................      02345000
