!CPMOUT MAC՝EDIT MACtM4 C aM4 COMMETA4 DOCDEMETA4 M4 8!5META4 MET0uMETA412 DOCAMETA412 M4 R<$META4MT4DIF pMULT MACPRINT MAC"V1ASM METkcVAL-M80 DIFeVAL-M80 METVALGOL DOCC5VALLIB RELM; CPMOUT for VALGOL I compiler BDOS EQU 5 PUBLIC ?CPMOUT ?CPMOUT: PUSH HL LD E,A LD C,2 CALL BDOS POP HL RET END ; EDIT for VALGOL I compiler PUBLIC ?EDIT ?EDIT: EDIT0: LD A,H OR L JP Z,EDIT1 LD A,' ' CALL ?CPMOUT## DEC HL JP EDIT0 EDIT1: POP HL EDIT2: LD A,(HL) CP 0 INC HL JP Z,EDIT3 CALL ?CPMOUT## JP EDIT2 EDIT3: PUSH HL RET END /* M4 interpreter for use with the Meta4 compiler-compiler Written by W. A. Gale in PIDGIN Dr. Dobb's Journal, August, 1981 10/81 -- Translated to BDS C by J. Larsen Lower case Default extension .M4 5/84 -- Translated to Aztec C by G. Edgar Sign-on changed to M4 Upper and lower case both recognized */ #include "libc.h" /* the global declarations for Dr. Gales Compiler-Compiler */ char er; char *iav[10]; int iac ; char m4file[20],metfile[20],outfile[25]; char prflag, spcharflag, eoflag; char aa,bb,bo[80],c0,c1,c2,c3,c9,cb,cc,cd,ce,cg,cl,cm,cp,cq,cs,ct; FILE *F1, *F2; char cu,cv,cx,dd,ds[10],ee,fl,*ks,li,ll; char *mc,mk,mn,nd,nl,ns[80],os[80],pb,pi,pl,pm,pn,po,qi,rc; char ri[80],sd,wa,wb,x0,x1,x2,x3,x9,xa,xb,xc,xd,xe,xf,xg,xh,xi,xj,xk; char xl,xm,xn,xo,xp,xq,xr,xs,xt,xu,xv,xw,xx,xy,xz,yp,zp,zx; int i00,i01,i03,i10,i16,iaa,ibb,ibk,icc,idd,ilb,iln,*ilt,imb; int imd,imf,*imi,iml,imm,imt,imx,imz,inl,ipc,ipl,ipr[10]; int ipt,irn,ism,*ist,itu,iuu,ixx,iys[80],iyy,izc,izs[80],izt; #define TRUE 1 #define FALSE 0 #define CPMEOF 0x1A #define ERROR -1 main( argc, argv ) int argc ; char **argv ; { printf(" M4 interpreter ver. 1.0\n"); printf(" Copyright (c) 1981 W.A. Gale\n"); ks = alloc(10000); mc = alloc(3000); ilt = alloc(2*1000); ist = alloc(2*600); imi = alloc(2*3000); if (imi == NULL) { printf("System TPA too small\n"); exit(1); } spcharflag = eoflag = prflag = FALSE ; strcpy( m4file, argv[1] ); strcpy( metfile, argv[2] ); strcpy( outfile, argv[3] ); newext( m4file, ".M4" ); if(argc < 4){ printf("Usage: A>M4 \n"); exit(1); } iav[1] = m4file; iav[2] = metfile; iav[3] = outfile; iac = argc ; nl = '\n' ; fin(); frc(); if(argc > 4)prflag = TRUE ; else prflag = FALSE ; fli(); ipc = 0 ; loc00: fgi(); cc = ri[c0] ; switch (cc) { case 'l' : case 'L' : if(pi == c1)aa = TRUE ; else aa = FALSE ; if(aa){ if(fl){ flw(); ism++ ; } else pl = pm ; } else { cc = ri[c1]; switch (cc) { case 'm' : case 'M' : fl = 0 ; bb = 2 ; while(TRUE){ if(bb < pi)aa = TRUE ; else aa = FALSE ; if(!aa)break; aa = ri[bb] ; dd = ns[pl]; if(aa != dd)aa = TRUE ; else aa = FALSE; if(aa)goto loc99; bb++; fla(); } fl = 1 ; flb(); break ; case 'i' : case 'I' : fl = 0 ; cc = ns[pl]; po = 0 ; fza(); while(TRUE){ if(!aa)break; os[po] = cc ; po++ ; fla(); cc = ns[pl]; fza(); dd = aa ; fzn(); aa = dd | aa ; } if(po == c0)aa = TRUE ; else aa = FALSE ; if(aa)goto loc99 ; fms(); ipr[c0] = iaa ; fl = 1 ; break ; case 'n' : case 'N' : fl = 0 ; iaa = i00 ; while(TRUE){ cc = ns[pl]; fzn(); if(!aa)break; fl = 1 ; iaa = iaa * 10 ; cc = cc - '0' ; ibb = cc ; iaa += ibb ; fla(); } ipr[c0] = iaa ; break; case 'h' : case 'H' : fl = 0 ; iaa = 0 ; while(TRUE){ cc = ns[pl]; fzh(); if(!aa)break; fl = 1 ; iaa *= 16 ; ibb = cc ; iaa += ibb ; fla(); }; ipr[c0] = iaa ; break ; case 'q' : case 'Q' : dd = ri[c2]; cc = ns[pl]; po = 0 ; if(cc == dd)aa = TRUE ; else aa = FALSE ; if(aa){ fla(); while(TRUE){ cc = ns[pl]; if(cc != nl)aa=TRUE;else aa=FALSE; if(cc != dd)bb=TRUE;else bb=FALSE; aa &= bb ; if(!aa)break; os[po] = cc ; po++ ; fla(); } fla(); if(cc == nl)aa = TRUE ; else aa = FALSE; if(aa){ iln++ ; ism = i00 ; } else ; fl = 1 ; } else fl = 0 ; break ; default : printf("Not lex: "); putchar(cc);putchar('\n'); } } break; case 'f' : case 'F' : if(!fl)goto loc20; break; case 'p' : case 'P' : bb = 1 ; while(TRUE){ if(bb < pi)aa = TRUE ; else aa = FALSE ; if(!aa)break ; cc = ri[bb]; bo[pb] = cc ; pb++ ; bb++ ; } break ; case 'o' : case 'O' : bb = 0 ; while(TRUE){ if(bb < pb)aa = TRUE ; else aa = FALSE ; if(!aa)break; cc = bo[bb]; bb++; pchar( cc, F2 ); } pb = c0 ; if(pi == c1)aa = TRUE ; else aa = FALSE ; if(aa)pchar( '\n', F2 ); break ; case 'x' : case 'X' : if(pi == c1)aa = TRUE ; else aa = FALSE ; if(aa){ if(fl);else { loc98: printf("Error at line num: "); iaa = iln ; fpn() ; printf(" symbol "); iaa = ism ; fpn(); putchar(cb); putchar('\n'); while(TRUE){ cc = ns[pl]; if(cc != zx)aa=TRUE;else aa=FALSE; if(cc != c0)bb=TRUE;else bb=FALSE; aa &= bb ; if(!aa)break; if(cc == nl)aa=TRUE;else aa=FALSE; if(aa){ iln++; ism = 0; } else ; fla(); flb(); } if(cc == c0)bb = TRUE ; else bb = FALSE ; if(bb){ printf("\nEOF recognized\n"); goto loc21 ; } else ; fla(); flb(); flw(); ipc = izc ; ipt = izt ; fl = 1 ; } } else { cc = ri[c1]; switch (cc) { case 'n' : case 'N' : iaa = iln ; fwn(); break; case 'o' : case 'O' : bb = 0 ; while(TRUE){ if(bb < pb)aa = TRUE ; else aa = FALSE ; if(!aa)break; cc = bo[bb]; bb++ ; putchar( cc ); } putchar('\n'); pb = c0 ; break; case 'm' : case 'M' : izc = ipc ; izt = ipt ; zx = ri[c2]; break; default: ; } } break; case 't' : case 'T' : if(fl){ goto loc20; } else ; break; case 'g' : case 'G' : wa = ri[c1]; wb = ri[c2]; ipt += i03 ; iaa = 597 ; if(iaa <= ipt)aa = TRUE ; else aa = FALSE ; if(aa){ printf("stack overflow >>>>\n"); goto loc98 ; } else ; ist[ipt] = ipc ; pack( &ipc, &wa, &wb ); iaa = ipt ; iaa++; ist[iaa]=i00 ; iaa++; ist[iaa] = i00 ; break ; case 'r' : case 'R' : ipc = ist[ ipt ]; if(ipt < i03)aa = TRUE ; else aa = FALSE ; if(aa){ printf("Stack underflow....\n"); goto loc98 ; } else ; ipt = ipt - i03 ; break; case 's' : case 'S' : if(pi == c1)aa = TRUE ; else aa = FALSE ; if(aa)fl = 1 ; else { cc = ri[c1]; switch (cc) { case 'f' : case 'F' : fl = 0 ; break; case 'c' : case 'C' : fl = c1 - fl ; break; default: printf("set error \n"); } } break; case 'u' : case 'U' : if(pi == c1)aa = TRUE ; else aa = FALSE ; if(aa){ iaa = ipt ; iaa++; loc10: ibb = ist[iaa]; if(ibb < i01)aa = TRUE ; else aa = FALSE ; if(aa){ iuu++; ibb = iuu ; ist[iaa] = iuu ; } else ; iaa = ibb ; ipr[c0] = iaa ; fwn(); } else goto loc22 ; break ; case 'c' : case 'C' : bb = 0 ; while(TRUE){ if(bb < po)aa = TRUE ; else aa = FALSE ; if(!aa)break; cc = os[bb]; bo[pb] = cc ; pb++ ; bb++ ; } break; case 'v' : case 'V' : if(pi == c1)aa = TRUE ;else aa = FALSE ; if(aa){ iaa = ipt ; iaa++ ; iaa++ ; goto loc10 ; } else goto loc22 ; break; case 'm' : case 'M' : cc = ri[c1]; switch (cc) { case 's' : case 'S' : fmh() ; break ; case 'p' : case 'P' : fmp() ; break ; case 'e' : case 'E' : fme();ipr[c0]=iaa;break; case 'q' : case 'Q' : fms();ipr[c0]=iaa;break ; case 'c' : case 'C' : fmc();ipr[c0]=iaa;break; case 'd' : case 'D' : fmd();ipr[c0]=iaa;break; case 'i' : case 'I' : cc = ri[c2]; fzn(); if(aa)mk = cc - x0 ; else mk = c2 ; fmi(); break; default : printf("Illegal memory operation.\n"); } break; case 'j' : case 'J' : aa = aa ; loc20: aa = ri[c1]; bb = ri[c2]; pack( &ilb,&aa,&bb); ipc = ilt[ilb]; break; case 'e' : case 'E' : aa = aa ; loc21: pchar( CPMEOF, F2 ); xclose( F1 ); xclose( F2 ); iaa = imm ; fpn(); printf(" max memory used\n"); exit(0); default : aa = aa ; loc22: qi = 0 ; fft(); ffi(); fst(); } goto loc00; loc99: fl = 0 ; goto loc00; } #define BOOL aa = TRUE ; else aa = FALSE ; fds() { if(iaa < i00)aa = TRUE ; else aa = FALSE ; if(aa){ bb = 1 ; iaa = -iaa ; } else bb = 0 ; if(iaa == i00)aa = TRUE ; else aa = FALSE ; if(aa){ nd = c1 ; ds[c0] = x0 ; } else { nd = c0 ; while(TRUE){ if(i00 < iaa)aa = TRUE ; else aa = FALSE ; if(!aa)break; iyy = iaa / i10 ; ibb = i10 * iyy ; ixx = iaa - ibb ; iaa = iyy ; aa = ixx ; aa = aa + x0 ; ds[nd] = aa ; nd++; } } ds[nd] = cm ; nd = nd + bb ; } fck(str) char *str; { if(er != c0)aa = TRUE ; else aa = FALSE ; if(aa){ printf("Cant open %s\n",str); exit(1); } } ffi() { qi++; cc = ri[qi]; switch (cc) { case 'm' : case 'M' : qi++; cc = ri[qi]; fzn(); if(aa)bb = cc - x0 ; else { loc11: printf("Index mem cell\n"); bb = 0 ; } if(bb < mk)aa = TRUE ; else aa = FALSE ; if(aa){ iaa = bb ; iaa = iaa + itu ; itu = imi[iaa]; return; } else { bb = bb - mk ; if(bb < mk)aa = TRUE ; else aa = FALSE ; if(aa){ iaa = bb ; iaa = itu + iaa ; aa = mc[iaa]; itu = aa ; } else goto loc11 ; } break ; case 's' : case 'S' : aa = itu ; bb = os[aa]; itu = bb ; break; default : qi-- ; } } fft() { cc = ri[qi]; switch (cc) { case 'y' : case 'Y' : itu = iys[yp]; break; case '!' : itu = iys[yp]; fpy(); break; case 'z' : case 'Z' : itu = izs[zp]; if(zp == c0)aa = TRUE ; else aa = FALSE ; if(aa){ printf("Z stacker\n"); zp = c1 ; fl = 0 ; } else ; zp-- ; break; case 'n' : case 'N' : qi++; aa = ri[qi]; qi++; bb = ri[qi]; pack(&itu,&aa,&bb); break; case 'h' : case 'H' : itu = iys[yp]; unpack(&itu,&aa,&bb); itu = aa ; break; case 'b' : case 'B' : itu = po ; break; case 'u' : case 'U' : iaa = ipt ; loc38: iaa++; itu = ist[iaa]; break; case 'v' : case 'V' : iaa = ipt ; iaa++; goto loc38; break; default: fzn(); if(aa)aa = cc - '0' ; else { printf("Illegal fetch\n"); aa = c0 ; } itu = ipr[aa]; } } fgi() { pi = 0 ; li = ks[ipc]; ipc++; while(TRUE){ if(pi < li)aa=TRUE;else aa = FALSE ; if(!aa)break; aa = ks[ipc]; ipc++; ri[pi] = aa ; pi++; } } fin() { zx = yp = zp = izc = izt = 0 ; xa = 'a' ; xb = 'b' ; xc = 'c' ; xd = 'd' ; xe = 'e' ; xf = 'f' ; xg = 'g' ; xh = 'h' ; xi = 'i' ; xj = 'j' ; xk = 'k' ; xl = 'l' ; xm = 'm' ; xn = 'n' ; xo = 'o' ; xp = 'p' ; xq = 'q' ; xr = 'r' ; xs = 's' ; xt = 't' ; xu = 'u' ; xv = 'v' ; xw = 'w' ; xx = 'x' ; xy = 'y' ; xz = 'z' ; x0 = '0' ; x1 = '1' ; x2 = '2' ; x3 = '3' ; x9 = '9' ; c9 = 9 ; cv = 25 ; c0 = 0 ; c1 = 1 ; c2 = 2 ; c3 = 3 ; cb = ' ' ; cx = '!' ; cs = '*' ; cm = '-' ; cp = '+' ; cg = '>' ; cu = '=' ; cl = '<' ; sd = 80 ; ct = '\t' ; ce = '/' ; cd = '.' ; cq = '\'' ; i00 = 0 ; i01 = 1 ; i03 = 3 ; i10 = 10 ; i16 = 16 ; mn = 79 ; ibk = iav[c3]; F2 = xopen( ibk, "w" ); fl = pi = pb = ipc = po = ipt = ilb = pn = iuu = iln = ism = inl = 0 ; mk = 2 ; fmi(); } fla() { if(pl == mn)aa = TRUE ; else aa = FALSE ; if(aa)pl = c0 ; else pl++; } flb() { while(TRUE){ if(pl != pm)BOOL if(!aa)break; cc = gchar( F1 ); if(er != c0)BOOL if(aa)cc = 0 ; ns[pm] = cc ; if(pm == mn)BOOL if(aa)pm = 0 ; else pm++; } } fli() { pm = pl = bb = 0 ; while(TRUE){ if(bb <= mn)BOOL if(er == c0)cc = TRUE ; else cc = FALSE ; aa = aa & cc ; if(!aa)break; cc = gchar( F1 ); ns[bb] = cc ; bb++; } } flw() { cc = ns[pl]; while(TRUE){ if(cc == '\n')BOOL if(aa){ iln++; ism = 0 ; } else ; if(cc == ' ')bb = TRUE ; else bb = FALSE ; aa = aa | bb ; if(cc == '\t')bb = TRUE ; else bb = FALSE ; aa = aa | bb ; if(!aa)break; fla(); cc = ns[pl]; } flb(); } fmc() { iaa = mk ; imt = imt - iaa ; fmo(); iaa = imt ; fmz(); } fmd() { iaa = mk ; imt = imt + iaa ; if(imd < imt)BOOL if(aa)printf("Destroy cell error\n"); else ; iaa = imt ; } fme() { fml(); if(iaa != i00)ee = TRUE ; else ee = FALSE ; if(ee)return; imi[ibb] = imf ; while(TRUE){ mc[imf] = cc ; imi[imf] = imx ; imf++; fmo(); if(cc != c0)BOOL if(!aa)break; bb++; cc = os[bb]; } iaa = imf ; iaa = imf ; idd = mk ; imf = imf + idd ; fmo(); fmz(); } fmh() { imi[imf] = imb ; imb = imf ; imf = imf + iml ; mc[imf] = c0 ; imi[imf] = i00 ; } fmi() { imm = imb = 0 ; imd = 3000 ; imt = imd ; iml = 1 ; imf = imb + iml ; imx = i00 ; imi[imb] = i00 ; mc[imf] = c0 ; imi[imf] = i00 ; } fml() { ibb = imb + iml ; bb = 0 ; while(TRUE){ cc = os[bb]; dd = mc[ibb]; if(cc == dd)ee = TRUE ; else ee = FALSE ; if(ee){ if(cc == c0)ee = TRUE ; else ee = FALSE ; if(ee){ iaa = ibb + i01 ; goto loc77 ; } else ; ibb++; bb++; } else { iaa = imi[ibb]; if(iaa == imx)ee = TRUE ; else ee = FALSE ; if(ee){ iaa = i00 ; goto loc77; } else ; ibb = iaa ; } if(ibb < imf)ee = TRUE ; else ee = FALSE ; if(!ee)break; } iaa = i00 ; loc77: aa = aa ; } fmo() { if(imt < imf)BOOL if(aa){ printf("NO Memory space left, increase array sizes.\n"); exit(1); } else ; if(imm < imf)BOOL if(aa)imm = imf ; } fmp() { if(imb != i00)BOOL if(aa){ imf = imb ; imb = imi[imb]; } else { imf = iml ; mc[imf] = c0 ; imi[imf] = i00 ; } } fms() { os[po] = c0 ; imz = imb ; while(TRUE){ fml(); if(iaa == i00)ee = TRUE ; else ee = FALSE ; imb = imi[imb] ; if(imb != i00)dd = TRUE ; dd = FALSE ; cc = ee & dd ; if(!cc)break ; } imb = imz ; } fmz() { bb = 0 ; idd = iaa ; while(TRUE){ if(bb < mk)BOOL bb++; if(!aa)break; mc[idd] = c0 ; imi[idd] = i00 ; idd++; } } fpn() { fds(); while(TRUE){ ibb = nd ; if(i00 < ibb)BOOL if(!aa)break; nd-- ; aa = ds[nd]; putchar( aa ); } putchar(' '); } fpy() { if(yp == c0)BOOL if(aa){ printf("Y stacker\n"); yp = c1 ; fl = 0 ; } else ; yp-- ; } #define BOOLA aa = TRUE ; else aa = FALSE #define BOOLB bb = TRUE ; else bb = FALSE #define BOOLE ee = TRUE ; else ee = FALSE fra() { os[c0]=cc; po = 1 ; while(TRUE){ cc = gchar( F1 ); fza(); dd = aa ; fzn(); aa = aa | dd ; if(!aa)break; os[po] = cc ; po++; } if(cc == nl)BOOLA; if(aa);else { while(TRUE){ cc = gchar( F1 ); if(cc != nl)BOOLA; if(!aa)break; } } } frc() { ibk = iav[c1] ; F1 = xopen(ibk, "r"); fck(ibk); ipc = 1 ; ll = ipl = 0 ; while(TRUE){ rc = gchar( F1 ); loc33: if(er == c0)BOOLA; if(!aa)break; switch (rc) { case '/' : cc = gchar( F1 ); if(cc == '-')BOOLA; if(aa){ cc = gchar( F1 ); frn(); irn = -irn ; goto loc37; } else ; fzn(); if(aa){ frn(); loc37: unpack(&irn,&aa,&bb); ks[ipc] = aa ; ipc++; ll++; ks[ipc] = bb ; ipc++; ll++; rc = cc ; if(rc == ' ')BOOLA; if(aa);else goto loc33; } else { ks[ipc] = '/' ; ipc++; ll++ ; rc = cc ; goto loc33; } break; case '\n' : ks[ipl] = ll ; ipl = ipc ; ipc++; ll = c0 ; break; case '.' : if(ll == c0)BOOLA; if(aa){ frl(); rc = '\n'; ipc-- ; goto loc33; } else goto loc35; break; case 'g' : case 'G' : if(ll == c0)BOOLA; if(aa){ cc = gchar( F1 ); fra(); os[po] = c0 ; fme(); irn = imi[iaa]; if(irn == i00)BOOLA; if(aa){ irn = iaa ; ks[ipc] = nl ; } else ks[ipc] = rc ; ipc++; unpack(&irn,&aa,&bb); ks[ipc] = aa ; ipc++; ks[ipc] = bb ; ipc++; ll = c3 ; rc = nl ; goto loc33; } else goto loc35; break; default: aa = aa ; loc35: ks[ipc] = rc ; ipc++; ll++; } } ipc-- ; if(er != c1)BOOLA; if(aa){ printf("Cant read commands.\n"); exit(1); } else ; xclose( F1 ); ibk = iav[ c2 ]; F1 = xopen(ibk,"r" ); fck(ibk); iaa = 0 ; while(TRUE){ if(iaa < ipc)BOOLA; if(!aa)break; ll = ks[iaa]; ibb = iaa + i01 ; aa = ks[ibb]; if(aa == nl)BOOLA; if(aa){ ks[ibb] = xg ; ibb++; aa = ks[ibb]; ibb++; bb = ks[ibb]; pack(&irn,&aa,&bb); bb = mc[irn]; if(bb != c1)BOOLA; if(aa){ icc = irn - i10 ; while(TRUE){ if(icc < irn)BOOLA; if(!aa)break; bb = mc[icc]; putchar( bb ); icc++; } putchar( cb ); printf("Subroutine undefined.\n"); } else ; icc = imi[irn]; unpack(&icc,&aa,&bb); ks[ibb] = bb ; ibb-- ; ks[ibb] = aa ; } else ; ibb = ll ; iaa = iaa + ibb ; iaa = iaa + i01 ; } fmp(); iaa = ipc; fpn(); printf("command bytes; "); iaa = inl ; fpn(); printf("number labels; "); iaa = pn ; fpn(); printf("subroutines.\n"); } frl() { while(TRUE){ cc = gchar( F1 ); fza(); if(aa)goto loc80; else ; fzn(); if(aa)goto loc85; else ; if(cc != nl)BOOLA; if(!aa)break; } return; loc80: fra(); os[po] = c0 ; fme(); imi[iaa] = ipl ; mc[iaa] = c1 ; pn++; return; loc85: inl++; frn(); ilt[irn] = ipl ; } frn() { irn = 0 ; while(TRUE){ cc = cc - x0 ; iaa = cc ; irn = irn * 10 ; irn = irn + iaa ; cc = gchar( F1 ); fzn(); if(!aa)break; } } fst() { qi++; cc = ri[qi]; switch (cc ) { case 'y' : case 'Y' : yp++; if(sd <= yp)BOOLA; if(aa){ printf("Y overflow.\n"); yp = sd ; fl = 0 ; } else ; iys[yp] = itu ; break; case 'z' : case 'Z' : zp++; if(sd <= zp)BOOLA; if(aa){ printf("Z overflow.\n"); zp = sd ; fl = 0 ; } else ; izs[zp] = itu ; break; case '+' : iaa = iys[yp]; iaa = iaa + itu ; iys[yp] = iaa ; break; case '-' : iaa = iys[yp]; iaa = iaa - itu ; iys[yp] = iaa ; break ; case '*' : iaa = iys[yp]; iaa = iaa * itu ; iys[yp] = iaa ; break ; case '>' : iaa = iys[yp]; if(iaa < itu)BOOLA; loc12: if(aa)fl = 1 ; else fl = 0 ; fpy(); break; case '<' : iaa = iys[yp]; if(itu < iaa)BOOLA; goto loc12; break; case '=' : iaa = iys[yp]; if(iaa == itu)BOOLA; goto loc12; case 'i' : case 'I' : qi++; dd = ri[qi]; ibb = itu; qi++; fft(); cc = dd ; fzn(); if(aa)bb = cc - x0 ; else { loc13: printf("Bad indirect index.\n"); bb = 0 ; } if(bb < mk)BOOLA; if(aa){ iaa = bb ; iaa = iaa + itu ; imi[iaa] = ibb ; return; } else { bb = bb - mk ; if(bb < mk)BOOLA; if(aa){ iaa = bb ; iaa = itu + iaa ; aa = ibb ; mc[iaa] = aa ; } else goto loc13; } break; case 'c' : case 'C' : iaa = itu ; fwn(); break; case 'l' : case 'L' : aa = itu; bo[pb] = aa ; pb++; break; case 'a' : case 'A' : aa = itu ; os[po] = aa ; po++; os[po] = c0 ; break; case 'b' : case 'B' : po = itu ; os[po] = c0 ; break; case 'g' : case 'G' : iuu = itu ; break; case 'u' : case 'U' : iaa = ipt ; loc39: iaa++; ist[iaa] = itu ; break; case 'v' : case 'V' : iaa = ipt ; iaa++; goto loc39; break; case 'd' : case 'D' : break; case 'h' : case 'H' : aa = itu ; itu = aa ; iaa = itu / 16 ; ibb = iaa * 16 ; ibb = itu - ibb ; cc = iaa ; fwh(); cc = ibb ; fwh(); break; default : cc = ri[qi]; fzn(); if(aa)aa = cc - x0 ; else { printf("Illegal store.\n"); aa = c0 ; } ipr[aa] = itu ; } } fwh() { if(cc <= 9)BOOLA; if(aa)cc = cc + '0' ; else cc = cc + 'A' + 7 ; bo[pb] = cc ; pb++; } fwn() { fds(); while(TRUE){ ibb = nd ; if(i00 < ibb)BOOLA; if(!aa)break; nd--; aa = ds[nd]; bo[pb] = aa ; pb++; } } fza() { if ((cc >= 'a') && (cc <= 'z')) aa = 1; else if ((cc >= 'A') && (cc <= 'Z')) aa = 1; else aa = 0; } fzh() { if('0' <= cc)BOOLA; if(cc <= '9')BOOLB; aa = aa & bb ; if(aa){ cc = cc - '0' ; return; } else ; if('a' <= cc)BOOLA; if(cc <= 'f')BOOLB; aa = aa & bb ; if(aa){ cc = cc - 'a' ; bb = 10 ; cc = cc + bb ; return; } else ; if('A' <= cc)BOOLA; if(cc <= 'F')BOOLB; aa = aa & bb ; if(aa){ cc = cc - 'A' ; bb = 10 ; cc = cc + bb ; return; } else ; } fzn() { aa = cc - '0' ; bb = '9' - cc ; if(aa <= 9)BOOLA; if(bb <= 9)BOOLB; aa = aa & bb ; } fzw() { if(cc == ' ')BOOLA; if(cc == '\t')BOOLB; aa = aa | bb ; if(cc == '\n')BOOLB; aa = aa | bb ; } /* Here we define file i/o and the pack/unpack functions CR's are filtered and the ER variable is set/reset in the file i/o functions. J.L. oct. -81 */ pack( a, b, c ) unsigned *a ; char *b, *c ; { *a = (*b << 8) | *c ; } unpack( a, b, c ) unsigned *a ; char *b, *c ; { *c = *a & 0x00FF ; *b = *a >> 8 ; } xopen( name, how ) char *name, *how ; { FILE * filep; if((filep = fopen( name, how )) == NULL) er = 1 ; else er = 0 ; eoflag = FALSE ; return filep; } xclose( ptr ) FILE *ptr ; { fclose( ptr ); er = 0 ; } gchar( ptr ) FILE *ptr ; { char c ; c = 0x0d ; er = 0; while(c == 0x0d && er == 0){ if((c = getc(ptr)) == ERROR || c == CPMEOF)er = 1 ; else er = 0 ; if(er)eoflag = TRUE ; if(prflag && c != CPMEOF && !eoflag) putc(c,stdout); } return(c); } pchar( c, ptr ) char c; FILE *ptr ; { if(spcharflag){ spcharflag = FALSE ; if(c == 't')c = 9; else if(c == 'n')c = '\n' ; } else if(c == '\\'){spcharflag = TRUE; er = 0 ; return ;} if(c == '\n')if(putc(0x0d,ptr) == ERROR)er = 1 ; else er = 0 ; if(putc(c,ptr) == ERROR)er = 1 ; else er = 0 ; } newext( s, n ) char *s, *n ; { char *i ; i = s ; while(*s != NULL && *s != '.')s++; if(*s == '.')*s = NULL ; strcat( i, n ); } I8!:!:!''B"Bd! 'B"e!'B"Pd!'B"d!p'B"Xd*Xd|g!:!,M!}2f}2c}2f! 9^#V##^#V!.d̈́Z! 9^#V!^#V!ë́Z! 9^#V!^#V!ë́Z!!.d38!9^#V!89!:!,M!.d" d!e" d!e"d!9^#V"d! }2f$!9^#V!99.!}2f5!}2f!"fd::co&f^}2c:co&:fo&:co&8y!}2bÀ!}2b:bo&|ʱ:do&|ʤ͢*d#"d+î:fo&}2f:co&f^}2c:co&!}2d!}2b!|v:bo&:fo&89!}2b!}2b:bo&|v:bo&f^}2b:fo&f^}2c:bo&:co& 9R!}2bY!}2b:bo&|•:bo&#}2b+!}2d!}2d:fo&f^}2c!}2f2!|:bo&|:co&:fo&Wfs:fo&#}2f+:fo&f^}2c2:bo&}2cͽ4:co&:bo&9}2bæ:fo&:co&81!}2b8!}2b:bo&|•!*,d:co&)jds#r!}2d!}2d* d",d!|:fo&f^}2cͽ4:bo&|!}2d*,d Ͷ9",d:co&}2c:co&"Dd*Dd*,d",dp*,d:co&)jds#r!}2d!",d!|L:fo&f^}2c53:bo&|L!}2d!*,dͶ9",d:co&"Dd*Dd*,d",d*,d:co&)jds#r:co&f^}2c:fo&f^}2c!}2f:co&:co&8ʪ!}2bñ!}2b:bo&|ʲ!|e:fo&f^}2c:co&:fo& 9!}2b!}2b:co&:co& 9!}2b!!}2b:bo&:bo&Ͷ8}2b:bo&|e:co&:fo&Wfs:fo&#}2f+ÿ:co&:fo&8ʅ!}2bÌ!}2b:bo&|ʨ*Nd#"Nd+* d"dè!}2dù!}2d!%:!hb:co&=!hb! ==: HIMNcQbhimncqbÒ:do&|jÒ!}2b!|ʢ:bo&:fo&89P!}2bW!}2b:bo&|ʢ:bo&f^}2c:co&:fo&Pcs:fo&#}2f+:bo&#}2b++Ò!}2b!|:bo&:fo&89!}2b!}2b:bo&|:bo&Pc^}2c:bo&#}2b+*b:co&Z7ì:co&}2f:fo&:co&8;!}2bB!}2b:bo&|Z*b! Z7Ò:fo&:co&8z!}2bÁ!}2b:bo&| :do&|ʚ !/:*Nd",d/"!C:*d",d/"!hb:co&=!hb! =!|ʣ :fo&f^}2c:co&:%go& 9 !}2b !}2b:co&:co& 94 !}2b; !}2b:bo&:bo&Ͷ8}2b:bo&|ʣ :co&:fo&8w !}2b~ !}2b:bo&|ʚ *Nd#"Nd+!"dÚ :co&:co&8 !}2b !}2b:bo&| !M:ý͢*.e"fd*e"~d!}2d :co&f^}2c:co& *Nd",dQ2 !}2b!|ʒ :bo&:fo&89O !}2bV !}2b:bo&|ʒ :bo&Pc^}2c:bo&#}2b+!hb:co&=* !hb! =:co&}2f *fd".e*~d"e:co&f^}2%g =:n N o# O# m M Ò:do&| jÒ:co&f^}2g:co&f^}2g*&d*~d"~d!U",d*,d*~d9O !}2bV !}2b:bo&|l !^:Ú*fd*~d)*ds#r!g!g!fd5*~d",d*,d#",d+* d*,d)*ds#r*,d#",d+* d*,d)*ds#rÒ*~d)*d^#V"fd*~d*&d89 !}2b !}2b:bo&| !s:Ú*~d*&d:"~dÒ:fo&:co&8; !}2bB !}2b:bo&|W !}2dõ :co&f^}2c:co&Þ !}2dõ :co&:do&:}2dõ !:õ =:fr Fr c| C| Ò:fo&:co&8 !}2b !}2b:bo&|o *~d",d*,d#",d+*,d)*d^#V"Dd*Dd*$d89 !}2b# !}2b:bo&|P *d#"d+*d"Dd*d*,d)*ds#rP *Dd",d*,d:co&)jds#rQ2r Ò!}2b!| :bo&:fo&89ʡ !}2bè !}2b:bo&| :bo&Wf^}2c:co&:fo&Pcs:fo&#}2f+:bo&#}2b+| Ò:fo&:co&8!}2b!}2b:bo&|>*~d",d*,d#",d+*,d#",d+ :co&f^}2c:co& ]͡ ]*,d:co&)jds#r]!*,d:co&)jds#r]͌*,d:co&)jds#r]ʹ*,d:co&)jds#r]:co&f^}2cͽ4:bo&|:co&:go&:}2f :co&}2fU]!:]=:CDEhIPbQS\cdehipbqs\Ò:bo&}2b:co&f^}2b:co&f^}2b!b!b!Ld5*Ld)*Pd^#V"fdÒ:bo&}2b*b!Z7*b̀6*b̀6*\d",d/"!:!,M:bo&}2b!}2fw,Ò!!&^#Vu  `\A$  ]u  `\A$  ]>!}2d> M4 interpreter ver. 1.0 Copyright (c) 1981 W.A. Gale System TPA too small .M4Usage: A>M4 Not lex: Error at line num: symbol EOF recognized stack overflow >>>> Stack underflow.... set error Illegal memory operation. max memory used 8*,d* d89!}2b!}2b:bo&|!}2b*,d9",d !}2b*,d* d8 !}2b'!}2b:bo&|R:co&}2f:go&:co&cs:co&}2f!|* d*,d89{!}2bÂ!}2b:bo&|*,d*(d8",e*(d*,eͶ9"Dd*,d*Dd:"d*,e",d*d}2b:bo&:go&}2b:bo&:fo&cs:fo&#}2f+\:co&:fo&cs:fo&:bo&}2f8:co&:co& 9=!}2bD!}2b:bo&|h!9^#V!i:!,MCant open %s 8:fo&#}2f+:fo&f^}2c:co&:fo&#}2f+:fo&f^}2cͽ4:bo&|:co&:go&:}2b!:!}2b:bo&:fo&89!}2b!}2b:bo&|I:bo&",d*,d*d",d*,d)*Xd^#V"d:bo&:fo&:}2b:bo&:fo&89z!}2bÁ!}2b:bo&|ʼ:bo&",d*d*,d",d*e*,d^}2b:bo&"dÿ *d}2b:bo&Wf^}2b:bo&"d :fo&+}2f# =:mMsSIndex mem cell 8:fo&f^}2c:co&:#go&)d^#V"d:#go&)d^#V"dͰ":$go&)0e^#V"d:$go&:co&8ʚ!}2bá!}2b:bo&|! ::co&}2$g!}2d:$go&+}2$g#:fo&#}2f+:fo&f^}2b:fo&#}2f+:fo&f^}2b!b!b!d5:#go&)d^#V"d!b!b!d5:bo&"d:fo&"d*~d",d*,d#",d+*,d)*d^#V"d*~d",d*,d#",d+jͽ4:bo&|ʵ:co&}2b!+::co&}2b:bo&)jd^#V"d=:!SBXH(NUdVY>ZkbXh(nudvy>zkZ stacker Illegal fetch 8!}2f*Bd*fd^}2e*fd#"fd+!|:fo&:eo&89ʃ!}2bÊ!}2b:bo&|*Bd*fd^}2b*fd#"fd+:bo&:fo&fs:fo&#}2f+^8!"e".e}2$g}2#g}2%g!a}2 g!b}2 g!c}2 g!d}2 g!e}2 g!f}2g!g}2g!h}2g!i}2g!j}2g!k}2g!l}2g!m}2g!n}2g!o}2g!p}2g!q}2g!r}2g!s}2g!t}2g!u}2g!v}2g!w}2g!x}2 g!y}2!g!z}2"g!0}2g!1}2g!2}2g!3}2g!9}2g! }2c!}2c!}2c!}2c!}2c!}2c! }2c!!}2c!*}2c!-}2c!+}2c!>}2c!=}2c!<}2c!P}2g! }2c!/}2c!.}2c!'}2c!" d!"$d!"&d! "(d!"*d!O}2f:co&) d^#V"Fd!*Fd86"b!"dd"d"Nd"d}2f"Ld"~d}2f"fd}2f}2f}2d!}2fUw8:fo&:fo&8!}2b!}2b:bo&| :co&}2f:fo&#}2f+8!|:fo&:fo& 9@!}2bG!}2b:bo&|*b͙6}2c:co&:co& 9{!}2bÂ!}2b:bo&|ʔ!}2c:co&:fo&fs:fo&:fo&8!}2b!}2b:bo&|!}2f:fo&#}2f+8!}2b}2f}2f!|ʡ:bo&:fo&9)!}2b0!}2b:co&:co&8M!}2cT!}2c:bo&:co&Ͷ8}2b:bo&|ʡ*b͙6}2c:co&:bo&fs:bo&#}2b+8:fo&f^}2c!|ʈ:co& 8!}2b!}2b:bo&|*Nd#"Nd+!"d:co& 8!}2b!}2b:bo&:bo&9}2b:co& 8J!}2bQ!}2b:bo&:bo&9}2b:bo&|ʈ:fo&f^}2cù8:fo&",d*^d*,d:"^d *^d",dͬ!8:fo&",d*^d*,d"^d*Td*^d89!}2b!}2b:bo&|!:*^d",dDestroy cell error 8ͺ*,d* d 9;!}2dB!}2d:do&|N*Vd*Dd)*Xds#r!|:co&*e*Vds*`d*Vd)*Xds#r*Vd#"Vd+ :co&:co& 9ʱ!}2bø!}2b:bo&|:bo&#}2b+:bo&Wf^}2c_*Vd",d*Vd",d:fo&"Jd*Vd*Jd"Vd ͬ!8*Rd*Vd)*Xds#r*Vd"Rd*Vd*Zd"Vd:co&*e*Vds* d*Vd)*Xds#r8!"Rd"\d! "Td*Td"^d!"Zd*Rd*Zd"Vd* d"`d* d*Rd)*Xds#r:co&*e*Vds* d*Vd)*Xds#r8*Rd*Zd"Dd!}2b!|:bo&Wf^}2c*e*Dd^}2c:co&:co&8!}2d!}2d:do&|~:co&:co&8G!}2dN!}2d:do&|g*Dd*$d",d*Dd#"Dd+:bo&#}2b+*Dd)*Xd^#V",d*,d*`d8ʥ!}2dì!}2d:do&|* d",d*,d"Dd*Dd*Vd89!}2d!}2d:do&|* d",d:bo&}2b8*^d*Vd89 !}2b& !}2b:bo&|D !t :!,MD *\d*Vd89[ !}2bb !}2b:bo&|s *Vd"\dNO Memory space left, increase array sizes. 8*Rd* d 9ʽ !}2b !}2b:bo&| *Rd"Vd*Rd)*Xd^#V"Rd!*Zd"Vd:co&*e*Vds* d*Vd)*Xds#r8:co&:fo&Wfs*Rd"bd!|ʥ!ͺ*,d* d8Q!!}2dX!!}2d*Rd)*Xd^#V"Rd*Rd* d 9|!!}2c!}2c:do&:co&Ͷ8}2c:co&|ʥ!/!*bd"Rd8!}2b*,d"Jd!|.":bo&:fo&89!!}2b!!}2b:bo&#}2b+:bo&|.":co&*e*Jds* d*Jd)*Xds#r*Jd#"Jd+þ!8!|ʢ":fo&"Dd* d*Dd89_"!}2bf"!}2b:bo&|ʢ":fo&+}2f#:fo&c^}2b!hb:bo&=7"!hb! =8:#go&:co&8"!}2b"!}2b:bo&|#! #::co&}2#g!}2d#:#go&+}2#g#Y stacker 8:co&:co&Wfs!}2f!|ʜ#*b͙6}2c2:bo&}2cͽ4:bo&:co&9}2b:bo&|ʜ#:co&:fo&Wfs:fo&#}2f+7#:co&:fo&8ʹ#!}2b#!}2b:bo&|#$!|$*b͙6}2c:co&:fo& 9#!}2b$!}2b:bo&|$#8:co&) d^#V"Fd!~**Fd86"b*Fd!"fd!"hd}2e!|ʰ'*b͙6}2f:co&:co&8ʅ$!}2bÌ$!}2b:bo&|ʰ':fo&Ò'*b͙6}2c:co&-8$!}2b$!}2b:bo&|$*b͙6}2cͩ+*d9"d%ͽ4:bo&|ʝ%ͩ+!b!b!d5:bo&*Bd*fds*fd#"fd+:eo&#}2e+:bo&*Bd*fds*fd#"fd+:eo&#}2e+:co&}2f:fo& 8ʂ%!}2bÉ%!}2b:bo&|ʗ%Ú%h$%!/*Bd*fds*fd#"fd+:eo&#}2e+:co&}2fh$í':eo&*Bd*hds*fd"hd*fd#"fd+:co&}2eí':eo&:co&8&!}2b&!}2b:bo&|?&*! }2f*fd+"fd#h$j':eo&:co&8_&!}2bf&!}2b:bo&|]'*b͙6}2c#:co&:fo&Wfs*,d)*Xd^#V"d*d* d8ʽ&!}2b&!}2b:bo&|&*,d"d:fo&*Bd*fds&:fo&*Bd*fds*fd#"fd+!b!b!d5:bo&*Bd*fds*fd#"fd+:bo&*Bd*fds*fd#"fd+:co&}2e:fo&}2fh$j':bo&}2b:fo&*Bd*fds*fd#"fd+:eo&#}2e+í'=:/$ %.%gB&GB&`'T$*fd+"fd#:co&:co& 9'!}2b'!}2b:bo&|'!*:!,M'*b̀6:co&) d^#V"Fd!**Fd86"b*Fd!",d!|D**,d*fd89Q(!}2bX(!}2b:bo&|D**Bd*,d^}2e*,d*$d"Dd*Bd*Dd^}2b:bo&:fo&8ʫ(!}2bò(!}2b:bo&|"*:go&*Bd*Dds*Dd#"Dd+*Bd*Dd^}2b*Dd#"Dd+*Bd*Dd^}2b!b!b!d5*e*d^}2b:bo&:co& 9=)!}2bD)!}2b:bo&|)*d*(d:"Hd!|ʸ)*Hd*d89{)!}2bÂ)!}2b:bo&|ʸ)*e*Hd^}2b!hb:bo&=*Hd#"Hd+\)!hb:co&=!*:)*d)*Xd^#V"Hd!b!b!Hd5:bo&*Bd*Dds*Dd+"Dd#:bo&*Bd*Dds"*:eo&"Dd*,d*Dd",d*,d*$d",d2(͡ *fd",d/"!*:*dd",d/"!*::fo&",d/"!*:rCant read commands. rSubroutine undefined. command bytes; number labels; subroutines. 8!|C+*b͙6}2c2:bo&|D+ͽ4:bo&|Œ+:co&:fo& 9.+!}2b5+!}2b:bo&|C+*#:co&:fo&Wfs*hd*,d)*Xds#r:co&*e*,ds:fo&#}2f+*dd#"dd+ͩ+*hd*d)*Pds#r8!"d!| ,:co&:go&:}2c:co&",d*d Ͷ9"d*d*,d"d*b͙6}2cͽ4:bo&| ,ô+8:fo&#}2f+:fo&f^}2c:co&1:#go&#}2#g+:go&:#go&9c,!}2bj,!}2b:bo&|ʑ,!1::go&}2#g!}2dÑ,*d:#go&)ds#rÝ1:$go&#}2$g+:go&:$go&9,!}2b,!}2b:bo&|,!1::go&}2$g!}2d,*d:$go&)0es#rÝ1:#go&)d^#V",d*,d*d",d*,d:#go&)ds#rÝ1:#go&)d^#V",d*,d*d:",d*,d:#go&)ds#rÝ1:#go&)d^#V",d*,d*dͶ9",d*,d:#go&)ds#rÝ1:#go&)d^#V",d*,d*d89-!}2b-!}2b:bo&|-!}2d-!}2dͰ"Ý1:#go&)d^#V",d*d*,d89,.!}2b3.!}2b-:#go&)d^#V",d*,d*d8_.!}2bf.!}2b-:fo&#}2f+:fo&f^}2c*d"Dd:fo&#}2f+:co&}2cͽ4:bo&|.:co&:go&:}2b.!1:!}2b:bo&:fo&89.!}2b.!}2b:bo&|//:bo&",d*,d*d",d*Dd*,d)*Xds#r:bo&:fo&:}2b:bo&:fo&89`/!}2bg/!}2b:bo&|ʡ/:bo&",d*d*,d",d*Dd}2b:bo&*e*,dsä/.Ý1*d",dQ2Ý1*d}2b:bo&:fo&Pcs:fo&#}2f+Ý1*d}2b:bo&:fo&Wfs:fo&#}2f+:co&:fo&WfsÝ1*d}2f:co&:fo&WfsÝ1*d"dÝ1*~d",d*,d#",d+*d*,d)*ds#rÝ1*~d",d*,d#",d+D0Ý1*d}2b:bo&"d*d8",d*,d))))"Dd*d*Dd:"Dd*,d}2c1*Dd}2c1Ý1:fo&f^}2cͽ4:bo&|0:co&:go&:}2b1!1::co&}2b*d:bo&)jds#rÝ1=:*|-+--G-<.=6.>-A/B0C/Dq0G50Ht0Ii.L/U>0V`0Y:,Z,a/b0c/dq0g50ht0ii.l/u>0v`0y:,z,0Y overflow. Z overflow. Bad indirect index. Illegal store. 8:co& 91!}2b2!}2b:bo&|2:co&0}2c12:co&A}2c:co&:fo&Pcs:fo&#}2f+8!|2:fo&"Dd* d*Dd89ʁ2!}2bÈ2!}2b:bo&|2:fo&+}2f#:fo&c^}2b:bo&:fo&Pcs:fo&#}2f+Y28:co&a93:co&z93!}2b43:co&A9-3:co&Z9-3!}2b43!}2b8!0:co&9T3!}2b[3!}2b:co&99u3!}2b|3!}2b:bo&:bo&Ͷ8}2b:bo&|ʪ3:co&}2c!a:co&93!}2b3!}2b:co&f93!}2b3!}2b:bo&:bo&Ͷ8}2b:bo&|34:co&}2c! }2b:co&:bo&}2c!A:co&9M4!}2bT4!}2b:co&F9n4!}2bu4!}2b:bo&:bo&Ͷ8}2b:bo&|ʼ4:co&}2c! }2b:co&:bo&}2c8:co&}2b!9:co&:}2b:bo& 94!}2b5!}2b:bo& 95!}2b#5!}2b:bo&:bo&Ͷ8}2b8:co& 8V5!}2b]5!}2b:co& 8v5!}2b}5!}2b:bo&:bo&9}2b:co& 8ʪ5!}2bñ5!}2b:bo&:bo&9}2b8! 9^#V^! 9^#V^!:9! 9^#Vs#r8!9^#V^#V!Ͷ8!9^#Vs!9^#V^#V!:! 9^#Vs8! 9^#V! 9^#V(;!9s#rzi6!}2cp6!}2c!}2c!9^#V8!9^#V͠?!}2c8! !9s!}2c!9^! 8Q7:co&|Q7! 9^#Vͺ=!9s!86!9^!86!}2c7!}2c:co&|7!}2c:fo&|N7!9^! 9N7:co&|N7!hb!9^ ?î6!9^8:fo&|ʩ7!}2f!9^!t8ʍ7! !9sæ7!9^!n8ʦ7! !9s7!9^!\87!}2f!}2c!9^! 88! 9^#V! ?87!}2c8!}2c! 9^#V! 9^ ?8+8!}2c28!}2c8! 9^#V!9s#r! 9^#V^z~8! 9^#V^!. 9~8! 9~#fo#s#r+F8! 9^#V^!.8ʠ8!! 9^#Vs! 9^#V!9^#VZ|g}o|/g}/o^#V#DM!99`i8|z2_c9:_9}|9}}9|9!}9|9!}|09}|?>o&zo&|J9}|>o&|o&z2_c9:_9||n9/g}/o#z|9/W{/_|9DM!>2_))ҏ9#}o|gҧ9 :_=2_‡9}:_=2_‡9}DM!>))9 =¾9}}/o|/g#}|99|g}o{_:|:|7g}o9{_:) :}}o|gN#F# N#F#z3:{7:##^#VBK^#Vz]:#yW:###E:#xR:#~#fo}|>?o&}|>o&{_:|g}o‡:|g}o~# xœ:!9_~#³:!:|ɧ8!hb"_! 9! 9^#V!;B8!9^#V"_! 9! 9^#V!;B8*_! 9^#V=8!]bDM`i~V;`i DMbd:S;!2;! 9^#V#^!+8!9s#r! 9^#V^Y! ^!Ͷ8=!!`in&Ͷ8s`i~#>͑A! ^#V! ^#V! ^ͧQ!9s#r!9l>!9~#S>!V>!`in&9s!! ^#V`is#r!9~#fo! s#r`i~#fo#s#r+^!Ͷ88!sb! 9^#V ?8!9N#F! 9^#V ?89>!! 9^#V`i: ?89?!`i8! 9N#F! ^#V`i^#Vd:>?!9^#V!Ͷ8?@!9^#V`i~#fo#s#r+s!Ͷ88!! 9^#V?@8!]bDM`ibr:ʟ?`i DM͠??8! 9N#F!!9s#r`i~-@! ^!Ͷ8?!?@!9s#r! ^͡O!9~#fo9s#r! ^!Ͷ8-@*b! ^#Vs#r! ^#V"b!! s!9^#V8! 9N#F! ^!Ͷ8ʴ@! ^#V`i^#V:!9s#r!9^#V! ^#V! ^U8ʴ@!`in&9s!! 9^#V!8@!`in&Ͷ8s!`is#r! s#r!`i~#@͑A! ^#V!87A!!9! ^U8›@! 9^#V! ^#V`is#r! ^#V! ^#V! s#r!`in&9s! 9^#V`i~#fo#s#r+s!Ͷ88! 9N#F! ^#V!8ʼA`i! s#r*b|A*b!9s#r*b^#V"bB! ^#V'B!9s#rzB!! s#ríA!`in&9s!9^#V! s#r8*"_|BB!J" _""_*"_DM!9^#V*"_""_PYr:gB`i""_!*"_* _s:ʦB*"_* _:Ͷ8!9s#rJ^B!9^#V* _" _`i8!9^#V"$_! 9! 9^#V!BB!*$_s8!9^#V*$_#"$_+s!Ͷ88!L9N#F!N9~#fo#s#r+^!F9s#rzʕH!F9^#V!%8ʄH!!9s!!D9s#r! !B9s#r!!@9s#r!N9^#V^!F9s#r!-8ʟC!!D9s#r!N9~#fo#s#r+^!F9s#r!F9^#V!08ʺC!0!B9s#r!!>9s#r!N9~#fo#s#r+^!F9s#r!09D!F9^#V!99D!>9^#V! Ͷ9!F9~#fo!>9s#rC!F9^#V!.8ʔD!!@9s#r!N9~#fo#s#r+^!F9s#r!09ʔD!F9^#V!99ʔD!@9^#V! Ͷ9!F9~#fo!@9s#r:D!F9^#V!l8D!N9~#fo#s#r+^!F9s#r!:9!R9~#fos#r͉[͜[ÔE!F9^#V!d8E!:9!R9~#fo##s#r++^#V^͜[ÔE!F9^#V!e8KE!F9^#V!f8KE!F9^#V!g8qE!9!R9~#fos#r__ÔE!:9!R9~#fo##s#r++^#V^͜[!F9^#VPG!9!!>9͉[ͯ[H!9!49s#rwG!:9͉[t[^F!9! !>9͉[[ͯ[͖H!9!49s#r!-!69~#fo+s#rs;F!9! !>9͉[ͯ[͖H!9!49s#rwG!9! !>9͉[ͯ[H!9!49s#rwG!9!!>9͉[ͯ[H!9!49s#rwG!:9͉[ _!49s#rͩZ!89s#rÏG!F9^#V!e8F!F!!B9^#V!8F!F!B9^#V!9! 9___!9! 9!49s#rͩZ!89s#r!!@9s#rÏG!:9͉[ _!F9s#r!F9^#V!9!69s#rswG=:oEdEu>FxdFsFeFfFc$G6G!9!49~#fo:!89s#r!89^#V!@9~#fo99ʲG!@9^#V!89s#r!D9~#G!>9~#fo+s#r#!89~#fo99G!B9^#V`i8üG!!69s#r H!69~#fo#s#r!49^#V~JH!69^#V!@9~#fo89JH!49~#fo#s#r+^`i8G!D9~#H!>9~#fo+s#r#!89~#fo99ʁH! `i8THÒH!F9^#V`i8C8! 9N#F`i^ͯ[! 9͉[[o] _&_^!9~#fo+s#rs!9`i^[͉[5]͜[[¢H!9^#V8!9N#F! 9͉[t[^ʼI! 9͉[ _Ͷ8!9s#r! 9! 9͉[t[\t[q\͜[`i9^ͯ[!9͉[[o] _)!9~#fo&_^!9~#fo+s#rs! 9`i9^[͉[5]͜[!9^#V!9͉[ͯ[͖H!9*JIͧ:Iͧ:*_DM*_o&ͧ:Jo&ͧ:*_*+++*_DM*_!9N#F#^#Vkb6#> 6 #=>J>6#=GJ : >zJ AڴJ[kJ@wJaڴJ{ҴJ`w# .ʕJʮJ}JͻJw#~J{o|g ʮJͻJw#ŸJ!!|a{ !9^#V*7_!9}|J*7_"7_|!8!!!u_Z!:o&Ͷ8u_s!M"9_!u_DM!"_*_89L`i^! 8RK`i^! 8ZK`i#DM6K`i^zL`i^!>8ʀK!!9s#rÙK`i^!<8ʥL!!9s#r`i#DM^! 8¸K`i^! 8ʻKÙK`i!9s#r`i#DM~K`i^! 8K`i^! 8K!`i#DM+sKK!9^#V͡O!9~#/L!!9^#V͞M!9s#rHL!!9^#V;M!9s#r!9^#V!8ʢL!M!̈́Z!9^#V!Z!*M!Z!ͩZ!!U! ,ML`i*_#"_+)9_s#r`i#DM~L`i^! 8L`i^! 8L!`i#DM+sLùL)K!9_*_,MCan't open file for redirection: 8u?!9~#FM!JMYIA:$$$.SUB8!"Sb!8!con:CON:lst:LST:prn:PRN:pun:PUN:rdr:RDR:8! 9^#V!! 9^#V;M8!b! 9s#r!!9s#rM! 9~#fos#r!9~#fo#s#r!9^#V! 89'N! 9^#V!^#V!TM81NM!"Sb!!cDMAN`iDM`i~#bN!9^#V`i^#VKZbN9N! ^#V!9s#r!9^#V!Ͷ8#!9s#r!9^#V!Ͷ8ʻN!9^#V^! 9^#Vsz»N!"Sb!!9^#V!Ͷ8N!9^#V#^! 9^#V#szN!"Sb!! ^#V! 9^#V!s#r!9^#V##^! 9^#V##s!9^#V###^! 9^#V###s!cM! 9^#V!s#r! 9^#V!9^#V!9^#V!9^#V!9^#V!^#V8! 9!89ʘO!!9^#V8!9^#V!89O!9^#V! 99O!"Sb!!9^#V)))bDM! ^#V! ^#V8!9s#r!! s! s! s`is!TM! s#r!9^#V8!_DMZ!9^#V#~#foxoZtZoZ# [Z!~Z!}!}!9^#V#~#foxʦZ~ʦZ# ÕZ!9~#foʾZ#õZ}!9^#V#^#V#N#F[Z!9^#V#^#V#N#FÕZ!9^#V#~#foxʦZ~[# [ÕZ!9^#V#^#V#N#F[!9^#V#n~C[I[#6[!|!9^#V#ne[#\[xC[ +~e[I[!*bÍ[!*bw#w#w#w*b~#~#~#~";b*bV+^+V+^*;b";b*bs#r#s#r*;b*b*b"b"b*b>w#[*b~»^#[ð^=ɯ<*b*b###.\\2\ \ \\+4\*b*b#P\*b*b#f\*b*b#{\*b*b#\*b*b#¥\*b~/w#µ\*b~?G*b^#V#~#fo))\#\DM*bs#r#q#p*b~?W*b###~]~w+]\7~w+]]~#&]O[*bGb#]y2Eb*bOb#]:Eb2Eb͢]Gb*bw#^]:Eb[*bGb#]y2Eb*bOb#]͢]Kb*bw#‘]:Eb[!Kbw#¨]> 2Fb!Gb~w#¹]OKb!Ob#]y]!Gb4!Fb5³]!Fb5^!Gb~w#]OKb!Ob# ^y]]Kb!Ob#$^*bOb~#7^*bKb~#G^!Gbw#U^> 2Fb!Gb~w#f^ґ^Gb!Ob#z^ґ^…^!Fb5`^*bGbw# ^\ʻ^!\ʰ^!<\^ð^\^ʻ^ð^\^û^\^ʰ^û^*bs#r#6#6*bs#r#z^6#6*b^#V0123456789abcdef&gTMRSTTMUWW=bAbcMcMcMcMcMcMTMTMTMTMTMTMTMTMlMbqMbvMb{MbMbMbMbMbMbMbd'P META4 COMPILER - COMPILER ------------------------- G. A. Edgar ************************************************************** * This implementation of Meta4 and of M4 is * * (c) 1981 W.A. Gale * * Additional material * * (c) 1984 G.A. Edgar * * Non-commercial use is permitted. * ************************************************************** HISTORY ------- META II was described in 1964 by the Los Angeles chapter of SIGPLAN of the ACM (reference below). Meta4 was described in Dr. Dobb's Journal (August, 1981) by W. A. Gale. The M4 interpreter was given in PIDGIN, which is (relatively) easy to translate into any other language. M4 was implemented for CP/M-86 by A. L. Bender. That version was distributed on SIG/M disk 159. M4 was transplanted to BDS C by: Jan Larsson, Kosterv. 12, S-181 35 Lidingo, SWEDEN. That version is available from the BDS C Users Group, on their disk "Compiler Utilities I" (disk number 17 in one of the numberings). I converted M4 to a more conventional C (namely Aztec). That source code, and object code for CP/M-80 are distributed here. DISK CONTENTS ------------- (1) Files concerning Meta4 are: META4.DOC This file. META4.MET Meta4 source code (in Meta4) META4.M4 Meta4 (in M4 object language) M4.COM M4 interpreter for CP/M-80 M4.C M4 (in C, with a foreign accent) (2) As a sample of how a compiler can be written in Meta4, I have written a compiler for the language VALGOL I (perhaps "very small ALGOL") from the META II paper. These files are: VALGOL.DOC Documentation for VALGOL I V1ASM.MET VALGOL I to 8080 ASM translator VAL-M80.MET VALGOL I to Z80 M80 translator VALLIB.REL Relocatable library for VAL-M80.MET MULT.MAC Source code for VALLIB.REL EDIT.MAC / PRINT.MAC / CPMOUT.MAC / (3) SIG/M disk 159 has a slightly different version of Meta4. Files relating to it are: META412.DOC Note on version 1.2AX of Meta4 META412.M4 Ver. 1.2AX of META4.M4 META4MT4.DIF Difference files for ver. 1.2AX VAL-M80.DIF / HOW TO GET M4 FOR YOUR COMPUTER ------------------------------- Except for the M4 interpreter, all the programs in this group are written in M4 or in each other, so once you have M4, you will be able to use them all. If you have CP/M-80, just use M4.COM. If you can use K&R standard C, use the source code M4.C. For nonstandard C's, you will have to make alterations. (Or try the BDS C Users Group disk. I tried to adapt this for Small C ver. 2.1, but apparently I did not find all of the "features" that differ, since I didn't get it to work right.) If you have CP/M-86, M4 is called META.CMD on SIG/M disk 159. It should work with the files on this disk. According to remarks on SIG/M disk 159, there is also a version specifically for IBM PC. According to W. A. Gale's remarks in a later issue of Dr. Dobb's Journal, M4 should also be available for Apple II and OSI. (His goal was to write tools that can be easily implemented on *all* microprocessors.) If worse comes to worse, you can implement M4 yourself in any higher-level language (even BASIC) by converting from the PIDGIN source code given in the August, 1981, article. UNDERSTANDING META4 ------------------- You will need a copy of the documentation in the August, 1981, issue of Dr. Dobb's Journal. Another useful paper is the document on META II, by D. V. Schorre, in the Proceedings of the 19th National Conference of the Association for Computing Machinery, 1964. (It was reprinted in Dr. Dobb's Journal in April, 1980). RUNNING META4 ------------- Comments given here apply to the CP/M-80 version of M4. Presumably, they can be used with appropriate changes for other versions, too. First, you will need the M4 interpreter. Usage: A>M4 You will also need the Meta4 object file, META4.M4. Then, you write your compiler in the Meta4 language. Let's say it is called VAL-M80.MET and it is supposed to translate a language called VALGOL I into Z80 assembly language for Microsoft's M80. Start by compiling the compiler using Meta4 running on the M4 interpreter: B>M4 META4 VAL-M80.MET VAL-M80.M4 M4 interpreter ver. 1.0 Copyright (c) 1981 by W.A. Gale 3264 command bytes; 207 number labels; 30 subroutines. --- Meta4 compiler-compiler --- 249 max memory used Thus the Meta4 compiler-compiler has taken VAL-M80.MET in Meta4 and translated it into VAL-M80.M4 in M4. Now in order to compile a program in VALGOL I, use the compiler VAL-M80.M4 just produced. Suppose your program is called P.VAL. To compile it into P.MAC do this: B>M4 VAL-M80 P.VAL P.MAC A more complete discussion of such an example is in the file VALGOL.DOC. COMPILING THE COMPILER-COMPILER ------------------------------- Long ago, when I switched from interpreted BASIC to compiled languages, I had to overcome my confusion between what happens during the compile phase and what happens during the execution phase. Well, now there are *four* different programs ( M4 , Meta4 , VAL-M80 , P ), each having its own language and its own time to act. Try to keep that straight! (Another confusion is that in the BDS C version, the M4 interpreter signs on by saying "Meta4" ! I quickly changed that.) The Meta4 compiler-compiler is itself a compiler, so it was written in the Meta4 language, and can be compiled by Meta4. To do this, you need M4.COM, META4.M4, and the source code META4.MET. Then do this: B>M4 META4 META4.MET META4X.M4 This should produce an object file META4X.M4. It should be identical to the object file META4.M4. A self-reproducing program!! Once you have META4.M4, then you can get META4.M4 by using it to compile META4.MET. (Now how did Dr. Gale compile META4 the first time? Which came first, the chicken or the egg?) CONCLUSION ---------- I wasn't kidding about getting the write-up in Dr. Dobb's Journal. Look in a university library. Dr Dobb's sells back issues in bound annual volumes. Although Dr. Gale's paper is not completely lucid, and is somewhat incomplete, it contains some indispensible information. It contains, for example, a description of the "object language" M4, which I have not covered at all here. It also has some background discussion of what is going on in general, and how to keep it straight. The T-shaped diagrams helped me to overcome some of my confusion. Go over the material on VALGOL I. The file VALGOL.DOC contains some explanation of the source file V1ASM.MET. This is the best place to start learning Meta4. (V1ASM.MET is shorter and easier to understand than META4.MET.) I suppose in the hacker's ideal world, all of you people out there (on the other side of this SIG/M release) would get busy and produce some public-domain compilers written in the Meta4 language. M4 has a lot of features that I have not used in connection with VALGOL, such as the ability to keep track of a symbol table, with separate layers for controlling scopes of variables. But realistically, such a thing would be a lot of work. So I don't expect to see it. (But wouldn't it be nice to be surprised?) If you want to contact me concerning this material, the best way is electronically, on CompuServe, my PPN is 70715,1324. The next best way is to write: G. A. Edgar, 107 W. Dodridge St., Columbus, OH 43202. If you want a reply, enclose a self-addressed, stamped envelope. REFERENCES ---------- A. L. Bender, Files on SIG/M disk 159, February, 1984. (ABSTRACT.159, M4.M4, META.*, META4.MET) W. A. Gale, "Write your own compiler", Dr. Dobb's Journal, August, 1981, pp. 6-14; listings pp. 22-39. J. Larsen, Files on BDS C UG disk "Compiler Utilities I". (M4.COM, META4*.*) D. V. Schorre, "META II, a syntax-oriented compiler writing language", Proc. 19th Nat. Conf. ACM, 1964. Reprinted in Dr. Dobb's Journal, April, 1980, pp. 17-21; listings pp. 22-25. ------------------------- G. A. Edgar May 22, 1984 CompuServe [70715,1324] revised: October 21, 1984 s xm; gcompile e ... rvalue gidname f/1 gcatname lm: l f/2 gidfield x pm 0m0c ... 2 t/3 s f/4 ... 4 ... 3 x ... 1 t/5 gconstsimp f/6 pn/ !c p ... 6 t/5 lm+ l f/7 gexpression x p! ... 7 ... 5 r ... expression gterm f/8 ... 9 lm+ l f/10 gterm x p!+ o ... 10 t/11 lm- l f/12 gterm x p!- o ... 12 ... 11 t/9 s x ... 8 ... 13 r ... term gfactor f/14 ... 15 lm* l f/16 gfactor x p!* o ... 16 t/17 lm/ l f/18 lm256 l x phz o p!d o pzy o ... 18 t/17 lm%256 l f/19 phy o pn/ p256* o p!- o ... 19 ... 17 t/15 s x ... 14 ... 20 r ... factor lm( l f/21 gexpression x lm) l x ... 21 t/22 gconstsimp f/23 pn/ !c py o ... 23 t/22 gidname f/24 gcatname lm: l f/25 gidfield x pm 0m0c ... 25 t/26 s f/27 ... 27 ... 26 x py o ... 24 t/22 lm- l f/28 gfactor x p!z o pn/ p0y o pz- o ... 28 ... 22 r ... catname 0m0y !l r ... toplace gidname f/29 02 lm: l f/30 gidfield x pi 0m0c ... 30 t/31 s f/32 ... 32 ... 31 x 20 gcatname ... 29 ... 33 r ... declare lm.field l f/34 ... 35 gidnew f/36 02 gconstexp x gcheckfrange 0i02 n/3 i32 ... 36 ... 37 t/35 s x lm; l x ... 34 t/38 lm.name l f/39 ... 40 gidnew f/41 02 gconstexp x !i02 n/1 i32 ... 41 ... 42 t/40 s x lm; l x ... 39 t/38 lm.constant l f/43 ... 44 gidnew f/45 02 gconstexp x n/2 i32 !i02 ... 45 ... 46 t/44 s x lm; l x ... 43 ... 38 r ... constexp gconstterm f/47 ... 48 lm+ l f/49 gconstterm x !+ ... 49 t/50 lm- l f/51 gconstterm x !- ... 51 ... 50 t/48 s x ... 47 ... 52 r ... constterm gconstfac f/53 ... 54 lm* l f/55 gconstfac x !* ... 55 ... 56 t/54 s x ... 53 ... 57 r ... constsimp ln l f/58 0y ... 58 t/59 gidcons f/60 0m0y ... 60 t/59 lq' l f/61 n/0sy ... 61 t/59 lm.x l f/62 lh l x 0y ... 62 ... 59 r ... constfac gconstsimp f/63 ... 63 t/64 lm- l f/65 gconstfac x !z n/0y z- ... 65 t/64 lm( l f/66 gconstexp x lm) l x ... 66 ... 64 r ... idtype li f/67 me 0m3y z= l r .67 l z9 r ... idname n/1 z gidtype f/68 ... 68 ... 69 r ... idfield n/3 z gidtype f/70 ... 70 ... 71 r ... idcons n/2 z gidtype f/72 ... 72 ... 73 r ... idnew n/0 z gidtype f/74 ... 74 ... 75 r ... checkfrange 0y n/5 < sc ... 76 ... 77 f/78 r j/79 ... 78 s t/80 0c p is too big for a field xo ... 80 ... 79 r ... aout lm*1 l f/81 pu o ... 81 t/82 lm*2 l f/83 pv o ... 83 t/82 lm* l f/84 pc o ... 84 t/82 lq' l f/85 ... 85 t/86 lq" l f/87 ... 87 ... 86 f/88 pp c o ... 88 t/82 grvalue f/89 pc o ... 89 t/82 lm.h l f/90 grvalue x ph o ... 90 t/82 lm. l f/91 pxn o ... 91 ... 82 r ... notsyn lm.out l f/92 lm( l x ... 93 gaout t/93 s x lm) l x ... 92 t/94 lm.lab l f/95 pp... o gaout x ... 95 ... 94 f/96 po o ... 96 t/97 lm.act l f/98 lm( l x ... 99 lq' l f/100 ... 100 t/101 lq" l f/102 ... 102 ... 101 f/103 c lm*1 l f/104 u ... 104 t/105 lm*2 l f/106 v ... 106 t/105 s f/107 ... 107 ... 105 x o ... 103 t/108 lq! l f/109 ... 109 ... 108 t/99 s x lm) l x ... 98 t/97 lm] l f/110 grvalue x py o ... 110 t/97 grvalue f/111 lm=: l x gtoplace x o ... 111 t/97 lm.if l f/112 lm( l x gcexp x lm) l x pf/ u o ... 113 gnotsyn t/113 s x lm.else l f/114 pj/ v o p... u o ps o ... 115 gnotsyn t/115 s x lm.end l x p... v o ... 114 t/116 lm.end l f/117 p... u o ps o ... 117 ... 116 x ... 112 t/97 lm.cat l f/118 lm( l x ... 119 gaout t/119 s x lm) l x ... 118 t/97 lm.condlab l f/120 lm*1 l f/121 puy o p0= o pt/ u o pp... o pu o ... 121 t/122 lm*2 l f/123 pvy o p0= o pt/ u o pp... o pv o ... 123 ... 122 x po o ps o p... u o ... 120 t/97 gerrormessage f/124 ... 124 t/97 lm.error l f/125 psf o ... 125 t/97 lm.succeed l f/126 ps o ... 126 t/97 lm.fail l f/127 psf o ... 127 t/97 lm& l f/128 gidnew x pg c o ... 128 t/97 lm.return l f/129 pr o ... 129 t/97 lq! l f/130 ... 130 ... 97 r ... cright lm== l f/131 py o grvalue x p= o ... 131 t/132 lm!= l f/133 py o grvalue x p= o psc o ... 133 t/132 lm<= l f/134 py o grvalue x p< o psc o ... 134 t/132 lm>= l f/135 py o grvalue x p> o psc o ... 135 t/132 lm< l f/136 py o grvalue x p> o ... 136 t/132 lm> l f/137 py o grvalue x p< o ... 137 ... 132 r ... cterm gcfac f/138 ... 139 lm.andif l f/140 pf/ v o gcfac x ... 140 ... 141 t/139 s x vy 0= t/142 p... v o s ... 142 ... 138 ... 143 r ... cfac grvalue f/144 gcright x ... 144 t/145 lm.not l f/146 gcfac x psc o ... 146 t/145 lm( l f/147 gcexp x lm) l x ... 147 t/145 lm& l f/148 gidnew x pg c o ... 148 ... 145 r ... cexp gcterm f/149 ... 150 lm.orif l f/151 pt/ u o gcterm x ... 151 ... 152 t/150 s x uy 0= t/153 p... u o s ... 153 ... 149 ... 154 r ... errormessage lm.erms l f/155 lm( l x pt/ u o ... 156 gaout t/156 s x lm) l x pxo o p... u o ... 155 ... 157 r ... syn gidnew f/158 pg c o ... 158 t/159 lq' l f/160 ... 160 t/161 lq" l f/162 ... 162 ... 161 f/163 plm c o pl o ... 163 t/159 lm.id l f/164 pli o pf/ u o pl o pme o p... u o ... 164 t/159 lm.num l f/165 pln o pl o ... 165 t/159 lm.str l f/166 lq' l f/167 ... 167 t/168 lq" l f/169 ... 169 ... 168 x plq c o pl o ... 166 t/159 lm.emp l f/170 ps o ... 170 t/159 lm$ l f/171 p... u o gsyn x pt/ u o ps o ... 171 t/159 lm( l f/172 gphrase x lm) l x ... 172 t/159 lm.hexnum l f/173 plh o pl o ... 173 ... 159 f/174 gerrormessage f/175 ... 175 t/176 s f/177 ... 177 ... 176 x ... 174 ... 178 r ... seq gsyn f/179 pf/ u o ... 180 gsyn f/181 px o ... 181 t/182 gnotsyn f/183 ... 183 ... 182 t/180 s x p... u o ... 179 ... 184 r ... alts gseq f/185 ... 186 lm/ l f/187 pt/ u o gseq x ... 187 ... 188 t/186 s x uy 0= t/189 p... u o s ... 189 ... 185 ... 190 r ... phrase lm.prep l f/191 ... 192 gnotsyn t/192 s x galts x ... 191 t/193 galts f/194 ... 194 t/193 gnotsyn f/195 ... 196 gnotsyn t/196 s x ... 195 ... 193 r ... statement li f/197 l me ... 197 f/198 p... c o lm= l x gphrase x lm; l x pr o lq! l f/199 ... 199 t/200 s f/201 ... 201 ... 200 x ... 198 ... 202 r ... compile lm.syn l f/203 p --- Meta4 compiler-compiler --- xo li f/204 l me ... 204 x ps o pxm; o pg c o pe o xm; ... 205 gdeclare t/205 s x ... 206 gstatement t/206 s x ... 203 ... 207 r .syn compile .field value 0 type 3 ; .constant name 1 field 3 constant 2 undefined 0 availfields 5 ; .name number '0' id '0' savid '2' temp 'z' stack 'y' unstack '!' ; rvalue = idname &catname (':' idfield .cat ('m' id:value) / .emp ) /constsimp .cat('n/' unstack ' ') / '+' expression .cat('!') ; expression = term $( '+' term .out('!+') /'-' term .out('!-') ) ; term = factor $( '*' factor .out('!*') / '/''256' .out('hz') .out('!d') .out('zy') / '%256' .out('hy') .out('n/''256*') .out('!-') ) ; factor = '(' expression ')' / constsimp .out('n/' unstack 'y' ) / idname &catname (':' idfield .cat('m' id:value) / .emp ) .out('y') / '-' factor .out('!z') .out('n/''0y') .out('z-') ; catname = id:value =: stack .act('!l') ! acts as a one byte macro ; toplace = idname id =: savid (':' idfield .cat('i' id:value ) /.emp ) savid =: id &catname ; declare = '.field' $( idnew id =: savid constexp &checkfrange number =: savid:value field =: savid:type ) ';' / '.name' $( idnew id=:savid constexp unstack =: savid:value name =: savid:type ) ';' / '.constant' $( idnew id =: savid constexp constant =: savid:type unstack =: savid:value ) ';' ; constexp = constterm $( '+' constterm .act('!+') / '-' constterm .act('!-') ) ; constterm = constfac $( '*' constfac .act('!*') ) ; constsimp = .num number =: stack / idcons id:value =: stack / .str "'" .act('n/0sy') ! value is first character / '.x' .hexnum ]number ; constfac = constsimp / '-' constfac .act('!z' 'n/0y' 'z-') / '(' constexp ')' ; idtype = .act ('li' ! is it an id ?? 'f/' *1 ! no, return 'me' ! define or find '0m3y' 'z=' ! id.type == temp 'l' 'r' ! take and return '.' *1 ! noe accept or rewind input 'l' 'z9' ) ; idname = .prep name =: temp idtype ; idfield = .prep field =: temp idtype ; idcons = .prep constant =: temp idtype ; idnew = .prep undefined =: temp idtype ; checkfrange = .if (number <= availfields) .return .else .erms( number ' is too big for a field' ) .end ; aout = '*1' .out('u') / '*2' .out('v') / '*' .out('c') / (.str "'" /.str'"') .out('p' *) / rvalue .out('c') / '.h' rvalue .out('h') / '.' .out('xn') ; notsyn = ( '.out' '(' $ aout ')' / '.lab' .out('p... ') aout ) .out('o') / '.act' '(' $( (.str "'" / .str '"') .act('c') ('*1' .act('u') / '*2' .act('v') / .emp) .act('o') / .str '!' ) ')' / ']' rvalue .out('y') / rvalue '=:' toplace .out() / '.if' '(' cexp ')' .out('f/' *1) $ notsyn ('.else' .out('j/' *2) .lab*1 .out('s') $ notsyn '.end' .lab*2 / '.end' .lab*1 .out('s') ) / '.cat' '(' $aout ')' / '.condlab' ('*1' .out('uy') .out('0=') .out('t/' *1) .out('p... ') .out('u') /'*2' .out('vy') .out('0=') .out('t/' *1) .out('p... ') .out('v') ) .out('o') .out('s') ! ! ! note side effect ! ! ! .lab *1 / errormessage / '.error' .out('sf') / '.succeed' .out('s') / '.fail' .out('sf') / '&' idnew .out('g' *) / '.return' .out('r') / .str '!' ; cright = '==' .out('y') rvalue .out('=') / '!=' .out('y') rvalue .out('=') .out('sc') / '<=' .out('y') rvalue .out('<') .out('sc') / '>=' .out('y') rvalue .out('>') .out('sc') / '<' .out('y') rvalue .out('>') / '>' .out('y') rvalue .out('<') ; cterm = cfac $( '.andif' .out('f/' *2) cfac) .condlab *2 ; cfac = rvalue cright / '.not' cfac .out('sc') / '(' cexp ')' / '&' idnew .out('g' *) ; cexp = cterm $( '.orif' .out('t/' *1) cterm) .condlab *1 ; errormessage = '.erms' '(' .out('t/' *1) $aout ')' .out('xo') .lab *1 ; syn = ( idnew .out('g' *) / ( .str "'" / .str '"' ) .out('lm' *) .out('l') / '.id' .out('li') .out('f/' *1) .out('l') .out('me') .lab *1 / '.num' .out('ln') .out('l') / '.str' (.str "'" / .str '"') .out('lq' *) .out('l') / '.emp' .out('s') / '$' .lab *1 syn .out('t/' *1) .out('s') / '(' phrase ')' / '.hexnum' .out('lh') .out('l') ) (errormessage / .emp) ; seq = syn .out('f/' *1) $( syn .out('x') / notsyn ) .lab *1 ; alts = seq $( '/' .out('t/' *1) seq ) .condlab *1 ; phrase = '.prep' $notsyn alts / alts / notsyn $notsyn ; statement = .id .lab * '=' phrase ';' .out('r') (.str '!' / .emp ) ; compile = '.syn' .act('p --- Meta4 compiler-compiler ---' 'xo') .id .out('s') .out('xm;') .out('g' *) .out('e') .act('xm;') $ declare $ statement ;  NOTE ON VERSION 1.2AX OF META4 ------------------------------ The version of Meta4 that is used on this disk is version 1.0. It is compatible with the PIDGIN source code given by W. A. Gale. A so-called "slightly optimized" version, known as version 1.2AX, is contained on SIG/M disk 159. (But the source and object code on that disk do not match, so even that is a bit confusing.) The main difference is that version 1.2AX keeps track of whether an identifier has been used or not, and what it was used for. Because of this, a ".function" declaration must be included at the beginning of the Meta4 language source file, listing the identifiers that appear on the right side of an "=" sign before they are defined by being used as the left side of one. The two versions are *not* compatible in the code that they will accept. Therefore I use different extensions (filetypes) for such source code, following A. L. Bender. Source code for Meta4 ver. 1.0 is called *.MET. Source code for Meta4 ver. 1.2AX is called *.MT4. All source code on this disk is for ver. 1.0. However, a few files for ver. 1.2AX are also included. META412.M4 is the analog of META4.M4. The file-driven editor SSED can be found, for example, on SIG/M disk 68. Use it to produce META412.MT4 (the analog of META4.MET) and VAL-M80.MT4 (the analog of VAL-M80.MET) like this: B>SSED META4.MET META412.MT4 B>SSED VAL-M80.MET VAL-M80.MT4 If you try B>M4 META412 META412.MT4 META4XX.M4 then the object file META4XX.M4 produced should be an exact copy of META412.M4. Checking this with DIF (also from SIG/M disk 68) is a good way to be confident that you have a working system. Another example. This: B>M4 META412 VAL-M80.MT4 VAL-M80.M4 should produce the *same* object file VAL-M80.M4 as this: B>M4 META4 VAL-M80.MET VAL-M80.M4 (I am inclined to think that version 1.2AX is a better system to use, but I have not used it here in order to retain compatibility with previous versions.) G. A. Edgar October 21, 1984 s xm; gcompile e ... rvalue gidname f/1 gcatname lm: l f/2 gidfield x pm 0m0c ... 2 t/3 s f/4 ... 4 ... 3 x ... 1 t/5 gconstsimp f/6 pn/ !c p ... 6 t/5 lm+ l f/7 gexpression x p! ... 7 ... 5 r ... expression gterm f/8 ... 9 lm+ l f/10 gterm x p!+ o ... 10 t/11 lm- l f/12 gterm x p!- o ... 12 ... 11 t/9 s x ... 8 ... 13 r ... term gfactor f/14 ... 15 lm* l f/16 gfactor x p!* o ... 16 t/17 lm/ l f/18 lm256 l x phz o p!d o pzy o ... 18 t/17 lm%256 l f/19 phy o pn/ p256* o p!- o ... 19 ... 17 t/15 s x ... 14 ... 20 r ... factor lm( l f/21 gexpression x lm) l x ... 21 t/22 gconstsimp f/23 pn/ !c py o ... 23 t/22 gidname f/24 gcatname lm: l f/25 gidfield x pm 0m0c ... 25 t/26 s f/27 ... 27 ... 26 x py o ... 24 t/22 lm- l f/28 gfactor x p!z o pn/ p0y o pz- o ... 28 ... 22 r ... catname 0m0y !l r ... toplace gidname f/29 02 lm: l f/30 gidfield x pi 0m0c ... 30 t/31 s f/32 ... 32 ... 31 x 20 gcatname ... 29 ... 33 r ... declare lm.field l f/34 ... 35 gidnew f/36 02 gconstexp x gcheckfrange 0i02 n/3 i32 ... 36 ... 37 t/35 s x lm; l x ... 34 t/38 lm.name l f/39 ... 40 gidnew f/41 02 gconstexp x !i02 n/1 i32 ... 41 ... 42 t/40 s x lm; l x ... 39 t/38 lm.constant l f/43 ... 44 gidnew f/45 02 gconstexp x n/2 i32 !i02 ... 45 ... 46 t/44 s x lm; l x ... 43 t/38 lm.function l f/47 ... 48 gidnew f/49 n/4 i30 ... 49 ... 50 t/48 s x lm; l x ... 47 ... 38 r ... constexp gconstterm f/51 ... 52 lm+ l f/53 gconstterm x !+ ... 53 t/54 lm- l f/55 gconstterm x !- ... 55 ... 54 t/52 s x ... 51 ... 56 r ... constterm gconstfac f/57 ... 58 lm* l f/59 gconstfac x !* ... 59 ... 60 t/58 s x ... 57 ... 61 r ... constsimp ln l f/62 0y ... 62 t/63 gidcons f/64 0m0y ... 64 t/63 lq' l f/65 n/0sy ... 65 t/63 lm.x l f/66 lh l x 0y ... 66 ... 63 r ... constfac gconstsimp f/67 ... 67 t/68 lm- l f/69 gconstfac x !z n/0y z- ... 69 t/68 lm( l f/70 gconstexp x lm) l x ... 70 ... 68 r ... idtype li f/71 me 0m3y z= l r .71 l z9 r ... idname n/1 z gidtype f/72 ... 72 ... 73 r ... idfield n/3 z gidtype f/74 ... 74 ... 75 r ... idfunc n/4 z gidtype f/76 ... 76 ... 77 r ... idcons n/2 z gidtype f/78 ... 78 ... 79 r ... idnew n/0 z gidtype f/80 ... 80 ... 81 r ... checkfrange 0y n/5 < sc ... 82 ... 83 f/84 r j/85 ... 84 s t/86 0c p is too big for a field xo ... 86 ... 85 r ... aout lm*1 l f/87 pu o ... 87 t/88 lm*2 l f/89 pv o ... 89 t/88 lm* l f/90 pc o ... 90 t/88 lq' l f/91 ... 91 t/92 lq" l f/93 ... 93 ... 92 f/94 pp c o ... 94 t/88 grvalue f/95 pc o ... 95 t/88 lm.h l f/96 grvalue x ph o ... 96 t/88 lm. l f/97 pxn o ... 97 ... 88 r ... notsyn lm.out l f/98 lm( l x ... 99 gaout t/99 s x lm) l x ... 98 t/100 lm.lab l f/101 pp... o gaout x ... 101 ... 100 f/102 po o ... 102 t/103 lm.act l f/104 lm( l x ... 105 lq' l f/106 ... 106 t/107 lq" l f/108 ... 108 ... 107 f/109 c lm*1 l f/110 u ... 110 t/111 lm*2 l f/112 v ... 112 t/111 s f/113 ... 113 ... 111 x o ... 109 t/114 lq! l f/115 ... 115 ... 114 t/105 s x lm) l x ... 104 t/103 lm] l f/116 grvalue x py o ... 116 t/103 grvalue f/117 lm=: l x gtoplace x o ... 117 t/103 lm.if l f/118 lm( l x gcexp x lm) l x pf/ u o ... 119 gnotsyn t/119 s x lm.else l f/120 pj/ v o p... u o ps o ... 121 gnotsyn t/121 s x lm.end l x p... v o ... 120 t/122 lm.end l f/123 p... u o ps o ... 123 ... 122 x ... 118 t/103 lm.cat l f/124 lm( l x ... 125 gaout t/125 s x lm) l x ... 124 t/103 lm.condlab l f/126 lm*1 l f/127 puy o p0= o pt/ u o pp... o pu o ... 127 t/128 lm*2 l f/129 pvy o p0= o pt/ u o pp... o pv o ... 129 ... 128 x po o ps o p... u o ... 126 t/103 gerrormessage f/130 ... 130 t/103 lm.error l f/131 psf o ... 131 t/103 lm.succeed l f/132 ps o ... 132 t/103 lm.fail l f/133 psf o ... 133 t/103 lm& l f/134 gidfunc x pg c o ... 134 t/103 lm.return l f/135 pr o ... 135 t/103 lq! l f/136 ... 136 t/103 lm.while l f/137 p... u o lm( l x gcexp x lm) l x pf/ v o ... 138 gnotsyn t/138 s x lm.endwhile l x pj/ u o p... v o ... 137 ... 103 r ... cright lm== l f/139 py o grvalue x p= o ... 139 t/140 lm!= l f/141 py o grvalue x p= o psc o ... 141 t/140 lm<= l f/142 py o grvalue x p< o psc o ... 142 t/140 lm>= l f/143 py o grvalue x p> o psc o ... 143 t/140 lm< l f/144 py o grvalue x p> o ... 144 t/140 lm> l f/145 py o grvalue x p< o ... 145 ... 140 r ... cterm gcfac f/146 ... 147 lm.andif l f/148 pf/ v o gcfac x ... 148 ... 149 t/147 s x vy 0= t/150 p... v o s ... 150 ... 146 ... 151 r ... cfac grvalue f/152 gcright x ... 152 t/153 lm.not l f/154 gcfac x psc o ... 154 t/153 lm( l f/155 gcexp x lm) l x ... 155 t/153 lm& l f/156 gidfunc x pg c o ... 156 ... 153 r ... cexp gcterm f/157 ... 158 lm.orif l f/159 pt/ u o gcterm x ... 159 ... 160 t/158 s x uy 0= t/161 p... u o s ... 161 ... 157 ... 162 r ... errormessage lm.erms l f/163 lm( l x pt/ u o ... 164 gaout t/164 s x lm) l x pxo o p... u o ... 163 ... 165 r ... syn gidfunc f/166 pg c o ... 166 t/167 lq' l f/168 ... 168 t/169 lq" l f/170 ... 170 ... 169 f/171 plm c o pl o ... 171 t/167 lm.id l f/172 pli o pf/ u o pl o pme o p... u o ... 172 t/167 lm.num l f/173 pln o pl o ... 173 t/167 lm.str l f/174 lq' l f/175 ... 175 t/176 lq" l f/177 ... 177 ... 176 x plq c o pl o ... 174 t/167 lm.emp l f/178 ps o ... 178 t/167 lm$ l f/179 p... u o gsyn x pt/ u o ps o ... 179 t/167 lm( l f/180 gphrase x lm) l x ... 180 t/167 lm.hexnum l f/181 plh o pl o ... 181 ... 167 f/182 gerrormessage f/183 ... 183 t/184 s f/185 ... 185 ... 184 x ... 182 ... 186 r ... seq gsyn f/187 pf/ u o ... 188 gsyn f/189 px o ... 189 t/190 gnotsyn f/191 ... 191 ... 190 t/188 s x p... u o ... 187 ... 192 r ... alts gseq f/193 ... 194 lm/ l f/195 pt/ u o gseq x ... 195 ... 196 t/194 s x uy 0= t/197 p... u o s ... 197 ... 193 ... 198 r ... phrase lm.prep l f/199 ... 200 gnotsyn t/200 s x galts x ... 199 t/201 galts f/202 ... 202 t/201 gnotsyn f/203 ... 204 gnotsyn t/204 s x ... 203 ... 201 r ... statement gidfunc f/205 ... 205 t/206 gidnew f/207 n/4 i30 ... 207 t/206 li f/208 l me ... 208 f/209 sf t/210 c p illegal statement name xo ... 210 ... 209 t/206 s f/211 sf t/212 xn p last line xo ... 212 ... 211 ... 206 f/213 p... c o lm= l x gphrase x lm; l x pr o lq! l f/214 ... 214 t/215 s f/216 ... 216 ... 215 x ... 213 ... 217 r ... compile lm.syn l f/218 p -- Meta4 (1.2AX) translates p Meta4 to M4 -- xo li f/219 l me ... 219 x ps o pxm; o pg c o pe o xm; ... 220 gdeclare t/220 s x ... 221 gstatement t/221 s x ... 218 ... 222 r 3c 16154 .constant name 1 field 3 constant 2 func 4 undefined 0 . 8a 43177 .function idname expression term factor constsimp constexp constterm constfac idcons errormessage cfac cexp idnew catname idfield checkfrange phrase ; . 64a 1647 / '.function' $ (idnew func =: id:type) ';' . 93c 45764 '.' *1 ! now accept or rewind input . 102a 46400 idfunc = .prep func =: temp idtype ; . 162c 4704 / '&' idfunc .out('g' *) . 164a 65131 / '.while' .lab *1 '(' cexp ')' .out('f/' *2) $notsyn '.endwhile' .out('j/' *1) .lab *2 . 185c 26507 / '&' idfunc .out('g' *) . 194c 41905 syn = ( idfunc .out('g' *) . 218c 45824 statement = (idfunc / idnew func =: id:type / .id .error .erms(* ' illegal statement name') / .emp .fail .erms(. ' last line') ) .lab * '=' phrase ';' .out('r') (.str '!' / .emp ) . 227,230c 36612 .act('p -- Meta4 (1.2AX) translates') .act('p Meta4 to M4 --' 'xo') .id .out('s') .out('xm;') .out('g' *) .out('e') .act('xm;') $ declare $ statement ; . $a 36632 . stterm constfac idcons errormessage cfac cexp idnew catname idfield checkfrange phrase ; Multiplication for VALGOL I compiler PUBLIC ?MULT ?MULT: LD B,H LD C,L XOR A LD H,A LD L,A LD A,16 MULT1: PUSH AF ADD HL,HL XOR A LD A,C RLA LD C,A LD A,B RLA LD B,A JP NC,MULT2 ADD HL,DE MULT2: POP AF DEC A OR A JP NZ,MULT1 RET END ; PRINT for VALGOL I compiler CR EQU 13 LF EQU 10 PUBLIC ?PRINT ?PRINT: LD A,CR CALL ?CPMOUT## LD A,LF CALL ?CPMOUT## RET END .syn program .name number '0' ; primary = .id .out(' LHLD V' * ) / .num .out(' LXI H,' number) / '(' exp ')' ; term = primary $( '*' .out(' PUSH H') primary .out(' POP D') .out(' CALL VMULT') ) ; exp1 = term $( '+' .out(' PUSH H') term .out(' POP D') .out(' DAD D') / '-' .out(' PUSH H') term .out(' POP D') .out(' MOV A,E') .out(' SUB L') .out(' MOV L,A') .out(' MOV A,D') .out(' SBB H') .out(' MOV H,A') ) ; exp = exp1 ( '.=' .out(' PUSH H') exp1 .out(' POP D') .out(' MOV A,L') .out(' SUB E') .out(' JNZ V' *2) .out(' MOV A,H') .out(' SBB D') .out(' JNZ V' *2) .out(' LXI H,1') .out(' JMP V' *1) .out('V' *2 ':') .out(' LXI H,0') .out('V' *1 ':') / .emp ) ; assignst = exp '=:' .id .out(' SHLD V' * ) ; untilst = '.until' .out('V' *1 ':') exp '.do' .out(' MOV A,H') .out(' ORA L') .out(' JNZ V' *2) st .out(' JMP V' *1) .out('V' *2 ':') ; conditionalst = '.if' exp '.then' .out(' MOV A,H') .out(' ORA L') .out(' JZ V' *1) st '.else' .out(' JMP V' *2) .out('V' *1 ':') st .out('V' *2 ':') ; iost = 'edit' '(' exp ',' .str "'" .out(' CALL VEDIT') .out(" DB '" * "',0") ')' / 'print' .out(' CALL VPRINT') ; idseq1 = .id .out('V' * ': DW 0') ; idseq = idseq1 $( ',' idseq1) ; dec = '.integer' .out(' JMP V' *1) idseq .out('V' *1 ':') ; block = '.begin' ( ( dec / st ) $( ';' st ) / .emp ) '.end' ; st = iost / assignst / untilst / conditionalst / block ; program = '.begin' .act('pVALGOL 1 compiler ') .act('pTranslates VALGOL to ASM' 'xo') .out('VBDOS EQU 5') .out('VTPA EQU 256') .out('VCR EQU 13') .out('VLF EQU 10') .out(' ORG VTPA') .out(' LXI SP,VSTACK') ( dec ';' / .emp ) st $( ';' st ) '.end' .out(' RET') .out('VMULT:') .out(' MOV B,H') .out(' MOV C,L') .out(' XRA A') .out(' MOV H,A') .out(' MOV L,A') .out(' MVI A,16') .out('VMULT1: PUSH PSW') .out(' DAD H') .out(' XRA A') .out(' MOV A,C') .out(' RAL') .out(' MOV C,A') .out(' MOV A,B') .out(' RAL') .out(' MOV B,A') .out(' JNC VMULT2') .out(' DAD D') .out('VMULT2: POP PSW') .out(' DCR A') .out(' ORA A') .out(' JNZ VMULT1') .out(' RET') .out('VEDIT:') .out('VEDIT0: MOV A,H') .out(' ORA L') .out(' JZ VEDIT1') .out(" MVI A,' '") .out(' CALL VCPMOUT') .out(' DCX H') .out(' JMP VEDIT0') .out('VEDIT1: POP H') .out('VEDIT2: MOV A,M') .out(' CPI 0') .out(' INX H') .out(' JZ VEDIT3') .out(' CALL VCPMOUT') .out(' JMP VEDIT2') .out('VEDIT3: PUSH H') .out(' RET') .out('VPRINT:') .out(' MVI A,VCR') .out(' CALL VCPMOUT') .out(' MVI A,VLF') .out(' CALL VCPMOUT') .out(' RET') .out('VCPMOUT:') .out(' PUSH H') .out(' MOV E,A') .out(' MVI C,2') .out(' CALL VBDOS') .out(' POP H') .out(' RET') .out(' DS 60') .out('VSTACK: DW 0') .out(' END') ; 2a 47401 .function exp st ; . $a 17448 . DM`iO?fD`i DMgDFD͜=!9N#F!!9s#r`i~D! ^!͋.syn program .name number '0' ; primary = .id .out( ' LD HL,(.' * ')') / .num .out( ' LD HL,' number) / '(' exp .erms('Bad expression') ')' .erms('Missing ")" or bad expr') ; term = primary $( '*' .out( ' PUSH HL') primary .erms('Dangling "*"') .out( ' POP DE') .out( ' CALL ?MULT##') ) ; exp1 = term $( '+' .out( ' PUSH HL') term .erms('Dangling "+"') .out( ' POP DE') .out( ' ADD HL,DE') / '-' .out( ' PUSH HL') term .erms('Dangling "-"') .out( ' POP DE') .out( ' LD A,E') .out( ' SUB L') .out( ' LD L,A') .out( ' LD A,D') .out( ' SBC A,H') .out( ' LD H,A') ) ; exp = exp1 ( '.=' .out( ' PUSH HL') exp1 .erms('Bad expression') .out( ' POP DE') .out( ' LD A,L') .out( ' SUB E') .out( ' JP NZ,.' *2) .out( ' LD A,H') .out( ' SBC A,D') .out( ' JP NZ,.' *2) .out( ' LD HL,1') .out( ' JP .' *1) .out( '.' *2 ':') .out( ' LD HL,0') .out( '.' *1 ':') / .emp ) ; assignst = exp '=:' .erms('Bad expr: "=:" not found') .id .erms('Var not on right-hand side') .out( ' LD (.' * '),HL') ; untilst = '.until' .out( '.' *1 ':') exp .erms('Bad ".until" condition') '.do' .erms('Missing ".do"') .out( ' LD A,H') .out( ' OR L') .out( ' JP NZ,.' *2) st .erms('Bad do-clause') .out( ' JP .' *1) .out( '.' *2 ':') ; conditionalst = '.if' exp .erms('Bad ".if" condition') '.then' .erms('Missing ".then"') .out( ' LD A,H') .out( ' OR L') .out( ' JP Z,.' *1) st .erms('Bad then-clause') '.else' .erms('Missing ".else"') .out( ' JP .' *2) .out( '.' *1 ':') st .erms('Bad else-clause') .out( '.' *2 ':') ; iost = 'edit' '(' .erms('Expected "("') exp .erms('Bad expression in "edit"') ',' .erms('Missing comma or bad expr') .str "'" .erms('Requires single-quote string') .out( ' CALL ?EDIT##') .out( " DB '" * "',0") ')' .erms('Bad "edit" syntax') / 'print' .out( ' CALL ?PRINT##') ; idseq1 = .id .out( '.' * ': DW 0') ; idseq = idseq1 $( ',' idseq1 .erms('Dangling comma in declaration') ) ; dec = '.integer' .out( ' DSEG') idseq .erms('Bad declaration syntax') .out( ' CSEG') ; block = '.begin' ( ( dec / st ) $( ';' st .erms('Dangling semicolon') ) / .emp ) '.end' ; st = iost / assignst / untilst / conditionalst / block ; program = .emp .act('pVALGOL 1 compiler ver. 1.2 (') .act('pTranslates VALGOL to Z80)' 'xo') '.begin' .erms('Must start with ".begin"') .out( ' .Z80') .out( '?CPM EQU 0') .out( ' DSEG') .out( ' DS 60') .out( '?STACK: DW 0') .out( ' CSEG') .out( '?START:') .out( ' LD SP,?STACK') ( dec ';' .erms('Missing semicolon') / .emp ) st .erms('No statement recognized') $( ';' st .erms('Dangling semicolon') ) '.end' .erms('Missing ".end" in line ' . ) .out( ' JP ?CPM') .out( ' END ?START') ;  VALGOL I INFORMATION -------------------- G. A. Edgar This file contains a description of the language VALGOL I, a (very) small derivative of ALGOL-60. It is intended to be used to illustrate the Meta4 compiler-compiler. This language was published in a paper by D. V. Schorre in 1964 as a sample language for META II. His paper was reprinted in Dr. Dobb's Journal, April, 1980. First, we will go through a description of the language. Then we will take a sample file and see what is involved in getting it to run. ----------------------------------------------------------- VALGOL I is basically a subset of ALGOL-60. The main peculiarities are these: (1) The key words that are usually typeset in boldface are preceded by a period. ( .begin .end .if .then .else .until .do .integer ) This also applies to the equal sign for comparing two expressions. ( .= ) (2) There is only one data type, namely .integer . This is a 16 bit two's-complement number in the compiler supplied. Thus you go from 0 up to 65535, and then back to 0. (3) The assignment statement is reverse from the normal order. ( 5 =: x assigns the value 5 to x ) (4) Arithmetic allows addition ( + ) subtraction ( - ) and multiplication ( * ) . There is no unary minus sign, so if you want -2 you can write either 0-2 or else 65534 (or, for that matter, 196606) . Let's walk through some of the syntax of the language. [This is to help you understand the Meta4 language source file V1ASM.MET . Comments concerning it are put in brackets like this. If you ignore the material in brackets, you will get a description of the syntax of VALGOL I only. It is probably necessary to read the file META4.DOC before this will make much sense to you. Start by looking at the first line of V1ASM.MET ( .syn program )] The overall syntax unit in VALGOL is the "program". [Now look down near the end of the file ( program = )] A program consists of the keyword ".begin", [When the ".begin" is matched, the compiler sends its sign-on to the console, and sends a few opening lines to its output file. I have put these actions on the right-hand side of the page to improve readablilty.] followed by an optional declaration, followed by one or more statements, separated by semicolons ( ; ) , followed by the keyword ".end". [Notice how alternatives are separated by slashes ( / ). The "dec" is made optional by putting in the alternative ".emp" or empty, which matches regardless of the input stream. But "dec" is first, so if there is one, it will be matched instead. The dollar sign ( $ ) indicates that the following may be repeated zero or more times. Now find "dec =" a few lines above in the file.] A declaration consists of the keyword ".integer" followed by a list of identifiers, separated by commas. [Can you figure this out for yourself? Now look at "st =".] A statement is one of the following: (1) an I/O statement. This is either of the form edit( expression , 'string') which will send (expression) spaces and then the (string) to the console, or of the form print which will send an end-of-line to the console. (2) an assignment statement, which has the form expression =: variable (3) a loop, of the form .until expression .do statement A value of 0 for the expression is considered false, and a nonzero value is true. (4) a conditional statement of the form .if expression .then statement .else statement The .else is not optional. (5) a block, which consists of the keyword ".begin", followed by an optional declaration, followed by zero or more statements, separated by semicolons, followed by the keyword ".end". Notice that the null statement in the form .begin .end is allowed. It is important that the semicolon is a statement separator, and not a statement terminator (as in some other languages, such as PL/I and C). You will get a syntax error message if you put a semicolon just before the ".end" in a block. A test for equality is allowed: 2 + x .= y * y This has value 1 if true and 0 if false. Expressions can be built up from variables, numbers, the operations + , - , *, and parentheses "(" , ")". [Notice how the syntax is arranged to take into account the precedence of these operations.] See the sample program below to see how the parts all fit together. [And now, class, your homework assignment. You may have noticed how uninformative the syntax error messages provided for free by Meta4 are. Find out how the ".erms" error message facility of Meta4 works and use it to insert useful diagnostic messages in the file V1ASM.MET . Don't you like a message like "Missing semicolon near line 17" or ".if without .else in line 17" better than "Error at line num 17 symbol 3" ? For extra credit, figure out how ".prep" works in Meta4 -- I don't know the answer to that myself, yet.] The paper by Schorre also has an implementation of VALGOL II, a much fuller relative of ALGOL-60. It has arrays, procedures called recursively, and more control statements, for example. I think that it would be feasible to write such a compiler using Meta4. But not ASM. If I were going to do it (and I might some day, but not right away), I think I would have the compiler output code for M80, include macros for most of the work, and have a library of subroutines (like VMULT) that will be loaded by L80 only if they are called for by the program. (See the description of VAL-M80, below.) ------------------------------------------------------------ Now we will go through a compile and run of a VALGOL program. You will need a compiler (such as V1ASM.M4, which converts VALGOL to assembly language suitable for Digital Research's ASM). The description that follows shows how everything looks under CP/M-80. For other operating systems, you will have to make the appropriate changes. (To get "object code" V1ASM.M4 from the source code V1ASM.MET , do this: B>M4 META4 V1ASM.MET V1ASM.M4 see the file META4.DOC for more explanation on this point.) Let's use this sample program: .begin .integer x ; 0 =: x ; .until x .= 9 .do .begin edit ( x*x + 1 , '+' ) ; print ; x + 1 =: x .end .end Suppose it is in a file called P.VAL. We compile it: B>M4 V1ASM P.VAL P.ASM M4 interpreter ver. 1.0 Copyright (c) 1981 W.A. Gale 2117 command bytes; 66 number labels; 14 subroutines. VALGOL 1 compiler translates VALGOL to ASM 110 max memory used This creates an assembly language file called P.ASM. It begins like this: VBDOS EQU 5 VTPA EQU 256 VCR EQU 13 VLF EQU 10 ORG VTPA LXI SP,VSTACK JMP V1 Vx: DW 0 V1: LXI H,0 SHLD Vx V2: LHLD Vx PUSH H LXI H,9 ... and so on. Next, the program can be compiled and run as normal: B>ASM P.BBZ CP/M ASSEMBLER - VER 2.0 01E2 001H USE FACTOR END OF ASSEMBLY B>LOAD P FIRST ADDRESS 0100 LAST ADDRESS 01E1 BYTES READ 00A6 RECORDS WRITTEN 02 B>P + + + + + + + + + And there it is. ------------------------------------------------------------ The VALGOL I compiler VAL-M80.MET translates into Zilog mnemonics for M80. I have put the four subroutines into a relocatable library, VALLIB.REL. This is really a waste of time for such a small gain in space for the resulting *.COM files. But it is included as a model of what could be done for a larger language with an extensive run-time library. To compile the compiler, do this: B>M4 META4 VAL-M80.MET VAL-M80.M4 Then, to compile, assemble, and link a VALGOL I program, I use the following SUBMIT script. (It will substitute any name for $1 and then automatically complete the compilation. Notice that the supplied version of M4 will discontinue any SUBMIT in progress if it finds a syntax error.) ; Compile VALGOL I program $1.VAL M4 VAL-M80 $1.VAL $1.MAC M80 =$1 ERA $1.MAC L80 $1/N,$1,VALLIB/S,/E ERA $1.REL G. A. Edgar May 21, 1984 CompuServe [70715,1324] revised October 21, 1984 US STI@lMWR<瀹E/݅A1 ~8QU STDI@xeP t~l8͡ :dE1jzt$NTS c$I@,| fS62c! A5=V:S'SU c5Y@$_Pj 곀 :dE1jzt