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 ,console_man
11 ttl console manager for 355 with multics
12 rem
13 rem
14 pmc off
15 pcc on
16 detail on
17 editp on
18 rem
19 rem
20 symdef cons
21 rem
22 symdef wcon write console routine
23 rem called from outside in emergency
24 symdef contip terminate interrupt processor for above
25 rem
26 symdef consol console interrupt processing routine
27 symdef consjt so init can find jump tables
28 rem
29 symref mdisp dispatcher return
30 symref secdsp event dispatcher return
31 symref dspqur dispatcher queuer entry
32 symref conabt console operator abort routine
33 symref invp main interrupt processing routine
34 symref g3wjt get 3rd word of jump table routine
35 symref octasc octal to ascii conversion subroutine
36 rem
37 rem
38 rem
39 rem
40 rem
41 pmc save,on
42 cons null
43 start cons,7
44 ttls console read and write routines
45 ************************************************************************
46 *
47 * these routines are used to write messages
48 * on the datanet-355 console and/or to receive messages from the
49 * system operator.
50 *
51 * the routines have no queueing capability, so a "busy flag" is used to
52 * prevent more than one access to the console at a time. if the console
53 * is busy at the time the user calls "write" or "wrcon," a return is made
54 * immediately to a special "busy return" point in the user's calling
55 * sequence. at this time the user would perhaps queue up a time
56 * delayed routine to retry at a later time. if the console is not busy
57 * when the user calls, his request will be initiated and control
58 * returned to his "accepted return" point.
59 *
60 ************************************************************************
61 *
62 * calling sequence for "write" --
63 * pre-set registers -- the a, q, and x1 registers must be set up as
64 * required by the dispatcher queuer. this specifies the
65 * routine which will be queued when the write operation
66 * terminates.
67 *
68 * tsy write-*
69 * zero <address of data icw>
70 * --- <accepted return point>
71 * --- <busy return point>
72 *
73 ************************************************************************
74 *
75 * calling sequence for "wrcon" --
76 *
77 * pre-set registers -- the a, q, and x1 registers must
78 * be set up as required by the dispatcher queuer.
79 * this specifies the routine which will be queued
80 * when the read operation has terminated.
81 *
82 * tsy wrcon-*
83 * zero <address of output data icw>
84 * zero <address of input-area data icw>
85 * --- <accepted return point>
86 * --- <busy return point>
87 *
88 ************************************************************************
89 eject
90 ************************************************************************
91 *
92 * console "terminate interrupt" processing routine
93 *
94 * the "terminate interrupt" is caused, naturally enough, when data
95 * transfer between the console teletypewriter and the 355 terminates.
96 *
97 * several "abnormal" events can also cause this interrupt, and these
98 * are indicated in the code.
99 *
100 * the routine responds to this interrupt by indicating to the approprate
101 * user routine that his requested data transfer has been completed.
102 *
103 ************************************************************************
104 *
105 * console "special interrupt" processing routine
106 *
107 * the "special interrupt" is caused by pressing the "break" key on the
108 * console tty. the routine "spcon" is called in response to this
109 * interrupt. this is the method to be used by the operator to request
110 * the performance of the several special operations provided.
111 *
112 * the routine responds to the special interrupt by printing "???" to
113 * which the operator is expected to type in one of the commands
114 * listed below --
115 *
116 * command variables function
117 *
118 * abort abort 355. cause an immediate dump.
119 * alter aaaaa,bbbbbb store bbbbbb in location aaaaa, absolute.
120 * peek aaaaa write contents of loc aaaaa, absolute
121 * peek aaaaa,n write n words starting at aaaaa.
122 * test call the on-line t&d system.
123 *
124 * n.b. -- future developers
125 * command words must be at least four 4 characters in length. to
126 * increase the number of variable fields, see the comments in the
127 * "idx" subroutine.
128 ************************************************************************
129 rem
130 rem
131 systm
132 comreg
133 rem
134 pmc restore
135 cr bool 15
136 lf bool 12
137 xoff bool 23
138 ttls write -- write console routine
139 ************************************************************************
140 *
141 * write write console routine
142 *
143 ************************************************************************
144 rem
145 write subr wri,x1inh
146 rem
147 szn nocon-* see if console is not configured or down
148 tnz w05-* yes
149 szn conbsy-* ? console busy ?
150 tze w10-* no
151 w05 null
152 aos write-* yes, go to user's "busy return"
153 tra wribak-*
154 rem
155 rem
156 rem
157 w10 null
158 aos conbsy-* set busy flag
159 aos cwrite-* set write operation control flag
160 aos cwconf-* set wcon routine in control flag
161 ldi wrisi-* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
162 rem
163 staq cqueaq-* save parameters of routine to be queued
164 stx1 cquex1-* when write operation terminates
165 ldaq csicw-* set up status icw mailbox
166 staq csicwa-*,*
167 ldx1 write-*,* set up data icw mailbox
168 ldaq 0,1
169 staq cdicwa-*,*
170 staq cwwicw-* save output data icw
171 rem
172 sel tych issue write command
173 cioc cwpcw-*
174 rem
175 wribak null
176 aos write-*
177 return write
178 ttls wrcon -- write-then-read console routine
179 ************************************************************************
180 *
181 * wrcon write-then-read console routine
182 *
183 ************************************************************************
184 rem
185 wrcon subr wrc,inhx1
186 rem
187 szn nocon-* see if console is not configured or down
188 tnz w105-* yes
189 szn conbsy-* ? console busy ?
190 tze w110-* no
191 w105 null
192 aos wrcon-* yes, go to user's "busy return"
193 aos wrcon-*
194 tra wrcbak-*
195 rem
196 rem
197 rem
198 w110 null
199 aos conbsy-* set busy flag
200 aos cwrite-* set write operation control flag
201 stz cwconf-* clear wcon routine in control flag
202 ldi wrcsi-* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
203 rem
204 staq cqueaq-* save parameters of routine to be queued
205 stx1 cquex1-* when read operation terminates
206 ldaq csicw-* set up status icw mailbox
207 staq csicwa-*,*
208 ldx1 wrcon-*,* set up data icw mailbox
209 ldaq 0,1
210 staq cdicwa-*,*
211 staq cwwicw-* save output data dcw
212 aos wrcon-* save input-area data icw
213 ldx1 wrcon-*,*
214 ldaq 0,1
215 staq cwricw-*
216 rem
217 sel tych issue write command
218 cioc cwpcw-*
219 rem
220 wrcbak null
221 aos wrcon-* go to user's "accepted return" point
222 tra wrcon-*,*
223 rem
224 rem *********************************************************
225 rem * continue after write operation terminates and initiate
226 rem * the read operation
227 rem *********************************************************
228 rem
229 wrcont null
230 stz cwrite-* clear write operation control flag
231 ldaq csicw-* set up status icw mailbox
232 staq csicwa-*,*
233 ldaq cwricw-* set up input-area data icw mailbox
234 staq cdicwa-*,*
235 rem
236 cioc crpcw-*
237 rem
238 tra 1,* return to dispatcher
239 cdisp ind secdsp
240 ttls wcon -- emergency write routine
241 rem
242 rem
243 **********************************************************************
244 * wcon is the routine called from outside console_man to write error
245 * messages and crash warnings on the console.
246 *
247 * it does not return to its caller until the write is complete.
248 * it expects that only level 0, 1, and 2 interrupts are enabled,
249 * and that other interrupts will go to an "ignore" subroutine.
250 *
251 * in general, contip will be the terminate interrupt processor
252 * associated with this routine, rather than consol as for write
253 * and wrcon.
254 *
255 * calling sequence:
256 *
257 * tsy wcon-*
258 * zero <address of data icw>
259 * --- <error return>
260 * --- <normal return>
261 *
262 **********************************************************************
263 rem
264 rem
265 cntrlx bool 30
266 sbits bool 50
267 rem
268 rem
269 rem
270 wcon subr wco,x1inh
271 rem
272 szn nocon-* is there a console?
273 tnz wcobak-* take error return if not
274 rem
275 szn conflg-*,* =.crcon console io enabled now?
276 tnz wcook-* no, ignore call
277 rem
278 aos conbsy-* mark console busy
279 ldx1 wcon-*,* get icw address
280 ldaq 0,1 get icw
281 staq cdicwa-*,* put it in mailbox
282 ldaq csicw-* get status icw
283 staq csicwa-*,*
284 rem
285 sel tych
286 cioc cwpcw-* write pcw
287 rem
288 wco010 null
289 eni >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
290 dis wait for interrupt
291 tra -1
292 rem
293 ttls contip -- terminate interrupt ptocessor for wcon
294 rem
295 contip ind **
296 sti conind-* hang on to indicators
297 inh <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
298 szn conbsy-* if console isn't busy,
299 tnz wco020-*
300 ldi conind-* restore indicators and
301 tra contip-*,* ignore interrupt
302 rem
303 wco020 null
304 lda cstat-* get status; is it "ready"?
305 tpl wcobak-* no, take error return
306 rem
307 arl 9 ptro or control char?
308 icana sbits
309 tze wcobak-* neither, take error return
310 rem
311 ldx1 cdicwa-*,* pick up last character transmitted
312 lda -1,1,b.1
313 icmpa cntrlx "control-x"?
314 tze wcobak-* yes, error return
315 rem
316 wcook aos wcon-* else bump for good return
317 rem
318 wcobak null
319 aos wcon-* bump return address once
320 stz conbsy-* not busy any more
321 rem
322 return wcon
323 rem
324 rem
325 conind bss 1 for storing indicators
326 ttls data for wcon, wrcon, write
327 rem
328 even
329 csicw icw cstat,b.0,1 status icw image
330 cwpcw oct 0,44 pcw -- write
331 crpcw oct 0,50 pcw -- read
332 cwwicw bss 2 wrcon's current output data icw
333 cwricw bss 2 wrcon's current input data icw
334 cqueaq bss 2 queue data for wrcon
335 rem
336 cstat bss 1 status store area
337 cquex1 bss 1 queue data for wrcon
338 conbsy bss 1 console busy flag <>0=busy
339 nocon bss 1 no console <>0 flag
340 cwrite bss 1 write operation control flag
341 cwconf bss 1 wcon routine in control <>0 flag
342 rem
343 csicwa ind tyst address of console status icw mailbox
344 cdicwa ind tyicw address of console data icw mailbox
345 rem
346 conflg ind .crcon
347 ttls consol -- console interrupt processing routine
348 ************************************************************************
349 *
350 * the sequence of events in processing the terminate and special
351 * interrupts from the system console is as follows:
352 *
353 * 1. the appropriate interrupt cell is set by the iom.
354 *
355 * 2. the processor acknowledges the interrupt by executing a
356 * "tsy x,*" where "x" is the address of the appropriate
357 * interrupt vector, which points to a "jump table."
358 *
359 * 3. the jump table routine stores the value of the ic and
360 * sends control to the "invp" routine.
361 *
362 * 4. the "invp" routine saves registers and sends control to
363 * the routine "consol" below.
364 *
365 * 5. "consol" determines from the 3rd word of the jump table
366 * which console interrupt terminate or special occurred,
367 * and enters the appropriate parameters into the event
368 * dispatcher's queue.
369 *
370 ************************************************************************
371 rem
372 rem *********************************************************
373 rem * terminate and special interrupt jump tables
374 rem *********************************************************
375 rem
376 consjt null symbol that init finds
377 contmj ind **
378 tsy invpx-*,*
379 vfd 12/0,6/modcon
380 rem
381 conspj ind **
382 tsy invpx-*,*
383 vfd 12/-1,6/modcon
384 eject
385 rem *********************************************************
386 rem * console interrupt processing routine
387 rem *********************************************************
388 rem
389 consol null
390 inh <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
391 tsy g3wjtx-*,* get 3rd word of jump table
392 iaq 0 ? terminate or special interrupt ?
393 tmi con20-* special, go process
394 rem
395 rem terminate interrupt...
396 rem
397 ldaq tmaq-* queue up the terminate interrupt
398 ldx1 tmx1-* processing routine in event
399 con10 null
400 tsy tmquer-*,* dispatcher
401 tra cmdisp-*,*
402 rem
403 rem special interrupt...
404 rem
405 con20 null
406 szn sibusy-* ? special interrupt already active ?
407 tnz cmdisp-*,* yes, ignore this one
408 aos sibusy-* no, set flag to block others
409 ldaq spaq-* queue up the special interrupt
410 ldx1 spx1-* processing routine in event
411 tra con10-*
412 rem
413 rem
414 rem
415 invpx ind invp main interrupt processor
416 g3wjtx ind g3wjt
417 cmdisp ind mdisp return to master dispatcher
418 rem
419 modcon set 6
420 ttls tmcon -- console terminate interrupt processor
421 ************************************************************************
422 *
423 * tmcon console terminate interrupt processor -- part 1
424 *
425 ************************************************************************
426 rem
427 tmcon null
428 szn conbsy-* ? busy flag set ?
429 tnz t10-* yes, as it should be!
430 aos tmeict-* no, count this extraneous interrupt
431 tra cdisp-*,* return to dispatcher
432 rem
433 t10 null
434 tsel sel ** select console channel
435 szn cwrite-* ? read or write termination ?
436 tze tmread-* read, go process accordingly
437 rem
438 rem *********************************************************
439 rem * process write termination status
440 rem *********************************************************
441 rem
442 lda cstat-* ? status = ready ?
443 tmi t30-* yes
444 rem
445 t20 null
446 aos cwrite-*
447 lda cwrite-* test to see if console may be down
448 cmpa cntrbl-* 377777 octal
449 tnz t25-* no, keep hanging in there
450 rem
451 rem we have tried to go to the console 131071 times.
452 rem it must be down. set a switch to indicate this
453 rem and disable interrupts for the console.
454 rem
455 sel tych select console channel
456 cioc cnmpcw-* connect to mask pcw
457 aos nocon-* set switch to indicate no console
458 tra cdisp-*,* return to dispatcher
459 t25 null
460 ldaq csicw-* re-issue the write command
461 staq csicwa-*,*
462 ldaq cwwicw-*
463 staq cdicwa-*,*
464 cioc cwpcw-*
465 tra cdisp-*,*
466 rem
467 t30 null
468 arl 9
469 icana 32 000040 ? status = ptro ?
470 tze t20-* no, re-issue write command
471 szn cwconf-* ? wcon or wrcon initiated write ?
472 tze wrcont-* wrcon, return to issue read
473 rem
474 texit null
475 inh <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
476 stz cwrite-* no longer in write sequence
477 ldaq cqueaq-* queue user's courtesy call routine
478 ldx1 cquex1-*
479 tsy tmquer-*,*
480 stz conbsy-* clear console busy flag
481 rem
482 szn spint-* ? special interrupt waiting ?
483 tze cdisp-*,* no, return to dispatcher
484 ldaq spaq-* yes, queue special interrupt
485 ldx1 spx1-* processor
486 tsy tmquer-*,*
487 stz spint-*
488 tra cdisp-*,* return to dispatcher
489 rem
490 rem *********************************************************
491 rem * process read termination status
492 rem *********************************************************
493 rem
494 tmread null
495 lda cstat-*
496 arl 9
497 icana 128 000200 ? status = timer runout ?
498 tnz t20-* yes, re-issue write command
499 rem
500 t40 null
501 icana 64 000100 ? status = tro ?
502 tnz t20-* yes, re-issue write command
503 ldx1 cdicwa-*,* no, get last input character
504 lda -1,1,b.1
505 icmpa cntrlx ? control-x ?
506 tze t20-* yes, re-issue write command
507 icmpa cr+pbit ? carriage return ?
508 tze t50-* yes
509 icmpa xoff+pbit ? x-off ?
510 tnz t20-* no, re-issue write command
511 rem
512 t50 null
513 lda cstat-* ? status = ready ?
514 tpl t20-* no, re-issue write command
515 tra texit-*
516 rem
517 rem
518 rem
519 even
520 tmaq oct 13
521 ind tmcon
522 tmx1 zero 0
523 rem
524 tmquer ind dspqur
525 tmeict bss 1 count of extraneous interrupts
526 cntrbl oct 377777
527 even
528 cnmpcw oct 0,010000 mask bit on to disable channel
529 ttls spcon -- console special interrupt processor
530 ************************************************************************
531 *
532 * spcon console special interrupt processor
533 *
534 ************************************************************************
535 rem
536 spcon null
537 szn conbsy-* ? any outstanding console io ?
538 tze sp9-* no, proceed
539 aos spint-* yes, set special interrupt flag
540 tra cdisp-*,* return to dispatcher
541 rem
542 sp9 null
543 lda msg1p-* set message "???"
544 sp9a null
545 sta sp15-*
546 rem
547 sp10 null
548 ldaq spbaq-* write-then-read message 1, 2, or 3
549 ldx1 spbx1-*
550 tsy wrcon-*
551 sp15 zero **
552 zero spicwi
553 tra cdisp-*,* accepted -- return to dispatcher
554 rem
555 ldaq spaqt-* busy -- re-queue with 5-second
556 ldx1 spx1-* time delay
557 tsy tmquer-*,*
558 tra cdisp-*,*
559 rem
560 rem *********************************************************
561 rem * continue after operator's message has been read
562 rem *********************************************************
563 rem
564 spconb null
565 ldx1 spoptb-* x1 points to op-code table
566 rem
567 sp100 null
568 ldaq input-* get 1st 4 characters of input data
569 cmpa 0,1 search
570 tnz sp110-* op-code
571 cmpq 1,1 table
572 tze 2,1* for match
573 rem
574 sp110 null
575 iacx1 3 bump pointer
576 cmpx1 spopnd-* ? end of table ?
577 tnz sp100-* no, continue search
578 rem
579 arl 9
580 icmpa cr+pbit ? null line -- cr only ?
581 tze sp115-* yes, exit
582 rem
583 lda msg3p-* set message "what?"
584 tra sp9a-*
585 rem
586 sp115 null
587 inh <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
588 stz sibusy-* yes, ignore this message
589 tra cdisp-*,*
590 rem
591 rem
592 rem
593 even
594 spicw1 icw msg1,b.0,6
595 spicw2 icw msg2,b.0,8
596 spicw3 icw msg3,b.0,8
597 spicwi icw input,b.0,24
598 spaq vfd 12/0,o6/14,18/spcon
599 spbaq vfd 12/0,o6/14,18/spconb
600 spaqt vfd 12/5,o6/14,18/spcon
601 input bss 12
602 rem
603 pbit bool 200
604 spx1 zero 0
605 spbx1 zero 0
606 spint bss 1
607 sibusy bss 1 "special interrupt processor" flag
608 rem
609 msg1p zero spicw1
610 msg2p zero spicw2
611 msg3p zero spicw3
612 rem
613 msg1 vfd 9/cr,9/lf
614 aci 2,???
615 msg2 vfd 9/cr,9/lf
616 aci 3,more?
617 msg3 vfd 9/cr,9/lf
618 aci 3,what?
619 rem
620 rem
621 rem
622 spoptb zero *+1
623 vfd o18/101102
624 vfd o18/317322
625 vfd 18/xabort
626 vfd o18/120305
627 vfd o18/305113
628 vfd 18/xpeek
629 vfd o18/101314
630 vfd o18/324305
631 vfd 18/xalter
632 vfd o18/324305
633 vfd o18/123324
634 vfd 18/xtest
635 spopnd zero *
636 ttls operator command processing routines
637 ************************************************************************
638 *
639 * abort
640 *
641 * this command causes an immediate system disaster dump if a printer is
642 * configured just as though a processor fault had occurred.
643 *
644 ************************************************************************
645 rem
646 xabort null
647 stz sibusy-*
648 tsy 1,*
649 ind conabt
650 eject
651 ************************************************************************
652 *
653 * peek aaaaa
654 * peek aaaaa,n
655 *
656 * this command causes the contents of specified locations to be written
657 * onto the console teletypewriter. if "n" is present, it specifies the
658 * number of words to be written, otherwise only one word will be written
659 * aaaaa specifies the address of the first, or only, word written.
660 *
661 * up to eight words will be printed per line
662 *
663 ************************************************************************
664 rem
665 xpeek null
666 ldx3 spicwi-* x3 points to input message
667 tsy idx-* extract one or two octal fields
668 rem
669 rem cidxof1 = address of 1st, or only, word to be typed
670 rem cidxof2 = number of words to be typed 0 = one word
671 rem
672 szn idxof2-* if zero was specified, make it 1
673 tnz 2
674 aos idxof2-*
675 rem
676 xpk10 null
677 lda xalmem-*,* mask address to allowable range
678 ansa idxof1-*
679 ldq idxof1-* convert address to ascii
680 ldx3 xpkout-*
681 tsy xpkcnv-*,*
682 rem
683 iacx3 0,b.1 leave extra blank after address
684 ila 9 initialize tally
685 sta xpkicw+1-*
686 rem
687 lda idxof2-* get remaining count
688 icmpa 8
689 tmi 2 if it's less than 8, use as is
690 ila 8 else use 8
691 rem
692 iera -1 ca <- -ca
693 iaa 1
694 sta remain-* hang on to remainder
695 rem
696 xpk15 null conversion loop
697 iacx3 0,b.1 precede word with a blank
698 ldq idxof1-*,* convert data word to ascii
699 tsy xpkcnv-*,*
700 rem
701 ila 7
702 asa xpkicw+1-* increment tally
703 aos idxof1-* and data address
704 aos remain-* more data words for this line?
705 tnz xpk15-* yes, go convert next one
706 rem else write out the line
707 rem
708 xpk20 null
709 ldaq xpkqa1-*
710 ldx1 xpkqx1-*
711 tsy xpkwc-*,* write address and contents
712 zero xpkicw
713 tra xpdisp-*,* accepted
714 tra xpk20-* busy
715 rem
716 rem *********************************************************
717 rem * continue processing after 1st write terminates
718 rem *********************************************************
719 rem
720 xpeekb null
721 rem
722 ila -8 any more words to be typed?
723 asa idxof2-* yes if result > 0
724 tmi 2 no
725 tnz xpk10-* yes
726 rem
727 xpk50 null
728 lda msg2p-* set message "more?"
729 tra sp9a-*
730 rem
731 rem
732 rem
733 even
734 xpkqa1 vfd 12/0,o6/14
735 ind xpeekb
736 xpkicw icw xpkmsg,b.0,**
737 rem
738 rem new-line and 64 blanks initially
739 xpkmsg vfd 9/cr,9/lf
740 aci 16
741 aci 16
742 rem
743 xpkout zero xpkmsg+1,b.0
744 xpkcnv ind octasc
745 xpkqx1 zero 0
746 xpkwc ind write
747 xpdisp ind secdsp
748 remain bss 1 number of words remaining to be printed on line
749 eject
750 ************************************************************************
751 *
752 * alter aaaaa,bbbbbb
753 *
754 * this command causes the octal number bbbbbb to be stored in the
755 * location whose absolute octal address is aaaaa.
756 * the octal address, aaaaa, will be "anded" with either 077777 or
757 * 037777, depending on the size of core storage in use.
758 *
759 ************************************************************************
760 rem
761 xalter null
762 ldx3 spicwi-* x3 points to input message
763 tsy idx-* extract one or two octal fields
764 rem
765 lda idxof1-* limit address to 16k or 32k size
766 ana xalmem-*,*
767 cax1
768 lda idxof2-* store data in specified address
769 sta 0,1
770 ila 1
771 sta idxof2-* peek location just altered
772 tra xpk10-*
773 rem
774 rem
775 rem
776 xalmem ind .crmem contains highest address in core
777 eject
778 ************************************************************************
779 *
780 * test call the on-line t&d system
781 *
782 * this command will allow the future on-line t&d system to be called by
783 * the 355 console operator.
784 *
785 ************************************************************************
786 rem
787 xtest null
788 stz sibusy-*
789 tra 1,* temporary return
790 ind secdsp
791 rem
792 ttls idx -- console input data extraction subroutine
793 ************************************************************************
794 *
795 * this subroutine is used to extract octal numbers from the input string
796 * typed on the system console. the routine was designed to permit the
797 * operator to make quick corrections to the octal numbers he may be
798 * required to type.
799 *
800 * for the purposes of this subroutine, the input string is assumed to be
801 * one octal number or two octal numbers separated by a comma. in the
802 * examples which follow, the first column is the input string, the
803 * symbol <eom> stands for either a "carriage return" or "x-off"
804 * character. the second and third columns are the output of this sub-
805 * routine -- idxof1 = octal field #1 and idxof2 = octal field #2
806 *
807 * as the input string is scanned from left to right, octits which is
808 * the word used to refer to octal integers are saved in one of the
809 * "octal field registers" until a non-octit is encountered. if this
810 * non-octit is --
811 *
812 * -- <eom>, control is immediately returned to the calling program.
813 *
814 * -- a comma, the saving of octits in the current octal field
815 * register is stopped, a pointer x2 is bumped to point to
816 * the next octal field register, and scanning continues.
817 *
818 * -- letter x, all octits and resulting octal fields are ignored,
819 * the octal field registers are reset to zero, and scanning
820 * begins with the next input character.
821 *
822 * -- any other non-octit, the octits thus far typed and being saved
823 * in the current octal field register are ignored, the
824 * current octal field register is reset to zero, and
825 * scanning continues at the next character.
826 *
827 * the octal field registers will contain a maximum of six octits. since
828 * each new octit enters the register at the right end by moving the pre-
829 * vious contents left, typing more than six octits removes the high
830 * order extra octits and saves only the low order six octits.
831 *
832 * examples --
833 *
834 * input string idxof1 idxof2
835 *
836 * 123456<eom> 123456 000000
837 * 123456,654321<eom> 123456 654321
838 * 1<eom> 000001 000000
839 * 1,2<eom> 000001 000002
840 * 1234567432,7654321346<eom> 567432 321346
841 * 13e12,456e556<eom> 000012 000556
842 * 123,456x321,654<eom> 000321 000654
843 *
844 ************************************************************************
845 *
846 * calling sequence --
847 *
848 * x3 = character/word address of start of the input string
849 *
850 * tsy idx-*
851 *
852 * exit conditions --
853 *
854 * x2 = address of last octal field register used
855 *
856 * n.b. -- future developers...
857 * the following must be done to modify this subroutine to
858 * handle more than the present two octal fields.
859 * 1. following the instruction at <idx10+2>,
860 * insert <stz idxof3-*>, <stz idxof4-*>, etc.
861 * 2. change the instruction at <idxlof> to <idxlof zero idxof#+1>,
862 * where # is the number of octal fields.
863 * 3. following the instruction at <idxof2>,
864 * insert <idxof3 bss 1>, <idxof4 bss 1>, etc.
865 *
866 ************************************************************************
867 rem
868 idx ind **
869 rem
870 idx10 null
871 ldx2 idxfof-* x2 points to octal field register
872 stz idxof1-* clear octal field registers
873 stz idxof2-*
874 stz idxpco-* clear pco flag
875 rem
876 idx20 null
877 lda 0,3,b.0 get current input character
878 icmpa cr+pbit ? carriage return ?
879 tze idx-*,* yes, return to user
880 icmpa xoff+pbit ? x-off ?
881 tze idx-*,* yes, return to user
882 iacx3 0,b.1 bump input character pointer
883 cmpx2 idxlof-* ? more than 2 octal fields ?
884 tze idx-*,* yes, return to user
885 rem
886 iana 127 000177 strip parity bit
887 caq
888 qrl 3
889 iaq -6 ? current character an octit ?
890 tnz idx30-* no
891 szn idxpco-* ? previous character an octit ?
892 tnz 3 yes
893 stz 0,2 no, clear current octal field register,
894 aos idxpco-* set pco flag
895 ldq 0,2 store octit
896 als 18-3 in current octal
897 llr 3 field
898 stq 0,2 register
899 tra idx20-*
900 rem
901 idx30 null
902 stz idxpco-* clear pco flag
903 icmpa 44 000054 ? current input character a comma ?
904 tnz 3 no
905 iacx2 1 yes, bump pointer to next field reg.
906 tra idx20-*
907 rem
908 icmpa 88 000130 ? current input character the letter x ?
909 tze idx10-* yes, clear all and start over
910 tra idx20-* no, resume scanning
911 rem
912 rem
913 rem
914 idxfof zero idxof1
915 idxlof zero idxof2+1
916 idxof1 bss 1 octal field register #1
917 idxof2 bss 1 octal field register #2
918 idxpco bss 1 previous character octit flag
919 end