Skip to main content
  • Home
  • Development
  • Documentation
  • Donate
  • Operational login
  • Browse the archive

swh logo
SoftwareHeritage
Software
Heritage
Archive
Features
  • Search

  • Downloads

  • Save code now

  • Add forge now

  • Help

https://github.com/jrincayc/ucblogo-code
26 January 2024, 08:32:20 UTC
  • Code
  • Branches (8)
  • Releases (24)
  • Visits
    • Branches
    • Releases
    • HEAD
    • refs/heads/debug_stop
    • refs/heads/fix_39
    • refs/heads/makefile_updates_v2
    • refs/heads/master
    • refs/heads/message_fix
    • refs/heads/release_624_changes
    • refs/heads/utf8_play
    • refs/tags/dev-latest
    • version_6.2.5rc1
    • version_6.2.4rc1
    • version_6.2.4
    • version_6.2.3rc1
    • version_6.2.3
    • version_6.2.2
    • version_6.2.1
    • version_6.2
    • version_6.1
    • version_6.0
    • pre_release_6_2_b
    • pre_release_6_2_a
    • pre_release_6_2_2
    • pre_release_6_1_c
    • pre_release_6_1_b
    • pre_release_6_1_a
    • last_svn_version
    • debian/6.2.4-1
    • debian/6.2.3-1
    • debian/6.2.2-3
    • debian/6.2.2-2
    • debian/6.2.2-1
    • debian/6.2.1-2
    • debian/6.2.1-1
  • 3db8803
  • /
  • logodata.c
Raw File Download Save again
Take a new snapshot of a software origin

If the archived software origin currently browsed is not synchronized with its upstream version (for instance when new commits have been issued), you can explicitly request Software Heritage to take a new snapshot of it.

Use the form below to proceed. Once a request has been submitted and accepted, it will be processed as soon as possible. You can then check its processing state by visiting this dedicated page.
swh spinner

Processing "take a new snapshot" request ...

To reference or cite the objects present in the Software Heritage archive, permalinks based on SoftWare Hash IDentifiers (SWHIDs) must be used.
Select below a type of object currently browsed in order to display its associated SWHID and permalink.

  • content
  • directory
  • revision
  • snapshot
  • release
origin badgecontent badge
swh:1:cnt:6f5480ce450b5577a1393a9fbd6f1489b47100e5
origin badgedirectory badge
swh:1:dir:3db8803f414bc7b2bec483c60dcc025c0eb41574
origin badgerevision badge
swh:1:rev:d58dd7c0cf2de738f7da115e88e9d7d882020f52
origin badgesnapshot badge
swh:1:snp:6eedb1da19a602bcc290a95dfe80bedb7646053c
origin badgerelease badge
swh:1:rel:2a2534d14430e816bd2a6b4e01a7d9e177cabc3e

This interface enables to generate software citations, provided that the root directory of browsed objects contains a citation.cff or codemeta.json file.
Select below a type of object currently browsed in order to generate citations for them.

  • content
  • directory
  • revision
  • snapshot
  • release
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Tip revision: d58dd7c0cf2de738f7da115e88e9d7d882020f52 authored by Barak A. Pearlmutter on 15 September 2022, 09:05:04 UTC
bump policy
Tip revision: d58dd7c
logodata.c
/*
 *      logodata.c      logo data management module             dvb
 *
 *	Copyright (C) 1993 by the Regents of the University of California
 *
 *      This program is free software: you can redistribute it and/or modify
 *      it under the terms of the GNU General Public License as published by
 *      the Free Software Foundation, either version 3 of the License, or
 *      (at your option) any later version.
 *
 *      This program is distributed in the hope that it will be useful,
 *      but WITHOUT ANY WARRANTY; without even the implied warranty of
 *      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *      GNU General Public License for more details.
 *
 *      You should have received a copy of the GNU General Public License
 *      along with this program.  If not, see <https://www.gnu.org/licenses/>.
 *
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif

#define WANT_EVAL_REGS 1
#include "logo.h"
#include "globals.h"
#include <stdarg.h>
#ifdef ibm
#if !defined(__RZTC__) && !defined(_MSC_VER)
#include <alloc.h>
#endif
#endif

char special_chars[] = " \t\n(?????+++~)[]-*/=<>\"\\:;|{}";

#ifdef ecma

#include <ctype.h>

#define upper_p(ch)	(isupper((ch) & 0377))
#define lower_p(ch)	(islower((ch) & 0377))

char ecma_array[128];

int ecma_size = sizeof(special_chars)-1;

char ecma_set(int ch) {
    ch &= 0377;
    if (ch >= 128) return(ch);
    return(ecma_array[ch]);
}

char ecma_clear(int ch) {
    ch &= 0377;
    if (ch < ecma_begin || ch >= ecma_begin+sizeof(special_chars)-1)
	return(ch);
    if (ch >= 007 && ch <= 015 && ch != 013) return(ch);
    return(special_chars[ch - ecma_begin]);
}

int ecma_get(int ch) {
    ch &= 0377;
    return ((ch >= ecma_begin && ch < ecma_begin+sizeof(special_chars)-1)
	    && (ch < 007 || ch > 015 || ch == 013));
}

#else

#define upper_p(c)     (c >= 'A' && c <= 'Z')
#define lower_p(c)     (c >= 'a' && c <= 'z')

#endif

char *strnzcpy(char *s1, char *s2, int n) {
    strncpy(s1, s2, n);
    s1[n] = '\0';
    return(s1);
}

char *word_strnzcpy(char *s1, NODE *kludge, int n) {  /* KLUDGE! */
    char *temp = s1;

    while (kludge != NIL) {
	strncpy(s1, getstrptr(car(kludge)), getstrlen(car(kludge)));
	s1 += getstrlen(car(kludge));
	kludge = cdr(kludge);
    }
    temp[n] = '\0';
    return(temp);
}

char *noparity_strnzcpy(char *s1, char *s2, int n) {
    int i;

    for (i = 0; i < n; i++)
	s1[i] = clearparity(s2[i]);
    s1[n] = '\0';
    return(s1);
}

char *backslashed_strnzcpy(char *s1, char *s2, int n) {
    int i,j;

    for (i = 0, j = 0; i < n; i++) {
	if (getparity(s2[i]))
	    s1[j++] = '\\';
	s1[j++] = clearparity(s2[i]);
    }
    s1[j] = '\0';
    return(s1);
}

char *mend_strnzcpy(char *s1, char *s2, int n) {
    int i, vbar = 0;

    for (i = 0; i < n; ) {
	while (*s2 == '|') {
	    vbar = !vbar;
	    s2++;
	}
	if (vbar) {
	    if (strchr(special_chars,(int)*s2))
		s1[i++] = setparity(*s2++);
	    else
		s1[i++] = *s2++;
	} else {
	    while (*s2 == ';' || (*s2 == '~' && *(s2 + 1) == '\n')) {
		while (*s2 == '~' && *(s2 + 1) == '\n') s2 += 2;
		if (*s2 == ';')
		    do {
			s2++;
		    } while (*s2 != '\0' && *s2 != '~' && *(s2 + 1) != '\n');
	    }
	    if (*s2 != '|') s1[i++] = *s2++;
	}
    }
    s1[n] = '\0';
    return(s1);
}

char *mend_nosemi(char *s1, char *s2, int n) {
    int i, vbar = 0;

    for (i = 0; i < n; ) {
	while (*s2 == '|') {
	    vbar = !vbar;
	    s2++;
	}
	if (vbar) {
	    if (strchr(special_chars,(int)*s2))
		s1[i++] = setparity(*s2++);
	    else
		s1[i++] = *s2++;
	} else {
	    while ((*s2 == '~' && *(s2 + 1) == '\n')) {
		while (*s2 == '~' && *(s2 + 1) == '\n') s2 += 2;
	    }
	    if (*s2 != '|') s1[i++] = *s2++;
	}
    }
    s1[n] = '\0';
    return(s1);
}

char *quote_strnzcpy(char *s1, char *s2, int n) {
    s1[0] = '"';
    strncpy(s1 + 1, s2, n - 1);
    s1[n] = '\0';
    return(s1);
}

char *colon_strnzcpy(char *s1, char *s2, int n) {
    s1[0] = ':';
    strncpy(s1 + 1, s2, n - 1);
    s1[n] = '\0';
    return(s1);
}

#define uncapital(c)    ((c) - 'A' + 'a')

char *low_strnzcpy(char *s1, char *s2, int n) {
    char *temp = s1;
    int i;

    for (i = 0; i < n; i++) {
	if (upper_p(*s2))
	    *s1++ = uncapital(*s2++);
	else
	    *s1++ = *s2++;
    }
    *s1 = '\0';
    return(temp);
}

#define capital(c)    ((c) - 'a' + 'A')

char *cap_strnzcpy(char *s1, char *s2, int n) {
    char *temp = s1;
    int i;

    for (i = 0; i < n; i++) {
	if (lower_p(*s2))
	    *s1++ = capital(*s2++);
	else
	    *s1++ = *s2++;
    }
    *s1 = '\0';
    return(temp);
}

char *noparitylow_strnzcpy(char *s1, char *s2, int n) {
    int i;
    char c, *temp = s1;

    for (i = 0; i < n; i++) {
	c = clearparity(*s2++);
	if (upper_p(c))
	    *s1++ = uncapital(c);
	else
	    *s1++ = c;
    }
    *s1 = '\0';
    return(temp);
}

int low_strncmp(char *s1, char *s2, int n) {
    int i;

    for (i = 0; i < n; i++) {
	if (*s1 != *s2) {
	    if (upper_p(*s2)) {
		if (upper_p(*s1)) {
		    if (uncapital(*s1) != uncapital(*s2))
			return(uncapital(*s1) - uncapital(*s2));
		} else {
		    if (*s1 != uncapital(*s2))
			return(*s1 - uncapital(*s2));
		}
	    } else if (upper_p(*s1)) {
		if (uncapital(*s1) != *s2)
		    return(uncapital(*s1) - *s2);
	    } else return(*s1 - *s2);
	}
	s1++, s2++;
    }
    return(0);
}

int noparity_strncmp(char *s1, char *s2, int n) {
    int i;

    for (i = 0; i < n; i++) {
	if (clearparity(*s1) != clearparity(*s2))
	    return(clearparity(*s1) - clearparity(*s2));
	s1++, s2++;
    }
    return(0);
}

int noparitylow_strncmp(char *s1, char *s2, int n) {
    int i;
    char c1, c2;

    for (i = 0; i < n; i++) {
	c1 = clearparity(*s1);
	c2 = clearparity(*s2);
	if (c1 != c2) {
	    if (upper_p(c2)) {
		if (upper_p(c1)) {
		    if (uncapital(c1) != uncapital(c2))
			return(uncapital(c1) - uncapital(c2));
		} else {
		    if (c1 != uncapital(c2))
			return(c1 - uncapital(c2));
		}
	    } else if (upper_p(c1)) {
		if (uncapital(c1) != c2)
		    return(uncapital(c1) - c2);
	    } else return(c1 - c2);
	}
	s1++, s2++;
    }
    return(0);
}

NODE *make_strnode(char *strptr, struct string_block *strhead, int len,
		   NODETYPES typ, char *(*copy_routine)())
{
    NODE *strnode;

    if (len == 0 && Null_Word != NIL) return(Null_Word);
    strnode = newnode(typ);
    if (strhead == NULL) {
	strhead = (struct string_block *) malloc((size_t)len
						 + sizeof(FIXNUM) + 1);
	if (strhead == NULL) {
	    err_logo(OUT_OF_MEM, NIL);
	    return UNBOUND;
	}
	(*copy_routine) (strhead->str_str, strptr, len);
	strptr = strhead->str_str;
	setstrrefcnt(strhead, 0);
    }
    setstrlen(strnode, len);
    setstrptr(strnode, strptr);
    setstrhead(strnode, strhead);
    incstrrefcnt(strhead);
    return(strnode);
}

void make_runparse(NODE *ndi) {
    NODE *rp_list;

    rp_list = runparse(ndi);
    setobject(ndi, rp_list);
    settype(ndi, RUN_PARSE);
}

NODE *make_quote(NODE *qnd) {
    NODE *nd;

    nd = cons(qnd, NIL);
    settype(nd, QUOTE);
    return(nd);
}

NODE *maybe_quote(NODE *nd) {
    if (nodetype(nd) == CONT) nd = cdr(nd);
    if (nd == UNBOUND || aggregate(nd) || numberp(nd)) return(nd);
    return(make_quote(nd));
}

NODE *make_caseobj(NODE *cstrnd, NODE *obj) {
    NODE *nd;

    nd = cons(cstrnd, obj);
    settype(nd, CASEOBJ);
    return(nd);
}

NODE *make_colon(NODE *cnd) {
    NODE *nd;

    nd = cons(cnd, NIL);
    settype(nd, COLON);
    return(nd);
}

NODE *make_intnode(FIXNUM i) {
    NODE *nd = newnode(INT);

    setint(nd, i);
    return(nd);
}

NODE *make_floatnode(FLONUM f) {
    NODE *nd = newnode(FLOATT);

    setfloat(nd, f);
    return(nd);
}

NODE *cnv_node_to_numnode(NODE *ndi) {
    NODE *val;
    int dr;
    char s2[MAX_NUMBER], *s = s2;

    if (is_number(ndi))
	return(ndi);
    ndi = cnv_node_to_strnode(ndi);
    if (ndi == UNBOUND) return(UNBOUND);
    if (((getstrlen(ndi)) < MAX_NUMBER) && (dr = numberp(ndi))) {
	if (backslashed(ndi))
	    noparity_strnzcpy(s, getstrptr(ndi), getstrlen(ndi));
	else
	    strnzcpy(s, getstrptr(ndi), getstrlen(ndi));
	if (*s == '+') ++s;
	if (s2[getstrlen(ndi)-1] == '.') s2[getstrlen(ndi)-1] = 0;
	if (dr - 1 || getstrlen(ndi) > 9) {
	    val = newnode(FLOATT);
	    setfloat(val, atof(s));
	} else {
	    val = newnode(INT);
	    setint(val, atol(s));
	}
	return(val);
    } else {
	return(UNBOUND);
    }
}

NODE *cnv_node_to_strnode(NODE *nd) {
    char s[MAX_NUMBER];

    if (nd == UNBOUND || aggregate(nd)) {
	return(UNBOUND);
    }
    switch(nodetype(nd)) {
	case STRING:
	case BACKSLASH_STRING:
	case VBAR_STRING:
	    return(nd);
	case CASEOBJ:
	    return strnode__caseobj(nd);
	case QUOTE:
	    nd = cnv_node_to_strnode(node__quote(nd));
	    nd = make_strnode(getstrptr(nd), (struct string_block *)NULL,
			      getstrlen(nd) + 1, nodetype(nd), quote_strnzcpy);
	    return(nd);
	case COLON:
	    nd = cnv_node_to_strnode(node__colon(nd));
	    nd = make_strnode(getstrptr(nd), (struct string_block *)NULL,
			      getstrlen(nd) + 1, nodetype(nd), colon_strnzcpy);
	    return(nd);
	case INT:
	    sprintf(s, "%ld", getint(nd));
	    return(make_strnode(s, (struct string_block *)NULL,
				(int)strlen(s), STRING, strnzcpy));
	case FLOATT:
	    sprintf(s, "%0.15g", getfloat(nd));
	    return(make_strnode(s, (struct string_block *)NULL,
				(int)strlen(s), STRING, strnzcpy));
    }
    return(UNBOUND);	/* Can't get here, but makes compiler happy */
}

NODE *make_static_strnode(char *strptr) {
    NODE *strnode = newnode(STRING);

    setstrptr(strnode, strptr);
    setstrhead(strnode, NULL);
    setstrlen(strnode, (int)strlen(strptr));
    return(strnode);
}

NODE *cons_list(int dummy, ...) {
    va_list ap;
    NODE *nptr, *outline = NIL, *lastnode = NIL, *val;

     va_start(ap, dummy);
     while ( (nptr = va_arg(ap, NODE *)) != END_OF_LIST) {
	val = cons(nptr, NIL);
	if (outline == NIL) {
	    outline = val;
	    lastnode = outline;
	} else {
	    setcdr(lastnode, val);
	    lastnode = val;
	}
     }
    va_end(ap);
    return(outline);
}

NODE *make_array(FIXNUM len) {
    NODE *node;
    NODE **data;

    node = newnode(ARRAY);
    setarrorg(node,1);
    setarrdim(node,len);
    data = (NODE **)malloc((size_t)len * sizeof(NODE *));
    if (data == NULL) {
        err_logo(OUT_OF_MEM, NIL);
	return UNBOUND;
    }
    setarrptr(node,data);
    while (--len >= 0) *data++ = NIL;
    return(node);
}

NODE *llowercase(NODE *args) {
    NODE *arg;

    arg = string_arg(args);
    if (NOT_THROWING) {
	return make_strnode(getstrptr(arg), (struct string_block *)NULL,
			    getstrlen(arg), nodetype(arg), low_strnzcpy);
    }
    return UNBOUND;
}

NODE *luppercase(NODE *args) {
    NODE *arg;

    arg = string_arg(args);
    if (NOT_THROWING) {
	return make_strnode(getstrptr(arg), (struct string_block *)NULL,
			    getstrlen(arg), nodetype(arg), cap_strnzcpy);
    }
    return UNBOUND;
}

/* property list stuff */

NODE *getprop(NODE *plist, NODE *name, BOOLEAN before)
{
    NODE *prev = NIL;
    BOOLEAN caseig = FALSE;

    if (varTrue(Caseignoredp))
	caseig = TRUE;
    while (plist != NIL) {
	if (compare_node(name,car(plist),caseig) == 0) {
	    return(before ? prev : plist);
	}
	prev = plist;
	plist = cddr(plist);
    }
    return(NIL);
}

NODE *lgprop(NODE *args) {
    NODE *plname, *pname, *plist, *val = NIL;

    plname = string_arg(args);
    pname = string_arg(cdr(args));
    if (NOT_THROWING) {
	plname = intern(plname);
	plist = plist__caseobj(plname);
	if (plist != NIL)
	    val = getprop(plist, pname, FALSE);
	if (val != NIL)
	    return cadr(val);
    }
    return NIL;
}

NODE *lpprop(NODE *args) {
    NODE *plname, *pname, *newval, *plist, *val = NIL;

    plname = string_arg(args);
    pname = string_arg(cdr(args));
    newval = car(cddr(args));
    if (NOT_THROWING) {
	plname = intern(plname);
	if (flag__caseobj(plname, PLIST_TRACED)) {
	    ndprintf(writestream, "%t %s %s %s",
		     message_texts[TRACE_PPROP], maybe_quote(plname),
		     maybe_quote(pname), maybe_quote(newval));
	    if (ufun != NIL)
		ndprintf(writestream,message_texts[ERROR_IN],ufun,this_line);
	    new_line(writestream);
	}
	plist = plist__caseobj(plname);
	if (plist != NIL)
	    val = getprop(plist, pname, FALSE);
	if (val != NIL)
	    setcar(cdr(val), newval);
	else
	    setplist__caseobj(plname, cons(pname, cons(newval, plist)));
	need_save = 1;
    }
    return(UNBOUND);
}

NODE *lremprop(NODE *args) {
    NODE *plname, *pname, *plist, *val = NIL;
    BOOLEAN caseig = FALSE;

    if (varTrue(Caseignoredp))
	caseig = TRUE;
    plname = string_arg(args);
    pname = string_arg(cdr(args));
    if (NOT_THROWING) {
	plname = intern(plname);
	plist = plist__caseobj(plname);
	if (plist != NIL) {
	    if (compare_node(car(plist), pname, caseig) == 0)
		setplist__caseobj(plname, cddr(plist));
	    else {
		val = getprop(plist, pname, TRUE);
		if (val != NIL)
		    setcdr(cdr(val), cddr(cddr(val)));
	    }
	}
    }
    return(UNBOUND);
}

NODE *copy_list(NODE *arg) {
    NODE *tnode, *lastnode = NIL, *val = NIL;

    while (arg != NIL) {
	tnode = cons(car(arg), NIL);
	arg = cdr(arg);
	if (val == NIL) {
	    lastnode = val = tnode;
	} else {
	    setcdr(lastnode, tnode);
	    lastnode = tnode;
	}
    }
    return(val);
}

NODE *lplist(NODE *args) {
    NODE *plname, *plist, *val = NIL;

    plname = string_arg(args);
    if (NOT_THROWING) {
	plname = intern(plname);
	plist = plist__caseobj(plname);
	if (plist != NIL)
	    val = copy_list(plist);
    }
    return(val);
}

/* Boolean foreign language stuff */

int isName(NODE *nod, enum words wd) {
    return ((compare_node(nod, translations[wd].English, TRUE) == 0) ||
	    (compare_node(nod, translations[wd].Alt, TRUE) == 0));
}

int varTrue(NODE *varb) {
    return isName(valnode__caseobj(varb), Name_true);
}

NODE *theName(enum words wd) {
    return(varTrue(UseAlternateNames) ? translations[wd].Alt :
					translations[wd].English);
}

NODE *TrueName() {
    return theName(Name_true);
}

NODE *FalseName() {
    return theName(Name_false);
}

back to top

Software Heritage — Copyright (C) 2015–2026, The Software Heritage developers. License: GNU AGPLv3+.
The source code of Software Heritage itself is available on our development forge.
The source code files archived by Software Heritage are available under their own copyright and licenses.
Terms of use: Archive access, API— Content policy— Contact— JavaScript license information— Web API