*** empty log message ***
This commit is contained in:
		
							parent
							
								
									0c0c3b7892
								
							
						
					
					
						commit
						ae1e81adb1
					
				
					 36 changed files with 1740 additions and 0 deletions
				
			
		
							
								
								
									
										29
									
								
								h/bc_io.h
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										29
									
								
								h/bc_io.h
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,29 @@ | ||||||
|  | #include <stdio.h> | ||||||
|  | 
 | ||||||
|  | /* $Header$ */ | ||||||
|  | 
 | ||||||
|  | /* BASIC file io definitions */ | ||||||
|  | 
 | ||||||
|  | extern FILE *_chanrd; | ||||||
|  | extern FILE *_chanwr; | ||||||
|  | extern int   _chann; | ||||||
|  | /* BASIC file descriptor table */ | ||||||
|  | /* Channel assignment:
 | ||||||
|  |    -1		terminal IO | ||||||
|  |     0		data file | ||||||
|  |     1-15	user files | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | /* FILE MODES:*/ | ||||||
|  | #define 	IMODE	1 | ||||||
|  | #define		OMODE	2 | ||||||
|  | #define		RMODE	3 | ||||||
|  | 
 | ||||||
|  | typedef struct { | ||||||
|  | 	char	*fname; | ||||||
|  | 	FILE	*fd; | ||||||
|  | 	int	pos; | ||||||
|  | 	int	mode;	 | ||||||
|  | 	int	reclength; | ||||||
|  | 	}Filedesc; | ||||||
|  | extern Filedesc	 _fdtable[16]; | ||||||
							
								
								
									
										15
									
								
								h/bc_string.h
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										15
									
								
								h/bc_string.h
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,15 @@ | ||||||
|  | # | ||||||
|  | 
 | ||||||
|  | /* $Header$ */ | ||||||
|  | 
 | ||||||
|  | /* Strings are allocated in a fixed string descriptor table 
 | ||||||
|  | ** This mechanism is used to avoid string copying as much as possible | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | typedef struct{ | ||||||
|  | 	char	*strval; | ||||||
|  | 	int	strcount; | ||||||
|  | 	int	strlength; | ||||||
|  | 	} String; | ||||||
|  | 
 | ||||||
|  | #define MAXSTRING 1024 | ||||||
							
								
								
									
										33
									
								
								lang/basic/lib/LIST
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										33
									
								
								lang/basic/lib/LIST
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,33 @@ | ||||||
|  | abs.c | ||||||
|  | asc.c | ||||||
|  | asrt.c | ||||||
|  | atn.c | ||||||
|  | conversion.c | ||||||
|  | error.c | ||||||
|  | file.c | ||||||
|  | hlt.c | ||||||
|  | print.c | ||||||
|  | read.c | ||||||
|  | return.c | ||||||
|  | salloc.c | ||||||
|  | string.c | ||||||
|  | trap.c | ||||||
|  | write.c | ||||||
|  | chr.c | ||||||
|  | power.c | ||||||
|  | io.c | ||||||
|  | exp.c | ||||||
|  | log.c | ||||||
|  | sin.c | ||||||
|  | sqt.c | ||||||
|  | sgn.c | ||||||
|  | random.c | ||||||
|  | mki.c | ||||||
|  | peek.c | ||||||
|  | trace.c | ||||||
|  | swap.c | ||||||
|  | fef.e | ||||||
|  | fif.e | ||||||
|  | oct.c | ||||||
|  | setline.e | ||||||
|  | stop.c | ||||||
							
								
								
									
										10
									
								
								lang/basic/lib/abs.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										10
									
								
								lang/basic/lib/abs.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,10 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | long _abl(i) long i; | ||||||
|  | { | ||||||
|  | 	return( i>=0?i:-i); | ||||||
|  | } | ||||||
|  | double _abr(f) double f; | ||||||
|  | {	 | ||||||
|  | 	return( f>=0.0?f: -f); | ||||||
|  | } | ||||||
							
								
								
									
										11
									
								
								lang/basic/lib/asc.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										11
									
								
								lang/basic/lib/asc.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,11 @@ | ||||||
|  | #include "string.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | int _asc(str) | ||||||
|  | String *str; | ||||||
|  | { | ||||||
|  | 	if(str==0 || str->strval==0) | ||||||
|  | 		error(3); | ||||||
|  | 	return( *str->strval); | ||||||
|  | } | ||||||
							
								
								
									
										9
									
								
								lang/basic/lib/asrt.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										9
									
								
								lang/basic/lib/asrt.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,9 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | asrt(b) | ||||||
|  | { | ||||||
|  | 	if(!b){ | ||||||
|  | 		printf("ASSERTION ERROR\n"); | ||||||
|  | 		abort(); | ||||||
|  | 	} | ||||||
|  | } | ||||||
							
								
								
									
										93
									
								
								lang/basic/lib/atn.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										93
									
								
								lang/basic/lib/atn.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,93 @@ | ||||||
|  | /*
 | ||||||
|  |  * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. | ||||||
|  |  * | ||||||
|  |  *          This product is part of the Amsterdam Compiler Kit. | ||||||
|  |  * | ||||||
|  |  * Permission to use, sell, duplicate or disclose this software must be | ||||||
|  |  * obtained in writing. Requests for such permissions may be sent to | ||||||
|  |  * | ||||||
|  |  *      Dr. Andrew S. Tanenbaum | ||||||
|  |  *      Wiskundig Seminarium | ||||||
|  |  *      Vrije Universiteit | ||||||
|  |  *      Postbox 7161 | ||||||
|  |  *      1007 MC Amsterdam | ||||||
|  |  *      The Netherlands | ||||||
|  |  * | ||||||
|  |  */ | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* Author: J.W. Stevenson */ | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	floating-point arctangent | ||||||
|  | 
 | ||||||
|  | 	atan returns the value of the arctangent of its | ||||||
|  | 	argument in the range [-pi/2,pi/2]. | ||||||
|  | 
 | ||||||
|  | 	there are no error returns. | ||||||
|  | 
 | ||||||
|  | 	coefficients are #5077 from Hart & Cheney. (19.56D) | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | static double sq2p1	= 2.414213562373095048802e0; | ||||||
|  | static double sq2m1	=  .414213562373095048802e0; | ||||||
|  | static double pio2	= 1.570796326794896619231e0; | ||||||
|  | static double pio4	=  .785398163397448309615e0; | ||||||
|  | static double p4	=  .161536412982230228262e2; | ||||||
|  | static double p3	=  .26842548195503973794141e3; | ||||||
|  | static double p2	=  .11530293515404850115428136e4; | ||||||
|  | static double p1	=  .178040631643319697105464587e4; | ||||||
|  | static double p0	=  .89678597403663861959987488e3; | ||||||
|  | static double q4	=  .5895697050844462222791e2; | ||||||
|  | static double q3	=  .536265374031215315104235e3; | ||||||
|  | static double q2	=  .16667838148816337184521798e4; | ||||||
|  | static double q1	=  .207933497444540981287275926e4; | ||||||
|  | static double q0	=  .89678597403663861962481162e3; | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	xatan evaluates a series valid in the | ||||||
|  | 	range [-0.414...,+0.414...]. | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | static double | ||||||
|  | xatan(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	double argsq; | ||||||
|  | 	double value; | ||||||
|  | 
 | ||||||
|  | 	argsq = arg*arg; | ||||||
|  | 	value = ((((p4*argsq + p3)*argsq + p2)*argsq + p1)*argsq + p0); | ||||||
|  | 	value = value/(((((argsq + q4)*argsq + q3)*argsq + q2)*argsq + q1)*argsq + q0); | ||||||
|  | 	return(value*arg); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | static double | ||||||
|  | satan(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	if(arg < sq2m1) | ||||||
|  | 		return(xatan(arg)); | ||||||
|  | 	else if(arg > sq2p1) | ||||||
|  | 		return(pio2 - xatan(1/arg)); | ||||||
|  | 	else | ||||||
|  | 		return(pio4 + xatan((arg-1)/(arg+1))); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	atan makes its argument positive and | ||||||
|  | 	calls the inner routine satan. | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | double | ||||||
|  | _atn(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	if(arg>0) | ||||||
|  | 		return(satan(arg)); | ||||||
|  | 	else | ||||||
|  | 		return(-satan(-arg)); | ||||||
|  | } | ||||||
							
								
								
									
										17
									
								
								lang/basic/lib/chr.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										17
									
								
								lang/basic/lib/chr.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,17 @@ | ||||||
|  | #include "string.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | String *_chr(i) | ||||||
|  | int i; | ||||||
|  | { | ||||||
|  | 	String	*s; | ||||||
|  | 	char	buf[2]; | ||||||
|  | 
 | ||||||
|  | 	if( i<0 || i>127) | ||||||
|  | 		error(3); | ||||||
|  | 	buf[0]=i; | ||||||
|  | 	buf[1]=0; | ||||||
|  | 	s= (String *) _newstr(buf); | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
							
								
								
									
										40
									
								
								lang/basic/lib/conversion.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										40
									
								
								lang/basic/lib/conversion.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,40 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | int _cint(f) double f; | ||||||
|  | { | ||||||
|  | 	int r; | ||||||
|  | 	if( f<-32768 || f>32767) error(4); | ||||||
|  | 	if(f<0) | ||||||
|  | 		r= f-0.5; | ||||||
|  | 	else	r= f+0.5; | ||||||
|  | 	return(r); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | double _trunc(f) | ||||||
|  | double f; | ||||||
|  | { | ||||||
|  | 	long d; | ||||||
|  | 	d=f; | ||||||
|  | 	f=d; | ||||||
|  | 	return( f ); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | double _fcint(f) double f; | ||||||
|  | { | ||||||
|  | 	long r; | ||||||
|  | 	if(f<0){ | ||||||
|  | 		r= -f; | ||||||
|  | 		r= -r -1; | ||||||
|  | 	}else	r= f; | ||||||
|  | 	f=r; | ||||||
|  | 	return(f); | ||||||
|  | } | ||||||
|  | int _fix(f) | ||||||
|  | double f; | ||||||
|  | { | ||||||
|  | 	int r; | ||||||
|  | 
 | ||||||
|  | 	if( f<-32768.0 || f>32767.0) error(4); | ||||||
|  | 	r= _sgn(f) * _fcint((f>0.0? f : -f)); | ||||||
|  | 	return(r); | ||||||
|  | } | ||||||
							
								
								
									
										63
									
								
								lang/basic/lib/error.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										63
									
								
								lang/basic/lib/error.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,63 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* error takes an error value in the range of 0-255 */ | ||||||
|  | /* and generates a trap */ | ||||||
|  | 
 | ||||||
|  | char *errortable[255]={ | ||||||
|  | /* 0  */	"", | ||||||
|  | /* 1  */	"RETURN without GOSUB", | ||||||
|  | /* 2  */	"Out of data", | ||||||
|  | /* 3  */	"Illegal function call", | ||||||
|  | /* 4  */	"Overflow", | ||||||
|  | /* 5  */	"Out of memory", | ||||||
|  | /*  6 */	"Undefined line ", | ||||||
|  | /*  7 */	"Subscript out of range", | ||||||
|  | /*  8 */	"Redimensioned array", | ||||||
|  | /*  9 */	"Division by zero", | ||||||
|  | /* 10 */	"Illegal indirect", | ||||||
|  | /* 11 */	"Type mismatch", | ||||||
|  | /* 12 */	"Out of string space", | ||||||
|  | /* 13 */	"String too long", | ||||||
|  | /* 14 */	"String formula too complex", | ||||||
|  | /* 15 */	"Can't continue", | ||||||
|  | /* 16 */	"Undefined user function", | ||||||
|  | /* 17 */	"No resume", | ||||||
|  | /* 18 */	"Resume without error", | ||||||
|  | /* 19 */	"Unprintable error", | ||||||
|  | /* 20 */	"Missing operand", | ||||||
|  | /* 21 */	"Line buffer overflow", | ||||||
|  | /* 22 */	"FOR without NEXT", | ||||||
|  | /* 23 */	"WHILE without WEND", | ||||||
|  | /* 24 */	"WEND without WHILE", | ||||||
|  | /* 25 */	"Field overflow", | ||||||
|  | /* 26 */	"Internal error", | ||||||
|  | /* 27 */	"Bad file number", | ||||||
|  | /* 28 */	"File not found", | ||||||
|  | /* 29 */	"Bad file mode", | ||||||
|  | /* 30 */	"File already open", | ||||||
|  | /* 31 */	"Disk IO error", | ||||||
|  | /* 32 */	"File already exists", | ||||||
|  | /* 33 */	"Disk full", | ||||||
|  | /* 34 */	"Input past end", | ||||||
|  | /* 35 */	"Bad record number", | ||||||
|  | /* 36 */	"Bad file name", | ||||||
|  | /* 37 */	"Direct statement in file", | ||||||
|  | /* 38 */	"Too many files", | ||||||
|  | /* 39 */	"File not open", | ||||||
|  | /* 40 */	"Syntax error in data", | ||||||
|  | 0 | ||||||
|  | }; | ||||||
|  | 
 | ||||||
|  | error(index) | ||||||
|  | int	index; | ||||||
|  | { | ||||||
|  | 	extern int _errsym; | ||||||
|  | 	extern int _erlsym; | ||||||
|  | 
 | ||||||
|  | 	_setline(); | ||||||
|  | 	if( index<0 || index >40 ) | ||||||
|  | 		printf("LINE %d:ERROR %d: Unprintable error\n",_erlsym,index); | ||||||
|  | 	else 	printf("LINE %d:ERROR %d: %s\n",_erlsym,index,errortable[index]); | ||||||
|  | 	_errsym= index; | ||||||
|  | 	_trap(); | ||||||
|  | } | ||||||
							
								
								
									
										122
									
								
								lang/basic/lib/exp.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										122
									
								
								lang/basic/lib/exp.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,122 @@ | ||||||
|  | /*
 | ||||||
|  |  * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. | ||||||
|  |  * | ||||||
|  |  *          This product is part of the Amsterdam Compiler Kit. | ||||||
|  |  * | ||||||
|  |  * Permission to use, sell, duplicate or disclose this software must be | ||||||
|  |  * obtained in writing. Requests for such permissions may be sent to | ||||||
|  |  * | ||||||
|  |  *      Dr. Andrew S. Tanenbaum | ||||||
|  |  *      Wiskundig Seminarium | ||||||
|  |  *      Vrije Universiteit | ||||||
|  |  *      Postbox 7161 | ||||||
|  |  *      1007 MC Amsterdam | ||||||
|  |  *      The Netherlands | ||||||
|  |  * | ||||||
|  |  */ | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* Author: J.W. Stevenson */ | ||||||
|  | 
 | ||||||
|  | extern double	_fif(); | ||||||
|  | extern double	_fef(); | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	exp returns the exponential function of its | ||||||
|  | 	floating-point argument. | ||||||
|  | 
 | ||||||
|  | 	The coefficients are #1069 from Hart and Cheney. (22.35D) | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | #define	HUGE	1.701411733192644270e38 | ||||||
|  | 
 | ||||||
|  | static double p0	=  .2080384346694663001443843411e7; | ||||||
|  | static double p1	=  .3028697169744036299076048876e5; | ||||||
|  | static double p2	=  .6061485330061080841615584556e2; | ||||||
|  | static double q0	=  .6002720360238832528230907598e7; | ||||||
|  | static double q1	=  .3277251518082914423057964422e6; | ||||||
|  | static double q2	=  .1749287689093076403844945335e4; | ||||||
|  | static double log2e	= 1.4426950408889634073599247; | ||||||
|  | static double sqrt2	= 1.4142135623730950488016887; | ||||||
|  | static double maxf	= 10000.0; | ||||||
|  | 
 | ||||||
|  | static double | ||||||
|  | floor(d) | ||||||
|  | double d; | ||||||
|  | { | ||||||
|  | 	if (d<0) { | ||||||
|  | 		d = -d; | ||||||
|  | 		if (_fif(d, 1.0, &d) != 0) | ||||||
|  | 			d += 1; | ||||||
|  | 		d = -d; | ||||||
|  | 	} else | ||||||
|  | 		_fif(d, 1.0, &d); | ||||||
|  | 	return(d); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | static double | ||||||
|  | ldexp(fr,exp) | ||||||
|  | double fr; | ||||||
|  | int exp; | ||||||
|  | { | ||||||
|  | 	int	neg,i; | ||||||
|  | 
 | ||||||
|  | 	neg = 1; | ||||||
|  | 	if (fr < 0) { | ||||||
|  | 		fr = -fr; | ||||||
|  | 		neg = -1; | ||||||
|  | 	} | ||||||
|  | 	fr = _fef(fr, &i); | ||||||
|  | 	/*
 | ||||||
|  | 	while (fr < 0.5) { | ||||||
|  | 		fr *= 2; | ||||||
|  | 		exp--; | ||||||
|  | 	} | ||||||
|  | 	*/ | ||||||
|  | 	exp += i; | ||||||
|  | 	if (exp > 127) { | ||||||
|  | 		error(3); | ||||||
|  | 		return(neg * HUGE); | ||||||
|  | 	} | ||||||
|  | 	if (exp < -127) | ||||||
|  | 		return(0); | ||||||
|  | 	while (exp > 14) { | ||||||
|  | 		fr *= (1<<14); | ||||||
|  | 		exp -= 14; | ||||||
|  | 	} | ||||||
|  | 	while (exp < -14) { | ||||||
|  | 		fr /= (1<<14); | ||||||
|  | 		exp += 14; | ||||||
|  | 	} | ||||||
|  | 	if (exp > 0) | ||||||
|  | 		fr *= (1<<exp); | ||||||
|  | 	if (exp < 0) | ||||||
|  | 		fr /= (1<<(-exp)); | ||||||
|  | 	return(neg * fr); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | double | ||||||
|  | _exp(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	double fract; | ||||||
|  | 	double temp1, temp2, xsq; | ||||||
|  | 	int ent; | ||||||
|  | 
 | ||||||
|  | 	if(arg == 0) | ||||||
|  | 		return(1); | ||||||
|  | 	if(arg < -maxf) | ||||||
|  | 		return(0); | ||||||
|  | 	if(arg > maxf) { | ||||||
|  | 		error(3); | ||||||
|  | 		return(HUGE); | ||||||
|  | 	} | ||||||
|  | 	arg *= log2e; | ||||||
|  | 	ent = floor(arg); | ||||||
|  | 	fract = (arg-ent) - 0.5; | ||||||
|  | 	xsq = fract*fract; | ||||||
|  | 	temp1 = ((p2*xsq+p1)*xsq+p0)*fract; | ||||||
|  | 	temp2 = ((xsq+q2)*xsq+q1)*xsq + q0; | ||||||
|  | 	return(ldexp(sqrt2*(temp2+temp1)/(temp2-temp1), ent)); | ||||||
|  | } | ||||||
							
								
								
									
										23
									
								
								lang/basic/lib/fef.e
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										23
									
								
								lang/basic/lib/fef.e
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,23 @@ | ||||||
|  | # | ||||||
|  |  mes 2,EM_WSIZE,EM_PSIZE | ||||||
|  | 
 | ||||||
|  | ; $Header$ | ||||||
|  | 
 | ||||||
|  | #define FARG    0 | ||||||
|  | #define ERES    EM_DSIZE | ||||||
|  | 
 | ||||||
|  | ; _fef is called with two parameters: | ||||||
|  | ;       - address of exponent result (ERES) | ||||||
|  | ;       - floating point number to be split (FARG) | ||||||
|  | ; and returns an EM_DSIZE-byte floating point number | ||||||
|  | 
 | ||||||
|  |  exp $_fef | ||||||
|  |  pro $_fef,0 | ||||||
|  |  lal FARG | ||||||
|  |  loi EM_DSIZE | ||||||
|  |  fef EM_DSIZE | ||||||
|  |  lal ERES | ||||||
|  |  loi EM_PSIZE | ||||||
|  |  sti EM_WSIZE | ||||||
|  |  ret EM_DSIZE | ||||||
|  |  end ? | ||||||
							
								
								
									
										25
									
								
								lang/basic/lib/fif.e
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										25
									
								
								lang/basic/lib/fif.e
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,25 @@ | ||||||
|  | # | ||||||
|  |  mes 2,EM_WSIZE,EM_PSIZE | ||||||
|  | 
 | ||||||
|  | ; $Header$ | ||||||
|  | 
 | ||||||
|  | #define ARG1    0 | ||||||
|  | #define ARG2    EM_DSIZE | ||||||
|  | #define IRES    2*EM_DSIZE | ||||||
|  | 
 | ||||||
|  | ; _fif is called with three parameters: | ||||||
|  | ;       - address of integer part result (IRES) | ||||||
|  | ;       - float two (ARG2) | ||||||
|  | ;       - float one (ARG1) | ||||||
|  | ; and returns an EM_DSIZE-byte floating point number | ||||||
|  | 
 | ||||||
|  |  exp $_fif | ||||||
|  |  pro $_fif,0 | ||||||
|  |  lal 0 | ||||||
|  |  loi 2*EM_DSIZE | ||||||
|  |  fif EM_DSIZE | ||||||
|  |  lal IRES | ||||||
|  |  loi EM_PSIZE | ||||||
|  |  sti EM_DSIZE | ||||||
|  |  ret EM_DSIZE | ||||||
|  |  end ? | ||||||
							
								
								
									
										135
									
								
								lang/basic/lib/file.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										135
									
								
								lang/basic/lib/file.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,135 @@ | ||||||
|  | #include "string.h" | ||||||
|  | #include <stdio.h> | ||||||
|  | #include "io.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | Filedesc	_fdtable[16]; | ||||||
|  | /* BASIC file descriptor table */ | ||||||
|  | /* Channel assignment:
 | ||||||
|  |    -1		terminal IO | ||||||
|  |     0		data file | ||||||
|  |     1-15	user files | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | int	_chann		= -1; | ||||||
|  | FILE	*_chanrd	= stdin; | ||||||
|  | FILE	*_chanwr	= stdout; | ||||||
|  | 
 | ||||||
|  | _setchannel(index) | ||||||
|  | int index; | ||||||
|  | { | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("setchannel %d\n",index); | ||||||
|  | #endif | ||||||
|  | 	fflush(_chanwr); | ||||||
|  | 	if( index == -1) | ||||||
|  | 	{ | ||||||
|  | 		_chann= -1; | ||||||
|  | 		_chanrd= stdin; | ||||||
|  | 		_chanwr= stdout; | ||||||
|  | 		return; | ||||||
|  | 	} | ||||||
|  | 	if( index<0 || index>15) | ||||||
|  | 		error(27); | ||||||
|  | 	_chann=index; | ||||||
|  | 	_chanrd= _chanwr= _fdtable[index].fd; | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _asschn() | ||||||
|  | { | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("_asschn %d\n",_chann); | ||||||
|  | #endif | ||||||
|  | 	if( _chann == -1) return; | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf(" file %d\n", _fdtable[_chann].fd); | ||||||
|  | #endif | ||||||
|  | 	if( _chann<0 || _chann>15) | ||||||
|  | 		error(27); | ||||||
|  | 	if( _fdtable[_chann].fd== 0) | ||||||
|  | 		error(39); | ||||||
|  | 	if( feof( _fdtable[_chann].fd)) | ||||||
|  | 		error(2); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _clochn(nr) | ||||||
|  | int nr; | ||||||
|  | { | ||||||
|  | 	if( nr<1 || nr >15 || _fdtable[nr].fd==0) error(3); | ||||||
|  | 	fclose(_fdtable[nr].fd); | ||||||
|  | 	_fdtable[nr].fd=0; _fdtable[nr].fname=0; | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _opnchn(reclen,fname,mode) | ||||||
|  | String *mode,*fname; | ||||||
|  | int	reclen; | ||||||
|  | { | ||||||
|  | 	/* channel has been set */ | ||||||
|  | 	FILE *f; | ||||||
|  | 	int m; | ||||||
|  | 
 | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("open %d %s %s \n",reclen,mode->strval,fname->strval); | ||||||
|  | #endif | ||||||
|  | 	/* check for opened/closed file */ | ||||||
|  | 	if(_fdtable[_chann].fd) | ||||||
|  | 		error(30); | ||||||
|  | 	switch(*mode->strval) | ||||||
|  | 	{ | ||||||
|  | 		case 'O': | ||||||
|  | 		case 'o': | ||||||
|  | 			if( (f=fopen(fname->strval,"w")) == NULL) | ||||||
|  | 				error(28); | ||||||
|  | 			m= OMODE; | ||||||
|  | 			break; | ||||||
|  | 		case 'I': | ||||||
|  | 		case 'i': | ||||||
|  | 			if( (f=fopen(fname->strval,"r")) == NULL) | ||||||
|  | 				error(28); | ||||||
|  | 			m= IMODE; | ||||||
|  | 			break; | ||||||
|  | 		case 'r': | ||||||
|  | 		case 'R': | ||||||
|  | 			if( (f=fopen(fname->strval,"a")) == NULL) | ||||||
|  | 				error(28); | ||||||
|  | 			m= RMODE; | ||||||
|  | 			break; | ||||||
|  | 		default: | ||||||
|  | 			printf("file mode %s\n",mode->strval); | ||||||
|  | 			error(29); | ||||||
|  | 	} | ||||||
|  | 	_chanrd= _fdtable[_chann].fd= f; | ||||||
|  | 	_fdtable[_chann].fname= fname->strval; | ||||||
|  | 	_fdtable[_chann].reclength= reclen; | ||||||
|  | 	_fdtable[_chann].mode= m; | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("file descr %d\n",f); | ||||||
|  | #endif | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _ioeof(channel) | ||||||
|  | int channel; | ||||||
|  | { | ||||||
|  | 	FILE *fd; | ||||||
|  | 	char c; | ||||||
|  | 	if( channel<0 || channel >15) error(3); | ||||||
|  | 	fd= _fdtable[channel].fd; | ||||||
|  | 	if( fd==0) | ||||||
|  | 		error(3); | ||||||
|  | 	c=fgetc(fd); | ||||||
|  | 	if( feof(_fdtable[channel].fd) ) return(-1); | ||||||
|  | 	ungetc(c,fd); | ||||||
|  | 	return(0); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _close() | ||||||
|  | { | ||||||
|  | 	/* close all open files */ | ||||||
|  | 	int i; | ||||||
|  | 	for(i=1;i<16;i++) | ||||||
|  | 	if( _fdtable[i].fd) | ||||||
|  | 		_clochn(i); | ||||||
|  | } | ||||||
							
								
								
									
										7
									
								
								lang/basic/lib/hlt.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								lang/basic/lib/hlt.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | _hlt(nr) | ||||||
|  | int nr; | ||||||
|  | { | ||||||
|  | 	exit(nr); | ||||||
|  | } | ||||||
							
								
								
									
										95
									
								
								lang/basic/lib/io.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										95
									
								
								lang/basic/lib/io.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,95 @@ | ||||||
|  | #include "io.h" | ||||||
|  | #include <sgtty.h> | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | struct sgttyb _ttydef; | ||||||
|  | 
 | ||||||
|  | /* BASIC has some nasty io characteristics */ | ||||||
|  | 
 | ||||||
|  | #define MAXWIDTH 255 | ||||||
|  | 
 | ||||||
|  | int	_width = 75, _pos=0, _zonewidth=15; | ||||||
|  | 
 | ||||||
|  | _out(str) | ||||||
|  | char *str; | ||||||
|  | { | ||||||
|  | 	int pos; | ||||||
|  | 
 | ||||||
|  | 	if( _chann== -1) pos= _pos; | ||||||
|  | 	else pos= _fdtable[_chann].pos; | ||||||
|  | 	while( *str)  | ||||||
|  | 	{ | ||||||
|  | 		if( pos>= _width){ _outnl(); pos=0;} | ||||||
|  | 		fputc(*str++, _chanwr); | ||||||
|  | 		pos++; | ||||||
|  | 	} | ||||||
|  | 	if( _chann== -1) _pos=pos; | ||||||
|  | 	else _fdtable[_chann].pos= pos; | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _outnl() | ||||||
|  | { | ||||||
|  | 	fputc('\n',_chanwr); | ||||||
|  | 	if( _chann == -1) | ||||||
|  | 		_pos=0; | ||||||
|  | 	else | ||||||
|  | 		_fdtable[_chann].pos=0; | ||||||
|  | } | ||||||
|  | _zone() | ||||||
|  | { | ||||||
|  | 	/* go to next zone */ | ||||||
|  | 	int pos; | ||||||
|  | 	if( _chann == -1) | ||||||
|  | 		pos= _pos; | ||||||
|  | 	else pos= _fdtable[_chann].pos; | ||||||
|  | 	do{ | ||||||
|  | 		fputc(' ',_chanwr); | ||||||
|  | 		pos++; | ||||||
|  | 		if( pos==_width) | ||||||
|  | 		{ | ||||||
|  | 			_outnl(); | ||||||
|  | 			pos=0; | ||||||
|  | 			break; | ||||||
|  | 		} | ||||||
|  | 	} while( pos % _zonewidth != 0); | ||||||
|  | 	if( _chann== -1) _pos=pos; | ||||||
|  | 	else _fdtable[_chann].pos= pos; | ||||||
|  | } | ||||||
|  | _in(buf) | ||||||
|  | char *buf; | ||||||
|  | { | ||||||
|  | 	char *c; | ||||||
|  | 	int pos; | ||||||
|  | 	if( _chann == -1) | ||||||
|  | 	{ | ||||||
|  | 		pos= _pos; | ||||||
|  | 		gtty(0,_ttydef); | ||||||
|  | 		_ttydef.sg_flags &= ~ECHO; | ||||||
|  | 		stty(0,_ttydef); | ||||||
|  | 	}else pos= _fdtable[_chann].pos; | ||||||
|  | 	c= buf; | ||||||
|  | 	while( (*c = fgetc(_chanrd)) != EOF && *c != '\n'){ | ||||||
|  | 		if( _chann == -1) putchar(*c); | ||||||
|  | 		c++; pos++; | ||||||
|  | 	} | ||||||
|  | 	*c= 0; | ||||||
|  | 	if( _chann== -1)  | ||||||
|  | 	{ | ||||||
|  | 		_pos=pos; | ||||||
|  | 		_ttydef.sg_flags |= ECHO; | ||||||
|  | 		stty(0,_ttydef); | ||||||
|  | 	} else _fdtable[_chann].pos= pos; | ||||||
|  | } | ||||||
|  | _tab(x) | ||||||
|  | int x; | ||||||
|  | { | ||||||
|  | 	if( x> _width) error(3); | ||||||
|  | 	if( x< _pos) _outnl(); | ||||||
|  | 	_spc(x-_pos); | ||||||
|  | } | ||||||
|  | _spc(x) | ||||||
|  | int x; | ||||||
|  | { | ||||||
|  | 	while(x-->0) _out(" "); | ||||||
|  | } | ||||||
							
								
								
									
										75
									
								
								lang/basic/lib/log.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										75
									
								
								lang/basic/lib/log.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,75 @@ | ||||||
|  | /*
 | ||||||
|  |  * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. | ||||||
|  |  * | ||||||
|  |  *          This product is part of the Amsterdam Compiler Kit. | ||||||
|  |  * | ||||||
|  |  * Permission to use, sell, duplicate or disclose this software must be | ||||||
|  |  * obtained in writing. Requests for such permissions may be sent to | ||||||
|  |  * | ||||||
|  |  *      Dr. Andrew S. Tanenbaum | ||||||
|  |  *      Wiskundig Seminarium | ||||||
|  |  *      Vrije Universiteit | ||||||
|  |  *      Postbox 7161 | ||||||
|  |  *      1007 MC Amsterdam | ||||||
|  |  *      The Netherlands | ||||||
|  |  * | ||||||
|  |  */ | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* Author: J.W. Stevenson */ | ||||||
|  | 
 | ||||||
|  | extern double	_fef(); | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	log returns the natural logarithm of its floating | ||||||
|  | 	point argument. | ||||||
|  | 
 | ||||||
|  | 	The coefficients are #2705 from Hart & Cheney. (19.38D) | ||||||
|  | 
 | ||||||
|  | 	It calls _fef. | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | #define	HUGE	1.701411733192644270e38 | ||||||
|  | 
 | ||||||
|  | static double log2	= 0.693147180559945309e0; | ||||||
|  | static double sqrto2	= 0.707106781186547524e0; | ||||||
|  | static double p0	= -.240139179559210510e2; | ||||||
|  | static double p1	= 0.309572928215376501e2; | ||||||
|  | static double p2	= -.963769093368686593e1; | ||||||
|  | static double p3	= 0.421087371217979714e0; | ||||||
|  | static double q0	= -.120069589779605255e2; | ||||||
|  | static double q1	= 0.194809660700889731e2; | ||||||
|  | static double q2	= -.891110902798312337e1; | ||||||
|  | 
 | ||||||
|  | double | ||||||
|  | _log(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	double x,z, zsq, temp; | ||||||
|  | 	int exp; | ||||||
|  | 
 | ||||||
|  | 	if(arg <= 0) { | ||||||
|  | 		error(3); | ||||||
|  | 		return(-HUGE); | ||||||
|  | 	} | ||||||
|  | 	x = _fef(arg,&exp); | ||||||
|  | 	/*
 | ||||||
|  | 	while(x < 0.5) { | ||||||
|  | 		x =* 2; | ||||||
|  | 		exp--; | ||||||
|  | 	} | ||||||
|  | 	*/ | ||||||
|  | 	if(x<sqrto2) { | ||||||
|  | 		x *= 2; | ||||||
|  | 		exp--; | ||||||
|  | 	} | ||||||
|  | 
 | ||||||
|  | 	z = (x-1)/(x+1); | ||||||
|  | 	zsq = z*z; | ||||||
|  | 
 | ||||||
|  | 	temp = ((p3*zsq + p2)*zsq + p1)*zsq + p0; | ||||||
|  | 	temp = temp/(((zsq + q2)*zsq + q1)*zsq + q0); | ||||||
|  | 	temp = temp*z + exp*log2; | ||||||
|  | 	return(temp); | ||||||
|  | } | ||||||
							
								
								
									
										37
									
								
								lang/basic/lib/mki.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										37
									
								
								lang/basic/lib/mki.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,37 @@ | ||||||
|  | #include "string.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | String *_mki(i) | ||||||
|  | int i; | ||||||
|  | { | ||||||
|  | 	char *buffer ="  "; | ||||||
|  | 	String *s; | ||||||
|  | 
 | ||||||
|  | 	s= (String *) _newstr(buffer); | ||||||
|  | 	strncpy(s->strval,&i,2); | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
|  | String *_mkd(d) | ||||||
|  | double d; | ||||||
|  | { | ||||||
|  | 	char *buffer ="        "; | ||||||
|  | 	String *s; | ||||||
|  | 
 | ||||||
|  | 	s= (String *) _newstr(buffer); | ||||||
|  | 	strncpy(s->strval,&d,8); | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
|  | _cvi(s) | ||||||
|  | String *s; | ||||||
|  | { | ||||||
|  | 	int i; | ||||||
|  | 	strncpy(&i,s->strval,2); | ||||||
|  | 	return(i); | ||||||
|  | } | ||||||
|  | double _cvd(s) | ||||||
|  | String *s; | ||||||
|  | { | ||||||
|  | 	double d; | ||||||
|  | 	strncpy(&d,s->strval,8); | ||||||
|  | } | ||||||
							
								
								
									
										19
									
								
								lang/basic/lib/oct.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										19
									
								
								lang/basic/lib/oct.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,19 @@ | ||||||
|  | #include "string.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | String *_oct(i) | ||||||
|  | int i; | ||||||
|  | { | ||||||
|  | 	char buffer[30]; | ||||||
|  | 	sprintf(buffer,"%o",i); | ||||||
|  | 	return( (String *)_newstr(buffer)); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | String *_hex(i) | ||||||
|  | int i; | ||||||
|  | { | ||||||
|  | 	char buffer[30]; | ||||||
|  | 	sprintf(buffer,"%x",i); | ||||||
|  | 	return( (String *)_newstr(buffer)); | ||||||
|  | } | ||||||
							
								
								
									
										26
									
								
								lang/basic/lib/peek.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										26
									
								
								lang/basic/lib/peek.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,26 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | int peek(addr) | ||||||
|  | int addr; | ||||||
|  | { | ||||||
|  | 	/* this can not work properly for machines in which the 
 | ||||||
|  | 	   POINTERSIZE differs from the integer size | ||||||
|  | 	*/ | ||||||
|  | 	char	*p; | ||||||
|  | 	int i; | ||||||
|  | 
 | ||||||
|  | 	p= (char *)addr; | ||||||
|  | 	i= *p; | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("peek %d = %d\n",addr,i); | ||||||
|  | #endif | ||||||
|  | 	return(i); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _poke(i,j) | ||||||
|  | int i,j; | ||||||
|  | { | ||||||
|  | 	char *p; | ||||||
|  | 	p= (char *) i; | ||||||
|  | 	*p=j; | ||||||
|  | } | ||||||
							
								
								
									
										32
									
								
								lang/basic/lib/power.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										32
									
								
								lang/basic/lib/power.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,32 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	computes a^b. | ||||||
|  | 	uses log and exp | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | double _log(), _exp(); | ||||||
|  | 
 | ||||||
|  | double | ||||||
|  | _power(base,pownr) | ||||||
|  | double pownr, base; | ||||||
|  | { | ||||||
|  | 	double temp; | ||||||
|  | 	long l; | ||||||
|  | 
 | ||||||
|  | 	if(pownr <= 0.0) { | ||||||
|  | 		if(pownr == 0.0) { | ||||||
|  | 			if(base <= 0.0) | ||||||
|  | 				error(3); | ||||||
|  | 			return(0.0); | ||||||
|  | 		} | ||||||
|  | 		l = base; | ||||||
|  | 		if(l != base) | ||||||
|  | 			error(3); | ||||||
|  | 		temp = _exp(base * _log(-pownr)); | ||||||
|  | 		if(l & 1) | ||||||
|  | 			temp = -temp; | ||||||
|  | 		return(temp); | ||||||
|  | 	} | ||||||
|  | 	return(_exp(base * _log(pownr))); | ||||||
|  | } | ||||||
							
								
								
									
										73
									
								
								lang/basic/lib/print.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										73
									
								
								lang/basic/lib/print.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,73 @@ | ||||||
|  | #include "string.h" | ||||||
|  | #include "io.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* Here all routine to generate terminal oriented output is located */ | ||||||
|  | 
 | ||||||
|  | _qstmark() | ||||||
|  | { | ||||||
|  | 	/* prompt for terminal input */ | ||||||
|  | 	putchar('?'); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _nl() | ||||||
|  | { | ||||||
|  | 	_asschn(); | ||||||
|  | 	_outnl(); | ||||||
|  | } | ||||||
|  | _prinum(i) | ||||||
|  | int i; | ||||||
|  | { | ||||||
|  | 	char	buffer[40]; | ||||||
|  | 
 | ||||||
|  | 	_asschn(); | ||||||
|  | 	if(i>=0)  | ||||||
|  | 		sprintf(buffer," %d ",i); | ||||||
|  | 	else	sprintf(buffer,"-%d ",-i); | ||||||
|  | 	_out(buffer); | ||||||
|  | } | ||||||
|  | _str(f,buffer) | ||||||
|  | double f; | ||||||
|  | char *buffer; | ||||||
|  | { | ||||||
|  | 	char *c; | ||||||
|  | 	c= buffer; | ||||||
|  | 	if( f>=0){ | ||||||
|  | 		if( f> 1.0e8) | ||||||
|  | 			sprintf(buffer," %e",f); | ||||||
|  | 		else sprintf(buffer," %f",f); | ||||||
|  | 		c++; | ||||||
|  | 	}else { | ||||||
|  | 		if(-f> 1.0e8) | ||||||
|  | 			sprintf(buffer,"-%e",-f); | ||||||
|  | 		else sprintf(buffer,"-%f",-f); | ||||||
|  | 	} | ||||||
|  | 	for( ; *c && *c!= ' ';c++) ; | ||||||
|  | 	c--; | ||||||
|  | 	while( c>buffer && *c== '0') | ||||||
|  | 	{ | ||||||
|  | 		*c= 0;c--; | ||||||
|  | 	} | ||||||
|  | 	if( *c=='.') *c=0; | ||||||
|  | 	strcat(buffer," "); | ||||||
|  | } | ||||||
|  | _prfnum(f) | ||||||
|  | double f; | ||||||
|  | { | ||||||
|  | 	/* BASIC strings trailing zeroes */ | ||||||
|  | 	char	buffer[100]; | ||||||
|  | 	char	*c; | ||||||
|  | 
 | ||||||
|  | 	_asschn(); | ||||||
|  | 	c= buffer; | ||||||
|  | 	_str(f,c); | ||||||
|  | 	_out(buffer); | ||||||
|  | } | ||||||
|  | _prstr(str) | ||||||
|  | String *str; | ||||||
|  | { | ||||||
|  | 	_asschn(); | ||||||
|  | 	if( str==0)	_out("<null>"); | ||||||
|  | 	else		_out(str->strval); | ||||||
|  | } | ||||||
							
								
								
									
										25
									
								
								lang/basic/lib/random.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										25
									
								
								lang/basic/lib/random.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,25 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | _randomize() | ||||||
|  | { | ||||||
|  | 	int i; | ||||||
|  | 	double f; | ||||||
|  | 	_setchannel(-1); | ||||||
|  | 	printf("Random number seed (-32768 to 32767) ? "); | ||||||
|  | 	_readint(&i); | ||||||
|  | 	f=i; | ||||||
|  | 	_setrandom(f); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _setrandom(f) | ||||||
|  | double f; | ||||||
|  | { | ||||||
|  | 	int i; | ||||||
|  | 	i=f; | ||||||
|  | 	srand(i); | ||||||
|  | } | ||||||
|  | double _rnd(d) double d; | ||||||
|  | { | ||||||
|  | 	double f; f= (int) rand(); | ||||||
|  | 	return(f/32767.0); | ||||||
|  | } | ||||||
							
								
								
									
										172
									
								
								lang/basic/lib/read.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										172
									
								
								lang/basic/lib/read.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,172 @@ | ||||||
|  | #include "string.h" | ||||||
|  | #include "io.h" | ||||||
|  | #include <ctype.h> | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | _readln() | ||||||
|  | { | ||||||
|  | 	char c; | ||||||
|  | 	while( (c=fgetc(_chanrd)) != EOF && c!= '\n') | ||||||
|  | 		; | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | readskip() | ||||||
|  | { | ||||||
|  | 	char c; | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("readskip\n"); | ||||||
|  | #endif | ||||||
|  | 	while( (c=fgetc(_chanrd)) != EOF && c!= ',' && c!= '\n') | ||||||
|  | 		; | ||||||
|  | } | ||||||
|  | _readint(addr) | ||||||
|  | int *addr; | ||||||
|  | { | ||||||
|  | 	int i; | ||||||
|  | 	char	buf[1024]; | ||||||
|  | 
 | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("read int from %d\n",_chann); | ||||||
|  | #endif | ||||||
|  | 	_asschn(); | ||||||
|  | 	if( fscanf(_chanrd,"%d",&i) != 1) | ||||||
|  | 	{ | ||||||
|  | 		if( ferror(_chanrd)) error(29); | ||||||
|  | 		if( feof(_chanrd)) error(2); | ||||||
|  | 		if( _chann == -1) | ||||||
|  | 		{ | ||||||
|  | 			_asschn();	/* may be closed by now */ | ||||||
|  | 			fgets(buf,1024,_chanrd); | ||||||
|  | 			printf("?Redo "); | ||||||
|  | 			_readint(addr); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		error(40); | ||||||
|  | 	}else  { readskip(); *addr=i;} | ||||||
|  | } | ||||||
|  | _readflt(addr) | ||||||
|  | double *addr; | ||||||
|  | { | ||||||
|  | 	double f; | ||||||
|  | 	char buf[1024]; | ||||||
|  | 
 | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("read flt from %d\n",_chann); | ||||||
|  | #endif | ||||||
|  | 	_asschn(); | ||||||
|  | 	if( fscanf(_chanrd,"%lf",&f) != 1) | ||||||
|  | 	{ | ||||||
|  | 		if( ferror(_chanrd)) error(29); | ||||||
|  | 		if( feof(_chanrd)) error(2); | ||||||
|  | 		if( _chann == -1) | ||||||
|  | 		{ | ||||||
|  | 			fgets(buf,1024,_chanrd); | ||||||
|  | 			printf("?Redo "); | ||||||
|  | 			_readflt(addr); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		error(40); | ||||||
|  | 	}else  { readskip(); *addr=f;} | ||||||
|  | } | ||||||
|  | _readstr(s) | ||||||
|  | String **s; | ||||||
|  | { | ||||||
|  | 	char buffer[1024]; | ||||||
|  | 	char *c; | ||||||
|  | 
 | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("read str from %d\n",_chann); | ||||||
|  | #endif | ||||||
|  | 	_asschn(); | ||||||
|  | 	c= buffer; | ||||||
|  | 	*c= fgetc(_chanrd);  | ||||||
|  | 	while(isspace(*c) && *c!= EOF)  | ||||||
|  | 		*c= fgetc(_chanrd); | ||||||
|  | 	if( *c== '"') | ||||||
|  | 	{ | ||||||
|  | 		/* read quoted string */ | ||||||
|  | #ifdef DEBUG | ||||||
|  | 		printf("qouted string\n"); | ||||||
|  | #endif | ||||||
|  | 		while( (*c= fgetc(_chanrd)) != '"' && *c!= EOF ) c++; | ||||||
|  | 		ungetc(*c,_chanrd); | ||||||
|  | 		*c=0; | ||||||
|  | 	}else | ||||||
|  | 	if( isalpha(*c)) | ||||||
|  | 	{ | ||||||
|  | 		/* read normal string */ | ||||||
|  | 		c++; | ||||||
|  | #ifdef DEBUG | ||||||
|  | 		printf("non-qouted string\n"); | ||||||
|  | #endif | ||||||
|  | 		while( (*c= fgetc(_chanrd)) != ',' && *c!= EOF && | ||||||
|  | 		       !isspace(*c) && *c!='\n')  | ||||||
|  | 		       c++; | ||||||
|  | 		ungetc(*c,_chanrd); | ||||||
|  | 		*c=0; | ||||||
|  | 	}else{ | ||||||
|  | 		if( ferror(_chanrd)) error(29); | ||||||
|  | 		if( feof(_chanrd)) error(2); | ||||||
|  | 		if( _chann == -1) | ||||||
|  | 		{ | ||||||
|  | 			fgets(buffer,1024,_chanrd); | ||||||
|  | 			printf("?Redo "); | ||||||
|  | 			_rdline(s); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		error(40); | ||||||
|  | 	} | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("string read: %s\n",buffer); | ||||||
|  | #endif | ||||||
|  | 	readskip(); | ||||||
|  | 	/* save value read */ | ||||||
|  | 	_decstr(*s); | ||||||
|  | 	*s= (String *) _newstr(buffer); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | extern int _seektable[]; | ||||||
|  | 
 | ||||||
|  | _restore(line) | ||||||
|  | int line; | ||||||
|  | { | ||||||
|  | 	int nr; | ||||||
|  | 	char buffer[1024]; | ||||||
|  | 
 | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("seek to %d",line); | ||||||
|  | #endif | ||||||
|  | 	fseek(_chanrd,0l,0); | ||||||
|  | 	if( line) | ||||||
|  | 	{ | ||||||
|  | 		/* search number of lines to skip */ | ||||||
|  | 		for(nr=0; _seektable[nr] && _seektable[nr]< line; nr+=2)  | ||||||
|  | #ifdef DEBUG | ||||||
|  | 		printf("test %d %d\n",_seektable[nr], _seektable[nr+1]); | ||||||
|  | #endif | ||||||
|  | 		; | ||||||
|  | 		nr /= 2; | ||||||
|  | #ifdef DEBUG | ||||||
|  | 		printf(" %d lines to skip\n",nr); | ||||||
|  | #endif | ||||||
|  | 		while(nr-- >0 ) fgets(buffer,1024,_chanrd); | ||||||
|  | 	} | ||||||
|  | } | ||||||
|  | _rdline(s) | ||||||
|  | String **s; | ||||||
|  | { | ||||||
|  | 	char buffer[1024]; | ||||||
|  | 	if( fgets(buffer,1024,_chanrd) == 0) | ||||||
|  | 	{ | ||||||
|  | 		if( _chann == -1) | ||||||
|  | 		{ | ||||||
|  | 			printf("?Redo "); | ||||||
|  | 			_rdline(s); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		error(40); | ||||||
|  | 	} | ||||||
|  | 	_decstr(*s); | ||||||
|  | 	*s= (String *) _newstr(buffer); | ||||||
|  | } | ||||||
							
								
								
									
										29
									
								
								lang/basic/lib/return.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										29
									
								
								lang/basic/lib/return.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,29 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | #define MAXNESTING	1000 | ||||||
|  | 
 | ||||||
|  | int _gotable[MAXNESTING]; | ||||||
|  | int topstk=0; | ||||||
|  | 
 | ||||||
|  | _gosub(x) | ||||||
|  | int x; | ||||||
|  | { | ||||||
|  | 	/* administer gosub */ | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("store %d in %d\n",x,topstk); | ||||||
|  | #endif | ||||||
|  | 	if( topstk== MAXNESTING)	error(26); | ||||||
|  | 	_gotable[topstk]= x; | ||||||
|  | 	topstk++; | ||||||
|  | } | ||||||
|  | _retstmt() | ||||||
|  | { | ||||||
|  | 	/* make sure that a return label index is on top
 | ||||||
|  | 	  of the stack */ | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("return to %d %d\n",_gotable[topstk-1],topstk-1); | ||||||
|  | #endif | ||||||
|  | 	  if( topstk==0 || topstk==MAXNESTING)  | ||||||
|  | 		error(1); | ||||||
|  | 	  return( _gotable[--topstk]); | ||||||
|  | } | ||||||
							
								
								
									
										18
									
								
								lang/basic/lib/salloc.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										18
									
								
								lang/basic/lib/salloc.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,18 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | char * salloc(length) | ||||||
|  | int length; | ||||||
|  | { | ||||||
|  | 	char *c, *s; | ||||||
|  | 	c= (char *) malloc(length); | ||||||
|  | 	if( c== (char *) -1) error(5); | ||||||
|  | 	for(s=c;s<c+length;s++) *s = 0; | ||||||
|  | 	return(c); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | sfree(c) | ||||||
|  | char *c; | ||||||
|  | { | ||||||
|  | 	if( c== 0) return; | ||||||
|  | 	free(c); | ||||||
|  | } | ||||||
							
								
								
									
										11
									
								
								lang/basic/lib/setline.e
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										11
									
								
								lang/basic/lib/setline.e
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,11 @@ | ||||||
|  | # | ||||||
|  |  mes 2,EM_WSIZE,EM_PSIZE | ||||||
|  | ; $Header$ | ||||||
|  | ; Save the line where the error occurred | ||||||
|  |  exp $_setline | ||||||
|  |  pro $_setline,0 | ||||||
|  |  exa _erlsym | ||||||
|  |  loe 0 | ||||||
|  |  ste _erlsym | ||||||
|  |  ret 0 | ||||||
|  |  end | ||||||
							
								
								
									
										9
									
								
								lang/basic/lib/sgn.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										9
									
								
								lang/basic/lib/sgn.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,9 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | _sgn(v) | ||||||
|  | double v; | ||||||
|  | { | ||||||
|  | 	if( v>0) return(1); | ||||||
|  | 	if( v<0) return(-1); | ||||||
|  | 	return(0); | ||||||
|  | } | ||||||
							
								
								
									
										102
									
								
								lang/basic/lib/sin.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										102
									
								
								lang/basic/lib/sin.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,102 @@ | ||||||
|  | /*
 | ||||||
|  |  * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. | ||||||
|  |  * | ||||||
|  |  *          This product is part of the Amsterdam Compiler Kit. | ||||||
|  |  * | ||||||
|  |  * Permission to use, sell, duplicate or disclose this software must be | ||||||
|  |  * obtained in writing. Requests for such permissions may be sent to | ||||||
|  |  * | ||||||
|  |  *      Dr. Andrew S. Tanenbaum | ||||||
|  |  *      Wiskundig Seminarium | ||||||
|  |  *      Vrije Universiteit | ||||||
|  |  *      Postbox 7161 | ||||||
|  |  *      1007 MC Amsterdam | ||||||
|  |  *      The Netherlands | ||||||
|  |  * | ||||||
|  |  */ | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* Author: J.W. Stevenson */ | ||||||
|  | 
 | ||||||
|  | extern double	_fif(); | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	C program for floating point sin/cos. | ||||||
|  | 	Calls _fif. | ||||||
|  | 	There are no error exits. | ||||||
|  | 	Coefficients are #3370 from Hart & Cheney (18.80D). | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | static double twoopi	= 0.63661977236758134308; | ||||||
|  | static double p0	=  .1357884097877375669092680e8; | ||||||
|  | static double p1	= -.4942908100902844161158627e7; | ||||||
|  | static double p2	=  .4401030535375266501944918e6; | ||||||
|  | static double p3	= -.1384727249982452873054457e5; | ||||||
|  | static double p4	=  .1459688406665768722226959e3; | ||||||
|  | static double q0	=  .8644558652922534429915149e7; | ||||||
|  | static double q1	=  .4081792252343299749395779e6; | ||||||
|  | static double q2	=  .9463096101538208180571257e4; | ||||||
|  | static double q3	=  .1326534908786136358911494e3; | ||||||
|  | 
 | ||||||
|  | static double | ||||||
|  | sinus(arg, quad) | ||||||
|  | double arg; | ||||||
|  | int quad; | ||||||
|  | { | ||||||
|  | 	double e, f; | ||||||
|  | 	double ysq; | ||||||
|  | 	double x,y; | ||||||
|  | 	int k; | ||||||
|  | 	double temp1, temp2; | ||||||
|  | 
 | ||||||
|  | 	x = arg; | ||||||
|  | 	if(x<0) { | ||||||
|  | 		x = -x; | ||||||
|  | 		quad = quad + 2; | ||||||
|  | 	} | ||||||
|  | 	x = x*twoopi;	/*underflow?*/ | ||||||
|  | 	if(x>32764){ | ||||||
|  | 		y = _fif(x, 10.0, &e); | ||||||
|  | 		e = e + quad; | ||||||
|  | 		_fif(0.25, e, &f); | ||||||
|  | 		quad = e - 4*f; | ||||||
|  | 	}else{ | ||||||
|  | 		k = x; | ||||||
|  | 		y = x - k; | ||||||
|  | 		quad = (quad + k) & 03; | ||||||
|  | 	} | ||||||
|  | 	if (quad & 01) | ||||||
|  | 		y = 1-y; | ||||||
|  | 	if(quad > 1) | ||||||
|  | 		y = -y; | ||||||
|  | 
 | ||||||
|  | 	ysq = y*y; | ||||||
|  | 	temp1 = ((((p4*ysq+p3)*ysq+p2)*ysq+p1)*ysq+p0)*y; | ||||||
|  | 	temp2 = ((((ysq+q3)*ysq+q2)*ysq+q1)*ysq+q0); | ||||||
|  | 	return(temp1/temp2); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | double | ||||||
|  | _cos(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	if(arg<0) | ||||||
|  | 		arg = -arg; | ||||||
|  | 	return(sinus(arg, 1)); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | double | ||||||
|  | _sin(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	return(sinus(arg, 0)); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | /* EXTENSION */ | ||||||
|  | double | ||||||
|  | _tan(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	return( _sin(arg)/_cos(arg)); | ||||||
|  | } | ||||||
							
								
								
									
										76
									
								
								lang/basic/lib/sqt.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										76
									
								
								lang/basic/lib/sqt.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,76 @@ | ||||||
|  | /*
 | ||||||
|  |  * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. | ||||||
|  |  * | ||||||
|  |  *          This product is part of the Amsterdam Compiler Kit. | ||||||
|  |  * | ||||||
|  |  * Permission to use, sell, duplicate or disclose this software must be | ||||||
|  |  * obtained in writing. Requests for such permissions may be sent to | ||||||
|  |  * | ||||||
|  |  *      Dr. Andrew S. Tanenbaum | ||||||
|  |  *      Wiskundig Seminarium | ||||||
|  |  *      Vrije Universiteit | ||||||
|  |  *      Postbox 7161 | ||||||
|  |  *      1007 MC Amsterdam | ||||||
|  |  *      The Netherlands | ||||||
|  |  * | ||||||
|  |  */ | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* Author: J.W. Stevenson */ | ||||||
|  | 
 | ||||||
|  | extern	double	_fef(); | ||||||
|  | 
 | ||||||
|  | /*
 | ||||||
|  | 	sqrt returns the square root of its floating | ||||||
|  | 	point argument. Newton's method. | ||||||
|  | 
 | ||||||
|  | 	calls _fef | ||||||
|  | */ | ||||||
|  | 
 | ||||||
|  | double | ||||||
|  | _sqt(arg) | ||||||
|  | double arg; | ||||||
|  | { | ||||||
|  | 	double x, temp; | ||||||
|  | 	int exp; | ||||||
|  | 	int i; | ||||||
|  | 
 | ||||||
|  | 	if(arg <= 0) { | ||||||
|  | 		if(arg < 0) | ||||||
|  | 			error(3); | ||||||
|  | 		return(0); | ||||||
|  | 	} | ||||||
|  | 	x = _fef(arg,&exp); | ||||||
|  | 	/*
 | ||||||
|  | 	while(x < 0.5) { | ||||||
|  | 		x =* 2; | ||||||
|  | 		exp--; | ||||||
|  | 	} | ||||||
|  | 	*/ | ||||||
|  | 	/*
 | ||||||
|  | 	 * NOTE | ||||||
|  | 	 * this wont work on 1's comp | ||||||
|  | 	 */ | ||||||
|  | 	if(exp & 1) { | ||||||
|  | 		x *= 2; | ||||||
|  | 		exp--; | ||||||
|  | 	} | ||||||
|  | 	temp = 0.5*(1 + x); | ||||||
|  | 
 | ||||||
|  | 	while(exp > 28) { | ||||||
|  | 		temp *= (1<<14); | ||||||
|  | 		exp -= 28; | ||||||
|  | 	} | ||||||
|  | 	while(exp < -28) { | ||||||
|  | 		temp /= (1<<14); | ||||||
|  | 		exp += 28; | ||||||
|  | 	} | ||||||
|  | 	if(exp >= 0) | ||||||
|  | 		temp *= 1 << (exp/2); | ||||||
|  | 	else | ||||||
|  | 		temp /= 1 << (-exp/2); | ||||||
|  | 	for(i=0; i<=4; i++) | ||||||
|  | 		temp = 0.5*(temp + arg/temp); | ||||||
|  | 	return(temp); | ||||||
|  | } | ||||||
							
								
								
									
										10
									
								
								lang/basic/lib/stop.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										10
									
								
								lang/basic/lib/stop.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,10 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | _stop() | ||||||
|  | { | ||||||
|  | 	extern int _erlsym; | ||||||
|  | 
 | ||||||
|  | 	_setline(); | ||||||
|  | 	printf("Break in %d\n", _erlsym); | ||||||
|  | 	exit(0); | ||||||
|  | } | ||||||
							
								
								
									
										175
									
								
								lang/basic/lib/string.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										175
									
								
								lang/basic/lib/string.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,175 @@ | ||||||
|  | #include "string.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | #define ok(X)	if( X ==0) return; | ||||||
|  | #define okr(X)	if( X ==0) return(0); | ||||||
|  | 
 | ||||||
|  | _len(str) | ||||||
|  | String *str; | ||||||
|  | { | ||||||
|  | 	okr(str); | ||||||
|  | 	return(str->strlength); | ||||||
|  | } | ||||||
|  | String *_newstr(str) | ||||||
|  | char *str; | ||||||
|  | { | ||||||
|  | 	String *s; | ||||||
|  | 	okr(str); | ||||||
|  | 	s= (String *) salloc(sizeof(String)); | ||||||
|  | 	s->strcount=1; | ||||||
|  | 	s->strlength= strlen(str); | ||||||
|  | 	s->strval= (char *) salloc(s->strlength+1); | ||||||
|  | 	strcpy(s->strval,str); | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
|  | _incstr(src) | ||||||
|  | String *src; | ||||||
|  | { | ||||||
|  | 	/* one more variable uses the string */ | ||||||
|  | 	ok(src); | ||||||
|  | 	src->strcount++; | ||||||
|  | } | ||||||
|  | _decstr(str) | ||||||
|  | String *str; | ||||||
|  | { | ||||||
|  | 	ok(str); | ||||||
|  | 	str->strcount--; | ||||||
|  | 	if(str->strcount<=0) _delstr(str); | ||||||
|  | } | ||||||
|  | _strcpy(dst,src) | ||||||
|  | String *src,*dst; | ||||||
|  | { | ||||||
|  | 	ok(src); | ||||||
|  | 	ok(dst); | ||||||
|  | 	_decstr(dst); | ||||||
|  | 	*dst = *src; | ||||||
|  | 	_incstr(src); | ||||||
|  | } | ||||||
|  | _delstr(src) | ||||||
|  | String *src; | ||||||
|  | { | ||||||
|  | 	ok(src); | ||||||
|  | 	sfree(src->strval); | ||||||
|  | 	sfree(src); | ||||||
|  | } | ||||||
|  | String *_concat(s1,s2) | ||||||
|  | String *s1,*s2; | ||||||
|  | { | ||||||
|  | 	String *s; | ||||||
|  | 	int length; | ||||||
|  | 	okr(s1); okr(s2); | ||||||
|  | 	s= (String *) salloc(sizeof(String)); | ||||||
|  | 	length= _len(s1)+_len(s2)+1; | ||||||
|  | 	s->strval= (char *) salloc(length); | ||||||
|  | 	strcpy(s->strval,s2->strval); | ||||||
|  | 	strcat(s->strval,s1->strval); | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
|  | _strcompare(s1,s2) | ||||||
|  | String *s1,*s2; | ||||||
|  | { | ||||||
|  | 	okr(s1);okr(s2); | ||||||
|  | 	return(strcmp(s2->strval,s1->strval)); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | String *_left(size,s) | ||||||
|  | String *s; | ||||||
|  | int	size; | ||||||
|  | { | ||||||
|  | 	String *ns; | ||||||
|  | 	int i; | ||||||
|  | 
 | ||||||
|  | 	okr(s); | ||||||
|  | 	if( size <0 || size >s->strlength) error(3); | ||||||
|  | 	ns= (String *) salloc(sizeof(String)); | ||||||
|  | 	ns->strval= (char *) salloc(size+1); | ||||||
|  | 	ns->strcount=1; | ||||||
|  | 	for(i=0; i<size && s->strval[i];i++) | ||||||
|  | 		ns->strval[i]= s->strval[i]; | ||||||
|  | 	ns->strval[i]=0; | ||||||
|  | 	ns->strlength= i; | ||||||
|  | 	return(ns); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | String *_space(d) | ||||||
|  | int d; | ||||||
|  | { | ||||||
|  | 	String *s; | ||||||
|  | 	int i,len; | ||||||
|  | 
 | ||||||
|  | 	len= d; | ||||||
|  | 	s= (String *) salloc(sizeof(String)); | ||||||
|  | 	s->strlength= len; | ||||||
|  | 	s->strcount=1; | ||||||
|  | 	s->strval= (char *) salloc(len+1); | ||||||
|  | 	for(i=0;i<len;i++) | ||||||
|  | 		s->strval[i]= ' '; | ||||||
|  | 	s->strval[i]=0; | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | String *_strascii() | ||||||
|  | { | ||||||
|  | } | ||||||
|  | String *_string(d,f) | ||||||
|  | double	d,f; | ||||||
|  | { | ||||||
|  | 	int i,j; | ||||||
|  | 	String *s; | ||||||
|  | 
 | ||||||
|  | 	i=d;j=f; | ||||||
|  | 	if( i<0  || i>MAXSTRING) error(3); | ||||||
|  | 	s= (String *) salloc(sizeof(String)); | ||||||
|  | 	s->strlength= i; | ||||||
|  | 	s->strcount=1; | ||||||
|  | 	s->strval= (char *) salloc(i+1); | ||||||
|  | 	s->strval[i]=0; | ||||||
|  | 	for(; i>=0;i--) | ||||||
|  | 		s->strval[i]= j; | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
|  | _midstmt(s2,i1,i2,s) | ||||||
|  | int i1,i2; | ||||||
|  | String *s, *s2; | ||||||
|  | { | ||||||
|  | 	int l; | ||||||
|  | 
 | ||||||
|  | /*	printf("mid called %d %d %s %s\n",i1,i2,s->strval, s2->strval);*/ | ||||||
|  | 	if( i1== -1) i1= s2->strlength; | ||||||
|  | 	if( s->strlength<i2) error(3);	/* source string too short */ | ||||||
|  | 	l= s->strlength - i2+1; | ||||||
|  | 	if( i1>l ) i1=l; | ||||||
|  | 	strncpy(s->strval+i2-1,s2->strval,i1); | ||||||
|  | } | ||||||
|  | String *_mid(i1,i2,s) | ||||||
|  | int i1,i2; | ||||||
|  | String *s; | ||||||
|  | { | ||||||
|  | 	int l; | ||||||
|  | 	String *s2; | ||||||
|  | 
 | ||||||
|  | /*	printf("mid fcn called %d %d %s\n",i1,i2,s->strval);*/ | ||||||
|  | 	if( i1 == -1) i1= s->strlength; | ||||||
|  | 	s2= _newstr(s->strval); | ||||||
|  | 	s2->strval[0]=0; | ||||||
|  | 	if( s->strlength<i2) return(s2);	/* source string too short */ | ||||||
|  | 	l= s->strlength - i2+1; | ||||||
|  | 	if( i1>l ) i1=l; | ||||||
|  | 	strncpy(s2->strval,s->strval+i2-1,i1); | ||||||
|  | 	s2->strval[i1]=0; | ||||||
|  | 	return(s2); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | String *_right(length,str) | ||||||
|  | String *str; | ||||||
|  | int length; | ||||||
|  | { | ||||||
|  | 	String *s; | ||||||
|  | 	int i; | ||||||
|  | 
 | ||||||
|  | 	i= _len(str)-length; | ||||||
|  | 	if(i<0) i=0; | ||||||
|  | 	s= _newstr(str->strval+i); | ||||||
|  | 	return(s); | ||||||
|  | } | ||||||
							
								
								
									
										30
									
								
								lang/basic/lib/swap.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										30
									
								
								lang/basic/lib/swap.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,30 @@ | ||||||
|  | #include "string.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | _intswap(i1,i2) | ||||||
|  | int *i1,*i2; | ||||||
|  | { | ||||||
|  | 	int i3; | ||||||
|  | 	i3= *i1; | ||||||
|  | 	*i1= *i2; | ||||||
|  | 	*i2=i3; | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _fltswap(i1,i2) | ||||||
|  | double *i1,*i2; | ||||||
|  | { | ||||||
|  | 	double i3; | ||||||
|  | 	i3= *i1; | ||||||
|  | 	*i1= *i2; | ||||||
|  | 	*i2=i3; | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _strswap(s1,s2) | ||||||
|  | String *s1,*s2; | ||||||
|  | { | ||||||
|  | 	String s; | ||||||
|  | 	s= *s1; | ||||||
|  | 	*s1= *s2; | ||||||
|  | 	*s2 = s; | ||||||
|  | } | ||||||
							
								
								
									
										7
									
								
								lang/basic/lib/trace.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								lang/basic/lib/trace.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | _trace() | ||||||
|  | {	 | ||||||
|  | int i; | ||||||
|  | printf("[%d]",i); | ||||||
|  | } | ||||||
							
								
								
									
										55
									
								
								lang/basic/lib/trap.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										55
									
								
								lang/basic/lib/trap.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,55 @@ | ||||||
|  | #include <signal.h> | ||||||
|  | #include <setjmp.h> | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* Trap handling */ | ||||||
|  | int	_trpline;	/* BASIC return label */ | ||||||
|  | jmp_buf	trpbuf; | ||||||
|  | 
 | ||||||
|  | _trpset(nr) | ||||||
|  | int nr; | ||||||
|  | { | ||||||
|  | 	/*debug  printf("trap set to %d\n",nr);*/ | ||||||
|  | 	_trpline=nr; | ||||||
|  | } | ||||||
|  | _trpfatal(i) | ||||||
|  | int i; | ||||||
|  | { | ||||||
|  | 	extern int _errsym,_erlsym; | ||||||
|  | 
 | ||||||
|  | 	_errsym= i; | ||||||
|  | 	_setline(); | ||||||
|  | 	if( _trpline == 0) | ||||||
|  | 		printf("LINE %d: FATAL ERROR: trap %d\n",_erlsym,i); | ||||||
|  | #ifdef DEBUG | ||||||
|  | 	printf("trap occurred %d return %d\n",i,_trpline); | ||||||
|  | #endif | ||||||
|  | 	_trap(); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | _ini_trp() | ||||||
|  | { | ||||||
|  | 	/* initialize trap routines */ | ||||||
|  | 	int i, _trpfatal(); | ||||||
|  | 
 | ||||||
|  | 	for(i=0;i<NSIG;i++) | ||||||
|  | 		signal(i,_trpfatal); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | _settrap(nr) | ||||||
|  | int nr; | ||||||
|  | { | ||||||
|  | 	_trpline=nr; | ||||||
|  | } | ||||||
|  | _trap() | ||||||
|  | { | ||||||
|  | 	int line; | ||||||
|  | 
 | ||||||
|  | 	if( _trpline==0) exit(-1); | ||||||
|  | 	line=_trpline; | ||||||
|  | 	_trpline=0;		/* should be reset by user */ | ||||||
|  | 	_ini_trp(); | ||||||
|  | 	longjmp(trpbuf,line); | ||||||
|  | } | ||||||
							
								
								
									
										32
									
								
								lang/basic/lib/write.c
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										32
									
								
								lang/basic/lib/write.c
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,32 @@ | ||||||
|  | #include "string.h" | ||||||
|  | #include "io.h" | ||||||
|  | 
 | ||||||
|  | /* $Header $ */ | ||||||
|  | 
 | ||||||
|  | /* assume that the channel has been set */ | ||||||
|  | 
 | ||||||
|  | _wrnl() | ||||||
|  | { | ||||||
|  | 	if( fputc('\n',_chanwr) == EOF) error(29); | ||||||
|  | } | ||||||
|  | _wrcomma() | ||||||
|  | { | ||||||
|  | 	if( fputc(',',_chanwr) == EOF) error(29); | ||||||
|  | } | ||||||
|  | _wrint(i) | ||||||
|  | int i; | ||||||
|  | { | ||||||
|  | 	if(i>0)  | ||||||
|  | 		if( fputc(' ',_chanwr)==EOF) error(29); | ||||||
|  | 	fprintf(_chanwr,"%d",i); | ||||||
|  | } | ||||||
|  | _wrflt(f) | ||||||
|  | double f; | ||||||
|  | { | ||||||
|  | 	if( fprintf(_chanwr,"%f",f)== EOF) error(29); | ||||||
|  | } | ||||||
|  | _wrstr(s) | ||||||
|  | String *s; | ||||||
|  | { | ||||||
|  | 	 if( fprintf(_chanwr,"\"%s\"",s->strval)== EOF) error(29); | ||||||
|  | } | ||||||
		Loading…
	
	Add table
		
		Reference in a new issue