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
11 lbl ,utilities
12 ttl fnp utility programs for mcs
13 ***************************************************************************
14 *
15 * note: cs means "central system"
16 *
17 ***************************************************************************
18 * change list
19 *
20 * modified on july 24, 1972 by rbs to add code to handle dia
21 *
22 * modified october 1974 by rsc for new system
23 *
24 * modified july 4 1979 by bsg for echo negotiation
25 *
26 * modified 1979 august 23 by art beattie to add 'setptw', 'mvpgsc' and
27 * 'mvpgtg' routines.
28 *
29 * modified january 19, 1981 by robert coren to add metering
30 *
31 * modified march 1982 by robert coren to add space management in high
32 * memory
33 *
34 ***************************************************************************
35
36 * HISTORY COMMENTS:
37 * 1) change86-04-23Coren, approve86-04-23MCR7300,
38 * audit86-05-19Beattie, install86-07-10MR12.0-1089:
39 * Modified november 1984 by robert coren to suppress check for eighth bit
40 * before looking character up in echo break table.
41 * 2) change88-01-15Farley, approve88-02-22MCR7843,
42 * audit88-02-22Beattie, install88-03-0112.2-1029:
43 * added check in the inproc routine to see if there is no more room on the
44 * line for echo negotiation t.scll=0 after echoing a character. If no
45 * room is left the input buffer should be sent to the host.
46 * END HISTORY COMMENTS
47 rem
48 rem
49 pcc on
50 pmc off
51 detail on
52 editp on
53 rem
54 rem
55 symdef util
56 rem
57 rem system service package
58 symdef meterc counting meter subroutine
59 symdef metert timing meter subroutine
60 symdef gettib get a tib address
61 symdef exist * summary of iom channels that exist
62 symdef hfv hardware fault vector entry base address
63 symdef ignore ignore interrupts routine
64 symdef badint extraneous interrupts routine
65 symdef iomflt iom channel fault routine
66 symdef conabt console operator abort
67 symdef octasc binary-octal ascii routine
68 symdef conchn console channel number
69 symdef outprc subroutine to process "output" subop
70 symdef fulbuf subroutine to check if a buffer is full
71 symdef chkiv checks interrupt vectors
72 symdef utsave place where registers get saved
73 symdef puteco subroutine to add char to echo buffer
74 symdef inproc subroutine to copy chars into input buffers
75 symdef move looks up chars in carriage movement table
76 symdef setptw converts absolute address to a virtual address
77 symdef setbpt converts buffer address to virtual
78 symdef cvabs converts a virtual address to absolute
79 symdef mvpgsc move data paging source address
80 symdef mvpgtg move data paging target address
81 symdef mvplmm move paged lower memory maximum address
82 symdef conman set to -1 by init if console_man is in image
83 rem
84 symdef getbuf
85 symdef frebuf
86 symdef frelbf
87 symdef getubf
88 symdef getbfh get a buffer in high memory
89 symdef frebfh free a buffer in high memory
90 symdef getmem
91 symdef fremem
92 symdef fresml
93 symdef getbfm interrupt time metering area
94 symdef fpsel 'sel' instructions patched by init
95 symdef obsel
96 rem
97 symref dicell cs interrupt cells
98 symref dmbx cs mailbox address
99 symref contip interrupt processor for console terminate
100 symref wcon routine to write on console
101 symref ctrl control tables
102 symref istat status entry of interpreter
103 symref itest test-state entry of interpreter
104 symref trace
105 symref ecgifl accept-input queuer
106 symref denq dia enqueuing routine
107 symref derrq dia error message queue
108 symref hcheck hsla_man starts echoing
109 symref simclk simulated clock value
110 symref dspqur dispatcher queuer
111 symref secdsp secondary dispatcher
112 symref mincs
113 symref mincd
114 symref mupdat
115 rem
116 rem
117 pmc save,on
118 util null
119 start util,4
120 rem
121 rem
122 ttls multiply and divide macros
123 rem
124 mpy macro multiplier loca tion-*
125 mpf #1
126 lrl 1
127 endm mpy
128 rem
129 rem
130 dvd macro divisor locatio n-*
131 qls 1
132 dvf #1
133 endm dvd
134 rem
135 systm
136 rem
137 comreg
138 rem
139 tib
140 rem
141 meters
142 rem
143 intm
144 rem
145 sfcm hsla
146 rem
147 buffer
148 rem
149 devtab
150 rem
151 dlytbl
152 rem
153 csbits
154 rem
155 pmc restore
156 ttls miscellaneous symbols
157 rem
158 ************************************************************************
159 * miscellaneous
160 ************************************************************************
161 rem
162 rem
163 k equ 1024
164 itprty equ 7 priority for timeout routine
165 rem
166 bcdspc bool 20
167 rem
168 null bool 000
169 space bool 040
170 blank equ space
171 ht bool 011
172 tab equ ht
173 lf bool 012
174 cr bool 015
175 rubout bool 177
176 rem
177 mask6 bool 077
178 mask7 bool 177
179 rem
180 hslafl bool 1000
181 rem return flags from inproc
182 reteco bool 001 chars put in echo buffer
183 retsus bool 002 output-suspend character
184 retres bool 004 output-resume character
185 rem
186 oct002 bool 002
187 oct003 bool 003
188 oct005 bool 005
189 oct007 bool 007
190 oct017 bool 017
191 oct020 bool 020
192 oct177 bool 177
193 sndout bool 105 "send output" mailbox opcode
194 errmsg bool 115 "error message" mailbox opcode
195 rem
196 fbdevc bool 37 device code mask
197 fcdevc equ 13 device code lsb position
198 dclock bool 01 device code for fnp's clocks
199 dprint bool 06 device code for printer
200 ddia bool 02 device code for dia
201 dcon bool 05 device code for console
202 rem
203 brkall equ -1 break on every character
204 brkctl equ -2 break on all control characters
205 brknxt equ -3 break on char after specifed char
206 rem
207 ct.dev equ 1 offset in ctrl of array of device table addrs
208 rem
209 rem
210 rem
211 rem get and release buffer symbol definitions
212 rem
213 adrs equ 0 address
214 wrdsz equ 1 number of words in buffer
215 fwdpt equ 2 forward pointer
216 bckpt equ 3 backward pointer
217 rem
218 rem
219 rem trace types
220 rem
221 mt.get equ 1 allocating single buffer
222 mt.fre equ 2 freeing single buffer
223 mt.gtc equ 3 allocating buffer chain
224 mt.frc equ 4 freeing buffer chain
225 rem
226 rem
227 ttls miscellaneous external values
228 rem
229 ************************************************************************
230 *
231 * Miscellaneous values shared by several modules, but kept here
232 * for simplicity.
233 *
234 ************************************************************************
235 rem
236 rem
237 rem
238 rem **********************************************
239 rem *
240 rem * "exist" -- a summary of which IOM chans
241 rem * init found to exist. the mapping
242 rem * used herein is: if bit N is on, the channel
243 rem * N has a valid channel attached to it.
244 rem *
245 rem **********************************************
246 rem
247 rem
248 exist bss 1
249 rem
250 rem
251 ttls fault processing routines
252 rem *********************************************************
253 rem * first level fault processing
254 rem *********************************************************
255 rem
256 hfv null
257 f0 ind ** pf
258 tsy fp-*
259 f1 ind ** po
260 tsy fp-*
261 f2 ind ** mp
262 tsy fp-*
263 f3 ind ** op
264 tsy fp-*
265 f4 ind ** ov
266 tsy fp-*
267 f5 ind ** im
268 tsy fp-*
269 f6 ind ** dc
270 tsy fp-*
271 f7 ind ** ii
272 tsy fp-*
273 rem
274 rem the following "fault entry points" are not caused by any
275 rem of the eight above processor faults. they are entered
276 rem by software which detects the indicated condition.
277 rem
278 badint ind ** xi -- extraneous interrupt
279 tsy fp-*
280 iomflt ind ** cf -- iom channel fault
281 tsy fp-*
282 conabt ind ** cn -- console operator abort
283 tsy fp-*
284 eject
285 rem *********************************************************
286 rem * second level fault processing
287 rem *********************************************************
288 rem
289 fp ind **
290 sti save+1-* save indicator register
291 ldi fp.inh-* set "inh" and parity inh
292 staq save+2-* save registers
293 lda iomflt+1-* get iom channel fault vector
294 sta fvsave-* and save it
295 lda l.a008-* tsy -1*
296 sta iomflt+1-* so we don't get clobbered during fault handling
297 stx1 save+4-*
298 stx2 save+5-*
299 stx3 save+6-*
300 rier
301 sta save+7-* save interrupt level enable register
302 lda a.a001-*,* etmb
303 sta save+8-* save elapsed timer value
304 ldx1 fp-* x1 = address+2 of original ic
305 lda -2,1 ar = original ic
306 sta save-* save original instruction counter value
307 rem
308 cx1a compute
309 sba a.a002-* f0+2 fault
310 arl 1 number
311 sta fltnum-* and save
312 rem
313 icmpa 9 is it an iom channel fault?
314 tnz fp006-* no, continue
315 ldx3 a.a012-* addrtyfts, fault status for chan 0
316 lda 0,3 get fault status
317 tze fp001-* not chan 0, check hsla channels
318 icmpa 12 is status o14 on chan 0?
319 tnz fp006-* no, go ahead and crash
320 tra fp004-* yes, queue error message and resume work
321 rem
322 fp001 null check for hsla parity error
323 ldx3 a.a016-* addrh1fts, fault status for hsla 1
324 fp002 null
325 lda 0,3 get status
326 tnz fp003-* non-zero, take a look at it
327 iacx3 1 zero. was this last hsla fault status?
328 cmpx3 a.a017-* addrh3fts + 1
329 tnz fp002-* no, check next one
330 tra fp006-* yes, it's something else, crash
331 rem
332 fp003 null non-zero hsla fault status
333 cmpa l.a007-* =o415 parity
334 tnz fp006-* other bad status, crash
335 rem
336 fp004 null queue error message
337 sta rstat-* save fault status
338 rem
339 ila 1 get error message code
340 sta rfault-* save
341 cx3a get address of fault status word
342 sba a.a012-* addrtyfts -- subtract origin to get chan no.
343 sta ric-*
344 stz rword-* unused
345 rem
346 ilq errmsg get the opcode for derrq
347 ldx2 a.a014-* =reason get addr of data
348 tsy a.a013-*,* =derrq queue the error_message
349 rem
350 stz 0,3 zero the fault status so we don't see it again
351 tra a.a015-*,* restart the processor
352 rem
353 fp006 lda fltnum-* restor the fault number
354 als 3
355 ada a.a009-* f.name compute address
356 cax1 of and
357 rem get and save fault name
358 ila -4 four doublewords worth
359 sta fptemp-*
360 ldx2 a.a010-* addrfltnam
361 fp008 null
362 ldaq 0,1 pick up two words
363 staq 0,2 store them
364 iacx1 2 bump from and to pointers
365 iacx2 2
366 aos fptemp-* done?
367 tnz fp008-* no, do it again
368 rem
369 rem
370 rem
371 rem
372 rem *********************************************************
373 rem * mask all hsla's and lsla's
374 rem *********************************************************
375 rem
376 ila h1ch starting with first hsla channel
377 fp009 null
378 cax3 hang on to iom channel no.
379 ora l.a002-* =o730000 "sel" opcode
380 sta msksel-*
381 msksel zero patched with sel instruction
382 cioc dispcw-* issue mask pcw
383 cx3a
384 iaa 1 next iom channel
385 icmpa l6ch+1 finished lsla's?
386 tmi fp009-* no, do it again
387 rem
388 rem
389 rem *********************************************************
390 rem * set interrupt level enable register to enable
391 rem * levels 0, 1, and 2 only. set up ignore iv's
392 rem * for all devices on levels 0, 1, and 2 except
393 rem * console.
394 rem *********************************************************
395 rem
396 lda l.a001-* =o700000
397 sier
398 rem
399 ldx3 l.a003-* =o000400
400 ldx2 a.a007-* sd.iv+48-3
401 fp010 null
402 ldaq -16,3 move iv's for levels 0, 1, and 2
403 sta 0,2 to save area sd.iv and replace with
404 stq 1,2 address of ignore routine
405 lda -14,3
406 sta 2,2
407 ldaq a.a004-* ignore
408 staq -16,3
409 sta -14,3
410 iacx2 -3
411 iacx3 -16
412 tnz fp010-*
413 rem
414 lda conchn-* re-initialize console iv's
415 tmi fp015-*
416 als 4
417 cax3
418 lda a.a008-*
419 sta 2,3
420 rem
421 rem
422 rem ***************************************************
423 rem * use software fault vector to write
424 rem * farewell message on console
425 rem ***************************************************
426 rem
427 fp015 null
428 ldx1 fltnum-*
429 adcx1 a.a003-* sfv
430 tsy 0,1*
431 rem
432 rem
433 rem *******************************************************
434 rem * send cs reason for crash
435 rem *******************************************************
436 rem
437 rem
438 lda fltnum-* get fault type code
439 sta rfault-*
440 rem get cs address word 6 of mailbox header
441 lda a.a011-*,* dmbx
442 iaa 6
443 sta dcwlst-* put it in dcw
444 alp 18 fix parity
445 tnz fp16-* odd, nothing to do
446 lda l.a005-* parity bits
447 orsa dcwlst+1-*
448 rem
449 fp16 null fix parity on second half of dcw
450 lda dcwlst+2-*
451 alp 18
452 tnz fp17-*
453 lda l.a005-*
454 orsa dcwlst+3-*
455 rem
456 fp17 null fix parity in list icw address for pcw
457 lda licadr-*
458 alp 18
459 tnz fp18-*
460 ldq l.a006-* =o060070
461 tra 2
462 fp18 null
463 ilq 56 i.e., o000070
464 staq a.a005-*,* dimb dia pcw mailbox
465 rem
466 fpsel sel **
467 cioc a.a005-*,* dimb
468 rem
469 rem
470 rem *********************************************************
471 rem * shut down all io devices
472 rem *********************************************************
473 rem
474 tsy a.a006-*,* obit disconnect the cs
475 rem
476 ldaq diapcw-* insert mask pcw into
477 staq a.a005-*,* dia pcw mailbox
478 rem
479 ila 16 * pick up number of channels to mask
480 fp020 cax3 * put current channel num in X3
481 ora l.a002-* * =o730000 get the "sel" op-code
482 sta fp030-* * and store for execution
483 fp030 zero * ALTRD patched to "sel" instruction
484 cioc dispcw-* * issue the masking PCW
485 rem
486 fp.040 cx3a * get current channel into A reg
487 iaa -1 * subtract one from it
488 tpl fp020-* * and if still positive, go mask it
489 rem
490 rem
491 rem
492 tra stop-* that's all, go to sleep
493 eject
494 even
495 dispcw oct 0,010000 mask bit on to disable channel
496 diapcw oct 0,070000 dia pcw with parity bits
497 l.a001 oct 700000
498 l.a002 oct 073000
499 l.a003 zero 256
500 l.a004 zero oct020
501 l.a005 oct 060000
502 l.a006 oct 060070
503 l.a007 oct 000415 iom parity fault status
504 l.a008 tsy -1,* used to make fault vector into nop
505 rem
506 a.a001 ind etmb elapsed timer mailbox address
507 a.a002 zero f0+2
508 a.a003 zero sfv
509 even
510 a.a004 ind ignore
511 ind ignore
512 a.a005 ind dimb dia mailbox address
513 a.a006 ind obit
514 a.a007 zero sd.iv+48-3
515 a.a008 ind contip console terminate interrupt proc.
516 a.a009 zero f.name
517 a.a010 zero fltnam
518 a.a011 ind dmbx
519 a.a012 ind tyfts
520 a.a013 ind derrq
521 a.a014 ind reason
522 a.a015 ind pwron
523 a.a016 ind h1fts iom fault status word, hsla 1
524 a.a017 ind h3fts+1 1 word past iom fault status word for hsla 3
525 a.a018 ind iomflt+1 to restore branch address
526 fp.inh oct 030000
527 rem
528 even
529 utsave null symdef symbol
530 save bss 9 ic i a q x1 x2 x3 er et
531 fltnum bss 1 save current fault number
532 fltnam bss 8 save current fault name
533 conchn zero tych = console ch no.
534 fptemp bss 1
535 fvsave bss 1 place to save iom channel fault vector
536 rem
537 rem
538 even
539 reason null 72 bits sent to cs to tell why we crashed
540 rfault bss 1 fault type code
541 ric bss 1 instruction counter
542 rstat bss 1 iom fault status if applicable
543 rword bss 1 contents of fault word, or iom channel
544 rem
545 even
546 lsticw zero dcwlst,w.2
547 oct 4
548 rem
549 rem dcw list for sending reason to cs
550 dcwlst zero cs address filled in later
551 oct 75 fnp -> cs opcode parity added later
552 zero reason,w.2 fnp address
553 oct 2 tally parity added later
554 zero
555 oct 060070 disconnect opcode with parity
556 zero 0,w.2
557 oct 020000 parity
558 rem
559 rem
560 even
561 licadr zero lsticw,w.2
562 rem
563 rem
564 rem
565 even
566 f.name ascii 8,power off fault mnemonic names
567 ascii 8,power on
568 ascii 8,memory parity
569 ascii 8,illegal opcode
570 ascii 8,overflow
571 ascii 8,store fault
572 ascii 8,divide check
573 ascii 8,illegal int
574 ascii 8,extra int
575 ascii 8,iom fault
576 ascii 8,console abort
577 eject
578 rem *********************************************************
579 rem * software fault vectors
580 rem *********************************************************
581 rem
582 sfv null
583 ind ignore pf
584 ind ignore po
585 ind mempar mp
586 ind illop op
587 ind icprt ov
588 ind icprt im
589 ind icprt dc
590 ind ignore ii
591 ind ignore xi
592 ind chflt cf
593 ind ignore cn
594 rem
595 rem
596 rem
597 eject
598 ************************************************************************
599 * power off fault processing routine
600 ************************************************************************
601 rem
602 stop null
603 pwroff null
604 ila 0 disable all interrupts and stop
605 sier
606 dis
607 tra -1
608 rem
609 rem
610 rem
611 ************************************************************************
612 * power turn on fault processing routine
613 ************************************************************************
614 rem
615 pwron null
616 inh
617 lda save+7-* restore interrupt level enable register
618 sier
619 lda save+8-* restore elapsed timer value
620 sta a.a001-*,* etmb
621 lda fvsave-* pick up saved iom channel fault vector
622 sta a.a018-*,* iomflt+1 restore it
623 ldaq save+2-* restore arithmetic registers
624 ldx1 save+4-*
625 ldx2 save+5-*
626 ldx3 save+6-*
627 ldi save+1-*
628 tra save-*,* return to point of interruption
629 rem
630 rem
631 rem
632 ************************************************************************
633 * ignore interrupts routine
634 ************************************************************************
635 rem
636 ignore ind **
637 tra -1,*
638 rem
639 eject
640 ************************************************************************
641 * routine to print faulting ic and possibly instruction
642 * on console
643 ************************************************************************
644 rem
645 illop ind ** this entry to print instruction as well
646 aos wflag-* set flag
647 lda illop-* copy return point
648 sta icprt-*
649 tra icp010-*
650 rem
651 rem this entry to print ic only
652 rem
653 icprt ind **
654 stz wflag-*
655 icp010 null both come to here
656 ldx2 a.i007-* addrmsgnam
657 ldx3 a.i005-* addrfltnam get address of fault name
658 ila -4 4 doublewords worth
659 sta itemp-* to move it into message
660 icp020 null
661 ldaq 0,3
662 staq 0,2
663 iacx2 2
664 iacx3 2
665 aos itemp-*
666 tnz icp020-* if not done, do next two words
667 rem
668 ldq a.i006-*,* save get ic value
669 iaq -1 really points to next instruction
670 stq itemp-* save it
671 stq a.i012-*,* ric save for sending to cs
672 ldx3 a.i001-* addricasci
673 rem now convert it to ascii and put it in
674 tsy a.i003-*,* octasc
675 rem
676 szn wflag-* write out word too?
677 tze icp030-* no, go write on console
678 rem else convert instruction word
679 rem to octal ascii and put in message
680 ldx3 itemp-*
681 ldq 0,3 got word
682 stq a.i013-*,* rword save for sending to cs
683 ldx3 a.i002-* addrwdasci
684 tsy a.i003-*,* octasc
685 rem
686 ila 16 increase tally in icw
687 asa flticw+1-*
688 rem
689 icp030 null now write on console
690 szn conman-* is console_man in image?
691 tze icprt-*,* no. skip console stuff and return
692 tsy a.i004-*,* wcon yes. go do it
693 zero flticw argument is address of data icw
694 nop if no console, don't worry
695 tra icprt-*,* return to caller
696 rem
697 rem
698 ************************************************************************
699 * routine to write out message for iom channel fault
700 ************************************************************************
701 rem
702 chflt subr chf
703 rem
704 rem write the channel number and
705 rem associated fault status
706 rem
707 rem we start by finding a non-zero fault status
708 ilq 0 initialize channel number
709 ldx3 a.i008-* addriom fault status
710 chf010 null
711 lda 0,3
712 tnz chf020-* non-zero, we got it
713 iaq 1 else bump channel number
714 iacx3 1 and fault status pointer
715 tra chf010-* and try again
716 rem
717 chf020 null channel no. is in q
718 sta itemp-* save fault status
719 staq a.i011-*,* rstat save both for sending to cs
720 ldx3 a.i009-* addrchnasc
721 tsy a.i003-*,* octasc convert channel no.
722 rem
723 lda chnasc+2-* pick up low-order 2 digits
724 sta chfnum-* put them in console message
725 rem
726 ldq itemp-* get fault status and convert it to ascii
727 ldx3 a.i010-* addrchfst
728 tsy a.i003-*,* octasc
729 rem now just write the message out
730 szn conman-* is console_man in image?
731 tze chfret-* no. skip console stuff
732 tsy a.i004-*,* wcon yes. go do it
733 zero chficw
734 nop
735 rem
736 chfret null
737 return chflt
738 rem
739 rem
740 ************************************************************************
741 * routine to write out memory parity fault message
742 * we will go through all of memory until we find something
743 * that results in parity indicator coming on
744 ************************************************************************
745 rem
746 mempar subr mmp
747 stz pagbas-* initialize this
748 lda a.i015-*,* .crmem
749 cmpa l.i001-* =o100000 more than 32k?
750 tpl mmp010-* no
751 sta memlst-* then that's the end
752 tra mmp020-*
753 mmp010 lda l.i002-* =o077777 more than 32k, first pass will stop there
754 sta memlst-*
755 ldx3 a.i016-*,* .crpte
756 stz 0,3 disable paging for now
757 mmp020 stz tstadr-* start at 0
758 ldi a.i014-*,* fp.inh make sure we start with clean indicators
759 mmp030 lda tstadr-*,* pick up contents of next word
760 sti tstind-* see what happened to the indicators
761 lda l.i003-* =o002000, parity error indicator bit
762 cana tstind-* is it on?
763 tnz mmp050-* yes, we found it
764 lda tstadr-* no, we'll advance the address
765 cmpa memlst-* finished this pass?
766 tze mmp040-* yes
767 aos tstadr-* no, increment test address
768 tra mmp030-* and go around again
769 rem
770 mmp040 ldq pagbas-* see if current address is real or virtual
771 tze mmp045-* it's real
772 iaq 255 it's virtual, test for real limit
773 cqa
774 mmp045 cmpa a.i015-*,* .crmem have we reached the end?
775 tpl mmp060-* yes, we didn't find it
776 iaa 1 else do next page
777 sta pagbas-* this is the base of it
778 tsy a.i017-*,* setptw
779 rem note that this is safe because we've tested here
780 sta tstadr-* this is presumably 077400 virtual page base
781 iaa 255 this is the last virtual address in it
782 sta memlst-*
783 tra mmp030-* start again
784 rem
785 mmp050 null here when we find a parity indicator
786 cmpa l.i004-* o077400 in window?
787 tmi mmp070-* no, it's exact
788 szn pagbas-* but we were really there?
789 tze mmp070-* yes
790 sba l.i004-* else reduce to offset within page
791 ada pagbas-* add page address
792 tra mmp070-* this is it
793 mmp060 ila -1 we never found it, use dummy value
794 mmp070 sta a.i012-*,* ric save it to send to cs
795 szn conman-* is there a console?
796 tze mmpret-* no, we're done
797 caq get value in q
798 ldx3 a.i018-* addr mmpadr
799 tsy a.i003-*,* octasc
800 tsy a.i004-*,* wcon
801 zero mmpicw
802 nop
803 mmpret return mempar
804 rem
805 rem
806 rem
807 a.i001 zero icasci,b.0
808 a.i002 zero wdasci,b.0
809 a.i003 ind octasc binary to octal ascii conversion routine
810 a.i004 ind wcon console-writing routine
811 a.i005 ind fltnam
812 a.i006 ind save contains ic
813 a.i007 zero msgnam
814 a.i008 zero fltst iom fault status
815 a.i009 zero chnasc,b.0
816 a.i010 zero chfst,b.0
817 a.i011 ind rstat used in sending crash info to cs
818 a.i012 ind ric likewise
819 a.i013 ind rword likewise
820 a.i014 ind fp.inh
821 a.i015 ind .crmem
822 a.i016 ind .crpte
823 a.i017 ind setptw
824 a.i018 ind mmpadr,b.0
825 rem
826 l.i001 oct 100000
827 l.i002 oct 077777
828 l.i003 oct 002000 parity error indicator
829 l.i004 oct 077400 base of paging 'window'
830 rem
831 conman oct 0 set to -1 by init if console_man is in image
832 rem
833 even
834 flticw icw fltmsg,b.0,38
835 zero to force fltmsg odd to force msgnam even
836 rem
837 detail save,off
838 fltmsg saci cr,lnf
839 msgnam bss 8 fault name
840 ascii 7,fault -- ic =
841 icasci bss 3
842 ascii 4,, word =
843 saci sp,sp
844 wdasci bss 3
845 rem
846 rem
847 even
848 chficw icw chfmsg,b.0,48
849 rem
850 chfmsg saci cr,lnf
851 ascii 10,iom fault: ch annel
852 chfnum bss 1
853 ascii 9,, fault status -
854 chfst bss 3
855 rem
856 even
857 mmpicw icw mmpmsg,b.0,34
858 rem
859 mmpmsg saci cr,lnf
860 ascii 13,memory parity referencing
861 mmpadr bss 3
862 detail restore
863 rem
864 rem
865 chnasc bss 3
866 wflag bss 1
867 itemp bss 1
868 memlst bss 1 last address to test in each pass
869 pagbas bss 1 base of current page
870 tstadr bss 1 adress on which to test parity
871 tstind bss 1 indicators resulting from test
872 rem
873 rem
874 eight
875 sd.iv bss 3*16 level 0 1 and 2 iv's at time of fault
876 ttls obit -- notify cs of fnp's death
877 ************************************************************************
878 *
879 * this subroutine will send an "emergency interrupt" to the cs,
880 * thereby indicating that the fnp is about to crash
881 *
882 ************************************************************************
883 rem
884 obit ind **
885 lda obit0-* as a last gesture of politeness, allow
886 iaa -1 the dia to xmt its last message
887 tnz -1
888 rem
889 lda obit1-*,* get emergency interrupt cell
890 iana 7 isolate it
891 caq put in q
892 qls 6 position
893 adq obit3-* get interrupt cs command
894 cqa save this in a
895 qlp 18 get parity on this word
896 tnz 2 already odd
897 ora obit4-* make odd parity lower
898 caq put correctly paritized word back in q
899 lda obit5-* load word with 36 bit xfer mode bit on
900 staq obit2-*,*
901 rem
902 obsel sel ** so long, its been good to know you
903 cioc obit2-*,*
904 tra obit-*,*
905 rem
906 rem
907 rem
908 obit0 dec 3500
909 obit1 ind dicell
910 obit2 ind dimb
911 obit3 oct 000073 upper half odd parity and int cs cmd
912 obit4 oct 020000 lower half parity bit
913 obit5 zero 0,w.2 word with 36-bit xfer mode
914 ttls bdecac -- binary-decimal ascii routine
915 ************************************************************************
916 * this routine converts a binary number into four ascii characters which
917 * represent the decimal equivalent of the number.
918 *
919 * the input binary number must be non-negative and <= 9999 23417 oct.
920 *
921 * calling sequence --
922 *
923 * cx3 = ch/wd address of where 1st digit is to be stored.
924 * car = the binary number to be converted.
925 * tsy bdecac-*
926 *
927 * on return, x3 will point to the position following the 4th digit.
928 ************************************************************************
929 rem
930 bdecac ind **
931 sti bdasvi-* save indicators
932 inh inhibit interrupts
933 stx2 bdasx2-* save x2
934 ilq -4 set loop counter
935 stq bdactr-* for 4 iterations
936 ldx2 bdacon-* set x2 for 1st conversion constant
937 rem
938 bda1 null
939 ilq 0 clear q-register
940 lrs 18-1-3 build dividend multiplied by 8
941 dvf 0,2 produce a bcd digit in a-register
942 iora 48 060 convert it to ascii code
943 sta 0,3,b.0 store in user's area
944 cqa
945 rem
946 iacx3 0,b.1 bump pointer to next digit store position
947 iacx2 1 bump pointer to next conversion constant
948 aos bdactr-* ? done this 4 times, yet ?
949 tnz bda1-* nope
950 rem
951 ldx2 bdasx2-* restore x2
952 ldi bdasvi-* restore indicators
953 tra bdecac-*,* restore control to user
954 rem
955 bdasvi bss 1 safe store indicators
956 bdasx2 bss 1 safe store x2
957 bdactr bss 1 loop counter
958 bdacon zero *+1 conversion constant initial pointer
959 dec 8000,6400,5120,4096
960 ttls octal-to-bcd/ascii subroutines
961 ************************************************************************
962 * octbcd/octasc will convert the six octits in the quotient register
963 * into six 6-bit/9-bit bcd/ascii characters and store them in sequential
964 * positions beginning at the address in x3.
965 *
966 * calling sequence --
967 *
968 * ldq <octal word to be converted>
969 * ldx3 <ch/wd address for 1st character>
970 * tsy <octbcd/octasc>
971 ************************************************************************
972 rem
973 octbcd ind **
974 stx2 octsv-* save x2
975 ldx2 octsv+1-* set x2 = 6
976 ila 0
977 lls 3
978 sta 0,3,c.0 store character
979 iacx3 0,c.1 bump character pointer
980 iacx2 -1 ? finished ?
981 tnz -5 no
982 ila bcdspc yes, store a space
983 sta 0,3,c.0
984 iacx3 0,c.1
985 ldx2 octsv-* restore x2
986 tra octbcd-*,* return
987 rem
988 octasc ind **
989 stx2 octsv-* save x2
990 ldx2 octsv+1-* set x2 = 6
991 ila 6
992 lls 3
993 sta 0,3,b.0 store character
994 iacx3 0,b.1 bump character pointer
995 iacx2 -1 ? finished ?
996 tnz -5 no
997 ldx2 octsv-* restore x2
998 tra octasc-*,* return
999 rem
1000 rem
1001 octsv bss 1
1002 dec 6
1003 ttls get tib address routine
1004 ************************************************************************
1005 *
1006 * gettib
1007 *
1008 * enter a - multics line number
1009 *
1010 * this routine will take a multics line number and
1011 * convert it to the associated real tib address which will
1012 * be returned in the a. if no tib exists, the
1013 * a will contain 0. In either case, the address of the
1014 * lsla or hsla table entry for the line will be returned
1015 * in the q
1016 *
1017 * a multics line number is a 10 bit value which is right
1018 * justified in the a. the rightmost 6 bits contain the
1019 * slot number/line number starting with 0, the next 3 bits
1020 * hold the lsla or hsla number starting with 0 and the
1021 * next bit is 1 if hsla or 0 if lsla
1022 *
1023 * line 1777 is a pseudo-channel used fro communication with
1024 * the colts executive; its tib address is held in .crtdt,
1025 * and it does not have the other associated data bases
1026 *
1027 ************************************************************************
1028 rem
1029 gettib subr gtb,inhx1
1030 cmpa l.h001-* =o1777 is this colts channel?
1031 tze gtb020-* yes, special case
1032 lrl 6 put line number in q
1033 iera 8 flip hsla/lsla flag 1 = lsla now
1034 icana 8 test for hsla or lsla
1035 tnz 2 it is an lsla
1036 iaa 5 hsla, add to hsla number
1037 iaa 1 add 1 to lsla or hsla no.
1038 als 1 multiply hsla/lsla number by 2 iom table entry s
1039 ada a.h001-** add iom table base
1040 cax1 and put in x1
1041 ila 0 clear a
1042 lls 6 refetch line number
1043 als 1 times 2
1044 ada 11 add table base address from iom table entry
1045 cax1 put addr of word 0 of table entry in x1
1046 ldq 11 get tib address from table
1047 llr 18 put tib addr in a slot addr in q
1048 gtb010 return gettib return to caller
1049 rem
1050 gtb020 lda a.h002-** .crtdt
1051 ilq 0 no table entry for colts channel
1052 tra gtb010-* return
1053 rem
1054 a.h001 ind .criom
1055 a.h002 ind .crtdt
1056 rem
1057 l.h001 oct 1777
1058 ttls chkiv -- procedure to check the interrupt vectors
1059 rem
1060 ************************************************************************
1061 *
1062 * "chkiv" -- procedure to check that the Interrupt Vectors
1063 * are not destroyed. This procedure does not verify that all IV's are
1064 * correct; it only checks the "reasonableness" of them.
1065 *
1066 *
1067 ************************************************************************
1068 rem
1069 rem
1070 rem
1071 chkiv subr chkinhaqx1
1072 rem
1073 ldaq chkcnt-* * let us add one to the call counter
1074 adaq chkone-* * add one ..
1075 staq chkcnt-* * and put back
1076 rem
1077 ila 0
1078 cax1
1079 rem
1080 chklp lda 01
1081 cmpa chkhgh-*
1082 tmi chkstp-*
1083 iacx1 1
1084 cmpx1 chkmax-*
1085 tnz chklp-*
1086 rem
1087 return chkiv
1088 rem
1089 chkstp die 6
1090 rem
1091 rem
1092 chkmax oct 40 * number of locations to check
1093 chkhgh oct 1000 * highest number which is not ok
1094 rem
1095 even
1096 chkone dec 01 * double precision one
1097 chkcnt dec 00
1098 rem
1099 ttls inproc subroutine -- copy chars into input buffers
1100 rem
1101 rem called by hsla_man and lsla_man as input characters
1102 rem arrive in order to put them in input buffers in t.icp
1103 rem chain; updates t.pos and puts characters in echo buffer
1104 rem if appropriate and may present status to the control tables.
1105 rem implements echoplex tabecho echo negotiation etc.
1106 rem
1107 rem at entry:
1108 rem a contains 0 for 7-bit nonzero for 6-bit chars
1109 rem q contains number of characters
1110 rem x3 points to first character
1111 rem
1112 rem returns in a:
1113 rem bit 17 on if anything put in echo buffer
1114 rem bit 16 on if output-suspend char received
1115 rem bit 15 on if output-resume char received
1116 rem
1117 inproc subr inpx1x2x3
1118 rem
1119 iaa 0 6- or 7-bit characters?
1120 tze inp005-* 7
1121 ila mask6 6
1122 tra 2
1123 inp005 ila mask7
1124 sta pmask-* hang on to parity mask
1125 rem
1126 cqa get character count
1127 tze a.b016-** inpbak none nothing to do
1128 iera -1 negate it
1129 iaa 1
1130 sta inrem-* save negative version
1131 stz inecho-*
1132 stz insusp-*
1133 stz inres-*
1134 stz inq-*
1135 rem
1136 stz inpte-* initially
1137 cx3a find out if input pointer is in buffer window
1138 ana l.b025-* =o077777 get word part alone
1139 cmpa l.b030-* =window general addressing window
1140 tpl inp006-* it's there therefore not in buffer window
1141 cmpa l.b031-* =bwndow buffer window
1142 tmi inp006-* below it in regular low memory
1143 ldx2 a.b022-** .crbte
1144 lda 02 save contents of buffer pte
1145 sta inpte-*
1146 rem
1147 inp006 lda t.flg21 in iflow now?
1148 cana l.b022-* =tfifc
1149 tze inp010-*
1150 lda t.flg31 watching the time?
1151 cana l.b021-* =tfitim
1152 tze inp010-*
1153 cana l.b027-* =tfsked inptim already scheduled?
1154 tnz inp007-* yes don't do it again
1155 lda t.line1 we need absolute tib address
1156 tsy a.b019-** gettib
1157 cax1 into x1 for dspqur
1158 ldaq a.b010-* time priority address for inptim
1159 tsy a.b011-** dspqur make sure it runs
1160 ldx1 inpsx1-* get x1 back
1161 lda l.b027-* =tfsked
1162 orsa t.flg31 it's scheduled now
1163 rem
1164 inp007 stz intime-* initialize for recording current time
1165 lda a.b012-** itmb get interval timer
1166 sta intime+1-*
1167 ldaq a.b013-** simclk and time it's due to go off
1168 sbaq intime-* now we have current time
1169 staq t.itim1 hang on to it
1170 rem
1171 inp010 stx3 inchrp-* save char pointer
1172 ldq 03b.0 get next char
1173 stq inchar-*
1174 lda t.flg31 if we're supposed to
1175 cana l.b028-* tf8in
1176 tnz inp012-*
1177 lda pmask-* fix parity on it
1178 ansa inchar-*
1179 inp012 ldq inchar-* save as original value
1180 stq inorig-* in case lfecho changes it
1181 lda t.flg21
1182 cana l.b012-* =tffrmi in frame mode?
1183 tze inp015-* no don't bother checking
1184 lda t.frmc1
1185 arl 9 get frame-begin char alone
1186 tze 3 zero null means any
1187 cmpa inchar-* is this it?
1188 tnz inp015-* no check for break
1189 lda l.b010-* =tffip
1190 orsa t.flg21 frame in progress now
1191 rem
1192 inp015 null
1193 tsy a.b015-** chkofc see if it's output flow control char
1194 tra a.b017-** inp300 chkofc fully processed the character
1195 ldq inchar-* get character back without parity
1196 rem now check carriage movement table
1197 lda t.pos1 save old column indicator
1198 sta oldpos-*
1199 tsy a.b004-** =addrmove
1200 tra inp020-* for line feed
1201 tra inp030-* for carriage return
1202 tra inp050-* for tab
1203 tra inp060-* for backspace do nothing
1204 tra inp070-* no hit
1205 rem
1206 rem
1207 inp020 null line feed
1208 lda l.b002-* =tfcrec
1209 cana t.flg1 crecho mode?
1210 tze inp100-*
1211 szn oldpos-* were we already in column 0?
1212 tze inp100-* if so don't echo carriage return
1213 ilq cr put carriage return in echo buffer
1214 tsy a.b003-** =addrputeco
1215 tra inp100-*
1216 rem
1217 inp030 null carriage return
1218 lda l.b003-* =tflfec
1219 cana t.flg1 lfecho mode?
1220 tze inp100-*
1221 lda l.b004-* =tfecpx
1222 cana t.flg1 echoplex mode?
1223 tze inp040-* no go ahead
1224 ilq cr else have to echo cr explicitly
1225 tsy a.b003-** puteco
1226 inp040 null
1227 ilq lf put line feed in echo buffer
1228 rem and input buffer
1229 stq inchar-*
1230 tsy a.b003-** =addrputeco
1231 tra inp110-*
1232 rem
1233 inp050 null tab
1234 cax2 save space count
1235 lda l.b005-* =tftbec
1236 cana t.flg1 tbecho mode?
1237 tze inp100-*
1238 tsy a.b003-** puteco
1239 tra inp110-* don't echoplex it also
1240 rem
1241 inp060 null
1242 tra inp100-*
1243 rem
1244 inp070 null
1245 lda a.b006-** mshift set by move subroutine
1246 tze inp090-* not a case shift character
1247 icmpa 1 yes is it up-shift?
1248 tnz inp080-* no
1249 lda l.b006-* =tfupsf
1250 orsa t.flg21 yes turn flag on
1251 tra inp100-*
1252 inp080 null down-shift
1253 lda l.b007-* =^tfupsf
1254 ansa t.flg21 turn flag off
1255 tra inp100-*
1256 rem
1257 inp090 null
1258 lda l.b006-* =tfupsf
1259 cana t.flg21 are we in uppercase?
1260 tze inp100-*
1261 ila 64 yes mark character
1262 orsa inchar-*
1263 rem
1264 inp100 null
1265 ldq inchar-*
1266 lda l.b004-* =tfecpx
1267 cana t.flg1 echoplex?
1268 tze inp110-*
1269 rem yes put char in echo buffer
1270 tsy a.b003-** =addrputeco
1271 tra inp110-* branch around literals & storage
1272 eject
1273 pmask bss 1 parity mask
1274 inchrp bss 1 pointer to current character
1275 inrem bss 1 number of characters remaining negative
1276 inecho bss 1 nonzero if something put in echo buffer
1277 insusp bss 1 nonzero if output_suspend char received
1278 inres bss 1 nonzero if output_resume char received
1279 inchar bss 1 copy of current character
1280 inorig bss 1 original contents of inchar
1281 oldpos bss 1 original value of t.pos
1282 inenef bss 1 echo negotiation flag
1283 inpte bss 1 buffer pte when we started
1284 inpvir bss 1 temporary storage for virtual address
1285 inq bss 1 nonzero => can append to queued input chain
1286 even
1287 intime bss 2 current time
1288 rem
1289 rem
1290 a.b001 ind istat
1291 a.b002 ind getubf
1292 a.b003 ind puteco
1293 a.b004 ind move
1294 a.b005 ind fulbuf
1295 a.b006 ind mshift
1296 a.b007 ind hcheck
1297 a.b008 ind echngo
1298 a.b009 ind ecgifl
1299 even
1300 a.b010 vfd 12/16/itprty 1 second and priority of inptim
1301 ind inptim
1302 a.b011 ind dspqur
1303 a.b012 ind itmb interval timer mailbox
1304 a.b013 ind simclk simulated clock value
1305 a.b014 ind itest
1306 a.b015 ind chkofc
1307 a.b016 ind inpbak
1308 a.b017 ind inp300
1309 *a.b018 unused
1310 a.b019 ind gettib
1311 a.b020 ind .crnbf
1312 a.b021 ind setbpt
1313 a.b022 ind .crbpe
1314 a.b023 ind eforce
1315 rem
1316 rem
1317 l.b001 zero 0b.0
1318 l.b002 vfd 18/tfcrec
1319 l.b003 vfd 18/tflfec
1320 l.b004 vfd 18/tfecpx
1321 l.b005 vfd 18/tftbec
1322 l.b006 vfd 18/tfupsf
1323 l.b007 vfd o18//tfupsf
1324 l.b008 vfd 18/s.exh
1325 l.b009 vfd 18/s.prex
1326 l.b010 vfd 18/tffip
1327 l.b011 oct 000777
1328 l.b012 vfd 18/tffrmi
1329 l.b013 vfd 18/bffbrk
1330 l.b014 vfd 18/s.brch
1331 l.b015 vfd 18/tfbral
1332 l.b016 vfd 18/tfsftr
1333 l.b017 vfd o18//tfwrit
1334 l.b018 vfd 18/hslafl
1335 l.b019 vfd 18/buftmk
1336 l.b020 oct 024000 "inhibit overflow" & "inhibit interrupts"
1337 l.b021 vfd 18/tfitim
1338 l.b022 vfd 18/tfifc
1339 *l.b023 unused
1340 *l.b024 unused
1341 l.b025 oct 077777
1342 l.b026 vfd 18/tfisus
1343 l.b027 vfd 18/tfsked
1344 l.b028 vfd 18/tf8in
1345 l.b029 dec 1 for adding to meters
1346 l.b030 vfd 18/window
1347 l.b031 vfd 18/bwndow
1348 l.b032 vfd 18/tfinq
1349 eject
1350 inp110 null
1351 stz inenef-* zero echnego did echo flag.
1352 szn t.scll1 are we echo-negotiating?
1353 tze inp114-*
1354 lda inchar-* hand the character to echngo
1355 tsy a.b008-** echngo echo negotiably
1356 sta inenef-* remember whether he actually echoed.
1357 inp114 null
1358 szn t.icp1 are we already building an input chain?
1359 tnz inp119-* yes
1360 rem otherwise we might just want to add to t.dcp
1361 szn inq-* have we done so once already?
1362 tnz inp116-* yes some of these tests are unnecessary
1363 lda t.flg31 in breakall mode?
1364 cana l.b015-* tfbral
1365 tze inp120-* no never mind
1366 cana l.b032-* tfinq is it safe to append?
1367 tze inp120-* no don't try
1368 inp116 lda t.dlst1 get last buffer of queued input
1369 tze inp120-* surprise there isn't one
1370 tsy a.b021-** setbpt get its virtual address
1371 cax3 find out if it's full
1372 tsy a.b005-** fulbuf
1373 tra inp120-* it is. oh well we tried
1374 aos inq-* remember that that's where the character goes
1375 tra inp200-* and skip all the buffer manipulation stuff
1376 rem
1377 inp119 null old chain
1378 lda t.ilst1 find out if last buffer is full
1379 tsy a.b021-** setbpt convert address to virtual
1380 cax3
1381 tsy a.b005-** fulbuf
1382 tra 2 it is
1383 tra inp190-* it isn't branch around buffer allocation code
1384 rem
1385 inp120 null check for exhaust condition
1386 stz inq-* can't add to dia chain now
1387 lda t.icpl1 how many buffers have we got so far?
1388 ada t.dcpl1
1389 icmpa bufmax too many?
1390 tmi inp125-* no
1391 lda t.stat1 yes send exhaust status
1392 iana s.dss common bits only
1393 ora l.b008-* =s.exh
1394 tsy a.b001-** =addristat
1395 tra inp140-*
1396 rem
1397 inp125 lda t.flg21 see if we should request input suspension
1398 cana l.b022-* =tfifc
1399 tze inp130-* mode isn't on certainly not
1400 lda t.icpl1 chain long enough?
1401 icmpa bufmax/2
1402 tpl inp128-* yes
1403 als 2 multiply by 4
1404 cmpa a.b020-** .crnbf more than 1/4 of remaining space?
1405 tmi inp130-* no skip it
1406 inp128 ldq t.ifch1 yes get input flow control chars
1407 qrl 9 get suspend char alone
1408 tsy a.b023-** eforce into echo buffer
1409 rem
1410 inp130 lda t.icpl1 have we got enough to send no matter what?
1411 icmpa bufpre
1412 tmi inp140-* no
1413 lda t.stat1 yes signal pre-exhaust status
1414 iana s.dss common bits only
1415 ora l.b009-* s.prex
1416 tsy a.b001-** =istat
1417 rem
1418 inp140 null
1419 rem
1420 rem get a fresh buffer
1421 ilq bufsiz
1422 tsy a.b002-** =addrgetubf
1423 tra inp150-* error cannot get buffer
1424 aos t.icpl1 increment buffer count
1425 caq hold on to address
1426 tra inp160-* continue
1427 rem
1428 rem send exhaust status forget input char
1429 inp150 cmeter mincsm.inafl.b029-*
1430 rem
1431 lda t.stat1 get tib status bits
1432 iana s.tib common bits only
1433 ora l.b008-* =s.exh
1434 tsy a.b001-** =addristat
1435 tra inp300-* go to next slot
1436 rem
1437 inp160 szn t.icp1 new chain or old?
1438 tze inp170-* new
1439 rem old chain new buffer on
1440 lda t.ilst1
1441 tsy a.b021-** setbpt
1442 cax2
1443 stq bf.nxt2
1444 tra inp180-*
1445 rem
1446 inp170 null
1447 stq t.icp1 new buffer is input chain head
1448 rem
1449 inp180 null
1450 rem set new last buffer pointer
1451 stq t.ilst1
1452 cqa get virtual address
1453 tsy a.b021-** setbpt
1454 cax3 also save it for later
1455 iaa bf.dta to set new character pointer
1456 ora l.b001-* 0b.0
1457 sta t.icch1
1458 rem
1459 inp190 null
1460 stx3 inpvir-* hang on to virtual buffer address
1461 ldx3 t.icch1
1462 lda inchar-* now put data character in input buffer
1463 sta 03b.0
1464 rem now increment tally
1465 ldx3 inpvir-*
1466 ila 1 add one to tally in last buffer
1467 asa bf.tly3
1468 rem increment char pointer
1469 ldx3 t.icch1 increment character pointer
1470 iacx3 0b.1
1471 stx3 t.icch1
1472 rem
1473 lda t.flg21 check for shifter
1474 cana l.b016-* =tsfstr
1475 tze inp200-* not an ibm type
1476 ila 63 yes it is mask off possible shift
1477 ansa inchar-* when testing for break
1478 inp200 null
1479 lda t.flg21 see if we're in a frame
1480 cana l.b010-* =tffip
1481 tze inp210-* nope
1482 lda t.frmc1 yes get framing chars
1483 ana l.b011-* =o000777 mask down to frame-end only
1484 cmpa inorig-* is this it?
1485 tze inp250-* yes break
1486 tra inp300-* no don't break
1487 rem
1488 inp210 null
1489 lda t.flg21 check for input_suspend char
1490 cana l.b022-* =tfifc if appropriate
1491 tze inp220-* it isn't
1492 lda t.ifch1 get input flow control chars
1493 lrl 9 suspend in a low resume in q high
1494 cmpa inorig-* received suspend char?
1495 tnz inp220-* no
1496 lda t.icpl1 yes should we resume right away?
1497 icmpa bufmax/2
1498 tmi inp215-* yes chain is short enough
1499 lda l.b026-* =tfisus
1500 orsa t.flg1 else set suspended flag in tib
1501 tra inp220-*
1502 inp215 qrl 9 get resume char in q low
1503 tsy a.b023-** eforce
1504 rem
1505 inp220 lda t.flg31 get flags
1506 cana l.b015-* =tfbral
1507 tnz inp250-* in breakall mode break on everything
1508 rem
1509 rem break list pointed to by t.brkp has maximum of
1510 rem 8 characters of which first is
1511 rem either a special code or a count.
1512 lda t.brkp1 get pointer to beginning of break list
1513 ora l.b001-* 0b.0
1514 cax3
1515 rem
1516 lda 03b.0 get first char of break list
1517 tze inp300-* no break list no break char.
1518 als 9 extend high-order bit of char
1519 ars 9 for immediate compare
1520 rem
1521 icmpa brkall break on every character?
1522 tze inp250-* yes that includes this one
1523 rem
1524 icmpa brkctl break on all control chars?
1525 tnz inp230-*
1526 lda inchar-* yes find out if this is one
1527 icmpa blank
1528 tmi inp250-* it is break
1529 tra inp300-* else don't
1530 rem
1531 inp230 null first char is count of list
1532 caq get it in q
1533 rem
1534 inp240 null check for match
1535 iacx3 0b.1 bump to next char in break list
1536 lda 03b.0 pick it up
1537 cmpa inchar-*
1538 tze inp250-* this one break now
1539 rem get next char in break list
1540 iaq -1 if there are any more
1541 tze inp300-*
1542 tra inp240-*
1543 rem
1544 rem
1545 inp250 null we have a break char send appropriate
1546 rem status to interpreter
1547 lda l.b010-* =tffip frame in progress
1548 iera -1 always turned off by break
1549 ansa t.flg21
1550 rem
1551 lda t.line1 hsla line?
1552 cana l.b018-* =hslafl
1553 tze inp260-* no skip this
1554 ldx2 t.sfcm1 else have to update input pointer
1555 ldx3 inchrp-* address of char just processed
1556 iacx3 0b.1 point to next char
1557 stx3 sf.nic2 update pointer in sfcm
1558 szn inecho-* have we put anything in echo buffer?
1559 tze inp260-* no proceed
1560 stz inecho-* yes reset flag
1561 tsy a.b007-** hcheck and tell hsla_man now
1562 rem
1563 inp260 null
1564 lda t.flg31 check for breakall super-optimization
1565 cana l.b015-* =tfbral
1566 tze inp265-* nope
1567 szn inenef-* did FNP echnego this char?
1568 tze 3 no proceed
1569 szn t.scll1 is there room for more echnego?
1570 tnz inp298-* great don't ship: turn on tfwrit
1571 rem if there's input on the t.dcp chain that can
1572 rem be safely appended to as determined above
1573 rem simply put the current character into it; it
1574 rem will be included in an already queued
1575 rem accept_input
1576 rem
1577 szn inq-* is there input queued?
1578 tze inp261-* no never mind
1579 lda t.dlst1 get the last buffer in the queued input
1580 tsy a.b021-** setbpt get virtual address
1581 sta inpvir-* save it
1582 cax3
1583 lda bf.tly3 get the current tally
1584 ana l.b019-* buftmk
1585 lrl 1 get number of words saving possible odd char
1586 aos bf.tly3 increment buffer tally
1587 iaa bf.dta account for buffer header
1588 ada inpvir-* add address of origin we now have word address
1589 ora l.b001-* 0b.0
1590 cax3 x3 now points to correct word
1591 iaq 0 was there an odd number of characters?
1592 tpl 2 no
1593 iacx3 0b.1 yes advance character pointer
1594 lda a.g008-** inorig get the current character
1595 sta 03b.0 store it in buffer
1596 tra inp300-* done
1597 inp261 null if that didn't work at least we can
1598 rem try to avoid running the control tables
1599 rem
1600 rem breakable chars come one at a time
1601 rem or the very last in an echoed chain.
1602 rem at any rate we are gonna ship.
1603 rem
1604 lda t.ilst1 first char in some buffer not echoed?
1605 cmpa t.icp1 only buffer in chain?
1606 tnz inp262-* no leave break bit on or off as was set before.
1607 tsy a.b021-** setbpt get virtual address
1608 cax3
1609 lda bf.tly3 check out the tally
1610 ana l.b019-*
1611 icmpa 1 1st char?
1612 tnz inp262-* no dont mark as break chars
1613 lda l.b013-* otherwise turn on break flag
1614 orsa bf.flg3
1615 inp262 null
1616 tsy a.b009-** ecgifl echnego iflush
1617 tra inp300-*
1618 inp265 null
1619 lda t.ilst1 get buffer pointer
1620 tsy a.b021-** make it virtual
1621 cax3 so as to set
1622 lda l.b013-* =bffbrk break flag
1623 orsa bf.flg3
1624 lda t.stat1 get tib status
1625 iana s.dss mask down to common bits
1626 ora l.b014-* =s.brch set break char received
1627 tsy a.g009-** =addristat
1628 lda t.flg1 check for echoplex
1629 cana l.b004-* =tfecpx
1630 tze inp300-* no we're done
1631 inp298 null here for thoughts that want chance to echo
1632 lda l.b017-* =^tfwrit
1633 ansa t.flg1 turn it off to make sure we get a chance to echo
1634 rem
1635 inp300 null through with that character
1636 szn t.entp1 is there a echnego table?
1637 tze inp310-* no
1638 szn a.g010-** inenef did echngo echo this char?
1639 tnz inp310-* yes it was echoed. echngo zeroed sncc
1640 sti inpind-* save indicators - it was not echoed
1641 ldi l.b020-* inhibit overflow- so count against sync ctr
1642 aos t.sncc1 aos the sync ctr
1643 ldi inpind-*
1644 inp310 null
1645 lda a.g011-** inpte pte to restore?
1646 tze inp320-* no
1647 ldx2 a.g012-** .crbpe yes
1648 sta 02 do it
1649 inp320 null
1650 ldx3 a.g005-** inchrp recover char pointer
1651 iacx3 0b.1 go to next
1652 aos a.g006-** inrem are there any more?
1653 tmi a.g013-** inp010 yes go do next one
1654 rem done set return flags
1655 ila 0
1656 szn a.g007-** inecho did we put anything in echo buffer?
1657 tze 2 no
1658 iora reteco
1659 szn a.g001-** insusp found an output_suspend char?
1660 tze 2 no
1661 iora retsus
1662 szn a.g002-** inres how about output_resume?
1663 tze 2 no
1664 iora retres
1665 rem
1666 inpbak return inproc
1667 ttls chkofc -- looks for output flow control chars
1668 rem this subroutine looks for output flow control characters
1669 rem and sets appropriate flags. If it completely processes
1670 rem the character i.e. it is not to be echoed or stored
1671 rem it returns to the next location; otherwise it returns
1672 rem one location further on
1673 rem
1674 rem
1675 chkofc subr
1676 lda t.flg21 oflow mode?
1677 cana l.g001-* =tfofc
1678 tze chk030-* no forget it
1679 lda t.ofch1 we'll check for output flow control char
1680 lrl 9 get suspend char. first
1681 cmpa a.g003-** inchar is it?
1682 tnz chk010-* no check for resume
1683 lda t.flg21 yes see if it's block acknowledgement
1684 cana l.g002-* =tfblak
1685 tnz chk010-* yes so suspend char isn't interesting
1686 aos a.g001-** insusp indicate receipt of suspend character
1687 stz a.g002-** inres overrides any preceding resume char
1688 tra chkret-* don't echo or store char
1689 chk010 qrl 9 get resume char
1690 cmpq a.g003-** inchar is our current char one?
1691 tnz chk030-*
1692 lda t.flg21 yes block acknowledgement?
1693 cana l.g002-* =tfblak
1694 tnz chk020-* yes we'll have to adjust message count
1695 stz a.g001-** insusp overrides any previous suspend character
1696 aos a.g002-** inres yes mark that it's to be resumed
1697 tra chkret-* done with char don't echo or store
1698 rem
1699 chk020 null ack
1700 lda t.omct1 get outstanding message count
1701 tze chkret-* don't let it go negative
1702 iaa -1 else decrement it
1703 sta t.omct1
1704 icmpa 2 can we resume now?
1705 tpl chkret-* no
1706 tsy a.g004-** itest yes tell interpreter
1707 tra chkret-* done with char don't store or echo
1708 rem
1709 chk030 aos chkofc-* to return + 1
1710 chkret return chkofc
1711 rem
1712 rem
1713 inpind bss 1 save indicator reg
1714 rem
1715 a.g001 ind insusp
1716 a.g002 ind inres
1717 a.g003 ind inchar
1718 a.g004 ind itest
1719 a.g005 ind inchrp
1720 a.g006 ind inrem
1721 a.g007 ind inecho
1722 a.g008 ind inorig
1723 a.g009 ind istat
1724 a.g010 ind inenef
1725 a.g011 ind inpte
1726 a.g012 ind .crbpe
1727 a.g013 ind inp010
1728 rem
1729 l.g001 vfd 18/tfofc
1730 l.g002 vfd 18/tfblak
1731 ttls inptim -- subroutine to run 1 second after inproc
1732 rem
1733 rem this subroutine is scheduled by inproc to run one second
1734 rem later if a channel is in input flow control/timeout
1735 rem mode. Its function is to see if more than half a second
1736 rem has elapsed since the last time inproc was called on behalf
1737 rem of the channel and if so to send an input_resume
1738 rem character to it on the assumption that it decided to
1739 rem suspend input.
1740 rem
1741 rem x1 contains absolute tib address at entry
1742 rem
1743 rem
1744 inptim null transferred to by secondary dispatcher
1745 cx1a copy absolute tib address into a
1746 sta ipabs-* save it for possible later call to dspqur
1747 tsy a.e006-** setptw virtualize it
1748 cax1 and back into x1
1749 ldaq t.itim1 get the time inproc last ran
1750 tze a.e001-** secdsp never forget it
1751 lda a.e002-** itmb see how much later it is now
1752 sta iptemp+1-*
1753 stz iptemp-*
1754 ldaq a.e003-** simclk next timer runout time
1755 sbaq iptemp-* result is current time
1756 sbaq t.itim1 how long has it been?
1757 tmi a.e001-** hasn't happened yet unlikely
1758 iaa 0 more than 2**18 msec??
1759 tnz itm010-* well that's sure more than half a second
1760 cmpq l.e001-* 50110 -- else was it in fact?
1761 tpl itm010-* yes
1762 rem else we should check again in a second
1763 ldaq a.e007-** time priority address of this routine
1764 ldx1 ipabs-* recover absolute tib address
1765 tsy a.e008-** dspqur make sure we get called again
1766 tra a.e001-** secdsp done
1767 rem
1768 itm010 ldq t.ifch1 it has been so send resume char
1769 qls 9 get rid of suspend char
1770 qrl 9
1771 tsy a.e004-** eforce
1772 lda l.e003-* =^tfsked
1773 ansa t.flg31 turn off scheduled flag
1774 lda t.line1 hsla line?
1775 cana l.e002-* =hslafl
1776 tze a.e001-** secdsp no done
1777 tsy a.e005-** hcheck yes make sure echoing happens
1778 tra a.e001-** secdsp finished now
1779 rem
1780 rem
1781 a.e001 ind secdsp
1782 a.e002 ind itmb
1783 a.e003 ind simclk
1784 a.e004 ind eforce
1785 a.e005 ind hcheck
1786 a.e006 ind setptw
1787 a.e007 ind a.b010 contains word pair for dspqur
1788 a.e008 ind dspqur
1789 rem
1790 rem
1791 l.e001 dec 501
1792 l.e002 vfd 18/hslafl
1793 l.e003 vfd o18//tfsked
1794 rem
1795 ipabs bss 1 absolute tib address temp stored here
1796 even
1797 iptemp bss 2
1798 ttls move subroutine does carriage movement
1799 rem
1800 rem this subroutine looks in carriage movement
1801 rem table supplied in device table for character
1802 rem supplied in q reg.
1803 rem
1804 rem returns: 0 -- linefeed char
1805 rem 1 -- carriage return
1806 rem 2 -- tab a contains no. of blanks
1807 rem 3 -- backspace
1808 rem 4 -- no match
1809 rem
1810 rem tib address assumed in x1 as always
1811 rem
1812 move subr movqx3
1813 rem
1814 rem first find out if we should bother
1815 stz mshift-* initially not a shift char
1816 ldx3 a.m001-* base of control tables
1817 ldx3 ct.dev3 array of device table ptrs
1818 adcx3 t.type1 indexed by terminal type
1819 lda -13 -1 to convert index to offset
1820 ora l.m001-* 0 b.0 convert to char. addressing
1821 cax3 x3 now points to device table entry
1822 rem we want to check against carriage mvmt
1823 rem characters in device table entry
1824 rem
1825 lda l.m004-* =tfsftr
1826 cana t.flg21
1827 tze mov005-* not a shifter only look for carriage movement
1828 ila 6 else we have to look for shifts too
1829 tra mov010-*
1830 mov005 null
1831 ila 4 limit
1832 mov010 sta mlimit-*
1833 ila 0
1834 mov012 cmpq dt.cmt3b.0
1835 tze mov030-* hit
1836 iaa 1 and increment counter
1837 cmpa mlimit-* end of table?
1838 tze mov020-* no hits
1839 iacx3 0b.1 not last bump pointer
1840 tra mov012-* check next char. in table
1841 *
1842 mov020 null not a special carriage mvmt. char.
1843 lda l.m004-* =tfsftr
1844 cana t.flg21
1845 tnz mov025-* if we don't have an ibm terminal
1846 cqa find out if it's a control char.
1847 icmpa rubout
1848 tze mov027-* if so don't bump column pointer
1849 icmpa space
1850 tmi mov027-*
1851 mov025 lda t.pos1 make sure we're not over limit
1852 icmpa 255
1853 tpl 2 we are don't increment
1854 aos t.pos1 else push to next column
1855 mov027 ila 4 indicate no hit return
1856 tra movbak-*
1857 *
1858 mov030 null
1859 rem hit on carriage movement table
1860 icmpa 4 was it a shift character?
1861 tmi mov035-* no check for something else
1862 iaa -3 yes reduce it to 1 or 2
1863 sta mshift-* save it for later
1864 ila 4 return as though no hit
1865 tra movbak-* all done carriage didn't move
1866 rem
1867 mov035 null
1868 icmpa 2 cr or lf?
1869 tpl mov040-*
1870 stz t.pos1 yes zero column indicator
1871 tra movbak-*
1872 mov040 null
1873 icmpa 3 backspace?
1874 tnz mov050-*
1875 szn t.pos1 don't decrement column indicator if
1876 tze movbak-* it's already zero
1877 ila -1
1878 asa t.pos1
1879 ila 3 bump return point for backspace
1880 tra movbak-*
1881 *
1882 mov050 null must be tab
1883 ila 0
1884 ldq t.pos1 get modt.pos 10
1885 cmpq l.m005-* =255 make sure we're not over limit
1886 tpl mov070-* we are don't increment t.pos
1887 cmpq l.m002-* =10
1888 tmi mov060-* if it's < 10 don't bother dividing
1889 dvd l.m002-* else divide by 10
1890 rem remainder is in q
1891 mov060 null
1892 stq mtemp-* save modt.pos10
1893 ila 10 t.pos<-t.pos+10-modt.pos10
1894 sba mtemp-*
1895 asa t.pos1
1896 mov070 aos move-* bump return pointer for tab return
1897 aos move-* by hand because have to keep space count in a
1898 tra 2
1899 rem
1900 movbak asa move-* bump return pointer appropriately
1901 return move
1902 rem
1903 rem
1904 l.m001 zero 0b.0
1905 l.m002 dec 10
1906 l.m003 vfd 18/tfcrec+tflfec+tftbec+tfecpx
1907 l.m004 vfd 18/tfsftr
1908 l.m005 dec 255
1909 a.m001 ind ctrl address of control tables
1910 mtemp bss 1 temp for saving modt.pos10
1911 mshift bss 1 char was case shift 1 for upper 2 for lower
1912 mlimit bss 1 number of chars to scan in cmt
1913 ttls echo buffer subroutines
1914 rem echo buffer format
1915 rem
1916 eb.inp equ 0 ptr to next place for input character
1917 eb.out equ 1 ptr to next output character
1918 eb.tly equ 2 current character count upper half
1919 eb.dta equ 2 first data char lower half
1920 eb.end equ bufsiz end of echo buffer
1921 ebsize equ bufsiz*2-5 maximum number of echo chars
1922 rem
1923 rem
1924 rem puteco subroutine puts input character in
1925 rem echo buffer. character is supplied in q
1926 rem tib address on x1 as usual
1927 rem if character is ht space count is in x2
1928 rem
1929 hecho null
1930 lecho null this is the external interface
1931 puteco subr putx2x3aq
1932 rem
1933 lda t.flg21 frame in progress?
1934 cana l.c006-* =tffip
1935 tnz putbak-* yes no echoing
1936 rem
1937 tsy putone-*
1938 tra putbak-* if no more room skip other stuff
1939 rem
1940 lda t.line1 hsla line?
1941 cana l.c008-* =hslafl
1942 tze put070-* no lsla_man will handle delays later
1943 ldx2 t.dtp1 yes put delays in echo buffer
1944 tze put039-* no delay table check tabecho
1945 lda putsq-* get echoed char
1946 icmpa lf linefeed?
1947 tnz put020-* no try something else
1948 lda dl.lf2 yes get linefeed delays
1949 tze putbak-* none skip it
1950 tra put030-* go do it
1951 rem
1952 put020 icmpa cr carriage return?
1953 tnz put040-* nope
1954 lda dl.cr2 get cr delay factor
1955 mpy a.c002-** oldpos original column position
1956 tze putbak-* no delays skip it
1957 qrs 9 divide by 512
1958 iaq 3 for good measure
1959 cqa result into a
1960 put030 ilq null delay char
1961 tra put050-* go put nulls in echo buffer
1962 rem
1963 put039 lda putsq-* get character into a again
1964 put040 icmpa tab not cr or lf is it tab?
1965 tnz putbak-* no done
1966 lda t.flg1 tab echo?
1967 cana l.c005-* =tftbec
1968 tze putbak-* no skip it
1969 lda putsx2-* get space count
1970 ilq blank get space char
1971 rem
1972 put050 null here to store blanks or nulls in buffer
1973 iera -1 negate count
1974 iaa 1
1975 sta puttmp-*
1976 put060 tsy putin-* put one in
1977 tra putbak-* buffer full no more
1978 aos puttmp-* count one
1979 tmi put060-* more go do them
1980 tra putbak-* no more finished
1981 rem
1982 put070 null lsla line may need to restore t.pos
1983 lda t.flg1 echoplex?
1984 cana l.c004-* =tfecpx
1985 tnz put080-* yes
1986 cana l.c005-* =tftbec no try tab echo
1987 tze putbak-* no done
1988 lda putsq-* get original char again
1989 icmpa ht is it a tab?
1990 tnz putbak-* no not interesting
1991 put080 lda a.c002-** oldpos
1992 sta t.pos1
1993 rem
1994 putbak return puteco
1995 rem
1996 rem
1997 eforce subr efoaqx3
1998 rem
1999 rem short version of puteco that puts the character
2000 rem in the echo buffer even if in a blk_xfer frame
2001 rem and doesn't bother about delays or tabs. called
2002 rem for such things as input suspend/resume characters.
2003 rem
2004 rem q contains character to be echoed.
2005 rem
2006 tsy putone-* this actually does all the work
2007 nop doesn't matter whether or not it succeeds
2008 return eforce
2009 ttls putin -- insert a char in the echo buffer
2010 putin subr pinaqx2
2011 rem
2012 rem this subroutine does the actual insertion in the
2013 rem echo buffer
2014 rem
2015 rem q contains character to insert
2016 rem x3 points to echo buffer
2017 rem returns to callpoint if echo buffer full
2018 rem to one loc. beyond otherwise
2019 rem
2020 lda eb.tly3 see if it's full
2021 arl 9
2022 icmpa ebsize check against maximum
2023 tmi pin010-*
2024 lda l.c003-* =tfbel echo buffer is full
2025 orsa t.flg1 set flag to send bell
2026 cmeter mincdm.ebofl.c011-* meter this
2027 tra pinbak-* and return
2028 pin010 null
2029 aos putin-* bump return pointer
2030 lda t.line1 if hsla line in tabecho don't store tab
2031 cana l.c008-* =hslafl
2032 tze pin015-* not hsla as you were
2033 cqa get character
2034 icmpa tab
2035 tnz pin015-* not tab go ahead
2036 lda t.flg1 check for tabecho
2037 cana l.c005-* tftbec
2038 tnz pinbak-* don't store it we'll put in spaces later
2039 pin015 null
2040 ldx2 eb.inp3 get input pointer
2041 rem we're ready to store char
2042 stq 02b.0 do it
2043 iacx2 0b.1 increment input pointer
2044 cx2a find out if we went off end
2045 cana l.c007-* =o077777
2046 tze pin020-* we went off end of memory in fact
2047 cana l.c002-* =o000037
2048 tnz pin030-*
2049 pin020 cx3a 0 mod 32 wraparound
2050 ada l.c001-* so point to beginning again
2051 *
2052 pin030 null
2053 sta eb.inp3
2054 lda l.c010-* =o1000
2055 asa eb.tly3 increment tally
2056 pinbak return putin
2057 ttls putone -- set up echo buffer
2058 putone subr puoq
2059 rem
2060 rem this subroutine allocates an echo buffer if
2061 rem necessary and puts a character in it updating
2062 rem the "inecho" flag. It is called by puteco and eforce.
2063 rem
2064 rem q contains character to echo
2065 rem on exit x3 points to the echo buffer if any
2066 rem returns to callpoint if echo buffer full or no
2067 rem buffer could be allocated otherwise to one location
2068 rem further on
2069 rem
2070 lda t.echo1 is there an echo buffer?
2071 tze puo005-* no we'll have to get one
2072 tsy a.c004-** setbpt yes get virtual address
2073 cax3
2074 tra puo010-* proceed
2075 rem set up echo buffer
2076 puo005 ilq bufsiz
2077 tsy a.c001-** getubf get a buffer
2078 tra puo020-* couldn't get one never mind
2079 *
2080 sta t.echo1 now we have it save absolute address
2081 ldq putsq-* copy char back to q
2082 cx3a get virtual pointer to
2083 ada l.c001-* first data char. save it in
2084 sta eb.inp3 input and
2085 sta eb.out3 output pointers
2086 stz eb.tly3 initialize tally
2087 puo010 tsy putin-* put the character in
2088 tra puobak-* if no more room skip other stuff
2089 rem
2090 aos putone-*
2091 ila 1 mark the echoed flag
2092 orsa a.c003-** inecho
2093 puobak return putone
2094 rem
2095 puo020 null allocation failure meter it
2096 cmeter mincsm.inafl.c011-*
2097 tra puobak-*
2098 rem
2099 rem
2100 a.c001 ind getubf subr to get an unreserved buffer
2101 a.c002 ind oldpos
2102 a.c003 ind inecho
2103 a.c004 ind setbpt
2104 rem
2105 l.c001 zero eb.dtab.1 offset of first char. position
2106 l.c002 oct 37 mask for mod 32
2107 l.c003 vfd 18/tfbel
2108 l.c004 vfd 18/tfecpx
2109 l.c005 vfd 18/tftbec
2110 l.c006 vfd 18/tffip
2111 l.c007 oct 077777
2112 l.c008 vfd 18/hslafl
2113 l.c009 vfd 18/tflfec
2114 l.c010 oct 1000
2115 l.c011 dec 1
2116 rem
2117 rem
2118 puttmp bss 1
2119 ttls negotiated echo handler
2120 rem
2121 rem called by inproc when would normally
2122 rem do echoplex echoing
2123 rem x1 is tib return a nonzero if echoed 0 if did not.
2124 rem inchar in a
2125 rem
2126 echngo subr eng
2127 rem
2128 sta engich-*
2129 lda t.flg31 breakall?
2130 cana l.s002-* =tfbral no echo if not
2131 tze eng180-*
2132 szn t.scll1 is there room left to echo?
2133 tze eng180-* no dont attempt to echo.
2134 lda engich-* Take a look at char
2135 rem
2136 rem check char's bit in table.
2137 rem
2138 iana 15 get low bits
2139 ada l.s001-* build instruction
2140 sta eng020-*
2141 lda engich-* get char
2142 arl 4 get high bits
2143 sta engtmp-*
2144 ldx2 t.entp1 damn well better be table
2145 tnz 2 or r0 screwed up
2146 die 99
2147 adcx2 engtmp-* build word address
2148 lda dl.hsz2 get table word
2149 eng020 bss 1 test high bit
2150 tmi eng180-* this is a true break no echo.
2151 rem
2152 rem now we have to echo this thing.
2153 rem
2154 ldq engich-*
2155 ila 0
2156 cax2
2157 tsy a.s002-** until we have something cleverer
2158 rem
2159 stz t.sncc1 we echoed this char so zero the
2160 rem protocol sync count of chars not
2161 rem echoed since echoed char.
2162 rem
2163 rem char has been echoed update line length left.
2164 ila -1
2165 asa t.scll1 decrement line space left
2166 rem and return nonzero a.
2167 tra engret-*
2168 rem
2169 eng180 stz t.scll1 turn off all further echnego
2170 ila 0 say that we did not echo
2171 rem inproc will aos t.sncc apropriately
2172 engret return echngo
2173 rem
2174 l.s001 als 0 instruction template
2175 l.s002 vfd 18/tfbral
2176 a.s001 ind ecgifl
2177 a.s002 ind puteco
2178 engich bss 1
2179 engtmp bss 1
2180 rem
2181 ttls outprc subroutine -- for output subop
2182 rem subroutine called by both lsla_man and hsla_man
2183 rem to process output subop of dcw list
2184 rem
2185 rem x1 - virtual tib address
2186 rem
2187 opend bool 77
2188 pradd equ 1
2189 kyadd equ 2
2190 outmsg equ 3
2191 repeat equ 4
2192 maxctl equ 4 maximum number of words in addressing string
2193 rem
2194 nbftmk bool /buftmk
2195 rem
2196 rem
2197 outprc subr outaqx2x3
2198 rem
2199 rem
2200 lda t.dcwa1
2201 ora l.o001-* 0b.0
2202 cax3 point to first character of "output"
2203 rem
2204 out010 null
2205 iacx3 0b.1 next char.
2206 lda 03b.0 pick it up
2207 cmpa l.o002-* =o000400
2208 tpl out020-* if less than 4008
2209 tsy a.o001-** literal char is to be inserted in buffer
2210 rem insert
2211 tra out010-* and get next
2212 rem
2213 out020 null
2214 iana 255 we know high-order bit is on so turn
2215 rem it off for easier comparison
2216 tze out090-* die if result is zero
2217 rem
2218 icmpa opend
2219 tze out200-* end of subop
2220 rem
2221 icmpa kyadd+1 printer or keyboard addressing?
2222 tpl out050-*
2223 rem yes get device table pointer
2224 rem but first check and make sure tfctrl is on
2225 caq
2226 lda l.o003-* =tfctrl
2227 cana t.flg1
2228 tze out010-* if it isn't skip this item
2229 rem
2230 ldx2 a.o002-* address of control tables
2231 ldx2 ct.dev2
2232 adcx2 t.type1
2233 ldx2 -12 now points to correct device tab entry
2234 cqa restore control char
2235 icmpa kyadd
2236 tze out030-*
2237 lda dt.prt2 get pointer to printer addr sequence
2238 szn t.ocur1 if there's already an output chain
2239 tze out028-*
2240 sta otemp-* put printer addr ahead of it
2241 ldq t.ocp1 which means putting it at head of pending output
2242 lda t.olst1 get end of t.ocur chain
2243 tsy a.o004-** setbpt virtualize it
2244 cax2
2245 stq bf.nxt2 hook t.ocp chain on at end
2246 lda t.ocur1 this becomes new t.ocp chain
2247 sta t.ocp1
2248 rem
2249 stz t.ocur1 clear current output chain
2250 stz t.olst1
2251 stz t.ocnt1
2252 rem
2253 lda otemp-* restore a register
2254 out028 null
2255 tra 2 skip over fetch of kybd string
2256 out030 null
2257 lda dt.key2 get keyboard addr sequence
2258 ora l.o001-* 0b.0
2259 cax2 point to beginning of string
2260 ldq 02b.0 get character count in q
2261 rem
2262 out040 null
2263 iacx2 0b.1 get next char.
2264 lda 02b.0
2265 tsy a.o001-** insert put it in output buffer
2266 iaq -1 more?
2267 tnz out040-* yes get next addressing char
2268 tra out010-* else get next output char
2269 rem
2270 out050 null
2271 icmpa outmsg thread output message into chain?
2272 tnz out080-*
2273 rem yes
2274 stz ohldot-* turn off local flag
2275 lda t.ocp1 get pointer to head of output chain
2276 tze out075-* if there isn't one nothing to do
2277 caq save absolute address in q
2278 tsy a.o004-** setbpt
2279 cax2 get virtual in x2
2280 lda bf.flg2 get buffer flags
2281 cana l.o010-* check hold output buffer flag
2282 tze out054-* not on - usual outmsg
2283 stz t.ocur1
2284 rem
2285 aos ohldot-* turn on local flag
2286 out052 stq t.olst1
2287 cana l.o011-* check last buffer in message flag
2288 tnz out054-* yes - end of partial chain
2289 lda bf.nxt2 advance to next buffer
2290 tze out054-* end of chain
2291 caq hang on to absolute address
2292 tsy a.o004-** setbpt virtualize address
2293 cax2
2294 lda bf.flg2 get buffer flags
2295 tra out052-* loop
2296 out054 ldq t.ocp1 get pointer to output chain
2297 szn t.ocur1 are we currently working on one?
2298 tnz out060-*
2299 stq t.ocur1 no make head of chain current buffer
2300 cqa
2301 tsy a.o004-** setbpt
2302 iaa bf.dta and point t.occh to first char slot
2303 ora l.o001-* =0b.0
2304 sta t.occh1
2305 lda t.ocur1
2306 szn ohldot-* check local flag
2307 tze out070-*
2308 tra out075-* skip all this other stuff
2309 rem
2310 out060 null there is a chain make sure
2311 lda t.olst1 t.olst really points to last buffer
2312 tsy a.o004-** setbpt get virtual address
2313 cax2
2314 szn bf.nxt2
2315 tze 2
2316 die 11
2317 rem
2318 stq bf.nxt2 now hook new chain to last buffer
2319 out070 null
2320 aos t.ocnt1 increment output buffer count
2321 cqa convert to virtual for local storage
2322 tsy a.o004-** setbpt
2323 cax2
2324 stx2 obufad-* save this address for later
2325 lda t.flg21 block-acknowledgement mode?
2326 ana l.o009-* =tfblak+tfofc
2327 cmpa l.o009-* see if they're both on
2328 tnz out071-* no proceed
2329 lda bf.tly2 yes we must check to see if buffer ends in etb
2330 ana l.o012-* buftmk
2331 iaa -1 back up one to get right word
2332 lrs 1 separate word and char parts of address
2333 ada l.o013-* bf.dtab.0 a now points to word of last char
2334 qls 0 one more char?
2335 tpl 2 no
2336 ora l.o014-* 0b.1 yes account for it
2337 ada obufad-* add address of base of buffer
2338 cax2 x2 now points to last char
2339 lda t.ofch1 get flow control chars
2340 arl 9 isolate eond-of-block char
2341 cmpa 02b.0 is this it?
2342 tnz out071-* no proceed normally
2343 aos t.omct1 yes count the message
2344 ldx2 obufad-* and break chain here
2345 cx2a convert it ot absolute for permanent storage
2346 tsy a.o005-** cvabs
2347 sta t.olst1
2348 lda bf.nxt2 keep the remains in t.ocp
2349 sta t.ocp1
2350 stz bf.nxt2 detach the chain
2351 tze out073-* if there is no more check for sendout
2352 tra out075-* else we're done -- don't turn on tfwrit
2353 out071 ldx2 obufad-* restore current buffer address
2354 ldq bf.nxt2 search chain for new end
2355 tnz out070-*
2356 rem
2357 lda l.o008-* =tfwrit turn on tfwrit now
2358 orsa t.flg1 not before.
2359 rem
2360 cx2a
2361 tsy a.o005-** cvabs
2362 sta t.olst1
2363 stz t.ocp1 zero output chain pointer to allow
2364 rem for new one
2365 out073 ila bufthr get output buffer threshold
2366 cmpa t.ocnt1 if we're not over it
2367 tmi out075-*
2368 ilq sndout ask for more output
2369 tsy a.o003-** denq
2370 rem
2371 out075 null
2372 iacx3 0b.1 get next char
2373 lda 03b.0 had better be end of subop
2374 cmpa l.o005-* =477
2375 tze out200-*
2376 die 7
2377 rem
2378 out080 null only remaining possibility
2379 icmpa repeat is repeat
2380 tze out100-*
2381 out090 null
2382 die 9
2383 rem
2384 out100 null
2385 lda 03b.1 get character to be repeated
2386 iacx3 1b.0
2387 ldq 03b.0 get repeat count
2388 tnz 2 where 0 means 512
2389 ldq l.o006-* =512
2390 rem
2391 out110 null
2392 tsy a.o001-** insert
2393 iaq -1 repeat count exhausted?
2394 tnz out110-* no do it again
2395 tra out010-* yes get next item
2396 rem
2397 rem
2398 out200 null end of output subop
2399 cx3a
2400 ana l.o007-* =o077777 convert to word addressing
2401 iaa 1 point to next word
2402 caq save new address
2403 sba t.dcwa1 get number of words processed
2404 sta otemp-*
2405 lda t.dcwl1 decrement dcw length accordingly
2406 sba otemp-*
2407 sta t.dcwl1
2408 stq t.dcwa1 save new dcw list pointer
2409 return outprc
2410 *
2411 rem
2412 rem
2413 l.o001 zero 0b.0 for character addressing
2414 l.o002 oct 400
2415 l.o003 vfd 18/tfctrl
2416 l.o004 vfd 18/maxctl
2417 l.o005 oct 477
2418 l.o006 dec 512
2419 l.o007 oct 77777
2420 l.o008 vfd 18/tfwrit
2421 l.o009 vfd 18/tfblak+tfofc
2422 l.o010 vfd 18/bffhld hold output buffer flag
2423 l.o011 vfd 18/bfflst last buffer in message flag
2424 l.o012 vfd 18/buftmk
2425 l.o013 zero bf.dtab.0
2426 l.o014 zero 0b.1
2427 rem
2428 otemp bss 1 temporary storage
2429 obufad bss 1 temporary for buffer address
2430 ohldot bss 1 flag - on if hold output buffers set
2431 rem
2432 a.o001 ind insert
2433 a.o002 ind ctrl
2434 a.o003 ind denq
2435 a.o004 ind setbpt
2436 a.o005 ind cvabs
2437 rem
2438 ttls insert -- subroutine to insert a char into output chain
2439 rem
2440 rem insert called by outprc to insert char passed in a
2441 rem
2442 insert subr insaqx2x3
2443 rem
2444 rem
2445 szn t.ocur1 is there a buffer chain?
2446 tnz ins010-*
2447 rem no must allocate a buffer
2448 ilq bufsiz
2449 tsy a.p001-** getbfh
2450 die 10 die if we couldn't get one
2451 rem
2452 sta t.ocur1 this is now current buffer
2453 sta t.olst1 last one too
2454 tsy a.p002-** setbpt
2455 cax3 now have virtual address in a and x3
2456 sta insbuf-* save it for later also
2457 iaa bf.dta point output char. pointer at
2458 ora l.p001-* 0b.0 first data char of new chain
2459 sta t.occh1
2460 tra ins030-*
2461 rem
2462 ins010 null find out if last buffer is full
2463 lda t.olst1
2464 tsy a.p002-** setbpt
2465 cax3
2466 tsy l.p002-** =addrfulbuf
2467 rem returns normally if full
2468 rem or +1 with tally in a
2469 tra ins020-*
2470 stx3 insbuf-* save virtual address for later
2471 lrs 1 get tally in words but save
2472 sta itemp1-* low-order bit in q
2473 cx3a
2474 iaa bf.dta
2475 ada itemp1-*
2476 ora l.p001-* 0b.0
2477 cax3
2478 qls 0 was tally odd?
2479 tpl ins040-*
2480 iacx3 0b.1 yes bump data pointer
2481 tra ins040-*
2482 rem
2483 ins020 null
2484 ilq bufsiz buffer was full get another
2485 tsy a.p001-** getbfh
2486 die 10 die if we can't
2487 rem
2488 caq hang on to absoute address
2489 lda t.olst1
2490 tsy a.p002-** setbpt
2491 cax2
2492 stq bf.nxt2 save in old last buffer's
2493 rem forward pointer
2494 cqa have to revirtualize
2495 tsy a.p002-** to make sure pte is right
2496 cax3 save virtual address
2497 sta insbuf-* store it for later also
2498 iaa bf.dta point to first data char
2499 ora l.p001-* 0b.0
2500 stq t.olst1 set new last buffer
2501 ins030 null mark this buffer as containing control chars
2502 caq save the a reg.
2503 lda l.p006-* =bffctl
2504 orsa bf.flg3
2505 cqa
2506 rem
2507 cax3
2508 rem
2509 rem
2510 ins040 null x3 points to where char should go
2511 lda inssa-* get the char
2512 sta 03b.0 store it in buffer
2513 ldx2 insbuf-* get addressable pointer to buffer
2514 lda bf.tly2 get the old tally
2515 ana l.p003-* =buftmk
2516 iaa 1 bump it
2517 sta itemp1-* save it
2518 lda l.p005-* =^buftmk
2519 ansa bf.tly2 zero out tally field
2520 lda itemp1-* so as to replace it
2521 orsa bf.tly2
2522 return insert
2523 rem
2524 rem
2525 rem
2526 l.p001 zero 0b.0 character addressing
2527 l.p002 ind fulbuf routine to see if buffer full
2528 l.p003 vfd 18/buftmk
2529 l.p004 dec 4
2530 l.p005 vfd 18/nbftmk complement mask for tally
2531 l.p006 vfd 18/bffctl
2532 rem
2533 itemp1 bss 1 temporary storage
2534 insbuf bss 1 virtual address of t.olst
2535 rem
2536 a.p001 ind getbfh buffer allocation routine
2537 a.p002 ind setbpt
2538 rem
2539 ttls fulbuf subroutine finds out if buffer is full
2540 rem
2541 rem this subroutine passed a buffer address in
2542 rem x3 looks to see if tally indicates that buffer
2543 rem is full.
2544 rem
2545 rem returns to callpoint+1 if buffer is full
2546 rem else to callpoint+2 with tally in a
2547 rem
2548 fulbuf subr ful
2549 rem
2550 lda bf.siz3
2551 arl 15 isolate size code
2552 iaa 1
2553 mpf l.f002-* =bufsiz
2554 rem mpf comes out double so it gives number of chars
2555 sbq l.f001-* =4 4 chars worth of header
2556 stq ftemp-*
2557 lda bf.tly3 get tally
2558 ana l.f003-* =buftmk
2559 cmpa ftemp-* tally>=size?
2560 tpl 2 yes regular return
2561 aos fulbuf-* else return+1
2562 return fulbuf
2563 rem
2564 rem
2565 l.f001 dec 4 number words of buffer header
2566 l.f002 vfd 18/bufsiz
2567 l.f003 vfd 18/buftmk mask for buffer tally
2568 ftemp bss 1
2569 ttls metering subroutines
2570 rem
2571 ************************************************************************
2572 *
2573 * meterc -- adds one to a "counting" meter
2574 *
2575 * index of meter to be incremented is passed in q reg.
2576 *
2577 ************************************************************************
2578 rem
2579 meterc subr mtcinhqx3
2580 rem
2581 ldi l.d001-* o024000 inhibit overflow
2582 cmpq cmax-* is value legal?
2583 tnc mtc010-*
2584 aos meterr-* if not meter invalid call
2585 tra mtcbak-* and return
2586 rem
2587 mtc010 null
2588 ldx3 mtcsq-* ok get meter name into x3
2589 aos cmetrs-** increment it
2590 mtcbak return meterc
2591 rem
2592 rem
2593 ************************************************************************
2594 *
2595 * metert -- increments a "time" meter
2596 *
2597 * index of meter is passed in q reg.
2598 * increment in microseconds is passed in a reg.
2599 *
2600 ************************************************************************
2601 rem
2602 metert subr mttinhaqx3
2603 rem
2604 ldi l.d001-* o024000 inhibit overflow
2605 cmpq tmax-* is meter index too big?
2606 tnc mtt010-* if so meter that
2607 aos meterr-*
2608 tra mttbak-* and return
2609 rem
2610 mtt010 qls 1 multiply by two for indexing
2611 stq mttemp-* time meters are 2 words each
2612 ldx3 mttemp-* index into x3
2613 lrs 18 time into aq
2614 adaq tmetrs-** increment meter
2615 staq tmetrs-**
2616 mttbak return
2617 rem
2618 rem
2619 rem
2620 meterr zero invalid meter count
2621 rem
2622 rem
2623 rem
2624 l.d001 oct 024000 "inhibit overflow" & "inhibit interrupts"
2625 rem
2626 rem
2627 mttemp bss 1
2628 tmax zero tmaxd/2 maximum value for "time" meters
2629 rem
2630 rem
2631 cmetrs ind *+13 "count" meters
2632 bss 50
2633 cmax zero *-cmetrs-1 maximum value for a count meter
2634 rem
2635 rem
2636 tmetrs ind tmorg3 "timing" meters
2637 even
2638 tmorg null
2639 bss 100
2640 tmaxd equ *-tmorg
2641 ttls virtual/absolute address conversion routines
2642 ************************************************************************
2643 *
2644 * setptw
2645 * converts an 18 bit absolute address to a 15 bit virtual
2646 * address and sets up the page table entry in the cpu page
2647 * table. this routine is only required if more than 32K of
2648 * memory is configured for a dn6670. a 'tra -1' is stored into
2649 * setptw+1 by init if otherwise.
2650 *
2651 * input:
2652 * a reg - 18 bit absolute address
2653 *
2654 * output:
2655 * a reg - 15 bit virtual address
2656 *
2657 * modified registers: none
2658 *
2659 ************************************************************************
2660 rem
2661 rem a 'tra -1*' is stored in setptw+1 by init if
2662 rem only 32k is configured
2663 setptw subr ptwinhx2 cannot allow interruptions
2664 ldx2 a.v001-** .crpte
2665 tsy setpte-*
2666 ora l.v001-* concatenate with window address
2667 return setptw all done
2668 rem
2669 rem
2670 ************************************************************************
2671 *
2672 * setbpt
2673 * like setptw except used for buffer addresses. sets pte for buffer
2674 * window rather than general address window
2675 *
2676 ************************************************************************
2677 rem
2678 setbpt subr bptinhx2
2679 cmpa l.v003-* =o100000
2680 tmi bptbak-* not in high memory leave it alone
2681 ldx2 a.v002-** .crbpe
2682 tsy setpte-* to do the work
2683 ora l.v002-* bwndow concatenate window base
2684 bptbak return setbpt
2685 eject
2686 ************************************************************************
2687 *
2688 * setpte
2689 * common subroutine used to set a page table entry
2690 *
2691 * input:
2692 * a reg - 18 bit absolute address
2693 * x2 - address of page table entry
2694 *
2695 * output:
2696 * a reg - low-order 8 bits of virtual address offset in page
2697 *
2698 ************************************************************************
2699 rem
2700 setpte subr spt
2701 sta sargsv-* save to provide offset
2702 iana -256 get page number
2703 iora pte.a turn on active bit
2704 sta 02 put in relevant page table entry
2705 lda sargsv-* get page offset
2706 iana 255
2707 return setpte
2708 rem
2709 rem
2710 ************************************************************************
2711 *
2712 * cvabs
2713 * routine to convert virtual address to absolute.
2714 * assumes corresponding page table entry buffer or tib/sfcm
2715 * points to correct page.
2716 *
2717 * input:
2718 * a reg - 15-bit virtual address
2719 *
2720 * output:
2721 * a reg - corresponding 18-bit absolute address
2722 *
2723 ************************************************************************
2724 rem
2725 cvabs subr cvainhqx2
2726 cmpa l.v002-* bwndow make sure address is in a window
2727 tmi cvabak-* it's below
2728 cmpa l.v003-* =o100000 not a virtual address at all
2729 tpl cvabak-* it's above
2730 caq hang on to address
2731 cmpa l.v001-* window which window is it in?
2732 tpl cva010-* tib/sfcm
2733 ldx2 a.v002-** .crbpe buffer
2734 sba l.v002-* bwndow
2735 tra cva020-*
2736 cva010 ldx2 a.v001-** .crpte
2737 sba l.v001-* window
2738 cva020 sta cvaoff-* save offset within page
2739 lda 02 get real address of page base
2740 icana pte.a make sure it's active
2741 tnz cva030-* yes
2742 cqa no restore original address
2743 tra cvabak-* return
2744 cva030 null
2745 iana -256 reduce to address only
2746 ada cvaoff-* add offset
2747 cvabak return cvabs done
2748 rem
2749 pte.r bool 200 page table entry read only bit
2750 pte.s bool 100 page table entry security bit
2751 pte.a bool 40 page table entry active bit
2752 window bool 77400 base address of paged memory
2753 bwndow bool 77000 base address of buffer window
2754 rem
2755 a.v001 ind .crpte
2756 a.v002 ind .crbpe
2757 rem
2758 l.v001 vfd 18/window
2759 l.v002 vfd 18/bwndow
2760 l.v003 oct 100000 smallest address outside 32k
2761 rem
2762 sargsv oct 0 storage for argument
2763 cvaoff bss 1
2764 ttls move with paging on source or target address
2765 ************************************************************************
2766 *
2767 * mvpgsc
2768 * this entry moves a block of data from an absolute location anywhere
2769 * in the fnp memory using the paging mechanism to a target in the lower
2770 * 32k of fnp memory.
2771 *
2772 * mvpgtg
2773 * this entry moves a block of data from the lower 32k of fnp memory
2774 * to a target anywhere in fnp memory using the paging mechanism.
2775 *
2776 * either entry can be directed to cross page boundaries and to start
2777 * and end anywhere in a page. each time a page boundary is crossed
2778 * the page table entry for the virtual window will be initialized.
2779 *
2780 * input registers:
2781 * x2 source address
2782 * x3 target address
2783 * q length of move
2784 *
2785 * output registers:
2786 * none
2787 *
2788 * modified registers: a q x2 x3
2789 *
2790 * unmodified registers: x1
2791 *
2792 ************************************************************************
2793 rem
2794 rem
2795 *
2796 * entry points
2797 rem
2798 mvpgsc subr mpsinh
2799 lda mvpgsc-* set up a common return point
2800 sta mvpgtg-*
2801 lda mpssi-*
2802 sta mptsi-*
2803 stx2 mabsad-* save as absolute address to virtualize
2804 lda l.w001-* 'cax2' inst to set up x2 with virtual address
2805 sta mvp080-*
2806 cx3a for checking non-paged address
2807 tra mvp000-*
2808 rem
2809 mvpgtg subr mptinh
2810 stx3 mabsad-* save as absolute address to virtualize
2811 lda l.w002-* 'cax3' inst to set up x3 with virtual address
2812 sta mvp080-*
2813 cx2a for checking non-paged address
2814 *
2815 * check input values
2816 rem
2817 mvp000 null
2818 ldi l.w004-* =o024000 inhibit overflow for logical adds
2819 sta mtstad-* save for compare
2820 stq mrmlen-* total length of move
2821 ldq mvplmm-* get last legal lower memory address
2822 cmpq mtstad-* is non-paged starting address below
2823 rem lower memory maximum?
2824 tpl 2 yes
2825 die 14 no. this shouldn't happen
2826 ada mrmlen-* calculate ending non-paged address
2827 iaa -1
2828 sta mtstad-* save for compare
2829 cmpq mtstad-* is non-paged ending address below
2830 rem lower memory maximum?
2831 tpl 2 yes
2832 die 14 no. this shouldn't happen
2833 ldq a.w001-** .crmem get last legal absolute address
2834 cmpq mabsad-* is starting absolute address ok?
2835 tpl 2 yes
2836 die 14 no. this shouldn't happen
2837 lda mabsad-* calculate ending absolute address
2838 ada mrmlen-*
2839 iaa -1
2840 sta mtstad-* save for compare
2841 cmpq mtstad-* is this address ok?
2842 tpl 2 yes
2843 die 14 no. this shouldn't happen
2844 ldq mrmlen-* is length of move > 0?
2845 tnz 2 yes
2846 die 1 no. this shouldn't happen
2847 *
2848 * set up length of first move
2849 rem
2850 lda mabsad-* calculate number of words in first page
2851 iana -256
2852 ada l.w003-* =256
2853 sba mabsad-* now have it
2854 cmpa mrmlen-* will first pass move all?
2855 tnc mvp020-* no
2856 stz mrmlen-* yes
2857 tra mvp040-* go do it
2858 rem
2859 mvp020 null
2860 caq length of first move
2861 stq mvllmp-* save it for absolute address update
2862 iera -1 calculate remaining length of total move after
2863 iaa 1 first pass
2864 asa mrmlen-*
2865 rem
2866 mvp040 null
2867 lda mabsad-* setup to virtualize absolute address
2868 *
2869 * virtualize source or target address
2870 rem
2871 mvp060 null outer move loop point
2872 tsy setptw-* virtualize and set ptw
2873 rem
2874 mvp080 oct 0 this location is set to 'cax2' or 'cax3' inst
2875 rem
2876 *
2877 * paged move loop
2878 rem
2879 mvp100 null move no more than one page here
2880 lda 02 get one source word
2881 sta 03 store in target
2882 iacx2 1 update pointers
2883 iacx3 1
2884 iaq -1 is current page moved?
2885 tnz mvp100-* no. continue move
2886 *
2887 * check if whole move is finished
2888 rem
2889 ldq mrmlen-* has everything been moved?
2890 tze mvpret-* yes. return
2891 *
2892 * update absolute address
2893 rem
2894 lda mabsad-* update absolute address
2895 ada mvllmp-* with length of last move pass
2896 sta mabsad-*
2897 *
2898 * set up length of next move pass
2899 rem
2900 sbq l.w003-* =256 update length of total remaining move
2901 stq mrmlen-* is it negative?
2902 tmi mvp110-* yes
2903 ldq l.w003-* =256 no. move a whole page
2904 stq mvllmp-*
2905 tra mvp060-* move some more
2906 rem
2907 mvp110 null
2908 adq l.w003-* =256 back up last subtract
2909 stz mrmlen-* last pass coming up
2910 tra mvp060-* go do it
2911 rem
2912 mvpret null
2913 return mvpgtg
2914 rem
2915 rem
2916 a.w001 ind .crmem last legal memory address
2917 rem
2918 l.w001 cax2
2919 l.w002 cax3
2920 l.w003 dec 256
2921 l.w004 oct 024000 inhibit interrupts and overflow
2922 rem
2923 mabsad oct 0 absolute address
2924 mrmlen oct 0 current remaining total length of move
2925 mtstad oct 0 test address value for legalness
2926 mvllmp oct 0 length of last move pass
2927 mvplmm zero move paged lower memory maximum address
2928 ttls mcs space management routines
2929 ************************************************************************
2930 *
2931 * format of buffer pool header
2932 *
2933 ************************************************************************
2934 rem
2935 fp.fst equ 0 pointer to first free block
2936 rem
2937 ************************************************************************
2938 *
2939 * format of free block
2940 *
2941 ************************************************************************
2942 rem
2943 fb.nxt equ 0 next block pointer
2944 fb.siz equ 1 size of this block in words
2945 eject
2946 ************************************************************************
2947 *
2948 * subroutine to allocate buffer space in low memory.
2949 * the request is rounded up to a 'bufsiz' boundary
2950 * and removed from the full buffer pool.
2951 *
2952 * calling sequence:
2953 *
2954 * q = size of space to allocate
2955 *
2956 * returns:
2957 *
2958 * returns in line if request fails
2959 * takes skip return if request suceeds
2960 * x3 -> space allocated
2961 *
2962 ************************************************************************
2963 rem
2964 getbuf subr gbfinhaqx1
2965 tsy a.y011-** timein record time entered
2966 cqa number of words to allocate
2967 tsy a.y005-** chksiz check for valid size
2968 iaa bufsiz-1 round to multiple of bufsiz
2969 iana -bufsiz
2970 caq
2971 ldx1 a.y003-* =addr.crnxa start of chain
2972 tsy a.y006-** getspc allocate the space
2973 tra gbfnsp-* failed
2974 gbfok aos getbuf-* succeeded setup skip return
2975 staq gbfaq-* safe store aq smeter uses them
2976 smeter mincd.mbufal.y001-*
2977 ldaq gbfaq-* restore them
2978 rem
2979 * update .crnbf
2980 rem
2981 ars bufshf convert from words to buffers
2982 iera -1 complement
2983 iaa 1
2984 asa a.y001-** update .crnbf
2985 tsy a.y013-** setsc set size code and clear buffer
2986 rem
2987 trace mt.get0x3gbfsqgetbufgbfsx1
2988 rem
2989 gbfbak ila 0 indicate allocation call
2990 tsy a.y012-** extime
2991 return getbuf
2992 rem
2993 * request for buffers failed. try cleaning up small space
2994 rem
2995 gbfnsp tsy a.y002-** =fresml this does cleanup
2996 tra gbfng-* didn't do any good
2997 tsy a.y006-** getspc retry request
2998 tra gbfng-* still fails
2999 tra gbfok-* this made request work
3000 rem
3001 gbfng smeter mincs.malofl.y001-*
3002 tra gbfbak-*
3003 eject
3004 ************************************************************************
3005 *
3006 * procedure for getting a small amount of memory. the
3007 * calling sequence is the same as for getbuf except
3008 * the request is rounded to an even number and the returned
3009 * address will only be on an even boundary
3010 *
3011 ************************************************************************
3012 rem
3013 getmem subr gtminhaqx1
3014 tsy a.y011-** timein
3015 cqa word count
3016 tsy a.y005-** chksiz check for valid size
3017 iaa 1 make it even
3018 iana -2
3019 gbfsml caq word count
3020 ldx1 a.y009-* =addr.crnxs
3021 tsy a.y006-** getspc look in small space chain
3022 tra gbfail-* not there
3023 aos getmem-* found it take skip
3024 tsy a.y014-** clrbuf go clear space
3025 rem
3026 trace mt.get0x3gtmsqgetmemgtmsx1
3027 rem
3028 gtmbak ila 0 indicate allocate call
3029 tsy a.y012-** extime
3030 return getmem
3031 rem
3032 * must allocate more buffers for small space
3033 rem
3034 gbfail sta gbftmp-* save word count
3035 iaa bufsiz-1 round to next multiple
3036 iana -bufsiz
3037 caq
3038 ldx1 a.y007-* =addr.crnxa
3039 tsy a.y006-** getspc get buffer
3040 tra gtmng-* failed give up
3041 ldx1 a.y009-* =addr.crnxs
3042 tsy a.y004-** relspc free in to small chain
3043 ars bufshf convert to buffers
3044 asa a.y010-** increment .crnbs
3045 iera -1 complement
3046 iaa 1
3047 asa a.y001-** decrement .crnbf
3048 lda gbftmp-* get original word count
3049 tra gbfsml-* retry allocate
3050 rem
3051 gtmng smeter mincs.malofl.y001-*
3052 tra gtmbak-*
3053 rem
3054 rem
3055 a.y001 ind .crnbf
3056 a.y002 ind fresml
3057 a.y003 ind .crnxa
3058 a.y004 ind relspc
3059 a.y005 ind chksiz
3060 a.y006 ind getspc
3061 a.y007 ind .crnxa
3062 *a.y008 unused
3063 a.y009 ind .crnxs
3064 a.y010 ind .crnbs
3065 a.y011 ind timein
3066 a.y012 ind extime
3067 a.y013 ind setsc
3068 a.y014 ind clrbuf
3069 rem
3070 l.y001 dec 1
3071 rem
3072 gbftmp bss 1
3073 even
3074 gbfaq bss 2
3075 eject
3076 ************************************************************************
3077 *
3078 * timein: records the elapsed timer at entry so that the time
3079 * spent in the allocation/freeing routines can be metered
3080 *
3081 ************************************************************************
3082 rem
3083 timein subr tmn
3084 lda a.x001-** etmb
3085 sta sttime-* record time of entry
3086 return timein
3087 rem
3088 rem
3089 ************************************************************************
3090 *
3091 * extime: records elapsed time at exit from
3092 * allocation/freeing routines for metering.
3093 * also meters current use of buffer pool
3094 *
3095 * input:
3096 * a reg contains 0 for allocate 1 for free
3097 *
3098 ************************************************************************
3099 rem
3100 extime subr extaqx2
3101 lda a.y001-** .crnbf
3102 ada a.y010-** .crnbs
3103 als bufshf convert to words for metering
3104 sta savcnt-*
3105 smeter mupdat.mspavsavcnt-*
3106 rem
3107 rem measure time spent
3108 lda a.x001-** etmb current elapsed timer value
3109 sta sttimx-* save it for debugging
3110 sba sttime-* a now contains time spent
3111 ldx1 extsa-* get alloc/free indicator
3112 ldx2 a.x002-** get pointer to relevant structure
3113 lrl 18 make time into doubleword
3114 staq loctim-* hang on to it
3115 adaq it.tot2 update running total
3116 staq it.tot2
3117 ldaq loctim-*
3118 cmpq it.max2 new maximum?
3119 tmi 2
3120 stq it.max2 yes save it
3121 ilq 1 see if it's more than 1 msec.
3122 cmpq loctim+1-*
3123 tpl ext010-* nope
3124 adaq it.gt12 yes add 1 which happens to be in aq
3125 staq it.gt12 to count of same
3126 ila 0
3127 ilq 1 get the one back
3128 ext010 adaq it.inc2 update increment count
3129 staq it.inc2
3130 return extime
3131 rem
3132 rem
3133 a.x001 ind etmb
3134 a.x002 ind itaddr1
3135 rem
3136 savcnt bss 1 number of free words for metering
3137 sttime bss 1 elapsed timer reading at entry
3138 sttimx bss 1 elapsed timer reading at exit
3139 itaddr ind getbfm
3140 ind frebfm
3141 rem
3142 even
3143 loctim bss 2 elapsed time while in routine
3144 getbfm bss 8 time meters for get calls
3145 frebfm bss 8 time meters for free calls
3146 eject
3147 ************************************************************************
3148 *
3149 * subroutine to fill in buffer size code
3150 * and zero the rest of the buffer
3151 *
3152 * input:
3153 * q contains size in words
3154 * x3 points to buffer
3155 *
3156 ************************************************************************
3157 rem
3158 setsc subr sscaqx3
3159 iaq -32 reduce by one unit
3160 qls 15-bufshf align in word
3161 stq bf.siz3
3162 stz bf.nxt3
3163 lda sscsq-* total words
3164 iaa -2 number left to clear
3165 iacx3 2 starting address to clear
3166 tsy clrbuf-*
3167 return setsc
3168 rem
3169 ************************************************************************
3170 *
3171 * subroutine to clear buffer or allocated space
3172 *
3173 * input:
3174 * x3 points to space to be cleared
3175 * a contains number of words to clear
3176 *
3177 ************************************************************************
3178 rem
3179 clrbuf subr clraqx3
3180 ars 1 number of double words to clear
3181 iera -1 complement
3182 iaa 1
3183 sta clrtmp-*
3184 ila 0 constants to store
3185 ilq 0
3186 clr010 staq 03 zero two words
3187 iacx3 2
3188 aos clrtmp-*
3189 tnz clr010-*
3190 return clrbuf
3191 rem
3192 rem
3193 clrtmp bss 1
3194 eject
3195 ************************************************************************
3196 *
3197 * subroutine to free buffer space in low memory
3198 *
3199 * calling sequence:
3200 *
3201 * x3 -> space to be freed
3202 * q = size of space or 0 meaning use buffer size code
3203 *
3204 ************************************************************************
3205 rem
3206 frebuf subr fbfinhaqx1
3207 tsy a.n001-** timein
3208 cqa pick up size
3209 tnz fbf010-* size is given
3210 lda fb.siz3 get size code
3211 arl 15
3212 iaa 1 number of buffers
3213 als bufshf convert to words
3214 tra fbf020-*
3215 fbf010 tsy chksiz-* check for valid size
3216 iaa bufsiz-1 round to multiple of bufsiz
3217 iana -bufsiz
3218 fbf020 sta fretmp-* save buffer size temporarily
3219 rem
3220 trace mt.fre0x3fretmpfrebuffbfsx1
3221 rem
3222 lda fretmp-*
3223 ldx1 a.n002-* =addr.crnxa free from full buffer chain
3224 caq
3225 tsy a.n003-** relspc
3226 ars bufshf get buffer count
3227 asa a.n004-** update .crnbf
3228 ila 1 indicate free call
3229 tsy a.n005-** extime
3230 return frebuf
3231 rem
3232 fretmp bss 1
3233 eject
3234 ************************************************************************
3235 *
3236 * similiar entry for freeing memory
3237 *
3238 ************************************************************************
3239 rem
3240 fremem subr frminhaqx1
3241 tsy a.n001-** timein
3242 cqa word count
3243 tsy chksiz-* check for valid size
3244 iaa 1 make it even
3245 iana -2
3246 sta fretmp-* save size
3247 rem
3248 trace mt.fre0x3fretmpfrememfrmsx1
3249 rem
3250 ldq fretmp-* retrieve size
3251 ldx1 a.n006-* =addr.crnxs
3252 tsy a.n003-** relspc
3253 ila 1 indicate free call
3254 tsy a.n005-** extime
3255 return fremem
3256 rem
3257 rem
3258 a.n001 ind timein
3259 a.n002 ind .crnxa
3260 a.n003 ind relspc
3261 a.n004 ind .crnbf
3262 a.n005 ind extime
3263 a.n006 ind .crnxs
3264 eject
3265 ************************************************************************
3266 *
3267 * subroutine to check for a valid buffer size in the a
3268 *
3269 ************************************************************************
3270 rem
3271 chksiz oct 0
3272 szn bfcksw-* should we check?
3273 tnz chksiz-** no
3274 icmpa 1
3275 tpl 2
3276 die 1
3277 cmpa maxsiz-*
3278 tmi 2
3279 die 2
3280 tra chksiz-**
3281 rem
3282 maxsiz ind bfmsiz+1
3283 rem
3284 symdef bfcksw indicates whether calls are checked
3285 rem
3286 bfcksw oct 1 start out as no
3287 eject
3288 ************************************************************************
3289 *
3290 * getbfh -- get a buffer in extended memory. address boundary
3291 * will be chosen based on buffer size so as to ensure that no
3292 * buffer spans a page boundary
3293 *
3294 * input:
3295 * q -- size in words
3296 *
3297 * output:
3298 * a -- absolute address of allocated buffer
3299 * x3 -- virtual " " " "
3300 * buffer window page table entry set up appropriately
3301 *
3302 ************************************************************************
3303 rem
3304 getubf null name retained for compatibility
3305 getbfh subr gfhinhqx1x2
3306 tsy a.j007-** timein
3307 cqa hang on to size
3308 tsy a.j006-** chksiz
3309 iaa bufsiz-1
3310 iana -bufsiz round size to nearest multiple of bufsiz
3311 caq this is size we'll use
3312 stq size-* put it in cold storage
3313 ila 0 clear the a
3314 iaq -1 and shift size-1
3315 lls 18-bufshf so as to get number of bufsiz blocks
3316 cax2 in order to force appropriate boundary
3317 adcx2 a.j003-* addr bounds
3318 lda 02 get the boundary in the a
3319 sta bndry-* save it
3320 stz prvadr-* initialize
3321 lda a.j001-** .crnxe start search
3322 tze gfh025-* no extended memory at all
3323 rem
3324 gfh010 sta blkadr-* block we're testing
3325 tsy a.j002-** setbpt get virtual address
3326 cax2
3327 cana bndry-* is it properly aligned?
3328 tnz gfh020-* no go to next free block
3329 lda fb.siz2 yes is it big enough?
3330 cmpa size-*
3331 tpl gfh030-* yes use it
3332 rem look at next block
3333 gfh020 lda blkadr-* save block address as previous
3334 sta prvadr-*
3335 lda fb.nxt2 get next
3336 tnz gfh010-* if any
3337 rem no usable blocks in high memory
3338 rem try low
3339 gfh025 ldx1 a.j004-* addr .crnxa
3340 ldq size-*
3341 tsy a.j009-** getspc regular space allocating subroutine
3342 tra gfh070-* forget it no space to be had
3343 stx3 blkadr-* ok
3344 rem meter instance of having to use low memory
3345 smeter mincs.mblowl.j001-*
3346 rem
3347 tra gfh060-* join common code
3348 rem found usable block in high memory
3349 gfh030 null a contains size
3350 stx2 blkvir-* save virtual address
3351 ldq fb.nxt2 pick up address of next free block
3352 sba size-* size of remainder
3353 tze gfh040-* none
3354 adcx2 size-* this is address of new free block
3355 stq fb.nxt2 put forward pointer in
3356 sta fb.siz2 and size
3357 lda blkadr-* now get absolute address of allocated block
3358 ada size-*
3359 caq now however we got here address
3360 gfh040 null of next block is in q
3361 lda prvadr-* get address of previous block
3362 tze gfh050-* if any
3363 tsy a.j002-** setbpt make it usable
3364 cax2
3365 stq fb.nxt2 rethread new next block
3366 lda blkadr-* now get allocated block address back
3367 tsy a.j002-** setbpt
3368 cax3
3369 tra gfh060-* go turn it into a buffer
3370 rem
3371 gfh050 stq a.j001-** .crnxe new head of free chain
3372 ldx3 blkvir-* we haven't lost its page
3373 gfh060 aos getbfh-* take successful return
3374 ldq size-* set the size code and clear the buffer
3375 tsy a.j005-** setsc
3376 rem now update .crnbf
3377 cqa get size in a
3378 ars bufshf convert to buffers
3379 iera -1 complement
3380 iaa 1
3381 asa a.j010-** .crnbf
3382 rem
3383 smeter mincd.mbufal.j001-*
3384 rem
3385 trace mt.get0blkadrgfhsqgetbfhgfhsx1
3386 rem
3387 gfhbak ila 0
3388 tsy a.j008-** extime
3389 lda blkadr-* absolute address as well
3390 return getbfh
3391 rem
3392 gfh070 null failure branch
3393 smeter mincs.malofl.j001-*
3394 tra gfhbak-*
3395 rem
3396 rem
3397 l.j001 dec 1
3398 rem
3399 a.j001 ind .crnxe
3400 a.j002 ind setbpt
3401 a.j003 ind bounds
3402 a.j004 ind .crnxa
3403 a.j005 ind setsc
3404 a.j006 ind chksiz
3405 a.j007 ind timein
3406 a.j008 ind extime
3407 a.j009 ind getspc
3408 a.j010 ind .crnbf
3409 rem
3410 size bss 1
3411 prvadr bss 1
3412 blkadr bss 1
3413 blkvir bss 1
3414 bndry bss 1
3415 rem
3416 bounds equ * array of strings for and'ing to ensure
3417 rem correct boundary -- indexed by buffer size
3418 oct 000037
3419 oct 000077
3420 oct 000177
3421 oct 000177
3422 oct 000177
3423 oct 000377
3424 oct 000377
3425 oct 000377
3426 oct 000377
3427 eject
3428 ************************************************************************
3429 *
3430 * frebfh -- external entry to free a single buffer in high
3431 * memory. internal subroutine frhbuf does most of the real work.
3432 *
3433 * input:
3434 * a contains absolute address of buffer to be freed
3435 * q contains size in words if zero use size code in buffer
3436 *
3437 ************************************************************************
3438 rem
3439 frebfh subr frbaqx2x3
3440 cmpa l.l001-* bwndow is buffer in fact in high memory?
3441 tnc frb010-* no use frebuf
3442 cax2 hang on to absolute address
3443 tsy a.l001-** setbpt
3444 cax3 get virtual address in x3
3445 lda frebfh-* save return address
3446 sta frertn-* for trace call
3447 cx2a get absolute address back in a
3448 tsy a.l002-** frhbuf
3449 frbbak return frebfh
3450 rem
3451 frb010 cax3 address in x3
3452 tsy a.l003-** frebuf
3453 tra frbbak-*
3454 eject
3455 ************************************************************************
3456 *
3457 * subroutine to free a buffer chain
3458 *
3459 * calling sequence:
3460 *
3461 * a contains absolute address of buffer chain
3462 *
3463 ************************************************************************
3464 rem
3465 frelbf subr frlaqx2
3466 rem
3467 trace mt.frc0frlsafrelbfx1x3
3468 rem
3469 ldq frelbf-* for trace calls on individual
3470 stq frertn-* buffers
3471 ilq 0 always use size in buffer
3472 lda frlsa-*
3473 frl010 cmpa l.l001-* bwndow is buffer in high memory?
3474 tmi frl030-* no use frebuf
3475 cax2 hang on to absolute address
3476 tsy a.l001-** setbpt
3477 cax3 get virtual into x3
3478 lda bf.nxt3 hold forward pointer
3479 sta frlnxt-* hang on to it
3480 cx2a recover absolute address of buffer
3481 tsy a.l002-** frhbuf free one buffer
3482 frl020 lda frlnxt-* recover next pointer
3483 tnz frl010-* not at end yet
3484 return frelbf
3485 rem
3486 frl030 cax3
3487 lda bf.nxt3
3488 sta frlnxt-*
3489 tsy a.l003-** frebuf
3490 tra frl020-*
3491 rem
3492 rem
3493 a.l001 ind setbpt
3494 a.l002 ind frhbuf
3495 a.l003 ind frebuf
3496 rem
3497 l.l001 vfd 18/bwndow
3498 rem
3499 frlnxt bss 1
3500 frertn bss 1
3501 eject
3502 ************************************************************************
3503 *
3504 * frhbuf -- subroutine to do the real work of freeing a buffer
3505 * in high memory.
3506 *
3507 * input:
3508 * a - absolute address of buffer
3509 * q - size in words
3510 * x3 - virtual address of buffer
3511 * buffer page table entry set up appropriately
3512 *
3513 ************************************************************************
3514 rem
3515 frhbuf subr frhinhaqx1x2x3
3516 sta freadr-*
3517 tsy a.k003-** timein
3518 ldx2 a.k005-** .crbpe
3519 lda 02 save pte
3520 sta frepte-* which callers may be counting on
3521 rem
3522 stz frenxt-* initialize
3523 stz freprv-*
3524 cqa get size
3525 tnz frh005-* if supplied
3526 ldq bf.siz3 else derive it from buffer size code
3527 qrl 15
3528 iaq 1
3529 qls bufshf
3530 tra frh007-*
3531 frh005 iaa bufsiz-1 round it to multiple of bufsiz
3532 iana -bufsiz
3533 caq
3534 frh007 stq fb.siz3
3535 stq fresiz-*
3536 trace mt.fre0freadrfresizfrertnfrhsx1
3537 rem
3538 lda a.k001-** .crnxe get head of chain
3539 tze frh060-* no chain at the moment
3540 frh010 cmpa freadr-* see if new block comes before next free one
3541 tnc frh030-* no look for next block
3542 tze frhdie-* oops this is already free
3543 sta frenxt-* we've found the first block after the one we're
3544 cax2 freeing
3545 lda freadr-* get the original one back
3546 tsy a.k002-** setbpt get the pte right
3547 cax3
3548 stx2 fb.nxt3 set its forward pointer
3549 lda freprv-* hook it on to previous one
3550 tnz frh020-* if any
3551 lda freadr-*
3552 sta a.k001-** .crnxe none this is head
3553 tra frh050-* combine ahead
3554 rem
3555 frh020 tsy a.k002-** setbpt get previous block's
3556 cax1 virtual address
3557 lda freadr-* thread new one to it
3558 sta fb.nxt1
3559 tra frh040-* combine behind
3560 rem
3561 frh030 sta freprv-* save most recent block address
3562 tsy a.k002-** setbpt get virtual address
3563 cax1 to look at forward pointer
3564 lda fb.nxt1
3565 tnz frh010-* if any
3566 sta frenxt-* no next pointer remember that
3567 lda freadr-* thread new one to last found
3568 sta fb.nxt1
3569 tsy a.k002-** setbpt get new one's virtual
3570 cax3 address
3571 stz fb.nxt3 set its forward pointer
3572 rem
3573 frh040 null try to combine with previous block
3574 lda freprv-*
3575 caq
3576 tsy a.k002-** setbpt
3577 cax3 virtual address in x3
3578 adq fb.siz3 end of previous block
3579 cmpq freadr-* does it reach new one?
3580 tnc frh050-* no can't combine
3581 tnz frhdie-* overlaps!
3582 lda freprv-* make sure they're in same page
3583 ana l.k001-* =o777400
3584 sta frebas-*
3585 lda freadr-*
3586 ana l.k001-* =o777400
3587 cmpa frebas-*
3588 tnz frh050-* they are not don't combine
3589 lda frenxt-* they are so previous now points
3590 sta fb.nxt3 to next
3591 ldq fb.siz3
3592 adq fresiz-* and its size increases accordingly
3593 stq fb.siz3
3594 lda freprv-* and this the address of
3595 sta freadr-* the current block
3596 rem
3597 frh050 null try to combine with following block
3598 lda frenxt-*
3599 tze frhbak-* there is none we're done
3600 ana l.k001-* =o777400
3601 sta frebas-* save base of next block's page
3602 lda freadr-*
3603 ana l.k001-*
3604 cmpa frebas-* compare with current one
3605 tnz frhbak-* different can't combine
3606 lda freadr-* get current block
3607 caq
3608 tsy a.k002-** setbpt
3609 cax3 virtualized
3610 adq fb.siz3 see if it extends to next
3611 cmpq frenxt-*
3612 tnc frhbak-* it doesn't
3613 tnz frhdie-* goes past it!
3614 lda frenxt-* to combine get virtual address
3615 tsy a.k002-** setbpt of next block
3616 cax2 since they're in same page both
3617 lda fb.siz3 are addressable
3618 ada fb.siz2 so combine their sizes
3619 sta fb.siz3 this is new size of current block
3620 lda fb.nxt2 which points past old next one
3621 sta fb.nxt3
3622 rem
3623 frhbak ldx2 a.k005-** .crbpe
3624 lda frepte-* restore original pte
3625 sta 02
3626 lda fresiz-* get size so as to update .crnbf
3627 ars bufshf convert to buffers
3628 asa a.k006-** .crnbf
3629 ila 1 mark as free call
3630 tsy a.k004-** extime
3631 return frhbuf
3632 rem
3633 frh060 lda freadr-* this is only free block
3634 sta a.k001-** .crnxe
3635 stz fb.nxt3
3636 tra frhbak-*
3637 rem
3638 frhdie die 4 free blocks overlap
3639 rem
3640 rem
3641 a.k001 ind .crnxe
3642 a.k002 ind setbpt
3643 a.k003 ind timein
3644 a.k004 ind extime
3645 a.k005 ind .crbpe
3646 a.k006 ind .crnbf
3647 rem
3648 l.k001 oct 777400
3649 rem
3650 frenxt bss 1
3651 freprv bss 1
3652 freadr bss 1
3653 fresiz bss 1
3654 frebas bss 1
3655 frepte bss 1
3656 eject
3657 ************************************************************************
3658 *
3659 * subroutine to find free space of a desired size
3660 * it is unthreaded from the beginning of the smallest block
3661 * large enough to hold it.
3662 *
3663 * calling sequence:
3664 *
3665 * x1 -> buffer pool header
3666 * q = size of space needed in words
3667 *
3668 * returns:
3669 *
3670 * procedure takes skip return if it succeeds
3671 * non-skip return if it fails.
3672 *
3673 * x3 -> space allocated
3674 *
3675 ************************************************************************
3676 rem
3677 getspc subr gspax2
3678 stz prvblk-* initialize some stuff
3679 stz bstblk-* will be addr of smallest block
3680 ldx3 bstblk-* to zero the reg
3681 lda a.z001-** =.crmem bigger that biggest free block
3682 ldx2 fp.fst1 pick up pointer to first free block
3683 gsp040 tze gsp010-* end of chain
3684 cmpq fb.siz2 is this block big enough?
3685 tze gsp020-* exactly right dont look anymore
3686 tpl gsp030-* too small skip to next
3687 cmpa fb.siz2 is this a better smaller block to use?
3688 tze gsp030-* same dont use it
3689 tmi gsp030-* already have smaller block
3690 stx2 bstblk-* save pointer to best block
3691 ldx3 prvblk-* rembember best blocks predessor
3692 lda fb.siz2 remember best blocks size
3693 gsp030 stx2 prvblk-*
3694 ldx2 fb.nxt2 step to next block
3695 tra gsp040-*
3696 gsp010 ldx2 bstblk-* get pointer to best block
3697 tze gspret-* no block big enough take error return
3698 stx3 prvblk-* unthread subr needs this pointer
3699 gsp020 aos getspc-* call will succeed setup skip return
3700 cx2a
3701 cax3 x2-x3 to unthread from beginning of block
3702 tsy unthrd-* unthread selected space
3703 gspret return getspc
3704 rem
3705 bstblk bss 1
3706 a.z001 ind .crmem
3707 a.z002 ind .crnxa
3708 a.z003 ind .crnbf
3709 a.z004 ind .crnxs
3710 a.z005 ind .crnbs
3711 a.z006 ind fresml
3712 a.z007 ind timein
3713 a.z008 ind .crbuf
3714 a.z009 ind extime
3715 rem
3716 l.z001 dec 1 for metering
3717 eject
3718 ************************************************************************
3719 *
3720 * subroutine to unthread space from a free chain
3721 *
3722 * calling sequence:
3723 *
3724 * x1 -> buffer poll header
3725 * x2 -> starting address to unthread
3726 * x3 -> free block space is coming from
3727 * q = size of block to unthread
3728 * prvblk contains address of free block which proceeds
3729 * the block pointed to by x2
3730 *
3731 ************************************************************************
3732 rem
3733 unthrd subr untaqx2x3
3734 lda fb.siz3 size of entire block
3735 sba untsq-* amount of space that will be left
3736 sta unttmp-* this number will be useful later
3737 tze untall-* if zero unthreading entire free block
3738 cx2a addr of space to unthread
3739 sba untsx3-* amount of space before block unthreaded
3740 tze untbeg-* if 0 unthreding from beginning
3741 cmpa unttmp-* equal to size remaining?
3742 tze untend-* yes unthreading from end of block
3743 rem
3744 * unthreading from the middle of a free block
3745 rem
3746 untmid sta fb.siz3 size of first partial block
3747 adq untsx2-* compute addr of second partial block
3748 lda fb.nxt3 hold forward pointer
3749 stq fb.nxt3 make first block point to second
3750 ldx2 fb.nxt3 addr of second block
3751 ldq unttmp-* total space in both free blocks
3752 sbq fb.siz3 subtract out size of first block
3753 staq fb.nxt2 update pointer and size
3754 tra untret-*
3755 rem
3756 * unthreading from end of a free block
3757 rem
3758 untend lda unttmp-* new size of partial block
3759 sta fb.siz3
3760 tra untret-* thats all to do
3761 rem
3762 * unthread an entire free block
3763 rem
3764 untall lda fb.nxt3 pick up pointer to next block
3765 untjon ldx2 prvblk-* addr of previous whole block
3766 tze unthed-* none unthreading head
3767 sta fb.nxt2 make prev point to next
3768 tra untret-*
3769 unthed sta fp.fst1 new head of chain
3770 tra untret-*
3771 rem
3772 * unthreading from beginning of a free block
3773 rem
3774 untbeg adcx2 untsq-* compute address of new partial block
3775 lda fb.nxt3 it will now point forward
3776 ldq unttmp-* and this will be its size
3777 staq fb.nxt2 update block
3778 cx2a
3779 tra untjon-* go update preceeding block
3780 rem
3781 untret return unthrd
3782 rem
3783 unttmp bss 1
3784 prvblk bss 1
3785 eject
3786 ************************************************************************
3787 *
3788 * subroutine to free space no longer needed. it is returned to
3789 * the free pool and combined with any adjacent blocks
3790 *
3791 * calling sequence:
3792 *
3793 * x1 -> free pool header
3794 * x3 -> block to free
3795 * q = size of block
3796 *
3797 ************************************************************************
3798 rem
3799 relspc subr rspax2
3800 cx3a validate addr >= .crbuf
3801 cmpa a.z008-** =.crbuf
3802 tze 3
3803 tpl 2
3804 die 3
3805 stq fb.siz3 free block will need its size
3806 ldx2 fp.fst1 pick up first block pointer
3807 tnz rsp010-* non-null chain
3808 stx3 fp.fst1 freeing only block in chain
3809 stz fb.nxt3 no forward pointer
3810 tra rspret-*
3811 rsp010 stz prvblk-*
3812 stx3 rsptmp-*
3813 rsp030 cx2a into 'a' for the compare
3814 cmpa rsptmp-* found spot for this block?
3815 tpl rsp020-* yes goes before this block
3816 stx2 prvblk-*
3817 ldx2 fb.nxt2 step foward
3818 tnz rsp030-*
3819 rem
3820 * free a block which goes at end of chain
3821 rem
3822 ldx2 prvblk-*
3823 stx3 fb.nxt2 make old last point at new last
3824 stz fb.nxt3 make new last the end
3825 tra rsp050-*
3826 rem
3827 * freeing a block that is not at end
3828 rem
3829 rsp020 ldx2 prvblk-* pick up proceeding block
3830 tnz rsp040-*
3831 rem
3832 * block goes at head of chain
3833 rem
3834 lda fp.fst1 old head
3835 stx3 fp.fst1 new head
3836 sta fb.nxt3 make new head point at old head
3837 tra rsp060-*
3838 rem
3839 * block goes in middle
3840 rem
3841 rsp040 lda fb.nxt2 forward pointer from prev block
3842 stx3 fb.nxt2 its new pointer is to this block
3843 sta fb.nxt3 forward pointer to next block
3844 rem
3845 * combine new block with preceeding
3846 rem
3847 rsp050 cx2a address of previous block
3848 ada fb.siz2 calculate end of previous block
3849 stx3 rsptmp-* address of current block
3850 cmpa rsptmp-* check for join
3851 tmi rsp060-* don't join
3852 tze rsp070-* they do
3853 die 4 they overlap
3854 rsp070 lda fb.nxt3 block after current
3855 sta fb.nxt2 make previous point at it
3856 lda fb.siz3 size of current
3857 asa fb.siz2 add into size of previous
3858 cx2a
3859 cax3 make x3 point at new combined cuurrent block
3860 rem
3861 * combine current block with following one
3862 rem
3863 rsp060 szn fb.nxt3 last block?
3864 tze rspret-* yes
3865 cx3a address of current
3866 ada fb.siz3 end of current
3867 cmpa fb.nxt3 does it join with next?
3868 tmi rspret-* no
3869 tze rsp080-* yes
3870 die 4 overlap
3871 rsp080 ldx2 fb.nxt3 address of next block
3872 lda fb.siz2 get next block size
3873 asa fb.siz3 add into current block size
3874 lda fb.nxt2 next blocks follower
3875 sta fb.nxt3 thrad after current
3876 rem
3877 rspret ila -1 put bad addr in x3
3878 cax3
3879 return relspc
3880 rsptmp bss 1
3881 eject
3882 ************************************************************************
3883 *
3884 * subroutine to scan the small buffer chain and find any space
3885 * that can be recombined into large buffers. it is called when
3886 * we run out of real buffers as a last resort.
3887 *
3888 * return:
3889 *
3890 * will take a skip return if any buffers were freed
3891 *
3892 ************************************************************************
3893 rem
3894 fresml subr fsmaqx1x2x3
3895 stz fsmcnt-* zero count of buffers found
3896 fsm040 stz prvblk-* initialze to follow threads
3897 ldx3 a.z004-** =addr.crnxs next small block
3898 tze fsm010-* empty chain
3899 fsm050 cx3a start of free block
3900 ada fb.siz3 compute end address
3901 sta fsmtmp-* save
3902 cx3a
3903 iaa bufsiz-1 round up to next buffer address
3904 iana -bufsiz
3905 cmpa fsmtmp-* does next buffer start in free block?
3906 tpl fsm020-* no
3907 cax2 save buffer start address
3908 iaa bufsiz compute end of possible buffer address
3909 cmpa fsmtmp-* is buffer complete in block?
3910 tmi fsm030-* yes
3911 tnz fsm020-* no
3912 fsm030 ilq bufsiz setup to unthread the buffer we found
3913 ldx1 a.z004-* =addr.crnxs
3914 tsy unthrd-* unthread from current chain
3915 ldx1 a.z002-* =addr.crnxa
3916 cx2a
3917 cax3
3918 tsy relspc-* free in to regular buffer chain
3919 aos fsmcnt-* count buffers i found
3920 tra fsm040-* and continue
3921 fsm020 stx3 prvblk-* step to next block
3922 ldx3 fb.nxt3
3923 tnz fsm050-*
3924 fsm010 lda fsmcnt-* count of buffers freed
3925 tze fsmret-* none
3926 aos fresml-* can take skip return
3927 asa a.z003-** update .crnbf
3928 iera -1 complement count
3929 iaa 1
3930 asa a.z005-** update .crnbs
3931 fsmret return fresml
3932 fsmcnt bss 1
3933 fsmtmp bss 1
3934 end