*CREATED 02/23/71 MM #3920
*                 CATALOG NO. 704737 - SIGMA 5/7 BPM M:DEBUG
       CSECT       1
         SYSTEM   SIG7FDP
*
*
*        PMD,PMDC,PMDI,SNAP,SNAPC,IF,AND,OR,COUNT DEBUG
*
*                 CONTROL COMMAND  PROCESSORS
*
*
       PAGE
*                 SYMBOLIC REGISTER DEF'S.
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
         PAGE
*                 CHANGE STACK POINTER AMOUNT SPEC. BY 1ST ARGUMENT.
*                 SECOND ARGUMENT SPEC. AVAILABLE REGISTER.
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TSTACK
         PEND
*                 PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGUMENT INTO
*                 REG'S STARTING AT 2ND ARGUMENT.
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17 0,NAME(1),AF(1),0,TSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TSTACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17  0,NAME(2),AF(2),0,TSTACK
         FIN
         FIN
         PEND
         REF      TSTACK
         PAGE
         DEF      INCLR
         DEF      DEFXREFR
         DEF      MODFYR
         DEF      PMDR
         DEF      SNAPR
         DEF      IFR
         DEF      SEGSRCH
         PAGE
         REF      TERMERCD
         REF      COMERCD
         REF      BLNKERCD
         REF      CHARSCAN
         REF      ILSEGNCD
         REF      PLB
         REF      CSL
         REF      CHSTSHFT
         REF      NAMSCAN
         REF      ALOCCT
         REF      CCLTFLGS
         REF      EOCCSCAN
         REF      GETHEXVAL
         REF      ROMTOVCD
         REF      NAMERCD
         REF      ROMTADR
         REF      TREETADR
         REF      TTESIZE
         REF      ROMTESIZE
         REF      ROMNAME
         REF      LINKNEXTROM
         REF      LSTROMLINK
         REF      DECSCAN
         REF      BCDHEX
         REF      DECERCD
         REF      RPERCD
         REF      LPERCD
         REF      SYNTXER
         REF      CHSTSCAN
         REF      CHSTERCD
         REF      X10
         REF      FLAGS
         REF      Y2
         REF      XF
         REF      X7FFFFFFF
         REF      X1FFFF
         REF      GETDECVAL
         REF      COUNTID
         REF      CJOB
         REF      GETLOC,GETLOC1,GETLOC2,GETLOC3
         REF      M:X1
         REF      CPE                                                   737
DBUGF    EQU      CPE                                                   737
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K3       EQU      X'3'
K4       EQU      X'4'
K7       EQU      X'7'
K8       EQU      X'8'
KF       EQU      X'F'
K20      EQU      X'20'
KN1      EQU      -X'1'
KNF      EQU      -X'F'
KN11     EQU      -X'11'
KBLANK   EQU      ' '
KCOMMA   EQU      ','
KCRET    EQU      X'15'
KEOB     EQU      X'26'
KPERIOD  EQU      '.'
         PAGE
**********************************************************************
*        INCLR    INCLUDE CONTROL COMMAND PROCESSOR                  *
*        ENTER WITH                                                  *
*                 (R5) = JIT POINTER                                 *
*                 (R7) = ADR OF PARAM LIST                           *
*                 (SR1) = CUR CHAR OR ZERO                           *
*                                                                    *
**********************************************************************
INCLR    EQU      %
         PUSH     SR4
         PUSH     R6
         LW,R6    ALOCCT,R5         (R6) = ADR OF LOCCT
         LW,R1    TREETADR,R6       (R1) = ADR OF TREE TABLE
         LW,D4    *R1
         AW,D4    R1                (D4) = ADR OF LAST WORD IN TREE TBL
         AI,R1    K1                (R1) = ADR OF 1ST TREE TABLE ENTRY
         BAL,SR4  SEGSRCH           GET SEG NAME AND SEARCH TREE TABLE
         BCR,8    GETROM
         B        INCLR20
*
GETROM   EQU %
         LW,R2    ROMTADR,R6        (R2) = ADR OF ROMT
         LW,R3    R2
         SLS,R3   KN11              (R3) V ROMT SIZE
         PUSH     5,D4
INCLR1   EQU      %
         BAL,SR4  NAMSCAN           GET ROM NAME
         BCS,8    INCLR10
         LW,R0    R7
         AI,R0    PLB
         LW,R1    CSL,R7
         LI,R2    K1
         BAL,SR4  CHSTSHFT          SHIFT ROM NAME AND INSERT BYTE COUNT
         PULL     5,D4
         LI,R4    ROMTESIZE
         STW,R2   D1
         STW,R3   D2
         AND,R2   X1FFFF
         SW,R2    R4
         CW,R2    D4                CHECK IF ROMT AND TREE TBLS OVERLAP
         BLE      INCLR14
         LI,R4    K0
INCLR2   EQU      %
         LW,D3    *D1,R4            MOVE ROMT DOWN BY ROMT ENTRY
         STW,D3   *R2,R4                                        SIZE
         AI,R4    K1
         BDR,D2   INCLR2
*
         LW,R4    R2
         AW,R4    R3
         LCI      K3
         LM,D1    PLB,R7            MOVE ROM
         STM,D1   ROMNAME,R4                 NAME TO ROMT
*
         LI,D1    K0                SET
         STW,D1   LINKNEXTROM,R4        UP
         AI,R3    K1
         STW,R3   R4                      NEW
         XW,R4    LSTROMLINK,R1              LINKS
         AI,R3    K7
         PUSH     5,D4
*
         PUSH     4,R5
         LW,R5    R3                R5=DISP+1 OF ROM ENTRY
         AI,R5    -7                JUST ADDED TO END OF ROMT
         LW,D1    R2                D1 PTS TO BASE OF ROMT
         LW,R3    R4                R3=DISP+1 OF ROM ENTRY POINTING
         AI,R3    -1
         AW,R3    D1                R3=ADDRESS OF ROMT ENTRY POINTING
         OR,R5    LINKNEXTROM,R3    STORE DISP TO LATEST.
         STW,R5   LINKNEXTROM,R3    ROM INTO LAST WORD OF ROMT ENTRY
         PULL     4,R5
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCR,8    INCLR1
         PULL     5,D4
         SLS,R2   KF
         SCD,R2   KNF
         STW,R2   ROMTADR,R6        STORE NEW ROMT ADR AND SIZE IN LOCCT
         CI,SR1   KEOB
         BE       INCLR3
         CI,SR1   KPERIOD
         BE       INCLR3
         CI,SR1   KCRET
         BNE      INCLR12
INCLR3   EQU      %
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC
         PULL     R6
         PULL     SR4
         B        *SR4              EXIT
*
INCLR10  EQU      %
         LI,SR3   NAMERCD
         B        INCLR18
*
INCLR12  EQU      %
         LI,SR3   TERMERCD
         B        INCLR20
*
INCLR14  EQU      %
         LI,SR3   ROMTOVCD
         B        INCLR20
INCLR18  EQU      %
         BUMP     -5,R1
INCLR20  EQU      %
         PULL     R6
         PULL     SR4
         AI,SR4   K1
         B        *SR4              ERROR EXIT
         PAGE
**********************************************************************
*        DEFXREF  PROCESS DEFXREF CONTROL COMMAND                    *
*        ENTER WITH                                                  *
*                 (R5) = JIT POINTER                                 *
*                 (R7) = PARAM LIST ADR                              *
*                 (SR1 = CUR CHAR OR ZERO                            *
*                                                                    *
**********************************************************************
DEFXREFR EQU      %
         PULL     R3                (R3) = ADR OF NXT AVAIL LOCA IN BUF
         BAL,SR4  GETLOC            GET NAME OF LOCA AND MOVE TO BUF
         B        DEFXREF3          ERROR RETURN
         PUSH     R3
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA AFTER NAME
         BCS,8    DEFXREF2          ERROR IF NO COMMA
         PULL     R3                (R3)=ADR OF NXT AVAIL LOC IN BUF
         BAL,SR4  GETLOC3           GET LOC AND MOVE TO BUF
         B        DEFXREF3          ERROR RETURN
         PULL     R2                (R2) = ADR OF BUFFER
         AWM,R4   0,R2              ADD RESOLUTION TO 1ST WORD OF BUF
         PULL     R4                (R4) = ADR OF KEY = SEGMENT NAME
         BAL,SR4  WRTDEBUG          WRITE BUF ON DISC
         BAL,SR4  EOCCSCAN
DEFXREF1 EQU      %
         PULL     SR4
         B        *SR4              EXIT
*
DEFXREF2 EQU      %
         LI,SR3   COMERCD           (SR3) = COMMA ERROR CODE
         PULL     R1                ADJUST
DEFXREF3 EQU      %
         PULL     R1                     TEMP
         PULL     R1                         STACK
         MTW,1    *TSTACK           BUMP FOR ERROR RETURN
         B        DEFXREF1
         PAGE
**********************************************************************
*        MODFYR   PROCESSES MODIFY CONTROL COMMAND                   *
*        ENTER WITH                                                  *
*                 (R5) = JIT ADR                                     *
*                 (R7) = PARAM LIST ADR                              *
*                 (SR1) = CUR CHAR OR ZERO                           *
*                                                                    *
**********************************************************************
MODFYR   EQU      %
         PULL     R3                (R3)=ADR OF NXT AVAIL LOC IN BUFF
         BAL,SR4  GETLOC2           GET MODIFY LOCA AND MOVE TO BUF
         B        MODFYR41          ERROR RETURN
         PULL     R2                (R2) = ADR OF BUFF
         STW,R3   -1,R2             SAVE NXT AVAIL LOC
         PUSH     2,R2
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCS,8    MODFYR30
MODFYR1  EQU      %
         BAL,SR4  GETHEXVAL         GET HEX MODIFY VALUE
         BCS,8    MODFYR40
         PUSH     D3                SAVE VALUE
         LI,SR2   '+'
         BAL,SR4  CHARSCAN          CHECK FOR +
         BCS,8    MODFYR2
         PULL     D3
         PULL     R3                (R3)= ADR OF NXT AVAIL
         PUSH     D3
         BAL,SR4  GETLOC1           GET RELOCATION NAME AND MOVE TO BUF
         B        MODFYR40          ERROR RETURN
         PULL     D3                (D3) = HEX MODIFY VALUE
         B        MODFYR3
*
MODFYR2  EQU      %
         PULL     D3                (D3) = HEX MODIFY VALUE
         PULL     R3                (R3) = ADR OF NXT AVAIL
         LI,R2    K0
         STW,R2   0,R3              SET RELOCATION NAME =0
         AI,R3    K1
         LI,R4    K4
MODFYR3  EQU      %
         STW,D3   0,R3              STORE HEX MODIFY VAL IN BUF
         AI,R3    K1
         PULL     R2                (R2) = ADR OF BUF
         LI,R1    3
         STB,R4   *R2,R1            STORE RESOLUTION
         PULL     R4
         PUSH     R4
         PUSH     R2
         BAL,SR4  WRTDEBUG          WRITE OUT BUFFER
*
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCS,8    MODFYR4
         PULL     R2                (R2) = ADR OF BUF
         LW,R3    -1,R2             (R3) = ADR OF NXT AVAIL AFTER LOC
         PUSH     2,R2
         MTW,1    -1,R3             INCREMENT MODFY LOC
         B        MODFYR1           PROCESS NEXT MODFY
MODFYR4  EQU      %
         CI,SR1   KEOB              CHECK FOR EOB
         BE       MODFYR5
         CI,SR1   '.'               CHECK FOR PERIOD
         BE       MODFYR5
         CI,SR1   KCRET             CHECK FOR CARRIAGE RETURN
         BNE      MODFYR32
MODFYR5  EQU      %
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC
         PULL     R1
         PULL     R1
MODFYR6  EQU      %
         PULL     SR4
         B        *SR4              EXIT
*
MODFYR30 EQU      %
         LI,SR3   COMERCD
         B        MODFYR40
*
MODFYR32 EQU      %
         LI,SR3   TERMERCD
         B        MODFYR41
*
MODFYR40 EQU      %
         PULL     R1
MODFYR41 EQU      %
         PULL     R1
         PULL     R1
         MTW,1    *TSTACK
         B        MODFYR6
         PAGE
PMDR     EQU      %
         PULL     2,R2
         STW,R3   -1,R2             SAVE CUR NXT AVAIL LOC POINTER
         PUSH     2,R2
         LI,SR2   '('
         BAL,SR4  CHARSCAN          CHECK FOR (
         BCS,8    PMDR22
*
PMDR2    EQU      %
         PULL     R3
         PUSH     R3
         LI,D1    0
         STW,D1   0,R3              ZERO
         STW,D1   1,R3                  FROM-TO
         STW,D1   2,R3                         IN
         STW,D1   3,R3                            BUFFER
         LI,SR2   '+'
         BAL,SR4  CHARSCAN          CHECK FOR LEADING +
         BCR,8    PMDR16
         PULL     R3
         BAL,SR4  GETLOC2
         B        PMDR3
         B        PMDR20
PMDR3    EQU      %
         CI,SR3   NAMERCD
         BNE      PMDR51
         PUSH     R3
         LW,R1    Y2
         STS,R1   FLAGS,R7
         BAL,SR4  DECSCAN           SCAN FOR DECIMAL VALUE
         BCS,8    PMDR40
         LW,R1    CSL,R7
         CI,R1    2                 CHECK IF <= 2 CHAR
         BG       PMDR40            ERROR IF NOT
         LW,D1    PLB,R7
         BAL,SR4  BCDHEX            CONVERT
         LI,R1    4
         CI,D3    0                 CHECK IF PP = 00
         BE       PMDR6
         LI,R1    2
         CI,D3    1                 CHECK IF PP = 01
         BE       PMDR6
         LI,R1    1
         CI,D3    X'10'                                                 737
         BNE      PMDR40
PMDR6    EQU      %
         PULL     2,R2
         REF      X8
         MTW,0    *TSTACK           CHK FLAG TO DO ALL
         BGZ      %+2
         OR,R1    X8                SET BIT FOR RUNNER
         STS,R1   0,R2              SET PP BIT INDICATOR
PMDR8    EQU      %
         PUSH     2,R2
         LI,SR2   ')'
         BAL,SR4  CHARSCAN          CHECK FOR )
         BCS,8    PMDR42            ERROR IF NONE
*
*
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR  ,
         BCS,8    PMDR10
         LI,SR2   '('
         BAL,SR4  CHARSCAN          CHECK FOR (
         BCS,8    PMDR44            ERROR IF NO (
         B        PMDR2             PROCESS NEXT PARAMETER
*
PMDR10   EQU      %
         CI,SR1   X'26'             CHECK FOR EOB
         BE       PMDR12
         CI,SR1   '.'               CHECK FOR  .
         BE       PMDR12
         CI,SR1   X'15'             CHECK FOR CARRIAGE RETURN
         BNE      PMDR46
PMDR12   EQU      %
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC
         PULL     2,R2
         PULL     R4
         LI,R1    7
         LS,R1    0,R2
         BEZ      PMDR14            CHECK IF ANY PP BITS SET
         AI,R3    4
         BAL,SR4  WRTDEBUG          YES- WRITE OUT BUFFER
PMDR14   EQU      %
         PULL     SR4
         B        *SR4              EXIT
*
PMDR16   EQU      %
         BAL,SR4  GETHEXVAL         GET HEX VALUE
         BCS,8    PMDR50
         PULL     R3
         LI,R1    K0
         STW,R1   0,R3              SET FROM NAME=0
         STW,D3   1,R3              STORE FROM VALUE
         AI,R3    K2
         B        PMDR20
*
PMDR20   EQU      %
         PUSH     R3
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR , AFTER FROM LOC
         BCS,8    PMDR48
         PULL     R3
         BAL,SR4  GETLOC2           GET TO LOC
         B        PMDR51            ERROR RETURN
         PULL     R2
         PULL     R4
         PUSH     R4
         PUSH     R2
         LW,D2    R3
         SW,D2    R2                (D2) = RECORD SIZE
         CI,D2    1                 CHECK IF ONE WORD ONLY
         BNE      PMDR21
         AI,R3    4                 SET RECORD SIZE = 4 WORDS
PMDR21   EQU      %
         BAL,SR4  WRTDEBUG          WRITE OUT BUFFER
         LI,R0    0
         LI,R1    7
         PULL     R2
         STS,R0   0,R2
         LW,R3    -1,R2             RESTORE NXT AVAIL POINTER
         B        PMDR8
*
PMDR22   EQU      %
         PULL     2,R2
         LI,R1    4
         MTW,0    *TSTACK           CHK FLAG TO DO ALL
         BGZ      %+2
         OR,R1    X8                SET BIT FOR RUNNER
         STS,R1   0,R2              SET BIT FOR PP =0
         PUSH     2,R2
         LI,R3    0                                                     737
         STW,R3   1,R2                                                  737
         STW,R3   2,R2                                                  737
         STW,R3   3,R2                                                  737
         STW,R3   4,R2                                                  737
         LW,R2    ALOCCT,R5
         LI,R3    2
         MTB,1    *R2,R3            BUMP DUMP COUNT
         B        PMDR10
*
PMDR40   EQU      %
         LI,SR3   DECERCD
         B        PMDR50
*
PMDR42   EQU      %
         LI,SR3   RPERCD
         B        PMDR50
*
PMDR44   EQU      %
         LI,SR3   LPERCD
         B        PMDR50
*
PMDR46   EQU      %
         LI,SR3   SYNTXER
         B        PMDR50
*
PMDR48   EQU      %
         LI,SR3   COMERCD
*
*
PMDR50   EQU      %
         PULL     R1
PMDR51   EQU      %
         PULL     R1
         PULL     R1
         MTW,1    *TSTACK
         B        PMDR14
         PAGE
SNAPR    EQU      %
         CI,R3    6                 CHECK IF SNAPC COMMAND
         BNE      SNAPR1
         PULL     R2
         AI,R2    2
         PUSH     R2
         B        SNAPR2
SNAPR1   EQU      %
         BAL,SR4  CHSTSCAN          GET FLAG
         BCS,8    SNAPR20           ILLEGAL FLAG
         PULL     R2
         LCI      2                 MOVE
         LM,D1    PLB,R7               FLAG
         STM,D1   0,R2                      TO BUFFER
         AI,R2    2
         PUSH     R2
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK IF COMMA FOLLOWS FLAG
         BCS,8    SNAPR22
SNAPR2   EQU      %
         PULL     R3
         BAL,SR4  GETLOC2           GET SNAP LOCAND MOVE TO BUFFER
         B        SNAPR34                                               737
         PUSH     R3
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BAL,SR4  CHSTSCAN          GET COMMENT
         BCS,8    SNAPR20
         LW,R2    CSL,R7
         CI,R2    8                 CHECK IF <= 8 CHAR
         BG       SNAPR20
         LW,D1    PLB,R7            MOVE
         LW,D2    PLB+1,R7              COMMENT
         PULL     2,R2                           REGISTER
         STW,D1   0,R3                                  DUMP
         STW,D2   1,R3                                      BIT
         AI,R3    2
         STW,R3   -1,R2
         PUSH     2,R2
*
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR AFTER COMMENT
         BCS,8    SNAPR6
SNAPR4   EQU      %
         LI,SR2   '('
         BAL,SR4  CHARSCAN          CHECK FOR LEFT PAREN
         BCS,8    SNAPR24
         PULL     R3
         BAL,SR4  GETLOC2           GET FROM ADR AND MOVE
         B        SNAPR34                                               737
         PUSH     R3
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCS,8    SNAPR8
         PULL     R3
         BAL,SR4  GETLOC2           GET TO ADR AND MOVE TO BUFFER
         B        SNAPR34                                               737
         PUSH     R3
SNAPR5   EQU      %
         LI,SR2   ')'
         BAL,SR4  CHARSCAN          CHECK FOR RIGHT PAREN
         BCS,8    SNAPR26
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCS,8    SNAPR7
         PULL     2,R2
         PULL     R4
         PUSH     R4
         PUSH     R2
         BAL,SR4  WRTDEBUG          WRITE OUT BUFFER
         PULL     R2
         LW,R3    -1,R2             RESTORE NEXT AVAIL. POINTER
         PUSH     2,R2
         B        SNAPR4
*
SNAPR6   EQU      %
         PULL     R3
         LI,D1    K0                SET
         LI,D2    K0                    FROM-TO DUMP
         LCI      K2                                 ADR'S TO
         STM,D1   0,R3
         STM,D1   2,R3
         AI,R3    K4
         PUSH     R3
SNAPR7   EQU      %
         CI,SR1   X'26'             CHECK FOR EOB
         BE       SNAPR12
         CI,SR1   '.'               CHECK FOR PERIOD
         BE       SNAPR12
         CI,SR1   X'15'             CHECK FOR CARRIAGE RETURN
         BNE      SNAPR28
SNAPR12  EQU      %
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC
         PULL     2,R2
         PULL     R4
         BAL,SR4  WRTDEBUG          WRITE OUT DEBUG
SNAPR10  EQU      %
         PULL     SR4
         B        *SR4              EXIT
*
SNAPR8   EQU      %
         PULL     2,R2              NO TO
         LW,R4    -1,R2                    ADR
         STW,R3   R1                          SPECIFIED
         SW,R1    R4
SNAPR9   EQU      %
         LW,D1    0,R4              SET
         STW,D1   0,R3                  TO ADR = FROM
         AI,R3    K1                                    ADR
         AI,R4    K1
         BDR,R1   SNAPR9
         PUSH     2,R2
         B        SNAPR5
*
SNAPR20  EQU      %
         LI,SR3   CHSTERCD
         B        SNAPR30
*
SNAPR22  EQU      %
         LI,SR3   COMERCD
         B        SNAPR30
*
SNAPR24  EQU      %
         LI,SR3   LPERCD
         B        SNAPR30
*
SNAPR26  EQU      %
         LI,SR3   RPERCD
         B        SNAPR30
*
SNAPR28  EQU      %
         LI,SR3   TERMERCD
*
SNAPR30  EQU      %
         BUMP     -3,R1
         MTW,1    *TSTACK
         B        SNAPR10
SNAPR34  EQU      %                                                     737
         PUSH     R3                                                    737
         B        SNAPR30                                               737
         PAGE
IFR      EQU      %
         BAL,SR4  CHSTSCAN          GET FLAG
         BCS,8    IFR30
         LW,R2    CSL,R7
         CI,R2    8                 CHECK IF >= 8 CHAR
         BG       IFR30
         PULL     R3
         LCI      2
         LM,D1    PLB,R7            MOVE FLAG
         STM,D1   0,R3                       TO BUFFER
         AI,R3    2                 INCREMENT NXT AVAIL POINTER
         PUSH     R3
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR ,
         BCS,8    IFR32
         PULL     R3                (R3) = NXT AVAIL POINTER
         BAL,SR4  GETLOC2           GET DEBUG LOC AND MOVE TO BUF
         B        IFR51
         PULL     R2
         PUSH     2,R2
         LB,R1    *R2
         CI,R1    COUNTID
         BE       COUNTR
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA AFTER LOC
         BCS,8    IFR32
*
         LI,SR2   '('
         BAL,SR4  CHARSCAN          CHECK FOR '('
         BCS,8    IFR34
*
IFR1     EQU      %
         LI,SR2   '*'
         BAL,SR4  CHARSCAN          CHECK FOR '*'
         BCS,8    IFR2
         PULL     2,R2                                                  737
         LI,R1    X'10'                                                 737
         STS,R1   0,R2                                                  737
         PUSH     2,R2                                                  737
IFR2     EQU      %
         PULL     R3                (R3) = NXT AVAIL POINTER
         BAL,SR4  GETLOC2           GET FROM AND MOVE TO BUF
         B        IFR51             ERROR RETURN
*
         PULL     R2                (R2) = ADR OF BUF
         LW,R1    0,R2
         AND,R1   X10
         LI,R0    0
         STS,R0   0,R2              RESET INDIRECT BIT FLAG
         SLS,R1   27                                                    737
         STS,R1   -1,R3             SET INDIRECT BIT
         PUSH     2,R2
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR .
         BCS,8    IFR32
         BAL,SR4  DECSCAN           GET INDEX FIELD
         BCS,8    IFR36
         LW,R2    CSL,R7
         CI,R2    1                 CHECK IF INDEX 1 CHAR
         BG       IFR36             ERROR IF NOT
         LW,R2    PLB,R7
         LB,R2    R2
         AND,R2   XF                (R2) = INDEX VALUE
         CI,R2    K7                CHECK IF INDEX VALUE <=7
         BG       IFR36             ERRORNIF NOT
         PULL     R3
         STW,R2   0,R3
         AI,R3    K1
         PUSH     R3
*
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR ,
         BCR,8    IFR4              BRANCH IF COMMA
         PULL     2,R2
         LI,R1    K20
         LS,R1    0,R2              CHECK IF 1ST PASS
         BEZ      IFR42             IF YES, ERROR
         PUSH     2,R2
         LI,R1    2                 SET B = 2                           737
         B        IFR11                                                 737
*
IFR4     EQU      %
         BAL,SR4  DECSCAN           GET DECIMAL VALUE
         BCR,8    IFR6              BRANCH IF DEC VALUE
         PULL     2,R2
         LI,R1    K20
         LS,R1    0,R2              CHECK IF 2ND PASS
         BNEZ     IFR42             IF YES ERROR
         PUSH     2,R2
         LW,R1    Y2
         STS,R1   FLAGS,R7          SET CHAR BUFFER FULL FLAG
         LI,R1    2                                                     737
         B        IFR11             SET B = 2                           737
*
IFR6     EQU      %
         LW,R2    CSL,R7
         CI,R2    1                 CHECK IF B 1 CHAR
         BNE      IFR36             ERROR IF NOT
         LW,R2    PLB,R7
         LB,R2    R2
         AND,R2   XF
         LI,R1    0
         CI,R2    1                 CHECK
         BE       IFR10                  IF
         LI,R1    1                         LEGAL
         CI,R2    2                              B
         BE       IFR10                           VALUE
         LI,R1    2
         CI,R2    4
         BE       IFR10
         LI,R1    3
         CI,R2    8
         BE       IFR10
         B        IFR36             ILLEGAL B VALUE
*
IFR10    EQU      %
         PULL     2,R2                                                  737
         PUSH     2,R2                                                  737
         PUSH     R1                                                    737
         LI,R1    X'20'                                                 737
         LS,R1    0,R2                                                  737
         BNEZ     IFR10A                                                737
         LI,SR2   ','                                                   737
         BAL,SR4  CHARSCAN                                              737
         BCR,8    IFR10A                                                737
         PULL     R1                                                    737
         B        IFR32                                                 737
IFR10A   EQU      %                                                     737
         PULL     R1                                                    737
IFR11    EQU      %                                                     737
         PULL     2,R2
         PUSH     2,R2
         SLS,R1   16
         AWM,R1   -1,R3             STORE B IN BUF
         LI,R1    K20
         LS,R1    0,R2
         BNEZ     IFR14             CHECK IF SECOND PASS
         LI,R1    K20
         STS,R1   0,R2              SET 2ND PASS FLAG
*
         BAL,SR4  NAMSCAN           GET RELATIONSHIP
         BCS,8    IFR38
         LW,R1    CSL,R7
         CI,R1    2                 CHECK IF 2 CHAR'S
         BNE      IFR38             ERROR IF NOT
         LW,R3    PLB,R7
         SLS,R3   -16               (R3) = RELATIONSHIP
         LI,R4    0
         CI,R3    'GT'              CHECK IF GREATER THAN
         BE       IFR12
         LI,R4    1
         CI,R3    'LT'                        LESS THAN
         BE       IFR12
         LI,R4    2
         CI,R3    'EQ'                        EQUAL
         BE       IFR12
         LI,R4    3
         CI,R3    'GE'                       GREATER THAN OR EQUAL
         BE       IFR12
         LI,R4    4
         CI,R3    'LE'                       LESS THAN RO EQUAL
         BE       IFR12
         LI,R4    5
         CI,R3    'NE'                        NOT EQUAL
         BNE      IFR38
IFR12    EQU      %
         PULL     2,R2
         AWM,R4   0,R2              STORE VALUE IN 1ST WORD OF BUFFER
         PUSH     2,R2
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR ,
         BCS,8    IFR32
         B        IFR1              MAKE 2ND PASS
*
IFR14    EQU      %
         LI,SR2   ')'
         BAL,SR4  CHARSCAN          CHECK FOR  )
         BCS,8    IFR40
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC
*
         PULL     2,R2
         PULL     R4
         LI,D1    0
         LI,D2    X'F0'
         STS,D1   0,R2              ZERO 2ND PASS FLAG
         BAL,SR4  WRTDEBUG          WRITE OUT BUFFER
IFR16    EQU      %
         PULL     SR4
         B        *SR4              EXIT
*
IFR30    EQU      %
         LI,SR3   CHSTERCD
         B        IFR50
*
IFR32    EQU      %
         LI,SR3   COMERCD
         B        IFR50
*
IFR34    EQU      %
         LI,SR3   LPERCD
         B        IFR50
*
IFR36    EQU      %
         LI,SR3   DECERCD
         B        IFR50
*
IFR38    EQU      %
         LI,SR3   NAMERCD
         B        IFR50
*
IFR40    EQU      %
         LI,SR3   RPERCD
         B        IFR50
*
IFR42    EQU      %
         LI,SR3   SYNTXER
         B        IFR52
*
IFR50    EQU      %
         PULL     R1                ADJUST
IFR51    EQU      %
         PULL     R1                      TEMP
IFR52    EQU      %
         PULL     R1                           STACK
         MTW,1    *TSTACK
         B        IFR16
         PAGE
COUNTR   EQU      %
         LI,R4    3
COUNTR1  EQU      %
         PUSH     R4
         LI,R1    X7FFFFFFF         (R1) = MAX VALUE
         BAL,SR4  GETDECVAL         GET DECIMAL VALUE
         BCS,8    COUNTR3           CHECK IF LEGAL
         PULL     R4
         PULL     R3
         STW,R2   0,R3              STORE VALUE IN BUFFER
         AI,R3    1
         PUSH     R3
         BDR,R4   COUNTR1
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC
         PULL     2,R2
         PULL     R4
         BAL,SR4  WRTDEBUG          WRITE OUT BUFFER
COUNTR2  EQU      %
         PULL     SR4
         B        *SR4              EXIT
*
COUNTR3  EQU      %
         PULL     R4
         PULL     2,R2
         PULL     R1
         MTW,1    *TSTACK
         B        COUNTR2
         PAGE
**********************************************************************
*        SEGSRCH  SEGMENT SEARCH- GETS SEGMENT NAME FROM CONTROL     *
*                 COMMAND, SEARCHES TREE TABLE FOR SEGMENT NAME      *
*                 AND CHECKS FOR COMMA FOLLOWING SEG NAME            *
*        ENTER WITH                                                  *
*                 (R1) =  ADR OF TREE TABLE                          *
*                 (R7) =  PARAM LIST POINTER                         *
*                 (SR1) =  CUR CHAR OR ZERO                          *
*                 (D4) =  END ADR OF TREE TABLE                      *
*        EXIT WITH                                                   *
*                 (R1) =  ADR OF TREE TABLE ENTRY  AND CC1 =0  IF    *
*                   LEGAL NAME FOUND                                 *
*                 CC1=1 AND (SR3)= ERR CODE IF NO LEGAL NAME         *
*                                                                    *
**********************************************************************
SEGSRCH  EQU      %
         PUSH     7,SR4
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA AFTER NAME
         BCS,8    SEGSRCH6
         BAL,SR4  NAMSCAN           SCAN FOR SEGMENT NAME
         BCS,8    SEGSRCH5          CHECK IF LEGAL NAME
         LW,R1    CSL,R7
         CI,R1    K8                CHECK IF SEGNENT NAME <= 8 CHAR
         BG       SEGSRCH4          ERROR IF NOT <= 8 CHAR
         LW,R0    R7
         AI,R0    PLB               (R0) = ADR OF SEG NAME IN BUFFER
         LI,R2    K1
         BAL,SR4  CHSTSHFT          SHIFT NAME AND INSERT BYTE COUNT
         PULL     6,D1
SEGSRCH1 EQU      %                 SEARCH TREE TABLE FOR SEGMENT NAME
         LB,R2    *R1
         AI,R2    KN1               (R2) = SEG NAME LENGTH IN TREE TBL
         LW,R3    R7
         AI,R3    PLB
         CB,R2    *R3               CHECK IF LENGTHS AGREE
         BNE      SEGSRCH3
SEGSRCH2 EQU      %
         LB,R4    *R3,R2
         CB,R4    *R1,R2            COMPARE NAMES
         BNE      SEGSRCH3
         BDR,R2   SEGSRCH2
         CI,SR1   KBLANK
         BNE      SEGSRCH8
         PULL     SR4
         LCI      K0
         B        *SR4              NORMAL EXIT
*
SEGSRCH3 EQU      %
         AI,R1    TTESIZE           BUMP R1 TO NEXT ENTRY IN IT
         CW,R1    D4                CHECK IF END OF IT
         BL       SEGSRCH1
         LW,R0    R7
         AI,R0    PLB
         LW,R1    CSL,R7
         CB,R1    *R0
         BNE      SEGSRCH9
         AI,R1    1
         LI,R2    2
         BAL,SR4  CHSTSHFT
         MTB,1    *R0
         LI,R1    '+'
         LI,R2    1
         STB,R1   *R0,R2
         LB,R1    CJOB
         LI,R2    2
         STB,R1   *R0,R2
         LW,R4    ALOCCT,R5
         LW,R1    TREETADR,R4
         AI,R1    1
         B        SEGSRCH1
SEGSRCH9 EQU      %
         PUSH     6,D1
SEGSRCH4 EQU      %
         LI,SR3   ILSEGNCD
         B        SEGSRCH7
SEGSRCH5 EQU      %
         LI,SR3   NAMERCD
         B        SEGSRCH7
SEGSRCH6 EQU      %
         LI,SR3   COMERCD
SEGSRCH7 EQU      %
         PULL     7,SR4
         LCI      K8
         B        *SR4              ERROR EXIT
*
SEGSRCH8 EQU      %
         PUSH     6,D1
         LI,SR3   BLNKERCD
         B        SEGSRCH7
*
         PAGE
*
*
*        WRTDEBUG - WRITE OUT DEBUG RECORD INTO FILE SYSIDD
*
*        ENTER WITH
*                 (R2) = START ADR OF RECORD
*                 (R3 = END ADR +1
*                 (R4) = ADR OF KEY
*
WRTDEBUG EQU      %
         SW,R3    R2                (R3) = NO. OF WORDS TO WRITE
         SLS,R3   2                 (R3) = NO. OF NYTES TO WRITE
         CAL1,1   SETDCB            SET ERROR AND ABN ADR'S IN DCB
         CAL1,1   WRTDBGPL          WRITE OUT RECORD
         LB,R1    *R4               (R1) = NO. OF BYTES IN KEY
         MTB,1    *R4,R1            INCREMENT LAST BYTE OF KEY
         LW,D2    CCLTFLGS,R5
         CI,D2    X'10000'
         BANZ     WRTDBG2
*
         LB,D1    *R2
         LI,R1    2
         CI,D1    2                 CHECK IF MODIFY
         BE       WRTDBG1
         CI,D1    6                 CHECK IF PMD,PMDC, OR PMDI
         BL       WRTDBG3           YES                                 737
         LI,R1    1                 NO,SNAP,SNAPC,IF,AND,OR,OR COUNT
WRTDBG1  EQU      %
         LW,D1    ALOCCT,R5         (D1) = ADR OF RUN TABLE
         MTB,1    *D1,R1            INCREMENT COUNTER
WRTDBG2  EQU      %
         B        *SR4              EXIT
WRTDBG3  EQU      %                                                     737
         LI,R1    X'20000'                                              737
         STS,R1   DBUGF,R5          SET PMD FLAG IN JIT                 737
         B        *SR4                                                  737
         PAGE
*
*        WRITE DEBUG PLIST
*
*
WRTDBGPL EQU      %
         GEN,8,24 X'11',M:X1
         DATA     X'F8000070'
         DATA     WRTDBG2
         DATA     WRTDBG2
         GEN,8,24 X'80',R2
         GEN,8,24 X'80',R3
         GEN,8,24 X'80',R4
*
*        SET DCB PLIST
*
SETDCB   EQU      %
         GEN,8,24 X'06',M:X1
         GEN,2,30 3,0
         DATA     WRTDBG2
         DATA     WRTDBG2
         END

