PCTLISTA867

(George Source)

Macros used: ACROSS, DATECON, FILEMOVE, FLENME1, FLIP, FREECORE, GEOERR, JBC, LF, LFEND, MHUNTW, NEW, NOBITS, ON, OUTPERA, PHOTO, RENGAGE, SEG, SEGENTRY, SETNCORE, SETUPCORE, SLEEP, SPLPROPS, TESTMOVE, TIMECON, VFREEW, WAKEUP

PCTLISTA867.txt
22FL          SEG      PCTLISTA,,GEORGE CONSTANTINIDES. 
22PD ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD, 1982   
22^=    #LIS  K0PCTLISTA>K0PCT>K0ALLGEO 
23YG    # ENTRY POINTS  
24D6          SEGENTRY K1PCTLISTA,Z1PCTLISTA
24S= ...      SEGENTRY K2PCTLISTA,Z2PCTLISTA
258B ...      SEGENTRY K3PCTLISTA,Z3PCTLISTA
25PQ ...      SEGENTRY K4PCTLISTA,Z4PCTLISTA
25X2    [   
26BL    [THIS SEGMENT OUTPUTS HEADINGS TO A REMOTE LP OR TP WHERE THE 7020 IS   
26W=    [ATTACHED VIA A MULTIPLEXOR/UNIPLEXOR/SCANNER -I.E. NOT A 7900. 
27*W    [IT IS EQUIVALENT TO LISTHEAD/LISTINIT OR IPBLISTA. 
27TG    [IT IS ENTERED  AT K1 FROM'LISTFIND' AFTER THE FILE TO BE LISTED HAS
28*6    [BEEN OPENED, AND THE SETUP FILE IF THERE IS ONE.   
29S2    [CURRENT ACTIVITY IS AN ACTLF.  
2=?L    [   
2=R=    [ON ENTRY K1
2?=W    [AN ADATA/CREADL WITH '#LISTING OF USERNAME.FILENAME '  
2?QG    [A FILE/ENT BLOCK OF THE FILE TO BE LISTED. 
2#=6 ...[A GOUT/INFO BLOCK  
2*P2    [   
2B8L    [DURING 
2BN=    [AWORK1 HAS B0 SET IF OUTPUT IS TO TP.  
2BNC ...[   
2BNP ...#DEF  QUAL=IWORK5   
2BNW ...[   
2BQN ...TWEMS          #76007631,#60763576,#04762300
2BS# ...VLIP  FLIP  
2BT6 ...      LDX   1  FX1  
2BTY ...      LDX   2  FX2  
2BWQ ...      EXIT  7  0
2C7W    [   
2CB6 ...ZZCL49         #75713777
2CMG    YLIST          #76663232
2D76    STAR           #32323232           [KEEP YLIST,STAR,ZLIST IN THIS ORDER 
2DBY ...ZLIST          #32327666
2DWJ ...               #76667634
2F6B    NLIST          #76347666,#76327632,#76357634
2FL2    TAPE           #76327620,#76207620  
2G5L ...THEAD          28H    PRODUCED ON         AT
2GK=    SHEAD          24H#OUTPUT BY LISTFILE IN '  
2H4W    ONAT           8H' ON AT
2H#N ...ZUSING         8H USING 
2HJG    SDOC           12HDOCUMENT  
2J46    TPUNCH         #40100000
2JHQ    SPACE          #20  
2K3B    STX            #76222020
2K?8 ...XETX           #23000000
2KH2    QDC3           #76037623
2L2L    #   
2LG=    [TABLE OF LEGIBLE CHARACTERS FOR VISIBLE HEADINGS ON THE TP 
2L^W    [   
2MFG    TABLE          #07566161,#56404040     [0   
2M^6                   #05766740,#40404040     [1   
2NDQ                   #07536165,#51404040     [2   
2NYB                   #07526165,#56404040     [3   
2PD2                   #10465262,#47424040     [4   
2PXL                   #07727161,#66404040     [5   
2QC=                   #07566565,#42404040     [6   
2QWW                   #07606164,#70404040     [7   
2RBG                   #07526565,#52404040     [8   
2RW6                   #07516565,#56404040     [9   
2S*Q                   #04454040,#40404040     [:   
2STB                   #05414640,#40404040     [;   
2T*2                   #06445261,#40404040     [<   
2TSL                   #07464646,#46404040     [=   
2W#=                   #06615244,#40404040     [>   
2WRW                   #07506364,#50404040     [?   
2X?G                   #10404040,#40404040     [SPACE   
2XR6                   #05766540,#40404040     [!   
2Y=Q                   #05707040,#40404040     ["   
2YQB                   #12527667,#52766752     [#   
2^=2                   #07455765,#61404040     [£   
2^PL                   #11416244,#40516040     [%   
329=                   #07536562,#45404040     [&   
32NW                   #04704040,#40404040     ['   
338G                   #05566140,#40404040     [(   
33N6                   #05615640,#40404040     [)   
347Q                   #06474747,#40404040     [*   
34MB                   #10444457,#44444040     [+   
3572                   #05414240,#40404040     [,   
35LL                   #07444444,#44404040     [-   
366=                   #04414040,#40404040     [.   
36KW                   #11414244,#40506040     [/   
375G                   #11506265,#67615640     [@   
37K6                   #10576464,#64574040     [A   
384Q                   #12766765,#65655442     [B   
38JB                   #10566161,#61614040     [C   
3942                   #11766761,#61615640     [D   
39HL                   #10766765,#65614040     [E   
3=3=                   #10766764,#64604040     [F   
3=GW                   #11566161,#63634240     [G   
3?2G                   #12766744,#44447667     [H   
3?G6                   #07617667,#61404040     [I   
3?^Q                   #12426161,#76666060     [J   
3#FB                   #10766744,#52614040     [K   
3#^2                   #10766741,#41414040     [L   
3*DL                   #12766750,#44507667     [M   
3*Y=                   #12766750,#44427667     [N   
3BCW                   #10566565,#65564040     [O   
3BXG                   #10766764,#64504040     [P   
3CC6                   #11566161,#65564140     [Q   
3CWQ                   #11766764,#64524140     [R   
3DBB                   #10425165,#65424040     [S   
3DW2                   #11606076,#67606040     [T   
3F*L                   #12766641,#41417666     [U   
3FT=                   #10704441,#44704040     [V   
3G#W                   #12766742,#44427667     [W   
3GSG                   #11615244,#44526140     [X   
3H#6                   #10605047,#50604040     [Y   
3HRQ                   #11416365,#61716140     [Z   
3J?B                   #07766761,#61404040     [[   
3JR2                   #11425176,#67654240     [$   
3K=L                   #07616176,#67404040     []   
3KQ=                   #07507667,#50404040     [^   
3L9W                   #10424742,#42424040     [_   
3LPG    VFROM          12H FROM JOB 
3M96    VNULL          #40404040
3MNQ    #   
3N8B    [     END OF LINE IN HEADINGS : NL + RUNOUT FOR TAPE, NL * 2 FOR PRINTER
3NN2    [   
3P7L    ZLINE SMO      FX2                 [GET OUTPUT PERIPHERAL SWITCH.   
3PM=          LDX   6  AWORK1   
3Q6W          LDN   2  4                   [SET UP FOR PRINTER : #76327632. 
3QLG          LDN   4  NLIST+1(1)   
3R66          BZE   6  ZMOVE               [ZERO IF LP. 
3RKQ          LDN   2  8                   [SET U7 FOR PUNCH : #7632762076207620
3S5B          LDN   4  TAPE(1)  
3SK2    ZMOVE MVCH  4  0(2)                [INSERT LINE TERMINATOR. 
3SSS ...      EXIT  7  0
3T4L    [   
3TJ=    [     APPEND ETB TO THE OUTPUT BUFFER AND UPDATE THE BUFFER POINTER.
3W3W    #   
3W4L ...SEND
3W^W ...      LDX   4  GSIGN               [APPEND ETB TO THE OUTPUT
3X36          LDN   0  #7607
3XGQ          MVCH  4  2
3Y2B          WAKEUP   LF                  [FPUT THE AMOP IF NECCESSARY.
3YG2          LDX   4  INTLK3(3)           [OLD BUFFER NUMBER   
3Y^L          SBN   4  ALFBUFFNUM-1 
3^F=          BZE   4  TWAS 
3^YW          ADN   4  ALFBUFFNUM   
42DG    TWAS  STO   4  INTLK3(3)           [NEW BUFFER NUMBER   
42Y6          LDX   0  GSIGN
43CQ          SMO   4   
43XB          ORS   0  INTLK(3)            [INDICATE BUFFER USED
44C2          SMO      4                   [SET EOM MARKER (MUST BE UNSET AGAIN 
44WL          STO   0  INTLK2(3)           [BY THE CALLING ROUTINE IF NOT WANTED
45B=          EXIT  7  0
45TW    #   
46*G    # DO SLEEP MACRO, TAKE CANT-DO ACTION IF ANY ERROR. 
46T6    #   
47#Q    SLEEP SBX   5  FX1  
47SB          SLEEP    LF,XCD,XCD   
48#2          MHUNTW   3,A7020,ALIST       [RE-LOCATE BUFFER BLOCK. 
48RL          LDCT  0  #103                [J. OUT IF ERROR, MOP OFF OR INOP. LI
49?=          ANDX  0  EWAIT(3) 
49QW          BNZ   0  XCD  
4==G          ADX   5  1
4=Q6          EXIT  5  0
4?9Q    #     IF INOP., MOP OFF, "TE" OR "CD" DURING OUTPUT OF HEADINGS.
4?PB    XCD   LDX   2  FX2  
4?SG ...      MHUNTW   3,A7020,ALIST
4?XL ...      LDCT  0  #100 
4#2Q ...      ANDX  0  EWAIT(3) 
4#5W ...      ERS   0  EWAIT(3) 
4*8=          VFREEW   ADATA,CREADL        [FREE THE VARIOUS DATA BLOCKS.   
4*MW          VFREEW   FILE,ENT 
4BM6          NGS   1  IWORK1(2)           [SET AS -VE TO SHOW NOT STARTED LISTI
4C6Q          LFEND    CD                  [CANTDF EXIT 
4CLB    #   
4D62    #     GET ADDRESS OF NEXT BUFFER ; WAIT IF IT IS STILL BEING USED   
4DKL    #   
4F5=    NEW   MHUNTW   3,A7020,ALIST
4FJW          LDCT  0  #103                [J. OUT IF ERROR, MOP OFF OR INOP. LI
4G4G          ANDX  0  EWAIT(3) 
4GJ6          BNZ   0  XCD  
4H3Q          LDX   4  INTLK3(3)           [OLD BUFFER NUMBER   
4HHB          SBN   4  ALFBUFFNUM-1 
4J32          BZE   4  TWOAL
4JGL          ADN   4  ALFBUFFNUM   
4K2=    SEG   SMO   4   
4KFW    TWOAL LDX   5  INTLK(3) 
4K^G          BPZ   5  XFREE               [NEXT BUFFER NOT BEING USED  
4LF6          SBX   7  1
4LYQ          CALL  5  SLEEP               [WAIT FOR THE NEXT BUFFER.   
4MDB          ADX   7  1
4MY2          BRN      SEG  
4NCL    XFREE ANDX  5  BITS22LS 
4NX=          ADN   5  ACTBUFF(3)          [ADDRESS FOR DEPOSITING IN X5
4PBW          LDN   4  STX(1)   
4PWG          MVCH  4  2                   [#7622 = STX 
4QB6          EXIT  7  0
4QTQ    #   
4R*B    # SET OUTPUT FINISHED MARKER AND WAIT FOR TRANSMISSION ENDED REPLY. 
4RT2    #   
4S33 ...WFIN1 LDXC  7  7
4S3W ...      BRN      WFMHW
4S4R ...SPLWF ORX   7  GSIGN
4S7B ...      ADN   7  1
4S8M ...WFMHW MHUNTW   3,A7020,ALIST
4SS=          LDCT  0  #103                [J. OUT IF ERROR, MOP OFF OR INOP. LI
4T?W          ANDX  0  EWAIT(3) 
4TRG          BNZ   0  XCD  
4W?6          LDCT  6  #20                 [SET OUTPUT COMPLETE MARKER. 
4WDY ...      LDXC  7  7
4WGW ...      BCC      NSPN2
4WJS ...      ORN   6  8
4WLQ ...NSPN2   
4WQQ          SBX   7  FX1  
4X=B    WFIN2 ORS   6  EWAIT(3) 
4XQ2          CALL  5  SLEEP               [WAIT
4Y9L          LDCT  0  #10                 [HAS THE TRANSMISSION FINISHED YET.  
4YP=          ANDX  0  EWAIT(3) 
4^8W          BZE   0  WFIN2
4^NG          ADX   7  1
5286          ERS   0  EWAIT(3)            [CLEAR THE "FINISHED" MARKER.
52BR ...      LDN   0  8
52F2 ...      ANDX  0  EWAIT(3) 
52H9 ...      ERS   0  EWAIT(3) 
52MQ          EXIT  7  0
537B    #   
53M2    #     STORE USER NAME AND JOB NAME , OMITTING NON-SIGNIFICANT SPACES
546L    #   
54L= ...UFLEN MHUNTW   1,GOUT,INFO  
555W          FLENME1  GUSER,1,3           [X2,X4,X5 NOT CHANGED
55KG          EXIT  4  0
5656    #   
56JQ    #     CONVERT TAPE HEADINGS INTO VISIBLE FORM ; CHAR COUNT IN X6 ; CHARS
574B    #     TO BE CONVERTED START AT IWORK1 OF ACTIVITY ; CALL ON X7  
57J2    #     ON ENTRY X5 CONTAINS ROOM LEFT IN TRANSFER COUNT  
583L    #   
58H=    VISIB SBX   7  FX1  
592W          LDX   2  FX2  
59GG          STO   7  IWORK15(2)          [PRESERVE LINK.  
5=26          SMO      FX1  
5=FQ          LDX   0  VNULL               [#40404040   
5=^B          STO   0  IWORK14(2)   
5?F2          ADN   2  IWORK1   
5?YL    VLOOP LDCH  3  0(2)                [CHAR TO BE CONVERTED
5#D=          ADN   3  TABLE(3) 
5#XW          ADX   3  FX1  
5*CG          LDX   1  FX2  
5*X6          LDN   4  IWORK12(1)   
5BBQ          MOVE  3  2                   [STORE REPRESENTATION FOR LATER MVCH 
5BWB          LDX   3  4
5CB2          LDX   4  IWORK11(1)          [DCH POINTER.
5CTL          LDCH  1  0(3)                [NO. OF CHARS IN VISIBLE FORM
5D*=          BCHX  3  £
5DSW          TXL   5  1
5F#G          BCC      VROOM               [ENOUGH ROOM IN THIS BLOCK   
5FS6          BZE   5  VFULL               [NOT EVEN ROOM FOR 1 CHAR
5G?Q          SMO   5   
5GRB          MVCH  3  0                   [FILL UP BLOCK   
5H?2    VFULL SBX   2  FX2  
5HQL          SMO      FX2  
5J==          STO   2  IWORK18             [PRESERVE CHAR  POINTER  
5JPW          LDX   2  FX2  
5K9G          SBX   3  2
5KP6          STO   3  IWORK17(2)          [PRESERVE START ADDR:SS FOR NEXT MVCH
5L8Q          SBX   1  5
5LNB          STO   1  IWORK16(2)          [PRESERVE COUNT FOR NEXT MVCH.   
5M82          MHUNTW   3,A7020,ALIST       [RESET THE BLOCK POINTER AND 
5MML          LDX   5  4
5N7=          CALL  7  SEND                [APPEND ETB  
5NLW          SMO      4                   [UNSET THE EOM MARKER.   
5P6G          STOZ     INTLK2(3)
5PL6          LDX   1  FX1  
5Q5Q          CALL  7  NEW                 [GET NEXT BUFFER 
5QKB          LDX   4  5                   [START ADDRESS FOR DEPOSITING
5R52          LDN   5  76                  [CHAR COUNT  
5RJL          LDX   2  FX2  
5S4=          LDX   1  IWORK16(2)          [COUNT FOR NEXT MVCH 
5SHW          LDX   3  IWORK17(2)   
5T3G          ADX   3  2
5TH6          ADX   2  IWORK18(2)          [POINTER TO CHAR. BEING CONVERTED.   
5W2Q    VROOM MVCH  3  0(1) 
5WGB          SBX   5  1
5X22          SMO      FX2  
5XFL          STO   4  IWORK11  
5X^=          BCHX  2  £
5YDW          BCT   6  VLOOP
5YYG          LDX   2  FX2                 [END OF CONVERSION   
5^D6          LDX   7  IWORK15(2)   
5^XQ          ADX   7  FX1  
62CB          EXIT  7  0
62X2    PDC3  BNZ   6  XY1TP              [J IF TP  
63BL          LDX   7  EWAIT(3) 
63W=          ANDN  7  1
64*W          BZE   7  XY1TP                [J IF NOT 1901A 
64TG          SMO      4
65*6          STOZ     INTLK2(3)
65SQ    XY1TP EXIT  0  0
66#B    #   
66S2    #   
67?L    #   
67R=    #   
68=W    #     ENTRY POINT FROM LISTFIND TO OUTPUT HEADINGS AND PREPARE FOR  
68QG    #     OUTPUT TO A BULK DEVICE ON A 7020 VIA A MULTIPLEXOR OR UNIPLEXOR  
69=6    #   
69PQ    Z1PCTLISTA  
69Q= ...      MHUNTW   3,GOUT,INFO  
69QQ ...      LDX   0  GMODE(3) 
69R= ...      STO   0  AWORK2(2)            [STORE GMODE - CENTRAL LF USED  
69RQ ...                                   [TO DO IT FOR US BUT DONT ANY MORE   
69S* ...      LDCT  0  #200 
69WY ...      STO   0  IWORK2(2)
69^J ...      STOZ     AWORK3(2)
6=9B          STOZ     IWORK10(2)          [MARK ENTRY AT K1.   
6=P2          LDX   0  AWORK2(2)
6?8L          SLL   0  2
6?N=          ANDX  0  GSIGN
6#7W          STO   0  AWORK4(2)
6#M4 ...START MHUNTW   3,A7020,ALIST
6#M5 ...      SMO      FX1  
6#M7 ...      LDX   0  ZZCL49   
6#M= ...      ANDS  0  EWAIT(3) 
6#MB ...      LDX   0  BITS22LS 
6#MN ...      ANDS  0  INTLK(3) 
6#N2 ...      ANDS  0  INTLK+1(3)   
6#N# ...      ANDS  0  INTLK+2(3)   
6#NB ...      LDN   0  #2000
6#ND ...      ORS   0  EWAIT(3)            [TELL  PCTLPTP BLOCK IS BEING RESET  
6#NG ...      STOZ     INTLK1(3)           [RESET LAST OUTPUT NUMBER
6#NJ ...      STOZ     INTLK3(3)           [AND LAST FILLED BUFFER NUMBER   
6#NQ ...      LDX   6  APCTID(3)           [GET INTEFACE DATA   
6#QD ...      LDN   1  FPTPCT(3)
6#S6 ...SCINF LDX   1  FPCT(1)  
6#TS ...      LDXC  0  APCTID-FPTPCT(1) 
6#XG ...      BCC      SCINF               [A7020-INFORM HAS BO SET 
6#^8 ...      LDEX  5  6
6*2W ...      ADX   1  5                   [FIND CORRECT INTERFACE  
6*4J ...      ANDX  6  HALFTOP  
6*56 ...      NGN   0  7
6*5N ...      ANDS  0  EWAIT(3) 
6*6= ...      LDX   0  6
6*7Y ...      ANDX  0  APCTSTAT-FPTPCT(1)   
6*9L ...      BZE   0  NSPL 
6*=8 ...      LDX   0  GSIGN
6*=Q ...      STO   0  AWORK3(2)
6*?# ...      LDN   0  4
6**2 ...      SRC   6  6
6*BN ...      ANDX  6  APCTSTAT-FPTPCT(1)   
6*DB ...      BZE   6  STBTS
6*G4 ...      ADN   0  2
6*HQ ...STBTS ORS   0  EWAIT(3) 
6*KD ...NSPL
6*M6 ...      LDCH  6  JSOURCE1(2)  
6*NS ...      LDX   5  EWAIT(3) 
6*QG ...      CALL  7  VLIP                [FLIP BIT FOR POLL ACTY  
6*S3 ...      LDN   7  4
6*TJ ...      ANDX  7  5
6*X5 ...      BZE   7  NSLPR
6*YL ...      SPLPROPS  (GEOERR)
6B27 ...NSLPR   
6B3R ...      SRC   5  3
6B*4 ...      ANDX  5  GSIGN               [-VE IF B21 IN EWAIT SET 
6BHS ...STARA LDX   1  FX1  
6BL2          LDX   2  FX2  
6C5L          ANDN  6  1                   [#400:0 IF TP, 0 IF LP.  
6CK=          SRC   6  1
6D4W          STO   6  AWORK1(2)           [REMEMBER PERIPHERAL TYPE INDICATOR  
6DJG          ADNC  6  4                   [TAPE REQUIRES 4 BUFFERS OF RUNOUT.  
6F46          BCS      TRUN 
6FHQ    #   
6G3B ...      LDN   6  0                   [0 = START OF LISTING
6HMW ...      ORX   6  5
6HQN ...      CALL  7  NEW                 [GET BUFFER ADDRESS IN X5
6J36 ...      BPZ   6  NSPLE               [ IF NOT SPOOLING
6J5Y ...      LDN   4  TWEMS(1) 
6J8Q ...      MVCH  4  7
6J?J ...NSPLE   
6J^6          LDN   4  NLIST(1) 
6KDQ ...      MVCH  4  4                   [FF + ^  
6KYB ...      LDN   4  STAR(1)  
6LD2 ...      MVCH  4  6                   [******  
6LXL ...      LDX   4  5
6MC= ...      SBN   4  1
6N4N ...      BPZ   6  NSPLA               [J IF NOT SPOOLING   
6N6L ...      NGN   7  7
6N8J ...      SMO      7
6N=G ...NSPLA   
6NBG          SEGENTRY K50PCTLISTA  
6NW6 ...      MVCH  4  A7021WIDTH-66       [ASSUMES 79<A7021WIDTH<133   
6P*Q          CALL  7  SEND                [APPEND ETB. 
6PTB          SMO      4                   [CLEAR THE EOM MARKER.   
6Q*2          STOZ     INTLK2(3)
6QSL          CALL  7  NEW                 [GET NEXT BUFFER 
6R#=          LDN   4  STAR(1)  
6RRW          MVCH  4  6                   [******  
6S?G          LDX   4  5
6SR6          SBN   4  1
6T=N ...      BPZ   6  NSPLB               [J IF NOT SPOOLING   
6TCW ...      MVCH  4  7
6TP* ...NSPLB MVCH  4  50                  [MOVE 50 STARS   
6Y55 ...      LDN   4  ZLIST(1)            [**^ 
6YBJ ...      MVCH  4  4
6YN6          CALL  7  SEND                [ADD CR & ETB AND OUTPUT.
6^7Q          LDX   5  EWAIT(3) 
6^MB          ANDN  5  1
75JB          BZE   5  YN01A             [J IF NOT 1901A
7642          SMO      4
76HL          STOZ     INTLK2(3)
773=    YN01A CALL  7  NEW  
77GW          LDN   4  NLIST+1(1)          [2 NEWLINES  
782G          MVCH  4  4
78G6          BRN      WHEAD
78^Q    #   
79FB    #     SEPARATE TAPE ROUTINE : OUTPUT TWO FEET OF RUNOUT BEFORE HEADINGS 
79^2    #   
7=DL    TAG   SMO      4                   [CLEAR THE EOM MARKER.   
7=Y=          STOZ     INTLK2(3)
7?#= ...      BRN      TRUNA
7?D= ...TRUN  ORX   6  5
7?J= ...TRUNA CALL  7  NEW  
7##= ...      LDXC  6  6
7#D= ...      BCC      NSPLJ
7#J= ...      LDN   4  TWEMS(1) 
7#N= ...      MVCH  4  7
7#S= ...NSPLJ   
7*4= ...      LDN   4  TAPE(1)  
7*8= ...      ORX   4  GSIGN
7*FT ...      MVCH  4  6
7*HD ...      LDX   4  5
7*K3 ...      SBN   4  1
7*LL ...      MVCH  4  108  
7B4= ...NENYE   
7C#W          CALL  7  SEND 
7CSG          BCT   6  TAG  
7D#6          LDX   5  EWAIT(3) 
7DRQ          ANDN  5  1
7GQ=          BZE   5  XN1901A             [J IF NOT 1901A  
7H9W          SMO      4
7HPG          STOZ     INTLK2(3)              [DONT SEND DC3
7J96    XN1901A 
7JNQ    #   
7K8B    #     OUTPUT VISIBLE TAPE HEADINGS WITH FILENAME AND USERNAME   
7KN2    #   
7L7L          MHUNTW   3,ADATA,CREADL   
7LM=          LDEX  6  A1+FRH(3)           [NO OF CHARS. IN "#LISTING....." 
7M6W          ADN   3  CPDATA+3            [ADDRESS OF FILENAME.
7MLG          LDX   2  FX2  
7N66          SBN   6  12   
7NKQ          LDN   4  IWORK1(2)
7P5B          SMO   6   
7PK2          MVCH  3  0                   [SAVE FILENAME FOR CONVERSION.   
7Q4L          CALL  7  NEW  
7QJ=          STO   5  IWORK11(2)          [SET INITIAL OUTPUT POINTER. 
7R3W          LDN   5  76                  [CHAR. COUNT 
7RHG          CALL  7  VISIB               [CONVERT FILENAME
7S36          LDX   1  FX1  
7SGQ          ADN   1  VFROM
7T2B          ADN   2  IWORK1   
7TG2          MOVE  1  3
7T^L          LDN   6  10   
7WF=          CALL  7  VISIB               [CONVERT ' FROM JOB '
7WYW          LDN   7  IWORK1(2)
7XDG          CALL  4  UFLEN               [FLENME USER NAME & JOB NAME 
7XY6          SBN   7  IWORK1(2)
7YCQ          SLC   7  2                   [NO. OF CHARS IN :USERNAME.JOBNAME   
7YXB          LDX   6  7
7^C2          CALL  7  VISIB               [CONVERT USER NAME AND JOB NAME  
7^LS ...      STOZ     IWORK5(2)
7^WL    #   
82B=          LDX   1  FX1  
83*G          MHUNTW   3,A7020,ALIST
83T6          LDX   5  4                   [DCH POINTER IN IOUT 
84#Q          CALL  7  SEND 
84SB          CALL  7  NEW  
85#2          LDN   4  TAPE(1)             [#762076207620   
85RL          NGN   6  1                   [SET MARKER TO SHOW TP.  
86?=          ORX   4  GSIGN
86QW          MVCH  4  6
87=G          LDX   4  5
87Q6          SBN   4  1
889Q          MOVE  4  10                  [RUNOUT  
88PB          ADN   5  9                   [SET POINTER TO END. 
8992          CALL  7  SEND 
89NL          CALL  7  NEW  
8=8=    #   
8=MW    #     IDENTIFY LISTING TO OUTPUT DEVICE WITH FILENAME , DATE AND TIME   
8?7G    #   
8?M6    WHEAD MHUNTW   3,ADATA,CREADL      [BLOCK CONTAINING #LISTING ETC.  
8#6Q          LDN   4  CPDATA(3)           [START ADDRESS OF DATA   
8#LB          SMO      A1+FRH(3)           [MOVE THE CONTENTS OF THE BLOCK  
8*62          MVCH  4  0                   [INTO THE BUFFER.
8*FP ...      FREECORE 3                   [ADATA/CREADL BLOCK  
8C9C ...      MHUNTW   3,A7020,ALIST
8C=6 ...      LDN   4  THEAD(1)            ["    PRODUCED ON "  
8C?H ...      MVCH  4  16   
8C#Y ...      CALL  7  SEND                [ADD ETB AND OUTPUT  
8CB* ...      SMO      4
8CCQ ...      STOZ     INTLK2(3)           [MARK "NOT CLEAN FINISH" 
8CF7 ...      CALL  7  NEW                 [GET NEW BUFFER  
8CJ6          MHUNTW   3,FILE,ENT   
8D3Q          LDX   4  EWRITDAY(3)         [DATE AND TIME THIS FILE WAS 
8DHB          LDX   7  EWRITTIME(3)        [LAST WRITTEN TO 
8F32          BZE   6  PRFIL               [X6 = 0 IF ENTERED FROM PRINTER CODE 
8FGL          STOZ     IWORK16(2)          [CLEAR THE MODE INDICATOR WORD.  
8G2=          STOZ     IWORK17(2)   
8GFW    PRFIL MHUNTW   2,A7020,ALIST
8G^G          SBN   5  3(2)                [RELATIVE POINTER TO 1ST. CH. OF DATE
8HF6          FREECORE 3                   [FILE/ENT BLOCK. 
8HYQ          TIMECON  7
8JDB          LDX   6  ACOMMUNE1(2)        [SAVE THE CONVERTED TIME IN SAFE WORD
8JY2          LDX   7  ACOMMUNE2(2) 
8KCL          DATECON  4
8KX=          MHUNTW   3,A7020,ALIST
8LBW          ADX   5  3                   [POINTER TO 1ST. CHAR. OF DATE AREA. 
8MGJ ...      STO   6  ACOMMUNE3(2)        [SAVE CONVERTED TIME 
8MJR ...      STO   7  ACOMMUNE4(2) 
8MRD ...      ADN   5  3
8MTM ...      LDN   4  ACOMMUNE1(2) 
8MXW ...      MVCH  4  7                   [PUT DATE IN BUFFER  
8N4# ...      LDX   6  AWORK1(2)
8N6H ...      BNZ   6  XNTP                [J IF TP 
8N8Q ...      SEGENTRY K54PCTLISTA  
8N=9 ...      LDN   6  A7021WIDTH   
8N?N ...      SBN   6  90   
8N*8 ...      BNG   6  XENDL               [J IF NOT ENOUGH ROOM FOR TIME   
8NCC ...XNTP
8P#= ...      LDN   4  ONAT+1(1)
8PBF ...      MVCH  4  5                   [INSERT " AT  "  
8PDN ...      LDN   4  ACOMMUNE3(2) 
8PGX ...      MVCH  4  8                   [INSERT TIME 
8PM* ...XENDL CALL  7  ZLINE               [INSERT NEWLINE ETC  
8PPJ ...      CALL  7  SEND                [ADD ETB 
8PS=          CALL  0  PDC3 
8Q?W    #   
8QRG          CALL  7  NEW                 [GET NEW BUFFER  
8R?6          LDN   4  SHEAD(1) 
8RQQ          MVCH  4  24                  ["#OUTPUT BY LISTFILE IN '"  
8S=B          LDX   7  5
8SQ2          LDX   5  3                   [ADDRESS OF A7020/ALIST  
8T9L          CALL  4  UFLEN               [STORE USER NAME & JOB NAME  
8TP=          SBX   7  5                   [IN CASE ALIST MOVES 
8W8W          DATECON  EDATE
8WNG          LDX   5  7                   [CURRENT OUTPUT POINTER. 
8X86          LDX   6  ACOMMUNE1(2)        [SAVE THE CONVERTED DATE IN SAFE WORD
8XMQ          LDX   7  ACOMMUNE2(2) 
8Y7B          TIMECON  CLEANCT  
8YM2          MHUNTW   3,A7020,ALIST       [RELOCATE AFTER COORDINATION 
8^6L          ADX   5  3
8^L=          LDN   4  ONAT(1)  
925W          MVCH  4  5                   [' ON
92KG          LDN   4  6
9356          MVCH  4  7                   [CURRENT DATE
93JQ          LDN   4  ONAT+1(1)
944B          MVCH  4  4                   [AT  
94J2          LDN   4  ACOMMUNE1(2) 
953L          MVCH  4  8                   [CURRENT TIME
9559 ...      SMO      FX2  
955Q ...      LDX   7  AWORK1   
956? ...      BNZ   7  USNTP                [J IF TP
956Y ...      SEGENTRY K55PCTLISTA  
957B ...      LDN   6  A7021WIDTH   
957S ...      SBN   6  90   
958= ...      BNG   6  USNSM                [J IF NO ROOM FOR UNIT NAME 
958Y ...USNTP   
959F ...      CALL  7  SEND                [SEND BUFFER 
95=2 ...      SMO      4
95=H ...      STOZ     INTLK2(3)           [MARK "NOT CLEAN FINISH" 
95?4 ...      CALL  7  NEW                 [GET NEW BUFFER  
95?K ...      SBX   5  3                   [SAVE PLACE IN ALIST 
95#6 ...      LDX   2  FX2  
95#M ...      LDN   0  JSOURCE1(2)  
95*8 ...      LDN   1  ACOMMUNE1(2)        [SET UP ACOMM WDS FOR OUTPERA
95*P ...      MOVE  0  2
95B= ...      OUTPERA                      [GET LP UNIT DESCRIPT. IN ACOMM WDS  
95BR ...      MHUNTW   3,A7020,ALIST
95C# ...      ADX   5  3                   [RESET X5 AS DCH POINTER 
95CT ...      LDN   4  ZUSING(1)           [MOVE IN " USING "   
95DB ...      MVCH  4  7
95DX ...      LDN   4  ACOMMUNE2(2)        [AND LP DESCRIPTION  
95FD ...      MVCH  4  8
95F^ ...USNSM   
95H=          CALL  7  ZLINE               [INSERT NEWLINE ETC. 
95R4 ...      CALL  7  SEND 
962W          CALL  0  PDC3 
96GG    #   
9726          CALL  7  NEW                 [GET NEW BUFFER  
97FQ          LDN   4  SDOC(1)  
97^B          MVCH  4  12                  ["DOCUMENT    "  
98F2 ...      MHUNTW   2,GOUT,INFO  
98YL          LDN   4  GHEAD(2) 
99D=          LDX   2  GSUSE(2) 
99XW          MVCH  4  0(2)                [COPY ACROSS USER'S HEADER   
9=CG          SMO      FX2  
9=X6          LDXC  0  AWORK4   
9?BQ          BCC      NOFF                [J NO SETUP FILE SO NO FF REQD   
9?WB          ADN   1  1                   [S/R ZLINE WILL PICK UP #7635734 
9#B2    NOFF  CALL   7  ZLINE   
9#TL          BNZ   6  XY2TP                 [J IF TP   
9**=          LDX   0  EWAIT(3) 
9*SW          ANDN  0  1
9B#G          BZE   0  PRIN               [J IF NOT 1901A   
9D?2          LDN   4  QDC3(1)            [PUT DC3ETX   
9DKP ...      MVCH  4  2
9DYD ...      CALL  7  SEND                [ADD ETB & OUTPUT
9F?7 ...      SLC   5  2
9FKW ...      SBN   5  1
9FYK ...      SRC   5  2
9G?# ...      LDN   4  XETX(1)              [CHANGE ETB TO ETX  
9GL3 ...      MVCH  4  1
9GYQ ...      BRN      PRIN1
9H?F ...XY2TP BPZ   6  PRIN 
9HL8 ...      LDN   0  8
9HYX ...ROUT  LDN   4  TAPE+1(1)           [EXTRA RUNOUT FOR TAPE PUNCH 
9J?L ...      MVCH  4  4
9JL* ...      BCT   0  ROUT 
9J^4 ...PRIN  CALL  7  SEND 
9K?R ...PRIN1   
9KLW ...      MHUNTW   3,GOUT,INFO  
9L6G ...      LDXC  0  GFLI(3)  
9LL6 ...      BCS      XFRTOERR            [J IF ERROR MESSAGE TO BE SENT...
9M5Q ...[                                   ...INSTEAD OF LISTING FILE  
9NJL          CALL  7  WFIN1               [WAIT FOR TRANSMISSION TO END.   
9P4=    #   
9PHW    #     STORE INFORMATION ABOUT FILE AND TYPE OF LISTING REQUIRED IN CA2-4
9Q3G    #   
9QH6 ...      MHUNTW   3,GOUT,INFO  
9R2Q          LDX   4  GFLI(3)             [START RECORD NO. = START LINE NO. +1
9RGB          ADN   4  1
9S22          LDX   6  AWORK1(2)           [>0 IF PRINT ; <0 IF TAPE
9SFL          STO   4  IWORK1(2)           [SET THE START RECORD NO.
9S^=          STO   4  IWORK14(2)          [RESTART RECORD NUMBER.  
9TDW          LDX   0  GNLI(3)             [NO. OF LINES TO BE OUTPUT   
9TYG          BNZ   0  NEND 
9WD6          NGN   0  1                   [INDICATE ALL LINES REQUIRED 
9WXQ    NEND  STO   0  IWORK3(2)
9XCB          LDCT  0  3
9XX2          ANDX  0  GMODE(3)            [TYPE OF RESTART REQUIRED
9YBL          SLL   0  7
9YK? ...      LDX   4  0
9YMG ...      ORX   0  AWORK3(2)
9YPP ...      LDXC  4  4
9YW=          STO   0  IWORK2(2)
9Y^S ...      LDXC  4  AWORK3(2)
9^32 ...      BCC      NOSPL
9^48 ...      LDN   4  32   
9^5B ...      LDX   7  IPAGE
9^6J ...      TXL   4  7
9^7Q ...      BCC      YSSPL
9^8Y ...      LDX   4  7
9^=6 ...      BRN      YSSPL
9^?# ...NOSPL   
9^*W          BPZ   0  NOPRE               [NOT PAGE RESTART
9^TG          LDX   4  IPAGE               [CURRENT PAGES PARAMETER 
=27W ...YSSPL   
=2*6          ADN   4  2
=2SQ          PHOTO    7
=3#B          SETUPCORE 4,1,ADATA,IPTEMP   [BLOCK TO HOLD 1ST REC NO PER PAGE   
=3S2          LDX   0  IWORK14(2)          [INITIAL RESTART NO. 
=4?L          STOC  0  A1+1(1)             [CAREFUL : SETS C.   
=4R=          STOZ     A1(1)               [INITIALISE THE PAGE COUNT.  
=5=W          TESTMOVE 7,NOPRE  
=5QG ...      MHUNTW   3,GOUT,INFO  
=6=6    NOPRE LDN   4  0
=6PQ          LDX   0  GFTY(3)             [J. IF AMORPHOUS FILE.   
=79B          ANDN  0  1
=7P2          BZE   0  XBASICMAIN   
=88L          BNG   6  PUNCH1              [J. IF TAPE PUNCH.   
=8N=          LDX   0  GMODE(3)            [J. IF SPECIAL LISTING.  
=97W          ANDN  0  1
=9MG          BNZ   0  NOBITS   
==76          LDX   0  GFTY(3)             [J. IF TAPE PUNCH TYPE FILE  
==LQ          ANDN  0  #10  
=?6B          BNZ   0  TPTYPEMAIN   
=?L2          LDCT  4  #100                [MARK TO SHOW PFCCS VALID IN REC.HDDR
=#5L    TPTYPEMAIN  
=#K=          LDX   0  GFTY(3)             [J. IF GRAPHIC FILE. 
=*4W          ANDN  0  6
=*JG          BZE   0  NOBITS   
=B46          ORX   4  GSIGN               [MARK TO SHOW TRANSFORM REQUIRED.
=BHQ          ANDN  0  2                   [J. IF ALLCHARS FILE.
=C3B          BZE   0  NOBITS   
=CH2          BCHX  4  NOBITS              [SET NORMAL FILE MARK & J.   
=D2L    PUNCH1  
=DG=          LDX   0  GFTY(3)             [SET IWORK17 NON ZERO IF TP TYPE FILE
=D^W          ANDN  0  #10  
=FFG          STO   0  IWORK17(2)   
=F^6          BRN      PUNCH2   
=GDQ    XBASICMAIN  
=GYB          LDN   4  #1001               [MARK AS AMORPHOUS FILE  
=HD2          BNG   6  PUNCH2              [J. IF TAPE PUNCH.   
=HXL    NOBITS  
=JC=          LDX   0  GMFMSK(3)           [CALEGORY MASK IF MONFILE
=JWW          STO   0  IWORK4(2)
=KBG          LDX   0  GMODE(3)            [SEQUENCING, MONFILE AND 
=KW6          ANDN  0  7                   [SPECIAL LISTING BITS
=L*Q    TAFF
=LTB          ORX   4  0
=M*2    PUNCH2  
=MSL          LDN   0  4
=N#=          ANDX  0  4
=NRW          BZE   0  STOR 
=P?G          NGN   0  2                   [ENSURE THE SPECIAL BIT IS NOT   
=PR6          ANDX  4  0                   [SET FOR MONITORING FILES
=Q=Q    STOR
=QQB         STO  4  IWORK5(2)  
=R=2          LDXC  0  AWORK4(2)
=RPL          BCC      NOTSETUP            [J NO SETUX FILE 
=S9=          LDN   0  IWORK1(2)           [SAVE MAIN FILE PARAMETERS   
=SNW          LDN   1  IWORK6(2)
=T8G          MOVE  0  5
=TN6          LDCT  0  #200 
=W2G ...      ORX   0  AWORK3(2)
=W7Q          STO   0  IWORK2(2)           [SET ALL RESTART 
=WMB          NGS   1  IWORK3(2)
=X72          LDN   0  1
=XLL          STO   0  IWORK1(2)
=Y6=          LDX   0  GFTY(3)             [J. IF AMORPHOUS FILE.   
=YKW          ANDN  0  #360 
=^5G          BZE   0  XBASICSETUP  
=^K6          ANDN  0  #200                [J. IF TAPE PUNCH TYPE FILE. 
?24Q          LDN   4  0
?2JB          BNZ   0  TPTYPESETUP  
?342          LDCT  4  #100                [MARK TO SHOW PFCCS VALID IN REC.HDDR
?3HL    TPTYPESETUP 
?43=          LDX   0  GFTY(3)             [J. IF GRAPHIC FILE. 
?4GW          ANDN  0  #140 
?52G          BZE   0  NOBITSSETUP  
?5G6          ORX   4  GSIGN               [MARK TO SHOW TRANSFORM REQUIRED.
?5^Q          ANDN  0  #40                 [J. IF ALLCHARS FILE.
?6FB          BZE   0  NOBITSSETUP  
?6^2          BCHX  4  NOBITSSETUP         [MARK AS NORMAL FILE & J.
?7DL    XBASICSETUP 
?7Y=          LDN   4  #1001               [MARK AS AMORPHOUS CILE  
?8CW    NOBITSSETUP 
?8XG          STO   4  IWORK5(2)
?9C6    NOTSETUP
?9G= ...      LDX   0  AWORK3(2)
?9KB ...      BPZ   0  NZPL 
?9NG ...      SRL   0  1
?9RL ...      ORS   0  IWORK17(2)   
?9RY ...      MHUNTW   1,ADATA,IPTEMP   
?9S= ...      LDX   0  IWORK1(2)
?9SJ ...      STO   0  A1+1(1)  
?9SW ...NZPL
?=3X ...      LDCT  0  #300 
?=5L ...      ANDX  0  AWORK2(2)           [SETUP AND   
?=6F ...      ORN   0  1                   [SET "MAINFILE ALREADY POSITIONED"   
?=7* ...      STO   0  IWORK20(2)   
?=94 ...      LDX   0  GSIGN
?==R ...      ANDX  0  AWORK4(2)
?=#G ...      ORS   0  IWORK20(2)   
?=B9 ...      LDXC  0  AWORK1(2)           [J. IF TAPE PUNCH.   
?=CY ...      BCS      TP1  
?=FM ...      SEGENTRY K80PCTLISTA  
?=HB ...      LDN   6  A7021PAGE-HEADINGS-1[SET NO. OF LINES LEFT ON PAGE   
?=K5 ...      SEGENTRY K85PCTLISTA  
?=LS ...      LDN   5  A7021WIDTH+1        [SET PRINTER WIDTH   
?=NH ...      STO   5  IWORK12(2)   
?=Q= ...      STO   6  IWORK16(2)   
?=R^ ...Z4PCTLISTA  
?=TN ...      LDXC  0  QUAL(2)  
?=XC ...      BCC      ONCEMORE 
?=^6 ...      SETNCORE 40,3,ADATA,ACONV 
??2T ...ONCEMORE
??32 ...      STOZ     IWORK17(2)          [CLEAR CONTINUATION  
??37 ...      LDCH  0  IWORK20(2)   
??3# ...      ANDN  0  #54  
??3F ...      ERN   0  #50  
??3L ...      BZE   0  SETLI               [J TO LIST SETUP FILE
??3R ...      LDN   0  1
??3Y ...      ANDX  0  IWORK20(2)   
??45 ...      ERS   0  IWORK20(2)          [UNSET "MAINFILE ALREADY POSITIONED" 
??4= ...      BNZ   0  ZMPOS               [AND J IF IT WAS SET 
??4C ...SETLI   
??6? ...      ACROSS   RMTLF,1  
??6N ...TP1   LDN   6  1                   [SET SO RMTLF FLIPS  
??75 ...ZMPOS LDX   4  IWORK1(2)            [LINE NUMBER
??7G ...      STO   4  IWORK14(2)   
??7X ...                                    [SAVE LINE NUM FOR RESTARTS 
??8# ...      STO   4  IWORK19(2)   
??8P ...      MHUNTW   3,A7020,ALIST
??96 ...      STO   4  INTLK4(3)            [SO RESTARTS DONT GO BACK TOO FAR   
??9H ...      LDN   4  1
??9Y ...                                    [SHOW RMTLF POSITION AT CORRECT LINE
??=* ...      LDN   5  1                    [AND CLEAN FINISH ON LAST BUFFER
??=Q ...      ACROSS   RMTLF,2              [GO TO LIST FILE
??T=    XFRTOERR
??^5 ...      LDX   7  GMODE(3) 
?#2B ...      ANDX  7  BIT11
?#3M ...      BZE   7  NDRQ 
?#4Y ...[                                J IF FILE WAS CORRUPT  
?#69 ...      MHUNTW   3,A7020,ALIST
?#7G ...      ORS   7  EWAIT(3) 
?#8R ...      RENGAGE  5,XCD,XCD
?#=4 ...NDRQ
?##5 ...      LDX   1  FX1  
?##W          CALL  7  NEW  
?#SG ...      MHUNTW   1,ADATA,HEADING  
?*#6 ...      LDN   4  HEADPFCC(1)         [MESSAGE PRECEDED BY 2 NLS   
?*RQ ...      SMO      HEADCNT(1)          [CHARACTER CT INC NLS
?B?B ...      MVCH  4  0                   [MOVE INTO BUFFER
?BR2 ...      FREECORE 1                   [FREE HEADINGS BLOCK 
?C=L ...      CALL  7  ZLINE
?CGD ...      CALL  7  SEND 
?CQ= ...      CALL  7  WFIN1
?F#= ...      MHUNTW   3,GOUT,INFO  
?FCB ...      JBC      NCB2,3,BLFSETUP  
?FGG ...[                                   J IF NO SETUP FILE  
?FKL ...      FILEMOVE 1,0                 [PUT MAINFILE AT TOP LEVEL   
?G5= ...NCB2  ACROSS   PCTLISTB,2   
?Y*G    #   
?YT6    #   
?^#Q    SET   GEOERR   1,LONGSET           [LONGSET GIVEN TWICE 
#2#2    #   
#2C6 ...Z2PCTLISTA  
#2G= ...      ACROSS   PCTLISTB,1   
#2KB ...Z3PCTLISTA  
#2NG ...      ACROSS   PCTLISTB,2   
#2RL    #END
^^^^ ...57150704000100000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1