$CONTROL USLINIT,ADR,MAP                                       <<03033>>00005000
<< hardres - module 55 >>                                               00010000
<< hp32002c mpe source c.00.00 >>                                       00015000
<< COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980.           >>  00020000
<<     this program may be used with one computer system at a       >>  00025000
<<     time and shall not otherwise be recorded, transmitted or     >>  00030000
<<     stored in a retrieval system.  copying or other reproduction >>  00035000
<<     of this program except for archival purposes is prohibited   >>  00040000
<<     without the prior written consent of hewlett-packard company.>>  00045000
<< **** note - dollar copyright cannot be used with this module *** >>  00050000
$control uslinit,adr,map,code                                  <<03068>>00055000
$control define                                                <<06872>>00060000
$tp                                                                     00065000
                                                               <<03033>>00070000
$control segment=hardres,main=hardres,nowarn                   <<03033>>00075000
                                                               <<03033>>00080000
begin                                                          <<03033>>00085000
$control define                                                         00090000
                                                               <<03033>>00095000
  define  devtypef   = (10:6)#,  <<type from ldt2>>            <<03033>>00100000
          subtypef   = (12:4)#,      <<  l  >>                 <<03033>>00105000
          fors       = (11:1)#,      <<  p  >>                 <<03033>>00110000
          nsdf       = ( 4:1)#,      <<  d  >>                 <<03033>>00115000
          jdfield    = ( 2:2)#,      <<  t  >>                 <<03033>>00120000
          drstate    = ( 0:2)#,      <<  1  >>                 <<03033>>00125000
                                                               <<03033>>00130000
          << ---- warning "LPDT1" is defined locally ---- >>   <<03033>>00135000
                                                               <<03033>>00140000
          nonsysdev  = lpdt1.nsdf=1#,                          <<03033>>00145000
          notforein  = lpdt'serial'or'foreign<>lpdt'foreign#,  <<06872>>00150000
          unowned    = lpdt'dev'own'state<>lpdt'owned#,        <<06872>>00155000
          allocated  = lpdt'dev'own'state=lpdt'owned#,         <<06872>>00160000
          jdaccpt    = lpdt1.jdfield<>0#,                      <<03033>>00165000
          stype      = lpdt1.subtypef#,                        <<03033>>00170000
                                                               <<03033>>00175000
          << ---- warning "TYPE" is defined locally ---- >>    <<03033>>00180000
                                                               <<03033>>00185000
          d7905r     = ( type=0 land stype= 4 )#,              <<03033>>00190000
          d7905f     = ( type=0 land stype= 5 )#,              <<03033>>00195000
          d7920      = ( type=0 land stype= 8 )#,              <<03033>>00200000
          d7925      = ( type=0 land stype= 9 )#,              <<03033>>00205000
          d7906r     = ( type=0 land stype=10 )#,              <<03033>>00210000
          d7906f     = ( type=0 land stype=11 )#,              <<03033>>00215000
          floppy     = ( type=2 )#,                            <<03033>>00220000
          d7935      = ( type=3 land stype= 8 )#,              <<03033>>00225000
          linus      = ( type=3 land stype= 0 )#,              <<03033>>00230000
          magtape    = ( type=24 )#,                           <<03033>>00235000
          discdevice = ( 0 <= type <= 7 )#,                    <<03033>>00240000
          removable  = (d7920 or d7925 or d7905r or d7906r     <<03033>>00245000
                        or floppy or d7935 or linus)#,         <<03033>>00250000
          splitdisc  = d7905f or d7906f#;                      <<03033>>00255000
                                                               <<03033>>00260000
  equate  servreq    = 2,                                      <<03033>>00265000
          servgrntd  = 3,                                      <<03033>>00270000
    wrtbase   = 17,      <<sio prog starting address>>                  00275000
    aborted   = 5,                                             <<01828>>00280000
    abort'io  = 66,        << sccp abortio and procio function >>       00285000
    ack        = 6,         << ascii acknowledge character >>           00290000
    ackintrpt  = 1,         << acknowledge terminal mpx interrupt >>    00295000
    active'   = 2,         << monitor is running against this device >> 00300000
    attn      = %37,       << attention needed status >>       <<rh.pv>>00305000
    bandwait  = 5,         << waiting for less term activity >>         00310000
    binaryread'=11,        << binary read or write enq/ack wait >>      00315000
    blkdio    =%200,       << blocked i/o wait bit >>                   00320000
    blocked'  = 5,         << blocked i/o request >>                    00325000
    blockmodrd= wrtbase+233,                                            00330000
    blocktimeout= 8,                                           <<01826>>00335000
    blockwait = wrtbase+223,                                            00340000
    break'    = 10,        << break is allowed and has been detected >> 00345000
    breakstop = 1,         << read stop code after break accepted >>    00350000
    brkbit    =%10,        << break service request to term >>          00355000
    brkstatus'= 7,         << break detected status of tio >>           00360000
    cb'       = 5,         << clear to send, reqst to send delayed >>   00365000
    cce       = 2,                                                      00370000
    ccg       = 0,                                                      00375000
    ccl       = 1,                                                      00380000
    cf'       = 4,         << carrier detected if set >>                00385000
    cfailto   = 1,         << carrier fail time out request >>          00390000
    charlost' = 6,         << interrupt not serviced in time >>         00395000
    clkmultiplyer=%13547,  << simulate .09412857 in binary >>           00400000
    cmode'    =11,         << terminal is in console mode >>            00405000
    cntrla     = 1,         << ascii control a charactter >>            00410000
    cntrlh    =%10,                                                     00415000
    cntrlx     =%30,        << ascii control x character >>             00420000
    cntrly     =%31,        << ascii control y character >>             00425000
    completed'= 6,         << i/o request has been completed >>         00430000
    coreres'  = 10,        << driver code is core resident >>           00435000
    cr        =%15,                                                     00440000
    crlf      =%6412,      << ascii cr / lf >>                          00445000
    crlfjmp   = 52,      <<jmp displm from 32 to 84>>                   00450000
    crwait    = 1,                                                      00455000
    crwaitlf  = 2,                                                      00460000
    cstpaddr  = 0,         << absolute addr of cst pointer >>  <<01475>>00465000
    cy'etx    = %14403,    << control y, etx >>                <<02866>>00470000
    datafrzn' = 7,         << data segment is frozen (ioq) >>           00475000
    dbcnt     =12,         << read,write byte counter and limits >>     00480000
    dblktail  = 36,                                                     00485000
    dbreak    =30,         << ioqp to saved broken read data >>         00490000
    dbtime    = 16,                                            <<01826>>00495000
    dc1'etx   = %10403,    << dc1 trigger and etx characters>> <<01931>>00500000
    dc2       =%22,        << 2640 response to dc1(xon) sent out >>     00505000
    dc2pair   = 4,                                                      00510000
    dcntrl    =10,         << multiplexor control word and next dstate>>00515000
    dcnt      = 18,        << count to unusual rd/wrt action >>         00520000
    ddltp     = 4,         << dlt pointer >>                            00525000
    deletecr  =%13,        << doing a cr after cntrl x delete >>        00530000
    deletepair= 2,         << last pair char was a control h >>         00535000
    delecho'  = 2,         << echo a \ on character deletion >>         00540000
                           << 0 - nothing, 1 - \, 2 - lf, 3 - c'y >>    00545000
    dhead     = 19,        << sysdb pointer to head of tbuf list >>     00550000
    diltp     = 5,         << ilt pointer >>                            00555000
    dintp     = 4,         << special interrupt handler plabel >>       00560000
    dinit     = 2,         << initiator plabel >>                       00565000
    dioqp     = 2,         << ioq pointer to first request >>           00570000
    disc'     =  1,        << device is a disc (dit) >>                 00575000
    dlast     =23,                                                      00580000
    dlink     = 1,         << pointer to next dit requesting resource >>00585000
    dldev     = 3,         << logical device and unit numbers >>        00590000
    dmamq     =  8,        << pointer to mam request queue >>           00595000
    dmntr     = 1,         << monitor plabel >>                         00600000
    dnxtb     = 25,        << tbuf pointer of a save tbuf if not 0 >>   00605000
    dpcbn     = 8,         << type 3 driver pcb number >>               00610000
    dmodem    = 8,         << modem type and state  >>                  00615000
    dmontr    = 34,                                                     00620000
    dpntr     = 21,        << byte pointer to access tbufs >>           00625000
    drbct     = 11,        << requested transfer count in bytes >>      00630000
    drqst     = 6,         << monitor service request flags >>          00635000
                           << 0 - hangupto    8  - readto               00640000
                              1 - disconnect  9  - online               00645000
                              2 - cfailto     10 - dstready             00650000
                              3 - turnto      11 - logonto              00655000
                              4 - ioerror     12 - break                00660000
                              5 - iodone      13 - control y            00665000
                              6 - spoolend    14 - cfail                00670000
                              7 - spoolsw     15 - unused               00675000
                           >>                                           00680000
    drt3      = 3,         << last word of drt entry >>                 00685000
    drtaddr   =9,   <<this will hold offset for drt table>>    <<03018>>00690000
    drtbank   =8,   <<this will hold bank drt table is in>>    <<03018>>00695000
    drtmask   =%777,    <<mask to keep last 9 bits>>           <<03018>>00700000
    drtmax    =28,         << maximum time for read timeout, seconds >> 00705000
    drtime    =26,         <<  index to i/o read time >>                00710000
    drtimed   =drtime/2,   << double index to i/o read time >>          00715000
    dsave     =13,         << holds waited dstate, hstate & turn char >>00720000
    dserr     = 7,         << hardware i/o error status in dit >>       00725000
    dsiopc    = 35,                                                     00730000
    dspeed    = 9,         << multiplexor speed and other flags >>      00735000
    dsize     = 5,         << dit size and device type word >>          00740000
    dstat1    = 18,        << dit - request status (word1)>>   <<00.pv>>00745000
    dstat2    = 19,        << dit - request status (word2)>>   <<00.pv>>00750000
    dstate'   =12,         << device state                              00755000
                               0 - null         %10 - eor sync          00760000
                               1 - writing      %11 - write buf fill    00765000
                               2 - reading      %12 - send xon next     00770000
                               3 - xon write    %13 - delete cr         00775000
                               4 - write turn   %14 - syncs or "!"s     00780000
                               5 - band wait    %15 - read data echo    00785000
                               6 - eor lf       %16 - start read        00790000
                               7 - eor cr       %17 - stop read >>      00795000
    dstop     = 14,        << sub sys brk and eor characters >>         00800000
    dsync     = 29,        << cr,lf sync data and sync counter >>       00805000
    dtail     = 20,        << sysdb pointer to end of tbuf list >>      00810000
    dtblk     = 24,        << link word for queued tbuf requests >>     00815000
    dstat     = 6,         << last hardware interrupt status >>         00820000
    dtankb    = 33,                                                     00825000
    dtbuf     =18,         << first tbuf pointer  >>                    00830000
    dtbufd    = dtbuf/2,   << double index to first two tbuf pointers >>00835000
    dtrlx     = 31,        << time our request trlx's >>                00840000
    dtype     = 7,         << paircode, termtype, hstate,timer flags>>  00845000
    dtypedlt  = 5,         << device type in driver linkage tab<<02804>>00850000
    dvrfrzn'  =  8,        << driver code is frozen (dlt) >>            00855000
    dwait     = 15,        << ditp to next dev on activity wait >>      00860000
    echo'     = 3,         << input is to be echoed to output channel >>00865000
    echooff   = 0,         << turn echo off code to mpxcontrol >>       00870000
    emptitbuf = %100002, <<wrt sio prog fini sending tbuf>>             00875000
    enq       = 5,         << enq code to 2640 >>                       00880000
    enqackwait'= 11,       << waiting to an ack after an enq >>         00885000
    enter     = 8,         << dc2 last, possible no echo "ENTER" >>     00890000
    eorcr     = 7,         << dstate - eor cr in progress >>            00895000
    eorlf     = 6,         << dstate - eor lf in progress >>            00900000
    eorsync   =%10,                                                     00905000
    esc       =%33,        << esc character >>                          00910000
    escseq    = 24,                                                     00915000
    escpair   = 3,         << last pair character was esc     >>        00920000
    etx       = 3,         << ascii end of text >>                      00925000
    etxsent'  = 10,        << etx sent to terminal on 202 >>   <<00.02>>00930000
    filledtbuf= %100003, <<rd sio prog fini filling tbuf>>              00935000
    finisend  = wrtbase+121,                                            00940000
    finread   =%17,                                                     00945000
    formfeed'  = 4,        << device respondes to a form feed >>        00950000
    ff        =%14,        << form feed >>                              00955000
       firstindex = %14, << index to 1st buffer of sbuf >>     <<06872>>00960000
    icf'55    =4, <<cpu number of icf 55>>                     <<03018>>00965000
    hangingup =  7,        <<modem being hanged up>>           <<01669>>00970000
    hangupturn=  6,        <<line being turnaround>>           <<01669>>00975000
    hiopcode  =%120000,                                                 00980000
    hp2631b   = 19,        << remote line priniter t. t. >>    <<01475>>00985000
    hp2640x   = 11,        << 2640 with no echo on start read >>        00990000
    hp2640to  = 0,         << 2640/44 read/write time out request >>    00995000
    iak'      =  8,        << device has interrupted (dit) >>           01000000
    icdp      = 11,        << current ditp in ilt table >>     <<00.tp>>01005000
    icpgm     = 6,         << next channel pgm adr to start >> <<03068>>01010000
    icntrl    = 7,         << controller info in ilt >>        <<00.tp>>01015000
    icpva0    = 0,         << cpva word0 in ilt >>             <<00.tp>>01020000
    icpva1    = 1,                                             <<00.tp>>01025000
    icpva2    = 2,                                             <<00.tp>>01030000
    icpva3    = 3,         << cpva word3 in ilt >>             <<00.tp>>01035000
    iditp     = 14,        << beginning of ditp's in ilt >>    <<00.tp>>01040000
    iflag     = 13,        << flags word of ilt >>             <<00.tp>>01045000
    ignorehi' = 2,         << ignore halt interrupt flag >>    <<tp.10>>01050000
    imask     = 7,         << interrupt mask word>>                     01055000
    imask55   =%32,<<start of 4 word interrupt mask for icf55>><<03018>>01060000
    impedable = 4,         << awakeio caller may be impeded >>          01065000
    intrptoff = 2,         << disable intrpts & echo on read channel >> 01070000
    initdset  = 0,         << initialize data set control code >>       01075000
    ioprog'   = 7,         << sio program in progress >>                01080000
    iowait    =%100,       << unblocked i/o wait code >>                01085000
    iowake'   = 4,         << wake caller on completion if set >>       01090000
    iqueue    = 12,       << controller queue # in ilt >>      <<00.tp>>01095000
    isiop     = 8,         << points to sio program area >>    <<00.tp>>01100000
    istap     = 9,         << status area ptr in ilt >>        <<00.tp>>01105000
    iunit     = 10,        << controller resource # >>         <<00.tp>>01110000
    jmpsrqoff = 38,      <<jmp displm from 62 to 100>>                  01115000
    junkwait  = %20,                                                    01120000
    lf        =%12,                                                     01125000
    lf'etx    = %5003,     << line feed, etx >>                <<02866>>01130000
    lflags    =  1,        << flags word of lpdt >>                     01135000
    lim       = 0,         << limit word of table allocation >>         01140000
    loggingon = 2,         << hstate logging on >>                      01145000
    logonto   = 4,         << log on time out request type >>           01150000
    lostchar  = 4,         << mpx not serviced in time >>               01155000
    lostdata  = 3,         << buffer not available >>                   01160000
    lpdtsize  = 2,         << size  of lpdt entry >>                    01165000
    lr        = 17,        << storage for interrupt interval >><<01431>>01170000
    lynx'type = %50017,   <<lynx channel id value>>            <<03028>>01175000
    m202'     = 2,         << 202 or 2002 modem >>                      01180000
    m202      =m202'+1,    << circular shift count to get 202 to bit15>>01185000
    mamerrorc'= 9,         << mam error bit in dlt >>                   01190000
    mamerrord'= 8,         << mam error bit in ioq >>                   01195000
    maxtio    = 12,        << max term i/o to prevent block overruns >> 01200000
    mhdisc'   =  9,        << dev = a moving head disc (dit) >><<rk0pv>>01205000
    minibee   = 9,         << terminal type of minibee, hp 2615 >>      01210000
    modsiocntrl=wrtbase+154,                                            01215000
    modsiopty =wrtbase+171,                                             01220000
    munit'    = 5,         << multiple devices having one controller >> 01225000
    newline'  = 8,         << lf was last character output >>           01230000
    newspecchar=wrtbase+258,<<sio prog address for spec char>> <<02867>>01235000
    nodatayet = 5,                                                      01240000
    noecho    = 3,                                                      01245000
    noimpede  = 0,         << dont impede flag to awakeio >>            01250000
    non'resp'dev'msg=409,<< non-responding device drt # msg >> <<03073>>01255000
    nopcb     = %13,       << no pcb is to be associated with the io >> 01260000
    noprotocol=18, <<term type without dc1 read or enq writes>><<01218>>01265000
    nopty'    = 2,         <<8-bit data  flag-->>              <<ams00>>01270000
                          <<set in 8th bit>>                   <<ams00>>01275000
    notrdymsg = 11,        << not ready ldev message number >>          01280000
    notreading = 0,         << device not in reading state >>           01285000
    nosync'   = 7,         << 2640 series terminal >>                   01290000
    nowait    = 0,         << dont wait in wake >>                      01295000
    null      = 0,                                                      01300000
    nxtnull   = 3,         <<sio interrupt code in cpva1>>              01305000
    nxtblkrd  = wrtbase+221,                                            01310000
    nxtcrlf   = 4,                                                      01315000
    nxtrd     = 5,                                                      01320000
    online    = 1,         << speed sensed and can do i/o hstate >>     01325000
    opconsole = 0,         << output message to operator >>             01330000
    pair'     = 7,         << escape or terminet xoff last >>           01335000
    papoutmsg = 14,        << ci msg index for paper out >>    <<01475>>01340000
    parity'   = 8,         << sense of parity written or read >>        01345000
    premptstop= 3,         << stop read for premptive request >>        01350000
    preq'     = 9,         << i/o request has been pre-empted by mam >> 01355000
    pretopost =%30,        << adding a cr/lf in pre to post spacing >>  01360000
    primary   = 1,         << get only from primary table >>            01365000
    primed'   = 10,        << 2640 ready to send a block >>             01370000
    ptapefunc =29,         << paper tape spooling function >>           01375000
    ptychk'   = 9,         << parity check reads >>                     01380000
    ptycntrl' = 7,         << parity is to be sent in 8th bit >>        01385000
    ptyerror  = 5,         << read parity error >>                      01390000
    ptymask   =%200,       << parity sense bit mask >>                  01395000
    qi        = 5,         << word 5:  used by checkdb >>      <<06872>>01400000
    rdinstr   = [8/3,8/0],                                              01405000
    rd4thword = [1/1,1/0,14/0],  <<4th word in rd channel instr>>       01410000
    rddatainstr=wrtbase+91,                                             01415000
    rdspecl   = 2,         <<cpva2 interrupt code>>                     01420000
    rdnxttb   = 1,                                                      01425000
    rdstrt    =wrtbase+43,                                              01430000
    rdintrpt  =wrtbase+147,                                             01435000
    rdwait    =wrtbase+76,                                              01440000
    readbinary= 1,         << binary read in progress >>                01445000
    readcmpltd=%43,        << rstate - read completed >>                01450000
    readecho  =%15,        << echoing 1st char of no echo read >>       01455000
    reading   = 2,         << dstate- read in progress >>               01460000
    readtimeout= 3,        << read time out request type >>             01465000
    readto    = 6,         << read timed out readerrors code >>         01470000
    readwaiting= 5,        << read waiting to start after write done >> 01475000
    restart'  = 1,         << restart write after buffer fill >>        01480000
    repeating =%14,        << writing sync's or "!"'s >>                01485000
    request'  = 3,         << monitor service requested while active >> 01490000
    revslash  = %134,                                                   01495000
    secondary = 2,         << get tbuf from 2nd if primary empty >>     01500000
    recvoff   =wrtbase+50,                                              01505000
    sbufmaxb  = 256,                                                    01510000
    scsr      = %26,       <<                              >>           01515000
    sclc      = %27,       <<                              >>           01520000
    send'     = 5,         << output completion status bit >>           01525000
    senddown   = 2,         << send info down to unit >>                01530000
    sendlf    = 8,         <<cpva1 code to send lf/syncs>>     <<00637>>01535000
    sendxon   =%12,        << read to be actually started dstate >>     01540000
    setecho   = 1,         << set echo on if enable >>                  01545000
    series'37 = 5,         << cpu # of series 37 >>            <<c8291>>01550000
    series'33 = 8,            << cpu # of series 33 >>         <<01431>>01555000
    multi'imb = %60,       << series 64 & series 37 >>         <<c8291>>01560000
    sfail'    = 10,        << sio failure bit in qflags >>              01565000
    siobase   = -46,       << offset from inittcp to sio area>><<01286>>01570000
    siofail  = 64,         << delayed sio failure function code >>      01575000
    sp'etx    = %20003,    << space, etx >>                    <<02866>>01580000
    spec'     =  1,        << disc request is for mam >>                01585000
    specialstop= 1,        << read terminated on special stop char >>   01590000
    specih'   = 4,         << use special interrupt handler >>          01595000
    speedto   = 6,         << speed sensing timeout type >>             01600000
    spoolend' = 7,         << ptape read compltd service reques<<00.06>>01605000
    spooling' = 5,         << ptape read in progress >>                 01610000
    spoolsw'  = 6,         << ptape buffer full service request<<00.06>>01615000
    spsenbaud =wrtbase+178,                                             01620000
    spdsensio = 7,         <<speedsense sio prog active dstate>>        01625000
    srqoff    = wrtbase+209,                                            01630000
    srqoffset = 76,        <<offset of wait srq instr for read>>        01635000
    statadrofset=11, <<offset of buf addr for rd status instr>>         01640000
    ssbreak'  = 4,         << sub sys brk is allowed &  has been det. >>01645000
    stopped   =%44,        << read stopped request state >>             01650000
    sysdb     =%1000,                                                   01655000
    sync'cr   = 6,                                                      01660000
    sync'lf   = 7,                                                      01665000
    syncchar  =%47777,     << sync character  >>                        01670000
    syncflag' = 4,         << set if data is a sync character >>        01675000
    synstrt   =wrtbase+57,                                              01680000
    sysbufr'  =  3,        << request data is in system buffers >>      01685000
    syscst    = 1,                                                      01690000
    sysdst    = 2,                                                      01695000
    sysinittcp=%347,       << sysglob offset >>                <<01286>>01700000
    sysioq    = 5,                                                      01705000
    syslpdt   =%10,        << logical physical device table >>          01710000
    sysmon    =%1267,      << system monitor flag >>           <<00.02>>01715000
    syspcb    = 3,                                                      01720000
    syssbuf   = 6,                                                      01725000
    systbuf   =%16,                                                     01730000
    tapemode' = 0,         << paper tape read mode;no edit responses >> 01735000
    tbmaxb    = 60,                                                     01740000
    tbmaxw    = tbmaxb/2,                                               01745000
    tbqn      = 0,        <<resource queue# for tbuf requests>>         01750000
    templr    = %22,   << this location is used by tick >>     <<00495>>01755000
                       << because the limit register is >>     <<00495>>01760000
                       << updated by the firmware before>>     <<00495>>01765000
                       << it gets to tick(see tick proc >>     <<00495>>01770000
    termchar' =10,         << terminate input on stop char >>           01775000
    terminet  = 6,                                                      01780000
    termjmp   = [8/15,8/1],                                             01785000
    thead     = 2,         << head index  >>                            01790000
    timerwait = %10,        << waken pin on timer wait >>      <<02804>>01795000
    tovrfl    = 5,         << overflow of primary table counter >>      01800000
    tqueue    = 1,         << term i/o limit resource number >>         01805000
    transerr' = %14,       << iostat error for 2631's >>       <<01475>>01810000
    transmit  = 4,         << finsh turning 202 to write state >>       01815000
    transmit' = 5,        << finish turn of half duplex line >><<02866>>01820000
    trqsts    = 3,         << request for elements counter, double >>   01825000
    tsize     = 1,         << element size and impeded pcb >>           01830000
    ttail     = 3,         << index of last element  >>                 01835000
    turn202    = 4,        << dstate, turning 202 to read or write >>   01840000
    turnto     = 2,        << 202 turn around time out type >>          01845000
    tuse      = 4,         << max in use and current in use >>          01850000
    unitmask = %037000,    << mask unit # from control word >>          01855000
    up'       = 1,         << on line,speed sensed and can do i/o >>    01860000
    uartbufadr= 10,                                                     01865000
    unknown'int'msg = 410, << unknown device interrupted msg >><<03662>>01870000
    wait2sio  = wrtbase+251,                                            01875000
    waited    =%11,        << write/read/bandwait held for break >>     01880000
    waitack   = 16,        <<cpva2 interrupt code>>                     01885000
    waitcr    = 14,        <<cpva2 interrupt code>>                     01890000
    waitc'a   = 18,        <<cpva2 interrupt code>>                     01895000
    waiting   = 7,        << qmisc state for waited req's >>   <<01475>>01900000
    waitspds  =8,                                                       01905000
    wakecount =32,         << wake if less remain to be written >>      01910000
    writing   = 1,         << dstate is writing >>                      01915000
    wrtsrq    = wrtbase+10,                                             01920000
    wrtdatainstr=wrtbase+34,                                            01925000
    wrtintrf  = 123,  <<offset of wrt interf cntrl chan instr>>         01930000
    wrt'rd    =wrtbase+66,                                              01935000
    wrt'rd2   = wrtbase+246,                                            01940000
    wrtspecl  = 3,                                             <<04228>>01945000
    wsp       = 14,        <<                              >>           01950000
    xmiton    =wrtbase+5,                                               01955000
    xmitoff   =wrtbase+71,                                              01960000
    xon       =%21,                                                     01965000
    xoff       =%23,        << ascii control x character >>             01970000
    xoffpair  = 1,         << last pair char xoff,terminet & tapemode >>01975000
  endeq       = 0;                                                      01980000
equate    << i/o tables id numbers >>                          <<07423>>01985000
   sbuf'table     = 1,                                         <<07423>>01990000
   ioqq'table     = 2,                                         <<07423>>01995000
   disc'table     = 3;                                         <<07423>>02000000
equate sysbase=%1000,                                                   02005000
                                                               <<06872>>02010000
                                                               <<06872>>02015000
       ioqreqtabix=%5,                                         <<06872>>02020000
       sysioqreqtab=sysbase+ioqreqtabix,                       <<06872>>02025000
       syssbuftab=%1006,                                       <<06872>>02030000
       systbuftab=%1016,                                       <<06872>>02035000
                                                               <<06872>>02040000
       syslpdtbuf=%1010,                                       <<06872>>02045000
        syswaittodispmsg=%1053;                                <<mpeiv>>02050000
integer pointer ics = 7;                                       <<01811>>02055000
equate          icsstkbank=5,                                  <<01811>>02060000
                icsstkbase=9,                                  <<01811>>02065000
                pxglobsize=12;                                 <<06872>>02070000
define  trapsoff = push(status);                               <<01861>>02075000
                   tos.(2:1) := 0;                             <<01861>>02080000
                   set(status)#;                               <<01861>>02085000
$include inclmio                                               <<06872>>02090000
$include incliqh                                               <<06872>>02095000
$include inclioq                                               <<06872>>02100000
$include incldqh                                               <<06872>>02105000
$include incldrq                                               <<06872>>02110000
$include inclarq                                               <<07423>>02115000
$include inclsbh                                               <<06872>>02120000
$include incltbh                                               <<06872>>02125000
$include inclmsg                                                        02130000
define transcompflag=(15:1)#,  <<waittodispmsg>>               <<mpeiv>>02135000
       longwaitflag=(1:1)#,                                    <<mpeiv>>02140000
       phasetransflag=(3:1)#,                                  <<mpeiv>>02145000
       memtrapflag=(4:1)#,                                     <<mpeiv>>02150000
       imptrapflag=(5:1)#,                                     <<mpeiv>>02155000
       recoveredocflag=(6:1)#,                                 <<mpeiv>>02160000
       discwaitflag=(7:1)#,                                    <<mpeiv>>02165000
       termreadflag=(8:1)#,                                    <<mpeiv>>02170000
       swflag=(0:1)#;                                          <<mpeiv>>02175000
define msgiofzreqflag=(0:1)#;                                  <<mpeiv>>02180000
integer discreqtabsysbaseinx=db+discreqtabix;                  <<mpeiv>>02185000
integer pointer discreqtab=discreqtabix;                       <<mpeiv>>02190000
define setdisciosegflag=(1:1)#;                                <<mpeiv>>02195000
equate cleardisciosegbit = 3;                                  <<06872>>02200000
define referencedflag=(2:1)#;                                  <<mpeiv>>02205000
                                                               <<mpeiv>>02210000
equate                                                         <<06872>>02215000
       qpriwordnum=1,                                          <<mpeiv>>02220000
       swbit=0,                                                <<mpeiv>>02225000
       transcompbit=15;                                        <<mpeiv>>02230000
$include inclpcb5                                              <<06872>>02235000
$include inclmeas                                              <<mpeiv>>02240000
                                                                        02245000
$include inclmift                                              <<04115>>02250000
$include inclio                                                         02255000
define logicalmapping = absolute(%1220)#;                      <<06872>>02260000
$include inclcdef                                              <<06872>>02265000
$include inclobj                                               <<06872>>02270000
$include inclsf                                                <<06872>>02275000
$include inclldr                                               <<06872>>02280000
$include inclldt5                                              <<06872>>02285000
$include incllpdt                                              <<06872>>02290000
$include incltrl                                               <<06872>>02295000
equate segiddatatype=0,                                                 02300000
       segidsltype=1;  <<program type =2 or 3>>                         02305000
define segidtypefield=(0:2)#,                                           02310000
       segidpbxflag=(0:1)#,                                             02315000
       segidpbxfield=(1:7)#,                                            02320000
       segidlogsegfield=(8:8)#;                                         02325000
  define                                                                02330000
    abortwrt  =( 5:1)#,                                                 02335000
    abs       = absolute#,                                              02340000
    active    =(active'  :1)#,                                          02345000
    autohandsh=ioqpl(qpar2).(9:1)#, << do views read >>        <<01474>>02350000
    binaryread=(11:1)#,    << if set then xfer 8 bits on read >>        02355000
    asmb      = assemble#,                                              02360000
                                                               <<06332>>02365000
    binary    =(11:2)#,    << if 0 then ascii else binary read >>       02370000
    bit8      =( 8:1)#,    << bit 8 of of ascii code >>                 02375000
    blocked   =(blocked':1)#,<< request waits until completion >>       02380000
    blockrd   =(10:1)#,                                                 02385000
    brkrqst   =(12:1)#,                                                 02390000
    bwrite    =( 7:1)#,    << binary write, pty disable >>              02395000
     cached    = ( 4:1)#,    << bit in flags word of dit >>    <<06872>>02400000
    cb        =(cb':1)#,                                                02405000
    cbsb      =(cb':2)#,   << current state of cb and sb >>             02410000
    ccvalue   =( 9:1)#,    << old cc status kept in dsave>>             02415000
    ccchange  =(11:1)#,    << change in data set ready status >>        02420000
    cf        = (cf':1)#,  << carrier detected >>                       02425000
    cf'cb'sb  =( 4:3)#,    << half duplex state >>             <<02866>>02430000
    cfailcnt  =( 4:6)#,    << carrier failure counter >>       <<01.01>>02435000
    cfailtrlx = ditp(32).(0:8)#, << carrier fail timer index>> <<02866>>02440000
    cfstatus  = (14:1)#,   << dset carrier detected status >>           02445000
    cc        =( 6:2)#,    << condition code field in status >>         02450000
    ccc        =( 5:3)#,    << cond code plus carry >>         <<03033>>02455000
    ch        =(10:1)#,    << 2002 speed control, 0 = low speed  00.02>>02460000
    chanque   =(1:6)#,     << channel queue number in ilt >>            02465000
    charmask  =( 8:8)#,                                                 02470000
    checkdb  =disable;                                         <<01115>>02475000
              push(db);                                        <<01115>>02480000
              x := absolute(qi)-5;                             <<01115>>02485000
              tos := absolute(x);                              <<01115>>02490000
              x := x+1;                                        <<01115>>02495000
              tos := absolute(x);                              <<01115>>02500000
              enable;                                          <<01115>>02505000
              assemble(dcmp)#,                                 <<01115>>02510000
    checkdio  = if < then iofailure(drtn,ditp)#,                        02515000
    cmode     =(cmode':1)#,<< terminal in console mode >>               02520000
    completed =(completed':1)#,                                         02525000
    consintrpt=(11:1)#,    << console interrupt ok if set >>   <<00.03>>02530000
    coreres   =(coreres':1)#,                                           02535000
    cquen     =(8:8)#,     << controller request que # >>               02540000
    crsync    =( 4:4)#,    << number of sync's after a cr >>   <<00.02>>02545000
    datafrzn  =(datafrzn':1)#,                                          02550000
    dataparity=(5:1)#,     << data input parity >>             <<01.01>>02555000
    delack    =( 8:1)#,                                                 02560000
    delecho   =(delecho':2)#,                                           02565000
    devtype   =(8:8)#,     << device type of dlt >>                     02570000
    dircstate =( 0:2)#,    <<  device recognition state  0 - not owned  02575000
                               1 - requesting service, 2 - service      02580000
                               granted,  3 - owned or recognized  >>    02585000
    disable   = assemble( sed 0 )#,                                     02590000
    disc      =(disc':1)#, << dflag, device is a disc >>                02595000
    disconnect=( 1:1)#,    << disconnect service request to term >>     02600000
    domod     =( 6:1)#,                                                 02605000
    donxtmod  =( 3:3)#,                                                 02610000
    dldevn    =(8:8)#,     << logical device number of dit >>           02615000
    dmontrp   = ditp(dmontr)#,                                 <<02866>>02620000
    drtnumber =(7:9)#,                                         <<03018>>02625000
    dsavepl   = ditpl(dsave)#,                                 <<02866>>02630000
    dsetready =(10:1)#,    << data set ready service request to term >> 02635000
    dsetunit  =( 4:4)#,    << unit field in dset status >>              02640000
    dstate    =(dstate'  :4)#,                                          02645000
    dstfield  =(1:10)#,    << dst number extract from pcb >>            02650000
    dstn      =(1:15)#,    << dst extract from ioq >>          <<*7615>>02655000
    duplicate =assemble( dup     )#,                                    02660000
    dvrfrzn   =(dvrfrzn':1)#,                                           02665000
    echo      =(echo':1)#,                                              02670000
    echoon    =( 2:1)#,  <<when restart rd, enable echo>>               02675000
    enable    = assemble( sed 1 )#,                                     02680000
    enqackwait=(11:1)#,    << 2640 write enq/ack wait >>                02685000
    enqoffset =(1:15)#,                                                 02690000
    eof       =( 7:3)#,    << last eof conditon in lpdt >>              02695000
    eorchar    =( 8:8)#,    << transparent read eor character >>        02700000
    epe       =( 6:1)#,                                                 02705000
    esize     =(8:8)#,     << table entry size >>                       02710000
    etxsent   =(etxsent':1)#,<< etx sent to terminal on 202 >> <<00.02>>02715000
    f         = absolute#,                                              02720000
    filling   =(14:1)#,    <<ioterm is filling tbufs with wrt data>>    02725000
    flush     =(0:1)#,     << brk/ssbrk flush in progress >>            02730000
    formfeed  =(formfeed':1)#, << if clear do cr for formfeed >>        02735000
    func      =( 8:8)#,    << qfunc, function code >>                   02740000
    hcunit    =(11:5)#,     << high configured unit number >>           02745000
    hiop      =con %20302;con 1#,                                       02750000
    hiopwait  =( 0:1)#,                                                 02755000
    hstate    =( 4:3)#,    << hang up state                             02760000
                               0 - hungup       3 - hngp spd sns discnct02765000
                               1 - online       4 - dclose disconnect   02770000
                               2 - logging on   5 - lo spd sns discnct  02775000
                               6 - hang up turn 7 - hanging up >>       02780000
    iak       =(iak':1)#,                                               02785000
    idlesio   =(0:3)#,<<0-runstatus,1-chng stat,2-pwr recvry>>          02790000
    ignorehi  =(ignorehi':1)#,                                 <<tp.10>>02795000
    impedeok  =(13:1)#,    << ok to impede awakeio caller >>            02800000
    inin      =(14:1)#,    <<system initialization flag>>      <<01045>>02805000
    init      =con %20302;con 6#,                              <<01301>>02810000
    inspeed   =(12:4)#,    << input speed and character size >>         02815000
                           <<  0 - not determined  4 - 30 cps           02820000
                               1 - 240 cps         5 - 15 cps           02825000
                               2 - 120 cps         6 - 10 cps           02830000
                               3 -  60 cps         7 - 14 cps  >>       02835000
    inuse     =(8:8)#,     << number of elements currenty in use >>     02840000
    intrptenable=(2:1)#,   << enable interupts on this channel >>       02845000
    iowake    =(iowake':1)#,                                            02850000
    ioprog    =(ioprog':1)#,<< sio program in progress >>               02855000
    iostat    =( 8:8)#,    << total request status returned >>          02860000
    lflast    =( 1:1)#,                                                 02865000
    lfsync    =( 0:4)#,    << number of sync's after a lf >>            02870000
    limit1    =(8:8)#,     << primary table size  >>                    02875000
    limit2    =(0:8)#,     << total table size >>                       02880000
    loadmemory=assemble( lsea )#,                                       02885000
    mamerrorc =(mamerrorc':1)#,                                         02890000
    mamerrord =(mamerrord':1)#,                                         02895000
    maxentry  =( 0:8)#,    << entries in lpdt >>                        02900000
    mcode     =(10:6)#,    << monitoring to be done code >>             02905000
    mhdisc    =(mhdisc':1)#, << mhflag,is a moving head disc >><<rk0pv>>02910000
    missedint =(10:1)#,    << missed interupt field of iflag of ilt >>  02915000
    munit     =(munit':1)#,                                             02920000
    modactive =( 6:1)#,    <<interf modem control prog active>>         02925000
    modbyte   =(11:5)#,    << modem control byte >>                     02930000
    modem     =( 2:2)#,     << modem type number >>            <<01993>>02935000
    modecho   =(11:1)#,                                                 02940000
    modca     =(12:1)#,                                                 02945000
    modcd     =(13:1)#,                                                 02950000
    modch     =(14:1)#,                                                 02955000
    modsa     =(15:1)#,                                                 02960000
    modcbref  =( 3:1)#,                                                 02965000
    modccref  =( 4:1)#,                                                 02970000
    modceref  =( 5:1)#,                                                 02975000
    modcfref  =( 6:1)#,                                                 02980000
    modsbref  =( 7:1)#,                                                 02985000
    modcbmsk  =(11:1)#,                                                 02990000
    modccmsk  =(12:1)#,                                                 02995000
    modcemsk  =(13:1)#,                                                 03000000
    modcfmsk  =(14:1)#,                                                 03005000
    modsbmsk  =(15:1)#,                                                 03010000
    mpxflag    =(4:1)#,     << operation completed on terminal mpx  >>  03015000
    mpxunit    =(0:5)#,     << unit number in terminal mpx status >>    03020000
    mtype     =( 1:3)#,    << modem type                                03025000
                                0 - hardwired   2 - 202c                03030000
                                1 - 103         3 - 2002   >>           03035000
    ms'per'day = 86400000d#,   << # of ms in a day >>          <<01431>>03040000
    msecs'24'days= 2073600000d#,<< millisec in 24 days>><<01.03>>       03045000
    newline   =(newline' :1)#,                                          03050000
    nopty  =(nopty':1)#,   <<8-bit data flag-->>               <<ams00>>03055000
                          <<no parity set in 8th bit>>         <<ams00>>03060000
    nosync    =(nosync':1)#,<< no sync terminal, uses enq and ack >>    03065000
    notimpedable=(13:1)#,  <<caller may not be impeded >>               03070000
    notrdy    =(9:1)#,     << start wait for notrdy dev >>     <<00.tp>>03075000
    no'cx'echo=( 1:1)#,    << if set dont echo !!! on control x >>      03080000
    nsw       =(11:1)#,     << do not short wait disc >>                03085000
    nxtdstate =( 9:4)#,    << next dstate after 202 turn around >>      03090000
    oddpty    =( 8:1)#,                                                 03095000
    oe        =( 5:1)#,                                                 03100000
    oepe      =( 5:2)#,    <<uart overrun,pty error status>>            03105000
    offline   = (13:1)#,   << of status from hp263x >>         <<01475>>03110000
    output    =(1:1)#,     << if set then wio is output control >>      03115000
    outspeed  =( 6:4)#,    << output speed and character size code      03120000
                               see inspeed for meaning >>               03125000
    ownread   =(10:1)#,    << user does own dc1/dc2 handshaking >>      03130000
    pair      =(pair'    :1)#,                                          03135000
    paircode  =(12:4)#,    << denotes last pair char input >>           03140000
    paperout  = (15:1)#,   << status from hp263x >>            <<01475>>03145000
    parity    =(parity':1)#,                                            03150000
    paritysave=( 8:2)#,    << holds prty sense during write back 01.01>>03155000
    pcbm      =(8:8)#,     << pcb mask for pcb and table impeded link >>03160000
    pcbn      =( 0:8)#,    << qstat, pcb number >>                      03165000
    pcbs      =lsr(8)#,    << shift to get pcb number from ioq >>       03170000
    pdisable  = assemble( psdb )#,     << psuedo disable >>             03175000
    pe        =( 6:1)#,    <<uart parity error bit>>                    03180000
    penable   = assemble( pseb )#,     << pseudo enable >>              03185000
    preq      =(preq':1)#,                                              03190000
    ptychk    =( 9:1)#,                                                 03195000
    ptycntrl  =(ptycntrl':1)#,                                          03200000
    ptyon     =( 7:1)#,                                                 03205000
    ptyonodd  =( 7:2)#,    <<pty on flag; odd pty flag>>       <<00637>>03210000
    primed    =(primed':1)#,<< 2640 ready to send a block >>            03215000
    prempt    =( 0:1)#,   << set when premptive term request queue >>   03220000
    premptfield=( 7:2)#,   << terminal request prempt flags >>          03225000
    premptfld =(12:2)#,    << sio request premp flags >>                03230000
    qaborts  = (11:1)#,    << send abort request, dont set bits >>      03235000
    qldevn    =(8:8)#,     << logical device # field of i/o req >>      03240000
    rbyte     =(8:8)#,                                                  03245000
    rdcounted =( 8:1)#,    << rdcounter incremented >>                  03250000
    rdflush   =( 2:1)#,                                        <<01828>>03255000
    readtrlx  =( 8:8)#,    << trlx for read & logon time outs >>        03260000
    readstop  =( 7:3)#,    << if not zero then stop read because        03265000
                                 0 - none        4 - logon timed out    03270000
                                 1 - break       5 - aborted            03275000
                                 2 - prempt      6 - not used           03280000
                                 3 - timed out   7 - not used  >>       03285000
    readerrors=(10:3)#,    << 0-ok,1-specialstop,2-pty err              03290000
                              3-lost data,4-lost char,5-break >>        03295000
    restart   =(restart':1)#,                                           03300000
    restspd   =(10:1)#,                                                 03305000
    request   =(request':1)#,<< request for service while active >>     03310000
    rioa      =con %20302;con %13#,                            <<03018>>03315000
    rioc      =con %20302;con 2#,                              <<01301>>03320000
    rplevel   =(13:3)#,    << request prempt level,see lplevel  >>      03325000
    rstate    =(10:6)#,    << request state -                           03330000
                              0 - new       %30 - pre to post tbuf wait 03335000
                              1 - started   %31 - prespace tbuf wait    03340000
                              2 - reading    32 - wrt data tbuf wait    03345000
                             43 - rd cmpltd  33 - postspace tbuf wait   03350000
                             44 - rd stopped                            03355000
                              5 - read waiting                          03360000
                             %34-%37 same a %30-%33 but enq add wait    03365000
                           >>                                           03370000
    rtype     =(14:2)#,    << extract least bits of request type        03375000
                               0 - unblocked, no wake                   03380000
                               1 - blocked                              03385000
                               2 - unblocked, wake                      03390000
                               3 - unblocked, no pcb, no wake           03395000
                           >>                                           03400000
    runwait   =(0:1)#,     << run wait prog on this cont. >>   <<00.tp>>03405000
    sb        =( 6:1)#,                                                 03410000
    scp       =( 3:1)#,    << restart channel pgm on interrupt <<03068>>03415000
    send      =(send':1)#,                                              03420000
    scount    =( 8:8)#,    << sync's remaining to do after this  00.02>>03425000
    sfail     =(sfail':1)#,                                             03430000
    siohiop   =( 2:1)#,                                                 03435000
    sioprempt =( 6:1)#,    << set when a premtive request is queue >>   03440000
    siorun    =(6:1)#,   <<sio prog in running status>>                 03445000
    spdfound  = ( 9:1)#,   << on line or spd snse service reqst >>      03450000
    spdsensing=( 4:1)#,                                                 03455000
    spdsio    =( 2:1)#,                                                 03460000
    spec      =(spec':1)#,                                              03465000
    specflag  =(10:1)#,    << spec request flag, flags word, attachio >>03470000
    spoolend  =(spoolend':1)#,                                          03475000
    spooling  =(spooling':1)#,                                          03480000
    spoolsw   =(spoolsw' :1)#,                                          03485000
    sq        =(4:1)#,     << restart channel program queued >><<03669>>03490000
    ssbrqst   =(13:1)#,                                                 03495000
    ssbrkchar  =( 0:8)#,    << transparent read sub sys brk character >>03500000
    stackflag = ( 0:1)#,   << if set qaddr is db relative addr <<00.05>>03505000
    startsio  =asmb(con %20302;con 0)#,                                 03510000
    statef    =(12:4)#,    << sio device request state >>               03515000
    statdone  = (15:1)#,   << drqst, stat req complete >>      <<01475>>03520000
    statreq   = ditpl(dsave).(13:1)#, << stat req active >>    <<01475>>03525000
    status    =(13:3)#,    << qstat, general status >>                  03530000
    stopsio = asmb(con %20302; con 1)#,                        <<01475>>03535000
    strtwrt   =(14:1)#,                                                 03540000
    stwait    =(10:1)#,    << start wait prog (dit) >>   <<00.tp>>      03545000
    sync      =( 2:1)#,    << repeating sync's for fill chars >>        03550000
    syncstate =( 4:4)#,    << saved interrupt for syncs >>     <<02866>>03555000
    sysbufr   =(sysbufr':1)#,                                           03560000
    sysbufrs  =(12:1)#,    << address is sbuf relative >>               03565000
    tapemode  =(tapemode':1)#,                                          03570000
    tdflags   =( 0:2)#,    << term & disc flags in dflags >>            03575000
    termchar  =(termchar':1)#,                                          03580000
    termspeed =(10:6)#,   <<default speed>>                    <<04229>>03585000
    ttype     =( 5:5)#,    << terminal type as in mpe ers >>            03590000
    testbit   = assemble(tbc#,                                          03595000
    timing    = (0:1)#,    << a timed read is in progress >>            03600000
    timeread  =( 1:1)#,    << time read operations >>                   03605000
    tmode     =(11:2)#,    << terminal mode                             03610000
                                 0 - normal   2 - console               03615000
                                 1 - break    3 - console from break >> 03620000
    transerr  = (12:1)#,   << status from 2635x >>             <<01475>>03625000
    turnchar  =( 8:8)#,    << byte to be output when turned around >>   03630000
    turntowrite=( 7:1)#,   << if set, 202 turning to write else read >> 03635000
    up        =(up':1)#,   << unit is on line & speed sensed >>         03640000
    waitdone  =( 2:1)#,    << term band width wait completed >>         03645000
    waitedstate=(0:4)#,    << state waited for break >>                 03650000
    waitprog  =(1:1)#,     << wait prog is running (ilt) >>    <<00.tp>>03655000
    waitxon   =(10:1)#,    <<write halted to wait for xon>>    <<00487>>03660000
    wioa      =con %20302;con %14#,                            <<03018>>03665000
    wioc      =con %20302;con 3#,                              <<01301>>03670000
    wrtcounted=( 9:1)#,    << wrtcounter incremented >>                 03675000
    wrtwait   =( 6:1)#,    << waiting for a write cmpltion intrpt >>    03680000
    wrtenq    =( 0:1)#,                                                 03685000
    xchdb     = assemble( xchd )#,                                      03690000
    enddef    = 0#;                                                     03695000
$page                                                                   03700000
                                                                        03705000
  <<----------- general service variables ----------------->>           03710000
                                                                        03715000
                                                                        03720000
    logical sysup = db + %73;  << system up flag >>                     03725000
    integer array ditpa(*) = db+ iditp;   << base of ditp's in ilt >>   03730000
    integer array ilt(*) = db;                                          03735000
   array tds'db(*) = db; <<to access terminal data segment>>   <<03651>>03740000
    logical pointer  pcb = 3;   << process control block >>             03745000
                                                               <<06872>>03750000
                                                                        03755000
    integer pointer ps0 = s-0,  ps1 = s-1;                              03760000
    logical ls0 = s-0,  ls1 = s-1,  lx = x;                             03765000
    integer s0 = s-0, s1 = s-1, x = x;                                  03770000
                                                                        03775000
    integer array wa0(*) = db + 0;                                      03780000
    byte array ba0(*) = db + 0;  << to byte address dit and tbufs >>    03785000
                                                                        03790000
    integer rstatus = q -1;   << pcal return status >>                  03795000
                                                                        03800000
                                                               <<06872>>03805000
    double array lpdtd(@) = db + syslpdt;                               03810000
    integer array cst (@) = db + syscst;                                03815000
                                                               <<06872>>03820000
    integer array sbuf(@) = db + syssbuf;                               03825000
    integer array tbuf(@) = db + systbuf;                               03830000
    integer pointer dst   = %2;                                <<*7615>>03835000
    integer array inittcp(@) = db + sysinittcp;                <<01286>>03840000
    integer array siop(@) = db + sysinittcp;                   <<01286>>03845000
    << the sio program area for printchar and readchar is    >><<01286>>03850000
    << located 46 words before the inittcp area in bank 0.   >><<01286>>03855000
    << to save a sysglob cell, the sio area will be accessed >><<01286>>03860000
    << by using the pointer to inittcp(-46) or siop(siobase).>><<01286>>03865000
                                                                        03870000
    integer array busy(@) = db + %55;                                   03875000
    integer array head(@) = db + %56;                                   03880000
    integer array tail(@) = db + %57;                                   03885000
    integer siocount   = db + %60;  << # of sio programs in progress >> 03890000
    integer rdcounter  = db + %64; << # of terminal reads in progess >> 03895000
    integer wrtcounter = db + %65; << # of termnal writes in progress >>03900000
                                                                        03905000
    integer consldev   = db + %74;  << system console ldev >>           03910000
    integer powerfail  = db + %72;  << powerfail state >>               03915000
    integer progenpcbp = db + %141;  << progen pcb index >>             03920000
    integer devrecpcbp = db + %145;  << device recognition pcb index >> 03925000
    integer sysiopcbp  = db + %153; << system i/o process pbc index >>  03930000
    logical logontime  = db + %120; << max logon time in seconds >>     03935000
    logical avr        = db + %346; << auto tape vol. recog. word >>    03940000
                                                                        03945000
  <<-------------- monitoring declarations ---------------->>           03950000
                                                                        03955000
    integer dsetb = db + %66;                                           03960000
    double lasttimer = db + %67;                                        03965000
                                                                        03970000
                                                                        03975000
                                                                        03980000
  <<---------external procedure declarations ------------->>            03985000
                                                                        03990000
                                                                        03995000
procedure aborttimereq(trlx);                                           04000000
  value trlx;  integer trlx;   option forward;                          04005000
                                                                        04010000
procedure awake(pcbpt, n, waitf);                                       04015000
  value pcbpt, n, waitf;                                                04020000
  integer pcbpt, n, waitf;  option external;                            04025000
                                                               <<04318>>04030000
double procedure b08'logical'dvr(ldev, qmisc, dstx, addr,      <<04318>>04035000
                                 fnct, cnt, p1, p2, flags);    <<04318>>04040000
                                                               <<04318>>04045000
value                            ldev, qmisc, dstx, addr,      <<04318>>04050000
                                 fnct, cnt, p1, p2, flags;     <<04318>>04055000
                                                               <<04318>>04060000
integer                          ldev, qmisc, dstx, addr,      <<04318>>04065000
                                 fnct, cnt, p1, p2, flags;     <<04318>>04070000
                                                               <<04318>>04075000
option external;                                               <<04318>>04080000
                                                               <<04318>>04085000
                                                                        04090000
procedure chkchannelque(qn,ditp);                                       04095000
  value qn,ditp;   integer qn; pointer ditp;                            04100000
  option forward;                                                       04105000
                                                                        04110000
procedure clearwws;    option external;                                 04115000
                                                                        04120000
                                                                        04125000
procedure iofailure(drtn,ditp);                                         04130000
  value drtn;  integer drtn;                                            04135000
  array ditp;  option forward;                                          04140000
                                                                        04145000
integer procedure getsbuf(type);                                        04150000
  value type;  integer type;                                            04155000
  option forward;                                                       04160000
                                                                        04165000
procedure halt'hpib(ditp);                                     <<01301>>04170000
   integer array ditp;                                         <<tp.10>>04175000
   option uncallable,privileged,forward;                       <<tp.10>>04180000
                                                                        04185000
procedure help; option forward;                                         04190000
                                                                        04195000
integer procedure sysproc(lpin);                               <<01752>>04200000
value lpin;                                                    <<01752>>04205000
integer lpin;                                                  <<01752>>04210000
option external;                                               <<01752>>04215000
                                                               <<01752>>04220000
procedure idlewait (ditp);                                              04225000
  integer array ditp;                                                   04230000
  option external;                                             <<06872>>04235000
                                                                        04240000
procedure init'lynx'dev'(ditp, device'type);                   <<03028>>04245000
  value ditp,device'type;                                      <<03019>>04250000
  pointer ditp;                                                <<03019>>04255000
  logical device'type;                                         <<03019>>04260000
  option external;                                             <<03019>>04265000
                                                                        04270000
procedure iofreeze'(oldsegid);                                 <<06872>>04275000
value oldsegid;                                                <<06872>>04280000
double  oldsegid;                                              <<06872>>04285000
option external;                                               <<mpeiv>>04290000
                                                               <<mpeiv>>04295000
procedure iounfreeze'(oldsegid);                               <<06872>>04300000
value oldsegid;                                                <<06872>>04305000
double  oldsegid;                                              <<06872>>04310000
option external;                                               <<mpeiv>>04315000
                                                                        04320000
procedure ioimpede(tbase);                                              04325000
  value tbase;  integer tbase;                                          04330000
  option forward;                                                       04335000
                                                                        04340000
procedure iounimpede(tbase);                                            04345000
  value tbase;  integer tbase;                                          04350000
  option forward;                                                       04355000
                                                                        04360000
procedure impede(pcbpt);                                                04365000
  value pcbpt;  integer pcbpt;                                          04370000
  option external;                                                      04375000
                                                                        04380000
procedure logerror(a,b,c);                                              04385000
value a,b,c;                                                            04390000
integer b,c;                                                   <<06872>>04395000
integer pointer a;                                             <<06872>>04400000
option forward;                                                         04405000
                                                                        04410000
integer procedure getsystabentry(systabinx);                   <<mpeiv>>04415000
value systabinx;                                               <<mpeiv>>04420000
integer systabinx;                                             <<mpeiv>>04425000
option external;                                               <<mpeiv>>04430000
                                                               <<mpeiv>>04435000
procedure relsystabentry(systabinx,entrysysbaseinx);           <<mpeiv>>04440000
value systabinx,entrysysbaseinx;                               <<mpeiv>>04445000
integer systabinx,entrysysbaseinx;                             <<mpeiv>>04450000
option external;                                               <<mpeiv>>04455000
                                                               <<mpeiv>>04460000
procedure fetchioseg(oldsegid,ldev,ioreqsysbaseinx,flags);     <<06872>>04465000
value oldsegid,ldev,ioreqsysbaseinx,flags;                     <<06872>>04470000
integer ldev,ioreqsysbaseinx,flags;                            <<06872>>04475000
double oldsegid;                                               <<06872>>04480000
option external;                                                        04485000
                                                                        04490000
procedure crash'(why);                                         <<mpeiv>>04495000
value why;                                                     <<mpeiv>>04500000
integer why;                                                   <<mpeiv>>04505000
option external;                                               <<mpeiv>>04510000
                                                               <<mpeiv>>04515000
                                                               <<mpeiv>>04520000
procedure objwritecompletor(reqp);                             <<06872>>04525000
value reqp;                                                    <<mpeiv>>04530000
integer reqp;                                                  <<mpeiv>>04535000
option external;                                               <<mpeiv>>04540000
                                                               <<mpeiv>>04545000
procedure objreadcompletor(reqp);                              <<06872>>04550000
value reqp;                                                    <<mpeiv>>04555000
integer reqp;                                                  <<mpeiv>>04560000
option external;                                               <<mpeiv>>04565000
                                                               <<mpeiv>>04570000
procedure adjustlocality(procinx,oldsegid,reqsize,flags);      <<06872>>04575000
value procinx,oldsegid,reqsize,flags;                          <<06872>>04580000
logical procinx,reqsize,flags;                                 <<06872>>04585000
double oldsegid;                                               <<06872>>04590000
option external;                                               <<mpeiv>>04595000
                                                               <<mpeiv>>04600000
procedure queueonsegment(oldsegid);                            <<06872>>04605000
value oldsegid;                                                <<06872>>04610000
double  oldsegid;                                              <<06872>>04615000
option external;                                               <<mpeiv>>04620000
                                                               <<mpeiv>>04625000
procedure flagprocabsent(pin,oldsegid,specialinstr);           <<06872>>04630000
value pin,oldsegid,specialinstr;                               <<06872>>04635000
integer pin; double oldsegid;                                  <<06872>>04640000
logical specialinstr;                                          <<06872>>04645000
option external;                                               <<06872>>04650000
integer procedure serialwriteqmgr(discreqentryindex,           <<06872>>04655000
   controlcode,auxinfo);                                       <<06872>>04660000
value discreqentryindex,controlcode,auxinfo;                   <<06872>>04665000
integer discreqentryindex,controlcode,auxinfo;                 <<06872>>04670000
option forward;                                                <<06872>>04675000
                                                               <<06872>>04680000
logical procedure testiofrozen(oldsegid);                      <<06872>>04685000
value oldsegid;                                                <<06872>>04690000
double  oldsegid;                                              <<06872>>04695000
option external;                                               <<mpeiv>>04700000
                                                               <<mpeiv>>04705000
procedure addtolocality(sllheadinx,oldsegid,flags);            <<06872>>04710000
value sllheadinx,oldsegid,flags;                               <<06872>>04715000
integer sllheadinx,flags;                                      <<06872>>04720000
double oldsegid;                                               <<06872>>04725000
option external;                                               <<mpeiv>>04730000
                                                                        04735000
procedure mmstat'(e,p1,p2,p3,p4,p5,p6);                        <<06872>>04740000
value e,p1,p2,p3,p4,p5,p6;                                     <<06872>>04745000
integer e,p1,p2,p3,p4,p5,p6;                                   <<06872>>04750000
option external;                                               <<06872>>04755000
                                                               <<00.02>>04760000
procedure resetcritical(oldcrit);                                       04765000
  value oldcrit;  integer oldcrit;                                      04770000
  option external;                                                      04775000
                                                                        04780000
procedure resetdb(olddb);                                               04785000
  value olddb;  integer olddb;                                          04790000
  option external;                                                      04795000
                                                                        04800000
integer procedure get'dsdevice(ldev);                          <<04310>>04805000
  value ldev;                                                  <<04310>>04810000
  integer ldev;                                                <<04310>>04815000
  option external;                                             <<04310>>04820000
                                                               <<04310>>04825000
procedure returnsysbuf(index);                                          04830000
value index;                                                            04835000
integer index;                                                          04840000
option forward;                                                         04845000
                                                                        04850000
                                                                        04855000
procedure returndiscreq(pntr);                                 <<01637>>04860000
value pntr;                                                    <<01637>>04865000
integer pntr;                                                  <<06872>>04870000
option forward;                                                <<01637>>04875000
                                                               <<01637>>04880000
logical procedure read'device'reg(drt, reg'num);               <<03028>>04885000
value drt, reg'num;                                            <<03028>>04890000
logical drt, reg'num;                                          <<03028>>04895000
option external;                                               <<06872>>04900000
                                                               <<03028>>04905000
procedure write'device'reg(drt, reg'num, data'out);            <<03028>>04910000
value drt, reg'num, data'out;                                  <<03028>>04915000
logical drt, reg'num, data'out;                                <<03028>>04920000
option external;                                               <<06872>>04925000
                                                               <<03028>>04930000
logical procedure channel'id(ldev);                            <<03028>>04935000
value ldev;                                                    <<03028>>04940000
integer ldev;                                                  <<03028>>04945000
option external;                                               <<06872>>04950000
                                                                        04955000
                                                                        04960000
procedure addtail(new,linkindex,queuenumber);                           04965000
  value   linkindex, queuenumber;                                       04970000
  integer linkindex, queuenumber;                                       04975000
  integer array new;                                                    04980000
  option forward;                                                       04985000
                                                                        04990000
                                                                        04995000
procedure addhead(new,linkindex,queuenumber);                           05000000
  value   linkindex, queuenumber;                                       05005000
  integer linkindex, queuenumber;                                       05010000
  integer array new;                                                    05015000
  option forward;                                                       05020000
                                                                        05025000
                                                                        05030000
integer procedure dequeue(linkindex,queuenumber);                       05035000
  value linkindex, queuenumber;   integer linkindex, queuenumber;       05040000
  option forward;                                                       05045000
                                                                        05050000
procedure siodm(ditp,flags);                                   <<06872>>05055000
value ditp,flags;                                              <<06872>>05060000
integer pointer ditp;                                          <<06872>>05065000
logical flags;                                                 <<06872>>05070000
option forward;                                                <<06872>>05075000
                                                                        05080000
                                                                        05085000
                                                                        05090000
procedure siodm'request'done(q'entry'index,ifadisc);                    05095000
  value q'entry'index, ifadisc;                                         05100000
  integer q'entry'index;                                                05105000
  logical ifadisc;                                                      05110000
  option forward;                                                       05115000
                                                                        05120000
                                                                        05125000
integer procedure ldevtotype(ldev);                            <<03033>>05130000
value ldev;  integer ldev;                                     <<03033>>05135000
option forward;                                                <<03033>>05140000
                                                                        05145000
procedure checkldev(ldev);                                              05150000
  value ldev;  integer ldev;                                            05155000
  option forward;                                                       05160000
                                                                        05165000
                                                                        05170000
procedure awakeio( ditp,flags);                                         05175000
  value ditp, flags;                                                    05180000
  integer pointer ditp;  integer flags;                                 05185000
  option forward;                                                       05190000
                                                                        05195000
                                                                        05200000
procedure startio(ditp,siop,queue);                         <<01301>>   05205000
value queue;                                                            05210000
integer array ditp,siop;                                                05215000
logical queue;                                                          05220000
option forward;                                                         05225000
                                                                        05230000
                                                                        05235000
logical procedure setsysdb;  option external;                           05240000
                                                                        05245000
integer procedure setcritical;                                          05250000
  option external;                                                      05255000
                                                                        05260000
procedure suddendeath(n);                                               05265000
  value n;  integer n;                                                  05270000
  option forward;                                                       05275000
                                                                        05280000
double procedure timer;    option forward;                              05285000
                                                                        05290000
integer procedure timereq(code,req,time);                               05295000
  value code, req, time;                                                05300000
  integer code, req;   double time;                                     05305000
  option forward;                                                       05310000
                                                               <<06872>>05315000
procedure porttimeout(req);                                    <<06872>>05320000
  value req;                                                   <<06872>>05325000
  integer req;                                                 <<06872>>05330000
  option external;                                             <<06872>>05335000
                                                                        05340000
procedure unimpede(pcbpt);                                              05345000
  value pcbpt;  integer pcbpt;                                          05350000
  option external;                                                      05355000
                                                                        05360000
procedure wait(waitf,waittype);                                         05365000
  value waitf, waittype;                                                05370000
  integer waitf, waittype;                                              05375000
  option external;                                                      05380000
                                                                        05385000
                                                               <<04837>>05390000
procedure awaketerminal(ditp);                                 <<04837>>05395000
  integer array ditp;                                          <<04837>>05400000
  option external;                                             <<04837>>05405000
                                                               <<04837>>05410000
integer procedure readchar(waitms);                            <<04837>>05415000
  value waitms;  logical waitms;                               <<04837>>05420000
  option variable,external;                                    <<04837>>05425000
                                                               <<04837>>05430000
$page                                                          <<03019>>05435000
logical procedure printchar(char);                             <<03019>>05440000
  value char;integer char;                                              05445000
  option external;  <<  printchar in termres >>                <<04837>>05450000
                                                               <<03651>>05455000
logical procedure console'init;                                <<06872>>05460000
option external;                                               <<06872>>05465000
                                                               <<*7811>>05470000
logical procedure check'io'state(ditp);                        <<*7811>>05475000
   value ditp;                                                 <<*7811>>05480000
   integer ditp;                                               <<*7811>>05485000
   option external;                                            <<*7811>>05490000
                                                               <<*7811>>05495000
                                                               <<*7811>>05500000
integer procedure loadproc( procname, libsearch, plabel);      <<03651>>05505000
value libsearch;                                               <<03651>>05510000
integer libsearch, plabel;                                     <<03651>>05515000
byte array procname;                                           <<03651>>05520000
option external;                                               <<03651>>05525000
                                                               <<03651>>05530000
procedure unloadproc( procid);                                 <<06872>>05535000
value procid;                                                  <<03651>>05540000
integer procid;                                                <<03651>>05545000
option external;                                               <<03651>>05550000
                                                               <<03019>>05555000
procedure ldevonenotready(consldev);                           <<03651>>05560000
   value consldev;                                             <<03019>>05565000
   integer consldev;                                           <<03019>>05570000
   option external;                                            <<06872>>05575000
                                                               <<03019>>05580000
double procedure sdiscio(ldnum,qmisc,dstx,adr,fnct,            <<sd.00>>05585000
cnt,p1,p2,flags);                                              <<sd.00>>05590000
value ldnum,qmisc,dstx,adr,fnct,cnt,p1,p2,flags;               <<sd.00>>05595000
integer ldnum,qmisc,dstx,adr,fnct,cnt,p1,p2,flags;             <<sd.00>>05600000
option external;                                               <<sd.00>>05605000
                                                               <<sd.00>>05610000
integer procedure exchangedb(dst);                             <<sd.00>>05615000
value dst;                                                     <<sd.00>>05620000
integer dst;                                                   <<sd.00>>05625000
option external;                                               <<sd.00>>05630000
                                                               <<sd.00>>05635000
integer procedure getdrt(drt,offset);                          <<03018>>05640000
value drt,offset;                                              <<03018>>05645000
integer drt,offset;                                            <<03018>>05650000
option forward;                                                <<03018>>05655000
                                                               <<03018>>05660000
procedure putdrt(drt,offset,num);                              <<03018>>05665000
value drt,offset,num;                                          <<03018>>05670000
integer drt,offset,num;                                        <<03018>>05675000
option forward;                                                <<03018>>05680000
                                                               <<03018>>05685000
procedure sendmsg(destpin,destport,msglen,flags);              <<02804>>05690000
value destpin,destport,msglen,flags;                           <<02804>>05695000
integer destpin,destport,msglen;                               <<02804>>05700000
logical flags;                                                 <<02804>>05705000
option external;                                               <<02804>>05710000
                                                               <<02804>>05715000
procedure stoptimeout(type,ditp);                              <<03687>>05720000
value type;                                                    <<03687>>05725000
integer type;                                                  <<03687>>05730000
integer array ditp;                                            <<03687>>05735000
option external;                                               <<06872>>05740000
                                                               <<03687>>05745000
logical procedure iomessage(setno,msgno,mask,p1,p2,p3,p4,p5,   <<02804>>05750000
   dest,reply,offset,ditp,iotype);                             <<02804>>05755000
value setno,msgno,mask,p1,p2,p3,p4,p5,dest,reply,offset,ditp,  <<02804>>05760000
   iotype;                                                     <<02804>>05765000
integer setno,msgno,mask,p1,p2,p3,p4,p5,dest,reply,offset,     <<02804>>05770000
   iotype;                                                     <<02804>>05775000
integer pointer ditp;                                          <<02804>>05780000
option variable,forward;                                       <<02804>>05785000
                                                               <<02804>>05790000
procedure mpe'table'full(tabnum);                              <<02804>>05795000
value tabnum;  integer tabnum;                                 <<02804>>05800000
option forward;                                                <<02804>>05805000
                                                               <<06872>>05810000
$include inclcimp                                              <<06872>>05815000
                                                               <<02804>>05820000
$page                                                                   05825000
                                                                        05830000
                                                                        05835000
                                                                        05840000
                                                                        05845000
procedure write2(tc);                                                   05850000
  value tc;  integer tc;                                                05855000
    option privileged, uncallable;                                      05860000
  begin  << writes two characters to the mux >>                         05865000
    printchar(tc&lsr(8));                                               05870000
    printchar(tc);                                                      05875000
  end;  << write 2  >>                                                  05880000
$page                                                                   05885000
                                                                        05890000
procedure bconvert(bn);                                                 05895000
  value bn;  integer bn;                                                05900000
    option privileged, uncallable;                                      05905000
  begin  << converts and prints the binary number bn >>                 05910000
    tos := bn;                                                          05915000
    asmb(zero,zrox);                                                    05920000
    tos := tos&dlsr(2);  << get ready >>                                05925000
                                                                        05930000
    while x<6 do   << convert to ascii and print >>                     05935000
      begin                                                             05940000
        tos := tos&dcsl(3);  << get a digit >>                          05945000
        x := x+1;  << increment counter >>                              05950000
        printchar(s0.(13:3)+"0");                                       05955000
      end;                                                              05960000
                                                                        05965000
  end;  << b convert >>                                                 05970000
                                                                        05975000
procedure dconvert(n);                                                  05980000
  value n;  integer n;                                                  05985000
    option privileged, uncallable;                                      05990000
  << converts the number n to ascii decimal and outputs >>              05995000
  begin                                                                 06000000
    integer temp;                                                       06005000
                                                                        06010000
    tos := n;  tos := 1000;                                    <<sd.00>>06015000
    asmb(div , xch);                                                    06020000
    temp := tos;                                                        06025000
    if <> then printchar(temp+"0");                                     06030000
    tos := 100;  asmb( div, xch);                              <<sd.00>>06035000
    temp := tos;                                                        06040000
    if <> or n>99 then printchar(temp+"0");                             06045000
    tos := 10;  asmb( div, xch);                               <<sd.00>>06050000
    temp:=tos;                                                 <<sd.00>>06055000
    if <> or n>99 then printchar(temp+"0");                    <<sd.00>>06060000
    tos := tos + "0";                                                   06065000
    printchar( * );                                                     06070000
  end;   << d convert >>                                                06075000
                                                               <<tp.cr>>06080000
procedure init'hpib(channel);                                  <<01301>>06085000
value   channel;                                               <<01301>>06090000
integer channel;                                               <<01301>>06095000
option privileged, uncallable;                                 <<01301>>06100000
begin                                                          <<01301>>06105000
                                                                        06110000
<<                                                                      06115000
                                                                        06120000
    init'hpib is used by hp3000 series 33 i/o drivers                   06125000
to initialize a channel on the imb. the reason for this is              06130000
that the hp-ib drivers on the series ii/iii for the imb                 06135000
adapter must call procedures to perform hp-ib commands.                 06140000
                                                                        06145000
>>                                                                      06150000
                                                                        06155000
   tos := channel;     << channel number in bits 9,10,11,12 >> <<01301>>06160000
                       << if icf 55 then module number>>       <<03018>>06165000
                       << is in bits 7 and 8 >>                <<03018>>06170000
   assemble(init);     << initialize the channel >>            <<01301>>06175000
    tos := if = then cce                                       <<03687>>06180000
           else if < then ccl                                  <<03687>>06185000
           else ccg;                                           <<03687>>06190000
    rstatus.cc := tos;                                         <<03687>>06195000
                                                               <<03687>>06200000
end;                                                           <<01301>>06205000
                                                               <<01301>>06210000
$page                                                          <<01301>>06215000
                                                               <<01301>>06220000
integer procedure rioc'hpib(command,chandev);                  <<03018>>06225000
value   command,                                               <<03018>>06230000
        chandev;                                               <<03018>>06235000
integer command,                                               <<03018>>06240000
        chandev;                                               <<03018>>06245000
option privileged, uncallable;                                 <<01301>>06250000
begin                                                          <<01301>>06255000
                                                                        06260000
comment                                                        <<03018>>06265000
                                                                        06270000
    rioc'hpib is used by hp3000 series 33 i/o drivers                   06275000
to read an i/o channel on the imb. the reason for this is               06280000
that the hp-ib drivers on the series ii/iii for the imb                 06285000
adapter must call procedures to perform hp-ib commands.                 06290000
                                                                        06295000
    the form of the words command and chandev are as follows   <<03018>>06300000
command - bbbbrrrr00000000                                     <<03018>>06305000
chandev - 0000000mmccccddd                                     <<03018>>06310000
b=busop code                                                   <<03018>>06315000
r=register number                                              <<03018>>06320000
m=module  number  - note if cpu not icf 55 then mm=00          <<03018>>06325000
c=channel number                                               <<03018>>06330000
d=device number                                                <<03018>>06335000
                                                               <<03018>>06340000
if the cpu is not an icf 55 then command and chandev will be   <<03018>>06345000
combined into one word before the rioc instruction is executed <<03018>>06350000
if the cpu is an icf 55 then chandev and command are pushed on <<03018>>06355000
stack separately and the instruction rioa is used instead of   <<03018>>06360000
rioc.                                                          <<03018>>06365000
endcomment;                                                    <<03018>>06370000
                                                                        06375000
   asmb( pcn; stax);                                           <<c8291>>06380000
   if multi'imb &lsr(x) then                                   <<c8291>>06385000
      begin                                                    <<c8291>>06390000
     tos:=chandev;            << module, channel and device>>  <<03018>>06395000
     tos:=command;            << command and register number>> <<03018>>06400000
     asmb(rioa);              << read the i/o channel>>        <<03018>>06405000
   end else begin                                              <<03018>>06410000
     command.(7:9):=chandev.(7:9);                             <<03018>>06415000
     tos := command;          << imb read command >>           <<03018>>06420000
     assemble(rioc);          << read the i/o channel >>       <<03018>>06425000
   end;                                                        <<03018>>06430000
   if = then rioc'hpib := tos;                                 <<01301>>06435000
    tos := if = then cce                                       <<03687>>06440000
           else if < then ccl                                  <<03687>>06445000
           else ccg;                                           <<03687>>06450000
    rstatus.cc := tos;                                         <<03687>>06455000
                                                               <<03687>>06460000
end;                                                           <<01301>>06465000
                                                               <<01301>>06470000
$page                                                          <<01301>>06475000
                                                               <<01301>>06480000
procedure wioc'hpib(command,chandev,dataword);                 <<03018>>06485000
value   command,                                               <<01301>>06490000
        chandev,                                               <<03018>>06495000
        dataword;                                              <<01301>>06500000
integer command,                                               <<01301>>06505000
        chandev,                                               <<03018>>06510000
        dataword;                                              <<01301>>06515000
option privileged, uncallable;                                 <<01301>>06520000
begin                                                          <<01301>>06525000
                                                                        06530000
comment                                                        <<03018>>06535000
                                                                        06540000
    wioc'hpib is used by hp3000 series 33 i/o drivers                   06545000
to write to an i/o channel on the imb. the reason for this is           06550000
that the hp-ib drivers on the series ii/iii for the imb                 06555000
adapter must call procedures to perform hp-ib commands.                 06560000
                                                                        06565000
    the form of the words command and chandev are as follows   <<03018>>06570000
command - bbbbrrrr00000000                                     <<03018>>06575000
chandev - 0000000mmccccddd                                     <<03018>>06580000
b=busop code                                                   <<03018>>06585000
r=register number                                              <<03018>>06590000
m=module  number  - note if cpu not icf 55 then mm=00          <<03018>>06595000
c=channel number                                               <<03018>>06600000
d=device number                                                <<03018>>06605000
                                                               <<03018>>06610000
if the cpu is not an icf 55 then command and chandev will be   <<03018>>06615000
combined into one word before the wioc instruction is executed <<03018>>06620000
if the cpu is an icf 55 then chandev and command are pushed on <<03018>>06625000
stack separately and the instruction wioa is used instead of   <<03018>>06630000
wioc.                                                          <<03018>>06635000
endcomment;                                                    <<03018>>06640000
                                                                        06645000
    asmb( pcn; stax);                                          <<c8291>>06650000
   if multi'imb &lsr(x) then                                   <<c8291>>06655000
      begin                                                    <<c8291>>06660000
      tos:=chandev;            << module, channel and device>> <<03018>>06665000
      tos:=command;            << command and register number>><<03018>>06670000
      tos:=dataword;           << word to be written>>         <<03018>>06675000
      asmb(wioa);              << write to the i/o channel>>   <<03018>>06680000
    end else begin                                             <<03018>>06685000
      command.(9:7):=chandev.(9:7);                            <<03018>>06690000
      tos := command;          << imb write command >>         <<03018>>06695000
      tos := dataword;         << word to be written >>        <<03018>>06700000
      assemble(wioc);          << write to the i/o channel >>  <<03018>>06705000
    end;                                                       <<03018>>06710000
    tos := if = then cce                                       <<03687>>06715000
           else if < then ccl                                  <<03687>>06720000
           else ccg;                                           <<03687>>06725000
    rstatus.cc := tos;                                         <<03687>>06730000
                                                               <<03687>>06735000
end;                                                           <<01301>>06740000
$page                                                                   06745000
                                                                        06750000
procedure masterclearhpib(ditp);                               <<01301>>06755000
  integer array ditp;    option privileged, uncallable;                 06760000
  <<                                                                    06765000
     this procedure issues a masterclear followed by a clear interrupts 06770000
     order to the controller identified by ditp. the sio program flags  06775000
     and counters  are cleaned up as if and interrupt occured. >>       06780000
  begin                                                                 06785000
    integer pointer iltp=q+1;                                           06790000
 integer channel = iltp+1,                                     <<tp.10>>06795000
         save    = channel+1;                                           06800000
    entry masterclear;   << for compatability reasons >>       <<01301>>06805000
                                                               <<01301>>06810000
masterclear:                                                   <<01301>>06815000
   tos := ditp(diltp); << ilt pointer >>                                06820000
   tos := ps0(icntrl); << ilt controller word >>               <<00.tp>>06825000
   disable;                                                    <<tp.10>>06830000
    ditp.ioprog := 0;                                                   06835000
    if <> then   << sio program in progress >>                          06840000
      begin                                                             06845000
        halt'hpib(ditp);  << halt i/o program >>               <<01301>>06850000
        if <> then                                             <<tp.10>>06855000
          begin << program not in wait >>                      <<tp.10>>06860000
          iltp(iflag).ignorehi := 1; << ignore interrupt >>    <<tp.10>>06865000
          tos := ls0 land drtmask; << drt # >>                 <<03018>>06870000
          do until getdrt(s0,drt3)=0; <<word 3 of drt>>        <<03018>>06875000
          del;                                                 <<tp.10>>06880000
          end; << i/o program halted >>                        <<tp.10>>06885000
        asmb(test); << check for software channel >>                    06890000
        if < then chkchannelque(*,ditp);  << get next channel user >>   06895000
      end else                                                          06900000
      begin << i/o not started, check for channel waiting >>            06905000
          asmb(test);  << check for pending prog >>            <<00.tp>>06910000
         if < then                                                      06915000
         begin                                                          06920000
            tos := tos.chanque; << channel # >>                         06925000
            tos := dequeue(dlink,channel);                              06930000
            tos := s0; << save ditp for end test >>                     06935000
         if s0<>-1 then << dit list is non-empty >>            <<07355>>06940000
              while s0 <> @ditp do                                      06945000
              begin << this isn't the dit, keep looking >>              06950000
                 addtail(*,dlink,channel); << put back on list >>       06955000
                 tos := dequeue(dlink,channel); << get next dit >>      06960000
                 if s0 = save then                                      06965000
                 begin << end of list, dit is not in list >>            06970000
                    addtail(*,dlink,channel);                           06975000
                    return;                                             06980000
                 end;                                                   06985000
              end;                                                      06990000
         end;                                                           06995000
      end;                                                              07000000
  end;  << master clear >>                                              07005000
$page                                                                   07010000
$page                                                                   07015000
$page                                                                   07020000
                                                                        07025000
$include inclhard                                                       07030000
procedure halt'hpib(ditp);                                     <<01301>>07035000
   integer array ditp;                                         <<00.tp>>07040000
   option uncallable,privileged;                               <<00.tp>>07045000
begin                                                          <<00.tp>>07050000
logical pointer iltp = q+1;   << pointer to ilt >>             <<03073>>07055000
   entry haltio;    << for compatability reasons >>            <<01301>>07060000
                                                               <<01301>>07065000
haltio:                                                        <<01301>>07070000
                                                               <<00.tp>>07075000
   tos := ditp(diltp); << ilt pointer >>                       <<00.tp>>07080000
   tos := ps0(icntrl).drtnumber; <<drt number>>                <<03018>>07085000
                                                               <<03073>>07090000
   << we will reset the deferred siop bits in case a >>        <<03073>>07095000
   << deferred start'hpib was scheduled previously   >>        <<03073>>07100000
   iltp(iflag).scp := 0;                                       <<03073>>07105000
                                                               <<03073>>07110000
                                                               <<*8429>>07115000
   asmb( dup );       << save drt.  halt deletes it >>         <<*8429>>07120000
                                                               <<*8429>>07125000
   asmb(hiop);        << halt i/o instruction >>               <<00.tp>>07130000
   if = then tos := cce                                        <<tp.14>>07135000
     else if > then tos := ccg else begin                      <<tp.14>>07140000
                                    putdrt(s0,drt3,0);         <<03018>>07145000
                         <<put 0 in word 3 of drt>>            <<03018>>07150000
       << print non-responding device drt#n on console >>      <<03073>>07155000
       iomessage(1,non'resp'dev'msg,%10000,s0,,,,,opconsole);  <<03073>>07160000
                                    tos := ccl;                <<tp.14>>07165000
                                    end;                       <<tp.14>>07170000
   rstatus.cc := tos;                                          <<tp.14>>07175000
end;                                                           <<00.tp>>07180000
$page "STARTIO     I/O PROGRAM ROUTINE"                                 07185000
procedure startio(ditp,siop,queue);                                     07190000
value queue;                                                            07195000
integer array ditp,siop;                                                07200000
logical queue;                                                          07205000
option privileged,uncallable;                                           07210000
begin                                                                   07215000
integer pointer                                                <<00.tp>>07220000
   iltp        = q+1;                                          <<00.tp>>07225000
integer                                                        <<00.tp>>07230000
   control     = iltp+1,                                       <<00.tp>>07235000
   channel     = control+1;                                    <<00.tp>>07240000
                                                               <<03088>>07245000
<<*************** returned condtion codes *******************>><<03088>>07250000
<<  cce - siop was successfully issued                       >><<03088>>07255000
<<  ccg - failed to issue siop (non-resp drt)                >><<03088>>07260000
<<  ccl - siop deferred due to queuing on software channel   >><<03088>>07265000
<<***********************************************************>><<03088>>07270000
                                                               <<03088>>07275000
entry  start'hpib;  << hpib drivers call this >>                        07280000
                                                               <<00.tp>>07285000
                                                               <<00.tp>>07290000
start'hpib:                                                             07295000
   tos := ditp(diltp);   << iltp >>                            <<00.tp>>07300000
   tos := iltp(icntrl); << control >>                          <<00.tp>>07305000
   tos := s0.chanque;   << channel >>                          <<00.tp>>07310000
                                                               <<03068>>07315000
   << if this is a restart of a channel program due to >>      <<03068>>07320000
   << a wait for hiop to complete, bypass queuing code >>      <<03068>>07325000
   iltp(iflag).scp := 0;                                       <<03068>>07330000
   if = then                                                   <<03068>>07335000
   if queue then << normal program start >>                    <<00.tp>>07340000
   if logical(control)&csl(1) then                             <<00.tp>>07345000
   begin << multi-controller channel resource >>               <<00.tp>>07350000
      disable;                                                 <<00.tp>>07355000
      if busy(channel) <> 0 then                               <<00.tp>>07360000
      begin                                                    <<00.tp>>07365000
         addtail(ditp,dlink,channel);                          <<00.tp>>07370000
                                                               <<03088>>07375000
         << save siop start address in ilt >>                  <<03088>>07380000
         iltp(icpgm) := @siop;                                 <<03088>>07385000
                                                               <<03088>>07390000
         << turn off iak bit in dit so siodm will not >>       <<03088>>07395000
         << fire-off i/o again.                       >>       <<03088>>07400000
         ditp.iak := 0;                                        <<03088>>07405000
                                                               <<03088>>07410000
         enable;                                               <<00.tp>>07415000
         tos := ccl;                                           <<00.tp>>07420000
         go out;                                               <<00.tp>>07425000
      end;                                                     <<00.tp>>07430000
      busy(channel) := @ditp;                                  <<00.tp>>07435000
      enable;                                                  <<00.tp>>07440000
   end;                                                        <<00.tp>>07445000
                                                               <<03068>>07450000
   disable;                                                    <<tp.10>>07455000
   ditp.iak := 0;  << turn off interrupt ack >>                <<03088>>07460000
   halt'hpib(ditp); << halt current program >>                 <<01301>>07465000
   if > then                                                   <<tp.10>>07470000
     begin                                                     <<tp.10>>07475000
     << wait for hiop interrupt & restart from gip >>          <<03068>>07480000
     tos := iltp(iflag);                                       <<03068>>07485000
     tos.scp := 1;          << turn on start chanp flag >>     <<03068>>07490000
     << if queued, we must set flag to start deferred siop >>  <<03669>>07495000
     << as queued.                                         >>  <<03669>>07500000
     tos.sq := if queue then 1 else 0;                         <<03669>>07505000
     tos.ignorehi := 1;     << tell gip to ignore hiop int >>  <<03068>>07510000
     iltp(x) := tos;                                           <<03068>>07515000
     iltp(icdp) := @ditp;                                      <<03068>>07520000
     iltp(icpgm ) := @siop;                                    <<03068>>07525000
     tos := cce;    << tell driver all went ok >>              <<03068>>07530000
     go to out;                                                <<03068>>07535000
                                                               <<03068>>07540000
     end;                                                      <<tp.10>>07545000
   <<  there used to be an enable  >>                                   07550000
   << need to check results after timeout >>                   <<00.tp>>07555000
   tos := control.drtnumber; << drt number >>                  <<03018>>07560000
                                                               <<03687>>07565000
   << clear any pending interrupts >>                          <<03687>>07570000
   asmb(dup,stax);  << put copy of drt in x-register >>        <<03687>>07575000
   tos := %006000;  << write register "C" on gig     >>        <<03687>>07580000
   tos := x;        << imb, channel, & (device)      >>        <<03687>>07585000
   tos := logical(x) land %7;                                  <<03687>>07590000
   wioc'hpib(*,*,*);                                           <<03687>>07595000
   if < then                                                   <<03687>>07600000
     go to io'failure;                                         <<03687>>07605000
                                                               <<03687>>07610000
   tos := @siop + sysdb;                                       <<00.tp>>07615000
                                                               <<03662>>07620000
  << log siop event in mmstat table                   >>       <<06872>>07625000
  << word 0 - mmstat event 193: start channel program >>       <<06872>>07630000
  <<      1 - ldev                                    >>       <<06872>>07635000
  <<      2 - drt number                   >>                  <<06872>>07640000
  <<      3 - siop address                 >>                  <<06872>>07645000
  <<      4 - q'entry'index from dit       >>                  <<06872>>07650000
  <<      5 - dit  word  0:   flags word   >>                  <<06872>>07655000
  <<      6 - lsw of timer                 >>                  <<06872>>07660000
  asmb(ddup);   << duplicate drt & siop address >>             <<06872>>07665000
  tos := 193;   << event number                 >>             <<06872>>07670000
  asmb(cab,cab);<< put in the right order       >>             <<06872>>07675000
  tos := ditp(dldev); asmb(cab);                               <<06872>>07680000
  tos := logical(ditp(dioqp))  lor  queue&lsl(15);             <<06872>>07685000
  tos := ditp;                                                 <<06872>>07690000
  tos := timer;                                                <<06872>>07695000
  asmb(delb);   << remove high-order word of timer >>          <<06872>>07700000
  mmstat'(*,*,*,*,*,*,*);                                      <<06872>>07705000
                                                               <<03068>>07710000
                                                               <<03088>>07715000
   startsio;           << start i/o instruction >>             <<00.tp>>07720000
   if = then                                                   <<00.tp>>07725000
   begin << program started >>                                 <<00.tp>>07730000
      if queue then                                            <<00.tp>>07735000
      begin                                                    <<00.tp>>07740000
         ditp.ioprog := 1; << set i/o program in progress >>   <<00.tp>>07745000
         iltp(iflag).waitprog := 0; << clear wait prog flag >> <<00.tp>>07750000
         tos := @ditp;                                         <<00.tp>>07755000
      end else                                                 <<00.tp>>07760000
      begin                                                    <<00.tp>>07765000
         iltp(iflag).waitprog := 1; << wait program started >> <<00.tp>>07770000
         tos := 0;                                             <<00.tp>>07775000
      end;                                                     <<00.tp>>07780000
      iltp(icdp) := tos; << set current dit pointer in ilt >>  <<00.tp>>07785000
      tos := cce;                                              <<00.tp>>07790000
out:                                                                    07795000
      rstatus.cc := tos;                                                07800000
      return;                                                           07805000
   end;                                                                 07810000
                                                                        07815000
   if < then                                                   <<tp.cr>>07820000
     begin << bad drt, return i/o failure >>                   <<tp.cr>>07825000
io'failure:                                                    <<03687>>07830000
     putdrt(control.drtnumber,drt3,0);                         <<03018>>07835000
                    << clear last word of drt >>               <<03018>>07840000
     << print non-responding device drt#n on console >>        <<03073>>07845000
     iomessage(1,non'resp'dev'msg,%10000,control.drtnumber,,,,,<<03073>>07850000
               opconsole);                                     <<03073>>07855000
     tos := ccg;                                               <<tp.cr>>07860000
     go out;                                                   <<tp.cr>>07865000
     end;                                                      <<tp.cr>>07870000
                                                                        07875000
   if queue and logical(control)&csl(1) then                   <<00.tp>>07880000
   chkchannelque(control,ditp);                                <<00.tp>>07885000
   tos := ccg;                                                          07890000
   go to out;                                                           07895000
end;                                                                    07900000
$page "GIP  -  GENERAL INTERRUPT PROCESSOR"                             07905000
procedure gip'hpib;                                            <<01301>>07910000
option privileged,uncallable;                                           07915000
begin                                                                   07920000
integer                                                                 07925000
   cdp         = db+icdp,                                      <<00.tp>>07930000
   cpva0       = db+icpva0,                                    <<00.tp>>07935000
   drtn        = q+3,                                                   07940000
   flag        = db+iflag,                                     <<00.tp>>07945000
   stap        = db+istap,                                     <<00.tp>>07950000
   unit        = db+iunit;                                     <<00.tp>>07955000
integer pointer                                                         07960000
   ditp        = drtn+1,                                       <<03018>>07965000
   iltp        = ditp+1;                                       <<00.tp>>07970000
logical                                                        <<tp.cr>>07975000
   aborted     = iltp+1;                                       <<tp.cr>>07980000
integer                                                        <<03018>>07985000
   i            = aborted+1,                                   <<03018>>07990000
   temp         = i+1,                                         <<03018>>07995000
   cpunum       = temp+1;                                      <<03018>>08000000
logical array                                                  <<03018>>08005000
   newmask(*)  =cpunum+1,                                      <<03018>>08010000
   oldmask(*)   =newmask+4;                                    <<03018>>08015000
logical pointer                                                         08020000
   ditpl       = ditp;                                                  08025000
logical array lmask(0:15) = pb :=     0,%100000,%140000,       <<03018>>08030000
%160000,%170000,%174000,%176000,%177000,%177400,%177600,       <<03018>>08035000
%177700,%177740,%177760,%177770,%177774,%177776;               <<03018>>08040000
entry gip;     << for compatability reasons >>                 <<01301>>08045000
                                                               <<03068>>08050000
<< subroutine to set sysdb and log event in mmstat >>          <<03068>>08055000
subroutine setdb'log;                                          <<03068>>08060000
begin                                                          <<03068>>08065000
                                                               <<03068>>08070000
<< set sysdb >>                                                <<03068>>08075000
tos := 0;                                                      <<03068>>08080000
tos := sysdb;                                                  <<03068>>08085000
asmb(xchd);                                                    <<03068>>08090000
ddel;                                                          <<03068>>08095000
                                                               <<03068>>08100000
<< log event to mmstat >>                                      <<06872>>08105000
  << word 0 - mmstat event 192:  i/o  interrupt  >>            <<06872>>08110000
  <<      1 - ldev                               >>            <<06872>>08115000
  <<      2 - queue entry index            >>                  <<06872>>08120000
  <<      3 - dit  word 0:  dit flags word >>                  <<06872>>08125000
  <<      4 - channel program inst. pointer >>                 <<06872>>08130000
  <<      5 - controller status            >>                  <<06872>>08135000
  <<      6 - lsw of timer                 >>                  <<06872>>08140000
tos := x;    << save x register >>                             <<06872>>08145000
tos := 192;                                                    <<06872>>08150000
tos := ditp(dldev);          << ldev >>                        <<06872>>08155000
tos := ditp(dioqp);          << ioq pointer >>                 <<06872>>08160000
tos := ditp;   << first word of dit >>                         <<06872>>08165000
tos := getdrt(drtn,0)-sysdb-iltp(isiop); << @ siop rel >>      <<06872>>08170000
tos := wa0(iltp(istap ));  << save controller status >>        <<06872>>08175000
tos := timer;                                                  <<06872>>08180000
asmb(delb);                << lsw of timer >>                  <<06872>>08185000
                                                               <<06872>>08190000
mmstat'(*,*,*,*,*,*,*);                                        <<06872>>08195000
                                                               <<03068>>08200000
x := tos;  << restore x register >>                            <<03068>>08205000
end;                                                           <<03068>>08210000
                                                                        08215000
gip:                                                           <<01301>>08220000
   push(db);                                                   <<00.tp>>08225000
   tos := tos - %1000; << iltp >>                              <<00.tp>>08230000
   tos := false; << aborted set to false >>                    <<tp.cr>>08235000
   asmb(adds 11);  <<leave space for i,temp,cpunum&maskarrays>><<03018>>08240000
   asmb(pcn);                                                  <<03018>>08245000
   cpunum:=tos;                                                <<03018>>08250000
   if multi'imb &lsr(cpunum) then                              <<c8291>>08255000
    begin                                                      <<03018>>08260000
      asmb(rmsk);                                              <<03018>>08265000
      oldmask(0):=tos; << most significant part of mask>>      <<03018>>08270000
      oldmask(1):=tos;                                         <<03018>>08275000
      oldmask(2):=tos;                                         <<03018>>08280000
      oldmask(3):=tos; <<leastsignificant part of mask>>       <<03018>>08285000
      temp:=drtn&lsr(3); <<ioa and channel #>>                 <<03018>>08290000
      i:=0;                                                    <<03018>>08295000
      while temp>15 do                                         <<03018>>08300000
      begin                                                    <<03018>>08305000
         newmask(i):=%177777;                                  <<03018>>08310000
         i:=i+1;                                               <<03018>>08315000
         temp:=temp-16;                                        <<03018>>08320000
      end;                                                     <<03018>>08325000
      newmask(i):=lmask(temp);                                 <<03018>>08330000
      i:=i+1;                                                  <<03018>>08335000
      while i<4 do                                             <<03018>>08340000
      begin                                                    <<03018>>08345000
         newmask(i):=0;                                        <<03018>>08350000
         i:=i+1;                                               <<03018>>08355000
      end;                                                     <<03018>>08360000
      i:=3;                                                    <<03018>>08365000
      while i>=0 do                                            <<03018>>08370000
      begin                                                    <<03018>>08375000
         tos:=newmask(i) land oldmask(i);                      <<03018>>08380000
         i:=i-1;                                               <<03018>>08385000
      end;                                                     <<03018>>08390000
      asmb(smsk);                                              <<03018>>08395000
      if <> then suddendeath(205);<<if smsk fails, we're sunk>><<03762>>08400000
    end                                                        <<03018>>08405000
   else                                                        <<03018>>08410000
    begin                                                      <<03018>>08415000
      asmb(rmsk);                                              <<03018>>08420000
      oldmask:=tos;                                            <<03018>>08425000
      x := drtn&lsr(3);     << drt number >>                   <<03018>>08430000
      tos := oldmask land lmask(x);                            <<03018>>08435000
      asmb(smsk);           << disable lower priority interrupt<<03018>>08440000
      if <> then suddendeath(205);<<if smsk fails, we're sunk>><<03762>>08445000
    end;                                                       <<03018>>08450000
   enable;                                                              08455000
   flag.ignorehi := 0;                                         <<tp.10>>08460000
   << if we expected hiop interrupt, we must check to >>       <<03068>>08465000
   << see if we should attempt to restart the channel >>       <<03068>>08470000
   << program for this device.                        >>       <<03068>>08475000
   if <> then                                                  <<03068>>08480000
     begin                                                     <<03068>>08485000
                                                               <<03068>>08490000
     << set to sysdb and log to mmstat >>                      <<03068>>08495000
     @ditp := cdp;   << set dit pointer to current ditp >>     <<03068>>08500000
     setdb'log;                                                <<03068>>08505000
                                                               <<03068>>08510000
     << check to see if channel program should be restarted >> <<03068>>08515000
     if iltp(iflag).scp = 1 then                               <<03068>>08520000
       begin                                                   <<03068>>08525000
       iltp<<(icpva0)>> := 0; << zero hiop status >>           <<03068>>08530000
       tos := @ditp;   << dit to fire i/o against >>           <<03068>>08535000
       tos := iltp(icpgm); << channel pgm start adr >>         <<03068>>08540000
       iltp(x) := 0;   << zero out start address  >>           <<03068>>08545000
       start'hpib(*,*,if iltp(iflag).sq = 1 then true          <<03669>>08550000
                                            else false);       <<03669>>08555000
       end;                                                    <<03068>>08560000
                                                               <<03068>>08565000
     go to leave;                                              <<03068>>08570000
                                                               <<03068>>08575000
     end;                                                      <<03068>>08580000
                                                               <<03068>>08585000
   if cdp = 0 then                                             <<00.tp>>08590000
     begin << wait program completion >>                       <<tp.cr>>08595000
     flag.waitprog := 0; << reset indicator >>                 <<tp.cr>>08600000
     if cpva0 <> 0 and unit <> 0 then                          <<tp.cr>>08605000
      << channel failure on multi-unit wait program >>         <<tp.cr>>08610000
       begin << idle channel program aborted >>                <<tp.cr>>08615000
restartidlep:                                                           08620000
       aborted := true;                                        <<tp.cr>>08625000
                                                               <<03073>>08630000
       << unit 0 may not be configured for this controller, so <<03073>>08635000
       << we must use the highest-configured unit for the idle <<03073>>08640000
       @ditp := ditpa(flag.hcunit);                            <<03073>>08645000
                                                               <<03073>>08650000
       cpva0 := 0;                                             <<tp.cr>>08655000
       end                                                     <<tp.cr>>08660000
     else                                                      <<tp.cr>>08665000
       begin << get unit number from status area >>            <<tp.cr>>08670000
       tos := wa0(stap-@iltp); << get controller status >>     <<tp.cr>>08675000
       wa0(x) := 0;    << zero out status word-disc dvr >>     <<03687>>08680000
       tos := unit; << extract instruction >>                  <<tp.cr>>08685000
       if <> then asmb(xch; xeq 1); << isolate unit mun >>     <<tp.cr>>08690000
      asmb(delb,dup); << delete unit extract instr >>                   08695000
       << check and see if unit is configured >>               <<03662>>08700000
       x := tos;     << store unit number in index register >> <<03662>>08705000
       @ditp := ditpa(x);   << get dit pointer >>              <<03662>>08710000
    if                                                         <<07355>>08715000
          tos > flag.hcunit then << beyond highest unit conf.>><<03662>>08720000
         begin   << print out message >>                       <<03662>>08725000
         << set sysdb >>                                       <<03662>>08730000
         tos := 0;                                             <<03662>>08735000
         tos := sysdb;                                         <<03662>>08740000
         asmb(xchd);                                           <<03662>>08745000
         << print message >>                                   <<03662>>08750000
         iomessage(1,unknown'int'msg,%10000,drtn,,,,,          <<03662>>08755000
                   opconsole);                                 <<03662>>08760000
         << put back db >>                                     <<03662>>08765000
         asmb(xchd;ddel);                                      <<03662>>08770000
         go to restartidlep;                                   <<03662>>08775000
         end;                                                  <<03662>>08780000
       end;                                                    <<tp.cr>>08785000
     end                                                       <<tp.cr>>08790000
   else @ditp := cdp; << use current dit pointer >>            <<tp.cr>>08795000
setdb'log;                                                     <<03068>>08800000
   tos := ditp;                                                <<00.tp>>08805000
   tos.iak := 1;                                               <<00.tp>>08810000
   tos.ioprog := 0;                                            <<00.tp>>08815000
   ditp := tos; << acknowledge interrupt >>                    <<00.tp>>08820000
   if iltp(icdp) = 0 then                                               08825000
     begin << wait program, check devrec >>                    <<tp.cr>>08830000
     if ditp.statef = 0 and not aborted then ditp.statef := 6; <<tp.cr>>08835000
     end                                                       <<tp.cr>>08840000
   else                                                        <<tp.cr>>08845000
     begin                                                     <<tp.cr>>08850000
     x := iltp(icntrl);  << channel resource ? >>              <<tp.cr>>08855000
     if < then chkchannelque(x,ditp);                          <<tp.cr>>08860000
     end;                                                      <<tp.cr>>08865000
   awakeio(ditp,noimpede);  << call monitor for interrupting device >>  08870000
leave:                                                                  08875000
   disable;                                                    <<01868>>08880000
   if multi'imb &lsr(cpunum) then                              <<c8291>>08885000
    begin                                                      <<03018>>08890000
      i:=3;                                                    <<03018>>08895000
      while i>=0 do                                            <<03018>>08900000
      begin                                                    <<03018>>08905000
         tos:=oldmask(i);                                      <<03018>>08910000
         i:=i-1;                                               <<03018>>08915000
      end;                                                     <<03018>>08920000
      asmb(smsk);                                              <<03018>>08925000
      if <> then suddendeath(205);<<if smsk fails, we're sunk>><<03762>>08930000
    end                                                        <<03018>>08935000
   else                                                        <<03018>>08940000
    begin                                                      <<03018>>08945000
      tos := oldmask;                                          <<03018>>08950000
      asmb( smsk );  << reset interrupt mask >>                <<03018>>08955000
      if <> then suddendeath(205);<<if smsk fails, we're sunk>><<03762>>08960000
    end;                                                       <<03018>>08965000
   asmb( ixit );                                                        08970000
end;                                                                    08975000
$page "COMMUNICATIONS PROCEDURES"                                       08980000
$page                                                                   08985000
<< procedure ldevnotrdy re-written & moved to inclhard >>      <<03687>>08990000
$page "MEASUREMENT PROCEDURES"                                          08995000
                                                                        09000000
procedure initio (flag);                                       <<00.05>>09005000
   value   flag;                                               <<00.05>>09010000
   logical flag;                                               <<00.05>>09015000
   option  privileged,uncallable;                              <<00.05>>09020000
   << initialise the i/o system. called by progen as soon  >>  <<00.05>>09025000
   << as it takes control in two phases                    >>  <<00.05>>09030000
   << flag = 2 ==> init system disc  >>                        <<mpeiv>>09035000
   << flag = 1 ==> init console and system volumes>>           <<mpeiv>>09040000
   << flag = 0 ==> initialize everything else >>               <<mpeiv>>09045000
   begin                                                       <<00.05>>09050000
   integer i,speed,type,console,j,temp;                        <<03018>>09055000
   logical array mask(0:3) = q; <<must be q relative/direct>>  <<c8291>>09060000
integer procid, plabel;                                        <<03651>>09065000
byte array lynx'genesis(0:9) = q;<<must be q relative/direct>> <<03651>>09070000
   equate sysdisc = 1;                                         <<00.05>>09075000
   equate dlast   = 23; << dit index to speed code and term type >>     09080000
   define termtype = (0:7)#,                                   <<00.05>>09085000
          speedcf  = (10:6)#;  << speed code field of dlast >> <<07355>>09090000
                                                               <<07355>>09095000
   integer consol = db+%74;                                    <<00.05>>09100000
   integer pointer ditp;                                       <<00.05>>09105000
   integer pointer dltp,iltp;                                  <<00.05>>09110000
   integer array speedcode(4:15) = pb :=                                09115000
      14,20,60,240,960,480,180,120,240,30,15,10;                        09120000
     integer lpdt'index;                                       <<06872>>09125000
                                                               <<00.05>>09130000
   subroutine initdev;                                         <<00.05>>09135000
      begin                                                    <<00.05>>09140000
        lpdt'index := i * integer(lpdt'entry'size);           <<<06872>>09145000
       @ditp := lpdt'dit'ptr;                                  <<06872>>09150000
      if not lpdt'virtual'device and @ditp <> 0 then           <<*7984>>09155000
         begin  <<real device>>                                <<00.05>>09160000
         tos := @ditp;                                         <<00.05>>09165000
         @dltp := ditp(ddltp);                                 <<00.05>>09170000
         @iltp := ditp(diltp);                                          09175000
         tos := dltp(7);                                       <<00.05>>09180000
         if <> then assemble(pcal 0) else ddel;                <<00.05>>09185000
         asmb( pcn; stax);                                     <<c8291>>09190000
         if multi'imb &lsr(x) then                             <<c8291>>09195000
            begin                                              <<c8291>>09200000
            j:=0;                                              <<03018>>09205000
            while j<=3 do begin                                <<03018>>09210000
               mask(j):=abs(imask55+j);                        <<03018>>09215000
               j:=j+1;                                         <<03018>>09220000
            end;                                               <<03018>>09225000
            tos:=iltp(icntrl).drtnumber;  <<drtn>>             <<03018>>09230000
            temp:=tos&lsr(3);  <<ioa and channel>>             <<03018>>09235000
            j:=temp.(10:2); <<imb #>>                          <<03018>>09240000
            tos:=mask(j);                                      <<03018>>09245000
            x:=temp.(12:4); <<channel #>>                      <<03018>>09250000
            asmb(tsbc 0,x);                                    <<03018>>09255000
            mask(j):=tos;                                      <<03018>>09260000
            j:=3;                                              <<03018>>09265000
            while j>=0 do                                      <<03018>>09270000
            begin                                              <<03018>>09275000
               tos:=mask(j);                                   <<03018>>09280000
               j:=j-1;                                         <<03018>>09285000
            end;                                               <<03018>>09290000
            asmb(smsk);                                        <<03018>>09295000
            if <> then suddendeath(205);                       <<03762>>09300000
                                  <<if smsk fails, we're sunk>><<03762>>09305000
         end else   <<now for non icf 55>>                     <<03018>>09310000
         begin                                                 <<03018>>09315000
               tos := absolute(imask); <<interrupt mask word>> <<03018>>09320000
               tos := iltp(icntrl).drtnumber;   << drtn  >>    <<03018>>09325000
               x := tos&lsr(3);    <<channel #>>               <<03018>>09330000
               asmb(tsbc 0,x);     <<set bit in mask word>>    <<03018>>09335000
               asmb(smsk);<<enable interupts for this device >><<03018>>09340000
               if <> then suddendeath(205);                    <<03762>>09345000
                                  <<if smsk fails, we're sunk>><<03762>>09350000
         end;                                                  <<03018>>09355000
         end;                                                           09360000
      end;                                                     <<00.05>>09365000
                                                               <<06872>>09370000
   if flag=2 then                                              <<mpeiv>>09375000
                                                               <<06872>>09380000
      begin  <<just initailize the system disc>>               <<mpeiv>>09385000
            i := 1;                                            <<02628>>09390000
            do                                                 <<02628>>09395000
            begin <<   initialize all discs   >>               <<02628>>09400000
               checkldev(i);                                   <<02628>>09405000
               if = and carry then                             <<02628>>09410000
               begin << it's a disc >>                         <<02628>>09415000
                initdev;  << init all disc:  may have v. m. >> <<02628>>09420000
               end;                                            <<02628>>09425000
        end until(i := i + 1) > integer(lpdt'max'entries);     <<06872>>09430000
      end                                                      <<mpeiv>>09435000
   else                                                        <<mpeiv>>09440000
      begin  <<initialize system console or other devices>>    <<mpeiv>>09445000
   setsysdb;                                                   <<00.05>>09450000
   console := consol;                                          <<07355>>09455000
      if flag = 1 then                                         <<mpeiv>>09460000
         begin  <<initialize system volumes and console>>      <<mpeiv>>09465000
      i := console;                                            <<00.05>>09470000
      initdev;                                                 <<00.05>>09475000
      console'init;                                            <<06872>>09480000
                                                               <<*8097>>09485000
      end                                                      <<00.05>>09490000
   else                                                        <<00.05>>09495000
      begin  <<init all other devices>>                        <<00.05>>09500000
       i := lpdt'max'entries;                                  <<06872>>09505000
      do                                                       <<00.05>>09510000
         if i<>console and i<>sysdisc then initdev             <<00.05>>09515000
      until (i := i-1) = 0;                                    <<00.05>>09520000
      end;                                                     <<00.05>>09525000
   resetdb(-1);                                                <<00.05>>09530000
      end;                                                     <<mpeiv>>09535000
   end;  <<initio>>                                            <<00.05>>09540000
 double procedure timer;                                       <<01431>>09545000
 option privileged;                                            <<01431>>09550000
                                                               <<01431>>09555000
 comment:  returns a unsigned, 31 bits double word.            <<01431>>09560000
                                                               <<01431>>09565000
           this quantity represents the number of              <<01431>>09570000
           milliseconds since the midnight preceeding          <<01431>>09575000
           the last system cold load.  this quantity           <<01431>>09580000
           will be reset to zero on 24-day intervals           <<01431>>09585000
           at exactly 12 o'clock midnight.  detection          <<01431>>09590000
           and correction of this case between two             <<01431>>09595000
           calls to timer (less than 24 days apart)            <<01431>>09600000
           can be done as follows:                             <<01431>>09605000
                                                               <<01431>>09610000
           if the current returned timer value is equal        <<01431>>09615000
           or smaller than last timer value, add               <<01431>>09620000
           2073600000 (the number of ms in 24 days) to         <<01431>>09625000
           the result.                                         <<01431>>09630000
                                                               <<01431>>09635000
 note:     the millisecond count since the midnight            <<01431>>09640000
           preceeding cold load is computed in number          <<01431>>09645000
           of clock ticks by adding the count register         <<01431>>09650000
           of the system clock with the overflow counter       <<01431>>09655000
           (trl(5) and trl(6)).  the procedure tick will       <<01431>>09660000
           reset the count in trl every twenty four hours      <<01431>>09665000
           and the number of days since cold load is stored    <<01431>>09670000
           in trl(3).  trl(3) is reseted every 24 days and     <<01431>>09675000
           the base julian date is updated accordingly.        <<01431>>09680000
 ;                                                             <<01431>>09685000
                                                               <<01431>>09690000
 begin                                                         <<01431>>09695000
                                                               <<01431>>09700000
    logical s33 := true;                                       <<01431>>09705000
    integer num'of'days, tick'in'int := 1100,                  <<01431>>09710000
            msw = q-5, lsw = q-4;       << return value >>     <<01431>>09715000
    double  ms, num'of'ticks, num'tick'per'day := 944710000d;  <<01431>>09720000
    real    tick'to'ms := 9.14566375e-2;<<convert tick to ms>> <<01431>>09725000
                                                               <<01431>>09730000
    disable;                                                   <<01431>>09735000
    push(status); tos.(2:1):=0; set(status);                   <<01431>>09740000
    asmb(pcn);  << get cpu # >>                                <<01431>>09745000
    if tos <> series'33  then                                  <<01431>>09750000
    begin                                                      <<01431>>09755000
       s33 := false;                                           <<01431>>09760000
       num'tick'per'day := ms'per'day;                         <<01431>>09765000
    end;                                                       <<01431>>09770000
    tos := 0;                                                  <<01431>>09775000
    asmb(rccr);                         << count reg value >>  <<01431>>09780000
    if s33  then                                               <<01431>>09785000
    begin                                                      <<01431>>09790000
       tos := f(templr);  << last updated count reg value >>   <<01431>>09795000
       asmb(lsub);                                             <<01431>>09800000
    end;                                                       <<01431>>09805000
     tos := trldtime1;                                         <<06872>>09810000
     tos := trldtime2;                                         <<06872>>09815000
    asmb(dadd; ddup);                                          <<01431>>09820000
     num'of'days := trlnumdays;                                <<06872>>09825000
    tos := num'tick'per'day;  << check if over a day >>        <<01431>>09830000
    asmb(dsub; ddel);                                          <<01431>>09835000
    if >=  then                                                <<01431>>09840000
    begin                                                      <<01431>>09845000
       num'of'ticks := tos - num'tick'per'day;                 <<01431>>09850000
       num'of'days := if num'of'days = 23  then  0  else       <<01431>>09855000
                      num'of'days + 1;                         <<01431>>09860000
    end  else  num'of'ticks := tos;                            <<01431>>09865000
    ms := if s33  then  fixr(real(num'of'ticks)*tick'to'ms)    <<01431>>09870000
          else  num'of'ticks;                                  <<01431>>09875000
                                                               <<01431>>09880000
 comment:  the above calculation is to get the total time      <<01431>>09885000
           since last clock interrupt.  for series 33, all the <<01431>>09890000
           values used are in number of ticks, hence must be   <<01431>>09895000
           converted to milliseconds for the return value of   <<01431>>09900000
           timer.  the multiplier we used is .0914566375, which<<01431>>09905000
           is 1024/(internal clock frenquency in khz).  note,  <<01431>>09910000
           if the clock frenquency changes, then this number   <<01431>>09915000
           must be also changed accordingly.                   <<01431>>09920000
 ;                                                             <<01431>>09925000
    tos := double(num'of'days)*ms'per'day + ms;                <<01431>>09930000
    lsw := tos;                                                <<01431>>09935000
    msw := tos.(1:15);                                         <<01431>>09940000
 end;    << timer >>                                           <<01431>>09945000
                                                                        09950000
procedure aborttimereq(trlx);                                           09955000
value trlx;                                                             09960000
integer trlx;                                                           09965000
option privileged,uncallable;                                           09970000
                                                                        09975000
comment: aborts the timer request found in entry trlx. entry is released09980000
                                                                        09985000
      ;                                                                 09990000
                                                                        09995000
begin                                                                   10000000
      integer  s, t := 8;                                               10005000
      integer trlptr;                                          <<06872>>10010000
                                                                        10015000
                                                                        10020000
      trlx := trlx&lsl(2);                                              10025000
      if  =  then  return;   << ignore zero from i/o system >>          10030000
      if not (%14 <= trlx <= trlnumentries*trlentrysize) then  <<06872>>10035000
         suddendeath(24);            <<index bad>>                      10040000
      disable;                                                          10045000
      if trlx = trlfreelistp then                              <<06872>>10050000
         suddendeath(28);            <<returning 1st free?>>            10055000
      if  trl(trlx) < 0  then                                           10060000
         begin  << active request >>                                    10065000
         while  t <> trlx  do                                           10070000
            begin                                                       10075000
            s := t;                                                     10080000
      trlptr := s;                                             <<06872>>10085000
        t := trlptrnext;                                       <<06872>>10090000
            end;                                                        10095000
      trlptr := s;                                             <<06872>>10100000
      trllink := trl(t);                                       <<06872>>10105000
      trlptr := t;                                             <<06872>>10110000
      t := trlptrnext;                                         <<06872>>10115000
         if  <>  then                                                   10120000
            begin                                                       10125000
        trlptr := trlx;                                        <<06872>>10130000
        tos := trlservtime1;                                   <<06872>>10135000
        tos := trlservtime2;                                   <<06872>>10140000
        trlptr := t;                                           <<06872>>10145000
        tos := trlservtime1;                                   <<06872>>10150000
        tos := trlservtime2;                                   <<06872>>10155000
            asmb( dadd );                                               10160000
      trlservtime2 := tos;                                     <<06872>>10165000
      trlservtime1 := tos;                                     <<06872>>10170000
            end;                                                        10175000
         end;                                                           10180000
   trl(trlx) := trlfreelistp/trlentrysize;                     <<06872>>10185000
      tos := x;                                                         10190000
   trlfreelistp := tos;                                        <<06872>>10195000
                                                                        10200000
                                                                        10205000
                                                                        10210000
trltraceword := %20000 + trlx;  << trace >>                    <<06872>>10215000
                                                                        10220000
                                                                        10225000
                                                                        10230000
end;  << a b o r t t i m e r e q  >>                                    10235000
                                                                        10240000
integer procedure timereq(code,req,time);                               10245000
value code,req,time;                                                    10250000
double time;                                                            10255000
integer code,req;                                                       10260000
option uncallable,privileged;                                           10265000
                                                                        10270000
comment: sets up a time request.                                        10275000
         accepts time up to 2**32-1.                                    10280000
         most prioritary request always first in the list.              10285000
                                                                        10290000
         all header entries are table word offsets.                     10295000
         entry # in entry is the number of the next entry.              10300000
      ;                                                                 10305000
                                                                        10310000
begin                                                                   10315000
      integer  trlx, s, t := 8;                                         10320000
      integer  s0 = s-0, s1 = s-1;                                      10325000
      integer  mst = q-5, lst = q-4;   << time >>                       10330000
   integer trlptr;                                             <<06872>>10335000
                                                                        10340000
      time := time+100d;               << figure ticks >>               10345000
      tos := 0;  tos := mst;                                            10350000
      tos := 100;                                                       10355000
      asmb( ldiv );                                                     10360000
      tos := lst;                                                       10365000
      tos := 100;                                                       10370000
      asmb( ldiv,del );                                                 10375000
      disable;                                                          10380000
      trlx := trlfreelistp;                                    <<06872>>10385000
      if  =  then  suddendeath(3);                                      10390000
      if not(%14 <= trlx <= trlnumentries * trlentrysize) then <<06872>>10395000
                                                               <<06872>>10400000
         suddendeath(25);                                               10405000
      << if this is last trl entry, report table'full >>       <<02804>>10410000
      trlptr := trlx;                                          <<06872>>10415000
      tos := trlptrnext;                                       <<06872>>10420000
      if = then                                                <<02804>>10425000
        mpe'table'full(4);  << 4 is timer req. list >>         <<02804>>10430000
      trlfreelistp := tos;  << update next pointer>>           <<06872>>10435000
      timereq := trlx&asr(2);                                           10440000
      do                                                                10445000
         begin   << find position in line >>                            10450000
         trlptr := t;                                          <<06872>>10455000
         t := trlptrnext;                                      <<06872>>10460000
         tos := trlservtime1;                                  <<06872>>10465000
         tos := trlservtime2;                                  <<06872>>10470000
         asmb( dsub );                                                  10475000
         end                                                            10480000
      until  t = 0  or  s1 < trl(t+2)  or  =  and  logical(s0) <        10485000
             logical(trl(x:=x+1));                                      10490000
s := trlptr;                                                   <<06872>>10495000
                                                                        10500000
      << build entry >>                                                 10505000
      if req=0 then suddendeath(26);                                    10510000
      time := tos;                                                      10515000
  trl(trlx) := %100000+code&lsl(10)+(t/trlentrysize);          <<06872>>10520000
   trlptr := x;                                                <<06872>>10525000
   trlrequest := req;                                          <<06872>>10530000
   trlservtime1 := mst;                                        <<06872>>10535000
   trlservtime2 := lst;                                        <<06872>>10540000
   trlptr := s;                                                <<06872>>10545000
   trllink := trlx&asr(2);    <<  convert to entry # >>        <<06872>>10550000
                                                                        10555000
      << check for time adjust in t >>                                  10560000
      if  t <> 0  then                                                  10565000
         begin                                                          10570000
   trlptr := t;                                                <<06872>>10575000
   tos := trlservtime1;                                        <<06872>>10580000
   tos := trlservtime2;                                        <<06872>>10585000
         tos := tos-time;                                               10590000
   trlservtime2 := tos;                                        <<06872>>10595000
   trlservtime1 := tos;                                        <<06872>>10600000
         end;                                                           10605000
                                                                        10610000
                                                                        10615000
      << if sio timeout, dit8.((code land %17):1) := 0 >>      <<01301>>10620000
      tos := code;                                                      10625000
      tos.(11:1) := 0;                                                  10630000
      if = then del                                                     10635000
      else                                                              10640000
         begin << sio timeout >>                                        10645000
         tos := f(%1010+req);                                  <<01301>>10650000
         asmb(xbx;                                                      10655000
              trbc 0,x;                                                 10660000
              xch,stax;);                                               10665000
         f(x) := tos;                                                   10670000
         end;                                                           10675000
                                                                        10680000
                                                                        10685000
                                                                        10690000
   trltraceword := %10000 + trlx;                              <<06872>>10695000
                                                                        10700000
                                                                        10705000
                                                                        10710000
end;  << t i m e r e q  >>                                              10715000
                                                                        10720000
logical procedure chektrlfree;                             <<1.01>>     10725000
  option privileged,uncallable;                            <<1.01>>     10730000
comment: returns true if a timer request entry is free     <<1.01>>     10735000
         else returns false                                <<1.01>>     10740000
;                                                          <<1.01>>     10745000
  begin                                                    <<1.01>>     10750000
  chektrlfree:= if trl(0) <> 0 then true else false;       <<1.01>>     10755000
  end;   << chektrlfree >>                                 <<1.01>>     10760000
                                                                        10765000
procedure startclock(yearday,timeday);                                  10770000
   value   yearday,timeday;                                             10775000
   integer yearday;                                                     10780000
   double  timeday;                                                     10785000
   option  privileged,uncallable;                                       10790000
 << initilises clock and store year/day/time in trl. >>        <<01431>>10795000
 << clock interrupts every 1100 ticks (s 33) or 100 ms (others)<<01431>>10800000
   begin                                                       <<01431>>10805000
                                                               <<01431>>10810000
   logical s33 := true;                                        <<01431>>10815000
   integer tick'in'int := 1100;  << # of ticks per 100 ms >>   <<01431>>10820000
   real ms'to'tick := 10.9341451852;                           <<01431>>10825000
                                                               <<01431>>10830000
   asmb(pcn);  << get cpu # >>                                 <<01431>>10835000
   if tos <> series'33  then                                   <<01431>>10840000
   begin                                                       <<01431>>10845000
      s33 := false;                                            <<01431>>10850000
      tick'in'int := 100;                                      <<01431>>10855000
   end;                                                        <<01431>>10860000
   tos := yearday;        <<year/day>>                                  10865000
   trldate := tos;                                             <<06872>>10870000
   tos := timeday;        <<time to trl>>                               10875000
   tos := ms'per'day;                                          <<01431>>10880000
   asmb(ddiv);         << # of days since coldload >>          <<01431>>10885000
   if s33 then                                                 <<01431>>10890000
   begin                                                       <<01431>>10895000
      asmb(dflt);                                              <<01431>>10900000
      tos := ms'to'tick;                                       <<01431>>10905000
      asmb(fmpy; fixr);   << convert ms into # of ticks >>     <<01431>>10910000
   end;                                                        <<01431>>10915000
   trldtime2 := tos;                                           <<06872>>10920000
   trldtime1 := tos;                                           <<06872>>10925000
   trlnumdays := tos;                                          <<06872>>10930000
   f(lr) := 0;         << set interrupt rate to default >>     <<01431>>10935000
    if s33  then  asmb(rccr)  else  tos := 0;                  <<01431>>10940000
   f(templr) := f(sclc) := s0;  << temp limit reg >>           <<01431>>10945000
   tos := tos + tick'in'int;                                   <<01431>>10950000
   asmb(sclr);  << update limit reg used by firmware >>        <<00495>>10955000
   f(scsr) := 0;                                                        10960000
   asmb(ton);   <<enable timer>>                                        10965000
   end;  << s t a r t c l o c k  >>                                     10970000
 procedure oldtick;                                            <<01431>>10975000
 option privileged, uncallable;                                <<01431>>10980000
 begin                                                         <<01431>>10985000
 equate   drqst = 6;                                           <<01431>>10990000
 integer  qtime = db+4,                                        <<01431>>10995000
          head = db+8,                                         <<01431>>11000000
          req,                                                 <<01431>>11005000
          code;                                                <<01431>>11010000
 integer array  trl(*) = db+0;                                 <<01431>>11015000
integer trlptr;                                                <<06872>>11020000
 double array  trld(*) = db+0;                                 <<01431>>11025000
 array    ditbit(*) = pb :=                                    <<01431>>11030000
          %100000, %20000, %10000, %200, %20, 0, 0, %4000, 0,2;<<01826>>11035000
   define  sys'portimer = absolute(%1121)#;                    <<01752>>11040000
   equate  junkwait = %20,                                     <<01752>>11045000
           ucopin   = 2;                                       <<01752>>11050000
                                                               <<01431>>11055000
   x := head&asl(1);      << convert to double wrd index >>    <<06872>>11060000
   if  <>  then                                                <<01431>>11065000
      begin   << queued requests >>                            <<01431>>11070000
      x := x+1;                                                <<01431>>11075000
      trld(x) := trld(x)-1d;                                   <<01431>>11080000
      tos := head;                                             <<01431>>11085000
                                                               <<01431>>11090000
      while  <>  and  trld(tos&asl(1)+1) <= 0d  do             <<06872>>11095000
         begin                                                 <<01431>>11100000
         tos := trld(x:=x-1);   << get values >>               <<01431>>11105000
         if s0=0 then suddendeath(27);                         <<01431>>11110000
         trld(x) := 0d;         << mark done >>                <<01431>>11115000
         req := tos;                                           <<01431>>11120000
         code := s0.(1:5);                                     <<01431>>11125000
         trltraceword := %30000 + head;                        <<06872>>11130000
         head := tos.(6:10);     << delink >>                  <<01431>>11135000
                                                               <<06872>>11140000
         if code = 5 then unimpede(req)                        <<01431>>11145000
         else if code = 8 then                                 <<01752>>11150000
            begin  <<port timeout, awaken ucop>>               <<01752>>11155000
            tos:=sys'portimer lor logical(req&lsl(3));         <<01752>>11160000
            sys'portimer := tos;  <<set port mask bit>>        <<01752>>11165000
            awake(sysproc(ucopin),junkwait,nowait);            <<01752>>11170000
            end                                                <<01752>>11175000
         else if code = %12 then << pcb watchdog timer >>      <<02804>>11180000
            awake(req,timerwait,nowait)                        <<02804>>11185000
         else if code = %13 then  << port procedure timeout >> <<06872>>11190000
           begin                                               <<06872>>11195000
           enable;                                             <<06872>>11200000
           porttimeout(req);                                   <<06872>>11205000
           disable;                                            <<06872>>11210000
           end                                                 <<06872>>11215000
         else                                                  <<01431>>11220000
            begin  << i/o timeout >>                           <<01431>>11225000
            x := %1000 + req;                                  <<01431>>11230000
            tos := code;                                       <<01431>>11235000
            tos.(11:1) := 0;                                   <<01431>>11240000
            if <> then                                         <<01431>>11245000
               begin << sio device timeout >>                  <<01431>>11250000
               f(x).(8:1) := 1;  <<iak  bit>>                  <<01431>>11255000
                x := x + 2;                                    <<01481>>11260000
                asmb(xax,zero;           << set dit(8) >>      <<01481>>11265000
                    tsbc 0,x;);                                <<01431>>11270000
               end                                             <<01431>>11275000
            else                                               <<01431>>11280000
               begin << dio device timeout >>                  <<01431>>11285000
               asmb(xax);                                      <<01431>>11290000
               tos := ditbit(x);                               <<01431>>11295000
               end;                                            <<01431>>11300000
            asmb(xch,stax);                                    <<01431>>11305000
            x := x + drqst;                                    <<01431>>11310000
            f(x) := tos lor f(x);                              <<01431>>11315000
            tos := %1000d;  asmb( xchd 0 );  enable;           <<01431>>11320000
            tos := req;                                        <<01431>>11325000
            awakeio( *, 0 );                                   <<01431>>11330000
            asmb( xchd 0; ddel );  disable;                    <<01431>>11335000
            end;                                               <<01431>>11340000
         tos := head;                                          <<01431>>11345000
         end;                                                  <<01431>>11350000
      end;                                                     <<01431>>11355000
                                                               <<01431>>11360000
   enable;                                                     <<01431>>11365000
   qtime := qtime-1;                                           <<01431>>11370000
   if = then                                                   <<mpeiv>>11375000
      begin <<time expired, possibly measure event>>           <<mpeiv>>11380000
      if gclassenabledmask.class0 and curprc <> 0 then         <<06872>>11385000
         begin <<measure>>                                     <<mpeiv>>11390000
         tos:=measstatxdsbank;                                 <<mpeiv>>11395000
         tos:=measstatxdsbase;                                 <<mpeiv>>11400000
         tos:=tos+c0sub0'segreloff+c'stoptimeout;              <<mpeiv>>11405000
         asmb(lsea;inca;ssea;ddel);                            <<mpeiv>>11410000
         end;                                                  <<mpeiv>>11415000
      << next block of code supports measurment intf >>        <<01969>>11420000
      tos:=curprc;                                             <<06872>>11425000
      if <> then                                               <<01969>>11430000
         begin << process running when interrupt occured >>    <<01969>>11435000
         del;  << dump cpcb >>                                 <<01969>>11440000
         tos:=ics(-icsstkbank);                                <<01969>>11445000
         tos:=ics(-icsstkbase);                                <<01969>>11450000
         tos:=tos+pxglobsize+measstopreason'idx;               <<01969>>11455000
         asmb(lsea;del); << processes stopreason >>            <<01969>>11460000
         if = then << process had not stopped for other >>     <<02828>>11465000
            begin   << reason inconjunction with timing out >> <<01969>>11470000
            tos:=stopactive;                                   <<01969>>11475000
            asmb(ssea;ddel);                                   <<01969>>11480000
            if gclassenabledmask.class15 then                  <<01969>>11485000
               begin << bump timeout counter >>                <<01969>>11490000
               tos:=measprocxdsbank;                           <<01969>>11495000
               tos:=measprocxdsbase;                           <<01969>>11500000
               tos := tos + ((curprc)/pcbsize) *               <<06872>>11505000
                    class15'sub0size+cp'stoptimeout;           <<01969>>11510000
               asmb(lsea;inca;ssea;ddel);                      <<01969>>11515000
               end;                                            <<01969>>11520000
            end                                                <<01969>>11525000
         else                                                  <<01969>>11530000
            asmb(ddel); << icsstkabnk, icsstkbase >>           <<01969>>11535000
         end                                                   <<01969>>11540000
      else                                                     <<01969>>11545000
         asmb(del); << cpcb >>                                 <<01969>>11550000
      asmb(disp);                                              <<mpeiv>>11555000
      end;                                                     <<mpeiv>>11560000
 end;                                                          <<01431>>11565000
                                                               <<01431>>11570000
                                                               <<01431>>11575000
procedure  tick;                                               <<01431>>11580000
   option  privileged, uncallable;                             <<01431>>11585000
comment:                                                       <<01431>>11590000
      interrupt handler for the system clock                   <<01431>>11595000
      db  is set to the trl base.                              <<01431>>11600000
      interrupts are aleady disabled but will enabled here.    <<01431>>11605000
;                                                              <<01431>>11610000
   begin                                                       <<01431>>11615000
   equate  one'year = [7/1,9/0];                               <<01431>>11620000
    define   flag = abs(clk'tab'base)#,                        <<dk.40>>11625000
        leap'year = date.(5:2) = 0#,                           <<dk.40>>11630000
              lrv = abs(lr).(1:15)#, <<current interrupt rate>><<dk.40>>11635000
           get'int'rate = tos := lrv;                          <<01431>>11640000
                          if = then tos := tos + tick'in'int#; <<01431>>11645000
   integer date = db+7,                                        <<01431>>11650000
           num'of'days = db + 3,<< # of days since cold lold >><<01431>>11655000
           clk'tab'base, i,                                    <<dk.40>>11660000
           day,                                                <<01431>>11665000
           days'this'year,                                     <<01431>>11670000
           tick'in'int := 1100, <<interrupt interval in ticks>><<01431>>11675000
           tick'per'100ms := %2106,   <<interrupt rate by mc>> <<01431>>11680000
           tslint = q-4, <<time since last interrupt interval>><<01431>>11685000
           int'missed;   << # of ticks since last interrupt >> <<01431>>11690000
   logical wrap := true, s33 := true;                          <<01431>>11695000
   double  dtime = db+5, num'tick'per'day := 944710000d;       <<01431>>11700000
                                                               <<01431>>11705000
   asmb(pcn);  << get cpu # >>                                 <<01431>>11710000
   if  tos <> series'33  then                                  <<01431>>11715000
   begin                                                       <<01431>>11720000
      s33 := false;                                            <<01431>>11725000
      tick'in'int := tick'per'100ms := 100;                    <<01431>>11730000
      num'tick'per'day := ms'per'day;                          <<01431>>11735000
   end;                                                        <<01431>>11740000
   tos := f(scsr);   <<system clock status>>                   <<01431>>11745000
   if < then                                                   <<01431>>11750000
   begin <<sin command>>                                       <<01431>>11755000
      f(scsr) := tos.(1:15);  << clear sinc flag >>            <<01431>>11760000
      enable;                                                  <<01431>>11765000
      asmb( disp );                                            <<01431>>11770000
      go to resetclk;                                          <<01431>>11775000
   end  else  f(x) := 0;  << clear status register >>          <<01431>>11780000
   if  s33  then                                               <<01431>>11785000
   begin                                                       <<01431>>11790000
      tos := 0;                                                <<01431>>11795000
      asmb(rccr; dup);                                         <<01431>>11800000
      tos := f(templr);                                        <<01431>>11805000
      asmb(xch);                                               <<01431>>11810000
      f(x) := tos;                                             <<01431>>11815000
      asmb(lsub; dup);                                         <<01431>>11820000
   end  else                                                   <<01431>>11825000
   begin                                                       <<01431>>11830000
      tos := 0;                                                <<01431>>11835000
      tos := tslint;                                           <<01431>>11840000
      asmb(dup);                                               <<01431>>11845000
   end;                                                        <<01431>>11850000
   get'int'rate;                                               <<01431>>11855000
   asmb(div; del);                                             <<01431>>11860000
   int'missed := tos;   << # if interupts missed  >>           <<01431>>11865000
   dtime := tos+dtime;  << in milliseconds >>                  <<01431>>11870000
   if dtime >= num'tick'per'day then                           <<01431>>11875000
   begin                                                       <<01431>>11880000
      dtime := dtime - num'tick'per'day;                       <<01431>>11885000
      if num'of'days = 23  then                                <<01431>>11890000
      begin                                                    <<01431>>11895000
         num'of'days := 0;                                     <<01431>>11900000
         days'this'year := if leap'year then 366 else 365;     <<01431>>11905000
         if (day:=date.(7:9)+24) > days'this'year then         <<01431>>11910000
         begin                                                 <<01431>>11915000
            day := day - days'this'year;                       <<01431>>11920000
            date := date + one'year;                           <<01431>>11925000
         end;                                                  <<01431>>11930000
         date.(7:9) := day;                                    <<01431>>11935000
      end  else  num'of'days := num'of'days + 1;               <<01431>>11940000
   end;                                                        <<01431>>11945000
                                                               <<dk.40>>11950000
    clk'tab'base := abs(%1261)+%1070; << get data table base >><<dk.40>>11955000
    if  tlimit <> 0  then                                      <<dk.40>>11960000
    begin    << someone is using the shared clock interface >> <<dk.40>>11965000
      tos := int'missed;                                       <<01838>>11970000
       tos := tcount;                                          <<dk.40>>11975000
       asmb(xch; sub);                                         <<dk.40>>11980000
       if  <=  then                                            <<dk.40>>11985000
       begin                                                   <<dk.40>>11990000
          tcount := tlimit;                                    <<dk.40>>11995000
          oldtick;                                             <<dk.40>>12000000
          if lrv=0 and flag.(1:1) then                         <<06872>>12005000
          begin                                                <<dk.40>>12010000
              tos := tick'in'int / integer ( tlimit );         <<04115>>12015000
             lrv := s0.(1:15);  << store interrupt interval >> <<dk.40>>12020000
             if  not s33  then  asmb(sclr);                    <<dk.40>>12025000
          end  else                                            <<dk.40>>12030000
          if lrv > 0 and not flag.(1:1) then                   <<06872>>12035000
          begin                                                <<dk.40>>12040000
             lrv := 0;                                         <<dk.40>>12045000
             for i:= 59 until 62  do  measinfotabptr(i) := 0;  <<dk.40>>12050000
             if  not s33  then                                 <<dk.40>>12055000
             begin                                             <<dk.40>>12060000
                tos := 100;                                    <<dk.40>>12065000
                asmb(sclr);                                    <<dk.40>>12070000
             end;                                              <<dk.40>>12075000
             goto  exit;                                       <<dk.40>>12080000
          end;                                                 <<dk.40>>12085000
       end  else  tcount := tos;                               <<04314>>12090000
      tos := int'missed;                                       <<01838>>12095000
       tos := dcount;                                          <<dk.40>>12100000
       asmb(xch; sub);                                         <<dk.40>>12105000
       if  <=  then                                            <<dk.40>>12110000
       begin                                                   <<dk.40>>12115000
          if  not flag  then                                   <<dk.40>>12120000
          begin                                                <<dk.40>>12125000
             tos := if  flag < 0  then  1  else  0;            <<dk.40>>12130000
              tos := dlabel;                                   <<04115>>12135000
             if flag.(1:1) then                                <<06872>>12140000
             begin                                             <<dk.40>>12145000
                enable;                                        <<dk.40>>12150000
                flag.(15:1) := 1;                              <<06872>>12155000
                flag.(0:1) := 0;                               <<06872>>12160000
                asmb(pcal 0);                                  <<dk.40>>12165000
                dcount := dlimit;                              <<dk.40>>12170000
                disable;                                       <<dk.40>>12175000
             end  else  asmb(ddel);                            <<dk.40>>12180000
             flag := flag land %40000;                         <<06872>>12185000
          end else flag.(0:1):=1;                              <<06872>>12190000
       end else  dcount := tos;                                <<04314>>12195000
    end  else  oldtick;                                        <<dk.40>>12200000
                                                               <<dk.40>>12205000
exit:                                                          <<01431>>12210000
   if s33  then                                                <<01431>>12215000
   begin                                                       <<01431>>12220000
      get'int'rate;                                            <<01431>>12225000
      tos := f(templr);                                        <<01431>>12230000
      asmb(ladd; dup; rccr; lsub);                             <<01431>>12235000
      tos := 10;                                               <<01431>>12240000
      asmb(sub; del);                                          <<01431>>12245000
      if <=  then << next scheduled interrupt has passed >>    <<01431>>12250000
      begin                                                    <<01431>>12255000
         get'int'rate;  << get interrupt rate >>               <<01431>>12260000
         asmb(rccr; ladd);  << set interrupt from now >>       <<01431>>12265000
      end;                                                     <<01431>>12270000
      asmb(sclr);                                              <<01431>>12275000
   end;                                                        <<01431>>12280000
resetclk:                                                      <<01431>>12285000
   asmb(ton);                                                  <<01431>>12290000
end;                                                           <<01431>>12295000
$page                                                          <<03028>>12300000
$page "                             HELP"                      <<06872>>12305000
                                                                        12310000
procedure help;                                                         12315000
    option privileged, uncallable;                                      12320000
<<                                                                      12325000
   mpe/30 standalone debugging procedure.                               12330000
   the following quantities are assumed to be defined outside           12335000
   this procedure:                                                      12340000
        disable = asmb(sed 0)#, asmb = assemble#, and                   12345000
        f = absolute#.                                                  12350000
>>                                                                      12355000
begin                                                                   12360000
define  cst'size = 4#,                                         <<01364>>12365000
        banks'configured = f( sysdb + %47)#,                   <<01364>>12370000
        ldad = asmb( lsea )#,                                           12375000
        stad = asmb( ssea )#;                                           12380000
                                                                        12385000
equate max'bpts = 10,  << number of entries in table >>        <<01364>>12390000
       table'size = max'bpts * 6;                              <<01364>>12395000
define num'bpts = bptab(table'size+1)#;                        <<01364>>12400000
  << the last word of the break point table counts the >>      <<01364>>12405000
  << number of break points.                           >>      <<01364>>12410000
                                                               <<01364>>12415000
define                                                         <<06872>>12420000
   lpdt'index = (help'ldev * integer(lpdt'entry'size))#,       <<*7811>>12425000
   help'ldev'ditp = lpdt'dit'ptr#,                             <<*7811>>12430000
   help'term = absolute(%1276)#,                               <<06872>>12435000
   help'ldev = 21#,                                            <<06872>>12440000
   help'on   = help'term := help'ldev#,                        <<06872>>12445000
   help'off  = help'term := 0#;                                <<06872>>12450000
array bp'tab(*) = pb := table'size(0),-1,0;                    <<01364>>12455000
<< this array holds the information required for breakpoints.           12460000
   each entry in the table is 6 words long. the table is                12465000
   ended with a -1. it may be extended by  changing the number          12470000
   of initialization zeros in the above declaration. the words          12475000
   in  a table entry are used as follows:                               12480000
                                                                        12485000
   word0.(0:8) =  0    empty table entry                                12490000
                  1    user set breakpoint                              12495000
                  2    "FAKE" breakpoint                                12500000
                                                                        12505000
   word0.(8:8) =       cst for the breakpoint. if zero then             12510000
                       this table entry is free.                        12515000
                                                                        12520000
   word1       =       pb relative address for the breakpoint. if       12525000
                       zero then the entry is free.                     12530000
                                                                        12535000
   word2       =       saved instruction  if a breakpoint is set.       12540000
                                                                        12545000
   word3.(0:8) =       relational operator for the conditional          12550000
                  0    no condition attached                            12555000
                  1    count attached                                   12560000
                  2    <                                                12565000
                  3    =                                                12570000
                  4    >                                                12575000
                  5    #                                                12580000
                                                                        12585000
   word3.(8:8) =       bank for comparison address                      12590000
                                                                        12595000
   word4       =       rest of the comparison address                   12600000
                                                                        12605000
   word5       =       comparison constant                              12610000
>>                                                                      12615000
                                                                        12620000
integer array  bptab(*) = db+0;  << breakpoint table >>                 12625000
byte array input(0:39) = q;  << holds command string input >>           12630000
                                                                        12635000
byte array  io(0:39) = q;   << output buffer >>                <<01778>>12640000
integer array  wrdio(*) = io;  << overlay for above >>                  12645000
                                                                        12650000
equate num'cmnds = 7;                                          <<01364>>12655000
integer array comm(*) = pb := %102,%103,%104,%115,%122,%121,   <<01364>>12660000
                              %114;                            <<01364>>12665000
<< octal values of the character commands >>                            12670000
                                                                        12675000
integer array  rel(*) = pb := %74,%75,%76,%43,%174;            <<06872>>12680000
<<  the above are the allowable relational operators >>                 12685000
                                                                        12690000
integer array  pre(*) = pb := "HELP    . ";                             12695000
                                                               <<06872>>12700000
                                                                        12705000
double  p1, p2,   << parameters for commands >>                         12710000
        olddb,    << callers db >>                                      12715000
        k,  << temporary variable >>                                    12720000
        ds4 = s-4,   << s relative temps >>                             12725000
        ds5 = s-5,                                                      12730000
        ds1 = s-1;                                                      12735000
integer array p1array(*) = p1;                                 <<06872>>12740000
                                                                        12745000
logical  p2f,   << set if 2nd parameter exists >>                       12750000
         reg;   << set if a register appears in pri' >>                 12755000
                                                                        12760000
integer  x = x,   << define registers and tos variables >>              12765000
         s0 = s-0,                                                      12770000
         s1 = s-1,                                                      12775000
         s2 = s-2,                                                      12780000
         s3 = s-3,                                                      12785000
         s4 = s-4,                                                      12790000
         s5 = s-5,                                                      12795000
         s7 = s-7,                                                      12800000
         token,  << output of char subroutine >>                        12805000
         inpntr, << index to fetch next char from cmnd string >>        12810000
         i, j, l,  << temporary variables >>                            12815000
         olds,  << s value to reset in fail >>                          12820000
         com,  << command # >>                                          12825000
         cst,  << cst value for b and c commands >>                     12830000
         p,  << p value for above >>                           <<06872>>12835000
         smx = q-4,  << x-reg from stack marker >>             <<06872>>12840000
         smdq= q-0,  << delta-q from stack marker >>           <<06872>>12845000
         smpx = q-2,  << delta-p from marker >>                <<06872>>12850000
         smsta = q-1;  << status from stack marker >>                   12855000
define   smp = smpx.(2:14)#;<<delta-p excluding mapping bit>>  <<06872>>12860000
                                                                        12865000
                                                                        12870000
subroutine  print(c);                                                   12875000
   value c; integer c;                                                  12880000
<<                                                                      12885000
this subroutine prints the i/o buffer (io) on the teletype.             12890000
c is a count. its absolute value is the number of characters            12895000
to print. if c >= 0, then the line will be followed by a                12900000
return-linefeed.                                                        12905000
>>                                                                      12910000
   begin                                                                12915000
                                                                        12920000
   x := 0;                                                              12925000
   while  x < \c\  do                                          <<01364>>12930000
      begin  << print a character >>                                    12935000
                                                                        12940000
      printchar (io(x));                                                12945000
                                                                        12950000
      x := x+1;                                                         12955000
      end;                                                              12960000
                                                                        12965000
                                                                        12970000
   if  c >= 0  then                                                     12975000
      begin  << print a cr, lf >>                                       12980000
      printchar(%15);    printchar(%12);                                12985000
      x:=4;                                                             12990000
      do  printchar(0)  until dxbz;                            <<01364>>12995000
      end;                                                              13000000
   end;                                                                 13005000
                                                                        13010000
subroutine  fail;                                                       13015000
<<                                                                      13020000
this is called on a command failure. it cuts the stack                  13025000
back as needed and returns to the command input loop.                   13030000
>>                                                                      13035000
    begin                                                               13040000
    wrdio := "??";                                                      13045000
    print( 2 );  << print error indication >>                           13050000
    tos := olds;  << reset s as required >>                             13055000
    set (  s  );                                                        13060000
    go comin;                                                           13065000
    end;                                                                13070000
                                                                        13075000
                                                                        13080000
subroutine getinput;                                                    13085000
                                                                        13090000
  << read command into input buffer, input.  first character of         13095000
     command is put into token and a lf is output on the cr.            13100000
     control h and x are processed in this routine.                     13105000
  >>                                                                    13110000
                                                                        13115000
  begin                                                                 13120000
   i := 0;                                                              13125000
                                                                        13130000
                                                                        13135000
readl:                                                                  13140000
                                                                        13145000
    token:=readchar;                                                    13150000
                                                                        13155000
   if  token = " "  then  goto readl;                                   13160000
                                                                        13165000
   if token=%10 then  << control h, delete a character >>               13170000
     begin                                                              13175000
       if i>0 then  << something to delete >>                           13180000
         begin                                                          13185000
           i := i - 1;                                                  13190000
           io := "\";    print(-1);                                     13195000
         end;                                                           13200000
       goto readl;   << get next character >>                           13205000
     end;                                                               13210000
                                                                        13215000
   if token=%30 then  << control x, delete the line >>                  13220000
     begin                                                              13225000
       i := 0;                                                          13230000
       wrdio := "!!";   io(2) := "!";                                   13235000
       print(3);                                                        13240000
       goto readl;   << get next character >>                           13245000
     end;                                                               13250000
                                                                        13255000
   if i>=40 then fail;   << overflow buffer >>                          13260000
   input(i) := token;     i := i + 1;                                   13265000
   if token<>%15 then goto readl;  << not a cr, get next character >>   13270000
                                                                        13275000
   i := 0;                                                              13280000
                                                                        13285000
   inpntr := 1;   token := input;                                       13290000
   print(0);    << cr/lf >>                                             13295000
  end;   << get input >>                                                13300000
                                                                        13305000
                                                                        13310000
subroutine  char;                                                       13315000
<<                                                                      13320000
this subroutine gets a character from the input buffer and places       13325000
it in token.                                                            13330000
>>                                                                      13335000
   begin                                                                13340000
     token := input(inpntr);                                            13345000
     inpntr := inpntr + 1;                                              13350000
   end;                                                                 13355000
                                                                        13360000
subroutine  numout( n, l, s );                                          13365000
   value  n,l,s;                                                        13370000
   double n;                                                            13375000
   integer l,s;                                                         13380000
<<                                                                      13385000
n is the number to print. l is the location in io to place it.          13390000
s is the size in characters for the converted number.                   13395000
>>                                                                      13400000
   begin                                                                13405000
   x := l+s;  << set up the index >>                                    13410000
   tos := n;  << get number >>                                          13415000
   do                                                                   13420000
      begin  << convert one digit >>                                    13425000
      x := x-1;                                                         13430000
      asmb( dup );                                                      13435000
      io(x) := (tos land 7) lor %60;                                    13440000
      tos := tos&dasr(3);                                               13445000
      end                                                               13450000
   until  s4 = x;                                                       13455000
   ddel;  << delete n's remains >>                                      13460000
   end;                                                                 13465000
                                                                        13470000
double subroutine octint;                                               13475000
<<                                                                      13480000
computes and returns an octal integer. the integer must                 13485000
have between 1 and 6 digits inclusive                                   13490000
>>                                                                      13495000
   begin                                                                13500000
   l := 0;  << zero the digit counter >>                                13505000
   tos := 0d;  << initial value of octint >>                            13510000
   while  %60 <= token <= %67  do                                       13515000
      begin  << get a digit >>                                          13520000
      l := l+1;                                                         13525000
      tos := tos&dcsl(3);                                               13530000
      tos := 0;   << form double value for new digit >>                 13535000
      tos := token-%60;                                                 13540000
      asmb( dadd );                                                     13545000
      char;  << get the next character >>                               13550000
      end;                                                              13555000
   if  not( 1 <= l <= 6 )  then  fail;  << too many or too few >>       13560000
   ds4 := tos;  << return the value >>                                  13565000
   end;                                                                 13570000
                                                                        13575000
double subroutine number;                                               13580000
<<                                                                      13585000
computes a signed number                                                13590000
>>                                                                      13595000
   if  token = "-"  then                                                13600000
      begin                                                             13605000
      char;  << get next >>                                             13610000
      number := -octint;                                                13615000
      end                                                               13620000
   else                                                                 13625000
      begin                                                             13630000
      if  token = "+"  then  char;  << ignore it >>                     13635000
      number := octint;                                                 13640000
      end;                                                              13645000
                                                                        13650000
double subroutine cst'addr( cst );                                      13655000
   value cst; integer cst;                                              13660000
<<                                                                      13665000
computes the base address for a segment given the cst.                  13670000
fails if the segment is absent                                          13675000
>>                                                                      13680000
   begin                                                                13685000
   if  f(f(0)) < cst  then  fail;  << illegal cst >>                    13690000
   x := x+cst*cst'size;                                                 13695000
   if  f(x) < 0  then  fail;  << absent, error >>                       13700000
   tos := f(x:=x+2);         << get bank >>                    <<01778>>13705000
   tos := f(x:=x+1);  << get address in the bank >>                     13710000
   ds5 := tos;  << return the value >>                                  13715000
   end;                                                                 13720000
                                                                        13725000
double subroutine pri';                                                 13730000
<<                                                                      13735000
computes a pri, see documentation for definition                        13740000
>>                                                                      13745000
   if  "D" <= token <= "Z"  then                                        13750000
      begin << a register is given >>                                   13755000
      reg := true;                                                      13760000
      push(sbank);  << get the stack bank >>                            13765000
      push( db );                                                       13770000
      delb;   << get rid of db bank >>                                  13775000
      if  token = "D"  then                                             13780000
         begin  << dl or db >>                                          13785000
         char;  << get the b or l >>                                    13790000
         if  token = "B"  then                                          13795000
            begin  << db >>                                             13800000
            ddel;  << cut db and sbank >>                               13805000
            tos := olddb;                                               13810000
            tos := 0;   << db rel db >>                                 13815000
            end                                                         13820000
         else  if  token  = "L"  then  push( dl )                       13825000
         else  fail;  << illegal register given >>                      13830000
         end                                                            13835000
      else                                                              13840000
         begin                                                          13845000
         if  token = "Q"  then                                          13850000
            begin  << q >>                                              13855000
            push( q );  << get q >>                                     13860000
            tos := tos+tos;   << make absolute q >>                     13865000
            ldad;  << get delta q from marker >>                        13870000
            tos := -tos;  << build user's q >>                          13875000
            end                                                         13880000
         else  if  token = "S"  then                                    13885000
            begin  << s >>                                              13890000
            push( q );                                                  13895000
            tos := tos-4;                                               13900000
            end                                                         13905000
         else  if  token = "Z"  then  push( z )                         13910000
         else  fail;                                                    13915000
         end;                                                           13920000
      char;  << scan off the register >>                                13925000
      tos := tos+tos;   << change db rel to abs >>                      13930000
      ds4 := tos;  << return the value >>                               13935000
      end                                                               13940000
   else                                                                 13945000
      pri' := number;                                                   13950000
                                                                        13955000
double subroutine sexp;                                                 13960000
<<                                                                      13965000
computes a <sexp>                                                       13970000
>>                                                                      13975000
   begin                                                                13980000
   reg := false;                                                        13985000
   tos := pri';  << get a <pri> >>                                      13990000
l: if  token = "+"  then                                                13995000
      begin                                                             14000000
      char;  << scan off + >>                                           14005000
      tos := pri'; if reg then  asmb(delb,add)  else  asmb(dadd);       14010000
      go l;                                                             14015000
      end;                                                              14020000
   if  token = "-"  then                                                14025000
      begin                                                             14030000
      char;  << scan off the - >>                                       14035000
      tos := pri'; if reg then  asmb(delb,sub)  else  asmb(dsub);       14040000
      go l;                                                             14045000
      end;                                                              14050000
   if  token = "I"  then                                                14055000
      begin  << indirect >>                                             14060000
      char;  << scan off the i >>                                       14065000
      ldad;  << get the address' contents >>                            14070000
      delb; delb;  << cut address >>                                    14075000
      if  reg  then  asmb(ldd olddb; cab,add)  else                     14080000
      asmb( zero,xch );  << form a double >>                            14085000
      go l;                                                             14090000
      end;                                                              14095000
   ds4 := tos;                                                          14100000
   end;                                                                 14105000
                                                                        14110000
double subroutine  exp;                                                 14115000
<<                                                                      14120000
computes a <exp>                                                        14125000
>>                                                                      14130000
   begin                                                                14135000
   tos := sexp;                                                         14140000
   if  token = "."  then                                                14145000
      begin                                                             14150000
      asmb( dup );                                                      14155000
      cst := s0;                                                        14160000
      char;                                                             14165000
      tos := cst'addr(*);                                               14170000
      tos := sexp;                                                      14175000
      p := s0;                                                          14180000
      asmb(dadd);                                                       14185000
      end                                                      <<01364>>14190000
 else if token = "@" then                                      <<01364>>14195000
      begin  << bank and absolute address >>                   <<01364>>14200000
      delb;                                                    <<01364>>14205000
      char;                                                    <<01364>>14210000
      tos:=sexp;                                               <<01364>>14215000
      delb;                                                    <<01364>>14220000
      end;                                                     <<01364>>14225000
   ds4 := tos;                                                          14230000
   end;                                                                 14235000
                                                                        14240000
logical subroutine find;                                                14245000
<<                                                                      14250000
this subroutine is used to find entries in the bp'tab. it               14255000
returns true on a successful find. on success, i is set                 14260000
to the 16 bit index of the first word of the table entry.               14265000
>>                                                                      14270000
   begin                                                                14275000
   i := x := 0;                                                         14280000
   do                                                                   14285000
      if  bptab(x).(8:8) = cst  and  bptab(x:=x+1) = p then             14290000
         begin  find := true;  return;  end                             14295000
   until  bptab(i:=i+6) = -1;                                           14300000
   end;                                                                 14305000
                                                                        14310000
subroutine  impcst;                                                     14315000
<<                                                                      14320000
checks for an implied cst in the c or b commands                        14325000
>>                                                                      14330000
   if  cst = 0  then                                                    14335000
      begin  << implied cst >>                                          14340000
      cst := smsta.(8:8);                                               14345000
      tos := p1;  delb;  p := tos;                                      14350000
      end;                                                              14355000
                                                                        14360000
subroutine clear;                                                       14365000
<<                                                                      14370000
this subroutine is called to clear a breakpoint                         14375000
>>                                                                      14380000
   begin                                                                14385000
   impcst;                                                              14390000
   if  find  then                                                       14395000
      begin  << one exists, zap it >>                                   14400000
      tos := cst'addr( cst )+double( p );                               14405000
      bptab(i) := 0;                                                    14410000
      bptab(x:=x+1) := 0;                                               14415000
      tos := bptab(x:=x+1);  << get the instruction >>                  14420000
      stad;  << restore it in the code >>                               14425000
      ddel;                                                             14430000
                                                               <<01364>>14435000
      num'bpts := num'bpts - 1;                                <<01364>>14440000
                                                               <<01364>>14445000
      p := p+1;  << take out a possible fake >>                         14450000
      if  find  and  bptab(i).(0:8) = 2  then  clear;                   14455000
      p := p-1;                                                         14460000
      end                                                               14465000
   else  fail;                                                          14470000
   end;                                                                 14475000
subroutine help'mmstat;                                        <<06872>>14480000
begin                                                          <<06872>>14485000
                                                               <<06872>>14490000
<< log event to mmstat >>                                      <<06872>>14495000
  << word 0 - %40000  +  delta  p                >>            <<06872>>14500000
  <<      1 - sm   x                             >>            <<06872>>14505000
  <<      2 - sm   status                  >>                  <<06872>>14510000
  <<      3 - sm   delta q                 >>                  <<06872>>14515000
  <<      4 - content of first specified address   >>          <<06872>>14520000
  <<      5 - content of second specified address  >>          <<06872>>14525000
  <<      6 - lsw of timer                 >>                  <<06872>>14530000
tos := %40000  lor  logical(smp);   <<  event # for mmstat >>  <<06872>>14535000
tos := smx;     <<  stack marker xreg  >>                      <<06872>>14540000
tos := smsta;   <<  stack marker p-reg >>                      <<06872>>14545000
tos := smdq;    <<  stack marker delta-q >>                    <<06872>>14550000
assemble(load s-6);  << first address specified >>             <<06872>>14555000
assemble(zero;  load s-7;  lsea);  << 2nd specified address >> <<06872>>14560000
assemble(delb,delb);    << delete address of 2nd parm >>       <<06872>>14565000
tos := timer;  asmb(delb);  << timer lsw >>                    <<06872>>14570000
mmstat'(*,*,*,*,*,*,*);                                        <<06872>>14575000
assemble(delb,delb);   <<  delete parms that would have cmped>><<06872>>14580000
end;   << of subroutine log'mmstat >>                          <<06872>>14585000
                                                                        14590000
subroutine break( a );                                                  14595000
   value a; integer a;                                                  14600000
<<                                                                      14605000
this routine puts in break points. the a passed is the type             14610000
of breakpoint.                                                          14615000
>>                                                                      14620000
comment                                                        <<01364>>14625000
   because a fake break point is set whenever help is entered  <<01364>>14630000
   via a user set break point, there must be at least one      <<01364>>14635000
   free entry after a user break point is set to accomodate    <<01364>>14640000
   the fake break point.                                       <<01364>>14645000
;                                                              <<01364>>14650000
                                                               <<01364>>14655000
   begin  << table entry will be built on the stack >>                  14660000
   impcst;                                                              14665000
   tos := 0;  << initialize the constant >>                             14670000
   tos := p2;  << get the address for the test >>                       14675000
   asmb( xch );  << reverse the address for as wanted >>                14680000
   if  p < 0  or  find  then  fail;  << bad p or already exists >>      14685000
   k := tos := cst'addr( cst )+double( p );                             14690000
   ldad;  << get the instruction to replace >>                          14695000
                                                                        14700000
   if  s7 = 1  then   << a is now at s7 >>                              14705000
      begin  << user breakpoint, check instruction >>                   14710000
      if  s0.(0:4) = %14   then  fail;  << branches >>                  14715000
      if  s0.(0:4) = 3  and  1<=s0.(4:4)<=4 then fail;                  14720000
      if  s0.(0:4) = 1  then                                            14725000
         begin  << check which ones >>                                  14730000
         tos := %117001703d;                                            14735000
         tos := tos&dcsl(s2.(5:5));                                     14740000
         if  <  then  fail;                                             14745000
         ddel;  << kick off magic constant >>                           14750000
         end;                                                           14755000
      << getting to this point says it is o.k. >>                       14760000
      end;                                                              14765000
                                                                        14770000
   asmb( cab,cab );  << put address above instruction >>                14775000
   tos := tos-double(p)+double(f(f(0)+cst*cst'size).(4:12)*4)-1d;       14780000
   << the above monster is the address of pl >>                         14785000
   << check for p in bounds >>                                          14790000
   if  k > ds1  then  fail;                                             14795000
   ldad;  << get stt size >>                                            14800000
   x := tos.(8:8);                                                      14805000
   j :=  i := 0;  << initial pl values >>                               14810000
   do                                                                   14815000
      begin  << search the stt >>                                       14820000
      i := i+1;                                                         14825000
      s0 := s0-1;  << back up address pointer >>                        14830000
      ldad;  << get the label >>                                        14835000
      if  tos = @help  then  j := i;  << found it >>                    14840000
      end                                                               14845000
   until  dxbz;                                                         14850000
   push(status);  if  tos.(8:8) = cst  then  j := @help.(1:7);          14855000
   if  j = 0  then  fail;                                               14860000
   ddel;  << get rid of the address into the stt >>                     14865000
   tos := p;  p := 0;                                                   14870000
   tos := cst;  cst := 0;   << stack the vitals >>                      14875000
   tos.(0:8) := s7;  << a from the call >>                              14880000
                                                               <<01364>>14885000
   if (s7 <<a>> = 1) and (num'bpts >= max'bpts - 1)            <<01364>>14890000
     then fail;  << not enough room in table >>                <<01364>>14895000
                                                               <<01364>>14900000
   if  not find  then  fail;  << get a zero entry >>                    14905000
   << check for a <lexp> >>                                             14910000
   if  s7 <<a>> = 1  and  p2f  then                                     14915000
      if  token = %15  then                                             14920000
         begin  << just a count >>                                      14925000
         s3.(0:8) := 1;  << set the relop >>                            14930000
         s3.(8:8) := 0;  << clear bank >>                      <<01364>>14935000
         s4 := s5 := integer(p2);  << set count >>                      14940000
         end                                                            14945000
      else                                                              14950000
         begin                                                          14955000
         tos := -1;                                                     14960000
         x := 0;                                                        14965000
         do  if  rel(x) = token  then  s0 := x+2                        14970000
         until  (x:=x+1) = 5;                                  <<06872>>14975000
         if  s0 = -1  then  fail;                                       14980000
         s4.(0:8) := tos;                                               14985000
         char;  << scan off the relop >>                                14990000
         s5 := integer(exp);                                            14995000
         if  token <> %15  then  fail;                                  15000000
         end;                                                           15005000
   x := i;  << set up entry >>                                          15010000
   i := 6;                                                              15015000
   do                                                                   15020000
      begin  << move from stack to table >>                             15025000
      bptab(x) := tos;                                                  15030000
      x := x+1;                                                         15035000
      i := i-1;                                                         15040000
      end                                                               15045000
   until  =;                                                            15050000
                                                               <<01364>>15055000
   num'bpts := num'bpts + 1;                                   <<01364>>15060000
                                                               <<01364>>15065000
   << set up the pcal into the segment >>                               15070000
   tos := k;  << get address >>                                         15075000
   tos := j+%031000;  << form the pcal >>                               15080000
   stad;  << store it >>                                                15085000
   ddel;                                                                15090000
   end;                                                                 15095000
                                                                        15100000
subroutine dum(a);                                                      15105000
   value a;  integer a;                                                 15110000
<<                                                                      15115000
helper function for dump and modify                                     15120000
>>                                                                      15125000
   begin                                                                15130000
   tos:=p1&dlsr(16);    << bank number >>                      <<01364>>15135000
   numout(*, 0, 6);                                            <<01778>>15140000
   wrdio(3):=" @";                                             <<01778>>15145000
   tos:=p1&dlsl(16);    << use only 1 word >>                  <<01364>>15150000
   tos:=tos&dlsr(16);   << for address     >>                  <<01364>>15155000
   numout(*, 8, 6);                                            <<01778>>15160000
   wrdio(7):=": ";                                             <<01778>>15165000
   tos := p1;                                                           15170000
   if s1 > banks'configured then fail;                         <<01778>>15175000
   ldad;                                                                15180000
   asmb( zero,xch );  << form into 32 bit value >>                      15185000
   numout( *, s5, 6 );                                                  15190000
   ddel;                                                                15195000
   p1 := p1+1d;                                                         15200000
   p2 := p2-1d;                                                         15205000
   end;                                                                 15210000
                                                                        15215000
subroutine dump;                                                        15220000
<<                                                                      15225000
dumps memory locations when called                                      15230000
>>                                                                      15235000
   do                                                                   15240000
      begin  << dump a word >>                                          15245000
      dum(16);                                                 <<01778>>15250000
      print( -22 );                                            <<01778>>15255000
      i := 0;                                                           15260000
      while  (i:=i+1) < 8  and  p2 > 0d  do                             15265000
         begin                                                          15270000
         dum(2);                                                        15275000
         wrdio := "  ";                                                 15280000
         print(-8);                                                     15285000
         end;                                                           15290000
      print(0);                                                         15295000
      end                                                               15300000
   until  p2 <= 0d;                                                     15305000
                                                                        15310000
subroutine modify;                                                      15315000
<<                                                                      15320000
does modifications to memory                                            15325000
>>                                                                      15330000
   do                                                                   15335000
      begin  << do a word >>                                            15340000
      tos := p1;                                                        15345000
      if s1 > banks'configured then fail;                      <<01778>>15350000
      dum(16);                                                 <<01778>>15355000
      wrdio(11) := " _";                                       <<01778>>15360000
      print( -24 );                                            <<01778>>15365000
      getinput;   << get modified value >>                              15370000
      tos := exp;  << get the new value >>                              15375000
      delb;  << shorten it >>                                           15380000
      stad;  << store it >>                                             15385000
      ddel;  << delete the address >>                                   15390000
      end                                                               15395000
   until  p2 <= 0d;                                                     15400000
                                                                        15405000
subroutine list;                                               <<01364>>15410000
comment                                                        <<01364>>15415000
   lists user set break points.                                <<01364>>15420000
;                                                              <<01364>>15425000
                                                               <<01364>>15430000
   begin                                                       <<01364>>15435000
   i := x := 0;                                                <<01364>>15440000
   do                                                          <<01364>>15445000
      if bptab(x).(0:8) = 1 then                               <<01364>>15450000
        begin                                                  <<01364>>15455000
        tos := double(bptab(x).(8:8));                         <<01364>>15460000
        tos := double(bptab(x:=x+1));                          <<01364>>15465000
        numout(*,4,5);                                         <<01364>>15470000
        numout(*,0,3);                                         <<01364>>15475000
        io(3) := ".";                                          <<01364>>15480000
        print(9);                                              <<01364>>15485000
        end                                                    <<01364>>15490000
   until bptab(i:=i+6) = -1;                                   <<01364>>15495000
   end;                                                        <<01364>>15500000
                                                                        15505000
subroutine  exit;                                                       15510000
<<                                                                      15515000
returns to the user program                                             15520000
>>                                                                      15525000
   begin                                                                15530000
   tos := olddb;  set(db);                                              15535000
   help'off;                                                   <<06872>>15540000
   tos := p1;  tos := tos+%31400;                                       15545000
   asmb( xeq 0 );  << cut back stacked parameters, exit >>              15550000
   end;                                                                 15555000
                                                                        15560000
                                                                        15565000
subroutine printioqs;                                                   15570000
<<                                                                      15575000
  this subroutine prints a list of ioqs. the first parameter of the     15580000
  command specifies the ldev number or if zero no ldev is specified.    15585000
  the 2nd parameter specifies the number of ioqs to print. the ioqs     15590000
  are printed in the reverse order of age, that is, the last event      15595000
  is print first.                                                       15600000
>>                                                                      15605000
  begin                                                                 15610000
    l := integer(p1);      << logical device number >>                  15615000
    j := integer(p2);      << number of ioqs to print >>                15620000
    com := 0;   << holds index of last ioq printed >>                   15625000
                                                                        15630000
findloop:                                                               15635000
    i := ioq(2);                                               <<06872>>15640000
    if i<>com then  <<last not oldest so look for one >>                15645000
      begin                                                             15650000
         while integer(ioq(i + 1)) <> com                      <<06872>>15655000
   do                                                          <<06872>>15660000
            i := ioq(x);                                       <<06872>>15665000
            << find preceeding ioq >>                          <<06872>>15670000
  if l<>0 and l <> integer(ioq(i+2))                           <<06872>>15675000
            then                                               <<06872>>15680000
          goto findloop;  << not correct ldev, find next ioq >>         15685000
                                                                        15690000
         p1array(0) := dst(ioq'dst * 4 +2);                    <<06872>>15695000
         p1array(1) := dst(ioq'dst * 4 + 2);                   <<06872>>15700000
         p2 := double(iqh'ent'size); dump;                     <<06872>>15705000
        if (j:=j-1)>0 then goto findloop;  << do next ioq >>            15710000
      end;                                                              15715000
  end;  << print ioq >>                                                 15720000
                                                                        15725000
<<                                                                      15730000
                                                                        15735000
start of the procedure body                                             15740000
                                                                        15745000
>>                                                                      15750000
<<    tell terminal code we're going into help mode >>         <<*7811>>15755000
if not check'io'state(help'ldev'ditp) then return;             <<*7811>>15760000
disable;  << turn off interrupts >>                                     15765000
<< decide why we stopped >>                                             15770000
help'on;                                                       <<06872>>15775000
tos := 0d;                                                              15780000
push(status);                                                           15785000
asmb( dup );                                                            15790000
tos.(2:1) := 0;  set(status);  << turn off the traps >>                 15795000
tos := tos.(8:8);                                                       15800000
tos := cst'addr( * );   tos := tos+@bp'tab;                             15805000
asmb( xchd 0 );  olddb := tos;                                          15810000
p := smp-1;  << get p from stack marker >>                              15815000
cst := smsta.(8:8);  << get the status >>                               15820000
tos := double( p );  tos := double( cst );  << save to print >>         15825000
                                                                        15830000
if  find  then                                                          15835000
   begin  << in the breakpoint table >>                                 15840000
   tos := cst'addr( cst )+double( p );                                  15845000
   smp := p;  << decrement exit address >>                              15850000
   if  bptab(i).(0:8) = 2  then                                         15855000
      begin  << a fake breakpoint >>                                    15860000
      ldad;  << get the pcal from the word >>                           15865000
      j := tos;  << save it >>                                          15870000
      tos := bptab(i+2);                                                15875000
      stad;  << restore the instruction >>                              15880000
      clear;  << remove the fake breakpoint >>                          15885000
      tos := tos-1;                                                     15890000
      tos := j;                                                         15895000
      stad;  << put the pcal back into the location >>                  15900000
out:  tos := olddb;                                            <<06872>>15905000
      set(db);                                                 <<06872>>15910000
      help'off;                                                <<06872>>15915000
      return;                                                  <<06872>>15920000
      end;                                                              15925000
   tos := bptab(i+2);  << restore instruction at breakpoint >>          15930000
   stad;  ddel;                                                         15935000
   tos := i;  << save i >>                                              15940000
   p := p+1;  << set a fake breakpoint >>                               15945000
   break( 2 );                                                          15950000
   i := tos;  << restore i >>                                           15955000
   tos := bptab(i+3).(8:8);   << get the bank >>               <<01778>>15960000
   tos := bptab(x:=x+1);  << get low order 16 bits >>                   15965000
   ldad;  << get test value >>                                          15970000
   tos := bptab(x:=x+1);   << get the constant >>                       15975000
   case  *bptab(i+3).(0:8)  of                                          15980000
      begin  << do the correct test >>                                  15985000
      ddel  << null >>;  << do it >>                                    15990000
         begin                                                          15995000
         x := i+4;                                                      16000000
         bptab(x) := bptab(x)-1;                                        16005000
         if  >  then  go out;  << not counted, so exit >>               16010000
         tos := bptab(x:=x+1);                                          16015000
         bptab(x:=x-1) := tos;  << reset the count >>                   16020000
         ddel;                                                          16025000
         end;                                                           16030000
      if  tos >= tos  then  go out;                                     16035000
      if  tos <> tos  then  go out;                                     16040000
      if  tos <= tos  then  go out;                                     16045000
      if  tos = tos  then  go out;                                      16050000
      begin help'mmstat; go out; end; << make a mmstat call >> <<06872>>16055000
      end;                                                              16060000
   ddel;                                                                16065000
   end;                                                                 16070000
                                                                        16075000
<< print the welcome message >>                                         16080000
print( 0 );  << newline >>                                              16085000
x := 4;  do  wrdio(x) := pre(x)  until  (x:=x-1)<0;                     16090000
numout( *, 5, 3 );                                                      16095000
numout( *, 9, 5 );                                                      16100000
print( 14 );                                                            16105000
push( s );  olds := tos;  << save for fail >>                           16110000
                                                                        16115000
<< command input loop >>                                                16120000
                                                                        16125000
comin:                                                                  16130000
                                                                        16135000
io := "-";  print( -1 );  << print the prompt >>                        16140000
getinput;   << get command string >>                                    16145000
cst := 0;                                                               16150000
x := num'cmnds - 1;                                            <<01364>>16155000
do                                                                      16160000
   begin                                                                16165000
   if comm(x) = token  then  go fnd;                                    16170000
   x := x-1;                                                            16175000
   end                                                                  16180000
until <;                                                                16185000
fail;  << illegal command >>                                            16190000
                                                                        16195000
fnd:  << legal command if you get here >>                               16200000
                                                                        16205000
com := x;  << save the command >>                                       16210000
char;  << scan off the command >>                                       16215000
p1 := 0d;                                                               16220000
if (com <> 4) and (com <> 6) then                              <<01364>>16225000
   begin  << get the parameters >>                                      16230000
   p1 := exp;                                                           16235000
   p2 := 0d;                                                            16240000
   p2f := false;                                                        16245000
   if  token = ","  and  com <> 1 then                                  16250000
      begin  << get a second parameter >>                               16255000
      char;                                                             16260000
      p2 := exp;                                                        16265000
      p2f := true;                                                      16270000
      end;                                                              16275000
   end                                                                  16280000
else  if (com = 4) and (token <> %15) then                     <<01364>>16285000
   begin  << get stack cut back parameter >>                            16290000
   p1 := sexp;                                                          16295000
   if  p1 > 255d  then  fail;                                           16300000
   end;                                                                 16305000
                                                                        16310000
if  token <> %15  and  com <> 0  then  fail;  << error >>               16315000
                                                                        16320000
case  *com  of                                                          16325000
   begin                                                                16330000
   break( 1 );                                                          16335000
   clear;                                                               16340000
   dump;                                                                16345000
   modify;                                                              16350000
   exit;                                                                16355000
   printioqs;                                                           16360000
   list;                                                       <<01364>>16365000
   end;                                                                 16370000
go comin;                                                               16375000
end;  << help >>                                                        16380000
                                                                        16385000
$control segment=main                                                   16390000
end.     << hardres >>                                                  16395000
