! Database Manager sub-module
!
!
!
!     EXTERNAL ROUTINES/PREDICATES FOR THE DATABASE MANAGEMENT
!
!         FOR APMTEL              By Andie Ness  2/3/88
!
!
!   9/ 5/88       Added database name parameter.   AN
!   9/ 5/88       Added timestamp information.     AN
!


%begin

%include "CONSTS.INC"
%include "INC:UTIL.IMP"
%include "FILES.INC"
%externalroutinespec access file(%string(255)f,%integer m,%integername ref,size)
%externalroutinespec deaccess file(%integer ref)
%externalroutinespec read region(%integer ref,byte,bytes,%bytename buffer)
%externalroutinespec write region(%integer ref,byte,bytes,%bytename buffer)
%externalstring(255) %fnspec extract comments(%integer n, %integername i)

%constinteger true=1,false=0

!
! open:   attempt to open one of the database files
!         success = 1, failure = -1
!
!         needed as there are no low-level file locking routines
!         available on the APMs
!
%integerfn open ( %string(255) cache file,
                     %integername file handle,
                                  file size,
                     %integer     mode)
   %on %event 0,1,2,3,4,5,6,7,8,9 %start
      %if event_event = 3 %and event_sub = 3 %start
         print string("GROK - Error occured - ".snl)
         print string("Event number = "); write(event_event,0); newline
         print string("Event sub    = "); write(event_sub,0);   newline
         print string("Line number  = "); write(event_line,0);  newline
         print string("Extra info   = ".event_message.snl)
         print string("Cannot find database file !!!!")
         newline
         print string("APMTEL must have been disabled!!!".snl)
         print string("Stopping .... Byee".snl)
         %stop
      %finish
      %return -1
   %finish

   accessfile(cache file ,mode, file handle,file size)
   %return 1
%end


%externalroutine show comments
%integer ch, number, i,j, temp
   newline
   print string("   0...".extract comments(0,number).snl);
   newline
   i=0
   %cycle
      i=i+1
      ch=test symbol
      write(i,3); print string("...".extract comments(i,number).snl)
      %if (i//10)*10 = i %start
         print string("<Press space to exit, any key to continue>".snl);
         %cycle
            ch = test symbol
         %repeatuntil ch#-1
      %finish
   %repeatuntil number<=1 %or ch=32 
%end

! open cache:   routine to repeat a re-open of the database file
!               until it succeeds
!
%routine open cache( %string(255) cache file, 
                     %integername filehandle,
                                  filesize,
                     %integer     mode)
   %cycle; %repeatuntil open(cache file,file handle, file size, mode) #-1
%end

   
!
! close cache:   routine to close the database file for use by other users
!
%routine close cache(%integer file handle)
   deaccessfile(file handle)
%end
   
!
!  free slot:    function that returns the record number of any free slots
!                in the database. If none, -1
!
%integerfn free slot(%integer file handle, file size)
%integer i
%integer max records
%bytearray buffer(0:record size)
   max records = file size // record size
   i=0
   %cycle
      read region(file handle,i*record size,1,buffer(0))
      i = i + 1
   %repeatuntil buffer(0)=0 %or i = max records
   %if buffer(usage offset)=free %start
      %return i-1
   %finish
   %return -1;                      ! No free slots
%end


! CONVERT TO INTERNAL                                                        
! This function takes a pointer to a byte array (actually its a date string  
! returned from the system function 'DATETIME') and converts the pointed-at  
! array into an easily compared form - ie an integer. I would have prefered  
! to have made it a long integer but unfortunately, this compiler doesn't    
! support %longintegerfn's                                                   
!                                                                            
%integerfn convert to internal(%bytearrayname b)
%integer temp,i
   temp = b(7)-'0'
   temp = temp * 10 + b(3)-'0'
   temp = temp * 10 + b(4)-'0'
   temp = temp * 10 + b(0)-'0'
   temp = temp * 10 + b(1)-'0'
   %for i = 9,1,14 %cycle
        temp = temp * 10 + b(i)-'0' %unless b(i)='.' %or b(i) = ' '
   %repeat
%return temp
%end

%integerfn extract stamp(%bytearrayname b)
%integer i
%bytearray t(0:15)
   %for i=date stamp offset,1,date stamp offset+15 %cycle
       t(i-date stamp offset) = b(i)
   %repeat
   %return(convert to internal(t))
%end

%integerfn current datestamp
%string(255) t
%bytearray t1(0:15)
%integer i
   t = datetime
    %for i=1,1,15 %cycle
      t1(i-1) = charno(t,i)
   %repeat
   %return(convert to internal(t1))
%end

! oldest record  :   function to return the record number of the oldest 
!                    record in the database file. Used when 'free slot' 
!                    fails.
%integerfn oldest record(%integer fref, fsize)
%integer record no,oldest record, oldest date, temp date
%bytearray b(0:14)
   oldest record= 2                    { Dummy value
   oldest date= 999999999              { Dummy value
   %for record no =0,1,fsize//record size-1 %cycle
      read region(fref, record no * record size+ datestamp offset,15,b(0))
      temp date = convert to internal(b)
      %if temp date < oldest date %start
         oldest date = temp date
         oldest record = record no
      %finish
   %repeat
   %return oldest record
%end

! match:        function that returns the record number of a record that
!               has the same page number and channel as the passed args.
!               Used to replace out of date pages
%externalintegerfn match(%integer page,channel, 
                         %string(255)cache file,%integer replace)
%integer i
%bytearray c(0:record size)
%integer max records
%integer file ref, file size, byte pos
%integer page no
%integer finished
   open cache(cache file, file ref, file size, 0)
   channel = channel - '0'
   finished = false
   max records = file size // record size
   i=0
   %cycle
      read region(file ref,record size * i,64,c(0))
      page no = c (page no hi offset) * 256 + c(page no lo offset)
      %if page no = page %and channel= c(channel offset) %start
         %if replace = 1 %start
            %if current datestamp-extract stamp(c)< 100 %then %c
               finished = true
         %else
            finished = true
         %finish
      %finish
      i=i+1
   %repeatuntil finished=true %or i = max records
   close cache(file ref)
   %if finished=false %then %return -1 %else %return i-1
%end


! insert page:        place the supplied page in the database file along
!                     with page number, channel information and comments
%externalroutine insert page(%bytearray page(0:24,0:39),%integer page no,
                             %byte channel, %string(255) file, comments)
%integer record no
%integer file ref, file size, byte pos,i,j
%bytearray this entry(0:1023);
%string(15) time stamp

   this entry (usage offset)        = used
   this entry (channel offset)      = channel - '0'
   this entry (page no lo offset)   = page no & 16_FF
   this entry (page no hi offset)   = (page no >> 8) & 16_ff
   time stamp = datetime
   %for i=1,1,length(time stamp) %cycle
      this entry (date stamp offset+i-1)= charno(time stamp,i)
   %repeat
   %if length(comments) < 32 %start
      %for i=length(comments),1,32 %cycle
         comments = comments." " 
      %repeat
   %finish
   %for i=1,1,32 %cycle
      this entry (comments offset + i -1) = charno(comments,i)
   %repeat
   %for i=0,1,23 %cycle
      %for j= 0,1,39 %cycle
         this entry (page offset + i*40 + j) = page(i,j)
      %repeat
   %repeat
   %if channel # '5' %then record no = match(page no, channel,file,0) %elsec
           record no = -1
   open cache(file, file ref, file size, 1)
   record no = free slot(file ref, file size) %unless record no # -1
   %if record no = -1 %then record no = oldest record(file ref,file size)
   byte pos = record no * record size
   write region(file ref, byte pos, record size, this entry(0))
   close cache(file ref)
%end




%integerfn extract page no (%bytearray packet(0:24,0:39))
%integer i,j
%integer actual
   actual = 0
   %for i=0,1,2 %cycle
      actual = 10*actual + packet(0,i)-'0'
   %repeat
   %for i=0,1,23 %cycle
      %for j=0,1,39 %cycle
         print symbol(packet(i,j))
      %repeat
      newline
   %repeat
   %return actual
%end


! extract page:      retrieve a page from the database file
!                    true on success, false on failure
%externalpredicate extract page( %integer record no,
                                 %bytearrayname page(0:24,0:39),
                                 %string (255) filename)
%integer byte pos
%integer file ref, file size
%integer i,j
%bytearray entry(0:record size)
   byte pos = record no * record size
   open cache(filename, file ref,file size, 0)
   %if byte pos > file size - record size %then %false
   read region(file ref, byte pos, record size, entry(0))
   close cache(file ref)
   %for i=0,1,23 %cycle
      %for j=0,1,39 %cycle  
         page(i,j) = entry(page offset + i*40 + j)
      %repeat
   %repeat
   %true
%end

%externalstring(255) %fn extract comments(%integer record no,%integername left)
%integer fsize, fref,i
%string(255) temp
%bytearray buffer(0:record size)
   temp = ""
   open cache(EUCHANNEL5FILE,fref,fsize,0)
   %if record no * recordsize > fsize - record size %start
       left = -1
       %return "INVALID RECORD NUMBER"
   %else
       read region(fref, record no * record size + comments offset,32,buffer(0))
       close cache(fref)
       temp = temp . tostring(buffer(i)) %for i = 0,1,32 
       left = fsize // record size - record no -1
       %return temp
   %finish
%end
            
       

%endofprogram