****************************************************************
*M*      DEFCOM   EXTRACTS THE DEFS FROM A LOAD MODULE
****************************************************************
*P*      NAME:    DEFCOM
*P*      PURPOSE: DEFCOM PROVIDES A MEANS OF ACCESSING CORE RESIDENT
*P*               DATA AND ROUTINES IN ONE LOAD MODULE FROM ANOTHER
*P*               LOAD MODULE.
*P*      DESCRIPTION: DEFCOM TAKES A SPECIFIED LOAD MODULE AS INPUT
*P*               AND PRODUCES ANOTHER LOAD MODULE THAT CONTAINS
*P*               ONLY THE DEFS AND THEIR VALUES. THIS LOAD MODULE
*P*               CAN THEN BE COMBINED INTO OTHER LOAD MODULES TO
*P*               GIVE THEM ACCESS TO CORE RESIDENT DATA AND ROUTINES,
*P*               AS IN THE CASE OF CORE LIBRARIES AND COMMON DATA
*P*               POOLS.
*P*      REFERENCE: DEFCOM IS DESCRIBED IN THE CP-V BATCH PROCESSING
*P*               REFERENCE MANUAL, 901764.
*******************************************************************
         SYSTEM   SIG7
         SYSTEM   BPM
         DEF      DEFCM,PATCH
         REF      M:EI,M:EO,M:DO
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
DEFCM    EQU      %
HEAD     RES      12
         DATA     0
TREE     RES      11
TREEADR  DATA     0
BUFSZ    DATA     0
RFDFADR  DATA     0
#SEGS    DATA     0
SEQNAME  DATA,16  0                 RFDFSTK KEY
DUMDEF   DATA     X'04100000'       TYPE
         DATA     0                 VALUE AT BYTE RESOLUTION
         DATA     X'01000000'       RESOLUTION
         TEXTC    ':PN'             NAME
RFDFMAX  DATA     0                 UPPER LIMIT OF RFDFSTK
TX:PNDAT TEXTC    ':PNDATA'
TXHEAD   TEXTC    'HEAD'
TXTREE   TEXTC    'TREE'
TXM:MON  TEXTC    'M:MON'
TXUMOV   TEXTC    'UMOV'
XF0000   DATA     X'F0000'
X100001  DATA     X'100001'
DEFCOM   EQU      %
         M:OPEN   M:EO,(KEYED),(DIRECT),(KEYM,11)
         M:READ   M:EI,(BUF,HEAD),(SIZE,48),(WAIT),(KEY,TXHEAD)
         LI,R1    X'83'
         STB,R1   HEAD
         M:GP     1
         BCS,8    NOMEM
         STW,SR2  TREEADR
         M:READ   M:EI,(BUF,*SR2),(SIZE,2048),(KEY,TXTREE),WAIT
         LCI      12
         LM,1     *TREEADR
         STM,1    TREE-1
         MTW,1    TREEADR
         LI,R1    12                CHANGE SIZE OF TREE TO 12 WDS
         STW,R1   HEAD+5            SET TREE SIZE INHEAD
         XW,R1    TREE-1
         MI,1     X'10000'/11       GET # SEGS IN HW0
         STW,R1   #SEGS
         M:GP     1
         BCS,8    NOMEM
         STW,SR2  RFDFADR
         STW,SR1  BUFSZ
         LW,R7    SR2
         LW,R2    TX:PNDAT          GOING TO A :PNDATA CORE LIBRARY
         LW,R3    =X'FFFFFF00'
         CS,R2    M:EO+23
         BNE      DEFCOM3           NO
         LW,R2    TX:PNDAT+1
         CW,R2    M:EO+24
         BNE      DEFCOM3           NO
         LCI      4
         LM,R2    DUMDEF
         STM,R2   *R7               PUT :PN DEF ENTRY IN RFDFSTK
         LI,R3    3
         LB,R2    M:EO+23,R3        N FROM :PNDATA
         LI,R3    15
         STB,R2   *R7,R3            INTO DEF ENTRY
         LW,R2    TREE+5            DATA SIZE
         SLS,R2   -16
         SLS,R2   3                 IN BYTES
         STW,R2   1,R7              PUT DATA SIZE INTO :PN DEF
         STW,R2   HEAD+7            AND IN HEAD
         AI,R7    4                 MAKE ROOM FOR :PN DEF ENTRY
DEFCOM3  RES
         LI,R4    0
         STW,R4   HEAD+7            ZAP DELTA SYMBOL TABLE
         STW,R4   TREE+4            ZAP FLINK IN TREE
         STH,R4   TREE+5            00 SIZE 0
         STH,R4   TREE+7            01 SIZE 0
         STH,R4   TREE+8            EXP SIZE 0
         STH,R4   TREE+9            10 SIZE 0
DEFCOMLP LW,R1    TREEADR           ADDRESS OF TREE SEGMENT
         LW,R1    6,R1              RDFDD SIZE
         SLS,R1   -16
         AW,R1    R7
         STW,R1   RFDFMAX
         SW,R1    RFDFADR
         AI,R1    X'1FF'
         SLS,R1   -9
         SW,R1    BUFSZ
         BLEZ     %+4
         M:GP     *R1
         BCS,8    NOMEM
         AWM,SR1  BUFSZ
         LW,R1    RFDFMAX           CALCULATE RECORD SIZE
         SW,R1    R7
         SLS,R1   2
         MTB,1    *TREEADR
         LB,R2    *TREEADR          GEN RFDF KEY
         STB,R4   *TREEADR,R2
         M:READ   M:EI,(BUF,*R7),(SIZE,*R1),(KEY,*TREEADR),WAIT
         LI,R2    0
         LW,R1    R7                SET INPUT POINTER
         LW,R3    XF0000
         LW,R5    X100001
         LW,SR1   DUMDEF+3          03:PN
         LW,SR2   =X'FFFFFF00'
DEFCOM2  LS,R2    0,R1              GET TYPE
         CI,R2    X'60000'          IS THIS A CSECT
         BNE      DEFCOM1           NO
         STS,R5   0,R1              YES-SET EVAL BIT
         STH,R4   *R1,R5            SET SIZE AT 0
DEFCOM1  CS,SR1   3,R1              03:PN ENTRY
         BNE      %+3               NO
         LW,R6    1,R1              YES-PUT CORE LIBRARY DATA SIZE
         STW,R6   HEAD+7                IN HEAD+7 (BYTE RESONTION)
         LB,R6    *R1               ADVANCE TO NEXT ENTRY
         AW,R1    R6                ADVANCE TO NEXT ENTRY
         CI,R6    3                 IF NO NAME, SKIP IT
         BE       SKIP
         CI,R2    X'10000'          OR IF SREF
         BE       SKIP
         CI,R2    X'20000'          PREF
         BE       SKIP
         CI,R2    X'50000'          OR FREF
         BE       SKIP
         CI,R2    X'70000'          FREF
         BE       SKIP
         AW,R7    R6
         LCW,R6   R6
         LW,D1    *R1,R6
         STW,D1   *R7,R6
         BIR,R6   %-2
SKIP     RES
         CW,R1    RFDFMAX           LOOKED AT ALL ENTRYS
         BL       DEFCOM2           NO
         LI,R6    11                TO NEXT TREE ENTRY
SKIP2    AWM,R6   TREEADR           INC TO NEXT TREE ENTRY
         MTH,-1   #SEGS             COUNT DOWN NO. OF SEGMENTS
         BLEZ     SKIP3             LAST SEGMENT
         LW,R1    TXM:MON           M:MON LOAD MUDULE
         CW,R1    M:EI+23
         BNE      SKIP1             NO
         LW,R1    TXM:MON+1
         CW,R1    M:EI+24
         BNE      SKIP1             NO
         LW,R1    TXUMOV
         CW,R1    *TREEADR          UMOV OVERLAY
         BNE      SKIP2             NO
         LI,R1    'V'
         LI,R2    4
         CB,R1    *TREEADR,R2       UMOV OVERLAY
         BNE      SKIP2             NO
         B        DEFCOMLP          YES-INCLUDE IN DF STACK
SKIP1    MTH,0    #SEGS             LAST SEGMENT
         B        %+2               NOP FOR ALL SEGS STACK
         BGZ      DEFCOMLP
SKIP3    EQU      %
         SW,R7    RFDFADR           CALCULATE FINAL RFDF SIZE
         STH,R7   HEAD+5
         STH,R7   TREE+6
         SLS,R7   2
         M:WRITE  M:EO,(BUF,HEAD),(SIZE,48),(WAIT),(ONEWKEY),;
                  (KEY,TXHEAD)
         LB,R1    M:EO+23
         STB,R1   SEQNAME
         STB,R1   TREE
         LB,R2    M:EO+23,R1
         STB,R2   SEQNAME,R1
         STB,R2   TREE,R1
         BDR,R1   %-3               COPY OUTPUT NAME TO TREE AND KEY
         MTB,1    SEQNAME
         LB,R2    SEQNAME
         STB,R1   SEQNAME,R2        ZERO TRAILING CHAR FOR RFDFSTK KEY
         M:WRITE  M:EO,(BUF,TREE-1),(SIZE,48),(WAIT),(ONEWKEY),;
                  (KEY,TXTREE)
         M:WRITE  M:EO,(BUF,*RFDFADR),(SIZE,*R7),(KEY,SEQNAME),WAIT,;
                  (ONEWKEY)
         M:CLOSE  M:EI
         M:CLOSE  M:EO,(SAVE)
         CAL1,9   1
*
NOMEM    LB,R1    NOMEMSG           GET SIZE OF MESSAGE
         M:WRITE  M:DO,(BUF,NOMEMSG),(SIZE,*R1),(BTD,1)
         M:XXX
NOMEMSG  TEXTC    'NOT ENOUGH MEMORY TO PROCESS THAT LOAD MODULE'
PATCH    RES      50                PATCH AREA
         END      DEFCOM

