(George Source)
Macros used: ACROSS, BXE, BXL, BXU, CCBB, CLEAR, DCA, DECLINK, DESUSPEND, DSCA, FADDRESS, FINDACTFB, FINMOVE, FSHCODE, FSHSKIP, GEOERR, GPERIIPC, HUNT2, HUNTW, JDISENG, JRESET, MENDAREA, MFREE, OPEN, SEG, SEGENTRY, SIPCM, SREP, TICKLE, TIPCREP, TRACE, TRACEIF
22FL ... SEG IPCON,,KEITH MARTIN 22^= # THIS SEGMENT HANDLES TYPE 28 IPBS IN ORDER TO IMPLEMENT 23DW # THE INTER-PROGRAM COMMUNICATION FACILITY. 23YG # 24D6 SEGENTRY K1IPCON,X1IPCON 24XQ SEGENTRY K3IPCON,X3IPCON 25CB # STORED WORDS 25X2 RESBITS #777700 26BL TMESSCODES #04000040 26W= #04000041 27*W #04000042 27TG #04000043 28*6 #04000046 28SQ #03000047 29#B #07000060 29S2 #07000061 2=?L #04000066 2=R= #03000067 2?=W #02000070 2?QG #02000071 2#=6 #03000077 2#PQ TBIT1 #20000000 2*9B TBIT2 #10000000 2*P2 TBIT3 #4000000 2B8L TBIT4 #2000000 2BN= TBIT5 #1000000 2C7W TBIT7 #00200000 2CMG TBIT11 #10000 2D76 TTLIM +8 [MAX TASK NO + 1 2DLQ TIPBACT +IPCA+IPCBX [TYPE OF IPB ACTIVITY 2F6B RNF #02200000 2FL2 ROK #0 2G5L RTO #22000000 2GK= RNI #02000000 2H4W RNINE #02400000 2HJG OBJW #40000*IPCG4+#11 2J46 OBJR #40000*IPCG4+#12 2JHQ # SUBROUTINE USED TO SET OBJECT PROGRAM REPLIES 2K3B # 2KH2 SREP 2L2L CALL 7 SREL 2LG= STO 4 ACC4(2) 2L^W STO 5 ACC5(2) 2MFG LDX 5 AREPPTR(3) [ADDRESS OF REPLY WORD 2M^6 #SKI G3 2NDQ ( 2NYB SMO FPTR(3) 2PD2 LDX 3 APETADDR-ARINGEL 2PXL ) 2QC= #SKI G4 2QWW ( 2RBG LDX 3 FPTR(3) 2RW6 SBN 3 ARINGEL 2S*Q ) 2STB LDN 4 ACOMMUNE2(2) 2T*2 LDN 7 1 2TSL #SKI IPCG4 2W#= HUNT2 2,ADATA,HLOCKDOWN,3 2WRW FINMOVE 3,5,4,7,HLOCKB1,2,1 2X?G LDX 2 FX2 2XR6 LDX 4 ACC4(2) 2Y=Q LDX 5 ACC5(2) 2YQB CALL 7 SREL 2^=2 NGNC 0 8 2^PL ANDS 0 ASTATUS1(3) [CALL TR STORED & IN PROGRESS BITS 329= STOZ ATIMCT(3) 32NW STOZ ASTR(3) 338G STOZ ALENTR(3) 33N6 STOZ AREPPTR(3) 347Q LDX 0 ASTMEL(3) 34MB STO 0 AWORK4(2) 3572 STOZ ASTMEL(3) 35LL NGN 0 2 366= ANDS 0 ASTATUS2(3) 36KW LDX 3 FPTR(3) 375G SBN 3 ARINGEL 37K6 #SKI IPCG4 384Q ( 38JB HUNT2 2,ADATA,HLOCKDOWN,3 3942 CLEAR APETADDR(3),0,HLOCKB1,2,2 39HL LDX 2 FX2 3=3= ) 3=GW CCBB 3 3=P6 ... STO 5 ACC5(2) 3=XB ... LDX 5 AWORK4(2) 3?5L ... TICKLE JOBNO(3),5 3??W ... LDX 5 ACC5(2) 3?G6 MFREE IPCD,ATASK 3?^Q EXIT 6 0 3#FB # SUBROUTINE TO LOCATE LINKS RING ELEMENT 3#^2 # GIVEN THE LINK IDENTIFIER IN ACOMMUNE1(2) [X2 MUST = FX2] 3*DL # ADDRESS IS LEFT IN X3. LINK IS X7. ON EXIT X1=FX1 3*Y= # 3BCW SREL 3BXG LDX 3 IPCPTR(2) [FIND IPC ACTIVITY 3CC6 HUNT2 3,IPCD,IPSTACK [FIND STACK BLOCK 3CWQ LDX 1 ARINGNO(3) 3DBB ANDN 1 #7777 3DW2 BZE 1 SFR1 [STACK EMPTY 3F*L ADN 3 A1 3FT= SFR3 LDX 0 ALINUM(3) 3G#W BXE 0 ACOMMUNE1(2),SFR2 3GSG ADN 3 ARECLEN 3H#6 BCT 1 SFR3 3HRQ SFR1 NGN 3 #7777 3J?B SFR2 LDX 1 FX1 3JR2 EXIT 7 0 3K=L # S/R TO LOCATE ACTIVITY OWNING A GEORGE LINK 3KQ= SLACT LDX 2 FPTR(3) [CONTROL BLOCK 3L9W SBN 2 A1 3LPG SLACT1 3M96 LDX 2 BPTR(2) 3MNQ LDX 0 ATYPE(2) 3N8B BXL 0 CACT,SLACT1 3NN2 EXIT 7 0 3P7L # S/R TO SET REPLY ETC ON GEORGE LINK 3PM= SGCLR LDX 2 FPTR(3) 3Q6W STO 6 IPCGREP-A1(2) [STORE REPLY 3QLG LDX 0 GSIGN 3R66 ERS 0 ASTATUS1(3) [UNSET T.I.P. 3RKQ STOZ ATIMCT(3) 3S5B STOZ ASTR(3) 3SK2 STOZ ALENTR(3) 3TJ= STOZ ASTMEL(3) 3W3W LDX 1 7 3WHG CALL 7 SLACT 3X36 LDX 7 1 3XGQ DESUSPEND [DESUSPEND ACTIVITY 3Y2B MFREE IPCD,ATASK [FREE TASK BLOCK 3YG2 EXIT 7 0 3Y^L # THIS PART OF THE SEGMENT IS THE POINT TO WHICH CONTROL 3^F= # IS RETURNED WHEN A MESSAGE SEQUENCE OR OTHER ACTION IS 3^YW # COMPLETED. 42DG PCNXT 42Y6 MFREE IPCD,ATASK 43CQ X1IPCON 43XB NEXTASK 443? ... FSHCODE AORB 4478 ... TRACEIF K6IPCON,199,299,IPREB(2),IPCON1 44?5 ... FSHSKIP 44C2 TRACE IPREB(2),IPCON1 44WL JDISENG ,NOP [J IF INOPERABLE 45B= JRESET ,RESETA [J IF RESET 45TW # ANY TASKS ? 46*G HUNTW 3,IPCD,ATASK [LOOK FOR TASK BLOCK 46T6 BPZ 3 TASK [IF FOUND,GO TO PROCESS TASK 47#Q ACROSS IPCONA,1 [IF NONE,GO QUIESCENT 47SB # SWITCH ON TASK TYPE 48#2 TASK LDX 0 A1+1(3) 48RL BZE 0 TA1 49?= TXL 0 TTLIM(1) 49QW BCS TA2 4==G TA1 GEOERR 1,IPCON1 4=Q6 TA2 SMO 0 4?9Q BRN TA2+1 4?PB BRN OPEN 4#92 BRN TRAN 4#NL BRN TCLOS 4*8= BRN TRAN 4*MW BRN OPGEO 4B7G BRN TFRG 4BM6 BRN TCLOS 4C6Q # THIS SECTION DEALS WITH OPEN REQUEST TASKS 4CLB OPEN ACROSS IPCONB,1 4D62 # THIS SECTION DEALS WITH TRANSFER TASKS 4DKL # 4F5= TRAN 4FJW LDX 0 A1(3) 4G4G STO 0 ACOMMUNE1(2) 4GJ6 TRACE 0,IPCON3 4H3Q LDX 0 A1+1(3) 4HHB STO 0 ACOMMUNE2(2) 4J32 CALL 7 SREL 4JGL ... BNG 3 PCNXT 4K2= ... LDX 0 ASTATUS1(3) 4KFW ... ANDN 0 1 4K^G ... BZE 0 PCNXT 4LF6 LDX 0 GSIGN 4LYQ ORS 0 ASTATUS1(3) [SET TRANSFER IN PROGRESS 4MDB # SET UP TRANSFER REQUEST MESSAGE 4MY2 LDX 2 FPTR(3) [ADDRESS OF AOLPT 4NCL LDX 0 ALINDIR-ARINGEL(2) [OPENING MODE 4NX= SRL 0 8 [0=READ,1=WRITE 4PBW SMO FX2 4PWG LDX 5 ACOMMUNE2 4QB6 SBN 5 2 [0=UNCONDITIONAL,2=CONDITIONAL 4QTQ ADX 1 0 4R*B ADX 1 5 4RT2 LDX 0 TMESSCODES(1) [HEADER 4S#L LDX 1 FX1 4SS= LDX 2 FX2 4T?W STO 0 IPWRB(2) [STORE HEADER 4TRG LDX 0 ACOMMUNE1(2) 4W?6 STO 0 IPWRB+1(2) [STORE LINK IDENTIFIER 4WQQ LDX 0 ALENTR(3) 4X=B STO 0 IPWRB+2(2) [STORE LENGTH OF TRANSFER 4XQ2 LDN 7 IPWRB(2) 4Y9L SUM 6 3 4YP= NGS 6 IPWRB+3(2) [STORE CHECKSUM 4^8W # SEND MESSAGE :- 4^NG # SET UP CONTROL AREA 5286 LDN 0 #31 52MQ DCA ,DLA,0,MODE 537B LDN 0 4 53M2 DCA ,DLA,0,COUNT 546L LDN 0 IPWRB(2) 54L= DCA ,STO,0,CTSA 555W LDN 0 #32 55KG DSCA ,DLA,0,MODE 5656 LDN 4 11 56JQ DSCA ,DLA,4,COUNT 574B LDN 0 IPREB(2) 57J2 DSCA ,STO,0,CTSA 583L # ISSUE PERI 58H= GPERIIPC ,2, 592W ... TIPCREP ,TE1,TE2,TE3,NPUT,WHOOPS,RESETA,NOP 59GG # CHECKSUM REPLY 5=26 LDX 5 CPRW2(2) 5=FQ ANDN 5 #777 5=^B SBX 4 5 5?F2 LDN 7 IPREB(2) 5?YL SMO 4 5#D= SUM 6 0 [CALCULATE CHECKSUM 5#XW BNZ 6 TE4 [WRONG 5*CG # FURTHER VALIDATION OF REPLY 5*X6 LDCH 0 IPREB(2) 5BBQ BXU 0 4,TE4 [COUNT WRONG 5BWB LDX 0 IPREB+1(2) 5CB2 SRC 0 12 5CTL ERX 0 IPWRB+1(2) 5D*= ANDN 0 #7777 5DSW BNZ 0 TE4 [NOT FOR SAME LINK 5F#G LDX 0 IPREB(2) 5FS6 ANDN 0 #77 5G?Q SBN 0 #46 5GRB BZE 0 OBJPERI [DO ACTUAL TRANSFER 5H?2 SBN 0 1 5HQL BZE 0 WAIT [NONE READY 5J== SBN 0 #20 5JPW BNZ 0 TE4 [EH? 5K9G # DEAL WITH 'NO LINK' REPLY 5KP6 CALL 7 SREL [RELOCATE RING EL 5L8Q LDX 0 TBIT1(1) 5LNB ORS 0 ASTATUS2(3) [MARK NOT ESTABLISHED 5M82 STOZ APTRIPB(3) 5MML LDX 0 TBIT3(1) 5N7= ORS 0 ASTATUS2(3) [MARK 'NE REPLY SET' 5NLW LDX 0 RNINE(1) 5P6G STO 0 ACOMMUNE2(2) 5PL6 LDN 0 #7777 5Q5Q ANDS 0 ACOMMUNE1(2) 5QKB ANDS 0 ALINUM(3) 5R52 CALL 6 SREP [SET REPLY 5RJL DECLINK 5S4= BRN NEXTASK 5SHW # NO TRANSFER REPLY 5T3G WAIT CALL 7 SREL 5TH6 LDX 0 ACOMMUNE2(2) 5W2Q SBN 0 4 5WGB BZE 0 WAIT1 [J IF CONDITIONAL TRANSFER 5X22 LDX 0 ATIMCT(3) 5XFL BNZ 0 WAIT2 [J TO WAIT IF TIME NOT UP 5X^= WAIT1 LDX 6 RTO(1) 5YDW JDISENG CPPTR(2),WAIT1A 5YYG ORX 6 TBIT5(1) 5^D6 WAIT1A 5^XQ STO 6 ACOMMUNE2(2) 62CB CALL 6 SREP [SET REPLY ETC 62X2 BRN NEXTASK 63BL WAIT2 NGNC 0 1 63W= ANDS 0 ASTATUS1(3) [UNSET TIP & LEAVE WAITING 64*W NGN 0 2 64TG ANDS 0 ASTATUS2(3) 65*6 BRN PCNXT 65SQ # DO ACTUAL TRANSFER 66#B OBJPERI 66S2 TRACE IPREB+1(2),IPCON4 67?L LDX 0 IPREB+2(2) 67R= STO 0 AWORK3(2) [DIFFERENCE IN COUNTS 68=W X3IPCON 68QG CALL 7 SREL [RELOCATE RING EL 69=6 SMO FPTR(3) 69PQ LDX 5 ALINDIR-ARINGEL 6=9B SBN 5 #200 6=P2 BZE 5 OBJREAD [READ REQUIRED 6?8L # DO WRITE 6?N= LDX 0 OBJW(1) 6#7W DCA ,DLA,0,MODE 6#MG LDX 0 AWORK3(2) 6*76 BPZ 0 OB1 6*LQ ADX 0 ALENTR(3) 6B6B BZE 0 TE4 6BL2 BRN OB2 6C5L OB1 LDX 0 ALENTR(3) 6CK= OB2 6D4W DCA ,DLA,0,COUNT 6DJG LDX 7 ASTR(3) 6F46 LDX 1 FPTR(3) 6FHQ SBN 1 ARINGEL 6G3B FINDACTFB 1,,APET,,,BPTR 6GH2 #SKI IPCG4 6H2L ( 6HG= LDX 0 ASEGTAB(1) 6H^W DCA ,STO,0,SEGTAB 6JFG ) 6J^6 #SKI IPCG4<1$1 6KDQ FADDRESS 1,7 [ABSOLUTE ADDRESS 6KYB DCA ,STO,7,CTSA 6LD2 GPERIIPC ,2,CT 6LXL TIPCREP CT,TE1,TE2,TE3,TE4 6M3H ... LDX 0 CPRW1(2) [REPLY WORD 6M7D ... ANDN 0 #7777 [LOOK FOR REMAINDER 6M?* ... BNZ 0 TE4 [MAJOR ERROR IF SEEN 6MC= BRN OBJP1 6MWW # DO READ 6NBG OBJREAD 6NW6 LDX 0 OBJR(1) 6P*Q DSCA ,DLA,0,MODE 6PTB LDX 0 AWORK3(2) 6Q*2 BPZ 0 OB3 6QSL LDX 0 ALENTR(3) 6R#= BRN OB4 6RRW OB3 LDX 0 ALENTR(3) 6S?G SBX 0 AWORK3(2) 6SR6 BZE 0 TE4 6T=Q OB4 6TQB DSCA ,DLA,0,COUNT 6W=2 LDX 7 ASTR(3) 6WPL LDX 1 FPTR(3) 6X9= SBN 1 ARINGEL 6XNW FINDACTFB 1,,APET,,,BPTR 6Y8G #SKI IPCG4 6YN6 ( 6^7Q LDX 0 ASEGTAB(1) 6^MB DSCA ,STO,0,SEGTAB 7272 ) 72LL #SKI IPCG4<1$1 736= FADDRESS 1,7 [ABSOLUTE ADDRESS 73KW DSCA ,STO,7,CTSA 745G LDX 1 FX1 74K6 GPERIIPC ,2,SP 754Q ... TIPCREP SP,TE1,TE2,TE3,,TE4 75JB # SET REPLY TO OBJ PROG 7642 OBJP1 LDX 0 ROK(1) 76HL JDISENG ,OBJP2 773= LDX 0 TBIT5(1) 77GW OBJP2 LDX 6 AWORK3(2) 782G BNG 6 OBJP5 78G6 BZE 5 OBJP6 78^Q BRN OBJP4 79FB OBJP5 ORX 0 TBIT2(1) 79^2 BZE 5 OBJP4 7=DL NGX 6 6 7=Y= OBJP6 7?CW ORX 0 6 [REMAINDER COUNT 7?XG OBJP4 STO 0 ACOMMUNE2(2) 7#C6 CALL 6 SREP [SET REPLY 7#WQ BRN NEXTASK 7*BB OBJP3 ANDX 0 TBIT2(1) [IONG BLOCK 7*W2 BRN OBJP4 7B*L # DEAL WITH TRANSFER ERROR CASES 7BT= TE1 LDX 6 RNF(1) 7C#W JDISENG ,TE1A 7CSG ORX 6 TBIT5(1) 7D#6 TE1A STO 6 ACOMMUNE2(2) 7DRQ CALL 6 SREP 7F?B BRN TIME 7FR2 TE2 LDX 6 RNF(1) 7G=L ORN 6 1 7GQ= JDISENG ,TE2A 7H9W ORX 6 TBIT5(1) 7HPG TE2A STO 6 ACOMMUNE2(2) 7J96 CALL 6 SREP 7JNQ BRN RESETA 7K8B TE3 LDX 6 RNF(1) 7KN2 ORN 6 3 7L7L STO 6 ACOMMUNE2(2) 7LM= CALL 6 SREP 7M6W BRN NOPS 7MLG TE4 LDX 6 RNF(1) 7N66 ORN 6 2 7NKQ JDISENG ,TE4A 7P5B ORX 6 TBIT5(1) 7PK2 TE4A STO 6 ACOMMUNE2(2) 7Q4L CALL 6 SREP 7QJ= BRN WHOOPS 7R3W # 7YXB # CLOSE LINK TASK : THE RING ELEMENT ETC WILL HAVE ALREADY 7^C2 # BEEN FREED. THE ACTION REQUIRED IS SIMPLY TO INFORM THE 7^WL # OTHER END. 82B= # THIS TYPE OF TASK IS USED ALSO WHEN AN OPEN LINK ATTEMPT 82TW # IS ANTICIPATED BY ANOTHER SOURCE. 83*G TCLOS ACROSS IPCONC,1 83T6 # OPEN TASKS FOR GEORGE ACTIVITIES 84#Q # 84SB OPGEO 85#2 ACROSS IPCONB,4 85RL # TRANSFER TASKS FOR GEORGE ACTIVITIES 86?= # 86QW # 87=G TFRG ACROSS IPCONG,1 87Q6 TFREP #3200000 889Q TIREP #2000000 88PB NPUT ACROSS IPCONA,2 8992 NOPS SIPCM SI 89NL NOP ACROSS IPCONE,2 [DEAL WITH INOPERABLE IPB 8=8= WHOOPS 8=MW ACROSS IPCONE,1 [DEAL WITH ERROR 8?7G RESETA 8?M6 ACROSS IPCONE,3 [DEAL WITH ERROR DETECTED 8#6Q TIME 8#LB ACROSS IPCONE,5 8*62 # 8*KL # 8B5= MENDAREA 100,K9IPCON 8BJW # 8C4G # 8CJ6 #END ^^^^ ...45570403000400000000