Ada/Mindstorms 2.0

Lists_Generic.adb

@@ -0,0 +1,193 @@
+WITH Unchecked_Deallocation;
+PACKAGE BODY Lists_Generic IS
+
+  PROCEDURE Dispose IS
+    NEW Unchecked_Deallocation(Object => Node, Name => Position);
+
+  FUNCTION Allocate (X: ElementType; P: Position) RETURN Position IS
+    Result: Position;
+  BEGIN
+    Result := NEW Node'(Info => X, Link => P);
+    RETURN Result;
+  EXCEPTION
+    WHEN Storage_Error =>
+      RAISE OutOfSpace;
+  END Allocate;
+
+  PROCEDURE Deallocate (P: IN OUT Position) IS
+  BEGIN
+    Dispose (X => P);
+  END Deallocate;
+
+  PROCEDURE Initialize(L: IN OUT List) IS
+    Previous: Position;
+    Current : Position;
+  BEGIN
+    IF L.Head /= NULL THEN
+      Current := L.Head;
+      WHILE Current /= NULL LOOP
+    Previous := Current;
+    Current := Current.Link;
+    Deallocate(Previous);
+      END LOOP;
+      L := (Head => NULL, Tail => NULL);
+    END IF;
+  END Initialize;
+
+  PROCEDURE AddToFront(L: IN OUT List; X: ElementType) IS
+  BEGIN
+    L.Head := Allocate(X, L.Head);
+    IF L.Tail = NULL THEN
+      L.Tail := L.Head;
+    END IF;
+  END AddToFront;
+
+  PROCEDURE AddToRear (L: IN OUT List; X: ElementType) IS
+    P: Position;
+  BEGIN
+    P := Allocate(X, NULL);
+    IF L.Head = NULL THEN
+      L.Head := P;
+    ELSE
+      L.Tail.Link := P;
+    END IF;
+    L.Tail := P;
+  END AddToRear;
+
+  FUNCTION IsEmpty (L: List) RETURN Boolean IS
+  BEGIN
+    RETURN L.Head = NULL;
+  END IsEmpty;
+
+  FUNCTION IsFirst (L: List; P: Position) RETURN Boolean IS
+  BEGIN
+    RETURN (L.Head /= NULL) AND (P = L.Head);
+  END IsFirst;
+
+  FUNCTION IsLast (L: List; P: Position) RETURN Boolean IS
+  BEGIN
+    RETURN (L.Tail /= NULL) AND (P = L.Tail);
+  END IsLast;
+
+  FUNCTION IsPastEnd (L: List; P: Position) RETURN Boolean IS
+  BEGIN
+    RETURN P = NULL;
+  END IsPastEnd;
+
+  FUNCTION IsPastBegin (L: List; P: Position) RETURN Boolean IS
+  BEGIN
+    RETURN P = NULL;
+  END IsPastBegin;
+
+  FUNCTION First (L: List) RETURN Position IS
+  BEGIN
+    RETURN L.Head;
+  END First;
+
+  FUNCTION  Last (L: List) RETURN Position IS
+  BEGIN
+    RETURN L.Tail;
+  END Last;
+
+  FUNCTION Retrieve (L: IN List; P: IN Position) RETURN ElementType IS
+  BEGIN
+    IF IsEmpty(L) THEN
+      RAISE EmptyList;
+    ELSIF IsPastBegin(L, P) THEN
+      RAISE PastBegin;
+    ELSIF IsPastEnd(L, P) THEN
+      RAISE PastEnd;
+    ELSE
+      RETURN P.Info;
+    END IF;
+  END Retrieve;
+
+  PROCEDURE GoAhead (L: List; P: IN OUT Position) IS
+  BEGIN
+    IF IsEmpty(L) THEN
+      RAISE EmptyList;
+    ELSIF IsPastEnd(L, P) THEN
+      RAISE PastEnd;
+    ELSE
+      P := P.Link;
+    END IF;
+  END GoAhead;
+
+  PROCEDURE GoBack (L: List; P: IN OUT Position) IS
+    Current: Position;
+  BEGIN
+    IF IsEmpty(L) THEN
+      RAISE EmptyList;
+    ELSIF IsPastBegin(L, P) THEN
+      RAISE PastBegin;
+    ELSIF IsFirst(L, P) THEN
+      P := NULL;
+    ELSE                    -- see whether P is in the list
+      Current := L.Head;
+      WHILE (Current /= NULL) AND THEN (Current.Link /= P) LOOP
+    Current := Current.Link;
+      END LOOP;
+
+      IF Current = NULL THEN -- P was not in the list
+        RAISE PastEnd;
+      ELSE
+        P := Current;        -- return predecessor pointer
+      END IF;
+    END IF;
+  END GoBack;
+
+  PROCEDURE Delete    (L: IN OUT List; P: Position) IS
+    Previous: Position;
+    Current : Position;
+  BEGIN
+    Current := P;
+    IF IsEmpty(L) THEN
+      RAISE EmptyList;
+    ELSIF IsPastBegin(L, Current) THEN
+      RAISE PastBegin;
+    ELSIF IsFirst(L, Current) THEN  -- must adjust list header
+      L.Head := Current.Link;
+      IF L.Head = NULL THEN         -- deleted the only node
+        L.Tail := NULL;
+      END IF;
+    ELSE                            -- "normal" situation
+      Previous := Current;
+      GoBack(L, Previous);
+      Previous.Link := Current.Link;
+      IF IsLast(L, Current) THEN     -- deleted the last node
+        L.Tail := Previous;
+      END IF;
+    END IF;
+    Deallocate(Current);
+  END Delete;
+
+  PROCEDURE Insert    (L: IN OUT List; X: ElementType; P: Position) IS
+  BEGIN
+    IF P = NULL THEN
+      AddToRear(L, X);
+    ELSE
+      P.Link := Allocate(X, P.Link);
+    END IF;
+  END Insert;
+
+  PROCEDURE Replace   (L: IN OUT List; X: ElementType; P: Position) IS
+  BEGIN
+    IF P = NULL THEN
+      RAISE PastEnd;
+    ELSE
+      P.Info := X;
+    END IF;
+  END Replace;
+
+  PROCEDURE Copy (To: IN OUT List; From: IN List) IS
+    Current: Position;
+  BEGIN
+    Initialize(To);
+    Current := First(From);
+    WHILE NOT IsPastEnd(From, Current) LOOP
+      AddToRear(To, Retrieve(From, Current));
+      GoAhead(From, Current);
+    END LOOP;
+  END Copy;
+
+END Lists_Generic;

Lists_Generic.ads

@@ -0,0 +1,113 @@
+GENERIC
+
+  TYPE ElementType IS PRIVATE;
+
+PACKAGE Lists_Generic IS
+------------------------------------------------------------------------
+--| Generic ADT for one-way linked lists
+--| Author: Michael B. Feldman, The George Washington University 
+--| Last Modified: January 1996                                     
+------------------------------------------------------------------------
+
+ -- exported types
+
+  TYPE Position IS PRIVATE;
+  TYPE List IS LIMITED PRIVATE;
+
+  -- exported exceptions
+
+  OutOfSpace: EXCEPTION;  -- raised if no space left for a new node
+  PastEnd   : EXCEPTION;  -- raised if a Position is past the end
+  PastBegin : EXCEPTION;  -- raised if a Position is before the begin
+  EmptyList : EXCEPTION;
+
+  -- basic constructors
+
+  PROCEDURE Initialize(L: IN OUT List);
+  -- Pre:  none
+  -- Post: L is initialized. If L contained nodes, these are deleted.
+
+  PROCEDURE AddToFront(L: IN OUT List; X: ElementType);
+  PROCEDURE AddToRear (L: IN OUT List; X: ElementType);
+  -- Pre:  L and X are defined
+  -- Post: a node containing X is inserted 
+  --   at the front or rear of L, respectively
+
+  -- basic selectors
+
+  FUNCTION First (L: List) RETURN Position;
+  FUNCTION Last  (L: List) RETURN Position;
+  -- Pre:  L is defined
+  -- Post: returns the position of the first or last node 
+  --   of L, respectively; return NULL if L is empty
+
+  FUNCTION Retrieve (L: IN List; P: IN Position) RETURN ElementType;
+  -- Pre:    L and P are defined; P designates a node in L
+  -- Post:   returns the value of the element at position P
+  -- Raises: EmptyList if L is empty
+  --         PastBegin if P points before the beginning of L
+  --         PastEnd   if P points beyond the end of L
+
+  -- other constructors
+
+  PROCEDURE Insert (L: IN OUT List; X: ElementType; P: Position);
+  -- Pre:  L, X, and P are defined; P designates a node in L
+  -- Post: X is inserted into L at position P; equivalent to
+  --   AddToRear if P is NULL
+
+  PROCEDURE Replace (L: IN OUT List; X: ElementType; P: Position);
+  -- Pre:    L, X, and P are defined; P designates a node in L
+  -- Post:   X replace the element in L at position P
+  -- Raises: PastEnd if P is NULL
+
+  PROCEDURE Delete (L: IN OUT List; P: Position);
+  -- Pre:    L and P are defined; P designates a node in L
+  -- Post:   the node at position P of L is deleted
+  -- Raises: EmptyList if L is empty
+  --         PastBegin if P is NULL
+
+  PROCEDURE Copy (To: IN OUT List; From: IN List);
+  -- Pre:  From is defined
+  -- Post: To is a list whose elements are the same as those
+  --   of From, in the same order.
+
+  -- iterator operations
+
+  PROCEDURE GoAhead (L: List; P: IN OUT Position);
+  -- Pre:    L and P are defined; P designates a node in L
+  -- Post:   P is advanced to designate the next node of L
+  -- Raises: EmptyList if L is empty
+  --         PastEnd   if P points beyond the end of L
+
+  PROCEDURE GoBack    (L: List; P: IN OUT Position);
+  -- Pre:    L and P are defined; P designates a node in L
+  -- Post:   P is moved to designate the previous node of L
+  -- Raises: EmptyList if L is empty
+  --         PastBegin if P points beyond the end of L
+
+  -- inquiry operators
+
+  FUNCTION  IsEmpty   (L: List) RETURN Boolean;
+  FUNCTION  IsFirst   (L: List; P: Position) RETURN Boolean;
+  FUNCTION  IsLast    (L: List; P: Position) RETURN Boolean;
+  FUNCTION  IsPastEnd (L: List; P: Position) RETURN Boolean;
+  FUNCTION  IsPastBegin (L: List; P: Position) RETURN Boolean;
+  -- Pre:    L and P are defined
+  -- Post:   return True iff the condition is met; False otherwise
+
+PRIVATE
+
+  TYPE Node;
+  TYPE Position IS ACCESS Node;
+
+  TYPE Node IS RECORD
+    Info: ElementType;
+    Link: Position;
+  END RECORD;
+
+  TYPE List IS RECORD
+    Head: Position;
+    Tail: Position;
+  END RECORD;
+
+END Lists_Generic;

README.md

@@ -0,0 +1,31 @@
+These files are the source code for Ada/Mindstorms 2.0, the most important part of which is ada2nqc, an Ada to NQC translator.  NQC is the "Not Quite C" language for Lego Mindstorms developed by Dave Baum (http://www.enteract.com/~dbaum/nqc).
+
+ada2nqc.adb is the top level file in the make tree.  If you have AdaGIDE, building ada2nqc will automatically construct the translator executable ada2nqc.exe.  Other important files are:
+
+lego.adb, lego.ads:  	the Ada/Mindstorms API
+trans_model.adb:	contains the code that actually performs the translation
+A95.g:			an Ada grammar
+other files:		define data types and build the parse tree of the source Ada program
+
+If you are making changes to the translator and/or adding functionality, you should never need to change anything apart from lego.adb, lego.ads, trans_model.adb, and possibly ada2nqc.adb if you are adding new command line arguments or options.
+
+USAGE:  from a DOS prompt,
+
+ada2nqc foo
+	Translates foo.adb in the current directory to foo.nqc in the current directory
+ada2nqc foo bar
+	Translates foo.adb in the current directory to bar.nqc in the current directory
+
+Other extensions can be supplied; the default is .adb for the input file (first argument) and .nqc for the output file (second argument).
+
+
+Links (some might need to be looked up via [archive.org](archive.org))
+-----
+[Ada Mindstorms](http://www.usafa.af.mil/df/dfcs/adamindstorms.cfm)
+[Ada Mindstorms Manual](http://www.usafa.edu/df/dfcs/ada_Mindstorms_manual.cfm)
+[AdaGIDE Home Page](http://adagide.martincarlisle.com/)
+[AdaMindstorms Manual](http://www.citidel.org/bitstream/10117/145/7/Ada_Mindstorms_manual.htm)
+[An Ada Interface to Lego Mindstorms](http://www.faginfamily.net/barry/Papers/AdaLetters.htm)
+[Successfully Build an Ada Compiler in Arch](http://wiki.archlinux.org/index.php/Successfully_Build_an_Ada_Compiler_in_Arch)
+[The GNU Ada Compiler](http://gnuada.sourceforge.net/)
+