{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: TROBJ867)}}
====== TROBJ867 ======
(George Source)

**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:AND|AND]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHECKA|CHECKA]], [[george:macro:COMPQU|COMPQU]], [[george:macro:FADDRESS|FADDRESS]], [[george:macro:FDRMTEST|FDRMTEST]], [[george:macro:FI|FI]], [[george:macro:FINMVCH|FINMVCH]], [[george:macro:FOUTMOVE|FOUTMOVE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT|HUNT]], [[george:macro:IF|IF]], [[george:macro:INMOP|INMOP]], [[george:macro:LOCKCA|LOCKCA]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OLPEND|OLPEND]], [[george:macro:PAIR|PAIR]], [[george:macro:PMODES|PMODES]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:THEN|THEN]], [[george:macro:TOPCA|TOPCA]], [[george:macro:TOPCA1|TOPCA1]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSFO1|TRANSFO1]], [[george:macro:WHICHMOP|WHICHMOP]]

<code - TROBJ867.txt>229S ...      SEG      TROBJ,867,SECT.FILE,,G505
22FL    #OPT  K0TROBJ=K0OLP 
22^=    #OPT  K6TROBJ=K6OLP 
23DW    #LIS  K0TROBJ   
23JR ...[   
23NN ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
23SK ...[     THIS EXCLUDES CODE UNDER #SKI G505
23YG ...[   
244C ...#OPT G505 = 0   
248# ...#SKI G505&1 
24#9 ...# WITH UGUG EDIT M505 (3-SHIFT WORKING FOR MOP ONLINE)  
24D6    #   
24XQ    #     THIS SEGMENT IMPLEMENTS OFFLINE A TR PERI IF *TR IS ASSIGNED TO A 
25CB    #           AWORK1=    N/CH READ BY PREVIOUS PERI   
25X2    #           AWORK2=    PERI MODE (NEW RECORD MODE)  
25^K    #           AWORK3     B23 SET.  LAST TRANSFERRED CH OF PREVIOUS PERI WA
2648    #                         DELTA. MODE IS PREVIOUS SO SUCCESSOR MUST BE  
266R    #                         FIRST CH. TRANSFERRED IN THIS PERI.   
269B    #                      B22 SET.  LAST TRANSFERRED CH OF PREVIOUS PERI WA
26?^    #                         DELTA. MODE IS ALPHA SO SUCCESSOR MUST BE REMO
26BJ    #                         FROM THIS PERI TRANSFER AND IF IT WAS A STOP C
26F7    #                            (EG N/L) THE TERMINATE STATUS MUST BE FORGO
26HQ    #                      B4 SET.  THE LOST CHARACTER(SEE B22 ABOVE) WAS A 
26L*    #                         STOP CHARACTER AND ACONV IS NOW EMPTY. MUST   
26NY    #                         CONTINUE AND GET NEXT RECORD AS TERMINATE 
26RH    #                         STATUS MUST BE FORGOTTEN. 
26W=    #                      B0 =  N/L CHAR HAS BEEN INSERTED 
27*W    #                      B01=1 RECORD IS 2000 CHARS LONG  
27TG    #                         B6 SET. LAST CH OF 2000 CH RECORD IS A DELTA. 
28*6    #           AWORK4     B0 =1 END OF MULTIFILE HAS BEEN REACHED  
28F3    #                     B10 SET. NLNULL PERIPHERAL NAME QUALIFIER GIVEN IN
28JY    #                     ASSIGN COMMAND. THIS HAS NO EFFECT EXCEPT FOR 
28NT    #                     GRAPHIC PERIS.
28SQ    #           ACOMMUNE1= RECORD MODE  
29#B    #           ACOMMUNE2= PERI MODE
29S2    #   
2=R=          SEGENTRY K1TROBJ,Z1TROBJ  
2?=W    MASK1          #60077777
2?QG    MASK2          #60000000
2#=6    MAX            +129 
2##P ...#SKI G505&1 
2#C# ...(   
2#FX ...XCCS1          #76137632           [ FOR 'CURSOR'   
2#JG ...MASKID         #70000706           [ PERMANENT BITS OF IDENTIND 
2#M5 ...)   
2#PQ    NEWLINE        #76322020
2*9B    XALP           #74  
2*P2    XBET           #75  
2B8L    PLINK1  
2BN=          PAIR     TROBJ,1  
2C7W    #   
2CMG    #  THIS SUBROUTINE GETS LENGTH OF RECORD (CHARACTERS) IN ACONV. 
2D76    #              ENTRY:X0=LINK
2DLQ    #                    X3=PTR TO RECORD   
2F6B    #              EXIT: X0,X3=UNCHANGED
2FL2    #                    X4=N/CH IN RECORD  
2G5L    #                    X6=OVERVRITTEN 
2GK=    #   
2H4W    RECLEN  
2HJG          LDX   4  0(3)                [PICK UP N/W IN RECORD   
2J46          SBN   4  2                   [SUBTRACT RED TAPE   
2JHQ          BZE   4  Q4   
2K3B          SLL   4  2                   [MULTIPLY BY 4^NO.OF CHARS.  
2KH2          LDCH  6  1(3)                [PICK UP NO.OF USED CHARS.   
2L2L          SRL   6  4                   [IN LAST WORD OF RCD.
2LG=          BZE   6  Q4   
2L^W          SBN   4  4                   [SUBTRACT 4 CHARS.   
2MFG          ADX   4  6                   [AND ADD NO.OF CHARS.IN LAST WORD
2M^6    Q4    EXIT  0  0
2NDQ    #   
2NYB    #     THE SUBROUTINE SETS AWORK3 IF THE RECORD IS 2000 CHARS LONG   
2PD2    #              ENTRY:X0=N/W IN THE RECORD   
2PXL    #                    X1=LINK
2QC=    #                    X3=PTR TO RECORD-A1
2QWW    #   
2RBG    TEST2000
2RW6          LDCT  0  #004                [IS LAST CH A DELTA  
2S*Q          ANDX  0  AWORK3(2)
2STB          STOZ     AWORK3(2)
2T*2          ORS   0  A1+1(3)             [TRANSFER BIT TO RECORD IN ACONV.
2TSL          LDEX  0  A1+FRH(3)
2W#=          SBN   0  502  
2WRW          BNZ   0  (1)               [RECORD <2000 CHARS
2X?G          LDCH  0  A1+1(3)  
2XR6          SRL   0  4
2Y=Q          BNZ   0  (1)               [RECORD <2000 CHARS
2YQB          LDCT  0  #600 
2^=2          ORS   0  AWORK3(2)           [SWITCH  
2^PL          LDX   0  A1+501(3)
329=          ANDN  0  #77  
32NW          ERN   0  #76                 [TEST IF LAST CH OF 2000 CH RECORD IS
338G          BNZ   0  (1)                 [A DELTA. J IF NOT.  
33N6          LDCT  0  #004 
347Q          ORS   0  AWORK3(2)           [SET 'DELTA AT 2000' BIT_
34MB          BRN      (1)  
3572    #   
35LL    Z1TROBJ 
366=    #SKI  K6TROBJ>799-799   
36KW          TRACE    FX2,TROBJ
375G          LDX   3  APETADDR(2)         [PTR TO APET 
37K6          LOCKCA   3,ACAP(2)
384Q          LDX   4  ACAP(2)             [CA IN OBJ.PROG. 
38JB          LDN   5  ACA1(2)             [CA IN AOLPT 
3942          LDN   6  4
39HL          FOUTMOVE 3,4,5,6,HLOCK1      [MOVE CA TO OLPA 
3=3=          STOZ     ACA2(2)             [ZEROISE REPLY WORD  
3=GW          LDX   0  AWORK4(2)
3?2G          BNG   0  NORE15              [J IF END OF MULTIFILE   
3?4P          PMODES   4,3  
3?6Y          ANDN  4  #10  
3?97          BNZ   4  NOTPACT             [J IF NOT COMPACT MODE   
3??B          LDX   4  MASK1(1) 
3?*K          ANDS  4  ACA4(2)  
3?CS    NOTPACT 
3?G6          LDX   3  ACA3(2)             [COUNT   
3?^Q          BZE   3  WC1  
3#2B ...#SKI G505&1 
3#32 ...(   
3#3L ...      LDX   0  MASKID(1)
3#4= ...      ANDS  0  IDENTIND(2)  
3#4W ...)   
3#5G ...#SKI G505&1 
3#66 ...(   
3#6Q ...      LDN   0  #10  
3#7B ...      ANDX  0  ACA1(2)  
3#82 ...      IF       0,ZE                [ SHIFT PERI 
3#8L ...         LDN   6  6 
3#9= ...         ANDX  6  IDENTIND(2)   
3#9W ...      AND      6,NZ                [ SHIFT DEVICE   
3#=G ...      THEN  
3#?6 ...         LDN   0  #20   
3#?Q ...         ANDX  0  ACA1(2)   
3##B ...         IF       0,ZE  
3#*2 ...         THEN   
3#*L ...            LDN   6  4                   [ NORMAL ON ALLCHAR DEVICE 
3#B= ...         FI 
3#BW ...         SLL   6  12
3#CG ...         ORS   6  IDENTIND(2)   
3#D6 ...      FI
3#DQ ...)   
3#FB          BXGE  3  MAX(1),WC1          [CHECK 0<COUNT<129   
3#^2          LDX   4  ACA4(2)             [BUFFER ADDRESS  
3*68 ...      SLC   4  2
3*?B ...      ADX   3  4
3*DL          ADN   3  3
3*Y=          SRL   3  2
3B5D ...      SRL   4  2
3B=L ...      SBX   3  4
3BCW          CHECKA   4,3,RESV,APETADDR(2),W,Q5,HLOCK2 
3BXG    Q5    LDX   5  AWORK1(2)           [POINTER TO LAST RCD.
3CC6          LDX   7  ACA1(2)  
3CWQ          ANDN  7  #7777               [PERI MODE   
3DBB          BNZ   5  USEBLK              [J IF RECORD BLOCK PRESENT   
3DW2    STEP
3F*L          MHUNT    3,ADATA,AREST
3FT=          BNG   3  NOREST              [J IF WOT EXISTING   
3G#W          LDX   0  A1(3)
3GSG          BZE   0  NOREST              [J IF EMPTY  
3H#6          MHUNT    1,ADATA,ACONV
3HRQ          BNG   1  NOREST   
3J?B          STOZ     A1(1)               [EMPTY   
3JR2          NAMETOP  1,ADATA,AREST
3K=L          BRN      READREST 
3KQ=    NOREST  
3L9W          INMOP K1TROBJ,MFMOP          [READ RECORD FROM MOP OR MF  
3LPG          STEP  
3M96          TESTREP2 STEPWAIT,WAIT
3MNQ          BZE   3  WAIT2
3N8B          HUNT     2,ADATA,ACONV
3NN2          LDX   4  FRH(3)                [RECORD LENGTH 
3P7L          ADN   4  1                   [1 WORD FOR N/L  
3PM=          BPZ   2  PRESB               [J IF BLOCK PRESENT  
3Q6W          SETUPCORE 4,2,ADATA,ACONV 
3QLG          BRN      OKLEN
3R66    MFMOP MHUNT    3,FILE,FRB          [FIND RECORD FROM MOP/MF 
3RKQ          LDX   4  A1+FRH(3)
3S5B          ADN   4  1
3SK2          ALTLEN   3,4                 [LENGTHEN TO MAKE ROOM FOR NEWLINE   
3T4L          MHUNT    3,FILE,FRB   
3TJ=    READREST
3W3W          NAMETOP  3,ADATA,ACONV
3WHG          CALL  1  TEST2000      [TEST IF RECORD IS 2000 CHARS LONG 
3X36          WHICHMOP      RCMOD          [J IF NOT MOP OR JDF.
3XGQ          LDX   3  APETADDR(2)  
3Y2B          LDX   3  JOBRING+FPTR(3)     [X3->JOBRING OF CPAT.
3YG2          LDN   0  #10  
3Y^L          ANDX  0  CONTEXT-JOBRING(3)   
3^F=          BNZ   0  XGRAMOP             [J IF MOP AND ASSUME GRAPHIC FILE MOD
3^YW          LDX   3  FILEBRING-JOBRING(3) 
42DG          LDX   3  BPTRF(3) 
42Y6          ADX   3  FBACKPOINT(3)
43CQ          LDX   3  BPTR(3)             [X3->FCB OF JDF. 
43XB          LDEX  6  FETM(3)             [PICK UP FILE MODE.  
44C2          BRN      TRANS
44WL    PRESB BXL   4  ALOGLEN(2),OKBL  
45B=          LDX   6  2
45TW          ALTLEN   6,4  
46*G    OKLEN STEPAGAIN                    [PTR.TO RECORD   
46T6          MHUNT    2,ADATA,ACONV
47#Q    OKBL
47SB          LDN   4  A1(2)
48#2          SMO      FRH(3)   
48RL          MOVE  3  0                   [MOVE RECORD TO ACONV.   
49?=          LDX   3  4
49QW          SBN   3  A1   
4==G          LDX   2  FX2  
4=Q6          CALL  1  TEST2000            [TEST IF RECORD IS 2000 CHARS
4?9Q    RCMOD LDX   6  FSCTM(2)            [TYPE/MODE   
4?PB          ANDN  6  #7777
4#92          BNZ   6  TRANS               [J IF TR FILE
4#NL    XGRAMOP 
4*8=          LDN   6  #12                 [CR,CP,LP FILE   
4*9S ...#SKI G505&1 
4*?B ...(   
4*#Y ...      LDX   0  IDENTIND(2)  
4*BG ...      SRL   0  9
4*D4 ...      ANDN  0  #60                 [ SHIFT DEVICE BITS  
4*FL ...      BZE   0  XCONV
4*H8 ...      LDN   6  #20                 [ ALLCHAR, START IN ALPHA
4*JQ ...      ANDX  6  0                   [ POSS CHANGE TO NORMAL  
4*L# ...)   
4*MW          BRN      XCONV
4B7G    TRANS LDX   0  6                   [RECORD MODE 
4BM6          ANDN  0  #10  
4C6Q          BNZ   0  XCONV               [J IF GRAPHIC
4CLB          ORN   6  4                   [ALL RECORDS IN PREVIOUS 
4D62    XCONV TRANSFO1 6,7                 [CONVERT THE MODE
4DKL          TESTREP2 ILLMODE,MOLE        [TEST IF LEGAL MODE  
4F5=          TESTRPN2 SHIFT,OKACA  
4FJW          LDN   0  4
4G4G          ORS   0  ACA1(2)             [CHANGE TO PREVIOUS  
4GJ6    OKACA STO   7  AWORK2(2)           [STORE NEW RECORD MODE   
4H3Q          ANDN  7  #10  
4HHB          MHUNT    3,ADATA,ACONV
4J32          LDX   5  3                   [REMEMBER PTR TO ACONV   
4JGL          ADN   3  A1   
4K2=          CALL  0  RECLEN   
4KFW          BNZ   7  NLPRE               [J IF RECORD IN GRAPHIC  
4K^G    NLCH  LDX   0  AWORK3(2)
4LF6          BNG   0  NLPRE               [J IF N/L HAS ALREADY BEEN INSERTED  
4LYQ          LDCT  0  #400                [B0=1
4MDB          ORS   0  AWORK3(2)           [N/L IS BEING INSERTED   
4MY2          ADN   3  2                   [ADD RED TAPE
4NCL          SRC   4  2
4NX=          ADX   3  4                   [PTR TO LAST CHAR+1  
4PBW          SLC   4  2
4PD7 ...#SKI G505&1 
4PFD ...(   
4PGP ...      LDCT  0  #200 
4PJ2 ...      ANDX  0  IDENTIND(2)  
4PK? ...      BZE   0  XCCS4               [ NO 'CURSOR'
4PLJ ...      LDN   2  XCCS1(1) 
4PMT ...      MVCH  2  4
4PP6 ...      ADN   4  4
4PQC ...      BRN      XCCS5
4PRN ...XCCS4   
4PS^ ...)   
4PWG          SLC   3  2
4QB6          SBN   3  2                   [- 2 CHRS
4QTQ          SRC   3  2
4R*B          LDCH  0  0(3)                [TEST FOR ^* 
4RT2          SBN   0  #76  
4S#L          BCHX  3  £
4SS=          BNZ   0  NONL                [J IF NOT ^  
4T?W          LDCH  0  0(3) 
4TRG          SBN   0  #32                 [TEST FOR *  
4W?6          BZE   0  NLPRE               [J IF ^* 
4WQQ    NONL  BCHX  3  £
4X=B          LDN   2  NEWLINE(1)   
4XQ2          MVCH  2  2                   [INSERT ^*   
4Y9L          ADN   4  2                   [ADD 2 CHARS 
4YBS ...#SKI G505&1 
4YJ2 ...XCCS5   
4YP=          LDX   2  FX2  
4^8W          LDX   3  5                   [PTR TO ACONV
4^NG          LDN   0  3
5286          ANDX  0  4                   [N/CH IN LAST WORD   
52MQ          SLL   0  4
537B          DCH   0  A1+1(3)             [UPDATE R/T  
53M2          LDX   0  4                   [N/CH IN RECORD  
546L          ADN   0  11                  [ADD RED TAPE
54L=          SRL   0  2                   [N/W 
555W          STO   0  A1(3)               [UPDATE R/T  
55KG    NLPRE LDX   3  5                   [RESTORE PTR TO ACONV
5656          LDEX  6  AWORK3(2)           [SWITCH  
56JQ          BZE   6  NOSET               [J IF IT IS NOT SET  
56SJ          BZE   4  NSET2               [J IF ACONV E-PTY
574B          LDCH  0  A1+2(3)  
57J2          SBN   0  #76                 [TEST IF DELTA   
57NN          BZE   0  TYPE2                [J IF SO
57TB          LDN   0  2                   [UNSET SWITCH AS ^ AN& 00CCE00OR 
5824          SBS   0  AWORK3(2)           [ALREADY RE-OVE& BY TRANSFOR 
586Q          BRN      NSET 
58?D    TYPE2   
58H=          BCHX  3  £
592W          SBN   4  1                   [SUBTRACT ONE CHAR   
594F          SEGENTRY K91TROBJ            [RESTORE TIME MACRO TRTYPE1  
5964          BCT   6  TYPE2               [X6 CONTAINS CURRENT STATE OF
597M                                       [BITS 22,23 OF AWORK3.   
598D    NSET
599=          BNZ   4  NOSET               [J IF ACONV NOT EMPTY.   
59=T                                       [IE STOP CHARACTER NOT REACHED.  
59?L    NSET2   
59#D          LDCT  0  #02                 [SET BIT TO INDICATE TERMINATE STATUS
59B3          ORS   0  AWORK3(2)           [OF STOP CH. MUST BE LOST,   
59CL                                       [SINCE SPLIT OVER TWO PERIS. 
59FC    NOSET BZE   7  NOGRAPH             [J IF NOT GRAPHIC.   
59KJ          LDX   0  4                   [INDICATE NO EMBEDDED STOP CH.   
59PP          BRN      NOST 
59TW    NOGRAPH 
5=26          LDX   0  ACA1(2)             [PERI MODE   
5=FQ          ANDN  0  2
5=^B          BZE   0  NOST                [J IF READ N CHARS   
5?F2          LDX   6  3                   [REMEMGR PTR TO ADATA
5?YL          LDX   7  4                   [NO. OF CHS IN RECORD.   
5#D=          BZE   7  NOSTA1   
5#XW          ADN   3  A1+2                [PTR TO THE RECORD   
5*CG    NCHAR LDCH  0  0(3)                [LOAD CHAR   
5*X6          SBN   0  #76  
5BBQ          BCHX  3  £
5BWB          BZE   0  SUCT                [J IF DELTA  
5CB2    TNCH  BCT   7  NCHAR
5CTL          BRN      NOSTA1               [J IF NOT A STOP CHAR   
5D*=    SUCT  BCT   7  SUCT1
5DSW    NOSTA1  
5F#G          LDX   0  4
5FS6          BRN      NOSTA               [J IF NOT A STOP CHAR
5G?Q    SUCT1 LDCH  0  0(3)                [LOAD SUCCESOR   
5GRB          BCHX  3  £
5H?2          SBN   0  20   
5HQL          BNZ   0  NOTC4               [J IF NOT TC4
5J==          LDX   0  ACA1(2)  
5JPW          SBN   0  2                   [TEST IF NORMAL  
5K9G          BZE   0  STOP                [J IF TC4
5KP6          BRN      TNCH 
5L8Q    NOTC4 SBN   0  6
5LNB          BNG   0  TNCH                [J IF NOT A STOP 
5M82          SBN   0  4
5MML          BPZ   0  TNCH                [J IF NOT A STOP 
5N7=    STOP
5NLW          SBN   3  A1+2 
5P6G          SLC   3  2
5PL6          SLC   6  2
5Q5Q          SBX   3  6
5QKB          SRC   6  2
5R52          LDX   0  4                   [N/CH IN RECORD  
5RJL          LDX   4  3                   [ASSUMED RECORD LENGTH   
5S4=    NOSTA LDX   3  6
5SHW    NOST  LDX   6  ACA3(2)             [PERI COUNT  
5T3G          BXL   6  4,SETAW             [J IF PERI COUNT<REC.LENGTH  
5TH6          BXU   6  4,TOK
5TM3          LDX   1  BIT10
5TQY          ANDX  1  AWORK4(2)
5TWT          BZE   1  TOK                 [J IF NLNULL QUAL NOT GIVEN  
5W2Q          LDCT  5  #600 
5WGB          ANDX  5  AWORK3(2)
5X22          BZE   5  SETAW             [J IF GRAPHIC BUT NOT 2000CH RECORD.   
5X^=    TOK 
5YDW          LDX   6  4
5YYG          BXL   4  0,SETAW             [J IF EMBEDDED STOP  
5^D6          STOZ     AWORK1(2)
5^XQ          BRN      Q8   
62CB    SETAW STO   6  AWORK1(2)           [N/CH
62X2          LDEX  0  AWORK3(2)           [SWITCH  
63BL          ADS   0  AWORK1(2)           [+1 IF ^ IS NOT TRANSFERED   
63W=    Q8    ADN   3  A1+2 
64*W          LDX   1  APETADDR(2)  
64TG          BZE   6  Q11                 [J IF RECORD LENGTH=0
65*6          SBS   6  ACA3(2)             [UPDATE COUNT
65SQ          LDX   4  ACA4(2)             [BUFFER ADDRESS  
66#B          FINMVCH  1,4,3,6,HLOCK2,,G      [MOVE TO OBJ PROG BUFFER  
66S2    Q11 
67?L          LDX   0  AWORK1(2)
67R=          BNZ   0  OLPREP              [J IF ACONV IS NOT EMPTY.
68=W          WHICHMOP Q12                 [J IF NOT MOP OR JDF.
68QG          MFREE    ADATA,ACONV         [FREE BUFFER BLOCK   
69=6          LDX   1  APETADDR(2)  
69PQ    Q12   LDX   0  ACA1(2)             [MODE
6=9B          SRC   0  2
6=P2          BPZ   0  NCHARS              [READ N CHARS
6?8L          LDCH  0  AWORK3(2)
6?N=          SBN   0  #60                 [TEST SWITCH 
6?WG          BZE   0  NCHARS              [J IF 2000CH RECORD. 
6#4Q          LDCT  0  #02                 [TEST IF ACONV EMPTY BUT STOP CH EFFE
6#?2          ANDX  0  AWORK3(2)           [LOST DUE TO BEING SPLIT OVER TWO
6#F=          BZE   0  OLPREP              [PERIS.  J IF NOT TO FINISH. 
6#MG    NCHARS  
6*76          LDEX  7  ACA1(2)             [MODE
6*LQ    PEGR  BZE   6  NOUP                [J IF ACA4 IS OK 
6B6B          LDX   4  ACA4(2)             [PERI ADDRESS
6BL2          SLC   4  2
6C5L          ADX   4  6                   [ADD NCH TRANSFERED  
6CK=          SRC   4  2                   [NEW ADDRESS 
6D4W          STO   4  ACA4(2)             [UPDATE BUFF ADDRESS 
6DJG    NOUP  LDX   6  ACA3(2)             [REMAINDER COUNT 
6F46          BNZ   6  STEP                [J TO READ NEXT RECORD   
6FHQ    OLPREP  
6G3B          LDX   3  ACAP(2)             [PTR TO PERI CA  
6GH2          ADN   3  1
6H2L          FADDRESS 1,3,HLOCK1   
6HG=          LDX   6  ACA3(2)             [REMAINDER COUNT;IF X6=0 
6H^W          STO   6  0(3)                [REPLY WORD  
6JFG          OLPEND
6J^6          BRN      K1TROBJ  
6KDQ    #   
6KYB    #   
6LD2    USEBLK  
6LXL          LDCT  0  #604 
6MC=          ANDS  0  AWORK3(2)           [MAST B23
6MWW          MHUNT    3,ADATA,ACONV
6NBG          LDX   4  A1+1(3)             [2ND WORD OF RED TAPE
6NW6          LDN   3  A1+2(3)             [PTR TO RECORD   
6P*Q          LDX   2  3
6PTB          SRL   4  6
6Q*2          ANDN  4  #77                 [SHIFT OR ZERO   
6QSL          BZE   4  XGR                 [J IF GRAPHIC
6R#=    NCH   LDCH  0  0(2)                [LOAD CHARACTER  
6RRW          BXE   0  XALP(1),SHIFT       [J IF ALPHA  
6S?G          BXU   0  XBET(1),NOSH        [J IF NOT SHIFT CHAR.
6SR6    SHIFT LDX   4  0                   [REMEMBER SHIFT  
6T=Q    NOSH  BCHX  2  £
6TQB          BCT   5  NCH                 [J TO TEST NEXT CHAR.
6W=2          SBN   0  #76  
6WPL          BNZ   0  NODEL               [J IF IT IS NOT DELTA
6X9=          LDN   0  1
6XNW          SMO      FX2  
6Y8G          SBS   0  AWORK1              [TRANSFER DELTA  
6YN6          SLC   2  2
6^7Q          SBN   2  1
6^MB          SRC   2  2
7272          LDN   6  4
72LL          ANDX  6  7                   [PERI MODE   
72WD          SEGENTRY K92TROBJ            [RESTORE TIME MACRO TRTYPE1  
736=          BNZ   6  PREMO               [J IF PREVIOUS SHIFT SPECIFIED.  
73B4          ADN   0  1
73KW    PREMO SMO      FX2  
745G          ORS   0  AWORK3              [SET SWITCH  
74*#          SEGENTRY K93TROBJ 
74K6    NODEL SLC   3  2
754Q          SBN   3  2
75JB          SRC   3  2
7642          DCH   4  0(3)                [STORE LAST SHIFT
76HL          BCHX  3  £
773=          BCHX  3  £
77GW          BRN      SUBR 
782G    XGR   SLC   2  2
78G6          SMO      FX2  
78^Q          ADX   2  AWORK1   
79FB          SRC   2  2
79^2    SUBR  SBN   3  2
7=DL          CALL  0  RECLEN              [GET RECORD LENGTH   
7=Y=          SMO      FX2  
7?CW          SBX   4  AWORK1              [SUBTRACT N/CH WHICH HAS BEEN READ   
7?XG    OKR   LDX   6  3
7#C6          ADN   3  2                   [PTR TO RECORD   
7#WQ          BZE   4  NOTMV               [J IF REC.LENGTH=0   
7*BB          LDX   0  4                   [REMEMBER RECORD LENGTH  
7*W2    TEST4 SBN   4  512  
7B*L          BNG   4  SHALL               [J IF LENGTH<512 
7BT=          MVCH  2  0                   [MOVE 512 CHARS  
7C#W          BNZ   4  TEST4               [J IF MORE TO MOVE   
7CSG          BRN      RES4 
7D#6    SHALL ADN   4  512                 [X4=N/CH TO MOVE 
7DRQ          SMO      4
7F?B          MVCH  2  0                   [MOVE RECORD 
7FR2    RES4  LDX   4  0                   [RESTORE X4  
7G=L    NOTMV LDN   0  3
7GQ=          ANDX  0  4                   [N/CH IN LAST WORD   
7H9W          SLL   0  4
7HPG          LDX   3  6
7J96          DCH   0  1(3)                [STORE N/CH IN LAST WORD 
7JNQ          BNG   4  NEGNCH              [J IF NEGATIVE N/CH  
7K8B          ADN   4  3
7KN2          SRL   4  2                   [N/W IN RECORD   
7L7L          ADN   4  2                   [ADD RED TAPE
7LM=          STO   4  0(3) 
7M6W          LDX   2  FX2  
7MLG          LDX   6  AWORK2(2)           [RECORD MODE 
7N66          BRN      TRANS
7NKQ    #   
7P5B    #   
7PK2    MOLE
7Q4L          BNZ   5  MOILE
7QJ=          CALL  6  SRBAC
7R3W    MOILE   
7RHG          LDN   3  FYMODE   
7S36    XILL
7SGQ          CALL  5  TOPCA               [CHANGE TO PCA LEAVING CORRECT LINK  
7T2B          ACROSS   OLPODD,4 
7TG2    NORE
7T^L          COMPQU   NORE1
7WF=          BRN      K1TROBJ  
7WYW          LDX   0  GSIGN
7XDG          ORS   0  AWORK4(2)           [END OF MULTIFILE
7XY6          BRN      NORE15   
7YCQ    NORE1   
7YXB          CALL  6  SRBAC
7^C2    NORE15  
7^WL          LDX   0  ACA1(2)             [TYPE/MODE   
82B=          SRL   0  6                   [IGNORE MAIN MODE
82TW          ANDN  0  #777 
83*G          SBN   0  #300                [TEST OWN MONITORING MODE #30000 
83T6          BNZ   0  OUTP                [J IF NOT
84#Q          LDCT  6  #50                 [SET B3 & B5 
84SB          ORS   6  ACA3(2)  
85#2          LDX   1  APETADDR(2)  
85RL          BRN      OLPREP              [J TO SET REPLY WORD 
86?=    NEGNCH  
86QW          GEOERR   1,NEG N/CH   
87=G    OUTP
87Q6          LDN   3  FYFILE   
889Q          LDX   4  FTYPNO(2)           [FOR OUTPACKING  
88PB          BRN      XILL 
8992    WC  
89NL          CALL  6  SRBAC
8=8=    WC1 
8=MW          LDN   3  FYCOUNT  
8?7G          BRN      XILL 
8?M6    RESV
8#6Q          LDN   3  FYNOBUF  
8#LB          BRN      XILL 
8*62    TOPCA   
8*KL          LDX   1  FX1  
8B5=          TOPCA1   PLINK1(1)           [CHANGE TO PCA   
8BJW          EXIT  5  0
8C4G    SRBAC   
8CJ6          WHICHMOP YBACK               [J IF NOT MOP OR JDF AND BACKSPACE   
8D3Q          BRN      (6)                 [EXIT
8DHB    YBACK   
8F32          SBX   6  FX1  
8FGL          BACKSPACE                    [UNDO THE STEP   
8G2=          ADX   6  FX1  
8GFW          EXIT  6  0
8G^G    WAIT
8HF6          LDN   3  1
8HYQ    WAIT2   
8JDB          FDRMTEST STEPWAIT,NODRM      [TEST FOR DRM
8JY2          LDCT  4  #420                [REPLY WORD  
8KCL          BNZ   3  WAIT3
8KX=          LDCT  4  #410                [REJECTED INOPERABLE 
8LBW          CALL  6  SRBAC
8LWG    WAIT3   
8MB6          ORS   4  ACA3(2)  
8MTQ          LDX   1  APETADDR(2)  
8N*B          BRN      OLPREP   
8NT2    NODRM   
8P#L          BZE   3  NORE 
8PS=    #SKI  K6TROBJ>100-100   
8Q?W          TRACE 7,TROBJWAK  
8QRG          CALL  5  TOPCA
8R?6          ACROSS   OLPODD,1            [WAIT FOR A RECORD TO BE APPENDED
8RQQ          MENDAREA 100,K99TROBJ 
8S=B    #END
^^^^ ...43015704000200000000
</code>