*DECK,STRNG 
          IDENT  BASTRNG
          TITLE   BASTRNG 
*CALL COPYRITE
         IPARAMS
          COMMENT BASIC 3 - STRING ROUTINES.
*CALL LIPARAM 
          ENTRY  BASACSV,BATACSV
          ENTRY  BASACVS,BATACVS
          ENTRY  BASXDIS,BATXDIS   DIS
          ENTRY  BASXLEN,BATXLEN   LEN
          ENTRY  BASXVAL,BATXVAL   VAL
          ENTRY  BASXSBS,BATXSBS   SUBSTR 
          ENTRY  BASXSBT,BATXSBT   SUBSTR (PSEUDO-VBL)
          ENTRY  BASTRCN,BATTRCN
          ENTRY  BASANSR,BATANSR
*CALL LIPARAM 
          ENTRY  BASXRPT,BATXRPT
          EXT    BASXCHR,BATXCHR   CHR$ FUNCTION
          EXT    CVSCALL           BASACVS STRING FLAG
* 
          EXT    BASICON
          EXT    INPBUFF
          EXT    SKIPEOL
          EXT    OBUFLCL           USED FOR UNPACKING (NUMERIC) STRINGS 
          EXT    ASCORD 
          EXT    ASCII             ASCII MODE SWITCH
          ENTRY  BASTORD,BASXORD  ORD FUNCTION
          ENTRY  BASACMP,BATACMP
          EXT       BASEGEN 
          EXT    RNBLOCK,RNLIST,DBUGON
          EXT    ER168
          EXT    COMRUNS     COMPILE VS RUNTIME SWITCH
          ENTRY  STRBFAD
           EXT   FFCLASS            SEE BASICON 
          EXT    MEMUP
          EXT    BASSMFI      ADDR OF 1ST ITEM IN STRNG BUFFER
          EXT    BASSMLI      ADDR OF LAST ITEM IN STRNG BUFFER 
          EXT    BASSMLM      ADDR-1 OF LAST USABLE WORD IN STRNG BUFFER
          EXT    BASSMGA           AVE OF GET STRING LENGTHS
          EXT    BASSMTG           TOTAL NO. OF GARBAGE WORDS 
          EXT    BASANSI,BASCOLL
* 
          EXT    FFCHANL
* 
 ACTR     EQU    64B
 LWPR     EQU    65B
* 
*         EQUATES FOR STRING ROUTINES.
 A        EQU    1           FOR SYMBOLIC REFERENCE TO A1/X1. 
 B        EQU    2           FOR SYMBOLIC REFERENCE TO A2/X2. 
 BSTRLEN  EQU    131070D+1   MAX STRING CHAR LENGTH + 1.
 BSTRWDS  EQU    13107D      MAX STRING WORD LENGTH.
 C        EQU    3           FOR SYMBOLIC REFERENCE TO A3/X3. 
 CHAR     EQU    6           BITS PER CHARACTER.
 CHSWD    EQU    10D         CHARACTERS PER WORD (OF LENGTH CHAR).
 EOB      EQU    100B 
 EOSB     EQU    101B        END-OF-STRING FLAG.
 ESC1     EQU    74B         ESCAPE CODE 1. 
 ESC100   EQU    ESC1*100B
 ESC2     EQU    76B         ESCAPE CODE 2. 
 ESC200   EQU    ESC2*100B
 I        EQU    4           FOR SYMBOLIC REFERENCE TO A4/X4. 
 J        EQU    5           FOR SYMBOLIC REFERENCE TO A5/X5. 
 KBLNK    EQU    1R          CODE FOR BLANK.
 OBUFLMT  EQU    31D         BUFFER LENGTH + 1. 
 TYPES    EQU    3
 WORD     EQU    CHAR*CHSWD  NUMBER OF BITS PER WORD. 
 Y        EQU    6           FOR SYMBOLIC REFERENCE TO A6/X6. 
 Z        EQU    7           FOR SYMBOLIC REFERENCE TO A7/X7. 
  
  
 SAVB4    BSSZ   1
 SAVB6    BSSZ   1
 SAVB7    BSSZ   1
 IPRMSIZ  BSSZ   1                  SPECIFIED START POSITION
 JPRMSIZ  BSSZ   1                  SPECIFIED NO OF CHARS (SUBSTR)
 TRGTEOS  BSSZ   1                  1/0 ACCORDING AS -EOS- MET/NOT MET
*                                  DURING TARGET STRING SUBSTR SCAN 
 SUBSTAT  BSSZ   1                 1/0 ACCORDING AS -ESC- MODE IS ON/OFF
 SAVEY     BSSZ  1                 PARTIAL MERGED TARGET INDICATORS 
 SAVEB51  BSSZ   1
 SAVEB61  BSSZ   1
* 
 SAVSWD   BSSZ   1                 ORIGINAL (TARGET) SOURCE FRAGMENT
 SAVSBNO  BSSZ   1                 ASSOCIATED BYTE COUNT
 SAVSOFF  BSSZ   1                 ASSOCIATED OFFSET FROM (ORIGINAL) ADR
* 
* 
*CALL LCORE 
*CALL,ERMNUM
* 
* 
*         ERROR-MESSAGES
* 
* 
 ERM163   DATA   C* ARRAY TOO SMALL IN CHANGE * 
 ERM164   DATA   C* ERROR IN CHANGE*
 ERM165   DATA   C* ILLEGAL CHARACTER * 
 ERM167   DATA   C* NON-NUMERIC OR NULL STRING *
 ERM169   DATA   C* ILLEGAL SUBSTR PARAMETER *
 ERM194   DATA   C* ILLEGAL ORD ARGUMENT *
ERM191    DATA   C* ILLEGAL RPT$ PARAMETER *
* 
 ER163    BSS    0
          RTERROR ERMN163,ERM163,BASEGEN   *ARRAY TOO SMALL * 
* 
 ER164    BSS    0
          RTERROR ERMN164,ERM164,BASEGEN   *INVALID LENGTH *
* 
 ER165    BSS    0
          RTERROR ERMN165,ERM165,BASEGEN   *ILLEGAL CHARACTER * 
 ER167    BSS    0
          RTERROR ERMN167,ERM167,BASEGEN   *NON-NUMERIC STRING *
* 
 ER169    BSS    0
          RTERROR ERMN169,ERM169,BASEGEN   *ILLEGAL SUBTRS PARAM *
* 
* 
 ER194    BSS    0           *ILLEGAL ORD ARGUMENT* 
          RTERROR  ERMN194,ERM194,BASEGEN 
ER191     BSS    0
          RTERROR ERMN191,ERM191,BASEGEN   *ILLEGAL RPT$ PARAM *
          TITLE  ASSIGN STRING ROUTINE (BASASTR)
          EXT    BASASTR
          TITLE  BASXORD/BASTORD - ORD FUNCTION.
          CON    10HBASTORD 
  
 BASTORD  PS                 ENTRY/EXIT FOR *ORD* 
          RJ     =XBASSBR=   SAVE REGISTERS 
          SA1    X5          GET INPUT STRING 
          BX0    X5          CHECK IF BLANK-APPENDED-TO-TRAILING-COLON
          LX0    3           FLAG IS SET
          SB3    B0 
          PL     X0,NOBLNK   BR, NO BLANK-APPENDED-TO-TRAILNG-COLON FLAG
          SB3    -1 
 NOBLNK   PL     X5,ORD1
          SA1    A1+B4
 ORD1     MX0    6
          SA2    =XASCII     CHECK ASCII MODE FLAG
          BX6    X0*X1
          AX5    18+18
          ZR     X5,ORD2     IF NULL STRING(ERROR)
          SB2    X5          STRING LENGTH
          SB2    B2+B3
          SB5    ASCTBL      TRANSLATION TABLE
          EQ     B2,B1,ORD4  IF SINGLE CHARACTER
          SB3    2
          EQ     B2,B3,ORD7  IF 2 CHARACTER COULD BE EITHER 
          SB3    3
          EQ     B2,B3,ORD6  IF 3 CHARACTER ASCII ABBREVIATION
          ZR     X2,ORD2
          SB3    6
          LE     B2,B3,ORD6 
 ORD2     RJ     =XBASRBR=   RESTORE REGISTERS
          JP     ER194       ERROR *ILLEGAL ORD ARGUMENT* 
  
 ORD7     ZR     X2,ORD6     MUST BE 2-CHARACTER ASCII ABBREVIATION 
          LX6    6                 SHIFT ESCAPE CODE INTO LOWER BITS
          BX2    X6          SAVE CHAR
          BX6    X1          GET STRING 
          LX6    6           MOVE 2ND CHAR TO HIGH ORDER
          BX6    X6*X0       MASK OUT REST
          SX2    X2-74B      SEE IF FIRST CHAR IS ESCAPE
          SB5    A74TBL            GET ADDR OF 7400 TRANSLATIO TBL
          ZR     X2,ORD4
          SX2    X2-2 
          NZ     X2,ORD6
          SB5    A76TBL            GET ADDR OF 7600 TRANSLATION TABLE 
 ORD4     LX6    6
 ORD10    SA1    =XBASANSI   IF NOT IN ANSI MODE
          ZR     X1,ORD10A   OR IF
          SA1    =XBASCOLL   COLLATE FLAG IS SET
          NZ     X1,ORD10A   GO RETURN ASCII ORDINAL. 
          SB5    B5-ASCTBL
          NZ     B5,ER194    MUST BE DISPLAY VALUE. 
          BX1    X6          RETURN DISPLAY VALUE.
          EQ     ORD10B 
 ORD10A   SA1    B5+X6       RETURN ASCII VALUE 
 ORD10B   BSS    0
          PX5    X1 
          NX5    X5 
          RJ     =XBASRBR=   RESTORE REGISTERS
          EQ     BASTORD     RETURN 
  
*         ASCII ABBREVIATION CRACKER. 
  
 ORD6     ZR     X2,ORD6A 
          MX3    -6 
          SB2    60 
          BX2    X2-X2
 ORD6D    LX1    6
          BX4    -X3*X1 
          ZR     X4,ORD6B 
          SX5    X4-74B 
          ZR     X5,ORD6C 
          SX5    X4-76B 
          ZR     X5,ORD6C 
          LX2    6
          BX2    X2+X4
          SB2    B2-6 
          EQ     ORD6D
 ORD6C    LX1    6
          BX4    -X3*X1 
          LX2    6
          BX2    X2+X4
          SB2    B2-6 
          EQ     ORD6D
 ORD6B    LX1    X2,B2
 ORD6A    SB2    -B1
          SA2    ABBTBL1-1   FIRST EQUIV TABLE
          LX1    18          POSITION STRING TO 17..0 
          BX6    X1 
          RJ     ABB         TRY THIS TABLE 
          SB5    ASCTBL      GET TRANSLATION TABLE
          PL     B2,ORD9     IF MATCHED 
          SB2    7400B-1
          SA2    ABBTBL2-1   NEXT TABLE 
          RJ     ABB
          SB5    A74TBL      GET 7400 TRANSLATION TABLE 
          PL     B2,ORD9     IF MATCHED 
          SB2    7600B-1
          SA2    ABBTBL3-1
          RJ     ABB
          SB5    A76TBL      GET 7600 TRANSLATION TABLE 
          PL     B2,ORD9     IF MATCHED 
          EQ     ORD2        NOT FOUND IN ANY TABLE 
  
 ORD9     SX6    B2 
          MX7    -6                ISOLATE LAST SIX BITS. 
          BX6    -X7*X6 
          EQ     ORD10
          SPACE  4
 ABB3     SB2    -1          FLAG NOT FOUND 
 ABB      PS                 ENTRY/EXIT 
 ABB1     SA2    A2+B1       READ UP TABLE ENTRY
          SB3    3
          LX2    6
          ZR     X2,ABB3     IF NOT FOUND 
 ABB2     LX2    18 
          SB3    B3-B1
          SX3    X2          GET ABBREVIATION 
          SB2    B2+B1
          BX1    X3-X6
          ZR     X1,ABB      IF MATCH 
          GT     B3,B0,ABB2 
          EQ     ABB1 
          SPACE  4
**        TBL - GENERATE TABLE ENTRY. 
* 
  
          PURGMAC TBL 
  
 TBL      MACRO  A,B,C
 TBL      IFC    EQ,$A_B_C$$
          VFD    1/1,59/0 
 TBL      ELSE
          VFD    6/0,18/0L_A,18/0L_B,18/0L_C
 TBL      ENDIF 
 TBL      ENDM
          SPACE  4
 ABBTBL1  BSS    0           00B-77B
          TBL    ,UCA,UCB 
          TBL    UCC,UCD,UCE
          TBL    UCF,UCG,UCH
          TBL    UCI,UCJ,UCK
          TBL    UCL,UCM,UCN
          TBL    UCO,UCP,UCQ
          TBL    UCR,UCS,UCT
          TBL    UCU,UCV,UCW
          TBL    UCW,UCY,UCZ
          TBL                0,1,2
          TBL                3,4,5
          TBL                6,7,8
          TBL                9,+,-
          TBL                *,/,(
          TBL                ) $ =
          TBL    SP,, 
          IFEQ   CHARSET,OLDCSET  61-CHARACTER SET
          TBL    QUO,,
          TBL 
          TBL    CF,LF, 
          ELSE               63/64-CHARACTER SET
          TBL 
          TBL    ,QUO,UND 
          TBL 
          ENDIF 
          TBL 
          TBL 
          TBL 
          CON    0           END OF TABLE 
  
  
 ABBTBL2  BSS    0           7400B-7407B
          IFEQ   CHARSET,OLDCSET  61-CHARACTER SET
          TBL 
          TBL    GRA,UND,DC1
          TBL    DC3,ENQ, 
          ELSE               63/64-CHARACTER SET
          TBL 
          TBL 
          TBL    ,GRA,
          ENDIF 
          CON    0           END OF TABLE 
  
  
 ABBTBL3  BSS    0           7600B-7677B
          TBL    ,LCA,LCB 
          TBL    LCC,LCD,LCE
          TBL    LCF,LCG,LCH
          TBL    LCI,LCJ,LCK
          TBL    LCL,LCM,LCN
          TBL    LCO,LCP,LCQ
          TBL    LCR,LCS,LCT
          TBL    LCU,LCV,LCW
          TBL    LCX,LCY,LCZ
          IFEQ   CHARSET,OLDCSET  61-CHARACTER SET
          TBL    DLE,BEL,DC2
          TBL    ETX,DC4,NAK
          TBL    SYN,ETB,CAN
          TBL    EM,VT,SOH
          TBL    ,SI,BS 
          TBL    HT,EOT,GS
          TBL    NUL,FF,SO
          TBL    STX,LBR,RBR
          TBL    SUB,ACK, 
          TBL    ,VLN,TIL 
          TBL    ,FS,RS 
          TBL    DEL,US 
          TBL    ESC,,
          ELSE               63/64-CHARACTER SET
          TBL    LBR,VLN,RBR
          TBL    TIL,DEL,NUL
          TBL    SOH,STX,ETX
          TBL    EOT,ENQ,ACK
          TBL    BEL,BS,HT
          TBL    LF,VT,FF 
          TBL    CR,SO,SI 
          TBL    DLE,DC1,DC2
          TBL    DC3,DC4,NAK
          TBL    SYN,ETB,CAN
          TBL    EM,SUB,ESC 
          TBL    FS,GS,RS 
          TBL    US,, 
          ENDIF 
          CON    0           END OF TABLE 
  
 ASCTBL   DATA   58          :  
          DATA   65          A
          DATA   66          B
          DATA   67          C
          DATA   68          D
          DATA   69          E
          DATA   70          F
          DATA   71          G
          DATA   72          H
          DATA   73          I
          DATA   74          J
          DATA   75          K
          DATA   76          L
          DATA   77          M
          DATA   78          N
          DATA   79          O
          DATA   80          P
          DATA   81          Q
          DATA   82          R
          DATA   83          S
          DATA   84          T
          DATA   85          U
          DATA   86          V
          DATA   87          W
          DATA   88          X
          DATA   89          Y
          DATA   90          Z
          DATA   48          0
          DATA   49          1
          DATA   50          2
          DATA   51          3
          DATA   52          4
          DATA   53          5
          DATA   54          6
          DATA   55          7
          DATA   56          8
          DATA   57          9
          DATA   43          +
          DATA   45          -
          DATA   42          *
          DATA   47          /
          DATA   40          (
          DATA   41          )
          DATA   36          $
          DATA   61          =
          DATA   32          SPACE
          DATA   44          ,
          DATA   46          .
          DATA   35 
          DATA   91          [
          DATA   93          ]
          IFEQ   CHARSET,NEWCSET
          DATA   37          %
          ELSE
          DATA   58          :  
          ENDIF 
          DATA   34          '
          DATA   95 
          DATA   33 
          DATA   38 
          DATA   39 
          DATA   63 
          DATA   60          <
          DATA   62          >
          DATA   64 
          DATA   92 
          DATA   94          >
          DATA   59          ;
 A74TBL   DATA   0
          DATA   64 
          DATA   94          &
          DATA   0
          DATA   58          :  
          DATA   0
          DATA   0
          DATA   96 
 A76TBL   DATA   0
          DATA   97          A(LCA) 
          DATA   98          B(LCB) 
          DATA   99          C(LCC) 
          DATA   100         D(LCD) 
          DATA   101         E(LCE) 
          DATA   102         F(LCF) 
          DATA   103         G(LCG) 
          DATA   104         H(LCH) 
          DATA   105         I(LCI) 
          DATA   106         J(LCJ) 
          DATA   107         K(LCK) 
          DATA   108         L(LCL) 
          DATA   109         M(LCM) 
          DATA   110         N(LCN) 
          DATA   111         O(LCO) 
          DATA   112         P(LCP) 
          DATA   113         Q(LCQ) 
          DATA   114         R(LCR) 
          DATA   115         S(LCS) 
          DATA   116         T(LCT) 
          DATA   117         U(LCU) 
          DATA   118         V(LCV) 
          DATA   119         W(LCW) 
          DATA   120         X(LCX) 
          DATA   121         Y(LCY) 
          DATA   122         Z(LCZ) 
          DATA   123          (LBR) 
          DATA   124          (VLN) 
          DATA   125          (RBR) 
          DATA   126          (TIL) 
          DATA   127         DEL
          DATA   0           NUL
          DATA   1           SOH
          DATA   2           STX
          DATA   3           ETX
          DATA   4           EOT
          DATA   5           ENQ
          DATA   6           ACK
          DATA   7           BEL
          DATA   8           BS 
          DATA   9           HT 
          DATA   10          LF 
          DATA   11          VT 
          DATA   12          FF 
          DATA   13          CR 
          DATA   14          SO 
          DATA   15          SI 
          DATA   16          DLE
          DATA   17          DC1
          DATA   18          DC2
          DATA   19          DC3
          DATA   20          DC4
          DATA   21          NAK
          DATA   22          SYN
          DATA   23          ETB
          DATA   24          CAN
          DATA   25          EM 
          DATA   26          SUB
          DATA   27          ESC
          DATA   28          FS 
          DATA   29          GS 
          DATA   30          RS 
          DATA   31          US 
  
 BASXORD  BSS    0           LWA+1 OF ORD PROCESSOR 
          SPACE  4
          TITLE  COPY/DISCARD LOGICAL CHARACTERS (BASCPYC). 
* 
*         BASCPYC - COPY/DISCARD LOGICAL CHARACTERS.
* 
*         PURPOSE - COPY/DISCARD LOGICAL CHARACTERS FOR THE ANSI SUB- 
*                   STRING EXTRACTION AND REPLACEMENT.
*                   A LOGICAL CHARACTER IS SIX BITS UNLESS IN ASCII 
*                   MODE. IN ASCII MODE, A LOGICAL CHARACTER IS TWELVE
*                   BITS IF THE FIRST SIX BITS ARE ESC1 (74B) OR
*                   ESC2 (76B), ELSE IT IS SIX BITS.
*                   DISCARDING OR COPYING WILL TERMINATE IF THE PHYSICAL
*                   END OF STRING IS ENCOUNTERED. 
* 
*         ENTRY - (X0) = 0, TO DISCARD LOGICAL CHARACTERS.
*                      = 1, TO COPY LOGICAL CHARACTERS. 
*                 (B4) = REMAINING PHYSICAL CHARS IN SOURCE STRING. 
*                 (B5) = NUMBER OF LOGICAL CHARS TO COPY/DISCARD. 
*                 (A2) = ADDRESS CONTAINING NEXT SOURCE CHARACTER.
*                 (B2) = NUMBER OF BITS IN ((A2)) AVAILABLE TO FETCH. 
*                 (B6) = ADDRESS CONTAINING NEXT TARGET CHAR POSITION.
*                 (B3) = NUMBER OF BITS IN ((B6)) AVAILABLE TO RECEIVE. 
* 
*         EXIT - (B1) = 1.
*                (B4) = REMAINING PHYSICAL CHARS IN SOURCE STRING.
*                (B5) = REMAINDER OF LOGICAL CHARS NOT COPIED/DISCARDED.
*                (A2) = ADDRESS CONTAINING NEXT SOURCE CHARACTER. 
*                (B2) = NUMBER OF BITS IN ((A2)) AVAILABLE TO FETCH.
*                (B6) = ADDRESS CONTAINING NEXT TARGET CHAR POSITION. 
*                (B3) = NUMBER OF BITS IN ((B6)) AVAILABLE TO RECEIVE.
*                       AFTER A COPY, THESE BITS CONTAIN BINARY ZERO. 
*                       THEREFORE, IF (B3) > 12, AN EXTRA WORD MUST 
*                       BE ZEROEDD TO INSURE A 12-66 BIT ZERO-BYTE. 
* 
*         USES - ALL BUT A0, X0.
* 
*         ENTRY POINTS
*                BASCPYC - FWA OF ROUTINE + TEMPORARIES.
*                BATCPYC - LWA+1 OF ROUTINE + TEMPORARIES.
*         CALLS - NONE
* 
  
  
          ENTRY  BASCPYC
          ENTRY  BATCPYC
  
 BASCPYC  JP     *+1S17      ENTRY/EXIT.
          SB1    1           DOESNT EVERYBODY...QQQ 
          LE     B4,BASCPYC  IF NOTHING TO COPY/DISCARD (PHYSICALLY)
          LE     B5,BASCPYC  IF NOTHING TO COPY/DISCARD (LOGICALLY) 
          SA3    B6          (X3) = FIRST TARGET WORD.
          MX7    -CHAR       RIGHT JUSTIFIED ONE CHARACTER MASK.
          BX5    X5-X5       CLEAR MIDDLE-OF-ASCII INDICATOR. 
          SA1    =XASCII     (X1) = 0 IF NON-ASCII MODE.
          SA2    A2          INSURE (X2) = ((A2)).
          SB7    WORD        (B7) = BITS PER WORD.
* 
*                            JUSTIFY SOURCE WORD. 
* 
          GT     B2,CPYC2    IF SOME SOURCE CHARS LEFT. 
          SA2    A2+B1       FETCH NEXT SOURCE WORD.
          SB2    B7          SET FULL SOURCE WORD IN X2.
 CPYC2    SB7    B7-B2       (B7) = BITS ALREADY USED FROM SOURCE X2. 
          LX2    X2,B7       LEFT JUSTIFY AVAILABLE CHARACTERS. 
          ZR     X0,CPYC4    IF DISCARDING. 
* 
*                            JUSTIFY TARGET WORD. 
* 
          SB7    WORD        (B7) = BITS PER WORD.
          GT     B3,CPYC3    IF SOME TARGET CHAR POSITIONS LEFT.
          SB6    B6+B1       SKIP TO NEXT TARGET WORD.
          SB3    B7          SET EMPTY TARGET WORD IN X6. 
 CPYC3    SB7    B7-B3       (B7) = BITS ALREADY FILLED IN TARGET.
          LX6    X3,B7       LEFT JUSTIFY TARGET WORD IN X6.
          SB7    B3-B1       (B7) = AVAILABLE TARGET BITS - 1.
          MX3    1
          AX3    X3,B7       MASK FOR AVAILABLE BITS. 
          BX6    -X3*X6      CLEAR AVAILABLE BITS IN TARGET WORD. 
  
 CPYC4    BSS    0           LOOP TO COPY/DISCARD LOGICAL CHARACTERS. 
* 
*                            GET NEXT SOURCE CHARACTER. 
* 
          LX2    CHAR        RIGHT JUSTIFY NEXT PHYSICAL CHARACTER. 
          BX4    -X7*X2      (X4) = NEXT SOURCE PHYSICAL CHARACTER. 
          SB4    B4-B1       DECREMENT PHYSICAL LENGTH. 
          SB5    B5-B1       DECREMENT LOGICAL LENGTH (NON-ASCII).
* 
*                            DECREMENT AVAILABLE BITS IN X2.
* 
          SB2    B2-CHAR     (B2) = BITS OF SOURCE IN X2. 
          GT     B2,CPYC5    IF X2 NOT EXHAUSTED, YET.
          SA2    A2+B1       FETCH NEXT SOURCE WORD.
          SB2    WORD        FULL SOURCE WORD IN X2.
 CPYC5    BSS    0
* 
*                            CHECK FOR ASCII ESCAPE CHARACTER.
* 
          ZR     X1,CPYC8    IF NOT IN ASCII MODE.
          NZ     X5,CPYC7    IF PROCESSING 2ND 6 BITS OF ASCII CHAR.
          SX3    X4-ESC1
          ZR     X3,CPYC6    IF ESCAPE CODE ESC1 (74B). 
          SX3    X4-ESC2
          NZ     X3,CPYC8    IF NOT ESCAPE CODE ESC2 (76B), EITHER. 
 CPYC6    SX5    B1          SET MIDDLE-OF-ASCII INDICATOR. 
          SB5    B5+B1       INCREMENT LOGICAL LENGTH (IGNORE ESCAPE).
          EQ     CPYC8
  
 CPYC7    SX5    B0          CLEAR MIDDLE-OF-ASCII INDICATOR. 
 CPYC8    BSS    0
* 
*                            STORE THIS PHYSICAL CHARACTER. 
* 
          ZR     X0,CPYC9    IF DISCARDING. 
          LX6    CHAR        RIGHT JUSTIFY TARGET CHAR POSITION.
          BX6    X6+X4       ADD NEW CHARACTER. 
* 
*                            DECREMENT AVAIALBLE BITS IN X6.
* 
          SB3    B3-CHAR     (B3) = BITS AVAILABLE IN X6. 
          GT     B3,CPYC9    IF X6 NOT FILLED, YET. 
          SA6    B6          STORE FILLED TARGET WORD.
          SB6    B6+B1       POINT TO NEXT TARGET WORD. 
          BX6    X6-X6       START WITH ZERO TARGET WORD. 
          SB3    WORD        SET EMPTY TARGET WORD IN X6. 
* 
*                            CHECK FOR MORE WORK TO BE DONE.
* 
 CPYC9    LE     B4,CPYC10   IF NO MORE SOURCE (PHYSICALLY).
          GT     B5,CPYC4    IF MORE SOURCE (LOGICALLY).
 CPYC10   ZR     X0,BASCPYC  IF DISCARDING. 
          LX6    X6,B3       LEFT JUSTIFY FILLED PART.
          SA6    B6          STORE LAST TARGET WORD.
          EQ     BASCPYC
 BATCPYC  BSS    0           LWA+1 OF BASCPYC.
          TITLE  STRING COMPARE ROUTINE (BASACMP) 
* 
*   STRING COMPARE
* 
          DATA      10HBASACMP
BASACMP   DATA      0                  STRING COMPARE ROUTINE 
* INPUT 
*         A5        ADDRESS SUBJECT 
*         A4        ADDRESS OBJECT
*         B6        TYPE
*            0        = 
*            1        NOT = 
*            2        > 
*            3        \ 
*            4        < 
*            5        @ 
* 
          SA1    A5          FETCH SOURCE STRING POINTER WORD 
          MX3    -18         MASK FOR STRING LENGTH 
          LX5    24 
          BX5    -X3*X5      (X6)=SOURCE STRING LENGTH
          SB1    A5          B1 = ADDRESS OF NULL STRING
          ZR     X1,COMP.A
          SB1    X1          B1 = ADR OF VARIABLE STR 
          PL     X1,COMP.A
          SB1    X1+B4       B1 = ADR OF CONSTANT STR 
 COMP.A   SA1    A4          FETCH OBJECT STRING POINTER WORD 
          LX4    24 
          BX4    -X3*X4      (X7)=OBJECT STRING LENGTH
          SB3    A4          B3 = ADR OF NULL STR 
          ZR     X1,COMP.B
          SB3    X1          B3 = ADR OF VARIABLE STR 
          PL     X1,COMP.B
          SB3    X1+B4       B3 = ADR OF CONSTANT STR 
 COMP.B   BSS    0
          SA1    ASCII
          ZR   X1,NOTASC4          JUMP IF NOT ASCII MODE 
* 
*  ASCII COMPARE - USE ASCORD RTN TO GET ASCII ORDINALS 
* 
          SX6    B6                SAVE B6
          SA6    COMPSAVE 
          SX0    77B               CHAR MASK
* 
          SA1    B1                GET FIRST WORDS
          BX6    X1                FIRST STAYS IN X6
          SA2    B3 
          BX7    X2                SECOND IN X7 
          SB5    10                CHARACTERS LEFT IN WORD (FIRST)
          SB7    10                (SECOND) 
* 
 COMP2    LX6    6                 EXTRACT CHARACTERS 
          LX7    6
          BX1    X0*X6
          BX2    X0*X7
          NZ   X1,COMP3            SKIP IF FIRST NOT EOS
* 
          SX3    B5-1              CHECK IF ZERO BYTE IS EOS
          ZR   X3,COMP21           SKIP IF NO MORE IN THIS WORD 
          LX3    1                 BYTES*2
          SX4    X3 
          LX4    1                 BYTES*4
          IX3    X3+X4             BITS REMAINING IN WORD 
          SB6    X3-1              FORM MASK
          MX3    1
          AX3    B6,X3
          BX3    X3*X6             REST OF WORD 
          ZR   X3,COMP18           EOS
          EQ   COMP3
 COMP21   SA3    B1+1              NEXT WORD OF STRING
          NG   X3,COMP3            POSSIBLE 77...7B 
          ZR   X3,COMP18           EOS
          EQ   COMP3
 COMP18   SX1    -1                INDICATE EOS ON FIRST STRING 
          EQ   COMP5               GO GET SECOND  CHARACTER 
* 
 COMP3    BSS    0                 CHECK FIRST FOR ESCAPE CODE
          SX3    X1-ESC1
          ZR   X3,COMP4            YES
          SX3    X1-ESC2
          NZ   X3,COMP5            NOT ESCAPE 
 COMP4    BSS    0                 HAVE ESCAPE CODE, GET THE REST 
          BX4    X1                SAVE ESCAPE
          LX4    6                 AS 7400 OR 7600
          SB5    B5-1 
          NZ   B5,COMP6            SKIP IF MORE IN WORD 
          SB1    B1+1              NEXT WORD
          SA1    B1 
          BX6    X1 
          SB5    10 
 COMP6    LX6    6                 EXTRACT NEXT 6 BITS
          BX1    X0*X6
          BX1    X1+X4             ADD IN ESCAPE
* 
 COMP5    BSS    0                 HAVE FIRST (FULL) CHARACTER IN X1
          NZ   X2,COMP7            SKIP IF SECOND NOT EOS 
* 
          SX3    B7-1              CHECK IF ZERO BYTE IS EOS
          ZR   X3,COMP19           SKIP IF NO MORE IN THIS WORD 
          LX3    1                 BYTES*2
          SX4    X3 
          LX4    1                 BYTES*4
          IX3    X3+X4             BITS REMAINING IN WORD 
          SB6    X3-1              FORM MASK
          MX3    1
          AX3    B6,X3
          BX3    X3*X7             REST OF WORD 
          ZR   X3,COMP20           EOS
          EQ   COMP7
 COMP19   SA3    B3+1              NEXT WORD OF STRING
          NG   X3,COMP7            POSSIBLE 77...7B 
          ZR   X3,COMP20           EOS
          EQ   COMP7
 COMP20   SX2    -1                INDICATE EOS ON SECOND STRING
          EQ   COMP9               GO COMPARE 
* 
 COMP7    BSS    0                 CHECK SECOND FOR ESCAPE
          SX3    X2-ESC1
          ZR   X3,COMP8            YES
          SX3    X2-ESC2
          NZ   X3,COMP9            NOT ESCAPE 
 COMP8    BSS    0                 HAVE ESCAPE CODE, GET THE REST 
          BX4    X2                SAVE ESCAPE
          LX4    6                 AS 7400 OR 7600
          SB7    B7-1 
          NZ   B7,COMP10           SKIP IF MORE IN WORD 
          SB3    B3+1              NEXT WORD
          SA2    B3 
          BX7    X2 
          SB7    10 
 COMP10   LX7    6                 EXTRACT NEXT 6 BITS
          BX2    X0*X7
          BX2    X2+X4             ADD IN ESCAPE CODE 
* 
 COMP9    BSS    0                 HAVE BOTH (FULL) CHARACTERS
          IX3    X1-X2             COMPARE
          NZ   X3,COMP11           JUMP IF NOT EQUAL
          SX1    X1+1              CHECK IF AT EOS
          NZ   X1,COMP17           SKIP IF NOT EOS
          SA1    COMPSAVE          BOTH EQUAL TO EOS
          SB6    X1                RESTORE B6 
          EQ   EQUAL               GO SET UP RESULT 
 COMP17   SB5    B5-1              PREPARE TO GO CHECK NEXT CHARACTERS
          NZ   B5,COMP12
          SB1    B1+1 
          SA1    B1 
          BX6    X1 
          SB5    10 
 COMP12   SB7    B7-1 
          NZ   B7,COMP13
          SB3    B3+1 
          SA2    B3 
          BX7    X2 
          SB7    10 
 COMP13   EQ   COMP2               LOOP FOR NEXT CHARACTERS 
* 
* 
 COMP11   BSS    0                 CHARACTERS ARE NOT EQUAL 
          BX0    X2                SAVE SECOND ONE
          NG   X1,COMP14           SKIP IF FIRST IS EOS 
          RJ   ASCORD              GET FIRST ASCII ORDINAL IN X1
          NG   X1,ER165            *ILLEGAL CHARACTER*
 COMP14   BX6    X1                SAVE IT
          BX1    X0                SECOND CHAR IN X1 FOR ASCORD 
          NG   X1,COMP15           SKIP IF EOS
          RJ   ASCORD              GET SECOND ORDINAL 
          NG   X1,ER165            *ILLEGAL CHARACTER*
 COMP15   IX5    X6-X1             FIRST MINUS SECOND 
          SA1    COMPSAVE          RESTORE B6 
          SB6    X1 
          EQ   COMP16              GO SET UP RESULT 
* 
* 
* 
*  NON-ASCII COMPARE - USE DISPLAY CODES
* 
* 
 NOTASC4  BSS    0                 NON-ASCII COMPARE
          IX0    X4*X5       CHECK FOR NULL STRING...LENGTH=0 
          NZ,X0  NOTASC6     NEITHER ARE NULL 
          IX0    X4-X5
          ZR,X0  EQUAL       BOTH ARE NULL
          SX5    -1 
          NZ,X4  COMP16      SUBJECT IS NULL
          SX5    1
          JP     COMP16 
 NOTASC6  BSS    0
          IX0    X5-X4
          PL,X0  NOTASC7
          BX4    X5 
 NOTASC7  BX6    X4          SAVE MIN LENGTH IN X6
          SX0    X4-10
          NG,X0  NOTASC8     LENGTH IS LESS THAN 10 
          SX4    10          ELSE SET COMPARE LENGTH TO 10
 NOTASC8  SB7    X4 
          SA1    B1          LOAD 1ST WORD OF SOURCE STR
          SA2    B3          LOAD 1ST WORD OF OBJECT STR
          SX0       77B 
LOOP      LX1       6 
          LX2       6 
          BX3       X0*X1 
          BX4       X0*X2 
          IX5       X3-X4 
          NZ        X5,NEQUAL 
          ZR     X3,ZERO40         BOTH BYTES EQUAL AND IS ZERO 
          SB7       B7-1
          NE        B0,B7,LOOP         NOT END OF WORD
ZERO41    BSS    0
          SX5    X6-10
          ZR,X5  NOTASC10 
          NG,X5  NOTASC11 
          BX6    X5          NEW MIN LENGTH LEFT
          SA1    A1+1        GET NEXT WORD
          SA2    A2+1 
          SX4    X5-10
          NG,X4  NOTASC9
          SX5    10 
 NOTASC9  SB7    X5          NEW COMPARE LENGTH 
          EQ        LOOP
 NOTASC10 BSS    0
          SA1    A1+1 
          SA2    A2+1 
 NOTASC11 BSS    0
          LX1    6
          LX2    6
          BX3    X0*X1
          BX4    X0*X2
          IX5    X3-X4
          ZR,X5  EQUAL
          EQ     COMP16 
ZERO40    BSS    0                 ZERO BYTE AND BOTH STRS EQUAL
          SB7    B7-1              DECREASE BYTE COUNT
          NE     B7,B0,LOOP        LOOP IF NOT LAST BYTE OF WORD
          MX3    48                MASK FOR STR TERMINATOR
          SA4    A1                OBTAIN CURRENT WORD
          BX4    -X3*X4            IF LAST 2 BYTES ARE ZERO 
          NZ     X4,ZERO41         END OF STR AND HAVE EQUALITY 
* 
* 
EQUAL     JP        TABLE1+B6 
TABLE1    JP        TRUE   =
          JP        FALSE  NOT =
          JP        FALSE  >
          JP        TRUE   \
          JP        FALSE  <
          JP        TRUE  @ 
 NEQUAL   BSS    0
          SA1    =XBASCOLL   IF COLLATE FLAG NOT SET
          ZR     X1,NEQUAL2  THEN GO DO COMPARISON. 
          SA3    X3+ASCTBL   GET ASCII VALUES FOR 
          SA4    X4+ASCTBL   THE DISPLAY CODE VALUES. 
 NEQUAL2  BSS    0
          IX5       X3-X4 
* 
* 
 COMP16   BSS    0
          NG       X5,LJMP
          JP       TABLE2+B6
TABLE2    JP        FALSE  =
          JP        TRUE   NOT =
          JP        TRUE   >
          JP        TRUE   \
          JP        FALSE  <
          JP        FALSE      @
LJMP      JP        TABLE3+B6 
TABLE3    JP        FALSE  =
          JP        TRUE   NOT= 
          JP        FALSE  >
          JP        FALSE  \
          JP        TRUE   <
          JP        TRUE   @
 FALSE    SX5    B0 
          EQ     BASACMP
 TRUE     SX5    1
          EQ     BASACMP
* 
 COMPSAVE BSS    1                 SAVE B6 HERE 
* 
BATACMP   BSS       0 
* 
*     END STRING COMPARE
* 
* 
* 
          TITLE  STRING TO VARIABLE (BASACSV) 
* 
*                                  (CHANGE) STRING TO VBL 
* 
* 
          DATA   10HBASACSV 
 BASACSV  JP     0
* 
* 
* 
*         ON ENTRY           B7 = ADDRESSS OF SOURCE STR POINTER WORD 
*                            X5 = CONTENTS OF ARRAY DOPE
* 
* 
          SA1    B7          FETCH STRING POINTER WORD
          ZR     X1,ACSV.A    B7 = ADR OF NULL STRING 
          SB7    X1 
          PL     X1,ACSV.A   B7 = ADR OF VARIABLE STRING
          SB7    X1+B4       B7 = ADR OF CONSTANT STRING
 ACSV.A   BSS    0
          SA1    BASCOLL
          ZR   X1,NOTASC3          SKIP IF NOT ASCII MODE 
* 
*  ASCII CHANGE - USE ASCORD RTN TO GET ASCII ORDINALS
* 
          BX0    X5                SAVE DOPE 30/ARRAYSIZE,30/RELADDR
          AX5    30 
          SX5    X5-1              ALLOW FOR CHAR COUNT TO GO IN FIRST E
          SB1    X0+1              REL ADDR OF FIRST USABLE ARRAY ELEMEN
          SB3    X5                COUNT OF ARRAY ELEMENTS LEFT 
          SX2    77B               CHAR MASK
          SX7    B0                CLEAR ESCAPE CODE BUFFER 
* 
 CHGSV1   SA1    B7                LOAD A WORD OF THE STRING
          BX6    X1                KEEP IT IN X6
          SB5    10                CHARACTERS LEFT IN WORD
* 
 CHGSV2   LX6    6                 EXTRACT CHARACTER
          BX3    X2*X6
          NZ   X7,CHGSV5           IF ESCAPE IS WAITING GO MATCH IT UP
          NZ   X3,CHGSV3           SKIP IF NOT END OF STRING
* 
          SX4    B5-1              CHECK IF ZERO BYTE IS EOS
          ZR   X4,CHGSV7           SKIP IF NO MORE IN THIS WORD 
          LX4    1                 BYTES*2
          SX5    X4 
          LX5    1                 BYTES*4
          IX4    X4+X5             BITS REMAINING IN WORD 
          SB6    X4-1              FORM MASK
          MX4    1
          AX4    B6,X4
          BX4    X4*X6             REST OF WORD 
          ZR   X4,CSVEND           EOS
          EQ   CHGSV3 
 CHGSV7   SA4    B7+1              NEXT WORD OF STRING
          NG   X4,CHGSV3           POSSIBLE 77...7B 
          ZR   X4,CSVEND           EOS
* 
 CHGSV3   BSS    0                 CHECK FOR ESCAPE CODE
          SX4    X3-ESC1
          ZR   X4,CHGSV4           FOUND 74 
          SX4    X3-ESC2
          NZ   X4,CHGSV5           NOT ESCAPE 
 CHGSV4   BSS    0                 HAVE ESCAPE CODE 
          SA4    ASCII       CHECK ASCII CODE 
          ZR     X4,CHGSV5   IT'S AT SIGN OR CIRCUMFLEX NOT ASCII CODE
          SX7    X3                SAVE IN ESCAPE BUFFER (X7) 
          LX7    6                 AS 7400 OR 7600
          EQ   CHGSV6              GO GET REST OF CHARACTER 
* 
 CHGSV5   BSS    0                 HAVE A CHARACTER 
          BX1    X7+X3             CHARACTER (PLUS ESCAPE CODE IF ANY) T
          RJ   ASCORD              GET ASCII ORDINAL IN X1 (USES X1-X5) 
          SX2    77B               RESTORE MASK 
          NG   X1,ER165            *ILLEGAL CHARACTER*
          PX7    B0,X1             FLOAT ORDINAL
          NX7    B6,X7
          ZR   B3,ER163            *ARRAY TOO SMALL*
          SA7    B1+B2             STORE IN ARRAY ELEMENT 
          SB1    B1+1              INCR ARRAY ADDR
          SB3    B3-1              DECR REMAINING ARRAY SPACE 
          SX7    B0                CLEAR ESCAPE BUFFER
* 
 CHGSV6   BSS    0                 GET NEXT CHARACTER 
          SB5    B5-1              DECR CHARS LEFT IN WORD
          NZ   B5,CHGSV2           LOOP IF MORE 
          SB7    B7+1              ELSE NEXT WORD OF STRING 
          EQ   CHGSV1              LOOP 
* 
 CSVEND   BSS    0
          SB3    X0+1              REL ADDR OF FIRST CHAR IN ARRAY
          SX1    B1-B3             LWA+1-FWA = LENGTH 
          PX6    B0,X1             FLOAT
          NX6    B6,X6
          SA6    X0+B2             STORE IN FIRST ARRAY ELEMENT 
          EQ   BASACSV             EXIT 
* 
* 
*  NON-ASCII CHANGE - USE DISPLAY CODES 
* 
* 
 NOTASC3  BSS    0                 NON-ASCII CHANGE 
          BX0    X5                DOPE (30/ARRAY SIZE,30/REL ADDR) 
          AX5    30 
          SX5    X5-1              ALLOW FOR CHAR COUNT IN ARRAY(0) 
          SX4    X0+1              REL ADDR OF 1ST USABLE ARRAY POSN
          MX3    54                CHARACTER MASK 
* 
 NXTWRD   BSS    0
          SA1    B7                LOAD NEXT (1ST) WORD OF STRING 
          SB5    10                CHARS IN WORD COUNT
* 
 NXTCH    BSS    0
          SB6    6                 CHAR SHIFT 
          LX1    X1,B6             MOVE IT ROUND
          BX2    -X3*X1            MASK IT OFF INTO X2
          ZR     X2,ZEROMET        JUMP IF ZERO BYTE
ZERO2     BSS    0
          PX2    B0,X2
          NX7    B6,X2             FLOAT CHAR CODE
          ZR   X5,ER163            *ARRAY TOO SMALL*
          SA7    X4+B2             AND DUMP IT IN THE ARRAY 
          SX4    X4+1              ADVANCE ARRAY REL.ADDR.
          SX5    X5-1              REDUCE ARRAY SIZE COUNT
          SB5    B5-1              REDUCE CHARS-IN-WORD COUNT 
          NE     B5,B0,NXTCH       LOOP IF COUNT NON-ZERO 
          SB7    B7+1              ADVANCE SOURCE STRING POINTER
          EQ     NXTWRD            AND LOOP TO GET NEXT WORD
* 
* 
 ENDSTR   BSS    0
          SX1    X0+1              X1: REL ADR OF 1ST CHAR
          IX4    X4-X1             X4: (LAST-1ST) = COUNT OF CHARS MET
          PX7    B0,X4             FLOAT NO OF CHARS
          NX7    B6,X7             AND NORMALIZE
          SA7    X0+B2             DUMP CHAR COUNT IN ARRAY(0)
          EQ     BASACSV           EXIT 
* 
* 
ZEROMET   BSS    0                 ZERO BYTE ENCOUNTERED
          SX7    B5-1 
          ZR     X7,ZERO1          JUMP IF BYTE AT END OF WORD
          LX7    1                 BYTES REMAINING IN WORD * 2
          SX3    X7                BYTES * 2
          LX7    1                 BYTES * 4
          IX3    X3+X7             BIT COUNT
          SB6    X3-1              SHIFT COUNT FOR MASK 
          MX3    1                 ELSE FORM MASK TO EXTRACT REST 
          AX3    B6,X3                OF WORD 
          SB6    6                 RESET B6 TO BIT COUNT PER BYTE 
          BX7    X1*X3
          ZR     X7,ENDSTR         IF ZERO, STRING ENDED
          MX3    54                ELSE RESET MASK
 IF1      IFEQ   CHARSET,OLDCSET
          EQ   ER165               00 IS *ILLEGAL CHAR* 
 IF1      ELSE
 IF2      IFEQ   IP.CSET,IP.C63 
          EQ   ER165               00 IS *ILLEGAL CHAR* 
 IF2      ELSE
          EQ     ZERO2                AND ZERO IS VALID CHAR
 IF2      ENDIF 
 IF1      ENDIF 
* 
ZERO1     BSS    0
          SA3    B7+1              NEXT WORD
          NG     X3,ZERO3          POSSIBLE 7777...7B 
          ZR     X3,ENDSTR         STRING ENDED IF ZERO 
ZERO3     BSS    0
          MX3    54                ELSE RESET MASK
          EQ     ZERO2                AND ZERO IS VALID CHAR
* 
* 
* 
* 
 BATACSV  BSS    0
* 
*********** 
          TITLE  VARIABLE TO STRING (BASACVS) 
* 
* 
* 
* 
          DATA   10HBASACVS 
 BASACVS  BSS    0
*                ON ENTRY X5 HOLDS DOPE ON SOURCE ARRAY 
*                            B7 = ADR OF TARGET STR POINTER WORD
* 
          JP     0
          BX0    X5                X0: 30/ARRAY SIZE,30/REL. ADDR.
        SX5      X5                ARRAY ADDRESS
          SA1    X5+B2             ARRAY(0) HAS USER SPECIFIED
*                                  CHARACTER STRING COUNT 
          NG     X1,ER164    *INVALID LENGTH* (164) 
          UX1    B6,X1
          LX1    B6,X1             X1: SPECIFIED LENGTH 
          ZR     X1,NULLSTR        GO PROVIDE A NULL STRING 
* 
          AX0    30                ISOLATE ARRAY SIZE 
          SX0    X0-1              ALLOW FOR CHAR COUNT POSITION
          IX0    X0-X1             (DIMENSION) LESS (SPECIFIED LENGTH)
          NG     X0,ER164    *INVALID LENGTH* 
          SX0    X1-BSTRLEN        (SPECIFIED LENGTH) LESS (BASIC SIZE) 
          PL     X0,ER164    *INVALID LENGTH* (164) 
* 
          SX6    B7 
          SA6    STRPNTR     SAVE ADR OF STRING PTR WORD
          SA2    BASCOLL
          ZR   X2,NOTASC5          SKIP IF NOT ASCII MODE 
* 
*  ASCII CHANGE - USE CHR$ TO CONVERT ASCII ORDINALS TO CHAR
* 
          SB3    X5                B3 = ARRAY ELEMENT POINTER 
          SB5    X1                B5 = NUMBER OF ELEMENTS LEFT 
          SX0    77B               CHAR MASK
          SX4    B0                ZERO 6-BIT ITEM COUNT
          LX1    1           X1 = POTENTIAL NUM OF 6 BIT CHARS
          BX2    X1          X2 = 6 BIT CHARS THAT COULD BE USED
          SX1    B7          X1 = ADR OF STRING POINTER 
          RJ     =XBASGSTR   GO GET STRING SPACE
          SB1    X1          B1 = FWA OF ASSIGNED SPACE 
* 
 CHGVS1   SX7    B0                X7 = STRING WORD BEING CONSTRUCTED 
          SX2    10                X2 = COUNT OF CHAR POSNS LEFT IN X7
* 
 CHGVS2   BSS    0                 GET NEXT NUMBER
          SB3    B3+1 
          SA5    B3+B2
          NG   X5,ER164            *ERROR IN CHANGE*
          UX1    B6,X5             UNFLOAT TO X1
          LX1    B6,X1
          SX1    X1-128            CHECK IF IN RANGE 0-127
          PL   X1,ER164            *ERROR IN CHANGE*
* 
          BX6    X0          MAKE X6 NON ZERO 
          SA6    CVSCALL     SET SPECIAL FLAG IN BASXCHR
          RJ     BASXCHR     GET CHAR WHOSE ASCII ORD IS IN X5
          BX1    X6          MOVE LEFT JUSTIFIED CHAR TO X1 
          SX6    B0 
          SA6    CVSCALL     CLEAR SPECIAL FLAG IN BASXCHR
          LX1    12                MOVE IT AROUND TO RIGHT END
          BX3    X0*X1             INSPECT BOTTOM 6 BITS
          NZ   X3,CHGVS3           SKIP IF IT IS A 12-BIT CHAR
          BX3    -X0*X1            CHECK UPPER BITS, COULD BE 7600       BAS0011
          SX3    X3-ESC200                                               BAS0011
          NZ     X3,CHGVS10 
          SA3    ASCII
          NZ     X3,CHGVS3   JUMP IF IT IS 7600 
 CHGVS10  BSS    0
* 
          AX1    6                 IT IS ONLY 6 BITS, DROP 00 
          LX7    6                 ADD IT TO STRING 
          BX7    X7+X1
          SX4    X4+1              COUNT 6-BIT ITEMS
          SX1    X4-BSTRLEN 
          PL   X1,ER164            OVERFLOW - ERROR IN CHANGE 
          EQ   CHGVS5              GO CHECK IF DONE 
* 
 CHGVS3   BSS    0                 ADD 12-BIT CHAR TO STRING
          AX1    6                 UPPER 6 BITS, LOWER ARE IN X3
          LX7    6                 ADD UPPER TO STRING
          BX7    X7+X1
          SX4    X4+2              COUNT 6-BIT ITEMS
          SX1    X4-BSTRLEN 
          PL   X1,ER164            OVERFLOW - ERROR IN CHANGE 
          SX2    X2-1              DECR SPACES LEFT IN X7 
          NZ   X2,CHGVS4           SKIP IF ROOM FOR MORE
          SA7    B1                STORE THE FULL WORD
          SB1    B1+1 
          SX7    B0                START NEW WORD 
          SX2    10 
 CHGVS4   LX7    6                 ADD LOWER 6 BITS TO STRING 
          BX7    X7+X3
* 
 CHGVS5   BSS    0                 CHECK IF DONE
          SB5    B5-1              DECR NUMBER OF ELEMENTS LEFT 
          ZR   B5,CVSEND           EXIT IF ALL CONVERTED
          SX2    X2-1              DECR CHAR SPACES LEFT IN WORD
          NZ   X2,CHGVS2           ROOM EXISTS, GO DO NEXT CHAR 
          SA7    B1                STORE FULL WORD
          SB1    B1+1 
          EQ   CHGVS1              GO START NEW WORD
* 
 CVSEND   BSS    0                 ALL CONVERTED, POSITION LAST WORD
          SX2    X2-1              DECR COUNT FOR LAST CHAR 
 CHGVS6   ZR   X2,CHGVS7           EXIT IF WORD FULL
          LX7    6                 LEFT JUSTIFY 
          SX2    X2-1 
          EQ   CHGVS6              LOOP 
 CHGVS7   SA7    B1                STORE LAST WORD
          SX1    7777B             ASSURE LINE TERMINATOR 
          BX2    X1*X7
          ZR     X2,CHGVS.B  EXIT IF ONE EXITS
          SX7    B0                STORE EXTRA ZERO WORD
          SB1    B1+1 
          SA7    B1 
 CHGVS.B  SA1    STRPNTR     X1 = ADDRESS OF STR POINTER WORD 
          SX2    X4          X2 = NUMBER OF 6 BIT CHARS STORED
          RJ     =XBASTSTR   GO TRUNCATE STRING TO (X4) CHARS 
          EQ     CHGVSXT     EXIT 
* 
* 
*  NON-ASCII CHANGE - USE DISPLAY CODES 
* 
* 
 NOTASC5  BSS    0                 NON-ASCII CHANGE 
* 
          BX2    X1          X2 = NUM OF CHARS REQUIRED 
          SX1    B7          X1 = ADR OF STR POINTER WORD 
          RJ     =XBASGSTR   GO GET STRING SPACE
          SB7    X1          B7 = FWA OF ASSIGNED SPACE 
          SX1    X2          X1 = NUMBER OF CHARS TO PROCESS
          MX4    54                CHARACTER MASK 
 NSTRWD   BSS    0
          SB5    10                CHARS PER WORD COUNT 
          SX7    B0                CLEAR BUFFER 
* 
 NXTCVAL  BSS    0
          SX5    X5+1              ADVANCE SOURCE ARRAY POINTER 
          SA2    X5+B2             LOAD NEXT (1ST) CHARACTER (VALUE)
          NG   X2,ER164            *ERROR IN CHANGE*
          UX2    B6,X2
          LX2    B6,X2             UNFLOAT VALUE
          BX3    -X4*X2            X3: DISPLAY CHARACTER (6 BITS) 
 STRIF1   IFEQ   CHARSET,OLDCSET
          ZR   X2,ER164            *ERROR IN CHANGE*
STRIF1    ELSE
STRIF2    IFEQ   IP.CSET,IP.C63    ISSUE ERROR IF SCOPE 63 CHAR SET 
          ZR   X2,ER164            *ERROR IN CHANGE*
 STRIF2   ENDIF 
STRIF1    ENDIF 
 NXTCVAL1 BSS    0
          BX2    X4*X2             X2: (POSSIBLE) ESCAPE CODE 
          ZR     X2,STDCH          SKIP IF ITS STANDARD DISPLAY CODE
          EQ   ER164               *ERROR IN CHANGE*
* 
 STDCH    BSS    0
          LX7    6                 SHIFT THE BUFFER 
          IX7    X7+X3             APPEND THE CHARACTER 
          SX1    X1-1              CHECK (SPECIFIED) LENGTH 
          ZR     X1,GOTALL         EXIT IF ITS ZERO 
          SB5    B5-1              NEXT CHECK CHARS-IN-WORD COUNT 
          EQ     B5,B0,WRDBND      EXIT ON WORD BOUND 
          EQ     NXTCVAL           ELSE GO GET NEXT VALUE 
* 
* 
 GOTALL   BSS    0
          SB5    B5-1 
          EQ     B5,B0,XTRAWD      SKIP IF ALREADY ON WORD BOUND
* 
          SX2    B5-1              X2 IS ZERO IF 1 BYTE LEFT
 SHFTEND  BSS    0
          LX7    6
          SB5    B5-1              REDUCE SHIFT COUNT 
          NE     B5,B0,SHFTEND     LOOP TILL WORD IS LEFT-JUSTIFIED 
* 
          ZR     X2,XTRAWD         IF ENDED BY 1 BYTE OF ZEROS
*                                     GO DUMP EXTRA WORD OF ZEROS 
          SA7    B7                DUMP FINAL WORD (MIXED CHARS AND 
*                                  ZEROS) 
          EQ     CHGVSXT     EXIT 
* 
 XTRAWD   BSS    0
          SA7    B7                DUMP LAST FULL WORD
          SX7    B0 
          SB7    B7+1              UPDATE (STRING) WORD POINTER 
          SA7    B7                DUMP -ZERO- WORD (FOR -EOS- TESTS) 
          EQ     CHGVSXT     EXIT 
* 
* 
 WRDBND   BSS    0
          SA7    B7                DUMP THE (STRING) WORD 
          SB7    B7+1              ADVANCE POINTER
          EQ     NSTRWD            GO SET UP WORD COUNT 
* 
* 
 NULLSTR  BSS    0
          SX1    B7          X1 = ADR OF STRING POINTER WORD
          RJ     =XBASRSTR   GO RELEASE OLD STRING POINTER WORD 
          SX7    B0 
          SA7    B7                NULL STRING (SPECIFIED LENGTH = 0 )
          EQ     BASACVS           EXIT 
* 
 CHGVSXT  MX1    1
          LX1    59          MASK FOR TEMP BIT IN STR PTR WORD
          SA2    STRPNTR     X2 = ADR OF STR PTR WORD 
          SA2    X2          X2 = STR PTR WORD
          BX6    -X1*X2      CLEAR TEMP BIT 
          SA6    A2          RESTORE RESULT PTR WORD
          EQ     BASACVS     EXIT 
* 
 STRPNTR  BSS    1           ADR OF STR POINTER WORD SAVED HERE 
* 
* 
* 
 BATACVS  BSS    0
          TITLE  DISPLAY CODE (BASXDIS) 
* 
* 
***              DIS RETURNS (IN X5) THE DISPLAY CODE VALUE FOR THE 
*                FIRST (IF ANY) CHARACTER OF THE STRING POINTED TO BY 
*                B7 ON ENTRY. 
* 
* 
          DATA   10HBASXDIS 
 BASXDIS  BSS    0
          JP     0
          MX3    54                CHAR MASK
          SB6    6                 BITS PER CHAR
          SA1    B7          B7 = ADR OF NULL STR 
          ZR     X1,ER167    * NON NUMERIC OR NULL STRING * 
          SB7    X1          B7 = ADR OF VARIABLE STR 
          PL     X1,DIS.A 
          SB7    X1+B4       B7 = ADR OF CONSTR STR 
 DIS.A    SA1    B7 
          LX2    B6,X1             SHIFT OFF TOP CHARACTER
          BX2    -X3*X2            MASK IT OFF
          SA4    ASCII
          ZR   X4,NOTESC           SKIP IF NOT ASCII MODE 
          SX0    X2-ESC1           TEST FOR -ESCAPE- CODE (ONE) 
          ZR     X0,DISESC         SKIP IF IT IS
          SX0    X2-ESC2           TEST FOR -ESCAPE- CODE (TWO) 
          NZ     X0,NOTESC         CONTINUE BELOW (ITS A STANDARD CHAR) 
* 
 DISESC   BSS    0
          LX1    B6,X1             GET LOWER BYTE OF -ESCAPE- COMBO 
          BX1    -X3*X1            MASK IT OFF
          LX2    6                 SHIFT -ESCAPE- CODE ALONG
          IX2    X1+X2             APPEND CHARACTER BITS
* 
* 
 NOTESC   BSS    0
          PX5    B0,X2             NOW FLOAT AND
          NX5    B6,X5             NORMALIZE THE DISPLAY CODE 
          JP     BASXDIS           EXIT 
* 
 BATXDIS  BSS    0
* 
          TITLE  LENGTH FUNCTION (BASXLEN)
* 
***              LEN RETURNS (IN X5) THE LENGTH (NO OF CHARS) IN THE
***              STRING POINTED TO BY B7 ON ENTRY.
* 
* 
* 
          DATA   10HBASXLEN 
 BASXLEN  BSS    0
          JP     0
          SA5    B7          FETCH STRING POINTER WORD
          ZR     X5,EOSMET   NULL STRING
          SB7    X5 
          PL     X5,XLEN.A   B7 = ADR OF VARIABLE STRING
          SB7    X5+B4       B7 = ADR OF CONSTANT STRING
 XLEN.A   SA3    ASCII
          NZ     X3,XLEN.B   SKIP IF IN ASCII MODE
          LX5    59-53+18    POSITION LENGTH TO BITS 17-0 
          SX5    X5          ISOLATE LENGTH FIELD 
          EQ     EOSMET      EXIT 
* 
*         IN ASCII MODE CHARS MUST BE SCANNED 
* 
 XLEN.B   BSS    0
  
          BX6    X3                X6 = ASCII MODE SWITCH 
          MX3    54                CHAR MASK
          SB6    6                 BITS PER CHAR
          SX5    B0                CLEAR COUNT
 NXTWS    BSS    0
          SX4    CHSWD             CHARS PER WORD 
          SA1    B7                LOAD NEXT (1ST ) WORD OF STRING
* 
 NXTCS    BSS    0
          LX1    B6,X1             NEXT CHARACTER 
          BX2    -X3*X1            MASK IT INTO X2
          ZR     X2,ZERO11          JUMP IF ZERO BYTE MET 
ZERO10     BSS    0 
          ZR   X6,NOTASC1          SKIP IF NOT ASCII MODE 
          SX0    X2-ESC1           CHECK FOR -ESCAPE- CODE
          ZR     X0,ESC1FND        SKIP IF MET
          SX0    X2-ESC2           CHECK FOR -ESCAPE- CODE (TWO)
          ZR     X0,ESC2FND        SKIP IF MET
 NOTASC1  BSS    0
          SX5    X5+1              ELSE UPDATE CHAR COUNT 
* 
          SX4    X4-1              REDUCE CHARS-IN-WORD COUNT 
          NZ     X4,NXTCS          LOOP WHILE NON-ZERO
          SB7    B7+1              ELSE UPDATE STRING POINTER 
          EQ     NXTWS             AND GO GET NEXT WORD FROM STRING 
* 
 ESC1FND  BSS    0           FIRST HALF OF ASCII CHAR FOUND 
 ESC2FND  BSS    0
          SX4    X4-1        REDUCE CHARS LEFT IN WORD COUNT
          NZ     X4,XLEN.C   SKIP IF SOME CHARS REMAINING IN WORD 
          SB7    B7+1        INCREMENT STRING POINTER 
          SA1    B7          FETCH NEXT WORD OF STRING
          SX4    CHSWD       REINITIALIZE COUNT OF CHARS LEFT 
 XLEN.C   LX1    B6          POSITION 2ND HALF OF ASCII CHAR
          EQ     NOTASC1     AND GO COUNT IT
* 
ZERO11     BSS    0                 ZERO BYTE MET 
          SX3    X4-1              NUMBER OF BYTES LEFT IN WORD 
          ZR     X3,ZERO12          JUMP IF LAST BYTE 
          LX3    1                 BYTES * 2
          SX7    X3 
          LX3    1                 BYTES * 4
          IX3    X3+X7             BIT COUNT
          SB6    X3-1              SHIFT COUNT FOR MASK 
          MX3    1
          AX3    B6,X3             FORM MASK TO CHECK REST OF WORD
          BX3    X3*X1
          ZR     X3,EOSMET         STRING ENDED IF REST IS ZERO 
          SB6    6                 ELSE RESET REGS
          MX3    54 
          EQ     ZERO10                AND ZERO IS VALID CHAR 
ZERO12     BSS    0 
          SA3    B7+1              IF NEXT WORD 
          ZR     X3,EOSMET            IS ZERO, STRING ENDED 
          MX3    54                ELSE RESET REG 
          EQ     ZERO10                AND ZERO IS VALID CHAR 
 EOSMET   BSS    0
          PX5    B0,X5             FLOAT
          NX5    B6,X5             AND NORMALIZE STRING LENGTH
          EQ     BASXLEN           EXIT 
* 
* 
 BATXLEN  BSS    0
          TITLE  VAL FUNCTION (BASXVAL) 
* 
* 
* 
*                VAL RETURNS (IN X5) THE VALUE OF THE (NUMERIC) STRING
*                POINTED TO BY B7 ON ENTRY. 
* 
* 
* 
          DATA   10HBASXVAL 
 BASXVAL  BSS    0
          JP     0
          SA1    B7 
          ZR     X1,ER167    B7 = ADR OF NULL STR 
          SB7    X1 
          PL     X1,VAL.A    B7 = ADR OF VARIABLE STR 
          SB7    X1+B4       B7 = ADR OF CONSTANT STR 
 VAL.A    BSS    0
          SX7    B5 
          SA7    SAVFET            DUMP THE -FET-POINTER
          SB5    DATFET      SET UP PSEUDO FET
          SX6    B7 
          SA6    B5+FETFRST 
          SA6    B5+FETIN 
          SA6    B5+FETOUT
          IFC    EQ,,"OS.NAME",SCOPE, 
          SA3    ASCII       SAVE ASCII 
          SX6    X3 
          SA6    DASCII 
          BX6    X6-X6
          SA6    ASCII       CLEAR ASCII FLAG 
          ENDIF 
          MX3    -18
          SX6    2
          LX1    24 
          BX3    -X3*X1      LENGTH OF STRING IN CHAR 
          SX2    10 
 VAL.B    IX3    X3-X2
          NG     X3,VAL.C 
          SX6    X6+1        INCREMENT WORD COUNT 
          EQ     VAL.B
 VAL.C    SX6    X6+B7
          SA6    B5+FETLIMT 
          SA3    =XDLMTSW 
          BX6    X6-X6       CLEAR X6 (REAL NUMBER) 
          BX7    X3 
          SA6    A3          TURN OFF DELIMETER SWITCH
          SA7    SAVDIM      SAVE ORIGINAL DELIMETER SWITCH 
          SA2    B5+FETCHAR 
          SB7    X2+INPBUFF+1 
          SX1    EOB
          BX3    X3-X3
* 
*   BASICON PERFORMS UNPACKING BEFORE CONVERSION
*   ENTRY CONDITION IS (B5) = FET ADDRESS 
*                       BUFFER IS EMPTY UPON ENTRY
* 
* 
          RJ     BASICON           CALL -INPUT CONVERT- 
* 
          SA3    SAVDIM 
          BX7    X3          RESTORE DELIMETER SWITCH 
          SA7    =XDLMTSW 
          BX7    X7-X7
          SA7    SKIPEOL
          IFC    EQ,,"OS.NAME",SCOPE, 
          SA3    ASCII       RESTORE ASCII
          SX7    X3 
          SA7    ASCII
          ENDIF 
          NG     X1,ER167    *NON-NUMERIC STRING* 
* 
          SA1    B7                PICK UP TERMINATOR 
          SX1    X1-EOSB
          NZ     X1,ER167    *NON-NUMERIC STRING* 
          BX5    X6                MOVE THE RESULT TO X5
          SA1    SAVFET 
          SB5    X1                RESTORE THE -FET- POINTER
          BX7    X1 
          SA7    FFCHANL
          EQ     BASXVAL           AND EXIT 
* 
* 
 SAVDIM   BSS    1
 SAVFET   BSSZ   1                 -FET- POINTER DUMPED HERE
* 
* 
 DATFET   BSSZ   14          -PSEUDO FET IS HERE- 
          IFC    EQ,,"OS.NAME",SCOPE, 
 DASCII   BSSZ   1
          ENDIF 
* 
* 
 BATXVAL  BSS    0
          TITLE  SUBSTRING REPLACEMENT (BASANSL)
* 
*         BASANSL - ANSI SUBSTRING REPLACEMENT (LEFT).
* 
*         PURPOSE - TO EFFECT SUBSTRING REPLACEMENT REQUESTED VIA:  
*                      CASE 1: LET A$(M:N) = B$, OR 
*                      CASE 2: LET Z$ = A$(M:N) = B$. 
*                   THIS CAUSES CHARACTERS M THROUGH N (INCLUSIVE) OF A$
*                   TO BE REPLACED BY THE CHARACTERS OF B$, THE SOURCE
*                   STRING. CHARACTERS ARE NUMBERED FROM THE LEFT, FROM 
*                   ONE.
*                   RULES FOR M,N:  
*                      1. IF M < 1, THEN M IS CONSIDERED TO EQUAL 1.
*                      2. IF M > LEN(A$), THEN THE SUBSTRING ADDRESSED
*                         FOR REPLACEMENT IS THE NULL STRING IMMEDIATE- 
*                         LY FOLLOWING THE LAST CHARACTER OF A$.
*                      3. IF N > LEN(A$), THEN N IS CONSIDERED TO EQUAL 
*                         LEN(A$).
*                      4. IF M > N, THEN THE SUBSTRING ADDRESSED FOR
*                         REPLACEMENT IS THE NULL STRING IMMEDIATELY
*                         PRECEDING THE M-TH CHARACTER OF A$. 
* 
*                   NOTE THAT N IS SIGNIFICANT ONLY IF N >= M.
* 
*         ENTRY - (B6) = ADDRESS OF TARGET STRING POINTER WORD (A$).
*                 (B7) = ADDRESS OF SOURCE STRING POINTER WORD (B$).
*                 (X4) = STARTING CHAR POS IN A$ (M). 
*                 (X5) = ENDING CHAR POS IN A$ (N). 
*                 (X0) = 0, FOR CASE 1 REPLACEMENT. 
*                      = 1, FOR CASE 2 REPLACEMENT. 
* 
*         EXIT - THE STRING REPLACEMENT HAS BEEN COMPLETED. 
*                THE POINTER WORD FOR A$ INDICATES THE RESULTANT STRING.
*                FOR CASE 1 REPLACEMENT, THE SOURCE STRING (B$) HAS BEEN
*                RELEASED, IF IT WAS TEMPORARY. 
* 
*         USES - ALL BUT A0, B2, B4, B5, B7.
* 
*         ENTRY POINTS
*                BASANSL - FWA OF THIS ROUTINE + TEMPORARY CELLS. 
*                BATANSL - LWA+1 OF THIS ROUTINE + TEMPORARY CELLS. 
* 
*         CALLS  BASASTR - ASSIGN STRING VALUE. 
*                BASCPYC - COPY/DISCARD LOGICAL CHARACTERS. 
*                BASGSTR - GET STRING SPACE.
*                BASRSTR - RELEASE STRING SPACE.
*                BASTSTR - TRUNCATE STRING. 
*                ER168   - ISSUE DIAGNOSTIC 168, THEN ABORT.
          SPACE  4
          ENTRY  BASANSL
          ENTRY  BATANSL
  
          DATA   10HBASANSL 
 BASANSL  JP     *+1S17      ENTRY/EXIT.
* 
*                            SAVE REGISTERS.
* 
          SX6    B2 
          SA6    ANSLB2      SAVE (B2). 
          SX7    B4 
          SA7    ANSLB4      SAVE (B4). 
          SX6    B5 
          SX7    B6 
          SA6    ANSLB5      SAVE (B5). 
          SA7    ANSLB6      SAVE (B6). 
          SX6    B7 
          SA6    ANSLB7      SAVE (B7). 
          SX7    X0 
          SA7    ANSLX0      SAVE (X0). 
* 
*                            UNFLOAT AND TRUNCATE M AND N.
* 
          SA1    BASANSI     ROUND THE ARGUMENTS IF 
          ZR     X1,BASANS1  IN ANSI MODE.
          BX6    X6-X6
          PX6    X6 
          RX4    X4+X6
          RX5    X5+X6
 BASANS1  BSS    0
          UX4    B4,X4
          LX4    B4,X4       (X4) = M.
          UX5    B4,X5
          LX5    B4,X5       (X5) = N.
* 
*                            ADJUST M AND N, THEN SAVE X4, X5.
* 
          SX6    X4-1 
          PL     X6,ANSL2    IF M >= 1. 
          SX4    1           FOR M < 1, CONSIDER M = 1. 
 ANSL2    IX6    X5-X4
          PL     X6,ANSL3    IF N >= M. 
          BX5    X5-X5       FOR N < M, CONSIDER N = 0. 
 ANSL3    BX6    X4 
          LX7    X5 
          SA6    ANSLX4      SAVE (X4) AFTER TRUNCATION AND ADJUSTMENT. 
          SA7    ANSLX5      SAVE (X5) AFTER TRUNCATION AND ADJUSTMENT. 
* 
*                            FIND PHYSICAL LENGTHS FOR A$ AND B$. 
* 
          SA3    B6          (X3) = POINTER WORD FOR A$.
          LX3    0-36        RIGHT JUSTIFY LENGTH FIELD.
          SX6    X3 
          SA6    PLENA       PHYSICAL LENGTH OF A$. 
          SA3    B7          (X3) = POINTER WORD FOR B$.
          LX3    0-36        RIGHT JUSTIFY LENGTH FIELD.
          SX7    X3 
          SA7    PLENB       PHYSICAL LENGTH OF B$. 
* 
*                            RESERVE COMBINED STRING LENGTH.
* 
          IX2    X6+X7       (X2) = COMBINED LENGTH OF STRINGS. 
          SX1    NEWA$       (X1) ADDRESS OF LOCAL POINTER WORD.
          RJ     =XBASGSTR   GET STRING SPACE.
* 
*                            COPY M - 1 LOGICAL CHARACTERS. 
* 
          SA2    B6          (X2) = SOURCE STRING (A$) POINTER WORD.
          SB4    B0          (B4) = 0 FOR ABSOLUTE STRING POINTER.
          PL     X2,ANSL4    IF STRING IS NOT LOCATED IN CONSTANT AREA. 
          SA3    ANSLB4 
          SB4    X3          (B4) = FWA OF CONSTANT AREA. 
 ANSL4    SA2    X2+B4       (A2) = ADDRESS OF SOURCE STRING (A$).
          SB2    WORD        SET FULL SOURCE WORD.
          SA1    NEWA$       (X1) = TARGET STRING (NEWA$) POINTER WORD. 
          SB6    X1          (B6) = ADDRESS OF TARGET STRING (NEWA$). 
          SB3    B2          SET EMPTY TARGET WORD. 
          SA1    PLENA
          SB4    X1          (B4) = PHYSICAL LENGTH OF SOURCE STRING A$.
          SX0    1           SET TO COPY CHARACTERS.
          SA1    ANSLX4      (X1) = TRUNCATED, ADJUSTED VALUE OF M. 
          SB5    X1-1        (B5) = NO. OF LOGICAL CHARACTERS TO COPY.
          RJ     =XBASCPYC   COPY/DISCARD LOGICAL CHARACTERS. 
* 
*                            SAVE PHYSICAL LENGTH COPIED TO NEW STRING. 
* 
          SA1    PLENA       (X1) = PHYSICAL LENGTH OF SOURCE STRING A$.
          SX6    B4          (X6) = REMAINING PHYSICAL LENGTH OF A$.
          IX6    X1-X6       (X6) = PHYSICAL LENGTH OF TARGET (NEWA$).
          SA6    PLENT
* 
*                            DISCARD UP TO N-TH LOGICAL CHAR. 
* 
          SA1    ANSLX4      (X1) = TRUNCATED, ADJUSTED VALUE OF M. 
          SA3    ANSLX5      (X3) = TRUNCATED, ADJUSTED VALUE OF N. 
          IX3    X3-X1
          SB5    X3+B1       (B5) = N - M + 1, (CHARS TO DISCARD).
          BX0    X0-X0       CLEAR TO DISCARD CHARACTERS. 
          RJ     =XBASCPYC   COPY/DISCARD LOGICAL CHARACTERS. 
* 
*                            RETAIN INTERMEDIATE POSITION IN A$.
* 
          SX6    A2 
          SX7    B2 
          SA6    INTA2       INTERMEDIATE A$ SOURCE WORD. 
          SA7    INTB2       INTERMEDIATE A$ SOURCE BITS. 
          SX6    B4 
          SA6    INTB4       INTERMEDIATE A$ SOURCE LENGTH. 
* 
*                            CALCULATE FINAL TARGET LENGTH. 
* 
          SA1    PLENB       (X1) = PHYSICAL LENGTH OF B$.
          SA3    PLENT       (X3) = CURRENT LENGTH OF TARGET. 
          IX6    X6+X3
          IX6    X6+X1       (X6) = FINAL LENGTH FOR TARGET.
          SX3    X6-BSTRLEN 
          PL     X3,=XER168  IF TARGET STRING WILL EXCEED MAX LENGTH. 
          SA6    PLENT       SAVE FINAL RESULT LENGTH OF TARGET.
* 
*                            COPY ALL CHARS OF B$.
* 
          SA2    ANSLB7      (X2) = ADDRESS OF B$ POINTER WORD. 
          SA2    X2          (X2) = B$ POINTER WORD.
          SB4    B0          (B4) = 0 FOR ABSOLUTE STRING POINTER.
          PL     X2,ANSL5    IF NOT A CONSTANT STRING.
          SA3    ANSLB4 
          SB4    X3          (B4) = FWA OF CONSTANT AREA. 
 ANSL5    SA2    X2+B4       (A2) = ADDRESS OF SOURCE STRING (B$).
          SB4    X1          (B4) = PHYSICAL LENGTH OF SOURCE (B$). 
          SB5    B4          (B5) = LOGICAL CHARS TO COPY (ALL).
          SX0    B1          SET TO COPY CHARACTERS.
          SB2    WORD        SET FULL SOURCE WORD.
          RJ     =XBASCPYC   COPY/DISCARD LOGICAL CHARACTERS. 
* 
*                            COPY REMAINING CHARS OF A$.
* 
          SA2    INTA2
          SA1    INTB2
          SA2    X2          RESTORE INTERMEDIATE A$ SOURCE WORD. 
          SB2    X1          RESTORE INTERMEDIATE A$ SOURCE BITS. 
          SA3    INTB4
          SB4    X3          RESTORE INTERMEDIATE A$ SOURCE LENGTH. 
          SB5    B4          (B5) = LOGICAL CHARS TO COPY (ALL).
          RJ     =XBASCPYC   COPY/DISCARD LOGICAL CHARACTERS. 
* 
*                            SUPPLY ZERO BYTE WORD, MAYBE.
* 
          SB7    B3-12D 
          GE     B7,ANSL6    IF >= 12 BITS OF ZERO BYTE IN LAST WORD. 
          BX6    X6-X6
          SA6    B6+B1       SUPPLY TRAILING ZERO BYTE WORD.
 ANSL6    BSS    0
* 
*                            TRUNCATE TARGET STRING TO ACTUAL LENGTH. 
* 
          SA2    PLENT       (X2) = PHYSICAL LENGTH OF TARGET (NEWA$).
          SX1    NEWA$       (X1) = ADDRESS OF NEWA$ POINTER WORD.
          RJ     =XBASTSTR   TRUNCATE STRING. 
* 
*                            ASSIGN TARGET STRING TO A$.
* 
          SB7    NEWA$       (B7) = ADDR OF SOURCE PTR WD (NEWA$).
          SA2    ANSLB6 
          SB6    X2          (B6) = ADDR OF TARGET PTR WD (A$). 
          RJ     =XBASASTR   ASSIGN STRING VALUE. 
* 
*                            RELEASE SOURCE STRING B$ IF TEMPORARY. 
* 
          SA1    ANSLX0      (X1) = 0, IF CASE 1 REPLACEMENT. 
          NZ     X1,ANSL7    IF NOT CASE 1. 
          SA1    ANSLB7      (X1) = ADDRESS OF B$ POINTER WORD. 
          SA2    X1          (X1) = B$ POINTER WORD.
          LX2    1           LEFT JUSTIFY TEMPORARY BIT.
          PL     X2,ANSL7    IF NOT A TEMPORARY SOURCE STRING.
          RJ     =XBASRSTR   RELEASE STRING SPACE.
 ANSL7    BSS    0
* 
*                            RESTORE REGISTERS AND EXIT.
* 
          SA1    ANSLB2 
          SA2    ANSLB4 
          SB2    X1          RESTORE (B2).
          SB4    X2          RESTORE (B4).
          SA1    ANSLB5 
          SA2    ANSLB7 
          SB5    X1          RESTORE (B5) 
          SB7    X2          RESTORE (B7) 
          EQ     BASANSL     EXIT.
  
  
*                            TEMPORARY STORAGE FOR BASANSL. 
  
 ANSLB2   BSS    1           (B2) AT TIME OF BASANSL CALL.
 ANSLB4   BSS    1           (B4) AT TIME OF BASANSL CALL.
 ANSLB5   BSS    1           (B5) AT TIME OF BASANSL CALL.
 ANSLB6   BSS    1           (B6) AT TIME OF BASANSL CALL.
 ANSLB7   BSS    1           (B7) AT TIME OF BASANSL CALL.
 ANSLX0   BSS    1           (X0) AT TIME OF BASANSL CALL.
 ANSLX4   BSS    1           (X4) AT CALL TIME, TRUNCATED AND ADJUSTED. 
 ANSLX5   BSS    1           (X5) AT CALL TIME, TRUNCATED AND ADJUSTED. 
  
 INTA2    BSS    1           (A2) FROM INTERMEDIATE STEP. 
 INTB2    BSS    1           (B2) FROM INTERMEDIATE STEP. 
 INTB4    BSS    1           (B4) FROM INTERMEDIATE STEP. 
  
 NEWA$    BSS    1           LOCAL POINTER WORD FOR TARGET STRING.
  
 PLENA    BSS    1           PHYSICAL LENGTH OF A$ SOURCE STRING. 
 PLENB    BSS    1           PHYSICAL LENGTH OF B$ SOURCE STRING. 
 PLENT    BSS    1           PHYSICAL LENGTH OF NEWA$ TARGET STRING.
  
  
 BATANSL  BSS    0           MARKS END OF SPACE FOR BASANSL.
          TITLE  SUBSTRING EXTRACTION (BASANSR) 
* 
*         BASANSR - ANSI SUBSTRING REPLACEMENT (RIGHT). 
* 
*         PURPOSE - TO EFFECT SUBSTRING EXTRACTION VIA THE ANSI 
*                   SUBSTRING ADDRESSING NOTATION.
*                            E.G. 
*                               B$=A$(M:N)
*                   THIS CAUSES EXTRACTION OF THE SUBSTRING CONSISTING
*                   OF CHARACTERS M THROUGH N OF THE SOURCE STRING,A$.
*                   (THIS TEMPORARY SUBSTRING CAN BE SUBSEQUENTLY 
*                   EQUATED TO B$ BY THE STRING ASSIGNMENT ROUTINE.)
* 
*                   A$ IS A STRING VARIABLE.  M AND N REPRESENT THE 
*                   TRUNCATED INTEGER VALUE OF SOME NUMERIC EXPRESSION
*                   THE CHARACTERS OF A$ ARE NUMBERED FROM THE LEFT 
*                   STARTING WITH ONE.
* 
*                   RULES FOR M AND N:  
*                            1. IF M<1, THEN M IS CONSIDERED TO EQUAL 1.
*                            2. IF M>LEN(A$), THEN THE SUBSTRING
*                               ADDRESSED FOR EXTRACTION IS THE NULL
*                               STRING IMMEDIATELY FOLLOWING THE LAST 
*                               CHARACTER OF A$.
*                            3. IF N>LEN(A$), THEN N IS CONSIDERED TO 
*                               EQUAL LEN(A$).
*                            4. IF M>N, THEN THE SUBSTRING ADDRESSED
*                               FOR EXTRACTION IS THE NULL STRING PRE-
*                               CEDING THE MTH CHARACTER OF A$. 
* 
*                            NOTE THAT N IS SIGNIFICANT ONLY IF N>=M. 
* 
*         ENTRY   - A3 = ADDRESS OF SOURCE STRING POINTER WORD (A$).
*                   X4 = STARTING CHAR POSITION IN A$ FOR EXTRACTION (M)
*                   X5 = ENDING CHAR POSITION IN A$ FOR EXTRACTION (N). 
* 
*         EXIT    - B7 = ADDRESS OF WORD CONTAINING OFFSET (ADDRESS-B2) 
*                            OF STRING POINTER WORD FOR EXTRACTED 
*                            SUBSTRING. THIS RESULT EXTRACTED STRING
*                            IS IN THE DYNAMIC STRING AREA AS A 
*                            TEMPORARY. THE SOURCE STRING (A$) IS 
*                            UNCHANGED. 
* 
* 
          DATA   10HBASANSR 
 BASANSR  BSS    0
          JP     *+1S17      ENTRY/EXIT 
* 
*  SAVE BASIC POINTERS
* 
          SX7    B5 
          SA7    ANSRB5      SAVE FET POINTER REGISTER. 
          SX6    B4 
          SA6    ANSRB4      SAVE POINTER TO CONSTANT AREA. 
          SX7    B2 
          SA7    ANSRB2      SAVE POINTER TO VARIABLE AREA. 
* 
* *** SAVE OTHER REGISTERS FOR TESTING ONLY *** 
          BX6    X5 
          SA6    ANSRX5 
          BX7    X4 
          SA7    ANSRX4 
          BX6    X3 
          SA6    ANSRX3 
          SX7    A3 
          SA7    ANSRA3 
* 
*  INTEGERIZE AND CHECK M AND N.
* 
 ANSR1    BSS    0
          SA1    BASANSI     ROUND THE ARGUMENTS IF 
          ZR     X1,BASNANS2 IN ANSI MODE.
          BX6    X6-X6
          PX6    X6 
          RX4    X4+X6
          RX5    X5+X6
 BASNANS2 BSS    0
          NX4    X4,B6
          UX4    X4,B6
          LX4    X4,B6       X4=M.
          NX5    X5,B6
          UX5    X5,B6
          LX5    X5,B6       X5=N.
* 
          SX6    X4-1 
          PL     X6,ANSR2    BR IF M>=1 
          SX4    1           FOR M<1, CONSIDER M=1. 
 ANSR2    BSS    0
          BX6    X4 
          BX7    X5 
          SA6    ANSRX4I     SAVE M (X4) AFTER INTEGERI-
*                            ZATION AND ADJUSTMENT. 
          SA7    ANSRX5I     SAVE N (X5) AFTER INTEGERIZATION.
          IX6    X5-X4
          NG     X6,ANSREND  GO RETURN A NULL STRING IF M>N.
* 
*  CALCULATE REQUIRED STRING SPACE FOR EXTRACTED RESULT.
* 
          SX6    X6+1        NEW RESULT STRING LENGTH,T, = N-M+1
*                            = NO. OF LOGICAL CHARACTERS TO EXTRACT.
          SA6    ANSREX      SAVE NO. OF CHARACTERS TO EXTRACT. 
          BX2    X6          X2 = NEW RESULT STRING LENGTH,T = N-M+1. 
          SA1    ASCII
          ZR     X1,ANSR3    SKIP IF NOT ASCII MODE.
          LX2    1           DOUBLE CHAR COUNT,T, TO PROVIDE
*                            SPACE FOR 12-BIT CHARS IN ASCII MODE.
* 
 ANSR3    BSS    0
* 
*  OBTAIN LENGTH OF SOURCE STRING (A$). 
* 
          LX3    59-53+18    POSITION STRING LENGTH TO BITS 0-17. 
          SX5    X3          GET RID OF UPPER BITS. 
          ZR     X5,ANSREND  FORCE NULL STRING RETURN IF SOURCE IS NULL.
* *** 
          BX6    X5 
          SA6    ANSRSL      SAVE PHYSICAL LENGTH OF SOURCE STRING. 
* *** 
* 
*  GO GET STRING SPACE FOR THE EXTRACTED RESULT.
* 
          SX1    ANSRPTR     X1 = ADDR OF LOCAL TEMP. RESULT PTR WORD.
*                            X2 = MAX. REQUIRED LENGTH FOR RESULT STRING
          RJ     =XBASGSTR   GO GET STRING SPACE IN DYNAMIC STRING
*                            AREA FOR THE EXTRACTED RESULT STRING.
* 
*  ON RETURN, X1 = FWA OF TEMP. RESULT STRING.
*             X2 = SPACE (NO. OF CHARS) RESERVED FOR RESULT STRING. 
* 
*  SET UP STARTING POINTERS TO SOURCE AND RESULT STRINGS. 
* 
 ANSR4    BSS    0
          SA3    A3          FETCH SOURCE STRING POINTER WORD.
          PL     X3,ANSR5    BR IF SOURCE IS NOT A CONSTANT STRING. 
          SX3    X3+B4       ADD CONSTANT OFFSET TO STRING LOCATION 
*                            IF STRING IS A CONSTANT. 
* 
 ANSR5    BSS    0
* *** 
          SX6    X3 
          SA6    ANSRSRC     SAVE FWA OF SOURCE STRING (A$).
* *** 
          SX7    X1 
          SA7    ANSRSLT     SAVE FWA FOR RESULT STRING.
* 
*  DISCARD FIRST M-1 CHARACTERS OF SOURCE STRING. 
* 
          SA2    X3          A2 = FWA OF SOURCE STRING (A$).
          SB2    WORD        B2 = FULL WORD OF BITS AVAIL. IN SRCE WORD.
          SB6    X1          B6 = FWA OF RESULT STRING. 
          SB3    B2          B3 = SET 60 BITS AVAIL.(EMPTY RESULT WORD).
          SB4    X5          B4 = PHYSICAL LENGTH OF SOURCE STRING A$.
          MX0    0           SET FLAG TO DISCARD CHARACTERS.
          SA1    ANSRX4I     X1 = INTEGERIZED VALUE OF M. 
          SB5    X1-1        B5 = NO. OF LOGICAL CHARS TO DISCARD.
          RJ     =XBASCPYC   COPY/DISCARD LOGICAL CHARACTERS. 
* 
*  SAVE REMAINING LENGTH OF SOURCE STRING A$. 
* 
 ANSR7    BSS    0
          SX6    B4          B4 = REMAINING PHYSICAL LENGTH OF A$.
          SA6    ANSRRL1     SAVE REMAINING LENGTH. 
* 
*                NOTE -      THE REMAINING LENGTH OF A$ AFTER THE 
*                            DISCARD WILL BE ZERO AND A NULL EXTRACTED
*                            STRING WILL BE RETURNED IF M>LEN(A$).
*                            (I.E. IF PHYSICAL LENGTH OF A$ WAS REACHED 
*                            BEFORE M-1 LOGICAL CHARS WERE DISCARDED.)
          SA1    ANSREX      FETCH NO. OF CHARS TO EXTRACT. 
          SB5    X1          SET NO. OF LOGICAL CHARS TO COPY (EXTRACT).
          SX0    1           SET FLAG TO COPY CHARACTERS. 
          RJ     =XBASCPYC   DISCARD LOGICAL CHARACTERS.
* 
*  ENSURE END-OF-STRING (EOS) INDICATION. 
* 
          SB7    B3-12D 
          GE     B7,ANSR8    BR IF >=12 BITS OF ZERO IN LAST RESULT WORD
          MX6    0
          SA6    B6+B1       SUPPLY TRAILING ZERO WORD TO RESULT FOR
*                            EOS INDICATION.
* 
*  COMPUTE THE PHYSICAL LENGTH OF THE EXTRACTED RESULT STRING.
* 
 ANSR8    BSS    0
          SA1    ANSRRL1     GET PREVIOUS REMAINING PHYS. LENGTH OF A$. 
          SX4    B4          GET REMAINING PHYS. LENGTH OF A$ AFTER 
*                            THE EXTRACTION.
          IX2    X1-X4       COMPUTE PHYS. LENGTH OF EXTRACTED STRING.
* 
*  TRUNCATE RESERVED SPACE TO ACTUAL PHYSICAL LENGTH OF RESULT STRING.
* 
          SX1    ANSRPTR     X1=ADDR OF TEMP. RESULT PTR WORD.
*                            X2=PHYSICAL LENGTH OF RESULT STRING. 
          RJ     =XBASTSTR   TRUNCATE RESULT STRING TO ACTUAL 
*                            PHYSICAL LENGTH. 
* 
 ANSREND  BSS    0
*  RESTORE BASIC POINTER REGISTERS BEFORE USING THEM. 
* 
          SA1    ANSRB5 
          SB5    X1          RESTORE THE FET POINTER. 
          SA1    ANSRB4 
          SB4    X1          RESTORE THE CONSTANT AREA POINTER. 
          SA1    ANSRB2 
          SB2    X1          RESTORE THE VARIABLE AREA POINTER. 
*  COMPUTE OFFSET OF RESULT POINTER RELATIVE TO THE VARIABLE AREA.
          SB7    ANSRPTR     B7 = ADDR OF PTR WORD FOR RESULT STRING. 
          SX7    B7-B2       OFFSET OF RESULT POINTER RELATIVE TO 
*                            THE VARIABLE AREA. 
* *** 
          SA7    ANSRRA      SAVE OFFSET ADDR OF RESULT STRING PTR WORD.
* *** 
          SB7    ANSRRA      SET B7 TO POINT TO THE WORD CONTAINING THE 
*                            ADDRESS-B2 OF THE RESULT STRING PTR WORD.
*                            THE RESULT IS IN THE DYNAMIC STRING AREA.
*  EXIT FROM ROUTINE. 
          EQ     BASANSR     EXIT.
* 
* 
 ANSRPTR  BSSZ   1           POINTER WORD FOR TEMP. EXTRACTED RESULT
*                            STRING.  MUST INITIALLY =0.
 ANSRRA   BSSZ   1           RESULT STRING POINTER ADDR-B2. 
 ANSRB5   BSS    1           SAVE AREA FOR FET POINTER. 
 ANSRB4   BSS    1           SAVE AREA FOR POINTER TO CONSTANT AREA.
 ANSRB2   BSS    1           SAVE AREA FOR POINTER TO VARIABLE AREA.
 ANSREX   BSS    1           NO. OF LOGICAL CHARS TO EXTRACT=N-M+1. 
 ANSRX4I  BSS    1           INTEGERIZED, ADJUSTED VALUE OF M.
 ANSRX5I  BSS    1           INTEGERIZED VALUE OF N.
 ANSRRL1  BSS    1           REMAINING PHYS. LENGTH OF A$ AFTER 
*                            FIRST DISCARD OF M-1 LOGICAL CHARACTERS. 
* 
 ANSRSL   BSS    1           PHYSICAL LENGTH OF SOURCE STRING, A$.
 ANSRSRC  BSS    1           FWA OF SOURCE STRING, A$.
 ANSRSLT  BSS    1           FWA OF RESULT STRING.
* *** SAVE AREAS FOR -TESTING ONLY- REGISTERS.
 ANSRX5   BSS    1
 ANSRX4   BSS    1
 ANSRX3   BSS    1
 ANSRA3   BSS    1
* *** 
* 
 BATANSR  BSS    0
* 
          TITLE  SUBSTR FUNCTION (BASXSBS)
* 
* 
* 
* 
*                                  THE -SUBSTR- FUNCTION IS EFFECTED
*                                  VIA BASXSBS
* 
* 
*                ON ENTRY 
*                            A5 = SOURCE STRING 
*                            X4 = CHARACTER POSITION AT WHICH TO START
*                            X3 = NO OF CHARACTERS (B6 = 3) 
*                            B6 = NO OF PARAMETERS PASSED 
* 
*         ON EXIT            B7 - ADR OF WORD CONTAINING ADDRESS-B2 
*                            OF STRING POINTER WORD. RESULT 
*                            STRING IS IN DYNAMIC STRING AREA 
* 
* 
* 
          DATA   10HBASXSBS        SUBSTR 
 BASXSBS  BSS    0
          JP     0
* 
* 
***********       NOTE INTERCHANGE OF PARAMETERS
* 
* 
          SA5    A5          FETCH SOURCE STR POINTER WORD
          SB7    A5          B7 = ADDRESS OF STR PTR WORD 
* 
          LX5    59-53+18    POSITION LENGTH TO BITS 17-0 
          SX2    X5          ISOLATE LENGTH IN X2 
          SB6    B6-2 
          ZR     B6,XSBS.A   SKIP IF ONLY 2 PARAMS PASSED 
          SA1    BASANSI     ROUND THE ARGUMENT IF
          ZR     X1,BASXSBS2 IN ANSI MODE.
          BX1    X1-X1
          PX1    X1 
          RX3    X3+X1
 BASXSBS2 BSS    0
          NG     X3,ER169    *ILL SUBSTR PARAM* 
          UX2    B6,X3       UNFLOAT REQUESTED NUMBER OF
          LX2    B6,X2       CHARS INTO X2
* 
 XSBS.A   BX5    X4          X5 = START CHAR POSITION 
          BX4    X2          X4 = NUMBER OF CHARS TO EXTRACT
          SB3    B0          B3 = COUNT OF 6-BIT CHARS EXTRACTED
* 
 NOSWAP   BSS    0
* 
          SX7    B5 
          SA7    SAVFET            SAVE THE -FET- POINTER 
          SA1    BASANSI     ROUND THE ARGUMENT IF
          ZR     X1,BASXSBS3 IN ANSI MODE.
          BX1    X1-X1
          PX1    X1 
          RX5    X5+X1
 BASXSBS3 BSS    0
          NG     X5,ER169    *ILLEGAL SUBSTR PARAMETER* 
          UX5    B5,X5
          LX5    B5,X5             UNFLOAT STARTING CHAR NO 
* 
          ZR     X5,ER169    *ILLEGAL SUBSTR PARAMETER* 
          SX3    X5-BSTRLEN        TEST FOR STRING BOUND
          NG     X3,POSNOK         SKIP IF SPEC START POSN IS .LE.
*                                  MAXIMUM STRING LENGTH
          EQ     ER169       *ILLEGAL SUBSTR PARAMETER* 
* 
* 
 POSNOK   BSS    0
          SX7    X2 
          SA7    SAVX2
          NZ     X2,NOTNULL 
          SA1    SUBPTR 
          SB7    A1 
          LX1    59-53+18 
          SX2    X1 
 NOTNULL  SA3    ASCII
          ZR     X3,XSBS.B   SKIP IF NOT ASCII
          LX2    1           DOUBLE CHAR COUNT
 XSBS.B   SX1    SUBPTR      X1 = ADDRESS OF POINTER WORD 
          RJ     =XBASGSTR   GO GET STRING SPACE
          SB6    X1          B6 = FWA OF STRING SPACE 
          SA1    B7          X1 = SOURCE STR POINTER WORD 
          PL     X1,JOININ   SKIP IF NOT A CONSTANT STR 
          SX1    X1+B4       ADD CONST OFFSET IF STR IS CONST 
* 
 JOININ   BSS    0
          SB7    X1          B7 = FWA OF SOURCE STR 
*                            NOTE - FWA CANNOT BE DETERMINED
*                                   BEFORE CALL TO BASGSTR BECAUSE
*                                   STR MGR MAY MOVE STRING 
          SX7    B0                CLEAR BUFFER 
          MX3    54                CHAR MASK
          SX6    CHSWD             CHARS PER WORD 
 WNEXT    BSS    0
          SB5    CHSWD
          SA1    SAVX2
          ZR     X1,CNEXT 
          SA1    B7                LOAD THE NEXT WORD OF SOURCE STRING
* 
 CNEXT    BSS    0
          LX1    6
          BX2    -X3*X1            MASK OFF NEXT CHARACTER
          ZR     X2,ZERO50         JUMP IF ZERO BYTE
ZERO51    BSS    0
* 
          SA3    ASCII             CHECK ASCII MODE SWITCH
          SX0    X3 
          MX3    54                RESTORE MASK 
          ZR   X0,NEQESC           SKIP IF NOT ASCII MODE 
          SX0    X2-ESC1           CHECK FOR -ESCAPE- CODE (ONE)
          ZR     X0,EQESC          SKIP IF MET
          SX0    X2-ESC2           CHECK FOR -ESCAPE- CODE (TWO)
          ZR     X0,EQESC          SKIP IF MET
 NEQESC   BSS    0
          SX5    X5-1 
          ZR     X5,SUBLOOP        EXIT IF START POSITION IS REACHED
* 
 EQESC    BSS    0
          BX7    X2                SAVE THE MOST-RECENT-CHAR-MET
          SB5    B5-1              CHECK CHARS-IN-WORD COUNT
          NE     B5,B0,CNEXT       LOOP WHILE NON-ZERO
* 
          SB7    B7+1              ELSE UPDATE SOURCE STRING POINTER
          EQ     WNEXT             AND GO GET NEXT WORD 
* 
* 
ZERO50    BSS    0
          SX3    B5-1              NUMBER OF BYTES LEFT IN WORD 
          ZR     X3,ZERO52         JUMP IF LAST BYTE OF WORD
          LX3    1                 BYTES * 2
          SX6    X3 
          LX3    1                 BYTES * 4
          IX3    X3+X6             BIT COUNT
          SX6    B5                SAVE B5 IN REG 
          SB5    X3-1              SHIFT COUNT FOR MASK 
          MX3    1
          AX3    B5,X3             FORM MASK FOR REST OF WORD 
          SB5    X6                RESET B5 
          BX3    X3*X1             EXTRACT REST OF WORD 
          ZR     X3,XSBS.D   STR ENDED BEFORE START CHAR
          MX3    54                ELSE RESET REGS
          SX6    CHSWD
          EQ     ZERO51               AND ZERO IS VALID CHAR
ZERO52    BSS    0
          SA3    B7+1              NEXT WORD
          ZR     X3,XSBS.D   STR ENDED BEFORE START CHAR REACHED
          MX3    54                ELSE RESET REG 
          EQ     ZERO51               AND ZERO IS VALID CHAR
* 
* 
* 
* 
* 
* 
 SUBLOOP  BSS    0
          SA3    ASCII
          SX0    X3 
          MX3    54                RESTORE MASK 
          ZR   X0,SUBLOOP1         SKIP IF NOT ASCII MODE 
*                                  CHECK IF THE PREVIOUS CHARACTER
*                                  WAS AN -ESCAPE-
          SX0    X7-ESC1
          ZR     X0,ESCSEEN        SKIP IF -ESCAPE- MET (ONE) 
          SX0    X7-ESC2
          ZR     X0,ESCSEEN        SKIP IF -ESCAPE- WAS MET (TWO) 
 SUBLOOP1 BSS    0
* 
          SX7    B0                ELSE CLEAR BUFFER REGISTER 
          EQ     CHLOOP            JOIN OUTPUT LOOP 
* 
* 
 ESCSEEN  BSS    0
       SB3    B3+1         COUNT ESC CODE CHAR ALREADY IN BUFFER REG X7 
          SX6    X6-1              REDUCE CHARS-IN-WORD COUNT 
          EQ     CHLOOP            JOIN OUTPUT LOOP 
* 
* 
 SRCWNXT  BSS    0
          SB5    CHSWD             CHARS-PER-WORD COUNT 
          SA1    B7                LOAD THE NEXT SOURCE WORD
 CHNEXT   BSS    0
          LX1    6
          BX2    -X3*X1            MASK IT OFF
          ZR     X2,ZERO53         JUMP IF ZERO BYTE MET
ZERO54    BSS    0
* 
 CHLOOP   BSS    0
          LX7    6                 MOVE BUFFER ALONG
          IX7    X7+X2             APPEND LATEST CHARACTER
          SB3    B3+1        INC COUNT OF 6 BIT CHARS STORED
          SA3    ASCII
          SX0    X3 
          MX3    54                RESTORE MASK 
          ZR   X0,CHLOOP1          SKIP IF NOT ASCII MODE 
          SX0    X2-ESC1           CHECK FOR -ESCAPE- 
          ZR     X0,DONTCNT        SKIP IF -ESCAPE- MET (ONE) 
          SX0    X2-ESC2
          ZR     X0,DONTCNT        SKIP IF -ESCAPE- MET (TWO) 
 CHLOOP1  BSS    0
          SX4    X4-1              ELSE CHECK NO OF CHARS NEEDED
          ZR     X4,GOTENUF        SKIP IF ENOUGH MET 
* 
 DONTCNT  BSS    0
          SX6    X6-1              CHECK BUFFER-CHAR-COUNT
          NZ     X6,BNTFULL        SKIP IF IT ISNT FULL YET 
* 
          SA7    B6                ELSE DUMP THE CURRENT OUTPUT WORD
          SX7    B0                CLEAR THE BUFFER 
          SX6    CHSWD             RESTORE CHARS-PER-WORD COUNT 
          SB6    B6+1              UPDATE OUTPUT POINTER
* 
 BNTFULL  BSS    0
          SB5    B5-1              CHECK SOURCE COUNT 
          NE     B5,B0,CHNEXT      LOOP WHILE NON-ZERO
* 
          SB7    B7+1              ELSE UPDATE SOURCE WORD POINTER
          EQ     SRCWNXT           AND GO GET NEXT (STRING) WORD
* 
ZERO53    BSS    0
          SX3    B5-1              NO. OF BYTES LEFT IN SOURCE WORD 
          ZR     X3,ZERO55         JUMP IF LAST BYTE IN WORD
          LX3    1                 BYTES * 2
          SA6    ZSAVX6            SAVE X6
          SX6    X3 
          LX3    1                 BYTES * 4
          IX3    X3+X6             BIT COUNT
          SX6    B5                SAVE B5 IN REG 
          SB5    X3-1              SHIFT COUNT FOR MASK 
          MX3    1
          AX3    B5,X3             FORM MASK FOR REST OF WORD 
          SB5    X6                RESET B5 
          BX3    X3*X1             EXTRACT REST OF SOURCE WORD
          ZR     X3,ZERO56         JUMP IF STR ENDED (ZERO) 
          SA3    ZSAVX6 
          BX6    X3                RESET X6 
          MX3    54                RESET X3 
          EQ     ZERO54            AND ZERO IS VALID CHAR 
ZERO55    BSS    0
          SA3    B7+1              NEXT WORD
          ZR     X3,NONELFT        JUMP IF STR ENDED (ZERO) 
          MX3    54                ELSE RESET REG 
          EQ     ZERO54               AND ZERO IS VALID CHAR
ZERO56    BSS    0
          SA3    ZSAVX6 
          BX6    X3                RESET X6 
          EQ     NONELFT              AND STR IS ENDED
* 
* 
ZSAVX6    DATA   0
* 
* 
* 
* 
 GOTENUF  BSS    0
          SX6    X6-1              CHECK IF BUFFER WORD IS FULL 
          ZR     X6,PAKDOK         SKIP IF IT IS
* 
 NONELFT  BSS    0
 MVOVER   BSS    0
          LX7    6                 ELSE SHIFT IT ALONG
          SX6    X6-1 
          NZ     X6,MVOVER         LOOP TILL LEFT-ADJUSTED
* 
* 
 PAKDOK   BSS    0
          SX0    7777B       MASK FOR END OF STRING 
          BX6    X0*X7
          ZR     X6,XSBS.C   SKIP IF WORD HAS ZERO BYTE 
          SA7    B6          STORE IT IF NOT AND
          SB6    B6+1        INCREMENT ADDRESS
          SX7    B0          CREATE FULL ZERO WORD
 XSBS.C   SA7    B6          STORE LAST WORD
* 
 XSBS.D   SX1    SUBPTR      X1 = ADDRESS OF RESULT POINTER WORD
          SX2    B3          X2 = NUM OF 6 BIT CHARS IN STR 
          RJ     =XBASTSTR   GO TRUNCATE STRNG TO X2 CHARS
* 
 NULLSUB  SB7    SUBPTR      B7 = ADDRESS OF POINTER WORD 
          SX7    B7-B2             OFFSET OF RESULT REL. TO STR VBL AREA
          SA7    STRBFAD           RECORD ADDRESS OF WORK STRING
          SB7    STRBFAD           GET B7 TO POINT TO THE ADDRESS LOCN
          SA1    SAVFET            RESTORE -FET- POINTER
          SB5    X1 
          EQ     BASXSBS           EXIT 
* 
* 
 SUBPTR   BSSZ   1           POINTER WORD FOR RESULT STRING 
*                            MUST INITIALLY BE 0
 STRBFAD  BSSZ   1           POINTER ADR - B2 STORED HERE 
 SAVX2    BSSZ   1
* 
* 
* 
* 
* 
 BATXSBS  BSS    0
* 
* 
          TITLE  PSEUDO SUBSTR FUNCTION (BASXSBT) 
          EJECT 
          DATA   10HBASXSBT 
 BASXSBT  BSS    0
* 
*                PURPOSE: TO EFFECT PSEUDO-VARIABLE ASSIGNMENT VIA THE
*                         SUBSTR FUNCTION - EG SUBSTR(A$,I,J)=B$ CAUSES 
*                         CHARS I TO I+J-1 OF A$ TO BE  REPLACED BY 
*                         THE 1ST J CHARACTERS OF B$,THE SOURCE STRING. 
*                         ASSUMING B$ IS K CHARS LONG 3 CASES ARISE:  
*                         1. K .EQ. J : CHARS ARE IN 1 TO 1 CORRESPOND- 
*                         ANCE. 
*                         2. K .LT. J: CHARS I+K TO I+J-1 OF A$ ARE 
*                         SPACE FILLED. 
*                         3. K .GT. J: ONLY THE 1ST J CHARS OF B$ ARE 
*                         CHOSEN TO REPLACE THE RELEVANT CHARS OF A$. 
* 
* 
*                         NOTE THAT IF A$ IS LESS THAN I CHARS LONG 
*                         SPACES ARE APPENDED TO IT TO FILL THE ENSUING 
*                         GAP.
* 
* 
*                         NOTE ALSO THAT IF THE J PARAMETER IS ABSENT 
*                         THE SOURCE STRING REPLACES COMPLETELY THE 
*                         REMAINDER OF THE TARGET STRING WHICH MAY
*                         THEREFORE EMERGE EITHER LONGER OR SHORTER 
*                         THAN BEFORE.
* 
* 
*                ON ENTRY: B6 POINTS TO THE TARGET STRING 
*                          B7 POINTS TO THE SOURCE STRING 
*                          X.I HAS THE STARTING CHAR POSITION IN A$ 
*                          X.J HAS THE COUNT OF CHARS TO BE REPLACED. 
*                          X0 CONTAINS 0/1 ACCORDING AS 2/3 PARAMETERS
*                          WERE SPECIFIED IN THE ASSOCIATED SOURCE
*                          STATEMENT. 
* 
*                NOTE THAT B7 IS RESTORED ON EXIT 
* 
* 
          JP     0
          SX7    B0 
          SA7    SAVSOFF           CLEAR OFFSET 
         SA7       STRLWFLG   CLEAR FLAG INDICATING ONLY 1 WORD LEFT IN 
*                                      STRING BUFFER
         SA7       DSCRDFG    CLEAR DISCARD FLAG TO SUPPRESS
*                                  OVERFLOW CHECK 
          SX7    B5 
          SA7    SAVFET            DUMP FET POINTER 
          SX7    B4 
          SA7    SAVB4             SAVE B4
          SX7    B7 
          SA7    SAVB7             DUMP B7 (ADDRESS OF SOURCE STRING) 
          SX7    B6 
          SA7    SAVB6
* 
* 
          SA1    BASANSI     ROUND THE ARGUMENT IF
          ZR     X1,BASXSBT2 IN ANSI MODE 
          BX.Y   X.Y-X.Y
          PX.Y   X.Y
          RX.I   X.I+X.Y
 BASXSBT2 BSS    0
          NG     X.I,ER169   *ILLEGAL SUBSTR PARAMETER* (169) 
          UX.Y   B5,X.I 
          LX.Y   B5,X.Y 
          ZR     X.Y,ER169   *ILLEGAL SUBSTR PARAMETER* 
          SX.Z   X.Y-BSTRLEN
          NG     X.Z,ISIZOK2
          EQ     ER169       *ILLEGAL SUBSTR PARAMETER* (169) 
*                                  BASIC STRING LENGTH. 
* 
* 
 ISIZOK2  BSS    0
          BX.A   X.Y
          SA.Y   IPRMSIZ           SAVE SPECIFIED START POSITION
          ZR     X0,TWOPRM         SKIP IF J WAS NOT SPECIFIED
* 
          SA2    BASANSI     ROUND THE ARGUMENT IF
          ZR     X2,BASXSBT3 IN ANSI MODE.
          BX.Y   X.Y-X.Y
          PX.Y   X.Y
          RX.J   X.J+X.Y
 BASXSBT3 BSS    0
          NG     X.J,ER169   *ILLEGAL SUBSTR PARAMETER* (169) 
          UX.Y   B5,X.J 
          LX.Y   B5,X.Y 
          ZR     X.Y,NULEXIT       EXIT (DO NOTHING) IF J IS .EQ. 0 
          IX.A   X.A+X.Y           COMBINE I AND J PARAMS 
          SX.Z   X.A               SAVE THE LENGTH
          SA.Z   SAVLEN 
          SX.Z   X.Z-BSTRLEN       CHECK ON COMBINED LENGTH 
          NG     X.Z,JISOK1        SKIP IF COMBINED COUNT DOES NOT
         ZR        X.Z,JISOK1 
*                                  IMPLY STRING OVERFLOW
          EQ     ER168       *STRING OVERFLOW*
* 
* 
* 
 TWOPRM   BSS    0
          SX.Y   B0 
          SA.I   B7 
          AX.I   18+18
          SX.I   X.I         X.I = SOURCE STR LENGTH
          IX.A   X.A+X.I     X.A = MIN NEW STR LENGTH 
          SX.Z   X.A               SAVE THE LENGTH
          SA.Z   SAVLEN 
* 
 JISOK1   BSS    0
          SA.Y   JPRMSIZ           SAVE THE SPECIFIED CHAR COUNT
* 
* 
*                PREPARE TO PICK OUT THE FIRST (I-1) CHARS FROM THE 
*                TARGET STRING
* 
* 
          SX.Y   B0                BUFFER WORD
          SA.Y   SUBSTAT           CLEAR STATE (TO NORMAL NON-ESC MODE) 
          SA.Y   TRGTEOS
          SX1    XSBTPTR
          SB7    X1 
          RJ     =XBASRSTR         RETURN LOCAL STRING
          SA1    SAVLEN            RETRIEVE THE LENGTH
          SA2    B6          X2 = TARGET STR PTR WORD 
          AX2    18+18
          SX2    X2          ISOLATE LENGTH OF ORIGINAL TARGET
          IX.Z   X.A-X2      MIN NEW LENGTH - ORIG LEN
          NG     X.Z,XSBT.A  SKIP IF ORIG LEN BIGGER
          BX2    X.A         X2 = NEW LENGTH
 XSBT.A   SX1    XSBTPTR     X1 = ADR OF LOCAL PTR WORD 
          RJ     =XBASGSTR   GET STRNIG SPACE FOR RESULT
          MX6    0           CLEAR BUFFER WORD
          SB5    54                INITIAL SHIFT
          SA.I   IPRMSIZ           LOAD START CHAR POSITION 
          SX.I   X.I-1
          SA.B   B6          X.B = TARGET STR PTR WORD
          ZR     X.B,XSBT.B  SKIP IF NULL STRING
          SB6    X.B
          PL     X.B,XSBT.B  SKIP IF VARIABLE STR 
          SB6    X.B+B4      ADD CONSTANT OFFSET
 XSBT.B   SX.Z   B6 
          SA.Z   XSBTTAD     SAVE TARGET STR ADR
          SB6    X1          B6 = FWA OF NEW RESULT STR 
          ZR     X.I,IWASONE       SKIP IF SPECIFIED START POSITION IS 1
          SB4    X.Z         B4 = TARGET STR FWA
* 
          SA.B   B4                FIRST SUPPLIED WORD
          SX.J   CHSWD             BYTES PER SUPPLIED WORD
* 
          RJ     MOVICHS           GET (I-1) CHARS FROM THE TARGET
* 
          ZR     X.I,MOVSRCE       SKIP IF TARGET HAD ENOUGH CHARS
* 
* 
          SX.Z   1
          SA.Z   TRGTEOS           SET MET-EOS-IN-TARGET FLAG 
* 
          RJ     BLNKFIL           THEN SPACE-FILL THE GAP BETWEEN THE
*                                  CURRENT END OF THE TARGET STRING AND 
                                   THE SPECIFIED START POSITION.
* 
          EQ     IWASONE
* 
 MOVSRCE  BSS    0
          SA.I   JPRMSIZ
          ZR     X.I,IWASONE       SKIP IF J NOT SPECIFIED
* 
*                                  NOW SAVE ORIGINAL TARGET INDICATORS
* 
          BX.Z   X.B               CURRENT FRAGMENT 
          SA.Z   SAVSWD            DUMP IT
          BX.Z   X.J               CURRENT BYTE PER WORD COUNT
          SA.Z   SAVSBNO
          SA.A   XSBTTAD     POINTS TO START OF ORIG TARGET 
          SB7    X.A
          SB7    B4-B7             OFFSET (FROM START)
          SX.Z   B7 
          SA.Z   SAVSOFF           SAVE SOURCE OFFSET 
* 
 IWASONE  BSS    0
* 
          SA.I   JPRMSIZ           CHECK IF J WAS SPECIFIED 
          NZ     X.I,JISZRO  SKIP IF IT WAS 
         SX.I      BSTRLEN-1  FORCE A COUNT OF MAX STR LENGTH 
*                             AND LET LATER CHECKS CHECK FOR OVERFLOW 
          EQ     JISZRO            SKIP THE NEXT MOVE (THE TARGET WONT
*                                  BE NEEDED AGAIN SINCE J WAS NOT
*                                  SPECIFIED AND SO THE SOURCE STRING 
*                                  REPLACES COMPLETELY THE REMAINDER
*                                  OF THE TARGET STRING)
* 
* 
 JISZRO   BSS    0
          SX.Z   B0 
          SA.Z   SUBSTAT           CLEAR STATE
          SA.B   SAVB7
          SB4    X.B         B4 = ADR OF SOURCE STR PTR WORD
          SA.B   B4          X.B = SOURCE STR PTR WORD
          ZR     X.B,XSBT.C  SKIP IF NULL STR 
          SB4    X.B
          PL     X.B,XSBT.C  SKIP IF VARIABLE STR 
          SA.C   SAVB4
          IX.B   X.B+X.C     ADD IN CONSTANT OFFSET 
          SB4    X.B
 XSBT.C   SA.B   B4          X.B = FIRST WORD OF SOURCE STR 
          SX.J   CHSWD             CHARS PER WORD 
* 
*                                  NOTE THAT X.Y AND B5 ARE ALREADY 
*                                  IN USE AND ASSUMED BY MOVICHS
* 
          RJ     MOVICHS           PICK UP J CHARS FROM THE ASSIGNED
*                                  SOURCE STRING
* 
* 
          SA.A   JPRMSIZ
          ZR     X.A,COMEXIT       EXIT IF J WAS NOT SPECIFIED ( IE THE 
*                                  REMAINDER(IF ANY) OF THE TARGET
*                                  STRING CAN BE ABANDONED) 
          ZR     X.I,SRCLOK        SKIP IF THE ASSIGNED SOURCE STRING 
*                                  WAS AT LEAST J CHARS IN LENGTH 
* 
* 
          RJ     BLNKFIL           ELSE BLANK FILL THE REMAINING GAP
* 
* 
 SRCLOK   BSS    0
          SA.A   TRGTEOS           CHECK IF TARGET WAS EXHAUSTED BY THE 
*                                  INITIAL SCAN THRU I CHARS
          NZ     X.A,COMEXIT       EXIT IF IT WAS ALL USED
* 
* 
*                NOW PREPARE TO DISCARD THE NEXT J CHARS FROM THE 
*                ORIGINAL TARGET STRING.
* 
          SA.Y   SAVEY             SAVE CURRENT MERGED FRAGMENT 
          SX.Y   B6 
          SA.Y   SAVEB61           SAVE CURRENT MERGED RESULT POINTER 
          SX.Y   B5 
          SA.Y   SAVEB51           SAVE CURRENT SHIFT FACTOR
* 
* 
          SX.Y   B0 
          SA.Y   SUBSTAT           CLEAR STATE
          SA.I   XSBTTAD     FETCH ADR OF TARGET
          SB4    X.I
          SB6    B4                USE IT AS A TARGET ALSO
          SA.I   JPRMSIZ           SPECIFIED CHAR COUNT 
          SB5    54 
          SA.A   SAVSOFF           ORIGINAL OFFSET
          SB4    X.A+B4            USED TO FIX CURRENT LOCN W.R.T TO
*                                  THE START OF THE ORIGINAL STRING.
          SA.A   IPRMSIZ
          SX.A   X.A-1             CHECK IF I WAS SPECIFIED TO BE = 1 
          NZ     X.A,IWASNT1       SKIP IF NOT
* 
          SA.B   B4                1ST W-RD OF ORIGINAL TARGET STRING 
          SX.J   CHSWD             BYTES PER WORD COUNT 
          EQ     DISCARD
* 
 IWASNT1  BSS    0
          SA.J   SAVSBNO           ORIGINAL BYTE COUNT
          SA.B   SAVSWD            CURRENT FRAGMENT 
* 
 DISCARD  BSS    0
         SX.Y      1          SET DISCARD FLAG TO SUPPRESS
         SA.Y      DSCRDFG        OVERFLOW CHECK
* 
          RJ     MOVICHS           DISCARD THE NEXT J CHARS FROM THE
*                                  ORIGINAL TARGET STRING 
* 
* 
          SA.A   SAVEY
          BX.Y   X.A               CURRENT FRAGMENT 
          SA.A   SAVEB61
          SB6    X.A               REAL TARGET ADDRESS RESET
          SA.A   SAVEB51
          SB5    X.A               CURRENT SHIFT
          NZ     X.I,COMEXIT       SKIP IF AN -EOS- STOPPED THE SCAN
*                                  IE THE TARGET (ORIGINAL) IS ALL THRU 
* 
* 
          SB7    BSTRWDS           MAX BASIC STRING LENGTH
          SA.A   XSBTPTR     X.A = NEW STR POINTER WORD 
          SB7    X.A+B7            BOUNDS ADDR FOR STRING MOVE
* 
 GETLBYT  BSS    0
          RJ     GETNBYT           GET NEXT BYTE FROM ORIGINAL TARGET 
*                                  STRING 
* 
          SX.C   X.A-EOSB          CHECK FOR -EOS- MET
          ZR     X.C,COMEXIT       SJIP TO EXIT (TARGET IS ALL THRU)
         SA.C      STRLWFLG   GET LAST WORD OF STR BUFFER FLG 
         ZR        X.C,GETLBYT1   BYPASS IF NOT LAST WORD 
         SX.C      B5-11      STRING ALREADY HAVE 70 CHARS
          NG     X.C,ER168   *STRING OVERFLOW*
GETLBYT1 BSS       0                   WORD 
          LX.A   B5,X.A 
          IX.Y   X.Y+X.A           APPEND THE BYTE
          EQ     B5,B0,DUMPNW      SKIP TO DUMP IT ON TARGET
          SB5    B5-6              ELSE DECREMENT SHIFT FACTOR
          EQ     GETLBYT           LOOP TO PICK UP THE NEXT BYTE
* 
* 
 DUMPNW   BSS    0
          SA.Y   B6                DUMP WORD ON TARGET
          ZR     X.Y,SUBEXIT       EXIT IF ZERO WORD MET
          SB6    B6+1 
         SX.C      B6-B7      CHECK IF ONLY 1 MORE WORD REMAIN IN 
         SX.C      X.C+1               STRING BUFFER
         NZ        X.C,DUMPNW1   BYPASS IF MORE THAN 1 WORD LEFT
         SX.Y      1                   IN STRING BUFFER 
         SA.Y      STRLWFLG   ELSE SET LAST WORD FLAG 
DUMPNW1  BSS       0
          EQ     B6,B7,SUBEXIT     SKIP IF BASIC STRING LENGTH ALREADY
*                                  REACHED
          SX.Y   B0                CLEAR OUT BUFFER 
          SB5    54                RENEW SHIFT
          EQ     GETLBYT           LOOP FOR ANOTHER BYTE
* 
* 
 COMEXIT  BSS    0
          SA.Y   B6                DUMP THE LAST FRAGMENT 
*                                  SKIP IF AT LEAST 2 BYTES OF
*                                     ZERO EXIST. 
*                                  IGNORE COMMENT ON NEXT LINE
          NE     B5,B0,SUBEXIT     SKIP IF AT LEAST ONE ZERO BYTE EXISTS
          SX.Y   B0 
          SB6    B6+1 
          SA.Y   B6                DUMP A FINAL ZERO (EOS) FLAG 
* 
 NULEXIT  BSS    0
 SUBEXIT  BSS    0
          SA1    SAVB6       X1 = ADR OF TARGET PTR WORD
          SB7    X1 
          RJ     =XBASRSTR   RETURN ORIGINAL TARGET STR 
          MX1    1
          LX1    59          CREATE MASK FOR TEMP BIT 
          SA2    XSBTPTR     X2 = NEW RESULT PTR WORD 
          BX6    -X1*X2      CLEAR TEMP BIT 
          SA6    B7          UPDATE TARGET PTR WORD 
           SB6    1 
           SA1    X6            FETCH STRING
           MX2    48            SET MASK FOR ZERO BYTE DELIMITER
 EXIT01    BX1    -X2*X1        CHECK FOR ZERO BYTE DELIMITER 
           ZR     X1,EXIT02     BR, END-OF-STRING FOUND 
           SA1    A1+B6         GET NEXT WORD OF STRING 
           JP     EXIT01
 EXIT02    SA1    A1+B6         GET GARBAGE TRAILER WORD
           MX2   42             SET MASK TO CLEAR PWADR 
           BX6   X2*X1
           SX6   X6+B7          PWADR=TARGET SPW ADDRESS
           SA6   A1             RESTORE GARBAGE TRAILER WORD
          SA.A   SAVB7
          SB7    X.A               RESTORE B7 
          SA.A   SAVFET 
          SB5    X.A               RESTORE FET POINTER
          SA.A   SAVB4
          SB4    X.A
          EQ     BASXSBT           EXIT 
* 
* 
* 
* 
*                NORMAL STATE ACTIONS 
* 
 SUBACTS  BSS     0 
           JP S0NRML
          JP     S0ESC12
*                                     IS RETURN AS 1 BY TABLE 
          JP     S0EOS
* 
*                ESCAPE STATE ACTIONS 
* 
          JP     SNZNRML
          JP     SNZESC 
          EQ     ER165       *ILLEGAL CHARACTER* (165)
* 
* 
          DATA   10HMOVICHS 
 MOVICHS  BSS    0
* 
* 
*                PURPOSE: TO MOVE (X.I) CHARS FROM THE STRING POINTED 
*                         TO BY B4 TO THE STRING POINTED TO BY B6.
*                         X.Y IS USED AS A 10-BYTE BUFFER 
*                         B5 HOLDS THE ASSOCIATED SHIFT AMOUNT
          JP     0
          MX0    57 
*                                  ASSOCIATED STRING
 NUBYT    BSS    0
          RJ     GETNBYT           PICK THE NEXT BYTE FROM THE STRING 
          SA.C   FFCLASS+X.A       LOAD TYPE WORD 
          AX.C   18 
          BX.C   -X0*X.C           ISOLATE TYPE (EOS/ESC/NORMAL)
          SB7    X.C
          SA.C   ASCII
          NZ   X.C,NUBYT1          SKIP IF ASCII MODE 
          SX.C   B7-1              NON-ASCII MODE, DO NOT ALLOW ESCAPE C
          NZ   X.C,NUBYT1          WAS NOT ESCAPE CODE
          SB7    B0                CONVERT ESCAPE CODE TO NORMAL
 NUBYT1   BSS    0
          SA.C   SUBSTAT           STATE IS NORMALLY ZERO 
          SB7    B7+X.C 
          JP     B7+SUBACTS        JUMP THRU TABLE TO RELEVANT ACTION 
* 
* 
* 
*                STATE 0 (NORMAL) 
* 
* 
 S0NRML   BSS    0                 STANDARD CHAR MET IN STATE 0 
* 
          SX.I   X.I-1             DECREMENT COUNT
S0APEND   BSS    0
         SA.C      DSCRDFG    BYPASS IF DISCARDING CHARS
         NZ        X.C,SOAPEND1 
         SA.C      STRLWFLG   GET LAST WORD OF STR BUFFER FLAG
         ZR        X.C,SOAPEND1   BYPASS IF NOT LAST WORD 
         SB7       6          STRING ALREADY HAVE 70 CHARS
          LE     B5,B7,ER168 *STRING OVERFLOW*
SOAPEND1 BSS       0                        WORD
          LX.A   B5,X.A            SHIFT CHAR ALONG 
          IX.Y   X.Y+X.A           APPEND IT TO THE BUFFER
          EQ     B5,B0,BUFDUMP     SKIP TO DUMP BUFFER ON TARGET
          SB5    B5-6              ELSE DECREMENT SHIFT FACTOR
 CHKIZRO  BSS    0
          ZR     X.I,MOVICHS       EXIT IF 1ST CHAR TO BE REPLACED IS 
*                                  NOW REACHED
          EQ     NUBYT             ELSE GO GET NEXT BYTE
* 
* 
 BUFDUMP  BSS    0
          SA.Y   B6                DUMP BUFFER ON TARGET STRING 
          SB6    B6+1              UPDATE TARGET POINTER
         SA.C      DSCRDFG    BYPASS IF DISCARDING CHARS
         NZ        X.C,BUFDUMP1 
          SA.C   XSBTPTR     GET FWA OF NEW TARGET
         SB7       X.C+BSTRWDS-1
         NE        B6,B7,BUFDUMP1   IF MORE THAN 1 MORE WORD LEFT 
         SX.Y      1                   IN STRING BUFFER 
         SA.Y      STRLWFLG    ELSE SET FLAG FOR LAST WORD
BUFDUMP1 BSS       0
          SB5    54                RENEW SHIFT FACTOR 
          SX.Y   B0                CLEAR BUFFER 
          EQ     CHKIZRO           GO CHECK CHAR COUNT
* 
* 
 S0ESC12  BSS    0
*                                  -ESCAPE- CODE MET IN STATE 0 
          SX.Z   TYPES             OTHER STATE
          SA.Z   SUBSTAT           CHANGE TO -ESCAPE- 
          EQ     S0APEND           GO APPEND -ESC- CODE (BUT AVOID
*                                  UPDATING REAL CHAR COUNT)
* 
* 
 S0EOS    BSS    0
* 
*                                  -EOS- MET IN STATE 0 
          EQ     MOVICHS           EXIT AT ONCE 
* 
* 
* 
*                STATE: -ESC- MET LAST
* 
* 
 SNZNRML  BSS    0                 STANDARD CHAR MET IN -ESC- MODE
          SX.Z   B0 
          SA.Z   SUBSTAT           RESET STATE TO ZERO
          EQ     S0NRML            JOIN STANDARD CHAR HANDLING (AND 
*                                  UPDATE COUNT TOO)
* 
* 
 SNZESC   BSS    0
* 
*                AN APPARENT -ESC- CODE MET IN THE -ESC- MODE 
*                (SPECIAL CASES: 7674B AND 7676B )
          EQ     SNZNRML           JOIN STANDARD CASE 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
 GETNBYT  BSS    0
* 
* 
*                PURPOSE: TO RETURN IN X.A THE NEXT BYTE OF THE STRING
*                WHOSE CURRENT FRAGMENT IS IN X.B 
* 
*                ENTRY:B4 POINTS TO THE STRING
*                      X.B HOLDS CURRENT STRING FRAGMENT
*                      X.J HOLDS THE CURRENT BYTE COUNT 
* 
*                EXIT: X.A HOLDS THE NEXT BYTE (SET TO 101B IF EOS WAS
*                      MET DURING THE SCAN) 
* 
* 
          JP     0
          MX.C   54                CHARACTER MASK 
          LX.B   6                 ROTATE CURRENT WORD
          BX.A   -X.C*X.B          MASK NEXT BYTE TO X.A
          ZR     X.A,EOSBYT        SKIP IF -EOS- BYTE MET 
ZERO61    BSS    0
          SX.J   X.J-1             CHECK BYTES IN WORD COUNTER
          NZ     X.J,GETNBYT       EXIT WHILE STILL NON-ZERO
          SX.J   CHSWD             ELSE RESET 
          SB4    B4+1              UPDATE STRING POINTER
          SA.B   B4                PICK UP NEXT WORD OF STRING
          EQ     GETNBYT           AND EXIT 
* 
* 
* 
 EOSBYT   BSS    0
          SX.C   X.J-1             NUMBER OF BYTES LEFT IN WORD 
          ZR     X.C,ZERO62        JUMP IF LAST BYTE OF WORD
          LX.C   1                 BYTES * 2
          SA.Y   ZSAVX6            SAVE REG 
          SX.Y   X.C
          LX.C   1                 BYTES * 4
          IX.C   X.C+X.Y           BIT COUNT
          SX.Y   B5                SAVE B5
          SB5    X.C-1             SHIFT COUNT FOR MASK 
          MX.C   1
          AX.C   B5,X.C            FORM MASK FOR REST OF WORD 
          SB5    X.Y               RESET B5 
          BX.C   X.C*X.B           EXTRACT REST OF WORD 
          ZR     X.C,ZERO63        JUMP IF END OF STR (ZERO)
          SA.C   ZSAVX6            ELSE RESET REGS
          BX.Y   X.C
          MX.C   54 
          EQ     ZERO61               AND ZERO IS VALID CHAR
ZERO62    BSS    0
          SA.C   A.B+1             NEXT WORD
          ZR     X.C,ZERO64        JUMP IF END OF STR (ZERO)
          MX.C   54                ELSE RESET REG 
          EQ     ZERO61               AND ZERO IS VALID CHAR
ZERO63    BSS    0
          SB5    X.Y               RESET REGS 
          SA.C   ZSAVX6 
          BX.Y   X.C
ZERO64    BSS    0
          MX.C   54 
* 
          SX.A   EOSB              FORCE -EOS- FLAG 
          EQ     GETNBYT           EXIT 
* 
* 
* 
* 
* 
 BLNKFIL  BSS    0
* 
* 
*                PURPOSE: APPEND -BLANKS- TO THE BUFFER IN X.Y UNTIL THE
*                COUNTER IN X.I REACHES 0.ANY FULL BUFFER IS DUMPED 
*                VIA B6 WHICH POINTS TO THE TARGET STRING.
* 
*                ON ENTRY: B5 HOLDS CURRENT SHIFT FACTOR
* 
*                USES: X.A         B5 
          JP     0
BLANKIT   BSS    0
         SA.C      STRLWFLG   GET LAST WORD OF STR BUFFER FLAG
         ZR        X.C,BLANKIT1   BYPASS IF NOT LAST WORD 
         SB7       6          STRING ALREADY HAVE 70 CHARS
          LE     B5,B7,ER168 *STRING OVERFLOW*
BLANKIT1 BSS       0                      WORD
          SX.A   KBLNK             -BLANK- CODE 
          LX.A   B5,X.A            SHIFT -BLANK- ALONG
          IX.Y   X.Y+X.A           APPEND IT TO BUFFER
          EQ     B5,B0,DUMPBUF     SKIP TO DUMP ANOTHER WORD ON TARGET
          SB5    B5-6              REDUCE COUNT 
* 
 CHKIJ    BSS    0
          SX.I   X.I-1             CHECK REQUIRED BLANKS COUNT
          NZ     X.I,BLANKIT       LOOP WHILE NON-ZERO
          EQ     BLNKFIL           ELSE EXIT
* 
 DUMPBUF  BSS    0
          SA.Y   B6                DUMP CURRENT WORD ON TARGET STRING 
          SB6    B6+1              UPDATE OUTPUT POINTER
          SA.C   XSBTPTR     GET FWA OF NEW TARGET
         SB7       X.C+BSTRWDS-1
         NE        B6,B7,DUMPBUF1   IF MORE THAN 1 WORD LEFT
         SX.Y      1                   IN STRING BUFFER 
         SA.Y      STRLWFLG    ELSE SET FLAG FOR LAST WORD
DUMPBUF1 BSS       0
          SB5    54                RENEW SHIFT COUNTER
          SX.Y   B0                CLEAR BUFFER 
          EQ     CHKIJ             GO CHECK REQUIRED COUNT
* 
* 
 XSBTPTR  BSSZ   1           PTR WORD FOR RELULT STR
 XSBTTAD  BSS    1           ORIG TARGET FWA SAVED HERE 
* 
STRLWFLG BSSZ      1          FLAG TO INDICATE IF LAST WORD OF STR
*                                      BUFFER HAS BEEN REACHED
DSCRDFG  BSSZ      1          FLAG TO SUPPRESS OVERFLOW CHECK 
*                                 WHEN DISCARDING CHARS 
 SAVLEN   BSS    1                 USED TO HOLD STRING LEN DURING BASRST
* 
 BATXSBT  BSS    0
* 
          TITLE  STRING CONCATENATION (BASTRCN) 
* 
* 
          DATA   10HBASTRCN 
 BASTRCN  BSS    0
* 
*         PURPOSE:   TO CONCATENATE 2 STRINGS INTO CONCBUF. 
*         ENTRY: B6 = STRING1 POINTER WORD ADDRESS
*                B7 = STRING2 POINTER WORD ADDRESS
*         EXIT:  B7 = ADR OF WORD CONTAINING ADR - B2 
*                     OF RESULT PTR WORD
* 
* 
          EQ     0
* 
* 
          BX6    X1 
          LX7    X2 
          SA6    SAVEX1 
          SA7    SAVEX2 
          BX6    X3 
          LX7    X5 
          SA6    SAVEX3 
          SA7    SAVEX5 
          BX7    X4 
          SX6    B5 
          SA7    SAVEX4 
          SA6    SAVEB5 
          MX6    0           RESET BLANK-APPENDED-TO-TRAILING-COLON FLAGS 
          SA6    COLBLK1
          SA6    COLBLK2
          MX6    1           USE X6 TO SET COLON-BLANK FLAGS IF NECSSRY 
          SA1    B6          X1 = POINTER WORD FOR STRING1
          LX1    3           PUT COLON-BLANK FLAG IN BIT 60 
          PL     X1,CONCA0   BR, STR1 COLON-BLANK FLAG NOT SET
          SA6    COLBLK1     SET STR1 BLANK-APPENDED-TO-TRAILING-COLON FLAG 
 CONCA0   SA1    B7          X1 = POINTER WORD FOR STRING2
          LX1    3           PUT COLON-BLANK FLAG IN BIT 60 
          PL     X1,CONCA1   BR, STR2 COLON-BLANK FLAG NOT SET
          SA6    COLBLK2     SET STR2 BLANK-APPENDED-TO-TRAILING-COLON FLAG 
 CONCA1   SA1    B6          X1 = POINTER WORD FOR STRING1
* 
*         DETERMINE LAST USED WORD AND CHAR OF 1ST STR
* 
          LX1    59-53+18    POISITION LENGTH TO LOWER 18 BITS
          SX1    X1          ISOLATE LENGTH OF STRING1
          SB3    B7          B3 = ADR OF RESULT PTR WORD (STR 2)
          ZR     X1,CONCE2   EXIT IF 1ST STR IS NULL
          SA2    B7          X2 = POINTER WORD FOR STR2 
          LX2    59-53+18    LOWER 18 BITS NOW = LENGTH OF STR2 
          SX2    X2          ISOLATE LENGTH OF STR2 
          BX6    X2 
          SA6    STR2LNG     STORE STR2 LENGTH
          SA2    COLBLK1
          ZR     X2,TRCN.A1  BR, DONT BACK UP--NO TRAILNG COLBLK SEQ. 
          ZR     X6,TRCN.A1  BR, DONT BACK UP--STR2 IS NULL--NEED APPNDED BLNK
          SX1    X1-1        BACK UP OVER BLANK WHICH WAS APPENDED TO COLON 
 TRCN.A1  SB5    X1          B5 = LENGTH
          SX6    B0 
          SX7    B0 
 TRCN.A   SX7    X7+1        X7 = CNT OF FULL WORDS 
          SB5    B5-CHSWD    B5 = B5-CHARACTERS PER WORD
          PL     B5,TRCN.A
          SX7    X7-1 
          SX6    B5+CHSWD 
          SA7    CTR         CTR = NEXT WORD POSITION 
          SA6    CTR+1       CTR+1 = NEXT CHAR POSITION 
* 
          SA2    B7          X2 = 2ND STRING POINTER WORD 
* 
*         CHECK FOR STRING OVERFLOW 
* 
          SA2    STR2LNG     X2 = LENGTH OF STR2
          SB3    B6          B3 = ADR OF RESULT PTR WORD (SRT 1)
          ZR     X2,CONCE2   EXIT IF 2ND STR IS NULL
          IX6    X1+X2       X6 = LENGTH1 + LENGTH2 
          SX7    BSTRLEN     X7 = MAX STRING LENGTH 
          IX6    X7-X6
          NG     X6,ER168    *STRING OVERFLOW*
* 
*         EXTEND 1ST STRING IF POSSIBLE 
* 
          BX3    X1          PROTECT LENGTH OF STRING1
          BX4    X2          PROTECT LENGTH OF STRING 2 
          SX1    B6          X1 = ADR OF 1ST STR POINTER
          SA5    COLBLK1     X5 = STRING 1 COLON-BLANK FLAG 
          NZ     X5,MANEXT   BR, CANT EXTEND STR1--MANUALLY EXTEND
          RJ     =XBASESTR   TRY TO EXTEND STR1 BY LENGTH2
          IX6    X3-X2       ORIGINAL LENGTH - NEW LENGTH 
          NZ     X6,CONCB1   JUMP IF EXTENSION GRANTED
* 
*         GET SPACE FOR STR 1 + STR 2 IF STR 1 COULD NOT BE EXTENDED
* 
 MANEXT   SB3    TRCNPTR     B3 = ADDRESS OF RESULT POINTER WORD
          SX1    TRCNPTR     X1 = ADDRESS OF RESULT POINTER WORD
          NE     B3,B7,CONCB0 
          SX1    X1+1 
          SB3    B3+1 
 CONCB0   BSS    0
          IX2    X3+X4       X2 = REQUIRED NEW STRING LENGTH
          RJ     =XBASGSTR   GO GET SPACE 
*                            X1 = FWA OF NEW STRING SPACE 
          SA4    B6          X4 = 1ST STR PTR WORD
          ZR     X4,TRCN.B   B6 = FWA OF NULL STR 
          SB6    X4 
          PL     X4,TRCN.B   B6 = FWA OF VARIABLE STR 
          SB6    X4+B4       B6 = FWA OF CONST STR
* 
*         COPY 1ST STRING INTO RESULT BUFFER
* 
 TRCN.B   SA4    CTR
          SB5    X4          B5 = NUMBER OF FULL WORDS IN STRING1 
 TRCN.C   SA4    B6+B5       B6 = FWA OF STRING 1 
          BX6    X4          MOVE FROM LAST TO FIRST
          SA6    X1+B5
          SB5    B5-1 
          PL     B5,TRCN.C   LOOP UNTIL B5+1 WORDS ARE COPIED 
* 
*         APPEND 2ND STRING TO END OF FIRST 
* 
 CONCB1   BSS    0
          SA5    B7          X5 = 2ND STR PTR WORD
          ZR     X5,TRCN.D   B7 = FWA OF NULL STR 
          SB7    X5 
          PL     X5,TRCN.D   B7 = FWA OF VARIABLE STR 
          SB7    X5+B4       B7 = FWA OF CONST STR
 TRCN.D   SA5    B7          A5/X5 = FWA/1ST WORD OF 2ND STR
          SB7    X1          B7 = FWA OF RESTUL STRING
          SA1    CTR
          SB5    X1                INDEX INTO CONCBUF 
          SA1    CTR+1             CHAR POS 
          ZR     X1,CONCB21 
          LX1    1                 POS*2
          SX7    X1 
          LX1    1                 POS*4
          IX1    X1+X7             BIT COUNT
          SB6    X1-1 
          MX1    1
          AX1    B6,X1             MASK FOR PART WORD 
          SB6    -B6               SHIFT COUNT FOR PART WORD
          SB6    B6+59
          SX2    7777B
          SA3    B7+B5       X3 = LAST WORD OF STRING1
 CONCB2   BSS    0
          BX6    X1*X3
          LX3    X5,B6
          BX7    -X1*X3            SECOND STR 
          BX6    X6+X7
          SA6    B7+B5       STORE WORD OF NEW STRING 
          BX7    X2*X6
          ZR     X7,CONCE2   EXIT IF NEW STRING ENDED BY EOL
          SB5    B5+1 
          BX5    X2*X5             EOL
          ZR     X5,CONCB2
          SA5    A5+1              FETCH NEXT 
          EQ     CONCB2 
* 
 CONCB21  BSS    0           STR1 ENDED ON WORD BOUNDRY 
          SX2    7777B
 CONCB22  BSS    0
          BX6    X5 
          SA6    B7+B5
          BX7    X2*X6
          ZR     X7,CONCE2   END OF STRING2 
          SB5    B5+1 
          SA5    A5+1 
          EQ     CONCB22
* 
 CONCE2   BSS    0           EXIT 
          SA2    STR2LNG
          ZR     X2,CONCE2C  BR, STR2 NULL--RESULT POINTER WORD IS SAME 
*                              AS PTR WORD OF STR1
          SA2    B3          X2 = PTR WORD
          MX6    1           USE X6 TO SET OR RESET THE COLON-BLNK FLAG 
          LX6    -3          PUT THE MASK AT BIT 57 (COLON-BLANK FLAG)
          SA3    COLBLK2     CHECK FOR COLON-BLANK FLAG ON STR2 
          PL     X3,CONCE2A  BR, RESET THE FLAG IN RESULT PTR WORD
          BX6    X6+X2       SET THE FLAG IN RESULT PTR WORD
          EQ     CONCE2B     JP, STORE THE UPDATED PTR WORD 
 CONCE2A  BX6    -X6*X2      RESET THE COLON-BLANK PTR WORD(IT WAS ON)
 CONCE2B  SA6    B3          STORE THE NEW RESULT PTR WORD
 CONCE2C  SX6    B3-B2
          SA6    CNCBFAD     SAVE PTR WORD ADR - B2 
          SB7    A6          B7 = ADR OF PRT ADR - B2 
          SA1    SAVEB5 
          SB5    X1 
          SA1    SAVEX1 
          SA2    SAVEX2 
          SA3    SAVEX3 
          SA5    SAVEX5 
          SA4    SAVEX4 
          EQ     BASTRCN
* 
* 
 SAVEB5   BSS    1
 SAVEX1   BSS    1
 SAVEX2   BSS    1
 SAVEX3   BSS    1
 SAVEX4   BSS    1
 SAVEX5   BSS    1
 CTR      BSS    2
 CNCBFAD  BSS    1
 TRCNPTR  BSSZ   2
 BATTRCN  BSS    0
 COLBLK1  BSS    1           BLANK-APPENDED-TO-TRAILING-COLON FLAG STR1 
 COLBLK2  BSS    1           BLANK-APPENDED-TO-TRAILING-COLON FLAG STR2 
 STR2LNG  BSS    1           LENGTH OF STRING 2 
* 
          TITLE  REPEAT STRING FUNCTION (RPT$)
* 
* SUBROUTINE:    BASXRPT
* 
*   PURPOSE:  
*                IMPLEMENT THE RPT$ FUNCTION. 
*                GENERATE A STRING CONSISTING OF N OCCURRENCES
*                OF THE CHARACTERS IN A GIVEN SOURCE STRING.
* 
*                REGISTERS B1-B5 MUST BE PRESERVED ACROSS 
*                EXECUTION OF THIS FUNCTION.
* 
*   ON ENTRY: 
*                A5=ADDRESS OF SOURCE STRING POINTER WORD 
*                X5=SOURCE STRING POINTER WORD. 
*                X4=NO. OF REPETITIONS OF THE SOURCE STRING 
*                   DESIRED IN THE RESULT STRING. 
*                B6=NO. OF PARAMETERS PASSED.  (NOT USED) 
* 
*   ON EXIT:  
*                B7=ADDRESS OF THE WORD CONTAINING THE ADDRESS
*                MINUS B2 OF THE RESULT STRING POINTER WORD. THE
*                RESULT STRING IS IN THE DYNAMIC STRING AREA. 
* 
          DATA   10HBASXRPT 
BASXRPT   BSS    0
          JP     *+1S17      ENTRY/EXIT 
* 
*    SAVE FET POINTER 
* 
          SX7    B5 
          SA7    SVB5 
* 
*  INITIALIZE TARGET RESULT POINTER 
          SX1    RPTPTR            TEMPORARY TARGET RESULT POINTER
          ZR     X1,BASXRPT1       SKIP IF POINTER WD ALREADY ZERO
          RJ     =XBASRSTR         RETURN LOCAL STRING
 BASXRPT1 BSS    0
*  CHECK AND INTEGERIZE THE REPETITION COUNT (X4) 
          ID     X4,ER191    BR IF *ILLEGAL RPT$ PARAMETER* 
          OR     X4,ER191 
          SA1    BASANSI     ROUND THE REP COUNT IF 
          ZR     X1,BASXRPT2 IN ANSI MODE.
          BX1    X1-X1
          PX1    X1 
          RX4    X4+X1
 BASXRPT2 BSS    0
          NG     X4,ER191 
* 
          NX4    X4,B6
          UX2    X4,B6       UNFLOAT REPETITION COUNT INTO X4 
          LX4    X2,B6
          ZR     X4,ENDING   IF COUNT=0, RETURN NULL STRING 
* 
          SA5    A5          FETCH SOURCE STR PTR WORD IN X5
          SB6    A5          B6=ADDR OF SOURCE STR PTR WORD 
* 
          LX5    59-53+18    POSITION STR LENGTH TO BITS 17-0 
          SX3    X5          ISOLATE LENGTH OF SOURCE STRING
          ZR     X3,ENDING   FORCE NULL STR IF SOURCE IS NULL 
          BX6    X3 
          SA6    SRCLEN      SAVE LENGTH OF SOURCE STRING 
          IX2    X4*X3       COMPUTE LENGTH OF NEW RESULT STRING
          SX1    BSTRLEN     MAXIMUM STRING LENGTH + 1. 
          IX1    X2-X1       TEST FOR STRING OVERFLOW.
          PL     X1,ER168    BR IF *STRING OVERFLOW*
* 
          SX1    RPTPTR      X1=ADDR OF TEMP. RESULT POINTER WORD 
*                            X2=REQUIRED LENGTH FOR RESULT TARGET STRING
          RJ     =XBASGSTR   GO GET STRING SPACE IN DYNAMIC STRING AREA 
*                              FOR TARGET RESULT STRING.
* 
*    SET UP POINTERS TO SOURCE AND TARGET RESULT STRINGS
          SB7    X1          B7=FWA OF NEW STRING SPACE FOR RESULT
*                            X2=LENGTH OF SPACE OBTAINED FOR RESULT STR 
          SX6    X2 
          SA6    TARLEN      SAVE LENGTH OF TARGET RESULT STRING
          SX7    X1 
          SA7    TARADR      SAVE FWA OF NEW TARGET RESULT AREA 
          SA5    B6          FETCH SOURCE STRING POINTER WORD 
          PL     X5,RPT0     BR IF SOURCE IS NOT A CONSTANT STRING
          SX5    X5+B4       ADD CONSTANT OFFSET TO STRING LOCATION 
*                              IF STRING IS A CONSTANT. 
RPT0      BSS    0
          SB6    X5          B6=FWA OF SOURCE STRING
          SX6    B6 
          SA6    SRCADR      SAVE FWA OF SOURCE STRING
          SB3    X3          X3=LENGTH OF SOURCE STR IN 6-BIT CHARS.
* 
          MX7    0           CLEAR CHAR BUFFER REGISTER 
          SX6    CHSWD       MAX. NO. OF 6-BIT CHARS/WORD 
*                            X6=NO. OF CHARS STILL TO BE PROCESSED
*                              IN THE CHARACTER BUFFER REGISTER.
          MX3    54          6-BIT CHARACTER MASK 
* 
*    PROCESS NEXT SOURCE WORD 
NXTSRCW   BSS    0
          SB5    CHSWD       MAX. NO. OF 6-BIT CHARS/WORD 
*                            B5=NO. OF 6-BIT CHARS STILL IN THE 
*                              LATEST SOURCE STRING WORD. 
          SA1    B6          FETCH THE NEXT SOURCE WORD 
*    PROCESS NEXT SOURCE CHARACTER
* 
NXTCHAR     BSS    0
          LX1    6           ALIGN THE SOURCE WORD AND
          BX4    -X3*X1       MASK OFF THE NEXT SOURCE CHAR.
          LX7    6           SHIFT BUFFER ALONG AND 
          IX7    X7+X4        APPEND LATEST CHARACTER.
* 
          SX2    X2-1        DECREMENT TARGET STRING LENGTH 
          ZR     X2,ALLCH    BR IF TARGET LENGTH COUNT HAS
*                              BEEN EXHAUSTED.
          SX6    X6-1        CK IF CHAR BUFFER IS FULL
          NZ     X6,RPT1     BR IF NOT FULL.
* 
          SA7    B7          MOVE THE CHAR BUFFER INTO THE
*                            TARGET RESULT STRING SPACE.
          MX7    0           CLEAR THE CHAR BUFFER
          SX6    CHSWD       RESET CHARS/WORD 
          SB7    B7+1        UPDATE TARGET RESULT POINTER 
* 
RPT1      BSS    0
          SB3    B3-1        NO. OF CHARS LEFT IN SOURCE STRING 
          SB5    B5-1        NO. OF CHARS LEFT IN LATEST SOURCE WD
          ZR     B3,RPT2     BR IF END-OF-A-REPETITION (ALL CHARS 
*                              HAVE BEEN EXHAUSTED IN SOURCE STRING.
          NZ     B5,NXTCHAR    BR IF ALL CHARS IN LATEST SOURCE 
*                              WORD HAVE NOT BEEN EXHAUSTED.
          SB6    B6+1        UPDATE SOURCE POINTER IF ALL CHARS 
*                              HAVE BEEN USED IN LATEST SOURCE WORD.
          EQ     NXTSRCW     GO PROCESS NEXT SOURCE WORD. 
* 
*    RESET SOURCE POINTER AND LENGTH FOR NEXT REPETITION
* 
RPT2      BSS    0
          SA5    SRCADR      RESET POINTER TO FWA OF
          SB6    X5            SOURCE STRING. 
          SA5    SRCLEN      RESET SOURCE STRING
          SB3    X5            LENGTH.
          EQ     NXTSRCW     GO PROCESS NEXT SOURCE WORD. 
* 
*    ALL CHARACTERS HAVE BEEN OBTAINED FOR THE TARGET RESULT STRING 
* 
ALLCH     BSS    0
          SX6    X6-1        CHECK IF CHAR BUFFER WORD IS FULL. 
          ZR     X6,FIXEOS   BR IF IT IS FULL.
* 
ADJUST    BSS    0
          LX7    6           SHIFT CHAR BUFFER
          SX6    X6-1 
          NZ     X6,ADJUST   LOOP UNTIL BUFFER WORD IS LEFT-ADJUSTED. 
* 
*    FIX END-OF-STRING (EOS) INDICATION 
* 
FIXEOS    BSS    0
          SX0    7777B       MASK FOR END-OF-STRING 
          BX6    X0*X7
          ZR     X6,LASTWD   BR IF BUFFER WORD HAS 12 BIT ZERO BYTE 
          SA7    B7          MOVE IT TO TARGET IF NOT AND 
          SB7    B7+1        UPDATE TARGET RESULT POINTER 
          MX7    0           CREATE FULL ZERO WORD FOR EOS
LASTWD    BSS    0
          SA7    B7          MOVE LAST WORD TO TARGET RESULT AREA 
* 
ENDING    BSS    0
          SB7    RPTPTR      B7=ADDR OF POINTER WORD FOR RESULT STRING
          SX7    B7-B2       OFFSET OF RESULT POINTER RELATIVE TO 
                               VARIABLE AREA. 
          SA7    RSLTADR     SAVE OFFSET ADDRESS OF RESULT STRING 
*                              POINTER WORD.
          SB7    RSLTADR     SET B7 TO POINT TO THE WORD CONTAINING 
*                              THE ADDRESS-B2 OF THE RESULT STRING
*                              POINTER WORD.  THE RESULT STRING IS
*                              IN THE DYNAMIC STRING AREA.
* 
          SA1    SVB5        RESTORE THE FET POINTER
          SB5    X1 
* 
          EQ     BASXRPT     EXIT 
* 
* 
RPTPTR    BSSZ   1           POINTER WORD FOR TARGET RESULT 
*                              STRING - MUST INITIALLY=0. 
RSLTADR   BSSZ   1           RESULT STRING POINTER ADDR-B2
SVB5      BSS    1           SAVE AREA FOR FET POINTER
SRCLEN    BSS    1           SOURCE STRING LENGTH IN 6-BIT CHARS
SRCADR    BSS    1           FWA OF SOURCE STRING (ABSOLUTE)
* 
TARLEN    BSS    1           RESULT TARGET STRING LENGTH
TARADR    BSS    1           FWA TARGET STRING AREA 
* 
BATXRPT   BSS    0
* 
          END 
