*COMDECK COMATOK
 COMATOK  CTEXT  COMATOK 2.0 - THE *TOGEL* MACROS.
 COMATOK  SPACE  4,10 
***       COMATOK - THE *TOGEL* MACROS. 
*         P CLARE   77/03/03
*         P CLARE   78/04/27 VERSION 2.0
 COMATOK  SPACE  4,10 
***       COMATOK - THE *TOGEL* MACROS. 
* 
* 
*         THIS COMDECK CONTAINS THE MACRO DEFINITIONS FOR *TOGEL*,
*         (TOKEN GENERATION LANGUAGE).  THESE MACROS ARE USED TO
*         GENERATE A *TOGEL OBJECT MODULE* (CALLED *TOM*) WHICH 
*         CAN THEN BE FED TO *COMCTOK*, THE COMMON TOKEN GENERATOR. 
*         *COMCTOK* WILL USE THE *TOM* GENERATED BY THESE MACROS TO 
*         GENERATE TOKENS FOR THE HOST PROGRAM. 
* 
*         *TOGEL* LOOKS SOMEWHAT LIKE A HIGHER LEVEL PROGRAMMING
*         LANGUAGE AND WAS DESIGNED SO AS TO ALLOW THE PROGRAMMER 
*         TO CONTROL THE LOGIC OF TOKEN GENERATION AND AT THE SAME
*         TIME TO MINIMIZE THE EFFECTS OF LOW-LEVEL DETAILS.
* 
*         THE *TOGEL* MACROS ARE--
* 
*                GROUP (A..Z),TOT,SQZ 
*                GROUP (A..Z),TOT,NSQZ
*                IFT (A..Z) 
*                  THEN 
*                  ELST 
*                  ENDT 
*                GOTO XX
*                CALT XX
*                CASEOF (A..Z)
*                  TOKEN TOT,(TOT1,...,TOTN),PAD
*                    .
*                    .
*                  TOKEN TOT,(TOT1,...,TOTN),PAD
*                ELSC 
*                  TOKEN TOT,(TOT1,...,TOTN),PAD
*                ENDC 
* 
*         LITTLE OR NO EFFORT IS MADE TO DESCRIBE THE MECHANICS 
*         OF USING THESE *TOGEL* MACROS HERE IN THE CODE.  THIS TOPIC 
*         IS DEALT WITH THOROUGHLY IN THE FTN 5 IMS/DECK *LEX*. 
* 
*         IN THE FOLLOWING PARAGRAPHS, *ASSEMBLY-TIME DEPENDENCIES* 
*         ARE INTERFACES THAT THE *COMATOK* INSTALLER MUST PROVIDE. 
*         *ASSEMBLY-TIME OPTIONS* REFER TO INTERFACES THAT ARE OPTIONAL,
*         I.E. INTERFACES THAT HAVE A DEFAULT VALUE.
* 
************************************************************************
* 
*         ASSEMBLY-TIME DEPENDENCIES -- 
* 
************************************************************************
* 
*         THE INSTALLER MUST PROVIDE *COMSTOK* WHICH CONTAINS 
*         *COMATOK/COMCTOK* INTERFACE SYMBOL DEFINITIONS. 
* 
************************************************************************
* 
*         ASSEMBLY-TIME OPTIONS --
* 
************************************************************************
* 
*         ALL ASSEMBLY-TIME OPTIONS ARE SET UP IN *COMSTOK*.
* 
************************************************************************
 COMATOK  SPACE  4,10 
**        *COMATOK* SYMBOL NAMING CONVENTIONS.
* 
* 
*         BECAUSE THE AUTHOR FINDS *COMPASS* MACRO CODE VERY DIFFICULT
*         TO READ, A FEW SYMBOL NAMING CONVENTIONS WERE ADOPTED IN
*         THE INTEREST OF READABILITY.  THE INTENT BEHIND THIS
*         CONVENTION IS TO PASS AS MUCH SEMANTIC INFORMATION ABOUT
*         "HOW" A SYMBOL IS USED IN THE SYMBOL NAME ITSELF.  IN THIS
*         WAY, IT IS HOPED THAT THE READER WILL SORT-OF KNOW WHAT 
*         TO EXPECT OF A SYMBOL BY MERELY LOOKING AT ITS NAME.  THIS
*         IS NOT A GREAT SYMBOL NAMING CONVENTION, BUT I HOPE IT MAKES
*         THIS CODE A LITTLE EASIER TO READ.
* 
*         SYMBOLS WITHIN *COMATOK* ARE OF THE FORM--
* 
*                '?TKSXXX 
* 
*         WHERE *'?TK* IS A COMMON PREFIX THAT IS USED TO AVOID 
*                      CONFLICTS WITH ANY HOST (THE HOST SHOULD AVOID 
*                      SYMBOLS OF THIS FORM). 
*               *S*    IS A SYMBOL TYPE, AND
*               *XXX*  IS A UNIQUE SYMBOL NAME. 
* 
*         SYMBOL TYPES *S* ARE--
*                C = MICRO NAME, I.E. A CHARACTER STRING. 
*                F = FLAG, I.E. A SYMBOL THAT IS USED AS A LOGICAL
*                    FLAG IN THE WAY ALL PROGRAMMERS HAVE COME TO 
*                    KNOW AND LOVE. 
*                M = MACRO NAME.
*                R = REMOTE BLOCK NAME (RMT). 
*                S = SET SYMBOL, I.E. AN ABSOLUTE EVALUATABLE EXPRESSION
*                    VALUE. 
*                # = A LABEL, I.E. EITHER AN *IF/ELSE/ENDIF* LABEL OR 
*                    A GENERATED LABEL. 
 CALT     SPACE  4,10 
**        *CALT* TOGEL INSTRUCTION/MACRO. 
* 
* 
*         CALT   CAD
* 
*         ENTRY  CAD = ADDR TO TRANSFER CONTROL TO. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC CALT
  
 CALT     MACRO  A
* 
*         GENERATE *TOGEL* BINARY INSTRUCTION.
* 
 '?TKS001 SET 60-TG.CADP-TG.CADL
 + VFD '?TKS001/0,TG.CADL/A-FW.TOK,TG.TOFUL/=XTOK=CAL-FW.TOK
* 
 CALT     ENDM
 CASEOF   SPACE  4,10 
**        *CASEOF* TOGEL INSTRUCTION/MACRO. 
* 
* 
*         FORM -- 
* 
*         CASEOF A,B
* 
*         EXAMPLES -- 
* 
*         CASEOF (+../),TAD 
*         CASEOF (A..Z) 
* 
*         ENTRY  A = RANGE OF CHARACTERS IN THIS *CASEOF*.
*                    NOTE: THIS MACRO GENERATES A MICRO OF THIS 
*                    PARAMETER AND USES ONLY THE 1ST AND LAST 
*                    CHARACTERS OF THE MICRO (*COA* AND *COZ*). 
*                B = OPTIONAL ADDR OF *TOKEN* CHARACTER MAP FOR THIS
*                    *CASEOF*.  IF ABSENT, THEN 1ST *TOKEN* FOLLOWING 
*                    THIS *CASEOF* WILL AUTOMATICALLY BECOME THE 1ST
*                    *TOKEN* ELEMENT IN THE CHAR MAP FOR THIS *CASEOF*. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC CASEOF
  
 CASEOF   MACRO  A,BB 
  LOCAL '?TKL001
* 
*         SET UP -- 
* 
*         '?TKSCOA = *COA*, 1ST CHAR IN *CASEOF* RANGE (IN DPC).
*         '?TKSCOZ = *COZ*, LAST CHAR IN *CASEOF* RANGE (IN RCS). 
* 
 '?TKCS01 MICRO 1,, A 
 '?TKS001 MICCNT '?TKCS01 
* 
 '?TKCS02 MICRO '?TKS001,1, "'?TKCS01"
 '?TKCS01 MICRO 1,1, "'?TKCS01" 
* 
 '?TKSCOA SET 1R"'?TKCS01"
 '?TKS001 SET 1R"'?TKCS02"+10000B-'?TKSCOA
 '?TKCS02 OCTMIC '?TKS001,2 
 '?TKSCOZ SET "'?TKCS02"B 
* 
*         SET UP ADDR OF *TOKEN* CHARACTER MAP FOR THIS *CASEOF*. 
* 
 '?TK#001 IFC NE, BB
 '?TKFCOF SET -1
 '?TKCTAD MICRO 
 '?TKCS01 MICRO 1,, BB
* 
 '?TK#001 ELSE
 '?TKFCOF SET 0 
 '?TKCTAD MICRO 1,, '?TKL001
 '?TKCS01 MICRO 1,, '?TKL001
* 
 '?TK#001 ENDIF 
* 
*         GENERATE TOGEL BINARY INSTRUCTION.
* 
 + VFD TG.COAL/'?TKSCOA,TG.COZL/'?TKSCOZ,TG.TADL/"'?TKCS01"-FW.TOK
  VFD TG.TOFUL/=XTOK=COF-FW.TOK 
* 
*         CONVERT '?TKSCOA TO RCS SO THAT *ELSC/ENDC* CAN PERFORM 
*         *CASEOF* RANGE CHECK. 
* 
 '?TKSCOA SET 77B 
* 
 CASEOF ENDM
 CHMIC    SPACE  4,20 
***       CHMIC - CREATE CHARACTER SHIFT MASK MICRO.
* 
* LOC     CHMIC  (LET1,LET2,...,LETN),BICH
* 
*         ENTRY  LOC = NAME OF THE MICRO TO BE CREATED. 
*                LET(I) = CHARACTERS TO GENERATE CHARACTER SHIFT
*                         MASK MICRO FOR.  CHARACTERS CAN BE SPECIFIED
*                         IN 1 OF 3 WAYS--
*                           1. AS A SINGLE CHARACTER, AS IN 
*                              *CHMIC (A,B,C)*. 
*                           2. AS A 2 OCDIT NUMBER, AS IN 
*                              *CHMIC (01,02,03)*.
*                           3. AS ANY EVALUATABLE *COMPASS* 
*                              EXPRESSION  (.GE. 3 CHARS), AS IN
*                              *CHMIC (1RA,02D,03B,5-1)*. 
*                         ANY OF THE ABOVE FORMS MAY BE USED, AND 
*                         IN ANY COMBINATION, AS IN 
*                         *CHMIC (A,02,03B,1RD,10D-4)*. 
* 
*                         NOTE-- *CHMIC* GENERATES BITS FOR CHARACTERS
*                         MODULO 60D.  THIS IMPLIES, THEREFORE THAT 
*                         0=60D, OR 1R:=1R\.
*                BICH = BIAS CHARACTER.  SPECIFIES BINARY VALUE OF
*                       CHARACTER THAT IS TO OCCUPY BIT 59 OF MICRO 
*                       TO GENERATE.  SEE *COMCBUB*.
* 
*         EXIT   LOC = MICRO CONTAINING THE 20-OCTAL DIGIT VALUE
*                            (WITH *B* SUFFIX PRESENT). 
* 
*         GENERATES A MICRO WITH 1-BITS IN SPECIFIED CHARACTER
*         POSITIONS.
  
  
          MACRO  CHMIC,LOC,LET,BICH 
* 
*         SET UP DEFAULT *BICH*.
* 
 '?CH#001 IFC    EQ,/BICH//,2 
 '?CHSBCH SET    00B
 '?CH#001 ELSE
 '?CHSBCH SET    BICH 
 '?CH#001 ENDIF 
* 
 '?CHCCSM MICRO  1,60, 0000000000_0000000000_0000000000_0000000000_00000
,00000_0000000000 
* 
          IRP    LET
* 
*         TRANSFORM *LET* INTO ITS BINARY VALUE.
* 
 '?CHCLET MICRO  1,, LET
 '?CHLLET MICCNT '?CHCLET 
* 
 '?CH#003 IFNE   '?CHLLET,0 
 '?CH#001 IFEQ   '?CHLLET,1 
 '?CHSLET SET    1R_LET 
* 
 '?CH#001 ELSE
 '?CH#002 IFEQ   '?CHLLET,2 
 '?CHSLET SET    LET_B
* 
 '?CH#002 ELSE
 '?CHSLET SET    LET
 '?CH#002 ENDIF 
 '?CH#001 ENDIF 
* 
*         CONVERT CHAR IN *'?CHSLET* TO *ROTATED CHAR SET* VALUE. 
* 
 '?CHSRCS SET    '?CHSLET+10000B-'?CHSBCH 
 '?CHCRCS OCTMIC '?CHSRCS,2 
 '?CHSRCS SET    "'?CHCRCS"B
          IFGE   '?CHSRCS,60D,2 
 '?CHCRCS DECMIC '?CHSRCS,1 
 '?CHSRCS SET    "'?CHCRCS" 
* 
*         EXTRACT TRAILING BITS.
* 
 '?CHCTBI MICRO  '?CHSRCS+2,,/"'?CHCCSM" /
* 
*         EXTRACT LEADING BITS. 
* 
 '?CHCLBI MICRO 
          IFNE   '?CHSRCS,0,1 
 '?CHCLBI MICRO  1,'?CHSRCS, "'?CHCCSM" 
* 
*         MERGE IN NEW BIT. 
* 
 '?CHCCSM MICRO  1,60, "'?CHCLBI"1"'?CHCTBI"
 '?CH#003 ENDIF 
          IRP 
* 
*         CONVERT BINARY TO OCTAL.
* 
 LOC       MICRO
 '?CHSS01 SET 
 '?CH#002  DUP   60D/3
 '?CHSS01 SET    1+'?CHSS01 
 '?CHCS01 MICRO  3*'?CHSS01-2,1, "'?CHCCSM" 
 '?CHCS02 MICRO  3*'?CHSS01-1,1, "'?CHCCSM" 
 '?CHCS03 MICRO  3*'?CHSS01-0,1, "'?CHCCSM" 
 '?CHCS03 OCTMIC "'?CHCS01"*4+"'?CHCS02"*2+"'?CHCS03",1 
 LOC      MICRO  1,, "LOC""'?CHCS03"
 '?CH#002 ENDD
* 
 LOC      MICRO  1,, "LOC"B 
 CHMIC    ENDM
 ELSC     SPACE  4,10 
**        *ELSC* TOGEL INSTRUCTION/MACRO. 
* 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC ELSC
  
 ELSC     MACRO 
* 
  IFNE '?TKSCOA,'?TKSCOZ,1
 P ERR *CASEOF* RANGE AND COUNT OF *TOKEN*S DO NOT AGREE "SEQUENCE" 
* 
*         SET '?TKFCOF TO INDICATE THAT WE HAVE PROCESSED AN *ELSC*.
* 
 '?TKFCOF SET 1 
* 
 ELSC ENDM
 ELST     SPACE  4,10 
**        *ELST* TOGEL INSTRUCTION/MACRO. 
* 
* 
* L       ELST
* 
*         ENTRY  L = *IFT/ELST/ENDT* LABEL. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  GOTO,'?TKMMEQ
  
          PURGMAC ELST
  
          MACRO  ELST,L 
* 
*         POP ENTRIES OFF '?TK1NNN UNTIL A MATCHING LABEL FOUND 
*         OR UNTIL NO MORE ENTRIES.  THIS PROCESS IS SIMILAR TO 
*         THE *ENDT* POPPING OF '?TK1NNN EXCEPT THAT WITH *ELST*
*         POPPING, '?TK1NNN IS NOT ALTERED SO THAT WHEN THE EXPECTED
*         *ENDT* DOES OCCUR THAT '?TK1NNN IS READY TO BE POPPED 
*         PERMANENTLY.
* 
 '?TKSLEN SET '?TK1LEN
* 
 '?TK#001 DUP '?TKSLEN
* 
 '?TKCS01 DECMIC '?TKSLEN,3 
 '?TKSLEN SET '?TKSLEN-1
* 
 '?TKCS02 '?TKMMEQ '?TK1"'?TKCS01"
* 
*         SET UP -- 
* 
*         '?TKCLNR - LATEST *IFT/ELST* LABEL NR.
*         '?TKCLAB - LATEST *IFT/ELST* LABEL, IF PRESENT. 
* 
*         NOTE: TEMPORARY MICRO NAMES ARE NOT USED BECAUSE THESE
*         MICROS HAVE TO SURVIVE A *GOTO* MACRO REFERENCE THAT IS 
*         GENERATED AS A RESULT OF *ELST*.  I.E. IT IS BAD PRACTICE 
*         TO ASSUME THAT A TEMPORARY SYMBOL WILL SURVIVE A MACRO
*         REFERENCE.
* 
 '?TKCLNR MICRO 1,3, "'?TKCS02" 
 '?TKCLAB MICRO 4,, "'?TKCS02"
* 
*         OUTPUT APPROPRIATE '?TKINNN INTERNAL LABEL SO THAT
*         *IFT* CAN BRANCH TO *ELST* IF *IFT* CONDITION IS FALSE. 
* 
  IF DEF,'?TKI"'?TKCLNR",1
 P ERR THIS *ELST* PREVIOUSLY DEFINED.
* 
*         OUTPUT A *GOTO '?TKENNN* TO SKIP *ELST* PORTION OF
*         *IFT/ELST/ENDT*.
* 
  GOTO '?TKE"'?TKCLNR"
* 
 '?TKI"'?TKCLNR" BSS 0
* 
*         IF IN *TEST* MODE, OUTPUT *ELST* BINARY INSTRUCTION.
* 
  IFNE TEST,0,1 
 + VFD 42/0L"'?TKCLAB",TG.TOFUL/=XTOK=ELS-FW.TOK
* 
*         CHECK *ELST* LABEL WITH '?TK1NNN LABEL. 
* 
  IFC EQ, "'?TKCLAB" L ,1 
  STOPDUP 
* 
 '?TK#001 ENDD
* 
 ELST ENDM
 ENDC     SPACE  4,10 
**        *ENDC* TOGEL INSTRUCTION/MACRO. 
* 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC ENDC
  
 ENDC     MACRO 
* 
   IFNE '?TKSCOA,'?TKSCOZ,1 
 P ERR *CASEOF* RANGE AND COUNT OF *TOKEN*S DO NOT AGREE "SEQUENCE" 
* 
*         REINITIALIZE '?TKFCOF.
* 
 '?TKFCOF SET -1
* 
 ENDC ENDM
 ENDT     SPACE  4,10 
**        *ENDT* TOGEL INSTRUCTION/MACRO. 
* 
* 
* L       ENDT
* 
*         ENTRY  L = *IFT/ELST/ENDT* LABEL. 
* 
*         EXIT   NONE 
* 
*         CALLS  '?TKMMEQ 
  
          PURGMAC ENDT
  
          MACRO  ENDT,L 
* 
*         POP ENTRIES OFF '?TK1NNN UNTIL A MATCHING LABEL FOUND 
*         OR UNTIL NO MORE ENTRIES. 
* 
 '?TK#001 DUP '?TK1LEN
* 
 '?TKCS01 DECMIC '?TK1LEN,3 
 '?TK1LEN SET '?TK1LEN-1
 '?TKCS02 '?TKMMEQ '?TK1"'?TKCS01"
* 
*         SET UP -- 
* 
*         '?TKCS01 = LATEST *IFT/ELST/ENDT* LABEL NR. 
*         '?TKCS02 = LATEST *IFT/ELST/ENDT* LABEL, IF PRESENT.
* 
 '?TKCS01 MICRO 1,3, "'?TKCS02" 
 '?TKCS02 MICRO 4,, "'?TKCS02"
* 
*         IF IN *TEST* MODE, OUTPUT *ENDT* BINARY INSTRUCTION.
* 
  IFNE TEST,0,1 
+ VFD TG.IFLL/0L"'?TKCS02",TG.TOFUL/=XTOK=ENT-FW.TOK
* 
*         OUTPUT APPROPRIATE INTERNAL LABELS FOR THIS '?TK1NNN ENTRY. 
* 
  IF -DEF,'?TKI"'?TKCS01",1 
 '?TKI"'?TKCS01" BSS 0
* 
 '?TKE"'?TKCS01" BSS 0
* 
*         CHECK *ENDT* LABEL WITH '?TK1NNN LABEL. 
* 
  IFC EQ, "'?TKCS02" L ,1 
  STOPDUP 
* 
 '?TK#001 ENDD
* 
 ENDT ENDM
 GENTOK   SPACE  4,10 
**        *GENTOK* TOGEL INSTRUCTION/MACRO. 
* 
* 
*         GENTOK TOT
* 
*         ENTRY  TOT = TOKEN TYPE TO GENERATE.
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC GENTOK
  
 GENTOK   MACRO  TOT
* 
*         GENERATE *TOGEL* BINARY INSTRUCTION.
* 
 '?TKS001 SET 60-TG.GTTP-TG.GTTL
 + VFD '?TKS001/0,TG.GTTL/"O."TOT,TG.TOFUL/=XTOK=GEN
 GENTOK   ENDM
 GOTO     SPACE  4,10 
**        *GOTO XX* TOGEL INSTRUCTION/MACRO.
* 
*         GOTO LAB
* 
*         ENTRY  LAB = *COMPASS* LOCATION FIELD TO *GOTO* TO. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC GOTO
  
 GOTO     MACRO  A
* 
*         GENERATE *TOGEL* BINARY INSTRUCTION.
* 
 '?TKS001 SET 60-TG.GOTP-TG.GOTL
 + VFD '?TKS001/0,TG.GOTL/A-FW.TOK,TG.TOFUL/=XTOK=GO-FW.TOK 
 GOTO ENDM
 GROUP    SPACE  4,10 
**        *GROUP (A..Z),TOT,SQZ/NSQZ* TOGEL INSTRUCTION/MACRO.
* 
* 
*         GROUP  RNG,TOT,MODE 
* 
*         ENTRY  RNG  = A CHARACTER RANGE THAT SPECIFIES THE CHARACTERS 
*                       THAT ARE TO BE GROUPED TOGETHER BY THIS *GROUP*.
*                       A CHARACTER RANGE CAN BE SPECIFIED VIA ANY
*                       COMBINATION OF THE FOLLOWING SYNTAXES-- 
*                         1. A CHARACTER RANGE CAN BE SPECIFIED VIA A 
*                            SIMPLE LIST, AS IN *GROUP (ABCDEFG)*.
*                         2. A CHARACTER RANGE MAY BE NOTATED USING THE 
*                            SPECIAL OPERATOR *..*, AS IN *GROUP (A..G)*
*                            WHICH READS "FROM A TO G". 
*                         3. INDIVIDUAL CHARACTERS CAN BE SPECIFIED AS
*                            2 DIGIT OCTAL NUMBERS, VIA THE SPECIAL 
*                            FORM */NN*, WHERE */* IS A PREFIX OPERATOR,
*                            AND *NN* IS A 2 DIGIT OCTAL CONSTANT.
*                            E.G. *GROUP (/01../07)*. 
* 
*                       EXAMPLES--
*                         GROUP (A..Z0..9)
*                         GROUP (+..:)
*                         GROUP (+..*/77/00)
* 
*                TOT  = TOKEN TYPE TO ASSOCIATE WITH THIS *GROUP*.
*                       *COMATOK* WILL PREFIX THIS NAME WITH THE
*                       OPTIONALLY USER-DEFINED MICRO "O.". 
* 
*                MODE = MODE OF *GROUP*ING. 
*                     = *SQZ* MEANS THAT BLANKS ARE SQUEEZED (IGNORED). 
*                     = *NSQZ* MEANS THAT BLANKS ARE NOT SQUEEZED.
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  '?TKMRNG 
  
  
          PURGMAC GROUP 
  
 GROUP    MACRO  A,B,C
          LOCAL  '?TK#001 
* 
*         DETERMINE WHICH *TOFU* TO INVOKE. 
* 
 '?TKCTOF MICRO 1,, TOK=GS
   IFC EQ, C NSQZ ,1
 '?TKCTOF MICRO 1,, TOK=GN
* 
*         GENERATE *TOGEL* BINARY INSTRUCTION.
* 
 '?TKS001 SET 60-TG.TOTP-TG.TOTL
 + VFD '?TKS001/0,TG.TOTL/"O."B,TG.MXAL/'?TK#001-FW.TOK,________________
,__TG.TOFUL/=X"'?TKCTOF"-FW.TOK 
* 
*         GENERATE CHARACTER RANGE SHIFT MASK.
* 
   '?TKMRNG (A) 
* 
 '?TKRCSM '?TKMRMT ('?TK#001 LIT "'?TKCRNG")
* 
 GROUP ENDM 
 IFT      SPACE  4,10 
**        *IFT (A..Z)* TOGEL INSTRUCTION/MACRO. 
* 
* 
*         IFT RNG 
* 
*         ENTRY  RNG = A CHARACTER RANGE THAT SPECIFIES THE CHARACTERS
*                      THAT ARE TO BE TESTED FOR.  SEE *GROUP* MACRO
*                      FOR A DESCRIPTION OF *RNG* SYNTAX. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  '?TKMRNG 
  
  
          PURGMAC IFT 
  
  MACRO IFT,L,A 
  LOCAL '?TK#001
* 
*         SET UP--
* 
*           '?TKSIGL   = GENERATED LABEL NR FOR *IFT/ELST/ENDT* 
*                        IMPLIED JUMPS.  '?TKSIGL WILL BE USED TO 
*                        GENERATE 2 UNIQUE LABELS: ONE FOR THE IMPLIED
*                        FALSE JUMP FROM THE *IFT* TO THE *ELST*, AND 
*                        ONE FOR THE IMPLIED JUMP FROM THE *ELST* TO
*                        THE *ENDT*.
* 
*                        *IFT/ELST* BRANCH IS TO A LABEL OF THE FORM -- 
* 
*                             '?TKINNN
* 
*                        WHERE *I* IS A SYMBOL TYPE MEANING *IFT/ELST*
*                        GENERATED LABEL, AND *NNN* IS A 3 DIGIT DECIMAL
*                        CONVERSION OF '?TKSIGL  (VIA *DECMIC*).
* 
*                        *ELST/ENDT* BRANCH IS TO A LABEL OF THE FORM --
* 
*                             '?TKENNN
* 
*                        WHERE *E* MEANS *ELST/ENDT* GENERATED LABEL. 
* 
*         FOR EXAMPLE, CONSIDER THE FOLLOWING --
* 
*                  IFT (A..Z) ---------------+ FALSE BRANCH 
*                   .                        +
*                  GOTO '?TKE001 (IMPLIED) --+-+
*                  ELST                      + +
*         '?TKI001 BSS 0   <-----------------+ +
*                   .                          +
*                  ENDT                        +
*         '?TKE001 BSS 0   <-------------------+
* 
 '?TKSIGL SET '?TKSIGL+1
  IFGT '?TKSIGL,999D,1
 P ERR TOO MANY *IFT/THEN/ELST/ENDT* BLOCKS. "SEQUENCE" 
* 
 '?TKCIGL DECMIC '?TKSIGL,3 
* 
*         GENERATE *TOGEL* BINARY INSTRUCTION.
* 
 '?TKS001 SET 60-TG.FALP-TG.FALL
 + VFD '?TKS001/0,TG.FALL/'?TKI"'?TKCIGL"-FW.TOK,_______________________
,__TG.MXAL/'?TK#001-FW.TOK,TG.TOFUL/=XTOK=IFT-FW.TOK
* 
*         GENERATE CHAR RANGE SHIFT MASK. 
* 
  '?TKMRNG (A)
 '?TKRCSM '?TKMRMT ('?TK#001 LIT "'?TKCRNG")
* 
*         MAKE '?TK1NNN ENTRY FOR THIS LABEL.  '?TK1NNN IS A MICRO
*         ARRAY THAT CONTAINS ALL THE CURRENTLY ACTIVE *IFT/ELST/ENDT*
*         LABELS.  EACH ENTRY IN '?TK1NNN CONTAINS THE LABEL NAME 
*         (AS SPECIFIED VIA *LAB* PARAMETER), THE *'?TKI* AND *'?TKE* 
*         SUFFIX FOR THIS LABEL, AND THE STATUS OF THE LABEL (EXPLAINED 
*         BELOW).  THIS MICRO ARRAY CAN BE THOUGHT OF AS A SYMBOL TABLE 
*         FOR THE ACTIVE *IFT/ELST/ENDT* LABELS AND IS USED AS A FORM 
*         OF COMMUNICATION BETWEEN THE *IFT/ELST/ENDT* MACROS SO THAT 
*         THEY CAN GENERATE THE APPROPRIATE LABELS AND IMPLIED *GOTO*S
*         ASSOCIATED WITH THESE MACROS. 
* 
*         EACH '?TK1NNN ENTRY IS A MICRO STRING OF THE FORM --
* 
*                XXXLLL 
* 
*         WHERE *XXX* IS THE *'?TKSIGL* NR FOR THIS *IFT/ELST/ENDT* 
*                     BLOCK.
*               *S*   IS THE STATUS OF THE LABEL. 
*                     = *+* IF THIS BLOCK HAS BEEN DEFINED VIA *IFT*, 
*                     ELSE * * (BLANK(55B)).
*               *LLL* IS THE LABEL ITSELF, AS SPECIFIED VIA *LAB* 
*                     PARAMETER.  IF NO *LAB* WAS PRESENT, THEN *LLL* 
*                     WILL BE NULL. 
* 
 '?TK1LEN SET '?TK1LEN+1
 '?TKCS01 DECMIC '?TK1LEN,3 
 '?TKCS02 MICRO 1,, '?TK1"'?TKCS01" 
* 
 "'?TKCS02" MICRO 1,, "'?TKCIGL"_L
* 
 IFT ENDM 
 ON       SPACE  4,10 
**        *ON I,V* TOGEL INSTRUCTION/MACRO. 
* 
* 
*         ON I,V
* 
*         ENTRY  I = INTERUPT TYPE. 
*                V = VALUE TO STORE INTO INTERUPT FLAG. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC ON
  
 ON       MACRO  I,V
* 
 '?TKCS01 MICRO 1,4, I
 '?TKS001 SET 60-TG.INVP-TG.INVL
 + VFD '?TKS001/0,TG.INVL/V,TG.INCL/TC."'?TKCS01",______________________
,__TG.TOFUL/=XTOK=ON-FW.TOK 
* 
 ON       ENDM
 PROC     SPACE  4,10 
**        *PROC* TOGEL INSTRUCTION/MACRO. 
* 
*         DEFINE TOGEL *PROC* ENTRY POINT.  THIS MACRO IS MODELED 
*         (I.E. COPIED) FROM *SUBR* MACRO IN *COMACPU*. 
* 
* PRN     PROC               DEFINE *EXIT.* AND *PRN_X*.
* PRN     PROC   0           SAME 
* PRN     PROC   =           SAME, AND DEFINE *PRN* AS ENTRY POINT. 
* PRN     PROC   -           DEFINE *EXIT.* BUT NOT *PRN_X*.
* PRN     PROC   LETTER      DEFINE *PRN_LETTER* BUT NOT *EXIT.*. 
* 
*         ENTRY  *PRN* = PROC NAME. 
* 
*         EXIT   TOGEL/COMPASS GENERATED -- 
* 
*                PRN    GOTO  *+4S15   ALWAYS 
*                       ENTRY PRN      IF = SPECIFIED.
*                EXIT.  SET   *        IF BLANK, 0, =, OR - SPECIFIED.
*                       NOREF EXIT.    IF BLANK, 0, =, OR - SPECIFIED.
*                PRN_X  EQU   *        IF BLANK, 0, OR = SPECIFIED. 
*                       NOREF PRN_X    IF BLANK, 0, OR = SPECIFIED. 
*                PRN_LETTER EQU *      IF LETTER SPECIFIED. 
* 
*         USES   NONE 
* 
*         CALLS NONE
  
  
          PURGMAC PROC
  
          MACRO  PROC,T,A 
 T GOTO *+4S15D 
 '?TKCS01 MICRO 1,,=T=
  IFC NE, A  ,3 
  IFC LT, A 0 ,2
 "'?TKCS01" EQU *-1 
  SKIP 7
  IFC NE, A - ,4
  IFC EQ, A = ,1
  ENTRY T 
 "'?TKCS01"X EQU *-1
  NOREF "'?TKCS01"X 
 EXIT. SET *-1
  NOREF EXIT. 
 PROC ENDM
 TOGEL    SPACE  4,10 
**        TOGEL - BEGIN/END *TOGEL* PROGRAM.
* 
* 
*         THIS MACRO IS USED TO DELIMIT A *TOGEL* PROGRAM.  THAT IS,
*         EVERY *TOGEL* PROGRAM SHOULD CONTAIN 2 *TOGEL* MACRO
*         REFERENCES: ONE AS THE 1ST LINE OF THE *TOGEL* PROGRAM, 
*         AND ONE AS THE LAST LINE OF THE *TOGEL* PROGRAM.
* 
*         THIS MACRO SETS UP AND WINDS UP THE ASSEMBLY OF THE *TOGEL* 
*         PROGRAM BY BOTH SETTING UP GLOBAL SYMBOLS AND BY FORCING
*         ASSEMBLY OF THE *RMT* BLOCKS. 
* 
*                            ** WARNING **
* 
*         IF THE PROGRAMMER FORGETS A TERMINATING *TOGEL* REFERENCE,
*         ONLY PARTIAL ASSEMBLY OF THE *TOGEL* PROGRAM WILL OCCUR 
*         (I.E. THE *RMT* BLOCKS ARE NOT ASSEMBLED), RESULTING IN 
*         NUMEROUS ASSEMBLY ERRORS. 
* 
*                                * * *
* 
*         FORM -- 
* 
* PGM     TOGEL 
* 
*         EXAMPLES -- 
* 
* PGM1    TOGEL 
*           . 
*           . 
* PGM1    TOGEL 
* 
* PGM2    TOGEL 
*           . 
*           . 
* PGM2    TOGEL 
* 
*         ENTRY  PGM = OPTIONAL NAME OF *TOGEL* PROGRAM.  *TOGEL* USES
*                      *PGM* TO VERIFY THAT THE BEGINNING AND END 
*                      *TOGEL* MACRO REFS REFER TO THE SAME *TOGEL* 
*                      PROGRAM. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC TOGEL 
  
          MACRO  TOGEL,A
* 
*         CHECK TO SEE IF THIS IS A *HEADER* REF OR AN *END* REF
*         AND PROCESS ACCORDINGLY.
* 
*         IN ADDITION, IF THIS IS A 1ST TIME EVER REF, THEN WE NEED 
*         TO DEFINE A FEW SYMBOLS BEFORE PROCEEDING.
* 
*         '?TKFHDR = HEADER FLAG. 
*                  = 0 IF THIS IS A *HEADER* REF (I.E. BEGINNING
*                      *TOGEL* PROGRAM), ELSE 
*                  = 1 IF THIS IS AN *END* REF (I.E. ENDING *TOGEL* 
*                      PROGRAM).
* 
  IF -DEF,'?TKFHDR,2
'?TKFHDR SET 0
'?TKSHDR SET 0
* 
 '?TK#001 IFEQ '?TKFHDR,0 
* 
*         HERE IF THIS IS A *HEADER* REF (I.E. BEGINNING *TOGEL* PGM).
*         NEED TO --
*           1. TOGGLE '?TKFHDR SO THAT NEXT *TOGEL* REF WILL BE *END*.
*           2. SET UP '?TKCHDR AS THE NAME OF THIS *TOGEL* PROGRAM. 
*              IF *PGM* PARAMETER OCCURRED, THEN '?TKCHDR CONTAINS THE
*              SPECIFIED CHARACTERS IN PROGRAM NAME.  ELSE IF *PGM* 
*              DID NOT OCCUR, THEN '?TKCHDR IS A STRING OF THE FORM-- 
*                 '?TKHNNN
*              WHERE *'?TKH* IS A PREFIX/SYMBOL TYPE, AND *NNN* IS
*              A 3 DIGIT DECIMAL NR THAT IS DERIVED FROM '?TKSHDR,
*              WHICH IS MERELY INCREMENTED FOR EACH NEW *TOGEL* PGM.
* 
 '?TKFHDR SET 1 
 '?TKSHDR SET '?TKSHDR+1
* 
 '?TKCHDR MICRO 1,, A 
  IFC EQ, A  ,2 
 '?TKCS01 DECMIC '?TKSHDR,3 
 '?TKCHDR MICRO 1,, '?TKH"'?TKCS01" 
* 
*         MISCELLANEOUS INITIALIZATIONS.
* 
  IF -DEF,'?TKSIGL,1
 '?TKSIGL SET 0 
* 
  IF -DEF,'?TKSCOF,1
 '?TKSCOF SET 0 
* 
  IF -DEF,'?TKSTLK,1
 '?TKSTLK SET 0 
* 
 '?TK1LEN SET 0 
 '?TK2LEN SET 0 
 '?TK3LEN SET 0 
 '?TKFCOF SET -1
* 
*         HERE IF *END* REF (I.E. ENDING A *TOGEL* PROGRAM).
*         NEED TO --
*           1. CHECK TO SEE THAT *PGM* NAME MATCHS '?TKCHDR.
*           2. FORCE ASSEMBLY OF *RMT* BLOCKS.
* 
 '?TK#001 ELSE
 '?TKCS01 MICRO 1,, A 
 '?TK#002 IFC NE, "'?TKCS01"
  IFC NE, "'?TKCHDR" "'?TKCS01" ,1
 '?TK#003 SKIP
 '?TK#002 ELSE
 '?TKCS02 MICRO 1,5, "'?TKCHDR" 
  IFC NE, "'?TKCHDR" '?TKH ,2 
 '?TK#003 ENDIF 
 P ERR *TOGEL* PROGRAM DELIMITER NAMES DO NOT MATCH. "SEQUENCE" 
 '?TK#002 ENDIF 
* 
*         SET ALL END-OF-FALSE CHAIN ENTRIES IN '?TK3NNN
*         TO 0  (I.E. END-OF-CHAIN).
* 
 '?TKS001 SET 0 
 '?TK#003 DUP '?TK3LEN
 '?TKS001 SET '?TKS001+1
* 
 '?TKCS01 DECMIC '?TKS001,3 
 '?TKCS02 '?TKMMEQ '?TK3"'?TKCS01"
 '?TKCS03 MICRO 1,3, "'?TKCS02" 
* 
 '?TKT"'?TKCS03" = 0
 '?TK#003 ENDD
* 
*         FORCE *RMT* ASSEMBLIES. 
* 
 '?TKRCSM HERE
 '?TKRTLK HERE
 '?TKRTOK HERE
 '?TKFHDR SET 0 
 '?TK#001 ENDIF 
 TOGEL ENDM 
 TOKEN    SPACE  4,10 
**        *TOKEN* TOGEL INSTRUCTION/MACRO.
* 
* 
* LAB     TOKEN  TOT,STX,PAD
* 
*         ENTRY  LAB = LABEL FIELD FOR THIS *TOKEN* ENTRY.
*                TOT = TOKEN TYPE FOR THIS *TOKEN*.  CHARS IN *TOT* 
*                      PARAMETER WILL BE PREFIXED WITH "O." MICRO.
*                STX = SYNTAX FOR THIS *TOKEN*.  USED TO DEFINE TOKENS
*                      THAT ARE DEFINED VIA OTHER TOKENS. 
*                PAD = PROCESSOR ADDR.  OPTIONAL PARAMETER THAT 
*                      SPECIFIES A SPECIAL PROCESSOR THAT IS TO BE
*                      INVOKED WHEN AND IF THIS TOKEN IS GENERATED. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  '?TKMMEQ,'?TKMSMA,'?TKMTLK 
  
          PURGMAC TOKEN 
  
          MACRO  TOKEN,A,BB,C,D 
* 
 '?TK#001 IFC EQ, C 
* 
  IF -MIC,'?TKCTAD,1
 '?TKCTAD MICRO 
 A '?TKMTOK BB,D,"'?TKCTAD",'?TKRTOK
 '?TKCTAD MICRO 
* 
*         IF '?TKFCOF .ZR., THEN NEED TO ADVANCE '?TKSCOA SO THAT 
*         *ELSC/ENDC* CAN PERFORM *CASEOF* RANGE CHECK. 
* 
  IFEQ '?TKFCOF,0,2 
 '?TKCS01 OCTMIC '?TKSCOA+1+10000B,2
 '?TKSCOA SET "'?TKCS01"B 
* 
*         HERE IF *STX* PARAMETER IS NON-NULL.
* 
 '?TK#001 ELSE
 '?TK2LEN SET 0 
* 
 '?TK#002 IRP C 
 '?TK2LEN SET '?TK2LEN+1
 '?TKCS01 DECMIC '?TK2LEN,3 
* 
 '?TK2"'?TKCS01" MICRO 1,, C
* 
 '?TK#002 IRP 
* 
*         SEARCH FOR NAME OF SYMBOL THAT DEFINES NEXT *FALSE* TLINK 
*         ENTRY.
* 
 '?TKCS01 '?TKMMEQ '?TK2"'?TKCS01"
  '?TKMSMA 3,4
* 
*         SET UP SYMBOL NAME THAT IS TO BE THE LOCATION FIELD 
*         OR THE BEGINNING OR THIS *TLINK* TRUE CHAIN.
* 
*           1. IF A FIND IN '?TK3NNN, THEN THIS IS NOT THE 1ST *TLINK*
*              ENTRY FOR THE CHAIN.  '?TK3NNN ENTRY CONTAINS
*              THE SYMBOL NAME FOR NEXT *FALSE* CHAIN ENTRY.
* 
*           2. IF NO FIND IN '?TK3NNN, THEN THIS IS THE 1ST *TLINK* 
*              ENTRY FOR THE CHAIN.  SYMBOL NAME IS '?_TOT.  NEED 
*              TO CREATE A '?TK3NNN ENTRY.
* 
 '?TK#003 IFNE '?TKS001,0 
* 
*         HERE IF A FIND. 
* 
 '?TKCS04 MICRO 1,3, "'?TKCS02" 
 '?TKCTLK MICRO 1,, '?TKT"'?TKCS04" 
* 
 '?TKSTLK SET '?TKSTLK+1
  IFGT '?TKSTLK,999D,1
 P ERR TOO MANY *TLINK* SYMBOLS "SEQUENCE"
* 
 '?TKCS04 DECMIC '?TKSTLK,3 
* 
*         HERE IF NO FIND.
* 
 '?TK#003 ELSE
* 
 '?TK3LEN SET '?TK3LEN+1
  IFGT '?TK3LEN,999D,1
 P ERR TOO MANY *TLINK* ENTRIES "SEQUENCE"
* 
 '?TKSTLK SET '?TKSTLK+1
  IFGT '?TKSTLK,999D,1
 P ERR TOO MANY *TLINK* ENTRIES "SEQUENCE"
* 
 '?TKCS03 DECMIC '?TK3LEN,3 
 '?TKCS03 MICRO 1,, '?TK3"'?TKCS03" 
* 
 '?TKCS04 DECMIC '?TKSTLK,3 
 '?TKCTLK MICRO 1,, '?"'?TKCS01"
* 
 '?TK#003 ENDIF 
* 
*         HERE WHEN READY TO MAKE ENTRY INTO '?TK3NNN.
* 
*         ENTRY  '?TKCS01 = CHARS IN THIS TOKEN TYPE NAME.
*                '?TKCS03 = '?TK3NNN ENTRY TO STORE INTO. 
*                '?TKCS04 = '?TKTNNN NR FOR THIS TOKEN. 
* 
 "'?TKCS03" MICRO 1,, "'?TKCS04""'?TKCS01"
* 
*         READY TO POP *STX* ENTRIES OFF '?TK2NNN, GENERATING 
*         ENTRIES ALONG THE WAY.
* 
   IFLE '?TK2LEN,1,1
 P ERR *STX* PARAMETER MUST CONTAIN AT LEAST 2 TOKENS "SEQUENCE"
* 
 '?TKCFAL MICRO 1,, '?TKT"'?TKCS04" 
* 
 '?TK#006 DUP '?TK2LEN-1
* 
 '?TK2LEN SET '?TK2LEN-1
 '?TKCS01 DECMIC '?TK2LEN,3 
 '?TKCTOT '?TKMMEQ '?TK2"'?TKCS01"
* 
 '?TKSTLK SET '?TKSTLK+1
  IFGT '?TKSTLK,999D,1
 P ERR TOO MANY *TLINK* ENTRIES "SEQUENCE"
* 
 '?TKCTRU DECMIC '?TKSTLK,3 
 "'?TKCTLK" '?TKMTLK "'?TKCTOT",'?TKT"'?TKCTRU","'?TKCFAL"
* 
 '?TKCTLK MICRO 1,, '?TKT"'?TKCTRU" 
 '?TK#006 ENDD
* 
 '?TKT"'?TKCTRU" SET 0
* 
 '?TKCS01 MICRO 1,, D 
 '?TKCS02 MICRO 1,1, D
* 
  IFC EQ, "'?TKCS02" * ,2 
 '?TKCS01 MICRO 2,, D 
 '?TKCS01 MICRO 1,, -"'?TKCS01" 
* 
 A '?TKMTOK BB,("'?TKCS01"),,'?TKRTLK 
* 
 '?TK#001 ENDIF 
* 
 TOKEN    ENDM
 XEQ      SPACE  4,10 
**        *XEQ* TOGEL INSTRUCTION/MACRO.
* 
*         XEQ    PRN
* 
*         ENTRY  PRN  = NAME/ADDR OF *TOGEL* PROC TO XEQ. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC XEQ 
  
 XEQ      MACRO  P
* 
*         GENERATE *TOGEL* BINARY INSTRUCTION.
* 
 '?TKS001 SET 60-TG.XADP-TG.XADL
 + VFD '?TKS001/0,TG.XADL/=X_P-FW.TOK,TG.TOFUL/=XTOK=XEQ-FW.TOK 
* 
 XEQ      ENDM
 '?TKMAPL SPACE  4,10 
**        '?TKMAPL - GENERATE APLIST FOR *CHMIC*. 
* 
* 
*         ENTRY  A = BINARY DPC VALUE OF CHAR TO GEN APL FOR
* 
*         EXIT   '?TKCAPL UPDATED 
* 
*         CALLS  NONE 
  
  
 '?TKMAPL MACRO A 
 '?TKCS01 OCTMIC A,2
 '?TKCAPL MICRO 1,, "'?TKCAPL","'?TKCS01" 
 '?TKMAPL ENDM
 '?TKMGRT SPACE  4,10 
**        '?TKMGRT - GET RANGE TOKEN. 
* 
* 
*         THIS MACRO PROVIDES *'?TKMRNG* WITH A SINGLE RANGE TOKEN. 
* 
*         ENTRY  '?TKCICS = CHAR STRING 
*                '?TKPICS = ORD OF 1ST CHAR IN "'?TKCICS" TO GENERATE 
*                           TOKEN FOR.
* 
*         EXIT   '?TKCICS = UNCHANGED 
*                '?TKSTOT = TOKEN TYPE.  TOKEN TYPES ARE -- 
*                         = 0 IF END-OF-STRING ENCOUNTERED. 
*                         = 1 IF SINGLE CHAR TOKEN.  SEE *'?TKSDPC* 
*                             BELOW.
*                         = 2 IF *..* TOKEN ENCOUNTERED.
*                '?TKSDPC = BINARY DPC VALUE OF CHAR IF *'?TKSTOT=1*. 
* 
*         CALLS  NONE 
  
  
 '?TKMGRT MACRO 
* 
*         CHECK FOR END-OF-STRING TOKEN.
* 
  IFGT '?TKPICS,'?TKLICS,2
 '?TKSTOT SET 0 
 '?TK#002 SKIP
* 
*         CHECK FOR *..* TOKEN. 
* 
  IFEQ '?TKSTOT,2,1 
 '?TK#001 SKIP
  IFLE '?TKPICS,'?TKLICS-1,5
 '?TKCS01 MICRO '?TKPICS,2, "'?TKCICS"
  IFC EQ, "'?TKCS01" .. ,3
 '?TKPICS SET '?TKPICS+2
 '?TKSTOT SET 2 
 '?TK#002 SKIP
* 
*         CHECK FOR */NN* TOKEN.
* 
  IFLE '?TKPICS,'?TKLICS-2,12D
 '?TKCS01 MICRO '?TKPICS,1, "'?TKCICS"
  IFC NE, "'?TKCS01" / ,1 
 '?TK#001 SKIP
 '?TKCS01 MICRO '?TKPICS+1,2, "'?TKCICS"
  IFC GT, "'?TKCS01" 77 ,1
 '?TK#001 SKIP
  IFC LT, "'?TKCS01" 00 ,1
 '?TK#001 SKIP
 '?TKSTOT SET 1 
 '?TKSDPC SET "'?TKCS01"B 
 '?TKPICS SET '?TKPICS+3
 '?TK#002 SKIP
* 
*         HERE IF THIS IS A SINGLE CHAR TOKEN.
* 
 '?TK#001 ENDIF 
 '?TKCS01 MICRO '?TKPICS,1, "'?TKCICS"
 '?TKSTOT SET 1 
 '?TKSDPC SET 1R"'?TKCS01"
 '?TKPICS SET '?TKPICS+1
* 
*         HERE WHEN DONE. 
* 
 '?TK#002 ENDIF 
 '?TKMGRT ENDM
 '?TKMMEQ SPACE  4,10 
**        '?TKMMEQ - MICRO EQUIVALENCE. 
* 
* 
*         THIS MACRO EQUATES TWO MICRO STRINGS.  IT IS ONLY TRULY 
*         USEFUL WHEN THE MICRO NAME ON THE RIGHT-SIDE OF THE 
*         EQUIVALENCE IS BEING GENERATED VIA MICRO STRINGS. 
* 
* A       '?TKMMEQ B
* 
*         ENTRY  A = MICRO NAME TO EQUATE *B* TO. 
*                B = OLD MICRO NAME.
* 
*         EXIT   "A" CREATED AND "B" LEFT ALONE.
* 
*         CALLS  NONE 
  
  
          PURGMAC '?TKMMEQ
  
  MACRO '?TKMMEQ,A,B
 A MICRO 1,, "B"
 '?TKMMEQ ENDM
 '?TKMPMA SPACE  4,10 
**        '?TKMPMA - PRINT MICRO ARRAY. 
* 
* 
*         THIS MACRO IS FOR INTERNAL DEBUGGING ONLY.  WHEN USED,
*         PRINTS THE CONTENTS OF A SPECIFIED MICRO ARRAY.  A MICRO
*         ARRAY HAS THE FORM -- 
* 
*                '?TKNXXX 
* 
*         WHERE *'?TK* IS A *COMATOK* COMMON SYMBOL PREFIX, *N* IS
*         A MICRO ARRAY NUMBER, AND *XXX* IS A MICRO ARRAY ELEMENT
*         NUMBER.  FOR EXAMPLE, CONSIDER THE MICRO ARRAY NUMBER *3*.
*         EACH ELEMENT IN MICRO ARRAY *3* IS A MICRO OF THE FORM -- 
* 
*                '?TK3XXX 
* 
*         I.E. -- '?TK3001, '?TK3002, '?TK3003, ETC.
* 
*         '?TKMPMA N
* 
*         ENTRY  N = MICRO ARRAY NR.
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  '?TKMMEQ 
  
  
          PURGMAC '?TKMPMA
  
 '?TKMPMA MACRO N 
  LOCAL '?TK#001,'?TK#002 
* 
 '?TKSD01 SET 0 
* 
 '?TK#002 DUP '?TK_N_LEN
 '?TKSD01 SET '?TKSD01+1
* 
 '?TKCD01 DECMIC '?TKSD01,3 
 '?TKCD02 '?TKMMEQ '?TK_N_"'?TKCD01"
* 
  '?TK_N_"'?TKCD01" = "'?TKCD02"
* 
 '?TK#002 ENDD
* 
 '?TKMPMA ENDM
 '?TKMRMT SPACE  4,10 
**        '?TKMRMT - FORCE MICRO EVALUATION FOR *RMT* BLOCKS. 
* 
* 
*         THIS MACRO IS USED SOLEY FOR THE PURPOSE OF FORCING 
*         MICRO EVALUATION IN *RMT* BLOCKS. 
* 
* BLK     '?TKMRMT S
* 
*         ENTRY  BLK = REMOTE BLOCK NAME
*                S   = STMT TO BE ENTERED INTO REMOTE BLOCK *BLK*.
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC '?TKMRMT
  
          MACRO  '?TKMRMT,BLK,S 
 BLK RMT
 S
 BLK RMT
 '?TKMRMT ENDM
 '?TKMRNG SPACE  4,10 
**        '?TKMRNG - GENERATE MICRO FOR CHARACTER RANGE.
* 
* 
*         THIS MACRO EVALUATES THE *TOGEL* CHARACTER RANGE, AS IT 
*         OCCURS IN *GROUP* AND *IFT* STATEMENTS, AND CREATES THE 
*         MICRO "'?TKCRNG" WHICH CONSISTS OF A BIT STRING THAT HAS
*         A BIT *ON* FOR EACH CHARACTER IN THE RANGE.  THIS BIT 
*         STRING IN "'?TKCRNG" IS DESTINED TO BECOME A
*         CHARACTER SHIFT MASK AS IS USED BY *COMCBUB*. 
*         SEE *COMCTOK* AND *COMCBUB/COMCBUN*.  NOTE THAT CHARS 
*         IN "'?TKCRNG" ARE THEREFORE IN A *ROTATED CHAR SET* 
*         REPRESENTATION. 
* 
*         THE ALGORITHM USED HERE IS TO TREAT THE CHARACTERS
*         IN THE RANGE (I.E. THE INPUT TO THIS MACRO) AS A STRING 
*         THAT IS TO BE SCANNED FROM LEFT-TO-RIGHT (VIA MICRO 
*         MANIPULATION).  THIS IS DONE BY MAKING CONSECUTIVE
*         CALLS TO *'?TKMGRT* (GET RANGE TOKEN) WHICH RETURNS A 
*         TOKEN TYPE, *'?TKSTOT*, FOR THE NEXT TOKEN IN THE RANGE.
* 
*         TOKEN TYPES, *'?TKSTOT*, ARE--
* 
*                = 0 IF END-OF-STRING ENCOUNTERED.  I.E. WE ARE DONE. 
*                = 1 IF CHAR TOKEN ENCOUNTERED.  THE ACTUAL CHAR IS IN
*                    *'?TKSDPC* (TOKEN VALUE) IN BINARY DPC.  *'?TKMGRT*
*                    WILL CALL *'?TKMGRB* (GENERATE RANGE BIT) TO MERGE 
*                    THE APPROPRIATE BIT FOR THIS CHAR INTO "'?TKCRNG". 
*                = 2 IF *..* TOKEN ENCOUNTERED.  *'?TKMGRT* WILL CALL 
*                    '?TKMAPL TO GENERATE APLIST ITEMS FOR
*                    EACH CHAR IN RANGE, TO BE USED AS INPUT
*                    TO *CHMIC*.
* 
*         IT SHOULD BE NOTED THAT THE */NN* SYNTAX IS RESOLVED BY 
*         *'?TKMGRT*, WHICH RETURNS *'?TKSTOT=1* WITH THE BINARY
*         VALUE *NN* IN *'?TKSDPC*. 
* 
*         ENTRY  A = CHARACTER RANGE AS IT OCCURS IN *TOGEL*. 
* 
*         EXIT   '?TKCRNG = CHAR SHIFT MASK FOR *A*.
* 
*         CALLS  '?TKMAPL,'?TKMGRT,CHMIC
  
  
 '?TKMRNG MACRO A 
* 
*         INITIALIZE -- 
* 
*         '?TKCICS = MICRO THAT CONTAINS THE ENTIRE INPUT CHARACTER 
*                    STRING.
*         '?TKPICS = ORD OF NEXT CHAR IN "'?TKCICS".
*         '?TKLICS = LEN OF "'?TKCICS"
*         '?TKCSGN = MICRO THAT CONTAINS /-/ IF 1ST CHAR IN RANGE 
*                    IS /-/, I.E. PROGRAMMER SPECIFIED *(-XXX)* WHICH 
*                    MEANS THAT RANGE IS TO BE NEGATED.  ELSE NULL. 
*         '?TKCAPL = NULL.
*         '?TKODPC = BIN DPC VALUE FOR ":"
*         '?TKSDPC = BIN DPC VALUE FOR ":"
*         '?TKSTOT = 0, I.E. BEGINNING-OF-STRING. 
* 
 '?TKCAPL MICRO 
 '?TKCICS MICRO 1,, A 
 '?TKCSGN MICRO 1,1, "'?TKCICS" 
* 
 '?TK#001 IFC NE, "'?TKCSGN" -
 '?TKCSGN MICRO 
 '?TK#001 ELSE
 '?TKCICS MICRO 2,, "'?TKCICS"
 '?TK#001 ENDIF 
* 
 '?TKPICS SET 1 
 '?TKLICS MICCNT '?TKCICS 
 '?TKODPC SET    0
 '?TKSDPC SET    0
* 
 '?TKSTOT SET 0 
* 
*         CYCLE THRU CHARACTER RANGE IN "'?TKCICS", 
*         GENERATING "'?TKCAPL".
* 
 '?TK#006 DUP -1
  '?TKMGRT
* 
*         IF NOT END-OF-STRING, THEN PROCESS NEXT TOKEN.
*         ELSE READY TO GENERATE "'?TKCRNG" USING "'?TKCAPL". 
* 
 '?TK#005 IFNE '?TKSTOT,0 
* 
*         CHECK FOR AND PROCESS *..* TOKEN. 
* 
 '?TK#003 IFEQ '?TKSTOT,2 
* 
*         HERE IF *..* TOKEN OCCURRED.
*         GET TOKEN/CHAR THAT TERMINATES RANGE. 
* 
  '?TKMGRT
  IFEQ '?TKSTOT,0,1 
 '?TKSDPC SET 1R; 
* 
*         LOOP THROUGH CHAR RANGE, GENERATING CHARS TO *'?TKCAPL* 
*         AS WE GO.  CHAR RANGE IS FROM *'?TKODPC* TO *'?TKSDPC*. 
* 
  '?TKMAPL '?TKODPC 
 '?TK#001 DUP -1
 '?TK#002 IFNE '?TKODPC,'?TKSDPC
 '?TKCS01 OCTMIC '?TKODPC+1+10000B,2
 '?TKODPC SET "'?TKCS01"B 
  '?TKMAPL '?TKODPC 
 '?TK#002 ELSE
  STOPDUP 
 '?TK#002 ENDIF 
 '?TK#001 ENDD
* 
*         CHECK FOR AND PROCESS A SINGLE CHAR TOKEN.
* 
 '?TK#003 ELSE
   IFEQ '?TKSTOT,1,1
   '?TKMAPL '?TKSDPC
* 
 '?TK#003 ENDIF 
 '?TK#005 ELSE
   STOPDUP
 '?TK#005 ENDIF 
* 
*         NEW CHAR BECOMES OLD CHAR.
* 
 '?TKODPC SET '?TKSDPC
 '?TK#006 ENDD
* 
*         GENERATE "'?TKCRNG" MICRO.
* 
 '?TKCRNG CHMIC ("'?TKCAPL"),BICH 
 '?TKCRNG MICRO 1,, "'?TKCSGN""'?TKCRNG"
 '?TKMRNG ENDM
 '?TKMSMA SPACE  4,10 
**        '?TKMSMA - SCAN MICRO ARRAY.
* 
* 
*         '?TKMSMA N,FC,NC
* 
*         ENTRY  N  - MICRO ARRAY NR. 
*                FC = 1ST CHAR POSITION IN EACH ARRAY ELEMENT 
*                     TO SEARCH AT. 
*                NC = NR OF CHARS (BEGINNING AT *FC*) TO COMPARE, 
*                   = 0 IF REST OF MICRO ARRAY ENTRY (AS IN *MICRO* 
*                     PSEUDO).
* 
*                '?TKCS01 = ELEMENT TO SEARCH FOR.
*                '?TKNLEN = NR OF ENTRIES IN THIS MICRO ARRAY 
*                           (WHERE *N* IS MICRO ARRAY NR).
* 
*         EXIT   '?TKCS01 = UNCHANGED.
*                '?TKS001 = MICRO ARRAY ELEMENT NR IF A FIND, ELSE
*                         = .ZR. IF NO FIND.
*                '?TKCS02 = MICRO CONTAINING FOUND ENTRY IN '?TKNXXX. 
*                '?TKCS03 = MICRO CONTAINING MICRO NAME OF FOUND
*                           ENTRY.
*                           I.E. "'?TKCS03" MICRO 1,, "'?TKCS02"
* 
*         CALLS  '?TKMMEQ 
  
  
          PURGMAC '?TKMSMA
  
 '?TKMSMA MACRO A,B,C 
  LOCAL '?TK#001,'?TK#002,'?TK#003
* 
 '?TKS001 SET '?TK_A_LEN
 '?TK#002 IFGT '?TKS001,0 
* 
 '?TK#001 DUP '?TK_A_LEN
* 
 '?TKCS03 DECMIC '?TKS001,3 
 '?TKCS03 MICRO 1,, '?TK_A_"'?TKCS03" 
 '?TKCS02 '?TKMMEQ "'?TKCS03" 
 '?TKCS04 MICRO B,C, "'?TKCS02" 
 '?TK#003  IFC EQ, "'?TKCS01" "'?TKCS04"
  STOPDUP 
* 
 '?TK#003 ELSE
 '?TKS001 SET '?TKS001-1
 '?TK#003 ENDIF 
 '?TK#001 ENDD
 '?TK#002 ENDIF 
* 
 '?TKMSMA ENDM
 '?TKMTLK SPACE  4,10 
**        '?TKMTLK - GENERATE *TLINK* ENTRY.
* 
* 
*         THIS MACRO IS USED SOLELY TO FORCE MICRO EVALUATION 
*         OF PARAMETERS INTO THIS MACRO.
* 
* LAB     '?TKMTLK TOT,TRU,FAL
* 
*         ENTRY  LAB = *TLINK* LABEL FOR THIS ENTRY.
*                TOT = *STX* TOKEN FROM *TOKEN* MACRO.
*                TRU = LABEL FOR *TRUE* LINK. 
*                FAL = LABEL FOR *FALSE* LINK.
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC '?TKMTLK
  
          MACRO  '?TKMTLK,A,B,C,D 
* 
 '?TKRTLK RMT 
 '?TKCS01 MICRO 1,, B 
 '?TKS001 MICCNT '?TKCS01 
* 
 '?TKCS02 MICRO 1,,'_B_'
 '?TKS002 MICCNT '?TKCS02 
* 
 '?TKSMAF SET 0 
* 
 '?TK#007 IFNE '?TKS001,'?TKS002
* 
*         HERE IF NEED TO PROCESS SPECIAL CHARACTER MATCH FORM. 
* 
 '?TKSMAF SET 1 
* 
 '?TKCS03 MICRO '?TKS002+1,, B
 '?TKCS03 MICRO 1,,"'?TKCS03"'
* 
 '?TK#007 ENDIF 
* 
*         GENERATE *TLINK* ENTRIES. 
* 
 A BSS 0
  VFD TL.MAFL/'?TKSMAF,5/0,TL.TRUL/C-FW.TOK,TL.FALL/D-FW.TOK,___________
,__TL.TOTL/"O.""'?TKCS02" 
* 
  IFEQ '?TKSMAF,1,1 
  DATA 0L"'?TKCS03" 
* 
 '?TKRTLK RMT 
* 
 '?TKMTLK ENDM
 '?TKMTOK SPACE  4,10 
**        '?TKMTOK - GENERATE *TOKEN* TABLE.
* 
* 
*         THIS MACRO IS USED SOLELY TO FORCE MICRO EVALUATION 
*         OF PARAMETERS INTO THIS MACRO.
* 
* LAB     '?TKMTOK TOT,PAD,TAD,RMT
* 
*         ENTRY  LAB = PROGRAMMER SPECIFIED LABEL FOR THIS *TOKEN*. 
*                TOT = TOKEN TYPE.
*                PAD = PROCESSOR ADDR.
*                TAD = TOKEN ADDR.  USED SO THAT *CASEOF* MACRO CAN 
*                      POINT TO THIS TOKEN AS THE 1ST *TOKEN* IN A
*                      TOKEN CHAR MAP.
*                RMT = *RMT* BLOCK NAME 
* 
*         EXIT   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC '?TKMTOK
  
          MACRO  '?TKMTOK,A,B,C,D,E 
* 
 E RMT
  IF -DEF,'?_B,1
 '?_B SET 0 
* 
 D BSS 0
* 
  IF -DEF,"O="B,1 
 "O="B BSS 0
 '?TKS001 SET 60-TK.PADP-TK.PADL
 A VFD '?TKS001/0,TK.PADL/C-FW.TOK,TK.LNKL/'?_B-FW.TOK,TK.TOTL/"O."B
 E RMT
 '?TKMTOK ENDM
 COMATOK  ENDX
