***********************************************************************
*M*      FRGD     TO DECODE :FRGD AND :INTLB CC'S AND BUILD M:FRGD LMN
***********************************************************************
*
         SYSTEM   SIG7FDP
         SYSTEM   BPM
         REF      FETCHBUF,READSTRG,NOROOM,SYNTAX,COREALLOC,;
                  MODGEN,M:TM,BIGLOC,WRITELM
         REF      LOGIT
         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
FOP      CNAME
         PROC
         GEN,1,7,8    AF(1),AF(2),AF(3)
         PEND
         PAGE
KWDTBL0  EQU      %
         DATA     KWDTBL-KWDTBL0
         FOP      0,0,3          0  FIND LEFT (
         FOP      1,0,9          1  FIND KEYWORD
         FOP      1,0,10         2  PROCESS KEYWORD
         FOP      1,0,8          3  LOOK FOR ) OR ),( OR END OF COMMAND
         FOP      0,1,1          4  GO TO KWDTBL0+1
         FOP      1,3,13         5  NEXT STRING MUST BE DEC IF SO
*                                   CONVERT IT. IF NOT GO TO KWDTBL+3
         FOP      0,1,18         6  STORE IT INTO *DYNAM+1,R5
         FOP      1,3,6          7  LOOK FOR ',' IF NOT GO TO KWDTBL0+3
         FOP      1,3,14         8  NEXT STRING MUST BE HEX
         FOP      0,1,18         9  STORE IT INTO *DYNAM+1,R5
         FOP      0,3,1          10 GO TO 3
         DATA,2   0              ROUND OFF H.W.  THIS IS A NOP
KWDTBL   EQU      %
KWD      COM,32,8,7,17  AF(1),AF(2),AF(3),AF(4)
         KWD,     'RESD',8,0,5      WHEN RESDF KEYWORD IS ENCOUNTERED
*                                   GO TO KWDTBL0+5 FOR COMMANDS
         KWD      'DYNR',1,1,NPAGES
         KWD      'NINT',1,0,NINTS
DFLTS    DATA     #DFLTS
KWDPTR   GEN,15,17    DFLTS-KWDTBL,KWDTBL0  SIZE OF KEYWORD TBL. ,
*                                           ADDRESS OF KEYWORD TBL
         DATA     #DYNAM
DYNAM    EQU      %
RESDFTOP DATA     RESSIZE+2         END OF RESDF TBL+1
RESDFPTR DATA     RESSIZE           START OF RESDF TBL ADDRESS
NPAGES   DYN      1,0,999           LIMITS = 0-999. DEFAULT = 0
NSEGMNTS DYN      1,0,999           LIMITS = 0-999. DEFAULT = 1
NINTS    DYN      1,0,0
#DYNAM   EQU      %-DYNAM
#DFLTS   EQU      %-DYNAM
RESSIZE  DATA     0                 SIZE LOCATION FOR RESDF OPTION
RESAD    DATA     0                 ADDRESS LOCATION FOR RESDF OPTION
*                                   DEFAULT = 10000
         PAGE
*                 THE FOLLOWING KEYWORD TABLE APPLIES TO THE 'INTLB'
*                 COMMAND PROCESSING
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      RECOV
FRGD     LW,1     FETCHBUF,R3       GET KEYWORD
         CW,R1    FRG               IS IT A DUMMY COMMAND
         BNE      READSTRG          YES
         PSW,SR1  *R0
         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
         PLW,SR1  *R0
         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   14
         MTW,0    NSEGMNTS,R5
         BNEZ     %+2
         MTW,1    NSEGMNTS,R5       DEFAULT #SEGMENTS TO 1
         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,R1    BIGLOC,R3         BYTE 0 = 1 IF 'BIG' SPECIFIED
         LB,R1    R1
         LW,D1    R1
         SLS,R1   7
         OR,R1    D1
         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   LI,D1    10                CHK LIMITS OF RESDF SIZE AND ADDRESS
         LI,D2    1000              AND DYNRESDF #PAGES AND #SEGMENTS
         CLR,D1   RESSIZE           SIZE MUST BE BETWEEN 10 & 999
         BCS,9    %+4
         LI,D3    ERRMESS2
         BAL,SR4  LOGIT             ENTER ERROR IN T:P2SI    & LP
         STW,D1   RESSIZE           IF NOT DEFAULT IS SET = 0
         LI,D1    X'10000'          CHK THAT RESDF ADDRESS IS EQUAL TO
         CW,D1    RESAD             OR GREATER THAN HEX 10000
         BLE      %+4
         LI,D3    ERRMESS5
         BAL,SR4  LOGIT             ENTER ERROR IN T:P2SI    & LP
         STW,D1   RESAD             OTHERWISE SET TO DEFAULT OF X'10000'
         BAL,SR3  MODGEN            GO GENERATE DEF'S
         AI,8     1
         TEXTC    'RESDF1'
         TEXTC    'RESDFD0'      THIS 'EQU' DEF = CONTENTS OF RESDF
         LW,D1    RESSIZE
         STW,D1   *SR1              GET SIZE AND STORE IT IN RESDF DEF
         AI,SR1   1
         STW,D1   *SR1
         TEXTC    'CRESDF1'         SIZE GOES ALSO INTO CRESDF DEF
         AI,SR1   1
         LW,D1    RESAD             GET ADDRESS FROM RESDF COMMAND
         STW,D1   *SR1              PUT IT INTO  RESDFP DEF
         TEXTC    'RESDFP1'
         TEXTC    'RESDFPD0'        THIS 'EQU' DEF = CONTENTS OF RESDFP
         AI,SR1   1
         STW,SR1  SAVDYNAD
         TEXTC    'DYNRESDF1'
         AI,SR1   1
         LW,D1    NPAGES,R5
         STW,D1   *SR1
         TEXTC    'MDYNRESDF1'
         TEXTC    'MDRESDFD0'    THIS 'EQU' DEF = CONTENTS OF MDYNRESDF
         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    '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    3                 ROUND TO WORD LENGTH
         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
         AI,SR1   -1
         BAL,10   MODGEN
         TEXTC    'INTLBSIZ0'
         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
         LI,D3    ERRMESS
         BAL,SR4  LOGIT             ENTER ERROR IN T:P2SI    & LP
         STW,2    *BEGIN,4
         AI,4     1
         AI,6     1
         B        LOCS1
         PZE      RECOV
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
         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)
         LI,D3    SPECMES
         BAL,SR4  LOGIT             ENTER ERROR IN T:P2SI    & LP
         B        RECOV
ERROR1   LI,D3    ERRMESS1
         BAL,SR4  LOGIT             ENTER ERROR IN T:P2SI    & LP
         B        NOFRG+3
IGNORE   LI,D3    IGMESS
         BAL,SR4  LOGIT             ENTER ERROR IN T:P2SI    & LP
         B        RECOV
IGMESS   TEXTC    '***NO CORE FOR FRGD, INTLB IGNORED'
ERRMESS  TEXTC    '***   LABEL HAS ILLEGAL VALUE. IGNORED'
ERRMESS1 TEXTC    '*** INTLB WITHOUT FRGD. OPTION IGNORED'
ERRMESS2 TEXTC    '*** SIZE OUT OF RANGE. DEFAULTED TO 10'
ERRMESS5 TEXTC    '*** ADDRESS < 10000.  DEFAULTED TO 10000'
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
PATCH    EQU      %
         LIST     0
         DO1      50
         DATA     0
         LIST     1
         END

