{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CONSROOT867)}}
====== CONSROOT867 ======
(George Source)
**Macros used:** [[george:macro:CHAIN|CHAIN]], [[george:macro:CONCONS|CONCONS]], [[george:macro:CONSOUT|CONSOUT]], [[george:macro:CONSTIME|CONSTIME]], [[george:macro:FMOPACT|FMOPACT]], [[george:macro:FMOPG|FMOPG]], [[george:macro:FPUT|FPUT]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:HUNTACT|HUNTACT]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:HUNTW|HUNTW]], [[george:macro:LONGCLEAR|LONGCLEAR]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:PCTMESA|PCTMESA]], [[george:macro:SCONS|SCONS]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:STEP|STEP]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
22FL #SEG CONSROOT [LEN WAGSTAFF
22KH ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983.
22PD #OPT ASPEAK=#33
22^= #OPT K0CONSROOT=0
23DW #OPT K6CONSROOT=0
23YG #LIS K0CONSROOT>K0ALLGEO
24D6 8HCONSROOT
24XQ #
25CB # THIS SEGMENT DEALS WITH ROUTING OF OUTPUT MESSAGES TO OPERATOR
25X2 # CONSOLES WHICH ARE KNOWN TO THE IDF.
26BL # ENTRY AT K1 IS FROM MONFILE FOR THE INITIAL ROUTING TO THE
26W= # PRIMARY CONSOLE,ENTRY AT K2 IS WHEN THE PRIMARY CONSOCE CANNOT
27*W # BE USED AND THUS THE OUTPUT MUST BE RE-ROUTED.
27TG # THE CODING FOR K1,K2 STARTS WITH '#PAGE' BELOW.
28*6 #
28SQ # AWORK1 : USED AS LINK DUMP IN 'TIME'
29#B # AWORK2 : USED AS LINK DUMP IN'ZPUT','ZFORM' & 'ZFREE'
29S2 # AWORK3 : USED AS ROUTING PARAMETER DUMP.
2=?L # AWORK4 : +VE IF ENTERED FROM MONFILE (ENTRY K1)
2=R= # ----------------------------------------------------------------
2?=W #
2?QG #
2#=6 # ENTRY POINTS
2#PQ #
2*9B SEGENTRY K1CONSROOT,X1CONSROOT
2*P2 SEGENTRY K2CONSROOT,X2CONSROOT
2*SX FSHENTRY K3CONSROOT,X3CONSROOT,X3CONSROOT,X3CONSROOT
2*YS FSHENTRY K4CONSROOT,X4CONSROOT,,X4CONSROOT
2B4P FSHENTRY K5CONSROOT,X5CONSROOT,,X5CONSROOT
2B5N FSHENTRY K7CONSROOT,X7CONSROOT,X7CONSROOT,X7CONSROOT
2B6M #
2B7L # K8CONSROOT & K9CONSROOT ARE DECLARED FOR RESTORE TIME MACROS!!!
2B8L #
2BN= #
2C7W OPMSK #7700,#770000 [MASK FOR OP# : MX,IPB
2CMG SHIFT 6,12 [SHIFT TO GET OP# IN CH.3 : MX,IPB
2D76 STARTPT +ADMULTACT,+IPBADDR [ADDR OF START OF AMOP CHAIN : MX,IPB
2DLQ UCHAR 0.2,0.2 [CHAR IN AMOP WD CONTAINING OP#
2F6B XUNIT BRN YMX
2FL2 BRN YIPB
2G5L STEP +ADMP,+IPBL [WD IN AMOP POINTING TO NEX0 AMOP
2GK= XLID #77,#7777 [MASK FOR LINE NO (MX), IDENT (IPB)
2H4W XFRIG NULL [DO NOT RELATIVISE LINE NO.
2HJG SBX 0 A1+FOURTHWD(3) [RELATIVISE IDENT
2J46 XJUMP BRN ZMX [J AFTER LOCATING ALINES BLOCK (MX)
2JHQ BRN ZIPB [J AFTER LOCATING ADEVS BLOCK (IPB)
2K3B XBLKA
2KH2 #HAL AMXOR+ALINES,0
2L2L #HAL AMXOR+ADEVS,0
2LG= XBLKB
2L^W #HAL A7020+INFORM,0
2MFG #HAL CONSA+I7023,0
2M^6 XBLKC
2NDQ #HAL A7020+CONSOUT,0
2NYB XBLKD
2PD2 #HAL CONBUFF+IREMTW,0
2PXL X256 256
2QC= #
2QWW # SEARCHF & SEARCHB : SEARCH FORWARDS OR BACKWARDS FOR BLOCK
2RBG # (TYPE&SUBTYPE AS GIVEN IN X4) FROM ADDRESS
2RW6 # IN X3 AND STOP WHEN AN ACTIVITY IS FOUND.
2S*Q # IF REQD BLOCK NOT FOUND,EXIT AT 0, OTHERWISE
2STB # EXIT AT 1 WITH X3=POINTER T- THE SOUGHT BLOCK
2T*2 #
2TSL SEARCHF
2W#= LDN 7 FPTR
2WRW BRN ZS1
2X?G SEARCHB
2XR6 LDN 7 BPTR
2Y=Q ZS1 LDX 2 FX2
2YQB STO 7 ACOMMUNE1(2)
2^=2 ZS2 SMO ACOMMUNE1(2)
2^PL LDX 3 0(3) [ADDR OF NEXT BLOCK
329= LDX 7 ATYPE(3)
32NW ANDX 7 HALFTOP
338G TXU 7 4
33N6 BCC ZS3 [J IF REQD BLOCK FOUND
347Q TXL 7 CACT [IS THIS AN ACT BLOCK?
34MB BCS ZS2 [J IF NOT TO CONTINUE SEARCH
3572 EXIT 0 0 [OTHERWISE RETURN VIA FAILURE EXIT
35LL ZS3 EXIT 0 1
366= #
36KW # TIME : IF CURRENT MESSAGE IS TIME/DATE,LOOK AT REMOTE ACTIVITY
375G # AND FREE ANY SIMILAR MESSAGE (EXCEPT 1ST MSGE IN QUEUE
37K6 # WHICH THE ACT MAY BE PROCESSING).
384Q # THIS ROUTINE MAY NOT CO-ORDINATE. ON ENTRY X2 POINTS TO
38JB # THE CURRENT MESSAGE AND X3 TO THE INFORM BLOCK (MX)
3942 # OR THE DCB (IPB). THESE VALUES ARE PRESERVED ON EXIT.
39HL #
3=3= TIME
3=GW LDX 1 FX1
3?2G LDX 0 A1(2)
3?G6 LDX 4 A1+2(2)
3?^Q ANDX 0 OPMSK+1(1)
3#FB BNZ 0 ZT6 [EXIT IF CURRENT MSGE ISN'T TIME/DATE
3#^2 STO 2 5
3*DL LDX 2 FX2
3*Y= STO 3 6
3BCW STO 7 AWORK1(2)
3BXG BPZ 4 ZT2 [J IF 7007
3CC6 ZT1 LDX 3 BPTR(3) [SEARCH
3CWQ LDX 0 ATYPE(3) [BACK TO
3DBB TXL 0 CACT [THE CONSA
3DW2 BCS ZT1 [FOR IPB.
3F*L ZT2 LDX 4 XBLKD(1)
3FT= CALL 0 SEARCHF [SEARCH FOR 1ST CONBUFF/IREMTW
3G#W BRN ZT5 [J IF ABSENT
3GBS LDX 0 A1+2(3)
3GDQ BNG 0 ZT3 [NOT PCT BLOCK
3GGN SMO 5 [ADDR OF CURRENT BLOCK
3GJL ERX 0 A1+2 [COMPARE TERMINAL IDENTIFIERS
3GLJ ANDN 0 #7777
3GNG BNZ 0 ZT2 [THIS BLK NOT FOR THE SAME TERMINAL
3GQD # FIRST CONBUFF FOUND
3GSG ZT3 CALL 0 SEARCHF [FIND NEXT CONBUFF
3H#6 BRN ZT5 [J IF NOT FOUND
3HRQ LDX 0 A1(3)
3J?B ANDX 0 OPMSK+1(1)
3JR2 BNZ 0 ZT3 [J IF NOT TO CONTINUE THE SEARCH
3K=L # WE HAVE FOUND A TIME/DATE MSGE. NWW TEST TO SEE IF IT IS A PCT
3KQ= # BLOCK,AND IF SO CHECK THAT THE BLK FOUND IN THE CHAIN IS FOR THE
3L9W # SAME PCT AS THE CURRENT ONE.(TO ALLOW FOR MULTI-DROP PCT'S ON MX)
3LPG #
3M96 ZT4 LDX 0 A1+2(3)
3MNQ BNG 0 ZT4A [J IF NOT PCT BLOCK
3N8B SMO 5 [ADDR OF CURRENT BLOCK
3NN2 ERX 0 A1+2 [IF THE T/D BLK IN THE CHAIN IS NOT
3P7L ANDN 0 #7777 [FOR THE SAME PCT AS THE CURRENT BLK
3PM= BNZ 0 ZT3 [WE JUMP TO TRY NEXT BLKS IN CHAIN
3Q6W ZT4A LDX 4 BPTR(3) [SAVE ADDR OF PRECEEDING BLOCK.
3QLG FREECORE 3 [FREE THE BLOCK
3R66 LDX 3 4 [PRECEEDING BLOCK BECOMES CURRENT
3RKQ LDX 0 ATYPE(3)
3S5B TXU 0 XBLKC(1) [IS IT A TRANSMISSION BLOCK?
3SK2 BCC ZT4A [FREE IT IF IT IS
3T4L ZT5 LDX 7 AWORK1(2) [JOB DONE,NOW RETURN AFTER RESTORING
3TJ= LDX 2 5 [ENTRY VALUES IN X2,X3.
3W3W LDX 3 6
3WHG ZT6 EXIT 7 0 [RETURN
3X36 #
3XGQ # ZPUT : ENTERED A&TER CONBUFF/IREMTW IS SET UP. THIS SUBR LOCATES
3Y2B # THE RELEVANT AMOP ACTIVITY,CHAINS THE ROUTINE BLOCK IN
3YG2 # AND FPUTS THE AMOP IF IT IS NOT RUNNING.
3Y^L # ON ENTRY X5= UNIQUE WORD DEFINING THE CONSOLE (FROM APERI/CONSOLE)
3^F= # X6= PROG.PROP.NO.(CI) OR GEOG.NO.(MX) OR ZERO(7900)
3^YW #
42DG ZPUT
42Y6 LDX 1 FX1
43CQ SBX 0 1
43XB LDX 2 FX2
44C2 STO 0 AWORK2(2)
44WL MHUNTW 3,CONBUFF,IREMTW [FIND ROUTING BLOCK
45B= LDXC 4 A1+2(3) [SET C IF CONSOLE IS ON 7900 ...
45TW ADN 1 0 [... SO X1=FX1+1 FOR 7900 &ONSOLE
46*G EXIT 1 XUNIT [BR TO YMX FOR PCT, YIPB FOR IPB
46B3 #SKI JSKI04<1$1
46BJ (
46C5 YMX [MX
46CL HUNTMISB 1,IDF,ITERMID [FIND ITERMID
46D7 BPZ 1 YFND [BR IF FOUND
46DN XG
46F9 GEOERR 1,ITERMID
46FQ YFND
46G? LDX 0 A1+1(1)
46GS BZE 0 XG [BR IF END OF BLOCK
46H* TXU 0 5
46HW BCC RFND [BR IF ENTRY FOUND
46JC ADN 1 2
46JY BRN YFND
46KF RFND
46L2 LDX 3 A1+2(1) [LOAD POINTER TO AMOP
46LH BNG 3 XG [BR IF FALSE ENTRY
46M4 LDX 1 FX1
46MK BRN Z99
46N6 YIPB
46NM LDX 7 5
46P8 SRL 7 12 [GEOG NO OF IPB
46PP FMOPG 3,7,IPB [FIND AMOP
46Q= BNG 3 REROUTE
46QR )
46R# #SKI JSKI04
46RT (
46T6 YMX [MX
47#Q ANDN 6 #777 [GEOG.NO.
47SB FMOPG 3,6,MX [FIND AMOP
48#2 BNG 3 REROUTE [NOT FOUND
48RL BRN Z99
49?= YIPB
49QW LDX 7 5
4==G SRL 7 12 [GEOG NO OF IPB
4=Q6 BNZ 7 YNOTCI [J. IF NOT CI
4?9Q ANDX 6 BITS22LS [JUST TO BE SURE
4?PB ORX 6 GSIGN [NEED B0=1 FOR CPPTR
4#92 FMOPACT 3,6,IPB [FIND AMOP
4#NL BRN YBOTH
4*8= YNOTCI
4*MW FMOPG 3,7,IPB [FIND AMOP
4B7G YBOTH
4BM6 BNG 3 REROUTE
4BWY )
4B^H LDXC 0 IPBSW(3)
4C46 BCS REROUTE [J IF IPB INOP. (OR ERROR)
4C6Q Z99
4CLB #
4D62 ZACTFND [REQD AMOP FOUND.NOW FIND ALINES BLOCK(MX) OR ADEVS BLOCK(IPB)
4DKL #
4F5= LDX 4 XBLKA(1)
4FJW CALL 0 SEARCHF [FORWARD SEARCH FROM AMOP
4G4G BRN REROUTE [J IF ABSENT TO REROUTE TO 2NDRY CONS
4GJ6 LDX 0 XLID(1)
4H3Q ANDX 0 5 [GET LINE NO.(MX) OR IDENT (IPB)
4HHB OBEY XFRIG(1) [RELATIVISE IT IF REQD
4J32 ADX 0 0
4JGL ADX 0 0
4K2= ADX 3 0 [X3 POINTS TO RELEVANT RECORD IN BLK
4KFW LDCT 0 #430
4K^G ANDX 0 A1+FOURTHWD(3)
4LF6 BNZ 0 REROUTE [BR IF UNAVAIL, ONLINE, UNREADY
4LYQ LDX 3 A1+BPTR(3) [POINTER TO LCB/DCB RING ELT
4MDB BZE 3 REROUTE [J IF NO LCB/DCB TO TRY 2NDRY CONSOLE
4MY2 SBN 3 A1+FPTR [X3 POINTS TO START OF LCB/DCB
4NCL EXIT 1 XJUMP [GO TO ZMX (MX) OR ZIPB (IPB)
4NX= #
4PBW #
4PWG ZMX
4QB6 LDX 4 XBLKB(1)
4QTQ CALL 0 SEARCHB [SEARCH BACK FROM LCB TO INFORM BLK
4R*B BRN REROUTE [IF ABSENT,TRY 2NDRY CONSOLE
4RT2 MHUNTW 2,CONBUFF,IREMTW
4S#L SEGENTRY K8CONSROOT [FOR ALLTIME MACRO
4SS= CALL 7 TIME [IF THIS IS TIME MSGE,DELETE ANY EXISTING ONE.
4T?W LDN 5 0
4TRG LDX 4 APCTNUM(3) [NO. OF PCT'S ON THIS LINE
4W?6 LDX 6 A1+2(2) [TERMINAL ADDR CODE
4WQQ SLL 6 12 [IN TOP 12 BITS
4X=B SRCH SMO 5
4XQ2 LDX 0 IDUNIQUE(3) [UNIQUE WD FOR THIS PCT RECORD
4Y9L ANDX 0 HALFTOP [TER ADDR CODE IN TOP 12 BITS.
4YP= TXU 0 6
4^8W BCC PCTFND [J IF THIS IS REQD ONE
4^NG ADN 5 APCTRLEN [STEP TO NEXT RECORD
5286 BCT 4 SRCH [J IF NOT END OF RECORDS.
52MQ BRN REROUTE [J IF REQD PCT NOT FOUND
537B PCTFND
53M2 ADX 3 5 [X3 POINTS TO PCT RECORD
546L LDCT 0 #500
54L= ANDX 0 APCTSTAT(3)
555W BNZ 0 REROUTE [J IF TERM INOP OR MOPPED OFF
55KG LDCH 0 APCTX(3)
5656 ORS 0 APCTD(3) [FLIP FOR CONSOLE O/P
56JQ LDX 7 IDUNIQUE(3)
574B SBX 3 5 [POINT TO TOP OF INFORM BLOCK
57J2 HUNT2J 3,A7020,ALCB,,REROUTE [FIND LCB=END OF MSGE QUEUE
583L LDX 3 BPTR(3) [LAST MSGE IN QUEUE
58H= ZMX1 LDX 4 FPTR(2)
592W CHAIN 2,3 [CHAIN CONBUFF BLOCK TO REMOTE
59GG LDX 2 4 [ACTIVITY AND THEN
5=26 LDX 4 ATYPE(2) [CHAIN IN ANY TRANSMISSION
5=FQ TXU 4 XBLKC(1) [BLOCKS (A7020/CONSOUT) BEFORE IT
5=^B BCS ZMX2
5?F2 STO 7 CIDENTM(2) [SET PCT UNIQUE WD IN TRANS BLOCK
5?YL BRN ZMX1
5#D= ZMX2
5#XW HUNTACT AMOP,2,3 [HUNT BACK IN X2 FOR THE REMOTE ACT
5*CG LONGCLEAR 2,#62,ZP10 [WAKE ACT IF IN STYLE #62,THEN EXIT..
5*X6 [... OTHERWISE JUST EXIT.
5BBQ ZP10 [COMMON EXIT POINT
5BWB LDX 2 FX2
5CB2 LDX 1 FX1
5CTL LDX 0 AWORK2(2)
5D*= ADX 0 1
5DSW EXIT 0 0
5F#G #
5FS6 #
5G?Q ZIPB1 GEOERR 1,NO CONSA
5GRB #
5H?2 #
5HQL ZIPB
5J== MHUNTW 2,CONBUFF,IREMTW
5JPW SEGENTRY K9CONSROOT [FOR ALLTIME MACRO
5K9G CALL 7 TIME [IF THIS IS TIME MSGE,DELETE ANY EXISTING ONE
5KP6 LDX 7 IWAIT(3)
5L8Q STOC 7 IWAIT(3) [CLEAR B0 TO SHOW CONSA (SOON) ACTIVE
5LNB LDN 7 0 [ [X7=0 IF CONSA ALREADY ACTIVE, ELSE=1
5M82 CHAIN 2,BPTR(3) [CHAIN ROUTING BLOCK INFRONT OF DCB
5MML BZE 7 ZP10 [J FOR EXIT IF CONSA ACTIVE...
5N7= LDX 4 XBLKB+1(1)
5NLW CALL 0 SEARCHB [...ELSE SEARCH BACK FOR IT...
5P6G BRN ZIPB1
5PL6 LDX 2 3
5Q5Q FPUT [...PUT CONSA ON LIST...
5QKB BRN ZP10 [...AND EXIT
5R52 #
5RJL # ZFORM : FORM A CONBUFF/IREMTW BLOCK FROM GMON/AOUT, AND IF
5S4= # ROUTING TO MX SET UP TRANSMISSION BLOCKS (A7020/CONSOUT).
5SHW # ON ENTRY X4=-VE -> 7900, X5=UNIQUE WD FROM APERI/CONSOLE.
5T3G #
5TH6 ZFORM
5W2Q SBX 0 FX1
5WGB SMO FX2
5X22 STO 0 AWORK2
5XFL MHUNTW 2,GMON,AOUT [FIND MESSAGE BLOCK
5X^= LDXC 7 A1(2) [NO OF WDS IN MSGE+2
5YDW BCS ZUP [IGNORE THIS MSGE IF 'CANT DO' IS SET
5YYG ADN 7 ICBUFF-A1-2 [X7=LENGTH OF MSGE + CONTROL INFORMATION
5^D6 SETUPCORE 7,3,CONBUFF,IREMTW [SET UP ROUTING BLOCK
5^XQ MHUNTW 2,GMON,AOUT
62CB SBN 7 ICBUFF-A1 [X7=MESSAGE WDCT
62X2 STO 7 A1(3)
63BL DCH 6 A1(3) [ROUTING PARAM IN CH.0
63W= LDX 0 5
64*W STO 4 A1+2(3) [SET OR CLEAR B0
64TG BNG 4 ZF1 [J IF 7900: X0=IDENT IN L.S. 12 BITS
65*6 SRL 0 12 [TERMINAL ADDR CODE IN L.S. 12 BITS
65SQ ZF1 DSA 0 A1+2(3)
66#B SCONS 5,4 [GET 2NDRY CONSOLE WD IN X4
66S2 STO 4 A1+1(3)
67?L LDX 1 FX2
67R= LDCH 0 ATYPE(1)
68=W SBN 0 ACTCDT/64
68QG BCHX 3 £
69=6 DCH 0 A1(3) [CH.1 = 0 IF THIS IS TIME/DATE MSGE.
69PQ LDX 0 A1+2(3)
6=9B LDN 3 ICBUFF(3) [POINT TO MSGE AREA IN ROUTING BLOCK
6=P2 BZE 7 ZF [FOR NULL MESSAGE
6?8L ADN 2 A1+2 [POINT TO MSGE AREA IN MESSA7E BLOCK
6?N= SMO 7
6#7W MOVE 2 0 [MOVE TEXT TO NEW BLOCK
6#MG ZF LDX 2 FX2
6*76 BNG 0 ZF2 [J IF 7900 TO AVOID TRANSLATION
6*LQ PCTMESA [CONSTRUCT TRANSMISSION BLOCKS
6B6B ZF2 LDX 0 AWORK2(2)
6BL2 ADX 0 FX1
6C5L EXIT 0 0
6CK= #
6D4W #
6DJG ZHUNTCON [SUBR TO FIND APERI/CONSOLE BLOCK
6F46 HUNTMISB 3,APERI,CONSOLE
6FHQ EXIT 4 0
6G3B #
6GH2 # ZFREE : ON ENTRY X3 POINTS TO ROUTING BLOCK. TEST IS MADE
6H2L # ON B0 OF A1+2,AND IF CLEAR (IE 7007) WE FIND AND FREE
6HG= # ANY TRANSMISSION BLOCKS CHAINED TO ROUTING BLOCK PROVIDED
6H^W # AWORK4 IS +VE,INDICATING THAT GOING UP WILL RE-ENTER THE
6JFG # MONFILE SEGMENT.
6J^6 # NEXT, IF ENTRY WAS AT ZFREA WE FREE THE ROUTING BLOCK
6KDQ # OTHERWISE ENTRY WAS AT ZFREB,SO JUST EXIT.
6KYB #
6LD2 ZFREA TXU 7 3
6LXL ZFREB LDN 4 0 [X4=1 IF ROUTEING BLOCK TO BE FREED
6MC= LDX 0 AWORK4(2)
6MWW BPZ 0 ZFR1 [J IF TRANSMISSION BLKS MAY BE FREED
6NBG ZFR BZE 4 ZFE [J IF BLOCK TO BE KEPT
6NW6 FREECORE 3 [FREE ROUTING BLOCK
6P*Q ZFE
6PTB EXIT 7 0
6Q*2 ZFR1
6QSL LDX 0 A1+2(3)
6R#= BNG 0 ZFR [IF 7900, THERE ARE NO TRANS BLOCKS
6RRW ZFR2
6S?G LDX 0 XBLKC(1) [ A7020,CONSOUT
6SR6 LDX 3 FPTR(3)
6T=Q TXU 0 ATYPE(3)
6TQB BCS ZFR3 [J IF END OF TRANS BLOCKS FOUND
6W=2 FREECORE 3 [FREE A TRANS BLOCK
6WPL MHUNTW 3,CONBUFF,IREMTW
6X9= BRN ZFR2 [J TO SEE IF THERE ARE ANY MORE
6XNW ZFR3 LDX 3 BPTR(3) [RESET X3=POINTER TO ROUTINE BLOCK
6Y8G BRN ZFR [J FOR TEST ON RELEASE OF R-BLOCK
6YN6 #PAGE [NOW FOR THE ENTRY POINTS.
6^7Q #
6^MB #
6^SJ X1CONSROOT
72F# # ENTERED FROM SEGMENT MONFILE VIA 'CONSOLE' MAC
72LL # IN RESPONSE TO DEMAND(X),INFORM(X),MONOUT(X).
736= # ON ENTRY X6=ROUTING PARAM, X7= CONSOLE PROP NO.
73KW #
745G STOZ AWORK4(2) [MARK ENTRY VIA MONFILE
74K6 LDX 6 ACOMMUNE1(2) [ROUTING PARAMETER
754Q STO 6 AWORK3(2) [SAVE ROUTING PARAM
75JB CALL 4 ZHUNTCON [FIND APERI/CONSOLE BLOCK
7642 BPZ 3 Z1 [J IF BLOCK EXISTS
76HL ZUP1 [CENTRAL OUTPUT REQUIRED
773= LDX 2 FX2
77GW LDCH 0 ATYPE(2) [TIME MESSAGES COME FROM ACTCDT
782G SBN 0 ACTCDT/64 [ACTIVITY
78G6 BNZ 0 YUP1 [BR IF NOT TIME, ELSE CLEAR ANY OLD
78^Q CONSTIME [MESSAGE FROM CONSOLE OUTPUT CHAIN
79FB ZUP
79^2 UP
7=DL YUP1
7=Y= UPPLUS 1
7?BL #
7?CW Z1 LDX 4 6 [ROUTING PARAM
7?XG SBN 4 3
7#C6 BNZ 4 Z2 [J IF PARTICULAR CONSOLE REQD.
7#WQ #
7*BB # ROUTING PARAM=3-> O/P TO ALL OPERATOR CONSOLES
7*BN #SKI JSKI04<1$1
7*C2 (
7*C# LDN 7 0 [X7 MEANINGLESS ON ENTRY IN THIS CASE
7*CL Z1A STO 7 AWORK4(2) [SO IT CAN BE FREELY USED HERE.
7*CY ADX 3 7 [POINT TO NEXT RECORD IN CONSOLE BLK
7*D= LDX 4 A1+1(3) [PROPERTY NO
7*DJ ADXC 4 4 [TEST B1: IF SET,THERE IS ANOTHER
7*DW BCS Z1B [CELL WITH THIS CONSOLE IN HUIDGE
7*F8 [SO J TO IGNORE THIS ONE
7*FG LDX 4 A1+1(3) [RELOAD PROPERTY WORD
7*FS BZE 4 ZUP1 [J IF END OF RECORDS
7*G6 LDX 5 A1+2(3) [CONSOLE UNIQUE WORD
7*GD CALL 0 ZFORM [FORM ROUTING BLOCK FOR THIS CONSOLE
7*GQ CALL 0 ZPUT [CHAIN IT TO RELEVANT ACTIVITY
7*H4 CALL 4 ZHUNTCON [RELOCATE CONSOLE BLOCK
7*HB BNG 3 ZUP1 [RETURN IF BLOCK HAS BEEN FREED
7*HN LDX 6 AWORK3(2) [RESTORE ROUTING PARAMETER
7*J2 LDX 7 AWORK4(2) [RESTORE RECOTD POINTER
7*J# BDX 7 Z1A [UPDATE RECORD POINTER
7*JL Z1B SBX 3 7 [X3=START OF BLK ADDR AGAIN
7*JY BDX 7 Z1A [UPDATE RECORD POINTER
7*K= #
7*KJ # NORMAL PATH : OUTPUT TO CLUSTER CONSOLE.
7*KW #
7*L8 Z2
7*LG LDX 7 JSOURCE3(2)
7*LS ANDX 7 BITS22LS
7*L^ NGS 3 AWORK4(2) [ - => APERI/CONSOLE
7*M6 Z2A LDX 4 A1+1(3) [PROPERTY NO
7*MD BZE 4 ZUP1 [J IF REQD PROP NOT FOUND
7*MQ ANDX 4 BITS22LS
7*N4 TXU 4 7
7*NB BCC ZCONFND [J IF REQD CONSOLE RECORD FOUND
7*NN BDX 3 Z2A [TRY NEXT ENTRY
7*P2 #
7*P# ZCONFND
7*PF ADS 3 AWORK4(2) [ X3 REL. PTR. DOWN /CONSOLE
7*PL LDX 4 A1+1(3) [CONSOLE PROP WD: B0=1 -> 7900
7*PY LDX 5 A1+2(3) [CONSOLE UNIQUE WORD
7*Q= ZC1 CALL 0 ZFORM [FORM ROUTING BLK FOR THIS CONSOLE
7*QJ CALL 0 ZPUT [OTHERWISE CHAIN BLK FOR PRIMARY CONS
7*QW LDX 0 AWORK3(2)
7*R8 BNZ 0 ZUP1 [BR FO- CENTRAL OUTPUT
7*RG BRN ZUP [AND RETURN VIA SUCCESS PATH.
7*RS )
7*S6 #SKI JSKI04
7*SD (
7*W2 LDN 7 0 [X7 MEANINGLESS ON ENTRY IN THIS CASE
7B*L Z1A STO 7 AWORK4(2) [SO IT CAN BE FREELY USED HERE.
7BT= ADX 3 7 [POINT TO NEXT RECORD IN CONSOLE BLK
7C#W LDX 4 A1+1(3) [PROPERTY NO
7CSG ADXC 4 4 [TEST B1: IF SET,THERE IS ANOTHER
7D#6 BCS Z1B [CELL WITH THIS CONSOLE IN HUIDGE
7DRQ [SO J TO IGNORE THIS ONE
7F?B LDX 4 A1+1(3) [RELOAD PROPERTY WORD
7FR2 BZE 4 ZUP1 [J IF END OF RECORDS
7G=L LDX 6 A1+3(3) [MAY NEED THIS IN ZPUT
7GQ= STO 6 AWORK1(2) [BUT ZFORM USES X6
7H9W LDX 5 A1+2(3) [CONSOLE UNIQUE WORD
7HPG CALL 0 ZFORM [FORM ROUTING BLOCK FOR THIS CONSOLE
7J96 LDX 6 AWORK1(2) [RESTORE X6
7JNQ CALL 0 ZPUT [CHAIN IT TO RELEVANT ACTIVITY
7K8B CALL 4 ZHUNTCON [RELOCATE CONSOLE BLOCK
7KN2 BNG 3 ZUP1 [RETURN IF BLOCK HAS BEEN FREED
7L7L LDX 6 AWORK3(2) [RESTORE ROUTING PARAMETER
7LM= LDX 7 AWORK4(2) [RESTORE RECOTD POINTER
7M6W ADN 7 HUIDGENTLEN [UPDATE RECORD PTR
7MLG BRN Z1A
7N66 Z1B SBX 3 7 [X3=START OF BLK ADDR AGAIN
7NKQ ADN 7 HUIDGENTLEN [UPDATE RECORD PTR
7P5B BRN Z1A
7PK2 #
7Q4L # NORMAL PATH : OUTPUT TO CLUSTER CONSOLE.
7QJ= #
7R3W Z2
7RHG LDX 7 JSOURCE3(2)
7S36 ANDX 7 BITS22LS
7SGQ Z2A LDX 4 A1+1(3) [PROPERTY NO
7T2B BZE 4 ZUP1 [J IF REQD PROP NOT FOUND
7TG2 ANDX 4 BITS22LS
7T^L TXU 4 7
7WF= BCC ZCONFND [J IF REQD CONSOLE RECORD FOUND
7WYW ADN 3 HUIDGENTLEN [TRY NEXT ENTRY
7XDG BRN Z2A
7XY6 #
7YCQ ZCONFND
7YXB LDX 4 A1+1(3) [CONSOLE PROP WD: B0=1 -> 7900
7^C2 LDX 5 A1+2(3) [CONSOLE UNIQUE WORD
7^WL LDX 6 A1+3(3) [MAY NEED THIS IN ZPUT
82B= STO 6 AWORK1(2) [ZFORM USES X6
82TW ZC1 CALL 0 ZFORM [FORM ROUTING BLK FOR THIS CONSOLE
83*G LDX 6 AWORK1(2)
83T6 CALL 0 ZPUT [OTHERWISE CHAIN BLK FOR PRIMARY CONS
84#Q LDX 0 AWORK3(2)
84SB BNZ 0 ZUP1 [BR FO- CENTRAL OUTPUT
85#2 BRN ZUP [AND RETURN VIA SUCCESS PATH.
85HS )
85RL #
86?= #
86QW REROUTE [FIND 2NDRY CONSOLE AND TRY OUTPUT = K2 ENTRY EQUIVALENT
87=G [FOR CASE OF PRIMARY FAILURE FOUND WHILST IN CONSROOT.
87Q6 #
889Q LDX 1 FX1
88PB LDX 2 FX2
8992 BRN ZR1
89NL #
8=8= X2CONSROOT
8=MW #
8?7G STOZ AWORK2(2)
8?M6 NGS 1 AWORK4(2) [MARK -VE = ENTRY NOT FROM MONFILE.
8?TB ZR1
8#D6 HUNTW 3,CONBUFF,IREMTW [LOCATE ROUTING BLOCK
8#LB BNG 3 ZUP [J IF ABSENT - NOTHING TO DO
8*62 LDCH 4 A1(3) [ROUTING PARAM
8*KL SBN 4 3
8B5= BNG 4 ZR2 [J UNLESS O/P ALREADY GONE
8BJW ZR1A CALL 7 ZFREA [FREE ROUTING BLOCK ETC
8C4G LDX 0 AWORK2(2) [ZERO OR LINK IF FROM MONFILE
8CJ6 BZE 0 ZUP [NO CENTRAL FUTPUT, ALREADY GONE
8D3Q ADX 0 FX1
8DHB BRN (0) [EXIT TO CARRY ON DOWN HUIDGE
8DHD ZR2
8DMJ HUNTW 1,AMXOR,ASPEAK
8DPL BNG 1 NSKNO [J IF NO SPEAK BLOCK
8DSQ LDEX 0 A1(1)
8DXW BZE 0 NSKNO [J IF INOP CHECK NOT REQD
8F32 LDX 0 GSIGN
8F66 STO 0 A1(1)
8F9= [ TELL SPEAK ITS INOP
8F#B NSKNO LDX 1 FX1
8FCG LDX 5 A1+1(3) [2NDRY CONSOLE WORD
8FGL BNZ 5 ZR3 [J IF 2NDRY CONS IS AN IDF DEVICE
8G2= ADN 4 2
8GFW BPZ 4 ZR1A [RP SHOWS O/P ALREADY SENT CENTRALLY
8G^G CALL 7 ZFREB [FREE ANY TRANSMISSION BLOCKS
8HF6 CHAIN 3,2 [MOVE IT NEXT TO ACTIVITY
8HYQ CONSOUT 3 [OUTPUT TO CENTRAL CONSOLE
8JDB BRN ZUP [RETURN
8JY2 #
8KCL # SECONDARY CONSOLE IS AN IDF DEVICE.
8KX= #
8LBW ZR3 CONCONS 3,5 [MARK NEW SECONDARY CONSOLE AND
8LWG [GET X5 = UNIQUE WD OF 2NDRY CONSOLE
8MB6 CALL 0 ZPUT [CHAIN MESSAGE TO RELEVANT ACTIVITY
8MTQ BRN ZUP
8N*B #
8NT2 #
8P#L #PAGE
8PS= MENDAREA 40,K99CONSROOT
8Q?W #END
^^^^ ...47407242000100000000