franz/lam2.c
/* concat **************************************************
-
-  use: (concat arg1 arg2 ... )
-
-  concatenates the print names of all of its arguments.
- the arguments may be atoms, integers or real numbers.
-
- *********************************************************/
concat
use: (concat arg1 arg2 ...

concatenates the print names of all of its arguments.
the arguments may be atoms, integers or real numbers.
concat use : ( concat arg1 arg2 ... concatenates the print names of all of its arguments . the arguments may be atoms integers or real numbers .
lispval
Iconcat(unintern)
{
	register struct argent *temnp;
	register char *cp = strbuf;
	register lispval cur;
	int n;
	char *atomtoolong();
	lispval Lhau();
	*cp = NULL_CHAR ;
	for(temnp = lbot + AD ; temnp < np ; temnp++)
	{
	    cur = temnp->val;
	    switch(TYPE(cur))
	    {
	    case ATOM:
		 n = strlen(cur->a.pname);
		 while(n + cp >= endstrb) cp = atomtoolong(cp);
		 strcpy(cp, cur->a.pname);
		 cp += n;
		 break;
	    case STRNG:
		 n = strlen( (char *) cur);
		 while(n + cp >= endstrb) cp = atomtoolong(cp);
		 strcpy(cp, (char *) cur);
		 cp += n;
		 break;
  	    case INT:
		 if(15 + cp >= endstrb) cp = atomtoolong(cp);
		 sprintf(cp,"%d",cur->i);
		 while(*cp) cp++;
		 break;
	    case DOUB:
		 if(15 + cp >= endstrb) cp = atomtoolong(cp);
		 sprintf(cp,"%f",cur->f);
		 while(*cp) cp++;
		 break;
	    case SDOT: {
		struct _iobuf _myiob;
		register lispval handy = cur;
		for(n = 12; handy->s.CDR!=(lispval) 0; handy = handy->s.CDR)
			n += 12;
		while(n + cp >= endstrb) cp = atomtoolong(cp);
		_myiob._flag = _IOWRT+_IOSTRG;
		_myiob._ptr = cp;
		_myiob._cnt = endstrb - cp - 1;
		pbignum(cur,&_myiob);
		cp = _myiob._ptr;
		*cp = 0;
		break; }
	    default:
		 cur = error("Non atom or number to concat",TRUE);
		 continue;    
	   }
	}
	if(unintern)
		return( (lispval) newatom(FALSE)); 
	else
		return( (lispval) getatom(FALSE)) ;
}
lispval Iconcat ( unintern ) { register struct argent * temnp ; register char * cp = strbuf ; register lispval cur ; int n ; char * atomtoolong ( ) ; lispval Lhau ( ) ; * cp = NULL_CHAR ; for ( temnp = lbot + AD ; temnp < np ; temnp ++ ) { cur = temnp -> val ; switch ( TYPE ( cur ) ) { case ATOM : n = strlen ( cur -> a . pname ) ; while ( n + cp >= endstrb ) cp = atomtoolong ( cp ) ; strcpy ( cp , cur -> a . pname ) ; cp += n ; break ; case STRNG : n = strlen ( ( char * ) cur ) ; while ( n + cp >= endstrb ) cp = atomtoolong ( cp ) ; strcpy ( cp , ( char * ) cur ) ; cp += n ; break ; case INT : if ( 15 + cp >= endstrb ) cp = atomtoolong ( cp ) ; sprintf ( cp , " " , cur -> i ) ; while ( * cp ) cp ++ ; break ; case DOUB : if ( 15 + cp >= endstrb ) cp = atomtoolong ( cp ) ; sprintf ( cp , " " , cur -> f ) ; while ( * cp ) cp ++ ; break ; case SDOT : { struct _iobuf _myiob ; register lispval handy = cur ; for ( n = 12 ; handy -> s . CDR != ( lispval ) 0 ; handy = handy -> s . CDR ) n += 12 ; while ( n + cp >= endstrb ) cp = atomtoolong ( cp ) ; _myiob . _flag = _IOWRT + _IOSTRG ; _myiob . _ptr = cp ; _myiob . _cnt = endstrb - cp - 1 ; pbignum ( cur , & _myiob ) ; cp = _myiob . _ptr ; * cp = 0 ; break ; } default : cur = error ( " " , TRUE ) ; continue ; } } if ( unintern ) return ( ( lispval ) newatom ( FALSE ) ) ; else return ( ( lispval ) getatom ( FALSE ) ) ; }
concat
use: (concat arg1 arg2 ... )
concat use : ( concat arg1 arg2 ... )
/* loop for each argument */ /* if returns value, try it */ /* uninterned atoms may
							have printname gc'd*/