TMG

Doug McIlroy has described how he and Bob Morris used TMG from Bob McClure at Texas Instruments to write the EPL compiler.
Doug McIlroy が EPL コンパイラを書くために、 彼と Bob Morris が Texas Instruments の Bob McClure の TMG をどのように使ったのかを 説明してくれました。

I got a nice note from Ron Tatum, about TMG.
私は Ron Tatum から TMG に関する素晴らしいメモを手に入れました。

I have copies of TMG written in TMG(L), and the resultant 360/370 assembler language source for a version of TMG that runs under OS360 (whatever version was in effect ca. 1973). Mike Green took Bob McClure's 7090/7040 version and implemented the compiler-compiler on the 360; best I can tell, Joe Cointment picked up that package and did some more work on it, resulting in what is a partially functional TMG for the old TI ASC machine. If it would be of any value to your groups' efforts, I can scrounge up the files on my system and e-mail them to you.
私は TMG(L) で書かれた TMG のコピーと、それから作成した (およそ 1973 年あたりに使われていた全てのバージョンの) OS360 で動作する TMG の 360/370 アセンブリ言語のソースのバージョンを を持っています。 Mike Green は Bob McClure の 7090/7040 バージョンを手に入れ、 360 で動くコンパイラ−コンパイラを実装しました。 Joe Cointment がこのパッケージを取り上げ、 いくつかの機能を追加した結果、 古い TI ASC マシンのための局所的に関数型の TMG になりました。 もしあなたのグループの活動にとって何らかの価値があるのであれば、 私のシステムから取ってきてメールで送ることができます。

So here is the source of TMG, somewhat modified from when we used it in 1966. This describes the TMG language in itself. The TMG code for EPL is probably long gone, unless somebody saved a listing..
これが TMG のソースで、 1966 年に使った時に少々手を入れたものです。 これは TMG 自身で TMG を記述しています。 おそらく EPL のコードはなくなっているしまっているでしょう。

TMG was the compiler definition tool used by Ken Thompson to write the compiler for the B language on his PDP-7 in 1970. B was the immediate ancestor of C. (Dennis Ritchie, The Evolution of the Unix Time-sharing System)
TMG は 1970 年に PDP-7 用の B 言語のコンパイラを書くために Ken Thompson が使ったコンパイラ定義用のツールでした。 BC の直系の祖先です。 (Dennis Ritchie, The Evolution of the Unix Time-sharing System)

*/////////////////////////////////////////////////////////////////////
*/ Author: Joe Cointment
*/ Version: 002
*/ Date: 73.073
*/ TMGL: TMG IN TMG
*/ NOTE: THIS VERSION, TO ACCOMODATE PC KEYBOARDS, USES THE TILDE
*/       (~) FOR NOT; THE CARET (^) COULD ALSO BE USED. THE CHANGE
*/       IS OBVIOUS DOWN AROUND LABEL "RELOP.."
*/////////////////////////////////////////////////////////////////////
.OPTIONS. DICT   $
.DECLARE.
.FUNCTIONS. BLANKS CARDOF CARDON COPY DEFINE DELETE DICT
         DOUBLE DUMDUM DUMENT EJECT EOF EOLMRK EXIT GLOT KILL LIST
         NEXTSYM NOBLKS NOLIST NOREF NOSOURC PASS2 SCAN
         SINGLE SKIPCOM SOURCE TRACEOF TRACEON.
.FUNCTIONS. ;      AFIND CHECK CLEAR EXTRN FIELD FIND GETI
         GET INSTALL INTRN MARKS PUT RESTORE SAVE SETINT TYPEVAR.
.FUNCTIONS.  ; ; CINSTAL CONVERT DEC DEQUEUE GETCON GETVAL GLOTTO GOTO
         MAX NOT PARSE POP PREFIX PUSH PUTI PUTVAL QUEUE SETTAB
         SET SWAP TYPE.
NUM      = '0123456789'                                    $
ALPHA    = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'                    $
ALPHANUM = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789'         $

P1 = ('$P1')       $
P2 = ('$P2')       $
P3 = ('$P3')       $
P12 = ('$P1$P2')   $
P21 = ('$P2$P1')   $
P321     = ('$P3$P2$P1')     $
Q1 = ('$Q1')       $
Q2 = ('$Q2')       $
Q3 = ('$Q3')       $
Q4 = ('$Q4')       $
Q5 = ('$Q5')       $
NULL = ('')        $
NOQUOTE = *''''    $
U0       =0        $
U1       =1        $
P1OF12 =(2)('$P1(Q1,Q2)')      $
P1OFQ1   =(1)('$P1(Q1)') $
Q1ALT = ('AL3($Q1)') $
Q2ALT = ('AL3($Q2)')
Q3ALT = ('AL3($Q3)')
.TABS.   1,10,16   $
.FLAGS. U,M,FA,F,FV,CC,A,Q,DEFD,BOOL,STR, LOC,LIT
DEF = *'$/''#>'   $
NODOL = *'$'      $
SIGN     = '+-'   $
NOTBLK   = *' '   $
ACT      =0       $
RCT      =0       $
TRACE    =0       $
LISTSW   =0       $
DICTSW   =0       $
TABSW    =0       $
CT       =0       $
FLGCNT   =1       $
FOUR     =4       $
ZEROCT   =0       $
EIGHT    =8       $ 
FUNFLAG  =0       $
INTVAL   =0       $
MVAL     =0       $
STCOL    =16      $
.QUEUE.  R(50)
T1       =0
FAL      =('FAIL$$')       $
SUC      =('SUCCESS$$')       $
ZERO     = ('0')  $
ONE = ('1')       $
TWO = ('2')       $
SDEF = ('/ST')    $
LDEF = ('/L')     $
MLOPD = (1)('/DC/X''08'',$Q1,A($P1)//')  $
U2       =2       $
TITLE1     'TMGL DATED MARCH 15,1973'
TITLE2     ' '                                         $
TITLE3     'END OF COMPILATION'                        $
TITLE6     'CROSS REFERENCE LISTING'                   $
MSG3       '***DECLARATION IN ERROR,IGNORED***'        $
MSGZ       '***END OF FILE, END MISSING***'            $
MES10      '***FUNCTION MUST HAVE ARGUMENTS: '      $
MES15      '***FUNCTION DECLARATION IN ERROR***'    $
MES5       '***TABS PREVIOUSLY DECLARED, THIS ONE IGNORED***'  $
MES7       '***MULTIPLY DEFINED NAME : ' $
MES8       '***UNDEFINED VARIABLE: '     $
MES9       '***FUNCTION CANNOT HAVE ARGUMENTS: '    $
SVMRK1     =0        $
*/  $
.SYNTAX. .FOR. TMGL            $
TMGL..   TYPE(TITLE1)          TYPE(TITLE2)        PREDCL-FUNC
         SKIPCOM   =('$F7(STCOL)')                               $
TMGL1..  COMMENT/TMGL2       **/TMGL1                            $
TMGL2    DECHAID/ERROR1      **/DECLARE                          $
ERROR1.. TYPE('***.DECLARE. MISSING, DECLARATIONS ASSUMED***')
         DECOUT    $
DECLARE..COMMENT/DECS   BODYHD/DECLARE   END/BODY   **/ENDUP     $
DECS..   DECL/ERROR3 BODYHD/DECLARE  **/BODY     $
ERROR3.. TYPE(MSG3) FLUSH BODYHD/DECLARE **/BODY  $
*
BODY..   CARDOF              $
BODYX..  COMMENT/BDY         END/BODYX **/ENDUP                  $
BDY..    STATE/BDY1          **/BDY                              $
BDY1..   COMMENT/BDY2        **/BDY                              $
BDY2..   END/ERROR4          **/ENDUP                            $
*
ERROR4.. TYP-MES4  **/BODYX                                      $
ENDUP..  CKTAB     **/ERRORS                                     $
ERRORS:  SEARCH/DICTIT       **/ERRORS                           $
DICTIT:  OUTEND IF(DICTSW.EQ.1) EJECT SINGLE
         TYPE('     TMG CROSS REFERENCE LISTING')  TYPE(NULL)
         DICT   **    $
SEARCH:  SCAN CHECK(LIT)/SRCH1 INTRN EXTRN
         =('$F6(U2) $P2/DC/F''$P1''//$F6')
SRCH1:   CHECK(U)/SRCH2 CHECK(M)/(EXIT) TYPEVAR(MES7) KILL =NULL
SRCH2:   TYPEVAR(MES8) KILL =NULL
CKTAB..  IF(TABSW.EQ.1)/MISSTAB EXIT   $
MISSTAB.. = ('$F6(U1)/ENTRY/TABMRK//TABMRK/DC/AL1(1),5A(0),A(255)//')
OUTEND.. =  ('$F6(U2)/END//')          $
*/  $
DECL..   CARDOF
         CHARCLX/DCL1        CR=P1     $
DCL1..   STRING-DEC/DCL2     CR=P1     $
DCL2..   VALUE-DEC/DCL3      CR=P1     $
DCL3..   TABS/DCL4           CR=P1     $
DCL4..   FLAGS/DCL5          CR=P1     $
DCL5..   FUNDCL/DCL6         CR=P1     $
DCL6..   DEFDCL/DCL7         CR=P1     $
DCL7..   CODE-DEC/DCL8       CR=P1     $
DCL8..   STACK-DEC/DCL9      CR=P1     $
DCL9..   ARRAY-DEC/DCL10     CR=P1     $
DCL10..  BOOL-DEC/DCL11      CR=P1     $
DCL11..  COMP-DEC/DCL12      CR=P1     $
DCL12..  QUEUE-DEC/DCL13     CR=P1     
DCL13..  LOC-DEC             CR=P1
*
*
CHARCLX..   NAME SAVE '=' '*'/CHARX1 STRING RESTORE DNAM SET(CC)
         =(1)('/DC/X''0800000008'',VL3(CCHARCL$$),A($Q1,$P2)//
         $F6(U1)$Q1/DC/ $P1 // $P2/DC/32X''00''//$F6')  $
CHARX1.. STRING RESTORE DNAM SET(CC)
         =(1)('/DC/X''0800000008'',VL3(CHARCL$$ ),A($Q1,$P2)//
         $F6(U1)$Q1/DC/ $P1 // $P2/DC/32X''FF''//$F6')  $
*
STRING-DEC.. NAME STRING SET(STR) DNAM
         =(1)('$F6(U1)$P2/DC/ $P1//  $F6')   $
*
VALUE-DEC..   NAME '=' SAVE SNUMBZ RESTORE DNAM
         =('$F6(U1)$P2/DC/F''$P1''//$F6')
*
TABS..   '.TABS.' INSTALL('.TABS.') CHECK(U)/TABS1 TYPE(MES5) = NULL $
TABS1..   SET(U) TABVAL  <',' TABVAL =P1>*  COMPUTE(TABSW=1)
          =('$F6(U1)/ENTRY/TABMRK//TABMRK$P2$P1/DC/5A(0),A(255)//$F6')
TABVAL..  NUMBER    =('/DC/AL1($P1)//')  $
*
*
FLAGS..   '.FLAGS.' FLGVAL <',' FLGVAL=P1 >* = ('$F6(U1)$P2$P1$F6')    $
FLGVAL..  DNAME = ('$P1/DC/A($F3(FLGCNT))//$F1(FLGCNT,FLGCNT)')
*
FUNDCL.. '.FUN' EATREST         COMPUTE (FUNFLG=U+F) FUNCT*
         ';'/FINFUN COMPUTE(FUNFLG=FV+U)           FUNCT*
         ';'/FINFUN COMPUTE(FUNFLG=FA+U)   FUNCT* ';'/FINFUN            $
FINFUN.. '.'/(TYPE(MES15)) CARDON GLOT =NULL      $
FUNCT..  DNAME SET(FUNFLAG) '='/FUNCT1 FNAME      $
FUNCT1.. SETINT ','/*+1 = NULL          $
CODE-DEC.. '.CODE.' CARDON GLOT // BLANKS PARSE(CODE-OUT) GLOT=NULL
CODE-OUT.. NOT(END) GOBBLE **/CODE-OUT
GOBBLE.. MARKS GLOT // COPY =('$F6(U1) $P1 $F6')
*/  $
DEFDCL.. NAME SAVE DEFN RESTORE DNAM SET(DEFD) PUTVAL(MVAL)
         = ('$P1(P2)')       $
DEFN..   '=' CARDOF PARMCT COMPUTE(MVAL=INTVAL) '(''' DEFX* ''')'
         OUT-MVAL
         =(1)('$F6(U1) $Q1/DC/$P1$P2,AL2(0) //$F6')  $
OUT-MVAL.. IF(MVAL.NE.0)/(=('0C''$ ''')  )  DEC(MVAL)
         =('    X''FEFE'',AL1($P1*4)')  $
*
DEFX..   '//'/SP1   =('   ,X''00FC''  ')          $
SP1..    '/'/SP11   = ('   ,X''00F8''  ')         $
SP11..   '#'/SP2 = ('///DC/0C''$ ''')  $
SP2..    '$Q'/SP3  NUMBER MAX(MVAL,INTVAL,MVAL) =('   ,AL2($P1*4)  ')$
SP3..    FORP/SP4  NUMBER ARGLIST =(',$P3,AL1($P2*4),$P1')   $
FORP..   '$P'/('$F' =('X''00F0''') ) = ('X''00F4''')  $
ARGLIST.. BLPAREN/(=('AL1(0)') ) RARG COMPUTE(RCT=4)
         <',' RARG COMPUTE(RCT=RCT+4)=P1 >* DEC(RCT)  ')'
         =('AL1($P1)$P3$P2') $
RARG..   RARGX* DEQUEUE(R,T1) INTRN
         <DEQUEUE(R,T1) INTRN=(',$P1')>* = (',A($P2$P1)')
RARGX..  <NAME/(SNUMBY)=P1>/RAR1 GETVAL(INTVAL) MAX(MVAL,INTVAL,MVAL)
                      SAVE(T1) QUEUE(R,T1) = NULL
RAR1..   '(''' DEFX* ''')' DUMDUM INTRN SAVE(T1) QUEUE(R,T1)
         =(',X''E4'',A($Q1)//$P1/DC/0C'' ''$P2//$Q1/DC/0C'' ''')
*
SP4..    '$C'/SP5 '(' BOOL-NAME/SP44 ')' '<' DEFX* '>'
        =(1)(',X''00E8'',A($P2,$Q1) $P1 //$Q1/DC/0C''$ ''')$
BOOL-NAME.. NAME CHECK(BOOL) = P1  $
SP44..    BOOLEX ')' '<' DEFX* '>'
         =(2)(',X''00E8'',A($Q2,$Q1)$P1//$F6$F6(U2)
         /USING/$Q2,15//$Q2/DS/0H//$P2(FAL,SUC)/DROP/15///LTORG//
         $F6$F6(U1) $Q1/DC/0C''$ ''')$
*
SP5..    '$'/SP6 BLANKS MARKS NODOL/DEFA COPY = (1)(',C''$P1'' ')$
DEFA..   '$'       =    ('      ,C''$$ ''  ')    $
SP6..    ''''''/SP7 = ('      , C''''''''  ')    $
SP7..    DEFSTR  = (',C''$P1'' ')      $
DEFSTR..  MARKS NOBLKS DEF DEF* COPY =P1  $
*
*
STACK-DEC..        '.STA' EATREST DNAME SAVE SET(A) ','/*+1
         INUMBER SET(U) PUT
         = ('$F6(U2)$P2/DC/A($P1*4,0)///DS/$P1F//$F6')          $
*
ARRAY-DEC..  '.ARR' EATREST DNAME SET(A)SAVE ','/*+1 INUMBER SET(U)
         PUT  = ('$F6(U2)$P2/DS/$P1F//$F6')      $
*
QUEUE-DEC.. '.QUEUE.' DNAME SAVE SET(Q) ','/*+1 INUMBER SET(U)
         PUT = ('$F6(U2)$P2/DC/A($P1*4,0,0)///DS/$P1F//$F6')         $
BOOL-DEC..         '.BOO' EATREST DNAME '=' SET(U,BOOL,F)  BOOLEX
      =('$F6(U1)$P2/DS/0H///USING/$P2,15//$F4(CT,ZEROCT)$P1(FAL,SUC)
         /DROP/15/////LTORG//$F6')          $
COMP-DEC..    '.EXP' EATREST DNAME '=' SET(U,F,BOOL) SMARK '(' ASSGTS
         ')' = ('$F6(U1)$F4(CT,ZEROCT)  $P2/DS/0H///USING/$P2,15//
         $P1  /B/SUCCESS$$///DROP/15///LTORG//$F6')   $
LOC-DEC.. '.LOCAL.' <NAME DEFINE SET(U,LOC) EXIT>* = NULL
*/  $
STATE..  COMPUTE(ACT=0) LABEL ITEM ALT/RECUR-ALT CLN=('$P3$P2(P1)') $
RECUR-ALT.. '/' LBRK STATE* RBRK CLN  =(2)('$P3$P2(Q1ALT)/
         DC/A($Q2,0)//$Q1 $P1 $Q2/EQU/*//')     $
LBRK..   '('/('<') EXIT
RBRK..   ')'/('>') EXIT
CLN..    CARDON '$'/CLN1 GLOT $
CLN1..   ///*+1 CARDOF EXIT $
ITEM..   ITEMX '|'/(=P1OFQ1)    ITEMY
         =('$P2(Q2ALT) /DC/A($Q3,0)//  $Q2 $P1(Q1,Q3) $Q3/EQU/*//')
*
ITEMY..  ITEMX  '|'/(=P1OFQ1)  ITEMY
         =('$P2(Q3ALT) /DC/A($Q2,0) // $Q3 $P1(Q1,Q2)  ')
ITEMX..  RHAND/LHAND = P1OFQ1
LHAND..  '<'/LP1 STATE* '>'  <BLANKS '*'/(=('00')) =('10')>
         =(2)('/DC/X''$P1'',$Q1,A(*+12,$Q2,0)//$P2 $Q2/EQU/*//') $
ALT..    NOT(SLASH-SLASH)/(=('AL3(0)') ) '/'/(=(AL3(0)') )
         NAME/ALT1 =   ('AL3($P1)')  $
ALT1..   '*+1' DEC(ACT) =('AL3(*+7+$P1)')  $
RHAND..  EQNAME/RHAND1 = P1OFQ1  $
RHAND1.. DEFN = (2)('/DC/X''0C'',$Q1,A($Q2)//$P1(Q2)')  $
EQNAME..  '=' NAME     =   (1)('/DC/X''0C'',$Q1,A($P1)//')  $

LP1..    IF-STATE/LP2        =P1OFQ1   $
LP2..    FUNCTION/LP3        =P1OFQ1   $
LP3..    STAR-STAR/LP4       =P1OFQ1   $
LP4..    COMPUTES/LP5        =P1OFQ1   $
LP5..    CHAR-CLASS/LP6      =P1OFQ1   $
LP6      FIXED-STRING/LP7    =P1OFQ1   $
LP7..    COMPONENT/LP8       =P1OFQ1   $
LP8..    SLASH-SLASH         =P1OFQ1   $
*
IF-STATE.. 'IF' SMARK '(' BOOLEX/IFER ')'/IFER SINSTAL/IFS1=MLOPD $
IFS1..   INTRN
        =(1)('/DC/X''08'',$Q1,A($P1)//$F6(U1)/USING/$P1,15/DS/0H
         //$F4(CT,ZEROCT)$P2(FAL,SUC)/DROP/15///LTORG//$F6(U0)')$
IFER..   TYPE('***ERROR IN IF STATEMENT***') KILL = NULL         $
              
FUNCTION.. NAME CHECK(F,FV,FA) CHECK(BOOL)/F2 = MLOPD       $
F2..     <CHECK(LOC)/(=('V'))=('A')> BLPAREN/F1
         CHECK(FA,FV)/(TYPEVAR(MES9))
         LARGS/(TYPE('***ERROR IN ARGUMENT LIST***') = NULL )  ')'
         DEC(ACT)=(2)('/DC/X''08'',$Q1,AL1($P1),$P3L3($P4$$)//$P2')  $
F1..     CHECK(F,FV)/(TYPEVAR(MES10))
         =(1)('/DC/X''08'',$Q1,AL1(0),$P1L3($P2$$)//')       $
STAR-STAR.. '**'   =(1)('/DC/X''00'',$Q1,A(0)//')          $
COMPUTES.. 'COMPUTE'/*+1 SMARK '(' ASSGTS ')' SINSTAL/COMP1=MLOPD
COMP1..  INTRN = (1)('$P0(MLOPD)/$F6(U1)USING/$P1,15//
          $P1/DS/0H//$F4(CT,ZEROCT)$P2/B/SUCCESS$$///DROP/15///LTORG//
          $F6')$

CHAR-CLASS.. NAME CHECK(CC) COMPUTE(ACT=4)
         <'*'/(=('CHAR$$')  ) = ('STRING$$') >
         =(1)('/DC/X''08'',$Q1,AL1(4),VL3($P1),A($P2)//')  $
         
FIXED-STRING.. NAME/FXT1 CHECK(STR)=(1)('   /DC/X''04'',$Q1,A($P1)//')$
FXT1..   STRING=(2)('/DC/X''04'',$Q1,A($Q2)//$F6(U1)
         $Q2/DC/ $P1//$F6')  $

COMPONENT..        NAME <BLANKS '*'/(=('00'))=('10')>
         =(1)('/DC/X''$P1'',$Q1,A($P2)//')       $
SLASH-SLASH.. '//' =(1)('/DC/X''08'',$Q1,AL1(0),VL3(EOLMARK$$)//')    $
*/
ASSGTS.. SING-ASSGT <',' SINGASSGT = P1>* = P21 $
SING-ASSGT..  STNAME STNAME* AREX = ( '$P1 $P2 $P3 ')  $
STNAME..   PRIME '=' = ('$P1(SDEF,TWO)')   $
AREX     SUM=P1    $
SUM..    TERM <ADDOP TERM = ('$P1(P2)') >* =('$P2(LDEF)$P1')  $
ADDOP..  '+'/('-'=('/S')  ) = ('/A')  $
                                           
TERM..   SIMPLE-TERM/TERM1 =(2)('$P1(Q1)')  $
TERM1..  PRIME <MULOP PRIME = ('$P1(P2,ZERO)')>*
         =(2)('$P2(LDEF,ONE) $P1 $Q1R/2,1//')   $
SIMPLE-TERM.. PRIME NOT(MULOP) =(2)('$P1(Q1,TWO)')         $
MULOP..  '*'/(' /'=('/SR/0,0///D') ) = ('/M')           $

PRIME..  NAME/PM1 NOT(LPAREN)/IPRIME =(2)('$Q1/$Q2,$P1//') $
PM1..    NUMBER/PM2 =(1)('$Q1/$Q2,=F''$P1''//')  $
IPRIME.. '(' SIMPLE-INDEX/IDX1 = (2)('$P1(Q1,Q2,P2)') $
SIMPLE-INDEX.. NAME-OR-NUM ')'
         =('/L/5,$P1///SLL/5,2///A/5,=A($Q3)//$Q1/$Q2,0(,5)//')
NAME-OR-NUM..      NAME/(SNUMBZ=('=F''$P1'' ') )=P1        $

IDX1.. SUM ')'  =(2)('/STM/1,2,$$TEMP+$F3(CT)$F1(CT,EIGHT)//$P1
         $F2(CT,EIGHT)/LR/5,2///SLL/5,2///A/5,=A($P2)///LM/1,2,$$TEMP
         +F3(CT)//$Q1/$Q2,0(,5)//')
PM2..    '(' AREX ')'
   =(1)('/STM/1,2,$$TEMP+$F3(CT)$F1(CT,EIGHT)//$P1/ST/2,$$TEMP+$F3(CT)
  //$F2(CT,EIGHT)/LM/1,2,$$TEMP+$F3(CT)//$Q1/$Q2,$$TEMP+$F3(CT)+8//')$
*
*
BOOLEX.. BTERM OROP/(=P1OF12) BOOLEX
         =(3)('$P2(Q3,Q2) $Q3/EQU/*//$P1(Q1,Q2)')  $
BTERM..  BPRIME ANDOP/(=P1OF12 ) BTERM
         =(3)('$P2(Q1,Q3) $Q3/EQU/*//$P1(Q1,Q2)')  $
BPRIME.. NOTOP/(RELATION/( '(' BOOLEX ')' )  =P1OF12 )
         BPRIME = (2)('$P1(Q2,Q1)')  $
RELATION..  SUM RELOP/SREL SUM = ('$P1  /ST/2,$$TEMP+$F3(CT)*4
         $F1(CT)// $P3 $F2(CT)/C/2,$$TEMP+$F3(CT)*4//$P2(Q1,Q2) ') $
SREL..   =('$P1/LTR/2,2///BNE/$Q2///B/$Q1//')       $

RELOP..  RELNAM = (2)('/B $P1/$Q2///B/$Q1// ')  $
RELNAM.. '.LE.'/('<='/R1) = ('NH')  $
R1..     '.GE.'/('>='/R2) = ('NL')  $
R2..     '.NE.'/('~='/R3) = ('NE')  $
R3..     '.EQ.'/( '='/R4) = ('E ')  $
R4..     '.LT.'/( '<'/R5) = ('L ')  $
R5..     '.GT.'/('>')    = ('H ')  $
OROP..   '.OR./('|') EXIT
ANDOP..  '.AND.'/('&&') EXIT
NOTOP..  '.NOT.'/('~') EXIT
*/
LARGS..  COMPUTE(ACT=0)  ARGTPE
         <COMPUTE(ACT=ACT+4)  ',' ARGTPE = ('$P1') >*   =P21   $
ARGTPE.. NAME/ATPE2   =('/DC/A($P1)'//)  $
ATPE2..  SNUMBZ/ATPE3 =(1)('/DC/A($Q1)//$F6(U1)$Q1/DC/F''$P1''//$F6')$
ATPE3..  STRING =('/DC/A($Q1)//$F6(U1) $Q1/DC/$P1//$F6')
*
*

LABEL.. HEAD/(=NULL) <HEADX =('$P1/EQU/*//')* = ('$P2$P1') $
HEAD..   NAME BLANKS '..'/(':' DNAM=P1) DNAM
         IF(TRACE.EQ.1)/(=P1) EXTRN
         =(1)($P2/DC/X''08'',AL3(0),AL1(4),VL3(TYPETR$$),A($Q1)//
         $F6(U1)$Q1/DC/C''TRACE--$P1'',AL2(0)//$F6(U0')          $
HEADX..  NAME BLANKS '..'/(':') DEFINE =P1   $
SMARK..  COMPUTE(SVMRK1=J)   EXIT      $
SINSTAL.. COMPUTE(CONTEXT=1) SWAP(J,SVMRK1) MARKS SWAP(J,SVMRK1)
         INSTALL COMPUTE(CONTEXT=0) CHECK(U)/SET(U) **) INTRN=P1 $
DECHAID..          '.DECLARE.' FLUSH   DECOUT = P1 $
DECOUT.. =('$F6(U1)STRINGS/CSECT//SUCCESS$$/CLI/*+1,0///BR/14//
         FAIL$$/CLI/*,0///BR/14/$$TEMP/DC/20F''0''//
         $F6(U0)TMGTBL/START///EXTRN/J,CONTEXT///USING/J,3///USING/
         STRINGS,8/#///USING/
         CONTEXT,4///ENTRY/PROGRM//PROGRM/DS/0F//')        $
BODYHD.. '.SYNTAX.' '.FOR.'/*+1 NAME FLUSH   =('$F6(U0)/DC/A($P1,0)
         //')      $
FLUSH..  CARDON    GLOT      //        CARDOF    EXIT      $
PREDCL-FUNC..      INSTALL('J') SET(U) SETINT('J') INSTALL('IF') SET(U)
         INSTALL('COMPUTE') SET(U)
         INSTALL('CONTEXT') SETINT('CONTEXT') SET(U) EXIT $
FNAME..  MARKS ALPHA ALPHANUM* EXIT $
CR..     CARDON ///CR1 CARDOF EXIT $
CR1..    '$'/CR2 GLOT // CARDOF EXIT $
CR2..    TYPE('***JUNK AT END OF STATEMENT') GLOT // CARDOF EXIT $
TYP-MES4.. TYPE('***STATEMENT IN ERROR***') FLUSH KILL EXIT $
END..    '.END.' CARDON GLOT //  EXIT $
PARMCT.. NOT(PARMCT1)/(COMPUTE(INTVAL=0) = NULL )
         '('/(COMPUTE(INTVAL=0) = NULL) NUMBER ')' = P1    $
PARMCT1..  '(''' EXIT $
STRING.. '''' BLANKS MARKS STRPCE/(=('AL2(0)') ) STRPCE* COPY ''''
         =(1)('C''$P1'',AL2(0)')  $
STRPCE.. NOQUOTE/(  ''''''  ) NOQUOTE* EXIT $
NAME..   MARKS ALPHA ALPHANUM* INSTALL INTRN = P1          $
DNAME..  NAME DNAM = P1
DNAM..   DEFINE CHECK(U)/(SET(U) EXIT) SET(M) EXIT
EATREST..          BLANKS NOTBLK* EXIT $
INUMBER..      '(' NUMBER INSTALL ')' EXTRN = P1  $
NUMBER.. MARKS NUM NUM* COPY CONVERT(INTVAL) = P1          $
BLPAREN..    BLANKS '(' EXIT  $
LPAREN.. '('  EXIT $
SNUMBZ.. MARKS SIGN/SNZ1  $
SNZ1..   NUM NUM* CINSTAL(1) SET(LIT,U) EXTRN  = P1  $
SNUMBY.. MARKS SIGN/*+1 NUM NUM* CINSTAL(1) SET(U,LIT) EXTRN =P1
COMMENT..   '.OPTIONS.' OPT <','/*+1 OPT EXIT>* CR =NULL  $
OPT..    'LIST'/OPT1         COMPUTE(LISTSW=1) LIST DOUBLE EXIT   $
OPT1..   'NOLIST'/OPT2       COMPUTE(LISTSW=0) NOLIST SINGLE EXIT $
OPT2..   'SOURCE'/OPT3       SOURCE EXIT         $
OPT3..   'NOSOURCE'/OPT4     NOSOURC  EXIT       $
OPT4..   'TRACE'/OPT5        COMPUTE(TRACE=1) EXIT         $
OPT5..   'NOTRACE'/OPT6      COMPUTE(TRACE=0) EXIT         $
OPT6..   'DICT'/OPT7         COMPUTE(DICTSW=1) EXIT        $
OPT7..   'NODICT'/OPT8       COMPUTE(DICTSW=0) EXIT        $
OPT8..   'TRACEON'/OPT9      TRACEON    EXIT               $
OPT9..   'TRACEOFF'/OPT10          TRACEOF   EXIT          $
OPT10..  'DOUBLE'/OPT11      DOUBLE    EXIT                 
OPT11..  'SINGLE'            SINGLE    EXIT
.END.
          


Editor: thvv@multicians.org

Home | Changes | Multicians | General | History | Features | Bibliography | Sites | Chronology
Stories | Glossary | Papers | Humor | Documents | Source | Links | About