REGEN865
(George Source)
Macros used: ACROSS, ALTLENG, BC, BITDEFS, BS, BXE, CHEKLFN2, CHNUMCOD, CLOSETOP, COMBRKIN, COOR4, ENDCOM, ERRORX, FREECORE, FSHCODE, FSHSKIP, FSHTEST, GEOERR, GETJOB, HLSINFORM, HUNT, INHIBITBRK, JBC, JBS, JLADJUST, JMBAC, JMBC, JMBS, JOBLOCK, LOSEPARS, MBC, MEND, MFREE, MHUNT, MONOUT, NAME, OPEN, OPENSYS, OUTBLOCN, OUTNUM, OUTPACKX, PARALYSX, PARANUMB, PERMITBRK, POP, READAGAIN, RG, RUNJSA, SEGENTRY, SETMODE, SETNCORE, SKIP, SPARABEG, STEP, STEPAGAIN, STEPREWRITE, STEPWRITE, TAB, TESTREP2, TESTRPN2, TRACE, TRANCHKN, TRANSBEG, TRANSFIN, UP, USEROPEN, USEROPEX, VOP
- REGEN865.txt
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