From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,c59de49f7d99d0b5,start X-Google-Attributes: gid103376,public From: "Ramsey Khair" Subject: Difficulty compiling ada program! Date: 1998/07/14 Message-ID: <900407099.23331.0.nnrp-10.c2de523e@news.demon.co.uk> X-Deja-AN: 371280852 X-NNTP-Posting-Host: citycom.demon.co.uk:194.222.82.62 X-Trace: news.demon.co.uk 900407099 nnrp-10:23331 NO-IDENT citycom.demon.co.uk:194.222.82.62 X-MimeOLE: Produced By Microsoft MimeOLE V4.72.3007.0 Newsgroups: comp.lang.ada X-Complaints-To: abuse@demon.net Date: 1998-07-14T00:00:00+00:00 List-Id: Hi, Can sombody please try compiling this source code as it keep saying "End of file expected" you have spilt the files where it says, if anybody has any luck please let me know! Ramsey --:::::::::: --abstract.412 --:::::::::: --ASSET_A_412: Event Set Manager Package -- This package allows for managing pending events for a simulation model. --There are functions to get a new event (either from the free list or to --allocate a new event), to free an event, to schedule a future event to enter --the event set, and to get the next event from the event set. Event records are --used to hold all information about a pending event in a simulation model, --including the time of the event, where it is to happen, and what will happen. --Event records are always dynamically allocated and manipulated with pointers. --In many simulation models, their number will vary dynamically during the life --of the model. All aspects of event-set structure are hidden; conceptually, --the event set may be viewed as a linked list ordered by the time at which --events are scheduled to happen. For the sake of efficiency, a more complex --data structure, called a splay tree, is used. -- The generic pending event set manager is a transliteration of a Pascal --version Doug Jones wrote some years ago, properly packaged in Ada style to --enforce information hiding. The same Pascal source has been transliterated --into C by David Brower, and his C code was used as the basis for a C++ --version that is now in the GNU C++ standard distribution. The Pascal --code has been bug free for a number of years now, and has been widely --used; the C code had only one bug in its first release, and it has been --bug free for years. --:::::::::: --eventset.ada --:::::::::: -- package GENERIC_EVENT_HANDLER is a generic event set management package. -- Written by Douglas Jones. -- Delete and Splay operations added by Bindhu Radhadevi. -- The implementation used here is based on the splay-tree abstract data type, -- as implemented in Pascal and tested in: -- An Empirical Comparison of Priority-Queue and Event-Set Implementations, -- by Douglas W. Jones, Comm. ACM 29, 4 (Apr. 1986) 300-311. -- The basic splay tree algorithms were originally presented in: -- Self Adjusting Binary Trees, -- by D. D. Sleator and R. E. Tarjan, Proc. ACM SIGACT Symposium on Theory -- of Computing (Boston, Apr 1983) 235-245. generic type AUX_TYPE is private; -- The type of the application dependent field of an event record. -- Usually, this is a record type. type TIME_TYPE is private; with function ">"(U, V: TIME_TYPE) return BOOLEAN is <>; -- The type of the time field of an event-record, and its ordering -- operator. Ordinarily, this will be a numeric type, and the -- comparison operator will be found implicitly and not explicitly -- passed as a generic parameter. package GENERIC_EVENT_HANDLER is type EVENT; -- Event records are used to hold all information about a pending -- event in a simulation model, including the time of the event -- where it is to happen, and what will happen. type EVENT_REF is access EVENT; -- Event records are always dynamically allocated and manipulated -- with pointers. In many simulation models, their number will -- vary dynamically during the life of the model. type LINK_FIELDS is limited private; -- All aspects of event-set structure are hidden here; conceptually, -- the event set may be viewed as a linked list ordered by the time -- at which events are scheduled to happen. For the sake of -- efficiency, a more complex data structure is used. type EVENT is record -- Private fields: LINK: LINK_FIELDS; -- Public fields needed by EVENT_HANDLER: TIME: TIME_TYPE; -- other fields may be added here (as a generic parameter): AUX: AUX_TYPE; end record; function EMPTY return BOOLEAN; -- Test to see if the event-set is empty. function NEW_EVENT return EVENT_REF; -- Get an event-record from the free-list or allocate a new one. -- May raise STORAGE_ERROR if memory is exhausted. procedure FREE_EVENT( N: in out EVENT_REF ); -- Deallocate an event-record, adding it to the free-list. -- May raise CONSTRAINT_ERROR if N is null. -- May raise CONSTRAINT_ERROR if N is in the free-list or event-set. procedure SCHEDULE( N: in EVENT_REF ); -- Add the event N to the event-set. -- May raise CONSTRAINT_ERROR if N is null. -- May raise CONSTRAINT_ERROR if N is in the free-list or event-set. procedure GET_NEXT( N: out EVENT_REF ); -- Remove and return an event from the event-set. The event -- returned will be one of the events that has a TIME field less -- than or equal to the time fields of all other events in the -- event-set. procedure DELETE( N: in EVENT_REF); -- Delete an event N from the event set. -- May raise CONSTRAINT_ERROR if N is not in event set. EVENT_SET_EMPTY: exception; -- raised by GET_NEXT on an empty event set. private -- The data structures defined here are specific to the splay-tree -- implementation and may need to be changed for other implementations. type LINK_FIELDS is record LEFT: EVENT_REF; -- Left child of the event record in the event-set. -- Successor pointer for events in the free-list. -- For debugging purposes only, X.LEFT = X indicates an event -- that is outside the free-list or event-set. RIGHT: EVENT_REF; -- Right child of event record in the event-set. UP: EVENT_REF; -- Parent of event record in the event-set. end record; end GENERIC_EVENT_HANDLER; package body GENERIC_EVENT_HANDLER is EVENT_SET: EVENT_REF := null; -- This is the root of the binary tree representing the event-set. FREE_LIST: EVENT_REF := null; -- This is the head of the linked list holding free EVENT records. DEBUG: constant BOOLEAN := TRUE; -- Controls runtime checks on preconditions to operations. Set to -- false for the same reason you would use the pragma SUPPRESS. -- This is included on the assumption that the compiler will remove -- dead code if DEBUG is false. function EMPTY return BOOLEAN is begin return EVENT_SET = null; end EMPTY; function NEW_EVENT return EVENT_REF is N: EVENT_REF; begin if FREE_LIST = null then N := new EVENT; else N := FREE_LIST; FREE_LIST := FREE_LIST.LINK.LEFT; end if; if DEBUG then N.LINK.LEFT := N; -- flag event as being outside the free list end if; return N; end NEW_EVENT; procedure FREE_EVENT( N: in out EVENT_REF ) is begin if DEBUG then -- assertions if N = null then raise CONSTRAINT_ERROR; end if; -- N must be an event record if N.LINK.LEFT /= N then raise CONSTRAINT_ERROR; end if; -- N must be outside the event-set end if; N.LINK.LEFT := FREE_LIST; FREE_LIST := N; end FREE_EVENT; procedure SCHEDULE( N: in EVENT_REF ) is LEFT: EVENT_REF; -- the rightmost event in the left tree RIGHT: EVENT_REF; -- the leftmost event in the right tree NEXT: EVENT_REF; -- the root of that part of the tree not yet split TEMP: EVENT_REF; TIME: TIME_TYPE; -- the time of event N begin if DEBUG then -- assertions if N = null then raise CONSTRAINT_ERROR; end if; -- N must be an event record if N.LINK.LEFT /= N then raise CONSTRAINT_ERROR; end if; -- N must be outside the event-set end if; N.LINK.UP := null; NEXT := EVENT_SET; EVENT_SET := N; if NEXT = null then -- trivial schedule operation N.LINK.LEFT := null; N.LINK.RIGHT := null; return; else -- difficult schedule operation TIME := N.TIME; LEFT := N; RIGHT := N; -- N's left and right children will hold the right and left -- splayed trees resulting from splitting NEXT around TIME, -- but note that the left and right children will be reversed if NEXT.TIME > TIME then goto WALK_LEFT; end if; <> -- assert NEXT.TIME <= TIME loop -- walk to the right in the left tree TEMP := NEXT.LINK.RIGHT; if TEMP = null then LEFT.LINK.RIGHT := NEXT; NEXT.LINK.UP := LEFT; RIGHT.LINK.LEFT := null; goto END_WALK; -- job done, entire tree is split end if; if TEMP.TIME > TIME then LEFT.LINK.RIGHT := NEXT; NEXT.LINK.UP := LEFT; LEFT := NEXT; NEXT := TEMP; goto WALK_LEFT; -- change sides end if; NEXT.LINK.RIGHT := TEMP.LINK.LEFT; if TEMP.LINK.LEFT /= null then TEMP.LINK.LEFT.LINK.UP := NEXT; end if; LEFT.LINK.RIGHT := TEMP; TEMP.LINK.UP := LEFT; TEMP.LINK.LEFT := NEXT; NEXT.LINK.UP := TEMP; LEFT := TEMP; NEXT := TEMP.LINK.RIGHT; if NEXT = NULL then RIGHT.LINK.LEFT := null; goto END_WALK; -- job done, entire tree is split end if; exit when NEXT.TIME > TIME; -- change sides end loop; <> -- assert NEXT.TIME > TIME loop -- walk to the left in the right tree TEMP := NEXT.LINK.LEFT; if TEMP = null then RIGHT.LINK.LEFT := NEXT; NEXT.LINK.UP := RIGHT; LEFT.LINK.RIGHT := null; goto END_WALK; -- job done, entire tree is split end if; if not (TEMP.TIME > TIME) then RIGHT.LINK.LEFT := NEXT; NEXT.LINK.UP := RIGHT; RIGHT := NEXT; NEXT := TEMP; goto WALK_RIGHT; -- change sides end if; NEXT.LINK.LEFT := TEMP.LINK.RIGHT; if TEMP.LINK.RIGHT /= null then TEMP.LINK.RIGHT.LINK.UP := NEXT; end if; RIGHT.LINK.LEFT := TEMP; TEMP.LINK.UP := RIGHT; TEMP.LINK.RIGHT := NEXT; NEXT.LINK.UP := TEMP; RIGHT := TEMP; NEXT := TEMP.LINK.LEFT; if NEXT = null then LEFT.LINK.RIGHT := null; goto END_WALK; -- job done, entire tree is split end if; exit when not (NEXT.TIME > TIME); -- change sides end loop; goto WALK_RIGHT; <> TEMP := N.LINK.LEFT; N.LINK.LEFT := N.LINK.RIGHT; N.LINK.RIGHT := TEMP; return; end if; -- control should never reach this point! raise CONSTRAINT_ERROR; end SCHEDULE; procedure GET_NEXT( N: out EVENT_REF ) is NEXT: EVENT_REF; -- then next event to deal with LEFT: EVENT_REF; -- the left child of NEXT FAR_LEFT: EVENT_REF; -- the left child of LEFT FAR_FAR_LEFT: EVENT_REF; -- the left child of FAR_LEFT begin if EVENT_SET = null then raise EVENT_SET_EMPTY; else NEXT := EVENT_SET; LEFT := NEXT.LINK.LEFT; if LEFT = null then -- trivial case, return the root EVENT_SET := NEXT.LINK.RIGHT; if EVENT_SET /= null then EVENT_SET.LINK.UP := null; end if; if DEBUG then NEXT.LINK.LEFT := NEXT; -- mark event as idle end if; N := NEXT; return; else -- nontrivial case, must find leftmost child of root loop -- NEXT is not it; LEFT is not NIL and might be it FAR_LEFT := LEFT.LINK.LEFT; if FAR_LEFT = null then NEXT.LINK.LEFT := LEFT.LINK.RIGHT; if LEFT.LINK.RIGHT /= null then LEFT.LINK.RIGHT.LINK.UP := NEXT; end if; if DEBUG then LEFT.LINK.LEFT := LEFT; -- mark event as idle end if; N := LEFT; return; end if; -- NEXT and LEFT are not it, FAR_LEFT non-null, could be it FAR_FAR_LEFT := FAR_LEFT.LINK.LEFT; if FAR_FAR_LEFT = null then LEFT.LINK.LEFT := FAR_LEFT.LINK.RIGHT; if FAR_LEFT.LINK.RIGHT /= null then FAR_LEFT.LINK.RIGHT.LINK.UP := LEFT; end if; if DEBUG then FAR_LEFT.LINK.LEFT := FAR_LEFT; -- mark as idle end if; N := FAR_LEFT; return; end if; -- NEXT, LEFT, FAR_LEFT are not null and not it, rotate! NEXT.LINK.LEFT := FAR_LEFT; FAR_LEFT.LINK.UP := NEXT; LEFT.LINK.LEFT := FAR_LEFT.LINK.RIGHT; if FAR_LEFT.LINK.RIGHT /= null then FAR_LEFT.LINK.RIGHT.LINK.UP := LEFT; end if; FAR_LEFT.LINK.RIGHT := LEFT; LEFT.LINK.UP := FAR_LEFT; NEXT := FAR_LEFT; LEFT := FAR_FAR_LEFT; end loop; end if; end if; -- control should never reach this point! raise CONSTRAINT_ERROR; end GET_NEXT; ---- SPLAY is not a visible component of the package, but is ---- only used by DELETE. procedure SPLAY( N: in EVENT_REF) is UP: EVENT_REF; -- points to the event currently being dealt with PREV: EVENT_REF; -- a child of up which has already been dealt with UPUP: EVENT_REF; -- the parent of up UPUPUP: EVENT_REF; -- the grandparent of up LEFT: EVENT_REF; -- the top of the left subtree being built RIGHT: EVENT_REF; -- the top of the right subtree beign built begin LEFT := N.LINK.LEFT; RIGHT := N.LINK.RIGHT; PREV := N; UP := PREV.LINK.UP; WHILE UP /= null loop -- walk up the tree towards the root, splaying all to the left of -- N into the left subtree, all to right into the right subtree UPUP := UP.LINK.UP; if UP.LINK.LEFT = PREV then -- up is to the right of n if UPUP /= null then if UPUP.LINK.LEFT = UP then -- rotate UPUPUP := UPUP.LINK.UP; UPUP.LINK.LEFT := UP.LINK.RIGHT; if UPUP.LINK.LEFT /= null then UPUP.LINK.LEFT.LINK.UP := UPUP; end if; UP.LINK.RIGHT := UPUP; UPUP.LINK.UP := UP; if UPUPUP = null then EVENT_SET := UP; elsif UPUPUP.LINK.LEFT = UPUP then UPUPUP.LINK.LEFT := UP; else UPUPUP.LINK.RIGHT:= UP; end if; UP.LINK.UP := UPUPUP; UPUP := UPUPUP; end if; end if; UP.LINK.LEFT := RIGHT; if RIGHT /= null then RIGHT.LINK.UP := UP; end if; RIGHT := UP; else -- up is to the left of n if UPUP /=null then if UPUP.LINK.RIGHT = UP then -- rotate UPUPUP := UPUP.LINK.UP; UPUP.LINK.RIGHT := UP.LINK.LEFT; if UPUP.LINK.RIGHT /= null then UPUP.LINK.RIGHT.LINK.UP:= UPUP; end if; UP.LINK.LEFT := UPUP; UPUP.LINK.UP := UP; if UPUPUP = null then EVENT_SET := UP; elsif UPUPUP.LINK.RIGHT = UPUP then UPUPUP.LINK.RIGHT := UP; else UPUPUP.LINK.LEFT := UP; end if; UP.LINK.UP := UPUPUP; UPUP := UPUPUP; end if; end if; UP.LINK.RIGHT := LEFT; if LEFT /= null then LEFT.LINK.UP := UP; end if; LEFT := UP; end if; PREV := UP; UP := UPUP; end loop; if EVENT_SET /= PREV then -- either N wasn't in the event set or the event set is corrupt. raise CONSTRAINT_ERROR; end if; N.LINK.LEFT := LEFT; N.LINK.RIGHT := RIGHT; if LEFT /= null then LEFT.LINK.UP := N; end if; if RIGHT /= null then RIGHT.LINK.UP := N; end if; EVENT_SET := N; N.LINK.UP := null; end SPLAY; procedure DELETE( N: in EVENT_REF) is -- N is deleted from EVENT_SET; the resulting splay tree -- has been splayed around its new root, which is the successor of N X: EVENT_REF; begin if DEBUG then -- assertions if N = null then raise CONSTRAINT_ERROR; end if; -- N must be an event record if N.LINK.LEFT = N then raise CONSTRAINT_ERROR; end if; -- N must be in the event-set -- Note! This is a weak assertion -- the exception won't -- be raised if N is in the free list; the raise -- statement in SPLAY will detect that case. end if; SPLAY(N); EVENT_SET := N.LINK.RIGHT; if EVENT_SET /= null then EVENT_SET.LINK.UP := null; GET_NEXT(X); X.LINK.UP := null; X.LINK.LEFT := N.LINK.LEFT; X.LINK.RIGHT := EVENT_SET; if X.LINK.LEFT /= null then X.LINK.LEFT.LINK.UP := X; end if; if X.LINK.RIGHT /= null then X.LINK.RIGHT.LINK.UP := X; end if; EVENT_SET := X; else EVENT_SET := N.LINK.LEFT; if EVENT_SET /= null then EVENT_SET.LINK.UP := null; end if; end if; if DEBUG then N.LINK.LEFT := N; -- flag event as being outside the free list end if; end DELETE; end GENERIC_EVENT_HANDLER; --:::::::::: --testevnt.ada --:::::::::: with TEXT_IO; with GENERIC_EVENT_HANDLER; procedure EVENT_HANDLER_TEST is package EVENT_HANDLER is new GENERIC_EVENT_HANDLER( AUX_TYPE => BOOLEAN, TIME_TYPE => FLOAT ); use EVENT_HANDLER; use TEXT_IO; package INT_I_O is new INTEGER_IO(INTEGER); use INT_I_O; begin TEXT_IO.PUT_LINE( "Event handler test!" ); if not EMPTY then TEXT_IO.PUT_LINE( " -- initialization failure" ); else TEXT_IO.PUT_LINE( " -- initialization success" ); declare -- test 1, see if one event can be put in and gotten back A, B: EVENT_REF; begin A := NEW_EVENT; A.TIME := 0.0; SCHEDULE( A ); if EMPTY then TEXT_IO.PUT_LINE( " -- SCHEDULE failure" ); else GET_NEXT( B ); if A = B then TEXT_IO.PUT_LINE( " -- GET_NEXT got scheduled event" ); else TEXT_IO.PUT_LINE( " -- GET_NEXT failure" ); end if; FREE_EVENT( B ); end if; end; declare -- test 2, see if it works as a FIFO with times in order A: EVENT_REF; begin for I in 1..1000 loop A := NEW_EVENT; A.TIME := FLOAT(I); SCHEDULE( A ); end loop; for I in 1..1000 loop GET_NEXT( A ); if A.TIME /= FLOAT(I) then TEXT_IO.PUT_LINE( " -- GET_NEXT out of order (1)! " ); end if; FREE_EVENT( A ); end loop; end; declare -- test 3, see if it works as a LIFO with times reversed A: EVENT_REF; begin for I in reverse 1..1000 loop A := NEW_EVENT; A.TIME := FLOAT(I); SCHEDULE( A ); end loop; for I in 1..1000 loop GET_NEXT( A ); if A.TIME /= FLOAT(I) then TEXT_IO.PUT_LINE( " -- GET_NEXT out of order (2)! " ); end if; FREE_EVENT( A ); end loop; end; declare -- test 4, see if it works with times a bit random A: EVENT_REF; T: FLOAT; TABLE : array(1..1000) of EVENT_REF; begin for I in 1..1000 loop -- schedule 1000 random events A := NEW_EVENT; A.TIME := FLOAT((I * 421 + 2073) mod 9317); SCHEDULE( A ); end loop; for I in 1..1000 loop -- schedule 1000 random events A := NEW_EVENT; A.TIME := FLOAT(((I+1000) * 421 + 2073) mod 9317); TABLE(I) := A; SCHEDULE( A ); end loop; for I in 1..1000 loop -- delete the second 1000 events DELETE(TABLE(I)); end loop; T := -1.0; GET_NEXT( A ); for I in 2..1000 loop -- dequeue the first 1000 events if A.TIME < T then TEXT_IO.PUT_LINE( " -- GET_NEXT out of order (3)! " ); end if; T := A.TIME; GET_NEXT( A ); FREE_EVENT( A ); end loop; end; if not EMPTY then TEXT_IO.PUT_LINE( " -- failure, event-set not empty at end" ); else TEXT_IO.PUT_LINE( " -- success, event-set empty at end" ); end if; end if; end EVENT_HANDLER_TEST;