         TITLE    'WSCOPY-B00,08/22/73,DWG702985'
         SYSTEM   SIG7F
         CSECT    1
         PCC      0                 CONTROL CARDS NOT PRINTED.
WSCOPY@  RES      0                 ORIGIN OF WORKSPACE COPY MODULE.
*
*  REF'S  AND  DEF'S
*
         DEF      WSCOPY@                 =START OF WSCOPY MODULE.
         DEF      COPY              ENTRY PT WHEN COMMITTED TO TRY COPY.
         DEF      RNOTFND           RESUME AFTER ERNOTFND.
         DEF      RNOTCPY           RESUME AFTER ERNOTCPY.
         DEF      RCSIDAM           RESUME AFTER SIDAMC.
 SPACE 3
*                               REFS TO PROCEDURE:
         REF      ACQCC             ACQUIRE CHAR & ITS CODE.
         REF      ACQNB             ACQUIRE NON-BLANK CHAR & ITS CODE.
         REF      ALOCNONX          ALLOCS. N+2 WDS IF POSS.
         REF      CLEARMEM          CLEARS MEMORY, RELEASING UNNEC.PAGES
         REF      CLOSR             CLOSES & RELEASES A FILE.
         REF      CMDERR            COMMAND ERROR EXIT.
         REF      DREF              DE-REFERENCES A DATA BLK.
         REF      ERNOTCPY          ERROR -- NAME NOT COPIED  (PENDENT).
         REF      ERNOTFND          ERROR -- NAME NOT FOUND.
         REF      SIDAMC            ERROR -- SI DAMAGE -- DUE TO COPYING
         REF      FINDNAME          FINDS NAME (OR HOLE) IN ACTIVE SYMT.
         REF      GARBCOLL          GARBAGE COLLECTOR.
         REF      RDACTIV           READS ACTIVE WS, ON TEMP FILE.
         REF      RDCOPY            READS COPY'S DYNAMIC.
         REF      RDCOPYDR          READS COPY DATA REGION, CLOSING FILE
         REF      RDNAMER           READS A NAME RECORD INTO WINDOW.
         REF      COPYDMES          REPORTS SAVED INFO & TAKES CMD EXIT.
         REF      SETFREET          INITS. FREE TABLE & OTHER CELLS.
         REF      SYSTERR           ERROR -- SYSTEM ERROR (HOPELESS).
         REF      WRACTIV           WRITES ACTIVE WS, ON TEMP FILE.
         REF      WRCOPYDR          WRITES COPY DATA REGION.
         REF      WRNAMER           WRITES A NAME RECORD FROM WINDOW.
         REF      XWLOCGLB          EXCHANGES LOCALS & GLOBALS.
*                               REFS TO CONTEXT:
         REF      BACKUP            = 0 IF EXTENT OF COPY NOT YET
*                                     DETERMINED DUE TO A GROUP COPY.
         REF      BLANKCNT          NO.OF UNUSED ENTRIES IN ACTIVE
*                                     SYMBOL TABLE, SO FAR.
         REF      CONSTBUF          130 WORD TEMP BLK.
         REF      COPYBASE          LOC OF COPY DATA REGION IN COPY WS.
         REF      COPYHOME          LOC OF COPY DATA REGION IN ACTIVE WS
         REF      COPYSAVE          16 WD SAVE AREA ON DBLWD BOUND.
         REF      COPYSIZE          # WDS COPY DYNAMIC OR DATA REGION.
         REF      CORAVAIL          # WDS AVAIL. FOR THIS USER'S WS.
         REF      CORLEFT           # WDS NOT YET USED (PAGES NOT USED).
         REF      CORVSFIL          = 0 IF CORE-COPY OR = -1 IF FILE-CPY
         REF      CSYMT             LOC OF COPIED SYMBOL TABLE.
         REF      DISPLAC           DISPLACEMENT VALUE FOR RE-LOCATING.
         REF      DYNBOUND          BOUNDARY LOC FOR CURRENT DYNAMIC.
         REF      FREETBL           LOC OF FREE BLKS & THEIR SIZES.
         REF      FREETOTL          TOTAL AMT OF FREE DYNAMIC.
         REF      F:TF              TEMP FILE DCB.
         REF      GARBSAVE          REGISTER SAVE AREA, USED BY GARBCOLL
         REF      HICOMMON          LOC OF HIGHEST PT IN COMMON AREA.
         REF      IDBUF             TRYLOAD PUT COPY'S HDR INFO HERE.
         REF      IMAGE             CHARACTER BUFFER.
         REF      IMAGEPOS          BYTE ADDR.OF COPY-LIST IN IMAGE.
         REF      LINKCY            LINKAGE HOLDER FOR COPY ROUTINES.
         REF      LINKWY            LINKAGE HOLDER FOR WINDOWING.
         REF      LODYN             LOC OF LOWEST PT IN DYNAMIC AREA.
         REF      NAMEBUF           20-WD BLK TO HOLD NAMES.
         REF      NAMERKEY          KEY FOR ACCESSING NAME RECORDS ON
*                                     THE TEMP FILE (NOT THE REAL KEY).
         REF      NAMEWDS           TEMP CELL.
         REF      NILCK             STRAY DATA BLK PTR HOLDER.
         REF      NSYMTWDS          NO.OF WDS IN ACTIVE SYMBOL TABLE.
         REF      OFFSETK           TEMP CELL.
         REF      PCOPYFLG          = 0 IF COPY, SMALL NEG.NO. IF PCOPY.
         REF      STATEPTR          PTS AT TOP STATE-ENTRY IN XEQ STACK.
         REF      SYMT              PTS AT ACTIVE SYMBOL TABLE.
         REF      SYMTSIZE          # OF (2-WD) ENTRIES, ACTIVE SYM TBL.
         REF      TOPOSTAK          PTS AT TOP OF EXECUTION STACK.
         REF      WINDOW            512 WD TEMP BLK FOR NAME RECORD
*                                     BLOCKING.
         REF      ERRORID           ERROR I.D. CELL.
*                               REFS TO CONSTANTS & PARAMETERS.
         REF      BITPOS            32-WD TBL OF BITS (BITPOS-K CONTAINS
*                                     A WD HAVING A 1 ONLY IN BIT POS K)
         REF      FUNTYPES          RANGE OF FUNCTION TYPES.
         REF      HASHINC           INCREMENT ON HASH CRASH.
         REF      IN2CODE           BYTE TBL OF CODES FOR EACH CHAR.
         REF      STACKOFF          OFFSET OF STACK FROM HI COMMON.
         REF      XFFFF             = X'FFFF'
         REF      X1FFFF            = X'1FFFF'
         REF      IDTOOBIG          ERROR I.D. FOR 'TOO BIG'.
         REF      ID2NAMEY          ERROR I.D. FOR 'TOO MANY SYMBOLS'.
*
*  EQU'S RELATED TO THE CONTEXT REF'S:
*
HASHAQM  EQU      COPYHOME          HASH ACCUMULATOR.
COPYBND  EQU      COPYSIZE         BOUNDS COPY KRUNCH REGION.           U16-0004
*
*  STANDARD EQU'S
*                   REGISTERS
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
NEWLINE  EQU      X'15'             END-OF-STMT CHAR.
NAMECODE EQU      23                NAME CODESTRING DESIGNATION.
PENDFLAG EQU      X'8000'           MARKS PENDENT FUNCTION STATE-ENTRY.
TYPELIST EQU      6                 DATA BLK TYPE = LIST.
TYPEGRP  EQU      17                DATA BLK TYPE = GROUP.
LISTLOFF EQU      2                 OFFSET TO LENGTH WD OF LIST DATA BLK
XSIZOFF  EQU      2                 OFFSET TO XSIZE WD OF FUNC.DESCR.
RESOFF   EQU      3                 OFFSET TO RESULT WD OF FUN DESCR.
NFLOFF   EQU      7                 OFFSET TO NO.OF FUN LINES WD IN A
*                                     FUNCTION DESCRIPTOR.
*
*  CONSTANTS
*
THREE    DATA     3
E0000000 DATA     X'E0000000'       BITS 0,1,2
B1TO11   DATA     X'7FF00000'       BITS 1 TO 11.
NB1TO13  DATA     X'8003FFFF'       NOT BITS 1 TO 13.
NOTNBIT  DATA     X'FEFFFFFF'       NOT N-BIT (BIT POS 7).
 PAGE
************************************************************************
*                                                                      *
*  HASH --  HASHES A NEW NAME INTO THE ACTIVE SYMBOL TABLE.            *
*       REGS:    R14 -- LINK, EXIT VIA *R14.                           *
*                R2  -- (ENTRY) PTS AT 1ST WD OF NAME.                 *
*                R3  -- (ENTRY) NO.OF WORDS FOR THAT NAME.             *
*                R6  -- (EXIT) ACTIVE NAME PTR.                        *
*                R2 AND R3 ARE VOLATILE.                               *
*                                                                      *
HASH     STW,R7   COPYSAVE+7        SAVE R7.
         SLD,R2   2                 USE BYTE ADDRESSING & BYTE COUNT.
         LI,R6    0                 SET R6=0 FOR LATER DIVISION.
         STW,R6   HASHAQM           CLEAR HASH ACCUMULATOR.
HASHN    LB,R7    0,R2              GET CHAR.
         CI,R7    ' '               CK FOR BLANK...
         BNE      HASHC               NO, HASH IT.
HASHD    AI,R2    -1                  YES, BACK UP 1 CHAR.
         LB,R2    0,R2              GET THAT (EBCDIC) CHAR.
         LW,R7    HASHAQM           GET PARTIAL HASH VALUE.
         SLS,R7   1                 DOUBLE IT.
         AW,R7    R2                ADD EBCDIC CHAR VALUE.
         DW,R6    SYMTSIZE          DIVIDE BY SYM TBL SIZE.
         SLS,R6   1                 = TENTATIVE NAME PTR.
         AI,R6    1                 OFFSET FOR NAME-INDICATOR QUERYING.
HASHQ    LW,R7   *SYMT,R6           IS NAME-INDIC WD OCCUPIED...
         BNEZ     HASHI               YES, LOOK FOR A HOLE ELSEWHERE.
         LW,R7    COPYSAVE+7          NO, RESTORE R7.
         AI,R6    -1                = ACTIVE NAME PTR.
         B       *R14               EXIT.
HASHI    AI,R6    HASHINC+HASHINC   INCREMENT THE HASH PTR.
         CW,R6    NSYMTWDS          ARE WE STILL WITHIN SYM TBL...
         BL       HASHQ               YES.
         SW,R6    NSYMTWDS            NO, CYCLE BACK IN.
         B        HASHQ
HASHC    LB,R7    IN2CODE,R7        GET CODE FOR THAT CHAR.
         AWM,R7   HASHAQM           ACCUMULATE PARTIAL HASH VALUE.
         AI,R2    1                 PT AT NEXT CHAR, IF ANY...
         BDR,R3   HASHN               OK.
         B        HASHD               DONE.
 PAGE
************************************************************************
*                                                                      *
*  UCNP -- UPDATES A COPIED NAME PTR, REPLACING IT BY ITS ACTIVE ONE.  *
*       REGS:    R14 -- LINK, EXIT VIA *R14.                           *
*                R6  -- (ENTRY) CONTAINS THE COPY NAME PTR.            *
*                       (EXIT) CONTAINS THE ACTIVE NAME PTR.           *
*                R7  -- VOLATILE.                                      *
*                                                                      *
UCNP     AI,R6    2                 CONVERT TO ODD COPY NAME PTR.
         SLS,R6   19
         OR,R6    SYMT              PT AT ACTIVE SYM TBL.
         LW,R7    B1TO11            MASK FOR ODD COPY NAME PTR ONLY.
         B        UCNPQ             SEARCH ACTIVE SYM TBL FOR THE COPY
*                                     NAME PTR, IT'S THERE SOMEWHERE.
UCNPU    AI,R6    2                 PT AT NEXT ACTIVE SYM TBL ENTRY.
UCNPQ    CS,R6    0,R6              LOOK FOR COPY NAME PTR IN IT.
         BNE      UCNPU               NOPE, TRY AGAIN.
         AND,R6   X1FFFF              YEP.
         SW,R6    SYMT              GET ACTIVE NAME PTR (TO THIS ENTRY).
         B       *R14               EXIT.
 PAGE
************************************************************************
*                                                                      *
*  GNP -- GLOBAL NAME PROCESSOR.  R4 PTS AT COPY'S REFERENT DATA BLK.  *
*        R1 PTS AT COPY SYM TBL REF-INDICATOR WD.                      *
*  GNEW -- ENTERED VIA LNP TO ACCOUNT FOR A NEW NAME IN ACTIVE SYM TBL.*
*       REGS:    R14 -- LINK  (DUAL RETURN USED BY LNP).               *
*                R6  -- (ENTRY) PTS AT COPY'S REF-INDICATOR WD.
*                       (EXIT, IF NEW NAME & CORE-COPY) ACTIVE NAME PTR*
*                R10 -- (ENTRY) A-BIT ONLY.                            *
*                R14 IS VOLATILE.                                      *
*                                                                      *
GNP      MTW,1    1,R4              BUMP REFERENT'S REF-COUNT.
         CW,R10   0,R1              TEST A-BIT OF COPY ENTRY...
         BANZ    *R14                 SET -- RETURN.
         LW,R6    R1
GNEW     AWM,R10  0,R6                NOT SET -- SET NOW & ACCT NEW NAME
         MTW,-1   BLANKCNT          DECR. NO.OF HOLES IN ACTIVE SYM TBL.
         BGEZ     G4                  OK, THERE IS ROOM FOR THIS NAME.
         B        2MANYSYM            OOPS -- TOO MANY SYMBOLS
G4       STW,R14  COPYSAVE+14       SAVE LINK.
         STD,R2   COPYSAVE+2        SAVE R2 & R3.
         LW,R2    1,R6              GET COPY'S NAME-INDICATOR WD.
         LB,R3    R2                GET BYTE 0 OF IT.
         LW,R14   CORVSFIL          IS THIS A CORE-COPY...
         BEZ      G5                  YES.
         AI,R3    -20                 NO, FILE COPY.  LONG NAME...
         BGZ      G9                    SHORT NAME.
         MTW,1    -1,R2                 LONG NAME, BUMP REF-COUNT OF THE
         B        G9                      LONG NAME DATA BLK.
G5       AI,R6    1                 PT AT COPY'S NAME-INDICATOR WD.
         STW,R6   COPYSAVE+6        SAVE THAT PTR.
         CI,R3    20                LONG OR SHORT NAME...
         BLE      G5L                 LONG, R2 PTS AT IT.
         LI,R3    1                   SHORT, 1 WD NAME.
         LW,R2    COPYSAVE+6        PT AT THAT NAME.
         B        G5S
G5L      MTW,1    -1,R2             BUMP REF-COUNT OF LONG-NAME DATA BLK
G5S      BAL,R14  HASH              HASH THE NEW NAME INTO ACTIVE SYMTBL
         LW,R2   *COPYSAVE+6        GET COPY'S NAME-INDICATOR WD.
         STW,R6  *COPYSAVE+6        PUT ACTIVE NAME PTR IN THE RT HALF
*                                     OF THE COPY NAME-INDIC ENTRY.
         LI,R14   ' '
         STB,R14 *COPYSAVE+6       PUT A BLANK IN BYTE 0 OF IT.         U16-0006
         LI,R3    X'40000'          SET W-BIT OF THE
         STS,R3  *SYMT,R6             ACTIVE SYM TBL ENTRY.
         AI,R6    1                 PT TO ACTIVE NAME-INDICATOR WD.
         STW,R2  *SYMT,R6           PUT COPY'S NAME-INDICATOR THERE.
         AI,R6    -1                = ACTIVE NAME PTR AGAIN.
G9       LD,R2    COPYSAVE+2        RESTORE R2 & R3.
         B       *COPYSAVE+14       EXIT.
 PAGE
************************************************************************
*                                                                      *
*  LNP -- LOCAL NAME PROCESSOR.                                        *
*  LNP6 -- ENTERED WHEN R6 PTS AT COPY SYM TBL ENTRY.                  *
*       REGS:    R14 -- LINK  DUAL RETRUN PREPARED:                    *
*                       RETURN-0 (CORE-COPY)                           *
*                       RETURN-1 (FILE-COPY)                           *
*                R6  -- (ENTRY) COPY NAME PTR.                         *
*                       (EXIT) ACTIVE NAME PTR (IF CORE-COPY).         *
*                R10 -- (ENTRY) A-BIT ONLY.                            *
*                R13 -- (ENTRY) L-BIT ONLY.                            *
*                R14 IS VOLATILE AND R6 IS VOLATILE IF FILE COPY.      *
*                   (SEE ALSO GNEW)                                    *
LNP      AW,R6    CSYMT             PT AT COPY SYM TBL ENTRY.
LNP6     SW,R14   CORVSFIL          SET RETURN 1 OR 0.
         STS,R13  0,R6              SET L-BIT OF COPY ENTRY.
         CW,R10   0,R6              TEST A-BIT OF COPY ENTRY...
         BAZ      GNEW                NOT SET -- ACCOUNT FOR NEW NAME.
         LW,R6    1,R6                SET, EXTRACT ACTIVE NAME PTR (IF
         AND,R6   XFFFF                 CORE-COPY) OR GARBAGE.
         B       *R14               RETURN APPROPRIATELY.
 PAGE
************************************************************************
*                                                                      *
*  HUP  -- HEADER NAME UPDATE ENTRY.  SEE ALSO UCNP.                   *
*  HNP  -- HEADER NAME PROCEDURE ENTRY.  SEE ALSO LNP.                 *
*     THE HEADER OF A FUNCTION DESCRIPTOR INCLUDES:                    *
*                                   RESULT                             *
*                                   LF DUMMY                           *
*                                   FUNCTION NAME                      *
*                                   RT DUMMY                           *
*     IF ONE OF THESE IS NOT USED, ITS NAME PTR WORD IS MINUS ONE.     *
*                                                                      *
*       REGS:    R12 -- LINK, EXIT VIA *R12.                           *
*                R1  -- (ENTRY) PTS AT FUNCTION DESCRIPTOR DATA BLK.   *
*                       (EXIT) PTS AT NO.OF FUN LINES WD IN THAT BLK.  *
*                R3, R4, R6, R14  ARE VOLATILE; SEE ALSO AS APPROPRIATE*
*                       UCNP OR LNP.                                   *
*                                                                      *
HUP      LI,R4    UCNP              ENTER UCNP FOR NAME PTR UPDATE.
         B        HUPA
HNP      LI,R4    LNP               ENTER LNP FOR NAME PTR PROCEDURE.
HUPA     AI,R1    RESOFF            PT AT RESULT WD.
         LI,R3    4                 4 NAME PTRS ARE POSSIBLE.
HUPU     LW,R6    0,R1              GET WD...
         BLZ      HUPK                NOT A NAME PTR.
         BAL,R14  0,R4            @   NAME PTR -- UPDATE OR PROCEDURE.
         STW,R6   0,R1            @ REPLACE NAME PTR BY ACTIVE ONE.
HUPK     AI,R1    1               @ PT AT NEXT WD IN FUN DESCRIPTOR.
         BDR,R3   HUPU              LOOP TILL HEADER NAMES CHECKED.
         B       *R12               EXIT.
 PAGE
************************************************************************
*                                                                      *
*  CSUP -- CODESTRING'S NAMES UPDATE ENTRY.  SEE ALSO UCNP.            *
*  CSNP -- CODESTRING'S NAMES PROCEDURE ENTRY.  SEE ALSO LNP.          *
*       REGS:    R12 -- LINK, EXIT VIA *R12.                           *
*                R1  -- (ENTRY) PTS AT THE OFFSET WORD OF THE CODESTR. *
*                               DATA BLK.                              *
*                R1,R3,R6,R14  ARE VOLATILE; SEE ALSO AS APPROPRIATE   *
*                       UCNP OR LNP.                                   *
*                                                                      *
CSUP     LI,R3    UCNP              ENTER UCNP FOR NAME PTR UPDATE.
         B        CSU1
CSNP     LI,R3    LNP               ENTER LNP FOR NAME PTR PROCEDURE.
CSU1     STW,R1   OFFSETK           SAVE PTR TO CODESTRING.
         LH,R1   *OFFSETK           GET OFFSET TO RTMOST CODE DESIGNATOR
CSU2     LB,R6   *OFFSETK,R1        GET A CODESTRING DESIGNATOR...
         CI,R6    NAMECODE
         BG       CSU5                ABOVE NAME CODE -- SKIP IT.
         BE       CSUN                NAME CODE -- WORK ON NAME PTR.
         AI,R6    -10
         BLZ      CSU5                0 THRU 9 -- SKIP IT.
         B        CSU4,R6             10 THRU 22 -- VECTOR ON THAT CODE.
CSU4     BDR,R1   CSU5        @10  SCALAR INTG (BYTE)
         B        CSUK4       @11  SCALAR INTG (WORD)
         B        CSUK8       @12  SCALAR REAL
         BDR,R1   CSU5        @13  SCALAR TEXT
         BDR,R1   CSUKL       @14  VECTOR LOGL
         BDR,R1   CSUKI       @15  VECTOR INTG
         BDR,R1   CSUKR       @16  VECTOR REAL
         BDR,R1   CSUKT       @17  VECTOR TEXT
         BDR,R1   CSUKTL      @18  VECTOR TEXT (LONG)
         BDR,R1   CSUKT       @19  ERROR STRING
         BDR,R1   CSUKT       @20  COMMENT
         B        CSUN        @21  STOPNAME
*        B        CSUN        @22  TRACENAME
CSUN     AI,R1    -1          @     OFFSET TO LO BYTE OF NAME PTR.
         LB,R14  *OFFSETK,R1
         AI,R1    -1                OFFSET TO HI BYTE OF NAME PTR.
         LB,R6   *OFFSETK,R1
         SLS,R6   8
         OR,R6    R14               FORM COPY'S NAME PTR.
         BAL,R14  0,R3            @ DO NAME PTR UPDATE OR PROCEDURE.
         B        CSUNU           @ REPLACE COPY NAME PTR BY ACTIVE.
CSU5     AI,R1    -1              @ PT AT NEXT CODESTR.DESIGNATOR,
         CI,R1    1                   IF ANY...
         BG       CSU2                  OK.
         B       *R12                   DONE -- EXIT.
CSUNU    AI,R1    +1
         STB,R6  *OFFSETK,R1        REPLACE LO BYTE.
         AI,R1    -1
         SLS,R6   -8
         STB,R6  *OFFSETK,R1        REPLACE HI BYTE.
         B        CSU5
CSUK8    AI,R1    -4                SKIP 4 BYTES.
CSUK4    AI,R1    -4                SKIP 4 BYTES.
         B        CSU5
CSUKT    LB,R6   *OFFSETK,R1        GET LENGTH OF STRING.
         B        CSUKB             SKIP THAT MANY BYTES.
CSUKTL   LB,R14  *OFFSETK,R1        GET LO HALF OF LENGTH OF STRING.
         AI,R1    -1
         LB,R6   *OFFSETK,R1        GET HI HALF.
         SLS,R6   8
         OR,R6    R14               MERGE THEM.
         B        CSUKB             SKIP THAT MANY BYTES.
CSUKL    LB,R6   *OFFSETK,R1        GET LENGTH OF LOGL VECTOR.
         AI,R6    7
         SLS,R6   -3                CALC. NO.OF BYTES FOR LOGL VALUE.
         B        CSUKB             SKIP THAT MANY BYTES.
CSUKR    LB,R6   *OFFSETK,R1        GET NO.OF DBLWDS FOR REAL VECTOR.
         SLS,R6   3                 GET NO.OF BYTES.
         B        CSUKB
CSUKI    LB,R6   *OFFSETK,R1        GET NO.OF WDS FOR INTG VECTOR.
         SLS,R6   2                 GET NO.OF BYTES.
CSUKB    SW,R1    R6                SKIP TO LEFTMOST BYTE OF ITEM.
         B        CSU5
 PAGE
************************************************************************
*                                                                      *
*  WINDI -- READS A WORD FROM THE WINDOW.                              *
*  WINDRD -- ENTERED WHEN READING THE 1ST WORD OF WINDOW RECORDS.      *
*       REGS:    R14 -- LINK, EXIT VIA *R14 WITH CONDITION CODE SET    *
*                                   ACCORDING TO THE WORD JUST READ.   *
*                R3  -- (EXIT) CONTAINS THE WORD.                      *
*                R2  -- (ENTRY) LOC OF EARLIER WORD IN WINDOW.         *
*                R2 IS UPDATED, NO OTHER REGS ARE AFFECTED.            *
*                                                                      *
WINDI    AI,R2    1                 PT AT NEXT WINDOW WD.
WINDIA   LW,R3    0,R2              GET THAT WORD.
         BNEZ    *R14               EXIT UNLESS TRUNCATED WINDOW.
WINDRD   LCI      14                  SAVE REGS.
         STM,R1   GARBSAVE+1
         BAL,R14  RDNAMER           READ NAME RECORD INTO WINDOW.
         LCI      14
         LM,R1    GARBSAVE+1        RESTORE REGS.
         LI,R2    WINDOW            PT AT 1ST WINDOW WD.
         B        WINDIA
 PAGE
************************************************************************
*                                                                      *
*  WINDO -- PUTS A WD IN THE WINDOW; IF NEC. TRUNCATES & WRITES RECORD.*
*       REGS:    R14 -- LINK, EXIT VIA *R14.                           *
*                R3  -- CONTAINS THE WD.                               *
*                R2  -- OFFSET INTO THE WINDOW (FROM -511 TO 0).       *
*                R2 IS UPDATED, NO OTHER REGS. ARE AFFECTED.           *
*                                                                      *
WINDO    STW,R3   WINDOW+511,R2     PUT WD IN WINDOW.
         AI,R2    1                 UPDATE OFFSET.
         BLZ     *R14               EXIT IF OFFSET DOESN'T REACH ZERO...
         STW,R2   WINDOW+511          TRUNCATE ON ZERO WD.
         LI,R2    -511              SET FOR FRESH WINDOW.
         LCI      14
         STM,R1   GARBSAVE+1        SAVE REGS.
         BAL,R14  WRNAMER           WRITE THE CURRENT WINDOW RECORD.
         LCI      14                RESTORE REGS.
         LM,R1    GARBSAVE+1
         B       *R14               EXIT.
 PAGE
************************************************************************
*                                                                      *
*  WINDON -- PUTS A SHORT OR LONG NAME IN THE WINDOW.                  *
*       REGS:    R14 -- LINK (MAY EXIT VIA 'WINDO').                   *
*                R1  -- PTS AT SYM TBL ENTRY.                          *
*                R3, R4, R12, R14  ARE VOLATILE.                       *
*  WINDON12 -- ENTRY TO PUT A LONG NAME IN THE WINDOW.                 *
*       REGS:    R14 -- LINK.                                          *
*                R1  -- PTS AT SYM TBL ENTRY.                          *
*                R12 -- CONTAINS WORD COUNT OF LONG NAME.              *
*                R3, R4, R12, R14  ARE VOLATILE.                       *
*                                                                      *
WINDON   LW,R3    1,R1              GET SYM TBL ENTRY'S NAME-INDIC. WD.
         LB,R12   R3                GET WORD COUNT IF LONG NAME...
         CI,R12   20
         BG       WINDO               SHORT, EXIT VIA 'WINDO'.
WINDON12 LW,R4    1,R1                LONG, PT AT LONG NAME'S 1ST WD.
         STW,R14  LINKWY            SAVE LINK.
WINDONL  LW,R3    0,R4              GET NAME WD.
         AI,R4    1                 PT AT NEXT WD.
         BAL,R14  WINDO             PUT NAME WD IN WINDOW.
         BDR,R12  WINDONL           LOOP TILL DONE.
         B       *LINKWY            EXIT VIA SAVED LINK.
 PAGE
************************************************************************
*                                                                      *
*  SEEKN -- SEEKS NAME (POINTED TO BY R4) IN COPY SYM TBL.             *
*  SEEKNI -- ENTRY PT WHEN R4 CONTAINS A NAME-INDICATOR.               *
*       REGS:    R14 -- LINK  EXITS:  RETURN-0 IF NOT FOUND.           *
*                                     RETURN-1 IF FOUND.               *
*                R3  -- (ENTRY) NO.OF WORDS FOR NAME.                  *
*                R4  -- (ENTRY) PTS AT 1ST WORD OF NAME (OR ON A SHORT *
*                               NAME USING SEEKNI-ENTRY, THAT NAME).   *
*                R6  -- (EXIT) PTS AT COPY SYM TBL ENTRY IF FOUND.     *
*                R12 & R14  ARE VOLATILE, R4 IS VOLATILE ON SHORT NAME.*
*                                                                      *
SEEKN    CI,R3    1                 LONG OR SHORT NAME...
         BE       SEEKNS              SHORT.
         B        SEEKNL              LONG.
SEEKNI   CI,R3    1                 LONG OR SHORT NAME...
         BE       SEEKNS4             SHORT, IT IS IN R4.
SEEKNL   STD,R2   COPYSAVE+2          LONG.
         STD,R4   COPYSAVE+4        SAVE R2,R3,R4,R5.
         LW,R6    CSYMT
         AI,R6    1                 PT AT 1ST COPY SYM TBL NAME-INDIC.
         LW,R12   IDBUF+1           GET NO.OF COPY SYM TBL ENTRIES.
         B        SEEKNLQ
SEEKNLU  AI,R6    2                 PT AT NEXT NAME-INDICATOR.
SEEKNLQ  CB,R3   *R6                DO WORD-COUNTS MATCH...
         BNE      SEEKNLK             NO.
         LW,R2    0,R6                YES, PT AT 1ST WD OF COPY NAME.
         LW,R4    COPYSAVE+4        PT AT 1ST WD OF NAME SOUGHT.
SEEKNLW  LW,R5    0,R4              GET NAME WORD SOUGHT.
         CW,R5    0,R2              MATCH COPY NAME WORD...
         BNE      SEEKNL3             NO.
         AI,R4    1                   YES, PT AT NEXT WORDS.
         AI,R2    1
         BDR,R3   SEEKNLW           COMPARE NEXT WORDS, IF NOT DONE...
         AI,R14   1                   BINGO, SET FOR RETURN-1, AND SET
         BDR,R6   SEEKNLX               R6 TO POINT AT THE REF-INDIC.
SEEKNL3  LW,R3    COPYSAVE+3        RESTORE WORD-COUNT.
SEEKNLK  BDR,R12  SEEKNLU           TRY AGAIN, IF NOT DONE...
SEEKNLX  LD,R2    COPYSAVE+2          DONE.
         LD,R4    COPYSAVE+4        RESTORE R2,R3,R4,R5.
         B       *R14               TAKE APPROPRIATE RETURN.
SEEKNS   LW,R4    0,R4              GET NAME SOUGHT.
SEEKNS4  LW,R6    CSYMT             PT AT 1ST COPY SYM TBL ENTRY.
         LW,R12   IDBUF+1           GET NO.OF COPY SYM TBL ENTRIES.
         B        SEEKNSQ
SEEKNSU  AI,R6    2                 PT AT NEXT COPY SYM TBL ENTRY.
SEEKNSQ  CW,R4    1,R6              MATCH...
         BNE      SEEKNSK             NO.
         AI,R14   1                   BINGO.
         B       *R14               RETURN-1.
SEEKNSK  BDR,R12  SEEKNSU           TRY AGAIN, IF NOT DONE...
         B       *R14               RETURN-0.
 PAGE
************************************************************************
*                                                                      *
*  NAMEL -- MARKS (N-BIT) EVERY COPY SYM TBL ENTRY THAT MAY BE OF
*          INTEREST BASED ON THE COPY CMND'S NAME-LIST.                *
*       REGS:    R14 -- LINK.                                          *
*                ALL REGS MAY BE CONSIDERED VOLATILE.                  *
*                                                                      *
NAMEL    LW,R11   BITPOS-7    R11 =  N-BIT.
         STW,R14  LINKCY            SAVE LINK.
         LW,R2    IMAGEPOS          GET BA(1ST NON-BLNK IN COPY-LIST).
         LB,R3    0,R2
         AI,R3    -NEWLINE          IS THERE A LIST OF NAMES TO COPY...
         BNEZ     NB                  YES.
         LW,R14   IDBUF+1             NO, COPY ALL.
         LW,R6    CSYMT
COPYALL  STS,R11  0,R6              SET N-BIT FOR ALL COPY SYM TBL ENTS.
         AI,R6    2
         BDR,R14  COPYALL
         B       *LINKCY            EXIT.
NOTFND   LCI      11                SAVE MOST REGS.
         STM,R1   GARBSAVE+1
         B        ERNOTFND          DISPLAY -- NAME NOT FOUND.
RNOTFND  LCI      11
         LM,R1    GARBSAVE+1        RESTORE REGS.
         B        NCX
NC1M     AI,R3    1                 PUT CHAR IN IMAGE.
         STB,R2   0,R3
         AI,R1    1                 PT AT NEXT CHAR OF COPY-LIST.
         B        NC1
NB       LI,R3    BA(CONSTBUF)
         OR,R3    BITPOS-0          (= CHAR COUNT OF 128)
         MBS,R2   0                 MOVE COPY-LIST FROM IMAGE TO
         LI,R1    BA(CONSTBUF)        CONSTBUF & PT AT 1ST CHAR.
NC       LI,R3    BA(IMAGE)-1       PRESET TO PUT NAME-CHARS IN IMAGE.
NC1      LB,R2    0,R1              GET CHAR FROM COPY-LIST.
         CI,R2    ' '                 CK FOR BLANK OR NEWLINE...
         BG       NC1M                  NO, A NAME-CHAR.
         LI,R4    ' '                   YES.
NC2      AI,R3    1
         STB,R4   0,R3              APPEND AT LEAST ONE BLANK.
         CI,R3    3
         BANZ     NC2               BLANK TILL ON A WD BOUNDARY.
         AI,R3    -BA(IMAGE)
         SLS,R3   -2                CALC. NO.OF WORDS FOR THE NAME.
         LI,R4    IMAGE             PT AT 1ST WORD OF NAME.
         BAL,R14  SEEKN             SEEK NAME IN COPY SYM TBL...
         B        NOTFND              NOT FOUND.
         LI,R4    X'1FFFF'            FOUND.
         AND,R4   0,R6              DOES IT REF. A GLOBAL...
         BEZ      NOTFND              NO.
         STS,R11  0,R6                YES, SET COPY ENTRY'S N-BIT.
NCX      BAL,R4   ACQNB             ACQ NON-BLANK FROM COPY-LIST.
         CI,R2    NEWLINE           IS THAT ALL FOR COPY-LIST...
         BNE      NC                  NOT YET.
         B       *LINKCY            EXIT.
 PAGE
************************************************************************
*                                                                      *
*  XDACT -- DISPLACES COPIED DATA BLK PTRS IN THE ACTIVE SYM TBL       *
*           (COPIED REF-PTRS ARE INDICATED BY R-BIT AND LONG-NAME      *
*            PTRS BY W-BIT) AND REMOVES EXTRANEOUS BITS FROM THE       *
*           ACTIVE SYM TBL.                                            *
*  XACT --  ENTRY TO ONLY REMOVE EXTRANEOUS BITS FROM ACTIVE SYM TBL.  *
*       REGS:    R14 -- LINK, EXIT VIA *R14.                           *
*                R1, R4, R5, R7, R8, R9, R12, R13  ARE VOLATILE.       *
*                                                                      *
XDACT    LI,R7    X2                SET LOOP CONTROL FOR DISPLACING.
         LW,R9    DISPLAC           GET THE DISPLACEMENT.
         LW,R12   BITPOS-12         R-BIT.
         LI,R13   X'40000'          W-BIT.
         B        X1
XACT     LI,R7    X3                SET LOOP CONTROL FOR REMOVAL ONLY.
X1       LI,R4    0
         LW,R5    NB1TO13           MASK TO REMOVE BITS 1 - 13.
         LW,R1    SYMT              PT AT ACTIVE SYM TBL.
         LW,R8    SYMTSIZE          GET ITS SIZE.
         B        0,R7              START VIA LOOP CONTROL.
X2       CW,R12   0,R1              IS THERE A COPIED REF-PTR...
         BAZ      X21                 NO.
         AWM,R9   0,R1                YES, DISPLACE IT.
X21      CW,R13   0,R1              IS THERE A COPIED LONG-NAME PTR...
         BAZ      X3                  NO.
         AWM,R9   1,R1                YES, DISPLACE IT.
X3       LS,R4    0,R1              EXTRACT NON-EXTRANEOUS BITS AND
         STW,R4   0,R1                REPLACE THE ENTRY.
         AI,R1    2                 PT AT NEXT SYM TBL ENTRY.
         BDR,R8   0,R7              LOOP VIA LOOP CONTROL TILL DONE.
         B       *R14               EXIT.
 PAGE
************************************************************************
*                                                                      *
*  UNREF -- ELIMINATES A GLOBAL REFERENT, IF ANY, FROM THE ACTIVE      *
*        SYMBOL TABLE.  IN THE CASE OF A SUSPENDED FUNCTION, UNREF     *
*        DAMAGES THE SUSPENSIONS & REPORTS SI DAMAGE.                  *
*       REGS:    R7 -- LINK, MAY EXIT VIA 'DREF'.                      *
*                R2 -- (ENTRY) = 0.                                    *
*                R3 -- (ENTRY) = X'1FFFF'.                             *
*                R4 -- (ENTRY & EXIT) NO BITS OTHER THAN ADDR. FIELD.  *
*                R5 -- (ENTRY) = X'1FFFF'.                             *
*                R6 -- (ENTRY) IS THE ACTIVE NAME PTR.                 *
*                R4 AND R14 ARE VOLATILE; SEE ALSO 'DREF'.             *
*                                                                      *
UNREF    LS,R4   *SYMT,R6           GET ACTIVE REF-PTR OR NIL.
         BEZ      0,R7                NIL -- EXIT QUICKLY.
         STS,R2  *SYMT,R6           REMOVE IT FROM ACTIVE SYM TBL.
         LB,R14  *R4                GET TYPE OF DATA BLK REFERENCED.
         CLM,R14  FUNTYPES          IS IT A DEFINED FUNCTION...
         BCS,9    DREF                NO, DE-REFERENCE IT & EXIT.
         LW,R14   1,R4                YES, GET ITS REF-COUNT.
         AI,R14   -1                DISCOUNT THE SYM TBL REF...
         BEZ      DREF                THAT'S ALL, DE-REFERENCE & EXIT.
         LCI      13                  IT IS A SUSPENDED FUNCTION.
         STM,R1   GARBSAVE+1        SAVE REGS.
         LW,R6    STATEPTR          PT AT TOP STATE-ENTRY IN XEQ. STACK.
         B        UNREFQ            HUNT FOR THOSE SUSPENSIONS.
UNREFS   LI,R13   X'7FFF'
         AND,R13  0,R6              MOVE TO NEXT STATE-ENTRY STACKED.
         AW,R6    R13
UNREFQ   CS,R4    1,R6              DOES IT REFER TO OUR FUNCTION...
         BNE      UNREFS              NO.
         STW,R2   1,R6                YES, DAMAGE IT.
         BDR,R14  UNREFS            LOOP TILL LAST SUSPENSION DAMAGED.
         B        SIDAMC            ERROR -- SI DAMAGE -- RESUME RCSIDAM
RCSIDAM  LCI      13
         LM,R1    GARBSAVE+1        RESTORE REGS.
         STW,R2   1,R4              ZERO THE REF-COUNT OF THE FUNCTION.
         B        DREF              DEREFERENCE IT (BYE-BYE) & EXIT.
 PAGE
************************************************************************
*                                                                      *
*  KRUNCH -- COALESCES DATA BLKS TO BE COPIED.                         *
*       REGS:    R8  -- LINK, EXIT VIA GARBCOLL                        *
*                R1  -- (ENTRY) PTS AT 1ST COPY BLK (DATA OR FREE).    *
*                R1, R3, R4, R7  ARE VOLATILE; SEE ALSO 'DREF'.        *
*                                                                      *
KRUNCH   LW,R4    DYNBOUND         SET BOUND TO KRUNCH REGION.          U16-0008
         STW,R4   COPYBND                                               U16-0009
         B        KRUNCHT                                               U16-0010
KRUNCHS  MTW,1    1,R1              BUMP REF-COUNT OF NEXT BLK &
         STW,R1   NILCK               SAVE ITS LOC IN CASE IT MOVES.
         STW,R1   COPYBASE         SAVE ALSO FOR MOVE CK.               U16-0012
         BAL,R7   DREF              PUT LATEST FREE BLK IN FREE TBL.
         LI,R1    0                 CLEAR & GET PTR
         XW,R1    NILCK               TO NEXT BLK AGAIN,
         MTW,-1   1,R1                  CORRECTING ITS REF-COUNT.
         CW,R1    COPYBASE         DID KRUNCH REGION MOVE...            U16-0014
         BE       KRUNCHT            NO.                                U16-0015
         LW,R3    FREETBL            YES, SET NEW BOUND TO              U16-0016
         STW,R3   COPYBND              KRUNCH REGION.                   U16-0017
KRUNCHT  LW,R3    1,R1             IS THIS A DATA BLK OR FREE BLK...    U16-0018
         BNEZ     KRUNCHR             DATA BLK.
         LW,R4    R1                  FREE BLK, AIM AT IT.
         INT,R3   0,R1              GET ITS SIZE.
         AW,R1    R3                PT AT NEXT BLK, IF ANY...
         CW,R1    COPYBND                                               U16-0020
         BL       KRUNCHS             ANOTHER COMING UP.
         LI,R7    GARBCOLL            NO MORE, EXIT VIA GARBCOLL AFTER
         B        DREF                  LAST FREE BLK GOES IN FREE TBL.
KRUNCHR  INT,R3   0,R1              GET SIZE OF DATA BLK.
         AW,R1    R3                PT AT NEXT BLK, IF ANY.
         CW,R1    COPYBND                                               U16-0022
         BL       KRUNCHT            ANOTHER COMING UP.                 U16-0023
         B        GARBCOLL            NO MORE, EXIT AFTER GARBAGE
*                                       COLLECTION.
 PAGE
************************************************************************
*                                                                      *
*  SA -- SCANS ACTIVE SYM TBL:                                         *
*          SETS 'BLANKCNT' = NO.OF UNUSED ENTRIES.                     *
*          IN CORE-COPY, LOOKS FOR ACTIVE NAMES IN THE COPY SYM TBL,   *
*             AND IF FOUND MODIFIES THE COPY ENTRY APPROPRIATELY.      *
*          IN FILE-COPY, WRITES ACTIVE NAME RECORDS, MARKING THEM      *
*             APPROPRIATELY.                                           *
*       REGS:    R14 -- LINK (VOLATILE)                                *
*                R1  -- (EXIT) PTS AT 1ST WD AFTER ACTIVE SYM TBL.     *
*                R8  -- (EXIT) = 0.                                    *
*                                                                      *
*                ALL OTHER REGS MAY BE REGARDED AS VOLATILE.           *
*                                                                      *
SA       STW,R14  LINKCY            SAVE LINK.
         LI,R10   0           R10 = CLEAR BLANK COUNTER.
         LW,R7    CORVSFIL    R7  = 0 IF CORE-COPY,  -1 IF FILE-COPY.
         LI,R5    X'1FFFF'    R5  = ADDRESS MASK.
         LW,R9    BITPOS-1    R9  = GR-BIT (GLOBAL REFERENT).
         LW,R11   BITPOS-2    R11 = PF-BIT (PENDENT FUNCTION).
         LW,R13   BITPOS-3    R13 = A-BIT (ACCOUNTED FOR IN ACTIVE TBL).
         LW,R1    SYMT        R1  = PTR TO ACTIVE ENTRY.
         LW,R8    SYMTSIZE    R8  = ACTIVE ENTRY COUNT TO GO.
SA31     LW,R4    1,R1              GET NAME-INDICATOR WORD...
         BEZ      SA38                UNUSED.
         LB,R3    R4                GET WORD-COUNT IF LONG NAME...
         CI,R3    20
         BLE      SA33,R7             LONG.
         LI,R3    1                   SHORT, SET WC = 1.
         B        SA33,R7
         B        SA34            @-FILE.
SA33     BAL,R14  SEEKNI          @-CORE, SEEK NAME IN COPY SYM TBL...
         B        SA39            @   NOT FOUND.
SA34     EXU      SA34A,R7        @   FOUND, SET A-BIT.
         LI,R4    0                 GET ACTIVE REF-PTR...
         LS,R4    0,R1
         BEZ      SA37,R7             NIL.
         EXU      SA34GR,R7           OK, SET GR-BIT.
         LB,R14  *R4                GET TYPE OF GLOBAL REFERENT...
         CLM,R14  FUNTYPES
         BCS,9    SA37,R7             NOT A DEFINED FUNCTION.
         LW,R14   1,R4                DEFINE FUNCTION, GET REF-COUNT...
         AI,R14   -1
         BEZ      SA37,R7               ONLY 1 REF (IN SYM TBL NOW).
         LW,R7    STATEPTR              IT'S REFERENCED IN XEQ STACK.
         B        SA34PQ            SEE IF IT IS PENDENT.
         OR,R3    BITPOS-3        @-FILE.
SA34A    STS,R13  0,R6            @-CORE, MODIFY COPY SYM TBL ENTRY.
         OR,R3    BITPOS-1        @-FILE.
SA34GR   STS,R9   0,R6            @-CORE, MODIFY COPY SYM TBL ENTRY.
         OR,R3    BITPOS-2        @-FILE.
SA34PF   STS,R11  0,R6            @-CORE, MODIFY COPY SYM TBL ENTRY.
SA34PS   LI,R12   X'7FFF'
         AND,R12  0,R7              GET OFFSET TO NEXT STATE ENTRY...
         BEZ      SA34PEND            NONE, FUNCTION MUST BE PENDENT.
         AW,R7    R12                 OK, PT AT IT.
SA34PQ   CS,R4    1,R7              DOES THIS STATE ENTRY REF THE FUN...
         BNE      SA34PS              NO, TRY NEXT.
         LI,R12   PENDFLAG            YES, IS IT PENDENT...
         CW,R12   0,R7
         BANZ     SA34PEND              YEP.
         BDR,R14  SA34PS                NOPE, LOOP UNLESS LAST SUSP.
         LW,R7    CORVSFIL          OK, SUSPENDED ONLY, RESTORE R7.
         B        SA37,R7
SA34PEND LW,R7    CORVSFIL          RESTORE R7.
         EXU      SA34PF,R7         SET PF-BIT.
         B        SA37,R7
         B        SA37FILE        @-FILE.
SA37     LW,R2    R1              @-CORE.
         SW,R2    SYMT              GET ACTIVE NAME PTR (IN RT HALFWD).
         OR,R2    BITPOS-1          PUT 'BLANK' IN BYTE 0.
         STW,R2   1,R6              REPLACE COPY'S NAME-INDICATOR WD.
         B        SA39
SA37FILE BAL,R14  WINDO             PUT WORD-1 (I.E. R3) IN WINDOW.
         LI,R14   SA39              GO TO SA39 AFTER PUTTING
         B        WINDON              NAME WORD(S) IN THE WINDOW.
SA38     AI,R10   1                 BUMP BLANK COUNT.
SA39     AI,R1    2                 PT AT NEXT ENTRY AND
         BDR,R8   SA31                LOOP IF ANY.
         STW,R10  BLANKCNT          SET BLANK COUNT (HOLES IN ACTIVE
         B       *LINKCY              SYM TBL).  EXIT VIA SAVED LINK.
 PAGE
************************************************************************
*                                                                      *
*  ACDYN -- ACQUIRE COPY DYNAMIC:                                      *
*                 ALLOCATE SPACE.                                      *
*                 DECLARE THAT SPACE TO BEGIN A SINGLE LARGE FREE BLK  *
*                   AT THE END OF CURRENT DYNAMIC.                     *
*                 READ COPY'S DYNAMIC INTO THE ALLOTED SPACE.          *
*                 SET CSYMT TO PT AT THE COPIED SYM TBL.               *
*                 SET DISPLAC TO THE DISPLACEMENT BETWEEN COPIED DATA  *
*                   BLK PTRS AND THEIR NEW VALUES.                     *
*                 ENTER RLOC TO ZERO THE REF-COUNTS OF ALL COPIED DATA *
*                   BLKS USING                                         *
*                     RB-ENTRY IF DISPLAC = 0                          *
*                     RC-ENTRY IF DISPLACEMENTS ARE NECESSARY.         *
*       REGS:    R12 -- LINK, EXIT IS IN THE RLOC ROUTINE.             *
*                R1  -- (EXIT) PTS AT 1ST DATA BLK IN COPIED DYNAMIC.  *
*                R2  -- (EXIT) LOOPING LOCATION FOR RLOC.              *
*                 SEE ALSO THE RLOC ROUTINE, IN GENERAL ALL REGS       *
*                   SHOULD BE CONSIDERED VOLATILE WHEN CALLING         *
*                   ACDYN.                                             *
*                                                                      *
ACDYN    STW,R12  LINKCY            SAVE LINK.
         LW,R11   COPYSIZE          GET SIZE OF COPY DYNAMIC.
         AI,R11   -2                DATA BLK HDR IS UNNEC.
         BAL,R14  ALOCNONX        @ ALLOC SPACE FOR COPY DYNAMIC.
         BAL,R15  SYSTERR         @   WS FULL SHOULD BE IMPOSSIBLE.
         LW,R11   FREETOTL        @ GET SIZE OF FREE BLK AFTER SPACE...
         BEZ      AD                  NONE.
         STW,R11 *FREETBL           MAKE THAT FREE BLK BE A LARGE FREE
*                                     BLK (TYPE = 0 & SIZE = FREE TOTAL)
*                                     ITS REF-COUNT WILL BE ZEROED LATER
*                                     IN RLOC.
AD       STW,R4   FREETBL           FREE EVERYTHING FROM THE ALLOTED
         LW,R6    DYNBOUND            SPACE ONWARD AS A SINGLE FREE BLK,
         SW,R6    FREETBL             THIS WILL PREVENT COPY DYNAMIC
         STW,R6   FREETBL+1           FROM MOVING TILL DESIRED.
         STW,R6   FREETOTL
         BAL,R14  RDCOPY            READ COPY'S DYNAMIC INTO THAT BLK.
         LW,R1    FREETBL
         AW,R1    IDBUF+0           SET CSYMT TO PT AT 1ST WD OF
         STW,R1   CSYMT               COPY SYM TBL.
         LW,R9    FREETBL
         SW,R9    IDBUF+4           SET DISPLAC TO DISPLACEMENT OF OLD
         STW,R9   DISPLAC             LOCATIONS TO NEW ONES...
         BNEZ     AG                    NON-ZERO, ADJUST PTRS IN CSYMT.
         AW,R1    IDBUF+1               ZERO (DISPLACEMENTS UNNECESSARY)
         AW,R1    IDBUF+1           SET R1 TO PT AT 1ST COPY DATA BLK.
         LI,R2    RB                SET R7 FOR ZEROING REF-COUNTS ONLY
         B        RB                  AND ENTER RLOC AT THE RB-ENTRY.
*                                     (NOTE R9 = 0).
AG       LI,R5    X'1FFFF'
         LW,R14   IDBUF+1           GET NO.OF COPY SYM TBL ENTRIES.
AGQ      LW,R4    1,R1              LOOK AT NAME-INDICATOR WD...
         BEZ      AGU                 UNUSED.
         AND,R4   E0000000            USED, LONG OR SHORT NAME...
         BNEZ     AGR                   SHORT.
         AWM,R9   1,R1                  LONG, DISPLACE LONG-NAME PTR.
AGR      CW,R5    0,R1              IS THERE A REFERENT PTR...
         BAZ      AGU                 NO.
         AWM,R9   0,R1                YES, DISPLACE IT.
AGU      AI,R1    2                 PT AT NEXT ENTRY, IF ANY.
         BDR,R14  AGQ               (WHEN DONE, R1 PTS AT 1ST COPY DATA
         LI,R2    RC                  BLK.)  SET R7 FOR ZEROING REF-
         B        RC                  COUNTS AND ENTER RLOC AT THE
*                                     RC-ENTRY.  (NOTE R14 = 0).
 PAGE
************************************************************************
*                                                                      *
*  RLOC -- THIS ROUTINE, WHICH IS SHARED BY ACDYN, DRIVES ONE OF 3     *
*        PROCESSES:                                                    *
*              1 - TO ZERO THE REF-COUNTS OF ALL COPIED DATA BLKS.     *
*              2 - TO ZERO THE REF-COUNTS OF ALL COPIED DATA BLKS AND  *
*                  DISPLACE EACH COPIED DATA BLK PTR WITHIN THE COPIED *
*                  LISTS OR FUNCTIONS.                                 *
*              3 - TO DISPLACE EACH COPIED DATA BLK PTR WITHIN THE     *
*                  COPIED LISTS OR FUNCTIONS AND TO REPLACE COPY NAME  *
*                  PTRS BY ACTIVE NAME PTRS IN GROUPS, FUNCTIONS, AND  *
*                  CODESTRING FOR THOSE FUNCTIONS.                     *
*  RLOC IS THE ENTRY FOR PROCESS 3; R12 IS THE LINK, R9 = DISPLAC.     *
*  RB IS THE ENTRY PT FOR PROCESS 1; R9=0 & R2=RB UPON ENTRY.          *
*  RC IS THE ENTRY PT FOR PROCESS 2; R14=0, R9=DISPLAC, & R2=RC (ENTRY)*
*       REGISTER 1 PTS AT THE 1ST COPIED DATA BLK UPON ALL ENTRIES.    *
*                                                                      *
*       ALL REGS SHOULD BE PRESUMED VOLATILE.                          *
*                                                                      *
RLOC     STW,R12  LINKCY            SAVE LINK.
         LI,R2    RD          R2  = LOOP CONTROL.
         B        RD
RB       STW,R9   1,R1              ZERO THE REF-COUNT.
         B        RE                LOOP FOR NEXT DATA BLK.
RC       STW,R14  1,R1            @ ZERO THE REF-COUNT.
RD       LB,R4   *R1              @ GET TYPE OF DATA BLK.
         B        RDV,R4            VECTOR ON THE TYPE:
RDV      B        RE              @   0 -- FREE.
         B        RE              @   1 -- LOGL.
         B        RE              @   2 -- TEXT.
         B        RE              @   3 -- INTG.
         B        RE              @   4 -- REAL.
         B        RE              @   5 -- INDEX SEQUENCE.
         B        RL              @   6 -- LIST.
         B        RCS-RD,R2       @   7 -- CODESTRING.
         B        RF              @   8 -- FUNCTION.
         B        RF              @   9 -- FUNCTION.
         B        RF              @  10 -- FUNCTION.
         B        RF              @  11 -- FUNCTION.
         B        RF              @  12 -- FUNCTION.
         B        RF              @  13 -- FUNCTION.
         B        RE              @  14 -- INTRINSIC FUNCTION.
         B        RE              @  15 -- INTRINSIC FUNCTION.
         B        RE              @  16 -- INTRINSIC FUNCTION.
         B        RG-RD,R2        @  17 -- GROUP.
         B        RE              @  18 -- LONG NAME.
*  NOTE -- RCS MUST FOLLOW A      @
*        B        RE              @  RC-PROCESS.
*        IN ORDER TO DRIVE RC-    @
*        PROCESSING RATHER THAN   @
*        RD-PROCESSING.           @
RCS      STW,R1   COPYSAVE          SAVE DATA BLK PTR.
         AI,R1    2                 PT AT OFFSET WD OF CODESTRING BLK.
         BAL,R12  CSUP              UPDATE CODESTRING'S NAME PTRS.
         LW,R1    COPYSAVE          RESTORE DATA BLK PTR.
RE       INT,R3   0,R1              GET SIZE OF CURRENT BLK.
         AW,R1    R3                PT AT NEXT BLK, IF ANY...
         CW,R1    DYNBOUND
         BL       0,R2                YES, GOTO RB, RC, OR RD.
         B       *LINKCY              NO -- EXIT VIA SAVED LINK.
RL       LW,R3    LISTLOFF,R1       GET LENGTH OF LIST...
         BEZ      RE                  ZERO, SKIP IT.
         AI,R1    LISTLOFF            PT AT THE WD BEFORE 1ST PTR IN IT.
RLQ      LW,R4   *R1,R3             TEST FOR DATA BLK PTR...
         BEZ      RLK                 NIL.
         AWM,R9  *R1,R3               YES, DISPLACE IT.
RLK      BDR,R3   RLQ               LOOP TILL DONE.
         AI,R1    -LISTLOFF         PT AT DATA BLK HDR AGAIN.
         B        RE
RF       STW,R1   COPYSAVE          SAVE PTR TO FUNCTION DATA BLK HDR.
         LW,R3    XSIZOFF,R1        GET FUNDEF'S XSIZE WD.
         CI,R3    X'E0000'          DOES IT PT AT ERR-CTRL TBL...
         BAZ      RFNFL               NO.
         AWM,R9   XSIZOFF,R1          YES, DISPLACE PTR TO ERR-CTRL TBL.
RFNFL    LW,R3    NFLOFF,R1         GET NO.OF FUNCTION LINE PTRS...
         BEZ      RFN-RD,R2           NONE, PROCEED VIA LOOP CONTROL.
         AI,R1    NFLOFF              PT AT WD BEFORE 1ST PTR.
RFDP     AWM,R9  *R1,R3             DISPLACE EACH LINE PTR.
         BDR,R3   RFDP
         AW,R1    0,R1              PT AT LAST FUNCTION LINE PTR.
         LI,R3    X'FFFF'
         AND,R3   1,R1              GET NO.OF LABEL ENTRIES...
         BEZ      RFN-RD,R2           NONE, PROCEED VIA LOOP CONTROL.
RFDLBL   AI,R1    2                   PT AT LABEL-ENTRY.
         AWM,R9   1,R1              DISPLACE IT.
         BDR,R3   RFDLBL            LOOP TILL LABEL DATA BLK PTRS DONE.
         B        RFN-RD,R2         PROCEED VIA LOOP CONTROL.
         B        RFX             @-RC.
RFN      LW,R1    COPYSAVE        @-RD, PT AT FUNCTION DATA BLK HDR.
         BAL,R12  HUP               UPDATE HEADER NAME PTRS.
         AW,R1    0,R1              PT AT LAST FUNCTION LINE PTR.
         LW,R3    1,R1              GET NO.OF LOCALS & LABELS...
         BEZ      RFX                 NONE.
         STW,R3   NAMEWDS             SAVE IT.
         AND,R3   XFFFF             GET NO.OF LABELS...
         BEZ      RFLCLS              NONE.
RFLBL    AI,R1    2                 PT AT LABEL ENTRY.
         LW,R6    0,R1              GET LABEL'S NAME PTR.
         BAL,R14  UCNP              GET ACTIVE VERSION OF THAT NAME PTR.
         STW,R6   0,R1
         BDR,R3   RFLBL
RFLCLS   LH,R3    NAMEWDS           GET NO.OF LOCALS...
         BEZ      RFX                 NONE.
         AI,R1    2                   PT AT 1ST WD OF LOCAL NAME PTRS.
         SLS,R1   1                 USE HALFWD RESOLUTION.
RFLCL    LH,R6    0,R1              GET LOCAL'S NAME PTR.
         BAL,R14  UCNP              GET ACTIVE VERSION OF THAT NAME PTR.
         STH,R6   0,R1
         AI,R1    1
         BDR,R3   RFLCL
RFX      LW,R1    COPYSAVE          PT AT DATA BLK HDR AGAIN.
         B        RE              @-RC.
RG       STW,R1   COPYSAVE        @-RD, SAVE PTR TO GROUP DATA BLK HDR.
         AI,R1    2                 PT AT LENGTH OF GROUP.
         SLS,R1   1                 (HALFWD)
         LH,R3    0,R1              GET LENGTH OF GROUP...
         BEZ      RGX                 ZERO.
RGU      AI,R1    1                 PT AT GROUP'S NAME PTR.
         LH,R6    0,R1              GET IT.
         BAL,R14  UCNP                GOT IT.
         STH,R6   0,R1                  GOOD.
         BDR,R3   RGU
RGX      LW,R1    COPYSAVE          PT AT DATA BLK HDR AGAIN.
         B        RE
 PAGE
COPY     BAL,R8   GARBCOLL          GARBAGE COLLECT.
         BAL,R14  XWLOCGLB          EXCHANGE LOCALS & GLOBALS.
         LW,R14   TOPOSTAK          CALC. SIZE AVAILABLE IN ACTIVE.
         SW,R14   FREETBL
         AI,R14   -4                  (EXTRA 4 WDS DEMANDED BY ALOCBLK).
         SW,R14   COPYSIZE          SUBTRACT SIZE OF COPY DYNAMIC.
         SAS,R14  -31               EXTEND SIGN OF RESULT SO THAT
         STW,R14  CORVSFIL            CORVSFIL =  0  IF CORE-COPY.
         BLZ      FA                  CORVSFIL = -1  IF FILE-COPY.
         BAL,R12  ACDYN             ACQ COPY DYNAMIC, ZERO ITS REF-CNTS.
         BAL,R14  NAMEL             PROCESS COPY CMND'S NAME-LIST.
         LI,R14   DCOPY             GO TO DCOPY AFTER
         B        SA                  SCANNING ACTIVE SYM TBL; RETURN
*                                       IS TO CD, EVENTUALLY.
*
*  UPON ENTRY TO CD:          R1  = PTR TO COPY SYM TBL'S 1ST WD.
*                             R2  = 0
*                             R4  = 0
*                             R5  = X'1FFFF'
*                             R8  = NO.OF COPY SYM TBL ENTRIES.
*                             R11 = THE N-BIT.
*
CD       LI,R3    X'1FFFF'
CD2      CW,R11   0,R1              IS THIS ITEM TO BE COPIED...
         BAZ      CD5                 NO.
         LW,R6    1,R1                YES, GET ITS ACTIVE NAME PTR.
         BAL,R7   UNREF             ELIM ANY ACTIVE GLOBAL REFERENT.
         LI,R7    X'1FFFF'          LOC OF COPY'S GLOBAL REFERENT
         AND,R7   0,R1                TOGETHER WITH THE R-BIT (MARKING
         OR,R7    BITPOS-12             AN ALIEN REF-PTR FOR ACTIVE)
         STS,R7  *SYMT,R6                 ARE PUT IN ACTIVE ENTRY.
CD5      AI,R1    2                 PT AT NEXT COPY SYM TBL ENTRY,
         BDR,R8   CD2                 LOOPING IF ANY.
         STW,R1   COPYBASE          SAVE LOC OF 1ST BLK IN COPY DATA REG
         BAL,R8   GARBCOLL          GARBAGE COLLECT ACTIVE WS, COPY WILL
*                                     NOT YET MOVE.
         BAL,R14  XACT              REMOVE EXTRANEOUS BITS (INCLUDING
*                                     R AND W BITS) FROM ACTIVE SYM TBL.
         LW,R1    COPYBASE
         SW,R1    DYNBOUND          = - SIZE OF COPY DATA BLK REGION.
         AWM,R1   FREETBL+1         DECLARE THAT REGION TO BE ALLOCATED.
         AWM,R1   FREETOTL            I.E. NO LONGER FREE.
         LW,R1    COPYBASE          PT AT 1ST BLK IN THAT REGION.
         BAL,R8   KRUNCH            COALESCE THOSE BLKS THAT ARE COPIED,
*                                     FREEING UNCOPIED BLKS SEQUENTIALLY
CI       LI,R1    IDBUF             SET UP FOR COPYDMES.
         LI,R14   COPYDMES          ISSUE THE SAVED MESSAGE & EXIT AFTER
         B        XWLOCGLB            RE-EXCHANGING LOCALS & GLOBALS.
FA       BAL,R14  WRACTIV           OPEN TEMP FILE & WRITE ACTIVE WS.
         LI,R14   0
         STW,R14  NAMERKEY
         LI,R2    -511              SET TO WINDOW ACTIVE NAME RECORDS.
         BAL,R14  SA                SCAN ACTIVE SYM TBL, WINDOWING.
         LI,R3    -1                END THE ACTIVE NAME RECORDS.
         STW,R3   WINDOW+511,R2
         BAL,R14  WRNAMER           WRITE THE LAST ACTIVE NAME RECORD.
         BAL,R11  CLEARMEM          CLEAR OUT ACTIVE WS.
         LW,R11   HICOMMON
         AI,R11   -STACKOFF
         STW,R11  TOPOSTAK
         STW,R11  STATEPTR
         LW,R3    LODYN             FREE ALL OF DYNAMIC.
         BAL,R5   SETFREET
         BAL,R12  ACDYN             ACQ COPY DYNAMIC, ZERO ITS REF-CNTS.
         LW,R12   CSYMT
         STW,R12  SYMT              MAKE CURRENT SYM TBL MATCH COPY'S.
         LW,R12   IDBUF+1
         STW,R12  SYMTSIZE
         AW,R12   SYMTSIZE
         STW,R12  NSYMTWDS
         LI,R8    0                 PREPARE TO READ ACTIVE NAME RECORDS.
         STW,R8   NAMERKEY
         LI,R14   FG1               GO TO FG1 AFTER
         B        WINDRD              READING 1ST ACTIVE NAME WD.
FG2      STB,R3   NAMEWDS           SAVE WORD COUNT.
         LI,R9    X'FFF00'          EXTRACT GR, PF, AND A-BITS.
         AND,R9   R3
         LB,R8    NAMEWDS
         LI,R4    NAMEBUF
         BAL,R14  WINDI             MOVE NAME WORDS
         STW,R3   0,R4                INTO NAMEBUF.
         AI,R4    1
         BDR,R8   WINDI
         LI,R4    NAMEBUF
         LB,R3    NAMEWDS
         BAL,R14  SEEKN           @ SEEK NAME IN COPY SYM TBL...
         B        FG              @   NOT FOUND.
         STS,R9   0,R6            @   FOUND, SET GR,PF,A-BITS THERE.
         MTB,-1   NAMEWDS           LONG OR SHORT NAME...
         BEZ      FG                  SHORT.
         LW,R4    1,R6                LONG, BUMP REF-COUNT OF COPY'S
         MTW,1    -1,R4                 LONG NAME DATA BLK.
FG       BAL,R14  WINDI             GET NEXT WINDOW WD.
FG1      BGZ      FG2               LOOP UNLESS END-WORD (WHICH = -1).
         BAL,R14  NAMEL             PROCESS COPY CMND'S NAME-LIST.
DCOPY    LW,R9    BITPOS-6    R9  =  X-BIT (EXAMINED).
         LW,R13   BITPOS-4    R13 =  L-BIT (LOCAL NAME).
         LW,R10   BITPOS-3    R10 =  A-BIT (ACCOUNTED FOR IN ACTIVE).
         LW,R11   BITPOS-7    R11 =  N-BIT (NAME OF INTEREST).
DB       LW,R8    IDBUF+1           GET COPY SYM TBL SIZE.
         STW,R8   BACKUP            PRESET BACKUP FLAG NON-ZERO.
         LW,R1    CSYMT             PT AT 1ST COPY SYM TBL ENTRY.
DC       LB,R2   *R1
         AND,R2   THREE             GET X & N BITS:
         B        DCV,R2                -   -
DCV      B        DD              @     0   0
         B        DE              @     0   1  -- NEEDS EXAMINATION.
         B        DD              @     1   0
DD       AI,R1    2               @     1   1
         BDR,R8   DC                LOOP TILL COPY SYM TBL SCANNED.
         LW,R2    BACKUP            IS ANOTHER SCAN NEEDED...
         BEZ      DB                  YES.
         B        ZAP                 NO, GO TO ZAP WITH R1 POINTING AT
*                                          THE FIRST DATA BLK IN COPY.
DE       STS,R9   0,R1              SET THE X-BIT NOW.
         LW,R4    0,R1              GET THE REF-INDICATOR WD.
         CW,R4    BITPOS-1          DOES THIS NAME HAVE ACTIVE GLOBALREF
         BAZ      DF                  NO.
         CW,R9    PCOPYFLG          IS THIS A PCOPY...
         BANZ     DE6                 YES, DON'T CLOBBER THE ACTIVE REF.
         CW,R4    BITPOS-2          IS ACTIVE GLOBAL REF A PENDENT FUN.
         BAZ      DF                  NO.
         AND,R4   X1FFFF              YES, IS THERE A COPY REFERENT...
         BEZ      DF1                   NO SWEAT.
         LCI      13                    YES, SAVE A BUNCH OF REGS,
         STM,R1   GARBSAVE+1
         LW,R2    1,R1              LOOK AT COPY'S NAME-INDIC WD.
         LB,R3    R2
         AI,R3    -X'40'            IS IT AN ACTIVE NAME PTR TYPE...
         BNEZ     NOTCOPYD            NO, R1 PTS 1 WD BEFORE NAME-INDIC.
         INT,R1   1,R1                YES, GET ACTIVE NAME PTR.
         B        ERNOTCPY          DISPLAY -- NAME NOT COPIED.
NOTCOPYD SW,R1    SYMT              GET NAME PTR (SYMT = CSYMT).
         B        ERNOTCPY          DISPLAY -- NAME NOT COPIED.
RNOTCPY  LCI      13
         LM,R1    GARBSAVE+1        AND RESTORE THE REGS.
DE6      BAL,R14  NBITOFF           TURN OFF N-BIT SO WON'T COPY REF.
DF       AND,R4   X1FFFF            IS THERE A COPY REFERENT...
         BNEZ     DG                  YES.
DF1      LI,R14   DD                RESUME SCAN AFTER TURNING N-BIT OFF.
NBITOFF  LW,R2    NOTNBIT           GET ALL BUT N-BIT.
         AND,R2   0,R1              EXTRACT FROM COPY REF-INDIC WD.
         STW,R2   0,R1              RESTORE ALL BUT N-BIT WHICH = ZERO.
         B       *R14               EXIT.
DG       LB,R2   *R4                GET TYPE OF REFERENT:
         CI,R2    TYPELIST
         BL       DG1                 (LOGL,TEXT,INTG,REAL,XSEQ)
         BE       DG2                 (LIST)
         CLM,R2   FUNTYPES
         BCR,9    DG4                 (DEFINED FUNCTION)
         CI,R2    TYPEGRP
         BE       DG3                 (GROUP)
DG1      CW,R11   0,R1                (OTHER) IS ITEM TO BE COPIED...
         BAZ      DD                NO (PCOPY OR PENDENT CONFLICT).
         LI,R14   DD                RESUME SCAN AFTER
         B        GNP                   DOING GLOBAL NAME PROCEDURE.
DG2      CW,R11   0,R1              WILL WE COPY THIS LIST...
         BAZ      DD                  NO, MOVE OUT QUICKLY.
         BAL,R14  GNP                 YES, DO GLOBAL NAME PROCEDURE.
DG2A     AI,R4    LISTLOFF          PT AT LENGTH WD OF LIST.
         LW,R7    0,R4              GET LENGTH...
         BEZ      DG2D                EMPTY.
DG2B     AI,R4    1                 PT AT PTR WD IN LIST.
         LW,R3    0,R4              GET THAT PTR...
         BEZ      DG2C                NIL.
         MTW,1    1,R3                OK, BUMP THAT DATA BLK'S REF-COUNT
         CB,R2   *R3                IS IT TOO A LIST...
         BNE      DG2C                NO.
         LW,R5    LISTLOFF,R3         YES, GET ITS LENGTH.
         AW,R3    R5
         STW,R4   LISTLOFF+1,R3     SET CHAIN = LOC OF PTR TO SUB-LIST.
         SLS,R7   17
         STS,R7   LISTLOFF+1,R3     PUT LENGTH VALUE OF HOST IN CHAIN WD
         LW,R4    0,R4              PT AT SUB-LIST DATA BLK HDR.
         B        DG2A
DG2C     BDR,R7   DG2B              LOOP TILL DONE WITH LIST'S PTR WDS.
DG2D     AI,R4    1                 PT AT THIS LIST'S CHAIN WD.
         LI,R7    0
         XW,R7    0,R4              CLEAR & GET IT...
         BEZ      DD                  THAT'S ALL FOLKS.
         LI,R4    X'1FFFF'            RESTORE HOST'S PTR.
         AND,R4   R7
         SLS,R7   -17               RESTORE HOST'S LENGTH VALUE.
         B        DG2C
DG3      CW,R11   0,R1              IS GROUP DEFN TO BE COPIED...
         BAZ      DG3L                NO, BUT GROUP'S REFS. MAY BE.
         BAL,R14  GNP                 YES, DO GLOBAL NAME PROCEDURE.
DG3L     AI,R4    2                 PT AT GROUP'S LENGTH WD.
         LH,R7   *R4                GET ITS LENGTH...
         BEZ      DD                  EMPTY.
         SLS,R4   1                 USE HALFWD RESOLUTION.
DG3A     AI,R4    1
         LH,R6    0,R4              GET COPY NAME PTR.
         AW,R6    CSYMT             PT AT COPY SYM TBL REF-INDIC. WD.
         CW,R9    0,R6              HAS THAT NAME BEEN EXAMINED YET...
         BANZ     DG3B                YES.
         STS,R11  0,R6                NO, SET ITS N-BIT.
         CW,R6    R1                WILL IT BE NECESSARY TO BACK UP...
         BGE      DG3B                NO, IT WILL APPEAR ON THIS SCAN.
         LI,R5    0                   YES, WE WILL NEED ANOTHER SCAN.
         STW,R5   BACKUP
DG3B     BAL,R14  LNP6            @ DO LOCAL NAME PROCEDURE.
         STH,R6   0,R4            @ REPLACE COPY NAME PTR BY ACTIVE.
         BDR,R7   DG3A            @ LOOP TILL DONE.
         B        DD
DG4      CW,R11   0,R1              WILL WE COPY THIS FUNCTION...
         BAZ      DD                  NO.
         BAL,R14  GNP                   (DO GLOBAL NAME PROCEDURE)
         STW,R1   COPYSAVE            YES, SAVE MASTER PTR.
         LW,R7    XSIZOFF,R4        GET FUNDEF'S XSIZE WD.
         CI,R7    X'E0000'          DOES IT PT AT ERR-CTRL TBL...
         BAZ      DG4HDR              NO.
         MTW,1    1,R7                YES, BUMP REF-CNT OF ERR-CTRL DB.
DG4HDR   LW,R1    R4                MAKE R1 PT AT FUNDEF DATA BLK.
         BAL,R12  HNP               DO HEADER NAME PROCEDURE.
         STW,R1   COPYSAVE+1        SAVE PTR TO FUNDEF'S LENGTH WD, AND
         LW,R7    0,R1                GET NO.OF FUNCTION LINES...
         BEZ      DG4B                  NONE.
DG4A     LW,R1   *COPYSAVE+1,R7     GET A CODESTRING PTR.
         MTW,1    -1,R1             BUMP CODESTR.DATA BLKS REF-COUNT.
         LW,R12   -1,R1             TEST THAT REF-COUNT...              U16-0025
         AI,R12   -1                  IF NOT 1, THIS CS HAS ALREADY HAD U16-0026
         BNEZ     DG4A2                 ITS NAME PTRS ADJUSTED.         U16-0027
         BAL,R12  CSNP                DO CODESTRING NAME PROCEDURE.     U16-0028
DG4A2    BDR,R7   DG4A              LOOP TILL DONE WITH CS PTRS.        U16-0029
DG4B     LW,R1    COPYSAVE          RESTORE MASTER PTR.
         LW,R4    COPYSAVE+1        PT AT FUNDEF'S LENGTH WD AGAIN.
         AW,R4    0,R4              PT AT LAST CODESTRING PTR WD.
         LW,R7    1,R4              GET NO.OF LOCALS & LABELS...
         BEZ      DD                  NONE.
         STW,R7   NAMEWDS             SAVE FOR LOCALS.
         AND,R7   XFFFF             EXTRACT NO.OF LABELS...
         BEZ      DG4LCLS             NONE.
DG4LBL   AI,R4    2                 PT AT LABEL ENTRY.
         LW,R5    1,R4              GET PTR TO LABEL'S DATA BLK, AND
         MTW,1    1,R5                BUMP ITS REF-COUNT.
         LW,R6    0,R4              GET COPY NAME PTR FOR THE LABEL.
         BAL,R14  LNP             @ DO LOCAL NAME PROCEDURE.
         STW,R6   0,R4            @ REPLACE COPY NAME PTR BY ACTIVE.
         BDR,R7   DG4LBL          @
DG4LCLS  LH,R7    NAMEWDS           GET NO.OF LOCALS.
         BEZ      DD                  NONE.
         AI,R4    2
         SLS,R4   1                 PT AT 1ST LOCAL NAME PTR (HALFWD).
DG4LCL   LH,R6    0,R4              GET COPY NAME PTR FOR THE LOCAL.
         BAL,R14  LNP             @ DO LOCAL NAME PROCEDURE.
         STH,R6   0,R4            @ REPLACE COPY NAME PTR BY ACTIVE.
         AI,R4    1               @ PT AT NEXT HALFWD.
         BDR,R7   DG4LCL            LOOP TILL DONE.
         B        DD
ZAP      LW,R2    1,R1              CK REF-COUNT OF DATA BLK...
         BNEZ     ZAPUP               NON-ZERO, DATA BLK TO BE COPIED.
         STB,R2  *R1                  0 (DON'T COPY), CHANGE ITS TYPE TO
*                                       BE A FREE BLK SO ANY INTERNAL
*                                       PTRS WILL BE DISREGARDED.  THIS
*                                       PREVENTS CONFUSION DURING ANY
*                                       GARBAGE COLLECTION PROCESS.
ZAPUP    INT,R7   0,R1              GET SIZE OF THIS BLK.
         AW,R1    R7                PT TO NEXT BLK,
         CW,R1    DYNBOUND            IF ANY...
         BL       ZAP                   YES.
         LI,R2    0                     NO, DO SOME REGISTER SET-UPS.
         LI,R4    0
         LI,R5    X'1FFFF'
         LW,R1    CSYMT                    (PT AT COPY SYM TBL)
         LW,R8    IDBUF+1                  (GET NO.OF ENTRIES IN IT)
         LW,R14   CORVSFIL          IS THIS A CORE-COPY OR FILE-COPY...
         BEZ      CD                  CORE-COPY.
*                                     FILE-COPY.
         AI,R1    1                 PT AT 1ST NAME-INDIC WD.
FK1      CW,R11   -1,R1             IS N-BIT SET...
         BAZ      FK3                 NO, DON'T COPY A REFERENT.
         LS,R4    -1,R1               YES, REMOVE EXTRANEOUS BITS,
         STW,R4   -1,R1                 KEEPING THE REF-PTR.
         B        FK4
FK3      CW,R13   -1,R1             IS L-BIT SET...
         STW,R2   -1,R1               (CLEAR REF-INDICATOR WD NOW)
         BANZ     FK4                 YES, KEEP THE NAME-INDICATOR.
         LB,R14  *R1                  NO, GET BYTE 0 OF NAME-INDIC.
         BEZ      FK4                   UNUSED ENTRY.
         AI,R14   -20               LONG OR SHORT NAME...
         BGZ      FK3NIX                SHORT.
         LW,R7    0,R1                  LONG, PT AT IT.
         STW,R2   -1,R7             ZERO THE REF-COUNT OF LONG NAME DATA
*                                     BLK, SO IT WON'T BE COPIED.
FK3NIX   STW,R2   0,R1              CLEAR THE NAME-INDICATOR.
FK4      AI,R1    2                 PT AT NEXT NAME-INDIC WD,
         BDR,R8   FK1                 IF ANY, LOOPING BACK.
         AI,R1    -1                PT AT 1ST DATA OR FREE BLK.
         STW,R8   NAMERKEY          ZERO THE KEY FOR WRITING COPY RECDS.
         LW,R3    DYNBOUND
         STW,R3   FREETBL           CLAIM ALL OF
         STW,R8   FREETBL+1           COPY DYNAMIC IS
         STW,R8   FREETOTL              ALLOCATED, AT PRESENT.
         BAL,R8   KRUNCH            FREE UNWANTED BLKS, COALESCING THE
*                                     BLKS TO BE COPIED INTO A SINGLE
*                                       COPY DATA REGION
*                                         (FOLLOWS THE COPY SYM TBL).
         LW,R1    CSYMT             PT AT COPY SYM TBL & GET ITS SIZE;
         LW,R8    IDBUF+1             WE WILL WRITE COPY NAME RECORDS.
         LI,R2    -511              SET INIT. OFFSET INTO WINDOW.
FN2      LW,R3    1,R1              GET NAME-INDICATOR WD.
         BEZ      FN3                 NAME OF NO INTEREST.
         BAL,R14  WINDO             PUT IT IN WINDOW.
         LI,R13   0                 CLEAR W-FLAG.
         LB,R12   R3                IS THIS A LONG OR SHORT NAME...
         CI,R12   20
         BG       FN2E                SHORT, NAME WAS IN NAME-INDIC WD.
         LI,R13   X'40000'            LONG, SET W-FLAG = W-BIT.
         BAL,R14  WINDON12          MOVE THE NAME WORDS INTO WINDOW.
FN2E     LW,R3    R1
         SW,R3    CSYMT             CALCULATE THE ODD COPY NAME PTR.
         AI,R3    2
         SLS,R3   19
         OR,R3    R13               MERGE IN W-FLAG.
         OR,R3    0,R1              MERGE REF-PTR, IF ANY.
         LW,R14   0,R1              TEST FOR REF-PTR...
         BEZ      FN2F                NO.
         OR,R3    BITPOS-12           YES, MERGE R-BIT.
FN2F     BAL,R14  WINDO             PUT REF-INDIC ETC IN THE WINDOW.
FN3      AI,R1    2                 PT AT NEXT ENTRY.
         BDR,R8   FN2               LOOP TILL DONE.
         STW,R1   COPYBASE          SAVE LOC OF 1ST WD OF COPY DATA REG.
         LI,R3    -1                END THE COPY NAME RECORDS.
         STW,R3   WINDOW+511,R2
         BAL,R14  WRNAMER           WRITE THE LAST PHYSICAL RECORD.
         LW,R14   FREETBL
         SW,R14   COPYBASE          CALC. SIZE OF COPY DATA REGION.
         STW,R14  COPYSIZE
         BAL,R14  WRCOPYDR          WRITE THE COPY DATA REGION.
         BAL,R14  RDACTIV           READ IN THE ACTIVE WS AGAIN.
         LI,R14   0                 SET TO READ 1ST COPY NAME RECORD.
         STW,R14  NAMERKEY
         LI,R14   FP1               GO TO FP1 AFTER
         B        WINDRD              READING THE 1ST WORD.
FP2      STW,R3   COPYSAVE          SAVE COPY NAME-INDIC.
         LB,R7    COPYSAVE          GET BYTE 0 OF IT.
         CI,R7    20                LONG OR SHORT NAME...
         BG       FP2S                SHORT (NAME IS IN R3).
         LI,R1    IMAGE               LONG, SET TO MOVE IT INTO IMAGE.
         BAL,R14  WINDI             GET 1ST NAME WORD.
         STW,R3   0,R1              PUT NAME WORD IN IMAGE.
         AI,R1    1                 PT AT NEXT WD IN IMAGE.
         BDR,R7   WINDI             LOOP TILL NAME HAS BEEN MOVED.
         B        FP3
FP2S     STW,R3   IMAGE             PUT THE NAME IN IMAGE.
         LI,R1    IMAGE+1           PT AT NEXT WD IN IMAGE.
FP3      LI,R3    ','               TERMINATE THE NAME WITH A COMMA.
         STB,R3  *R1
         BAL,R14  WINDI             GET COPY REF-INDIC, ETC.
         STD,R2   COPYSAVE+2        SAVE IT & WINDOW OFFSET.
         LI,R1    BA(IMAGE)         PT AT 1ST CHAR OF NAME.
         BAL,R4   ACQCC             ACQ CHAR & CODE.
         BAL,R8   FINDNAME        @ FIND NAME IN ACTIVE SYM TBL...
         B        FP8             @   FRESH NAME.
         LW,R2    BITPOS-12       @   ACTIVE NAME.
         CW,R2    COPYSAVE+3        DOES COPY NAME HAVE A REFERENT...
         BAZ      FP5                 NO, LEAVE ACTIVE REF ALONE.
         LI,R2    0                   YES.
         LI,R3    X'1FFFF'
         LI,R4    0                 DO REG. SET-UPS.
         LI,R5    X'1FFFF'
         BAL,R7   UNREF             REMOVE ACTIVE REFERENT, IF ANY.
FP5      LB,R7    COPYSAVE
         AI,R7    -20               LONG OR SHORT NAME...
         BGZ      FP9                 SHORT.
         AI,R6    1                 PT TO NAME-INDICATOR OF SYM TBL ENT.
         LI,R4    0                 CLEAR AND GET
         XW,R4   *SYMT,R6             LONG NAME PTR (ACTIVE ONE).
         AI,R4    -2                PT AT ITS DATA BLK HDR.  GET RID OF
         BAL,R7   DREF                THAT ONE, WE'LL USE COPIED ONE.
FP8      AI,R6    -1                PT TO REF-INDIC WD OF SYM TBL ENTRY.
FP9      AW,R6    SYMT              PT AT THAT WD DIRECTLY.
         LD,R2    COPYSAVE+2        RESTORE OFFSET & COPY REF-INDIC.
         STS,R3   0,R6              MERGE INTO REF-INDIC OF SYM TBL:
*                                     THE ODD COPY NAME PTR (BITS 1-11),
*                                     THE R-BIT VALUE (BIT 12),
*                                     THE W-BIT VALUE (BIT 13), AND
*                                     THE COPY REF-PTR (BITS 15-31).
         LW,R8    COPYSAVE          REPLACE ACTIVE NAME-INDICATOR WD BY
         STW,R8   1,R6                COPY'S NAME-INDIC.
         BAL,R14  WINDI             READ NEXT WORD IN COPY NAME RECORD.
FP1      CI,R3    -1                IS THAT THE END-WORD...
         BNE      FP2                 NO -- A COPY NAME-INDICATOR.
         BAL,R8   GARBCOLL            YES, GARBAGE COLLECT ANY FREED
         LW,R11   COPYSIZE                 BLOCKS.
         BEZ      NOCOPY              (OOPS, NOTHING TO COPY)
         AI,R11   -2                HDR IS UNNEC.
         BAL,R14  ALOCNONX        @ ALLOCATE SPACE FOR COPY DATA REGION.
         B        TOOBIG          @   WS FULL -- TOO BIG.
         STW,R4   COPYHOME        @   OK, SAVE LOC TO GET 1ST COPIED WD.
         BAL,R14  RDCOPYDR          READ COPY DATA REGION & CLOSE TEMP
         LW,R9    COPYHOME            FILE.  CALC. DISPLACEMENT OF COPY
         SW,R9    COPYBASE          LOCATIONS INTO ACTIVE LOCS.
         STW,R9   DISPLAC
         LW,R12   FREETOTL          GET SIZE OF FREE BLK AFTER COPY D.R.
         BEZ      FQ                  NONE.
         STW,R12 *FREETBL           SET FREE BLK HDR, TYPE=0, SIZE=TOTAL
FQ       LW,R1    COPYHOME          PT AT 1ST COPIED DATA BLK.
         BAL,R12  RLOC              CORRECT COPIED DATA BLK PTRS &
*                                     NAME PTRS IN THE COPY DATA REGION.
         LI,R14   CI                GO TO CI TO FINISH UP AFTER
         B        XDACT               REMOVING EXTRANEOUS BITS AND
*                                       DISPLACING COPY REF-PTRS &
*                                         LONG-NAME PTRS IN THE SYM TBL.
NOCOPY   LI,R5    F:TF              NO COPY, CLOSE TEMP FILE AND
         LI,R6    CI                  GO TO CI FOR WRAP UP.
         B        CLOSR
TOOBIG   LI,R8    IDTOOBIG          = ERROR I.D. FOR 'TOO BIG'.
         STW,R8   ERRORID
         B        ABORTFIL          ABORT THE FILE-COPY ATTEMPT.
2MANYSYM LI,R8    ID2NAMEY          = ERROR I.D. FOR 'TOO MANY SYMBOLS'.
         STW,R8   ERRORID
ABORTCPY LW,R14   CORVSFIL          ABORT CORE-COPY OR FILE-COPY...
         BNEZ     ABORTFIL            FILE-COPY.
         LI,R10   X'40000'            CORE-COPY, GET W-BIT,
         LI,R9    X'C0000'              AND ITS NEGATIVE.
         LW,R1    SYMT              WE HAVE TO DELETE ANY NEW NAMES IN
         LW,R8    SYMTSIZE            THE ACTIVE SYM TBL + ANY W-BITS.
ABORT1   CW,R10   0,R1              IS THIS A NEW ENTRY...
         BAZ      ABORT2              NO.
         AWM,R9   0,R1                YES, SUBTRACT OUT THE W-BIT.
         STW,R14  1,R1              ZERO THE NAME-INDICATOR WD.
ABORT2   AI,R1    2                 PT AT NEXT SYM TBL ENTRY, LOOP IF
         BDR,R8   ABORT1              ANY.  NOTE THAT THE COPIED DYNAMIC
*                                       AREA WILL DISAPPEAR AUTOMATICALY
*                                         SINCE IT WAS DECLARED FREE.
ABORTOUT BAL,R14  XWLOCGLB          RE-EXCHANGE LOCALS & GLOBALS.
         LW,R8    ERRORID           GET ERROR I.D.
         B        CMDERR            COMMAND ERROR EXIT.
ABORTFIL BAL,R14  RDACTIV           READ IN THE ACTIVE WS AGAIN.
         LI,R5    F:TF
         LI,R6    ABORTOUT          GO TO ABORTOUT AFTER
         B        CLOSR               CLOSE & RELEASE OF TEMP FILE.
 PAGE
************************************************************************
 SPACE 2
Z        SET      %-WSCOPY@         SIZE OF WSCOPY IN HEX.
 SPACE 1
Z        SET      Z+Z/10*6+Z/100*96+Z/1000*1536  SIZE IN DECIMAL.
 SPACE 3
         END

