TMG
Doug McIlroy has described how he and Bob Morris used TMG from Bob McClure at Texas Instruments to write the EPL compiler.
I got a nice note from Ron Tatum, about 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.
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 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)
*/////////////////////////////////////////////////////////////////////
*/ 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.