EDWRITE867

(George Source)

Macros used: ACROSS, ALTLEN, BACKSPACE, BXE, BXGE, BXL, BXU, CURTAIL, EDCOM, EDERR, FI, FIXTRA, FREECORE, GEOERR, HUNTW, IF, MENDAREA, MFREEW, MHUNT, MHUNTW, MONOUT, NAME, OUTBLOCN, OUTMON, OUTMONX, OUTNUM, PHOTO, READAGAIN, SEG, SEGENTRY, STEP, TESTMOVE, TESTREP, THEN, UP, UPPLUS

EDWRITE867.txt
22FL    #LIS  K0EDWRITE>K0ALLGEO>0  
22LS ...      SEG EDWRITE,867,COMM,,G571
22S2 ...[   
22^8 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
236B ...[     THIS EXCLUDES CODE UNDER #SKI G571
23?J ...[   
23DQ ...#OPT G571 = 0   
23KY ...#SKI G571&1 
23R6 ...# WITH UGUG EDIT M571 (IMPROVED EDIT AMORPHOUS FILE)
23YG    #   
24D6    #              ENTRY POINT TABLE
24XQ    #   
25CB     SEGENTRY K1EDWRITE,N1EDWRITE      [WRITE RECORD TO NEW FILE
25X2     SEGENTRY K2EDWRITE,OH  
26BL     SEGENTRY K3EDWRITE,OH  
26W=     SEGENTRY K4EDWRITE,OH  
27*W     SEGENTRY K5EDWRITE,OH  
27TG     SEGENTRY K7EDWRITE,OH  
28*6     SEGENTRY K8EDWRITE,OH  
28SQ     SEGENTRY K9EDWRITE,N9EDWRITE      [F INSTRUCTION   
29#B     SEGENTRY K10EDWRITE,N10EDWRITE    [OUTPUT FOR W-FACILITY   
29S2     SEGENTRY K11EDWRITE,N11EDWRITE    [JOB ABANDONED ACTION
2=?L    OH    GEOERR   1,EDWRITE
2=R=    #   
2?=W    MNUM  #32657713                    [MAGIC NUMBER
2?QG    SPWRD #40772020                    [@_   PRECEDES W LISTINGS
2#=6    #   
2#PQ    #     RLOF RELOCATES THE OLD FILE BLOCK 
2*9B    #   
2*P2    RLOF  LDX   5  IEOM(2)             [GET BLOCK PHOTO 
2*YS          LDX   3  IEOA(2)  
2B8L          TESTMOVE 5,RO1               [J IF STILL THERE
2BN=          MHUNTW   3,EDIT,FRB           [ELSE FIND IT   
2C7W          PHOTO    5                   [GET NEW PHOTO   
2CMG          STO   5  IEOM(2)             [AND STORE   
2D76          STO   3  IEOA(2)             [STORE ADDRESS   
2DLQ    RO1   EXIT  6  0                   [AND EXIT
2F6B    #   
2FL2    #   
2G5L    #     RLNF RELOCATES THE NEW FILE BLOCK.
2GK=    #   
2H4W    RLNF  LDX   5  IENM(2)             [GET BLOCK PHOTO 
2H#N          LDX   3  IENA(2)  
2HJG          TESTMOVE 5,RN1               [J IF STILL THERE
2J46          MHUNTW   3,FILE,FAPB          [ELSE FIND IT   
2JHQ          PHOTO 5                      [GET NEW PHOTO   
2K3B          STO   3  IENA(2)             [STORE ADDRESS OF BLOCK  
2KH2          STO   5  IENM(2)             [STORE PHOTO OF BLOCK
2L2L    RN1   EXIT  6  0                   [AND EXIT
2LG=    #   
2L^W    #   
2MFG    SETAPPEND            [SETS APPEND POINTERS = READ PTRS FOR NEWFILE  
2M^6    #   
2NDQ          CURTAIL                      [NEWFILE AT LEVEL 0  
2NYB          EXIT  6  0
2PD2    #   
2PXL    #   
2QC=    #     K1EDWRITE IS THE ENTRY POINT FOR WRITING A RECORD TO  
2QWW    #     THE NEW FILE. THE RECORD IS LISTED TO THE MONITORING  
2RBG    #     FILE IF REQUIRED  
2RW6    #     EXTREME OVERSIGHT ON MY PART I WROTE THE SPECIFICATION TO ALLOW   
2S*Q    #     FOR ANY SORT OF FILE TO BE USED BY THE EDITOR. THE FOLLOWING CODE,
2STB    #     WHICH IS AS NASTY AS THE SYNTAX ANALYSIS ROUTINES IN EDITOR ARE   
2T*2    #     BEAUTIFUL, REPRESENTS THE ALMOST UNBELIEVABLE MESS THAT THE   
2TSL    #     DESIGNERS OF GEORGE 3 HAVE MADE OF PERIPHERAL FILES. (THE FILE-   
2W#=    #     STORE WAS ACTUALLY DESIGNED?) 
2WRW    #     BE CONSOLED BY THE THOUGHT THAT THE PAPER TAPE MODE CONVERSION
2X?G    #     IS NOT NEEDED HERE THANKS TO LADISLAV KUTILECK'S CUNNING ROUTINES 
2XR6    #     EXIT IF FILE FULL OR B. S. LIMIT:    UP   
2Y=Q    #     EXIT IF BREAK-IN                     UPPLUS 1 
2YQB    #     EXIT IF OK                           UPPLUS 2 
2^=2    #   
2^PL    #     NOW READ ON - -   
329=    #   
32NW    N1EDWRITE   
338G    #   
33N6          BVSR     £                   [MAKE SURE V IS CLEAR
347Q          CALL  6  RLNF                [GET OUTPUT BLOCK AGAIN. 
34MB    WR6   LDX   5  BITS22LS            [NOW WE HAVE TO SET  
3572          LDX   6  IENC(2)             [UP THE FILESTORE
35LL          BXL   6  IENH(2),WR60        [RED TAPE WORDS, 
366=          BXE   6  IENH(2),WR60        [LOPPING OFF 
36KW          BVCI  £                      [AT MAXIMUM LENGTH   
375G          LDX   6  IENH(2)             [IF REQUIRED 
37K6          STO   6  IENC(2)  
384Q    WR60  LDN   7  0                   [AND SETTING UP THE  
38JB          SRL   67 2                   [PECULIAR FORMAT 
3942          BZE   7  WR7                 [ADDING IN FOR ALL   
39HL          ADN   6  1                   [MANNER OF THINGS
3=3=    #SKI  JDIAG1
3=GW    (   
3?2G    WR7   ADX   6  IENG(2)             [SET RECORD HEADER LENGTH
3?G6          SBN   6  A1                  [WE MUST NOT OVERWRITE   
3?^Q    )   
3#FB    #SKI  JDIAG1<1$1
3#^2    WR7   ADN   6  2                   [WE MUST NOT OVERWRITE   
3*DL          LDX   3  IENA(2)             [BITS 2 TO 23 OF THE 
3*Y=          ANDS  5  A1+1(3)             [SECOND WORD BECAUSE 
3BCW          STO   6  A1(3)               [WE HAVE MOST PAINFULLY  
3BXG          ORS   7  A1+1(3)             [PUT THEM THERE  
3CC6          LDX   0  A1+1(3)             [CHECK IF PFCC TO BE CHANGED 
3CWQ          LDX   5  IEPF(2)  
3DBB          BNG   5  WR7A                [J IF NOT
3DW2          SRL   0  6
3F*L          SLL   0  6
3FT=          ORX   0  5                   [RESET   
3G#W          STO   0  A1+1(3)  
3GSG    WR7A  STO   0  AWORK1(2)           [SAVE 2ND RED TAPE WORD  
3H#6          BZE   7  WR71                [J IF INTEPRAL NUMBER OF WORDS   
3HRQ          ADS   6  3                   [END ADDRESS OF BLOCK
3J?B          ADN   3  A1-1                [ADJUST FOR RED TAPE 
3JR2          ORS   7  3                   [SET CHARACTER ADDRESS   
3K=L          SLC   7  2                   [CONVERT TO COUNT WHICH  
3KQ=          LDN   5  #20                 [IS COMPLEMENT   
3L9W          SBN   7  4                   [CONVERT TO NEGATIVE COUNT   
3LPG    WR70  DCH   5  0(3)                [SPACE FILL THE LAST 
3M96          BCHX  3  £                   [WORD OF THE RECORD  
3MNQ          ADN   7  1                   [INCREMENT COUNT AND 
3N8B          BNZ   7  WR70                [LOOP UNTIL FULL 
3NN2    WR71  BVCR  WR8                    [J IF LENGTH WAS OK  
3P7L          EDCOM    YRTL                [ELSE COMMENT ON THE CHOPPING
3PM=    WR8   CALL  6  RLNF                [GET FAPB
3Q6W          CALL  6  RLOF 
3QLG          LDX   3  IENA(2)  
3R66          STO   3  5
3RKQ          LDX   7  A1(3)
3S5B    #SKI  JDIAG1
3SK2    (   
3T4L          LDN   4  #4   
3TJ=          ANDX  4  IESW(2)  
3W3W          BZE   4  NOTG                [J IF NOT GEDIT  
3WHG          SMO      IEOA(2)  
3X36          LDX   4  A1+2                [PASS ACROSS 
3XGQ          STO   4  A1+2(3)             [SEQUENCE WORD   
3Y2B    NOTG
3YG2    )   
3Y^L          CALL  6  SETAPPEND           [SET APPEND PTRS = READ PTRS 
3^2H ...#SKI G571&1 
3^3D ...(   
3^4* ...      LDN   6  0
3^5= ...      IF       +IEOT(2),ZE         [ NEWFILE AMORPHOUS  
3^67 ...      THEN  
3^74 ...         LDN   6  1 
3^7^ ...         SBN   7  1 
3^8W ...         IF       6,E,7               [ EMPTY RECORD, X7=1  
3^9R ...         THEN   
3^=N ...            LDX   0  ACES   
3^?K ...            LDN   7  2                   [ SET TO 4 SPACES  
3^#G ...            SMO      5  
3^*C ...            STO   0  A1+2   
3^B# ...         FI 
3^C9 ...      FI
3^D6 ...)   
3^F=          LDX   2  7
3^YW          STEP  ,0(2),WRBI  
42DG          STO   3  4
42Y6          LDX   3  5
43CQ          TESTREP  FILEFULL,WR9        [J IF FILE FULL  
43XB          TESTREP   REFUSED,WR90       [J IF NO MORE B. S.  
44C2          TESTREP  OK,WR8A             [J IF NOT COORDINATED
44WL          MHUNTW   3,FILE,FAPB  
45B=    WR8A  ADN   3  A1   
45DT ...#SKI G571&1 
45HD ...(   
45L3 ...      ADX   3  6                   [ IF AMORPHOUS, OVERWRITE
45NL ...      STO   7  0(3)                [  2ND RED TAPE WORD WITH 1ST
45R9 ...)   
45TW          SMO      7
46*G          MOVE  3  0                   [MOVE DATA   
46T6          STEP                         [UPDATE READ PTRS
47#Q          LDX   0  IENR(2)             [GET REC COUNT INTO X0   
47SB          LDX   6  IESW(2)             [COLLECT SWITCH WORD 
482L ...      BXL   0  IENL(2),WR10        [J IF NO. OF RECORDS < LIMIT 
488W ...      LDCT  6  #400                [SET LIMIT MESSAGE MARKER
48C6 ...      ORS   6  IENL(2)  
48KB ...      BRN      WR9A 
48RL    WR9   STOZ     IENL(2)  
49?=    WR9A  LDX   6  IESW(2)  
49QW    WR10  LDX   5  IENC(2)             [KEEP NUMBER OF CHARACTERS   
4==G          STOZ     IENC(2)             [CLEAR COUNT 
4=Q6          BPZ   6  WR13                [J IF NOT LISTING
4?9Q          LDCT  7  #200                [ELSE WE ARE LISTING SO...   
4?PB          ANDX  7  IESW(2)  
4#92          SLC   7  5
4#NL          ADX   5  7                   [USING THE NUMBERING SWITCH BIT  
4*8=          ERN   7  #10                 [ADJUST CHARACTER COUNT AND START
4*MW          STO   5  AWORK2(2)           [ADDRESSES SO THAT IT WORKS OUT  
4B7G          SRL   7  2                   [CORRECTLY. THIS AVOIDS A RATHER 
4BM6          LDN   5  A1                  [MESSY BIT OF CODE   
4C6Q          STO   7  AWORK3(2)           [STORE CALCULATED
4CLB          ADS   5  AWORK3(2)           [VALUES  
4D62          CALL  6  RLNF                [RELOCATE OUTPUT BLOCK   
4DKL          LDN   1  0                   [NEEDED BY NS SP CHOPPER 
4F5=          BNZ   7  WR12                [J IF NOT NUMBERING  
4FJW          LDX   7  IENR(2)             [AND OVERWRITE THE RED TAPE  
4G4G          SMO   FX1                    [WORDS WITH  
4GJ6          MPY   7  MNUM                [THE DECIMAL 
4H3Q          LDX   1  IENA(2)             [RECORD NUMBER. WE HAVE TO   
4HHB    #SKI  JDIAG1
4J32    (   
4JGL          ADX   1  IENG(2)  
4K2=          SBN   1  A1+2 
4KFW    )   
4K^G          MODE  1                      [ALLOW FOR THE FACT THAT 
4LF6          LDN   5  6                   [THE FIRST RECORD IS NUMBER  
4LYQ    WR11  CBD   7  A1(1)               [ZERO, ALSO THAT THE NUMBER  
4MDB          BCHX  1  £                   [FIELD IS SEVEN CHARACTERS   
4MY2          BCT   5  WR11                [SO WE HAVE TO INSERT AN EXTRA   
4NCL          MODE  0                      [SPACE AT THE END.   
4NX=          LDN   6  #20  
4PBW          CBD   7  A1(1)               [HAVING DONE THAT WE MUST NOW
4PWG          BCHX  1  £                   [SET UP FOR THE LISTING (LISTING 
4QB6          DCH   6  A1(1)               [CATEGORY IS 4) PS ARE THERE 
4QTQ          NGN   1  8                   [NEEDED BY NS SP CHOPPER 
4R*B    WR12  LDN   7  4                   [STILL REDUNDANT WORDS IN THE
4RT2          LDX   3  IENA(2)             [NOW TO LOP OFF TRAILING 
4S#L          ADX   1  AWORK2(2)           [SPACES.   DONE HERE 
4SS=          ADN   1  3                   [BY SCANNING 
4T?W          SRL   1  2                   [BLOCK BACKWARDS 
4TRG          LDN   4  0                   [AND COUNTING
4W?6    #SKI  JDIAG1
4WQQ    (   
4X=B          ADX   1  3
4XQ2          ADX   1  IENG(2)  
4Y9L          SBN   1  1                   [THE NUMBER  
4YP=    )   
4^8W    #SKI  JDIAG1<1$1
4^NG          ADN   1  A1+1(3)             [THE NUMBER  
5286          LDX   5  ACES                [OF WORDS OF SPACES  
52MQ    WR21  BXU   5  0(1),WR22           [J NOT SPACE 
537B          ADN   4  1                   [COUNT   
53M2          SBN   1  1                   [ADDRESS 
546L          BRN   WR21                   [LOOP
54L=    WR22  LDX   5  AWRK2(2)            [SO GET LENGTH OF RECORD 
555W          LDX   1  AWRK3(2)            [ROUND UP TO WORDS   
55KG    #SKI  JDIAG1
5656    (   
56JQ          ADX   1  IENG(2)  
574B          SBN   1  A1+2 
57J2    )   
583L          ADN   5  3                   [AND SUATRACT THE NUMBER OF  
58H=          SRL   5  2                   [WORDS WITH SPACES THEN  
592W          SBS   4  5                   [CONVERT BACK TO CHARACTERS  
59GG          SLL   5  2                   [C_ULD BE A REC-RD TH_T  
5=26          BPZ   5  WR23                [IS ALL SPQACES AND A NON-   
5=FQ          LDN   5  0                   [INTEGRAL NNUMBER OF WORDS   
5=^B    WR23  OUTMON   5,0(1),7,FILE,FAPB  [SOCK IT TO CLKENT   
5?F2    WR13  CALL  6  RLNF                [FIND THE OUTPUT 
5?YL          LDX   5  AWORK1(2)           [GET THE PFCC FROM THE   
5#D=          LDX   3  IENA(2)             [FILE FAPB AND PUT IT
5#XW          LDN   4  1                   [OF O/P'S RED TAPE   
5*CG    #SKI  JDIAG1
5*X6          STOZ     A1+2(3)             [NULL OUT SEQUENCE WORD  
5BBQ          STO   5  A1+1(3)             [INCREMENT RECORD
5BWB          LDX   0  IENL(2)             [NUMBER AND CHACK THAT   
5CB2          ADS   4  IENR(2)             [THE NEW FILE IS NOT FULL
5CH8          FIXTRA   ESP                 [****EDITOR SPECIAL FOR PLESSEY****  
5CNB          NULL  
5CTL          BNZ   0  WR14                [J NOT FULL  
5D*=          EDERR    YFYN                ['YOUV'E FILLED YOUR NEW FILE'   
5DSW          UP                           [SHUTDOWN EXIT   
5F#G ...WR14  BNG   0  WR15                [J IF REFUSED OR LIMIT EXCEEDED  
5FS6          UPPLUS  2                    [EXIT IN GOOD ORDER  
5FWP ...WR15  LDCT  0  #400                [UNSET REFUSED OR LIMIT EXCEEDED 
5F^# ...      ERX   0  IENL(2)  
5G3X ...      BZE   0  WR17                [J IF BS LIMIT REACHED   
5G6G ...      BXE   0  AZVOLUME,WR16       [J IF LIMIT IS IP VOLUME 
5G95 ...      EDERR    YESL                ['YOU'VE EXCEEDED YOUR SPECIFIED 
5G?N ...                                   [LIMIT'  
5GB? ...      UP                           [SHUTDOWN EXIT   
5GDW ...WR16  EDERR    YEDL                ['YOU'VE EXCEEDED INSTALLATION   
5GHF ...                                   [DEFAULT LIMIT'  
5GL4 ...      UP                           [SHUTDOWN EXIT   
5GNM ...WR17  EDERR    YBSL                ['YOU'VE REACHED YOUR BS LIMIT'  
5GRB          UP                           [SHUTDOWN EXIT   
5H?2    #   
5HQL    WR90  LDCT  7  #400                [IF REFUSED,SET  
5J==          STO   7  IENL(2)             [B0 OF IENL  
5JPW          BRN      WR9A                [AND CONTINUE
5K9G    #   
5KP6    #     IF BREAK-IN WHILE WAITING FOR BACKING STORE:  
5L8Q    WRBI  UPPLUS   1                   [TERMINATING EXIT
5LNB    #   
5M82    #   
5MML    #   
5N7=    #   
5NLW    #     FILE REPOSITION ROUTINE   
5P6G    #     X = REQURED POSITION     Y = CURRENT POSITION 
5PL6    #     FILE NUMBER IS IN AWORK1  
5Q5Q    #     NB  NO ADVANTAGE IS TAKEN OF THE FACT THAT WE 
5QKB    #     COULD REWIND THE FILE BECAUSE WE MAY NOT  
5R52    #     ACTUALLY HAVE THE ABSOLUTE RECORD NUMBERS 
5RJL    #   
5S4=    REPO  LDX   1  AWORK1(2)
5SHW          SBX   6  FX1                  [RELATIVISE LINK
5T3G          SLL   1  1
5TH6          ADX   1  2
5W2Q          LDX   0  IENZ+1(1)            [SWITCH CHARACTER POINTERS  
5WGB          STO   0  IENC(1)  
5X22          LDX   7  IENR(1)  
5XFL          LDX   0  IENZ(1)              [SWITCH RECORD POINTERS 
5X^=          STO   0  IENR(1)  
5YDW          BXE   0  7,REPEX              [J IF X = Y 
5YYG          BXL   0  7,REP3               [J IF X <Y  
5^D6          SBX   0  7                    [ELSE X > Y AND FORWARDS
5^XQ          STO   0  7                    [SO MUST BE OLD FILE
62CB    REP1  LDX   1  AWORK1(2)
62X2          STEP     0(1) 
63BL          BZE   3  REP2                 [J IF HIT EOF   
63W=          BCT   7  REP1 
64*W          BRN      REP6 
64TG    REP2  LDCT  4  #4                   [SET EOF BIT
65*6          ORS   4  IESW(2)  
65SQ          BRN      REP6 
66#B    REP3  SBX   7  0                    [X7 = Y-X   
66S2          LDX   1  AWORK1(2)
67?L          BZE   1  REP4                 [J IF NEW FILE  
67R=          LDCT  4  #4                  [ELSE OLD FILE SO
68=W          ORS   4  IESW(2)             [CLEAR EOF BIT   
68QG          ERS   4  IESW(2)  
69=6          BRN      REP5 
69PQ    REP4  SBN   7  1                    [X7-1 BSP'S FOR N/F 
6=9B          BZE   7  REP6                 [J IF NONE  
6=P2    REP5  LDX   1  AWORK1(2)
6?8L          BACKSPACE 0(1)
6?N=          BCT   7  REP5 
6#7W    REP6  LDX   1  AWORK1(2)
6#MG          READAGAIN 0(1)                [BSP + READ 
6*76          MHUNTW   3,FILE,FRB   
6*LQ          NAME     3,EDIT,FAPB  
6B6B    REPEX ADX   6  FX1  
6BL2          EXIT  6  0
6C5L    #   
6CK=    #   
6D4W    #     THIS CODE EXECUTES GRUEL'S F(*CK) INSTRUCTION 
6DJG    #   
6F46    N9EDWRITE   
6FHQ    #   
6G3B          LDN   6  #3                   [SEE IF F IS CURRENTLY  
6GH2          ANDX  6  IESW(2)              [ALLOWED
6H2L          BZE   6  UCKER                [J IF SO
6HG=          LDN   6  1
6H^W          ORS   6  IESW(2)  
6JFG          EDCOM    TWOF                 [ERROR MESSAGE  
6J^6          BRN      NCK                  [J TO NEXT INSTRUCTION  
6KDQ    UCKER LDN   6  1                    [SET BIT TO SHOW WE HAVE
6KYB          ORS   6  IESW(2)              [JUST ENTERED F MODE
6LD2          STOZ     AWORK1(2)            [FIRST DO NEW FILE  
6LXL          CALL  6  REPO 
6MC=          HUNTW    3,EDIT,FAPB          [SEE IF WE HAVE TO SWAP BLOCKS  
6MWW          BNG   3  UCK                  [J IF NOT   
6NBG          MFREEW   FILE,FAPB
6NW6          NAME     3,FILE,FAPB          [SWAP BLOCKS
6P*Q          STO   3  IENA(2)  
6PTB          PHOTO    5                    [RESET WHERE AND WHEN   
6Q*2          STO   5  IENM(2)  
6QSL          BACKSPACE                     [GET POINTERS CORRECT   
6R#=          LDX   7  IENR(2)             [TO PUT IN EOF MARKER
6RRW          BZE   7  RCK1                [SKIP IF BOF 
6S?G          READAGAIN                    [BSP+READ
6SR6          MHUNTW   3,FILE,FRB   
6T=Q          ADN   3  A1                  [GET PTR TO RECORD   
6TQB          LDX   5  3                   [SAVE
6W=2          BRN   RCK2
6WPL    RCK1  STEP                         [DONT BSP IF BOF 
6X9=    RCK2  LDEX  4  0(3)                [GET LENGTQ LAST RECORD  
6XNW          BACKSPACE                    [REPOSITION FOR REWRITING
6Y8G          CALL  6  SETAPPEND           [RESET APP PTRS TO READ PTRS 
6YN6          LDX   2  4                   [STORED LENGTH   
6^7Q          STEP  ,0(2),UCK              [GET PTR INTO FUWB   
6^MB          BZE   7  RCK3                [J IF BOF
7272          SMO      FX2  
72LL          LDX   0  IENM 
736=          TESTMOVE 0,RCONT  
73KW          MHUNTW   2,FILE,FRB          [RE-FIND RECORD  
745G          ADN   2  A1   
74K6          BRN      RCONTA   
754Q    RCONT LDX   2  5
75JB    RCONTA SMO     FRH(2)              [REWRITE RECORD  
7642          MOVE  2  0                   [AT END OF FILE  
76HL          SBN   2  A1   
773=          FREECORE 2                   [FREE TEMPORARY BLOCK
77GW          STEP                         [UPDATE READ PTRS
782G          BRN   UCK 
78G6    RCK3  STOZ     0(3) 
78^Q    UCK   LDN   6  1                    [NOW DO OLD FILE
79FB          STO   6  AWORK1(2)
79^2          CALL  6  REPO 
7=DL          HUNTW    3,EDIT,FAPB          [SEE IF WE HAVE TO SWAP BLOCKS  
7=Y=          BNG   3  NCK                  [J IF NOT   
7?CW          NAME     3,EDIT,FRB   
7?XG          PHOTO    5
7#C6          STO   3  IEOA(2)              [RESET WHERE AND WHEN   
7#WQ          STO   5  IEOM(2)  
7#X9 ...#SKI G571&1 
7#XN ...(   
7#Y7 ...      LDXC  0  IEOT(2)  
7#YL ...      BCS      UCK3 
7#^5 ...      LDEX  6  A1(3)
7#^J ...      LDN   4  1
7*23 ...      ADX   4  6
7*2G ...      LDX   7  ALOGLEN(3)   
7*2^ ...      BXGE  7  4,UCK1   
7*3D ...      ALTLEN   3,4  
7*3X ...      MHUNTW   3,EDIT,FRB   
7*4B ...      STO   3  IEOA(2)  
7*4T ...      PHOTO    5
7*5# ...      STO   5  IEOM(2)  
7*5R ...UCK1
7*6= ...      LDN   0  #41  
7*6P ...      STO   4  A1(3)
7*78 ...      SBN   4  2
7*7M ...      BZE   4  UCK2 
7*86 ...      LDN   6  A1(3)
7*8K ...      LDN   7  A1+1(3)  
7*94 ...      ADX   6  4
7*9H ...      ADX   7  4
7*=2 ...UCK1A   
7*=F ...      MOVE  6  1
7*=Y ...      SBN   6  1
7*?C ...      SBN   7  1
7*?W ...      BCT   4  UCK1A
7*#* ...UCK2
7*#S ...      STO   0  A1+1(3)  
7**? ...UCK3
7**Q ...)   
7*BB          LDEX  6  A1(3)
7*W2          LDX   7  A1+1(3)              [NOW WE HAVE TO FIND
7B*L          ANDX  7  CACT                 [HOW MANY CHARACTERS
7BT=          SBN   6  3                    [THERE WERE IN THAT 
7C#W          BNZ   7  NCK1                 [BLOCK AND RESET IEOH   
7CSG          ADN   6  1
7D#6    NCK1  SLL   67 2
7DRQ    #SKI  JDIAG1
7F?B    (   
7FR2          LDN   4  #4   
7G=L          ANDX  4  IESW(2)  
7GQ=          BZE   4  NOG                 [J IF NOT GEDIT  
7H9W          LDX   4  A1+2(3)  
7HPG          STOZ     A1+2(3)             [NULL SEQUENCE WORD AS DEFAULT   
7J96          STO   4  IESD(2)             [SAVE NEW SEQUENCE WORD  
7JNQ          SBN   6  8                   [TAKE ACCOUNT OF EXTRA WORDS 
7K8B    NOG 
7KN2    )   
7L7L          STO   6  IEOH(2)  
7LM=    NCK   UP
7M6W    #   
7MLG    # THIS CODE CAUSES THE CURRENT RECORD IN THE OLDFILE TO BE LISTED, I.E. 
7N66    # IT'S THE OUTPUT FOR THE W-FACILITY
7NKQ    N10EDWRITE  
7P5B          LDCT  7  #4                  [FIRST CHECK THAT WE ARE NOT 
7PK2          ANDX  7  IESW(2)             [TRYING TO W FROM OFF EOF
7Q4L          BNZ   7  WR103               [J IF WE ARE 
7QJ=          LDX   3  IEOA(2)  
7R3W          LDX   7  IEOM(2)  
7RHG          TESTMOVE 7,WR100             [CHECK IF BLOCKS MOVED   
7S36          MHUNTW   3,EDIT,FRB   
7SGQ          PHOTO    7
7T2B          STO   3  IEOA(2)             [UPDATE BLOCK ADDRESS AND
7TG2          STO   7  IEOM(2)             [COUNT OF BLOCKS MOVED   
7T^L    #SKI  JDIAG1
7WF=    (   
7WYW    WR100 LDX   4  IEOG(2)  
7XDG          SBN   4  A1+2 
7XY6          SMO      4
7YCQ          LDX   0  A1+1(3)  
7YXB          STO   0  AWORK1(2)           [SAVE REDTAPE WORD   
7^C2          LDX   0  A1+1(3)  
7^WL    )   
82B=    #SKI  JDIAG1<1$1
82TW    WR100 LDX   0  A1+1(3)             [STORE RED TAPE TEMPORARILY  
83*G          LDN   7  0
83T6    #SKI  JDIAG1<1$1
84#Q          STO   0  AWRK1(2) 
84SB          SLL   70 2                   [GET CHAR POINTER
85#2          LDX   5  SPWRD(1) 
85RL          LDEX  0  A1(3)               [RECORD LENGTH IN WORDS  
86?=    #SKI  JDIAG1
86QW          SMO      4
87=G          STO   5  A1+1(3)  
87Q6          ADN   3  A1-1 
889Q          ADX   3  0                   [X3 => LAST WORD IN RECORD   
88PB    WR101 LDX   6  0(3)                [WE NOW SCAN THE RECORD BACKWARDS
8992          BXU   6  ACES,WR102          [CHOPPING OFF TRAILING SPACES
89NL          SBN   3  1                   [LOSES SPACE WORDS   
8=8=          LDN   7  0                   [END CHARS DON'T MATTER  
8=MW          BRN   WR101   
8?7G    WR102 SBX   3  IEOA(2)  
8?M6    #SKI  JDIAG1
8#6Q          SMO      4
8#LB          SBN   3  A1   
8*62          SLL   3  2
8*KL          BZE   7  WR104               [NO ODD CHARS AT END 
8B5=          ADX   3  7                   [ELSE ADJUST 
8BJW          SBN   3  4                   [CHARACTER COUNT 
8C4G    WR104 LDN   5  4                   [X5 = %C OF OUTMON(CATEGORY) 
8CJ6    #SKI  JDIAG1
8D3Q    (   
8DHB          SMO      4
8F32          LDN   6  A1+1                [START ADDRESS   
8FGL          OUTMONX  3,6,5,EDIT,FRB   
8G2=    )   
8GFW    #SKI  JDIAG1<1$1
8G^G          OUTMON   3,A1+1,5,EDIT,FRB
8HF6          LDCT  7  #20  
8HYQ          ORS   7  IESW(2)             [SET B4 TO SHOW LISTED   
8JDB          MHUNT    3,EDIT,FRB   
8JY2          LDX   0  AWRK1(2) 
8KCL    #SKI  JDIAG1
8KX=          SMO      4
8LBW          STO   0  A1+1(3)             [REPLACE RED TAPE
8LWG    WR103 UP
8MB6    #   
8MTQ    # THIS IS ACTION FOR JT EXCEEDED OR JOB ABANDONED   
8N*B    #   
8NT2    N11EDWRITE  
8P#L          OUTBLOCN 6
8PS=          OUTNUM IEOR(2),0             [PARAMETERS FOR  
8Q?W          OUTNUM IENR(2),0             [MONOUT  
8QRG          MONOUT   FILEUP              [MESSAGE SAYS WHERE EDIT HALTED  
8R?6          EDERR EDAB                   ['EDIT ABANDONED'
8RQQ          LDCT  0  #400                [SWITCH OFF L
8S=B          ORS   0  IESW(2)  
8SQ2          ERS   0  IESW(2)  
8T9L          ACROSS   EDITPT,2            [SIMULATE 'E'
8TP=    #   
8W8W     MENDAREA 100,K100EDWRITE   
8WNG    #END
^^^^ ...00063062000500000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1