home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS - Coast to Coast
/
simteldosarchivecoasttocoast2.iso
/
calculat
/
pibcal11.zip
/
GETTOK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-03-08
|
22KB
|
556 lines
(*--------------------------------------------------------------------------*)
(* GetTok --- Get Token from Command Line *)
(*--------------------------------------------------------------------------*)
PROCEDURE GetTok( VAR Iline: AnyStr; VAR Ipos: INTEGER );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: GetTok *)
(* *)
(* Purpose: Extracts a token from the command line. *)
(* *)
(* Calling Sequence: *)
(* *)
(* GetTok( VAR Iline: AnyStr; VAR Ipos: INTEGER ); *)
(* *)
(* Iline --- command line *)
(* Ipos --- current position in command line *)
(* *)
(* Calls: *)
(* *)
(* Lookahead *)
(* CrackWord *)
(* CrackReal *)
(* SynErr *)
(* *)
(*--------------------------------------------------------------------------*)
(*--------------------------------------------------------------------------*)
(* CrackNum --- Get number from command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE CrackNum( b: INTEGER;
digset: CharSetTy;
VAR num: REAL;
VAR len: INTEGER );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: CrackNum *)
(* *)
(* Purpose: Extracts a number from the command line. *)
(* *)
(* Calling Sequence: *)
(* *)
(* CrackNum( b: INTEGER; *)
(* digset: CharSetTy; *)
(* VAR num: REAL ; *)
(* VAR len: INTEGER ); *)
(* *)
(* b --- base for number *)
(* digset --- set of legal characters for digits *)
(* num --- resultant number (REAL!) *)
(* len --- no. digits in number *)
(* *)
(* Calls: *)
(* *)
(* ORD *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
c: CHAR;
BEGIN (* CrackNum *)
num := 0.0;
len := 0;
WHILE Iline[Ipos] IN digset DO
BEGIN
c := Iline[Ipos];
num := b * num;
IF c IN ['0'..'9'] THEN
num := num + ORD(c) - ORD('0')
ELSE
num := num + ORD(c) - ORD('A') + 10;
len := len + 1;
Ipos := Ipos + 1;
END;
END (* CrackNum *);
(*--------------------------------------------------------------------------*)
(* CrackInt --- Get integer from command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE CrackInt( b: INTEGER;
digset: CharSetTy;
flagset: CharSetTy );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: CrackInt *)
(* *)
(* Purpose: Extracts an integer from the command line. *)
(* *)
(* Calling Sequence: *)
(* *)
(* CrackInt( b: INTEGER; *)
(* digset: CharSetTy; *)
(* flagset: CharSetTy; *)
(* *)
(* b --- base for number *)
(* digset --- set of legal characters for digits *)
(* flagset --- legal terminator for base *)
(* *)
(* Calls: *)
(* *)
(* CrackNum *)
(* SynErr *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
num: REAL;
len: INTEGER;
BEGIN (* CrackInt *)
CrackNum( b, digset, num, len );
IF len = 0 THEN SynErr
ELSE IF num > MaxLint THEN
Error('Number too big to be integer')
ELSE
BEGIN
IF Iline[Ipos] IN flagset THEN Ipos := Ipos + 1;
WITH constval DO
BEGIN
def := TRUE;
typ := INT;
i := TRUNC( num );
r := num;
END;
Token := constsy;
END;
END (* CrackInt *);
(*--------------------------------------------------------------------------*)
(* CrackDec --- Get decimal integer from command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE CrackDec;
BEGIN (* CrackDec *)
CrackInt( 10, ['0'..'9'], ['D'] );
END (* CrackDec *);
(*--------------------------------------------------------------------------*)
(* CrackOct --- Get octal integer from command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE CrackOct;
BEGIN (* CrackOct *)
CrackInt( 8, ['0'..'7'], ['B','O'] );
END (* CrackOct *);
(*--------------------------------------------------------------------------*)
(* CrackHex --- Get hex integer from command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE CrackHex;
BEGIN (* CrackHex *)
CrackInt( 16, ['0'..'9','A'..'F'], ['X'] );
END (* CrackHex *);
(*--------------------------------------------------------------------------*)
(* CrackReal --- Get real number from command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE CrackReal;
VAR
intpart: REAL;
intlen: INTEGER;
fracpart: REAL;
fraclen: INTEGER;
expon: REAL;
explen: INTEGER;
expsign: INTEGER;
LABEL 99;
BEGIN (* CrackReal *)
(* Get part up to '.' if any *)
CrackNum(10, ['0'..'9'], intpart, intlen);
(* Next char MUST be '.' *)
IF Iline[Ipos] <> '.' THEN
BEGIN
SynErr;
GOTO 99;
END;
(* Skip '.' *)
Ipos := Ipos + 1;
(* Get fractional part after '.' *)
CrackNum(10, ['0'..'9'], fracpart, fraclen);
(* If no digits found, error *)
IF ( intlen + fraclen ) = 0 THEN
BEGIN
SynErr;
GOTO 99;
END;
(* Look for E -- signals exponent *)
expon := 0;
expsign := +1;
IF Iline[Ipos] = 'E' THEN
BEGIN
(* Skip past E *)
Ipos := Ipos + 1;
(* Pick up sign of exponent *)
IF Iline[Ipos] IN ['+','-'] THEN
BEGIN
IF Iline[Ipos] = '-' THEN expsign := -1;
Ipos := Ipos + 1;
END;
(* Get numeric value of exponent *)
CrackNum(10, ['0'..'9'], expon, explen);
(* No digits -- syntax error *)
IF explen = 0 THEN
BEGIN
SynErr;
GOTO 99;
END;
END;
(* Compose real result from parts *)
WITH constval DO
BEGIN
def := TRUE;
typ := rea;
i := 0;
r := ( intpart + fracpart * poweri( 10.0, -fraclen ) ) *
poweri( 10.0, expsign * TRUNC( expon ) );
END;
Token := constsy;
99:
END (* CrackReal *);
(*--------------------------------------------------------------------------*)
(* CrackWord --- Get name from command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE CrackWord;
LABEL
1;
VAR
kw: Alfa;
i: INTEGER;
found: BOOLEAN;
BEGIN (* CrackWord *)
i := 0;
(* Pick up name as letters, digits *)
WHILE (i < 10 ) AND ( Iline[Ipos] IN ['A'..'Z','0'..'9'] ) DO
BEGIN
i := i + 1;
kw[i] := Iline[Ipos];
Ipos := Ipos + 1;
END;
(* Blank fill the keyword *)
FOR i := i + 1 TO 10 DO kw[i] := ' ';
found := FALSE;
i := 0;
(* See if token a built-in name *)
WHILE ( i < Maxtoknams ) AND ( NOT found ) DO
BEGIN
i := i + 1;
found := ( kw = toknams[i].name );
END;
(* If found, save type in Token and *)
(* exit *)
IF found THEN
BEGIN
Token := toknams[i].tok;
GOTO 1;
END;
i := 0;
(* Check user function names *)
WHILE ( i < Maxuserfuncs ) AND ( NOT found ) DO
BEGIN
i := i + 1;
found := kw = userfuncs[i].name
END;
(* If found, remember which function *)
(* it was in 'iuserfunc'. *)
IF found THEN
BEGIN
Token := userfuncsy;
iuserfunc := i;
GOTO 1;
END;
(* Now try single letter variable *)
(* If it is, save variable name in *)
(* 'varnam'. *)
IF ( kw[1] IN ['A'..'Z'] ) AND ( kw[2] = ' ' ) THEN
BEGIN
Token := varsy;
varnam := kw[1];
GOTO 1;
END;
i := 0;
(* Last, try standard function names *)
WHILE (i < Maxstdfuncs) AND NOT found DO
BEGIN
i := i + 1;
found := ( kw = stdfuncs[i].name );
END;
(* If found, remember which function *)
(* in 'istdfunc'. *)
IF found THEN
BEGIN
Token := stdfuncsy;
istdfunc := i;
GOTO 1;
END;
(* If none of the above, syntax error *)
SynErr;
1:
END (* CrackWord *);
(*--------------------------------------------------------------------------*)
(* Lookahead -- Look ahead in command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE Lookahead;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: Lookahead *)
(* *)
(* Purpose: Look ahead in command line *)
(* *)
(* Calling sequence: *)
(* *)
(* Lookahead; *)
(* *)
(* Calls: *)
(* *)
(* CrackReal *)
(* CrackWord *)
(* CrackOct *)
(* CrackDec *)
(* CrackHex *)
(* *)
(* Remarks: *)
(* *)
(* When the default base is hexadecimal many ambiguities can arise. *)
(* For example, the letters 'A' through 'F' could be either variable *)
(* names or hex constants. 'DEC' could be either a command or a *)
(* hex constant, and '32B' could be either the octal constant *)
(* (= 26 dec.) or the hex constant 32B. The rule is that ALL SUCH *)
(* AMBIGUITIES ARE RESOLVED IN FAVOR OF THE INTERPRETATION AS A HEX *)
(* CONSTANT. To override this rule a colon (:) may be used to *)
(* prefix the construct. For example, ':32B' always means the octal *)
(* constant 32 (=26 dec.), whatever the default base may be. *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
spanset: CharSetTy;
k: INTEGER;
b: basety;
lastchar: CHAR;
colon: BOOLEAN;
BEGIN (* Lookahead *)
(* See if colon found *)
colon := ( Iline[Ipos] = ':' );
(* Skip it if so *)
IF colon THEN Ipos := Ipos + 1;
spanset := [];
k := Ipos;
b := base;
(* Scan assuming constant. *)
(* 'b' is default base. *)
(* 'k' is temporary Ipos *)
(* 'lastchar' remembers last *)
(* character in constant. *)
WHILE Iline[k] IN ['A'..'Z','0'..'9'] DO
BEGIN
IF k > Ipos THEN spanset := spanset + [lastchar];
lastchar := Iline[k];
k := k + 1;
END;
(* Change base if last char was *)
(* B, O, X, or D *)
IF ( lastchar IN ['D','B','O','X'] ) AND ( ( base <> hex ) OR colon )
AND ( k > ( Ipos + 1 ) ) THEN
CASE lastchar OF
'D': b := dec;
'B', 'O': b := oct;
'X': b := hex
END
ELSE
spanset := spanset + [lastchar];
(* If '.' stopped scan, try getting *)
(* real number *)
IF Iline[k] = '.' THEN CrackReal
(* Else try integer of appropriate *)
(* base, if only digits/letters *)
ELSE IF ( b = dec ) AND ( spanset <= ['0'..'9'] ) THEN CrackDec
ELSE IF ( b = oct ) AND ( spanset <= ['0'..'7'] ) THEN CrackOct
ELSE IF ( b = hex ) AND ( spanset <= ['0'..'9','A'..'F'] ) AND
( NOT colon ) THEN CrackHex
(* Else must be name *)
ELSE CrackWord;
END (* Lookahead *);
(*--------------------------------------------------------------------------*)
BEGIN (* GetTok *)
(* Skip blanks *)
WHILE Iline[Ipos] = ' ' DO Ipos := Ipos + 1;
(* Take action on next character *)
CASE Iline[Ipos] OF
(* End of line marker encountered *)
COL: Token := eolsy;
(* Name OR Constant *)
'A','B','C','D','E','F','0','1','2','3','4','5','6','7','8','9',
':': Lookahead;
(* Name *)
'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
'W','X','Y','Z': CrackWord;
'+': Token := plussy;
'-': Token := minussy;
(* * = multiplication, *)
(* ** = exponentation *)
'*': BEGIN
IF Iline[ Ipos + 1 ] = '*' THEN
Token := exponsy
ELSE
Token := starsy;
IF Token = exponsy THEN Ipos := Ipos + 1;
END;
'/': Token := slashsy;
'(': Token := oparsy;
')': Token := cparsy;
'=': Token := equalssy;
',': Token := commasy;
'$': Token := dollarsy;
(* '.' is accumulator OR start of *)
(* real number if followed by digit *)
'.': IF Iline[ Ipos + 1 ] IN ['0'..'9'] THEN
CrackReal
ELSE
Token := periodsy;
ELSE
SynErr;
END;
(* Skip those chars not yet skipped *)
IF Token IN [plussy..periodsy] THEN Ipos := Ipos + 1;
END (* GETTOK *);
(*--------------------------------------------------------------------------*)
(* NextTok --- Advance to next token in command line *)
(*--------------------------------------------------------------------------*)
PROCEDURE NextTok;
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: NextTok *)
(* *)
(* Purpose: Advance to next token in command line *)
(* *)
(* Calling sequence: *)
(* *)
(* NextTok; *)
(* *)
(* Calls: GetTok *)
(* *)
(*--------------------------------------------------------------------------*)
BEGIN (* NextTok *)
GetTok( Iline , Ipos );
END (* NextTok *);
