Logo Search packages:      
Sourcecode: scheme48 version File versions  Download package

scheme48heap.c

#include <stdio.h>
#include "prescheme.h"
#include "scheme48vm-prelude.h"
#include "scheme48vm.h"

static long copy_weak_pointer(long, char *, char **);
static long real_copy_object(long, char *, char **);
void s48_write_barrier(long, char *, long);
char * s48_heap_pointer(void);
char * s48_heap_begin(void);
long s48_heap_size(void);
char * s48_oldspace_begin(void);
char * s48_oldspace_end(void);
void s48_register_static_areas(long, char **, long*, long, char **, long*);
long s48_gc_count(void);
char * s48_initialize_heap(long, long, char *);
char * s48_allocate_small(long);
long s48_available(void);
char s48_extantP(long);
long s48_gather_objects(char(*)(long), char(*)(char(*)(long)));
static char pD0(long);
char s48_check_heap(long);
long s48_find_all(long);
long s48_trace_value(long);
long s48_find_all_records(long);
void s48_trace_continuation_contentsB(char *, char *, long);
void s48_trace_locationsB(char *, char *);
void s48_trace_stob_contentsB(long);
void s48_collect(void);
void s48_make_availableAgc(long);
char * s48_allocate_tracedAgc(long);
char * s48_allocate_untracedAgc(long);
long s48_allocate_stob(long, long);
static char * Soldspace_hpS;
static char * Soldspace_limitS;
static char * Snewspace_beginS;
static char * Snewspace_endS;
static char * Soldspace_beginS;
static char * Soldspace_endS;
static char * *Spure_areasS;
static char * *Simpure_areasS;
static long *Spure_sizesS;
static long *Simpure_sizesS;
static long Spure_area_countS;
static long Simpure_area_countS;
static char (*Scollect_predicateS)(long);
static long Sfinding_typeS;
static long Sheap_errors_leftS;
static long Sgc_countS;
static char * Sfrom_beginS;
static char * Sfrom_endS;
static char * Sweak_pointer_hpS;
static char * Sweak_pointer_limitS;
static long Hthe_record_type10820;
char * s48_ShpS;
char * s48_SlimitS;

static long copy_weak_pointer(long weak_1X, char * frontier_2X, char * *TT0)
{
  char * arg0K0;
  long new_7X;
  char * frontier_6X;
  char * new_frontier_5X;
  char * old_4X;
  char * x_3X;
 {  x_3X = Sweak_pointer_hpS;
  if ((x_3X == NULL)) {
    goto L1682;}
  else {
    if (((Sweak_pointer_hpS) < (Sweak_pointer_limitS))) {
      arg0K0 = frontier_2X;
      goto L1687;}
    else {
      goto L1682;}}}
 L1682: {
  old_4X = Sweak_pointer_hpS;
  new_frontier_5X = frontier_2X + 1024;
  Sweak_pointer_hpS = frontier_2X;
  Sweak_pointer_limitS = new_frontier_5X;
  *((long *) (Sweak_pointer_hpS)) = (long) (261194);
  *((long *) ((Sweak_pointer_hpS) + 8)) = (long) ((((long) old_4X)));
  arg0K0 = new_frontier_5X;
  goto L1687;}
 L1687: {
  frontier_6X = arg0K0;
  new_7X = 3 + (((long) ((Sweak_pointer_hpS) + 4)));
  *((long *) ((Sweak_pointer_hpS) + 4)) = (long) ((*((long *) (((char *) (-3 + weak_1X))))));
  Sweak_pointer_hpS = ((Sweak_pointer_hpS) + 8);
  *((long *) ((((char *) (-3 + weak_1X))) + -4)) = (long) (new_7X);
  *TT0 = frontier_6X;
  return new_7X;}
}
static long real_copy_object(long thing_8X, char * frontier_9X, char * *TT0)
{
  long new_14X;
  char * data_addr_13X;
  char * a_12X;
  long descriptor_11X;
  long h_10X;
 {  h_10X = *((long *) ((((char *) (-3 + thing_8X))) + -4));
  if ((3 == (3 & h_10X))) {
    *TT0 = frontier_9X;
    return h_10X;}
  else {
    if ((1078 == h_10X)) {
      descriptor_11X = *((long *) (((char *) (-3 + thing_8X))));
      if ((3 == (3 & descriptor_11X))) {
        a_12X = ((char *) (-3 + descriptor_11X));
        if ((a_12X < (Sfrom_beginS))) {
          goto L2405;}
        else {
          if ((a_12X < (Sfrom_endS))) {
            return copy_weak_pointer(thing_8X, frontier_9X, TT0);}
          else {
            goto L2405;}}}
      else {
        goto L2405;}}
    else {
      goto L2405;}}}
 L2405: {
  *((long *) frontier_9X) = (long) (h_10X);
  data_addr_13X = frontier_9X + 4;
  new_14X = 3 + (((long) data_addr_13X));
  *((long *) ((((char *) (-3 + thing_8X))) + -4)) = (long) (new_14X);
  memcpy((void *)data_addr_13X, (void *)(((char *) (-3 + thing_8X))),((long)(((unsigned long)h_10X)>>8)));
  *TT0 = (data_addr_13X + (-4 & (3 + ((long)(((unsigned long)h_10X)>>8)))));
  return new_14X;}
}
void s48_write_barrier(long stob_15X, char * address_16X, long value_17X)
{

 {  return;}
}
char * s48_heap_pointer(void)
{

 {  return (s48_ShpS);}
}
char * s48_heap_begin(void)
{

 {  return (Snewspace_beginS);}
}
long s48_heap_size(void)
{

 {  return ((Snewspace_endS) - (Snewspace_beginS));}
}
char * s48_oldspace_begin(void)
{

 {  return (Soldspace_beginS);}
}
char * s48_oldspace_end(void)
{

 {  return (Soldspace_endS);}
}
void s48_register_static_areas(long pure_count_18X, char * *pure_areas_19X, long *pure_sizes_20X, long impure_count_21X, char * *impure_areas_22X, long *impure_sizes_23X)
{

 {  Spure_area_countS = pure_count_18X;
  Spure_areasS = pure_areas_19X;
  Spure_sizesS = pure_sizes_20X;
  Simpure_area_countS = impure_count_21X;
  Simpure_areasS = impure_areas_22X;
  Simpure_sizesS = impure_sizes_23X;
  return;}
}
long s48_gc_count(void)
{

 {  return (Sgc_countS);}
}
char * s48_initialize_heap(long heap_size_24X, long image_size_25X, char * image_start_26X)
{
  long arg1K0;
  char * temp_35X;
  char * temp_34X;
  char * temp_33X;
  char * temp_32X;
  long semisize_31X;
  long cells_30X;
  char * heap_29X;
  long heap_size_28X;
  long minimum_size_27X;
 {  minimum_size_27X = ((image_size_25X)<<2);
  if ((heap_size_24X < minimum_size_27X)) {
    ps_write_string("heap size ", (stderr));
    ps_write_integer(heap_size_24X, (stderr));
    ps_write_string(" is too small, using ", (stderr));
    ps_write_integer(minimum_size_27X, (stderr));
    { long ignoreXX;
    PS_WRITE_CHAR(10, (stderr), ignoreXX) }
    arg1K0 = minimum_size_27X;
    goto L776;}
  else {
    arg1K0 = heap_size_24X;
    goto L776;}}
 L776: {
  heap_size_28X = arg1K0;
  heap_29X = (char *)malloc((((heap_size_28X)<<2)));
  if ((heap_29X == NULL)) {
    ps_error("unable to allocate heap space", 0);
    goto L792;}
  else {
    goto L792;}}
 L792: {
  cells_30X = heap_size_28X / 2;
  semisize_31X = ((cells_30X)<<2);
  Snewspace_beginS = heap_29X;
  Snewspace_endS = ((Snewspace_beginS) + semisize_31X);
  Soldspace_beginS = (Snewspace_endS);
  Soldspace_endS = ((Soldspace_beginS) + semisize_31X);
  if (((Soldspace_beginS) == image_start_26X)) {
    temp_32X = s48_SlimitS;
    s48_SlimitS = (Soldspace_limitS);
    Soldspace_limitS = temp_32X;
    temp_33X = s48_ShpS;
    s48_ShpS = (Soldspace_hpS);
    Soldspace_hpS = temp_33X;
    temp_34X = Snewspace_beginS;
    Snewspace_beginS = (Soldspace_beginS);
    Soldspace_beginS = temp_34X;
    temp_35X = Snewspace_endS;
    Snewspace_endS = (Soldspace_endS);
    Soldspace_endS = temp_35X;
    goto L816;}
  else {
    goto L816;}}
 L816: {
  Soldspace_hpS = (Soldspace_beginS);
  Soldspace_limitS = (Soldspace_endS);
  s48_ShpS = ((Snewspace_beginS) + (((image_size_25X)<<2)));
  s48_SlimitS = (Snewspace_endS);
  return (Snewspace_beginS);}
}
char * s48_allocate_small(long len_36X)
{
  char * new_37X;
 {  new_37X = s48_ShpS;
  s48_ShpS = ((s48_ShpS) + (-4 & (3 + len_36X)));
  return new_37X;}
}
long s48_available(void)
{

 {  return (((((s48_SlimitS) - (s48_ShpS)))>>2));}
}
char s48_extantP(long thing_38X)
{
  char * a_39X;
 {  if ((3 == (3 & thing_38X))) {
    if ((3 == (3 & thing_38X))) {
      a_39X = ((char *) (-3 + thing_38X));
      if ((a_39X < (Sfrom_beginS))) {
        return 1;}
      else {
        if ((a_39X < (Sfrom_endS))) {
          return (3 == (3 & (*((long *) ((((char *) (-3 + thing_38X))) + -4)))));}
        else {
          return 1;}}}
    else {
      return 1;}}
  else {
    return 1;}}
}
long s48_gather_objects(char (*predicate_40X)(long), char (*for_each_object_41X)(char(*)(long)))
{
  char v_43X;
  char * start_hp_42X;
 {  Scollect_predicateS = predicate_40X;
  start_hp_42X = s48_ShpS;
  *((long *) (s48_ShpS)) = (long) (0);
  s48_ShpS = ((s48_ShpS) + 4);
  v_43X = (*for_each_object_41X)(pD0);
  if (v_43X) {
    *((long *) start_hp_42X) = (long) ((10 + (((((s48_ShpS) - (start_hp_42X + 4)))<<8))));
    return (3 + (((long) (start_hp_42X + 4))));}
  else {
    s48_ShpS = start_hp_42X;
    return 1;}}
}
static char pD0(long obj_44X)
{
  char x_45X;
 {  x_45X = (*(Scollect_predicateS))(obj_44X);
  if (x_45X) {
    if ((((s48_ShpS) + 16) < (s48_SlimitS))) {
      *((long *) (s48_ShpS)) = (long) (obj_44X);
      s48_ShpS = ((s48_ShpS) + 4);
      return 1;}
    else {
      return 0;}}
  else {
    return 1;}}
}
char s48_check_heap(long error_count_46X)
{
  char * arg0K0;
  long arg1K0;
  char * merged_arg0K1;
  char * merged_arg0K0;

  int check_area_return_tag;
  char check_area0_return_value;
  char * start_47X;
  char * end_48X;
  char temp_66X;
  char * addr_65X;
  long x_64X;
  char * addr_63X;
  char * next_62X;
  long d_61X;
  char * addr_60X;
  char v_59X;
  long i_58X;
  long count_57X;
  long *sizes_56X;
  char * *areas_55X;
  char v_54X;
  long i_53X;
  long count_52X;
  long *sizes_51X;
  char * *areas_50X;
  char v_49X;
 {  Sheap_errors_leftS = error_count_46X;
  merged_arg0K0 = (Snewspace_beginS);
  merged_arg0K1 = (s48_ShpS);
  check_area_return_tag = 0;
  goto check_area;
 check_area_return_0:
  v_49X = check_area0_return_value;
  if (v_49X) {
    if ((0 < (Simpure_area_countS))) {
      areas_50X = Simpure_areasS;
      sizes_51X = Simpure_sizesS;
      count_52X = Simpure_area_countS;
      arg1K0 = 0;
      goto L2888;}
    else {
      goto L2872;}}
  else {
    return 0;}}
 L2888: {
  i_53X = arg1K0;
  if ((i_53X < count_52X)) {
    merged_arg0K0 = (*(areas_50X + i_53X));
    merged_arg0K1 = ((*(areas_50X + i_53X)) + (*(sizes_51X + i_53X)));
    check_area_return_tag = 1;
    goto check_area;
   check_area_return_1:
    v_54X = check_area0_return_value;
    if (v_54X) {
      arg1K0 = (1 + i_53X);
      goto L2888;}
    else {
      return 0;}}
  else {
    goto L2872;}}
 L2872: {
  if ((0 < (Spure_area_countS))) {
    areas_55X = Spure_areasS;
    sizes_56X = Spure_sizesS;
    count_57X = Spure_area_countS;
    arg1K0 = 0;
    goto L2909;}
  else {
    return 1;}}
 L2909: {
  i_58X = arg1K0;
  if ((i_58X < count_57X)) {
    merged_arg0K0 = (*(areas_55X + i_58X));
    merged_arg0K1 = ((*(areas_55X + i_58X)) + (*(sizes_56X + i_58X)));
    check_area_return_tag = 2;
    goto check_area;
   check_area_return_2:
    v_59X = check_area0_return_value;
    if (v_59X) {
      arg1K0 = (1 + i_58X);
      goto L2909;}
    else {
      return 0;}}
  else {
    return 1;}}
 check_area: {
  start_47X = merged_arg0K0;
  end_48X = merged_arg0K1;{
  arg0K0 = start_47X;
  goto L2238;}
 L2238: {
  addr_60X = arg0K0;
  if ((addr_60X < end_48X)) {
    d_61X = *((long *) addr_60X);
    next_62X = addr_60X + (4 + (-4 & (3 + ((long)(((unsigned long)d_61X)>>8)))));
    if ((2 == (3 & d_61X))) {
      if ((end_48X < next_62X)) {
        ps_write_string("Heap-check: header too large.", (stderr));
        { long ignoreXX;
        PS_WRITE_CHAR(10, (stderr), ignoreXX) }
        Sheap_errors_leftS = (-1 + (Sheap_errors_leftS));
        check_area0_return_value = ((Sheap_errors_leftS) < 1);
        goto check_area_return;}
      else {
        if ((2 == (3 & d_61X))) {
          if (((31 & (((d_61X)>>2))) < 17)) {
            goto L2264;}
          else {
            arg0K0 = next_62X;
            goto L2238;}}
        else {
          goto L2264;}}}
    else {
      ps_write_string("Heap-check: unexpected non-header.", (stderr));
      { long ignoreXX;
      PS_WRITE_CHAR(10, (stderr), ignoreXX) }
      Sheap_errors_leftS = (-1 + (Sheap_errors_leftS));
      check_area0_return_value = ((Sheap_errors_leftS) < 1);
      goto check_area_return;}}
  else {
    check_area0_return_value = 1;
    goto check_area_return;}}
 L2264: {
  arg0K0 = (addr_60X + 4);
  goto L1793;}
 L1793: {
  addr_63X = arg0K0;
  if ((addr_63X == next_62X)) {
    arg0K0 = next_62X;
    goto L2238;}
  else {
    x_64X = *((long *) addr_63X);
    if ((2 == (3 & x_64X))) {
      ps_write_string("Heap-check: unexpected header.", (stderr));
      { long ignoreXX;
      PS_WRITE_CHAR(10, (stderr), ignoreXX) }
      Sheap_errors_leftS = (-1 + (Sheap_errors_leftS));
      if (((Sheap_errors_leftS) < 1)) {
        arg0K0 = next_62X;
        goto L2238;}
      else {
        check_area0_return_value = 0;
        goto check_area_return;}}
    else {
      if ((3 == (3 & x_64X))) {
        addr_65X = (((char *) (-3 + x_64X))) + -4;
        temp_66X = addr_65X < (Snewspace_beginS);
        if (temp_66X) {
          goto L1161;}
        else {
          if ((addr_65X < (s48_ShpS))) {
            if ((2 == (3 & (*((long *) addr_65X))))) {
              goto L1818;}
            else {
              ps_write_string("Heap-check: stob has no header.", (stderr));
              { long ignoreXX;
              PS_WRITE_CHAR(10, (stderr), ignoreXX) }
              Sheap_errors_leftS = (-1 + (Sheap_errors_leftS));
              if (((Sheap_errors_leftS) < 1)) {
                goto L1818;}
              else {
                check_area0_return_value = 0;
                goto check_area_return;}}}
          else {
            goto L1161;}}}
      else {
        goto L1818;}}}}
 L1161: {
  ps_write_string("Heap-check: address out of bounds.", (stderr));
  { long ignoreXX;
  PS_WRITE_CHAR(10, (stderr), ignoreXX) }
  Sheap_errors_leftS = (-1 + (Sheap_errors_leftS));
  if (((Sheap_errors_leftS) < 1)) {
    goto L1818;}
  else {
    check_area0_return_value = 0;
    goto check_area_return;}}
 L1818: {
  arg0K0 = (addr_63X + 4);
  goto L1793;}
 check_area_return:
  switch (check_area_return_tag) {
  case 0: goto check_area_return_0;
  case 1: goto check_area_return_1;
  default: goto check_area_return_2;
  }}

}
long s48_find_all(long type_67X)
{
  char * arg0K0;
  long arg1K0;
  char * merged_arg0K1;
  char * merged_arg0K0;

  int Hproc107968_return_tag;
  char Hproc1079680_return_value;
  char * start_69X;
  char * end_70X;
  char * next_87X;
  long d_86X;
  char * addr_85X;
  long type_84X;
  char v_83X;
  long i_82X;
  long count_81X;
  long *sizes_80X;
  char * *areas_79X;
  char v_78X;
  long i_77X;
  long count_76X;
  long *sizes_75X;
  char * *areas_74X;
  char v_73X;
  char * start_hp_72X;
  char * start_hp_71X;
 {  Sfinding_typeS = type_67X;
  start_hp_71X = s48_ShpS;
  start_hp_72X = s48_ShpS;
  *((long *) (s48_ShpS)) = (long) (0);
  s48_ShpS = ((s48_ShpS) + 4);
  merged_arg0K0 = (Snewspace_beginS);
  merged_arg0K1 = start_hp_71X;
  Hproc107968_return_tag = 0;
  goto Hproc107968;
 Hproc107968_return_0:
  v_73X = Hproc1079680_return_value;
  if (v_73X) {
    if ((0 < (Simpure_area_countS))) {
      areas_74X = Simpure_areasS;
      sizes_75X = Simpure_sizesS;
      count_76X = Simpure_area_countS;
      arg1K0 = 0;
      goto L3007;}
    else {
      goto L2976;}}
  else {
    goto L2989;}}
 L3007: {
  i_77X = arg1K0;
  if ((i_77X < count_76X)) {
    merged_arg0K0 = (*(areas_74X + i_77X));
    merged_arg0K1 = ((*(areas_74X + i_77X)) + (*(sizes_75X + i_77X)));
    Hproc107968_return_tag = 1;
    goto Hproc107968;
   Hproc107968_return_1:
    v_78X = Hproc1079680_return_value;
    if (v_78X) {
      arg1K0 = (1 + i_77X);
      goto L3007;}
    else {
      goto L2989;}}
  else {
    goto L2976;}}
 L2976: {
  if ((0 < (Spure_area_countS))) {
    areas_79X = Spure_areasS;
    sizes_80X = Spure_sizesS;
    count_81X = Spure_area_countS;
    arg1K0 = 0;
    goto L3028;}
  else {
    goto L2991;}}
 L2989: {
  s48_ShpS = start_hp_72X;
  return 1;}
 L3028: {
  i_82X = arg1K0;
  if ((i_82X < count_81X)) {
    merged_arg0K0 = (*(areas_79X + i_82X));
    merged_arg0K1 = ((*(areas_79X + i_82X)) + (*(sizes_80X + i_82X)));
    Hproc107968_return_tag = 2;
    goto Hproc107968;
   Hproc107968_return_2:
    v_83X = Hproc1079680_return_value;
    if (v_83X) {
      arg1K0 = (1 + i_82X);
      goto L3028;}
    else {
      goto L2989;}}
  else {
    goto L2991;}}
 L2991: {
  *((long *) start_hp_72X) = (long) ((10 + (((((s48_ShpS) - (start_hp_72X + 4)))<<8))));
  return (3 + (((long) (start_hp_72X + 4))));}
 Hproc107968: {
  start_69X = merged_arg0K0;
  end_70X = merged_arg0K1;{
  type_84X = Sfinding_typeS;
  arg0K0 = start_69X;
  goto L2521;}
 L2521: {
  addr_85X = arg0K0;
  if ((addr_85X < end_70X)) {
    d_86X = *((long *) addr_85X);
    next_87X = addr_85X + (4 + (-4 & (3 + ((long)(((unsigned long)d_86X)>>8)))));
    if ((2 == (3 & d_86X))) {
      if ((type_84X == (31 & (((d_86X)>>2))))) {
        if ((((s48_ShpS) + 16) < (s48_SlimitS))) {
          *((long *) (s48_ShpS)) = (long) ((3 + (((long) (addr_85X + 4)))));
          s48_ShpS = ((s48_ShpS) + 4);
          arg0K0 = next_87X;
          goto L2521;}
        else {
          Hproc1079680_return_value = 0;
          goto Hproc107968_return;}}
      else {
        arg0K0 = next_87X;
        goto L2521;}}
    else {
      ps_write_string("heap is in an inconsistent state.", (stderr));
      Hproc1079680_return_value = 0;
      goto Hproc107968_return;}}
  else {
    Hproc1079680_return_value = 1;
    goto Hproc107968_return;}}
 Hproc107968_return:
  switch (Hproc107968_return_tag) {
  case 0: goto Hproc107968_return_0;
  case 1: goto Hproc107968_return_1;
  default: goto Hproc107968_return_2;
  }}

}
long s48_trace_value(long stob_88X)
{
  char * new_hp_91X;
  long new_thing_90X;
  char * a_89X;
 {  if ((3 == (3 & stob_88X))) {
    a_89X = ((char *) (-3 + stob_88X));
    if ((a_89X < (Sfrom_beginS))) {
      return stob_88X;}
    else {
      if ((a_89X < (Sfrom_endS))) {
        new_thing_90X = real_copy_object(stob_88X, (s48_ShpS), &new_hp_91X);
        s48_ShpS = new_hp_91X;
        return new_thing_90X;}
      else {
        return stob_88X;}}}
  else {
    return stob_88X;}}
}
long s48_find_all_records(long record_type_92X)
{
  char * arg0K0;
  long arg1K0;
  char * merged_arg0K1;
  char * merged_arg0K0;

  int Hproc108793_return_tag;
  char Hproc1087930_return_value;
  char * start_94X;
  char * end_95X;
  long obj_113X;
  char * next_112X;
  long d_111X;
  char * addr_110X;
  long type_109X;
  char v_108X;
  long i_107X;
  long count_106X;
  long *sizes_105X;
  char * *areas_104X;
  char v_103X;
  long i_102X;
  long count_101X;
  long *sizes_100X;
  char * *areas_99X;
  char v_98X;
  char * start_hp_97X;
  char * start_hp_96X;
 {  Hthe_record_type10820 = record_type_92X;
  Sfinding_typeS = 9;
  start_hp_96X = s48_ShpS;
  start_hp_97X = s48_ShpS;
  *((long *) (s48_ShpS)) = (long) (0);
  s48_ShpS = ((s48_ShpS) + 4);
  merged_arg0K0 = (Snewspace_beginS);
  merged_arg0K1 = start_hp_96X;
  Hproc108793_return_tag = 0;
  goto Hproc108793;
 Hproc108793_return_0:
  v_98X = Hproc1087930_return_value;
  if (v_98X) {
    if ((0 < (Simpure_area_countS))) {
      areas_99X = Simpure_areasS;
      sizes_100X = Simpure_sizesS;
      count_101X = Simpure_area_countS;
      arg1K0 = 0;
      goto L3137;}
    else {
      goto L3106;}}
  else {
    goto L3119;}}
 L3137: {
  i_102X = arg1K0;
  if ((i_102X < count_101X)) {
    merged_arg0K0 = (*(areas_99X + i_102X));
    merged_arg0K1 = ((*(areas_99X + i_102X)) + (*(sizes_100X + i_102X)));
    Hproc108793_return_tag = 1;
    goto Hproc108793;
   Hproc108793_return_1:
    v_103X = Hproc1087930_return_value;
    if (v_103X) {
      arg1K0 = (1 + i_102X);
      goto L3137;}
    else {
      goto L3119;}}
  else {
    goto L3106;}}
 L3106: {
  if ((0 < (Spure_area_countS))) {
    areas_104X = Spure_areasS;
    sizes_105X = Spure_sizesS;
    count_106X = Spure_area_countS;
    arg1K0 = 0;
    goto L3158;}
  else {
    goto L3121;}}
 L3119: {
  s48_ShpS = start_hp_97X;
  return 1;}
 L3158: {
  i_107X = arg1K0;
  if ((i_107X < count_106X)) {
    merged_arg0K0 = (*(areas_104X + i_107X));
    merged_arg0K1 = ((*(areas_104X + i_107X)) + (*(sizes_105X + i_107X)));
    Hproc108793_return_tag = 2;
    goto Hproc108793;
   Hproc108793_return_2:
    v_108X = Hproc1087930_return_value;
    if (v_108X) {
      arg1K0 = (1 + i_107X);
      goto L3158;}
    else {
      goto L3119;}}
  else {
    goto L3121;}}
 L3121: {
  *((long *) start_hp_97X) = (long) ((10 + (((((s48_ShpS) - (start_hp_97X + 4)))<<8))));
  return (3 + (((long) (start_hp_97X + 4))));}
 Hproc108793: {
  start_94X = merged_arg0K0;
  end_95X = merged_arg0K1;{
  type_109X = Sfinding_typeS;
  arg0K0 = start_94X;
  goto L2688;}
 L2688: {
  addr_110X = arg0K0;
  if ((addr_110X < end_95X)) {
    d_111X = *((long *) addr_110X);
    next_112X = addr_110X + (4 + (-4 & (3 + ((long)(((unsigned long)d_111X)>>8)))));
    if ((2 == (3 & d_111X))) {
      if ((type_109X == (31 & (((d_111X)>>2))))) {
        obj_113X = 3 + (((long) (addr_110X + 4)));
        if (((*((long *) (((char *) (-3 + obj_113X))))) == (Hthe_record_type10820))) {
          if ((((s48_ShpS) + 16) < (s48_SlimitS))) {
            *((long *) (s48_ShpS)) = (long) (obj_113X);
            s48_ShpS = ((s48_ShpS) + 4);
            arg0K0 = next_112X;
            goto L2688;}
          else {
            Hproc1087930_return_value = 0;
            goto Hproc108793_return;}}
        else {
          arg0K0 = next_112X;
          goto L2688;}}
      else {
        arg0K0 = next_112X;
        goto L2688;}}
    else {
      ps_write_string("heap is in an inconsistent state.", (stderr));
      Hproc1087930_return_value = 0;
      goto Hproc108793_return;}}
  else {
    Hproc1087930_return_value = 1;
    goto Hproc108793_return;}}
 Hproc108793_return:
  switch (Hproc108793_return_tag) {
  case 0: goto Hproc108793_return_0;
  case 1: goto Hproc108793_return_1;
  default: goto Hproc108793_return_2;
  }}

}
void s48_trace_continuation_contentsB(char * contents_pointer_114X, char * code_pointer_115X, long mask_size_116X)
{
  char * arg0K0;
  char * arg0K1;
  long arg1K0;
  long x2_126X;
  char * new_hp_125X;
  long new_thing_124X;
  char * a_123X;
  long stob_122X;
  char * ptr_121X;
  long mask_120X;
  char * trace_ptr_119X;
  char * mask_ptr_118X;
  char * mask_pointer_117X;
 {  mask_pointer_117X = code_pointer_115X + -5;
  arg0K0 = (mask_pointer_117X + (0 - mask_size_116X));
  arg0K1 = contents_pointer_114X;
  goto L3288;}
 L3288: {
  mask_ptr_118X = arg0K0;
  trace_ptr_119X = arg0K1;
  if ((mask_ptr_118X == mask_pointer_117X)) {
    return;}
  else {
    arg1K0 = (*((unsigned char *) mask_ptr_118X));
    arg0K1 = trace_ptr_119X;
    goto L3296;}}
 L3296: {
  mask_120X = arg1K0;
  ptr_121X = arg0K1;
  if ((0 == mask_120X)) {
    arg0K0 = (mask_ptr_118X + 1);
    arg0K1 = (trace_ptr_119X + 32);
    goto L3288;}
  else {
    if ((1 == (1 & mask_120X))) {
      stob_122X = *((long *) ptr_121X);
      if ((3 == (3 & stob_122X))) {
        a_123X = ((char *) (-3 + stob_122X));
        if ((a_123X < (Sfrom_beginS))) {
          arg1K0 = stob_122X;
          goto L3309;}
        else {
          if ((a_123X < (Sfrom_endS))) {
            new_thing_124X = real_copy_object(stob_122X, (s48_ShpS), &new_hp_125X);
            s48_ShpS = new_hp_125X;
            arg1K0 = new_thing_124X;
            goto L3309;}
          else {
            arg1K0 = stob_122X;
            goto L3309;}}}
      else {
        arg1K0 = stob_122X;
        goto L3309;}}
    else {
      goto L3314;}}}
 L3309: {
  x2_126X = arg1K0;
  *((long *) ptr_121X) = (long) (x2_126X);
  goto L3314;}
 L3314: {
  arg1K0 = (((mask_120X)>>1));
  arg0K1 = (ptr_121X + 4);
  goto L3296;}
}
void s48_trace_locationsB(char * start_127X, char * end_128X)
{
  char * arg0K0;
  char * arg0K1;
  long arg1K0;
  long new_146X;
  char * data_addr_145X;
  char * frontier_144X;
  long new_thing_143X;
  char * data_pointer_142X;
  long mask_size_141X;
  char * code_pointer_140X;
  long size_139X;
  char * frontier_138X;
  long new_thing_137X;
  char * a_136X;
  long descriptor_135X;
  long h_134X;
  char * a_133X;
  char * next_132X;
  long thing_131X;
  char * frontier_130X;
  char * addr_129X;
 {  arg0K0 = start_127X;
  arg0K1 = (s48_ShpS);
  goto L3469;}
 L3469: {
  addr_129X = arg0K0;
  frontier_130X = arg0K1;
  if ((addr_129X < end_128X)) {
    thing_131X = *((long *) addr_129X);
    next_132X = addr_129X + 4;
    if ((2 == (3 & thing_131X))) {
      if ((2 == (3 & thing_131X))) {
        if (((31 & (((thing_131X)>>2))) < 17)) {
          goto L3486;}
        else {
          arg0K0 = (next_132X + (-4 & (3 + ((long)(((unsigned long)thing_131X)>>8)))));
          arg0K1 = frontier_130X;
          goto L3469;}}
      else {
        goto L3486;}}
    else {
      if ((3 == (3 & thing_131X))) {
        a_133X = ((char *) (-3 + thing_131X));
        if ((a_133X < (Sfrom_beginS))) {
          arg0K0 = next_132X;
          arg0K1 = frontier_130X;
          goto L3469;}
        else {
          if ((a_133X < (Sfrom_endS))) {
            h_134X = *((long *) ((((char *) (-3 + thing_131X))) + -4));
            if ((3 == (3 & h_134X))) {
              arg1K0 = h_134X;
              arg0K1 = frontier_130X;
              goto L3504;}
            else {
              if ((1078 == h_134X)) {
                descriptor_135X = *((long *) (((char *) (-3 + thing_131X))));
                if ((3 == (3 & descriptor_135X))) {
                  a_136X = ((char *) (-3 + descriptor_135X));
                  if ((a_136X < (Sfrom_beginS))) {
                    goto L4095;}
                  else {
                    if ((a_136X < (Sfrom_endS))) {
                      new_thing_137X = copy_weak_pointer(thing_131X, frontier_130X, &frontier_138X);
                      arg1K0 = new_thing_137X;
                      arg0K1 = frontier_138X;
                      goto L3504;}
                    else {
                      goto L4095;}}}
                else {
                  goto L4095;}}
              else {
                goto L4095;}}}
          else {
            arg0K0 = next_132X;
            arg0K1 = frontier_130X;
            goto L3469;}}}
      else {
        arg0K0 = next_132X;
        arg0K1 = frontier_130X;
        goto L3469;}}}
  else {
    s48_ShpS = frontier_130X;
    return;}}
 L3486: {
  if ((10 == (31 & (((thing_131X)>>2))))) {
    size_139X = -4 & (3 + ((long)(((unsigned long)thing_131X)>>8)));
    s48_ShpS = frontier_130X;
    code_pointer_140X = (((char *) (-3 + (*((long *) (next_132X + 4)))))) + ((((*((long *) next_132X)))>>2));
    mask_size_141X = *((unsigned char *) (code_pointer_140X + -3));
    if ((0 == mask_size_141X)) {s48_trace_locationsB(next_132X, (next_132X + size_139X));
      goto L3555;}
    else {
      data_pointer_142X = next_132X + 12;s48_trace_locationsB(next_132X, data_pointer_142X);s48_trace_continuation_contentsB(data_pointer_142X, code_pointer_140X, mask_size_141X);
      goto L3555;}}
  else {
    arg0K0 = next_132X;
    arg0K1 = frontier_130X;
    goto L3469;}}
 L3504: {
  new_thing_143X = arg1K0;
  frontier_144X = arg0K1;
  *((long *) addr_129X) = (long) (new_thing_143X);
  arg0K0 = next_132X;
  arg0K1 = frontier_144X;
  goto L3469;}
 L4095: {
  *((long *) frontier_130X) = (long) (h_134X);
  data_addr_145X = frontier_130X + 4;
  new_146X = 3 + (((long) data_addr_145X));
  *((long *) ((((char *) (-3 + thing_131X))) + -4)) = (long) (new_146X);
  memcpy((void *)data_addr_145X, (void *)(((char *) (-3 + thing_131X))),((long)(((unsigned long)h_134X)>>8)));
  arg1K0 = new_146X;
  arg0K1 = (data_addr_145X + (-4 & (3 + ((long)(((unsigned long)h_134X)>>8)))));
  goto L3504;}
 L3555: {
  arg0K0 = (next_132X + size_139X);
  arg0K1 = (s48_ShpS);
  goto L3469;}
}
void s48_trace_stob_contentsB(long stob_147X)
{
  char * start_149X;
  long h_148X;
 {  h_148X = *((long *) ((((char *) (-3 + stob_147X))) + -4));
  start_149X = ((char *) (-3 + stob_147X));
  s48_trace_locationsB(start_149X, (start_149X + (-4 & (3 + ((long)(((unsigned long)h_148X)>>8))))));
  return;}
}
void s48_collect(void)
{
  char * arg0K1;
  char * arg0K0;
  long arg1K0;
  long x2_165X;
  long h_164X;
  char * a_163X;
  long value_162X;
  char * scan_161X;
  char * next_160X;
  char * end_159X;
  char * start_158X;
  char * end_157X;
  char * x_156X;
  char * end_155X;
  char * start_154X;
  char * temp_153X;
  char * temp_152X;
  char * temp_151X;
  char * temp_150X;
 {  Sfrom_beginS = (Snewspace_beginS);
  Sfrom_endS = (Snewspace_endS);
  temp_150X = s48_SlimitS;
  s48_SlimitS = (Soldspace_limitS);
  Soldspace_limitS = temp_150X;
  temp_151X = s48_ShpS;
  s48_ShpS = (Soldspace_hpS);
  Soldspace_hpS = temp_151X;
  temp_152X = Snewspace_beginS;
  Snewspace_beginS = (Soldspace_beginS);
  Soldspace_beginS = temp_152X;
  temp_153X = Snewspace_endS;
  Snewspace_endS = (Soldspace_endS);
  Soldspace_endS = temp_153X;
  s48_ShpS = (Snewspace_beginS);
  Sweak_pointer_hpS = NULL;s48_gc_root();
  arg0K0 = (Snewspace_beginS);
  goto L3767;}
 L3767: {
  start_154X = arg0K0;
  end_155X = s48_ShpS;s48_trace_locationsB(start_154X, end_155X);
  if (((((((s48_SlimitS) - (s48_ShpS)))>>2)) < 0)) {
    ps_error("GC error: ran out of space in new heap", 0);
    goto L3727;}
  else {
    if ((end_155X < (s48_ShpS))) {
      arg0K0 = end_155X;
      goto L3767;}
    else {
      goto L3727;}}}
 L3727: {
  if (((Sweak_pointer_hpS) == NULL)) {
    goto L3729;}
  else {
    x_156X = Sweak_pointer_limitS;
    end_157X = Sweak_pointer_hpS;
    arg0K0 = (x_156X + -1024);
    arg0K1 = end_157X;
    goto L2147;}}
 L3729: {
s48_post_gc_cleanup();
  Sgc_countS = (1 + (Sgc_countS));
  return;}
 L2147: {
  start_158X = arg0K0;
  end_159X = arg0K1;
  next_160X = ((char *) (*((long *) (start_158X + 8))));
  arg0K0 = start_158X;
  goto L1500;}
 L1500: {
  scan_161X = arg0K0;
  if ((scan_161X < end_159X)) {
    *((long *) scan_161X) = (long) (1078);
    value_162X = *((long *) (scan_161X + 4));
    if ((3 == (3 & value_162X))) {
      a_163X = ((char *) (-3 + value_162X));
      if ((a_163X < (Sfrom_beginS))) {
        goto L1546;}
      else {
        if ((a_163X < (Sfrom_endS))) {
          if ((3 == (3 & value_162X))) {
            h_164X = *((long *) ((((char *) (-3 + value_162X))) + -4));
            if ((3 == (3 & h_164X))) {
              arg1K0 = h_164X;
              goto L1541;}
            else {
              arg1K0 = 1;
              goto L1541;}}
          else {
            goto L1546;}}
        else {
          goto L1546;}}}
    else {
      goto L1546;}}
  else {
    if ((next_160X == NULL)) {
      if ((end_157X < (Sweak_pointer_limitS))) {
        *((long *) end_157X) = (long) ((74 + ((((-4 & ((Sweak_pointer_limitS) - (end_157X + 4))))<<8))));
        goto L3729;}
      else {
        goto L3729;}}
    else {
      arg0K0 = (next_160X + -1024);
      arg0K1 = next_160X;
      goto L2147;}}}
 L1546: {
  arg0K0 = (scan_161X + 8);
  goto L1500;}
 L1541: {
  x2_165X = arg1K0;
  *((long *) (scan_161X + 4)) = (long) (x2_165X);
  goto L1546;}
}
void s48_make_availableAgc(long len_166X)
{
  char x_167X;
 {  x_167X = ((s48_ShpS) + (-4 & (3 + len_166X))) < (s48_SlimitS);
  if (x_167X) {
    goto L3798;}
  else {s48_collect();
    goto L3798;}}
 L3798: {
  if ((((s48_ShpS) + (-4 & (3 + len_166X))) < (s48_SlimitS))) {
    return;}
  else {
    ps_error("Scheme 48 heap overflow", 0);
    return;}}
}
char * s48_allocate_tracedAgc(long len_168X)
{
  char * new_170X;
  char x_169X;
 {  x_169X = ((s48_ShpS) + (-4 & (3 + len_168X))) < (s48_SlimitS);
  if (x_169X) {
    goto L3872;}
  else {s48_collect();
    goto L3872;}}
 L3872: {
  if ((((s48_ShpS) + (-4 & (3 + len_168X))) < (s48_SlimitS))) {
    new_170X = s48_ShpS;
    s48_ShpS = ((s48_ShpS) + (-4 & (3 + len_168X)));
    return new_170X;}
  else {
    return NULL;}}
}
char * s48_allocate_untracedAgc(long len_171X)
{
  char * new_173X;
  char x_172X;
 {  x_172X = ((s48_ShpS) + (-4 & (3 + len_171X))) < (s48_SlimitS);
  if (x_172X) {
    goto L3944;}
  else {s48_collect();
    goto L3944;}}
 L3944: {
  if ((((s48_ShpS) + (-4 & (3 + len_171X))) < (s48_SlimitS))) {
    new_173X = s48_ShpS;
    s48_ShpS = ((s48_ShpS) + (-4 & (3 + len_171X)));
    return new_173X;}
  else {
    return NULL;}}
}
long s48_allocate_stob(long type_174X, long size_175X)
{
  long arg1K0;
  char * arg0K0;
  char * thing_183X;
  char * new_182X;
  char * new_181X;
  char x_180X;
  char x_179X;
  long needed_178X;
  long length_in_bytes_177X;
  char tracedP_176X;
 {  tracedP_176X = type_174X < 17;
  if (tracedP_176X) {
    arg1K0 = (((size_175X)<<2));
    goto L3970;}
  else {
    arg1K0 = size_175X;
    goto L3970;}}
 L3970: {
  length_in_bytes_177X = arg1K0;
  needed_178X = 4 + length_in_bytes_177X;
  if (tracedP_176X) {
    x_179X = ((s48_ShpS) + (-4 & (3 + needed_178X))) < (s48_SlimitS);
    if (x_179X) {
      goto L4036;}
    else {s48_collect();
      goto L4036;}}
  else {
    x_180X = ((s48_ShpS) + (-4 & (3 + needed_178X))) < (s48_SlimitS);
    if (x_180X) {
      goto L4055;}
    else {s48_collect();
      goto L4055;}}}
 L4036: {
  if ((((s48_ShpS) + (-4 & (3 + needed_178X))) < (s48_SlimitS))) {
    new_181X = s48_ShpS;
    s48_ShpS = ((s48_ShpS) + (-4 & (3 + needed_178X)));
    arg0K0 = new_181X;
    goto L3986;}
  else {
    arg0K0 = NULL;
    goto L3986;}}
 L4055: {
  if ((((s48_ShpS) + (-4 & (3 + needed_178X))) < (s48_SlimitS))) {
    new_182X = s48_ShpS;
    s48_ShpS = ((s48_ShpS) + (-4 & (3 + needed_178X)));
    arg0K0 = new_182X;
    goto L3986;}
  else {
    arg0K0 = NULL;
    goto L3986;}}
 L3986: {
  thing_183X = arg0K0;
  if ((thing_183X == NULL)) {
    ps_error("insufficient heap space for external allocation", 0);
    goto L3998;}
  else {
    goto L3998;}}
 L3998: {
  *((long *) thing_183X) = (long) ((2 + (((((((length_in_bytes_177X)<<6)) + type_174X))<<2))));
  return (3 + (((long) (thing_183X + 4))));}
}void
s48_heap_init(void)
{
Spure_area_countS = 0;
Simpure_area_countS = 0;
Sfinding_typeS = 1;
Sheap_errors_leftS = 0;
Sgc_countS = 0;
Hthe_record_type10820 = 1;
}

Generated by  Doxygen 1.6.0   Back to index