OUTPER867

(George Source)

Macros used: GEOPACK, HUNTMISB, MENDAREA, OUTPAR, SAWCEJ, SAWCEJX, SEGENTRY, UP

OUTPER867.txt
22FL    #SEG  OUTPER8                      [A C PUTMAN  
22PD ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982.   
22^=    #OPT  K0OUTPER=0
23DW    #OPT  K6OUTPER=0
23YG    #LIS  K0OUTPER>K0ALLGEO 
24D6                   8HOUTPER 
24XQ    #              THIS SEGMENT IS ENTERED IF OUTPER MACRO FINDS NO PARAM.  
25CB    #              A JSOURCE TYPE WORD PAIR, OR THE PACKED EQUIVALENT, IS   
25X2    #              USED TO CREATE A PERIPHERAL DESCRIPTION CHARACTER STRING 
26BL    #              OF THE FORM: 1) 'UX'   ( X=GEOG. NO. FOR LOCAL PERIPH.)  
26W=    #                        OR 2) 'IAAY' (AA=PCT IDENT., Y=INTERFACE NO.)  
27*W    #                        OR 3) 'IZ'   ( Z=7900 IDENTIFIER NO.)  
27TG    #   
28*6    #     ZCONV:-  SUBR TO CONVERT BINARY TO DECIMAL IN ACOMMUNE3 ONWARDS.  
28SQ    #              LINK IN X3. ON ENTRY X4=NO. TO BE CONVERTED,X2=FX2 PLUS  
29#B    #              CHAR MOD TO POSN IN ACOM2 INTO WHICH CONVERTED CHARS WILL
29S2    #              BE OUTPUT. PARAM TO THIS SUBR IS THE NO. OF EXTERNAL 
2=?L    #              CHARS TO BE CONVERTED,HELD IN X7 (1-4).  
2=R=    #              ON EXIT (LINK + 1) ACOM2 & 3 CONTAIN THE CONVERTED CHARS 
2?=W    #              LEFT JUSTIFIED STARTING AT THE REQD POSN, X2 = FX2   
2?QG    #              X7 = COUNT OF CHARS USED , ALL OTHER X'S USED UP.
2#=6    #   
2#PQ    #   
2*9B    #              ENTRY POINTS 
2*P2    #   
2B8L          SEGENTRY K1OUTPER,X1OUTPER
2BN=          SEGENTRY K2OUTPER,X2OUTPER
2C7W          SEGENTRY K3OUTPER,X3OUTPER
2CMG          SEGENTRY K4OUTPER,X4OUTPER
2D76    #   
2DLQ    TEN   10,100,1000,10000 
2F6B    #   
2FL2    ZCONV   
2G5L          ANDN  4  #7777
2GK=          LDN   5  0
2H4W          SMO      7
2HJG          DVR   4  TEN-1(1) 
2J46          LDCT  6  #200 
2JHQ          MODE     0
2K3B          LDX   0  7                   [NO.OF EXTL CHARS
2KH2          LDN   7  0
2L2L          LDN   4  0
2LG=    ZCON1 CBD   5  7                   [PUT CHAR IN X7  
2L^W          ORX   4  7
2MFG          BZE   4  ZCON2               [J IF NOT A SIGNIFICANT CHAR.
2M^6          DCH   7  ACOMMUNE2(2)        [INSERT SIG CHAR.
2NDQ          BCHX  2  £
2NYB    ZCON2 BCT   0  ZCON1
2PD2          BNZ   4  ZCON3
2PXL          DCH   4  ACOMMUNE2(2)        [FOR ZERO CONVERSION 
2QC=          BCHX  2  £
2QWW    ZCON3 LDX   7  2
2RBG          SLC   7  2
2RW6          LDX   6  FX2  
2S*Q          SLL   6  2
2STB          SBX   7  6
2T*2          LDX   2  FX2  
2TSL          EXIT  3  0
2W#=    #   
2WRW    #   
2X?G    X1OUTPER
2XR6          OUTPAR   GEOPER              [THIS ENTRY MAY WELL BECOME REDUNDANT
2Y=Q          UP                           [BUT IS HERE BECAUSE OUTPAR IS LONG. 
2YQB    #   
2^=2    #   
2^PL    X3OUTPER                           [OUTPERA MACRO   
2^R8 ...      LDX   0  ANIPSW              [J IF NOT LPS14-NIP  
2^SQ ...      BZE   0  XNLPS
2^W# ...      SAWCEJ   XNLPS,XNLPS,XNLPS,XLPS   
2^XW ...[ NIP PACKS TO B0-2 = 1,B3-23 = 0   
2^^D ...XLPS  LDCT  0  #100 
3232 ...      STO   0  ACOMMUNE1(2) 
324J ...      BRN      X4OUTPER 
3266 ...XNLPS   
329=          GEOPACK  ACOMMUNE1(2)        [PACK UP JSOURCE1 & 2 WORDS. 
32NW    X4OUTPER                           [PERCHARS MACRO  
338G          LDX   5  ACES                [SPACEFILL GASH CHARACTERS.  
33N6          LDX   4  ACOMMUNE1(2) 
33XY ...      STO   5  ACOMMUNE2(2) 
347Q          STO   5  ACOMMUNE3(2) 
34MB          SAWCEJX  ACOMMUNE1(2),PERLOC,PERIPB   
3572    PCT   STO   4  ACOMMUNE2(2) 
35LL          LDN   4  #51  
366=          LDN   7  4
36KW          DCH   4  ACOMMUNE2(2)        [PUT 'I' BEFORE TERM IDENT.  
375G    OUTP1 STO   7  ACOMMUNE1(2)        [STORE CHARACTER COUNT.  
37K6    XUP   UP
384Q    #   
38JB    PERIPB  
3942          LDN   3  #51                 ['I' 
39HL          LDN   7  4
3=3=    OUTP2 DCH   3  ACOMMUNE2(2)        [INSERT START CHARACTER. 
3=GW          BCHX  2  £                   [STEP ON 
3?2G          SEGENTRY K50OUTPER
3?G6          CALL  3  ZCONV               [CONVERT IDENT TO DECIMAL
3?^Q          BRN      OUTP1
3#FB    #   
3#^2    PERLOC  
3*DL          LDN   7  3
3*KF ...      LDCT  0  #100                [J IF LPS14-NIP  
3*Q# ...      TXU   0  4
3*S= ...      BCC      XLPS2
3*Y= ...      SEGENTRY K51OUTPER           [BILA OFF OVERWRITES NEXT INSTN  
3BCW ...      LDN   3  #65                 ['U' (WITH BRN K50OUTPER)
3BXG          BRN      OUTP2
3C4M ...[   
3C6B ...XLDAT 4HLPS                        [LPS14-NIP   
3C85 ...XLPS2 LDX   0  XLDAT(1) 
3C9S ...      STO   0  ACOMMUNE2(2) 
3C?H ...      BRN      OUTP1
3CC6    #   
3CWQ    #                           K2 ENTRY FROM ORIGIN MACRO  
3DBB    #                         ------------------------------
3DW2    #     ON ENTRY ACOMMUNE7,8,9 CONTAIN COPIES (OR PSEUDO COPIES) OF THE   
3F*L    #     JSOURCE WDS FROM THE RELEVANT CPA; ACOMMUNE2,3 ARE SPACE-FILLED.  
3FT=    #   
3G#W    #     THIS ROUTINE FORMS IN ACOMMUNE2,3 THE FOLLOWING INFORMATION :-
3GSG    #   
3H#6    #       MOP JOBS (DESCRIPTION OF MOP TERMINAL):-
3HRQ    #      ----------   
3J?B    #                ON MULTIPLEXOR : UYY.LXX      [YY = GEOGRAPHIC NO. 
3JR2    #                ON UNIPLEXOR   : UYY          [XX = LINE NO.   
3K=L    #                ON IPB         : IZZZZ        [ZZZZ = IPB IDENTIFIER   
3KQ=    #   
3L9W    #       REMOTE BACK-GROUND JOBS (DESCRIPTION OF CLUSTER CONSOLE):-  
3LPG    #      -------------------------
3M96    #                7020 ON MULTIPLEXOR
3MNQ    #                   OR UNIPLEXOR   : AA      [AA=PCT TERMINAL IDENT.
3N8B    #              7020 ON IPB         : IZZZZ  
3NN2    #   
3P7L    #   
3PM=    X2OUTPER
3Q6W          LDX   0  ACOMMUNE8(2)        [JSOURCE2
3Q*6 ...      BNZ   0  MOP                 [J IF MOP JOB
3QHB ...      LDCH  3  ACOMMUNE7(2)        [DEVICE TYPE 
3QPL ...      SBN   3  10                  [J IF NOT MOP JOB
3QXW ...      BNZ   3  NOTMOP              [ON UNIPLEXOR
3R66    MOP   LDEX  4  ACOMMUNE7(2)        [GEOG NO 
3RKQ          ANDN  0  #7777               [LINE NO.OR IPB IDENT
3S5B          STO   0  ACOMMUNE8(2)        [SAVE IT 
3SK2          LDCH  5  ACOMMUNE7(2)        [DEVICE TYPE 
3T4L          SBN   5  11                  [SUBTRACT MX DEVICE TYPE 
3TJ=          STO   5  ACOMMUNE7(2)        [ZERO = LINE NUMBER REQD 
3W3W          SBN   5  13   
3WHG          LDN   7  3                   [PREPARE TO CONVERT GEOG NO. 
3X36          BNZ   5  MOP1A               [BR IF NOT IPB   
3XGQ          LDX   4  ACOMMUNE8(2)        [PREPARE TO CONVERT IDENTIFIER   
3Y2B    MOP1
3YG2          LDN   7  4
3Y^L    MOP1A   
3^F=          NGX   6  ACOMMUNE7(2) 
3^YW          LDN   0  #65                 [U   
42DG          BPZ   6  MOP2                [BR IF NOT 7900  
42Y6          LDN   0  #51                 [I   
43CQ    MOP2  DCH   0  ACOMMUNE2(2) 
43XB         BCHX  2  £ 
44C2         CALL  3  ZCONV 
44WL          LDX   6  7
45B=          SBN   6  1
45TW          BZE   6  XUP                 [J. IF NO SIG CHARS CONVERTED.   
46*G          SRC   7  2
46T6          LDX   6  ACOMMUNE7(2) 
47#Q          BNZ   6  XUP                 [J IF LINE NO.NOT REQD   
47SB          LDX   4  ACOMMUNE8(2)        [LINE NO.OF MX   
48#2          ADX   2  7
48RL          LDN   0  #36                 [.   
49?=          DCH   0  ACOMMUNE2(2) 
49QW          BCHX  2  £
4==G          LDN   0  #54                 [L   
4=Q6          DCH   0  ACOMMUNE2(2) 
4?9Q          BCHX  2  £
4?PB          LDN   7  2
4#92          CALL  3  ZCONV
4#NL          BRN      XUP  
4*8=    #   
4*MW    NOTMOP  
4B7G          LDX   6  ACOMMUNE9(2)        [JSOURCE3
4BM6          ANDX  6  BITS22LS            [X6=REQD CONS PROP NO.   
4C6Q          HUNTMISB 3,APERI,CONSOLE     [FIND HUIDGE BLOCK   
4CLB          BNG   3  XUP                 [J IF ABSENT 
4D62    SRCH  LDX   4  A1+1(3)             [NOW SEARCH BLOCK FOR REQD PROPERTY  
4DKL          BZE   4  XUP                 [J IF NOT FOUND  
4F5=          ANDX  4  BITS22LS            [EXTRACT PROP NO 
4FJW          TXU   4  6
4G4G          BCC      XFND                [J IF MATCH FOUND
4G##P...#SKI  JSKI04<1$1
4GJ6          BDX   3  SRCH                [ELSE CONTINUE SEARCH
4GLPP...#SKI  JSKI04
4GP#P...(   
4GRXP...      ADN   3  HUIDGENTLEN         [MOVE TO NEXT ENTRY  
4GWGP...      BRN      SRCH                [CONTINUE SEARCH 
4G^5P...)   
4H3Q    XFND  LDX   0  A1+1(3)  
4HHB          BPZ   0  XPCT                [J IF NOT IPB
4J32          LDN   5  13   
4JGL          STO   5  ACOMMUNE7(2)        [MARK NO LINE NO REQD.   
4K2=          LDX   4  A1+2(3)  
4KFW          ANDN  4  #7777               [IPB IDENT   
4K^G          BRN      MOP1                [J TO DO CONVERSION  
4LF6    XPCT  LDN   4  ACOMMUNE2(2) 
4LYQ          LDN   3  A1+2(3)  
4MDB          MVCH  3  2                   [MOVE 'AA' INTO ACOMM WDS
4MY2          BRN      XUP                 [RETURN -END OF JOB. 
4NCL    #   
4NX=    #   
4PBW    #PAGE   
4PWG          MENDAREA 20,K100OUTPER
4QB6    #END
^^^^ ...50175205000100000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1