INCRCUBX860
(George Source)
Macros used: BCONTEXT, BFCBX, BITDEFS, BXE, BXGE, BXL, FCJOB, FREECORE, FSHCODE, GEOERR, ISSUCOMB, JBC, JBS, MHUNTW, NOTALIEN, OR, PSTAC, SEG, SEGENTRY, SETREP2, SETUPCORE, SFCA, SFSTACK, SPRIVJUMP, TRACEIF, TRANCHKN, TRANSBEG, TRANSFIN, UP, UPPLUS, XCBINDEX
- INCRCUBX860.txt
22FL ... SEG INCRCUBX,860,FILE,FILESTORE 22^= # 23DW ... BITDEFS AWORK4,0,XBCOMM [UPDATE OTHER COMMUNAL USERS OF THIS 23YG ... BITDEFS AWORK4,1,XBWHOLE ["WHOLE FILE" MAY BE SPECIFIED AS %C 24D6 ... BITDEFS AWORK4,3,XBFORCED ["FORCED" SPECIFIED 24XQ ... BITDEFS AWORK4,4,XBANSWER ["ANSWER" SPECIFIED 25CB ... BITDEFS AWORK4,5,XBSUBCUBS [SUBCUBS MACRO 25X2 ...# 26BL ...# 26W= ... SEGENTRY K1INCRCUBX,X1INCRCUBX [AMBS EXCEEDED - ASK OPS FOR MO 27*W ... SEGENTRY K2INCRCUBX,X2INCRCUBX [FILE OPEN COMMUNALLY & HAD >1 2DLQ # 2F6B # 2FL2 [ 2GK= MREACH +42 2H4W 42HDP 2,LIMIT OF ONLINE BACKING STORE REACHED 2HJG MQUES +39 2J46 39HQN 2,CAN THIS JOB'S LIMIT BE INCREASED? 2JHQ MNOTINC +24 2K3B 24HDP 2,LIMIT NOT INCREASED 2KH2 MNEW +31 2L2L 31HDP 2 , LIMIT NOW KWORDS 2LG= MYESNO +28 2L^W 28HDP 2,PLEASE ANSWER YES OR NO 2MFG MBREAK +48 2M^6 48HDP 0 , BREAK-IN CONTEXT KWORDS MORE ALLOWED 2NDQ ...[ 2NYB ...[ 2PD2 ...[ SUBROUTINES 2PXL ...[ ----------- 2QC= ...[ 2QWW ...[ 2RBG ...[ THIS SUBROUTINE SEARCHES FOR A FILE'S FILE CONTROL AREA (FCA) 2RW6 ...[ ON ENTRY, X2=FX2, AWORK3= DEPTH OF FILE. X6 IS S?R LINK 2S*Q ...[ ON EXIT , X1->FCA, X2=FX2. X0 DESTROYED. 2STB ...SFCA 2T*2 ... SFSTACK AWORK3(2),1 [X1-> FCA 2TSL ... EXIT 6 0 6F46 [ 6FHQ [ X2-> ACT. WHOSE JOB BLOCK IS TO BE SOUGHT (USUALLY CURRENT ACT.) 6G3B [ 6GH2 SJOBLOCK 6H2L LDX 0 JOBNO(2) 6HG= BZE 0 NOLOBJOB [ERROR IF JOB NO. ZERO 6H^W FCJOB 1,2,,CPA,OLPA [X1-> JOB BLOCK 6MC= EXIT 6 0 8G2= [ 8GFW [ S/R TO SET UP AN ADATA/CREADL CONTAINING A COMMAND 8G^G [ ON ENTRY, X2=FX2. 8HF6 [ 8HYQ SETCOM 8JDB SBX 6 FX1 8JY2 LDX 1 FX1 8KCL ADX 1 7 [X1-> WORD BEFORE COMMAND 8KX= LDX 0 0(1) [X0= NO. OF CHARS IN MESSAGE 8LBW ADN 0 3 8LWG SLL 0 2 [X0= LENGTH OF MESSAGE IN WORDS 8MB6 ADN 0 CPDATA-A1 8MTQ STO 0 ACOMMUNE1(2) 8N*B SETUPCORE ACOMMUNE1(2),2,ADATA,CREADL [BLOCK FOR COMMAND 8NT2 ADX 1 7 [X1-> WORD BEFORE COMMAND 8P#L LDX 0 0(1) 8PS= STO 0 A1(2) [SET UP CHAR COUNT 8Q?W STOZ A1+1(2) [CLEAR 2ND RED-TAPE WORD 8QRG ADN 1 1 8R?6 ADN 2 CPDATA 8RQQ ADN 0 3 8S=B SLL 0 2 8SQ2 SMO 0 8T9L MOVE 1 0 [MOVE COMMAND ACROSS 8TP= ADX 6 FX1 8W8W EXIT 6 0 8WNG [ 8X86 [ S/R TO ISSUE A COMMAND IN ADATA/CREADL BLOCK 8XMQ [ 8Y7B UCOM 8YM2 SBX 6 FX1 8^6L ISSUCOMB OTHERERR,XBRK [ISSUE COMMAND 8^L= ADX 6 FX1 925W EXIT 6 0 92KG ...XBRK 9356 ... CALL 6 SJOBLOCK [X1-> JOB BLOCK 93JQ ... TRACEIF K6INCRCUBS,199,399,JNAME(1),BRK JBN [BREAK-IN 944B ... TRACEIF K6INCRCUBS,199,399,CUBS(1),BRK CUBS 946# ... FSHCODE B,XBRKA 948= ...( 94=8 ... TRANCHKN FSHINCBX,EQUAL,XBRK1 94#6 ... TRANSFIN 94B4 ...XBRKA 94D2 ...) 94FY ...XBRK1 94J2 UP 953L # 953R ...[ 953Y ...[ 9545 ...[ 954= ...X1INCRCUBX 954? ... FSHCODE A,X1INCRCONT 954# ...( 954* ... NOTALIEN X1INCR 954B ... TRANSBEG FSHINCBX,INCRCUBX,1,NOBLOCKS,,ACOMMUNE1,UACD 954C ... BRN XBRK1 954D ...UACD BRN UP1A 954F ...X1INCRCONT 954G ...) 954H ...X1INCR 954J ... CALL 6 SJOBLOCK [X1-> JOB BLOCK 954K ... SBS 3 CUBS(1) [RESET CUBS TO TRUE VALUE (IN CASE J 954P ... [ ABANDONED DURING QUESTION) 954W ... SPRIVJUMP JSISSUE,1,SYSISS [J IF SYSTEM-ISSUED 9553 ... SPRIVJUMP JSSTART,1,SYSISS [J IF SYSTEM-STARTED 9558 ... BCONTEXT XBR,2,BREAKIN [J IF BREAK-IN CONTEXT 955* ... LDN 7 MREACH 955G ... CALL 6 SETCOM [SET UP DISPLAY COMMAND 955M ... CALL 6 UCOM [ISSUE "DP LIMIT OF ONLINE BACKING ST 955S ... [ REACHED" TO MON. FILE 955^ ... [ & CENTRAL OPS CONSOLE 9566 ...QUES 956? ... LDN 7 MQUES 956D ... CALL 6 SETCOM [SET UP QUESTION COMMAND 956K ... CALL 6 UCOM [QN 2,CAN THIS JOB'S LIMIT BE INCREAS 956Q ... MHUNTW 2,APED,ADISPLAY 956X ... LDX 6 APEDDISM(2) [X6= NO. OF CHARS IN ANSWER 9574 ... LDCH 7 APEDDISM+1(2) [PICK UP 1ST CHAR. OF ANSWER 9579 ... FREECORE 2 957B ... BZE 6 WRANS [J IF NO CHARS IN ANSWER 957H ... SBN 7 #71 957N ... BZE 7 REPYES [J IF ANSWER "Y......." 957T ... ADN 7 #71-#56 9582 ... BZE 7 REPNO [J IF ANSWER "N......." 9587 ...WRANS 958# ... LDN 7 MYESNO 958F ... CALL 6 SETCOM [SET UP DISPLAY COMMAND 958L ... CALL 6 UCOM [DP 2,PLEASE ANSWER YES OR NO 958R ... BRN QUES 958Y ...REPYES 9595 ... CALL 6 SJOBLOCK [X1-> JOB BLOCK 959= ... STOZ ACOMMUNE2(2) [CLEAR 'SYSTEM-ISSUED/STARTED JOB' MA 959C ... LDX 0 IDEFBS [PICK UP IP DEFAULTBS 959J ... SLA 0 1 959P ... BVCR NOOVRFL [IF OVERFLOW,SET AMBS TO LARGE +IVE N 959W ... LDCT 0 #377 95=3 ...NOOVRFL 95=8 ... LDX 5 AMBS(1) [X5= OLD LIMIT 95=* ... STO 0 AMBS(1) [SET NEW LIMIT (AMBS) 95=G ... SBX 5 0 95=M ... BZE 5 UNCH [J IF LIMIT UNCHANGED 95=S ... LDX 4 0 95=^ ... SRL 4 1 [X4= NEW LIMIT IN KWORDS 95?6 ... LDN 7 MNEW 95?? ... CALL 6 SETCOM [SET UP DISPLAY COMMAND 95?D ... SMO FX2 95?K ... LDX 0 ACOMMUNE2 95?Q ... BZE 0 NSYSISS [J IF NOT SYSTEM-ISSUED/STARTED 95?X ... LDX 0 0(2) 95#4 ... SBN 0 2 95#9 ... STO 0 0(2) [CHANGE DISPLAY TO 'ONLY TO MOP' 95#B ...NSYSISS 95#H ... MHUNTW 1,ADATA,CREADL 95#N ... ADN 1 CPDATA+4 95#T ... XCBINDEX 2,1,4 [INSERT NEW VALUE IN DISPLAY COMMAND 95*2 ... CALL 6 UCOM [DP ,LIMIT NOW N KWORDS 95*7 ... BPZ 5 UNCH [J IF LIMIT HAS NOT INCREASED 95*# ... CALL 6 SJOBLOCK [X1-> JOB BLOCK 95*F ... ADS 3 CUBS(1) [UPDATE CUBS 95*L ... LDX 0 AMBS(1) 95*R ... SBX 0 CUBS(1) 95*Y ... BPZ 0 YOK [J IF ENOUGH NOW (BXGE NOT USED 95B5 ... [ SINCE IF CUBS IS -IVE THIS CAUSES 95B= ... [ CHAOS) 95BC ... SBS 3 CUBS(1) [REDUCE CUBS AGAIN 95BJ ... BRN REPNO 95BP ...# 95BW ...# AUTOMATICALLY INCREASE AMBS FOR SYSTEM-ISSUED & SYSTEM-STARTED JOBS. 95C3 ...# 95C8 ...SYSISS 95C* ... STO 2 ACOMMUNE2(2) [ACOMMUNE2 NON-ZERO MEANS 'SYSTEM-ISS 95CG ... LDX 6 CUBS(1) 95CM ... ADX 6 3 [X6= NEW VALUE OF CUBS 95CS ... LDX 0 AMBS(1) 95C^ ... ADN 0 20 95D6 ... BXGE 0 6,NOOVRFL [J IF 10K EXTRA IS ENOUGH 95D? ... LDX 0 6 [IF NOT, GIVE IT WHAT ITS ASKING FOR 95DD ... BRN NOOVRFL 95DK ...# 95DQ ...XBR [QUESTION COMMAND NOT ALLOWED IN BREA 95DX ... [ CONTEXT SO ALLOW UP TO 10K EXTRA & 95F4 ... [ THEN REFUSE REQUEST 95F9 ... LDX 4 AMBS(1) 95FB ... ADN 4 20 95FH ... SBX 4 CUBS(1) 95FN ... SBX 4 3 [X4= NO. OF BLOCKS FROM THE 20 EXTRA 95FT ... [ ALLOWED IN BREAK-IN CONTEXT WHICH 95G2 ... [ ARE STILL SPARE 95G7 ... BNG 4 XBRN1 [J IF MORE THAN 20 BLOCKS OVER LIMIT 95G# ... LDX 0 3 95GF ... SBN 0 1 95GL ... BNZ 0 XBRN1 [J IF NOT JUST ASKING FOR 1 BLOCK 95GR ... LDX 0 4 95GY ... ANDN 0 1 95H5 ... BNZ 0 XBROK [J IF ODD NO. OF BLOCKS SPARE OUT OF 95H= ...XBRN1 95HC ... LDN 7 MREACH 95HJ ... CALL 6 SETCOM [SET UP DISPLAY COMMAND 95HP ... LDX 0 0(2) 95HW ... SBN 0 2 95J3 ... STO 0 0(2) [CHANGE DISPLAY TO GO ONLY TO MOP CON 95J8 ... CALL 6 UCOM [DP 0,LIMIT OF ONLINE BACKING STORE R 95J* ... BNG 4 REPNO [J IF >20 BLOCKS OVER LIMIT 95JG ... LDN 7 MBREAK 95JM ... CALL 6 SETCOM [SET UP DISPLAY COMMAND 95JS ... LDN 1 5(2) [X1 _ POSITION TO INSERT HOW MUCH LEF 95J^ ... SRL 4 1 [X4= KWORDS LEFT OF EXTRA 20 95K6 ... XCBINDEX 2 [CONVERT TO CHARS. & INSERT IN DP COM 95K? ... SMO FX1 95KD ... LDX 0 MBREAK+6 95KK ... SBN 1 2 95KQ ... STO 0 0(1) [REINSTATE "TEXT" IN DP COMMAND 95KX ... CALL 6 UCOM [DP 0,BREAK-IN CONTEXT N KWORDS MORE 95L4 ... [ ALLOWED 95L9 ... CALL 6 SJOBLOCK [X6-> JOB BLOCK 95LB ...XBROK 95LH ... ADS 3 CUBS(1) [UPDATE CUBS SINCE REQUEST GRANTED 95LN ...YOK 95LT ... SETREP2 OK 95M2 ... TRACEIF K6INCRCUBS,199,399,JNAME(1),OPS OK [ASKED OPS & OK 95M7 ... TRACEIF K6INCRCUBS,199,399,CUBS(1),OPS CUBS 95M# ...UP1 95M* ... FSHCODE B,UP1CONT 95MB ...( 95MC ... TRANCHKN FSHINCBX,EQUAL,UP1A 95MD ... LDN 5 1 95MF ... TRANSFIN 5 95MG ...UP1CONT 95MH ...) 95MJ ...UP1A 95MK ... UPPLUS 1 95ML ...UNCH 95MR ... LDN 7 MNOTINC 95MY ... CALL 6 SETCOM [SET UP DISPLAY COMMAND 95N5 ... CALL 6 UCOM [DP 2,LIMIT NOT INCREASED 95N= ...REPNO 95NC ... SETREP2 REFUSED 95NJ ... CALL 6 SJOBLOCK [X1-> JOB BLOCK 95NP ... TRACEIF K6INCRCUBS,199,399,JNAME(1),OPS REF [ASKED OPS & REFUS 95NW ... TRACEIF K6INCRCUBS,199,399,CUBS(1),OPS CUBS 95P3 ... BRN UP1 95P8 ...[ 95P* ...[ 95PG ...[ 95PM ...X2INCRCUBX 95PS ... CALL 6 SFCA [X1-> FCA 95P^ ... STO 1 ACOMMUNE2(2) [REMEMBER CURRENT FCA 95Q6 ... PSTAC 1,1 [X1-> FSTACK BLOCK 95Q7 ... BFCBX 2,1 [X2-> FCB 95Q8 ... JBS UP,2,BFWORK [EXIT IF WORKFILE (CAN'T BE OPEN TO A 95Q9 ... [ ONLY COUNT ! FILES ONCE PER JOB) 95Q? ... LDEX 7 ARINGNO(1) [NO.OF ELEMENTS 95QD ... ADN 1 A1 [FIRST ELEMENT 95QK ...[ 95QQ ...[ TAKE EACH ELEMENT IN TURN,UPDATE ITS CUBS IF IT HAS ONE 95QX ...[ 95R4 ...NEXTLMLOOK 95R9 ... SMO FX2 95RB ... BXE 1 ACOMMUNE2,NEXTELEM [J IF THIS FCA IS ONE SPECIFIED BY DE 95RH ... JBC NEXTELEM,1,BACUBS [J IF PUBLIC 95RN ... LDX 4 1 [X4-> FILE CONTROL AREA 95RT ...[ SEARCH FOR ACTIVITY BLOCK 95S2 ...NOTACT 95S7 ... SMO 4 95S# ... LDX 2 FPTR [X2-> NEXT FCA 95SF ... LDX 4 2 95SL ... ADX 2 FBACKPOINT(2) [X2-> BLOCK 95SR ... LDX 0 ATYPE(2) 95SY ... BXL 0 CACT,NOTACT [J IF NOT AN ACTIVITY BLOCK 95T5 ...[ 95T= ...[ X2-> ACT. BLOCK 95TC ...[ 95TJ ... LDX 0 JOBNO(2) 95TP ... BZE 0 NEXTELEM [J IF NO JOB NO. (MAY BE CLOSE) 95TW ... LDX 5 1 [X5-> FCA 95W3 ... CALL 6 SJOBLOCK [X1-> JOB BLOCK 95W8 ...[ 95W* ...[ 95WG ... JBS SUBC,FX2,XBSUBCUBS [J IF SUBCUBS 95WM ... ADS 3 CUBS(1) [INCREASE CUBS 95WS ... TRACEIF K6INCRCUBS,199,399,JNAME(1),COM JBN [COMMUNE & THIS IS 95W^ ... TRACEIF K6INCRCUBS,199,399,CUBS(1),COM CUBS 95X6 ... LDX 0 CUBS(1) 95X? ... BXL 0 GUBS(1),SUBD [J IF CUBS < GUBS 95XD ... STO 0 GUBS(1) [RESET GUBS 95XK ...SUBD 95XQ ... LDX 1 5 [X1-> FCA 95XX ...NEXTELEM 95Y4 ... ADN 1 FELLEN 95Y9 ... BCT 7 NEXTLMLOOK 95Y? ...UP 95YB ... UP 95YH ...SUBC 95YN ... SBS 3 CUBS(1) [REDUCE CUBS 95YT ... TRACEIF K6INCRCUBS,199,399,JNAME(1),SUBC JBN [ 95^2 ... TRACEIF K6INCRCUBS,199,399,CUBS(1),SUBCCUBS 95^7 ... BRN SUBD 95^# ...[ 95^F ...# 95^L ...NOLOBJOB 95^R ... GEOERR 1,NOLOBJOB [ JOB BLOCK MISSING 95^Y ...OTHERERR 9625 ... GEOERR 1,INCRCUBS [ANY OTHER CLEAR MALFUNCTION 962W # 96GG #END ^^^^ ...22731127000700000000