{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: REGEN865)}}
====== REGEN865 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BC|BC]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:CHEKLFN2|CHEKLFN2]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COOR4|COOR4]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:FSHTEST|FSHTEST]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETJOB|GETJOB]], [[george:macro:HLSINFORM|HLSINFORM]], [[george:macro:HUNT|HUNT]], [[george:macro:INHIBITBRK|INHIBITBRK]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JLADJUST|JLADJUST]], [[george:macro:JMBAC|JMBAC]], [[george:macro:JMBC|JMBC]], [[george:macro:JMBS|JMBS]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:LOSEPARS|LOSEPARS]], [[george:macro:MBC|MBC]], [[george:macro:MEND|MEND]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OPEN|OPEN]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACKX|OUTPACKX]], [[george:macro:PARALYSX|PARALYSX]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PERMITBRK|PERMITBRK]], [[george:macro:POP|POP]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:RG|RG]], [[george:macro:RUNJSA|RUNJSA]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SKIP|SKIP]], [[george:macro:SPARABEG|SPARABEG]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPREWRITE|STEPREWRITE]], [[george:macro:STEPWRITE|STEPWRITE]], [[george:macro:TAB|TAB]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANCHKN|TRANCHKN]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:TRANSFIN|TRANSFIN]], [[george:macro:UP|UP]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:USEROPEX|USEROPEX]], [[george:macro:VOP|VOP]]
22FL #SEG REGEN
22^= #LIS K0REGEN>K0COMMAND>K0ALLGEO
23DW 8HREGEN
23YG [
24D6 [ THIS SEGMENT IMPLEMENTS THE REGENERATE (RG) COMMAND
24XQ [
25CB SEGENTRY K1REGEN,START
25H? ... SEGENTRY K2REGEN,MONEY
25JJ ...#SKI [CODE MOVED INTO SEGMENT 'JWELLONE'
25KT ...(
25M8 ... SEGENTRY K3REGEN,PRIVON
25R5 ... SEGENTRY K4REGEN,PRIVOFF
25S4 ...)
25T3 ... FSHSKIP B
25W2 ...(
25X2 [
26BL [ USE OF AWORK WORDS
26W= [ 1 SEMAPHORES
27*W [ 2 TEMP STORAGE
27TG [ 3 ADATA/CSTORE MODIFIER
28*6 [ 4 LINK TO REGENJB
28SQ [
29#B #DEF SZCSTORE=40
29S2 #DEF SIZELIST=10
2=?L [
2=R= PCANTRGNAME +CANTRGNAME
2?=W PCANTRGNO +CANTRGNO
2?QG PERGNOJOB +ERGNOJOB
2#=6 PERGJOBNO +ERGJOBNO
2#PQ [
2*9B XJOBLIST +SIZELIST
2*P2 12H
2B8L 12HJOBLIST
2C7W +1
2CMG +1
2CX# ... 4H****
2D76 XALL +3
2DLQ 3HALL
2F6B XAB +2
2FL2 2HAB
2G5L XALB +6
2GK= 6HALLBUT
2H4W [
2HJG [
2J46 [ ADATA/CSTORE BLOCK HAS THE FOLLOWING FORMAT
2JHQ [
2K3B [ WORDS 0,1,2 USERNAME
2KH2 [ 3,4,5 JOBNAME
2L2L [ 6 NO OF JOBNUMBERS FROM NEXT WORD ONWARDS
2LG= [ 7 JOBNUMBERS OF JOBS TO BE RG'D
2L^W [ 2 WORD ENTRIES CONTAINING JOBNUMBER AND PARAM NUMBER
2MFG [ THAT THE JOBNO WAS DERIVED FROM
2M^6 [ JOBNUMBERS HAVE BIT 0 SET IF ORIGINAL PARAM WAS A JOBNO
2NDQ [
2NYB BITDEFS AWORK1,0,RGALLBIT,RGABIT,RUSER,RJOB
2PD2 ... BITDEFS AWORK1,4,RGNOJBER,RGERROR,RGMONEY
2PQB ... BITDEFS AWORK1,7,RGFROZEN
2PXL [
2QC= SPARABEG [ OBTAIN SPECIFIED PARAM
2QWW SBX 7 FX1 [ LINK
2RBG ... SPARABEG 1,0(3),,,0 [ GET PARAM IF EXISTS
2S*Q MHUNT 3,CPB,CUNI
2STB LDX 0 ANUM(3) [ SEE IF EXISTS
2T*2 BNG 0 SPOUT [ J IF NOT
2TMC ... ADN 7 1
2T^S ... BRN XIT70
2W#= [
2WRW SPOUT FREECORE 3 [ FREE CPB/CUNI
2X?G ... BRN XIT70
2XR6 [
2Y=Q SETFABS
2YQB SBX 7 FX1
2^=2 SETNCORE SIZELIST,3,FILE,FABSNB
2^PL LDN 5 A1(3)
329= LDN 4 XJOBLIST(1)
32NW MOVE 4 SIZELIST
338G ADN 5 1
33N6 ... BRN XIT70
349^ ...[
34=4 ...[N.B. THE FOLLOWING 2 SUBROUTINES CAN'T BE COMBINED
34=7 ...[DUE TO FORM OF PARAM FOR STEPREWRITE MACRO
34== ...STEPWRT1
34#R ... LDX 3 AWORK2(2)
34C# ... [POINTER TO RECORD
34FT ... STEPREWRITE 1 [UPDATE RECORD
34JB ... EXIT 4 0
34M3 ...[
34Y^ ...STEPWRITE
35CW ... LDX 3 AWORK2(2) [POINTER TO RECORD
35WR ... STEPREWRITE 0 [UPDATE RECORD
368P ... EXIT 4 0
36GM ...[
36SK ...[
376H ...USEROPEN
37DF ... SBX 7 FX1
37QC ... SETUPMOD ,4,FROZEN
384* ... USEROPEX UBRK,5,4
38B? ... ADN 7 1
38N9 ...UBRK MFREE FILE,FABSNB
3927 ... BRN XIT70
39#5 ...[
39L3 ...POP SBX 4 FX1
39X^ ...
3=9X ...POPC POP POPC,,JWACCESS
3=HT ...POPX ADX 4 FX1
3=TR ... EXIT 4 0
3?7P ...[
3?FM ...VOPCLOSE
3?RK ... SBX 7 FX1
3#5H ... CLOSETOP
3#CF ... CALL 5 VOP
3#PC ... BRN XIT70
3*3* ...[
3**? ...VOP VOP ,JWACCESS
3*M9 ... EXIT 5 0 [ ACCESS SEMAPHORE RELEASED
3*^7 ...[
3B?5 ...SETNAMES
3BK3 ... SBX 7 FX1
3BW^ ... STO 7 AWORK2(2) [ LINK
3C8X ... LDN 4 3
3CGT ... MHUNT 3,ADATA,CSTORE
3CSR ... LDN 6 A1+3(3) [ JOBNAME ADDRESS
3D6P ... LDN 5 JPDJOBNAME
3DDM ... CALL 7 XOUTPACK [ OUTPACK THE JOBNAME
3DQK ... MHUNT 3,ADATA,CSTORE
3F4H ... LDN 6 A1(3) [ USERNAME ADDRESS
3FBF ... LDN 5 JPDUSERNAME
3FNC ... CALL 7 XOUTPACK
3G2* ... NGN 6 1
3G#? ... LDX 7 AWORK2(2)
3GL9 ... BRN XIT70
3GY7 ...[
3H=5 ...[
3HJ3 ...PARAMNO
3HT^ ...SETJOBNO
3J7X ... SBX 7 FX1
3JFT ... OUTNUM 6,0
3JRR ... NGN 6 1
3K5P ... BRN XIT70
3KCM ...[
3KPK ...[
3L3H ...VOUTPACK
3L*F ... LDN 5 JPDVARCHAR
3LMC ...XOUTPACK
3L^* ... SBX 7 FX1
3M?? ... OUTPACKX 6,4,5
3MK9 ... BRN XIT70
3MX7 ...[
3N95 ...[
3NH3 ...OUTERROR
3NS^ ... SBX 7 FX1
3P6X ... ERRORX 5,6 [ ISSUE COMMAND ERROR
3PDT ... BRN XIT70
3PQR ...[
3Q4P ...RUNJSA
3QBM ... SBX 7 FX1
3QNK ... RUNJSA HOSTOPEN
3R2H ...XIT70 ADX 7 FX1
3R#F ... EXIT 7 0
3RLC ...[
3RY* ...XHLSINF
3S=? ... SBX 7 FX1
3SJ9 ... HLSINFORM XIT70,REGEN,4,5,,3
3SW7 ... BRN XIT70
3T85 ...#
3TG3 ...STEP1 NGNC 0 1
3TR^ ...STEP LDN 3 0
3W5X ... SBX 4 FX1
3WCT ... STEP 0(3)
3WPR ... BRN POPX
3X3P ...#
3X*M ...STEPAGAIN1
3XMK ... NGNC 0 1
3X^H ...STEPAGAIN
3Y?F ... LDN 3 0
3YKC ... SBX 4 FX1
3YX* ... STEPAGAIN 0(3)
3^9? ... STO 3 AWORK2(2) [PRESERVE POINTER TO RECORD
3^H9 ... [FOR STEPREWRITE
3^W6 ... BRN POPX
3^W8 ...#
3^WS ...[
3^YW REGENJOB
42DG [
42Y6 [ THIS IS THE CENTRAL ROUTINE FOR REGENERATING A PARTICULAR JOB
43CQ [
43XB [ IF RGALLBIT OR RGABIT ARE SET THE JOB TO BE RG'ED IS THE
44C2 [ ONE AT THE CURRENT POSITION IN SYSTEM JOBLIST
44WL [ OHTERWISE THE JOB IS INDICATED BY THE JOBNO IN X6
45B= [ IF X6 HAS BIT 0 SET THEN A ADATA/CSTORE BLOCK HOLDS THE
45TW [ JOBNAME AND USERNAME WHICH SHOULD BE USED FOR ERROR MESSAGES
46*G [
46T6 SBX 7 FX1
47#Q STO 7 AWORK4(2) [ LINK
47SB BS 2,RGERROR [ SET ERROR FLAG TO START WITH
48#2 JMBS TAKE,2,RGALLBIT,RGABIT
48RL [
49?= [ USE THE JOBNUMBER GIVEN IN X6
49QW [
4==G LDXC 5 6 [ REMOVE BIT 0
4=Q6 BCS £ [ GET RID OF CARRY
4?9Q GETJOB 5,SYSTEM [ LOCATE ENTRY
4?PB TESTRPN2 OK,MISSING [ J IF CANT FIND JOB
4#NL [
4*8= [ COMMON PATH NOW FOR THE RG
4*MW [
4B7G TAKE
4C6Q ... CALL 4 STEPAGAIN
4K^S ... JMBS TK1,2,RGMONEY,RGFROZEN
4L3# ... MHUNT 2,ADATA,CSTORE
4L49 ... LDN 5 A1(2)
4L56 ... LDN 4 FRH+JLUSER(3)
4L63 ... MOVE 4 6
4L6Y ...TK1 LDX 2 FX2
4L82 ... TRACE JLJOBNO(3),*REGEN*
4L?= ... LDX 5 JLJOBNO(3)
4LBG ... ADX 3 JOBDATASIZE
4LD2 ... JMBAC NMONY,2,RGMONEY,RGFROZEN
4LDG ... JBS TK2,2,RGMONEY
4LF2 ... BC 3,JLBFROZENNC
4LFG ... BRN TK3
4LG2 ...TK2 BC 3,JLBHARDUP
4LGG ...TK3
4LX* ... JMBS NRG,3,JLBABAND,JLBBMAP
4M8G ... BRN XCLR
4M?9 ...NMONY JMBAC TELLER,3,JLBABAND,JLBBMAP
4M?# ...[ B1249 CORRECTION 10.06.82
4M?C ...[ AVOID 'GEOERR CHJOBLOK' IN 'SETJOBQ' BY CHECKING
4M?G ...[ A TEMP AB HAS COMPLETED - IE JOBQ BLOCK REMOVED
4M?N ... JOBLOCK 5,4
4M?W ... BPZ 4 TELLER
4M#6 ... MBC 3,JLBABAND,JLBBMAP
4MFJ ... JMBS NRG,3,JLBHARDUP,JLBFROZENNC
4MS2 ...XCLR BC 3,JLBNOTCAND
4N2G ...NRG
4N92 ... CALL 4 STEPWRITE
4N9P ... JMBS NRG0,2,RGALLBIT,RGABIT
4N=D ... LDXC 4 6
4N?7 ... BCS £
4N?W ... LDN 5 0
4N#K ... ADX 3 JOBDATASIZE
4N#Y ... JBS NRG0,3,JLBNOTCAND
4N*# ... LDX 3 JLSTAT(3)
4NB3 ... CALL 7 XHLSINF
4NBQ ...NRG0
4NCL READAGAIN [ FOR JWUPDATE OF RG JOB
4NX= MHUNT 3,FILE,FRB
4PBW NAME 3,JWELL,COPYSYS
4PWG BC 2,RGERROR [ CLEAR ERROR FLAG
4PX9 ... JLADJUST 3
4PXY ... JBS TMON,3,JLBNOTCAND
4PYM ... RG WELL
4P^B ... MFREE JWELL,COPYSYS
4P^L ...TMON JMBS XIT,2,RGMONEY,RGFROZEN
4Q5N ... HUNT 3,FILE,FABSNB [ FOR OPENING USER JOBLIST
4Q6C ... BPZ 3 SET [ J IF ONE FOUND
4Q6Q ...RETRYJL
4Q76 ... SETNCORE SIZELIST,3,FILE,FABSNB
4Q7T ...[
4Q8J ...SET LDN 5 A1(3) [ INITIALISE IT
4Q9? ... LDN 4 XJOBLIST(1)
4Q=2 ... MOVE 4 SIZELIST
4Q=P ... ADN 5 1 [ FOR USERNAME
4Q?D ... MHUNT 3,ADATA,CSTORE [ TEMP STORAGE FOR COMMAND
4Q#7 ... LDN 4 A1(3) [ USERNAME
4Q#W ... MOVE 4 3 [ TO FABSNB
4QB6 [
4QTQ ... SETMODE 5,GENERAL,UNTRAP,NOERREP,NOWAIT,REPLY
4R*B CALL 7 USEROPEN [ SORT OUT USER JOBLIST NOW
4RT2 ... BRN (GEOERR)
4S#L TESTRPN2 OK,POTTY [ SHOULD BE ABLE TO OPEN FILE
4SS= MHUNT 3,ADATA,CSTORE [ FOR JOBNAME
4T?W LDN 5 A1+3(3) [ ADDRESS OF JOBNAME
4TRG GETJOB 5,USER
4W?6 TESTRPN2 OK,OUT [ SKIP IF NOT FOUND
4WGY ... CALL 4 STEPAGAIN
4X6F ... ADX 3 JOBDATASIZE
4X#? ... MBC 3,JLBABAND,JLBBMAP
4XLW ... JMBS NRG1,3,JLBHARDUP,JLBFROZENNC
4Y9L BC 3,JLBNOTCAND
4YJ3 ...NRG1
4YWD ... CALL 4 STEPWRITE
4^8W [
4^NG OUT CLOSETOP
5286 ... JMBS XIT,2,RGALLBIT,RGABIT
537B JBS TELLER,2,RGERROR [ J IF ERROR
54L= LDXC 6 6 [ FOR MESSAGE TYPE
555W BCS TELLNO [ J IF TO TELL NO
55KG CALL 7 SETNAMES [ OUTPACK JOB AND USER NAMES
5656 MONOUT ARGNAME
56JQ ... BRN XIT
574B TELLNO
57J2 CALL 7 SETJOBNO [ OUTPUT JOBNUMBER
583L MONOUT ARGJOBNO
58H= ... BRN XIT
592W [
59GG TELLER [ ERROR MESSAGE TIME
5=26 LDXC 6 6 [ WHICH MESSAGE
5=FQ BCS TELNO [ J IF JOBNO
5=^B CALL 7 SETNAMES [ NAMES
5?F2 ... LDX 5 PCANTRGNAME(1) [ ERROR UNIVERSAL
5?YL [
5#D= TELALL
5#XW CALL 7 OUTERROR [ OUTPUT ERROR MESSAGE
5*CG ... BRN XIT
5*X6 [
5BBQ [
5BWB MISSING
5C3J ... JMBS XIT,2,RGMONEY,RGFROZEN
5CB2 LDX 6 5 [ JOBNUMBER OF JOB LOST
5CTL CALL 7 SETJOBNO
5D*= ... LDX 5 PERGJOBNO(1)
5DSW BRN TELALL
5F#G [
5FS6 TELNO CALL 7 SETJOBNO
5G?Q ... LDX 5 PCANTRGNO(1)
5GRB BRN TELALL
5JPW [
5K9G ...XIT LDX 7 AWORK4(2)
5L8Q ADX 7 FX1
5LNB EXIT 7 0
5LQK ...WTJL
5LSS ... COOR4 #6
5LX3 ... BRN RETRYJL
5L^= ...POTTY
5M3F ... TESTREP2 CANT,WTJL
5M5N ... GEOERR 0,USER JL?
5M6T ...)
5M82 [
5MML [
5N7= [
5NLW [
5P6G [ START OF MAIN PATH THROUGH CODE
5PL6 [
5Q5Q START
5Q6R ... FSHCODE B,XNOTA1
5Q7S ...(
5Q8T ...# FOR SHARED FILESTORE THE WHOLE OF THE 'RG' COMMAND IS IMPLEMENTED
5Q9W ...# ON 'A', SO WE MUST TRANSFER THERE AS EARLY AS POSSIBLE
5Q=X ...#
5Q?Y ... TRANSBEG FSHRGCOMID,REGEN,1,CLB,,ACOMMUNE1
5Q#^ ...#
5QB2 ... BRN XENDC [ENDCOM RETURN FROM 'A'
5QC3 ... COMBRKIN [BREAK-IN RETURN FROM 'A'
5QD4 ...#
5QF5 ...XNOTA1
5QG6 ...)
5QH7 ... FSHSKIP B,XNOTINB1
5QJ8 ...(
5QKB ... CALL 4 POP
5R52 ... STOZ AWORK1(2) [ INITIALISE MARKER WORD
5RJL LDN 3 XALB(1) [ ALLBUT()
5S4= CALL 7 SPARABEG [ GET ALLBUT PARAM
5SHW BRN RAB
5T3G BRN RGAB
5T?# ...[
5TH6 RAB LDN 3 XAB(1) [ AB()
5W2Q CALL 7 SPARABEG
5WGB BRN TALL
5X22 BRN RGAB
5XFL [
5X^= TALL LDN 3 XALL(1)
5YDW CALL 7 SPARABEG
5YYG BRN SCAN
5^D6 [
5^XQ ...TAB LDX 0 JPARNUM(3) [ ALL PARAM MUST BE FIRST AND ONLY
62CB SBN 0 1
62X2 BNZ 0 SCANF [ NOT FIRST
63BL FREECORE 3 [ FREE THIS CPB/CUNI
63W= PARANUMB 3 [ SEE IF ONLY ONE PARAM
64*W SBN 3 1
64TG BNZ 3 SCAN [ J IF NOT THE ONLY PARAM
65*6 BS 2,RGALLBIT [ INDICATE ALL PARAM CORRECT
65SQ ... BRN SCAN [ J AS ALL PARAMS ANALYSED
664J ...[
66#B RGAB LDX 0 ANUM(3) [ ALLBUT PARAM RECOGNISED
66S2 SRL 0 12 [ CHECK IF TYPE 2 PARAM
67?L SBN 0 2
67R= BNZ 0 SCANF [ J IF NOT
68=W LDX 4 JPARNUM(3) [ SPLIT OUT JOBNAMES ETC
68GN ... FREECORE 3
68JJ ... LDN 3 2
68K8 ... NGN 0 1
68KS ...P1 PARALYSX 0,,4
68L6 ... TESTRPN2 OK,PARFORMER
68LD ... LDN 0 #34
68M4 ... LDN 4 2
68MN ... BCT 3 P1
6=9B BS 2,RGABIT [ INDICATE ALLBUT THESE JOBS
6=P2 BRN SCAN
6?8L [
6?N= SCANF FREECORE 3
6#7W [
6#MG SCAN SETNCORE SZCSTORE,3,ADATA,CSTORE
6*76 STOZ A1+6(3) [ COUNT OF RG JOBS IN COMMAND
6*BY ... JBS TERM,2,RGALLBIT
6*LQ [
6B6B SCANAGAIN [ START OF PARAM ANALYSYS LOOP
6BB8 ... MHUNT 3,ADATA,CSTORE
6BL2 MBC 2,RUSER,RJOB,RGNOJBER [ JOBNAME USERNAME ADDRESS
6C5L LDN 4 A1(3) [ CLEAR TO SPACES
6CK= LDN 5 A1+1(3)
6D4W LDX 0 ACES
6DJG STO 0 A1(3)
6F46 MOVE 4 5
6FHQ [
6G3B SPASS SPARAPASS [ NEXT PARAM
6GH2 [
6H2L SORT MHUNT 3,CPB,CUNI
6HG= LDX 0 JPARNUM(3) [ PARAM NUMBER FOR ERROR MESSAGES
6H^W STO 0 AWORK3(2) [ PRESERVE
6JBW ... LDX 5 ANUM(3) [ SEE IF NEXT PARAM EXISTS
6JRW ... BNG 5 TERM [ J IF NOT
6K8W ... BZE 5 NULL [ J IF NULL
6KKY ... LDCH 4 APARA(3)
6KR6 ... SBN 4 10
6KYB JMBS NAMES,2,RUSER,RJOB [ J IF JOBNAME OR USERNAME NEXT
6MC= BPZ 4 TRYUSER [ J IF NOT
6MWW CHNUMCOD 1,3 [ CONVERT A JOBNUMBER
6NBG TESTRPN2 OK,NOINV [ INVALID JOBNUMBER
6NW6 LDX 6 ACOMMUNE1(2) [ ELSE GET CONVERTED NUMBER
6P*Q ORX 6 GSIGN [ INDICATE ORIGINALLY JOBNO
6PTB BRN RGADD
6Q*2 [
6QJS ...NAMES
6QSL TRYUSER [ TEST FOR USERNME
6R#= BNZ 4 TRYJOBNAME [ J IF FIRST CHAR NOT :
6RRW JBS PARFORMER,2,RUSER [ J IF ALREADY GOT A USERNAME
6RX2 ... LDEX 6 5
6S26 ... SRL 5 12 [ USERNAMES ARE TYPRE 1 PARAMS
6S5= ... SBN 5 1
6S8B ... BNZ 5 PARUSER
6SB^ ... LDN 3 APARA(3)
6SKJ ...TRYUSER2
6SS7 ... BCHX 3 £ [SKIP COLON 1ST TIME,THEN
6T2Q ...[ LEADING SPACES
6T9* ... SBN 6 1 [DECREMENT CHAR COUNT
6TCY ... LDCH 4 0(3) [NEXT CHAR
6TLH ... SBN 4 #20
6TT6 ... BZE 4 TRYUSER2 [J IF LEADING SPACES IN USERNAME
6W3P ...[
6W=# ...[ COLON & ANY LEADING SPACES HAVE NOW BEEN DROPPED
6WDX ... LDX 4 3 [SO X4 POINTS TO 1ST SIG CHAR
6WMG ... SBN 6 1
6WW5 ... BNG 6 PARUSER [PARAM SHOULD BE GREATER THAN ONE CHA
6X4N ... SBN 6 12
6X?? ... BPZ 6 PARUSER [AND <13, ELSE ERROR
6XFW ... ADN 6 13 [X6=NO OF CHARS IN USERNAME
6XNW MHUNT 3,ADATA,CSTORE [ SAVE USERNAME
6Y8G LDN 5 A1(3)
6YN6 SMO 6
6^7Q MVCH 4 0
6^MB BS 2,RUSER [ USERNAME READ
7272 BRN TRY2 [ GO AND FINISH CHECK
72LL [
736= TRYJOBNAME
73KW JBS PARFORMER,2,RJOB
745G CHEKLFN2 PARFORMER,PARFORMER,3
74K6 LDN 4 APARA(3)
754Q LDX 6 ANUM(3) [ CHARS IN JOBNAME
75JB MHUNT 3,ADATA,CSTORE
7642 LDN 5 A1+3(3) [ AND PRESERVE IT
76HL SMO 6
773= MVCH 4 0
77GW BS 2,RJOB [ INDICATE JOBNAME READ
782G [
78G6 TRY2 MFREE CPB,CUNI
78^Q JMBC SPASS,2,RUSER,RJOB [ IF EITHER BIT CLEAR LOOP
79FB [
79^2 [ NOW HAVE USERNAME AND JOBNAME SO CHECK IF JOB OK
7=DL [
7=Y= CALL 7 SETFABS
7?CW MHUNT 3,ADATA,CSTORE
7?XG LDN 4 A1(3)
7#C6 MOVE 4 3
7#WQ SETMODE 5,READ,NOERREP,UNTRAP
7*BB CALL 7 USEROPEN
7*W2 BRN XBRK
7B*L TESTRPN2 OK,NOUSER [ J IF NOT OK
7BT= MHUNT 3,ADATA,CSTORE [ CHECK JONNAME
7C#W LDN 6 A1+3(3)
7CSG GETJOB 6,USER [ GET ENTRY
7D#6 TESTREP2 OK,SOK
7DRQ BS 2,RGNOJBER
7F?B [
7FMG ... CLOSETOP
7G3L ...SOK JBS NOUSER,2,RGNOJBER
7G9N ... CALL 4 STEPAGAIN
7GK2 ... LDX 6 JLJOBNO(3)
7GML ... CLOSETOP
7GQ= [
7H9W [ REGENERATABLE JOB - JOBNO IN X6
7HPG [
7J96 RGADD MHUNT 3,ADATA,CSTORE [ JOBNO BLOCK
7JNQ LDX 0 A1+6(3)
7K8B ADN 0 7
7KN2 TXL 0 ALOGLEN(3) [ SEE IF ENOUGH ROOM LEFT
7L7L BCS RAD
7LM= LDX 4 ALOGLEN(3)
7M6W ADN 4 SZCSTORE [ LENGTHEN BLOCK
7MLG ALTLENG 3,4,REHUNT [ LENGTHEN BLOCK
7N66 [
7N*Y ... MHUNT 3,ADATA,CSTORE
7NKQ RAD LDX 4 A1+6(3) [ COUNT
7P5B SLL 4 1 [ ACTUAL MODIFIER
7PK2 SMO 4
7Q4L STO 6 A1+7(3) [ JOBNO
7QJ= LDX 0 AWORK3(2) [ PARAM NUMBER
7R3W SMO 4
7RHG STO 0 A1+8(3) [ PARAM NUMBER FROM WHICH DERIVED
7S36 LDN 0 1 [ INCREMENT IT FOR NEXT TIME
7SGQ ADS 0 A1+6(3) [ UPDATE POINTER
7T2B BRN SCANAGAIN [ BACK FOR NEXT JOB
7TG2 [
7T^L NOUSER
7WF= CALL 7 SETNAMES [ NO SUCH JOB
7WYW ... LDX 5 PERGNOJOB(1)
7XDG CALL 7 OUTERROR
7XY6 BRN SCANAGAIN
7YCQ [
7YXB TERM JMBS PARFORMER,2,RUSER,RJOB
83*G [
83T6 OPEN OPENSYS XBRK,JOBLIST,GENERAL
844Y ... INHIBITBRK TIDYBRK
84#Q JMBS TOTAL,2,RGALLBIT,RGABIT
84SB STOZ AWORK3(2) [ BLOCK POINTER
85#2 [
85RL NEXT1 MHUNT 3,ADATA,CSTORE
86?= LDX 7 AWORK3(2) [ MODIFIER
86QW TXU 7 A1+6(3) [ SEE IF FINISHED
87=G BCC OUTFIN [ J IF DONE
87Q6 LDN 0 1 [ INCREMENT ENTRY COUNTS
889Q ADS 0 AWORK3(2) [ INCREMENT
88PB SLL 7 1 [ ENTRY MODIFIER
8992 SMO 7 [ MODIFY
89NL LDX 6 A1+7(3) [ JOBNO
8=8= CALL 7 REGENJOB [ REGENERATE THIS JOB
8?7G BRN NEXT1 [ CONTINUE
8?M6 [
8#6Q [
8#BJ ...TOTAL CALL 4 STEP
8*62 [
8**S ...ROUND CALL 4 STEP
8B5= BZE 3 OUTALL [ END OF RG ALL
8BJW JBS SUB,2,RGALLBIT [ SKIP IF ALL
8C4G LDX 6 FRH+JLJOBNO(3) [ ELSE CHECK JOBNO
8CJ6 MHUNT 2,ADATA,CSTORE
8D3Q LDX 5 A1+6(2) [ NO OF JOBS
8D?J ... BZE 5 SUB2
8DHB LDN 4 0 [ MODIFIER START
8F32 [
8FGL X SMO 4 [ COMPARE JOBNOS
8FW* ... LDXC 0 A1+7(2)
8G=4 ... BCS £
8GKR ... BXE 0 6,ROUND
8G^G ADN 4 2
8HF6 BCT 5 X [ CHECK ALL JOBS
8HK3 ...SUB2
8HNY ... LDX 2 FX2
8HYQ [
8J?7 ...SUB [ CHECK IF JOB RG'ABLE
8JKJ ... ADX 3 JOBDATASIZE
8K2K ... JMBAC ROUND,3,JLBABAND,JLBBMAP
8KCL CALL 7 REGENJOB
8LBW BRN ROUND
8LWG [
8MB6 OUTALL
8MTQ MONOUT ALLRGJOBS
8MXH ... LDN 5 1
8MY6 ... JBS TELLHLS,2,RGALLBIT
8MYP ... MHUNT 2,ADATA,CSTORE
8M^# ... LDX 7 A1+6(2)
8M^X ... BZE 7 TELLNUN
8N2G ... LDX 6 7
8N35 ... LDN 3 A1+7(2)
8N3N ... LDN 1 A1(2)
8N4? ...TELLMV
8N4M ... LDXC 0 0(3)
8N53 ... BCS £
8N5F ... STO 0 0(1)
8N64 ... ADN 3 2
8N6M ... ADN 1 1
8N7= ... BCT 6 TELLMV
8N7T ...TELLNUN
8N8D ... STO 7 ALOGLEN(2)
8N93 ... NAME 2,ADATA,ASUP
8N9L ... LDN 5 2
8N=9 ...TELLHLS
8N=S ... LDN 4 0
8N?C ... LDN 3 0
8N#2 ... CALL 7 XHLSINF
8N*B [
8NT2 OUTFIN
8P4S ... PERMITBRK
8P8P ... CALL 7 RUNJSA
8P#L CALL 7 VOPCLOSE
8P*= ...#
8P*W ...XNOTINB1
8PBG ...)
8PC6 ... FSHCODE AORB
8PCQ ...(
8PDB ...#
8PF2 ...XENDC
8PFL ...#
8PG= ... FSHCODE A,XHERE
8PGW ...(
8PHG ...# CHECK HERE WHETHER WE MUST GO BACK TO 'B' BEFORE THE 'ENDCOM'
8PJ6 ...#
8PJQ ... TRANCHKN FSHRGCOMID,EQUAL,XHERE,XHERE
8PKB ...#
8PL2 ... LDN 3 0 [SET THE OFFSET FOR 'ENDCOM'
8PLL ...#
8PM= ...XFIN TRANSFIN 3 [AND RETURN TO 'A'
8PMW ...#
8PNG ...XHERE
8PP6 ...)
8PPQ ... ENDCOM
8PQB ...)
8PR2 ... FSHSKIP
8PS= ...XENDC ENDCOM
8P^D ... FSHSKIP B,XNOTB3
8Q6L ...(
8Q?W [
8QRG NOINV
8R?6 NULL
8RQQ PARUSER
8S=B PARFORMER
8TP= CALL 5 VOP
8TXG ... LDN 5 APFERR
8W5Q ... NGN 6 1
8W#2 ... CALL 7 OUTERROR
8WG= ... BRN XENDC
8WNG [
8X86 TIDYBRK
8XMQ CLOSETOP
8Y7B [
8YM2 XBRK CALL 5 VOP
8YN? ... FSHCODE A,XNOTB2
8YPJ ...(
8YQT ...# THIS IS ANOTHER POINT WHERE WE MIGHT HAVE TO GO BACK TO 'B'
8YS6 ...#
8YTC ... TRANCHKN FSHRGCOMID,EQUAL,XNOTB2,XNOTB2
8YWN ...#
8YX^ ... LDN 3 1 [SET OFFSET FOR BREAK-IN RETURN
8Y^= ... BRN XFIN
8^2H ...#
8^3S ...XNOTB2
8^55 ...)
8^6L ... COMBRKIN
8^L= REHUNT
925W MHUNT 2,ADATA,CSTORE
92KG EXIT 1 0
92KK ...[
92QY ...[
92Q^ ...[ THE NEXT SECTION DEALS WITH THE REGENERATION OF JOBS
92R2 ...[ FROM A USER WHO HAS JUST BECOME SOLVENT OR WHO HAS JUST BEEN
92R3 ...[ THAWED. (I.E. IT IS PART OF THE IMPLEMENTATION OF "DICTJL".)
92R4 ...[ ON ENTRY IN ACOMMUNE4 :-
92R5 ...[ B0=1 IF USER HAS BECOME OVERDRAWN
92R6 ...[ B1=1 IF USER HAS BECOME SOLVENT
92R7 ...[ B2=1 IF USER HAS BEEN FROZEN
92R8 ...[ B3=1 IF USER HAS BEEN THAWED
92R9 ...[ N.B. 1 AND ONLY1 OF THESE BITS WILL BE SET.
92R= ...[
92R? ...MONEY
92R# ... LDCT 0 #140
92R* ... ANDX 0 ACOMMUNE4(2)
92RB ... BNZ 0 NMS [NO MESSAGE IF FROZEN OR THAWED
92RC ... OUTBLOCN 4
92RD ... LDN 6 ACOMMUNE1(2)
92RF ... LDN 4 3
92RG ... LDN 5 JPDUSERNAME
92RH ... CALL 7 XOUTPACK
92RJ ...NMS LDCT 0 #500
92RK ... ANDX 0 ACOMMUNE4(2)
92RL ... BNZ 0 XABAN [J IF ONE OF THE ABANDON ENTRIES
92RM ... STOZ AWORK1(2)
92RN ... LDX 0 ACOMMUNE4(2)
92RP ... SLL 0 1
92RQ ... BNG 0 MY1 [J IF SOLVENT ENTRY
92RR ... BS 2,RGFROZEN [ELSE MUST BE CC FZ
92RS ... BRN MY2
92RT ...MY1 BS 2,RGMONEY
92RW ...MY2 CALL 6 OPENJLS [OPEN JOBLIST FILES
92RX ... BRN UP2 [NOTHING TO DO IF NO USER JOBLIST
92S2 ... LDN 7 0
92S4 ...MNXT CALL 4 STEP1
92S7 ... BZE 3 MEND [J IF AT END OF USER JOBLIST
92S8 ... LDX 6 JLJOBNO(3)
92S9 ... ADX 3 JOBDATASIZE
92S= ... JBS MY3,2,RGMONEY
92S? ... JBC MSKP,3,JLBFROZENNC
92S# ... BRN MY4
92S* ...MY3 JBC MSKP,3,JLBHARDUP
92SB ...MY4
92SC ... JBS MRUN,3,JLBRUNNING
92SD ... CALL 7 REGENJOB [REGENERATE THE JOB
92SG ...MRUN1 CALL 4 STEPAGAIN1
92SK ... ADX 3 JOBDATASIZE
92SL ... JBS MY5,2,RGMONEY
92SM ... BC 3,JLBFROZENNC
92SN ... BRN MY6
92SP ...MY5 BC 3,JLBHARDUP
92SQ ...MY6 JMBS NRG2,3,JLBABAND,JLBBMAP,JLBHARDUP,JLBFROZENNC
92SR ... BC 3,JLBNOTCAND
92SS ...NRG2 SBX 3 JOBDATASIZE
92ST ... CALL 4 STEPWRT1
92SW ...MSKP SKIP 1,3
92SX ... BRN MNXT
92SY ...MRUN JBS MRUN1,2,RGFROZEN
92S^ ... GETJOB 6,SYSTEM [RUNNING JOBS MAY BE HARD UP
92T3 ... CALL 4 STEPAGAIN
92T6 ... ADX 3 JOBDATASIZE
92T7 ... MBC 3,JLBNOTCAND,JLBHARDUP
92T8 ... SBX 3 JOBDATASIZE
92T9 ... CALL 4 STEPWRITE
92T= ... BRN MRUN1
92T? ...MEND BZE 7 PEND [J IF MESSAGE NOT REQUIRED
92T# ... JBS MFZ1,2,RGFROZEN
92T* ... MONOUT JMONEYOK
92TB ...MFZ1 CALL 7 RUNJSA
92TD ...PEND
92TH ...PENDP CLOSETOP
92TJ ... CLOSETOP
92TK ...UP2 LDCH 0 ATYPE(2)
92TL ... SBN 0 CPAT/64
92TM ... BNZ 0 UP1
92TN ... LDX 0 AWORK3(2)
92TP ... STO 0 JOBEVENTS(2) [RESTORE BREAK IN BITS
92TQ ...UP1 LOSEPARS
92TR ... UP
92TS ...XABAN
92TT ... STO 0 AWORK1(2)
92TW ... CALL 6 OPENJLS
92TX ... BRN UP2
92W? ... LDX 0 AWORK3(2)
92WM ...[ ABANDONA USES AWORK4 AS PARAM
92X3 ... STO 0 AWORK4(2)
92XC ... ACROSS ABANDONA,2 [DE-GENERATE JOBS
92XR ...[
92Y7 ...OPENJLS
92YH ... SBX 6 FX1
92YX ... CALL 7 SETFABS
92^? ... LDN 4 ACOMMUNE1(2)
92^M ... LDN 5 A1+1(3)
9323 ... MOVE 4 3
932C ... SETMODE 5,GENERAL,UNTRAP,NOERREP
932R ... LDCH 0 ATYPE(2)
9337 ... SBN 0 CPAT/64
933H ... BNZ 0 NCPA [J IF NOT CPAT
933X ... LDX 0 JOBEVENTS(2)
934? ... STO 0 AWORK3(2)
934M ... LDCT 0 #40
9353 ... STO 0 JOBEVENTS(2) [FIDDLE BREAK IN BITS
935C ...NCPA CALL 7 USEROPEN [OPEN USER JOBLIST
935R ... BRN (GEOERR)
9367 ... TESTRPN2 OK,NOJOBS
936H ... ADN 6 1
936X ... OPENSYS (GEOERR),JOBLIST,GENERAL
937? ...NOJOBS
937M ... ADX 6 FX1
9383 ... EXIT 6 0
938C ...#
938R ...XNOTB3
9397 ...)
939H ...#UNS FSHTEST
939X ...#SKI
93=? ...(
93=M ... FSHCODE B,XNOTA2
93?3 ...(
93?C ...# THERE IS NO K2 ENTRY ON THE 'B' MACHINE
93?R ...#
93#7 ...MONEY
93#H ... GEOERR 1,K2-ENTRY
93#X ...#
93*? ...XNOTA2
93*M ...)
93B3 ...)
93BS ...# [THE CODE WHICH USED TO FOLLOW HAS BEEN TRANSFERRED TO
93WD ...# SEGMENT DICTWELL.
94B4 ...#END
^^^^ ...001370400007