MONITOR36
(George Source)
Macros used: ALTLEN, BXE, BXGE, BXU, CHAIN, COMERRX, DOWN, ENDCOM, ERRORX, FINDOLP1, FPCACA, FREECORE, GEOERR, HUNT2, HUNTW, LOCK, MENDAREA, MFREE, MHUNT, MHUNTW, MONOUT, MTPTR, OUTBLOCK, OUTNUM, PARAFREE, PARALYSE, PARANUMB, PARAPASS, PERCONA, PERMOFF, PERMON, PHOTO, RESTART, SEGENTRY, SETNCORE, TESTMOVE, TESTOUT, TESTREP, TESTREP2, TESTREPNOT, TRACE, UNLOCK, UP, UPDATE
- MONITOR36.txt
22FL #SEG MONITOR36 [ROGER TERRY 22^= #LIS K0MONITOR>K0ALLGEO>K0GREATGEO>K0COMMAND 23DW #OPT K6MONITOR=K6ALLGEO>K6GREATGEO>K6COMMAND 23YG 8HMONITOR 24D6 # 24XQ # THIS SEGMENT IMPLEMENTS THE MONITOR COMMAND.THE FIRST PARAMETER (ON 25CB # OR OFF) IS GOT AND,IF VALID,B0 OF AWORK1 IS SET 1 FOR ON,0 FOR OFF 25X2 # IF THE TYPE OF THE SECOND PARAMETER IS SIMPLE IT IS CHECKED FOR BEING 26BL # 'DELETE','DISPLAY' OR 'DISENGAGED';IF NOT IT IS ASSUMED TO BE IN THE 26W= # 'OPEN PERI' FORMAT - 27*W # EG MN ON,REL(*CR)&(OPEN&CLOSE)(*MT0&*MT1) 27TG # FOR THIS LAST TYPE OF MONITORING AN APED/AMONCAT BLOCK IS SET UP/ 28*6 # UPDATED/DELETED IN THE PCA CHAIN,AND IF MONITORING IS BEING TURNED ON 28SQ # AN ADATA/AMONWORK BLOCK IS USED FOR WORKING SPACE. 29#B # 29S2 # ENTRY POINTS0 ONLY THE FIRST IS GENUINE FROM THE C0P0 2=?L SEGENTRY K1MONITOR,ZEP1 [FOR MONITOR COMMAND 2=R= SEGENTRY K10MONITOR,ZEP10 [RE-ENTRY FROM SEGMENT ITSELF 2?=W SEGENTRY K11MONITOR,ZEP11 [RE-ENTRY FROM SEGMENT ITSELF 2?QG # 2#=6 # LOCAL DEFINITIONS FOR THE AMONWORK BLOCK 2#PQ # 2*9B #DEF TYPE=A1 2*P2 #DEF PERILS=TYPE+1 2B8L #DEF TAMON=PERILS+3 2BN= #DEF TALL=TAMON+1 2C7W #DEF TTPOINT=TALL+1 2CMG #DEF TBPOINT=TTPOINT+1 2D76 #DEF PERLIST=TBPOINT+1 2DLQ # 2F6B #DEF ZWORKL=16 [ORIG LENGTH OF AMONWORK BLOCK 2FL2 #DEF ZCATL=8 [ AMONCAT 2G5L #DEF ZWORKX=16 [LENGTH BY WHICH AMONWORK IS EXTENDED 2GK= #DEF ZCATX=4 [ AMONCAT 2H4W #DEF NMONBITS=#3770 [MNTRG TYPES USING AMONCAT BLOCK 2HJG # 2J46 # DATA WORDS 2JHQ # 2JRJ ...X64 +64 2K3B XON 4HON 2KH2 XOFF 4HOFF 2L2L XED 4HED 2LG= MERM1 +APFERR [PARAMETER FORMAT ERROR : %C 2L^W MERM3 +JPARMIS [ %C PARAMETER MISSING 2MFG MERM4 +ERUNPAIR [ %C CONTAINS AN UNPAIRED DELIMITER 2M^6 MERM5 +ERRPERC [ %C IS NOT A CORRECT PERIPHERAL NAME 2NDQ MERM6 +ERM2 [THE NAMED PERIPHERAL IS NOT ON-LINE 2NYB MERM7 +JMONCOM [ %C IS INVALID COMBINATION OF MONITORING 2P88 ...MERM8 +JMAXPAR 2PD2 [ AND PERIPHERAL TYPES 2PXL # 2QC= TABLE1 +6 [LENGTH OF TABLE ENTRY 2QWW [ ILLEGAL PERIPHERAL TYPES 2RBG 8HREL 2RW6 +BBREL 2S*Q ... #01777777 [ ALL BUT 0-4,50,51,52,60 2STB -1 2T*2 ... #61773777 2TSL # 2W#= 8HDIS 2WRW +BBDIS 2X?G ... #01777777 [ ALL BUT 0-4,50,51,52 2XR6 -1 2Y=Q ... #61777777 2YQB # 2^=2 8HCONT 2^PL +BBCONT 329= #32773777 [ 1,2,4,6-11,13-23 32NW -1 [ 24-47 338G -1 [ 48-63 33N6 # 347Q 8HALLOT 34MB +BBALLOT 3572 +0 [ NONE 35LL +0 366= +0 36KW # 375G 8HOPEN 37K6 +BBOPEN 384Q #76135777 [ ALL BUT 5-7,9,13 38JB #75777777 [ AND 28 3942 -1 39HL # 3=3= 8HCLOSE 3=GW +BBCLOSE 3?2G #76175777 [ ALL BUT 5-7,13 3?G6 #75777777 [ AND 28 3?^Q -1 3#FB # 3#^2 8HRENAME 3*DL +BBRENAME 3*Y= #76175777 [ ALL BUT 5-7,13 3BCW -1 3BXG -1 3CC6 # 3CWQ 8HEXTEND 3DBB +BBEXTEND 3DW2 #77175777 [ ALL BUT 6,7,13 3F*L -1 3FT= -1 3G#W +0 [MARKS END OF TABLE1 3GSG # 3H#6 TABLE2 +3 [LENGTH OF TABLE ENTRY 3HRQ 8HDELETE 3J?B #0004 3JR2 8HDISENGAG 3K=L +0 3KQ= 8HDISPLAY 3L9W #0001 3LPG #SKI K6MONITOR>1099-1099 3M96 ( 3MNQ 8HTEST 3N8B #10000000 3NN2 8HERROR 3P7L #04000000 3PM= ) 3Q6W +0 [END OF TABLE2 3QLG # 3R66 # THIS FIRST CODE GETS THE 1ST & 2ND PARAMS AND BRANCHES TO APPRIATE 3RKQ # ANALYSIS ROUTINE 3S5B # 3SK2 ZEP1 [ENTRY POINT FROM COMMAND PROCESSOR 3T4L CALL 7 ZPARAPASS [GET FIRST PARAMETER 3TJ= NGX 0 ANUM(3) 3W3W BPZ 0 ZERR3 [ 'PARAMETER MISSING' IF NULL OR 3WHG [ NONEXISTENT 3X36 LDCT 4 256 3XGQ LDX 0 APARA(3) 3Y2B BXE 0 XON(1),SFLAG 3YG2 LDN 4 0 3Y^L BXU 0 XOFF(1),ZERR1 [ 'PARAMETER FORMAT ERROR IF NEITHER 3^F= SFLAG [ 'ON' OR 'OFF' 3^YW STO 4 AWORK1(2) [SET ON/OFF FLAG (B0=1 FOR ON) 42DG #SKI K6MONITOR>699-699 42Y6 TRACE AWORK1(2),MONOFF 43CQ FREECORE 3 [FREE THE UNI BLOCK 43XB CALL 7 ZPARAPASS [GET 2ND PARAMETER 44C2 #SKI K6MONITOR>799-799 44WL TRACE APARA(3),2NDPARAM 45B= LDX 0 ANUM(3) 45TW BZE 0 ZERR3 [ERROR IF NULL 46*G BNG 0 ZERR3 [ OR NON-EXISTENT 46T6 SRL 0 12 47#Q BNZ 0 NEWMON [IF PARAM NOT SIMPLE,J TO SEE IF IT 47SB [ IS THE 'OPEN PERI ETC' FORMAT 48#2 LDN 1 TABLE2(1) 48RL CALL 7 WHATTYPE [CHECK MNTRG TYPE AGAINST TABLE2 49?= BRN NEWMON [ -IF ABSENT ASSUME 'OPEN PERI'FORMAT 49QW LDX 7 2(1) [ OTHERWISE GET MASK 4==G BRN ZOLD1 [ AND J TO IMPLEMENT COMMAND 4=Q6 # 4?9Q # THE NEXT SECTION DEALS WITH REL,DIS,CONT,ALLOT,OPEN,CLOSE AND RENAME 4?PB # MONITORING TYPES.ON ENTRY X0=TYPE OF 2ND PARAM,X5=NO OF PARAMS-3 4#92 # 4#NL NEWMON 4*8= SBN 0 2 4*MW BZE 0 ZERR1 [ERROR IF 2ND PARAM COMPOSITE 4B7G LDN 1 2 4BM6 PARALYSE #26,,1 [SPLIT PARAMETER AT & 4C6Q TESTREP UNPAIR,ZERR4 4C?Y ...#UNS ANSTOOMANY 4CF6 ... TESTREP2 TOOMANY,ZERR8 4CLB LDXC 0 AWORK1(2) 4D62 BCS MONON [BRANCH IF MONITORING BEING TURNED ON 4DKL STOZ AWORK2(2) 4F5= MONOFF [IF MNTRG TURNED OFF WE EXAMINE EACH 4FJW [ELEMENT OF 2ND PARAM AND SET CORESP 4G4G [BIT OF AWORK2 4GJ6 CALL 7 ZPARAPASS [GET NEXT ELEMENT OF 2ND PARAM 4H3Q #SKI K6MONITOR>799-799 4HHB TRACE APARA(3),OFFTYPE 4J32 LDX 0 ANUM(3) 4JGL BZE 0 ZERR1A [ERROR IF NULL 4K2= BNG 0 TURNOFF [IF NON-EXISTENT PROCEED TO TURN OFF 4KFW [ SPECIFIED MONITORING 4K^G ANDX 0 HALFTOP 4LF6 BNZ 0 ZERR2 [ERROR IF PARAM NOT SIMPLE 4LYQ LDN 1 TABLE1(1) 4MDB CALL 7 WHATTYPE [FIND TYPE OF MONITORING 4MY2 BRN ZERR2 [ERROR IF TYPE UNRECOGNISED 4NCL LDX 0 2(1) 4NX= ORS 0 AWORK2(2) [ OTHERWISE REMEMBER RECOGNISED TYPE 4PBW FREECORE 3 [FREE THE UNI BLOCK 4PWG BRN MONOFF 4QB6 # 4QTQ # THE NEXT ROUTINE TURNS OFF MONITORING FOR THE MONITORING TYPES DEFINED 4R*B # BY AWORK2 OF THE CPAT 4RT2 # 4S#L TURNOFF 4SS= #SKI K6MONITOR>699-699 4T?W TRACE AWORK2(2),TURNOFF 4TRG FREECORE 3 [FREE THE LAST UNI 4W?6 CALL 0 SMONBLKS [ X1->PCA,X3-> AMONCAT BLOCK 4WQQ BNG 3 ZFINISH [IF NO MONITORING,NOTHING TO TURN OFF 4X=B LDX 6 AWORK2(2) 4XQ2 NGN 0 1 4Y9L ERX 6 0 4YP= ANDS 6 AMON(1) 4^8W ANDS 6 BPALL(3) 4^NG ERX 6 0 [FOR THE TABLES TURN OFF ALSO THOSE 5286 ORX 6 BPALL(3) [ MNTRG TYPES ALREADY COVERED BY 52MQ ERX 6 0 [ THE BPALL WORD 537B LDN 5 1 53M2 CALL 7 UPDATE [ERASE MONITORING INFO IN UPPER TABLE 546L NGN 5 1 54L= CALL 7 UPDATE [...AND IN LOWER TABLE 555W LDX 0 AMON(1) 55KG ANDN 0 NMONBITS 5656 BNZ 0 ZFINISH [IF NO MONITORING OF TYPES WHICH NEED 56JQ FREECORE 3 [ THE AMONCAT BLOCK,FREE IT 574B BRN ZFINISH 57J2 # 583L # THE NEXT SECTION ANALYSES THE SECOND PARAM OF MN ON,OPEN PERI FORMAT 58H= # EG MN ON,REL&DIS(*CR)&(OPEN&CLOSE)(*ED1&*ED2) 592W # FIRST WE SET UP AND INITIALISE AN AMONWORK BLOCK,AND EXAMINE THE NEXT 59GG # 'ELEMENT' (EG DIS(*CR) OR (OPEN&CLOSE)(*ED1&*ED2) IN ABOVE EXAMPLE ) 5=26 # AT LABEL NXTELE.IF THE ELEMENT IS QUALIFIED IT IS SPLIT INTO THE 5=FQ # MNTRG TYPES AND PERIPHERAL TYPES PARTS,AND THESE ARE ANALYSED (LABELS 5=^B # NXTMTYPE AND NXTPERL);OTHERWISE IF UNQUALIFIED IT IS ANALYSED AT 5?F2 # LABEL UNQUAL. 5?YL # 5#D= MONON SETNCORE ZWORKL,4,ADATA,AMONWORK 5#XW PHOTO 0 5*CG STO 0 AWORK2(2) 5*X6 STOZ AWORK3(2) [POSITIONAL NO OF CURRENT ELEMENT 5BBQ LDX 2 4 5BWB STOZ TAMON(2) [BIT => TYPE OF MNTRG FOR SOME PERIPH 5CB2 STOZ TALL(2) [BIT => ALL 5CTL STOZ TTPOINT(2) [PNTR FOR TOP TABLE (REL TO PERLIST) 5D*= LDN 0 ZWORKL+A1-1-PERLIST 5DSW STO 0 TBPOINT(2) [PNTR FOR BOT TABLE (REL TO PERLIST) 5F#G NXTELE [X2,X4->AMONWORK; PHOTO FOR THIS 5FS6 [ IN AWORK2 5G?Q STOZ TYPE(2) [CONJUNCTION OF MNTRG TYPES FOR THIS 5GRB STOZ PERILS(2) [ ELEMENT 5H?2 STOZ PERILS+1(2) [3 PERILS WDS-BIT SET IF THAT PERI- 5HQL STOZ PERILS+2(2) [ PHERAL MUSTNT BE MNTRD IN SPECD WAY 5J== LDN 0 2 5JPW PARAFREE 0 [FREE ANY STRAY MULTI BLOCKS 5K9G CALL 7 ZPARAPASS [GET NEXT ELEMENT 5KP6 LDN 5 1 5L8Q ADS 5 AWORK3(2) [AWORK3=POSITIONAL NO OF CRNT ELEMENT 5LNB #SKI K6MONITOR>799-799 5M82 TRACE APARA(3),NXTELE 5MML LDX 0 ANUM(3) 5N7= BZE 0 ZERR1A [ERROR IF NULL-ORIG PARAM LIKE 5NLW [ REL&&DIS 5P6G BNG 0 TURNON [IF N/E PROCEED TO UPDATE AMONCAT BLK 5PL6 SRL 0 12 [IF SIMPLE DONT BOTHER TO SPLIT INTO 5Q5Q BZE 0 UNQUAL [ (MON TYPES) AND (PERIPH LIST) 5QKB SBN 0 3 [ OTHERWISE ERROR IF NOT TYPE 3 5R52 BNZ 0 ZERR1 5RJL LDX 1 AWORK3(2) [SPLIT ELEMENT INTO (MON TYPES) AND 5S4= PARALYSE ,,1 [ (PERIPH LIST) 5SHW TESTREP UNPAIR,ZERR4 5SP4 ...#UNS ANSTOOMANY 5SW= ... TESTREP2 TOOMANY,ZERR8 5T3G CALL 7 ZPARANUMB 5TH6 SBN 3 2 5W2Q BNZ 3 ZERR1 5WGB CALL 7 ZPARAPASS [GET MON TYPES PART 5X22 LDX 0 ANUM(3) 5XFL SRL 0 12 5X^= BZE 0 SINGLE [IF SIMPLE DONT SPLIT FURTHER 5YDW LDCH 0 APARA(3) 5YYG SBN 0 #30 5^D6 BNZ 0 ZERR1 [ERROR IF 1ST CHAR NOT ( 5^XQ LDN 5 0 [ 'NOT TYPE 0' SWITCH 62CB FREECORE 3 62X2 LDN 3 1 63BL CALL 7 SPLIT [REMOVE OUTER PARENTHESES AND SPLIT 63W= CALL 7 ZPARANUMB 64*W SBN 3 2 64TG BNG 3 ZERR1 65*6 NXTMTYPE 65SQ CALL 7 ZPARAPASS [GET NEXT ITEM IN MNTRG TYPES LIST 66#B #SKI K6MONITOR>899-899 66S2 TRACE APARA(3),NXTMTYPE 67?L LDX 0 ANUM(3) 67R= BZE 0 ZERR1A [ERROR IF NULL - EG (REL&)(*CR) 68=W BNG 0 PERQ [IF N/E ANALYSE QUALIFYING PERIPHERAL 68QG ANDX 0 HALFTOP [ LIST 69=6 BNZ 0 ZERR2 [ERROR IF OTHER THAN SIMPLE 69PQ SINGLE 6=9B CALL 7 SWORK [FIND THE AMONWORK BLOCK 6=P2 LDN 1 TABLE1(1) 6?8L CALL 7 WHATTYPE [FIND MNTRG TYPE 6?N= BRN ZERR2 [ERROR IF UNRECOGNISED 6#7W LDX 0 2(1) [OTHERWISE UPDATE DATA WORDS FOR THIS 6#MG ORS 0 TYPE(2) [ ELEMENT 6*76 ORS 0 TAMON(2) 6*LQ LDX 0 3(1) 6B6B ORS 0 PERILS(2) 6BL2 LDX 0 4(1) 6C5L ORS 0 PERILS+1(2) 6CK= LDX 0 5(1) 6D4W ORS 0 PERILS+2(2) 6DJG FREECORE 3 [FREE THE UNI 6F46 BZE 5 NXTMTYPE [IF >1 ITEM TO MNTRG TYPES LIST,BRNCH 6FHQ BRN PERQUAL [ OTHERWISE ALALYSE ELEMENT QUALIFIER 6G3B # 6GH2 PERQ FREECORE 3 6H2L PERQUAL [THIS ROUTINE ANALYSES THE PERIPHERAL 6HG= [ LIST QUALIFIER FOR THE CURRENT 6H^W [ ELEMENT.X4->AMONWORK,PHOTO IN AWK2 6JFG LDN 0 2 [ ALL OTHER ACCS UNDEFINED 6J^6 PARAPASS 0 6KDQ MHUNT 3,CPB,CUNI 6KYB #SKI K6MONITOR>899-899 6LD2 TRACE APARA(3),PERQUAL 6LXL LDCH 0 APARA(3) 6MC= SBN 0 #30 6MWW BNZ 0 ZERR1 [ERROR IF 1ST CHAR NOT ( 6NBG FREECORE 3 6NW6 LDN 3 2 6P*Q CALL 7 SPLIT [STRIP OFF OUTER PARENTHESES AND 6PTB [ SPLIT ON & 6Q*2 NXTPERL 6QSL CALL 7 ZPARAPASS [GET CUNI BLOCK 6R#= #SKI K6MONITOR>899-899 6RRW TRACE APARA(3),NXTPERL 6S?G NGX 7 ANUM(3) 6SR6 BNG 7 NXTP2 [J IF NOT NULL OR NON-EXISTENT 6T=Q FREECORE 3 [OTHERWISE FREE THE UNI BLOCK 6TQB BZE 7 ZERR1 [IF UNI WAS NULL,ERROR 6W=2 MFREE CPB,CUNI [ OTHERWISE FREE UNI CONTAINING 6WPL [ ENTIRE ELEMENT 6X9= CALL 7 SWORK [FIND THE AMONWORK BLOCK 6XNW BRN NXTELE [PROCEED TO PROCESS NEXT ELEMENT 6Y8G NXTP2 PERCONA [GET TYPE/UNIT NO 6YN6 TESTREPNOT OK,ZERR10 [INVALID PERIPH NAME - EXIT TO CP 6YT# ... LDEX 0 ACOMMUNE1(2) 6^2G ... BXGE 0 X64(1),ZERR5 [IN CASE MANYDA IN USE 6^7Q MFREE CPB,CUNI 6^MB LDX 6 ACOMMUNE1(2) [RESULT OF PERCONA CONVERSION 7272 LDX 5 6 72LL SRL 5 15 [PERIPHERAL TYPE NUMBER 736= CALL 7 SWORK [FIND AMONWORK BLOCK 73KW NXTP4 SBN 5 24 [MONITORING IS ILLEGAL FOR THE 745G BNG 5 NXTP3 [ PERIPHERAL TYPE SPECD BY X5 IF 74K6 ADN 2 1 [ THE [X5]TH BIT OF PERILS-PERILS+2 754Q BRN NXTP4 [ IN THE AMONWORK BLOCK IS SET 75JB NXTP3 ADN 5 24 7642 LDCT 0 #400 76HL SMO 5 773= SRL 0 0 77GW ANDX 0 PERILS(2) 782G BNZ 0 ZERR7 78G6 LDX 2 4 [X2-> AMONWORK AGAIN 78^Q LDX 0 TBPOINT(2) [IF THE PERLIST TABLES CAN ACCOMODATE 79FB BXGE 0 TTPOINT(2),ZENUF [ ANOTHER ENTRY,BRANCH 79^2 DOWN MONITOR,10 7=DL CALL 7 SWORK [ AND RELOCATE AMONWORK BLOCK 7=Y= ZENUF LDCH 5 6 7?CW SLL 5 12 7?XG SLL 6 3 7#C6 ANDX 6 HALFTOP 7#WQ ORX 6 5 [X6=B0-5TYPE B6-11UNIT NO B12-23 ZERO 7*BB ORX 6 TYPE(2) [X6 NOW IN FORMAT FOR INSERTION INTO 7*W2 [ AMONWORK TABLE 7B*L SMO FX2 7BT= LDX 0 ACOMMUNE2 7C#W BNG 0 TBEN [J IF UNIT NO NOT SPECIFIED - ENTRY 7CSG [ IN BOTTOM TABLE 7D#6 SMO TTPOINT(2) [OTHERWISE INSERT IN 7DRQ STO 6 PERLIST(2) [ TOP TABLE 7F?B LDN 0 1 7FR2 ADS 0 TTPOINT(2) [ ..AND UPDATE POINTER 7G=L BRN NXTPERL 7GQ= TBEN SMO TBPOINT(2) 7H9W STO 6 PERLIST(2) 7HPG LDN 0 1 7J96 SBS 0 TBPOINT(2) 7JNQ BRN NXTPERL 7K8B UNQUAL [EXECUTED IF ELEMENT WAS UNQUALIFIED 7KN2 LDN 1 TABLE1(1) [ BY A PERIPHERAL LIST 7L7L CALL 7 WHATTYPE 7LM= BRN ZERR2 [ERROR IF TYPE UNRECOGNISED 7M6W LDX 5 2(1) [GET MASK FOR RECOGNISED TYPE 7MLG FREECORE 3 [FREE CUNI BLOCK 7N66 CALL 7 SWORK [FIND AMONWORK BLOCK 7NKQ ORS 5 TAMON(2) [THIS TYPE MNTRG FOR SOME PERIPHERALS 7P5B ORS 5 TALL(2) [THIS TYPE MNTRG FOR ALL PERIPHERALS 7PK2 BRN NXTELE 7Q4L # 7QJ= # THIS ROUTINE TRANSFERS THE INFORMATION ABOUT MONITORING TO BE TURNED 7R3W # ON FROM THE AMONWORK BLOCK TO THE AMONCAT BLOCK,EXTENDING THIS BLOCK 7RHG # IF NECESSARY. 7S36 # ON ENTRY X4 -> AMONWORK BLOCK VALIDATED BY AWORK2 X1=FX1 X2=FX2 7SGQ # X3 -> CUNI TO BE FREED 7T2B # 7TG2 TURNON 7T^L FREECORE 3 7WF= RESTART [RE-ENTRY WHEN MERGE FRUSTRATED BY LACK OF CORE. 7WYW [ MUST HAVE X2=FX2 AND X4 OK FOR S/R SWORK 7XDG CALL 7 SWORK [FIND AMONWORK BLOCK 7XY6 LDX 0 TAMON(2) [ERROR IF NO MONITORING IS TO 7YCQ BZE 0 ZERR1 [ BE TURNED ON-SHOULD NEVER OCCUR 7YXB CALL 0 SMONBLKS [ X1-> PCA, X3-> AMONCAT 7^C2 BPZ 3 ZOK [IF NO AMONCAT BLOCK,CREATE ONE 7^WL SETNCORE ZCATL,3,APED,AMONCAT 82B= STOZ BPALL(3) [INITIALISE 'ALL PERS' WORD 82TW STOZ BTPOINT(3) [ AND POINTERS 83*G LDN 0 ZCATL+A1-1-BPTAB 83T6 STO 0 BBPOINT(3) 84#Q FPCACA 2 84SB LDX 5 2 85#2 CHAIN 3,2 [CHAIN AMONCAT BLOCK BEFORE PCA 85RL LDX 1 5 86?= CALL 7 SWORK 86QW ZOK LDX 0 TAMON(2) [X1->PCA X2->AMONWORK X3->AMONCAT 87=G ORS 0 AMON(1) [BIT -> MNTRG REQUD ON SOME PERIPHS 87Q6 LDX 0 TALL(2) 889Q ORS 0 BPALL(3) [BIT -> MNTRG REQUD ON ALL PERIPHS 88PB SMO FX2 8992 STO 2 AWORK3 89NL SMO FX2 8=8= STO 3 AWORK4 8=MW LDN 5 1 8?7G CALL 7 MERGE [MERGE TOP TABLES 8?M6 SMO FX2 8#6Q LDX 2 AWORK3 8#LB SMO FX2 8*62 LDX 3 AWORK4 8*KL NGN 5 1 8B5= CALL 7 MERGE [MERGE BOTTOM TABLES 8BJW BRN ZFINISH 8C4G # 8CJ6 # THE FOLLOWING ROUTINE IMPLEMENTS THE MONITOR COMMAND WHEN THE SECOND 8D3Q # PARAMETER IS DISPLAY,DELETE OR DISENGAGED.ENTER WITH X2=FX2, 8DHB # X3->CUNI CONTG MNTRG TYPE PARAMETER,X5=NO OF PARAMS-3 8F32 # 8FGL ZOLD1 BZE 7 ZDIS1 [J IF DISENGAGED 8G2= FPCACA 3,2 [FIND PCA 8GFW LDXC 0 AWORK1(2) 8G^G BCS ZOLD3 8HF6 NGN 0 1 8HYQ ERX 7 0 8JDB ANDS 7 AMON(3) [IF MONITOR OFF,ERASE RELEVANT BIT 8JY2 BRN ZFINISH 8KCL ZOLD3 ORS 7 AMON(3) [IF MONITOR ON,SET RELEVANT BIT 8KX= BRN ZFINISH 8LBW ZDIS1 LDX 0 ANUM(3) [MNTRG TYPE IS 'DISENGAGED' 8LWG SBN 0 10 8MB6 BNZ 0 ZERR2 [ ERROR IF NOT 10 CHARS 8MTQ LDX 1 FX1 8N*B LDX 0 XED(1) 8NT2 BXU 0 APARA+2(3),ZERR2 [ ...OR LAST TWO NOT 'ED' 8P#L CALL 7 ZPARAPASS [GET PERIPHERAL 8PS= NGX 0 ANUM(3) [ QUALIFIER 8Q?W BPZ 0 ZERR3 [ - ERROR IF MISSING 8QRG PERCONA [CONVERT TO TYPE/UNIT NO 8R?6 TESTREPNOT OK,ZERR10 8RD# ... LDEX 0 ACOMMUNE1(2) 8RKG ... BXGE 0 X64(1),ZERR5 [IN CASE MANY DA IN USE 8RQQ LDX 7 ACOMMUNE1(2) [B0-8 TYPE B9-23 UNIT NO (MK 6.5) 8S=B FPCACA 1,2 8SQ2 FINDOLP1 7,3,1,ZDIS2 8T9L LDX 5 A1+1(3) 8TP= ANDX 5 BITS22LS [GET DEVICE LIST PTR IN CASE ITS ON/L 8W8W BNG 1 ZDIS5 [J IF PERIPHERAL MARKED ONLINE IN PRB 8WNG SRL 7 15 8X86 SBN 7 5 8XMQ BNZ 7 ZDIS2 [J IF NOT MT - MUST BE REALLY OFFLINE 8Y7B LDX 0 ATMARK(1) 8YM2 SBN 0 2 8^6L BNZ 0 ZDIS2 [J IF AOLPT IS NOT PSEUDO OFFLINE MT 8^L= MTPTR 1,5 [ ELSE GET PTR TO ONLINE MT DEVICE LS 925W ZDIS5 NGNC 6 1 [X6=1 IF PERIPHERAL IS ONLINE 92KG ZDIS2 NGN 6 0 [X6=0 IF PRL OFFLINE OR UNALLOCATED 9356 LDXC 0 AWORK1(2) 93JQ BCS ZDIS7 [J IF TURNING MNTRG ON 944B BZE 6 ZFINISH [MN OFF:IGNORE IF PRL OFF/L OR UNALL 94J2 PERMOFF 5 [ OTHERWISE TURN MNTRE OFF 953L BRN ZFINISH 95H= ZDIS7 BZE 6 ZERR6 [MN ON:ILLEGAL IF PRL OFF/L OR UNALL 962W PERMON 5 [ OTHERWISE TURN MNTRG ON 96GG BRN ZFINISH 9726 # 97FQ # SUBROUTINES 97^B # 98F2 ZPARAPASS [ LINK X7 98YL SBX 7 FX1 [ X0 DESTROYED X1=FX1 X2=FX2 X3->CUNI 99D= PARAPASS [ X4-X6 UNCHANGED 99XW ADX 7 FX1 9=CG MHUNT 3,CPB,CUNI 9=X6 EXIT 7 0 9?BQ # 9?WB ZPARANUMB [ LINK X7 9#B2 SBX 7 FX1 [ X0 DESTROYED X1=FX1 X2=FX2 9#TL PARANUMB 3 [ X3=NO OF PARAMS IN HIGHEST CMULTI 9**= ADX 7 FX1 [ X4,5,6 UNCHANGED 9*SW EXIT 7 0 9B#G # 9BS6 SWORK [FINDS THE AMONWORK BLOCK 9C?Q LDX 0 AWORK2(2) [ON ENTRY X2=FX2,X4->AMONWORK?(PHOTO 9CRB TESTMOVE 0,SWOR1 [ IN AWORK2) 9D?2 PHOTO 0 [ON EXIT X2=X4->AMONWORK,AWORK2 9DQL STO 0 AWORK2(2) [ UPDATED,X0 DESTROYED 9F== MHUNTW 2,ADATA,AMONWORK 9FPW LDX 4 2 9G9G SWOR1 LDX 2 4 9GP6 EXIT 7 0 9H8Q # 9HNB SMONBLKS [FINDS PCA (X1) AND AMONCAT BLOCK(X3) 9J82 [ IF NO AMONCAT BLOCK X3 SET -1 9JML [ LINK X0,GEN6 DESTROYED 9K7= STO 0 GEN6 9KLW FPCACA 1,FX2 9L6G NGN 3 1 9LL6 LDX 0 AMON(1) 9M5Q ANDN 0 NMONBITS 9MKB BZE 0 SMON1 [J SINCE NO AMONCAT BLOCK 9N52 HUNT2 3,APED,AMONCAT,1 9NJL SMON1 BRN (GEN6) 9P4= # 9PHW SPLIT [SPLITS OUTER PARENTHESES OFF THE 9Q3G [ [X3]-TH PARAM AT ANALYSIS LEVEL 2 9QH6 [ AND SPLITS IT AT '&'.ONE CMULTI 9R2Q [ BLOCKS CREATED 9RGB SBX 7 FX1 9S22 LDN 1 2 9SFL PARALYSE #26,1,3 9S^= TESTREP UNPAIR,ZERR4 9T6D ...#UNS ANSTOOMANY 9T?L ... TESTREP2 TOOMANY,ZERR8 9TDW ADX 7 FX1 9TYG EXIT 7 0 9WD6 # 9WXQ UPDATE [THIS S/R TURNS OFF THE MONITORING INFO OF THE TOP OR 9XCB [BOTTOM TABLES OF THE AMONCAT BLOCK 9XX2 [ON ENTRY X3-> AMONCAT BLOCK,X5=+/-1 FOR TOP/BOT TABLES 9YBL [ X6=TURNOFF MASK 9YW= [ON EXIT X0,X2,X4 & GEN6 DESTROYED ; MOD([X2])=NO OF 9^*W [ NEW FREE WORDS CREATED 9^TG # =2*6 STO 3 GEN6 [REMEMBER ADDR OF AMONCAT BLOCK =2SQ BNG 5 UP1 =3#B LDX 4 BTPOINT(3) [COUNT OF TABLE ENTRIES =3S2 BZE 4 UP3 [EXIT IF NO ENTRIES IN TABLE =4?L LDN 3 BPTAB(3) [BASE OF TABLE =4R= BRN UP2 =5=W UP1 LDX 4 ALOGLEN(3) =5QG SBN 4 BPTAB-A1+1 =6=6 SBX 4 BBPOINT(3) [COUNT OF TABLE ENTRIES =6PQ BZE 4 UP3 [EXIT IF NO ENTRIES IN TABLE =79B ADX 3 ALOGLEN(3) =7P2 ADN 3 A1-1 [BASE OF TABLE =88L UP2 LDX 2 3 =8N= UP5 LDX 0 0(3) =97W ANDX 0 6 =9MG STO 0 0(2) ==76 ANDN 0 NMONBITS ==LQ BZE 0 UP4 [IF LAST ENTRY NULL,DONT STEP =?6B ADX 2 5 [ STORING PNTR =?L2 UP4 ADX 3 5 =#5L BCT 4 UP5 =#K= SBX 2 3 =*4W LDX 3 GEN6 =*JG BNG 5 UP6 [UPDATE BOTTOM TABLE PNTR =B46 ADS 2 BTPOINT(3) [ OR TOP ONE =BHQ EXIT 7 0 =C3B UP6 ADS 2 BBPOINT(3) =CH2 UP3 EXIT 7 0 =D2L # =DG= WHATTYPE [THIS S/R FINDS WHETHER 1ST 8 CHARS OF PARAMETER IN CUNI =D^W [BLOCK CORRESPOND TO A TABLE ENTRY =FFG [ ON ENTRY X1->TABLE ;X3-> CUNI BLOCK =F^6 [ ON EXIT - MATCH FOUND:X1->ENTRY,EXIT TO CALL+1 =GDQ [ OTHERWISE :X1=?,EXIT TO CALL =GYB LDX 6 ANUM(3) =HD2 ANDN 6 #7777 =HXL SBN 6 5 [ X6 -VE IF JUST 1 WD IN CUNI BLOCK =JC= LDX 0 0(1) =JWW STO 0 GEN6 [TABLE ENTRY LENGTH TO GEN6 =KBG ADN 1 1 =KW6 WSTEP LDX 0 0(1) =L*Q BZE 0 WEND [BRANCH IF END OF TABLE =LTB SBX 0 APARA(3) [IF NO MATCH WITH 1ST WD OF CUNI =M*2 BNZ 0 WNXT [ STEP DOWN TABLE =MSL LDX 0 ACES =N#= BNG 6 W2ND =NRW LDX 0 APARA+1(3) =P?G W2ND BXU 0 1(1),WEND [...OTHERWISE CHECK 2ND WORD =PR6 EXIT 7 1 [SUCCESS EXIT =Q=Q WNXT ADX 1 GEN6 =QQB BRN WSTEP =R=2 WEND EXIT 7 0 [FAIL EXIT =RPL # =S9= # =SNW # THIS SUBROUTINE UPDATES THE TABLES OF THE AMONCAT BLOCK BY THOSE OF =T8G # THE AMONWORK BLOCK =TN6 # ON ENTRY X2=AWORK3-> AMONWORK BLOCK ;X3=AWORK4-> AMONCAT BLOCK =W7Q # X5=+ OR - 1 FOR TOP OR BOTTOM TABLES =WMB # ON EXIT ALL ACCUMULATORS ARE DESTROYED & NO COORDINATION =X72 # IF THE AMONCAT BLOCK TURNS OUT TO BE TOO SMALL IT IS LENGTHENED AND =XLL # CONTROL PASSES TO LABEL RESTART AFTER RESETING X4 FOR S/R SWORK =Y6= # =YKW MERGE =^5G BNG 5 M1 [J IF MERGING BOTTOM TABLES =^K6 LDX 4 TTPOINT(2) [ SET X4=COUNT OF AMONWORK ENTRIES ?24Q LDX 6 BTPOINT(3) [ X6=COUNT OF AMONCAT ENTRIES ?2JB LDX 0 BBPOINT(3) ?342 ADN 2 PERLIST [ X2=BASE OF AMONWORK TABLE ?3HL ADN 3 BPTAB [ X3=BASE OF AMONCAT TABLE ?43= BRN M2 ?4GW M1 LDX 4 ALOGLEN(2) [IF MERGING BOTTOM TABLE SET ?52G SBN 4 PERLIST-A1+1 [ X4,X6,X2,X3 AS ABOVE ?5G6 SBX 4 TBPOINT(2) ?5^Q ADX 2 ALOGLEN(2) ?6FB ADN 2 A1-1 ?6^2 LDX 6 ALOGLEN(3) ?7DL SBN 6 BPTAB-A1+1 ?7Y= SBX 6 BBPOINT(3) ?8CW LDX 0 BTPOINT(3) ?8XG ADX 3 ALOGLEN(3) ?9C6 ADN 3 A1-1 ?9WQ M2 BZE 4 M3 [EXIT IF NOTHING TO MERGE ?=BB LDX 1 FX2 ?=W2 ADX 0 AWORK4(1) ??*L ADN 0 BPTAB ??T= ADX 0 5 ?##W STO 0 ACOMMUNE1(1) [ABS ADDR OF END OF 'OTHER' TABLE ?#SG STO 3 ACOMMUNE2(1) [BASE OF AMONCAT TABLE ?*#6 STO 6 ACOMMUNE3(1) [COUNT OF AMONCAT ENTRIES ?*RQ BZE 6 M4 ?B?B M7 LDX 0 0(2) ?BR2 ANDX 0 HALFTOP [TYPE/UNIT NO OF NEXT AMONWORK ENTRY ?C=L M6 LDX 1 0(3) ?CQ= ANDX 1 HALFTOP [TYPE/UNIT NO OF NEXT AMONCAT ENTRY ?D9W BXE 0 1,M5 [IF EQUAL,J TO UPDATE AMONCAT ENTRY ?DPG ADX 3 5 ?F96 BCT 6 M6 [ OTHERWISE CHECK NEXT AMONCAT ENTRY ?FNQ M4 SMO FX2 [NO MATCH IN ENTIRE AMONCAT TABLE : ?G8B BXE 3 ACOMMUNE1,M9 [ ROOM FOR NEW ENTRY? J IF NOT ?GN2 LDX 0 0(2) ?H7L STO 0 0(3) [INSERT NEW AMONCAT ENTRY ?HM= LDX 1 FX2 ?J6W LDN 0 1 ?JLG LDX 3 AWORK4(1) ?K66 BNG 5 M10 ?KKQ ADS 0 BTPOINT(3) [UPDATE AMONCAT PNTR IF TOP TABLE ?L5B BRN M11 ?LK2 M10 SBS 0 BBPOINT(3) [UPDATE AMONCAT PNTR IF BOT TABLE ?M4L M11 ADS 0 ACOMMUNE3(1) [UPDATE COUNT OF AMONCAT ENTRIES ?MJ= M8 LDX 3 ACOMMUNE2(1) [BASE OF AMONCAT TABLE ?N3W LDX 6 ACOMMUNE3(1) [COUNT OF AMONCAT ENTRIES ?NHG ADX 2 5 [STEP PNTR TO NEXT AMONWORK ENTRY ?P36 BCT 4 M7 [ AND J IF ANY MORE ENTRIES TO MERGE ?PGQ M3 EXIT 7 0 [ OTHERWISE EXIT ?Q2B M5 LDX 0 0(2) [UPDATE EXISTING AMONCAT ENTRY ?QG2 ORS 0 0(3) ?Q^L LDX 1 FX2 ?RF= BRN M8 ?RYW M9 DOWN MONITOR,11 ?SDG LDX 4 AWORK3(2) ?SY6 BRN RESTART ?TCQ # ?TXB #SKI K6MONITOR>1099-1099 ?WC2 ( ?WWL TESTOUT [OUTPUTS TO THE MONITORING FILE THE CONTENTS OF A BLOCK, ?XB= [IN OCTAL ON ENTRY X3->BLOCK ?XTW [ ON EXIT X1=FX1,X2=FX2,X0,3,4,5,6 DESTROYED ?Y*G [ COORDINATES. ?YT6 SBX 7 FX1 ?^#Q LOCK 3 ?^SB LDX 4 3 #2#2 LDX 5 ALOGLEN(3) #2RL ADN 5 A1+3 #3?= SRL 5 2 #3QW TE1 LDN 0 20 #4=G OUTBLOCK 0 #4Q6 LDN 6 4 #59Q TE2 OUTNUM 1-1(3),OCTAL #5PB BUX 3 £ #692 BCT 6 TE2 #6NL MONOUT IPLISTING #78= BCT 5 TE1 #7MW UNLOCK 4 #87G ADX 7 FX1 #8M6 EXIT 7 0 #96Q ) #9LB # ENTRY POINTS 10 & 11 ARE ENTERED BY THE SEGMENT ITSELF (CHEAP ACC. #=62 # DUMP) TO LENGTHEN THE AMONWORK AND AMONCAT BLOCKS RESPECTIVELY.IT IS #=KL # UNLIKELY THAT THE CODE WILL EVER BE EXECUTED #?5= # #?JW ZEP10 ##4G LDN 7 0 [K10/K11 SWITCH ##J6 MHUNTW 3,ADATA,AMONWORK #*3Q LDN 5 ZWORKX [LENGTH TO BE ADDED #*HB LDX 4 ALOGLEN(3) #B32 SBN 4 PERLIST-A1+1 #BGL SBX 4 TBPOINT(3) [X4=NO OF ENTRIES IN LOWER TABLE #C2= BRN XTND #CFW ZEP11 #C^G LDN 7 1 #DF6 CALL 0 SMONBLKS [ X1-> PCA, X3-> AMONCAT #DYQ LDN 5 ZCATX [LENGTH TO BE ADDED #FDB LDX 4 ALOGLEN(3) #FY2 SBN 4 BPTAB-A1+1 #GCL SBX 4 BBPOINT(3) [X4=NO OF ENTRIES IN LOWER TABLE #GX= XTND #HBW #SKI K6MONITOR>699-699 #HWG TRACE ALOGLEN(3),OLDLENG #JB6 LDX 6 ALOGLEN(3) #JTQ ADX 6 5 [INCREMENT OLD LOGICAL LENGTH #K*B ALTLEN 3,6 [ AND EXTEND BLOCK #KT2 BNZ 7 Z11 [RELOCATE AND UPDATE BOT POINTER #L#L MHUNTW 3,ADATA,AMONWORK #LS= ADS 5 TBPOINT(3) #M?W BRN XFOUND #MRG Z11 CALL 0 SMONBLKS [ X1-> PCA, X3-> AMONCAT #N?6 ADS 5 BBPOINT(3) #NQQ XFOUND #P=B #SKI K6MONITOR>699-699 #PQ2 TRACE ALOGLEN(3),NEWLENG #Q9L BZE 4 RETN [IF LOWER TABLE EMPTY,J TO GO UP #QP= ADX 3 ALOGLEN(3) [OTHERWISE SLIDE TABLE DOWN #R8W ADN 3 A1-1 [X3-> NEW TABLE BASE #RNG LDX 2 3 #S86 SBX 2 5 [X2-> OLD TABLE BASE #SMQ TRANS LDX 0 0(2) [SLIDE TABLE DOWN #T7B STO 0 0(3) #TM2 SBN 2 1 #W6L SBN 3 1 #WL= BCT 4 TRANS #X5W RETN UP #XKG # #Y56 # THERE NOW FOLLOW THE VARIOUS ERROR EXITS #YJQ # #^4B ZERR1A #^J2 FREECORE 3 *23L ZERR1 *2H= ZERR2 *32W LDN 3 MERM1 *3GG BRN MESS *426 ZERR3 *4FQ LDN 3 MERM3 *4^B BRN MESS *5F2 ZERR4 *5YL LDN 3 MERM4 *6D= BRN MESS *6XW ZERR5 *7CG LDN 3 MERM5 *7X6 BRN MESS *8BQ ZERR6 *8WB LDN 3 MERM6 *9B2 BRN MESS *9TL ZERR7 *=*= LDN 3 MERM7 *=F7 ... BRN MESS *=K4 ...ZERR8 *=N^ ... LDN 3 MERM8 *=SW MESS SMO FX1 *?#G LDX 7 0(3) *?S6 #SKI K6MONITOR<1100-1100 *#?Q ( *#RB COMERRX 7 **?2 ZFINISH **QL ZERR10 *B== ) *BPW #SKI K6MONITOR>1099-1099 *C9G ( *CP6 ERRORX 7 *D8Q ZERR10 *DNB LDN 7 0 *F82 BRN ZF1 *FML ZFINISH *G7= NGN 7 1 *GLW ZF1 LDX 2 FX2 *H6G FPCACA 3,2 *HL6 BNG 7 ZF2 *J5Q LDX 0 AMON(3) *JKB SLL 0 3 *K52 BPZ 0 ZF5 [J IF NOT MN ON,ERROR *KJL GEOERR 1,MONITOR *L4= ZF2 LDX 0 AMON(3) *LHW STO 0 AWORK1(2) *M3G SLL 0 2 *MH6 BPZ 0 ZF5 [J IF NOT MN ON,TEST *N2Q ZF3 LDX 3 FPTR(3) [LOOK FOR AMONCAT BLOCK *NGB BXE 3 FX2,ZF4 [ J IF ABSENT *P22 LDX 0 ATYPE(3) *PFL SRL 0 12 *P^= SBN 0 APED+AMONCAT *QDW BNZ 0 ZF3 *QYG CALL 7 TESTOUT *RD6 ZF4 LDX 7 AWORK1(2) *RXQ OUTNUM 7,OCTAL *SCB MONOUT JPRINTOUT *SX2 HUNTW 3,ADATA,AMONWORK *TBL BNG 3 ZF5 *TW= CALL 7 TESTOUT *W*W ZF5 *WTG ) *X*6 ENDCOM *XSQ # *Y#B MENDAREA 25 *YS2 #END ^^^^ ...30020514000500000000