{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: JSASCAN867)}}
====== JSASCAN867 ======
(George Source)
**Macros used:** [[george:macro:BC|BC]], [[george:macro:BS|BS]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DOWN|DOWN]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETJOB|GETJOB]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:JBC|JBC]], [[george:macro:JBCC|JBCC]], [[george:macro:JBS|JBS]], [[george:macro:JLADJUST|JLADJUST]], [[george:macro:JMBS|JMBS]], [[george:macro:MBC|MBC]], [[george:macro:MHUNT|MHUNT]], [[george:macro:NAME|NAME]], [[george:macro:OPEND|OPEND]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:POP|POP]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:REWIND|REWIND]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:VOP|VOP]]
22^= #OPT WELLTEST=0
23DW #LIS K0JSASCAN>K0ALLGEO>K0GREATGEO>K0COMMAND
23M6 ... SEG JSASCAN,867,SECTION CENT
23TB ...[
243L ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
249W ...[
24D6 [
24XQ #DEF RRH=A1+FRH
25CB [
25X2 [ THIS SEGMENT PERFORMS THE JOB SELECTION MECHAINISM
26BL [ AND CREATES VIRTUAL SLOTS
26W= [
27*W SEGENTRY K1JSASCAN,SOPEN [ :SYSTEM.JOBLIST ALREADY OPEN
27TG SEGENTRY K2JSASCAN,SCLOS [ ABOVE NEEDS TO BE OPENED
28*6 [
29#B [
29S2 [
2=?L [
2?=W [ THE RELEVANT POP WILL HAVE BEEN DONE BY THE HOST
2?QG ...SOPEN BS ,HOSTOPEN [ B0 AWORK1 INDICATES JOBLIST OPEN
2#=6 BRN SCAN
2#JH ...SCLOS
2#WY ...POPC POP POPC,,JWACCESS
2*9B ... MBC ,IVEOPEND,HOSTOPEN
2*P2 SCAN
2B8L JBS START,,JSAREQ [ SHOULD ONLY BE OBEYED IF JSAREQ
2BN= GEOERR 1,ILL JSA
2C7W [
2CMG [ DON'T BOTHER IF FINISH ISSUED...
2D76 [
2DLQ START LDXC 0 FINISH
2F6B BCS TFIN
2FL2 [
2G5L LDN 5 JWMOPB [ MOP JOB TYPE(X)
2GK= SAGIN HUNTMISB 3,JWELL [ JWELL BLOCK
2H4W ANDN 5 1 [ ENSURE ONLY MOP/BACK TYPE
2HJG REACH LDEX 0 JOBENTS+JOBCTS(3) [ BACK RUNNING
2J46 LDEX 1 JOBENTS+JWENTRY+JOBCTS(3) [ MOP RUNNING
2JHQ LDX 4 0
2K3B ADX 4 1 [ TOTAL
2KH2 LDX 6 BACKJOBS
2L2L LDX 7 IMOPJOBS [ IP'S
2LG= ADX 7 6 [ TOTAL JOBS
2L^W TXL 4 7
2MFG BCC TFIN [ J IF MAX JOBS REACHED OR PASSED
2M^6 SBX 7 6 [ RESTORE MOP IP
2N2H ...#SKI JWPHASE4
2N3Y ...(
2N5* ... JBC NOHLSB,,HLSBS
2N6Q ... LDN 6 0 [DON'T START ANY BACK IF HLS IN CONTROL
2N87 ...NOHLSB
2N9J ... JBC NOHLSM,,HLSMS
2N=^ ... LDN 7 0 [DITTO FOR MOP
2N#B ...NOHLSM
2N*R ... LDEX 0 JOBENTS+JOBCTS(3)
2NC8 ...)
2NDQ SMO 5
2NYB LDX 4 0 [ COUNT FOR TYPE(X)
2PD2 SMO 5
2PXL TXL 4 6
2QC= BCC STIDY [ J IF LIMIT REACHED
2QWW SMO 5
2RBG LDXC 4 CLUSTERBACK [ IP CLUSTER(X)
2RW6 BCS NOTIP [ J IF IP NOT SET
2S*Q ORN 5 JWCLUSB [ MAKE TYPE CLUSTER
2STB [
2T*2 [ SUM LIVEJOBS FOR THIS TYPE
2TSL [
2W#= LDN 1 0 [ CUMULATIVE TOTAL
2WRW LDN 3 JOBENTS(3)
2X?G BRN TRYT
2XR6 TMORE ADN 3 JWENTRY [ NEXT ENTRY
2Y=Q TRYT LDX 0 JOBTYPE(3)
2YQB BNG 0 SUMD [ J IF END
2^=2 ANDN 0 JOBBITS [ GET TYPE
2^PL TXU 0 5
329= BCS TMORE [ J IF DIFFERENT TYPE
32NW LDEX 7 JOBCTS(3) [ CUMULATE
338G ADX 1 7 [ COUNT
33N6 BRN TMORE
347Q SUMD TXL 1 4
34MB BCS REMJB [ J IF IP CLUSTER(X) NOT REACHED
3572 ERN 5 JWCLUSB [ REMOVE CLUSTER BIT
35LL ORN 5 JWCENTB
366= CALL 4 STARTNEXT [ START NEXT CENTRAL(X)
36KW BZE 7 SAGIN [ SUCCESS SO TRY AGAIN
375G ERN 5 JWCENTB
37K6 ORN 5 JWCLUSB
384Q CALL 4 STARTNEXT [ START NEXT CLUSTER(X)
38JB BZE 7 SAGIN [ OK SO TRY AGAIN
3942 BRN VSLOT [ J TO CREATE A VIRTUAL SLOT
39HL REMJB CALL 4 STARTNEXT [ START NEXT CLUSTER(X)
3=3= BZE 7 SAGIN [ OK SO TRY AGAIN
3=GW ERN 5 JWCLUSB
3?2G ORN 5 JWCENTB
3?G6 CALL 4 STARTNEXT [ START NEXT CENTRAL(X)
3?^Q BZE 7 SAGIN [ OK SO TRY AGAIN
3#FB BRN VSLOT [ J TO CREATE A VIRTUAL SLOT
3#^2 [
3*DL NOTIP CALL 4 STARTNEXT [ START NEXT(X)
3*Y= BZE 7 SAGIN [ OK SO TRY AGAIN
3BCW VSLOT ANDN 5 1
3BXG BZE 5 SBACK [ J IF BACKGROUND JOB
3CC6 BS ,JSVIRTMOP [ VIRTUAL MOP SLOT
3CWQ BRN STIDY
3DBB SBACK BS ,JSVIRTBACK [ VIRTUAL BACK SLOT
3DW2 STIDY BZE 5 TIDY [ J IF FINISHED
3F*L JBC SDUN,,JSAREQ
3FT= LDN 5 JWBACKB
3G#W BC ,JSAREQ
3GSG BRN SAGIN [ LOOP FOR BACK JOBS
3H#6 TIDY JBCC SDUN,,JSAREQ
3HRQ BRN START
3J?B TFIN BC ,JSAREQ
3JR2 SDUN BC ,JSACT
3K=L LDX 2 FX2
3KL* ... JBS OUTV,,HOSTOPEN [ CLOSE JOBLIST IF OPENED BY ME
3L24 ... JBC OUTW,,IVEOPEND
3L*R ... BC ,IVEOPEND
3LPG CLOSETOP
3M96 OUTW VOP ,JWACCESS [ RELEASE ACCESS TO JWELL
3MHH ...OUTV BC ,HOSTOPEN
3MTY ... UP
3N8B [
3NN2 [ STARTNEXT JOB OF TYPE(X)
3P7L [ TYPE IS DEFINED BY THE JOBBITS OF THE JWELL JOBTYPE WORD
3PM= [
3Q6W [ AWORK2 - USED TO SAVE THE POSITION IN JWELL OF (Z)
3QLG [
3R66 [ X4/AWORK3 - LINK
3RKQ [ X5 - TYPE OF JOB TO BE STARTED
3S5B [ X6 - STARTING POINT JOBNO(Y) IF SCANNEXT CALLED
3SK2 [ X7 - REPLY =0 JOB STARTED
3T4L [ #0 FAILED TO START A JOB
3TJ= [
3W3W STARTNEXT
3WHG SBX 4 FX1
3X36 STO 4 AWORK3(2) [ LINK
3XGQ LDN 7 1 [ JOB NOT STARTED REPLY
3Y2B HUNTMISB 1,JWELL
3YG2 LDN 3 JOBENTS(1)
3Y^L BRN XCOMP
3^F= [
3^YW XINC ADN 3 JWENTRY [ INCREMENT TO NEXT TYPE
42DG XCOMP LDX 0 JOBTYPE(3)
42Y6 BNG 0 XNOJB [ J IF NO MORE
43CQ ANDN 0 JOBBITS
43XB TXU 0 5
44C2 BCS XINC
44WL LDX 0 JOBCTS(3)
45B= SRL 0 9
45TW BZE 0 XINC [ J IF NO WELLJOBS
46*G BRN XUPD
46T6 [
47#Q XNOJB ADX 4 FX1
47SB EXIT 4 0 [ FAILED EXIT
48#2 [
48RL [ THERE JOBS OF TYPE(X) IN THE WELL
49?= [
49QW XUPD SBX 3 1 [ POSITION WITHIN JWELL OF TYPE(X)
4==G STO 3 AWORK2(2) [ PRESERVE
4=Q6 [
4?9Q ... JMBS OPEND,,HOSTOPEN,IVEOPEND
4?PB [
4#92 OPENSYS ,JOBLIST,GENERAL [ OPEN :SYSTEM.JOBLIST
4#NL ... BS ,IVEOPEND [ INDICATE OPENED BY ME
4*8= HUNTMISB 1,JWELL
4*MW OPEND LDX 3 1
4B7G ADX 3 AWORK2(2) [ RESTORE JWELL POINTER
4BM6 [
4BPP ... LDX 0 JOBPROP(3)
4BS# ... STO 0 AWORK1(2)
4BWX ...[
4B^G ...[ PROPERTY OF THIS JOB TYPE PRESERVED..
4C45 ...[
4C6Q LDXC 6 JNEXT(3) [ POINTER OR ACTUAL JOB
4CLB BCC RJOB [ J IF REAL JOB
4D62 [
4DKL [ POINTER TO JOB OF TYPE(X) IN X6 - IE(Y)
4F5= [
4FJW XSCAN CALL 7 SCANNEXT [ LOOK FOR NEXT(X) AFTER(Y)
4G4G HUNTMISB 1,JWELL
4GJ6 [
4H3Q [ SET B0 IN ALL JWELL ELEMENTS WHERE JNEXT=(Y)
4HHB [
4J32 RJOB LDX 0 GSIGN
4JGL LDN 3 JOBENTS(1) [ START OF JWELL ENTRIES
4K2= BRN Z2 [ SET B0 FOR ALL ELEMENTS WHERE JNEXT
4KFW Z1 ADN 3 JWENTRY [ =(Y)
4K^G Z2 LDX 7 JOBTYPE(3)
4LF6 BNG 7 XEND
4LYQ LDX 7 JNEXT(3)
4MDB TXU 6 7
4MY2 BCS Z1
4NCL ORS 0 JNEXT(3)
4NX= BRN Z1
4PBW [
4PWG XEND GETJOB 6,SYSTEM [ READ ENTRY FOR(Y)
4QB6 TESTREP2 OK,XND
4QTQ GEOERR 1,NOSUCHJB
4R*B XND READAGAIN
4RT2 MHUNT 3,FILE,FRB
4S#L SMO JOBDATASIZE
4SS= LDXC 7 RRH+JLSTAT(3)
4T?W BCC YMARK
4TRG FREECORE 3
4W?6 BRN XSCAN
4WQQ [
4X=B [
4XQ2 YMARK NAME 3,FILE,FWB
4Y9L JLADJUST 3
4YP= BS 3,JLBRUNNING
4^8W REWRITE [ WRITE BACK TO JOBLIST
4^NG MHUNT 3,FILE,FWB
5286 NAME 3,JWELL,COPYSYS [ RENAME FOR NEWJOB
52MQ [
537B [ DECREMENT WELLJOBS AND INCREMENT LIVEJOBS FOR THE TYPES INDICATED
53M2 [ BY THE TYPE BITS IN JLSTAT OF THE JOBLIST ENTRY
546L [
54L= LDX 4 JLPROPNO+RRH(3)
555W STOZ AWORK4(2)
55KG JLADJUST 3
5656 LDX 2 JLSTAT(3)
56JQ ANDN 2 3
574B ADN 2 2 [ FORM NOW SAME AS JOBTYPE
57J2 NGN 7 1 [ LOOP MARKER
583L HUNTMISB 1,JWELL [ LOCATE JWELL BLOCK
58H= X0 LDN 3 JOBENTS(1)
592W BRN X2
59GG X1 ADN 3 JWENTRY [ NEXT
5=26 X2 LDX 0 JOBTYPE(3)
5=FQ BPZ 0 X3
5=^B GEOERR 1,NOJBTYPE [ SHOULD ALWAYS FIND TYPE
5?F2 X3 ANDN 0 JOBBITS
5?YL TXU 0 2 [ COMPARE TYPES
5#D= BCS X1 [ J IF DIFFERENT
5#XW BPZ 7 X4 [ J IF NOT FIRST TIME
5*CG ANDN 0 JWCLUSB
5*X6 BZE 0 X4 [ J IF NOT CLUSTER
5BBQ TXU 4 JOBPROP(3)
5BWB BCS X1 [ J IF DIFF PROPERTIES
5CB2 SMO FX2 [ RETAIN ADDRESS OF CLUSTER ENTRY
5CTL STO 3 AWORK4 [ IN JWELL BLOCK
5D*= X4 LDN 0 JWELLONE [ TYPES MATCHED
5DSW SBS 0 JOBCTS(3) [ DECREMENT WELLJOBS
5F#G LDN 0 1
5FS6 ADS 0 JOBCTS(3) [ INCREMENT LIVEJOBS
5G?Q BZE 7 X5 [ EXIT IF END OF SECOND PASS
5GRB ADN 7 1
5H?2 ANDN 2 1 [ ISOLATE MOP/BACK BIT
5HQL BRN X0 [ AND REPEAT
5J== X5 LDX 2 FX2
5JPW LDX 1 AWORK4(2) [ SEE IF CLUSTER COUNT WAS UPDATED
5K9G BZE 1 SWOPE [ J IF NOT
5KP6 [
5L8Q [ RE-ORDER ELEMENTS OF SAME TYPE TO SHARE CLUSTERS
5LNB [
5M82 LDX 3 1
5MML LDEX 4 JOBCTS(3) [ LIVEJOBS FOR(M)
5N7= X6 ADN 3 JWENTRY [ NEXT ELEMENT(N)
5NLW LDX 0 JOBTYPE(3)
5P6G BNG 0 X7 [ J IF NO (N)
5PL6 ANDN 0 JOBBITS [ EXTRACT TYPE
5Q5Q TXU 0 5
5QKB BCS X7 [ J IF DIFFERENT
5R52 LDEX 2 JOBCTS(3)
5RJL TXL 4 2 [ IS (M).LT.(N)
5S4= BCC X6 [ J IF (M).GE.(N)
5SHW [
5T3G [ RE-ORDER IF NECESSARY
5TH6 [
5W2Q X7 SBN 3 JWENTRY [ LAST ENTRY OF SAME TYPE
5WGB TXU 3 1
5X22 BCC SWOPE [ J IF SAME ENTRY
5XFL SMO FX2
5X^= LDN 2 ACOMMUNE1
5YDW MOVE 1 JWENTRY [ MOVE(M) OUT
5YYG LDN 0 JWENTRY(1) [ ADDRESS OF ENTRY AFTER(M)
5^D6 LDX 2 3
5^XQ SBX 2 1
62CB MOVE 0 0(2) [ MOVE OTHER ENTRIES DOWN
62X2 SMO FX2
63BL LDN 2 ACOMMUNE1
63W= MOVE 2 JWENTRY [ MOVE(M) BACK TO END OF LIST
64*W SWOPE LDX 2 FX2
64TG LDX 1 FX1
65*6 TRACE 5,JSASCAN
65F3 ...#SKI JWPHASE4
65JY ... DOWN SETJOBQ,2
65NT ...#SKI JWPHASE4<1$1
668F ... DOWN ENWELLB,1
6=P2 [
6?8L [ SUCCESS......
6?N= [
6#7W XIT LDN 7 0
6#MG XITC LDX 4 AWORK3(2) [ RESTORE LINK
6*76 ADX 4 FX1
6*LQ EXIT 4 0
6B6B [
6BL2 [ SCANNEXT
6C5L [
6CK= [ SCAN JOBLIST FOR NEXT JOB(Z) AFTER (Y) OF TYPE(X)
6D4W [
6DJG [ X5 JOB TYPE(X) BOTTOM BITS OF JOBTYPE - UNCHANGED
6F46 [ X6 STARTING POINT(Y) BECOMES ANSWER(Z)
6FHQ [ X7 LINK - AWORK4
6G3B [
6GH2 SCANNEXT
6H2L SBX 7 FX1
6HG= STO 7 AWORK4(2) [ PROCESS LINK
6H^W [
6JFG LDX 7 6 [ STARTING POINT(W)=(Y)
6J^6 [
6KDQ GETJOB 6,SYSTEM [ POSITION JOBLIST AFTER(Y)
6KYB TESTREP OK,XREAD [ J IF FOUND
6LD2 STEPAGAIN [ RE-READ RECORD AFTER(Y)
6LXL BRN TRY
6MC= XREAD STEP [ READ NEXT RECORD
6MWW ...TRY BNZ 3 XON
6P*Q REWIND [ ELSE START AT FRONT AGAIN
6PTB STEP
6Q*2 BRN XREAD
6QSL [
6R#= [ (Z) = JOBNO OF CURRENT RECORD
6RRW [
6S?G XON LDX 6 JLJOBNO(3) [ (Z)
6SR6 [
6T=Q [ CONSTRUCT JWELL(JOBTYPE) BIT PATTERN FROM JOBLIST ENTRY
6TQB [
6W=2 SMO JOBDATASIZE
6WPL LDX 4 JLSTAT(3) [ JOBLIST ENTRY STATUS
6X9= ANDN 4 3 [ CLUS/CENT/MOP - BOTTOM TWO BITS
6XNW ADN 4 2 [ NOW SAME AS JWELL BITS
6Y8G [
6YN6 [ LOCATE JWELL BLOCK AND INITIALISE POINTERS
6^7Q [
6^F6 ...PASS2
6^MB HUNTMISB 1,JWELL
7272 LDN 1 JOBENTS(1)
72LL BRN XSORT
736= [
73KW [ PROCESS JNEXTS IN JWELL BLOCK BY UPDATING AS NECESSARY
745G [
74*# ...XLOO SBX 3 JOBDATASIZE
74K6 XLOOP ADN 1 JWENTRY [ TO NEXT ENTRY
754Q XSORT LDX 0 JOBTYPE(1)
75JB BNG 0 XNDW [ J IF END OF BLOCK
7642 LDXC 0 JNEXT(1)
76HL BCC XLOOP [ TO NEXT IF NOT A POINTER
773= TXU 0 7
77GW BCS XLOOP [ J IF JOBNO'S DIFFERENT
782G [
78G6 [ SET JNEXT TO CURRENT JOB
78^Q [
79FB STO 6 JNEXT(1)
79^2 LDX 0 GSIGN
7=DL ORS 0 JNEXT(1) [ POINTER
7=Y= [
7?CW [ SEE IF SAME TYPE AND CLEAR B0 IF THEY ARE
7?XG [
7#C6 LDX 0 JOBTYPE(1)
7#WQ ANDN 0 JOBBITS [ JWELL JOBTYPE
7*BB LDX 2 0
7*W2 ANDX 2 4 [ EXTRACT THESE BITS FROM JOBLIST
7B*L TXU 2 0
7BT= BCS XLOOP [ J IF NOT SAME TYPE
7BXF ...[
7B^N ...[ ALSO JUMP IF MOP/BACK TYPE NOT SAME...
7C3X ...[
7C66 ... ERX 2 4
7C8* ... ANDN 2 1
7C=J ... BNZ 2 XLOOP
7C#W ANDN 0 JWCLUSB
7CSG BZE 0 XCLR [ J IF NOT CLUSTER
7D#6 LDX 0 JOBPROP(1) [ COMPARE PROPERTIES AS CLUSTER
7DRQ TXU 0 JLPROPNO(3)
7F?B BCS XLOOP [ J IF DIFFERENT
7FR2 [
7G=L [ SAME TYPE AND PROPERTY
7GQ= [
7GW7 ...XCLR ADX 3 JOBDATASIZE
7H24 ...[
7H5^ ...[ SKIP IF ALREADY RUNNING OR DEGENERATE
7H9W ...[
7HCP ... JMBS XLOO,3,JLBRUNNING,JLBNOTCAND
7HKK ... LDX 0 JNEXT(1)
7HPG STOC 0 JNEXT(1) [ REMOVE B0
7J96 ... BRN XLOO
7JNQ [
7K8B [ END OF JWELL BLOCK - IS CURRENT JOB THE CORRECT TYPE
7KN2 [
7L7L XNDW LDX 7 6 [ (W)=(Z)
7LM= LDN 0 JWCENTB+JWCLUSB
7M6W [
7MLG [ EXTRACT CLUS/CENT BITS AS REQUIRED
7N66 [
7NKQ ANDX 0 5
7P5B ORN 0 JWMOPB
7PK2 ANDX 4 0
7Q4L [
7QJ= TXU 4 5
7R3W BCS XREAD [ LOOP IF NOT
7RHG [
7S36 [ IF JOB ALREADY STARTED LOOK FOR NEXT
7SGQ [
7T2B ADX 3 JOBDATASIZE
7TG2 ... JMBS XREAD,3,JLBRUNNING,JLBNOTCAND
7WYW LDX 2 FX2 [ RESTORE LINK
7X2K ...[
7X4# ...[ IF JOBLIST ENTRY IS CLUSTER CHECK PROPS ARE SAME
7X63 ...[
7X7Q ... JBC XPROK,3,JLBCLUS
7X93 ... LDX 0 AWORK1(2)
7X=# ... BZE 0 XPROK
7X=Y ... SBX 3 JOBDATASIZE
7X?K ... TXU 0 JLPROPNO(3)
7X#X ... BCS XREAD
7XBL ...XPROK
7XDG LDX 7 AWORK4(2)
7XY6 ADX 7 FX1
7YCQ EXIT 7 0
7YXB #END
^^^^ ...73745023000100000000