summaryrefslogtreecommitdiff
path: root/new/data.c
diff options
context:
space:
mode:
Diffstat (limited to 'new/data.c')
-rw-r--r--new/data.c1250
1 files changed, 0 insertions, 1250 deletions
diff --git a/new/data.c b/new/data.c
deleted file mode 100644
index c7463ac..0000000
--- a/new/data.c
+++ /dev/null
@@ -1,1250 +0,0 @@
-/* MIRANDA DATA REPRESENTATIONS */
-
-/**************************************************************************
- * Copyright (C) Research Software Limited 1985-90. All rights reserved. *
- * The Miranda system is distributed as free software under the terms in *
- * the file "COPYING" which is included in the distribution. *
- *------------------------------------------------------------------------*/
-
-#include "data.h"
-#include "big.h"
-#define INITSPACE 250000
-word SPACE=INITSPACE; /* false ceiling in heap to improve paging behaviour
- during compilation */
-extern word SPACELIMIT; /* see steer.c for default value */
- /* SPACELIMIT controls the size of the heap (i.e. the number of list
- cells available) - the minimum survivable number given the need to
- compile the prelude etc is probably about 6000 */
- /* Note: the size of a list cell is 2 ints + 1 char */
-#define BIGTOP (SPACELIMIT + ATOMLIMIT)
-word listp=ATOMLIMIT-1;
-word *hdspace,*tlspace;
-long long cellcount=0;
-long claims=0;
-long nogcs=0;
-extern word atgc; /* flag, set in steer.c */
-#define poschar(c) !(negchar((c)-1))
-#define negchar(c) (c&128)
- /* safest to test for -ve chars this way, since not all m/c's do sign
- extension - DT Jan 84 */
-
-trueheapsize()
-{ return(nogcs==0?listp-ATOMLIMIT+1:SPACE); }
-
-setupheap()
-{ hdspace=(word *)malloc(SPACELIMIT*sizeof(word));
- tlspace=(word *)malloc(SPACELIMIT*sizeof(word));
- hd=hdspace-ATOMLIMIT; tl=tlspace-ATOMLIMIT;
- if(SPACE>SPACELIMIT)SPACE=SPACELIMIT;
- tag=(char *)calloc(BIGTOP+1,sizeof(char));
- /* NB use calloc because it sets contents to zero */
- /* tag[TOP] must be zero and exists as a sentinel */
- if(hdspace==NULL||tlspace==NULL||tag==NULL)mallocfail("heap");
-}
-
-resetheap() /* warning - cannot do this dynamically, because both the
- compiler and the reducer hold onto absolute heap addresses
- during certain space consuming computations */
-{ if(SPACELIMIT<trueheapsize())
- fprintf(stderr,"impossible event in resetheap\n"),exit(1);
- hdspace=(word *)realloc((char *)hdspace,SPACELIMIT*sizeof(word));
- if(hdspace==NULL)mallocfail("heap");
- tlspace=(word *)realloc((char *)tlspace,SPACELIMIT*sizeof(word));
- if(tlspace==NULL)mallocfail("heap");
- hd=hdspace-ATOMLIMIT; tl=tlspace-ATOMLIMIT;
- tag=(char *)realloc(tag,BIGTOP+1);
- if(tag==NULL)mallocfail("heap");
- tag[BIGTOP]=0;
- if(SPACE>SPACELIMIT)SPACE=SPACELIMIT;
- if(SPACE<INITSPACE&&INITSPACE<=SPACELIMIT)SPACE=INITSPACE,tag[TOP]=0;
- /* tag[TOP] is always zero and exists as a sentinel */
-}
-
-mallocfail(x)
-char *x;
-{ fprintf(stderr,"panic: cannot find enough free space for %s\n",x);
- exit(1);
-}
-
-resetgcstats()
-{ cellcount= -claims;
- nogcs = 0;
- initclock();
-}
-
-make(t,x,y) /* creates a new cell with "tag" t, "hd" x and "tl" y */
-word t,x,y;
-{ while(poschar(tag[++listp]));
- /* find next cell with zero or negative tag (=unwanted) */
- if(listp==TOP)
- { if(SPACE!=SPACELIMIT)
- if(!compiling)SPACE=SPACELIMIT; else
- if(claims<=SPACE/4&&nogcs>1)
- { /* during compilation we raise false ceiling whenever residency
- reaches 75% on 2 successive gc's */
- static word wait=0;
- word sp=SPACE;
- if(wait)wait--; else
- SPACE+= SPACE/2,wait=2,
- SPACE=5000*(1+(SPACE-1)/5000); /* round upwards */
- if(SPACE>SPACELIMIT)SPACE=SPACELIMIT;
- if(atgc&&SPACE>sp)
- printf( "\n<<increase heap from %d to %d>>\n",sp,SPACE);
- }
- if(listp==TOP)
- {
-#if defined ORION105
- asm("savew6");
- gc();
- asm("restw6");
-#elif defined sparc
- asm("ta 0x03"); /* see /usr/include/sun4/trap.h */
- /* asm("ta ST_FLUSH_WINDOWS"); */
- gc();
-#else
- gc();
-#endif
- if(t>STRCONS)mark(x);
- if(t>=INT)mark(y);
- return(make(t,x,y)); }
- }
- claims++;
- tag[listp]= t;
- hd[listp]= x;
- tl[listp]= y;
- return(listp); }
-
-/* cons ap ap2 ap3 are all #defined in terms of make
- - see MIRANDA DECLARATIONS */
-
-setwd(x,a,b)
-word x,a,b;
-{ hd[x]= a;
- tl[x]= b; }
-
-word collecting=0; /* flag for reset(), in case interrupt strikes in gc */
-
-gc() /* the "garbage collector" */
-{ char *p1;
- extern word making;
- collecting=1;
- p1= &(tag[ATOMLIMIT]);
- if(atgc)
- printf("\n<<gc after %ld claims>>\n",claims);
- if(claims<=SPACE/10 && nogcs>1 && SPACE==SPACELIMIT)
- { /* if heap utilisation exceeds 90% on 2 successive gc's, give up */
- static word hnogcs=0;
- if(nogcs==hnogcs)
- { extern word ideep;
- extern char *current_script;
- fprintf(stderr,"<<not enough heap space -- task abandoned>>\n");
- if(!compiling)outstats();
- if(compiling&&ideep==0)
- fprintf(stderr,"not enough heap to compile current script\n"),
- fprintf(stderr,"script = \"%s\", heap = %d\n",current_script,SPACE);
- exit(1); } /* if compiling should reset() instead - FIX LATER */
- else hnogcs=nogcs+1; }
- nogcs++;
- while(*p1= -*p1)p1++; /* make all tags -ve (= unwanted) */
-/*if(atgc)
- { extern int lasthead;
-#define BACKSTOP 020000000000
- printf("bases() called\n");
- printf("lasthead= ");
- if(lasthead==BACKSTOP)printf("BACKSTOP");
- else out(stdout,lasthead);
- putchar('\n'); } /* DEBUG */
- bases();
-/*if(atgc)printf("bases() done\n"); /* DEBUG */
- listp= ATOMLIMIT - 1;
- cellcount+= claims;
- claims= 0;
- collecting=0;
-}
-/* int Icount; /* DEBUG */
-
-gcpatch() /* called when gc interrupted - see reset in steer.c */
-/* must not allocate any cells between calling this and next gc() */
-{ char *p1;
- for(p1= &(tag[ATOMLIMIT]);*p1;p1++)if(negchar(*p1))*p1= -*p1;
- /* otherwise mutator crashes on funny tags */
-}
-
-bases() /* marks everthing that must be saved */
-{ word *p;
- extern YYSTYPE yyval;
- extern word *cstack;
- extern word fileq,primenv;
- extern word cook_stdin,common_stdin,common_stdinb,rv_expr,rv_script;
- extern word margstack,vergstack,litstack,linostack,prefixstack;
- extern word idsused,suppressids,lastname,
- eprodnts,nonterminals,ntmap,ihlist,ntspecmap,gvars,lexvar;
- extern word R,TABSTRS,SGC,ND,SBND,NT,current_id,meta_pending;
- extern word showchain,newtyps,algshfns,errs,speclocs;
- extern word SUBST[],tvmap,localtvmap;
- extern word tfnum,tfbool,tfbool2,tfnum2,tfstrstr,
- tfnumnum,ltchar,bnf_t,tstep,tstepuntil;
- extern word exec_t,read_t,filestat_t;
- extern word big_one;
- extern word nill,standardout;
- extern word lexstates,lexdefs,oldfiles,includees,embargoes,exportfiles,
- exports,internals, freeids,tlost,detrop,rfl,bereaved,ld_stuff;
- extern word CLASHES,ALIASES,SUPPRESSED,TSUPPRESSED,DETROP,MISSING,fnts,FBS;
- extern word outfilq,waiting;
- /* Icount=0; /* DEBUG */
- p= (word *)&p;
-/* we follow everything on the C stack that looks like a pointer into
-list space. This is failsafe in that the worst that can happen,if e.g. a
-stray integer happens to point into list space, is that the garbage
-collector will collect less garbage than it could have done */
- if(p<cstack) /* which way does stack grow? */
- while(++p!=cstack)mark(*p);/* for machines with stack growing downwards */
- else
- while(--p!=cstack)mark(*p);/* for machines with stack growing upwards */
- mark(*cstack);
-/* now follow all pointer-containing external variables */
- mark(outfilq);
- mark(waiting);
- if(compiling||rv_expr||rv_script) /* rv flags indicate `readvals' in use */
- { extern YYSTYPE *yyvs, *yyvsp;
- extern word namebucket[];
- extern word *dstack,*stackp; /* undump stack - see load_script(), below */
- extern word *pnvec,nextpn,loading; /* private name vector */
- extern word make_status;
- word i;
- mark(make_status);
- mark(primenv);
- mark(fileq);
- mark(idsused);
- mark(eprodnts);
- mark(nonterminals);
- mark(ntmap);
- mark(ihlist);
- mark(ntspecmap);
- mark(gvars);
- mark(lexvar);
- mark(common_stdin);
- mark(common_stdinb);
- mark(cook_stdin);
- mark(margstack);
- mark(vergstack);
- mark(litstack);
- mark(linostack);
- mark(prefixstack);
- mark(files);
- mark(oldfiles);
- mark(includees);
- mark(freeids);
- mark(exports);
- mark(internals);
- mark(CLASHES);
- mark(ALIASES);
- mark(SUPPRESSED);
- mark(TSUPPRESSED);
- mark(DETROP);
- mark(MISSING);
- mark(FBS);
- mark(lexstates);
- mark(lexdefs);
- for(i=0;i<128;i++)
- if(namebucket[i])mark(namebucket[i]);
- for(p=dstack;p<stackp;p++)mark(*p);
- if(loading)
- { mark(algshfns);
- mark(speclocs);
- mark(exportfiles);
- mark(embargoes);
- mark(rfl);
- mark(detrop);
- mark(bereaved);
- mark(ld_stuff);
- mark(tlost);
- for(i=0;i<nextpn;i++)mark(pnvec[i]); }
- mark(lastname);
- mark(suppressids);
- mark(lastexp);
- mark(nill);
- mark(standardout);
- mark(big_one);
- mark(yyval);
-/* for(vp= yyvs;vp<=yyvsp;vp++)mark(*vp); */
- mark(yylval);
- mark(R);
- mark(TABSTRS);
- mark(SGC);
- mark(ND);
- mark(SBND);
- mark(NT);
- mark(current_id);
- mark(meta_pending);
- mark(newtyps);
- mark(showchain);
- mark(errs);
- mark(tfnum);
- mark(tfbool);
- mark(tfbool2);
- mark(tfnum2);
- mark(tfstrstr);
- mark(tfnumnum);
- mark(ltchar);
- mark(bnf_t);
- mark(exec_t);
- mark(read_t);
- mark(filestat_t);
- mark(tstep);
- mark(tstepuntil);
- mark(tvmap);
- mark(localtvmap);
- for(i=0;i<hashsize;i++)mark(SUBST[i]); }
-/* if(atgc)printf("<<%d I-nodes>>\n",Icount); /* DEBUG */
-}
-
-#define tlptrbits 030000000000
-/* see reduce.c */
-
-mark(x) /* a marked cell is distinguished by having a +ve "tag" */
-word x;
-{ x&= ~tlptrbits; /* x may be a `reversed pointer' (see reduce.c) */
- while(isptr(x)&&negchar(tag[x]))
- { /*if(hd[x]==I)Icount++; /* DEBUG */
- if((tag[x]= -tag[x])<INT)return;
- if(tag[x]>STRCONS)mark(hd[x]);
- x= tl[x]&~tlptrbits; }
-}
-
-union numparts {double real; struct{word left;word right;} parts;};
-
-double get_dbl(x)
-word x;
-{ union numparts r;
- r.parts.left= hd[x];
- r.parts.right= tl[x];
- return(r.real); }
-
-/* Miranda's arithmetic model requires fp overflow trapped. On sparc this
- can be done by setting a trap with ieee_handler (see steer.c) otherwise
- we test for overflow with finite(), see IEEE754-1985 (Appendix) */
-
-sto_dbl(R)
-double R;
-{ union numparts r;
-#if !defined sparc /* */
- if(!finite(R))fpe_error(); /* see note on arithmetic model above */
-#endif /* */
- r.real=R;
- return(make(DOUBLE,r.parts.left,r.parts.right));
-}
-
-setdbl(x,R)
-double R;
-{ union numparts r;
-#if !defined sparc /* */
- if(!finite(R))fpe_error(); /* see note on arithmetic model above */
-#endif /* */
- r.real=R;
- tag[x]=DOUBLE; hd[x]=r.parts.left; tl[x]=r.parts.right;
-}
-
-sto_char(c) /* assumes 0<=c<=UMAX */
-word c;
-{ return c<256?c:make(UNICODE,c,0); }
-
-get_char(x)
-word x;
-{ if(x<256)return x;
- if(tag[x]==UNICODE)return hd[x];
- fprintf(stderr,"impossible event in get_char(x), tag[x]==%d\n",tag[x]);
- exit(1);
-}
-
-is_char(x)
-word x;
-{ return 0<=x && x<256 || tag[x]==UNICODE; }
-
-sto_id(p1)
-char *p1;
-{ return(make(ID,cons(strcons(p1,NIL),undef_t),UNDEF)); }
- /* the hd of an ID contains cons(strcons(name,who),type) and
- the tl has the value */
- /* who is NIL, hereinfo, or cons(aka,hereinfo) where aka
- is of the form datapair(oldname,0) oldname being a string */
- /* hereinfo is fileinfo(script,line_no) */
-
-/* hereafter is stuff for dumping and undumping compiled scripts
-
- (internal heap object) (external file rep - char sequence)
- ---------------------- -----------------------------------
- 0..127 self
- 128..383 CHAR_X (self-128)
- 384..ATOMLIMIT-1 (self-256)
- integer (-127..127) SHORT_X <byte>
- integer INT_X <4n bytes> (-1)
- double DBL_X <8 bytes>
- unicode_char UNICODE_X <4 bytes>
- typevar TVAR_X <byte>
- ap(x,y) [x] [y] AP_X
- cons(x,y) [y] [x] CONS_X
- id (=occurrence) ID_X <string terminated by '\0'>
- pname (=occurrence) PN_X <2 bytes>
- PN1_X <4 bytes>
- datapair(string,0) AKA_X <string...\0>
- fileinfo(script,line_no) HERE_X <string...\0> <2 bytes> (**)
- constructor(n,x) [x] CONSTRUCT_X <2 bytes>
- readvals(h,t) [t] RV_X
- definition [val] [type] [who] [id] DEF_X
- [val] [pname] DEF_X
- definition-list [definition*] DEF_X
- filename <string terminated by '\0'>
- mtime <4 bytes>
-
- complete script XVERSION
- [ [filename]
- [mtime]
- [shareable] (=0 or 1)
- [definition-list] ]+
- '\0'
- [definition-list] (algshfns)
- [ND] or [True] (see below)
- DEF_X
- [SGC]
- DEF_X
- [freeids]
- DEF_X
- [definition-list] (internals)
-
- type-error script XVERSION
- '\1'
- <4 bytes> (=errline)
- ... (rest as normal script)
-
- syntax-error script XVERSION
- `\0'
- <4 bytes> (=errline)
- [ [filename]
- [mtime] ]+
-
- Notes
- -----
- first filename in dump must be that of `current_script' (ie the
- main source file). All pathnames in dump are correct wrt the
- directory of the main source.
- (**) empty string is abbreviation for current filename in hereinfo
- True in ND position indicates an otherwise correct dump whose exports
- include type orphans
-
- Pending:
- --------
- could have abbreviation for iterated ap and cons
-
- remaining issue - external format should be machine and version
- independent - not clear how to do this
-*/
-
-#define XBASE ATOMLIMIT-256
-#define CHAR_X (XBASE)
-#define SHORT_X (XBASE+1)
-#define INT_X (XBASE+2)
-#define DBL_X (XBASE+3)
-#define ID_X (XBASE+4)
-#define AKA_X (XBASE+5)
-#define HERE_X (XBASE+6)
-#define CONSTRUCT_X (XBASE+7)
-#define RV_X (XBASE+8)
-#define PN_X (XBASE+9)
-#define PN1_X (XBASE+10)
-#define DEF_X (XBASE+11)
-#define AP_X (XBASE+12)
-#define CONS_X (XBASE+13)
-#define TVAR_X (XBASE+14)
-#define UNICODE_X (XBASE+15)
-#define XLIMIT (XBASE+16)
-#if XLIMIT>512
-SEE ME!!! /* coding scheme breaks down if this occurs */
-#else
-
-static char prefix[pnlim];
-word preflen;
-
-setprefix(p) /* to that of pathname p */
-char *p;
-{ char *g;
- (void)strcpy(prefix,p);
- g=rindex(prefix,'/');
- if(g)g[1]='\0';
- else *prefix='\0';
- preflen = strlen(prefix);
-} /* before calling dump_script or load_script must setprefix() to that
- of current pathname of file being dumped/loaded - to get correct
- translation between internal pathnames (relative to dump script)
- and external pathnames */
-
-char *mkrel(p) /* makes pathname p correct relative to prefix */
-char *p; /* must use when writing pathnames to dump */
-{ if(strncmp(prefix,p,preflen)==0)return(p+preflen);
- if(p[0]=='/')return(p);
- fprintf(stderr,"impossible event in mkrelative\n"); /* or use getwd */
- /* not possible because all relative pathnames in files were computed
- wrt current script */
- return(p); /* proforma only */
-}
-
-#define bits_15 0177777
-char *CFN;
-
-dump_script(files,f) /* write compiled script files to file f */
-word files;
-FILE *f;
-{ extern word ND,bereaved,errline,algshfns,internals,freeids,SGC;
- putc(XVERSION,f); /* identifies dump format */
- if(files==NIL){ /* source contains syntax or metatype error */
- extern word oldfiles;
- word x;
- putc(0,f);
- putw(errline,f);
- for(x=oldfiles;x!=NIL;x=tl[x])
- fprintf(f,"%s",mkrel(get_fil(hd[x]))),putc(0,f),
- /*filename*/
- putw(fil_time(hd[x]),f); /* mtime */
- return; }
- if(ND!=NIL)putc(1,f),putw(errline,f);
- for(;files!=NIL;files=tl[files])
- { fprintf(f,"%s",mkrel(CFN=get_fil(hd[files]))); /* filename */
- putc(0,f);
- putw(fil_time(hd[files]),f);
- putc(fil_share(hd[files]),f);
- dump_defs(fil_defs(hd[files]),f);
- }
- putc(0,f); /* header - not a possible filename */
- dump_defs(algshfns,f);
- if(ND==NIL&&bereaved!=NIL)dump_ob(True,f); /* special flag */
- else dump_ob(ND,f);
- putc(DEF_X,f);
- dump_ob(SGC,f);
- putc(DEF_X,f);
- dump_ob(freeids,f);
- putc(DEF_X,f);
- dump_defs(internals,f);
-}
-
-dump_defs(defs,f) /* write list of defs to file f */
-word defs;
-FILE *f;
-{ while(defs!=NIL)
- if(tag[hd[defs]]==STRCONS) /* pname */
- { word v=get_pn(hd[defs]);
- dump_ob(pn_val(hd[defs]),f);
- if(v>bits_15)
- putc(PN1_X,f),
- putw(v,f);
- else
- putc(PN_X,f),
- putc(v&255,f),
- putc(v >> 8,f);
- putc(DEF_X,f);
- defs=tl[defs]; }
- else
- { dump_ob(id_val(hd[defs]),f);
- dump_ob(id_type(hd[defs]),f);
- dump_ob(id_who(hd[defs]),f);
- putc(ID_X,f);
- fprintf(f,"%s",(char *)get_id(hd[defs]));
- putc(0,f);
- putc(DEF_X,f);
- defs=tl[defs]; }
- putc(DEF_X,f); /* delimiter */
-}
-
-dump_ob(x,f) /* write combinatory expression x to file f */
-word x;
-FILE *f;
-{ /* printob("dumping: ",x); /* DEBUG */
- switch(tag[x])
- { case ATOM: if(x<128)putc(x,f); else
- if(x>=384)putc(x-256,f); else
- putc(CHAR_X,f),putc(x-128,f);
- return;
- case TVAR: putc(TVAR_X,f), putc(gettvar(x),f);
- if(gettvar(x)>255)
- fprintf(stderr,"panic, tvar too large\n");
- return;
- case INT: { /* 32 bit version (suppressed)
- int d=get_int(x);
- if(abs(d)<=127)
- { putc(SHORT_X,f); putc(d,f); return; }
- putc(INT_X,f);
- putw(d,f);
- /* variable length version */
- word d=digit(x);
- if(rest(x)==0&&(d&MAXDIGIT)<=127)
- { if(d&SIGNBIT)d= -(d&MAXDIGIT);
- putc(SHORT_X,f); putc(d,f); return; }
- putc(INT_X,f);
- putw(d,f);
- x=rest(x);
- while(x)
- putw(digit(x),f),x=rest(x);
- putw(-1,f);
- /* end of variable length version */
- return; }
- /* 4 bytes per digit wasteful at current value of IBASE */
- case DOUBLE: putc(DBL_X,f);
- putw(hd[x],f);
- putw(tl[x],f);
- return;
- case UNICODE: putc(UNICODE_X,f);
- putw(hd[x],f);
- return;
- case DATAPAIR: fprintf(f,"%c%s",AKA_X,(char *)hd[x]);
- putc(0,f);
- return;
- case FILEINFO: { word line=tl[x];
- if((char *)hd[x]==CFN)putc(HERE_X,f);
- else fprintf(f,"%c%s",HERE_X,mkrel(hd[x]));
- putc(0,f);
- putc(line&255,f);
- putc((line >>= 8)&255,f);
- if(line>255)fprintf(stderr,
- "impossible line number %d in dump_ob\n",tl[x]);
- return; }
- case CONSTRUCTOR: dump_ob(tl[x],f);
- putc(CONSTRUCT_X,f);
- putc(hd[x]&255,f);
- putc(hd[x]>>8,f);
- return;
- case STARTREADVALS: dump_ob(tl[x],f);
- putc(RV_X,f);
- return;
- case ID: fprintf(f,"%c%s",ID_X,get_id(x));
- putc(0,f);
- return;
- case STRCONS: { word v=get_pn(x); /* private name */
- if(v>bits_15)
- putc(PN1_X,f),
- putw(v,f);
- else
- putc(PN_X,f),
- putc(v&255,f),
- putc(v >> 8,f);
- return; }
- case AP: dump_ob(hd[x],f);
- dump_ob(tl[x],f);
- putc(AP_X,f);
- return;
- case CONS: dump_ob(tl[x],f);
- dump_ob(hd[x],f);
- putc(CONS_X,f);
- return;
- default: fprintf(stderr,"impossible tag %d in dump_ob\n",tag[x]);
- }
-}
-
-#define ovflocheck if(dicq-dic>DICSPACE)dicovflo()
-extern char *dic; extern word DICSPACE;
-
-word BAD_DUMP=0,CLASHES=NIL,ALIASES=NIL,PNBASE=0,SUPPRESSED=NIL,
- TSUPPRESSED=NIL,TORPHANS=0;
-
-load_script(f,src,aliases,params,main)
- /* loads a compiled script from file f for source src */
- /* main=1 if is being loaded as main script, 0 otherwise */
-FILE *f;
-char *src;
-word aliases,params,main;
-{ extern word nextpn,ND,errline,algshfns,internals,freeids,includees,SGC;
- extern char *dicp, *dicq;
- word ch,files=NIL;
- TORPHANS=BAD_DUMP=0;
- CLASHES=NIL;
- dsetup();
- setprefix(src);
- if(getc(f)!=XVERSION){ BAD_DUMP= -1; return(NIL); }
- if(aliases!=NIL)
- { /* for each `old' install diversion to `new' */
- /* if alias is of form -old `new' is a pname */
- word a,hold;
- ALIASES=aliases;
- for(a=aliases;a!=NIL;a=tl[a])
- { word old=tl[hd[a]],new=hd[hd[a]];
- hold=cons(id_who(old),cons(id_type(old),id_val(old)));
- id_type(old)=alias_t;
- id_val(old)=new;
- if(tag[new]==ID)
- if((id_type(new)!=undef_t||id_val(new)!=UNDEF)
- &&id_type(new)!=alias_t)
- CLASHES=add1(new,CLASHES);
- hd[hd[a]]=hold;
- }
- if(CLASHES!=NIL){ BAD_DUMP= -2; unscramble(aliases); return(NIL); }
- for(a=aliases;a!=NIL;a=tl[a]) /* FIX1 */
- if(tag[ch=id_val(tl[hd[a]])]==ID) /* FIX1 */
- if(id_type(ch)!=alias_t) /* FIX1 */
- id_type(ch)=new_t; /* FIX1 */
- }
- PNBASE=nextpn; /* base for relocation of internal names in dump */
- SUPPRESSED=NIL; /* list of `-id' aliases successfully obeyed */
- TSUPPRESSED=NIL; /* list of -typename aliases (illegal just now) */
- while((ch=getc(f))!=0&&ch!=EOF&&!BAD_DUMP)
- { word s,holde=0;
- dicq=dicp;
- if(files==NIL&&ch==1) /* type error script */
- { holde=getw(f),ch=getc(f);
- if(main)errline=holde; }
- if(ch!='/')(void)strcpy(dicp,prefix),dicq+=preflen;
- /* locate wrt current posn */
- *dicq++ = ch;
- while((*dicq++ =ch=getc(f))&&ch!=EOF); /* filename */
- ovflocheck;
- ch=getw(f); /* mtime */
- s=getc(f); /* share bit */
- /*printf("loading: %s(%d)\n",dicp,ch); /* DEBUG */
- if(files==NIL) /* is this the right dump? */
- if(strcmp(dicp,src))
- { BAD_DUMP=1;
- if(aliases!=NIL)unscramble(aliases);
- return(NIL); }
- CFN=get_id(name()); /* wasteful way to share filename */
- files = cons(make_fil(CFN,ch,s,load_defs(f)),
- files);
- }
-/* warning: load_defs side effects id's in namebuckets, cannot be undone by
-unload until attached to global `files', so interrupts are disabled during
-load_script - see steer.c */ /* for big dumps this may be too coarse - FIX */
- if(ch==EOF||BAD_DUMP){ if(!BAD_DUMP)BAD_DUMP=2;
- if(aliases!=NIL)unscramble(aliases);
- return(files); }
- if(files==NIL){ /* dump of syntax error state */
- extern word oldfiles;
- ch=getw(f);
- if(main)errline=ch;
- while((ch=getc(f))!=EOF)
- { dicq=dicp;
- if(ch!='/')(void)strcpy(dicp,prefix),dicq+=preflen;
- /* locate wrt current posn */
- *dicq++ = ch;
- while((*dicq++ =ch=getc(f))&&ch!=EOF); /* filename */
- ovflocheck;
- ch=getw(f); /* mtime */
- if(oldfiles==NIL) /* is this the right dump? */
- if(strcmp(dicp,src))
- { BAD_DUMP=1;
- if(aliases!=NIL)unscramble(aliases);
- return(NIL); }
- oldfiles = cons(make_fil(get_id(name()),ch,0,NIL),
- oldfiles);
- }
- if(aliases!=NIL)unscramble(aliases);
- return(NIL); }
- algshfns=append1(algshfns,load_defs(f));
- ND=load_defs(f);
- if(ND==True)ND=NIL,TORPHANS=1;
- SGC=append1(SGC,load_defs(f));
- if(main||includees==NIL)freeids=load_defs(f);
- else bindparams(load_defs(f),hdsort(params));
- if(aliases!=NIL)unscramble(aliases);
- if(main)internals=load_defs(f);
- return(reverse(files));
-}/* was it necessary to unscramble aliases before error returns?
- check this later */
-/* actions labelled FIX1 were inserted to deal with the pathological case
- that the destination of an alias (not part of a cyclic alias) has a direct
- definition in the file and the aliasee is missing from the file
- - this is both nameclash and missing aliasee, but without fix the two
- errors cancel each other out and are unreported */
-
-word DETROP=NIL,MISSING=NIL;
-
-bindparams(formal,actual) /* process bindings of free ids */
-/* formal is list of cons(id,cons(original_name,type)) */
-/* actual is list of cons(name,value) | ap(name,typevalue)) */
-/* both in alpha order of original name */
-word formal,actual;
-{ extern word FBS; word badkind=NIL;
- DETROP=MISSING=NIL;
- FBS=cons(formal,FBS);
- /* FBS is list of list of formals bound in current script */
- for(;;)
- { word a; char *f;
- while(formal!=NIL && (actual==NIL ||
- strcmp((f=(char *)hd[hd[tl[hd[formal]]]]),get_id(a=hd[hd[actual]]))<0))
- /* the_val(hd[hd[formal]])=findid((char *)hd[hd[tl[hd[formal]]]]),
- above line picks up identifier of that name in current scope */
- MISSING=cons(hd[tl[hd[formal]]],MISSING),
- formal=tl[formal];
- if(actual==NIL)break;
- if(formal==NIL||strcmp(f,get_id(a)))DETROP=cons(a,DETROP);
- else { word fa=tl[tl[hd[formal]]]==type_t?t_arity(hd[hd[formal]]):-1;
- word ta=tag[hd[actual]]==AP?t_arity(hd[actual]):-1;
- if(fa!=ta)
- badkind=cons(cons(hd[hd[actual]],datapair(fa,ta)),badkind);
- the_val(hd[hd[formal]])=tl[hd[actual]];
- formal=tl[formal]; }
- actual=tl[actual];
- }
-for(;badkind!=NIL;badkind=tl[badkind])
- DETROP=cons(hd[badkind],DETROP);
-}
-
-unscramble(aliases) /* remove old to new diversions installed above */
-word aliases;
-{ word a=NIL;
- for(;aliases!=NIL;aliases=tl[aliases])
- { word old=tl[hd[aliases]],hold=hd[hd[aliases]];
- word new=id_val(old);
- hd[hd[aliases]]=new; /* put back for missing check, see below */
- id_who(old)=hd[hold]; hold=tl[hold];
- id_type(old)=hd[hold];
- id_val(old)=tl[hold]; }
- for(;ALIASES!=NIL;ALIASES=tl[ALIASES])
- { word new=hd[hd[ALIASES]];
- word old=tl[hd[ALIASES]];
- if(tag[new]!=ID)
- { if(!member(SUPPRESSED,new))a=cons(old,a);
- continue; } /* aka stuff irrelevant to pnames */
- if(id_type(new)==new_t)id_type(new)=undef_t; /* FIX1 */
- if(id_type(new)==undef_t)a=cons(old,a); else
- if(!member(CLASHES,new))
- /* install aka info in new */
- if(tag[id_who(new)]!=CONS)
- id_who(new)=cons(datapair(get_id(old),0),id_who(new)); }
- ALIASES=a; /* transmits info about missing aliasees */
-}
-
-char *getaka(x) /* returns original name of x (as a string) */
-word x;
-{ word y=id_who(x);
- return(tag[y]!=CONS?get_id(x):(char *)hd[hd[y]]);
-}
-
-get_here(x) /* here info for id x */
-word x;
-{ word y=id_who(x);
- return(tag[y]==CONS?tl[y]:y);
-}
-
-word *dstack=0,*stackp,*dlim;
-/* stackp=dstack; /* if load_script made interruptible, add to reset */
-
-dsetup()
-{ if(!dstack)
- { dstack=(word *)malloc(1000*sizeof(word));
- if(dstack==NULL)mallocfail("dstack");
- dlim=dstack+1000; }
- stackp=dstack;
-}
-
-dgrow()
-{ word *hold=dstack;
- dstack=(word *)realloc(dstack,2*(dlim-dstack)*sizeof(word));
- if(dstack==NULL)mallocfail("dstack");
- dlim=dstack+2*(dlim-hold);
- stackp += dstack-hold;
- /*printf("dsize=%d\n",dlim-dstack); /* DEBUG */
-}
-
-load_defs(f) /* load a sequence of definitions from file f, terminated
- by DEF_X, or a single object terminated by DEF_X */
-FILE *f;
-{ extern char *dicp, *dicq;
- extern word *pnvec,common_stdin,common_stdinb,nextpn,rv_script;
- word ch,defs=NIL;
- while((ch=getc(f))!=EOF)
- { if(stackp==dlim)dgrow();
- switch(ch)
- { case CHAR_X: *stackp++ = getc(f)+128;
- continue;
- case TVAR_X: *stackp++ = mktvar(getc(f));
- continue;
- case SHORT_X: ch = getc(f);
- if(ch&128)ch= ch|(~127); /*force a sign extension*/
- *stackp++ = stosmallint(ch);
- continue;
- case INT_X: { word *x;
- ch = getw(f);
- *stackp++ = make(INT,ch,0);
- /* for 32 bit version suppress to end of varpart */
- x = &rest(stackp[-1]);
- ch = getw(f);
- while(ch!= -1)
- *x=make(INT,ch,0),ch=getw(f),x= &rest(*x);
- /* end of variable length part */
- continue; }
- case DBL_X: ch=getw(f);
- *stackp++ = make(DOUBLE,ch,getw(f));
- continue;
- case UNICODE_X: *stackp++ = make(UNICODE,getw(f),0);
- continue;
- case PN_X: ch = getc(f);
- ch = PNBASE+(ch|(getc(f)<<8));
- *stackp++ = ch<nextpn?pnvec[ch]:sto_pn(ch);
- /* efficiency hack for *stackp++ = sto_pn(ch); */
- continue;
- case PN1_X: ch=PNBASE+getw(f);
- *stackp++ = ch<nextpn?pnvec[ch]:sto_pn(ch);
- /* efficiency hack for *stackp++ = sto_pn(ch); */
- continue;
- case CONSTRUCT_X: ch = getc(f);
- ch = ch|(getc(f)<<8);
- stackp[-1] = constructor(ch,stackp[-1]);
- continue;
- case RV_X: stackp[-1] = readvals(0,stackp[-1]);
- rv_script=1;
- continue;
- case ID_X: dicq=dicp;
- while((*dicq++ =ch=getc(f))&&ch!=EOF);
- ovflocheck;
- *stackp++=name(); /* see lex.c */
- if(id_type(stackp[-1])==new_t) /* FIX1 (& next 2 lines) */
- CLASHES=add1(stackp[-1],CLASHES),stackp[-1]=NIL;
- else
- if(id_type(stackp[-1])==alias_t) /* follow alias */
- stackp[-1]=id_val(stackp[-1]);
- continue;
- case AKA_X: dicq=dicp;
- while((*dicq++ =ch=getc(f))&&ch!=EOF);
- ovflocheck;
- *stackp++=datapair(get_id(name()),0);
- /* wasteful, to share string */
- continue;
- case HERE_X: dicq=dicp;
- ch=getc(f);
- if(!ch){ /* coding hack, 0 means current file name */
- ch = getc(f);
- ch = ch|getc(f)<<8;
- *stackp++ = fileinfo(CFN,ch);
- continue; }
- /* next line locates wrt current posn */
- if(ch!='/')(void)strcpy(dicp,prefix),dicq+=preflen;
- *dicq++ = ch;
- while((*dicq++ =ch=getc(f))&&ch!=EOF);
- ovflocheck;
- ch = getc(f);
- ch = ch|getc(f)<<8;
- *stackp++ = fileinfo(get_id(name()),ch); /* wasteful */
- continue;
- case DEF_X: switch(stackp-dstack){
- case 0: /* defs delimiter */
- { /*printlist("contents: ",defs); /* DEBUG */
- return(reverse(defs)); }
- case 1: /* ob delimiter */
- { return(*--stackp); }
- case 2: /* pname defn */
- { ch = *--stackp;
- pn_val(ch)= *--stackp;
- defs=cons(ch,defs); /* NB defs now includes pnames */
- continue; }
- case 4:
- if(tag[stackp[-1]]!=ID)
- if(stackp[-1]==NIL){ stackp -= 4; continue; } /* FIX1 */
- else { /* id aliased to pname */
- word akap;
- ch= *--stackp;
- SUPPRESSED=cons(ch,SUPPRESSED);
- stackp--; /* who */
- akap= tag[*stackp]==CONS?hd[*stackp]:NIL;
- stackp--; /* lose type */
- pn_val(ch)= *--stackp;
- if(stackp[1]==type_t&&t_class(ch)!=synonym_t)
- /* suppressed typename */
- { word a=ALIASES; /* reverse assoc in ALIASES */
- while(a!=NIL&&id_val(tl[hd[a]])!=ch)
- a=tl[a];
- if(a!=NIL) /* surely must hold ?? */
- TSUPPRESSED=cons(tl[hd[a]],TSUPPRESSED);
- /*if(akap==NIL)
- akap=datapair(get_id(tl[hd[a]]),0); */
- /*if(t_class(ch)==algebraic_t)
- CSUPPRESS=append1(CSUPPRESS,t_info(ch));
- t_info(ch)= cons(akap,fileinfo(CFN,0));
- /* assists identifn of dangling typerefs
- see privatise() in steer.c */ }else
- if(pn_val(ch)==UNDEF)
- { /* special kludge for undefined names */
- /* necessary only if we allow names specified
- but not defined to be %included */
- if(akap==NIL) /* reverse assoc in ALIASES */
- { word a=ALIASES;
- while(a!=NIL&&id_val(tl[hd[a]])!=ch)
- a=tl[a];
- if(a!=NIL)
- akap=datapair(get_id(tl[hd[a]]),0); }
- pn_val(ch)= ap(akap,fileinfo(CFN,0));
- /* this will generate sensible error message
- see reduction rule for DATAPAIR */
- }
- defs=cons(ch,defs);
- continue; }
- if(
- id_type(stackp[-1])!=new_t&& /* FIX1 */
- (id_type(stackp[-1])!=undef_t||
- id_val(stackp[-1])!=UNDEF)) /* nameclash */
- { if(id_type(stackp[-1])==alias_t) /* cyclic aliasing */
- { word a=ALIASES;
- while(a!=NIL&&tl[hd[a]]!=stackp[-1])a=tl[a];
- if(a==NIL)
- { fprintf(stderr,
- "impossible event in cyclic alias (%s)\n",
- get_id(stackp[-1]));
- stackp-=4;
- continue; }
- defs=cons(*--stackp,defs);
- hd[hd[hd[a]]]= *--stackp; /* who */
- hd[tl[hd[hd[a]]]]= *--stackp; /* type */
- tl[tl[hd[hd[a]]]]= *--stackp; /* value */
- continue; }
- /*if(strcmp(CFN,hd[get_here(stackp[-1])]))
- /* EXPT (ignore clash if from same original file) */
- CLASHES=add1(stackp[-1],CLASHES);
- stackp-=4; }
- else
- defs=cons(*--stackp,defs),
- /*printf("%s undumped\n",get_id(hd[defs])), /* DEBUG */
- id_who(hd[defs])= *--stackp,
- id_type(hd[defs])= *--stackp,
- id_val(hd[defs])= *--stackp;
- continue;
- default:
- { /* printf("badly formed def in dump\n"); /* DEBUG */
- BAD_DUMP=3; return(defs); } /* should unsetids */
- } /* of switch */
- case AP_X: ch = *--stackp;
- if(stackp[-1]==READ&&ch==0)stackp[-1] = common_stdin; else
- if(stackp[-1]==READBIN&&ch==0)stackp[-1] = common_stdinb; else
- stackp[-1] = ap(stackp[-1],ch);
- continue;
- case CONS_X: ch = *--stackp;
- stackp[-1] = cons(ch,stackp[-1]);
- continue;
- default: *stackp++ = ch>127?ch+256:ch;
- }}
- BAD_DUMP=4; /* should unsetids */
- return(defs);
-}
-
-extern char *obsuffix;
-
-okdump(t) /* return 1 if script t has a non-syntax-error dump */
-char *t;
-{ char obf[120];
- FILE *f;
- (void)strcpy(obf,t);
- (void)strcpy(obf+strlen(obf)-1,obsuffix);
- f=fopen(obf,"r");
- if(f&&getc(f)==XVERSION&&getc(f)){fclose(f); return(1); }
- return(0);
-}
-
-geterrlin(t) /* returns errline from dump of t if relevant, 0 otherwise */
-char *t;
-{ char obf[120];
- extern char *dicp,*dicq;
- word ch,el;
- FILE *f;
- (void)strcpy(obf,t);
- (void)strcpy(obf+strlen(obf)-1,obsuffix);
- if(!(f=fopen(obf,"r")))return(0);
- if(getc(f)!=XVERSION||(ch=getc(f))&&ch!=1){ fclose(f);
- return(0); }
- el=getw(f);
- /* now check this is right dump */
- setprefix(t);
- ch=getc(f);
- dicq=dicp;
- if(ch!='/')(void)strcpy(dicp,prefix),dicq+=preflen;
- /* locate wrt current posn */
- *dicq++ = ch;
- while((*dicq++ =ch=getc(f))&&ch!=EOF); /* filename */
- ch=getw(f); /* mtime */
- if(strcmp(dicp,t)||ch!=fm_time(t))return(0); /* wrong dump */
- /* this test not foolproof, strictly should extract all files and check
- their mtimes, as in undump, but this involves reading the whole dump */
- return(el);
-}
-
-hdsort(x) /* sorts list of name-value pairs on name */
-word x;
-{ word a=NIL,b=NIL,hold=NIL;
- if(x==NIL)return(NIL);
- if(tl[x]==NIL)return(x);
- while(x!=NIL) /* split x */
- { hold=a,a=cons(hd[x],b),b=hold;
- x=tl[x]; }
- a=hdsort(a),b=hdsort(b);
- /* now merge two halves back together */
- while(a!=NIL&&b!=NIL)
- if(strcmp(get_id(hd[hd[a]]),get_id(hd[hd[b]]))<0)x=cons(hd[a],x),a=tl[a];
- else x=cons(hd[b],x),b=tl[b];
- if(a==NIL)a=b;
- while(a!=NIL)x=cons(hd[a],x),a=tl[a];
- return(reverse(x));
-}
-#endif
-
-append1(x,y) /* rude append */
-word x,y;
-{ word x1=x;
- if(x1==NIL)return(y);
- while(tl[x1]!=NIL)x1=tl[x1];
- tl[x1]=y;
- return(x);
-}
-
-/* following is stuff for printing heap objects in readable form - used
- for miscellaneous diagnostics etc - main function is out(FILE *,object) */
-
-/* charname returns the printable name of a character, as a string (using
- C conventions for control characters */ /* DAT 13/9/83 */
-/* NB we use DECIMAL (not octal) for miscellaneous unprintables */
-
-/* WARNING - you should take a copy of the name if you intend to do anything
- with it other than print it immediately */
-
-char *charname(c)
-word c;
-{ static char s[5];
- switch(c)
- { case '\n': return("\\n");
- case '\t': return("\\t");
- case '\b': return("\\b");
- case '\f': return("\\f"); /* form feed */
- case '\r': return("\\r"); /* carriage return */
- case '\\': return("\\\\");
- case '\'': return("\\'");
- case '"': return("\\\"");
- /* we escape all quotes for safety, since the context could be either
- character or string quotation */
- default: if(c<32||c>126) /* miscellaneous unprintables -- convert to decimal */
- sprintf(s,"\\%d",c);
- else s[0]=c,s[1]='\0';
- return(s);
- }
-}
-
-out(f,x)
-/* the routines "out","out1","out2" are for printing compiled expressions */
-FILE *f;
-word x;
-{
-#ifdef DEBUG
- static pending=NIL; /* cycle trap */
- word oldpending=pending; /* cycle trap */
-#endif
- if(x<0||x>TOP){ fprintf(f,"<%d>",x); return; }
-#ifdef DEBUG
- if(member(pending,x)){ fprintf(f,"..."); return; } /* cycle trap */
- pending=cons(x,pending); /* cycle trap */
-#endif
- if(tag[x]==LAMBDA)
- { fprintf(f,"$(");out(f,hd[x]);putc(')',f);
- out(f,tl[x]); } else
- { while(tag[x]==CONS)
- { out1(f,hd[x]);
- putc(':',f);
- x= tl[x];
-#ifdef DEBUG
- if(member(pending,x))break; /* cycle trap */
- pending=cons(x,pending); /* cycle trap */
-#endif
- }
- out1(f,x); }
-#ifdef DEBUG
- pending=oldpending; /* cycle trap */
-#endif
-} /* warning - cycle trap not interrupt safe if `out' used in compiling
- process */
-
-out1(f,x)
-FILE *f;
-word x;
-{ if(x<0||x>TOP){ fprintf(f,"<%d>",x); return; }
- if(tag[x]==AP)
- { out1(f,hd[x]);
- putc(' ',f);
- out2(f,tl[x]); }
- else out2(f,x); }
-
-out2(f,x)
-FILE *f;
-word x;
-{ extern char *yysterm[], *cmbnms[];
- if(x<0||x>TOP){ fprintf(f,"<%d>",x); return; }
- if(tag[x]==INT)
- { if(rest(x))
- { x=bigtostr(x);
- while(x)putc(hd[x],f),x=tl[x]; }
- else fprintf(f,"%d",getsmallint(x));
- return; }
- if(tag[x]==DOUBLE){ outr(f,get_dbl(x)); return; }
- if(tag[x]==ID){ fprintf(f,"%s",get_id(x)); return; }
- if(x<256){ fprintf(f,"\'%s\'",charname(x)); return; }
- if(tag[x]==UNICODE){ fprintf(f,"'\%x'",hd[x]); return; }
- if(tag[x]==ATOM)
- { fprintf(f,"%s",x<CMBASE?yysterm[x-256]:
- x==True?"True":
- x==False?"False":
- x==NIL?"[]":
- x==NILS?"\"\"":
- cmbnms[x-CMBASE]);
- return; }
- if(tag[x]==TCONS||tag[x]==PAIR)
- { fprintf(f,"(");
- while(tag[x]==TCONS)
- out(f,hd[x]), putc(',',f), x=tl[x];
- out(f,hd[x]); putc(',',f); out(f,tl[x]);
- putc(')',f); return; }
- if(tag[x]==TRIES)
- { fprintf(f,"TRIES("); out(f,hd[x]); putc(',',f); out(f,tl[x]);
- putc(')',f); return; }
- if(tag[x]==LABEL)
- { fprintf(f,"LABEL("); out(f,hd[x]); putc(',',f); out(f,tl[x]);
- putc(')',f); return; }
- if(tag[x]==SHOW)
- { fprintf(f,"SHOW("); out(f,hd[x]); putc(',',f); out(f,tl[x]);
- putc(')',f); return; }
- if(tag[x]==STARTREADVALS)
- { fprintf(f,"READVALS("); out(f,hd[x]); putc(',',f); out(f,tl[x]);
- putc(')',f); return; }
- if(tag[x]==LET)
- { fprintf(f,"(LET ");
- out(f,dlhs(hd[x])),fprintf(f,"=");
- out(f,dval(hd[x])),fprintf(f,";IN ");
- out(f,tl[x]);
- fprintf(f,")"); return; }
- if(tag[x]==LETREC)
- { word body=tl[x];
- fprintf(f,"(LETREC ");
- x=hd[x];
- while(x!=NIL)out(f,dlhs(hd[x])),fprintf(f,"="),
- out(f,dval(hd[x])),fprintf(f,";"),x=tl[x];
- fprintf(f,"IN ");
- out(f,body);
- fprintf(f,")"); return; }
- if(tag[x]==DATAPAIR)
- { fprintf(f,"DATAPAIR(%s,%d)",(char *)hd[x],tl[x]);
- return; }
- if(tag[x]==FILEINFO)
- { fprintf(f,"FILEINFO(%s,%d)",(char *)hd[x],tl[x]);
- return; }
- if(tag[x]==CONSTRUCTOR)
- { fprintf(f,"CONSTRUCTOR(%d)",hd[x]);
- return; }
- if(tag[x]==STRCONS)
- { fprintf(f,"<$%d>",hd[x]); return; }/* used as private id's, inter alia*/
- if(tag[x]==SHARE)
- { fprintf(f,"(SHARE:"); out(f,hd[x]); fprintf(f,")"); return; }
- if(tag[x]!=CONS&&tag[x]!=AP&&tag[x]!=LAMBDA)
- /* not a recognised structure */
- { fprintf(f,"<%d|tag=%d>",x,tag[x]); return; }
- putc('(',f);
- out(f,x);
- putc(')',f); }
-
-outr(f,r) /* prints a number */
-FILE *f;
-double r;
-{ double p;
- p= r<0?-r: r;
- if(p>=1000.0||p<=.001)fprintf(f,"%e",r);
- else fprintf(f,"%f",r); }
-
-/* end of MIRANDA DATA REPRESENTATIONS */
-
generated by cgit v1.2.1 (git 2.18.0) at 2024-12-22 20:49:41 +0000