{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CANTDO867)}}
====== CANTDO867 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BC|BC]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CATMASK|CATMASK]], [[george:macro:CDRVTAPE|CDRVTAPE]], [[george:macro:COMERR|COMERR]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERROR|ERROR]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:HUNT|HUNT]], [[george:macro:JBS|JBS]], [[george:macro:MARK|MARK]], [[george:macro:MASK|MASK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OFF|OFF]], [[george:macro:ON|ON]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:REQSTARS|REQSTARS]], [[george:macro:RESET|RESET]], [[george:macro:RESTART|RESTART]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:TAB|TAB]], [[george:macro:TEST|TEST]], [[george:macro:TRACE|TRACE]]
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