*M*      UPDAT    RESEQUENCE AND ORDER A METASYMBOL UPDATE FILE
*P*      NAME:    UPDAT
*P*      AUTHOR:  RICK ACE
*P*      DATE:    DEC 1976 - JAN 1977
*P*      PURPOSE: THIS PROGRAM WILL READ A METASYMBOL UPDATE FILE
*P*               THROUGH THE F:1 DCB, SORT IT BY THE LINE NUMBERS ON
*P*               THE 'PLUS' CARDS, AND OUTPUT THE SORTED FILE TO THE
*P*               F:3 DCB.  VARIOUS INTEGRITY CHECKS ARE ALSO PERFORMED
*P*               UPON THE CONTENTS OF THE INPUT FILE.
         PCC
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
STAKSIZE EQU      32                # OF WORDS IN STACK
         REF      SCAN:C
         TITLE    'U P D A T '
*
*        PRINT - WRITE TEXT STRING TO M:LL
*        CRAP  - WRITE TEXT STRING TO M:LL AND ABORT JOB
*
CRAP     CNAME    R10,CRAPOUT
PRINT    CNAME    R7,PRINTR
         PROC
LF       BAL,NAME(1) NAME(2)
         LIST     0
         TEXTC    AF
         LIST     1
         PEND
         TITLE    'D A T A'
STAK     DATA     STAKAREA-1        UNIVERSAL STACK
         GEN,16,16 STAKSIZE,0
*
*   END OF BOUND 8 DATA
*
STAKAREA RES      STAKSIZE
NEXTREC  DATA     1                 # OF NEXT REC TO BE READ FROM F:1
ENDF     DATA     0                 SET TO 1 WHEN +END IS HIT
PLUSEND  TEXT     '+END'
BLANK    TEXT     '        '
M16      DATA     X'FFFF'
D10      DATA     10
D1000    DATA     1000
#OVLAP   DATA     -1                COUNT FOR # OF OVERLAPS FOUND
#PCARDS  DATA     0                 # OF PLUSCARDS (NOT COUNTING +END)
PLUSENDP DATA     0                 RECORD # OF +END CARD
PLUSTBL  DATA     0                 ADDRESS OF +CARD DATA TABLE IN CORE
WKEY     DATA     X'03000000'       KEY FOR WRITING OUTPUT FILE
SBUF     TEXT     '   XXXX.XXX '    MUST PRECEDE BUF1
BUF1     RES      64+1              CARD INPUT BUFFER
HEX      TEXT     '0123456789ABCDEF'
TB       TEXTC    ' '
XXMSG    TEXTC    '* ERR/ABN ON F:1 DCB -- CODE = XXXX'
,F3OFPT,F3OVLP ;
         M:OPEN   F:3,KEYED,SEQUEN,SAVE,OUT,FILE,(KEYM,3),;
                  (ABN,F3X),(ERR,F3X)
F3FPT    RES      F3OVLP-F3OFPT
FP       RES      90                FPARAM BUFFER
         TITLE    'P H A S E - I     SCAN INPUT FILE FOR + CARDS'
*
*        P H A S E - I
*        =============
*
START    CSECT    1
         DEF      START
*
*        OPEN FILES
*
         LI,R8    F3TVLP
         BAL,R14  SCAN:C
,,F3TVLP M:OPEN   F:3,IN,FILE,PASS,TEST,(FPARAM,FP),;
                  (ERR,F1X),(ABN,F1X)
         LI,R1    -15
         LW,R12   F3TVLP+15,R1
         STW,R12  F1OVLP+15,R1
         BIR,R1   %-2
         LI,R1    -(F3OVLP-F3OFPT)
         LW,R12   F3OFPT+(F3OVLP-F3OFPT),R1
         STW,R12  F3FPT+(F3OVLP-F3OFPT),R1
         BIR,R1   %-2
         M:OPEN,E F3FPT
,,F1OVLP M:OPEN   F:1,IN,FILE,PASS,(ABN,F1X),(ERR,F1X)
*
*        PHASE 1 REGISTERS:
*
*        R2:  ARS OF CURRENT RECORD BEING PROCESSED
*        R3:  CURRENT POINTER INTO +CARD TABLE
*        R12: CURRENT CARD # WITHIN INPUT DECK
*        R13: # OF CARDS IN CURRENT REGION
*        R14: RECORD # OF START OF CURRENT REGION
*
,GET1    M:GP     1                 GET CORE PAGE
         BCS,8    NOCORE
         STW,R9   PLUSTBL           REMEMBER + CARD TABLE ADDR
         LI,R3    0                 ZAP + CARD COUNT
         LI,R12   0                 ZAP CARD COUNT
         PAGE
*
*        READ NEXT CARD
*
NEXT1    BAL,R7   READNEXT          READ NEXT RECORD FROM INPUT FILE
         B        PH1EOF            BRANCH IF EOF
         AI,R12   1                 BUMP RECORD COUNT
         LW,R0    ENDF              WAS PREVIOUS CARD +END?
         BEZ      NOTPLEND          NO
         CRAP     'MORE CARDS FOLLOW THE ''+END'' CARD'
NOTPLEND EQU      %
*
*        APPEND TRAILING BLANK
*
         LI,R0    ' '
         STB,R0   BUF1,R2           INSTALL TRAILING BLANK FOR SCAN
         LB,R0    BUF1
         CI,R0    '+'               IS THIS A PLUSCARD?
         BE       PLUSCARD          YES
*
*        CARD IS NOT A PLUSCARD
*
NOTPLUS  RES      0
         CI,R12   1                 1ST CARD?
         BNE      COUNTCRD          NO
         CRAP     'FIRST CARD IS NOT A PLUS CARD'
COUNTCRD AI,R13   1                 BUMP COUNT FOR THIS REGION
         B        NEXT1             RESUME SCAN
*
*        THE CARD IS A PLUSCARD (THE MAN'S INSATIABLE)
*
PLUSCARD RES      0
         LH,R0    BUF1              CHECK FOR "+*"
         CI,R0    '+*'              SIGN EXTENSION NOT SIGNIFICANT
         BE       NOTPLUS           GOT PLUS CARD COMMENT
         MTW,1    ENDF              ANTICIPATE +END
         LW,R0    BUF1
         CW,R0    PLUSEND           IS IT +END?
         BE       SKIPSCAN          YES->SKIP LINE # SCAN
         MTW,-1   ENDF              OH WELL, IT WASN'T; RESET FLAG
*
*        NOT +END; SCAN LINE NUMBER RANGE
*
         MTW,1    #PCARDS           COUNT IT
         LI,R6    1                 SET UP SCAN INDEX
         BAL,R7   SCAN#             GET 1ST #
         LW,R15   R9                COPY #1
         CI,R5    ','               #1,#2?
         BE       #1#2              YES
         LI,R9    -1                ASSUME #1
         CI,R5    ' '               MUST BE #1 ONLY THEN
         BE       MERGE             YES
SYNTAX   BAL,R7   SNAP              SNAP BAD LINE TO LL DEVICE
         CRAP     'ILLEGAL UPDATE CARD SYNTAX'
#1#2     BAL,R7   SCAN#             GET #2
         CI,R5    ' '               BETTER END WITH BLANK
         BNE      SYNTAX            NO->ERROR
         CW,R15   R9                #1 > #2?
         BLE      MERGE             NO->OK
         BAL,R7   SNAP              DISPLAY BAD CARD
         CRAP     'LINE # 1 GREATER THAN LINE # 2'
MERGE    STH,R9   R15               MERGE #1 & #2
SKIPSCAN EQU      %
*
*        PUT ENTRY IN TABLE
*
         STH,R14  R13               MERGE START & SIZE OF PREV REGION
         AI,R3    1
         STW,R13  *PLUSTBL,R3       STASH 'EM
         AI,R3    1
         CI,R3    X'1FF'            NEED A NEW PAGE?
         BANZ     HAVECORE          NO
         CAL1,8   GET1              YES->GET IT
         BCR,8    HAVECORE          BRANCH IF I GOT IT
NOCORE   CRAP     'INSUFFICIENT PHYSICAL MEMORY'
HAVECORE STW,R15  *PLUSTBL,R3       STASH LINE # RANGE FOR THIS +CARD
*
*        RESET REGION POINTERS
*
         LW,R14   R12               SET NEW REGION START
         LI,R13   1                 SET NEW REGION COUNT
         B        NEXT1             GO ON TO NEXT CARD
         PAGE
*
*        EOF HIT ON INPUT FILE
*
PH1EOF   EQU      %
*
*        COMPUTE AND SAVE RECORD # OF +END CARD
*
         LW,R0    NEXTREC
         AI,R0    -1                COMPUTE REC # OF +END CARD
         STW,R0   PLUSENDP          STASH IT
*
*        MAKE SURE THAT THE LAST CARD READ WAS A +END
*
         LW,R0    ENDF              WAS THE LAST CARD +END ?
         BGZ      PHASE2            YES->PHASE I COMPLETE
         CRAP     'LAST CARD IN DECK IS NOT ''+END'''
         TITLE    'P H A S E - I I     CHECK FOR OVERLAPPING + CARDS'
*
*        P H A S E - I I
*        ===============
*
PHASE2   EQU      %
*
*        REWIND INPUT FILE
*
         M:REW    F:1               REWIND DCB
         LI,R0    1
         STW,R0   NEXTREC           RESET DCB RECORD POINTER
*
*        PHASE 2 REGISTERS:
*
*        R3:  MAJOR TEST INDEX (+A,B)
*        R4:  MINOR TEST INDEX (+C,D)
*        R10: START RECORD FOR +A,B
*        R11: START RECORD FOR +C,D
*        R12: A
*        R13: B
*        R14: C
*        R15: D
*
         SPACE
*
*        LOAD R3 AND CHECK IF OVERLAP TEST IS NEEDED
*
         LW,R3    #PCARDS           ANY + CARDS?
         BEZ      WRTEND            NO->JUST WRITE +END
*
*        BEGIN OVERLAP CHECK
*
COMP1    LW,R4    R3                LOAD MINOR INDEX
         AI,R4    -1                DON'T CHECK AGAINST MYSELF
         BEZ      PH2END            BRANCH IF OVLAP TESTS COMPLETE
*
*        LOAD MAJOR REGISTERS
*
         LD,R12   *PLUSTBL,R3       GET DATA FOR MAJOR +CARD
         LH,R10   R13               LOAD START REC #
         LH,R13   R12               LOAD B
         AND,R12  M16               LOAD A
         PAGE
*
*        BEGIN MINOR COMPARISON LOOP
*
COMP2    LD,R14   *PLUSTBL,R4       GET DATA FOR MINOR +CARD
         LH,R11   R15               LOAD START REC #
         LH,R15   R14               LOAD D
         AND,R14  M16               LOAD C
         AI,R15   0                 WHICH FORM?
         BLZ      OC                +C
         AI,R13   0                 +C,D FORM... TEST MAJOR FORM
         BLZ      OACD              +A / +C,D
*
*        +A,B  +C,D
*
         CW,R12   R15               A > D ?
         BG       COMP2F            YES
         CW,R14   R13               C > B ?
         BG       COMP2F            YES
         B        OVLAP             OVERLAP
*
*        +A  +C,D
*
OACD     CW,R12   R14               A < C ?
         BL       COMP2F            YES
         CW,R12   R15               A > D ?
         BG       COMP2F            YES
         BL       OVLAP             A < D
         CW,R12   R14               A = D;  A > C ?
         BG       COMP2F            YES
         B        OVLAP
*
*        +C
*
OC       AI,R13   0                 TEST MAJOR FORM
         BLZ      OAC               +A
*
*        +A,B  +C
*
         CW,R14   R12               C < A ?
         BL       COMP2F            YES
         CW,R14   R13               C > B ?
         BG       COMP2F            YES
         BL       OVLAP             C < B
         CW,R14   R12               C = B;  C > A ?
         BG       COMP2F            YES
         B        OVLAP
*
*        +A  +C
*
OAC      CW,R12   R14               A = C ?
         BNE      COMP2F            NO
*        B        OVLAP             OVERLAP
         PAGE
*
*        OVERLAPPING SEQUENCE NUMBERS HAVE BEEN DETECTED
*
OVLAP    EQU      %
         MTW,1    #OVLAP            1ST TIME?
         BGZ      OV1               NO
,SKIP    M:PRINT  (MESS,TB)         SKIP A LINE
         PRINT    'OVERLAPPING SEQUENCE NUMBERS:'
OV1      CAL1,2   SKIP
         LW,R8    R11               PRINT MINOR LINE
         BAL,R7   POS
         BAL,R7   READNEXT
         B        LE                EOF
         BAL,R7   SNAP
         LW,R8    R10               PRINT MAJOR LINE
         BAL,R7   POS
         BAL,R7   READNEXT
         B        LE                EOF
         BAL,R7   SNAP
*
*        ADVANCE TO NEXT MINOR CARD
*
COMP2F   BDR,R4   COMP2             LOOP IF ANY MORE MINORS
         BDR,R3   COMP1             DO NEXT MAJOR (ALWAYS BRANCHES)
*
*        END OF OVERLAP TESTS
*
PH2END   LW,R0    #OVLAP            ANY OVERLAPPERS?
         BLZ      PHASE3            NO->ALL SYSTEMS GO FOR PHASE 3
         CRAP     ' '               OH WELL, I TRIED
         TITLE    'P H A S E - I I I     SORT PLUSCARD TABLE IN CORE'
*
*        P H A S E - I I I
*        =================
*
PHASE3   EQU      %
*
*        PHASE 3 REGISTERS:
*
*        R4:  INDEX TO LOWER +CARD IN TABLE
*        R5:  INDEX TO UPPER +CARD IN TABLE
*        R6:  DISTANCE (D) BETWEEN LOWER AND UPPER +CARDS
*        R7:  COUNT OF # OF EXCHANGES FOR CURRENT PASS PLUS 1
*        R12,13: LOWER +CARD DATA
*        R14,15: UPPER +CARD DATA
*
         LW,R6    #PCARDS
         CI,R6    1                 DO I NEED TO SORT?
         BE       PHASE4            NO
         SLS,R6   -3                COMPUTE STARTING D = N/8
*
*        BEGIN NEXT SORT PASS: MODIFY D AND LOAD R4,R5,R7
*
SRT0     AI,R6    -1                DECREMENT D
         BGZ      %+2
         LI,R6    1                 DON'T GO BELOW 1
         LI,R4    0
         LW,R5    R6
         LI,R7    1
*
*        COMPARE (AND MAYBE SWAP) NEXT PAIR OF +CARDS
*
SRT1     AI,R4    1
         AI,R5    1
         CW,R5    #PCARDS           END OF PASS?
         BLE      %+2               NO
         B        SRT3              YES (SPEED)
         LD,R12   *PLUSTBL,R4       GET LOWER
         LD,R14   *PLUSTBL,R5       GET UPPER
         INT,R9   R12               EXTRACT LOWER #
         INT,R11  R14               EXTRACT UPPER #
         CW,R9    R11               LOWER > UPPER ?
         BG       SRT1              YES->NO SWAP
         AI,R7    1                 LOWER<UPPER  *** MUST SWAP ***
         STD,R12  *PLUSTBL,R5
         STD,R14  *PLUSTBL,R4
         B        SRT1
*
*        END OF PASS; CHECK IF MORE PASSES NEEDED
*
SRT3     BDR,R7   SRT0              STAY IN IF ANY SWAPS WERE MADE
         CI,R6    1                 AM I SURE TABLE IS IN ORDER?
         BG       SRT0              NO->STAY IN
         TITLE    'P H A S E - I V     OUTPUT SORTED UPDATE FILE'
*
*        P H A S E - I V
*        ===============
PHASE4   EQU      %
*
*        TRANSFER CARDS FROM INPUT FILE TO OUTPUT FILE
*
         LW,R6    #PCARDS           INDEX INTO PLUSTBL
WRT1     LD,R10   *PLUSTBL,R6       GET +CARD DATA
         LH,R8    R11
         BAL,R7   POS               POSITION F:1 DCB
         AND,R11  M16               ISOLATE RECORD COUNT FOR REGION
WRT2     BAL,R7   READNEXT          READ RECORD
         B        LE
         BAL,R7   WRTREC            WRITE IT
         BDR,R11  WRT2              FINISH THIS REGION
         BDR,R6   WRT1              FINISH THE +CARD LIST
*
*        WRITE +END CARD
*
WRTEND   LW,R8    PLUSENDP
         BAL,R7   POS               POSITION BEFORE +END
         BAL,R7   READNEXT
         B        LE
         BAL,R7   WRTREC
*
*        CLOSE DCBS AND EXIT
*
         M:CLOSE  F:1
         M:CLOSE  F:3,SAVE
         CAL1,9   1
         TITLE    'S U B R O U T I N E S'
***********************************************************************
*F*      NAME:    CRAPOUT
*F*      PURPOSE  PRINT TEXT ON M:LL AND ABORT PROGRAM
*F*      INPUT    R10: WORD ADDRESS OF TEXTC STRING
*F*      RETURNS  NONE; PROGRAM ABORTS (BATCH) OR EXITS (ONLINE)
***********************************************************************
         SPACE
CRAPOUT  M:PRINT  (MESS,*R10)
         CAL1,2   SKIP
         PRINT    'UPDAT ABORT'
         LC       *X'4F'
         BCS,12   %+2               MODE?
         CAL1,9   3                 BATCH->ABORT JOB
         CAL1,9   1                 ONLINE->JUST EXIT
         PAGE
***********************************************************************
*F*      NAME:    F1X, F3X
*F*      PURPOSE  EDIT AN ERROR OR ABNORMAL CODE FROM F:1 OR F:3 DCB
*F*               INTO EBCDIC AND DISPLAY IT ON THE LL DEVICE.
*F*               THE PROGRAM WILL TERMINATE.
*F*      INPUT    R8:  INTACT FRON ERR/ABN RETURN
*F*               R10: INTACT FROM ERR/ABN RETURN
*F*      RETURNS  NONE; EXIT IS MADE THROUGH CRAPOUT
*F*      INTFCE   CRAPOUT
***********************************************************************
         SPACE
F3X      MTB,2    XXMSG+4           CHANGE MESSAGE TO READ 'F:3'
F1X      EQU      %
*
*        EDIT CODE & SUBCODE INTO BUFFER
*
         LW,R2    R10               COPY CODE
         SLD,R2   -24
         SLS,R3   -1                ADJUST SUBCODE
         SLD,R2   -8                MERGE 'EM
         LI,R1    -4                # OF DIGITS
EDH      LI,R2    0
         SLD,R2   4                 GET NIBBLE
         LB,R2    HEX,R2            GET EBCDIC
         STB,R2   XXMSG+9,R1        STASH
         BIR,R1   EDH
         LI,R10   XXMSG
         B        CRAPOUT           GIVE MESSAGE & QUIT
         PAGE
***********************************************************************
*F*      NAME:    POS
*F*      PURPOSE  POSITION F:1 DCB IMMEDIATELY BEFORE A SPECIFIED
*F*               RECORD IN THE INPUT FILE
*F*      LINK     R7
*F*      INPUT    R8:  RECORD NUMBER (COUNTING FROM 1) AT WHICH DCB
*F*                    IS TO BE POSITIONED
***********************************************************************
         SPACE
POS      EQU      %
         LCI      4
         PSM,R8   STAK              SAVE REGS
         LI,R10   X'10'             ASSUME REVERSE POSITIONING NEEDED
         XW,R8    NEXTREC           INSTALL NEW NEXT RECORD, GET OLD
         SW,R8    NEXTREC           WHAT KIND OF POSITIONING REQUIRED?
         BEZ      NOPOS             NONE
         BGZ      POSR              REVERSE
         LCW,R8   R8                FORWARD; GET ABS VALUE IN R8
         LI,R10   0                 CORRECT BIT FOR FORWARD
POSR     EQU      %
*
*        SET UP FPT FOR POSITIONING OPERATION
*
         LI,R11   X'10'
         STS,R10  PRECF+1           INSTALL DIRECTION
         STW,R8   PRECF+2           INSTALL # OF RECORDS
,PRECF   M:PRECORD F:1,(ABN,LE),(N,0)
NOPOS    B        PULL4B1           RESTORE REGS AND EXIT
*
*        ABNORMAL RETURN FROM POSITIONING OPERATION
*
LE       CRAP     'LOGIC ERROR IN UPDAT PROGRAM - SEE R7'
         PAGE
***********************************************************************
*F*      NAME:    PRINTR
*F*      PURPOSE  PRINT A TEXT STRING ON M:LL AND RETURN TO THE 1ST
*F*               WORD FOLLOWING THE TEXT STRING
*F*      CALL     [lf]    PRINT    'text'
*F*      LINK     R7
*F*      INPUT    R7:  WORD ADDRESS OF TEXT
*F*      RETURNS  TO 1ST WORD AFTER TEXT STRING
***********************************************************************
         SPACE
PRINTR   EQU      %
         LCI      4
         PSM,R8   STAK              SAVE REGS
         M:PRINT  (MESS,*R7)        PRINT MESSAGE
         LB,R8    *R7               GET # BYTES
         SLS,R8   -2                COMPUTE # OF WORDS
         AW,R7    R8                R7 = ADDR OF LAST WORD OF TEXT
         B        PULL4B2           RETURN 1,R7
         PAGE
***********************************************************************
*F*      NAME:    READNEXT
*F*      PURPOSE  READ THE NEXT RECORD IN THE INPUT FILE INTO BUF1
*F*      LINK     R7
*F*      OUTPUT   R2:  # OF BYTES IN RECORD (BAL+2 RETURN ONLY)
*F*      RETURNS  BAL+1: END-OF-FILE ENCOUNTERED
*F*               BAL+2: RECORD READ SUCCESSFULLY
***********************************************************************
         SPACE
READNEXT EQU      %
         LCI      4
         PSM,R8   STAK              SAVE SYSTEM REGS
         M:READ   F:1,(BUF,BUF1),(SIZE,256),(ABN,XX1),(ERR,XX1)
         MTW,1    NEXTREC           BUMP NEXT RECORD #
         LH,R2    F:1+4
         SLS,R2   -1                R2 = ARS
PULL4B2  LCI      4                 READ SUCCESSFUL; EXIT
         PLM,R8   STAK
         B        1,R7              GOOD RETURN
*
*        ERROR OR ABNORMAL ENCOUNTERED ON READ
*
XX1      LB,R9    R10               GET CODE
         CI,R9    7                 RECORD TOO BIG FOR BUFFER?
         BE       *R8               YES->IGNORE
         CI,R9    6                 EOF HIT?
         BNE      F1X               NO->I DON'T RECOGNIZE THIS ERROR
PULL4B1  LCI      4                 EOF HIT
         PLM,R8   STAK
         B        0,R7              EOF RETURN
         PAGE
***********************************************************************
*F*      NAME:    SCAN#
*F*      PURPOSE  INTERPRET A LINE NUMBER FROM A PLUSCARD
*F*      LINK     R7
*F*      INPUT    R6:  BYTE INDEX INTO BUF1 FOR START OF #
*F*      OUTPUT   R5:  CHARACTER AFTER #
*F*               R6:  POINTING 2 BYTES AFTER LAST DIGIT OF #
*F*               R9:  NUMBER IN HEX
***********************************************************************
         SPACE
SCAN#    LI,R9    0                 ZAP ACC
         LB,R5    BUF1,R6           GET 1ST DIGIT (?)
         AI,R5    -'0'              IS IT A DIGIT?
         BLZ      SYNTAX            NO->SYNTACTICAL ERROR
SCAN#1   LB,R5    BUF1,R6           GET DIGIT
         AI,R6    1                 BUMP POINTER
         CI,R5    '0'               DIGIT?
         BL       0,R7              NO->RETURN
         AI,R5    -'0'              DUMP ZONE
         MI,R9    10                SHIFT
         AW,R9    R5                MERGE
         B        SCAN#1            LOOP THRU #
         PAGE
***********************************************************************
*F*      NAME:    SNAP
*F*      PURPOSE  DISPLAY A RECORD IN BUF1 AND ITS EDIT KEY ON M:LL
*F*      LINK     R7
*F*      INPUT    R2:  # OF BYTES IN RECORD
***********************************************************************
         SPACE
SNAP     EQU      %
         LCI      5
         PSM,R7   STAK              SAVE REGS
         LI,R8    X'20'
         AND,R8   F:1+5             IS F:1 A KEYED FILE?
         BEZ      SN1               NO->DON'T EDIT THE KEY #
*
*        EDIT KEY # INTO EBCDIC IN 'SBUF'
*
         LCI      2
         LM,R8    BLANK
         STM,R8   SBUF              BLANK OUT TEXT KEY BUFFER
         LI,R8    -1
         SLD,R8   -40               R8=0, R9=M24
         AND,R9   *F:1+10           EXTRACT EDIT LINE # FROM KEY
         DW,R8    D1000
         MI,R9    10000
         AW,R9    R8                XXXXXXX --> XXXX0XXX
         AI,R9    1000              XXXX0XXX --> XXXX1XXX  START SIGNIF
         LI,R7    BA(SBUF)+10       START EDIT HERE
SN2      LI,R8    0
         DW,R8    D10               EXTRACT DIGIT
         AI,R8    '0'
         STB,R8   0,R7              STORE DIGIT
         AI,R7    -1
         AI,R9    0                 MORE DIGITS?
         BNEZ     SN2               YES
         LI,R7    7                 INDEX DECIMAL POINT
         LI,R8    '.'
         STB,R8   SBUF,R7           INSTALL IT
*
*        COMPUTE SIZE AND WRITE RECORD
*
SN1      LW,R7    R2                COPY SIZE
         AI,R7    12                ADD IN SBUF SIZE
         M:WRITE  M:LL,(BUF,SBUF),(SIZE,*R7),WAIT
         LCI      5
         PLM,R7   STAK
         B        0,R7
         PAGE
***********************************************************************
*F*      NAME:    WRTREC
*F*      PURPOSE  WRITE RECORD FROM BUF1 TO OUTPUT FILE WITH THE NEXT
*F*               INTEGRAL EDIT KEY NUMBER.
*F*      LINK     R7
*F*      INPUT    R2:  BYTE COUNT OF RECORD
***********************************************************************
         SPACE
WRTREC   EQU      %
         LCI      4
         PSM,R8   STAK              SAVE REGS
         LI,R8    1000
         AWM,R8   WKEY              INCREMENT KEY
         M:WRITE  F:3,(BUF,BUF1),(SIZE,*R2),(ABN,F3X),(ERR,F3X),;
                      (KEY,WKEY),NEWKEY
         B        PULL4B1           PULL REGS & RETURN TO BAL+1
         TITLE    'D C B S'
*
*        D C B ' S
*        =========
*
F:1      DSECT
F:1      M:DCB    FILE,READ,WRITE,PASS,SN
F:3      DSECT
F:3      M:DCB    FILE,READ,WRITE,PASS,SN
         END      START
