SETMON70
(George Source)
Macros used: ACROSSX, ALTLEN, BXGE, FREECORE, GEOERR, HUNTX, MENDAREA, MHUNTW, SEGENTRY, SETUPCORE, TRACE, UP
- SETMON70.txt
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