(George Source)
Macros used: ACROSS, ALTLEN, BITDEFS, BS, BXE, BXGE, BXL, BXU, CLOSETOP, DATECON, DOWN, FREECORE, FSHENTRY, GEOERR, IDENTITY, IPBACKJAM, IPCONT, IPUSEX, JBC, JBS, JBSC, JBSS, MBC, MBS, MENDAREA, MFREE, MHUNT, MHUNTW, MONOUT, MONOUTX, OPENSYS, OUTBLOCN, OUTNUM, OUTPACK, OUTPARAM, REWIND, SEG, SEGENTRY, SETNCORE, STEP, STEPAGAIN, STEPREWRITE, SYNTHMON, TABRN, TIMECON, TRACE, UNSET, UP
22FL #LIS K0SETUPARA>K0ALLGEO 22^= ... SEG SETUPARA,84,OWEN N JOHN(:CENT) 2394 ...[ 23DW ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983 23NN ...[ 23YG [ 24D6 SEGENTRY K1SETUPARA,XSTRT 24K# ... SEGENTRY K2SETUPARA,XTENTBLOK 24QG ... FSHENTRY K3SETUPARA,XALTVALUE,,XALTVALUE 24XQ [ 25CB [ THIS SEGMENT IS PART OF EARLY MORNING START.ITS FUNCTION IS AS 25X2 [ FOLLOWS:- 26BL [ 1) SET THE TIME AND DATE UP AND INDICATE THEY ARE TO 26W= [ BE O/P BY THE FIRST SRING CLEAN 27*W [ 27TG [ 2) CHECK THAT THE IDENTITY MACRO HAS BEEN IMPLEMENTED 28*6 [ 28SQ [ 3) COMPARE ALL IPS IN PARAMINDEX WITH THEIR MAX/MIN 29#B [ VALUES IF TEST FAILS WE TAKE THE FIXED CORE 29S2 [ DEFAULT AND PUT DEFAULT INTO PARAMINDEX 2=?L [ 2=R= [ 4) PERFORM CERTAIN SPECIAL CHECKS:- 2?=W [ MOPLIMIT+BACKGROUND <= JOBLIMIT 2?QG [ MOPJOBS+BACKJOBS <= JOBLIMIT 2#=6 ...[ OBJECTQUOTA+CHAPTERQUOTA < AFREE 2*P2 [ COREOBJECT < AFREE (G3) OR < EBSWAPSP (G4) 2B8L [ SIZEDEFAULT < AFREE (G3) OR < EBSWAPSP (G4) 2BN= ...[ MAXQUOTA < AFREE (G4) 2C7W [ 2CMG [ THE CHECK IS REPEATED UNTIL ALL POSSIBLE DEFAULT 2D76 [ VALUES ARE TAKEN 2DLQ [ 2F6B [ 5) IF VALUE IN PARAMINDEX IS UNSET - THE DEFAULT IS 2FL2 [ TAKEN - IN THIS CASE NO MESSAGE O/P 2G5L [ 2GK= [ NOTE: 2H4W [ ONCE AN IP DEFAULT IS TAKEN NO FURTHER CHECKS ARE MADE - 2HJG [ E.G SO IF DEFAULT > MAX VALUE 2J46 [ *** BAD LUCK -- DEFAULT STILL TAKEN 2JHQ [ 2JKN ...#UNS IPEXTENSION+1*IPEXTENSION 2JML ...#DEF XIPEXT=1 2JPJ ...#UNS IPEXTENSION+1*IPEXTENSION 2JRG ...#SKI 2JTD ...#DEF XIPEXT=0 2K3B #PAGE 2KH2 [ THE FOLLOWING TABLE IS A LIST OF SPECIAL IP'S 2L2L [ 2LG= [ -- LOCATION = FIXED CORE ADDRESS (TO BE HELD AS AN 2L^W [ ADDR. REL. TO INSTPARAM ) 2MFG [ 2M^6 [ -- BRANCH = PLACE WHERE RELAVENT CODING IS FOR CHECK 2NDQ [ 2NYB [ 2PD2 TABIPST [ LOCATION BRANCH 2PXL [ 2QC= TABRN BACKGROUND , +YBGD 2QWW TABRN BACKJOBS , +YBCJ 2RBG TABRN AOBJCORES , +YCOR [COREOBJECT 2RW6 TABRN IMOPJOBS , +YMOJ 2S*Q TABRN IMOPLIMIT , +YMOL 2STB TABRN JOBLIMIT , +YJOL 2T*2 TABRN COREDEFAULT , +YCOR [SIZEDEFAULT 2WRW TABRN COBJQUOTA , +YOBJ [OBJECTQUOTA 2X?G TABRN CHAPQUOTA , +YCAP [CHAPTERQUOTA 2Y=Q #SKI G4 [THESE ARE FOR G4 ONLY :- 2YQB ... TABRN AMAXQUOTA , +YMAX [MAXQUOTA 338G #DEF TABIPLGN = 0? - TABIPST [LENGTH OF IP SPECIAL TABLE 33N6 #PAGE 347Q [ 34MB [ NOW WE SET UP THE REQUIRED POINTER WORDS :- 3572 [ 35LL [ WORD: XDEFAULT = B2 - IF DEFAULT TAKEN =1 366= [ B5 - IF IP WAS UNSET =0 36KW [ B8 - IF CHECK FAILED =1 375G [ B11 - IF ERROR HEADING BEEN O/P = 1 37K6 [ B14 - IF TRACE/CONTEXT IP=1 384Q [ B17 - IF CONTEXT =1 38JB [ 3942 #DEF XDEFAULT = AWORK4 39HL [ 3=3= BITDEFS XDEFAULT,2,TOOKDEF,,,UNSETDEF,,,TESTFAIL,,,VANYERR 3=GW [ 3?2G BITDEFS XDEFAULT,14,TRACON,,,TCONT 3?G6 #PAGE 3?^Q [ 3#FB [ AS GEORGE IS PURE CODE WE MUST SOMEHOW HOLD THE VALUE OR POINTERS 3#^2 [ TO THE VALUE OF THE SPECIAL IP'S AS WE DO OUR SCAN OF PARAMINDEX 3*DL [ IN ORDER TO PERFORM THE CHECKS 3*Y= [ 3BCW [ SO WE CREATE A 13 WORD ADATA/CSTORE BLOCK TO CONTAIN THE 3BXG [ INFORMATION. THE ADATA BLOCK IS IN GROUPS OF 4 WORDS 3CC6 [ 3CWQ [ THE VERY FIRST WORD (XCALC) IS A POINTER TO 3DBB [ WHERE WE ARE IN THE BLOCK 3DW2 [ 3F*L [ A GROUP OF 4 WORDS CONSITS OF :- 3FT= [ 3G#W [ WORD 1 - TELLS OF THE 3 IP'S WHETHER THE DEFAULT HAS BEEN 3GSG [ TAKEN AND WHY -- STRUCTURED AS:- 3H#6 [ 3HRQ BITDEFS 0,0,,,TOOK1,,,UNSET1,,,TOOK2,,,UNSET2,,,TOOK3,,,UNSET3 3J?B [ 3JR2 [ WORD 2 - IF A1 DEFAULT HAS BEEN TAKEN THEN THE VALUE OF THE 3K=L [ [P DEFAULT ELSE POINTER TO POSITION IN PARMNDX 3KQ= [ 3L9W [ SIMILARY WORDS 3+4, THE CHECK BEING:- 3LPG [ 3M96 [ WORD 2 + WORD 3 <= WORD 4 3MNQ [ 3N8B [ SET UP POINTERS TO WORD 1'S 3NN2 #DEF XDUMP=A1 3P7L #DEF XCALC=XDUMP+1 3PM= #DEF XCALCLIMIT=XCALC+1 3Q6W #DEF XCALCJOB = XCALCLIMIT + 4 [JOBLIMIT/BACKJOB/MOPJOB 3R66 #DEF XCALCQUOTA = XCALCJOB + 4 [CHAPTERQUOTA/COREOBJECT 3RKQ #SKI G4 3S5B #DEF XAFEB = EFSWAPSP 3SK2 #OPT XAFEB = AFREE 3T4L #PAGE 3TJ= [ 3W3W [ FATAL ERRORS 3WHG [ 3X36 YBRK GEOERR 1,SETPARAB [BREAK-IN ON ATTEMPT TO OPEN PARAMNDX 3XGQ YFAL GEOERR 1,OPENFAIL [SOMETHINK WRONG ON OPENING PARAMNDX 3Y2B #PAGE 3YG2 TRACEIP 3Y^L [ 3^F= [ THE FOLLOWING ARE THE VALUE OF IPNUM FOR CONTEXT + THE TRACING LEVEL 3^YW [ IP'S OVER WHICH SPECIAL COMPARISIONS OF MAX/MIN ARE REQUIRED 42DG [ 42Y6 +ICONTEXT-INSTPARAM [ADDR. OF CONTEXT 43CQ +JOBTRACE-INSTPARAM [ JOBTRACE 43XB +IMINTRACE-INSTPARAM [ MINTRACE 44C2 +IMOPTRACE-INSTPARAM [ MOPTRACE 44WL +IOPTRACE-INSTPARAM [ OPTRACE 45B= #DEF TRACEED = 0?-TRACEIP 45TW #PAGE 46*G [ 46T6 [ INTERFACE WITH MESSAGE SYSTEM 47#Q [ 47SB WIDFAIL +IDISACES [THIS RESTORE HAS NO IDENTITY 48#2 WIPHEAD +IPDEFHEAD [IP'S RESET TO DEFAULT ARE:- 48RL WIPLIS +IPDEFSET [ %A = %B 49?= UNSC +5 49QW UNSET 5HUNSET 4==G #DEF ULNOUTB = 6 [LGTH OF A STANDARD OUTBLOCK 4=Q6 [ NUMBER=1 W : IPNAME= 3 W 4?9Q #PAGE 4?PB [ 4#92 [ THERE NOW FOLLOWS THE 3 SUBROUTINES REQUIRED TO HANDLE THE 4#NL [ ADATA/CSTORE IP'S 4*8= [ 4*MW [ 1)SINPUT -- PUTS THE IP INTO THE BLOCK AND UPDATES WORD 1 4B7G [ CALLING O/P ROUTINES IF DEFAULT TAKEN 4BM6 [ 2)SOUTPUT -- TAKES THE 3 IP'S OUT OF ADATA BLOCK AND PLACING IN 4C6Q [ X4,X5,X6 SUCH THAT X4+X5 TO BE <= X6 4CLB [ 4D62 [ 3)STAKEDEF -- SEES IF WHEN CHECK FAILS WHICH DEFAULT TO BE TAKEN 4DKL [ NEXT 4F5= [ 4FJW SINPUT 4G4G [ 4GJ6 [ RULE :- 4H3Q [ IF DEFAULT TAKEN THEN DEFAULT VALUE IS STORED IN THE 4HHB [ ADATA/CSTORE AND RELAVENT TOOK? IS SET. OTHERWISE THE RELAATIVE 4J32 [ POSITION IN PARAMINDEX IS STORED AND TOOK% IS LEFT CLEAR 4JGL [ 4K2= #SKI K6SETUPARA>200-200 4KFW ... TRACE 0,SETUP00 4K^G STO 3 AWORK2(2) [STORE CURRENT POS IN PARAMINDEX 4LF6 MHUNTW 3,ADATA,CSTORE 4LYQ ADX 3 1 [RELITIVIZER FOR WHICH XCALC WORD 4MDB LDX 1 5 [STORE LINK ADDR IN X1 SO WE CAN MOD 4MQQ ...( 4MY2 JBC SJN,2,UNSETDEF [JUMP IF IP UNSET 4NCL OBEY 0(1) [ VIZ BS 3,UNSET? 4NX= OBEY 1(1) 4P74 ...) 4PBW SJN JBC SJM,2,TOOKDEF [JUMP IP DEFAULT NOT TAKEN 4PSD ...( 4PWG OBEY 2(1) [VIZ BS 3,TOOK? 4QB6 OBEY 3(1) 4QDP ...) 4QH# ...#SKI XIPEXT 4QKX ... IPUSEX LDX 0,4 [PUT DEFAULT VALUE IN X0 4QNG ...#SKI XIPEXT<1$1 4QR5 ...( 4QTQ SMO 4 4R*B LDX 0 INSTPARAM [PUT DEFAULT VALUE IN X0 4RK8 ...) 4RT2 BRN SEND 4S#L SJM LDX 0 AWORK2(2) 4SS= SBX 0 ACOMMUNE6(2) [PUT REL POINTER TO PARAMNDX IN X0 4T?W SEND OBEY 4(1) [VIZ ADN 3 1/2/3 4TRG STO 0 0(3) [STORE REQUIRED VALUE 4W?6 LDX 3 AWORK2(2) [RESTORE POINTER TO PARAMINDEX 4WQQ LDX 1 FX1 [PUT FX1 INTO X2 AGAIN 4XQ2 EXIT 5 5 4Y9L #PAGE 4YP= SOUTPUT 4^8W #SKI K6SETUPARA>200-200 4^NG ... TRACE 1,SETUP01 5286 STO 0 GEN0 52GH MHUNTW 3,ADATA,CSTORE 52SY LDX 2 FX2 [BEST BE CAREFUL !!! 537B LDX 7 ACOMMUNE6(2) 53M2 ADN 7 IPVAL-A1 [X7 NOW HOLDS ADDR OF PARAMINDEX 546L SMO GEN0 54L= OBEY 0 [ VIZ ADX 3 XCALC??? 555W LDX 4 1(3) 55KG JBS SJ1,3,TOOK1 [JUMP IF 1ST IP IS DEFAULT 5656 ADX 4 7 56JQ SMO 4 574B LDX 4 0 57J2 SJ1 LDX 5 2(3) 583L JBS SJ2,3,TOOK2 [REPEAT FOR 2ND IP 58H= ADX 5 7 592W SMO 5 59GG LDX 5 0 5=26 SJ2 LDX 6 3(3) 5=FQ JBS SJ3,3,TOOK3 [AND THE 3RD 5=^B ADX 6 7 5?F2 SMO 6 5?YL LDX 6 0 5#D= SJ3 LDX 0 GEN0 5#XW EXIT 0 1 5*CG #PAGE 5*X6 [ 5BBQ STAKEDEF 5BWB #SKI K6SETUPARA>200-200 5CB2 ... TRACE 2,SETUP02 5CTL MHUNTW 3,ADATA,CSTORE 5D*= SMO 7 [LINK ADDR IN X7 5DSW OBEY 0 [PICK UP WHICH XCALC WORD 5F#G JBSS STOK1,3,TOOK1 [JUMP IF IP 1 - IS DEFAULT 5FS6 LDX 3 1(3) [REL POINTER TO PARAMINDEX 5G?Q ADX 3 ACOMMUNE6(2) [MAKE X3 ABSOLUTE POINTER TO PARA 5G*N ...#SKI XIPEXT 5GCL ...( 5GFJ ... LDX 0 IPNUM-A1(3) 5GHG ... IPUSEX LDX 4,0 [PUT DEFAULT VALUE IN X4 5GKD ...) 5GMB ...#SKI XIPEXT<1$1 5GP# ...( 5GRB SMO IPNUM-A1(3) 5H?2 LDX 4 INSTPARAM [PUT DEFAULT VALUE IN X4 5HGS ...) 5HQL BRN STRM 5J== STOK1 JBSS STOK2,3,TOOK2 [REPEAT ABOVE FOR 2ND IP -DEFAUT INX5 5JPW LDX 3 2(3) 5K9G ADX 3 ACOMMUNE6(2) 5K?D ...#SKI XIPEXT 5K*B ...( 5KC# ... LDX 0 IPNUM-A1(3) 5KF= ... IPUSEX LDX 5,0 [PUT DEFAULT VALUE IN X5 5KH8 ...) 5KK6 ...#SKI XIPEXT<1$1 5KM4 ...( 5KP6 SMO IPNUM-A1(3) 5L8Q LDX 5 INSTPARAM 5LDJ ...) 5LNB BRN STRM 5M82 STOK2 JBS YSUC,3,TOOK3 [IF 3RD IP IS DEFAULT ALL POSS DEFS 5MML [ TAKEN SO JUMP 5N7= STOZ AWORK3(2) [POINTER TO SAY ALL DEFS TAKEN 5NLW LDX 3 3(3) [REL POINTER TO PARA 5P6G ADX 3 ACOMMUNE6(2) [ABS POINTER 5PL6 BRN STRM1 5Q5Q STRM STO 4 AWORK1(2) [STORE THE VALUES 5QKB STO 5 AWORK2(2) 5R52 STO 6 AWORK3(2) 5RJL STRM1 5S4= LDX 4 IPNUM-A1(3) 5SHW SBX 7 FX1 [AS WE ARE TO COORD SAVE REL LINK ADD 5SRN ... CALL 5 YHD 5T3G ... MHUNTW 3,ADATA,CSTORE [RE-FIND ADATA-CSTORE 5T?# ... ADX 3 XCALC(3) [AND RE-POSITION 5TH6 SBAK LDX 6 AWORK3(2) 5W2Q ADX 7 1 [RESTORE LINK ADD 5WGB BZE 6 YSUC [JUMP IF ALL 3 IP'S ARE DEFAULT 5X22 LDX 4 AWORK1(2) [ELSE RESTORE ALL VALUES 5XFL LDX 5 AWORK2(2) 5X^= EXIT 7 1 5YDW #PAGE 5YYG [ 5^D6 [ WELL HERE WE GO ---- 5^XQ [ 62CB XSTRT 62X2 [ 63BL #SKI K6SETUPARA>200-200 63CW ... TRACE 3,SETUP03 64*W [ FIRST SET ADTO LARGE ENOUGH TO FORCE SRING CLEAN TO O/P DATE AND 64TG [ TIME ON OPS CONSOLE 64^Q ...[ 6562 ...[ THE FOLLOWING 2 LINES HAVE BEEN ALTERED DUE TO G5441(B 0911) 65== ...[ THIS WAS CAUSED BY THE FACT THE CURRENT SPRING CLEAN 65BG ...[ ONLY RCOGNISWS B0 + B12 SET IN ADTO,IF ALL BITS SET 65GQ ...[ IT GETS CONFUSED....! 65M2 ...[ 65R= ...[ DONE 6.SEPT.74 :CENT 65XG ...[ 663Q ...TOFORCEOP #40004000 [CORRECT FORMAT FOR S-P 6682 ... LDX 0 TOFORCEOP(1) 66#B STO 0 ADTO [ALL BITS NOW SET 66S2 [ 67?L [ CHECK THAT IDENTITY MACRO HAS BEEN IMPLEMENTED 67BH ...[ 67FD ...[ 67J* ...[ THE FOLLOWING CORRECTION IS DUE TO G5448 (B 0983) 67M= ...[ THIS RESULTED IN NO DATAE BEING PRESENT IN THE 'PM' 67Q7 ...[ GEOERGE LOADED MESSAGE.THIS WAS CAUSED BY SETUPARA ASSUMMING 67T4 ...[ THAT A DOWN TO DATECON HAD OCCURED AND FDATE HELD THE CORRECT 67X^ ...[ DATE ---- THIS IS NOT TRUE --- SO DATECON MUST BE CALLED 682W ...[ WITH %A .NE. 'EDATE' SO FORCING A DOWN DATECON,1 685R ...[ DONE 18.SEPT.74 :CENT 688N ...[ 68?K ...#DEF TEDATE = EDATE 68BG ...[ 68FC ...[ WE CAN NOW CALL DATECON WITH PARAMETER TEDATE FORCING DOWN 68J# ...[ 68M9 ... DATECON TEDATE [CONVERT NO OF DAYS TO DDMMMYY IN 68QG [ ACOMMUNE1 + 2. 69=6 LDX 4 ACOMMUNE1(2) 69PQ LDX 5 ACOMMUNE2(2) 6=9B STO 4 IDENTITY+4 6=P2 ... STO 5 IDENTITY+5 [STORE AWAY THE DATE 6?8L [ 6?N= [ NOW CHECK IF IDENTITY MACRO HAS BEEN IMPLEMENTED 6#7W [ (WORD - ACES HOLDS 4 SPACES 6#MG LDX 4 ACES 6*76 TXU 4 IDENTITY [DO CHECK 6*LQ TXU 4 IDENTITY+1 6B6B BCS YIMP [JUMP IF IMPLEMENTED 6BL2 MONOUTX WIDFAIL(1) [O/P RESTORE ERROR MESSAGE 6C5L YIMP 6CK= TIMECON JTIME [CONVERT NO.OF K9'5 TO HH.MM.SS 6D4W LDX 4 ACOMMUNE1(2) 6DJG LDX 5 ACOMMUNE2(2) 6F46 STO 4 IDENTITY+2 6FHQ STO 5 IDENTITY+3 [STORE AWAY THE TIME 6G3B #SKI K6SETUPARA>299-299 6GH2 ... TRACE IDENTITY+2,FIRSTBIT 6H2L [ 6HG= [ OPEN PARAMINDEX --- HOPEFULLY!! MODE CLEAN AS NOT ALTERING 6H^W [ 6JFG OPENSYS YBRK,PARAMINDEX,CLEAN 6J^6 TESTREPN OK,YFAL [IF NOT OK -- GO AND GEOERR 6KDQ #SKI K6SETUPARA>200-200 6KJM ... TRACE 4,SETUP04 6LD2 SETNCORE 14,3,ADATA,CSTORE [SET UP HOLDING BLOCK 6LXL STOZ A1(3) 6MC= LDN 4 A1(3) 6MWW LDN 5 A1+1(3) 6NBG MOVE 4 13 [ZEROISE BLOCK 6NW6 LDN 5 XCALCLIMIT 6P*Q STO 5 XCALC(3) 6PTB STOZ XDEFAULT(2) 6PW2 ...XFSHNBSETN 6PX= ...#SKI XIPEXT 6PXW ...( 6PYG ...#SKI K6SETUPARA>299-299 6P^6 ... TRACE 3,SETUPFRB 6P^Q ... DOWN SETUPARA,2 [SETUP FILE/FRB BLOCK 6Q82 ... MHUNT 3,FILE,FRB [PTR TO FILE/FRB RECORD 6Q8L ... ADN 3 A1 [PTR TO START OF ACTUAL RECORD 6Q9= ...XFSHNBHUNT 6Q=G ...) 6Q#B ...#SKI XIPEXT<1$1 6Q*2 STEP [READ THE ONLY RECORD 6QSL #SKI IPL 6R#= ( 6RRW SEGENTRY K97SETUPARA 6S?G NULL 6SR6 ) 6T=Q STO 3 ACOMMUNE6(2) [STORE START ADDR IN EVENT OF COORD 6TQB SBN 3 IPLINE [MERELY TO EASE POSITIONING 6W=2 YLOP ADN 3 IPLINE 6WPL SMO ACOMMUNE6(2) 6X9= LDX 0 IPHEAD-A1 6XNW ADX 0 ACOMMUNE6(2) 6Y8G SBN 0 IPNUM-A1(3) [SUBTRACT ADDR OF NEXT IP LOCATION 6YN6 BNG 0 YALL [J IF END OF PARAMNDEX REACHED 6^7Q [ 6^MB [ WE ARE NOW (STILL) READING PARAMINDEX 7272 [ 72LL MBC 2,TOOKDEF,UNSETDEF,TESTFAIL,TRACON,TCONT 736= #SKI K6SETUPARA>200-200 73KW ... TRACE XDEFAULT(2),SETUP08 745G LDX 6 IPVAL-A1(3) [PUT VALUE OF IP IN XD 74K6 LDX 4 IPNUM-A1(3) [PUT REL FIXED CORE ADDR INTO X4 74KT ...#SKI XIPEXT 74LJ ... BNG 4 XTNUM [J IF IN EXTENSION TABLE 74M* ... LDN 5 INSTGAPEND-INSTPARAM [MAX NO OF IPS ALLOWED 74MJ ...#SKI XIPEXT 74MR ...( 74N2 ... BRN XTNUMCOMP 74N9 ...XTNUM 74ND ... LDX 5 IPEXTCOUNT [NUMBER OF IPS IN EXTENSION TABLE 74NM ... ORX 5 GSIGN [SET BIT 0 74NW ...XTNUMCOMP 74P5 ...) 74PJ ... BXL 4 5,NUMOK [J IF OK 74RR ... OUTNUM 4,0 74W2 ... MONOUT IPHIGH [%A IS TOO HIGH FOR AN IP NO 74W7 ... SBX 3 ACOMMUNE6(2) [OBTAIN REL PTR WITHIN FILE/FRB 74W# ... STO 3 4 [SAVE IN X4 74WF ...#SKI XIPEXT<1$1 74WL ... STEPAGAIN [REFIND PTR TO RECORD 74WR ...#SKI XIPEXT 74WY ...( 74X5 ... MHUNT 3,FILE,FRB [REFIND PTR TO FILE/FRB BLOCK 74X= ... ADN 3 A1 74XC ...) 74XJ ... STO 3 ACOMMUNE6(2) [STORE START ADDR IN EVENT OF COORD 74XP ... ADX 3 4 [REFIND CURRENT PLACE IN FILE/FRB 74Y9 ... BRN YLOP 752D ...NUMOK 754Q [ 75JB [ IS THE IP UNSET ? 7642 [ 76HL BXE 6 GSIGN,YSTD [JUMP IF IT IS 773= [ 77GW ...[ ARE WE DEALING WITH A TRACE IP OR CONTEXT 782G [ 78G6 LDN 5 TRACEED 78^Q YRD SMO 5 79FB BXE 4 TRACEIP-1(1),YTRAC 79^2 BCT 5 YRD 7=DL [ 7=Y= [ IF WE GET HERE NOT TRACE/CONTEXT AND NOW X1 = FX1 AGAIN 7?CW [ 7?XG [ SO NOW WE CAN TEST IPVAL AGAINST MAX/MIN 7#C6 #SKI K6SETUPARA>200-200 7#WQ ... TRACE 6,SETUP06 7*BB BXL 6 IPMIN-A1(3),YSBD [JUMP IF LESS THAN MIN 7*W2 BXL 6 IPMAX-A1(3),YOK [JUMP IF LESS THAN MAX-- I.E OKAY 7B*L BXE 6 IPMAX-A1(3),YOK [JUMP IF EQUAL TO MAX -- I.E.OKAY 7BT= [ 7C#W [ IF WE GET HERE WE HAVE TO SET XDEFAULT AS WE MUST TAKE A DEFAULT 7CSG [ 7D#6 YSBD BS 2,UNSETDEF [IP WAS NOT UNSET-- TEST HAS FAILED 7DRQ #SKI K6SETUPARA>200-200 7F?B ... TRACE XDEFAULT(2),SETUP09 7FR2 YSTD BS 2,TOOKDEF [DEFAULT TO BE TAKEN 7G=L #SKI K6SETUPARA>200-200 7GQ= ... TRACE XDEFAULT(2),SETUP19 7H9W [ 7HPG [ NOW TO TEST IF WE ARE DEALING WITH A SPECIAL IP 7J96 [ 7JNQ YOK 7K8B LDN 0 TABIPLGN [LENGTH OF SP IP TABLE 7KN2 YRDA SMO 0 7L7L LDX 5 TABIPST-2(1) [LOAD A SP IPNUM - START AT END OF TB 7LM= SBN 0 1 [ADJUST COUNT AS DOUBLE ENTRY TABLE 7M6W BXU 4 5,YEND [JUMP IF NOT A MATCH 7MLG #SKI K6SETUPARA>200-200 7N66 ... TRACE 0,SETUP10 7NKQ SMO 0 7P5B BRN TABIPST [BRANCH TO REL SP IP CODING 7PK2 YEND BCT 0 YRDA [ROUND WE GO 7Q4L [ 7QJ= [ IF WE FALL THROUGH NOT A SP IP 7R3W [ 7RHG [ THE FOLLOW INTEROGATES THE XDEFAULT WORD 7S36 [ 7SGQ YNOR LDN 5 YLOP(1) [THIS CODE MAY RETURN ELSEWHERE THAN 7T2B #SKI K6SETUPARA>200-200 7TG2 ... TRACE 1,SETUP11 7T^L [ YLOP 7WF= YOPT JBS YTAK,2,TOOKDEF [JUMP IF DEFAULT TO BE TAKEN 7WJB ...#SKI XIPEXT 7WMG ... IPUSEX STO 6,4 [STORE NEW VALUE OF IP 7WQL ...#SKI XIPEXT<1$1 7WTQ ...( 7WYW SMO 4 7XDG STO 6 INSTPARAM 7XN# ...) 7XY6 #SKI K6SETUPARA>200-200 7YCQ ... TRACE 4,SETUP24 7YXB BRN (5) [FINI - SO RETURN 7^C2 [ 7^WL [ IF HERE THE DEFAULT IS TO BE TAKEN 82B= [ 82TW YTAK JBC (5),2,UNSETDEF [IF UNSET WE CAN RETURN 83*G #SKI K6SETUPARA>200-200 83T6 ... TRACE 2,SETUP12 84#Q [ 84SB [ SO WE HAVE TO O/P AN ERROR MESSAGE 85#2 [ 85RL YHD SBX 3 ACOMMUNE6(2) 85WQ ...#SKI XIPEXT 85^W ... IPUSEX LDX 6,4 [VALUE OF IP 8652 ...#SKI XIPEXT<1$1 8686 ...( 86?= SMO 4 86QW LDX 6 INSTPARAM 872N ...) 87=G LDX 4 3 87Q6 SBX 5 FX1 889Q JBS YERR,2,VANYERR [JUMP IF HEADING ALREADY O/P 88PB MONOUTX WIPHEAD(1) [O/P DEFAULT HEADING 8992 BS 2,VANYERR [SET HEADING O/P SWITCH 89NL YERR 8=8= [ 8=MW [ OUTPUT THE %A = %B 8?7G [ 8?M6 #SKI K6SETUPARA>200-200 8#6Q ... TRACE 0,SETUP20 8#LB OUTBLOCN ULNOUTB [CREATE THE GMON/ASET BLOCK 8*62 TRYAGAIN 8*7Y ...#SKI XIPEXT 8*9W ...( 8*?S ... MHUNT 3,FILE,FRB [PTR TO FILE/FRB BLOCK 8**Q ... ADN 3 A1 [PTR TO START OF ACTUAL RECORD 8*CN ... STO 3 ACOMMUNE6(2) [STORE ADDR IN EVENT OF COORD 8*FL ...) 8*HJ ...#SKI XIPEXT<1$1 8*KL STEPAGAIN 8B5= ADX 3 4 8BJW OUTPACK IPNAME-A1(3),3,LOCNAME,TRYAGAIN 8C4G BXU 6 GSIGN,YNUNS 8CJ6 LDX 3 UNSET(1) [SO OUR VALUE IS -- UNSET 8D3Q STO 3 ACOMMUNE1(2) [SO WE OUTPUT AN INTELLIEGENT 8DHB LDX 3 UNSET+1(1) [ERROR REMARK 8F32 STO 3 ACOMMUNE2(2) 8FGL LDX 3 UNSC(1) [NOW THE NO. OF CHARACHTERS 8G2= BRN YPAR 8GFW YNUNS 8G^G ... JBSC YTR,2,TRACON [JUMP IF CONTEXT OR TRACE IP- CLEAR B 8HF6 YNUM OUTNUM 6,0 [PUT IP VALUE INTO GMON BLOCK 8HYQ BRN YOUT 8JDB YTR JBSC YCON,2,TCONT [JUMP IF CONTEXT - CLEAR BIT 8JY2 SYNTHMON 6 [TRANSLATE MASK AND OUTPAR 8KCL BRN YOUT 8KX= YCON BZE 6 YNUM [TRAP CASE OF CONTEXT=0 !! 8LBW IPCONT 6,3 [TRANSLATE CONTEXT INTO CHARS 8LWG YPAR OUTPARAM 3,ACOMMUNE1 [PUT INTO GMON BLOCK 8MB6 YOUT MONOUTX WIPLIS(1) [DO THE ACTUAL O/P 8MKY ...#SKI XIPEXT<1$1 8MTQ STEPAGAIN [.. WE WISH TO RETURN TO THE POSITION 8MY* ...#SKI XIPEXT 8N2Y ...( 8N5H ... MHUNT 3,FILE,FRB 8N86 ... ADN 3 A1 [.. WE WISH TO RETURN TO THE POSITION 8N=P ...) 8N*B STO 3 ACOMMUNE6(2) [.. IN PARAMINDEX BEFORE WE O/P 8NK8 ...#SKI XIPEXT<1$1 8NT2 STEPREWRITE [MARK TO WRITE AWAY AS INSERTING 8P#L [ ... DEFAULT IN PARAMINDEX 8PS= ADX 3 4 8Q?W STO 6 IPVAL-A1(3) [WRITE DEFAULT AWAY 8QRG ADX 5 FX1 8R?6 BRN (5) 8RQQ [ THE MAIN BODY OF THE SEGMENT IS COMPLETE WHAT FOLLOWS IS MERELY.. 8S=B [ 8SQ2 [ 1) THE MAX/MIN COMPARISON FOR CONTEXT+TRACE LEVELS 8T9L [ 8TP= [ 2) THE CHECKS ON SPECIAL IP'S 8W8W [ 8WNG [ 8X86 [ MAX/MIN COMPARISION FOR CONTEXT+TRACE LEVELS 8XMQ [ 8Y7B YTRAC LDX 1 FX1 [RESET FX1 8YM2 BS 2,TRACON [SET TRACE/CONTEXT INDICATOR 8^6L BXU 4 TRACEIP(1),YNCN [JUMP IF NOT CONTEXT 8^L= BS 2,TCONT [SET CONTEXT INDICATOR 925W [ 92KG #SKI K6SETUPARA>200-200 9356 ... TRACE 3,SETUP13 93JQ [ TEST 'MIN' 944B [ 94J2 YNCN 953L LDX 5 IPVAL-A1(3) 95H= ERX 5 IPMIN-A1(3) 962W ANDX 5 IPMIN-A1(3) 96GG BNZ 5 YMFL [JUMP IF MIN HAS FAILED 9726 #SKI K6SETUPARA>200-200 97FQ ... TRACE 4,SETUP14 97^B [ 98F2 [ TEST 'MAX' 98YL [ 99D= LDX 5 IPVAL-A1(3) 99XW ORX 5 IPMAX-A1(3) 9=CG ERX 5 IPMAX-A1(3) 9=X6 BZE 5 YNOR [IF SUCCESS ON MAX/MIN JUMP 9?BQ #SKI K6SETUPARA>200-200 9?WB ... TRACE 5,SETUP15 9#B2 YMFL MBS 2,TOOKDEF,UNSETDEF [SET BITS TO FAILURE 9#TL BRN YNOR 9**= #PAGE 9*SW [ 9B#G [ NOW FOR CODE TO SET UP THE ADATA/CSTORE WITH THE SP-IP'S 9BS6 [ 9C?Q #SKI K6SETUPARA>200-200 9CRB ... TRACE 6,SETUP16 9D?2 YBGD LDN 1 XCALCLIMIT [BACKGROUND 9DQL YFST CALL 5 SINPUT 9F== BS 3,UNSET1 9FPW BS 3,TOOK1 9G9G ADN 3 1 9GP6 ... BRN YLOP 9H8Q YBCJ LDN 1 XCALCJOB [BACKJOB 9HNB BRN YFST 9J82 YMOJ LDN 1 XCALCJOB [MOPJOB 9JML YSND CALL 5 SINPUT 9K7= BS 3,UNSET2 9KLW BS 3,TOOK2 9L6G ADN 3 2 9LL6 ... BRN YLOP 9M5Q YMOL LDN 1 XCALCLIMIT [MOPLIMIT 9MKB BRN YSND 9N52 YJOL1 LDN 1 XCALCJOB [JOBLIMIT 9NJL #SKI K6SETUPARA>200-200 9P4= ... TRACE 1,SETUP21 9PHW BRN YTRD 9Q3G YJOL LDN 1 XCALCLIMIT 9QH6 LDN 6 2 9R2Q YTRD CALL 5 SINPUT 9RGB BS 3,UNSET3 9S22 BS 3,TOOK3 9SFL ADN 3 3 9S^= BCT 6 YJOL1 9TDW ... BRN YLOP 9TYG [ 9WD6 [ END OF INSERTING DATA INTO ADATA/CSTORE 9WXQ [ 9YBL YOBJ MHUNTW 2,ADATA,CSTORE 9YW= LDX 6 AFREE [STORE AFREE IN CALC WORD 9^*W ADN 2 XCALCQUOTA [POSITION OURSELVES 9^TG STO 6 3(2) =2*6 BS 2,TOOK3 [AND SET DEFAULT BIT =2SQ LDX 2 FX2 =3#B LDN 1 XCALCQUOTA [OBJECTQUOTA =3S2 BRN YFST =4?L YCAP LDN 1 XCALCQUOTA [CHAPTERQUOTA =4R= BRN YSND =5QG #SKI G4 =6=6 ( =6PQ ...YMAX JBS YNOR,2,TOOKDEF [JUMP IF DEFAULT ALREADY TAKEN =79B ... [THIS FOR G4 MAXQUOTA =7P2 ... BXL 6 AFREE,YNOR [JUMP IF CHECK OKAY =88L MBS 2,TOOKDEF,UNSETDEF =8N= BRN YNOR =?6B ) =?L2 YCOR JBS YNOR,2,TOOKDEF [FOR SIZEDEFAULT/COREOBJECT G3+G4 =#5L #SKI G4 [IF G4 -AS EBSWAPSP IN K MUST DIVIDE =#99 ... SRL 6 10 [ IPVAL(X0) BY 1024 =##S ...[ =#DC ...[ THE FOLLOWING LINES HAVE BEEN ALTERED TO CORRECT =#J2 ...[ BUG 0742(G 5425) =#MK ...[ =#R8 ...[ THIS WAS CAUSED BY THE FACT IF OLD VALUS OF COREOBJECT =#WR ...[ AND SIZEDEFAULT WERE OKAY THE VALUES PUT IN NEW PARAMINDEXG4 =*2B ...[ WAS OLD VALUE/1024 (GEORGE 4 BUG ONLY) =*5^ ...[ =*9J ...[ DONE 7.AUGUST.74 :CENT =**7 ...[ =*DQ ... BXL 6 XAFEB,YYNR [NOTE ROUNING TAKES CARE OF ITSELF =*JG [IF EBSWAPSP = 10K =B46 [X0 = 10002 - SRL = 10 FAILS ON BXL =BHQ #SKI K6SETUPARA>200-200 =BS^ ... TRACE 0,SETUP30 =C68 ... MBS 2,TOOKDEF,UNSETDEF =C92 ...[ =C?S ...[ THIS IS NEW G5425 =CBL ...[ =CFD ...YYNR =CJ= ...#SKI G4 =CM4 ... LDX 6 IPVAL-A1(3) [RESTORE OLD VALUE =CPW ...[ =CSN ...[ AND THATS IT !!!! =CXG ...[ =D2L BRN YNOR =DG= [ =D^W [ END OF ALL CHECKS =FFG [ =F^6 [ NOW THE NUMERICAL CHECKS =GDQ [ =GYB YALL MHUNTW 3,ADATA,CSTORE =HD2 ... LDN 0 3 [POST VOPA ALL CHECKS IN G3+4 =HXL STO 0 XDUMP(3) [KEEP COUNT =JC= YCHK CALL 0 SOUTPUT [PUT IP VALUES INTO X4,X5,X6 =JWW ADX 3 XCALC(3) =KBG YAGN LDX 0 4 =KW6 ADX 0 5 =L*Q BXGE 6 0,YSUC1 [JUMP IF CONDITION IS SUCCESSFUL =LTB #SKI K6SETUPARA>200-200 =M*2 ... TRACE 2,SETUP22 =MSL CALL 7 STAKEDEF [PICK ANOTHER DEFAULT =N#= ADX 3 XCALC(3) =NRW BRN YAGN =P?G YCHK1 =PR6 #SKI K6SETUPARA>200-200 =Q=Q ... TRACE XDEFAULT(2),SETUP18 =QQB LDN 0 4 =R=2 ADS 0 XCALC(3) [UPDATE XCALC POINTER =RPL BRN YCHK =S9= YSUC1 LDX 2 ACOMMUNE6(2) [NOW TO TEST IF ANY IP'S IN A CHEC =SNW [ ARE OKAY (NOT DEFAULT) =T8G JBS YN1,3,TOOK1 [ X3 = ADATA BLOCK =TN6 SMO 1(3) =W7Q LDX 0 IPNUM-A1(2) =W=W ...#SKI XIPEXT =WB2 ... IPUSEX STO 4,0 [1ST IP IN =WF6 ...#SKI XIPEXT<1$1 =WJ= ...( =WMB SMO 0 =X72 STO 4 INSTPARAM [1ST 1P IN =XBS ...) =XLL YN1 JBS YN2,3,TOOK2 =Y6= SMO 2(3) =YKW LDX 0 IPNUM-A1(2) =YP2 ...#SKI XIPEXT =YS6 ... IPUSEX STO 5,0 [2ND IP =YX= ...#SKI XIPEXT<1$1 =^2B ...( =^5G SMO 0 =^K6 STO 5 INSTPARAM [2ND IP =^SY ...) ?24Q #SKI K6SETUPARA>200-200 ?2JB ... TRACE 3,SETUP23 ?342 YN2 JBS YSUC2,3,TOOK3 ?3HL SMO 3(3) ?43= LDX 0 IPNUM-A1(2) ?46B ...#SKI XIPEXT ?49G ... IPUSEX STO 6,0 [3RD IP ?4#L ...#SKI XIPEXT<1$1 ?4CQ ...( ?4GW SMO 0 ?52G STO 6 INSTPARAM [3RD IP ?5=# ...) ?5G6 YSUC2 ?5^Q YSUC MHUNTW 3,ADATA,CSTORE ?6FB LDX 0 XDUMP(3) ?6^2 SBN 0 1 ?7DL STO 0 XDUMP(3) [KEEP NEW COUNT ?7Y= BNZ 0 YCHK1 [J IF NOT FINISHED CHECKS ?8CW FREECORE 3 ?8DC ...#SKI XIPEXT ?8DY ...( ?8FF ... REWIND [REWIND TO START OF FILE ?8G2 ...#SKI K6SETUPARA>299-299 ?8GH ... TRACE 3,IPREWIND ?8H4 ... LDN 7 A1+1 [RELATIVE PTR TO VERSION NUMBER ?8HK ...NEXTRECOUT ?8J6 ... STEP [READ FIRST/NEXT RECORD ?8JM ... BZE 3 WRITEEND [J IF REACHED END OF FILE ?8K8 ... MHUNT 2,FILE,FRB [PTR TO FILE/FRB BLOCK ?8KP ... ADX 2 7 [PTR TO START OF NEXT ENTRY IN /FRB ?8L= ... LDX 1 0(3) [RECORD HEADER OF CURRENT RECORD ?8LR ... SBN 1 1 [DON'T WANT TO MOVE HEADER ITSELF ?8M# ... ADX 7 1 [UPDATE RELATIVE PTR IN FILE/FRB ?8MT ... ADN 3 1 [PTR TO WORD AFTER RECORD HEADER ?8NB ... MOVE 2 0(1) [MOVE NEW ENTRY INTO FILE/FURB ?8NX ... SBN 3 1 [RESET POINTER TO RECORD ?8PD ... STEPREWRITE [RENAME /FURB TO /FUWB TO REWRITE ?8P^ ... BRN NEXTRECOUT ?8QG ...WRITEEND ?8R3 ... LDX 2 FX2 [RESET X2 ?8RJ ... MFREE FILE,FRB [FREE FILE/FRB BLOCK ?8S5 ...#SKI K6SETUPARA>299-299 ?8SL ... TRACE 3,IPWRITEN ?8T7 ...) ?8TN ...XFSHNBALTER ?8XG CLOSETOP ?9C6 IPBACKJAM ?9J# ...XFSHNBBKJM ?9WQ ACROSS SETUP,2 ?9WW ...#PAGE ?9X2 ...XTENTBLOK ?9X6 ...#SKI XIPEXT<1$1 ?9X= ... GEOERR 1,NOTXTTAB [SHOULD ONL ENTER IF EXTENSION TABLE ?9XB ...#SKI XIPEXT ?9XG ...( ?9XL ...# ?9XQ ...# THIS ENTRY POINT SETS UP A FILE/FRB BLOCK WHEN AN EXTENSION TABLE ?9XW ...# EXISTS TO SAVE HAVING TO MAKE LARGE ALTERATIONS TO THE IP CODE ?9Y2 ...# ?9Y6 ... SETNCORE 512,4,FILE,FRB [CREATE FILE/FRB BLOCK ?9Y= ... STEP [READ FIRST RECORD OF FILE ?9YB ... MHUNT 1,FILE,FRB [PTR TO FILE/FRB BLOCK IN X1 ?9YG ... LDX 4 1 [ IN X4 ?9YL ... ADN 4 A1 [PTR TO START OF RECORD BLOCK ?9YQ ... MOVE 3 2 [MOVE FIRST RECORD INTO FILE/FRB ?9YW ... LDN 7 2 [NUMBER OF WORDS IN FILE/FRB ?9^2 ... LDN 6 512 [CURRENT SIZE OF FILE/FRB BLOCK ?9^6 ...NEXTRECIN ?9^= ... STEP [READ NEXT RECORD ?9^B ... BZE 3 READEND [J IF REACHED END OF FILE ?9^G ... MHUNT 1,FILE,FRB [REFIND PTR TO FILE/FRB BLOCK IN X1 ?9^L ... LDX 4 1 [ IN X4 ?9^Q ... ADN 4 A1 [PTR TO START OF RECORD AREA ?9^W ... ADX 4 7 [PTR TO NEXT ENTRY IN FILE/FRB ?=22 ... LDEX 1 0(3) [NUMBER OF WORDS IN RECORD ?=26 ... SBN 1 1 [NUMBER OF WORDS TO BE MOVED ?=2= ... ADX 7 1 [UPDATE COUNT OF WORDS IN FILE/FRB ?=2B ... BXGE 7 6,XALTLEN [J IF BLOCK NOT BIG ENOUGH ?=2G ...XALTERED ?=2L ... ADN 3 1 [PTR TO START OF AREA TO BE MOVED ?=2Q ... MOVE 3 0(1) [MOVE IN RECORD ENTRY ?=2W ... BRN NEXTRECIN [REPEAT FOR NEXT RECORD ?=32 ...XALTLEN ?=36 ... ADN 6 64 ?=3= ...#SKI K6SETUPARA>299-299 ?=3B ... TRACE 6,IPALTLEN ?=3G ... SBX 4 7 ?=3L ... ADX 4 1 ?=3Q ... SBN 4 A1 [REFIND PTR TO FILE/FRB BLOCK IN X4 ?=3W ... ALTLEN 4,6,FILE,FRB [INCREASE LENGTH OF FILE/FRB BY 64 ?=42 ... STEPAGAIN [REFIND PTR TO NEXT RECORD ?=46 ... MHUNT 1,FILE,FRB [REFIND PTR TO FILE/FRB BLOCK IN X1 ?=4= ... LDX 4 1 [ IN X4 ?=4B ... LDEX 1 0(3) ?=4G ... SBN 1 1 [RESET NUMBER OF WORDS TO BE MOVED ?=4L ... ADN 4 A1 ?=4Q ... ADX 4 7 ?=4W ... SBX 4 1 [RESET PTR IN FILE/FRB BLOCK ?=52 ... BRN XALTERED [RETURN TO NORMAL PATH ?=56 ...READEND ?=5= ... MHUNT 1,FILE,FRB [REFIND PTR TO FILE/FRB BLOCK IN X1 ?=5B ... STO 7 A1(1) [INSERT NEW VALUE OF RECORD HEADER ?=5G ...#SKI K6SETUPARA>299-299 ?=5L ... TRACE 7,FRBSETUP ?=5Q ... UP [RETURN TO CALLING SEGMENT ?=5W ...) ?=BB MENDAREA 50,K99SETUPARA ?=W2 #SKI IPL ??*L MENDAREA 30,K98SETUPARA ??T= #END ^^^^ ...10330510000300000000