CANTDO867
(George Source)
Macros used: ALTLEN, BC, BITDEFS, BS, BXE, BXU, CATMASK, CDRVTAPE, COMERR, ENDCOM, ERROR, FREECORE, FSHENTRY, HUNT, JBS, MARK, MASK, MENDAREA, MFREE, MHUNT, MHUNTW, OFF, ON, PARAPASS, REQSTARS, RESET, RESTART, SEG, SEGENTRY, SETNCORE, SPARANOT, TAB, TEST, TRACE
- CANTDO867.txt
22FL #LIS K0CANTDO>K0ALLGEO>K0GREATGEO 22LS ... SEG CANTDO,867,SECTION CENT,,G110 22S2 ...[ 22^8 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 236B ...[ THIS EXCLUDES CODE UNDER #SKI G110 23?J ...[ 23DQ ...#OPT G110 = 0 23KY ...#SKI G110&1 23R6 ...# WITH UGUG EDIT M110 (PLEASE CHANGED TO ****** IN OPERATOR REQUESTS.) 23YG SEGENTRY K1CANTDO,SENTRY1 248# FSHENTRY K2CANTDO,RESET,RESET,RESET 24#9 FSHENTRY K3CANTDO,XCDOWNENT,,XCDOWNENT 24D6 ZBLOK 24XQ #HAL GMON+AOUT,0 252W XCOUT 2562 #HAL +CONBUFF+COUT,0 2596 XIREM 25#= #HAL +CONBUFF+IREMTW,0 25CB ONE +1 25X2 MASK #60000000 26BL TWO +2 26W= SPACE #20 27*W TAB #77 27PK ... BITDEFS AWORK2,0,SECOND,XACT 285# ... 28F3 ... 28SQ SYSREQ CATMASK SYSREQ 29#B PLEASE 8HPLEASE00 29FJ ...#SKI G110&1 29LQ ...STAR 8H******00 [ACL 0014 STARS NOT PLEASE 29S2 MASKA #600:1 2=R= # THIS SEGMENT IS ENTERED IN THE EVENT OF AN ISSUE OF THE OPERATOR'S 2?=W # DIRECTIVE - CANTDO. IT SEARCHES THE ACTIVITY CHAIN FOR GMON/AOUT 2?QG # BLOCK, THE MESSAGE IN WHICH (IGNORING THE INITIAL PLEASE) MATCHES 2#=6 # THE PARAMETER OF CANTDO.IF ONE OR MORE MATCH IS FOUND THE APPROPRI 2#PQ # ACTIVITY/IES IS/ARE HUNG ON THE END OF THE LIST. 2*9B # 2*P2 # 2B8L # !!THIS SEGMENT ASSUMES THAT SYSTEM REQUESTS NEVER CONTAIN COMMAS!! 2BN= # 2C7W # !! AND HAVE ONLY ONE PART !! 2CMG # 2D76 SENTRY1 2DBY STOZ AWORK2(2) 2DLQ #SKI K6CANTDO>99-99 2F6B ( 2FL2 #SKI GENIE 2G5L TRACE JTIME,CANTDO 2GK= #SKI GENIE<1$1 2H4W TRACE K5+K13,CANTDO 2HJG ) 2J46 # THIS SECTION PASSES ACROSS PARAMETER : IT USES PARAPASS AND 2JHQ # THEREFORE ASSUMES THERE IS NO COMMA IN THE MESSAGE FOR OTHERWISE 2K3B # TEXT AFTER THE COMMA WILL BE LOST 2KH2 # 2KQS PASSPARAM 2L2L PARAPASS 2LG= PASS HUNT 3,CPB,CUNI 2LQ4 ... BNG 3 XERRO 2L^W LDX 4 ANUM(3) [J IF 2MFG BNG 4 XERRO [MISSING 2M^6 BZE 4 XERRO 2NDQ ANDN 4 #7777 2NNJ ... STO 4 AWORK4(2) 2NYB #SKI K6CANTDO>299-299 2PD2 ( 2PXL TRACE 3,SOURCE 2QC= TRACE 4,DESTIN 2QWW ) 2RBG ADN 3 APARA 2RW6 SETNCORE 10,2,ADATA,BCANTDO [BLOCK TO CONTAIN ADDRESSES OF GMON/A 2S*Q RESTT STOZ A1(2) [ZEROISE R.H. 2STB SMO FX2 2T*2 STO 2 AWORK1 [SAVE BLOCK ADDRESS 2TSL # 2W#= # THIS ROUTINE SEARCHES DOWN ACTIVITY CHAIN LOOKING FOR GHON/AOUT 2WRW # BLOCKS WITH A MESSAGE AGREEING WITH AS MUCH OF THE MESSAGE 2X?G # ISSUED AS A PARAM TO CANTDO. THE ADDRESSES OF THESE BLOCKS ARE REMEMB. 2XR6 # 2Y=Q LDN 6 0 [MARKER FOR NO GMON/AOUT BLOCK 2YQB LDN 2 BACT [BASE OF ACTIVITY CHAIN 2^=2 XCONT LDX 2 FPTR(2) [NEXT BLOCK 2^PL LDX 3 2 [PRESERVE ADDRESS 329= SBN 3 BACT 32NW BZE 3 ZBASE [JUMP IF BACK TO BASE 338G LDX 7 ATYPE(2) [BLOCK TYPE 33N6 #SKI K6CANTDO>499-499 347Q TRACE 7,BLOK 34MB SMO FX1 3572 TXU 7 ZBLOK 35LL BCS XCONT [J IF NOT AOUT 375G LDX 0 ARECB+1(2) 37K6 BPZ 0 XCONT [OUT IF NOT RETAINED 384Q SMO FX1 38JB ANDX 0 SYSREQ 3942 BZE 0 XCONT [OR NOT SYSTEM-REQUEST 39BC LDX 0 ARECB(2) 39NS BNG 0 XCONT [OR IF ALREADY CANTDO'NE 39Q? ... 39RQ ... ANDN 0 #7777 39T9 ... SMO FX2 39WN ... STO 0 AWORK3 39Y7 ... SMO FX2 39^L ... LDX 4 AWORK4 3=3= MHUNT 3,CPB,CUNI 3=GW ADN 3 APARA 3?2G LDX 5 2 [TO PRESERVE START OF AOUT BLOCK 3CC6 ADN 2 ARECB+2 3CWQ LDX 1 FX1 3DBB LDX 0 0(2) 3DW2 LDX 7 1(2) 3F*L ANDX 7 HALFTOP 3FT= TXU 0 PLEASE(1) 3G#W TXU 7 PLEASE+1(1) 3G*T ...[ 3GBS ...[ 3GCR ...#SKI G110&1 3GDQ ...( 3GFP ...[ MEND EXCHANGE SCHEME CODE 3GGN ... BCC TESTX 3GHM ... TXU 0 STAR(1) [ACL0014 CHECK FOR STARS 3GJL ... TXU 7 STAR+1(1) 3GKK ... BCS TESTA 3GLJ ...TESTX ADX 2 MASKA(1) 3GMH ...) 3GNG ...[ 3GPF ...[ 3GQD ...#SKI G110&1$1 3GRC ...( 3GSG BCS TESTA [OK IF NOT "PLEASE...." 3H#6 ADX 2 MASKA(1) [ELDE IGNORE 3HRQ ...) 3HW* ... SMO FX2 3HYY ... LDX 7 AWORK3 3J3H ... SBN 7 6 3J66 ... BNG 7 NOTSAME 3J8P ... BZE 7 NOTSAME 3J?# ... BRN TEST 3J*X ... 3JDG ...TESTA 3JH5 ... SMO FX2 3JKN ... LDX 7 AWORK3 3JN? ... 3JR2 TEST LDCH 1 0(3) [THESE 2 INSTRUCTIONS GET FIRST 3K=L TESTC LDCH 0 0(2) [LOAD CHAR FROM AOUT BLOCK 3KQ= SMO FX1 3L9W TXU 0 SPACE [IS IT A SPACE 3LPG BCS TESTB [JUMP IF NOT 3LWN ... SBN 7 1 3M3W ... BZE 7 NOTSAME 3M96 BCHX 2 £ 3MNQ BRN TESTC [GO AND GET NEXT CHARACTER 3N8B TESTB 3NN2 #SKI K6CANTDO>499-499 3P7L ( 3PM= TRACE 0,X0=CHAR 3Q6W TRACE 1,X1=CHAR 3QLG ) 3R66 TXU 0 1 [COMPARE CHARACTERS 3RKQ BCC SSAME 3RQY ...NOTSAME 3RY6 ... 3S5B LDX 2 5 [RESTORE X2 3SK2 BRN XCONT [GO BACK TO LOOK FOR NEXT BLOCK 3STX ... 3T6S ...SSAME 3TCP ... 3TNL ... BCT 4 SSAME20 3T^H ... 3W=D ... BCT 7 SSAME10 3WH* ... 3WS= ...SSAME05 3X57 ... 3XB4 ... LDX 3 FX2 3XL^ ... JBS SAME50,3,XACT 3XXW ... BS 3,XACT 3Y8R ... BZE 6 SAME50 3YFN ... 3YQK ... 3^3G ... 3^#C ... LDN 6 1 3^K# ... SMO FX2 3^W9 ... LDX 3 AWORK1 4276 ... STO 6 A1(3) 42D3 ... STO 5 A1+1(3) 42NY ... BRN RESTO 42^T ... 43=Q ...SSAME10 43HM ... 43SJ ... LDX 3 FX2 445F ... JBS RESTO,3,XACT 44BB ... 44M? ... BRN SAME50 44Y8 ... 4595 ...SSAME20 45G2 ... 45QX ... SBN 7 1 463S ... BZE 7 NOTSAME 46*G SAME BCHX 3 £ 46T6 BCHX 2 £ 47#Q ... BRN TEST 47SB #SKI K6DEMAND>99-99 48#2 TRACE 5,CDOBLOK 48RL # 493D ...SAME50 49?= # IF THIS IS NOT THE 1ST BLOCK THAT AGREES(NB IF THERE ARE MORE BLOCKS 49QW # DISCOVERED THAN THERE IS ROOM FOR IN THE BLOCK SET UP, THIS BLOCK HAS 4==G # TO BE LENGTHENED, BUT AS THIS INVOLVES A COORDINATION DURING WHICH 4=Q6 # TIME THE BLOCKS MIGHT BE FREED, THE SEARCH HAS TO BE RESTARTED) THEN 4?9Q # THE ENTIRE CONTENTS OF THE BLOCK MUST BE COMPARED WITH THOSE OF AN 4?PB # EARLIER ONE. IF THEY DISAGREE AN ERROR IS REPORTED, STATING THAT 4#92 # THE MESSAGE PARAMETER IS TOO SHORT 4#NL # 4*8= ADN 6 1 [ADD 1 TO COUNT OF BLOCKS 4*MW SMO FX2 4B7G LDX 3 AWORK1 [POINTER TO BCANTDO BLOCK 4BM6 TXL 6 ALOGLEN(3) 4C6Q BCS ZEX 4CLB LDX 7 ALOGLEN(3) 4D62 ADN 7 5 [NEW REQUIRED SIZE 4DKL ALTLEN 3,7,ADATA,BCANTDO [TRY AGAIN WITH MORE SPACE 4DM8 RESET 4DMB ... LDX 3 FX2 4DMJ ... BC 3,XACT 4DMQ ... LDX 4 AWORK4(3) 4DM^ MHUNTW 2,ADATA,BCANTDO 4FJW BRN RESTT [IN THIS CASE SEARCU MUST BE RESTARTE 4G4G # THE NEW ADDRESS IS STORED IN BLOCK AND R.H. IS UPDATED.IF IT IS NOT FI 4GJ6 # BLOCK FOUND THE LAST BLOCK IS COMPARED WITH THE FIRST ONE. IF THEY DIS 4H3Q # AN ERROR IS REPORTED 4H=2 ZEX 4HSQ SMO A1(3) 4J32 STO 5 A1+1(3) 4JGL STO 6 A1(3) 4K2= SMO FX1 4KFW TXL 6 TWO 4K^G BCS RESTO 4LF6 LDX 1 A1+1(3) 4LGN LDX 7 A1(1) 4LYQ LDX 3 5 4MY2 #SKI K6CANTDO>499-499 4NCL ( 4NX= TRACE 7,R.H. 4PBW TRACE A1(3),R.H. 4PWG ) 4QB6 TXU 7 A1(3) [COMPARE RECORD HEADERS 4QTQ BCS NUNIQ [ERROR IF DIFFERENT 4S#L ANDN 7 4095 4SS= ADN 7 7 4T?W SRL 7 2 [WORDS + 1 4X=B VCOMP 4XQ2 #SKI K6CANTDO>499-499 4Y9L ( 4YP= SMO 7 4^8W LDX 0 A1(3) 4^NG TRACE 0,WORD 5286 ) 52MQ SMO 7 537B LDX 0 A1(1) 53M2 #SKI K6CANTDO>499-499 546L TRACE 0,WORD 54L= SMO 7 555W TXU 0 A1(3) [COMPARE BLOCKS WORD FOR WORD 55KG BCS NUNIQ [ERROR IF DIFFERENCE 5656 BCT 7 VCOMP 56JQ RESTO LDX 2 5 [RESTORE X2 574B BRN XCONT 57=# ZBASE LDX 2 FX2 57D= JBS ZFINISH,2,SECOND [J IF SECOND PASS 57L9 #UNS FIRSTR 57ND ( 57QM CDRVTAPE NUNIQ,NONEXIST,6 [CHECK FOR SPECIAL RV MESSAGE 57SW BRN QUP [CANTDO ACTIONED SUCCESSFULLY 57T5 XFSHNBCDRV 57TK ZFINISH 57W# BNZ 6 ZIND [J IF MESSAGE FOUND 57X5 NONEXIST 57Y8 BNZ 6 SECONDPASS 57^# ) 583L SPARANOT 1 [GET SPACES IN MESSAGE 58?D XERR 58H= ERROR ERROCANT 592W BRN QUP 5947 XFSHNBERR 596R SECONDPASS 59=N BS 2,SECOND 59BK BRN RESET 59K5 ZIND 59RK SMO FX2 5=26 LDX 2 AWORK1 5=FQ LDCT 3 #400 5=^B MARK SMO 6 5?F2 LDX 1 A1(2) 5?YL ORS 3 A1(1) 5#D= BCT 6 MARK 5#XW # 5*CG # THE FOLLOWING SECTION OF CODE SEARCHES THROUGH THE CONSOLE OUTPUT 5*X6 # CHAIN, FREEING ANY BLOCKS THAT CONTAIN THE MESSAGE TO WHICH THE CONTDO 5BBQ # APPLIED, UNLESS THE BLOCK REPRESENTS THE BUFFER FOR A CURRENT TRANSFER 5BWB # 5CB2 LDX 4 1 [PRESERVE BLOCK ADDRESS 5CLD LDX 3 BCONSOUT [BASE OF CONSOLE OUTPUT CHAIN 5CWW BXE 3 CXCO,QUP [GO UP IF NO BLOCKS 5D7# RESTART [IGNORE 1ST BLOCK AS IT MAY BE 5DCQ [BEING OUTPUT 5DN8 LDX 3 FPTR(3) [SECOND/NEXT BLOCK 5DYL NEXT BXE 3 CXCO,QUP [UP IF NONE LEFT 5F94 LDX 0 ATYPE(3) 5FFG LDX 1 FX1 5FPY BXE 0 XCOUT(1),XC [CONBUFF/COUT BLOCK 5G2B BXE 0 XIREM(1),XI [CONBUFF/IREMTW BLOCK 5G=S BRN RESTART [IGNORE OTHER BLOCKS (USED IN DME) 5GH= XC LDX 6 AREC(3) 5GRN SBN 6 1 [WORD COUNT 5H46 LDN 2 ATEXT(3) [START OF MESSAGE 5H#J BRN XCHCH 5HK2 XI LDX 6 A1(3) 5HTD ANDN 6 #7777 [WORD COUNT 5J5W LDN 2 ICBUFF(3) [START OF MESSAGE 5JB# XCHCH 5JLQ BZE 6 RESTART [J IF NO TEXT IN BLOCK 5JX8 SLL 6 2 [CHANGE TO CHARACTER COUNT 5K7S LDX 1 4 [RESTORE POINTER TO MESSAGE BLOCK 5KDD ADN 1 A1+2 [START OF MESSAGE IN BLOCK 5KP6 TRGN LDCH 0 0(2) [FIRST CHAR/NEXT CHAR 5L8Q #SKI K6CANTDO>499-499 5LNB TRACE 0,CONSCHAR 5M82 LDCH 5 0(1) [GET NEXT CHAR FROM MESSAGE BLOCK 5P6G #SKI K6CANTDO>499-499 5PL6 TRACE 5,MESSCHAR 5Q5Q BXU 0 5,RESTART [COMPARE AND JUMP BACK IF UNEQUAL 5R52 BCHX 1 £ 5RJL BCHX 2 £ 5S4= BCT 6 TRGN [LOOP 5SHW #SKI K6CANTDO>199-199 5T3G TRACE 3,FREEBUFF 5TH6 LDX 5 FPTR(3) 5W2Q FREECORE 3 [IF DROPS THROUGH RELEASE BUFFER 5WGB LDX 3 5 5X22 BRN NEXT [LOOK FOR MORE 5X4R XFSHNBCONS 5^4Q QUP 5^*5 MFREE ADATA,BCANTDO 5^D6 ENDCOM 5^GW XERRO 6266 COMERR JPARMIS,JAMESSAGE [MESSAGE PARAM MISSING 628W NUNIQ 62S6 MFREE ADATA,BCANTDO 62X2 COMERR ATOOSMALL [ERROR PARAMETER TOO SHORT 63BL MENDAREA 20,GAPCANTDO 63F9 ...#END 63HS ...#SKI G110&1 63LC ... REQSTARS ON 63P2 ...#SKI G110&3-2<1$1 63RK ... REQSTARS OFF 63W= ^^^^ ...16125205001000000000