Index: trunk/minix/lib/ack/libm2/Arguments.c =================================================================== --- trunk/minix/lib/ack/libm2/Arguments.c (revision 9) +++ (revision ) @@ -1,73 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: Access to program arguments and environment - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Arguments.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -extern char **argv, ***_penviron; -extern int argc; -unsigned int _Arguments__Argc; - -static char * -findname(s1, s2) -register char *s1, *s2; -{ - - while (*s1 == *s2++) s1++; - if (*s1 == '\0' && *(s2-1) == '=') return s2; - return 0; -} - -static unsigned int -scopy(src, dst, max) - register char *src, *dst; - unsigned int max; -{ - register unsigned int i = 0; - - while (*src && i <= max) { - i++; - *dst++ = *src++; - } - if (i <= max) { - *dst = '\0'; - return i+1; - } - while (*src++) i++; - return i + 1; -} - -_Arguments_() -{ - _Arguments__Argc = argc; -} - -unsigned -_Arguments__Argv(n, argument, l, u, s) - unsigned int u; - char *argument; -{ - - if (n >= argc) return 0; - return scopy(argv[n], argument, u); -} - -unsigned -_Arguments__GetEnv(name, nn, nu, ns, value, l, u, s) - char *name, *value; - unsigned int nu, u; -{ - register char **p = *_penviron; - register char *v = 0; - - while (*p && !(v = findname(name, *p++))) { - /* nothing */ - } - if (!v) return 0; - return scopy(v, value, u); -} Index: trunk/minix/lib/ack/libm2/ArraySort.mod =================================================================== --- trunk/minix/lib/ack/libm2/ArraySort.mod (revision 9) +++ (revision ) @@ -1,155 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE ArraySort; -(* - Module: Array sorting module. - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/ArraySort.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - FROM SYSTEM IMPORT ADDRESS, BYTE; (* no generics in Modula-2, sorry *) - - TYPE BytePtr = POINTER TO BYTE; - - VAR compareproc: CompareProc; - - PROCEDURE Sort(base: ADDRESS; (* address of array *) - nel: CARDINAL; (* number of elements in array *) - size: CARDINAL; (* size of each element *) - compar: CompareProc); (* the comparison procedure *) - BEGIN - compareproc := compar; - qsort(base, base+(nel-1)*size, size); - END Sort; - - PROCEDURE qsort(a1, a2: ADDRESS; size: CARDINAL); - (* Implemented with quick-sort, with some extra's *) - VAR left, right, lefteq, righteq: ADDRESS; - cmp: CompareResult; - mainloop: BOOLEAN; - BEGIN - WHILE a2 > a1 DO - left := a1; - right := a2; - lefteq := a1 + size * (((a2 - a1) + size) DIV (2 * size)); - righteq := lefteq; - (* - Pick an element in the middle of the array. - We will collect the equals around it. - "lefteq" and "righteq" indicate the left and right - bounds of the equals respectively. - Smaller elements end up left of it, larger elements end - up right of it. - *) - LOOP - LOOP - IF left >= lefteq THEN EXIT END; - cmp := compareproc(left, lefteq); - IF cmp = greater THEN EXIT END; - IF cmp = less THEN - left := left + size; - ELSE - (* equal, so exchange with the element - to the left of the "equal"-interval. - *) - lefteq := lefteq - size; - exchange(left, lefteq, size); - END; - END; - mainloop := FALSE; - LOOP - IF right <= righteq THEN EXIT END; - cmp := compareproc(right, righteq); - IF cmp = less THEN - IF left < lefteq THEN - (* larger one at the left, - so exchange - *) - exchange(left,right,size); - left := left + size; - right := right - size; - mainloop := TRUE; - EXIT; - END; - (* - no more room at the left part, so we - move the "equal-interval" one place to the - right, and the smaller element to the - left of it. - This is best expressed as a three-way - exchange. - *) - righteq := righteq + size; - threewayexchange(left, righteq, right, - size); - lefteq := lefteq + size; - left := lefteq; - ELSIF cmp = equal THEN - (* equal, zo exchange with the element - to the right of the "equal" - interval - *) - righteq := righteq + size; - exchange(right, righteq, size); - ELSE - (* leave it where it is *) - right := right - size; - END; - END; - IF (NOT mainloop) THEN - IF left >= lefteq THEN - (* sort "smaller" part *) - qsort(a1, lefteq - size, size); - (* and now the "larger" part, saving a - procedure call, because of this big - WHILE loop - *) - a1 := righteq + size; - EXIT; (* from the LOOP *) - END; - (* larger element to the left, but no more room, - so move the "equal-interval" one place to the - left, and the larger element to the right - of it. - *) - lefteq := lefteq - size; - threewayexchange(right, lefteq, left, size); - righteq := righteq - size; - right := righteq; - END; - END; - END; - END qsort; - - PROCEDURE exchange(a,b: BytePtr; size : CARDINAL); - VAR c: BYTE; - BEGIN - WHILE size > 0 DO - DEC(size); - c := a^; - a^ := b^; - a := ADDRESS(a) + 1; - b^ := c; - b := ADDRESS(b) + 1; - END; - END exchange; - - PROCEDURE threewayexchange(p,q,r: BytePtr; size: CARDINAL); - VAR c: BYTE; - BEGIN - WHILE size > 0 DO - DEC(size); - c := p^; - p^ := r^; - p := ADDRESS(p) + 1; - r^ := q^; - r := ADDRESS(r) + 1; - q^ := c; - q := ADDRESS(q) + 1; - END; - END threewayexchange; - -END ArraySort. Index: trunk/minix/lib/ack/libm2/CSP.mod =================================================================== --- trunk/minix/lib/ack/libm2/CSP.mod (revision 9) +++ (revision ) @@ -1,347 +1,0 @@ -(*$R-*) -IMPLEMENTATION MODULE CSP; -(* - Module: Communicating Sequential Processes - From: "A Modula-2 Implementation of CSP", - M. Collado, R. Morales, J.J. Moreno, - SIGPlan Notices, Volume 22, Number 6, June 1987. - Some modifications by Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/CSP.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ - - See this article for an explanation of the use of this module. -*) - - FROM random IMPORT Uniform; - FROM SYSTEM IMPORT BYTE, ADDRESS, NEWPROCESS, TRANSFER; - FROM Storage IMPORT Allocate, Deallocate; - FROM Traps IMPORT Message; - - CONST WorkSpaceSize = 2000; - - TYPE ByteAddress = POINTER TO BYTE; - Channel = POINTER TO ChannelDescriptor; - ProcessType = POINTER TO ProcessDescriptor; - ProcessDescriptor = RECORD - next: ProcessType; - father: ProcessType; - cor: ADDRESS; - wsp: ADDRESS; - guardindex: INTEGER; - guardno: CARDINAL; - guardcount: CARDINAL; - opened: Channel; - sons: CARDINAL; - msgadr: ADDRESS; - msglen: CARDINAL; - END; - - Queue = RECORD - head, tail: ProcessType; - END; - - ChannelDescriptor = RECORD - senders: Queue; - owner: ProcessType; - guardindex: INTEGER; - next: Channel; - END; - - VAR cp: ProcessType; - free, ready: Queue; - -(* ------------ Private modules and procedures ------------- *) - - MODULE ProcessQueue; - - IMPORT ProcessType, Queue; - EXPORT Push, Pop, InitQueue, IsEmpty; - - PROCEDURE InitQueue(VAR q: Queue); - BEGIN - WITH q DO - head := NIL; - tail := NIL - END - END InitQueue; - - PROCEDURE Push(p: ProcessType; VAR q: Queue); - BEGIN - p^.next := NIL; - WITH q DO - IF head = NIL THEN - tail := p - ELSE - head^.next := p - END; - head := p - END - END Push; - - PROCEDURE Pop(VAR q: Queue; VAR p: ProcessType); - BEGIN - WITH q DO - p := tail; - IF p # NIL THEN - tail := tail^.next; - IF head = p THEN - head := NIL - END - END - END - END Pop; - - PROCEDURE IsEmpty(q: Queue): BOOLEAN; - BEGIN - RETURN q.head = NIL - END IsEmpty; - - END ProcessQueue; - - - PROCEDURE DoTransfer; - VAR aux: ProcessType; - BEGIN - aux := cp; - Pop(ready, cp); - IF cp = NIL THEN - HALT - ELSE - TRANSFER(aux^.cor, cp^.cor) - END - END DoTransfer; - - PROCEDURE OpenChannel(ch: Channel; n: INTEGER); - BEGIN - WITH ch^ DO - IF guardindex = 0 THEN - guardindex := n; - next := cp^.opened; - cp^.opened := ch - END - END - END OpenChannel; - - PROCEDURE CloseChannels(p: ProcessType); - BEGIN - WITH p^ DO - WHILE opened # NIL DO - opened^.guardindex := 0; - opened := opened^.next - END - END - END CloseChannels; - - PROCEDURE ThereAreOpenChannels(): BOOLEAN; - BEGIN - RETURN cp^.opened # NIL; - END ThereAreOpenChannels; - - PROCEDURE Sending(ch: Channel): BOOLEAN; - BEGIN - RETURN NOT IsEmpty(ch^.senders) - END Sending; - -(* -------------- Public Procedures ----------------- *) - - PROCEDURE COBEGIN; - (* Beginning of a COBEGIN .. COEND structure *) - BEGIN - END COBEGIN; - - PROCEDURE COEND; - (* End of a COBEGIN .. COEND structure *) - (* VAR aux: ProcessType; *) - BEGIN - IF cp^.sons > 0 THEN - DoTransfer - END - END COEND; - - PROCEDURE StartProcess(P: PROC); - (* Start an anonimous process that executes the procedure P *) - VAR newprocess: ProcessType; - BEGIN - Pop(free, newprocess); - IF newprocess = NIL THEN - Allocate(newprocess,SIZE(ProcessDescriptor)); - Allocate(newprocess^.wsp, WorkSpaceSize) - END; - WITH newprocess^ DO - father := cp; - sons := 0; - msglen := 0; - NEWPROCESS(P, wsp, WorkSpaceSize, cor) - END; - cp^.sons := cp^.sons + 1; - Push(newprocess, ready) - END StartProcess; - - PROCEDURE StopProcess; - (* Terminate a Process (itself) *) - VAR aux: ProcessType; - BEGIN - aux := cp^.father; - aux^.sons := aux^.sons - 1; - IF aux^.sons = 0 THEN - Push(aux, ready) - END; - aux := cp; - Push(aux, free); - Pop(ready, cp); - IF cp = NIL THEN - HALT - ELSE - TRANSFER(aux^.cor, cp^.cor) - END - END StopProcess; - - PROCEDURE InitChannel(VAR ch: Channel); - (* Initialize the channel ch *) - BEGIN - Allocate(ch, SIZE(ChannelDescriptor)); - WITH ch^ DO - InitQueue(senders); - owner := NIL; - next := NIL; - guardindex := 0 - END - END InitChannel; - - PROCEDURE GetChannel(ch: Channel); - (* Assign the channel ch to the process that gets it *) - BEGIN - WITH ch^ DO - IF owner # NIL THEN - Message("Channel already has an owner"); - HALT - END; - owner := cp - END - END GetChannel; - - PROCEDURE Send(data: ARRAY OF BYTE; VAR ch: Channel); - (* Send a message with the data to the cvhannel ch *) - VAR m: ByteAddress; - (* aux: ProcessType; *) - i: CARDINAL; - BEGIN - WITH ch^ DO - Push(cp, senders); - Allocate(cp^.msgadr, SIZE(data)); - m := cp^.msgadr; - cp^.msglen := HIGH(data); - FOR i := 0 TO HIGH(data) DO - m^ := data[i]; - m := ADDRESS(m) + 1 - END; - IF guardindex # 0 THEN - owner^.guardindex := guardindex; - CloseChannels(owner); - Push(owner, ready) - END - END; - DoTransfer - END Send; - - PROCEDURE Receive(VAR ch: Channel; VAR dest: ARRAY OF BYTE); - (* Receive a message from the channel ch into the dest variable *) - VAR aux: ProcessType; - m: ByteAddress; - i: CARDINAL; - BEGIN - WITH ch^ DO - IF cp # owner THEN - Message("Only owner of channel can receive from it"); - HALT - END; - IF Sending(ch) THEN - Pop(senders, aux); - m := aux^.msgadr; - FOR i := 0 TO aux^.msglen DO - dest[i] := m^; - m := ADDRESS(m) + 1 - END; - Push(aux, ready); - Push(cp, ready); - CloseChannels(cp) - ELSE - OpenChannel(ch, -1); - DoTransfer; - Pop(senders, aux); - m := aux^.msgadr; - FOR i := 0 TO aux^.msglen DO - dest[i] := m^; - m := ADDRESS(m) + 1 - END; - Push(cp, ready); - Push(aux, ready) - END; - Deallocate(aux^.msgadr, aux^.msglen+1); - DoTransfer - END - END Receive; - - PROCEDURE SELECT(n: CARDINAL); - (* Beginning of a SELECT structure with n guards *) - BEGIN - cp^.guardindex := Uniform(1,n); - cp^.guardno := n; - cp^.guardcount := n - END SELECT; - - PROCEDURE NEXTGUARD(): CARDINAL; - (* Returns an index to the next guard to be evaluated in a SELECT *) - BEGIN - RETURN cp^.guardindex - END NEXTGUARD; - - PROCEDURE GUARD(cond: BOOLEAN; ch: Channel; - VAR dest: ARRAY OF BYTE): BOOLEAN; - (* Evaluates a guard, including reception management *) - (* VAR aux: ProcessType; *) - BEGIN - IF NOT cond THEN - RETURN FALSE - ELSIF ch = NIL THEN - CloseChannels(cp); - cp^.guardindex := 0; - RETURN TRUE - ELSIF Sending(ch) THEN - Receive(ch, dest); - cp^.guardindex := 0; - RETURN TRUE - ELSE - OpenChannel(ch, cp^.guardindex); - RETURN FALSE - END - END GUARD; - - PROCEDURE ENDSELECT(): BOOLEAN; - (* End of a SELECT structure *) - BEGIN - WITH cp^ DO - IF guardindex <= 0 THEN - RETURN TRUE - END; - guardcount := guardcount - 1; - IF guardcount # 0 THEN - guardindex := (guardindex MOD INTEGER(guardno)) + 1 - ELSIF ThereAreOpenChannels() THEN - DoTransfer - ELSE - guardindex := 0 - END - END; - RETURN FALSE - END ENDSELECT; - -BEGIN - InitQueue(free); - InitQueue(ready); - Allocate(cp,SIZE(ProcessDescriptor)); - WITH cp^ DO - sons := 0; - father := NIL - END -END CSP. - Index: trunk/minix/lib/ack/libm2/Conversion.mod =================================================================== --- trunk/minix/lib/ack/libm2/Conversion.mod (revision 9) +++ (revision ) @@ -1,73 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Conversions; -(* - Module: numeric-to-string conversions - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Conversion.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - PROCEDURE ConvertNum(num, len, base: CARDINAL; - neg: BOOLEAN; - VAR str: ARRAY OF CHAR); - VAR i: CARDINAL; - r: CARDINAL; - tmp: ARRAY [0..20] OF CHAR; - BEGIN - i := 0; - REPEAT - r := num MOD base; - num := num DIV base; - IF r <= 9 THEN - tmp[i] := CHR(r + ORD('0')); - ELSE - tmp[i] := CHR(r - 10 + ORD('A')); - END; - INC(i); - UNTIL num = 0; - IF neg THEN - tmp[i] := '-'; - INC(i) - END; - IF len > HIGH(str) + 1 THEN len := HIGH(str) + 1; END; - IF i > HIGH(str) + 1 THEN i := HIGH(str) + 1; END; - r := 0; - WHILE len > i DO str[r] := ' '; INC(r); DEC(len); END; - WHILE i > 0 DO str[r] := tmp[i-1]; DEC(i); INC(r); END; - WHILE r <= HIGH(str) DO - str[r] := 0C; - INC(r); - END; - END ConvertNum; - - PROCEDURE ConvertOctal(num, len: CARDINAL; VAR str: ARRAY OF CHAR); - BEGIN - ConvertNum(num, len, 8, FALSE, str); - END ConvertOctal; - - PROCEDURE ConvertHex(num, len: CARDINAL; VAR str: ARRAY OF CHAR); - BEGIN - ConvertNum(num, len, 16, FALSE, str); - END ConvertHex; - - PROCEDURE ConvertCardinal(num, len: CARDINAL; VAR str: ARRAY OF CHAR); - BEGIN - ConvertNum(num, len, 10, FALSE, str); - END ConvertCardinal; - - PROCEDURE ConvertInteger(num: INTEGER; - len: CARDINAL; - VAR str: ARRAY OF CHAR); - BEGIN - IF (num < 0) AND (num >= -MAX(INTEGER)) THEN - ConvertNum(-num, len, 10, TRUE, str); - ELSE - ConvertNum(CARDINAL(num), len, 10, num < 0, str); - END; - END ConvertInteger; - -END Conversions. Index: trunk/minix/lib/ack/libm2/EM.e =================================================================== --- trunk/minix/lib/ack/libm2/EM.e (revision 9) +++ (revision ) @@ -1,100 +1,0 @@ -# -; -; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. -; See the copyright notice in the ACK home directory, in the file "Copyright". -; -; -; Module: Interface to some EM instructions and data -; Author: Ceriel J.H. Jacobs -; Version: $Header: /cvsup/minix/src/lib/ack/libm2/EM.e,v 1.1 2005/10/10 15:27:46 beng Exp $ -; - 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 ? - -#define PROC 0 - -; SIG is called with one parameter: -; - procedure instance identifier (PROC) -; and returns the old traphandler. - - exa handler - exp $SIG - pro $SIG, 0 - lae handler - loi _EM_PSIZE - lal PROC - loi _EM_PSIZE - lae handler - sti _EM_PSIZE - ret _EM_PSIZE - end ? - - exp $LINO - pro $LINO,0 - loe 0 - ret _EM_WSIZE - end ? - - exp $FILN - pro $FILN,0 - lae 4 - loi _EM_PSIZE - ret _EM_PSIZE - end ? Index: trunk/minix/lib/ack/libm2/InOut.mod =================================================================== --- trunk/minix/lib/ack/libm2/InOut.mod (revision 9) +++ (revision ) @@ -1,371 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE InOut ; -(* - Module: Wirth's Input/Output module - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/InOut.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - IMPORT Streams; - FROM Conversions IMPORT - ConvertCardinal, ConvertInteger, - ConvertOctal, ConvertHex; - FROM Traps IMPORT Message; - - CONST TAB = 11C; - - TYPE numbuf = ARRAY[0..255] OF CHAR; - - VAR unread: BOOLEAN; - unreadch: CHAR; - CurrIn, CurrOut: Streams.Stream; - result: Streams.StreamResult; - - PROCEDURE Read(VAR c : CHAR); - - BEGIN - IF unread THEN - unread := FALSE; - c := unreadch; - Done := TRUE; - ELSE - Streams.Read(CurrIn, c, result); - Done := result = Streams.succeeded; - END; - END Read; - - PROCEDURE UnRead(ch: CHAR); - BEGIN - unread := TRUE; - unreadch := ch; - END UnRead; - - PROCEDURE Write(c: CHAR); - BEGIN - Streams.Write(CurrOut, c, result); - END Write; - - PROCEDURE OpenInput(defext: ARRAY OF CHAR); - VAR namebuf : ARRAY [1..128] OF CHAR; - BEGIN - IF CurrIn # Streams.InputStream THEN - Streams.CloseStream(CurrIn, result); - END; - MakeFileName("Name of input file: ", defext, namebuf); - IF NOT Done THEN RETURN; END; - openinput(namebuf); - END OpenInput; - - PROCEDURE OpenInputFile(filename: ARRAY OF CHAR); - BEGIN - IF CurrIn # Streams.InputStream THEN - Streams.CloseStream(CurrIn, result); - END; - openinput(filename); - END OpenInputFile; - - PROCEDURE openinput(namebuf: ARRAY OF CHAR); - BEGIN - IF (namebuf[0] = '-') AND (namebuf[1] = 0C) THEN - CurrIn := Streams.InputStream; - Done := TRUE; - ELSE - Streams.OpenStream(CurrIn, namebuf, Streams.text, - Streams.reading, result); - Done := result = Streams.succeeded; - END; - END openinput; - - PROCEDURE CloseInput; - BEGIN - IF CurrIn # Streams.InputStream THEN - Streams.CloseStream(CurrIn, result); - END; - CurrIn := Streams.InputStream; - END CloseInput; - - PROCEDURE OpenOutput(defext: ARRAY OF CHAR); - VAR namebuf : ARRAY [1..128] OF CHAR; - BEGIN - IF CurrOut # Streams.OutputStream THEN - Streams.CloseStream(CurrOut, result); - END; - MakeFileName("Name of output file: ", defext, namebuf); - IF NOT Done THEN RETURN; END; - openoutput(namebuf); - END OpenOutput; - - PROCEDURE OpenOutputFile(filename: ARRAY OF CHAR); - BEGIN - IF CurrOut # Streams.OutputStream THEN - Streams.CloseStream(CurrOut, result); - END; - openoutput(filename); - END OpenOutputFile; - - PROCEDURE openoutput(namebuf: ARRAY OF CHAR); - BEGIN - IF (namebuf[1] = '-') AND (namebuf[2] = 0C) THEN - CurrOut := Streams.OutputStream; - Done := TRUE; - ELSE - Streams.OpenStream(CurrOut, namebuf, Streams.text, - Streams.writing, result); - Done := result = Streams.succeeded; - END; - END openoutput; - - PROCEDURE CloseOutput; - BEGIN - IF CurrOut # Streams.OutputStream THEN - Streams.CloseStream(CurrOut, result); - END; - CurrOut := Streams.OutputStream; - END CloseOutput; - - PROCEDURE MakeFileName(prompt, defext : ARRAY OF CHAR; - VAR buf : ARRAY OF CHAR); - VAR i : INTEGER; - j : CARDINAL; - BEGIN - Done := TRUE; - IF Streams.isatty(Streams.InputStream, result) 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; - Done := FALSE; - END MakeFileName; - - 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; - neg : BOOLEAN; - safedigit: [0 .. 9]; - chvalue: CARDINAL; - buf : ibuf; - index : itype; - BEGIN - ReadString(buf); - IF NOT Done THEN - RETURN - END; - index := 0; - IF buf[index] = '-' THEN - neg := TRUE; - INC(index); - ELSIF buf[index] = '+' THEN - neg := FALSE; - INC(index); - ELSE - neg := FALSE - END; - - safedigit := SAFELIMITREM10; - IF neg THEN safedigit := safedigit + 1 END; - int := 0; - WHILE (buf[index] >= '0') & (buf[index] <= '9') DO - chvalue := ORD(buf[index]) - ORD('0'); - IF (int > SAFELIMITDIV10) OR - ( (int = SAFELIMITDIV10) AND - (chvalue > safedigit)) THEN - Message("integer too large"); - HALT; - ELSE - int := 10*int + VAL(INTEGER, chvalue); - INC(index) - END; - END; - IF neg THEN - integ := -int - ELSE - integ := int - END; - IF buf[index] > " " THEN - Message("illegal integer"); - HALT; - 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; - index : itype; - buf : ibuf; - safedigit: [0 .. 9]; - chvalue: CARDINAL; - BEGIN - ReadString(buf); - IF NOT Done THEN RETURN; END; - index := 0; - safedigit := SAFELIMITREM10; - int := 0; - WHILE (buf[index] >= '0') & (buf[index] <= '9') DO - chvalue := ORD(buf[index]) - ORD('0'); - IF (int > SAFELIMITDIV10) OR - ( (int = SAFELIMITDIV10) AND - (chvalue > safedigit)) THEN - Message("cardinal too large"); - HALT; - ELSE - int := 10*int + chvalue; - INC(index); - END; - END; - IF buf[index] > " " THEN - Message("illegal cardinal"); - HALT; - END; - card := int; - Done := TRUE; - END ReadCard; - - PROCEDURE ReadString(VAR s : ARRAY OF CHAR); - TYPE charset = SET OF CHAR; - VAR i : CARDINAL; - ch : CHAR; - - BEGIN - i := 0; - REPEAT - Read(ch); - UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C}); - IF NOT Done THEN - RETURN; - END; - UnRead(ch); - REPEAT - Read(ch); - termCH := ch; - IF i <= HIGH(s) THEN - s[i] := ch; - IF (NOT Done) OR (ch <= " ") THEN - s[i] := 0C; - END; - END; - INC(i); - UNTIL (NOT Done) OR (ch <= " "); - IF Done THEN UnRead(ch); END; - END ReadString; - - PROCEDURE XReadString(VAR s : ARRAY OF CHAR); - VAR j : CARDINAL; - ch : CHAR; - - BEGIN - j := 0; - LOOP - Streams.Read(Streams.InputStream, ch, result); - IF result # Streams.succeeded THEN - EXIT; - END; - IF ch <= " " THEN - s[j] := 0C; - EXIT; - END; - IF j < HIGH(s) THEN - s[j] := ch; - INC(j); - END; - END; - END XReadString; - - PROCEDURE XWriteString(s: ARRAY OF CHAR); - VAR i: CARDINAL; - BEGIN - i := 0; - LOOP - IF (i <= HIGH(s)) AND (s[i] # 0C) THEN - Streams.Write(Streams.OutputStream, s[i], result); - INC(i); - ELSE - EXIT; - END; - END; - END XWriteString; - - PROCEDURE WriteCard(card, width : CARDINAL); - VAR - buf : numbuf; - BEGIN - ConvertCardinal(card, width, buf); - WriteString(buf); - END WriteCard; - - PROCEDURE WriteInt(int : INTEGER; width : CARDINAL); - VAR - buf : numbuf; - BEGIN - ConvertInteger(int, width, buf); - WriteString(buf); - END WriteInt; - - PROCEDURE WriteHex(card, width : CARDINAL); - VAR - buf : numbuf; - BEGIN - ConvertHex(card, width, buf); - WriteString(buf); - END WriteHex; - - PROCEDURE WriteLn; - BEGIN - Write(EOL) - END WriteLn; - - PROCEDURE WriteOct(card, width : CARDINAL); - VAR - buf : numbuf; - BEGIN - ConvertOctal(card, width, buf); - WriteString(buf); - END WriteOct; - - PROCEDURE WriteString(str : ARRAY OF CHAR); - VAR - nbytes : CARDINAL; - BEGIN - nbytes := 0; - WHILE (nbytes <= HIGH(str)) AND (str[nbytes] # 0C) DO - Write(str[nbytes]); - INC(nbytes) - END; - END WriteString; - -BEGIN (* InOut initialization *) - CurrIn := Streams.InputStream; - CurrOut := Streams.OutputStream; - unread := FALSE; -END InOut. Index: trunk/minix/lib/ack/libm2/LtoUset.e =================================================================== --- trunk/minix/lib/ack/libm2/LtoUset.e (revision 9) +++ (revision ) @@ -1,61 +1,0 @@ -# -; -; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. -; See the copyright notice in the ACK home directory, in the file "Copyright". -; -; -; Module: Compute non-constant set displays -; Author: Ceriel J.H. Jacobs -; Version: $Header: /cvsup/minix/src/lib/ack/libm2/LtoUset.e,v 1.1 2005/10/10 15:27:46 beng Exp $ -; - mes 2,_EM_WSIZE,_EM_PSIZE - - ; LtoUset is called for set displays containing { expr1 .. expr2 }. - ; It has six parameters, of which the caller must pop five: - ; - The set in which bits must be set. - ; - the lower bound of the set type. - ; - The set size in bytes. - ; - The upper bound of set elements, specified by the set-type. - ; - "expr2", the upper bound - ; - "expr1", the lower bound - -#define SETBASE 5*_EM_WSIZE -#define SETLOW 4*_EM_WSIZE -#define SETSIZE 3*_EM_WSIZE -#define USETSIZ 2*_EM_WSIZE -#define LWB _EM_WSIZE -#define UPB 0 - exp $LtoUset - pro $LtoUset,0 - lal SETBASE ; address of initial set - lol SETSIZE - los _EM_WSIZE ; load initial set - lol LWB ; low bound - lol SETLOW - sbu _EM_WSIZE - stl LWB - lol UPB ; high bound - lol SETLOW - sbu _EM_WSIZE - stl UPB -1 - lol LWB - lol UPB - cmu _EM_WSIZE - zgt *2 ; while low <= high - lol LWB - lol SETSIZE - set ? ; create [low] - lol SETSIZE - ior ? ; merge with initial set - lol LWB - loc 1 - adu _EM_WSIZE - stl LWB - bra *1 ; loop back -2 - lal SETBASE - lol SETSIZE - sts _EM_WSIZE ; store result over initial set - ret 0 - end 0 Index: trunk/minix/lib/ack/libm2/Makedepend-ack =================================================================== --- trunk/minix/lib/ack/libm2/Makedepend-ack (revision 9) +++ (revision ) @@ -1,50 +1,0 @@ -depend-ack: - rm .depend-ack - touch .depend-ack - mkdep 'cc -O -I../h -wo -E' Arguments.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' ArraySort.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' CSP.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Conversion.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' EM.e | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' InOut.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' LtoUset.e | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' MathLib0.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Mathlib.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' PascalIO.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Processes.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' RealConver.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' RealInOut.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' SYSTEM.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Semaphores.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Storage.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' StrAss.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Streams.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Strings.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Termcap.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Terminal.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' Traps.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' XXTermcap.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' absd.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' absf.e | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' absi.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' absl.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' blockmove.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' cap.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' catch.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' confarray.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' dvi.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' halt.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' head_m2.e | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' init.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' load.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' par_misc.e | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'm2 -O -ws -n -E' random.mod | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' rcka.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' rcki.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' rckil.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' rcku.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' rckul.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' sigtrp.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' stackprio.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' store.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack - mkdep 'cc -O -I../h -wo -E' ucheck.c | sed -e 's:^\(.\):../../obj-ack//./ack/libm2/\1:' >> .depend-ack Index: trunk/minix/lib/ack/libm2/Makedepend-gnu =================================================================== --- trunk/minix/lib/ack/libm2/Makedepend-gnu (revision 9) +++ (revision ) @@ -1,3 +1,0 @@ -depend-gnu: - rm .depend-gnu - touch .depend-gnu Index: trunk/minix/lib/ack/libm2/Makefile =================================================================== --- trunk/minix/lib/ack/libm2/Makefile (revision 9) +++ (revision ) @@ -1,178 +1,0 @@ -#Generated from ./ack/libm2/Makefile.in -all: all-ack - -all-ack: -all-gnu: - -makefiles: Makefile -Makedepend-ack Makedepend-gnu: - sh ../../generate.sh ./ack/libm2 ../../obj-ack/ ../../obj-gnu - -Makefile: Makefile.in Makedepend-ack Makedepend-gnu - sh ../../generate.sh ./ack/libm2 ../../obj-ack/ ../../obj-gnu - @echo - @echo *Attention* - @echo Makefile is regenerated... rerun command to see changes - @echo *Attention* - @echo - -depend: depend-ack -all-ack: ../../obj-ack//libm2.a - -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Arguments.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(ArraySort.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(CSP.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Conversion.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(EM.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(InOut.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(LtoUset.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(MathLib0.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Mathlib.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(PascalIO.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Processes.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(RealConver.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(RealInOut.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(SYSTEM.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Semaphores.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Storage.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(StrAss.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Streams.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Strings.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Termcap.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Terminal.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(Traps.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(XXTermcap.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(absd.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(absf.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(absi.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(absl.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(blockmove.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(cap.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(catch.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(confarray.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(dvi.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(halt.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(head_m2.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(init.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(load.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(par_misc.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(random.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(rcka.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(rcki.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(rckil.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(rcku.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(rckul.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(sigtrp.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(stackprio.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(store.o) -../../obj-ack//libm2.a: ../../obj-ack//libm2.a(ucheck.o) - -../../obj-ack//libm2.a: - ar cr ../../obj-ack//libm2.a ../../obj-ack//./ack/libm2/*.o - rm ../../obj-ack//./ack/libm2/*.o - -../../obj-ack//libm2.a(Arguments.o): Arguments.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/Arguments.o Arguments.c -../../obj-ack//libm2.a(ArraySort.o): ArraySort.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/ArraySort.o ArraySort.mod -../../obj-ack//libm2.a(CSP.o): CSP.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/CSP.o CSP.mod -../../obj-ack//libm2.a(Conversion.o): Conversion.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Conversion.o Conversion.mod -../../obj-ack//libm2.a(EM.o): EM.e - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/EM.o EM.e -../../obj-ack//libm2.a(InOut.o): InOut.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/InOut.o InOut.mod -../../obj-ack//libm2.a(LtoUset.o): LtoUset.e - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/LtoUset.o LtoUset.e -../../obj-ack//libm2.a(MathLib0.o): MathLib0.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/MathLib0.o MathLib0.mod -../../obj-ack//libm2.a(Mathlib.o): Mathlib.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Mathlib.o Mathlib.mod -../../obj-ack//libm2.a(PascalIO.o): PascalIO.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/PascalIO.o PascalIO.mod -../../obj-ack//libm2.a(Processes.o): Processes.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Processes.o Processes.mod -../../obj-ack//libm2.a(RealConver.o): RealConver.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/RealConver.o RealConver.mod -../../obj-ack//libm2.a(RealInOut.o): RealInOut.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/RealInOut.o RealInOut.mod -../../obj-ack//libm2.a(SYSTEM.o): SYSTEM.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/SYSTEM.o SYSTEM.c -../../obj-ack//libm2.a(Semaphores.o): Semaphores.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Semaphores.o Semaphores.mod -../../obj-ack//libm2.a(Storage.o): Storage.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Storage.o Storage.mod -../../obj-ack//libm2.a(StrAss.o): StrAss.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/StrAss.o StrAss.c -../../obj-ack//libm2.a(Streams.o): Streams.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Streams.o Streams.mod -../../obj-ack//libm2.a(Strings.o): Strings.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Strings.o Strings.mod -../../obj-ack//libm2.a(Termcap.o): Termcap.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Termcap.o Termcap.mod -../../obj-ack//libm2.a(Terminal.o): Terminal.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Terminal.o Terminal.mod -../../obj-ack//libm2.a(Traps.o): Traps.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/Traps.o Traps.mod -../../obj-ack//libm2.a(XXTermcap.o): XXTermcap.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/XXTermcap.o XXTermcap.c -../../obj-ack//libm2.a(absd.o): absd.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/absd.o absd.c -../../obj-ack//libm2.a(absf.o): absf.e - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/absf.o absf.e -../../obj-ack//libm2.a(absi.o): absi.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/absi.o absi.c -../../obj-ack//libm2.a(absl.o): absl.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/absl.o absl.c -../../obj-ack//libm2.a(blockmove.o): blockmove.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/blockmove.o blockmove.c -../../obj-ack//libm2.a(cap.o): cap.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/cap.o cap.c -../../obj-ack//libm2.a(catch.o): catch.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/catch.o catch.c -../../obj-ack//libm2.a(confarray.o): confarray.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/confarray.o confarray.c -../../obj-ack//libm2.a(dvi.o): dvi.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/dvi.o dvi.c -../../obj-ack//libm2.a(halt.o): halt.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/halt.o halt.c -../../obj-ack//libm2.a(head_m2.o): head_m2.e - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/head_m2.o head_m2.e -../../obj-ack//libm2.a(init.o): init.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/init.o init.c -../../obj-ack//libm2.a(load.o): load.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/load.o load.c -../../obj-ack//libm2.a(par_misc.o): par_misc.e - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/par_misc.o par_misc.e -../../obj-ack//libm2.a(random.o): random.mod - m2 -O -ws -n -c -o ../../obj-ack//./ack/libm2/random.o random.mod -../../obj-ack//libm2.a(rcka.o): rcka.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/rcka.o rcka.c -../../obj-ack//libm2.a(rcki.o): rcki.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/rcki.o rcki.c -../../obj-ack//libm2.a(rckil.o): rckil.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/rckil.o rckil.c -../../obj-ack//libm2.a(rcku.o): rcku.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/rcku.o rcku.c -../../obj-ack//libm2.a(rckul.o): rckul.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/rckul.o rckul.c -../../obj-ack//libm2.a(sigtrp.o): sigtrp.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/sigtrp.o sigtrp.c -../../obj-ack//libm2.a(stackprio.o): stackprio.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/stackprio.o stackprio.c -../../obj-ack//libm2.a(store.o): store.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/store.o store.c -../../obj-ack//libm2.a(ucheck.o): ucheck.c - cc -O -I../h -wo -c -o ../../obj-ack//./ack/libm2/ucheck.o ucheck.c - - - -clean:: - rm -f ../../obj-ack//./ack/libm2/* - -include Makedepend-ack -include .depend-ack - -include Makedepend-gnu -include .depend-gnu Index: trunk/minix/lib/ack/libm2/Makefile.in =================================================================== --- trunk/minix/lib/ack/libm2/Makefile.in (revision 9) +++ (revision ) @@ -1,57 +1,0 @@ -# Makefile for lib/ack/libm2. - -CFLAGS="-O -I../h -wo" -M2FLAGS="-O -ws -n" - -LIBRARIES=libm2 - -libm2_FILES=" \ - Arguments.c \ - ArraySort.mod \ - CSP.mod \ - Conversion.mod \ - EM.e \ - InOut.mod \ - LtoUset.e \ - MathLib0.mod \ - Mathlib.mod \ - PascalIO.mod \ - Processes.mod \ - RealConver.mod \ - RealInOut.mod \ - SYSTEM.c \ - Semaphores.mod \ - Storage.mod \ - StrAss.c \ - Streams.mod \ - Strings.mod \ - Termcap.mod \ - Terminal.mod \ - Traps.mod \ - XXTermcap.c \ - absd.c \ - absf.e \ - absi.c \ - absl.c \ - blockmove.c \ - cap.c \ - catch.c \ - confarray.c \ - dvi.c \ - halt.c \ - head_m2.e \ - init.c \ - load.c \ - par_misc.e \ - random.mod \ - rcka.c \ - rcki.c \ - rckil.c \ - rcku.c \ - rckul.c \ - sigtrp.c \ - stackprio.c \ - store.c \ - ucheck.c" - -TYPE=ack Index: trunk/minix/lib/ack/libm2/MathLib0.mod =================================================================== --- trunk/minix/lib/ack/libm2/MathLib0.mod (revision 9) +++ (revision ) @@ -1,69 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE MathLib0; -(* - Module: Some mathematical functions - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/MathLib0.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - IMPORT Mathlib; - - PROCEDURE cos(arg: REAL): REAL; - BEGIN - RETURN Mathlib.cos(arg); - END cos; - - PROCEDURE sin(arg: REAL): REAL; - BEGIN - RETURN Mathlib.sin(arg); - END sin; - - PROCEDURE arctan(arg: REAL): REAL; - BEGIN - RETURN Mathlib.arctan(arg); - END arctan; - - PROCEDURE sqrt(arg: REAL): REAL; - BEGIN - RETURN Mathlib.sqrt(arg); - END sqrt; - - PROCEDURE ln(arg: REAL): REAL; - BEGIN - RETURN Mathlib.ln(arg); - END ln; - - PROCEDURE exp(arg: REAL): REAL; - BEGIN - RETURN Mathlib.exp(arg); - END exp; - - PROCEDURE entier(x: REAL): INTEGER; - VAR i: INTEGER; - BEGIN - IF x < 0.0 THEN - i := TRUNC(-x); - IF FLOAT(i) = -x THEN - RETURN -i; - ELSE - RETURN -i -1; - END; - END; - RETURN TRUNC(x); - END entier; - - PROCEDURE real(x: INTEGER): REAL; - BEGIN - IF x < 0 THEN - RETURN - FLOAT(-x); - END; - RETURN FLOAT(x); - END real; - -BEGIN -END MathLib0. Index: trunk/minix/lib/ack/libm2/Mathlib.mod =================================================================== --- trunk/minix/lib/ack/libm2/Mathlib.mod (revision 9) +++ (revision ) @@ -1,576 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Mathlib; -(* - Module: Mathematical functions - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Mathlib.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - FROM EM IMPORT FIF, FEF; - FROM Traps IMPORT Message; - - CONST - OneRadianInDegrees = 57.295779513082320876798155D; - OneDegreeInRadians = 0.017453292519943295769237D; - OneOverSqrt2 = 0.70710678118654752440084436210484904D; - - (* basic functions *) - - PROCEDURE pow(x: REAL; i: INTEGER): REAL; - BEGIN - RETURN SHORT(longpow(LONG(x), i)); - END pow; - - PROCEDURE longpow(x: LONGREAL; i: INTEGER): LONGREAL; - VAR val: LONGREAL; - ri: LONGREAL; - BEGIN - ri := FLOATD(i); - IF x < 0.0D THEN - val := longexp(longln(-x) * ri); - IF ODD(i) THEN RETURN -val; - ELSE RETURN val; - END; - ELSIF x = 0.0D THEN - RETURN 0.0D; - ELSE - RETURN longexp(longln(x) * ri); - END; - END longpow; - - PROCEDURE sqrt(x: REAL): REAL; - BEGIN - RETURN SHORT(longsqrt(LONG(x))); - END sqrt; - - PROCEDURE longsqrt(x: LONGREAL): LONGREAL; - VAR - temp: LONGREAL; - exp, i: INTEGER; - BEGIN - IF x <= 0.0D THEN - IF x < 0.0D THEN - Message("sqrt: negative argument"); - HALT - END; - RETURN 0.0D; - END; - temp := FEF(x,exp); - (* - * NOTE - * this wont work on 1's comp - *) - IF ODD(exp) THEN - temp := 2.0D * temp; - DEC(exp); - END; - temp := 0.5D*(1.0D + temp); - - WHILE exp > 28 DO - temp := temp * 16384.0D; - exp := exp - 28; - END; - WHILE exp < -28 DO - temp := temp / 16384.0D; - exp := exp + 28; - END; - WHILE exp >= 2 DO - temp := temp * 2.0D; - exp := exp - 2; - END; - WHILE exp <= -2 DO - temp := temp / 2.0D; - exp := exp + 2; - END; - FOR i := 0 TO 5 DO - temp := 0.5D*(temp + x/temp); - END; - RETURN temp; - END longsqrt; - - PROCEDURE ldexp(x:LONGREAL; n: INTEGER): LONGREAL; - BEGIN - WHILE n >= 16 DO - x := x * 65536.0D; - n := n - 16; - END; - WHILE n > 0 DO - x := x * 2.0D; - DEC(n); - END; - WHILE n <= -16 DO - x := x / 65536.0D; - n := n + 16; - END; - WHILE n < 0 DO - x := x / 2.0D; - INC(n); - END; - RETURN x; - END ldexp; - - PROCEDURE exp(x: REAL): REAL; - BEGIN - RETURN SHORT(longexp(LONG(x))); - END exp; - - PROCEDURE longexp(x: LONGREAL): LONGREAL; - (* Algorithm and coefficients from: - "Software manual for the elementary functions" - by W.J. Cody and W. Waite, Prentice-Hall, 1980 - *) - CONST - p0 = 0.25000000000000000000D+00; - p1 = 0.75753180159422776666D-02; - p2 = 0.31555192765684646356D-04; - q0 = 0.50000000000000000000D+00; - q1 = 0.56817302698551221787D-01; - q2 = 0.63121894374398503557D-03; - q3 = 0.75104028399870046114D-06; - - VAR - neg: BOOLEAN; - n: INTEGER; - xn, g, x1, x2: LONGREAL; - BEGIN - neg := x < 0.0D; - IF neg THEN - x := -x; - END; - n := TRUNC(x/longln2 + 0.5D); - xn := FLOATD(n); - x1 := FLOATD(TRUNCD(x)); - x2 := x - x1; - g := ((x1 - xn * 0.693359375D)+x2) - xn * (-2.1219444005469058277D-4); - IF neg THEN - g := -g; - n := -n; - END; - xn := g*g; - x := g*((p2*xn+p1)*xn+p0); - INC(n); - RETURN ldexp(0.5D + x/((((q3*xn+q2)*xn+q1)*xn+q0) - x), n); - END longexp; - - PROCEDURE ln(x: REAL): REAL; (* natural log *) - BEGIN - RETURN SHORT(longln(LONG(x))); - END ln; - - PROCEDURE longln(x: LONGREAL): LONGREAL; (* natural log *) - (* Algorithm and coefficients from: - "Software manual for the elementary functions" - by W.J. Cody and W. Waite, Prentice-Hall, 1980 - *) - CONST - p0 = -0.64124943423745581147D+02; - p1 = 0.16383943563021534222D+02; - p2 = -0.78956112887491257267D+00; - q0 = -0.76949932108494879777D+03; - q1 = 0.31203222091924532844D+03; - q2 = -0.35667977739034646171D+02; - q3 = 1.0D; - VAR - exp: INTEGER; - z, znum, zden, w: LONGREAL; - - BEGIN - IF x <= 0.0D THEN - Message("ln: argument <= 0"); - HALT - END; - x := FEF(x, exp); - IF x > OneOverSqrt2 THEN - znum := (x - 0.5D) - 0.5D; - zden := x * 0.5D + 0.5D; - ELSE - znum := x - 0.5D; - zden := znum * 0.5D + 0.5D; - DEC(exp); - END; - z := znum / zden; - w := z * z; - x := z + z * w * (((p2*w+p1)*w+p0)/(((q3*w+q2)*w+q1)*w+q0)); - z := FLOATD(exp); - x := x + z * (-2.121944400546905827679D-4); - RETURN x + z * 0.693359375D; - END longln; - - PROCEDURE log(x: REAL): REAL; (* log with base 10 *) - BEGIN - RETURN SHORT(longlog(LONG(x))); - END log; - - PROCEDURE longlog(x: LONGREAL): LONGREAL; (* log with base 10 *) - BEGIN - RETURN longln(x)/longln10; - END longlog; - - (* trigonometric functions; arguments in radians *) - - PROCEDURE sin(x: REAL): REAL; - BEGIN - RETURN SHORT(longsin(LONG(x))); - END sin; - - PROCEDURE sinus(x: LONGREAL; cosflag: BOOLEAN) : LONGREAL; - (* Algorithm and coefficients from: - "Software manual for the elementary functions" - by W.J. Cody and W. Waite, Prentice-Hall, 1980 - *) - CONST - r0 = -0.16666666666666665052D+00; - r1 = 0.83333333333331650314D-02; - r2 = -0.19841269841201840457D-03; - r3 = 0.27557319210152756119D-05; - r4 = -0.25052106798274584544D-07; - r5 = 0.16058936490371589114D-09; - r6 = -0.76429178068910467734D-12; - r7 = 0.27204790957888846175D-14; - A1 = 3.1416015625D; - A2 = -8.908910206761537356617D-6; - VAR - x1, x2, y : LONGREAL; - neg : BOOLEAN; - BEGIN - IF x < 0.0D THEN - neg := TRUE; - x := -x - ELSE neg := FALSE - END; - IF cosflag THEN - neg := FALSE; - y := longhalfpi + x - ELSE - y := x - END; - y := y / longpi + 0.5D; - - IF FIF(y, 1.0D, y) < 0.0D THEN ; END; - IF FIF(y, 0.5D, x1) # 0.0D THEN neg := NOT neg END; - IF cosflag THEN y := y - 0.5D END; - x2 := FIF(x, 1.0, x1); - x := x1 - y * A1; - x := x + x2; - x := x - y * A2; - - IF x < 0.0D THEN - neg := NOT neg; - x := -x - END; - y := x * x; - x := x + x * y * (((((((r7*y+r6)*y+r5)*y+r4)*y+r3)*y+r2)*y+r1)*y+r0); - IF neg THEN RETURN -x END; - RETURN x; - END sinus; - - PROCEDURE longsin(x: LONGREAL): LONGREAL; - BEGIN - RETURN sinus(x, FALSE); - END longsin; - - PROCEDURE cos(x: REAL): REAL; - BEGIN - RETURN SHORT(longcos(LONG(x))); - END cos; - - PROCEDURE longcos(x: LONGREAL): LONGREAL; - BEGIN - IF x < 0.0D THEN x := -x; END; - RETURN sinus(x, TRUE); - END longcos; - - PROCEDURE tan(x: REAL): REAL; - BEGIN - RETURN SHORT(longtan(LONG(x))); - END tan; - - PROCEDURE longtan(x: LONGREAL): LONGREAL; - (* Algorithm and coefficients from: - "Software manual for the elementary functions" - by W.J. Cody and W. Waite, Prentice-Hall, 1980 - *) - - CONST - p1 = -0.13338350006421960681D+00; - p2 = 0.34248878235890589960D-02; - p3 = -0.17861707342254426711D-04; - - q0 = 1.0D; - q1 = -0.46671683339755294240D+00; - q2 = 0.25663832289440112864D-01; - q3 = -0.31181531907010027307D-03; - q4 = 0.49819433993786512270D-06; - - A1 = 1.57080078125D; - A2 = -4.454455103380768678308D-06; - - VAR y, x1, x2: LONGREAL; - negative: BOOLEAN; - invert: BOOLEAN; - BEGIN - negative := x < 0.0D; - y := x / longhalfpi + 0.5D; - - (* Use extended precision to calculate reduced argument. - Here we used 12 bits of the mantissa for a1. - Also split x in integer part x1 and fraction part x2. - *) - IF FIF(y, 1.0D, y) < 0.0D THEN ; END; - invert := FIF(y, 0.5D, x1) # 0.0D; - x2 := FIF(x, 1.0D, x1); - x := x1 - y * A1; - x := x + x2; - x := x - y * A2; - - y := x * x; - x := x + x * y * ((p3*y+p2)*y+p1); - y := (((q4*y+q3)*y+q2)*y+q1)*y+q0; - IF negative THEN x := -x END; - IF invert THEN RETURN -y/x END; - RETURN x/y; - END longtan; - - PROCEDURE arcsin(x: REAL): REAL; - BEGIN - RETURN SHORT(longarcsin(LONG(x))); - END arcsin; - - PROCEDURE arcsincos(x: LONGREAL; cosfl: BOOLEAN): LONGREAL; - CONST - p0 = -0.27368494524164255994D+02; - p1 = 0.57208227877891731407D+02; - p2 = -0.39688862997540877339D+02; - p3 = 0.10152522233806463645D+02; - p4 = -0.69674573447350646411D+00; - - q0 = -0.16421096714498560795D+03; - q1 = 0.41714430248260412556D+03; - q2 = -0.38186303361750149284D+03; - q3 = 0.15095270841030604719D+03; - q4 = -0.23823859153670238830D+02; - q5 = 1.0D; - VAR - negative : BOOLEAN; - big: BOOLEAN; - g: LONGREAL; - BEGIN - negative := x < 0.0D; - IF negative THEN x := -x; END; - IF x > 0.5D THEN - big := TRUE; - IF x > 1.0D THEN - Message("arcsin or arccos: argument > 1"); - HALT - END; - g := 0.5D - 0.5D * x; - x := -longsqrt(g); - x := x + x; - ELSE - big := FALSE; - g := x * x; - END; - x := x + x * g * - ((((p4*g+p3)*g+p2)*g+p1)*g+p0)/(((((q5*g+q4)*g+q3)*g+q2)*g+q1)*g+q0); - IF cosfl AND NOT negative THEN x := -x END; - IF cosfl = NOT big THEN - x := (x + longquartpi) + longquartpi; - ELSIF cosfl AND negative AND big THEN - x := (x + longhalfpi) + longhalfpi; - END; - IF negative AND NOT cosfl THEN x := -x END; - RETURN x; - END arcsincos; - - PROCEDURE longarcsin(x: LONGREAL): LONGREAL; - BEGIN - RETURN arcsincos(x, FALSE); - END longarcsin; - - PROCEDURE arccos(x: REAL): REAL; - BEGIN - RETURN SHORT(longarccos(LONG(x))); - END arccos; - - PROCEDURE longarccos(x: LONGREAL): LONGREAL; - BEGIN - RETURN arcsincos(x, TRUE); - END longarccos; - - PROCEDURE arctan(x: REAL): REAL; - BEGIN - RETURN SHORT(longarctan(LONG(x))); - END arctan; - - VAR A: ARRAY[0..3] OF LONGREAL; - arctaninit: BOOLEAN; - - PROCEDURE longarctan(x: LONGREAL): LONGREAL; - (* Algorithm and coefficients from: - "Software manual for the elementary functions" - by W.J. Cody and W. Waite, Prentice-Hall, 1980 - *) - CONST - p0 = -0.13688768894191926929D+02; - p1 = -0.20505855195861651981D+02; - p2 = -0.84946240351320683534D+01; - p3 = -0.83758299368150059274D+00; - q0 = 0.41066306682575781263D+02; - q1 = 0.86157349597130242515D+02; - q2 = 0.59578436142597344465D+02; - q3 = 0.15024001160028576121D+02; - q4 = 1.0D; - VAR - g: LONGREAL; - neg: BOOLEAN; - n: INTEGER; - BEGIN - IF NOT arctaninit THEN - arctaninit := TRUE; - A[0] := 0.0D; - A[1] := 0.52359877559829887307710723554658381D; (* p1/6 *) - A[2] := longhalfpi; - A[3] := 1.04719755119659774615421446109316763D; (* pi/3 *) - END; - neg := FALSE; - IF x < 0.0D THEN - neg := TRUE; - x := -x; - END; - IF x > 1.0D THEN - x := 1.0D/x; - n := 2 - ELSE - n := 0 - END; - IF x > 0.26794919243112270647D (* 2-sqrt(3) *) THEN - INC(n); - x := (((0.73205080756887729353D*x-0.5D)-0.5D)+x)/ - (1.73205080756887729353D + x); - END; - g := x*x; - x := x + x * g * (((p3*g+p2)*g+p1)*g+p0) / ((((q4*g+q3)*g+q2)*g+q1)*g+q0); - IF n > 1 THEN x := -x END; - x := x + A[n]; - IF neg THEN RETURN -x; END; - RETURN x; - END longarctan; - - (* hyperbolic functions *) - (* The C math library has better implementations for some of these, but - they depend on some properties of the floating point implementation, - and, for now, we don't want that in the Modula-2 system. - *) - - PROCEDURE sinh(x: REAL): REAL; - BEGIN - RETURN SHORT(longsinh(LONG(x))); - END sinh; - - PROCEDURE longsinh(x: LONGREAL): LONGREAL; - VAR expx: LONGREAL; - BEGIN - expx := longexp(x); - RETURN (expx - 1.0D/expx)/2.0D; - END longsinh; - - PROCEDURE cosh(x: REAL): REAL; - BEGIN - RETURN SHORT(longcosh(LONG(x))); - END cosh; - - PROCEDURE longcosh(x: LONGREAL): LONGREAL; - VAR expx: LONGREAL; - BEGIN - expx := longexp(x); - RETURN (expx + 1.0D/expx)/2.0D; - END longcosh; - - PROCEDURE tanh(x: REAL): REAL; - BEGIN - RETURN SHORT(longtanh(LONG(x))); - END tanh; - - PROCEDURE longtanh(x: LONGREAL): LONGREAL; - VAR expx: LONGREAL; - BEGIN - expx := longexp(x); - RETURN (expx - 1.0D/expx) / (expx + 1.0D/expx); - END longtanh; - - PROCEDURE arcsinh(x: REAL): REAL; - BEGIN - RETURN SHORT(longarcsinh(LONG(x))); - END arcsinh; - - PROCEDURE longarcsinh(x: LONGREAL): LONGREAL; - VAR neg: BOOLEAN; - BEGIN - neg := FALSE; - IF x < 0.0D THEN - neg := TRUE; - x := -x; - END; - x := longln(x + longsqrt(x*x+1.0D)); - IF neg THEN RETURN -x; END; - RETURN x; - END longarcsinh; - - PROCEDURE arccosh(x: REAL): REAL; - BEGIN - RETURN SHORT(longarccosh(LONG(x))); - END arccosh; - - PROCEDURE longarccosh(x: LONGREAL): LONGREAL; - BEGIN - IF x < 1.0D THEN - Message("arccosh: argument < 1"); - HALT - END; - RETURN longln(x + longsqrt(x*x - 1.0D)); - END longarccosh; - - PROCEDURE arctanh(x: REAL): REAL; - BEGIN - RETURN SHORT(longarctanh(LONG(x))); - END arctanh; - - PROCEDURE longarctanh(x: LONGREAL): LONGREAL; - BEGIN - IF (x <= -1.0D) OR (x >= 1.0D) THEN - Message("arctanh: ABS(argument) >= 1"); - HALT - END; - RETURN longln((1.0D + x)/(1.0D - x)) / 2.0D; - END longarctanh; - - (* conversions *) - - PROCEDURE RadianToDegree(x: REAL): REAL; - BEGIN - RETURN SHORT(longRadianToDegree(LONG(x))); - END RadianToDegree; - - PROCEDURE longRadianToDegree(x: LONGREAL): LONGREAL; - BEGIN - RETURN x * OneRadianInDegrees; - END longRadianToDegree; - - PROCEDURE DegreeToRadian(x: REAL): REAL; - BEGIN - RETURN SHORT(longDegreeToRadian(LONG(x))); - END DegreeToRadian; - - PROCEDURE longDegreeToRadian(x: LONGREAL): LONGREAL; - BEGIN - RETURN x * OneDegreeInRadians; - END longDegreeToRadian; - -BEGIN - arctaninit := FALSE; -END Mathlib. Index: trunk/minix/lib/ack/libm2/PascalIO.mod =================================================================== --- trunk/minix/lib/ack/libm2/PascalIO.mod (revision 9) +++ (revision ) @@ -1,437 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE PascalIO; -(* - Module: Pascal-like Input/Output - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/PascalIO.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - FROM Conversions IMPORT - ConvertInteger, ConvertCardinal; - FROM RealConversions IMPORT - LongRealToString, StringToLongReal; - FROM Traps IMPORT Message; - FROM Streams IMPORT Stream, StreamKind, StreamMode, StreamResult, - InputStream, OutputStream, OpenStream, CloseStream, - EndOfStream, Read, Write, StreamBuffering; - FROM Storage IMPORT Allocate; - FROM SYSTEM IMPORT ADR; - - TYPE charset = SET OF CHAR; - btype = (Preading, Pwriting, free); - - CONST spaces = charset{11C, 12C, 13C, 14C, 15C, ' '}; - - TYPE IOstream = RECORD - type: btype; - done, eof : BOOLEAN; - ch: CHAR; - next: Text; - stream: Stream; - END; - Text = POINTER TO IOstream; - numbuf = ARRAY[0..255] OF CHAR; - - VAR ibuf, obuf: IOstream; - head: Text; - result: StreamResult; - - PROCEDURE Reset(VAR InputText: Text; Filename: ARRAY OF CHAR); - BEGIN - doclose(InputText); - getstruct(InputText); - WITH InputText^ DO - OpenStream(stream, Filename, text, reading, result); - IF result # succeeded THEN - Message("could not open input file"); - HALT; - END; - type := Preading; - done := FALSE; - eof := FALSE; - END; - END Reset; - - PROCEDURE Rewrite(VAR OutputText: Text; Filename: ARRAY OF CHAR); - BEGIN - doclose(OutputText); - getstruct(OutputText); - WITH OutputText^ DO - OpenStream(stream, Filename, text, writing, result); - IF result # succeeded THEN - Message("could not open output file"); - HALT; - END; - type := Pwriting; - END; - END Rewrite; - - PROCEDURE CloseOutput(); - VAR p: Text; - BEGIN - p := head; - WHILE p # NIL DO - doclose(p); - p := p^.next; - END; - END CloseOutput; - - PROCEDURE doclose(Xtext: Text); - BEGIN - IF Xtext # Notext THEN - WITH Xtext^ DO - IF type # free THEN - CloseStream(stream, result); - type := free; - END; - END; - END; - END doclose; - - PROCEDURE getstruct(VAR Xtext: Text); - BEGIN - Xtext := head; - WHILE (Xtext # NIL) AND (Xtext^.type # free) DO - Xtext := Xtext^.next; - END; - IF Xtext = NIL THEN - Allocate(Xtext,SIZE(IOstream)); - Xtext^.next := head; - head := Xtext; - END; - END getstruct; - - PROCEDURE Error(tp: btype); - BEGIN - IF tp = Preading THEN - Message("input text expected"); - ELSE - Message("output text expected"); - END; - HALT; - END Error; - - PROCEDURE ReadChar(InputText: Text; VAR ch : CHAR); - BEGIN - ch := NextChar(InputText); - IF InputText^.eof THEN - Message("unexpected EOF"); - HALT; - END; - InputText^.done := FALSE; - END ReadChar; - - PROCEDURE NextChar(InputText: Text): CHAR; - BEGIN - WITH InputText^ DO - IF type # Preading THEN Error(Preading); END; - IF NOT done THEN - IF EndOfStream(stream, result) THEN - eof := TRUE; - ch := 0C; - ELSE - Read(stream, ch, result); - done := TRUE; - END; - END; - RETURN ch; - END; - END NextChar; - - PROCEDURE Get(InputText: Text); - VAR dummy: CHAR; - BEGIN - ReadChar(InputText, dummy); - END Get; - - PROCEDURE Eoln(InputText: Text): BOOLEAN; - BEGIN - RETURN NextChar(InputText) = 12C; - END Eoln; - - PROCEDURE Eof(InputText: Text): BOOLEAN; - BEGIN - RETURN (NextChar(InputText) = 0C) AND InputText^.eof; - END Eof; - - PROCEDURE ReadLn(InputText: Text); - VAR ch: CHAR; - BEGIN - REPEAT - ReadChar(InputText, ch) - UNTIL ch = 12C; - END ReadLn; - - PROCEDURE WriteChar(OutputText: Text; char: CHAR); - BEGIN - WITH OutputText^ DO - IF type # Pwriting THEN Error(Pwriting); END; - Write(stream, char, result); - END; - END WriteChar; - - PROCEDURE WriteLn(OutputText: Text); - BEGIN - WriteChar(OutputText, 12C); - END WriteLn; - - PROCEDURE Page(OutputText: Text); - BEGIN - WriteChar(OutputText, 14C); - END Page; - - PROCEDURE ReadInteger(InputText: Text; VAR int : INTEGER); - CONST - SAFELIMITDIV10 = MAX(INTEGER) DIV 10; - SAFELIMITREM10 = MAX(INTEGER) MOD 10; - VAR - neg : BOOLEAN; - safedigit: CARDINAL; - ch: CHAR; - chvalue: CARDINAL; - BEGIN - WHILE NextChar(InputText) IN spaces DO - Get(InputText); - END; - ch := NextChar(InputText); - IF ch = '-' THEN - Get(InputText); - ch := NextChar(InputText); - neg := TRUE; - ELSIF ch = '+' THEN - Get(InputText); - ch := NextChar(InputText); - neg := FALSE; - ELSE - neg := FALSE - END; - - safedigit := SAFELIMITREM10; - IF neg THEN safedigit := safedigit + 1 END; - int := 0; - IF (ch >= '0') AND (ch <= '9') THEN - WHILE (ch >= '0') & (ch <= '9') DO - chvalue := ORD(ch) - ORD('0'); - IF (int < -SAFELIMITDIV10) OR - ( (int = -SAFELIMITDIV10) AND - (chvalue > safedigit)) THEN - Message("integer too large"); - HALT; - ELSE - int := 10*int - VAL(INTEGER, chvalue); - Get(InputText); - ch := NextChar(InputText); - END; - END; - IF NOT neg THEN - int := -int - END; - ELSE - Message("integer expected"); - HALT; - END; - END ReadInteger; - - PROCEDURE ReadCardinal(InputText: Text; VAR card : CARDINAL); - CONST - SAFELIMITDIV10 = MAX(CARDINAL) DIV 10; - SAFELIMITREM10 = MAX(CARDINAL) MOD 10; - - VAR - ch : CHAR; - safedigit: CARDINAL; - chvalue: CARDINAL; - BEGIN - WHILE NextChar(InputText) IN spaces DO - Get(InputText); - END; - ch := NextChar(InputText); - safedigit := SAFELIMITREM10; - card := 0; - IF (ch >= '0') AND (ch <= '9') THEN - WHILE (ch >= '0') & (ch <= '9') DO - chvalue := ORD(ch) - ORD('0'); - IF (card > SAFELIMITDIV10) OR - ( (card = SAFELIMITDIV10) AND - (chvalue > safedigit)) THEN - Message("cardinal too large"); - HALT; - ELSE - card := 10*card + chvalue; - Get(InputText); - ch := NextChar(InputText); - END; - END; - ELSE - Message("cardinal expected"); - HALT; - END; - END ReadCardinal; - - PROCEDURE ReadReal(InputText: Text; VAR real: REAL); - VAR x1: LONGREAL; - BEGIN - ReadLongReal(InputText, x1); - real := x1 - END ReadReal; - - PROCEDURE ReadLongReal(InputText: Text; VAR real: LONGREAL); - VAR - buf: numbuf; - ch: CHAR; - ok: BOOLEAN; - index: INTEGER; - - PROCEDURE inch(): CHAR; - BEGIN - buf[index] := ch; - INC(index); - Get(InputText); - RETURN NextChar(InputText); - END inch; - - BEGIN - index := 0; - ok := TRUE; - WHILE NextChar(InputText) IN spaces DO - Get(InputText); - END; - ch := NextChar(InputText); - IF (ch ='+') OR (ch = '-') THEN - ch := inch(); - END; - IF (ch >= '0') AND (ch <= '9') THEN - WHILE (ch >= '0') AND (ch <= '9') DO - ch := inch(); - END; - IF (ch = '.') THEN - ch := inch(); - IF (ch >= '0') AND (ch <= '9') THEN - WHILE (ch >= '0') AND (ch <= '9') DO - ch := inch(); - END; - ELSE - ok := FALSE; - END; - END; - IF ok AND (ch = 'E') THEN - ch := inch(); - IF (ch ='+') OR (ch = '-') THEN - ch := inch(); - END; - IF (ch >= '0') AND (ch <= '9') THEN - WHILE (ch >= '0') AND (ch <= '9') DO - ch := inch(); - END; - ELSE - ok := FALSE; - END; - END; - ELSE - ok := FALSE; - END; - IF ok THEN - buf[index] := 0C; - StringToLongReal(buf, real, ok); - END; - IF NOT ok THEN - Message("Illegal real"); - HALT; - END; - END ReadLongReal; - - PROCEDURE WriteCardinal(OutputText: Text; card: CARDINAL; width: CARDINAL); - VAR - buf : numbuf; - BEGIN - ConvertCardinal(card, 1, buf); - WriteString(OutputText, buf, width); - END WriteCardinal; - - PROCEDURE WriteInteger(OutputText: Text; int: INTEGER; width: CARDINAL); - VAR - buf : numbuf; - BEGIN - ConvertInteger(int, 1, buf); - WriteString(OutputText, buf, width); - END WriteInteger; - - PROCEDURE WriteBoolean(OutputText: Text; bool: BOOLEAN; width: CARDINAL); - BEGIN - IF bool THEN - WriteString(OutputText, " TRUE", width); - ELSE - WriteString(OutputText, "FALSE", width); - END; - END WriteBoolean; - - PROCEDURE WriteReal(OutputText: Text; real: REAL; width, nfrac: CARDINAL); - BEGIN - WriteLongReal(OutputText, LONG(real), width, nfrac) - END WriteReal; - - PROCEDURE WriteLongReal(OutputText: Text; real: LONGREAL; width, nfrac: CARDINAL); - VAR - buf: numbuf; - ok: BOOLEAN; - digits: INTEGER; - BEGIN - IF width > SIZE(buf) THEN - width := SIZE(buf); - END; - IF nfrac > 0 THEN - LongRealToString(real, width, nfrac, buf, ok); - ELSE - IF width < 9 THEN width := 9; END; - IF real < 0.0D THEN - digits := 7 - INTEGER(width); - ELSE - digits := 6 - INTEGER(width); - END; - LongRealToString(real, width, digits, buf, ok); - END; - WriteString(OutputText, buf, 0); - END WriteLongReal; - - PROCEDURE WriteString(OutputText: Text; str: ARRAY OF CHAR; width: CARDINAL); - VAR index: CARDINAL; - BEGIN - index := 0; - WHILE (index <= HIGH(str)) AND (str[index] # Eos) DO - INC(index); - END; - WHILE index < width DO - WriteChar(OutputText, " "); - INC(index); - END; - index := 0; - WHILE (index <= HIGH(str)) AND (str[index] # Eos) DO - WriteChar(OutputText, str[index]); - INC(index); - END; - END WriteString; - -BEGIN (* PascalIO initialization *) - WITH ibuf DO - stream := InputStream; - eof := FALSE; - type := Preading; - done := FALSE; - END; - WITH obuf DO - stream := OutputStream; - eof := FALSE; - type := Pwriting; - END; - Notext := NIL; - Input := ADR(ibuf); - Output := ADR(obuf); - Input^.next := Output; - Output^.next := NIL; - head := Input; -END PascalIO. Index: trunk/minix/lib/ack/libm2/Processes.mod =================================================================== --- trunk/minix/lib/ack/libm2/Processes.mod (revision 9) +++ (revision ) @@ -1,101 +1,0 @@ -(*$R-*) -IMPLEMENTATION MODULE Processes [1]; -(* - Module: Processes - From: "Programming in Modula-2", 3rd, corrected edition, by N. Wirth - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Processes.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - FROM SYSTEM IMPORT ADDRESS, TSIZE, NEWPROCESS, TRANSFER; - FROM Storage IMPORT Allocate; - FROM Traps IMPORT Message; - - TYPE SIGNAL = POINTER TO ProcessDescriptor; - - ProcessDescriptor = - RECORD next: SIGNAL; (* ring *) - queue: SIGNAL; (* queue of waiting processes *) - cor: ADDRESS; - ready: BOOLEAN; - END; - - VAR cp: SIGNAL; (* current process *) - - PROCEDURE StartProcess(P: PROC; n: CARDINAL); - VAR s0: SIGNAL; - wsp: ADDRESS; - BEGIN - s0 := cp; - Allocate(wsp, n); - Allocate(cp, TSIZE(ProcessDescriptor)); - WITH cp^ DO - next := s0^.next; - s0^.next := cp; - ready := TRUE; - queue := NIL - END; - NEWPROCESS(P, wsp, n, cp^.cor); - TRANSFER(s0^.cor, cp^.cor); - END StartProcess; - - PROCEDURE SEND(VAR s: SIGNAL); - VAR s0: SIGNAL; - BEGIN - IF s # NIL THEN - s0 := cp; - cp := s; - WITH cp^ DO - s := queue; - ready := TRUE; - queue := NIL - END; - TRANSFER(s0^.cor, cp^.cor); - END - END SEND; - - PROCEDURE WAIT(VAR s: SIGNAL); - VAR s0, s1: SIGNAL; - BEGIN - (* insert cp in queue s *) - IF s = NIL THEN - s := cp - ELSE - s0 := s; - s1 := s0^.queue; - WHILE s1 # NIL DO - s0 := s1; - s1 := s0^.queue - END; - s0^.queue := cp - END; - s0 := cp; - REPEAT - cp := cp^.next - UNTIL cp^.ready; - IF cp = s0 THEN - (* deadlock *) - Message("deadlock"); - HALT - END; - s0^.ready := FALSE; - TRANSFER(s0^.cor, cp^.cor) - END WAIT; - - PROCEDURE Awaited(s: SIGNAL): BOOLEAN; - BEGIN - RETURN s # NIL - END Awaited; - - PROCEDURE Init(VAR s: SIGNAL); - BEGIN - s := NIL - END Init; - -BEGIN - Allocate(cp, TSIZE(ProcessDescriptor)); - WITH cp^ DO - next := cp; - ready := TRUE; - queue := NIL - END -END Processes. Index: trunk/minix/lib/ack/libm2/RealConver.mod =================================================================== --- trunk/minix/lib/ack/libm2/RealConver.mod (revision 9) +++ (revision ) @@ -1,337 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE RealConversions; -(* - Module: string-to-real and real-to-string conversions - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/RealConver.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - - PROCEDURE RealToString(arg: REAL; - width, digits: INTEGER; - VAR str: ARRAY OF CHAR; - VAR ok: BOOLEAN); - BEGIN - LongRealToString(LONG(arg), width, digits, str, ok); - END RealToString; - - TYPE - Powers = RECORD - pval: LONGREAL; - rpval: LONGREAL; - exp: INTEGER - END; - - VAR Powers10: ARRAY[1..6] OF Powers; - - PROCEDURE LongRealToString(arg: LONGREAL; - width, digits: INTEGER; - VAR str: ARRAY OF CHAR; - VAR ok: BOOLEAN); - VAR pointpos: INTEGER; - i: CARDINAL; - ecvtflag: BOOLEAN; - r: LONGREAL; - ind1, ind2 : CARDINAL; - sign: BOOLEAN; - ndigits: CARDINAL; - - BEGIN - r := arg; - IF digits < 0 THEN - ecvtflag := TRUE; - ndigits := -digits; - ELSE - ecvtflag := FALSE; - ndigits := digits; - END; - IF (HIGH(str) < ndigits + 3) THEN - str[0] := 0C; ok := FALSE; RETURN - END; - pointpos := 0; - sign := r < 0.0D; - IF sign THEN r := -r END; - ok := TRUE; - IF NOT (r / 10.0D < r) THEN - (* assume Nan or Infinity *) - r := 0.0D; - ok := FALSE; - END; - IF r # 0.0D THEN - IF r >= 10.0D THEN - FOR i := 1 TO 6 DO - WITH Powers10[i] DO - WHILE r >= pval DO - r := r * rpval; - INC(pointpos, exp) - END; - END; - END; - END; - IF r < 1.0D THEN - FOR i := 1 TO 6 DO - WITH Powers10[i] DO - WHILE r*pval < 10.0D DO - r := r * pval; - DEC(pointpos, exp) - END; - END; - END; - END; - (* Now, we have r in [1.0, 10.0) *) - INC(pointpos); - END; - ind1 := 0; - ind2 := ndigits+1; - - IF NOT ecvtflag THEN - IF INTEGER(ind2) + pointpos <= 0 THEN - ind2 := 1; - ELSE - ind2 := INTEGER(ind2) + pointpos - END; - END; - IF ind2 > HIGH(str) THEN - ok := FALSE; - str[0] := 0C; - RETURN; - END; - WHILE ind1 < ind2 DO - str[ind1] := CHR(TRUNC(r)+ORD('0')); - r := 10.0D * (r - FLOATD(TRUNC(r))); - INC(ind1); - END; - IF ind2 > 0 THEN - DEC(ind2); - ind1 := ind2; - str[ind2] := CHR(ORD(str[ind2])+5); - WHILE str[ind2] > '9' DO - str[ind2] := '0'; - IF ind2 > 0 THEN - DEC(ind2); - str[ind2] := CHR(ORD(str[ind2])+1); - ELSE - str[ind2] := '1'; - INC(pointpos); - IF NOT ecvtflag THEN - IF ind1 > 0 THEN str[ind1] := '0'; END; - INC(ind1); - END; - END; - END; - IF (NOT ecvtflag) AND (ind1 = 0) THEN - str[0] := CHR(ORD(str[0])-5); - INC(ind1); - END; - END; - IF ecvtflag THEN - FOR i := ind1 TO 2 BY -1 DO - str[i] := str[i-1]; - END; - str[1] := '.'; - INC(ind1); - IF sign THEN - FOR i := ind1 TO 1 BY -1 DO - str[i] := str[i-1]; - END; - INC(ind1); - str[0] := '-'; - END; - IF (ind1 + 4) > HIGH(str) THEN - str[0] := 0C; - ok := FALSE; - RETURN; - END; - str[ind1] := 'E'; INC(ind1); - IF arg # 0.0D THEN DEC(pointpos); END; - IF pointpos < 0 THEN - pointpos := -pointpos; - str[ind1] := '-'; - ELSE - str[ind1] := '+'; - END; - INC(ind1); - str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 100)); - pointpos := pointpos MOD 100; - INC(ind1); - str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 10)); - INC(ind1); - str[ind1] := CHR(ORD('0') + CARDINAL(pointpos MOD 10)); - ELSE - IF pointpos <= 0 THEN - FOR i := ind1 TO 1 BY -1 DO - str[i+CARDINAL(-pointpos)] := str[i-1]; - END; - FOR i := 0 TO CARDINAL(-pointpos) DO - str[i] := '0'; - END; - ind1 := ind1 + CARDINAL(1 - pointpos); - pointpos := 1; - END; - FOR i := ind1 TO CARDINAL(pointpos+1) BY -1 DO - str[i] := str[i-1]; - END; - IF ndigits = 0 THEN - str[pointpos] := 0C; - ind1 := pointpos - 1; - ELSE - str[pointpos] := '.'; - IF INTEGER(ind1) > pointpos+INTEGER(ndigits) THEN - ind1 := pointpos+INTEGER(ndigits); - END; - str[pointpos+INTEGER(ndigits)+1] := 0C; - END; - IF sign THEN - FOR i := ind1 TO 0 BY -1 DO - str[i+1] := str[i]; - END; - str[0] := '-'; - INC(ind1); - END; - END; - IF (ind1+1) <= HIGH(str) THEN str[ind1+1] := 0C; END; - IF ind1 >= CARDINAL(width) THEN - ok := FALSE; - RETURN; - END; - IF width > 0 THEN - DEC(width); - END; - IF (width > 0) AND (ind1 < CARDINAL(width)) THEN - FOR i := ind1 TO 0 BY -1 DO - str[i + CARDINAL(width) - ind1] := str[i]; - END; - FOR i := 0 TO CARDINAL(width)-(ind1+1) DO - str[i] := ' '; - END; - ind1 := CARDINAL(width); - IF (ind1+1) <= HIGH(str) THEN - FOR ind1 := ind1+1 TO HIGH(str) DO - str[ind1] := 0C; - END; - END; - END; - - END LongRealToString; - - - PROCEDURE StringToReal(str: ARRAY OF CHAR; - VAR r: REAL; VAR ok: BOOLEAN); - VAR x: LONGREAL; - BEGIN - StringToLongReal(str, x, ok); - IF ok THEN - r := x; - END; - END StringToReal; - - PROCEDURE StringToLongReal(str: ARRAY OF CHAR; - VAR r: LONGREAL; VAR ok: BOOLEAN); - CONST BIG = 1.0D17; - TYPE SETOFCHAR = SET OF CHAR; - VAR pow10 : INTEGER; - i : INTEGER; - e : LONGREAL; - ch : CHAR; - signed: BOOLEAN; - signedexp: BOOLEAN; - iB: CARDINAL; - - BEGIN - r := 0.0D; - pow10 := 0; - iB := 0; - ok := TRUE; - signed := FALSE; - WHILE (str[iB] = ' ') OR (str[iB] = CHR(9)) DO - INC(iB); - IF iB > HIGH(str) THEN - ok := FALSE; - RETURN; - END; - END; - IF str[iB] = '-' THEN signed := TRUE; INC(iB) - ELSIF str[iB] = '+' THEN INC(iB) - END; - ch := str[iB]; INC(iB); - IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END; - REPEAT - IF r>BIG THEN INC(pow10) ELSE r:= 10.0D*r+FLOATD(ORD(ch)-ORD('0')) END; - IF iB <= HIGH(str) THEN - ch := str[iB]; INC(iB); - END; - UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'}); - IF (ch = '.') AND (iB <= HIGH(str)) THEN - ch := str[iB]; INC(iB); - IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END; - REPEAT - IF r < BIG THEN - r := 10.0D * r + FLOATD(ORD(ch)-ORD('0')); - DEC(pow10); - END; - IF iB <= HIGH(str) THEN - ch := str[iB]; INC(iB); - END; - UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'}); - END; - IF (ch = 'E') THEN - IF iB > HIGH(str) THEN - ok := FALSE; - RETURN; - ELSE - ch := str[iB]; INC(iB); - END; - i := 0; - signedexp := FALSE; - IF (ch = '-') OR (ch = '+') THEN - signedexp := ch = '-'; - IF iB > HIGH(str) THEN - ok := FALSE; - RETURN; - ELSE - ch := str[iB]; INC(iB); - END; - END; - IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END; - REPEAT - i := i*10 + INTEGER(ORD(ch) - ORD('0')); - IF iB <= HIGH(str) THEN - ch := str[iB]; INC(iB); - END; - UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'}); - IF signedexp THEN i := -i END; - pow10 := pow10 + i; - END; - IF pow10 < 0 THEN i := -pow10; ELSE i := pow10; END; - e := 1.0D; - DEC(i); - WHILE i >= 10 DO - e := e * 10000000000.0D; - DEC(i,10); - END; - WHILE i >= 0 DO - e := e * 10.0D; - DEC(i) - END; - IF pow10<0 THEN - r := r / e; - ELSE - r := r * e; - END; - IF signed THEN r := -r; END; - IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END - END StringToLongReal; - -BEGIN - WITH Powers10[1] DO pval := 1.0D32; rpval := 1.0D-32; exp := 32 END; - WITH Powers10[2] DO pval := 1.0D16; rpval := 1.0D-16; exp := 16 END; - WITH Powers10[3] DO pval := 1.0D8; rpval := 1.0D-8; exp := 8 END; - WITH Powers10[4] DO pval := 1.0D4; rpval := 1.0D-4; exp := 4 END; - WITH Powers10[5] DO pval := 1.0D2; rpval := 1.0D-2; exp := 2 END; - WITH Powers10[6] DO pval := 1.0D1; rpval := 1.0D-1; exp := 1 END; -END RealConversions. Index: trunk/minix/lib/ack/libm2/RealInOut.mod =================================================================== --- trunk/minix/lib/ack/libm2/RealInOut.mod (revision 9) +++ (revision ) @@ -1,97 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE RealInOut; -(* - Module: InOut for REAL numbers - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/RealInOut.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - FROM InOut IMPORT ReadString, WriteString, WriteOct; - FROM Traps IMPORT Message; - FROM SYSTEM IMPORT WORD; - FROM RealConversions IMPORT - LongRealToString, StringToLongReal; - - CONST MAXNDIG = 32; - MAXWIDTH = MAXNDIG+7; - TYPE RBUF = ARRAY [0..MAXWIDTH+1] OF CHAR; - - PROCEDURE WriteReal(arg: REAL; ndigits: CARDINAL); - BEGIN - WriteLongReal(LONG(arg), ndigits) - END WriteReal; - - PROCEDURE WriteLongReal(arg: LONGREAL; ndigits: CARDINAL); - VAR buf : RBUF; - ok : BOOLEAN; - - BEGIN - IF ndigits > MAXWIDTH THEN ndigits := MAXWIDTH; END; - IF ndigits < 10 THEN ndigits := 10; END; - LongRealToString(arg, ndigits, -INTEGER(ndigits - 7), buf, ok); - WriteString(buf); - END WriteLongReal; - - PROCEDURE WriteFixPt(arg: REAL; n, k: CARDINAL); - BEGIN - WriteLongFixPt(LONG(arg), n, k) - END WriteFixPt; - - PROCEDURE WriteLongFixPt(arg: LONGREAL; n, k: CARDINAL); - VAR buf: RBUF; - ok : BOOLEAN; - - BEGIN - IF n > MAXWIDTH THEN n := MAXWIDTH END; - LongRealToString(arg, n, k, buf, ok); - WriteString(buf); - END WriteLongFixPt; - - PROCEDURE ReadReal(VAR x: REAL); - VAR x1: LONGREAL; - BEGIN - ReadLongReal(x1); - x := x1 - END ReadReal; - - PROCEDURE ReadLongReal(VAR x: LONGREAL); - VAR Buf: ARRAY[0..512] OF CHAR; - ok: BOOLEAN; - - BEGIN - ReadString(Buf); - StringToLongReal(Buf, x, ok); - IF NOT ok THEN - Message("real expected"); - HALT; - END; - Done := TRUE; - END ReadLongReal; - - PROCEDURE wroct(x: ARRAY OF WORD); - VAR i: CARDINAL; - BEGIN - FOR i := 0 TO HIGH(x) DO - WriteOct(CARDINAL(x[i]), 0); - WriteString(" "); - END; - END wroct; - - PROCEDURE WriteRealOct(x: REAL); - BEGIN - wroct(x); - END WriteRealOct; - - PROCEDURE WriteLongRealOct(x: LONGREAL); - BEGIN - wroct(x); - END WriteLongRealOct; - -BEGIN - Done := FALSE; -END RealInOut. Index: trunk/minix/lib/ack/libm2/SYSTEM.c =================================================================== --- trunk/minix/lib/ack/libm2/SYSTEM.c (revision 9) +++ (revision ) @@ -1,115 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: SYSTEM - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/SYSTEM.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -/* - An implementation of the Modula-2 NEWPROCESS and TRANSFER facilities - using the topsize, topsave, and topload facilities. - For each coroutine, a proc structure is built. For the main routine, - a static space is declared to save its stack. For the other coroutines, - the user specifies this space. -*/ - -#include - -#define MAXMAIN 2048 - -struct proc { - unsigned size; /* size of saved stackframe(s) */ - int (*proc)(); /* address of coroutine procedure */ - char *brk; /* stack break of this coroutine */ -}; - -extern unsigned topsize(); - -static struct proc mainproc[MAXMAIN/sizeof(struct proc) + 1]; - -static struct proc *curproc = 0;/* current coroutine */ -extern char *MainLB; /* stack break of main routine */ - -_SYSTEM__NEWPROCESS(p, a, n, p1) - int (*p)(); /* coroutine procedure */ - struct proc *a; /* pointer to area for saved stack-frame */ - unsigned n; /* size of this area */ - struct proc **p1; /* where to leave coroutine descriptor, - in this implementation the address of - the area for saved stack-frame(s) */ -{ - /* This procedure creates a new coroutine, but does not - transfer control to it. The routine "topsize" will compute the - stack break, which will be the local base of this routine. - Notice that we can do this because we do not need the stack - above this point for this coroutine. In Modula-2, coroutines - must be level 0 procedures without parameters. - */ - char *brk = 0; - unsigned sz = topsize(&brk); - - if (sz + sizeof(struct proc) > n) { - /* not enough space */ - TRP(M2_TOOLARGE); - } - a->size = n; - a->proc = p; - a->brk = brk; - *p1 = a; - if (topsave(brk, a+1)) - /* stack frame saved; now just return */ - ; - else { - /* We get here through the first transfer to the coroutine - created above. - This also means that curproc is now set to this coroutine. - We cannot trust the parameters anymore. - Just call the coroutine procedure. - */ - (*(curproc->proc))(); - _cleanup(); - _exit(0); - } -} - -_SYSTEM__TRANSFER(a, b) - struct proc **a, **b; -{ - /* transfer from one coroutine to another, saving the current - descriptor in the space indicated by "a", and transfering to - the coroutine in descriptor "b". - */ - unsigned size; - - if (! curproc) { - /* the current coroutine is the main process; - initialize a coroutine descriptor for it ... - */ - mainproc[0].brk = MainLB; - mainproc[0].size = sizeof(mainproc); - curproc = &mainproc[0]; - } - *a = curproc; /* save current descriptor in "a" */ - if (*b == curproc) { - /* transfer to itself is a no-op */ - return; - } - size = topsize(&(curproc->brk)); - if (size + sizeof(struct proc) > curproc->size) { - TRP(M2_TOOLARGE); - } - if (topsave(curproc->brk, curproc+1)) { - /* stack top saved. Now restore context of target - coroutine - */ - curproc = *b; - topload(curproc+1); - /* we never get here ... */ - } - /* but we do get here, when a transfer is done to the coroutine in "a". - */ -} Index: trunk/minix/lib/ack/libm2/Semaphores.mod =================================================================== --- trunk/minix/lib/ack/libm2/Semaphores.mod (revision 9) +++ (revision ) @@ -1,118 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Semaphores [1]; -(* - Module: Processes with semaphores - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Semaphores.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ - - Quasi-concurrency implementation -*) - - FROM SYSTEM IMPORT ADDRESS, NEWPROCESS, TRANSFER; - FROM Storage IMPORT Allocate; - FROM random IMPORT Uniform; - FROM Traps IMPORT Message; - - TYPE Sema = POINTER TO Semaphore; - Processes = POINTER TO Process; - Semaphore = - RECORD - level: CARDINAL; - END; - Process = - RECORD next: Processes; - proc: ADDRESS; - waiting: Sema; - END; - - VAR cp: Processes; (* current process *) - - PROCEDURE StartProcess(P: PROC; n: CARDINAL); - VAR s0: Processes; - wsp: ADDRESS; - BEGIN - s0 := cp; - Allocate(wsp, n); - Allocate(cp, SIZE(Process)); - WITH cp^ DO - next := s0^.next; - s0^.next := cp; - waiting := NIL; - END; - NEWPROCESS(P, wsp, n, cp^.proc); - TRANSFER(s0^.proc, cp^.proc); - END StartProcess; - - PROCEDURE Up(VAR s: Sema); - BEGIN - s^.level := s^.level + 1; - ReSchedule; - END Up; - - PROCEDURE Down(VAR s: Sema); - BEGIN - IF s^.level = 0 THEN - cp^.waiting := s; - ELSE - s^.level := s^.level - 1; - END; - ReSchedule; - END Down; - - PROCEDURE NewSema(n: CARDINAL): Sema; - VAR s: Sema; - BEGIN - Allocate(s, SIZE(Semaphore)); - s^.level := n; - RETURN s; - END NewSema; - - PROCEDURE Level(s: Sema): CARDINAL; - BEGIN - RETURN s^.level; - END Level; - - PROCEDURE ReSchedule; - VAR s0: Processes; - i, j: CARDINAL; - BEGIN - s0 := cp; - i := Uniform(1, 5); - j := i; - LOOP - cp := cp^.next; - IF Runnable(cp) THEN - DEC(i); - IF i = 0 THEN EXIT END; - END; - IF (cp = s0) AND (j = i) THEN - (* deadlock *) - Message("deadlock"); - HALT - END; - END; - IF cp # s0 THEN TRANSFER(s0^.proc, cp^.proc); END; - END ReSchedule; - - PROCEDURE Runnable(p: Processes): BOOLEAN; - BEGIN - IF p^.waiting = NIL THEN RETURN TRUE; END; - IF p^.waiting^.level > 0 THEN - p^.waiting^.level := p^.waiting^.level - 1; - p^.waiting := NIL; - RETURN TRUE; - END; - RETURN FALSE; - END Runnable; -BEGIN - Allocate(cp, SIZE(Process)); - WITH cp^ DO - next := cp; - waiting := NIL; - END -END Semaphores. Index: trunk/minix/lib/ack/libm2/Storage.mod =================================================================== --- trunk/minix/lib/ack/libm2/Storage.mod (revision 9) +++ (revision ) @@ -1,353 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Storage; -(* - Module: Dynamic Storage Allocation - Author: Ceriel J.H. Jacobs - Adapted from a version in C by Hans Tebra - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Storage.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) -(* This storage manager maintains an array of lists of objects with the - same size. Commonly used sizes have their own bucket. The larger ones - are put in a single list. -*) - FROM Unix IMPORT sbrk, ILLBREAK; - FROM SYSTEM IMPORT ADDRESS, ADR; - FROM Traps IMPORT Message; - - CONST - NLISTS = 20; - MAGICW = 0A5A5H; - MAGICC = 175C; - - TYPE - ALIGNTYPE = - RECORD - CASE : INTEGER OF - 1: l: LONGINT | - 2: p: ADDRESS | - 3: d: LONGREAL - END - END; (* A type with high alignment requirements *) - BucketPtr = POINTER TO Bucket; - Bucket = - RECORD - CASE : BOOLEAN OF - FALSE: - BNEXT: BucketPtr; (* next free Bucket *) - BSIZE: CARDINAL; | (* size of user part in UNITs *) - TRUE: BXX: ALIGNTYPE - END; - BSTORE: ALIGNTYPE; - END; - - CONST - UNIT = SIZE(ALIGNTYPE); - - VAR - FreeLists: ARRAY[0..NLISTS] OF BucketPtr; (* small blocks *) - Llist: BucketPtr; (* others *) - Compacted: BOOLEAN; (* avoid recursive reorganization *) - FirstBlock: BucketPtr; - USED: ADDRESS; - - PROCEDURE MyAllocate(size: CARDINAL) : ADDRESS; - VAR nu : CARDINAL; - b : CARDINAL; - p, q: BucketPtr; - pc: POINTER TO CHAR; - brk : ADDRESS; - BEGIN - IF size > CARDINAL(MAX(INTEGER)-2*UNIT + 1) THEN - RETURN NIL; - END; - nu := (size + (UNIT-1)) DIV UNIT; - IF nu = 0 THEN - nu := 1; - END; - IF nu <= NLISTS THEN - b := nu; - IF FreeLists[b] # NIL THEN - (* Exact fit *) - p := FreeLists[b]; - FreeLists[b] := p^.BNEXT; - p^.BNEXT := USED; - IF p^.BSIZE * UNIT # size THEN - pc := ADR(p^.BSTORE) + size; - pc^ := MAGICC; - END; - p^.BSIZE := size; - RETURN ADR(p^.BSTORE); - END; - - (* Search for a block with >= 2 units more than requested. - We pay for an additional header when the block is split. - *) - FOR b := b+2 TO NLISTS DO - IF FreeLists[b] # NIL THEN - q := FreeLists[b]; - FreeLists[b] := q^.BNEXT; - p := ADDRESS(q) + (nu+1)*UNIT; - (* p indicates the block that must be given - back - *) - p^.BSIZE := q^.BSIZE - nu - 1; - p^.BNEXT := FreeLists[p^.BSIZE]; - FreeLists[p^.BSIZE] := p; - q^.BSIZE := nu; - q^.BNEXT := USED; - IF q^.BSIZE * UNIT # size THEN - pc := ADR(q^.BSTORE) + size; - pc^ := MAGICC; - END; - q^.BSIZE := size; - RETURN ADR(q^.BSTORE); - END; - END; - END; - - p := Llist; - IF p # NIL THEN - q := NIL; - WHILE (p # NIL) AND (p^.BSIZE < nu) DO - q := p; - p := p^.BNEXT; - END; - - IF p # NIL THEN - (* p^.BSIZE >= nu *) - IF p^.BSIZE <= nu + NLISTS + 1 THEN - (* Remove p from this list *) - IF q # NIL THEN q^.BNEXT := p^.BNEXT - ELSE Llist := p^.BNEXT; - END; - p^.BNEXT := USED; - IF p^.BSIZE > nu + 1 THEN - (* split block, - tail goes to FreeLists area - *) - q := ADDRESS(p) + (nu+1)*UNIT; - q^.BSIZE := p^.BSIZE -nu -1; - q^.BNEXT := FreeLists[q^.BSIZE]; - FreeLists[q^.BSIZE] := q; - p^.BSIZE := nu; - END; - IF p^.BSIZE * UNIT # size THEN - pc := ADR(p^.BSTORE) + size; - pc^ := MAGICC; - END; - p^.BSIZE := size; - RETURN ADR(p^.BSTORE); - END; - (* Give part of tail of original block. - Block stays in this list. - *) - q := ADDRESS(p) + (p^.BSIZE-nu)*UNIT; - q^.BSIZE := nu; - p^.BSIZE := p^.BSIZE - nu - 1; - q^.BNEXT := USED; - IF q^.BSIZE * UNIT # size THEN - pc := ADR(q^.BSTORE) + size; - pc^ := MAGICC; - END; - q^.BSIZE := size; - RETURN ADR(q^.BSTORE); - END; - END; - - IF Compacted THEN - (* reorganization did not yield sufficient memory *) - RETURN NIL; - END; - - brk := sbrk(UNIT * (nu + 1)); - IF brk = ILLBREAK THEN - ReOrganize(); - Compacted := TRUE; - brk := MyAllocate(size); - Compacted := FALSE; - RETURN brk; - END; - - p := brk; - p^.BSIZE := nu; - p^.BNEXT := USED; - IF p^.BSIZE * UNIT # size THEN - pc := ADR(p^.BSTORE) + size; - pc^ := MAGICC; - END; - p^.BSIZE := size; - RETURN ADR(p^.BSTORE); - END MyAllocate; - - PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL); - BEGIN - Allocate(a, size); - END ALLOCATE; - - PROCEDURE Allocate(VAR a: ADDRESS; size: CARDINAL); - BEGIN - a := MyAllocate(size); - IF a = NIL THEN - Message("out of core"); - HALT; - END; - END Allocate; - - PROCEDURE Available(size: CARDINAL): BOOLEAN; - VAR a: ADDRESS; - BEGIN - a:= MyAllocate(size); - IF a # NIL THEN - Deallocate(a, size); - RETURN TRUE; - END; - RETURN FALSE; - END Available; - - PROCEDURE DEALLOCATE(VAR a: ADDRESS; size: CARDINAL); - BEGIN - Deallocate(a, size); - END DEALLOCATE; - - PROCEDURE Deallocate(VAR a: ADDRESS; size: CARDINAL); - VAR p: BucketPtr; - pc: POINTER TO CHAR; - BEGIN - IF (a = NIL) THEN - Message("(Warning) Deallocate: NIL pointer deallocated"); - RETURN; - END; - p := a - UNIT; - IF (p^.BNEXT # BucketPtr(USED)) THEN - Message("(Warning) Deallocate: area already deallocated or heap corrupted"); - a := NIL; - RETURN; - END; - WITH p^ DO - IF BSIZE # size THEN - Message("(Warning) Deallocate: wrong size or heap corrupted"); - END; - BSIZE := (size + (UNIT - 1)) DIV UNIT; - IF (BSIZE*UNIT # size) THEN - pc := a + size; - IF pc^ # MAGICC THEN - Message("(Warning) Deallocate: heap corrupted"); - END; - END; - IF BSIZE <= NLISTS THEN - BNEXT := FreeLists[BSIZE]; - FreeLists[BSIZE] := p; - ELSE - BNEXT := Llist; - Llist := p; - END; - END; - a := NIL - END Deallocate; - - PROCEDURE ReOrganize(); - VAR lastblock: BucketPtr; - b, be: BucketPtr; - i: CARDINAL; - BEGIN - lastblock := NIL; - FOR i := 1 TO NLISTS DO - b := FreeLists[i]; - WHILE b # NIL DO - IF ADDRESS(b) > ADDRESS(lastblock) THEN - lastblock := b; - END; - be := b^.BNEXT; - b^.BNEXT := NIL; (* temporary free mark *) - b := be; - END; - END; - - b := Llist; - WHILE b # NIL DO - IF ADDRESS(b) > ADDRESS(lastblock) THEN - lastblock := b; - END; - be := b^.BNEXT; - b^.BNEXT := NIL; - b := be; - END; - - (* Now, all free blocks have b^.BNEXT = NIL *) - - b := FirstBlock; - WHILE ADDRESS(b) < ADDRESS(lastblock) DO - LOOP - be := ADDRESS(b)+(b^.BSIZE+1)*UNIT; - IF b^.BNEXT # NIL THEN - (* this block is not free *) - EXIT; - END; - IF ADDRESS(be) > ADDRESS(lastblock) THEN - (* no next block *) - EXIT; - END; - IF be^.BNEXT # NIL THEN - (* next block is not free *) - EXIT; - END; - (* this block and the next one are free, - so merge them, but only if it is not too big - *) - IF MAX(CARDINAL) - b^.BSIZE > be^.BSIZE THEN - b^.BSIZE := b^.BSIZE + be^.BSIZE + 1; - ELSE - EXIT; - END; - END; - b := be; - END; - - (* clear all free lists *) - FOR i := 1 TO NLISTS DO FreeLists[i] := NIL; END; - Llist := NIL; - - (* collect free blocks in them again *) - b := FirstBlock; - WHILE ADDRESS(b) <= ADDRESS(lastblock) DO - WITH b^ DO - IF BNEXT = NIL THEN - IF BSIZE <= NLISTS THEN - BNEXT := FreeLists[BSIZE]; - FreeLists[BSIZE] := b; - ELSE - BNEXT := Llist; - Llist := b; - END; - b := ADDRESS(b) + (BSIZE+1) * UNIT; - ELSE - b := ADDRESS(b) + - ((BSIZE + (UNIT - 1)) DIV UNIT + 1) * UNIT; - END; - END; - END; - END ReOrganize; - - PROCEDURE InitStorage(); - VAR i: CARDINAL; - brk: ADDRESS; - BEGIN - FOR i := 1 TO NLISTS DO - FreeLists[i] := NIL; - END; - Llist := NIL; - brk := sbrk(0); - brk := sbrk(UNIT - brk MOD UNIT); - FirstBlock := sbrk(0); - Compacted := FALSE; - USED := MAGICW; - END InitStorage; - -BEGIN - InitStorage(); -END Storage. Index: trunk/minix/lib/ack/libm2/StrAss.c =================================================================== --- trunk/minix/lib/ack/libm2/StrAss.c (revision 9) +++ (revision ) @@ -1,23 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: assign string to character array, with possible 0-byte - extension - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/StrAss.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ -StringAssign(dstsiz, srcsiz, dstaddr, srcaddr) - register char *dstaddr, *srcaddr; -{ - while (srcsiz > 0) { - *dstaddr++ = *srcaddr++; - srcsiz--; - dstsiz--; - } - if (dstsiz > 0) { - *dstaddr = 0; - } -} Index: trunk/minix/lib/ack/libm2/Streams.mod =================================================================== --- trunk/minix/lib/ack/libm2/Streams.mod (revision 9) +++ (revision ) @@ -1,443 +1,0 @@ -# -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Streams; -(* - Module: Stream Input/Output - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Streams.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ - - Implementation for Unix -*) - - FROM SYSTEM IMPORT BYTE, ADR; - FROM Epilogue IMPORT CallAtEnd; - FROM Storage IMPORT Allocate, Available; - FROM StripUnix IMPORT - open, close, lseek, read, write, creat; - IMPORT StripUnix; - - CONST BUFSIZ = 1024; (* tunable *) - TYPE IOB = RECORD - kind: StreamKind; - mode: StreamMode; - eof: BOOLEAN; - buffering: StreamBuffering; - next : Stream; - fildes: INTEGER; - cnt, maxcnt: INTEGER; - bufferedcnt: INTEGER; - buf: ARRAY[1..BUFSIZ] OF BYTE; - END; - Stream = POINTER TO IOB; - VAR - ibuf, obuf, ebuf: IOB; - head: Stream; - - PROCEDURE getstruct(VAR stream: Stream); - BEGIN - stream := head; - WHILE (stream # NIL) AND (stream^.kind # none) DO - stream := stream^.next; - END; - IF stream = NIL THEN - IF NOT Available(SIZE(IOB)) THEN - RETURN; - END; - Allocate(stream,SIZE(IOB)); - stream^.next := head; - head := stream; - END; - END getstruct; - - PROCEDURE freestruct(stream: Stream); - BEGIN - stream^.kind := none; - END freestruct; - - PROCEDURE OpenStream(VAR stream: Stream; - filename: ARRAY OF CHAR; - kind: StreamKind; - mode: StreamMode; - VAR result: StreamResult); - VAR fd: INTEGER; - i: CARDINAL; - BEGIN - IF kind = none THEN - result := illegaloperation; - RETURN; - END; - getstruct(stream); - IF stream = NIL THEN - result := nomemory; - RETURN; - END; - WITH stream^ DO - FOR i := 0 TO HIGH(filename) DO - buf[i+1] := BYTE(filename[i]); - END; - buf[HIGH(filename)+2] := BYTE(0C); - END; - IF (mode = reading) THEN - fd := open(ADR(stream^.buf), 0); - ELSE - fd := -1; - IF (mode = appending) THEN - fd := open(ADR(stream^.buf), 1); - IF fd >= 0 THEN - IF (lseek(fd, 0D , 2) < 0D) THEN ; END; - END; - END; - IF fd < 0 THEN - fd := creat(ADR(stream^.buf), 666B); - END; - END; - IF fd < 0 THEN - result := openfailed; - freestruct(stream); - stream := NIL; - RETURN; - END; - result := succeeded; - stream^.fildes := fd; - stream^.kind := kind; - stream^.mode := mode; - stream^.buffering := blockbuffered; - stream^.bufferedcnt := BUFSIZ; - stream^.maxcnt := 0; - stream^.eof := FALSE; - IF mode = reading THEN - stream^.cnt := 1; - ELSE - stream^.cnt := 0; - END; - END OpenStream; - - PROCEDURE SetStreamBuffering( stream: Stream; - b: StreamBuffering; - VAR result: StreamResult); - BEGIN - result := succeeded; - IF (stream = NIL) OR (stream^.kind = none) THEN - result := nostream; - RETURN; - END; - IF (stream^.mode = reading) OR - ((b = linebuffered) AND (stream^.kind = binary)) THEN - result := illegaloperation; - RETURN; - END; - FlushStream(stream, result); - IF b = unbuffered THEN - stream^.bufferedcnt := 1; - END; - stream^.buffering := b; - END SetStreamBuffering; - - PROCEDURE FlushStream(stream: Stream; VAR result: StreamResult); - VAR cnt1: INTEGER; - BEGIN - result := succeeded; - IF (stream = NIL) OR (stream^.kind = none) THEN - result := nostream; - RETURN; - END; - WITH stream^ DO - IF mode = reading THEN - result := illegaloperation; - RETURN; - END; - IF (cnt > 0) THEN - cnt1 := cnt; - cnt := 0; - IF write(fildes, ADR(buf), cnt1) < 0 THEN END; - END; - END; - END FlushStream; - - PROCEDURE CloseStream(VAR stream: Stream; VAR result: StreamResult); - BEGIN - IF (stream # NIL) AND (stream^.kind # none) THEN - result := succeeded; - IF stream^.mode # reading THEN - FlushStream(stream, result); - END; - IF close(stream^.fildes) < 0 THEN ; END; - freestruct(stream); - ELSE - result := nostream; - END; - stream := NIL; - END CloseStream; - - PROCEDURE EndOfStream(stream: Stream; VAR result: StreamResult): BOOLEAN; - BEGIN - result := succeeded; - IF (stream = NIL) OR (stream^.kind = none) THEN - result := nostream; - RETURN FALSE; - END; - IF stream^.mode # reading THEN - result := illegaloperation; - RETURN FALSE; - END; - IF stream^.eof THEN RETURN TRUE; END; - RETURN (CHAR(NextByte(stream)) = 0C) AND stream^.eof; - END EndOfStream; - - PROCEDURE FlushLineBuffers(); - VAR s: Stream; - result: StreamResult; - BEGIN - s := head; - WHILE s # NIL DO - IF (s^.kind # none) AND (s^.buffering = linebuffered) THEN - FlushStream(s, result); - END; - s := s^.next; - END; - END FlushLineBuffers; - - PROCEDURE NextByte(stream: Stream): BYTE; - VAR c: BYTE; - BEGIN - WITH stream^ DO - IF cnt <= maxcnt THEN - c := buf[cnt]; - ELSE - IF eof THEN RETURN BYTE(0C); END; - IF stream = InputStream THEN - FlushLineBuffers(); - END; - maxcnt := read(fildes, ADR(buf), bufferedcnt); - cnt := 1; - IF maxcnt <= 0 THEN - eof := TRUE; - c := BYTE(0C); - ELSE - c := buf[1]; - END; - END; - END; - RETURN c; - END NextByte; - - PROCEDURE Read(stream: Stream; VAR ch: CHAR; VAR result: StreamResult); - VAR EoF: BOOLEAN; - BEGIN - ch := 0C; - EoF := EndOfStream(stream, result); - IF result # succeeded THEN RETURN; END; - IF EoF THEN - result := endoffile; - RETURN; - END; - WITH stream^ DO - ch := CHAR(buf[cnt]); - INC(cnt); - END; - END Read; - - PROCEDURE ReadByte(stream: Stream; VAR byte: BYTE; VAR result: StreamResult); - VAR EoF: BOOLEAN; - BEGIN - byte := BYTE(0C); - EoF := EndOfStream(stream, result); - IF result # succeeded THEN RETURN; END; - IF EoF THEN - result := endoffile; - RETURN; - END; - WITH stream^ DO - byte := buf[cnt]; - INC(cnt); - END; - END ReadByte; - - PROCEDURE ReadBytes(stream: Stream; - VAR bytes: ARRAY OF BYTE; - VAR result: StreamResult); - VAR i: CARDINAL; - BEGIN - FOR i := 0 TO HIGH(bytes) DO - ReadByte(stream, bytes[i], result); - END; - END ReadBytes; - - PROCEDURE Write(stream: Stream; ch: CHAR; VAR result: StreamResult); - BEGIN - IF (stream = NIL) OR (stream^.kind = none) THEN - result := nostream; - RETURN; - END; - IF (stream^.kind # text) OR (stream^.mode = reading) THEN - result := illegaloperation; - RETURN; - END; - WITH stream^ DO - INC(cnt); - buf[cnt] := BYTE(ch); - IF (cnt >= bufferedcnt) OR - ((ch = 12C) AND (buffering = linebuffered)) - THEN - FlushStream(stream, result); - END; - END; - END Write; - - PROCEDURE WriteByte(stream: Stream; byte: BYTE; VAR result: StreamResult); - BEGIN - IF (stream = NIL) OR (stream^.kind = none) THEN - result := nostream; - RETURN; - END; - IF (stream^.kind # binary) OR (stream^.mode = reading) THEN - result := illegaloperation; - RETURN; - END; - WITH stream^ DO - INC(cnt); - buf[cnt] := byte; - IF cnt >= bufferedcnt THEN - FlushStream(stream, result); - END; - END; - END WriteByte; - - PROCEDURE WriteBytes(stream: Stream; bytes: ARRAY OF BYTE; VAR result: StreamResult); - VAR i: CARDINAL; - BEGIN - FOR i := 0 TO HIGH(bytes) DO - WriteByte(stream, bytes[i], result); - END; - END WriteBytes; - - PROCEDURE EndIt; - VAR h, h1 : Stream; - result: StreamResult; - BEGIN - h := head; - WHILE h # NIL DO - h1 := h; - CloseStream(h1, result); - h := h^.next; - END; - END EndIt; - - PROCEDURE GetPosition(s: Stream; VAR position: LONGINT; - VAR result: StreamResult); - BEGIN - IF (s = NIL) OR (s^.kind = none) THEN - result := illegaloperation; - RETURN; - END; - IF (s^.mode # reading) THEN FlushStream(s, result); END; - position := lseek(s^.fildes, 0D, 1); - IF position < 0D THEN - result := illegaloperation; - RETURN; - END; - IF s^.mode = reading THEN - position := position + LONG(s^.maxcnt - s^.cnt + 1); - END; - END GetPosition; - - PROCEDURE SetPosition(s: Stream; position: LONGINT; VAR result: StreamResult); - VAR currpos: LONGINT; - BEGIN - currpos := 0D; - IF (s = NIL) OR (s^.kind = none) THEN - result := nostream; - RETURN; - END; - IF (s^.mode # reading) THEN - FlushStream(s, result); - ELSE - s^.maxcnt := 0; - s^.eof := FALSE; - END; - IF s^.mode = appending THEN - currpos := lseek(s^.fildes, 0D, 1); - IF currpos < 0D THEN - result := illegaloperation; - RETURN; - END; - END; - IF position < currpos THEN - result := illegaloperation; - RETURN; - END; - currpos := lseek(s^.fildes, position, 0); - IF currpos < 0D THEN - result := illegaloperation; - RETURN; - END; - result := succeeded; - END SetPosition; - - PROCEDURE isatty(stream: Stream; VAR result: StreamResult): BOOLEAN; - BEGIN - IF (stream = NIL) OR (stream^.kind = none) THEN - result := nostream; - RETURN FALSE; - END; - RETURN StripUnix.isatty(stream^.fildes); - END isatty; - - PROCEDURE InitStreams; - VAR result: StreamResult; - BEGIN - InputStream := ADR(ibuf); - OutputStream := ADR(obuf); - ErrorStream := ADR(ebuf); - WITH ibuf DO - kind := text; - mode := reading; - eof := FALSE; - next := ADR(obuf); - fildes := 0; - maxcnt := 0; - cnt := 1; - bufferedcnt := BUFSIZ; - END; - WITH obuf DO - kind := text; - mode := writing; - eof := TRUE; - next := ADR(ebuf); - fildes := 1; - maxcnt := 0; - cnt := 0; - bufferedcnt := BUFSIZ; - IF isatty(OutputStream, result) THEN - buffering := linebuffered; - ELSE - buffering := blockbuffered; - END; - END; - WITH ebuf DO - kind := text; - mode := writing; - eof := TRUE; - next := NIL; - fildes := 2; - maxcnt := 0; - cnt := 0; - bufferedcnt := BUFSIZ; - IF isatty(ErrorStream, result) THEN - buffering := linebuffered; - ELSE - buffering := blockbuffered; - END; - END; - head := InputStream; - IF CallAtEnd(EndIt) THEN ; END; - END InitStreams; - -BEGIN - InitStreams -END Streams. Index: trunk/minix/lib/ack/libm2/Strings.mod =================================================================== --- trunk/minix/lib/ack/libm2/Strings.mod (revision 9) +++ (revision ) @@ -1,171 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Strings; -(* - Module: String manipulations - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Strings.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - PROCEDURE Assign(source: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); - (* Assign string source to dest - *) - VAR i: CARDINAL; - max: CARDINAL; - BEGIN - max := HIGH(source); - IF HIGH(dest) < max THEN max := HIGH(dest); END; - i := 0; - WHILE (i <= max) AND (source[i] # 0C) DO - dest[i] := source[i]; - INC(i); - END; - IF i < HIGH(dest) THEN dest[i] := 0C; END; - END Assign; - - PROCEDURE Insert(substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR; inx: CARDINAL); - (* Insert the string substr into str, starting at str[inx]. - If inx is equal to or greater than Length(str) then substr is appended - to the end of str. - *) - VAR sublen, length, i: CARDINAL; - BEGIN - sublen := Length(substr); - IF sublen = 0 THEN RETURN; END; - length := Length(str); - IF inx > length THEN inx := length; END; - i := length; - IF i + sublen - 1 > HIGH(str) THEN i := HIGH(str); END; - WHILE i > inx DO - str[i+sublen-1] := str[i-1]; - DEC(i); - END; - FOR i := 0 TO sublen - 1 DO - IF i + inx <= HIGH(str) THEN - str[i + inx] := substr[i]; - ELSE - RETURN; - END; - END; - IF length + sublen <= HIGH(str) THEN - str[length + sublen] := 0C; - END; - END Insert; - - PROCEDURE Delete(VAR str: ARRAY OF CHAR; inx, len: CARDINAL); - (* Delete len characters from str, starting at str[inx]. - If inx >= Length(str) then nothing happens. - If there are not len characters to delete, characters to the end of the - string are deleted. - *) - VAR length: CARDINAL; - BEGIN - IF len = 0 THEN RETURN; END; - length := Length(str); - IF inx >= length THEN RETURN; END; - WHILE inx + len < length DO - str[inx] := str[inx + len]; - INC(inx); - END; - str[inx] := 0C; - END Delete; - - PROCEDURE Pos(substr, str: ARRAY OF CHAR): CARDINAL; - (* Return the index into str of the first occurrence of substr. - Pos returns a value greater than HIGH(str) of no occurrence is found. - *) - VAR i, j, max, subl: CARDINAL; - BEGIN - max := Length(str); - subl := Length(substr); - IF subl > max THEN RETURN HIGH(str) + 1; END; - IF subl = 0 THEN RETURN 0; END; - max := max - subl; - FOR i := 0 TO max DO - j := 0; - WHILE (j <= subl-1) AND (str[i+j] = substr[j]) DO - INC(j); - END; - IF j = subl THEN RETURN i; END; - END; - RETURN HIGH(str) + 1; - END Pos; - - PROCEDURE Copy(str: ARRAY OF CHAR; - inx, len: CARDINAL; - VAR result: ARRAY OF CHAR); - (* Copy at most len characters from str into result, starting at str[inx]. - *) - VAR i: CARDINAL; - BEGIN - IF Length(str) <= inx THEN RETURN END; - i := 0; - LOOP - IF i > HIGH(result) THEN RETURN; END; - IF len = 0 THEN EXIT; END; - IF inx > HIGH(str) THEN EXIT; END; - result[i] := str[inx]; - INC(i); INC(inx); DEC(len); - END; - IF i <= HIGH(result) THEN result[i] := 0C; END; - END Copy; - - PROCEDURE Concat(s1, s2: ARRAY OF CHAR; VAR result: ARRAY OF CHAR); - (* Concatenate two strings. - *) - VAR i, j: CARDINAL; - BEGIN - i := 0; - WHILE (i <= HIGH(s1)) AND (s1[i] # 0C) DO - IF i > HIGH(result) THEN RETURN END; - result[i] := s1[i]; - INC(i); - END; - j := 0; - WHILE (j <= HIGH(s2)) AND (s2[j] # 0C) DO - IF i > HIGH(result) THEN RETURN END; - result[i] := s2[j]; - INC(i); - INC(j); - END; - IF i <= HIGH(result) THEN result[i] := 0C; END; - END Concat; - - PROCEDURE Length(str: ARRAY OF CHAR): CARDINAL; - (* Return number of characters in str. - *) - VAR i: CARDINAL; - BEGIN - i := 0; - WHILE (i <= HIGH(str)) DO - IF str[i] = 0C THEN RETURN i; END; - INC(i); - END; - RETURN i; - END Length; - - PROCEDURE CompareStr(s1, s2: ARRAY OF CHAR): INTEGER; - (* Compare two strings, return -1 if s1 < s2, 0 if s1 = s2, and 1 if s1 > s2. - *) - VAR i: CARDINAL; - max: CARDINAL; - BEGIN - max := HIGH(s1); - IF HIGH(s2) < max THEN max := HIGH(s2); END; - i := 0; - WHILE (i <= max) DO - IF s1[i] < s2[i] THEN RETURN -1; END; - IF s1[i] > s2[i] THEN RETURN 1; END; - IF s1[i] = 0C THEN RETURN 0; END; - INC(i); - END; - IF (i <= HIGH(s1)) AND (s1[i] # 0C) THEN RETURN 1; END; - IF (i <= HIGH(s2)) AND (s2[i] # 0C) THEN RETURN -1; END; - RETURN 0; - END CompareStr; - -END Strings. Index: trunk/minix/lib/ack/libm2/Termcap.mod =================================================================== --- trunk/minix/lib/ack/libm2/Termcap.mod (revision 9) +++ (revision ) @@ -1,99 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(* - Module: Interface to termcap database - From: Unix manual chapter 3 - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Termcap.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - -(*$R-*) -IMPLEMENTATION MODULE Termcap; - - IMPORT XXTermcap; - FROM SYSTEM IMPORT ADR, ADDRESS; - FROM Unix IMPORT isatty; - FROM Arguments IMPORT - GetEnv; - - TYPE STR = ARRAY[1..32] OF CHAR; - STRCAP = POINTER TO STR; - - VAR Buf, Buf1 : ARRAY [1..1024] OF CHAR; - BufCnt : INTEGER; - - PROCEDURE Tgetent(name: ARRAY OF CHAR) : INTEGER; - VAR i: INTEGER; - x: STRCAP; - BEGIN - i := XXTermcap.tgetent(ADR(Buf), ADR(name)); - BufCnt := 1; - IF isatty(1) THEN - ELSE - (* This used to be something returned by gtty(). To increase - * portability we forget about old terminals needing delays. - * (kjb) - *) - XXTermcap.ospeed := 0; - END; - IF i > 0 THEN - IF Tgetstr("pc", x) THEN - XXTermcap.PC := x^[1]; - ELSE XXTermcap.PC := 0C; - END; - IF Tgetstr("up", x) THEN ; END; XXTermcap.UP := x; - IF Tgetstr("bc", x) THEN ; END; XXTermcap.BC := x; - END; - RETURN i; - END Tgetent; - - PROCEDURE Tgetnum(id: ARRAY OF CHAR): INTEGER; - BEGIN - RETURN XXTermcap.tgetnum(ADR(id)); - END Tgetnum; - - PROCEDURE Tgetflag(id: ARRAY OF CHAR): BOOLEAN; - BEGIN - RETURN XXTermcap.tgetflag(ADR(id)) = 1; - END Tgetflag; - - PROCEDURE Tgoto(cm: STRCAP; col, line: INTEGER): STRCAP; - BEGIN - RETURN XXTermcap.tgoto(cm, col, line); - END Tgoto; - - PROCEDURE Tgetstr(id: ARRAY OF CHAR; VAR res: STRCAP) : BOOLEAN; - VAR a, a2: ADDRESS; - b: CARDINAL; - BEGIN - a := ADR(Buf1[BufCnt]); - a2 := XXTermcap.tgetstr(ADR(id), ADR(a)); - res := a2; - IF a2 = NIL THEN - RETURN FALSE; - END; - b := a - a2; - INC(BufCnt, b); - RETURN TRUE; - END Tgetstr; - - PROCEDURE Tputs(cp: STRCAP; affcnt: INTEGER; p: PUTPROC); - BEGIN - XXTermcap.tputs(cp, affcnt, XXTermcap.PUTPROC(p)); - END Tputs; - - PROCEDURE InitTermcap; - VAR Bf: STR; - BEGIN - IF GetEnv("TERM", Bf) = 0 THEN - Bf := "dumb"; - END; - IF Tgetent(Bf) <= 0 THEN - END; - END InitTermcap; - -BEGIN - InitTermcap; -END Termcap. Index: trunk/minix/lib/ack/libm2/Terminal.mod =================================================================== --- trunk/minix/lib/ack/libm2/Terminal.mod (revision 9) +++ (revision ) @@ -1,114 +1,0 @@ -# -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Terminal; -(* - Module: Input/Output to/from terminals - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Terminal.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ - - Implementation for Unix. -*) - FROM SYSTEM IMPORT ADR; -#ifdef __USG - FROM Unix IMPORT read, write, open, fcntl; -#else - FROM Unix IMPORT read, write, open, ioctl; -#endif - VAR fildes: INTEGER; - unreadch: CHAR; - unread: BOOLEAN; - tty: ARRAY[0..8] OF CHAR; - - PROCEDURE Read(VAR ch: CHAR); - BEGIN - IF unread THEN - ch := unreadch; - unread := FALSE - ELSE - IF read(fildes, ADR(ch), 1) < 0 THEN - ; - END; - END; - unreadch := ch; - END Read; - - PROCEDURE BusyRead(VAR ch: CHAR); - VAR l: INTEGER; - BEGIN - IF unread THEN - ch := unreadch; - unread := FALSE - ELSE -#ifdef __USG - l := fcntl(fildes, (*FGETFL*) 3, 0); - IF fcntl(fildes, - (* FSETFL *) 4, - l + (*ONDELAY*) 2) < 0 THEN - ; - END; - IF read(fildes, ADR(ch), 1) = 0 THEN - ch := 0C; - ELSE - unreadch := ch; - END; - IF fcntl(fildes, (*FSETFL*)4, l) < 0 THEN - ; - END; -#else -#ifdef __BSD4_2 - IF ioctl(fildes, INTEGER(ORD('f')*256+127+4*65536+40000000H), ADR(l)) < 0 THEN -#else - IF ioctl(fildes, INTEGER(ORD('f')*256+127), ADR(l)) < 0 THEN -#endif - ; - END; - - IF l = 0 THEN - ch := 0C; - ELSE - IF read(fildes, ADR(ch), 1) < 0 THEN - ; - END; - unreadch := ch; - END; -#endif - END; - END BusyRead; - - PROCEDURE ReadAgain; - BEGIN - unread := TRUE; - END ReadAgain; - - PROCEDURE Write(ch: CHAR); - BEGIN - IF write(fildes, ADR(ch), 1) < 0 THEN - ; - END; - END Write; - - PROCEDURE WriteLn; - BEGIN - Write(12C); - END WriteLn; - - PROCEDURE WriteString(s: ARRAY OF CHAR); - VAR i: CARDINAL; - BEGIN - i := 0; - WHILE (i <= HIGH(s)) & (s[i] # 0C) DO - Write(s[i]); - INC(i) - END - END WriteString; - -BEGIN - tty := "/dev/tty"; - fildes := open(ADR(tty), 2); - unread := FALSE; -END Terminal. Index: trunk/minix/lib/ack/libm2/Traps.mod =================================================================== --- trunk/minix/lib/ack/libm2/Traps.mod (revision 9) +++ (revision ) @@ -1,96 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE Traps; -(* - Module: Facility for handling traps - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/Traps.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - FROM EM IMPORT SIG, LINO, FILN, TRP; - FROM Unix IMPORT write; - FROM SYSTEM IMPORT ADDRESS, ADR; - FROM Arguments IMPORT - Argv; - - PROCEDURE InstallTrapHandler(t: TrapHandler): TrapHandler; - (* Install a new trap handler, and return the previous one. - Parameter of trap handler is the trap number. - *) - BEGIN - RETURN SIG(t); - END InstallTrapHandler; - - PROCEDURE Message(str: ARRAY OF CHAR); - (* Write message "str" on standard error, preceeded by filename and - linenumber if possible - *) - VAR p: POINTER TO CHAR; - l: CARDINAL; - lino: INTEGER; - buf, buf2: ARRAY [0..255] OF CHAR; - i, j: CARDINAL; - BEGIN - p := FILN(); - IF p # NIL THEN - i := 1; - buf[0] := '"'; - WHILE p^ # 0C DO - buf[i] := p^; - INC(i); - p := ADDRESS(p) + 1; - END; - buf[i] := '"'; - INC(i); - IF write(2, ADR(buf), i) < 0 THEN END; - ELSE - l := Argv(0, buf); - IF write(2, ADR(buf), l-1) < 0 THEN END; - END; - lino := LINO(); - i := 0; - IF lino # 0 THEN - i := 7; - buf[0] := ','; buf[1] := ' '; - buf[2] := 'l'; buf[3] := 'i'; buf[4] := 'n'; buf[5] := 'e'; - buf[6] := ' '; - IF lino < 0 THEN - buf[7] := '-'; - i := 8; - lino := - lino; - END; - j := 0; - REPEAT - buf2[j] := CHR(CARDINAL(lino) MOD 10 + ORD('0')); - lino := lino DIV 10; - INC(j); - UNTIL lino = 0; - WHILE j > 0 DO - DEC(j); - buf[i] := buf2[j]; - INC(i); - END; - END; - buf[i] := ':'; - buf[i+1] := ' '; - IF write(2, ADR(buf), i+2) < 0 THEN END; - i := 0; - WHILE (i <= HIGH(str)) AND (str[i] # 0C) DO - INC(i); - END; - IF write(2, ADR(str), i) < 0 THEN END; - buf[0] := 12C; - IF write(2, ADR(buf), 1) < 0 THEN END; - END Message; - - PROCEDURE Trap(n: INTEGER); - (* cause trap number "n" to occur *) - BEGIN - TRP(n); - END Trap; - -END Traps. Index: trunk/minix/lib/ack/libm2/XXTermcap.c =================================================================== --- trunk/minix/lib/ack/libm2/XXTermcap.c (revision 9) +++ (revision ) @@ -1,573 +1,0 @@ -/* - * termcap.c 1.1 20/7/87 agc Joypace Ltd - * - * Copyright Joypace Ltd, London, UK, 1987. All rights reserved. - * This file may be freely distributed provided that this notice - * remains attached. - * - * A public domain implementation of the termcap(3) routines. - * - * Made fully functional by Ceriel J.H. Jacobs. - * - * BUGS: - * - does not check termcap entry sizes - * - not fully tested - */ - -#define CAPABLEN 2 - -#define ISSPACE(c) ((c) == ' ' || (c) == '\t' || (c) == '\r' || (c) == '\n') -#define ISDIGIT(x) ((x) >= '0' && (x) <= '9') - -short ospeed = 0; /* output speed */ -char PC = 0; /* padding character */ -char *BC = 0; /* back cursor movement */ -char *UP = 0; /* up cursor movement */ - -static char *capab = 0; /* the capability itself */ -static int check_for_tc(); -static int match_name(); - -#define NULL 0 - -/* Some things from C-library, needed here because the C-library is not - loaded with Modula-2 programs -*/ - -static char * -strcat(s1, s2) -register char *s1, *s2; -{ - /* Append s2 to the end of s1. */ - - char *original = s1; - - /* Find the end of s1. */ - while (*s1 != 0) s1++; - - /* Now copy s2 to the end of s1. */ - while (*s1++ = *s2++) /* nothing */ ; - return(original); -} - -static char * -strcpy(s1, s2) -register char *s1, *s2; -{ -/* Copy s2 to s1. */ - char *original = s1; - - while (*s1++ = *s2++) /* nothing */; - return(original); -} - -static int -strlen(s) -char *s; -{ -/* Return length of s. */ - - char *original = s; - - while (*s != 0) s++; - return(s - original); -} - -static int -strcmp(s1, s2) -register char *s1, *s2; -{ -/* Compare 2 strings. */ - - for(;;) { - if (*s1 != *s2) { - if (!*s1) return -1; - if (!*s2) return 1; - return(*s1 - *s2); - } - if (*s1++ == 0) return(0); - s2++; - } -} - -static int -strncmp(s1, s2, n) - register char *s1, *s2; - int n; -{ -/* Compare two strings, but at most n characters. */ - - while (n-- > 0) { - if (*s1 != *s2) { - if (!*s1) return -1; - if (!*s2) return 1; - return(*s1 - *s2); - } - if (*s1++ == 0) break; - s2++; - } - return 0; -} - -static char * -getenv(name) -register char *name; -{ - extern char ***_penviron; - register char **v = *_penviron, *p, *q; - - if (v == 0 || name == 0) return 0; - while ((p = *v++) != 0) { - q = name; - while (*q && *q++ == *p++) /* nothing */ ; - if (*q || *p != '=') continue; - return(p+1); - } - return(0); -} - -static char * -fgets(buf, count, fd) - char *buf; -{ - static char bf[1024]; - static int cnt = 0; - static char *pbf = &bf[0]; - register char *c = buf; - - - while (--count) { - if (pbf >= &bf[cnt]) { - if ((cnt = read(fd, bf, 1024)) <= 0) { - if (c == buf) return (char *) NULL; - *c = 0; - return buf; - } - pbf = &bf[0]; - } - *c = *pbf++; - if (*c++ == '\n') { - *c = 0; - return buf; - } - } - *c = 0; - return buf; -} - -/* - * tgetent - get the termcap entry for terminal name, and put it - * in bp (which must be an array of 1024 chars). Returns 1 if - * termcap entry found, 0 if not found, and -1 if file not found. - */ -int -tgetent(bp, name) -char *bp; -char *name; -{ - int fp; - char *file; - char *cp; - short len = strlen(name); - char buf[1024]; - - capab = bp; - if ((file = getenv("TERMCAP")) != (char *) NULL) { - if (*file != '/' && - (cp = getenv("TERM")) != NULL && strcmp(name, cp) == 0) { - (void) strcpy(bp, file); - return(1); - } - else file = "/etc/termcap"; - } else - file = "/etc/termcap"; - if ((fp = open(file, 0)) < 0) { - capab = 0; - return(-1); - } - while (fgets(buf, 1024, fp) != NULL) { - if (buf[0] == '#') continue; - while (*(cp = &buf[strlen(buf) - 2]) == '\\') - if (fgets(cp, 1024, fp) == NULL) - return (0); - if (match_name(buf, name)) { - strcpy(bp, buf); - close(fp); - if(check_for_tc() == 0) { - capab = 0; - return 0; - } - return 1; - } - } - capab = 0; - close(fp); - return(0); -} - -/* - * Compare the terminal name with each termcap entry name; Return 1 if a - * match is found. - */ -static int -match_name(buf, name) - char *buf; - char *name; -{ - register char *tp = buf; - register char *np; - - for (;;) { - for (np = name; *np && *tp == *np; np++, tp++) { } - if (*np == 0 && (*tp == '|' || *tp == ':' || *tp == 0)) - return(1); - while (*tp != 0 && *tp != '|' && *tp != ':') tp++; - if (*tp++ != '|') return (0); - } -} - -/* - * Handle tc= definitions recursively. - */ -static int -check_for_tc() -{ - static int count = 0; - char *savcapab = capab; - char buf[1024]; - char terminalname[128]; - register char *p = capab + strlen(capab) - 2, *q; - - while (*p != ':') - if (--p < capab) - return(0); /* no : in termcap entry */ - if (p[1] != 't' || p[2] != 'c') - return(1); - if (count > 16) { - return(0); /* recursion in tc= definitions */ - } - count++; - strcpy(terminalname, &p[4]); - q = terminalname; - while (*q && *q != ':') q++; - *q = 0; - if (tgetent(buf, terminalname) != 1) { - --count; - return(0); - } - --count; - for (q = buf; *q && *q != ':'; q++) { } - strcpy(p, q); - capab = savcapab; - return(1); -} - -/* - * tgetnum - get the numeric terminal capability corresponding - * to id. Returns the value, -1 if invalid. - */ -int -tgetnum(id) -char *id; -{ - char *cp; - int ret; - - if ((cp = capab) == NULL || id == NULL || *cp == 0) - return(-1); - while (*++cp && *cp != ':') - ; - while (*cp) { - cp++; - while (ISSPACE(*cp)) - cp++; - if (strncmp(cp, id, CAPABLEN) == 0) { - while (*cp && *cp != ':' && *cp != '#') - cp++; - if (*cp != '#') - return(-1); - for (ret = 0, cp++ ; *cp && ISDIGIT(*cp) ; cp++) - ret = ret * 10 + *cp - '0'; - return(ret); - } - while (*cp && *cp != ':') - cp++; - } - return(-1); -} - -/* - * tgetflag - get the boolean flag corresponding to id. Returns -1 - * if invalid, 0 if the flag is not in termcap entry, or 1 if it is - * present. - */ -int -tgetflag(id) -char *id; -{ - char *cp; - - if ((cp = capab) == NULL || id == NULL || *cp == 0) - return(-1); - while (*++cp && *cp != ':') - ; - while (*cp) { - cp++; - while (ISSPACE(*cp)) - cp++; - if (strncmp(cp, id, CAPABLEN) == 0) - return(1); - while (*cp && *cp != ':') - cp++; - } - return(0); -} - -/* - * tgetstr - get the string capability corresponding to id and place - * it in area (advancing area at same time). Expand escape sequences - * etc. Returns the string, or NULL if it can't do it. - */ -char * -tgetstr(id, area) -char *id; -char **area; -{ - char *cp; - char *ret; - int i; - - if ((cp = capab) == NULL || id == NULL || *cp == 0) - return(NULL); - while (*++cp != ':') - ; - while (*cp) { - cp++; - while (ISSPACE(*cp)) - cp++; - if (strncmp(cp, id, CAPABLEN) == 0) { - while (*cp && *cp != ':' && *cp != '=') - cp++; - if (*cp != '=') - return(NULL); - for (ret = *area, cp++; *cp && *cp != ':' ; (*area)++, cp++) - switch(*cp) { - case '^' : - **area = *++cp - 'A' + 1; - break; - case '\\' : - switch(*++cp) { - case 'E' : - **area = '\033'; - break; - case 'n' : - **area = '\n'; - break; - case 'r' : - **area = '\r'; - break; - case 't' : - **area = '\t'; - break; - case 'b' : - **area = '\b'; - break; - case 'f' : - **area = '\f'; - break; - case '0' : - case '1' : - case '2' : - case '3' : - for (i=0 ; *cp && ISDIGIT(*cp) ; cp++) - i = i * 8 + *cp - '0'; - **area = i; - cp--; - break; - case '^' : - case '\\' : - **area = *cp; - break; - } - break; - default : - **area = *cp; - } - *(*area)++ = '\0'; - return(ret); - } - while (*cp && *cp != ':') - cp++; - } - return(NULL); -} - -/* - * tgoto - given the cursor motion string cm, make up the string - * for the cursor to go to (destcol, destline), and return the string. - * Returns "OOPS" if something's gone wrong, or the string otherwise. - */ -char * -tgoto(cm, destcol, destline) -char *cm; -int destcol; -int destline; -{ - register char *rp; - static char ret[32]; - char added[16]; - int *dp = &destline; - int numval; - int swapped = 0; - - added[0] = 0; - for (rp = ret ; *cm ; cm++) { - if (*cm == '%') { - switch(*++cm) { - case '>' : - if (dp == NULL) - return("OOPS"); - cm++; - if (*dp > *cm++) { - *dp += *cm; - } - break; - case '+' : - case '.' : - if (dp == NULL) - return("OOPS"); - if (*cm == '+') *dp = *dp + *++cm; - for (;;) { - switch(*dp) { - case 0: - case 04: - case '\t': - case '\n': - /* filter these out */ - if (dp == &destcol || swapped || UP) { - strcat(added, dp == &destcol || swapped ? - (BC ? BC : "\b") : - UP); - (*dp)++; - continue; - } - } - break; - } - *rp++ = *dp; - dp = (dp == &destline) ? &destcol : NULL; - break; - - case 'r' : { - int tmp = destline; - - destline = destcol; - destcol = tmp; - swapped = 1 - swapped; - break; - } - case 'n' : - destcol ^= 0140; - destline ^= 0140; - break; - - case '%' : - *rp++ = '%'; - break; - - case 'i' : - destcol++; - destline++; - break; - - case 'B' : - if (dp == NULL) - return("OOPS"); - *dp = 16 * (*dp / 10) + *dp % 10; - break; - - case 'D' : - if (dp == NULL) - return("OOPS"); - *dp = *dp - 2 * (*dp % 16); - break; - - case 'd' : - case '2' : - case '3' : - if (dp == NULL) - return("OOPS"); - numval = *dp; - dp = (dp == &destline) ? &destcol : NULL; - if (numval >= 100) { - *rp++ = '0' + numval / 100; - } - else if (*cm == '3') { - *rp++ = ' '; - } - if (numval >= 10) { - *rp++ = '0' + ((numval%100)/10); - } - else if (*cm == '3' || *cm == '2') { - *rp++ = ' '; - } - *rp++ = '0' + (numval%10); - break; - default : - return("OOPS"); - } - } - else *rp++ = *cm; - } - *rp = '\0'; - strcpy(rp, added); - return(ret); -} - -static int tens_of_ms_p_char[] = { /* index as returned by gtty */ - /* assume 10 bits per char */ - 0, 2000, 1333, 909, 743, 666, 500, 333, 166, 83, 55, 41, 20, 10, 5, 2 -}; -/* - * tputs - put the string cp out onto the terminal, using the function - * outc. Also handle padding. - */ -int -tputs(cp, affcnt, outc) -register char *cp; -int affcnt; -int (*outc)(); -{ - int delay = 0; - if (cp == NULL) - return(1); - while (ISDIGIT(*cp)) { - delay = delay * 10 + (*cp++ - '0'); - } - delay *= 10; - if (*cp == '.') { - cp++; - if (ISDIGIT(*cp)) { - delay += *cp++ - '0'; - } - while (ISDIGIT(*cp)) cp++; - } - if (*cp == '*') { - delay *= affcnt; - cp++; - } - while (*cp) - (*outc)(*cp++); - if (delay != 0 && - ospeed > 0 && - ospeed < (sizeof tens_of_ms_p_char / sizeof tens_of_ms_p_char[0])) { - delay = (delay + tens_of_ms_p_char[ospeed] - 1) / - tens_of_ms_p_char[ospeed]; - while (delay--) (*outc)(PC); - } - return(1); -} - -/* - * That's all, folks... - */ Index: trunk/minix/lib/ack/libm2/absd.c =================================================================== --- trunk/minix/lib/ack/libm2/absd.c (revision 9) +++ (revision ) @@ -1,18 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: double abs function - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/absd.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ -#ifndef NOFLOAT -double -absd(i) - double i; -{ - return i >= 0 ? i : -i; -} -#endif Index: trunk/minix/lib/ack/libm2/absf.e =================================================================== --- trunk/minix/lib/ack/libm2/absf.e (revision 9) +++ (revision ) @@ -1,30 +1,0 @@ -# -; -; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. -; See the copyright notice in the ACK home directory, in the file "Copyright". -; -; -; Module: REAL abs function -; Author: Ceriel J.H. Jacobs -; Version: $Header: /cvsup/minix/src/lib/ack/libm2/absf.e,v 1.1 2005/10/10 15:27:46 beng Exp $ -; - mes 2,_EM_WSIZE,_EM_PSIZE - exp $absf - pro $absf,0 - mes 5 - mes 9,8 - lal 0 - loi _EM_FSIZE - zrf _EM_FSIZE - cmf _EM_FSIZE - zlt *3 - lal 0 - loi _EM_FSIZE - bra *4 -3 - lal 0 - loi _EM_FSIZE - ngf _EM_FSIZE -4 - ret _EM_FSIZE - end 0 Index: trunk/minix/lib/ack/libm2/absi.c =================================================================== --- trunk/minix/lib/ack/libm2/absi.c (revision 9) +++ (revision ) @@ -1,15 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: integer abs function - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/absi.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -absi(i) -{ - return i >= 0 ? i : -i; -} Index: trunk/minix/lib/ack/libm2/absl.c =================================================================== --- trunk/minix/lib/ack/libm2/absl.c (revision 9) +++ (revision ) @@ -1,16 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: longint abs function - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/absl.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ -long -absl(i) - long i; -{ - return i >= 0 ? i : -i; -} Index: trunk/minix/lib/ack/libm2/blockmove.c =================================================================== --- trunk/minix/lib/ack/libm2/blockmove.c (revision 9) +++ (revision ) @@ -1,23 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: block moves - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/blockmove.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#if _EM_WSIZE==_EM_PSIZE -typedef unsigned pcnt; -#else -typedef unsigned long pcnt; -#endif - -blockmove(siz, dst, src) - pcnt siz; - register char *dst, *src; -{ - while (siz--) *dst++ = *src++; -} Index: trunk/minix/lib/ack/libm2/cap.c =================================================================== --- trunk/minix/lib/ack/libm2/cap.c (revision 9) +++ (revision ) @@ -1,18 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: cap; implementation of CAP - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/cap.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -cap(u) - unsigned u; -{ - register unsigned *p = &u; - - if (*p >= 'a' && *p <= 'z') *p += 'A'-'a'; -} Index: trunk/minix/lib/ack/libm2/catch.c =================================================================== --- trunk/minix/lib/ack/libm2/catch.c (revision 9) +++ (revision ) @@ -1,99 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: default modula-2 trap handler - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/catch.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ -#include -#include -#include - -static struct errm { - int errno; - char *errmes; -} errors[] = { - { EARRAY, "array bound error"}, - { ERANGE, "range bound error"}, - { ESET, "set bound error"}, - { EIOVFL, "integer overflow"}, - { EFOVFL, "real overflow"}, - { EFUNFL, "real underflow"}, - { EIDIVZ, "divide by 0"}, - { EFDIVZ, "divide by 0.0"}, - { EIUND, "undefined integer"}, - { EFUND, "undefined real"}, - { ECONV, "conversion error"}, - - { ESTACK, "stack overflow"}, - { EHEAP, "heap overflow"}, - { EILLINS, "illegal instruction"}, - { EODDZ, "illegal size argument"}, - { ECASE, "case error"}, - { EMEMFLT, "addressing non existent memory"}, - { EBADPTR, "bad pointer used"}, - { EBADPC, "program counter out of range"}, - { EBADLAE, "bad argument of lae"}, - { EBADMON, "bad monitor call"}, - { EBADLIN, "argument if LIN too high"}, - { EBADGTO, "GTO descriptor error"}, - - { M2_TOOLARGE, "stack size of process too large"}, - { M2_TOOMANY, "too many nested traps + handlers"}, - { M2_NORESULT, "no RETURN from function procedure"}, - { M2_UOVFL, "cardinal overflow"}, - { M2_FORCH, "(warning) FOR-loop control variable was changed in the body"}, - { M2_UUVFL, "cardinal underflow"}, - { M2_INTERNAL, "internal error; ask an expert for help"}, - { M2_UNIXSIG, "got a unix signal"}, - { -1, 0} -}; - -catch(trapno) - int trapno; -{ - register struct errm *ep = &errors[0]; - char *errmessage; - char buf[20]; - register char *p, *s; - - while (ep->errno != trapno && ep->errmes != 0) ep++; - if (p = ep->errmes) { - while (*p) p++; - _Traps__Message(ep->errmes, 0, (int) (p - ep->errmes), 1); - } - else { - int i = trapno; - static char q[] = "error number xxxxxxxxxxxxx"; - - p = &q[13]; - s = buf; - if (i < 0) { - i = -i; - *p++ = '-'; - } - do - *s++ = i % 10 + '0'; - while (i /= 10); - while (s > buf) *p++ = *--s; - *p = 0; - _Traps__Message(q, 0, (int) (p - q), 1); - } -#if !defined(__em24) && !defined(__em44) && !defined(__em22) - if (trapno == M2_UNIXSIG) { - extern int __signo; - signal(__signo, SIG_DFL); - _cleanup(); - kill(getpid(), __signo); - _exit(trapno); - } -#endif - if (trapno != M2_FORCH) { - _cleanup(); - _exit(trapno); - } - SIG(catch); -} Index: trunk/minix/lib/ack/libm2/confarray.c =================================================================== --- trunk/minix/lib/ack/libm2/confarray.c (revision 9) +++ (revision ) @@ -1,72 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: runtime support for conformant arrays - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/confarray.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ -#include - -#ifndef EM_WSIZE -#define EM_WSIZE _EM_WSIZE -#define EM_PSIZE _EM_PSIZE -#endif - -#if EM_WSIZE==EM_PSIZE -typedef unsigned pcnt; -#else -typedef unsigned long pcnt; -#endif - -struct descr { - char *addr; - int low; - unsigned int highminlow; - unsigned int size; -}; - -static struct descr *descrs[10]; -static struct descr **ppdescr = descrs; - -pcnt -new_stackptr(pdscr, a) - struct descr *pdscr; -{ - register struct descr *pdescr = pdscr; - pcnt size = (((pdescr->highminlow + 1) * pdescr->size + - (EM_WSIZE - 1)) & ~(EM_WSIZE - 1)); - - if (ppdescr >= &descrs[10]) { - /* to many nested traps + handlers ! */ - TRP(M2_TOOMANY); - } - *ppdescr++ = pdescr; - if ((char *) &a - (char *) &pdscr > 0) { - /* stack grows downwards */ - return - size; - } - return size; -} - -copy_array(pp, a) - char *pp; -{ - register char *p = pp; - register char *q; - register pcnt sz; - char dummy; - - ppdescr--; - sz = ((*ppdescr)->highminlow + 1) * (*ppdescr)->size; - - if ((char *) &a - (char *) &pp > 0) { - (*ppdescr)->addr = q = (char *) &a; - } - else (*ppdescr)->addr = q = (char *) &a - - ((sz + (EM_WSIZE - 1)) & ~ (EM_WSIZE - 1)); - - while (sz--) *q++ = *p++; -} Index: trunk/minix/lib/ack/libm2/dvi.c =================================================================== --- trunk/minix/lib/ack/libm2/dvi.c (revision 9) +++ (revision ) @@ -1,68 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: implementation of DIV and MOD - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/dvi.c,v 1.1 2005/10/10 15:27:46 beng Exp $ - Reason: We cannot use DVI and RMI, because DVI rounds towards 0 - and Modula-2 requires truncation -*/ - -#include - -int -dvi(j,i) - int j,i; -{ - if (j == 0) TRP(EIDIVZ); - if ((i < 0) != (j < 0)) { - if (i < 0) i = -i; - else j = -j; - return -((i+j-1)/j); - } - else return i/j; -} - -long -dvil(j,i) - long j,i; -{ - if (j == 0) TRP(EIDIVZ); - if ((i < 0) != (j < 0)) { - if (i < 0) i = -i; - else j = -j; - return -((i+j-1)/j); - } - else return i/j; -} - -int -rmi(j,i) - int j,i; -{ - if (j == 0) TRP(EIDIVZ); - if (i == 0) return 0; - if ((i < 0) != (j < 0)) { - if (i < 0) i = -i; - else j = -j; - return j*((i+j-1)/j)-i; - } - else return i%j; -} - -long -rmil(j,i) - long j,i; -{ - if (j == 0) TRP(EIDIVZ); - if (i == 0) return 0L; - if ((i < 0) != (j < 0)) { - if (i < 0) i = -i; - else j = -j; - return j*((i+j-1)/j)-i; - } - else return i%j; -} Index: trunk/minix/lib/ack/libm2/halt.c =================================================================== --- trunk/minix/lib/ack/libm2/halt.c (revision 9) +++ (revision ) @@ -1,37 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: program termination routines - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/halt.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ -#define MAXPROCS 32 - -static int callindex = 0; -static int (*proclist[MAXPROCS])(); - -_cleanup() -{ - while (--callindex >= 0) - (*proclist[callindex])(); - callindex = 0; -} - -CallAtEnd(p) - int (*p)(); -{ - if (callindex >= MAXPROCS) { - return 0; - } - proclist[callindex++] = p; - return 1; -} - -halt() -{ - _cleanup(); - _exit(0); -} Index: trunk/minix/lib/ack/libm2/head_m2.e =================================================================== --- trunk/minix/lib/ack/libm2/head_m2.e (revision 9) +++ (revision ) @@ -1,63 +1,0 @@ -# -; -; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. -; See the copyright notice in the ACK home directory, in the file "Copyright". -; -; -; Module: Modula-2 runtime startoff -; Author: Ceriel J.H. Jacobs -; Version: $Header: /cvsup/minix/src/lib/ack/libm2/head_m2.e,v 1.1 2005/10/10 15:27:46 beng Exp $ -; - - mes 2,_EM_WSIZE,_EM_PSIZE - - exa handler - exa argv - exa argc - exa MainLB - exa bkillbss - exp $catch - exp $init - inp $trap_handler - -bkillbss - bss _EM_PSIZE,0,0 - - exp $_m_a_i_n - pro $_m_a_i_n, 0 - - lor 0 - lae MainLB - sti _EM_PSIZE - - lal _EM_WSIZE - loi _EM_PSIZE - lae argv ; save argument pointer - sti _EM_PSIZE - - lol 0 - ste argc ; save argument count - - lpi $trap_handler - sig - asp _EM_PSIZE - cal $init - cal $__M2M_ - cal $halt - loc 0 ; should not get here - ret _EM_WSIZE - end - - pro $trap_handler,0 - lpi $trap_handler - sig - lol 0 ; trap number - lae handler - loi _EM_PSIZE - lpi $catch - lae handler - sti _EM_PSIZE - cai - asp _EM_PSIZE+_EM_WSIZE - rtt - end 0 Index: trunk/minix/lib/ack/libm2/init.c =================================================================== --- trunk/minix/lib/ack/libm2/init.c (revision 9) +++ (revision ) @@ -1,51 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: initialization and some global vars - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/init.c,v 1.2 2006/02/17 14:12:47 philip Exp $ -*/ - -#include -#include -#include - -/* map unix signals onto EM traps */ -init() -{ - sigtrp(M2_UNIXSIG, SIGHUP); - sigtrp(M2_UNIXSIG, SIGINT); - sigtrp(M2_UNIXSIG, SIGQUIT); - sigtrp(EILLINS, SIGILL); - sigtrp(M2_UNIXSIG, SIGTRAP); -#ifdef SIGIOT - sigtrp(M2_UNIXSIG, SIGIOT); -#endif -#if SIGEMT - sigtrp(M2_UNIXSIG, SIGEMT); -#endif - sigtrp(M2_UNIXSIG, SIGFPE); - sigtrp(M2_UNIXSIG, SIGBUS); - sigtrp(M2_UNIXSIG, SIGSEGV); -#ifdef SIGSYS - sigtrp(EBADMON, SIGSYS); -#endif - sigtrp(M2_UNIXSIG, SIGPIPE); - sigtrp(M2_UNIXSIG, SIGALRM); - sigtrp(M2_UNIXSIG, SIGTERM); -} - -killbss() -{ - /* Fill bss with junk? Make lots of VM pages dirty? No way! */ -} - -extern int catch(); - -int (*handler)() = catch; -char **argv; -int argc; -char *MainLB; Index: trunk/minix/lib/ack/libm2/load.c =================================================================== --- trunk/minix/lib/ack/libm2/load.c (revision 9) +++ (revision ) @@ -1,45 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: get value on stack, byte by byte - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/load.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#include - -#ifndef EM_WSIZE -#define EM_WSIZE _EM_WSIZE -#define EM_PSIZE _EM_PSIZE -#endif - -#if EM_WSIZE==EM_PSIZE -typedef unsigned pcnt; -#else -typedef long pcnt; -#endif - -load(siz, addr, p) - register char *addr; - register pcnt siz; -{ - /* Make sure, that a value with a size that could have been - handled by the LOI instruction ends up at the same place, - where it would, were the LOI instruction used. - */ - register char *q = (char *) &p; - char t[4]; - - if (siz < EM_WSIZE && EM_WSIZE % siz == 0) { - /* as long as EM_WSIZE <= 4 ... */ - if (siz != 2) TRP(M2_INTERNAL); /* internal error */ - q = &t[0]; - } - while (siz--) *q++ = *addr++; - if (q - t == 2) { - *((unsigned *)(&p)) = *((unsigned short *) (&t[0])); - } -} Index: trunk/minix/lib/ack/libm2/par_misc.e =================================================================== --- trunk/minix/lib/ack/libm2/par_misc.e (revision 9) +++ (revision ) @@ -1,175 +1,0 @@ -# -; -; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. -; See the copyright notice in the ACK home directory, in the file "Copyright". -; - -; -; Module: coroutine primitives -; Author: Kees Bot, Edwin Scheffer, Ceriel Jacobs -; Version: $Header: /cvsup/minix/src/lib/ack/libm2/par_misc.e,v 1.1 2005/10/10 15:27:46 beng Exp $ -; - - mes 2,_EM_WSIZE,_EM_PSIZE - - ; topsize takes care of two things: - ; - given a stack-break, - ; it computes the size of the chunk of memory needed to save the stack; - ; - also, if this stack-break = 0, it creates one, assuming that caller is - ; the stack-break. - ; - ; This implementation assumes a continuous stack growing downwards - - exp $topsize -#ifdef __sparc - inp $topsize2 - pro $topsize, 0 - mes 11 - zer _EM_PSIZE - lal 0 - loi _EM_PSIZE - cal $topsize2 - asp 2*_EM_PSIZE - lfr _EM_WSIZE - ret _EM_WSIZE - end 0 - pro $topsize2, (3*_EM_WSIZE+3*_EM_PSIZE) -#else - pro $topsize, (3*_EM_WSIZE+3*_EM_PSIZE) -#endif - ; local space for line-number, ignoremask, filename, stack-break, size, - ; and stack-pointer (see the topsave routine) - mes 11 - lal 0 - loi _EM_PSIZE - loi _EM_PSIZE ; stack-break or 0 - zer _EM_PSIZE - cmp - zne *1 - lxl 0 - dch ; local base of caller -#ifdef __sparc - dch ; because of the extra layer -#endif - lal 0 - loi _EM_PSIZE - sti _EM_PSIZE -1 - lal 0 - loi _EM_PSIZE - loi _EM_PSIZE - lpb ; convert this local base to an argument base. - ; An implementation of a sort of "topsize" EM - ; instruction should take a local base, and save - ; the whole frame. - - lor 1 ; stack-break SP - sbs _EM_WSIZE ; stack-break-SP - ret _EM_WSIZE ; return size of block to be saved - end 3*_EM_WSIZE+3*_EM_PSIZE - - exp $topsave -#ifdef __sparc - inp $topsave2 - pro $topsave,0 - mes 11 - lal 0 - loi 2*_EM_PSIZE - cal $topsave2 - asp 2*_EM_PSIZE - lfr _EM_WSIZE - ret _EM_WSIZE - end 0 - pro $topsave2,0 -#else - pro $topsave, 0 -#endif - mes 11 - loe 0 - lae 4 ; load line number and file name - loi _EM_PSIZE - lim ; ignore mask - lor 0 ; LB - lal 0 - loi _EM_PSIZE ; stack-break - lpb - lor 1 - sbs _EM_WSIZE - loc _EM_WSIZE - adu _EM_WSIZE ; gives size - dup _EM_WSIZE - stl 0 ; save size - lor 1 ; SP (the SP BEFORE pushing) - lor 1 ; SP (address of stack top to save) - lal _EM_PSIZE ; area - loi _EM_PSIZE - lol 0 ; size - bls _EM_WSIZE ; move whole block - asp 3*_EM_PSIZE+3*_EM_WSIZE ; remove the lot from the stack - loc 1 - ret _EM_WSIZE ; return 1 - end 0 - -sv - bss _EM_PSIZE,0,0 - - exp $topload -#ifdef __sparc - inp $topload1 - pro $topload,0 - lal 0 - loi _EM_PSIZE - cal $topload1 - asp _EM_PSIZE - lfr _EM_WSIZE - ret _EM_WSIZE - end 0 - pro $topload1, 0 -#else - pro $topload, 0 -#endif - mes 11 - - lal 0 - loi _EM_PSIZE - lae sv - sti _EM_PSIZE ; saved parameter - - lxl 0 -2 - dup _EM_PSIZE - adp -3*_EM_PSIZE - lal 0 - loi _EM_PSIZE ; compare target SP with current LB to see if we must - loi _EM_PSIZE - cmp ; find another LB first - zgt *1 - dch ; just follow dynamic chain to make sure we find - ; a legal one - bra *2 -1 - str 0 - - lae sv - loi _EM_PSIZE - loi _EM_PSIZE ; load indirect to - str 1 ; restore SP - asp 0-_EM_PSIZE ; to stop int from complaining about non-existent memory - lae sv - loi _EM_PSIZE ; source address - lor 1 - adp _EM_PSIZE ; destination address - lae sv - loi _EM_PSIZE - adp _EM_PSIZE - loi _EM_WSIZE ; size of block - bls _EM_WSIZE - asp _EM_PSIZE+_EM_WSIZE ; drop size + SP - str 0 ; restore local base - sim ; ignore mask - lae 4 - sti _EM_PSIZE - ste 0 ; line and file - loc 0 - ret _EM_WSIZE - end 0 Index: trunk/minix/lib/ack/libm2/random.mod =================================================================== --- trunk/minix/lib/ack/libm2/random.mod (revision 9) +++ (revision ) @@ -1,58 +1,0 @@ -(* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*) - -(*$R-*) -IMPLEMENTATION MODULE random; -(* - Module: random numbers - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/random.mod,v 1.1 2005/10/10 15:27:46 beng Exp $ -*) - - FROM Unix IMPORT getpid, time; - TYPE index = [1..55]; - - VAR X: ARRAY index OF CARDINAL; - j, k: index; - tm: LONGINT; - - PROCEDURE Random(): CARDINAL; - BEGIN - IF k-1 <= 0 THEN k := 55; ELSE DEC(k) END; - IF j-1 <= 0 THEN j := 55; ELSE DEC(j) END; - X[k] := X[k] + X[j]; - RETURN X[k] - END Random; - - PROCEDURE Uniform (lwb, upb: CARDINAL): CARDINAL; - BEGIN - IF upb <= lwb THEN RETURN lwb; END; - RETURN lwb + (Random() MOD (upb - lwb + 1)); - END Uniform; - - PROCEDURE StartSeed(seed: CARDINAL); - VAR v: CARDINAL; - BEGIN - FOR k := 1 TO 55 DO - seed := 1297 * seed + 123; - X[k] := seed; - END; - FOR k := 1 TO 15 DO - j := tm MOD 55D + 1D; - v := X[j]; - tm := tm DIV 7D; - j := tm MOD 55D + 1D; - X[j] := v; - tm := tm * 3D; - END; - k := 1; - j := 25; - END StartSeed; - -BEGIN - tm := time(NIL); - X[1] := tm; - StartSeed(CARDINAL(getpid()) * X[1]); -END random. Index: trunk/minix/lib/ack/libm2/rcka.c =================================================================== --- trunk/minix/lib/ack/libm2/rcka.c (revision 9) +++ (revision ) @@ -1,25 +1,0 @@ -/* - * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - * See the copyright notice in the ACK home directory, in the file "Copyright". - * - * - * Module: range checks for INTEGER, now for array indexing - * Author: Ceriel J.H. Jacobs - * Version: $Header: /cvsup/minix/src/lib/ack/libm2/rcka.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#include - -extern TRP(); - -struct array_descr { - int lbound; - int n_elts_min_one; - unsigned size; -}; - -rcka(descr, indx) - struct array_descr *descr; -{ - if (indx < 0 || indx > descr->n_elts_min_one) TRP(EARRAY); -} Index: trunk/minix/lib/ack/libm2/rcki.c =================================================================== --- trunk/minix/lib/ack/libm2/rcki.c (revision 9) +++ (revision ) @@ -1,23 +1,0 @@ -/* - * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - * See the copyright notice in the ACK home directory, in the file "Copyright". - * - * - * Module: range checks for INTEGER - * Author: Ceriel J.H. Jacobs - * Version: $Header: /cvsup/minix/src/lib/ack/libm2/rcki.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#include - -extern TRP(); - -struct range_descr { - int low, high; -}; - -rcki(descr, val) - struct range_descr *descr; -{ - if (val < descr->low || val > descr->high) TRP(ERANGE); -} Index: trunk/minix/lib/ack/libm2/rckil.c =================================================================== --- trunk/minix/lib/ack/libm2/rckil.c (revision 9) +++ (revision ) @@ -1,24 +1,0 @@ -/* - * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - * See the copyright notice in the ACK home directory, in the file "Copyright". - * - * - * Module: range checks for LONGINT - * Author: Ceriel J.H. Jacobs - * Version: $Header: /cvsup/minix/src/lib/ack/libm2/rckil.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#include - -extern TRP(); - -struct range_descr { - long low, high; -}; - -rckil(descr, val) - struct range_descr *descr; - long val; -{ - if (val < descr->low || val > descr->high) TRP(ERANGE); -} Index: trunk/minix/lib/ack/libm2/rcku.c =================================================================== --- trunk/minix/lib/ack/libm2/rcku.c (revision 9) +++ (revision ) @@ -1,24 +1,0 @@ -/* - * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - * See the copyright notice in the ACK home directory, in the file "Copyright". - * - * - * Module: range checks for CARDINAL - * Author: Ceriel J.H. Jacobs - * Version: $Header: /cvsup/minix/src/lib/ack/libm2/rcku.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#include - -extern TRP(); - -struct range_descr { - unsigned low, high; -}; - -rcku(descr, val) - struct range_descr *descr; - unsigned val; -{ - if (val < descr->low || val > descr->high) TRP(ERANGE); -} Index: trunk/minix/lib/ack/libm2/rckul.c =================================================================== --- trunk/minix/lib/ack/libm2/rckul.c (revision 9) +++ (revision ) @@ -1,24 +1,0 @@ -/* - * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - * See the copyright notice in the ACK home directory, in the file "Copyright". - * - * - * Module: range checks for LONGCARD - * Author: Ceriel J.H. Jacobs - * Version: $Header: /cvsup/minix/src/lib/ack/libm2/rckul.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#include - -extern TRP(); - -struct range_descr { - unsigned long low, high; -}; - -rckul(descr, val) - struct range_descr *descr; - unsigned long val; -{ - if (val < descr->low || val > descr->high) TRP(ERANGE); -} Index: trunk/minix/lib/ack/libm2/sigtrp.c =================================================================== --- trunk/minix/lib/ack/libm2/sigtrp.c (revision 9) +++ (revision ) @@ -1,82 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: Mapping of Unix signals to EM traps - (only when not using the MON instruction) - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/sigtrp.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#if !defined(__em22) && !defined(__em24) && !defined(__em44) - -#define EM_trap(n) TRP(n) /* define to whatever is needed to cause the trap */ - -#include -#include - -int __signo; - -static int __traps[] = { - -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, - -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, - -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -}; - -static void -__ctchsig(signo) -{ - signal(signo,__ctchsig); -#ifdef __BSD4_2 - sigsetmask(sigblock(0) & ~(1<<(signo - 1))); -#endif - __signo = signo; - EM_trap(__traps[signo]); -} - -int -sigtrp(trapno, signo) -{ - /* Let Unix signal signo cause EM trap trapno to occur. - If trapno = -2, restore default, - If trapno = -3, ignore. - Return old trapnumber. - Careful, this could be -2 or -3; But return value of -1 - indicates failure, with error number in errno. - */ - extern int errno; - void (*ctch)() = __ctchsig; - void (*oldctch)(); - int oldtrap; - - if (signo <= 0 || signo >= sizeof(__traps)/sizeof(__traps[0])) { - errno = EINVAL; - return -1; - } - - if (trapno == -3) - ctch = SIG_IGN; - else if (trapno == -2) - ctch = SIG_DFL; - else if (trapno >= 0 && trapno <= 252) - ; - else { - errno = EINVAL; - return -1; - } - - oldtrap = __traps[signo]; - - if ((oldctch = signal(signo, ctch)) == (void (*)())-1) /* errno set by signal */ - return -1; - - else if (oldctch == SIG_IGN) { - signal(signo, SIG_IGN); - } - else __traps[signo] = trapno; - - return oldtrap; -} -#endif Index: trunk/minix/lib/ack/libm2/stackprio.c =================================================================== --- trunk/minix/lib/ack/libm2/stackprio.c (revision 9) +++ (revision ) @@ -1,27 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: Dummy priority routines - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/stackprio.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -static unsigned prio = 0; - -stackprio(n) - unsigned n; -{ - unsigned old = prio; - - if (n > prio) prio = n; - return old; -} - -unstackprio(n) - unsigned n; -{ - prio = n; -} Index: trunk/minix/lib/ack/libm2/store.c =================================================================== --- trunk/minix/lib/ack/libm2/store.c (revision 9) +++ (revision ) @@ -1,43 +1,0 @@ -/* - (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - See the copyright notice in the ACK home directory, in the file "Copyright". -*/ - -/* - Module: store values from stack, byte by byte - Author: Ceriel J.H. Jacobs - Version: $Header: /cvsup/minix/src/lib/ack/libm2/store.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#include - -#ifndef EM_WSIZE -#define EM_WSIZE _EM_WSIZE -#define EM_PSIZE _EM_PSIZE -#endif - -#if EM_WSIZE==EM_PSIZE -typedef unsigned pcnt; -#else -typedef long pcnt; -#endif - -store(siz, addr, p) - register char *addr; - register pcnt siz; -{ - /* Make sure, that a value with a size that could have been - handled by the LOI instruction is handled as if it was - loaded with the LOI instruction. - */ - register char *q = (char *) &p; - char t[4]; - - if (siz < EM_WSIZE && EM_WSIZE % siz == 0) { - /* as long as EM_WSIZE <= 4 ... */ - if (siz != 2) TRP(M2_INTERNAL); /* internal error */ - *((unsigned short *) (&t[0])) = *((unsigned *) q); - q = &t[0]; - } - while (siz--) *addr++ = *q++; -} Index: trunk/minix/lib/ack/libm2/ucheck.c =================================================================== --- trunk/minix/lib/ack/libm2/ucheck.c (revision 9) +++ (revision ) @@ -1,65 +1,0 @@ -/* - * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. - * See the copyright notice in the ACK home directory, in the file "Copyright". - * - * - * Module: CARDINAL operations with overflow checking - * Author: Ceriel J.H. Jacobs - * Version: $Header: /cvsup/minix/src/lib/ack/libm2/ucheck.c,v 1.1 2005/10/10 15:27:46 beng Exp $ -*/ - -#ifndef EM_WSIZE -#define EM_WSIZE _EM_WSIZE -#endif -#ifndef EM_LSIZE -#define EM_LSIZE _EM_LSIZE -#endif - -#include - -#define MAXCARD ((unsigned)-1) -#if EM_WSIZE < EM_LSIZE -#define MAXLONGCARD ((unsigned long) -1L) -#endif - -adduchk(a,b) - unsigned a,b; -{ - if (MAXCARD - a < b) TRP(M2_UOVFL); -} - -#if EM_WSIZE < EM_LSIZE -addulchk(a,b) - unsigned long a,b; -{ - if (MAXLONGCARD - a < b) TRP(M2_UOVFL); -} -#endif - -muluchk(a,b) - unsigned a,b; -{ - if (a != 0 && MAXCARD/a < b) TRP(M2_UOVFL); -} - -#if EM_WSIZE < EM_LSIZE -mululchk(a,b) - unsigned long a,b; -{ - if (a != 0 && MAXLONGCARD/a < b) TRP(M2_UOVFL); -} -#endif - -subuchk(a,b) - unsigned a,b; -{ - if (b < a) TRP(M2_UUVFL); -} - -#if EM_WSIZE < EM_LSIZE -subulchk(a,b) - unsigned long a,b; -{ - if (b < a) TRP(M2_UUVFL); -} -#endif