(George Source)
Macros used: ALTLEN, BC, BITDEFS, BS, BSUJ, BXE, BXGE, BXL, BXU, CLOSETOP, COOR3, DOWN, DUMPINC, GEOERR, IFUJSTAT, INFORM, INFORMX, INSTPARA, JBC, JBS, JBSC, JBSS, JMBAC, LONGON, MBC, MBI, MBS, MENDAREA, MFREEW, MHUNTW, MONOUT, OPENINC, OPENMAS, OUTINCS, OUTMESS, OUTPACK, OUTPACKX, OUTPAR, OVER, REFORM, REFORMUL, RESET, RETURNA, SEG, SEGENTRY, SETNCORE, SETUPCORE, SLEEP, STARTACT, STEP, TRACE
22FL SEG BSUNJAM,83,PETER CAMPBELL,BSUNJ 22^= [ 23DW [ 23YG [ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 24D6 [ 24XQ [ 25CB #DEF Z=K6BSUNJAM>599-599 25X2 SEGENTRY K1BSUNJAM,X1BSUNJAM 26BL MASTER 12HMASTER [ NAME OF MASTER DIRECTORY 26W= SEGENTRY BSUJSW 27*W +0 [THIS IS A SWITCH WORD USED TO LIST 27TG [ STATISTICS IF NON-ZERO,BY ENTRY TO 28*6 [ BSUJSTAT SEGMENT 28SQ NFRES +4 [NO. OF WORDS PER RESIDENCE USED 29#B [IN FILE/FRESNUM BLOCK 29S2 #SKI IFS<1$1 2=?L ( 2=R= SMAPP 2?=W #HAL FILE+FMAPP,0 2?QG ) 2#=6 PARALT 12HFORMULA [INSTALLATION PARAMETER USED BY INSTP 2#PQ # THIS ROUTINE IS CALLED IN BY THE BACKING STORE 2*9B # ALLOCATION SYSTEM WHEN A CERTAIN PERCENTAGE OF ANY 2*P2 # BACKING STORE IS USED 2B8L [ 2BN= BITDEFS AWORK3,0,XBDESPDUMP,XBABJOBS,XBNONSPEC 2C7W BITDEFS AWORK3,22,XBDUMPED,XBNOTFIRST 2CMG [ AWORK3=0 IF FIRST PASS 2D76 [ B23 SET IF NOT FIRST PASS 2DLQ [ B0 SET IF UNJAMMER HAS DONE A 'DESPERATE'DUMP 2F6B [ B1 SET IF ABANDON JOBS MESSAGE HAS BEEN OUTPUT 2FL2 [ B2 SET IF A NON SPECIAL RESIDENCE JAMMED 2G5L [ AWORK4 CONTAINS NO.CLEANCTS SPENT WAITING FOR DIRECTORIES 2GK= [ 2H4W [ BEGINNING OF LOOP 2HJG [ 2J46 RETURNA 2JHQ BS 2,XBNOTFIRST 2K3B IFUJSTAT 2 [GO DOWN TO WRITE MAIN RECORD 2KH2 # X6 -VC IF ONLY SPECIAL RESIDENCES WERE JAMMED AT 2L2L # END OF LAST PASS - IN THIS CASE FORMULA SHOULD 2LG= # NOT BE RECALCULATED 2L^W TCCAO BNG 6 NRCAL 2MFG NGX 5 5 [ X5 := NO OF JAMMED RESIDENCES 2M^6 CALL 0 PMISC [ FIND FIRST BSLIST BLOCK 2NDQ BRN XNUMRES [ JUMP IF END OF CHAIN 2NYB ADN 5 1 [ ADD 1 FOR EACH RESIDENCE 2PD2 BRN NMISC [ FIND NEXT RES 2PXL XNUMRES 2QC= MHUNTW 1,FILE,INCUNJ 2QWW STO 5 ANOJAM(1) [ STORE NO OF UNJAMMED RES 2RBG LDX 2 FX2 2RW6 #SKI Z 2S*Q ( 2STB TRACE BSNDUMP(1),BSNDUMP 2T*2 TRACE BSLEFT(1),BSLEFT 2TSL ) 2W#= JBSC NODUMP2,2,XBDUMPED 2WRW LDX 0 BSNDUMP(1) [ NUMBER OF BLOCKS TO BE DUMPED 2X?G BXL 0 BSLEFT(1),NODUMP2 [ JUMP IF LESS THAN BLOCKS TO CLEAR J 2XR6 LDN 2 0 [ COUNT OF BLOCKS ONLINE 2Y=Q LDX 0 BSAB [ TYPE OF BSTB/BSLIST BLOCK 2YQB LDX 3 BMISC [ PICK UP BASE OF MISC CHAIN 2^=2 TODU1 LDX 3 FPTR(3) [ PICK UP NEXT BLOCK 2^PL BXE 3 CXMI,TODU2 [ JUMP IF END OF CHAIN 329= BXU 0 ATYPE(3),TODU1 [ JUMP IF NOT BSLIST 32NW LDX 4 BSLETH(3) [ JUMP IF SWAP FILE 338G BNG 4 TODU1 [ 33N6 ADX 2 BSTOT(3) [ ADD TOTAL SIZE OF RESIDENCE 347Q SBX 2 BSFREE(3) [ SUBTRACT FREE BLOCKS 34MB BRN TODU1 [ 3572 TODU2 SRL 2 2 [ DIVIDE SIZE OF ONLINE F/S BY 4 35LL BXL 2 BSNDUMP(1),TRYDP [ JUMP IF > 25% TO BE DUMPED 366= NODUMP2 36KW LDX 2 FX2 375G LDX 0 FORMULA 37K6 BNZ 0 NTDMP [GO ON UNJAMMING UNLESS DESPERATE 384Q [ 38JB [ IF THE UNJAMMERS FORMULA IS ZERO,THEN WE ONLY WANT TO DO A 3942 [ 'DESPERATE' DUMP ONCE.OTHERWISE ONLY DUMP WHEN FORMULA=ZERO IF 39HL [ THERE IS ENOUGH TO CLEAR THE JAM 3=3= [ 3=GW JBSS NDDMP,2,XBDESPDUMP 3?2G TRYDP 3?G6 #SKI K6BSUNJAM>99-99 3?^Q TRACE BSNDUMP(1),DUMPING 3#FB OUTPAR TIMENOW 3#^2 CALL 3 OPMESS [OUTPUT 'BACKING STORE JAM DUMPER 3*DL +BSJDUM [ STARTED' 3*Y= +3 [TO ALL CONSOLES 3BCW DUMPINC [SET THE DUMPER GOING 3BXG BS 2,XBDUMPED 3CC6 LDN 6 0 3CWQ IFUJSTAT 3 3DBB BRN NRCAL 3DW2 NDDMP JBSS NABAN,2,XBABJOBS 3F*L CALL 3 OPMESS [OUTPUT 'ABANDON JOBS' 3FT= +BSABAN 3G#W +1 [TO CENTRAL CONSOLE 3GSG NTDMP 3H#6 NABAN 3HRQ LDN 6 1 3J?B IFUJSTAT 3 [ APPEND FILE/INCUNJ TO STSTS FILE 3JR2 BRN NRCAL 3K=L X1BSUNJAM 3KQ= OUTPAR DATENOW,TIMENOW 3L9W OUTPACK GMTNOW,1,NUMA 3LPG CALL 3 OPMESS [OUTPUT 'BACKING STORE JAM' 3M96 +BACJAM 3MNQ +3 [TO ALL RESIDENCES 3N8B SEGENTRY K10BSUNJAM 3NN2 BRN NOFF 3P7L # 3PM= # OUTPUT 'PARAMETERS FOR FILE FORMULA ARE X1,X2,X3,X4' 3Q6W # 3QLG LDN 4 BSUJFORM1 3R66 LDN 5 1 3RKQ LDN 6 JPDNUMA 3S5B CALL 7 PACKMESS 3SK2 LDN 4 BSUJFORM2 3T4L CALL 7 PACKMESS 3TJ= LDN 4 BSUJFORM3 3W3W CALL 7 PACKMESS 3WHG LDN 4 BSUJFORM4 3X36 CALL 7 PACKMESS 3XGQ MONOUT BSFFPARS 3Y2B BRN NNOFF 3YG2 SEGENTRY K11BSUNJAM 3Y^L NOFF MONOUT BSFFNORM [STANDARD FORMULA 3^F= NNOFF LDX 7 BSUJSW(1) [PICK UP SWITCH 3^YW IFUJSTAT 1 [ TRY TO OPEN STATS FILE ,TURN OFF SW 42DG [ IF UNSUCCESSFUL 42Y6 # CARRY OUT A MISC CHAIN SEARCH TO FIND OUT THE NUMBER OF 43CQ # ONLINF RESIDENCES DURING THIS JAM. 43XB # THIS VALUE IS STORED IN IRESNUM OF THE INCUNJ BLOCK 44C2 LDN 5 0 44WL CALL 0 PMISC [FIND NEXT RESIDENCE 45B= BRN XOUT [EXIT FOR END OF CHAIN 45TW ADN 5 1 46*G BRN NMISC 46T6 XOUT 47#Q LDX 4 5 47SB SETNCORE 8,2,FILE,INCUNJ 48#2 STO 4 IRESNUM(2) [NUMBER OF RESIDENCES IN X4 48RL LDN 6 4 49?= MPY 4 6 [ALLOW FOUR WORDS PER RES 49QW ADN 5 1 [PLUS ONE FOR REC HEDDR 4==G SETUPCORE 5,3,FILE,FRESNUM 4=Q6 SBN 5 2 4?9Q STOZ A1+1(3) 4?PB LDN 1 A1+1(3) 4#92 LDN 2 1(1) 4#NL SMO 5 4*8= MOVE 1 0 4*MW # ZEROISE WORDS IN FILE,FRESNUM 4B7G SETNCORE 6,1,FILE,FLOCNB 4BM6 SETNCORE 4,3,FILE,FABSNB 4C6Q LDN 0 4 4CLB STO 0 A1(3) 4D62 ADN 3 A1+1 4DKL LDN 2 MASTER(1) 4F5= MOVE 2 3 4FJW NRCAL 4G4G MHUNTW 2,FILE,INCUNJ 4GJ6 [ 4H3Q [ START OF MAIN LOOP 4HHB [ 4J32 TINCUJ 4JGL #SKI K6BSUNJAM>99-99 4K2= ( 4KFW TRACE CLEANCT,BSU ENT 4K^G TRACE FORMULA,FORMULA 4LF6 ) 4LYQ LDN 0 8 4MDB STO 0 INREC(2) 4MY2 STOZ INREC+2(2) 4NCL LDN 0 INREC+2(2) 4NX= LDN 1 ANOJAM(2) 4PBW MOVE 0 5 4PWG # CARRY OUT A MISC CHAIN SEARCH TO DETERMINE WHICH 4QB6 # RESIDENCES ARE ABOVE THRESHOLD ANM/OR JAMMED 4QTQ # FRESNUM HOLDS 4 WORD ENTRIES PER RESIDENCE 4R*B # 1ST =RESIDENCE NUMBER 4RT2 # 2ND = STATE WORD 4S#L # 3RD = NO. OF FILES THROWN OFF 4SS= # 4TH = SIZE OF FILES THROWN OFF 4T?W MHUNTW 3,FILE,FRESNUM 4TRG STOZ FRREC(3) 4W?6 LDN 1 0 [USE X1 TO HOLD NUM. OF JAMMED 4WQQ [RESIDENCES 4X=B CALL 0 PMISC [FIND NEXT RESIDENCE 4XQ2 RESET BRN TOUT [EXIT FOR END O CHAIN 4Y9L BC 2,BSLTHRESH [ CLEAR YHRESHOLD BIT IF SET 4YP= LDX 4 BACK1(2) 4^8W STO 4 FRNUM(3) [INSERT RESUDENCE NUMBERS 4^NG JBS ZHARDJAM,2,BSLJAM [ JUMP IF JAM BIT SET 5286 LDX 5 BSFREE(2) 52MQ BNG 5 ZHARDJAM [MUST BE JAMMED 537B BXGE 5 BSTHRESH(2),NSET [J IF NOT ABOVE THRESHOLD 53M2 BS 2,BSLTHRESH [ SET THRESHOLD BIT 546L ZHARDJAM 54L= LDCT 4 #600 [PRESERVE B0/B1 555W ANDS 4 FRSTATE(3) 55KG BS 3,BFTHRESH 5656 JBC NOSET,2,BSLJAM 56JQ ZJAM ADN 1 1 [INCREASE NO. OF JAMMED RESIDENCES 574B MBI 3,BFJAM,BFTHRESH [ SET JAM UNSET THRESHOLD BITS 57J2 BRN NOSET 583L NSET STOZ FRSTATE(3) 58H= NOSET 592W #SKI Z 59GG ( 5=26 TRACE FRNUM(3),RESNUM 5=FQ TRACE FRSTATE(3),RESTATE 5=^B ) 5?F2 STOZ FRNTOFF(3) 5?YL STOZ FRSTOFF(3) 5#D= MHUNTW 3,FILE,FRESNUM 5#XW SMO FX1 5*CG LDX 0 NFRES 5*X6 ADS 0 FRREC(3) 5BBQ ADX 3 FRREC(3) 5BWB SMO FX1 5CB2 LDN 0 RESET [RESTORE LINK ADDRESS TO PMISC 5CTL BRN NMISC 5D*= TOUT 5DSW LDX 6 1 [X1->X6 WHILE MESSAGES OUTPUT 5F#G LDX 2 FX2 5FS6 JBS NOSTAT4,2,XBNONSPEC 5G?Q IFUJSTAT 4 5GRB NOSTAT4 5H?2 #SKI Z 5HQL TRACE 6,TOTJRES 5J== CALL 3 OUTMESS [JAM ON RESIDENCE . . . 5JPW +0 5K9G +BSJAMRES 5KP6 BRN NOSPEC1 [EXIT 3 3 IF A SPEC RES JAMMED 5L8Q [EXIT 3 2 IF NO SPEC RES JAMMED 5LNB CALL 3 OUTMESS [CC AO ON RESIDENCE . . . 5M82 +4 5MML +BSSPECRES 5N7= BRN NOSPEC1 [EXIT 3 2 IF BOTH TYPES OR RES JAMME 5NLW [EXIT 3 3 - ONLY SPEC RES JAMMED 5P6G LDN 5 0 5PL6 BRN NOSPEC2 5Q5Q NOSPEC1 5QKB LDCT 5 #400 5R52 NOSPEC2 5RJL MHUNTW 2,FILE,INCUNJ 5S4= OPENINC ,READ [OPEN INCINDEX 5SHW LDN 6 0 5T3G RINC STEP [READ NEXT RECORD 5TH6 BZE 3 OVER [LAST RECORD 5W2Q LDX 6 AINCNO-A1(3) [HIGHEST INC.NO 5WGB JBS REDUMP,3,BIREDUMPR 5X22 LDX 2 AMTSR(3) [ NO TAPES ? 5XFL BZE 2 REDUMP [ NO NOT WRONGED TAPES 5X^= NEXTTAPE 5YDW JMBAC RINC,3,BMUSWRR,BMOPWRR [ AT LEAST ONE TAPE OK ! 5YYG ADN 3 2 5^D6 BCT 2 NEXTTAPE [ LOOK AT NEXT TAPE 5^XQ # 62CB # ALL TAPES WRONGED 62X2 # 63BL REDUMP 63W= LDX 4 6 [NO OF THIS INCREMENT 64*W #SKI Z 64TG ( 65*6 TRACE AINCSTATE-A1(3),UNRINCST 65SQ TRACE 4,UNRINC 66#B ) 66S2 CALL 1 NUMINC 67?L BRN RINC 67R= OVER MHUNTW 3,FILE,INCUNJ 68=W ADN 6 1 68QG SMO A1(3) 69=6 STO 6 A1-1(3) [LATEST INC.NO+1 69PQ CLOSETOP [INCINDEX 6=9B BZE 5 SPECS 6=P2 BNG 5 NOSPEC 6?8L GEOERR 1,FORTEST 6?N= # ONLY SPECIAL RESIDENCES ARE JAMMED 6#7W # 6#MG SPECS 6*76 LDX 5 ASYSTEMMESS [IP MESSAGETIME 6*LQ LDN 1 FONINTP 6B6B DVS 4 1 6BL2 SLEEP 6C5L COOR3 #62 [SLEEP THE LENGTH OF MESSAGETIME 6CK= CALL 0 PMISC [UNLESS A NON SPECIAL TES JAMMED 6D4W BRN NDOZE 6DJG LDX 1 BACK1(2) [IF SPECIAL RES -CAN 6F46 SBN 1 48 [SLEEP A LITTLE LONGER 6FHQ BPZ 1 NDOZE 6G3B ANDN 4 #4000 6GH2 BZE 4 NMISC 6H2L LDX 2 FX2 6HG= BS 2,XBNOTFIRST 6H^W BRN NRCAL [RESET X2 6JFG NDOZE 6J^6 BCT 5 SLEEP 6KDQ LDCT 3 #400 6KYB BRN SONLY 6LD2 # 6LXL NOSPEC 6MC= CALL 3 OUTMESS [ABOVE THRESHOLD ON RES . . . 6MWW +1 6NBG +BSTHRESHR 6NW6 JBS PASS2,2,XBNONSPEC 6P*Q REFORMUL 6PTB SMO FX2 6Q*2 STO 6 AWORK2 [ SAVE VALUE OF FORMULAFROM 1ST PASS 6QSL BRN NEWF 6R#= PASS2 JBC NODUMP,2,XBDUMPED 6RRW [ IF DUMPER WAS STARTED ON LAST PASS LEAVE FORMULA UNC 6S?G BRN ZDUMPED 6SR6 NODUMP REFORM 6T=Q NEWF STO 6 FORMULA [CHANGE VALUE IN CORE 6TQB OUTPACK FORMULA,1,NUMA [OUTPUT WORKING VALUE OF FORMULA 6W=2 CALL 3 OPMESS [OUTPUT MESSAGE TO CONSOLE 6WPL +BSUFORM 6X9= +1 6XNW ZDUMPED 6Y8G #SKI Z 6YN6 TRACE 0(3),BEGINMAS 6^7Q OPENMAS XBRK,GENERAL 6^MB [ 7272 [ DOWN TO BSPRUNE FOR FILESTORE PASS 72LL [ 736= DOWN BSPRUNE,1 73KW [ 745G [ 74K6 [ 754Q LDX 0 ACOMMUNE1(2) 75JB STO 0 AWORK4(2) [PRESERVE CLEANCT TOTAL 7642 #SKI Z 76HL TRACE 0,DIRWTIM 773= MASTL CLOSETOP [CLOSE MASTER 77GW BS 2,XBNONSPEC 782G LDN 3 0 78G6 SONLY CALL 0 PMISC [FIND NEXT RESIDENCE 78^Q SRSET BRN SOUT [EXIT IF END OF CHAIN 79FB MHUNTW 1,FILE,FRESNUM 79^2 NERES 7=DL LDX 0 FRNUM(1) 7=Y= BXE 0 BACK1(2),THRES [J IF FOUND RIGHT RESIDENCE 7?CW SMO FX1 7?XG ADX 1 NFRES [STEP ON TO NEXT RESIDENCE 7#C6 BRN NERES 7#WQ THRES LDX 5 BSFREE(2) [NO. OF BLOCKS LEFT 7*BB BNG 5 SJAM [STILL IN HARD JAM 7*W2 JBC NJAM,2,BSLJAM [ JUMP IF WASNT JAMMED 7B*L BXL 5 BSJAML(2),SJAM [ STILL JAMMED - ADD INTO BSLEFT 7BT= BXL 5 BSTHRESH(2),NTHRESH [WAS JAMMED- STILL ABOVE THRESHOLD 7C#W MBC 2,BSLJAM,BSLTHRESH [ WAS JAMMED-NOW BELOW THRESHOLD-CLEA 7CSG [ THRESHOLD BITS 7D#6 BS 1,BFTHRESHCL 7DRQ BRN SNEXT 7F?B NTHRESH 7FR2 # WAS JAMMED BUT STILL ABOVE THRESHOLD- UNSET JAM MARKER 7G=L # ONLY IN BSLETH AND SET B21 OF STATEWD 7GQ= BC 2,BSLJAM 7H9W BS 1,BFJAMCL 7HPG BRN SNEXT 7J96 SJAM 7JNQ LDX 4 BSJAML(2) [JAM LIMIT 7K8B SBX 4 BSFREE(2) [ - NO. OF BLOCKS LEFT 7KN2 BNG 4 SNEXT 7L7L LDX 5 BACK1(2) [DONT ADD INTO BSLETH IF FILE 7LM= SBN 5 48 [ON A SPECIAL RESIDENCE 7M6W BPZ 5 WRES 7MLG MHUNTW 1,FILE,INCUNJ 7N66 ADS 4 BSLEFT(1) [BLOCKS INTO JAM TO BSLEFT 7NKQ WRES 7P5B ADN 3 1 [INCREASE NUMBER OF UNITS STILL JAMME 7PK2 BRN SNEXT [PICK UP NEXT FPTR 7Q4L NJAM JBC SNEXT,1,BFTHRESH 7QJ= BXL 5 BSTHRESH(2),SJAM [STILL ABOVE THRESH - LEAVE IT - 7R3W [BUT FIRST CHECK IT HASNT JAMMED 7RHG # NOW BELOW THRESHOLD - UNSET THRESHOLD BIT 7S36 BC 2,BSLTHRESH 7SGQ BS 1,BFTHRESHCL 7T2B SNEXT SMO FX1 7TG2 LDN 0 SRSET [RESET LINK ADDRESS FOR PMISC 7T^L BRN NMISC 7WF= # 7WYW SOUT LDX 6 3 [NO. OF JAMMED UNITS- B0 SET IF 7XDG [FROM CC AO MESSAGE 7XY6 CALL 3 OUTMESS [JAM CLEARED ON RES . . . 7YCQ +2 7YXB +BSJAMCL 7^C2 LDEX 5 6 7^WL BNZ 5 STILJAM [J IF NOT END OF JAM 82B= MHUNTW 3,FILE,INCUNJ [PREPARE FILE/INCUNJ FOR 82TW LDN 0 8 [BSUPTHRESH MESSAGE 83*G STO 0 INREC(3) 83T6 STILJAM 84#Q BNG 6 PCCAO 84SB CALL 3 OUTMESS [RES . . . CLEARED BELOW THRESHOLD 85#2 +3 85RL +BSTHRESHCL 86?= PCCAO 86QW #SKI K6BSUNJAM>99-99 87=G TRACE CLEANCT,BSU END 87Q6 #SKI Z 889Q ( 88PB TRACE 6,STILJAMD 8992 TRACE 0,CLCTEND 89NL ) 8=8= IFUJSTAT 4 8=MW LDEX 5 6 [IGNORE B0 IF SET 8?7G # 8?M6 # 8#6Q BNZ 5 RETURNA 8#LB [ JAM CLEARED 8*62 IFUJSTAT 5 8*KL OUTPAR TIMENOW 8B5= CALL 3 OPMESS [OUTPUT'BACKING STORE JAM CLEARED' 8BJW +BSJCL 8C4G +3 [TO ALL CONSOLES 8CJ6 CALL 3 OPPMESS [RESIDENCE%A %B NOW ABOVE THREXHOLD 8D3Q +5 8DHB +BSUPTHRESH 8F32 LDX 2 FX2 8FGL JBC NOUPD,2,XBNONSPEC 8G2= LDX 6 AWORK2(2) [PICK UP VALUE FROM 1ST PASS 8GFW CALL 3 NEWFORM [ CHANGE VALUE IN PARAMINDEX 8G^G OPENMAS XBRK,GENERAL 8HF6 LDX 0 GMTNOW 8HYQ #SKI IFS 8JDB MASFCB 3 8JY2 #SKI IFS<1$1 8KCL LDX 3 BFILE [MASTERS FCB 8KX= STO 0 FLASTJAM(3) [CURRENT GMT 8LBW MBS 3,BFALTB,BFALTR [SET FILE BEING ALTERED BITS 8LWG #SKI IFS 8MB6 SFMAPP 3,3,XBRK 8MTQ #SKI IFS<1$1 8N*B ( 8NT2 NMAPP 8P#L LDX 3 FPTR(3) [SERCH FILE CHAIN FOR F/FMAPP 8PS= LDX 4 ATYPE(3) 8Q?W BXE 4 FILEPLUSFCB,XBRK [GEOERR IF NO F/FMAPP 8QRG BXU 4 SMAPP(1),NMAPP 8R?6 ) 8RQQ [ X3 NOW POINTS TO MASTERS F/FMAPP BLOCK 8S=B LDN 0 3 8SQ2 STO 0 FBCOMM(3) [REQUIRED IN UPDATING MASTER 8T9L CLOSETOP 8TP= NOUPD 8W8W MFREEW FILE,FABSNB 8WNG MFREEW FILE,FLOCNB 8X86 MFREEW FILE,FRESNUM 8XMQ MFREEW FILE,INCUNJ 8Y7B CALL 0 PMISC [TEST TO SEE IF A NEW JAM 8YM2 BRN NOMOREJAMS [END OF BSLIST 8^6L ANDN 4 #4000 8^L= BNZ 4 NUJAM [ JUMP IF JAM MARKER IN BSLETH SET 925W BRN NMISC [NO. SO LOOK AT NEST RESIDECE 92KG NOMOREJAMS 9356 LONGON #21 [WAKE UP ACTS WAITING FOR END BSJAM 93JQ [E.G.MK3 PROCESSOR 944B STARTACT RET [KICK D.T. SCHEDULER 94J2 NOSTARTACT 953L COOR3 #11 [SET WAITING FOR NEXT JAM 95H= NUJAM 962W LDX 2 FX2 96GG STOZ AWORK3(2) [SET'NEW JAM' 9726 BRN K1BSUNJAM [NEW JAM HAS OCCURRED 97FQ # 97^B XBRK GEOERR 1,BRK BSUJ [BREAKIN 98F2 # 98YL # SUBROUTINE TO SEND MESSAGE TO CONSOLE 99D= # 99XW OUTMESS 9=CG MHUNTW 1,FILE,INCUNJ 9=X6 LDX 5 IRESNUM(1) [NUMBER OF ONLINE RESIDENCES 9?BQ ADN 5 2 [INCLUDE 1 FOR REC HEDDR 9?WB [AND ANOTHER FOR A1+1 (NOT USED) 9#B2 SBX 3 FX1 9#TL SETUPCORE 5,2,FLIB,FLINC 9**= ADX 3 FX1 9*SW LDN 0 1 9B#G STO 0 A1(2) [SET UP REC HEDDR FOR FLINC 9BS6 LDN 5 0 9C?Q MHUNTW 1,FILE,FRESNUM 9CRB ADX 2 A1(2) [INCREASE POINTER FOR F/FLINC 9D?2 NRESN 9DQL LDX 0 0(3) [PICK UP FIRST PARAMETER OF CALL 9F== BZE 0 XJAMRES [JAM ON RESIDENCE 9FPW SBN 0 1 9G9G BZE 0 XTHRESHR [ABOVE THRESHOLD 9GP6 SBN 0 1 9H8Q BZE 0 XJAMCL [JAM CLEARED 9HNB SBN 0 1 9J82 BZE 0 XTHRESHCL [CLEARED BELOW THRESHOLD 9JML BRN XJAMRESCCAO [CC AO MESSAGE WITH X0=1 9K7= TRES 9KLW LDX 4 FRNUM(1) [INSERT RESNUM INTO F/FLINC 9L6G STO 4 A1+1(2) 9LL6 MHUNTW 2,FLIB,FLINC 9M5Q LDN 0 1 9MKB ADS 0 A1(2) [INCREASE POINTER IN F/FLINC 9N52 ADX 2 A1(2) [AND UPDATE X2 9NJL NSUIT 9P4= MHUNTW 1,FILE,FRESNUM 9PHW ADN 5 4 9Q3G BXE 5 FRREC(1),RESEN [J IF END OF SEARCH 9QH6 ADX 1 5 [UPDATE F/FRESNUM POINTER BY 4 9R2Q BRN NRESN [LOOK AT NEXT RES NUMBER 9RGB # 9S22 # FINALLY OUTPUT MESSAGE 9SFL # 9S^= RESEN 9TDW MHUNTW 2,FLIB,FLINC 9TYG LDX 5 A1(2) [CHECK IF ANY VALUES TO O/P 9WD6 SBN 5 1 9WXQ BZE 5 NOMESS [DONT BOTHER WITH MESSAGE IF NOT 9XCB LDX 4 1(3) [PICK UP UNIVERSAL IDENTIFIER 9XX2 SBX 3 FX1 9YBL OUTINCS [SET UP OUTPARAM FOR O/P 9YW= SMO FX2 9^*W STO 7 AWORK1 [PRESERVE STATS SWITCH 9^TG LDN 7 0 [MESSAGE TO CENTRAL CONSOLE =2*6 INFORMX 7,4,1 =2SQ ADX 3 FX1 [RESTORE CALL ADDRESS =3#B LDX 7 AWORK1(2) [RESTRORE STATS SWITCH =3S2 NOMESS =4?L LDX 4 0(3) =4R= BZE 4 PDEAL [CHECK IF NEED TO DEALLOCATE =5=W SBN 4 4 =5QG BZE 4 SRES [J IF COME FROM CCAO MESSAGE =6=6 NORMAL =6PQ MFREEW FLIB,FLINC =79B EXIT 3 2 [NORMAL EXIT =7P2 PDEAL BPZ 6 NORMAL [NO NEED TO DEALLOCATE =88L [ - EXIT NORMALLY =8N= SPECONLY =97W MFREEW FLIB,FLINC =9MG EXIT 3 3 ==76 SRES LDEX 0 6 [DONT NEED B0 ==LQ BXE 0 5,SPECONLY [ONLY SPEC RES JAMMED =?6B BRN NORMAL [NORMAL EXIT DO UNJAM PASS =?L2 # =#5L # =#K= # SETS B20 - JAM ON RESIDENCE. . . =*4W [ =*JG [ =B46 XJAMRES [JAM ON RESIDENCES =BHQ JBC NSUIT,1,BFJAM [ IF NOT JAMMED LOOK AT NEXT RESIDENC =C3B LDX 4 FRNUM(1) [ RESIDENCE NUMBER =CH2 SBN 4 48 =D2L BNG 4 NSPECJ [ JUMP IF NOT SPEC RES =DG= LDCT 4 #400 [ IF SPEC RES SET BIT 0 IN X2 =D^W ORS 4 6 =FFG NSPECJ =F^6 JBSS NSUIT,1,BFJAMOP [ IF MESSAGE ALREADY OUTPUT DONT REPE =GDQ BRN TRES [ INSERT RES NO =GYB [ =HD2 [ =HXL XTHRESHR [ ABOVE THRESHOLD ON RES =JC= JBC NSUIT,1,BFTHRESH [ DONT OUTPUT MESSAGE IN NOT ABOVE TH =JWW JBSS NSUIT,1,BFTHRESHOP [ OR IF MESSAGE ALREADY OUTPUT =KBG BRN TRES =KW6 [ =L*Q [ =LTB XJAMCL [ JAM CLEARED ON RESIDENCE =M*2 JBC NSUIT,1,BFJAM [ JUMP IF IT WASNT JAMMED =MSL JMBAC NSUIT,1,BFJAMCL,BFTHRESHCL [ =N#= MBC 1,BFJAMOP,BFTHRESHOP [ CLEAR MESSAGE OUTPUT BITS =NRW BRN TRES =P?G [ =PR6 [ =Q=Q XTHRESHCL =QQB JMBAC NSUIT,1,BFJAM,BFTHRESH,BFTHRESHCL =R=2 JBS THRESHB,1,BFTHRESHCL =RPL LDEX 4 6 =S9= BNZ 4 NSUIT [ =SNW LDX 4 FRNUM(1) [ =T8G CALL 1 NUMINC [ INSERT RES NO IN INCUNJ =TN6 MHUNTW 2,FLIB,FLINC =W7Q ADX 2 A1(2) [ RESET POINTER TO FLIB FLINC =WMB BRN NSUIT =X72 THRESHB =XLL MBC 1,BFJAMOP,BFTHRESHOP =Y6= BRN TRES =YKW [ =^5G [ =^K6 XJAMRESCCAO ?24Q JBC NSUIT,1,BFJAM ?2JB LDX 4 FRNUM(1) ?342 SBN 4 48 ?3HL BPZ 4 TRES ?43= BRN NSUIT ?4GW [ ?52G [ ?5G6 OPMESS ?5^Q LDX 1 0(3) [ADDRESS OF MESSAGE ?6FB LDX 5 1(3) [ROUTING PARAMETER ?6^2 SBX 3 FX1 ?7DL INFORMX 5,1,1 ?7Y= ADX 3 FX1 ?8CW EXIT 3 2 ?8XG OPPMESS ?9C6 MHUNTW 2,FILE,INCUNJ ?9WQ LDN 4 INREC(2) [FIND OUT THE NUMBER OF RESIDENCES ?=BB ADX 4 INREC(2) [STILL ABOVE THRESHOLD ?=W2 SBN 4 INCUNR(2) ??*L SBX 3 FX1 ??T= SETUPCORE 4,2,FLIB,FLINC [AND SET UP FLINC FOR THEM ?##W ADX 3 FX1 ?#SG SBN 4 1 ?*#6 STO 4 A1(2) [REMEMBER A1+1 IN FLINC ?*RQ SBN 4 1 ?B?B BZE 4 NORMAL ?BR2 ADN 2 A1+2 ?C=L MHUNTW 1,FILE,INCUNJ ?CQ= ADN 1 INCUNR+1 ?D9W SMO 4 ?DPG MOVE 1 0 ?F96 BRN RESEN ?FNQ # ?G8B # NUMINC IS USED AT THE START OF THE PASS TO INSERT ?GN2 # UNRELIABLE INCREMENT NUMBERS INTO FILE/INCUNJ BLOCK ?H7L # ALSO USED AT END OF JAM TO HOLD NUMBERS OF ANY ?HM= # RESIDENCES STILL ABOVE THRSHOLD ?J6W # ?JLG NUMINC ?K66 SBX 3 FX1 ?KKQ SBX 1 FX1 ?L5B LDX 2 FX2 ?LK2 STO 3 ACOMMUNE2(2) ?M4L STO 1 ACOMMUNE1(2) [TEMP STORAGE FOR LINK ADDRESS ?MJ= MHUNTW 3,FILE,INCUNJ ?N3W SMO INREC(3) [STORE NUMBER IN ?NHG STO 4 INREC-1(3) [NEXT WORD OF INCUNJ ?P36 LDN 0 1 ?PGQ ADS 0 INREC(3) [INCREASE INCUNJ REC HEDDR. ?Q2B LDX 4 INREC(3) ?QG2 BXL 4 ALOGLEN(3),NUFF ?Q^L ALTLEN 3,4,FILE,INCUNJ [INCREASE INCUNJ LENGTH ?RF= NUFF LDX 1 ACOMMUNE1(2) [RESTORE LINKS IN X3 & X1 ?RYW ?SDG LDX 3 ACOMMUNE2(2) ?SY6 ADX 3 FX1 ?TCQ ADX 1 FX1 ?TXB EXIT 1 0 ?WC2 # ?WWL # S/R PICKS UP NEXT BSLIST BLOCK ?XB= # EXIT 0 0 IF END OF CHAIN ?XTW # EXIT 0 1 IF SUITABLE RESIDENCE FOUND ?Y*G # ?YT6 PMISC LDN 2 BMISC ?^#Q LDX 6 BSAB [HAMTYPE OF BSLIST BLOCK ?^SB NMISC LDX 2 FPTR(2) [NEXT BLOCK IN CHAIN #2#2 BXE 2 CXMI,NOUT [END OF CKAIN? #2RL BXU 6 ATYPE(2),NMISC [NOT A BSLIST BLOCK #3?= LDX 4 BSLETH(2) #3QW BNG 4 NMISC [J IF SWAP FILE #4=G EXIT 0 1 #4Q6 NOUT EXIT 0 0 #59Q # #5PB # S/R TO ALTER VALUE OF FORMULA #692 # IN CORE AND ON B.S. IF GMT NOT ZERO #6NL # OR JUST IN CORE IF ZERO #78= # #7MW NEWFORM #87G SMO FX1 #8M6 LDN 4 PARALT #96Q SBX 3 FX1 #9LB INSTPARA XBRK,4,6,OVERL #=62 NWLIM #=KL ADX 3 FX1 #?5= EXIT 3 0 #?JW OVERL ##4G OUTPACK 6,1,NUMA [PICK UP VALUE OF FORMULA ##J6 INFORM 1,BSLIMIT,1 #*3Q BRN NWLIM #*HB # S/R FOR PARAMETERS FOR FILE FORMULA MESSAGE #B32 PACKMESS #BGL SBX 7 FX1 #C2= OUTPACKX 4,5,6 #CFW ADX 7 FX1 #C^G EXIT 7 0 #DF6 MENDAREA 20,K99BSUNJAM #DYQ #END ^^^^ ...042113120002