{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: INCRCUBX860)}}
====== INCRCUBX860 ======
(George Source)
**Macros used:** [[george:macro:BCONTEXT|BCONTEXT]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:FCJOB|FCJOB]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:ISSUCOMB|ISSUCOMB]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NOTALIEN|NOTALIEN]], [[george:macro:OR|OR]], [[george:macro:PSTAC|PSTAC]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SFCA|SFCA]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SPRIVJUMP|SPRIVJUMP]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:TRANCHKN|TRANCHKN]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:TRANSFIN|TRANSFIN]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:XCBINDEX|XCBINDEX]]
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