--- /dev/null
+#
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define ARG1 0
+#define ARG2 EM_DSIZE
+#define IRES 2*EM_DSIZE
+
+; FIF is called with three parameters:
+; - address of integer part result (IRES)
+; - float two (ARG2)
+; - float one (ARG1)
+; and returns an EM_DSIZE-byte floating point number
+; Definition:
+; PROCEDURE FIF(ARG1, ARG2: LONGREAL; VAR IRES: LONGREAL) : LONGREAL;
+
+ exp $FIF
+ pro $FIF,0
+ lal 0
+ loi 2*EM_DSIZE
+ fif EM_DSIZE
+ lal IRES
+ loi EM_PSIZE
+ sti EM_DSIZE
+ ret EM_DSIZE
+ end ?
+
+#define FARG 0
+#define ERES EM_DSIZE
+
+; FEF is called with two parameters:
+; - address of base 2 exponent result (ERES)
+; - floating point number to be split (FARG)
+; and returns an EM_DSIZE-byte floating point number (the mantissa)
+; Definition:
+; PROCEDURE FEF(FARG: LONGREAL; VAR ERES: integer): LONGREAL;
+
+ exp $FEF
+ pro $FEF,0
+ lal FARG
+ loi EM_DSIZE
+ fef EM_DSIZE
+ lal ERES
+ loi EM_PSIZE
+ sti EM_WSIZE
+ ret EM_DSIZE
+ end ?
+
+#define TRAP 0
+
+; TRP is called with one parameter:
+; - trap number (TRAP)
+; Definition:
+; PROCEDURE TRP(trapno: INTEGER);
+
+ exp $TRP
+ pro $TRP, 0
+ lol TRAP
+ trp
+ ret 0
+ end ?
+#include <em_abs.h>
IMPLEMENTATION MODULE InOut ;
IMPORT Unix;
IMPORT Conversions;
+ IMPORT EM;
FROM TTY IMPORT isatty;
FROM SYSTEM IMPORT ADR;
CloseInput;
END;
MakeFileName("Name of input file: ", defext, namebuf);
+ IF NOT Done THEN RETURN; END;
IF (namebuf[1] = '-') AND (namebuf[2] = 0C) THEN
ELSE
WITH ibuf DO
CloseOutput;
END;
MakeFileName("Name of output file: ", defext, namebuf);
+ IF NOT Done THEN RETURN; END;
IF (namebuf[1] = '-') AND (namebuf[2] = 0C) THEN
ELSE
WITH obuf DO
PROCEDURE MakeFileName(prompt, defext : ARRAY OF CHAR;
VAR buf : ARRAY OF CHAR);
- VAR i, k : INTEGER;
+ VAR i : INTEGER;
j : CARDINAL;
ch: CHAR;
BEGIN
- FOR k := 1 TO 3 DO
- IF isatty(0) THEN
- XWriteString(prompt);
- END;
- XReadString(buf);
- i := 0;
- WHILE buf[i] # 0C DO i := i + 1 END;
- IF i # 0 THEN
- i := i - 1;
- IF buf[i] = '.' THEN
- FOR j := 0 TO HIGH(defext) DO
- i := i + 1;
- buf[i] := defext[j];
- END;
- buf[i+1] := 0C;
- END;
- RETURN;
+ Done := TRUE;
+ IF isatty(0) THEN
+ XWriteString(prompt);
+ END;
+ XReadString(buf);
+ i := 0;
+ WHILE buf[i] # 0C DO i := i + 1 END;
+ IF i # 0 THEN
+ i := i - 1;
+ IF buf[i] = '.' THEN
+ FOR j := 0 TO HIGH(defext) DO
+ i := i + 1;
+ buf[i] := defext[j];
+ END;
+ buf[i+1] := 0C;
END;
+ RETURN;
END;
- Error("no proper file name in three attempts. Giving up.");
+ Done := FALSE;
END MakeFileName;
- PROCEDURE Error(s: ARRAY OF CHAR);
- VAR Xch: ARRAY[1..1] OF CHAR;
- BEGIN
- XWriteString("Error: ");
- XWriteString(s);
- Xch[1] := 12C;
- XWriteString(Xch);
- Unix.exit(1);
- END Error;
-
PROCEDURE ReadInt(VAR integ : INTEGER);
CONST
SAFELIMITDIV10 = MAX(INTEGER) DIV 10;
SAFELIMITREM10 = MAX(INTEGER) MOD 10;
+ TYPE
+ itype = [0..31];
+ ibuf = ARRAY itype OF CHAR;
VAR
int : INTEGER;
- ch : CHAR;
neg : BOOLEAN;
safedigit: [0 .. 9];
chvalue: CARDINAL;
+ buf : ibuf;
+ index : itype;
BEGIN
- Read(ch);
- WHILE (ch = ' ') OR (ch = TAB) OR (ch = 12C) DO
- Read(ch)
- END;
- IF ch = '-' THEN
+ ReadString(buf);
+ IF NOT Done THEN
+ RETURN
+ END;
+ index := 0;
+ IF buf[index] = '-' THEN
neg := TRUE;
- Read(ch)
- ELSIF ch = '+' THEN
+ INC(index);
+ ELSIF buf[index] = '+' THEN
neg := FALSE;
- Read(ch)
+ INC(index);
ELSE
neg := FALSE
END;
safedigit := SAFELIMITREM10;
IF neg THEN safedigit := safedigit + 1 END;
int := 0;
- IF (ch >= '0') & (ch <= '9') THEN
- WHILE (ch >= '0') & (ch <= '9') DO
- chvalue := ORD(ch) - ORD('0');
- IF (int > SAFELIMITDIV10) OR
- ( (int = SAFELIMITDIV10) AND
- (chvalue > safedigit)) THEN
- Error("integer overflow");
- ELSE
- int := 10*int + VAL(INTEGER, chvalue);
- Read(ch)
- END;
- END;
- IF neg THEN
- integ := -int
- ELSE
- integ := int
- END;
- Done := TRUE;
- ELSE
- Done := FALSE
- END;
- UnRead(ch)
+ WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
+ chvalue := ORD(buf[index]) - ORD('0');
+ IF (int > SAFELIMITDIV10) OR
+ ( (int = SAFELIMITDIV10) AND
+ (chvalue > safedigit)) THEN
+ EM.TRP(EIOVFL);
+ ELSE
+ int := 10*int + VAL(INTEGER, chvalue);
+ INC(index)
+ END;
+ END;
+ IF neg THEN
+ integ := -int
+ ELSE
+ integ := int
+ END;
+ IF buf[index] > " " THEN
+ EM.TRP(66);
+ END;
+ Done := TRUE;
END ReadInt;
PROCEDURE ReadCard(VAR card : CARDINAL);
CONST
SAFELIMITDIV10 = MAX(CARDINAL) DIV 10;
SAFELIMITREM10 = MAX(CARDINAL) MOD 10;
+
+ TYPE
+ itype = [0..31];
+ ibuf = ARRAY itype OF CHAR;
VAR
int : CARDINAL;
- ch : CHAR;
+ index : itype;
+ buf : ibuf;
safedigit: [0 .. 9];
chvalue: CARDINAL;
BEGIN
- Read(ch);
- WHILE (ch = ' ') OR (ch = TAB) OR (ch = 12C) DO
- Read(ch)
- END;
-
+ ReadString(buf);
+ IF NOT Done THEN RETURN; END;
+ index := 0;
safedigit := SAFELIMITREM10;
int := 0;
- IF (ch >= '0') & (ch <= '9') THEN
- WHILE (ch >= '0') & (ch <= '9') DO
- chvalue := ORD(ch) - ORD('0');
- IF (int > SAFELIMITDIV10) OR
- ( (int = SAFELIMITDIV10) AND
- (chvalue > safedigit)) THEN
- Error("cardinal overflow");
- ELSE
- int := 10*int + chvalue;
- Read(ch)
- END;
- END;
- card := int;
- Done := TRUE;
- ELSE
- Done := FALSE
- END;
- UnRead(ch)
+ WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
+ chvalue := ORD(buf[index]) - ORD('0');
+ IF (int > SAFELIMITDIV10) OR
+ ( (int = SAFELIMITDIV10) AND
+ (chvalue > safedigit)) THEN
+ EM.TRP(EIOVFL);
+ ELSE
+ int := 10*int + chvalue;
+ INC(index);
+ END;
+ END;
+ IF buf[index] > " " THEN
+ EM.TRP(67);
+ END;
+ card := int;
+ Done := TRUE;
END ReadCard;
PROCEDURE ReadString(VAR s : ARRAY OF CHAR);
+ TYPE charset = SET OF CHAR;
VAR i : CARDINAL;
ch : CHAR;
i := 0;
REPEAT
Read(ch);
- UNTIL (ch # ' ') AND (ch # TAB);
+ UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C});
UnRead(ch);
REPEAT
Read(ch);
END;
INC(i);
UNTIL (NOT Done) OR (ch <= " ");
+ UnRead(ch);
END ReadString;
PROCEDURE XReadString(VAR s : ARRAY OF CHAR);
LOOP
i := Unix.read(0, ADR(ch), 1);
IF i < 0 THEN
- Error("failed read");
+ EXIT;
END;
IF ch <= " " THEN
s[j] := 0C;
--- /dev/null
+struct descr {
+ char *addr;
+ int low;
+ unsigned int highminlow;
+ unsigned int size;
+};
+
+static struct descr *descrs[10];
+static struct descr **ppdescr = descrs;
+
+char *
+_new_stackptr(pdescr, a)
+ register struct descr *pdescr;
+{
+ unsigned int size = (((pdescr->highminlow + 1) * pdescr->size +
+ (EM_WSIZE - 1)) & ~(EM_WSIZE - 1));
+
+ if (ppdescr >= &descrs[10]) {
+ /* to many nested traps + handlers ! */
+ TRP(65);
+ }
+ *ppdescr++ = pdescr;
+ if ((char *) &a - (char *) &size > 0) {
+ /* stack grows downwards */
+ return (char *) &a - size;
+ }
+ else return (char *) &a + size;
+}
+
+_copy_array(p, a)
+ register char *p;
+{
+ register char *q;
+ register unsigned int sz;
+ char dummy;
+
+ ppdescr--;
+ sz = (((*ppdescr)->highminlow + 1) * (*ppdescr)->size +
+ (EM_WSIZE -1)) & ~ (EM_WSIZE - 1);
+
+ if ((char *) &a - (char *) &dummy > 0) {
+ (*ppdescr)->addr = q = (char *) &a;
+ }
+ else (*ppdescr)->addr = q = (char *) &a - sz;
+
+ while (sz--) *q++ = *p++;
+}
public / ack.git / commitdiff