======================================================================= 1 === Date: Mon, 1 Jun 92 16:21:55 GMT From: Darren New Subject: Re: _NILCHECKB(e) > However, I agree that you have to do explicit [NIL] checks > if you want to be 100% safe. Of course, since the language does not guarantee that pointers will be initialized to NIL anyway, this is really a relatively minor part of the problem, IMHO. Since it is entirely possible to use an uninitialized pointer and get valid but incorrect results anyway, the fact that 100% of the time you explicitly assign a NIL to a pointer and then use it later by mistake would seem to be a smaller part of the problem, yes? -- Darren ======================================================================= 2 === Date: Mon, 1 Jun 1992 16:29:31 GMT From: templ@inf.ethz.ch (Josef Templ) Subject: Oberon poll This is an informal poll for usage of Oberon. Please respond by e-mail to templ@inf.ethz.ch. Replies should include Organisation, Machine, OS, purpose, satisfaction, comments e.g.: MIT, Sparcstation1, SUNOS 4.1.1, education, high, none I'll post a summary if I get enough replies. - Josef Templ (the usual disclaimer) ======================================================================= 3 === Date: 1 Jun 92 14:07:45 GMT From: marlowe@paul.rutgers.edu (Thomas Marlowe) Subject: Re: Side Effects & Language Design (A Poll) The proposal that modules or calls must be annotated with the variables required to be initialized on the call, and those which can be modified internally, or whose modified value will be passed back to the caller, is very reminiscent of work done on the language Hermes at IBM Watson. there is a comp.lang.hermes newsgroup; alternatively, andy lowry (lowry), rob strom (strom) or art goldberg (artg) at watson.ibm.com can answer your questions. tom marlowe ======================================================================= 4 === Date: Mon, 1 Jun 92 14:46 GMT From: David Bruce <"ISIS::dib%hermes.mod.uk"@relay.MOD.UK> Subject: Re: Side Effects & Language Design (A Poll) I think that prohibiting side-effects would be a mistake. Fortunately, what you describe is not prohibition, but rather one way of taming or controlling them; this is a wholly laudable goal. There have been a number of other attempts at this, most of which are intended either to allow the integration of imperative and functional programming styles to be combined, or to ease the exploition of parallelism. I guess these are both based upon reasoning about code. An example is the FX work of Gifford's group at MIT. In the FX languages, any effects of an expression are inferred and form part of its type; such effects can be abstracted over and in many cases `masked' (when it can be shown that they can not actually be observed). (In fact, much of FX's power comes from the use of regions rather than variables, because aliasing and structures including internal pointers can be handled.) Nevertheless, there are still some problems wrt the kind of "implementation details" that you mention. For example, it is impossible in general to distinguish between caching (as in your factorial example) and significant changes of internal state (such as updating the seed of a pseudo-random number generator), but different program transformations are appropriate in each case. The seriousness of this problem is particularly pronounced when the possibility of concurrency is introduced. I have been working on these and other related topics for the last year, but at low effort because of other commitments. I would therefore be very interested in the approach that you mention. David Bruce Architectures Division, Defence Research Agency post: DRA Malvern, St Andrews Road, Malvern, Worcestershire WR14 3PS, ENGLAND email: dib%hermes.mod.uk@relay.mod.uk (internet) phone: +44 684 895112 fax: +44 684 89{4303|4389|4540} -------- ======================================================================= 5 === Date: Mon, 1 Jun 92 21:10:51 GMT From: muller@src.dec.com (Eric Muller) Subject: Moudla-3 FAQ Archive-name: Modula-3-faq Last-modified: Jun 1 1992 MODULA-3 FAQ ============ What is Modula-3 ? The goal of Modula-3 is to be as simple and safe as it can be while meeting the needs of modern systems programmers. Instead of exploring new features, we studied the features of the Modula family of languages that have proven themselves in practice and tried to simplify them into a harmonious language. We found that most of the successful features were aimed at one of two main goals: greater robustness, and a simpler, more systematic type system. Modula-3 descends from Mesa, Modula-2, Cedar, and Modula-2+. It also resembles its cousins Object Pascal, Oberon, and Euclid. Modula-3 retains one of Modula-2's most successful features, the provision for explicit interfaces between modules. It adds objects and classes, exception handling, garbage collection, lightweight processes (or threads), and the isolation of unsafe features. Is Modula-3 a superset of Modula-2 ? No; valid Modula-2 programs are not valid Modula-3 programs. Where can I get a description of Modula-3 ? The definition of Modula-3 is contained in: System Programming with Modula-3 Edited by Greg Nelson Prentice Hall Series in Innovative Technology ISBN 0-13-590464-1 L.C. QA76.66.S87 1991 also known as SPwM3. Sam Harbison has written a book about Modula3: Modula-3 Samuel P. Harbison Prentice Hall, 1992 ISBN 0-13-596396-6 as well as an overview article, "Modula-3", in Byte, Vol. 15, Number 12, October 1990, p 385. Where can I get information on Modula-3 ? There is a Usenet newsgroup, comp.lang.modula3. The archives of that group are available via anonymous ftp from gatekeeper.dec.com in pub/DEC/Modula-3/comp.lang.modula3. If you do not have access to Usenet, there is a relay mailing list; send a message to m3-request@src.dec.com to be added to it. Also, Pine Creek Software publishes a free newsletter and various announcements about Modula-3 products and activities. To be added to their mailing list, send email or US mail to: Pine Creek Software Suite 300 305 South Craig Street Pittsburgh, PA 15213 Phone & Fax: [1] (412) 681 9811 Email: modula3@bert.pinecreek.com Where can I get an implementation ? There is only one implementation available today. It has been built by SRC and is available via anonymous ftp from gatekeeper.dec.com in pub/DEC/Modula-3/release. Contributed software can be found in pub/DEC/Modula-3/contrib. The current version, 2.06, implements the language defined in SPwM3. There are versions for the following machines: AIX386 IBM PC running AIX/PS2, AP3000 Apollo DN4500 running Domain/OS ARM Acorn R260 running RISC iX 1.21 DS3100 DECstation 3100 and 5000 running Ultrix 4.0 and 4.2 HP300 HP 9000/300 running HP-UX 8.0 IBMR2 IBM R6000 running AIX 3.1, IBMRT IBM RT running IBM/4.3, NEXT NeXT running ? SPARC SPARCstation running SunOS 4.1.x SUN3 SUN3 running SunOS UMAX Encore Multimax running UMAX 4.3 (R4.1.1) VAX VAX running Ultrix 3.1 SRC Modula-3 includes a user manual, compiler, runtime library, some libraries and a few other goodies (see below). The compiler generates C as an intermediate language and should be fairly easy to port. Except for the very lowest levels of the thread implementation, the entire system is written in Modula-3. What if I don't have ftp access ? You can contact Pine Creek Software (see the address above). Can I contribute Modula-3 software ? Certainly. Send us what you are willing to share, be it programs, libraries or other things. We'll put them in the distribution. -- Eric. ======================================================================= 6 === Date: 1 Jun 92 22:08:50 GMT From: mdixon@parc.xerox.com (Mike Dixon) Subject: Side Effects & Language Design (Followup) I've received lots of interesting replies to my original message, which I greatly appreciate. There are several points that were brought up by a number of the respondents, so I think it's worth responding to them more broadly... 1. Why not use scoping mechanisms to restrict side effects? (e.g. deal with the caching problem by using variables that are local to a module or to an object) This is an important technique and clearly the right way to deal with many of the simple cases, but it doesn't generalize to side effects on state other than programming-language variables. Consider, for example, side effects to specialized hardware registers, file system state, network connection status, or other external state. Although Euclid and Turing did not deal with these cases explicitly, I believe their general approach can be naturally extended to deal with many of them. 2. Side effects are too useful to be eliminated altogether. I completely agree. What I really think we need is some means for declaring each procedure's side effects, together with compiler mechanisms for checking that (a) the declarations are correct, and (b) the side effects are "benign", i.e. they do not interfere with the behavior of the procedure's caller. Also, there is some confusion because pseudo-functional languages like Lisp tend to use the term "side effect" for *all* state changes. I am instead using the term more in the spirit of imperative languages like Euclid and Turing, which distinguish between the effects that are part of a procedure's interface and the side effects that result from its implementation. 3. FX does something like this. Several people mentioned FX (a Lisp-like language developed by Gifford et al). FX's approach to side effects is very similar to that of Euclid/Turing; each procedure's interface (a type in FX) must carry complete information about state changes that are potentially visible to its caller. Like Euclid/Turing, FX allows procedures to introduce local state; changes to local state are guaranteed to be invisible to the procedure's caller (FX calls this "effect masking"). FX declares effects in terms of "regions", which correspond to zones in Euclid/Turing. FX augments Euclid/Turing's 'read' and 'write' modes to include an 'allocate' mode. Like Euclid/Turing, FX does not distinguish between state changes that are part of a procedure's "ideal" interface and those that result from a particular implementation's details. -- .mike. ======================================================================= 7 === Date: 1 Jun 92 22:30:27 GMT From: mdixon@parc.xerox.com (Mike Dixon) Subject: Side Effects & Language Design (Another Example) Here is another example, which may help to clarify some of the issues. Consider a simple function which maps error numbers to error messages, something like function msg(in e:Error_Num) returns String; If this function is implemented with a simple lookup table in program memory, it will have no side effects and we have no problems. But suppose the number of error messages is large, and we decide to store them in a file. Now a call to msg may open this file, which may in turn cause a variety of other state changes, e.g. - On a system with removable media, the disk containing the file may need to be mounted (e.g. the Mac stops & says "please insert System floppy"). - If the file is stored on a server, we may need to establish a connection to the server, which involves changes to various kinds of network state (and may even involve dialling a modem). In most languages these state changes will be undeclared side effects. Most of the time they will cause no problems, but occasionally they may bite an unsuspecting client of the msg function who depends on the side-effected state. (For example, an early version of the Macintosh OS had a bug of this sort that would occasionally cause the system disk to be reformatted!) If the Euclid/Turing/FX approach were applied to external state, the implementation of msg would have to declare the side-effected state as part of its interface, e.g. (in pseudo-Turing): function msg(in e:Error_Num) return String import (in file_system, inout mounted_disks) This makes it easier for a client of msg to anticipate the potential problems, but adds implementation-specific details to the interface. If we keep the side-effect information in the procedure's declaration, but keep it separate from the procedure's "ideal" effects, we get two advantages: a) it is clear which effects can be counted on by the client, and which are just artifacts of the current implementation; and b) with some additional analysis, the compiler can identify cases in which a procedure's side effects may change the behavior of one of its clients (aka "bugs"). -- .mike. ======================================================================= 8 === Date: 1 Jun 92 21:49:52 GMT From: n8243274@henson.cc.wwu.edu (S. Lee ODEGARD) Subject: lexically directed comments I propose that the thorny art of a compiler's error recovery can by assisted by special-purpose comments. I illustrate this with what I hope are two excellent examples. A _lexical comment_ describes an ordinary comment in the brackets (* and *), bu t beginning with a particular keyword. It marks items in the specification that can be mechanically verified against some stated lexical or syntax property. The pragma COMMENT at the beginning of the program declares all of the lexical comment keywords employied in it. I shall attempt to specify two of these: OF and COVERS. Their use in a program is declared with the pragma like this: MODULE Example EXPORTS MAIN <* COMMENT OF, COVERS *> ; ----- COVERS ----- Early in the program, I declare some procedure types, say: TYPE Tprodu = PROCEDURE () : REFANY RAISES { E, Thread.Alerted } ; Tmodif = PROCEDURE ( from : REFANY ) : REFANY RAISES { E, Thread.Alerted } ; Tconsu = PROCEDURE ( of : REFANY ) RAISES { E, Thread.Alerted } ; Later on in the same program I declare some procedures that accept those types, say PROCEDURE Lprodu ( into : vocab.T ; name : TEXT ; this : Tprodu ) = ... PROCEDURE Lmodif ( into : vocab.T ; name : TEXT ; this : Tmodif ) = ... PROCEDURE Lconsu ( into : vocab.T ; name : TEXT ; this : Tconsu ) = ... Now, finally, I wish to define some procedures that I can pass into these procedures. It would help me and the compiler to know right away if these procedures are not covered by a particular declared type. The lexical comment COVERS permits me to explicitly state this. It is to appear after the RAISES clause but before the "=": PROCEDURE dump ( of : REFANY ) RAISES { E, Thread.Alerted } (* COVERS Tconsu *) = BEGIN Wr.PutText( Stdio.stdout, "(" & Fmt.Ref( of ) & ":" & Fmt.Int( TYPECODE( of ) ) & ")" ) ; END dump ; Now, if I mung up the declaration of /dump/ so it is not covered by a /Tconsu/, I will know it closer to the source of the error, rather then when I attempt to pass it into procedure (which is not in error), say pages later at: BEGIN Lconsu( go.V, "dump", dump ) ; ----- OF ----- Any END closes a particular scope. It would often be useful to assert, Ada-style, the statement defining the scope that is being closed: PROCEDURE big_and_ugly() = BEGIN WHILE I_cannot_go_home DO INC( entries ) ; do_all_kinds_of_other_junk() ; END (* OF WHILE *) ; Thus any END except those closing a procedure block or main module block, (particulary recommended after pages of indented blocks), can _optionally_ be followed by a statement of what is being ENDed. However, I propose to do Ada one better. FOR and WITH statements, that declare readonly temporary variables, can be ENDed similarly but optionally also stating those temporary variables no longer available: PROCEDURE little_and_pretty() = BEGIN FOR level := 0 TO EntriesToCheck DO IF S.in > level THEN (* entry is on stack *) WITH entry = S.of[ S.in - level - 1 ] DO (* examine it *) IF match[ level ] # 0 THEN RAISE E END ; do_pages_of_technical_stuff_so_I_am_now_lost() ; END (* OF WITH entry *) END (* OF IF *) END (* OF FOR level *) END little_and_pretty() ; I chose not to triply indent /pages_of_technical_stuff/, so the program would lay out better. I even propose to allow optional lexical labelling of block statements via ordinary comments after a DO or THEN with reference to those labels permitted in the lexical comments, to support a favorite style of mine: PROCEDURE roll_sideways() = BEGIN FOR IR := FIRST( G ) TO LAST( G ) DO (* process piecewise each routine *) IF G[ IR ] = NIL THEN (* nothing to process *) RAISE E ; END (* OF IF THEN (* nothing to process *) *) IF ISTYPE( G[ IR ], Entry ) THEN (* Entry type *) WITH WA = NARROW( G[ IR ], Entry ) DO WA.in( WA.of, S ) END ; ELSE (* load parameter onto stack *) S.of[ S.in ] := G[ IR ] ; INC( S.in ) ; END (* OF IF ELSE (* load parameter onto stack *) *) ; END (* OF FOR IR DO (* process piecewise each routine *) *) ; END roll_sideways() ; I find the repeating of these long labels permits me to quickly find the closing block in a text editor with a simple text search --S. Lee ODEGARD 13722 Aurora Ave N Seattle, WA 98133-6913 USA ======================================================================= 9 === Date: Mon, 1 Jun 92 15:29:55 CDT From: shrinand desai Subject: porting modula-3 on pc(ms dos) Hello, I have started the task of porting modula-3 on ibm-pc(and compatibles) for 386 and above(to take advantage of 32 bit memory model and paging etc) If you happen to know people who are also working on the similiar project can you let me know? I would like to exchange ideas with them(particulary, on implementation of garbage collection and threads). Thanks in advance. p.s. I am a student here at university of north texas. --Shri -- Shrinand Desai | shri@sol.acs.unt.edu | If I don't care where I am, I ain't lost. or shri@vaxb.acs.unt.edu | ======================================================================= 10 === Date: Tue, 2 Jun 92 9:45:56 EST From: Peter Edwards Subject: Re: Oberon poll G'day Josef, > This is an informal poll for usage of Oberon. Is this an appropriate thing to post to a newsgroup/mailing list set up for Modula-3? Perhaps it should be directed to an Oberon one, if it exists. (If it doesn't, maybe you should start one?) Thanks - Hooroo - Peter Voice: +61-3-6479833 or 6694389 FAX: +61-3-6479835 US: psde@cray.com or peter.edwards@cray.com Oz: psde@bom.gov.au UUCP: ...!uunet!cray!psde Delphi: PSDE ======================================================================= 11 === Date: 2 Jun 92 03:20:54 GMT From: n8243274@gonzo.cc.wwu.edu (S. Lee ODEGARD) Subject: fun time: Modula-3 program that output its own Modula-3 source. In the journal of Ada, Pascal, and Modula-2, a few years back, Saim Ural published a letter to the editor. In that letter, Ural included a self-contained program I wrote in Modula-2 that dumps out its own source code without using any non-character character representations. Please find included a program that does those things for Modula-3. m3 -why -w1 e.m3 -- compile the included file -> compile e.m3 -> link a.out a.out > f.m3 -- copy its output to f.m3 diff e.m3 f.m3 -- compare that to the original source, exactly the same! ------------------------------------------------------------------------------- - (* Output self code to Stdio.stdout. -- S. Lee ODEGARD, Western Washington University *) MODULE put_selfcode EXPORTS Main ; IMPORT Text, Wr, Thread, Stdio ; CONST Lines = 50 ; Middle = 8 ; Source = ARRAY[ 0 .. Lines-1 ] OF TEXT{ "(* Output self code to Stdio.stdout.", " -- S. Lee ODEGARD, Western Washington University *)", "", "MODULE put_selfcode EXPORTS Main ;", "IMPORT Text, Wr, Thread, Stdio ;", "CONST", " Lines = 50 ; Middle = 8 ;", " Source = ARRAY[ 0 .. Lines-1 ] OF TEXT{", " .. } ;", "PROCEDURE wquote( from : TEXT ) =", "<* UNUSED *> CONST newline = \"\\n\" ;", "VAR c : CHAR ;", "<* FATAL Thread.Alerted, Wr.Failure *>", "BEGIN", " Wr.PutText( Stdio.stdout, \"\\t\\t\\\"\" ) ;", " FOR i := 0 TO Text.Length( from )-1 DO", " c := Text.GetChar( from, i ) ;", " IF c = \'\\\'\' THEN", " Wr.PutText( Stdio.stdout, \"\\\\\\\'\" ) ;", " ELSIF c = \'\\\"\' THEN", " Wr.PutText( Stdio.stdout, \"\\\\\\\"\" ) ;", " ELSIF c = \'\\\\\' THEN", " Wr.PutText( Stdio.stdout, \"\\\\\\\\\" ) ;", " ELSE Wr.PutText( Stdio.stdout,", " Text.FromChar( c ) ) END ;", " END ;", " Wr.PutText( Stdio.stdout, \"\\\",\\n\" ) ;", " Wr.Flush( Stdio.stdout ) ;", "END wquote ;", "", "<* FATAL Thread.Alerted, Wr.Failure *>", "BEGIN", " FOR i := 0 TO Middle-1 DO", " Wr.PutText( Stdio.stdout, Source[ i ] & \"\\n\" ) END ;", " FOR i := 0 TO Lines-1 DO", " wquote( Source[ i ] ) END ;", " FOR i := Middle TO Lines-1 DO", " Wr.PutText( Stdio.stdout, Source[ i ] & \"\\n\" ) END ;", "END put_selfcode.", "", "", "", "", "", "", "", "", "", "", "", .. } ; PROCEDURE wquote( from : TEXT ) = <* UNUSED *> CONST newline = "\n" ; VAR c : CHAR ; <* FATAL Thread.Alerted, Wr.Failure *> BEGIN Wr.PutText( Stdio.stdout, "\t\t\"" ) ; FOR i := 0 TO Text.Length( from )-1 DO c := Text.GetChar( from, i ) ; IF c = '\'' THEN Wr.PutText( Stdio.stdout, "\\\'" ) ; ELSIF c = '\"' THEN Wr.PutText( Stdio.stdout, "\\\"" ) ; ELSIF c = '\\' THEN Wr.PutText( Stdio.stdout, "\\\\" ) ; ELSE Wr.PutText( Stdio.stdout, Text.FromChar( c ) ) END ; END ; Wr.PutText( Stdio.stdout, "\",\n" ) ; Wr.Flush( Stdio.stdout ) ; END wquote ; <* FATAL Thread.Alerted, Wr.Failure *> BEGIN FOR i := 0 TO Middle-1 DO Wr.PutText( Stdio.stdout, Source[ i ] & "\n" ) END ; FOR i := 0 TO Lines-1 DO wquote( Source[ i ] ) END ; FOR i := Middle TO Lines-1 DO Wr.PutText( Stdio.stdout, Source[ i ] & "\n" ) END ; END put_selfcode. ======================================================================= 12 === Date: Tue, 2 Jun 1992 14:42:53 +0200 From: Piet van Oostrum Subject: Re: help with RECORD layout This is on a HP-9000/425 system running the standard C compiler on HP-UX 7.05 and 8.0 (same results). BITS PER BYTE = 8 ALIGNMENTS char=1 short=2 int=2 long=2 float=2 double=2 char*=2 int*=2 func*=2 STRUCTURES Schar: size = 2, offset(a) = 0 Schar_char: size = 2, offset(a) = 0, offset (b) = 1 Schar_short: size = 4, offset(a) = 0, offset (b) = 2 Schar_int: size = 6, offset(a) = 0, offset (b) = 2 Schar_long: size = 6, offset(a) = 0, offset (b) = 2 SIZES OF STRUCT; _ is a bitfield _ c_ s_ i_ l_ 0x01 2 2 4 6 6 0x02 2 2 4 6 6 0x03 2 2 4 6 6 0x04 2 2 4 6 6 0x05 2 2 4 6 6 0x06 2 2 4 6 6 0x07 2 2 4 6 6 0x08 2 2 4 6 6 0x09 2 4 4 6 6 0x0a 2 4 4 6 6 0x0b 2 4 4 6 6 0x0c 2 4 4 6 6 0x0d 2 4 4 6 6 0x0e 2 4 4 6 6 0x0f 2 4 4 6 6 0x10 2 4 4 6 6 0x11 4 4 6 8 8 0x12 4 4 6 8 8 0x13 4 4 6 8 8 0x14 4 4 6 8 8 0x15 4 4 6 8 8 0x16 4 4 6 8 8 0x17 4 4 6 8 8 0x18 4 4 6 8 8 0x19 4 6 6 8 8 0x1a 4 6 6 8 8 0x1b 4 6 6 8 8 0x1c 4 6 6 8 8 0x1d 4 6 6 8 8 0x1e 4 6 6 8 8 0x1f 4 6 6 8 8 0x20 4 6 6 8 8 c_c c__ c__c c_s c__s 0x01 4 2 4 4 4 0x02 4 2 4 4 4 0x03 4 2 4 4 4 0x04 4 2 4 4 4 0x05 4 4 4 4 6 0x06 4 4 4 4 6 0x07 4 4 4 4 6 0x08 4 4 4 4 6 0x09 4 4 6 6 6 0x0a 4 4 6 6 6 0x0b 4 4 6 6 6 0x0c 4 4 6 6 6 0x0d 4 6 6 6 8 0x0e 4 6 6 6 8 0x0f 4 6 6 6 8 0x10 4 6 6 6 8 0x11 6 6 8 6 8 0x12 6 6 8 6 8 0x13 6 6 8 6 8 0x14 6 6 8 6 8 0x15 6 8 8 6 10 0x16 6 8 8 6 10 0x17 6 8 8 6 10 0x18 6 8 8 6 10 0x19 8 10 12 8 12 0x1a 8 10 12 8 12 0x1b 8 10 12 8 12 0x1c 8 10 12 8 12 0x1d 8 10 12 8 12 0x1e 8 10 12 8 12 0x1f 8 10 12 8 12 0x20 8 10 12 8 12 DONE. This is on a HP 9000/750 running HP-UX 8.05 with the standard C compiler: BITS PER BYTE = 8 ALIGNMENTS char=1 short=2 int=4 long=4 float=4 double=8 char*=4 int*=4 func*=4 STRUCTURES Schar: size = 1, offset(a) = 0 Schar_char: size = 2, offset(a) = 0, offset (b) = 1 Schar_short: size = 4, offset(a) = 0, offset (b) = 2 Schar_int: size = 8, offset(a) = 0, offset (b) = 4 Schar_long: size = 8, offset(a) = 0, offset (b) = 4 SIZES OF STRUCT; _ is a bitfield _ c_ s_ i_ l_ 0x01 4 4 4 8 8 0x02 4 4 4 8 8 0x03 4 4 4 8 8 0x04 4 4 4 8 8 0x05 4 4 4 8 8 0x06 4 4 4 8 8 0x07 4 4 4 8 8 0x08 4 4 4 8 8 0x09 4 4 4 8 8 0x0a 4 4 4 8 8 0x0b 4 4 4 8 8 0x0c 4 4 4 8 8 0x0d 4 4 4 8 8 0x0e 4 4 4 8 8 0x0f 4 4 4 8 8 0x10 4 4 4 8 8 0x11 4 4 8 8 8 0x12 4 4 8 8 8 0x13 4 4 8 8 8 0x14 4 4 8 8 8 0x15 4 4 8 8 8 0x16 4 4 8 8 8 0x17 4 4 8 8 8 0x18 4 4 8 8 8 0x19 4 8 8 8 8 0x1a 4 8 8 8 8 0x1b 4 8 8 8 8 0x1c 4 8 8 8 8 0x1d 4 8 8 8 8 0x1e 4 8 8 8 8 0x1f 4 8 8 8 8 0x20 4 8 8 8 8 c_c c__ c__c c_s c__s 0x01 4 4 4 4 4 0x02 4 4 4 4 4 0x03 4 4 4 4 4 0x04 4 4 4 4 4 0x05 4 4 4 4 8 0x06 4 4 4 4 8 0x07 4 4 4 4 8 0x08 4 4 4 4 8 0x09 4 4 8 8 8 0x0a 4 4 8 8 8 0x0b 4 4 8 8 8 0x0c 4 4 8 8 8 0x0d 4 8 8 8 8 0x0e 4 8 8 8 8 0x0f 4 8 8 8 8 0x10 4 8 8 8 8 0x11 8 8 8 8 12 0x12 8 8 8 8 12 0x13 8 8 8 8 12 0x14 8 8 8 8 12 0x15 8 8 8 8 12 0x16 8 8 8 8 12 0x17 8 8 8 8 12 0x18 8 8 8 8 12 0x19 12 12 16 12 16 0x1a 12 12 16 12 16 0x1b 12 12 16 12 16 0x1c 12 12 16 12 16 0x1d 12 12 16 12 16 0x1e 12 12 16 12 16 0x1f 12 12 16 12 16 0x20 12 12 16 12 16 DONE. Piet van Oostrum ======================================================================= 13 === Date: Tue, 2 Jun 92 10:38:47 -0700 From: harbison@bert.pinecreek.com (Sam Harbison) Subject: Re: Moudla-3 FAQ In article <1992Jun1.211051.8341@src.dec.com> you write: >Archive-name: Modula-3-faq >Last-modified: Jun 1 1992 >... > Also, Pine Creek Software publishes a free newsletter and various > announcements about Modula-3 products and activities. To be added > to their mailing list, send email or US mail to: >... >What if I don't have ftp access ? > > You can contact Pine Creek Software (see the address above). >... Eric, You should remove references to Pine Creek from the FAQ. Starting July 1, I won't be publishing the newsletter or providing software on PC disks. My current plans are to ship to you (i.e., SRC) a set of floppy disks and most of my stock of the back issues of the newsletter. I'll then forward requests to you, or anyone you designate. Sam ======================================================================= 14 === Date: 2 Jun 92 12:20:46 GMT From: pk@john.informatik.rwth-aachen.de (Peter Klein) Subject: What about multiple inheritance? Ever since I got interested in Modula-3 (and decided that it would become my new favorite), I wonder that there is obviously no sincere discussion about the fact that Modula-3 offers no multiple inheritance. Recently, Niklaus Wirth was here to propagate the Oberon language. When the point came to multiple inheritance, I had the strongest feeling that he regards it as some kind of gimmick which isn't really useful in everyday programming. Be that as it may, I think multiple inheritance is the only real feature which C++ has in advantage of Modula-3. And for people who consider it essential, it makes C++ the only choice left. Of course, multiple inheritance isn't easy to implement, not to talk about semantical problems. But even if it would be regarded as 'unsafe', I believe that the prospect of having multiple inheritance (some day) would greatly increase the acceptance of Modula-3. Peter Klein E-Mail: pk@rwthi3.informatik.rwth-aachen.de Lehrstuhl fuer Informatik III Tel.: +49/241/80-21320 Ahornstrasse 55 Fax.: +49/241/80-21329 RWTH Aachen D-5100 Aachen Germany ======================================================================= 15 === Date: 2 Jun 92 11:00:20 GMT From: pk@john.informatik.rwth-aachen.de (Peter Klein) Subject: Optimization on SPARC Until recently, I used gcc 1.4 as back end for the SRC modula-3 system (with SunOS 4.1.2). This went quite well. But since we upgraded to 2.1, I can't use optimization anymore. If I build a new compiler from scratch with -O (or -O2), the resulting compiler won't even compile libm3 - it reports "../runtime/src/generic/RT0.i3", line 157: types are not assignable "../runtime/src/generic/RT0.i3", line 158: types are not assignable These lines contain the declaration of two CARDINAL variables with implicit initialization to a zero value. I tried to use Sun cc instead, but this one also failed when used with optimization. In a great program system, it caused a weird behaviour in some places (especially in LOOPHOLEs). Since I know that gcc works fine on a DECstation, I wonder if there are pieces in the SPARC runtime modules which are prone to be optimized into wrong code. Can anybody help? Now for something completely different. Packed Modula-3 types are translated into C bitfields when possible. Now, if I put together several packed type variables into a RECORD, I can't supply components as actual parameters for call-by-reference formals. This is alright from the C's compiler point of view, since it actually demands to take the pointer to a bitfield, which is not allowed in C. But I can't remember that it violates Modula-3 semantics (the error is reported from the C compiler, not from Modula-3!). Shouldn't there be something done about this? Peter Klein E-Mail: pk@rwthi3.informatik.rwth-aachen.de Lehrstuhl fuer Informatik III Tel.: +49/241/80-21320 Ahornstrasse 55 Fax.: +49/241/80-21329 RWTH Aachen D-5100 Aachen Germany ======================================================================= 16 === Date: 2 Jun 92 16:26:20 GMT From: lins@Apple.COM (Chuck Lins ) Subject: Re: What about multiple inheritance? In article pk@john.informatik.rwth-aachen.de (Peter Klein ) writes: >Be that as it may, I think multiple inheritance is the only real feature which >C++ has in advantage of Modula-3. And for people who consider it essential, it >makes C++ the only choice left. MI as defined in C++ is completely a compile-time notion. Thus if you declare a class A, with base classes B and C, for all instances of class A, they will derive from B and C. B' and/or C' (subclasses of B and C respectively) would not be allowed without the programmer writting a whole new class definition (say A') that inherited from B' (and/or C'). By using fields you can get essentially the same effect as MI and still have dynamic behavior at run-time. Using the example above, you would declare class A with two fields b: B and c: C. When instaniating A, initialize b and c to the desired types (subtypes). -- Chuck Lins, Apple Computer, Inc. Oberon-2 Paladin lins@apple.com "Oppression breeds violence" - Front Line Assembly ======================================================================= 17 === Date: Tue, 2 Jun 92 14:38:30 EDT From: wyant@centerline.com Subject: What about multiple inheritance? I disagree about the value of multiple inheritance. People considere essential in C++ until they actually use it. Then they rethink there need for the most part. Multiple interitance gets used for a number of different purposes. I think is more important to disentangle these uses and support them in semantically clean and distinct ways instead of jumping onto the MI bandwagon. As an example, MI is sometimes used for software reuse: composing 2 independent classes into a 3rd class which provides an interface distinct from the original two. I feel this usage is better supported through a more formal class composition tool. Other times MI is used for classes which exhibit 2 distinct behaviors with little or no implementation in common. This may be better supported by some generalization of partial revelations. I think that in general inheritance is far too overhyped as a software construction paradigm. Don't get me wrong, I do believe that inheritance is a valuable addition to programming. I just think in many cases it gets used where other paradigms would be more appropriate. I'd love to see someone explore the use of traits/facets and delegation in an M3-like system. In general, I find I'd like to see what minimal additions to M3 could be made so that it could support dynamic evolution. --geoff ======================================================================= 18 === Date: 2 Jun 92 17:50:46 GMT From: fishkin@Xerox.com (Ken Fishkin) Subject: Re: What about multiple inheritance? In article <68028@apple.Apple.COM>, lins@Apple.COM (Chuck Lins ) writes: > > MI as defined in C++ is completely a compile-time notion. Thus if you declare > a class A, with base classes B and C, for all instances of class A, they will > derive from B and C. B' and/or C' (subclasses of B and C respectively) would > not be allowed without the programmer writting a whole new class definition > (say A') that inherited from B' (and/or C'). Not true. One can merrily subclass B and C at will without paying any attention to A. > > By using fields you can get essentially the same effect as MI and still have > dynamic behavior at run-time. Using the example above, you would declare > class A with two fields b: B and c: C. When instaniating A, initialize b and c > to the desired types (subtypes). Ah, but consider the following. Suppose that class B had one hundred functions defined upon it: B0, B1 ... B99. Suppose that class C had two hundred functions defined upon it: C0, C1 ... C199. Under your solution, in order to fully implement A, I would have to write 300 one-line functions: A.B0 ::= A.b->B0 (pardon my meta-syntax). etc, etc, etc. -- Ken Fishkin fishkin@xerox.com ======================================================================= 19 === Date: 2 Jun 92 21:05:51 GMT From: lins@Apple.COM (Chuck Lins ) Subject: Re: What about multiple inheritance? In article <1992Jun2.175046.658@parc.xerox.com> fishkin@Xerox.com (Ken Fishkin) writes: >In article <68028@apple.Apple.COM>, lins@Apple.COM (Chuck Lins ) writes: >> >> MI as defined in C++ is completely a compile-time notion. Thus if you declar e >> a class A, with base classes B and C, for all instances of class A, they wil l >> derive from B and C. B' and/or C' (subclasses of B and C respectively) would >> not be allowed without the programmer writting a whole new class definition >> (say A') that inherited from B' (and/or C'). > Not true. One can merrily subclass B and C at will without paying >any attention to A. I did not make myself clear. What you cannot do is have an instance(s) of A, which when instaniated inherit from B' and/or C'. The class declaration in C++ explicitly gives the exact names of the classes you inherit from. That's why it's a class. *All* instances of A will multiply inherit from B and C and *never* from B' or C'. This negates the whole advantage of inheritance and polymorphism. > >> >> By using fields you can get essentially the same effect as MI and still have >> dynamic behavior at run-time. Using the example above, you would declare >> class A with two fields b: B and c: C. When instaniating A, initialize b and c >> to the desired types (subtypes). > Ah, but consider the following. Suppose that class B had one hundred >functions defined upon it: B0, B1 ... B99. > Suppose that class C had two hundred functions defined upon it: >C0, C1 ... C199. > Under your solution, in order to fully implement A, I would have >to write 300 one-line functions: > > A.B0 ::= A.b->B0 (pardon my meta-syntax). > etc, etc, etc. If you have a class with 100 functions, i suggest you review your design. If this is difficult to do with the development tools at your disposal, I suspect you look to better development tools. -- Chuck Lins, Apple Computer, Inc. Oberon-2 Paladin lins@apple.com "Oppression breeds violence" - Front Line Assembly ======================================================================= 20 === Date: 2 Jun 92 17:03:08 GMT From: moss@cs.umass.edu (Eliot Moss) Subject: Re: _NILCHECKB(e) >>>>> On 1 Jun 92 16:21:55 GMT, dnew@thumper.bellcore.com (Darren New) said: Darren> Of course, since the language does not guarantee that pointers will be Darren> initialized to NIL anyway, ... Well, in a sense you are right but the language *does* require that every variable, field, etc., contain a *legal value of its type*, and the only reasonable and practical way to satisfy this constraint for REF and OBJECT types is to initialize things to NIL, so in a practical sense, you are probably wrong. I am not aware of how the SRC compiler handles this requirement. Note that good data flow analysis will eliminate many redundant stores of NIL that might be inserted to meet this requirement. -- J. Eliot B. Moss, Assistant Professor Department of Computer Science Lederle Graduate Research Center University of Massachusetts Amherst, MA 01003 (413) 545-4206, 545-1249 (fax); Moss@cs.umass.edu ======================================================================= 21 === Date: 3 Jun 92 08:23:27 GMT From: laverman@cs.rug.nl (Bert Laverman) Subject: Re: Side Effects & Language Design (Another Example) Making all side effects of OS calls visible? Please, NO! The idea of s system call is to hide and abstract. Pulling the side effects out again undoes all this. I _don't_ want to have different versions of the program for systems with only removable disks, as compared to a system with fixed disks. If you request a file, and the OS needs to mount another disk in order to get it, it should take care to restore the situation if files on the replaced disks were active. Dragging in a Mac problem doesn't prove your point. At most it proves a problem of MacOS. Greetings, Bert -- #include Bert Laverman, Dept. of Computing Science, Groningen University Friendly mail to: laverman@cs.rug.nl The rest to: /dev/null ======================================================================= 22 === Date: 3 Jun 92 08:17:26 GMT From: laverman@cs.rug.nl (Bert Laverman) Subject: Re: lexically directed comments Hmmm, There may be an alternative solution that looks unusual, but fits perfectly in the language as described in SPwM3: > TYPE > Tprodu = PROCEDURE () : REFANY RAISES { E, Thread.Alerted } ; > Tmodif = PROCEDURE ( from : REFANY ) : REFANY RAISES { E, Thread.Alerted } ; > Tconsu = PROCEDURE ( of : REFANY ) RAISES { E, Thread.Alerted } ; Remember that a procedure declaration is said to declare a procedure _CONSTANT_. So why not in stead of: > PROCEDURE dump ( of : REFANY ) > RAISES { E, Thread.Alerted } > (* COVERS Tconsu *) = > BEGIN > Wr.PutText( Stdio.stdout, "(" > & Fmt.Ref( of ) & ":" & Fmt.Int( TYPECODE( of ) ) > & ")" ) ; > END dump ; This: CONST dump : Tconsu = BEGIN Wr.PutText( Stdio.stdout, "(" & Fmt.Ref( of ) & ":" & Fmt.Int( TYPECODE( of ) ) & ")" ) ; END dump ; No mistaking possible about the cover, and since a procedure constant's value is its block, this looks like a logical solution. Greetings, Bert -- #include Bert Laverman, Dept. of Computing Science, Groningen University Friendly mail to: laverman@cs.rug.nl The rest to: /dev/null ======================================================================= 23 === Date: Wed, 3 Jun 92 17:58:25 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: is there the equivalent of a BUSYREAD in m3? In article <1992Jun3.134035.3281@henson.cc.wwu.edu>, n8243274@henson.cc.wwu.edu (S. Lee ODEGARD) writes: > I find myself wishing for an equivalent to the BUSYREAD from TTIO of > a Modula-2 implementation here. I am familiar with libm3 but I don't know what BUSYREAD is; can you explain ? > Also, is there a GetCharNoEcho equivalent? Look into the UFileRd module, to discover how to get the file descriptor associated with a reader. Then make the appropriate system call. -- Eric. ======================================================================= 24 === Date: Wed, 3 Jun 92 10:04:47 PDT From: surak!frode (Frode Odegard) Subject: Re: lexically directed comments > Hmmm, There may be an alternative solution that looks unusual, but fits > perfectly in the language as described in SPwM3: > > [..] > > This: > > CONST > dump : Tconsu = > BEGIN > Wr.PutText( Stdio.stdout, "(" > & Fmt.Ref( of ) & ":" & Fmt.Int( TYPECODE( of ) ) > & ")" ) ; > END dump ; > > No mistaking possible about the cover, and since a procedure constant's > value is its block, this looks like a logical solution. Hey! Does this mean I can finally write: PROCEDURE withall (in: Dictionary.T; do: PROCEDURE (entry: Dictionary.Entry)) = BEGIN .. END withall; VAR latin: Dictionary.T; withall (latin, BEGIN Wr.PutText (stdout, entry & "\n") END); :-) - Frode -------------------------------------------------------------------- Odegard Labs, Inc., 100 Bush St., Suite 625, San Francisco, CA 94104-3909, USA; +1-415-434-4242, +1-415-434-4243(fax), frode@odegard.com(internet) * - * - * - * There are two kinds of solar-heat systems: "passive" systems collect the sunlight that hits your home, and "active" systems collect the sunlight that hits your neighbors' homes, too. -- Dave Barry, "Postpetroleum Guzzler" ======================================================================= 25 === Date: 3 Jun 92 13:40:35 GMT From: n8243274@henson.cc.wwu.edu (S. Lee ODEGARD) Subject: is there the equivalent of a BUSYREAD in m3? I find myself wishing for an equivalent to the BUSYREAD from TTIO of a Modula-2 implementation here. Does anyone familiar with libm3 know of an equivalent? Also, is there a GetCharNoEcho equivalent? --SLO ======================================================================= 26 === Date: Wed, 3 Jun 92 22:35:44 GMT From: mjordan@src.dec.com (Mick Jordan) Subject: Re: What about multiple inheritance? I have an example of MI from the AST specification for Modula-3. Identifiers belong to the class "ID", which carries the attribute denoting the name. A subtype of this class is "USED_ID", denoting identifier occurrences, which, at the semantic level, carries the attribute that denotes the binding of the occurrence to the definition. There is also a class "EXP" denoting expressions, which carries an attribute specifying the "type". One of the subtypes of this class, "Exp_used_id", is an identifier occurrence, but this is impossible since it is already a subtype of "USED_ID". You could "solve" this by copying the attributes of "USED_ID" directly into an "Exp_used_id", but then you cant pass such things to procedures taking "USED_ID"s as arguments. And if you add new attributes to a "USED_ID", you have to remember to propagate them. It is easy to forget. There are other examples. The other branch of the "ID" class is for identifier definitions, and these do not fall into a tree structure when you consider notions such as "typed", "initialised", "redefined", all of which are relevant notions from the static semantics. I chose a number of ad hoc solutions to this problem in the AST design. In particular I often add an attribute whose type is the class I want to multiply inherit. This avoids forgetting to propagate new attributes and allows one to pass an instance as a parameter to either supertype. E.g. TYPE Exp_used_id = EXP OBJECT vUSED_ID: USED_ID; (* other attributes *) END; The principal problem is that attributes inherited from common supertypes of "EXP" and "USED_ID" are duplicated, which in this case I dont want. One also ca nt use "ISTYPE(n, USED_ID)"; instead you need a procedure which explicitly TYPECAS Es an "Exp_used_id". Note that if the language supported MI directly, it would hav e to handle this in the general case, which is non-trivial. Mick Jordan ======================================================================= 27 === Date: Tue, 2 Jun 92 23:08:07 GMT From: ggf@saifr00.cfsat.honeywell.com (Gary Frederick) Subject: Re: Optimization on SPARC I tried to build m3 with a gcc that is around 2.0 and had it blow up in: >RecordType.m3:166: internal error--unrecognizable insn: This is on a Sun also. Has anyone got m3 and gcc 2.1 talking? Gary . ======================================================================= 28 === Date: 3 Jun 1992 21:26:31 GMT From: chased@rbbb.Eng.Sun.COM (David Chase) Subject: Re: What about multiple inheritance? In article mdixon@parc.xerox.com (Mike Dixon) writ es: >mullens@jamsun.ic.ornl.gov (James A. Mullens) writes: > I also think MI provides some clarity in organizing a complex class > hierarchy. In a project I'm working on now my class heirarchy is > influenced by C++'s strong typing and MI helps me work through that. > Sign me "a C++ user who is not rethinking the need for MI in C++ (yet)". >could you give a few more details? i'm very interested in seeing cases >where MI really helps; like some other posters, i'm unconvinced by the >toy examples that show up in most books. Yes, I'd like to see some good examples. I've had a hell of a time figuring out what MI means in C++, and I don't think I've found a good use for it in two years of C++ programming. My experience has been that subtly tinkering with the declarations (virtual bases vs. not) can change a no-compiler-warnings-working-"Hello world" into a no-compiler-warnings-crashing-"Hello world". This, of course, has always been true to some extent in popular programming languages (for example, returning the address of a local stack-allocated variable), but I don't think we need more of it. David Chase Sun ======================================================================= 29 === Date: Sun, 31 May 92 15:31:51 GMT From: ggf@saifr00.cfsat.honeywell.com (Gary Frederick) Subject: Re: IP for gatekeeper Reading the README, I found gatekeeper.dec.com [16.1.0.2]. (I read that file several times and could not 'see' the number. It was to small...) Gary ======================================================================= 30 === Date: Sun, 31 May 92 13:41:47 GMT From: ggf@saifr00.cfsat.honeywell.com (Gary Frederick) Subject: IP for gatekeeper Someone asked me the IP address of gatekeeper (they do not have access using Internet names I guess). What is the IP? Thanks. Gary ======================================================================= 31 === Date: Wed, 3 Jun 1992 23:23:55 GMT From: mullens@jamsun.ic.ornl.gov (James A. Mullens) Subject: Re: What about multiple inheritance? In article , mdixon@parc.xerox.com (Mike Dixon) wri tes: |> mullens@jamsun.ic.ornl.gov (James A. Mullens) writes: |> |> I also think MI provides some clarity in organizing a complex class |> hierarchy. In a project I'm working on now my class heirarchy is |> influenced by C++'s strong typing and MI helps me work through that. |> |> Sign me "a C++ user who is not rethinking the need for MI in C++ (yet)". |> |> could you give a few more details? i'm very interested in seeing cases |> where MI really helps; like some other posters, i'm unconvinced by the |> toy examples that show up in most books. OK, but keep in mind that the following class hierarchy is partly motivated by C++'s strong type checking. Also, I'm using a C++ compiler without templates. I offer it (humbly) as an example, not as a proof of necessity... Skip to the last paragraph if you find this unbearably boring, it seemed impossible to provide just a few more details :-) I have an application that uses signals acquired via a data acquisition system. Some of my signals are analog (floating point) and some are "discrete" (integers). I compute many more quantities from these signals and (again) some are floating point quantities and some are integers. In all cases, I attach a "quality" flag to these values which indicates whether or not the value is considered to be reliable. I have found, for various reasons, that I might as well have separate classes for the float and int + quality objects, so I have FltQ (float + quality) and IntQ (int + quality). [In another applicatio n I did not do this. I used an embedded object to represent a float or int value and added a quality field; but the way in which analog and discrete signals are handled is sufficiently different that the value of a common class is questionable]. Now, the FltQ/IntQ objects are useful as temporaries in calculations, but I also need to associate more fields with my permanent variables: the time the value was updated, the character id to use when showing the value to the user, etc. The shared part of this is the VarDes class. For obscure reasons, I have a sort of utility class State which I often "mix in" to the hierarchy which keeps track of the state of an object: State | FltQ VarDes IntQ | | | | |---FltQVar--| |--IntQVar---| Variables representing analog and discrete signals have even more information associated with them (the id of the instrument they were acquired from, the data acquistion point, etc). Some of this is also shared by the analog and discrete signals, and this information is in class Signal. Class State is also a base class of Signal so that the state of the Signal part of the object can be tracked (State is a virtual base class): The tree looks like: State(1) | FltQ VarDes IntQ | | | | |---FltQVar--| |--IntQVar---| | | | State(2) | | | | | Signal | | | | | | | | | AnalogSignal DiscreteSignal If I had not decided to keep float/int variables separately this would have been done with single inheritance, something like: State (keep track of object status) | VarQ (float/int + quality) | VarQDes (VarQ + VarDes stuff) | VarQDesSignal (VarQDes + Signal stuff) except that I'd really want to derive VarQDes from VarQ and State, instead of basing the hierarchy on State, because VarQ can't use the State class stuff. I could modify VarQDes and VarQDesSignal to keep track of their own states, and leave State out of the hierarchy, in order to avoid this; I would be reimplementing part of State in VarQDes and VarQDesSignal. In a nutshell, I used MI to implement a hierarchy that made more sense to me in my application rather than forcing a SI hierarchy. Personally, I felt better about writing the State, VarDes, and Signal classes as "standalone" classes that could be arbitrarily "mixed into" other classes where they are needed in the hierarchy. (Can you tell I've used Lisp's Flavor system? :-) To me, it's a more useful and cleaner way to use classes. But I'd like to hear about alternatives. jim mullens mullens@jamsun.ic.ornl.gov (128.219.64.31) voice: 615-574-5564 ======================================================================= 32 === Date: Wed, 3 Jun 1992 22:17:28 GMT From: fishkin@Xerox.com (Ken Fishkin) Subject: Re: What about multiple inheritance? In article , chased@rbbb.Eng.Sun.COM (David Ch ase) writes: > In article mdixon@parc.xerox.com (Mike Dixon) wr ites: [re MI in C++] > >could you give a few more details? i'm very interested in seeing cases > >where MI really helps; like some other posters, i'm unconvinced by the > >toy examples that show up in most books. > > Yes, I'd like to see some good examples. I've had a hell of a time > figuring out what MI means in C++, and I don't think I've found a good > use for it in two years of C++ programming. For what it's worth, in a previous life I worked on a middling-size C++ project (about 100K lines, 6 person-years development). After some to-ing and fro-ing, we wound up with zero uses of MI. Overall, we were happy with this decision: the only problem, as I alluded to in an earlier post, is that you have to do more work to track class changes. -- Ken Fishkin fishkin@xerox.com ======================================================================= 33 === Date: Wed, 3 Jun 1992 18:33:27 GMT From: mullens@jamsun.ic.ornl.gov (James A. Mullens) Subject: Re: What about multiple inheritance? In article <9206021838.AA10126@riposte>, wyant@centerline.com writes: |> I disagree about the value of multiple inheritance. People considere |> essential in C++ until they actually use it. Then they rethink there |> need for the most part. Multiple interitance gets used for a number |> of different purposes. I think is more important to disentangle these |> uses and support them in semantically clean and distinct ways instead |> of jumping onto the MI bandwagon. As an example, MI is sometimes used |> for software reuse: composing 2 independent classes into a 3rd class |> which provides an interface distinct from the original two. I feel this |> usage is better supported through a more formal class composition |> tool. Other times MI is used for classes which exhibit 2 distinct behaviors |> with little or no implementation in common. This may be better supported |> by some generalization of partial revelations. |> |> I think that in general inheritance is far too overhyped as a software |> construction paradigm. Don't get me wrong, I do believe that inheritance |> is a valuable addition to programming. I just think in many cases it |> gets used where other paradigms would be more appropriate. I'd love to |> see someone explore the use of traits/facets and delegation in an |> M3-like system. In general, I find I'd like to see what minimal additions |> to M3 could be made so that it could support dynamic evolution. [maybe I can learn something here...] One thing comes to mind. In a strongly-type language like C++, MI helps. With class A, class B, and class C derived from A & B, C can take messages as if it were an A or a B. In languages without C++'s strong typing MI doesn't make as big a difference here. The "compiler" would not complain abo ut sending A & B messages to an object declared as a C even if C were not derived from A & B. At most it would require that C handle those messages (i.e., provide functions/methods with the same name). (Smalltalk would not complain until an unhandled message was detected at runtime). I'm not familiar enough with Modula-3 to know if MI would be an advantage. I also think MI provides some clarity in organizing a complex class hierarchy. In a project I'm working on now my class heirarchy is influenced by C++'s stron g typing and MI helps me work through that. Sign me "a C++ user who is not rethinking the need for MI in C++ (yet)". jim mullens mullens@jamsun.ic.ornl.gov (128.219.64.31) voice: 615-574-5564 ======================================================================= 34 === Date: 3 Jun 92 18:15:26 GMT From: mdixon@parc.xerox.com (Mike Dixon) Subject: Re: Side Effects & Language Design (Another Example) laverman@cs.rug.nl (Bert Laverman) writes: Making all side effects of OS calls visible? Please, NO! The idea of a system call is to hide and abstract. Pulling the side effects out again undoes all this. I _don't_ want to have different versions of the program for systems with only removable disks, as compared to a system with fixed disks. If you request a file, and the OS needs to mount another disk in order to get it, it should take care to restore the situation if files on the replaced disks were active. Dragging in a Mac problem doesn't prove your point. At most it proves a problem of MacOS. Some language designers try to make side effects go away by closing their eyes and sticking their fingers in their ears, but it doesn't really work. There are at least two good reasons why people write procedures with side effects: a) Sometimes it's more efficient. I'm not just talking about saving a few machine cycles here and there; if the Mac OS was implemented the way you propose, the user would have to insert and remove disks very much more often. Similarly, if network connections were brought down after every file access you'd be really unhappy. b) Sometimes it's just not possible to hide the side effects. For example, suppose my procedure needs to use some general I/O controller to interact with a device it's controlling. It may not be possible to read the controller's state back so that I can restore it when I'm done. That's no problem for the programmer, as long as they're careful to ensure that the next piece of code to use the controller makes no assumptions about the state it's in. It shouldn't be a problem for your language, either. Good programmers don't introduce egregious side effects, but there are plenty of cases when good designs involve side effects. Many developments in programming languages have sought to make more and more of the simple memory-based side effects invisible (by taking over aspects of storage management), but this isn't a total solution to the problem. Once you recognize that side effects aren't going to go away, the next question is what your programming language can do to help you with them. If it pretends they'll never happen, it's not likely to help much when they do. If, on the other hand, it provides ways to declare them and does compile-time analysis to check for interactions, you have a real opportunity to make the programmer's like easier. P.S. You don't want to have different versions of your program for machines with and without removable media? Fine. But consider the following scenario: Your OS was designed with fixed media in mind, and sometime later they decide to add removable media. Which of these options would you prefer? 1. To ensure that no side effects are introduced, each access to a file on removable media will require that disk to be inserted and then ejected. 2. The rewritten procedures may side-effect the state of which disk is in the drive. There is no way of indicating this in the programming language. Programs that only do high-level access (in terms of file descriptors) are probably unaffected, but programs that do lower-level access (e.g. the Mac disk formatter) may break in unexpected ways. 3. The rewritten procedures may side-effect the drive state, and this is declared in the programming language. As before, most programs are unaffected (since they do not depend on the side-effected state), but programs that will be affected (like the formatter) now get a compile-time error (indicating that that code needs to be rethought). -- .mike. ======================================================================= 35 === Date: 3 Jun 92 19:23:39 GMT From: mdixon@parc.xerox.com (Mike Dixon) Subject: Re: What about multiple inheritance? mullens@jamsun.ic.ornl.gov (James A. Mullens) writes: I also think MI provides some clarity in organizing a complex class hierarchy. In a project I'm working on now my class heirarchy is influenced by C++'s strong typing and MI helps me work through that. Sign me "a C++ user who is not rethinking the need for MI in C++ (yet)". could you give a few more details? i'm very interested in seeing cases where MI really helps; like some other posters, i'm unconvinced by the toy examples that show up in most books. -- .mike. ======================================================================= 36 === Date: Wed, 3 Jun 1992 23:54:57 GMT From: mullens@jamsun.ic.ornl.gov (James A. Mullens) Subject: Re: What about multiple inheritance? In article , chased@rbbb.Eng.Sun.COM (David Ch ase) writes: |> In article mdixon@parc.xerox.com (Mike Dixon) w rites: |> >mullens@jamsun.ic.ornl.gov (James A. Mullens) writes: |> > I also think MI provides some clarity in organizing a complex class |> > hierarchy. In a project I'm working on now my class heirarchy is |> > influenced by C++'s strong typing and MI helps me work through that. |> |> > Sign me "a C++ user who is not rethinking the need for MI in C++ (yet)" . |> |> >could you give a few more details? i'm very interested in seeing cases |> >where MI really helps; like some other posters, i'm unconvinced by the |> >toy examples that show up in most books. |> |> Yes, I'd like to see some good examples. I've had a hell of a time |> figuring out what MI means in C++, and I don't think I've found a good |> use for it in two years of C++ programming. My experience has been |> that subtly tinkering with the declarations (virtual bases vs. not) |> can change a no-compiler-warnings-working-"Hello world" into a |> no-compiler-warnings-crashing-"Hello world". This, of course, has |> always been true to some extent in popular programming languages (for |> example, returning the address of a local stack-allocated variable), |> but I don't think we need more of it. I know what you're talking about. A buggy implementation of MI is worse than none at all. A bugless implemenation of an overly-complicated MI scheme is not much better. Here's a question: Is is possible to do a simple *and* useful implementation of MI? jim mullens mullens@jamsun.ic.ornl.gov (128.219.64.31) voice: 615-574-5564 ======================================================================= 37 === Date: Thu, 4 Jun 1992 15:11:21 GMT From: wyant@riposte.com (Geoff Wyant) Subject: Re: What about multiple inheritance? ..Preliminary material gratuitously elided... > To make myself clear, here's an example. Suppose I write an abstract data > type for graphs. Now I want to augment it in several distinct ways, like > node-labels, edge-labels, attributes or weights. If I'm not completetly > wrong, I would make subclasses for each of them. Finally, I have graph-like > structures in my system, like abstract syntax graphs or binary trees. This > is exactly the point where I would like to write something like > > TYPE AbstractSyntaxGraph = NodeLabeledGraph, EdgeLabeledGraph, > AttributedGraph OBJECT ... END; > or > > TYPE BinaryTree = EdgeLabeledGraph OBJECT ... END; I may be wrong, but I think this points out the confusions that arise when dealing with multiple inheritance. An Abstract syntax graph can be viewed as a graph whose contents are specific to representing abstract syntax. In the above example 3 very different sorts of graphs have been composed in a 4th kind of graph with the hopes that the multiple inheritance system can make some sort of sensible composition. I would have structured this a generic graph with the contents and edge types as parameters to the instantiation. I think that puts much less of a cognitive load on the reader. Multiple inheritance forces the reader to understand the composition algorithms used by the language and requires them mentally go through that composition algorithm before they can understand what a given abstraction really represents. --- Geoff Wyant wyant@centerline.com Centerline Software, Inc. (Formerly Saber Software, Inc) 10 Fawcett Street Cambridge, Ma. 01238 ======================================================================= 38 === Date: 4 Jun 92 12:05:26 GMT From: pk@john.informatik.rwth-aachen.de (Peter Klein) Subject: Re: What about multiple inheritance? wyant@centerline.com writes: >I disagree about the value of multiple inheritance. People considere >essential in C++ until they actually use it. Then they rethink there >need for the most part. Multiple interitance gets used for a number >of different purposes. I think is more important to disentangle these >uses and support them in semantically clean and distinct ways instead >of jumping onto the MI bandwagon. As an example, MI is sometimes used >for software reuse: composing 2 independent classes into a 3rd class >which provides an interface distinct from the original two. I feel this >usage is better supported through a more formal class composition >tool. Other times MI is used for classes which exhibit 2 distinct behaviors >with little or no implementation in common. This may be better supported >by some generalization of partial revelations. Well, I consider the problem strictly from a software engineering point of view. I believe that the first and most important thing is to design a good architecture. Reusability, maintainability, safety and portability are just spin-offs from good architectures. The problem now is to map the architecture to a programming language. This *can* be done with assembler and fortran as well; the architecture will be as good or bad as ever. But that's not the point. I want to have language in which I can express my ideas in a safe, natural and simple way. The language itself should support writing good programs. To make myself clear, here's an example. Suppose I write an abstract data type for graphs. Now I want to augment it in several distinct ways, like node-labels, edge-labels, attributes or weights. If I'm not completetly wrong, I would make subclasses for each of them. Finally, I have graph-like structures in my system, like abstract syntax graphs or binary trees. This is exactly the point where I would like to write something like TYPE AbstractSyntaxGraph = NodeLabeledGraph, EdgeLabeledGraph, AttributedGraph OBJECT ... END; or TYPE BinaryTree = EdgeLabeledGraph OBJECT ... END; >I think that in general inheritance is far too overhyped as a software >construction paradigm. Don't get me wrong, I do believe that inheritance >is a valuable addition to programming. I just think in many cases it >gets used where other paradigms would be more appropriate. I'd love to >see someone explore the use of traits/facets and delegation in an >M3-like system. In general, I find I'd like to see what minimal additions >to M3 could be made so that it could support dynamic evolution. I have no real experience with delegation, but I am afraid that it leads to a somewhat confusing runtime behaviour. And I don't even know what you mean by dynamic evolution (sorry, language paradigms are not my strong point). Chuck Lins writes: >By using fields you can get essentially the same effect as MI and still have >dynamic behavior at run-time. Using the example above, you would declare >class A with two fields b: B and c: C. When instaniating A, initialize b and c >to the desired types (subtypes). I don't agree with that. If I declare A the way you do, there is no subtype relationship between A and B or C. You have to copy and merge the interfaces for B und C to get an interface for A. Ken Fishkin's example might be a little exaggerated, but I don't even want to copy *one* method from B to A. I want to apply B's method to A. Furthermore, in the above example, I want AbstractSyntaxGraph to be *one* graph , not three. In C++, this would be done using virtual classes. I don't find this very convincing; I think if A is a subclass of B and C, which are themselves subclasses of D, A should *never* have two copies if D's data and methods. Peter Klein (pk@rwthi3.informatik.rwth-aachen.de) Lehrstuhl fuer Informatik III RWTH Aachen Germany ======================================================================= 39 === Date: Thu, 4 Jun 92 23:12:43 GMT From: jdd@src.dec.com (John DeTreville) Subject: Re: Modula-3 Users Group Meeting... Reminder: the Modula-3 Users' Group meeting will be held on Tuesday, 16 June 1992, at DEC SRC in Palo Alto. Below, I've attached a copy of the current schedule, and instructions to SRC. The good news is that we have a large number of excellent talks. The bad news is that we will be quite short of extra time. If you are speaking, we will help you keep to the schedule. We do not expect that we will run out of room. Even so, we would appreciate it if you would let us know if you are coming (to help plan lunches, etc.). I've received a large number of requests for copies of the slides, copies of abstracts, etc., from people who are interested in the talks but who cannot attend. If you are speaking, please bring an extra copy of your slides for me to duplicate. Alternatively, feel free to mail me Postscript. If you have a written abstract, please mail that to me too. We will appoint scribes for the reports from the breakout sessions. You will note that the proposed breakout sessions include one on proposed changes to Modula-3 (or to the Modula-3 Report). If you bring changes to discuss, please also bring a prepared position paper. No fancy formatting required, but it would help us plan the best way to discuss the proposals. As always, send mail to mug-meeting@src.dec.com. Cheers, John -------------------- Modula-3 Users' Group Meeting jointly sponsored by Digital Equipment Corporation Systems Research Center and Xerox PARC Computer Science Laboratory 16 June 1992 9:00 AM - 1:00 PM Talks. Bill Kalsow, DEC SRC. "SRC's plans for Modula-3 this year". Eliot Moss, University of Massachusetts at Amherst. "GNU Modula-3". Jim Meehan, DEC SRC. "FormsVBT". Loretta Guarino and Cynthia Hibbard, DEC SRC. Hector demo. Mick Jordan, DEC SRC. "The M3AST toolkit". Dave Nichols, Xerox PARC CSL. "Sun RPC". David Evers, Cambridge University. "Network objects at Cambridge". Greg Nelson, DEC SRC. "Network objects at SRC". Hans Boehm, Xerox PARC CSL. "Replacing the Modula-3 runtime with PCR". David Chase, Sun Microsystems. "GC-safe C-based compilation for Modula-3". Frode Odegard, Odegard Labs. "Commercializing Modula-3". John DeTreville, DEC SRC. "Taking over the world with Modula-3". Marc H. Brown, DEC SRC. "The Mentor project for algorithm animation". Greg Nelson, DEC SRC. "The Sparta project for static program analysis tools". Jorge Stolfi, DEC SRC, "Using generics". David Goldberg, Xerox PARC CSL. "Why does Modula-3 have all those required Float interfaces?" 1:00 PM - 2:00 AM Lunch. 2:00 PM - 3:00 PM Short talks. Michel Dagenais, Ecole Polytechnique de Montreal. David Evers, Cambridge University. Sam Harbison, Pine Creek Software. Bert Laverman, University of Gronigen. S. Lee Odegard, Western Washington University. Norman Ramsey, Princeton University. Win Treese, DEC Cambridge Research Laboratory. 3:00 PM - 4:45 PM Breakout sessions. Topics will be decided at the meeting. Possible topics include: Modula-3 in education. Choice of compiler back-ends. Extensions to Trestle. Extension languages. RPC systems. Numerical analysis. Modula-3 on PCs. Tools for lexing and parsing. Critique of Modula-3 libraries. Proposed language changes. 4:45 PM - 5:30 PM Reports from breakout sessions. 5:30 PM - 6:00 PM Wrapup. -------------------- BY CAR From San Francisco or the San Francisco airport take Highway 101 south, from San Jose take Highway 101 north. Take the Willow Road freeway exit WEST (going towards the mountains, not towards East Palo Alto and the Bay). Follow Willow to the intersection with Middlefield Road (you will see the Sunset Magazine building on the opposite side of the road to the left). Make a left on Middlefield and a right at the first light (Lytton). Follow Lytton up to High Street. The building occupies the whole block from High to Alma on Lytton. It's an angular brick building with large windows and a 2-story garage at the corner of Lytton and High. The entrance (130 Lytton) is just past the garage structure, on the left side of the road. Turn left into High Street and right into the parking lot. Enter at the left door and use the intercom to be let in; visitors park on the upper level. DIAGRAM san /\ | | | |___________| |___ _ _ _ ___| m |__ francisco | | t| lytton ave . . . i / \ r| ___________ h ___ _ _ _ ___ d __ / e \ a| | SRC | i | | d | stanford / /| l |\ \ i| | LOT== g | | l | << / / | | \ \ n| | | h | | e | _________| |__|___|__| |__| a |___________| |___ _ _ _ ___| f |__ palm drive | l | university ave . . . i _________ _________ __| m |___ ______ ___ _ _ _ ___ e __ | | | | | | | a | \ \ | | | l | \ \ | c | / / | \__/ / | | | d | \ \| a |/ / | ____/ | | | | \ m / | | | | \ i / | | | n | | | san jose\/ | o | | | BY TRAIN Caltrain provides train service between the San Francisco station, south of Market at 4th and Townsend, and the peninsula. The Palo Alto station is across Alma from SRC, which is an angular brick building with large windows at the corner of Lytton and Alma. If you come from San Francisco, you will need to cross under the train tracks to reach SRC. The entrance (130 Lytton) is 1/2 block down Lytton. For information on train schedules, phone 415 557-8661. ======================================================================= 40 === Date: 5 Jun 92 16:45:16 GMT From: lins@Apple.COM (Chuck Lins ) Subject: Re: _NILCHECKB(e) wrt the dicussion about whether pointers should be automatically initialized to NIL, with a little thought and logic you realize that with automatic storage management (ie garbage collection) this must occur. Point 1. The programmer should not need to be aware of the garbage collector when writing her program. Point 2. NEW must always appear to the programmer to synthesize new, virgin memory, even when it returns reclaimed memory. Otherwise you violate Point 1 and give the programmer a lot more work. Point 3. Some of the memory allocated by NEW may be for holding pointers. By Point 2, these would be initialized to the virgin state. Point 4. It doesn't make much sense to initialize some pointers (ie those embedded in dynamically allocated memory) and not initialize others (ie statically allocated (stack) memory). This is an extra burden on the programmer and a waste of their time. Thus it doesn't seem necessary to add such as requirement to the language since by definition it must occur. However, a note to language implementors may be in order to ensure they don't forget. :-) -- Chuck Lins, Apple Computer, Inc. Oberon-2 Paladin lins@apple.com "Oppression breeds violence" - Front Line Assembly ======================================================================= 41 === Date: Fri, 5 Jun 92 11:55:38 GMT From: ggf@saifr00.cfsat.honeywell.com (Gary Frederick) Subject: Re: Modula-3 Users Group Meeting... Will the talks at the Modula-3 Users' Group Meeting be published? I am especially interested in the Mentor project for algorithm animation and the Sparta project for static program analysis tools. (actually, I would like to see everything...) Gary ======================================================================= 42 === Date: Fri, 5 Jun 92 17:06:05 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: _NILCHECKB(e) In article <1992Jun5.154623.17585@walter.bellcore.com>, Darren New writes: > I'm fairly sure the SRC compiler still initializes pointers to NIL. > However, I think this is a flaw, since M3 programs will come to rely on > this and will fail when ported to a future compiler which does not > enforce this. It is still the case that on machines with alignments constraints, the compiler has to do something. For example, VAR x: REF INTEGER; i: INTEGER; BEGIN i := x^; END; is legal and should not crash. If the initial value of x is not properly aligned, this will not work. We could try to find a random but adequate value. In general, building a system that can masks the characteristics of the underlying hardware so as to improve portability of the programs is difficult and painful for the users. For example, what would you say if your program is compiled once with 32 bits integers, and the next time with 13 bits integers ? > If you want to deduce that the only `practical' > way to initialize pointers is to set them to NIL, why not just put that > into the language specification? Because of some machines this is not necessary. It turns out that most machines we have been interested into so far have alignment constraints and for those machines, initializing to NIL is the simplest. If the next great machine does not need any initialization, you can be sure that the compiler will be modified to generate nothing; having the language require an initialization to NIL would prohibit that. -- Eric. ======================================================================= 43 === Date: Fri, 5 Jun 92 15:46:23 GMT From: Darren New Subject: Re: _NILCHECKB(e) Excerpts from netnews.comp.lang.modula3: 2-Jun-92 Re: _NILCHECKB(e) Eliot Moss@cs.umass.edu (913) > Well, in a sense you are right but the language *does* require that every > variable, field, etc., contain a *legal value of its type*, and the only > reasonable and practical way to satisfy this constraint for REF and OBJECT > types is to initialize things to NIL, so in a practical sense, you are > probably wrong. On the other hand, if all values are legal pointers (say, like on an 8080 machine) then it is not unreasonable to think that perhaps pointers will not be initialized at all. > I am not aware of how the SRC compiler handles this requirement. I'm fairly sure the SRC compiler still initializes pointers to NIL. However, I think this is a flaw, since M3 programs will come to rely on this and will fail when ported to a future compiler which does not enforce this. This is similar to the `all the world is a VAX' problem that many C programs have/had. (*NULL) on a VAX was always zero, and many programs which ran fine on a VAX bombed when ported to something where that wasn't true. If you want to deduce that the only `practical' way to initialize pointers is to set them to NIL, why not just put that into the language specification? -- Darren ======================================================================= 44 === Date: Fri, 5 Jun 1992 12:25:10 GMT From: laverman@cs.rug.nl (Bert Laverman) Subject: Re: Side Effects & Language Design (Another Example) Mike Dixon writes: [ spurious remark removed ] > a) Sometimes it's more efficient. I'm not just talking about saving a > few machine cycles here and there; if the Mac OS was implemented the > way you propose, the user would have to insert and remove disks > very much more often. Similarly, if network connections were brought > down after every file access you'd be really unhappy. I've only had some contacts with MacOS, but I remember that it kept a disk's directory on the desktop, even if disks were swapped. Re-activating that window would not immediately prompt for re-swapping the disks. BUT: if I do something that causes a disk swap, and next I want to do something the needs the first disk again, THEN_I_HAVE_TO_SWAP_DISKS! I'ld rather not know about that as a program. I only request some activity on the previous file, The OS will find it wherever it is, asking for disks-swaps if needed. I'ld be interested in seeing your solution to this without swaps. The program running should not be bothered with on which disk a file is. The file selector window will allow you to insert another disk, but when the first disk is needed again, the program should not need to have to test for this. It just continues to use a file it already opened, the OS will take care of letting the user swap disks. The side effect (if you want) of requesting a file from another disk may be that that other disks resides in the drive, but the OS should sort it out, NOT the program. > b) Sometimes it's just not possible to hide the side effects. For > example, ... general I/O controller ... Doing something in between - if possible at all - should leave the controller in a known state. It is therefore not necessary to log this activity for the next time the controller is needed. You seem to be mixing high- and low-level concerns. Sure the state may need recording somewhere, but if that concerns you, you're in the driver. If you're outside, you don't give a damn, and frankly, you would prefer to be able not to give a damn. > Good programmers don't introduce egregious side effects, but there are > plenty of cases when good designs involve side effects. Many > developments in programming languages have sought to make more and > more of the simple memory-based side effects invisible (by taking over > aspects of storage management), but this isn't a total solution to the > problem. I have nothing against side effects, nor against being conscious about them. However, if I layer my program in such a way that the side-effect becomes immaterial, I dont' see the need for still propagating them, that won't change the use of the layer. > Once you recognize that side effects aren't going to go away, the next > question is what your programming language can do to help you with them. > If it pretends they'll never happen, it's not likely to help much when > they do. If, on the other hand, it provides ways to declare them and > does compile-time analysis to check for interactions, you have a real > opportunity to make the programmer's like easier. Please! I'm not stupid. I'm talking about hiding, not ignoring. > P.S. You don't want to have different versions of your program for > machines with and without removable media? Fine. But consider > the following scenario: Your OS was designed with fixed media > in mind, and sometime later they decide to add removable media. > Which of these options would you prefer? For an OS the disks are not a given thing, but something to explicitly deal with. Completely different situation. [ some more text deleted ] I'm sorry, but I keep getting the idea that yoo're using a bad example. Sure, keeping track of side-effects are important, but when you've written a layer that takes care of them, and offers a nice interface to the upper layers, then there's no need to keep propagating them. Greetings, Bert -- #include Bert Laverman, Dept. of Computing Science, Groningen University Friendly mail to: laverman@cs.rug.nl The rest to: /dev/null ======================================================================= 45 === Date: Fri, 5 Jun 1992 15:48:05 PDT From: Mike_Spreitzer.PARC@xerox.com Subject: Re: What about multiple inheritance? No, I don't think the AbstractSyntaxGraph is an example where three *very different* sorts of graphs have been composed. It is an example where three extensions or refinements of graphs have been combined. Here's a similar example that I've worked with: start with a base type for binary relations. Make a subtype for functions (i.e., binary relations where no two tuples have the same first element). Make another subtype for inverse-functions (i.e., binary relations where no two tuples have the same second element). Now, what do you do for one-to-one relations? Your preferred solution is probably the best way to cope in a SI type system. In my example, I'd write one type for binary relations, and include flags or tests for functionality and for inverse-functionality; a one-to-one relation could be identified by testing for both functionality and inverse-functionality. But this style has two important shortcomings: 1. The type system is no longer capable of discriminating between the four types in my example. That is, if I write a procedure that must be given a function, and a call that passes an inverse-function, the compiler will not complain. 2. Subtypes cannot always be added without editing their supertypes. In my example, suppose that a year later I want to add a subtype for relations where you know the 1st projection (i.e., {x | Exists y: (x,y) in R}) is an interval of the integers, and another subtype that is arrays (i.e., the relation is a function, and its 1st projection is an interval of the integers). In the style you recommend, I have to go back to the base type (which is the only type), and add flags or tests that tell whether the 1st projection is an interval of the integers. This is less modular than is desirable. Mike Spreitzer ======================================================================= 46 === Date: Fri, 5 Jun 1992 19:20:59 GMT From: dussault@DMI.USherb.CA (Jean-Pierre Dussault) Subject: need to convert numbers to LONGREAL I used the function LONGFLOAT in scr Modula3 Version 1.6..... We recently upgra ded to src Modula3 Version 2.05, and LONGFLOAT is undefined Question: what has replaced LONGFLOAT ??? Jean-Pierre Dussault ======================================================================= 47 === Date: Fri, 05 Jun 92 14:17:12 -0700 From: Subject: Re: need to convert numbers to LONGREAL > [J-P. Dussault:] Question: what has replaced LONGFLOAT ??? > [E. Muller:] FLOAT now takes two arguments, the number to > convert and the type to convert to. But note that the type defaults to REAL, so FLOAT(x) is still legal and means the same thing as in 1.6. --jorge ======================================================================= 48 === Date: Fri, 5 Jun 92 20:33:44 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: need to convert numbers to LONGREAL In article , dussault@DMI.USherb.CA (Jean-Pierre Duss ault) writes: > Question: what has replaced LONGFLOAT ??? FLOAT now takes two arguments, the number to convert and the type to convert to. This change was motivated by the introduction of a third floating point type, EXTENDED: rather than introducing a new function to convert to EXTENDED, FLOAT handles all three cases. -- Eric. ======================================================================= 49 === Date: Fri, 5 Jun 92 20:14:14 GMT From: jdd@src.dec.com (John DeTreville) Subject: Re: Modula-3 Users Group Meeting... From: ggf@saifr00.cfsat.honeywell.com (Gary Frederick) Re: Modula-3 Users Group Meeting... Date: Fri Jun 05 04:55:38 PDT 1992 Will the talks at the Modula-3 Users' Group Meeting be published? What we plan to do is at least to make available paper copies of all the slides, and the names and email addresses of all the speakers. You can then contact them directly for more information. We hope also to collect abstracts and Postscript versions of the slides. Not all of the speakers will have these, but if they do, we'll be able to distribute them electronically. Finally, we plan to publish a report on what happens in the discussions at the afternoon breakout sessions. Cheers, John ======================================================================= 50 === Date: Sat, 6 Jun 1992 08:15:34 GMT From: dvorak@extro.ucc.su.OZ.AU (Darko Volaric) Subject: M3 port to Macintosh? MPW C? Has anyone ported the SRC M3 compiler to MPW C or something similar? If not, does anyone have any opinions on how hard this would be to do, assuming things like threads were left out? I know MPW GNU C exists - is there a M3 GNU port or is there only the GNU Project M3? Thanks in advance for any help. Darko Volaric. ======================================================================= 51 === Date: 6 Jun 92 21:53:25 GMT From: moss@cs.umass.edu (Eliot Moss) Subject: Re: _NILCHECKB(e) There were suggestions that pointers could legally/sensibly be initialized to something other than NIL, and that the explicit initialization had to do with satisfying alignment contraints. I think this ignores some important points: 1) For even something as simple as a REF INTEGER, it should be either NIL or a reference to something that some NEW(REF INTEGER) call would return. 2) For something like REF [1..100], the storage referred to by the pointer needs to have an appropriate value. (Note that this has implications about the initial value of variables of type [1..100], etc.) There is a basic safety issue here rather than simply insuring the machine doesn't give you an unexpected alignment violation trap. Or am I missing something in the language definition? -- J. Eliot B. Moss, Assistant Professor Department of Computer Science Lederle Graduate Research Center University of Massachusetts Amherst, MA 01003 (413) 545-4206, 545-1249 (fax); Moss@cs.umass.edu ======================================================================= 52 === Date: 6 Jun 92 21:54:56 GMT From: moss@cs.umass.edu (Eliot Moss) Subject: Re: Modula-3 Users Group Meeting... I can't speak for other people, but I was only going to make some slides and talk to them, not write an actual paper. I have no objection to John's distributing copies of the slides as he has mentioned he will arrange to do. -- J. Eliot B. Moss, Assistant Professor Department of Computer Science Lederle Graduate Research Center University of Massachusetts Amherst, MA 01003 (413) 545-4206, 545-1249 (fax); Moss@cs.umass.edu ======================================================================= 53 === Date: Mon, 8 Jun 92 14:19:09 GMT From: Darren New Subject: Re: _NILCHECKB(e) Excerpts from netnews.comp.lang.modula3: 5-Jun-92 Re: _NILCHECKB(e) Eric Muller@src.dec.com (1557) > Because of some machines this is not necessary. It turns out that > most machines we have been interested into so far have alignment > constraints and for those machines, initializing to NIL is the > simplest. If the next great machine does not need any initialization, > you can be sure that the compiler will be modified to generate > nothing; having the language require an initialization to NIL would > prohibit that. Thank you thank you thank you. That is exactly my point. In this case, NILCHECK is pointless, since nobody (including the compiler) has initialized the pointer. This is my original point. Now, what happens to all those programs that said "Hmmm. Since all these pointers get initialized to NIL, I don't have to initialize them myself." They break, that's what. Very non-portable. There are already posters on this group who are claiming that the semantics of the language implicitly require pointers to be initialized to NIL. How many of these people are going to assign NIL to a pointer after allocating it, if they assume later in the program that such pointers are initialized to NIL? Look at it this way: A great number of pointers are initialized to NIL. I suspect (having programmed for 15 years) that 99.44% of all pointers are initialized to NIL or are assigned some initial value in the same scope in which they are allocated (and hence in an easy place for the compiler to find). Why not define the language to initialize to NIL any pointer that is not otherwise initialized in the scope in which it is allocated (or that the compiler cannot detect is assigned something else, basically)? Given that bad pointers are such a pain to debug compared to a great deal of other problems, I would think that making a language like Modula-3 popular would be helped by making it easy to not make stupid mistakes. -- Darren ======================================================================= 54 === Date: Mon, 8 Jun 92 21:27:58 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: Up to date description of the language In article , dussault@DMI.USherb.CA (Jean-Pierre Duss ault) writes: > Is there an up to date language description available thru electronic distrib ution? No. The "official" definition of the language can be found only in: System Programming with Modula-3 Edited by Greg Nelson Prentice Hall Series in Innovative Technology ISBN 0-13-590464-1 L.C. QA76.66.S87 1991 also known as SPwM3. -- Eric. ======================================================================= 55 === Date: 8 Jun 92 20:55:14 GMT From: moss@cs.umass.edu (Eliot Moss) Subject: Re: M3 port to Macintosh? MPW C? >>>>> On 6 Jun 92 08:15:34 GMT, dvorak@extro.ucc.su.OZ.AU (Darko Volaric) said: Darko> .... I know MPW GNU C exists - is there a M3 GNU port or is there only Darko> the GNU Project M3? So far as I know no one has completed a port of SRC M3 to the DOS environment yet. I have had mail from a student at a University in NC who was going to attempt a port to gcc under MSDOS (386/486). My guess is that would not be all that hard, if you have the disk space and the patience to deal with smoothing out the inevitable rough edges. Meanwhile, GNU Modula-3 is proceeding, but it will still be several months before we can send around an alpha test, and that won't be for the MSDOS environment. -- J. Eliot B. Moss, Assistant Professor Department of Computer Science Lederle Graduate Research Center University of Massachusetts Amherst, MA 01003 (413) 545-4206, 545-1249 (fax); Moss@cs.umass.edu ======================================================================= 56 === Date: Mon, 8 Jun 1992 13:21:12 PDT From: David Nichols Subject: new version of m3rpc Version 1.3 of our m3rpc code is now available for anonymous ftp. It features: - Support for transient program numbers. - Uses version 2.06 of the compiler. - Bug fixes to m3rpcgen. - Locking in generated stubs. It's on parcftp.parc.xerox.com (13.1.64.94) in "pub/m3/m3rpc.tar.Z". There's also a diffs file to get you from 1.2 to 1.3 (pub/m3/m3rpc-diffs-1.2-1.3). Thanks to Frode Odegard for the 2.06 changes, and Mark Day for many bug reports. David ======================================================================= 57 === Date: Mon, 8 Jun 1992 20:26:04 GMT From: dussault@DMI.USHERB.CA (Jean-Pierre Dussault) Subject: Up to date description of the language Is there an up to date language description available thru electronic distribut ion? A TeX file would be most usefull. Jean-Pierre Dussault ======================================================================= 58 === Date: Tue, 9 Jun 92 10:13 GMT From: David Bruce <"ISIS::dib%hermes.mod.uk"@relay.MOD.UK> Subject: Re: _NILCHECKB(e) Forgive me, but I don't quite see the problem here. Just follow the rules. The revised report (I haven't got SPwM3, but I assume its the same) says that when a variable of type T is not initialised, "the initial value is an arbitrary value of type T". This holds for all types, including REFs. It is *not* the case that arbitrary addresses are arbitrary values of REF types, even on a machine with no alignment constraints. Indeed, very few addresses are valid references, especially for the more interesting types (consider, for example, those that are BRANDED). Nevertheless, my reading is that the a valid initial value *must* be given. NIL is such a value and is of course the easy option. But programmers can't rely on finding NIL -- if they feel like working hard, implementators can initialise a REF T by constructing a T [*] (recursively on its structure, of course) and then heaping that value. It is not, however, a correct implementation technique to just use whatever bits happen to be lying around. (The same would in general have to be done for NEW.) Obviously, data flow analyses, etc. may show that such initialisation is unnecessary in many cases. But one must consider the general case. [*] We had a big problem once because it was inherently impossible to do this arbitrary value generation. I think it is OK in M3 because its type structure is not as demanding as the one we were working in. (The question of what the language should *require* when an initial value is not specified is an entirely different, if important, consideration.) David Bruce PS. The point of _NILCHECKB must surely be to check for things that aren't really pointers. If the language is implemented properly (I'm ignoring abuse of UNSAFE bits here), NIL is the only case to be considered. When initialisation is omitted, perhaps a similar check should be done to `validate' the address (but note that this is probably impossible!) -------- post: DRA Malvern, St Andrews Road, Malvern, Worcestershire WR14 3PS, ENGLAND email: dib%hermes.mod.uk@relay.mod.uk (internet) dib@uk.mod.hermes (janet) phone: +44 684 895112 fax: +44 684 894303 ======================================================================= 59 === Date: Tue, 9 Jun 1992 12:21:41 -0500 From: shrinand desai Subject: Re: Up to date description of the language Hello eric, I am planning to port src m3 compiler tp IBM PC(and compatibles above 386 using MS DOS) I was going thru the compiler source code. You have done quite a bit a work on this compiler. My question is when I start porting what are the most critical areas that need to be changed to port it to pc? I am a student here at university of north texas. m3 compiler at present is on solbourne using SunOs 4.1a.1. Any help/tips/guidence will be greatly appriciated. Thanks in advance. --Shri -- Shrinand Desai | shri@sol.acs.unt.edu | If I don't care where I am, I ain't lost. or shri@vaxb.acs.unt.edu | ======================================================================= 60 === Date: 9 Jun 92 13:14:39 GMT From: fn00@gte.com (Farshad Nayeri) Subject: Re: M3 port to Macintosh? MPW C? Eliot Moss writes: dvorak@extro.ucc.su.OZ.AU (Darko Volaric) said: Darko> .... I know MPW GNU C exists - is there a M3 GNU port or is Darko> there only the GNU Project M3? So far as I know no one has completed a port of SRC M3 to the DOS environment yet. I have had mail from a student at a University in NC who was going to attempt a port to gcc under MSDOS (386/486). My guess is that would not be all that hard, if you have the disk space and the patience to deal with smoothing out the inevitable rough edges. Meanwhile, GNU Modula-3 is proceeding, but it will still be several months before we can send around an alpha test, and that won't be for the MSDOS environment. MPW is the "Macintosh Programmers Workshop". As far as I know, noone has announced the completion of porting either one of the {SRC,GNU} compilers to MPW. I don't remember if the original post asked for a way of porting Modula-3 to the Macintosh, or was asking about specifically GNU M-3... You might be able to use the diffs (available from ftp.apple.com) to make some progress in porting GNU M3 to MPW, given that the version of the GCC backend that GNU Modula-3 uses is the same as the version that you have the diffs for. As far as I understand FSF does not intend to support their compilers under Macintosh environments as a protest to the Apple look-and-feel copyright suits. Another possibility is to port SRC Modula-3 to the MPW. I believe people at Queen Mary and Westfield College in London have ported SRC M-3 to the Macintoshes running A/UX. Read the article in the second Modula-3 Newsletter for more detail. Now I am not sure how much that is going to help you with porting Modula to MacOS. I suppose it depends on the number of UNIX dependencies in SRC Modula-3 that MPW does not address, memory management (Ptr/Handle) issues, and finally threads. I know there has been system extensions to MacOS to allow some thread support (preemptive or not, I am not sure). Check Apple develop magazine #6, for an article about this. If you get all of this to work, then you can port Trestle to use native Mac windows. This would be really be a neat experiment for Trestle... --farshad -- Farshad Nayeri Intelligent Database Systems fn00@gte.com Computer and Intelligent Systems Laboratory (617)466-2473 GTE Laboratories, Waltham, MA ======================================================================= 61 === Date: 9 Jun 92 15:03:13 GMT From: templ@inf.ethz.ch (Josef Templ) Subject: Re: _NILCHECKB(e) Eric Muller writes > For example, > > VAR x: REF INTEGER; i: INTEGER; BEGIN > i := x^; END; > > is legal and should not crash. At least on the SPARC implementation this does crash. Is it really legal or is it legal in some other sense? -Josef Templ (the usual disclaimer) ======================================================================= 62 === Date: Tue, 9 Jun 92 13:20:41 PDT From: surak!frode (Frode Odegard) Subject: Re: _NILCHECKB(e) Josef Templ writes: > Eric Muller writes > > For example, > > > > VAR x: REF INTEGER; i: INTEGER; BEGIN > > i := x^; END; > > > > is legal and should not crash. > > At least on the SPARC implementation this does crash. > Is it really legal or is it legal in some other sense? > > -Josef Templ > (the usual disclaimer) Huh? It is legal for m3compiler to initialize x to NIL, is it not, since NIL is a member of any REF type ? Then it is incorrect to infer that the above should work on all implementations. However, the following should work: VAR x: REF INTEGER; i: INTEGER; BEGIN IF x # NIL THEN i := x^ END END - Frode -------------------------------------------------------------------- Odegard Labs, Inc., 100 Bush St., Suite 625, San Francisco, CA 94104-3909, USA; +1-415-434-4242, +1-415-434-4243(fax), frode@odegard.com(internet) * - * - * - * Scotty: Captain, we din' can reference it! Kirk: Analysis, Mr. Spock? Spock: Captain, it doesn't appear in the symbol table. Kirk: Then it's of external origin? Spock: Affirmative. Kirk: Mr. Sulu, go to pass two. Sulu: Aye aye, sir, going to pass two. ======================================================================= 63 === Date: Tue, 9 Jun 1992 17:39:55 GMT From: wewallac@watsol.waterloo.edu (Bill Wallace) Subject: RE: Help with Modula3 libraries I have installed the M3 compiler on a sparc station, but am having trouble compiling the library. (libm3) The problem is in the m3makefile, there isn't one. The code all seems to exist, but when I type: m3make -f m3makefile.libm3 all install it complains: cd libm3; /u/wewallace/bin/sun4/m3make all No m3makefile ? really ? cd libm3; /u/wewallace/bin/sun4/m3make install No m3makefile ? really ? I assume there is supposed to be a m3makefile in libm3 but there isn't one. If someone has one, could they send it to me. Thanks, Bill ======================================================================= 64 === Date: 9 Jun 92 20:09:26 GMT From: n8243274@gonzo.cc.wwu.edu (S. Lee ODEGARD) Subject: Re: _NILCHECKB(e) I prefer just leaving things as they are. If in a Modula-3 program I order no initialization to be done, then I want no initialization to be performed. period. :r .sig ======================================================================= 65 === Date: Tue, 9 Jun 1992 07:01:38 GMT From: muller@src.dec.com (Eric Muller) Subject: help with the layout of structures in C/C++ [Moderator's note: This is one of the longest messages I've ever sent to comp.compilers. Would people have preferred that I put it on the mail and FTP servers so those who wanted to try it could pick it up? -John] Hello, We would like your help: could you please run the program below on as many combinations of machine/C/C++ compiler you have access to ? It does not matter if the compiler is ANSI-C or not, and the program should work on 16-bit, 32-bit and 64-bit machines. Our goal is to find out how the various C/C++ compilers represent structures, in particular bitfields. The file README contains a detailed explanation of the problem we are trying to solve When describing the combination(s) of machine/compiler you are Please be as precise as possible about the hardware, operating system version, C/C++ compiler version as you can. We will make all the results available, with the proper credits. If you prefer to remain anonymous, please tell us. Thanks very much for your help, Eric Muller muller@src.dec.com DEC Systems Research Center 130 Lytton Av. Palo Alto, CA 94301 (415) 853 21 93 Fax: (415) 324 48 76 ---- Cut Here and unpack ---- #!/bin/sh # This is a shell archive (shar 3.32) # made 06/09/1992 06:59 UTC by muller@procope.pa.dec.com # Source directory /tmp_mnt/flimflam/r/dlusers5/muller/work/struct/test2 # # existing files WILL be overwritten # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 2691 -rw-r--r-- README # 34762 -rw-r--r-- params.c # 1484 -rw-r--r-- random.c # 979 -rw-r--r-- Makefile # if touch 2>&1 | fgrep 'amc' > /dev/null then TOUCH=touch else TOUCH=true fi # ============= README ============== echo "x - extracting README (Text)" sed 's/^X//' << 'SHAR_EOF' > README && XWe are working on a compiler for Modula-3. Because we want to make it Xeasy to mix Modula-3 and other languages, for example C, we need to be Xcompatible in a number of respects: calling sequences, representation Xof basic types and so on. There is one area were we still have Xproblems: the layout of structure declarations, in particular in the Xpresence of bitfields. As you may know the ANSI C standard gives a Xlot of freedom to the implementer, and this only recognizes the Xvariety of existing "C" compilers. For example, the two structures: X X struct {int a; char b; signed int c: sizeof (char); } X X struct {int a; char b; char c; } X Xare not always equivalent. X XIn a previous posting to comp.compilers, we asked for an algorithm Xthat could be parameterized to reflect what various machine/compiler Xcombinations do. Although we got some interesting answers (thanks a Xlot), none provided the algorithm we have been looking for. In fact, Xmany people are not really aware of the problems. So we wrote a Xsimple program to report the size of various structures, and sent it Xto our friends. We were fortunate to get many answers (in fact, 43 Xmachine/compiler combinations), and we have designed an algorithm that Xexplains all the results we have received. This first test program Xwas just meant to give us an idea of what to expect from the various C Xcompilers and it did not collect exhaustive data. X XWe think that our algorithm will cover a very large number of Xmachines/combinations (in fact, it is a bit more parameterized than we Xthink is needed, just to be on the safe side). Now, we would like to Xconfirm or infirm that thesis, and the best way is to have the program Xrun on as many machines/compilers as possible. X XWhy should you care ? The example above should be enough to tell you Xthat bitfields are not really the most portable construct in C. You Xcan avoid them, but you may as well know what works and what does not. XAlso, this may explain why some third-party C (or non-C) compilers do Xnot interoperate properly with the vendors C compilers (and libraries). X XWhen describing the combination(s) of machine/compiler you are trying, Xplease be as precise as possible about the hardware, operating system Xversion, C/C++ compiler version as you can. We are also interested in Xany problem you may have compiling or running the programs. X XWe will make all the results available, with the proper credits. If Xyou prefer to remain anonymous, please tell us. X XThanks very much for your help, X XEric Muller muller@src.dec.com XDEC Systems Research Center X130 Lytton Av. XPalo Alto, CA 94301 X(415) 853 21 93 Fax: (415) 324 48 76 X X SHAR_EOF $TOUCH -am 0608233992 README && chmod 0644 README || echo "restore of README failed" set `wc -c README`;Wc_c=$1 if test "$Wc_c" != "2691"; then echo original size 2691, current size $Wc_c fi # ============= params.c ============== echo "x - extracting params.c (Text)" sed 's/^X//' << 'SHAR_EOF' > params.c && Xint a[100], s[100], p[100], start[100], stop[100], size, align; Xchar *block; Xint report_losses; X X#define MAX(a,b) ((a>b) ? a : b) X#define roundup(x,y) (((x+y-1)/y)*y) X#define rounddown(x,y) (((x)/y)*y) X X#define SZ(x) (sizeof(x) * BITS_PER_BYTE) X#define AL(TYPE) \ X ((long)((char *)&((struct{char c; TYPE d;}*)0)->d \ X - (char *)0) * BITS_PER_BYTE) X Xint X s_char, a_char, X s_short, a_short, X s_int, a_int, X s_long, a_long, X s_float, a_float, X s_double, a_double; X Xint X BITFIELD_UNITS_OVERLAP, X BITFIELD_UNIT_SIZE, X BITFIELD_UNIT_ALIGN, X FIELD_PAD_BITFIELD, X BITFIELD_PAD_FIELD, X BITFIELD_SIZE_ALIGN [100], X NUMBER_PAD_SIZES, X PAD_SIZES [100], X BITS_PER_BYTE; X Xtypedef struct {char a[0x01];} SC0x01; Xtypedef struct {char a[0x02];} SC0x02; Xtypedef struct {char a[0x03];} SC0x03; Xtypedef struct {char a[0x04];} SC0x04; Xtypedef struct {char a[0x05];} SC0x05; Xtypedef struct {char a[0x06];} SC0x06; Xtypedef struct {char a[0x07];} SC0x07; Xtypedef struct {char a[0x08];} SC0x08; Xtypedef struct {char a[0x09];} SC0x09; Xtypedef struct {char a[0x0a];} SC0x0a; Xtypedef struct {char a[0x0b];} SC0x0b; Xtypedef struct {char a[0x0c];} SC0x0c; Xtypedef struct {char a[0x0d];} SC0x0d; Xtypedef struct {char a[0x0e];} SC0x0e; Xtypedef struct {char a[0x0f];} SC0x0f; Xtypedef struct {char a[0x10];} SC0x10; Xtypedef struct {char a[0x11];} SC0x11; Xtypedef struct {char a[0x12];} SC0x12; Xtypedef struct {char a[0x13];} SC0x13; Xtypedef struct {char a[0x14];} SC0x14; Xtypedef struct {char a[0x15];} SC0x15; Xtypedef struct {char a[0x16];} SC0x16; Xtypedef struct {char a[0x17];} SC0x17; Xtypedef struct {char a[0x18];} SC0x18; Xtypedef struct {char a[0x19];} SC0x19; Xtypedef struct {char a[0x1a];} SC0x1a; Xtypedef struct {char a[0x1b];} SC0x1b; Xtypedef struct {char a[0x1c];} SC0x1c; Xtypedef struct {char a[0x1d];} SC0x1d; Xtypedef struct {char a[0x1e];} SC0x1e; Xtypedef struct {char a[0x1f];} SC0x1f; Xtypedef struct {char a[0x20];} SC0x20; X Xtypedef struct {int a: 0x01;} S0x01; S0x01 v0x01; Xtypedef struct {int a: 0x02;} S0x02; S0x02 v0x02; Xtypedef struct {int a: 0x03;} S0x03; S0x03 v0x03; Xtypedef struct {int a: 0x04;} S0x04; S0x04 v0x04; Xtypedef struct {int a: 0x05;} S0x05; S0x05 v0x05; Xtypedef struct {int a: 0x06;} S0x06; S0x06 v0x06; Xtypedef struct {int a: 0x07;} S0x07; S0x07 v0x07; Xtypedef struct {int a: 0x08;} S0x08; S0x08 v0x08; Xtypedef struct {int a: 0x09;} S0x09; S0x09 v0x09; Xtypedef struct {int a: 0x0a;} S0x0a; S0x0a v0x0a; Xtypedef struct {int a: 0x0b;} S0x0b; S0x0b v0x0b; Xtypedef struct {int a: 0x0c;} S0x0c; S0x0c v0x0c; Xtypedef struct {int a: 0x0d;} S0x0d; S0x0d v0x0d; Xtypedef struct {int a: 0x0e;} S0x0e; S0x0e v0x0e; Xtypedef struct {int a: 0x0f;} S0x0f; S0x0f v0x0f; Xtypedef struct {int a: 0x10;} S0x10; S0x10 v0x10; Xtypedef struct {int a: 0x11;} S0x11; S0x11 v0x11; Xtypedef struct {int a: 0x12;} S0x12; S0x12 v0x12; Xtypedef struct {int a: 0x13;} S0x13; S0x13 v0x13; Xtypedef struct {int a: 0x14;} S0x14; S0x14 v0x14; Xtypedef struct {int a: 0x15;} S0x15; S0x15 v0x15; Xtypedef struct {int a: 0x16;} S0x16; S0x16 v0x16; Xtypedef struct {int a: 0x17;} S0x17; S0x17 v0x17; Xtypedef struct {int a: 0x18;} S0x18; S0x18 v0x18; Xtypedef struct {int a: 0x19;} S0x19; S0x19 v0x19; Xtypedef struct {int a: 0x1a;} S0x1a; S0x1a v0x1a; Xtypedef struct {int a: 0x1b;} S0x1b; S0x1b v0x1b; Xtypedef struct {int a: 0x1c;} S0x1c; S0x1c v0x1c; Xtypedef struct {int a: 0x1d;} S0x1d; S0x1d v0x1d; Xtypedef struct {int a: 0x1e;} S0x1e; S0x1e v0x1e; Xtypedef struct {int a: 0x1f;} S0x1f; S0x1f v0x1f; Xtypedef struct {int a: 0x20;} S0x20; S0x20 v0x20; X Xtypedef struct {char a; int b: 0x19;} Sc0x19; Xtypedef struct {char a; int b: 0x02;} Sc0x02; Xtypedef struct {char a; int b: 0x20;} Sc0x20; Xtypedef struct {char a; int b: 0x04;} Sc0x04; Xtypedef struct {char a; int b: 0x05;} Sc0x05; Xtypedef struct {char a; int b: 0x08;} Sc0x08; Xtypedef struct {char a; int b: 0x09;} Sc0x09; Xtypedef struct {char a; int b: 0x0c;} Sc0x0c; Xtypedef struct {char a; int b: 0x10;} Sc0x10; Xtypedef struct {char a; int b: 0x11;} Sc0x11; Xtypedef struct {char a; int b: 0x14;} Sc0x14; Xtypedef struct {char a; int b: 0x17;} Sc0x17; Xtypedef struct {char a; int b: 0x18;} Sc0x18; Xtypedef struct {char a; int b: 0x01;} Sc0x01; XSc0x19 vc0x19; XSc0x02 vc0x02; XSc0x20 vc0x20; XSc0x04 vc0x04; XSc0x05 vc0x05; XSc0x08 vc0x08; XSc0x09 vc0x09; XSc0x0c vc0x0c; XSc0x10 vc0x10; XSc0x11 vc0x11; XSc0x14 vc0x14; XSc0x17 vc0x17; XSc0x18 vc0x18; XSc0x01 vc0x01; X Xtypedef struct {short a; int b: 0x19;} Ss0x19; Xtypedef struct {short a; int b: 0x02;} Ss0x02; Xtypedef struct {short a; int b: 0x20;} Ss0x20; Xtypedef struct {short a; int b: 0x04;} Ss0x04; Xtypedef struct {short a; int b: 0x05;} Ss0x05; Xtypedef struct {short a; int b: 0x08;} Ss0x08; Xtypedef struct {short a; int b: 0x09;} Ss0x09; Xtypedef struct {short a; int b: 0x0c;} Ss0x0c; Xtypedef struct {short a; int b: 0x10;} Ss0x10; Xtypedef struct {short a; int b: 0x11;} Ss0x11; Xtypedef struct {short a; int b: 0x14;} Ss0x14; Xtypedef struct {short a; int b: 0x17;} Ss0x17; Xtypedef struct {short a; int b: 0x18;} Ss0x18; Xtypedef struct {short a; int b: 0x01;} Ss0x01; XSs0x19 vs0x19; XSs0x02 vs0x02; XSs0x20 vs0x20; XSs0x04 vs0x04; XSs0x05 vs0x05; XSs0x08 vs0x08; XSs0x09 vs0x09; XSs0x0c vs0x0c; XSs0x10 vs0x10; XSs0x11 vs0x11; XSs0x14 vs0x14; XSs0x17 vs0x17; XSs0x18 vs0x18; XSs0x01 vs0x01; X Xtypedef struct {int a; int b: 0x19;} Si0x19; Xtypedef struct {int a; int b: 0x02;} Si0x02; Xtypedef struct {int a; int b: 0x20;} Si0x20; Xtypedef struct {int a; int b: 0x04;} Si0x04; Xtypedef struct {int a; int b: 0x05;} Si0x05; Xtypedef struct {int a; int b: 0x08;} Si0x08; Xtypedef struct {int a; int b: 0x09;} Si0x09; Xtypedef struct {int a; int b: 0x0c;} Si0x0c; Xtypedef struct {int a; int b: 0x10;} Si0x10; Xtypedef struct {int a; int b: 0x11;} Si0x11; Xtypedef struct {int a; int b: 0x14;} Si0x14; Xtypedef struct {int a; int b: 0x17;} Si0x17; Xtypedef struct {int a; int b: 0x18;} Si0x18; Xtypedef struct {int a; int b: 0x01;} Si0x01; XSi0x19 vi0x19; XSi0x02 vi0x02; XSi0x20 vi0x20; XSi0x04 vi0x04; XSi0x05 vi0x05; XSi0x08 vi0x08; XSi0x09 vi0x09; XSi0x0c vi0x0c; XSi0x10 vi0x10; XSi0x11 vi0x11; XSi0x14 vi0x14; XSi0x17 vi0x17; XSi0x18 vi0x18; XSi0x01 vi0x01; X Xtypedef struct {long a; int b: 0x19;} Sl0x19; Xtypedef struct {long a; int b: 0x02;} Sl0x02; Xtypedef struct {long a; int b: 0x20;} Sl0x20; Xtypedef struct {long a; int b: 0x04;} Sl0x04; Xtypedef struct {long a; int b: 0x05;} Sl0x05; Xtypedef struct {long a; int b: 0x08;} Sl0x08; Xtypedef struct {long a; int b: 0x09;} Sl0x09; Xtypedef struct {long a; int b: 0x0c;} Sl0x0c; Xtypedef struct {long a; int b: 0x10;} Sl0x10; Xtypedef struct {long a; int b: 0x11;} Sl0x11; Xtypedef struct {long a; int b: 0x14;} Sl0x14; Xtypedef struct {long a; int b: 0x17;} Sl0x17; Xtypedef struct {long a; int b: 0x18;} Sl0x18; Xtypedef struct {long a; int b: 0x01;} Sl0x01; XSl0x19 vl0x19; XSl0x02 vl0x02; XSl0x20 vl0x20; XSl0x04 vl0x04; XSl0x05 vl0x05; XSl0x08 vl0x08; XSl0x09 vl0x09; XSl0x0c vl0x0c; XSl0x10 vl0x10; XSl0x11 vl0x11; XSl0x14 vl0x14; XSl0x17 vl0x17; XSl0x18 vl0x18; XSl0x01 vl0x01; X Xtypedef struct {char a; int b: 0x19; char c;} Sc0x19c; Xtypedef struct {char a; int b: 0x02; char c;} Sc0x02c; Xtypedef struct {char a; int b: 0x20; char c;} Sc0x20c; Xtypedef struct {char a; int b: 0x04; char c;} Sc0x04c; Xtypedef struct {char a; int b: 0x05; char c;} Sc0x05c; Xtypedef struct {char a; int b: 0x08; char c;} Sc0x08c; Xtypedef struct {char a; int b: 0x09; char c;} Sc0x09c; Xtypedef struct {char a; int b: 0x0c; char c;} Sc0x0cc; Xtypedef struct {char a; int b: 0x10; char c;} Sc0x10c; Xtypedef struct {char a; int b: 0x11; char c;} Sc0x11c; Xtypedef struct {char a; int b: 0x14; char c;} Sc0x14c; Xtypedef struct {char a; int b: 0x17; char c;} Sc0x17c; Xtypedef struct {char a; int b: 0x18; char c;} Sc0x18c; Xtypedef struct {char a; int b: 0x01; char c;} Sc0x01c; XSc0x19c vc0x19c; XSc0x02c vc0x02c; XSc0x20c vc0x20c; XSc0x04c vc0x04c; XSc0x05c vc0x05c; XSc0x08c vc0x08c; XSc0x09c vc0x09c; XSc0x0cc vc0x0cc; XSc0x10c vc0x10c; XSc0x11c vc0x11c; XSc0x14c vc0x14c; XSc0x17c vc0x17c; XSc0x18c vc0x18c; XSc0x01c vc0x01c; X Xtypedef struct {char a; int b: 0x19; short c;} Sc0x19s; Xtypedef struct {char a; int b: 0x02; short c;} Sc0x02s; Xtypedef struct {char a; int b: 0x20; short c;} Sc0x20s; Xtypedef struct {char a; int b: 0x04; short c;} Sc0x04s; Xtypedef struct {char a; int b: 0x05; short c;} Sc0x05s; Xtypedef struct {char a; int b: 0x08; short c;} Sc0x08s; Xtypedef struct {char a; int b: 0x09; short c;} Sc0x09s; Xtypedef struct {char a; int b: 0x0c; short c;} Sc0x0cs; Xtypedef struct {char a; int b: 0x10; short c;} Sc0x10s; Xtypedef struct {char a; int b: 0x11; short c;} Sc0x11s; Xtypedef struct {char a; int b: 0x14; short c;} Sc0x14s; Xtypedef struct {char a; int b: 0x17; short c;} Sc0x17s; Xtypedef struct {char a; int b: 0x18; short c;} Sc0x18s; Xtypedef struct {char a; int b: 0x01; short c;} Sc0x01s; XSc0x19s vc0x19s; XSc0x02s vc0x02s; XSc0x20s vc0x20s; XSc0x04s vc0x04s; XSc0x05s vc0x05s; XSc0x08s vc0x08s; XSc0x09s vc0x09s; XSc0x0cs vc0x0cs; XSc0x10s vc0x10s; XSc0x11s vc0x11s; XSc0x14s vc0x14s; XSc0x17s vc0x17s; XSc0x18s vc0x18s; XSc0x01s vc0x01s; X Xtypedef struct {char a; int b: 0x19; int c: 0x19;} Sc0x190x19; Xtypedef struct {char a; int b: 0x02; int c: 0x02;} Sc0x020x02; Xtypedef struct {char a; int b: 0x20; int c: 0x20;} Sc0x200x20; Xtypedef struct {char a; int b: 0x04; int c: 0x04;} Sc0x040x04; Xtypedef struct {char a; int b: 0x05; int c: 0x05;} Sc0x050x05; Xtypedef struct {char a; int b: 0x08; int c: 0x08;} Sc0x080x08; Xtypedef struct {char a; int b: 0x09; int c: 0x09;} Sc0x090x09; Xtypedef struct {char a; int b: 0x0c; int c: 0x0c;} Sc0x0c0x0c; Xtypedef struct {char a; int b: 0x10; int c: 0x10;} Sc0x100x10; Xtypedef struct {char a; int b: 0x11; int c: 0x11;} Sc0x110x11; Xtypedef struct {char a; int b: 0x14; int c: 0x14;} Sc0x140x14; Xtypedef struct {char a; int b: 0x17; int c: 0x17;} Sc0x170x17; Xtypedef struct {char a; int b: 0x18; int c: 0x18;} Sc0x180x18; Xtypedef struct {char a; int b: 0x01; int c: 0x01;} Sc0x010x01; XSc0x190x19 vc0x190x19; XSc0x020x02 vc0x020x02; XSc0x200x20 vc0x200x20; XSc0x040x04 vc0x040x04; XSc0x050x05 vc0x050x05; XSc0x080x08 vc0x080x08; XSc0x090x09 vc0x090x09; XSc0x0c0x0c vc0x0c0x0c; XSc0x100x10 vc0x100x10; XSc0x110x11 vc0x110x11; XSc0x140x14 vc0x140x14; XSc0x170x17 vc0x170x17; XSc0x180x18 vc0x180x18; XSc0x010x01 vc0x010x01; X Xtypedef struct {char a; int b: 0x19; int c: 0x19; char d;} Sc0x190x19c; Xtypedef struct {char a; int b: 0x02; int c: 0x02; char d;} Sc0x020x02c; Xtypedef struct {char a; int b: 0x20; int c: 0x20; char d;} Sc0x200x20c; Xtypedef struct {char a; int b: 0x04; int c: 0x04; char d;} Sc0x040x04c; Xtypedef struct {char a; int b: 0x05; int c: 0x05; char d;} Sc0x050x05c; Xtypedef struct {char a; int b: 0x08; int c: 0x08; char d;} Sc0x080x08c; Xtypedef struct {char a; int b: 0x09; int c: 0x09; char d;} Sc0x090x09c; Xtypedef struct {char a; int b: 0x0c; int c: 0x0c; char d;} Sc0x0c0x0cc; Xtypedef struct {char a; int b: 0x10; int c: 0x10; char d;} Sc0x100x10c; Xtypedef struct {char a; int b: 0x11; int c: 0x11; char d;} Sc0x110x11c; Xtypedef struct {char a; int b: 0x14; int c: 0x14; char d;} Sc0x140x14c; Xtypedef struct {char a; int b: 0x17; int c: 0x17; char d;} Sc0x170x17c; Xtypedef struct {char a; int b: 0x18; int c: 0x18; char d;} Sc0x180x18c; Xtypedef struct {char a; int b: 0x01; int c: 0x01; char d;} Sc0x010x01c; XSc0x190x19c vc0x190x19c; XSc0x020x02c vc0x020x02c; XSc0x200x20c vc0x200x20c; XSc0x040x04c vc0x040x04c; XSc0x050x05c vc0x050x05c; XSc0x080x08c vc0x080x08c; XSc0x090x09c vc0x090x09c; XSc0x0c0x0cc vc0x0c0x0cc; XSc0x100x10c vc0x100x10c; XSc0x110x11c vc0x110x11c; XSc0x140x14c vc0x140x14c; XSc0x170x17c vc0x170x17c; XSc0x180x18c vc0x180x18c; XSc0x010x01c vc0x010x01c; X Xtypedef struct {char a; int b: 0x19; int c: 0x19; short d;} Sc0x190x19s; Xtypedef struct {char a; int b: 0x02; int c: 0x02; short d;} Sc0x020x02s; Xtypedef struct {char a; int b: 0x20; int c: 0x20; short d;} Sc0x200x20s; Xtypedef struct {char a; int b: 0x04; int c: 0x04; short d;} Sc0x040x04s; Xtypedef struct {char a; int b: 0x05; int c: 0x05; short d;} Sc0x050x05s; Xtypedef struct {char a; int b: 0x08; int c: 0x08; short d;} Sc0x080x08s; Xtypedef struct {char a; int b: 0x09; int c: 0x09; short d;} Sc0x090x09s; Xtypedef struct {char a; int b: 0x0c; int c: 0x0c; short d;} Sc0x0c0x0cs; Xtypedef struct {char a; int b: 0x10; int c: 0x10; short d;} Sc0x100x10s; Xtypedef struct {char a; int b: 0x11; int c: 0x11; short d;} Sc0x110x11s; Xtypedef struct {char a; int b: 0x14; int c: 0x14; short d;} Sc0x140x14s; Xtypedef struct {char a; int b: 0x17; int c: 0x17; short d;} Sc0x170x17s; Xtypedef struct {char a; int b: 0x18; int c: 0x18; short d;} Sc0x180x18s; Xtypedef struct {char a; int b: 0x01; int c: 0x01; short d;} Sc0x010x01s; XSc0x190x19s vc0x190x19s; XSc0x020x02s vc0x020x02s; XSc0x200x20s vc0x200x20s; XSc0x040x04s vc0x040x04s; XSc0x050x05s vc0x050x05s; XSc0x080x08s vc0x080x08s; XSc0x090x09s vc0x090x09s; XSc0x0c0x0cs vc0x0c0x0cs; XSc0x100x10s vc0x100x10s; XSc0x110x11s vc0x110x11s; XSc0x140x14s vc0x140x14s; XSc0x170x17s vc0x170x17s; XSc0x180x18s vc0x180x18s; XSc0x010x01s vc0x010x01s; X X#include "types.h" X X Xtry (n) X int n; X{ X int i; X int padded = 0; X int this_bitfield_unit_start; X int last_was_bitfield = 0; X X size = 0; X align = 1; X X for (i = 0; i < n; i++) { X if (p[i]) { X int last; X X if (last_was_bitfield) { X if (BITFIELD_UNITS_OVERLAP) { X last = rounddown (size, BITFIELD_UNIT_ALIGN) + BITFIELD_UNIT_SIZE; } X else { X last = this_bitfield_unit_start + BITFIELD_UNIT_SIZE; }} X else { X if (FIELD_PAD_BITFIELD) { X this_bitfield_unit_start = roundup (size, BITFIELD_UNIT_ALIGN); X size = this_bitfield_unit_start; } X else { X this_bitfield_unit_start = rounddown (size, BITFIELD_UNIT_ALIGN); } X last = this_bitfield_unit_start + BITFIELD_UNIT_SIZE; } X X if (size + s[i] <= last) { X start [i] = size; X size += s[i]; } X else { X this_bitfield_unit_start = roundup (size, BITFIELD_UNIT_ALIGN); X start [i] = this_bitfield_unit_start; X size = this_bitfield_unit_start + s[i]; } X X align = MAX (align, BITFIELD_SIZE_ALIGN [s[i]]); } X X else { X if (last_was_bitfield && BITFIELD_PAD_FIELD) { X size = roundup (size, BITFIELD_UNIT_ALIGN); } X start[i] = roundup (size, a[i]); X size = start[i] + s[i]; X align = MAX (align, a[i]); } X X last_was_bitfield = p[i]; X stop [i] = start[i] + s[i] - 1; } X X size = roundup (size, align); X for (i = 0; i < NUMBER_PAD_SIZES; i++) { X if (size <= PAD_SIZES [i]) { X size = PAD_SIZES [i]; X padded = 1; X break; }} X if (padded == 0) { X size = roundup (size, PAD_SIZES [NUMBER_PAD_SIZES - 1]); } X} X Xint wrong (si, al, nb_fields) X int si, al, nb_fields; X{ X int i; X X try (nb_fields); X if ((size != si) || (align != al)) { X if (report_losses) { X printf ("%d %d %d %d %d FAILS on %s", X BITFIELD_UNIT_SIZE, X BITFIELD_UNIT_ALIGN, X FIELD_PAD_BITFIELD, X BITFIELD_PAD_FIELD, X BITFIELD_UNITS_OVERLAP, X block); X for (i = 0; i < nb_fields; i++) { X if (p[i]) { X printf (" %d", s[i]); }} X printf (": %d, %d instead of %d, %d\n", size, align, si, al); } X return 1; } X X return 0; X} X Xint X try_OVERLAP[] = {0, 1}, X try_SIZE[] = {8, 16, 32, 64, 128}, X try_ALIGN[] = {8, 16, 32, 64, 128}, X try_FPB[] = {0, 1}, X try_BPF[] = {0, 1}; X Xint search () X{ X int winner =0; X int t_OVERLAP, t_SIZE, t_ALIGN, t_FPB, t_BPF; X X for (t_SIZE = 0; X t_SIZE < sizeof (try_SIZE) / sizeof (int); X t_SIZE++) { X BITFIELD_UNIT_SIZE = try_SIZE [t_SIZE]; X X for (t_ALIGN = 0; X t_ALIGN < sizeof (try_ALIGN) / sizeof (int); X t_ALIGN++) { X BITFIELD_UNIT_ALIGN = try_ALIGN [t_ALIGN]; X X for (t_FPB = 0; X t_FPB < sizeof (try_FPB) / sizeof (int); X t_FPB++) { X FIELD_PAD_BITFIELD = try_FPB [t_FPB]; X X for (t_BPF = 0; X t_BPF < sizeof (try_BPF) / sizeof (int); X t_BPF++) { X BITFIELD_PAD_FIELD = try_BPF [t_BPF]; X X for (t_OVERLAP = 0; X t_OVERLAP < sizeof (try_OVERLAP) / sizeof (int); X t_OVERLAP++) { X BITFIELD_UNITS_OVERLAP = try_OVERLAP [t_OVERLAP]; X X block = "S_"; X a[0] = 1; p[0] = 1; X s[0] = 0x19; if (wrong (SZ (S0x19), AL (S0x19), 1)) continue; X s[0] = 0x02; if (wrong (SZ (S0x02), AL (S0x02), 1)) continue; X s[0] = 0x20; if (wrong (SZ (S0x20), AL (S0x20), 1)) continue; X s[0] = 0x04; if (wrong (SZ (S0x04), AL (S0x04), 1)) continue; X s[0] = 0x05; if (wrong (SZ (S0x05), AL (S0x05), 1)) continue; X s[0] = 0x08; if (wrong (SZ (S0x08), AL (S0x08), 1)) continue; X s[0] = 0x09; if (wrong (SZ (S0x09), AL (S0x09), 1)) continue; X s[0] = 0x0c; if (wrong (SZ (S0x0c), AL (S0x0c), 1)) continue; X s[0] = 0x10; if (wrong (SZ (S0x10), AL (S0x10), 1)) continue; X s[0] = 0x11; if (wrong (SZ (S0x11), AL (S0x11), 1)) continue; X s[0] = 0x14; if (wrong (SZ (S0x14), AL (S0x14), 1)) continue; X s[0] = 0x17; if (wrong (SZ (S0x17), AL (S0x17), 1)) continue; X s[0] = 0x18; if (wrong (SZ (S0x18), AL (S0x18), 1)) continue; X s[0] = 0x01; if (wrong (SZ (S0x01), AL (S0x01), 1)) continue; X X block = "Sc_"; X s[0] = s_char; a[0] = a_char; p[0] = 0; X a[1] = 1; p[1] = 1; X s[1] = 0x19; if (wrong (SZ (Sc0x19), AL (Sc0x19), 2)) continue; X s[1] = 0x02; if (wrong (SZ (Sc0x02), AL (Sc0x02), 2)) continue; X s[1] = 0x20; if (wrong (SZ (Sc0x20), AL (Sc0x20), 2)) continue; X s[1] = 0x04; if (wrong (SZ (Sc0x04), AL (Sc0x04), 2)) continue; X s[1] = 0x05; if (wrong (SZ (Sc0x05), AL (Sc0x05), 2)) continue; X s[1] = 0x08; if (wrong (SZ (Sc0x08), AL (Sc0x08), 2)) continue; X s[1] = 0x09; if (wrong (SZ (Sc0x09), AL (Sc0x09), 2)) continue; X s[1] = 0x0c; if (wrong (SZ (Sc0x0c), AL (Sc0x0c), 2)) continue; X s[1] = 0x10; if (wrong (SZ (Sc0x10), AL (Sc0x10), 2)) continue; X s[1] = 0x11; if (wrong (SZ (Sc0x11), AL (Sc0x11), 2)) continue; X s[1] = 0x14; if (wrong (SZ (Sc0x14), AL (Sc0x14), 2)) continue; X s[1] = 0x17; if (wrong (SZ (Sc0x17), AL (Sc0x17), 2)) continue; X s[1] = 0x18; if (wrong (SZ (Sc0x18), AL (Sc0x18), 2)) continue; X s[1] = 0x01; if (wrong (SZ (Sc0x01), AL (Sc0x01), 2)) continue; X X block = "Ss_"; X s[0] = s_short; a[0] = a_short; p[0] = 0; X a[1] = 1; p[1] = 1; X s[1] = 0x19; if (wrong (SZ (Ss0x19), AL (Ss0x19), 2)) continue; X s[1] = 0x02; if (wrong (SZ (Ss0x02), AL (Ss0x02), 2)) continue; X s[1] = 0x20; if (wrong (SZ (Ss0x20), AL (Ss0x20), 2)) continue; X s[1] = 0x04; if (wrong (SZ (Ss0x04), AL (Ss0x04), 2)) continue; X s[1] = 0x05; if (wrong (SZ (Ss0x05), AL (Ss0x05), 2)) continue; X s[1] = 0x08; if (wrong (SZ (Ss0x08), AL (Ss0x08), 2)) continue; X s[1] = 0x09; if (wrong (SZ (Ss0x09), AL (Ss0x09), 2)) continue; X s[1] = 0x0c; if (wrong (SZ (Ss0x0c), AL (Ss0x0c), 2)) continue; X s[1] = 0x10; if (wrong (SZ (Ss0x10), AL (Ss0x10), 2)) continue; X s[1] = 0x11; if (wrong (SZ (Ss0x11), AL (Ss0x11), 2)) continue; X s[1] = 0x14; if (wrong (SZ (Ss0x14), AL (Ss0x14), 2)) continue; X s[1] = 0x17; if (wrong (SZ (Ss0x17), AL (Ss0x17), 2)) continue; X s[1] = 0x18; if (wrong (SZ (Ss0x18), AL (Ss0x18), 2)) continue; X s[1] = 0x01; if (wrong (SZ (Ss0x01), AL (Ss0x01), 2)) continue; X X block = "Si_"; X s[0] = s_int; a[0] = a_int; p[0] = 0; X a[1] = 1; p[1] = 1; X s[1] = 0x19; if (wrong (SZ (Si0x19), AL (Si0x19), 2)) continue; X s[1] = 0x02; if (wrong (SZ (Si0x02), AL (Si0x02), 2)) continue; X s[1] = 0x20; if (wrong (SZ (Si0x20), AL (Si0x20), 2)) continue; X s[1] = 0x04; if (wrong (SZ (Si0x04), AL (Si0x04), 2)) continue; X s[1] = 0x05; if (wrong (SZ (Si0x05), AL (Si0x05), 2)) continue; X s[1] = 0x08; if (wrong (SZ (Si0x08), AL (Si0x08), 2)) continue; X s[1] = 0x09; if (wrong (SZ (Si0x09), AL (Si0x09), 2)) continue; X s[1] = 0x0c; if (wrong (SZ (Si0x0c), AL (Si0x0c), 2)) continue; X s[1] = 0x10; if (wrong (SZ (Si0x10), AL (Si0x10), 2)) continue; X s[1] = 0x11; if (wrong (SZ (Si0x11), AL (Si0x11), 2)) continue; X s[1] = 0x14; if (wrong (SZ (Si0x14), AL (Si0x14), 2)) continue; X s[1] = 0x17; if (wrong (SZ (Si0x17), AL (Si0x17), 2)) continue; X s[1] = 0x18; if (wrong (SZ (Si0x18), AL (Si0x18), 2)) continue; X s[1] = 0x01; if (wrong (SZ (Si0x01), AL (Si0x01), 2)) continue; X X block = "Sl_"; X s[0] = s_long; a[0] = a_long; p[0] = 0; X a[1] = 1; p[1] = 1; X s[1] = 0x19; if (wrong (SZ (Sl0x19), AL (Sl0x19), 2)) continue; X s[1] = 0x02; if (wrong (SZ (Sl0x02), AL (Sl0x02), 2)) continue; X s[1] = 0x20; if (wrong (SZ (Sl0x20), AL (Sl0x20), 2)) continue; X s[1] = 0x04; if (wrong (SZ (Sl0x04), AL (Sl0x04), 2)) continue; X s[1] = 0x05; if (wrong (SZ (Sl0x05), AL (Sl0x05), 2)) continue; X s[1] = 0x08; if (wrong (SZ (Sl0x08), AL (Sl0x08), 2)) continue; X s[1] = 0x09; if (wrong (SZ (Sl0x09), AL (Sl0x09), 2)) continue; X s[1] = 0x0c; if (wrong (SZ (Sl0x0c), AL (Sl0x0c), 2)) continue; X s[1] = 0x10; if (wrong (SZ (Sl0x10), AL (Sl0x10), 2)) continue; X s[1] = 0x11; if (wrong (SZ (Sl0x11), AL (Sl0x11), 2)) continue; X s[1] = 0x14; if (wrong (SZ (Sl0x14), AL (Sl0x14), 2)) continue; X s[1] = 0x17; if (wrong (SZ (Sl0x17), AL (Sl0x17), 2)) continue; X s[1] = 0x18; if (wrong (SZ (Sl0x18), AL (Sl0x18), 2)) continue; X s[1] = 0x01; if (wrong (SZ (Sl0x01), AL (Sl0x01), 2)) continue; X X block = "Sc_c"; X s[0] = s_char; a[0] = a_char; p[0] = 0; X a[1] = 1; p[1] = 1; X s[2] = s_char; a[2] = a_char; p[2] = 0; X s[1] = 0x19; if (wrong (SZ (Sc0x19c), AL (Sc0x19c), 3)) continue; X s[1] = 0x02; if (wrong (SZ (Sc0x02c), AL (Sc0x02c), 3)) continue; X s[1] = 0x20; if (wrong (SZ (Sc0x20c), AL (Sc0x20c), 3)) continue; X s[1] = 0x04; if (wrong (SZ (Sc0x04c), AL (Sc0x04c), 3)) continue; X s[1] = 0x05; if (wrong (SZ (Sc0x05c), AL (Sc0x05c), 3)) continue; X s[1] = 0x08; if (wrong (SZ (Sc0x08c), AL (Sc0x08c), 3)) continue; X s[1] = 0x09; if (wrong (SZ (Sc0x09c), AL (Sc0x09c), 3)) continue; X s[1] = 0x0c; if (wrong (SZ (Sc0x0cc), AL (Sc0x0cc), 3)) continue; X s[1] = 0x10; if (wrong (SZ (Sc0x10c), AL (Sc0x10c), 3)) continue; X s[1] = 0x11; if (wrong (SZ (Sc0x11c), AL (Sc0x11c), 3)) continue; X s[1] = 0x14; if (wrong (SZ (Sc0x14c), AL (Sc0x14c), 3)) continue; X s[1] = 0x17; if (wrong (SZ (Sc0x17c), AL (Sc0x17c), 3)) continue; X s[1] = 0x18; if (wrong (SZ (Sc0x18c), AL (Sc0x18c), 3)) continue; X s[1] = 0x01; if (wrong (SZ (Sc0x01c), AL (Sc0x01c), 3)) continue; X X block = "Sc__"; X s[0] = s_char; a[0] = a_char; p[0] = 0; X a[1] = 1; p[1] = 1; X a[2] = 1; p[2] = 1; X s[1]=s[2]=0x19; if (wrong (SZ (Sc0x190x19), AL (Sc0x190x19), 3)) continue; X s[1]=s[2]=0x02; if (wrong (SZ (Sc0x020x02), AL (Sc0x020x02), 3)) continue; X s[1]=s[2]=0x20; if (wrong (SZ (Sc0x200x20), AL (Sc0x200x20), 3)) continue; X s[1]=s[2]=0x04; if (wrong (SZ (Sc0x040x04), AL (Sc0x040x04), 3)) continue; X s[1]=s[2]=0x05; if (wrong (SZ (Sc0x050x05), AL (Sc0x050x05), 3)) continue; X s[1]=s[2]=0x08; if (wrong (SZ (Sc0x080x08), AL (Sc0x080x08), 3)) continue; X s[1]=s[2]=0x09; if (wrong (SZ (Sc0x090x09), AL (Sc0x090x09), 3)) continue; X s[1]=s[2]=0x0c; if (wrong (SZ (Sc0x0c0x0c), AL (Sc0x0c0x0c), 3)) continue; X s[1]=s[2]=0x10; if (wrong (SZ (Sc0x100x10), AL (Sc0x100x10), 3)) continue; X s[1]=s[2]=0x11; if (wrong (SZ (Sc0x110x11), AL (Sc0x110x11), 3)) continue; X s[1]=s[2]=0x14; if (wrong (SZ (Sc0x140x14), AL (Sc0x140x14), 3)) continue; X s[1]=s[2]=0x17; if (wrong (SZ (Sc0x170x17), AL (Sc0x170x17), 3)) continue; X s[1]=s[2]=0x18; if (wrong (SZ (Sc0x180x18), AL (Sc0x180x18), 3)) continue; X s[1]=s[2]=0x01; if (wrong (SZ (Sc0x010x01), AL (Sc0x010x01), 3)) continue; X X block = "Sc__c"; X s[0] = s_char; a[0] = a_char; p[0] = 0; X a[1] = 1; p[1] = 1; X a[2] = 1; p[2] = 1; X s[3] = s_char; a[3] = a_char; p[3] = 0; X s[1]=s[2]=0x19; if (wrong (SZ (Sc0x190x19c), AL (Sc0x190x19c), 4)) continue; X s[1]=s[2]=0x02; if (wrong (SZ (Sc0x020x02c), AL (Sc0x020x02c), 4)) continue; X s[1]=s[2]=0x20; if (wrong (SZ (Sc0x200x20c), AL (Sc0x200x20c), 4)) continue; X s[1]=s[2]=0x04; if (wrong (SZ (Sc0x040x04c), AL (Sc0x040x04c), 4)) continue; X s[1]=s[2]=0x05; if (wrong (SZ (Sc0x050x05c), AL (Sc0x050x05c), 4)) continue; X s[1]=s[2]=0x08; if (wrong (SZ (Sc0x080x08c), AL (Sc0x080x08c), 4)) continue; X s[1]=s[2]=0x09; if (wrong (SZ (Sc0x090x09c), AL (Sc0x090x09c), 4)) continue; X s[1]=s[2]=0x0c; if (wrong (SZ (Sc0x0c0x0cc), AL (Sc0x0c0x0cc), 4)) continue; X s[1]=s[2]=0x10; if (wrong (SZ (Sc0x100x10c), AL (Sc0x100x10c), 4)) continue; X s[1]=s[2]=0x11; if (wrong (SZ (Sc0x110x11c), AL (Sc0x110x11c), 4)) continue; X s[1]=s[2]=0x14; if (wrong (SZ (Sc0x140x14c), AL (Sc0x140x14c), 4)) continue; X s[1]=s[2]=0x17; if (wrong (SZ (Sc0x170x17c), AL (Sc0x170x17c), 4)) continue; X s[1]=s[2]=0x18; if (wrong (SZ (Sc0x180x18c), AL (Sc0x180x18c), 4)) continue; X s[1]=s[2]=0x01; if (wrong (SZ (Sc0x010x01c), AL (Sc0x010x01c), 4)) continue; X X block = "Sc_s"; X s[0] = s_char; a[0] = a_char; p[0] = 0; X a[1] = 1; p[1] = 1; X s[2] = s_short; a[2] = a_short; p[2] = 0; X s[1] = 0x19; if (wrong (SZ (Sc0x19s), AL (Sc0x19s), 3)) continue; X s[1] = 0x02; if (wrong (SZ (Sc0x02s), AL (Sc0x02s), 3)) continue; X s[1] = 0x20; if (wrong (SZ (Sc0x20s), AL (Sc0x20s), 3)) continue; X s[1] = 0x04; if (wrong (SZ (Sc0x04s), AL (Sc0x04s), 3)) continue; X s[1] = 0x05; if (wrong (SZ (Sc0x05s), AL (Sc0x05s), 3)) continue; X s[1] = 0x08; if (wrong (SZ (Sc0x08s), AL (Sc0x08s), 3)) continue; X s[1] = 0x09; if (wrong (SZ (Sc0x09s), AL (Sc0x09s), 3)) continue; X s[1] = 0x0c; if (wrong (SZ (Sc0x0cs), AL (Sc0x0cs), 3)) continue; X s[1] = 0x10; if (wrong (SZ (Sc0x10s), AL (Sc0x10s), 3)) continue; X s[1] = 0x11; if (wrong (SZ (Sc0x11s), AL (Sc0x11s), 3)) continue; X s[1] = 0x14; if (wrong (SZ (Sc0x14s), AL (Sc0x14s), 3)) continue; X s[1] = 0x17; if (wrong (SZ (Sc0x17s), AL (Sc0x17s), 3)) continue; X s[1] = 0x18; if (wrong (SZ (Sc0x18s), AL (Sc0x18s), 3)) continue; X s[1] = 0x01; if (wrong (SZ (Sc0x01s), AL (Sc0x01s), 3)) continue; X X block = "Sc__s"; X s[0] = s_char; a[0] = a_char; p[0] = 0; X a[1] = 1; p[1] = 1; X a[2] = 1; p[2] = 1; X s[3] = s_short; a[3] = a_short; p[3] = 0; X s[1]=s[2]=0x19; if (wrong (SZ (Sc0x190x19s), AL (Sc0x190x19s), 4)) continue; X s[1]=s[2]=0x02; if (wrong (SZ (Sc0x020x02s), AL (Sc0x020x02s), 4)) continue; X s[1]=s[2]=0x20; if (wrong (SZ (Sc0x200x20s), AL (Sc0x200x20s), 4)) continue; X s[1]=s[2]=0x04; if (wrong (SZ (Sc0x040x04s), AL (Sc0x040x04s), 4)) continue; X s[1]=s[2]=0x05; if (wrong (SZ (Sc0x050x05s), AL (Sc0x050x05s), 4)) continue; X s[1]=s[2]=0x08; if (wrong (SZ (Sc0x080x08s), AL (Sc0x080x08s), 4)) continue; X s[1]=s[2]=0x09; if (wrong (SZ (Sc0x090x09s), AL (Sc0x090x09s), 4)) continue; X s[1]=s[2]=0x0c; if (wrong (SZ (Sc0x0c0x0cs), AL (Sc0x0c0x0cs), 4)) continue; X s[1]=s[2]=0x10; if (wrong (SZ (Sc0x100x10s), AL (Sc0x100x10s), 4)) continue; X s[1]=s[2]=0x11; if (wrong (SZ (Sc0x110x11s), AL (Sc0x110x11s), 4)) continue; X s[1]=s[2]=0x14; if (wrong (SZ (Sc0x140x14s), AL (Sc0x140x14s), 4)) continue; X s[1]=s[2]=0x17; if (wrong (SZ (Sc0x170x17s), AL (Sc0x170x17s), 4)) continue; X s[1]=s[2]=0x18; if (wrong (SZ (Sc0x180x18s), AL (Sc0x180x18s), 4)) continue; X s[1]=s[2]=0x01; if (wrong (SZ (Sc0x010x01s), AL (Sc0x010x01s), 4)) continue; X X#include "code.h" X X winner = 1; X printf ("\nBITFIELD_UNIT_SIZE %d\n", BITFIELD_UNIT_SIZE); X printf ("BITFIELD_UNIT_ALIGN %d\n", BITFIELD_UNIT_ALIGN); X printf ("FIELD_PAD_BITFIELD %d\n", FIELD_PAD_BITFIELD); X printf ("BITFIELD_PAD_FIELD %d\n", BITFIELD_PAD_FIELD); X printf ("BITFIELD_UNITS_OVERLAP %d\n", BITFIELD_UNITS_OVERLAP); X }}}}} X X return winner; X} X X Xstatic int c[33] = { X sizeof (SC0x01), X sizeof (SC0x02), X sizeof (SC0x03), X sizeof (SC0x04), X sizeof (SC0x05), X sizeof (SC0x06), X sizeof (SC0x07), X sizeof (SC0x08), X sizeof (SC0x09), X sizeof (SC0x0a), X sizeof (SC0x0b), X sizeof (SC0x0c), X sizeof (SC0x0d), X sizeof (SC0x0e), X sizeof (SC0x0f), X sizeof (SC0x10), X sizeof (SC0x11), X sizeof (SC0x12), X sizeof (SC0x13), X sizeof (SC0x14), X sizeof (SC0x15), X sizeof (SC0x16), X sizeof (SC0x17), X sizeof (SC0x18), X sizeof (SC0x19), X sizeof (SC0x1a), X sizeof (SC0x1b), X sizeof (SC0x1c), X sizeof (SC0x1d), X sizeof (SC0x1e), X sizeof (SC0x1f), X sizeof (SC0x20), X 0}; X X Xfind_pad_sizes () X{ X int i, j, ok; X X for (i = 0; i < 24; i++) { X ok = 1; X for (j = i + 1; j < 24; j++) { X if (c[j] != roundup (j+1, c[i])) { X ok = 0; }} X if (ok == 1) { X NUMBER_PAD_SIZES = 0; X for (j = 0; j <= i; j++) { X if ((NUMBER_PAD_SIZES == 0) || (c[j] != c[NUMBER_PAD_SIZES-1])) { X printf ("PAD_SIZE = %d\n", c [j] * BITS_PER_BYTE); } X PAD_SIZES [NUMBER_PAD_SIZES++] = c[j] * BITS_PER_BYTE; }} X return; } X} X Xfind_bits_per_byte () X{ X char c; X int b; X X c = 1; X b = 0; X do { c = c << 1; X b++; } while (c != 0); X X BITS_PER_BYTE = b; X printf ("\nBITS PER BYTE = %d\n", b); X} X X Xbasic_sizes_and_alignments () X{ X X s_char = SZ (char); X a_char = AL (char); X s_short = SZ (short); X a_short = AL (short); X s_int = SZ (int); X a_int = AL (int); X s_long = SZ (long); X a_long = AL (long); X X s_float = SZ (float); X a_float = AL (float); X s_double = SZ (double); X a_double = AL (double); X X printf ("SIZEOF char = %d\n", s_char); X printf ("ALIGNOF char = %d\n", a_char); X printf ("SIZEOF short = %d\n", s_short); X printf ("ALIGNOF short = %d\n", a_short); X printf ("SIZEOF int = %d\n", s_int); X printf ("ALIGNOF int = %d\n", a_int); X printf ("SIZEOF long = %d\n", s_long); X printf ("ALIGNOF long = %d\n", a_long); X printf ("SIZEOF float = %d\n", s_float); X printf ("ALIGNOF float = %d\n", a_float); X printf ("SIZEOF double = %d\n", s_double); X printf ("ALIGNOF double = %d\n", a_double); X} X X#define SHOW(T,Tn) \ X { T *a; int i, j; \ X a = (T *) &v; \ X for (i = 0; i < sizeof (v)/sizeof(T); i++) { a[i] = 0; } \ X printf ("%s; size = %d, seen as %s\n", desc, sizeof (v), Tn); \ X for (i = 0; i < sizeof (v) / sizeof(T); i++) { \ X for (j = 0; j < BITS_PER_BYTE * sizeof(T); j++) { \ X a[i] = 1 << j; \ X PRINT; } \ X a[i] = 0; }} X Xbit_positions () X{ X printf ("\n\nBIT POSITIONS\n"); X X { short v; X char *desc = "short"; X#undef PRINT X#define PRINT printf (" %d, %d = %d\n", i, j, v); X SHOW(char, "char") } X X { int v; X char *desc = "int"; X#undef PRINT X#define PRINT printf (" %d, %d = %d\n", i, j, v); X SHOW(short, "short") } X X { long v; X char *desc = "long"; X#undef PRINT X#define PRINT printf (" %d, %d = %d\n", i, j, v); X SHOW(int, "int") } X X { struct {char a; int b:23; int c:9; char d;} v; X char *desc = "struct {char, int :23, int :9, char}"; X#undef PRINT X#define PRINT printf (" %d, %d = %d, %d, %d, %d\n", i,j,v.a,v.b,v.c,v.d); X SHOW(char, "char") } X X { struct {char a; int b:23; int c:9;} v; X char *desc = "struct {char, int :23, int :9}"; X#undef PRINT X#define PRINT printf (" %d, %d = %d, %d, %d, %d\n", i, j, v.a, v.b, v.c); X SHOW(char, "char") } X X { struct {int b:23; int c:9;} v; X char *desc = "struct {int:23, int:9}"; X#undef PRINT X#define PRINT printf (" %d, %d = %d, %d\n", i, j, v.b, v.c); X SHOW(char, "char") } X X { struct {int b:10; int c:24;} v; X char *desc = "struct {int:10, int:24}"; X#undef PRINT X#define PRINT printf (" %d, %d = %d, %d\n", i, j, v.b, v.c); X SHOW(char, "char") } X} X Xfind_bitfield_aligns () X{ X BITFIELD_SIZE_ALIGN [0x01] = SZ (S0x01); X BITFIELD_SIZE_ALIGN [0x02] = SZ (S0x02); X BITFIELD_SIZE_ALIGN [0x03] = SZ (S0x03); X BITFIELD_SIZE_ALIGN [0x04] = SZ (S0x04); X BITFIELD_SIZE_ALIGN [0x05] = SZ (S0x05); X BITFIELD_SIZE_ALIGN [0x06] = SZ (S0x06); X BITFIELD_SIZE_ALIGN [0x07] = SZ (S0x07); X BITFIELD_SIZE_ALIGN [0x08] = SZ (S0x08); X BITFIELD_SIZE_ALIGN [0x09] = SZ (S0x09); X BITFIELD_SIZE_ALIGN [0x0a] = SZ (S0x0a); X BITFIELD_SIZE_ALIGN [0x0b] = SZ (S0x0b); X BITFIELD_SIZE_ALIGN [0x0c] = SZ (S0x0c); X BITFIELD_SIZE_ALIGN [0x0d] = SZ (S0x0d); X BITFIELD_SIZE_ALIGN [0x0e] = SZ (S0x0e); X BITFIELD_SIZE_ALIGN [0x0f] = SZ (S0x0f); X BITFIELD_SIZE_ALIGN [0x10] = SZ (S0x10); X BITFIELD_SIZE_ALIGN [0x11] = SZ (S0x11); X BITFIELD_SIZE_ALIGN [0x12] = SZ (S0x12); X BITFIELD_SIZE_ALIGN [0x13] = SZ (S0x13); X BITFIELD_SIZE_ALIGN [0x14] = SZ (S0x14); X BITFIELD_SIZE_ALIGN [0x15] = SZ (S0x15); X BITFIELD_SIZE_ALIGN [0x16] = SZ (S0x16); X BITFIELD_SIZE_ALIGN [0x17] = SZ (S0x17); X BITFIELD_SIZE_ALIGN [0x18] = SZ (S0x18); X BITFIELD_SIZE_ALIGN [0x19] = SZ (S0x19); X BITFIELD_SIZE_ALIGN [0x1a] = SZ (S0x1a); X BITFIELD_SIZE_ALIGN [0x1b] = SZ (S0x1b); X BITFIELD_SIZE_ALIGN [0x1c] = SZ (S0x1c); X BITFIELD_SIZE_ALIGN [0x1d] = SZ (S0x1d); X BITFIELD_SIZE_ALIGN [0x1e] = SZ (S0x1e); X BITFIELD_SIZE_ALIGN [0x1f] = SZ (S0x1f); X BITFIELD_SIZE_ALIGN [0x20] = SZ (S0x20); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x01, SZ (S0x01)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x02, SZ (S0x02)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x03, SZ (S0x03)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x04, SZ (S0x04)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x05, SZ (S0x05)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x06, SZ (S0x06)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x07, SZ (S0x07)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x08, SZ (S0x08)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x09, SZ (S0x09)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x0a, SZ (S0x0a)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x0b, SZ (S0x0b)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x0c, SZ (S0x0c)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x0d, SZ (S0x0d)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x0e, SZ (S0x0e)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x0f, SZ (S0x0f)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x10, SZ (S0x10)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x11, SZ (S0x11)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x12, SZ (S0x12)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x13, SZ (S0x13)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x14, SZ (S0x14)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x15, SZ (S0x15)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x16, SZ (S0x16)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x17, SZ (S0x17)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x18, SZ (S0x18)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x19, SZ (S0x19)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x1a, SZ (S0x1a)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x1b, SZ (S0x1b)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x1c, SZ (S0x1c)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x1d, SZ (S0x1d)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x1e, SZ (S0x1e)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x1f, SZ (S0x1f)); X printf ("BITFIELD_SIZE_ALIGN [%02d] = %d\n", 0x20, SZ (S0x20)); X X} X Xmain () X{ X find_bits_per_byte (); X basic_sizes_and_alignments (); X find_pad_sizes (); X find_bitfield_aligns (); X report_losses = 0; X if (search () != 1) { X report_losses = 1; X search (); } X else { X bit_positions (); } X exit (0); X} SHAR_EOF $TOUCH -am 0608225692 params.c && chmod 0644 params.c || echo "restore of params.c failed" set `wc -c params.c`;Wc_c=$1 if test "$Wc_c" != "34762"; then echo original size 34762, current size $Wc_c fi # ============= random.c ============== echo "x - extracting random.c (Text)" sed 's/^X//' << 'SHAR_EOF' > random.c && Xenum {Tchar, Tshort, Tint, Tlong, Tfloat, Tdouble, Tbit} types; X Xchar* typeNames [] = {"char", "short", "int", "long", "float", "double"}; X Xint typeFreq [] = {Tchar, Tshort, Tint, Tlong, Tfloat, Tdouble, X Tbit, Tbit, Tbit, Tbit, Tbit, Tbit, X Tbit, Tbit, Tbit, Tbit, Tbit, Tbit, X Tbit, Tbit, Tbit, Tbit, Tbit, Tbit, }; X Xint sizeFreq [] = {1, 2, 3, 5, 8, 10, 16, 17, X 19, 20, 21, 22, 24, 27, 29, 32}; X Xmain (argc, argv) X int argc; X char **argv; X{ X int r, nfields, f, ftype, fsize, n; X X int ftypes = fopen ("types.h", "w", 0666); X int fcode = fopen ("code.h", "w", 0666); X X if (argc <= 1) { X n = 300; } X else { X n = atoi (argv[1]); } X X for (r = 1; r <= n; r++) { X nfields = 5 + (rand () % 10); X X fprintf (ftypes, "typedef struct {"); X X for (f = 0; f < nfields; f++) { X ftype = typeFreq [rand () % (sizeof (typeFreq) / sizeof (int))]; X if (ftype == Tbit) { X fsize = sizeFreq [rand () % (sizeof (sizeFreq) / sizeof (int))]; X fprintf (ftypes, "int x%d: %d; ", f, fsize); X fprintf (fcode, "s[%d]=%d; a[%d]=1; p[%d]=1;\n", f, fsize, f, f); } X else { X fprintf (ftypes, "%s x%d; ", typeNames [ftype], f); X fprintf (fcode, "s[%d]=s_%s; a[%d]=a_%s; p[%d]=0;\n", X f, typeNames[ftype], f, typeNames [ftype], f); } X if (f % 5 == 0) { X fprintf (ftypes, "\n"); }} X X fprintf (ftypes, "} R%d; R%d v%d;\n\n", r, r, r); X fprintf (fcode, "if (wrong (SZ (R%d), AL (R%d), %d)) continue;\n\n", X r, r, nfields); } X} SHAR_EOF $TOUCH -am 0608230192 random.c && chmod 0644 random.c || echo "restore of random.c failed" set `wc -c random.c`;Wc_c=$1 if test "$Wc_c" != "1484"; then echo original size 1484, current size $Wc_c fi # ============= Makefile ============== echo "x - extracting Makefile (Text)" sed 's/^X//' << 'SHAR_EOF' > Makefile && XCFLAGS = -g X Xall:: get_desc clean compute_result mail_result X Xget_desc: FRC X @echo "You can change CC and CFLAGS (e.g. 'make CC=mycc')" X @echo "to test various compilers." X @echo "Please enter a description of your system, i.e.:" X @echo " cpu type" X @echo " operating system and version" X @echo " compiler and version" X @echo "as well an any comment you want to make" X @echo "End by " X @echo "Thanks for you help !" X cat - > config X echo "CC = " $CC >> config X echo "CFLAGS = " $CFLAGS >> config X Xclean: X rm -f code.h types.h X Xcode.h: X @echo "---- generating some random structures" X -$(CC) $(CFLAGS) -o random random.c X -./random 300 X touch code.h types.h X Xcompute_result: code.h X @echo "---- if the C compiler does not like big programs" X @echo " you may need to run random with a smaller argument" X $(CC) $(CFLAGS) -o params params.c X params > result X cat result X Xmail_result: FRC X cat config result | mail -s "struct, test2" muller@src.dec.com X XFRC: X SHAR_EOF $TOUCH -am 0608233792 Makefile && chmod 0644 Makefile || echo "restore of Makefile failed" set `wc -c Makefile`;Wc_c=$1 if test "$Wc_c" != "979"; then echo original size 979, current size $Wc_c fi exit 0 -- Send compilers articles to compilers@iecc.cambridge.ma.us or {ima | spdcc | world}!iecc!compilers. Meta-mail to compilers-request. ======================================================================= 66 === Date: 10 Jun 92 15:13:51 GMT From: dagenais@vlsi.polymtl.ca (Michel Dagenais) Subject: Modula 3 BOF meeting at SIGPLAN 92 PLDI in San Francisco As announced earlier, there will be a Modula 3 BOF meeting on Thursday June 18 at 19h30 during the SIGPLAN 92 PLDI conference. Of course it does not replace the Full Day user group meeting held on Tuesday at DEC SRC. It should be a good occasion for present and prospective Modula 3 users to meet and discuss. The exact location will be found on the BOF sheet in the PLDI registration package. -- --------------------------------------------------------------------- Prof. Michel Dagenais dagenais@vlsi.polymtl.ca Dept of Electrical and Computer Eng. Ecole Polytechnique de Montreal tel: (514) 340-4029 --------------------------------------------------------------------- ======================================================================= 67 === Date: Thu, 11 Jun 1992 01:50:51 GMT From: krishnan@cs.arizona.edu (Venkata Krishnan) Subject: yacc spec for MODULA-3 ? Can anybody out there please mail me the yacc specification for MODULA-3? Thanks a lot. -Venkat ** krishnan@cs.arizona.edu ** [There's a Modula-2 parser in the compilers archives, don't know how different the syntax of M-3 is. -John] -- Send compilers articles to compilers@iecc.cambridge.ma.us or {ima | spdcc | world}!iecc!compilers. Meta-mail to compilers-request. ======================================================================= 68 === Date: 11 Jun 92 23:47:14 +0200 From: wfouche@sunvax.sun.ac.za Subject: Why is a.out so big? I've just installed the SRC M3 compiler and hope never to program in C again! One question though: can someone please tell why a stripped, null Modula-3 program is 319488 bytes big on a SPARC running SunOS 4.1.1? I compiled -------- MODULE Main; BEGIN END Main. -------- using $ m3 -O Main.m3; strip a.out; ls -l a.out to get -rwxr-xr-x 1 werner 319488 Jun 11 23:35 a.out Thank you. Werner ---- Werner Fouche' (Student) Department of Computer Science University of Stellenbosch Stellenbosch, 7600 South Africa ======================================================================= 69 === Date: Sun, 14 Jun 1992 05:21:38 GMT From: andru@concerto.lcs.mit.edu (Andrew Myers) Subject: m3process - Modula-3 preprocessor Send me mail if you want a copy of this. It compiles fine on Decstations; I make no guarantees about the ease of compiling it on other machines, though I expect the amount of work will be small or zero. It is written in C and bison (yacc). Andrew Public Domain M3PROCESS(1) NAME m3process - process Modula 3 source files SYNOPSIS m3process [ -o output-file ] [ -uldfps ] DESCRIPTION m3process creates Modula-3 interface and implementation files (both gen- eric and normal) from source files written in an almost identical language that I will call "m3" for convenience. There are two major differences between m3 and Modula-3. In m3, keywords and reserved words may be either all-uppercase or all-lowercase. In addition, semicolons are not allowed in m3. Variables may be introduced at any point within a block of code. They will remain in scope until the end of the block. To indicate this variety of scoping, a double colon "::" is placed after the variable declarations (rather than a "begin...end"). The ordinary block-style variable declarations are still supported. m3process will insert line number information in the processed results that will allow compilation errors to be correctly located in the origi- nal m3 file. Sometimes an identifier from a standard package looks like a keyword, in lowercase (e.g. "val"). To let m3process know that the identifier is not a keyword, it must be preceded by a backslash, e.g. "\val". Iden- tifiers that are part uppercase, part lowercase, will not be treated as keywords (e.g. Text). m3process parses m3 source files considerably faster than the current implementation of the Modula-3 compiler, so you also get the advantage of faster error reporting (though it doesn't recover from parse errors). OPTIONS -o output-file Sets the output file. If m3process fails, this file will be deleted, which helps when using make(1). If this option is not specified, the Modula-3 source is sent to standard output. -u Turn off the conversion of keywords to uppercase. -s Turn off the semicolon processing, so semicolons are required as usual in Modula-3. If both the -u and -s options are specified, m3process will transmit the input file unchanged. -l Don't insert LINE pragmas into the Modula-3 source. Has no effect if the -s option is specified. -p Automatically run the Modula-3 output through the pretty-printer, 1 M3PROCESS(1) Public Domain m3pp. -f input-file Changes the name of the input file as specified in the LINE prag- mas inserted into the output text. Normally, the pragmas contain the name of the file passed to m3process. -d Spew reams of YACC gibberish if the -s option is specified. EXAMPLES The Modula-3 interface file "foo.i3" INTERFACE foo; TYPE node <: REFANY; END foo. could be replaced by an m3 interface file "foo.h": interface foo type node <: refany end foo. A generic implementation "goo.mg" and a m3 equivalent "goo.m" are: UNSAFE GENERIC MODULE goo(itemTypeInterface); BEGIN VAR a := 0; BEGIN ... statements ... END END goo. unsafe generic module goo(itemTypeInterface) begin var a := 0 :: ... statements ... end goo. BUGS, LIMITATIONS Statements cannot start with a left parenthesis. This can only happen if the statement is a procedure call, in which case the parentheses must be 2 Public Domain M3PROCESS(1) unnecessary. "RETURN", "EXIT", "BREAK", "RAISE" statements cannot immediately be followed by another statement. Such a statement could never be reached, anyway. Comments and pragmas may shift around a little bit in the output text, and the line number information is not always perfectly accurate, since several consecutive lines may be "credited" to an earlier line. With that caveat stated, line numbers are usually right on, and comments and pragmas stay where they were put unless they are imbedded in the middle of an expression: var (* hello *) a := (3 + (* hi mom *) 4) becomes var (* hello *) a := (3 + 4); (* hi mom *) Pragmas that depend on being located at a particular syntactic location; e.g. ASSERT, UNUSED, FATAL; will stay in the right place. Debugging when you get a parse error can be confusing at first, espe- cially since the error messages are currently of low quality, e.g. "Line 527: Parse error". Note that semicolons will automatically cause a parse error, since m3 doesn't allow them (unless -s is used). Comments, bug reports are welcome. FILES ucm3, sem3, m3pp AUTHOR Andrew Myers (andru@lcs.mit.edu) 3 ======================================================================= 70 === Date: 14 Jun 92 19:15:17 GMT From: pk@john.informatik.rwth-aachen.de (Peter Klein) Subject: Re: Optimization on SPARC >Until recently, I used gcc 1.4 as back end for the SRC modula-3 system (with >SunOS 4.1.2). This went quite well. But since we upgraded to 2.1, I can't use >optimization anymore. If I build a new compiler from scratch with -O (or -O2), >the resulting compiler won't even compile libm3 - it reports >"../runtime/src/generic/RT0.i3", line 157: types are not assignable >"../runtime/src/generic/RT0.i3", line 158: types are not assignable >These lines contain the declaration of two CARDINAL variables with implicit >initialization to a zero value. >I tried to use Sun cc instead, but this one also failed when used with >optimization. In a great program system, it caused a weird behaviour in some >places (especially in LOOPHOLEs). >Since I know that gcc works fine on a DECstation, I wonder if there are pieces >in the SPARC runtime modules which are prone to be optimized into wrong code. >Can anybody help? I just tried gcc 2.2.1 with the same result. Peter Klein E-Mail: pk@rwthi3.informatik.rwth-aachen.de Lehrstuhl fuer Informatik III Tel.: +49/241/80-21320 Ahornstrasse 55 Fax.: +49/241/80-21329 RWTH Aachen D-5100 Aachen Germany ======================================================================= 71 === Date: Mon, 15 Jun 1992 03:00:02 GMT From: ma@Xerox.com (QingMing Ma) Subject: Re: Optimization on SPARC In article , pk@john.informatik.rwth-aachen.de (Peter Klei n) writes: > >Until recently, I used gcc 1.4 as back end for the SRC modula-3 system (with > >SunOS 4.1.2). This went quite well. But since we upgraded to 2.1, I can't us e > >optimization anymore. If I build a new compiler from scratch with -O (or -O2 ), > >the resulting compiler won't even compile libm3 - it reports > > >"../runtime/src/generic/RT0.i3", line 157: types are not assignable > >"../runtime/src/generic/RT0.i3", line 158: types are not assignable > > >These lines contain the declaration of two CARDINAL variables with implicit > >initialization to a zero value. > > >I tried to use Sun cc instead, but this one also failed when used with > >optimization. In a great program system, it caused a weird behaviour in some > >places (especially in LOOPHOLEs). > > >Since I know that gcc works fine on a DECstation, I wonder if there are piec es > >in the SPARC runtime modules which are prone to be optimized into wrong code . > >Can anybody help? > > I just tried gcc 2.2.1 with the same result. > David goldberg and I at Xerox PARC have recently figured out why "gcc -O" does not work when buliding Modula-3 compiler on SPARC machines. The version of gcc we used is 2.1, and the OS is SunOS 4.1.1-GF. 1. As long as you compile the following file ../compiler/boot-SPARC/SubrangeType_m.c to .o file by using gcc without -O, then the compiler can be built. This new compiler can compile all files in the libm3. In other words, you can build Modula-3 compiler with "gcc -O", if you first compile the file SubrangeType_m.c into SubrangeType_m.o separately with just gcc. 2. If you use gcc and gcc -O compile the following attached C code respectively , you will get different run time results 0 and -2147483648 for the same input 2147483647. This is the only but the whole reason we found why "gcc -O" failed in building Modula-3 compiler for SPARC machines. #include main(argc, argv) int argc; char **argv; { int i, j; i = 0; j = atoi(argv[1]) + 1; if (0 < j) i = j; printf("%d\n", i); } Qingming Ma ======================================================================= 72 === Date: Mon, 15 Jun 92 18:30:38 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: Why is a.out so big? In article <5144.2a37e602@sunvax.sun.ac.za>, wfouche@sunvax.sun.ac.za writes: > One question though: can someone please tell why a stripped, > null Modula-3 program is 319488 bytes big on a SPARC running SunOS 4.1.1? Any Modula-3 program compiled with SRC Modula-3 will contain a fair amount of runtime code, even if it is not needed. You get a garbage collector, a user-level thread mechanism, runtime support for type manipulation (for the gc and pickles), among other things. -- Eric. ======================================================================= 73 === Date: Tue, 16 Jun 1992 21:39:54 GMT From: wewallac@watsol.waterloo.edu (Bill Wallace) Subject: Porting Modula 3 to LINUX I am working on this currently (I have just started.) If anyone is interested in helping me (I will post to the net when I have it done, and of course ftp it to dec.) I would appreciate any help. The initial problem is 14 character file names, which may be solved in the next release (0.97). Bill Wallace New OED ======================================================================= 74 === Date: Wed, 17 Jun 1992 18:31:24 GMT From: eggert@twinsun.com (Paul Eggert) Subject: Re: Optimization on SPARC ma@Xerox.com (QingMing Ma) writes: >2. If you use gcc and gcc -O compile the following attached C code respectivel y, >you will get different run time results 0 and -2147483648 for the same input >2147483647. This is the only but the whole reason we found why "gcc -O" failed >in building Modula-3 compiler for SPARC machines. >#include > >main(argc, argv) >int argc; >char **argv; >{ > int i, j; > i = 0; > j = atoi(argv[1]) + 1; > if (0 < j) > i = j; > printf("%d\n", i); >} Strictly speaking GCC is entitled to print whatever it wants for this example, since in C the behavior is undefined after integer overflow has occurred. I'm not saying that GCC is _wise_ to print nonsense here; only that it's _allowed_ to. Perhaps the Modula-3 implementation could be fixed to use unsigned instead of signed integers for the case in question, since in C unsigned arithmetic always yields defined results. ======================================================================= 75 === Date: Thu, 18 Jun 92 20:37:29 GMT From: msm@src.dec.com (Mark S. Manasse) Subject: Re: M3 port to Macintosh? MPW C? Incidentally, I'm quite eager to help someone understand enough of the dark side of XClient and XScreenType to port Trestle to native Macintosh or MS windows. If someone would just get a compiler running, we'd be all set :-) Mark ======================================================================= 76 === Date: Fri, 19 Jun 1992 08:35:24 GMT From: Andreas Wuertz Subject: Re: M3 port to Macintosh? MPW C? In article <1992Jun6.081534.7065@ucc.su.OZ.AU> Darko Volaric, dvorak@extro.ucc.su.OZ.AU writes: >Has anyone ported the SRC M3 compiler to MPW C or something similar? If not, >does anyone have any opinions on how hard this would be to do, assuming things >like threads were left out? I know MPW GNU C exists - is there a M3 GNU port >or is there only the GNU Project M3? Actually I'm quite new to this group, I don't know how difficult the port will be, but I'd like to do it; I'm an experienced Mac programmer (MPW) and very interested in Modula, be it Modula 2 or 3. Andy from TIK ======================================================= The earliest time for a program to be bug-free is, when it's out of date. The latest time for a programmer to retire is, when he writes such a program. ======================================================= ======================================================================= 77 === Date: 19 Jun 92 15:44:39 GMT From: ludwig@inf.ethz.ch (Stefan Ludwig) Subject: Re: Method call overhead in Oberon-2 In article <26H421D82U@tron.gun.de> g_dotzel@tron.gun.de (Guenter Dotzel) write s: > > Recently I've read a discussion in CompuServe's CLMForum on the calling >overhead for dynamically bound procedures (methods) in Eiffel and C++. They >talked about 50 microseconds overhead (on fast workstations) compared to >calling statically bound (compile time known) procedures. I wonder what they are doing wrong... ;-) (see below) > > Calling dynamically bound methods (type bound procedures) seems to be >much faster in Oberon-2: > > In our Oberon-2 implementation H2O for VAX/VMS it takes only two move >longword instructions (MOVL) to get the pointer value and it's tag pointer >(type descriptor) in addition to the procedure/method call (CALLS) instruction >with an deferred destination operand and method-offset. Correct. Same here on CISC or RISC implementations. I made some measurements on my Ceres-3 workstation. CPU: National Semiconductor NS32GX32 @ 25MHz (512 Bytes I-Cache, 1024 D-Cache) With the (pseudo-) declarations below I got the following timings: (Each call was made 1 million times and the loop overhead was subtracted) obj: Object = POINTER TO RECORD END; obj2: Object2 = POINTER TO RECORD handle: PROCEDURE (self: Object2; VAR m: Msg) END; Msg = RECORD END; m: Msg2 = RECORD(Msg) x, y: INTEGER END; Methods implemented with handlers and message records. On the handler's side, a type guard to the m parameter is applied to guard it to a Msg2: m.x := 5; m.y := 10; obj2.handle(obj2, m) 5.9 microsec / call MOVQW 5,-4(FP) MOVW 10,-2(FP) MOVD obj2(SB),TOS MOVD DESC5(SB),TOS ;Typedesc Msg2 ADDR -4(FP),TOS CXPD 0(obj2(SB)) Methods implemented with type-bound procedures: obj.Method(5, 10) 4.1 microsec / call MOVD -4(obj(SB)),R7 MOVD obj(SB),TOS MOVQD 5,TOS MOVXWD 10,TOS CXPD 328(R7) For comparison, an external procedure call: M.Call(obj, 5, 10) 3.9 microsec / call MOVD obj(SB),TOS MOVQD 5,TOS MOVXWD 10,TOS CXP M.P1 These results indicate either that the C++ and Eiffel guys (which produce C code) don't know how to generate code, or that the times from Guenter are taken out of context. Even in the case of multiple inheritance (C++ and Eiffel) one should not see a tenfold increase of execution time for a method call over Oberon (with similar hardware). BTW: A method call here is only 5% slower than an external call. BTW 2: You could use message records and still have a better performance than C++ and so on... Frankly, I think you got the numbers wrong, Guenter... Has anybody got timings for Modula-3 (they produce C code, too)? Cheers, Stefan Stefan H-M Ludwig ludwig@inf.ethz.ch Institute for Computer Systems Swiss Federal Institute of Technology (ETH) Zurich, Switzerland "No way I'd speak for ETH or ICS!" ======================================================================= 78 === Date: Fri, 19 Jun 1992 17:38:44 GMT From: templ@inf.ethz.ch (Josef Templ) Subject: Re: Method call overhead in Oberon-2 The numbers for Eiffel are correct given that assertion checks are turned on (a compiler switch). I did some benchmarks in Eiffel 2.1 and was quite surprised when I discovered that Eiffel is a hundred times as slow as Oberon or C (C++ is almost as fast as C). After turning off assertion checking Eiffel ran about three times as slow as Oberon or C. I didn't look at the generated C code, but I guess that they are using signals to implement the asertion mechanism (even in the absence of assertions!). - Josef Templ (the usual disclaimer) ======================================================================= 79 === Date: Sat, 20 Jun 1992 20:45:23 GMT From: jez@osf.org (Jez Wain) Subject: M3 on DS3100_OSF I have tried building v2.0 on a DECStation 3100 running OSF/1 v1.0 only to find the build fail during the link-edit phase of the compiler and driver directories fail with the error: FloatMode_m.o: Undefined symbol "swapRM" referenced Having not been able to find any other reference to this name except in FPU_i.c (in both directories), I turn to the news group for help. I should perhaps also add that I created a directory: ./m3make/DS3100_OSF, and copied the config file from model-configs/DS3100, changing the PASS1 options from: PASS1 = @cc@-G@0@-Wf,-XNp200000@-Wf,-XNd150000@ to: PASS1 = @cc@-G@0@ as the copmiler (gcc) does not support the options -W nor -X I renamed the directories ./compiler/DS3100 and ./driver/DS3100 to DS3100_OSF. What do I have to do? ======================================================================= 80 === Date: Mon, 22 Jun 1992 14:42:25 GMT From: braeu@untadi.enet.dec.com (Walter Braeu) Subject: VAX/VMS Does anybody know about a VAX/VMS implementation of Modula-3? Walter Walter Braeu walter.braeu@unt.mts.dec.com ======================================================================= 81 === Date: Mon, 22 Jun 1992 18:59:02 GMT From: dagenais@vlsi.polymtl.ca (Michel Dagenais) Subject: Modula 3 SIGPLAN BOF and MUG The Modula 3 user group meeting was held last Tuesday (16/06/92). I was really impressed by the demos and by what should be released in the coming year. The MUG organizer, John De Treville, and all the group at DEC SRC deserve our gratitude for their hospitality and excellent work. (The BOF is discussed at the end of this posting). Here is my unofficial "highlights" list for those who could not attend: - The group of Modula 3 users and developpers at DEC SRC has enlarged considerably since last January. Developments should arrive faster than ever. - Native Modula 3 compiler and debugger (perhaps atop gdb) in about 6 months . - GNU Modula 3 (based on gcc and gdb) at about the same time. May serve as a base for a DOS port. - An Interface Police was created (human) to help insuring that all modules in the DEC SRC library are coherent and follow similar programming conventions. (May produce programming conventions and library indexing/browsing tools). - Additions to Trestle, most notably FormsVBT for rapidly generating user interfaces from a small lisp-like description (with instant preview without needs to compile or link). May already be on gatekeeper! - Pickles will be machine independant and will not require seeking. They will serve as a base for network objects: objects that you can send from one process to another while their references to other network objects remain consistent. - Project Mentor: animation tools for algorithms. A library of well known algorithms (found in standard courses on algorithms or data structures) will be coded in Modula 3 and acompanied by a graphic animation produced in the Mentor framework. You can see a parse tree being built through shift/reduce while you step through the code, or a balanced tree in action while items are added or removed... - Static verification of locking levels in multi-threaded applications using formal specification techniques (project Sparta). - Various tools based on the AST toolkit. A Modula 3 BOF was held at PLDI. Most of the attendees had already met at the Tuesday MUG meeting and discussions proceeded informally. The universities teaching Modula 3 at various levels were discussed. The problem of making Modula 3 available to the masses (people with small machines) was probably the major point. Most students and hobbyist seem to have access to a 386 or better machine. Thus, a port of GNU modula 3 to DOS may be the easiest solution. It would not, however, provide an integrated "TURBO" environment. Perhaps PC users involved enough to do real programming would not mind installing something like Windows NT (or OS/2) which is a better base than DOS for a complete port (debugger, Trestle...). -- --------------------------------------------------------------------- Prof. Michel Dagenais dagenais@vlsi.polymtl.ca Dept of Electrical and Computer Eng. Ecole Polytechnique de Montreal tel: (514) 340-4029 --------------------------------------------------------------------- ======================================================================= 82 === Date: 22 Jun 92 22:35:06 GMT From: dagenais@vlsi.polymtl.ca (Michel Dagenais) Subject: Questions on Trestle VBT sizes Two short questions: 1) Is there a way to obtain the size of a tree of VBTs without displaying it. Perhaps avoiding the Trestle.install ? However i suspect that some of the screen dependant resources like fonts need to be resolved before the size is available? 2) We have splits used to represent mathematical equations. Parenthesis, integral, "over" do resize to cover their childs. The problem we have is one of alignment. Suppose that we have a + b + c where a, b and c are themselves complex expressions. The horizontal HVSplit that contains a + b + c does adjust to be as large as the largest of a, b and c. Then, a, b and c get centered vertically and thus get misaligned. I suppose that we have to put a, b and c in vertical HVSplits with blank above and below them. We still need to provide adequate alignment information. Is this achieved by providing "domains" or "sizes" adequately computed with respect to the origin? Any better idea? -- --------------------------------------------------------------------- Prof. Michel Dagenais dagenais@vlsi.polymtl.ca Dept of Electrical and Computer Eng. Ecole Polytechnique de Montreal tel: (514) 340-4029 --------------------------------------------------------------------- ======================================================================= 83 === Date: Tue, 23 Jun 92 17:17:40 GMT From: jdd@src.dec.com (John DeTreville) Subject: Modula-3 Users' Group meeting report: part 2 of 4 (summary of talks) Here are my own brief summaries of the talks. The speakers should feel free to post additions or corrections! The speakers are all included in the list of attendees posted in a separate message; feel free to contact them if you would like more or better information. Bill Kalsow from DEC SRC spoke on "SRC Modula-3 in '93". SRC is working this year to improve its Modula-3 implementation by adding a native code back-end to its compiler; porting a language-level debugger to Modula-3; improving the libraries to make them more portable, better documented, and in a consistent style; investigating alternative garbage collectors, including a real-time collector; and considering a possible speedup of exceptions in the normal case. Jim Meehan, also from DEC SRC, gave a demo of FormsVBT, a system for building user interfaces; FormsVBT simplifies the creation and modification of UI dialogs and their use from within application programs. FormsVBT's layout model is adapted from TeX's, and it includes a dialog editor. FormsVBT dialogs are based on the vbtkit library of Trestle widgets. Jim's demo was very well received, and many attendees said they were looking forward to FormsVBT's imminent release. Eliot Moss from the University of Massachusetts at Amherst spoke on GNU Modula-3, the new implementation of Modula-3 that his group has been pursuing. GNU Modula-3 is based on gcc, the GNU C compiler, and Eliot intends to distribute GNU Modula-3 through FSF, the Free Software Foundation, alongside the other GNU software. Eliot described how the structure of the GNU Modula-3 compiler is different from gcc's, and listed some of its innovative goals, including accurate garbage collection and persistent objects. The GNU Modula-3 compiler is now generating code for most constructs; the major remaining tasks include full debugger support and an implementation of threads. They hope to be able to compile the SRC Modula-3 libraries by the end of the summer, and to support the full language by the end of the year. Mick Jordan from DEC SRC spoke on the M3AST toolkit. The toolkit is based on an extensible Abstract Syntax Tree specification of Modula-3 programs, and the corresponding parser front-end and related tool-building components. The toolkit supports the creation of tools such as stub-generators, browsers, and source-level transformers. Mick demoed a simple use of the toolkit to parse a large program, find syntax errors, step through them with Emacs, and then reparse only the changed modules. Following a ten-minute break, Dave Nichols from Xerox PARC CSL gave a talk on "Modula-3 RPC". He and Marvin Theimer designed their system to be protocol-compatible with Sun RPC, accepting Sun-style rpcgen interface files, but to have reasonable Modula-3 bindings that would work in the multi-threaded Modula-3 environment. The programmer's view is like network objects: the result of a Bind is an object with an appropriate method suite. David Evers from Cambridge University then spoke on "Network objects over ANSA". ANSA is an distributed systems framework in place at the Cambridge University Computer Lab, and their Modula-3 network objects scheme plugs well into ANSA. Applications so far include m3coffee, a client of a remote video device viewing the communal coffee pot, as well as a Trestle-based active badge monitor and an experimental inter-tool communication framework for CAD. Andrew Birrell from DEC SRC described the evolving pickle design in Modula-3, and their planned use in SRC's network object system. Pickles allow an arbitrary data structure to be copied into a byte-stream, such as a file; the byte-stream can later be read and a copy of the original data structure reconstructed. Improvements in the design of pickles allow them to be used as a marshaling method for network objects. Alan Demers from Xerox PARC CSL spoke on replacing the Modula-3 runtime with PPCR. PPCR is the Posix Portable Common Runtime, CSL's language-independent runtime system that provides threads, garbage-collection, etc., on top of any Posix environment. PPCR's forerunner, PCR, was developed to make Cedar programs more portable, and has also been hosted C and Common Lisp. Alan asked people to consider whether PPCR might make a useful alternative runtime environment for Modula-3, giving the programmer another option; using PPCR would give different functionality and performance characteristics. He also said that some parts, like Hans Boehm's garbage collector, might be usable in the Modula-3 runtime independent of the rest of PPCR. David Chase from Sun Microsystems talked on "Portably safe conservative garbage collection". The SRC Modula-3 compiler produces C as an intermediate language, which is compiled by an ordinary C compiler. If this compiler performs certain increasingly common optimizations, such as replacing source-level pointers with derived pointers in the generated code, this can break conservative garbage collector, such as Joel Bartlett's collector which is used in the current SRC implementation. David proposed a stop-gap contract with C compiler writers, which he explained is already met in all existing C compilers; along with a stylized form of intermediate C generation, this contract would guarantee that optimizations could be used and conservative collection would still work. After another ten-minute break, Frode Odegard from Odegard Labs in San Francisco spoke on "Commercializing Modula-3". Frode categorized Modula-3 as a research language, which might someday become a commercial language. To aspire to that goal, we need more PR, availability on more platforms, better positioning in the marketplace, and high-quality implementations, even if that means starting new implementations from scratch. In order to practice what he preaches, his company plans to provide a commercial-quality programming environment for Modula-3; he's now looking for early adopters, whom he urges to contact him directly. John DeTreville from DEC SRC followed with a talk on "Taking over the world with Modula-3". Modula-3 is a successful language design, but what is needed to make it a successful language in the world? SRC continues to improve and export its implementation and libraries; we encourage third parties to port it to new architectures, including PCs, or to make wholly new implementations. SRC plans to write more papers and give more talks on Modula-3; to push its use in education, where SRC believes it has a good chance of acceptance and which would be an influential toehold; and to work to build and strengthen the user community through efforts such as the MUG meeting. Marc H. Brown from DEC SRC spoke on "Promoting Modula-3 for Computer Science education in undergraduate algorithms courses", one example of what John had described. His project will choose algorithms from a set of undergraduate algorithms texts, and will produce high-quality animations of these algorithms that can be used for teaching. Once his group gets the foundations in place, a large number of interested SRCers will produce the animations in a marathon two-week "Animation Festival" this summer; these animations will be written in Modula-3, and distributed via network in time for professors to use in the fall term, providing a useful service and helping increase the number of installed copies of the Modula-3 system. Even non-SRCers might be able to take part; contact Marc for more information. Greg Nelson from DEC SRC spoke on automatic locking-level verification. When Greg and Mark Manasse designed Trestle, a complex concurrent system, they had to avoid race conditions and deadlocks; they evolved a system of stylized comments that associated "locking levels" with procedures and data, then convinced themselves that the program obeyed the locking levels. Greg is now working on automatic verification of locking level assertions, translating Modula-3 programs to guarded commands, and from the guarded commands generating a formal statement of the desired property, which can then be sent to a theorem prover. Greg said that although he would ultimately like failures of the assertions to be reported to the programmer much as type-system violations are now reported, it is not useful to think of this problem as just another kind of type-checking, since one should not expect to find similarly simple algorithms for checking validity. David Goldberg from Xerox PARC CSL finished the morning session with his talk, "Why does Modula-3 have all those required Float interfaces?" The answer is, because David lobbied to have them put in; his goal was to allow programmers to write efficient portable programs that could, at least in principle, be proved to meet accuracy guarantees. Among the features added were the ability to query the environment for information on the floating-point implementation. The talks in the morning session were 10-20 minutes. The talks in the afternoon session were 5-10 minutes, and included a number of short demos. Andrew Birrell from DEC SRC gave a demo of Postcard, a GUI application for reading mail and Usenet news. Postcard is a client of FormsVBT, described earlier, and the application itself is rather small, with the UI functionality being primarily provided by the FormsVBT libraries. Michel Dagenais from the Ecole Polytechnique de Montreal spoke on "Modula-3 for CAD applications". Modula-3 was chosen for CAD system development at l'Ecole Polytechnique because of language features--modules, safety, threads--and because of implementation features--extensive libraries, ASTs, and a freely available reference implementation. Since CAD applications have a large number of communicating tools, and deal with complex objects, they are looking forward to using network objects and pickles. Loretta Guarino and Cynthia Hibbard from DEC SRC gave a demo of Hector, a workbench for lexicographers. Loretta and Cynthia work on joint project between SRC and the Oxford University Press to experiment with software tools to support lexicographers preparing a dictionary. The Hector UI is based on FormsVBT, and showed many of its features. Bert Laverman from the University of Groningen spoke on "Generic programming in Modula-3". As part of his thesis research, Bert is studying ways to add type parameterization to Modula-3. For example, imagine the definition of a function from any type to the same type; this can be done in current Modula-3 using generics, but Bert would propose extending the language with MetaTypes to allow the declaration of such functions directly. S. Lee Odegard, a student at Western Washington University, had intended to demo a Modula-3 application he has been building, but instead spoke briefly on other topics. Norman Ramsey from Princeton University spoke on "PostScript: an extension language for Modula-3". Extension languages, like elisp in GNU Emacs, make applications programmable, and enable fast-turnaround experimentation. Norman has implemented a subset of PostScript, without types or operators for fonts or graphics, as a useful extension language for Modula-3 programs. His implementation can be ftp'd from princeton.edu:pub/ldb. Jorge Stolfi from DEC SRC gave a talk on using Modula-3 generics. Jorge has been one of the most intense users of Modula-3 generics, and listed a number of problems with their use. For example, if a generic module has sub-modules, the instantiator must be aware of this internal structure, and must also instantiate all the sub-modules. Jorge suggested a macro facility as an alternative to generics. Finally, Win Treese from the DEC Cambridge Research Laboratory spoke on "A Modula-3 Domain Name Server". Because of shortcomings in the current Internet Domain Name Server implementation, Win is building a new implementation that will also serve as a testbed for experimentation. He has chosen Modula-3 because it supports threads and objects, and because of the libraries available, as well as being able to interface well with Unix. The work is underway. Cheers, John ======================================================================= 84 === Date: Tue, 23 Jun 92 17:15:01 GMT From: jdd@src.dec.com (John DeTreville) Subject: Modula-3 Users' Group meeting report: part 1 of 4 (overview) This summer's Modula-3 Users' Group Meeting was held Tuesday, 16 June 1992, at DEC's Systems Research Center in Palo Alto, California. The meeting was jointly sponsored by DEC SRC and by the Xerox PARC Computer Science Laboratory. There were 68 attendees from 30 organizations. Greg Nelson reminds me that this is much better turnout than the first such meeting some while ago, with 6 attendees sitting around a table discussing details of the SRC implementation. I hope we can sustain this rate of growth! There were 5 1/2 hours of technical talks, not including breaks and lunch, followed by breakout sessions for group discussions of specific technical areas. This is the first of four messages that I'm sending out. The other three messages are: 2) My own brief summaries of the talks. Feel free to contact the speakers directly for more or better information. 3) A list of attendees, with their affiliations and email addresses. 4) Summaries of the breakout sessions, written by members of each group. I'm sending out 2 and 3 this same morning; message 4 will be out by the end of this week. Late next week, I will also be able to mail out copies of the speakers' slides, plus any other materials, like abstracts and papers, that they have provided me. If you would like to receive these, please send me your postal address. I regret that this material is available on paper only. If you've already sent me a message asking for slides, send me another. Copies of slides will not be automatically sent to attendees; you must request a copy, and send me your postal address. (If any speakers have additional materials that they would like to include in these packages, please let me know.) And what about next year? There was general agreement to try to hold a similar meeting in 1993, that SIGPLAN PLDI or OOPSLA attendees could also attend. Many thanks to everyone who attended, and to everyone who gave a presentation. Cheers, John ======================================================================= 85 === Date: Tue, 23 Jun 92 17:19:19 GMT From: jdd@src.dec.com (John DeTreville) Subject: Modula-3 Users' Group meeting report: part 3 of 4 (list of attendees) Here is the list of attendees for the 1992 MUG meeting, followed by a breakdown of their affiliations. Summer students at DEC SRC or at Xerox PARC CSL are listed with both their summer and academic affiliations and email addresses. Bob Ayers Adobe ayers@adobe.com Nina Bhatti Xerox PARC CSL / University of Arizona bhatti@parc.xerox.com / nina@cs.arizona.edu Andrew Birrell DEC SRC birrell@src.dec.com Hans Boehm Xerox PARC CSL boehm@parc.xerox.com Marc H. Brown DEC SRC mhb@src.dec.com Mark R. Brown DEC SRC mbrown@src.dec.com Luca Cardelli DEC SRC luca@src.dec.com David Chase Sun Microsystems chased@eng.sun.com Joao Comba DEC SRC / Federal University of Rio de Janeiro comba@src.dec.com Michel Dagenais Ecole Polytechnique de Montreal dagenais@vlsi.polymtl.ca Vincent Delacour Xerox PARC CSL delacour@parc.xerox.com Jim des Rivieres Xerox PARC SSL desrivieres@parc.xerox.com Dave Detlefs DEC SRC detlefs@src.dec.com John DeTreville DEC SRC jdd@src.dec.com Alan Demers Xerox PARC CSL demers@parc.xerox.com Amer Diwan University of Massachusetts diwan@cs.umass.edu Mike Dixon Xerox PARC SSL mdixon@parc.xerox.com Michael Elliott Rancho Santiago College elliottm@beach.csulb.edu David Evers Cambridge University Computer Lab David.Evers@cl.cam.ac.uk Jerry Farrell Sun Microsystems farrell@sun.com Yasushi Fujiwara Stanford University fujiwara@theory.stanford.edu Hania Gajewska DEC SRC hania@src.dec.com Steve Glassman DEC SRC steveg@src.dec.com David Goldberg Xerox PARC CSL goldberg@parc.xerox.com Loretta Guarino DEC SRC guarino@src.dec.com John Guttag MIT guttag@lcs.mit.edu Dave Hanson Princeton University drh@princeton.edu Sam Harbison Tartan, Inc. harbison@tartan.com Carl Hauser Xerox PARC CSL hauser@parc.xerox.com Allan Heydon DEC SRC heydon@src.dec.com Cynthia Hibbard DEC SRC Hibbard@src.dec.com Angie Hinrichs Xerox PARC CSL / MIT hinrichs@parc.xerox.com / dill@mit.edu Jim Horning DEC SRC horning@src.dec.com Rick Hudson University of Massachusetts hudson@cs.umass.edu Christian Jacobi Xerox PARC CSL jacobi@parc.xerox.com Kevin Jones DEC SRC kjones@src.dec.com Mick Jordan DEC SRC mjordan@src.dec.com Bill Kalsow DEC SRC kalsow@src.dec.com Bert Laverman University of Groningen laverman@cs.rug.nl Rustan Leino DEC SRC / Cal Tech rustan@src.dec.com QingMing Ma Xerox PARC CSL / CMU ma@parc.xerox.com / qma@cs.cmu.edu David Maltz Xerox PARC CSL / MIT maltz@parc.xerox.com / dmaltz@athena.mit.edu Mark Manasse DEC SRC msm@src.dec.com Jim Meehan DEC SRC meehan@src.dec.com Doug Moen Siemens Nixdorf doug@sni.ca Eliot Moss University of Massachusetts moss@cs.umass.edu Eric Muller DEC SRC muller@src.dec.com Donald Mullis DEC WSE dwm@pa.dec.com Marc Najork DEC SRC / University of Illinois najork@src.dec.com Greg Nelson DEC SRC gnelson@src.dec.com Dave Nichols Xerox PARC CSL nichols@parc.xerox.com Frode Odegard Odegard Labs frode@odegard.com S. Lee Odegard Western Washington University n8243274@henson.cc.wwu.edu Susan Owicki DEC SRC owicki@src.dec.com Norman Ramsey Princeton University nr@princeton.edu Larry Rau Tandem rau_larry@tandem.com Dave Redell DEC SRC redell@src.dec.com Tom Rodeheffer DEC SRC tomr@src.dec.com Jerry Saltzer MIT saltzer@lcs.mit.edu Jim Saxe DEC SRC saxe@src.dec.com Michael Sclafani DEC SRC sclafani@src.dec.com Jorge Stolfi DEC SRC stolfi@src.dec.com Doug Terry Xerox PARC CSL terry@parc.xerox.com Win Treese DEC Cambridge Research Laboratory treese@crl.dec.com Eric Veach DEC SRC / Stanford veach@src.dec.com Mark Weiser Xerox PARC CSL mark_weiser@parc.xerox.com Dave Wortman University of Toronto dw@dragon.fly.toronto.edu Ken Zadeck IBM Hawthorne Research Lab zadeck@watson.ibm.com -------------------- Here are the affiliations of the 1992 MUG attendees. 29 DEC SRC (includes 4 summer students also listed below) 1 DEC Cambridge Research Laboratory 1 DEC WSE 11 Xerox PARC CSL (includes 4 summer students also listed below) 2 Xerox PARC SSL 4 MIT 3 University of Massachusetts 2 Princeton University 2 Stanford University 1 CMU 1 Cal Tech 1 Cambridge University Computer Lab 1 Ecole Polytechnique de Montreal 1 Federal University of Rio de Janeiro 1 Rancho Santiago College 1 University of Arizona 1 University of Groningen 1 University of Illinois 1 University of Toronto 1 Western Washington University 2 Sun Microsystems 1 Adobe 1 IBM Hawthorne Research Lab 1 Odegard Labs 1 Siemens Nixdorf 1 Tandem 1 Tartan, Inc. Cheers, John ======================================================================= 86 === Date: 24 Jun 92 19:52:17 GMT From: brh@aquila.arh.cdc.com (brian r hanson x6009) Subject: Re: Modula 3 SIGPLAN BOF and MUG In article 92Jun22135902@pollux.vlsi.polymtl.ca, dagenais@vlsi.polymtl.ca (Mich el Dagenais) writes: >- Additions to Trestle, most notably FormsVBT for rapidly generating user > interfaces from a small lisp-like description (with instant preview > without needs to compile or link). May already be on gatekeeper! What is Trestle? --- Brian Hanson, Control Data Corporation Email: brh@ahse.cdc.com ======================================================================= 87 === Date: Wed, 24 Jun 92 19:01:10 GMT From: detlefs@src.dec.com (Dave Detlefs) Subject: New gnuemacs modula3-mode I have done a fair amoint of work on the gnuemacs modula3-mode, that I'd like to share with the community. Here's a short description, with the .el file to follow. I would be very interested in any feedback, especially on the new features I added. Thanks, and happy hacking! ---------------------------------------------------------------------- I just shipped a new version of the gnuemacs modula3.el. I've hacked this quite a lot, though I believe that I've set things up so that new behaviors are controlled by variables whose default values keep things the old way. However, I'd very much like people to change those variables and try out the new features. I'll quote from the doc-string for m3-mode on the new features: "This is a mode intended to support program development in Modula 3. There are three (!) different ways of avoiding tedious entry of constructs involving long uppercase keywords: 1) The template mechanism. [...] 2) The "aggressive pseudo-abbrev" mode. [...This is what I now call the previously existing abbrev mode...]... 3) The "polite pseudo-abbrev" mode. This differs from the "aggressive" mode in that it does not insert full template constructs. Instead, in this mode, TAB invoked at the end of a word completes just that current word as a keyword. This mode analyzes the context to restrict the choices admitted by partial prefixes to as small a set as possible. If more than 1 choice remain after this winnowing, they are ordered according to their popularity (assigned in an ad hoc manner by me, dld, and easily changed), and the first completion is performed, with a message that other completions are possible. If the choice is wrong, hitting TAB immediately will cycle through the other choices. ... There are also two independent mechanism for indenting/prettyprinting text. The main addition that I (dld) have made is adding the style of 'electric' indentation normally associated with gnuemacs language modes. Basically, all you need to know is that TAB, in addition to completing keywords, also indents the current line properly. The other mechanism uses a pretty printer (m3pp) ... Another new feature is END-matching and completion. Various non-nil values of the variable 'm3-electric-end' cause hitting TAB on a line containing just an END to do things like fill in the name of the procedure, module, or interface, or the keyword that starts the construct that the END completes. Another, independent, variable, 'm3-blink-end-matchers', temporarily blinks the curser at the beginning of the construct that the END matches. (An easy thing to add would be ESC-C-b, move-to-END-matcher, but I haven't done that yet.) If you want to use the new stuff, I ask that you put the following in your .emacs file: (defun m3-mode-hook-function () (setq m3-abbrev-enabled 'polite) (setq m3-electric-end 'all) ;; or 'proc-mod if you find this too intrusive (setq m3-blink-end-matchers t)) (setq m3-mode-hook 'm3-mode-hook-function) If you don't like something about the particular style of indentation it does, let me know. I've parameterized it so that there are a large number of variables to allow customization of indentation style; what you want may or may not be acheivable by a simple setting of variables. I, for example, add these (setq m3-METHODS-undent 1) (setq m3-OVERRIDES-undent 1) (setq m3-case-offset 2) to my m3-mode-hook-function. Again, I'm interested in any and all problems, and will try to fix them quickly. Finally, this also includes an experimental identifier-completion command. ESC-TAB will parse the entire file looking for valid completions of the current word as an identifier in your program, expand the current word to the longest unique prefix of the matches, and list the matches in the message area if the match is not unique. Sadly, even with modern hardware this is still too slow for moderately-sized files, and it has some bugs. I'll work on it further, in the meantime it's occasionally useful. I hope this gets used! Any comments will be appreciated. Dave ---------------- Cut here ---------------------------------------------- ;;; Last modified on Wed Jun 24 12:00:49 PDT 1992 by detlefs ;;; modified on Fri May 15 17:13:12 PDT 1992 by heydon ;;; modified on Thu Apr 23 17:45:03 PDT 1992 by muller ;;; modified on Fri Feb 2 13:04:24 1990 by discolo ;;; modified on Tue May 2 21:59:35 1989 by ellis ;;; modified by Trevor Morris ;;; modified by Tom Perrine ;;; modified by Michael Schmidt ;;; modified by Peter Robinson ;;; modified by mjordan ;; LCD Archive Entry: ;; modula3|Eric Muller|muller@src.dec.com| ;; Modula-3 mode.| ;; 92-04-17||~/modes/modula3.el.Z| (provide 'modula3) ; ; MODE SYNTAX TABLE (Added by TEP) ; (defvar m3-mode-syntax-table nil "Syntax table in use in Modula 3 mode buffers.") (if m3-mode-syntax-table () (let ((table (make-syntax-table))) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?* "." table) (modify-syntax-entry ?\( "()1" table) (modify-syntax-entry ?\) ")(4" table) (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\] ")[" table) (modify-syntax-entry ?{ "(}" table) (modify-syntax-entry ?} ")}" table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?% "." table) (modify-syntax-entry ?< "." table) (modify-syntax-entry ?> "." table) (modify-syntax-entry ?\' "\"" table) (setq m3-mode-syntax-table table))) ; ; MODE KEY MAP (Added by TEP) ; (defvar m3-mode-map nil "Keymap used in Modula 3 mode.") (defun setup-m3-mode-map () "Sets up Modula 3 mode map; this must be called after the sequence for the keypad key \"?\\C-@\" has been setup - it uses \"function-key-sequence\" on that key in order to bind the Modula 3 specific functions" (if m3-mode-map () (let ((map (make-sparse-keymap)) (other-map (make-sparse-keymap))) (define-key map "\t" 'm3-abbrev-and-or-indent) (define-key map "\M-\t" 'm3-ident-complete) (define-key map "\C-ca" 'm3-array) (define-key map "\C-cb" 'm3-block) (define-key map "\C-cc" 'm3-case) (define-key map "\C-cd" 'm3-declare) (define-key map "\C-ce" 'm3-else) (define-key map "\C-cf" 'm3-for) (define-key map "\C-ci" 'm3-if) (define-key map "\C-cm" 'm3-choose-module) (define-key map "\C-cl" 'm3-loop-or-lock) (define-key map "\C-c|" 'm3-next-case) (define-key map "\C-co" 'm3-object) (define-key map "\C-c\C-o" other-map) (define-key map "\C-cp" 'm3-procedure) (define-key map "\C-cr" 'm3-record) (define-key map "\C-ct" 'm3-try-or-typecase) (define-key map "\C-cu" 'm3-until) (define-key map "\C-cw" 'm3-while-or-with) (define-key map "\C-cy" 'm3-import) (define-key map "\C-c{" 'm3-begin-comment) (define-key map "\C-c}" 'm3-end-comment) (define-key other-map "a" 'm3-toggle-abbrev) (define-key other-map "v" 'm3-path-find-file) (define-key other-map "b" 'm3-toggle-buffer) (define-key other-map "c" 'm3-compile) (define-key other-map "p" 'm3-convert-proc-header) (setq m3-mode-map map) ))) ; ; INDENTATION ; (defvar m3-indent 2 "*This variable gives the indentation in Modula 3 Mode") ; ; ROUTINE TO CHECK IF BUFFER CONTAINS DEF MODULE ; (defun m3-is-def () "Does current buffer's name suggest that it contains an interface?" (or (string-equal (m3-get-extension (buffer-name)) ".i") (string-equal (m3-get-extension (buffer-name)) ".i3"))) ; ; THE MAIN ROUTINE - SETS UP MODULA-3 MODE ; (defun modula-3-mode () "This is a mode intended to support program development in Modula 3. There are three (!) different ways of avoiding tedious entry of constructs involving long uppercase keywords: 1) The template mechanism. All control constructs of Modula 3 can be reached by typing CNTRL C followed (usually!) by the first character of the construct. 2) The 'aggressive pseudo-abbrev' mode. Typing the first letter(s) of a construct and then hitting TAB will cause the full construct to be inserted. When there is overlap between two constructs (e.g. WITH and WHILE) type the smallest unique substring (e.g. \"wi\" for WITH) then hit TAB. If the abbreviation is not unique alphabetic ordering is used e.g. \"w\" gives WHILE rather than WITH. 3) The 'polite pseudo-abbrev' mode. This differs from the 'aggressive' mode in that it does not insert full template constructs. Instead, in this mode, TAB invoked at the end of a word completes just that current word as a keyword. This mode analyzes the context to restrict the choices admitted by partial prefixes to as small a set as possible. If more than 1 choice remain after this winnowing, they are ordered according to their popularity (assigned in an ad hoc manner by me, dld, and easily changed), and the first completion is performed, with a message that other completions are possible. If the choice is wrong, hitting TAB immediately will cycle through the other choices. The template mechanism is always available. The variable m3-abbrev-enabled controls the choice of aggressive or polite abbrev mode. There are also two independent mechanism for indenting/prettyprinting text. The main addition that I (dld) have made is adding the style of 'electric' indentation normally associated with gnuemacs language modes. Basically, all you need to know is that TAB, in addition to completing keywords, also indents the current line properly. ($I will soon add mechanisms for indenting the current unit, indenting a region, etc.) The other mechanism uses a pretty printer (m3pp) that runs as a separate process. The command m3pp-region and m3pp-unit, and the variable m3pp-options are used to apply m3pp to a portion of the buffer. These are not at present bound to specific keys. Another new feature is END-matching and completion. Various non-nil values of the variable 'm3-electric-end' cause hitting TAB on a line containing just an END to do things like fill in the name of the procedure, module, or interface, or the keyword that starts the construct that the END completes. Another, independent, variable, 'm3-blink-end-matchers', temporarily blinks the curser at the beginning of the construct that the END matches. ($An easy thing to add would be ESC-C-b, move-to-END-matcher) There are a few mode specific commands which are not to do with inserting text for language structures (e.g. compile module, toggle pseudo abbrev mode). These can be used by typing CTRL-C CTRL-O, \"O\" (for \"Other\") and then the command letter. See the following list for more detailed information. \\{m3-mode-map} The variable m3-indent controls the number of spaces for each indentation." (interactive) (kill-all-local-variables) (setup-m3-mode-map) (use-local-map m3-mode-map) (setq major-mode 'modula-3-mode) (setq mode-name "Modula 3") (make-local-variable 'end-comment-column) (setq end-comment-column 75) (set-syntax-table m3-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'indent-line-function) (setq indent-line-function 'm3-indent-line) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "(* ") (make-local-variable 'comment-end) (setq comment-end " *)") (make-local-variable 'comment-column) (setq comment-column 41) (make-local-variable 'comment-start-skip) (setq comment-start-skip "(\\*+[ \t]*") (make-local-variable 'comment-multi-line) (setq comment-multi-line t) (make-local-variable 'comment-indent-hook) (setq comment-indent-hook 'c-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (run-hooks 'm3-mode-hook)) ; ; FORMATTING ; (defun m3-newline () "Insert a newline and indent following line like previous line." (interactive) (let ((hpos (current-indentation))) (newline) (indent-to hpos))) (defun m3-tab () "Indent to next tab stop." (interactive) (indent-to (* (+ (/ (current-column) m3-indent) 1) m3-indent))) ;;;====================================================================== ;;; The stuff in this section relate to indentation. (defun m3-indent-line () "Indent the current-line." (interactive) (m3-indent-line-work t)) (defun m3-indent-line-work (electric) ;; If in unterminated string, give an error. If in comment and ;; electric, indent like previous line. ;;; (message "indent-line-work") (sit-for 2) (let ((string-comment-state (m3-in-comment-or-string))) (cond ((eq string-comment-state 'string) (beep) (message "Unterminated Text literal...")) ((eq string-comment-state 'comment) (if electric (let ((cur-point (point))) (beginning-of-line) (m3-skip-whitespace-in-line) (cond ;; If the current line begines with a close comment, ;; indent it to the level of the matching start comment. ((save-excursion (beginning-of-line) (m3-skip-whitespace-in-line) (looking-at "*)")) (m3-indent-to cur-point (save-excursion (beginning-of-line) (m3-skip-whitespace-in-line) (forward-char 2) (m3-skip-comment-backward (point-min) t) (current-column)))) ;;; If the current line begins with an open-comment, and ;;; the opened comment is not nested, indent like a code line. ((save-excursion (beginning-of-line) (m3-skip-whitespace-in-line) (and (looking-at "(*") (not (m3-in-comment-or-string)))) (m3-indent-to cur-point (m3-indent-for-line))) ;;; Otherwise, indent to same level as previous ;;; non-whitespace line. (t (m3-indent-to cur-point (save-excursion (forward-line -1) (while (looking-at m3-whitespace-line-re) (forward-line -1)) (m3-skip-whitespace-in-line) (if (looking-at "(\\*") (progn (forward-char 2) (m3-skip-whitespace-in-line))) (current-column)))))))) ;; We're not in a comment or a string. Indent the current line. (t (m3-indent-to (point) (m3-indent-for-line)) ;; Do the appropriate thing for electric end's. (m3-do-electric-end))))) (defun m3-indent-for-line () (save-excursion (beginning-of-line) (let ((cur-point (point)) (part-start (save-excursion (m3-backward-to-last-part-begin) (point))) (first-code (save-excursion (re-search-forward "[ \t]*" (save-excursion (end-of-line) (point)) t) (goto-char (match-end 0)) ;;; (message "first-code 2") (sit-for 2) (point))) ;; Must do this because Modula is case-sensitive (case-fold-search nil)) ;; Find end of previous statement or last keyword-line-starter. ;;; (message "m3-indent-for-line(A)") (sit-for 2) (m3-re-search-backward (concat "\\(;\\|^[ \t]*\\(" m3-keyword-line-starters "\\)\\)") part-start t) (while (m3-in-arg-list part-start) (m3-re-search-backward (concat "\\(;\\|^[ \t]*\\(" m3-keyword-line-starters "\\)\\)") part-start t)) ;;; (message "m3-indent-for-line(A10)") (sit-for 2) (cond ((and (looking-at ";") (save-excursion (beginning-of-line) (re-search-forward (concat "^[ \t]*\\(" m3-keyword-line-starters "\\)") (save-excursion (end-of-line) (point)) t))) (beginning-of-line) (re-search-forward "[ \t]*")) (t ;; skip to the keyword; (re-search-forward "[ \t]*"))) ;;; (message "m3-indent-for-line(B)") (sit-for 2) ;; Now figure out if there is an intervening incomplete ;; statement between here and the original line. (let ((prev-statement-start (point))) ;;; (message "Checking completeness") (sit-for 2) (cond ;; Is it incomplete? ((m3-prev-line-incomplete-p cur-point part-start) ;; ...OK, the previous line *was* incomplete. (goto-char cur-point) ;;; (message "m3-indent-for-line: incomplete") (sit-for 2) (m3-incomplete-indent cur-point first-code part-start)) (t ;; No: the previous line completed a statement, so find it's ;; start and indent from that. ;;; (message "m3-indent-for-line: complete") (sit-for 2) (let ((skip-one (and (save-excursion (goto-char first-code) (looking-at m3-keyword-ssl-enders)) (save-excursion (goto-char first-code) (m3-re-search-backward (concat "\\(" m3-keyword-endable-ssl-introducers "\\|;\\)") part-start t) (not (looking-at ";")))))) ;;; (message "m3-IFL complete(2): skip-one = %s" skip-one) (sit-for 2) (goto-char cur-point) (beginning-of-line) (m3-re-search-backward (concat "\\(;\\|END\\|\\(" m3-keyword-endable-ssl-introducers "\\|" m3-part-starters "\\)\\)") part-start 'move-to-limit) ;;; (message "m3-IFL complete(2.5-1)") (sit-for 2) (while (m3-in-arg-list part-start) ;;; (message "m3-IFL complete(2.5-2)") (sit-for 2) (m3-re-search-backward (concat "\\(;\\|END\\|\\(" m3-keyword-endable-ssl-introducers "\\|" m3-part-starters "\\)\\)") part-start 'move-to-limit)) ;; Should now be at the beginning of the last ;; ';', END, comment-start on left margin, or ssl-introducer. ;;; (message "m3-IFL complete(3)") (sit-for 2) (cond (skip-one ;;; (message "m3-IFL skip-one(1)") (sit-for 2) (if (looking-at ";") (error "Bad logic.")) (cond ((looking-at (concat "^" m3-com-start-re)) ;;; (message "m3-IFL skip-one left-margin-commment") (sit-for 2) 0) (t (re-search-forward m3-keyword-line-starters (point-max) t) (goto-char (match-end 0)) ;;; (message "m3-IFL skip-one(2)") (sit-for 2) (let ((eol (save-excursion (end-of-line) (point)))) (m3-forward-to-code first-code) ;;; (message "m3-IFL skip-one(3)") (sit-for 2) (cond ;; Is there stuff between the keyword and the current line? ((and (> (point) eol) (< (point) first-code)) ;;; (message "m3-IFL: skip-1 indentation x") (sit-for 2) (m3-complete-adjust-indent (current-column) first-code part-start)) ;; No; (t ;;; (message "m3-IFL: skip-1 indentation y0") (sit-for 2) (m3-re-search-backward (concat "^[ \t]*\\(" m3-keyword-line-starters "\\)") part-start t) (re-search-forward m3-keyword-line-starters first-code t) (goto-char (match-beginning 0)) (cond ((save-excursion (beginning-of-line) (looking-at (concat "[ \t]*" m3-multi-keyword-lines))) (beginning-of-line) (re-search-forward "[ \t]*" first-code t) (goto-char (match-end 0)))) ;;; (message "m3-IFL: skip-1 indentation y") (sit-for 2) (m3-after-keyword-adjust-indent (current-column) first-code part-start))))))) (t ;;; (message "m3-IFL skip-two") (sit-for 2) ;; First of all, are we in a procedure argument list? (let ((in-arg-list (m3-in-arg-list part-start))) (cond ;; Are we at the beginning of the file? ;; If so, move current line to left margin. ((eq (save-excursion (m3-backward-to-code (point-min)) ;;; (message "m3-IFL foo: %d" (point)) (sit-for 2) (point)) 1) 0) ;; Are we looking at a comment on the left margin? ((looking-at (concat "^" m3-com-start-re)) 0) ;; Is it a keyword starting a line? ((save-excursion (beginning-of-line) (looking-at (concat "[ \t]*\\(" m3-keyword-line-starters "\\|" m3-part-starters "\\)"))) ;;; (message "m3-IFL: after complete keyword") (sit-for 2) (beginning-of-line) (re-search-forward (concat m3-keyword-line-starters "\\|" m3-part-starters) (point-max) t) (goto-char (match-beginning 0)) ;;; (message "m3-IFL: after complete keyword 2") (sit-for 2) (m3-after-keyword-adjust-indent (current-column) first-code part-start)) (t ;; No; skip backwards another then forward-to-code ;;; (message "m3-IFL: skip-two xxx") (sit-for 2) (if (not (looking-at (concat m3-keyword-endable-ssl-introducers "\\|;"))) (error "Bad logic 2.")) (let ((last-complete (looking-at (concat ";\\|END")))) (beginning-of-line) (m3-re-search-backward (concat "\\(;\\|END\\|\\(" "\\([ \t]*" m3-keyword-line-starters "\\)\\|" m3-keyword-endable-ssl-introducers "\\)\\)") part-start 'move-to-limit) ;;; (message "m3-IFL: skip-two xxx 2") (sit-for 2) (while (and (not in-arg-list) (m3-in-arg-list part-start)) ;;; (message "m3-IFL: skip-two xxx 2.2") (sit-for 2) (m3-re-search-backward (concat "\\(;\\|END\\|\\(" m3-keyword-line-starters "\\)\\)") part-start t) (if (looking-at "PROCEDURE") (m3-re-search-backward (concat "\\(;\\|END\\|\\(" m3-keyword-line-starters "\\)\\)") part-start t))) ;;; (message "m3-IFL: skip-two xxx 2.5") (sit-for 2) (let ((continue t) (OF-end (point))) (while (and (looking-at "OF") continue) ;;; (message "m3-IFL: skip-two xxx 2.6") (sit-for 2) (if (re-search-backward "SET[ \t]*\\|ARRAY[ \t]*\\(\\[[^]]*\\][ \t]*\\)?" part-start t) (cond ((eq (match-end 0) OF-end) (m3-re-search-backward (concat "\\(;\\|\\(" m3-keyword-line-starters "\\)\\)") part-start t)) (t (setq continue nil))) (setq continue nil)))) ;;; (message "m3-IFL: skip-two xxx 3") (sit-for 2) ;; If we're at part-start, then that is the indentation ;; (Since part-starts are not ssl-introducers?) (if (and t ;; (not (eq (point) part-start)) (looking-at (concat ";\\|" m3-keyword-endable-ssl-introducers))) (progn (re-search-forward (concat "\\(;\\|END\\|\\(" "\\([ \t]*" m3-keyword-line-starters "\\)\\|" m3-keyword-endable-ssl-introducers "\\)\\)") (point-max) t) (goto-char (match-end 0)) ;;; (message "m3-IFL: skip-two xxx 4") (sit-for 2) (m3-forward-to-code cur-point))) ;;; (message "m3-indent-for-line: indentation") (sit-for 2) (cond (last-complete (m3-complete-adjust-indent (current-column) first-code part-start)) (t (m3-after-keyword-adjust-indent (current-column) first-code part-start) ))))))))))))))) (defun m3-in-arg-list (part-start) "Returns non-NIL iff the point is in a procedure or method argument list." ;;; (message "m3-in-arg-list(1)") (sit-for 2) (save-excursion (let ((cur-point (point))) (m3-re-search-backward "PROCEDURE\\|METHODS" part-start t) (cond ((looking-at "PROCEDURE") (forward-word 1) (m3-re-search-forward "([^*]" (point-max) t) ;;; (message "m3-in-arg-list(3)") (sit-for 2) (and (< (point) cur-point) (condition-case err (progn (forward-sexp 1) ;;; (message "m3-in-arg-list(4)") (sit-for 2) (> (point) cur-point)) (error t)))) ((looking-at "METHODS") (let ((continue t) (res nil)) (while (and continue (< (point) cur-point)) (m3-re-search-forward "([^*]\\|END" (point-max) t) ;;; (message "m3-in-arg-list(101)") (sit-for 2) (cond ((and (looking-at "([^*]") (< (point) cur-point)) ;;; (message "m3-in-arg-list(101.5)") (sit-for 2) (condition-case err (progn (forward-sexp 1) ;;; (message "m3-in-arg-list(102)") (sit-for 2) (if (> (point) cur-point) (setq res t))) (error ;; No matching right paren, so must still be in arg list. ;;; (message "m3-in-arg-list(103)") (sit-for 2) (setq continue nil) (setq res t)))) (t ;;; (message "m3-in-arg-list(104)") (sit-for 2) (setq continue nil)))) res)) (t nil))))) (defun m3-prev-line-incomplete-p (cur-point part-start) ;;; (message "incomplete?") (sit-for 2) (and ;; If the last word of the previous line is ";", "END", or an ;; ssl-introducer, the previous line is complete. (save-excursion (goto-char cur-point) (m3-backward-to-code part-start) (not (or (save-excursion (and (> (point) 1) (progn (forward-char -1) (looking-at ";")))) (progn (forward-word -1) (looking-at (concat "END\\|" m3-statement-list-starter)))))) (or ;; Does the previous non-blank line end with an operator? (save-excursion ;;; (message "incomplete-1") (sit-for 2) (goto-char cur-point) (m3-backward-to-code part-start) (or (looking-at "[+\\-*&#<,]") (and (looking-at ">") (save-excursion (beginning-of-line) ;;; (message "incomplete-1.1") (sit-for 2) (not (looking-at (concat "[ \t]*" m3-handler-start-re "[ \t]*\\($\\|(\\*\\)"))))) (and (looking-at "=") (save-excursion ;;; (message "incomplete-1.2") (sit-for 2) (beginning-of-line) ;;; (message "incomplete-1.21") (sit-for 2) (and (not (looking-at (concat "PROCEDURE.*=[ \t]*\\($\\|(\\*\\)"))) (not (m3-in-arg-list part-start))))) (and (> (point) 2) (progn (forward-char -2) (or (looking-at (concat m3-not-identifier-char-re "OR")) (and (> (point) 1) (progn (forward-char -1) (looking-at (concat m3-not-identifier-char-re "\(DIV\\|MOD\\|AND\\|NOT"))))))))) (save-excursion (goto-char cur-point) (m3-backward-to-code part-start) (forward-char 1) ;;; (message "incomplete-1B1") (sit-for 2) (let ((last-char (point))) (beginning-of-line 1) (and (re-search-forward (concat "^[ \t]*\\(" m3-statement-keywords "\\)") cur-point t) (= last-char (match-end 0))))) (save-excursion ;;; (message "incomplete-2") (sit-for 2) (cond ((looking-at "END;") ;;; (message "incomplete-2.01") (sit-for 2) (forward-char 4)) ((looking-at (concat "END[ \t]*" m3-identifier-re "[ \t]*\\(;\\|\\.\\)")) ;;; (message "incomplete-2.02") (sit-for 2) (re-search-forward (concat "END[ \t]*" m3-identifier-re "[ \t]*\\(;\\|\\.\\)") (point-max) t) (goto-char (match-end 0))) ((looking-at m3-multi-keyword-line-prefix) ;;; (message "incomplete-2.1") (sit-for 2) (re-search-forward m3-multi-keyword-line-prefix (point-max) t) (goto-char (match-end 0))) ((looking-at "PROCEDURE") ;;; (message "incomplete-2.15") (sit-for 2) (forward-word 1) (m3-re-search-forward "([^*]" (point-max) t) (let ((new-point (point))) (save-excursion (condition-case err (forward-sexp 1) (error (goto-char (point-max)))) ;;; (message "incomplete-2.15-2") (sit-for 2) (and (< (point) cur-point) (m3-re-search-forward "=" (point-max) t) (progn (forward-char 1) (and (< (point) cur-point) ;;; (message "incomplete-2.15-3") (sit-for 2) (setq new-point (point)))))) (goto-char new-point))) ((looking-at "WITH") ;;; (message "incomplete-2.191") (sit-for 2) (forward-word 1) (let ((new-point (point))) (m3-re-search-forward "DO" first-code t) ;;; (message "incomplete-2.192") (sit-for 2) (cond ((looking-at "DO") (forward-word 1) ;;; (message "incomplete-2.193") (sit-for 2) (setq new-point (point)))) (goto-char new-point))) ((looking-at "END") (forward-word 1) (cond ((save-excursion (m3-forward-to-code (point-max)) (looking-at ";")) (m3-forward-to-code (point-max)) (forward-char 1)))) ;; If looking-at keyword-line-starter or part-starter ((looking-at (concat m3-keyword-line-starters "\\|" m3-part-starters)) ;;; (message "incomplete-2.2") (sit-for 2) (re-search-forward (concat m3-keyword-line-starters "\\|" m3-part-starters) (point-max) t) (goto-char (match-end 0))) ((looking-at ";") (forward-char 1))) ;; Go forward to code. ;;; (message "m3-IFL: before codepoint") (sit-for 2) (m3-forward-to-code (point-max)) ;; Is there something between the last ';' and the current ;; line? ;;; (message "m3-IFL: codepoint") (sit-for 2) (and (< (point) cur-point) ;; Yes -- means that the previous statement was incomplete... ;; ...unless the current line is an ssl-ender, in which ;; case it is assumed complete... ;;; (message "incomplete-3") (sit-for 2) (or (not (save-excursion (goto-char first-code) ;;; (message "incomplete-3.1") (sit-for 2) (looking-at m3-keyword-ssl-enders))) (save-excursion ;;; (message "incomplete-3.2") (sit-for 2) (goto-char first-code) (m3-backward-to-code part-start) (forward-char 1) ;;; (message "incomplete-3.21") (sit-for 2) (let ((after (point))) (m3-re-search-backward m3-keyword-endable-ssl-introducers part-start t) (re-search-forward m3-keyword-endable-ssl-introducers cur-point t) (goto-char (match-end 0)) ;;; (message "incomplete-3.22") (sit-for 2) (= (point) after)))) ;; ... or there is a an ssl-ender between here and first-code ;; that is not a semi in an argument list... (not (save-excursion ;;; (message "incomplete-3.3-0") (sit-for 2) (and (m3-re-search-forward (concat ";\\|" m3-keyword-ssl-enders) first-code 't) (let ((continue t)) (while (and continue (m3-in-arg-list part-start)) ;;; (message "incomplete-3.3-1") (sit-for 2) (re-search-forward (concat ";\\|" m3-keyword-ssl-enders) first-code 't) (goto-char (match-end 0)) ;;; (message "incomplete-3.3-2") (sit-for 2) (setq continue (m3-re-search-forward (concat ";\\|" m3-keyword-ssl-enders) first-code 't))) continue) ;;; (message "incomplete-3.3") (sit-for 2) (< (point) first-code)))) ;; ... or the previous statement is a multi-keyword statement ;; and the current line is completed by a subsequent keyword... (not (save-excursion (goto-char cur-point) (m3-backward-to-non-comment-line-start part-start) ;;; (message "m3-indent-for-line: multi-keyword") (sit-for 2) (looking-at m3-multi-keyword-lines))) ))))) ;; Constants, especially helpful regexps. (defconst m3-identifier-char-re "[a-zA-Z0-9_]") (defconst m3-alpha-char-re "[a-zA-Z_]") (defconst m3-not-identifier-char-re "[^a-zA-Z0-9_]") (defconst m3-identifier-re (concat "\\b" m3-alpha-char-re m3-identifier-char-re "*\\b")) (defconst m3-intlit-re "\\(0\\|[1-9][0-9]*\\)") (defconst m3-poss-qual-ident-re (concat "\\(" "\\(" m3-identifier-re "\\.\\)?" m3-identifier-re "\\.\\)?" m3-identifier-re)) (defconst m3-com-start-re "\\((\\*\\|<\\*\\)") (defconst m3-com-end-re "\\(\\*)\\|\\*>\\)") (defconst m3-com-start-or-end-re (concat "\\\(" m3-com-start-re "\\|" m3-com-end-re "\\)")) (defconst m3-whitespace-char-re "[ \t]") (defconst m3-poss-whitespace-re "[ \t]*") (defconst m3-poss-whitespace-nl-re "[ \t\n]*") (defconst m3-whitespace-line-re "^[ \t\n]*$") (defconst m3-char-lit-re "'\\([^\\]\\|\\\\..?.?\\)'") (defconst m3-range-end-re (concat "\\(" m3-poss-qual-ident-re "\\|" m3-intlit-re "\\|" m3-char-lit-re "\\)")) (defconst m3-range-re (concat m3-range-end-re m3-poss-whitespace-re "\\.\\." m3-poss-whitespace-re m3-range-end-re)) (defconst m3-case-label-re (concat "\\(" m3-poss-qual-ident-re "\\|" m3-char-lit-re "\\|" m3-intlit-re "\\|" m3-range-re "\\)")) (defconst m3-handler-start-re (concat "\\(|[ \t]*\\)?\\(" (concat "\\b" m3-poss-qual-ident-re m3-poss-whitespace-re "(" m3-poss-whitespace-re m3-identifier-re m3-poss-whitespace-re ")" ) "\\|" (concat "\\b" m3-case-label-re (concat "\\(" m3-poss-whitespace-re "," m3-poss-whitespace-re m3-case-label-re "\\)*")) "\\)" m3-poss-whitespace-re "=>")) (defconst m3-object-re (concat "\\(" m3-identifier-re "[ \t]+\\)?\\(BRANDED[ \t]+" "\\(\"[^\"]+\"\\)?[ \t]+\\)?OBJECT")) (defconst m3-part-starters (concat "\\bINTERFACE\\b\\|\\bMODULE\\b\\|\\bIMPORT\\b\\|\\bFROM\\b\\|" "\\bTYPE\\b\\|\\bEXCEPTION\\b\\|\\bVAR\\b\\|" "\\bPROCEDURE\\b\\|\\bREVEAL\\b\\|\\bCONST\\b") "These are the patterns that can start lines and change the indentation of the following line.") (defconst m3-keyword-endable-ssl-introducers (concat "\\bTYPE\\b\\|\\bVAR\\b\\|" "\\bRECORD\\b\\|\\bOBJECT\\b\\|\\bMETHODS\\b\\|\\bOVERRIDES\\b\\|" "\\bBEGIN\\b\\|\\bTRY\\b\\|\\bEXCEPT\\b\\|" m3-handler-start-re "\\|" "\\bFINALLY\\b\\|\\bLOOP\\b\\|\\bTHEN\\b\\|\\bELSE\\b\\|\\bREPEAT\\b\\|" "\\bDO\\b\\|\\bOF\\b\\|\\bREVEAL\\b\\|\\bCONST\\b")) (defconst m3-statement-list-starter (concat "\\bBEGIN\\b\\|\\bTRY\\b\\|\\bEXCEPT\\b\\|" m3-handler-start-re "\\|" "\\bFINALLY\\b\\|\\bLOOP\\b\\|\\bTHEN\\b\\|\\bELSE\\b\\|\\bREPEAT\\b\\|" "\\bDO\\b")) ;;; These keywords have the property that they affect the indentation if they ;;; occur at the beginning of a line. (defconst m3-keyword-line-starters (concat "TYPE\\b\\|\\bEND\\b\\|RECORD\\|PROCEDURE\\|OBJECT\\|METHODS\\|OVERRIDES\\|" "VAR\\|BEGIN\\|TRY\\|EXCEPT\\b\\|" m3-handler-start-re "\\|" "|\\|FINALLY\\|\\bLOOP\\b\\|THEN\\|ELSIF\\|\\bIF\\|ELSE\\|WHILE\\|REPEAT\\|" "WITH\\|FOR\\b\\|DO\\|CASE\\|\\bOF\\b\\|TYPECASE\\|LOCK\\|CONST\\|FROM\\|" "REVEAL")) (defconst m3-multi-keyword-line-prefix (concat "\\(" ;; ...a PROCEDURE at the start of a line that ends ;; with an equals "^PROCEDURE[^\n]*=" "\\|" ;; ... or an IF or ELSEIF that ends with a THEN "\\(IF\\|ELSIF\\)[^\n]*THEN" "\\|" ;; ... or a WHILE, WITH, FOR, or LOCK that ends with a DO "\\(WHILE\\|WITH\\|FOR\\b\\|LOCK\\)[^\n]*DO" "\\|" ;; ... or a FOR that ends with a TO or BY "FOR[^\n]*\\(DO\\|BY\\)" "\\|" ;; ... or a CASE or TYPECASE that ends with a OF "\\(CASE\\|TYPECASE\\)[^\n]*OF" "\\|" ;; ... or at a handler-start that ends with a "=>" "\\(|\\|\\)[ \t]*" m3-handler-start-re "\\)" )) (defconst m3-multi-keyword-lines (concat m3-multi-keyword-line-prefix "[ \t]*\\($\\|(\\*\\)")) (defconst m3-statement-starters (concat "BEGIN\\b\\|TRY\\b\\|LOOP\\b\\|IF\\b\\|WHILE\\b\\|REPEAT\\b\\|" "WITH\\\b\\|FOR\\b\\|CASE\\b\\|TYPECASE\\b\\|LOCK\\b") "These are the patterns that can start lines and change the indentation of the following line.") (defconst m3-keyword-ssl-enders "|\\|EXCEPT\\|FINALLY\\|ELSIF\\|ELSE\\|UNTIL\\|END") (defconst m3-left-parens "\\((\\|\\[\\|{\\)") (defconst m3-right-parens "\\()\\|\\]\\|}\\)") ;;; Think of a more descriptive name for these... (defconst m3-statement-keywords "RETURN\\|RAISE\\|EXCEPTION\\|IMPORT\\|WITH") ;; Variables that control indentation behavior (defvar m3-standard-offset 2) (defvar m3-continued-line-offset 2) (defvar m3-case-offset 0) ;;;(setq m3-case-offset 2) (defvar m3-open-paren-offset 4) ;;;(setq m3-open-paren-offset 2) (defvar m3-assign-offset 4) (defvar m3-RAISES-offset 4) (defvar m3-follow-continued-indent t) (defvar m3-END-undent 2) (defvar m3-METHODS-undent 2) (defvar m3-OVERRIDES-undent 2) (defvar m3-EXCEPT-undent 2) (defvar m3-VERT-undent 2) (defvar m3-handler-start-undent 0) (defvar m3-EXCEPT-undent 2) (defvar m3-UNTIL-undent 2) (defvar m3-FINALLY-undent 2) (defvar m3-ELSIF-undent 2) (defvar m3-ELSE-undent 2) (defvar m3-DO-undent 1) (defvar m3-OF-undent 1) (defvar m3-THEN-undent 1) (defvar m3-OBJECT-undent 1) (defvar m3-RECORD-undent 1) (defun m3-after-keyword-adjust-indent (indent first-code part-start) "Point is looking at a keyword at column INDENT; if the current line has any code it starts at FIRST-CODE. Return the proper indentation for the current line." ;;; (message "m3-after-keyword: indent = %d" indent) (sit-for 2) (let ((call-adjust-indent t)) (cond ((looking-at "END") ;;; (message "m3-after-keyword(END): i: %d, m3-END: %d, m3-stand: %d" ;;; indent m3-END-undent m3-standard-offset) ;;; (sit-for 2) (setq indent (- (+ indent m3-END-undent) m3-standard-offset))) ((looking-at "ELSE") (setq indent (+ indent m3-ELSE-undent)) (if (m3-in-case part-start) (setq indent (+ indent m3-case-offset)))) ((looking-at "METHODS") (setq indent (+ indent m3-METHODS-undent))) ((looking-at "OVERRIDES") (setq indent (+ indent m3-OVERRIDES-undent))) ((looking-at "EXCEPT\\b") ;;; (message "m3-after-keyword: EXCEPT" indent) (sit-for 2) (setq indent (+ indent m3-EXCEPT-undent))) ((looking-at "|") ;;; (message "m3-after-keyword: vert" indent) (sit-for 2) (setq indent (+ indent m3-VERT-undent m3-case-offset))) ((looking-at m3-handler-start-re) ;;; (message "m3-after-keyword: handler-start" indent) (sit-for 2) (setq indent (+ indent m3-handler-start-undent m3-case-offset))) ((looking-at "FINALLY") (setq indent (+ indent m3-FINALLY-undent))) ((looking-at "THEN") (setq indent (+ indent m3-THEN-undent))) ((looking-at "ELSIF") (setq indent (+ indent m3-ELSIF-undent))) ((looking-at "ELSE") (setq indent (+ indent m3-ELSE-undent))) ((looking-at "DO") (setq indent (+ indent m3-DO-undent))) ((looking-at "OF") (setq indent (+ indent m3-OF-undent))) ((looking-at m3-object-re) (setq indent (+ indent m3-OBJECT-undent))) ((looking-at "RECORD") (setq indent (+ indent m3-RECORD-undent))) ;; These are the keywords that can be followed by an SSL that begins on ;; the same line -- if so, indent to the level of the first elem. ((looking-at m3-same-line-ssl-keywords) ;;; (message "m3-after-keyword: same-line-ssl") (sit-for 2) (let ((eol (save-excursion (end-of-line 1) (point)))) (save-excursion (forward-word 1) (m3-forward-to-code (point-max)) ;;; (message "m3-after-keyword: SlSSL(2)") (sit-for 2) (cond ((and m3-follow-continued-indent (<= (point) eol) (save-excursion (goto-char first-code) (not (looking-at (concat m3-part-starters "\\|BEGIN")))) (save-excursion (end-of-line 1) (m3-backward-to-code part-start) (looking-at ";"))) ;;; (message "m3-after-keyword: SLSSL (3)") (sit-for 2) (setq indent (current-column)) (setq call-adjust-indent nil)) (t (setq indent (+ indent m3-standard-offset))))))) ;; These are all the keywords that don't affect the indentation ;; when they start complete lines. ((looking-at (concat "INTERFACE\\|MODULE\\|IMPORT\\|FROM\\|EXCEPTION")) ;;; (message "m3-after-keyword: no extra") (sit-for 2) indent) ;; Otherwise, give the standard indentation. (t ;;; (message "m3-after-keyword: standard") (sit-for 2) (setq indent (+ indent m3-standard-offset)))) (cond (call-adjust-indent (save-excursion (goto-char first-code) ;;; (message "m3-after-keyword: calling complete-adjust") (sit-for 2) (m3-complete-adjust-indent indent first-code part-start))) (t ;;; (message "m3-after-keyword: not calling complete-adjust") (sit-for 2) indent)))) (defun m3-in-case (part-start) ;;; (message "M3-in-case") (sit-for 2) (save-excursion (let ((cur-point (point))) (m3-backward-to-end-match part-start) ;;; (message "M3-in-case(2)") (sit-for 2) (and (looking-at m3-case-starters) (progn (cond ((looking-at "TRY") (forward-word 1) ;; Is it a TRY-FINALLY or a TRY-EXCEPT? (let (res (continue t)) (while continue (setq res (m3-re-search-forward "TRY\\|EXCEPT\\|FINALLY" cur-point t)) ;;; (message "M3-in-case(3)") (sit-for 2) (cond ((looking-at "EXCEPT") (setq continue nil)) ((looking-at "TRY") ;; Go to matching END and try again (m3-forward-to-end-matcher cur-point)) (t;; FINALLY or not found (setq res nil) (setq continue nil)))) res)) (t t))) ;;; We are now looking at a case starter. Make sure there is ;;; at least one case arm starter. (progn (cond ((looking-at "EXCEPT") (forward-word 1)) ((looking-at "CASE\\|TYPECASE") (forward-word 1) (m3-re-search-forward "OF" cur-point 'move-to-limit) (forward-word 1))) (m3-forward-to-code cur-point) ;;; (message "M3-in-case: about to test handler") (sit-for 2) (and (< (point) cur-point) (looking-at m3-handler-start-re))) ;;; (message "M3-in-case: returning t") (sit-for 2) )))) (defun m3-in-continued-record-def (part-start) (if (not (looking-at "END")) (error "m3-in-continued-record-def assumes looking-at END")) (save-excursion (m3-backward-to-end-match part-start) (let ((end-match (point)) (eol (save-excursion (end-of-line) (point)))) (beginning-of-line) (or (save-excursion (re-search-forward "[ \t]*" eol t) (= (point) end-match)) (save-excursion (and (re-search-forward "[ \t]*BRANDED[ \t]+" eol t) (= (point) end-match) (save-excursion (goto-char end-match) (looking-at "OBJECT")))))))) (defun m3-correct-for-trailing-ends (indent part-start) ;; If the previous line ends in a (series of) END(s) that does ;; (do) not start the line, and are unmatched by the start of the line, ;; subtract the END-undent(s) from indent (the Eric Muller convention.) ;;; (message "correct-for-trailing-ends in: %d" indent) (sit-for 2) (let ((prev-line-start (save-excursion (m3-backward-to-code part-start) (beginning-of-line) (m3-forward-to-code (point-max)) ;;; (message "correct-for-trailing-ends (0)") (sit-for 2) (point)))) (save-excursion (if (save-excursion (m3-backward-to-code part-start) (beginning-of-line) (not (looking-at "[ \t]*END"))) (save-excursion (let ((continue t)) (while continue (m3-backward-to-code part-start) ;;; (message "correct-for-trailing-ends (2)") (sit-for 2) (cond ((or (save-excursion (forward-word -1) (looking-at "END")) (save-excursion (forward-word -2) (looking-at (concat "END" m3-poss-whitespace-re m3-identifier-re m3-poss-whitespace-re ";")))) (re-search-backward "END" part-start t) (goto-char (match-beginning 0)) ;;; (message "correct-for-trailing-ends (3)") (sit-for 2) (if (not (looking-at "END")) (error "m3-complete-adjust-indent(A)")) (let ((em-point (save-excursion (m3-backward-to-end-match part-start) ;;; (message "correct-for-trailing-ends EM") (sit-for 2) (point)))) ;;; (message "xxx") (sit-for 2) (cond ((< em-point prev-line-start) (goto-char prev-line-start) ;;; (message "xxx<") (sit-for 2) (setq indent (save-excursion (goto-char em-point) (current-column)))) ((= em-point prev-line-start) ;;; (message "xxx=") (sit-for 2) (setq indent (- indent m3-END-undent)) (setq continue nil)) ((> em-point prev-line-start) (goto-char em-point))))) (t (setq continue nil)))))))) ;;; (message "m3-trailing-end returns %d" indent) (sit-for 2) indent)) (defun m3-complete-adjust-indent (indent first-code part-start) "Previous statement is complete and starts at column INDENT; if the current line has any code it starts at FIRST-CODE. Returns the proper indentation for the current line." ;;; (message "m3-complete-adjust(A): indent = %d, first-code = %d" ;;; indent first-code) ;;; (sit-for 2) (save-excursion (goto-char first-code) ;;; (message "m3-complete-adjust(B)") (sit-for 2) ;; If the previous line ends in a (series of) END(s) that does ;; (do) not start the line, and are unmatched before the start of the line, ;; the END-undent(s) (the Eric Muller convention.) (setq indent (m3-correct-for-trailing-ends indent part-start)) ;;; (message "yyy2: indent = %d" indent) (sit-for 2) (cond ;; Some things can only start parts, and must be on the left margin. ((looking-at (concat "REVEAL\\b\\|EXCEPTION\\b\\|" "FROM\\b\\|IMPORT\\b")) 0) ;; These can start parts, but can also appear in the procedures. ((looking-at (concat "\\(PROCEDURE\\b\\|CONST\\b\\|VAR\\b\\|TYPE\\b\\|BEGIN\\b\\)")) ;; Look backwards for line-beginning-keywords that increase the ;; indentation, start an SSL, but don't require an END (i.e., ;; TYPE, VAR, or CONST); or END's. If the former is found first, ;; decrease the indentation to the same as the keyword line's. ;; If an END is found whose matcher is not something that can ;; occur in a TYPE, VAR, or CONST (i.e. RECORD or OBJECT), ;; indent normally. ;;; (message "yyy7") (sit-for 2) (let ((new-indent indent) (continue t)) (while continue ;;; (message "xxx1") (sit-for 2) (m3-re-search-backward (concat "\\(^[ \t]*\\(" m3-same-line-ssl-keywords "\\)\\|END\\|" m3-statement-starters "\\)") part-start 'move-to-limit) ;;; (message "xxx2") (sit-for 2) (cond ;; If we reached the part-start because of the move-to-limit, ;; indent to here... ((looking-at (concat "^" m3-part-starters)) ;;; (message "xxx2.5") (sit-for 2) (goto-char first-code) ;; If its the start of a procedure def, indent normally. ;; Otherwise, indent to left margin. (if (not (m3-after-procedure-introducer part-start)) (setq new-indent 0)) (setq continue nil)) ((and (looking-at (concat "^[ \t]*\\(" m3-same-line-ssl-keywords "\\)")) (not (m3-in-arg-list part-start))) (setq continue nil) ;;; To accomodate part-starters that establish new indentations, ;;; indent to the level of the previous part-starter, unless ;;; that was a BEGIN. (goto-char first-code) (m3-re-search-backward (concat m3-part-starters "\\|BEGIN") part-start t) (while (m3-in-arg-list part-start) (m3-re-search-backward (concat m3-part-starters "\\|BEGIN") part-start t)) ;;; (message "xxx3") (sit-for 2) (cond ((looking-at "BEGIN") (setq new-indent (- new-indent m3-standard-offset))) (t (setq new-indent (current-column))))) ((looking-at (concat "END[ \t]*" m3-identifier-re "[ \t]*;")) (setq continue nil) (setq new-indent (- new-indent m3-standard-offset))) ((looking-at "END") (m3-backward-to-end-match part-start) ;;; (message "xxxEND-match") (sit-for 2) (cond ((looking-at "\\(RECORD\\|OBJECT\\)") nil) (t (setq continue nil)))) (t (setq continue nil)))) new-indent)) ;; If the current line is an END, add the END-undent. ((looking-at "END") ;;; (message "zzz1") (sit-for 2) (cond ((m3-in-case part-start) (- indent m3-END-undent m3-case-offset)) (t (- indent m3-END-undent)))) ((looking-at "ELSE") (- indent m3-ELSE-undent (if (m3-in-case part-start) m3-case-offset 0))) ((looking-at "METHODS") (- indent m3-METHODS-undent)) ((looking-at "OVERRIDES") (- indent m3-OVERRIDES-undent)) ((looking-at "EXCEPT") (- indent m3-EXCEPT-undent)) ((looking-at "UNTIL") (- indent m3-UNTIL-undent)) ((looking-at "|") (cond ((save-excursion (m3-backward-to-code part-start) ;;; (message "zzz2") (sit-for 2) (or (save-excursion (and (> (point) 1) (progn (forward-char -1) (looking-at "OF")))) (save-excursion (and (> (point) 5) (progn (forward-char -5) (looking-at "EXCEPT")))))) (- indent m3-VERT-undent)) (t (- indent m3-VERT-undent m3-case-offset)))) ((looking-at "FINALLY") (- indent m3-FINALLY-undent)) ((looking-at "THEN") (- indent m3-THEN-undent)) ((looking-at "ELSIF") (- indent m3-ELSIF-undent)) ((looking-at "ELSE") (- indent m3-ELSE-undent)) ((looking-at "DO") (- indent m3-DO-undent)) ((looking-at "OF") (- indent m3-OF-undent)) ((looking-at "RECORD") ;;; (message "zzz-record") (sit-for 2) (- indent m3-RECORD-undent)) ((looking-at m3-object-re) ;;; (message "zzz-object") (sit-for 2) (- indent m3-OBJECT-undent)) (t ;;; (message "zzz-t: indent = %d" indent) (sit-for 2) indent)))) (defun m3-incomplete-indent (cur-point first-code part-start) (let* (list-indent (prev-line-start (save-excursion (m3-backward-to-non-comment-line-start part-start) (point))) (last-char-prev-line (save-excursion (m3-backward-to-non-comment-line-start part-start) (end-of-line) (m3-backward-to-code (save-excursion (beginning-of-line) (point))) (point))) (prev-line-indent (save-excursion (m3-backward-to-non-comment-line-start part-start) (let ((pli (current-column))) (cond ((looking-at m3-statement-keywords) (forward-word 1) (m3-forward-to-code first-code) (cond ((<= (point) last-char-prev-line) (current-column)) (t pli))) (t pli)))))) ;;; (message "m3-incomplete-indent(A)") (sit-for 2) (cond ;; Did the previous non-blank line end with a paren? ((save-excursion (goto-char last-char-prev-line) (looking-at m3-left-parens)) ;;; (message "m3-incomplete-indent(PAREN)") (sit-for 2) ;; Find the indentation of the previous line, ;; either add open-paren-offset, or indent of paren + ;; open-paren-sep (goto-char last-char-prev-line) (cond (m3-open-paren-offset ;;; (message "m3-incomplete-indent(PAREN offset)") (sit-for 2) (re-search-backward (concat m3-identifier-re m3-poss-whitespace-re) part-start t) (goto-char (match-beginning 0)) ;; Account for qualified names. (cond ((save-excursion (and (> (point) 1) (progn (forward-char -1) (looking-at "\\.")))) (re-search-backward (concat m3-identifier-re m3-poss-whitespace-re) part-start t) (goto-char (match-beginning 0)))) ;;; (message "m3-incomplete-indent(PAREN offset 2)") (sit-for 2) (+ (current-column) m3-open-paren-offset)) (t (+ (current-column) m3-open-paren-sep)))) ;; Did the previous line end with a ',' or ';'?: ((save-excursion (goto-char last-char-prev-line) (looking-at ",\\|;")) ;;; (message "m3-incomplete-indent(COMMA)") (sit-for 2) ;; Skip over any matched parens; if this puts us at a line ;; containing an unmatched left paren, indent to that + ;; paren-sep. Otherwise, indent same as beginning of that line. (save-excursion (goto-char last-char-prev-line) (let ((continue t) res) (while continue ;;; (message "m3-incomplete-indent(COMMA) 0") (sit-for 2) (m3-re-search-backward (concat m3-left-parens "\\|" m3-right-parens) (save-excursion (beginning-of-line) (point)) 'move-to-limit) ;;; (message "m3-incomplete-indent(COMMA) 1") (sit-for 2) (cond ((looking-at m3-left-parens) ;;; (message "m3-incomplete-indent(COMMA) lp") (sit-for 2) (setq continue nil) (forward-char 1) (re-search-forward "[ \t]*") (goto-char (match-end 0)) (setq list-indent (current-column))) ((looking-at m3-right-parens) ;;; (message "m3-incomplete-indent(COMMA) rp") (sit-for 2) (forward-char 1) (backward-sexp 1)) (t ;;; (message "m3-incomplete-indent(COMMA) none") (sit-for 2) (beginning-of-line) (skip-chars-forward "[ \t]") (setq continue nil) (setq list-indent (current-column))))) ;;; (message "m3-incomplete-indent(COMMA) end") (sit-for 2) (cond ((looking-at (concat "|[ \t]*" m3-identifier-char-re)) (forward-word 1) (forward-word -1) (setq list-indent (current-column))) ((looking-at m3-statement-keywords) (forward-word 1) (re-search-forward "[ \t]*" last-char-prev-line t) (setq list-indent (current-column)))))) list-indent) ;; Did the previous non-blank line end a procedure header? ((m3-after-procedure-introducer part-start) ;;; (message "m3-incomplete-indent(PROCEDURE)") (sit-for 2) (goto-char last-char-prev-line) (m3-re-search-backward "PROCEDURE" part-start t) (+ (current-column) m3-standard-offset)) ;; Does the current line start a RAISES clause? ((looking-at "^[ \t]*RAISES") ;;; (message "m3-incomplete-indent(RAISES)") (sit-for 2) (goto-char last-char-prev-line) (m3-re-search-backward "\\(PROCEDURE\\|METHODS\\)" part-start t) (if (looking-at "METHODS") (progn (forward-word 1) (m3-forward-to-code (point-max)))) (+ (current-column) m3-RAISES-offset)) ;; Did the previous line end with an assignment? ((save-excursion (goto-char last-char-prev-line) (beginning-of-line) ;;; (message "m3-incomplete-indent(:= 1)") (sit-for 2) (and (m3-re-search-forward ":=" (1+ last-char-prev-line) t) (re-search-forward "[^ \t]" last-char-prev-line t))) ;;; (message "m3-incomplete-indent(:=)") (sit-for 2) (goto-char last-char-prev-line) (beginning-of-line) (m3-re-search-forward ":=" last-char-prev-line t) (forward-char 2) (re-search-forward "[ \t]*[^ \t]") (+ (- (current-column) 1) m3-assign-offset)) ;; Otherwise: (t ;;; (message "m3-incomplete-indent(OTHER)") (sit-for 2) ;; Find out if the previous line begins the statement. (goto-char prev-line-start) (m3-re-search-backward (concat ";\\|" m3-keyword-line-starters "\\|" m3-part-starters "\\|" m3-statement-keywords) part-start t) (while (m3-in-arg-list part-start) (m3-re-search-backward (concat ";\\|" m3-keyword-line-starters "\\|" m3-part-starters "\\|" m3-statement-keywords) part-start t)) ;;; (message "m3-incomplete-indent(OTHER1)") (sit-for 2) (if (or (> (point) part-start) (and (= (point) part-start) (looking-at m3-keyword-endable-ssl-introducers))) (progn (re-search-forward (concat ";\\|" m3-keyword-line-starters "\\|" m3-part-starters "\\|" m3-statement-keywords) cur-point t) (goto-char (match-end 0)))) ;;; (message "m3-incomplete-indent(OTHER1.5)") (sit-for 2) (m3-forward-to-code (point-max)) ;;; (message "m3-incomplete-indent(OTHER2), prev-line-start = %d" ;;; prev-line-start) ;;; (sit-for 2) (cond ;; If the previous line begins the statement, add ;; m3-standard-offset to indentation, unless the prev-line-indent ;; has already skipped over a keyword. ((= (point) prev-line-start) ;;; (message "m3-incomplete-indent(START): prev-line-indent = %d" ;;; prev-line-indent) ;;; (sit-for 2) (m3-complete-adjust-indent ;; Indent further if we haven't indented already. (cond ((= prev-line-indent (save-excursion (goto-char prev-line-start) (current-column))) (+ prev-line-indent m3-continued-line-offset)) (t prev-line-indent)) first-code part-start)) (t ;;; (message "m3-incomplete-indent(CONT)") (sit-for 2) ;; Otherwise, same indentation as previous, modulo adjustment ;; for current line prev-line-indent)))))) (defun m3-after-procedure-introducer (part-start) "Returns t iff first non-blank non-comment character before point is the '=' of a procedure definition." (save-excursion (m3-backward-to-code part-start) (and (looking-at "=") ;;; (message "m3-API(0)") (sit-for 2) (let ((eq-point (point))) (and ;; Not that this does not allow any comments in ;; PROCEDURE Foo ;; and all must occur on the same line. (m3-re-search-backward (concat "PROCEDURE[ \t]*" m3-identifier-re "[ \t]*(") part-start t) ;;; (message "m3-API(1)") (sit-for 2) (progn (re-search-forward (concat "PROCEDURE[ \t]*" m3-identifier-re "[ \t]*(") eq-point t) (goto-char (match-end 0)) ;;; (message "m3-API(2)") (sit-for 2) (forward-char -1) (and (condition-case err (progn (forward-sexp 1) t) (error nil)) ;;; (message "m3-API(3)") (sit-for 2) ;; We should now be at the right paren of the arg-list. ;; Check for a return type. (progn (m3-forward-to-code eq-point) (and ;;; (message "m3-API(4)") (sit-for 2) (cond ((looking-at ":") (forward-char 1) (m3-forward-to-code eq-point) (and (looking-at m3-poss-qual-ident-re) (progn (re-search-forward m3-poss-qual-ident-re eq-point t) (goto-char (match-end 0)) (m3-forward-to-code eq-point) t))) (t t)) ;; Now check for RAISES clause. ;;; (message "m3-API(5)") (sit-for 2) (cond ((looking-at "RAISES") (forward-word 1) (m3-forward-to-code eq-point) (cond ((looking-at "ANY") (forward-word 1) (m3-forward-to-code eq-point) t) ((looking-at "{") ;;; (message "m3-API(5.5)") (sit-for 2) (and (condition-case err (progn (forward-sexp 1) t) (error nil)) (progn (m3-forward-to-code eq-point) t))) (t t))) (t t)) ;; Now, we better be back to the original =! (= (point) eq-point)))))))))) (defconst m3-end-matchers (concat "\\bRECORD\\b\\|\\bOBJECT\\b\\|\\bBEGIN\\b\\|\\bTRY\\b\\|\\bLOOP\\b\\|" "\\bIF\\b\\|\\bWHILE\\b\\|\\bWITH\\b\\|\\bFOR\\b\\|\\bCASE\\b\\|" "\\bTYPECASE\\b\\|\\bLOCK\\b\\|\\bINTERFACE\\b\\|\\bMODULE\\b\\|" "\\bGENERIC\\b")) (defconst m3-same-line-ssl-keywords "\\bVAR\\b\\|\\bTYPE\\b\\|\\bCONST\\b\\|\\bEXCEPTION\\b\\|\\bREVEAL\\b" "These are the keywords that can be followed by an SSL that begins on the same line -- if so, indent to the level of the first elem.") (defconst m3-case-starters "TRY\\|CASE\\|TYPECASE") (defun m3-backward-to-end-match (part-start &optional depth) (if (not depth) (setq depth 0)) (let (res (continue t)) (while continue ;;; (message "m3-backward-to-end-match(1) [%d]" depth) (sit-for 1) (setq res (m3-re-search-backward (concat "\\(" m3-end-matchers "\\|END\\)") part-start t)) (cond ((and res (looking-at "END")) (m3-backward-to-end-match part-start (1+ depth))) (t (setq continue nil)))) res)) (defun m3-forward-to-end-matcher (max-point) (let (res (continue t)) (while continue (setq res (m3-re-search-forward (concat "\\(" m3-statement-starters "\\|END\\)") max-point t)) (cond ((looking-at m3-statement-starters) (re-search-forward m3-statement-starters max-point t) (goto-char (match-end 0)) (m3-forward-to-end-matcher max-point)) (t ;; looking at END or reached max-point (setq continue nil)))) res)) (defun m3-backward-to-non-comment-line-start (part-start) "Sets the point at the first non-whitespace character in a line that contains something other than comments and/or whitespace." (m3-backward-to-code part-start) (beginning-of-line) (m3-skip-whitespace-in-line)) (defun m3-skip-whitespace-in-line () (re-search-forward "[ \t]*")) (defun m3-indent-to (cur-point new-column) "Make current line indentation NEW-COLUMN. If the point is to the left of the first non-blank character, move it to NEW-COLUMN. Otherwise, maintain its relative position. Has the side effect of converting tabs to spaces." (goto-char cur-point) (untabify (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point))) (let ((cur-column (current-column)) (cur-point (point)) (first-column (save-excursion (beginning-of-line) (re-search-forward " *") (current-column)))) (let ((diff (- new-column first-column))) (cond ((> diff 0) (beginning-of-line) ;; Must do this to make sure the keyword completion marker moves ;; correctly. (let ((d diff)) (while (> d 0) (insert-before-markers " ") (setq d (1- d)))) ) ((< diff 0) (save-excursion (forward-char (- first-column cur-column)) (backward-delete-char-untabify (- diff))))) (cond ((> first-column cur-column) (beginning-of-line) (forward-char new-column)) (t (goto-char (+ cur-point diff))))))) (defun m3-in-comment-or-string () "Returns 'string if point is in an unterminated string, 'comment if in an unterminated comment, otherwise, nil." (save-excursion (beginning-of-line) (let ((cur-point (point)) (state nil)) (save-excursion ;; We assume the lisp-like convention that "top-level defuns," ;; or "parts", are the only things that occur on the left ;; margin (we make an exception for end-comments.) (m3-backward-to-last-part-begin) (while (and (not state) (re-search-forward (concat "\\(" m3-com-start-re "\\|\"\\|'\\)") cur-point t)) (goto-char (match-beginning 0)) (cond ((looking-at m3-com-start-re) (setq state 'comment) (if (m3-skip-comment-forward cur-point t) (setq state nil))) ((looking-at "\"") (setq state 'string) (if (re-search-forward "[^\\\\]\"" cur-point t) (setq state nil))) ((looking-at "'") (setq state 'string) (if (re-search-forward "[^\\\\]'" cur-point t) (setq state nil))))) state)))) (defun m3-backward-to-last-part-begin () (beginning-of-line nil) (if (re-search-backward (concat "^\\(" m3-com-start-re "\\|" m3-part-starters "\\)") (point-min) t) (progn (goto-char (match-beginning 0))) (goto-char (point-min)))) (defun m3-forward-to-code (max-point) "Sets the point at the first non-comment, non-whitespace character following the current point, else at max-point." ;;; (message "m3-forward-to-code (1)") (sit-for 2) (let ((continue t)) (while continue ;;; (message "m3-forward-to-code (1.5)") (sit-for 2) (setq continue (and (re-search-forward "[^ \t\n]" max-point 'move-to-limit) (progn (goto-char (match-beginning 0)) ;;; (message "m3-forward-to-code (2)") (sit-for 2) (and (looking-at m3-com-start-re) (m3-skip-comment-forward max-point t)))))))) (defun m3-backward-to-code (min-point) "Sets the point at the first non-comment, non-whitespace character before the current point, else at end-of-file" (interactive "n") (let ((continue t)) (while continue (if (re-search-backward "[^ \t\n][ \t\n]*" min-point t) (goto-char (match-beginning 0))) (setq continue (and (save-excursion (and (> (point) 1) (progn (forward-char -1) (looking-at m3-com-end-re)))) (progn (forward-char 1) (m3-skip-comment-backward min-point t))))) t)) (defun m3-re-search-forward (re max-point fail) "Assumes we're not in a comment. Puts point at the start of the first occurence of RE that is not in a comment, if such an occurence occurs before MAX-POINT, and returns non-nil. Otherwise, returns nil and leaves point unaffected. Results are undefined if RE matches any comment starter." (let ((continue t) (save-point (point)) (res nil)) (while continue (setq res (re-search-forward (concat "\\(" m3-com-start-re "\\|" re "\\)") max-point fail)) (goto-char (match-beginning 0)) (cond (res (cond ((looking-at m3-com-start-re) (m3-skip-comment-forward max-point fail)) (t (setq continue nil)))) (t (setq continue nil) (if (and (eq fail t) (not res)) (goto-char save-point))))) res)) (defun m3-re-search-backward (re min-point fail) "Assumes we're not in a comment. Puts point the start of the first previous occurence of RE that is not in a comment, if such an occurence occurs before MIN-POINT, and returns non-nil. FAIL is interpreted as is third argument to re-search. Results are undefined if RE matches any comment starter." (let ((continue t) (save-point (point)) (res nil)) (while continue (setq res (re-search-backward (concat "\\(" m3-com-end-re "\\|" re "\\)") min-point fail)) (cond (res (cond ((looking-at m3-com-end-re) (forward-char 2) (m3-skip-comment-backward min-point fail)) (t (setq continue nil)))) (t (setq continue nil) (if (and (eq fail t) (not res)) (goto-char save-point))))) res)) (defun m3-skip-comment-forward (max-point fail) "Requires that point is at the start of a comment. If that comment is terminated before MAX-POINT, return t and leaves point after end of the comment. Otherwise, if fail is 't, returns returns nil and leaves the point unchanged; if fail is nil raises an errer; if fail is not t or nil, returns nil and leaves the point at max-point or (point-max), whichever is smaller." (if (not (looking-at m3-com-start-re)) (error "m3-skip-comment-forward should only be called when looking at comment-starter")) (forward-char 2) (let ((save-point (point)) (continue t) res) (while continue ;;; (message "m3-comment-forward (0.5)") (sit-for 2) (setq res (re-search-forward m3-com-start-or-end-re max-point fail)) (cond (res ;;; (message "m3-comment-forward (1)") (sit-for 2) (goto-char (match-beginning 0)) ;;; (message "m3-comment-forward (2)") (sit-for 2) (cond ((looking-at m3-com-start-re) (if (not (m3-skip-comment-forward max-point fail)) (progn (setq res nil) (setq continue nil)))) ((looking-at m3-com-end-re) (goto-char (match-end 0)) (setq continue nil)) (t ;;; (message "m3-comment-forward (4)") (sit-for 2) (goto-char save-point) (setq res nil) (setq continue nil)))) (t ;;; (message "m3-comment-forward (5)") (sit-for 2) (goto-char save-point) (setq res nil) (setq continue nil)))) res)) (defun m3-skip-comment-backward (min-point fail) "Requires that point is at the end of a comment. If that comment is terminated before MIN-POINT, return t and leaves point at the start the comment. Otherwise returns nil and leaves the point in an unspecified position." (forward-char -2) (if (not (looking-at m3-com-end-re)) (error "m3-skip-comment-backward should only be called when looking at comment-ender")) (let ((save-point (point)) (continue t) res) (while continue (setq res (re-search-backward m3-com-start-or-end-re min-point fail)) (cond (res (cond ((looking-at m3-com-end-re) (forward-char 2) (if (not (m3-skip-comment-backward min-point fail)) (progn (setq res nil) (setq continue nil)))) ((looking-at m3-com-start-re) (setq continue nil)) (t (goto-char save-point) (setq res nil) (setq continue nil)))) (t (goto-char save-point) (setq res nil) (setq continue nil)))) res)) ;;;====================================================================== ;;; Electric END completion (defun m3-do-electric-end () ;;; (message "m3-do-electric-end") (sit-for 2) (let ((start-point (point)) (case-fold-search nil)) (cond ((and (save-excursion (end-of-line) (forward-word -1) ;;; (progn (message "m3-do-electric-end 1.2") (sit-for 2) t) (and (looking-at "END") (or (save-excursion (beginning-of-line) (looking-at "[ \t]*END[ \t]*$")) (progn (forward-word 1) (= (point) start-point))))) (or m3-electric-end m3-blink-end-matchers)) ;;; (progn (message "m3-do-electric-end 1.5") (sit-for 2) t) (let ((insert-point (save-excursion (end-of-line) (forward-word -1) (forward-word 1) (point))) (insert-string)) ;;; (progn (message "m3-do-electric-end 2") (sit-for 2) t) (end-of-line) (forward-word -1) (save-excursion (and (m3-backward-to-end-match (point-min)) (if m3-blink-end-matchers (sit-for 1) t) ;;; (progn (message "m3-do-electric-end 3") (sit-for 1) t) (progn (cond ;; Do nothing if we're not supposed to... ((not m3-electric-end)) ;; If it's a begin, what is it the begin of? ((looking-at "BEGIN") (cond ;; If it's on the left margin, it must be a module. ((looking-at "^BEGIN") (goto-char (point-min)) (and (re-search-forward "MODULE\\|INTERFACE" (point-max) t) (progn (goto-char (match-end 0)) (forward-word 1) (setq insert-string (concat (buffer-substring (save-excursion (forward-word -1) (point)) (point)) "."))))) ;; Is it the body of a procedure? ((save-excursion (let ((continue t)) (while continue (m3-re-search-backward "BEGIN\\|PROCEDURE\\|END" (point-min) t) (cond ((looking-at "END") (m3-backward-to-end-match (point-min)) (cond ((looking-at "BEGIN") (m3-re-search-backward "BEGIN\\|PROCEDURE" (point-min) t) (if (looking-at "BEGIN") (forward-word 1))))) (t (setq continue nil)))) (and (looking-at "PROCEDURE") (progn ;;; (message "m3-do-electric-end PROC 2") (sit-for 2) (forward-word 2) (setq insert-string (concat (buffer-substring (save-excursion (forward-word -1) (point)) (point)) ";"))))))) ;; Otherwise, it is just a random BEGIN, so ;; m3-electric-end must be 'all. ((eq m3-electric-end 'all) (setq insert-string "(* BEGIN *)")))) ((looking-at "INTERFACE\\|MODULE") (forward-word 2) (setq insert-string (concat (buffer-substring (save-excursion (forward-word -1) (point)) (point)) "."))) ;; Otherwise, m3-electric-end must be 'all. ((eq m3-electric-end 'all) ;;; (progn (message "m3-do-electric-end non-BEGIN") (sit-for 2) t) (setq insert-string (concat "(* " (buffer-substring (point) (save-excursion (forward-word 1) (point))) " *)"))))))) (cond (insert-string (progn (goto-char insert-point) ;; If we completed an END and then added something, include ;; the something in the completion... (if (and (marker-position m3-cur-keyword-completion-start) (= insert-point (+ m3-cur-keyword-completion-start m3-cur-keyword-completion-len))) (setq m3-cur-keyword-completion-len (+ m3-cur-keyword-completion-len 1 (length insert-string)))) (insert " " insert-string))) (t (goto-char start-point)))))))) ; ; COMMENTS ; (defun m3-begin-comment () "Indent to start comment column and then start Modula 3 comment." (interactive) (if (not (bolp)) (indent-to comment-column 0)) (insert "(* ")) (defun m3-end-comment () "Indent to end comment column and then end Modula 3 comment." (interactive) (if (not (bolp)) (indent-to end-comment-column)) (insert "*)\n")) (defun m3-banner () "Insert a comment line suitable for marking the start of a big comment." (insert "(******************************************************************* ********)\n")) ; ; STATEMENTS, DECLARATIONS AND KEYWORDS ; (defun m3-array () "Insert ARRAY, prompt for index type then finish with OF." (interactive) (insert "ARRAY ") (insert (read-string "Index type: ")) (insert " OF ")) (defun m3-case () "Build skeleton CASE statement, prompting for the expression and first label( s)." (interactive) (insert "CASE ") (insert (read-string "Case expression: ") " OF") (m3-newline) (insert "| ") (insert (read-string "First case label(s): ") " =>") (m3-newline) (m3-newline) (insert "END; (* case *)") (end-of-line 0) (m3-tab) (m3-tab)) (defun m3-const () "Insert CONST then newline and tab." (interactive) (insert "CONST") (m3-newline) (m3-tab)) (defun m3-declare () "Insert a Modula 3 declaration; prompt the user for declaration type." (interactive) (message "Var (default), Const, Type, Exception or Procedure") (let ((choice (read-char))) (if (char-equal ?c choice) (m3-const) (if (char-equal ?t choice) (m3-type) (if (char-equal ?e choice) (m3-exception) (if (char-equal ?p choice) (m3-procedure) (m3-var))))))) (defun m3-except () "Insert EXCEPT clause of a TRY statement." (interactive) (insert "EXCEPT") (m3-newline) (m3-newline) (insert "END; (* try *)") (end-of-line -2) (m3-tab)) (defun m3-exception () "Insert EXCEPTION then newline and tab." (interactive) (insert "EXCEPTION") (m3-newline) (m3-tab)) (defun m3-else () "Insert ELSE or ELSIF keyword and indent for next line." (interactive) (m3-newline) (backward-delete-char-untabify m3-indent ()) (message "elsE (default) or elsIf") (if (not (char-equal ?i (read-char))) (insert "ELSE") (insert "ELSIF ") (insert (read-string "Elsif expression: ")) (insert " THEN")) (m3-newline) (m3-tab)) (defun m3-finally () "Insert FINALLY clause of a TRY statement." (interactive) (insert "FINALLY") (m3-newline) (m3-tab) (m3-newline) (backward-delete-char-untabify m3-indent ()) (insert "END; (* try *)") (end-of-line -2) (m3-tab)) (defun m3-for () "Build skeleton FOR loop statement, prompting for the loop parameters." (interactive) (insert "FOR ") (insert (read-string "For: ") " TO ") (insert (read-string "To: ")) (let ((by (read-string "By: "))) (if (not (string-equal by "")) (insert " BY " by))) (insert " DO") (m3-newline) (m3-newline) (insert "END; (* for *)") (end-of-line 0) (m3-tab)) (defun m3-if () "Insert skeleton IF statement, prompting for the expression." (interactive) (insert "IF ") (insert (read-string "If expression: ") " THEN") (m3-newline) (m3-newline) (insert "END; (* if *)") (end-of-line 0) (m3-tab)) (defun m3-loop-or-lock () "Insert LOOP or LOCK statement; prompt user to decide which." (interactive) (message "looP (default) or locK") (if (char-equal ?k (read-char)) (m3-lock) (m3-loop))) (defun m3-loop () "Build skeleton LOOP (with END)." (interactive) (insert "LOOP") (m3-newline) (m3-newline) (insert "END; (* loop *)") (end-of-line 0) (m3-tab)) (defun m3-lock () "Build skeleton LOCK (with END)." (interactive) (insert "LOCK ") (insert (read-string "Lock mutex: ") " DO") (m3-newline) (m3-newline) (insert "END; (* lock *)") (end-of-line 0) (m3-tab)) (defun m3-module-type () "Returns char describing module type deduced from buffername and user input." (interactive) (if (m3-is-def) ?i ?m)) (defun m3-choose-module () "Build skeleton MODULE, decide module type from buffername and user input." (interactive) (m3-module (m3-module-type))) (defun m3-choose-module-name () "Prompt user for module name; if user returns null use buffer name." (let ((name (read-string "Module name (default is buffer name): "))) (if (string-equal name "") (m3-strip-extension (buffer-name)) name))) (defun m3-module (type) "Build skeleton MODULE, prompting for module name." (interactive) (if (char-equal type ?i) (insert "INTERFACE ") (if (char-equal type ?m) (insert "MODULE ") ())) (let ((name (m3-choose-module-name)) (args "")) (insert name) (if (char-equal type ?m) (setq args (read-string "Exports list (default is empty): ")) ()) (if (not (string-equal args "")) (insert " EXPORTS " args)) (insert ";\n\n") (m3-banner) (insert "(* Author: " (user-full-name)) (m3-end-comment) (m3-banner) (insert "\n(* $Rev") ; split into two so RCS can't find it! (insert "ision$ *)\n") (insert "\n\n\n") (if (char-equal type ?m) (insert "BEGIN\n\nEND " name ".\n") (insert "END " name ".\n")) (if (char-equal type ?m) (previous-line 5) (previous-line 3)) )) (defun m3-next-case () "Move on to next arm of a CASE or TYPECASE statement." (interactive) (m3-newline) (backward-delete-char-untabify m3-indent) (backward-delete-char-untabify m3-indent) (let* ((label (read-string "Case label(s): ")) (not-else (not (string-equal "ELSE" label)))) (if not-else (insert "| ")) (insert label) (if not-else (insert " =>")) (m3-newline) (m3-tab) (if not-else (m3-tab)))) (defun m3-object () "Insert a skeleton OBJECT." (interactive) (insert "OBJECT") (m3-newline) (m3-newline) (insert "METHODS") (m3-newline) (insert "END; (* object *)") (end-of-line -1) (m3-tab)) (defun m3-procedure () "Build a skeleton PROCEDURE declaration, prompting the user as necessary." (interactive) (insert "PROCEDURE ") (let ((name (read-string "Procedure name: " )) args) (insert name "(") (insert (read-string "Procedure arguments: ") ")") (setq args (read-string "Procedure result type: ")) (if (not (string-equal args "")) (insert ": " args)) (setq args (read-string "Procedure raises list (or ANY): ")) (if (not (string-equal args "ANY")) (insert " RAISES {" args "}")) (if (m3-is-def) (insert ";") (insert "=")) (m3-newline) (if (m3-is-def) () (m3-tab) (insert "BEGIN") (m3-newline) (m3-newline) (insert "END ") (insert name) (insert ";\n\n") (end-of-line -2) (m3-tab)))) (defun m3-block () "Insert a skeleton block" (interactive) (insert "BEGIN") (m3-newline) (m3-newline) (insert "END;") (end-of-line 0) (m3-tab)) (defun m3-record () "Insert a skeleton RECORD." (interactive) (insert "RECORD") (m3-newline) (m3-newline) (insert "END; (* record *)") (end-of-line 0) (m3-tab)) (defun m3-type () "Insert TYPE then newline and tab." (interactive) (insert "TYPE") (m3-newline) (m3-tab)) (defun m3-try-or-typecase () "Insert a TRY or TYPECASE statement; prompt the user to decide which." (interactive) (message "tRy (default) or tYpecase") (if (char-equal ?y (read-char)) (m3-typecase) (m3-try))) (defun m3-try () "Build TRY statement, prompting to see if it is the EXCEPT or FINALLY form." (interactive) (insert "TRY") (m3-newline) (m3-newline) (message "Except (default) or Finally") (if (char-equal ?f (read-char)) (m3-finally) (m3-except))) (defun m3-typecase () "Build skeleton TYPECASE statement, prompting for the expression and first la bels." (interactive) (insert "TYPECASE ") (insert (read-string "Typecase expression: ") " OF") (m3-newline) (insert "| " (read-string "First typecase label(s): ") " =>") (m3-newline) (m3-newline) (insert "END; (* typecase *)") (end-of-line 0) (m3-tab) (m3-tab)) (defun m3-until () "Insert a skeleton REPEAT loop, prompting the user for the final expression." (interactive) (insert "REPEAT") (m3-newline) (m3-newline) (insert "UNTIL ") (insert (read-string "Until expression: ") ";") (end-of-line 0) (m3-tab)) (defun m3-var () "Insert VAR then newline and tab." (insert "VAR") (m3-newline) (m3-tab)) (defun m3-while-or-with () "Insert WHILE or WITH statement; prompt user to decide which." (interactive) (message "wHile (default) or wIth") (if (char-equal ?i (read-char)) (m3-with) (m3-while))) (defun m3-while () "Insert skeleton WHILE statement; prompt user for while expression." (interactive) (insert "WHILE ") (insert (read-string "While expression: ")) (insert " DO") (m3-newline) (m3-newline) (insert "END; (* while *)") (end-of-line 0) (m3-tab)) (defun m3-with () "Insert skeleton WITH statement; prompt user for WITH bindings." (interactive) (insert "WITH ") (insert (read-string "With bindings: ")) (insert " DO") (m3-newline) (m3-newline) (insert "END; (* with *)") (end-of-line 0) (m3-tab)) (defun m3-import () "Insert FROM ... IMPORT statement, prompting user for module." (interactive) (insert "FROM ") (insert (read-string "Import from module: ")) (insert " IMPORT ")) ; ; COMMANDS ; (defun m3-compile () "call m3c, argument is modulename derived from current buffer name." (interactive) (if (m3-is-oli) (compile (concat "m3c -g " (if (m3-is-def) "-i " "-m ") (m3-strip-extension (buffer-name)))) ; else (compile (concat "m3 -c -g " (m3-strip-bufnum (buffer-name))))) ) (defun m3-is-oli () (or (string-equal (m3-get-extension (buffer-name)) ".i") (string-equal (m3-get-extension (buffer-name)) ".m"))) (defun m3-position-of-end-of-line () "Returns position of end of line" (save-excursion (end-of-line) (point))) (defun m3-match-regexp-here (regexp) "Tries to match regexp at current position and before end of line" (let ((save-point (point))) (if (and (re-search-forward regexp (m3-position-of-end-of-line) t) (= (match-beginning 0) save-point)) t (goto-char save-point) nil))) (defun m3-multi-to-single-line-proc-header () "Convert multi line proc header to single line; do not call this directly" (backward-char) (let ((start-of-signature (point))) (forward-list) (re-search-forward "[=;]") (save-restriction (narrow-to-region start-of-signature (point)) (goto-char (point-min)) (save-excursion (replace-regexp "[ \t\n]+" " ")) (save-excursion (replace-string "( " "(")) (save-excursion (replace-string ") :" "):"))))) (defun m3-single-to-multi-line-proc-header () "Convert multi line proc header to single line; do not call this directly" (backward-char) (let ((start-of-signature (point))) (forward-list) (re-search-forward "[=;]") (save-restriction (narrow-to-region start-of-signature (point)) (goto-char (point-min)) (save-excursion (replace-string " RAISES" "\n RAISES")) (save-excursion (replace-regexp "\\([^*]\\)) ?:" "\\1)\n :")) (save-excursion (replace-string "; " ";\n ")) (forward-char) (insert "\n ")))) (defun m3-convert-proc-header () "Convert single line <-> multi line proc header" (interactive) (beginning-of-line) (let ((old-cfs case-fold-search)) (setq case-fold-search nil) (save-excursion (if (not (m3-match-regexp-here "\\(INLINE \\|\\) *PROCEDURE *[A-Za-z0-9_] + *(")) (message "Must be on first line of procedure header") (while (or (= (following-char) ? ) (= (following-char) ?\t)) (delete-char 1)) (if (or (= (following-char) ?\n) (= (following-char) ?\r)) (m3-multi-to-single-line-proc-header) (m3-single-to-multi-line-proc-header)))) (setq case-fold-search old-cfs))) (defun m3-search-path-line (name) "Appends given name to current line and sees if result is a file name. Returns either nil or the file name." (let ((old-point (point))) (if (not (search-forward "\n" nil t)) nil ; else (let* ((dir-name (m3-filename-expand (buffer-substring old-point (- (point) 1)))) (try (if (string= dir-name "") name (concat dir-name "/" name)))) (if (file-exists-p try) try (m3-search-path-line name)))))) (defun m3-filename-expand (name) (let ((pos 0) (spos 0) (epos 0) (res nil) ) (while (string-match "\\$(" name pos) (setq spos (match-beginning 0)) (setq res (concat res (substring name pos spos))) (setq epos (string-match ")" name spos)) (setq res (concat res (getenv (substring name (+ 2 spos) epos)))) (setq pos (1+ epos)) ) (setq res (concat res (substring name pos))) ) ) (defun m3-strip-extension (name) "Strips .ext from the given string (where ext is any extension)" (let ((dot-pos (string-match "\\." name))) (if dot-pos (substring name 0 dot-pos) name))) (defun m3-strip-bufnum (name) "Strips any from the given string" (let ((dot-pos (string-match "<" name))) (if dot-pos (substring name dot-pos nil) name))) (defun m3-get-extension (name) "Gets .ext from the given string (where ext is any extension)" (let ((dot-pos (string-match "\\." name))) (if dot-pos (let ((ext (substring name dot-pos nil)) ext_pos) (setq ext-pos (string-match "<" ext)) (if ext-pos (substring ext 0 ext-pos) ext)) ; else nil ) ) ) (defun m3-search-path (name path-file extension) "Uses path file to return full file name for given name and extension. Arguments are NAME - the file name to search for. PATHFILE - a string which is the name of a file containing newline separated directory names. The third argument is EXTENSION - a string. Takes NAME, extends it by EXTENSION then appends it to each directory given in PATHFILE until the name of an existing file is obtained. Then returns the full file name." (save-excursion (set-buffer (generate-new-buffer (concat "*" path-file "*"))) (delete-region (point-min) (point-max)) (let ((old-point-max (point-max)) (full-name (concat (m3-strip-extension name) "." extension))) (goto-char old-point-max) (if (file-readable-p path-file) (call-process "cat" path-file t)) (if (= (point-max) old-point-max) (if (file-exists-p name) full-name nil) ; else (goto-char old-point-max) (m3-search-path-line full-name))))) (defun m3-path-find-named-file (name path-file extension) "Uses path file to search and open file with given name and extension. Arguments are NAME - the file name to search for. PATHFILE - a string which is the name of a file containing newline separated directory names. The third argument is EXTENSION - a string. Takes NAME, extends it by EXTENSION then appends it to each directory given in PATHFILE until the name of an existing file is obtained. Then opens the file in the other window." (let ((file-name (m3-search-path name path-file extension))) (if file-name (find-file-other-window file-name)))) (defun m3-whole-prev-word () "Return word under or previous to point as a string" (buffer-substring (save-excursion (backward-word 1) (point)) (save-excursion (backward-word 1) (forward-word 1) (point)))) (defun m3-find-file-on-path (path-file extension) "Uses path file to search and open file named by current word and extension. Arguments are PATHFILE - a string which is the name of a file containing newline separated directory names. The second argument is EXTENSION - a string. Takes the word under point, extends it by EXTENSION then appends it to each directory given in PATHFILE until the name of an existing file is obtained. Then opens the file in the other window." (m3-path-find-named-file (m3-whole-prev-word) path-file extension)) (defun m3-path-find-file () "Visit interface corresponding to name currently under point. Looks down the m3path so it doesn't work unless all sources are on the m3path." (interactive) (if (m3-is-oli) (m3-find-file-on-path "m3path" "i") ; else (m3-find-file-on-path "m3path" "i3"))) ;(defun execute-monitor-command (command) ; (let* ((shell shell-file-name) ; (csh (equal (file-name-nondirectory shell) "csh"))) ; (call-process shell nil t t "-cf" (concat "exec " command)))) (defun m3-toggle-buffer () "Toggle between .i/.i3 and .m/.m3 files for the module." (interactive) (cond ((string-equal (m3-get-extension (buffer-name)) ".i") (find-file-other-window (concat (m3-strip-extension (buffer-name)) ".m"))) ((string-equal (m3-get-extension (buffer-name)) ".i3") (find-file-other-window (concat (m3-strip-extension (buffer-name)) ".m3"))) ((string-equal (m3-get-extension (buffer-name)) ".m") (find-file-other-window (concat (m3-strip-extension (buffer-name)) ".i"))) ((string-equal (m3-get-extension (buffer-name)) ".m3") (find-file-other-window (concat (m3-strip-extension (buffer-name)) ".i3"))))) ; ; PSEUDO ABBREV MODE ; (defvar m3-abbrev-enabled 'aggressive "*Values are nil, 'aggressive, and 'polite, indicating no abbrev completion, aggressive and polite abbrev mode, respectively.") ;;;(setq m3-abbrev-enabled 'polite) (defvar m3-electric-end nil "*Values are nil -- do nothing; 'proc-mod -- match name of procedure or module; 'all -- proc-mod + add comment for others.") (defvar m3-blink-end-matchers nil) ;;;(setq m3-electric-end 'all) ;;;(setq m3-blink-end-matchers 't) (defun m3-toggle-abbrev () "Toggle the flag enabling/disabling Modula 3 pseudo abbrev mode." (interactive) (cond ((eq m3-abbrev-enabled 'aggressive) (setq m3-abbrev-enabled nil)) ((eq m3-abbrev-enabled 'polite) (setq m3-abbrev-enabled 'aggressive)) ((eq m3-abbrev-enabled nil) (setq m3-abbrev-enabled 'polite))) (message "Set m3-abbrev style to %s." m3-abbrev-enabled)) (defun m3-prev-word () "returns last word in buffer." (buffer-substring (point) (save-excursion (backward-word 1) (point)))) (defun m3-is-abbrev (keyword word) "Returns non-nil if WORD is abbreviation of given KEYWORD." (if (> (length word) (length keyword)) () (string-equal (substring keyword 0 (length word)) (upcase word)))) (defun m3-is-prefix (word prefix &optional no-upper) "returns non-nil if PREFIX is a (non-proper) prefix of WORD." (let ((uword (if no-upper word (upcase word))) (uprefix (if no-upper prefix (upcase prefix)))) (if (> (length prefix) (length word)) nil (string-equal (substring uword 0 (length prefix)) uprefix)))) (defun m3-if-abbrev-kill-prev (keyword word) "checks if word is abbreviation of keyword; if so deletes last word in buffer." (if (not (m3-is-abbrev keyword word)) () (forward-word -1) (delete-region (point) (save-excursion (forward-word 1) (point))) t)) (defun m3-abbrev () "call appropriate m3-function depending on value of last word in buffer." (let ((pw (m3-prev-word))) ;; Must split this in two because it's so big (or else elisp ;; can't handle it.) (cond ((eq m3-abbrev-enabled 'aggressive) (or (m3-aggressive-abbrev-1 pw) (m3-aggressive-abbrev-2 pw))) (t ;; "polite" (m3-polite-abbrev pw))))) (defun m3-aggressive-abbrev-1 (pw) (cond ((m3-if-abbrev-kill-prev "ABS" pw) (insert "ABS") t) ((m3-if-abbrev-kill-prev "ADDRESS" pw) (insert "ADDRESS") t) ((m3-if-abbrev-kill-prev "ADR" pw) (insert "ADR") t) ((m3-if-abbrev-kill-prev "ADRSIZE" pw) (insert "ADRSIZE") t) ((m3-if-abbrev-kill-prev "AND" pw) (insert "AND ") t) ((m3-if-abbrev-kill-prev "BEGIN" pw) (insert "BEGIN") t) ((m3-if-abbrev-kill-prev "BITS" pw) (insert "BITS ") t) ((m3-if-abbrev-kill-prev "BITSIZE" pw) (insert "BITSIZE") t) ((m3-if-abbrev-kill-prev "BOOLEAN" pw) (insert "BOOLEAN") t) ((m3-if-abbrev-kill-prev "BRANDED" pw) (insert "BRANDED") t) ((m3-if-abbrev-kill-prev "BY" pw) (insert "BY") t) ((m3-if-abbrev-kill-prev "BYTESIZE" pw) (insert "BYTESIZE") t) ((m3-if-abbrev-kill-prev "CARDINAL" pw) (insert "CARDINAL") t) ((m3-if-abbrev-kill-prev "CEILING" pw) (insert "CEILING") t) ((m3-if-abbrev-kill-prev "CHAR" pw) (insert "CHAR") t) ((m3-if-abbrev-kill-prev "DEC" pw) (insert "DEC") t) ((m3-if-abbrev-kill-prev "DISPOSE" pw) (insert "DISPOSE") t) ((m3-if-abbrev-kill-prev "DIV" pw) (insert "DIV ") t) ((m3-if-abbrev-kill-prev "DO" pw) (insert "DO ") t) ((m3-if-abbrev-kill-prev "ELSIF" pw) (insert "ELSIF") t) ((m3-if-abbrev-kill-prev "END" pw) (insert "END") t) ((m3-if-abbrev-kill-prev "EVAL" pw) (insert "EVAL") t) ((m3-if-abbrev-kill-prev "EXCEPT" pw) (insert "EXCEPT") t) ((m3-if-abbrev-kill-prev "EXIT" pw) (insert "EXIT") t) ((m3-if-abbrev-kill-prev "EXPORTS" pw) (insert "EXPORTS ") t) ((m3-if-abbrev-kill-prev "FALSE" pw) (insert "FALSE") t) ((m3-if-abbrev-kill-prev "FINALLY" pw) (insert "FINALLY") t) ((m3-if-abbrev-kill-prev "FIRST" pw) (insert "FIRST") t) ((m3-if-abbrev-kill-prev "FLOAT" pw) (insert "FLOAT") t) ((m3-if-abbrev-kill-prev "FLOOR" pw) (insert "FLOOR") t) ((m3-if-abbrev-kill-prev "IMPORT" pw) (insert "IMPORT ") t) ((m3-if-abbrev-kill-prev "IN" pw) (insert "IN") t) ((m3-if-abbrev-kill-prev "INC" pw) (insert "INC") t) ((m3-if-abbrev-kill-prev "INLINE" pw) (insert "INLINE") t) ((m3-if-abbrev-kill-prev "INTEGER" pw) (insert "INTEGER") t) ((m3-if-abbrev-kill-prev "LAST" pw) (insert "LAST") t) ((m3-if-abbrev-kill-prev "LONGFLOAT" pw) (insert "LONGFLOAT") t) ((m3-if-abbrev-kill-prev "LONGREAL" pw) (insert "LONGREAL") t) ((m3-if-abbrev-kill-prev "LOOPHOLE" pw) (insert "LOOPHOLE") t) ((m3-if-abbrev-kill-prev "MAX" pw) (insert "MAX") t) ((m3-if-abbrev-kill-prev "METHODS" pw) (insert "METHODS") t) ((m3-if-abbrev-kill-prev "MIN" pw) (insert "MIN") t) ((m3-if-abbrev-kill-prev "MOD" pw) (insert "MOD") t) ;; These may be either "aggressive" or "polite". ((m3-if-abbrev-kill-prev "ARRAY" pw) (m3-array) t) ((m3-if-abbrev-kill-prev "CASE" pw) (m3-case) t) ((m3-if-abbrev-kill-prev "CONST" pw) (m3-const) t) ((m3-if-abbrev-kill-prev "ELSE" pw) (m3-else) t) ((m3-if-abbrev-kill-prev "FOR" pw) (m3-for) t) ((m3-if-abbrev-kill-prev "FROM" pw) (m3-import) t) ((m3-if-abbrev-kill-prev "IF" pw) (m3-if) t) ((m3-if-abbrev-kill-prev "LOCK" pw) (m3-lock) t) ((m3-if-abbrev-kill-prev "LOOP" pw) (m3-loop) t) ((m3-if-abbrev-kill-prev "INTERFACE" pw) (m3-module ?i) t) ((m3-if-abbrev-kill-prev "MODULE" pw) (m3-module ?m) t) ((m3-if-abbrev-kill-prev "EXCEPTION" pw) (m3-exception) t) (t nil))) (defun m3-aggressive-abbrev-2 (pw) (cond ((m3-if-abbrev-kill-prev "NARROW" pw) (insert "NARROW") t) ((m3-if-abbrev-kill-prev "NEW" pw) (insert "NEW") t) ((m3-if-abbrev-kill-prev "NIL" pw) (insert "NIL") t) ((m3-if-abbrev-kill-prev "NULL" pw) (insert "NULL") t) ((m3-if-abbrev-kill-prev "NUMBER" pw) (insert "NUMBER") t) ((m3-if-abbrev-kill-prev "NOT" pw) (insert "NOT ") t) ((m3-if-abbrev-kill-prev "OF" pw) (insert "OF") t) ((m3-if-abbrev-kill-prev "OR" pw) (insert "OR ") t) ((m3-if-abbrev-kill-prev "ORD" pw) (insert "ORD") t) ((m3-if-abbrev-kill-prev "OVERRIDES" pw) (insert "OVERRIDES") t) ((m3-if-abbrev-kill-prev "RAISE" pw) (insert "RAISE") t) ((m3-if-abbrev-kill-prev "RAISES" pw) (insert "RAISES") t) ((m3-if-abbrev-kill-prev "READONLY" pw) (insert "READONLY") t) ((m3-if-abbrev-kill-prev "REAL" pw) (insert "REAL") t) ((m3-if-abbrev-kill-prev "REF" pw) (insert "REF ") t) ((m3-if-abbrev-kill-prev "REFANY" pw) (insert "REFANY") t) ((m3-if-abbrev-kill-prev "RETURN" pw) (insert "RETURN") t) ((m3-if-abbrev-kill-prev "REVEAL" pw) (insert "REVEAL") t) ((m3-if-abbrev-kill-prev "ROUND" pw) (insert "ROUND") t) ((m3-if-abbrev-kill-prev "SET" pw) (insert "SET OF ") t) ((m3-if-abbrev-kill-prev "SUBARRAY" pw) (insert "SUBARRAY") t) ((m3-if-abbrev-kill-prev "THEN" pw) (insert "THEN") t) ((m3-if-abbrev-kill-prev "TO" pw) (insert "TO") t) ((m3-if-abbrev-kill-prev "TRUE" pw) (insert "TRUE") t) ((m3-if-abbrev-kill-prev "TRUNC" pw) (insert "TRUNC") t) ((m3-if-abbrev-kill-prev "TYPECODE" pw) (insert "TYPECODE") t) ((m3-if-abbrev-kill-prev "UNSAFE" pw) (insert "UNSAFE") t) ((m3-if-abbrev-kill-prev "UNTIL" pw) (insert "UNTIL") t) ((m3-if-abbrev-kill-prev "UNTRACED" pw) (insert "UNTRACED") t) ((m3-if-abbrev-kill-prev "VAL" pw) (insert "VAL") t) ((m3-if-abbrev-kill-prev "VALUE" pw) (insert "VALUE") t) ((m3-if-abbrev-kill-prev "REPEAT" pw) (m3-until) t) ((m3-if-abbrev-kill-prev "OBJECT" pw) (m3-object) t) ((m3-if-abbrev-kill-prev "PROCEDURE" pw) (m3-procedure) t) ((m3-if-abbrev-kill-prev "RECORD" pw) (m3-record) t) ((m3-if-abbrev-kill-prev "TRY" pw) (m3-try) t) ((m3-if-abbrev-kill-prev "TYPE" pw) (m3-type) t) ((m3-if-abbrev-kill-prev "TYPECASE" pw) (m3-typecase) t) ((m3-if-abbrev-kill-prev "VAR" pw) (m3-var) t) ((m3-if-abbrev-kill-prev "WHILE" pw) (m3-while) t) ((m3-if-abbrev-kill-prev "WITH" pw) (m3-with) t) (t nil))) ;;; Here are the data structure we'll use for the "intelligent" keyword ;;; completion: ;;; ;;; We associate each keyword with a weight. When we complete a keyword, ;;; (defvar m3-cur-keyword-completion-start (make-marker) "A marker indicating the start of the last word that was keyword-completed.") (defvar m3-cur-keyword-completion-len nil "The length of the completed keyword at the time of completion, to allow us to determine if the user has entered more text.") (defvar m3-cur-keyword-completions nil "A list of the strings that matched the originally input keyword text.") ;;; This alist associates with each keyword: ;;; ( ) ;;; ;;; is a score for breaking ties. Smaller numbers are ;;; preferred to higher. ;;; is a list of properties of the keyword. ;;; Properties include: ;;; left-margin status: It is assumed that a keyword cannot ;;; appear at the left-margin unless it has one of the ;;; properties 'lm-ok or 'lm-only, which indicate that it can ;;; or must appear at the left margin, respectively. ;;; line-starter status: It is assumed that a keyword cannot ;;; appear after an ssl-introducer unless it has one of the ;;; properties 'ls-ok or 'ls-only, which indicate that it can ;;; or must appear after an ssl-introducer, respectively. ;;; , if non-nil, is a function that must return non-nil for the ;;; completion to be legal (defconst m3-keyword-completions '(("ABS" . (3 ())) ("ADDRESS" . (5 ())) ("ADR" . (6 ())) ("ADRSIZE" . (7 ())) ("AND" . (2 ())) ("ANY" . (1 () (lambda (on-lm starts-ssl) (m3-keyword-before-ssl-introducer-p "RAISES")))) ("ARRAY" . (4 (ls-ok) (lambda (on-lm starts-ssl) (or (not starts-ssl) (save-excursion (forward-word -2) (looking-at "OF")))))) ("BEGIN" . (1 (lm-ok ls-ok) (lambda (on-lm starts-ssl) (save-excursion (forward-word -1) (if (not starts-ssl) (m3-after-procedure-introducer (point-min)) t))))) ("BITS" . (6 ())) ("BITSIZE" . (7 ())) ("BOOLEAN" . (3 ())) ("BRANDED" . (4 ())) ("BY" . (2 () (lambda (on-lm starts-ssl) (m3-keyword-before-ssl-introducer-p "FOR")))) ("BYTESIZE" . (5 ())) ("CARDINAL" . (4 ())) ("CASE" . (3 (ls-only))) ("CEILING" . (5 ())) ("CHAR" . (2 ())) ("CONST" . (1 (lm-ok ls-ok))) ("DEC" . (2 (ls-only))) ("DISPOSE" . (4 (ls-only))) ("DIV" . (3 ())) ("DO" . (1 () (lambda (on-lm starts-ssl) (save-excursion (forward-word -1) (or (m3-keyword-before-ssl-introducer-p "WHILE") (m3-keyword-before-ssl-introducer-p "WITH") (m3-keyword-before-ssl-introducer-p "FOR") (m3-keyword-before-ssl-introducer-p "LOCK")))))) ("ELSE" . (2 (ls-ok) (lambda (on-lm starts-ssl) (or (m3-end-matcher-is-p "IF") (m3-end-matcher-is-p "TRY") (m3-end-matcher-is-p "\\bCASE") (m3-end-matcher-is-p "\\bTYPECASE"))))) ("ELSIF" . (3 (ls-ok) (lambda (on-lm starts-ssl) (m3-end-matcher-is-p "IF")))) ("END" . (1 (lm-ok ls-ok))) ("EVAL" . (7 (ls-only))) ("EXCEPT" . (6 (ls-ok) (lambda (on-lm starts-ssl) (m3-end-matcher-is-p "TRY")))) ("EXCEPTION" . (5 (lm-only ls-ok))) ("EXIT" . (8 (ls-only))) ("EXPORTS" . (4 () (lambda (on-lm starts-ssl) (save-excursion ;; One for prefix of EXPORTS one for module name, ;; one for MODULE. (forward-word -3) (looking-at "MODULE"))))) ("FALSE" . (4 ())) ("FINALLY" . (3 (ls-ok) (lambda (on-lm starts-ssl) (m3-end-matcher-is-p "TRY")))) ("FIRST" . (5 ())) ("FLOAT" . (6 ())) ("FLOOR" . (7 ())) ("FOR" . (2 (ls-only))) ("FROM" . (1 (lm-only ls-ok))) ("GENERIC" . (1 (lm-only))) ("IMPORT" . (2 (lm-ok ls-ok) (lambda (on-lm starts-ssl) (or on-lm (save-excursion (forward-word -3) (looking-at "FROM")))))) ("IF" . (3 (ls-only) (lambda (on-lm starts-ssl) (or (not starts-ssl) (save-excursion (forward-word -3) (not (looking-at "\\(\\bARRAY\\|\bSET\\)[ \t]+OF"))))))) ("IN" . (7 ())) ("INC" . (4 (ls-only) (lambda (on-lm starts-ssl) (or (not starts-ssl) (save-excursion (forward-word -3) (not (looking-at "\\(\\bARRAY\\|\bSET\\)[ \t]+OF"))))))) ("INTEGER" . (5 (ls-ok) (lambda (on-lm starts-ssl) (or (not starts-ssl) (save-excursion (forward-word -2) (looking-at "OF")))))) ("INTERFACE" . (1 (lm-ok) (lambda (on-lm starts-ssl) (save-excursion (or on-lm (progn (forward-word -2) (and (m3-at-left-margin-p) (looking-at "GENERIC\\|UNSAFE")))))))) ("ISTYPE" . (7 ())) ("LAST" . (3 ())) ("LOCK" . (1 (ls-only))) ("LOOP" . (2 (ls-only))) ("LONGFLOAT" . (4 ())) ("LONGREAL" . (5 ())) ("LOOPHOLE" . (6 ())) ("MAX" . (5 ())) ("METHODS" . (2 (ls-only))) ("MIN" . (4 ())) ("MOD" . (3 ())) ("MODULE" . (1 (lm-ok) (lambda (on-lm starts-ssl) (save-excursion (forward-word -1) (or (m3-at-left-margin-p) (progn (forward-word -1) (and (m3-at-left-margin-p) (looking-at "GENERIC\\|UNSAFE")))))))) ("NARROW" . (1 ())) ("NEW" . (2 ())) ("NIL" . (3 ())) ("NULL" . (6 ())) ("NUMBER" . (5 ())) ("NOT" . (4 ())) ("OBJECT" . (2 () (lambda (on-lm starts-ssl) (save-excursion (m3-re-search-backward m3-part-starters (point-min) t) (looking-at "TYPE\\|REVEAL"))))) ("OF" . (1 () (lambda (on-lm starts-ssl) (or (m3-keyword-before-ssl-introducer-p "\\bCASE\\|\\bTYPECASE") (m3-keyword-before-ssl-introducer-p "\\bARRAY\\|SET\\b"))))) ("OR" . (4 ())) ("ORD" . (5 ())) ("OVERRIDES" . (3 (ls-only))) ("PROCEDURE" . (1 (lm-ok ls-ok))) ("RAISE" . (5 (ls-only))) ("RAISES" . (3 () m3-raises-ok)) ("READONLY" . (4 () (lambda (on-lm starts-ssl) (m3-in-arg-list 0)))) ("REAL" . (9 ())) ("RECORD" . (6 ())) ("REF" . (7 ())) ("REFANY" . (8 ())) ("REPEAT" . (10 (ls-only))) ("RETURN" . (2 (ls-only))) ("REVEAL" . (1 (lm-only ls-ok))) ("ROOT" . (11 ())) ("ROUND" . (12 ())) ("SET" . (1 ())) ("SUBARRAY" . (2 (ls-ok))) ("TEXT" . (6 ())) ("THEN" . (1 () (lambda (on-lm starts-ssl) (or (m3-keyword-before-ssl-introducer-p "\\bIF") (m3-keyword-before-ssl-introducer-p "\\bELSIF"))))) ("TO" . (2 () (lambda (on-lm starts-ssl) (m3-keyword-before-ssl-introducer-p "\\bFOR")))) ("TRUE" . (8 ())) ("TRUNC" . (9 ())) ("TRY" . (3 (ls-only))) ("TYPE" . (4 (lm-ok ls-ok))) ("TYPECASE" . (5 (ls-only))) ("TYPECODE" . (7 ())) ("UNSAFE" . (1 (lm-only))) ("UNTIL" . (2 (ls-ok))) ("UNTRACED" . (3 ())) ("VAL" . (2 () (lambda (on-lm starts-ssl) (and (not (save-excursion (forward-word -1) (m3-after-procedure-introducer 0))) (not (m3-in-arg-list 0)))))) ("VALUE" . (3 () (lambda (on-lm starts-ssl) (not (save-excursion (forward-word -1) (m3-after-procedure-introducer 0)))))) ("VAR" . (1 (lm-ok ls-ok) (lambda (on-lm starts-ssl) (or on-lm starts-ssl (save-excursion (forward-word -1) (m3-after-procedure-introducer 0)) (m3-in-arg-list 0))))) ("WHILE" . (1 (ls-only))) ("WITH" . (2 (ls-only))))) (defun m3-at-left-margin-p () (eq (current-column) 0)) (defun m3-keyword-before-ssl-introducer-p (keyword) "Returns non-nil if KEYWORD occurs before an ssl-introducer (other than KEYWORD), looking backward." (save-excursion (m3-re-search-backward (concat "\\(;\\|END\\|" m3-keyword-endable-ssl-introducers "\\|" keyword "\\)") (point-min) 't) (looking-at keyword))) (defun m3-end-matcher-is-p (keyword) "Returns non-nil if the keyword that would match an END inserted at point is KEYWORD." (save-excursion (m3-backward-to-end-match (point-min)) (looking-at keyword))) (defun m3-raises-ok (on-lm starts-ssl) (save-excursion (forward-word -1) (let ((save-point (point))) (and (m3-re-search-backward "[^*])" 0 t) (progn (forward-char 1) (and (m3-in-arg-list 0) (progn (forward-char 1) (let ((retval-pat (concat "[ \t\n]*:[ \t\n]*" m3-poss-qual-ident-re))) (if (looking-at retval-pat) (progn (re-search-forward retval-pat) (goto-char (match-end 0)))) (m3-forward-to-code (point-max)) (= (point) save-point))))))))) (defun m3-polite-abbrev (pw) ;;; (message "In m3-polite-abbrev") (sit-for 2) (let ((case-fold-search nil)) (cond ;; First, if the start of the current keyword is the same as the ;; start of the last keyword we completed, and the user hasn't ;; appended any characters, and m3-cur-keyword-completions is non-nil, ;; try the next completion in the list. ((and ;;; (progn (message "In m3-polite-abbrev (x1)") (sit-for 2) t) (marker-position m3-cur-keyword-completion-start) ;;; (progn (message "In m3-polite-abbrev (x2)") (sit-for 2) t) (> (point) m3-cur-keyword-completion-len) (= m3-cur-keyword-completion-start (save-excursion (forward-char (- m3-cur-keyword-completion-len)) (point))) ;;; (progn (message "In m3-polite-abbrev (x3)") (sit-for 2) t) m3-cur-keyword-completions) (let ((cur-completion (car m3-cur-keyword-completions))) (setq m3-cur-keyword-completions (append (cdr m3-cur-keyword-completions) (list cur-completion))) ;;; (progn (message "In m3-polite-abbrev (xx1)") (sit-for 2) t) (forward-word -1) (delete-region m3-cur-keyword-completion-start (+ m3-cur-keyword-completion-start m3-cur-keyword-completion-len)) ;;; (progn (message "In m3-polite-abbrev (xx2)") (sit-for 2) t) (insert (car m3-cur-keyword-completions)) (setq m3-cur-keyword-completion-len (- (point) m3-cur-keyword-completion-start)) (if (> (length m3-cur-keyword-completions) 1) (message "Other matches: %s" (mapconcat '(lambda (x) x) (cdr m3-cur-keyword-completions) ", "))))) ;; Otherwise, form the list of ( . ) pairs such ;; that pw is a prefix of , is the score ;; associated with in m3-keyword-completions, and the ;; conditions in m3-keyword-completions are met. (t ;;; (message "In m3-polite-abbrev (t)") (sit-for 2) (let ((keyword-list m3-keyword-completions) matches (on-lm (and (= (save-excursion (forward-word -1) (current-column)) 0) (let ((continue t) (res nil)) (save-excursion ;;; (message "Checking on-lm, about to enter loop") (sit-for 2) (while continue (setq continue nil) ;;; (message "Checking on-lm, before search") (sit-for 2) (m3-re-search-backward (concat m3-part-starters "\\|" m3-end-matchers "\\|" "\\bEND\\b") (point-min) 'move-to-limit) ;;; (message "Checking on-lm, after search") (sit-for 2) (cond ((looking-at "END") (m3-backward-to-end-match (point-min)) (if (and (looking-at "BEGIN") (not (looking-at "^BEGIN"))) (progn ;;; (message "Checking doing BEGIN adjustment") ;;; (sit-for 2) (m3-re-search-backward "\\(^PROCEDURE\\|^[ \t]+BEGIN\\)" (point-min) 'move-to-limit) (goto-char (match-end 0)))) (setq continue t)) ((looking-at (concat "^\\(" m3-part-starters "\\)")) (setq res t)) ((looking-at "IMPORT") (save-excursion (forward-word -2) ;;; (message "Doing FROM ... IMPORT special") (sit-for 2) (if (looking-at "^FROM") (setq res t)))) ((= (point) (point-min)) (setq res t))))) ;;; (message "After loop, res is %s" res) (sit-for 2) (and res (save-excursion (forward-word -1) (m3-backward-to-code (point-min)) (or (= (point) (point-min)) ;;; (progn (message "xxx") (sit-for 2) nil) (looking-at ";"))))))) (starts-ssl (let ((first-char (save-excursion (forward-word -1) (point)))) (save-excursion (forward-word -1) (m3-re-search-backward (concat "\\(;\\|END\\|" m3-keyword-endable-ssl-introducers "\\)") (point-min) 'move-to-limit) (re-search-forward (concat "\\(;\\|END\\|" m3-keyword-endable-ssl-introducers "\\)") first-char t) (goto-char (match-end 0)) ;;; (message "In m3-polite-abbrev (zz1)") (sit-for 2) (m3-forward-to-code (point-max)) (= (point) first-char))))) ;;; (message "In m3-polite-abbrev, on-lm = %s, starts-ssl = %s" ;;; on-lm starts-ssl) ;;; (sit-for 2) (while keyword-list (let* ((entry (car keyword-list)) (kw (car entry))) ;;; (message "In m3-polite-abbrev kw = %s" kw) (sit-for 2) ;;; (message "Foo") (sit-for 2) (if (m3-is-prefix kw pw) (let* ((rest (cdr entry)) (score (car rest)) (props (car (cdr rest))) (pred (car (cdr (cdr rest))))) ;;; (message "In m3-polite-abbrev, found kw = %s" kw) (sit-for 1) (let ((lm-status (cond ((and (memq 'lm-ok props) (memq 'lm-only props)) (error "Bad prop-list in m3-keyword-completions.")) ((memq 'lm-ok props) 'lm-ok) ((memq 'lm-only props) 'lm-only) (t 'lm-not))) (ls-status (cond ((and (memq 'ls-ok props) (memq 'ls-only props)) (error "Bad prop-list in m3-keyword-completions.")) ((memq 'ls-ok props) 'ls-ok) ((memq 'ls-only props) 'ls-only) (t 'ls-not)))) ;;; (message ;;; "In m3-polite-abbrev, (2) lm-status = %s ls-status = %s" ;;; lm-status ls-status) ;;; (sit-for 2) (and (or (eq lm-status 'lm-ok) (cond ((eq lm-status 'lm-only) on-lm) ((eq lm-status 'lm-not) (not on-lm)))) (or ;;; (progn (message "In m3-polite-abbrev, (3.2)") ;;; (sit-for 2) nil) (eq ls-status 'ls-ok) (cond ((eq ls-status 'ls-only) starts-ssl) ((eq ls-status 'ls-not) (not starts-ssl)))) (or ;;; (progn (message "In m3-polite-abbrev, (5), pred = %s" pred) ;;; (sit-for 2) nil) (not pred) ;;; (progn (message "In m3-polite-abbrev, (5)") ;;; (sit-for 2) nil) (funcall pred on-lm starts-ssl)) ;;; (message "In m3-polite abbrev, adding %s to matches" kw) ;;; (sit-for 2) (setq matches (cons (cons kw score) matches))))))) (setq keyword-list (cdr keyword-list))) ;;; (message "In m3-polite-abbrev (after matches): %s" matches) (sit-for 4) ;; If there are any matches, do a completion (and matches (progn ;; Now sort matches according to score. ;;; (message "In m3-polite-abbrev, (10)") (sit-for 2) (setq matches (sort matches '(lambda (e1 e2) (< (cdr e1) (cdr e2))))) ;; And strip off the scores from the result. ;;; (message "In m3-polite-abbrev, (11)") (sit-for 2) (setq matches (mapcar'(lambda (e) (car e)) matches)) ;;; (message "In m3-polite-abbrev, (12)") (sit-for 2) (setq m3-cur-keyword-completions matches) (let ((first-match (car matches))) (forward-word -1) (delete-region (point) (save-excursion (forward-word 1) (point))) ;;; (message "In m3-polite-abbrev, (13)") (sit-for 2) (set-marker m3-cur-keyword-completion-start (point)) (insert first-match) (setq m3-cur-keyword-completion-len (- (point) m3-cur-keyword-completion-start)) (if (> (length matches) 1) (message "Other matches: %s" (mapconcat '(lambda (x) x) (cdr matches) ", "))))) )))))) ;;; The identifiers are the names of ;;; 1) imported interfaces ;;; 2) variables, types, constants, exceptions and procedures defined at ;;; module scope. ;;; 3) If we are in a procedure body: ;;; variables, constants, and procedures defined in enclosing scopes. (defun m3-find-id-list () (interactive) "Returns a list of the identifiers visible at point." (append (setq m3-mod-names (m3-module-names)) (m3-scope-names) )) (defun m3-module-names () (interactive) (let ((names nil)) (save-excursion (goto-char (point-min)) (while (m3-re-search-forward (concat "^\\(" m3-part-starters "\\)") (point-max) t) ;;; (message "m3-module-names (0.1)") (sit-for 2) (let ((limit (save-excursion (forward-word 1) ;;; (message "m3-module-names (0.2)") (sit-for 2) (if (m3-re-search-forward (concat "^\\(" m3-part-starters "\\)") (point-max) t) (point) (point-max))))) ;;; (message "m3-module-names (1)") (sit-for 2) (cond ((looking-at "INTERFACE\\|MODULE") (forward-word 1)) ((looking-at "IMPORT") ;;; (message "m3-mod-names, IMPORT(1)") (sit-for 2) (forward-word 1) (setq names (append (m3-parse-name-list "," nil ";" limit) names))) ((looking-at "FROM") ;;; (message "m3-mod-names, FROM(1)") (sit-for 2) (forward-word 3) (forward-word -1) ;;; (message "m3-mod-names, FROM(2)") (sit-for 2) (if (looking-at "IMPORT") (progn (forward-word 1) (setq names (append (m3-parse-name-list "," nil ";" limit) names))))) ((looking-at "TYPE\\|REVEAL") (forward-word 1) (setq names (append (m3-parse-name-list ";" "\\(=\\|<:\\)" nil limit) names))) ((looking-at "EXCEPTION") (forward-word 1) (setq names (append (m3-parse-name-list ";" nil nil limit) names))) ((looking-at "VAR") (forward-word 1) (let ((continue t)) (while (and (< (point) (point-max)) continue) ;;; (message "m3-mod-names, VAR(1), limit = %d" limit) (sit-for 2) (setq names (append (m3-parse-name-list "," nil ":" limit) names)) ;;; (message "m3-mod-names, VAR(2)") (sit-for 2) (setq continue (and (m3-re-search-forward ";" limit t) ;;; (progn (message "m3-mod-names, VAR(3)") ;;; (sit-for 2) t) (progn (forward-char 1) ;;; (message "m3-mod-names, VAR(4)") (sit-for 2) (m3-forward-to-code limit) ;;; (message "m3-mod-names, VAR(5), point = %d" ;;; (point)) ;;; (sit-for 2) (< (point) limit))))))) ((looking-at "PROCEDURE") (forward-word 1) (m3-forward-to-code limit) (setq names (cons (buffer-substring (point) (save-excursion (forward-word 1) (point))) names))) ((looking-at "CONST") (forward-word 1) (setq names (append (m3-parse-name-list ";" "=" nil limit) names))))))) ;;; (message "names are %s" names) names)) (defun m3-scope-names () "If we are not in a procedure scope, return nil. If we are, return a list of all identifiers defined in the current scope." ;; Identifiers can be introduced by VAR, CONST, WITH, or nested PROCEDURE ;; declarations. (interactive) ;;; (message "m3-scope-names") (sit-for 2) (let ((case-fold-search nil) (orig-point (point))) (save-excursion (cond ((save-excursion (m3-re-search-backward (concat "^\\(" m3-part-starters "\\)") (point-min) t) ;;; (message "m3-scope-names (1)") (sit-for 2) (and (looking-at "^PROCEDURE") (progn (forward-word 1) (m3-re-search-forward "VAR\\|CONST\\|PROCEDURE\\|BEGIN" (point-max) 'move-to-limit) (while (m3-in-arg-list (point-min)) (forward-word 1) (m3-re-search-forward "VAR\\|CONST\\|PROCEDURE\\|BEGIN" (point-max) 'move-to-limit)) (and (looking-at "VAR\\|CONST\\|PROCEDURE\\|BEGIN") (> orig-point (point)))))) ;;; (message "m3-scope-names (2)") (sit-for 2) (let ((continue t) (names nil) (orig-point (point))) ;; Set things up to make sure we start with a complete list. (m3-re-search-backward (concat "\\(VAR\\|CONST\\|WITH\\|PROCEDURE\\|END\\|;\\)") (point-min) t) ;;; (message "m3-scope-names (2.2)") (sit-for 2) (while continue (m3-re-search-backward (concat "\\(VAR\\|CONST\\|WITH\\|PROCEDURE\\|END\\)") (point-min) t) ;;; (message "m3-scope-names (3)") (sit-for 2) (cond ((looking-at "^PROCEDURE") (setq continue nil)) ((looking-at "END") (m3-backward-to-end-match (point-min)) ;; If we're now looking at a BEGIN, skip over any ;; VAR, CONST, or PROCEDURE associated with the BEGIN. (cond ((looking-at "BEGIN") (m3-re-search-backward (concat "\\(BEGIN\\|WITH\\|END\\)") (point-min) t) (forward-word 1)))) ((looking-at "VAR") ;;; (message "m3-scope-names (VAR)") (sit-for 2) (let ((save-point (point)) (limit (save-excursion (forward-word 1) (m3-re-search-forward (concat "\\(" m3-part-starters "\\|BEGIN\\)") orig-point 'move-to-limit) ;;; (message "m3-scope-names, VAR(0.5)") (sit-for 2) (point)))) (forward-word 1) (let ((continue t)) (while (and (< (point) (point-max)) continue) ;;; (message "m3-scope-names, VAR(1)") (sit-for 2) (let ((new-names (m3-parse-name-list "," nil ":" limit))) ;;; (message "m3-scope-names, VAR(2), new-names = %s" ;;; new-names) ;;; (sit-for 2) (setq names (append names new-names))) ;;; (message "m3-scope-names, VAR(3)") (sit-for 2) (setq continue (and (m3-re-search-forward ";" limit t) ;;; (progn (message "m3-mod-names, VAR(4)") ;;; (sit-for 2) t) (progn (forward-char 1) ;;; (message "m3-mod-names, VAR(5)") ;;; (sit-for 2) (m3-forward-to-code limit) ;;; (message "m3-mod-names, VAR(6), point = %d" ;;; (point)) ;;; (sit-for 2) (< (point) limit)))))) (goto-char save-point))) ((looking-at "CONST") (let ((save-point (point))) (forward-word 1) (setq names (append (m3-parse-name-list ";" "=" nil orig-point) names)) (goto-char save-point))) ((looking-at "WITH") (let ((save-point (point))) (forward-word 1) (let ((new-names (m3-parse-name-list "," "=" "DO" orig-point))) ;;; (message "WITH: %s" new-names) (sit-for 2) (setq names (append names new-names))) (goto-char save-point))) ((looking-at "PROCEDURE") (let ((save-point (point))) (forward-word 1) (m3-forward-to-code orig-point) (setq names (cons (buffer-substring (point) (save-excursion (forward-word 1) (point))) names)) (goto-char save-point))))) ;;; (message "scope-names returns %s" names) (sit-for 10) names)) (t nil))))) (defun m3-parse-name-list (between skip end lim) "Assumes point is at the start of a BETWEEN-separated list. Assumes that SKIP, if non-nil is an regexp giving a pattern that ends each element, and starts a string that should be ignored up to the next BETWEEN or END. END, if non-nil gives the regexp that terminates the list. Alternatively, LIMIT, if non-nil is a character position that bounds the parse. Returns the list of names, leaves point positioned after list." ;;; (message "m3-parse-name-list (1)") (sit-for 2) (let ((names nil) (continue t) (limit (if lim lim (point-max)))) ;;; (message "m3-parse-name-list, re = %s" re) (sit-for 2) (while (and (< (point) limit) continue) ;;; (message "m3-parse-name-list (2)") (sit-for 2) (m3-forward-to-code limit) ;;; (message "m3-parse-name-list (3)") (sit-for 2) (cond ((< (point) limit) ;;; (message "m3-parse-name-list (3.5)") (sit-for 2) (let ((start (point))) (setq names (cons (buffer-substring (point) (progn (forward-word 1) (point))) names)) (cond ((m3-re-search-forward (concat "\\(" between "[ \t\n]*" m3-identifier-re (if skip (concat "[ \t\n]*" skip)) "\\)" (if end (concat "\\|" end))) limit t) ;;; (message "m3-parse-name-list (4)") (sit-for 2) (cond ((looking-at between) ;;; (message "m3-parse-name-list (6.1)") (sit-for 2) (re-search-forward between limit t) (goto-char (match-end 0))) ((and end (looking-at end)) ;;; (message "m3-parse-name-list (6.2)") (sit-for 2) (setq continue nil)))) (t (setq continue nil))))))) ;;; (message "Parse-name-list returns: %s" names) (sit-for 2) names)) (defvar m3-cur-ident-completion-start (make-marker) "A marker indicating the start of the last word that was identifier-completed.") (defvar m3-cur-ident-completion-len nil "The length of the completed identifier at the time of completion, to allow us to determine if the user has entered more text.") (defvar m3-cur-ident-completions nil "A list of the strings that matched the originally input identifier text.") (defvar m3-cur-ident-completion-done nil "A list of the strings that matched the originally input identifier text.") (defvar m3-ident-match-no-case-fold t "If non-nil, case matters in identifier matches. If nil, case is ignored.") ;;;(setq m3-ident-match-no-case-fold nil) (defun m3-ident-complete () "Moves to the end of the current word; then checks if that word is a prefix of any of the identifiers in the current file. If it is a prefix of a unique member of the list, completes the word to that prefix. If it is a prefix of multiple elements of the list, completes to the longest prefix shared by all those elements, and presents the further completions to the user in the minibuffer. If this command is next executed from at the end of the partially completed word, and no changes have been made to the word, it will fill in the first element of the set of full completions, and subsequent executions will cycle through the list." (interactive) ;;; (message "In m3-ident-complete") (sit-for 2) (m3-ident-complete-work (m3-find-id-list))) (defun m3-ident-complete-work (names) "Moves to the end of the current word; then checks if that word is a prefix of any of the strings in NAMES. If it is a prefix of a unique member of the list, completes the word to that prefix. If it is a prefix of multiple elements of the list, completes to the longest prefix shared by all those elements, and presents the further completions to the user in the minibuffer. If this command is next executed from at the end of the partially completed word, and no changes have been made to the word, it will fill in the first element of the set of full completions, and subsequent executions will cycle through the list." ;;; (message "In m3-ident-complete-work (1), names = %s" names) (sit-for 2) (let ((save-point (point))) (cond ((and ;;; (progn (message "In m3-ident-complete (x1)") (sit-for 2) t) (marker-position m3-cur-ident-completion-start) ;;; (progn (message "In m3-ident-complete (x2)") (sit-for 2) t) (> (point) m3-cur-ident-completion-len) ;;; (progn (message "In m3-ident-complete (x2.5)") (sit-for 2) t) (= m3-cur-ident-completion-start (save-excursion (forward-char (- m3-cur-ident-completion-len)) ;;; (progn (message "In m3-ident-complete (x2.75)") (sit-for 2) t) (point))) ;;; (progn (message "In m3-ident-complete (x3)") (sit-for 2) t) m3-cur-ident-completions) (let ((cur-completion (car m3-cur-ident-completions))) (if m3-cur-ident-completion-done (setq m3-cur-ident-completions (append (cdr m3-cur-ident-completions) (list cur-completion)))) ;;; (progn (message "In m3-ident-complete (xx1)") (sit-for 2) t) (forward-word -1) (delete-region m3-cur-ident-completion-start (+ m3-cur-ident-completion-start m3-cur-ident-completion-len)) ;;; (progn (message "In m3-ident-complete (xx2)") (sit-for 2) t) (insert (car m3-cur-ident-completions)) (setq m3-cur-ident-completion-len (- (point) m3-cur-ident-completion-start)) (setq m3-cur-ident-completion-done t) (if (> (length m3-cur-ident-completions) 1) (message "Other matches: %s" (mapconcat '(lambda (x) x) (cdr m3-cur-ident-completions) ", "))))) ;; Otherwise, find the current word, and see if it is a prefix of any ;; members of names. (t ;;; (progn (message "In m3-ident-complete-work (1)") (sit-for 2) t) (cond ((and (not (looking-at m3-identifier-char-re)) (or (= (point) (point-min)) (save-excursion (forward-char -1) (not (looking-at m3-identifier-char-re))))) ;;; (progn (message "In m3-ident-complete-work (2.1)") (sit-for 2) t) (beep) (message "Not in identifier!") (goto-char save-point)) (t ;;; (progn (message "In m3-ident-complete-work (2)") (sit-for 2) t) (let ((cur-word (cond ((looking-at (concat "\\b" m3-identifier-char-re)) (buffer-substring (point) (save-excursion (forward-word 1) (point)))) (t (forward-word -1) (buffer-substring (point) (save-excursion (forward-word 1) (point)))))) (matches nil)) ;; Get the matches (mapcar '(lambda (elem) (if (m3-is-prefix elem cur-word m3-ident-match-no-case-fold) (setq matches (cons elem matches)))) names) ;;; (message "In m3-ident-complete-work (3), matches = %s" matches) ;;; (sit-for 2) (cond ((eq (length matches) 0) (goto-char save-point) (message "No matches of current word '%s'." cur-word)) ((eq (length matches) 1) (delete-region (point) (save-excursion (forward-word 1) (point))) (insert (car matches))) (t ;; Multiple matches. Sort them alphabetically. (setq matches (sort matches 'string<)) ;; Find the longest common prefix. (let ((lcp (m3-longest-common-prefix matches))) ;;; (message "In m3-ident-complete-work (4), lcp = %s" lcp) ;;; (sit-for 2) (setq m3-cur-ident-completions matches) (setq m3-cur-ident-completion-len (length lcp)) ;; This completion is only partial. (setq m3-cur-ident-completion-done nil) (delete-region (point) (save-excursion (forward-word 1) (point))) (set-marker m3-cur-ident-completion-start (point)) (insert lcp) (if (> (length m3-cur-ident-completions) 1) (message "Completions: %s" (mapconcat '(lambda (x) x) m3-cur-ident-completions ", "))))))))))))) (defun m3-longest-common-prefix (names) "Returns the longest string that is a common substring of all the strings in NAMES" (m3-longest-common-prefix-work (car names) (cdr names))) (defun m3-longest-common-prefix-work (lcp names) "Returns the longest string that is a common substring of lcp and the strings in the list NAMES" (cond ((null names) lcp) (t (let ((len (length lcp)) (continue nil) (first-name (car names))) ;;; (message "m3-lcp, lcp: %s, fn: %s" lcp first-name) (sit-for 2) (while (and (> len 0) (not (m3-is-prefix first-name (substring lcp 0 len)))) ;;; (message "m3-lcp, len = %d, lcp = %s" len (substring lcp 0 len)) ;;; (sit-for 2) (setq len (- len 1))) ;;; (message "m3-lcp (2)") (sit-for 2) (cond ((= len 0) "") (t (m3-longest-common-prefix-work (substring lcp 0 len) (cdr names)))))))) ;;;====================================================================== (defun m3-is-letter (ch) "checks if argument is a letter." (and (>= (upcase ch) ?A) (<= (upcase ch) ?Z))) (defun m3-abbrev-or-tab () "if preceding char in buffer is letter, tries to expand abbrev else tabs." (interactive) (if (and m3-abbrev-enabled (m3-is-letter (preceding-char))) (m3-abbrev) (m3-tab))) (defun m3-abbrev-and-or-indent () "If preceding char in buffer is letter, tries to expand abbrev. Otherwise, indents the current line." (interactive) ;;; (message "Foo1") (sit-for 2) (if (and m3-abbrev-enabled (or (m3-is-letter (preceding-char)) (save-excursion (and (> (point) 2) (progn (forward-char -2) (and (looking-at "*)") (progn (forward-word -1) (forward-char -3) (looking-at "(*")) (progn (forward-word -1) (looking-at "END")))))) (save-excursion (and (> (point) 2) (progn (forward-char -1) (and (looking-at ";\\|.") (progn (forward-word -2) (looking-at "END"))))))) (or (eq (point) (point-max)) (eq (following-char) ?\ ) (eq (following-char) ?\t) (eq (following-char) ?\n))) (progn (m3-abbrev) (m3-indent-line)) (m3-indent-line))) ; Finally a function for those used to M2 style text literals. It checks for ; text literals containing single quotes and ensures that they are preceded by ; a backslash. ; BUG: If a text literal contains an embedded double quote it is ignored (defun m3-text-literal-check () "Ensures that single quotes in text literals are preceded by backslash" (interactive) (save-excursion (goto-char (point-min)) (while (re-search-forward "[^\\\\]\"\\([^\"]*\\)[^\\\\]" nil t) (save-excursion (save-restriction (narrow-to-region (match-beginning 1) (match-end 1)) (goto-char (point-min)) (replace-regexp "\\([^\\\\]\\)'" "\\1\\\\'")))))) ;;;-------------------------------------------------------- pretty printing --- (defvar m3pp-options '("-ZZ") "Command line options that should be passed to m3pp when it is started up.") (defvar &m3pp-modunit "\002") (defvar &m3pp-defunit "\005") (defvar &m3pp-endunit "\001") (defvar &m3pp-process nil) (defvar &m3pp-in-progress nil) (defvar &m3pp-unit-boundary (concat "^[ \t]*\nCONST\\|" "^[ \t]*\nTYPE\\|" "^[ \t]*\nVAR\\|" "^[ \t]*\nPROCEDURE\\|" "^[ \t]*\nEXCEPTION\\|" "^[ \t]*\n<\*EXTERNAL\*>|" "^[ \t]*\n<\*INLINE\*>|" "^[ \t]*\nMODULE\\|" "^[ \t]*\nINTERFACE\\|" "^[ \t]*\nIMPORT\\|" "^[ \t]*\nBEGIN")) (defun &m3pp-startup () (if (not (and &m3pp-process (process-status (process-name &m3pp-process)))) (save-excursion (get-buffer-create "&m3pp") (set-buffer "&m3pp") (erase-buffer) (setq &m3pp-process (apply 'start-process "m3pp" nil "m3pp" m3pp-options)) (process-kill-without-query &m3pp-process) (set-process-filter &m3pp-process '&m3pp-filter) (process-send-string &m3pp-process (concat &m3pp-modunit &m3pp-endunit "\n")) (accept-process-output &m3pp-process)))) (defun m3pp-unit () "Pretty prints the 'unit' containing the cursor. A unit starts with a blank line followed by CONST, TYPE, VAR, PROCEDURE, EXCEPTION, IMPORT, FROM, MODULE, or BEGIN, and it extends to the start of the next unit. If there is no such unit around the cursor, the entire file is pretty printed." (interactive) (save-excursion (let (start) (&m3pp-find-format-unit) (setq start (point-marker)) (m3pp-region) (set-mark (point)) (goto-char start) (exchange-point-and-mark)))) (defun m3pp-region () "Pretty prints the region. The region should consist of zero or more declarations, definitions, import statements, or modules." (interactive) (let* ((size (- (point-marker) (mark-marker))) (a (if (< size 0) (- size) size))) (if (> a 32760) (error (concat "Sorry, region too large for emac " (int-to-string a) " > 32760")))) (safe-m3pp-region)) (defun safe-m3pp-region () (let ((m3pp-type nil) (m3pp-start nil)) (&m3pp-startup) (save-excursion (goto-char (point-min)) (if (search-forward &m3pp-endunit (point-max) t) (error "m3pp: file mustn't contain ^A")) (get-buffer-create "&m3pp-output") (set-buffer "&m3pp-output") (erase-buffer)) (let* ((len (length (buffer-file-name))) (tail (substring (buffer-file-name) (- len 3) len))) (if (string-equal tail ".m3") (setq m3pp-type &m3pp-modunit)) (if (string-equal tail ".i3") (setq m3pp-type &m3pp-defunit)) (if (and (not (string-equal tail ".m3")) (not (string-equal tail ".i3"))) (error "m3pp: pretty-print only .m3 or .i3 files"))) (message "m3pp: working ...") (setq &m3pp-in-progress t) (process-send-string &m3pp-process (concat m3pp-type (buffer-substring (min (point) (mark)) (max (point) (mark))) &m3pp-endunit "\n")) (while &m3pp-in-progress (accept-process-output &m3pp-process)) (setq m3pp-start (point-marker)) (kill-region (point) (mark)) (insert-buffer "&m3pp-output") (save-excursion (set-buffer "&m3pp-output") (if (re-search-backward "(\\* SYNTAX ERROR " (point-min) t) (progn (beep) (message "m3pp: syntax error")) (progn ;else (message "m3pp: done")))) (if (not (pos-visible-in-window-p)) (let ((dotval (+ (point-marker)))) (line-to-bottom-of-window) (goto-char dotval))))) (defun &m3pp-filter (&process &str) (save-excursion (get-buffer-create "&m3pp-output") (set-buffer "&m3pp-output") (goto-char (point-max)) (insert &str) (if (search-backward &m3pp-endunit (point-min) t) (progn (delete-char 2) (setq &m3pp-in-progress nil))))) (defun &m3pp-find-format-unit () (if (not (re-search-backward &m3pp-unit-boundary (point-min) t)) (goto-char (point-min))) (set-mark (point)) (if (bobp) (progn (goto-char (point-max)) (if (bolp) (backward-char))) (progn ;else (forward-line) (beginning-of-line) (set-mark (point)) (if (not (re-search-forward &m3pp-unit-boundary (point-max) t)) (progn (goto-char (point-max)) (if (bolp) (backward-char))) (progn ;else (beginning-of-line))))) (exchange-point-and-mark) nil) ;;;------------------------------------------------------- epoch --- (if (boundp 'epoch::version) (progn (require 'mouse) (require 'scr-pool))) (defvar *m3::defpath* '("." "/proj/cra/ultrix/${CPU_TYPE}/pub/m3") "Search path for Modula-3 interfaces") (if (boundp 'epoch::version) (progn (defvar *m3::poolsize* 8 "Size of the pool of screens for Modula-3 interfaces") (defvar *m3::poolclass* "Modula-3" "Class for the Modula-3 interface screens"))) ;;; stolen from lib-complete, ;;; Author : Mike Williams ;;; Created On : Sat Apr 20 17:47:21 1991 ;;; Last Modified By: Mike Williams ;;; Last Modified On: Tue Jun 18 12:53:08 1991 (defun m3::locate-file (FILE SEARCH-PATH &optional SUFFIX-LIST PRED) "Search for FILE on SEARCH-PATH (list). If optional SUFFIX-LIST is provided, allow file to be followed by one of the suffixes. Optional second argument PRED restricts the number of files which may match. The default is file-exists-p." (if (not SUFFIX-LIST) (setq SUFFIX-LIST '(""))) (if (not PRED) (setq PRED 'file-exists-p)) (if (file-name-absolute-p FILE) (setq SEARCH-PATH '(nil))) (if (equal FILE "") (error "Empty filename")) (let ((filelist (mapcar (function (lambda (ext) (concat FILE ext))) SUFFIX-LIST))) ;; Search SEARCH-PATH for a readable file in filelist (catch 'found (while SEARCH-PATH (let ((filelist filelist)) (while filelist (let ((filepath (substitute-in-file-name (expand-file-name (car filelist) (car SEARCH-PATH) )))) (if (funcall PRED filepath) (throw 'found filepath))) (setq filelist (cdr filelist)))) (setq SEARCH-PATH (cdr SEARCH-PATH)))) )) (defun m3::show-interface (&optional arg) "Find a Modula-3 interface. If ARG is a string, it is the name of the interface. If ARG is nil, get the name from the text around the point. Otherwise, ARG should be an epoch mouse position and the name is found around that position. Using *m3::defpath*, find the file that contains that interface. Under gnuemacs, show the interface in another window. Under epoch, show the interface in a screen of the Modula-3 pool; the screens in that pool are in the class *m3::poolclass*. The Modula-3 pool is of size *m3::poolsize*." (interactive) (let (buffer pos interface filename) (if (stringp arg) (setq interface arg) (save-excursion (if arg (progn (setq buffer (nth 1 arg)) (setq pos (car arg))) (progn (setq buffer (current-buffer)) (setq pos (point)))) (set-buffer buffer) (goto-char pos) (let (end) (re-search-forward "[^A-Za-z0-9]" nil t) (backward-char) (setq end (point)) (re-search-backward "[^A-Za-z0-9]" nil t) (forward-char) (setq interface (buffer-substring (point) end))))) (setq filename (locate-file (concat interface ".i3") *m3::defpath*)) (if (boundp 'epoch::version) (progn (setq buf (find-file-noselect filename)) (let ((screen (pool:get-shrink-wrapped-screen m3-interfaces-pool buf '(80 80 20 40)))) (epoch::select-screen screen) (epoch::mapraised-screen screen)) (switch-to-buffer buf)) (progn (find-file-other-window filename))))) (if (boundp 'epoch::version) (progn (setq m3-interfaces-pool (pool:create *m3::poolsize* '(lambda () (create-screen nil (cons (cons 'class *m3::poolclass*) nil))))) (global-set-mouse mouse-left mouse-meta 'm3::show-interface))) ======================================================================= 88 === Date: Thu, 25 Jun 92 10:40:14 EDT From: wyant@centerline.com Subject: Contracts & M3 ? At OOPSLA '90, Richard Helm of IBM TJ Watson Research Center presented an interesting paper called: "Contracts: Specifying Behavioral Compositions in Object-Oriented Systems". The idea is that a specification needs to capture not only the invariants of a single abstraction, but that it needs to capture those invariants maintained by a set of cooperating abstractions. Ib his terminology, a "contract" identifies the participants in a behavioral composition and their contractual obligations. Obligations come in two kinds: type and causal. Causal obligations capture behavioral dependencies between objects. Has any work been done on mapping Helm's contract into M3 and perhaps specifying some of the core libraries this way ? It would be interesting to see a specification of Trestle or M3TK done in this way. With libraries of this size, its often very hard to see the behavioral dependencies between different components of the library, and something akin to "contracts" may help in illuminating their behavior. Geoff Wyant wyant@centerline.com Centerline Software, Inc. 10 Fawcett Street Cambridge, Ma. 01238 ======================================================================= 89 === Date: 25 Jun 92 14:38:51 GMT From: brh@aquila.arh.cdc.com (brian r hanson x6009) Subject: Availability of M3 compilers. What is the availability of Modula 3 compilers commercial or otherwise and for what platforms? --- Brian Hanson, Control Data Corporation Email: brh@ahse.cdc.com ======================================================================= 90 === Date: Thu, 25 Jun 1992 19:44:31 GMT From: cflatter@nrao.edu (Chris Flatters,208,7209,homephone) Subject: Re: Method call overhead in Oberon-2 In article 4975@neptune.inf.ethz.ch, templ@inf.ethz.ch (Josef Templ) writes: > >The numbers for Eiffel are correct given that assertion checks are >turned on (a compiler switch). I did some benchmarks in Eiffel 2.1 >and was quite surprised when I discovered that Eiffel is a hundred times >as slow as Oberon or C (C++ is almost as fast as C). After turning off >assertion checking Eiffel ran about three times as slow as Oberon or C. >I didn't look at the generated C code, but I guess that they are using >signals to implement the asertion mechanism (even in the absence of >assertions!). I believe that they use setjmp/longjmp to unwind the stack during exception processing. If you profile an Eiffel program with exceptions you will find that an awful lot of time is consumed by setjmp related functions. Chris Flatters cflatter@nrao.edu ======================================================================= 91 === Date: Fri, 26 Jun 92 16:57:02 GMT From: najork@src.dec.com (Marc Najork) Subject: Re: Availability of M3 compilers. Modula-3 is available from gatekeeper.dec.com in /archive/pub/DEC/Modula-3. The compiler compiles into C, and there is a Modula-3 and a C-version of it (so you can bootstrap it). -- Marc Najork ======================================================================= 92 === Date: Fri, 26 Jun 92 21:50:42 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: VAX/VMS In article <1992Jun22.054151.27605@nntpd2.cxo.dec.com>, braeu@untadi.enet.dec.c om (Walter Braeu) writes: > > Does anybody know about a VAX/VMS implementation of Modula-3? I don't think that such a thing exists. I have been as far as compiling, linking and running the M3 compiler. I started from the VAX Ultrix C intermediate code and did a few modifications. I compiled it with gcc 1.40 running on VMS. Bringing the full system is another story: the driver will probably need a fair amount of changes, the thread mechanism probably won't work, m3make relies on cpp, awk and sed, the release mechanism is probably not adquate, and so on. Also, we will have to face the issue of filenames (length, all upercase) 8-( -- Eric. ======================================================================= 93 === Date: 26 Jun 92 20:24:07 GMT From: brh@aquila.arh.cdc.com (brian r hanson x6009) Subject: Errors building M3-2.07 on SPARC I built M3-2.06 without a problem on the SPARC using the boot materials but bui lding the M3-2.07 version gets a load error when linking the compiler. ld: Undefined symbol _strerror *** Error code 2 make: Fatal error: Command failed for target `m3compiler' --- Brian Hanson, Control Data Corporation Email: brh@ahse.cdc.com ======================================================================= 94 === Date: Fri, 26 Jun 92 23:06:39 GMT From: steveg@src.dec.com (Steve Glassman) Subject: Re: Viewing Color X pixmaps using pixmapVBT There are two phases to producing a color pixmap. 1) Look in ScrnPixmap.T (part of the ui package) for the format of a Pixmap.Raw (Reveal to be a subtype of Raw_Public). Call ScrnPixmap.NewRaw and then use the put methods to set the pixels. (Or if you are brave, set the bits directly in the pixels array). Use Pixmap.FromRaw to get a Pixmap.T. 2) Getting the colors right requires ScrnColorMap interface. Depending on how many colors you need (and how particular you are) you can use the standard colormap or allocate your own. Then you can use the fromRGB, new and write to get/set pixel values for the colors you want. Use these pixel values in 1) for the pixmap. Simple? (Well, a procedure that did this from an X pixmap would help a bit.) If you succeed, send it back. Steve ======================================================================= 95 === Date: Fri, 26 Jun 92 15:59:00 -0700 From: Subject: Re: Viewing Color X pixmaps using pixmapVBT First the good news: Use "Rsrc.GetPixmap(filename)". Now for the bad news: You need to extend rsrc/src/PixmapFromAscii.m3 to work for pixmaps with depth > 1. This isn't very high on our todo list, but it should be quite simple. ======================================================================= 96 === Date: Fri, 26 Jun 92 22:35:56 GMT From: jdd@src.dec.com (John DeTreville) Subject: Modula-3 Users' Group meeting report: part 4 of 4 (breakout sessions) Here are the reports from the breakout sessions, as written by participants in the sessions: Proposed Language Changes Norman Ramsey PC Ports / Back Ends Michael Elliott Extensions to Trestle Steve Glassman RPC Systems Andy Hisgen -------------------- Proposed Language Changes Norman Ramsey About 15 or 20 people attended the session. We broke the session into two parts: brainstorming to make a list of proposed changes, and discussion of the proposals. We reserved some time at the end to address the higher-level questions of how much change we want and how changes should be made. Because there wasn't time to discuss all the proposals, we voted on the list and discussed only the proposals that received the most votes. Please remember that votes measure interest in discussing the proposal, not support for the proposal itself. The proposals were: Generics should be changed. (10 votes) The language should require that checked runtime errors raise exceptions, especially the ``out of memory'' error. (8 votes) ABSTRACT OBJECT should indicate a type that cannot be instantiated; only proper subtypes can be instantiated. (4 votes) It should be possible to override the meanings of the infix operators, e.g. by PROCEDURE "="( , ) = ... (4 votes) Modula-3 should (or should not) have multiple inheritance. (3 votes) Modula-3 should have an unsigned integer type WORD distinct from INTEGER. (3 votes) Permit formal parameters of type ANY and the type REF ANY. (3 votes) Support FORK P(args) as syntactic sugar for the declaration of the appropriate subtype of Thread.Closure, the allocation of the instance, and the call to Thread.Fork. (3 votes) ASSERT should be a statement, not a pragma, and not ignorable. (2 votes) Define INTEGER to be 32 bits, and add LONGINTEGER. (2 votes) Restrict the text between pragma brackets <* ... *> to be a sequence of valid Modula-3 tokens. (2 votes) Add a parameter mode PROCEDURE P(READONLYREF p: REF T) that prevents P from modifying p^. (1 vote) Make it possible to declare a VAR READONLY in an interface. Change the names of the parameter modes, or the semantics, or both, to support the Ada-style IN, OUT, and INOUT modes. (1 vote) Provide a syntax so that VAR and VALUE actuals can be distinguished at call sites. (1 vote) I apologize if I have misstated anyone's proposal; please send corrections to nr@princeton.edu. Because time was short, discussion was limited to ten minutes per proposal. Discussion began with generics. Few of those present were happy with generics as now defined, but nobody wanted to add all the nifty new generic features that have been proposed. Discussion centered around the proposal made by Jorge Stolfi to support ``inline'' instantiation of generics, hiding the existence of internal generics, e.g. GENERIC MODULE Set(Elem); IMPORT List(Elem); Jorge mentioned this idea in his presentation at the meeting, along with other, more speculative ideas. Greg Nelson's concern was that there was no way to specify what module was to be used as the implementation of List, whereas with the current system the programmer is forced to instantiate a separate interface, e.g. INTERFACE IntList = List(Integer); END IntList. MODULE IntList = List(Integer); END IntList. MODULE IntSet = Set(Integer, Intlist); END IntSet. Most of our time was spent discussing this example, and pointing out that it was unclear how to have two different implementations of lists under the proposed system. Norman Ramsey suggested that the problem of who implements List(Integer) isn't any different from the problem of who implements Integer---it is also impossible to have two different implementations of Integer. Jorge pointed out that the his proposal subsumes the current generics, so that it would still be possible to do things the old way. No consensus was reached about generics, except possibly that anything other than what we have now would probably be hard to understand. Discussion moved on to the question of whether the language definition should require that checked runtime errors raise exceptions. Discussion was spirited; I have tried to summarize the positions of those pro and con, not to describe the back-and-forth of the session. Sam Harbison said his experience with Ada convinced him that it was good to have checked run-time errors be exceptions. The error ``exception not in RAISES clause'' has to be treated specially. Eliot Moss pointed out that CLU handles every error as an exception, that overflow was explicit, and that it was important to have different exceptions for different conditions. Exceptions are divided into two classes, and the implementation does not guarantee correctness after an exception of the second class (``Failure'') has been raised. All procedures can raise Failure, and an exception is automatically converted to Failure if not in the RAISES clause. Examples include parity error and insufficient memory. Eliot also said that Modula-3 should require that checked run-time errors raise exceptions, because otherwise programs wouldn't be portable between implementations that chose to raise exceptions and those that chose not to. Raising exceptions make it easier to write long-running servers that can log what happened and try to recover. Someone pointed out that in the PC world it is important to be able to write shrink-wrap applications (e.g. a word-processor) that never just crash, but print some error message that makes sense to the user. Jim Saxe observed that the Larch Prover, when it encounters a checked run-time error, prints a message that includes Steve Garland's email address. (The Larch Prover is written in CLU.) He agreed that it's important for applications to be able to make an attempt to save the user's work when a fatal error occurs. He also suggested that raising an exception when array bounds are violated could help avoid the duplicate work of checking array bounds in extension languages. Doug Moen has developed editors for the PC and Mac, and these editors have had a ``low on memory'' pop-up window that gives users a chance to save their work and avoid bombs when memory is exhausted. Customers demand this feature. The implementation pre-allocates resources for that window at startup time; this technique could be applied generally. The faction against requiring checked run-time errors to be exceptions was less numerous. Norman Ramsey pointed out that other mechanisms can be used to handle some checked run-time errors; for example, users might register a procedure to be called when memory is exhausted. Greg Nelson pointed out the complications induced by concurrency; when a checked run-time error occurs, there is no guarantee that the currently executing thread has a handler for the appropriate exception. This situation can easily occur in practice because some of the modules in the library fork threads. The language committee was reluctant to require that ALL checked run-time errors raise exceptions, because that might place an undue burden on implementors. Greg said that ``serious fail-stop programmers'' who actually worry about long-running servers don't use exceptions to recover from failures. Instead of watching individual threads with exception handlers, they use operating-system mechanisms to watch the entire address space, starting a new address space on failure. Discussion moved from specific topics to the general questions of how much change we want and what mechanisms there are for making changes. There was broad consensus in favor of keeping the language stable, although we didn't explore in detail what ``stability'' meant. Greg Nelson's view was that another ``12 changes'' in the next 18 months would be too much change, but that there would be changes eventually---otherwise the language would be dead. Sam Harbison suggested that we think about making changes approximately every two years. Sam Harbison suggested that no changes at all are better than a few good changes, and that it is important to be able to point new users to a single document that describes the language, not make them apply deltas to the existing documents. Christian Jacobi said that small improvements are not worth the disruption. He also said that there is a difficult tightrope walk between promising enough stability and getting the necessary changes done. He thought that the language commitee handled the 12 changes quite elegantly in this respect. Dave Detlefs argued the opposite position, that Modula-3 has a small user community, so now is a good time to make changes. Modula-3 might need to change to compete with C++ templates. Eliot Moss pointed out that the designers might have an inaccurate picture of the potential impact changes, since they and most users are at SRC where the impact is high. Eliot also suggested that compilers with experimental features should offer a conforming mode. It was suggested that comp.lang.modula3 could be used as a forum for proposing changes, but there seemed to be agreement posting is too easy and that the process for proposing changes should be more arduous. Someone asked how well comp.lang.modula3 is working, and those present were not too dissatisfied, although there were broad complaints that there is too much quantity and the signal-to-noise ratio is low. No-one present volunteered to moderate a Modula-3 newsgroup. -------------------- PC Ports and Back Ends Michael Elliott I. Concerning the port of Modula-3 to the PC A. Modula-3 must be percieved as a viable language 1. C++ is percieved to be viable 2. Speed vs C++ is probably not an issue a) garbage collection may enable M3 to run a little faster b) lots of virtual functions will slow it down, though optimization techniques hold promise. c) How about Byte Magazine ad benchmarks? d) Sales techniques Has to appeal to the one or two daring guys in an organization of 100 or so, in order to get them to try it. B. What's the target user? To what sort of user should a PC port be addressed 1. The professional software developer Probably not any time soon 2. Education -- used for teaching programming Probably the best hope of getting a large user base -- followed by popularity in industry. C. The PC World Expects a lot in terms of an integrated environment -- editor, compiler, debugger, profiler, etc. Current PC debuggers are quite good and quite friendly. D. What OS? 1. MS-DOS Non re-entrant non-tasking operating system will be tough. It's definitely doable, but within what range of effort? 2. OS-2 Much easier port, but that doesn't provide the wide availability which is the overriding concern. E. Nothing less than a 386 The general consensus seemed to be that it was folly to consider architectures in the 8088 -- 80286 range, as the lack of protected mode programming and a flat 32-bit address space would not be worth addressing. A minimum of 2Mb of memory was deemed necessary. F. 386 is probably not a problem Although a lot of older machines are out there, few people today buy less than the architecture considered workable -- a 386 with at least 2Mb of memory. G. Bad implementation which at least works? Some interest was shown in having some implementation, even if quite slow, available soon -- just to establish "market presence" in the academic world. H. What's the soonest route to delivery of something? 1. Maybe Microsoft Windows I. Microsoft Windows as an operating system 1. Has a memory manager allowing a large 32-bit address space 2. Is thoroughly GUI -- possible to port Trestle to Windows 3. Has crude multi-tasking, although not pre-emptive. 4. Can threads actually exist with Windows? J. Buying much of a port Probably not cost-effective. Borland will sell something for around $500,000.00, but it wouldn't be nearly a turnkey product. K. How about having a grad student do the port? Consensus of opinion was against this as being too difficult a task for a grad student to be doing -- apparently grad students aren't what they were ten years ago. L. Toughest single problem: threads II. Concerning non PC backend issues Little time is currently spent on backend issues. A. Mips microcode B. GNU RTL 1. A proven design for multiple architectures 2. Allows re-use of backends already produced (or to be produced in the future) for the GNU project. C. bytecode 1. Pros: ease of implementation 2. Cons: difficulty of integrated environment and debugging. D. ANDF E. "Oberon" Really a placeholder for any quick and dirty code generator. F. Apple Macintosh If something exists for a long time on Macintoshes, there is a tendency for PC guys to ask for a similar product. It was noted that Apple had recently made a change internally from Object Pascal to C++. G. Pattern matcher Seen as a potential back end, to allow for ease in attaching an automatically generated code generator. H. Global Optimizer Seen as a potential back end, since the code generator can be automated to a greater extent. -------------------- Extensions to Trestle Steve Glassman Attendance 8 Mark Manasse, Steve Glassman, Marc H. Brown, Jim Meehan (DEC SRC) Frode Odegard (Odegard Labs) Dave Nichols, David Goldberg (Xerox PARC) Michel Dagenais - (Ecole Polytechnic Montreal) Executive summary: Non-SRC'ers expressed wishes for several high-level applications and/or VBT widgets. SRC'ers indicated wishes to do some low-level improvements to Trestle Neither group promised to do anything Minor announcement: The Trestle tutorial along with vbtkit and FormsVBT packages have been released to gatekeeper for anonymous FTP. Documentation for the Trestle tutorial is SRC report 69. Initial documentation for vbtkit is on gatekeeper. Details: Dave Nichols expressed wishes for Rich Text editor/viewer and an embedded editor. David Goldberg requested TCL-like funtionality which was permuted into the possibility for an RPC interface to FormsVBT. We got off on a discussion of Graphical FormsVBT editing. Mark Manassed presented a list of things he would like a chance to do to Trestle: Exposing X-graphics operations (and extensions like PEX and Display Postscript) to Trestle clients (would/could/should be non-portable) Shared memory putImage operations for pixmaps and video Double buffering and capture improvements (less copying of bytes) Well structured JoinVBTs (VBT's with multiple parents for multiple views of a single common VBT) extending over multiple screens/screen types Teleporting trestle windows to other screens or servers. Dealing with X ICCCM changes Fill out unimplemented Trestle functionality (out of domain tracking, etc.) Observing WindowsNT as a potential porting target Getting at window system state (Xdefaults) cleanly We got off into a discussion of application configuration/Look and Feel (TM) - whether Trestle applications should or should not look like windows. Even if the client might want them to (even if some people didn't think the client should want them to) We got off on a discussion of editable graphics, structured graphics and ZSplits (until, mercifully, time ran out...) -------------------- RPC Systems Andy Hisgen At the RPC session, we had discussions of the approach of using SUN RPC (as presented earlier in the day by Dave Nichols of Xerox PARC) and of SRC's new Network Objects project. Among the issues that came up were tuning time-outs for SUN RPC, callback RPC's (that is, RPC's which wish to pass a procedure and a RPC binding that the callee can callback), opaque remote references, and distributed garbage collection. We also discussed resource limits in the implementation of RPC (fixed-size buffer pools and the like) and how these can impact applications which stress the resources to their limits. -------------------- Cheers, John ======================================================================= 97 === Date: 26 Jun 92 21:34:19 GMT From: s9205@gte.com (Rohit Gupta) Subject: Viewing Color X pixmaps using pixmapVBT Hi, I am new to both Modula-3 and Trestle. I have a question regarding how I can u se the newly available PixmapVBT type to display a color X pixmap. PixmapVBT.Ne w needs a Pixmap.T as an argument and it is not clear to me how to get a Pixm ap.T from a color pixmap that I have created using "iconedit" on a SPARCstation . Any help will be greatly appreciated. Thanks in advance. Rohit ======================================================================= 98 === Date: Fri, 26 Jun 92 21:41:36 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: Modula 3 SIGPLAN BOF and MUG > What is Trestle? >From SRC technical report 68, "Trestle Reference Manual" by Mark Manasse and Greg Nelson: This is a reference manual for Trestle, a Modula-3 toolkit for the X window system. Trestle is a collection of interfaces structured around a central abstract type: a "virtual bitmap terminal" or VBT, which represents a share of the workstation's screen, keyboard, and mouse - a thing comparable to viewers, windows, or widgets of other systems. Trestle is included in SRC Modula-3 version 2.0, which is available via public ftp. Trestle includes a fairly standard set of interactors, including menus, buttons, "container" classes that provide overlapping or tiled subwindows, and "leaf" windows that display text or other data. This reference manual also specifies the interfaces that allow you to create your own window classes. Knowledge of X is not required. A Trestle window is an object whose behavior is determined by its methods. For example, a window's response to a mouse click is determined by calling its mouse method. This is fast becoming the standard architecture for toolkits, but Trestle carries it further than most. For example, you can change the way a Trestle window paints by overriding its paint method; this is useful for sophisticated effects like groupware. Trestle provides a novel strategy for writing applications that are independent of the type of disply they are running on. For example, it is easy to write a Trestle application that can be moved back and forth between a color display and a monochrome display where the application will look good on both. You can order a copy of the Trestle Reference Manual or other SRC technical reports by sending a message to "src-report@src.dec.com". The abstracts of the SRC technical reports are available via anonymous ftp in: gatekeeper.dec.com:pub/DEC/srcabstracts.list SRC Modula-3 can be found via anonymous ftp in: gatekeeper.dec.com:pub/DEC/Modula-3/release In addition, the next release of SRC Modula-3, which should appear on gatekeeper sometime before next Tuesday, will also contain the vbtkit, formvbt and vbtapps archives. I don't have "official" words for those. Roughly, vbtkit is collection of VBTs, formsvbt is a library to facilitate the development of user interfaces, and vbtapps contains a two-view interface editor. Unfortunately, the documentation for those is not quite ready, but should be available soon. -- Eric. ======================================================================= 99 === Date: Sat, 27 Jun 92 00:08:06 GMT From: msm@src.dec.com (Mark S. Manasse) Subject: Re: Viewing Color X pixmaps using pixmapVBT You first need to build a Pixmap.Raw containing your bits. The easiest way to do that is to create one, and then call the set method repeatedly, setting each pixel to the value you want it to have. I'm not familiar with the data format used by iconedit, so I don't know how you parse one, or how you determine what colors it wants so that you can determine the appropriate pixel values to use. You'll need to get familiar with the ScrnPixmap, ScreenType, and possibly ScrnPaintOp interfaces, all of which appear in the Trestle Reference Manual, and maybe the Palette interface. Have fun! Mark ======================================================================= 100 === Date: 29 Jun 92 07:16:12 GMT From: laverman@cs.rug.nl (Bert Laverman) Subject: Re: Errors building M3-2.07 on SPARC Elementery my dear Watsun. The SUN C compiler is not ANSI, and is therefore not required to provide this in libc. It is however very simple to add: ---snip---snip---snip--- /* strerror(3) - return a string describing the error * * strerror(int errnum) returns a text describing the error * number errnum. If the error number is illegal, the * string "Unknown error" is returned. */ extern char *sys_errlist[]; extern int sys_nerr; char *strerror(errnum) int errnum; { if ((errnum < 0) || (errnum >= sys_nerr)) return("Unknown error"); return(sys_errlist [errnum]); } ---snip---snip---snip--- compile with "cc -c -O strerror.c", add to library with "ar rv libm3.a", and re-ranlib with "ranlib libm3.a". That's all folks. Greetings, Bert -- #include Bert Laverman, Dept. of Computing Science, Groningen University Friendly mail to: laverman@cs.rug.nl The rest to: /dev/null ======================================================================= 101 === Date: 29 Jun 92 16:30:33 GMT From: carter@EuroPARC.Xerox.COM (Kathleen Carter) Subject: X colors in M3 Has anyone written functions to generate color paintops from X color names? (so I don't have to use R,G,B values) Kathy Carter ======================================================================= 102 === Date: Mon, 29 Jun 92 18:07:38 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: X colors in M3 In article <1992Jun29.163033.26027@parc.xerox.com>, carter@EuroPARC.Xerox.COM ( Kathleen Carter) writes: > Has anyone written functions to generate color paintops from > X color names? (so I don't have to use R,G,B values) The ColorName interface, which will be part of the libm3 library in 2.07 and is now in the m3color library may be the answer: (* Copyright (C) 1992, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* Created by stolfi on Wed Apr 19 01:33:17 1989 *) (* Last modified on Mon Jun 29 11:07:34 PDT 1992 by muller *) (* modified on Mon Jun 15 05:45:56 1992 by mhb *) (* modified on Wed Jun 3 18:06:16 PDT 1992 by stolfi *) (* The "ColorName" interface provides a standard mapping between color names and linear RGB triples. The current implementation recognizes only the corners of the RGB unit cube, plus an arbitary set of fifty-odd colors: | Aquamarine Beige Black Blue | BlueViolet Brown CadetBlue Coral | CornflowerBlue Cyan Firebrick ForestGreen | Gold Goldenrod Gray Green | GreenYellow Grey IndianRed Khaki | Lilac LimeGreen Magenta Maroon | MidnightBlue Navy NavyBlue Ochre | Orange OrangeRed Orchid Peach | Pink Plum Purple Red | Salmon SeaGreen Sienna SkyBlue | SlateBlue SlateGray SlateGrey SpringGreen | SteelBlue Tan Thistle Turquoise | Violet VioletRed Wheat White | Yellow YellowGreen In addition, the name of a color $C$ from the above list can be prefixed by one or more of the modifiers listed below: \begin{center} \begin{tabular}{l|l} % \begin{tabular}[c]{l} "Light" \\ "Pale" \end{tabular} & means 1/3 of the way from $C$ to white \\ \hline \begin{tabular}[c]{l} "Dark" \\ "Dim" \end{tabular} & means 1/3 of the way from $C$ to black \\ \hline \begin{tabular}[c]{l} "Drab" \\ "Weak" \\ "Dull" \end{tabular} & $\vcenter{\hbox{means 1/3 of the way from $C$ to the gray} \hbox{with the same brightness as $C$}}$ \\ \hline \begin{tabular}[c]{l} "Vivid" \\ "Strong" \\ "Bright" \end{tabular} & $\vcenter{\hbox{means 1/3 of the way from $C$ to the purest color} \hbox{with the same hue as $C$}}$ \\ \hline \begin{tabular}[c]{l} "Reddish" \end{tabular} & means 1/3 of the way from $C$ to red \\ \hline \begin{tabular}[c]{l} "Greenish" \end{tabular} & means 1/3 of the way from $C$ to green \\ \hline \begin{tabular}[c]{l} "Bluish" \end{tabular} & means 1/3 of the way from $C$ to blue \\ \hline \begin{tabular}[c]{l} "Yellowish" \end{tabular} & means 1/3 of the way from $C$ to yellow \\ \end{tabular} \end{center} Each of these modifiers can be modified in turn by the following prefixes, which replace ``1/3 of the way'' by the indicated fraction: \begin{center} \begin{tabular}{ll} "VeryVerySlightly" & 1/16 of the way \\ "VerySlightly" & 1/8 of the way \\ "Slightly" & 1/4 of the way \\ "Somewhat" & 3/8 of the way \\ "Rather" & 1/2 of the way \\ "Quite" & 5/8 of the way \\ "Very" & 3/4 of the way \\ "VeryVery" & 7/8 of the way \\ "VeryVeryVery" & 15/16 of the way \\ \end{tabular} \end{center} \noindent The modifier "Medium" is also recognized as a shorthand for "SlightlyDark". (But you cannot use "VeryMedium".) The names "Undefined" and "NIL" are also recognized, and both are mapped to "RGB.Undefined". These names accept no modifiers. So, for example, | Turquoise | (0.100, 0.814, 1.000) | | QuiteStrongTurquoise | Mix(FromHue(Hue(Turquoise)), 0.625, Turquoise, 0.375) | | BluishQuiteStrongTurquoise | Mix(Blue, 0.333, QuiteStrongTurquoise, 0.667) | | SlightlyDrabBluishQuiteStrongTurquoise | Mix(Grey(Brightness(BluishQuiteStrongTurquoise)), 0.250, | BluishQuiteStrongTurquoise, 0.750) | | VeryVeryDarkSlightlyDrabBluishQuiteStrongTurquoise | Mix(Black, 0.875, | SlightlyDrabBluishQuiteStrongTurquoise, 0.125) *) INTERFACE ColorName; IMPORT RGB, List; EXCEPTION NotFound; PROCEDURE ToRGB (name: TEXT): RGB.T RAISES {NotFound}; (* Gives the "RGB.T" value described by "name". Ignores case and whitespace. A cache of unnormalized names is maintained, so this procedure should be pretty fast for repeated lookups of the same name. *) PROCEDURE FromRGB (color: RGB.T): TEXT; (* Guesses a descriptive name for the given color. WARNING: This procedure is VeryVeryExpensive! *) PROCEDURE NameList (): List.T; (* Returns a list with all ``basic'' (unmodified) color names known to this module, as "TEXT"s capitalized according to the Modula-3 style, in alphabetical order. *) END ColorName. -- Eric. ======================================================================= 103 === Date: 29 Jun 92 16:28:13 GMT From: carter@EuroPARC.Xerox.COM (Kathleen Carter) Subject: Renderman and M3 Has anyone written Modula3 interfaces for the Renderman package? Kathy Carter ======================================================================= 104 === Date: Mon, 29 Jun 92 09:06:40 EDT From: wyant@centerline.com Subject: Errors building M3-2.07 on SPARC Keep in mind that the 'test-release' on gatekeeper is just that. M3-2.06 is still the official release. The 2.07 test release has other bugs (known and will be fixed for the official release) that prevent it from being useful. I would suggest sticking with the 2.06 release for a few more days... --geoff Geoff Wyant wyant@centerline.com Centerline Software, Inc. (Formerly Saber Software, Inc) 10 Fawcett Street Cambridge, Ma. 01238 ======================================================================= 105 === Date: Mon, 29 Jun 92 19:12:58 GMT From: muller@src.dec.com (Eric Muller) Subject: Unix.exit I changed the signature of Unix.exit, from: PROCEDURE exit (status: Ctypes.int): int; To: PROCEDURE exit (status: Ctypes.int); This may cause some problems which you cannot solve: for example if you use a library that calls Unix.exit and this library has not been rebuilt (the message you get from m3 is "inconsistent libraries"). However, I do not recommend the use of Unix.exit; instead, use RTMisc.exit, which will run the registered exitors. Sorry if this causes some trouble. -- Eric. ======================================================================= 106 === Date: Mon, 29 Jun 92 19:16:48 GMT From: muller@src.dec.com (Eric Muller) Subject: Re: Unix.exit My original message was sent to the wrong newsgroup; sorry about that. In any case, the change it describes will occur in 2.07, and RTMisc.Exit is a better procedure to use. -- Eric. ======================================================================= 107 === Date: Tue, 30 Jun 92 19:35:34 GMT From: muller@src.dec.com (Eric Muller) Subject: SRC Modula-3 2.07 available SRC Modula-3 2.07 is available in: gatekeeper.dec.com:pub/DEC/Modula-3/release In addition to the usual bug fixes, the main changes are: - the libraries color, sx and pinecreek have been merged into libm3 - three new archives: vbtkit, a set of VBTs formsvbt, a user-interface editor library vbtapps, which include a user-interface editor and demo applications I'll let Marc or Jim (the culprits) comment more on that - the DECstation OSF/1 version has been reactivated. I don't know if it works. It seems that the <*OBSOLETE*> mechanism is now reliable. In the next release, all the things marked <*OBSOLETE*> in 2.07 will be removed; you probably want to start cleaning your code when you have a chance. -- Eric.