   Dim Version$/"BAGL interpreter V1.0"
!INSERT_NEWLY_CREATED_BAG(B1)
!inserts an element into bag B1 which refers to a bag B2 such
!that there are no other references anywhere in the universe to bag B2
!(i.e., this element is unique).  Only implementation limit errors
!(such as NO BAGS LEFT, NO MORE ROOM IN BAG) can abort this operation.
!
!COPY_ARBITRARY_ELEMENT_FROM_FIRST_BAG_TO_SECOND(B1,B2)
!chooses an element at random from bag B1 and adds that element to B2.
!After the operation, both B1 and B2 contain the element.  The operation
!will fail if B1 has no elements.
!
!DELETE_ARBITRARY_ELEMENT_IN_FIRST_BAG_FROM_SECOND_BAG(B1,B2)
!chooses an element at random from bag B1 and removes an equivalent
!element from bag B2.  The operation will fail if B1 has no elements,
!or B2 has no corresponding element.
!
!DESTROY_BAG(B1)
!makes bag B1 evaporate from the universe.  An error will occur if
!B1 is referenced by any other bag.
!
!EQUAL_ELEMENTS(B1,B2) is a predicate which returns an error
!if an arbitrary element of B1 does NOT match an arbitrary element of
!B2 (the error/nonerror action may be used to produce conventional
!boolean values).
!.sp
!BAGL PROCEDURES
!.sp
!A BAGL procedure is a bag which specifies that a particular computation
!should take place.  The elements of the bag specify the computation
!by referencing bags which have pre-defined meanings.
!
   Dim FreeBagCells/0/
   ! Points to 1st free bag cell available
   Dim Word$[3]/0,0,0/

Def Word(WordIndex)
   ! Fetch value of virtual word array selected by WordIndex
   Read #1@WordIndex*3,Word$
   Return (Word$[1]**8+Word$[2])*256+Word$[3]
End

Subroutine SetWord(SetWordIndex,SetWordNewValue)
   ! Store NewValue into virtual word array
   If SetWordNewValue>65535
   Then
       ! Big value, do it the hard way
       WordTemp=int(SetWordNewValue/256.)
       Word$[1]=(WordTemp&:FF00)/256
       Word$[2]=WordTemp&:00FF
       Word$[3]=SetWordNewValue-WordTemp
   Else
       ! Little value, do it the quick way
       Word$[1]=0
       Word$[2]=(SetWordNewValue&:FF00)/256
       Word$[3]=SetWordNewValue&:00FF
   Fi
   Write #1@SetWordIndex*3,Word$ \ ! Store word into disk file
   Return Subroutine
End

Subroutine ResetBagSpace
   ! Note: Word(1) holds pointer to list of all free bag cells
   For i=1 to BagCellMax
       Word(i*2+1)=i \ ! Chain ALL the bag cells together
   Next i
   Word(i*2+1)=0 \ ! Mark last bag cell with END-OF-LIST marker
   Return Subroutine
End

Subroutine InitializeBagSpace
   ! Reads text file BAGL.DEF, which contains symbolic version of
   ! BAGL support environment, into BAGL virtual space.  Then it
   ! passes control to the executable BAG called BAGL.
   !
   ! An arbitrary bag is chosen to be the Unity bag.  We choose Bag cell 1.
   UnityBag=1 \ ! Set up magic Unity bag
   Word(UnityBag)=1 \ ! Set reference count to ensure never garbage collected
   Word(UnityBag+1)=IntegerBagCode+1 \ ! Make unity bag contain unity
End

Subroutine Initialize
   ! Called to initialize operation of BAGL
   FreeBagCells=Word(1) \ ! Fetch pointer to list of free bag cells
   len(Word$)=3 \ ! in case SetWord is called 1st
   IntegerBagCode=2^23 \ ! I.E., a bag cell pointer with top bit set
   Return Subroutine
End

Subroutine StopExecution
   ! Called to terminate execution
   Word(1)=FreeBagCells
End

Subroutine NoFreeBagCells
   ! Ran out of bag cells.  Try to figure out what to do.
   Print "No free bag cells."
   Print MaxBagCells;"currently in use."
   Input "Allocate how many more cells? " AllocateCount
   If AllocateCount=0
   Then
       ! Try garbage collecting
       StopExecution
       Error 101
   Else
   FreeBagCells=BagCellMax+1
   For i=BagCellMax+1 to AllocateCount
       Word(i*2+1)=i \ ! Chain ALL the bag cells together
   Next i
   Word(i*2+1)=0 \ ! Mark last bag cell with END-OF-LIST marker
   BagCellMax=AllocateCount \ ! Remember how many bag cells allocated
   Return Subroutine
End

Subroutine InsertNewlyCreatedBag
   ! Insert new bag cell, pointing to newly created bag, into existing bag.
   If FreeBagCells=0 Then NoFreeBagCells
   ! Create a new bag by allocating a bag cell as a placeholder
   NewBag=FreeBagCells \ ! Find free location
   FreeBagCells=Word(FreeBagCells) \ ! Remove from list of bag cells
   If FreeBagCells=0 Then NoFreeBagCells
   Word(NewBag)=1 \ ! Set reference count to unity
   Word(NewBag+1)=0 \ ! Make newly allocated bag be empty
   NewBagCell=FreeBagCells \ ! Find free location
   FreeBagCells=Word(FreeBagCells) \ ! Remove from list of bag cells
   Word(NewBagCell)=NewBag \ ! Make new bag cell point to newly created bag
   ! Make new bag cell point to rest of existing bag cells for InsertVictim
   Word(NewBagCell+1)=Word(InsertVictim+1)
   Word(InsertVictim+1)=NewBagCell
   Return Subroutine
End

Subroutine DeleteBag
   ! Delete a random bag from DeleteVictim. We choose to delete the 1st.
   BagCellToFree=Word(DeleteVictim+1)
   If BagCellToFree=0
   Then Error 102 \ ! Attempt to delete from empty bag
   If BagCellToFree>IntegerBagCode
   Then
       ! We found an integer bag
       BagCellToFree=BagCellToFree-1 \ ! Decrement integer bag
       If BagCellToFree=IntegerBagCode
       Then Word(DeleteVictim+1)=0 \ ! Mark bag as empty
       Else Word(DeleteVictim+1)=BagCellToFree
       Return Subroutine
   Fi
   Word(DeleteVictim+1)=Word(BagCellToFree+1) \ ! remove bag cell from Victim
   BagToAdjust=Word(BagCellToFree) \ ! Find bag to decrement ref count on
   Word(BagCellToFree+1)=FreeBagCells \ ! Place bag on front of free list
   FreeBagCells=BagCellToFree
   Temp=Word(BagToAdjust) \ ! Fetch reference count
   If Temp>1
   Then Word(BagToAdjust)=Temp-1 \ ! Decrement reference count
   Else
       ! Referenced bag no longer has any references. Stuff into free list.
       Word(BagToAdjust+1)=FreeBagCells
       FreeBagCells=BagToAdjust
   Fi
   Return Subroutine
End

Subroutine CopyAnyBag
   ! Choose a bag at random from source. Place into target.
   ! To make our life easy, we choose the 1st. Don't tell anybody.
   BagCellToCopy=Word(DeleteVictim+1)
   If BagCellToCopy=0
   Then Error 102 \ ! Attempt to delete from empty bag
   If BagCellToCopy>IntegerBagCode
   Then
       ! We found an integer bag, must be at end of bag cell list
       BagCellToCopy=BagCellToCopy-1 \ ! Decrement integer bag
       If BagCellToCopy=IntegerBagCode
       Then Word(DeleteVictim+1)=0 \ ! Mark bag as empty
       Else Word(DeleteVictim+1)=BagCellToCopy
       ! Now insert unity bag into destination
       BagCellToCopy=Word(InsertVictim+1) \ ! Fetch link
       If BagCellToCopy=0
       Then
           ! Insert victim is an empty bag
           Word(InsertVictim+1)=IntegerBagCode+1 \ ! Insert unity into empty bag
       ElseIf BagCellToCopy>IntegerBagCode
       Then
           Word(InsertVictim+1)=BagCellToCopy+1 \ ! Bump # unity bags installed
       Else
           ! Insert new bag cell, pointing to unity bag, into existing bag.
           If FreeBagCells=0 Then NoFreeBagCells
           NewBagCell=FreeBagCells \ ! Find free location
           FreeBagCells=Word(FreeBagCells) \ ! Remove from list of bag cells
           Word(NewBagCell)=UnityBag \ ! Make new bag cell point to unity bag
           ! Make new bag cell point to rest of existing bag cells for InsertVictim
           Word(NewBagCell+1)=Word(InsertVictim+1)
           Word(InsertVictim+1)=NewBagCell
       Fi
       Return Subroutine
   Fi
   Word(DeleteVictim+1)=Word(BagCellToCopy+1) \ ! remove bag cell from Victim
   ! Insert bag cell into InsertVictim
   Temp=Word(InsertVictim+1) \ ! Fetch pointer to bag contents
   If Temp=0
   Then
       ! Empty bag: check for inserting unity
       If Word(BagCellToCopy)=UnityBag
       Then
           ! Inserting unity into empty bag, set bag to integer 1
           Word(InsertVictim+1)=IntegerBagCode+1
           ! Word(UnityBag)=Word(UnityBag)=1 \ ! Decrement reference count
           Word(BagCellToCopy+1)=FreeBagCells \ ! Give bag cell to free list
           FreeBagCells=BagCellToCopy
       Else
           ! Not inserting unity, do insertion the normal way
           Word(BagCellToCopy+1)=Temp
           Word(InsertVictim+1)=BagCellToCopy
       Fi
   ElseIf Temp>IntegerBagCode
       ! Integer bag: check for inserting unity
       If Word(BagCellToCopy)=UnityBag
       Then
           ! Inserting unity into Integer bag, just bump integer
           Word(InsertVictim+1)=Temp+1
           ! Word(UnityBag)=Word(UnityBag)=1 \ ! Decrement reference count
           Word(BagCellToCopy+1)=FreeBagCells \ ! Give bag cell to free list
           FreeBagCells=BagCellToCopy
       Else
           ! Not inserting unity, do insertion the normal way
           Word(BagCellToCopy+1)=Temp
           Word(InsertVictim+1)=BagCellToCopy
       Fi
   Else
       ! Normal bag, just insert copied bag
       Word(BagCellToCopy+1)=Temp
       Word(InsertVictim+1)=BagCellToCopy
   Fi
   Return Subroutine
End
! This BAGL interpreter manages a large linear virtual address space.
! A particular bag lives at a fixed address in this space, and consists
! of a list of LISP-like CONS cells, called BAG CELLS. BAG CELLS
! have two parts, nominally a pointer to a bag, and pointer to another
! bag cell.  Unlike lisp, there is no mechanism for a BAGL program
! to generate, reference or adjust a bag cell; bag cells are used
! ONLY by the implementation.  Initially, all bag cells available are
! placed in a free bag cell list.  Bag Creation causes a bag cell to
! be removed from the free cell list, and the bag cell initialized
! with a zero reference count in the bag pointer, and an end-of-bag
! mark placed in the next-bag-cell link.  Insertion of a bag into
! a bag causes a bag cell to be allocated and inserted in the
! bag cell list for the target bag, with its bag pointer pointing
! to the to-be-inserted bag.  The reference count on the inserted
! bag in bumped.  Deletion of an element from a bag decrements the
! reference count of the bag selected by the 2nd bag cell in the
! bag cell list; if the deleted bag's reference count goes to zero,
! its bag cell is returned to free space.
! Special WHOLENUMBER bags are specially tagged BAG pointers (top bit
; set) that simply contain a counter.
! If such a bag has the special "unit" bag cell inserted, the counter
! is incremented; if a bag is deleted, the counter is decremented.
! Insertion of a non-unit bag causes allocation of a bag cell, and a mixed
! list is constructed.
! Cheap garbage collection is
! handled by reference counts; although reference counting does not
! gaurantee that freed lists are collectible, it significantly reduces
! garbage collection overhead.
