Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/getrad.sim
There is 1 other file named getrad.sim in the archive. Click here to see a list.
! INTEGER PROCEDURE GETRADIX converts a text T containing
! an item in base BASE to the corresponding base-10 integer.
!
! If BASE <= 10 only the characters 012...(BASE-1) may be used.
! If BASE = 16 or -16 then the char:s 0..9 A..F may be used.
! For all other bases the sequence should be written:
! 01...9(10)(11)(12)....
! Note that texts containing illegal characters will
! always be (somehow) interpreted.
!
! C.f. TEXT PROCEDURE RADIX.
!
! Author: Mats Ohlin, FOA 1, Fack, S-104 50 STOCKHOLM, SWEDEN.
! Date: 76-12-10
;
OPTIONS(/E/C/-Q/-A/-I/-D);
EXTERNAL CHARACTER PROCEDURE fetchar;
EXTERNAL TEXT PROCEDURE from;
INTEGER PROCEDURE getradix(base,t);
INTEGER base; TEXT t;
IF t = "0" THEN error: getradix:= 0 ELSE
IF base > 1 OR base < -1 THEN
BEGIN INTEGER sum,b,i,flag; CHARACTER c;
BOOLEAN neg,signflag;
! Skip leading blanks and sign;
FOR c:= fetchar(t,1) WHILE c = ' ' OR c = '+'
OR c = '-' DO
BEGIN t:- from(t,2);
IF c = '-' OR c = '+' THEN
BEGIN neg:= c = '-';
IF signflag THEN GO TO error;
signflag:= TRUE;
END sign;
END c loop;
! Check first char;
IF (IF c = '(' OR Digit(c) THEN TRUE
ELSE 'A' <= c AND c <= 'F' AND (base = 16 OR
base = -16) ) THEN
BEGIN
! See how long the item is;
t.Setpos(1);
WHILE t.More DO
BEGIN c:= t.Getchar;
IF Digit(c) THEN !ok; ELSE
IF c = '(' THEN flag:= flag + 1 ELSE
IF c = ')' THEN flag:= flag - 1 ELSE
IF 'A' <= c AND c <= 'F' AND (base = 16 OR
base = -16) THEN ! OK; ELSE
GO TO endoft;
IF flag < 0 THEN GO TO endoft ELSE
IF flag > 1 THEN
BEGIN t.Setpos(t.Pos-2);
GO TO endoft END;
END more loop;
endoft: IF t.More THEN t:- t.Sub(1,t.Pos-1);
! Start summation;
b:= 1;
FOR i:= t.Length STEP -1 UNTIL 1 DO
BEGIN
c:= fetchar(t,i);
IF c NE ')' THEN
sum:= sum + b*(Rank(c)-(IF Letter(c) THEN 55
ELSE 48)) ELSE
BEGIN
i:= i - 2;
FOR c:= fetchar(t,i) WHILE c NE '(' AND i > 1
DO i:= i - 1;
IF i > 0 THEN sum:= sum + b*from(t,i+1).Getint;
END (..) ;
IF i > 1 THEN b:= b*base;
END i loop;
getradix:= sum*(IF neg THEN -1 ELSE 1)
END starts with ( or Digit
END getradix;