1 ***********************************************************
2 * *
3 * *
4 * Copyright, C Honeywell Information Systems Inc., 1981 *
5 * *
6 * *
7 ***********************************************************
8 rem
9 lbl ,hasp_tables
10 ttl hasp_tables -- control tables for hasp protocol
11 editp on
12 pcc off
13 pmc off
14 detail off
15 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
16 *
17 * hasp_tables
18 *
19 * These tables provide the special processing for a BISYNC
20 * line utilizing the HASP multi-leaving protocol
21 *
22 * Created: September 1979 by Larry Johnson
23 * Modified: November-December 1980 by G. Palter to implement
24 * infinite initial connection timeout, properly report NAK
25 * limit overflows to Multics, and fix many minor bugs
26 * Modified: 30 March 1981 by G. Palter to fix bug in slave
27 * idle loop handling of NAKs
28 * Modified: 9 April 1981 by G. Palter to fix bug in slave
29 * idle loop reporting of NAK limit overflow
30 * Modified: July 1981 by G. Palter to add metering and
31 * support for SIGNON/runout processing and to remove the
32 * limitation in slave CPU initialization
33 * Modified: 24 August 1981 by G. Palter to make wraparounds
34 * nest by counting foreign devices going not ready and
35 * the corresponding sync-blocks from the CS
36 * Modified: 28 December 1981 by G. Palter to fix another
37 * case where the slave idle loop wasn't detecting
38 * too many sequential NAKs
39 * Modified: June 1982 by Robert Coren for extended memory
40 * Modified: February 1984 by G. Palter to properly implement
41 * the system wait-a-bit and to insure that the "Too Many
42 * NAKs" line status get through to the CS
43 *
44 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
45 rem
46 symdef sthasp start of hasp tables
47 rem
48 symref bsctst bisync test state handler
49 symref bscwt bisync write routine
50 symref bscwtr bisync write/read routine
51 symref bscrd bisync read routine
52 symref bsccki bisync check input routine
53 symref bsccko bisync check output routine
54 symref bshang bisync hangup routine
55 symref bscbad bisync report bad block routine
56 rem
57 symref setbpt
58 symref adbyte interpreter byte addressing rtn
59 symref cvaddr interpreter word addressing rtn
60 rem
61 hasp null
62 rem
63 start hasp,,c3hspm0b0000
64 pmc save,on
65 tib
66 meters
67 csbits
68 tconst
69 buffer
70 bscdat
71 pmc restore
72 ttls HASP symbol definitions
73 rem
74 rem /* input scan control strings */
75 rem
76 inack chstr rescanmatchdleignorematchtiback
77 innak chstr rescanmatchtibnak
78 ininit chstr rescanmatchsohignorematchenq
79 rem
80 rem /* output bldmsg control strings */
81 rem
82 otack chstr dletibackseteom
83 otnak chstr tibnakseteom
84 otinit chstr sohenqseteom
85 rem
86 rem /* Local system not-ready idle message */
87 rem
88 libcb bool 220 /* BCB: ignore block count */
89 lifcs1 bool 300 /* FCS 1: system wait-a-bit */
90 lifcs2 bool 200 /* FCS 2: all devices not ready */
91 otsidl chstr dlestxlibcblifcs1lifcs2000dleetbseteom
92 rem
93 rem /* definitions of fcs bits */
94 rem
95 fcs1sb bool 100 /* system wait-a-bit */
96 fcs1nr bool 040 /* 1 = some device went not-ready */
97 fcs1rt bool 020 /* 1 = this is output being returned */
98 fcs1pr bool 017 /* printer wait-a-bits */
99 rem
100 fcs2ty bool 100 /* tty wait-a-bit */
101 fcs2pn bool 017 /* punch wait-a-bits */
102 rem
103 fcs2bt bool 060 /* contains block type set by CS */
104 fcs2ra bool 020 /* 01 = tell CS when block is sent */
105 fcs2sy bool 060 /* 11 = this is resync msg */
106 rem
107 allon equ 512*fcs1pr+fcs2ty+fcs2pn /* "1" for all device wait-a-bits */
108 rem /* includes fcs1 and fcs2 */
109 ttls HASP initialization
110 **********************************************************************
111 *
112 * Wait for Multics to perform proper initialization
113 * by watching for the 'allow bid' line control order
114 *
115 **********************************************************************
116 rem
117 sthasp setflg tfmrcv /* we are msg-receive device */
118 clrlcf exflg1,naksw+nakksw+wacksw+datrcv+cfgok+rflag
119 clrlcf exflg1,ttdsw+ntrsw+rvisw+needrv+ctlmsg
120 clrlcf exflg2,lookot+gotot+timout+polpnd+pollok+selop
121 clrlcf exflg2,pollsw+autopl+outarv+dialos+csreqa
122 clrlcf exflg2,lswabs+fswabs+fnrcba
123 setlcl testrt,testst /* establish our test-state handler */
124 setchr tiback,ack0
125 setlcl wabmsk,0 /* init all wait-a-bits off */
126 setlcl wrpcnt,0 /* don't need any sync-blocks to get started */
127 rem
128 tstlcf exflg1,alwbid,ini020 /* initialization already done? */
129 setlcl naklmt,10 /* set default values */
130 setlcl hcontm,30
131 setlcl hrcvtm,3
132 setlcl hxmttm,2
133 wait 0,0,ini010 /* watch for line status */
134 status 0,dsr,bshang /* don't miss hangups */
135 rem
136 ini010 tstflg tfhang,bshang /* forced hangup */
137 linctl ctlop,bsctst /* see if line status */
138 tstlcl ctlop,lctabd,ini020 /* if so, see if allow bid */
139 goto bsctst /* no, let bsc test state handler do it */
140 rem
141 ini020 setlcf exflg1,alwbid /* setup complete */
142 tstlcf exflg2,master,ini050 /* master */
143 eject
144 **********************************************************************
145 *
146 * slave device initialization cpu
147 *
148 **********************************************************************
149 rem
150 tstlcl hcontm,0,ini030 /* no connect timeout requested */
151 setlcv temp1,hcontm /* connect time limit */
152 setlcv temp2,hrcvtm /* receive time limit for waiting for connect */
153 calasm calcbl /* divide to calculate retry count */
154 setlcv bidcnt,temp1
155 rem
156 ini030 setimv hrcvtm /* wait for initialization message */
157 contrl srec
158 calsub bscrd
159 tstlcf exflg2,timout,ini040 /* no message in time... */
160 rem
161 inscan ininit,ini040 /* initialization message? */
162 dumpin
163 bldmsg otack,punt /* yes: acknowledge */
164 holdot
165 calsub bscwtr
166 dmpout
167 setlcl ctlop,lsthin /* report HASP initialized */
168 setlcl ctlvl1,0 /* as a slave */
169 linsta ctlop
170 goto slv000
171 rem
172 ini040 dumpin /* discard any garbage */
173 tstlcl hcontm,0,ini030 /* no connect timeout: retry */
174 addlcl bidcnt,1
175 tstlcl bidcnt,0,bshang /* too many tries: punt */
176 goto ini030
177 eject
178 **********************************************************************
179 *
180 * master device initialization terminal
181 *
182 **********************************************************************
183 rem
184 ini050 tstlcl hcontm,0,ini060 /* no connect timeout requested */
185 setlcv temp1,hcontm /* connect time limit */
186 setlcv temp2,hrcvtm /* receive time limit for waiting for replies */
187 calasm calcbl /* divide to calculate retry count */
188 setlcv bidcnt,temp1
189 rem
190 ini060 bldmsg otinit,punt /* initialization msg */
191 holdot
192 calsub bscwtr /* write it */
193 dmpout
194 rem
195 setimv hrcvtm
196 calsub bscrd /* wait for reply */
197 tstlcf exflg2,timout,ini070 /* no response */
198 rem
199 inscan inack,ini070 /* good response? */
200 dumpin
201 setlcl ctlop,lsthin /* report HASP initialized */
202 setlcl ctlvl1,1 /* as a master */
203 linsta ctlop
204 goto mstidl
205 rem
206 ini070 dumpin /* throw away and try again */
207 tstlcl hcontm,0,ini060 /* no connect timeout so retry */
208 addlcl bidcnt,1
209 tstlcl bidcnt,0,bshang /* too many tries */
210 goto ini060
211 ttls HASP idle state handlers
212 **********************************************************************
213 *
214 * master channel idle state handler
215 *
216 **********************************************************************
217 rem
218 mstidl calsub chkout /* see if output ready */
219 tstlcl result,resack,haspwr /* yes */
220 setimv hxmttm /* we ack every two seconds */
221 rem
222 wait mst020,mst010,bsctst
223 status 0,dsr,bshang
224 rem
225 mst010 dumpin /* just in case */
226 setlcf exflg2,outarv /* output arrived */
227 calsub chkout /* examine it */
228 tstlcl result,resack,haspwr /* ready to go */
229 waitm
230 rem
231 mst020 dumpin /* nothing to write: send idle block */
232 setlcl nakcnt,0
233 mst025 tstlcf exflg2,lswabs,mst026
234 bldmsg otack,punt /* ... either an ACK */
235 goto mst030
236 mst026 bldmsg otsidl,punt /* ... or local not-ready */
237 rem
238 mst030 holdot
239 calsub bscwtr /* write the idle message */
240 dmpout
241 rem
242 setimv hrcvtm /* wait for reply */
243 calsub bscrd
244 tstlcf exflg2,timout,mst035 /* timeout */
245 tstlcf exflg1,naksw,mst055 /* CRC error */
246 inscan inack,mst040 /* is it an ACK? */
247 rem /* foreign side sent an ACK ... */
248 tstlcf exflg2,fswabs,mst031 /* ... was foreign not ready? */
249 goto mst032 /* ... ... no */
250 mst031 clrlcf exflg2,fswabs /* ... ... yes: ACK resets not ready */
251 setlcl ctlop,lsthfr /* ... ... and we must inform CS */
252 linsta ctlop
253 mst032 dumpin /* ... discard the ACK ... */
254 meter2 m.cnt5,1 /* ... and count a trip through idle loop */
255 goto mstidl
256 rem
257 mst035 meter2 m.cnt4,1 /* count timeout waiting for reply */
258 goto mst070
259 rem
260 mst040 inscan innak,mst050 /* was it a nak? */
261 meter2 m.cnt2,1 /* yes: count NAK to our output ... */
262 dumpin
263 addlcl nakcnt,1
264 tstlcv nakcnt,naklmt,mst045 /* report nak limit to mcs? */
265 goto mst025 /* no: retry the ack */
266 mst045 signal quit /* yes */
267 setlcl ctlop,lstnak
268 linsta ctlop
269 goto mst025 /* retry the ack */
270 rem
271 mst050 calasm bsccki /* detailed scan */
272 tstlcl result,resack,mst060 /* good */
273 tstlcl result,resntr,mst060
274 mst055 meter2 m.cnt1,1 /* bad input: count NAK we send */
275 goto mst070
276 rem
277 mst060 calsub chkdia /* be sure dia caught up */
278 tstlcf exflg2,dialos,mst065 /* no, must nak for breather */
279 calsub inproc /* ship good data */
280 calsub chkout /* anything more to write */
281 tstlcl result,resack,haspwr /* yes */
282 goto mst020 /* no, just ack */
283 rem
284 mst065 meter2 m.cnt6,1 /* count inability to take input */
285 rem
286 mst070 dumpin /* timeout or garbage */
287 addlcl nakcnt,1
288 tstlcv nakcnt,naklmt,mst075 /* report nak limit to mcs? */
289 goto mst080 /* no: just send nak */
290 mst075 signal quit /* yes */
291 setlcl ctlop,lstnak
292 linsta ctlop
293 rem
294 mst080 bldmsg otnak,punt /* send nak */
295 goto mst030
296 eject
297 **********************************************************************
298 *
299 * slave channel idle state handler
300 *
301 **********************************************************************
302 rem
303 slv000 contrl srec
304 slv005 setlcl nakcnt,0
305 slv010 setimv hrcvtm
306 calsub bscrd
307 tstlcf exflg2,timout,slv040 /* timeout */
308 tstlcf exflg1,naksw,slv035 /* CRC error */
309 inscan inack,slv020 /* ack? */
310 goto slv050 /* yes */
311 rem
312 slv020 inscan innak,slv030 /* nak? */
313 dumpin /* yes: flush it ... */
314 meter2 m.cnt2,1 /* ... count NAK to our output ... */
315 addlcl nakcnt,1
316 tstlcv nakcnt,naklmt,slv025 /* ... report NAK limit to MCS? ... */
317 goto slv026 /* ... ... no */
318 slv025 signal quit /* ... ... yes */
319 setlcl ctlop,lstnak
320 linsta ctlop
321 slv026 tstlcf exflg2,lswabs,slv027 /* ... resend the idle block */
322 bldmsg otack,punt /* ... ... which is an ACK */
323 goto slv028
324 slv027 bldmsg otsidl,punt /* ... ... or local not-ready */
325 slv028 holdot
326 calsub bscwtr
327 dmpout
328 goto slv010 /* ... and not a completed cycle */
329 rem
330 slv030 calasm bsccki /* detailed scan */
331 tstlcl result,resack,slv080 /* good data */
332 tstlcl result,resntr,slv080
333 slv035 meter2 m.cnt1,1 /* bad input: count NAK we send */
334 goto slv041
335 rem
336 slv040 meter2 m.cnt3,1 /* count timeout waiting for input */
337 slv041 dumpin /* discard garbage */
338 addlcl nakcnt,1
339 tstlcv nakcnt,naklmt,slv045 /* report nak limit to mcs? */
340 goto slv046 /* no: just send nak */
341 slv045 signal quit /* yes */
342 setlcl ctlop,lstnak
343 linsta ctlop
344 rem
345 slv046 bldmsg otnak,punt /* send nak */
346 holdot
347 calsub bscwtr
348 dmpout
349 goto slv010
350 rem
351 rem /* foreign side sent an ACK ... */
352 slv050 tstlcf exflg2,fswabs,slv051 /* ... was foreign not ready? */
353 goto slv052 /* ... ... no */
354 slv051 clrlcf exflg2,fswabs /* ... ... yes: ACK resets not ready */
355 setlcl ctlop,lsthfr /* ... ... and we must inform CS */
356 linsta ctlop
357 slv052 dumpin /* ... discard the ACK ... */
358 meter2 m.cnt5,1 /* ... and count a trip through idle loop */
359 rem
360 tstlcf exflg2,lswabs,slv053 /* are we not ready? */
361 goto slvidl /* ... no */
362 slv053 setimv hxmttm /* ... yes: give CS time to become ready */
363 wait slvidl,slv055,bsctst
364 status 0,dsr,bshang
365 slv055 setlcf exflg2,outarv /* ... ... output has arrived */
366 calsub chkout /* ... ... see if it is complete */
367 tstlcl result,resack,haspwr /* ... ... yes: send it */
368 waitm
369 rem
370 rem /* Control arrives here after processing input */
371 slvidl calsub chkout /* see if something to send */
372 tstlcl result,resack,haspwr
373 rem
374 tstlcf exflg2,lswabs,slv061 /* no: send an idle block */
375 bldmsg otack,punt /* ... which is an ACK */
376 goto slv062
377 slv061 bldmsg otsidl,punt /* ... or local not-ready */
378 slv062 holdot
379 calsub bscwtr
380 dmpout
381 goto slv005
382 rem
383 slv080 calsub chkdia /* be sure dia caught up */
384 tstlcf exflg2,dialos,slv081 /* no: NAK to buy some time */
385 calsub inproc /* ship good data */
386 goto slvidl
387 rem
388 slv081 meter2 m.cnt6,1 /* count inability to accept input */
389 goto slv041
390 ttls HASP output processing
391 **********************************************************************
392 *
393 * HASP output processing: write the message and analyze the
394 * response; retransmit when necessary if NAKed
395 *
396 **********************************************************************
397 rem
398 haspwr meterm 1 /* count the output message */
399 holdot /* to keep msg */
400 signal sndout /* start next */
401 rem
402 **********************************************************************
403 *
404 * Check the output block type: if the CS requests
405 * acknowledgement of transmission of this block, record its
406 * BCB for the line status sent when block is transmitted
407 *
408 **********************************************************************
409 rem
410 clrlcf exflg2,csreqa /* assume CS doesn't care */
411 outscn outcra,wrt010 /* check for block type = 1 */
412 rem /* block type 1: CS requests ack */
413 setlcf exflg2,csreqa
414 outscn outgbn,punt /* pickup the BCB */
415 calasm setbno /* copy wrkch1 to hblkno */
416 rem
417 wrt010 outscn outcbt,punt /* clear block type field */
418 rem
419 **********************************************************************
420 *
421 * Transmit the block
422 *
423 **********************************************************************
424 rem
425 setlcl nakcnt,0 /* count transmission failures */
426 wrt020 dumpin
427 calsub bscwtr /* write the message */
428 rem
429 setimv hrcvtm /* wait for rcv time limit */
430 calsub bscrd /* wait for input */
431 rem
432 **********************************************************************
433 *
434 * analyze the response if any
435 *
436 **********************************************************************
437 rem
438 tstlcf exflg2,timout,wrt080 /* no response */
439 tstlcf exflg1,naksw,wrt045 /* CRC error */
440 rem
441 inscan inack,wrt030 /* ack? */
442 goto wrt050 /* yes */
443 rem
444 wrt030 inscan innak,wrt040 /* nak? */
445 dumpin /* yes: flush it ... */
446 meter2 m.cnt2,1 /* ... and count the NAK to our msg */
447 addlcl nakcnt,1
448 tstlcv nakcnt,naklmt,wrt035 /* report nak limit to mcs? */
449 goto wrt020 /* no: retry transmission */
450 wrt035 signal quit /* yes */
451 setlcl ctlop,lstnak
452 linsta ctlop
453 goto wrt020 /* now retry transmission */
454 rem
455 wrt040 calasm bsccki /* subject to further analysis */
456 tstlcl result,resack,wrt070 /* good message */
457 tstlcl result,resntr,wrt070 /* non-transparent ok too */
458 wrt045 meter2 m.cnt1,1 /* bad input: count NAK we must send */
459 goto wrt081
460 rem
461 **********************************************************************
462 *
463 * Response is an ACK: message has been transmitted; inform
464 * the CS if needed and return to the idle loop
465 *
466 **********************************************************************
467 rem
468 wrt050 dumpin /* discard ack */
469 wrt060 dmpout /* discard data */
470 tstlcf exflg2,csreqa,wrt061 /* does CS want to know? */
471 goto wrt065 /* no: return to idle loop */
472 wrt061 setlcl ctlop,lstwrc /* yes: report write completed */
473 setlcv ctlvl1,hblkno /*... and which block was written */
474 linsta ctlop
475 wrt065 tstlcf exflg2,master,mstidl /* if master mode */
476 goto slvidl
477 rem
478 **********************************************************************
479 *
480 * response is a valid message: send it to Multics
481 *
482 **********************************************************************
483 rem
484 wrt070 calsub chkdia /* be sure to check dia first */
485 tstlcf exflg2,dialos,wrt071
486 calsub inproc /* ship the input */
487 goto wrt060
488 rem
489 wrt071 meter2 m.cnt6,1 /* can't accept input now: NAK it */
490 goto wrt081
491 rem
492 **********************************************************************
493 *
494 * response garbled or timeout: request restransmission
495 *
496 **********************************************************************
497 rem
498 wrt080 meter2 m.cnt4,1 /* count timeout waiting for reply */
499 wrt081 dumpin /* discard bad input, if any */
500 addlcl nakcnt,1
501 tstlcv nakcnt,naklmt,wrt085 /* report nak limit to mcs? */
502 goto wrt086 /* no */
503 wrt085 signal quit /* yes */
504 setlcl ctlop,lstnak
505 linsta ctlop
506 rem
507 wrt086 bldmsg otnak,punt /* prepare to write nak */
508 holdot
509 calsub bscwtr
510 dmpout
511 setimv hrcvtm /* time limit for response */
512 calsub bscrd
513 rem
514 tstlcf exflg2,timout,wrt080 /* timeout: try again */
515 tstlcf exflg1,naksw,wrt105 /* CRC error */
516 inscan inack,wrt090 /* ack? */
517 goto wrt020 /* yes */
518 wrt090 inscan innak,wrt100 /* nak? */
519 meter2 m.cnt2,1 /* yes: count original NAK to our msg */
520 goto wrt020
521 rem
522 wrt100 calasm bsccki /* examine input */
523 tstlcl result,resack,wrt070 /* response now ok */
524 tstlcl result,resntr,wrt070
525 wrt105 meter2 m.cnt1,1 /* bad input: count our NAK */
526 goto wrt081
527 rem
528 outcra chstr rescansearchstxignoreignoreignorecmaskfcs2rafcs2
529 etc bt
530 outgbn chstr rescansearchstxignoremovchrwrkch1
531 outcbt chstr rescansearchstxignoreignoreignoreoffbitfcs2bt
532 ttls HASP input processing
533 **********************************************************************
534 *
535 * scan input and update state of wait-a-bit bits
536 *
537 **********************************************************************
538 rem
539 inproc inscan getfcs,inp020 /* extract fcs chars */
540 setlcv temp1,wabmsk /* make copy of current mask */
541 rem
542 calasm wabchk /* analyze wait-a-bit stuff */
543 rem
544 clrlcf exflg2,fswabs /* clear foreign system wait-a-bit */
545 tstlcl temp3,0,inp010 /* foreign system wait-a-bit on? */
546 setlcf exflg2,fswabs /* yes: don't check individual devices */
547 goto inp020
548 rem
549 inp010 setlcv wabmsk,temp1 /* save new state of device wabs */
550 tstlcl temp2,0,inp020 /* any bits go off? */
551 inscan setnr,punt /* yes: flag msg as important ... */
552 addlcl wrpcnt,1 /* ... and expect another sync-block */
553 rem
554 inp020 meterm 0 /* count the input ... */
555 sendin /* ... and hand it off to CS */
556 retsub
557 rem
558 getfcs chstr rescansearchstxignoreignoreoffbitfcs1rt+fcs1nrmov
559 etc chrwrkch1ignoremovchrwrkch2
560 setnr chstr rescansearchstxignoreignoresetbitfcs1nr
561 ttls subroutines
562 **********************************************************************
563 *
564 * examine output to see if it is ready to write
565 *
566 **********************************************************************
567 rem
568 chkout tstlcf exflg2,outarv,chk010 /* any arrivals since last time? */
569 tstlcf exflg2,fnrcba,chk030 /* ... while foreign not ready? */
570 goto chk050 /* no, nothing is ready to write */
571 rem
572 chk010 clrlcf exflg2,outarv
573 calasm bsccko /* perform output scan */
574 tstlcl result,resack,chk030
575 tstlcl result,resntr,chk030
576 tstlcl result,resinc,chk020
577 tstlcl result,resnul,chk020
578 calsub bscbad /* report bad block */
579 dmpout
580 goto chk050
581 rem
582 chk020 signal sndout /* ask message be completed */
583 goto chk050
584 rem
585 chk030 clrlcf exflg2,fnrcba
586 tstlcl wrpcnt,0,chk035 /* returning output to CS? */
587 goto chk060 /* yes: check for sync-blocks */
588 rem
589 chk035 tstlcf exflg2,fswabs,chk040 /* ignore while foreign not ready */
590 clrlcf exflg2,lswabs /* copy local system wait-a-bit */
591 outscn getlsw,chk036
592 setlcf exflg2,lswabs
593 chk036 setlcl result,resack /* good message */
594 retsub
595 rem
596 chk040 setlcf exflg2,fnrcba /* remember there's data */
597 chk050 setlcl result,resinc /* incomplete message */
598 retsub
599 rem
600 chk060 calasm wrpchn /* turn output into input */
601 inscan setrt,chk070 /* turn on returned msg bit */
602 chk070 inscan chksnc,chk080 /* check for sync-block */
603 addlcl wrpcnt,-1 /* yes: need one less to start sending again */
604 chk080 signal sndout /* ask for more */
605 sendin
606 goto chk050
607 rem
608 getlsw chstr rescansearchstxignoreignorecmaskfcs1sbfcs1sb
609 setrt chstr rescansearchstxignoreignoresetbitfcs1rt
610 chksnc chstr rescansearchstxignoreignoreignorecmaskfcs2syfcs2
611 etc bt
612 eject
613 **********************************************************************
614 *
615 * divide connect time by transmit repeat time to get
616 * initialization try count
617 *
618 **********************************************************************
619 rem
620 calcbl subr clc
621 lda temp1-*
622 lrs 17
623 dvf temp2-*
624 iera -1 /* complement */
625 iaa 1
626 sta temp1-*
627 return calcbl
628 rem
629 rem
630 **********************************************************************
631 *
632 * turn current output chain back into input
633 *
634 **********************************************************************
635 rem
636 wrpchn subr wrp,x2
637 szn t.icp,1 /* input chain is programming error */
638 tze 2
639 oct 0 /* crash */
640 lda t.ocp,1 /* get output chain start */
641 sta t.icp,1
642 stz t.ocp,1
643 stz t.icpl,1 /* prepare to count length of chain */
644 lda t.icp,1
645 wrp010 sta wrplst-*
646 tsy a.a001-*,* setbpt
647 cax2
648 lda bf.siz,2 /* get word with size */
649 ana wrp030-*
650 arl 15 /* convert to buffers */
651 iaa 1
652 asa t.icpl,1
653 szn bf.nxt,2
654 tze wrp020-*
655 lda bf.nxt,2
656 tra wrp010-*
657 wrp020 lda wrp040-* /* flag last buffer */
658 orsa bf.flg,2
659 lda wrp050-*
660 ansa bf.flg,2
661 lda wrplst-*
662 sta t.ilst,1
663 return wrpchn
664 rem
665 wrp030 vfd o18/bufsmk
666 wrp040 vfd o18/bffbrk
667 wrp050 vfd o18//bfflst
668 wrplst bss 1
669 rem
670 a.a001 ind setbpt
671 eject
672 **********************************************************************
673 *
674 * analyze fcs chars to build new mask
675 *
676 * sets temp2 to 1 if some bits went off
677 * sets temp3 to 1 if system wait-a-bit on
678 *
679 **********************************************************************
680 rem
681 wabchk subr wab
682 stz temp2-*
683 stz temp3-*
684 lda wab020-* /* get address of first work char */
685 tsy wab030-*,* /* =adbyte */
686 oct 0 /* impossible */
687 lda 0,3,b.0 /* get first fcs */
688 icana fcs1sb /* check for system bit */
689 tze 2 /* off */
690 aos temp3-*
691 als 9 /* align in left half */
692 ora 0,3,b.1 /* get second fcs */
693 ana wab010-* /* isolate wait-a-bits */
694 caq /* save copy of new mask */
695 iera -1
696 ana temp1-* /* 1's here means wait-a-bits went off */
697 tze 2 /* no change */
698 aos temp2-*
699 stq temp1-* /* new mask */
700 return wabchk
701 rem
702 wab010 vfd o18/allon
703 wab020 vfd o18/wrkch1
704 wab030 ind adbyte
705 eject
706 **********************************************************************
707 *
708 * Copy the character in wrkch1 into the TIB variable
709 * hblkno right justified
710 *
711 **********************************************************************
712 rem
713 setbno subr sbn
714 lda sbn005-* /* byte address of interest */
715 tsy sbn010-*,* /* =adbyte */
716 oct 0
717 ldq 0,3,b.0 /* get the character we want */
718 lda sbn015-* /* TIB extension addr */
719 cax3 /* cvaddr needs addr in X3 */
720 tsy sbn020-*,* /* =cvaddr */
721 stq 0,3 /* store the character */
722 return setbno
723 rem
724 sbn005 vfd o18/wrkch1
725 sbn010 ind adbyte
726 sbn015 vfd o18/hblkno
727 sbn020 ind cvaddr
728 eject
729 **********************************************************************
730 *
731 * routine to check dia for pending input not yet sent to
732 * mainframe. the assumption here is that if the dia is
733 * falling behind, maybe multics is slow, or is having a
734 * problem, and we better not send too much more input.
735 * since it is too hard to attempt HASP flow control from
736 * this level, input will be nakked until the dia can
737 * catch up.
738 *
739 **********************************************************************
740 rem
741 chkdia clrlcf exflg2,dialos /* assume OK to send */
742 tstfld t.dcp,0,ckd030 /* all ok, return */
743 setime -100 /* first, wait .1 seconds */
744 wait ckd010,ckd040,bsctst
745 status 0,dsr,bshang
746 rem
747 ckd010 tstfld t.dcp,0,ckd030 /* .1 wait worked */
748 setime -500 /* wait a little longer */
749 wait ckd020,ckd040,bsctst
750 status 0,dsr,bshang
751 rem
752 ckd020 tstfld t.dcp,0,ckd030 /* .5 wait worked */
753 setlcf exflg2,dialos /* can't wait forever: NAK it */
754 rem
755 ckd030 retsub
756 rem
757 ckd040 setlcf exflg2,outarv /* dont fail to notice output */
758 waitm
759 eject
760 **********************************************************************
761 *
762 * test state handler
763 *
764 **********************************************************************
765 rem
766 testst tstlcl ctlop,lcthtm,tst010 /* only HASP timers handled here */
767 waitm
768 tst010 setlcv hcontm,ctlvl1
769 setlcv hrcvtm,ctlvl2
770 setlcv hxmttm,ctlvl3
771 waitm
772 rem
773 rem
774 rem
775 rem
776 punt punt 0 /* fnp crash on wierd errors */
777 rem
778 rem
779 rem
780 temp1 bss 1
781 temp2 bss 1
782 temp3 bss 1
783 rem
784 end hasp