home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / alexcoco / alexfram < prev    next >
Text File  |  1987-07-16  |  7KB  |  271 lines
  1. IMPLEMENTATION MODULE -->modulenamelex;
  2.  
  3. FROM Files IMPORT
  4.   ReadNBytes;
  5. FROM SYSTEM IMPORT
  6.   ADR;
  7. FROM FileIO IMPORT
  8.   con, WriteString;
  9.  
  10. CONST
  11.   buffersize = 2048;     (*input buffer size*)
  12.   idmax      = 4980;     (*max.length of identifier-list*)
  13.   htmax      =  599;     (*max.length of hash table*)
  14.   CR         =  15C;
  15.   LF         =  12C;
  16.   EF         =   4C;
  17.  
  18. -->declarations
  19. TYPE 
  20.   Buffer     = ARRAY[0..buffersize-1] OF CHAR;
  21.   Charset    = ARRAY[0..7] OF BITSET;
  22.   Class      = ARRAY[0..classes-1] OF RECORD
  23.     set: Charset;
  24.     END;
  25.   Starttable = ARRAY[0..127] OF CARDINAL;
  26.   
  27. VAR
  28.   ch:       CHAR;        (*current input character*)
  29.   col:      CARDINAL;    (*current input columns*)
  30.   state:    CARDINAL;    (*current state*)
  31.   apx:      CARDINAL;    (*length of appendix*)
  32.  
  33. VAR
  34.   class:    Class;       (*generated character classes*)
  35.   comstart: Charset;     (*set of comment start symbols*)
  36.   ignored:  Charset;     (*set of ignored characters in start state*)
  37.   starttab: Starttable;  (*start state for every character*)
  38.   attr:     CARDINAL;    (*attribute value*)
  39.   filled:   BOOLEAN;     (*TRUE if attr is filled*)
  40.   
  41. VAR 
  42.   inbuffer:  Buffer;
  43.   ip:        CARDINAL;   (*ptr to next character in input buffer*)
  44.   ipmax:     CARDINAL;   (*ptr to last character in input buffer*)
  45.  
  46. VAR
  47.   id:      ARRAY[0..idmax+20] OF CHAR;  (*identifiers*)
  48.   idact:   CARDINAL;                    (*last character IN id*)
  49.   idp:     CARDINAL;                    (*last character of new token*)
  50.   keys:    CARDINAL;                    (*position OF last keyword IN id*)
  51.   ht:      ARRAY[0..htmax] OF INTEGER;  (*hash table*)
  52.  
  53. VAR
  54.   oldch:   ARRAY[0..160] OF CHAR;       (*delayed input*)
  55.   oldcol:  ARRAY[0..160] OF CARDINAL;   (*columns of delayed input*)
  56.   oldip:   CARDINAL;                    (*length of delayed input*)
  57.   eols:    CARDINAL;                    (*nr.of EOLs in a comment*)
  58.   i:       CARDINAL;
  59.  
  60.  
  61. PROCEDURE Comment(): BOOLEAN;
  62. VAR 
  63.   level: CARDINAL;
  64.   och:   CHAR;
  65.   ocol:  CARDINAL;
  66.   
  67.   PROCEDURE RememberEols;
  68.   BEGIN
  69.     IF eols>0 THEN
  70.       IF ch<>LF THEN PushInput(ch); END;
  71.       WHILE eols>0 DO PushInput(LF); PushInput(CR); DEC(eols); END;
  72.       NextCh;
  73.       END;
  74.     END RememberEols;
  75.  
  76. BEGIN (*Comment*)
  77.   level:=1; eols:=0;
  78. -->comment
  79.   END Comment;
  80.  
  81.  
  82. PROCEDURE CutAppendix;
  83. BEGIN
  84.   PushInput(ch);
  85.   WHILE apx>0 DO
  86.     PushInput(id[idp]); DEC(idp); DEC(apx);
  87.     END;
  88.   NextCh;
  89.   END CutAppendix;
  90.  
  91.  
  92. PROCEDURE Element(x:CARDINAL; set:Charset): BOOLEAN;
  93. BEGIN RETURN (x MOD 16) IN set[x DIV 16]; END Element;
  94.  
  95.  
  96. PROCEDURE GetSy(VAR token:CARDINAL);
  97. VAR typ,column,spix: CARDINAL;
  98.  
  99.   PROCEDURE Error;
  100.   BEGIN typ:=errortoken; END Error;
  101.   
  102. BEGIN (*GetSy*)
  103.   IF filled  (*attribute available*) 
  104.     THEN token:=attr; filled:=FALSE;
  105.     ELSE
  106. -->GetSy1
  107.       column:=col; idp:=idact;
  108.       IF Element(ORD(ch),ignored)
  109.         THEN ShiftIgnore(starttab[ORD(ch)]);
  110.         ELSE Shift(starttab[ORD(ch)]);
  111.         END;
  112.       LOOP
  113.         CASE state OF
  114.           1:
  115. -->GetSy2
  116.         ELSE Error; NextCh; EXIT;
  117.           END; (*CASE*)
  118.         END; (*LOOP*)
  119.       token:=256*typ+column;
  120.     END;
  121.   END GetSy;
  122.   
  123.  
  124. PROCEDURE GetVal(spix:CARDINAL;VAR name:ARRAY OF CHAR;VAR l:CARDINAL);
  125. VAR i: CARDINAL;
  126. BEGIN
  127.   i:=spix; l:=0;
  128.   WHILE (id[i]<>0C) AND (l<=HIGH(name)) DO
  129.     name[l]:=id[i]; INC(i); INC(l);
  130.     END;
  131.   END GetVal;
  132.  
  133.  
  134. PROCEDURE Hash(VAR spix: CARDINAL);
  135. VAR
  136.   h,l: CARDINAL;
  137.   d: INTEGER;
  138.  
  139.   PROCEDURE Equal(x,y,l:CARDINAL):BOOLEAN;
  140.   VAR i: CARDINAL;
  141.   BEGIN
  142.     i:=0;
  143.     WHILE (i<l) AND (id[x+i]=id[y+i]) DO INC(i); END;
  144.     RETURN i=l;
  145.     END Equal;
  146.  
  147. BEGIN (*Hash*)
  148.   INC(idp); id[idp]:=0C;
  149.   l:=idp-idact; spix:=idact+1;
  150.   h:=(ORD(id[spix])*7 + ORD(id[spix+1]) + l) * 17 MOD htmax;
  151.   d:= -htmax;
  152.   LOOP
  153.     IF ht[h]=0 THEN                    (*new identifier*)
  154.       ht[h]:=spix; idact:=idp; 
  155.       EXIT;
  156.     ELSIF Equal(ht[h],spix,l) THEN     (*old identifier*)
  157.       spix:=ht[h]; EXIT;
  158.     ELSE                               (*collision*)
  159.       d:=d+2;
  160.       IF d=htmax THEN 
  161.         WriteString(con,"$--- Hash table full$"); HALT;
  162.         END;
  163.       h:=(h+CARDINAL(ABS(d))) MOD htmax;
  164.       END;
  165.     END;    (*LOOP*)
  166.   IF idp>idmax THEN 
  167.     WriteString(con,"$--- Name list full$"); HALT;
  168.     END;
  169.   END Hash;
  170.  
  171.  
  172. PROCEDURE InitClass(nr,x1,x2,x3,x4,x5,x6,x7,x8:CARDINAL);
  173. BEGIN
  174.   WITH class[nr] DO
  175.     set[0]:=BITSET(x1);   set[1]:=BITSET(x2);
  176.     set[2]:=BITSET(x3);   set[3]:=BITSET(x4);
  177.     set[4]:=BITSET(x5);   set[5]:=BITSET(x6);
  178.     set[6]:=BITSET(x7);   set[7]:=BITSET(x8);
  179.     END;
  180.   END InitClass;
  181.  
  182.  
  183. PROCEDURE InitIgnored(x1,x2,x3,x4,x5,x6,x7,x8:CARDINAL);
  184. BEGIN
  185.   ignored[0]:=BITSET(x1);   ignored[1]:=BITSET(x2);
  186.   ignored[2]:=BITSET(x3);   ignored[3]:=BITSET(x4);
  187.   ignored[4]:=BITSET(x5);   ignored[5]:=BITSET(x6);
  188.   ignored[6]:=BITSET(x7);   ignored[7]:=BITSET(x8);
  189.   END InitIgnored;
  190.  
  191.  
  192. PROCEDURE InitStartTab(base,x1,x2,x3,x4,x5,x6,x7,x8:CARDINAL);
  193. BEGIN
  194.   starttab[base]:=x1;     starttab[base+1]:=x2;
  195.   starttab[base+2]:=x3;   starttab[base+3]:=x4;
  196.   starttab[base+4]:=x5;   starttab[base+5]:=x6;
  197.   starttab[base+6]:=x7;   starttab[base+7]:=x8;
  198.   END InitStartTab;
  199.  
  200.  
  201. PROCEDURE Keyword(spix:CARDINAL; VAR keynr:CARDINAL): BOOLEAN;
  202. BEGIN
  203.   IF spix<=keys
  204.     THEN keynr:=ORD(id[spix-1]); RETURN TRUE;
  205.     ELSE RETURN FALSE;
  206.     END;
  207.   END Keyword;
  208.  
  209.  
  210. PROCEDURE NewKey(sy:CARDINAL; key:ARRAY OF CHAR);
  211. VAR i: CARDINAL;
  212. BEGIN
  213.   INC(idact); id[idact]:=CHR(sy); idp:=idact;
  214.   FOR i:=0 TO HIGH(key) DO INC(idp); id[idp]:=key[i]; END;
  215.   Hash(keys);   (*keys contains the last keyword spix at any time*)
  216.   END NewKey;
  217.  
  218.  
  219. PROCEDURE NextCh; (*return global variable ch*)
  220. BEGIN
  221.   IF oldip>0
  222.     THEN 
  223.       DEC(oldip); ch:=oldch[oldip]; col:=oldcol[oldip];
  224.     ELSE
  225.       IF ip>=ipmax THEN
  226.         ipmax := ReadNBytes(src,ADR(inbuffer),buffersize);
  227.         IF ipmax=0 THEN inbuffer[0]:=EF; END;
  228.         ip:=0;
  229.         END;
  230.       ch:=inbuffer[ip]; INC(ip);
  231.       IF ch=LF THEN col:=0; INC(eols); ELSE INC(col); END;
  232.     END;
  233.   END NextCh;
  234.  
  235.  
  236. PROCEDURE PushInput(ch:CHAR);
  237. BEGIN
  238.   oldch[oldip]:=ch; oldcol[oldip]:=col; INC(oldip);
  239.   END PushInput;
  240.  
  241.  
  242. PROCEDURE Shift(s:CARDINAL);
  243. BEGIN
  244.   INC(idp); id[idp]:=ch; apx:=0; NextCh;
  245.   state:=s;
  246.   END Shift;
  247.  
  248.  
  249. PROCEDURE ShiftIgnore(s:CARDINAL);
  250. BEGIN
  251.   apx:=0; NextCh;
  252.   state:=s;
  253.   END ShiftIgnore;
  254.  
  255.  
  256. PROCEDURE ShiftLA(s:CARDINAL);
  257. BEGIN
  258.   INC(idp); id[idp]:=ch; INC(apx); NextCh;
  259.   state:=s;
  260.   END ShiftLA;
  261.  
  262.  
  263. BEGIN (*Scanner*)
  264.   ip:=buffersize; ipmax:=ip; oldip:=0;        (*init input*)
  265.   col:=0; ch:=" "; eols:=0;
  266.   filled:=FALSE;
  267.   FOR i:=0 TO htmax-1 DO ht[i]:=0; END;       (*init name list*)
  268.   idact:=0;
  269. -->initializations
  270.   END -->modulenamelex.
  271.