*DECK BASSINT 
          IDENT  BASSINT
          TITLE  STRING MANAGER SERVICE PROCEDURES
*CALL COPYRITE
          IPARAMS 
*CALL LCORE 
*CALL LIPARAM 
*CALL ERMNUM
 ACTR     EQU    64B
 LWPR     EQU    65B
          TITLE  BASSMMM - STRING MEMORY MANAGER
          ENTRY  BASSMMM
          EXT    MEMUP
          EXT    BASEGEN
* 
*         MEMORY MANAGER FOR STRING MANAGER 
* 
*         THIS ROUTINE INITIALIZES STRING MANAGER POINTERS
*         AND ACQUIRES AND/OR RETURNS MEMORY AS THE 
*         STRING SPACE GROWS AND SHRINKS.  NORMALLY MEMORY IS 
*         ACQUIRED AND RELEASED VIA THE MEMORY MACRO.  HOWEVER
*         WHEN CMM IS LOADED, IT MUST BE USED AND FIXED MEMORY
*         BLOCKS ARE ACQUIRED AND RELEASED THRU CMM CALLS.
* 
*         ENTRY  A1 = ADDRESS OF PARAMETER LIST WHICH 
*                POINTS TO INCREMENT/DECREMENT
*                VALUE
*         EXIT   NORMAL MODE - JOB FIELD LENGTH, STRING MANGER
*                POINTER BASSMLM (LIMIT), AND ON THE FIRST CALL 
*                BASSMLI (LAST) ARE ADJUSTED. 
*                CMM MODE - ON THE INITAL CALL A FIXED BLOCK IS 
*                OBTAINED AND (LIMIT) AND (LAST) ARE UPDATED. 
*                ON SUBSEQUENT CALLS THE CURRENT BLOCK IS SHRUNK
*                AND (LIMIT) UPDATED IF THE DESIRED INCREMENT IS
*                NEGATIVE, OR CURRENT BLOCK IS RELEASED, A NEW ONE
*                OBTAINED, THE OLD DATA IS COPIED TO THE NEW, ALL 
*                STRING POINTER WORDS UPDATED TO POINT TO THE NEW 
*                BLOCK, AND (FIRST),(LIMIT),AND (LAST) UPDATED IF 
*                THE INCREMENT IS POSITIVE. 
* 
*         NOTE   CMM WILL BE PRESENT ONLY IF THE BASIC PROGRAM
*                CALLS AN EXTERNAL SUBROUTINE.  A ROUTINE THAT MAKES USE
*                OF SORT FOR EXAMPLE WILL CAUSE CRM AND CMM TO BE LOADED
*                BECAUSE CRM USES CMM FUNCTION CMM.ALF, CMM.FRF, AND
*                CRM.SLF, THIS ROUTINE ASSUMES THAT IF CMM.ALF IS LOADED
*                THE OTHERS ARE LOADED.  NOTE ALSO THAT BEACUSE CRM 
*                DOESN'T USE CRM.GFS, THIS ROUTINE DOES NOT CALL CRM.GFS
*                TO SEE IF THE REQUIRED BLOCK CAN BE GRANTED. 
*                IN THE EVENT THAT THE BLOCK CANNOT BE ACQUIRED CMM WILL
*                ABORT THE BASIC JOB AND "ON ERROR" RECOVERY WON'T BE 
*                POSSIBLE.
* 
 ERM166   DATA   C* MEMORY OVERFLOW*
* 
 ER166    BSS    0                 * MEMORY OVERFLOW *
          RTERROR ERMN166,ERM166,BASEGEN   *MEMORY OVERFLOW * 
 BASSMMM  DATA   0
          SA1    X1          X1 = REQUIRED INCREMENT
          BX6    X1 
          SA6    REQINC            SAVE REQUESTED INC 
          NG     X1,SMMM.A         BR REDUCE FIELD LENGTH REQUESTED 
          SA2    =XBASSMGA         X2 = BASSMGR AVE GET LENGTH
          LX2    2                 X2 = 4 * AVE EGT LENGTH
* 
* W A R N I N G - ABOVE CODE IS EQUIVALENT TO LX2 BASSMK. 
* BUT IT IS VALID ONLY WHEN BASSMK = 4. 
* ANY CHANGE TO BASSMK IN BASSMGR MUST BE REFLECTED HERE ALSO.
* 
          IX1    X1+X2             X1 = REQUESTED + 4 * AVE GET LENGTH
          SX3    MININC             X3 = MIN ALLOWABLE MEMORY INC 
          IX3    X3-X1             INC MUST BE AT LEAST MINIC 
          NG     X3,SMMM.A         BR OK
          SX1    MININC             FORCE MIN INC 
 SMMM.A   SA3    =XBASSMLI          X3 = LAST 
          SB7    =YCMM.ALF   ** SOFT EXTERNAL REF TO CMM ** 
          PL     B7,SMMM.E   JUMP IF CMM IS LOADED
* 
*         PROCESS NON CMM REQUEST 
* 
          NZ     X3,SMMM.B         BR NOT FIRST REQUEST 
* 
*         PROCESS FIRST TIME REQUEST
          MX0    0
          RJ     MEMUP       GO SET CURRENT FL IN FIELDLG 
          SA3    LWPR        X3 = LWA +1 OF USER PROG 
          SX6    X3 
          SA6    =XBASSMLI   SAVE LWA +1 IN BASSMLI 
          SA2    FIELDLG     X2 = CURRENT FL
          SX2    X2-PAD      LEAVE ROOM FOR LAST TRAILER WORD 
          IX4    X2-X6       X4 = FL-LWA
          SA1    REQINC      X1 = REQUIRED INCREMENT
          IX3    X4-X1       X3 = AVAILABLE-REQUIRED
          PL     X3,SMMM.D   EXIT IF AVAILABLE IS ENOUGH
* 
*         NOT FIRST TIME AND/OR AVAILABLE ISN'T ENOUGH
* 
 SMMM.B   BX0    X1          X0 = REQUESTED INC 
          RJ     MEMUP             TRY TO MEMUP 
          ZR     X0,SMMM.D   REQUEST GRANTED, EXIT
          SA1    REQINC 
          IX0    X0-X1       X0 = FL GRANTED-FL REQUESTED 
          PL     X0,SMMM.D   EXIT IF ENOUGH WAS GRANTED 
          EQ     ER166         *MEMORY OVERFLOW*
* 
*         UPDATE SM "LIMIT" AND RETURN
* 
 SMMM.D   SA2    FIELDLG     X2 = NEW FL
          SX6    X2-PAD      X6 = NEW FL-PAD FOR LAST TRAILER 
          SA6    =XBASSMLM   STORE 'LIMIT'
          EQ     BASSMMM     EXIT 
* 
*         PROCESS CMM MODE REQUEST
* 
 SMMM.E   SA2    CMMSIZE     X2 = CURRENT BLOCK SIZE
          IX6    X2+X1       ADD REQUESTED INCREMENT
          SA6    A2          STORE NEW BLOCK SIZE 
          PL     X1,SMMM.F   JUMP IF BLOCK INCREASE IS NEEDED 
* 
*         SHIRNK CURRENT BLOCK AT LWA 
* 
          BX2    -X1         X2 = NUM WORDS TO SHRINK 
          SA1    =XBASSMFI   X1 = CURRENT BLOCK FWA 
          SA3    FIELDLG           X3 = CURRENT FIELD LENGTH
          IX6    X3-X2             UPDATE FIELD LENGTH
          SA6    A3                AND SAVE 
          RJ     =YCMM.SLF   CALL CMM TO SHRINK BLOCK 
          EQ     SMMM.D      GO UPDATE 'LIMIT' AND EXIT 
* 
*         REQUEST NEW CMM BLOCK AND COPY STRINGS FROM 
*         OLD CMM BLOCK TO NEW LARGER CMM BLOCK AND THEN
*         RELEASE OLD CMM BLOCK 
* 
 SMMM.F   SA2    CMMSIZE           X2 = NEW BLOCK SIZE
          SX3    200B              X3 = CODE FOR SHRINKABLE AT LWA
          RJ     =YCMM.ALF         CALL CMM TO ALLACOTE A FIXED BLOCK 
          BX6    X1                X6 = FWA OF NEW CMM BLOCK
          SA2    CMMSIZE           X2 = CURRENT BLOCK SIZE
          IX7    X1+X2             X7 = NEW FIELD LENGTH
          SA7    FIELDLG
          SA2    =XBASSMLI         X2 = OLD LAST ITEM POINTER 
          NZ     X2,SMMM.G         BR, NOT FIRST REQUEST
          SA6    A2                INITIALIZE LAST
          EQ     SMMM.D            BR, UPDATE LIMIT AND EXIT
 SMMM.G   BSS    0
* 
* INITIALIZE FWA OF NEW CMM BLOCK 
* 
          SB7    X1             B7 = FWA OF NEW CMM BLOCK 
* 
* INITIALIZE ADDRESS OF PREVIOUS TRAILER TO VALUE BASSMFI 
          SA1    =XBASSMFI         X1 = BASSMFI 
          SA1    X1                X1 = DUMMY TRAILER WORD
          BX6    X1 
          SA6    B7                DUMMY TRAILER WORD IN NEW CMM BLOCK
* 
          SB6    A6                B6 = PRECEDING TRAILER WORD ADDR 
* 
          AX1    18                NEXT TRLR ADDR TO BITS 0-17
          SX1    X1                X1 = CURRENT TRAILER WORD ADDR 
* 
          SX6    B6+1              X6 = NEXT AVAIL LOCATION IN
          SA6    CURRENT                NEW CMM BLOCK 
* 
* START MAIN LOOP OF SCAN. X1 = ADDR OF FIRST TRAILER WORD
* 
 SMMM.H   BSS    0
  
* FETCH THE CURRENT TRAILER WORD
          SA1    X1              X1 - CURRENT TRAILER WORD
* SAVE THE ADDRESS OF THE CURRENT TRAILER WORD IN X7
          SX7    A1              X7 - ADDR OF CURRENT TRAILER WORD
* EXTRACT ADDRESS OF NEXT TRAILER FROM THE CURRENT TRAILER
*  AND STORE THE ADDRESS IN -NEXT-
          SB1    42 
          LX2    X1,B1           NEXT TRAILER ADDR TO LO ORDER
          SX6    X2              X6 - NEXT TRLR ADDR
          SA6    NEXT            NEXT TRLR ADDR STORED IN -NEXT-
* 
* TEST IF CURRENT TRAILER FOR A STRING OR GARBAGE 
* (NEGATIVE VALUE IN PWADR FIELD OF TRAILER INDICATES GARBAGE)
          NG     X2,SMMM.N         BR, GARBAGE TRAILER
* 
* HERE BECAUSE CURRENT TRAILER IS FOR A STRING
* CURRENT TRAILER WORD IS IN X1.
* 
* FETCH THE POINTER WORD FOR CURRENT STRING 
          SA1    X1              X1 - POINTER WORD OF CURRENT STRING
* 
* SET UP MOVE LOOP CONTROLS 
          SB1    X1              B1 - FWA OF SOURCE STRING
          SA3    CURRENT         X3 - FWA OF TARGET AREA
          SB2    X3              B2 - FWA OF TARGET AREA
          SB3    X7                B3 - ADDR OF CURRENT TRAILER WORD
* 
* SAVE ADDRESS OF THE CURRENT STRING POINTER WORD IN X7 
          SX7    A1              X7 - ADDRESS OF CURRENT POINTER WORD 
* 
 SMMM.I  BSS    0 
* 
* NOW MOVE THE STRING DOWN
          SA4    B1              X4 - FETCHED SOURCE WORD 
          BX6    X4 
          SA6    B2              WORD OF STRING NOW MOVED 
* 
* INCREASE SOURCE ADDRESS AND TEST FOR LOOP DONE
          SB1    B1+1            B1 - INCREASED SOURCE ADDRESS
          SB2    B2+1            B2 - INCREASED TARGET ADDRESS
          LT     B1,B3,SMMM.I   BR, TO MOVE ANOTHER WORD
          EQ     B1,B3,SMMM.I   BR, TO MOVE THE LAST WORD 
* 
* 
* HERE FOR MOVE ALL DONE
* NOTE X1 STILL CONTAINS THE STRING POINTER WORD, 
*      X3 STILL CONTAINS FWA OF TARGET STRING 
*      A6 CONTAINS THE FINAL MOVE ADDRESS = NEW TRLR ADDR 
*      X7 STILL CONTAINS THE ADDRESS OF THE STRING POINTER WORD 
* 
* SAVE THE NEW TRAILER ADDRESS IN X4
          SX4    A6              X4 - NEW ADDRESS OF TRAILER
* 
* INSERT NEW FWA OF THE STRING IN THE STRING POINTER WORD 
  
          MX2    42              X2 - 42 POSITION UTILITY MASK
          BX6    X2*X1           X6 - STRING POINTER WITH ZERO FWA
          BX6    X6+X3           X6 - STRING POINTER WITH FWA INSERTED
          SA6    X7              STORE CORRECTED STRING POINTER WORD
* 
* ISOLATE EQU FIELD OF THE STRING POINTER WORD
* AND TEST IT TO DETERMINE IF THIS STRING IS EQUATED. 
* IF SO, CHANGE ALL POINTER WORDS IN THE EQU CHAIN
* TO REFLECT THE NEW FWA OF THE MOVED STRING
          LX1      42     X1 - EQU FIELD IN LO ORDER
          SX1    X1              X1 - CLEAN EQU ADDR IN LO ORDER
          ZR     X1,SMMM.K       BR, THERE IS NO EQU CHAIN
* 
* HERE TO FIX UP POINTER WORDS IN THE EQU CHAIN 
* X1 - ADDR FROM EQU FIELD
* X3 - ADDR OF MEW FWA OF MOVED STRING. 
* X7 - ADDR OF THE POINTER WORD OF THE MOVED STRING = "START" ADDR
* 
 SMMM.J  BSS    0 
* FETCH POINTER WORD POINTED TO BY "EQU" FIELD
          SA1    X1              X1 - FETCHED EQUATED POINTER WORD
* 
* INSERT NEW FWA OF MOVED STRING IN THE EQUATED POINTER WORD
          BX6    X2*X1           X6 - EQUATED POINTER WORD, NULL STRING 
          BX6    X6+X3           X6 - EQUATED POINTER WORD WITH GOOD STR
          SA6    A1              RESTORE CORRECTED EQUATED POINTER WORD 
* 
* IF THE EQU FIELD OF EQUATED POINTER WORD WE JUST CORRECTED
* POINTS TO THE POINTER WORD OF THE STRING WE JUST MOVED, 
* THEN WE HAVE COMPLETED GOING AROUND THE EQUATE CHAIN. 
* ISOLATE THE "EQU" FIELD OF THE POINTER WORD WE JUST CORRECTED.
          LX1    42              X1 - EQU FIELD IN LOW ORDER
          SX1    X1              X1 - CLEAN EQU FIELD IN LOW ORDER
* 
* TEST IF THIS EQU FIELD POINTS TO THE "START" OF CHAIN 
          IX6    X1-X7           X3 = CURRENT EQU - START 
          NZ     X6,SMMM.J      BR, MORE ON THE EQU CHAIN 
* 
* DONE FIXING EQU CHAIN POINTER WORDS 
* 
 SMMM.K   BSS    0
* 
* NOW CORRECT THE TRAILER THAT PRECEDES THE 
* MOVED STRING TO REFLECT THE NEW LOCATION OF 
* THE TRAILER OF THE MOVED STRING.
          SA1    B6              X1 = PRECEDING TRAILER WORD
          LX1    42              X1 - NEXT TRAILER ADDR IN LO ORDER 
          BX1    X2*X1           X1 - PREVIOUS TRAILER WORD WITH NULL NE
          BX6    X1+X4           X6 - PREV TRLR WITH GOOD NEXT TRLR FIEL
          LX6    18              X6 - PREV TRAILER ALIGNED OK 
          SA6    A1              CORRECTED PREVIOUS TRALER RESTORED 
          SB6    X4              B6 = ADDRESS TRAILER WORD
* 
* NOW GET READY FOR NEXT MAIN LOOP ITERATION. 
          SX6    B2              X6 - NEXT AVAIL LOCATION IN
          SA6    CURRENT              NEW CMM BLOCK 
* 
 SMMM.N   BSS    0
* 
* TEST IF ALL DONE MAIN LOOP SCAN 
* WE TEST TO SEE IF THE -NEXT- FIELD OF THE TRAILER 
* OF THE STRING WE JUST MOVED IS ZERO. IF SO WE ARE DONE. 
          SA1    NEXT            X1 - SAVED -NEXT- FIELD
          NZ     X1,SMMM.H       BR, PROCESS NEXT STRING TRAILER
* 
* UPDATE THE ADDRESS OF THE LAST TRAILER IN STRG AREA I.E. BASSMLI
          SA1    CURRENT          GET ADDRESS OF LAST TRAILER 
          SX6    X1-1             WORD IN NEW CMM BLOCK 
          SA6    BASSMLI         BASSMLI UPDATED
* SET TOTALGARBAGE TO ZERO
          MX7    0
          SA7    =XBASSMTG       BASSMTG ZEROED 
* 
*         RELEASE OLD CMM BLOCK 
* 
          SA1    =XBASSMFI         X1 = FWA OF OLD CMM BLOCK
          SX6    B7                UPDATE BASSMFI = FWA OF NEW CMM BLOCK
          SA6    A1 
          RJ     =YCMM.FRF         RELEASE OLD CMM BLOCK
* 
          JP     SMMM.D            UPDATE LIMIT AND EXIT
* 
* 
 REQINC   BSSZ    1 
 CMMSIZE  BSSZ   1                 CURRENT CMM BLOCK SIZE 
 PAD      EQU    2
 MININC   EQU    200B 
* 
* 
          TITLE  BASSMIF  STRING MANAGER INTERFACE
* 
* INTERFACE TO SYMPL STRING MANAGER FUNCTIONS 
*    THIS ROUTINE PROVIDES COMPASS CALLABLE 
*    ENTRY POINTS THAT SAVE REGISTERS, BUILD
*    A SYMPL PARAMETER BLOCK, CALL
*    THE SYMPL ROUTINE, MOVE THE RETURNED 
*    VALUES TO REGISTERS, RELOAD THE
*    SAVED REGISTERS, AND RETURN TO THE CALLER
* 
*    IN GENERAL PARAMETERS ARE PASSED INTO AND
*    OUT OF THIS ROUTINE IN REGISTERS X1 AND X2.
* 
*    REGISTERS A1,A2,A6,A7,X1,X2,X6,AND X7
*    ARE NOT PRESERVED. ALL OTHERS ARE. 
* 
* 
          ENTRY  BASGSTR          GET STRING
          ENTRY  BASESTR          EXTEND STRING 
          ENTRY  BASRSTR          RELEASE STRING
          ENTRY  BASTSTR          TRUNCATE STRING 
* 
          EXT    BASSMGS
          EXT    BASSMES
          EXT    BASSMTS
          EXT    BASSMRS
* 
* 
 BASGSTR  DATA   0                GET STRING
          RJ     PREPARE
          RJ     BASSMGS
          RJ     RESTORE
          EQ     BASGSTR
* 
 BASESTR  DATA   0                EXTEND STRING 
          RJ     PREPARE
          RJ     BASSMES
          RJ     RESTORE
          EQ     BASESTR
* 
* 
 BASTSTR  DATA   0                TRUNCATE STRING 
          RJ     PREPARE
          RJ     BASSMTS
          RJ     RESTORE
          EQ     BASTSTR
* 
          DATA   10HBASRSTR 
 BASRSTR  DATA   0                RELEASE STRING
          RJ     PREPARE
          RJ     BASSMRS
          RJ     RESTORE
          EQ     BASRSTR
* 
 PREPARE  DATA   0                SAVE REGISTERS AND BUILD PARAMETER
          SX6    B1               BLOCK 
          SX7    B2 
          SB1    1                ADDRESS INCREMENT IN B1 
          SA6    SAVEBUF     SAVE B1
          SA7    A6+B1       SAVE B2
          SX6    B3 
          SA6    A7+B1       SAVE B3
          SX7    B4 
          SA7    A6+B1       SAVE B4
          SX6    B5 
          SA6    A7+B1       SAVE B5
          SX7    B6 
          SA7    A6+B1       SAVE B6
          SX6    B7 
          SA6    A7+B1       SAVE B7
          SX7    A0 
          SA7    A6+B1       SAVE A0
          SX6    A3 
          SA6    A7+B1       SAVE A3
          SX7    A4 
          SA7    A6+B1       SAVE A4
          SX6    A5 
          SA6    A7+B1       SAVE A5
          BX7    X0 
          SA7    A6+B1        SAVE X0 
          BX6    X3 
          SA6    A7+B1       SAVE X3
          BX7    X4 
          SA7    A6+B1       SAVE X4
          BX6    X5 
          SA6    A7+B1       SAVE X5
* 
          BX7    X1 
          SA7    PBLOCK      SAVE 1ST PARAMETER 
          BX6    X2 
          SA6    A7+B1       SAVE 2ND PARAMETER 
* 
          SA1    PLIST       A1 POINTS TO PRAM LIST 
          EQ     PREPARE
* 
 RESTORE  DATA   0
          SB1    1           RESTORE REGISTERS AND RETURN 
          SA2    SAVEBUF+1
          SB2    X2          RESTORE B2 
          SA3    A2+B1
          SB3    X3          RESTORE B3 
          SA4    A3+B1
          SB4    X4          RESTORE B4 
          SA5    A4+B1
          SB5    X5          RESTORE B5 
          SA1    A5+B1
          SB6    X1          RESTORE B6 
          SA2    A1+B1
          SB7    X2          RESTORE B7 
          SA1    A2+B1
          SA0    X1          RESTORE A0 
          SA2    A1+B1
          SA3    X2          RESTORE A3 
          SA1    A2+B1
          SA4    X1          RESTORE A4 
          SA2    A1+B1
          SA5    X2          RESTORE A5 
          SA1    A2+B1
          BX0    X1          RESTORE X0 
          SA2    A1+B1
          BX3    X2          RESTORE X3 
          SA1    A2+B1
          BX4    X1          RESTORE X4 
          SA2    A1+B1
          BX5    X2          RESTORE X5 
          SA1    SAVEBUF
          SB1    X1          RESTORE B1 
* 
          SA1    PBLOCK           SET UP RETURN REGISTERS 
          SA2    PBLOCK+1 
          EQ     RESTORE
* 
 PLIST    VFD    42/0,18/PBLOCK   PARAMETER LIST
          VFD    42/0,18/PBLOCK+1 
* 
 PBLOCK   BSS    2                STORAGE FOR ACTUAL PARAMETERS 
* 
 SAVEBUF  BSS    15               STORAGE FOR SAVED REGISTERS 
* 
          TITLE BASSMSQ - STRING MANAGER SQUEEZE
          ENTRY  BASSMSQ
* 
*         THIS ROUTINE STEPS THRU THE STRING AREA 
*         FROM TRAILER TO TRAILER PACKING VALID STRINGS 
*         TOGETHER THEREBY SQUEEZING OUT ALL GARBAGE. 
*         THE FREED UP SPACE IS ADDED TO THE AVAILABLE
*         SPACE AT THE END OF THE STRING AREA.
* 
*         NO FORMAL PARAMETERS ARE USED, THE
*         GLOBAL VARIABLES BASSMFI (FIRST) AND
*         BASSMLI (LAST) ARE USED TO DETERMINE THE
*         FIRST AND LAST TRAILERS IN THE STRING 
*         AREA.  AFTER ALL STRINGS ARE PACKED 
*         TOGETHER, "LAST" IS UPDATED TO REFLECT THE
*         NEW LAST TRAILER ADDRESS.  THE GLOBAL VARIABLE
*         BASSMTG (TOTALGARBAGE) IS USED TO DETERMINE 
*         IF THERE IS ANY GARBAGE TO SQUEEZE OUT. 
* 
* 
          EXT    DBUGON            CID MODE FLAG
          EXT    RNBLOCK,RNLIST    CID DBUG.FN PARAM BLOCKS 
* 
 INTBLCK  DATA   0                 ENABLE/DISABLE CID INTERPRET MODE
 INTADDR  VFD    60/INTBLCK        DBUG.FN APLIST 
* 
* 
* 
          DATA   7HBASSMSQ
 BASSMSQ  PS
* 
* 
          SA1    DBUGON 
          ZR     X1,SMSQ1          BR, CID DISABLED 
          SX6    3                 DISABLE CID INTERPRETER
          SA6    INTBLCK           DURING BASIC STRING AREA SQUEEZE 
          SA1    INTADDR           DBUG.FN APLIST 
          RJ     =YDBUG.FN
 SMSQ1    BSS    0
* 
* IF TOTAL GARBAGE EQUALS ZERO , GO TO EXIT 
          SA1    =XBASSMTG       X1 - TOTAL GARBAGE IN STRING AREA
          ZR     X1,EXIT         BR, NO GARBAGE, CAN'T SQUEEZE
* 
* FALL THRU, WILL SQUEEZE.
* INITIALIZE "GARBAGE ENCOUNTERED DURING SCAN" COUNTER. 
          MX6    0
          SA6    GARBAGE         GARBAGE SET TO ZERO
* 
* INITIALIZE ADDRESS OF PREVIOUS TRAILER TO VALUE BASSMFI 
          SA1    BASSMFI         X1 = BASSMFI 
          BX6    X1              X6 = BASSMFI 
          SA6    PREVIOUS         PREVIOUS = BASSMFI
* 
* INITIALIZE ADDRESS OF -CURRENT- TRAILER TO VALUE BASSMFI
          SA6    CURRENT          CURRENT = BASSMFI 
* 
* START MAIN LOOP OF SCAN. X1 = ADDR OF FIRST TRAILER WORD
* 
 MAININ   BSS    0
  
* FETCH THE CURRENT TRAILER WORD
          SA1    X1              X1 - CURRENT TRAILER WORD
* SAVE THE ADDRESS OF THE CURRENT TRAILER WORD IN X7
          SX7    A1              X7 - ADDR OF CURRENT TRAILER WORD
* EXTRACT ADDRESS OF NEXT TRAILER FROM THE CURRENT TRAILER
*  AND STORE THE ADDRESS IN -NEXT-
          SB1    42 
          LX2    X1,B1           NEXT TRAILER ADDR TO LO ORDER
          SX6    X2              X6 - NEXT TRLR ADDR
          SA6    NEXT            NEXT TRLR ADDR STORED IN -NEXT-
* 
* TEST IF CURRENT TRAILER FOR A STRING OR GARBAGE 
* (NEGATIVE VALUE IN PWADR FIELD OF TRAILER INDICATES GARBAGE)
          PL     X2,STRING       BR, TRAILER IS FOR A STRING
* 
* HERE FOR ON A TRAILER FOR GARBAGE 
* INCREMENT COUNT OF GARBAGE ENCOUNTERED DURING SCAN. 
          SA1    GARBAGE         X1 - PREVIOUS COUNT OF GARBAGE 
          AX2    18              X2 - GARBAGE LENGTH IN LO ORDER
          SX6    X2              X6 - CLEAN GARBAGE LENGTH
          IX6    X1+X6           X6 - NEW COUNT OF GARBAGE ENCOUNTERED
          SA6    GARBAGE         NEW GARBAGE COUNT STORED 
          EQ     MNTST         BR TO SEE IF MAIN LOOP DONE
* 
 STRING    BSS    0 
* HERE BECAUSE CURRENT TRAILER IS FOR A STRING
* CURRENT TRAILER WORD IS IN X1.
* 
* IF NO GARBAGE HAS BEEN ENCOUNTERED PRIOR TO THIS STRING,
* THEN THIS STRING CAN'T BE MOVED DOWN. 
          SA3    GARBAGE         X3 - COUNT OF GARBAGE ENCOUNTERED
          NZ     X3,MVIT         BR, MOVE STRING DOWN 
* 
* STRING CANT MOVE SO WE SET ADDR OF TRAILER OF 
* THIS STRING INTO CELL "PREVIOUS". (ADDR IS
* IN X7)
          SA7    PREVIOUS        PREVIOUS UPDATED 
          EQ     MNTST           GO TST IF STRING AREA SCAN DONE
* 
 MVIT     BSS    0
* 
* 
* 
* FETCH THE POINTER WORD FOR CURRENT STRING 
          SA1    X1              X1 - POINTER WORD OF CURRENT STRING
* 
* SET UP MOVE LOOP CONTROLS 
          SB1    X1              B1 - FWA OF SOURCE STRING
          SB2    X3              B2 - DISPLACEMENT TO MOVE I.E. = GARBAG
          SB3    X7              B3 - LWA OF SOURCE STRING I.E. ADDR OF 
* 
* SAVE ADDRESS OF THE CURRENT STRING POINTER WORD IN X7 
          SX7    A1              X7 - ADDRESS OF CURRENT POINTER WORD 
* 
* 
 MVMOR    BSS    0
* 
* NOW MOVE THE STRING DOWN
          SA4    B1              X4 - FETCHED SOURCE WORD 
          BX6    X4 
          SA6    B1-B2           WORD OF STRING NOW MOVED 
  
  
* 
* INCREASE SOURCE ADDRESS AND TEST FOR LOOP DONE
          SB1    B1+1            B1 - INCREASED SOURCE ADDRESS
          LT     B1,B3,MVMOR     BR, TO MOVE ANOTHER WORD 
          EQ     B1,B3,MVMOR     BR, TO MOVE THE LAST WORD
* 
* 
* HERE FOR MOVE ALL DONE
* NOTE X1 STILL CONTAINS THE STRING POINTER WORD, 
*      X3 STILL CONTAINS COUNT OF GARBAGE 
*      A6 CONTAINS THE FINAL MOVE ADDRESS = NEW TRLR ADDR 
*      X7 STILL CONTAINS THE ADDRESS OF THE STRING POINTER WORD 
* 
* COMPUTE AND SET UP IN X5 THE NEW FWA OF MOVED STRING. 
          SX4    X1              X4 - OLD FWA OF MOVED STRING 
          IX5    X4-X3           X5 - NEW FWA OF MOVED STRING (OLD FWA-G
* 
* SAVE THE NEW TRAILER ADDRESS IN X4
          SX4    A6              X4 - NEW ADDRESS OF TRAILER
* 
* 
* INSERT NEW FWA OF THE STRING IN THE STRING POINTER WORD 
  
          MX2    42              X2 - 42 POSITION UTILITY MASK
          BX6    X2*X1           X6 - STRING POINTER WITH ZERO FWA
          BX6    X6+X5           X6 - STRING POINTER WITH FWA INSERTED
          SA6    X7              STORE CORRECTED STRING POINTER WORD
* 
  
* ISOLATE EQU FIELD OF THE STRING POINTER WORD
* AND TEST IT TO DETERMINE IF THIS STRING IS EQUATED. 
* IF SO, CHANGE ALL POINTER WORDS IN THE EQU CHAIN
* TO REFLECT THE NEW FWA OF THE MOVED STRING
          LX1      42     X1 - EQU FIELD IN LO ORDER
          SX1    X1              X1 - CLEAN EQU ADDR IN LO ORDER
          ZR     X1,NOEQU        BR, THERE IS NO EQU CHAIN
* 
* HERE TO FIX UP POINTER WORDS IN THE EQU CHAIN 
* X1 - ADDR FROM EQU FIELD
* X5 - ADDR OF MEW FWA OF MOVED STRING. 
* X7 - ADDR OF THE POINTER WORD OF THE MOVED STRING = "START" ADDR
* 
 EQUIN    BSS    0
* FETCH POINTER WORD POINTED TO BY "EQU" FIELD
          SA1    X1              X1 - FETCHED EQUATED POINTER WORD
* 
* INSERT NEW FWA OF MOVED STRING IN THE EQUATED POINTER WORD
          BX6    X2*X1           X6 - EQUATED POINTER WORD, NULL STRING 
          BX6    X6+X5           X6 - EQUATED POINTER WORD WITH GOOD STR
          SA6    A1              RESTORE CORRECTED EQUATED POINTER WORD 
* 
* IF THE EQU FIELD OF EQUATED POINTER WORD WE JUST CORRECTED
* POINTS TO THE POINTER WORD OF THE STRING WE JUST MOVED, 
* THEN WE HAVE COMPLETED GOING AROUND THE EQUATE CHAIN. 
* ISOLATE THE "EQU" FIELD OF THE POINTER WORD WE JUST CORRECTED.
          LX1    42              X1 - EQU FIELD IN LOW ORDER
          SX1    X1              X1 - CLEAN EQU FIELD IN LOW ORDER
* 
* TEST IF THIS EQU FIELD POINTS TO THE "START" OF CHAIN 
          IX3    X1-X7           X3 = CURRENT EQU - START 
          NZ     X3,EQUIN        BR, MORE ON THE EQU CHAIN
* 
* DONE FIXING EQU CHAIN POINTER WORDS 
* 
 NOEQU    BSS    0
* 
* NOW CORRECT THE TRAILER THAT PRECEDES THE 
* MOVED STRING TO REFLECT THE NEW LOCATION OF 
* THE TRAILER OF THE MOVED STRING.
          SA1    PREVIOUS         X1 - ADDRESS OF THE PRECEDING TRAILER 
          SA1    X1              X1 - PRECEDING TRAILER WORD
          LX1    42              X1 - NEXT TRAILER ADDR IN LO ORDER 
          BX1    X2*X1           X1 - PREVIOUS TRAILER WORD WITH NULL NE
          BX6    X1+X4           X6 - PREV TRLR WITH GOOD NEXT TRLR FIEL
          LX6    18              X6 - PREV TRAILER ALIGNED OK 
          SA6    A1              CORRECTED PREVIOUS TRALER RESTORED 
* 
* NOW GET READY FOR NEXT MAIN LOOP ITERATION. 
* SET "PREVIOUS" TO CONTAIN THE ADDRESS OF THE TRAILER
* OF THE STRING WE JUST MOVED.
          BX6    X4              X6 - ADDR OF TRAILER WE JUST MOVED 
          SA6    PREVIOUS         PREVIOUS UPDATED
* 
 MNTST    BSS    0
* 
* TEST IF ALL DONE MAIN LOOP SCAN 
* WE TEST TO SEE IF THE -NEXT- FIELD OF THE TRAILER 
* OF THE STRING WE JUST MOVED IS ZERO. IF SO WE ARE DONE. 
          SA1    NEXT            X1 - SAVED -NEXT- FIELD
          ZR     X1,MNDONE       BR, DONE MAIN SCAN 
* 
* HERE TO COMPLETE SET UP FOR ANOTHER SCAN ITERATION
* SET -CURRENT- TO THE ADDRESS OF THE TRAILER WORD OF THE 
* NEXT ITEM IN STRING AREA .
          SX6    X1              X6 - ADDR OF TRAILER WORD
          SA6    CURRENT          -CURRENT- NOW THE ADDRESS OF NEXT ITEM
* 
* FETCH THE TRAILER WORD TO BE EXAMINED 
          EQ     MAININ            BR BACK INTO MAIN LOOP.
* 
 MNDONE   BSS    0
* 
* UPDATE THE ADDRESS OF THE LAST TRAILER IN STRG AREA I.E. BASSMLI
          SA1    PREVIOUS          GET ADDRESS OF LAST TRAILER
          SX6    X1 
          SA6    BASSMLI         BASSMLI UPDATED
* SET TOTALGARBAGE TO ZERO
          MX7    0
          SA7    =XBASSMTG       BASSMTG ZEROED 
* 
 EXIT     BSS    0
* 
* 
          SA1    DBUGON            CHECK FOR CID MODE 
          ZR     X1,BASSMSQ        BR, CID DISABLED 
          SX6    4                 ENABLE CID INTERPRETER 
          SA6    INTBLCK
          SA1    INTADDR           DBUG.FN APLIST 
          RJ     =YDBUG.FN
          JP     BASSMSQ           EXIT 
* 
* 
* 
 GARBAGE  BSSZ 1
 PREVIOUS BSSZ 1
 CURRENT  BSSZ 1
 NEXT     BSSZ 1
          ENTRY  BASASTR,BATASTR
          DATA   10HBASASTR 
 BASASTR  DATA   0
* 
*         PERFORM STRING ASSIGNMENT BY EQUATING STRING
*         POINTER WORDS 
* 
*         ENTRY  B7 = ADDRESS OF SOURCE POINTER WORD
*                B6 = ADDRESS OF TARGET POINTER WORD
* 
*         EXIT   TARGET AND SOURCE PTR WORDS ARE UPDATED. 
*                IF SOURCE WAS TEMPORARY,B7 IS SET EQUAL TO B6. 
* 
*         REGS DESTROIED = X6, X7, A1, A3, A5, A6, A7 
* 
*         FORMAT OF STRING POINTER WORDS =
*                VFD 1/CONSTANT FLAG, 1/TEMP FLAG, 4/RESERVED,
*                    18/LENGTH, 18/EQU ADDRESS, 18/STRING LOCATION
* 
*         FORMAT OF STRING TRAILER WORDS =
*                VFD 24/RESERVED, 18/NEXT TRL ADR, 18/POINTER WORD ADR
* 
* 
  
          BX6    X1 
          BX7    X3 
          SA6    SVX1        SAVE X1
          SA7    SVX3        SAVE X3
          BX6    X5 
          SA6    SVX5        SAVE X5
  
*         PROCESS IDENTICAL POINTER WORDS 
  
          SA3    B6          X3 = TARGET POINTER WORD 
          SA5    B7          X5 = SOURCE POINTER WORD 
          BX6    X3-X5
          ZR     X6,ASTR.6   IF IDENTICAL, JUMP TO RESTORE REGS., EXIT
* 
* 
* CHECK FOR BLANK-APPENDED-TO-TRAILING-COLON FLAG 
* 
          MX6    0           CLEAR THE COLON BLANK FLAG 
          SA6    COLBLK 
          BX1    X5 
          LX1    3           SHIFT BIT 57 TO HIGH ORDER BIT 
          PL     X1,ASTR.A   COLON-BLANK FLAG NOT SET 
          MX6    1
          SA6    COLBLK      SET COLON-BLANK FLAG ON
* 
* 
  
*         RELEASE OLD STRING IF TARGET POINTS TO ONE
  
 ASTR.A   ZR     X3,ASTR.1   JUMP IF NO OLD STRING
          NG     X3,ASTR.1   JUMP IF OLD STRING IS A CONSTANT 
          SX1    A3 
          RJ     =XBASRSTR   GO RELEASE OLD STRING
  
*         PROCESS CONSTANT AND NULL SOURCE STRINGS
  
 ASTR.1   SA5    B7          X5 = SOURCE POINTER WORD 
*                            NOTE - SOURCE POINTER MUST BE LOADED AFTER 
*                                   CALL TO BASRSTR BECAUSE BASRSTR CAN 
*                                   CHANGE ITS VALUE
          NG     X5,ASTR.5   GO COPY SOURCE PTR INTO TARGET 
          ZR     X5,ASTR.5    AND EXIT. DON'T CHANGE SOURCE PTR.
  
*         PROCESS TEMPORARY SOURCE STRING 
  
          LX5    59-58       SHIFT TO TEST TEMP BIT 
          PL     X5,ASTR.2   JUMP IF NOT TYPE TEMP
          MX1    1
          BX5    -X1*X5      CLEAR TEMP BIT FOR COPY INTO TARGET
          LX5    -59+58      REPOSITION WORD
          SX7    B0          ZERO OUT RETURNED SOURCE POINTER 
          SX1    X5          ISOLATE FWA OF SOURCE STR
          SA1    X1-1        X1 = PRECEEDING TRAILER WORD 
          LX1    59-35+18    POSITION NEXT TRL ADR TO BITS 17-0 
          SA1    X1          X1 = CURRENT TRAILER WORD
          MX6    42 
          BX6    X6*X1       CLEAR OLD POINTER WORD ADR 
          SX3    A3          X3 = ADDRESS OF TARGET POINTER WORD
          BX6    X6+X3       OR IN NEW POINTER WORD ADR 
          SA6    A1          STORE UPDATED TRAILER
          SB7    B6          CHANGE ADDR OF SOURCE POINTER WORD TO ADDR 
                             OF TARGET POINTER WORD SO SUBSEQUENT 
                             EQUATES WILL CHAIN TO IT.
          EQ     ASTR.4      GO UPDATE POINTERS AND EXIT
  
*         PROCESS NON-NULL, NON-CONSTANT, NON-TEMPORARY SOURCE STRS 
  
 ASTR.2   LX5    -59+58      REPOSITION SOURCE POINTER WORD 
          MX1    18          MASK FOR EQU ADDRESS WHICH IS
          LX1    -59+35        IN BITS 35-18
          SX6    A3          MOVE ADDRESS OF TARGET PTR TO X6 
          LX6    18          POSITION TARGET PTR ADDRESS
          BX7    -X1*X5      CLEAR OLD EQU ADDRESS
          BX7    X7+X6       INSERT ADDRESS OF TARGET IN ITS PLACE
          BX6    X1*X5       GET EQU ADDRESS FROM SOURCE PTR
          NZ     X6,ASTR.3   SKIP IF IT POINTS SOMEWHERE
          SX6    A5          MOVE ADDRESS OF SOURCE TO X6 
          LX6    18          POSITION IT
 ASTR.3   BX5    X5+X6       INSERT EQU ADR IN TARGET PTR 
  
*         STORE UPDATED SOURCE AND TARGET POINTERS
*          AND RETURN 
  
 ASTR.4   SA1    COLBLK 
          PL     X1,ASTR.4A  BR, DONT SET COLON BLANK FLAG
          LX1    -3 
          BX5    X5+X1       SET COLON-BLANK FLAG IN TARGET POINTER WORD
 ASTR.4A  SA7    A5          STORE UPDATED SOURCE POINTER WORD
 ASTR.5   BX6    X5 
          SA6    A3          STORE UPDATED TARGET PTR WORD
 ASTR.6   SA1    SVX1        RESTORE X1 
          SA3    SVX3        RESTORE X3 
          SA5    SVX5        RESTORE X5 
          BX6    X5                RESTORE A5 WITHOUT DESTROYING X5 
          SA5    B6 
          BX5    X6 
          EQ     BASASTR     EXIT 
* 
 SVX1     BSS    1
 SVX3     BSS    1
 SVX5     BSS    1
  
 COLBLK   BSS    1           BLANK-APPENDED-TO-TRAILING-COLON FLAG
 BATASTR  BSS    0           ENTRY PT TO MARK END OF BASASTR
* 
*    END STRING MOVE
* 
* 
* 
* 
* 
* 
          TITLE  CHKDLMT - CHECK DELIMIT PROCEDURE
          ENTRY  CHKDLMT
          EXT    DLMTESC           ASCII ESCAPE CODE
          EXT    DLMTNO            DELIMITER NUMBER 
          EXT    KKKKKKK
          EXT    FFCLASS
          EXT    ASCII
          EXT    DLTKND 
* 
 KBLNK    EQU    55B               KRONOS BLANK 
 CHKDLMT  BSS    0
* 
* 
***              ON ENTRY X1 HAS THE CHARACTER TO BE CHECKED AGAINST
*                            THE SPECIFIED DELIMITERS.
***              ON EXIT X3 =0 IF DELIMITER MATCHED 
***                      X3=-1 IF DELIMITER NOT MATCHED 
* 
* 
***              USES X 1  2  3  7
* 
* 
          JP     0
          BX7    X1                SAVE THIS CHARACTER
          SA7    DLMTESC
          PL   X1,NOTESC           SKIP IF NOT ESCAPE CODE CHAR 
          BX1    -X1               74XX/76XX
 TSTDLMT  BSS    0
          SA2    DLMTNO            LOAD DELIMITER COUNT 
          BX7    X2 
 TSTNXTD  BSS    0
          SA2    A2+1              LOAD NEXT (SPECIFIED) DELIMITER
          IX3    X2-X1             CHECK AGAINST CURRENT CHARACTER
          ZR     X3,CHKDLMT        EXIT IF SIMILAR
          SX7    X7-1              ELSE CHECK DELIMITER COUNT 
          NZ     X7,TSTNXTD        AND LOOP WHILE NON-ZERO
          MX3    59                SET DELIMITER-NOT-MET FLAG 
          SA1    DLMTESC           RESTORE ORIGINAL X1
          EQ     CHKDLMT           AND EXIT 
* 
* 
 NOTESC   BSS    0
          SX2    KKKKKKK
          SX7    FFCLASS
          IX2    X2-X7             GET TRANSFORMED BLANK CODE 
          IX2    X2-X1             CHECK AGAINST CURRENT CHARACTER
          NZ     X2,NOTBLNK        SKIP IF ITS NOT A BLANK (CODE) 
          SX1    KBLNK             ELSE FORCE KRONOS-BLANK CODE 
 NOTBLNK  BSS    0
          EQ     TSTDLMT           GO TEST CHARACTER
          END 
