wrftladj/adStack.c

   1 static char adSid[]="$Id: adStack.c 3723 2011-02-24 13:34:42Z llh $";
   2
   3 #ifndef CRAY
   4 # ifdef NOUNDERSCORE
   5 #      define PUSHINTEGER4ARRAY pushinteger4array
   6 #      define POPINTEGER4ARRAY popinteger4array
   7 #      define PUSHREAL8ARRAY pushreal8array
   8 #      define POPREAL8ARRAY popreal8array
   9 # else
  10 #   ifdef F2CSTYLE
  11 #      define PUSHINTEGER4ARRAY pushinteger4array_
  12 #      define POPINTEGER4ARRAY popinteger4array_
  13 #      define PUSHREAL8ARRAY pushreal8array_
  14 #      define POPREAL8ARRAY popreal8array_
  15 #   else
  16 #      define PUSHINTEGER4ARRAY pushinteger4array_
  17 #      define POPINTEGER4ARRAY popinteger4array_
  18 #      define PUSHREAL8ARRAY pushreal8array_
  19 #      define POPREAL8ARRAY popreal8array_
  20 #   endif
  21 # endif
  22 #endif
  23
  24 #include <stdlib.h>
  25 #include <stdio.h>
  26 #include <string.h>
  27
  28 #define ONE_BLOCK_SIZE 16384
  29 #ifndef STACK_SIZE_TRACING
  30 #define STACK_SIZE_TRACING 1
  31 #endif
  32 /* The main stack is a double-chain of DoubleChainedBlock objects.
  33  * Each DoubleChainedBlock holds an array[ONE_BLOCK_SIZE] of char. */
  34 typedef struct _doubleChainedBlock{
  35   struct _doubleChainedBlock *prev ;
  36   char                       *contents ;
  37   struct _doubleChainedBlock *next ;
  38 } DoubleChainedBlock ;
  39
  40 /* Globals that define the current position in the stack: */
  41 static DoubleChainedBlock *curStack = NULL ;
  42 static char               *curStackTop    = NULL ;
  43 /* Globals that define the current LOOKing position in the stack: */
  44 static DoubleChainedBlock *lookStack = NULL ;
  45 static char               *lookStackTop    = NULL ;
  46
  47 static long int mmctraffic = 0 ;
  48 static long int mmctrafficM = 0 ;
  49 #ifdef STACK_SIZE_TRACING
  50 long int bigStackSize = 0;
  51 #endif
  52
  53 /* PUSHes "nbChars" consecutive chars from a location starting at address "x".
  54  * Resets the LOOKing position if it was active.
  55  * Checks that there is enough space left to hold "nbChars" chars.
  56  * Otherwise, allocates the necessary space. */
  57 void pushNarray(char *x, unsigned int nbChars) {
  58   unsigned int nbmax = (curStack)?ONE_BLOCK_SIZE-(curStackTop-(curStack->contents)):0 ;
  59 #ifdef STACK_SIZE_TRACING
  60   bigStackSize += nbChars;
  61 #endif
  62
  63   mmctraffic += nbChars ;
  64   while (mmctraffic >= 1000000) {
  65      mmctraffic -= 1000000 ;
  66      mmctrafficM++ ;
  67   }
  68
  69   lookStack = NULL ;
  70   if (nbChars <= nbmax) {
  71     memcpy(curStackTop,x,nbChars) ;
  72     curStackTop+=nbChars ;
  73   } else {
  74     char *inx = x+(nbChars-nbmax) ;
  75     if (nbmax>0) memcpy(curStackTop,inx,nbmax) ;
  76     while (inx>x) {
  77       if ((curStack == NULL) || (curStack->next == NULL)) {
  78         /* Create new block: */
  79         DoubleChainedBlock *newStack ;
  80         char *contents = (char*)malloc(ONE_BLOCK_SIZE*sizeof(char)) ;
  81         newStack = (DoubleChainedBlock*)malloc(sizeof(DoubleChainedBlock)) ;
  82         if ((contents == NULL) || (newStack == NULL)) {
  83           DoubleChainedBlock *stack = curStack ;
  84           int nbBlocks = (stack?-1:0) ;
  85           while(stack) {
  86               stack = stack->prev ;
  87               nbBlocks++ ;
  88           }
  89           printf("Out of memory (allocated %i blocks of %i bytes)\n",
  90                  nbBlocks, ONE_BLOCK_SIZE) ;
  91           exit(0);
  92         }
  93         if (curStack != NULL) curStack->next = newStack ;
  94         newStack->prev = curStack ;
  95         newStack->next = NULL ;
  96         newStack->contents = contents ;
  97         curStack = newStack ;
  98         /* new block created! */
  99       } else
 100         curStack = curStack->next ;
 101       inx -= ONE_BLOCK_SIZE ;
 102       if(inx>x)
 103         memcpy(curStack->contents,inx,ONE_BLOCK_SIZE) ;
 104       else {
 105         unsigned int nbhead = (inx-x)+ONE_BLOCK_SIZE ;
 106         curStackTop = curStack->contents ;
 107         memcpy(curStackTop,x,nbhead) ;
 108         curStackTop += nbhead ;
 109       }
 110     }
 111   }
 112 }
 113
 114 /* POPs "nbChars" consecutive chars to a location starting at address "x".
 115  * Resets the LOOKing position if it was active.
 116  * Checks that there is enough data to fill "nbChars" chars.
 117  * Otherwise, pops as many blocks as necessary. */
 118 void popNarray(char *x, unsigned int nbChars) {
 119   unsigned int nbmax = curStackTop-(curStack->contents) ;
 120 #ifdef STACK_SIZE_TRACING
 121   bigStackSize -= nbChars;
 122 #endif
 123   lookStack = NULL ;
 124   if (nbChars <= nbmax) {
 125     curStackTop-=nbChars ;
 126     memcpy(x,curStackTop,nbChars);
 127   } else {
 128     char *tlx = x+nbChars ;
 129     if (nbmax>0) memcpy(x,curStack->contents,nbmax) ;
 130     x+=nbmax ;
 131     while (x<tlx) {
 132       curStack = curStack->prev ;
 133       if (curStack==NULL) printf("Popping from an empty stack!!!") ;
 134       if (x+ONE_BLOCK_SIZE<tlx) {
 135         memcpy(x,curStack->contents,ONE_BLOCK_SIZE) ;
 136         x += ONE_BLOCK_SIZE ;
 137       } else {
 138         unsigned int nbtail = tlx-x ;
 139         curStackTop=(curStack->contents)+ONE_BLOCK_SIZE-nbtail ;
 140         memcpy(x,curStackTop,nbtail) ;
 141         x = tlx ;
 142       }
 143     }
 144   }
 145 }
 146
 147 /* LOOKs "nbChars" consecutive chars to a location starting at address "x".
 148  * Activates the LOOKing position if it was reset.
 149  * LOOKing is just like POPping, except that the main pointer
 150  * remains in place, so that the value is not POPped.
 151  * Further PUSHs or POPs will start from the same place as if
 152  * no LOOK had been made. */
 153 void lookNarray(char *x, unsigned int nbChars) {
 154   unsigned int nbmax ;
 155   if (lookStack == NULL) {
 156     lookStack = curStack ;
 157     lookStackTop = curStackTop ;
 158   }
 159   nbmax = lookStackTop-(lookStack->contents) ;
 160   if (nbChars <= nbmax) {
 161     lookStackTop-=nbChars ;
 162     memcpy(x,lookStackTop,nbChars);
 163   } else {
 164     char *tlx = x+nbChars ;
 165     if (nbmax>0) memcpy(x,lookStack->contents,nbmax) ;
 166     x+=nbmax ;
 167     while (x<tlx) {
 168       lookStack = lookStack->prev ;
 169       if (lookStack==NULL) printf("Looking into an empty stack!!!") ;
 170       if (x+ONE_BLOCK_SIZE<tlx) {
 171         memcpy(x,lookStack->contents,ONE_BLOCK_SIZE) ;
 172         x += ONE_BLOCK_SIZE ;
 173       } else {
 174         unsigned int nbtail = tlx-x ;
 175         lookStackTop=(lookStack->contents)+ONE_BLOCK_SIZE-nbtail ;
 176         memcpy(x,lookStackTop,nbtail) ;
 177         x = tlx ;
 178       }
 179     }
 180   }
 181 }
 182
 183 void resetadlookstack_() {
 184   lookStack=NULL ;
 185 }
 186
 187 /****** Exported PUSH/POP/LOOK functions for ARRAYS: ******/
 188
 189 void pushcharacterarray_(char *x, unsigned int *n) {
 190   pushNarray(x,*n) ;
 191 }
 192 void popcharacterarray_(char *x, unsigned int *n) {
 193   popNarray(x,*n) ;
 194 }
 195 void lookcharacterarray_(char *x, unsigned int *n) {
 196   lookNarray(x,*n) ;
 197 }
 198
 199 void pushbooleanarray_(char *x, unsigned int *n) {
 200   pushNarray(x,(*n*4)) ;
 201 }
 202 void popbooleanarray_(char *x, unsigned int *n) {
 203   popNarray(x,(*n*4)) ;
 204 }
 205 void lookbooleanarray_(char *x, unsigned int *n) {
 206   lookNarray(x,(*n*4)) ;
 207 }
 208
 209 void PUSHINTEGER4ARRAY(char *x, unsigned int *n) {
 210   pushNarray(x,(*n*4)) ;
 211 }
 212 void POPINTEGER4ARRAY(char *x, unsigned int *n) {
 213   popNarray(x,(*n*4)) ;
 214 }
 215 void lookinteger4array_(char *x, unsigned int *n) {
 216   lookNarray(x,(*n*4)) ;
 217 }
 218
 219 void pushinteger8array_(char *x, unsigned int *n) {
 220   pushNarray(x,(*n*8)) ;
 221 }
 222 void popinteger8array_(char *x, unsigned int *n) {
 223   popNarray(x,(*n*8)) ;
 224 }
 225 void lookinteger8array_(char *x, unsigned int *n) {
 226   lookNarray(x,(*n*8)) ;
 227 }
 228
 229 void pushinteger16array_(char *x, unsigned int *n) {
 230   pushNarray(x,(*n*16)) ;
 231 }
 232 void popinteger16array_(char *x, unsigned int *n) {
 233   popNarray(x,(*n*16)) ;
 234 }
 235 void lookinteger16array_(char *x, unsigned int *n) {
 236   lookNarray(x,(*n*16)) ;
 237 }
 238
 239 void pushreal4array_(char *x, unsigned int *n) {
 240   pushNarray(x,(*n*4)) ;
 241 }
 242 void popreal4array_(char *x, unsigned int *n) {
 243   popNarray(x,(*n*4)) ;
 244 }
 245 void lookreal4array_(char *x, unsigned int *n) {
 246   lookNarray(x,(*n*4)) ;
 247 }
 248
 249 void PUSHREAL8ARRAY(char *x, unsigned int *n) {
 250   pushNarray(x,(*n*8)) ;
 251 }
 252 void POPREAL8ARRAY(char *x, unsigned int *n) {
 253   popNarray(x,(*n*8)) ;
 254 }
 255 void lookreal8array_(char *x, unsigned int *n) {
 256   lookNarray(x,(*n*8)) ;
 257 }
 258
 259 void pushreal16array_(char *x, unsigned int *n) {
 260   pushNarray(x,(*n*16)) ;
 261 }
 262 void popreal16array_(char *x, unsigned int *n) {
 263   popNarray(x,(*n*16)) ;
 264 }
 265 void lookreal16array_(char *x, unsigned int *n) {
 266   lookNarray(x,(*n*16)) ;
 267 }
 268
 269 void pushreal32array_(char *x, unsigned int *n) {
 270   pushNarray(x,(*n*32)) ;
 271 }
 272 void popreal32array_(char *x, unsigned int *n) {
 273   popNarray(x,(*n*32)) ;
 274 }
 275 void lookreal32array_(char *x, unsigned int *n) {
 276   lookNarray(x,(*n*32)) ;
 277 }
 278
 279 void pushcomplex4array_(char *x, unsigned int *n) {
 280   pushNarray(x,(*n*4)) ;
 281 }
 282 void popcomplex4array_(char *x, unsigned int *n) {
 283   popNarray(x,(*n*4)) ;
 284 }
 285 void lookcomplex4array_(char *x, unsigned int *n) {
 286   lookNarray(x,(*n*4)) ;
 287 }
 288
 289 void pushcomplex8array_(char *x, unsigned int *n) {
 290   pushNarray(x,(*n*8)) ;
 291 }
 292 void popcomplex8array_(char *x, unsigned int *n) {
 293   popNarray(x,(*n*8)) ;
 294 }
 295 void lookcomplex8array_(char *x, unsigned int *n) {
 296   lookNarray(x,(*n*8)) ;
 297 }
 298
 299 void pushcomplex16array_(char *x, unsigned int *n) {
 300   pushNarray(x,(*n*16)) ;
 301 }
 302 void popcomplex16array_(char *x, unsigned int *n) {
 303   popNarray(x,(*n*16)) ;
 304 }
 305 void lookcomplex16array_(char *x, unsigned int *n) {
 306   lookNarray(x,(*n*16)) ;
 307 }
 308
 309 void pushcomplex32array_(char *x, unsigned int *n) {
 310   pushNarray(x,(*n*32)) ;
 311 }
 312 void popcomplex32array_(char *x, unsigned int *n) {
 313   popNarray(x,(*n*32)) ;
 314 }
 315 void lookcomplex32array_(char *x, unsigned int *n) {
 316   lookNarray(x,(*n*32)) ;
 317 }
 318
 319 /****** Exported PUSH/POP/LOOK functions for F95 POINTERS: ******/
 320
 321 /* IMPORTANT: Don't forget to add the following interface into each calling routines:
 322
 323       INTERFACE
 324          SUBROUTINE PUSHPOINTER(pp)
 325            REAL, POINTER :: pp
 326          END SUBROUTINE PUSHPOINTER
 327          SUBROUTINE POPPOINTER(pp)
 328            REAL, POINTER :: pp
 329          END SUBROUTINE POPPOINTER
 330       END INTERFACE
 331
 332 */
 333
 334 void pushpointer_(char *ppp) {
 335   pushNarray(ppp, 4) ;
 336 }
 337
 338 void poppointer_(char *ppp) {
 339   popNarray(ppp, 4) ;
 340 }
 341
 342
 343 /************* Debug displays of the state of the stack: ***********/
 344
 345 void printbigbytes(long int nbblocks, long int blocksz, long int nbunits) {
 346   long int a3, b3, res3, res6, res9, res12 ;
 347   int a0, b0, res0 ;
 348   int printzeros = 0 ;
 349   a0 = (int)nbblocks%1000 ;
 350   a3 = nbblocks/1000 ;
 351   b0 = (int)blocksz%1000 ;
 352   b3 = blocksz/1000 ;
 353   res0 = ((int)(nbunits%1000)) + a0*b0 ;
 354   res3 = nbunits/1000 + a3*b0 + a0*b3 ;
 355   res6 = a3*b3 ;
 356   res3 += ((long int)(res0/1000)) ;
 357   res0 = res0%1000 ;
 358   res6 += res3/1000 ;
 359   res3 = res3%1000 ;
 360   res9 = res6/1000 ;
 361   res6 = res6%1000 ;
 362   res12 = res9/1000 ;
 363   res9 = res9%1000 ;
 364   if (res12>0) {
 365     printf("%li ", res12) ;
 366     printzeros = 1 ;
 367   }
 368   if ((res9/100)>0 || printzeros) {
 369     printf("%li",res9/100) ;
 370     printzeros = 1 ;
 371     res9 = res9%100 ;
 372   }
 373   if ((res9/10)>0 || printzeros) {
 374     printf("%li",res9/10) ;
 375     printzeros = 1 ;
 376     res9 = res9%10 ;
 377   }
 378   if (res9>0 || printzeros) {
 379     printf("%li ",res9) ;
 380     printzeros = 1 ;
 381   }
 382   if ((res6/100)>0 || printzeros) {
 383     printf("%li",res6/100) ;
 384     printzeros = 1 ;
 385     res6 = res6%100 ;
 386   }
 387   if ((res6/10)>0 || printzeros) {
 388     printf("%li",res6/10) ;
 389     printzeros = 1 ;
 390     res6 = res6%10 ;
 391   }
 392   if (res6>0 || printzeros) {
 393     printf("%li ",res6) ;
 394     printzeros = 1 ;
 395   }
 396   if ((res3/100)>0 || printzeros) {
 397     printf("%li",res3/100) ;
 398     printzeros = 1 ;
 399     res3 = res3%100 ;
 400   }
 401   if ((res3/10)>0 || printzeros) {
 402     printf("%li",res3/10) ;
 403     printzeros = 1 ;
 404     res3 = res3%10 ;
 405   }
 406   if (res3>0 || printzeros) {
 407     printf("%li ",res3) ;
 408     printzeros = 1 ;
 409   }
 410   if ((res0/100)>0 || printzeros) {
 411     printf("%i",res0/100) ;
 412     printzeros = 1 ;
 413     res0 = res0%100 ;
 414   }
 415   if ((res0/10)>0 || printzeros) {
 416     printf("%i",res0/10) ;
 417     printzeros = 1 ;
 418     res0 = res0%10 ;
 419   }
 420   printf("%i",res0) ;
 421 }
 422
 423 void printctraffic_() {
 424   printf(" C Traffic: ") ;
 425   printbigbytes(mmctrafficM, 1000000, mmctraffic) ;
 426   printf(" bytes\n") ;
 427 }
 428
 429 void printftrafficinc_(long int *mmfM, int *mmfsz, int *mmf) {
 430   printf(" F Traffic: ") ;
 431   printbigbytes(*mmfM, (long int)*mmfsz, (long int)*mmf) ;
 432   printf(" bytes\n") ;
 433 }
 434
 435 void printtopplace_() {
 436     DoubleChainedBlock *stack = curStack ;
 437     int nbBlocks = (stack?-1:0) ;
 438     int remainder = 0;
 439     while(stack) {
 440         stack = stack->prev ;
 441         nbBlocks++ ;
 442     }
 443     if (curStack && curStackTop) remainder = curStackTop-(curStack->contents) ;
 444     printf(" Stack size: ") ;
 445     printbigbytes((long int)nbBlocks, ONE_BLOCK_SIZE, (long int)remainder) ;
 446     printf(" bytes\n") ;
 447 }
 448
 449 void printtopplacenum_(int *n) {
 450     DoubleChainedBlock *stack = curStack ;
 451     int nbBlocks = (stack?-1:0) ;
 452     int remainder = 0;
 453     while(stack) {
 454         stack = stack->prev ;
 455         nbBlocks++ ;
 456     }
 457     if (curStack && curStackTop) remainder = curStackTop-(curStack->contents) ;
 458     printf(" Stack size at location %i : ", *n) ;
 459     printbigbytes((long int)nbBlocks, ONE_BLOCK_SIZE, (long int)remainder) ;
 460     printf(" bytes\n") ;
 461 }
 462
 463 void printstackmax_() {
 464     DoubleChainedBlock *stack = curStack ;
 465     int nbBlocks = (stack?-2:0) ;
 466     int remainder = 0;
 467     long int totalsz ;
 468     while(stack) {
 469         stack = stack->prev ;
 470         nbBlocks++ ;
 471     }
 472     stack = curStack ;
 473     while(stack) {
 474         stack = stack->next ;
 475         nbBlocks++ ;
 476     }
 477
 478     printf(" Max Stack size (%i blocks): ", nbBlocks) ;
 479     printbigbytes((long int)nbBlocks, ONE_BLOCK_SIZE, (long int)0) ;
 480     printf(" bytes\n") ;
 481 }
 482
 483 void printlookingplace_() {
 484     if (lookStack == NULL)
 485         printtopplace_() ;
 486     else {
 487         DoubleChainedBlock *stack = lookStack ;
 488         int nbBlocks = (stack?-1:0) ;
 489         while(stack) {
 490             stack = stack->prev ;
 491             nbBlocks++ ;
 492         }
 493         printf(" Stack look at: ") ;
 494         printbigbytes((long int)nbBlocks, ONE_BLOCK_SIZE,
 495                       ((long int)(lookStackTop-(lookStack->contents)))) ;
 496         printf(" bytes\n") ;
 497     }
 498 }
 499
 500 void showrecentcstack_() {
 501   if (curStack && curStackTop) {
 502     int totalNumChars = 30 ;
 503     DoubleChainedBlock *stack = curStack ;
 504     char *stackTop = curStackTop ;
 505     unsigned short int *st1 ;
 506     printf("TOP OF C STACK  : ") ;
 507     while (totalNumChars>0 && stackTop>(stack->contents)) {
 508       stackTop-- ;
 509       st1 = (unsigned short int *)stackTop ;
 510       printf("%02X,",*st1%256) ;
 511       totalNumChars-- ;
 512     }
 513     while (totalNumChars>0 && stack->prev) {
 514       printf(" || ") ;
 515       stack = stack->prev ;
 516       stackTop = (stack->contents)+ONE_BLOCK_SIZE ;
 517       while (totalNumChars>0 && stackTop>(stack->contents)) {
 518         stackTop-- ;
 519         st1 = (unsigned short int *)stackTop ;
 520         printf("%02X,",*st1%256) ;
 521         totalNumChars-- ;
 522       }
 523     }
 524     if (stack->prev || stackTop>(stack->contents))
 525       printf(" ...\n") ;
 526     else
 527       printf(" || BOTTOM\n") ;
 528   } else {
 529     printf("NOTHING IN C STACK.\n") ;
 530   }
 531 }
 532
 533 void getnbblocksinstack_(int *nbblocks) {
 534   DoubleChainedBlock *stack = curStack ;
 535   *nbblocks = 0 ;
 536   while(stack) {
 537     stack = stack->prev ;
 538     (*nbblocks)++ ;
 539   }
 540 }