{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: JDWRITE867)}}
====== JDWRITE867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BC|BC]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BUDGBITX|BUDGBITX]], [[george:macro:BUDGUSE|BUDGUSE]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FOX|FOX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETJOB|GETJOB]], [[george:macro:HLSINFORM|HLSINFORM]], [[george:macro:JBC|JBC]], [[george:macro:JBCSBS|JBCSBS]], [[george:macro:JBS|JBS]], [[george:macro:JLADJUST|JLADJUST]], [[george:macro:JLTEMPLATE|JLTEMPLATE]], [[george:macro:JMBS|JMBS]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OPEN|OPEN]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:READDICT|READDICT]], [[george:macro:REPLACE|REPLACE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SIX|SIX]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:STEP|STEP]], [[george:macro:TESTERR|TESTERR]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:URGTIME|URGTIME]]
22FL #OPT K0JDWRITE = 0
22^= #LIS K0JDWRITE>K0COMMAND>K0HLS>K0ALLGEO>K0GREATGEO
23DW #SEG JDWRITE [V E PHIPPS
23JR ...[
23NN ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
23SK ...[
23YG 8HJDWRITE
245N ...#UNS G400
24=W ...# THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK 2
24D6 [ THIS SEGMENT UPDATES A JOB ENTRY IN JOBLIST
24XQ [ WITH JOBDATA SPECIFIED IN AN ADATA/CSTORE
25CB [ THAT WAS SET UP BY JOBDATA SEGMENT.
25X2 SEGENTRY K1JDWRITE,XK1 [UPDATE JOBLIST
26BL SEGENTRY K2JDWRITE,XK2 [URGENCY CHECKS
26W= SEGENTRY K3JDWRITE,XK3 [JOBTIME CHECKS
27*W [
27TG [ TEMPLATE IN 1ST RECORD OF JOBLIST
28*6 TEMPLATE
28SQ JLTEMPLATE JD
29#B [
29S2 TDEFAULT [ITEM/FACILITY NUMBERS OF 'DEFAULTABLE' ITEMS
2=?L [ORDER MUST CORRESPOND TO ORDER IN JLDFIND
2=R= #4001 [JOBTIME
2?=W #4006 [MAXSIZE
2?QG #0007 [MAXQUOTA
2#=6 TDEFAULTEND
2#PQ YER4 +JTTWICE
2*9B YER7 +ERB9
2*P2 YER8 +ERB10
2B8L YER9 +ERB1
2BN= YER10 +JDOVERFLOW
2BY4 ...YER11 +JSYSFILE
2B^7 ...#UNS G400
2C2= ...(
2C3* ...YER12 +JINVJNO
2C4D ...YER13 +JUSERJOB
2C5H ...YER14 +APFERR
2C6L ...)
2C7W ONE +1
2CMG SIX +6
2D76 SEVEN +7
2DLQ NINE +9
2F6B TEN +10
2FL2 SIXTYFOUR +64
2G5L XWAIT #31 [WAITING STYLE FOR MOP JOBS
2GK= #32 [WAITING STYLE FOR BACKGROUND JOBS
2H4W ZFABSNB +10
2HJG 12HMASTER
2J46 12HDICTIONARY
2JHQ +0 [GENERATION NO
2K3B +1 [REEL NO
2KH2 +0 [LANGUAGE CODE
2L2L #DEF W0 = 0
2LG= #DEF W1 = 1
2L^W #DEF W2 = 2
2MFG [
2M^6 BITDEFS W0,5,SINGLE,TMINUS,TPLUS,PMINUS
2NDQ BITDEFS W1,0,TFIXED
2NYB BITDEFS W1,12,TCOUNT
2PD2 BITDEFS AWORK4,2,TFORMAT,STARTCOM,SIGNEED
2PXL [
2QC= [ SUBROUTINES
2QWW [
2RBG RCLOSE
2RW6 SBX 5 FX1 [LEAVES A RELATIVE JUMP IN LINK ADDRE
2S*Q CLOSE
2STB ADX 5 FX1 [ADD IN THE'HEAD OF CURRENT CHAPTER'M
2T*2 EXIT 5 0
2TSL [ TEST THAT FILE WAS OPENED SUCCESSFULLY
2W#= TESTOPENOK
2WRW TESTREP2 OK,TOK9
2X?G TESTERR CLUDGE,TOK8
2XR6 GEOERR 1,NO FILE
2Y=Q TOK8 EXIT 5 0
2YQB TOK9 EXIT 5 1
2^=2 [
2^PL [ S/R TO FIND JOB BLOCK FROM CPAT
329= SFJOCA
32NW LDX 2 FX2
338G FJOCA 2
33N6 EXIT 4 0
347Q SASUP MHUNT 3,FILE,FWB
34MB NAME 3,ADATA,ASUP
3572 EXIT 7 0
35LL OLDVJLENTRY
366= [ THIS S/R FINDS THE ENTRY IN JWELL/COPYSYS GIVEN THE ITEM
36KW [ NO. SPECIFIED IN RECORD POINTED TO BY X3. LINK IS X4.
375G [ ON EXIT, X2 IS NEG. IF ENTRY NOT FOUND, ELSE X2->ENTRY
37K6 LDX 5 W1(3)
384Q SRL 5 12 [ITEM NO.
38JB MHUNTW 2,JWELL,COPYSYS
3942 LDX 0 ALOGLEN(2)
39HL SMO JOBDATASIZE
3=3= SBN 0 FRH+JLRESTF+1
3=GW BNG 0 OJL8 [J IF NO VAR. RES. FIELD
3?2G LDN 0 A1(2)
3?G6 ADX 0 ALOGLEN(2)
3?^Q STO 0 GEN0 [SAVE PTR->END OF COPYSYS
3#FB JLADJUST 2 [ADJUST FOR NEWJOBDATA
3#^2 LDN 2 JLRESTF(2)
3*DL OJL3 LDX 0 0(2)
3*Y= SRL 0 12 [ITEM NO.
3BCW BXE 0 5,OJL9 [J IF ENTRY FOUND
3BXG LDEX 0 0(2) [LENGTH OF RECORD
3CC6 ADX 2 0
3CWQ BXL 2 GEN0,OJL3 [J IF MORE DATA
3DBB OJL8 LDX 2 GSIGN [NOT FOUND IND.
3DW2 OJL9 EXIT 4 0
3F*L VARMOVE
3FT= [ THIS S/R MOVES DATA FROM THE CSTORE RECORD POINTED TO BY
3G#W [ X3 INTO AREA STARTING AT ADDR. IN X6. LINK IS X4.
3GSG LDEX 0 W0(3)
3H#6 SBN 0 2 [LENGTH OF DATA
3HRQ VARMOVE1
3J?B LDN 5 W2(3)
3JR2 SMO 0
3K=L MOVE 5 0
3KQ= EXIT 4 0
3L9W OLDFJLENTRY
3LPG [ THIS S/R FINDS THE ENTRY IN JWELL/COPYSYS GIVEN THE
3M96 [ FACILITY NUMBER SPECIFIED IN RECORD OF CSTORE POINTED TO
3MNQ [ BY X3. LINK IS X4.
3N8B [ ON EXIT, X2-> ENTRY
3NN2 LDXC 5 W1(3)
3P7L SRL 5 12 [FACILITY NUMBER
3PM= LDN 1 TEMPLATE(1) [X1->TEMPLATE
3Q6W SMO JFACTAB+1-A1(1)
3QLG LDN 1 2(1) [X1-> FACILITY TABLE
3R66 LDN 0 3
3RKQ MPY 5 0 [X6->ENTRY IN FAC.TABLE
3S5B BXGE 6 0(1),NOFACILITY [J IF NOT IN TABLE
3SK2 MHUNTW 2,JWELL,COPYSYS
3T4L LDN 2 A1(2)
3TJ= SMO 6
3W3W ADX 2 2(1)
3WHG SMO 6
3X36 LDX 0 3(1) [LENGTH OF ENTRY
3XGQ OFE9 LDX 1 FX1
3Y2B EXIT 4 0
3YG2 NOFACILITY
3Y^L GEOERR 1,NOSUCHJD
3^F= [
3^YW SCOPYSYS
42DG MHUNTW 2,JWELL,COPYSYS
42Y6 EXIT 1 0
43CQ [
43XB SETLEN
44C2 [ THIS S/R CHANGES THE LOGICAL LENGTH OF THE JWELL/COPYSYS
44WL [ SO IT CAN HOLD RECORD POINTED TO BY X3.
45B= [ THE NEW AREA IS ZEROISED AND RECORD LENGTH IS
45TW [ PUT IN THE FIRST WORD. X3 AND ACOMMUNE2 RESET IF LENGTH
46*G [ INCREASES AND X2-> NEW AREA. LINK IS X4.
46T6 LDEX 6 W0(3)
47#Q SBN 6 1 [EXTRA WORDS REQUIRED
47SB SETLEN1
48#2 SBX 4 FX1
48RL BZE 6 SETLEN7 [J IF LOGLEN UNALTERED
49?= CALL 1 SCOPYSYS [X2->JWELL/COPYSYS
49QW LDX 3 6
4==G ADX 3 ALOGLEN(2) [NEW LOGICAL LENGTH
4=Q6 ALTLENG 2,3,SCOPYSYS
4?9Q CALL 1 SCOPYSYS
4?PB SMO FX2
4#92 STO 2 ACOMMUNE2
4#NL BNG 6 SETLEN7 [J IF BLOCK REDUCED
4*8= ADX 2 ALOGLEN(2)
4*MW ADN 2 A1
4B7G SBX 2 6 [X2-> NEW RECORD
4BM6 STOZ 0(2)
4C6Q LDN 3 1(2)
4CLB SMO 6
4D62 MOVE 2 511 [ZEROISE NEW RECORD
4DKL SETLEN7
4F5= MHUNTW 3,ADATA,CSTORE
4FJW SMO FX2
4G4G STO 3 ACOMMUNE1
4GJ6 ADX 3 A1+1(3) [X3-> CURRENT CSTORE RECORD
4H3Q BNG 6 SETLEN9 [J IF LOGLEN REDUCED
4HHB BZE 6 SETLEN9
4J32 LDX 0 W1(3)
4JGL STO 0 0(2) [STORE ITEM NO. AND ....
4K2= DSA 6 0(2) [...REC. LENGTH IN REC. HEDDR
4KFW SETLEN9
4K^G LDX 1 FX1
4LF6 ADX 4 1
4LYQ EXIT 4 0
4MDB REMOVESEL
4MY2 [ THIS S/R REMOVES VARIABLE ENTRIES FROM JWELL/COPYSYS
4NCL [ X7 IS LINK. (B0 SET IF SELECTIVE)
4NX= [ X3 -> RECORD IN ADATA/CSTORE HOLDING ITEM NO. (AND DATA IF
4PBW [ SELECTIVE REMOVAL)
4PWG ORX 7 GSIGN
4QB6 REMOVEALL
4QTQ MHUNTW 1,JWELL,COPYSYS
4R*B LDX 2 FX2
4RT2 STO 1 ACOMMUNE2(2)
4S#L LDX 0 ALOGLEN(1)
4SS= SMO JOBDATASIZE
4T?W SBN 0 FRH+JLRESTF+1
4TRG BNG 0 RMV9 [J IF NO VAR. RES. FIELD
4W?6 JLADJUST 1 [ADJUST FOR NEWJOBDATA
4WQQ LDN 1 JLRESTF(1)
4X=B STO 1 ACOMMUNE4(2) [X1-> ENTRY IN JWELL/COPYSYS
4XQ2 STO 3 ACOMMUNE3(2) [X3-> ADATA/CSTORE RECORD
4Y9L BRN RMV7
4YP= RMV1 LDEX 5 0(1) [RECORD LENGTH
4^8W LDX 4 0(1)
4^NG ERX 4 W1(3)
5286 SRL 4 12
52MQ BNZ 4 RMV6 [J IF DIFF. ITEM NOS.
537B BPZ 7 RMV4 [J IF NO SELECT. CHECK
53M2 LDX 4 W0(3)
546L SBN 4 2
54L= LDEX 0 4 [LENGTH OF DATA
555W BXGE 0 5,RMV6 [J IF NO MATCH
55KG SLC 4 2
5656 ANDN 4 #3777
56JQ LDX 0 4
574B ANDN 0 3 [CHAR. POSN.
57J2 BZE 0 RMV3 [J IF LAST WORD NOT SPACEFILLED
583L SBN 4 4
58H= RMV3 BZE 4 (GEOERR) [NO. OF CHS. TO BE COMPARED
592W RMV33 LDCH 6 1(1)
59GG LDCH 0 W2(3)
5=26 BXU 0 6,RMV6 [J IF NO MATCH
5=FQ BCHX 1 £
5=^B BCHX 3 £
5?F2 BCT 4 RMV33
5?YL RMV4 LDX 1 ACOMMUNE4(2)
5#D= ADX 1 5 [X1 -> NEXT COPYSYS RECORD
5#XW CALL 4 TESTLEN [CHECK IF MORE RECORDS
5*CG BNG 0 (GEOERR)
5*X6 BZE 0 RMV5 [J IF LAST RECORD
5BBQ LDX 2 ACOMMUNE4(2) [PTR.->ENTRY IN JWELL/COPYSYS
5BWB SMO 0
5CB2 MOVE 1 0
5CTL RMV5 CALL 1 SCOPYSYS
5D*= LDX 6 ALOGLEN(2)
5DSW SBX 6 5
5F#G ALTLENG 2,6 [REMOVE REDUNDANT WORDS
5FS6 LDN 5 0
5G?Q RMV6 LDX 2 FX2
5GRB ADS 5 ACOMMUNE4(2)
5H?2 LDX 1 ACOMMUNE4(2)
5HQL LDX 3 ACOMMUNE3(2)
5J== RMV7 CALL 4 TESTLEN
5JPW BNG 0 (GEOERR)
5K9G BZE 0 RMV9 [J IF END JWELL/COPYSYS
5KP6 BRN RMV1
5L8Q RMV9 ORX 7 GSIGN
5LNB ERX 7 GSIGN [REMOVE SELECT. IND.
5M82 EXIT 7 0
5MML TESTLEN
5N7= [ THIS S/R CHECKS X1 -> TO WORD WITHIN JWELL/COPYSYS
5NLW [ ON EXIT, X0 HOLD INCLUSIVE WORD COUNT FROM [X1] TO END OF
5P6G [ BLOCK. LINK IS X4
5PL6 SMO FX2
5Q5Q LDX 3 ACOMMUNE2
5QKB LDX 0 ALOGLEN(3)
5R52 ADN 0 A1(3)
5RJL SBX 0 1
5S4= SMO FX2
5SHW LDX 3 ACOMMUNE3
5T3G EXIT 4 0
5TH6 XBINADDSUB
5W2Q [ THIS S/R ADDS/SUBTRACTS WORDS FROM FIELD(POINTED TO BY X3)
5WGB [ INTO FIELD(POINTED TO BY X2). LINK IS X4
5X22 LDEX 5 W0(3)
5XFL SBN 5 2 [LENGTH OF DATA
5X^= JBS XAS3,3,TPLUS
5YDW ORX 4 GSIGN
5YYG XAS3 LDX 0 W2(3)
5^D6 BPZ 4 XAS4
5^XQ SBS 0 0(2)
62CB BRN XAS5
62X2 XAS4 ADS 0 0(2)
63BL XAS5 ADN 2 1
63W= ADN 3 1
64*W BCT 5 XAS3
64TG ORX 4 GSIGN
65*6 ERX 4 GSIGN
65SQ EXIT 4 0
66#B [
66S2 [ ZEROISE X4 WORDS FROM 0(2), IF NEW DATA
67?L [ IN 0(3) IS NOT SIGNED
67R= ZEROISE
68=W JMBS ZERO9,3,TMINUS,TPLUS
68QG STOZ 0(2)
69=6 STO 3 GEN0
69PQ LDN 3 1(2)
6=9B SMO 4
6=P2 MOVE 2 511
6?8L LDX 3 GEN0
6?N= ZERO9 EXIT 7 0
6#7W #
6#MG WOOPS GEOERR 1,REC NFD
6#N5 ...#UNS G400
6#NN ...(
6#P? ...# 2 S/RS FOR USE OF HOOKS CODE. GET USERNAME OR JOBNAME
6#PW ...# FROM CPB/CALAS BLOCK AND STORE IT IN 3 WORD AREA
6#QF ...# STARTING AT ADDRESS HELD IN X6.1ST S/R SETS ANALYSIS
6#R4 ...# LEVEL TO ZERO .X4 HOLDS NO OF PARAM IN CPB/CALAS BLOCK
6#RM ...# X5 =LINK FOR BOTH
6#S= ...QGET LDN 7 0
6#ST ... SBX 5 FX1
6#TD ... SPARANOX 4,7
6#W3 ... MHUNT 3,CPB,CUNI
6#WL ... ADX 5 FX1
6#X9 ... EXIT 5 0
6#XS ...QMOVE SBX 5 FX1
6#YC ... LDX 7 ANUM(3)
6#^2 ... ANDN 7 #7777
6#^K ... STO 5 GEN0
6*28 ... LDN 5 APARA(3)
6*2R ... SMO 7
6*3B ... MVCH 5 0
6*3^ ... LDX 5 GEN0
6*4J ... FREECORE 3
6*57 ... ADX 5 FX1
6*5Q ... EXIT 5 0
6*6* ...)
6*76 # UPDATE JOB ENTRY WITH JD DATA
6*LQ XK1
6B6B JBC XK1A,2,STARTCOM [J IF NOT JOBDATA PARAM
6BL2 MHUNTW 3,JWELL,COPYSYS
6C5L BRN XK1B
6CK= XK1A
6D4W OPENSYS XBREAK,JOBLIST,GENERAL,QUERY [OPEN SYSTEM.JOBLIST
6D=4 ... TESTREP OK,OPENOK
6DC= ... TESTREP CLUDGE,XNOJL
6DJD ...[ THE FOLLOWING 'TESTREP' CAN BE REMOVED WHEN
6DPL ...[ 'OPENSYS' IS CORRECTED TO REPLY WITH 'CLUDGE' INSTEAD OF
6DWS ...[ 'NAME' WHEN DIRECTORY IS OPEN TO SAME JOB
6F42 ... TESTREP NAME,XNOJL
6F98 ... GEOERR 1,JDNOJL [ UNEXPECTED REPLY
6FBB ...OPENOK
6FBD ...#UNS G400
6FBG ...(
6FBJ ...# CODE FOR NEW FORMAT OF JD COMMAND.AWORK3=0 COMMAND EITHER
6FBL ...# OLD FORMAT OR HOOK NOT ON.AWORK3 NEG RECORD IDENTIFIED BY
6FBN ...# JOB NO. AWORK3=1 BY JOBNAME/USERNAME.AWORK3=2 BY USERNAME
6FBQ ...# /JOBNAME
6FBS ... LDX 4 AWORK3(2)
6FBW ... BZE 4 XK11 [J. INTO GEORGE CODE
6FBY ... BPZ 4 XK12 [SEARCH FOR JOB/USER NAMES
6FC2 ... LDX 6 AWORK3(2)
6FC4 ... ERX 6 GSIGN
6FC6 ... GETJOB 6,SYSTEM
6FC8 ... TESTRPN2 OK,XERR1
6FC= ... BRN XK13
6FC# ...# THE NEXT CODE IS FOR USERNAME/JOBNAME SEARCH
6FCB ...XK12 LDX 6 ACES [SPACE FILL ACOMMUNE 1-6
6FCD ... STO 6 ACOMMUNE1(2)
6FCG ... LDN 6 ACOMMUNE1(2)
6FCJ ... LDN 7 ACOMMUNE2(2)
6FCL ... MOVE 6 5
6FCN ... CALL 5 QGET [GET JOBNAME
6FCQ ... LDN 6 ACOMMUNE4(2)
6FCS ... CALL 5 QMOVE [MOVE TO ACOMMUNE4-6
6FCW ... SBN 4 1
6FCY ... BNZ 4 QC1
6FD2 ... ADN 4 2
6FD4 ...QC1 CALL 5 QGET [GET USERNAME
6FD6 ... LDN 5 APARA(3)
6FD8 ... LDX 6 5
6FD= ... BCHX 5 £
6FD# ... LDX 7 ANUM(3)
6FDB ... ANDN 7 #7777
6FDD ... SBN 7 1
6FDG ... SMO 7
6FDJ ... MVCH 5 0 [OVERWRITE :
6FDL ... STO 7 ANUM(3)
6FDN ... LDN 6 ACOMMUNE1(2)
6FDQ ... CALL 5 QMOVE [MOVE TO ACOMMUNE1-3
6FDS ... STEP [FORMAT RECORD NOT WANTED
6FDW ... LDN 1 TEMPLATE(1)
6FDY ... LDX 4 JUSERELADD-A1+1(1) [USERNAME PTR
6FF2 ... LDX 5 JJOBRELADD-A1+1(1) [JOBNAME PTR.
6FF4 ...ZP1 STEP
6FF6 ... BZE 3 XERR2 [J.IF NO REC FOUND
6FF8 ... LDN 7 3 [COUNT
6FF= ... LDN 6 ACOMMUNE1(2)
6FF# ... ADX 3 4 [U/NAME ADDRESS
6FFB ...ZP2 SMO 6
6FFD ... LDX 0 0
6FFG ... TXU 0 0(3)
6FFJ ... BCS ZP1
6FFL ... ADN 3 1
6FFN ... ADN 6 1
6FFQ ... BCT 7 ZP2
6FFS ... SBN 3 3 [U/NAME FOUND,CHECK JOBNAME
6FFW ... LDN 7 3
6FFY ... SBX 3 4
6FG2 ... ADX 3 5
6FG4 ...ZP3 SMO 6
6FG6 ... LDX 0 0
6FG8 ... TXU 0 0(3)
6FG= ... BCS ZP1
6FG# ... ADN 3 1
6FGB ... ADN 6 1
6FGD ... BCT 7 ZP3
6FGG ... BRN XK13 [REJOIN GEORGE CODE
6FGJ ...)
6FGL ...#UNS G400
6FGN ...XK11
6FHQ GETJOB JOBNO(2),SYSTEM [GET JOB ENTRY IN JOBLIST
6G3B TESTRPN2 OK,WOOPS
6G8J ...#UNS G400
6G*Q ...XK13
6GH2 READAGAIN
6H2L MHUNTW 3,FILE,FRB
6HG= NAME 3,JWELL,COPYSYS
6H^W XK1B
6JFG STO 3 ACOMMUNE2(2) [ADDR. OF JOB ENTRY
6J^6 MHUNTW 3,ADATA,CSTORE
6KDQ LDN 4 A1+2 [PTR->FIRST RECORD OF CSTORE
6KYB BRN NXT4
6LD2 NEXT
6LXL LDX 1 FX1
6MC= LDX 2 FX2
6MWW MHUNTW 3,ADATA,CSTORE
6NBG LDX 4 A1+1(3)
6NW6 SMO 4
6P*Q LDEX 0 W0(3) [LENGTH OF RECORD
6PTB BZE 0 (GEOERR)
6Q*2 ADX 4 0
6QSL NXT4 BXGE 4 A1(3),SFINISH [J IF NO MORE RECORDS
6R#= STO 4 A1+1(3) [SAVE PTR. TO RECORD
6RRW STO 3 ACOMMUNE1(2)
6S?G ADX 3 4 [X3-> RECORD(ABS.ADDR)
6SR6 SETDEFAULT
6T=Q [ SET DEFAULT SWITCH IF SPECIAL RESOURCE
6TQB LDX 4 W1(3)
6W=2 SRL 4 12 [ITEM/FACILITY NUMBER
6WPL LDX 0 GSIGN [BIT IN JLDFIND
6X9= LDN 7 TDEFAULTEND-TDEFAULT
6XNW SDF2 BXE 4 TDEFAULT(1),SDF4
6Y8G SRL 0 1
6YN6 ADN 1 1
6^7Q BCT 7 SDF2
6^MB BRN SDF9 [J IF NO SPECIALS
7272 SDF4 LDX 1 ACOMMUNE2(2)
72LL SMO JOBDATASIZE
736= ORS 0 FRH+A1+JLDFIND(1)
73KW SDF9 LDX 1 FX1
745G [
74K6 LDXC 4 W1(3)
754Q SRL 4 12
75JB STO 3 AWORK3(2) [SAVE CSTORE PTR.
7642 JBS NOJOBBLOCK,2,STARTCOM [J IF JD PARAM.
76HL LDX 6 W2(3)
773= BZE 4 XURGENCY [J IF URGENCY
77GW BXE 4 ONE(1),XJOBTIME [J IF JOBTIME
77K5 ...[ B7270 CORRECTION 06.08.82
77M# ...[ STORE MAXSIZE DATA IN JOBQ BLOCK
77PH ... BXU 4 SIX(1),NOJOBBLOCK
77RQ ... CALL 4 SFJOCA
77T^ ... STO 6 JSIZE(2)
77Y8 ... BRN XJOBBLOCK
782G NOJOBBLOCK
786C ...[ IF PERITYPE OF JD WE MUST CHECK SWITCH SIGNEED
78=# ...[ AND SET IT IF CLEAR SO THAT SUBSEQUENT PARAMETERS DONT
78B9 ...[ ZEROISE JOBLIST RECORD
78G6 ... LDEX 0 W1(3)
78L3 ... SBN 0 6
78PY ... BZE 0 SNCHECK
78TT ... SBN 0 1
78^Q ... BZE 0 SNCHECK
795M ... SBN 0 3
799J ... BNZ 0 XJOBBLOCK [J IF NOT PERITYPE
79*F ...SNCHECK
79FB JBCSBS ROUTINE,2,SIGNEED,3,TPLUS
79^2 XJOBBLOCK
7=DL LDX 2 FX2
7=Y= LDX 3 AWORK3(2) [RESTORE CSTORE PTR.
7?CW ROUTINE
7?XG LDEX 7 W1(3) [CONVERSION ROUTINE NO.
7#C6 BXE 7 SIX(1),PERIFIXED [J IF PERIPH. ROUTINE
7#WQ BXE 7 SEVEN(1),PERIFIXED [J IF PERIPH. ROUTINE
7*BB BXE 7 TEN(1),PERITEN [J IF PERIPH. ROUTINE
7*W2 BXE 7 NINE(1),STORECHAR [J IF VAR. CHAR.MOVE
7B*L [ THE FOLLOWING CODE ASSUMES THE DATA IS FIXED LENGTH
7BT= STANDARD
7C#W JMBS SIGNED,3,TPLUS,TMINUS [J IF SIGNED
7CSG JBS XFIXED,3,TFIXED [J IF FIXED FIELD
7D#6 VARIABLE
7DRQ CALL 7 REMOVEALL [REMOVE VARIABLE ENTRIES
7F?B CALL 4 SETLEN [PUT DUMMY ENTRY INTO COPYSYS
7FR2 VAR2 LDN 6 1(2) [X6-> ENTRY
7G=L VAR3 CALL 4 VARMOVE [MOVE DATA INTO NEW ENTRY
7GQ= BRN NEXT
7H9W XFIXED
7HPG CALL 4 OLDFJLENTRY [SET X2->ENTRY IN COPYSYS
7J96 LDX 6 2
7JNQ BRN VAR3
7K8B SIGNED
7KN2 JBS XCOUNT,3,TCOUNT [J IF BINARY COUNT
7L7L JBS XAPPEND,3,TPLUS [J IF ADDING
7LM= CALL 7 REMOVESEL [REMOVE VARIABLE ENTRIES
7M6W BRN NEXT
7MLG XAPPEND
7N66 CALL 4 SETLEN [APPEND DUMMY ENTRY
7NKQ BRN VAR2
7P5B XCOUNT
7PK2 JBS XCT5,3,TFIXED [J IF FIXED ENTRY
7Q4L CALL 4 OLDVJLENTRY [X2->ENTRY
7QJ= BPZ 2 XCT4 [J IF ENTRY FOUND
7R3W CALL 4 SETLEN [APPEND DUMMY ENTRY->COPYSYS
7RHG XCT4 LDN 2 1(2)
7S36 BRN XCT6
7SGQ XCT5 CALL 4 OLDFJLENTRY [SET X2->ENTRY IN COPYSYS
7T2B XCT6 CALL 4 XBINADDSUB [UPDATE ENTRY
7TG2 BRN NEXT
7T^L STORECHAR
7WF= [ THE FOLLOWING CODE STORES VARIABLE LENGTH CHAR STRINGS INTO
7WYW [ JWELL/COPYSYS, SPACEFILLING IN THE FIXED FIELD. THE COUNT
7XDG [ INDICATOR IS IGNORED
7XY6 BC 3,TCOUNT [CLEAR COUNT IND.
7YCQ JBC STANDARD,3,TFIXED [J IF VARIABLE ENTRY
7YXB CALL 4 OLDFJLENTRY [SET X2-> ENTRY IN COPYSYS
7^C2 BZE 0 NEXT [X0=LENGTH OF FIELD
7^WL LDX 4 ACES
82B= STO 4 0(2)
82TW LDX 6 0
83*G BRN STCH3
83T6 STCH2 SMO 6
84#Q STO 4 0(2) [SPACEFILL FIELD
84SB STCH3 BCT 6 STCH2
85#2 LDEX 4 W0(3)
85RL SBN 4 2
86?= BXGE 4 0,STCH5
86QW LDX 0 4
87=G STCH5 LDX 6 2
87Q6 CALL 4 VARMOVE1 [MOVE DATA TO NEW REC.
889Q BRN NEXT
88PB [ THIS CODE UPDATES PERIPHERAL COUNTS
8992 PERIFIXED
89=8 ... JBS PERIFIX2,3,TFIXED
89?B ... CALL 4 OLDVJLENTRY [X2->ENTRY
89#J ... BPZ 2 PERIFIX4
89*Q ... LDN 6 64
89BY ... BXU 7 SIX(1),PERIFIX3
89D6 ... LDN 6 16
89F# ...PERIFIX3
89GG ... CALL 4 SETLEN1 [GET EXTENSION OF RIGHT LENGTH
89HN ...PERIFIX4
89JW ... LDN 2 1(2) [X2-> ENTRY
89L4 ... BRN PERIFIX1
89M= ...PERIFIX2
89NL CALL 4 OLDFJLENTRY [SET X2-> ENTRY
89YD ...PERIFIX1
8=8= LDEX 6 W0(3)
8=MW SBN 6 2
8?7G SRL 6 1 [COUNT OF PERIPHS.
8?M6 LDX 5 2 [SAVE ADDR. OF COPYSYS ENTRY
8#6Q BXE 7 SIX(1),PERISIX [J IF ROUTINE 6
8#LB BRN PERISEVEN [J IF ROUTINE 7
8*62 PERITEN
8*KL JMBS PTN03,3,TMINUS,TPLUS [J IF COUNT SIGNED
8B5= CALL 7 REMOVEALL
8BJW PTN03
8C4G CALL 4 OLDVJLENTRY [SET X2->ENTRY
8CJ6 LDN 6 0 [COUNT OF PER. WDS. IN COPYSYS
8D3Q BNG 2 PTN05 [J IF NO COPYSYS ENTRY
8DHB LDEX 6 0(2) [LENGTH OF COPYSYS RECORD
8F32 SBN 6 1
8FGL PTN05 LDEX 7 0(3) [LENGTH OF CSTORE RECORD
8G2= SRL 7 1
8GFW ADX 6 7
8G^G CALL 4 SETLEN1
8HF6 SMO FX2
8HYQ STO 2 ACOMMUNE7
8JDB SBX 6 7
8JY2 SBN 7 1
8KCL BZE 6 PTN07 [J IF NO COPYSYS ENTRY
8KX= CALL 4 OLDVJLENTRY
8LBW LDX 1 2
8LWG PTN07 LDX 0 HALFTOP
8MB6 ORS 0 W1(3) [REDUNDANT REC. ITEM NO.
8MTQ BZE 6 PTN08
8N*B ORS 0 0(1) [ '' '' ''
8NT2 SMO FX2
8P#L LDX 2 ACOMMUNE7 [ADDR. OF NEW ENTRY
8PS= PTN08 STO 3 GEN3
8Q?W STO 7 GEN4
8QRG NGN 0 1
8R?6 BRN PTEN25
8RQQ PTEN1 LDX 3 GEN3
8S=B LDX 7 GEN4
8SQ2 NGN 4 1
8T9L PTEN2 BNG 0 PTEN23
8TP= BXGE 0 W2(3),PTEN4 [J IF PER. ALREADY O/P
8W8W PTEN23
8WNG BXL 4 W2(3),PTEN4 [J IF PER. ALREADY O/P
8X86 BXE 4 W2(3),PTEN3 [J IF 2ND OCCURRENCE
8XMQ PTEN25
8Y7B LDX 4 W2(3)
8YM2 LDN 5 0
8^6L PTEN3 ADX 5 W2+1(3) [SUM PER. COUNTS
8^L= PTEN4 ADN 3 2
925W BCT 7 PTEN2
92KG BZE 6 PTEN8 [J IF NO MORE COPYSYS O/P
9356 PTEN5 LDCH 7 1(1) [PER. IDENT.
93JQ BXL 4 7,PTEN8
944B BXE 4 7,PTEN6
94J2 LDX 4 7
953L LDN 5 0
95H= PTEN6 LDEX 0 1(1)
962W ADX 5 0
96GG PTEN7 ADN 1 1
9726 BCT 6 PTEN5
97FQ PTEN8 BNG 4 PTEN9 [J IF NO MORE PERS.
97^B LDX 0 4
98F2 BNG 5 PTEN1 [J IF NEG. PER. COUNT
98YL BZE 5 PTEN1 [J IF ZER PER. COUNT
99D= STO 5 1(2) [STORE COUNT AND....
99XW DCH 4 1(2) [PERIPHERAL IDENT.
9=CG ADN 2 1 [UPDATE O/P PTR.
9=X6 BRN PTEN1
9?BQ PTEN9 SMO FX2
9?WB LDX 1 ACOMMUNE7 [ADDR. OF NEW ENTRY
9#B2 LDEX 6 0(1)
9#TL ADX 6 1
9**= SBN 6 1(2) [NO. OF UNUSED WDS IN NEW REC.
9*SW NGX 6 6
9B#G ADS 6 0(1) [UPDATE REC. LENGTH
9BS6 BXU 1 2,PTEN95
9C?Q SBN 6 1
9CRB PTEN95
9D?2 CALL 4 SETLEN1 [REMOVE REDUNDANT WORDS
9DQL CALL 7 REMOVEALL [REMOVE OLD RECORD
9F== BRN NEXT
9FPW PERISIX
9G9G LDN 4 16
9GP6 CALL 7 ZEROISE [ZEROISE FIELD IF NOT SIGNED
9H8Q [ THE FOLLOWING CODE PUTS COUNTS INTO CHAR. POSITIONS
9HNB PSIX2 LDX 2 W2(3)
9J82 SRC 2 2 [X2->PERIP. COUNT IN COPYSYS
9JML ADX 2 5
9K7= LDCH 0 0(2)
9KLW ADX 0 W2+1(3)
9L6G BXL 0 SIXTYFOUR(1),PSIX4
9LL6 LDN 0 0
9M5Q PSIX4 DCH 0 0(2)
9MKB ADN 3 2
9N52 BCT 6 PSIX2
9NJL BRN NEXT
9P4= PERISEVEN
9PHW LDN 4 64
9Q3G CALL 7 ZEROISE [ZERO IF FIELD NOT SIGNED
9QH6 [ THE FOLLOWING CODE PUTS COUNTS INTO WORDS
9R2Q PSEV2 LDX 2 5
9RGB ADX 2 W2(3)
9S22 LDX 0 W2+1(3)
9SFL ADS 0 0(2)
9S^= ADN 3 2
9TDW BCT 6 PSEV2
9TYG BRN NEXT
9WD6 SFINISH
9WXQ [ THE FOLLOWING CODE WRITES COPYSYS BACK TO SYSTEM.JOBLIST
9XCB MHUNTW 3,JWELL,COPYSYS
9XX2 LDX 4 ALOGLEN(3)
9YBL DSA 4 A1(3) [RESET REC. HDDR.
9YW= LDX 0 TEMPLATE(1)
9^*W SLL 0 6
9^TG SRL 0 15
=2*6 BNZ 0 SFINISH2 [J IF MAX. REC. LENGTH SPECIFIED
=2SQ LDN 0 502 [DEFAULT MAX. RECORD LENGTH
=3#B SFINISH2
=3S2 SBX 0 4
=4?L LDN 1 YER10
=4R= BNG 0 RERROR [J IF RECORD TOO LONG
=5=W LDN 0 0
=5QG SMO JOBDATASIZE
=6=6 SBN 4 FRH+JLRESTF+1
=6PQ BNG 4 SFINISH3 [J IF NO VAR. FIELD PRESENT
=79B SMO JOBDATASIZE
=7P2 LDN 0 JLRESTF
=88L SFINISH3
=8N= SMO JOBDATASIZE
=97W STO 0 FRH+A1+JLRESTPTR(3) [STORE PTR->VAR. FIELD
=9MG JBC SFINISH5,2,STARTCOM [J IF NOT JOBDATA PARAM.
==76 UPPLUS 1
==LQ SFINISH5
=?6B NAME 3,FILE,FWB
=?L2 REPLACE
=#5L CLOSETOP
=#K= BRN SCONT
=*4W #
=*JG [ START OF 'ONEURG' CODE
=B46 [ RESTORE TIME MENDABLE CODE TO....
=BHQ [ ALLOW ONLY ONE URGENCY PER JOB
=C3B SEGENTRY K20JDWRITE [ONLY ONE URGENCY ALLOWED
=C?8 ... JBS XK2,2,STARTCOM [J IF JOB START COMMAND
=CH2 CALL 4 SFJOCA
=D2L LDX 0 JURGE(2)
=DG= ANDN 0 #77
=D^W BZE 0 SUR2 [J IF URGENCY NOT SET
=FFG LDN 1 SUR1
=F^6 BRN RERROR
=GDQ SUR1 +JTTWICE
=GYB SUR2 LDX 2 FX2
=HD2 SEGENTRY K21JDWRITE [MULTI-URGENCY ALLOWED
=HXL [ END OF ONEURG CODE
=JC= XK2
=JWW LDN 0 4
=KBG ANDX 0 CONTEXT(2)
=KW6 BNZ 0 TESTOK [J IF BACKGROUND:NO BUDGETS CHECKED
=L*Q URGTIME 7 [GET BIT PATTERN
=LTB SETNCORE 10,3,FILE,FABSNB [RESERVES 10 WORD CORE AREA,LEAVES PT
=M*2 LDN 5 A1(3) [COPIES IN PRESET DATA AREA,WHICH GIV
=MSL LDN 4 ZFABSNB(1) [OPEN INSTRUCTION THE NAME OF THE FIL
=N#= MOVE 4 10 [SUPPOSED TO OPEN,IN THIS CASE THE DI
=NRW OPEN YBREAK,READ,QUERY [OPEN DICTIONARY
=P?G CALL 5 TESTOPENOK [CHECK OPEN WAS SUCCESSFUL
=PR6 BRN XUR25 [J IF OPEN FAILED
=Q=Q XUR2 BUDGBITX 7 [TAKES BIT PATTERN IN X7 AND SETS UP A JBU
=QQB TESTREP OK,XUR3 [ JLINE BLOCK.IF NO SUCH BUDGET TYPE EXIST
=R=2 [ REPLY WILL BE 'NOTYPE'.OTHERWISE IT IS '
=RPL CALL 5 RCLOSE [CLOSE DICTIONARY
=S9= XUR25
=SNW LDN 1 YER9
=T8G BRN RERROR
=TN6 XUR3 SETNCORE 3,3,FILE,ADICT [SET UP THE USER NAME IN A BLOCK FOR READD
=TT# ... JBC XUR35,2,STARTCOM [J IF JD COMMAND
=W2G ... MHUNTW 2,JWELL,COPYSYS [....OTHERWISE JD PARAMETER
=W7N ... LDN 4 A1+JLUSER(2)
=W#W ... BRN XUR4
=WG4 ...XUR35 CALL 4 SFJOCA [SET X2->JOB BLOCK
=WMB LDN 4 JUSER(2) [SET UP BLOCK
=X72 ...XUR4 LDN 5 A1(3) [CONTAINING USERNAME
=XLL MOVE 4 3
=Y6= READDICT [READS DOWN USER-ENTRY OG USER WHOSE
=YKW XUR5 BUDGUSE 7 [REF:3.16.5.2
=^5G TESTREP OK,XUR7
=^K6 CALL 5 RCLOSE [CLOSE DICTIONARY
?24Q LDN 1 YER8
?2JB BRN RERROR
?342 [THIS URGENCY.
?3HL XUR7 CALL 5 RCLOSE [CLOSE DICTIONARY
?43= MHUNTW 3,JBUDGET,JBUDGUSER
?4GW LDX 4 JCONSUMED(3)
?52G TXL 4 JALLOWED(3)
?5G6 BCS TESTOK
?5^Q LDN 1 YER7
?6FB BRN RERROR
?6^2 XURGENCY
?7DL CALL 4 SFJOCA [SET X2->JOB BLOCK
?7Y= ... DSA 6 JURGE(2) [SET JURGE AND CLEAR BIT 0
?8CW BRN XJOBBLOCK
?8XG #
?9C6 #
?9WQ # UPDATE JOBBLOCK WITH JOBTIME
?=BB XK3
?=W2 [ START OF 'CSSJTMAX' CODE
??*L [ RESTORE TIME MENDABLE CODE TO....
??T= [ RESTRICT MAXIMUM JOB TIME
?##W [ %A=IP MANAGERN (MAX. JT ALLOWED)
?#SG SEGENTRY K30JDWRITE
?*#6 TMSCV LDX 6 7 [LDX 6 %A
?*RQ SBX 6 7
?B?B BPZ 6 TMAX9
?BR2 LDN 1 TMAX1
?C=L BRN RERROR
?CQ= SEGENTRY K31JDWRITE
?D9W TMAX1 +0
?DPG TMAX9
?F96 [ END OF 'CSSJTMAX' CODE
?FNQ CALL 4 SFJOCA [SET X2->JOB BLOCK
?G8B LDX 4 JMISC(2)
?GN2 SLL 4 6
?H7L BNG 4 SECONDJT [J IF JT ISSUED ONCE
?HM= TESTOK
?J6W ACROSS JOBDATA,5
?JLG XJOBTIME
?K66 CALL 4 SFJOCA [SET X2->JOBBLOCK
?KKQ LDN 5 1000
?L5B MPY 6 5 [CHANGE TO MILLISECS
?LK2 LDCT 4 #004
?M4L ORS 4 JMISC(2) [SET J/T ISSUED BIT
?MJ= STO 6 ATIMEJ(2) [STORE JOBTIME IN JOBBLOCK
?N3W STO 7 ATIMEJ+1(2)
?NHG BRN XJOBBLOCK
?P36 #
?PGQ SCONT
?Q2B LDX 2 FX2
?QG2 HLSINFORM XBREAK,JOBDATA,JOBNO(2),,SASUP
?Q^L LDX 3 CONTEXT(2)
?RF= BNG 3 THEND [J IF SYS. ISSUED
?RYW LDN 0 #4000
?SDG ANDX 0 3 [ISOLATE FULLY STARTED BIT
?SY6 BZE 0 THEND [J IF TENT. STARTED
?TCQ LDN 0 #6000
?TXB ERS 0 CONTEXT(2) [SET TENT ST. BIT & CLEAR F.ST. BIT
?WC2 CALL 4 SFJOCA [SET X2->JOB BLOCK
?WWL NGNC 0 1 [X0:=#37777777
?XB= ANDS 0 JURGE(2) [DROP BIT-0 IF PRESENT (:=T.S.)
?XTW ANDN 3 4 [ISOLATE OFFLINE BIT
?Y*G BZE 3 TMOP [J IF MOP JOB
?YT6 LDN 3 1 [SET SWITCH FOR BACKGROUND JOB
?YX* ...TMOP
?Y^J ... FSHCODE B,XENDB1
?^3R ...(
?^62 ...# FOR SHARED FILESTORE, WE CANNOT UPDATE THE HLSCOUNT WORDS IN 'B'
?^89 ...# AND WE USE A ROUTINE IN 'A' TO UPDATE THE COUNTS FOR US
?^=D ...#
?^#M ... TRANSBEG FSHNOID,WAIT,2,NOBLOCKS,,ACOMMUNE1
?^BW ...#
?^F5 ...XENDB1
?^H# ...)
?^KH ... FSHSKIP B,XNOTB1
?^MQ ...(
?^P^ ... LDX 4 HLSCOUNT(3)
?^SB ... SBN 4 1 [ REDUCE APPROPRIATE
#2#2 ... BNG 4 TGEO [J IF COUNT IS -VE
#2RL ... STO 4 HLSCOUNT(3)
#3QW ... TXL 4 IMOPLIMIT(3)
#4=G BCC THEND [J IF LIMIT REACHED
#4Q6 SMO 3
#59Q LDX 0 XWAIT(1) [LOAD APPROP. WAITING STYLE
#5PB FOX 0 [WAKE UP WAITING ACTIVITIES
#5T? ...#
#5^8 ...XNOTB1
#655 ...)
#692 XCLUDGE
#6NL THEND
#78= ENDCOM
#7MW YBREAK
#87G CALL 5 RCLOSE
#8M6 XBREAK
#96Q COMBRKIN
#9?Y ...XNOJL LDN 1 YER11
#9F6 ... BRN RERROR
#9LB SECONDJT
#=62 LDN 1 YER4
#=KL RERROR
#?5= ADX 1 FX1
#?JW LDX 7 0(1)
##4G ACROSS JOBDATA,9 [REPORT ERROR
##J6 TGEO GEOERR 1,HLSCOUNT
##KC ...#UNS G400
##LN ...(
##M^ ...# ERROR REPORTING FOR HOOKS INSERTION
##P= ...XERR1 CLOSETOP
##QH ... LDX 7 YER12(1)
##RS ... BRN XERROR
##T5 ...XERR2 CLOSETOP
##WB ... LDX 7 YER13(1)
##XM ...XERROR LDX 6 YER14(1)
##YY ... COMERRX 6,7
#*29 ...)
#*3Q #
#*HB #END
^^^^ ...003317740001