*COMDECK DBG=IDP
 DBG=IDP  CTEXT  DBG=IDP - INTERACTIVE AND BATCH DEBUG PACKAGES.
 DBG=IDP  SPACE  4,8
          IF     -DEF,QUAL$,1 
          QUAL   DBG=IDP
          BASE   D
                                                                        000190
 IDP      MICRO  1,,/"QUAL"/                                            000200
 DBG=IDP  SPACE  4,8
**        DBG=IDP - INTERACTIVE AND BATCH DEBUG PACKAGES. 
* 
* 
*                CONTAINS THE INTERACTIVE DEBUG PACKAGE (IDP=), WHICH 
*         PLACES A HOST PROGRAM IN INTERACTIVE MODE; AND THE 2 BATCH
*         DEBUGGING ROUTINES (REG=,SNP=), WHICH PROVIDE REGISTER AND
*         CORE SNAPSHOT DUMPS.
* 
*            IN THE SECTIONS THAT FOLLOW, *ASSEMBLY-TIME DEPENDENCIES*
*         ARE DEFINED TO BE THE INTERFACES THAT THE IDP INSTALLER MUST
*         PROVIDE; *ASSEMBLY-TIME OPTIONS* ARE THOSE INTERFACES WHICH 
*         ARE OPTIONAL, I.E. INTERFACES THAT HAVE DEFAULT CONDITIONS. 
*            IN THE CASE WHERE THE USER PROVIDES A SUBROUTINE THAT WILL 
*         BE CALLED BY IDP, THE *ENTRY* AND *EXIT* CONDITIONS ARE SHOWN.
*         IN ADDITION, THE REGISTERS THAT CANNOT BE ALTERED BY THE USER 
*         SUBROUTINE ARE SPECIFIED VIA *LOCKED*.  (B1) ARE ASSUMED TO BE
*         EQUAL TO 1 (LOCKED), AND WILL THEREFORE NOT BE MENTIUNED
*         AGAIN.
* 
************************************************************************000153
*                                                                       000154
*         ASSEMBLY-TIME DEPENDENCIES--
* 
************************************************************************000170
*                                                                       000180
*         COMDECKS NEEDED BY *DBG=IDP*.  ALTHOUGH THESE COMDECKS        000190
*         ARE NOT ALL STRICTLY ASSEMBLY-TIME DEPENDENCIES (I.E. SOME CAN000200
*         BE SATISFIED AT LOAD-TIME), THE POINT IS THAT THEY ALL HAVE   000210
*         TO BE AROUND FOR *DBG=IDP* TO WORK.  SOME ARE THE CLASSIC     000220
*         *KRONOS* COMDECKS AND SOME ARE NEW.  ALL CAN BE FOUND ON      000230
*         THE *FTN* OLDPL OR ON *CPUTEXT*.  (COMMON COMDECKS ARE AFOOT).000240
*                                                                       000250
*         WARNING-- IT IS SUGGESTED THAT THE IDP INSTALLER PROVIDE      000260
*         SEPARATE COPIES OF CODE COMDECKS FOR *DBG=IDP*, EVEN          000270
*         IF THE HOST ALREADY HAS COPIES OF THESE COMDECKS.             000280
*         THIS WILL AVOID PROBLEMS THAT CAN OCCUR IN *STEP*             000290
*         MODE WHEN IDP TRIES TO STEP COMDECKS THAT IT IS               000300
*         USING ITSELF.                                                 000310
*                                                                       000320
*         ACTCOM    COMACIO   COMADEF   COMAFET   COMAREG               000330
*                                                                       000340
*         COMCCDD   COMCCIO   COMCCOD   COMCDXB   COMCRDC   COMCRDW     000350
*         COMCSVR   COMCWTC   COMCWTW                                   000360
*                                                                       000370
*         COMSRAS                                                       000380
************************************************************************
* 
*         ASSEMBLY-TIME OPTIONS-- 
* 
************************************************************************
*                                                                       000240
*         CP.NFLS - NOMINAL FIELD LENGTH SCM.                           000250
*                                                                       000260
*         IF THE SYMBOL *CP.NFLS* IS DEFINED (DEF), THEN IT IS THE      000270
*         ADDR OF THE SCM LOCATION THAT CONTAINS THE CURRENT NOMINAL    000280
*         FIELD LENGTH SCM FOR THE HOST PROGRAM.  THIS OPTION IS        000290
*         INTENDED FOR HOST PROGRAMS THAT PERFORM THEIR OWN MEMORY      000300
*         MANAGEMENT.  IF *CP.NFLS* IS DEFINED, THEN *IDP* USES ITS     000310
*         CONTENTS FOR ADDR LEGALITY CHECKS AND ASSUMES THAT THE HOST   000320
*         IS KEEPING IT UPDATED.                                        000330
*                                                                       000340
*                0 .LE. LEGAL ADDR .LT. (CP.NFLS)                       000350
*                                                                       000360
*         FORMAT --                                                     000370
*                VFD   42/0,18/FL                                       000380
*                                                                       000390
*         IF THE SYMBOL *CP.NFLS* IS NOT DEFINED (-DEF), THEN *IDP*     000400
*         WILL CHECK SCM ADDRESSES USING THE FOLLOWING SCHEME--         000410
*                                                                       000420
*           1. IF BITS 0 THRU 17 OF (RA.LWP) ARE .MI., THEN *CMM*       000430
*              IS ACTIVE.  *IDP* WILL THEREFORE TRY AND FIND THE        000440
*              CURRENT FL AT (DABA), I.E. (-(RA.LWP)).  HOWEVER,        000450
*              BECAUSE *CMM* IS NOT REAL GOOD AT KEEPING *DABA*         000460
*              UPDATED PROPERLY, *IDP* WILL DOUBLE CHECK AN             000470
*              ADDR THAT *DABA* INDICATES IS OUT-OF-RANGE BY PERFORMING 000480
*              A SYSTEM *MEMORY* (*MEM* REQUEST) TO FIND OUT THE TRUE   000490
*              FL.  NOTE-- *IDP* DOES NOT UNCONDITIONALLY CHECK ADDRS   000500
*              AGAINST A *MEMORY* FOR EFFICIENCY REASONS.               000510
*                                                                       000520
*           2. IF BITS 0 THRU 17 OF (RA.LWP) ARE .PL., THEN ADDRESSES   000530
*              ARE CHECKED AGAINST A *MEMORY* REQUEST.                  000540
*                                                                       000550
************************************************************************000560
* 
***              IF THE SYMBOL *EOS* IS A MICRO NAME (MIC), THEN
*         "EOS" IS A MICRO WHICH DEFINES THE INTERACTIVE
*         END-OF-STATEMENT CHARACTER.  THE USE OF THIS CHARACTER ALLOWS 
*         AN *IDP* USER TO ENTER MORE THAN ONE INTERACTIVE COMMAND ON 
*         A SINGLE LINE.
* 
*         DEFAULT IS -- 
* 
*         EOS    MICRO  1,,/;/
* 
*         E.G.   SNAP,100;REG,X1;END
* 
*         NOTE   THE END OF STATEMENT LOGIC WILL NOT WORK PROPERLY IF 
*                "EOS" IS ONE OF THE FOLLOWING 8 CHARACTERS --
*                JKLMNOPQ 
************************************************************************
* 
***          IF THE SYMBOL *FAA=* IS DEFINED (DEF), THEN *FAA= - FIND 
*         ABSOLUTE ADDRESS* IS A USER SUBROUTINE THAT WILL PROVIDE
*         *DBG=IDP* WITH AN ABSOLUTE ADDRESS ASSOCIATED WITH A *NAME*.
*         THIS OPTION IS INTENDED FOR HOST PROGRAMS THAT CONSIST OF 
*         MULTIPLE *DECK*S OR *IDENT*S, AND WHERE USERS OF *IDP* WOULD
*         LIKE TO BE ABLE TO REFERENCE ADDRESSES RELATIVE TO A
*         DECK NAME--  E.G. SNAP NAME+20,,10
*            IF *FAA=* IS DEFINED, THEN *IDP* WILL *RJ =XFAA=* TO TRY TO
*         ASSOCIATE AN ABSOLUTE ADDRESS WITH *NAME* BEFORE HE SEARCHS 
*         THE USER *SET* TABLE. 
* 
**        FAA= - FIND ABSOLUTE ADDRESS. 
* 
*         ENTRY  (X0) = MX0 7*CHAR     (CHAR=6) 
*                (X1) = 42/0LNAME, 18/0 
* 
*         EXIT   (X6) = .PL. IF ABS ADDR ASSOCIATED WITH NAME 
*                       .MI. IF NO ADDR KNOWN FOR *NAME* (I.E. NO FIND) 
* 
*         LOCKED X - 0,1
************************************************************************
* 
***          IF THE SYMBOL *FRA=* IS DEFINED (DEF), THEN *FRA= - FIND 
*         RELATIVE ADDRESS* IS A USER SUBROUTINE THAT WILL PROVIDE
*         *DBG=IDP* WITH A DISPLAY CODE (DPC) NAME AND RELATIVE OFFSET
*         ASSOCIATED WITH AN ABSOLUTE ADDRESS. THIS ROUTINE IS THE
*         LOGICAL COMPLEMENT TO *FAA=*, AND IS USED BY ROUTINES IN
*         *DBG=IDP* TO OUTPUT A MORE HUMAN READABLE ADDRESS FORMAT. 
* 
*         E.G. IN RESPONSE TO *IDP* COMMAND-- CODE NAME+10
*         1025   010001023         RJ    1023     6 IN NAME 
* 
*            IF *FRA=* IS DEFINED, WHENEVER A ROUTINE IN *DBG=IDP*
*         REQUIRES THIS RELATIVE ADDRESS PLUS OFFSET DPC FORMAT, A
*         *EQ =XFRA=* IS EXECUTED.
* 
**        FRA= - FIND RELATIVE ADDRESS. 
* 
*         ENTRY  (X1) = 60/ABS ADDR 
*                (B7) = RETURN ADDRESS-- AN *RJ =XFRA=* IS NOT USED 
*                         BECAUSE IF THE HOST PROGRAM HAS REPRIEVE
*                         PROCESSING, THEN *FRA=* COULD BE INCORPORATED 
*                         INTO IT AND EXIST IN AN AREA CHECKSUMMED
*                         BY *RPV*
* 
*         EXIT   (X6) = 1ST WORD OF DPC RESULT
*                         E.G. (X6) = NNNNNN.IN.     (.=BLANK(55B)) 
*                (X7) = 2ND WORD OF DPC RESULT  (-C- FORMAT)
*                         E.G. (X7) = XXXXXXX000     (0=00B)
* 
*         LOCKED X - 5
*                A - 0,5,6,7
************************************************************************
* 
***              IF THE SYMBOL *PROMPT* IS A MICRO NAME (MIC), THEN 
*         "PROMPT" IS A MICRO WHICH DEFINES THE INTERACTIVE PROMPT. 
*         THIS PROMPT WILL BE ISSUED WHENEVER *IDP* REQUIRES THAT THE 
*         USER ENTER A COMMAND. 
* 
*         DEFAULT IS -- 
* 
*         PROMPT MICRO  1,,/>>/ 
* 
*         NOTE - *IDP* PREFIXES THE "PROMPT" WITH A BLANK (55B) PRINT 
*                CONTROL CHARACTER. 
************************************************************************
* 
***          IF THE SYMBOL *UKT=* IS DEFINED (DEF), THEN *UKT=* IS THE
*         FWA OF THE USER KEYWORD TABLE. THIS OPTION ALLOWS THE USER TO 
*         PERFORM HER OR HIS OWN KEYWORD PROCESSING IN INTERACTIVE MODE.
*         IF *UKT=* IS DEFINED, THEN AFTER *IDP* HAS SEARCHED ITS OWN 
*         KEYWORD TABLE, IT WILL SEARCH THE USER KEYWORD TABLE AT 
*         *UKT=* ET SEQ, AND BRANCH TO THE PROCESSOR ADDRESS IF A FIND
*         IS MADE. *UKT=* FORMAT--
* 
* UKT=    BSS    0
*         VFD    42/0LKEYWORD, 18/PROCESSOR ADDR
*          .
*          .
*         DATA   0           END OF TABLE MARK
* 
*            AFTER KEYWORD PROCESSING, THE USER SHOULD BRANCH TO EITHER 
*         *IDP=MN* TO REENTER THE MAIN LOOP, OR TO *IDP=ER* TO ISSUE
*         MESSAGE *ERROR--* BEFORE REENTERING MAIN LOOP.
************************************************************************
* 
***          IF THE SYMBOL *UIO=* IS DEFINED (DEF), THEN *UIO= - USER 
*         IDP OWNCODE* IS A USER SUBROUTINE THAT IS CALLED AFTER ENTRY
*         TO *IDP=*. IT ALLOWS THE USER TO PERFORM HER OWN TASKS BEFORE 
*         ENTERING INTERACTIVE MODE (E.G. CHECKING A MASTER SNAP FLAG). 
* 
**        UIO= - USER IDP OWNCODE.
* 
*         ENTRY  NONE 
* 
*         EXIT   (X1) = .MI. IF TO ENTER INTERACTIVE MODE 
*                     = .PL. IF NOT ENTERING INTERACTIVE MODE THIS TIME 
*                              I.E. ALL REGISTERS ARE RESTORED AND
*                                   CONTROL RETURNS TO CALLER 
* 
*         LOCKED X - 5
************************************************************************
* 
***       .OS - DEFINE OPERATING SYSTEM.
* 
*         .OS = 1   KRONOS 2 OR NOS 1/TS
*         .OS = 2   SCOPE 2  (CYBER 76) 
*         .OS = 3   SCOPE 3 OR NOS 1/BE  (DEFAULT)
************************************************************************
* 
***          IF THE SYMBOL *URO=* IS DEFINED (DEF), THEN *URO= - USER 
*         REG= OWNCODE* IS A USER SUBROUTINE THAT IS CALLED AFTER ENTRY 
*         TO THE REGISTER SNAPSHOT ROUTINE *REG=* (CALLED VIA *REG* 
*         MACRO IN *DBG=MAC*). IT ALLOWS THE USER TO PERFORM HIS OWN
*         TASKS BEFORE THE REGISTER SNAPSHOT IS TAKEN (E.G. CHECKING A
*         MASTER SNAP FLAG).
* 
**        URO= - USER REG= OWNCODE. 
* 
*         ENTRY  (X5)+SN=URF = ADDRESS OF USER FLAGS                    000970
* 
*         EXIT   (X1) = .MI. IF TO PERFORM REGISTER SNAPSHOT
*                     = .PL. IF NO REGISTER SNAPSHOT THIS TIME
************************************************************************
* 
***          IF THE SYMBOL *USO=* IS DEFINED (DEF), THEN *USO= - USER 
*         SNP= OWNCODE* IS A USER SUBROUTINE THAT IS CALLED AFTER ENTRY 
*         TO THE CORE SNAPSHOT ROUTINE *SNP=* (CALLED VIA *SNAP* MACRO
*         IN *DBG=MAC*). IT ALLOWS THE USER TO PERFORM HIS OWN TASKS
*         BEFORE THE SNAPSHOT IS TAKEN (E.G. CHECKING A MASTER SNAP 
*         FLAG).
* 
**        USO= - USER SNP= OWNCODE. 
* 
*         ENTRY  (X5)+SN=USF = ADDRESS OF USER FLAGS                    000990
* 
*         EXIT   (X1) = .MI. IF SNAP TO BE TAKEN
*                     = .PL. IF NO SNAP THIS TIME 
************************************************************************
* 
***              AS A SPACE OPTIMIZATION, IF THE FOLLOWING GENERAL
*         UTILITY SUBROUTINES ARE DEFINED (DEF), THEN THEY WILL NOT BE
*         ASSEMBLED WITHIN *DBG=IDP*--
* 
*         WOD - CONVERT A FULL BINARY WORD TO OCTAL DPC.
* 
*                THIS OPTIOM APPLIES MAINLY TO HOST PROGRAMS THAT HAVE
*         *DBG=IDP* ASSEMBLED ONLY IN A TEST OR DEBUGGING CONFIGURATION,
*         BUT THAT REQUIRE THE ABOVE UTILITY SUBROUTINES UNDER ALL
*         CONFIGURATIONS, THEREBY NECESSITATING A SEPARATE COPY OF THEM.
************************************************************************
 .OS      SPACE  4,8
**        DEFINE DEFAULT OPERATING SYSTEM.
          IF     -DEF,.OS,1 
 .OS      =      3           SCOPE 3
 CHARMX   SPACE  4,8
**        CHARMX - GENERATE CHARACTER SHIFT MASK WORD.
* 
* 
* LAB     CHARMX CHAR,BIAS
* 
* MX=NR09 CHARMX (0,1,2,3,4,5,6,7,8,9)
* MX=TOKN CHARMX ("EOS",+,-,*,(,)),+7777B-1RM 
* 
*         ENTRY  LAB  = COMPASS ADDRESS FIELD OF CHARACTER SHIFT MASK 
*                         WORD
*                CHAR = A LIST OF CHARACTERS TO GENERATE SHIFT MASK FOR 
*                BIAS = CHAR BIAS (MODULO 60D)
* 
*                         IF (LAB) ARE LEFT SHIFTED *CHAR_BIAS*, THEN 
*                         SIGN BIT WILL BE ON FOR ANY CHARACTER THAT
*                         APPEARED IN *CHAR* LIST, AND OFF FOR ALL
*                         OTHERS. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          NOREF  .2,.3,.4 
  
          PURGMAC CHARMX
  
          MACRO  CHARMX,LAB,CHAR,BIAS 
* 
 .1       MICRO  1,60,/0000000000000000000000000000000000000000000000000
,00000000000/ 
* 
 CHAR     IRP    CHAR 
 .2       MICRO  1,,/CHAR/
 .3       MICCNT .2 
* 
          IFEQ   .3,1,2 
 .4       SET    1R".2" 
          SKIP   1
 .4       SET    ".2" 
* 
          IFC    NE,/BIAS//,1 
 .4       SET    .4_BIAS
* 
 .4       OCTMIC .4,2 
 .2       SET    ".4"B
* 
          IFNE   .2,0,2 
 .3       MICRO  1,.2,/".1"/
          SKIP   1
 .3       MICRO  1,,//
* 
          IFNE   .2,59,2
 .4       MICRO  .2+2,,/".1"/ 
          SKIP   1
 .4       MICRO  1,,//
* 
 .1       MICRO  1,60,/".3"1".4"/ 
 CHAR     IRP 
* 
 .2       SET    0
 LAB      BSS    0
* 
 BIT      DUP    60 
 .2       SET    .2+1 
 .3       MICRO  .2,1,/".1"/
* 
          POS    60-.2+1
          VFD    1/".3" 
 BIT      ENDD
* 
 CHARMX   ENDM
 LXQ      SPACE  4,8
**        LXQ - REDEFINE THE LEFT SHIFT INSTRUCTION.
* 
*         THIS OPDEF REDEFINES THE LEFT SHIFT INSTRUCTION TO SUPPRESS 
*         CODE GENERATION WHEN THE SHIFT COUNT IS 0, +60D OR -60D.
*         THE INSTRUCTION IS OTHERWISE UNCHANGED. 
* 
*         LXI       JK
* 
*         ENTRY  *XI* = X-REG TO BE SHIFTED 
*                *JK* = SHIFT COUNT EXPRESSION
* 
*         USES   XI 
  
  
          PURGDEF ^XQ 
          PURGDEF   LXQ 
 ^XQ      CPOP   0,200B,100B
  
 LXQ      OPDEF     I,JK
  IFNE JK,0,2 
  IFNE JK_&60D,0,1
  ^X.I JK 
  ENDM
 PRIDP    SPACE  4,8
**        PRIDP - PRINT CODED LINE ON OUTPUT FILE.
* 
* 
*         PRIDP  FWA,LEN,NRB
* 
*         ENTRY  FWA = FWA OF LINE (-C- FORMAT) 
*                LEN = LENGTH OF LINE (IN WORDS)
*                    = .ZR. IF LENGTH TO BE COMPUTED
*                NRB = NR OF BLANK LINES TO OUTPUT PRECEDING THE LINE 
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT B4,A0,X0,A5,X5 (INCLUDES ALL CALLS)
* 
*         CALLS  ROL
  
  
          PURGMAC PRIDP 
  
 PRIDP    MACRO  FWA,LEN,NRB
          =X6    FWA
          =X7    LEN
          =X4    NRB
          RJ     =XROL
 PRIDP    ENDM
 PRBDO    SPACE  4,8
**        PRBDO - PRINT CODED LINE ON BATCH DEBUG OUTPUT FILE.
* 
* 
*                IF THE USER DID NOT DEFINE A BATCH DEBUG OUTPUT FILE,
*         (F.BDO -DEF), THEN *IDP* WILL INVENT ONE AND ACCESS IT VIA
*         *PRBDO* MACRO. IF *F.BDO* IS DEFINED, THEN THE USER SUPPLIES
*         HER OWN *PRBDO*.
* 
*         PRBDO  FWA,LEN
* 
*         ENTRY  FWA = FWA OF LINE (-C- FORMAT) 
*                LEN = LENGTH OF LINE (IN WORDS)
*                    = .ZR. IF LENGTH TO BE COMPUTED
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT A0,X0,A5,X5   (INCLUDES ALL CALLS) 
* 
*         CALLS  WRITEC 
  
  
 #BDO     IF     -DEF,F.BDO 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
  
          PURGMAC PRBDO 
  
 PRBDO    MACRO  FWA,LEN
          WRITEC =XF.BDO,(FWA),(LEN)
 PRBDO    ENDM
 #OS      ENDIF 
 #BDO     ENDIF 
 MICROS   SPACE  4,8
**        DEFINE DEFAULT MICROS.
  
          IFNE   .OS,2,2
          IF     -MIC,EOS,1 
 EOS      MICRO  1,,/;/ 
  
          IFNE   .OS,2,2
          IF     -MIC,PROMPT,1
 PROMPT   MICRO  1,,/>>/
 DEFS     SPACE  4,8
**        SYMBOL DEFINITIONS. 
  
  
 CHAR     =      6           LENGTH OF CYBER CHARACTER
  
 L.BSL    =      4           NR OF CM WORDS DUMPED ON LINE (BATCH)
 L.ISL    =      2           NR OF CM WORDS DUMPED ON LINE (INTERACTIVE)
  
 L.PRB    =      0           NR OF PRECEDING BLANKS TO OUTPUT 
*                              FOR SPACING PURPOSES 
 DEFS     SPACE  4,8
**        SNAP PARAMETER LIST SYMBOL DEFINITIONS. 
*           THESE SYMBOLS DEFINE THE ORDINALS INTO THE SNAP PARAMETER 
*           LIST. (DESIRED WORD IS AT-- FWA OF PARAMETER LIST + SN=XXX) 
  
  
 SN=FRK   =      0           1ST WORD OF FREQUENCY PARAMETER LIST 
 SN=LL    =      0           LOWER LIMIT
 SN=UL    =      1           UPPER LIMIT
 SN=INC   =      2           INCREMENT
 SN=HDR   =      3           HEADER 
 SN=CNT   =      4           SNAP COUNT 
 SN=FWA   =      5           FWA
 SN=LWA   =      6           LWA
 SN=LEN   =      7           LENGTH 
 SN=URF   =      5           USER *REG* MACRO FLAGS                     001010
 SN=RRL   =      6           1ST WORD OF *RGR=* LIST FOR *REG* MACRO    001020
 SN=USF   =      8           USER *SNAP* MACRO FLAGS                    001030
 SN=SRL   =      9           1ST WORD OF *RGR=* LIST FOR *SNAP* MACRO   001040
 APL      SPACE  4,8
*         APL - DUMMY APLIST USED FOR SAVE CELLS AND *IDP* CALLS. 
  
 APL      BSSZ   SN=LEN+1 
  
          LOC    APL
  
 AP=LL    =      *+SN=LL
 AP=UL    =      *+SN=UL
 AP=INC   =      *+SN=INC 
 AP=HDR   =      *+SN=HDR 
 AP=CNT   =      *+SN=CNT 
 AP=FWA   =      *+SN=FWA 
 AP=LWA   =      *+SN=LWA 
 AP=LEN   =      *+SN=LEN 
          LOC    *O 
 DATA     SPACE  4,8
 FWAPARM  BSSZ   1           SAVE CELL FOR FWA OF PARAMETER LIST
  
  
 SNAPLNE  BSSZ   15          INTERACTIVE AND BATCH DEBUG OUTPUT LINE
*                              IMAGE AREA 
 IDPFLG   SPACE  4,8
**        IDPFLG - INTERACTIVE/BATCH MASTER CONTROL FLAG. 
* 
*                CONTAINS GLOBAL CONTROL INFORMATION THAT IS USED 
*         THROUGH OUT *DBG=IDP*.  THE FIELDS IN *IDPFLG* ARE DESCRIBED
*         BY PAIRS OF SYMBOLS OF THE FORM *IDF.XXXP* AND *IDF.XXXL*,
*         WHERE *IDF* IS THE COMMON PREFIX, *XXX* IS THE FIELD
*         DESCRIPTOR, *P* DENOTES THE RIGHT-MOST BIT OF THE FIELD, AND
*         *L* DENOTES THE LENGTH OF THE FIELD.
* 
*                FIELD DESCRIPTIONS (XXX) ARE --
* 
*         ADR  = 0  IF ADDRESSES ARE TO BE OUTPUT AS ABSOLUTE 
*              = 1  IF ADDRESSES ARE TO BE OUTPUT AS DECK RELATIVE
* 
*         BDO  = 1  IF WRITING TO BATCH DEBUG OUTPUT FILE (F.BDO),
*                     ELSE 0
* 
*         BKO  = 1  IF ECHOING/WRITING INPUT SOURCE LINE IMAGE TO 
*                     BATCH DEBUG OUTPUT FILE *F.BDO*, ELSE 0 
* 
*         FTO  = 0  IF THIS IS 1ST TIME *IDP* HAS BEEN CALLED, ELSE 1 
* 
*         IDO  = 1  IF WRITING TO INTERACTIVE DEBUG OUTPUT FILE (F.IDO),
*                     ELSE 0
* 
*         IKO  = 1  IF ECHOING/WRITING INPUT SOURCE LINE IMAGE TO 
*                     INTERACTIVE DEBUG OUTPUT FILE *F.IDO*, ELSE 0 
* 
*         INP  = 1  IF READING FROM BATCH DEBUG INPUT FILE (F.BDI)
*                     (I.E. READING FROM AN UNCONNECTED INPUT FILE) 
*              = 0  IF READING FROM INTERACTIVE DEBUG INPUT FILE (F.IDI)
* 
*         SNL  = NR OF CM WORDS TO BE DUMPED (BY *DCM*) ON A SINGLE LINE
*              = L.BSL  IN BATCH MODE 
*              = L.ISL  IN INTERACTIVE MODE 
* 
*         XEC  = 0  IF THE EXECUTIVE IS *IDP=*
*              = 1  IF THE EXECUTIVE IS *REG=*
*              = 2  IF THE EXECUTIVE IS *SNP=*
  
  
          DESCRIBE IDF. 
 IDO      DEFINE 1
 IKO      DEFINE 1
          DEFINE 1
 BDO      DEFINE 1
 BKO      DEFINE 1
          DEFINE 1
 FTO      DEFINE 1
 INP      DEFINE 1
 ADR      DEFINE 1
 XEC      DEFINE 3
          DEFINE 30 
 SNL      DEFINE 18 
  
 IDPFLG   BSSZ   1
 PAF.     SPACE  4,8                                                    000200
**        PAF. - *PATFLG* DESCRIBE/DEFINES.                             000210
                                                                        000220
                                                                        000230
          DESCRIBE PAF.,15                                              000240
 LWA      DEFINE 1                                                      000250
          DEFINE 2                                                      000260
 LEN      DEFINE 1                                                      000270
          DEFINE 11                                                     000280
 IDPTB    SPACE  4,8
**        IDPTB - COMMAND LINE TOKEN BUFFER DESCRIBE/DEFINES. 
  
  
          DESCRIBE TB.
 LAS      DEFINE 1
          DEFINE 23 
 PRS      DEFINE 18 
 LEN      DEFINE 18 
 F.BDO    SPACE  4,8
**        F.BDO - FET AND BUFFER FOR BATCH DEBUG OUTPUT FILE. 
  
 #BDO     IF     -DEF,F.BDO 
 #OS      IFNE   .OS,2
 L.BDO    =      101B        LENGTH OF BATCH OUTPUT BUFFER
  
 F.BDO    BSS    0           ** FWA OF FET ** 
 BDO      FILEC  IDPBDO,L.BDO 
 IDPBDO   BSS    L.BDO
 #OS      ENDIF 
 #BDO     ENDIF 
 CAD      SPACE  4,8                                                    000220
**        CAD - CONVERT ADDRESS FROM BINARY TO DPC.                     000230
*                                                                       000240
*                                                                       000250
*         THIS ROUTINE CONVERTS A BINARY ADDRESS (18 BITS) TO DPC       000260
*         IN ONE OF 2 WAYS --                                           000270
*                                                                       000280
*           1. IF *FRA=* (FIND RELATIVE ADDRESS) IS DEFINED .AND.       000290
*              *IDPFLG/IDF.ADRP* INDICATES THAT WE ARE TO CONVERT       000300
*              THE ADDR TO DECK RELATIVE, THEN *CAD* WILL CALL *FRA=*   000310
*              TO FIND AND CONVERT THE RELATIVE ADDRESS.                000320
*                                                                       000330
*           2. IF *FRA=* IS NOT DEFINED .OR. *IDPFLG/IDF.ADRP* INDICATES000340
*              THAT WE ARE TO CONVERT THE ADDR TO AN ABSOLUTE ADDR,     000350
*              *CAD* WILL CALL *COD* (CONVERT BINARY TO OCTAL DPC)      000360
*              TO CONVERT THE ADDR.                                     000370
*                                                                       000380
*         ENTRY  (X1) = ADDR TO CONVERT, IN BINARY.                     000390
*                                                                       000400
*         EXIT   (X6) = .NNNNNN...  IF ABSOLUTE CONVERSION              000410
*                     = ..+NNNNNN.  IF RELATIVE CONVERSION              000420
*                                                                       000430
*                       WHERE . = BLANK(55B)                            000440
*                             N = OCTAL DIGIT (ADDR IS RIGHT JUSTIFIED  000450
*                                 TO BIT 3*CHAR, LEADING 0 SUPPRESSION) 000460
*                             + = RELATIVE ADDR INDICATOR               000470
*                                                                       000480
*         USES   ALL BUT A0,X0,A5,X5,A6   (INCLUDES ALL CALLS)          000490
*                                                                       000500
*         CALLS  COD,FRA=(IF DEF)                                       000510
                                                                        000520
                                                                        000530
 CAD      SUBR               ** ENTRY/EXIT **                           000540
                                                                        000550
*         CHECK FOR AND CONVERT/FIND A RELATIVE ADDRESS.                000560
                                                                        000570
 #FRA     IF     DEF,FRA=                                               000580
          SA2    IDPFLG                                                 000590
          LX2    59-IDF.ADRP                                            000600
          PL     X2,CAD3     IF USER REQUESTED ABS CONVERSION           000610
                                                                        000620
          SB7    CAD2        (B7) = RETURN ADDR FOR *FRA=*              000630
          EQ     FRA=        FIND RELATIVE ADDRESS                      000640
                                                                        000650
*         RETURN FROM *FRA=*.  NEED TO SET UP EXIT CONDITIONS.          000660
                                                                        000670
 CAD2     SA2    =R.   +.                                               000680
          MX3    6*CHAR                                                 000690
          BX4    X3*X6       (X4) = NNNNNN0000  (.=BLANK(55B),0=00B)    000700
          IX6    X4+X2       (X6) = NNNNNN...+  (.=BLANK(55B))          000710
          LX6    -3*CHAR     (X6) = ..+NNNNNN.                          000712
          EQ     EXIT.                                                  000720
 #FRA     ENDIF                                                         000730
                                                                        000740
*         HERE IF CONVERTING TO AN ABSOLUTE ADDRESS.                    000750
                                                                        000760
 CAD3     RJ     COD         CONVERT BINARY TO OCTAL DPC                000770
          LX6    3*CHAR      (X6) = .NNNNNN...   (.=BLANK(55B))         000780
          EQ     EXIT.                                                  000790
 DBG=IDP  TITLE  BATCH AND SHARED ROUTINES. 
 CHK      SPACE  4,8
**        CHK - CHECK CM ADDRESS. 
* 
* 
*         ENTRY  (B2)   =  ADDRESS TO BE CHECKED
* 
*         EXIT   (B2)   =  .MI. IF (B2) WAS BAD 
*                       =  UNCHANGED IF OK
* 
*         USES   X - 1,2
*                A - 1
*                B - NONE    (USES B2 IF .GE. FL)                       000580
* 
*         CALLS  MEMORY                                                 000600
  
  
 CHK      SUBR               ** ENTRY/EXIT ** 
                                                                        000620
 #NFLS    IF     DEF,CP.NFLS                                            000630
          SA1    =XCP.NFLS   (X1) = CURRENT NOMINAL FL SCM              000640
          MI     B2,EXIT.    IF ADDR BAD TO START WITH
                                                                        000660
 #NFLS    ELSE                                                          000670
          SA1    RA.LWP                                                 000680
          MI     B2,EXIT.    IF ADDR IS BAD                             000690
          SX1    X1          EXTEND SIGN BIT                            000700
          PL     X1,CHK2     IF CMM NOT ACTIVE                          000710
          BX1    -X1         (X1) = DABA                                000720
          SA1    X1          (X1) = 42/STUFF,18/FL SCM                  000730
          SX2    B2                                                     000740
          SX1    X1          (X1) = FL SCM                              000750
          IX2    X2-X1       (X2) = ADDR - FL                           000760
          MI     X2,EXIT.    IF ADDR LT FL                              000770
 CHK2     BX2    X6          SAVE X6 ACROSS MEMORY MACRO                000780
          SX6    A6                                                     000790
          SA6    CHKB        SAVE A6 ACROSS MEMORY MACRO                000800
          MX6    0                                                      000810
          SA6    CHKA        CLEAR MEM REQUEST WORD                     000820
          MEMORY CM,A6,RCL   REQUEST CURRENT FIELD LENGTH               000830
          SA1    CHKB        (X1) = SAVED A6                            000840
          SA1    X1          (X1) = ((A6))                              000850
          BX6    X1                                                     000860
          SA6    A1          RESTORE A6                                 000870
          BX6    X2          RESTORE X6                                 000880
          SA1    CHKA        (X1) = 30/FL SCM,30/STUFF                  000890
          AX1    30D         (X1) = FL SCM                              000900
 #NFLS    ENDIF                                                         000910
                                                                        000920
          SX2    B2 
          IX2    X2-X1
          MI     X2,EXIT.    IF ADDR OK 
          SB2    -B2         SET TO *ADDR IS BAD* 
          EQ     EXIT.
                                                                        000940
                                                                        000950
 CHKA     BSSZ   1           REQUEST WORD FOR MEMORY MACRO              000960
 CHKB     BSSZ   1           FOR SAVING A6 ACROSS MEMORY MACRO          000970
 DAB      SPACE  4,8
**        DAB - DUMP AN -A- OR -B- REGISTER AND WHAT IT POINTS TO.
* 
* 
*         ENTRY  (B4) = 0TR, WHERE
*                            T IS REGISTER TYPE 
*                                  = 0 FOR -B- REGISTER 
*                                  = 1 FOR -A- REGISTER 
*                            R IS REGISTER NR (0-7) 
*                            E.G.  A6 WOULD BE 016
* 
*         EXIT   (B4) IS UNCHANGED
* 
*         USES   ALL BUT B4 
* 
*         CALLS  FAB,PRIDP
  
  
 DAB      SUBR               ** ENTRY/EXIT ** 
          SB6    SNAPLNE
          RJ     FAB         FORMAT -A- OR -B- REGISTER 
          PRIDP  SNAPLNE
          EQ     EXIT.
 DAR      SPACE  4,8
**        DAR - DUMP ALL REGISTERS. 
* 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  DAB,DUX,PRIDP,WOD
  
  
 DAR      SUBR   0           ** ENTRY/EXIT ** 
          SB4    B0          INITIALIZE (B4) = REGISTER COUNT, 0TR
          PRIDP  ,,L.PRB
  
          SA1    IDPFLG 
          LX1    59-IDF.IDOP
          PL     X1,DAR5     IF NOT WRITING INTERACTIVELY,
*                              PACK -A- AND -B- REGISTERS...
  
*         DUMP -B- REGISTERS. 
  
 DAR2     RJ     DAB         DUMP -B- REGISTER
          SB4    B4+B1
          SB7    007B 
          LE     B4,B7,DAR2  IF NOT DONE
  
          PRIDP  ,,L.PRB
  
*         DUMP -A- REGISTERS. 
  
 DAR3     RJ     DAB         DUMP -A- REGISTER
          SB4    B4+B1
          SB7    017B 
          LE     B4,B7,DAR3  IF NOT DONE
  
          PRIDP  ,,L.PRB
  
*         DUMP -X- REGISTERS. 
  
 DAR4     RJ     DUX         DUMP -X- REGISTER
          SB4    B4+B1
          SB7    027B 
          LE     B4,B7,DAR4  IF NOT DONE
          EQ     EXIT.
  
*         HERE IF PACKING -A- AND -B- REGISTERS IN BATCH MODE.
  
 DAR5     SB6    SNAPLNE
          RJ     FAB         FORMAT -B- REGISTER
          SB4    B4+10B 
          SB6    A6 
          RJ     FAB         FORMAT -A- REGISTER
          PRIDP  SNAPLNE
          SB4    B4-10B+1 
          SB7    007B 
          LE     B4,B7,DAR5  IF NOT DONE
  
          PRIDP  ,,L.PRB
          SB4    020B        (B4) = 0TR, WHERE T=2 (X REG)
          EQ     DAR4 
 DCM      SPACE  4,8
**        DCM - DUMP CENTRAL MEMORY.
* 
* 
*                CONVERTS CM WORDS TO OCTAL DPC AND DUMPS THEM IN THE 
*         FOLLOWING FORMAT--
*     COL 1         1         1         1         1 
*         .NNNNNN.+.CCCCCCCCCCCCCCCCCCCC..........ETC                   000810
*                   ******************************
*         N = ADDR OF 1ST WORD DUMPED ON LINE 
*         + = + IF *NNNNNN* IS DECK RELATIVE, ELSE                      000830
*           = BLANK(55B) IF *NNNNNN* IS ABSOLUTE ADDR.                  000840
*         C = CONVERTED CM WORD 
*         . = BLANK(55B)
*         THE FORMAT OF COLS 11 THRU 40 (INDICATED BY *) IS REPEATED FOR
*           HOWEVER MANY CM WORDS ARE TO BE DUMPED ON A LINE. 
* 
*                (IDPFLG) = 42/OTHER, 18/NR OF CM WORDS TO BE DUMPED ON 
*                             A SINGLE LINE 
* 
*         ENTRY  (X2) = 18/0, 21/LEV OF IND ADDR ,21/FWA
*                (X3) = 18/0, 21/LEV OF IND ADDR ,21/LWA
*                         (X3) IS OPTIONAL
*                (X4) = 18/0,21/LEV OF IND ADDR ,21/LEN 
*                         NOTE -- IF LEN = 0, DMP IS FROM FWA TO LWA, 
*                                        ELSE DMP IS FROM FWA TO FWA+LEN
* 
*         EXIT   (B2) = .MI. IF FWA,LWA, OR LEN BAD, ELSE .PL.
* 
*         USES   ALL BUT A0  (INCLUDES ALL CALLS)                       000860
* 
*         CALLS  CAD,FLL,PRIDP,WOD                                      000880
  
  
 DCM      SUBR               ** ENTRY/EXIT ** 
          RJ     FLL         CHECK FWA,LWA, AND LENGTH
          SA1    =10H 
          MI     B2,EXIT.    IF FWA,LWA, OR LEN IS BAD
          BX6    X1 
          SB6    B0          PRESET TO *READY FOR NEW SNAP LINE*
          SA6    SNAPLNE     PRESTORE (A6) = ADDR OF LAST WORD STORED 
*                              INTO SNAP LINE.  THIS WILL FORCE A BLANK 
*                              LINE TO BE OUTPUT AS 1ST LINE OF DUMP. 
  
*         ** MAIN LOOP NODE **
  
 DCM2     SA5    AP=FWA      (X5) = ADDR OF NEXT WORD TO DUMP 
          SA2    A5+B1       (X2) = LWA OF DUMP 
          IX3    X2-X5
          SX7    X5+B1
          MI     X3,DCM6     IF FINISHED
          SA7    A5 
          GT     B6,B0,DCM3  IF MORE WORDS TO DUMP ON THIS LINE 
  
*         HERE IF READY TO OUTPUT OLD LINE AND START NEW LINE BY
*           SETTING UP ADDR OF 1ST WORD ON LINE.
  
          MX6    0
          SA6    A6+B1       MARK EOL 
          PRIDP  SNAPLNE
  
          SX1    X5 
          RJ     CAD         CONVERT ADDR TO DPC                        000900
          SA1    IDPFLG 
          SB6    X1          (B6) = NR OF WORDS TO DUMP ON A LINE 
          SA6    SNAPLNE
          LE     B6,B0,*+4S15 IF BAD WORDS PER LINE COUNT...
  
*         HERE TO DUMP A SINGLE WORD. 
  
 DCM3     SA1    X5          (X1) = NEXT WORD TO BE DUMPED
          SA2    =10H 
          NZ     X1,DCM4     IF WORD TO DUMP IS NON-ZERO
          SX3    2R 0&2R
          SX4    2R-0&2R
          BX3    -X1*X3 
          BX4    -X1+X4 
          IX5    X3+X4
          LX6    X2 
          BX7    X2-X5       (X7) = .........0   (.=55B)  IF (X1) = +0
*                                 = ........-0   (.=55B)  IF (X1) = -0
          EQ     DCM5 
  
 DCM4     RJ     =XWOD       CONVERT A FULL BINARY WORD TO OCTAL DPC
  
 DCM5     SA6    A6+B1
          SA7    A6+B1
          SA1    =10H 
          SB6    B6-B1
          BX6    X1 
          SA6    A7+B1
          EQ     DCM2        MAIN LOOP... 
  
*         HERE IF FINISHED -- NEED TO OUTPUT FINAL WORD.
  
 DCM6     MX6    0
          SA6    A6+B1       MARK EOL 
          PRIDP  SNAPLNE
          EQ     EXIT.
 DSR      SPACE  4,8
**        DSR - DUMP SELECTED REGISTERS.
* 
* 
*                PERFORMS A SELECTED REGISTER DUMP, BASED ON A PARAMETER
*         LIST SET UP BY *SNAP* AND/OR *REG* MACROS.
* 
*                0TR = REGISTER DESIGNATOR
*                            T = REGISTER TYPE
*                              = 0 FOR -B- REGISTER 
*                              = 1 FOR -A- REGISTER 
*                              = 2 FOR -X- REGISTER 
*                            R = REGISTER NR (0-7)
*                              E.G. A3 WOULD BE 013B
*                SV=B = FWA OF REGISTER SAVE AREA 
* 
*         PARAMETER LIST FORMAT-- 
* 
*         VFD    60/SV=B+0TR
*         VFD    60/SV=B+0TR
*                 . 
*                 . 
*                60/0        END OF PARAMETER LIST
* 
*         ENTRY  (A1,X1) = ADDR + CNTS OF 1ST WORD OF PARAMETER LIST
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  DAB,DUX
  
  
 DSR      SUBR               ** ENTRY/EXIT ** 
  
 DSR2     ZR     X1,EXIT.    IF FINISHED DUMPING SELECTED REGISTERS 
          SB2    =XSV=B 
          SB3    X1 
          SX6    A1+
          SB4    B3-B2
          SB5    20B
          SA6    DSRA        SAVE (A1) = CURRENT POSITION IN PARM LIST
          GE     B4,B5,DSR3  IF -X- REGISTER DUMP 
          RJ     DAB         DUMP -A- OR -B- REGISTER 
          EQ     DSR4 
  
 DSR3     RJ     DUX         DUMP -X- REGISTER
  
 DSR4     SA1    DSRA 
          SA1    X1+1 
          EQ     DSR2 
  
  
 DSRA     BSSZ   1           SAVED (A1) = ADDR OF NEXT REGISTER PARAME- 
*                              TER WORD 
 DUX      SPACE  4,8
**        DUX - DUMP AN -X- REGISTER. 
* 
* 
*         ENTRY  (B4) = 0TR, WHERE
*                            T IS REGISTER TYPE (2=X REGISTER)
*                            R IS REGISTER NR (0-7) 
*                              E.G. X1 WOULD BE 021B
* 
*         EXIT   (B4) IS UNCHANGED
* 
*         USES   ALL BUT B4 
* 
*         CALLS  PRIDP,WOD
  
  
 DUX      SUBR               ** ENTRY/EXIT ** 
          SA1    B4+SV=B
          SA2    DUXA 
          SX7    B4-20B      (X7) = X REGISTER NR 
          LX7    2*CHAR-1*CHAR
          IX6    X2+X7       (X6) = 10H       XN  , WHERE N=0 THRU 7
          SA6    SNAPLNE
          RJ     =XWOD       CONVERT ONE FULL BINARY WORD TO OCTAL DPC
          SA6    A6+B1
          SA7    A6+B1
          SA1    =10H 
          SA2    B4+SV=B     (X2) = CONTENTS OF X-N-
          BX6    X1 
          LX7    X2 
          SA6    A7+B1
          SA7    A6+B1
          BX6    X6-X6
          SA6    A7+B1       MARK EOL 
          PRIDP  SNAPLNE
          EQ     EXIT.
  
  
 DUXA     DATA   10H       X0 
 FAB      SPACE  4,8
**        FAB - FORMAT AN -A- OR -B- REGISTER.
* 
* 
*                THIS ROUTINE WILL FORMAT AN -A- OR -B- REGISTER
*         SUITABLE FOR PRINTING. FORMAT-- 
* 
*    (B6)+0         0         0         0         0         0 
*         .......TR..NNNNNN.....C(TR).=.NNNNNNNNNNNNNNNNNNNN
* 
*         T=REGISTER TYPE (B,A),R=REGISTER NR (0-7),.=BLANK(55B)
* 
*         ENTRY  (B4) = 0TR, WHERE
*                            T IS REGISTER TYPE (B=0,A=1) 
*                            R IS REGISTER NR (0-7) 
*                (B6) = FWA TO STORE
* 
*         EXIT   (B4) = UNCHANGED 
*                (B6) = UNCHANGED 
*                (A6) = ADDR OF FULL ZERO WORD EOL MARKER 
* 
*         USES   X - ALL     (INCLUDES ALL CALLS) 
*                A - ALL BUT A0 
*                B - 2,3,4,5
* 
*         CALLS  CHK,COD,WOD
  
  
 FAB      SUBR               ** ENTRY/EXIT ** 
          SX1    B4 
          MX0    -3 
          SA5    SV=B+B4     (X5) = SAVED (TR)   (T=REG TYPE,R=REG NR)
          BX6    X0*X1       (X6) = REG TYPE (B=00B,A=10B)
          SB5    B4          SAVE (B4) = 0TR
          BX7    -X0*X1      (X7) = REG NR (0-7)
          LX6    -3 
          SA2    FABA+X6
          SA3    FABB+X6
          LX7    2*CHAR-1*CHAR
          IX6    X2+X7       (X6) = .......TR.   (.=BLANK,T=RTYPE,R=RNR)
          LX7    5*CHAR-2*CHAR
          SA6    B6 
          MX0    -18
          IX7    X3+X7       (X7) = ..C(TR).=.
          BX1    -X0*X5 
          SA7    B6+2 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          LX6    9*CHAR-6*CHAR
          SB4    B5          RESTORE (B4) 
          SA6    A6+B1
          SB2    X5 
          RJ     CHK         CHECK CM ADDRESS 
          PL     B2,FAB2     IF ADDR OK 
          SA1    =20H ** OUT OF RANGE **
          SA2    A1+B1
          BX6    X1 
          LX7    X2 
          EQ     FAB3 
  
*         HERE TO CONVERT C(TR) TO OCTAL DPC. 
  
 FAB2     SA1    B2          (X1) = C(TR) 
          RJ     WOD         CONVERT A FULL BINARY WORD TO OCTAL DPC
  
 FAB3     SA6    A7+B1
          SA7    A6+B1
          MX6    0
          SA6    A7+B1       MARK EOL 
          EQ     EXIT.
  
  
 FABA     DATA   10H       B0  NNNNNN 
          DATA   10H       A0  NNNNNN 
 FABB     DATA   10H  C(B0) =  NNNNNNNNNNNNNNNNNNNN 
          DATA   10H  C(A0) =  NNNNNNNNNNNNNNNNNNNN 
 FLL      SPACE  4,8
**        FLL - CHECK FWA,LWA, AND LENGTH PARAMETERS. 
* 
* 
*         ENTRY  (X2) = 18/0, 21/LEV OF IND ADDR, 21/FWA
*                (X3) = 18/0, 21/LEV OF IND ADDR, 21/LWA
*                         (X3) IS OPTIONAL
*                (X4) = 18/0, 21/LEV OF IND ADDR, 21/LEN
*                         NOTE -- IF LEN = 0, DMP IS FROM FWA TO LWA, 
*                                        ELSE DMP IS FROM FWA TO FWA+LEN
* 
*         EXIT   (B2) = .MI. IF FWA,LWA, OR LEN WAS BAD, ELSE .PL.
*                (AP=FWA) = FWA 
*                (AP=LWA) = LWA 
* 
*         USES   X - ALL BUT X5 
*                A - 1,2,6
*                B - 2,3
* 
*         CALLS  CHK,GIL
  
  
 FLL      SUBR               ** ENTRY/EXIT ** 
  
*         CHECK FWA.
  
          LX2    -21
          SB3    X2+         (B3) = LEVEL OF INDIRECT ADDRESSING
          LX2    21          RESTORE (X2) 
          RJ     GIL         GENERATE INDIRECT LOAD (IF NECESSARY)
          MI     B2,EXIT.    IF FWA IS BAD
          SX6    B2          SAVE (B2) = FWA
          SA6    AP=FWA 
  
*         CHECK LENGTH. 
  
 FLL2     MX0    -42
          BX2    -X0*X4 
          ZR     X2,FLL3     IF NO LENGTH, USE LWA
          LX2    -21
          SB3    X2 
          LX2    21 
          RJ     GIL         GENERATE INDIRECT LOAD (IF NECESSARY)
          MI     B2,EXIT.    IF LENGTH IS BAD 
          SB2    X6+B2       (B2) = FWA + LEN 
          SB2    B2-B1       (B2) = LWA 
          RJ     CHK         CHECK CM ADDR
          MI     B2,EXIT.    IF LWA IS BAD
          SX6    B2          SAVE (B2) = LWA
          SA6    A6+B1
          EQ     EXIT.
  
*         CHECK LWA.
  
 FLL3     BX2    X3 
          LX2    -21
          BX7    -X0*X3 
          SB3    X2 
          SX4    B1          (X4) = DEFAULT LEN IS 1, IF LEN AND LWA =0 
          LX2    21 
          ZR     X7,FLL2     IF NO LWA, DEFAULT LEN=1 
          RJ     GIL         GENERATE INDIRECT LOAD (IF NECESSARY)
          MI     B2,EXIT.    IF LWA IS BAD
          SX6    B2          SAVE (B2) = LWA
          SA6    A6+B1
          EQ     EXIT.
 FRK      SPACE  4,8
**        FRK - CHECK FREQUENCY PARAMETERS. 
* 
* 
*         ENTRY  (X5)   =  FWA OF SNAP PARAMETER LIST 
* 
*         FREQUENCY PARAMETER LIST AT (X5)+SN=FRK --
* 
*         VFD    60/LOWER LIMIT (LL)
*         VFD    60/UPPER LIMIT (UL)
*         VFD    60/INCREMENT  (INC)
*         VFD    60/10HNAME 
*         VFD    60/SNAP COUNT
* 
*         EXIT   (X5)   =  .ZR. IF NO SNAP THIS TIME, ELSE UNCHANGED
* 
*         USES   X - ALL     (BUT X5 IF SNAP THIS TIME) 
*                A - 1,2,3,4
*                B - 7
* 
*         CALLS  NONE 
  
  
 FRK.NO   SX5    0
  
 FRK      SUBR               ** ENTRY/EXIT ** 
          SA1    X5+SN=LL    (X1) = LL
          SA2    A1+B1       (X2) = UL
          SA3    A2+B1       (X3) = INC 
          SA4    X5+SN=CNT   (X4) = SNAP COUNT
          MI     X1,FRK.NO   IF LL BAD
          MI     X2,FRK.NO   IF UL BAD
          MI     X3,FRK.NO    IF INC BAD
          SX6    X4+B1       (X6) = SNAP COUNT + 1
          SA6    A4+
          IX7    X6-X1       (X7) = SNAP CNT - LOWER LIMIT
          MI     X7,FRK.NO   IF NOT TIME TO SNAP YET
          IX7    X2-X6       (X7) = UPPER LIMIT - SNAP COUNT
          PX3    X3 
          MI     X7,FRK.NO   IF PAST UPPER LIMIT
  
*         COMPUTE  (COUNT/INC)*INC-COUNT. 
  
          PX6    X6 
          NX3    X3 
          NX6    X6 
          FX7    X6/X3
          UX7    X7,B7
          LX7    X7,B7
          PX7    X7 
          NX7    X7 
          FX7    X7*X3
          IX7    X7-X6
          NZ     X7,FRK.NO   IF NOT AT A SNAP INCREMENT 
          EQ     EXIT.       SNAP SHOULD BE HONORED...
 GIL      SPACE  4,8
**        GIL - GENERATE INDIRECT LOAD. 
* 
* 
*                GENERATES 0 THRU N INDIRECT LOADS, CHECKING THE ADDRESS
*         TO BE LOADED BEFORE EACH LOAD.
* 
*         ENTRY  (X2) = ADDRESS (BITS 59-18) IGNORED) 
*                (B3) = LEVEL OF INDIRECT ADDRESSING, 
*                         (B3) = 0 MEANS DIRECT ADDRESSING
* 
*         EXIT   (B2) = ADDRESS AT END OF INDIRECT CHAIN, IF (B2) .PL.
*                       IF (B2) .MI., ONE OF THE ADDRESSES WAS BAD
* 
*         USES   X - 1,2
*                A - 1,2
*                B - 2,3
* 
*         CALLS  CHK
  
  
 GIL      SUBR               ** ENTRY/EXIT ** 
  
 GIL2     SB2    X2 
          SB3    B3-B1
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,EXIT.    IF ADDR IS BAD 
          SA2    B2+
          GE     B3,B0,GIL2  IF MORE LEVELS OF INDIRECT ADDRESSING TO GO
          EQ     EXIT.
 HDR      SPACE  4,8
**        HDR - PRINT SNAP HEADER.
* 
* 
*                PRINTS A SNAP HEADER OF THE FORM-- 
* 
* NAME      SNAP NR  NNNNNN    CALLED BY NNNNNN IN XXXXXXX
* 
*         ENTRY  (A5,   =  ADDR OF CALLER 
*                    X5)=  FWA OF PARAMETER LSIT
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT A5,X5
* 
*         CALLS  CDD,FRA=,PRIDP 
  
  
 HDR      SUBR               ** ENTRY/EXIT ** 
          SA1    X5+SN=HDR
          SA4    X5+SN=CNT
          ZR     X1,EXIT.    IF NO HEADER TO BE GENERATED 
          MX0    8*CHAR 
          BX6    X0*X1
          SX7    2R 
          BX6    X6+X7
          LX6    -2*CHAR     (X6) = 10H  NAME 
          SA6    SNAPLNE
          SA2    HDRA 
          SA3    A2+B1
          SX1    X4 
          BX6    X2 
          LX7    X3 
          SA6    A6+B1
          SA7    A6+2 
          RJ     =XCDD       CONVERT BINARY TO DECIMAL DPC
          BX6    X4 
          SA6    A6+B1
          SX1    A5 
  
 #FRA     IF     DEF,FRA= 
          SB7    HDR2        (B7) = RETURN ADDR FOR *FRA=*
          EQ     =XFRA=      FIND RELATIVE ADDRESS
  
 HDR2     BSS    0
  
 #FRA     ELSE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          BX6    X4 
          MX7    0
 #FRA     ENDIF 
  
          SA6    A7+B1
          SA7    A6+B1
          PRIDP  SNAPLNE,,L.PRB 
          EQ     EXIT.
  
  
*         DATA   10H  SNAPNAME
 HDRA     DATA   10H SNAP NR
*         DATA   10HNNNNNN
          DATA   10HCALLED BY 
*         DATA   10HNNNNNN IN 
*         DATA   10CXXXXXXX 
 REG      SPACE  4,8
**        REG - REGISTER SNAPSHOT.
* 
* 
*                CALLED BY *REG* MACRO. 
* 
*         ENTRY  LOWER HALF OF *RJ REG=* WORD HAS FWA OF PARAMETER LIST.
* 
* +       RJ     REG= 
* -       VFD    30/FWA OF PARAMETER LIST 
* 
*         PARAMETER LIST EXISTS IN LOCAL BLOCK *USE DEBUG*, AS SET UP BY
*         *REG* MACRO (SEE *DBG=MAC*) --
* 
*         VFD    60/LOWER LIMIT (LL)
*         VFD    60/UPPER LIMIT (UL)
*         VFD    60/INCREMENT (INC) 
*         VFD    60/10HNAME  (OR .ZR. IF NO NAME) 
*         VFD    60/0        (USED BY *FRK* TO KEEP SNAP COUNT) 
*         VFD    60/USER FLAGS                                          001060
*         VFD    60/REGISTER DUMP FLAG
*                 . 
*                 . 
*         VFD    60/REGISTER DUMP FLAG
*                .ZR. = NO REGISTER DUMP  (OR END OF REGISTER LIST) 
*                .MI. = DUMP ALL REGISTERS
*                .GT.0 = ADDR OF REGISTER SAVE WORD FOR REGISTER TO DMP 
* 
*         EXIT   NONE 
* 
*         USES   NONE        (ALL REGISTERS ARE SAVED AND RESTORED) 
* 
*         CALLS  DAR,DSR,FRK,HDR,RSR=,SOB,SVR=,URO=(IF DEF) 
  
  
 REG=     SUBR               ** ENTRY/EXIT ** 
          RJ     =XSVR=      SAVE ALL REGISTERS 
          SX1    1           SET TO *EXECUTIVE IS /REG=/* 
          RJ     SOB         SET OUTPUT BIT FLAGS 
          SA4    REG=        (X4) = 30/EQ CALLING ADDRESS+1, 30/0 
          LX4    30 
          SA5    X4-1        (A5,X5) = ADDR + CNTS OF CALLING *RJ*
          SX6    X5          (X6) = FWA OF PARAMETER LIST 
          SA6    FWAPARM
                                                                        001110
 #URO     IF     DEF,URO=                                               001120
          RJ     =XURO=      USER REG= OWNCODE                          001130
          PL     X1,REG3     IF NO REGISTER SNAPSHOT THIS TIME          001140
 #URO     ENDIF                                                         001150
                                                                        001160
          SA5    FWAPARM     (X5) = FWA OF PARAMETER LIST               001165
          RJ     FRK         CHECK FREQUENCY PARAMETERS 
          ZR     X5,REG3     IF NOT SNAPPING THIS TIME
          RJ     HDR         OUTPUT SNAP HEADER 
          SA5    FWAPARM
          SA1    X5+SN=RRL   (A1,X1) = ADDR + CNTS OF 1ST REGISTER DUMP 
*                              PARAMETER WORD 
          PL     X1,REG2     IF NOT DUMPING ALL REGISTERS 
          RJ     DAR         DUMP ALL REGISTERS 
          EQ     REG3 
  
 REG2     RJ     DSR         DUMP SELECTED REGISTERS
  
 REG3     RJ     =XRSR=      RESTORE ALL REGISTERS
          EQ     EXIT.
 ROL      SPACE  4,8
**        ROL - WRITE OUTPUT LINE.
* 
* 
*                SHOULD BE ACCESSED VIA *PRIDP* MACRO.  THIS ROUTINE
*         WILL OUTPUT A SINGLE LINE WITH A SPECIFIED NUMBER OF PRECEDING
*         BLANK LINES TO EITHER THE INTERACTIVE DEBUG OUTPUT FILE 
*         *F.IDO* AND/OR TO THE USERS BATCH DEBUG OUTPUT FILE 
*         (VIA *PRBDO* MACRO).
* 
*         ENTRY  (X4) = NR OF PRECEDING BLANK LINES TO OUTPUT (0=NONE)
*                (X6) = FWA OF LINE TO BE OUTPUT
*                (X7) = LEN OF LINE TO BE OUTPUT (IN WORDS) 
*                     = .ZR. IF LEN TO BE COMPUTED BY *WRITEC* (SCOPE 2)
*                (IDPFLG) --
*                  BIT IDF.IDOP = 1 IF WRITING TO *F.IDO*, ELSE 0 
*                  BIT IDF.BDOP = 1 IF WRITING TO *F.BDO*, ELSE 0 
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT B4,A0,X0,A5,X5          (INCLUDES ALL CALLS) 
* 
*         CALLS  PRBDO,WRITEC 
  
  
 ROL      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION.  SAVE CRITICAL REGISTERS TO AVOID LETTING     000280
*         HOST DESTROY THEM VIA *PRBDO* CALL.                           000290
  
          SA6    ROLA        SAVE (X6) = FWA OF LINE
          SA7    A6+B1       SAVE (X7) = LEN OF LINE
          BX6    X4 
          SX7    B4-B0
          SA6    A7+B1       SAVE (X4) = NR OF PRECEDING BLANK LINES
          SA7    A6+B1       SAVE (B4)
          SX6    A0-B0                                                  000310
          SX7    A5-B0                                                  000320
          SA6    A7+B1       SAVE (A0)                                  000330
          SA7    A6+B1       SAVE (A5)                                  000340
          BX6    X0                                                     000350
          LX7    X5                                                     000360
          SA6    A7+B1       SAVE (X0)                                  000370
          SA7    A6+B1       SAVE (X5)                                  000380
  
*         HERE TO OUTPUT APPROPRIATE NUMBER OF PRECEDING BLANK LINES. 
  
 ROL2     SA1    ROL=PRB     (X1) = NR OF PRECEDING BLANK LINES 
          SA2    IDPFLG 
          SX6    X1-1 
          MI     X6,ROL4     IF NO MORE BLANK LINES 
          LX2    59-IDF.IDOP
          SA6    A1 
          PL     X2,ROL3     IF NOT WRITING TO INTERACTIVE DEBUG OUTPUT 
  
 #OS2     IFNE   .OS,2       IF NOT SCOPE 2 
          WRITEC =XF.IDO,(=C= =),1
  
 #OS2     ELSE
          EQ     *+4S15      IF TRYING TO WRITE INTERACTIVELY...
 #OS2     ENDIF 
  
 ROL3     SA1    IDPFLG 
          LX1    59-IDF.BDOP
          PL     X1,ROL2     IF NOT WRITING TO BATCH DEBUG OUTPUT 
          PRBDO  (=C= =),1
          EQ     ROL2 
  
*         HERE TO OUTPUT LINE FINALLY.
  
 ROL4     SA1    IDPFLG 
          LX1    59-IDF.IDOP
          PL     X1,ROL5     IF NOT WRITING TO INTERACTIVE DEBUG OUTPUT 
  
 #OS2     IFNE   .OS,2       IF NOT SCOPE 2 
          SA1    ROLA        (X1) = FWA OF LINE 
          SA2    A1+B1       (X2) = LEN OF LINE 
          ZR     X1,ROL6     IF NO LINE TO OUTPUT 
          WRITEC =XF.IDO,X1,X2
  
 #OS2     ELSE
          EQ     *+4S15      IF TRYING TO WRITE INTERACTIVELY...
 #OS2     ENDIF 
  
 ROL5     SA1    IDPFLG 
          SA2    ROLA 
          SA3    A2+B1
          LX1    59-IDF.BDOP
          PL     X1,ROL6     IF NOT WRITING TO BATCH DEBUG OUTPUT 
          ZR     X2,ROL6     IF NO LINE TO OUTPUT 
          PRBDO  X2,X3
  
*         FINAL PROCESSING -- RESTORE SAVED REGISTERS.
  
 ROL6     SA1    ROL=B4 
          SA2    A1+B1                                                  000400
          SA3    A2+B1                                                  000410
          SA4    A3+B1                                                  000420
          SB4    X1          RESTORE (B4)                               000430
          SA0    X2          RESTORE (A0)                               000440
          SA5    X3          RESTORE (A5)                               000450
          SA1    A4+B1                                                  000460
          NO                                                            000470
          BX0    X4          RESTORE (X0)                               000480
          LX5    X1          RESTORE (X5)                               000490
          EQ     EXIT.
  
  
 ROLA     BSSZ   8                                                      000510
  
          LOC    ROLA 
 ROL=FWA  =      *           SAVED FWA
 ROL=LEN  =      *+1         SAVED LENGTH 
 ROL=PRB  =      *+2         SAVED PRECEDING BLANK COUNT
 ROL=B4   =      *+3         SAVED (B4) 
 ROL=A0   =      *+4         SAVED (A0)                                 000530
 ROL=A5   =      *+5         SAVED (A5)                                 000540
 ROL=X0   =      *+6         SAVED (X0)                                 000550
 ROL=X5   =      *+7         SAVED (X5)                                 000560
          LOC    *O 
 SNP      SPACE  4,8
**        SNP - SNAPSHOT OF CORE AND REGISTERS. 
* 
* 
*                CALLED BY *SNAP* MACRO.
* 
*         LOWER HALF OF *RJ SNP=* WORD HAS FWA OF PARAMETER LIST--
* 
* +       RJ     SNP= 
* -       VFD    30/FWA OF PARAMETER LIST 
* 
*         PARAMETER LIST EXISTS IN LOCAL BLOCK *USE DEBUG*, AS SET UP BY
*         BY *SNAP* MACRO. (SEE *DBG=MAC*) -- 
* 
*         VFD    60/LOWER LIMIT (LL)
*         VFD    60/UPPER LIMIT (UL)
*         VFD    60/INCREMENT (INC) 
*         VFD    60/10HNAME  (OR .ZR. IF NO NAME) 
*         VFD    60/0        (USED BY *FRK* TO KEEP SNAP COUNT) 
*         VFD    18/0,21/LVL OF INDIRECT ADDRESSING,21/FWA
*         VFD    18/0,21/LVL OF INDIRECT ADDRESSING,21/LWA
*         VFD    18/0,21/LVL OF INDIRECT ADDRESSING,21/LEN
*         VFD    60/USER FLAGS                                          001180
*         VFD    60/REGISTER DUMP FLAG
*                 . 
*                 . 
*         VFD    60/REGISTER DUMP FLAG
*                .ZR. = NO REGISTER DUMP  (OR END OF REGISTER LIST) 
*                .MI. = DUMP ALL REGISTERS
*                .GT.0 = ADDR OF REGISTER SAVE WORD FOR REGISTER TO DMP 
* 
*         USES   NONE        (ALL REGISTERS ARE SAVED AND RESTORED) 
* 
*         CALLS  DAR,DCM,DSR,FRK,HDR,RSR=,SOB,SVR=,USO=(IF DEF) 
  
  
 SNP=     SUBR               ** ENTRY/EXIT ** 
          RJ     SVR=        SAVE ALL REGISTERS 
          SX1    2           SET TO *EXECUTIVE IS /SNP=/* 
          RJ     SOB         SET OUTPUT BIT FLAGS 
          SA4    SNP=        (X4) = 30/EQ CALLING ADDRESS+1, 30/0 
          LX4    30 
          SA5    X4-1        (A5,X5) = ADDR + CNTS OF CALLING *RJ*
          SX6    X5          (X6) = FWA OF PARAMETER LIST 
          SA6    FWAPARM
                                                                        001220
 #USO     IF     DEF,USO=                                               001230
          RJ     =XUSO=      USER SNP= OWNCODE                          001240
          PL     X1,SNP4     IF NO SNAPSHOT THIS TIME                   001250
 #USO     ENDIF                                                         001260
                                                                        001270
          SA5    FWAPARM     (X5) = FWA OF PARAMETER LIST               001280
          RJ     FRK         CHECK FREQUENCY PARAMETERS 
          ZR     X5,SNP4     IF NO SNAP THIS TIME 
          RJ     HDR         OUTPUT SNAP HEADER 
          SA1    X5+SN=SRL   (A1,X1) = ADDR + CNTS OF 1ST WORD OF 
*                              REGISTER LIST
          PL     X1,SNP2     IF NOT DUMPING ALL REGISTERS 
          RJ     DAR         DUMP ALL REGISTERS 
          EQ     SNP3 
  
 SNP2     RJ     DSR         DUMP SELECTED REGISTERS
  
 SNP3     SA5    FWAPARM
          SA2    X5+SN=FWA   (X2) = 10/0,21/LVL OF IND ADDR,21/FWA
          SA3    A2+B1       (X3) = 18/0,21/LVL OF IND ADDR,21/LWA
          SA4    A3+B1       (X4) = 18/0,21/LVL OF IND ADDR,21/LEN
          RJ     DCM         DUMP CENTRAL MEMORY
  
 SNP4     RJ     =XRSR=      RESTORE ALL REGISTERS
          EQ     EXIT.
 SOB      SPACE  4,8
**        SOB - SET OUTPUT BIT FLAGS. 
* 
* 
*                THIS ROUTINE SETS BITS IN THE MASTER CONTROL FLAG, 
*         *IDPFLG*, WHICH DETERMINES WHERE OUTPUT IS TO BE WRITTEN BY A 
*         BATCH (I.E. NON-INTERACTIVE) EXECUTIVE -- 
* 
*           1. IF INTERACTIVE MODE HAS EVER BEEN ENTERED (BIT *FTO* ON),
*                THEN NO FLAGS ARE SET  (I.E. ALL FLAGS ARE AS SET BY 
*                INTERACTIVE USER VIA *OUTPUT* COMMAND).
*           2. IF INTERACTIVE MODE HAS NOT YET BEEN ENTERED 
*                (BIT *FTO* OFF), THEN SET -- 
*                  BDO = WRITING TO BATCH DEBUG OUTPUT FILE, *F.BDO*
*                  SNL = L.BSL
* 
*         ENTRY  (X1) = BITS 0 THRU *IDF.XECL-1* CONTAIN THE VALUE TO 
*                         BE PLACED IN *XEC* FIELD, 
*                         (BITS 59 THRU *IDF.XECL* ARE IGNORED).
* 
*         EXIT   (IDPFLG) UPDATED 
* 
*         USES   X - 1,2,3,4,6
*                A - 2,6
*                B - NONE 
* 
*         CALLS  NONE 
  
  
 SOB      SUBR               ** ENTRY/EXIT ** 
          SA2    IDPFLG 
          MX3    -IDF.XECL
          SX4    L.BSL
          BX1    -X3*X1 
          LX2    0-IDF.XECP 
          BX2    X3*X2       CLEAR OLD *XEC*
          IX6    X2+X1       MERGE NEW *XEC*
          LX2    59-IDF.FTOP+IDF.XECP-0 
          LX6    IDF.XECP-0 
          MX3    1
          SA6    A2 
          MI     X2,EXIT.    IF *IDP* HAS EVER BEEN CALLED
          LX3    IDF.BDOP-59
          MX2    -IDF.SNLL
          BX6    X6+X3       MERGE *BDO*
          LX2    IDF.SNLP-0 
          LX4    IDF.SNLP-0 
          BX6    X2*X6       CLEAR OLD *SNL*
          IX6    X6+X4       MERGE NEW *SNL*
          SA6    A2 
          EQ     EXIT.
 WOD      SPACE  4,8
**        WOD - CONVERT A WORD TO OCTAL DISPLAY CODE. 
* 
* 
*         ENTRY  (X1)   =  BINARY WORD TO CONVERT 
* 
*         EXIT   (X6)   =  UPPER 10 OCTAL DIGITS OF CONVERTED WORD
*                (X7)   =  LOWER 10 OCTAL DIGITS OF CONVERTED WORD
* 
*         USES   X - ALL
*                A - 2,3,4,5
*                B - NONE 
* 
*         CALLS  NONE 
  
  
 #WOD     IF     -DEF,WOD 
  
 WOD      SUBR               ** ENTRY/EXIT ** 
  
*         ON ENTRY   (X1)  = ABCDE FGHIJ KLMNO PQRST
  
          SA2    WODA        7.... 7.... 7.... 7....
          BX7    X2*X1       A.... F.... K.... P....
          LX1    3           BCDEF GHIJK LMNOP QRSTA
          BX6    X2*X1       B.... G.... L.... Q....
          LX1    3           CDEFG HIJKL MNOPQ RSTAB
          LX7    9*3         .K... .P... .A... .F...
          BX0    X2*X1       C.... H.... M.... R....
          LX6    7*3         ...L. ...Q. ...B. ...G.
          LX1    3           DEFGH IJKLM NOPQR STABC
          IX7    X6+X7       .K.L. .P.Q. .A.B. .F.G.
          BX5    X2*X1       D.... I.... N.... S....
          LX1    3           EFGHI JKLMN OPQRS TABCD
          LX0    5*3         H.... M.... R.... C....
          BX6    X2*X1       E.... J.... O.... T....
          IX7    X7+X0       HK.L. MP.Q. RA.B. CF.G.
          LX5    3*3         ..I.. ..N.. ..S.. ..D..
          LX6    3           ....J ....O ....T ....E
          IX7    X7+X6       HK.LJ MP.QO RA.BT CF.GE
          SA4    A2+B1       .7.7. 7.7.7 ..... .....
          SA3    A4+B1       ..... .7.7. 7.7.7 .....
          BX7    X7+X5       HKILJ MPNQO RASBT CFDGE
          BX2    X7*X4       .K.L. M.N.O ..... .....
          SA5    A3+B1       00000 00000 00000 00000
          BX1    X7*X3       ..... .P.Q. R.S.T .....
          LX7    10*3        RASBT CFDGE HKILJ MPNQO
          IX2    X5+X2       .K.L. M.N.O 00000 00000
          BX0    X7*X4       .A.B. C.D.E ..... .....
          IX0    X0+X5       .A.B. C.D.E 00000 00000
          LX1    15*3        ..... ..... .P.Q. R.S.T
          BX3    X7*X3       ..... .F.G. H.I.J .....
          IX7    X1+X2       .K.L. M.N.O .P.Q. R.S.T
          LX3    15*3        ..... ..... .F.G. H.I.J
          IX6    X0+X3       .A.B. C.D.E .F.G. H.I.J
          EQ     EXIT.
  
 WODA     CON    70000700007000070000B
          CON    07070707070000000000B
          CON    00000070707070700000B
          CON    10H0000000000
 #WOD     ENDIF 
 IDP      TITLE  IDP - INTERACTIVE DEBUGGING PACKAGE. 
**        IDP - INTERACTIVE DEBUGGING PACKAGE.
* 
* 
*                THIS IS THE INTERACTIVE DEBUGGING PACKAGE WHICH ALLOWS 
*         ITS USER THE JOYS AND SORROWS OF INTERACTIVE DEBUGGING. 
* 
*                INITIAL ENTRY IS VIA *BREAK* MACRO (DBG=MAC), WHICH
*         ASSEMBLES AN *RJ IDP=* AT THE DESIRED LOCATION TO BE BREAK- 
*         POINTED. SUBSEQUENT ENTRIES CAN BE VIA MORE ASSEMBLED *BREAK*S
*         OR BY PLACING AN *IDP* GENERATED BREAKPOINT, VIA *BREAK*
*         COMMAND, AT THE DESIRED LOCATION TO BE BREAKPOINTED.
* 
*         IDP COMMANDS ARE--
* 
*         BREAK 
*         BREAK  ADDR,LL,UL,INC 
*         BRPL   ADDR,A1,LL,UL,INC
*         BRMI   ADDR,A1,LL,UL,INC
*         BRZR   ADDR,A1,LL,UL,INC
*         BRNZ   ADDR,A1,LL,UL,INC
*         BREQ   ADDR,A1,A2,LL,UL,INC 
*         BRNE   ADDR,A1,A2,LL,UL,INC 
*         BRLT   ADDR,A1,A2,LL,UL,INC 
*         BRGE   ADDR,A1,A2,LL,UL,INC 
*         BRLE   ADDR,A1,A2,LL,UL,INC 
*         BRGT   ADDR,A1,A2,LL,UL,INC 
*         CODE   FWA,LWA,LEN
*         CONNECT FILE
*         DISCONT FILE
*         DPC FWA,LWA,LEN 
*         END 
*         FREEZE                                                        000220
*         JUMP   ADDR 
*         OUTPUT I,B,IE,BE
*         REGS
*         REGS   R1,R2,...,RN 
*         SET 
*         SET    NAME,VALUE 
*         SNAP   FWA,LWA,LEN
*         STORE  ADDR,C1,C2,C3,C4 
*         STEP   L,RJ 
*         STPL   ADDR,L,RJ
*         STMI   ADDR,L,RJ
*         STZR   ADDR,L,RJ
*         STNZ   ADDR,L,RJ
*         STEQ   ADDR1,ADDR2,L,RJ 
*         STNE   ADDR1,ADDR2,L,RJ 
*         STLT   ADDR1,ADDR2,L,RJ 
*         STGE   ADDR1,ADDR2,L,RJ 
*         STLE   ADDR1,ADDR2,L,RJ 
*         STGT   ADDR1,ADDR2,L,RJ 
*         STRANGE ADDR1,ADDR2,L,RJ
*         STNR   NR,L,RJ
*         STAR   ADDR1,ADDR2,L,RJ 
*         UNBREAK ADDR1,...,ADDRN 
*         UNSET  NAME1,...,NAMEN
*         WHERE  ADDR1,...,ADDRN
*         XEQ 
* 
*         MAY THE GODS BE WITH YOU... 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   NONE        (OR IT WOULDNT BE ANY GOOD)
* 
*         CALLS  (EXTERNAL TO DBG=IDP)--
*                CDD,COD,DXB,OPEN,READC,RSR=,SFN,SVR=,WRITEC,WRITER     000180
  
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
  
 IDP=     SUBR               ** ENTRY **
          RJ     =XSVR=      SAVE ALL REGISTTERS
  
*         INITIALIZATION. 
  
          SA1    IDP= 
          SX6    60 
          LX1    30 
          SX7    X1 
          SA6    IDPPOS      SET UP POS COUNTER 
          SA7    IDPPREG     SET UP PSEUDO P REGISTER 
          SB6    IDPXFT 
          RJ     CLZ         CLEAR *IDP* TABLE -- TRANSFER ADDRESSES
  
*         SET UP *IDPFLG* - MASTER CONTROL FLAG.
* 
*           SET  XEC = *IDP=* 
*           IF 1ST TIME *IDP* HAS BEEN ENTERED (BIT *FTO* OFF), SET --
*                FTO = 1ST TIME ONLY CODE HAS BEEN EXECUTED 
*                IDO = WRITING INTERACTIVELY (F.IDO)
*                SNL = L.ISL
  
          SA1    IDPFLG 
          MX2    -IDF.XECL
          MX3    1
          LX2    IDF.XECP-0 
          BX6    X2*X1       CLEAR OLD *XEC*/SET NEW *XEC*
          MX4    -IDF.SNLL
          LX1    59-IDF.FTOP
          SA6    A1 
          MI     X1,IDP2     IF NOT 1ST TIME
          LX4    IDF.SNLP-0 
          LX3    IDF.FTOP-59
          BX6    X4*X6       CLEAR OLD *SNL*
          =X1    L.ISL
          BX6    X6+X3       MERGE *FTO*
          LX3    IDF.IDOP-IDF.FTOP
          BX6    X6+X1       MERGE NEW *SNL*
          IX6    X6+X3       MERGE *IDO*
          SA6    A1 
  
*         SET UP INTERACTIVE FILES.                                     000240
                                                                        000250
          RJ     IIF         INITIALIZE INTERACTIVE FILES               000260
  
*         CLEAR/INITIALIZE TABLES.
  
          SB6    IDPBA
          RJ     CLZ         CLEAR *IDP* TABLE -- BREAK ADDRESSES 
          SB6    IDPSET 
          RJ     CLZ         CLEAR *IDP* TABLE -- SET NAMES 
          RJ     IST         (RE)INITIALIZE *SET* TABLE 
  
*         INITIAL BREAK PROCESSING. 
  
 IDP2     SA1    IDPPREG
          SA5    X1-1        (X5) = 30/RJ IDP, 30/FWA PARAMETER LIST
          BX6    X6-X6
          SX5    X5 
          SA6    ST=ENDX     SET TO *DEFAULT IS NOT IDP GENERATED BRK*
          RJ     BRK         BREAK PROCESSOR
  
 #UIO     IF     DEF,UIO= 
          RJ     =XUIO=      USER IDP OWNCODE 
          PL     X1,ST=ENDW  IF NO INTERACTIVE BREAK THIS TIME
 #UIO     ENDIF 
  
          ZR     X5,ST=ENDW  IF CONDITIONAL BREAK NOT SATISFIED 
          RJ     FRK         CHECK FREQUENCY PARAMETERS 
          ZR     X5,ST=ENDW  IF NO BREAK THIS TIME
  
*         FLUSH *F.BDO - BATCH DEBUG OUTPUT FILE*.
  
          WRITER =XF.BDO,,RCL 
  
*         INTRODUCE YOURSELF. 
  
 IDP2A    BSS    0
          SA1    =10H **IDP** 
          SA2    =10H CALLD BY
          SA3    X5+SN=HDR
          BX6    X1 
          LX7    X2 
          SA6    SNAPLNE
          SA7    A6+B1
          BX6    X3 
          ZR     X3,IDP4     IF NO HEADER PROVIDED BY CALLER .OR. 
*                              IDP GENERATED BREAK
          SA6    A6+B1
          SA7    A6+B1
  
 IDP4     SA1    IDPPREG
          SX1    X1-1 
  
 #FRA     IF     DEF,FRA= 
          SB7    IDP5        (B7) = RETURN ADDR FOR *FRA=*
          EQ     =XFRA=      FIND RELATIVE ADDRESS
  
 IDP5     BSS    0
  
 #FRA     ELSE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          BX6    X4 
          MX7    0
 #FRA     ENDIF 
  
          SA6    A7+B1
          SA7    A6+B1
          PRIDP  SNAPLNE
          EQ     IDP8        READ 1ST LINE... 
 IDP=MN   SPACE  4,8
*         ** MAIN LOOP NODE **
  
 IDP=MN   BSS    0
          SA1    IDPSTMT
          PL     X1,IDP7     IF LAST STMT PROCESSED WAS NOT IN *PROC* 
  
*         HERE IF LAST STATEMENT WAS IN A PROCEDURE.
  
          EQ     *+4S15      OOPS...
  
*         CHECK FOR AVAILABILITY OF NEXT STATEMENT. 
  
 IDP7     SA2    X1          (X2) = LEN WORD FOR LAST STMT PROCESSED
          LX2    59-TB.LASP 
          MI     X2,IDP8     IF LAST STMT PROCESSED WAS LAST ON LINE
          LX2    0-TB.LENP+TB.LASP-59 
          SX1    X1 
          SX2    X2+B1
          IX6    X1+X2       (X6) = ADDR OF LEN WORD FOR NEXT STMT
          SA6    IDPSTMT
          SA5    X6+B1       (A5,X5) = A+C OF 1ST TOKEN IN NEXT STMT
          EQ     IDP12
  
*         HERE TO READ NEW LINE.
  
 IDP8     SA1    IDPFLG 
          LX1    59-IDF.INPP
          MI     X1,IDP9     IF READING FROM BATCH INPUT (F.BDI)
  
          DUP    L.PRB,1
          WRITEC =XF.IDO,(=C=  =) 
  
          WRITEC =XF.IDO,(=C= "PROMPT"=)
          WRITER =XF.IDO,,RCL 
  
 IDP9     RJ     RIL         READ IDP LINE
          SA2    IDPFLG 
          ZR     X1,IDP10    IF EOR/EOF NOT ENCOUNTERED 
          MX6    1
          LX6    IDF.INPP-59
          BX6    -X6*X2      CLEAR INP
          SA6    A2 
          EQ     IDP8 
  
*         HERE TO ECHO LINE TO BATCH DEBUG OUTPUT FILE (F.BDO), 
*           IF REQUESTED. 
  
 IDP10    BX3    X2 
          LX2    59-IDF.BKOP
          LX3    59-IDF.BDOP
          BX4    X2*X3
          PL     X4,IDP10A   IF NO ECHO REQUESTED .OR. NOT WRITING TO 
*                              BATCH DEBUG OUTPUT FILE (F.BDO)
          PRBDO  (=C=  =),1 
          SA2    L=LIM
          PRBDO  IDPLIM-1,X2
  
*         HERE TO ECHO LINE TO INTERACTIVE DEBUG OUTPUT FILE (F.IDO), 
*           IF REQUESTED. 
  
 IDP10A   SA1    IDPFLG 
          BX2    X1 
          LX1    59-IDF.IKOP
          LX2    59-IDF.IDOP
          BX3    X1*X2
          PL     X3,IDP11    IF NO ECHO REQUESTED .OR. NOT WRITING TO 
*                              INTERACTIVE DEBUG OUTPUT FILE (F.IDO)
  
          DUP    L.PRB,1
          WRITEC =XF.IDO,(=C=  =) 
  
          WRITEC =XF.IDO,IDPLIM-1 
  
*         HERE TO ENTOKEN NEW LINE. 
  
 IDP11    SX7    L.TB 
          SA6    IDPTB       (A6) = ADDR OF LEN WORD FOR 1ST STMT 
          SA7    BUB=LEN
          RJ     BUB         BURST/BUILD NEW LINE 
          SX6    IDPTB
          SA5    IDPTB+1
          SA6    IDPSTMT
  
*         HERE TO SEARCH FOR STATEMENT KEYWORD. 
  
 IDP12    MX0    7*CHAR 
          SX6    B1 
          ZR     X5,IDP=MN   IF A NULL STMT, IGNORE...
*                              (PROBABLE "EOS" "EOS" SYNTAX)
          SA2    =40404040404040404040B 
          BX1    X0*X5       (X1) = 0LKEYWORD 
          IX6    X1-X6       BORROW RIPPLES LEFT TO 1ST NON-ZERO BIT
          BX7    -X6+X1      (X7) = ALL TRAILING 0 BITS IN (X1) = 0 BITS
*                                    ALL OTHER LEADING BITS = 1 BITS
          SB7    60-5        (B7) = RIGHT CIRCULAR SHIFT 5 BITS 
          BX6    X2*X7       (X6) = 40B WHERE EACH CHAR IN KEYWORD IS 
          LX7    X6,B7       (X7) = 01B WHERE EACH CHAR IN KEYWORD IS 
          SB6    IDPKEY 
          IX7    X6-X7       (X7) = 37B WHERE EACH CHAR IN KEYWORD IS 
          BX0    X6+X7       (X0) = 77B WHERE EACH CHAR IN KEYWORD IS 
          RJ     SKT         SEARCH *IDP* KEYWORD TABLE 
  
 #UKT     IF     DEF,UKT= 
          NZ     X2,IDP=UK   IF A FIND
          SB6    =XUKT=      (B6) = FWA OF USER KEYWORD TABLE 
          RJ     SKT         SEARCH USER KEYWORD TABLE
  
 IDP=UK   BSS    0
 #UKT     ENDIF 
  
          ZR     X2,IDP.ER   IF NO FIND IN TABLE
          SB5    X2          (B5) = PROCESSOR ADDR
          SA5    A5+B1       (A5,X5) = A+C OF TOKEN THAT TERMINATED KEYW
          JP     B5 
 IDP=ER   SPACE  4,8
*         HERE FOR ERROR CONDITION. 
  
 IDP=ER   BSS    0           ** ERROR **
 IDP.ER   BSS    0
  
          DUP    L.PRB,1
          WRITEC =XF.IDO,(=C=  =) 
  
          WRITEC =XF.IDO,(=C= ** ERROR **=) 
          EQ     IDP=MN 
 IDP=OV   SPACE  4,8
*         HERE IF TABLE OVERFLOW. 
  
 IDP=OV   BSS    0           ** TABLE OVERFLOW ** 
  
          DUP    L.PRB,1
          WRITEC =XF.IDO,(=C=  =) 
  
          WRITEC =XF.IDO,(=C= ** TABLE OVERFLOW **=)
          EQ     IDP=ER 
 IDP=IFR  SPACE  4,8                                                    000280
**        IDP=IFR - IDP RESTART.                                        000290
*                                                                       000300
*         HERE FROM *RHH* WHEN HOST HAS JUST BEEN RESTARTED             000310
*         VIA *IFR*.  NEED TO --                                        000320
*           1.*MEM* BACK DOWN TO ORIGINAL FIELD LENGTH.                 000330
*           2. RESTORE THE WORDS AT (RA.SSW), (FL-2), AND (FL-1).       000340
*           3. (RE)OPEN AND CONNECT INTERACTIVE FILES, JUST IN CASE     000350
*              USER IS RESTARTING ON ANOTHER DAY.                       000360
                                                                        000370
                                                                        000380
 IDP=IFR  BSS    0           ** ENTRY **                                000390
          SA4    MEM#HOST                                               000400
          SX3    B1                                                     000410
          BX6    -X3*X4      CLEAR COMPLETE BIT                         000420
          SA6    A4                                                     000430
          MEMORY SCM,A4,RCL                                             000440
                                                                        000450
          SA1    FRZ#SAV                                                000460
          SA2    A1+B1                                                  000470
          SA3    A2+B1                                                  000480
          LX6    X1                                                     000490
          BX7    X2                                                     000500
          AX4    30                                                     000505
          =A6    RA.SSW      RESTORE (RA.SSW)                           000510
          SA7    X4-2        RESTORE (FL-2)                             000520
          BX6    X3                                                     000530
          SA6    A7+B1       RESTORE (FL-1)                             000540
          RJ     IIF         INITIALIZE INTERACTIVE FILES               000550
          EQ     IDP=MN      CONTINUE INTERACTIVE SESSION...            000560
 ST=      SPACE  4,8
**        ST= - STATEMENT PROCESSORS. 
* 
 ST=BRK   SPACE  4,8
*         HERE TO PROCESS *BREAK ADDR,LL,UL,INC*, 
*                      OR *BRPL ADDR,ADDR1,LL,UL,INC* FORM, 
*                      OR  *BREQ ADDR,ADDR1,ADDR2,LL,UL,INC* FORM.
  
 ST=BRK   SX6    B7+IDPKEY-IDPKBR  (X6) = BREAK TYPE CODE (BTC) 
          SA6    IDPBTC 
          ZR     X5,ST=BRK13 IF EOS ENCOUNTERED, LIST ALL BREAKS... 
          RJ     PAS         PARSE SUBEXPRESSION-- ADDR 
          ZR     X3,ST=BRK13 IF 1ST EXPRESSION IS NULL, LIST ALL BREAKS 
          SX6    X1 
          SB2    X1          (B2) = ADDR AT WHICH TO BREAK
          SA6    AP=FWA 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,IDP.ER   IF ADDR IS BAD 
          SA2    IDPBTC 
          MX3    0
          ZR     X2,ST=BRK2  IF THIS IS *BREAK ADDR,LL,UL,INC*
  
*         ASSEMBLE ADDR1. 
  
          ZR     X5,ST=BRK2  IF ADDR FOLLOWED BY EOS
          RJ     PAS         PARSE SUBEXPRESSION-- ADDR1
  
 ST=BRK2  NZ     X3,ST=BRK3  IF ADDR1 NOT NULL
          SX1    0           (X1) = DEFAULT ADDR1 
  
 ST=BRK3  SB2    X1 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,IDP.ER   IF ADDR1 IS BAD
          SX6    B2 
          MX3    0
          SA6    AP=LWA 
          SA2    IDPBTC 
          SX7    X2-BTC=EQ
          MI     X7,ST=BRK4  IF THIS IS *BREAK ADDR,LL,UL,INC*
*                              OR *BRPL ADDR,ADDR1,LL,UL,INC* FORM
  
*         ASSEMBL ADDR2.
  
          ZR     X5,ST=BRK4  IF ADDR1 FOLLOWED BY EOS 
          RJ     PAS         PARSE SUBEXPRESSION-- ADDR2
  
 ST=BRK4  NZ     X3,ST=BRK5  IF ADDR2 NOT NULL
          SX1    0
  
 ST=BRK5  SB2    X1 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,IDP.ER   IF ADDR2 IS BAD
          SX6    B2 
          MX3    0
          SA6    AP=LEN      SAVE (X6) = ADDR2
  
*         ASSEMBLE LL.
  
          ZR     X5,ST=BRK6  IF ADDR2 FOLLOWED BY EOS 
          RJ     PAS         PARSE SUBEXPRESSION-- LL 
  
 ST=BRK6  NZ     X3,ST=BRK7  IF LL NOT NULL 
          SX1    1           (X1) = DEFAULT LL
  
 ST=BRK7  SX6    X1 
          SA6    AP=LL
          MX3    0
          ZR     X5,ST=BRK8  IF LL FOLLOWED BY EOS
          RJ     PAS         PARSE SUBEXPRESSION-- UL 
  
 ST=BRK8  NZ     X3,ST=BRK9  IF UL NOT NULL 
          SX1    100         (X1) = DEFAULT UL
  
 ST=BRK9  SX6    X1 
          SA6    AP=UL
          MX3    0
          ZR     X5,ST=BRK10 IF UL FOLLOWED BY EOS
          RJ     PAS         PARSE SUBEXPRESSION-- INC
  
 ST=BRK10 NZ     X3,ST=BRK11 IF INC NOT NULL
          SX1    1           (X1) = DEFAULT INC 
  
 ST=BRK11 SX6    X1 
          SA6    AP=INC 
  
*         ASSEMBLE NEW BREAK TABLE ENTRY. 
  
          SA1    AP=FWA      (X1) = BREAK ADDR
          SA2    A1+B1       (X2) = ADDR1 
          SA3    A2+B1       (X3) = ADDR2 
          SA4    IDPBTC      (X4) = BREAK TYPE CODE 
          LX2    54-18
          BX6    X1+X2       (X6) = 6/0,18/ADDR1,18/0,18/BREAK ADDR 
          LX3    36-18
          BX6    X6+X3       (X6) = 6/0,18/ADDR1,18/ADDR2,18/BRK ADDR 
          LX4    60-6 
          BX6    X6+X4       (X6) = 6/BTC,18/ADDR1,18/ADDR2,18/BRK ADDR 
          SA6    ST=BRKB
  
          SA2    AP=LL       (X2) = LL
          SA3    A2+B1       (X3) = UL
          SA4    A3+B1       (X4) = INC 
          LX2    60-15
          LX3    45-15
          BX7    X2+X3       (X7) = 15/LL,15/UL,12/0,18/0 
          LX4    30-12
          BX7    X7+X4       (X7) = 15/LL,15/UL,12/INC,18/0 
          SA7    A6+B1
  
          SX1    X1 
          SB6    IDPBA
          MX0    -18
          BX0    -X0
          RJ     SKT         SEARCH FOR BREAK ADDR
          SA1    ST=BRKB
          NZ     X2,ST=BRK12 IF BREAK ADDR ALREADY IN TABLE 
  
*         HERE IF MAKING A NEW ENTRY. 
  
          BX6    X1 
          RJ     ADZ         ADD NEW *IDPBA* ENTRY
          SA3    X1          (X3) = PREVIOUS CONTENTS OF BREAK ADDR 
          SA4    ST=BRKA     (X4) = *RJ IDP* PLUG 
          BX6    X3 
          LX7    X4 
          SB6    B7+B7
          SA6    IDPBC+B6 
          SA7    A3 
          SA1    ST=BRKB+1   (X1) = 2ND WORD OF NEW *IDPBC* ENTRY 
          BX6    X1 
          SA6    A6+B1
          EQ     IDP=MN 
  
*         HERE IF REPLACING/UPDATING AN EXISTING ENTRY. 
  
 ST=BRK12 SB6    B7+B7
          BX6    X1 
          SA3    IDPBC+B6+1  (X3) = 2ND WORD OF EXISTING *IDPBC* ENTRY
          SA6    A2          REPLACE OLD *IDPBA* WITH NEW 
          SA4    A1+B1       (X4) = NEW 2ND WORD OF *IDPBC* ENTRY 
          SX3    X3          (X3) = SNAP COUNT
          BX6    X4+X3
          SA6    A3          REPLACE OLD WITH NEW 
          EQ     IDP=MN 
  
*         HERE TO LIST ALL BREAKS.
  
 ST=BRK13 RJ     LBT         LIST BREAK TABLE 
          EQ     IDP=MN 
  
  
 ST=BRKA  RJ     IDP=        PLUG VALUE 
 -        VFD    30/0 
  
 ST=BRKB  BSSZ   2           SAVE CELLS 
 ST=COD   SPACE  4,8
*         HERE TO PROCESS *CODE FWA,LWA,LEN*. 
  
 ST=COD   BSS    0
          SA1    IDPPREG                                                000300
          SX6    B1          (X6) = DEFAULT LEN                         000310
          BX7    X1          (X7) = DEFAULT FWA                         000320
          SA6    PAT#LEN                                                000330
          SA7    PAT#FWA                                                000340
          RJ     PAT         PARSE *FWA,LWA,LEN* TRIPLE                 000350
          MI     B2,IDP=ER   IF FWA, LWA, OR LEN IS BAD                 000360
  
*         HERE TO DEASSEMBLE FROM FWA TO LWA. 
  
 ST=COD5  SA1    AP=FWA 
          SA2    A1+B1
          IX3    X2-X1
          SX6    X1+B1
          MI     X3,IDP=MN   IF FINISHED
          SA6    A1 
          SA5    X1          (A5,X5) = WORD TO DEASSEMBLE 
          SB4    60          (B4) = POSITION COUNTER
  
 ST=COD6  RJ     DAZ         DEASSEMBLE INSTRUCTION 
          MI     X1,ST=COD5  IF INSTRUCTION FORCED UPPER
          SB4    B4-B5
          GT     B4,B0,ST=COD6  IF MORE INSTRUCTIONS TO GO IN THIS WORD 
          EQ     ST=COD5
 ST=CON   SPACE  4,8
*         HERE TO PROCESS *CONNECT FILE*. 
  
 ST=CON   ZR     X5,IDP=ER   IF EOS ENCOUTNTERED
          SA5    A5+B1
          SB4    B0          SET TO *CONNECT* 
  
 ST=CON2  BSS    0
  
 #UFT     IF     DEF,UFT= 
          SB6    =XUFT=      (B6) = FWA OF USER FILE NAME TABLE 
          MX0    7*CHAR 
          BX1    X0*X5       (X1) = 0LLFN 
          RJ     SKT         SEARCH FOR FILE NAME 
          ZR     X2,IDP=ER   IF NO FIND 
          SA1    X2          (A1,X1) = A + C OF 1ST WORD OF FET 
          SX2    B4          SET TO *CONNECT/DISCONT* 
          RJ     CON         CONNECT/DISCONT FILE 
  
 #OS3     IFEQ   .OS,3       IF SCOPE 3 
          MI     X1,IDP=ER   IF *CON* DETECTED ERROR... 
 #OS3     ENDIF 
 #UFT     ENDIF 
  
          EQ     IDP=MN 
 ST=DPC   SPACE  4,8
*         HERE TO PROCESS *DPC FWA,LWA,LEN*.
  
 ST=DPC   BSS    0
          MX6    -1          (X6) = DEFAULT FWA  (ERROR)                000380
          SX7    B1          (X7) = DEFAULT LEN                         000390
          SA6    PAT#FWA                                                000400
          SA7    PAT#LEN                                                000410
          RJ     PAT         PARSE *FWA,LWA,LEN* TRIPLE                 000420
          MI     B2,IDP=ER   IF FWA, LWA, OR LEN IS BAD                 000430
          SA2    AP=FWA      (X2) = FWA                                 000440
          SA3    A2+B1       (X3) = LWA                                 000450
          BX4    X4-X4       (X4) = LEN (I.E. NO LEN)                   000460
          RJ     DOD         DUMP CENTRAL MEMORY - OCTAL AND DPC
          PL     B2,IDP=MN   IF FWA,LWA,AND LEN OK
          EQ     IDP=ER 
 ST=DSC   SPACE  4,8
*         HERE TO PROCESS *DISCONT FILE*. 
  
 ST=DSC   ZR     X5,IDP=ER   IF EOS ENCOUNTERED 
          SA5    A5+B1
          SB4    B1          SET TO *DISCONT* 
          EQ     ST=CON2     PROCESS *DISCONT*... 
 ST=END   SPACE  4,8
*         HERE TO PROCESS *END*.
  
 ST=END   BSS    0           ** END **
          PRIDP  (=C= BYE...=),,L.PRB 
          WRITER =XF.IDO,,RCL 
  
 ST=ENDW  SA1    IDPPREG     (X1) = PSEUDO P REGISTER 
          SA2    IDPPOS      (X2) = POS COUNTER 
          SA3    ST=ENDX
          SA4    =46000460004600046000B 
          SB4    X2 
          LX6    X3 
          SB6    60 
          SA5    ST=ENDZ     (X5) = *JP B0+0* PLUG
          LE     B4,B0,*+4S15  IF BAD POS COUNTER, SHAZAM...
          LT     B4,B6,ST=END2 IF NEXT INSTRUCTION TO XEQ IS NOT UPPER, 
*                              (I.E.STEP MODE LEFT US IN MIDDLE OF WORD)
          NZ     X3,ST=END4  IF TO XEQ PREVIOUS CONTENTS OF BREAK ADDR
*                              AT *ST=ENDX* 
          LX6    X4 
          EQ     ST=END4
  
 ST=END2  NZ     X3,ST=END3  IF TO XEQ PARTIAL WORD AT *ST=ENDX*
          SA3    X1          (X3) = PARTIALLY XEQ WORD AT ((IDPPREG)) 
          SX1    X1+B1       (X1) = RETURN ADDR 
  
*         HERE BECAUSE STEP MODE LEFT US IN THE MIDDLE OF A WORD--
*           LEFT JUSTIFY REMAINING INSTRUCTION(S) TO XEQ AND NO-OP FILL.
  
 ST=END3  MX0    1
          SB7    B6-B4       (B7) = NR OF BITS ALREADY XEQ IN THIS WORD 
          SB5    B4-B1
          LX6    X3,B7       (X6) = INSTRUCTIONS TO XEQ-- LEFT JUSTIFIED
          AX0    X0,B5       (X0) = EXTRACT MASK FOR INST TO XEQ
          BX6    X0*X6
          BX4    -X0*X4 
          BX6    X6+X4       (X6) = INSTRUCTIONS TO XEQ W/ NO-OP FILL 
  
*         HERE TO SET UP *JP B0+RETURN ADDR*. 
  
 ST=END4  SA6    ST=ENDX
          LX1    30 
          BX6    X5+X1       (X6) = 30/JP B0+RETURN ADDR, 30/NO-OP
          SA6    ST=ENDY
          RJ     RSR=        RESTORE ORIGINAL REGISTERS 
  
 ST=ENDX  BSSZ   1           WORD TO EXECUTE BEFORE EXITING *IDP* 
*                              IF AN IDP GENERATED BREAK, THEN IS PLUG- 
*                              GED WITH PREVIOUS CONTENTS OF BREAK ADDR 
*                              IF AN ASSEMBLED BREAK, THEN IS .ZR.
*                              SEE *BRK*. 
  
 ST=ENDY  BSSZ   1           PLUGGED WITH *JP B0+RETURN ADDR* 
  
 ST=ENDZ  JP     B0+         PLUG VALUE 
 ST=FRZ   SPACE  4,8                                                    000580
*         HERE TO PROCESS *FREEZE*.                                     000590
                                                                        000600
 ST=FRZ   BSS    0                                                      000610
          SA1    FW.IFR+/IFR/F.FRZ-RA.ORG                               000620
          SA2    =0LFRZ                                                 000630
          MX3    -18                                                    000640
          BX1    -X3*X1      CLEAR OLD LFN                              000650
          IX6    X1+X2       MERGE NEW LFN                              000660
          SA6    A1                                                     000670
          RJ     FRZ         FREEZE INTERACTIVE HOST                    000680
          EQ     IDP=MN                                                 000690
 ST=JP    SPACE  4,8
*         HERE TO PROCESS *JUMP ADDR*.
  
 ST=JP    BSS    0
          ZR     X5,IDP=MN   IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION-- ADDR 
          ZR     X3,IDP=MN   IF ADDR IS NULL
          SB2    X1 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,IDP.ER   IF ADDR IS BAD 
          SA1    =46000460004600046000B 
          SX7    60 
          SA7    IDPPOS 
          SX6    B2 
          BX7    X1 
          SA6    IDPPREG
          SA7    ST=ENDX
          EQ     ST=END 
 ST=OUT   SPACE  4,8
**        HERE TO PROCESS *OUTPUT I,B*. 
  
 ST=OUT   ZR     X5,IDP=MN   IF EOS ENCOUNTERED 
          SB6    IDPKOUT     (B6) = FWA OF *OUTPUT* OPTIONS KEYWORD TBL 
          RJ     POL         PROCESS OPTIONS LIST ITEM
          SA1    B6+B7
          ZR     X3,ST=OUT   IF NULL PARAMETER, IGNORE... 
          SB5    X1          (B5) = OPTIONS PROCESSOR ADDR
          MX0    1
          SA2    IDPFLG 
          BX6    -X6*X0      (X6) = +0 IF -OPTION, OR 1S59 IF +OPTION 
          JP     B5+
  
*         HERE IF *OUTPUT I* OR *OUTPUT -I*.
  
 ST=OUT2  LX0    IDF.IDOP-59
          BX2    -X0*X2      CLEAR EXISTING FIELD 
          LX6    IDF.IDOP-59
          BX6    X2+X6
          SA6    A2 
          EQ     ST=OUT 
  
*         HERE IF *OUTPUT B* OR *OUTPUT -B*.
  
 ST=OUT3  LX0    IDF.BDOP-59
          BX2    -X0*X2      CLEAR EXISTING FIELD 
          LX6    IDF.BDOP-59
          BX6    X2+X6
          SA6    A2 
          EQ     ST=OUT 
  
*         HERE IF *OUTPUT BE* OR *OUTPUT -BE*.
  
 ST=OUT4  LX0    IDF.BKOP-59
          BX2    -X0*X2      CLEAR EXISTING FIELD 
          LX6    IDF.BKOP-59
          BX6    X2+X6       MERGE NEW BKO
          SA6    A2 
          EQ     ST=OUT 
  
*         HERE IF *OUTPUT IE* OR *OUTPUT -IE*.
  
 ST=OUT5  LX0    IDF.IKOP-59
          BX2    -X0*X2      CLEAR EXISTING FIELD 
          LX6    IDF.IKOP-59
          BX6    X2+X6       MERGE NEW IKO
          SA6    A2 
          EQ     ST=OUT 
 ST=REG   SPACE  4,8
*         HERE TO PROCESS *REG R1,R2,...,RN*. 
  
 ST=REG   BSS    0
          SA0    A5          INITIALIZE (A0) = ADDR OF CURRENT TOKEN
          NZ     X5,ST=REG2  IF *REG* NOT FOLLOWED BY EOS 
          RJ     DAR         DUMP ALL REGISTERS 
          EQ     IDP=MN 
  
*         HERE FOR SELECTED REGISTER DUMP.
  
 ST=REG2  SA0    A0+B1
          SA5    A0 
          ZR     X5,IDP=MN   IF AN EOS ENCOUNTERED
  
          SX6    X5-O.SEP 
          SX7    X5-O.CONS
          SA4    IDP0TR 
          ZR     X6,ST=REG2  IF SEPARATOR TOKEN 
          ZR     X7,ST=REG4  IF CONSTANT TOKEN
  
*         HERE IF A NAME TOKEN, CHECK FOR REGISTER NAME.
  
          LX5    CHAR 
          MX0    -CHAR
          BX6    -X0*X5      (X6) = REGISTER TYPE (BAX) 
          SX4    B0          (X4) = 0TR, WHERE T=0 (B REG)
          SX1    X6-1RB 
          SX2    X6-1RA 
          SX3    X6-1RX 
          ZR     X1,ST=REG4  IF B REGISTER
          SX4    010B        (X4) = 0TR, WHERE T=1 (A REG)
          ZR     X2,ST=REG4  IF A REGISTER
          SX4    020B        (X4) = 0TR, WHERE T=2 (X REG)
          ZR     X3,ST=REG4  IF X REGISTER
          EQ     IDP=ER 
  
 ST=REG4  LX5    CHAR 
          MX0    -CHAR
          BX6    -X0*X5 
          MX1    1R7-1R0+1
          LX1    -1R0        (X1) = (0-7) SHIFT MASK
          SB3    X6          (B3) = REGISTER NR (0-7) 
          LX7    X1,B3
          LX5    5*CHAR 
          PL     X7,IDP=ER   IF NOT (0-7), ERROR... 
          MX0    -5*CHAR
          BX7    -X0*X5 
          NZ     X7,IDP=ER   IF REST OF CHARS NON-ZERO, NOT A REGISTER
          SB6    B3-1R0      (B6) = REGISTER NR IN BINARY 
          MX0    60-3 
          BX7    X0*X4       STRIP OLD REGISTER NR
          SX6    X7+B6       (X6) = NEW 0TR 
          SB4    X6 
          SA6    IDP0TR 
          SB7    020B 
          GE     B4,B7,ST=REG5     IF DUMPING X REGISTER
          RJ     DAB         DUMP -A- OR -B- REGISTER 
          EQ     ST=REG2
  
 ST=REG5  RJ     DUX         DUMP -X- REGISTER
          EQ     ST=REG2
 ST=RES   SPACE  4,8
*         HERE TO PROCESS *RESET*.
  
 ST=RES   SB6    IDPBA
          RJ     CLZ         CLEAR *IDP* TABLE -- BREAK ADDRESSES 
          SB6    IDPSET 
          RJ     CLZ         CLEAR *IDP* TABLE -- SET NAMES 
          RJ     IST         (RE)INITIALIZE DEFAULT *SET* NAMES 
          EQ     IDP=MN 
 ST=SET   SPACE  4,8
*         HERE TO PROCESS *SET NAME,ADDR*.
  
 ST=SET   ZR     X5,ST=SET3  IF EOS ENCOUNTERED 
          SA5    A5+B1       (X5) = 42/0LNAME,18/O.VAR
          SX6    X5-O.VAR 
          NZ     X6,IDP=ER   IF NOT A NAME TOKEN
          MX0    7*CHAR 
          BX7    X0*X5
          SA7    IDPNAM      SAVE 0LNAME
          SA5    A5+B1
          RJ     PAS         PARSE SUBEXPRESSION -- ADDR
          MX0    7*CHAR 
          SB6    IDPSET      (B6) = FWA OF *SET* TABLE
          BX4    -X0*X1      (X4) = 42/0,18/VALUE OF *NAME* 
          SA1    IDPNAM 
          RJ     SKT         SEARCH *SET* TABLE FOR NAME
          IX6    X1+X4       (X6) = 42/0LNAME, 18/VALUE OF NAME 
          ZR     X2,ST=SET2  IF NO FIND 
          SA6    A2 
          EQ     IDP=MN 
  
 ST=SET2  RJ     ADZ         ADD A WORD TO IDP TABLE
          EQ     IDP=MN 
  
*         HERE TO LIST *SET* TABLE. 
  
 ST=SET3  SA5    IDPSET 
          RJ     LST         LIST SET TABLE 
          EQ     IDP=MN 
 ST=SNP   SPACE  4,8
*         HERE TO PROCESS *SNAP FWA,LWA,LEN*. 
  
 ST=SNP   BSS    0
          MX6    -1          (X6) = DEFAULT FWA (ERROR)                 000480
          SX7    B1          (X7) = DEFAULT LEN                         000490
          SA6    PAT#FWA                                                000500
          SA7    PAT#LEN                                                000510
          RJ     PAT         PARSE *FWA,LWA,LEN* TRIPLE                 000520
          MI     B2,IDP=ER   IF FWA, LWA, OR LEN IS BAD                 000530
          SA2    AP=FWA      (X2) = FWA                                 000540
          SA3    A2+B1       (X3) = LWA                                 000550
          BX4    X4-X4       (X4) = LEN  (I.E. NO LEN)                  000560
          RJ     DCM         DUMP CENTRAL MEMORY
          PL     B2,IDP=MN   IF FWA,LWA,AND LEN OK
          EQ     IDP=ER 
 ST=STO   SPACE  4,8
*         HERE TO PROCESS *STORE ADDR,C1,C2,C3,C4*. 
  
 ST=STO   BSS    0
          ZR     X5,IDP=ER   IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION -- ADDR TO STORE 
          ZR     X3,IDP=ER   IF 1ST EXPRESSION *ADDR* IS NULL 
          SX6    X1 
          SB2    X1 
          SA6    IDPSTA      SAVE STORE ADDR
          RJ     CHK         CHECK CM ADDRESS -- STORE ADDR 
          MI     B2,IDP=ER   IF ADDR IS BAD 
          MX6    0
          SA6    A6+B1       CLEAR (IDPSTC) = NEW VALUE TO STORE
          SA6    A6+B1       CLEAR (IDPSTM) = NULL PARAMETER MASK 
          ZR     X5,ST=STO4  IF STORE ADDR FOLLOWED BY EOS
  
 ST=STO2  RJ     PAS         PARSE SUBEXPRESSION -- C-N-
          SA2    IDPSTC      (X2) = CURRENT VALUE TO BE STORED
          SA4    A2+B1       (X4) = CURRENT NULL PARAMETER MASK 
          MX0    -15
          LX2    15 
          LX4    15 
          BX6    X2+X1
          LX7    X4 
          SA6    A2 
          NZ     X3,ST=STO3  IF C-N- NOT NULL 
          BX7    -X0+X4 
  
 ST=STO3  SA7    A4 
          NZ     X5,ST=STO2  IF NOT FINISHED ASSEMBLING STORE VALUE 
  
*         HERE IF FINISHED ASSEMBLING STORE VALUE.
  
 ST=STO4  SA1    IDPSTA      (X1) = STORE ADDR
          SA2    A1+B1       (X2) = NEW ASSEMBLED STORE VALUE 
          SA3    A2+B1       (X3) = NULL PARAMETER MASK 
          SA1    X1          (X1) = OLD CONTENTS OF STORE ADDR
          BX6    X3*X1
          BX7    X2+X6       (X7) = NEW CONTENTS OF STORE ADDR
          SA7    A1          NEW REPLACES OLD 
          SA7    A2 
          RJ     =XWOD       CONVERT A WORD OF BINARY TO OCTAL DPC--OLD 
          SA6    IDPMSG4+1
          SA7    A6+B1
          SA1    IDPSTC      (X1) = NEW CONTENTS OF STORE ADDR
          RJ     =XWOD       CONVERT A WORD OF BINARY TO OCTAL DPC--NEW 
          SA6    IDPMSG5+1
          SA7    A6+B1
          PRIDP  IDPMSG4,4
          PRIDP  IDPMSG5,4
          EQ     IDP=MN 
 ST=STP   SPACE  4,8
*         HERE TO PROCESS *STEP L,RJ*,
*                      OR *STPL ADDR1,L,RJ* FORM, 
*                      OR *STEQ ADDR1,ADDR2,L,RJ* FORM. 
  
 ST=STP   SX6    B7+IDPKEY-IDPKST  (X6) = STEP TYPE CODE (XTC)
          SA6    IDPXTC 
          ZR     X6,ST=STP5  IF *STEP L,RJ* FORM
          ZR     X5,ST=STP1  IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION-- ADDR1
          NZ     X3,ST=STP2  IF ADDR1 NOT NULL
  
 ST=STP1  SX1    0           (X1) = DEFAULT ADDR1 
  
 ST=STP2  SB2    X1 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,IDP=ER   IF ADDR1 IS BAD
          SX6    B2 
          MX3    0
          SA6    IDPXA1 
          SA2    IDPXTC 
          SX7    X2-XTC=EQ
          MI     X7,ST=STP3  IF THIS IS *STPL ADDR1,L,RJ* FORM
  
*         ASSEMBLE ADDR2. 
  
          ZR     X5,ST=STP3  IF ADDR1 FOLLOWED BY EOS 
          RJ     PAS         PARSE SUBEXPRESSION-- ADDR2
  
 ST=STP3  NZ     X3,ST=STP4  IF ADDR2 NOT NULL
          SA1    IDPXA1      (X1) = DEFAULT ADDR2 
  
 ST=STP4  SB2    X1 
          SX6    B2 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,IDP=ER   IF ADDR2 IS BAD
          SA6    IDPXA2 
  
*         HERE TO PROCESS *L,RJ* OPTIONS LIST.
  
 ST=STP5  ZR     X5,ST=STP6  IF EOS ENCOUNTERED 
          SB6    IDPKSTO     (B6) = FWA OF STEP OPTIONS KEYWORD TABLE 
          RJ     POL         PROCESS OPTIONS LIST 
          ZR     X3,ST=STP5  IF NULL PARAMETER
          SA7    IDPXOP+B7
          EQ     ST=STP5
  
*         HERE TO SET UP FOR ACTUAL STEP. 
  
 ST=STP6  SA1    IDPXTC 
          SA2    IDPXA2 
          MX6    0
          SX3    X1-XTC=NR
          BX7    X2 
          SA6    IDPXRJ      SET TO *AT LEVEL 0 NOW*
          NZ     X3,ST=STP7  IF NOT *STNR NR,L,RJ*
          SA7    IDPXA1      (RE)SET STEP COUNT 
  
 ST=STP7  SA1    IDPXOL      (X1) = /L/ OPTION FLAG 
          SA2    A1+B1       (X2) = /RJ/ OPTION FLAG
          SX6    B1          SET TO *LIST ON* 
          SA3    IDPXRJ 
          NZ     X2,ST=STP7A IF /RJ/ TRACING ON 
          ZR     X3,ST=STP7A IF AT LEVEL 0 (I.E. NO ACTIVE *RJ*)
          SX6    B0          SET TO *LIST OFF*
  
 ST=STP7A BX7    X6*X1
          SA7    IDPXLST
  
*         HERE TO CHECK STEP CONDITIONS.
  
 ST=STP8  SA3    IDPXTC      (X3) = STEP TYPE CODE
          SA1    IDPXA1      (X1) = A1
          SA2    A1+B1       (X2) = A2
          SB5    X3 
          SX6    X3-XTC=NR
          SX0    X3-XTC=AR
          SX7    X3-XTC=RNG 
          ZR     X3,ST=STP9  IF *STEP L,RJ* 
          ZR     X6,ST=STP10 IF *STNR NR,L,RJ*
          ZR     X0,ST=STP9  IF *STAR ADDR1,ADDR2,L,RJ* 
          ZR     X7,ST=STP12 IF *STRANGE ADDR1,ADDR2,L,RJ*
  
          SA1    X1          (X1) = C1
          SA2    X2          (X2) = C2
          RJ     CBC         CHECK STEP CONDITION 
          ZR     B6,IDP=MN   IF CONDITION NOT SATISFIED 
  
 ST=STP9  RJ     STP         STEP ONE INSTRUCTION 
          SA1    IDPXTC 
          SA2    IDPXRJ 
          SA3    IDPXORJ
          SX6    X1-XTC=AR
          ZR     X6,ST=STP9A IF *STAR ADDR1,ADDR2,L,RJ* 
          NZ     X1,ST=STP7  IF NOT *STEP L,RJ* 
  
*         HERE IF *STEP L,RJ*.
  
          NZ     X3,IDP=MN   IF /RJ/ SELECTED 
          ZR     X2,IDP=MN   IF AT LEVEL 0
          EQ     ST=STP7
  
*         HERE TO PROCESS *STAR ADDR1,ADDR2,L,RJ*.
  
 ST=STP9A SA1    IDPXAR 
          SA2    IDPXA1 
          SA3    IDPXA2 
          SA4    IDPPREG
          IX6    X1-X2
          IX7    X3-X1
          MI     X6,ST=STP7  IF ADDR BELOW LOWER LIMIT
          MI     X7,ST=STP7  IF ADDR ABOVE UPPER LIMIT
          EQ     IDP=MN 
  
*         HERE TO PROCESS *STNR NR,L,RJ*. 
  
 ST=STP10 SA2    IDPXORJ
          SA3    IDPXRJ 
          SX6    X1-1 
          NZ     X2,ST=STP11 IF /RJ/ SELECTED 
          NZ     X3,ST=STP9  IF NOT AT LEVEL 0
  
 ST=STP11 MI     X6,IDP=MN   IF NO MORE INSTRUCTIONS TO STEP
          SA6    A1 
          EQ     ST=STP9
  
*         HERE TO PROCESS *STRANGE ADDR1,ADDR2,L,RJ*. 
  
 ST=STP12 SA4    IDPPREG
          IX6    X4-X1
          IX7    X2-X4
          MI     X6,IDP=MN   IF P BELOW LOWER RANGE 
          MI     X7,IDP=MN   IF P ABOVE UPPER RANGE 
          EQ     ST=STP9
 ST=UBK   SPACE  4,8
*         HERE TO PROCESS *UNBREAK ADDR1,...,ADDRN*.
  
 ST=UBK   BSS    0
          ZR     X5,IDP=MN   IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION-- ADDR 
          ZR     X3,ST=UBK   IF ADDR IS NULL
          SB6    IDPBA
          MX0    -18
          BX0    -X0
          RJ     SKT         SEARCH FOR *ADDR*
          ZR     X2,IDP=ER   IF NO FIND 
          SB6    B7+B7
          SA4    IDPBC+B6 
          MX6    -1 
          BX7    X4 
          SA6    A2          SET TO *THIS ENTRY IS AVAILABLE* 
          SA7    X2          RESTORE PREVIOUS CONTENTS OF BREAK ADDR
          EQ     ST=UBK      CONTINUE...
 ST=UST   SPACE  4,8
*         HERE TO PROCESS *UNSET NAME1,...,NAMEN*.
  
 ST=UST   BSS    0
  
 ST=UST2  ZR     X5,IDP=MN   IF EOS ENCOUNTERED 
          SA5    A5+B1
          NO
          SX6    X5-O.VAR 
          NZ     X6,ST=UST2  IF NOT A NAME TOKEN
          SB6    IDPSET 
          MX0    7*CHAR 
          BX1    X5 
          RJ     SKT         SEARCH FOR NAME
          ZR     X2,ST=UST2  IF NO FIND 
          SX6    -B1
          SA6    A2          SET TO *THIS ENTRY IS AVAILABLE* 
          EQ     ST=UST2
 ST=WHR   SPACE  4,8
*         HERE TO PROCESS *WHERE ADDR1,...,ADDRN*.
  
 ST=WHR   BSS    0
          ZR     X5,ST=WHR2A IF EOS ENCOUNTERED 
  
 ST=WHR2  RJ     PAS         PARSE SUBEXPRESSION
          NZ     X3,ST=WHR3  IF ADDR NOT NULL 
  
 ST=WHR2A SA1    IDPPREG
  
 ST=WHR3  MX0    -18
          BX1    -X0*X1 
          LX0    X1          SAVE (X1) = ADDR 
          RJ     COD         CONVERT BINARY TO OCTAL DPC
          LX6    9*CHAR-6*CHAR
          BX1    X0 
          SA6    SNAPLNE
  
 #FRA     IF     DEF,FRA= 
          SB7    ST=WHR4     (B7) = RETURN ADDRESS FOR *FRA=* 
          EQ     =XFRA=      FIND RELATIVE ADDRESS
  
 ST=WHR4  SA6    A6+B1
          SA7    A6+B1
  
 #FRA     ELSE
          MX6    0
          SA6    A6+B1       MARK EOL 
 #FRA     ENDIF 
  
          PRIDP  SNAPLNE
          NZ     X5,ST=WHR2  IF NOT EOS TOKEN 
          EQ     IDP=MN 
 ST=XEQ   SPACE  4,8
*         HERE TO PROCESS *XEQ*.
  
 ST=XEQ   =      ST=STP6
 ST=XFR   SPACE  4,8
*         HERE TO PROCESS *XFER NR*.
  
 ST=XFR   ZR     X5,ST=XFR1  IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION -- NR
          NZ     X3,ST=XFR2  IF NR NOT NULL 
  
 ST=XFR1  SX6    L.XFT       (X6) = DEFAULT NR = ALL ENTRIES
  
 ST=XFR2  RJ     LXT         LIST XFER TABLE
          EQ     IDP=MN 
 ST=XNR   SPACE  4,8
*         HERE TO PROCESS *STNR,NR,L,RJ*. 
  
 ST=XNR   SX6    XTC=NR 
          SA6    IDPXTC 
          ZR     X5,ST=STP5  IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION-- NR 
          ZR     X3,ST=STP5  IF NR IS NULL
          SA6    IDPXA1 
          SA6    IDPXA2 
          EQ     ST=STP5     REJOIN NORMAL STEP PROCESSING FLOW...
 ADZ      SPACE  4,8
**        ADZ - ADD A WORD TO IDP TABLE.
* 
* 
*                THIS ROUTINE WILL ADD A SINGLE WORD TO AN IDP FIXED
*         LENGTH TABLE THAT IS TERMINATED BY A ZERO WORD, AND WHERE 
*         AN AVAILABLE SPACE IS MARKED BY A -1. 
* 
*         ENTRY  (X6)   =  WORD TO BE ADDED TO TABLE
*                (B6)   =  FWA OF TABLE 
* 
*         EXIT   TO *IDP=OV* IF TABLE OVERFLOW
*                (X1)   =  -1 IF ENTRY ALREADY IN TABLE, ELSE 
*                       =  ENTRY THAT WAS MADE IN TABLE 
*                (B7)   =  ORDINAL OF ENTRY THAT WAS MADE OR OF MATCHING
*                            ENTRY
* 
*         USES   X - 0,1,2,3,6,7
*                A - 1,2
*                B - 7
* 
*         CALLS  IDP.ER,PRIDP,SKT 
  
  
 ADZ      SUBR               ** ENTRY/EXIT ** 
          BX1    X6 
          MX0    60 
          SA6    ADZA        SAVE (X6)
          RJ     SKT         SEARCH TO SEE IF ENTRY ALREADY IN TABLE
          SX1    -B1
          NZ     X2,EXIT.    IF ENTRY ALREADY IN TABLE
          RJ     SKT         SEARCH FOR AVAILABLE SPACE 
          ZR     X2,IDP=OV   IF NO AVAILABLE SPACE LEFT 
          SA1    ADZA 
          BX6    X1 
          SA6    A2          MAKE NEW TABLE ENTRY 
          EQ     EXIT.
  
  
 ADZA     BSSZ   1
 BRK      SPACE  4,8
**        BRK - BREAK PROCESSOR.
* 
* 
*         1. IF THIS IS AN ASSEMBLED BREAK (NOT *IDP* GENERATED), 
*            THEN CONTROL IS MERELY RETURNED TO CALLER. 
* 
*         2. IF THIS IS AN *IDP* GENERATED BREAK, THE 2 PARALLEL TABLES,
*            *IDPBA/IDPBC*, ARE QUERIED FOR INFORMATION THAT WILL BE
*            PLUGGED INTO A DUMMY PARAMETER LIST FOR THIS BREAK. THE
*            PREVIOUS CONTENTS OF THE BREAK ADDR ARE PICKED UP FROM 
*            *IDPBC* AND PLUGGED AT *ST=ENDX* SO THAT THEY CAN BE 
*            EXECUTED BEFORE EXITING *IDP*. 
* 
*         TABLE FORMATS ARE-- 
* 
*         IDPBA ENTRY AT (IDPBA+ORDINAL)
* 
*         VFD    6/BREAK TYPE CODE (BTC)
*         VFD    18/ ADDR1
*         VFD    18/ ADDR2   FOR A CONDITIONAL BREAK (BRNE,...) THE 
*                              CONTENTS OF THE CORE LOCATION ADDR1 WILL 
*                              BE COMPARED TO THE CONTENTS OF CORE
*                              LOCATION ADDR2.
*         VFD    18/ BREAK ADDR 
* 
*         IDPBC ENTRY AT (IDPBC+2*ORDINAL)
* 
*         VFD    60/ PREVIOUS CONTENTS OF BREAK ADDR
*         VFD    15/ LL 
*         VFD    15/ UL 
*         VFD    12/ INC
*         VFD    18/ SNAP COUNT 
* 
*            IF THIS IS A CONDITIONAL *IDP* GENERATED BREAK 
*            (BRPL,BREQ,...), THE RELATIONAL CONDITION IS EVALUATED.
*            A TRUE RESULT MEANS THE BREAK WILL BE HONORED, A FALSE THAT
*            IT WILL NOT. 
* 
*         ENTRY  (X1)    =   (IDPPREG)  PSEUDO P REGISTER 
*                            (IDPPREG)-1 = ADDR OF IDP CALLER (BREAK AD)
*                (A5,    =   (IDPPREG)-1
*                    X5) =   FWA OF PARAMETER LIST
*                        =   .ZR. IF *IDP* GENERATED BREAK
* 
*         EXIT   (X5)    =   FWA OF PARAMETER LIST FOR THIS BREAK 
*                              (OR DUMMY PARAMETER LIST FOR *IDP* BREAK)
*                        =   .ZR. IF NO BREAK THIS TIME 
* 
*         USES   X - ALL
*                A - 1,2,3,6,7
*                B - 5,6,7
* 
*         CALLS  CBC,SKT
  
  
 BRK      SUBR               ** ENTRY/EXIT ** 
          SX6    X5 
          MX7    -0 
          SX1    X1-1        (X1) = BREAK ADDR
          SA6    FWAPARM
          NZ     X5,EXIT.    IF NOT *IDP* GENERATED BREAK 
  
*         SET UP DUMMY APLIST FOR *IDP* GENERATED BREAK.
  
          SX6    APL         (X6) = FWA OF DUMMY APLIST 
          SA7    AP=HDR      SET TO *IDP GENERATED BREAK HEADER*
          SA6    A6 
          MX0    -18
          SX5    X6 
          BX0    -X0
          SB6    IDPBA
          RJ     SKT         SEARCH FOR BREAK ADDR
          ZR     X2,*+4S15   IF NO FIND, IRRETRIEVABLE ERROR... 
          SB6    B7+B7
          SA3    IDPBC+B6+1  (X3) = 15/LL,15/UL,12/INC,18/CNT 
          SX6    X3 
          BX7    -X0*X3      (X7) = 15/LL,15/UL,12/INC,18/0 
          SA6    AP=CNT 
          SX4    X3+B1       (X4) = CNT+1 
          BX7    X7+X4       (X7) = 15/LL,15/UL,12/INC,18/CNT+1 
          SA7    A3 
          MX0    -15
          LX3    15 
          BX6    -X0*X3      (X6) = LL
          LX3    15 
          BX7    -X0*X3      (X7) = UL
          SA6    AP=LL
          SA7    A6+B1
          MX0    -12
          LX3    12 
          BX6    -X0*X3      (X6) = INC 
          SA6    A7+B1
  
*         SET UP EXIT SO THAT PREVIOUS CONTENTS OF BREAK ADDR WILL BE 
*           EXECUTED BEFORE EXITING *IDP*.
* 
          SA3    A3-B1       (X3) = PREVIOUS CONTENTS OF BREAK ADDR 
          BX6    X3 
          SA6    ST=ENDX
  
*         CHECK TO SEE IF BREAK CONDITION SATISFIED.
  
          MX0    -6 
          LX2    6
          BX6    -X0*X2      (X6) = BREAK TYPE CODE (BTC) 
          SB5    X6 
          MX0    -18
          LX2    18 
          BX6    -X0*X2 
          SA1    X6          (X1) = (ADDR1) 
          LX2    18 
          BX6    -X0*X2 
          SA2    X6          (X2) = (ADDR2) 
          RJ     CBC         CHECK BREAK CONDITION
          NZ     B6,EXIT.    IF CONDITION WAS SATISFIED (TRUE)
          MX5    0
          EQ     EXIT.
 BUB      SPACE  4,8
**        BUB - BURST/BUILD IDP COMMAND.
* 
* 
*                THIS ROUTINE BURSTS AND BUILDS A PACKED (I.E. 10 CHARS 
*         PER WORD) SOURCE LINE AT *IDPLIM* ET SEQ INTO ITS TOKEN FORM. 
* 
*         GENERAL TOKEN FORMAT IS --
* 
*         VFD    42/0L_CHARS,18/TOKEN TYPE
*                CHARS = DISPLAY CODE CHARACTERS THAT CONSTITUTE THIS 
*                          TOKEN
*                TOKEN TYPE = A TYPE CODE THAT IS USED TO DISTINGUISH 
*                               ONE TOKEN FROM ANOTHER. (NOTE--BIT 17 
*                               OF TOKEN TYPE MUST BE 0)
* 
*         TOKEN TYPES ARE --
* 
*         O.VAR  VARIABLE OR NAME TOKEN  (ALPHANUMERIC) 
*         O.CONS CONSTANT TOKEN  (NUMERIC)
*         O.SEP  SEPARATOR TOKEN (E.G. *,+-)
* 
*         E.G. IF ; IS THE END-OF-STMT CHARACTER -- 
* 
*         SNAP,NAME,,4;REG,X1 
* 
*         WOULD BECOME -- 
*         VFD    42/OTHER ,18/LEN OF STMT = 7 
*         VFD    42/4LSNAP,18/O.VAR 
*         VFD    42/1L,   ,18/O.SEP 
*         VFD    42/4LNAME,18/O.VAR 
*         VFD    42/1L,   ,18/O.SEP 
*         VFD    42/1L,   ,18/O.SEP 
*         VFD    42/1L4   ,18/O.CONS
*         VFD    60/0  ** EOS **
* 
*         VFD    42/OTHER ,18/LEN OF STMT = 4 
*         VFD    42/3LREG ,18/O.VAR 
*         VFD    42/1L,   ,18/O.SEP 
*         VFD    42/2LX1  ,18/O.VAR 
*         VFD    60/0  ** EOS **
* 
*         ENTRY  (A5,X5)   = A+C OF 1ST WORD OF SOURCE LINE IMAGE 
*                              TO BE BURST/BUILT
*                (A6)+1    = ADDR TO STORE 1ST TOKEN THAT IS BURST/BUILT
*                (L=LIM)   = NR OF WORDS IN SOURCE LINE IMAGE AT
*                              (IDPLIM) ET SEQ  (INCLUDES WORD
*                              CONTAINING EOL MARK) 
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  NONE 
  
  
 BUB      SUBR               ** ENTRY/EXIT ** 
  
*         FIRST TIME ONLY INITIALIZATION. 
  
          SX7    A6 
          MX0    -CHAR
          SA4    10*CHAR
          SA7    IDPSTMT
          SB3    CHAR 
          SB6    A4 
          SA0    B0          SET TO *LENGTH=0 FIRST TIME THROUGH* 
  
*         SET UP (B7) = NR OF WORDS TO BURST/BUILD (NOT INCLUDING WORD
*           CONTAINING EOL MARK).  I.E. (B7) WILL CONTAIN NR OF FULL
*           WORDS (10 CHARS EACH) TO BURST/BUILD.  THREE END-OF-LINE
*           CONDITIONS ARE SIGNIFICANT -- 
* 
*             (A5)+0         1     (X=ANY CHAR,0=00B) 
*                  XXXXXXXX00            (L=LIM) = 1, (B7) = 0
*                 +0         1
*                  XXXXXXXXXX0000000000  (L=LIM) = 1, (B7) = 1
*                 +0         1
*                  XXXXXXXXX00000000000  (L=LIM) = 2, (B7) = 0
  
          SA1    =XL=LIM     (X1) = NR OF WORDS IN SOURCE LINE IMAGE
*                                     (INCLUDES WORD CONTAINING EOL MRK)
          SB5    A5-2 
          SB7    X1-1        (B7) = NR OF WORDS IN SOURCE LINE IMAGE
*                                     (NOT INCLUDING WD CONTAINING EOL) 
          SA2    B5+X1       (A2,X2) = A+C OF NEXT TO LAST WORD OF LINE 
          ZR     B7,BUB2     IF 11 CHAR (66 BIT) EOL NOT POSSIBLE 
          BX6    -X0*X2 
          NZ     X6,BUB2     IF NOT 11 CHAR (66 BIT) EOL MARK 
          SB7    B7-B1
  
*         INITIALIZE FOR BURST/BUILD OF KEYWORD.
  
 BUB2     SA2    MX=KEYW
          MX1    0           SET TO *NOT SQUEEZING BLANKS*
          SB5    B0          SET TO *NOT SQUEEZING BLANKS*
          BX2    -X2
          EQ     BUB2B
  
*         INITIALIZE FOR BURST/BUILD OF NON-KEYWORD.
  
 BUB2A    SA1    =10H 
          SA2    MX=TOKN
          SB5    1R +7777B-1RM
  
*         COMMON INITIALIZATION FOR BURST/BUILD.
  
 BUB2B    SA3    BUB=LEN
          SX4    A0 
          IX7    X3-X4
          SB4    8*CHAR-1*CHAR
          BX6    X6-X6
          SA7    A3 
          NZ     B7,BUB4     IF 1ST WORD OF SOURCE LINE DOES NOT CONTAIN
*                              EOL MARK, INTO THE FIRE... 
  
*         HERE TO PROCESS WORD CONTAINING EOL MARK (I.E. LAST WORD OF 
*           SOURCE LINE) -- FIGURE OUT HOW MANY USEABLE (I.E. NON-EOL)
*           BITS ARE IN FINAL WORD TO BE BURST/BUILT. 
  
 BUB2C    MI     B7,BUB5     IF HAVE ALREADY PROCESSED LAST WORD OF LINE
          SA3    =40404040404040404040B 
          SX4    B1 
          IX7    X5-X4       BORROW RIPPLES LEFT TO 1ST NON-ZERO BIT
          BX4    -X7+X5      (X4) = ALL TRAILING 0 BITS IN (X1) = 0 BITS
*                                     ALL OTHER LEADING BITS = 1 BITS 
          SB2    60-5        (B2) = RIGHT CIRCULAR SHIFT 5 BITS 
          BX7    X3*X4       (X7) = 40B WHERE EACH CHAR IN LAST WORD IS 
          LX4    X7,B2       (X4) = 01B WHERE EACH CHAR IN LAST WORD IS 
          IX3    X7-X4       (X3) = 37B WHERE EACH CHAR IN LAST WORD IS 
          BX4    X7+X3       (X4) = 77B WHERE EACH CHAR IN LAST WORD IS 
          CX7    X4 
          SB7    B7-B1       (B7) = SET WORD COUNT TO -1 (I.E. BURSTING 
*                                     LAST WD) TO AVOID LOOPING AT BUB2B
          SB6    X7          (B6) = NR OF BITS TO BU/BU IN LAST WD (X5) 
          EQ     BUB4        BURST/BUILD LAST WORD... 
  
*         BURST/BUILD LOOP  ** INSTACK ** 
  
 BUB3     SB7    B7-B1
          SA5    A5+B1
          LE     B7,B0,BUB2C IF NO MORE SOURCE WORDS TO BURST/BUILD 
          IX7    X5-X1
          SB6    A4 
          ZR     X7,BUB3     IF NEXT SOURCE IMAGE WORD IS ALL BLANK 
  
 BUB4     LX5    CHAR 
          LE     B6,B0,BUB3  IF SOURCE IMAGE WORD (X5) IS EXHAUSTED 
          BX4    -X0*X5 
          SB6    B6-B3
          SB2    X4+7777B-1RM 
          NO
          LX7    X2,B2
          EQ     B2,B5,BUB4  IF CHAR TO PACK IS A BLANK (55B) 
          LX3    X4,B4
          SB4    B4-B3
          MI     X7,BUB5     IF NEXT CHAR TO PACK IS TERMINATOR 
          BX6    X6+X3
          GE     B4,B0,BUB4  IF PACKING REG (X6) NOT FULL 
  
*         HERE IF AN ERROR -- TERMINATE TOKEN BUFFER. 
  
          SA1    IDPSTMT
          MX6    1
          SX2    B1 
          BX6    X6+X2       (X6) = 1/1=LAST STMT ON LINE,41/0,18/LEN 
          SA6    X1 
          EQ     IDP=ER      ERROR - TOKEN .GT. 7 CHARS 
  
*         HERE TO STORE PACKING REG (X6). 
  
 BUB5     LX6    10*CHAR-8*CHAR (X6) = 42/0LNAME,18/0 
          SA1    BUB=LEN
          SA0    B1 
          SA2    MX=NR09
          LX7    X6,B3
          BX7    -X0*X7 
          SX3    X1-3-1 
          SB4    X7 
          LX2    X2,B4
          PL     X3,BUB6     IF NO TABLE OVERFLOW IMPENDING 
  
*         HERE IF AN ERROR -- TERMINATE TOKEN BUFFER. 
  
          SA1    IDPSTMT
          MX6    1
          SX2    B1 
          BX6    X6+X2       (X6) = 1/1=LAST STMT ON LINE,41/0,18/LEN 
          SA6    X1 
          EQ     IDP=OV 
  
 BUB6     ZR     X6,BUB8     IF (X6) IS NULL, PROBABLE ,, SYNTAX
          SX7    O.VAR
          PL     X2,BUB7     IF 1ST CHAR IN (X6) IS NOT 0 THRU 9
          SX7    O.CONS 
  
 BUB7     BX6    X6+X7
          SA0    A0+B1
          SA6    A6+B1
  
*         CHECK FOR AND PROCESS END-OF-STATEMENT. 
  
 BUB8     SB2    -2 
          SX2    X4-1R"EOS" 
          LE     B7,B2,BUB9  IF NOTHING MORE TO BURST 
          NZ     X2,BUB10    IF NOT EOS CHARACTER 
  
 BUB9     SA1    IDPSTMT
          MX6    0
          SX2    A6+B1
          SA6    A6+B1       MARK EOS 
          IX7    X2-X1
          NO
          SA7    X1 
          LE     B7,B2,BUB11 IF FINISHED
          SX7    A6+B1       (X7) = ADDR OF LEN WORD FOR NEXT STMT
          SA6    A6+B1       (A6+1) = NEXT ADDR TO STORE
          SA0    A0+B1
          SA7    A1 
          EQ     BUB2        CRANK UP FOR NEW STMT... 
  
*         HERE TO STORE TERMINATOR CHARACTER (X4).
  
 BUB10    BX6    X4 
          SX7    O.SEP
          LX6    10*CHAR-1*CHAR 
          BX6    X6+X7       (X6) = 42/0LCHAR,18/O.SEP
          SA6    A6+B1
          EQ     BUB2A       CONTINUE...
  
 BUB11    MX6    1
          BX7    X6+X7
          SA7    X1 
          EQ     EXIT.
  
  
 BUB=LEN  =      APL         SAVED NR OF WORDS LEFT IN TOKEN BUFFER 
 CBC      SPACE  4,8
**        CBC - CHECK BREAK CONDITION.
* 
* 
*                THIS ROUTINE RETURNS A TRUE/FALSE VALUE FOR A GIVEN
*         LOGICAL EXPRESSION-- C1.OP.C2 
* 
*         NOTE-- THE OPERATOR JUMP TABLE AT *CBC.OP* HAS A ONE-TO-ONE 
*         ORDER DEPENDENT RELATIONSHIP WITH THE *BREAK* KEYWORDS AT 
*         (IDPKBR) ET SEQ. SHOULD A CHANGE BE EFFECTED TO EITHER TABLE, 
*         BOTH SHOULD BE CHECKED FOR CONSISTENCY. 
* 
*         ENTRY  (X1) = C1   1ST QUANTITY 
*                (X2) = C2   2ND QUANTITY 
*                (B5) = BREAK TYPE CODE (BTC) 
* 
*         EXIT   (B6) = .NZ. IF TRUE, ELSE .ZR. IF FALSE
* 
*         USES   X - 0,3,6,7
*                A - NONE 
*                B - 6
* 
*         CALLS  NONE 
  
  
 CBC      SUBR               ** ENTRY/EXIT ** 
          MI     B5,*+4S15   IF BTC IS BAD, AVOID SMELLY EVIL BUG...
          SB6    CBC2-CBC.OP (B6) = NR OF OPERATOR JP TABLE ENTRIES 
          GT     B5,B6,*+4S15  IF BTC IS BAD, P U...DUMMKOPF
          SB6    B1          SET TO *CONDITION SATISFIED (TRUE)*
          ZR     B5,EXIT.    IF UNCONDITIONAL BREAK 
          BX3    X1-X2
          IX6    X1-X2
          IX7    X2-X1
          MX0    0
          IX6    X6+X0       REMOVE POSSIBLE -0 
          IX7    X7+X0
          JP     CBC.OP+B5-1
  
*         CBC.OP - OPERATOR JUMP TABLE. 
  
 CBC.OP   BSS    0
          LOC    1
  
*         HERE FOR .PL.C1 
  
 +        PL     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR .MI.C1 
  
+         MI     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR .ZR.C1 
  
 +        ZR     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR .NZ.C1 
  
 +        NZ     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.EQ.C2 
  
 +        ZR     X3,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.NE.C2 
  
 +        NZ     X3,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.LT.C2 
  
 +        MI     X6,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.GE.C2 
  
 +        PL     X6,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.LE.C2 
  
 +        PL     X7,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.GT.C2 
  
 +        MI     X7,EXIT.    IF TRUE
          EQ     CBC2 
  
          LOC    *O 
  
*         HERE FOR CONDITION NOT SATISFIED (FALSE). 
  
 CBC2     SB6    B0 
          EQ     EXIT.
 CLZ      SPACE  4,8
**        CLZ - CLEAR *IDP* TABLE.
* 
* 
*                THIS ROUTINE WILL CLEAR AN *IDP* ZERO TERMINATED TABLE 
*         BY SETTING ALL ENTRIES TO *AVAILABLE*, I.E. -1. 
* 
*         ENTRY  (B6) = FWA OF TABLE TO BE CLEARED
* 
*         EXIT   NONE 
* 
*         USES   X - 1,6
*                A - 1,6
*                B - NONE 
* 
*         CALLS  NONE 
  
  
 CLZ      SUBR               ** ENTRY/EXIT ** 
          SA1    B6 
          MX6    -1 
  
 CLZ2     ZR     X1,EXIT.    IF FINISHED
          SA6    A1 
          SA1    A1+B1
          EQ     CLZ2 
 CON      SPACE  4,8
**        CON - CONNECT/DISCONT FILE. 
* 
* 
*         ENTRY  (A1,X1) = A + C OF 1ST WORD OF FET OF FILE 
*                (X2)    = +0  IF TO CONNECT
*                        =  1  IF TO DISCONT
* 
*         EXIT   SCOPE 3--
*                (X1)    = .MI. IF PP ROUTINE *CON* DETECTED ERROR, 
*                                 ELSE .PL. 
*                KRONOS/NOS/SCOPE 2-- NONE
* 
*         USES   ALL BUT A0,A5,X5 
* 
*         CALLS  SCOPE 3-- SYSTEM 
*                KRONOS/NOS-- CLOSE,REQUEST,WRITER
  
  
 CON      SUBR               ** ENTRY/EXIT ** 
  
 #OS2     IFEQ   .OS,2       IF SCOPE 2 
          EQ     EXIT.
 #OS2     ENDIF 
  
 #OS3     IFEQ   .OS,3       IF SCOPE 3 
          MX0    7*CHAR 
          BX6    X0*X1       (X6) = 42/0LFILENAME, 18/0 
          SA6    CONA 
          LX2    6
          SYSTEM CON,RCL,CONA,X2
  
          SA1    CONA 
          LX1    59-1 
          EQ     EXIT.
  
  
 CONA     BSSZ   1           PARAMETER WORD FOR PP ROUTINE *CON*--
*                              42/0LFILENAME
*                              16/0, 1/ERROR FLAG, 1/COMPLETE BIT 
  
 #OS3     ELSE               IF KRONOS/NOS
          SX6    A1 
          SA6    CONA        SAVE (A1) = FWA OF FET 
          NZ     X2,CON2     IF TO DISCONT FILE 
  
*         HERE TO CONNECT FILE. 
  
          WRITER A1,,RCL     FLUSH BUFFER 
          SA1    CONA 
          CLOSE  X1,,RCL     CLOSE FILE 
          SA1    CONA 
          SX6    2RTT 
          MX0    60-48
          SA2    X1+B1       (X2) = 12/DEVICE TYPE, 48/OTHER
          LX6    10*CHAR-2*CHAR 
          BX2    -X0*X2 
          IX6    X2+X6       (X6) = 12/2RTT, 48/OTHER 
          SA6    A2 
          REQUEST X1,TT      ASSIGN FILE TO TERMINAL
          EQ     EXIT.
  
*         HERE TO DISCONT FILE. 
  
 CON2     WRITER A1,,RCL     FLUSH BUFFER 
          SA1    CONA 
          CLOSE  X1,,RCL
          EQ     EXIT.
  
  
 CONA     BSSZ   1           SAVED FWA OF FET 
 #OS3     ENDIF 
 DAZ      SPACE  4,8
**        DAZ - DEASSEMBLER.
* 
* 
*                DEASSEMBLES A SINGLE BINARY INSTRUCTION TO ITS 
*         *COMPASS* MNEMONIC AND LISTS IT.
* 
*         ENTRY  (A5,     =  ADDR OF WORD CONTAINING INSTRUCTION TO 
*                              DEASSEMBLE 
*                    X5)  =  WORD CONTAINING INSTRUCTION TO DEASSEMBLE
*                            NOTE-- ((A5)) MIGHT NOT BE EQUAL TO (X5),
*                              AS WOULD BE THE CASE WHEN DASSEMBLING
*                              THE SAVED PREVIOUS CONTENTS OF AN IDP
*                              GENERATED BREAK (SEE *STP*)
*                (B4)     =  POSITION COUNTER. LEFT MOST BIT TO BE
*                              DEASSEMBLED IS BIT (B4)-1 IN (X5). 
*                              (BITS ARE NUMBERED 59 THRU 0) COMPASS
*                              EQUIVALENT WOULD BE--
*                                  POS   (B4)    IN (X5)
*                (IDPFAD) =  .NZ. IF *DAZ* IS TO UNCONDITIONALLY FORCE
*                                   OUT ADDR OF DEASSEMBLED INSTRUCTION,
*                         =  .ZR. IF ADDR IS TO APPEAR ONLY IF INSTR IS 
*                                   FORCED UPPER IN WORD, I.E. (B4)=60D 
* 
*         EXIT   (A5,X5)  =  UNCHANGED
*                (B4)     =  UNCHANGED
*                (X1)     =  .MI. IF INSTRUCTION DEASSEMBLED FORCES 
*                              UPPER, ELSE .PL. 
*                (B5)     =  NR OF BITS DEASSEMBLED IF NO FORCE UPPER,
*                         =  NR OF BITS IN INSTRUCTION THAT FORCED UPPER
*                (IDPFAD) =  +0 
* 
*         USES   ALL BUT A5,X5,B4 
* 
*         LOCKED (A6+1)   =  NEXT AVAILABLE *SNAPLNE* LOCATION
* 
*         CALLS  CAD,PRIDP,VFD                                          000930
  
  
 DAZ      SUBR               ** ENTRY/EXIT ** 
          SB6    60 
          LE     B4,B0,*+1S17  IF POSITION COUNTER IS BAD 
          SA1    =10H 
          SA2    IDPFAD 
          MX7    0
          BX6    X1 
          SA7    A2          CLEAR *FORCE OUT ADDR UNCONDITIONALLY* FLAG
          NZ     X2,DAZ1     IF FORCING OUT ADDR UNCONDITIONALLY
          LT     B4,B6,DAZ2  IF THIS INSTRUCTION NOT UPPER
  
*         HERE IF INSTRUCTION IS UPPER, OUTPUT ADDRESS. 
  
 DAZ1     SX0    B4          SAVE (B4)                                  000950
          SX1    A5          (X1) = ADDR OF INSTRUCTION TO DEASSEMBLE   000960
          RJ     CAD         CONVERT ADDR TO DPC                        000970
          SB4    X0          RESTORE (B4)                               000980
  
*         BREAK OUT OP CODE.
  
 DAZ2     SA6    SNAPLNE
          SB6    -B4
          MX0    -6 
          SB6    60+B6+6     60-(B4) = LEFT JUST SHIFT COUNT FOR INSTRTN
          LX5    X5,B6       (X5) = 54/OTHER STUFF, 6/OP CODE 
          BX7    -X0*X5 
          LX5    3           (X5) = 51/OTHER STUFF,6/OP CODE,3/I
          MX0    -3 
          SA7    DAZ=OP 
          ZR     X7,DAZ12    IF 00B OP CODE, REST OF WORD IS DATA 
  
*         BREAK OUT *I* FIELD.
  
          BX7    -X0*X5 
          LX5    3           (X5) = 48/OTHER STUFF,6/OP,3/I,3/J 
          SX7    X7+1R0 
          SA7    A7+B1       SAVE (X7) = 1R<I>
  
*         BREAK OUT *J* FIELD.
  
          BX7    -X0*X5 
          LX5    3           (X5) = 45/OTHER,6/OP,3/I,3/J,3/K 
          SX7    X7+1R0 
          SA7    A7+B1       SAVE (X7) = 1R<J>
  
*         BREAK OUT *K* FIELD.
  
          BX7    -X0*X5 
          LX5    18-3        (X5) = 30/OTHER,6/OP,3/I,3/J,18/Q
          SX7    X7+1R0 
          MX0    -18
          SA7    A7+B1       SAVE (X7) = 1R<K>
  
*         BREAK OUT *Q* 18 BIT ADDRESS FIELD. 
  
          BX1    -X0*X5      (X1) = 42/0,18/Q 
          SB5    B4          SAVE (B4)
          SB7    60-60+B4-6-3-3-3-15  (B7) = 60-((60-(B4))+6+3+3+3+15)
          SX7    X1 
          LX5    X5,B7       RESTORE (X5) 
          SA7    DAZ=ADR
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC-- *Q*
          SB4    B5          RESTORE (B4) 
          SB2    B2-B1
          MX0    1
          AX0    X0,B2
          BX7    X0*X4       (X7) = 0L<Q> 
          SA7    A7+B1
  
*         FETCH INSTRUCTION SKELETON AND CHECK FOR LENGTH CONFLICT. 
  
          SA1    DAZ=OP 
          SA2    DAZ=PS+X1   (X2) = INSTRUCTION SKELETON
          SB5    15 
          BX1    X5 
          PL     X2,DAZ3     IF SHORT (15 BIT) INSTRUCTION
          SB5    B5+B5       (B5) = 30
  
 DAZ3     LT     B4,B5,DAZ12 IF NOT ENOUGH ROOM FOR 30 BIT INSTR, 
*                                  MUST BE DATA 
  
*         CONVERT BINARY INSTRUCTION PARCEL TO OCTAL DPC. 
  
          RJ     VFD         VARIABLE FIELD DEFINITION
          SA6    A6+B1
          BX6    X7 
          SA6    A6+B1
  
*         CHECK FOR X REGISTER BRANCH INSTRUCTION.
  
          SA1    DAZ=OP 
          SA2    DAZ=PS+X1   (X2) = INSTRUCTION SKELETON
          SX6    X1-03B 
          NZ     X6,DAZ4     IF NOT X REGISTER BRANCH 
          SA1    DAZ=I
          SA2    DAZ=XJP+X1-1R0    (X2) = X REG BRANCH SKELETON 
  
*         GENERATE ...OPI....      (.=BLANK(55B)) 
  
 DAZ4     SA1    DAZ=OPI     (X1) = ...000....   (0=00B)
          MX0    -2*CHAR
          BX6    -X0*X2      (X6) = 2R<OP>
          LX6    7*CHAR-2*CHAR
          MX0    -4 
          LX2    3+4         (X2) = 56/OTHER STUFF,4/1ST DESCRIPTOR 
          BX3    -X0*X2 
          SA4    DAZ=I-1+X3 
          BX6    X1+X6       (X6) = ...OP0....   (0=00B)
          LX4    5*CHAR-1*CHAR
          BX6    X6+X4       (X6) = ...OPI....
  
*         ASSEMBLE NORMAL (I,J,K) ITEMS.
  
 DAZ5     SA6    A6+B1
          SB6    10*CHAR
          MX6    0
  
 DAZ6     LX2    4
          SB6    B6-CHAR
          BX3    -X0*X2      (X3) = DESCRIPTOR
          SA4    DAZ=I-1+X3 
          ZR     X3,DAZ11    IF END OF DESCRIPTOR LIST IN SKELETON
  
 DAZ7     MI     X4,DAZ8     IF THIS IS A CONDITIONAL ITEM
          LX4    X4,B6
          BX6    X6+X4
          GT     B6,B0,DAZ6  IF PACKING REG (X6) NOT FULL 
          EQ     DAZ5 
  
*         PROCESS AND ASSEMBLE CONDITONAL ITEM. 
  
 DAZ8     NZ     X4,DAZ9     IF *Q* 18 BIT ADDRESS
  
*         HERE TO PROCESS CONDITIONAL *B0* ASSEMBLY.
  
          LX2    4
          BX3    -X0*X2 
          SA4    DAZ=I-1+X3 
          SX7    X4-1R0 
          SX4    1RB
          LX2    -4          RESTORE (X2) 
          NZ     X7,DAZ7     IF NOT *B0* REFERENCE
  
*         HERE TO IGNORE *B0* REFERENCE.
  
          LX2    2*4         SKIP OVER *B0* AND SEPARATOR 
          SB6    B6+CHAR
          EQ     DAZ6 
  
*         HERE TO PROCESS *Q* 18 BIT ADDRESS. 
  
 DAZ9     SA1    DAZ=ADR+1   (X1) = 0L<Q>   (ALWAYS .LE. 6 CHARS) 
          MX0    -CHAR
  
*         ASSEMBLE *Q*. 
  
 DAZ10    LX1    CHAR 
          BX4    -X0*X1 
          ZR     X4,DAZ11    IF FINISHED ASSEMBLING *Q* 
          LX4    X4,B6
          SB6    B6-CHAR
          BX6    X6+X4
          GE     B6,B0,DAZ10 IF PACKING REG (X6) NOT FULL 
          SA6    A6+B1
          MX6    0
          SB6    10*CHAR-1*CHAR 
          EQ     DAZ10
  
*         STORE FINAL WORD. 
  
 DAZ11    BX1    X6 
          RJ     =XSFN       SPACE FILL NAME
          SA6    A6+B1
  
*         GENERATE RELATIVE ADDRESS.
  
 #FRA     IF     DEF,FRA= 
          SA1    DAZ=ADR
          SA2    =10H 
          SB3    SNAPLNE+5
          SB2    A6 
          SB7    DAZ11B      (B7) = RETURN ADDRESS FOR *FRA=* 
          SA0    B4          SAVE (B4)
          GE     B2,B3,DAZ11A IF WE DONT NEED BLANK FILL
          BX6    X2 
          SA6    A6+B1
  
 DAZ11A   SB6    30 
          MI     X1,DAZ11C   IF ADDR IS .MI. (I.E. NOT AN ADDRESS)
          LT     B5,B6,DAZ11C IF 15 BIT INSTRUCTION, NO RELATIVE ADDR 
          EQ     =XFRA=      FIND RELATIVE ADDRESS
  
 DAZ11B   SA1    A6          (X1) = XX........   .=BLANK(55B) 
*                              X=DIFFERENT CHARS DEPENDING ON DEASSEMBLY
          SB4    A0          RESTORE (B4) 
          MX0    3*CHAR 
          BX1    X0*X1       (X1) = XX.0000000   (.=BLANK(55B),0=00B) 
          LX6    -3*CHAR
          BX6    -X0*X6      (X6) = 000NNNNNN.   (.=BLANK(55B),0=00B) 
          BX6    X6+X1       (X6) = XX.NNNNNN.   (.=BLANK(55B)) 
          SA6    A1 
          SX1    3RIN 
          BX6    X7+X1       (X6) = XXXXXXXIN.   (.=BLANK(55B)) 
          LX6    10*CHAR-3*CHAR 
          SA6    A6+B1
 #FRA     ENDIF 
  
*         FINAL PROCESSING AND EXIT.
  
 DAZ11C   MX6    0
          SA6    A6+B1
          SX0    B5 
          PRIDP  =XSNAPLNE
          SB5    X0 
          SB6    59-57
          SA2    DAZ=OP 
          SA2    DAZ=PS+X2
          LX1    X2,B6       SET TO *FORCED UPPER(.MI.)/NOT UPPER(.PL.)*
          EQ     EXIT.
  
*         HERE IF OUTPUTING REST OF WORD AS DATA. 
  
 DAZ12    SB5    B4          (B5) = LENGTH OF REMAINDER OF INSTR WORD 
          SA1    A5          (X1) = INSTRUCTION WORD
          RJ     VFD         VARIABLE FIELD DEFINITION
          SA6    A6+B1
          SA7    A6+B1
          SA1    =7L   DATA 
          BX6    X1 
          SA6    A7+B1
          SX0    B5          SAVE (B5)
          PRIDP  =XSNAPLNE
          SB5    X0          RESTORE (B5) 
          MX2    0           SET TO *THIS IS A DATA ITEM* 
          MX1    1           SET TO *FORCED UPPER*
          EQ     EXIT.
  
  
 DAZ=ADR  BSSZ   1           18 BIT *Q* IN BINARY 
          BSSZ   1           18 BIT *Q* IN -0L- FORMAT
 DAZ=OPI  CON    3L   +4R 
 DAZ=OP   DATA   0           OP CODE FOR INSTRUCTION
 DAZ=I    DATA   0           *I* REGISTER PORTION OF INSTRUCTION
 DAZ=J    DATA   0           *J* REGISTER PORTION OF INSTRUCTION
 DAZ=K    DATA   0           *K* REGISTER PORTION OF INSTRUCTION
 DAZ=Q    DATA   -1          FLAG TO INDICATE 18 BIT *Q*
          DATA   1R+
          DATA   1R-
          DATA   1R*
          DATA   1R/
          DATA   1R,
          DATA   1RA
          DATA   1RB
          DATA   -0          FLAG TO INDICATE CONDITIONAL *B0* ASSEMBLY 
          DATA   1RX
          DATA   1R 
 INST     SPACE  4,8
**        INST - MACRO TO GENERATE INSTRUCTION SKELETONS. 
*         GENERATES TABLE OF INSTRUCTION SKELETONS USED BY *PIG* TO 
*                CONVERT INSTRUCTIONS TO HUMAN-READABLE FORM FOR THE
*                OBJECT CODE LISTING. 
* 
*         INST   (KEY),BJMP,FORCE,IJJ 
* 
*         *KEY*  = INSTRUCTION DESCRIPTOR.  EACH CHARACTER OF THE *KEY* 
*                  HAS MEANING AS FOLLOWS --
*                            I   I-PORTION OF INSTRUCTION 
*                            J   J-PORTION OF INSTRUCTION 
*                            K   K-PORTION OF INSTRUCTION (3 BITS ONLY) 
*                            Q   18-BIT *K* ADDRESS FIELD (MUST BE LAST)
*                            C   OUTPUT A *B* IF THE NEXT REGISTER IS 
*                                            NOT A ZERO,
*                                            ELSE, SKIP THE NEXT 2 ITEMS
*                            + - * / A B X , AND BLANK ALL STAND FOR
*                                            THEMSELVES.
*         *BJMP* = NON-EMPTY IF THIS A *B-REGISTER* JUMP INSTRUCTION. 
*                            (04 THRU 07 INSTRUCTION.)
*         *FORCE*= THIS INSTRUCTION FORCES THE NEXT INSTRUCTION UPPER.
*         *COPY* = COPY *J* INTO *K*. 
  
 P.COPY   =      2*CHAR 
          NOREF  D,L
  
  
 INST     MACRO  KEY,BJMP,FORCE,IJJ 
 A        MICRO  3,1,=KEY=
 B        MICRO  5,,=KEY= 
 B        MICRO  1,,="A""B"=
 C        MICCNT B
 D        SET    0
 L        SET    0
 A        MICRO  C+3,1,=KEY=
          IFC    EQ,="A"=Q=,1 
 L        SET    L+4
          IFC    NE,,BJMP,,,1 
 L        SET    L+2
          IFC    NE,,FORCE,,,1
 L        SET    L+1
          VFD    3/L
.1        DUP    C
 D        SET    D+1
 A        MICRO  D,1,="B"=
 A        MICRO  2*1R"A"-1,2,/101112-D-E-F-G-H010203-L-M-N-O-P04-R-S-T-U
,-V-W13-Y-Z-0-1-2-3-4-5-6-7-8-905060708-(-)-$-=1409/
          VFD    4/"A"
.1        ENDD
          IFLE   $,2*6-1+4,1
 8        ERR    INST - DESCRIPTOR (KEY) IS TOO LONG
          POS    P.COPY+1 
 A        MICRO  1,2, KEY 
          VFD    1/IJJ,12/2R"A" 
 INST     ENDM
 DAZ=PS   SPACE  4,8
**        DAZ=PS - INSTRUCTION SKELETON TABLES FOR *DAZ*. 
  
  
 DAZ=PS   INST   (PS  Q)               00    (FAKE) 
          INST   (RJ  Q),,1            01 
          INST   (JP  CI+Q),,1         02 
          INST   (JXI XJ,Q)            03I  (FAKE)
 DAZ=EQ   INST   (EQ  CI,CJ,Q),1       04 
          INST   (NE  CI,CJ,Q),1       05 
          INST   (GE  BI,CJ,Q),1       06 
          INST   (LT  BI,CJ,Q),1       07 
  
          INST   (BXI XJ),,,1          10 
          INST   (BXI XJ*XK)           11 
          INST   (BXI XJ+XK)           12 
          INST   (BXI XJ-XK)           13 
          INST   (BXI -XJ),,,1         14 
          INST   (BXI -XK*XJ)          15 
          INST   (BXI -XK+XJ)          16 
          INST   (BXI -XJ-XK)          17 
  
          INST   (LXI JKB)             20 
          INST   (AXI JKB)             21 
          INST   (LXI CJ,XK)           22 
          INST   (AXI CJ,XK)           23 
          INST   (NXI CJ,XK)           24 
          INST   (ZXI CJ,XK)           25 
          INST   (UXI CJ,XK)           26 
          INST   (PXI CJ,XK)           27 
  
          INST   (FXI XJ+XK)           30 
          INST   (FXI XJ-XK)           31 
          INST   (DXI XJ+XK)           32 
          INST   (DXI XJ-XK)           33 
          INST   (RXI XJ+XK)           34 
          INST   (RXI XJ-XK)           35 
          INST   (IXI XJ+XK)           36 
          INST   (IXI XJ-XK)           37 
  
          INST   (FXI XJ*XK)           40 
          INST   (RXI XJ*XK)           41 
          INST   (DXI XJ*XK)           42 
          INST   (MXI JKB)             43 
          INST   (FXI XJ/XK)           44 
          INST   (RXI XJ/XK)           45 
          INST   (NO  IJKB)            46 
          INST   (CXI XK),,,1          47 
  
          INST   (SAI AJ+Q)            50 
          INST   (SAI CJ+Q)            51 
          INST   (SAI XJ+Q)            52 
          INST   (SAI CK+XJ)           53 
          INST   (SAI CK+AJ)           54 
          INST   (SAI AJ-BK)           55 
          INST   (SAI CK+BJ)           56 
          INST   (SAI -BK+BJ)          57 
  
          INST   (SBI AJ+Q)            60 
          INST   (SBI CJ+Q)            61 
          INST   (SBI XJ+Q)            62 
          INST   (SBI CK+XJ)           63 
          INST   (SBI CK+AJ)           64 
          INST   (SBI AJ-BK)           65 
          INST   (SBI CK+BJ)           66 
          INST   (SBI -BK+BJ)          67 
  
          INST   (SXI AJ+Q)            70 
          INST   (SXI CJ+Q)            71 
          INST   (SXI XJ+Q)            72 
          INST   (SXI CK+XJ)           73 
          INST   (SXI CK+AJ)           74 
          INST   (SXI AJ-BK)           75 
          INST   (SXI CK+BJ)           76 
          INST   (SXI -BK+BJ)          77 
  
 DAZ=XJP  INST   (ZR  XJ,Q)            030
          INST   (NZ  XJ,Q)            031
          INST   (PL  XJ,Q)            032
          INST   (MI  XJ,Q)            033
          INST   (IR  XJ,Q)            034
          INST   (OR  XJ,Q)            035
          INST   (DF  XJ,Q)            036
          INST   (ID  XJ,Q)            037
 DOD      SPACE  4,8
**        DOD - DUMP CENTRAL MEMORY -- OCTAL AND DPC. 
* 
* 
*                CONVERTS CM WORDS TO OCTAL DPC AND ALSO DUMPS THE
*         UNCONVERTED DPC EQUIVALENT IN THE FOLLOWING FORMAT--
*     COL 1         1         1         1         1         1 
*         .NNNNNN.+.CCCCCCCCCCCCCCCCCCCC..........UUUUUUUUUU            001000
*         N = ADDR OF WORD DUMPED 
*         + = + IF *NNNNNN* IS DECK RELATIVE, ELSE                      001020
*           = BLANK(55B) IF *NNNNNN* IS ABSOLUTE ADDR.                  001030
*         C = CONVERTED CM WORD 
*         U = UNCONVERTED CM WORD. NOTE--TRAILING COLONS ARE TREATED AS 
*               AN EOL AND THEREFORE WILL NOT APPEAR. 
*         . = BLANK(55B)
* 
*         ENTRY  (X2) = 18/0,21/LEV OF IND ADDR,21/FWA
*                (X3) = 18/0,21/LEV OF IND ADDR,21/LWA
*                       NOTE-- (X3) IS OPTIONAL 
*                (X4) = 18/0,21/LEV OF IND ADDR,21/LEN
*                         NOTE-- IF LEN = 0, DMP IS FROM FWA TO LWA,
*                         ELSE DMP IS FROM FWA TO FWA+LEN-1 
* 
*         EXIT   (B2) = .MI. IF FWA,LWA, OR LEN IS BAD, ELSE .PL. 
* 
*         USES   ALL                        (INCLUDES ALL CALLS)        001050
* 
*         CALLS  CAD,FLL,PRIDP,WOD                                      001070
  
  
 DOD      SUBR               ** ENTRY/EXIT ** 
          RJ     FLL         CHECK FWA,LWA, AND LENGTH
          MI     B2,EXIT.    IF FWA,LWA, OR LEN IS BAD
  
*         HERE TO BUILD SNAP OUTPUT LINE. 
  
 DOD2     SA1    AP=FWA      (X1) = ADDR OF NEXT WORD TO DUMP 
          SA2    A1+B1       (X2) = LWA TO DUMP 
          IX3    X2-X1
          SX6    X1+B1
          SB2    B0          SET TO *NO ERROR OCCURRED* 
          MI     X3,EXIT.    IF FINISHED
          SA6    A1 
          SA0    X1 
          RJ     CAD         CONVERT ADDR TO DPC                        001090
          SA6    SNAPLNE
          SA1    A0          (X1) = NEXT WORD TO BE DUMPED
          RJ     =XWOD       CONVERT A FULL BINARY WORD TO OCTAL DPC
          SA6    A6+B1
          SA7    A6+B1
          SA1    =10H 
          SA2    A0 
          BX6    X1 
          LX7    X2 
          SA6    A7+B1
          SA7    A6+B1
          MX6    0
          SA6    A7+B1       MARK EOL 
          PRIDP  SNAPLNE
          EQ     DOD2 
 FRZ      SPACE  4,8                                                    000710
**        FRZ - FREEZE INTERACTIVE SESSION.                             000720
*                                                                       000730
*                                                                       000740
*         PERFORMS A CHECKPOINT OF AN INTERACTIVE SESSION BY            000750
*         WRITING THE CURRENT CORE IMAGE TO LFN *F.FRZ* IN A            000760
*         SPECIAL FORMAT.                                               000770
*                                                                       000780
*         *F.FRZ* FORMAT --                                             000790
*                                                                       000800
*           RECORD 1 CONSISTS OF A LOADER ABSOLUTE BINARY, CALLED *IFR* 000810
*           (IDP FREEZE RESTART), THAT WHEN EXECUTED WILL READ THE      000820
*           FROZEN HOST BACK INTO CORE (OVERLAYING ITSELF), AND         000830
*           THEN REINVOKE *IDP*.                                        000840
*                                                                       000850
*           RECORD 2 CONTAINS THE CORE IMAGE OF THE FROZEN HOST.        000860
*                                                                       000870
*         SEE ROUTINE *IFR* IN DATA SECTION BEGINNING AT ADDR *FW.IFR*. 000880
*                                                                       000890
*         ENTRY  NONE                                                   000900
*                                                                       000910
*         EXIT   *F.FRZ* WRITTEN                                        000920
*                                                                       000930
*         USES   ALL BUT A0,X0,A5,X5   (INCLUDES ALL CALLS)             000940
*                                                                       000950
*         CALLS  MEMORY,REWIND,WRITER,WRITEW                            000960
                                                                        000970
                                                                        000980
 FRZ      SUBR               ** ENTRY/EXIT **                           000990
                                                                        001000
*         FIND OUT ACTUAL FIELD LENGTH SCM (AFLS) SO THAT *IFR*         001010
*         CAN KNOW HOW MUCH IS NEEDED TO RESTART.  IF *CMM* IS ACTIVE,  001020
*         SAVE THIS KNOWLEDGE SO THAT *IFR* CAN INDICATE SO             001030
*         TO OPERATING SYSTEM.                                          001040
                                                                        001050
          SA1    RA.LWP                                                 001060
          BX6    X6-X6                                                  001070
          SX7    X1          (X7) = .MI. IF *CMM* ACTIVE, ELSE .PL.     001080
          SA6    MEM#HOST                                               001090
          MEMORY SCM,A6,RCL                                             001100
          SX2    B1                                                     001102
          AX7    59          (X7) = -0 IF *CMM* ACTIVE, ELSE +0         001110
          SA1    MEM#HOST                                               001120
          BX7    X2*X7       (X7) = 1 IF *CMM* ACTIVE, ELSE +0          001122
          LX7    2-0                                                    001130
          SX7    X7+B1       SET BIT 1S0                                001140
          BX6    X1-X7       SET *CMM* IF APPROPRIATE/CLEAR COMPLETE BIT001150
          SA6    A1                                                     001160
                                                                        001170
*         NEED TO SAVE 3 SPECIAL WORDS BECAUSE WE ARE ONLY WRITING      001180
*         FROM *RA.MTR+1* TO FL-2 TO *F.FRZ*.                           001190
*           1. SAVE (RA.SSW) BECAUSE APPARENTLY *CIO* WILL SOMETIMES    001200
*              NOT ALLOW ONE TO HAVE *RA.MTR* IN CIO BUFFER AREA.       001210
*           2. SAVE WORDS AT FL-1 AND FL-2 BECAUSE LWA AND LWA+1 OF CIO 001220
*              BUFFER ARE NOT WRITTEN.                                  001230
                                                                        001240
          AX1    30          (X1) = AFLS OF FROZEN HOST                 001250
          SA2    RA.SSW                                                 001260
          SA3    X1-2                                                   001270
          SA4    A3+B1                                                  001280
          BX6    X2                                                     001290
          LX7    X3                                                     001300
          SA6    FRZ#SAV                                                001310
          SA7    A6+B1                                                  001320
          BX6    X4                                                     001330
          SA6    A7+B1                                                  001340
                                                                        001350
*         SET UP AND *OPEN* *F.FRZ* FET FOR RECORD 1 WRITE.             001360
*         FIRST, THOUGH, WE NEED TO SET THE *COMPLETE* BIT              001370
*         IN *F.FRZ* FET BECAUSE IF WE ARE NOW FREEZING AN              001380
*         INTERACTIVE SESSION THAT WAS PREVIOUSLY FROZEN AND UNFROZEN,  001390
*         THEN *F.FRZ* IS MARKED AS STILL BEING ACTIVE.  THIS HAPPENS   001400
*         BECAUSE WHEN THE PREVIOUS SESSION WAS FROZEN, *F.FRZ* WAS     001410
*         USED TO WRITE ITSELF OUT, AND WAS THEREFORE STILL ACTIVE WHEN 001420
*         CORE IMAGE WAS WRITTEN TO DISK.                               001430
                                                                        001440
          SA1    F.FRZ                                                  001450
          MX2    -1                                                     001460
          BX6    -X2+X1      SET COMPLETE BIT                           001470
          SA6    A1                                                     001480
                                                                        001490
          SX6    FW.IFR                                                 001500
          SX7    FW.IFR+L.IFR-1                                         001510
          SA6    A6+B1       FIRST  = FW.IFR                            001520
          SA7    A6+B1       IN     = FW.IFR+L.IFR-1                    001530
          SA6    A7+B1       OUT    = FW.IFR                            001540
          SX7    X7+B1                                                  001550
          SA7    A6+B1       LIMIT  = FW.IFR+L.IFR                      001560
                                                                        001570
          OPEN   A1,,RCL                                                001580
          SA1    F.FRZ+4     (X1) = LIMIT                               001590
          SX6    X1-1                                                   001600
          SA6    F.FRZ+2     IN = LIMIT-1                               001610
                                                                        001620
*         WRITE INTERACTIVE FREEZE RESTART PROGRAM, *IFR*,              001630
*         TO RECORD 1 OF *F.FRZ*.                                       001640
                                                                        001650
          WRITER F.FRZ,,RCL                                             001660
                                                                        001670
*         SET UP *F.FRZ* FET SO THAT BUFFER IS RA.MTR+1 THRU FL-1.      001680
                                                                        001690
          SA1    MEM#HOST                                               001700
          SX6    RA.MTR+1    (X6) = FIRST = OUT                         001710
          LX1    30                                                     001720
          SX7    X1-2        (X7) = IN = AFLS-2 (FOR SAFETY)            001730
          SA6    F.FRZ+1     FIRST = RA.MTR+1                           001740
          SA7    A6+B1       IN =AFLS-2                                 001750
          SA6    A7+B1       OUT = RA.MTR+1                             001760
          SX7    X7+B1       (X7) = LIMIT = AFLS-1 (FOR SAFETY)         001770
          SA7    A6+B1       LIMIT = AFLS-1                             001780
                                                                        001790
*         WRITE ALL OF SCM TO *F.FRZ/RECORD 2*.                         001800
                                                                        001810
          WRITER F.FRZ,,RCL                                             001820
          EQ     EXIT.                                                  001830
                                                                        001840
                                                                        001850
 FRZ#SAV  =      APL         FWA OF SAVE AREA FOR (RA.SSW), (FL-2),     001860
*                            AND (FL-1)                                 001870
 IIF      SPACE  4,8                                                    001880
**        IIF - INITIALIZE INTERACTIVE FILES.                           001890
*                                                                       001900
*                                                                       001910
*         THIS ROUTINE OPENS AND CONNECTS THE INTERACTIVE DEBUG INPUT   001920
*         AND OUTPUT FILES, *F.IDI* AND *F.IDO*.                        001930
*                                                                       001940
*         ENTRY  NONE                                                   001950
*                                                                       001960
*         EXIT   NONE                                                   001970
*                                                                       001980
*         USES   ALL BUT A5,X5,A0,X0                                    001990
*                                                                       002000
*         CALLS  CON,OPEN                                               002010
                                                                        002020
                                                                        002030
 IIF      SUBR               ** ENTRY/EXIT **                           002040
                                                                        002050
*         SET UP *F.IDI - INTERACTIVE DEBUG INPUT FILE*.                002060
                                                                        002070
          SA1    F.IDI                                                  002080
          SX2    040021B     (X2) = CIO EOR STATUS                      002090
          MX0    7*CHAR                                                 002100
          BX6    X0*X1                                                  002110
          BX6    X6+X2                                                  002120
          SA6    A1                                                     002130
          OPEN   F.IDI,,RCL                                             002140
          SA1    F.IDI                                                  002150
          MX2    0           SET TO *CONNECT*                           002160
          RJ     CON         CONNECT F.IDI                              002170
                                                                        002180
 #OS3     IFEQ   .OS,3       IF SCOPE 3                                 002190
          MI     X1,*+4S15   IF *CON* DETECTED ERROR...                 002200
 #OS3     ENDIF                                                         002210
                                                                        002220
*         SET UP *F.IDO - INTERACTIVE DEBUG OUTPUT FILE*.               002230
                                                                        002240
          OPEN   F.IDO,,RCL                                             002250
          SA1    F.IDO                                                  002260
          MX2    0           SET TO *CONNECT*                           002270
          RJ     CON         CONNECT F.IDO                              002280
                                                                        002290
 #OS3     IFEQ   .OS,3       IF SCOPE 3                                 002300
          MI     X1,*+4S15   IF *CON* DETECTED ERROR...                 002310
 #OS3     ENDIF                                                         002320
                                                                        002330
          EQ     EXIT.                                                  002340
 IST      SPACE  4,8
**        IST - INITIALIZE *SET* TABLE. 
* 
* 
*                THIS ROUTINE SETS UP THE DEFAULT *SET* TABLE VALUES. 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  ADZ
  
  
 IST      SUBR               ** ENTRY/EXIT ** 
          SB6    IDPSET      (B6) = FWA OF IDP *SET* TABLE
          SA1    =4LTEMP
          SX6    IDPTMP 
          BX6    X1+X6       (X6) = 42/0LTEMP,18/FWA OF TEMP AREA 
          RJ     ADZ         ADD WORD TO IDP TABLE
          SX7    1RP
          SX6    IDPPREG
          LX7    10*CHAR-1*CHAR 
          BX6    X7+X6       (X6) = 42/0LP, 18/ADDR OF PSEUDO P REGISTER
          RJ     ADZ         ADD WORD TO IDP TABLE
          EQ     EXIT.
 LBT      SPACE  4,8
**        LBT - LIST BREAK TABLE. 
* 
* 
*                LISTS THE CONTENTS OF THE PARALLEL BREAK TABLES
*         *IDPBA/IDPBC* IN THREE FORMS, DEPENDING ON THE TYPE OF BREAK--
* 
*     COL 1         1         1         1        (.=BLANK(55B)) 
*         .BREAK.AT.NNNNNN.IN.XXXXXXX 
*         ...........LL.NNNNN..UL.NNNNN..INC.NNNN.CNT.NNNNNN
* 
*         .BRPL..AT.NNNNNN.IN.XXXXXXX....A1.NNNNNN
*         ...........LL.NNNNN..UL.NNNNN..INC.NNNN.CNT.NNNNNN
* 
*         .BREQ..AT.NNNNNN.IN.XXXXXXX....A1.NNNNNN.A2.NNNNNN
*         ...........LL.NNNNN..UL.NNNNN..INC.NNNN.CNT.NNNNNN
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT A0 
* 
*         CALLS  COD,FRA=,PRIDP,SFN 
  
  
 LBT      SUBR               ** ENTRY/EXIT ** 
  
*         SET UP FOR 1ST ENTRY. 
  
          SA5    IDPBA
          EQ     LBT2 
  
*         MAIN LOOP.
  
 LBT1     SA5    A5+B1
  
 LBT2     ZR     X5,EXIT.    IF FINISHED LISTING ALL BREAKS 
          SX6    X5+B1
          ZR     X6,LBT1     IF THIS ENTRY AVAILABLE (NOT A BREAK)
  
*         ASSEMBLE * BREAK AT *.
  
          SX4    X5          (X4) = BREAK ADDRESS 
          LX5    6
          MX0    -6 
          BX6    -X0*X5      (X6) = BREAK TYPE CODE 
          MX0    7*CHAR 
          SA1    IDPKBR+X6
          SA6    IDPBTC 
          BX1    X0*X1
          RJ     =XSFN       SPACE FILL NAME
          LX6    -CHAR
          BX6    X0*X6
          SX7    3RAT 
          BX6    X6+X7       (X6) = .BREAK.AT.   (.=BLANK(55B)) 
          SA6    SNAPLNE
  
*         ASSEMBLE *NNNNNN IN XXXXXXX   *.
  
          SX1    X4 
  
 #FRA     IF     DEF,FRA= 
          SB7    LBT3        (B7) = RETURN ADDR FOR *FRA=*
          EQ     =XFRA=      FIND RELATIVE ADDRESS
  
 LBT3     BSS    0
  
 #FRA     ELSE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          BX6    X4 
          MX7    0
 #FRA     ENDIF 
  
          SA6    A6+B1
          SA7    A6+B1
          SA2    IDPBTC 
          ZR     X2,LBT5     IF *BREAK ADDR,LL,UL,INC* FORM 
          BX1    X7 
          RJ     SFN         SPACE FILL NAME
          SA6    A6+B1       RE-STORE BLANK FILLED *XXXXXXX   * 
  
*         ASSEMBLE * A1 NNNNNN*.
  
          LX5    18 
          SX1    X5 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          SA2    IDPBTC 
          SX1    3R A1
          MX0    -7*CHAR
          BX6    -X0*X6 
          LX1    10*CHAR-3*CHAR 
          BX1    X0*X1
          BX6    X6+X1       (X6) = .A1.NNNNNN   (.=BLANK(55B)) 
          SA6    A6+B1
          SX2    X2-BTC=EQ
          MI     X2,LBT4     IF *BRPL ADDR,A1,LL,UL,INC* FORM 
  
*         ASSEMBLE * A2 NNNNNN*.
  
          LX5    18 
          SX1    X5 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          SX1    3R A2
          MX0    -7*CHAR
          BX6    -X0*X6 
          LX1    10*CHAR-3*CHAR 
          BX1    X0*X1
          BX6    X6+X1       (X6) = .A2.NNNNNN   (.=BLANK(55B)) 
          SA6    A6+B1
  
 LBT4     MX6    0
          SA6    A6+B1       MARK EOL 
  
 LBT5     PRIDP  SNAPLNE
  
*         ASSEMBLE *           LL NNNNN *.
  
          SA1    =10H 
          SB7    A5-IDPBA 
          SB6    B7+B7
          SA2    IDPBC+B6+1  (X2) = 2ND WORD OF *IDPBC* ENTRY 
          BX6    X1 
          BX5    X2 
          LX5    15 
          MX0    -15
          BX1    -X0*X5 
          SA6    SNAPLNE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          SX1    3R LL
          LX4    -4*CHAR     LEFT JUSTIFY NR TO BIT 35
          BX6    X4          (X6) = ....NNNNN.   (.=BLANK(55B)) 
          MX0    -7*CHAR
          LX1    10*CHAR-3*CHAR 
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X6+X1       (X6) = .LL.NNNNN.   (.=BLANK(55B)) 
          SA6    A6+B1
  
*         ASSEMBLE * UL NNNNN *.
  
          LX5    15 
          MX0    -15
          BX1    -X0*X5      (X1) = UL
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          SX1    3R UL
          LX4    -4*CHAR
          BX6    X4          (X6) = ....NNNNN.   (.=BLANK(55B)) 
          MX0    -7*CHAR
          BX6    -X0*X6 
          LX1    10*CHAR-3*CHAR 
          BX1    X0*X1
          BX6    X6+X1       (X6) = .UL.NNNNN.   (.=BLANK(55B)) 
          SA6    A6+B1
  
*         ASSEMBLE * INC NNNN *.
  
          LX5    12 
          MX0    -12
          BX1    -X0*X5      (X1) = INC 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          SA1    =4L INC
          LX4    -5*CHAR
          BX6    X4          (X6) = .....NNNN.   (.=BLANK(55B)) 
          MX0    -6*CHAR
          BX6    -X0*X6 
          BX6    X6+X1       (X6) = .INC.NNNN.   (.=BLANK(55B)) 
          SA6    A6+B1
  
*         ASSEMBLE *CNT NNNNNN*.
  
          LX5    18 
          SX1    X5 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          SX1    3RCNT
          MX0    -7*CHAR
          BX6    -X0*X6 
          LX1    10*CHAR-3*CHAR 
          BX1    X0*X1
          BX6    X6+X1       (X6) = CNT.NNNNNN   (.=BLANK(55B)) 
          MX7    0
          SA6    A6+B1
          SA7    A6+B1       MARK EOL 
          PRIDP  SNAPLNE
          EQ     LBT1 
 LST      SPACE  4,8
**        LST - LIST *SET* NAME TABLE.
* 
* 
*         ENTRY  (A5,X5) =   ADDR + CNTS OF 1ST *SET* TABLE ENTRY 
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  COD,FRA=,PRIDP,SFN 
  
  
 LST      SUBR               ** ENTRY/EXIT ** 
  
 LST2     ZR     X5,EXIT.    IF FINISHED ALL SET NAMES
          SX1    B1 
          IX6    X5+X1
          ZR     X6,LST4     IF THIS ENTRY IS AVAILABLE (NOT A SET) 
          MX0    7*CHAR 
          BX1    X0*X5       (X1) = 0LNAME
          RJ     =XSFN       SPACE FILL NAME
          LX6    -CHAR
          SA6    SNAPLNE
          BX1    -X0*X5 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC-- SET NAME VALU
          LX6    4*CHAR 
          SA6    A6+B1
  
 #FRA     IF     DEF,FRA= 
          BX1    -X0*X5 
          SB7    LST3        (B7) = RETURN ADDR FOR *FRA=*
          EQ     =XFRA=      FIND RELATIVE ADDRESS
  
 LST3     SA6    A6+B1
          SA7    A6+B1
  
 #FRA     ELSE
          MX6    0
          SA6    A6+B1
 #FRA     ENDIF 
  
          PRIDP  SNAPLNE
  
 LST4     SA5    A5+B1
          EQ     LST2 
 LXT      SPACE  4,8
**        LXT - LIST XFER TABLE.
* 
* 
*                LISTS THE MOST RECENT TRANSFERS OF CONTROL TO OCCUR
*         DURING STEP MODE (CONTAINED IN *IDPXFT*). 
* 
*         *IDPXFT* FORMAT --
* 
*         VFD    60/-1       UNUSED ENTRY (I.E. XFT HAS NOT FILLED YET) 
*          .
*          .
*         VFD    30/POS COUNTER,30/P REGISTER OF XFER INSTRUCTION 
*          .
*         VFD    60/0        END OF TABLE MARK
* 
*         ENTRY  (X6) = NR OF ENTRIES TO LIST (BEGINNING W/ MOST RECENT)
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  DAZ
  
  
 LXT      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          SX1    IDPXFT+L.XFT 
          SX7    X6-L.XFT-1 
          MI     X7,LXT2     IF NOT ASKING FOR TOO MANY ENTRIES 
          SX6    L.XFT
  
 LXT2     IX7    X1-X6
          NO
          SA7    LXT=NXT
  
*         ** MAIN LOOP NODE **
  
 LXT3     SA2    LXT=NXT
          SA3    X2          (X3) = NEXT *XFT* ENTRY
          SX7    X2+B1
          SX4    X3+B1
          SA7    A2 
          ZR     X3,EXIT.    IF HIT END OF TABLE MARK, DONE...
          ZR     X4,LXT3     IF HIT AVAILABLE ENTRY (I.E. *XFT* WAS NOT 
*                              FULL TO BEGIN WITH)
          SA5    X3          (A5,X5) = A+C OF XFER INSTRUCTION
          AX3    30 
          SB4    X3          (B4) = POS COUNTER 
          SA7    IDPFAD      SET TO *FORCE OUT ADDR UNCONDITIONALLY*
          RJ     DAZ         DEASSEMBLE XFER INSTRUCTION
          EQ     LXT3 
  
  
 LXT=NXT  =      APL         SAVED ADDR OF NEXT *XFT* ENTRY 
 PAS      SPACE  4,8
**        PAS - PARSE SUBEXPRESSION.
* 
*                THIS ROUTINE PARSES AN EXPRESSION THAT IS TERMINATED 
*         BY A -,- OR -EOS-, AND RETURNS THE VALUE OF THE EXPRESSION
*         IN THE ACCUMULATOR *IDPACC*.
* 
*         ENTRY  (A5+1,X5)=  ADDR + CONTENTS OF 1ST TOKEN IN EXPRESSION 
* 
*         EXIT   (IDPACC) =  BINARY VALUE OF EXPRESSION 
*                (X1)     =  (IDPACC) 
*                (X3)     =  .ZR. IF EXPRESSION WAS NULL, ELSE .NZ. 
*                (A5,X5)  =  ADDR + CNTS OF TOKEN THAT TERMINATED PARSE 
*                (X6)     =  (X1) = (IDPACC)
* 
*         USES   ALL
* 
*         CALLS  DXB,FAA(IF DEF),IDP=ER,SKT 
  
  
 PAS      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          MX6    0
          MX7    -1 
          SA6    IDPACC      CLEAR ACCUMULATOR
          SA6    IDPSGN      SET TO *SIGN IS PLUS*
          SA6    IDPIND      SET TO *DIRECT ADDRESSING* 
          SA7    IDPNUL      SET TO *NULL EXPRESSION SO FAR*
  
*         MAIN LOOP NODE. 
  
 PS=ALL   SA5    A5+B1       (X5) = NEXT TOKEN TO PARSE 
          SA4    IDPNUL 
          SX7    X4+B1
          SA7    A4 
          ZR     X5,PS=END   IF EOS TOKEN 
          MX0    -CHAR
          =X6    X5-O.VAR 
          =X7    X5-O.CONS
          ZR     X6,PS=NAM   IF NAME TOKEN
          ZR     X7,PS=CON   IF CONSTANT TOKEN
          SX6    X5-O.SEP 
          NZ     X6,IDP.ER   IF NOT SEPARATOR TOKEN, ERR... 
  
*         HERE TO PROCESS A SEPARATOR TOKEN -- *,+- 
  
          LX5    1*CHAR-10*CHAR 
          BX5    -X0*X5 
          SX6    X5-1R, 
          SX7    X5-1R* 
          ZR     X6,PS=END   IF , TOKEN 
          ZR     X7,PS=STR   IF * TOKEN 
          SX6    X5-1R+ 
          SX7    X5-1R- 
          ZR     X6,PS=PL    IF + TOKEN 
          ZR     X7,PS=MI    IF - TOKEN 
          EQ     IDP.ER      ERR - *UNKNOWN TOKEN*
  
*         HERE IF NAME TOKEN. 
  
 PS=NAM   SA1    IDPBAX 
          BX2    X5 
          MX0    -CHAR
          LX2    CHAR 
          BX6    -X0*X2 
          SB2    X6          (B2) = REGISTER TYPE (BAX) 
          LX7    X1,B2
          PL     X7,PS=NAM2  IF NAME DOES NOT BEGIN WITH B,A,OR X 
  
*         CHECK FOR REGISTER NAME.
  
          MX1    1R7-1R0+1
          LX1    -1R0        (X1) = (0-7) SHIFT MASK
          LX2    CHAR 
          BX6    -X0*X2 
          SB3    X6          (B3) = REGISTER NR (0-7) DPC 
          LX7    X1,B3
          PL     X7,PS=NAM2  IF 2ND LETTER OF NAME IS NOT (0-7) 
          LX2    CHAR 
          BX7    -X0*X2 
          NZ     X7,PS=NAM2  IF 3RD CHAR IS NON-ZERO, NOT A REGISTER
          SB5    1RB
          SB6    000B        (B6) = 0TR, WHERE T=0 (B REG)
          EQ     B2,B5,PS=NAM1     IF B REGISTER
          SB5    1RA
          SB6    010B        (B6) = 0TR, WHERE T=1 (A REG)
          EQ     B2,B5,PS=NAM1     IF A REGISTER
          SB6    020B        (B6) = 0TR, WHERE T=2 (X REG)
  
 PS=NAM1  SB7    X6-1R0      (B7) = REGISTER NR IN BINARY 
          SB6    B6+B7       (B6) = 0TR 
          SX6    B6+SV=B     (X6) = ADDR OF SAVED 0TR REGISTER
          EQ     PS=ACC 
  
*         CHECK FOR DECK NAME.
  
 PS=NAM2  MX0    7*CHAR 
          BX1    X0*X5       (X1) = 0LNAME
  
 #FAA     IF     DEF,FAA= 
          RJ     =XFAA=      FIND ABSOLUTE ADDRESS
          PL     X6,PS=ACC   IF A FIND, ADJUST ACCUMULATOR... 
 #FAA     ENDIF 
  
*         HERE TO SEARCH USER *SET* TABLE.
  
          SB6    IDPSET      (B6) = FWA OF *SET* TABLE
          RJ     SKT         SEARCH SET TABLE FOR NAME
          ZR     X2,IDP.ER   IF NO FIND 
          SX6    X2+
          EQ     PS=ACC 
  
*         HERE IF CONSTANT TOKEN. 
  
 PS=CON   MX0    7*CHAR 
          BX5    X0*X5       (X5) = 42/0LCONSTANT(DPC), 18/0
          SB7    B0          SET TO *MODE IS OCTAL* 
          RJ     =XDXB       CONVERT DPC TO BINARY
          NZ     X4,IDP.ER   IF ERROR IN ASSEMBLY 
          EQ     PS=ACC      ADJUST ACCUMULATOR...
  
*         HERE IF * TOKEN.
  
 PS=STR   SA1    IDPIND 
          SX6    X1+B1       (X6) = LEVEL OF INDIRECT ADDRESSING
          SA6    A1 
          EQ     PS=ALL      RETURN TO MAIN LOOP.. .
  
*         HERE IF + TOKEN . 
  
 PS=PL    =      PS=ALL 
  
*         HERE IF - TOKEN.
  
 PS=MI    SA1    IDPSGN 
          MX6    60 
          BX6    X1-X6
          SA6    A1 
          EQ     PS=ALL      RETURN TO MAIN LOOP... 
  
*         HERE TO ADJUST ACCUMULATOR. 
  
 PS=ACC   SA1    IDPIND 
          SX7    X1-1 
          MI     X7,PS=ACC2  IF NO MORE LEVELS OF INDIRECT ADDR 
          SA7    A1 
          SB2    X6 
          RJ     CHK         CHECK CM ADDR
          MI     B2,IDP.ER   IF ADDR IS BAD 
          SA2    B2          (X2) = NEW ADDRESS 
          BX6    X2 
          EQ     PS=ACC 
  
 PS=ACC2  SA1    IDPACC 
          SA2    IDPSGN 
          BX3    X6-X2       (X3) = +X6 IF +, -X6 IF -
          IX7    X1+X3
          MX6    0
          SA7    A1 
          SA6    A2          SET TO *DEFAULT SIGN IS PLUS*
          EQ     PS=ALL      RETURN TO MAIN LOOP ...
  
*         HERE IF END OF SUBEXPRESSION SENSED.
  
 PS=END   SA1    IDPACC 
          SA3    IDPNUL 
          BX6    X1 
          EQ     EXIT.
 PAT      SPACE  4,8                                                    000580
**        PAT - PARSE *FWA,LWA,LEN* TRIPLE.                             000590
*                                                                       000600
*                                                                       000610
*         THIS ROUTINE CONTROLS THE PARSING OF THE *FWA,LWA,LEN*        000620
*         SYNTAX, AND IS USED MERELY AS A SPACE OPTIMIZATION BECAUSE    000630
*         THIS SYNTAX NEEDS TO BE PARSED FOR A NUMBER OF DIFFERENT      000640
*         STATEMENTS.                                                   000650
*                                                                       000660
*         ANY OR ALL OF THE SUBEXPRESSIONS WHICH CONSTITUTE THE         000670
*         *FWA,LWA,LEN* TRIPLE MAY BE NULL.  IF A NULL SUBEXPRESSION    000680
*         IS ENCOUNTERED, *PAT* WILL USE A DEFAULT VALUE THAT HAS       000690
*         BEEN SET UP BY THE CALLER.                                    000700
*                                                                       000710
*         NOTE THAT *PAT* RESOLVES ANY POSSIBLE SYNTACTIC DIFFERENCES   000720
*         BETWEEN THE USES OF THE *LWA* AND *LEN* PARAMETERS --         000730
*                                                                       000740
*           1. FOR *FWA,LWA* (I.E. WHEN *LEN* IS NULL),                 000750
*              NEED TO SET: LEN = LWA-FWA+1                             000760
*                                                                       000770
*           2. FOR *FWA,,LEN* (I.E. WHEN *LWA* IS NULL),                000780
*              NEED TO SET: LWA = FWA+LEN-1                             000790
*                                                                       000800
*         THIS HOCUS POCUS IS NECESSARY TO INSURE THAT *LWA* AND *LEN*  000810
*         DO NOT CONFLICT WITH EACH OTHER.                              000820
*                                                                       000830
*         CONSIDER --                                                   000840
*                                                                       000850
*                SNAP 100,,2                                            000860
*                                                                       000870
*         FOLLOWED BY --                                                000880
*                                                                       000890
*                SNAP 100,110                                           000900
*                                                                       000910
*         IF THE ABOVE *LWA/LEN* FIDDLING WERE NOT PERFORMED, UPON      000920
*         ENCOUNTERING THE 2ND STMT, IDP WOULD NOT KNOW WHICH VALUE     000930
*         TO USE: LEN=2 (RESIDUAL), OR LWA=110 (EXPLICIT).              000940
*                                                                       000950
*         ENTRY  (A5+1)    = ADDR OF 1ST TOKEN IN TRIPLE, I.E. *FWA*.   000960
*                (PAT#FWA) = DEFAULT *FWA*                              000970
*                (PAT#LWA) = DEFAULT *LWA*                              000980
*                (PAT#LEN) = DEFAULT *LEN*                              000990
*                                                                       001000
*         EXIT   (A5,X5)   = A+C OF TOKEN THAT TERMINATED TRIPLE        001010
*                (PAT#FWA) = FWA, AS SPECIFIED EXPLICITLY OR BY DEFAULT 001020
*                (PAT#LWA) = LWA, AS SPECIFIED EXPLICITLY OR BY DEFAULT 001030
*                (PAT#LEN) = LEN, AS SPECIFIED EXPLICITLY OR BY DEFAULT 001040
*                (AP=FWA)  = (PAT#FWA) = FWA                            001050
*                (AP=LWA)  = LWA, AS COMPUTED FROM *LWA* AND/OR *LEN*   001060
*                (B2)      = .MI. IF FWA, LWA, OR LEN ARE BAD, ELSE .PL.001070
*                                                                       001080
*         USES   ALL                                                    001090
*                                                                       001100
*         CALLS  FLL,PAS                                                001110
                                                                        001120
                                                                        001130
 PAT      SUBR               ** ENTRY/EXIT **                           001140
                                                                        001150
*         INITIALIZATION.                                               001160
                                                                        001170
          BX6    X6-X6                                                  001180
          SA6    PATFLG      CLEAR *PATFLG*                             001190
                                                                        001200
*         PARSE/PROCESS FWA.                                            001210
                                                                        001220
          ZR     X5,PAT4     IF EOS ENCOUNTERED                         001230
          RJ     PAS         PARSE SUBEXPRESSION -- FWA                 001240
          ZR     X3,PAT2     IF FWA IS NULL                             001250
          SX6    X1+                                                    001260
          SA6    PAT#FWA                                                001270
                                                                        001280
*         PARSE/PROCESS LWA.                                            001290
                                                                        001300
 PAT2     ZR     X5,PAT4     IF EOS ENCOUNTERED                         001310
          RJ     PAS         PARSE SUBEXPRESSION -- LWA                 001320
          ZR     X3,PAT3     IF LWA IS NULL                             001330
          SX6    X1                                                     001340
          SX7    PAF.LWAM                                               001350
          SA6    PAT#LWA                                                001360
          SA7    PATFLG                                                 001370
                                                                        001380
*         PARSE/PROCESS LEN.                                            001390
                                                                        001400
 PAT3     ZR     X5,PAT4     IF EOS ENCOUNTERED                         001410
          RJ     PAS         PARSE SUBEXPRESSION -- LEN                 001420
          ZR     X3,PAT4     IF LEN IS NULL                             001430
          SA2    PATFLG                                                 001440
          SX7    PAF.LENM                                               001450
          SX6    X1                                                     001460
          BX7    X2+X7       SET TO *LEN SPECIFIED*                     001470
          SA6    PAT#LEN                                                001480
          SA7    A2+                                                    001490
                                                                        001500
*         HERE TO RESOLVE ANY POSSIBLE SYNTACTIC DIFFERENCES            001510
*         BETWEEN *FWA,LWA* AND *FWA,,LEN*.                             001520
                                                                        001530
 PAT4     SA1    PATFLG                                                 001540
          SA2    PAT#FWA     (X2) = FWA                                 001550
          SA3    A2+B1       (X3) = LWA                                 001560
          SA4    A3+B1       (X4) = LEN                                 001570
          ZR     X1,PAT6     IF NO PROBLEM                              001580
          SX6    X1-PAF.LWAM-PAF.LENM                                   001590
          SX7    X1-PAF.LWAM                                            001600
          ZR     X6,PAT6     IF *FWA,LWA,LEN*                           001610
          ZR     X7,PAT5     IF *FWA,LWA*                               001620
                                                                        001630
*         HERE IF *FWA,,LEN*.                                           001640
*         SET: LWA = FWA+LEN-1                                          001650
                                                                        001660
          IX6    X2+X4                                                  001670
          SX3    X6-1                                                   001680
          BX6    X3                                                     001690
          SA6    A3                                                     001700
          EQ     PAT6                                                   001710
                                                                        001720
*         HERE IF *FWA,LWA*.                                            001730
*         SET: LEN = LWA-FWA+1                                          001740
                                                                        001750
 PAT5     IX6    X3-X2                                                  001760
          SX4    X6+B1                                                  001770
          BX6    X4                                                     001780
          SA6    A4                                                     001790
                                                                        001800
*         CHECK *FWA,LWA,LEN*.                                          001810
                                                                        001820
 PAT6     RJ     FLL         CHECK *FWA,LWA,LEN*                        001830
          PL     B2,EXIT.    IF FWA, LWA, AND LEN OK                    001840
          BX6    X6-X6                                                  001850
          SA6    PAT#FWA     CLEAR *FWA*                                001860
          SA6    A6+B1       CLEAR *LWA*                                001870
          SA6    A6+B1       CLEAR *LEN*                                001880
          EQ     EXIT.                                                  001890
                                                                        001900
                                                                        001910
          LOC    AP=LL                                                  001920
 PAT#FWA  =      *                                                      001930
 PAT#LWA  =      *+1                                                    001940
 PAT#LEN  =      *+2                                                    001950
          LOC    *O                                                     001960
 POL      SPACE  4,8
**        POL - PROCESS OPTIONS LIST ITEM.
* 
* 
*                THIS ROUTINE WILL PROCESS AN OPTIONS LIST ITEM THAT IS 
*         TERMINATED BY A -,- OR -EOS-. 
* 
*         ENTRY  (B6) = FWA OF OPTIONS KEYWORD TABLE (OKT)
*                (A5+1,X5) = ADDR + CONTENTS OF 1ST TOKEN IN LIST 
* 
*         EXIT   IF NO ERROR--
*                (A5,X5) =  A + C OF TOKEN THAT TERMINATED OPTIONS LIST 
*                (X3)    = .ZR. IF OPTIONS LIST ITEM WAS NULL, ELSE .NZ.
*                (X6)    =  -DEFAULT IF - PREFIX, ELSE +DEFAULT 
*                (X7)    =  +0 IF - PREFIX, ELSE + DEFAULT
*                (B7)    =  ORDINAL INTO *OKT* OF FIND
* 
*                IF AN ERROR-- EXIT IS TO *IDP=ER*
* 
*         USES   X - ALL
*                A - 2,3,5
*                B - 7
* 
*         CALLS  IDP=ER,SKT 
  
  
 POL      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          BX4    X4-X4       SET TO *NO - PREFIX SO FAR*
          MX6    -1 
          SX7    B0 
          SA6    IDPNUL      SET TO *NULL EXPRESSION SO FAR*
          SA7    IDPACC      CLEAR ACCUMULATOR
  
*         MAIN LOOP NODE. 
  
 POL2     SA3    IDPNUL 
          SA5    A5+B1
          SX6    X3+B1
          MX0    -CHAR
          SA6    A3 
          ZR     X5,POL4     IF EOS ENCOUNTERED 
          SX6    X5-O.SEP 
          SX7    X5-O.VAR 
          NZ     X6,POL3     IF NOT A SEPARATOR 
  
*         HERE IF A SEPARATOR TOKEN ENCOUNTERED.
  
          LX5    1*CHAR-10*CHAR 
          BX5    -X0*X5 
          SX6    X5-1R, 
          SX7    X5-1R- 
          ZR     X6,POL4     IF , ENCOUNTERED (I.E. END OF LIST)
          NZ     X7,IDP=ER   IF NOT - TOKEN, ERROR... 
          MX4    60          SET TO * - PREFIX ENCOUNTERED* 
          EQ     POL2 
  
*         HERE TO PROCESS NAME TOKEN. 
  
 POL3     NZ     X7,IDP=ER   IF NOT A NAME TOKEN, ERROR...
          MX0    7*CHAR 
          SX6    B1 
          SA2    =40404040404040404040B 
          BX1    X0*X5       (X1) = 0LKEYWORD 
          IX6    X1-X6       BORROW RIPPLES LEFT TO 1ST NON-ZERO BIT
          BX7    -X6+X1      (X7) = ALL TRAILING 0 BITS IN (X1) = 0 BITS
*                                    ALL OTHER LEADING BITS = 1 BITS
          SB7    60-5        (B7) = RIGHT CIRCULAR SHIFT 5 BITS 
          BX6    X2*X7       (X6) = 40B WHERE EACH CHAR IN KEYWORD IS 
          LX7    X6,B7       (X7) = 01B WHERE EACH CHAR IN KEYWORD IS 
          IX7    X6-X7       (X7) = 37B WHERE EACH CHAR IN KEYWORD IS 
          BX0    X6+X7       (X0) = 77B WHERE EACH CHAR IN KEYWORD IS 
          RJ     SKT         SEARCH FOR NAME
          ZR     X2,IDP=ER   IF NO FIND 
          SX6    X2 
          SA6    IDPACC 
          EQ     POL2 
  
*         HERE TO SET UP EXIT CONDITIONS. 
  
 POL4     SA1    IDPACC 
          SA3    IDPNUL 
          BX6    X1-X4       (X6) = -DEFAULT IF - PREFIX, ELSE +DEFAULT 
          BX7    -X4*X1      (X7) = +0 IF - PREFIX, ELSE +DEFAULT 
          EQ     EXIT.
 RIL      SPACE  4,8
**        RIL - READ IDP INPUT LINE.
* 
* 
*         ENTRY  IF READING INTERACTIVELY (F.IDI) -- NONE 
*                IF READING FROM BATCH (F.BDI) -- INITIAL *READ* ISSUED 
*                  TO FILL BUFFER 
* 
*         EXIT   (X1)      = .NZ. IF EOR/EOF ENCOUNTERED, ELSE .ZR. 
*                IF NO EOR/EOF ENCOUNTERED -- 
*                (A5,X5)   = A+C OF 1ST WORD OF LINE IMAGE
*                (L=LIM)   = NR OF WORDS IN SOURCE LINE IMAGE 
*                              (INCLUDES WORD CONTAINING EOL MARK)
* 
*         USES   ALL BUT A0,X0     (INCLUDES ALL CALLS) 
* 
*         CALLS  READ,READC 
  
  
 RIL      SUBR               ** ENTRY/EXIT ** 
  
 RIL2     SA5    IDPFLG 
          SX2    F.IDI
          LX5    59-IDF.INPP
          SB6    IDPLIM 
          PL     X5,RIL3     IF READING INTERACTIVELY (F.IDI) 
          SX2    F.BDI
  
 RIL3     READC  X2,B6,8
          ZR     X1,RIL4     IF NOT EOR/EOF STATUS
          MI     X5,EXIT.    IF READING FROM BATCH (F.BDI)
          READ   X2,RCL 
  
*         SET EOR STATUS TO PREVENT *READC* FROM READING AHEAD. 
  
          SA1    X2 
          MX6    60-18
          BX1    X6*X1
          SX6    040021B
          BX6    X1+X6
          SA6    A1 
          EQ     RIL2 
  
*         SET UP EXIT CONDITIONS. 
  
 RIL4     SX7    B6-IDPLIM   (X7) = NR OF WORDS IN LINE IMAGE 
          SA5    IDPLIM      (A5,X5) = A+C OF 1ST WORD OF LINE IMAGE
          SA7    L=LIM
          EQ     EXIT.
 SKT      SPACE  4,8
**        SKT - SEARCH KEYWORD TABLE. 
* 
* 
*                SEARCHS A TABLE THAT IS TERMINATED BY A ZERO WORD
*         FOR A MATCH, USING A SPECIFIED EXTRACTION MASK. 
* 
*         ENTRY  (B6)     =  FWA TO BEGIN SEARCH
*                (X0)     =  EXTRACTION MASK TO USE 
*                (X1)     =  ELEMENT TO SEARCH FOR
* 
*         EXIT   IF NO FIND --
*                (X2)     =  .ZR. 
*                IF A FIND -- 
*                (B7)     =  ORDINAL OF FIND
*                (A2,X2)  =  ADDR + CONTENTS OF WORD THAT MATCHED 
* 
*         USES   X - 2,3,6,7
*                A - 2
*                B - 7
* 
*         CALLS  NONE 
  
  
 SKT      SUBR               ** ENTRY/EXIT ** 
          SA2    B6 
          BX6    X0*X1
          SB7    -1 
  
 SKT2     ZR     X2,EXIT.    IF END OF TABLE
          BX7    X0*X2
          SB7    B7+B1
          IX3    X6-X7
          ZR     X3,EXIT.    IF A FIND
          SA2    A2+B1
          EQ     SKT2 
 STP      SPACE  4,8
**        STP - STEP AN INSTRUCTION.
* 
* 
*                THIS ROUTINE WILL STEP A SINGLE CPU INSTRUCTION, AND 
*         LIST THE RESULT REGISTER, IF APPROPRIATE. 
* 
*                *STP* ALSO PERFORMS A LIMITED SET OF ERROR CHECKS FOR
*         RANGE ERRORS (MODE=1). 1) THE PSEUDO P REGISTER IS CHECKED, 
*         2) XFERS OF CONTROL (BRANCH OR RJ) ARE CHECKED, AND 
*         3) LOAD/STORE ADDRESSES ARE CHECKED. IF AN ERROR IS DETECTED, 
*         THE BAD INSTRUCTION AND THE -P- REGISTER ARE DISPLAYED (EVEN
*         IF -L SELECTED). STEP MODE IS THEN TERMINATED.
* 
*         ENTRY  (ST=ENDX) = CONTAINS THE PREVIOUS CONTENTS OF IDP
*                              GENERATED BREAK ADDR IF THEY NEED TO 
*                              BE XEQ, ELSE .ZR.
*                (IDPPREG) = PSEUDO P REGISTER, I.E. ADDRESS OF WORD
*                              CONTAINING INSTRUCTION TO XEQ
*                (IDPPOS)  = POSITION COUNTER. LEFT MOST BIT OF INSTR 
*                              TO XEQ IS BIT (IDPPOS)-1 IN ((IDPPREG)). 
*                              (BITS ARE NUMBERED 59 THRU 0)
*                              E.G. FOR A WORD CONTAINING-- 
*                               +  MX0  -CHAR 
*                                  SA1  ADDR
*                                  BX6  -X0*X5
*                              WHEN STEPPING *SA1  ADDR*--
*                              (IDPPOS) = 45
*                (IDPXLST) = .NZ. IF LISTING EACH STEPPED INSTRUCTION,
*                                  ELSE .ZR.
* 
*         EXIT   (ST=ENDX), (IDPPREG), AND (IDPPOS) UPDATED 
*                TO *IDP=ER* IF AN ERROR DETECTED 
*                TO *IDP2A* IF AN *RJ IDP=* IS ENCOUNTERED AND THE
*                  BREAK CONDITIONS ARE STATISFIED
* 
*         USES   ALL BUT A0 
* 
*         CALLS  BRK,CHK,DAB,DAZ,DUX,FRA=(IF DEF),FRK,
*                  PRIDP,RSR=,SVR=
  
  
 STP      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          MX6    0
          SX7    -B1
          SA6    IDPXFR      CLEAR *TRANSFER CONTROL* FLAG
          SA7    IDPXAR      SET TO *NO ADDR REF SO FAR*
  
*         FETCH WORD CONTAINING INSTRUCTION TO BE XEQ.
  
          SA1    IDPPREG     (X1) = PSEUDO P REGISTER 
          SA2    ST=ENDX
          SA3    A1+B1       (X3) = POS COUNTER 
          SA5    X1          (X5) = WORD CONTAINING INSTRUCTION TO XEQ
          ZR     X2,STP2     IF NOT *IDP* GENERATED BREAK 
  
*         HERE BECAUSE INSTRUCTION TO XEQ AT *ST=ENDX*. 
  
          SA5    A5-B1       (A5) = ADDR OF GENERATED BREAK 
          BX5    X2 
  
*         LIST INSTRUCTION IF NECESSARY.
  
 STP2     SA1    IDPXLST
          SB4    X3 
          ZR     X1,STP3     IF NOT LISTING INSTRUCTION 
          RJ     DAZ         DEASSEMBLE INSTRUCTION 
  
*         BREAK OUT OPCODE. 
  
 STP3     SB6    -B4
          MX0    -6 
          SB6    B6+60+6
          LX5    X5,B6       (X5) = 54/OTHER STUFF, 6/OPCODE
          BX6    -X0*X5 
          LX5    3           (X5) = 51/OTHER, 6/OPC, 3/I
          MX0    -3 
          SA6    STP=OP 
          ZR     X6,STP=ER   IF 00B OPCODE, TRYING TO XEQ DATA... 
  
*         BREAK OUT *I* FIELD.
  
          BX6    -X0*X5 
          LX5    3           (X5) = 48/OTHER, 6/OPC, 3/I, 3/J 
          SA6    A6+B1
  
*         BREAK OUT *J* FIELD.
  
          BX6    -X0*X5 
          LX5    3           (X5) = 45/OTHER, 6/OPC, 3/I, 3/J, 3/K
          SA6    A6+B1
  
*         BREAK OUT *K* FIELD.
  
          BX6    -X0*X5 
          LX5    18-3        (X5) = 30/OTHER, 6/OPC, 3/I, 3/J, 18/Q 
          SA6    A6+B1
  
*         BREAK OUT *Q* 18 BIT ADDRESS FIELD. 
  
          SX6    X5 
          SA6    STP=ADR
  
*         FETCH INSTRUCTION SKELETON AND CHECK FOR LENGTH CONFLICT. 
  
          SA1    STP=OP 
          LX5    30          LEFT JUSTIFY INSTRUCTION 
          MX0    15 
          SA2    DAZ=PS+X1   (X2) = INSTRUCTION SKELETON
          SB5    15 
          PL     X2,STP4     IF SHORT (15 BIT) INSTRUCTION
          MX0    30 
          SB5    B5+B5
  
 STP4     LT     B4,B5,STP=ER IF NOT ENOUGH ROOM FOR 30 BIT INSTRUCTION,
*                              TRYING TO XEQ DATA...
  
*         BREAK OUT FULL INSTRUCTION. 
  
          SA3    =46000460004600046000B 
          BX6    X0*X5
          BX7    -X0*X3 
          IX6    X6+X7       (X6) = INSTRUCTION, LEFT JUST W/ NO-OP FILL
          SA6    STP=IN 
  
*         SPLIT INSTRUCTION INTO REPRESENTATIVE TYPE--
*           01 THRU 07  BRANCH
*           10 THRU 47  NORMAL
*           50 THRU 57  LOAD/STORE
*           60 THRU 77  NORMAL
  
          SX3    X1-10B 
          SX4    X1-50B 
          MI     X3,STP6     IF A BRANCH
          MI     X4,STP5     IF A NORMAL
          SX3    X1-60B 
          MI     X3,STP12    IF A LOAD/STORE
  
*         HERE IF A NORMAL INSTRUCTION (NO SPECIAL PROCESSING). 
  
 STP5     RJ     =XRSR=      RESTORE ORIGINAL REGISTERS 
  
*         HERE TO XEQ NORMAL INSTRUCTION. 
  
 STP=IN   BSSZ   1           THIS WORD IS PLUGGED WITH THE INSTRUCTION
*                              TO BE XEQ, LEFT JUSTIFIED WITH NO-OP FILL
  
          RJ     SVR=        SAVE ORIGINAL REGISTERS
          EQ     STP=X
  
*         HERE IF A BRANCH INSTRUCTION (01 THRU 07).
  
 STP6     SA2    STP=I
          SX6    X1-01B 
          SA3    STP=ADR
          NZ     X6,STP8     IF NOT 01B INSTRUCTION 
          NZ     X2,STP5     IF NOT *RJ*
  
*         HERE IF AN *RJ* INSTRUCTION.
  
          SA4    IDPPREG
          SA5    ST=ENDX     (X5) = WORD CONTAINING *RJ* INSTRUCTION
*                                     (IF PREVIOUS CONTENTS OF GEN BRK) 
          BX6    X4          (X6) = /*+1/ 
          SX7    X3-REG=
          SX0    X3-SNP=
          NZ     X5,STP6A    IF *RJ* IS PREVIOUS CONTENTS OF BREAK ADDR 
          SA5    X4          (X5) = WORD CONTAINING *RJ* INSTRUCTION
          SX6    X4+B1       (X6) = /*+1/ 
  
*         CHECK FOR CALL TO *REG=/SNP=*.  THESE ROUTINES MUST AVOID 
*           BEING STEPPED BECAUSE THEY USE *SVR=/RSR=* TO SAVE AND
*           RESTORE THE CALLERS REGISTERS (SEE NEXT PARAGRAPH). 
  
 STP6A    ZR     X7,STP7     IF *RJ REG=* 
          ZR     X0,STP7     IF *RJ SNP=* 
  
*         CHECK FOR CALL TO *RSR=/SVR=*.  THIS IS CURRENTLY FATALLY 
*           RECURSIVE BECAUSE *STP* USES *RSR=/SVR=* TO SAVE AND RESTORE
*           THE ORIGINAL REGISTERS BEFORE AND AFTER EACH INSTRUCTION IS 
*           STEPPED.  THIS IMPLIES THAT *RSR=/SVR=* WOULD HAVE TO BE
*           ABLE TO BE STEPPED AND EXECUTED CONCURRENTLY...TRICKY.
  
          SX7    =XRSR= 
          SX0    =XSVR= 
          IX7    X3-X7
          IX0    X3-X0
          ZR     X7,STP=ER   IF *RJ RSR=* 
          ZR     X0,STP=ER   IF *RJ SVR=* 
  
*         SET UP TRANSFER ADDRESS OF /RJ Q/ TO BE /Q+1/.
  
          SX7    X3+B1       (X7) = /Q+1/ 
          SB2    X7 
          SA7    IDPXFR 
  
*         CHECK TRANSFER ADDR AND SIMULATE *RJ* BY PLUGGING /EQ *+1/. 
* 
*         ENTRY  (B2) = TRANSFER ADDRESS
*                (X6) = /*+1/  (I.E. RETURN ADDR) 
*                (X3) = /Q/    (I.E. ADDR TO PLUG /EQ *+1/) 
* 
*         NOTE   WHEN THIS IS NOT *RJ REG=/SNP=*, THEN
*                TRANSFER ADDR = Q+1  OR  (B2) = (X3)+1.
* 
*                WHEN THIS IS AN *RJ REG=/SNP=*, THEN 
*                TRANSFER ADDR = *+1  OR  (B2) = (X6), I.E. THE *RJ* HAS
*                BEEN SKIPPED.
  
 STP6B    RJ     CHK         CHECK CM ADDRESS 
          SX7    0400B       (X7) = *EQ* INSTRUCTION
          MI     B2,STP=ER   IF ADDR IS BAD 
          LX7    29-11
          SX0    IDP= 
          BX7    X7+X6       (X7) = 30/0,30/EQ *+1
          LX7    59-29       (X7) = 30/EQ *+1,30/0
          SA7    X3 
  
*         CHECK FOR *RJ IDP=*.
  
          IX0    X3-X0
          SA1    IDPXRJ 
          ZR     X0,STP7A    IF *RJ IDP=* 
  
*         SET UP LEVEL 0 *RJ* ADDRESS.
  
          NZ     X1,STP=X    IF NOT AT LEVEL 0 *RJ* 
          SX6    X3 
          SA6    A1 
          EQ     STP=X
  
*         HERE TO PROCESS *RJ REG=/SNP=*. 
  
 STP7     SA6    IDPXFR      SET TO *RJ REG=/SNP= BECOMES 
*                              BRANCH TO /*+1/* 
          BX7    X5          (X7) = 30/RJ REG=/SNP=, 30/FWA OF PARM LIST
          SA7    STP=SNP
          RJ     =XRSR=      RESTORE ORIGINAL REGISTERS 
  
 STP=SNP  BSSZ   1           THIS WORD IS PLUGGED WITH AN *RJ REG=* OR
*                              AN *RJ SNP=* FORCED UPPER WITH THE FWA OF
*                              THE PARAMETER LIST IN THE LOWER 18 BITS
  
          SA1    IDPXFR      (X1) = ADDR TO XFER TO (I.E. /*+1/)
          SA3    STP=ADR     (X3) = *REG=* OR *SNP=*
          SB2    X1 
          BX6    X1 
          EQ     STP6B
  
*         HERE TO PROCESS *RJ IDP=*.
  
 STP7A    SA6    IDPXFR      SET TO */RJ IDP=/ BECOMES BRANCH TO /*+1/* 
          SX1    A5+B1       (X1) = ADDR+1 OF *RJ IDP=* 
          SX5    X5          (X5) = FWA OF PARAMETER LIST (IF .NZ.) 
          RJ     BRK         BREAK PROCESSOR
          ZR     X5,STP=X    IF NO BREAK THIS TIME
          RJ     FRK         CHECK FREQUENCY PARAMETERS 
          ZR     X5,STP=X    IF NO BREAK THIS TIME
  
*         HERE TO HONOR BREAK.
  
          SA1    IDPXFR 
          SX7    60 
          BX6    X1 
          SA7    IDPPOS 
          SA6    IDPPREG
          EQ     IDP2A       HONOR THIS BREAK...
  
*         HERE IF BRANCH INSTRUCTION (02 THRU 07).
  
 STP8     SX6    X1-4 
          SX7    X1-2 
          ZR     X6,STP10    IF *EQ BI,BJ,ADDR* 
          ZR     X7,STP11    IF *JP BI+ADDR*
  
*         HERE IF CONDITIONAL BRANCH INSTRUCTION. 
  
 STP9     SA1    STP=IN 
          MX0    -18
          LX0    48-18
          SX2    STP=BP      (X2) = BRANCH *PASS* ADDR
          LX2    48-18
          BX1    X0*X1
          BX2    -X0*X2 
          IX6    X1+X2       (X6) = 12/BRANCH OPC, 18/STP=BRP, 30/NO-OPS
          SA6    STP=BR 
  
*         HERE TO XEQ CONDITIONAL BRANCH INSTRUCTION. THE 18 BIT ADDRESS
*           *Q* PORTION OF THE BRANCH INSTRUCTION IS MODIFIED SO THAT IF
*           THE BRANCH IS TAKEN, CONTROL PASSES TO *STP=BP*.
  
          RJ     =XRSR=      RESTORE ORIGINAL REGISTERS 
  
 STP=BR   BSSZ   1           BRANCH TO XEQ IS PLUGGED HERE -- LEFT JUST-
*                              IFIED W/ *Q* ALTERED AND NO-OP FILL
  
 STP=BF   SB1    1           RESTORE (B1) = 1 
          EQ     STP=X
  
 STP=BP   SA1    STP=ADR
          SB1    1           RESTORE (B1) = 1 
          SB2    X1          (B2) = ADDR TO TRANSFER CONTROL TO 
          SX6    X1 
          SA6    IDPXFR 
          RJ     CHK         CHECK CM ADDRESS 
          SA1    IDPXLST
          MI     B2,STP=ER   IF ADDR IS BAD 
          ZR     X1,STP=X    IF NOT LISTING 
          PRIDP  (=C=                                 BRANCH TAKEN...=) 
          EQ     STP=X
  
*         HERE IF *EQ BI,BJ,ADDR*.
  
 STP10    SA1    STP=I
          SA2    STP=J
          BX6    X1+X2
          NZ     X6,STP9     IF NOT *EQ ADDR* 
          MX7    0
          SA1    IDPXRJ 
          SA2    IDPPREG
          IX6    X1-X2
          NZ     X6,STP=BP   IF NOT POSSIBLY *RJ SUBR* EXIT 
          SA7    A1          SET TO *BACK TO LEVEL 0 NOW* 
          EQ     STP=BP 
  
*         HERE IF *JP BI+ADDR*. 
  
 STP11    SA1    STP=I
          SA2    STP=ADR
          SA3    =XSV=B+X1   (X3) = (BI)
          IX6    X2+X3       (X6) = BI+ADDR 
          SB2    X6 
          SA6    IDPXFR 
          RJ     CHK         CHECK CM ADDRESS 
          PL     B2,STP=X    IF ADDR OK 
          EQ     STP=ER 
  
*         HERE IF A LOAD/STORE INSTRUCTION (50 THRU 57).
  
 STP12    SA1    STP=LS+X1-50B  (X1) = LOAD/STORE SKELETON
          SA2    STP=I
          SA3    A2+B1
          SA4    A3+B1
          SA5    STP=ADR
          SB6    X1          (B6) = .MI. IF *Q* FLAG, ELSE
*                                 = FWA OF APPROPRIATE SAVED REG BLOCK
          LX1    -18-3
          BX6    X1 
          AX6    59          (X6) = +0 IF *J* REG + *K* REG 
*                                   -0 IF *J* REG - *K* REG 
          SB7    X1 
          ZR     X2,STP5     IF *SA0* (I.E. NOT LOAD/STORE) 
          MI     B6,STP13    IF *Q* 18 BIT ADDR 
          SA5    B6+X4       (X5) = SAVED *K* REGISTER
          BX5    X5-X6
  
 STP13    SA1    B7+X3       (X1) = SAVED *J* REGISTER
          IX6    X1+X5
          SB2    X6          (B2) = ADDR TO LOAD/STORE
          SA6    IDPXAR 
          RJ     =XCHK       CHECK CM ADDRESS 
          PL     B2,STP5     IF ADDR OK 
          EQ     STP=ER 
  
*         LOAD/STORE TABLE. 
  
 STP=LS   BSS    0
  
          LOC    50B
 +        VFD    18/0,3/0,18/=XSV=A,3/0,18/-1         SAI  AJ+Q 
 +        VFD    18/0,3/0,18/=XSV=B,3/0,18/-1         SAI  BJ+Q 
 +        VFD    18/0,3/0,18/=XSV=X,3/0,18/-1         SAI  XJ+Q 
 +        VFD    18/0,3/0,18/=XSV=X,3/0,18/=XSV=B     SAI  XJ+BK
 +        VFD    18/0,3/0,18/=XSV=A,3/0,18/=XSV=B     SAI  AJ+BK
 +        VFD    18/0,3/0,18/=XSV=A,3/4,18/=XSV=B     SAI  AJ-BK
 +        VFD    18/0,3/0,18/=XSV=B,3/0,18/=XSV=B     SAI  BJ+BK
 +        VFD    18/0,3/0,18/=XSV=B,3/4,18/=XSV=B     SAI  BJ-BK
          LOC    *O 
  
*         HERE TO UPDATE POS COUNTER AND PSEUDO P REGISTER. 
  
 STP=X    SA1    STP=OP 
          SA2    IDPXFR 
          SA3    IDPPREG
          SA4    IDPPOS 
          SA5    ST=ENDX
          SA1    DAZ=PS+X1   (X1) = INSTRUCTION SKELETON
          SB5    15 
          BX6    X2 
          SB4    X4 
          MX7    0
          PL     X1,STP=X2   IF SHORT (15 BIT) INSTRUCTION
          SB5    B5+B5
  
 STP=X2   LX1    59-57
          NZ     X2,STP=X4A  IF A XFER OF CONTROL OCCURRED
          SX6    X3+B1
          LE     B4,B5,STP=X3  IF NO MORE INSTRUCTIONS IN THIS WORD 
          PL     X1,STP=X5   IF INSTRUCTION DOES NOT FORCE UPPER
  
 STP=X3   ZR     X5,STP=X4   IF NOT IN IDP GENERATED BREAK MODE 
          SX6    X3 
  
*         HERE IF INSTRUCTION FORCES UPPER. 
  
 STP=X4   SA7    A5          SET TO *NOT IN IDP GENERATED BREAK MODE* 
          SA6    A3 
          SX7    60 
          SA7    A4 
          EQ     STP=X6 
  
*         HERE IF TRANSFER OF CONTROL OCCURRED -- ENTER TRANSFER ADDR 
*           ONTO PUSH DOWN STACK OF SAVED TRANSFER ADDRESSES *IDPXFT*.
*           ALL ENTRIES IN PUSH DOWN STACK ARE MOVED UP (TOWARD *RA*) 
*           ONE POSITION (THE 1ST ENTRY IN *XFT*, THE EARLIEST TRANSFER 
*           ADDRESS, FALLS OFF STACK).  EXAMPLE --
* 
*                     BEFORE                 AFTER
*             XFT+0  XFER(N)         XFT+0  XFER(N+1) 
*                +1  XFER(N+1)          +1  XFER(N+2) 
*                +2  XFER(N+2)          +2  XFER(N+3) 
*                +3  XFER(N+3)          +3  XFER(N+4) -- NEW ENTRY
*                +4  END-OF-TABLE       +4  END-OF-TABLE
  
 STP=X4A  SA1    IDPXFT+1    (A1,X1) = A+C OF 1ST WORD TO MOVE
          SB7    L.XFT-1     (B7) = NR OF WORDS TO MOVE 
  
 STP=X4B  BX7    X1 
          SA7    A1-B1
          SB7    B7-B1
          SA1    A1+B1
          GT     B7,B0,STP=X4B IF NOT DONE
  
          LX4    59-29
          BX7    X4+X3       (X7) = 30/POS COUNTER,30/P REG OF XFER INST
          SA7    A1-B1       MAKE NEW ENTRY 
          MX7    0
          EQ     STP=X4      FORCE UPPER... 
  
*         HERE IF INSTRUCTION DOES NOT FORCE UPPER. 
  
 STP=X5   SB6    B4-B5
          SX7    B6 
          SA7    A4 
  
*         LIST RESULT REGISTER. 
  
 STP=X6   SA3    IDPXLST
          SA4    STP=OP 
          ZR     X3,EXIT.    IF NOT LISTING 
  
          SX6    X4-10B 
          SA3    STP=I
          MI     X6,EXIT.    IF A BRANCH INSTRUCTION
          LX1    -2          RESTORE (X1) = INSTRUCTION SKELETON
          MX0    -CHAR
          BX6    -X0*X1 
          SX7    X6-1RB 
          SB6    000B        (B6) = 0TR, WHERE T=0 (B REG)
          ZR     X7,STP=X8   IF B REGISTER
          SX7    X6-1RA 
          SB6    010B        (B6) = 0TR, WHERE T=1 (A REG)
          ZR     X7,STP=X8   IF A REGISTER
          SX7    X6-1RX 
          SB6    020B        (B6) = 0TR, WHERE T=2 (X REG)
          ZR     X7,STP=X9   IF X REGISTER
          EQ     EXIT.
  
 STP=X8   SB4    B6+X3       (B4) = 0TR 
          RJ     DAB         DUMP -A- OR -B- REGISTER 
          EQ     EXIT.
  
 STP=X9   SB4    B6+X3       (B4) = 02R 
          RJ     DUX         DUMP -X- REGISTER
          EQ     EXIT.
  
*         HERE IF AN ERROR ENCOUNTERED. 
  
 STP=ER   SA1    IDPXLST
          SA2    ST=ENDX
          SA3    IDPPREG
          SA4    IDPPOS 
          NZ     X1,STP=E3   IF INSTRUCTION WAS ALREADY LISTED
          SA5    X3 
          ZR     X2,STP=E2   IF NOT IN IDP GENERATED BREAK MODE 
          SA5    A2 
  
 STP=E2   SB4    X4 
          RJ     DAZ         DEASSEMBLE BAD INSTRUCTION 
  
 STP=E3   MX0    -18
          SA1    IDPPREG
          SA2    =10H      P =
          BX1    -X0*X1 
          LX7    X2 
          SA7    SNAPLNE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          BX6    X4 
          SA6    A7+B1
  
 #FRA     IF     DEF,FRA= 
          SA1    IDPPREG
          SB7    STP=E4      (B7) = RETURN ADDR FOR *FRA=*
          EQ     =XFRA=      FIND RELATIVE ADDRESS
  
 STP=E4   SA6    A6+B1
          SA7    A6+B1
  
 #FRA     ELSE
          MX6    0
          SA6    A6+B1       MARK EOL 
 #FRA     ENDIF 
  
          PRIDP  SNAPLNE
          EQ     IDP=ER 
  
  
 STP=ADR  =      DAZ=ADR
 STP=I    =      DAZ=I
 STP=J    =      DAZ=J
 STP=K    =      DAZ=K
 STP=OP   =      DAZ=OP 
 VFD      SPACE  4,8
**        VFD - VARIABLE FIELD DEFINITION.
* 
* 
*                CONVERTS A SPECIFIED FIELD IN A BINARY WORD TO OCTAL 
*         DISPLAY CODE WITH APPROPRIATE SPACING AND BLANK FILL. 
*         THE FIELD TO BE CONVERTED CAN BE REPRESENTED IN *COMPASS* BY--
* 
*         POS    (B4)   IN (X1) 
*         VFD    (B5)/FIELD   WHERE *FIELD* HAS BEEN EXTRACTED FROM (X1)
* 
*         E.G.   (B4) = 45   POSITION COUNTER 
*                (B5) = 30   NR OF BITS 
* 
*                BINARY      76211031100015620310 
*                DPC RSULT   .....0311000156.....    (.=BLANK(55B)) 
* 
*         ENTRY  (X1)  =  BINARY WORD TO BE CONVERTED 
*                (B4)  =  POSITION COUNTER
*                (B5)  =  NR OF BITS IN FIELD 
* 
*         EXIT   (X6)  =  CONVERTED UPPER 30 BITS OF (X1) -- DPC RESULT 
*                (X7)  =  CONVERTED LOWER 30 BITS OF (X1) -- DPC RESULT 
*                (X0)  =  .ZR. IF BAD POS OR BIT COUNT ON ENTRY,
*                            ELSE .NZ.
* 
*         USES   X - 0,1,2,3,4,6,7
*                A - NONE 
*                B - 6
* 
*         CALLS  NONE 
  
  
 VFD      SUBR               ** ENTRY/EXIT ** 
          MX3    0
          BX0    X0-X0
          SB6    B5-1 
          LT     B4,B0,EXIT. IF POS COUNT IS BAD
          LT     B5,B0,EXIT. IF BIT COUNT IS BAD
          MX0    -3 
          ZR     B5,VFD2     IF NOT CONVERTING ANY BITS 
          MX3    1
          AX3    X3,B6
          NO
          LX3    X3,B4       (X3) = EXTRACT MASK FOR BITS TO CONVERT
          BX1    X3*X1
  
 VFD2     MX6    0
          BX7    X7-X7
          SB6    60 
  
*         ASSEMBLE APPROPRIATE DIGITS.
  
 VFD3     LX1    3
          BX2    -X0*X1 
          LX3    3
          BX4    -X0*X3 
          SX2    X2+1R0 
          SB6    B6-6 
          NZ     X4,VFD4     IF ASSEMBLING THESE DIGITS 
          SX2    1R 
  
 VFD4     LX2    X2,B6
          BX7    X7+X2
          GT     B6,B0,VFD3  IF PACKING REG (X7) NOT FULL 
  
*         HERE IF PACKING REGISTER (X7) IS FULL.
  
          SB6    60 
          NZ     X6,EXIT.    IF FINISHED ASSEMBLING ENTIRE WORD 
          BX6    X7 
          MX7    0
          EQ     VFD3 
 DATA     SPACE  4,8
**        *IDP* DATA DECLARATIONS.
  
  
 IDPSTMT  BSSZ   1           DURING TOKEN GENERATION *BUB* -- CONTAINS
*                              ADDR OF STMT INFO WORD FOR STMT BEING
*                              BURST/BUILT, SO THAT UPON ENCOUNTERING 
*                              EOS, *BUB* CAN GO BACK AND FILL IN LEN.
*                            DURING STMT PROCESSING -- INDICATES WHERE
*                              STMT BEING PROCESSED IS. 
*                              IF STMT IS NOT PART OF *PROC* -- BIT 59
*                                IS 0 AND BITS 17 THRU 0 CONTAIN THE
*                                ADDR OF STMT INFO WORD IN *IDPTB* FOR
*                                THIS STMT. 
*                              IF STMT IS PART OF *PROC* -- BIT 59 IS 1 
*                                AND BITS 17 THRU 0 CONTAIN THE *IDPPRN*
*                                ORD OF *PROC* CONTAINING STMT. 
  
 IDPSTO   BSSZ   3
  
          LOC    IDPSTO 
 IDPSTA   =      *           ADDR TO STORE INTO FOR *STORE* PROCESSING
 IDPSTC   =      *+1         NEW VALUE ASSEMBLED FROM C1 THRU C4 ON 
*                              *STORE* COMMAND
 IDPSTM   =      *+2         MASK ASSEMBLED FROM NULL C1 THRU C4 ON 
*                              *STORE* COMMAND. IDP USES THIS MASK TO 
*                              PICK UP THE PREVIOUS CONTENTS OF THE C-N-
*                              FIELD IF THE NEW C-N- FIELD IS NULL
*                              E.G.  STORE ADDR,,22222,,44444 
*                              PREVIOUS (STA) = 01020304050607080910
*                                       (STC) = 00000222220000044444
*                                       (STM) = 77777000007777700000
*                                   NEW (STA) = 01020222220607044444
          LOC    *O 
  
 IDPBAX   BSS    0           BAX REGISTER SHIFT MASK
          ECHO   2,BIT=(A,B,X)
          POS    60-1R_BIT
          VFD    1/1
          POS    0
  
 IDPSMX   BSS    0           SEPARATOR TOKEN MASK +-*,
          POS    60-1R+ 
          VFD    1/1
          POS    60-1R- 
          VFD    1/1
          POS    60-1R* 
          VFD    1/1
          POS    60-1R, 
          VFD    1/1
          POS    0
 IDPBTC   BSSZ   1           BREAK TYPE CODE
  
 IDPACC   BSSZ   1           ACCUMULATOR FOR THIS SUBEXPRESSION 
 IDPIND   BSSZ   1           USED BY *PAS* TO SHOW THE LEVEL OF INDIR-
*                              ECT ADDRESSING, 0 = DIRECT ADDRESSING
 IDPNUL   BSSZ   1           .ZR. IF JUST PARSED NULL EXPRESSION
*                                   E.G.   SNAP FWA,,LEN   (LWA IS NULL)
 IDPSGN   BSSZ   1           SET TO +0 WHEN + SIGN ENCOUNTERED
*                                   -0 WHEN - SIGN ENCOUNTERED
  
 IDP0TR   BSSZ   1           REGISTER DESIGNATOR
*                              USED FOR *REG R1,R2,...,RN* PROCESSING.
*                              FORMAT IS--  60/0TR WHERE
*                                  T = REGISTER TYPE (B=0,A=1,X=2)
*                                  R = REGISTER NR (0-7)
  
 IDPNAM   BSSZ   1           SAVE CELL FOR *ST=SET* -- SET NAME (0L FMT)
  
 IDPFAD   BSSZ   1           .NZ. IF *DAZ* IS TO FORCE OUT ADDR OF INST-
*                              RUCTION BEING DEASSEMBLED EVEN IF NOT
*                              FORCED UPPER IN WORD, ELSE .ZR.
*                              E.G. IF *FAD* IS .ZR. -- 
*                              ADDR  54111                 SA1  A1+B1 
*                                         0311000000       NZ   X1,...
*                                                   10611  BX6  X1
*                              E.G. IF *FAD* IS .NZ. -- 
*                              ADDR  54111                 SA1  A1+B1 
*                              ADDR       0311000000       NZ   X1,...
*                              ADDR                 10611  BX6  X1
*                              NOTE-- *DAZ* WILL ALWAYS ZERO *FAD*
  
 IDPSA5   BSSZ   1           SAVE CELL FOR (A5) 
  
 IDPPPP   BSSZ   2           PSEUDO P REGISTER AND POS COUNTER
  
          LOC    IDPPPP 
 IDPPREG  =      *           PSEUDO P REGISTER. POINTS TO WORD CONTAIN- 
*                              ING NEXT INSTRUCTION TO BE XEQ 
 IDPPOS   =      *+1         POSITION COUNTER. LEFT MOST BIT OF INST- 
*                              RUCTION TO XEQ IS BIT (IDPPOS)-1 IN
*                              ((IDPPREG)).(BITS ARE NUMBERED 59 THRU 0)
          LOC    *O 
  
 IDPXAR   BSSZ   1           .MI. IF NO ADDR REF VIA LOAD/STORE, ELSE 
*                              ADDR THAT WAS REFERENCED. USED IN *STAR* 
*                              PROCESSING.
 IDPXCA   BSSZ   2           CONDITIONAL *STEP* COMPARE ADDRESSES.
*                              IF THIS IS A CONDITIONAL STEP (STNE,...),
*                              THEN ((XA1)) WILL BE COMPARED TO ((XA2)) 
  
          LOC    IDPXCA 
 IDPXA1   =      *
 IDPXA2   =      *+1
          LOC    *O 
  
 IDPXFR   BSSZ   1           .ZR. IF NO XFER OF CONTROL BY BRANCH OR RJ,
*                              ELSE ADDR TO XFER CONTROL TO. USED IN
*                              STEP MODE SO THAT PSEUDO P REGISTER IS 
*                              NOT PREMATURELY UPDATED WHEN BRANCHING.
 IDPXLST  BSSZ   1           .NZ. IF LISTING THIS INSTRUCTION IN STEP 
*                              MODE, ELSE .ZR.
 IDPXRJ   BSSZ   1           .ZR. IF AT LEVEL 0 (I.E. NO *RJ* ACTIVE),
*                              ELSE ADDR OF ENTRY POINT TO ROUTINE
*                              CALLED FROM LEVEL 0. USED IN STEP MODE TO
*                              DETERMINE WHEN TO TURN LISTING BACK ON 
*                              WHEN /-RJ/ OPTION SELECTED 
 IDPXTC   BSSZ   1           *STEP* TYPE CODE 
  
 IDPXOP   BSSZ   2           STEP OPTIONS FLAGS. THERE IS A ONE-TO-ONE
*                              RELATIONSHIP BETWEEN THE STEP OPTIONS
*                              FLAGS AND THE STEP OPTIONS KEYWORD TABLE.
*                              WHEN *POL* RETURNS WITH A KEYWORD FIND 
*                              AND AN OPTIONS FLAG VALUE, THE ORDINAL OF
*                              FIND IN THE STEP OPTIONS KEYWORD TABLE IS
*                              THE ORDINAL TO STORE INTO *IDPXOP*.
  
          LOC    IDPXOP 
 IDPXOL   =      *           .NZ. IF /L/ SELECTED ON STEP COMAND, 
*                              ELSE .ZR. IF /-L/ SELECTED 
 IDPXORJ  =      *+1         .NZ. IF /RJ/ SELECTED ON STEP COMMAND, 
*                              ELSE .ZR. IF /-RJ/ SELECTED
          LOC    *O 
 MX=      SPACE  4,8
**        MX= - CHARACTER SHIFT MASKS.
  
  
 MX=KEYW  CHARMX (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,
,1,2,3,4,5,6,7,8,9),+7777B-1RM
 MX=NR09  CHARMX (0,1,2,3,4,5,6,7,8,9)
 MX=TOKN  CHARMX ("EOS",+,-,*,(,)),+7777B-1RM 
 MSG      SPACE  4,8
**        *IDP* MESSAGES. 
  
 IDPMSG2  DIS    3, CALLD BY 000000 IN XXXXXXX
 IDPMSG4  DIS    3, OLD VALU 00000000000000000000 
          DATA   0
 IDPMSG5  DIS    3, NEW VALU 00000000000000000000 
          DATA   0
 PATFLG   SPACE  4,8                                                    001980
**        PATFLG - PARSE *FWA,LWA,LEN* TRIPLE FLAG.                     001990
*                                                                       002000
*                                                                       002010
*         CONTAINS STATUS ABOUT THE *FWA,LWA,LEN* TRIPLE BEING          002020
*         PARSED/PROCESSED BY ROUTINE *PAT*.  USED SO THAT *PAT*        002030
*         CAN RESOLVE ANY POSSIBLE SYNTACTIC DIFFERENCES/PROBLEMS       002040
*         THAT MIGHT OCCUR BETWEEN THE *LWA* AND *LEN* PARAMETERS.      002050
*         SEE SUBROUTINE *PAT*.                                         002060
*                                                                       002070
*         BIT FLAGS WITHIN *PATFLG* MUST EXIST IN BITS 0 THRU 16        002080
*         (I.E. FIELD MANIPULATION IS DONE VIA *SX.I* TYPE INSTRUCTIONS)002090
*         AND ARE DESCRIBE/DEFINED IN THE USUAL MANNER VIA SYMBOLS      002100
*         OF THE FORM --                                                002110
*                                                                       002120
*                PAF.XXXP  AND  PAF.XXXL                                002130
*                                                                       002140
*         WHERE *PAF.* IS A COMMON PREFIX AND *XXX* IS A UNIQUE         002150
*         BIT FLAG (FIELD) NAME.                                        002160
*                                                                       002170
*         BIT FLAGS *XXX* ARE --                                        002180
*                                                                       002190
*         LWA  = 1 IF LWA WAS SPECIFIED EXPLICITLY (I.E. NON-NULL),     002200
*                  ELSE 0.                                              002210
*         LEN  = 1 IF LEN WAS SPECIFIED EXPLICITLY (I.E. NON-NULL),     002220
*                  ELSE 0.                                              002230
                                                                        002240
                                                                        002250
 PATFLG   BSSZ   1                                                      002260
 F.IDI    SPACE  4,8
**        F.IDI - FET, LINE IMAGE AREA, AND BUFFER FOR INTERACTIVE
*           DEBUG INPUT FILE. 
  
 #IDI     IF     -DEF,F.IDI 
 L.IDI    =      101B        LENGTH OF *IDP* INPUT BUFFER 
  
 F.IDI    BSS    0           ** FWA OF FET ** 
 ZZZZZDI  FILEC  IDPIDI,L.IDI,(FET=7)                                   000190
          DIS    1, **IDP** 
 IDPLIM   DIS    8,INTERACTIVE DEBUG LINE IMAGE AREA. 
 IDPIDI   BSS    L.IDI
  
 L=LIM    BSSZ   1           NR OF WORDS IN SOURCE LINE IMAGE AT
*                              (IDPLIM) ET SEQ (INCLUDES WORD CONTAINING
*                              EOL MARK)
 #IDI     ENDIF 
 F.BDI    SPACE  4,8
 F.BDI    =      F.IDI
 F.IDO    SPACE  4,8
**        F.IDO - FET AND BUFFER FOR INTERACTIVE DEBUG OUTPUT FILE. 
  
 #IDO     IF     -DEF,F.IDO 
 L.IDO    =      101B        LENGTH OF *IDP* OUTPUT BUFFER
  
 F.IDO    BSS    0           ** FWA OF FET ** 
 ZZZZZDO  FILEC  IDPIDO,L.IDO,(FET=7)                                   000210
 IDPIDO   BSS    L.IDO
 #IDO     ENDIF 
 IDPTB    SPACE  4,8
**        IDPTB - COMMAND LINE TOKEN BUFFER.
* 
*                CONTAINS THE CURRENT COMMAND LINE IN TOKEN FORM. 
* 
*         TOKEN BUFFER FORMAT --
* 
*         VFD    1/LAS,41/0,18/LEN   (TOKEN INFO WORD FOR STMT 1) 
*         VFD    42/0LCHARS,18/TOKEN TYPE 
*         VFD    42/0LCHAR ,18/TOKEN TYPE 
*          .
*          .
*         VFD    60/0   (END OF STATEMENT MARK FOR STMT 1)
* 
*         VFD    1/LAS,41/0,18/LEN   (TOKEN INFO WORD FOR STMT 2) 
*          .
*         ETC 
* 
*                THE FIELDS IN THE TOKEN INFORMATION WORDS ARE DESCRIBED
*         BY PAIRS OF SYMBOLS OF THE FORM *TB.XXXP* AND *TB.XXXL*,
*         WHERE *TB* IS THE COMMON PREFIX, AND *XXX* IS THE FIELD 
*         DESCRIPTION.
* 
*         FIELD DESCRIPTIONS (XXX) ARE -- 
* 
*         LAS  = 1  IF THIS IS LAST STMT ON LINE, ELSE 0
* 
*         LEN  = NR OF WORDS OR TOKENS IN STMT  (INCLUDES EOL MARK) 
*                  NOTE--IF LAS .EQ. 0, TOKEN INFO WORD FOR NEXT
*                  STMT IS AT -- TOKEN INFO WORD + LEN + 1
  
  
 L.TB     =      40          LENGTH OF TOKEN BUFFER 
 IDPTB    BSSZ   L.TB 
 TOKEN    SPACE  4,8
**        IDP TOKEN VALUES. 
  
 O.CONS   =      2           CONSTANT 
 O.SEP    =      4           SEPARATOR +-*, 
 O.VAR    =      3           NAME 
 KEYW     SPACE  4,8
**        KEYW - *IDP* KEYWORD TABLE GENERATOR. 
* 
* 
*                MACRO USED TO GENERATE THE *IDP* COMMAND KEYWORD TABLE.
* 
*         KEYW   KEYWRD,ADDR
* 
*         ENTRY  *KEYWRD* =  THE *IDP* KEYWORD
*                *ADDR*   =  STATEMENT PROCESSOR FOR THIS KEYWORD 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC  KEYW 
  
 KEYW     MACRO  KEYWRD,ADDR
          VFD    42/0L_KEYWRD,18/ADDR 
 KEYW     ENDM
 KEY      SPACE  4,8
**        *IDP* KEYWORD TABLE.
  
 IDPKEY   BSS    0
          KEYW   CODE,ST=COD
          KEYW   CONNECT,ST=CON 
          KEYW   DISCONT,ST=DSC 
          KEYW   DPC,ST=DPC 
          KEYW   END,ST=END 
          KEYW   FREEZE,ST=FRZ                                          002360
          KEYW   JUMP,ST=JP 
          KEYW   OUTPUT,ST=OUT
          KEYW   REGS,ST=REG
          KEYW   RESET,ST=RES 
          KEYW   SET,ST=SET 
          KEYW   SNAP,ST=SNP
          KEYW   STORE,ST=STO 
          KEYW   UNBREAK,ST=UBK 
          KEYW   UNSET,ST=UST 
          KEYW   UBREAK,ST=UBK
          KEYW   USET,ST=UST
          KEYW   WHERE,ST=WHR 
          KEYW   XEQ,ST=XEQ 
          KEYW   XFER,ST=XFR
  
*         *BREAK* KEYWORDS. 
*              THE BREAK TYPE CODE (IDPBTC) IS DETERMINED FROM THE BREAK
*           KEYWORD ORDINAL.
*              THERE EXISTS A ONE-TO-ONE RELATIONSHIP BETWEEN THE 
*           BREAK KEYWORD TABLE AND THE *CBC* OPERATOR TABLE. A CHANGE
*           TO ONE WOULD AFFECT THE OTHER.
*              THE ORDER OF THE BREAK KEYWORDS WITHIN *IDPKBR* IS ALSO
*           SIGNIFICANT-- 
*                BTC = 0  IS A BREAK WITH ONLY ONE ADDRESS EXPRESSION-- 
*                            BREAK ADDR 
*                BTC .LT. BTC=EQ  ARE BREAKS WITH 2 ADDR EXPRESSIONS--
*                            BRPL ADDR,ADDR1
*                BTC .GE. BTC=EQ  ARE BREAKS WITH 3 ADDR EXPRESSIONS--
*                            BREQ ADDR,ADDR1,ADDR2
*           THIS INFORMATION IS USED THROUGHOUT BREAK PROCESSING. 
  
 IDPKBR   BSS    0
          LOC    0
          KEYW   BREAK,ST=BRK 
          KEYW   BRPL,ST=BRK
          KEYW   BRMI,ST=BRK
          KEYW   BRZR,ST=BRK
          KEYW   BRNZ,ST=BRK
 BTC=EQ   KEYW   BREQ,ST=BRK
          KEYW   BRNE,ST=BRK
          KEYW   BRLT,ST=BRK
          KEYW   BRGE,ST=BRK
          KEYW   BRLE,ST=BRK
          KEYW   BRGT,ST=BRK
          LOC    *O 
  
*         *STEP* KEYWORDS.
*              THE STEP TYPE CODE (IDPXTC) IS DETERMINED FROM THE STEP
*           KEYWORD ORDINAL.
*              THERE EXISTS A ONE-TO-ONE RELATIONSHIP BETWEEN THE STEP
*           KEYWORD TABLE AND THE *CBC* OPERATOR TABLE. 
*              THE ORDER OF THE STEP KEYWORDS WITHIN *IDPKST* IS ALSO 
*           SIGNIFICANT-- 
*                XTC = 0  IS A STEP WITH NO ADDR EXPRESSION-- 
*                            STEP L,RJ
*                XTC .LT. XTC=EQ ARE STEPS WITH 1 ADDR EXPRESSION-- 
*                            STMI ADDR,L,RJ 
*                XTC .GE. XTC=EQ AND
*                    .LT. XTC=RNG ARE STEPS WITH 2 ADDR EXPRESSIONS-- 
*                            STGT ADDR1,ADDR2,L,RJ
*                XTC .GE. XTC=RNG ARE STEPS THAT ARE SPECIAL CASED--
*                            STAR ADDR,L,RJ 
*           (ALSO SEE *BREAK* KEYWORDS) 
  
 IDPKST   BSS    0
          LOC    0
          KEYW   STEP,ST=STP
          KEYW   STPL,ST=STP
          KEYW   STMI,ST=STP
          KEYW   STZR,ST=STP
          KEYW   STNZ,ST=STP
 XTC=EQ   KEYW   STEQ,ST=STP
          KEYW   STNE,ST=STP
          KEYW   STLT,ST=STP
          KEYW   STGE,ST=STP
          KEYW   STLE,ST=STP
          KEYW   STGT,ST=STP
 XTC=RNG  KEYW   STRANGE,ST=STP 
 XTC=NR   KEYW   STNR,ST=XNR
 XTC=AR   KEYW   STAR,ST=STP
          LOC    *O 
          DATA   0           END OF TABLE MARK
  
**        *STEP* OPTIONS KEYWORD TABLE. 
*           THERE IS A ONE-TO-ONE RELATIONSHIP BETWEEN THE STEP OPTIONS 
*           KEYWORD TABLE AND THE STEP OPTIONS FLAGS (SEE *IDPXOP*) 
  
 IDPKSTO  BSS    0
          KEYW   L,1
          KEYW   RJ,1 
          DATA   0           END OF TABLE MARK
 KEY      SPACE  4,8
**        *OUTPUT* OPTIONS KEYWORD TABLE. 
  
 IDPKOUT  BSS    0
          KEYW   B,ST=OUT3
          KEYW   BECHO,ST=OUT4
          KEYW   I,ST=OUT2
          KEYW   IECHO,ST=OUT5
          DATA   0           END OF TABLE MARK
 IDPBA    SPACE  4,8
**        IDPBA/IDPBC - BREAK ADDRESS AND BREAK CONTENTS PARALLEL TBLS. 
  
 L.BA     =      10          LENGTH OF *IDPBA*
 IDPBA    BSS    0           FWA OF *BREAK* ADDR TABLE
 .BA      DUP    L.BA,1 
          CON    -1 
          DATA   0           END OF TABLE TERMINATOR
 IDPBC    BSSZ   2*L.BA      *BREAK* ADDR CONTENTS TABLE
 IDPTMP   SPACE  4,8
**        IDP USER *TEMP* TABLE.
  
 L.TMP    =      10D
 IDPTMP   BSSZ   L.TMP
 IDPSET   SPACE  4,8
**        IDP *SET* TABLE DEFINITION. 
  
 L.SET    =      30B         LENGTH OF IDP *SET* TABLE
 IDPSET   BSS    0
          DUP    L.SET,1
          CON    -1 
          DATA   0
 IDPXFT   SPACE  4,8
**        IDPXFT - MOST RECENT TRANSFER ADDRESSES TABLE.
* 
*           TABLE FORMAT -- 
* 
*             XFT+0    VFD  30/-1  AVAILABLE ENTRY(ONLY IF XFT NOT FULL)
*                       . 
*                       . 
*                +N    VFD  30/POS COUNTER,30/P REG OF EARLIEST XFER
*                +N+1  VFD  30/POS COUNTER,30/P REG OF LATER XFER 
*                       . 
*               +L.XFT VFD  60/0   END OF TABLE MARK
  
 L.XFT    =      4
 IDPXFT   BSS    0
          DUP    L.XFT,1
          CON    -1 
          DATA   0
 IFR      SPACE  4,8                                                    002380
***       IFR - IDP FREEZE RESTART.                                     002390
*                                                                       002400
*                                                                       002410
                                                                        002420
 FW.IFR   BSS    0           MARK FWA OF *FREEZE* RESTART AREA          002430
                                                                        002440
          QUAL   IFR                                                    002450
 IFR      SPACE  4,8                                                    002460
**        IFR - IDP FREEZE RECOVERY/RESTART.                            002470
*                                                                       002480
*                                                                       002490
*         THIS ROUTINE IS USED TO RESTART (I.E. SWAPIN) AN              002500
*         IDP HOST PROGRAM THAT WAS FROZEN VIA *FREEZE*                 002510
*         COMMAND.  THE PROGRAM TO RESTART WAS WRITTEN BY *FRZ*         002520
*         TO LFN *F.FRZ* IN A SPECIAL FORMAT --                         002530
*                                                                       002540
*           RECORD 1  CONTAINS *IFR* (THE CODE YOU ARE LOOKING AT)      002550
*                     IN THE FORMAT OF AN ABSOLUTE BINARY.              002560
*                                                                       002570
*           RECORD 2  CONTAINS THE CORE IMAGE OF THE FROZEN PROGRAM.    002580
*                                                                       002590
*         BECAUSE RECORD 1 OF *F.FRZ* LOOKS LIKE AN ABS BINARY, THE     002600
*         PROGRAMMER NEED ONLY ENTER THE NAME OF THE FREEZE FILE AT     002610
*         HIS OR HER TERMINAL IN ORDER TO RESTART THE HOST.             002620
*                                                                       002630
*         AFTER *IFR* HAS BEEN LOADED, IT WILL MAKE AN OPERATING SYSTEM 002640
*         REQUEST FOR THE AMOUNT OF CM THAT THE HOST HAD AT THE TIME IT 002650
*         WAS FROZEN PLUS ENOUGH FOR *IFR* TO PERFORM THE FOLLOWING     002660
*         TASKS.  AFTER *IFR* HAS CREATED A HOLE FOR THE HOST           002670
*         BY *MEM*ING, IT WILL *PLUG* SOME CODE UP ABOVE THE HOLE,      002680
*         WHICH WILL READ IN THE 2ND RECORD OF *F.FRZ*.                 002690
*                                                                       002700
*         WE ALL HAVE CHET RICHARDS OF SVLOPS TO THANK FOR THIS         002710
*         DIABOLICALLY CLEVER IDEA.  HI HO SILVER, AND AWAY...          002720
*                                                                       002730
*         IMPORTANT NOTE--  IT IS IMPORTANT TO REALIZE THAT             002740
*         THIS CODE, AS IT EXISTS IN /DBG=IDP/, IS A DATA SECTION,      002750
*         I.E. IT CANNOT BE EXECUTED.  IT IS HERE ONLY SO THAT *FRZ*    002760
*         CAN WRITE IT OUT AS THE 1ST RECORD ON *F.FRZ*.                002770
*                                                                       002780
*         ENTRY  NONE                                                   002790
*                                                                       002800
*         EXIT   TO *RHH* IN HIGH CORE TO READ IN FROZEN HOST           002810
*                                                                       002820
*         USES   IRRELEVANT                                             002830
*                                                                       002840
*         CALLS  MEMORY                                                 002850
                                                                        002860
                                                                        002870
          LOC    RA.ORG                                                 002880
                                                                        002890
          VFD    12/5000B,12/0,18/RA.ORG,18/IFR                         002900
                                                                        002910
 IFR      BSS    0           ** LOADER ENTRY POINT **                   002920
          SB1    1                                                      002930
                                                                        002940
*         REQUEST ENOUGH MEMORY FOR THE FROZEN HOST PLUS *RHH*.         002950
*         ALSO, IF *CMM* WAS ACTIVE IN FROZEN HOST, INDICATE SO TO      002960
*         OPERATING SYSTEM.                                             002970
                                                                        002980
          SA2    MEM#HOST    (X2) = 30/AFLS OF FROZEN HOST,30/OTHER     002990
          SX6    L.RHH+L.IFRSZ+10B                                      003000
          LX6    30                                                     003010
          IX6    X2+X6       (X6) = 30/ENOUGH CORE FOR FROZEN HOST      003020
*                                    AND *RHH*, 30/OTHER                003030
          SA6    MEM#RHH                                                003040
                                                                        003050
                                                                        003060
          SA1    IFRA        (X1) = *MEM* REQUEST WORD                  003070
          BX6    X1                                                     003080
          RJ     SYS         MAKE SYSTEM REQUEST                        003090
                                                                        003100
*         SET UP *F.FRZ* FET SO THAT A *READSKP* WILL READ              003110
*         THE FROZEN HOST FROM *F.FRZ/RECORD 2* INTO                    003120
*         THE HOLE CREATED BY *MEM*.                                    003130
                                                                        003140
          SA1    RA.PGN                                                 003150
          AX2    30                                                     003160
          SX7    X2          (X7) = OUT = AFLS OF FROZEN HOST           003170
          MX3    60-18                                                  003180
          SA7    F.FRZ+3     OUT = AFLS OF FROZEN HOST                  003190
          SX4    122B        (X4) = *OPEN/NO REWIND* CIO CODE           003200
          BX6    X3*X1                                                  003210
          SX7    X7+B1       (X7) = LIMIT = AFLS+1 OF FROZEN HOST       003220
          IX6    X6+X4                                                  003230
          SA7    A7+B1       LIMIT = AFLS+1 OF FROZEN HOST              003240
          SA6    F.FRZ                                                  003250
          =X7    RA.MTR+1                                               003260
          SA7    A6+B1       FIRST = RA.MTR+1                           003270
          SA7    A7+B1       IN = FIRST =RA.MTR+1                       003280
                                                                        003290
*         MOVE *RHH* AND *F.FRZ* FET TO HIGH CORE                       003300
*         (ABOVE HOLE CREATED FOR FROZEN HOST).                         003310
                                                                        003320
          SB4    B0                                                     003330
          SA1    FW.RHH      (A1,X1) = A+C OF 1ST WORD TO MOVE          003340
          SB3    L.RHH       (B2) = NR OF WORDS TO MOVE                 003350
          SB2    X2+L.IFRSZ  (B2) = ADDR TO MOVE TO                     003360
                                                                        003370
 IFR2     BX6    X1                                                     003380
          SA6    B2+B4                                                  003390
          SB4    B4+B1                                                  003400
          SA1    A1+B1                                                  003410
          LT     B4,B3,IFR2  IF NOT DONE                                003420
                                                                        003430
*         OPEN *F.FRZ*.                                                 003440
                                                                        003450
          SA1    IFRB        (X1) = *CIO* REQUEST WORD                  003460
          SX2    B2+F.FRZ-FW.RHH   (X2) = FWA OF *F.FRZ* FET            003470
          BX6    X1+X2                                                  003480
          SA6    A1          SAVE *CIO* REQUEST W/ ADDR OF MOVED *F.FRZ*003490
          RJ     SYS         MAKE SYSTEM REQUEST TO OPEN *F.FRZ*        003500
                                                                        003510
*         SET UP SYSTEM REQUEST TO PERFORM THE *READSKP*                003520
*         WHICH WILL READ THE FROZEN HOST INTO THE HOLE CREATED         003530
*         BY *MEM*.                                                     003540
                                                                        003550
 IFR3     SA1    RA.MTR                                                 003560
          NZ     X1,IFR3     IF (RA.MTR) NOT CLEAR, WAIT...             003570
                                                                        003580
          SA1    SYS1                                                   003590
          SA2    B2+F.FRZ-FW.RHH   (A2,X2) = A+C OF *F.FRZ* FET WORD 1  003600
          SA3    IFRB        (X3) = *CIO* REQUEST WORD                  003610
          MX4    60-18                                                  003620
          BX7    X1                                                     003630
          LX1    59-56       (X1) = .MI. IF *EQ* INSTRUCTION            003640
*                                 = .PL. IF *XJ* INSTRUCTION            003650
          BX6    X4*X2       CLEAR BITS 0 THRU 17 OF *F.FRZ* WORD 1     003660
          SX4    22B         (X4) = *READSKP* CIO CODE                  003670
          IX6    X6+X4       MERGE *READSKP* CIO CODE                   003680
          SA6    A2                                                     003690
          BX6    X3          (X6) = *CIO* REQUEST WORD                  003700
                                                                        003710
*         RELOCATE *WAIT (RA.MTR) LOOP* IF NOT USING                    003720
*         *XJ* INSTRUCTION.                                             003730
                                                                        003740
          PL     X1,IFR4     IF USING *XJ*                              003750
          MX2    -18                                                    003760
          SX3    B2+B1       (X3) = ADDR OF *RHH* INSTRUCTIONS WHICH    003770
*                                   ACTUALLY MAKES THE *CIO* REQUEST    003780
*                                   TO READ *F.FRZ*                     003790
          BX7    X2*X7       CLEAR OLD ADDR                             003800
          IX7    X7+X3       MERGE NEW ADDR                             003810
          SA7    B2+B1                                                  003820
                                                                        003830
*         EVERYTHING IS READY TO GO...                                  003840
*         TRANSFER CONTROL TO *RHH* UP IN HIGH CORE.                    003850
                                                                        003860
 IFR4     JP     B2+                                                    003870
                                                                        003880
                                                                        003890
*         *MEM* REQUEST WORD.                                           003900
                                                                        003910
 IFRA     VFD    18/3LMEM,3/2,21/0,18/MEM#RHH                           003920
                                                                        003930
*         *CIO* REQUEST WORD.                                           003940
                                                                        003950
 IFRB     VFD    18/3LCIO,3/2,21/0,18/0                                 003960
 SYS      SPACE  4                                                      003970
***       SYS - PROCESS SYSTEM REQUEST.                                 003980
*                                                                       003990
*         ENTRY  (X6) = SYSTEM REQUEST.                                 004000
*                                                                       004010
*         EXIT   REQUEST PROCESSED.                                     004020
*                                                                       004030
*         USES   X - 1.                                                 004040
*                B - NONE.                                              004050
*                A - 1, 6.                                              004060
*                                                                       004070
*         CALLS  NONE.                                                  004080
                                                                        004090
                                                                        004100
*         INSTRUCTION WORDS FOR MONITOR CALL.                           004110
                                                                        004120
 SYSA     BSS    0                                                      004130
          LOC    *+2                                                    004140
 +        SA1    A1          WAIT (RA+1) CLEAR IF AUTO RECALL           004150
          LX1    59-40                                                  004160
          NG     X1,*                                                   004170
          LOC    SYSA+1                                                 004180
                                                                        004190
          XJ                                                            004200
                                                                        004210
 SYS1     EQ     SYS2        FIRST ENTRY                                004220
                                                                        004230
 SYS      PS                 ENTRY/EXIT                                 004240
 +        SA1    1           WAIT (RA+1) CLEAR                          004250
          NZ     X1,*                                                   004260
          SA6    A1          ENTER REQUEST                              004270
          EQ     SYS1                                                   004280
                                                                        004290
*         INITIAL ENTRY TO SET TYPE OF CALL.                            004300
                                                                        004310
 SYS2     SA1    SYSA        NO MEJ/CEJ OPTION                          004320
          BX6    X1                                                     004330
                                                                        004340
          SA1    RA.CEJ                                                 004350
          PL     X1,SYS3     IF NO MEJ/CEJ PRESENT                      004360
          SA1    SYSA+1                                                 004370
          BX6    X1                                                     004380
 SYS3     BSS    0                                                      004390
                                                                        004400
          SA6    SYS1        SET MONITOR CALL                           004410
          SA1    1           RESET (A1)                                 004420
          BX6    X1                                                     004430
          RJ     SYS1-1      CLEAR STACK                                004440
 IFR      SPACE  4,8                                                    004450
 MEM#RHH  BSSZ   1           30/AFLS OF HOST PLUS *RHH*,30/OTHER        004460
                                                                        004470
 MEM#HOST BSSZ   1           30/AFLS OF HOST,30/OTHER                   004480
                                                                        004490
 L.IFRSZ  =      10B         LEN OF SAFETY ZONE BETWEEN HOST AND *RHH*  004500
 RHH      SPACE  4,8                                                    004510
**        RHH - READ HOST INTO HOLE.                                    004520
*                                                                       004530
*                                                                       004540
*         THIS ROUTINE MAKES THE ACTUAL OPERATING SYSTEM REQUEST        004550
*         TO READ THE FROZEN HOST FROM *F.FRZ/RECORD 2*                 004560
*         INTO THE HOLE CREATED BY *IFR*.                               004570
*                                                                       004580
*         ENTRY  (X6) = *CIO* REQUEST WORD                              004590
*                                                                       004600
*         EXIT   TO *IDP=IFR* IN UNFROZEN HOST                          004610
*                                                                       004620
*         USES                                                          004630
*                                                                       004640
*         CALLS  NONE                                                   004650
                                                                        004660
 FW.RHH   BSS    0           MARK FWA OF*RHH*                           004670
                                                                        004680
 RHH      BSS    0           ** ENTRY **                                004690
          SA6    RA.MTR                                                 004700
                                                                        004710
*         THE FOLLOWING LOCATION WILL BE PLUGGED WITH                   004720
*         A *WAIT (RA.MTR)* LOOP BY *IFR* IF NO *XJ* INSTRUCTION        004730
*         AVAILABLE.                                                    004740
                                                                        004750
+         XJ                                                            004760
                                                                        004770
*         THE INTERACTIVE HOST IS NOW BACK IN CORE... RE-ENTER *IDP*.   004780
                                                                        004790
+         EQ     /"IDP"/IDP=IFR                                         004800
 F.FRZ    SPACE  4,8                                                    004810
**        F.FRZ - FET FOR *FREEZE* FILE.                                004820
                                                                        004830
 F.FRZ    BSS    0           ** FWA OF FET **                           004840
 L.FRZ    =      101B        LENGTH OF *F.FRZ* BUFFER FOR RECORD 1 WRITE004850
*                            (I.E. SMALLEST POSSIBLE, 1 PRU)            004860
 FRZ      FILEB  /"IDP"/FW.IFR,L.FRZ                                    004870
                                                                        004880
                                                                        004890
 L.RHH    =      *-FW.RHH+1                                             004900
                                                                        004910
          LOC    *O                                                     004920
          QUAL   *                                                      004930
                                                                        004940
 L.IFR    =      *-FW.IFR+1  LENGTH OF IDP FREEZE RESTART PROGRAM       004950
 IFR      SPACE  4,8                                                    004960
**        REDEFINE SYMBOLS THAT *IDP* NEEDS TO REFERENCE INSIDE /IFR/.  004970
                                                                        004980
 F.FRZ    =      FW.IFR+/IFR/F.FRZ-RA.ORG                               004990
 MEM#RHH  =      FW.IFR+/IFR/MEM#RHH-RA.ORG                             005000
 MEM#HOST =      FW.IFR+/IFR/MEM#HOST-RA.ORG                            005010
 IDP      SPACE  4,8                                                    005020
  
 #OS      ELSE
 IDP=     SUBR               ** ENTRY/EXIT ** 
          EQ     EXIT.
 #OS      ENDIF 
 DBG=IDP  SPACE  4,8
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 IDP=     =      /DBG=IDP/IDP=
  
          IF     DEF,/DBG=IDP/.OS,1 
 .OS      =      /DBG=IDP/.OS 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
 IDP=ER   =      /DBG=IDP/IDP=ER
 IDP=MN   =      /DBG=IDP/IDP=MN
 #OS      ENDIF 
  
 REG=     =      /DBG=IDP/REG=
 SNP=     =      /DBG=IDP/SNP=
 QUAL$    ENDIF 
          ENDX
