1 * ***********************************************************
   2 * *                                                         *
   3 * * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4 * *                                                         *
   5 * * Copyright (c) 1972 by Massachusetts Institute of        *
   6 * * Technology and Honeywell Information Systems, Inc.      *
   7 * *                                                         *
   8 * ***********************************************************
   9 
  10           lbl       ,polled_vip_tables
  11           ttl       polled_vip_tables
  12           editp     on
  13           pmc       off
  14           detail    off
  15           pcc       off
  16 *********************************************************************
  17 *
  18 *         polled_vip_tables
  19 *
  20 *         These control tables are designed to support the polled VIP
  21 *         communication protocol.  Both controller polling and
  22 *         round-robin station polling are available.
  23 *
  24 *         Coded November 1978 by Jerry Stern
  25 *
  26 *********************************************************************
  27           rem
  28 pvip      null
  29           rem
  30           symdef    pvstar
  31           rem
  32           symref    begin
  33           symref    hungup
  34           symref    adbyte
  35           symref    cvaddr
  36           rem
  37           pmc       save,on
  38           tib
  39           meters
  40           csbits
  41           tconst
  42           pmc       restore
  43           ttls      polled vip cct
  44           cctdef
  45           rem
  46 ct.eot    equ       ct.sw+ct.t0s+ct.syn
  47           rem
  48           rem
  49           base      64
  50 vipcct    null      * cct for polled vip
  51           rem       * table 0 - terminate on eot, ignore syn
  52           rem
  53           vfd       9/ct.ncs,9/ct.ncs * 000   001
  54           vfd       9/ct.ncs,9/ct.tb1 * 002   etx
  55           vfd       9/ct.eot,9/ct.ncs * eot   005
  56           vfd       9/ct.ncs,9/ct.ncs * 006   007
  57           vfd       9/ct.ncs,9/ct.ncs * 010   011
  58           vfd       9/ct.ncs,9/ct.ncs * 012   013
  59           vfd       9/ct.ncs,9/ct.ncs * 014   015
  60           vfd       9/ct.ncs,9/ct.ncs * 016   017
  61           vfd       9/ct.ncs,9/ct.ncs * 020   021
  62           vfd       9/ct.ncs,9/ct.ncs * 022   023
  63           vfd       9/ct.ncs,9/ct.ncs * 024   025
  64           vfd       9/ct.ign,9/ct.ncs * syn   027
  65           vfd       9/ct.ncs,9/ct.ncs * 030   031
  66           vfd       9/ct.ncs,9/ct.ncs * 032   033
  67           vfd       9/ct.ncs,9/ct.ncs * 034   035
  68           vfd       9/ct.ncs,9/ct.ncs * 036   037
  69           dup       1,48
  70           vfd       9/ct.ncs,9/ct.ncs * 040 - 177
  71           rem
  72           rem
  73           rem       * table 1 - store lrc char and switch to table 0
  74           rem
  75           dup       1,64
  76           vfd       9/ct.ncs,9/ct.ncs * 000 - 177
  77           rem
  78           rem
  79           rem
  80           start     pvip
  81           ttls      polled vip tib extension symbols
  82           tibex     poladr,char         /* poll address */
  83           tibex     argadr,char         /* address char subroutine arg */
  84           tibex     argsta,char         /* status char subroutine arg */
  85           tibex     inadr,char          /* input message address */
  86           tibex     insta,char          /* input message status char */
  87           tibex     outdev,char         /* output message device address */
  88           tibex     savdev,char         /* pending output message device address */
  89           tibex     repadr,char         /* station address for reply */
  90           tibex     reptyp,char         /* reply type - ack or nak */
  91           tibex     dspsta,char         /* display status */
  92           tibex     prtsta,char         /* printer status */
  93           tibex     blkend,char         /* end of block - etx or etb */
  94           rem
  95           tibex     stat0,word          /* line status/line control words */
  96           tibex     stat1,word
  97           tibex     stat2,word
  98           tibex     stat3,word
  99           tibex     nsbchn,word         /* number of subchannels */
 100           tibex     sbchn1,word         /* subchannel mask - part 1 */
 101           tibex     sbchn2,word         /* subchannel mask - part 2 */
 102           tibex     curadr,word         /* current poll address */
 103           tibex     inkcnt,word         /* count of consecutive naks for bad input */
 104           tibex     onkcnt,word         /* count of consecutive naks for bad output */
 105           tibex     itocnt,word         /* count of consecutive timeouts */
 106           tibex     msgcnt,word         /* count of status messages in input frame */
 107           tibex     qcount,word         /* count of consecutive quiescent responses */
 108           tibex     ptime,word          /* pause time between quiescent response cycles */
 109           tibex     wrtcnt,word         /* count of consecutive writes */
 110           tibex     echom1,word         /* echo mask - part 1 */
 111           tibex     echom2,word         /* echo mask - part 2 */
 112 
 113           rem
 114           tibex     tbxflg,word         /* flag word */
 115 idle      bool      000001    /* ON if polling stopped */
 116 quiet     bool      000002    /* ON if got quiescent input frame */
 117 datrcv    bool      000004    /* ON if got input during output */
 118 rflag     bool      000010    /* ON if reading while writing */
 119 textsw    bool      000020    /* ON if got text msg in input frame */
 120 rderr     bool      000040    /* ON if error reading input frame */
 121 cntrlr    bool      000100    /* ON if controller polling enabled */
 122 echosw    bool      000200    /* ON if CRLF echoing enabled */
 123 afrsw     bool      000400    /* ON to await first response */
 124 rdpar     bool      001000    /* ON if parity error in input frame */
 125 blderr    bool      002000    /* ON if bdbld done  */
 126           rem                 /* return label for error handling */
 127           tibex     rtnlbl,word
 128           ttls      polled vip constant symbols
 129 *** control characters ***
 130           rem
 131 dspdev    bool      140       /* display device address */
 132 prtdev    bool      150       /* printer device address */
 133 etb       bool      027
 134 prt       bool      032       /* printer message type */
 135 ctlpol    bool      010       /* controller poll address */
 136 eof       bool      400       /* special end-of-frame marker */
 137 pgof      bool      156       /* page overflow status char */
 138           rem
 139           rem
 140 *** line status types ***
 141           rem
 142 lstpst    equ       1         /* printer status */
 143 lstito    equ       2         /* input timeout */
 144 lstink    equ       3         /* input nak */
 145 lstonk    equ       4         /* output nak */
 146 lstbof    equ       5         /* bad output frame */
 147 lstoto    equ       6         /* output timeout */
 148 lstdst    equ       7         /* display status */
 149 lstchu    equ       8         /* i hung up the channel */
 150           rem
 151           rem
 152 *** line control types ***
 153           rem
 154 lctssp    equ       1         /* start station polling */
 155 lctscp    equ       2         /* start controller polling */
 156 lctstp    equ       3         /* stop polling */
 157 lctspt    equ       4         /* set pause time */
 158 lctsem    equ       5         /* set echo mask */
 159 lctafr    equ       6         /* awit first poll response */
 160           rem
 161           rem
 162 *** inscan control strings ***
 163           rem
 164 quiet1    chstr     (rescan,match,eot)
 165 quiet2    chstr     (match,eot)
 166 getsoh    chstr     (rescan,match,soh,ignore)
 167 mormsg    chstr     (search,soh,ignore)
 168 regmsg    chstr     (strlrc,movchr,inadr,nxtchr,movchr,insta,nxtchr,nxtchr,nx
 169           etc       tchr,match,stx,nxtchr,serch2,etx,etb,movchr,blkend,ignore
 170           etc       ,cmplrc,ignore)
 171 chgadr    chstr     (replac,repadr)
 172 skpmsg    chstr     (serch2,etx,etb,ignore,ignore,match,soh,ignore)
 173           rem
 174           rem
 175 *** outscn control strings ***
 176           rem
 177 outfrm    chstr     (rescan,endchn,match,eof,replac,eot,seteom)
 178 outadr    chstr     (rescan,search,soh,ignore,movchr,repadr,search,etx,ignore
 179           etc       ,ignore,search,soh,ignore,movchr,outdev)
 180 setlrc    chstr     (rescan,search,soh,ignore,strlrc,search,etx,ignore,outlrc
 181           etc       )
 182 nxtlrc    chstr     (search,soh,ignore,strlrc,search,etx,ignore,outlrc)
 183 setpol    chstr     (rescan,search,soh,ignore,replac,poladr)
 184           rem
 185           rem
 186 *** bldmsg control strings ***
 187           rem
 188 polmsg    chstr     (syn,syn,syn,syn,soh,poladr,null,space,space,stx,etx,spac
 189           etc       e,syn,syn,syn,syn,eot,seteom)
 190 repmsg    chstr     (syn,syn,syn,syn,soh,repadr,null,space,space,stx,etx,spac
 191           etc       e,syn,syn,syn,syn,soh,dspdev,reptyp,space,space,stx,etx,s
 192           etc       pace,syn,syn,syn,syn,eot,seteom)
 193           rem
 194 echmsg    chstr     (syn,syn,syn,syn,soh,repadr,null,space,space,stx,etx,spac
 195           etc       e,syn,syn,syn,syn,soh,dspdev,reptyp,space,space,stx,cr,nl
 196           etc       ,etx,space,syn,syn,syn,syn,eot,seteom)
 197           ttls      polled vip dialup and initialization
 198 *********************************************************************
 199 *
 200 *         Wait for line to dial up, i.e., wait for dsr to come on.
 201 *
 202 *********************************************************************
 203           rem
 204 pvstar    tstflg    tflisn,lisn         /* told to listen ? */
 205           wait      0,0,begin /* no, start over */
 206           rem
 207 lisn      tstflg    tfdlup,dulisn       /* handle dialup line */
 208           contrl    sdtr+srts+stat      /* ready full duplex line */
 209           wait      0,0,cklisn
 210           status    cts+dsr,0,ckdlup
 211           rem
 212 dulisn    contrl    sdtr+rrts+stat      /* ready halfduplex line */
 213           wait      0,0,cklisn
 214           status    dsr,0,ckdlup
 215           rem
 216 ckdlup    setime    1         /* wait for dsr to stabilize */
 217           wait      ckdsr,0,cklisn
 218           rem
 219 ckdsr     contrl    stat      /* find out if dsr is still up */
 220           wait      0,0,cklisn
 221           status    dsr,0,dialed        /* yes, this is a real dial up */
 222           status    0,dsr,hungup        /* no, dsr vanished */
 223           rem
 224 cklisn    tstflg    tfhang,hang
 225           tstflg    tflisn,golisn
 226           goto      hungup
 227 golisn    waitm
 228           rem
 229           rem
 230 *********************************************************************
 231 *
 232 *         Line has dialed up. Initialize and signal dialup.
 233 *
 234 *********************************************************************
 235           rem
 236 dialed    getext    ,hang1    /* cant do anything without a tib extension */
 237           setcct    vipcct
 238           config              /* configure send and rcv odd parity */
 239           smode     fg.lpr+fg.lps+fg.lpo
 240           rem
 241           setflg    tfmrcv    /* use message rcv mode */
 242           setlcl    ptime,1   /* default pause time = 1 sec */
 243           rem
 244           signal    dialup
 245           ttls      polled vip basic work loop
 246 *********************************************************************
 247 *
 248 *         Enter idle state.  Do nothing until told to start polling.
 249 *
 250 *********************************************************************
 251           rem
 252           setlcf    tbxflg,idle         /* set idle state */
 253 isleep    wait      0,0,tstate          /* wait for a line control order */
 254           status    0,dsr,hang
 255           rem
 256 notidl    clrlcf    tbxflg,idle         /* test-state handler transfers here */
 257           dumpin
 258           calsub    dmpall
 259           rem
 260           setlcl    qcount,0  /* initialize a few things */
 261           setlcl    wrtcnt,0
 262           clrlcf    tbxflg,quiet
 263           setchr    savdev,nochar
 264           setlcf    tbxflg,afrsw
 265           rem
 266           rem
 267 *********************************************************************
 268 *
 269 *         Find something to do.  If there is output, send it.  Otherwise,
 270 *         send a poll.  Before polling, however, see if we should pause.
 271 *
 272 *********************************************************************
 273           rem
 274 getwrk    setlcl    inkcnt,0  /* reset error counters */
 275           setlcl    onkcnt,0
 276           setlcl    itocnt,0
 277           rem
 278           tstlcl    wrtcnt,2,forcep     /* force poll after 2 consecutive writes */
 279           tstwrt    writef    /* have any output ? */
 280           tstlcf    tbxflg,idle,isleep /* if idle, go to sleep */
 281           rem
 282           tstlcf    tbxflg,quiet,qcycle /* last response was quiescent ? */
 283 forcep    setlcl    qcount,0  /* no, reset counter */
 284           goto      poll
 285           rem
 286 qcycle    tstlcl    ptime,0,poll        /* no pause wanted */
 287           tstlcf    tbxflg,cntrlr,pause /* controller polling enabled ? */
 288           addlcl    qcount,1  /* no, bump counter */
 289           tstlcv    qcount,nsbchn,pause /* finished quiescent cycle ? */
 290           goto      poll      /* no */
 291           rem
 292 pause     setlcl    qcount,0  /* reset counter */
 293           setimv    ptime     /* set timer */
 294           wait      poll,writef,tstate /* wait for timer or anything else */
 295           status    0,dsr,hang
 296           eject
 297 *********************************************************************
 298 *
 299 *         Send output if we have a complete frame.
 300 *
 301 *********************************************************************
 302           rem
 303 writef    addlcl    wrtcnt,1  /* bump write counter */
 304           clrlcf    tbxflg,quiet        /* for output, ignore quiescent response */
 305 ckeot     outscn    outfrm,noeot        /* is there a complete frame ? */
 306           signal    sndout    /* yes, start the next one coming */
 307           rem
 308           outscn    outadr,badout       /* repadr <- select addr, outdev <- device addr */
 309           setchr    savdev,outdev       /* save device address of this output */
 310           setchr    argadr,repadr
 311           calasm    swapps    /* convert select addr to poll addr */
 312           setchr    poladr,argadr       /* output frame ends with poll to this addr */
 313           meterm    1
 314           goto      sndfrm    /* send it */
 315           rem
 316 badout    dmpout              /* ugh, a bad output frame */
 317           setchr    savdev,nochar
 318           setlcl    stat0,lstbof        /* indicate bad output frame */
 319           linsta    stat0     /* send line status */
 320           goto      getwrk
 321           rem
 322 noeot     signal    sndout    /* ask for rest of frame */
 323           meter2    m.cnt4,1
 324           clrflg    tfwabt    /* so we can detect write abort at next wait */
 325           setime    5         /* wait at most 5 secs */
 326           wait      otosta,ckeot,tswabt
 327           status    0,dsr,hang
 328           rem
 329 otosta    setlcl    stat0,lstoto        /* indicate output timeouts status */
 330           linsta    stat0     /* send line status */
 331           dmpout              /* discard incomplete output */
 332           goto      getwrk
 333           eject
 334 *********************************************************************
 335 *
 336 *         Build a poll message.
 337 *
 338 *********************************************************************
 339           rem
 340 poll      setlcl    wrtcnt,0  /* reset write counter */
 341           setlcf    tbxflg,quiet        /* assume quiescent response */
 342           tstlcf    tbxflg,cntrlr,cpoll /* controller polling enabled ? */
 343           rem
 344           calasm    getspa    /* get station poll address */
 345           setchr    argadr,poladr
 346           calasm    swapps    /* convert to select address */
 347           setchr    repadr,argadr       /* and save for reply */
 348           goto      poll1
 349           rem
 350 bldfld    setlcl    stat0,lstchu        /* hung up the channel */
 351           linsta    stat0     /* tell host */
 352           goto      hang      /* and say goodbye */
 353           rem       /* if i've been here, tell host and hangup */
 354 bdbld     tstlcf    tbxflg,blderr,bldfld
 355           setime    1         /* wait 1 sec and then retry */
 356           wait      bldwt,0,tstate
 357           status    0,dsr,hang
 358 bldwt     setlcf    tbxflg,blderr /* note that i've been here */
 359           gotov     rtnlbl    /* back to where i'm told */
 360 
 361           rem
 362 cpoll     setchr    poladr,ctlpol       /* prepare for controller poll */
 363           setchr    repadr,nochar       /* don't know who will respond */
 364 poll1     clrlcf    tbxflg,blderr       /* reset */
 365           setlcl    rtnlbl,poll1a       /* where to go */
 366 poll1a    bldmsg    polmsg,bdbld        /* build the poll message */
 367 poll2     clrlcf    tbxflg,blderr       /* reset */
 368           setlcl    rtnlbl,poll2a
 369 poll2a    outscn    setlrc,bdbld
 370 poll3     setchr    outdev,nochar       /* no output device, i.e., not a select msg */
 371           eject
 372 *********************************************************************
 373 *
 374 *         Send the output frame and wait for a response.
 375 *
 376 *********************************************************************
 377           rem
 378 sndfrm    calsub    writer    /* enter rcv mode and write the frame */
 379           tstlcf    tbxflg,datrcv,read /* got input during write ? */
 380           tstlcf    tbxflg,rdpar,read /* got par err for input during write? */
 381           rem
 382           setime    3         /* set 3 second timeout */
 383           wait      timout,0,tstate
 384           status    0,dsr,hang
 385           status    brkchr,0,read
 386           status    exh,0,exhsta
 387           status    xte,0,xtesta
 388           status    parity,0,parsta
 389           rem
 390 timout    meter2    m.cnt3,1
 391           calsub    stprcv    /* timed out, leave rcv mode */
 392           dumpin              /* dump any incomplete input */
 393           clrlcf    tbxflg,quiet        /* did not get quiescent response */
 394           addlcl    itocnt,1  /* bump counter */
 395           tstlcl    itocnt,3,itosta /* too many timeouts ? */
 396           goto      sndfrm    /* not yet, send it again */
 397           rem
 398 itosta    tstlcf    tbxflg,afrsw,dmpfrm /* skip line status if waiting for response */
 399           setlcl    stat0,lstito        /* indicate input timeout status */
 400           setchr    argadr,repadr
 401           calasm    ldstat    /* put repadr in stat1 */
 402           linsta    stat0     /* send line status */
 403           rem
 404 dmpfrm    dmpout              /* dump whatever output we had */
 405           cmpchr    outdev,nochar,rstest /* if poll, check for pending output */
 406           setchr    savdev,nochar       /* no pending output */
 407           goto      getwrk    /* better luck next time */
 408           rem
 409 parsta    setlcf    tbxflg,rdpar        /* parity error on input */
 410           goto      read      /* meter it later */
 411 exhsta    meter2    m.exh,1
 412           goto      read
 413 xtesta    meter1    m.xte,1
 414           eject
 415 *********************************************************************
 416 *
 417 *         Got an input frame.  See what messages it contains.
 418 *
 419 *********************************************************************
 420           rem
 421 read      calsub    stprcv    /* exit rcv mode */
 422           clrlcf    tbxflg,afrsw        /* no longer awaiting first response */
 423           setlcl    itocnt,0  /* did not time out */
 424           tstlcf    tbxflg,rdpar,badpar /* parity error in input frame */
 425           setchr    reptyp,ack          /* default reply is an ack */
 426           setchr    dspsta,nak          /* default display status is NAK */
 427           setchr    prtsta,nochar       /* default printer status is none */
 428           clrlcf    tbxflg,textsw+rderr /* init these flags */
 429           setlcl    msgcnt,0  /* init status message count */
 430           rem
 431           inscan    quiet1,rdsoh        /* type 1 quiescent frame ? */
 432           goto      endfrm    /* yes */
 433 rdsoh     inscan    getsoh,sndnak       /* frame must start with soh */
 434           inscan    quiet2,notqui       /* type 2 quiescent message ? */
 435           goto      endfrm    /* yes */
 436 notqui    clrlcf    tbxflg,quiet        /* not a quiescent frame */
 437           rem
 438 rdloop    setchr    insta,nochar        /* init message status */
 439           setchr    inadr,nochar        /* init message address */
 440           setchr    blkend,nochar       /* init block end char */
 441           inscan    regmsg,badmsg       /* is there a regular message ? */
 442           goto      goodms    /* yes, looks good */
 443           rem
 444 badmsg    setlcf    tbxflg,rderr        /* a sick message */
 445           goto      nxtmsg
 446           rem
 447 badpar    meter1    m.par,1   /* meter the parity error */
 448           clrlcf    tbxflg,rdpar        /* reset the flag for next time */
 449           goto      sndnak    /* nak the input frame */
 450           rem
 451 goodms    cmpchr    poladr,ctlpol,ckmcnt /* sent controller poll ? */
 452           goto      notpol    /* no */
 453 ckmcnt    tstlcl    msgcnt,0,ispol      /* yes, is this first message ? */
 454           goto      notpol    /* no */
 455           rem
 456 ispol     setchr    argadr,inadr        /* get poll addr of responding station */
 457           calasm    swapps    /* convert to select address */
 458           setchr    repadr,argadr       /* that's who we reply to */
 459           goto      nxtmsg
 460           rem
 461 notpol    cmpchr    insta,null,txtmsg /* got a text message */
 462           cmpchr    insta,prt,txtmsg /* likewise */
 463           rem
 464           cmpchr    inadr,dspdev,dspsav /* got display status */
 465           cmpchr    inadr,prtdev,prtsav /* got printer status */
 466           rem
 467           goto      nxtmsg    /* got garbage */
 468           rem
 469 dspsav    setchr    dspsta,insta        /* save display status */
 470           goto      nxtmsg
 471           rem
 472 prtsav    setchr    prtsta,insta        /* save printer status */
 473           rem
 474 nxtmsg    inscan    mormsg,endfrm       /* more messages in input frame ? */
 475           addlcl    msgcnt,1  /* yes, bump status message count */
 476           goto      rdloop    /* process next message */
 477           rem
 478 endfrm    dumpin              /* discard the input */
 479           tstlcf    tbxflg,rderr,sndnak /* might have lost text msg, so send nak */
 480           goto      dostat
 481           rem
 482           rem
 483 *********************************************************************
 484 *
 485 *         Got a text message.  There can only be one text message per
 486 *         frame and it must be the last message.  See if we sent a
 487 *         controller poll.  If so, the first message of the frame
 488 *         will be a poll message which contains the responding station
 489 *         address.  If not, we must change the device address in the
 490 *         text message to a station address to identify the message
 491 *         source.
 492 *
 493 *********************************************************************
 494           rem
 495 txtmsg    tstlcf    tbxflg,rderr,sndnak /* get a clean frame */
 496           setlcf    tbxflg,textsw       /* remember getting text message */
 497           cmpchr    poladr,ctlpol,sndtxt /* sent controller poll ? */
 498           rem
 499           inscan    getsoh,sndnak       /* position to start of input frame */
 500 findtx    tstlcl    msgcnt,0,chgtxt     /* status message next ? */
 501           addlcl    msgcnt,-1 /* yes, decrement status message count */
 502           inscan    skpmsg,sndnak       /* skip the status message */
 503           goto      findtx    /* keep scanning for text message */
 504           rem
 505 chgtxt    inscan    chgadr,sndnak       /* change the address */
 506 sndtxt    meterm    0
 507           sendin              /* send input to Multics */
 508           goto      reply     /* send ack for text message */
 509           eject
 510 *********************************************************************
 511 *
 512 *         Got bad input.  Reply by sending a nak.
 513 *
 514 *********************************************************************
 515           rem
 516 sndnak    dumpin              /* discard bad input */
 517           meter2    m.cnt1,1
 518           clrlcf    tbxflg,quiet        /* not a quiescent response */
 519           setchr    reptyp,nak          /* reply type is nak */
 520           cmpchr    repadr,nochar,dostat /* station adress known ? */
 521           tstlcl    inkcnt,3,inksta     /* have we sent too many naks ? */
 522           addlcl    inkcnt,1  /* not yet, bump count */
 523           goto      reply
 524           rem
 525 inksta    setlcl    stat0,lstink        /* indicate input nak status */
 526           setchr    argadr,repadr
 527           calasm    ldstat    /* put repadr in stat1 */
 528           linsta    stat0     /* send line status */
 529           rem
 530           rem
 531 *********************************************************************
 532 *
 533 *         Reply     to input frame.  Send ack or nak frame.
 534 *
 535 *********************************************************************
 536           rem
 537 reply     cmpchr    reptyp,nak,reply3 /* ordinary nak message */
 538           tstlcf    tbxflg,echosw,reply2 /* echoing enabled ? */
 539           goto      reply3    /* no */
 540           rem
 541 reply2    calasm    testem    /* test echo mask for current station */
 542           tstlcl    temflg,0,reply3     /* temflg = 0 means don't echo */
 543           clrlcf    tbxflg,blderr       /* first time here */
 544           setlcl    rtnlbl,repl2a       /* set to come back there */
 545 repl2a    bldmsg    echmsg,bdbld        /* build reply frame with echo */
 546           goto      reply4
 547           rem
 548 reply3    clrlcf    tbxflg,blderr       /* reset */
 549           setlcl    rtnlbl,repl3a
 550 repl3a    bldmsg    repmsg,bdbld        /* build ordinary reply frame */
 551           rem
 552 reply4    clrlcf    tbxflg,blderr       /* reset */
 553           setlcl    rtnlbl,repl4a
 554 repl4a    outscn    setlrc,bdbld        /* put lrc on select message */
 555           clrlcf    tbxflg,blderr       /* reset */
 556           setlcl    rtnlbl,repl4b
 557 repl4b    outscn    nxtlrc,bdbld        /* put lrc on status message */
 558           rem
 559           calsub    write     /* send it */
 560           dmpout              /* and throw it away */
 561           eject
 562 *********************************************************************
 563 *
 564 *         Process saved input status.  Delete output unless it must
 565 *         be resent.  Note that the receipt of text input from a
 566 *         display implies that any output sent was ignored and must
 567 *         be resent.
 568 *
 569 *********************************************************************
 570           rem
 571 dostat    cmpchr    reptyp,nak,dspck /* did we nak the input ? */
 572           setlcl    inkcnt,0  /* no, reset counter */
 573           rem
 574 dspck     cmpchr    outdev,dspdev,dspsnt /* sent display output ? */
 575           goto      prtck1    /* no */
 576           rem
 577 dspsnt    setchr    argsta,dspsta       /* set arg for cknak subr */
 578           calsub    cknak     /* check for nak status */
 579           cmpchr    argsta,nak,prtck2 /* was it nak ? */
 580           cmpchr    dspsta,pgof,dsplst /* was it PGOF ? */
 581           goto      txtck     /* no */
 582           rem
 583 dsplst    setlcl    stat0,lstdst        /* send line status */
 584           setchr    argadr,repadr
 585           calasm    ldstat    /* put repadr and dspsta in stat1 */
 586           linsta    stat0
 587           rem
 588 txtck     tstlcf    tbxflg,textsw,prtck2 /* text message received ? */
 589           goto      delout    /* no, discard the output */
 590           rem
 591 prtck1    cmpchr    outdev,prtdev,prtsnt /* sent printer output ? */
 592           goto      prtck2    /* no */
 593           rem
 594 prtsnt    setchr    argsta,prtsta       /* set arg for cknak subr */
 595           calsub    cknak     /* check for nak status */
 596           cmpchr    argsta,nak,rptest /* was it nak ? */
 597           rem
 598 delout    dmpout              /* discard the output frame */
 599           setchr    savdev,nochar       /* no output pending */
 600           rem
 601 prtck2    cmpchr    prtsta,nochar,rptest /* got printer status ? */
 602           setlcl    stat0,lstpst        /* indicate printer status */
 603           setchr    argadr,repadr
 604           setchr    argsta,prtsta
 605           calasm    ldstat    /* put repadr and prtsta in stat1 */
 606           linsta    stat0     /* send line status */
 607           eject
 608 *********************************************************************
 609 *
 610 *         See if it is necessary to repoll the same station.
 611 *
 612 *********************************************************************
 613           rem
 614 rptest    cmpchr    repadr,nochar,ckdel /* station adress known ? */
 615           cmpchr    reptyp,nak,rptst2 /* did we nak the input ? */
 616           tstlcf    tbxflg,textsw,cketb /* got a text message ? */
 617           goto      ckdel     /* no, don't have to repoll */
 618           rem
 619 cketb     cmpchr    blkend,etb,rptst2 /* did text block end with etb ? */
 620           goto      ckdel     /* no */
 621           rem
 622 rptst2    cmpchr    outdev,nochar,rptst3 /* last output was a poll, reuse it */
 623           goto      poll1     /* build a poll message */
 624           rem
 625 rptst3    cmpchr    poladr,ctlpol,rptst4 /* was last poll to controller ? */
 626           goto      poll3     /* no, already have station poll */
 627           rem
 628 rptst4    setchr    argadr,repadr       /* get station select address */
 629           calasm    swapps    /* convert to poll address */
 630           setchr    poladr,argadr
 631           clrlcf    tbxflg,blderr       /* reset */
 632           setlcl    rtnlbl,rptst5
 633 rptst5    outscn    setpol,bdbld        /* update into poll message */
 634           goto      poll2
 635           rem
 636 ckdel     cmpchr    outdev,nochar,delpol /* was last output a poll ? */
 637           goto      rstest    /* no */
 638 delpol    dmpout              /* yes, delete it */
 639           rem
 640           rem
 641 *********************************************************************
 642 *
 643 *         Check for pending output to be resent.
 644 *
 645 *********************************************************************
 646           rem
 647 rstest    cmpchr    savdev,nochar,getwrk /* if no saved output, start at top */
 648           setchr    outdev,savdev       /* saved output now current again */
 649           goto      sndfrm    /* resend it */
 650           ttls      polled vip test-state handler
 651 *********************************************************************
 652 *
 653 *         Test-state handler.
 654 *
 655 *********************************************************************
 656           rem
 657 tstate    tstflg    tfhang,hang
 658           linctl    stat0,tsret         /* check for line control */
 659           tstlcl    stat0,lctssp,setspl /* start station polling */
 660           tstlcl    stat0,lctscp,setcpl /* start controller polling */
 661           tstlcl    stat0,lctstp,poloff /* stop polling */
 662           tstlcl    stat0,lctspt,setpt /* set pause time */
 663           tstlcl    stat0,lctsem,echomk /* set echo mask */
 664           tstlcl    stat0,lctafr,setafr /* set await first response switch */
 665 tsret     waitm
 666           rem
 667 setspl    tstlcl    stat1,0,poloff      /* if zero subchan count, stop polling */
 668           tstlcl    stat2,0,cksta3      /* first part of subchan mask is zero ? */
 669           goto      dossp     /* no */
 670 cksta3    tstlcl    stat3,0,poloff      /* if zero subchan mask, stop polling */
 671           rem
 672 dossp     setlcv    nsbchn,stat1        /* copy subchannel count */
 673           setlcv    sbchn1,stat2        /* copy subchannel mask */
 674           setlcv    sbchn2,stat3
 675           setlcl    curadr,0  /* init current station address */
 676           clrlcf    tbxflg,cntrlr       /* disable controller polling */
 677           rem
 678           tstlcf    tbxflg,idle,notidl /* if idle, go to work */
 679           waitm
 680           rem
 681 setcpl    setlcf    tbxflg,cntrlr       /* enable controller polling */
 682           tstlcf    tbxflg,idle,notidl /* if idle, go to work */
 683           waitm
 684           rem
 685 poloff    setlcf    tbxflg,idle         /* enter idle state */
 686           waitm
 687           rem
 688 setpt     setlcv    ptime,stat1         /* set pause time */
 689           waitm
 690           rem
 691 echomk    setlcv    echom1,stat2        /* save echo mask */
 692           setlcv    echom2,stat3
 693           tstlcl    stat1,0,noecho      /* stat1 = 0 means null mask */
 694           setlcf    tbxflg,echosw
 695           waitm
 696 noecho    clrlcf    tbxflg,echosw
 697           waitm
 698           rem
 699 setafr    setlcf    tbxflg,afrsw        /* await first poll response */
 700           waitm
 701           rem
 702 tswabt    tstflg    tfwabt,wabort       /* check for write abort */
 703           goto      tstate    /* nope, do standard test-state stuff */
 704 wabort    dmpout              /* discard output */
 705           goto      getwrk
 706           ttls      polled vip hangup and punt handlers
 707 *********************************************************************
 708 *
 709 *         Come here to hang up the line.
 710 *
 711 *********************************************************************
 712           rem
 713 hang      unwind              /* in case we jumped out of a subroutine */
 714           retext              /* free tib extension */
 715 hang1     stpchn
 716           dumpin
 717           calsub    dmpall
 718           rem
 719           contrl    rdtr      /* drop dtr */
 720           clrflg    (tflisn,tfhang)
 721           signal    hangup
 722           goto      hungup
 723           ttls      polled vip write subroutine
 724 ************************************************************************
 725 *
 726 *         subroutine to write the current output stuff.
 727 *         it can be called at "write", in which case only output
 728 *         is done, or it can be called at "writer", which
 729 *         also sets receive mode during the output. the flag
 730 *         "datrcv" in the tib ext will be set if data is read while
 731 *         the output is in progress.
 732 *
 733 *         this routine was adapted from the bsc_tables counterpart
 734 *
 735 ************************************************************************
 736           rem
 737 write     clrlcf    tbxflg,rflag        /* remember which entry */
 738           goto      write1
 739           rem
 740 writer    setlcf    tbxflg,rflag
 741           rem
 742 write1    setime    0
 743           clrlcf    tbxflg,datrcv
 744           holdot              /* hold all output */
 745           rem
 746           tstflg    tfdlup,write3       /* half duplex */
 747           goto      write4    /* full duplex */
 748           rem
 749 write3    tstlcf    tbxflg,rflag,write5 /* choose between dcw lists */
 750           dcwlst
 751           cmd       sxmit+srts
 752           output    (outmsg)
 753           cmd       rxmit+rrts+sterm
 754           goto      write6
 755           rem
 756 write5    dcwlst
 757           cmd       sxmit+srec+srts
 758           output    (outmsg)
 759           cmd       rxmit+rrts+sterm
 760           goto      write6
 761           rem
 762 write4    tstlcf    tbxflg,rflag,write7 /* choose between fulldpx dcwlists */
 763           dcwlst
 764           cmd       sxmit
 765           output    (outmsg)
 766           cmd       rxmit+sterm
 767           goto      write6
 768           rem
 769 write7    dcwlst
 770           cmd       sxmit+srec
 771           output    (outmsg)
 772           cmd       rxmit+sterm
 773           rem
 774 write6    wait      0,0,tstate          /* common wait block */
 775           status    0,dsr,hang
 776           status    term,0,write9
 777           status    brkchr,0,write8     /* got input during output */
 778           status    parity,0,write2
 779           rem
 780 write2    setlcf    tbxflg,rdpar        /* remember parity error on input frame */
 781           waitm                         /* continue waiting for output to finish */
 782           rem
 783 write8    setlcf    tbxflg,datrcv       /* remember data came in */
 784           waitm
 785           rem
 786 write9    retsub
 787           ttls      polled vip utility routines
 788 *********************************************************************
 789 *
 790 *         Routine to exit receive mode.
 791 *
 792 *********************************************************************
 793           rem
 794 stprcv    contrl    rrec+smark
 795           wait      0,0,tstate
 796           status    marker,0,rcvoff
 797           rem
 798 rcvoff    retsub
 799           rem
 800           rem
 801 *********************************************************************
 802 *
 803 *         Routine to dump all output.
 804 *
 805 *********************************************************************
 806           rem
 807 dmpall    dmpout
 808           tstwrt    dmpall
 809           retsub
 810           rem
 811           rem
 812 *********************************************************************
 813 *
 814 *         Routine to handle received nak status.
 815 *
 816 *********************************************************************
 817           rem
 818 cknak     cmpchr    argsta,nak,cknak2 /* got a nak ? */
 819           setlcl    onkcnt,0  /* no, reset counter */
 820           retsub
 821           rem
 822 cknak2    meter2    m.cnt2,1
 823           addlcl    onkcnt,1  /* bump count */
 824           tstlcl    onkcnt,3,cknak3     /* too many naks received ? */
 825           retsub
 826           rem
 827 cknak3    setlcl    onkcnt,0  /* pretend it was an ack */
 828           setchr    argsta,ack
 829           rem
 830           setlcl    stat0,lstonk        /* indicate output nak status */
 831           setchr    argadr,repadr
 832           calasm    ldstat    /* put repadr in stat1 */
 833           linsta    stat0     /* send line status */
 834           retsub
 835           ttls      polled vip assembler routines
 836 *********************************************************************
 837 *
 838 *         swapps - swap poll/select
 839 *
 840 *         converts the address specified by argadr from a poll address
 841 *         to a corresponding select address or vice versa.
 842 *
 843 *********************************************************************
 844           rem
 845 swapps    subr      sps,(x3)
 846           rem
 847           lda       l.a000-*  (=argadr) get addr of argadr
 848           tsy       a.a000-*,*          (=adbyte) convert it
 849           oct       0         conversion failed, die
 850           lda       0,3,b.0   get value of argadr
 851           iera      96        flip the poll/select bits
 852           sta       0,3,b.0   update argadr
 853           rem
 854           return    swapps
 855           eject
 856 *********************************************************************
 857 *
 858 *
 859 *         ldstat - load status
 860 *
 861 *         Stores an address character (argadr) and a status
 862 *         character (argsta) into stat1.
 863 *
 864 *********************************************************************
 865           rem
 866 ldstat    subr      lds,(x3)
 867           rem
 868           lda       l.a003-*  (=argsta) get addr of argsta
 869           tsy       a.a000-*,*          (=adbyte) convert it
 870           oct       0         conversion failed, die
 871           lda       0,3,b.0   get value of argsta
 872           lrs       9         shift into q
 873           stq       ldstmp-*  save it
 874           rem
 875           lda       l.a000-*  (=argadr) get addr of argadr
 876           tsy       a.a000-*,*          convert it
 877           oct       0         conversion failed, die
 878           lda       0,3,b.0   get value of argadr
 879           ldq       ldstmp-*  get back argsta
 880           lrs       9         combine with argadr
 881           rem
 882           ldx3      l.a004-*  (=stat1) get addr of stat1
 883           tsy       a.a001-*,*          (=cvaddr) convert it
 884           stq       0,3       store status in stat1
 885           rem
 886           return    ldstat
 887           rem
 888 ldstmp    bss       1
 889           eject
 890 *********************************************************************
 891 *
 892 *         getspa - get station poll address
 893 *
 894 *         Computes the address of the next station to poll based on the
 895 *         subchannel configuration data.  Stores the poll address in
 896 *         poladr.
 897 *
 898 *********************************************************************
 899           rem
 900 getspa    subr      gsp,(x2,x3)
 901           rem
 902           ldx3      l.a006-*  (=sbchn1) get addr of sbchn1
 903           tsy       a.a001-*,*          (=cvaddr) convert it
 904           lda       0,3       get value of sbchn1
 905           ldq       1,3       get value of sbchn2 (assumed adjacent)
 906           staq      gspsc-*   save subchannel mask
 907           rem
 908           ldx3      l.a010-*  (=curadr) get addr of curadr
 909           tsy       a.a001-*,*          (=cvaddr) convert it
 910           lda       0,3       get value of curadr
 911           ora       l.a009-*  (=llr 0) make llr instruction
 912           sta       gsp010-*  put in place
 913           rem
 914           ldaq      gspsc-*   get subchannel mask
 915 gsp010    llr       0         rotate to current subchan
 916           rem
 917           ldx2      l.a007-*  (=37) init shift counter
 918 gsp020    iacx2     -1        decrement shift counter
 919           tze       gsp025-*  error, no subchans found
 920           llr       1         rotate subchan mask
 921           tmi       gsp030-*  subchan is configured
 922           tra       gsp020-*  keep looking
 923           rem
 924 gsp025    oct       0         die
 925           rem
 926 gsp030    stx2      gsptmp-*  store shift counter
 927           lda       l.a007-*  (=37) get original value
 928           sba       gsptmp-*  get number of shifts
 929           ada       0,3       add in starting address
 930           cmpa      l.a008-*  (=36) did we wrap around ?
 931           tmi       gsp035-*  no
 932           sba       l.a008-*  (=36) yes, normalize
 933 gsp035    sta       0,3       update curadr
 934           sta       gsptmp-*  save a copy
 935           rem
 936           lda       l.a001-*  (=poladr) get addr of poladr
 937           tsy       a.a000-*,*          (=adbyte) convert it
 938           oct       0         conversion failed, die
 939           ldq       gsptmp-*  get current subchan addr
 940           iaq       32        convert to poll addr
 941           stq       0,3,b.0   update poladr
 942           rem
 943           return    getspa
 944           rem
 945           even
 946 gspsc     bss       2
 947 gsptmp    bss       1
 948           eject
 949 ******************************************************************
 950 *
 951 *         testem - test echo mask
 952 *
 953 *         tests the echo mask to see if echoing is required for
 954 *         the station whose select address is given by repadr.
 955 *
 956 ******************************************************************
 957           rem
 958 testem    subr      tem,(x3)
 959           rem
 960           ldx3      l.a002-*  (=echom1) get addr of echom1
 961           tsy       a.a001-*,*          (=cvaddr) convert it
 962           lda       0,3       get value of echom1
 963           ldq       1,3       get value of echom2 (assumed adjacent)
 964           staq      temdbl-*  save echo mask
 965           rem
 966           lda       l.a005-*  (=repadr) get addr of repadr
 967           tsy       a.a000-*,*          (=adbyte) convert it
 968           oct       0         conversion failed, die
 969           lda       0,3,b.0   get value of repadr
 970           iana      31        mask out high-order bits
 971           ora       l.a009-*  (=llr 0) make llr instruction
 972           sta       tem010-*  put in place
 973           rem
 974           ila       1
 975           sta       temflg-*  assume echo enabled
 976           rem
 977           ldaq      temdbl-*  get back echo mask
 978 tem010    llr       0         rotate to station of interest
 979           tmi       temret-*  echo is enabled
 980           stz       temflg-*  echo is disabled
 981           rem
 982 temret    return    testem
 983           rem
 984           even
 985 temdbl    bss       2
 986 temflg    bss       1
 987           eject
 988 l.a000    vfd       18/argadr
 989 l.a001    vfd       18/poladr
 990 l.a002    vfd       18/echom1
 991 l.a003    vfd       18/argsta
 992 l.a004    vfd       18/stat1
 993 l.a005    vfd       18/repadr
 994 l.a006    vfd       18/sbchn1
 995 l.a007    dec       37
 996 l.a008    dec       36
 997 l.a009    llr       0
 998 l.a010    vfd       18/curadr
 999 l.a011    oct       377777
1000           rem
1001 a.a000    ind       adbyte
1002 a.a001    ind       cvaddr
1003           rem
1004           end