JSASCAN867

(George Source)

Macros used: BC, BS, CLOSETOP, DOWN, FREECORE, GEOERR, GETJOB, HUNTMISB, JBC, JBCC, JBS, JLADJUST, JMBS, MBC, MHUNT, NAME, OPEND, OPENSYS, POP, READAGAIN, REWIND, REWRITE, SEG, SEGENTRY, STEP, STEPAGAIN, TESTREP, TESTREP2, TRACE, UP, VOP

JSASCAN867.txt
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