***********************************************************************
*M*      DEBUGR   PROCESSES ALL DEBUG AND THE INCL CONTROL COMMANDS
************************************************************************
*P*
*P*      NAME:        DEBUGR
*P*
*P*      PURPOSE:     TO PROCESS THE FOLLOWING CONTROL COMMANDS:
*P*                   INCL, MODIFY, PMD, PMDE, PMDI, SNAP, SNAPC,
*P*                   IF, AND, OR, COUNT.
*P*
*P*      DESCRIPTION: SEE FUNCTION PREAMBLES FOR THE ABOVE
*P*                   MENTIONED CONTROL COMMANDS.
*P*
*P*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*P*                   BATCH PROCESSING REFERENCE MANUAL.
       CSECT       1
         SYSTEM   SIG7FDP
       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
         PAGE
         DEF      INCLR             PROCESS INCLUDE CONTROL COMMAND
         DEF      DEFXREFR          PROCESS DEFXREF CONTROL COMMAND
         DEF      MODFYR            PROCESS MODIFY CONTROL COMMAND
         DEF      PMDR              PROCESS PMD, PMDE, PMDI CONTROL
*,*                                 COMMANDS
         DEF      SNAPR             PROCESS SNAP,SNAPC CONTROL COMMANDS
         DEF      IFR               PROCESS IF,AND,OR CONTROL COMMANDS
         DEF      SEGSRCH           SEARCH TREE TABLE FOR SEGMENT NAME
         PAGE
         REF      TERMERCD          ERROR CODE CONSTANT
         REF      COMERCD           ERROR CODE CONSTANT
         REF      BLNKERCD          ERROR CODE CONSTANT
         REF      MODERCD           ERROR CODE CONSTANT
         REF      CHARSCAN          GET NEXT ACTIVE CHARACTER FROM
*,*                                 CONTROL COMMAND
         REF      ILSEGNCD          ERROR CODE CONSTANT
         REF      PLB               INPUT-HOLDS MOST RECENT CHARACTER
*,*                                 STRING SCANNED
         REF      CSL               INPUT-HOLDS CHARACTER STRING LENGTH
         REF      CHSTSHFT          SHIFT CHARACTER STRING AND INSERT BYTE
*,*                                 COUNT
         REF      NAMSCAN           GET NAME FROM COMMAND
         REF      ALOCCT            INPUT-OFFSET INTO JIT TO OBTAIN
*,*                                 LOCCT ADDRESS
         REF      CCLTFLGS          OUTPUT-BIT 14; SET PMD FLAG IN JIT
         REF      EOCCSCAN          SCAN TO END OF CONTROL COMMAND AND
*,*                                 LIST IT
         REF      GETHEXVAL         GET HEX VALUE FROM CONTROL COMMAND
         REF      ROMTOVCD          ERROR CODE CONSTANT
         REF      NAMERCD           ERROR CODE CONSTANT
         REF      ROMTADR           INPUT-OLD ROM TABLE BASE ADDRESS
*,*                                 OUTPUT-NEW ROM TABLE BASE ADDRESS
         REF      TREETADR          INPUT-USED FOR SEARCHING TREE
*,*                                 TABLE FOR SEGMENT
         REF      TTESIZE           EQU; TREE TABLE ENTRY SIZE
         REF      ROMTESIZE         EQU; ROM TABLE ENTRY SIZE
         REF      ROMNAME           OUTPUT-OFFSET INTO ROM TABLE FOR
*,*                                 STORING NEW ROM NAME
         REF      LINKNEXTROM       OUTPUT-SET UP NEW ROM TABLE LINKS
         REF      LSTROMLINK        OUTPUT-SET UP NEW ROM TABLE LINKS
         REF      DECSCAN           GET DECIMAL VALUE FROM CONTROL COMMAND
         REF      BCDHEX            CONVERT BCD VALUE TO HEXADECIMAL
         REF      DECERCD           ERROR CODE CONSTANT
         REF      RPERCD            ERROR CODE CONSTANT
         REF      LPERCD            ERROR CODE CONSTANT
         REF      SYNTXER           ERROR CODE CONSTANT
         REF      CHSTSCAN          GET NEXT CHARACTER STRING FROM CONTROL
*,*                                 COMMAND
         REF      CHSTERCD          ERROR CODE CONSTANT
         REF      X10               MASK
         REF      FLAGS             EQU; BIT 2; SET BUFFER IN PARAMETER
*,*                                 LIST AS FULL
         REF      Y2                MASK
         REF      XF                MASK
         REF      X7FFFFFFF         MASK
         REF      X1FFFF            MASK
         REF      GETDECVAL         GET DECIMAL VALUE FROM CONTROL
*,*                                 COMMAND
         REF      COUNTID           EQU; COUNT OF DEBUG CONTROL COMMANDS
         REF      CJOB              INPUT-ADDRESS OF JIT
         REF      GETLOC            GET NEXT FIELD CONTAINING NAME FROM
*,*                                 CONTROL COMMAND
         REF      GETLOC1           GET NEXT FIELD CONTAINING NAME,
*,*                                 RESOLUTION FROM CONTROL COMMAND
         REF      GETLOC2           GET NEXT FIELD CONTAINING NAME
*,*                                 ,VALUE FROM CONTROL COMMAND
         REF      GETLOC3           GET NEXT FIELD CONTAINING NAME,
*,*                                 VALUE, RESOLUTION FROM CONTROL
*,*                                 COMMAND
         REF      M:X1              DCB USED TO WRITE OUT DEBUG FILE
         REF      CPE               OUTPUT-BIT 14; SET DEBUG FLAG IN JIT
         REF      TSTACK            INPUT/OUTPUT-PRESERVE REGISTERS
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'
KA       EQU      X'A'
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
*F*
*F*      NAME:        INCLR
*F*
*F*      PURPOSE:     TO PROCESS THE INCL CONTROL COMMAND,
*F*                   APPENDING ROMS OR LOAD MODULES TO THE
*F*                   SPECIFIED SEGMENT
*F*
*F*      DESCRIPTION: INCLR IS CALLED BY CCIR WHENEVER AN INCL
*F*                   CONTROL COMMAND IS ENCOUNTERED.  THE
*F*                   CONTROL COMMAND IS PROCESSED AND OUTPUT ON
*F*                   THE LL DEVICE. THE LOAD MODULE OR ROM
*F*                   SPECIFIED ON THE COMMAND IS APPENDED TO THE
*F*                   SPECIFIED SEGMENT BY BEING INCLUDED IN THE
*F*                   LOCCT. UPON COMPLETION OF PROCESSING THE
*F*                   COMMAND, CONTROL IS RETURNED TO CCIR.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*                   BATCH PROCESSING REFERENCE MANUAL.
*F*
**********************************************************************
*        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      %
*E*      MESSAGE: ILLEGAL ALPHANUMERIC NAME.
*E*      DESCRIPTION: THE SPECIFIED NAME CONTAINED AN ILLEGAL CHARACTER.
         LI,SR3   NAMERCD
         B        INCLR18
*
INCLR12  EQU      %
*E*      MESSAGE: EXPECTED TERMINATOR MISSING.
*E*      DESCRIPTION: THE CONTROL COMMAND WASN'T TERMINATED BY A
*E*               PERIOD, END OF BUFFER (X'26') OR CARRIAGE RETURN.
         LI,SR3   TERMERCD
         B        INCLR20
*
INCLR14  EQU      %
*E*      MESSAGE:     TOO MANY EFS
         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
*E*      MESSAGE:     EXPECTED COMMA MISSING.
         PULL     R1                ADJUST
DEFXREF3 EQU      %
         PULL     R1                     TEMP
         PULL     R1                         STACK
         MTW,1    *TSTACK           BUMP FOR ERROR RETURN
         B        DEFXREF1
         PAGE
*F*
*F*      NAME:        MODFYR
*F*
*F*      PURPOSE:     TO PROCESS THE MODIFY CONTROL COMMANDS AND
*F*                   BUILD THE MODIFY TABLE.
*F*
*F*      DESCRIPTION: MODFYR IS CALLED BY CCIR WHENEVER A MODIFY
*F*                   CONTROL COMMAND IS ENCOUNTERED. THE
*F*                   CONTROL COMMAND IS PROCESSED AND OUTPUT ON
*F*                   THE LL DEVICE. THE PARAMETERS ON THE
*F*                   CONTROL COMMAND ARE USED TO GENERATE A
*F*                   MODIFY TABLE WHICH IS SUBSEQUENTLY READ BY
*F*                   THE MONITOR. UPON COMPLETION OF PROCESSING
*F*                   THE COMMAND, CONTROL IS RETURNED TO CCIR.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*                   BATCH PROCESSING REFERENCE MANUAL.
*F*
**********************************************************************
*        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
         LB,R2    *R4               ABORT IF LOCATIONS MODIFIED EXCEED 255
         MTB,0    *R4,R2
         BEZ      MODFYR28          IF=0 ABORT
*
         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
*
MODFYR28 EQU      %
*E*      MESSAGE: MAXIMUM NUMBER OF MODIFICATIONS EXCEEDED
*E*
*E*      DESCRIPTION: THE NUMBER OF LOCATIONS BEING MODIFIED
*E*                   EXCEEDED 255.
*E*
         LI,SR3   MODERCD
         B        MODFYR41
*
MODFYR30 EQU      %
*E*      MESSAGE:     EXPECTED COMMA MISSING.
         LI,SR3   COMERCD
         B        MODFYR40
*
MODFYR32 EQU      %
*E*      MESSAGE:     EXPECTED TERMINATOR MISSING.
*E*
*E*      DESCRIPTION: THE CONTROL COMMAND WASN'T TERMINATED
*E*                   BY A PERIOD, END OF BUFFER (X'26')
*E*                   OR CARRIAGE RETURN.
         LI,SR3   TERMERCD
         B        MODFYR41
*
MODFYR40 EQU      %
         PULL     R1
MODFYR41 EQU      %
         PULL     R1
         PULL     R1
         MTW,1    *TSTACK
         B        MODFYR6
         PAGE
*F*
*F*      NAME:        PMDR
*F*
*F*      PURPOSE:     TO PROCESS THE PMD, PMDE, AND PMDI CONTROL
*F*                   CONTROL COMMANDS AND BUILD THE PMD TABLE.
*F*
*F*      DESCRIPTION: PMDR IS CALLED BY CCIR WHENEVER A PMDE
*F*                   (PMDI, PMD) CONTROL COMMAND IS ENCOUNTERED.
*F*                   THE CONTROL COMMAND IS PROCESSED AND OUTPUT
*F*                   ON THE LL DEVICE. THE PARAMETERS ON THE
*F*                   CONTROL COMMAND IS USED TO GENERATE A PMD
*F*                   TABLE WHICH IS SUBSEQUENTLY READ BY THE
*F*                   MONITOR. UPON COMPLETITION OF PROCESSING THE
*F*                  COMMAND, CONTROL IS RETURNED TO CCIR.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*                   BATCH PROCESSING REFERENCE MANUAL.
*F*
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      %
*E*      MESSAGE:     ILLEGAL DECIMAL NUMBER.
         LI,SR3   DECERCD
         B        PMDR50
*
PMDR42   EQU      %
*E*      MESSAGE:     EXPECTED RIGHT PARENTHESIS MISSING.
         LI,SR3   RPERCD
         B        PMDR50
*
PMDR44   EQU      %
*E*      MESSAGE: EXPECTED LEFT PARENTHESIS MISSING
         LI,SR3   LPERCD
         B        PMDR50
*
PMDR46   EQU      %
*E*      MESSAGE:     SYNTAX ERROR.
         LI,SR3   SYNTXER
         B        PMDR50
*
PMDR48   EQU      %
*E*      MESSAGE:     EXPECTED COMMA MISSING.
         LI,SR3   COMERCD
*
*
PMDR50   EQU      %
         PULL     R1
PMDR51   EQU      %
         PULL     R1
         PULL     R1
         MTW,1    *TSTACK
         B        PMDR14
         PAGE
*F*
*F*      NAME:        SNAPR
*F*
*F*      PURPOSE      TO PROCESS THE SNAP AND SNAPC CONTROL
*F*                   COMMANDS AND BUILD THE SNAP TABLE.
*F*
*F*      DESCRIPTION: SNAPR IS CALLED BY CCTR WHENEVER A SNAP
*F*                   (SNAPC) CONTROL COMMAND IS ENCOUNTERED.
*F*                   THE CONTROL COMMAND IS PROCESSED AND
*F*                   OUTPUT ON THE LL DEVICE. THE PARAMETERS
*F*                   ON THE CONTROL COMMAND ARE USED TO
*F*                   GENERATE A SNAP, SNAPC TABLE WHICH IS
*F*                   SUBSEQUENTLY READ BY THE MONITOR. UPON
*F*                   COMPLETITION OF PROCESSING THE COMMAND,
*F*                   CONTROL IS RETURNED TO CCIR.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*                   BATCH PROCESSING REFERENCE MANUAL.
*F*
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      %
*E*      MESSAGE:     ILLEGAL CHARACTER STRING.
         LI,SR3   CHSTERCD
         B        SNAPR30
*
SNAPR22  EQU      %
*E*      MESSAGE:     EXPECTED COMMA MISSING.
         LI,SR3   COMERCD
         B        SNAPR30
*
SNAPR24  EQU      %
*E*      MESSAGE:     EXPECTED LEFT PARENTHESIS MISSING.
         LI,SR3   LPERCD
         B        SNAPR30
*
SNAPR26  EQU      %
*E*      MESSAGE:     EXPECTED RIGHT PARENTHESIS MISSING.
         LI,SR3   RPERCD
         B        SNAPR30
*
SNAPR28  EQU      %
*E*      MESSAGE: EXPECTED TERMINATOR MISSING.
*E*      DESCRIPTION: THE CONTROL COMMAND WASN'T TERMINATED BY A
*E*               PERIOD, END OF BUFFER (X'26') OR CARRIAGE RETURN.
         LI,SR3   TERMERCD
*
SNAPR30  EQU      %
         BUMP     -3,R1
         MTW,1    *TSTACK
         B        SNAPR10
SNAPR34  EQU      %                                                     737
         PUSH     R3                                                    737
         B        SNAPR30                                               737
         PAGE
*F*
*F*      NAME:        IFR
*F*
*F*      PURPOSE:     TO PROCESS THE IF, AND, OR OR COUNT
*F*                   CONTROL COMMANDS AND BUILD THE APPROPRIATE
*F*                   TABLE FOR THE COMMAND.
*F*
*F*      DESCRIPTION: IFR IS CALLED BY CCIR WHENEVER AN IF (AND
*F*                   OR, COUNT) CONTROL COMMAND IS ENCOUNTERED.
*F*                   THE CONTROL COMMAND IS PROCESSED AND OUTPUT
*F*                   ON THE LL DEVICE. THE PARAMETERS ON THE
*F*                   COUNT CONTROL COMMAND ARE USED TO GENERATE
*F*                   A COUNT TABLE. THE PARAMETERS ON THE IF,
*F*                   AND OR OR COMMANDS ARE USED TO
*F*                   GENERATE AN IF, AND, OR TABLE. BOTH
*F*                   TABLES GENERATED ARE SUBSEQUENTLY READ BY
*F*                   THE MONITOR. UPON COMPLETION OF PROCESSING
*F*                   THE COMMAND, CONTROL IS RETURNED TO CCTR.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*                   BATCH PROCESSING REFERENCE MANUAL.
*F*
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      %
*E*      MESSAGE:     ILLEGAL CHARACTER STRING.
*E*
*E*      DESCRIPTION: THE VALUE SPECIFYING THE TYPE OF
*E*                   COMPARISON TO BE MADE WAS ILLEGAL.
         LI,SR3   CHSTERCD
         B        IFR50
*
IFR32    EQU      %
*E*      MESSAGE:     EXPECTED COMMA MISSING.
         LI,SR3   COMERCD
         B        IFR50
*
IFR34    EQU      %
*E*      MESSAGE:     EXPECTED LEFT PARENTHESIS MISSING.
         LI,SR3   LPERCD
         B        IFR50
*
IFR36    EQU      %
*E*      MESSAGE:     ILLEGAL DECIMAL NUMBER.
         LI,SR3   DECERCD
         B        IFR50
*
IFR38    EQU      %
*E*      MESSAGE:     ILLEGAL ALPHANUMERIC NAME.
         LI,SR3   NAMERCD
         B        IFR50
*
IFR40    EQU      %
*E*      MESSAGE:     EXPECTED RIGHT PARENTHESIS MISSING.
         LI,SR3   RPERCD
         B        IFR50
*
IFR42    EQU      %
*E*      MESSAGE:     SYNTAX ERROR.
         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    KA                CHECK IF SEGMENT NAME <= 10 CHAR
         BG       SEGSRCH4          ERROR IF NOT <= 10 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      %
*E*      MESSAGE:     ILLEGAL SEGMENT NAME.
*E*
*E*      DESCRIPTION: THE SEGMENT NAME SPECIFIED IS GREATER
*E*                   THAN 10 CHARACTERS.
         LI,SR3   ILSEGNCD
         B        SEGSRCH7
SEGSRCH5 EQU      %
*E*      MESSAGE:     ILLEGAL ALPHANUMERIC NAME.
         LI,SR3   NAMERCD
         B        SEGSRCH7
SEGSRCH6 EQU      %
*E*      MESSAGE:     EXPECTED COMMA MISSING.
         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

