コード例 #1
0
ファイル: lisp767.c プロジェクト: hoelzl/Clicc
void Fstring_left_trim(CL_FORM *base)
{
	Fstring(ARG(1));
	LOAD_FIXNUM(ARG(2), 0, ARG(2));
	M1_1:;
	COPY(ARG(2), ARG(3));
	COPY(ARG(1), ARG(4));
	Flength(ARG(4));
	Fnumeql(ARG(3), 2);
	if(CL_TRUEP(ARG(3)))
	{
		LOAD_SMSTR((CL_FORM *)&KClisp[70], ARG(0));	/*  */
		goto RETURN1;
	}
	COPY(ARG(1), ARG(3));
	Fstringp(ARG(3));
	if(CL_TRUEP(ARG(3)))
	{
	}
	else
	{
		COPY(SYMVAL(Slisp, 58), ARG(3));	/* WRONG_TYPE */
		COPY(ARG(1), ARG(4));
		LOAD_SYMBOL(SYMBOL(Slisp, 44), ARG(5));	/* STRING */
		Ferror(ARG(3), 3);
	}
	COPY(ARG(1), ARG(3));
	COPY(ARG(2), ARG(4));
	Frow_major_aref(ARG(3));
	COPY(ARG(0), ARG(4));
	LOAD_SYMBOL(SYMBOL(Slisp, 282), ARG(5));	/* TEST */
	LOAD_GLOBFUN(&CFcharE, ARG(6));
	Ffind(ARG(3), 4);
	if(CL_TRUEP(ARG(3)))
	{
	}
	else
	{
		goto RETURN2;
	}
	F1plus(ARG(2));
	goto M1_1;
	RETURN2:;
	COPY(ARG(2), ARG(3));
	Fzerop(ARG(3));
	if(CL_TRUEP(ARG(3)))
	{
		COPY(ARG(1), ARG(0));
	}
	else
	{
		COPY(ARG(1), ARG(0));
		COPY(ARG(2), ARG(1));
		LOAD_NIL(ARG(2));
		subseq1(ARG(0));
	}
	RETURN1:;
}
コード例 #2
0
ファイル: patternE.c プロジェクト: hoelzl/Clicc
void patternE(CL_FORM *base)
{
	COPY(ARG(0), ARG(2));
	pattern_pieces(ARG(2));
	COPY(ARG(1), ARG(3));
	pattern_pieces(ARG(3));
	COPY(ARG(2), ARG(4));
	Flength(ARG(4));
	COPY(ARG(3), ARG(5));
	Flength(ARG(5));
	Fnumeql(ARG(4), 2);
	if(CL_TRUEP(ARG(4)))
	{
		LOAD_GLOBFUN(&CZ114_lambda, ARG(4));
		COPY(ARG(2), ARG(5));
		COPY(ARG(3), ARG(6));
		Fevery(ARG(4), 3);
		COPY(ARG(4), ARG(0));
	}
	else
	{
		LOAD_NIL(ARG(0));
	}
}
コード例 #3
0
ファイル: menu.c プロジェクト: ueno/emacs
/* Set up data in menu_items for a menu bar item
   whose event type is ITEM_KEY (with string ITEM_NAME)
   and whose contents come from the list of keymaps MAPS.  */
bool
parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
		      Lisp_Object maps)
{
  Lisp_Object length;
  EMACS_INT len;
  Lisp_Object *mapvec;
  ptrdiff_t i;
  bool top_level_items = 0;
  USE_SAFE_ALLOCA;

  length = Flength (maps);
  len = XINT (length);

  /* Convert the list MAPS into a vector MAPVEC.  */
  SAFE_ALLOCA_LISP (mapvec, len);
  for (i = 0; i < len; i++)
    {
      mapvec[i] = Fcar (maps);
      maps = Fcdr (maps);
    }

  /* Loop over the given keymaps, making a pane for each map.
     But don't make a pane that is empty--ignore that map instead.  */
  for (i = 0; i < len; i++)
    {
      if (!KEYMAPP (mapvec[i]))
	{
	  /* Here we have a command at top level in the menu bar
	     as opposed to a submenu.  */
	  top_level_items = 1;
	  push_menu_pane (Qnil, Qnil);
	  push_menu_item (item_name, Qt, item_key, mapvec[i],
			  Qnil, Qnil, Qnil, Qnil);
	}
      else
	{
	  Lisp_Object prompt;
	  prompt = Fkeymap_prompt (mapvec[i]);
	  single_keymap_panes (mapvec[i],
			       !NILP (prompt) ? prompt : item_name,
			       item_key, 10);
	}
    }

  SAFE_FREE ();
  return top_level_items;
}
コード例 #4
0
ファイル: lisp182.c プロジェクト: hoelzl/Clicc
void Fmake_string_input_stream(CL_FORM *base, int nargs)
{
	switch(nargs)
	{
		case 1:
		LOAD_FIXNUM(ARG(1), 0, ARG(1));
		case 2:
		COPY(ARG(0), ARG(2));
		Flength(ARG(2));
		case 3:
		break;
		default:
		Labort(TOO_MANY_ARGS);
	}
	make_string_input_stream1(ARG(0));
}
コード例 #5
0
ファイル: menu.c プロジェクト: stanis/emacs
/* Set up data in menu_items for a menu bar item
   whose event type is ITEM_KEY (with string ITEM_NAME)
   and whose contents come from the list of keymaps MAPS.  */
int
parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
{
  Lisp_Object length;
  int len;
  Lisp_Object *mapvec;
  int i;
  int top_level_items = 0;

  length = Flength (maps);
  len = XINT (length);

  /* Convert the list MAPS into a vector MAPVEC.  */
  mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
  for (i = 0; i < len; i++)
    {
      mapvec[i] = Fcar (maps);
      maps = Fcdr (maps);
    }

  /* Loop over the given keymaps, making a pane for each map.
     But don't make a pane that is empty--ignore that map instead.  */
  for (i = 0; i < len; i++)
    {
      if (!KEYMAPP (mapvec[i]))
	{
	  /* Here we have a command at top level in the menu bar
	     as opposed to a submenu.  */
	  top_level_items = 1;
	  push_menu_pane (Qnil, Qnil);
	  push_menu_item (item_name, Qt, item_key, mapvec[i],
			  Qnil, Qnil, Qnil, Qnil);
	}
      else
	{
	  Lisp_Object prompt;
	  prompt = Fkeymap_prompt (mapvec[i]);
	  single_keymap_panes (mapvec[i],
			       !NILP (prompt) ? prompt : item_name,
			       item_key, 10);
	}
    }

  return top_level_items;
}
コード例 #6
0
ファイル: sort1.c プロジェクト: hoelzl/Clicc
void sort1(CL_FORM *base)
{
	if(CL_LISTP(ARG(0)))
	{
		list_merge_sort(ARG(0));
	}
	else
	{
		COPY(ARG(0), ARG(3));
		LOAD_FIXNUM(ARG(4), 0, ARG(4));
		COPY(ARG(0), ARG(5));
		Flength(ARG(5));
		COPY(ARG(1), ARG(6));
		COPY(ARG(2), ARG(7));
		quick_sort(ARG(3));
		COPY(ARG(3), ARG(0));
	}
}
コード例 #7
0
static void
make_argv (repv list, int *argc, char ***argv)
{
    int c = rep_INT (Flength (list)), i;
    char **v;

    v = (char **)rep_alloc ((c+1) * sizeof(char**));
    for (i = 0; i < c; i++, list = rep_CDR (list))
    {
	if (!rep_STRINGP (rep_CAR (list)))
	{
	    rep_free ((char *)v);
	    return;
	}
	v[i] = strdup (rep_STR (rep_CAR (list)));
    }
    v[c] = NULL;
  
    *argv = v;
    *argc = c;
}
コード例 #8
0
ファイル: eldap.c プロジェクト: boukeversteegh/chise
  EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, search_plist)
    {
      /* Host */
      if (EQ (keyword, Qhost))
        {
          CHECK_STRING (value);
          ldap_host = alloca (XSTRING_LENGTH (value) + 1);
          strcpy (ldap_host, (char *)XSTRING_DATA (value));
        }
      /* Filter */
      else if (EQ (keyword, Qfilter))
        {
          CHECK_STRING (value);
          ldap_filter = alloca (XSTRING_LENGTH (value) + 1);
          strcpy (ldap_filter, (char *)XSTRING_DATA (value));
        }
      /* Attributes */
      else if (EQ (keyword, Qattributes))
        {
          if (! NILP (value))
            {
              Lisp_Object attr_left = value;
              struct gcpro ngcpro1;

              NGCPRO1 (attr_left);
              CHECK_CONS (value);

              ldap_attributes = alloca ((XINT (Flength (value)) + 1)*sizeof (char *));

              for (i=0; !NILP (attr_left); i++) {
                CHECK_STRING (XCAR (attr_left));
                ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
                strcpy(ldap_attributes[i],
                       (char *)(XSTRING_DATA( XCAR (attr_left))));
                attr_left = XCDR (attr_left);
              }
              ldap_attributes[i] = NULL;
              NUNGCPRO;
            }
        }
      /* Attributes Only */
      else if (EQ (keyword, Qattrsonly))
        {
          CHECK_SYMBOL (value);
          ldap_attrsonly = NILP (value) ? 0 : 1;
        }
      /* Base */
      else if (EQ (keyword, Qbase))
        {
          if (!NILP (value))
            {
              CHECK_STRING (value);
              ldap_base = alloca (XSTRING_LENGTH (value) + 1);
              strcpy (ldap_base, (char *)XSTRING_DATA (value));
            }
        }
      /* Scope */
      else if (EQ (keyword, Qscope))
        {
          CHECK_SYMBOL (value);

          if (EQ (value, Qbase))
            ldap_scope = LDAP_SCOPE_BASE;
          else if (EQ (value, Qonelevel))
            ldap_scope = LDAP_SCOPE_ONELEVEL;
          else if (EQ (value, Qsubtree))
            ldap_scope = LDAP_SCOPE_SUBTREE;
          else
            signal_simple_error ("Invalid scope", value);
        }
      /* Authentication method */
      else if (EQ (keyword, Qauth))
        {
          CHECK_SYMBOL (value);

          if (EQ (value, Qsimple))
            ldap_auth = LDAP_AUTH_SIMPLE;
#ifdef LDAP_AUTH_KRBV41
          else if (EQ (value, Qkrbv41))
            ldap_auth = LDAP_AUTH_KRBV41;
#endif
#ifdef LDAP_AUTH_KRBV42
          else if (EQ (value, Qkrbv42))
            ldap_auth = LDAP_AUTH_KRBV42;
#endif
          else
            signal_simple_error ("Invalid authentication method", value);
        }
      /* Bind DN */
      else if (EQ (keyword, Qbinddn))
        {
          if (!NILP (value))
            {
              CHECK_STRING (value);
              ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
              strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
            }
        }
      /* Password */
      else if (EQ (keyword, Qpasswd))
        {
          if (!NILP (value))
            {
              CHECK_STRING (value);
              ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
              strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
            }
        }
      /* Deref */
      else if (EQ (keyword, Qderef))
        {
          CHECK_SYMBOL (value);
          if (EQ (value, Qnever))
            ldap_deref = LDAP_DEREF_NEVER;
          else if (EQ (value, Qsearch))
            ldap_deref = LDAP_DEREF_SEARCHING;
          else if (EQ (value, Qfind))
            ldap_deref = LDAP_DEREF_FINDING;
          else if (EQ (value, Qalways))
            ldap_deref = LDAP_DEREF_ALWAYS;
          else
            signal_simple_error ("Invalid deref value", value);
        }
      /* Timelimit */
      else if (EQ (keyword, Qtimelimit))
        {
          if (!NILP (value))
            {
              CHECK_INT (value);
              ldap_timelimit = XINT (value);
            }
        }
      /* Sizelimit */
      else if (EQ (keyword, Qsizelimit))
        {
          if (!NILP (value))
            {
              CHECK_INT (value);
              ldap_sizelimit = XINT (value);
            }
        }
    }
コード例 #9
0
ファイル: lisp12.c プロジェクト: hoelzl/Clicc
void string_capitalize1(CL_FORM *base)
{
	COPY(ARG(0), ARG(3));
	Fstring(ARG(3));
	COPY(ARG(3), ARG(0));
	COPY(ARG(1), ARG(3));
	COPY(ARG(2), ARG(4));
	COPY(ARG(0), ARG(5));
	Flength(ARG(5));
	check_seq_start_end(ARG(3));
	COPY(ARG(3), ARG(2));
	COPY(ARG(0), ARG(3));
	COPY(ARG(3), ARG(4));
	COPY(ARG(4), ARG(5));
	LOAD_FIXNUM(ARG(6), 0, ARG(6));
	LOAD_NIL(ARG(7));
	subseq1(ARG(5));
	COPY(ARG(5), ARG(0));
	COPY(ARG(1), ARG(3));
	LOAD_NIL(ARG(4));
	LOAD_NIL(ARG(5));
	M1_1:;
	COPY(ARG(3), ARG(6));
	COPY(ARG(2), ARG(7));
	Fnumeql(ARG(6), 2);
	if(CL_TRUEP(ARG(6)))
	{
		goto RETURN1;
	}
	COPY(ARG(0), ARG(6));
	COPY(ARG(3), ARG(7));
	if(CL_SMSTRP(ARG(6)))
	{
	}
	else
	{
		COPY(SYMVAL(Slisp, 58), ARG(8));	/* WRONG_TYPE */
		COPY(ARG(6), ARG(9));
		LOAD_SYMBOL(SYMBOL(Slisp, 40), ARG(10));	/* SIMPLE-STRING */
		Ferror(ARG(8), 3);
	}
	COPY(ARG(6), ARG(8));
	COPY(ARG(7), ARG(9));
	COPY(ARG(9), ARG(10));
	LOAD_FIXNUM(ARG(12), AR_SIZE(GET_FORM(ARG(8))), ARG(11));
	F1minus(ARG(11));
	if(CL_FIXNUMP(ARG(10)))
	{
		LOAD_FIXNUM(ARG(12), 0, ARG(12));
		COPY(ARG(10), ARG(13));
		COPY(ARG(11), ARG(14));
		Fle(ARG(12), 3);
	}
	else
	{
		goto ELSE1;
	}
	if(CL_TRUEP(ARG(12)))
	{
	}
	else
	{
		ELSE1:;
		COPY(SYMVAL(Slisp, 153), ARG(10));	/* OUT_OF_RANGE */
		COPY(ARG(9), ARG(11));
		LOAD_FIXNUM(ARG(13), AR_SIZE(GET_FORM(ARG(8))), ARG(12));
		Ferror(ARG(10), 3);
	}
	COPY(ARG(8), ARG(5));
	COPY(ARG(9), ARG(6));
	rt_pvref(ARG(5));
	if(CL_CHARP(ARG(5)))
	{
		COPY(ARG(5), ARG(6));
	}
	else
	{
		COPY(SYMVAL(Slisp, 58), ARG(6));	/* WRONG_TYPE */
		COPY(ARG(5), ARG(7));
		LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(8));	/* CHARACTER */
		Ferror(ARG(6), 3);
	}
	rt_alpha_char_p(ARG(6));
	if(CL_TRUEP(ARG(6)))
	{
		goto THEN2;
	}
	else
	{
		COPY(ARG(5), ARG(7));
		LOAD_FIXNUM(ARG(8), 10, ARG(8));
		digit_char_p1(ARG(7));
	}
	if(CL_TRUEP(ARG(7)))
	{
		THEN2:;
		if(CL_TRUEP(ARG(4)))
		{
			if(CL_CHARP(ARG(5)))
			{
				COPY(ARG(5), ARG(6));
			}
			else
			{
				COPY(SYMVAL(Slisp, 58), ARG(6));	/* WRONG_TYPE */
				COPY(ARG(5), ARG(7));
				LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(8));	/* CHARACTER */
				Ferror(ARG(6), 3);
			}
			rt_char_downcase(ARG(6));
		}
		else
		{
			LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(4));	/* T */
			if(CL_CHARP(ARG(5)))
			{
				COPY(ARG(5), ARG(6));
			}
			else
			{
				COPY(SYMVAL(Slisp, 58), ARG(6));	/* WRONG_TYPE */
				COPY(ARG(5), ARG(7));
				LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(8));	/* CHARACTER */
				Ferror(ARG(6), 3);
			}
			rt_char_upcase(ARG(6));
		}
	}
	else
	{
		LOAD_NIL(ARG(4));
		COPY(ARG(5), ARG(6));
	}
	COPY(ARG(6), ARG(7));
	COPY(ARG(0), ARG(8));
	COPY(ARG(3), ARG(9));
	Fset_schar(ARG(7));
	F1plus(ARG(3));
	goto M1_1;
	RETURN1:;
}
コード例 #10
0
ファイル: lisp583.c プロジェクト: hoelzl/Clicc
void concatenate_to_list(CL_FORM *base, int nargs)
{
	CL_FORM *rest_0;
	CL_FORM *local;
	rest_0 = ARG(0);
	local = ARG(nargs);
	{
		LOAD_NIL(LOCAL(0));
		LOAD_NIL(LOCAL(1));
		ALLOC_CONS(LOCAL(2), LOCAL(0), LOCAL(1), LOCAL(0));
		{
			CL_FORM *rest_1;
			LOAD_NIL(LOCAL(1));
			rest_1 = rest_0;
			M1_1:;
			if(NOT(REST_NOT_EMPTY(rest_1)))
			{
				LOAD_NIL(LOCAL(1));
				goto RETURN1;
			}
			{
				CL_FORM *rest_2;
				rest_2 = rest_1;
				REST_CAR(rest_2, LOCAL(1));
			}
			if(CL_LISTP(LOCAL(1)))
			{
				LOAD_NIL(LOCAL(2));
				COPY(LOCAL(1), LOCAL(3));
				M2_1:;
				if(CL_ATOMP(LOCAL(3)))
				{
					LOAD_NIL(LOCAL(2));
					goto RETURN2;
				}
				{
					COPY(LOCAL(3), LOCAL(4));
					COPY(GET_CAR(LOCAL(4)), LOCAL(2));
				}
				COPY(LOCAL(2), LOCAL(4));
				COPY(LOCAL(0), LOCAL(5));
				add_q(LOCAL(4));
				{
					COPY(LOCAL(3), LOCAL(4));
					COPY(GET_CDR(LOCAL(4)), LOCAL(3));
				}
				goto M2_1;
				RETURN2:;
			}
			else
			{
				LOAD_FIXNUM(LOCAL(2), 0, LOCAL(2));
				M3_1:;
				COPY(LOCAL(2), LOCAL(3));
				COPY(LOCAL(1), LOCAL(4));
				Flength(LOCAL(4));
				Fge(LOCAL(3), 2);
				if(CL_TRUEP(LOCAL(3)))
				{
					goto RETURN3;
				}
				COPY(LOCAL(1), LOCAL(3));
				COPY(LOCAL(2), LOCAL(4));
				Felt(LOCAL(3));
				COPY(LOCAL(0), LOCAL(4));
				add_q(LOCAL(3));
				F1plus(LOCAL(2));
				goto M3_1;
				RETURN3:;
			}
			{
				CL_FORM *rest_3;
				rest_3 = rest_1;
				rest_1 = REST_CDR(rest_3);
			}
			goto M1_1;
		}
		RETURN1:;
		COPY(GET_CAR(LOCAL(0)), ARG(0));
	}
}
コード例 #11
0
ファイル: mule.c プロジェクト: boukeversteegh/chise
int re_short_flag;


DEFUN ("define-word-pattern", Fdefine_word_pattern, 1, 1, 0, /*
Don't call this function directly, instead use 'define-word' which
accept a pattern compiled by 'regexp-compile' with word-option t.
*/
       (pattern))
{
  int i, len;
  char *p;
  Lisp_Object temp;
  Lisp_String *s;

  CHECK_CONS (pattern);
  len = XINT (Flength (pattern));
  if (len > MAXWORDBUF)
    error ("Too complicated regular expression for word!");
  for (i = 0; i < len; i++)
    {
      temp = XCAR (pattern);
      CHECK_VECTOR (temp);
      CHECK_STRING (XVECTOR_DATA (temp)[0]);
      s = XSTRING (XVECTOR_DATA (temp)[0]);
      if (!wordbuf[i])
	wordbuf[i] = xnew (struct re_pattern_buffer);
      else
	if (wordbuf[i]->buffer) xfree (wordbuf[i]->buffer);
      wordbuf[i]->buffer = (char *) xmalloc (s->size + 1);
      wordbuf[i]->used = s->size;
      memcpy (wordbuf[i]->buffer, s->data, s->size + 1);
コード例 #12
0
ファイル: lisp369.c プロジェクト: hoelzl/Clicc
void unparse_unix_enough(CL_FORM *base)
{
	LOAD_NIL(ARG(2));
	LOAD_NIL(ARG(3));
	ALLOC_CONS(ARG(4), ARG(2), ARG(3), ARG(2));
	COPY(ARG(0), ARG(3));
	Ppathname_directory(ARG(3));
	COPY(ARG(1), ARG(4));
	Ppathname_directory(ARG(4));
	COPY(ARG(4), ARG(5));
	Flength(ARG(5));
	COPY(ARG(5), ARG(6));
	LOAD_FIXNUM(ARG(7), 1, ARG(7));
	Fgt(ARG(6), 2);
	if(CL_TRUEP(ARG(6)))
	{
		COPY(ARG(3), ARG(6));
		Flength(ARG(6));
		COPY(ARG(5), ARG(7));
		Fge(ARG(6), 2);
		if(CL_TRUEP(ARG(6)))
		{
			COPY(ARG(3), ARG(6));
			LOAD_FIXNUM(ARG(7), 0, ARG(7));
			COPY(ARG(5), ARG(8));
			subseq1(ARG(6));
			COPY(ARG(4), ARG(7));
			compare_component(ARG(6));
		}
		else
		{
			goto ELSE1;
		}
	}
	else
	{
		goto ELSE1;
	}
	if(CL_TRUEP(ARG(6)))
	{
		LOAD_SYMBOL(SYMBOL(Slisp, 270), ARG(6));	/* RELATIVE */
		COPY(ARG(5), ARG(7));
		COPY(ARG(3), ARG(8));
		Fnthcdr(ARG(7));
		ALLOC_CONS(ARG(8), ARG(6), ARG(7), ARG(6));
	}
	else
	{
		ELSE1:;
		if(CL_CONSP(ARG(3)))
		{
			COPY(GET_CAR(ARG(3)), ARG(6));
		}
		else
		{
			if(CL_TRUEP(ARG(3)))
			{
				LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(6));	/* ~a is not a list */
				COPY(ARG(3), ARG(7));
				Ferror(ARG(6), 2);
			}
			else
			{
				COPY(ARG(3), ARG(6));
			}
		}
		if(CL_SYMBOLP(ARG(6)) && GET_SYMBOL(ARG(6)) == SYMBOL(Slisp, 267))	/* ABSOLUTE */
		{
			COPY(ARG(3), ARG(6));
		}
		else
		{
			LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(6));	/* ~S cannot be represented relative to ~S */
			COPY(ARG(0), ARG(7));
			COPY(ARG(1), ARG(8));
			Ferror(ARG(6), 3);
		}
	}
	COPY(ARG(6), ARG(7));
	unparse_unix_directory_list(ARG(7));
	COPY(ARG(2), ARG(8));
	add_q(ARG(7));
	COPY(ARG(0), ARG(3));
	Ppathname_version(ARG(3));
	if(CL_TRUEP(ARG(3)))
	{
		if(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 269))	/* NEWEST */
		{
			LOAD_NIL(ARG(4));
		}
		else
		{
			LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(4));	/* T */
		}
	}
	else
	{
		LOAD_NIL(ARG(4));
	}
	COPY(ARG(0), ARG(5));
	Ppathname_type(ARG(5));
	if(CL_TRUEP(ARG(4)))
	{
		COPY(ARG(4), ARG(6));
	}
	else
	{
		if(CL_TRUEP(ARG(5)))
		{
			if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 266))	/* UNSPECIFIC */
			{
				LOAD_NIL(ARG(6));
			}
			else
			{
				LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(6));	/* T */
			}
		}
		else
		{
			LOAD_NIL(ARG(6));
		}
	}
	COPY(ARG(0), ARG(7));
	Ppathname_name(ARG(7));
	if(CL_TRUEP(ARG(6)))
	{
		COPY(ARG(6), ARG(8));
	}
	else
	{
		if(CL_TRUEP(ARG(7)))
		{
			COPY(ARG(7), ARG(8));
			COPY(ARG(1), ARG(9));
			Ppathname_name(ARG(9));
			compare_component(ARG(8));
			if(CL_TRUEP(ARG(8)))
			{
				LOAD_NIL(ARG(8));
			}
			else
			{
				LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(8));	/* T */
			}
		}
		else
		{
			LOAD_NIL(ARG(8));
		}
	}
	if(CL_TRUEP(ARG(8)))
	{
		if(CL_TRUEP(ARG(7)))
		{
		}
		else
		{
			LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(9));	/* ~S cannot be represented relative to ~S */
			COPY(ARG(0), ARG(10));
			COPY(ARG(1), ARG(11));
			Ferror(ARG(9), 3);
		}
		COPY(ARG(7), ARG(9));
		unparse_unix_piece(ARG(9));
		COPY(ARG(2), ARG(10));
		add_q(ARG(9));
	}
	if(CL_TRUEP(ARG(6)))
	{
		if(CL_TRUEP(ARG(5)))
		{
			LOAD_NIL(ARG(9));
		}
		else
		{
			LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(9));	/* T */
		}
		if(CL_TRUEP(ARG(9)))
		{
			goto THEN2;
		}
		else
		{
		}	/* UNSPECIFIC */
		if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 266))
		{
			THEN2:;
			LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(9));	/* ~S cannot be represented relative to ~S */
			COPY(ARG(0), ARG(10));
			COPY(ARG(1), ARG(11));
			Ferror(ARG(9), 3);
		}
		LOAD_SMSTR((CL_FORM *)&Kunparse_unix_enough[0], ARG(9));	/* . */
		COPY(ARG(2), ARG(10));
		add_q(ARG(9));
		COPY(ARG(5), ARG(9));
		unparse_unix_piece(ARG(9));
		COPY(ARG(2), ARG(10));
		add_q(ARG(9));
	}
	if(CL_TRUEP(ARG(4)))
	{
		if(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 271))	/* WILD */
		{
			LOAD_SMSTR((CL_FORM *)&Kunparse_unix_enough[2], ARG(9));	/* .* */
			COPY(ARG(2), ARG(10));
			add_q(ARG(9));
		}
		else
		{
			if(CL_FIXNUMP(ARG(3)))
			{
				LOAD_NIL(ARG(9));
				LOAD_SMSTR((CL_FORM *)&Kunparse_unix_enough[4], ARG(10));	/* .~D */
				COPY(ARG(3), ARG(11));
				Fformat(ARG(9), 3);
				mv_count = 1;
				COPY(ARG(2), ARG(10));
				add_q(ARG(9));
			}
			else
			{
				LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(9));	/* ~S cannot be represented relative to ~S */
				COPY(ARG(0), ARG(10));
				COPY(ARG(1), ARG(11));
				Ferror(ARG(9), 3);
			}
		}
	}
	LOAD_GLOBFUN(&CFconcatenate, ARG(3));
	LOAD_SYMBOL(SYMBOL(Slisp, 40), ARG(4));	/* SIMPLE-STRING */
	COPY(GET_CAR(ARG(2)), ARG(5));
	Fapply(ARG(3), 3);
	COPY(ARG(3), ARG(0));
}
コード例 #13
0
ファイル: gh.c プロジェクト: SawfishWM/librep
unsigned long gh_length(repv l)
{
    repv len = Flength (l);
    return len && rep_INTP (len) ? rep_INT (len) : 0;
}
コード例 #14
0
ファイル: gh.c プロジェクト: SawfishWM/librep
repv gh_string_length(repv str)
{
    return Flength (str);
}
コード例 #15
0
ファイル: lisp318.c プロジェクト: plops/clicc
void concatenate_to_list(CL_FORM *base, int nargs)
{
	Flist(STACK(base, 0), nargs - 0);
	LOAD_NIL(STACK(base, 1));
	LOAD_NIL(STACK(base, 2));
	{
		CL_FORM *lptr;
		lptr = form_alloc(STACK(base, 3), 2);
		COPY(STACK(base, 1), CAR(lptr));
		COPY(STACK(base, 2), CDR(lptr));
		LOAD_CONS(lptr, STACK(base, 1));
	}
	LOAD_NIL(STACK(base, 2));
	COPY(STACK(base, 0), STACK(base, 3));
	M148_1:;
	if(CL_ATOMP(STACK(base, 3)))
	{
		LOAD_NIL(STACK(base, 2));
		goto RETURN162;
	}
	COPY(STACK(base, 3), STACK(base, 4));
	Fcar(STACK(base, 4));
	COPY(STACK(base, 4), STACK(base, 2));
	if(CL_LISTP(STACK(base, 2)))
	{
		LOAD_NIL(STACK(base, 4));
		COPY(STACK(base, 2), STACK(base, 5));
		M149_1:;
		if(CL_ATOMP(STACK(base, 5)))
		{
			LOAD_NIL(STACK(base, 4));
			goto RETURN163;
		}
		COPY(STACK(base, 5), STACK(base, 6));
		Fcar(STACK(base, 6));
		COPY(STACK(base, 6), STACK(base, 4));
		COPY(STACK(base, 1), STACK(base, 7));
		add_q(STACK(base, 6));
		Fcdr(STACK(base, 5));
		goto M149_1;
		RETURN163:;
	}
	else
	{
		COPY(STACK(base, 2), STACK(base, 4));
		Flength(STACK(base, 4));
		LOAD_FIXNUM(0, STACK(base, 5));
		M150_1:;
		COPY(STACK(base, 5), STACK(base, 6));
		COPY(STACK(base, 4), STACK(base, 7));
		Fge(STACK(base, 6), 2);
		if(CL_TRUEP(STACK(base, 6)))
		{
			goto RETURN164;
		}
		COPY(STACK(base, 2), STACK(base, 6));
		COPY(STACK(base, 5), STACK(base, 7));
		Felt(STACK(base, 6));
		COPY(STACK(base, 1), STACK(base, 7));
		add_q(STACK(base, 6));
		F1plus(STACK(base, 5));
		goto M150_1;
		RETURN164:;
	}
	Fcdr(STACK(base, 3));
	goto M148_1;
	RETURN162:;
	COPY(STACK(base, 1), STACK(base, 0));
	Fcar(STACK(base, 0));
}
コード例 #16
0
ファイル: lisp475.c プロジェクト: hoelzl/Clicc
void check_array_internal(CL_FORM *base)
{
	LOAD_BOOL(CL_SYMBOLP(ARG(1)) && GET_SYMBOL(ARG(1)) == SYMBOL(Slisp, 49), ARG(3));	/* * */
	if(CL_TRUEP(ARG(3)))
	{
		goto THEN1;
	}
	else
	{
		COPY(ARG(0), ARG(4));
		array_element_type_internal(ARG(4));
		to_element_type(ARG(4));
		COPY(ARG(1), ARG(5));
		Fupgraded_array_element_type(ARG(5));
	}
	if(EQL(ARG(4), ARG(5)))
	{
		THEN1:;
		LOAD_BOOL(CL_SYMBOLP(ARG(2)) && GET_SYMBOL(ARG(2)) == SYMBOL(Slisp, 49), ARG(3));	/* * */
		if(CL_TRUEP(ARG(3)))
		{
			COPY(ARG(3), ARG(0));
		}
		else
		{
			if(CL_ATOMP(ARG(2)))
			{
				COPY(ARG(0), ARG(4));
				Farray_rank(ARG(4));
				COPY(ARG(2), ARG(5));
				Fnumeql(ARG(4), 2);
				COPY(ARG(4), ARG(0));
			}
			else
			{
				COPY(ARG(0), ARG(4));
				Farray_rank(ARG(4));
				COPY(ARG(2), ARG(5));
				Flength(ARG(5));
				Fnumeql(ARG(4), 2);
				if(CL_TRUEP(ARG(4)))
				{
					LOAD_NIL(ARG(4));
					LOAD_FIXNUM(ARG(5), 0, ARG(5));
					M1_1:;
					COPY(ARG(5), ARG(6));
					COPY(ARG(2), ARG(7));
					Flength(ARG(7));
					Fge(ARG(6), 2);
					if(CL_TRUEP(ARG(6)))
					{
						LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
						goto RETURN1;
					}
					COPY(ARG(2), ARG(6));
					COPY(ARG(6), ARG(7));
					if(CL_CONSP(ARG(7)))
					{
						COPY(GET_CAR(ARG(7)), ARG(6));
					}
					else
					{
						if(CL_TRUEP(ARG(7)))
						{
							LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(6));	/* ~a is not a list */
							Ferror(ARG(6), 2);
						}
						else
						{
							COPY(ARG(7), ARG(6));
						}
					}
					COPY(ARG(2), ARG(7));
					COPY(ARG(7), ARG(8));
					if(CL_CONSP(ARG(8)))
					{
						COPY(GET_CDR(ARG(8)), ARG(2));
					}
					else
					{
						if(CL_TRUEP(ARG(8)))
						{
							LOAD_SMSTR((CL_FORM *)&KClisp[262], ARG(9));	/* ~a is not a list */
							COPY(ARG(8), ARG(10));
							Ferror(ARG(9), 2);
						}
						else
						{
							COPY(ARG(8), ARG(2));
						}
					}
					COPY(ARG(6), ARG(4));
					LOAD_BOOL(CL_SYMBOLP(ARG(4)) && GET_SYMBOL(ARG(4)) == SYMBOL(Slisp, 49), ARG(6));	/* * */
					if(CL_TRUEP(ARG(6)))
					{
						goto THEN2;
					}
					else
					{
						COPY(ARG(0), ARG(7));
						COPY(ARG(5), ARG(8));
						Farray_dimension(ARG(7));
						COPY(ARG(4), ARG(8));
						Fnumeql(ARG(7), 2);
					}
					if(CL_TRUEP(ARG(7)))
					{
						THEN2:;
					}
					else
					{
						LOAD_NIL(ARG(0));
						goto RETURN1;
					}
					F1plus(ARG(5));
					goto M1_1;
					RETURN1:;
				}
				else
				{
					LOAD_NIL(ARG(0));
				}
			}
		}
	}
	else
	{
		LOAD_NIL(ARG(0));
	}
}
コード例 #17
0
ファイル: lisp355.c プロジェクト: plops/clicc
static void Z122_check_for(CL_FORM *base)
{
	COPY(ARG(1), ARG(2));
	LOAD_SYMBOL(SYMBOL(Slisp, 248), ARG(3));	/* PATTERN */
	rt_struct_typep(ARG(2));
	if(CL_TRUEP(ARG(2)))
	{
		LOAD_NIL(ARG(2));
		COPY(ARG(1), ARG(3));
		pattern_pieces(ARG(3));
		M1_1:;
		if(CL_ATOMP(ARG(3)))
		{
			LOAD_NIL(ARG(2));
			COPY(ARG(2), ARG(0));
			goto RETURN1;
		}
		COPY(ARG(3), ARG(4));
		COPY(GET_CAR(ARG(4)), ARG(2));
		if(CL_SMSTRP(ARG(2)))
		{
			COPY(ARG(0), ARG(4));
			COPY(ARG(2), ARG(5));
			Z122_check_for(ARG(4));
			bool_result = CL_TRUEP(ARG(4));
		}
		else
		{
			if(CL_CONSP(ARG(2)))
			{
				if(CL_CONSP(ARG(1)))
				{
					COPY(GET_CAR(ARG(1)), ARG(4));
				}
				else
				{
					if(CL_TRUEP(ARG(1)))
					{
						LOAD_SMSTR((CL_FORM *)&KClisp[239], ARG(4));	/* ~a is not a list */
						COPY(ARG(1), ARG(5));
						Ferror(ARG(4), 2);
					}
					else
					{
						COPY(ARG(1), ARG(4));
					}
				}
				if(CL_SYMBOLP(ARG(4)) && GET_SYMBOL(ARG(4)) == SYMBOL(Slisp, 255))	/* CHARACTER-SET */
				{
					COPY(ARG(0), ARG(5));
					if(CL_CONSP(ARG(1)))
					{
						COPY(GET_CDR(ARG(1)), ARG(6));
					}
					else
					{
						if(CL_TRUEP(ARG(1)))
						{
							LOAD_SMSTR((CL_FORM *)&KClisp[241], ARG(6));	/* ~a is not a list */
							COPY(ARG(1), ARG(7));
							Ferror(ARG(6), 2);
						}
						else
						{
							COPY(ARG(1), ARG(6));
						}
					}
					Z122_check_for(ARG(5));
				}
				else
				{
					goto ELSE1;
				}
			}
			else
			{
				goto ELSE1;
			}
			bool_result = CL_TRUEP(ARG(5));
		}
		if(bool_result)
		{
			LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
			goto RETURN1;
		}
		ELSE1:;
		COPY(ARG(3), ARG(4));
		COPY(GET_CDR(ARG(4)), ARG(3));
		goto M1_1;
		RETURN1:;
	}
	else
	{
		if(CL_LISTP(ARG(1)))
		{
			LOAD_NIL(ARG(2));
			COPY(ARG(1), ARG(3));
			M2_1:;
			if(CL_ATOMP(ARG(3)))
			{
				LOAD_NIL(ARG(2));
				COPY(ARG(2), ARG(0));
				goto RETURN2;
			}
			COPY(ARG(3), ARG(4));
			COPY(GET_CAR(ARG(4)), ARG(2));
			COPY(ARG(0), ARG(4));
			COPY(ARG(2), ARG(5));
			Z122_check_for(ARG(4));
			if(CL_TRUEP(ARG(4)))
			{
				LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
				goto RETURN2;
			}
			COPY(ARG(3), ARG(4));
			COPY(GET_CDR(ARG(4)), ARG(3));
			goto M2_1;
			RETURN2:;
		}
		else
		{
			if(CL_SMSTRP(ARG(1)))
			{
				COPY(ARG(1), ARG(2));
				Flength(ARG(2));
				LOAD_SMALLFIXNUM(0, ARG(3));
				M3_1:;
				COPY(ARG(3), ARG(4));
				COPY(ARG(2), ARG(5));
				Fge(ARG(4), 2);
				if(CL_TRUEP(ARG(4)))
				{
					LOAD_NIL(ARG(0));
					goto RETURN3;
				}
				COPY(ARG(0), ARG(4));
				COPY(ARG(1), ARG(5));
				COPY(ARG(3), ARG(6));
				Fschar(ARG(5));
				Ffuncall(ARG(4), 2);
				mv_count = 1;
				if(CL_TRUEP(ARG(4)))
				{
					LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
					goto RETURN3;
				}
				F1plus(ARG(3));
				goto M3_1;
				RETURN3:;
			}
			else
			{
				if(CL_SYMBOLP(ARG(1)) && GET_SYMBOL(ARG(1)) == SYMBOL(Slisp, 256))	/* UNSPECIFIC */
				{
					LOAD_NIL(ARG(0));
				}
				else
				{
					LOAD_SMSTR((CL_FORM *)&Kmaybe_diddle_case[0], ARG(0));	/* etypecase: the value ~a is not a legal value */
					Ferror(ARG(0), 2);
				}
			}
		}
	}
}
コード例 #18
0
ファイル: print_float.c プロジェクト: hoelzl/Clicc
void print_float(CL_FORM *base)
{
	COPY(ARG(0), ARG(2));
	Fminusp(ARG(2));
	if(CL_TRUEP(ARG(2)))
	{
		LOAD_CHAR(ARG(2), '-', ARG(2));
		COPY(ARG(1), ARG(3));
		write_char1(ARG(2));
		mv_count = 1;
		COPY(ARG(0), ARG(2));
		Fminus(ARG(2), 1);
		COPY(ARG(2), ARG(0));
	}
	COPY(ARG(0), ARG(2));
	Fzerop(ARG(2));
	if(CL_TRUEP(ARG(2)))
	{
		LOAD_SMSTR((CL_FORM *)&Kprint_float[0], ARG(2));	/* 0.0 */
		COPY(ARG(2), ARG(3));
		COPY(ARG(1), ARG(4));
		LOAD_FIXNUM(ARG(5), 0, ARG(5));
		COPY(ARG(2), ARG(6));
		Flength(ARG(6));
		write_string1(ARG(3));
		COPY(ARG(3), ARG(0));
	}
	else
	{
		LOAD_FIXNUM(ARG(2), 10, ARG(2));
		COPY(ARG(0), ARG(2));
		LOAD_FIXNUM(ARG(3), 10, ARG(3));
		rt_log(ARG(2));
		LOAD_FIXNUM(ARG(3), 1, ARG(3));
		LOAD_FIXNUM(ARG(3), 1, ARG(3));
		rt_floor(ARG(2));
		mv_count = 1;
		COPY(ARG(0), ARG(3));
		GEN_FLOAT(ARG(4), 10.0, ARG(4));
		LOAD_FIXNUM(ARG(5), -1, ARG(5));
		COPY(ARG(2), ARG(6));
		Fminus(ARG(5), 2);
		COPY(ARG(5), ARG(6));
		Fminusp(ARG(6));
		if(CL_TRUEP(ARG(6)))
		{
			LOAD_FIXNUM(ARG(6), 1, ARG(6));
			COPY(ARG(4), ARG(7));
			COPY(ARG(5), ARG(8));
			Fminus(ARG(8), 1);
			Fexpt(ARG(7));
			Fdiv(ARG(6), 2);
			COPY(ARG(6), ARG(4));
		}
		else
		{
			rt_expt(ARG(4));
		}
		Fmult(ARG(3), 2);
		LOAD_NIL(ARG(4));
		COPY(SYMVAL(Slisp, 2), ARG(5));	/* SHORT-FLOAT-EPSILON */
		LOAD_NIL(ARG(6));
		COPY(ARG(3), ARG(7));
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		COPY(ARG(5), ARG(9));
		Fminus(ARG(8), 2);
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			GEN_FLOAT(ARG(7), 0.1, ARG(3));
			F1plus(ARG(2));
		}
		COPY(ARG(2), ARG(7));
		LOAD_FIXNUM(ARG(8), 7, ARG(8));
		Fgt(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			goto THEN1;
		}
		else
		{
			COPY(ARG(2), ARG(8));
			LOAD_FIXNUM(ARG(9), -3, ARG(9));
			Flt(ARG(8), 2);
		}
		if(CL_TRUEP(ARG(8)))
		{
			THEN1:;
			LOAD_FIXNUM(ARG(7), 0, ARG(4));
		}
		else
		{
			COPY(ARG(2), ARG(4));
			LOAD_FIXNUM(ARG(7), 0, ARG(2));
		}
		COPY(ARG(4), ARG(7));
		Fminusp(ARG(7));
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_CHAR(ARG(7), '0', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			LOAD_CHAR(ARG(7), '.', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			LOAD_FIXNUM(ARG(7), 0, ARG(7));
			M1_1:;
			COPY(ARG(7), ARG(8));
			COPY(ARG(4), ARG(9));
			Fminus(ARG(9), 1);
			F1minus(ARG(9));
			Fge(ARG(8), 2);
			if(CL_TRUEP(ARG(8)))
			{
				goto RETURN1;
			}
			LOAD_CHAR(ARG(8), '0', ARG(8));
			COPY(ARG(1), ARG(9));
			write_char1(ARG(8));
			mv_count = 1;
			F1plus(ARG(7));
			goto M1_1;
			RETURN1:;
			LOAD_FIXNUM(ARG(7), -1, ARG(4));
		}
		M2_1:;
		COPY(ARG(5), ARG(7));
		LOAD_FIXNUM(ARG(8), 10, ARG(8));
		Fmult(ARG(7), 2);
		COPY(ARG(7), ARG(5));
		LOAD_FIXNUM(ARG(7), 10, ARG(7));
		COPY(ARG(3), ARG(8));
		Fmult(ARG(7), 2);
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		rt_truncate(ARG(7));
		COPY(&mv_buf[0], ARG(8));
		{
			int nargs;
			nargs = 2;
			mv_count = 1;
			{
				switch(nargs)
				{
					case 0:
					LOAD_NIL(ARG(7));
					case 1:
					LOAD_NIL(ARG(8));
					nargs = 2;
				}
				COPY(ARG(7), ARG(6));
				COPY(ARG(8), ARG(3));
			}
		}
		COPY(ARG(3), ARG(7));
		LOAD_FIXNUM(ARG(8), 1, ARG(8));
		COPY(ARG(5), ARG(9));
		Fminus(ARG(8), 2);
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			goto THEN2;
		}
		else
		{
			COPY(ARG(3), ARG(8));
			COPY(ARG(5), ARG(9));
			Fle(ARG(8), 2);
		}
		if(CL_TRUEP(ARG(8)))
		{
			THEN2:;
			goto RETURN2;
		}
		COPY(ARG(6), ARG(7));
		LOAD_FIXNUM(ARG(8), 10, ARG(8));
		digit_char1(ARG(7));
		COPY(ARG(1), ARG(8));
		write_char1(ARG(7));
		mv_count = 1;
		COPY(ARG(4), ARG(7));
		Fzerop(ARG(7));
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_CHAR(ARG(7), '.', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
		}
		F1minus(ARG(4));
		goto M2_1;
		RETURN2:;
		COPY(ARG(3), ARG(7));
		GEN_FLOAT(ARG(8), 0.5, ARG(8));
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			F1plus(ARG(6));
		}
		COPY(ARG(6), ARG(7));
		LOAD_FIXNUM(ARG(8), 10, ARG(8));
		digit_char1(ARG(7));
		COPY(ARG(1), ARG(8));
		write_char1(ARG(7));
		mv_count = 1;
		COPY(ARG(4), ARG(7));
		LOAD_FIXNUM(ARG(8), 0, ARG(8));
		Fge(ARG(7), 2);
		if(CL_TRUEP(ARG(7)))
		{
			LOAD_FIXNUM(ARG(7), 0, ARG(7));
			M3_1:;
			COPY(ARG(7), ARG(8));
			COPY(ARG(4), ARG(9));
			Fge(ARG(8), 2);
			if(CL_TRUEP(ARG(8)))
			{
				goto RETURN3;
			}
			LOAD_CHAR(ARG(8), '0', ARG(8));
			COPY(ARG(1), ARG(9));
			write_char1(ARG(8));
			mv_count = 1;
			F1plus(ARG(7));
			goto M3_1;
			RETURN3:;
			LOAD_CHAR(ARG(7), '.', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			LOAD_CHAR(ARG(7), '0', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
		}
		COPY(ARG(2), ARG(7));
		Fzerop(ARG(7));
		if(CL_TRUEP(ARG(7)))
		{
		}
		else
		{
			LOAD_CHAR(ARG(7), 'E', ARG(7));
			COPY(ARG(1), ARG(8));
			write_char1(ARG(7));
			mv_count = 1;
			COPY(ARG(2), ARG(7));
			COPY(ARG(1), ARG(8));
			print_integer(ARG(7));
			mv_count = 1;
		}
		LOAD_NIL(ARG(0));
	}
}
コード例 #19
0
ファイル: fringe.c プロジェクト: infiniteone/emacs
static int
get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, int partial_p)
{
  Lisp_Object cmap, bm1 = Qnil, bm2 = Qnil, bm;
  int ln1 = 0, ln2 = 0;
  int ix1 = right_p;
  int ix2 = ix1 + (partial_p ? 2 : 0);

  /* Lookup in buffer-local fringe-indicator-alist before global alist.

     Elements are:
	BITMAP		-- use for all
	(L R)		-- use for left right (whether partial or not)
	(L R PL PR)	-- use for left right partial-left partial-right
	If any value in local binding is not present or t, use global value.

     If partial, lookup partial bitmap in default value if not found here.
     If not partial, or no partial spec is present, use non-partial bitmap.  */

  if ((cmap = BVAR (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap))
    {
      bm1 = Fassq (bitmap, cmap);
      if (CONSP (bm1))
	{
	  if ((bm1 = XCDR (bm1)), NILP (bm1))
	    return NO_FRINGE_BITMAP;
	  if (CONSP (bm1))
	    {
	      ln1 = XINT (Flength (bm1));
	      if (partial_p)
		{
		  if (ln1 > ix2)
		    {
		      bm = Fnth (make_number (ix2), bm1);
		      if (!EQ (bm, Qt))
			goto found;
		    }
		}
	      else
		{
		  if (ln1 > ix1)
		    {
		      bm = Fnth (make_number (ix1), bm1);
		      if (!EQ (bm, Qt))
			goto found;
		    }
		}
	    }
	  else if ((bm = bm1, !EQ (bm, Qt)))
	    goto found;
	}
    }

  if (!EQ (cmap, BVAR (&buffer_defaults, fringe_indicator_alist))
      && !NILP (BVAR (&buffer_defaults, fringe_indicator_alist)))
    {
      bm2 = Fassq (bitmap, BVAR (&buffer_defaults, fringe_indicator_alist));
      if (CONSP (bm2))
	{
	  if ((bm2 = XCDR (bm2)), !NILP (bm2))
	    {
	      if (CONSP (bm2))
		{
		  ln2 = XINT (Flength (bm2));
		  if (partial_p)
		    {
		      if (ln2 > ix2)
			{
			  bm = Fnth (make_number (ix2), bm2);
			  if (!EQ (bm, Qt))
			    goto found;
			}
		    }
		}
	    }
	}
    }

  if (ln1 > ix1)
    {
      bm = Fnth (make_number (ix1), bm1);
      if (!EQ (bm, Qt))
	goto found;
    }

  if (ln2 > ix1)
    {
      bm = Fnth (make_number (ix1), bm2);
      if (!EQ (bm, Qt))
	goto found;
      return NO_FRINGE_BITMAP;
    }
  else if ((bm = bm2, NILP (bm)))
    return NO_FRINGE_BITMAP;

 found:
  return lookup_fringe_bitmap (bm);
}
コード例 #20
0
ファイル: stringNE1.c プロジェクト: hoelzl/Clicc
void stringNE1(CL_FORM *base)
{
	COPY(ARG(0), ARG(6));
	Fstring(ARG(6));
	COPY(ARG(6), ARG(0));
	COPY(ARG(1), ARG(6));
	Fstring(ARG(6));
	COPY(ARG(6), ARG(1));
	COPY(ARG(2), ARG(6));
	COPY(ARG(3), ARG(7));
	COPY(ARG(0), ARG(8));
	Flength(ARG(8));
	check_seq_start_end(ARG(6));
	COPY(ARG(6), ARG(3));
	COPY(ARG(4), ARG(6));
	COPY(ARG(5), ARG(7));
	COPY(ARG(1), ARG(8));
	Flength(ARG(8));
	check_seq_start_end(ARG(6));
	COPY(ARG(6), ARG(5));
	COPY(ARG(2), ARG(6));
	COPY(ARG(4), ARG(7));
	LOAD_NIL(ARG(8));
	LOAD_NIL(ARG(9));
	M1_1:;
	COPY(ARG(6), ARG(10));
	COPY(ARG(3), ARG(11));
	Fnumeql(ARG(10), 2);
	if(CL_TRUEP(ARG(10)))
	{
		COPY(ARG(7), ARG(10));
		COPY(ARG(5), ARG(11));
		Fnumeql(ARG(10), 2);
		if(CL_TRUEP(ARG(10)))
		{
			LOAD_NIL(ARG(0));
		}
		else
		{
			COPY(ARG(6), ARG(0));
		}
		goto RETURN2;
	}
	COPY(ARG(7), ARG(10));
	COPY(ARG(5), ARG(11));
	Fnumeql(ARG(10), 2);
	if(CL_TRUEP(ARG(10)))
	{
		COPY(ARG(6), ARG(0));
		goto RETURN2;
	}
	COPY(ARG(0), ARG(10));
	COPY(ARG(6), ARG(11));
	COPY(ARG(10), ARG(12));
	Fstringp(ARG(12));
	if(CL_TRUEP(ARG(12)))
	{
	}
	else
	{
		COPY(SYMVAL(Slisp, 58), ARG(12));	/* WRONG_TYPE */
		COPY(ARG(10), ARG(13));
		LOAD_SYMBOL(SYMBOL(Slisp, 44), ARG(14));	/* STRING */
		Ferror(ARG(12), 3);
	}
	COPY(ARG(10), ARG(12));
	COPY(ARG(11), ARG(13));
	Frow_major_aref(ARG(12));
	COPY(ARG(12), ARG(8));
	COPY(ARG(1), ARG(10));
	COPY(ARG(7), ARG(11));
	COPY(ARG(10), ARG(12));
	Fstringp(ARG(12));
	if(CL_TRUEP(ARG(12)))
	{
	}
	else
	{
		COPY(SYMVAL(Slisp, 58), ARG(12));	/* WRONG_TYPE */
		COPY(ARG(10), ARG(13));
		LOAD_SYMBOL(SYMBOL(Slisp, 44), ARG(14));	/* STRING */
		Ferror(ARG(12), 3);
	}
	COPY(ARG(10), ARG(9));
	COPY(ARG(11), ARG(10));
	Frow_major_aref(ARG(9));
	COPY(ARG(8), ARG(10));
	COPY(ARG(9), ARG(11));
	rt_charE(ARG(10));
	if(CL_TRUEP(ARG(10)))
	{
	}
	else
	{
		COPY(ARG(6), ARG(0));
		goto RETURN1;
	}
	COPY(ARG(6), ARG(10));
	F1plus(ARG(10));
	F1plus(ARG(7));
	COPY(ARG(10), ARG(6));
	goto M1_1;
	RETURN2:;
	RETURN1:;
}
コード例 #21
0
ファイル: lisp16.c プロジェクト: plops/clicc
void string_not_equal1(CL_FORM *base)
{
	COPY(ARG(0), ARG(6));
	Fstring(ARG(6));
	COPY(ARG(6), ARG(0));
	COPY(ARG(1), ARG(6));
	Fstring(ARG(6));
	COPY(ARG(6), ARG(1));
	if(CL_TRUEP(ARG(3)))
	{
	}
	else
	{
		COPY(ARG(0), ARG(6));
		Flength(ARG(6));
		COPY(ARG(6), ARG(3));
	}
	if(CL_TRUEP(ARG(5)))
	{
	}
	else
	{
		COPY(ARG(1), ARG(5));
		Flength(ARG(5));
	}
	COPY(ARG(2), ARG(6));
	COPY(ARG(4), ARG(7));
	LOAD_NIL(ARG(8));
	LOAD_NIL(ARG(9));
	M1_1:;
	COPY(ARG(6), ARG(10));
	COPY(ARG(3), ARG(11));
	Fnumeql(ARG(10), 2);
	if(CL_TRUEP(ARG(10)))
	{
		COPY(ARG(7), ARG(10));
		COPY(ARG(5), ARG(11));
		Fnumeql(ARG(10), 2);
		if(CL_TRUEP(ARG(10)))
		{
			LOAD_NIL(ARG(0));
		}
		else
		{
			COPY(ARG(6), ARG(0));
		}
		goto RETURN2;
	}
	COPY(ARG(7), ARG(10));
	COPY(ARG(5), ARG(11));
	Fnumeql(ARG(10), 2);
	if(CL_TRUEP(ARG(10)))
	{
		COPY(ARG(6), ARG(0));
		goto RETURN2;
	}
	COPY(ARG(0), ARG(10));
	COPY(ARG(6), ARG(11));
	COPY(ARG(10), ARG(12));
	COPY(ARG(11), ARG(13));
	Frow_major_aref(ARG(12));
	COPY(ARG(12), ARG(8));
	COPY(ARG(1), ARG(10));
	COPY(ARG(7), ARG(11));
	COPY(ARG(10), ARG(9));
	COPY(ARG(11), ARG(10));
	Frow_major_aref(ARG(9));
	if(CL_CHARP(ARG(8)))
	{
		COPY(ARG(8), ARG(10));
	}
	else
	{
		COPY(SYMVAL(Slisp, 58), ARG(10));	/* WRONG_TYPE */
		COPY(ARG(8), ARG(11));
		LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(12));	/* CHARACTER */
		Ferror(ARG(10), 3);
	}
	rt_char_upcase(ARG(10));
	rt_char_code(ARG(10));
	if(CL_CHARP(ARG(9)))
	{
		COPY(ARG(9), ARG(11));
	}
	else
	{
		COPY(SYMVAL(Slisp, 58), ARG(11));	/* WRONG_TYPE */
		COPY(ARG(9), ARG(12));
		LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(13));	/* CHARACTER */
		Ferror(ARG(11), 3);
	}
	rt_char_upcase(ARG(11));
	rt_char_code(ARG(11));
	Fnumeql(ARG(10), 2);
	if(CL_TRUEP(ARG(10)))
	{
	}
	else
	{
		COPY(ARG(6), ARG(0));
		goto RETURN1;
	}
	COPY(ARG(6), ARG(10));
	F1plus(ARG(10));
	COPY(ARG(7), ARG(11));
	F1plus(ARG(11));
	COPY(ARG(11), ARG(7));
	COPY(ARG(10), ARG(6));
	goto M1_1;
	RETURN2:;
	RETURN1:;
}
コード例 #22
0
ファイル: lisp317.c プロジェクト: plops/clicc
void concatenate_to_non_list(CL_FORM *base, int nargs)
{
	Flist(STACK(base, 1), nargs - 1);
	LOAD_NIL(STACK(base, 2));
	LOAD_FIXNUM(0, STACK(base, 3));
	LOAD_FIXNUM(0, STACK(base, 4));
	LOAD_NIL(STACK(base, 5));
	COPY(STACK(base, 1), STACK(base, 6));
	M144_1:;
	if(CL_ATOMP(STACK(base, 6)))
	{
		LOAD_NIL(STACK(base, 5));
		goto RETURN158;
	}
	COPY(STACK(base, 6), STACK(base, 7));
	Fcar(STACK(base, 7));
	COPY(STACK(base, 7), STACK(base, 5));
	COPY(STACK(base, 3), STACK(base, 7));
	COPY(STACK(base, 5), STACK(base, 8));
	Flength(STACK(base, 8));
	Fplus(STACK(base, 7), 2);
	COPY(STACK(base, 7), STACK(base, 3));
	Fcdr(STACK(base, 6));
	goto M144_1;
	RETURN158:;
	COPY(STACK(base, 0), STACK(base, 5));
	COPY(STACK(base, 3), STACK(base, 6));
	Fmake_sequence(STACK(base, 5), 2);
	COPY(STACK(base, 5), STACK(base, 2));
	LOAD_NIL(STACK(base, 5));
	COPY(STACK(base, 1), STACK(base, 6));
	M145_1:;
	if(CL_ATOMP(STACK(base, 6)))
	{
		LOAD_NIL(STACK(base, 5));
		goto RETURN159;
	}
	COPY(STACK(base, 6), STACK(base, 7));
	Fcar(STACK(base, 7));
	COPY(STACK(base, 7), STACK(base, 5));
	if(CL_LISTP(STACK(base, 5)))
	{
		LOAD_NIL(STACK(base, 7));
		COPY(STACK(base, 5), STACK(base, 8));
		M146_1:;
		if(CL_ATOMP(STACK(base, 8)))
		{
			LOAD_NIL(STACK(base, 7));
			goto RETURN160;
		}
		COPY(STACK(base, 8), STACK(base, 9));
		Fcar(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 7));
		COPY(STACK(base, 2), STACK(base, 10));
		COPY(STACK(base, 4), STACK(base, 11));
		Fset_elt(STACK(base, 9));
		COPY(STACK(base, 4), STACK(base, 9));
		F1plus(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 4));
		Fcdr(STACK(base, 8));
		goto M146_1;
		RETURN160:;
	}
	else
	{
		COPY(STACK(base, 5), STACK(base, 7));
		Flength(STACK(base, 7));
		LOAD_FIXNUM(0, STACK(base, 8));
		M147_1:;
		COPY(STACK(base, 8), STACK(base, 9));
		COPY(STACK(base, 7), STACK(base, 10));
		Fge(STACK(base, 9), 2);
		if(CL_TRUEP(STACK(base, 9)))
		{
			goto RETURN161;
		}
		COPY(STACK(base, 5), STACK(base, 9));
		COPY(STACK(base, 8), STACK(base, 10));
		Felt(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 10));
		COPY(STACK(base, 2), STACK(base, 11));
		COPY(STACK(base, 4), STACK(base, 12));
		Fset_elt(STACK(base, 10));
		COPY(STACK(base, 4), STACK(base, 9));
		F1plus(STACK(base, 9));
		COPY(STACK(base, 9), STACK(base, 4));
		F1plus(STACK(base, 8));
		goto M147_1;
		RETURN161:;
	}
	Fcdr(STACK(base, 6));
	goto M145_1;
	RETURN159:;
	COPY(STACK(base, 2), STACK(base, 0));
}