{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SETMON70)}}
====== SETMON70 ======
(George Source)
**Macros used:** [[george:macro:ACROSSX|ACROSSX]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BXGE|BXGE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTX|HUNTX]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]]
22FL #LIS K0MONFILE>K0SETMON>K0OBJPROG>K0ALLGEO>K0GREATGEO
22^= #SEG SETMON70 [R TERRY
23DW 8HSETMON70
23YG SEGENTRY K1SETMON,SENTRY1
24D6 SEGENTRY K2SETMON,SENTRY2
24XQ SEGENTRY K3SETMON,SENTRY3
25CB SEGENTRY K4SETMON,SENTRY4
25X2 SEGENTRY K5SETMON,SENTRY5
26BL SEGENTRY K7SETMON,SENTRY7
26W= SEGENTRY K8SETMON,SENTRY8
27*W SEGENTRY K9SETMON,SENTRY9
27TG SEGENTRY K10SETMON,SENTRY10
28*6 SEGENTRY K11SETMON,SENTRY11
28SQ SEGENTRY K12SETMON,SENTRY12
29#B SEGENTRY K13SETMON,SENTRY13
29S2 # THIS SEGMENT SETS UP PARAMETER BLOCKS FOR OUTPUT TO THE MONITORING
2=?L # FILE
2=R= XBIT0 7H8388608
2?=W MSK1 #77770000
2?QG XOUTMJPD #500:JPDJOBMILL
2#=6 # THIS SUBROUTINE GETS THE CORE FOR OUTBLOCK. AMONT OF CORE REQD IN X3
2#PQ # OR 56 WORDS, WHICH EVER IS GREATER
2*9B SR1 SBX 7 FX1
2*P2 LDX 4 3
2B8L SBN 4 24
2BN= BPZ 4 SRX1
2C7W LDN 3 24
2CMG SRX1
2D76 SETUPCORE 3,3,GMON,ASET
2DLQ LDCT 4 #100 [SET
2F6B ORS 4 CLONG1(2) [MARKER
2FL2 STOZ A1(3) [ZEROISE CH CT
2G5L LDN 4 A1+2
2GK= STO 4 A1+1(3) [PTR TO 1ST FREE WORD
2H4W STO 3 AWORK2(2) [SAVE PTR
2HJG ADX 7 FX1
2J46 EXIT 7 0
2JHQ # THIS SUBROUTINE CHECKS TO SEE IF THE BLOCK IS LONG ENOUGH. IF NOT IT
2K3B # DOES AN ALTLEN. X3 PTS. TO START OF GMON BLOCK, AND X5 CONTAINS NO. OF
2KH2 # WDS.NEEDED FOR NEXT PARAM.
2L2L TESTLEN
2LG= SBX 7 FX1
2L^W LDX 4 A1+1(3) [PTR TO NEXT PARAM POSN
2MFG SBN 4 A1-1 [NEXT PARAM. POSN.
2M^6 ADX 4 5
2NDQ TXL 4 ALOGLEN(3)
2NYB BCS NMOR [J IF BLOCK LONG ENOUGH
2PD2 TRACE 4,!ALTLEN!
2PXL ALTLEN 3,4
2QC= MHUNTW 3,GMON,ASET
2QWW NMOR STO 3 AWORK2(2) [SAVE BLOCK ADDRESS
2RBG ADX 3 A1+1(3)
2RW6 ADX 7 FX1
2S*Q EXIT 7 0
2STB SENTRY1
2T*2 LDX 3 HMON1(2) [LENGTH REQD
2TSL #SKI K6SETMON>199-199
2W#= TRACE HMON1(2),HOORAY!
2WRW ADN 3 4
2X?G CALL 7 SR1 [GET BLOCK AND INSERT RED TAPE
2XR6 UP
2Y=Q SENTRY2
2YQB LDCT 0 #100 [TEST IF ASET
2^=2 ANDX 0 CLONG1(2) [BLOCK THERE
2^PL BNZ 0 SFD1
329= LDN 3 3
32NW CALL 7 SR1 [GET GMON BLOCK
338G ADN 3 A1+2
33N6 BRN SETP
347Q SFD1 MHUNTW 3,GMON,ASET
34MB LDN 5 1
3572 CALL 7 TESTLEN [INCREASE BLOCK SIZE IF NECESSARY
35LL SETP STOZ 0(3) [ZERO CH CT
366= ADN 3 1
36KW BRN REDTAPE
375G SJ3 SBX 6 FX1
37K6 LDCT 0 #100
384Q ANDX 0 CLONG1(2)
38JB BNZ 0 SJ1
3942 LDX 3 ACOMMUNE1(2) [LOAD WORD COUNT
39HL CALL 7 SR1
3=3= ADN 3 A1+2
3=GW BRN SJ2
3?2G SJ1 MHUNTW 3,GMON,ASET
3?G6 LDX 5 ACOMMUNE1(2) [LOAD WORD COUNT
3?^Q CALL 7 TESTLEN
3#FB SJ2 ADX 6 FX1
3#^2 EXIT 6 0
3*DL SENTRY11
3*Y= CALL 6 SJ3
3BCW UP
3BXG SENTRY12
3CC6 CALL 6 SJ3
3CWQ LDX 1 ACOMMUNE1(2) [LOAD WORD COUNT
3DBB LDN 2 ACOMMUNE2(2)
3DW2 MOVE 2 0(1)
3F*L ADX 3 1
3FT= LDX 1 FX1
3G#W LDX 2 FX2
3GSG BRN REDTAPE
3H#6 SENTRY13
3HRQ LDCT 0 #100
3J?B ANDX 0 CLONG1(2)
3JR2 BNZ 0 S38
3K=L LDN 3 5
3KQ= CALL 7 SR1
3L9W ADN 3 A1+2
3LPG BRN S38A
3M96 S38 MHUNTW 3,GMON,ASET
3MNQ LDN 5 1
3N8B CALL 7 TESTLEN
3NN2 S38A LDX 0 XOUTMJPD(1)
3P7L STO 0 0(3)
3PM= ADN 3 1
3Q6W BRN REDTAPE
3QLG SENTRY3
3R66 # ENTRY FROM OUTNUM : OCTAL CASE
3RKQ #SKI K6SETMON>99-99
3S5B TRACE HMON1(2),NUMBER
3SK2 LDCT 0 #100 [TEST IF ASET
3T4L ANDX 0 CLONG1(2) [BLOCK EXISTS
3TJ= BNZ 0 S31
3W3W LDN 3 6
3WHG CALL 7 SR1 [GET GMON BLOCK
3X36 ADN 3 A1+2
3XGQ BRN S32
3Y2B S31
3YG2 MHUNTW 3,GMON,ASET
3Y^L LDN 5 4
3^F= CALL 7 TESTLEN [GET MORE IF NECESSARY
3^YW S32
42DG LDCT 6 #700
42Y6 S37 STO 6 0(3)
43CQ LDX 0 HMON1(2)
43XB STO 0 1(3)
44C2 ADN 3 2
44WL BRN REDTAPE
45B= # ENTRIES FOR DECIMAL CONVERSION
45TW SENTRY10
46*G LDCT 6 #660
46T6 BRN NDEC
47#Q SENTRY9
47SB LDCT 6 #640
48#2 BRN NDECA
48RL SENTRY8
49?= LDCT 6 #620
49QW NDECA
4==G ORX 6 HMON2(2)
4=Q6 NDEC
4?9Q # THIS SECTION IS COMMON TO ALL THE DEC CONVERSION ROUTINES
4?PB #SKI K6SETMON>99-99
4#92 TRACE HMON1(2),NUMBER
4#NL LDCT 0 #100
4*8= ANDX 0 CLONG1(2) [TEST IF ASET BLOCK
4*MW BNZ 0 S35
4B7G LDN 3 5
4BM6 CALL 7 SR1 [SET UP GMON BLOCK
4C6Q ADN 3 A1+2
4CLB BRN S36
4D62 S35 MHUNTW 3,GMON,ASET
4DKL LDN 5 3
4F5= CALL 7 TESTLEN [CHECK BLOCK LENGTH; GET MORE IF REQD
4FJW S36
4G4G BRN S37
4GJ6 SENTRY4
4H3Q # ENTRY FROM OUTPARAM(X),OUTEXES(X) MACROS
4HHB LDX 5 HMON1(2)
4J32 ANDN 5 #7777
4JGL ADN 5 3
4K2= SRL 5 2 [NO OF WORDS
4KFW ADN 5 1 [PLUS ONE FOR PARAM HEADER WORD
4K^G LDCT 0 #100
4LF6 ANDX 0 CLONG1(2) [TEST IF THERE IS ASET BLOCK
4LYQ BNZ 0 S42
4MDB LDX 3 5
4MY2 ADN 3 2
4NCL CALL 7 SR1 [SET UP BLOCK
4NX= ADN 3 A1+2
4PBW BRN S43
4PWG S42 MHUNTW 3,GMON,ASET
4QB6 CALL 7 TESTLEN
4QTQ S43 LDX 4 HMON1(2)
4R*B LDX 0 4
4RT2 ANDN 0 #7777 [CH CT
4S#L STO 0 0(3)
4SS= ADN 3 1 [UPDATE POINTER
4T?W STOZ 5
4TRG SRL 45 12 [ISOLATE TYPE/SUBTYPE
4W?6 # IF THE CH CT IS ZERO THE EFFECT IS AS FOR OUTNULL. OTHERWISE THE BLOCK
4WQQ # CONTAINING THE PARAM IS LOCATED(GEOERR IF IT CANNOT BE FOUND) AND A
4X=B # POINTER SET UP FOR THE PARAMETER. IF A ZERO TYPE/SUBTYPE IS PASSED
4XQ2 # ACROSS, THE CURRENT ACTIVITY BLOCK IS ASSUMED
4Y9L BZE 5 REDTAPE [J IF ZERO CH CT
4YP= BZE 4 XACT [JUMP IF PARAM IN ACTIVITY BLOCK
4^8W HUNTX 2,HMON1(2)
4^NG BNG 2 QRONG [GEOERR IF NOT THERE
5286 XACT SRL 5 12 [CH COUNT
52MQ SMO FX2
537B ADX 2 HMON2
53M2 # THE FOLLOWING SECTION ACTUALLY MOVES THE PARAM INTO THE ASET BLOCK
546L # IF THE PARAM IS LONGER THAN 512 CHARS. THE MOVE MUST BE MULTIPLE
54L= LDN 1 512
555W TESTA TXL 1 5
55KG BCC NORM [JUMP IF NOT
5656 LDN 7 0 [SET X7 ZERO AS MARKER
56JQ SBN 5 512 [SUBTRACT 512 FROM COUNT
574B BRN MISS
57J2 NORM LDN 7 1
583L LDX 1 5
58H= MISS MVCH 2 0(1) [MOVE PARAM
592W BZE 7 TESTA
59GG LDX 2 FX2
5=26 BRN REDTAPE
5=FQ QRONG GEOERR 1,RONG BLK
5=^B TOTNUMB +AMFNUMBER+1
5?F2 #
5?YL # THE FOLLOWING ROUTINE IS OBEYED BY THE MACRO OUTMESS(X). THE INITIAL
5#D= # PART DETERMINES IN WHICH SEGMENT THE SUBMESSAGE EXISTS. THEN AN ACROSS
5#XW # IS MADE TO THE APPROPRIATE SEGMENT USING THE LINK PAIRS TABULATED ABOV
5*CG #
5*X6 SENTRY5
5BBQ LDX 3 HMON1(2)
5BWB SRL 3 9
5CB2 BXGE 3 TOTNUMB(1),ZGER
5CTL LDEX 4 HMON1(2)
5D*= ADN 3 KMESSX
5DSW ACROSSX 3,K4MESSA
5F#G ZGER GEOERR 1,NOMESS
5FS6 #
5G?Q # THE ROUTINE IS REENTERED HERE AND GMON/ASET BLOCK SET UP IF NOT THERE
5GRB # ALREADY OR ANEXISTING ONE LENGTHENED IF NECESSARY. THE PARAMETER HEADE
5H?2 # WORD IS ALSO SET UP
5HQL #
5J== SENTRY7
5JPW LDX 5 3 [LENGTH OF ATEMP
5K9G LDCT 0 #100 [TEST IF ASET
5KP6 ANDX 0 CLONG1(2) [BLOCK EXISTS
5L8Q BNZ 0 SFOUN
5LNB ADN 5 1 [LENGTH OF PARAM + 3
5M82 LDX 3 5
5MML CALL 7 SR1 [SET UP BLOCK
5N7= ADN 3 A1+2
5NLW BRN XINS
5P6G SFOUN SBN 5 1 [LEN OF PARAM+1 FOR PARAMETER HEADER
5PL6 MHUNTW 3,GMON,ASET
5Q5Q CALL 7 TESTLEN [TEST IF BLOCK LONG ENOUGH
5QKB XINS
5R52 MHUNTW 2,GMON,ATEMP
5RJL LDX 7 A1(2) [NO OF CHARS
5S4= STO 7 0(3) [CH CT
5SHW LDX 1 ALOGLEN(2)
5T3G SBN 1 2 [NUMBER OF WORDS
5TH6 LDX 7 2
5W2Q ADN 2 A1+2 [POINTERS ESTABLISHED
5WGB ADN 3 1 [IN BOTH BLOCKS
5X22 MOVE 2 0(1) [MOVE IN PARAMETER
5XFL ADX 3 1 [UPDATE POINTER AGAIN
5X^= FREECORE 7 [FREE ATEMP BLOCK
5YDW # THIS SECTION ZEROISES THE 1ST WORD AND UPDATES A1 AND GOES UP
5YYG REDTAPE
5^D6 SLC 3 2
5^XQ ADN 3 3
62CB SRL 3 2
62X2 SBX 3 AWORK2(2)
63BL LDX 1 AWORK2(2)
63W= STO 3 A1+1(1) [PTR TO 1ST FREE WORD
64*W LDN 0 1
64TG ADS 0 A1(1) [NO OF PARS.
65*6 UP
65SQ MENDAREA 20,GAPSETMON
66#B #END
^^^^ ...40304513000300000000