*COMDECK COMCIDP
 COMCIDP  CTEXT  COMCIDP "IDPVER" - INTERACTIVE DEBUG PACKAGE.
 COMCIDP  SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCIDP
          BASE   D
  
 IDP      MICRO  1,,/"QUAL"/
 COMCIDP  SPACE  4,10 
***       COMCIDP - 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, *IDP DEPENDENCIES* ARE DEFINED 
*         TO BE THE INTERFACES THAT THE IDP INSTALLER MUST PROVIDE; 
*         AND *IDP OPTIONS* ARE THOSE INTERFACES WHICH ARE OPTIONAL.
*         THAT IS, 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 MENTIONED
*         AGAIN.
* 
************************************************************************
* 
*         IDP DEPENDENCIES--
* 
************************************************************************
* 
*         COMDECKS NEEDED BY *COMCIDP*.  ALTHOUGH THESE COMDECKS
*         ARE NOT ALL STRICTLY ASSEMBLY-TIME DEPENDENCIES (I.E. SOME CAN
*         BE SATISFIED AT LOAD-TIME), THE POINT IS THAT THEY ALL HAVE 
*         TO BE AROUND FOR *COMCIDP* TO WORK.  SOME ARE THE CLASSIC 
*         *KRONOS* COMDECKS AND SOME ARE NEW.  ALL CAN BE FOUND ON
*         *IDPPL* (IDP OLDPL), *OLDPL,ID=COMPASS*, OR *CPUTEXT*.
* 
*         WARNING-- IT IS SUGGESTED THAT THE IDP INSTALLER PROVIDE
*         SEPARATE COPIES OF CODE COMDECKS FOR *COMCIDP*, EVEN IF 
*         THE HOST ALREADY HAS COPIES OF THESE COMDECKS.  THIS WILL 
*         AVOID PROBLEMS THAT CAN OCCUR IN *STEP* MODE WHEN IDP 
*         TRIES TO STEP COMDECKS THAT IT IS ALSO USING ITSELF.
* 
*         ACTCOM    COMACIO   COMADEF   COMAFET   COMAIDP   COMAREG 
*         COMATOK 
* 
*         COMCBUB   COMCBUN   COMCCDD   COMCCIO   COMCCOD   COMCLFM 
*         COMCMCS   COMCRDC   COMCRDW   COMCRSR   COMCSBM   COMCSFN 
*         COMCSVR   COMCSYS   COMCTOK   COMCWOD   COMCWTC   COMCWTW 
*         COMCXJR   COMCZTB 
* 
*         COMSIDP   COMSRAS   COMSTOK 
************************************************************************
* 
*         IDP OPTIONS-- 
* 
************************************************************************
* 
*         CP.NFLS - NOMINAL FIELD LENGTH SCM. 
* 
*         IF THE SYMBOL *CP.NFLS* IS AVAILABLE (=Y), THEN IT IS THE 
*         ADDR OF THE SCM LOCATION THAT CONTAINS THE CURRENT NOMINAL
*         FIELD LENGTH SCM FOR THE HOST PROGRAM.  THIS OPTION IS
*         INTENDED FOR HOST PROGRAMS THAT PERFORM THEIR OWN MEMORY
*         MANAGEMENT.  IF *CP.NFLS* IS AVAILABLE, THEN *IDP* USES ITS 
*         CONTENTS FOR ADDR LEGALITY CHECKS AND ASSUMES THAT THE HOST 
*         IS KEEPING IT UPDATED.
* 
*                0 .LE. LEGAL ADDR .LT. (CP.NFLS) 
* 
*         FORMAT -- 
*                VFD   42/0,18/FL 
* 
*         IF THE SYMBOL *CP.NFLS* IS NOT AVAILABLE, THEN *IDP*
*         WILL CHECK SCM ADDRESSES USING THE FOLLOWING SCHEME-- 
* 
*           1. IF BITS 0 THRU 17 OF (RA.LWP) ARE .MI., THEN *CMM* 
*              IS ACTIVE.  *IDP* WILL THEREFORE TRY AND FIND THE
*              CURRENT FL AT (DABA), I.E. (-(RA.LWP)).  HOWEVER,
*              BECAUSE *CMM* IS NOT REAL GOOD AT KEEPING *DABA* 
*              UPDATED PROPERLY, *IDP* WILL DOUBLE CHECK AN 
*              ADDR THAT *DABA* INDICATES IS OUT-OF-RANGE BY PERFORMING 
*              A SYSTEM *MEMORY* (*MEM* REQUEST) TO FIND OUT THE TRUE 
*              FL.  NOTE-- *IDP* DOES NOT UNCONDITIONALLY CHECK ADDRS 
*              AGAINST A *MEMORY* FOR EFFICIENCY REASONS. 
* 
*           2. IF BITS 0 THRU 17 OF (RA.LWP) ARE .PL., THEN ADDRESSES 
*              ARE CHECKED AGAINST A *MEMORY* REQUEST.
* 
************************************************************************
* 
*         EOS - END-OF-STATEMENT MICRO. 
* 
*         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 
************************************************************************
* 
*         FAA= - FIND ABSOLUTE ADDRESS. 
* 
*         IF THE SYMBOL *FAA=* IS AVAILABLE (=Y), THEN *FAA= - FIND 
*         ABSOLUTE ADDRESS* IS A USER SUBROUTINE THAT WILL PROVIDE
*         *COMCIDP* 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 AVAILABLE, 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
************************************************************************
* 
*         FRA= - FIND RELATIVE ADDRESS. 
* 
*         IF THE SYMBOL *FRA=* IS AVAILABLE (=Y), THEN *FRA= - FIND 
*         RELATIVE ADDRESS* IS A USER SUBROUTINE THAT WILL PROVIDE
*         *COMCIDP* 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
*         *COMCIDP* 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 AVAILABLE, WHENEVER A ROUTINE IN *COMCIDP* 
*         REQUIRES THIS RELATIVE ADDRESS PLUS OFFSET DPC FORMAT, A
*         *EQ =XFRA=* IS EXECUTED.
* 
*         IT IS SUGGESTED THAT THE IDP INSTALLER USE THE COMDECK
*         NAMED *CCOMRPV* (COMPILER COMMON REPRIEVE PROCESSOR). 
*         *CCOMRPV* CONTAINS, AMONG OTHER THINGS, A REASONABLE VERSION
*         OF *FRA=*.  SEE *CCOMRPV*.
* 
*         SEE ALSO PREAMBLE TO SUBROUTINE *FRA* (FIND RELATIVE ADDRESS) 
*         IN *COMCIDP*. 
* 
**        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
************************************************************************
* 
*         PROMPT - INTERACTIVE PROMPT MICRO NAME
* 
*         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. 
************************************************************************
* 
*         UKT=/FW=UKT - USER KEYWORD TABLE DEFINITION AND LINKING.
* 
*         IF THE SYMBOL *UKT=* IS AVAILABLE (=Y), 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,
*         THEREBY USING IDP AS A TERMINAL HANDLER FOR ONES OWN SCHEMES. 
* 
*         IN GENERAL TERMS, THIS WORKS AS FOLLOWS: AFTER IDP HAS
*         SEARCHED ITS OWN KEYWORD TABLE, HE WILL SEARCH THE USER 
*         KEYWORD TABLE AT *UKT=* ET SEQ.  IF IDP FINDS A KEYWORD MATCH 
*         IN THE USER'S KEYWORD TABLE, THEN IDP TRANSFERS CONTROL TO
*         A SPECIFIED USER PROCESSOR. 
* 
*         NOTE THAT AS STATED ABOVE, THIS ALGORITHM GIVES PRECEDENCE
*         TO IDP'S KEYWORDS OVER THE USER'S KEYWORDS. 
* 
*         THE KEYWORD TABLE(S) FOR IDP CAN BE LINKED TOGETHER IN THE
*         FOLLOWING WAY --
* 
*                +++++++++++++++++++++
*                +                   +
*                + IDP KEYWORD TABLE +
*                +                   +
*                +++++++++++++++++++++  ..... 
*                                           . 
*                +++++++++++++++++++++  <.... 
*                +                   +
*                + UKT NUMBER 1      +
*                +                   +
*                +++++++++++++++++++++  ..... 
*                                           . 
*                         .                 . 
*                         .                 . 
*                +++++++++++++++++++++  <.... 
*                +                   +
*                + UKT NUMBER N      +
*                +                   +
*                +++++++++++++++++++++
* 
*         THIS IMPLIES, THEREFORE, THAT THERE CAN BE ANY NUMBER OF USER 
*         KEYWORD TABLES LINKED TO IDP AT ANY TIME. 
* 
*         EACH KEYWORD TABLE IS TERMINATED BY A FULL ZERO WORD.  A 2ND
*         FULL WORD IMMEDIATELY FOLLOWING THE END-OF-TABLE WORD IS USED 
*         FOR LINKING TO MORE KEYWORD TABLES, IF DESIRED.  IT SHOULD
*         CONTAIN THE FWA OF THE **NEXT** USER KEYWORD TABLE, OR BE 
*         ZERO TO INDICATE END-OF-ALL-KEYWORD-TABLES. 
* 
*         EACH INDIVIDUAL KEYWORD TABLE ENTRY SHOULD BE DEFINED VIA THE 
*         *KEYW* MACRO IN *COMSIDP* (IDP INTERFACE TEXT). 
* 
*         AFTER KEYWORD PROCESSING, THE USER SHOULD RETURN CONTROL BACK 
*         TO IDP BY EXECUTING A BRANCH TO *IDP=MN* (IDP MAIN LOOP NODE) 
*         IF THERE WERE NO ERRORS, OR TO ONE OF IDP'S ERROR PROCESSORS: 
* 
*         *IDP=ER* IS INVOKED FOR USER DETECTED ERRORS FOR WHICH THERE
*         IS NO ERROR MESSAGE.  THIS PROCESSOR EXISTS PRIMARILY FOR 
*         COMPATABILITY WITH AN OLDER VERSION OF IDP CALLED *DBG=IDP*.
*         I ADVISE **NOT** USING THIS ERROR PROCESSOR FOR THE SIMPLE
*         REASON THAT ERROR MESSAGES ARE NICE THINGS TO HAVE... 
* 
*         THE MACRO *ERROR* (DEFINED IN *COMSIDP*) IS USED TO SPECIFY 
*         AN ERROR THAT **DOES** HAVE AN ERROR MESSAGE.  SEE *COMSIDP*. 
* 
*         THE MACRO *SYSERR* (DEFINED IN *COMSIDP*) IS USED FOR ERRORS
*         THAT ARE DETECTED VIA *SELF CHECKING* TYPE CODE.  THESE ARE 
*         INTERNAL TYPE IDP SYSTEM ERRORS THAT COULD POTENTIALLY BE 
*         VERY DANGEROUS/CONFUSING TO THE DEBUGGER WHO IS NOT INTERESTED
*         IN DEBUGGING IDP ITSELF.  IDP CONTAINS A GOODLY AMOUNT OF 
*         SELF-CHECKING CODE THAT AIMS AT MINIMIZING IDP SCREW-UPS. 
* 
************************************************************************
* 
*         UIO= - USER IDP OWNCODE.
* 
*         IF THE SYMBOL *UIO=* IS AVAILABLE (=Y), 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)
************************************************************************
* 
*         URO= - USER *REG=* OWNCODE. 
* 
*         IF THE SYMBOL *URO=* IS AVAILABLE (=Y), 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 *COMAIDP*). 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
* 
*         EXIT   (X1) = .MI. IF TO PERFORM REGISTER SNAPSHOT
*                     = .PL. IF NO REGISTER SNAPSHOT THIS TIME
************************************************************************
* 
*         USO= - USER *SNP=* OWNCODE. 
* 
*         IF THE SYMBOL *USO=* IS AVAILABLE (=Y), 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 *COMAIDP*). 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
* 
*         EXIT   (X1) = .MI. IF SNAP TO BE TAKEN
*                     = .PL. IF NO SNAP THIS TIME 
************************************************************************
* 
*         USY= - USER SYMBOL TABLES SEARCH. 
* 
*         IF THE SYMBOL *USY=* IS AVAILABLE (=Y), THEN *USY=* (USER 
*         SYMBOL TABLES SEARCH) IS A USER SUBROUTINE THAT IS CALLED 
*         WHEN IDP WISHES TO ASSOCIATE A BINARY VALUE WITH A DPC
*         SYMBOL. 
* 
*         FOR EXAMPLE, IF THE INTERACTIVE PERSON TYPES -- 
* 
*                SNAP FROM,TO 
* 
*         AND IDP CAN NOT FIND THE SYMBOLS *FROM* AND/OR *TO* VIA 
*         ITS OWN SEARCHING, THEN IDP WILL TRY AND CALL *USY=* TO 
*         ALLOW THE HOST TO TRY AND ASSOCIATE A BINARY VALUE WITH 
*         THIS SO FAR UNDEFINED SYMBOL. 
* 
**        USY= - USER SYMBOL TABLES SEARCH. 
* 
*         ENTRY  (X1) = SYMBOL TO SEARCH FOR, -L- FMT.
* 
*         EXIT   (X1) = .NZ. IF A FIND, ELSE .ZR. 
*                (X6) = BINARY VALUE TO ASSOCIATE WITH THIS SYMBOL. 
* 
*         LOCKED A0,X0,A5,X5
* 
************************************************************************
 CODING   SPACE  4,10 
***       COMMENTING/CODING CONVENTIONS.
* 
* 
*         A NUMBER OF COMMENTING AND CODING CONVENTIONS HAVE BEEN 
*         ADOPTED IN THIS PIECE OF CODE WHICH SHOULD MAKE IT EASIER 
*         TO READ AND UNDERSTAND.  THIS AUTHOR BELIEVES VERY STRONGLY 
*         THAT THE **NOTATION** USED TO DESCRIBE A PARTICULAR DESIGN
*         IMPLEMENTATION IS AS IMPORTANT AS THE DESIGN ITSELF.  AND 
*         INSTEAD OF REQUIRING THAT YOU DECIPHER **MY** NOTATION ON 
*         THE FLY, I WILL TELL YOU HERE AND NOW HOW IT WORKS... 
* 
*         THIS DISCUSSION CAN BE DIVIDED INTO 3 PARTS: CODE FORM, 
*         SYMBOL NAMING, AND A GLOSSARY OF ABBREVIATIONS. 
* 
************************************************************************
* 
*         CODE FORM 
* 
*         THIS IS A DESCRIPTION OF HOW ONE CAN EXPECT CODE TO LOOK
*         ON A PAGE.  THE *MACE/KRONOS* CONVENTION IS THE MODEL.
*         *MACE* IS A VERY STYLIZED CODING CONVENTION WHICH IS AIMED
*         PRIMARILY AT FORMALIZING SUBROUTINE STRUCTURE.
* 
*         *MACE*, BRIEFLY --
* 
*           1. SUBROUTINES ARE USED THAT ENTER AND EXIT AT A COMMON 
*              POINT, I.E. ARE INVOKED BY AN *RJ* INSTRUCTION.
* 
*           2. ALL SUBROUTINES HAVE 3 CHARACTER MNEMONIC NAMES
*              THAT DESCRIBE THEIR FUNCTION.
* 
*           3. ALL SUBROUTINES BEGIN WITH AN EXTREMELY STYLIZED 
*              PREAMBLE WHICH GIVES THE NAME OF THE SUBROUTINE, ITS 
*              FUNCTION, ITS ENTRY AND EXIT CONDITIONS, THE REGISTERS 
*              IT USES/DESTROYS, AND A LIST OF ALL THE SUBROUTINES
*              AND/OR MACROS THAT IT CALLS/REFERENCES.
* 
*              A DETAILED DESCRIPTION OF THE PREAMBLE IS BASICALLY
*              A WASTE OF TIME.  THEY ARE ALL EXACTLY ALIKE...JUST GO 
*              LOOK AT ONE. 
* 
*           4. ALL SUBROUTINE EXECUTABLE CODE LABELS CONSIST OF THE 
*              SUBROUTINE 3 CHARACTER MNEMONIC FOLLOWED BY A DIGIT
*              OR DIGITS IN ASCENDING ORDER.
* 
*           5. SUBROUTINE LOCAL-ONLY SCRATCH CELLS HAVE LABELS THAT 
*              CONSIST OF THE SUBROUTINE 3 CHARACTER MNEMONIC FOLLOWED
*              BY A SINGLE LETTER (BEGINNING AT -A-) IN ASCENDING 
*              ORDER. 
* 
*           6. THE *COMPASS* 2,11,18,30 TABBING CONVENTION IS STRICTLY
*              FOLLOWED.  I.E. LABEL FIELD IN COL 2, OPERATION FIELD
*              IN COL 11, ADDRESS FIELD IN COL 18, AND COMMENT FIELD
*              IN COL 30. 
* 
*           7. COMMENTS THAT DESCRIBE HARDWARE FUNCTION ARE AVOIDED.
*              E.G.  SA1  ZIP    LOAD FLAG
*                    LX1  4      LEFT-SHIFT (X1)
* 
*           8. **ALL** CONDITIONAL BRANCH INSTRUCTIONS CONTAIN A COMMENT
*              IN COLS 30-72 THAT BEGINS WITH THE WORD *IF* AND 
*              DESCRIBES THE *BRANCH TAKEN* CONDITION.  E.G.
* 
*                    ZR   X1,EXIT. IF AT END OF TABLE 
* 
*         FOR ME, *MACE*S PRIMARY VIRTUE IS THAT IS MAKES FOREIGN CODE
*         LOOK NOT-SO-FOREIGN.  SIMPLE. 
* 
*         IN ADDITION, THIS CODE USES A FEW EXTENSIONS TO THE *MACE*
*         WAY... THEY ARE --
* 
*           1. THE COMMENT FIELD FOR A LINE CONTAINING A MACHINE
*              MNEMONIC INSTRUCTIONS (I.E. COLS 30-72) IS GENERALLY 
*              RESERVED FOR A DESCRIPTION OF THE DATA STRUCTURE 
*              RESULTING FROM THE HARDWARE INSTRUCTION ON THAT LINE.
* 
*              USUALLY, THIS IS NOTATED VERY FORMALLY, WITH THE EXPLICIT
*              RESULT REGISTER SPECIFIED.  E.G. --
* 
*                BX4  -X0*X5    (X4) = NEXT CHAR TO PACK, -R- FORMAT
* 
*              WHEN SETTING A LOGICAL FLAG, IT DIFFERS -- 
* 
*                SA6  TF=SQZ    SET TO *INDICATE NO BLANK SQUEEZE*
* 
*              OR WHEN MANIPULATING A *COMADEF* STRUCTURE --
* 
*                BX6  X6+X1     MERGE *LEN* 
* 
*              IN ITS MOST COMMON FORM, THE RESULT REGISTER IS
*              EXPLICITLY SPECIFIED SO THAT THE READER KNOWS
*              **ABSOLUTELY** WHAT IS MEANT.
* 
*              IN ANY CASE, RESERVING COLS 30-72 FOR DATA STRUCTURE 
*              DESCRIPTIONS MAKES DEBUGGING EASIER BECAUSE ONE CAN
*              CONSTANTLY COMPARE WHAT **IS** WITH WHAT **SHOULD BE**.
* 
*           2. FUNCTIONAL COMMENTS (I.E. WHAT IS GOING ON, OR HOW IT
*              IS DONE, OR MORE IMPORTANTLY, WHY ARE WE DOING IT) ARE 
*              USUALLY PLACED ON A SEPARATE COMMENT LINE THAT PRECEDES
*              PARAGRAPH OF CODE THAT IT PERTAINS TO. 
* 
*              THIS TENDS TO MAKE CODE OCCUR IN FUNCTIONAL BLOCKS...GOOD
*              FOR A QUICK ONCE-OVER EYE SCAN.
* 
*           3. A FLAG CELL DEFINITION WILL CONTAIN (AT A MINIMUM) 
*              A COMMENT THAT SPECIFIED/DESCRIBES **ALL** POSSIBLE
*              VALUES THAT THIS FLAG MAY TAKE, AND IDEALLY, UNDER 
*              WHAT CONDITIONS THE FLAG WILL TAKE THOSE VALUES. 
* 
*              THIS IS DONE BECAUSE OFTENTIMES, THE FLAG CELL DEFINITION
*              IS THE ONLYPLACE WHERE THE INTRICACIES AND PATHOLOGIES 
*              ASSOCIATED WITH THE USE OF THE FLAG CAN BE INTEGRATED. 
* 
************************************************************************
* 
*         SYMBOL NAMING 
* 
*         THIS IS A DESCRIPTION OF THE CONVENTIONS USED IN SYMBOL 
*         NAMING.  THE INTENT OF THSE CONVENTIONS IS TO TRANSMIT TO 
*         THE READER AS MUCH INFORMATION AS POSSIBLE BY MERELY SEEING 
*         A SYMBOL NAME ITSELF.  OFTEN, THIS INFORMATION IMPLIES HOW
*         ONE CAN **EXPECT** A SYMBOL TO BE USED. 
* 
*         TWO BASIC SYMBOL NAME-FORMING RULES ARE USED: FIRST, SYMBOL 
*         PREFIXES ARE USED HEAVILY.  AND SECOND, THE CHARACTER THAT
*         SEPARATES A SYMBOL PREFIX FROM THE REST OF THE SYMBOL NAME
*         IS GIVEN SEMANTIC MEAING.  CURRENTLY, THERE ARE ONLY 2 SUCH 
*         CHARACTERS: -.- IMPLIES THAT THE VALUE OF THE SYMBOL IS 
*         AVAILABLE AT ASSEMBLY-TIME.  E.G. --
* 
*                SX1    L.KEYW  (X1) = LEN (IN WORDS) OF *KEYW* TABLE 
* 
*         AN -=- CHARACTER IMPLIES THAT THE VALUE OF THE SYMBOL IS
*         AVAILABLE ONLY AT EXECUTION-TIME (I.E. IT IS ONLY THE ADDRESS 
*         OF A CELL AT ASSEMBLY-TIME).  E.G. -- 
* 
*                SA1    L=KEYW  (X1) = LEN (IN WORDS) OF *KEYW* TABLE 
* 
*         THESE SYMBOLS ARE, THEREFORE, INDIRECT. 
* 
*         NOTE THE USE OF THE WORD *VALUE* IN THE ABOVE PARAGRAPH.
*         OBVIOUSLY, *COMPASS* MUST BE ABLE TO ASSOCIATE SOME BINARY
*         NUMBER WITH BOTH TYPES OF SYMBOLS AT ASSEMBLY-TIME.  IN A 
*         HUMAN SENSE, THOUGH, THE SYMBOL NAMES IN THE ABOVE EXAMPLES 
*         TELL WHETHER THE *VALUE* OF THE SYMBOL WILL BE USED IN
*         A DIRECT, OR AN INDIRECT MANNER.  A SUBTLE DIFFERENCE THAT
*         CAN BE HANDY WHEN READING CODE. 
* 
*         SYMBOL NAMES CAN BE DIVIDED INTO THE FOLLOWING GENERAL
*         TYPES --
* 
*           1. SYMBOLS THAT DESCRIBE COMMON COMPUTER OR CDC CONCEPTS, 
*              SUCH AS: LENGTH, FIRST WORD ADDRESS, ETC...  THESE 
*              SYMBOL NAMES ARE STRUCTURED SO THAT THE PREFIX DESCRIBES 
*              THE COMMON IDEA.  I.E. - 
* 
*                L.XXX  - LENGTH OF XXX.
*                FW.XXX - FWA OF XXX. 
*                F.XXX  - FWA OF A FET/FIT FOR FILE XXX.
* 
*           2. *COMADEF* STRUCTURES.  *COMADEF* IS A COMDECK THAT 
*              CONTAINS MACROS FOR DESCRIBE/DEFINING SOFTWARE DATA
*              STRUCTURES.  CONCEPTUALLY, IT WORKS MUCH LIKE THE *COBOL*
*              *PICTURE*.  VIA THE *COMADEF* MACROS, ONE CAN DRAW 
*              A PICTURE OF WHAT A DATA STRUCTURE ELEMENT WILL LOOK 
*              LIKE.
* 
*              NOW WHEN ONE WISHES TO BUILD OR ACCESS SOME PART OF THE
*              DATA STRUCTURE, YOU CAN DO IT **SYMBOLICALLY** VIA 
*              SYMBOLS THAT THE *COMADEF* MACROS DEFINED IN RESPONSE
*              TO THE PICTURE THAT WAS DRAWN VIA THOSE MACROS.
* 
*              *COMADEF* SYMBOLS TAKE THE FORM -- 
* 
*                  DD.XXXP  AND DD.XXXL 
* 
*              WHERE *DD* IS A COMMON PREFIX FOR THIS DATA STRUCTURE, 
*              *XXX* IS A UNIQUE NAME FOR A FIELD WITHIN THE DATA 
*              STRUCTURE *DD*, *P* IS A SUFFIX THAT DENOTES THE RIGHT-
*              MOST BIT POSITION OF FIELD *XXX* WITHIN *DD*, AND *L*
*              IS A SUFFIX THAT DENOTES THE LENGTH (IN BITS) OF FIELD 
*              *XXX*. 
* 
*              FOR EXAMPLE -- 
* 
*                  SA1  A1+B1    (X1) = NEXT ELEMENT IN STRUCTURE *BB.* 
*                  MX2  -BB.TOTL (X2) = MASK FOR EXTRACTING *TOT* FIELD 
*                  LX1  0-BB.TOTP RIGHT-JUSTIFY *TOT* FIELD 
*                  BX6  -X2*X1   (X6) = CONTENTS OF *TOT* FIELD 
* 
*              ONCE ONE BECOMES FAMILIAR WITH THE *COMADEF* NOTATION, 
*              MOST OF THE ABOVE COMMENTS ARE UNNECESSARY.  THE 
*              ACCESSING OF A *COMADEF* STRUCTURE IS SO STYLIZED THAT 
*              ONE CAN PRETTY MUCH RECOGNIZE IT ANYWHERE, BY ANYONE,
*              AND IN AN INFINITY OF CIRCUMSTANCES. 
* 
*           3. SYMBOLS THAT ONE WISHES TO ASSOCIATE VIA A COMMON PREFIX.
*              THESE ARE SYMBOLS THAT THE PROGRAMMER FEELS HAVE AN
*              INTERRELATIONSHIP WITHIN THE CONTEXT OF A SPECIFIC 
*              PIECE OF CODE.  FOR EXAMPLE, ALL SYMBOL TYPES (DECK NAME,
*              *SET* NAME, ETC) ARE DEFINED VIA SYMBOLS THAT HAVE THE 
*              THE COMMON PREFIX *SY.*, E.G. *SY.DECK*, *SY.SET*, ETC.
* 
*              CERTAIN GROUPS OF DATA CELLS ARE ALSO ASSOCIATED VIA 
*              A COMMON PREFIX: E.G. ALL THE CELLS THAT CONTAIN 
*              INFORMATION THAT *IDP* HAS GATHERED ABOUT THE TOKEN
*              BUFFER HAVE THE COMMON PREFIX *TB=*. 
* 
*           4. SYMBOLS WITHIN MACRO DEFINITIONS.  THE CONVENTION
*              USED FOR NAMING SYMBOLS WITHIN A MACRO DEFINITION IS 
*              AS FOLLOWS.  SYMBOLS ARE OF THE FORM --
* 
*                '?PPTXXX 
* 
*              WHERE '?  = COMMON *MACRO SYMBOL* PREFIX.
*                    PP  = A COMMON PREFIX FOR SYMBOLS WITHIN THIS
*                          MACRO DEFINITION, OR WITHIN A GROUP OF 
*                          RELATED MACRO DEFINITIONS. 
*                    T   = SYMBOL TYPE.  SEE BELOW. 
*                    XXX = UNIQUE NAME FOR THIS SYMBOL. 
* 
*              SYMBOL TYPES, *T*, ARE USED TO SIMPLIFY THE READING
*              OF MACRO CODE A LITTLE BIT.  EACH SYMBOL TYPE DENOTES
*              HOW THE SYMBOL WILL BE USED WITHIN THE MACRO.
* 
*              SYMBOL TYPES ARE --
* 
*                S = *SET* SYMBOL, I.E. ANY SYMBOL THAT IS ASSIGNED AN
*                    ABSOLUTE VALUE.  E.G. '?PPSXXX SET 1 
* 
*                C = *MICRO* NAME.  E.G. '?PPCXXX MICRO 1,,/HARPIES/
* 
*                R = *RMT* BLOCK NAME.  E.G. '?PPRXXX RMT 
* 
*                M = *MACRO* NAME.  I.E. USED FOR INTERNAL MACROS WHICH 
*                    THE PROGRAMMER WISHES TO BE **INVISIBLE** TO THE 
*                    REST OF THE WORLD. 
* 
*           5. NONE OF THE ABOVE.  THERE WILL ALWAYS BE EXCEPTIONS... 
*              SOME OF THESE ARE BECAUSE THERE IS NO CONVENTION, SOME 
*              ARE BECAUSE THE CONVENTION DIDNT SEEM RIGHT FOR THIS 
*              PARTICULAR CASE, ETC, ETC, ETC...
* 
************************************************************************
* 
*         GLOSSARY
* 
*         THE FOLLOWING IS A GLOSSARY OF COMMON ABBREVIATIONS,
*         NOTATIONS, AND SYMBOL PREFIXES THAT ARE NOT IN PARTICULAR 
*         *IDP* DEPENDENT.
* 
*         A+C    ADDRESS AND CONTENTS.  USED PRIMARILY IN CONJUNCTION 
*                WITH A LOAD INSTRUCTION WHERE BOTH THE ADDRESS AND 
*                THE CONTENTS OF THE ADDRESS ARE MEANINGFUL, AS IN -- 
* 
*                    SA1   A1+B1   (A1,X1) = A+C OF NEXT TABLE ENTRY
* 
*                AS OPPOSED TO -- 
* 
*                    SA1   LN=TYPE (X1) = LINE TYPE 
* 
*         ADDR   ADDRESS. 
* 
*         FWA    FIRST WORD ADDRESS.
* 
*         F.XXX  FWA OF A LOGICAL FILE *FET*. 
* 
*         FW=XXX A CELL THAT CONTAINS A FWA.
* 
*         FW.XXX A SYMBOL WHOSE VALUE SPECIFIES A FWA.
* 
*         L=XXX  A CELL THAT CONTAINS A LENGTH (NOT A MANAGED TABLE 
*                *LENGTH*, HOWEVER).
* 
*         L.XXX  A SYMBOL WHOSE VALUE SPECIFIES A LENGTH IN WORDS.
* 
*         L1.XXX A SYMBOL WHOSE VALUE SPECIFIES THE LENGTH (IN WORDS) 
*                OF A SINGLE TABLE ENTRY.  FOR EXAMPLE -- 
* 
*                    SA1   FW.TBL    (A1,X1) = A+C OF 1ST *TBL* ENTRY 
*                    SA2   A1+L1.TBL (A2,X2) = A+C OF 2ND *TBL* ENTRY 
* 
************************************************************************
 IDP      TITLE  IDP "IDPVER"/DATA STRUCTURES.
 ADR=RJ   SPACE  4,10 
**        ADR=RJ - ADDRESS OF CALLING RJ. 
* 
* 
*         *ADR=RJ* CONTAINS THE ADDRESS OF THE *RJ* INSTRUCTION THAT
*         LAST INVOKED ONE OF THE EXECUTIVES (IDP=,REG=,SNP=) IN
*         *COMCIDP*.  IT IS SET UP BY *IEX* (INITIALIZE EXECUTIVE), 
*         AND IS USED WHENEVER SOMEONE WISHES TO KNOW THE ADDR OF 
*         AN IDP CALLER.  E.G. *HDR* (OUTPUT HEADER) USES (ADR=RJ)
*         IN OUTPUTING THE *CALLED BY*-TYPE HEADERS.
  
  
 ADR=RJ   BSSZ   1
 APL      SPACE  4,10 
**        APL - IDP APLIST. 
* 
* 
*         *APL* IS AN AREA USED FOR 2 PURPOSES -- 
* 
*           1. WHEN IDP IS INVOKED VIA AN INTERACTIVE BREAK (I.E. NOT 
*              AN ASSEMBLED BREAK), THEN *BRK* (BREAKPOINT PROCESSOR) 
*              EXPANDS ITS INTERNAL BREAKPOINT INFORMATION FROM *IDPBA* 
*              (BREAKPOINT ADDRESS TABLE) AND *IDPBC* (BREAKPOINT 
*              CONTENTS TABLE) INTO *APL* ET SEQ SO THAT THIS 
*              INFORMATION **LOOKS** JUST LIKE AN ASSEMBLED BREAKPOINT
*              PARAMETER LIST.
* 
*           2. AND BECAUSE THIS *BREAKPOINT INFORMATION* IS NOT NEEDED
*              FOR VERY LONG, IDP REUSES THIS AREA FOR SCRATCH CELLS. 
  
  
 L.APL    =      SN=LEN+1 
 APL      BSSZ   L.APL
  
          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 
 BC=BRAD  SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        BC=BRAD - PREVIOUS CONTENTS OF BREAK ADDRESS. 
* 
* 
  
  
 BC=BRAD  BSSZ   1
 F.       SPACE  4,10 
***       F. - FILE FETS. 
* 
* 
*         SYMBOLS OF THE FORM *F.XXX*, WHERE *F.* IS A COMMON PREFIX, 
*         AND *XXX* IS A UNIQUE FILE, DEFINE THE FWA OF A FET USED
*         BY *IDP*. 
* 
*         FOLLOWING ARE ALL THE DEFINITIONS OF FETS USED BY *IDP*,
*         WITH THE **EXCEPTION** OF *F.FRZ*, THE *FREEZE* FILE
*         (SEE *IFR*, IDP FREEZE RESTART).
* 
****************************************************************
 F.BDO    SPACE  4,10 
**        F.BDO - FET AND BUFFER FOR BATCH DEBUG OUTPUT FILE. 
  
 #BDO     IF     -DEF,F.BDO 
 L.BDO    =      101B        LENGTH OF BATCH OUTPUT BUFFER
  
 F.BDO    BSS    0           ** FWA OF FET ** 
 BDO      FILEC  IDPBDO,L.BDO 
 IDPBDO   BSS    L.BDO
 #BDO     ENDIF 
 F.IDI    SPACE  4,10 
**        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) 
          DIS    1, **IDP** 
 FW.LIM   DIS    8,INTERACTIVE DEBUG LINE IMAGE AREA. 
 IDPIDI   BSS    L.IDI
  
 L=LIM    BSSZ   1           NR OF WORDS IN SOURCE LINE IMAGE AT
*                              (FW.LIM) ET SEQ (INCLUDES WORD CONTAINING
*                              EOL MARK)
 #IDI     ENDIF 
 F.BDI    SPACE  4,10 
 F.BDI    =      F.IDI
 F.IDO    SPACE  4,10 
**        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) 
 IDPIDO   BSS    L.IDO
 #IDO     ENDIF 
 .IDPOS   ENDIF 
 FW.SVR   SPACE  4,10 
**        FW.SVR - SAVED REGISTER AREA. 
* 
* 
*         THIS IS WHERE IDP SAVES THE USERS REGISTERS.
  
  
 FW.SVR   BSS    0           ** FWA **
 IDP=SVB  BSSZ   8           SAVED -B- REGISTERS
 IDP=SVA  BSSZ   8           SAVED -A- REGISTERS
 IDP=SVX  BSSZ   8           SAVED -X- REGISTERS
 FW=PARM  SPACE  4,10 
**        FW=PARM - FWA OF BREAK/SNAP/REG PARAMETER LIST. 
* 
* 
  
  
 FW=PARM  BSSZ   1           SAVE CELL FOR FWA OF PARAMETER LIST
 IDPERR   SPACE  4,10 
**        IDPERR - IDP ERROR CELL.
* 
* 
*         *IDPERR* IS SET BY *IDP=ER* WHEN AN ERROR IS DETECTED.
*         ITS VALUE DEPENDS ON THE IDP ASSEMBLY-TIME OPTION *OI.ERR* -- 
* 
*           1. IF *OI.ERR = 0*, THEN (IDPERR) ARE ALWAYS SET TO .ZR.
*              TO INDICATE THAT NO ERROR MSG IS AVAILABLE.
* 
*           2. IF *OI.ERR = 1*, THEN (IDPERR) ARE SET TO THE ERROR MSG
*              NR FOR THIS ERROR. 
* 
*           3. IF *OI.ERR = 2*, THEN (IDPERR) ARE SET TO THE FWA OF THE 
*              ERROR MSG ITSELF.
* 
*         SEE *OI.ERR* (IN *COMSIDP*) FOR MORE INFORMATION. 
  
  
 IDPERR   BSSZ   1
 IDPFLG   SPACE  4,10 
**        IDPFLG - INTERACTIVE/BATCH MASTER CONTROL FLAG. 
* 
*                CONTAINS GLOBAL CONTROL INFORMATION THAT IS USED 
*         THROUGH OUT *COMCIDP*.  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 
* 
*         BRF  = 1  IF IN *BRIEF* MODE (I.E. DO NOT ISSUE INTERACTIVE 
*                     PROMPT), 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)
* 
*         MEM  = 0  IF ALL MEMORY REFERENCES ARE TO BE CHECKED
*                   IN THE *NORMAL* WAY, ELSE 
* 
*              = 1  IF ALL MEMORY REFERENCES ARE TO BE CHECKED
*                   VIA A SYSTEM *MEM/MEMORY* CALL.  THIS OPTION
*                   IS INTENDED FOR THOSE TIMES WHEN IDP IS MODING
*                   OUT BECAUSE THE HOST MEMORY MANAGEMENT IS 
*                   SCREWING UP (I.E. TELLING IDP THAT OUT-OF-RANGE ADDRS 
*                   ARE OK), PUTTING THE USER UP SHIT CREEK SO TO SPEAK.
* 
*                   WHEN *MEM* IS SET, IDP WILL IGNORE ALL HOST MEMORY
*                   MANAGEMENT SCHEMES, RELYING SOLEY UPON THE OPERATING
*                   SYSTEM FOR FL INFORMATION.
* 
*         RAP  = 1  IF A CIO READ WAS ALREADY PERFORMED 
*              = 0  IF A CIO READ NEEDS TO BE PERFORMED 
* 
*         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=*
* 
*         XJR  = 1  IF *COMCXJR* IS TO BE USED FOR RESTORING REGISTERS, 
*                   ELSE
*              = 0  IF *COMCRSR* IS TO BE USED FOR RESTORING REGISTERS. 
* 
*                   SEE *OPTION,XJR* COMMAND IN IDP EXTERNAL REFERENCE
*                   MANUAL FOR EXAMPLE OF USE.
  
  
 IDPFLG   BSSZ   1
 MX=      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        MX= - MASKS.
* 
* 
  
  
 '?IDCS01 CHMIC  (B,A,X)
 MX=BAX   LIT    "'?IDCS01" 
  
 '?IDCS01 CHMIC  (0,1,2,3,4,5,6,7)
 MX=0..7  LIT    "'?IDCS01" 
 MX=PREUN SPACE  4,10 
**        MX=PREUN - PRE-UNARY TOKEN TYPE SHIFT MASK. 
* 
* 
*         *MX=PREUN* IS A SHIFT MASK USED BY *PAS* (PARSE SUBEXPRESSION)
*         FOR DETERMINING WHETHER AN OPERATOR IS UNARY OR NOT.
* 
*         FOR EXAMPLE --
* 
*                SNAP -A     IS UNARY 
*                SNAP A-B    IS BINARY
  
  
 '?IDCS01 CHMIC  (O.VAR,O.CONS,O.REG,O.RP)
 MX=PREUN LIT    -"'?IDCS01"
 MX=TET   SPACE  4,10 
**        MX=TET - TERMINATING TOKEN TYPE SHIFT MASK. 
* 
* 
*         *MX=TET* CONTAINS A SHIFT MASK THAT IS USED BY *PAS* (PARSE 
*         SUBEXPRESSION) TO DETERMINE WHAT TOKEN TYPES (*TOT*) ARE TO 
*         TERMINATE THE PARSE.
* 
*         FOR MOST STMTS, THEY ARE THE *EOS* (END-OF-STMT) AND *COM*
*         (COMMA) TOKENS, BUT BECAUSE THIS MAY CHANGE SOME DAY (FUNCTION
*         REFERENCES, FOR EXAMPLE), *PAS* USES THIS SHIFT MASK. 
* 
*         NOTE THAT *PAS* INTERNALLY USES (PAS=TET) FOR ITS TERMINATING 
*         *TOT* SHIFT MASK, BUT **GUARANTEES** THAT, UPON EXIT, 
*         (PAS=TET) IS SET TO (MX=TET).  THIS RELATIONSHIP CAN BE 
*         THOUGHT OF AS A MASTER/SLAVE, AND ALLOWS A CALLER TO ALTER
*         THE WAY *PAS* PARSES, BUT DOES NOT REQUIRE THAT ALL THE 
*         RUN-OF-THE-MILL CALLERS SET UP (PAS=TET). 
* 
*         NOTE HOW THE MICRO *'?IDCTET* IS USED TO INITIALLY SET UP 
*         **BOTH** (MX=TET) AND (PAS=TET).
* 
*         I CONSIDER IT A SAFE PRACTICE TO PLACE *BITMIC* PARAMETERS
*         IN **ASCENDING** ORDER...THIS AVOIDS A PROBLEM THAT CAN OCCUR 
*         BECAUSE COMPASS SOMETIMES DOESN'T HONOR MIXED UP *POS*ING 
*         (IT APPARENTLY HAS SOMETHING TO DO WITH WHEN COMPASS ACTUALLY 
*         FORCES OUT BINARY WHEN ASSEMBLING PARTIAL WORDS). 
  
  
 '?IDCTET CHMIC  (O.EOS,O.COM)
  
 MX=TET   CON    "'?IDCTET" 
 POT      SPACE  4,10 
**        POT - PARSING OPERATOR/OPERAND TABLE. 
* 
* 
*         *POT* IS THE PARSERS OPERATOR/OPERAND TABLE WHICH DETERMINES
*         HOW/WHEN/WHERE OPERATORS AND OPERANDS ARE PARSED. 
* 
*         FIELDS WITHIN *POT* ARE DEFINED VIA SYMBOLS OF THE FORM --
* 
*                PS.XXXP  AND  PS.XXXL
* 
*         WHERE *PS.* IS A COMMON PREFIX, *XXX* IS A UNIQUE FIELD NAME, 
*         AND *L/P* ARE THE *COMADEF* LENGTH AND RIGHT-MOST BIT POSITION
*         INDICATORS (SEE *COMADEF* FOR MORE INFO). 
* 
*         FIELDS, *XXX*, ARE -- 
* 
*           PIP  = POLISH IN PROCESSOR ADDR.  *PIP* CONTAINS THE
*                  ADDR OF THE POLISH IN PROCESSOR FOR THIS OPERATOR/ 
*                  OPERAND. 
* 
*                  THIS FIELD HAS SIGNIFICANCE WHEN A PARTICULAR *RPN*
*                  HAS BEEN CONSTRUCTED **FOR** AN OPERATOR OR OPERAND
*                  **FROM** ITS CORRESPONDING *POT* ENTRY.  SEE BELOW.
* 
*           POP  = POLISH OUT PROCESSOR ADDR.  *POP* CONTAINS THE 
*                  ADDR OF THE POLISH OUT PROCESSOR FOR THIS OPERATOR/
*                  OPERAND. 
* 
*                  *POP* IS USED IN THE **CREATION** OF AN *RPN* ENTRY. 
* 
*           PRI  = PARSING PRIORITY FOR THIS OPERATOR (IGNORED FOR
*                  OPERANDS AND UNARY OPERATORS). 
* 
*                  *PRI* HELPS DETERMINE THE ORDER IN WHICH OPERATORS 
*                  GET POPPED OFF THE PARSING STACK (*PAST*), AND 
*                  THEREFORE, THE ORDER IN WHICH THINGS COME OUT ON 
*                  *RPN*. 
* 
*           UPIP = UNARY OPERATOR POLISH IN PROCESSOR ADDRESS.  *UPIP*
*                  IS USED WHEN AN OPERATOR HAS BOTH A BINARY **AND** 
*                  A UNARY FORM, AS DOES MINUS  --
* 
*                       SNAP A-B
*                       SNAP -A 
* 
*         SEE ALSO *RPN* (REVERSE POLISH NOTATION TABLE) AND *PAS*
*         (PARSE SUBEXPRESSION).
* 
*         NOTE THAT BECAUSE *PAS* USES TOKEN TYPES (*O.* SYMBOLS) 
*         AS ORDINALS INTO *POT*, THAT THIS IMPLIES THAT *POT* ENTRIES
*         MUST BE IN THE SAME ORDER AS THE TOKEN TYPES.  THAT IS, 
*         THERE IS A ONE-TO-ONE CORRESPONDENCE BETWEEN *O.* TOKEN 
*         TYPES AND *POT*.  SEE ALSO *DEFTOT* (DEFINE TOKEN TYPE) 
*         MACRO IN *COMSIDP* (IDP INTERFACE TEXT).
  
  
 '?IDSTOT SET    O.VAR-1
  
 FW.POT   BSS    0           ** FWA **
 VAR      PASOP  POP=PAS24,PIP=PAS34
 CONS     PASOP  POP=PAS26,PIP=PAS34
 REG      PASOP  POP=PAS28,PIP=PAS34
  
 PLUS     PASOP  POP=PAS20,PIP=PAS36,UPIP=PAS38,PRI=40B 
 MIN      PASOP  POP=PAS20,PIP=PAS40,UPIP=PAS42,PRI=40B 
 STAR     PASOP  POP=PAS20,PIP=PAS44,UPIP=PAS46,PRI=42B 
 LP       PASOP  POP=PAS16
 RP       PASOP  POP=PAS18
 SHFT     PASOP  POP=PAS20,PIP=PAS48,PRI=40B
 AND      PASOP  POP=PAS20,PIP=PAS52,PRI=40B
 OR       PASOP  POP=PAS20,PIP=PAS50,PRI=40B
 XOR      PASOP  POP=PAS20,PIP=PAS54,PRI=40B
 NOT      PASOP  POP=PAS20,UPIP=PAS42,PRI=77B 
  
  
 L.POT    =      *-FW.POT 
 PAST     SPACE  4,10 
**        PAST - PARSING STACK. 
* 
* 
*         *PAST* IS THE STACK USED BY THE PARSER *PAS* (PARSE 
*         SUBEXPRESSION) DURING THE GENERATION AND EVALUATION 
*         OF THE *RPN* (REVERSE POLISH NOTATION) TABLE. 
* 
*         DURING GENERATION OF *RPN* (I.E. POLISH OUT), *PAS* 
*         PUSHS AND POPS OPERATORS ON AND OFF *PAST* IN ORDER TO GET
*         THEM TO COME OUT IN THEIR PROPER ORDER ONTO *RPN*.
* 
*         DURING THE EVALUATION OF *RPN* (I.E. POLISH IN), *PAS*
*         PUSHS AND POPS OPERANDS ON AND OFF *PAST* IN ORDER TO GET 
*         THEM EVALUATED PROPERLY.  DURING THIS PHASE, THE FINAL
*         ANSWER/EVALUATION IS THE ONLY THING LEFT ON *PAST* WHEN 
*         WE ARE DONE (ASSUMING NO ERRORS, OF COURSE).
* 
*         SEE *PAS* AND *RPN* 
  
  
 L.PAST   =      30 
          BSSZ   1
 FW.PAST  BSSZ   L.PAST 
 RPN      SPACE  4,10 
**        RPN - REVERSE POLISH NOTATION TABLE.
* 
* 
*         *RPN* CONTAINS THE REVERSE POLISH NOTATION FORM OF EACH 
*         SUBEXPRESSION DURING PARSING BY *PAS* (PARSE SUBEXPRESSION).
* 
*         *RPN* IS GENERATED BY THE POLISH OUT PROCESSORS OF *PAS*, 
*         AND IS READ BY THE POLISH IN PROCESSORS OF *PAS*.  IT IS, 
*         THEREFORE, AN INTERNAL FORM OF COMMUNICATION WITHIN THE 
*         PARSER. 
* 
*         INDIVIDUAL *RPN* ENTRIES ARE CONSTRUCTED FROM *POT* (PARSING
*         OPERATOR/OPERAND TABLE) AND *TB* (TOKEN BUFFER) BY THE
*         POLISH OUT PROCESSORS.
* 
*         *RPN* ENTRIES TAKE 2 GENERAL FORMS: OPERATOR ENTRIES, AND 
*         OPERAND ENTRIES.  BOTH FORMS ARE SIMILAR IN THAT THEY 
*         CONTAIN *POLISH IN* INFORMATION (FOR EXAMPLE, THE POLISH
*         IN PROCESSOR ADDR FOR A PARTICULAR TOKEN/*RPN* ENTRY).
* 
*         THE PRIMARY DIFFERENCE BETWEEN THESE 2 FORMS IS THAT OPERAND
*         ENTRIES ALSO CONTAIN THE BINARY VALUE THAT *PAS*S POLISH OUT
*         PROCESSORS WERE ABLE TO ASSOCIATE/EVALUATE WITH THIS OPERAND. 
* 
*         WHILE OPERATOR ENTRIES ARE 1 WORD IN LENGTH EACH, OPERAND 
*         ENTRIES ARE 2 WORDS EACH: THE EXTRA WORD CONTAINING THE 
*         BINARY VALUE OF THE OPERAND.
* 
*         SEE ALSO *PAS*, *POT*.
* 
*         REVERSE POLISH NOTATION EXAMPLES -- 
* 
*                A + B          A B + 
*                -A             A - 
*                *(A+B)         A B + * 
*                *(A$B)+C       A B $ * C + 
  
  
 L.RPN    =      L.PAST+L.PAST/2
 FW.RPN   BSSZ   L.RPN
 .IDPOS   ENDIF 
 SNAPLNE  SPACE  4,10 
**        SNAPLNE - OUTPUT LINE IMAGE AREA. 
* 
* 
  
  
 SNAPLNE  BSSZ   15          INTERACTIVE AND BATCH DEBUG OUTPUT LINE
*                              IMAGE AREA 
 TB=FLL   SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        TB=FLL - CURRENT *FWA,LWA,LEN* KEYWORD POINTER. 
* 
* 
*         *TB=FLL* CONTAINS THE ADDR OF THE MOST RECENT *KEYW*
*         ENTRY FOR A *PTR* DRIVEN KEYWORD.  THAT IS, A KEYWORD 
*         WHICH HAS THE *PTR* FIELD IN ITS *KEYW* ENTRY .NZ.
* 
*         (TB=FLL) ARE USED BY THE *UP* AND *DOWN* PROCESSORS 
*         FOR DETERMINING WHICH *KEYW* POINTER (AT *FW.PTR* ET SEQ) 
*         THE INTERACTIVE USER WISHES TO MOVE *UP* OR *DOWN*. 
  
  
 TB=FLL   BSSZ   1
 TB=KEY   SPACE  4,10 
**        TB=KEY - CURRENT KEYWORD POINTER. 
* 
* 
*         *TB=KEY* CONTAINS THE ADDRESS OF THE MOST RECENT *KEYW* 
*         ENTRY FOUND BY *CST* (CLASSIFY STMT).  IT IS USED 
*         WHENEVER ANYONE WISHES TO GET TO ANY INFORMATION CONTAINED
*         IN THE *KEYW* ENTRY FOR THE CURRENT STMT. 
* 
*         FOR EXAMPLE, *IDP*S MAIN LOOP USES (TB=KEY) TO DETERMINE
*         WHICH STMT PROCESSOR TO TRANSFER CONTROL TO FOR A STMT
*         IN THE TOKEN BUFFER.  THAT IS, AFTER A *CST* CALL, (TB=KEY) 
*         POINTS TO THE *FOUND* KEYWORD ENTRY.
  
  
 TB=KEY   BSSZ   1
 TB=STMT  SPACE  4,10 
**        TB=STMT - CURRENT STMT POINTER. 
* 
* 
*         *TB=STMT* CONTAINS INFORMATION ABOUT THE CURRENT STMT 
*         IN THE TOKEN BUFFER, *IDPTB*.  *TB=STMT* IS USED IN 2 
*         DISTINCTLY DIFFERENT WAYS --
* 
*           1. DURING TOKEN GENERATION OF A SOURCE LINE BY *COMCTOK*, 
*              *TB=STMT* CONTAINS THE ADDR OF THE STMT INFORMATION
*              HEADER WORD FOR THE STMT BEING ENTOKENED.
* 
*              WHEN *TOK* ENCOUNTERS AN END-OF-STMT CONDITION (I.E. 
*              EITHER END-OF-LINE OR * *), THEN *TOK=EOS* (END-OF-
*              STMT PROCESSING FOR *COMCTOK*) USES (TB=STMT) TO FIND
*              THE STMT INFO HEADER WORD FOR THE STMT JUST ENTOKENED
*              SO THAT HE CAN GO BACK AND FILL IN THE LENGTH OF THIS
*              STMT.
* 
*           2. DURING THE STMT PROCESSING PHASE, *TB=STMT* CONTAINS 
*              THE ADDR OF THE CURRENT STMT BEING PROCESSED.  IN THIS 
*              WAY, IDP.S MAIN LOOP CAN ADVANCE TO EACH NEW STMT THAT 
*              OCCURS ON A SINGLE SOURCE LINE.
  
  
 TB=STMT  CON    IDPTB
 DATA     SPACE  4,10 
**        *IDP* DATA DECLARATIONS.
  
  
 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 
 IDPBTC   BSSZ   1           BREAK TYPE CODE
  
 IDPACC   BSSZ   1           ACCUMULATOR FOR THIS SUBEXPRESSION 
 IDPNUL   BSSZ   1           .ZR. IF JUST PARSED NULL EXPRESSION
*                                   E.G.   SNAP FWA,,LEN   (LWA IS NULL)
  
 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*
  
 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           .MI. 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 
 MSG      SPACE  4,10 
**        *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,10 
**        PATFLG - PARSE *FWA,LWA,LEN* TRIPLE FLAG. 
* 
* 
*         CONTAINS STATUS ABOUT THE *FWA,LWA,LEN* TRIPLE BEING
*         PARSED/PROCESSED BY ROUTINE *PAT*.  USED SO THAT *PAT*
*         CAN RESOLVE ANY POSSIBLE SYNTACTIC DIFFERENCES/PROBLEMS 
*         THAT MIGHT OCCUR BETWEEN THE *LWA* AND *LEN* PARAMETERS.
*         SEE SUBROUTINE *PAT*. 
* 
*         BIT FLAGS WITHIN *PATFLG* MUST EXIST IN BITS 0 THRU 16
*         (I.E. FIELD MANIPULATION IS DONE VIA *SX.I* TYPE INSTRUCTIONS)
*         AND ARE DESCRIBE/DEFINED IN THE USUAL MANNER VIA SYMBOLS
*         OF THE FORM --
* 
*                PAF.XXXP  AND  PAF.XXXL
* 
*         WHERE *PAF.* IS A COMMON PREFIX AND *XXX* IS A UNIQUE 
*         BIT FLAG (FIELD) NAME.
* 
*         BIT FLAGS *XXX* ARE --
* 
*         LWA  = 1 IF LWA WAS SPECIFIED EXPLICITLY (I.E. NON-NULL), 
*                  ELSE 0.
*         LEN  = 1 IF LEN WAS SPECIFIED EXPLICITLY (I.E. NON-NULL), 
*                  ELSE 0.
  
  
 PATFLG   BSSZ   1
 PTR      SPACE  4,10 
**        PTR - POINTER AREA. 
* 
* 
  
  
 N.PTR    =      10          NR OF *PTR* ENTRIES
  
 FW.PTR   BSS    0
 '?ID#001 DUP    N.PTR
          DUP    L1.PTR,1 
          VFD    PT.FWAL/0,PT.LENL/1
 '?ID#001 ENDD
  
  
 L.PTR    =      *-FW.PTR 
 TC=      SPACE  4,10 
**        TC= - *TOKCOM*, THE *USER/TOK* COMMUNICATIONS AREA. 
* 
* 
*         SYMBOLS WITH THE COMMON PREFIX *TC=* CONTAIN INFORMATION
*         THAT IS TO BE PASSED BETWEEN IDP AND *COMCTOK* (THE COMMON
*         TOKEN GENERATOR). 
* 
*         LOCATIONS WITHIN *TOKCOM* ARE DEFINED VIA ORDINALS.  THESE
*         ORDINALS ARE DEFINED VIA SYMBOLS OF THE FORM -- 
* 
*                TC.XXX 
* 
*         WHERE *TC.* IS A COMMON PREFIX, AND *XXX* IS A *TOKCOM* 
*         LOCATION ORDINAL NAME (*TC.XXX* SYMBOLS ARE DEFINED 
*         IN *COMSTOK*, THE COMMON TOKEN GENERATOR INTERFACE TEXT). 
* 
*         TO AVOID BUGS, MISUNDERSTANDINGS, AND GENERAL CONFUSION,
*         **ALL** LOCATIONS WITHIN *TOKCOM* SHOULD BE DEFINED/REFERENCED
*         VIA *TC.XXX* SYMBOLS. 
  
  
 FW.TCOM  BSSZ   L.TCOM 
  
          LOC    FW.TCOM
 TC=P     =      *+TC.P 
 TC=SOA   =      *+TC.SOA 
 TC=SOX   =      *+TC.SOX 
 TC=SOL   =      *+TC.SOL 
 TC=SOB   =      *+TC.SOB 
 TC=SOC   =      *+TC.SOC 
 TC=TBA   =      *+TC.TBA 
 TC=TBB   =      *+TC.TBB 
 TC=RSF   =      *+TC.RSF 
 TC=BOL   =      *+TC.BOL 
 TC=EOL   =      *+TC.EOL 
 TC=REST  =      *+TC.REST
          LOC    *O 
 IDPTB    SPACE  4,10 
**        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     =      100         LENGTH OF TOKEN BUFFER 
 IDPTB    BSSZ   L.TB 
 SCT      SPACE  4,10 
**        SCT - STATEMENT CONTROL TOKEN TABLE.
* 
* 
*         THE FOLLOWING IS THE TABLE CONTAINING ALL THE *STMT 
*         CONTROL* TOKENS AND THEIR RESPECTIVE PROCESSOR ADDRESSES
*         FOR ALL THE SPECIAL *STMT CONTROL* TOKENS THAT CAN
*         PRECEDE AN IDP STMT KEYWORD.
  
  
 FW.SCT   BSS    0           ** FWA **
 PER      SCTOT  SC=BRF      .
 QQQ      SCTOT  SC=QQQ      ?
          DATA   0           ** END OF TABLE ** 
 KEY      SPACE  4,10 
**        *IDP* KEYWORD TABLE.
* 
* 
  
  
 FW=KEY   CON    FW.KEY 
 FW.KEY   SPACE  4,10 
 FW.KEY   BSS    0           ** FWA OF KEYW TABLE **
 ABS      KEYW   ABS
 COD      KEYW   (CODE FWA,LWA,LEN) 
 CON      KEYW   CONNECT
 DPC      KEYW   (DPC FWA,LWA,LEN)
 DSC      KEYW   DISCONT
 END      KEYW   END
 FRZ      KEYW   FREEZE 
 JP       KEYW   (JUMP ADDR)
 OPT      KEYW   (OPTION P1,...,PN) 
 OUT      KEYW   (OUTPUT I,B,IE,BE) 
 REG      KEYW   (REGS R1,...,R.N)
 REL      KEYW   REL
 SET      KEYW   (SET NAME,VALUE) 
 SNP      KEYW   (SNAP FWA,LWA,LEN) 
 STO      KEYW   (STORE ADDR,C1,C2,C3,C4) 
 STA      KEYW   STATUS 
 TIM      KEYW   TIME 
 UBK      KEYW   (UNBREAK BRAD1,...,BRAD.N) 
 UST      KEYW   (UNSET NAME1,...,NAME.N) 
 UBK      KEYW   (UB BRAD1,...,BRAD.N)
 UST      KEYW   (US NAME1,...,NAME.N)
 WHR      KEYW   (WHERE ADDR1,...,ADDR.N) 
 XEQ      KEYW   XEQ
 XFR      KEYW   (XFER NR)
  
*         *BREAK* KEYWORDS. 
* 
*         NOTE THAT THE *BREAK* TYPE CODE (BTC) IS PLACED IN THE *XAT*
*         FIELD IN WORD 1 OF EACH *BREAK* KEYWORD.
* 
*         *BTC* VALUES HAVE THE FOLLOWING SIGNIFICANCE -- 
* 
*                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. 
  
 BRK      KEYW   (BREAK BRAD,LL,UL,INC),0 
 BRK      KEYW   (BRPL BRAD,A1,LL,UL,INC),BTC.PL
 BRK      KEYW   (BRMI BRAD,A1,LL,UL,INC),BTC.MI
 BRK      KEYW   (BRZR BRAD,A1,LL,UL,INC),BTC.ZR
 BRK      KEYW   (BRNZ BRAD,A1,LL,UL,INC),BTC.NZ
 BRK      KEYW   (BREQ BRAD,A1,A2,LL,UL,INC),BTC.EQ 
 BRK      KEYW   (BRNE BRAD,A1,A2,LL,UL,INC),BTC.NE 
 BRK      KEYW   (BRLT BRAD,A1,A2,LL,UL,INC),BTC.LT 
 BRK      KEYW   (BRGE BRAD,A1,A2,LL,UL,INC),BTC.GE 
 BRK      KEYW   (BRLE BRAD,A1,A2,LL,UL,INC),BTC.LE 
 BRK      KEYW   (BRGT BRAD,A1,A2,LL,UL,INC),BTC.GT 
  
*         *STEP* KEYWORDS.
* 
*         NOTE THAT THE *STEP* TYPE CODE (XTC) IS PLACED IN THE *XAT* 
*         FIELD OF EACH *STEP* KEYWORD. 
* 
*         *STEP* TYPE CODES (XTC) HAVE THE FOLLOWING SIGNIFICANCE --
* 
*                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) 
  
 STP      KEYW   (STEP L,RJ),0
 STP      KEYW   (STPL A1,L,RJ),XTC.PL
 STP      KEYW   (STMI A1,L,RJ),XTC.MI
 STP      KEYW   (STZR A1,L,RJ),XTC.ZR
 STP      KEYW   (STNZ A1,L,RJ),XTC.NZ
 STP      KEYW   (STEQ A1,A2,L,RJ),XTC.EQ 
 STP      KEYW   (STNE A1,A2,L,RJ),XTC.NE 
 STP      KEYW   (STLT A1,A2,L,RJ),XTC.LT 
 STP      KEYW   (STGE A1,A2,L,RJ),XTC.GE 
 STP      KEYW   (STLE A1,A2,L,RJ),XTC.LE 
 STP      KEYW   (STGT A1,A2,L,RJ),XTC.GT 
 STP      KEYW   (STRANGE A1,A2,L,RJ),XTC.RNG 
 XNR      KEYW   (STNR NR,L,RJ),XTC.NR
 STP      KEYW   (STAR A1,A2,L,RJ),XTC.AR 
          DATA   0           END OF TABLE MARK
  
  
 FW=UKT   DATA   0           ** LINK WORD **
 IDPKSTO  SPACE  4,10 
**        *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
          SUBKEY L,1
          SUBKEY RJ,1 
          DATA   0           END OF TABLE MARK
 KEY      SPACE  4,10 
**        *OUTPUT* OPTIONS KEYWORD TABLE. 
  
 IDPKOUT  BSS    0
          SUBKEY B,ST=OUT3
          SUBKEY BECHO,ST=OUT4
          SUBKEY I,ST=OUT2
          SUBKEY IECHO,ST=OUT5
          DATA   0           END OF TABLE MARK
 FW.KOPT  SPACE  4,10 
**        FW.KOPT - *OPTION* SUBKEYWORD TABLE.
* 
* 
  
  
 FW.KOPT  BSS    0           ** FWA **
          SUBKEY MEM,ST=OPT2
          SUBKEY XJR,ST=OPT3
          DATA   0           ** EOT **
 ERROR    SPACE  10,20
***       IDP ERROR MESSAGES. 
* 
* 
  
  
 FW.ERR   BSS    0           ** FWA **
 E.ADDR   ERROR  (ADDR OUT-OF-RANGE)
 E.SC     ERROR  (STMT KEYWORD PRECEDED BY UNKNOWN CHARACTER) 
 E.KEY    ERROR  (UNKNOWN KEYWORD)
 E.BRAD   ERROR  (*BREAK* ADDR IS OUT-OF-RANGE) 
 E.BRA1   ERROR  (*ADDR1* IS OUT-OF-RANGE)
 E.BRA2   ERROR  (*ADDR2* IS OUT-OF-RANGE)
 E.FLL    ERROR  (FWA, LWA, OR LEN OUT-OF-RANGE)
 E.LFN    ERROR  (YOU MUST SPECIFY AN LFN)
 E.JP     ERROR  (*JUMP* ADDR OUT-OF-RANGE) 
 E.REG    ERROR  (YOU SPECIFIED A NON-REGISTER NAME)
 E.SET    ERROR  (YOU MUST SPECIFY A *SET* NAME)
 E.STO    ERROR  (*STORE* ADDR IS MISSING OR OUT-OF-RANGE)
 E.POP    ERROR  (PARSER ENCOUNTERED ILLEGAL TOKEN/OPERATOR/OPERAND)
 E.VAR    ERROR  (YOU SPECIFIED AN UNKNOWN/UNDEFINED SYMBOL NAME) 
 E.CON    ERROR  (ERROR DURING CONSTANT CONVERSION) 
 E.IND    ERROR  (INDIRECT ADDR OUT-OF-RANGE) 
 E.OPT    ERROR  (YOU JUST SPECIFIED AN UNKNOWN OPTION) 
 E.PAST   ERROR  (PARSER COULD NOT BALANCE OPERATORS AND OPERANDS)
 E.STB    ERROR  (STMT TOO BIG FOR PARSER.  PLEASE SIMPLIFY)
 E.SYTL   ERROR  (SYMBOL NAME TOO LONG) 
 E.UNOP   ERROR  (YOU JUST TRIED TO USE A BINARY OPERATOR AS A UNARY) 
  
 L.ERR    =      *-FW.ERR 
 SYSER    SPACE  4,10 
***       IDP *SYSTEM* ERRORS.
* 
* 
*         THE FOLLOWING ARE THE UNSUPPRESSABLE *SYSTEM* TYPE
*         ERRORS THAT IDP OUTPUTS WHEN IT DETECTS AN INTERNAL 
*         ERROR.
  
  
 FW.SER   BSS    0           ** FWA **
 SE.KEY   SYSERR (ONE OF IDP'S KEYWORD TABLES IS OUT-OF-RANGE)
 SE.CON   SYSERR (PPU PGM *CON* DETECTED AN ERROR W/ CONNECT OR DISCONT)
 SE.FLL   SYSERR (SOMEONE SCREWED UP YOUR FWA, LWA, LEN.  WILD STORE?)
 SE.TOV   SYSERR (TABLE OVERFLOW.  GIVE UP AN ENTRY, TRY AGAIN) 
 SE.PAD   SYSERR (ADDR OF PROCESSOR FOR THIS KEYWORD IS OUT-OF-RANGE) 
 SE.PTR   SYSERR (NO POINTER DEFINED FOR THIS KEYWORD)
 SE.BPTR  SYSERR (BAD POINTER REF.  CHECK ENTRY REGS TO *PTR*)
 SE.TOK   SYSERR (ERROR DURING TOKEN GENERATION.  ENTIRE LINE TRASHED)
 SE.UFT   SYSERR (*UFT=* ENTRY IS OUT-OF-RANGE) 
 SE.UNPL  SYSERR (*FRA/FAA* ERROR WITH UNARY PLUS)
 SE.BRK   SYSERR (NO BREAK TABLE ENTRY FOR THIS BREAK.  YOUR MOVE...) 
 SE.NPP   SYSERR (NO PIP PROCESSOR) 
 SE.RPN   SYSERR (RPN TABLE OVERFLOW) 
 SE.CONS  SYSERR (ERROR DURING CONSTANT CONVERSION) 
 L.SER    =      *-FW.SER 
 IDPBA    SPACE  4,10 
**        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,10 
**        IDP USER *TEMP* TABLE.
  
 L.TMP    =      10D
 IDPTMP   BSSZ   L.TMP
 IDPSET   SPACE  4,10 
**        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,10 
**        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,10 
***       IFR - IDP FREEZE RESTART. 
* 
* 
  
 FW.IFR   BSS    0           MARK FWA OF *FREEZE* RESTART AREA
  
          QUAL   IFR
 IFR      SPACE  4,10 
**        IFR - IDP FREEZE RECOVERY/RESTART.
* 
* 
*         THIS ROUTINE IS USED TO RESTART (I.E. SWAPIN) AN
*         IDP HOST PROGRAM THAT WAS FROZEN VIA *FREEZE* 
*         COMMAND.  THE PROGRAM TO RESTART WAS WRITTEN BY *FRZ* 
*         TO LFN *F.FRZ* IN A SPECIAL FORMAT -- 
* 
*           RECORD 1  CONTAINS *IFR* (THE CODE YOU ARE LOOKING AT)
*                     IN THE FORMAT OF AN ABSOLUTE BINARY.
* 
*           RECORD 2  CONTAINS THE CORE IMAGE OF THE FROZEN PROGRAM.
* 
*         BECAUSE RECORD 1 OF *F.FRZ* LOOKS LIKE AN ABS BINARY, THE 
*         PROGRAMMER NEED ONLY ENTER THE NAME OF THE FREEZE FILE AT 
*         HIS OR HER TERMINAL IN ORDER TO RESTART THE HOST. 
* 
*         AFTER *IFR* HAS BEEN LOADED, IT WILL MAKE AN OPERATING SYSTEM 
*         REQUEST FOR THE AMOUNT OF CM THAT THE HOST HAD AT THE TIME IT 
*         WAS FROZEN PLUS ENOUGH FOR *IFR* TO PERFORM THE FOLLOWING 
*         TASKS.  AFTER *IFR* HAS CREATED A HOLE FOR THE HOST 
*         BY *MEM*ING, IT WILL *PLUG* SOME CODE UP ABOVE THE HOLE,
*         WHICH WILL READ IN THE 2ND RECORD OF *F.FRZ*. 
* 
*         WE ALL HAVE CHET RICHARDS OF SVLOPS TO THANK FOR THIS 
*         DIABOLICALLY CLEVER IDEA.  HI HO SILVER, AND AWAY...
* 
*         IMPORTANT NOTE--  IT IS IMPORTANT TO REALIZE THAT 
*         THIS CODE, AS IT EXISTS IN /COMCIDP/, IS A DATA SECTION,
*         I.E. IT CANNOT BE EXECUTED.  IT IS HERE ONLY SO THAT *FRZ*
*         CAN WRITE IT OUT AS THE 1ST RECORD ON *F.FRZ*.
* 
*         ENTRY  NONE 
* 
*         EXIT   TO *RHH* IN HIGH CORE TO READ IN FROZEN HOST 
* 
*         USES   IRRELEVANT 
* 
*         CALLS  MEMORY 
  
  
          LOC    RA.ORG 
  
          VFD    12/5000B,12/0,18/RA.ORG,18/IFR 
  
 IFR      BSS    0           ** LOADER ENTRY POINT ** 
          SB1    1
  
*         REQUEST ENOUGH MEMORY FOR THE FROZEN HOST PLUS *RHH*. 
*         ALSO, IF *CMM* WAS ACTIVE IN FROZEN HOST, INDICATE SO TO
*         OPERATING SYSTEM. 
  
          SA2    MEM#HOST    (X2) = 30/AFLS OF FROZEN HOST,30/OTHER 
          SX6    L.RHH+L.IFRSZ+10B
          LX6    30 
          IX6    X2+X6       (X6) = 30/ENOUGH CORE FOR FROZEN HOST
*                                    AND *RHH*, 30/OTHER
          SA6    MEM#RHH
  
  
          SA1    IFRA        (X1) = *MEM* REQUEST WORD
          BX6    X1 
          RJ     SYS         MAKE SYSTEM REQUEST
  
*         SET UP *F.FRZ* FET SO THAT A *READSKP* WILL READ
*         THE FROZEN HOST FROM *F.FRZ/RECORD 2* INTO
*         THE HOLE CREATED BY *MEM*.
  
          SA1    RA.PGN 
          AX2    30 
          SX7    X2          (X7) = OUT = AFLS OF FROZEN HOST 
          MX3    60-18
          SA7    F.FRZ+3     OUT = AFLS OF FROZEN HOST
          SX4    122B        (X4) = *OPEN/NO REWIND* CIO CODE 
          BX6    X3*X1
          SX7    X7+B1       (X7) = LIMIT = AFLS+1 OF FROZEN HOST 
          IX6    X6+X4
          SA7    A7+B1       LIMIT = AFLS+1 OF FROZEN HOST
          SA6    F.FRZ
          =X7    RA.MTR+1 
          SA7    A6+B1       FIRST = RA.MTR+1 
          SA7    A7+B1       IN = FIRST =RA.MTR+1 
  
*         MOVE *RHH* AND *F.FRZ* FET TO HIGH CORE 
*         (ABOVE HOLE CREATED FOR FROZEN HOST). 
  
          SB4    B0 
          SA1    FW.RHH      (A1,X1) = A+C OF 1ST WORD TO MOVE
          SB3    L.RHH       (B2) = NR OF WORDS TO MOVE 
          SB2    X2+L.IFRSZ  (B2) = ADDR TO MOVE TO 
  
 IFR2     BX6    X1 
          SA6    B2+B4
          SB4    B4+B1
          SA1    A1+B1
          LT     B4,B3,IFR2  IF NOT DONE
  
*         OPEN *F.FRZ*. 
  
          SA1    IFRB        (X1) = *CIO* REQUEST WORD
          SX2    B2+F.FRZ-FW.RHH   (X2) = FWA OF *F.FRZ* FET
          BX6    X1+X2
          SA6    A1          SAVE *CIO* REQUEST W/ ADDR OF MOVED *F.FRZ*
          RJ     SYS         MAKE SYSTEM REQUEST TO OPEN *F.FRZ*
  
*         SET UP SYSTEM REQUEST TO PERFORM THE *READSKP*
*         WHICH WILL READ THE FROZEN HOST INTO THE HOLE CREATED 
*         BY *MEM*. 
  
 IFR3     SA1    RA.MTR 
          NZ     X1,IFR3     IF (RA.MTR) NOT CLEAR, WAIT... 
  
          SA1    SYS1 
          SA2    B2+F.FRZ-FW.RHH   (A2,X2) = A+C OF *F.FRZ* FET WORD 1
          SA3    IFRB        (X3) = *CIO* REQUEST WORD
          MX4    60-18
          BX7    X1 
          LX1    59-56       (X1) = .MI. IF *EQ* INSTRUCTION
*                                 = .PL. IF *XJ* INSTRUCTION
          BX6    X4*X2       CLEAR BITS 0 THRU 17 OF *F.FRZ* WORD 1 
          SX4    22B         (X4) = *READSKP* CIO CODE
          IX6    X6+X4       MERGE *READSKP* CIO CODE 
          SA6    A2 
          BX6    X3          (X6) = *CIO* REQUEST WORD
  
*         RELOCATE *WAIT (RA.MTR) LOOP* IF NOT USING
*         *XJ* INSTRUCTION. 
  
          PL     X1,IFR4     IF USING *XJ*
          MX2    -18
          SX3    B2+B1       (X3) = ADDR OF *RHH* INSTRUCTIONS WHICH
*                                   ACTUALLY MAKES THE *CIO* REQUEST
*                                   TO READ *F.FRZ* 
          BX7    X2*X7       CLEAR OLD ADDR 
          IX7    X7+X3       MERGE NEW ADDR 
          SA7    B2+B1
  
*         EVERYTHING IS READY TO GO...
*         TRANSFER CONTROL TO *RHH* UP IN HIGH CORE.
  
 IFR4     JP     B2+
  
  
*         *MEM* REQUEST WORD. 
  
 IFRA     VFD    18/3LMEM,3/2,21/0,18/MEM#RHH 
  
*         *CIO* REQUEST WORD. 
  
 IFRB     VFD    18/3LCIO,3/2,21/0,18/0 
 SYS      SPACE  4
***       SYS - PROCESS SYSTEM REQUEST. 
* 
*         ENTRY  (X6) = SYSTEM REQUEST. 
* 
*         EXIT   REQUEST PROCESSED. 
* 
*         USES   X - 1. 
*                B - NONE.
*                A - 1, 6.
* 
*         CALLS  NONE.
  
  
*         INSTRUCTION WORDS FOR MONITOR CALL. 
  
 SYSA     BSS    0
          LOC    *+2
 +        SA1    A1          WAIT (RA+1) CLEAR IF AUTO RECALL 
          LX1    59-40
          NG     X1,* 
          LOC    SYSA+1 
  
          XJ
  
 SYS1     EQ     SYS2        FIRST ENTRY
  
 SYS      PS                 ENTRY/EXIT 
 +        SA1    1           WAIT (RA+1) CLEAR
          NZ     X1,* 
          SA6    A1          ENTER REQUEST
          EQ     SYS1 
  
*         INITIAL ENTRY TO SET TYPE OF CALL.
  
 SYS2     SA1    SYSA        NO MEJ/CEJ OPTION
          BX6    X1 
  
          SA1    RA.CEJ 
          PL     X1,SYS3     IF NO MEJ/CEJ PRESENT
          SA1    SYSA+1 
          BX6    X1 
 SYS3     BSS    0
  
          SA6    SYS1        SET MONITOR CALL 
          SA1    1           RESET (A1) 
          BX6    X1 
          RJ     SYS1-1      CLEAR STACK
 IFR      SPACE  4,10 
 MEM#RHH  BSSZ   1           30/AFLS OF HOST PLUS *RHH*,30/OTHER
  
 MEM#HOST BSSZ   1           30/AFLS OF HOST,30/OTHER 
  
 L.IFRSZ  =      10B         LEN OF SAFETY ZONE BETWEEN HOST AND *RHH*
 RHH      SPACE  4,10 
**        RHH - READ HOST INTO HOLE.
* 
* 
*         THIS ROUTINE MAKES THE ACTUAL OPERATING SYSTEM REQUEST
*         TO READ THE FROZEN HOST FROM *F.FRZ/RECORD 2* 
*         INTO THE HOLE CREATED BY *IFR*. 
* 
*         ENTRY  (X6) = *CIO* REQUEST WORD
* 
*         EXIT   TO *IDP=IFR* IN UNFROZEN HOST
* 
*         USES
* 
*         CALLS  NONE 
  
 FW.RHH   BSS    0           MARK FWA OF*RHH* 
  
 RHH      BSS    0           ** ENTRY **
          SA6    RA.MTR 
  
*         THE FOLLOWING LOCATION WILL BE PLUGGED WITH 
*         A *WAIT (RA.MTR)* LOOP BY *IFR* IF NO *XJ* INSTRUCTION
*         AVAILABLE.
  
+         XJ
  
*         THE INTERACTIVE HOST IS NOW BACK IN CORE... RE-ENTER *IDP*. 
  
+         EQ     /"IDP"/IDP=IFR 
 F.FRZ    SPACE  4,10 
**        F.FRZ - FET FOR *FREEZE* FILE.
  
 F.FRZ    BSS    0           ** FWA OF FET ** 
 L.FRZ    =      101B        LENGTH OF *F.FRZ* BUFFER FOR RECORD 1 WRITE
*                            (I.E. SMALLEST POSSIBLE, 1 PRU)
 FRZ      FILEB  /"IDP"/FW.IFR,L.FRZ
  
  
 L.RHH    =      *-FW.RHH+1 
  
          LOC    *O 
          QUAL   *
  
 L.IFR    =      *-FW.IFR+1  LENGTH OF IDP FREEZE RESTART PROGRAM 
 IFR      SPACE  4,10 
**        REDEFINE SYMBOLS THAT *IDP* NEEDS TO REFERENCE INSIDE /IFR/.
  
 F.FRZ    =      FW.IFR+/IFR/F.FRZ-RA.ORG 
 MEM#RHH  =      FW.IFR+/IFR/MEM#RHH-RA.ORG 
 MEM#HOST =      FW.IFR+/IFR/MEM#HOST-RA.ORG
 IDP      TITLE  IDP "IDPVER"/THE EXECUTIVES. 
 IDP      SPACE  4,8
**        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 (COMAIDP), 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.
* 
*         FOR A LIST OF IDP'S OWN (I.E. NOT USER KEYWORDS), SEE IDP'S 
*         KEYWORD LIST AT *FW.KEY* ET SEQ.
* 
*         MAY THE GODS BE WITH YOU... 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   NONE        (OR IT WOULDNT BE ANY GOOD)
* 
*         CALLS  (EXTERNAL TO COMCIDP)--
*                CDD,COD,DXB,OPEN,READC,RSR=,SFN,SVR=,WRITEC,WRITER 
  
  
  
 IDP=     SUBR               ** ENTRY **
 +        RJ     =XSVR       SAVE ALL REGISTERS 
 -        VFD    30/FW.SVR
  
*         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*
          BX6    X6+X3       MERGE *IDO*
          SA6    A1 
  
*         SET UP LINK TO USER KEYWORD TABLE, *UKT=*.
  
          SA1    FW=UKT      (X1) = LINK WORD TO USER KEYWORD TABLES
          SX6    =YUKT=      (X6) = FWA OF 1ST USER KEYWORD TABLE 
          NZ     X1,IDP1     IF USER HAS ALREADY LINKED TABLES THEMSELF 
          MI     X6,IDP1     IF USER DID NOT PROVIDE *UKT=* 
          SA6    A1+
  
*         SET UP INTERACTIVE FILES. 
  
 IDP1     RJ     IIF         INITIALIZE INTERACTIVE FILES 
  
*         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 
          SB6    IDPXFT 
          RJ     CLZ         CLEAR *IDP* TABLE -- XFER ADDRESSES
  
*         INITIAL BREAK PROCESSING. 
  
 IDP2     SA1    IDP=        (A1,X1) = A+C OF IDP ENTRY POINT 
          RJ     BRK         BREAK PROCESSOR
          ZR     X5,ST=END3  IF CONDITIONAL BREAK NOT SATISFIED 
          RJ     FRK         CHECK FREQUENCY PARAMETERS 
          ZR     X5,ST=END3  IF NO BREAK THIS TIME
          RJ     UIO         USER IDP OWNCODE 
          PL     X1,ST=END3  IF NO INTERACTIVE BREAK THIS TIME
  
*         FLUSH *F.BDO - BATCH DEBUG OUTPUT FILE*.
  
          SB2    =YF.BDO
          RJ     FOF         FLUSH OUTPUT FILE
  
*         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 
          RJ     FRA         FIND RELATIVE ADDRESS
          PL     B7,IDP5     IF USER PROVIDED *FRA=*
  
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          BX6    X4 
          MX7    0
  
 IDP5     SA6    A7+B1
          SA7    A6+B1
          PRIDP  SNAPLNE
 IDP=MN   SPACE  4,10 
*         ** MAIN LOOP NODE **
  
 IDP=MN   BSS    0
          SA1    TB=STMT
          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    0-TB.LENP
          SX1    X1 
          SX2    X2+B1
          IX6    X1+X2       (X6) = ADDR OF LEN WORD FOR NEXT STMT
          SA6    TB=STMT
          SA1    X6 
          SA5    X6+B1       (A5,X5) = A+C OF 1ST TOKEN IN NEXT STMT
          NZ     X1,IDP12    IF NOT END-OF-LINE IN TOKEN BUFFER 
  
*         HERE TO READ NEW LINE.
  
 IDP8     SA1    IDPFLG 
          BX2    X1 
          LX1    59-IDF.INPP
          LX2    59-IDF.BRFP
          BX6    X1+X2
          MI     X6,IDP8A    IF READING FROM BATCH INPUT (F.BDI) .OR. 
*                              IN *BRIEF* MODE
  
          DUP    L.PRB,1
          WRITEC =XF.IDO,(=C=  =) 
  
          WRITEC =XF.IDO,(=C= "PROMPT"=)
  
 IDP8A    SB2    F.IDO
          RJ     FOF         FLUSH OUTPUT FILE
  
 IDP9     RJ     RIL         READ IDP LINE
          SA2    IDPFLG 
          SA5    FW.LIM      (A5,X5) = A+C OF 1ST WORD IN SOURCE LINE 
          ZR     X1,IDP10    IF EOR/EOF NOT ENCOUNTERED 
          MX3    1
          LX3    IDF.RAPP-59
          BX6    -X3*X2      CLEAR *RAP*
          LX3    IDF.INPP-IDF.RAPP
          BX6    -X3*X6      CLEAR *INP*
          LX2    59-IDF.INPP
          SA6    A2+
          PL     X2,ST=STA   IF INTERACTIVE INPUT, EOR IS *STATUS*... 
          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  FW.LIM-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,FW.LIM-1 
  
*         HERE WHEN READY TO ENTOKEN LINE.
* 
*           1. SET UP *TOKCOM*, THE *USER/TOK* COMMUNICATIONS AREA. 
* 
*           2. CALL *COMCTOK* (COMMON TOKEN GENERATOR) TO ENTOKEN 
*              THIS LINE. 
  
 IDP11    SX6    TOM=BOL     (X6) = ADDR OF 1ST *TOGEL* INST TO XEQ 
          SX7    FW.LIM      (X7) = FWA OF LINE IMAGE TO ENTOKEN
          SA6    TC=P 
          SA7    TC=SOA 
  
          SA1    X7 
          BX6    X1 
          SA6    TC=SOX 
          SX6    -1 
          SX7    IDPTB       (X7) = FWA OF TOKEN BUFFER 
          SA6    TC=SOC      SET TO *NO USEABLE CHAR IN (X4)* 
          SA7    TC=TBA 
          SA7    TB=STMT
  
          SB2    FW.TCOM     (B2) = FWA OF *TOKCOM* 
          RJ     =XTOK       TOKEN GENERATOR
          SX6    IDPTB
          SA5    IDPTB+1
          SA6    TB=STMT
          EQ     IDP12
  
*         BACK FROM *STATEMENT CONTROL* PROCESSING.  INCREMENT
*         TOKEN BUFFER POINTER. 
  
 IDP=SC   BSS    0           ** ENTRY **
          SA5    A5+1 
  
*         HERE WITH A NEW STATEMENT TO BE PROCESSED.
* 
*           1. CHECK FOR AND PROCESS ANY *STMT CONTROL* TOKENS
*              THAT PRECEDE THE STMT KEYWORD. 
* 
*           2. SEARCH FOR THE STMT KEYWORD VIA THE LINKED LIST(S) 
*              OF KEYWORD TABLES. 
* 
*           3. TRANSFER CONTROL TO THE APPROPRIATE STMT PROCESSOR 
*              FOR THIS KEYWORD.
  
 IDP12    MX0    TB.TOCL
          BX1    X0*X5       (X1) = KEYWORD, IN -L- FMT 
          ZR     X5,IDP=MN   IF A NULL STMT, IGNORE...
*                              (PROBABLE "EOS" "EOS" SYNTAX)
          SX6    X5-O.KEY 
          ZR     X6,IDP13    IF *KEY* TOKEN, NO *STMT CTL*... 
  
*         CHECK FOR *STATEMENT CONTROL* TOKEN.
  
          BX1    -X0*X5      (X1) = *TOT* 
          SB6    FW.SCT      (B6) = FWA OF *STMT CTL* PROCESSOR TABLE 
          LX1    SC.TOTP-0
          MX0    SC.TOTL     (X0) = EXTRACTION MASK FOR *SKT* 
          RJ     SKT         SEARCH IDP TABLE 
          ZR     X2,E.SC     IF NO FIND 
          LX2    0-SC.PADP
          SB2    X2+         (B2) = ADDR OF PROCESSOR FOR THIS *TOT*
          JP     B2 
  
*         CLASSIFY THIS STATEMENT.
* 
*         NOTE THAT *CST* DOES NOT RETURN IF AN ERROR IS DETECTED.
  
 IDP13    RJ     CST         CLASSIFY STATEMENT 
          ZR     X6,E.KEY    IF NO FIND, ERROR... 
          SA6    TB=KEY      SAVE ADDR OF FOUND *KEYW* ENTRY
  
*         HERE IF WE HAVE A KEYWORD MATCH.
* 
*         READY TO TRANSFER CONTROL TO THE APPROPRIATE STMT PROCESSOR.
*         FIRST, HOWEVER, WE NEED TO FIDDLE WITH (A5) AND (X5) SO 
*         THAT UPON ENTRY TO THE STMT PROCESSOR --
* 
*                (A1,X1)= A+C OF *KEYW* ENTRY, WORD 1.
*                (A5+1) = ADDR OF 1ST TOKEN TO LOOK AT. 
*                (X5)   = .ZR. IF KEYWORD IMMEDIATELY FOLLOWED BY EOS,
*                         ELSE .NZ. 
  
 IDP14    BX6    X5 
          SX7    X5-O.COM 
          ZR     X7,IDP15    IF KEYWORD FOLLOWED BY COMMA 
          SA5    A5-B1
          LX5    X6 
  
 IDP15    SA1    TB=KEY      (X1) = ADDR OF *KEYW* ENTRY FOR THIS KEYWRD
          SA2    X1+         (A2,X2) = A+C OF *KEYW* ENTRY, WORD 1
          LX2    0-KW.PADP
          SB2    X2          (B2) = ADDR OF STMT PROCESSOR
          RJ     CHK         CHECK CM ADDR (BEST TO BE CAREFUL...)
          SA2    TB=KEY 
          MI     B2,SE.PAD   IF STMT PROCESSOR ADDR IS BAD
          SA1    X2          (A1,X1) = A+C OF FOUND *KEYW* ENTRY, WORD 1
          JP     B2          FLY AWAY...
 IDP=XIT  SPACE  4,10 
**        IDP=XIT - EXIT IDP. 
* 
* 
  
 IDP=XIT  BSS    0           ** ENTRY **
          SA1    IDPPREG     (X1) = ADDR OF NEXT INSTRUCTION TO XEQ 
          SA2    IDP=JPS     (X2) = *JP B0+0* PLUG SKELETON 
          LX1    30 
          BX6    X2+X1       (X6) = 30/JP B0+PREG,30/NO-OP
          SA6    IDP=JP 
  
          SX1    FW.SVR      (X1) = FWA OF SAVED REGISTERS
          RJ     RIR         RESTORE INTERACTIVE REGISTERS
  
 IDP=JP   JP     *+4S15      PLUGGED W/ *JP B0+RETURN ADDR* 
  
 IDP=JPS  JP     B0+0        PLUG SKELETON
 IDP=ER   SPACE  4,10 
*         HERE FOR ERROR CONDITION. 
  
 IDP=ER   BSS    0           ** ERROR **
 IDP.ER   BSS    0
          SX6    -1          SET TO *NO ERROR MSG AVAILABLE*
  
 IDP=ERR  BSS    0           ** ENTRY FROM /ERROR/ MACRO ** 
          SA6    IDPERR 
          WRITEC =XF.IDO,(=C. ?.) 
          EQ     IDP8        TRASH CURRENT LINE/READ NEW LINE...
 IDP=SER  SPACE  4,10 
**        IDP=SER - *SYSTEM* ERROR. 
* 
* 
*         HERE WHEN IDP SENSES AN INTERNAL-TYPE ERROR.
  
  
 IDP=SER  BSS    0           ** ENTRY **
          SA6    IDPERR 
          SB2    =YF.BDO
          RJ     FOF         FLUSH OUTPUT FILE
          RJ     PEM         PRINT ERROR MSG
          EQ     IDP8        TRASH CURRENT LINE/READ NEW LINE...
 IDP=IFR  SPACE  4,10 
**        IDP=IFR - IDP RESTART.
* 
*         HERE FROM *RHH* WHEN HOST HAS JUST BEEN RESTARTED 
*         VIA *IFR*.  NEED TO --
* 
*           1.*MEM* BACK DOWN TO ORIGINAL FIELD LENGTH. 
* 
*           2. RESTORE THE WORDS AT (RA.SSW), (FL-2), AND (FL-1). 
* 
*           3. (RE)OPEN AND CONNECT INTERACTIVE FILES, JUST IN CASE 
*              USER IS RESTARTING ON ANOTHER DAY. 
* 
*           4. CALL *UFR* (USER FREEZE RESTART OWNCODE) TO ALLOW
*              THE HOST TO PERFORM FREEZE RESTART OWNCODE  (LIKE
*              RE-SETTING UP FILES, FER INSTANCE...). 
  
  
 IDP=IFR  BSS    0           ** ENTRY **
          SA4    MEM#HOST 
          SX3    B1 
          BX6    -X3*X4      CLEAR COMPLETE BIT 
          SA6    A4 
          MEMORY SCM,A4,RCL 
  
          SA1    FRZ#SAV
          SA2    A1+B1
          SA3    A2+B1
          LX6    X1 
          BX7    X2 
          AX4    30 
          =A6    RA.SSW      RESTORE (RA.SSW) 
          SA7    X4-2        RESTORE (FL-2) 
          BX6    X3 
          SA6    A7+B1       RESTORE (FL-1) 
          RJ     IIF         INITIALIZE INTERACTIVE FILES 
          RJ     UFR         USER FREEZE RESTART OWNCODE
          EQ     IDP=MN      CONTINUE INTERACTIVE SESSION...
 .IDPOS   ENDIF 
 REG      SPACE  4,10 
**        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 *COMAIDP*) --
* 
*         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
*         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
  
  
 REG=     SUBR               ** ENTRY/EXIT ** 
 +        RJ     =XSVR       SAVE ALL REGISTERS 
 -        VFD    30/FW.SVR
          SX1    1           SET TO *EXECUTIVE IS /REG=/* 
          RJ     SOB         SET OUTPUT BIT FLAGS 
          SA1    REG=        (X1) = 30/EQ CALLING ADDRESS+1, 30/0 
          RJ     IEX         INITIALIZE EXECUTIVE 
          RJ     URO         USER REG= OWNCODE
          PL     X1,REG3     IF NO REGISTER SNAPSHOT THIS TIME
          RJ     FRK         CHECK FREQUENCY PARAMETERS 
          ZR     X5,REG3     IF NOT SNAPPING THIS TIME
          RJ     HDR         OUTPUT SNAP HEADER 
          SA5    FW=PARM
          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     SX1    FW.SVR      (X1) = FWA OF SAVED REGISTERS
          RJ     RIR         RESTORE INTERACTIVE REGISTERS
          EQ     EXIT.
 SNP      SPACE  4,10 
**        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 *COMAIDP*) -- 
* 
*         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
*         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,RIR,SOB,SVR,USO
  
  
 SNP=     SUBR               ** ENTRY/EXIT ** 
 +        RJ     =XSVR       SAVE ALL REGISTERS 
 -        VFD    30/FW.SVR
          SX1    2           SET TO *EXECUTIVE IS /SNP=/* 
          RJ     SOB         SET OUTPUT BIT FLAGS 
          SA1    SNP=        (X1) = 30/EQ CALLING ADDRESS+1, 30/0 
          RJ     IEX         INITIALIZE EXECUTIVE 
          RJ     USO         USER SNP= OWNCODE
          PL     X1,SNP4     IF NO SNAPSHOT THIS TIME 
          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    FW=PARM
          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     SX1    FW.SVR      (X1) = FWA OF SAVED REGISTERS
          RJ     RIR         RESTORE INTERACTIVE REGISTERS
          EQ     EXIT.
 IDP      TITLE  IDP "IDPVER"/THE STATEMENT PROCESSORS. 
 .IDPOS   IFNE   .OS,2
 SC=      SPACE  4,10 
***       SC= - STATEMENT CONTROL PROCESSORS. 
* 
* 
*         THE FOLLOWING SECTION CONTAINS THE PROCESSORS THAT HANDLE 
*         THE SO CALLED *STATEMENT CONTROL* SYNTAXS.  THESE ARE THE 
*         SPECIAL PREFIX TOKENS THAT CAN OPTIONALLY PRECEDE ANY IDP 
*         COMMAND STMT, AND THAT CONTROL HOW THAT STMT IS **SEEN**. 
* 
*         FOR EXAMPLE, THE *BRIEF* MODE TOGGLE SWITCH, *.*, IS NOT
*         REALLY A KEYWORD IN THE STRUCTURAL SENSE.  IT MERELY INDICATES
*         TO IDP THAT THE USER WISHES TO TOGGLE *BRIEF* MODE. 
 SC=BRF   SPACE  4,10 
**        HERE TO PROCESS *.* (BRIEF MODE TOGGLE SWITCH). 
  
 SC=BRF   BSS    0           ** ENTRY **
          SA1    IDPFLG 
          MX2    1
          LX2    IDF.BRFP-59
          BX6    X1-X2       TOGGLE *BRF* 
          SA6    A1 
          EQ     IDP=SC 
 SC=QQQ   SPACE  4,10 
**        HERE TO PROCESS *?*.
  
  
 SC=QQQ   BSS    0           ** ENTRY **
          RJ     PEM         PRINT ERROR MSG
          EQ     IDP=SC 
 ST=      SPACE  4,10 
**        ST= - STATEMENT PROCESSORS. 
* 
 ST=ABS   SPACE  4,10 
**        HERE TO PROCESS *ABS*.
  
  
 ST=ABS   BSS    0           ** ENTRY **
          SA1    IDPFLG 
          MX2    1
          LX2    IDF.ADRP-59
          BX6    -X2*X1      CLEAR *ADR*
          SA6    A1 
          EQ     IDP=MN 
 ST=BRK   SPACE  4,10 
*         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   BSS    0           ** ENTRY **
          LX1    0-KW.XATP
          MX2    -KW.XATL 
          BX6    -X2*X1      (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,E.BRAD   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,E.BRA1   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,E.BRA2   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,10 
*         HERE TO PROCESS *CODE FWA,LWA,LEN*. 
  
 ST=COD   BSS    0
          RJ     PAT         PARSE *FWA,LWA,LEN* TRIPLE 
          MI     B2,E.FLL    IF FWA, LWA, OR LEN IS BAD 
  
*         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,10 
*         HERE TO PROCESS *CONNECT FILE*. 
  
 ST=CON   ZR     X5,E.LFN    IF EOS ENCOUNTERED 
          SA5    A5+B1
          MX2    TB.TOCL
          BX1    X2*X5       (X1) = LFN, -L- FMT
          RJ     SSY         SEARCH SYMBOL TABLES 
          ZR     B6,E.VAR    IF NO FIND 
          SB2    X6+         (B2) = FWA OF FET
          RJ     CHK         CHECK CM ADDR
          MI     B2,E.ADDR   IF ADDR IS BAD 
          SA1    B2          (A1,X1) = A+C OF WORD 1 OF FET 
          SX2    B0          SET TO *CONNECT* 
          RJ     CON         CONNECT/DISCONT FILE 
  
 #OS3     IFEQ   .OS,3       IF SCOPE 3 
          MI     X1,SE.CON   IF *CON* DETECTED ERROR... 
 #OS3     ENDIF 
 #UFT     ENDIF 
  
          EQ     IDP=MN 
 ST=DPC   SPACE  4,10 
*         HERE TO PROCESS *DPC FWA,LWA,LEN*.
  
 ST=DPC   BSS    0
          RJ     PAT         PARSE *FWA,LWA,LEN* TRIPLE 
          MI     B2,E.FLL    IF FWA, LWA, OR LEN IS BAD 
          RJ     DOD         DUMP CENTRAL MEMORY - OCTAL AND DPC
          PL     B2,IDP=MN   IF FWA,LWA,AND LEN OK
          EQ     SE.FLL 
 ST=DSC   SPACE  4,10 
*         HERE TO PROCESS *DISCONT FILE*. 
  
 ST=DSC   ZR     X5,E.LFN    IF EOS ENCOUNTERED 
          SA5    A5+B1
          MX2    TB.TOCL
          BX1    X2*X5       (X1) = LFN, -L- FMT
          RJ     SSY         SEARCH SYMBOL TABLES 
          ZR     B6,E.VAR    IF NO FIND 
          SB2    X6+         (B2) = FWA OF FET
          RJ     CHK         CHECK CM ADDR
          MI     B2,E.ADDR   IF ADDR IS BAD 
          SA1    B2          (A1,X1) = A+C OF WORD 1 OF FET 
          SB2    B1          SET TO *DISCONT* 
          RJ     CON         CONNECT/DISCONT FILE 
  
          IFEQ   .OS,3,1     IF SCOPE 3 
          MI     X1,SE.CON   IF *CON* DETECTED ERROR... 
  
          EQ     IDP=MN 
 ST=END   SPACE  4,10 
**        HERE TO PROCESS *END*.
* 
*           1. ISSUE THE FAREWELL PROMPT, *BYE...*, AND FLUSH 
*              THE INTERACTIVE OUTPUT LFN, *F.IDO*. 
* 
*           2. DETERMINE WHETHER OR NOT WE NEED TO XEQ SOMETHING
*              BEFORE RETURNING CONTROL TO THE CALLER.
* 
*              THERE ARE 2 FLAVOURS OF THIS --
* 
*              A. IF THIS IS AN INTERACTIVE BREAK (I.E. NOT AN ASSEMBLED
*                 BREAK), THEN WE MIGHT NEED TO XEQ THE PREVIOUS
*                 CONTENTS OF THE BREAK ADDR, WHICH WAS SET UP BY *BRK* 
*                 TO BE IN (BC=BRAD). 
* 
*              B. IF *STEP* MODE LEFT US IN THE MIDDLE OF A WORD, THEN
*                 WE NEED TO FINISH UP THE INSTRUCTIONS IN THAT WORD
*                 BECAUSE WE CAN NOT START UP THE CPU IN THE MIDDLE 
*                 OF A WORD.
* 
*              IT SHOULD BE RELATIVELY CLEAR THAT WE MUST FINISH UP ANY 
*              PARTIAL WORDS SO THAT WE CAN TRANSFER CONTROL TO A FORCED
*              UPPER INSTRUCTION.  HOWEVER, IT MAY NOT BE QUITE AS CLEAR
*              WHY WE **MUST** STEP THESE INSTRUCTIONS (AS OPPOSED TO 
*              MERELY NO-OP FILLING A WORD AND XEQING IT).  IDP USED TO 
*              PLAY THE NO-OP FILLING GAME, BUT A NUMBER OF BUGS WERE 
*              DISCOVERED WITH THIS SCHEME... 
* 
*              BOTH HAD TO DO WITH THE *RJ* INSTRUCTION.  IT TURNED OUT 
*              THAT UNDER NOT SO UNUSUAL CIRCUMSTANCES, IDP WOULD DO
*              VERY UGLY THINGS WHEN THIS *FINAL* INSTRUCTION WAS AN
*              *RJ*.  ERGO... 
  
  
 ST=END   BSS    0           ** ENTRY **
          SA1    IDPFLG 
          LX1    59-IDF.BRFP
          MI     X1,ST=END2  IF IN *BRIEF* MODE, NO BYE BYE PROMPT... 
  
          PRIDP  (=C= BYE...=),,L.PRB 
  
 ST=END2  SB2    F.IDO
          RJ     FOF         FLUSH OUTPUT FILE
          SB2    =YF.BDO
          RJ     FOF         FLUSH OUTPUT FILE
  
 ST=END3  BSS    0           ** ENTRY FROM SOME PLACES ** 
          SA1    IDPXLST
          SA2    BC=BRAD     (X2) = PREVIOUS CONTENTS OF BREAK ADDR 
          BX6    X6-X6
          LX7    X1 
          SA6    A1+         SET TO *NOT LISTING STEPPED INSTRUCTIONS*
          SA7    ST=ENDA     SAVE ORIGINAL (IDPXLST)
          NZ     X2,ST=END5  IF WE NEED TO XEQ SOMETHING BEFORE EXITING 
  
 ST=END4  SA1    IDPPOS 
          SX6    X1-60D 
          ZR     X6,ST=END6  IF WE ARE FORCED UPPER, THEN DONE... 
          PL     X6,*+4S15   IF *POS* COUNTER IS BAD... 
  
 ST=END5  RJ     STP         STEP ONE INSTRUCTION 
          EQ     ST=END4
  
 ST=END6  SA1    ST=ENDA     (X1) = SAVED (IDPXLST) 
          BX6    X1 
          SA6    IDPXLST     RESTORE (IDPXLST) TO ORIGINAL VALUE
          EQ     IDP=XIT
  
  
 ST=ENDA  BSSZ   1           SAVED (IDPXLST)
 ST=FRZ   SPACE  4,10 
*         HERE TO PROCESS *FREEZE*. 
  
 ST=FRZ   BSS    0
          SA1    FW.IFR+/IFR/F.FRZ-RA.ORG 
          SA2    =0LFRZ 
          MX3    -18
          BX1    -X3*X1      CLEAR OLD LFN
          IX6    X1+X2       MERGE NEW LFN
          SA6    A1 
          RJ     FRZ         FREEZE INTERACTIVE HOST
          RJ     UFO         USER FREEZE OWNCODE
          EQ     IDP=MN 
 ST=JP    SPACE  4,10 
*         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,E.JP     IF ADDR IS BAD 
          SA1    =46000460004600046000B 
          SX7    60 
          SA7    IDPPOS 
          SX6    B2 
          BX7    X1 
          SA6    IDPPREG
          SA7    BC=BRAD
          EQ     ST=END 
 ST=OPT   SPACE  4,10 
**        HERE TO PROCESS *OPTION P1,...PN*.
  
  
 ST=OPT   BSS    0           ** ENTRY **
          ZR     X5,IDP=MN   IF EOS ENCOUNTERED 
          SB6    FW.KOPT     (B6) = FWA OF *OPTION* SUBKEYWORD TABLE
          RJ     POL         PROCESS OPTIONS LIST ITEM
          SA1    B6+B7       (X1) = *FOUND* OPTIONS SUBKEYWORD ENTRY
          ZR     X3,ST=OPT   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 *OPTION (-)MEM*.
  
 ST=OPT2  LX0    IDF.MEMP-59
          BX2    -X0*X2      CLEAR OLD *MEM*
          LX6    IDF.MEMP-59
          BX6    X2+X6       MERGE NEW *MEM*
          SA6    A2 
          EQ     ST=OPT 
  
  
*         HERE IF *OPTION (-)XJR*.
  
 ST=OPT3  LX0    IDF.XJRP-59
          BX2    -X0*X2      CLEAR OLD *XJR*
          LX6    IDF.XJRP-59
          BX6    X2+X6       MERGE NEW *XJR*
          SA6    A2 
          EQ     ST=OPT 
 ST=OUT   SPACE  4,10 
**        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,10 
*         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.COM 
          SX7    X5-O.CONS
          SA4    IDP0TR 
          ZR     X6,ST=REG2  IF COMMA TOKEN 
          ZR     X7,ST=REG3  IF CONSTANT TOKEN
          SX6    X5-O.REG 
          NZ     X6,E.REG    IF NOT *REG* TOKEN, ERROR... 
  
*         HERE IF A *REG* TOKEN ENCOUNTERED.
  
          LX5    0-TB.0TRP
          SB4    X5          (B4) = 0TR 
          EQ     ST=REG4
  
*         HERE IF A *CONS* TOKEN ENCOUNTERED. 
  
  
 ST=REG3  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,E.REG    IF NOT (0-7), ERROR... 
          MX0    -5*CHAR
          BX7    -X0*X5 
          NZ     X7,E.REG    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
          SB4    X7+B6       (B4) = NEW 0TR 
  
 ST=REG4  SX6    B4 
          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=REL   SPACE  4,10 
**        HERE TO PROCESS *REL*.
  
  
 ST=REL   BSS    0           ** ENTRY **
          SA1    IDPFLG 
          MX2    1
          LX2    IDF.ADRP-59
          BX6    X1+X2       SET *ADR*
          SA6    A1 
          EQ     IDP=MN 
 ST=SET   SPACE  4,10 
*         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,E.SET    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,10 
*         HERE TO PROCESS *SNAP FWA,LWA,LEN*. 
  
 ST=SNP   BSS    0
          RJ     PAT         PARSE *FWA,LWA,LEN* TRIPLE 
          MI     B2,E.FLL    IF FWA, LWA, OR LEN IS BAD 
          RJ     DCM         DUMP CENTRAL MEMORY
          PL     B2,IDP=MN   IF FWA,LWA,AND LEN OK
          EQ     SE.FLL 
 ST=STA   SPACE  4,10 
**        HERE TO PROCESS *STATUS*. 
  
 ST=STA   BSS    0           ** ENTRY **
          SA3    IDPFLG 
          SA2    ST=STAA     (X2) = 10L_ IN IDP 
          LX3    59-IDF.BRFP
          BX6    X2 
          SB7    SNAPLNE     (B7) = FWA OF OUTPUT LINE IMAGE AREA 
          SA1    A2+B1       (X1) = 10L_, *BRIEF* 
          SA6    B7 
          PL     X3,ST=STA2  IF NOT IN *BRIEF* MODE 
          RJ     =XMCS       MERGE CODED STRINGS
  
 ST=STA2  BX6    X6-X6
          SA6    B7+B1       MARK EOL 
          PRIDP  SNAPLNE
          EQ     IDP=MN 
  
  
 ST=STAA  DATA   L. IN IDP. 
          DATA   L., *BRIEF*. 
 ST=STO   SPACE  4,10 
*         HERE TO PROCESS *STORE ADDR,C1,C2,C3,C4*. 
  
 ST=STO   BSS    0
          ZR     X5,E.STO    IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION -- ADDR TO STORE 
          ZR     X3,E.STO    IF 1ST EXPRESSION *ADDR* IS NULL 
          SX6    X1 
          SB2    X1 
          SA6    IDPSTA      SAVE STORE ADDR
          RJ     CHK         CHECK CM ADDRESS -- STORE ADDR 
          MI     B2,E.STO    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,10 
*         HERE TO PROCESS *STEP L,RJ*,
*                      OR *STPL ADDR1,L,RJ* FORM, 
*                      OR *STEQ ADDR1,ADDR2,L,RJ* FORM. 
  
 ST=STP   BSS    0           ** ENTRY **
          MX2    -KW.XATL 
          LX1    0-KW.XATP
          BX6    -X2*X1      (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,E.BRA1   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,E.BRA2   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 
          MI     X1,ST=STP7  IF NO ADDR REF 
          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=TIM   SPACE  4,10 
**        HERE TO PROCESS *TIME*. 
  
 ST=TIM   BSS    0           ** ENTRY **
          CLOCK  SNAPLNE
          BX6    X6-X6
          SA6    SNAPLNE+1   MARK EOL 
          PRIDP  SNAPLNE,2
          EQ     IDP=MN 
 ST=UBK   SPACE  4,10 
*         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
          SB2    X6          (B2) = ADDR OF BREAK TO UNBREAK
          SB3    X6 
          RJ     UBK         UNBREAK A BREAK
          EQ     ST=UBK      CONTINUE...
 ST=UST   SPACE  4,10 
*         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,10 
*         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
  
          RJ     FRA         FIND RELATIVE ADDRESS
          SA6    A6+B1
          SA7    A6+B1
          PRIDP  SNAPLNE
          NZ     X5,ST=WHR2  IF NOT EOS TOKEN 
          EQ     IDP=MN 
 ST=XEQ   SPACE  4,10 
*         HERE TO PROCESS *XEQ*.
  
 ST=XEQ   =      ST=STP6
 ST=XFR   SPACE  4,10 
*         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,10 
*         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...
 IDP      TITLE  IDP "IDPVER"/SUPPORTING SUBROUTINES. 
 ADZ      SPACE  4,10 
**        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 *SE.TOV* 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,SE.TOV   IF NO AVAILABLE SPACE LEFT 
          SA1    ADZA 
          BX6    X1 
          SA6    A2          MAKE NEW TABLE ENTRY 
          EQ     EXIT.
  
  
 ADZA     BSSZ   1
 BRK      SPACE  4,10 
**        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 *BC=BRAD* 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  (A1,X1) = A+C OF IDP ENTRY POINT.
* 
*         EXIT   (X5) = FWA OF PARAMETER LIST, ELSE 
*                     = .ZR. IF NO BREAK THIS TIME. 
* 
*                (ADR=RJ)  = ADDR OF *RJ IDP=* WORD.
*                (FW=PARM) = FWA OF PARAMETER LIST (ACTUAL OR INVENTED).
* 
*                (IDPPREG) = PSEUDO P REGISTER, I.E. ADDR OF NEXT 
*                            INSTRUCTION TO XEQ.
*                (IDPPOS)  = POS COUNTER, I.E. SET EQUAL TO 60D 
*                            (FORCED UPPER).
*                (BC=BRAD) = SAVED CONTENTS OF IDP GENERATED BREAK WORD,
*                            ELSE .ZR. IF NONE. 
* 
*         USES   ALL
* 
*         CALLS  CBC,CHK,IEX,SKT
  
  
 BRK      SUBR               ** ENTRY/EXIT ** 
          SX6    60D
          SX7    0
          SA6    IDPPOS      SET UP POS COUNTER 
          SA7    BC=BRAD     INITIALIZE TO *NO SAVED BREAK CONTENTS*
          RJ     IEX         INITIALIZE EXECUTIVE 
  
          SA1    ADR=RJ      (X1) = ADDR OF CALLING *RJ IDP=* 
          SA5    FW=PARM     (X5) = FWA OF *BREAK* PARAMETER LIST 
          SX6    X1+1 
          SA6    IDPPREG     SET UP PSEUDO P REGISTER 
          GT     B2,B0,BRK10 IF ASSEMBLED *BREAK* W/ PARAM LIST 
  
          BX7    -X7-X7      (X7) = -0
          MX0    -18
          SA7    AP=HDR      SET TO *IDP GENERATED BREAK HEADER*
          BX0    -X0
          MI     B2,EXIT.    IF ASSEMBLED *RJ IDP=* W/O PARM LIST 
  
          SB6    IDPBA
          RJ     SKT         SEARCH FOR BREAK ADDR
          ZR     X2,SE.BRK   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    BC=BRAD
  
*         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.
  
*         HERE IF ASSEMBLED *BREAK* WITH A PARAMETER LIST.
* 
*         NEED TO CHECK (X5)+SN=BRAD. 
  
 BRK10    SA1    X5+SN=BRAD  (X1) = NEW PSEUDO P REG
          SB2    X1+
          LE     B2,B1,EXIT. IF NEW PSEUDO P IS BAD, IGNORE IT... 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,EXIT.    IF NEW PSEUDO P IS BAD, IGNORE IT... 
  
          SX6    B2 
          SX7    B2-B1
          SA6    IDPPREG     UPDATE PSEUDO P REG
          SA7    ADR=RJ      UPDATE CALLING ADDR
          EQ     EXIT.
 .IDPOS   ENDIF 
 CAD      SPACE  4,10 
**        CAD - CONVERT ADDRESS FROM BINARY TO DPC. 
* 
* 
*         THIS ROUTINE CONVERTS A BINARY ADDRESS (18 BITS) TO DPC 
*         IN ONE OF 2 WAYS -- 
* 
*           1. IF *FRA=* (FIND RELATIVE ADDRESS) IS DEFINED .AND. 
*              *IDPFLG/IDF.ADRP* INDICATES THAT WE ARE TO CONVERT 
*              THE ADDR TO DECK RELATIVE, THEN *CAD* WILL CALL *FRA=* 
*              TO FIND AND CONVERT THE RELATIVE ADDRESS.
* 
*           2. IF *FRA=* IS NOT DEFINED .OR. *IDPFLG/IDF.ADRP* INDICATES
*              THAT WE ARE TO CONVERT THE ADDR TO AN ABSOLUTE ADDR, 
*              *CAD* WILL CALL *COD* (CONVERT BINARY TO OCTAL DPC)
*              TO CONVERT THE ADDR. 
* 
*         ENTRY  (X1) = ADDR TO CONVERT, IN BINARY. 
* 
*         EXIT   (X6) = ..NNNNNN..  IF ABSOLUTE CONVERSION
*                     = .+NNNNNN..  IF RELATIVE CONVERSION
* 
*                       WHERE . = BLANK(55B)
*                             N = OCTAL DIGIT (ADDR IS RIGHT JUSTIFIED
*                                 TO BIT 3*CHAR, LEADING 0 SUPPRESSION) 
*                             + = RELATIVE ADDR INDICATOR 
* 
*         USES   ALL BUT A0,X0,A5,X5,A6   (INCLUDES ALL CALLS)
* 
*         CALLS  COD,FRA
  
  
 CAD      SUBR               ** ENTRY/EXIT ** 
  
*         CHECK FOR AND CONVERT/FIND A RELATIVE ADDRESS.
  
          SA2    IDPFLG 
          LX2    59-IDF.ADRP
          PL     X2,CAD3     IF USER REQUESTED ABS CONVERSION 
  
          RJ     FRA         FIND RELATIVE ADDRESS
          MI     B7,CAD3     IF USER DID NOT PROVIDE *FRA=* 
  
*         SET UP EXIT CONDITIONS. 
  
          SA2    =R.   +. 
          MX3    6*CHAR 
          BX4    X3*X6       (X4) = NNNNNN0000  (.=BLANK(55B),0=00B)
          IX6    X4+X2       (X6) = NNNNNN...+  (.=BLANK(55B))
          LX6    -2*CHAR     (X6) = .+NNNNNN..
          EQ     EXIT.
  
*         HERE IF CONVERTING TO AN ABSOLUTE ADDRESS.
  
 CAD3     RJ     COD         CONVERT BINARY TO OCTAL DPC
          LX6    2*CHAR      (X6) = ..NNNNNN..   (.=BLANK(55B)) 
          EQ     EXIT.
 CBC      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        CBC - CHECK BREAK CONDITION.
* 
* 
*                THIS ROUTINE RETURNS A TRUE/FALSE VALUE FOR A GIVEN
*         LOGICAL EXPRESSION-- C1.OP.C2 
* 
*         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 
  
 CBC.PL   PL     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR .MI.C1 
  
 CBC.MI   MI     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR .ZR.C1 
  
 CBC.ZR   ZR     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR .NZ.C1 
  
 CBC.NZ   NZ     X1,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.EQ.C2 
  
 CBC.EQ   ZR     X3,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.NE.C2 
  
 CBC.NE   NZ     X3,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.LT.C2 
  
 CBC.LT   MI     X6,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.GE.C2 
  
 CBC.GE   PL     X6,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.LE.C2 
  
 CBC.LE   PL     X7,EXIT.    IF TRUE
          EQ     CBC2 
  
*         HERE FOR C1.GT.C2 
  
 CBC.GT   MI     X7,EXIT.    IF TRUE
          EQ     CBC2 
  
 CBC.LOP  =      *           DEFINE LAST OP 
          LOC    *O 
  
*         HERE FOR CONDITION NOT SATISFIED (FALSE). 
  
 CBC2     SB6    B0 
          EQ     EXIT.
 CHK      SPACE  4,10 
 .IDPOS   ENDIF 
**        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) 
* 
*         CALLS  MEMORY 
  
  
 CHK      SUBR               ** ENTRY/EXIT ** 
  
          SX2    =YCP.NFLS
          MI     B2,EXIT.    IF ADDR BAD TO START WITH
          MI     X2,CHK2     IF USER IS NOT DOING OWN MEMORY MGMT 
          SA1    IDPFLG 
          LX1    59-IDF.MEMP
          MI     X1,CHK3     IF USER HAS SELECTED *OPT MEM* 
          SA1    X2          (X1) = CURRENT NOMINAL FL SCM
          EQ     CHK4 
  
 CHK2     SA1    RA.LWP 
          MI     B2,EXIT.    IF ADDR IS BAD 
          SX1    X1          EXTEND SIGN BIT
          PL     X1,CHK3     IF CMM NOT ACTIVE
          BX1    -X1         (X1) = DABA
          SA1    X1          (X1) = 42/STUFF,18/FL SCM
          SX2    B2 
          SX1    X1          (X1) = FL SCM
          IX2    X2-X1       (X2) = ADDR - FL 
          MI     X2,EXIT.    IF ADDR LT FL
  
 CHK3     BX2    X6          SAVE X6 ACROSS MEMORY MACRO
          SX6    A6 
          SA6    CHKB        SAVE A6 ACROSS MEMORY MACRO
          MX6    0
          SA6    CHKA        CLEAR MEM REQUEST WORD 
          MEMORY CM,CHKA,RCL    REQUEST CURRENT FIELD LENGTH
          SA1    CHKB        (X1) = SAVED A6
          SA1    X1          (X1) = ((A6))
          BX6    X1 
          SA6    A1          RESTORE A6 
          BX6    X2          RESTORE X6 
          SA1    CHKA        (X1) = 30/FL SCM,30/STUFF
          AX1    30D         (X1) = FL SCM
  
 CHK4     SX2    B2 
          IX2    X2-X1
          MI     X2,EXIT.    IF ADDR OK 
          SB2    -B2         SET TO *ADDR IS BAD* 
          EQ     EXIT.
  
  
 CHKA     BSSZ   1           REQUEST WORD FOR MEMORY MACRO
 CHKB     BSSZ   1           FOR SAVING A6 ACROSS MEMORY MACRO
 CIB      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        CIB - CONVERT UNSIGNED INTEGER TO BINARY. 
* 
* 
*         *CIB* CONVERTS A STREAM OF *O.CONS* TOKENS TO A BINARY NUMBER 
*         VIA A CALLER-SPECIFIED BASE CONVERSION. 
* 
*         ENTRY  (A5,X5) = A+C OF 1ST *O.CONS* TOKEN. 
*                (X1) = DEFAULT BASE.  (X1) CAN BE IN THE RANGE --
* 
*                          1 .LT. (X1) .LT 36D
* 
*         EXIT   (B2) = .ZR. IF NO ERROR, ELSE .NZ. 
*                (X6) = BINARY NUMBER, ELSE .ZR. IF ERROR ((B2) .NZ.).
*                (A5+1) = ADDR OF 1ST TOKEN FOLLOWING *CONS*. 
* 
*         USES   X - 1,2,3,4,5,6,7
*                A - 1,2,5,6,7
*                B - 2,3,4
* 
*         CALLS  MUL
  
  
 CIB      SUBR               ** ENTRY/EXIT ** 
          SX6    X1 
          MX7    0
          SA6    CIBA        SAVE (X1) = BASE 
          SA7    CIBC        SET TO *NO EXPLICIT BASE SO FAR* 
          SB2    X5-O.CONS
          NZ     B2,SE.CONS  IF ERROR ON ENTRY
  
*         CHECK FOR -B- (OCTAL) OR -D- (DECIMAL) SUFFIX.
  
 CIB2     SA5    A5+1 
          SX7    X5-O.CONS
          ZR     X7,CIB2     IF STILL *CONS* TOKEN
  
          SB3    A5+         SAVE (A5) = LWA+1 OF *CONS*
          SB2    X5-O.VAR 
          NZ     B2,CIB4     IF NOT *VAR*, NO -B/D- SUFFIX... 
  
          MX2    -CHAR
          MX3    TB.TOCL
          BX4    X3*X5       (X4) = CHARS IN *VAR*, -L- FMT 
          LX5    CHAR 
          BX3    -X2*X5      (X3) = 1ST CHAR IN *VAR*, -R- FMT
          MX2    CHAR 
          BX1    -X2*X4 
          NZ     X1,CIB4     IF *VAR* LONGER THAN 1 CHAR, NO -B/D-... 
          SB2    X3-1RB 
          SX7    8           SET TO *OCTAL* 
          ZR     B2,CIB3     IF -B- SUFFIX
  
          SB2    X3-1RD 
          SX7    10D         SET TO *DECIMAL* 
          NZ     B2,CIB4     IF NO -D- SUFFIX 
  
 CIB3     SA7    CIBA        SAVE EXPLICIT BASE 
          SA7    CIBC        SET TO *EXPLICIT BASE OCCURRED*
          SB3    B3+1 
  
*         CHECK BASE. 
  
 CIB4     SA1    CIBA        (X1) = BASE
          SX2    X1-2 
          SX3    X1-36
          MI     X2,CIB10    IF BASE .LT. 2, ERROR... 
          PL     X3,CIB10    IF BASE .GT. 35, ERROR...
  
*         INITIALIZE FOR CONVERSION LOOP. 
  
          BX6    X6-X6       CLEAR (X6) = BINARY ACCUMULATOR
          SX7    B1 
          SA7    CIBB        INITIALIZE BASE**N ACCUMULATOR,
*                            I.E. BASE**0 = 1 
          SB2    0           SET TO *NO ERROR SO FAR* 
          SB4    20D         (B4) = MAX NR OF DIGITS TO CONVERT 
  
*         MAIN LOOP NODE FOR DIGIT-BY-DIGIT CONVERSION. 
* 
*           1. CONVERT NEXT DIGIT TO BINARY, CHECKING FOR DIGIT 
*              VALIDITY ALONG THE WAY.
* 
*           2. SCALE THIS DIGIT BY MULTIPLYING IT BY APPROPRIATE
*              POWER OF BASE. 
* 
*           3. ADD RESULTANT SCALED DIGIT INTO ACCUMULATOR. 
  
 CIB5     SA5    A5-1 
          SX7    X5-O.CONS
          NZ     X7,CIB11    IF NOT *CONS*, DONE... 
          MX4    TB.TOCL
          BX5    X4*X5       (X5) = CHARS IN *CONS*, -L- FMT
  
 CIB6     AX5    CHAR 
          MX4    -CHAR
          ZR     X5,CIB5     IF (X5) EXHAUSTED
          BX4    -X4*X5      (X4) = NEXT CHAR, -R- FMT
          ZR     X4,CIB6     IF NULL (00B) CHARACTER, IGNORE... 
          SB4    B4-B1
          LT     B4,B0,CIB10 IF TRYING TO CONVERT TOO MANY DIGITS 
          SX7    X4-1R9-1 
          PL     X7,CIB10    IF DIGIT .GT. 1R9
          SX3    X4-1R0      (X3) = BINARY VALUE FOR THIS DIGIT 
          PL     X3,CIB7     IF 1R0 .LE. DIGIT .LE. 1R9 
          SX3    X4-1RA+10   (X3) = BINARY VALUE FOR THIS DIGIT 
  
 CIB7     SA1    CIBA        (X1) = BASE
          SA2    CIBB        (X2) = BASE**N ACCUMULATOR 
          IX4    X3-X1       (X4) = DIGIT - BASE
          MI     X4,CIB9     IF DIGIT .LT. BASE 
  
*         HERE IF DIGIT TOO BIG FOR BASE. 
  
          SA3    CIBC        (X3) = .NZ. IF EXPLICIT BASE OCCURRED, ELSE .ZR. 
          SX7    X1-8 
          NZ     X3,CIB10    IF EXPLICIT BASE, ERROR... 
          NZ     X7,CIB10    IF NOT BASE 8, ERROR...
  
*         HERE IF OCTAL WITH DIGIT .GE. 8.  TRY DECIMAL.
  
          SX6    10D
          SA6    CIBA        SET TO *DECIMAL CONVERSION*
          SA5    B3 
          EQ     CIB4 
  
*         HERE TO SCALE DIGIT.
  
 CIB9     SX1    X3          (X1) = DIGIT 
          RJ     MUL         INTEGER MULTIPLY (DIGIT*(BASE**N)) 
          IX6    X6+X7
          SA1    CIBA        (X1) = BASE
          SA2    CIBB        (X2) = BASE**N ACCUMULATOR 
          RJ     MUL         INTEGER MULTIPLY (BASE*(BASE**N))
          SA7    A2          SAVE (X7) = BASE**(N+1)
          EQ     CIB6 
  
*         HERE IF AN ERROR. 
  
 CIB10    BX6    X6-X6
          SB2    B1          SET TO *ERROR OCCURRED*
  
*         HERE WHEN READY TO EXIT.
  
 CIB11    SA5    B3-1        (A5) = ADDR OF LAST/FINAL TOKEN IN CONSTANT
          EQ     EXIT.
  
  
 CIBA     BSSZ   1           SAVED BASE 
 CIBB     BSSZ   1           SAVED BASE**N ACCUMULATOR
 CIBC     BSSZ   1           .NZ. IF EXPLICIT BASE OCCURRED, ELSE .ZR.
 CLZ      SPACE  4,10 
**        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,10 
**        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 
          RETURN X1,RCL 
          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 
          RETURN X1,RCL 
          EQ     EXIT.
  
  
 CONA     BSSZ   1           SAVED FWA OF FET 
 #OS3     ENDIF 
 CST      SPACE  4,10 
**        CST - CLASSIFY STMT.
* 
* 
*         *CST* PERFORMS THE TASK OF DETERMINING WHICH STMT 
*         PROCESSOR IS TO PROCESS THE NEXT STMT IN THE TOKEN
*         BUFFER. 
* 
*         ENTRY  (A5,X5) = A+C OF NEXT TOKEN TO TRY AND FIND A KEYWORD
*                          MATCH FOR. 
* 
*         EXIT   (X6) = .NZ. IF ADDR OF FOUND *KEYW* ENTRY, ELSE
*                     = .ZR. IF NO FIND.
* 
*                IF A FIND, (X6) .NZ. --
* 
*                (A5,X5) = A+C OF TOKEN IMMEDIATELY FOLLOWING KEYWORD.
* 
*         USES   ALL BUT A0 
* 
*         CALLS  CHK,SFN
  
  
 CST      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
* 
*         WE FIRST NEED TO VERIFY THAT THE 1ST KEYWORD TABLE IS 
*         IN FACT AVAILABLE, AND IF NOT, WE MAKE SURE THAT AT 
*         LEAST IDP.S ORIGINAL KEYWORD TABLE (I.E. THE ONLY ONE 
*         WE HAPPEN TO KNOW THE LOCATION OF) IS MADE AVAILABLE
*         SO THAT THE USER IS NOT LEFT WITH HIS OR HER PANTS DOWN.
  
          SA1    FW=KEY      (X1) = FWA OF 1ST KEYWORD TABLE
          SB2    X1 
          SB4    X5          (B4) = TOKEN TYPE OF 1ST TOKEN TO CHECK
          SB5    A5          SAVE ORIGINAL (A5) 
          SB6    X1 
          SB4    -B4         (BECAUSE THERE IS NO SX.I X.J-B.K) 
          RJ     CHK         CHECK CM ADDR
          PL     B2,CST3     IF 1ST KEYWORD TABLE IS AVAILABLE
          SX6    FW.KEY      (X6) = FWA OF IDP.S OWN KEYWORD TABLE
          SA6    FW=KEY 
          EQ     SE.KEY      ** 1ST KEYWORD TABLE OUT-OF-RANGE ** 
  
*         HERE TO CHECK LINK TO NEXT KEYWORD TABLE. 
  
 CST2     SA2    B6+B1       (X2) = LINK WORD 
          SB2    X2          (B2) = ADDR OF NEXT KEYWORD TABLE
          ZR     X2,CST7     IF END-OF-ALL KEYWORD TABLES, NO FIND... 
          RJ     CHK         CHECK CM ADDR
          MI     B2,SE.KEY   IF NEXT KEYWORD TABLE IS OUT-OF-RANGE
          SB6    B2          (B6) = FWA OF NEXT KEYWORD TABLE 
          BX1    X7*X5       RESTORE (X1) = CHARS TO SEARCH FOR, -L- FMT
          EQ     CST4 
  
*         KEYW TABLE SEARCH MAIN LOOP NODE. 
* 
*         READY TO SCAN TOKEN(S) FOR A KEYWORD MATCH. 
  
 CST3     SA5    B5          (A5,X5) = A+C OF 1ST TOKEN TO SEARCH FOR 
          SX6    X5+B4
          NZ     X6,CST7     IF TOKEN TYPES DO NOT MATCH, NO FIND...
          MX2    TB.TOCL
          BX1    X2*X5       (X1) = CHARS IN 1ST *VAR* TOKEN
          RJ     =XSFN       SPACE FILL NAME
          BX1    X7*X6       (X1) = CHARS IN 1ST *VAR* TOKEN, -L- FMT 
  
*         SEARCH KEYWORD TABLE FOR A MATCH OF CURRENT *VAR* TOKEN.
  
 CST4     SA2    B6          (X2) = KEYWORD TABLE ENTRY, WORD 1 
          ZR     X2,CST2     IF END-OF-TABLE, TRY NEXT TABLE... 
          LX2    0-KW.KEYP
          SA4    X2          (X4) = 1ST WORD OF KEYWORD LITERAL, -L- FMT
          SB6    B6+2 
          LX2    0-KW.LENP+KW.KEYP-0
          MX3    -KW.LENL 
          BX6    -X3*X2      (X6) = NR OF BITS IN THIS KEYWORD
          SB7    X6 
  
 CST5     LE     B7,B0,CST3  IF NOTHING LEFT IN KEYWORD LITERAL 
          BX6    X7*X4
          IX3    X1-X6
          NZ     X3,CST3     IF NO MATCH, TRY NEXT *KEYW* ENTRY...
  
*         HERE TO SET UP FOR NEXT *VAR* TOKEN.
  
          SA5    A5+B1       (A5,X5) = A+C OF NEXT *VAR* TO SEARCH FOR
          MX2    TB.TOCL
          BX1    X2*X5       (X1) = CHARS IN NEXT *VAR* TOKEN, -L- FMT
          SX6    X5+B4
          NZ     X6,CST6     IF TOKEN TYPES DO NOT MATCH, FIND... 
          RJ     =XSFN       SPACE FILL NAME
          SA4    A4+B1       (X4) = NEXT KEYWORD LITERAL, -L- FMT 
          BX1    X7*X6       (X1) = CHARS IN NEXT *VAR* TOKEN, -L- FMT
          SB7    B7-TB.TOCL  (B7) = NR OF BITS REMAINING IN THIS KEYWORD
          EQ     CST5 
  
*         HERE IF WE HAVE A FIND.  SET UP EXIT CONDITIONS.
  
 CST6     SX6    B6-2        (X6) = ADDR OF FOUND *KEYW* ENTRY
          EQ     EXIT.
  
*         HERE IF NO FIND.  SET UP EXIT CONDITIONS. 
  
 CST7     BX6    X6-X6       SET TO *NO FIND* 
          EQ     EXIT.
 .IDPOS   ENDIF 
 CXR      SPACE  4,10 
**        CXR - CHECK EXECUTIVE RJ. 
* 
* 
*         *CXR* FIGURES OUT WHETHER THE *RJ* TO AN IDP EXECUTIVE
*         HAS A PARAMETER LIST ASSOCIATED WITH IT.
* 
*         ENTRY  (X1) = ADDR OF EXECUTIVE 
*                (X2) = ADDR OF CALLING *RJ*
* 
*         EXIT   (B2) = ADDR OF PARAMETER LIST, IF THERE IS ONE.
*                     = .ZR. IF SPECIAL 
*                              +  RJ  XEC 
*                              -  VFD 30/0
*                     = .MI. IF NO PARAMETER LIST 
* 
*         USES   X - 1,2,3,4,6,7
*                A - 1,2,3,6
*                B - 2
* 
*         CALLS  CHK
  
  
 CXR      SUBR               ** ENTRY/EXIT ** 
          SA3    CXRA        (X3) = *RJ-FORCED-UPPER* SKELETON
          LX1    30 
          SX6    X2 
          BX1    X1+X3       (X1) = 30/RJ XEC,30/0
          SA6    ADR=RJ 
          SA2    X2          (A2,X2) = A+C OF WORD CONTAINING CALLING RJ
          IX7    X1-X2
          MX3    30 
          SB2    B0 
          BX4    X3*X2       (X4) = UPPER 30 BITS OF WORD CONTAINING RJ 
          ZR     X7,EXIT.    IF SPECIAL 30/RJ XEC,30/0 FORM 
          IX7    X1-X4
          SB2    -B1         SET TO *NO PARAMETER LIST* 
          NZ     X7,EXIT.    IF NO PARAMETER LIST 
          BX4    -X3*X2      (X4) = LOWER 30 BITS OF WORD CONTAINING RJ 
          SX2    X2          (X2) = POSSIBLE PARAMETER LIST ADDR
          IX7    X4-X2
          NZ     X7,EXIT.    IF LOWER 30 BITS CONTAIN MORE THAN AN ADDR 
          SB2    X2 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,EXIT.    IF PARAMETER LIST ADDR IS BAD
          SA1    B2          (A1,X1) = A+C OF 1ST WORD OF PARAMETER LIST
          MX2    12 
          BX7    X2*X1       (X7) = UPPER 12 BITS OF 1ST WORD OF PARM 
          ZR     X7,EXIT.    IF PARAMETER LIST LOOKS OK 
          SB2    -B1         SET TO *NO PARAMETER LIST* 
          EQ     EXIT.
  
  
 CXRA     RJ     0
 -        VFD    30/0 
 DAB      SPACE  4,10 
**        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,10 
**        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 
 DAZ      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        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
  
  
 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)
          SX1    A5          (X1) = ADDR OF INSTRUCTION TO DEASSEMBLE 
          RJ     CAD         CONVERT ADDR TO DPC
          SB4    X0+         RESTORE (B4) 
  
*         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+1 
  
*         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+1 
  
*         GENERATE RELATIVE ADDRESS.
  
          SA1    DAZ=ADR
          SA2    =10H 
          SB3    SNAPLNE+5
          SB2    A6 
          SA0    B4          SAVE (B4)
          SX0    B5+         SAVE (B5)
          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 
          RJ     FRA         FIND RELATIVE ADDRESS
          MI     B7,DAZ11C   IF USER DID NOT PROVIDE *FRA=* 
  
          SA1    A6          (X1) = XX........   .=BLANK(55B) 
*                              X=DIFFERENT CHARS DEPENDING ON DEASSEMBLY
          MX2    3*CHAR 
          BX1    X2*X1       (X1) = XX.0000000   (.=BLANK(55B),0=00B) 
          LX6    -3*CHAR
          BX6    -X2*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
  
*         FINAL PROCESSING AND EXIT.
  
 DAZ11C   MX6    0
          SA6    A6+B1
          PRIDP  =XSNAPLNE
          SB4    A0          RESTORE (B4) 
          SB5    X0          RESTORE (B5) 
          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,10 
**        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,10 
**        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
 DCM      SPACE  4,10 
 .IDPOS   ENDIF 
**        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 
*                   ******************************
*         N = ADDR OF 1ST WORD DUMPED ON LINE 
*         + = + IF *NNNNNN* IS DECK RELATIVE, ELSE
*           = BLANK(55B) IF *NNNNNN* IS ABSOLUTE ADDR.
*         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) 
* 
*         CALLS  CAD,FLL,PRIDP,WOD
  
  
 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
          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.
 DOD      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        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
*         N = ADDR OF WORD DUMPED 
*         + = + IF *NNNNNN* IS DECK RELATIVE, ELSE
*           = BLANK(55B) IF *NNNNNN* IS ABSOLUTE ADDR.
*         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)
* 
*         CALLS  CAD,FLL,PRIDP,WOD,ZTB
  
  
 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
          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 
          BX6    X1 
          SA6    A7+B1
  
          SA1    A0+         (X1) = WORD TO BE DUMPED 
          RJ     =XZTB       CONVERT ZEROES TO BLANKS 
          SA6    A6+1 
  
          BX6    X6-X6
          SA6    A6+B1       MARK EOL 
          PRIDP  SNAPLNE
          EQ     DOD2 
 .IDPOS   ENDIF 
 DSR      SPACE  4,10 
**        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
*                IDP=SVB = FWA OF REGISTER SAVE AREA
* 
*         PARAMETER LIST FORMAT-- 
* 
*         VFD    60/IDP=SVB+0TR 
*         VFD    60/IDP=SVB+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    IDP=SVB
          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,10 
**        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,ZTB
  
  
 DUX      SUBR               ** ENTRY/EXIT ** 
          SA2    DUXA 
          SX7    B4-20B      (X7) = X REGISTER NR 
          SA1    IDP=SVX+X7   (X1) = SAVED -X- REGISTER 
          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 
          BX6    X1 
          SA6    A7+B1
  
          SA1    IDP=SVB+B4  (X1) = SAVED CONTENTS OF X-N-
          RJ     =XZTB       CONVERT ZEROES TO BLANKS 
          SA6    A6+1 
  
          BX6    X6-X6
          SA6    A6+B1       MARK EOL 
          PRIDP  SNAPLNE
          EQ     EXIT.
  
  
 DUXA     DATA   10H       X0 
 FAA      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        FAA - FIND ABSOLUTE ADDRESS.
* 
* 
*         THIS ROUTINE TRIES TO ASSOCIATE A BINARY ADDR/NUMBER
*         WITH A GIVEN NAME IN -L- FORMAT.  THIS IS USED BY IDP 
*         WHEN THE PROGRAMMER ENTERS, FOR EXAMPLE, A DECK NAME. 
* 
*         E.G. -- 
* 
*             CODE DECK+1123
* 
*         *FAA* TRIES TO ASSOCIATE A BINARY VALUE WITH *DECK* 
*         IN THE FOLLOWING MANNER --
* 
*           1. IF THE USER PROVIDED AN *FAA=*, THEN THIS *FAA*
*              ASSUMES THAT THE USER WISHES TO PERFORM HIS OWN
*              ADDR TRANSLATION.  THEREFORE, *FAA* MERELY CALLS *FAA=*. 
* 
*           2. IF THE HOST IS USING *CCOMRPV* (COMMON REPRIEVE
*              PROCESSOR), THEN *FAA* WILL ATTEMPT TO QUERY THE LINKED
*              TABLES USED BY *CCOMRPV* THAT CONTAIN ALL THE ROUTINE
*              NAMES AND FWAS.  SEE *CCOMRPV* FOR DETAILS.
* 
*         ENTRY  (X0) = MASK TO EXTRACT NAMES, I.E. MX0 7*CHAR. 
*                (X1) = NAME TO SEARCH FOR, IN -L- FMT. 
* 
*         EXIT   (X6) = .PL. IF ABS ADDR IDP IS TO USE FOR *NAME*.
*                     = .MI. IF NO ADDR KNOWN FOR *NAME* (I.E. NO FIND).
* 
*         USES   CANNOT DESTROY A0,A5,X5
* 
*         CALLS  FAA=(IF AVAIL) 
  
  
 FAA      SUBR               ** ENTRY/EXIT ** 
          SX6    =YFAA= 
          SB2    =YRPV=RNA
          MI     X6,FAA2     IF USER DID NOT PROVIDE *FAA=* 
          RJ     =YFAA=      FIND ABSOLUTE ADDRESS
          EQ     EXIT.
  
 FAA2     MI     B2,EXIT.    IF USER IS NOT USING *CCOMRPV* 
          SA2    B2          (X2) = FWA OF 1ST RNA TABLE
          SA2    X2          (A2,X2) = A+C OF 1ST RPV NAME ADDR ENTRY 
  
 FAA3     ZR     X2,FAA4     IF END-OF-TABLE ENCOUNTERED
          BX7    X0*X2       (X7) = NAME IN *RPV* TABLE, -L- FMT
          IX3    X7-X1
          ZR     X3,FAA5     IF A HIT 
          SA2    A2+B1
          EQ     FAA3 
  
 FAA4     SA3    A2+B1       (X3) = LINK TO NEXT TABLE, ELSE .ZR. 
          ZR     X3,EXIT.    IF END OF ALL TABLES ENCOUNTERED 
          SA2    X3          (A2,X2) = A+C OF 1ST ENTRY IN NEXT TABLE 
          EQ     FAA3 
  
 FAA5     SX6    X2          (X6) = ABS ADDR FOR THIS NAME
          EQ     EXIT.
 .IDPOS   ENDIF 
 FAB      SPACE  4,10 
**        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    IDP=SVB+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,10 
**        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.
* 
*                IF FWA,LWA,LEN IS OK, (B2) .PL. -- 
* 
*                (X2) = FWA.
*                (X3) = LWA.
*                (X4) = LEN.
*                (AP=FWA) = FWA 
*                (AP=LWA) = LWA 
*                (AP=LEN) = LEN 
* 
*         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 
          SX1    X6+B2       (X1) = FWA + LEN 
          SX6    B2          (X6) = LEN 
          SB2    X1-1        (B2) = LWA 
          SA6    AP=LEN 
          RJ     CHK         CHECK CM ADDR
          MI     B2,EXIT.    IF LWA IS BAD
          SX6    B2+         SAVE (B2) = LWA
          SA6    AP=LWA 
          EQ     FLL4 
  
*         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
          SA1    AP=FWA 
          SX6    B2          SAVE (B2) = LWA
          IX2    X6-X1
          SA6    A6+1 
          SX6    X2+1        (X6) = LEN 
          SA6    A6+1 
  
*         SET UP EXIT CONDITIONS. 
  
 FLL4     SA2    AP=FWA      (X2) = FWA 
          SA1    A2+B1
          BX3    X1          (X3) = LWA 
          SA1    A1+B1
          BX4    X1          (X4) = LEN 
          EQ     EXIT.
 FOF      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        FOF - FLUSH OUTPUT FILE.
* 
* 
*         *FOF* CONDITIONALLY FLUSHES AN OUTPUT FILE, BASED ON
*         WHETHER THERE IS ANYTHING IN THE BUFFER FOR THAT FILE,
*         I.E. IF *IN .NE. OUT*.
* 
*         ENTRY  (B2) = FWA OF FET. 
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT A0,X0,A5,X5     (INCLUDES ALL CALLS) 
* 
*         CALLS  WRITER 
  
  
 FOF      SUBR               ** ENTRY/EXIT ** 
          MI     B2,EXIT.    IF FET NOT DEFINED 
          SA1    B2+2        (X1) = IN
          SA2    A1+B1       (X2) = OUT 
          IX7    X1-X2
          ZR     X7,EXIT.    IF IN = OUT, NOTHING TO FLUSH... 
          WRITER B2,,RCL
          EQ     EXIT.
 .IDPOS   ENDIF 
 FRA      SPACE  4,10 
**        FRA - FIND RELATIVE ADDRESS.
* 
* 
*         *FRA* IS USED THROUGHOUT IDP WHENEVER HE WOULD LIKE TO
*         OUTPUT AN ABSOLUTE ADDRESS IN A DECK-RELATIVE FORM (FOR 
*         READABILITY/UNDERSTANDABILITY BY A HUMAN).
* 
*         *FRA* TRIES TO PRODUCE A STRING OF THE FORM-- 
* 
*                NNNNNN.IN.XXXXXXXX00 
* 
*         WHERE  N = CONVERTED DPC RELATIVE ADDR DIGITS.
*                X = DECK NAME. 
*                0 = 00B, I.E. EOL BITS.
*                . = 55B, I.E. BLANKS.
* 
*         FOR EXAMPLE, GIVEN A DECK CALLED *IDP* THAT HAS ITS FWA AT
*         ABS ADDR 4000, THEN A CALL TO *FRA* WITH ABS ADDR 4222
*         MIGHT PRODUCE --
* 
*                222    IN IDP
* 
*         *FRA* TRIES TO DO HIS JOB IN THE FOLLOWING WAYS-- 
* 
*           1. IF THE USER PROVIDED AN *FRA=* (VIA =Y), THEN THIS *FRA* 
*              WILL CALL IT.  THAT IS, THE USER'S *FRA=* TAKES
*              PRECEDENCE.
* 
*           2. IF THE USER PROVIDED AN *RNA* (ROUTINE NAME/ADDRESS) 
*              TABLE, THEN THIS *FRA* WILL USE/SEARCH IT. 
* 
*              *FRA* DETECTS THE PRESENCE/ABSENCE OF AN *RNA* TABLE 
*              VIA THE PRESENCE/ABSENCE OF THE CELL *RPV=RNA* (VIA =Y). 
*              IF *RPV=RNA* IS PROVIDED, THEN IT IS A CELL THAT 
*              **CONTAINS** THE FWA OF THE *RNA* TABLE. 
* 
*              NOTE THAT THE SYMBOL NAME *RPV=RNA* IS FOR COMPATABILITY 
*              WITH *CCOMRPV* (COMPILER COMMON REPRIEVE PROCESSOR). 
* 
*              AN *RNA* TABLE HAS THE FOLLOWING FORM--
* 
*                  42/0LDECK1,18/FWA OF DECK1 
*                  42/0LDECK2,18/FWA OF DECK2 
*                            .
*                            .
*                  42/0LDECKN,18/FWA OF DECKN 
*                  60/0    END OF TABLE MARK
*                  60/LINK TO NEXT *RNA* TABLE, ELSE
*                     .ZR. IF END OF ALL TABLES.
* 
*              *RNA* TABLES MAY BE LINKED TO ACCOMODATE OVERLAYED HOST
*              PROGRAMS.
* 
*              NOTE THAT *RNA* TABLE(S) DO **NOT** HAVE TO BE ORDERED 
*              IN DECK-ASCENDING ORDER.  *FRA* SEARCHS FOR THE
*              **CLOSEST** OCCURENCE. 
* 
*              NOTE ALSO THAT *FRA* CHECKS TO SEE IF (RPV=RNA) IS 
*              IN FL, VIA *CHK* (CHECK CM ADDRESS), BEFORE USING
*              IT.  IN THIS WAY, THE HOST PROGRAM CAN IF IT WISHS 
*              SELECT/DESELECT *RNA* TABLES BY MERELY SETTING 
*              (RPV=RNA) OUT-OF-RANGE (E.G. .MI.).
* 
*           3. IF NEITHER OF THE ABOVE CONDITIONS ARE SATISFIED, THEN 
*              *FRA* DOESNT/CANT DO ANYTHING... 
* 
*         ENTRY  (X1) = BINARY ABS ADDR TO FIND.
* 
*         ENTRY  IF *FRA* COULD FIND A DECK-RELATIVE ADDR-- 
* 
*                (B7) = .PL. TO INDICATE THAT *FRA* FOUND A DECK
*                            RELATIVE ADDRESS.
*                (X6) = NNNNNN.IN.
*                (X7) = XXXXXXXX00     (SEE PREAMBLE ABOVE FOR DETAILS) 
* 
*                IF *FRA* COULD NOT FIND A DECK RELATIVE ADDR-- 
* 
*                (B7) = .MI. TO INDICATE THAT *FRA* COULD NOT 
*                            FIND A DECK RELATIVE ADDRESS.
*                (X1) = AS ON ENTRY.
*                (X6) = +0. 
*                (X7) = +0. 
* 
*         USES   ALL BUT A0,X0,A5,X5,A6 
* 
*         CALLS  CHK,COD,FRA=(IF AVAIL) 
  
  
 FRA      SUBR               ** ENTRY/EXIT ** 
          SB6    X1+         SAVE (X1)
          SB7    =YFRA= 
          BX6    X6-X6
          MX7    0
          MI     B7,FRA1     IF USER DID NOT PROVIDE *FRA=* 
          SB7    EXIT.       (B7) = RETURN ADDR FOR *FRA=*
          EQ     =YFRA=      FIND RELATIVE ADDRESS
  
*         HERE TO TRY *RNA* TABLE(S). 
  
 FRA1     SB2    =YRPV=RNA
          RJ     CHK         CHECK CM ADDRESS 
          SB7    B2+
          MI     B7,EXIT.    IF USER DID NOT PROVIDE *RNA* TABLE
  
          SA2    =YRPV=RNA   (X2) = FWA OF 1ST RNA TABLE
          SB2    B6          (B2) = ADDRESS RELATIVE TO RA+0
          SA2    X2          (A2,X2) = A+C OF 1ST ENTRY IN RNA TABLE
          SB3    X2 
          SB4    B0 
          SB5    A2+
  
*         SEARCH ROUTINE NAME ADDRESS TABLE.
  
 FRA2     BSS 
          ZR     X2,FRA3     IF END OF BLOCK
          SB3    X2 
          SA2    A2+B1       (X2) = NEXT TABLE ENTRY
          GT     B3,B2,FRA2  IF CURRENT ENTRY BEYOND ABS ADDR 
          GE     B4,B3,FRA2  IF CURRENT NOT CLOSER
          SB5    A2-B1       CLOSEST SO FAR 
          SB4    B3 
          EQ     FRA2        KEEP LOOKING 
  
*         CHECK FOR TABLE CONTINUATION LINK.
  
 FRA3     BSS 
          SA2    A2+B1       END OF TABLE/TABLE LINK WORD 
          ZR     X2,FRA4     IF END OF TABLE
          SA2    X2          (A2,X2) = A+C OF 1ST WORD IN NEXT BLOCK
          EQ     FRA2        CONTINUE TABLE SEARCH... 
  
*         EXTRACT ROUTINE NAME AND FORMAT ABSOLUTE ADDRESS. 
  
 FRA4     BSS 
          SX1    B2-B4       (X1) = BIN ADDR, RELATIVE TO CLOSEST FIND
          RJ     =XCOD       CONVERT TO OCTAL DISPLAY CODE
          SA1    B5          (X1) = 42/0LNAME,18/ADDRESS
          MX7    42 
          SX3    2R  &2RIN
          BX7    X7*X1       (X7) = ROUTINE NAME, 0L FORMAT 
          LX3    6
          BX6    X4-X3       (X6) = RELATIVE ADDRESS, *NNNNNN IN *
          EQ     EXIT.
 FRK      SPACE  4,10 
**        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...
 FRZ      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        FRZ - FREEZE INTERACTIVE SESSION. 
* 
* 
*         PERFORMS A CHECKPOINT OF AN INTERACTIVE SESSION BY
*         WRITING THE CURRENT CORE IMAGE TO LFN *F.FRZ* IN A
*         SPECIAL FORMAT. 
* 
*         *F.FRZ* FORMAT -- 
* 
*           RECORD 1 CONSISTS OF A LOADER ABSOLUTE BINARY, CALLED *IFR* 
*           (IDP FREEZE RESTART), THAT WHEN EXECUTED WILL READ THE
*           FROZEN HOST BACK INTO CORE (OVERLAYING ITSELF), AND 
*           THEN REINVOKE *IDP*.
* 
*           RECORD 2 CONTAINS THE CORE IMAGE OF THE FROZEN HOST.
* 
*         SEE ROUTINE *IFR* IN DATA SECTION BEGINNING AT ADDR *FW.IFR*. 
* 
*         ENTRY  NONE 
* 
*         EXIT   *F.FRZ* WRITTEN
* 
*         USES   ALL BUT A0,X0,A5,X5   (INCLUDES ALL CALLS) 
* 
*         CALLS  MEMORY,REWIND,WRITER,WRITEW
  
  
 FRZ      SUBR               ** ENTRY/EXIT ** 
  
*         FIND OUT ACTUAL FIELD LENGTH SCM (AFLS) SO THAT *IFR* 
*         CAN KNOW HOW MUCH IS NEEDED TO RESTART.  IF *CMM* IS ACTIVE,
*         SAVE THIS KNOWLEDGE SO THAT *IFR* CAN INDICATE SO 
*         TO OPERATING SYSTEM.
  
          SA1    RA.LWP 
          BX6    X6-X6
          SX7    X1          (X7) = .MI. IF *CMM* ACTIVE, ELSE .PL. 
          SA6    MEM#HOST 
          MEMORY SCM,A6,RCL 
          SX2    B1 
          AX7    59          (X7) = -0 IF *CMM* ACTIVE, ELSE +0 
          SA1    MEM#HOST 
          BX7    X2*X7       (X7) = 1 IF *CMM* ACTIVE, ELSE +0
          LX7    2-0
          SX7    X7+B1       SET BIT 1S0
          BX6    X1-X7       SET *CMM* IF APPROPRIATE/CLEAR COMPLETE BIT
          SA6    A1 
  
*         NEED TO SAVE 3 SPECIAL WORDS BECAUSE WE ARE ONLY WRITING
*         FROM *RA.MTR+1* TO FL-2 TO *F.FRZ*. 
*           1. SAVE (RA.SSW) BECAUSE APPARENTLY *CIO* WILL SOMETIMES
*              NOT ALLOW ONE TO HAVE *RA.MTR* IN CIO BUFFER AREA. 
*           2. SAVE WORDS AT FL-1 AND FL-2 BECAUSE LWA AND LWA+1 OF CIO 
*              BUFFER ARE NOT WRITTEN.
  
          AX1    30          (X1) = AFLS OF FROZEN HOST 
          SA2    RA.SSW 
          SA3    X1-2 
          SA4    A3+B1
          BX6    X2 
          LX7    X3 
          SA6    FRZ#SAV
          SA7    A6+B1
          BX6    X4 
          SA6    A7+B1
  
*         SET UP AND *OPEN* *F.FRZ* FET FOR RECORD 1 WRITE. 
*         FIRST, THOUGH, WE NEED TO SET THE *COMPLETE* BIT
*         IN *F.FRZ* FET BECAUSE IF WE ARE NOW FREEZING AN
*         INTERACTIVE SESSION THAT WAS PREVIOUSLY FROZEN AND UNFROZEN,
*         THEN *F.FRZ* IS MARKED AS STILL BEING ACTIVE.  THIS HAPPENS 
*         BECAUSE WHEN THE PREVIOUS SESSION WAS FROZEN, *F.FRZ* WAS 
*         USED TO WRITE ITSELF OUT, AND WAS THEREFORE STILL ACTIVE WHEN 
*         CORE IMAGE WAS WRITTEN TO DISK. 
  
          SA1    F.FRZ
          MX2    -1 
          BX6    -X2+X1      SET COMPLETE BIT 
          SA6    A1 
  
          SX6    FW.IFR 
          SX7    FW.IFR+L.IFR-1 
          SA6    A6+B1       FIRST  = FW.IFR
          SA7    A6+B1       IN     = FW.IFR+L.IFR-1
          SA6    A7+B1       OUT    = FW.IFR
          SX7    X7+B1
          SA7    A6+B1       LIMIT  = FW.IFR+L.IFR
  
          OPEN   A1,,RCL
          SA1    F.FRZ+4     (X1) = LIMIT 
          SX6    X1-1 
          SA6    F.FRZ+2     IN = LIMIT-1 
  
*         WRITE INTERACTIVE FREEZE RESTART PROGRAM, *IFR*,
*         TO RECORD 1 OF *F.FRZ*. 
  
          WRITER F.FRZ,,RCL 
  
*         SET UP *F.FRZ* FET SO THAT BUFFER IS RA.MTR+1 THRU FL-1.
  
          SA1    MEM#HOST 
          SX6    RA.MTR+1    (X6) = FIRST = OUT 
          LX1    30 
          SX7    X1-2        (X7) = IN = AFLS-2 (FOR SAFETY)
          SA6    F.FRZ+1     FIRST = RA.MTR+1 
          SA7    A6+B1       IN =AFLS-2 
          SA6    A7+B1       OUT = RA.MTR+1 
          SX7    X7+B1       (X7) = LIMIT = AFLS-1 (FOR SAFETY) 
          SA7    A6+B1       LIMIT = AFLS-1 
  
*         WRITE ALL OF SCM TO *F.FRZ/RECORD 2*. 
  
          WRITER F.FRZ,,RCL 
          EQ     EXIT.
  
  
 FRZ#SAV  =      APL         FWA OF SAVE AREA FOR (RA.SSW), (FL-2), 
*                            AND (FL-1) 
 .IDPOS   ENDIF 
 GIL      SPACE  4,10 
**        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,10 
**        HDR - PRINT SNAP HEADER.
* 
* 
*                PRINTS A SNAP HEADER OF THE FORM-- 
* 
* NAME      SNAP NR  NNNNNN    CALLED BY NNNNNN IN XXXXXXX
* 
*         ENTRY  (X5) = FWA OF PARAMETER LIST 
* 
*         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
          SA1    ADR=RJ      (X1) = ADDR OF CALLING RJ
          RJ     FRA         FIND RELATIVE ADDR 
          PL     B7,HDR2     IF USER PROVIDED *FRA=*
  
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          BX6    X4 
          MX7    0
  
 HDR2     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 
 IEX      SPACE  4,10 
**        IEX - INITIALIZE EXECUTIVE. 
* 
* 
*         ENTRY  (A1,X1) = A+C OF EXECUTIVE ENTRY/EXIT POINT
* 
*         EXIT   (B2) = ADDR OF PARAMETER LIST, IF THERE IS ONE.
*                     = .ZR. IF SPECIAL 
*                            +  RJ  XEC 
*                            -  VFD 30/0
*                     = .MI. IF NO PARAMETER LIST.
* 
*                (ADR=RJ)  = ADDR OF *RJ XEC* WORD. 
*                (FW=PARM) = FWA OF PARAMETER LIST FOR THIS EXECUTIVE.
*                            NOTE THAT *IEX* FIGURES OUT WHETHER THERE
*                            REALLY IS A USER-SPECIFIED/ASSEMBLED 
*                            PARAMETER LIST OR NOT.  IF NOT, *IEX* DOES 
*                            THE PRELIMINARY INITIALIZATION OF THE DUMMY
*                            PARAMETER LIST AT *APL* ET SEQ.
* 
*         USES   ALL
* 
*         CALLS  CXR,SBM
  
  
 IEX      SUBR               ** ENTRY/EXIT ** 
  
*         SET UP AND CHECK CALLING *RJ* INSTRUCTION.
  
          LX1    30 
          SX2    X1-1        (X2) = ADDR OF CALLING *RJ*
          SX1    A1          (X1) = ADDR OF EXECUTIVE 
          RJ     CXR         CHECK EXECUTIVE RJ 
          SX6    B2 
          GT     B2,B0,IEX2  IF PARAMETER LIST LOOKS TO BE PRESENT
  
*         SET UP DUMMY PARAMETER LIST.
  
          BX6    X6-X6
          SX1    L.APL       (X1) = LEN OF DUMMY PARAMETER LIST 
          SA6    APL         INITIALIZE (A6)
          RJ     =XSBM=      SET BLOCK OF MEMORY
  
*         SET UP DEFAULT *LL,UL,INC* INTO DUMMY PARAMETER LIST. 
  
          SX6    1
          SX7    100D 
          SA6    APL+SN=LL   DEFAULT LL = 1 
          SA7    APL+SN=UL   DEFAULT UL = 100D
          SA6    APL+SN=INC  DEFAULT INC = 1
          SX6    APL
  
*         SAVE FWA OF PARAMETER LIST (REAL OR DUMMY). 
  
 IEX2     SA6    FW=PARM
          EQ     EXIT.
 IIF      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        IIF - INITIALIZE INTERACTIVE FILES. 
* 
* 
*         THIS ROUTINE OPENS AND CONNECTS THE INTERACTIVE DEBUG INPUT 
*         AND OUTPUT FILES, *F.IDI* AND *F.IDO*.
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT A5,X5,A0,X0
* 
*         CALLS  CON,OPEN 
  
  
 IIF      SUBR               ** ENTRY/EXIT ** 
  
*         SET UP *F.IDI - INTERACTIVE DEBUG INPUT FILE*.
  
          SA1    IDPFLG 
          MX2    1
          LX2    IDF.RAPP-59
          BX6    -X2*X1      CLEAR *RAP*
          LX2    IDF.INPP-IDF.RAPP
          BX6    -X2*X6      CLEAR *INP*
          SA6    A1 
          OPEN   F.IDI,,RCL 
          SA1    F.IDI
          MX2    0           SET TO *CONNECT* 
          RJ     CON         CONNECT F.IDI
  
 #OS3     IFEQ   .OS,3       IF SCOPE 3 
          MI     X1,*+4S15   IF *CON* DETECTED ERROR... 
 #OS3     ENDIF 
  
*         SET UP *F.IDO - INTERACTIVE DEBUG OUTPUT FILE*. 
  
          OPEN   F.IDO,,RCL 
          SA1    F.IDO
          MX2    0           SET TO *CONNECT* 
          RJ     CON         CONNECT F.IDO
  
 #OS3     IFEQ   .OS,3       IF SCOPE 3 
          MI     X1,*+4S15   IF *CON* DETECTED ERROR... 
 #OS3     ENDIF 
  
          EQ     EXIT.
 IST      SPACE  4,10 
**        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,10 
**        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 
          IX2    X6+X6       *2 
          SA1    ST.BRK+X2   (X1) = *KEYW* ENTRY FOR THIS BREAK 
          SA6    IDPBTC 
          LX1    0-KW.KEYP
          SA1    X1          (X1) = KEYW LITERAL FOR THIS BREAK, -L- FMT
          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 
          RJ     FRA         FIND RELATIVE ADDRESS
          PL     B7,LBT3     IF USER PROVIDED *FRA=*
  
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          BX6    X4 
          MX7    0
  
 LBT3     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,10 
**        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
          BX1    -X0*X5 
          RJ     FRA         FIND RELATIVE ADDRESS
          SA6    A6+B1
          SA7    A6+B1
          PRIDP  SNAPLNE
  
 LST4     SA5    A5+B1
          EQ     LST2 
 LXT      SPACE  4,10 
**        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 
 MUL      SPACE  4,10 
**        MUL - INTEGER MULTIPLY. 
* 
* 
*         *MUL* INTEGER MULTIPLIES THE 2 **POSITIVE** INTEGERS
*         IN REGISTERS (X1) AND (X2), PRODUCING A 60 BIT RESULT.
* 
*         *MUL* IS ONLY NECESSARY BECAUSE THE HARDWARE CAN ONLY GET 
*         A MAXIMUM OF 48 BITS OF PRECISION ON AN INTEGER MULTIPLY, AND 
*         WE NEED 60 BITS.
* 
*         ENTRY  (X1) = X 
*                (X2) = Y 
* 
*         EXIT   (X7) = X*Y  (60 BIT RESULT). 
* 
*         USES   X - 1,2,3,4,7
*                A - NONE 
*                B - NONE 
* 
*         CALLS  NONE 
  
  
 MUL      SUBR               ** ENTRY/EXIT ** 
          MI     X1,*+4S15   IF X IS NEGATIVE, CAN'T DO IT... 
          MI     X2,*+4S15   IF Y IS NEGATIVE, CAN'T DO IT... 
          SX3    1
          BX7    X7-X7
          IX4    X1-X2
          PL     X4,MUL2     IF X .GT. Y
          BX1    X1-X2
          BX2    X1-X2
          BX1    X1-X2
  
 MUL2     ZR     X2,EXIT.    IF DONE
          IX7    X7+X1
          IX2    X2-X3
          EQ     MUL2 
 PAS      SPACE  4,10 
**        PAS - PARSE SUBEXPRESSION.
* 
* 
*         THIS IS THE PARSER... 
* 
*         *PAS* IS A RELATIVELY SIMPLE 2 PASS REVERSE POLISH NOTATION 
*         (*RPN*) PARSER.  IT IS USED BY JUST ABOUT EVERYONE IN IDP FOR 
*         EVALUATING EXPRESSIONS TYPED IN BY FRIENDLY HUMANS. 
* 
*         *PAS* CAN BE SPLIT DOWN THE MIDDLE INTO 2 PHASES: POLISH OUT
*         (I.E. THE GENERATION OF REVERSE POLISH NOTATION TO *RPN*
*         TABLE), AND POLISH IN (I.E. THE EVALUATION OF THE *RPN* THAT
*         WE JUST GENERATED INTO A SINGLE BINARY ANSWER/VALUE). 
* 
*         FOLLOWING IS A PICTORIAL OF *DATA FLOW* IN *PAS* -- 
* 
* 
*                     POLISH OUT      I     POLISH IN 
*                                     I 
*                        +------+     I 
*                        I      I     I 
*                        I PAST I     I 
*                        I      I     I 
*                        +------+     I 
*                          &  .       I 
*                +----+    .  .    +-----+      +------+
*                I    I 1  .  .    I     I      I      I
*                I    I ....  ...> I     I 2    I      I
*                I TB I            I RPN I ...> I PAST I ...> (IDPACC)
*                I    I .........> I     I      I      I
*                I    I 2          I     I      I      I
*                +----+            +-----+      +------+
*                                     I 
*                                     I 
* 
*         WHERE  TB   = TOKEN BUFFER (I.E. *PAS* INPUT).
*                RPN  = REVERSE POLISH NOTATION TABLE (I.E. POLISH
*                       OUT OUTPUT, AND POLISH IN INPUT). 
*                PAST = PARSING STACK (USED DURING POLISH OUT FOR 
*                       ORDERING OPERATORS, AND DURING POLISH IN
*                       FOR EVALUATING OPERANDS). 
* 
*                1    = DATA FLOW PATH FOR OPERATORS. 
*                2    = DATA FLOW PATH FOR OPERANDS.
* 
*                IDPACC = THE ACCUMULATOR.  I.E. WHERE *PAS* STUFFS THE 
*                         FINAL RESULT RIGHT BEFORE EXITING.
* 
* 
*         THE GENERAL ALGORITHM USED IN THIS PARSER CAN BE REPRESENTED
*         IN A PSEUDO ENGLISH/PASCAL AS FOLLOWS --
* 
*         POLISH OUT -- 
* 
*                CASE OF TOKEN TYPE 
* 
*                    OPERAND:  PASS TO *RPN*. 
* 
*                    OPERATOR: WHILE PRIORITY OF TOKEN .LE. PRIORITY
*                              OF TOP-OF-STACK, PASS TOP-OF-STACK 
*                              TO *RPN*.
* 
*                              PUSH TOKEN ON STACK. 
* 
*                    LEFT (:   PUSH ON STACK. 
* 
*                    RIGHT ):  POP STACK THRU FIRST ( HIT.
* 
*                    EOS:      POP ENTIRE STACK.
* 
* 
*         POLISH IN --
* 
*                WHILE NOT EOS
* 
*                    IF TOKEN = OPERAND 
*                       PUSH ON STACK.
* 
*                    IF TOKEN = BINARY OPERATOR 
*                       APPLY OPERATOR ON TOP 2 STACK ENTRIES 
*                       PUSH RESULT ON STACK (OVERLAYING TOP 2).
* 
*                    IF TOKEN = UNARY OPERATOR
*                       APPLY ON TOP STACK ENTRY
*                       PUSH RESULT ON STACK (OVERLAYING TOP 1).
* 
*                AT END, RESULT WILL BE IN STACK. 
* 
*         THROUGHOUT THIS ROUTINE, REGISTERS B6 AND B7 HAVE GLOBAL
*         SIGNIFICANCE -- 
* 
*                (B6) = TOP-OF-STACK, *PAST*, ORDINAL.
*                (B7) = NEXT ADDR TO STORE/READ IN *RPN*. 
* 
* 
*         ENTRY  (A5+1) = ADDR OF 1ST TOKEN TO PARSE. 
* 
*         EXIT   (IDPACC) = BINARY VALUE OF EXPRESSION. 
*                         = +0 IF NULL PARSE, (X3) .ZR. 
*                (X6)     = (IDPACC). 
*                (X1)     = (IDPACC). 
*                (X3)     = .NZ. IF EXPRESSION WAS NON-NULL, ELSE 
*                         = .ZR. IF EXPRESSION WAS NULL.
*                (A5,X5)  = A+C OF TOKEN THAT TERMINATED PARSE. 
* 
*                (PAS=TET) = (MX=TET).  SEE *MX=TET* FOR DETAILS. 
* 
*         USES   ALL
* 
*         CALLS  CHK,CIB,FAA,FRA,PTR,SSY
  
  
 PAS      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          SX6    0
          SA6    IDPACC      CLEAR ACCUMULATOR
          SA6    IDPNUL      INITIALIZE TO *SUBEXPRESSION IS NULL*
  
          SA1    TB=STMT     (X1) = ADDR OF STMT INFO WORD
          SA2    X1          (X2) = STMT INFO WORD FOR STMT TO PARSE
          ERRNZ  TB.LENL-18 
          LX2    0-TB.LENP
          SB2    X2          (B2) = NR OF WORDS/TOKENS IN THIS STMT 
          SB3    L.PAST      (B3) = NR OF AVAILABLE WORDS IN *PAST* 
          GT     B2,B3,E.STB IF STMT TOO BIG, ERROR...
  
          SB6    -1          INITIALIZE (B6) = *PAST* ORDINAL 
          SB7    FW.RPN      (B7) = FWA OF *RPN* TABLE
 PAS=PO   SPACE  4,10 
**        PAS=PO - POLISH OUT MAIN LOOP NODE. 
* 
*         THIS IS THE MAIN LOOP NODE FOR GENERATION OF THE *RPN*
*         (REVERSE POLISH NOTATION) TABLE, AND IS TRAVERSED ONCE FOR
*         EACH TOKEN/OPERATOR/OPERAND ENCOUNTERED IN *TB* (TOKEN
*         BUFFER).
* 
*         *PAS=PO* CAN BE THOUGHT OF AS HAVING 2 DISTINCT FUNCTIONS --
* 
*           1. EVALUATION OF OPERANDS INTO BINARY.
* 
*           2. ORDERING OF OPERATORS. 
* 
*         ENTRY  (B6) = ORDINAL IN *PAST* OF TOP-OF-STACK.
*                (B7) = NEXT ADDR TO STORE INTO *RPN*.
* 
*         NOTE THAT (B6) AND (B7) ARE SAVED AT THE TOP OF THIS LOOP IN
*         (PAS=SB6) AND (PAS=SB7), RESPECTIVELY.  THIS ALLOWS ANY POLISH
*         OUT PROCESSOR TO DESTROY (B6) AND (B7) WITHOUT HAVING TO SAVE 
*         THEM.  SAID PROCESSORS, HOWEVER, **MUST** RESTORE THESE 
*         REGISTERS BEFORE RETURNING TO *PAS=PO*. 
  
  
 PAS=PO   BSS    0           ** POLISH OUT MAIN LOOP NODE **
          SA1    PAS=TET     (X1) = TERMINATING *TOT* SHIFT MASK
          SA2    IDPNUL 
          SA5    A5+B1       (A5,X5) = A+C OF NEXT TOKEN
          SB2    X5 
          LX1    B2 
          BX7    X5 
          SX6    X2+B1
          MI     X1,PAS30    IF TERMINATING TOT, POP ENTIRE STACK...
          SA6    A2 
          SX6    B6 
          SX7    B7 
          SA6    PAS=SB6     SAVE (B6)
          SA7    PAS=SB7     SAVE (B7)
  
*         GET *POT* ENTRY.
  
          SB2    X5+
          SB3    L.POT
          LE     B2,B0,E.POP IF UNDER-SHOOTING *POT*, WOWY... 
          GT     B2,B3,E.POP IF OVER-SHOOTING *POT*, KAZOWY...
  
          SA1    FW.POT+X5-O.VAR  (X1) = *POT* ENTRY FOR THIS OPERATOR
          LX1    0-PS.POPP
          ERRNZ  PS.POPL-18 
          SB2    X1          (B2) = POLISH OUT PROCESSOR ADDR 
  
*         EXTRACT *POT* INFORMATION.
  
          ERRNZ  TB.TOTL-18 
          ERRNZ  PS.TOTL-18 
          ERRNZ  PS.POPL-TB.TOTL
          ERRNZ  PS.POPL-18 
          ERRNZ  PS.UPIPL-18
          ERRNZ  PS.PIPL-18 
  
          LX1    0-PS.PIPP+PS.POPP-0
          SX2    X1          (X2) = *PIP* 
          LX1    0-PS.UPIPP+PS.PIPP-0 
          SX3    X1          (X3) = *UPIP*
          LX1    0-PS.PRIP+PS.UPIPP-0 
          MX6    -PS.PRIL 
          SX7    X5          (X7) = *TOT* 
          BX6    -X6*X1      (X6) = *PRI* 
  
*         CHECK FOR UNARY OPERATOR. 
  
          SA4    A5-B1       (X4) = PRECEDING TOKEN 
          SA1    MX=PREUN    (X1) = PRE-UNARY *TOT* SHIFT MASK
          SB3    X4 
          LX1    B3 
          PL     X1,PAS10    IF NOT A UNARY OPERATOR
  
          SX4    X5-O.SEP 
          MI     X4,PAS10    IF NOT AN OPERATOR 
  
          SX4    X5-O.LP
          ZR     X4,PAS10    IF (, LEAVE THINGS ALONE...
  
          SX6    77B         (X6) = UNARY OPERATOR PRIORITY 
          SB2    PAS22       (B2) = ADDR TO FORCE UNARY ON STACK
          SX2    X3+         *PIP* = *POP*
  
*         CONSTRUCT *PAST* ENTRY. 
* 
*         ENTRY  (X2) = *PIP*, POLISH IN PROCESSOR ADDR 
*                (X6) = *PRI*, PARSING PRIORITY 
*                (X7) = *TOT*, TOKEN TYPE 
*                (B2) = POLISH OUT PROCESSOR ADDR 
  
 PAS10    LX7    PS.TOTP-0
          LX2    PS.PIPP-0
          BX4    X6          (X4) = *PRI*, PARSING PRIORITY 
          LX6    PS.PRIP-0
          BX7    X7+X2       MERGE *PIP*
          BX7    X7+X6       MERGE *PRI*
  
          JP     B2 
 PAS=PO   SPACE  4,10 
**        POLISH OUT PROCESSORS.
* 
*         FOLLOWING ARE THE POLISH OUT PROCESSORS THAT ARE RESPONSIBLE
*         FOR GENERATION OF THE *RPN* (REVERSE POLISH NOTATION) TABLE.
* 
*         ENTRY  (B6) = *PAST* TOP-OF-STACK ORDINAL.
*                (B7) = NEXT *RPN* ADDR TO STORE AT.
*                (X4) = PARSING PRIORITY OF THIS OPERATOR/OPERAND 
*                       (IGNORED FOR OPERANDS). 
*                (X7) = CONSTRUCTED *PAST/RPN* ENTRY FOR THIS OPERATOR/ 
*                       OPERAND.
*                (A5,X5) = A+C OF CURRENT TOKEN.
 PAS=PO   SPACE  4,10 
*         HERE IF ( ENCOUNTERED -- PLACE ON STACK.
  
 PAS16    SB6    B6+1 
          SA7    FW.PAST+B6 
          EQ     PAS=PO      CONTINUE...
  
  
*         HERE IF ) ENCOUNTERED -- POP *PAST* UNTIL ( ENCOUNTERED.
  
 PAS18    SA1    FW.PAST+B6  (X1) = TOP OF STACK
          LT     B6,B0,PAS=PO IF *PAST* IS EMPTY, DONE... 
          SX2    X1-O.LP
          BX6    X1 
          SB6    B6-B1
          ZR     X2,PAS=PO   IF ( ENCOUNTERED, DONE...
          SA6    B7 
          SB7    B7+B1
          EQ     PAS18
  
  
*         HERE FOR ALL OPERATORS (NOT LEFT AND RIGHT PARENS). 
* 
*           1. WHILE PRIORITY OF *TB* OPERATOR .LE. PRIORITY OF TOP OF
*              *PAST* OPERATOR, PASS TOP OF *PAST* OPERATOR TO *RPN*. 
* 
*           2. PLACE *TB* OPERATOR ON TOP OF *PAST*.
  
 PAS20    SA1    FW.PAST+B6  (X1) = TOP OF STACK
          LT     B6,B0,PAS22 IF *PAST* IS EMPTY, DONE...
          MX2    -PS.PRIL 
          BX6    X1 
          LX1    0-PS.PRIP
          BX3    -X2*X1      (X3) = *PAST* TOP-OF-STACK OP PRIORITY 
          IX1    X3-X4
          MI     X1,PAS22    IF *TB* OP PRIOR .GT. *PAST* OP PRIOR
          SA6    B7 
          SB7    B7+B1
          SB6    B6-B1
          EQ     PAS20
  
*         PLACE *TB* OPERATOR ON STACK. 
  
 PAS22    SB6    B6+1 
          SA7    FW.PAST+B6 
          EQ     PAS=PO      CONTINUE...
  
  
*         HERE IF *VAR* TOKEN.
* 
*           1. CALL *SSY* (SEARCH SYMBOL TABLES) TO ASSOCIATE A BINARY
*              VALUE WITH THIS *VAR* TOKEN. 
* 
*           2. PUT *PS* ENTRY FOR THIS *VAR* AND ITS EVALUATED BINARY 
*              VALUE OUT TO *RPN* AS A 2 WORD ENTRY.
  
 PAS24    SA1    A5+1 
          SX6    X1-O.VAR 
          ZR     X6,E.SYTL   IF SYMBOL TOO LONG, ERROR... 
  
          SA7    B7 
          MX2    TB.TOCL
          BX1    X2*X5       (X1) = SYMBOL TO SEARCH FOR, -L- FMT 
          RJ     SSY         SEARCH SYMBOL TABLES 
          ZR     B6,E.VAR    IF NO FIND 
  
          SA1    PAS=SB6
          SA2    A1+B1
          SB6    X1          RESTORE (B6) 
          SB7    X2+B1       (B7) = NEXT *RPN* ADDR TO STORE AT 
          SA6    B7 
          SB7    B7+B1
          EQ     PAS=PO      CONTINUE WITH POLISH OUT...
  
  
*         HERE IF *CONS* TOKEN. 
* 
*           1. CALL *CIB* (CONVERT INTEGER TO BINARY) TO EVALUATE *CONS*
*              TOKEN(S).
* 
*           2. PUT *PS* ENTRY FOR THIS *CONS* AND ITS EVALUATED BINARY
*              OUT TO *RPN* AS A 2 WORD ENTRY.
  
 PAS26    SA7    B7 
          SB7    B7+B1
          SX1    8           SET TO *DEFAULT BASE IS OCTAL* 
          RJ     CIB         CONVERT INTEGER TO BINARY
          NZ     B2,E.CON    IF AN ERROR DURING CONVERSION
  
          SA6    B7 
          SB7    B7+B1
          EQ     PAS=PO 
  
  
*         HERE IF *REG* TOKEN.
* 
*           1. GET ADDR OF SAVED REGISTER FROM IDP'S SAVED USER REGISTER
*              AREA.
* 
*           2. PUT *PS* ENTRY FOR THIS *REG* AND APPROPRIATE REGISTER 
*              ADDR OUT TO *RPN* AS A 2 WORD ENTRY. 
  
 PAS28    LX5    0-TB.0TRP
          ERRNZ  TB.0TRL-18 
          SX6    IDP=SVB+X5  (X6) = ADDR OF SAVED REGISTER
          SA7    B7 
          SA6    A7+B1
          SB7    B7+2 
          EQ     PAS=PO 
  
  
*         HERE IF AN EOS ENCOUNTERED. 
* 
*         POP ENTIRE STACK. 
  
 PAS30    SA1    FW.PAST+B6  (X1) = TOP OF STACK
          LT     B6,B0,PAS32 IF DONE
          SX2    X1-O.LP
          BX6    X1 
          SB6    B6-B1
          ZR     X2,PAS30    IF (, IGNORE...
          SA6    B7 
          SB7    B7+B1
          EQ     PAS30
  
  
*         HERE WHEN WE HAVE COMPLETED GENERATING *RPN* TABLE. 
* 
*           1. TERMINATE *RPN* TABLE WITH A FULL ZERO END-OF-TABLE
*              MARK.
* 
*           2. CHECK FOR *RPN* TABLE OVERFLOW.
* 
*           3. SET UP FOR *POLISH IN* PROCESSING. 
  
 PAS32    BX6    X6-X6
          SA6    B7          MARK EOT 
  
          SB2    FW.RPN+L.RPN  (B2) = LWA+1 OF AVAILABLE *RPN* SPACE
          GE     B7,B2,SE.RPN  IF *RPN* OVERFLOW
  
          SB6    -1          INITIALIZE (B6) = *PAST* ORDINAL 
          SB7    FW.RPN      (B7) = FWA OF *RPN* TABLE
 PAS=PI   SPACE  4,10 
**        PAS=PI - POLISH IN MAIN LOOP NODE.
* 
*         THIS IS THE MAIN LOOP NODE FOR THE EVALUATION OF THE *RPN*
*         (REVERSE POLISH NOTATION) TABLE INTO A SINGLE BINARY VALUE. 
* 
*         *PAS=PI* IS TRAVERSED ONCE FOR EACH OPERATOR/OPERAND ENTRY
*         ENCOUNTERED IN *RPN*. 
* 
*         ENTRY  (B6) = *PAST* TOP-OF-STACK ORDINAL.
*                (B7) = NEXT *RPN* ADDR TO LOOK AT. 
*                (A5,X5) = A+C OF TOKEN THAT TERMINATED PARSE (UNUSED 
*                          DURING POLISH IN PROCESSING).
* 
*         NOTE THAT (B6) AND (B7) ARE SAVED AT THE TOP OF THIS LOOP IN
*         (PAS=SB6) AND (PAS=SB7), RESPECTIVELY.  THIS ALLOWS ANY POLISH
*         IN PROCESSOR TO DESTROY (B6) AND (B7) WITHOUT HAVING TO SAVE
*         THEM.  SAID PROCESSORS, HOWEVER, **MUST** RESTORE THESE 
*         REGISTERS BEFORE RETURNING TO *PAS=PI*. 
  
  
 PAS=PI   BSS    0           ** POLISH IN MAIN LOOP NODE ** 
          SA1    B7          (X1) = NEXT *RPN* ENTRY
          SB7    B7+B1
          ZR     X1,PAS=XIT  IF *RPN* DEPLETED, DONE... 
  
          SX6    B6 
          SX7    B7 
          SA6    PAS=SB6     SAVE (B6)
          SA7    PAS=SB7     SAVE (B7)
  
          LX1    0-PS.PIPP
          ERRNZ  PS.PIPL-18 
          SB2    X1          (B2) = POLISH IN PROCESSOR ADDR
  
          SA1    FW.PAST+B6    (X1) = A 
          SA2    FW.PAST+B6-1  (X2) = B 
          JP     B2          PARSE ON, PARSE ON...
 PAS=PI   SPACE  4,10 
**        POLISH IN PROCESSORS. 
* 
*         FOLLOWING ARE THE POLISH IN PROCESSORS THAT ARE RESPONSIBLE 
*         FOR ACTUALLY PERFORMING THE OPERATIONS SPECIFIED VIA IDP'S
*         OPERATORS UPON THE OPERANDS.
* 
*         ENTRY  (B6) = *PAST* TOP-OF-STACK ORDINAL.
*                (B7) = NEXT *RPN* ADDR TO LOOK AT. 
*                (X1) = OPERAND -A-, TOP-OF-STACK.
*                (X2) = OPERAND -B-, NEXT-TO-TOP-OF-STACK.
* 
*                       THAT IS, OPERATIONS ARE --
* 
*                         1. UNARY: OPERATE -A-.
* 
*                         2. BINARY: -B- OPERATE -A-. 
 PAS=PI   SPACE  4,10 
*         HERE IF --
* 
*           1. *VAR* TOKEN. 
* 
*           2. *CONS* TOKEN.
* 
*           3. *REG* TOKEN. 
* 
*         PUSH BINARY ON STACK. 
  
 PAS34    SA1    B7 
          SB7    B7+B1
          BX6    X1 
          SB6    B6+B1
          SA6    FW.PAST+B6 
          EQ     PAS=PI 
  
  
*         HERE IF: B+A
  
 PAS36    IX7    X2+X1       (X7) = B+A 
          EQ     PAS=PIB
  
  
*         HERE IF: +A 
* 
*         DETERMINE CURRENT DECK FWA BY --
* 
*           1. GETTING CURRENT *CODE* 1ST DEFAULT POINTER.  THIS
*              TELLS US WHERE OUR FRIEND IS *CODE*ING AT. 
* 
*           2. CALLING *FRA* (FIND RELATIVE ADDRESS) WITH OUR 
*              *CODE* POINTER IN ORDER TO GET THE DECK NAME 
*              PLUS RELATIVE OFFSET.
* 
*           3. CALLING *FAA* (FIND ABSOLUTE ADDRESS) WITH OUR 
*              JUST-FOUND-BY-FRA DECK NAME IN ORDER TO FIND 
*              OUT WHAT THE ABSOLUTE ADDRESS OF THIS DECK IS. 
* 
*         THIS IS OUR DESIRED NUMBER. 
  
 PAS38    SB2    B1          SET TO *1ST DEFAULT* 
          SB3    -B1         SET TO *GET POINTER* 
          SA1    ST.COD      (X1) = *KEYW* ENTRY FOR *CODE* 
          RJ     PTR         GET POINTER
          SX1    X2          (X1) = DEFAULT *CODE* FWA
          RJ     FRA         FIND RELATIVE ADDRESS
          MI     B7,PAS39    IF USER DID NOT PROVIDE *FRA=* 
          BX1    X7          (X1) = DECK NAME, -L- FMT
          MX0    7*CHAR 
          RJ     FAA         FIND ABSOLUTE ADDRESS
          MI     X6,SE.UNPL  IF NO FIND 
  
 PAS39    SA1    PAS=SB6     (X1) = SAVED (B6)
          SA2    A1+B1       (X2) = SAVED (B7)
          SB6    X1          RESTORE (B6) 
          SB7    X2          RESTORE (B7) 
  
          SA1    FW.PAST+B6  (X1) = A, RESTORED 
          IX7    X6+X1       (X7) = DECK+A
          EQ     PAS=PIU
  
  
*         HERE IF: B-A
  
 PAS40    IX7    X2-X1       (X7) = B-A 
          EQ     PAS=PIB
  
  
*         HERE IF: -A 
  
 PAS42    BX7    -X1         (X7) = -A
          EQ     PAS=PIU
  
  
*         HERE IF: B*A
  
 PAS44    IX7    X2*X1       (X7) = B*A 
          EQ     PAS=PIB
  
  
*         HERE IF: *A 
  
 PAS46    SB2    X1 
          RJ     CHK         CHECK CM ADDRESS 
          MI     B2,E.IND    IF ADDR IS BAD 
          SA1    B2 
          BX7    X1          (X7) = *A
          EQ     PAS=PIU
  
  
*         HERE IF: B$A
  
 PAS48    SB2    X1 
          LX7    X2,B2       (X7) = B$A 
          EQ     PAS=PIB
  
  
*         HERE IF: B.OR.A 
  
 PAS50    BX7    X2+X1       (X7) = B.OR.A
          EQ     PAS=PIB
  
  
*         HERE IF: B.AND.A
  
 PAS52    BX7    X2*X1       (X7) = B.AND.A 
          EQ     PAS=PIB
  
  
*         HERE IF: B.XOR.A
  
 PAS54    BX7    X2-X1       (X7) = B.XOR.A 
          EQ     PAS=PIB
  
  
*         HERE TO PUSH RESULT OF BINARY OPERATION ON STACK. 
  
 PAS=PIB  BSS    0
          SB6    B6-1 
          LT     B6,B0,E.PAST IF STACK IS EMPTY, ERROR... 
          SA7    FW.PAST+B6 
          EQ     PAS=PI      CONTINUE WITH POLISH IN... 
  
  
*         HERE TO PUSH RESULT OF UNARY OPERATION ON STACK.
  
 PAS=PIU  BSS    0
          SA7    FW.PAST+B6 
          EQ     PAS=PI      CONTINUE WITH POLISH IN... 
 PAS=XIT  SPACE  4,10 
**        PAS=XIT - HERE WHEN READY TO EXIT.
* 
*           1. CHECK TO MAKE SURE THAT THE RESULT OF OUR EVALUATION 
*              IS THE ONLY THING LEFT ON THE STACK. IF NOT THEN WE
*              HAVE AN ERROR. 
* 
*           2. SET UP EXIT CONDITIONS, AND EXIT BACK TO CALLER. 
  
  
 PAS=XIT  BSS    0
          SA3    IDPNUL 
          SA2    MX=TET      (X2) = MASTER TERMINATING *TOT* SHIFT MASK 
          SX1    0
          ZR     X3,PAS90    IF NULL PARSE
  
          SA1    FW.PAST+B6  (X1) = BINARY RESULT 
          NZ     B6,E.PAST   IF OPERATOR/OPERAND MISMATCH, ERROR... 
  
 PAS90    BX6    X1 
          LX7    X2 
          SA6    IDPACC      SAVE ACCUMULATOR 
          SA7    PAS=TET
          EQ     EXIT.
  
  
 PASA     BSSZ   3
  
          LOC    PASA 
 PAS=SB6  =      *           SAVED (B6) 
 PAS=SB7  =      *+1         SAVED (B7) 
 PAS=SX7  =      *+2         SAVED (X7) 
          LOC    *O 
  
 PAS=TET  CON    "'?IDCTET"  LOCAL TERMINATING *TOT* SHIFT MASK 
 PAT      SPACE  4,10 
**        PAT - PARSE *FWA,LWA,LEN* TRIPLE. 
* 
* 
*         THIS ROUTINE CONTROLS THE PARSING OF THE *FWA,LWA,LEN*
*         SYNTAX, AND IS USED MERELY AS A SPACE OPTIMIZATION BECAUSE
*         THIS SYNTAX NEEDS TO BE PARSED FOR A NUMBER OF DIFFERENT
*         STATEMENTS. 
* 
*         ANY OR ALL OF THE SUBEXPRESSIONS WHICH CONSTITUTE THE 
*         *FWA,LWA,LEN* TRIPLE MAY BE NULL.  IF A NULL SUBEXPRESSION
*         IS ENCOUNTERED, *PAT* WILL USE A DEFAULT VALUE THAT HAS 
*         BEEN SET UP BY THE CALLER.
* 
*         NOTE THAT *PAT* RESOLVES ANY POSSIBLE SYNTACTIC DIFFERENCES 
*         BETWEEN THE USES OF THE *LWA* AND *LEN* PARAMETERS -- 
* 
*           1. FOR *FWA,LWA* (I.E. WHEN *LEN* IS NULL), 
*              NEED TO SET: LEN = LWA-FWA+1 
* 
*           2. FOR *FWA,,LEN* (I.E. WHEN *LWA* IS NULL),
*              NEED TO SET: LWA = FWA+LEN-1 
* 
*         THIS HOCUS POCUS IS NECESSARY TO INSURE THAT *LWA* AND *LEN*
*         DO NOT CONFLICT WITH EACH OTHER.
* 
*         CONSIDER -- 
* 
*                SNAP 100,,2
* 
*         FOLLOWED BY --
* 
*                SNAP 100,110 
* 
*         IF THE ABOVE *LWA/LEN* FIDDLING WERE NOT PERFORMED, UPON
*         ENCOUNTERING THE 2ND STMT, IDP WOULD NOT KNOW WHICH VALUE 
*         TO USE: LEN=2 (RESIDUAL), OR LWA=110 (EXPLICIT).
* 
*         ENTRY  (A5+1)    = ADDR OF 1ST TOKEN IN TRIPLE, I.E. *FWA*. 
*                (TB=KEY)  = ADDR OF *KEYW* ENTRY, WORD 1, FOR THIS 
*                            STMT (I.E. CONTAINS *PTR* ORD).
* 
*         EXIT   (A5,X5)   = A+C OF TOKEN THAT TERMINATED TRIPLE
*                (X2)      = FWA, AS SPECIFIED EXPLICITLY OR BY DEFAULT 
*                (X3)      = LWA, AS SPECIFIED EXPLICITLY OR BY DEFAULT 
*                (X4)      = LEN, AS SPECIFIED EXPLICITLY OR BY DEFAULT 
*                (AP=FWA)  = (PAT#FWA) = FWA
*                (AP=LWA)  = LWA, AS COMPUTED FROM *LWA* AND/OR *LEN* 
*                (B2)      = .MI. IF FWA, LWA, OR LEN ARE BAD, ELSE .PL.
* 
*         USES   ALL
* 
*         CALLS  FLL,PAS,PTR
  
  
 PAT      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          SB2    B1          SET TO *1ST DEFAULT, PLEASE* 
          SB3    -1          SET TO *GET PTR* 
          BX1    X1-X1       SET TO *USE KEYW ENTRY AT (TB=KEY)*
          RJ     PTR         GET POINTER VALUES 
  
*         SET UP DEFAULT FWA,LWA,LEN. 
  
          MX6    0
          SA6    PATFLG      CLEAR *PATFLG* 
          SA6    PAT#LWA     DEFAULT LWA = 0 (I.E. NO LWA)
          BX6    X2 
          LX7    X4 
          SA6    PAT#FWA     DEFAULT FWA = (FWA POINTER)
          SA7    PAT#LEN     DEFAULT LEN = (LEN POINTER)
  
*         PARSE/PROCESS FWA.
  
          ZR     X5,PAT4     IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION -- FWA 
          ZR     X3,PAT2     IF FWA IS NULL 
  
*         CHECK TO SEE IF FWA CHANGED.  IF SO, SET DEFAULT LEN = 1. 
  
          SA2    PAT#FWA     (X2) = DEFAULT FWA 
          SX6    X1          (X6) = NEW FWA 
          SX7    B1 
          IX3    X6-X2
          SA6    A2          UPDATE NEW FWA 
          ZR     X3,PAT2     IF FWA DID NOT CHANGE
          SA7    PAT#LEN     SET TO DEFAULT LEN = 1 
  
*         PARSE/PROCESS LWA.
  
 PAT2     ZR     X5,PAT4     IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION -- LWA 
          ZR     X3,PAT3     IF LWA IS NULL 
          SX6    X1 
          SX7    PAF.LWAM 
          SA6    PAT#LWA
          SA7    PATFLG 
  
*         PARSE/PROCESS LEN.
  
 PAT3     ZR     X5,PAT4     IF EOS ENCOUNTERED 
          RJ     PAS         PARSE SUBEXPRESSION -- LEN 
          ZR     X3,PAT4     IF LEN IS NULL 
          SA2    PATFLG 
          SX7    PAF.LENM 
          SX6    X1 
          BX7    X2+X7       SET TO *LEN SPECIFIED* 
          SA6    PAT#LEN
          SA7    A2+
  
*         HERE TO RESOLVE ANY POSSIBLE SYNTACTIC DIFFERENCES
*         BETWEEN *FWA,LWA* AND *FWA,,LEN*. 
  
 PAT4     SA1    PATFLG 
          SA2    PAT#FWA     (X2) = FWA 
          SA3    A2+B1       (X3) = LWA 
          SA4    A3+B1       (X4) = LEN 
          ZR     X1,PAT6     IF NO PROBLEM
          SX6    X1-PAF.LWAM-PAF.LENM 
          SX7    X1-PAF.LWAM
          ZR     X6,PAT6     IF *FWA,LWA,LEN* 
          NZ     X7,PAT5     IF *FWA,,LEN*
  
*         HERE IF *FWA,LWA*.
*         SET: LEN=LWA-FWA+1
* 
*         NOTE THAT A SPECIAL DEAL HAPPENS HERE TO HELP CLUMSY TYPISTS
*         AND AN EVEN CLUMSIER EXTERNAL SYNTAX.  IF --
* 
*                LWA .LT. FWA .AND. LWA .LT. 100
* 
*         THEN WE USE *LWA* AS A *LEN*. 
  
          IX6    X3-X2       (X6) = LWA-FWA 
          SX4    X6+B1
          PL     X6,PAT6     IF FWA .LE. LWA
          SX7    X3-100 
          PL     X7,PAT6     IF DON'T WANT TO RISK IT 
          BX4    X3          (X4) = LEN 
  
*         HERE IF *FWA,,LEN*. 
*         SET: LWA = FWA+LEN-1
  
 PAT5     IX6    X2+X4
          SX3    X6-1 
          BX6    X3 
          SA6    A3 
  
*         CHECK *FWA,LWA,LEN*.
* 
*         ENTRY  (X2) = FWA 
*                (X3) = LWA 
*                (X4) = LEN 
  
 PAT6     SX6    X2 
          SX7    X3 
          SA6    PAT#FWA
          SA7    A6+B1
          SX6    X4 
          SA6    A7+1 
  
          RJ     FLL         CHECK FWA,LWA,LEN
          PL     B2,PAT7     IF FWA, LWA, AND LEN OK
          BX2    X2-X2       CLEAR *FWA*
          MX3    0           CLEAR *LWA*
          SX4    B0          CLEAR *LEN*
          EQ     EXIT.
  
*         SET UP EXIT CONDITIONS. 
  
 PAT7     SA2    PAT#FWA     (X2) = FWA 
          SA3    A2+B1       (X3) = LWA 
          SA4    A3+B1       (X4) = LEN 
          BX1    X1-X1       SET TO *USE PTR ORD AT (TB=KEY)* 
          SB2    B1          SET TO *1ST DEFAULT* 
          SB3    B1+         SET TO *PUT NEW VALUE* 
          RJ     PTR         PUT POINTER VALUES 
          EQ     EXIT.
  
  
          LOC    AP=LL
 PAT#FWA  =      *
 PAT#LWA  =      *+1
 PAT#LEN  =      *+2
          LOC    *O 
 PEM      SPACE  4,10 
**        PEM - PRINT ERROR MSG.
* 
* 
*         THIS ROUTINE PRINTS AN IDP ERROR MSG IN ONE OF TWO
*         WAYS -- 
* 
*           1. IF *OI.ERR = 1*, THEN THE ERROR MESSAGE NR IS PRINTED. 
* 
*           2. IF *OI.ERR = 2*, THEN THE ERROR MESSAGE TEXT IS PRINTED. 
* 
*         SEE *OI.ERR* (IN *COMSIDP*) FOR MORE INFORMATION. 
* 
*         ENTRY  (IDPERR) = .ZR. IF NO ERROR HAS OCCURRED, ELSE 
*                         = .MI. IF NO ERR MSG AVAILABLE FOR THIS ERROR.
*                         = .PL. IF AN ERROR MSG IS AVAILABLE --
* 
*                           1. IF *OI.ERR = 1*, THEN (IDPERR) = THE ERR 
*                              MSG NUMBER.
* 
*                           2. IF *OI.ERR = 2*, THEN (IDPERR) = THE FWA 
*                              OF THE ERR MSG TO BE PRINTED.
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  WRITEC 
  
  
 PEM      SUBR               ** ENTRY/EXIT ** 
  
*         CHECK FOR ERR MSG AVAILABILITY. 
  
          SA1    IDPERR      (X1) = ERR MSG NR IF *OI.ERR = 1*, ELSE
*                                 = FWA OF ERR MSG TEXT IF *OI.ERR = 2* 
          NZ     X1,PEM2     IF THERE IS AN ERROR 
          WRITEC F.IDO,PEMA 
          EQ     EXIT.
  
 PEM2     PL     X1,PEM3     IF THERE IS AN ERR MSG FOR THIS ERROR
          WRITEC F.IDO,PEMB 
          EQ     EXIT.
  
 PEM3     BSS    0
  
 '?ID#001 IFEQ   OI.ERR,1 
  
          SA2    =10H ERROR NR
          BX6    X2 
          SA6    SNAPLNE
          RJ     =XCDD       CONVERT BINARY TO DECIMAL DPC
          BX7    X7-X7
          SA6    A6+B1
          SA7    A7+B1       MARK EOL 
          WRITEC =XF.IDO,SNAPLNE
          EQ     EXIT.
  
 '?ID#001 ELSE
  
          WRITEC =XF.IDO,X1 
          EQ     EXIT.
 '?ID#001 ENDIF 
  
  
 PEMA     DATA   C. NO ERROR. 
  
 PEMB     DATA   C. NO ERROR MESSAGE FOR THIS ERROR.
 POL      SPACE  4,10 
**        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  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.VAR 
          SX7    X5-O.COM 
          ZR     X6,POL3     IF *VAR* TOKEN 
          ZR     X7,POL4     IF , TOKEN 
          SX6    X5-O.MIN 
          NZ     X6,E.OPT    IF NOT - TOKEN, ERROR... 
          MX4    60          SET TO * - PREFIX ENCOUNTERED* 
          EQ     POL2 
  
*         HERE TO PROCESS NAME TOKEN. 
  
 POL3     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,E.OPT    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.
 PTR      SPACE  4,10 
**        PTR - POINTER MANAGER.
* 
* 
*         *PTR* PERFORMS THE TASK OF MANAGING THE ACCESSING 
*         AND CHANGING OF IDP'S USER POINTERS (AT *FW.PTR* ET SEQ). 
* 
*         ENTRY  (X1) = .NZ. IF A *KEYW* ENTRY CONTAINING *PTR* ORD 
*                       TO USE (SEE *KEYW* MACRO AND *KW.XXXP* AND
*                       *KW.XXXL* SYMBOL DEFINITIONS IN *COMSIDP*). 
*                     = .ZR. IF *PTR* IS TO USE THE *KEYW* ENTRY
*                       AT (TB=KEY).
*                (B3) = .PL. IF PUTTING/STORING NEW *PTR* VALUE.
*                     = .MI. IF GETTING OLD/CURRENT *PTR* VALUE.
*                (B2) = *PTR* LEVEL THAT CALLER IS PUTTING/GETTING. 
*                       I.E. 1ST DEFAULT IS (B2) = 1, 2ND DEFAULT 
*                       IS (B2) = 2, ETC.  NOTE THAT *PTR* CHECKS 
*                       TO MAKE SURE CALLER IS REQUESTING A LEGAL 
*                       (I.E. EXISTENT) *PTR* LEVEL.
* 
*                IF PUTTING NEW VALUE, (B3) .PL. -- 
* 
*                (X2) = FWA.
*                (X4) = LEN.  NOTE THAT (X3) IS IGNORED.
* 
*         EXIT   (X2) = FWA.
*                (X4) = LEN.
*                (B2) = ADDR OF *PTR* ENTRY PUTTEN/GOTTEN.
* 
*         USES   X - 1,2,4,6,7
*                A - 1,6
*                B - 2,3,4
* 
*         CALLS  NONE 
  
  
 PTR      SUBR               ** ENTRY/EXIT ** 
          SB4    L1.PTR      (B4) = NR OF DEFAULTS FOR EACH *PTR* 
          NZ     X1,PTR2     IF CALLER PROVIDED POINTER DEF KEYW
          SA1    TB=KEY 
          SA1    X1+         (X1) = *KEYW* ENTRY
  
 PTR2     MX7    -KW.PNRL 
          LX1    0-KW.PNRP
          BX6    -X7*X1      (X6) = *PTR* ORD 
          SX7    B4 
          GT     B2,B4,SE.BPTR IF REQUESTING NON-EXISTENT DEFAULT PTR 
          LE     B2,B0,SE.BPTR IF REQUESTING NON-EXISTENT DEFAULT PTR 
          IX1    X6*X7       (X1) = ORD INTO PTR TBL + L1.PTR 
          NO
          SX6    X1-L.PTR-L1.PTR
          PL     X6,SE.BPTR  IF OVER-INDEXING PTR TABLE 
          SB4    FW.PTR+X1-1
          SB2    B4+B2
          PL     B3,PTR3     IF PUTTING NEW VALUES
  
*         HERE IF GETTING CURRENT VALUES. 
  
          SA1    B2          (A1,X1) = A+C OF REQUESTED *PTR* 
          LX1    0-PT.FWAP
          SX2    X1          (X2) = FWA 
          LX1    0-PT.LENP+PT.FWAP-0
          SX4    X1+         (X4) = LEN 
          EQ     EXIT.
  
*         HERE IF PUTTING NEW VALUES. 
  
 PTR3     SX6    X2 
          SX7    X4 
          LX6    PT.FWAP-0
          LX7    PT.LENP-0
          BX6    X6+X7
          SA6    B2          STORE NEW *PTR*
          EQ     EXIT.
 RIL      SPACE  4,10 
**        RIL - READ IDP INPUT LINE.
* 
* 
*         ENTRY  APPROPRIATE *IDPFLG* CONTROL BITS SET. 
* 
*         EXIT   (X1)      = .NZ. IF EOR/EOF ENCOUNTERED, ELSE .ZR. 
*                IF NO EOR/EOF ENCOUNTERED -- 
*                (L=LIM)   = NR OF WORDS IN SOURCE LINE IMAGE 
*                              (INCLUDES WORD CONTAINING EOL MARK)
*                (TC=SOB)  = NR OF BITS IN FIRST WORD OF SOURCE LINE, 
*                            (FOR *COMCTOK*). 
*                (TC=SOL)  = NR OF BITS IN SOURCE LINE IMAGE, 
*                            (FOR *COMCTOK*). 
* 
*         USES   ALL BUT A0,X0     (INCLUDES ALL CALLS) 
* 
*         CALLS  READ,READC,SFN 
  
  
 RIL      SUBR               ** ENTRY/EXIT ** 
  
          SA5    IDPFLG 
          SX2    F.IDI
          LX5    59-IDF.INPP
          SB6    FW.LIM 
          PL     X5,RIL2     IF READING INTERACTIVELY (F.IDI) 
          SX2    F.BDI
  
 RIL2     LX5    59-IDF.RAPP+IDF.INPP-59
          MI     X5,RIL3     IF READ ALREADY PERFORMED
          READ   X2 
  
*         SET READ ALREADY PERFORMED (RAP) STATUS.
  
          MX6    1
          BX6    X6+X5       SET RAP
          LX6    IDF.RAPP-59
          SA6    A5 
  
 RIL3     READC  X2,B6,8
          NZ     X1,EXIT.    IF EOR/EOF STATUS
  
*         SET UP EXIT CONDITIONS. 
  
 RIL4     SX6    B6-FW.LIM   (X6) = NR OF WORDS IN SOURCE LINE
          SA6    L=LIM
          SB7    X6+
          LE     B7,B1,RIL5  IF 11 CHAR (66 BIT) EOL NOT POSSIBLE 
          SA1    FW.LIM+B7-2 (X1) = NEXT TO LAST WORD OF LINE 
          MX2    -CHAR
          BX3    -X2*X1 
          NZ     X3,RIL5     IF NOT 11 CHAR (66 BIT) EOL MARK 
          SB7    B7-1 
  
 RIL5     SA1    FW.LIM+B7-1 (X1) = LAST WORD OF SOURCE LINE
          RJ     =XSFN       SPACE FILL NAME
          CX6    X7          (X6) = NR OF BITS IN LAST WORD 
          SX7    X6          (X7) = NR OF BITS IN 1ST WORD IF 1ST = LAST
          LE     B7,B1,RIL6  IF 1ST WORD IS ALSO LAST WORD
          SB7    B7-1 
          SX7    B7 
          SB7    B7+B7       *2 
          LX7    6           *64
          SX2    B7+B7       *4 
          IX7    X7-X2       *60
          IX6    X7+X6       (X6) = NR OF BITS IN SOURCE LINE 
          SX7    10*CHAR     (X7) = NR OF BITS IN 1ST WORD
  
 RIL6     SX1    0           SET TO *NO EOR/EOF/EOI ENCOUNTERED*
          SA6    TC=SOL 
          SA7    TC=SOB 
          EQ     EXIT.
 .IDPOS   ENDIF 
 RIR      SPACE  4,10 
**        RIR - RESTORE INTERACTIVE REGISTERS.
* 
* 
*         *RIR* RESTORES ALL THE IDP CALLER'S REGISTERS FROM THE
*         REGISTER SAVE AREA PROVIDE ON ENTRY IN (X1).
* 
*         *RIR* MAKES THE DYNAMIC DECISION AS TO WHETHER TO CALL
*         *COMCRSR* OR *COMCXJR* TO RESTORE REGISTERS, BASED ON 
*         WHETHER THE IDP INTERACTIVE USER HAS SELECTED --
* 
*                OPTION,XJR 
* 
*         OR NOT. 
* 
*         ENTRY  (X1) = FWA OF REGISTER SAVE AREA 
* 
*         EXIT   ALL REGISTERS RESTORED TO CONTENTS OF REGISTER 
*                SAVE AREA. 
* 
*         USES   ALL
* 
*         CALLS  RSR,XJR
  
  
 RIR      SUBR               ** ENTRY/EXIT ** 
          SA2    IDPFLG 
          LX2    59-IDF.XJRP
          MI     X2,RIR2     IF *OPT,XJR* SELECTED
  
          RJ     =XRSR       RESTORE REGISTERS VIA CPU
          EQ     EXIT.
  
 RIR2     BSS    0
 .IDPOS   IFNE   .OS,2
          RJ     =XXJR       RESTORE REGISTERS VIA *XJR*
 .IDPOS   ELSE
          EQ     *+4S15      *XJR* DOES NOT EXIST ON SCOPE 2
 .IDPOS   ENDIF 
          EQ     EXIT.
 ROL      SPACE  4,10 
**        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 
*         HOST DESTROY THEM VIA *PRBDO* CALL. 
  
          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
          SX7    A5-B0
          SA6    A7+B1       SAVE (A0)
          SA7    A6+B1       SAVE (A5)
          BX6    X0 
          LX7    X5 
          SA6    A7+B1       SAVE (X0)
          SA7    A6+B1       SAVE (X5)
  
*         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
          SA3    A2+B1
          SA4    A3+B1
          SB4    X1          RESTORE (B4) 
          SA0    X2          RESTORE (A0) 
          SA5    X3          RESTORE (A5) 
          SA1    A4+B1
          NO
          BX0    X4          RESTORE (X0) 
          LX5    X1          RESTORE (X5) 
          EQ     EXIT.
  
  
 ROLA     BSSZ   8
  
          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) 
 ROL=A5   =      *+5         SAVED (A5) 
 ROL=X0   =      *+6         SAVED (X0) 
 ROL=X5   =      *+7         SAVED (X5) 
          LOC    *O 
 SKT      SPACE  4,10 
**        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 
 SLF      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        SLF - SEARCH FOR LOGICAL FILE NAME. 
* 
* 
*         *SLF* TRIES TO ASSOCIATE A FET FWA WITH A GIVEN DPC 
*         LFN BY -- 
* 
*           1. SEARCHING THE USER FILE/FET TABLE (UFT=) LIST IF IT
*              WAS PROVIDED (=Y). 
* 
*           2. SEARCHING RA.SSW+2 THRU RA.SSW+20B TO SEE IF ANYTHING
*              HERE LOOKS LIKE A FILE/FET NAME. 
* 
*         ENTRY  (X1) = LFN TO SEARCH FOR, -L- FMT. 
* 
*         EXIT   (X6) = FWA OF FET FOR LFN, ELSE .ZR. IF NO FIND. 
* 
*         USES   ALL BUT A0,X0,A5,X5
* 
*         CALLS  CHK
  
  
 SLF      SUBR               ** ENTRY/EXIT ** 
  
*         HERE TO TRY POSSIBLE FET VECTOR LIST PROVIDED BY HOST 
*         AT *UFT=* (USER FILE/FET TABLE).
  
          SB7    =YUFT=      (B7) = FWA OF USER FILE TABLE, IF AVAIL
          LX7    X1 
          SA7    SLFA        SAVE LFN 
          MI     B7,SLF3     IF USER DID NOT PROVIDE *UFT=* 
  
 SLF2     SB2    B7          (B2) = ADDR OF NEXT *UFT=* ENTRY 
          RJ     CHK         CHECK CM ADDR (*UFT=* ENTRY ADDR)
          MI     B2,SE.UFT   IF *UFT=* ENTRY OUT-OF-RANGE 
  
          SA1    B7          (X1) = NEXT *UFT=* ENTRY 
          SB7    B7+B1
          SX6    X1          (X6) = FWA OF FET, ELSE .ZR. 
          MX3    7*CHAR 
          ZR     X1,SLF3     IF END-OF-TABLE, NO FIND...
          SA2    SLFA        (X2) = LFN TO SEARCH FOR, -L- FMT
          BX4    X3*X1       (X4) = LFN FROM *UFT=*, -L- FMT
          IX7    X2-X4
          ZR     X7,EXIT.    IF A FIND IN *UFT=*
          SB2    X1          (B2) = FWA OF FET
          RJ     CHK         CHECK CM ADDRESS (FET FWA) 
          BX6    X6-X6
          MI     B2,SLF2     IF FET ADDR NO GOOD
          SA1    B2          (X1) = WORD 1 OF FET 
          SA2    SLFA        (X2) = LFN TO SEARCH FOR, -L- FMT
          BX4    X3*X1       (X4) = FET LFN, -L- FMT
          IX7    X2-X4
          SX6    B2+         (X6) = FWA OF FET
          ZR     X7,EXIT.    IF A FIND
          EQ     SLF2 
  
*         HERE TO TRY POSSIBLE FET VECTOR LIST AT RA+2 THRU RA+20.
  
 SLF3     SB6    RA.SSW+2    (B6) = FWA OF POSSIBLE FET VECTOR
          SB7    RA.SSW+20B  (B7) = LWA OF POSSIBLE FET VECTOR
  
 SLF4     SA1    B6          (X1) = NEXT POSSIBLE FET VECTOR ENTRY
          BX6    X6-X6
          GT     B6,B7,EXIT. IF END OF ALL POSSIBLE VECTORS 
          SB6    B6+B1
          MX3    7*CHAR 
          SA2    SLFA        (X2) = LFN TO SEARCH FOR, -L- FMT
          BX4    X3*X1       (X4) = LFN FROM VECTOR, -L- FMT
          IX7    X2-X4
          SX6    X1          (X6) = FWA OF FET
          SB2    X1 
          ZR     X7,EXIT.    IF A FIND
          RJ     CHK         CHECK CM ADDRESS (FET FWA) 
          BX6    X6-X6
          MI     B2,SLF4     IF FET ADDR NO GOOD
          SA1    B2          (X1) = WORD 1 OF FET 
          SA2    SLFA        (X2) = LFN TO SEARCH FOR, -L- FMT
          BX4    X3*X1       (X4) = FET LFN, -L- FMT
          IX7    X2-X4
          SX6    B2+         (X6) = FWA OF FET
          ZR     X7,EXIT.    IF A FIND
          EQ     SLF4 
  
  
 SLFA     BSSZ   1           SAVED LFN TO SEARCH FOR
 .IDPOS   ENDIF 
 SOB      SPACE  4,10 
**        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.
 SSY      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        SSY - SEARCH SYMBOL TABLES. 
* 
* 
*         *SSY* PERFORMS THE TASK OF TRYING TO ASSOCIATE A BINARY VALUE 
*         WITH A DPC NAME BY QUERYING IDP'S VARIOUS SYMBOL TABLES.
* 
*         EACH SYMBOL HAS AN IMPLICIT SYMBOL TYPE ASSOCIATED WITH IT, 
*         PLACED INTO (B6) ON EXIT.  SYMBOL TYPES ARE DEFINED VIA 
*         COMPASS SYMBOLS OF THE FORM --
* 
*                SY.XXX 
* 
*         WHERE *SY.* IS A COMMON PREFIX, AND *XXX* IS A UNIQUE SYMBOL
*         TYPE.  SYMBOL TYPES, *XXX* ARE -- 
* 
*           NONE = SYMBOL IS UNDEFINED. 
* 
*           DECK = SYMBOL IS AN *FAA/RPV=RNA* DECK NAME.
* 
*           SET  = SYMBOL WAS DEFINED VIA *SET* COMMAND.
* 
*           LFN  = SYMBOL IS A LOGICAL FILE NAME.  I.E. IDP KNOWS 
*                  THE FWA OF ITS FET SOMEHOW.
* 
*           USY  = SYMBOL IS USER-DEFINED.
* 
*         ENTRY  (X1) = SYMBOL TO SEARCH FOR, -L- FMT.
* 
*         EXIT   (B6) = SYMBOL TYPE (SEE ABOVE).  THAT IS, (B6) .NZ 
*                       IF A FIND, ELSE .ZR.
*                (X6) = BINARY VALUE TO ASSOCIATE WITH THIS SYMBOL. 
*                       NOTE THAT IF SYMBOL IS UNDEFINED, (B6) .ZR.,
*                       THEN (X6) = 0.
* 
*         USES   ALL BUT A0,X0,A5,X5
* 
*         CALLS  FAA,SKT,USY=(IF AVAIL) 
  
  
 SSY      SUBR               ** ENTRY/EXIT ** 
  
*         HERE TO TRY *SET* NAME. 
  
          BX6    X1 
          SB6    IDPSET      (B6) = FWA OF *SET* TABLE
          MX0    7*CHAR      (X0) = EXTRACTION MASK FOR *SKT* 
          SA6    SSYA        SAVE (X1)
          RJ     SKT         SEARCH *SET* TABLE FOR SYMBOL
          SB6    SY.SET      SET TO *SYMBOL IS SET NAME*
          SX6    X2+         (X6) = BINARY VALUE OF THIS SYMBOL 
          NZ     X2,EXIT.    IF A FIND
  
*         HERE TO TRY DECK NAME.
  
          SA1    SSYA        (X1) = SYMBOL TO SEARCH FOR, -L- FMT 
          MX0    7*CHAR      (X0) = EXTRACTION MASK FOR *FAA* 
          RJ     FAA         FIND ABSOLUTE ADDRESS
          SB6    SY.DECK     SET TO *SYMBOL IS DECK NAME* 
          PL     X6,EXIT.    IF A FIND
  
*         HERE TO TRY LFN/FET NAME. 
  
          SA1    SSYA        (X1) = SYMBOL TO SEARCH FOR, -L- FMT 
          RJ     SLF         SEARCH FOR LFN 
          SB6    SY.LFN      SET TO *SYMBOL IS LFN* 
          NZ     X6,EXIT.    IF A FIND
  
*         HERE TO TRY USER-DEFINED SYMBOL.
  
          SB2    =YUSY= 
          SA1    SSYA        (X1) = SYMBOL TO SEARCH FOR, -L- FMT 
          =B6    SY.NONE     SET TO *NO FIND* 
          BX6    X6-X6
          MI     B2,EXIT.    IF USER DID NOT PROVIDE *USY=* 
          RJ     =YUSY=      USER SYMBOL SEARCH OWNCODE 
          SB6    SY.USY      SET TO *SYMBOL IS USER-DEFINED*
          NZ     X1,EXIT.    IF A FIND
          =B6    SY.NONE     SET TO *SYMBOL IS UNDEFINED* 
          BX6    X6-X6
          EQ     EXIT.
  
  
 SSYA     BSSZ   1           SAVED SYMBOL TO SEARCH FOR 
 STP      SPACE  4,10 
**        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  (BC=BRAD) = 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   (BC=BRAD), (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,RIR,SVR
  
  
 STP      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          SX6    -1 
          SA6    IDPXFR      CLEAR *TRANSFER CONTROL* FLAG
          SA6    IDPXAR      SET TO *NO ADDR REF SO FAR*
  
*         FETCH WORD CONTAINING INSTRUCTION TO BE XEQ.
  
          SA1    IDPPREG     (X1) = PSEUDO P REGISTER 
          SA2    BC=BRAD
          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 *BC=BRAD*. 
  
          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     SX1    FW.SVR      (X1) = FWA OF SAVED REGISTERS
          RJ     RIR         RESTORE INTERACTIVE 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     =XSVR       SAVE ORIGINAL REGISTERS
 -        VFD    30/FW.SVR
          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    BC=BRAD     (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 *RIR/RSR/SVR/SYS=/XJR*. 
* 
*         THIS IS CURRENTLY FATALLY RECURSIVE BECAUSE *STP* USES THESE
*         ROUTINES TO SAVE AND RESTORE THE IDP CALLER'S REGISTERS 
*         BEFORE AND AFTER EACH INSTRUCTION IS STEPPED.  THIS IMPLIES 
*         THAT THESE *SAVE AND RESTORE* ROUTINES WOULD HAVE TO BE 
*         ABLE TO BE STEPPED AND EXECUTED CONCURRENTLY...TRICKY.
* 
*         IN CASE YOU ARE CONFUSED ABOUT *SYS=*, NOTE THAT *COMCXJR*
*         CALLS *SYS=* TO ISSUE *XJR* RA+1 REQUEST. 
  
          SX1    =XSVR
          SX2    RIR
          IX1    X1-X3
          IX2    X2-X3
          ZR     X1,STP=ER   IF *RJ SVR*, FATAL RECURSION...
          ZR     X2,STP=ER   IF *RJ RIR*, FATAL RECURSION...
          SX1    =XRSR
          SX2    =XXJR
          IX1    X1-X3
          IX2    X2-X3
          ZR     X1,STP=ER   IF *RJ RSR*, FATAL RECURSION...
          ZR     X2,STP=ER   IF *RJ XJR*, FATAL RECURSION...
          SX1    =XSYS= 
          IX1    X1-X3
          ZR     X1,STP=ER   IF *RJ SYS=*, FATAL RECURSION... 
  
*         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
          SX1    FW.SVR      (X1) = FWA OF SAVED REGISTERS
          RJ     RIR         RESTORE INTERACTIVE 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/* 
          SA1    IDP=        (A1,X1) = A+C OF IDP ENTRY POINT 
          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
          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*.
  
          SX1    FW.SVR      (X1) = FWA OF SAVED REGISTERS
          RJ     RIR         RESTORE INTERACTIVE 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 
          SA1    STP=I
          SA2    A1+B1
          BX6    X1+X2
          ZR     X6,STP=X    IF *EQ ADDR*, DONT BE VERBOSE... 
          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    IDP=SVB+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/IDP=SVA,3/0,18/-1         SAI  AJ+Q
 +        VFD    18/0,3/0,18/IDP=SVB,3/0,18/-1         SAI  BJ+Q
 +        VFD    18/0,3/0,18/IDP=SVX,3/0,18/-1         SAI  XJ+Q
 +        VFD    18/0,3/0,18/IDP=SVX,3/0,18/IDP=SVB     SAI  XJ+BK
 +        VFD    18/0,3/0,18/IDP=SVA,3/0,18/IDP=SVB     SAI  AJ+BK
 +        VFD    18/0,3/0,18/IDP=SVA,3/4,18/IDP=SVB     SAI  AJ-BK
 +        VFD    18/0,3/0,18/IDP=SVB,3/0,18/IDP=SVB     SAI  BJ+BK
 +        VFD    18/0,3/0,18/IDP=SVB,3/4,18/IDP=SVB     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    BC=BRAD
          ZR     X2,STP=ER   IF BAD XFER, BAD TIMES...
          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
          PL     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    BC=BRAD
          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
          SA1    IDPPREG
          RJ     FRA         FIND RELATIVE ADDRESS
          SA6    A6+B1
          SA7    A6+B1
          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 
 TOGEL    SPACE  4,10 
***       THE *TOGEL* PROGRAM.
* 
* 
*         THE FOLLOWING SECTION CONTAINS THE *TOGEL* PROGRAM THAT 
*         DRIVE/DESCRIBES THE GENERATION OF *IDP* TOKENS. 
 IDPTOM   SPACE  4,10 
 IDPTOM   TOGEL 
  
 TOM=NXT  BSS    0           ** MAIN LOOP NODE ** 
          GROUP (),NUL,SQZ
 EOS      IFT ("EOS") 
            CALT TOK=EOS     GENERATE *EOS* TOKEN 
  
 TOM=BOL  BSS    0           ** BEGINNING OF LINE **
            ON EOL,TOK=EOS
            GROUP (),NUL,SQZ
            IFT (-A..Z0..9"EOS"/55) 
              CASEOF (+..:),TOM=COF 
              GOTO TOM=BOL
            ENDT
            GROUP (A..Z),KEY,NSQZ 
            GOTO TOM=NXT
 EOS      ENDT
  
 VAR      IFT (A..Z)
            ON EOL,TOK=VOL
            GROUP (A..Z0..9),VAR,SQZ
            CALT TOK=VAR     PROCESS/CHECK *VAR* TOKEN
            ON EOL,TOK=EOS
 VAR      ELST
 CON        IFT (0..9)
              GROUP (0..9),CONS,SQZ 
 CON        ELST
              CASEOF (+..:) 
 TOM=COF        TOKEN PLUS   +
                TOKEN MIN    -
                TOKEN STAR   *
                TOKEN ILL    /
                TOKEN LP     (
                TOKEN RP     )
                TOKEN SHFT   $
                TOKEN ILL    =
                TOKEN ILL    BLANK
                TOKEN COM    ,
                TOKEN PER    .
                  TOKEN AND,(PER,VAR'AND',PER)
                  TOKEN AND,(PER,VAR'A',PER)
                  TOKEN OR,(PER,VAR'OR',PER)
                  TOKEN OR,(PER,VAR'O',PER) 
                  TOKEN XOR,(PER,VAR'XOR',PER)
                  TOKEN XOR,(PER,VAR'X',PER)
                  TOKEN NOT,(PER,VAR'NOT',PER)
                  TOKEN NOT,(PER,VAR'N',PER)
                TOKEN ILL    #
                TOKEN ILL    [
                TOKEN ILL    ]
                TOKEN ILL    %
                TOKEN ILL    DQOT 
                TOKEN ILL    _
                TOKEN ILL    !
                TOKEN ILL    &
                TOKEN SQOT,,TOK=SQT    '
                TOKEN QQQ    ?
                TOKEN ILL    <
                TOKEN ILL    >
                TOKEN ILL    @
                TOKEN ILL    \
                TOKEN ILL    ^
                TOKEN ILL    SCOL 
                TOKEN ILL    :  
              ENDC
 CON        ENDT
 VAR      ENDT
          GOTO TOM=NXT
 TOM=SQT  SPACE  4,10 
**        TOM=SQT - HERE FOR SPECIAL 'XXX' *VAR* TOKEN. 
  
  
 TOM=SQT  BSS    0           ** ENTRY **
          GROUP  (-'"EOS"),VAR,SQZ
          CALT TOK=SQV       CHECK SPECIAL 'VAR' TOKEN
          GOTO TOM=NXT
 IDPTOM   TOGEL 
 TOK=     SPACE  4,10 
***       TOK= - IDP OWNCODE FOR *COMCTOK*. 
* 
* 
 TOK=EOS  SPACE  4,10 
**        TOK=EOS - END-OF-STMT PROCESSING. 
  
  
 TOK=EOS  BSS    0           ** ENTRY **
          SA1    TB=STMT
          MX6    0
          SX2    A6+B1
          SA6    A6+B1       MARK EOS 
          IX7    X2-X1       (X7) = NR OF WORDS IN STMT JUST ENTOKENED
          LX7    TB.LENP-0
          SA7    X1 
  
          SX7    A6+B1       (X7) = ADDR OF LEN WORD FOR NEXT/NEW STMT
          SA6    A6+B1       MARK BOS 
          SA7    A1 
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          LE     B7,B0,=XTOK IF HERE FROM *ON EOL* PROCESSING, EXIT...
          EQ     =XTOK=MN 
 TOK=ER   SPACE  4,10 
**        TOK=ER - HERE IF ERROR DURING TOKEN GENERATION. 
* 
* 
*         NEED TO CLEAR TOKEN BUFFER, *IDPTB*.
  
  
 TOK=ER   BSS    0           ** ENTRY **
          SX6    B1 
          BX7    X7-X7
          LX6    TB.LENP-0
          SA6    IDPTB
          SA7    A6+B1       MARK EOS FOR NULL STMT/LINE
          SA7    A7+B1       MARK EOL FOR NULL STMT/LINE
          EQ     SE.TOK 
 TOK=SQT  SPACE  4,10 
**        TOK=SQT - HERE IF ' ENCOUNTERED.
* 
* 
  
  
 TOK=SQT  BSS    0           ** ENTRY **
          SA0    TOM=SQT
          EQ     =XTOK=CON   RETURN W/ *NO STORE*...
 TOK=SQV  SPACE  4,10 
**        TOK=SQV - CHECK SPECIAL 'VAR' TOKEN.
* 
* 
  
  
 TOK=SQV  BSS    0           ** ENTRY **
          SA1    A6-B1       (A1,X1) = A+C OF TOKEN PRECEDING *VAR* 
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          SX7    X1-O.VAR 
          ZR     X7,TOK=ER   IF *VAR* TOKEN TOO LONG
          EQ     =XTOK=MN 
 TOK=VAR  SPACE  4,10 
**        TOK=VAR - PROCESS/CHECK *VAR* TOKEN.
* 
* 
*         CALL *VAR* (PROCESS *VAR* TOKEN) TO PERFORM THE FOLLOWING --
* 
*           1. CHECK TO MAKE SURE THAT *VAR* TOKEN IS ONLY 1 TOKEN LONG,
*              I.E. NR CHARS .LE. 7.
* 
*           2. IF THIS *VAR* TOKEN IS A REGISTER NAME, CHANGE IT TO 
*              A *REG* TOKEN. 
  
  
 TOK=VAR  BSS    0           ** ENTRY **
          SA1    A6          (A1,X1) = A+C OF *VAR* TOKEN 
          RJ     VAR         PROCESS *VAR* TOKEN
          EQ     =XTOK=MN 
 TOK=VOL  SPACE  4,10 
**        TOK=VOL - HERE IF *VAR* TOKEN TERMINATED BY *EOL*.
* 
* 
*         HERE VIA *ON EOL,TOK=VOL*.  NEED TO DO THE SAME THING 
*         THAT *TOK=VAR* DOES, **EXCEPT** THAT OUR POINTERS ARE 
*         A LITTLE DIFFERENT. 
  
  
 TOK=VOL  BSS    0           ** ENTRY **
          SA1    A6-B1       (A1,X1) = A+C OF *VAR* TOKEN 
          RJ     VAR         PROCESS *VAR* TOKEN
          EQ     TOK=EOS
 UBK      SPACE  4,10 
**        UBK - UNBREAK BREAKS WITHIN A RANGE.
* 
* 
*         ENTRY  (B2) = LOWER BOUND TO UNBREAK. 
*                (B3) = UPPER BOUND TO UNBREAK. 
* 
*                       I.E. *UBK* WILL UNBREAK ALL BREAKS THAT FALL
*                       IN THE RANGE -- 
* 
*                            ADDR .GE. (B2) .AND. ADDR .LE. (B3)
* 
*         EXIT   NONE 
* 
*         USES   X - 1,2,3,4,6,7
*                A - 1,2,3,4,6,7
*                B - 4,6,7
* 
*         CALLS  NONE 
  
  
 UBK      SUBR               ** ENTRY/EXIT ** 
          SB7    -1 
  
 UBK2     SB7    B7+1 
          SA1    IDPBA+B7 
  
          ZR     X1,EXIT.    IF END-OF-TABLE, DONE... 
          SX6    X1-1 
          ZR     X6,UBK2     IF AVAILABLE (EMPTY) ENTRY, IGNORE...
  
          SB4    X1+         (B4) = BREAK ADDR
          LT     B4,B2,UBK2  IF BREAK ADDR TOO LOW
          GT     B4,B3,UBK2  IF BREAK ADDR TOO HIGH 
  
          SB6    B7+B7       (B6) = ORD INTO *IDPBC* FOR THIS BREAK 
          SA2    IDPBC+B6    (A2,X2) = A+C OF *IDPBC* ENTRY FOR THIS BRK
          SA3    B4          (X3) = BREAKPOINT (I.E. SHOULD BE *RJ IDP*)
          SA4    ST=BRKA     (X4) = *RJ IDP* PLUG FROM *BREAK*
          MX6    -1 
          BX7    X2 
          IX3    X3-X4
          SA6    A1          SET TO *THIS ENTRY AVAILABLE*
          NZ     X3,UBK2     IF BREAK ADDR DOESNT HAVE *RJ IDP* 
          SA7    B4          RESTORE PREVIOUS CONTENTS OF BREAK ADDR
          EQ     UBK2 
 UFO      SPACE  4,10 
**        UFO - USER FREEZE OWNCODE.
* 
* 
*         *UFO* WILL CALL *UFO=* IF THE IDP INSTALLER/USER
*         PROVIDED *UFO=* TO ALLOW THE HOST TO PERFORM ITS
*         OWNCODE RIGHT AFTER IDP *FREEZE*S AN INTERACTIVE
*         SESSION.
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  UFO=(IF AVAIL) 
  
  
 UFO      SUBR               ** ENTRY/EXIT ** 
          SB2    =YUFO= 
          MI     B2,EXIT.    IF USER DID NOT PROVIDE *UFO=* 
          RJ     =YUFO=      USER FREEZE OWNCODE
          EQ     EXIT.
 UFR      SPACE  4,10 
**        UFR - USER FREEZE RESTART OWNCODE.
* 
* 
*         *UFR* WILL CALL *UFR=* IF THE INSTALLER/USER
*         PROVIDED *UFR=* TO ALLOW THE HOST TO PERFORM ITS
*         OWNCODE RIGHT AFTER IDP RESTARTS A FROZEN INTERACTIVE 
*         SESSION.
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   ALL
* 
*         CALLS  UFR=(IF AVAIL) 
  
  
 UFR      SUBR               ** ENTRY/EXIT ** 
          SB2    =YUFR= 
          MI     B2,EXIT.    IF USER DID NOT PROVIDE *UFR=* 
          RJ     =YUFR=      USER FREEZE RESTART OWNCODE
          EQ     EXIT.
 UIO      SPACE  4,10 
**        UIO - USER IDP OWNCODE. 
* 
* 
*         *UIO* WILL CALL *UIO=* TO ALLOW THE HOST TO PERFORM 
*         ITS OWNCODE IF THE IDP INSTALLER PROVIDED *UIO=*. 
* 
*         ENTRY  (FW=PARM) = FWA OF PARAMETER LIST FOR THIS *BREAK*.
* 
*         EXIT   (X1) = .MI. IF BREAK IS TO BE HONORED, ELSE .PL. 
*                (X5) = FWA OF *BREAK* PARAMETER LIST.
* 
*         USES   ALL
* 
*         CALLS  UIO=(IF AVAIL) 
  
  
 UIO      SUBR               ** ENTRY/EXIT ** 
          SX1    =YUIO= 
          SA5    FW=PARM     (X5) = FWA OF PARAMETER LIST 
          MI     X1,EXIT.    IF USER DID NOT PROVIDE *UIO=* 
          RJ     =YUIO=      USER IDP OWNCODE 
          SA5    FW=PARM     RESTORE (X5) 
          EQ     EXIT.
 .IDPOS   ENDIF 
 URO      SPACE  4,10 
**        URO - USER *REG* OWNCODE. 
* 
* 
*         *URO* WILL CALL *URO=* TO ALLOW THE HOST TO PERFORM 
*         ITS OWNCODE IF THE IDP INSTALLER PROVIDED *URO=*. 
* 
*         ENTRY  (FW=PARM) = FWA OF PARAMETER LIST FOR THIS *REG*.
* 
*         EXIT   (X1) = .MI. IF REG IS TO BE HONORED, ELSE .PL. 
*                (X5) = FWA OF *REG* PARAMETER LIST.
* 
*         USES   ALL
* 
*         CALLS  URO=(IF AVAIL) 
  
  
 URO      SUBR               ** ENTRY/EXIT ** 
          SX1    =YURO= 
          SA5    FW=PARM     (X5) = FWA OF PARAMETER LIST 
          MI     X1,EXIT.    IF USER DID NOT PROVIDE *URO=* 
          RJ     =YURO=      USER *REG* OWNCODE 
          SA5    FW=PARM     RESTORE (X5) 
          EQ     EXIT.
 USO      SPACE  4,10 
**        USO - USER *SNP* OWNCODE. 
* 
* 
*         *USO* WILL CALL *USO=* TO ALLOW THE HOST TO PERFORM 
*         ITS OWNCODE IF THE IDP INSTALLER PROVIDED *USO=*. 
* 
*         ENTRY  (FW=PARM) = FWA OF PARAMETER LIST FOR THIS *SNAP*. 
* 
*         EXIT   (X1) = .MI. IF SNAP IS TO BE HONORED, ELSE .PL.
*                (X5) = FWA OF *SNAP* PARAMETER LIST. 
* 
*         USES   ALL
* 
*         CALLS  USO=(IF AVAIL) 
  
  
 USO      SUBR               ** ENTRY/EXIT ** 
          SX1    =YUSO= 
          SA5    FW=PARM     (X5) = FWA OF PARAMETER LIST 
          MI     X1,EXIT.    IF USER DID NOT PROVIDE *USO=* 
          RJ     =YUSO=      USER *SNP* OWNCODE 
          SA5    FW=PARM     RESTORE (X5) 
          EQ     EXIT.
 VAR      SPACE  4,10 
 .IDPOS   IFNE   .OS,2
**        VAR - PROCESS *VAR* TOKEN.
* 
* 
*         THIS ROUTINE PERFORMS SOME SPECIAL CASE PROCESSING
*         UPON A VARIABLE NAME, *VAR*, TOKEN DURING TOKEN 
*         GENERATION -- 
* 
*           1. *VAR* MAKES SURE THAT THIS *VAR* TOKEN IS NOT
*              TOO LONG, I.E. NR CHARS .LE. 7.  THIS IS NECESSARY 
*              FOR 2 PRIMARY REASONS:  FIRST, IDP IS NOT SET UP 
*              TO HANDLE A *VAR* TOKEN THAT IS LONGER THAN A SINGLE 
*              CM WORD.  CHECKING FOR THIS CONDITION EARLY (I.E. DURING 
*              TOKEN GENERATION) SHOULD SIMPLIFY THE WORK OF OTHERS.
* 
*              SECOND, BECAUSE *COMCTOK* CAN NOT BE TOLD TO GENERATE
*              A *VAR* TOKEN THAT IS 1 CM WORD LONG, WE HAVE TO CHECK 
*              OURSELVES. 
* 
*           2. BECAUSE HARDWARE REGISTER NAMES **LOOK** LIKE
*              VARIABLE NAMES, IT IS THE RESPONSIBILITY OF *VAR* TO 
*              CHECK FOR, AND REPLACE REGISTER NAMES WITH AN APPROPRIATE
*              *REG* TOKEN. 
* 
*         ENTRY  (A1,X1) = A+C OF *VAR* TOKEN TO CHECK. 
* 
*         EXIT   (A6)+1  = ADDR TO STORE NEXT TOKEN.
* 
*                TO *TOK=ER* IF *VAR* TOKEN TOO LONG. 
* 
*         USES   X - 1,2,3,6,7
*                A - 2,3,6
*                B - 2
* 
*         CALLS  TOK=ER 
  
  
 VAR      SUBR               ** ENTRY/EXIT ** 
          SA3    A1-B1       (A3,X3) = A+C OF TOKEN PRECEDING *VAR* 
          SA2    MX=BAX      (X2) = *BAX* CHARACTER SHIFT MASK
          LX1    CHAR 
          SX7    X3-O.VAR 
          ZR     X7,TOK=ER   IF VARIABLE NAME IS TOO LONG, ERROR... 
  
*         CHECK FOR REGISTER NAME.
  
          BX6    -X0*X1 
          LX1    CHAR 
          SB2    X6 
          LX2    B2 
          PL     X2,EXIT.    IF 1ST CHAR IS NOT *BAX* 
          SX7    020B        (X7) = 0TR, FOR -X- REG
          SB2    X6-1RX 
          ZR     B2,VAR2     IF -X- REG 
          SB2    X6-1RB 
          SX7    000B        (X7) = 0TR, FOR -B- REG
          ZR     B2,VAR2     IF -B- REG 
          SX7    010B        (X7) = 0TR, FOR -A- REG
  
 VAR2     SA2    MX=0..7     (X2) = *01234567* CHAR SHIFT MASK
          BX6    -X0*X1 
          LX1    CHAR 
          SB2    X6 
          LX2    B2 
          PL     X2,EXIT.    IF 2ND CHAR IS NOT *0..7*
          SX6    X6-1R0 
          MX2    5*CHAR 
          IX3    X7+X6       (X7) = 0TR 
          BX6    X2*X1
          LX3    TB.0TRP-0
          NZ     X6,EXIT.    IF 3RD THRU 7TH CHARS NON-NULL 
          SX1    O.REG
          BX6    X3+X1       MERGE *0TR* AND *TOT*
          SA6    A1 
          EQ     EXIT.
 VFD      SPACE  4,10 
**        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 
 .IDPOS   ENDIF 
 COMCIDP  SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 IDP=     =      /COMCIDP/IDP=
 ROL=     =      /COMCIDP/ROL=
  
          IF     DEF,/COMCIDP/.OS,1 
 .OS      =      /COMCIDP/.OS 
 IDP=ER   =      /COMCIDP/IDP=ER
 IDP=ERR  =      /COMCIDP/IDP=ERR 
 IDP=MN   =      /COMCIDP/IDP=MN
 IDP=SVB  =      /COMCIDP/IDP=SVB 
 IDP=SVA  =      /COMCIDP/IDP=SVA 
 IDP=SVX  =      /COMCIDP/IDP=SVX 
  
 REG=     =      /COMCIDP/REG=
 SNP=     =      /COMCIDP/SNP=
 QUAL$    ENDIF 
 COMCIDP  ENDX
