         SYSTEM   SIG7FDP
         SYSTEM   BPM
         REF      FETCHBUF,READSTRG,NOROOM,SYNTAX,COREALLOC,;
                  MODGEN,M:TM,BIG9FLG,WRITELM
         REF      P2ERR
         REF      P2OVLOP
         DEF      FRGD,INTLB
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
DYN      CNAME
         PROC
LF       EQU      %-DYNAM
         GEN,1,15,16 AF(1),AF(2),AF(3)
         PEND
KWDTBL   EQU      %
KWD      COM,32,8,7,17  AF(1),AF(2),AF(3),AF(4)
         KWD      'RESD',1,1,NRESPGS
         KWD      'DYNR',1,1,NPAGES
         KWD      'NINT',1,0,NINTS
LKWDTBL  EQU      %-KWDTBL
         DATA     #DFLTS
KWDPTR   GEN,15,17 LKWDTBL,KWDTBL
DYNAM    EQU      %
NRESPGS  DYN      1,0,0
RESBUFSZ DYN      1,0,0
NPAGES   DYN      1,0,0
NSEGMNTS DYN      1,0,0
NINTS    DYN      1,0,0
#DYNAM   EQU      %-DYNAM
#DFLTS   EQU      %-DYNAM
FOP      COM,1,7,8 AF(1),AF(2),AF(3)
KWDTBL1  EQU      %
         DATA     LKWDTBL1
         FOP      0,0,3             (
         FOP      1,9,11            TEXT
         FOP      0,1,18            STORE
         FOP      1,9,6             COMMA
         FOP      1,9,14            HEX
         FOP      0,1,18            STORE
         FOP      1,9,6             COMMA
         FOP      1,9,14            HEX     (2ND ARG)
         FOP      0,1,18            STORE
         FOP      0,0,8             ),(
         FOP      0,1,1
         FOP      0,0,0
LKWDTBL1 EQU      %-KWDTBL1
         DATA     0
KWDPTR1  GEN,15,17 0,KWDTBL1
DYNAM1   EQU      %
         DATA     0
         DATA     0
#DYNAM1  EQU      %-DYNAM1
         PZE      GOOF3
FRGD     LW,1     FETCHBUF,R3       GET KEYWORD
         CW,R1    FRG               IS IT A DUMMY COMMAND
         BNE      READSTRG          YES
         LW,R1    P2OVLOP,R3
         AI,R1    X'100'            SET RTOV FLAG FOR OVERLAY
         STW,R1   P2OVLOP,R3
         LW,R1    =X'08000001'      GET PAGE FOR PROCESSING INTLB
         CAL1,8   R1
         BCS,8    NOROOM
         STW,SR2  DYNAM1+1
         STW,SR2  BEGIN             SAVE ADD. OF PAGE
         AI,SR2   511
         STW,SR2  DYNAM1            SAVE END OF PAGE
**       START PROCESSING FRGD COMMAND
         LI,2     DYNAM
         LI,1     #DYNAM
         LW,4     KWDPTR
         BAL,SR4  SYNTAX
         LI,D1    -1                CHANGE TO EXPLICIT
         LI,D2    -1
         BAL,SR4  COREALLOC
         CI,8     1
         BAZ      %+2               DOUBLEWORD BOUNDARY?
         AI,8     1
         LW,D1    8                 SAVE LOC.
         AI,SR1   12
         AW,SR1   NSEGMNTS,R5
         BAL,10   MODGEN            ENOUGH ROOM
         TEXTC    'E2'
         LW,8     D1
         TEXTC    'RT:GINTP1'
         AI,8     2
         TEXTC    'RT:GINT23'
         AI,8     1
         LW,1     BIG9FLG,3
         SLS,1    7
         OR,1     BIG9FLG,3
         SLS,1    16
         OR,1     FLGS
         STW,1    *8
         AI,8     1
         TEXTC    'RT:UINTP1'
         AI,8     2
         TEXTC    'RT:UINT23'
         AI,8     1
         STW,1    *8
         LI,D1    12
         TEXTC    'ICBSIZE0'
         AI,8     1
         TEXTC    'ICB1'
         STW,8    1
         LW,D1    NINTS,5
         TEXTC    'NINTS0'
         MTW,0    NINTS,5
         BEZ      NONINTS+1
         MI,D1    22
         LW,D2    8
         AW,8     D1
         TEXTC    'E2'
         B        %+1
         LW,8     D2
         LW,D2    NINTS,5
         AI,D2    -1
         BEZ      NONINTS
         LW,D1    8
         AI,D1    12
         STW,D1   *8
         BAL,10   MODGEN
         TEXTC    '22'
         AI,8     12
         BDR,D2   %-5
NONINTS  AI,8     12
         B        %+1
         BAL,10   MODGEN
         TEXTC    'LASTICB1'
         TEXTC    'RTICBHDR1'
         LW,D1    NINTS,5
         BEZ      NONIN1
         STW,1    *8
         TEXTC    '22'
         B        %+1
NONIN1   BAL,10   MODGEN
         AI,8     1
         TEXTC    'RESDF1'
         LW,D1    NRESPGS,R5
         STW,D1   *8
         LW,D1    RESBUFSZ,R5
         TEXTC    'RESDF1'
         AI,SR1   1
         STW,D1   *SR1
         TEXTC    'RESDFP1'
         AI,SR1   1
         STW,SR1  SAVDYNAD
         TEXTC    'DYNRESDF1'
         AI,SR1   1
         LW,D1    NPAGES,R5
         STW,D1   *SR1
         TEXTC    'MDYNRESDF1'
         AI,SR1   1
         TEXTC    'PPTABLE1'
         LW,D1    NSEGMNTS,R5
         AI,D1    1
         TEXTC    'PPTABLSZ0'
         AW,SR1   D1
         TEXTC    'PP:UPPH1'
         AI,SR1   1
         TEXTC    'PP:UPPT1'
         AI,SR1   1
         TEXTC    'PP:UPPC1'
         AI,SR1   1
         TEXTC    'RDPPTAB1'
         LI,R1    3                 NEED TO CREATE
         SLS,R1   22                GEN,8,24  3,BA(PPTABDSK)
         AW,R1    SR1
         AI,R1    4
         SLS,R1   2
         STW,R1   *SR1
         AI,SR1   1
         LI,R1    X'2E'             NEED TO CREATE
         SLS,R1   24                GEN,8,24   X'2E',4
         AI,R1    4
         STW,R1   *SR1
         AI,SR1   1
         LI,R1    2
         SLS,R1   22                NEED TO CREATE
         AW,R1    SAVDYNAD          GEN,8,24 2,BA(PPTABLE)
         SLS,R1   2
         STW,R1   *SR1
         AI,SR1   1
         TEXTC    'PPTABSZ1'
         SLS,D1   2                 D1 = PPTABLSZ*4
         AI,D1    16
         STW,D1   *SR1
         AI,SR1   1
         TEXTC    'PPTABDSK1'
         AI,SR1   1
         TEXTC    'PPTABDSK21'
         B        %+1
         AI,8     1
         STW,8    MODEND
         STW,7    PLISTA
         MTW,1    FRGFLG            FRGD ENCOUNTERED
         B        READSTRG
**       ENTRANCE FOR INTLB
INTLB    MTW,0    FRGFLG            W AS THERE A FRGD?
         BEZ      NOFRG             NO
         MTW,0    GOOFLG
         BNEZ     IGNORE
         LI,R1    #DYNAM1
         LI,R2    DYNAM1
         LW,R4    KWDPTR1           SET UP TO GO TO SYNTAX
         BAL,SR4  SYNTAX
         LW,7     PLISTA            RESTORE PLIST POINTER
         LW,8     MODEND            END OF LM
         AI,5     1
         LW,1     *5
         SW,1     BEGIN
         DW,R1    THREE             ENTRY = LABEL,LOC,PRIO
*                                   AFTER DIVISION R1 = # OF ENTRIES
         LI,6     0
         LI,2     0
         LI,4     1
         LW,D2    1
         BEZ      LOCS1+3           NO ENTRIES
LOCS     LW,D1    *BEGIN,4          IS LOC LEGAL
         CLM,D1   FIRST
         BCR,9    LOCS1
         CLM,D1   SECOND
         BCR,9    LOCS1
         CLM,D1   THIRD
         BCS,9    SIZERR
LOCS1    AI,R4    3                 STEP OVER LABEL AND PRIO
         BDR,D2   LOCS
         SW,1     6                 1=# GOOD ENTRIES
         LW,11    8
         LW,D4    R1                SAVE # OF ENTRIES
         AW,SR1   R1
         AW,SR1   R1
         AI,8     2
         BAL,10   MODGEN
         TEXTC    'E2'              ENOUGH SPACE
         LW,8     11
         TEXTC    'INTLB11'
         B        %+1
         LW,6     1                 SAVE ENTRIES
         LW,2     1
         AI,2     2
         SLS,2    -1                HOW MANY WORDS
         AW,8     2
         BAL,10   MODGEN
         TEXTC    'INTLB21'
         LW,SR2   SR1               SAVE POINTER
         AW,SR1   R2
         LW,R2    R1
         AI,R2    4
         SLS,R2   -2                HOW MANY WORDS
         TEXTC    'INTLB31'
         B        %+1
         CI,1     0
         BE       NOPE              NO ENTRIES
         LI,4     0
         LI,5     1
LOOP     LCI      3
         LM,D1    *BEGIN,R4
         CI,D1    0
         BE       LOOPNUL
         SAS,D1   -16               JUSTIFY IT
         STH,D1   *SR4,R5           STORE LABEL
         STH,D2   *SR2,R5           STORE LOCATION
         STB,D3   *SR1,R5           STORE PRIORITY
         AI,R5    1
LOOPNUL  AI,R4    3
         BDR,D4   LOOP
NOPE     LW,D1    6
         AI,D1    1
         AW,8     2
         BAL,10   MODGEN
         TEXTC    'INTLBSIZ0'
GOOF3    B        %+1
         LI,D3    FILENAM
         BAL,SR4  WRITELM
         CI,8     -1
         BE       RECOV
         M:OPEN   M:TM,(FILE,'SPEC:HAND'),(KEYED),(INOUT),;
                  (SAVE),(ERR,NOH),(ABN,NOH)
         M:READ   M:TM,(BUF,*BEGIN),(SIZE,2044),(KEY,HAND),;
                  (ERR,NOH),(ABN,NOH)
         LW,1     13+M:TM
         SLS,1    -3
         LD,14    NAME
         STD,14   *BEGIN,1
         MTW,1    *BEGIN
         AI,1     1
         SLS,1    3
         M:WRITE  M:TM,(BUF,*BEGIN),(SIZE,*1),(KEY,HAND),;
                  (ERR,NOH),(ABN,NOH)
         M:CLOSE  M:TM,(SAVE)
RECOV    EQU      %
         LW,R1    =X'09000001'
         CAL1,8   R1                FREE PAGE
         LI,D1    -#DYNAM1
         MSP,D1   *R0
         MTW,1    GOOFLG
         LI,D1    -#DYNAM           RELEASE STACK LOC.'S OCCUPIED BY
         MSP,D1   *R0               FRGD TEMP LOCATIONS
         B        READSTRG
SIZERR   AI,4     -1
         LW,15    *BEGIN,4
         SAS,15   -16
         STH,15   ERRMESS+1
         M:PRINT  (MESS,ERRMESS)
         MTW,1    P2ERR,R3
         STW,2    *BEGIN,4
         AI,4     1
         AI,6     1
         B        LOCS1
         PZE      GOOF2
NOFRG    LW,1     FETCHBUF,R3       WAS IT A REAL INTBL
         CW,1     INT
         BE       ERROR1            YEW
         LI,D1    -1                NO
         LI,D2    -1
         BAL,SR4  COREALLOC         GET ROOM
         BAL,10   MODGEN
         TEXTC    'RTICBHDR1'
         LI,1     -1
         STW,1    *8
         AI,8     1
GOOF2    B        %+1
         LI,D3    FILENAM
         BAL,SR4  WRITELM
         B        READSTRG
NOH      LW,14    =X'200000'
         CW,14    M:TM
         BAZ      %+2
         M:CLOSE  M:TM,(SAVE)
         M:PRINT  (MESS,SPECMES)
         MTW,1    P2ERR,R3
         B        RECOV
ERROR1   M:PRINT  (MESS,ERRMESS1)
         MTW,1    P2ERR,R3
         B        NOFRG+3
IGNORE   M:PRINT  (MESS,IGMESS)
         MTW,1    P2ERR,R3
         B        READSTRG
IGMESS   TEXTC    '***NO CORE FOR FRGD, INTLB IGNORED'
ERRMESS  TEXTC    '***   LABEL HAS ILLEGAL VALUE. IGNORED'
ERRMESS1 TEXTC    '*** INTLB WITHOUT FRGD. OPTION IGNORED'
HAND     TEXTC    'HANDLERS'
SPECMES  TEXTC    '***TROUBLE WITH SPEC:HAND--RTROOT   NOT INCLUDED'
         BOUND    8
NAME     TEXTC    'RTROOT'
FRG      TEXT     'FRGD'
INT      TEXT     'INTL'
SAVDYNAD DATA     0
MODEND   RES      1
PLISTA   RES      1
FRGFLG   DATA     0
BEGIN    DATA     0
FLGS     DATA     X'17000000'
         BOUND    8
FIRST    DATA     X'58',X'59'
SECOND   DATA     X'60',X'13F'
THIRD    DATA     X'1000',X'7FFF'
GOOFLG   DATA     0
FILENAM  TEXTC    'M:FRGD'
THREE    DATA     3
         END

