Files
Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GTOKEN.PLM
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

116 lines
3.9 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

$title('TOKEN module for GENDEF')
token:
do;
$include (:f1:glit.plb)
declare
cr lit '0dh';
/* token tables given below are each addressed by tokadr(length), and
each start with the number of items in the table of that particular
length. the tables are in sorted order so that they could be searched
with a binary search algorithm (sequential is used at this time) */
declare
/* tokens are not listed for length 0,1 */
tok0 (*) byte data(0), tok1 (*) byte data(0),
/* single character tokens are given by their ascii representation */
tok2 (*) byte data
(0),
tok3 (*) byte data
(0),
tok4 (*) byte data
(0),
tok5 (*) byte data
(2,'DISKS','ENDEF'),
tok6 (*) byte data
(1,'MACLIB'),
tok7 (*) byte data
(1,'DISKDEF');
declare
/* index to base address of each table */
tokadr (*) address data
(.tok0,.tok1,.tok2,.tok3,.tok4,.tok5,.tok6,.tok7),
/* starting token number for each length */
tokbas (*) byte data
(0,0,token2,token3,token4,token5,token6,token7);
/* external declarations */
declare
nextc byte external, /* next char (lookahead) */
token byte external, /* current token */
continue byte external, /* true for long idents, strings */
acclen byte external, /* accumulator length */
accum(32) byte external; /* actual characters scanned */
gnt: procedure external;
/* produces token = tiden, tnumb, tstrng, or tspecl */
end gnt;
scan: procedure public;
/* scan produces the actual token number for each item returned by
gnt (get next token). in the case of identifiers and special chars,
the token tables are searched before returning the token number */
nextchar: procedure(lookchr) byte;
declare lookchr byte;
/* nextchar is used to look ahead for special two character
sequences. if 'lookchr' is found, then nextc is zeroed and true is
returned from the call */
declare tf byte;
if (tf := nextc = lookchr) then nextc = 0;
return tf;
end nextchar;
declare /* local variables for the token matching */
ta address, /* set to beginning of string of symbols */
tokstr based ta (tokenm) byte, /* string template at ta */
n byte, /* number of symbols remaining to scan in string */
i byte; /* index used while matching characters */
call gnt; /* sets external variables */
if token = tstrng or token = tnumb then return;
/* otherwise token = tspecl or token = tiden */
if token = tspecl then
do;
/* may be a comment */
if accum(0) = ';' then
do while accum(0) <> cr;
call gnt;
end;
token = accum(0);
return;
end;
if acclen > tokenm then
/* cannot be a reserved word */
return;
ta = tokadr(acclen); /* ta is set to the base string to match */
n = tokstr(0); /* n is the number of symbols in the string */
/* token must be set to tiden at this point */
token = tokbas(acclen); /* base token number */
do while n > 0; /* more match attempts */
n = n - 1; i = acclen;
do while i > 0 and accum(i-1) = tokstr(i);
/* one more character has been matched */
i = i - 1;
end;
if i = 0 then /* a complete match was found */
return;
/* current token does not match, try again */
token = token + 1; /* move to next token in sequence */
ta = ta + acclen; /* base address advanced to next item */
end;
/* cannot find the token, leave 'token' set to tiden */
token = tiden;
return;
end scan;
end;