home *** CD-ROM | disk | FTP | other *** search
- /* setmem.f -- translated by f2c (version of 3 February 1990 3:36:42).
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
- */
-
- #include "f2c.h"
-
- /* Common Block Declarations */
-
- struct {
- doublereal value[200000];
- } blank_;
-
- #define blank_1 blank_
-
- struct {
- doublereal cpyknt;
- integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk,
- loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8,
- nwd16;
- } memmgr_;
-
- #define memmgr_1 memmgr_
-
- /* Table of constant values */
-
- static integer c__1 = 1;
- static integer c__6 = 6;
-
- /*< subroutine setmem(ipntr,ksize) >*/
- /* Subroutine */ int setmem_(ipntr, ksize)
- integer *ipntr, *ksize;
- {
- /* Local variables */
- extern integer locf_();
- static integer nevn, icheck, ifamwa;
- #define cvalue ((complex *)&blank_1)
- extern /* Subroutine */ int errmem_();
- extern integer nxtmem_();
- extern /* Subroutine */ int memory_();
- extern integer nxtevn_();
-
- /* Parameter adjustments */
- --ipntr;
-
- /* Function Body */
- /*< implicit double precision (a-h,o-z) >*/
-
- /* this routine performs dynamic memory management. it is used in */
- /* spice2, and useable in any program. */
-
- /* memory is managed within an array selected by the calling program.
- */
- /* one may either dimension this array to the 'maxmem' size, or more
- */
- /* desirably, find the address of the first available word of memory
- */
- /* above your program, and dimension your array to '1'. passing the
- */
- /* address of the first data word available permits the manager to */
- /* use 'illegal' indices into the data area. */
-
- /* this routine must have access to an integer function called 'locf'
- */
- /* which returns the address of its argument. addresses as used by
- this*/
- /* program refer to 'integer' addresses, not byte addresses. */
-
- /* entry points: */
- /* setmem - set initial memory */
- /* getm4 - get block for table of integers */
- /* getm8 - get block for table of floating point variables */
- /* getm16 - get block for table of complex variables */
- /* relmem - release part of block */
- /* extmem - extend size of existing block */
- /* sizmem - determine size of existing block */
- /* clrmem - release block */
- /* ptrmem - reset memory pointer */
- /* crunch - force memory compaction */
- /* avlm4 - amount of space available (integers) */
- /* avlm8 - amount of space available (real) */
- /* avlm16 - amount of space available (complex) */
-
- /* calling sequences: */
- /* call setmem(imem(1),maxmem) */
- /* call setmem(imem(1),maxmem,kfamwa) cdc machines running under */
- /* calidoscope kfamwa is the
- address*/
- /* of the first available word */
-
- /* call getm4 (ipntr,blksiz) where blksize is the number of entries
- */
- /* call getm8 (ipntr,blksiz) */
- /* call getm16(ipntr,blksiz) */
- /* call relmem(ipntr,relsiz) */
- /* call extmem(ipntr,extsiz) extsiz is the number of entries to be
- added*/
- /* call sizmem(ipntr,blksiz) */
- /* call clrmem(ipntr) */
- /* call ptrmem(ipntr1,ipntr2) */
- /* call avlm4(ispace) */
- /* call avlm8(ispace) */
- /* call avlm16(ispace) */
- /* call crunch */
- /* call slpmem(ipntr,slpsiz) express desire for *slpsiz* extra
- entries*/
-
-
- /* general comments: */
- /* for each block which is allocated, a multi-word entry is
- maintained*/
- /* in a table kept in high memory, of the form */
-
- /* word contents */
- /* ---- -------- */
-
- /* 1 index of imem(.) into origin of block */
- /* i.e. contents of pointer (used for error check) */
- /* 2 block size (in words) */
- /* 3 number of words in use */
- /* 4 address of variable containing block origin */
- /* 5 number of words used per table entry */
- /* 6 slop size (in words) */
-
- /* all allocated blocks are an 'even' (nxtevn) number of words in
- length,*/
- /* where a 'word' is the storage unit required for an 'integer' variable.
- */
- /* since block repositioning may be necessary, the convention that */
-
- /* only one variable contain a block origin should be observed. */
- /* for *getmem*, *ipntr* is set such that *array(ipntr+1)* is the */
- /* first word of the allocated block. 'ipntr' is set to address the
- first */
- /* entry of the table when used with the appropriate variable type, i.e.,
- */
- /* nodplc(ipntr+1), value(ipntr+1), or cvalue(ipntr+1). */
- /* for *clrmem*, *ipntr* is set to 'invalid' to enable rapid
- detection*/
- /* of an attempt to use a cleared block. */
- /* if any fatal errors are found, a message is printed and a flag */
- /* set inhibiting further action until *setmem* is called. (in this */
- /* context, insufficient memory is considered a fatal error.) */
- /* throughout this routine, *ldval* always contains the subscript of
- */
- /* the last addressable word of memory, *memavl* always contains the */
- /* number of available words of memory, *numblk* always contains the */
- /* number of allocated blocks, and istack(*loctab* +1) always contains */
- /* the first word of the block table. */
-
- /* spice version 2g.6 sccsid=blank 3/15/83 */
- /*< common /blank/ value(200000) >*/
- /* spice version 2g.6 sccsid=memmgr 3/15/83 */
- /*< common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
- /*< 1 ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
- /*< 2 nwd8,nwd16 >*/
- /*< dimension ipntr(1) >*/
-
- /*< logical memptr >*/
- /*< complex cvalue(32) >*/
- /*< equivalence (value(1),cvalue(1)) >*/
- /*< external locf >*/
-
- /* ... approximate time required to copy *nwords* integer values */
-
- /* nxtevn rounds the number up to the next 'even' value. the value */
- /* used for this 'even' number is the smallest number into which one */
- /* can divide nwd4,nwd8,and nwd16. */
-
-
- /* nxtmem returns next higher memory size */
-
-
-
- /* *** setmem - set initial memory */
-
- /*< nwd4=1 >*/
- memmgr_1.nwd4 = 1;
- /*< nwd8=locf(value(2))-locf(value(1)) >*/
- memmgr_1.nwd8 = locf_(&blank_1.value[1]) - locf_(blank_1.value);
- /*< nwd16=locf(cvalue(2))-locf(cvalue(1)) >*/
- memmgr_1.nwd16 = locf_(&cvalue[1]) - locf_(cvalue);
- /*< memerr=0 >*/
- memmgr_1.memerr = 0;
- /*< nevn=nxtevn(1) >*/
- nevn = nxtevn_(&c__1);
- /* check that nxtevn function returns a number divisible by */
- /* nwd4, nwd8, nwd16; also check that the memory increment */
- /* nxtmem(.) is an integer multiple of nxtevn(1) */
- /*< icheck=mod(nevn,nwd4)+mod(nevn,nwd8)+mod(nevn,nwd16)+ >*/
- /*< 1 mod(nxtmem(1),nevn) >*/
- icheck = nevn % memmgr_1.nwd4 + nevn % memmgr_1.nwd8 + nevn %
- memmgr_1.nwd16 + nxtmem_(&c__1) % nevn;
- /*< if(icheck.eq.0) go to 2 >*/
- if (icheck == 0) {
- goto L2;
- }
- /*< memerr=1 >*/
- memmgr_1.memerr = 1;
- /*< call errmem(6,memerr,ipntr(1)) >*/
- errmem_(&c__6, &memmgr_1.memerr, &ipntr[1]);
- /*< 2 cpyknt=0.0d0 >*/
- L2:
- memmgr_1.cpyknt = 0.;
- /*< ifamwa=locf(ipntr(1)) >*/
- ifamwa = locf_(&ipntr[1]);
- /*< maxmem=ksize >*/
- memmgr_1.maxmem = *ksize;
- /*< ntab=nxtevn(6) >*/
- memmgr_1.ntab = nxtevn_(&c__6);
- /*... add 'lorg' to an address and you get the 'istack' index to that
- word*/
- /*< lorg=1-locf(istack(1)) >*/
- memmgr_1.lorg = 1 - locf_(memmgr_1.istack);
- /*< ifwa=ifamwa+lorg-1 >*/
- memmgr_1.ifwa = ifamwa + memmgr_1.lorg - 1;
- /*< nwoff=locf(ipntr(1))+lorg-1 >*/
- memmgr_1.nwoff = locf_(&ipntr[1]) + memmgr_1.lorg - 1;
- /*< icore=nxtmem(1) >*/
- memmgr_1.icore = nxtmem_(&c__1);
- /* ... don't take chances, back off from 'end of memory' by nxtevn(1) */
- /*< ldval=ifwa+nxtmem(1)-nxtevn(1) >*/
- memmgr_1.ldval = memmgr_1.ifwa + nxtmem_(&c__1) - nxtevn_(&c__1);
- /*< memavl=ldval-ntab-ifwa >*/
- memmgr_1.memavl = memmgr_1.ldval - memmgr_1.ntab - memmgr_1.ifwa;
- /*< maxcor=0 >*/
- memmgr_1.maxcor = 0;
- /*< maxuse=0 >*/
- memmgr_1.maxuse = 0;
- /*< call memory >*/
- memory_();
- /*< if(memerr.ne.0) call errmem(6,memerr,ipntr(1)) >*/
- if (memmgr_1.memerr != 0) {
- errmem_(&c__6, &memmgr_1.memerr, &ipntr[1]);
- }
- /*< numblk=1 >*/
- memmgr_1.numblk = 1;
- /*< loctab=ldval-ntab >*/
- memmgr_1.loctab = memmgr_1.ldval - memmgr_1.ntab;
- /*< istack(loctab+1)=0 >*/
- memmgr_1.istack[memmgr_1.loctab] = 0;
- /*< istack(loctab+2)=memavl >*/
- memmgr_1.istack[memmgr_1.loctab + 1] = memmgr_1.memavl;
- /*< istack(loctab+3)=0 >*/
- memmgr_1.istack[memmgr_1.loctab + 2] = 0;
- /*< istack(loctab+4)=-1 >*/
- memmgr_1.istack[memmgr_1.loctab + 3] = -1;
- /*< istack(loctab+5)=1 >*/
- memmgr_1.istack[memmgr_1.loctab + 4] = 1;
- /*< istack(loctab+6)=0 >*/
- memmgr_1.istack[memmgr_1.loctab + 5] = 0;
- /*< return >*/
- return 0;
- /*< end >*/
- } /* setmem_ */
-
- #undef cvalue
-
-
-