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 ,ibm3270_tables
11 ttl ibm3270_tables -- tables for ibm 3270 terminals
12 editp on
13 pcc off
14 pmc off
15 detail off
16 rem
17 i3270 null
18 rem
19 start i3270,,c3ibmm0b0000
20 rem
21 rem
22 symdef st3270
23 rem
24 symref bsctst bisync test state handler
25 symref bscwt bisync write routine
26 symref bscwtr bisync write routine with rcv mode set
27 symref bscrd bisync read routine
28 symref bsccki bisync check input message routine
29 symref bsccko bisync check output message routine
30 symref bscswa bisync ack switching routine
31 symref bshang when line hangs up
32 symref bscbad for reporting bad blocks
33 symref cvaddr convert tib ext address
34 symref setbpt
35 rem
36 pmc save,on
37 csbits
38 tconst
39 tib
40 meters
41 buffer
42 bscdat
43 pmc restore
44 rem
45 rem
46 epad bool 377
47 esyn bool 062
48 rem
49 rem
50 rem /* input scan control strings */
51 rem
52 inenq chstr rescanmatchenq
53 ineot chstr rescanmatchtibeot
54 inack chstr rescanmatchdleignorematchtiback
55 innak chstr rescanmatchtibnak
56 indisc chstr rescanmatchdleignorematchtibeot
57 inwack chstr rescanmatchdleignorematchwack
58 inrvi chstr rescanmatchdleignorematchrvi
59 rem
60 rem /* output bldmsg control strings */
61 rem
62 otack chstr dletibackseteom
63 otnak chstr tibnakseteom
64 otenq chstr enqseteom
65 oteot chstr tibeotseteom
66 otdisc chstr dletibeotseteom
67 otwack chstr dlewackseteom
68 otttd chstr stxenqseteom
69 otrvi chstr dlerviseteom
70 otpoll equ otenq
71 otetpd chstr tibeotepadesynesynesynesyn
72 rem
73 ttls 3270 polling and input
74 ************************************************************************
75 *
76 * enter here for ibm 3270 terminal operation
77 *
78 ************************************************************************
79 rem
80 st3270 clrlcf exflg1,naksw+nakksw+wacksw+ttdsw+ntrsw+rvisw+needrv
81 clrlcf exflg1,ctlmsg
82 clrlcf exflg2,pollok+polpnd
83 setlcl testrt,testst /* so bisync uses my test state handler */
84 rem
85 ************************************************************************
86 *
87 * wait for something to do
88 *
89 ************************************************************************
90 rem
91 idle tstwrt gosel /* data to write, we can do a select */
92 tstlcf exflg2,polpnd,gopoll /* previoulsy asked to poll */
93 setlcf exflg2,pollok /* can accept a poll req now */
94 wait 0,idle,bsctst /* if output comes in, check for rvi */
95 status 0,dsr,bshang /* if we lose the line, all bets are off */
96 rem
97 ************************************************************************
98 *
99 * asked to start polling operation
100 *
101 ************************************************************************
102 rem
103 gopoll unwind /* in case subr interrupted */
104 clrlcf exflg1,rvisw+nakksw
105 clrlcf exflg2,pollok+polpnd+selop /* cant take poll req now */
106 setchr tiback,ack0
107 setlcl nakcnt,0 /* initialize nak counter */
108 setlcl bidcnt,0 /* initialize bid timeout counter */
109 sndpol bldmsg otpoll,gopunt /* get enq for poll message */
110 calasm bldpol,polad1 /* add in device selection stuff */
111 bldmsg otetpd,gopunt
112 setlcf exflg2,pollsw /* remember current message is poll */
113 sndmsg holdot
114 calsub bscwtr /* write poll */
115 dmpout
116 pollwt setime 5 /* time limit for response */
117 calsub bscrd
118 tstlcf exflg2,timout,pollto /* timed out */
119 tstlcf exflg1,naksw,nakpol /* got bad reply */
120 calasm bsccki /* check input message */
121 tstlcl result,reseot,poleot /* eot, end of pool seq */
122 tstlcl result,resack,pollgd /* got good reply */
123 tstlcl result,resenq,enqpol /* got enq, so repeat prevous response */
124 goto nakpol
125 rem
126 ************************************************************************
127 *
128 * got eot in response to poll
129 *
130 ************************************************************************
131 rem
132 poleot tstwrt polend /* if data to write, stop polling */
133 tstlcf exflg2,autopl,conpol /* continue polling if autopoll */
134 polend sendin /* tell multics we stopped polling */
135 goto idle
136 conpol dumpin /* thrwo away eot */
137 setime 1
138 wait gopoll,idle,bsctst /* tetry poll in 1 second */
139 status 0,dsr,bshang
140 rem
141 ************************************************************************
142 *
143 * got a good response in reply to a poll
144 *
145 ************************************************************************
146 rem
147 pollgd meterm 0 /* meter input */
148 sendin /* ship it */
149 calsub bscswa /* switch acks */
150 sndack bldmsg otack,gopunt /* and acknowledge it */
151 setlcl nakcnt,0 /* start counting over */
152 clrlcf exflg1,nakksw /* previous msg not nak */
153 clrlcf exflg2,pollsw+autopl /* previous msg not poll */
154 rem /* also, good msg stops auto polling */
155 goto sndmsg /* go send the ack just built */
156 rem
157 ************************************************************************
158 *
159 * got bad reply to poll, send nak
160 *
161 ************************************************************************
162 rem
163 nakpol meter2 m.cnt1,1
164 dumpin /* throw away bad msg */
165 addlcl nakcnt,1 /* dont do this too often */
166 tstlcl nakcnt,10,manynk
167 sndnak bldmsg otnak,gopunt /* nak bad reply */
168 setlcf exflg1,nakksw /* last message was nak */
169 clrlcf exflg2,pollsw /* last message not poll */
170 goto sndmsg /* go send the nak */
171 manynk meter2 m.cnt4,1
172 setlcl ctlop,lstnak /* report error to multics */
173 calsub sndsta /* report status */
174 goto eotidl /* send an eot and idle */
175 rem
176 ************************************************************************
177 *
178 * got enq reply, so repeat out last response */
179 *
180 ************************************************************************
181 rem
182 enqpol dumpin
183 tstlcf exflg1,nakksw,sndnak
184 tstlcf exflg2,pollsw,sndpol
185 goto sndack
186 rem
187 ************************************************************************
188 *
189 * come here to send an eot to the 3270, and go back to the idle state
190 *
191 ************************************************************************
192 rem
193 eotidl bldmsg oteot,gopunt
194 holdot
195 calsub bscwt
196 dmpout
197 goto idle
198 ttls 3270 device selection and output
199 rem
200 ************************************************************************
201 *
202 * come here when output arrives
203 *
204 ************************************************************************
205 rem
206 gosel setchr tiback,ack0 /* initialize ack */
207 clrlcf exflg2,pollok /* can't do polls now */
208 setlcf exflg2,selop /* mark it as select operation */
209 setlcl nakcnt,0
210 setlcl bidcnt,0
211 sndsel bldmsg otpoll,gopunt
212 calasm bldpol,selad1 /* build select msg looks like poll msg */
213 bldmsg otetpd,gopunt
214 holdot
215 calsub bscwtr /* write/read subr in bsc_tables */
216 dmpout
217 rem
218 selwt setime 5
219 calsub bscrd /* use bsc_tables subr to get response */
220 tstlcf exflg2,timout,pollto /* timeout, try again */
221 rem
222 ************************************************************************
223 *
224 * look at response to select
225 *
226 ************************************************************************
227 rem
228 inscan inrvi,tstwck
229 goto gotrvi /* reverse interrupt */
230 tstwck inscan inwack,tstack
231 goto selwck /* wack */
232 tstack inscan inack,pollto /* if not ack, unrecognizable */
233 rem
234 ************************************************************************
235 *
236 * got an ack for the select, do some writing
237 *
238 ************************************************************************
239 rem
240 calsub bscswa /* start with ack 1 */
241 dumpin /* don't need the ack */
242 goto chkout /* look at output message */
243 rem
244 ************************************************************************
245 *
246 * reverse interrupt on select, we should poll now
247 *
248 ************************************************************************
249 rem
250 gotrvi dumpin
251 calsub dmpall /* get rid of all of output message */
252 setlcl ctlop,lstrvi /* report rvi back */
253 calsub sndsta
254 goto eotidl /* wait for poll order */
255 rem
256 ************************************************************************
257 *
258 * wack in response to select, send eot, wait and try again
259 *
260 ************************************************************************
261 rem
262 selwck meter2 m.cnt5,1
263 dumpin
264 calsub dmpall
265 setlcl ctlop,lstwck
266 calsub sndsta
267 goto eotidl /* go wait for next order */
268 rem
269 ************************************************************************
270 *
271 * examine current output message before sending it
272 *
273 ************************************************************************
274 rem
275 chkout calasm bsccko /* bsc_tables output-message checking rtn */
276 tstlcl result,resack,sendit /* normal message */
277 tstlcl result,resinc,getmor /* incomplete message, get the rest of it */
278 tstlcl result,resnul,outwt /* nothing there at all */
279 dmpout /* it's no good, remove it */
280 tstlcl result,reseot,endout /* normal termination, send eot */
281 calsub bscbad /* anything else is invalid */
282 goto outwt /* wait for more */
283 getmor signal sndout /* ask for more */
284 outwt setimv ttdtim
285 wait sndttd,chkout,bsctst /* arrival of output will stir us */
286 status 0,dsr,bshang /* so, alas, will lack of dsr */
287 endout setlcl ctlop,lstwrc /* report write complete */
288 calsub sndsta
289 goto eotidl
290 rem
291 ************************************************************************
292 *
293 * ready to send complete output message
294 *
295 ************************************************************************
296 rem
297 sendit meterm 1 /* count output message */
298 holdot /* hang on to it until sent */
299 signal sndout /* ask for next one */
300 setlcl nakcnt,0 /* initialize counts */
301 setlcl ttdcnt,0
302 setlcl enqcnt,0
303 clrlcf exflg1,ttdsw
304 rem
305 sndagn calsub bscwtr /* write and read response */
306 sent setime 3 /* which should come within 3 seconds */
307 calsub bscrd /* go get it */
308 tstlcf exflg2,timout,ask /* didn't come, check up on it */
309 rem
310 ************************************************************************
311 *
312 * have a response, let's examine it
313 *
314 ************************************************************************
315 rem
316 inscan innak,gotrs1
317 goto gotnak /* nak, they didn't like it */
318 gotrs1 inscan inack,gotrs2
319 goto gudout /* it was accepted */
320 gotrs2 inscan ineot,gotrs3
321 goto repeot /* they said eot, something is messed up */
322 gotrs3 inscan inwack,ask /* if not wack, what is it? */
323 rem
324 ************************************************************************
325 *
326 * wack in response to output message
327 *
328 ************************************************************************
329 rem
330 dumpin /* throw away wack */
331 calsub dmpall
332 meter2 m.cnt5,1
333 setlcl ctlop,lstwkm /* report wack to msg */
334 calsub sndsta
335 goto eotidl
336 rem
337 ************************************************************************
338 *
339 * good message acknowledged, send next one
340 *
341 ************************************************************************
342 rem
343 gudout dumpin /* who needs ack? */
344 calsub bscswa /* switch acks */
345 dmpout
346 goto chkout /* look at next message */
347 rem
348 ************************************************************************
349 *
350 * output hasn't come yet, use ttd to let him know we're still here
351 *
352 ************************************************************************
353 rem
354 sndttd tstlcv ttdcnt,ttdlmt,fakeot /* have we waited too long? */
355 addlcl ttdcnt,1
356 bldmsg otttd,gopunt /* send ttd message */
357 holdot
358 calsub bscwtr
359 dmpout
360 setlcf exflg1,ttdsw /* so we'll understand nak */
361 goto sent /* wait for nak */
362 rem
363 * come here when we get the nak
364 rem
365 ttdnak clrlcf exflg1,ttdsw /* not ttd now */
366 goto chkout
367 rem
368 ************************************************************************
369 *
370 * our message got nak'ed
371 *
372 ************************************************************************
373 rem
374 gotnak dumpin
375 tstlcf exflg1,ttdsw,ttdnak /* if we were doing ttd, that's ok */
376 meter2 m.cnt2,1
377 tstlcl nakcnt,3,nakerr /* drop it if too many */
378 addlcl nakcnt,1 /* count this one */
379 goto sndagn /* try again */
380 nakerr calsub dmpall
381 meter2 m.cnt6,1
382 setlcl ctlop,lstnko
383 calsub sndsta
384 goto eotidl
385 rem
386 ************************************************************************
387 *
388 * got an eot response, something's wrong
389 * report it so he can try poll to get status
390 *
391 ************************************************************************
392 rem
393 repeot dumpin
394 calsub dmpall /* not likely to want output again */
395 setlcl ctlop,lsteot
396 calsub sndsta
397 goto idle
398 rem
399 ************************************************************************
400 *
401 * last response didn't come or was unrecognizable
402 * send enq to get it repeated
403 *
404 ************************************************************************
405 rem
406 ask meter2 m.cnt7,1
407 dumpin
408 tstlcl enqcnt,enqlmt,fakeot /* too many of these */
409 addlcl enqcnt,1
410 bldmsg otenq,gopunt /* set up an enq */
411 holdot
412 calsub bscwtr
413 dmpout
414 goto sent /* wait for response to repeat */
415 rem
416 ************************************************************************
417 *
418 * time to send eot message, either because we can't send any more
419 * output, or because it's done
420 *
421 ************************************************************************
422 rem
423 fakeot setlcl ctlop,lstabo /* this is abnormal one */
424 dmpout
425 calsub sndsta
426 goto eotidl
427 rem
428 ************************************************************************
429 *
430 * subroutine to dump all pending output up to and including eot message
431 *
432 ************************************************************************
433 rem
434 dmpall dmpout
435 tstwrt dmpchk /* next message already here? */
436 wait 0,dmpchk,bsctst /* no, wait for it to arrive */
437 status 0,dsr,bshang /* die if phone goes */
438 rem
439 dmpchk outscn ineot,dmpall /* is it eot message? */
440 dmpout /* yes, throw it away and we're done */
441 retsub
442 ttls unsuccessful poll or select
443 rem
444 ************************************************************************
445 *
446 * time out waiting for poll /select reply */
447 *
448 ************************************************************************
449 rem
450 pollto meter2 m.cnt3,1
451 dumpin
452 bldmsg oteot,gopunt /* reset 3270 */
453 holdot
454 calsub bscwtr
455 dmpout
456 tstlcl bidlmt,0,pollt1 /* unmlimited retries */
457 addlcl bidcnt,1
458 tstlcv bidcnt,bidlmt,badpol
459 pollt1 tstlcf exflg2,selop,sndsel /* send select again */
460 goto sndpol /* send poll again */
461 badpol tstlcl exflg2,selop,badsel
462 setlcl ctlop,lstbdf /* report poll failure */
463 calsub sndsta
464 goto idle
465 badsel calsub dmpall
466 setlcl ctlop,lstslf /* report select error */
467 calsub sndsta
468 goto idle
469 rem
470 ************************************************************************
471 *
472 * routine to report line status and stop polling
473 *
474 ************************************************************************
475 rem
476 sndsta clrlcf exflg2,autopl+polpnd
477 linsta ctlop
478 retsub
479 ttls assembler language subroutines
480 ************************************************************************
481 *
482 * routine to build a poll req by editing the poll address
483 * into the current output buffer before the enq it
484 * already has in it.
485 *
486 ************************************************************************
487 rem
488 bldpol subr blp
489 ldx3 0,3 get addr of arg
490 tsy a.a001-*,* =cvaddr, cvt to real address
491 cx3a
492 ora l.a001-* turn into char address
493 cax3
494 ldq 0,3,b.0 pick up count
495 iacx3 0,b.1 skip over count
496 lda t.ocp,1 current buffer
497 tsy a.a002-*,* setbpt
498 cax2
499 cqa get count into a
500 asa bf.tly,2 update tally with length of address
501 cx2a
502 iaa bf.dta address of data in buffer
503 ora l.a001-* make into character address
504 cax2
505 lda 0,2,b.0 pick up enq
506 sta blpsv1-* save for a while
507 iaq 0 to test the q
508 blp020 tze blp010-* no chars left in addr to copy
509 lda 0,3,b.0 pick up addr char
510 sta 0,2,b.0 copy into buffer
511 iacx2 0,b.1
512 iacx3 0,b.1
513 iaq -1
514 tra blp020-* loop thru address
515 blp010 lda blpsv1-* retrieve the saved enq
516 sta 0,2,b.0 add to end of address
517 ldx2 l.a002-* =0, means inline return
518 return bldpol
519 rem
520 blpsv1 bss 1
521 rem
522 a.a001 ind cvaddr
523 a.a002 ind setbpt
524 rem
525 l.a001 ind 0,b.0
526 l.a002 oct 0
527 ttls test_state handler
528 ************************************************************************
529 *
530 * test state handler. most things are left to bsc handler
531 *
532 ************************************************************************
533 rem
534 testst tstlcl ctlop,lctpol,rqpoll /* poll request handled here */
535 tstlcl ctlop,lctsta,stpaut /* stop auto polling */
536 waitm
537 rqpoll clrlcf exflg2,autopl /* assume not auto-polling */
538 tstlcl ctlvl1,0,rqpol2 /* it isnt */
539 setlcf exflg2,autopl /* it is */
540 rqpol2 tstlcf exflg2,pollok,gopoll /* go start poll if ok now */
541 setlcf exflg2,polpnd /* otherwise, save for later */
542 waitm
543 stpaut clrlcf exflg2,autopl /* auto polling will stop soon */
544 waitm
545 rem
546 gopunt punt 0
547 rem
548 *
549 * limit for number of enq's we will send in succession
550 *
551 enqlmt equ 3
552 rem
553 end