EMSENTER867

(George Source)

Macros used: ACROSS, BSON, CLOSETOP, DOWN, FSHTEST, ISSUJOB, JBS, MASK, MENDAREA, MFREEW, MHUNT, OPENDIR, RUNJSA, SEG, SEGENTRY, SETNCORE, SKIP, SUICIDE

EMSENTER867.txt
22?B ...      SEG      EMSENTER,867,SECTION CENT
22JQ ...[   
22W6 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LIMITED  1982   
237G ...[   
23DW    #OPT  K0EMSENTER=K0HLS>K0INCDUMP>K0EMS>K0ALLGEO>K0GREATGEO  
23YG    #LIS  K0EMSENTER
24D6    #   
24XQ    #  A COMMAND PROCESSING ACTIVITY IS SET UP DURING E.M.S. (BY SETUP) WITH
25CB    #  PAIR TO K1 OF THIS SEGMENT. IT IS RELEASED AT END OF E.M.S.. 
25X2    #  INITIATES  1) THE INITIAL INCREMENTAL DUMPER JOB (ALWAYS).   
26BL    #                  ALSO HLSJOB IF HLSON. BOTH THESE ARE SYS. ISSUED 
26W=    #        AND  2) JUGGERNAUT RESTORER JOB (BUT ONLY AFTER A GENERAL RESTO
27*W    #        AND  3) JOB TO ASK OPERATORS ABOUT INCREMENTS ONLY APPEARING ON
27TG    #                  WRONGED DUMP TAPES (BUT ONLY IF "WRONGED INCREMENTS" 
28*6    #                                      MARKER SET [B23 OF INCWORD]).
28SQ    #        AND  4) MACRO EMSJOBS WISH IS USED TO INITIATE ANY JOBS REQUIRE
29#B    #                  ALWAYS,+ PARAMETER INDICATING GEN REST OR NOT, AS
29S2    #                  APPROPRIATE  
29^8 ...#         AND  5) IF LPS ON HAS BEEN USED, "LPSJOB",
2=6B ...#                   THE LPS14 SPOOLING JOB. 
2=?L    #  THE DUMPER IS SET UP AS SYSTEM-ISSUED JOB BUT JUGGERNAUT, Q & EMSJOBS
2=R=    #  ARE NOT.  UNFORTUNATELY (VERY), THE SEGMENT IS NOT TOLD IF ANY OF THE
2?=W    #  RUNJOBS (ETC.) FAIL.  TO COMPENSATE FOR THIS, IT TRIES TO AVOID A
2?QG    #  NON-UNIQUE JOB NAME FOR DUMPER OR HLS. NO ATTEMPT MADE TO CATER  
2#=6    #  FOR FAILURE OF OTHER RJ'S ETC
2#PQ    #   
2*9B    #   
2*P2    #     ENTRY POINTS  
2B8L    #   
2BN=          SEGENTRY K1EMSENTER,START 
2C7W    #     THE FOLLOWING TABLE CONSISTS OF CELLS WITH THE
2CMG    #     FOLLOWING FORMAT: 
2D76    #   
2DLQ    #     WORD 0 = INSTRUCTION TO CHECK IF COMMAND IS REQUIRED  
2F6B    #     WORD 1 = CHARACTER COUNT OF COMMAND   
2FL2    #     WORD 2 = INSTRUCTION TO ADJUST IF NECESSARY THE ADATA/CREADL  
2G5L    #     WORD 3 ETC. = THE COMMAND 
2GK=    #   
2H4W    #     THE LAST CELL TERMINATES THE PROCEDURE BY SUICIDE 
2HJG    #   
2J46    #SKI  CPDATA-A1-2   
2JHQ    !     USE OF TABLE ASSUMES CPDATA=A1+2 !
2K3B    TABLE   
2KH2          BRN      RET1                [DUMPER ALWAYS REQUIRED  
2L2L                   +24  
2LG=          BRN      QDUMP               [ADJUST JOBNAME IF NECESSARY 
2L^W                   24HRJ  A0,:DUMPER,INCJOB 
2MFG    #   
2M^6          BRN      QHLS1               [SEE IF HLS ON OR OFF
2NDQ                   +28  
2NYB          BRN      QHLS2               [ADJUST JOBNAME IF NECESSARY 
2PD2                   28HRJ  HLSJOB ,:SYSTEM,HLSFILE   
2PXL    #   
2QC=          BRN      QJUGG               [SEE IF JUGGERNAUT REQUIRED  
2QWW                   +36  
2RBG          BRN      RET2                [NO CHANGE TO DATA/CREADL
2RW6                   36HRJ JUGGERNAUTJB,:MANAGER,JUGGERNAUT   
2S*Q    #   
2STB          BRN      QQ                  [SEE IF :DUMPER,Q REQUIRED   
2T*2                   +36  
2TSL          BRN      RET2                [NO CHANGE TO ADATA/CREADL   
2W#=                   36HRJ Q,:DUMPER,PROCESSOR,PARAM(QUEST)   
2WRW    #   
2X?G          BRN      RET1                [EMSJOBS ALWAYS ISSUED   
2XR6                   +20  
2Y=Q          BRN      QEMS                [PUT IN NORES/REST PARAMETER 
2YQB                   20HEMSJOBS   
2^=2    #   
2^#H ...      SEGENTRY K53EMSENTER  
2^*5 ...      BRN      SKIP         [NIP RESTORE MAC MENDS TO BRN K52EMSENTER (S
2^*M ...[                                OR TO BRN K51EMSENTER (ISSUE RJ)   
2^B9 ...      +32   
2^C4 ...      BRN      QNIP2        [ADJUST JOBNAME IF NEC  
2^CX ...      32HRJ  LPSJOB ,:LPSCONTROL,LPSJDF 
2^FS ...      SEGENTRY K50EMSENTER  
2^HB ...#UNS  FSHTEST   
2^JY ...      ACROSS   FSHAUTO,1
2^LG ...#UNS  FSHTEST   
2^N4 ...#SKI
2^PL          SUICIDE                      [END OF TABLE
329=    #   
32NW    MDUMP          +10  
338G                   12HDUMPER
33N6                   12HA0
347Q                   0,0,0
34MB    MHLS           +10  
3572                   12HSYSTEM
35LL                   12HHLSJOB
366=                   0,0,0
36#4 ...MNIP   +10  
36B2 ...      12HLPSCONTROL 
36CY ...      12HLPSJOB 
36FW ...      0,0,0 
36KW    NORES          12HNORESTORE 
375G    REST           12HGENRESTORE
37=N ...#UNS FPARTRES   
37CW ...PARTRES        12HPARTRESTORE   
37K6    MASK           #57777777
384Q    #   
38JB    QDUMP   
3942          LDN   3  MDUMP
39HL          LDCT  5  #200                [=0.1
3=3=          BRN      UNIQUE              [ADJUST JOBNAME TO BE UNIQUE 
3=GW    #   
3?2G    QHLS1   
3?G6          LDX   0  MASK(1)  
3?^Q          ANDS  0  CLONG1(2)           [LOSE BS PRIVILEGE   
3#FB          BSON     HLSBIT,SKIP         [SKIP RJ IF HLS OFF  
3#^2          BRN      RET1 
3*2P ...[   
3*4D ...QNIP2   
3*67 ...      LDN   3  1
3*7W ...      STO   3  ANIPSW            [SET LPS INDICATOR 
3*9K ...      LDN   3  MNIP 
3*?B ...      BRN      QNIP3
3*DL    QHLS2   
3*Y=          LDN   3  MHLS 
3B84 ...QNIP3   
3BCW          LDCT  5  #400 
3BXG          ADN   5  1                   [=1.2
3CC6    UNIQUE  
3CWQ          LDN   6  1
3DBB          SETNCORE 10,2,FILE,FABSNB 
3DW2          LDN   4  A1(2)
3F*L          ADX   3  1
3FT=          MOVE  3  10   
3G#W    ULOOP                              [ATTEMPT TO FIND FILE = JOBNAME  
3GSG          OPENDIR  (GEOERR),READ,ERASING,QUERY  
3H#6          TESTREPN OK,UOK              [J IF JOBNAME SHOULD BE UNIQUE   
3HRQ          MFREEW   FILE,ENT 
3J?B          CLOSETOP  
3JR2          MHUNT    3,FILE,FABSNB
3K=L          ADX   3  A1(3)
3KQ=          ADX   3  5
3L9W          DCH   6  A1-6(3)             [UPDATE JOBNAME  
3LPG          STOZ     A1-3(3)  
3M96          STOZ     A1-2(3)  
3MNQ          STOZ     A1-1(3)  
3N8B          MHUNT    3,ADATA,CREADL   
3NN2          ADX   3  5
3P7L          DCH   6  CPDATA+1(3)  
3PM=          ADN   6  1
3Q6W          BRN      ULOOP
3QLG    UOK 
3R66          ISSUJOB  0                   [ISSUE RUNJOB FOR DUMPER/HLS 
3R?# ...[                                   %A=0 MEANS CONTROL RETURNED 
3RDG ...[                                   TO ISSUING ROUTINE  
3RKQ          BRN      RET3                [BACK TO MAIN LOOP   
3S5B    #   
3SK2    QJUGG   
3T4L          SEGENTRY K20EMSENTER         [USED BY NOJUGG MACRO
3TJ=          LDX   0  GINCTSN  
3W3W          BZE   0  SKIP                [J IF NO GEN REST
3WHG          BRN      RET1 
3X36    #   
3XGQ    QQ  
3Y2B          LDX   0  INCWORD  
3YG2          ANDN  0  1
3Y^L          BZE   0  SKIP                [J IF NO WRONGED INCREMENTS  
3^F=          BRN      RET1 
3^YW    #   
42DG    QEMS
42Y6          LDN   4  CPDATA+2(3)  
436L ...      LDX   0  GINCTSN  
43*6 ...      BZE   0  NGRES               [^ IF NO GEN RES 
43HL ...      LDN   3  REST(1)  
43Q6 ...      BRN      NRES 
43YL ...NGRES   
4476 ...#UNS FPARTRES   
44*L ...(   
44J6 ...      LDN   3  PARTRES(1)   
44QL ...      JBS      NRES,,BFPRDONE       [^ IF NO PART RES   
44^6 ...)   
457L ...      LDN   3  NORES(1) 
45B=    NRES  MOVE  3  3                   [MOVE IN APPROPRIATE PARAMETER   
45TW          BRN      RET2 
46*G    #   
46T6    #     MAIN PATH STARTS HERE 
47#Q    #   
47SB    START   
4848 ...      STOZ     ANIPSW           [INITIALISE LPS INDICATOR   
48#2    #     SET UP JWELL SLOTS ETC.   
48RL          RUNJSA
49QW          LDN   6  0                   [INITIALISE TABLE POINTER
4==G    XLOOP   
4=Q6          STO   6  AWORK1(2)
4?9Q          SMO      6
4?PB          BRN      TABLE               [GO SEE IF COMMAND IS NECESSARY  
4#3Q ...      SEGENTRY  K51EMSENTER 
4#92    RET1                               [RETURN HERE MEANS IT IS(SKIP IF NOT)
4#NL          LDX   6  AWORK1(2)
4*8=          SMO      6
4*MW          LDX   4  TABLE+1(1)          [CHAR. COUNT OF COMMAND  
4B7G          SRL   4  2
4BM6          ADN   4  CPDATA-A1
4C6Q          SETUPCOR 4,3,ADATA,CREADL    [SET UP BLOCK BIG ENOUGH FOR COMMAND 
4CLB          LDN   0  A1(3)
4D62          SMO      6
4DKL          LDN   7  TABLE+1(1)   
4F5=          SMO      4
4FJW          MOVE  7  0                   [MOVE COUNT/COMMAND INTO ADATA/CREADL
4G4G          SMO      6
4GJ6          BRN      TABLE+2             [ADJUST ADATA/CREADL IF REQUIRED 
4H3Q
4HHB    RET2
4J32          DOWN     REDON,3             [ISSUE COMMAND - BUT NOT SYS. ISS.   
4JGL    RET3                               [RETURN FROM DUMPER/HLS ISSUJOB  
4JT2 ...      SEGENTRY  K52EMSENTER 
4K2=    SKIP
4KFW          LDX   6  AWORK1(2)
4K^G          SMO      6
4LF6          LDX   4  TABLE+1(1)   
4LYQ          SRL   4  2
4MDB          ADX   6  4
4MY2          ADN   6  3                   [STEP ON TABLE POINTER   
4NCL          BRN      XLOOP
4NX=    #   
4PBW          MENDAREA 10,K99EMSENTER   
4PWG    #END
^^^^ ...03110442000200000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1