From crash!kirk.safb.af.mil!BWILLS Tue, 8 Jun 93 17:50:33 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Tue, 8 Jun 93 17:50:33 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3Cg5-0001SpC; Tue, 8 Jun 93 16:02 PDT Message-Id: Date: 8 Jun 93 17:59:00 CST From: "Barry D. Wills" To: "amigae" Subject: re: How do I use E? Peter Dilly, in a message you said: /* Now first I know I forogt a \n after the \c on the first WriteF that gives the result to variable a. So put it in there. Ok in C im in the cli running the executable. Enter something so I type ! and return You entered ! Enter something else so I type @ and return You now entered @ Ok in E im in the cli and then EC the example.e file and run the executable. Enter something so I type ! and return You entered ! Enter something else You now entered ^^^^ In E it just flies through skipping the next attempt to get variable. After the first Return is pressed it goes flippo. ------------------------------ aga@qedbbs.com (Peter Dilley) or qed!aga The QED BBS -- (310)420-9327 */ PROC main() DEF a,b WriteF ('Enter something > ') a := Inp (stdout) /* in C it seems to be stdin */ /*---------------------------------------------------------------*/ /* Try this: */ WHILE Inp (stdout) <> 10 DO NOP /* Flush the input buffer. */ /* If you only want to get one character, do this. 10 is the */ /* decimal ascii code for the line-feed character, which is left */ /* in the input buffer after pressing return. This gets rid of */ /* it. Incidently, Peter, you can Inp() a whole string at a */ /* time using a loop, checking the value to tell when the end of */ /* input has been reached. */ /*---------------------------------------------------------------*/ WriteF ('You entered \c\n', a) WriteF ('Enter something else > ') b := Inp (stdout) /* ditto */ WHILE Inp (stdout) <> 10 DO NOP /* Flush the input buffer. */ WriteF ('You now entered \c\n', b) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Wed, 9 Jun 93 20:29:50 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Wed, 9 Jun 93 20:29:50 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3ZAi-0000BCC; Wed, 9 Jun 93 16:03 PDT Message-Id: Date: 9 Jun 93 18:00:00 CST From: "Barry D. Wills" To: "amigae" Subject: Sprite example /* Sprite example. This example produces a tiny sprite in a custom */ /* window on a custom screen. This example does not explain: how to */ /* design sprite images; what you should know about sprites in general; */ /* the ChangeSprite() function. If anyone needs this info, send me a */ /* request and I'll try to do it justice. -- Barry */ MODULE 'exec/memory' MODULE 'graphics/sprite' MODULE 'intuition/intuition' MODULE 'intuition/screens' ENUM ER_NONE, ER_MEM, ER_OPENSCREEN, ER_OPENWIN, ER_RESERVE_SPRITE, ER_USER_BREAK RAISE ER_MEM IF AllocMem () = NIL CONST SIZEOF_SPRITEDATA = 24 DEF myScreen : PTR TO screen, myWindow : PTR TO window, mySpriteData : PTR TO INT, mySpriteChipData : PTR TO INT, mySprite : simplesprite PROC main () HANDLE DEF x, y, xDirection, yDirection, closeWin = FALSE, class, /* IDCMP */ code, /* Code */ myMessage : PTR TO intuimessage, i /*-------------------------------------------*/ /* Allocate and initialize chip sprite data. */ /*-------------------------------------------*/ mySpriteChipData := AllocMem (SIZEOF_SPRITEDATA, MEMF_CHIP + MEMF_CLEAR) mySpriteData := [$0000, $0000, /* for system use */ $2000, $0000, /* line 1 */ $7000, $0000, /* line 2 */ $F800, $7000, /* line 3 */ $0000, $2000, /* line 4 */ $0000, $0000] : INT /* for system use */ FOR i := 0 TO (SIZEOF_SPRITEDATA / 2 - 1) mySpriteChipData [i] := mySpriteData [i] ENDFOR /*--------------------------------------------------------*/ /* Init simplesprite structure with chip data and others. */ /*--------------------------------------------------------*/ mySprite := [mySpriteChipData, /* Pointer to imagedata. */ 4, /* Height. */ 2, /* X-location on screen. */ 2, /* Y-location on screen. */ -1] : simplesprite /* Sprite id (0-7 are */ /* the only valid ids). */ /* -1 is a sentinel */ /* value. */ /* Sprite position. */ x := mySprite.x /* These are passed to MoveSprite() to set the new */ y := mySprite.y /* sprite location. */ /* Sprite direction. */ xDirection := 0 /* These are added to x and y according to the rawkey */ yDirection := 0 /* that is pressed (cursor keys.) */ /*---------------------------*/ /* Custom screen and window. */ /*---------------------------*/ IF (myScreen := OpenS (640, 200, 4, $8000, 'SPRITES')) = NIL THEN Raise (ER_OPENSCREEN) IF (myWindow := OpenW (0, 0, 639, 199, (IDCMP_CLOSEWINDOW + IDCMP_RAWKEY), (WFLG_SIMPLE_REFRESH + WFLG_CLOSEGADGET + WFLG_ACTIVATE), NIL, myScreen, CUSTOMSCREEN, NIL)) = NIL Raise (ER_OPENWIN) ENDIF /*----------------------------------------------------------------------*/ /* Set color registers. I know that my sprite will be using color regs */ /* 20 - 23 because I'll be asking for sprite #2. */ /*----------------------------------------------------------------------*/ SetRGB4 (myScreen.viewport, 21, $F, $0, $0); /* Red */ SetRGB4 (myScreen.viewport, 22, $F, $F, $0); /* Yellow */ SetRGB4 (myScreen.viewport, 23, $0, $F, $0); /* Green */ /*------------------------------------*/ /* Make sure I can reserve sprite #2. */ /*------------------------------------*/ IF (GetSprite (mySprite, 2) <> 2) THEN Raise (ER_RESERVE_SPRITE) /*----------------------------------------------------------------*/ /* Get IDCMP messages and move the sprite. Exit when closewindow */ /* gadget has been pressed. */ /*----------------------------------------------------------------*/ WHILE closeWin = FALSE WHILE (myMessage := GetMsg (myWindow.userport)) class := myMessage.class code := myMessage.code ReplyMsg (myMessage) SELECT class CASE IDCMP_CLOSEWINDOW closeWin := TRUE CASE IDCMP_RAWKEY SELECT code /* Up Arrow. */ CASE $4C; yDirection := -1 /* Pressed */ CASE $4C+$80; yDirection := 0 /* Released */ /* Down Arrow. */ CASE $4D; yDirection := 1 /* Pressed */ CASE $4D+$80; yDirection := 0 /* Released */ /* Right Arrow. */ CASE $4E; xDirection := 1 /* Pressed */ CASE $4E+$80; xDirection := 0 /* Released */ /* Left Arrow. */ CASE $4F; xDirection := -1 /* Pressed */ CASE $4F+$80; xDirection := 0 /* Released */ ENDSELECT ENDSELECT ENDWHILE x := x + xDirection y := y + yDirection IF x > 303 x := 303 ELSEIF x < 0 x := 0 ENDIF IF y > 184 y := 184 ELSEIF y < 0 y := 0 ENDIF MoveSprite (0, mySprite, x, y) FOR i := 0 TO 10000 DO NOP /* Reduce this on 7MHz Amigas. I've seen WaitTOF() used here to */ /* slow down the sprite, but it made the sprite vibrate on my */ /* machine. */ ENDWHILE freeMemory (0) EXCEPT freeMemory (exception) ENDPROC PROC freeMemory (exitCode) IF mySprite.num <> -1 THEN FreeSprite (mySprite.num) IF mySpriteChipData THEN FreeMem (mySpriteChipData, SIZEOF_SPRITEDATA) IF myWindow THEN CloseW (myWindow) IF myScreen THEN CloseS (myScreen) WriteF ('Exit code \d\n', exitCode) CleanUp (exitCode) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!netcom.com!qed!aga Wed, 9 Jun 93 20:30:11 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Wed, 9 Jun 93 20:30:11 PST Received: from netcomsv.netcom.com by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3a7k-0000JyC; Wed, 9 Jun 93 17:04 PDT Received: from qed.UUCP by netcomsv.netcom.com with UUCP (4.1/SMI-4.1) id AA08086; Wed, 9 Jun 93 17:04:30 PDT Received: by qed.UUCP (smail2.5) id AA08782; 9 Jun 93 12:14:22 PDT (Wed) Comments: n Message-Id: Date: Wed, 09 Jun 93 12:12:29 PDT Organization: The QED BBS, Lakewood CA From: aga@qedbbs.com (Peter Dilley) To: amigae@bkhouse.cts.com Subject: Thanks Barry PROC main() DEF a,b WriteF ('Enter something > ') a := Inp (stdout) /* in C it seems to be stdin */ /*---------------------------------------------------------------*/ /* Try this: */ WHILE Inp (stdout) <> 10 DO NOP /* Flush the input buffer. */ /* If you only want to get one character, do this. 10 is the */ /* decimal ascii code for the line-feed character, which is left */ /* in the input buffer after pressing return. This gets rid of */ /* it. Incidently, Peter, you can Inp() a whole string at a */ /* time using a loop, checking the value to tell when the end of */ /* input has been reached. */ /*---------------------------------------------------------------*/ WriteF ('You entered \c\n', a) WriteF ('Enter something else > ') b := Inp (stdout) /* ditto */ WHILE Inp (stdout) <> 10 DO NOP /* Flush the input buffer. */ WriteF ('You now entered \c\n', b) ENDPROC Thanks Barry. I had trouble mailing the list so all I could do was responds. Until I found out I wrote the mailing address down wrong :-D ------------------------------ aga@qedbbs.com (Peter Dilley) or qed!aga The QED BBS -- (310)420-9327 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Wed, 9 Jun 93 20:30:15 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Wed, 9 Jun 93 20:30:15 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3awF-0000gxC; Wed, 9 Jun 93 17:56 PDT Message-Id: Date: 9 Jun 93 19:52:00 CST From: "Barry D. Wills" To: "amigae" Subject: Linked Lists and Lists This is in response to Son Le's query. It doesn't really answer your question, but the three examples I'm posting is what I've learned about lists in E so far. This is the best I can do for a quick response. I'll try to come up with some- thing more relevant. The distinction between an E list variable and an E linked list is fairly demonstrated (I think) in this example, where the list variable contains a sequential collection of like objects (?), and the linked list is a collection of these things (I like to think of them as nodes) which are linked together dynamically (whereas the list variable is linked statically, more like an array. Wouter, does this make sense? ------------------------------------------------------------------------------- ENUM ER_NONE, ER_MEM RAISE ER_MEM IF List () = NIL DEF globalListElement PROC print () WriteF (' \d', globalListElement) ENDPROC PROC tailOfList (theList) DEF tail tail := theList WHILE Next (tail) <> NIL DO tail := Next (tail) ENDPROC tail PROC appendList (theList, listToAppend) VOID Link (tailOfList (theList), listToAppend) ENDPROC PROC printAll (theList) WriteF ('\n Contents of list: ') readAll (theList, `print ()) ENDPROC PROC incrementAll (theList) writeAll (theList, `globalListElement + 1) ENDPROC PROC readAll (theList, func) DEF link link := theList WHILE link <> NIL ForAll ({globalListElement}, link, func) link := Next (link) ENDWHILE ENDPROC PROC writeAll (theList, func) DEF link link := theList WHILE link <> NIL MapList ({globalListElement}, link, link, func) link := Next (link) ENDWHILE ENDPROC PROC main () HANDLE DEF listHead, newListElement, counter /* Allocate and initialize front of list. */ listHead := List (5) FOR counter := 0 TO 4 ListAdd (listHead, [counter], ALL) ENDFOR /* We now have one list element containing a group of 5 long integers */ /* which is pointed to by variable listHead. */ printAll (listHead) /* Allocate another list element, initialize it, and append it to the */ /* end of the list (after listHead and all subsequent Next () */ /* elements, (academic at this point since there is no Next ().) */ newListElement := List (5) FOR counter := 5 TO 9 ListAdd (newListElement, [counter], ALL) ENDFOR appendList (listHead, newListElement) /* We now have one list element containing a group of 5 long integers */ /* which is pointed to by variable listHead, and a Next () element */ /* which contains 5 long integers, and which can be accessed by using */ /* the internal list function Next () (demonstrated in function */ /* readAll () which is called by function printAll ().) Incidently, */ /* the integers can only be accessed by the internal functions */ /* ForAll () and MapList () (see functions readAll () and writeAll ().) */ printAll (listHead) /* Allocate another list element, initialize it, and append it to the */ /* end of the list (after listHead and all subsequent Next () elements. */ newListElement := List (5) FOR counter := 10 TO 14 ListAdd (newListElement, [counter], ALL) ENDFOR appendList (listHead, newListElement) /* We now have one list element containing a group of 5 long integers */ /* which is pointed to by variable listHead, and two Next () elements */ /* each containing 5 long integers, and which can be accessed by using */ /* the internal list function Next (). */ printAll (listHead) /* Increment the value in each of the long integers stored in all the */ /* list elements. */ incrementAll (listHead) printAll (listHead) DisposeLink (listHead) /* WARNING! listHead will be a NIL pointer */ /* after this function call even though it was */ /* not allocated using the List () function. */ WriteF ('\n\n') CleanUp (0) EXCEPT IF exception = ER_MEM THEN WriteF ('\n\n *** Out of memory.\n\n') CleanUp (exception) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Wed, 9 Jun 93 20:30:18 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Wed, 9 Jun 93 20:30:18 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3avw-0000C8C; Wed, 9 Jun 93 17:56 PDT Message-Id: Date: 9 Jun 93 19:53:00 CST From: "Barry D. Wills" To: "amigae" Subject: Linked Lists and Lists (3 of 3) ENUM ER_NONE, ER_MEM, ER_USER_ABORT RAISE ER_MEM IF List () = NIL, ER_MEM IF String () = NIL, ER_USER_ABORT IF CtrlC () = TRUE OBJECT listElementType name, phoneNumber ENDOBJECT PROC newElementFor (name, phoneNumber) DEF el : PTR TO listElementType el := New (SIZEOF listElementType) el.name := String (10) StrCopy (el.name, name, ALL) el.phoneNumber := phoneNumber ENDPROC el PROC phoneNumberFrom (theLink) DEF link : PTR TO listElementType link := ^theLink ENDPROC link.phoneNumber PROC printAll (theList) DEF link, element : PTR TO listElementType link := theList WHILE link <> NIL element := ^link WriteF ('\s \d\n', element.name, element.phoneNumber) link := Next (link) ENDWHILE ENDPROC PROC tailOfList (theList) DEF tail tail := theList WHILE Next (tail) <> NIL DO tail := Next (tail) ENDPROC tail PROC appendList (theList, name, phoneNumber) DEF newElement, newList newList := List (1) newElement := newElementFor (name, phoneNumber) ListCopy (newList, [newElement], ALL) IF ^theList = NIL /* Empty list, special case. */ ^theList := newList ELSE VOID Link (tailOfList (^theList), newList) ENDIF ENDPROC PROC sortList (theList) DEF listCurrent : PTR TO listElementType, listNext : PTR TO listElementType, temp listCurrent := ^theList WHILE listCurrent <> NIL listNext := listCurrent WHILE listNext := Next (listNext) CtrlC () IF phoneNumberFrom (listCurrent) > phoneNumberFrom (listNext) temp := ^listCurrent ^listCurrent := ^listNext ^listNext := temp ENDIF ENDWHILE listCurrent := Next (listCurrent) ENDWHILE ENDPROC /* sortList */ PROC main () HANDLE DEF listHead = NIL /* Allocate and initialize front of list. */ appendList ({listHead}, 'Cookamonga', 4444444) printAll (listHead) /* Allocate and initialize a second list element, then link it. */ appendList ({listHead}, 'Beeblebrox', 3333333) printAll (listHead) /* Allocate and initialize a third list element, then link it. */ appendList ({listHead}, 'Anteater', 2222222) printAll (listHead) /* Allocate and initialize a fourth list element, then link it. */ appendList ({listHead}, 'Aardvark', 1111111) printAll (listHead) /* Sort the list and display the contents. */ sortList ({listHead}) printAll (listHead) DisposeLink (listHead) /* WARNING! listHead will be a NIL pointer */ /* after this function call even though it was */ /* not allocated using the List () function. */ WriteF ('\n\n') CleanUp (0) EXCEPT IF exception = ER_MEM THEN WriteF ('\n\n *** Out of memory.\n\n') CleanUp (exception) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Wed, 9 Jun 93 20:30:21 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Wed, 9 Jun 93 20:30:21 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3aw4-000229C; Wed, 9 Jun 93 17:56 PDT Message-Id: Date: 9 Jun 93 19:53:00 CST From: "Barry D. Wills" To: "amigae" Subject: Linked Lists and Lists (2 of 3) ENUM ER_NONE, ER_MEM RAISE ER_MEM IF List () = NIL, ER_MEM IF String () = NIL OBJECT listElementType name, phoneNumber ENDOBJECT DEF globalListElement : PTR TO listElementType PROC newElement (name, phoneNumber) DEF el : PTR TO listElementType el := New (SIZEOF listElementType) el.name := String (10) StrCopy (el.name, name, ALL) el.phoneNumber := phoneNumber ENDPROC el PROC print () WriteF ('\s \d\n', globalListElement.name, globalListElement.phoneNumber) ENDPROC PROC tailOfList (theList) DEF tail tail := theList WHILE Next (tail) <> NIL DO tail := Next (tail) ENDPROC tail PROC appendList (theList, listToAppend) VOID Link (tailOfList (theList), listToAppend) ENDPROC PROC printAll (theList) WriteF ('\n Contents of list: \n') readAll (theList, `print ()) ENDPROC PROC incrementAll (theList) writeAll (theList, `globalListElement + 1) ENDPROC PROC readAll (theList, func) DEF link link := theList WHILE link <> NIL ForAll ({globalListElement}, link, func) link := Next (link) ENDWHILE ENDPROC PROC writeAll (theList, func) DEF link link := theList WHILE link <> NIL MapList ({globalListElement}, link, link, func) link := Next (link) ENDWHILE ENDPROC PROC main () HANDLE DEF listHead = NIL, listCurrent, newListElement : PTR TO listElementType, name, phoneNumber, counter /* Allocate and initialize front of list. */ listHead := List (1) newListElement := newElement ('Beeblebrox', 3333333) ListCopy (listHead, [newListElement], ALL) /* We now have one list element containing a name and a phone number */ /* which is pointed to by variable listHead. */ printAll (listHead) /* Allocate and initialize a second list element, then link it. */ listCurrent := List (1) newListElement := newElement ('Aardvark', 1111111) ListCopy (listCurrent, [newListElement], ALL) appendList (listHead, listCurrent) /* We now have two list elements each containing a name and a phone */ /* number which is linked to the end of the list pointed to by variable */ /* listHead. It can be accessed by using the function Next () (see */ /* function readAll () which is called by function printAll ().) */ printAll (listHead) /* Allocate and initialize a third list element, then link it. */ listCurrent := List (1) newListElement := newElement ('Cookamonga', 2222222) ListCopy (listCurrent, [newListElement], ALL) appendList (listHead, listCurrent) /* We now have three list elements each containing a name and a phone */ /* number which is linked to end of the list pointed to by variable */ /* listHead. It can be accessed by successive calls to the function */ /* Next () (see function readAll () which is called by function */ /* printAll ().) */ printAll (listHead) DisposeLink (listHead) /* WARNING! listHead will be a NIL pointer */ /* after this function call even though it was */ /* not allocated using the List () function. */ WriteF ('\n\n') CleanUp (0) EXCEPT IF exception = ER_MEM THEN WriteF ('\n\n *** Out of memory.\n\n') CleanUp (exception) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 10 Jun 93 14:08:11 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 10 Jun 93 14:08:11 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3s2N-0000tEC; Thu, 10 Jun 93 12:11 PDT Message-Id: Date: 10 Jun 93 14:07:00 CST From: "Barry D. Wills" To: "amigae" Subject: LIST1.E (re: Son Le's linked list questions) /* LIST1.E - In response to Son Le's linked list questions. More complete */ /* discussion appears at the end of LIST2.E. */ /* Does anyone know if you can use MapList, ForAll, Exists list functions on linked lists? Also how are linked lists stored in memory and finally, what's the difference between these two examples: */ PROC main () DEF a [3] : STRING, b [3] : STRING, c [3] : STRING, d [3] : STRING /* NOTE: if you make a,b,c,d pointers and create them as follows, this program will do exactly the same thing. a := String (3) b := String (3) c := String (3) d := String (3) */ StrCopy (a, 'aaa', ALL) StrCopy (b, 'bbb', ALL) StrCopy (c, 'ccc', ALL) StrCopy (d, 'ddd', ALL) /* Note: you are about to lose the string pointed to by d! */ /*------------*/ d:=Link(c,NIL) /*------------*/ /* c.next points to NIL (the initial value); d now points to the string */ /* 'ccc' because Link() returns the address of c. */ WriteF ('1. c=\s d=\s\n', c, d) /*----------*/ d:=Link(b,c) /*----------*/ /* b.next points to the string 'ccc'; d now points to the string 'bbb' */ /* because Link() returns the address of b. */ WriteF ('2. b=\s c=\s b.next=\s d=\s\n', b, c, Next(b), d) /*----------*/ d:=Link(a,b) /*----------*/ /* a.next points to the string 'bbb'; d now points to the string 'aaa' */ /* because Link() returns the address of a. */ WriteF ('3. a=\s b=\s a.next=\s d=\s\n', a, b, Next(a), d) /* Finally, everything that can be gotten from the linked strings: */ WriteF ('a=\s -> \s\n', a, Next(a)) WriteF ('b=\s -> \s\n', b, Next(b)) WriteF ('c=\s -> \s\n', c, IF Next(c)=NIL THEN 'NIL' ELSE Next(c)) WriteF ('d=\s -> \s\n', d, Next(d)) /*************************************************************************/ /* Output looks like this: */ /* */ /* a=aaa -> bbb */ /* b=bbb -> ccc */ /* c=ccc -> NIL */ /* d=aaa -> bbb */ /* */ /* If you compare the output of this program to that of list2.e you will */ /* see that the strings pointed to by a,b,c,d have the same values, but */ /* the strings that they are linked to are not the same. */ /*************************************************************************/ CleanUp (0) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 10 Jun 93 14:08:21 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 10 Jun 93 14:08:21 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3sJq-0000ZfC; Thu, 10 Jun 93 12:29 PDT Message-Id: Date: 10 Jun 93 14:27:00 CST From: "Barry D. Wills" To: "amigae" Subject: LIST2.E (re: Son Le's questions about linked lists) /* LIST2.E - In response to Son Le's linked list question. */ PROC main () DEF a [3] : STRING, b [3] : STRING, c [3] : STRING, d [3] : STRING StrCopy (a, 'aaa', ALL) StrCopy (b, 'bbb', ALL) StrCopy (c, 'ccc', ALL) StrCopy (d, 'ddd', ALL) WriteF ('d.next=\s\n', IF Next(d)=NIL THEN 'NIL' ELSE Next(d)) /*------------*/ d:=Link(d,NIL) /* At this point does nothing: d.next is already NIL. */ /*------------*/ /*------------*/ d:=Link(c,d) /*------------*/ /* c.next points to the string 'ddd'; d now points to the string 'ccc' */ /* because Link() returns the address of c. Now the string 'ddd' can */ /* only be accessed via Next(c). */ WriteF ('a=\s b=\s c=\s d=\s c.next=\s\n', a, b, c, d, Next(c)) /*------------*/ d:=Link(b,d) /*------------*/ /* b.next points to the string 'ccc' because d was reassigned the */ /* address of 'ccc' in the previous Link() statement; d now points to */ /* the string 'bbb' because Link() returns the address of b. */ WriteF ('b=\s b.next=\s d=\s\n', b, Next(b), d) /*------------*/ d:=Link(a,d) /*------------*/ /* a.next points to the string 'bbb' because d was reassigned the */ /* address of 'bbb' in the previous Link() statement; d now points to */ /* the string 'aaa' because Link() returns the address of a. */ WriteF ('a=\s a.next=\s d=\s\n', a, Next(a), d) /* Finally, everything that can be gotten from the linked strings: */ WriteF ('a=\s -> \s\n', a, Next(a)) WriteF ('b=\s -> \s\n', b, Next(b)) WriteF ('c=\s -> \s\n', c, Next(c)) WriteF ('d=\s -> \s\n', d, Next(d)) /***************************************************************************/ /* The final output of the program is: */ /* */ /* a=aaa -> bbb */ /* b=bbb -> ccc */ /* c=ccc -> ddd */ /* d=aaa -> aaa */ /* */ /* Compare the values pointed to by the Next() links in this program and */ /* list1.e. This is the difference in what the code does, not to mention */ /* the different routes used to get there. */ /* */ /* Hope this sheds *some* light! It might help if you're familiar with */ /* how the DrawBorder() graphics function works on border structures that */ /* are linked together, and how the DrawText() intuition function works on */ /* intuitext structures that are linked together. Also, the functions */ /* MapList(), ForAll(), and Exists() only work on a single list variable, */ /* NOT on linked lists. I haven't found a good example for using these */ /* yet. Maybe later. -- Barry */ /***************************************************************************/ CleanUp (0) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 10 Jun 93 17:50:45 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 10 Jun 93 17:50:45 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3wFA-0000KbC; Thu, 10 Jun 93 16:41 PDT Message-Id: Date: 10 Jun 93 18:37:00 CST From: "Barry D. Wills" To: "amigae" Subject: LIST1.E (re: Son Le's lists/linked lists questions) /* It looked like this was undelivered, so here it is again. */ /* LIST1.E - In response to Son Le's linked list questions. More complete */ /* discussion appears at the end of LIST2.E. */ /* Does anyone know if you can use MapList, ForAll, Exists list functions on linked lists? Also how are linked lists stored in memory and finally, what's the difference between these two examples: */ PROC main () DEF a [3] : STRING, b [3] : STRING, c [3] : STRING, d [3] : STRING /* NOTE: if you make a,b,c,d pointers and create them as follows, this program will do exactly the same thing. a := String (3) b := String (3) c := String (3) d := String (3) */ StrCopy (a, 'aaa', ALL) StrCopy (b, 'bbb', ALL) StrCopy (c, 'ccc', ALL) StrCopy (d, 'ddd', ALL) /* Note: you are about to lose the string pointed to by d! */ /*------------*/ d:=Link(c,NIL) /*------------*/ /* c.next points to NIL (the initial value); d now points to the string */ /* 'ccc' because Link() returns the address of c. */ WriteF ('1. c=\s d=\s\n', c, d) /*----------*/ d:=Link(b,c) /*----------*/ /* b.next points to the string 'ccc'; d now points to the string 'bbb' */ /* because Link() returns the address of b. */ WriteF ('2. b=\s c=\s b.next=\s d=\s\n', b, c, Next(b), d) /*----------*/ d:=Link(a,b) /*----------*/ /* a.next points to the string 'bbb'; d now points to the string 'aaa' */ /* because Link() returns the address of a. */ WriteF ('3. a=\s b=\s a.next=\s d=\s\n', a, b, Next(a), d) /* Finally, everything that can be gotten from the linked strings: */ WriteF ('a=\s -> \s\n', a, Next(a)) WriteF ('b=\s -> \s\n', b, Next(b)) WriteF ('c=\s -> \s\n', c, IF Next(c)=NIL THEN 'NIL' ELSE Next(c)) WriteF ('d=\s -> \s\n', d, Next(d)) /*************************************************************************/ /* Output looks like this: */ /* */ /* a=aaa -> bbb */ /* b=bbb -> ccc */ /* c=ccc -> NIL */ /* d=aaa -> bbb */ /* */ /* If you compare the output of this program to that of list2.e you will */ /* see that the strings pointed to by a,b,c,d have the same values, but */ /* the strings that they are linked to are not the same. */ /*************************************************************************/ CleanUp (0) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 10 Jun 93 17:50:47 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 10 Jun 93 17:50:47 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o3wEv-00003sC; Thu, 10 Jun 93 16:41 PDT Message-Id: Date: 10 Jun 93 18:38:00 CST From: "Barry D. Wills" To: "amigae" Subject: LIST2.E (re: Son Le's lists/linked lists questions) /* It looked like this was undelivered, so here it is again. This is part 2. */ /* LIST2.E - In response to Son Le's linked list question. */ PROC main () DEF a [3] : STRING, b [3] : STRING, c [3] : STRING, d [3] : STRING StrCopy (a, 'aaa', ALL) StrCopy (b, 'bbb', ALL) StrCopy (c, 'ccc', ALL) StrCopy (d, 'ddd', ALL) WriteF ('d.next=\s\n', IF Next(d)=NIL THEN 'NIL' ELSE Next(d)) /*------------*/ d:=Link(d,NIL) /* At this point does nothing: d.next is already NIL. */ /*------------*/ /*------------*/ d:=Link(c,d) /*------------*/ /* c.next points to the string 'ddd'; d now points to the string 'ccc' */ /* because Link() returns the address of c. Now the string 'ddd' can */ /* only be accessed via Next(c). */ WriteF ('a=\s b=\s c=\s d=\s c.next=\s\n', a, b, c, d, Next(c)) /*------------*/ d:=Link(b,d) /*------------*/ /* b.next points to the string 'ccc' because d was reassigned the */ /* address of 'ccc' in the previous Link() statement; d now points to */ /* the string 'bbb' because Link() returns the address of b. */ WriteF ('b=\s b.next=\s d=\s\n', b, Next(b), d) /*------------*/ d:=Link(a,d) /*------------*/ /* a.next points to the string 'bbb' because d was reassigned the */ /* address of 'bbb' in the previous Link() statement; d now points to */ /* the string 'aaa' because Link() returns the address of a. */ WriteF ('a=\s a.next=\s d=\s\n', a, Next(a), d) /* Finally, everything that can be gotten from the linked strings: */ WriteF ('a=\s -> \s\n', a, Next(a)) WriteF ('b=\s -> \s\n', b, Next(b)) WriteF ('c=\s -> \s\n', c, Next(c)) WriteF ('d=\s -> \s\n', d, Next(d)) /***************************************************************************/ /* The final output of the program is: */ /* */ /* a=aaa -> bbb */ /* b=bbb -> ccc */ /* c=ccc -> ddd */ /* d=aaa -> aaa */ /* */ /* Compare the values pointed to by the Next() links in this program and */ /* list1.e. This is the difference in what the code does, not to mention */ /* the different routes used to get there. */ /* */ /* Hope this sheds *some* light! It might help if you're familiar with */ /* how the DrawBorder() graphics function works on border structures that */ /* are linked together, and how the DrawText() intuition function works on */ /* intuitext structures that are linked together. Also, the functions */ /* MapList(), ForAll(), and Exists() only work on a single list variable, */ /* NOT on linked lists. I haven't found a good example for using these */ /* yet. Maybe later. -- Barry */ /***************************************************************************/ CleanUp (0) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!minyos.xx.rmit.OZ.AU!s924723 Sun, 13 Jun 93 19:47:15 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Sun, 13 Jun 93 19:47:15 PST Received: from peladon.rmit.OZ.AU by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o547K-00008YC; Sun, 13 Jun 93 19:17 PDT Received: from minyos.xx.rmit.OZ.AU by peladon.rmit.OZ.AU with SMTP id AA17306 (5.65c/IDA-1.4.4 for ); Mon, 14 Jun 1993 12:17:44 +1000 Received: by minyos.xx.rmit.oz.au Date: Mon, 14 Jun 93 12:17:48 EST Message-Id: <9306140217.12731@minyos.xx.rmit.oz.au> From: s924723@minyos.xx.rmit.OZ.AU (Son Huu Le) To: amigae@bkhouse.cts.com Subject: Here's a timer program for those who want to see which part of their program is taking up the most time. It's not meant to be used for accuracy as it isn't but it does give you a good idea as to what your program is spending most of it's time doing. If you make lots of etime() and eend() calls, be prepared for a real program slowdown... :( Usage is pretty straightforward.. see main(). Oh yeah, 2.0 only. Time to upgrade people.. (; eg. Compiling epp014b.e using epp014b (both are my modified version, on 68000) Functions numbered according to the order in which the appear in source, skipping validStartOfToken. (eg. Function 10 = getModule()) Function 11: (Visits 1) secs 8 msecs 316 micros 52 Function 8: (Visits 25) secs 46 msecs 377 micros 100 Function 4: (Visits 8) secs 0 msecs 9 micros 933 Function 3: (Visits 207) secs 0 msecs 262 micros 522 Function 7: (Visits 1042) secs 4 msecs 400 micros 59 Function 5: (Visits 27911) secs 8 msecs 163 micros 20 Function 6: (Visits 1028) secs 6 msecs 741 micros 421 Function 2: (Visits 9) secs 0 msecs 4 micros 329 Function 10: (Visits 9) secs 54 msecs 145 micros 372 Function 1: (Visits 2) secs 0 msecs 0 micros 789 Function 0: (Visits 1) secs 0 msecs 4 micros 936 Order of functions called = bottom to top. (yep, getModule()and copyProc() are the time hoggers.. look at getModule() .. only 9 calls too!) --- CUT HERE --- /* ETimer by Son Le (28.05.93) based on CTimer2 by Chas A. Wyndham */ MODULE 'Timer', 'devices/timer', 'exec/io' OBJECT erecord idnumber:LONG visits:LONG start:LONG elapse:LONG ENDOBJECT DEF etimerequest:PTR TO timerequest,eclock:PTR TO eclockval, echeck:PTR TO erecord, estore:PTR TO erecord, eclockstatus=TRUE PROC einit() DEF newdevice:PTR TO io eclockstatus:=1 IF (etimerequest:=New(SIZEOF timerequest)) OR (eclock:=New(SIZEOF eclockval)) IF (eclockstatus:=OpenDevice('timer.device',UNIT_ECLOCK,etimerequest,0))=FALSE newdevice:=etimerequest.io timerbase:=newdevice.device ENDIF ENDIF ENDPROC PROC etime(id) IF (eclockstatus) THEN einit() IF (eclockstatus=1) THEN RETURN (FALSE) /* error?!! */ echeck:=estore WHILE ((echeck) AND (echeck.idnumber<>id)) DO echeck:=Next(echeck) IF (echeck=NIL) IF (echeck:=String(SIZEOF erecord))=NIL eclockstatus:=1 RETURN ENDIF echeck.idnumber:=id estore:=Link(echeck,estore) ENDIF echeck.visits:=echeck.visits+1 ReadEClock(eclock) echeck.start:=eclock.lo ENDPROC PROC eend(id) IF (eclockstatus=FALSE) ReadEClock(eclock) echeck:=estore WHILE ((echeck) AND (echeck.idnumber<>id)) DO echeck:=Next(echeck) IF (echeck) THEN echeck.elapse:=echeck.elapse+(eclock.lo-echeck.start) ENDIF ENDPROC PROC ereport() DEF temp, freq, micros, msecs, secs, echeck:PTR TO erecord IF (eclockstatus=FALSE) freq:=ReadEClock(eclock) echeck:=estore REPEAT temp:=SpDiv(SpDiv(1000000.0,SpFlt(freq)),SpFlt(echeck.elapse)) secs:=SpFix(SpDiv(1000000.0,temp)) temp:=SpSub(SpMul(1000000.0,SpFlt(secs)),temp) msecs:=SpFix(SpDiv(1000.0,temp)) micros:=SpFix(SpSub(SpMul(1000.0,SpFlt(msecs)),temp)) WriteF('Function \d[2]: (Visits \d[6]) secs \d[3] msecs \d[3] micros \d[3]\n', echeck.idnumber, echeck.visits, secs, msecs, micros) UNTIL (echeck:=Next(echeck))=NIL ENDIF CloseDevice(etimerequest) DisposeLink(estore) Dispose(eclock) eclockstatus:=TRUE estore:=echeck:=NIL ENDPROC PROC main() DEF x /* no need to call einit() - etime() does that automatically */ etime(0) etime(1) eend(1) eend(0) etime(2) FOR x:=1 TO 1000 etime(3) eend(3) ENDFOR eend(2) /* must call ereport() to see result, and close/cleanup after etime() */ ereport() ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 17 Jun 93 13:49:08 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 17 Jun 93 13:49:08 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o6PN5-0000PdC; Thu, 17 Jun 93 12:11 PDT Message-Id: Date: 17 Jun 93 14:08:00 CST From: "Barry D. Wills" To: "amigae" Subject: sscanf.e To Son Le: Here is a shell for the sscanf() function you were asking about. Didn't have time to work out the string parsing. Don't know if/when I'll work on it. But this is a [good?] example of how to put things into a list variable and get them out again. This example goes one further and shows how you can simulate passing a variable number of args into a proc by sending them as a list. Let me know what you think (that's meant for everybody, especially Wouter!) -- Barry ---------- CUT HERE --------------------------------------------------------- DEF ssf_x, ssf_var : PTR TO LONG, ssf_forCount PROC assign () ssf_var [ssf_forCount] := ssf_x INC ssf_forCount ENDPROC PROC sscanf (str, fmt, varList) DEF numRead = 0, i, listLen /* Get/set length of list. */ listLen := ListLen (varList) SetList (varList, listLen) /* Extract vars from list. */ ssf_var := New (listLen * 4) /* 4=SIZEOF LONG. */ ssf_forCount := 0 ForAll ({ssf_x}, varList, `assign ()) /*------------------------------------------------------------------------*/ /* Just some displays to see what we got as params. */ /* This is where your code goes to parse the string. */ WriteF ('ListLen(varList)=\d\n', listLen) WriteF ('\s\n' + '\s\n', str, fmt) FOR i := 0 TO (listLen - 1) WriteF ('ssf_var[\d]=\d\n', i, ssf_var [i]) ENDFOR WriteF ('\n') /* End of displays. */ /*------------------------------------------------------------------------*/ Dispose (ssf_var) ENDPROC numRead PROC main () DEF string [20] : STRING, format [20] : STRING, a=90, b=91, c=92, d=93 StrCopy (string, '100 101 102 103', ALL) StrCopy (format, '\d \d \d \d', ALL) /* ---> OR... StrCopy (format, '%d %d %d %d', ALL) */ sscanf (string, format, [a,b,c,d]) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 17 Jun 93 18:06:44 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 17 Jun 93 18:06:44 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o6Sfg-0000p7C; Thu, 17 Jun 93 15:43 PDT Message-Id: Date: 17 Jun 93 17:38:00 CST From: "Barry D. Wills" To: "amigae" Subject: sscanf.e (fixed) Okay, Son Le. Here it is. sscanf() now does exactly what I want it to do. All you have to do is write the code to scan the string and place numeric values in the variables at addresses in the array ssf_var, and put the addresses of strings there in the same way. I think the shell should be pretty easy to work with. The only thing up in the air is how to implement floats :-) Oh, don't forget characters. I don't know if you want to do octal and hex. Anyway, if you don't want to work on the scanning algorithm myself, let me know so I can stick it on the back burner. That way it won't get forgotten. (Oops, back two sentences should read "yourself" .vs. "myself". I don't know how to get back to pervious lines in this mail editor. It's a massive pain in the BUTT! :( As usual, let me know what you think. -- Barry DEF ssf_x, ssf_var : PTR TO LONG, ssf_forCount PROC assign () ssf_var [ssf_forCount] := ssf_x INC ssf_forCount ENDPROC PROC sscanf (str, fmt, varList) DEF numRead = 0, i, listLen, var = NIL /* Get/set length of list. */ listLen := ListLen (varList) SetList (varList, listLen) /* Extract addresses from list. */ ssf_var := New (listLen * 4) /* 4=SIZEOF LONG. */ ssf_forCount := 0 ForAll ({ssf_x}, varList, `assign ()) /*------------------------------------------------------------------------*/ /* Just some displays to see what we got as params. */ /* This is where your code goes to parse the string. */ WriteF ('Values passed to sscanf():\n') WriteF (' ListLen(varList)=\d\n', listLen) WriteF (' string=\s\n' + ' format=\s\n', str, fmt) FOR i := 0 TO (listLen - 1) var := ssf_var [i] /* get the address from the array. */ WriteF (' ssf_var[\d]=\d\n', i, ^var) ^var := ^var + 20 /* change the values just to see the results. */ ENDFOR ^var := 'Pretend this is an extracted string.' /* simulate extracting a string. look at end of main to see result. */ /* End of displays. */ /*------------------------------------------------------------------------*/ Dispose (ssf_var) ENDPROC numRead PROC main () DEF string [20] : STRING, format [20] : STRING, a=90, b=91, c=92, d=93, numRead StrCopy (string, '100 101 102 103', ALL) StrCopy (format, '\d \d \d \d', ALL) /* ---> OR... StrCopy (format, '%d %d %d %d', ALL) */ numRead := sscanf (string, format, [{a},{b},{c},{d}]) WriteF ('The modified values:\n' + ' a=\d\n' + ' b=\d\n' + ' c=\d\n' + ' d=\d (address of a string)\n', a, b, c, d) WriteF (' string at d=\s\n', d) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 17 Jun 93 21:44:43 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 17 Jun 93 21:44:43 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o6X94-0000tEC; Thu, 17 Jun 93 20:29 PDT Message-Id: Date: 17 Jun 93 22:27:00 CST From: "Barry D. Wills" To: "amigae" Subject: 2Darray.e (solution) I forget who originally asked this question. Must have accidently deleted the message (sorry!) But here it is: 2D arrays in E! With a little more work this could be expanded into a MULTI-dimensional module (see my sscanf.e module for a hint :) Later. -- Barry --- CUT HERE ------------------------------------------------------------- /*========================================================================*/ /* */ /* 2D array in E. It's as easy as this. */ /* */ /* User components are: */ /* dd_arrayType and the components therein */ /* dd_dim (), create the 2d array */ /* dd_set (), put a value into an element of the 2d array */ /* dd_get (), get a value from an element of the 2d array */ /* */ /* The other components of this module should not be useful. */ /* */ /*========================================================================*/ RAISE 0 IF CtrlC () = TRUE /* You should define an error trap for New()=NIL. */ OBJECT dd_arrayType iUBound, jUBound, elSize, elements ENDOBJECT /* These are global to speed up array access. */ DEF dd_ar : PTR TO dd_arrayType, dd_charPtr : PTR TO CHAR, dd_intPtr : PTR TO INT, dd_longPtr : PTR TO LONG, dd_elSize PROC dd_dim (i, j, elSize) IF (elSize <> 1) AND (elSize <> 2) AND (elSize <> 4) THEN Raise ('Invalid element size.') dd_ar := New (SIZEOF dd_arrayType) dd_ar.elements := New (i*j*elSize) dd_ar.iUBound := i - 1 dd_ar.jUBound := j - 1 dd_ar.elSize := elSize ENDPROC dd_ar PROC checkBounds (i, j) /* dd_ar already points to array when this is called. */ IF (i < 0) OR (i > dd_ar.iUBound) THEN Raise ('"i" subscript out of bounds.') IF (j < 0) OR (j > dd_ar.jUBound) THEN Raise ('"j" subscript out of bounds.') ENDPROC TRUE PROC dd_offset (i, j) RETURN ((i * (dd_ar.jUBound + 1) + j) * dd_elSize) PROC dd_set (array, i, j, value) dd_ar := array checkBounds (i, j) dd_elSize := dd_ar.elSize SELECT dd_elSize CASE 1 dd_charPtr := dd_ar.elements dd_charPtr [dd_offset (i, j)] := value CASE 2 dd_intPtr := dd_ar.elements dd_intPtr [dd_offset (i, j)] := value CASE 4 dd_longPtr := dd_ar.elements dd_longPtr [dd_offset (i, j)] := value ENDSELECT ENDPROC PROC dd_get (array, i, j) DEF value dd_ar := array checkBounds (i, j) dd_elSize := dd_ar.elSize SELECT dd_elSize CASE 1 dd_charPtr := dd_ar.elements value := dd_charPtr [dd_offset (i, j)] CASE 2 dd_intPtr := dd_ar.elements value := dd_intPtr [dd_offset (i, j)] CASE 3 dd_longPtr := dd_ar.elements value := dd_longPtr [dd_offset (i, j)] ENDSELECT ENDPROC value PROC dd_dispose (array) dd_ar := array Dispose (dd_ar.elements) Dispose (dd_ar) ENDPROC PROC main () HANDLE DEF myArray : PTR TO dd_arrayType, /* Only needs to PTR TO if you want */ /* access to the OBJECT fields. */ xDim = 4, yDim = 4, /* x and y dimensions. */ sizeofChar = 1, /* Just for readability. */ i, j, val = 0 /* Loop counters. */ /* Create the array. */ myArray := dd_dim (xDim, yDim, sizeofChar) /* Put stuff in each element. */ FOR i := 0 TO myArray.iUBound FOR j := 0 TO myArray.jUBound CtrlC() dd_set (myArray, i, j, val++) ENDFOR ENDFOR /* Get it back out. */ FOR i := 0 TO myArray.iUBound FOR j := 0 TO myArray.jUBound WriteF ('myArray [\d,\d]=\d\n', i, j, dd_get (myArray, i, j)) ENDFOR ENDFOR /* Cleanup. */ dd_dispose (myArray) EXCEPT IF exception THEN WriteF ('\s\n', exception) CleanUp (exception) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Mon, 21 Jun 93 10:29:24 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Mon, 21 Jun 93 10:29:24 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o6tPL-00001hC; Fri, 18 Jun 93 20:15 PDT Message-Id: Date: 18 Jun 93 22:12:00 CST From: "Barry D. Wills" To: "amigae" Subject: askreq.e /* Here's something I found in C and I couldn't resist translating it. It was something I was interested in a long time ago, but the one I saw said, "KS2.0 only!" (But I think that one did a little more than yes/no. */ /****************************************************** * REQSTD - A simple boolean requester command for use * within EXECUTE command files. ******************************************************* * THIS VERSION OBSERVES "STANDARD" C PRGMG CONVENTIONS ******************************************************* * BVO Computing Services, January 1987, Bob Riemersma ******************************************************* * Format: REQSTD * Template: REQSTD " " * Purpose: To ask the user a yes/no question from * within an EXECUTE command file. * Specification: * REQSTD invokes a system requester displaying the * text argument given, and accepts either a "Yes" or * a"No" response via the requester's boolean gadgets. * This response is communicated to the command stream * via REQSTD's return result: 0 = No, 5 = Yes. * Example: * REQSTD "Are you older than 35?" * IF WARN ;WARN = Yes * ECHO "Hmmm, so you are." * ELSE * ECHO "Just a young whippersnapper!" * ENDIF ******************************************************* * Note to rodent-haters: * Beginning with KS/WB 1.2 you may respond using * "Left Amiga-V" for "Yes", "Left Amiga-B" for "No". ******************************************************* * Original C code ported to E by Barry Wills, 18 Jun 93. * Sizes of executables: * StdC: 14,388 bytes * SkinnyC: 2,540 bytes * E: 856 bytes * Note: no explanation was provided about "StdC" and * "SkinnyC". ******************************************************* ;I decided to call my executable "AskReq", so I tested ;it with this script: AskReq "Will you help me?" If WARN Echo "Oh, thank you, thank you!" Else Echo "Okay, be that way!" EndIf ******************************************************/ MODULE 'dos/dosextens', 'intuition/intuition', 'graphics/rastport' DEF myself : PTR TO process PROC main () DEF reqWidth, questionLength IF arg [] = 0 THEN RETURN 120 questionLength := StrLen (arg) /* get rid of quotes efficiently */ arg [0] := " " arg [questionLength - 1] := " " myself := FindTask (0) IF (reqWidth := 8 * questionLength + 40) < 200 THEN reqWidth := 200 RETURN IF AutoRequest (myself.windowptr, [2, 1, RP_JAM1, 8, 6, NIL, arg, NIL] : intuitext, [2, 1, RP_JAM1, 6, 4, NIL, 'Yes', NIL] : intuitext, [2, 1, RP_JAM1, 6, 4, NIL, 'No', NIL] : intuitext, NIL, NIL, reqWidth, 50) THEN 5 ELSE 0 ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!golum.riv.csu.edu.au!geoff Mon, 21 Jun 93 10:30:22 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Mon, 21 Jun 93 10:30:22 PST Received: from golum.riv.csu.edu.au by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0o7AQm-00002HC; Sat, 19 Jun 93 14:26 PDT Received: by golum.riv.csu.edu.au (5.65/DEC-Ultrix/4.3) id AA20134; Sun, 20 Jun 1993 07:28:50 +1000 Message-Id: <9306192128.AA20134@golum.riv.csu.edu.au> Reply-To: gfellows@csu.edu.au Organisation: Charles Sturt University-Riverina, Australia Date: Sun, 20 Jun 93 07:28:50 -0800 X-Mts: smtp From: Geoff Fellows (CSU-R InfoStud) To: amigae@bkhouse.cts.com Subject: Toy program Here's a toy program that someone might find useful: /* Draw a tree using recursion on the command */ MODULE 'dos/dostags', 'utility/tagitem', 'intuition/intuition' CONST IFLAGS=IDCMP_CLOSEWINDOW, X0=160, Y0=256, MINLEN=16, SQR3E6=1732 PROC main() DEF myargs:PTR TO LONG,rdargs myargs:=[0,0,0,0,0] rdargs:=ReadArgs('RAST/A/N,X/A/N,Y/A/N,GRAD/A/N,LEN/A/N', myargs, NIL) IF rdargs branch(myargs) FreeArgs(rdargs) ELSE root() ENDIF ENDPROC PROC root() DEF sptr, wptr sptr:=OpenS(320,256,4,0,'Root Screen') wptr:=OpenW(0,0,320,256,IFLAGS,15,'Tree',sptr,15,NIL) newbranch(0, 0, 90, 128) WaitIMessage(wptr) CloseW(wptr) CloseS(sptr) ENDPROC PROC branch(myargs: PTR TO LONG) DEF x, y, x1, y1, dxdy: PTR TO LONG, gradient, length SetStdRast(Long(myargs[0])) x := Long(myargs[1]) y := Long(myargs[2]) gradient := Long(myargs[3]) length := Long(myargs[4]) IF length >= MINLEN dxdy := dxy(gradient, length) x1 := x + dxdy[0]; y1 := y + dxdy[1] Line(X0+x,Y0-y,X0+x1,Y0-y1,1) newbranch(x1, y1, gradient-30, length/2) newbranch(x1, y1, gradient+30, length/2) ELSE Plot(X0+x, Y0-y, 2) /* leaf */ ENDIF ENDPROC PROC dxy(gradient, length) DEF dx, dy IF gradient < 0 THEN gradient := 360 + Mod(gradient, 360) gradient := Mod(gradient, 360) SELECT gradient CASE 0; dx:= length; dy := 0 CASE 30; dx:= length * SQR3E6/2000; dy := length/2 CASE 60; dx:= length / 2; dy := length * SQR3E6/2000 CASE 90; dx:= 0; dy := length CASE 120; dx:= -length / 2; dy := length * SQR3E6/2000 CASE 150; dx:= -length * SQR3E6/2000; dy := length / 2 CASE 180; dx:= -length; dy := 0 CASE 210; dx:= -length * SQR3E6/2000; dy := -length/2 CASE 240; dx:= -length / 2; dy := -length * SQR3E6/2000 CASE 270; dx:= 0; dy := -length CASE 300; dx:= length / 2; dy := -length * SQR3E6/2000 CASE 330; dx:= length * SQR3E6/2000; dy := -length / 2 ENDSELECT ENDPROC [dx, dy] PROC newbranch(x, y, g, l) DEF command[80]: STRING StrAdd(command, '', ALL) /* required initialisation */ RawDoFmt('%s %ld %ld %ld %ld %ld', ['Tree', stdrast, x, y, g, l], {putCh}, command) Execute(command, NIL, NIL) ENDPROC putCh: MOVE.B D0,(A3)+; RTS /* Proc used by RawDoFmt (see exec.doc) */ Just compile and then type 'tree' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!cs.weber.edu!leon Mon, 28 Jun 93 21:45:57 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Mon, 28 Jun 93 21:45:57 PST Received: from cs.weber.edu by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oAWym-0000tAC; Mon, 28 Jun 93 21:07 PDT Received: from icarus.weber.edu (icarus.cs.weber.edu) by cs.weber.edu (4.1/SMI-4.1.1) id AA11664; Mon, 28 Jun 93 22:05:18 MDT Received: by icarus.weber.edu (5.0/SMI-SVR4) id AA11684; Mon, 28 Jun 93 22:04:07 MDT Date: Mon, 28 Jun 93 22:04:07 MDT Message-Id: <9306290404.AA11684@icarus.weber.edu> Content-Length: 1884 From: leon@cs.weber.edu (Leon D. Atkinson) To: amigae@bkhouse.cts.com Subject: OK, OK... The problem with my generator IS something stupid. I assumed the section 4 was the only stuff on math... Anyway, all I should have to do is change my *'s to Mul()'s. The float support is apt to change, so I'm not going to bother to do a more precise check of the randomness than by whole numbers, but it's probably close enough. One thing I couldn't find in the docs was how to create the equivalent of a header file in C, or a package in Ada. So, I just put it at the top of the file for main(). Note, this function does tend to wander, meaning it takes a long time for it's output to converge toward the correct average, at least with the seed I was testing with. Anyway, enough talking, here's the source (both C and E): ***E source*** /*Random number generator*/ /*C is a constant in the form 2^n+1*/ /*K is a positive prime number*/ /*X is the upper limit*/ /*I got this algorithm out of Game Playing with Computers*/ /*by Donald D. Spencer*/ CONST C=32769, K=37, X=429496730 DEF rand_seed: LONG PROC seedRandom(new_seed) rand_seed := new_seed ENDPROC PROC randomNum(range) rand_seed := Mod((Mul(rand_seed, C) + K), X) RETURN Abs((Mod(rand_seed, range) + 1)) ENDPROC /*Main procedure just for testing*/ PROC main() DEF counter DEF total: LONG seedRandom(1212490) FOR counter := 1 TO 1000000 total := total + randomNum(100) ENDFOR WriteF('Average: \d\n',Div(total,1000000)) ENDPROC /*this should spit out an average of 52, where the ideal should be 50*/ ***C source*** #define C 32769 #define K 37 #define X 429496730 unsigned int RND_seed; void SEED(unsigned int new_seed) { RND_seed = new_seed; } unsigned int RND(unsigned int range) { RND_seed = (((C * RND_seed) + K) % X); return(((RND_seed)%range)+1); } ************* OK, have at it, fellas. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!minyos.xx.rmit.OZ.AU!s924723 Sun, 4 Jul 93 19:42:52 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Sun, 4 Jul 93 19:42:52 PST Received: from peladon.rmit.OZ.AU by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oCg5t-0000RcC; Sun, 4 Jul 93 19:15 PDT Received: from minyos.xx.rmit.OZ.AU by peladon.rmit.OZ.AU with SMTP id AA16127 (5.65c/IDA-1.4.4 for ); Mon, 5 Jul 1993 12:15:32 +1000 Received: by minyos.xx.rmit.oz.au Date: Mon, 5 Jul 93 12:15:34 EST Message-Id: <9307050215.23331@minyos.xx.rmit.oz.au> From: s924723@minyos.xx.rmit.OZ.AU (Son Huu Le) To: amigae@bkhouse.cts.com Subject: Joystick Anyone want to access the joystick? Son Le PROC main() DEF joypos, joyx, joyy, firebutton /* $DFF00A (gameport 0) - %xxxxxxxx xxxxxxx fedcba98 76543210 $DFF00C (gameport 1) left - bit 9 up - bit 8 xor bit 9, Eor(bit 8,bit 9) right - bit 1 down - bit 0 xor bit 1, Eor(bit 0,bit 1) $BFE001 (gameport fire) - %76543210 fire gameport 0 - bit 7 fire gameport 1 - bit 6 (zero-active, ie. 0=pressed) */ WHILE CtrlC()=FALSE joypos:=Long($dff00a) AND $FFFF firebutton:=Char($bfe001) joyx:=joypos AND %11 joyy:=Shr(joypos,8) AND %11 IF ((joyx AND %10) = %10) THEN WriteF('right\t') IF ((joyy AND %10) = %10) THEN WriteF('left\t') IF (joyx = %01) OR (joyx = %10) THEN WriteF('down\t') IF (joyy = %01) OR (joyy = %10) THEN WriteF('up\t') /* IF Eor(joyx AND %01,Shr(joyx,1)) = 1 THEN WriteF('down\t') IF Eor(joyy AND %01,Shr(joyy,1)) = 1 THEN WriteF('up\t') */ IF (firebutton AND %10000000) = 0 THEN WriteF('fire') WriteF(' \b') ENDWHILE ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!minyos.xx.rmit.OZ.AU!s924723 Sat, 10 Jul 93 09:40:54 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Sat, 10 Jul 93 09:40:54 PST Received: from peladon.rmit.OZ.AU by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oEgKX-0000DuC; Sat, 10 Jul 93 07:55 PDT Received: from minyos.xx.rmit.OZ.AU by peladon.rmit.OZ.AU with SMTP id AA05244 (5.65c/IDA-1.4.4 for ); Sun, 11 Jul 1993 00:55:07 +1000 Received: by minyos.xx.rmit.OZ.AU Message-Id: <9307101455.11858@minyos.xx.rmit.OZ.AU> Date: Sun, 11 Jul 1993 00:55:07 +1000 (EST) X-Mailer: ELM [version 2.4 PL22] Mime-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Length: 3652 From: s924723@minyos.xx.rmit.OZ.AU (Son Huu Le) To: amigae@bkhouse.cts.com Subject: Slow E example Forwarded message: From MAILER-DAEMON Sat Jul 10 12:16:53 1993 Date: Sat, 10 Jul 93 12:16:30 EST From: MAILER-DAEMON (Mail Delivery Subsystem) Subject: Returned mail: Service unavailable Message-Id: <9307100216.24669@minyos.xx.rmit.OZ.AU> To: s924723 ----- Transcript of session follows ----- >>> DATA <<< 554 ... 550 Host unknown (Authoritative answer from name server) 554 Wouter@alt.let.uva.nl... Service unavailable ----- Unsent message follows ----- Received: by minyos.xx.rmit.OZ.AU Date: Sat, 10 Jul 93 12:16:30 EST From: s924723 (Son Huu Le) Message-Id: <9307100216.24669@minyos.xx.rmit.OZ.AU> To: Wouter@alt.let.uva.nl Subject: Slow_E Okay. Here's the slow E port of boyerm.c - It's been stripped of the non-essential routines and has a few features hard-coded (laziness, I know :) Basically it searches my Aminet catalogue for Toolmanager2.0 (there's only one entry) using Boyer-Moore string search. I compiled practically the same code in C format (of coz) using SAS/C v6.3 and the results were something like 30secs for SAS/C and 60 secs for E. Any help much appreciated. Son Le PS. Another idea would be to include a set of standard functions with E for basic functions like atoi, islower, etc. And also about the .o files, how about mimicking c.o with e.o? /* boyerm - find lines containing given constant string */ /* A. Kotanski, 1989 */ /* For explanation of the method see the following articles : */ /* R.S.Boyer, J.S. Moore, "A fast string search algorithm" */ /* Comm. ACM 20, 762-772 (1977) */ /* D.E.Knuth, J.H.Morris and V.B.Pratt */ /* "Fast pattern matching in strings" */ /* SIAM J. Computing, 6, 323-350 (1977)*/ CONST UPPER=255 DEF except = 0, number = 0, ppos = 1, patlen, stringlen, c, delta0[128]:STRING, delta2[80]:STRING, string[256]:STRING, pat[80]:STRING, f[80]:STRING PROC max(a,b) RETURN (IF a>b THEN a ELSE b) PROC min(a,b) RETURN (IF a>b THEN b ELSE a) PROC boyer() DEF i, j IF ( (i := patlen + ppos - 2) >= stringlen ) THEN RETURN 0 LOOP WHILE ( (i := i + delta0[string[i]]) < stringlen ) DO NOP IF ( i < UPPER ) THEN RETURN 0 i := i - (UPPER + 1) IF ( (j := patlen - 2) < 0 ) THEN RETURN (i + 2) WHILE ( string[i] = pat[j] ) i-- IF ( j-- < 0 ) THEN RETURN (i + 2) ENDWHILE IF ( string[i] = pat[patlen-1] ) i := i + delta2[j] ELSE i := i + max(delta0[string[i]], delta2[j]) ENDIF IF CtrlC()=TRUE THEN Raise(0) ENDLOOP ENDPROC PROC main() HANDLE /* find pattern from first argument */ DEF lineno = 0, match, i, t, fh IF (fh := Open (arg,OLDFILE))=NIL WriteF('Open error\n') CleanUp(0) ENDIF StrCopy(pat,'ToolManager2.0',ALL) patlen := StrLen(pat) FOR i := 0 TO 127 DO delta0[i] := patlen FOR i := 0 TO patlen-1 DO delta0[pat[i]] := patlen - i - 1 delta0[pat[patlen - 1]] := UPPER FOR i := 0 TO patlen-1 DO delta2[i] := patlen + patlen - i - 1 i := patlen - 1 t := patlen WHILE ( i >= 0 ) f[i] := t WHILE ( ( t < patlen ) AND ( pat[i] <> pat[t] ) ) delta2[t] := min(delta2[t], patlen-i-1) t := f[t] ENDWHILE t-- i-- ENDWHILE FOR i := 0 TO t DO delta2[i] := min(delta2[i], patlen + t - i) WHILE Fgets(fh, string, 256) lineno++ stringlen := StrLen(string) match := boyer() IF match THEN WriteF('\s',string) ENDWHILE Raise(0) EXCEPT IF fh THEN Close(fh) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Sun, 11 Jul 93 09:40:51 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Sun, 11 Jul 93 09:40:51 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oF2pk-00016tC; Sun, 11 Jul 93 07:56 PDT Message-Id: Date: 11 Jul 93 09:52:00 CST From: "Barry D. Wills" To: "amigae" Subject: Processor Ids Here's something I cooked up to help my startup-sequence in deciding which startup to run based on the processor I booted with (Derringer-030 uses 68000 and 68030). It also checks for FPU and MMU just for the heck of it. ----- CUT HERE ---------------------------------------------------------------- /* IdentifyProcessors - For AmigaDOS V1.3 (and higher?) Author: Barry Wills Program to place the values of the current processor ids in the environment. The following environment variables will receive the appropriate string values, and can be used in scripts: $CPU - 68040 68030 68020 68010 68000 $FPU - 68882 68881 NIL (usage: IF "$FPU" eq "") $MMU - 68851 NIL (usage: IF "$MMU" eq "") Configuration Notes (add your config and results here) ~~~~~~~~~~~~~~~~~~~ KS1.3: - 68000/""/"" == correct values reflected 68030/68881/68851 == (Derringer-030) MMU not recognized Rights and Restrictions ~~~~~~~~~~~~~~~~~~~~~~~ This program is hereby placed in the public domain. The reader/user of this program assumes all risk. */ MODULE 'exec/types' MODULE 'exec/execbase' MODULE 'dos/dos' DEF ver = NIL PROC main () DEF execBase : PTR TO execbase, attnFlag, processor, fh ver := 'VER$: PROCs V1.0 (10JUL93)' execBase := execbase attnFlag := execBase.attnflags /*-----------------*/ /* Check CPU type. */ /*-----------------*/ IF attnFlag AND AFF_68040 processor := '68040' ELSEIF attnFlag AND AFF_68030 processor := '68030' ELSEIF attnFlag AND AFF_68020 processor := '68020' ELSEIF attnFlag AND AFF_68010 processor := '68010' ELSE processor := '68000' ENDIF IF (fh := Open ('ENV:CPU', NEWFILE)) = NIL THEN RETURN RETURN_FAIL Write (fh, processor, 5) Close (fh) /*----------------*/ /* Check for FPU. */ /*----------------*/ IF attnFlag AND AFF_68881 processor := '68881' ELSEIF attnFlag AND AFF_68882 processor := '68882' ELSE processor := NIL ENDIF IF (fh := Open ('ENV:FPU', NEWFILE)) = NIL THEN RETURN RETURN_FAIL IF processor THEN Write(fh, processor, 5) Close (fh) /*----------------*/ /* Check for MMU. */ /*----------------*/ IF attnFlag AND AFF_68851_MMU processor := '68851' ELSE processor := NIL ENDIF IF (fh := Open ('ENV:MMU', NEWFILE)) = NIL THEN RETURN RETURN_FAIL IF processor THEN Write (fh, processor, 5) Close (fh) ENDPROC 0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!minyos.xx.rmit.OZ.AU!s924723 Mon, 12 Jul 93 05:41:08 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Mon, 12 Jul 93 05:41:08 PST Received: from peladon.rmit.OZ.AU by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oFN78-00007WC; Mon, 12 Jul 93 05:36 PDT Received: from minyos.xx.rmit.OZ.AU by peladon.rmit.OZ.AU with SMTP id AA19977 (5.65c/IDA-1.4.4 for ); Mon, 12 Jul 1993 22:36:05 +1000 Received: by minyos.xx.rmit.OZ.AU Date: Mon, 12 Jul 93 22:35:50 EST Message-Id: <9307121235.21423@minyos.xx.rmit.OZ.AU> From: s924723@minyos.xx.rmit.OZ.AU (Son Huu Le) To: amigae@bkhouse.cts.com Subject: Optimising_E (Profiler output and drool deleted :) Boyerm.e probably suffered from a low buffer size input, which reminds me, what are the proper arguments for the DOS function SetVBuf()? The DOS manual says it accepts 4 arguments, E only accepts 3!? Okay, so the boyerm.e example wasn't a very good as it relied on DOS calls, but I still say E is slower and would benefit from a good optimizer. While I was debugging my programs, I noticed that E always(?) used MOVE.L x(A5),D0 for variable storage/retrieval. In a tight loop, a MOVE.L x(AN),D0 will cost more cycle time than a MOVE.L D1,D0. Since E doesn't touch the other data registers often, it would help speed time greatly if you could use them. For a better example(?) I coded the following short |ittle program, which is small and relies on no external calls (except for outputting of result at the end which btw, if left out under SAS/C, makes the program run under 1 sec - clever optimiser :) E: PROC main() DEF x=0, y=0 WHILE x<500000 x++ y:=y+x ENDWHILE WriteF('\d\n',y) ENDPROC Disassembly of main loop: loop: MOVE.L -4(A5),D0 CMPI.L #500000,D0 BGE out MOVE.L -4(A5),D0 ; What's this for?! (; ADDQ.L #1,-4(A5) MOVE.L -8(A5),D0 ADD.L -4(A5),D0 MOVE.L D0,-8(A5) BRA loop C: #include void main() { int x=0, y=0; /* Direct port - bare minimum change */ while (x<500000) { x++; y=y+x; } printf("%d\n",y); } Disassembly of main loop: loop: ADDQ.L #1,D7 ADD.L D7,D6 ; SAS/C might be expensive, but look at this! CMPI.L #500000,D7 BLT.S loop Time results: ~~~~~~~~~~~~ (On an Amiga 2000 with 2mb fast, 1mb chip) (Faster machines might need to alter the counter for meaningful results) 11.STAT-RAM:> timex test_c 446198416 Ticks:429 -> Secs:8.58 -> Time:0h0m8s 11.STAT-RAM:> timex test_e 446198416 Ticks:1224 -> Secs:24.48 -> Time:0h0m24s Although I don't expect E to outperform a commercial C product, using spare data registers would increase E's performance tremendously. One last suggestion.. how about making some E functions (such as WriteF) more assembling friendly, so you can use certain E functions in the middle of an assembly code? ie. it uses only the upper data/address registers (4-7) and leaves the lower ones intact. Regards.. Son Le PS. Wouter, your address bounced. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Mon, 19 Jul 93 21:54:48 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Mon, 19 Jul 93 21:54:48 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oI7sm-0000pwC; Mon, 19 Jul 93 19:56 PDT Message-Id: Date: 19 Jul 93 21:54:00 CST From: "Barry D. Wills" To: "amigae" Subject: re: Amos to E /* In answer to Stephane's Amos2E questions. */ PROC main () DEF s [2] : STRING, c = "A", cChar = NIL : PTR TO CHAR, iChar = NIL : PTR TO INT, lChar = NIL : PTR TO LONG /* >> In Amos: A$=INKEY$ is to get a keyboard character. Unfortunately, Inp() *waits* for the RETURN key. If I have time maybe I'll try to work up an IDCMP thang; don't know if that would be the the best solution. Meanwhile maybe someone else can pull this one out of the air. */ /* >> Month$=Str(12) converts 12 as a string. */ StringF (s, '\d', 12) WriteF ('1) Month=\s\n', s) /* >> ASCII$=Asc(a) converts a into an ASCII value. */ WriteF ('2) Asc(c)=\d\n', c) /* >> A$=CHR$(27) convert a ASCII value into a character. */ WriteF ('3) CHR$(c)=\c\n', c) /* Characters are similar to those in C. It's how you treat them that */ /* makes the difference. Note the following awesome feature: */ c := "FRED" WriteF ('4a) 32-bit character! But be careful what you want:\n' + ' CHR$(c) = \c\n' + ' (no equiv)(c) = \d\n', c, c) /* And lastly...a little of Wouter's polymorphism. */ cChar := iChar := lChar := 'FRED' WriteF ('4b) What WriteF() thinks about 32-bit characters:\n' + ' cChar[]=\c\n' + ' iChar[]=\c\n' + ' lChar[]=\c\n', cChar[], iChar[], lChar[]) WriteF (' What E really thinks about 32-bit characters:\n' + ' cChar[]=\s, Char(cChar)=\d[10], cChar[]=\d[10]\n' + ' iChar[]=\s, Int(iChar) =\d[10], iChar[]=\d[10]\n' + ' lChar[]=\s, Long(lChar)=\d[10], lChar[]=\d[10]\n', IF cChar[] = "F" THEN 'F' ELSE '*', Char (cChar), cChar[], IF iChar[] = "FR" THEN 'FR' ELSE '*', Int (iChar), iChar[], IF lChar[] = "FRED" THEN 'FRED' ELSE '*', Long (lChar), lChar[]) /*===== >from Amos<->E like he did with C<->E it would be very usefull. And I need the >commands how to get or put values from gadtools gadgets. Sorry, Stephane. KS1.3 is too dumb for gadtools :( I got carried away, so you got more than you asked for. Hope I answered your other questions thoroughly. Later. -- Barry =====*/ ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!genie.geis.com!g.beasley2 Sat, 24 Jul 93 07:44:11 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Sat, 24 Jul 93 07:44:11 PST Received: from relay2.geis.com by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oJk7I-0000WUC; Sat, 24 Jul 93 06:58 PDT Received: by relay2.geis.com (1.37.109.4/15.6) id AA08903; Sat, 24 Jul 93 14:58:57 +0100 Message-Id: <9307241358.AA08903@relay2.geis.com> Date: Sat, 24 Jul 93 14:39:00 BST X-Genie-Id: 8476808 X-Genie-From: G.BEASLEY2 From: g.beasley2@genie.geis.com To: amigae@bkhouse.cts.com Subject: Re: Armageddon in E! Reply: Item #4395553 from POLITIKILL@CUP.PORTAL.COM@INET# Here is a little goodie that someone posted in the AmigaNet:Programming conference. I am not sure if it has been posted here yet, but it works well some here it is: MODULE 'dos/dos' PROC readStr(handle, buffer) DEF bytes, size, eof=FALSE bytes:=Read(handle, buffer, StrMax(buffer)) size:=bytes IF InStr(buffer, '\n', 0) > -1 Seek(handle, -(bytes - InStr(buffer, '\n', 0)-1), OFFSET_CURRENT) bytes:=InStr(buffer, '\n', 0) ELSE IF size < StrMax(buffer) THEN eof:=TRUE ENDIF buffer[bytes]:=0 ENDPROC eof This is a replacement for v2.1b's ReadStr() function. This one is generally 4 to 8 times faster and functions identically to E's. Check it out. BEANMAN... %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Mon, 26 Jul 93 15:51:18 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Mon, 26 Jul 93 15:51:18 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oKZh9-0000aRC; Mon, 26 Jul 93 14:02 PDT Message-Id: Date: 26 Jul 93 16:00:00 CST From: "Barry D. Wills" To: "amigae" Subject: re: request for 2d arrays --- CUT HERE ------------------------------------------------------------- /*========================================================================*/ /* */ /* 2D array in E. It's as easy as this. */ /* */ /* User components are: */ /* dd_arrayType and the components therein */ /* dd_dim (), create the 2d array */ /* dd_set (), put a value into an element of the 2d array */ /* dd_get (), get a value from an element of the 2d array */ /* */ /* The other components of this module should not be useful. */ /* */ /*========================================================================*/ RAISE 0 IF CtrlC () = TRUE /* You should define an error trap for New()=NIL. */ OBJECT dd_arrayType iUBound, jUBound, elSize, elements ENDOBJECT /* These are global to speed up array access. */ DEF dd_ar : PTR TO dd_arrayType, dd_charPtr : PTR TO CHAR, dd_intPtr : PTR TO INT, dd_longPtr : PTR TO LONG, dd_elSize PROC dd_dim (i, j, elSize) IF (elSize <> 1) AND (elSize <> 2) AND (elSize <> 4) THEN Raise ('Invalid element size.') dd_ar := New (SIZEOF dd_arrayType) dd_ar.elements := New (i*j*elSize) dd_ar.iUBound := i - 1 dd_ar.jUBound := j - 1 dd_ar.elSize := elSize ENDPROC dd_ar PROC checkBounds (i, j) /* dd_ar already points to array when this is called. */ IF (i < 0) OR (i > dd_ar.iUBound) THEN Raise ('"i" subscript out of bounds.') IF (j < 0) OR (j > dd_ar.jUBound) THEN Raise ('"j" subscript out of bounds.') ENDPROC TRUE PROC dd_offset (i, j) RETURN ((i * (dd_ar.jUBound + 1) + j) * dd_elSize) PROC dd_set (array, i, j, value) dd_ar := array checkBounds (i, j) dd_elSize := dd_ar.elSize SELECT dd_elSize CASE 1 dd_charPtr := dd_ar.elements dd_charPtr [dd_offset (i, j)] := value CASE 2 dd_intPtr := dd_ar.elements dd_intPtr [dd_offset (i, j)] := value CASE 4 dd_longPtr := dd_ar.elements dd_longPtr [dd_offset (i, j)] := value ENDSELECT ENDPROC PROC dd_get (array, i, j) DEF value dd_ar := array checkBounds (i, j) dd_elSize := dd_ar.elSize SELECT dd_elSize CASE 1 dd_charPtr := dd_ar.elements value := dd_charPtr [dd_offset (i, j)] CASE 2 dd_intPtr := dd_ar.elements value := dd_intPtr [dd_offset (i, j)] CASE 3 dd_longPtr := dd_ar.elements value := dd_longPtr [dd_offset (i, j)] ENDSELECT ENDPROC value PROC dd_dispose (array) dd_ar := array Dispose (dd_ar.elements) Dispose (dd_ar) ENDPROC PROC main () HANDLE DEF myArray : PTR TO dd_arrayType, /* Only needs to PTR TO if you want */ /* access to the OBJECT fields. */ xDim = 4, yDim = 4, /* x and y dimensions. */ sizeofChar = 1, /* Just for readability. */ i, j, val = 0 /* Loop counters. */ /* Create the array. */ myArray := dd_dim (xDim, yDim, sizeofChar) /* Put stuff in each element. */ FOR i := 0 TO myArray.iUBound FOR j := 0 TO myArray.jUBound CtrlC() dd_set (myArray, i, j, val++) ENDFOR ENDFOR /* Get it back out. */ FOR i := 0 TO myArray.iUBound FOR j := 0 TO myArray.jUBound WriteF ('myArray [\d,\d]=\d\n', i, j, dd_get (myArray, i, j)) ENDFOR ENDFOR /* Cleanup. */ dd_dispose (myArray) EXCEPT IF exception THEN WriteF ('\s\n', exception) CleanUp (exception) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Wed, 4 Aug 93 05:45:57 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Wed, 4 Aug 93 05:45:57 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oNiAN-0000OSC; Wed, 4 Aug 93 05:42 PDT Message-Id: Date: 4 Aug 93 07:21:00 CST From: "Barry D. Wills" To: "amigae" Subject: re: ReadArgs() Hi, Dan. Sorry about the slow reply. In response to your message titled "ReadArgs():" > Ok, my question is about the readargs.e example. Is it correct, and if >so, how does it work? None of the parameters I've given it return anything >but "Bad Args!" The source is short, so could someone please post it, >and tell exactly what each line does, as well as some sample calls to it? >I'd really appreciate it.. Yes, it does work. Your problem lies in the obscurity of the command template, a feature of the Amiga which is by no means friendly. Here is a blow-by-blow: /* Use readargs() to get parameters instead of using the string 'arg'. This is more convenient if more than one arg is needed. Uses kick 2.0 */ OPT OSVERSION=37 /*-- You must be using KS 2,0+ --*/ PROC main() DEF myargs:PTR TO LONG,rdargs /*-- PTR TO LONG is used to access an array of LONG, also know in E as a --*/ /*-- List. rdargs is a generic pointer which holds an address returned --*/ /*-- by ReadArgs(), the purpose of which I am unsure except that it --*/ /*-- indicates success. Anyone else care to comment? --*/ myargs:=[0,0,0] /*-- One way (the easiest) of allocating and initializing a List variable. --*/ /*-- This is where ReadArgs() is going to put the command-line args for --*/ /*-- you to get as you please. --*/ IF rdargs:=ReadArgs('UNIT/N,DISK/A,NEW/S',myargs,NIL) /*-- Attempt to get the command-line args in the format specified by the /*-- template string. The tags after each arg's name tells you what kind /*-- arg it is and how/when it must be used: /*-- /N means a number is expected; /*-- /A means arg must always be provided; /*-- /K means the keyword must be given if the argument is provided, /*-- e.g., if DISK/A were changed to DISK/A/K then you would need to /*-- enter "DISK somestring" on the command-line; /*-- /S means arg is a switch; this is probably the arg that was giving /*-- you the problem; here you must type the arg name to set the /*-- switch to TRUE or omit it to set the switch to FALSE; /*-- /M means multiple arguments are accepted; these must always precede /*-- all other args; I'm not sure if having two multiple-args /*-- parameters in a command-line is legal or practical; /*-- = allows for synonyms/abbreviations to be used, e.g., replacing /*-- NEW/S with NEW=N/S would allow you to use N on the command- /*-- line in place of keyword NEW. /*-- So the following usages are valid for this program: /*-- readargs 1 mydisk new; "new" is a switch, ON here /*-- readargs 0 mydisk ; .... OFF here WriteF('UNIT=\d\n',Long(myargs[0])) /* integer */ WriteF('DISK=\s\n',myargs[1]) /* string */ WriteF('NEW=\d\n',myargs[2]) /* boolean */ FreeArgs(rdargs) /*-- Evidently ReadArgs() does some things we need to clean up. --*/ ELSE WriteF('Bad Args!\n') ENDIF ENDPROC Hope this helped to clear some things up. Later. -- Barry %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Sat, 14 Aug 93 10:42:10 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Sat, 14 Aug 93 10:42:10 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oRNm2-00006kC; Sat, 14 Aug 93 08:44 PDT Message-Id: Date: 14 Aug 93 10:43:00 CST From: "Barry D. Wills" To: "amigae" Subject: BusyPointer.e /* SetPointer() demo. Compile and run. Click left mouse button in window to see the Busy Pointer. Click the right mouse button in window to quit. Eric, I have modified Dave's example to make the function that sets the pointer a little more reusable. In order for it to work right some things must be considered: 1. In order for the pointer size calculation to work, pointerImage must be a List of INT. Since E variables are even-byte aligned, and the pointer data are paired, we can use CopyMemQuick(). This is a bonus, but the gain is not significant with this small data size. 2. If you don't open your own window, then (I think) you must go through a lot of hassle to get a pointer to the Workbench window. If anyone knows differently, please let us know. 3. You have to know a little about images in order to code them. There are some utils out there to capture the pointer to C source code, or convert a brush to C source code. You'll have to hunt for those. If you want a tutorial on how to construct image data, I might could cook something up for you. RKRMs discuss it, but rather tersely. */ MODULE 'exec/memory' MODULE 'intuition/intuition' MODULE 'intuition/screens' CONST SIZEOF_INT = 2 PROC mySetPointer (win : PTR TO window, pointerImage : PTR TO INT) /* NOTE: pointerImage CAN reside in any type of MEM. */ DEF chipMem = NIL, sizePointer = 0 sizePointer := ListLen (pointerImage) * SIZEOF_INT IF chipMem := AllocMem (sizePointer, MEMF_CHIP) CopyMemQuick (pointerImage, chipMem, sizePointer) SetPointer (win, chipMem, 16, 16, -6, 0) /*---------------------------------------*/ /*-- DON'T do this!!! --*/ /*-- (SetPointer() does it for you.) --*/ /*-- --*/ /* FreeMem (pointerImage, sizePointer) */ /*-- --*/ /*---------------------------------------*/ ENDIF ENDPROC PROC main () DEF myWin = NIL, busyPointer = NIL : PTR TO INT IF myWin := OpenW (20, 20, 100, 100, 0, 0, 'BusyPointer', NIL, WBENCHSCREEN, NIL) busyPointer := [$0000, $0000, /* Reserved, must be NULL */ $0400, $07c0, $0000, $07c0, $0100, $0380, $0000, $07e0, $07c0, $1ff8, $1ff0, $3fec, $3ff8, $7fde, $3ff8, $7fbe, $7ffc, $ff7f, $7efc, $ffff, $7ffc, $ffff, $3ff8, $7ffe, $3ff8, $7ffe, $1ff0, $3ffc, $07c0, $1ff8, $0000, $07e0, $0000, $0000] : INT /* Reserved, must be NULL */ mySetPointer (myWin, busyPointer) WHILE Mouse () <> 2 DO WaitTOF () CloseW (myWin) ENDIF ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Thu, 19 Aug 93 08:32:20 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Thu, 19 Aug 93 08:32:20 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #15) id m0oSzLI-0000RJC; Wed, 18 Aug 93 19:03 PDT Message-Id: Date: 18 Aug 93 21:00:00 CST From: "Barry D. Wills" To: "amigae" Subject: BusyPointer.e (update) /* SetPointer() demo. Compile and run. Click left mouse button in window to see the Busy Pointer. Click the right mouse button in window to quit. The previous version did not free memory properly (thanks to Dave for pointing that out!) I made the mistaken assumption that once I gave the image to the window the window would free the image for me. WRONG! You have to hang onto the image and free it after closing the window. In order for it to work right some things must be considered: 1. In order for the pointer size calculation to work, pointerImage must be a List of INT. Since E variables are even-byte aligned, and the pointer data are paired, we can use CopyMemQuick(). This is a bonus, but the gain is not significant with this small data size. 2. If you don't open your own window, then (I think) you must go through a lot of hassle to get a pointer to the Workbench window. If anyone knows differently, please let us know. 3. You have to know a little about images in order to code them. There are some utils out there to capture the pointer to C source code, or convert a brush to C source code. You'll have to hunt for those. (Dave, how did you do it?) If you want a tutorial on how to construct image data, I might could cook something up for you. RKRMs discuss it, but rather tersely. 4. You must save the address returned by setPointer(), then call freePointer() after closing the window. 5. You can reset the pointer image to the intuition default by calling ClearPointer(win). If you are not closing the window, you *must* do "ClearPointer(); freePointer()" in that order. If you reverse the order, your task will crash if your window is active or becomes activated in between the calls. Thanks again, Dave, for your replies (and for the "private data" suggestion. :-) */ MODULE 'exec/memory' MODULE 'intuition/intuition' MODULE 'intuition/screens' CONST SIZEOF_INT = 2 PROC setPointer (win : PTR TO window, pointerImage : PTR TO INT) /* NOTE: pointerImage CAN reside in any type of MEM. */ DEF chipMem = NIL, sizeofPointer = 0 sizeofPointer := ListLen (pointerImage) * SIZEOF_INT IF chipMem := AllocMem (sizeofPointer + 4, MEMF_CHIP) PutLong (chipMem, sizeofPointer) chipMem := chipMem + 4 CopyMemQuick (pointerImage, chipMem, sizeofPointer) SetPointer (win, chipMem, 16, 16, -6, 0) ENDIF ENDPROC chipMem PROC freePointer (pointerImage : PTR TO INT) pointerImage := pointerImage - 4 FreeMem (pointerImage, ^pointerImage + 4) ENDPROC PROC main () DEF myWin = NIL, busyPointerData = NIL : PTR TO INT, busyPointer = NIL IF myWin := OpenW (20, 20, 100, 100, 0, 0, 'BusyPointer', NIL, WBENCHSCREEN, NIL) busyPointerData := [$0000, $0000, /* Reserved, must be NULL */ $0400, $07c0, $0000, $07c0, $0100, $0380, $0000, $07e0, $07c0, $1ff8, $1ff0, $3fec, $3ff8, $7fde, $3ff8, $7fbe, $7ffc, $ff7f, $7efc, $ffff, $7ffc, $ffff, $3ff8, $7ffe, $3ff8, $7ffe, $1ff0, $3ffc, $07c0, $1ff8, $0000, $07e0, $0000, $0000] : INT /* Reserved, must be NULL */ busyPointer := setPointer (myWin, busyPointerData) WHILE Mouse () <> 2 DO WaitTOF () CloseW (myWin) freePointer (busyPointer) ENDIF ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From crash!kirk.safb.af.mil!BWILLS Tue, 31 Aug 93 02:36:28 PST Received: by bkhouse.cts.com (V1.16/Amiga) id AA00000; Tue, 31 Aug 93 02:36:28 PST Received: from kirk.safb.af.mil by crash.cts.com with smtp (Smail3.1.28.1 #18) id m0oXEOe-0000XEC; Mon, 30 Aug 93 11:56 PDT Message-Id: Date: 30 Aug 93 13:54:00 CST From: "Barry D. Wills" To: "amigae" Subject: serial test for serlib.library [For Vinny (sorry, lost your address!):] Here is the supplied serial test program sert.e, ported to E just for you :-) Enjoy, hope this helps. -- Barry ---8<---8<---8<---------------------------------------------------------------- MODULE '/serlib', '/libraries/serlib', 'devices/serial' DEF ss : serstatus, sld : PTR TO serlibdata, buf [2048] : ARRAY OF CHAR, len PROC main () serlibbase := OpenLibrary ('serlib.library', 3) IF (sld := OpenSerial ('serial.device', 0, 2400, 8, 1, (SERF_7WIRE + SERF_SHARED))) = NIL WriteF ('Couldn''t open...\n') ELSE ChangeData (sld, 2400, 8, 1, (SERF_RAD_BOOGIE + SERF_7WIRE + SERF_SHARED)) WriteSer (sld, 'AT$\r', 4) Delay (20) GetStatus (sld, ss) WriteF ('Bytes unread: \d\nStatus: \h\n', ss.unread, ss.status) Delay (20) WriteSer (sld, ' ', 1) Delay (20) GetStatus (sld, ss) WriteF ('Bytes unread: \d\nStatus: \h\n',ss.unread,ss.status) loop: len := ReadSer (sld, buf, 2040) buf [len] := "\0" WriteF ('\s', buf) GetStatus (sld, ss) IF (ss.unread > 0) THEN JUMP loop CloseSerial (sld) ENDIF CloseLibrary (serlibbase) ENDPROC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%