Imported from Sources.UnU.Lib.Support

asm/muldiv

+a1 RN 0
+a2 RN 1
+a3 RN 2
+a4 RN 3
+v1 RN 4
+v2 RN 5
+ip RN 12
+sp RN 13
+lr RN 14
+pc RN 15
+
+        AREA |C$$code|, CODE, READONLY
+
+        EXPORT muldiv
+;;;;    IMPORT raise
+
+muldiv
+ ; muldiv(a, b, c)
+ ; result = a*b/c
+ ; the intermediate product is 64 bits long
+ ; do everything using moduluses, and sort out signs later
+
+        STMFD   sp!, {a1, a2, a3, a4, v1, v2, lr}
+
+ ; first, the double-length product, returned in a3 & a4
+         ; uses ip, a1 and a2 as workspace
+        MOV     a3, #0
+        MOV     a4, #0
+        MOV     ip, #0
+        CMPS    a2, #0
+        RSBLT   a2, a2, #0      ; abs b
+        MOV     v2, a2
+        CMPS    a1, #0
+        RSBLT   a1, a1, #0      ; abs a
+muldiv0
+        MOVS    a2, a2, LSR #1
+        BCC     muldiv1
+        ADDS    a4, a4, a1
+        ADC     a3, a3, ip
+muldiv1
+        MOVS    a1, a1, ASL #1
+        ADC     ip, ip, ip
+        CMPS    a2, #0
+        BNE     muldiv0
+
+ ; now the 64*32 bit divide
+ ; dividend in a3 and a4
+ ; remainder ends up in a4; quotient in ip
+ ; uses a1 and a2 to hold the (shifted) divisor;
+ ;      v1 for the current bit in the quotient
+        LDR     a2, [sp, #8]    ; recover divisor
+        CMPS    a2, #0
+        LDMEQFD sp!, {a1-a4, v1, v2, pc}^
+        ;;was BEQ muldiv_by_0, but we might be a module
+        RSBLT   a2, a2, #0      ; abs c
+        MOV     v2, a2
+        MOV     ip, #0
+        MOV     a1, #0
+        MOV     v1, #0
+        MOV     lr, #1
+muldiv2
+        CMPS    a1, #&80000000
+        BCS     muldiv3
+        CMPS    a1, a3
+        CMPEQS  a2, a4          ; compare of [a1, a2] against [a3, a4]
+        BCS     muldiv3
+        MOVS    a2, a2, ASL #1
+        MOV     a1, a1, ASL #1
+        ADC     a1, a1, #0
+        ADD     v1, v1, #1
+        B       muldiv2
+
+muldiv3
+        CMPS    a1, a3
+        CMPEQS  a2, a4
+        BHI     muldiv4
+        CMPS    v1, #31
+        ADDLE   ip, ip, lr, ASL v1
+        SUBS    a4, a4, a2
+        SBC     a3, a3, a1
+muldiv4
+        MOVS    a1, a1, ASR #1
+        MOV     a2, a2, RRX
+        SUBS    v1, v1, #1
+        BGE     muldiv3
+
+ ; now all we need to do is sort out the signs.
+        LDMFD   sp!, {a1, a2, a3, v1}
+        EOR     a2, a2, a1      ; a2 has the sign of a*b: a3 is the sign of c
+        MOV     a1, ip
+        TEQS    a2, a3          ; if a*b and c have opposite signs,
+        RSBMI   a1, a1, #0      ; negate the quotient
+        CMPS    a2, #0          ; and if the dividend was negative,
+        RSBLT   a4, a4, #0      ; negate the remainder
+;;;;    Now discard the remainder - J R C 19 March 1991
+;;;;    STR     a4, [v1]
+        LDMFD   sp!, {v1, v2, pc}^
+
+muldiv_by_0 ;not used
+;;;;    LDMFD   sp!, {a1-a4, v1, v2, lr}
+;;;;    MOV     a1, #2          ; SIGFPE
+;;;;    B       raise
+
+        END

c/callback

+/* Copyright 1996 Acorn Computers Ltd
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *     http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+/*callback.c - dynamically extensible multi-way, multi-level
+   switch facility*/
+
+   /* First implementation: hold callbacks in a tree structure reflecting
+      their structure.
+
+      Note: since all callbacks are called back with non-null |unclaimed|
+      pointer, and this is initialised to TRUE, you never need to assign TRUE
+      to |unclaimed|. You can assign FALSE to it without checking for
+      nullness, too.
+   */
+
+/*From CLib*/
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+/*From OSLib*/
+#include "types.h"
+
+/*From Support*/
+#include "callback.h"
+#include "m.h"
+#include "riscos.h"
+#include "jc_trace.h"
+
+#ifdef TRACE
+/*#define XTRACE*/
+#endif
+
+/* Useful types needed by |callback_|
+
+      Type Fn == (the type of a callback function);
+      Type SH == (the type of the static handle);
+      Type DH == (the type of the dynamic handle)
+      Type Level == List [Fn  SH]  List [Int  Level];
+
+   implemented in C via
+
+      Type Function == List [Fn  SH];
+      Type Entry == List [Int  Level];
+
+   (where List [T] == Opt [T  List [T]])
+*/
+
+struct callback_l {struct Level *root;};
+
+typedef
+   struct Function
+   {  callback_fn *fn;
+      void *sh;
+      struct Function *next;
+   }
+   *Function;
+
+typedef
+   struct Entry
+   {  int key;
+      struct Level *level;
+      struct Entry *next;
+   }
+   *Entry;
+
+typedef
+   struct Level
+   {  struct Function *fns;
+      struct Entry *list;
+   }
+   *Level;
+
+#if TRACE
+/*------------------------------------------------------------------------*/
+static char *Function_Name (callback_fn *fn)
+
+   /*The name of a function.*/
+
+{  char *name = (char *) fn - 4;
+
+   static char Fn [80 + 1];
+
+   if (name [3] == 0xFF)
+      riscos_strncpy (Fn, name - *name, 80);
+   else
+      sprintf (Fn, "(unnamed at 0x%X)" _ (unsigned) fn);
+
+   return Fn;
+}
+#endif
+/*------------------------------------------------------------------------*/
+os_error *callback_new (callback_l *l_out)
+
+{  callback_l l;
+   os_error *error = NULL;
+
+   tracef ("callback_new\n");
+   if ((l = m_ALLOC (sizeof *l)) == NULL)
+   {  error = riscos_error_lookup (os_GLOBAL_NO_MEM, "NoMem");
+      goto finish;
+   }
+
+   l->root = NULL;
+
+   if (l_out != NULL) *l_out = l;
+
+finish:
+   return error;
+}
+/*------------------------------------------------------------------------*/
+static void Delete_Function (Function f)
+
+{  if (f != NULL)
+   {
+      #ifdef XTRACE
+      tracef ("Delete_Function\n");
+      #endif
+
+      Delete_Function (f->next);
+      m_FREE (f, sizeof *f);
+}  }
+/*------------------------------------------------------------------------*/
+static void Delete_Entry (Entry), Delete_Level (Level);
+/*------------------------------------------------------------------------*/
+void Delete_Entry (Entry e)
+
+{  if (e != NULL)
+   {
+      #ifdef XTRACE
+      tracef ("Delete_Entry\n");
+      #endif
+
+      Delete_Level (e->level);
+      Delete_Entry (e->next);
+      m_FREE (e, sizeof *e);
+}  }
+/*------------------------------------------------------------------------*/
+void Delete_Level (Level level)
+
+{  if (level != NULL)
+   {
+      #ifdef XTRACE
+      tracef ("Delete_Level\n");
+      #endif
+
+      Delete_Function (level->fns);
+      Delete_Entry (level->list);
+      m_FREE (level, sizeof *level);
+}  }
+/*------------------------------------------------------------------------*/
+os_error *callback_delete (callback_l l)
+
+{  tracef ("callback_delete\n");
+
+   if (l != NULL)
+   {  Delete_Level (l->root);
+      m_FREE (l, sizeof *l);
+   }
+
+   return NULL;
+}
+/*------------------------------------------------------------------------*/
+static os_error *Callback (void *dh, Level level, bool *unclaimed, int limit,
+      int *k)
+
+{  Function f;
+   bool u = TRUE;
+   os_error *error = NULL;
+
+   #ifdef XTRACE
+   {  int i;
+
+      tracef ("Callback: dh 0x%X, level 0x%X, limit %d, key {" _ dh _ level _
+            limit);
+
+      for (i = 0; i < limit; i++)
+         trace_f (NULL _ 0 _ "%s%d" _ i == 0? "": ", " _ k [i]);
+      trace_f (NULL _ 0 _ "} ...\n");
+   }
+   #endif
+
+   if (level != NULL)
+   {  if (limit > 0)
+      {  /*Try to match this key.*/
+         Entry e;
+
+         /*It's important that we process the deepest ones first, as they are
+            the most specialised for their purpose (all in a highly abstract
+            sense ...).*/
+         for (e = level->list; e != NULL; e = e->next)
+            if (e->key == *k)
+            {  if ((error = Callback (dh, e->level, &u, limit - 1,
+                     k + 1)) != NULL)
+                  goto finish;
+
+               if (!u) break;
+            }
+      }
+
+      if (u)
+         /*Reached the end of the line - call all the functions until one
+            handles the keys.*/
+         for (f = level->fns; f != NULL; f = f->next)
+         {  tracef ("callback %s (0x%X, 0x%X, 0x%X)\n" _
+                  Function_Name (f->fn) _ f->sh _ dh _ &u);
+            if ((error = (*f->fn) (f->sh, dh, &u)) != NULL)
+               goto finish;
+
+            if (!u) break;
+   }     }
+
+#ifdef XTRACE
+   tracef ("Callback ... %s claimed\n" _ u? "was not": "was");
+#endif
+
+   if (!u) *unclaimed = FALSE;
+
+finish:
+   return error;
+}
+/*------------------------------------------------------------------------*/
+os_error *callback (callback_l l, void *dh, bool *unclaimed, int limit, ...)
+
+   /*Makes the non-portable assumption that the arguments after |limit| are
+      on the stack in order of increasing address.*/
+
+{  bool u = TRUE;
+   os_error *error = NULL;
+
+   tracef ("callback ...\n");
+   if ((error = Callback (dh, l->root, &u, limit, &limit + 1)) != NULL)
+      goto finish;
+   tracef ("callback ... %s claimed\n" _ u? "was not": "was");
+
+   if (unclaimed != NULL) *unclaimed = u;
+
+finish:
+   return error;
+}
+/*------------------------------------------------------------------------*/
+os_error *callback_register (callback_l l, callback_fn *fn, void *sh,
+      int limit, ...)
+
+   /*Makes the non-portable assumption that the arguments after |limit| are
+      on the stack in order of increasing address.*/
+
+{  Level *level;
+   int i, *k = &limit + 1;
+   os_error *error = NULL;
+
+   tracef ("callback_register\n");
+
+   /*Descend the hierarchy, creating new |Level|'s if necessary.*/
+   level = &l->root;
+
+   for (i = 0; i < limit; i++)
+   {  Entry e;
+      bool found = FALSE;
+
+      if (*level == NULL)
+      {  /*Need a new one for this level. First create the new |Level|.*/
+         Level t;
+
+         if ((t = m_ALLOC (sizeof *t)) == NULL)
+         {  error = riscos_error_lookup (os_GLOBAL_NO_MEM, "NoMem");
+            goto finish;
+         }
+         t->fns  = NULL;
+         t->list = NULL;
+
+         *level = t;
+      }
+
+      /*Now look along the current level for the given key. This won't
+         take long if the level was just created.*/
+      for (e = (*level)->list; e != NULL; e = e->next)
+         if (e->key == k [i])
+         {  found = TRUE;
+            break;
+         }
+
+      if (!found)
+      {  /*Must create a new entry for this key.*/
+         if ((e = m_ALLOC (sizeof *e)) == NULL)
+         {  error = riscos_error_lookup (os_GLOBAL_NO_MEM, "NoMem");
+            goto finish;
+         }
+         e->key   = k [i];
+         e->level = NULL;
+         e->next  = (*level)->list;
+
+         (*level)->list = e;
+      }
+
+      level = &e->level;
+   }
+
+   if (*level == NULL)
+   {  /*Need a new one here too.*/
+      Level t;
+
+      if ((t = m_ALLOC (sizeof *t)) == NULL)
+      {  error = riscos_error_lookup (os_GLOBAL_NO_MEM, "NoMem");
+         goto finish;
+      }
+      t->fns  = NULL;
+      t->list = NULL;
+
+      *level = t;
+   }
+
+   /*Append the new function to the function list for |level|.*/
+   #if 1 /*this adds it at the end*/
+   {  Function *f;
+
+      for (f = &(*level)->fns; *f != NULL; f = &(*f)->next)
+         ;
+      if ((*f = m_ALLOC (sizeof **f)) == NULL)
+      {  error = riscos_error_lookup (os_GLOBAL_NO_MEM, "NoMem");
+         goto finish;
+      }
+
+      (*f)->fn   = fn;
+      (*f)->sh   = sh;
+      (*f)->next = NULL;
+   }
+   #else /*this adds it at the beginning*/
+   {  Function f;
+
+      if ((f = m_ALLOC (sizeof *f)) == NULL)
+      {  error = riscos_error_lookup (os_GLOBAL_NO_MEM, "NoMem");
+         goto finish;
+      }
+      f->fn   = fn;
+      f->sh   = sh;
+      f->next = (*level)->fns;
+
+      (*level)->fns = f;
+   }
+   #endif
+
+finish:
+   return error;
+}
+/*------------------------------------------------------------------------*/
+static void Deregister_Level (Level *l, void *sh),
+      Deregister_Entry (Entry *e, void *sh);
+/*------------------------------------------------------------------------*/
+static void Deregister_Function (Function *ff, void *sh)
+
+{  Function f = *ff;
+
+   if (f != NULL)
+   {
+      #ifdef XTRACE
+      tracef ("Deregister_Function\n");
+      #endif
+
+      Deregister_Function (&f->next, sh);
+
+      if (f->sh == sh)
+      {  *ff = f->next;
+         m_FREE (f, sizeof *f);
+}  }  }
+/*------------------------------------------------------------------------*/
+void Deregister_Entry (Entry *ee, void *sh)
+
+{  Entry e = *ee;
+
+   if (e != NULL)
+   {
+      #ifdef XTRACE
+      tracef ("Deregister_Entry\n");
+      #endif
+
+      Deregister_Level (&e->level, sh);
+      Deregister_Entry (&e->next,  sh);
+
+      if (e->level == NULL)
+      {  *ee = e->next;
+         m_FREE (e, sizeof *e);
+}  }  }
+/*------------------------------------------------------------------------*/
+void Deregister_Level (Level *ll, void *sh)
+
+{  Level l = *ll;
+
+   if (l != NULL)
+   {
+      #ifdef XTRACE
+      tracef ("Deregister_Level\n");
+      #endif
+
+      Deregister_Function (&l->fns,  sh);
+      Deregister_Entry    (&l->list, sh);
+
+      if (l->fns == NULL && l->list == NULL)
+      {  *ll = NULL;
+         m_FREE (l, sizeof *l);
+}  }  }
+/*------------------------------------------------------------------------*/
+os_error *callback_deregister (callback_l l, void *sh, int limit, ...)
+
+   /*Makes the non-portable assumption that the arguments after |limit| are
+      on the stack in order of increasing address.*/
+
+   /*No error is flagged if the given (fn, handle, keys) combination does
+      not exist.*/
+
+{  /*We only free the |Function|'s that record this callback, though it
+      would be possible to free the |Level| that they depend on (provided
+      that there were no sub-|Level|'s or other |Function|'s).*/
+
+   Level *ll;
+   Entry *ee = NULL;
+   int i, *k = &limit + 1;
+   os_error *error = NULL;
+
+   tracef ("callback_deregister\n");
+
+   /*Descend the hierarchy.*/
+   ll = &l->root;
+
+   for (i = 0; i < limit && *ll != NULL; i++)
+   {  /*Look along the current level for the given key.*/
+      for (ee = &(*ll)->list; *ee != NULL; ee = &(*ee)->next)
+         if ((*ee)->key == k [i])
+            break;
+
+      if (*ee == NULL)
+         goto finish;
+
+      ll = &(*ee)->level;
+   }
+
+   Deregister_Level (ll, sh);
+
+   if (*ll == NULL && ee != NULL)
+   {  /*We've just killed the level of a certain entry, so we should remove
+         it too.*/
+      Entry e = *ee;
+
+      *ee = e->next;
+      m_FREE (e, sizeof *e);
+   }
+
+finish:
+   return error;
+}
+#if TRACE
+/*------------------------------------------------------------------------*/
+static void Trace_Entry (Entry, int), Trace_Level (Level, int);
+
+void Trace_Entry (Entry entry, int indent)
+
+{  if (entry != NULL)
+   {  trace_f (NULL _ 0 _ "%*s%d:\n" _ indent _ "" _ entry->key);
+      Trace_Level (entry->level, indent + 3);
+      Trace_Entry (entry->next, indent);
+}  }
+/*------------------------------------------------------------------------*/
+static void Trace_Function (Function fns, int indent)
+
+{  Function f;
+   bool first = TRUE;
+
+   for (f = fns; f != NULL; f = f->next)
+   {  if (first)
+      {  trace_f (NULL _ 0 _ "%*sFunctions:" _ indent _ "");
+         first = FALSE;
+      }
+      else
+         trace_f (NULL _ 0 _ ", ");
+
+      trace_f (NULL _ 0 _ " %s (0x%X,)" _ Function_Name (f->fn) _ f->sh);
+   }
+
+   if (first)
+      trace_f (NULL _ 0 _ "%*sNo functions" _ indent _ "");
+
+   trace_f (NULL _ 0 _ "\n");
+}
+/*------------------------------------------------------------------------*/
+void Trace_Level (Level level, int indent)
+
+{  if (level != NULL)
+   {  Trace_Function (level->fns, indent);
+      Trace_Entry (level->list, indent);
+}  }
+/*------------------------------------------------------------------------*/
+void callback_trace (callback_l l)
+
+{  tracef ("callback_trace\n");
+
+   if (l != NULL) Trace_Level (l->root, 0);
+}
+#endif

c/trfm

+/* Copyright 1996 Acorn Computers Ltd
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *     http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+/*trfm.c - trfm stuff*/
+
+#include <limits.h>
+
+#include "macros.h"
+#include "os.h"
+
+#include "muldiv.h"
+#include "jc_trace.h"
+#include "trfm.h"
+