#ifndef __IMP_PERMS__ #define __IMP_PERMS__ 1 // Like imp %perms, most of these cannot be passed as procedures to other procedures // without being wrapped in a real procedure first. C's "inline" is very similar in // style to imp's %perms. // Some procedures have been declared %prim and are implemented directly by the i2c // compiler, without any procedure being called - whether inline or external. // i2c should not output the declarations from the perm file to the generated C code // but should replace them with a suitable C header file, eg perms.inc -> perms.h // We'll try to avoid namespace pollution by using all uppercase within the generated // C code. Imp is not case-sensitive, but C is. Also any imp support code that has // to be created as externals will be prefixed by "_imp_" so that C doesn't sufffer // namespace pollution from Imp either! #include #include #include #include #include #include #include #include #include #include #include #include #ifdef NULL // The level of namespace pollution from C is causing real problems :-( // Anything in C that is all uppercase could potentially cause a clash. #undef NULL #endif #ifdef FALSE #undef FALSE #endif #define False (0!=0) #ifdef TRUE #undef TRUE #endif #define True (0==0) // NOTE: All of the macros below are unsafe: // The current implementation of Imp strings does *not* guarantee a terminating // '\0' at the end of the Imp string. #define _imp_c2istr(str) ({_imp_string tmp; strcpy(tmp.cstr.s, str); tmp.length=strlen(tmp.cstr.s);/*_imp_zeropad(&tmp);*/tmp;}) #define _imp_i2cstr(str) ({(*str).cstr.s[(*str).length] = '\0'; (*str).cstr.s;}) // experimental code to see if we can be sure to avoid use of strlen at runtime: #define _imp_str_literal(lit) (_imp_string){.cstr = {(sizeof(lit))-1, lit} } #define _imp_assign_str_literal(s,lit) _imp_strcpy(s, _imp_str_literal(lit)) // similar to C's __LINE__ and __FILE__ for diagnostics: extern int _imp_current_line; extern char *_imp_current_file; typedef uintptr_t _imp_address; // This is to handle systems with 64-bit addresses extern int _imp_control; // %control 0xnnnnnn and command-line option flags. #define _IMP_CONTROL_TRACE 1024 extern int _imp_diagnose; // %diagnose 0xnnnnnn and command-line option flags. #define _IMP_DIAG_SIGNALS 1024 extern void _imp_initialise(int argc, char **argv); //%begin/%endofprogram // TRACE FACILITY extern int _imp_trace_enter(int line, char *file, char *funcname); extern int _imp_trace_exit(int line, char *file, char *funcname); extern void _imp_trace_backtrace(int n, int line, char *file, char *funcname); // NAME - Generic %name type is implemented by a struct. i2c will construct the // struct on the fly when anything other than another generic %name variable is // passed as a %name parameter. typedef struct { void *address; int sizeinfo; int typeinfo; } _imp_NAME; // CONSTS //extern const double PI; static inline double PI(void) { return 3.141592653589793238462; } enum { NL = '\n' }; // STRINGS #define define_imp_c_string(N) typedef struct cstring_##N { unsigned char ignored; char s[N]; } cstring_##N #define define_imp_string(N) typedef struct { union { unsigned char length; unsigned char charno[256]; cstring_##N cstr; }; } _imp_string##N #define define_string(N) define_imp_c_string(N); define_imp_string(N) define_string(255); define_string(254); define_string(253); define_string(252); define_string(251); define_string(250); define_string(249); define_string(248); define_string(247); define_string(246); define_string(245); define_string(244); define_string(243); define_string(242); define_string(241); define_string(240); define_string(239); define_string(238); define_string(237); define_string(236); define_string(235); define_string(234); define_string(233); define_string(232); define_string(231); define_string(230); define_string(229); define_string(228); define_string(227); define_string(226); define_string(225); define_string(224); define_string(223); define_string(222); define_string(221); define_string(220); define_string(219); define_string(218); define_string(217); define_string(216); define_string(215); define_string(214); define_string(213); define_string(212); define_string(211); define_string(210); define_string(209); define_string(208); define_string(207); define_string(206); define_string(205); define_string(204); define_string(203); define_string(202); define_string(201); define_string(200); define_string(199); define_string(198); define_string(197); define_string(196); define_string(195); define_string(194); define_string(193); define_string(192); define_string(191); define_string(190); define_string(189); define_string(188); define_string(187); define_string(186); define_string(185); define_string(184); define_string(183); define_string(182); define_string(181); define_string(180); define_string(179); define_string(178); define_string(177); define_string(176); define_string(175); define_string(174); define_string(173); define_string(172); define_string(171); define_string(170); define_string(169); define_string(168); define_string(167); define_string(166); define_string(165); define_string(164); define_string(163); define_string(162); define_string(161); define_string(160); define_string(159); define_string(158); define_string(157); define_string(156); define_string(155); define_string(154); define_string(153); define_string(152); define_string(151); define_string(150); define_string(149); define_string(148); define_string(147); define_string(146); define_string(145); define_string(144); define_string(143); define_string(142); define_string(141); define_string(140); define_string(139); define_string(138); define_string(137); define_string(136); define_string(135); define_string(134); define_string(133); define_string(132); define_string(131); define_string(130); define_string(129); define_string(128); define_string(127); define_string(126); define_string(125); define_string(124); define_string(123); define_string(122); define_string(121); define_string(120); define_string(119); define_string(118); define_string(117); define_string(116); define_string(115); define_string(114); define_string(113); define_string(112); define_string(111); define_string(110); define_string(109); define_string(108); define_string(107); define_string(106); define_string(105); define_string(104); define_string(103); define_string(102); define_string(101); define_string(100); define_string(99); define_string(98); define_string(97); define_string(96); define_string(95); define_string(94); define_string(93); define_string(92); define_string(91); define_string(90); define_string(89); define_string(88); define_string(87); define_string(86); define_string(85); define_string(84); define_string(83); define_string(82); define_string(81); define_string(80); define_string(79); define_string(78); define_string(77); define_string(76); define_string(75); define_string(74); define_string(73); define_string(72); define_string(71); define_string(70); define_string(69); define_string(68); define_string(67); define_string(66); define_string(65); define_string(64); define_string(63); define_string(62); define_string(61); define_string(60); define_string(59); define_string(58); define_string(57); define_string(56); define_string(55); define_string(54); define_string(53); define_string(52); define_string(51); define_string(50); define_string(49); define_string(48); define_string(47); define_string(46); define_string(45); define_string(44); define_string(43); define_string(42); define_string(41); define_string(40); define_string(39); define_string(38); define_string(37); define_string(36); define_string(35); define_string(34); define_string(33); define_string(32); define_string(31); define_string(30); define_string(29); define_string(28); define_string(27); define_string(26); define_string(25); define_string(24); define_string(23); define_string(22); define_string(21); define_string(20); define_string(19); define_string(18); define_string(17); define_string(16); define_string(15); define_string(14); define_string(13); define_string(12); define_string(11); define_string(10); define_string(9); define_string(8); define_string(7); define_string(6); define_string(5); define_string(4); define_string(3); define_string(2); define_string(1); define_string(0); /* ^ Only for the empty string! And consistency. */ typedef _imp_string255 _imp_string; // default %string(*) is %string(255) ... #undef define_imp_c_string #undef define_imp_string #undef define_string static inline _imp_string _imp_SNL(void) { _imp_string SNL = {.length = 1, .cstr.s[0] = NL}; return SNL; } // Not sure if it is worth being able to keep a stream open on end-of-file and // allow failing reads to continue? If that's needed, we need another variable // 'EOF' rather than setting the FILE to NULL. Might also be helpful to add a // pascal-style eof() predicate just in case at some point a user program doesn't // want to get all tied up with the %signal mechanism. typedef struct _imp_filedata { int streamno; FILE *f; _imp_string fname; int lastchar, nextchar; union { int inpos; int outpos; }; } _imp_filedata; extern int _imp_InStream , _imp_OutStream ; extern FILE *_imp_INFILE, *_imp_OUTFILE; extern _imp_filedata _imp_infile[256]; extern _imp_filedata _imp_outfile[256]; //extern const _imp_string1 SNL; extern _imp_string _imp_promptstr; extern int _imp_resolve (_imp_string s, _imp_string *left, _imp_string match, _imp_string *right); // _imp_join is implemented inline below. //extern _imp_string _imp_join (_imp_string left, _imp_string right); extern int _imp_strcmp (_imp_string left, _imp_string right); static inline void _imp_zeropad(_imp_string *str) { int len = str->length; if (str->cstr.s[len] != '\0') fprintf(stderr, "*** WARNING: IMP string at %p is not zero-terminated for access by C\n", str); do str->cstr.s[len++] = '\0'; while (len < 256); } extern void _imp_readsymbol(int *P); extern void _imp_readch(int *P); extern int _imp_nextsymbol(void); extern int _imp_nextch(void); extern void _imp_skipsymbol(void); extern void _imp_printsymbol(char SYM); extern void _imp_printch(char SYM); extern void _imp_printstring(_imp_string S); extern void _imp_write(int V, int P); extern void _imp_readitem(_imp_string *S); extern void _imp_readstring(_imp_string *S); extern void _imp_readtext(_imp_string *S, int DELIM); extern _imp_string _imp_nextitem(void); extern void _imp_readline(_imp_string *S); extern int _imp_instream(void); extern int _imp_outstream(void); extern int _imp_inputstream(void); extern int _imp_outputstream(void); extern _imp_string _imp_inputname(void); extern _imp_string _imp_outputname(void); extern _imp_string _imp_infilename(void); extern _imp_string _imp_outfilename(void); extern void _imp_selectinput(int N); extern void _imp_selectoutput(int N); extern void _imp_openinput(int N, _imp_string FD); extern void _imp_openoutput(int N, _imp_string FD); extern void _imp_openbinaryinput(int N, _imp_string FD); extern void _imp_openbinaryoutput(int N, _imp_string FD); extern void _imp_defineinput(int I, _imp_string SPEC); extern void _imp_defineoutput(int I, _imp_string SPEC); extern void _imp_closeinput(void); extern void _imp_closeoutput(void); extern void _imp_abandoninput(void); extern void _imp_abandonoutput(void); extern void _imp_resetinput(void); extern void _imp_space(void); extern void _imp_spaces(int N); extern void _imp_newpage(void); extern void _imp_newline(void); extern void _imp_newlines(int N); extern void _imp_print(double R, int BEFORE, int AFTER); extern void _imp_printfloating(double R, int A, int B); extern void _imp_printfl(double R, int PLACES); extern _imp_string _imp_substring(_imp_string S, int FROM, int TO); extern _imp_string _imp_fromstring(_imp_string S, int FROM, int TO); extern _imp_string _imp_trim(_imp_string S, int MAX); extern _imp_string _imp_time(void); extern _imp_string _imp_date(void); extern int _imp_cputime(void); extern _imp_string _imp_cliparam(void); extern _imp_string _imp_eventmessage(void); extern _imp_string _imp_itos(int I, int P); static inline void _imp_zeropad(_imp_string *str); static inline _imp_string _imp_TOSTRING(int C); static inline unsigned char *_imp_CHARNO(_imp_string *str, int i); static inline unsigned char *_imp_LENGTH(_imp_string *str); static inline void _imp_strcpy(_imp_string *to, _imp_string from); extern _imp_string *_imp_strcat(_imp_string *to, _imp_string from); // static inline void READ(_imp_NAME dest); // i2c can, when allowed, change READ into a call on READITEM, // READSTRING, or the newly-invented READINT and READFLOAT/READDOUBLE etc! // Note that this mechanism will not work if READ is passed a %name parameter, // or if READ itself is passed to another procedure as a procedure parameter... extern void _imp_readbyte(unsigned char *dest); extern void _imp_readshort(short int *dest); extern void _imp_readint(int *dest); extern void _imp_readlong(long long int *dest); extern void _imp_readfloat(float *dest); extern void _imp_readdouble(double *dest); #define _imp_READ(var) do { \ if (__builtin_types_compatible_p(typeof(var), unsigned char *)) _imp_readbyte((unsigned char *)var); \ else if (__builtin_types_compatible_p(typeof(var), short int *)) _imp_readshort((short int *)var); \ else if (__builtin_types_compatible_p(typeof(var), int *)) _imp_readint((int *)var); \ else if (__builtin_types_compatible_p(typeof(var), long long int *)) _imp_readlong((long long int *)var); \ else if (__builtin_types_compatible_p(typeof(var), float *)) _imp_readfloat((float *)var); \ else if (__builtin_types_compatible_p(typeof(var), double *)) _imp_readdouble((double *)var); \ else if (__builtin_types_compatible_p(typeof(var), _imp_string *)) _imp_readitem((_imp_string *)var); \ else { fprintf(stderr, "READ failes - cannot determine type of parameter\n"); exit(1); } \ } while(0) static inline double _imp_FLOAT(double N); // might be wrong. might be for converting an int to a real. static inline _imp_address _imp_ADDR(void *P); static inline unsigned char *_imp_BYTE(_imp_address N); static inline unsigned char *_imp_BYTEINTEGER(_imp_address N); static inline short *_imp_SHORT(_imp_address N); static inline short *_imp_SHORTINTEGER(_imp_address N); static inline int *_imp_INTEGER(_imp_address N); static inline long *_imp_LONG(_imp_address N); static inline long *_imp_LONGINTEGER(_imp_address N); static inline long long *_imp_LONGLONG(_imp_address N); static inline long long *_imp_LONGLONGINTEGER(_imp_address N); static inline long long int _imp_LENGTHENI(int I); static inline float *_imp_REAL(_imp_address N); static inline double *_imp_LONGREAL(_imp_address N); static inline _imp_string *_imp_STRING(_imp_address N); static inline void *_imp_RECORD(_imp_address N); static inline int _imp_TYPEOF(_imp_NAME N); static inline int _imp_SIZEOF(_imp_NAME N); static inline double _imp_ARCSIN(double ANGLE); static inline double _imp_ARCCOS(double ANGLE); static inline double _imp_ARCTAN(double X, double Y); static inline double _imp_ARCTAN1(double ANGLE); static inline double _imp_SIN(double ANGLE); static inline double _imp_COS(double ANGLE); static inline double _imp_TAN(double ANGLE); static inline double _imp_FRACTION(double R); static inline double _imp_FRACPT(double R); static inline int _imp_IMOD(int I); #ifdef NEVER // This is why perms need to be output in C using private internal names such as _imp_imod(N) ... // %integerfn IMOD(%integer n) // %result = |N| // %end // If a user program did the above, it would cause an infinite recusion! #endif static inline double _imp_MOD(double R); static inline int _imp_INT(double R); static inline int _imp_INTPT(double R); static inline long int _imp_LINT(double R); static inline long int _imp_LINTPT(double R); static inline int _imp_TRUNC(double R); static inline int _imp_ROUND(double R); static inline long long int _imp_IEXP(int NUM, int POWER); static inline double _imp_REXP(double NUM, double POWER); static inline double _imp_LOG(double X); static inline int _imp_REM(int P, int Q); static inline double _imp_SQRT(double NUM); static inline int _imp_ISQRT(int NUM); static inline int _imp_MULDIV(int A, int B, int C); static inline void _imp_PROMPT(_imp_string S); static inline void _imp_READSYMBOL(int *P); static inline void _imp_READCH(int *P); static inline int _imp_NEXTSYMBOL(void); static inline int _imp_NEXTCH(void); static inline void _imp_SKIPSYMBOL(void); static inline void _imp_PRINTSYMBOL(char SYM); static inline void _imp_PRINTCH(char SYM); static inline void _imp_PRINTSTRING(_imp_string S); static inline void _imp_WRITE(int V, int P); // IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt} static inline void _imp_READITEM(_imp_string *S); static inline void _imp_READSTRING(_imp_string *S); static inline void _imp_READTEXT(_imp_string *S, int DELIM); static inline _imp_string _imp_NEXTITEM(void); static inline void _imp_READLINE(_imp_string *S); static inline int _imp_INSTREAM(void); static inline int _imp_OUTSTREAM(void); static inline int _imp_INPUTSTREAM(void); static inline int _imp_OUTPUTSTREAM(void); static inline _imp_string _imp_INPUTNAME(void); static inline _imp_string _imp_OUTPUTNAME(void); static inline _imp_string _imp_INFILENAME(void); static inline _imp_string _imp_OUTFILENAME(void); static inline void _imp_SELECTINPUT(int N); static inline void _imp_SELECTOUTPUT(int N); static inline void _imp_OPENINPUT(int N, _imp_string FD); static inline void _imp_OPENOUTPUT(int N, _imp_string FD); static inline void _imp_OPENBINARYINPUT(int N, _imp_string FD); static inline void _imp_OPENBINARYOUTPUT(int N, _imp_string FD); static inline void _imp_DEFINEINPUT(int I, _imp_string SPEC); static inline void _imp_DEFINEOUTPUT(int I, _imp_string SPEC); static inline void _imp_ABANDONINPUT(void); static inline void _imp_ABANDONOUTPUT(void); static inline void _imp_CLOSEINPUT(void); static inline void _imp_CLOSEOUTPUT(void); static inline void _imp_RESETINPUT(void); static inline void _imp_RESETOUTPUT(void); static inline void _imp_COMPLETEINPUT(void); static inline void _imp_COMPLETEOUTPUT(void); static inline void _imp_POSITIONINPUT(int P); static inline void _imp_POSITIONOUTPUT(int P); static inline void _imp_SETINPUT(int P); static inline void _imp_SETOUTPUT(int P); static inline void _imp_INPUTPOSITION(void); static inline void _imp_OUTPUTPOSITION(void); static inline int _imp_ENDOFINPUT(void); static inline void _imp_SPACE(void); static inline void _imp_SPACES(int N); static inline void _imp_NEWPAGE(void); static inline void _imp_NEWLINE(void); static inline void _imp_NEWLINES(int N); static inline void _imp_READ_name(void *PTR, int PTR_typeof); static inline void _imp_PRINT(double R, int BEFORE, int AFTER); // IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt} static inline void _imp_PRINTFLOATING(double R, int A, int B); static inline void _imp_PRINTFL(double R, int PLACES); static inline _imp_string _imp_SUBSTRING(_imp_string S, int FROM, int TO); static inline _imp_string _imp_FROMSTRING(_imp_string S, int FROM, int TO); static inline _imp_string _imp_TRIM(_imp_string S, int MAX); static inline _imp_string _imp_TIME(void); static inline _imp_string _imp_DATE(void); #ifdef WANT_EMAS_STYLE static inline float _imp_CPUTIME(void); // Result is seconds #else static inline int _imp_CPUTIME(void); // Result is milliseconds #endif static inline _imp_string _imp_CLIPARAM(void); // Linux extension added. extern int _imp_ARGC(void); extern _imp_string255 _imp_ARGV(int n); static inline int _imp_EVENT_(void); static inline int _imp_SUBEVENT(void); static inline int _imp_EVENTINFO(void); static inline _imp_string _imp_EVENTMESSAGE(void); static inline _imp_string _imp_ITOS(int I, int P); static inline _imp_string _imp_SSFMESSAGE(void); static inline int _u(int I, int line); static inline _imp_string _imp_TOSTRING(int C) { _imp_string tmp; *_imp_LENGTH(&tmp) = 1; *_imp_CHARNO(&tmp, 1) = (C&255); return tmp; // Return whole string on the stack, not just a pointer. } static inline unsigned char *_imp_CHARNO(_imp_string *str, int i) { return &str->charno[i]; } static inline unsigned char *_imp_LENGTH(_imp_string *str) { return &str->length; } static inline void _imp_strcpy(_imp_string *to, _imp_string from) { memmove(to, &from, *_imp_LENGTH(&from)+1); } //static inline _imp_string *_imp_strcat(_imp_string *left, _imp_string right) { // /*TO DO*/ // fprintf(stderr, "* _imp_strcat not yet implemented.\n"); // return left; //} static inline _imp_string _imp_join(_imp_string left, _imp_string right) { _imp_string joined; int combined_length = *_imp_LENGTH(&left)+*_imp_LENGTH(&right); if (combined_length > 255) { fprintf(stderr, "STRING CAPACITY EXCEEDED\n"); exit(1); // short-term error message. Needs work. *TO DO* } _imp_strcpy(&joined, left); memmove(&joined.charno[1]+*_imp_LENGTH(&left), &right.charno[1], *_imp_LENGTH(&right)); *_imp_LENGTH(&joined) = combined_length; return joined; // Return whole string on the stack, not just a pointer. } // EVENTS typedef struct EVENTFM { int EVENT; int SUBEVENT; int EXTRA; _imp_string MESSAGE; // From __LINE__ and __FILE__ int LINE; _imp_string *FILE; } eventfm; typedef struct _imp_on_event_handler _imp_on_event_handler; typedef struct _imp_on_event_handler { // int eventmask; _imp_on_event_handler *parent_handler; jmp_buf env; } _imp_on_event_handler; extern eventfm _imp_Event; // global extern _imp_on_event_handler *global_handler; // only declared and installed in an onevent block! // Signal codes enum { PROGRAMSTOP = 0, OVERFLOW = 1, STOREEXCEEDED = 2, CONVERSIONERROR = 4, ARGUMENTERROR = 5, RANGEERROR = 6, STRINGRESOLUTIONFAILS = 7, UNDEFINEDVALUE = 8, INPUTENDED = 9, IOERROR = 10, JUMPOUT = 11, USEREVENT = 12, }; #ifdef USE_IMP_TRACING #define _imp_on_event(...) ( { \ static _imp_on_event_handler this_handler; \ this_handler = (_imp_on_event_handler){.parent_handler=global_handler} ; /* chain */ \ global_handler = &this_handler; \ handler_at_this_level = 1; \ setjmp(this_handler.env) && _imp_caught_on_event(_imp_Event.EVENT,__VA_ARGS__); \ } ) #else #define _imp_on_event(...) ( { \ /* handler_at_this_level undefined. Needs work */ \ static _imp_on_event_handler this_handler; \ this_handler = (_imp_on_event_handler){.parent_handler=global_handler} ; /* chain */ \ global_handler = &this_handler; \ int handler_at_this_level = 1; \ setjmp(this_handler.env) && _imp_caught_on_event(_imp_Event.EVENT,__VA_ARGS__); \ } ) #endif // Unfortunately to work properly, imp %signal support has to be handled // by i2c inserting calls at both the entry points of procedures and all // their exit points (returns, and end of block) // Since we're inserting code anyway, we might as well handle tracing here too. // BACKTACE, PROFILING ETC. #ifdef USE_IMP_TRACING #define _imp_enter() int handler_at_this_level = _imp_trace_enter(__LINE__, __FILE__, (char *)__PRETTY_FUNCTION__) // LEAVE has to be inserted before plain 'return' statements and the final '}' of the procedure/function #define _imp_leave() do { _imp_trace_exit(__LINE__, __FILE__, (char *)__PRETTY_FUNCTION__); \ if (global_handler && handler_at_this_level) global_handler = global_handler->parent_handler; \ } while(0) // returns with value can be handled almost transparently as long as imp2c generates return(x) rather then return x. #if USE_IMP_TRACING == 4 #define return(x) do { _imp_trace_exit(__LINE__, __FILE__, (char *)__PRETTY_FUNCTION__); \ if (global_handler && handler_at_this_level) global_handler = global_handler->parent_handler; return x; \ } while(0) #endif #endif // USE_IMP_TRACING extern void _signal_event(char *file, int line, _imp_string info, int event, int subevent, int extra); extern int _imp_caught_on_event(int event, int bitpos, ...); // resignals if not in catch-list. //extern int eventmask(int bitpos, ...); extern int _imp_caught_fault(int event, int bitpos, ...); // does not signal. just returns true/false extern int sysnprintf(char *out, int maxlen, char *command); void _imp_monitor(int n, int line, char *file, const char *funcname); //#define _imp_monitor(N) _imp_trace_backtrace(N,__LINE__,__FILE__,(char *)__PRETTY_FUNCTION__) #define _imp_signal(A,B,C,D) _signal_event(__FILE__,__LINE__,_imp_c2istr(D),A,B,C) #define signal_event(E,S,X) _signal_event(__FILE__,__LINE__,_imp_c2istr(strerror(errno)),E,S,X) // PERMS+PRIMS: /* %integer %function TYPE OF ( %name X ) This function returns a code which indicates the type of the object supplied as parameter. The complete list of code values which may be returned by TYPE OF is as follows: 0 - unknown type 1 - integer 2 - real 3 - string 4 - record 5 - byte integer 6 - short integer 7 - long integer 8 - long real 9 - array 10 - label */ // TYPEOF() in Imp should return the values above for parameters that are known // at compile time. However until that level of support is added to the // compiler, we can pass the buck to C with the code below, which will return // an approximation to the truth that may work well enough to support READ() etc. // It can't identify user-defined types such as records, but assuming a valid // Imp77 program checked by imp77 then the only non-base type we're likely to // receive is %string ... // This is a C11 construct. Unfortunately we can't use gcc's typeof(), as it // returns an actual , not a code or string representing the type, that we could use. // const and volatile types have to be listed explicitly. // I'll skip volatile for now as it barely exists in Imp // types 4 and 9 are not possible with this current implementation #define _imp_typeof(T) _Generic( (T), \ int: 1, \ unsigned int: 1, \ const int: 1, \ const unsigned int: 1, \ float: 2, \ const float: 2, \ _imp_string: 3, \ char *: 3, \ const char *: 3, \ char: 5, \ const char: 5, \ signed char: 5, \ const signed char: 5, \ unsigned char: 5, \ const unsigned char: 5, \ short int: 6, \ const short int: 6, \ unsigned short int: 6, \ const unsigned short int: 6, \ long int: 7, \ const long int: 7, \ unsigned long int: 7, \ const unsigned long int: 7, \ double: 8, \ const double: 8, \ long long int: 11, \ const long long int: 11, \ unsigned long long int: 11, \ const unsigned long long int: 11, \ long double: 12, \ const long double: 12, \ default: 0) // label: 9, // __label__: 9, // const char const *: 3, // char const *: 3, // READ is a perm/prim hybrid. The prim part is that a second parameter // must be passed when a %name is in the parameter list. // fortunately there is no such thing as a simple generic %name variable, // otherwise it would have to be implemented as a struct. // Compiler must generate C that looks like: // READ((_imp_NAME){&fred, SIZEOF(fred), TYPEOF(fred)}); //static inline void READ(_imp_NAME dest) { //} static inline double _imp_FLOAT(double N) { return N; // if FLOAT() is passed an integer, C will promote it to double. // %real in imp is evaluated as double everywhere except when // assigned to a 4-byte memory location. } static inline _imp_address _imp_ADDR(void *P) { return (_imp_address)P; } static inline unsigned char *_imp_BYTE(_imp_address N) { return (unsigned char *)N; } static inline unsigned char *_imp_BYTEINTEGER(_imp_address N) { return (unsigned char *)N; } static inline short *_imp_SHORT(_imp_address N) { return (short *)N; } static inline short *_imp_SHORTINTEGER(_imp_address N) { return (short *)N; } static inline int *_imp_INTEGER(_imp_address N) { return (int *)N; } static inline long *_imp_LONG(_imp_address N) { return (long *)N; } static inline long *_imp_LONGINTEGER(_imp_address N) { return (long *)N; } static inline long long *_imp_LONGLONG(_imp_address N) { return (long long *)N; } static inline long long *_imp_LONGLONGINTEGER(_imp_address N) { return (long long *)N; } static inline long long int _imp_LENGTHENI(int I) { return (long long int) I; } static inline float *_imp_REAL(_imp_address N) { return (float *)N; } static inline double *_imp_LONGREAL(_imp_address N) { return (double *)N; } //static inline long double *LONGLONGREAL(_imp_address N) { // return (long double *)N; //} static inline _imp_string *_imp_STRING(_imp_address N) { return (_imp_string *)N; } static inline void *_imp_RECORD(_imp_address N) { return (void *)N; // Needs compiler support with casting at the point of call... } static inline int _imp_TYPEOF(_imp_NAME N) { // i2c can usually insert this directly without calling the procedure version return N.typeinfo; } static inline int _imp_SIZEOF(_imp_NAME N) { // ditto. return N.sizeinfo; } /* Most math operations have multiple forms depending on the parameter/result type: float powf(float x, float y); double pow(double x, double y); long double powl(long double x, long double y); */ static inline double _imp_ARCSIN(double ANGLE) { return asin(ANGLE); } static inline double _imp_ARCCOS(double ANGLE) { return acos(ANGLE); } static inline double _imp_ARCTAN(double X, double Y) { return atan2(X, Y); } static inline double _imp_ARCTAN1(double ANGLE) { return atan(ANGLE); } static inline double _imp_SIN(double ANGLE) { return sin(ANGLE); } static inline double _imp_COS(double ANGLE) { return cos(ANGLE); } static inline double _imp_TAN(double ANGLE) { return tan(ANGLE); } static inline double _imp_FRACTION(double R) { return R-_imp_TRUNC(R); } static inline double _imp_FRACPT(double R) { return R-_imp_INTPT(R); } static inline int _imp_IMOD(int I) { extern int abs(int j); return abs(I); } static inline double _imp_MOD(double R) { extern double fabs(double x); return fabs(R); } static inline int _imp_INT(double R) { return _imp_INTPT(R+0.5); } static inline int _imp_INTPT(double R) { extern double floor(double x); assert(floor(R) <= R); return (int)floor(R); } // rounds *towards minus infinity* static inline long int _imp_LINT(double R) { return _imp_LINTPT(R+0.5); } static inline long int _imp_LINTPT(double R) { extern double floor(double x); assert(floor(R) <= R); return (long int)floor(R); } static inline int _imp_TRUNC(double R) { extern double trunc(double x); return (int)trunc(R); } // rounds *towards 0* static inline int _imp_ROUND(double R) { return _imp_TRUNC(R < 0.0 ? R-0.5 : R+0.5); } static inline long long int _imp_IEXP(int NUM, int POWER) { int tot = 1; int mul = POWER; while (mul-- > 0) tot *= NUM; return tot; // return (long)exp(NUM, POWER); } static inline double _imp_REXP(double NUM, double POWER) { extern double pow(double x, double y); return POWER==2 ? NUM*NUM : pow(NUM,POWER); } static inline double _imp_LOG(double X) { return log(X); } static inline int _imp_REM(int P, int Q) { return P % Q; } static inline double _imp_SQRT(double NUM) { extern double sqrt(double x); return sqrt(NUM); } static inline int _imp_ISQRT(int NUM) { extern double sqrt(double x); return (int)sqrt(NUM); } static inline int _imp_MULDIV(int A, int B, int C) { return (int) (((long long)A * (long long)B) / (long long)C); } static inline void _imp_PROMPT(_imp_string S) { _imp_promptstr = S; } static inline void _imp_READSYMBOL(int *P) { _imp_readsymbol(P); } static inline void _imp_READCH(int *P) { _imp_readch(P); } static inline int _imp_NEXTSYMBOL(void) { return _imp_nextsymbol(); } static inline int _imp_NEXTCH(void) { return _imp_nextch(); } static inline void _imp_SKIPSYMBOL(void) { _imp_skipsymbol(); } static inline void _imp_PRINTSYMBOL(char SYM) { _imp_printsymbol(SYM); } static inline void _imp_PRINTCH(char SYM) { _imp_printch(SYM); } static inline void _imp_PRINTSTRING(_imp_string S) { _imp_printstring(S); } static inline void _imp_WRITE(int V, int P) { _imp_write(V, P); } // IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt} static inline void _imp_READITEM(_imp_string *S) { _imp_readitem(S); } static inline void _imp_READSTRING(_imp_string *S) { _imp_readstring(S); } static inline void _imp_READTEXT(_imp_string *S, int DELIM) { _imp_readtext(S, DELIM); } static inline _imp_string _imp_NEXTITEM(void) { return _imp_nextitem(); } static inline void _imp_READLINE(_imp_string *S) { _imp_readline(S); } static inline int _imp_INSTREAM(void) { return _imp_InStream; } static inline int _imp_OUTSTREAM(void) { return _imp_OutStream; } static inline int _imp_INPUTSTREAM(void) { return _imp_InStream; } static inline int _imp_OUTPUTSTREAM(void) { return _imp_OutStream; } static inline _imp_string _imp_INPUTNAME(void) { return _imp_infile[_imp_InStream].fname; } static inline _imp_string _imp_OUTPUTNAME(void) { return _imp_outfile[_imp_OutStream].fname; } static inline _imp_string _imp_INFILENAME(void) { return _imp_infile[_imp_InStream].fname; } static inline _imp_string _imp_OUTFILENAME(void) { return _imp_outfile[_imp_OutStream].fname; } static inline void _imp_SELECTINPUT(int N) { if (N < 0) return; _imp_InStream = N; _imp_INFILE = _imp_infile[N].f; } static inline void _imp_SELECTOUTPUT(int N) { if (N < 0) return; _imp_OutStream = N; _imp_OUTFILE = _imp_outfile[N].f; } static inline void _imp_OPENINPUT(int N, _imp_string FD) { _imp_openinput(N, FD); } static inline void _imp_OPENOUTPUT(int N, _imp_string FD) { _imp_openoutput(N, FD); } static inline void _imp_OPENBINARYINPUT(int N, _imp_string FD) { _imp_openinput(N, FD); } static inline void _imp_OPENBINARYOUTPUT(int N, _imp_string FD) { _imp_openoutput(N, FD); } static inline void _imp_DEFINEINPUT(int I, _imp_string SPEC) { _imp_OPENINPUT(I, SPEC); } static inline void _imp_DEFINEOUTPUT(int I, _imp_string SPEC) { _imp_OPENOUTPUT(I, SPEC); } static inline void _imp_ABANDONINPUT(void) { _imp_abandoninput(); } static inline void _imp_ABANDONOUTPUT(void) { _imp_abandonoutput(); } static inline void _imp_CLOSEINPUT(void) { _imp_closeinput(); } static inline void _imp_CLOSEOUTPUT(void) { _imp_closeoutput(); } static inline void _imp_RESETINPUT(void) { fseek(_imp_infile[_imp_InStream].f, 0L, SEEK_SET); } static inline void _imp_RESETOUTPUT(void) {} static inline void _imp_COMPLETEINPUT(void) {} static inline void _imp_COMPLETEOUTPUT(void) {} static inline void _imp_POSITIONINPUT(int P) { _imp_SETINPUT(P); } static inline void _imp_POSITIONOUTPUT(int P) { _imp_SETOUTPUT(P); } // seek/tell static inline void _imp_SETINPUT(int P) { fseek (_imp_INFILE, P, SEEK_SET); } static inline void _imp_SETOUTPUT(int P) { fseek (_imp_OUTFILE, P, SEEK_SET); } static inline void _imp_INPUTPOSITION(void) {} static inline void _imp_OUTPUTPOSITION(void) {} static inline int _imp_ENDOFINPUT(void) { return 0; /*TO DO*/} static inline void _imp_SPACE(void) { _imp_space(); } static inline void _imp_SPACES(int N) { _imp_spaces(N); } static inline void _imp_NEWPAGE(void) { _imp_newpage(); } static inline void _imp_NEWLINE(void) { _imp_newline(); } static inline void _imp_NEWLINES(int N) { _imp_newlines(N); } static inline void _imp_READ_name(void *PTR, int PTR_typeof) { /*TO DO*/ } static inline void _imp_PRINT(double R, int BEFORE, int AFTER) { _imp_print(R, BEFORE, AFTER); } // IMPORTANT: See https://gtoal.com/imp77/reference-manual/IO-LIBRARY-EXPERIMENTS.{imp,txt} static inline void _imp_PRINTFLOATING(double R, int A, int B) { _imp_printfloating(R, A, B); } static inline void _imp_PRINTFL(double R, int PLACES) { _imp_printfl(R, PLACES); } // TOUPPER // TOLOWER static inline _imp_string _imp_SUBSTRING(_imp_string S, int FROM, int TO) { return _imp_substring(S, FROM, TO); } static inline _imp_string _imp_FROMSTRING(_imp_string S, int FROM, int TO) { return _imp_substring(S, FROM, TO); } static inline _imp_string _imp_TRIM(_imp_string S, int MAX) { return _imp_trim(S, MAX); } static inline _imp_string _imp_TIME(void) { return _imp_time(); } static inline _imp_string _imp_DATE(void) { return _imp_date(); } static inline int _imp_CPUTIME(void) { return _imp_cputime(); } static inline _imp_string _imp_CLIPARAM(void) { return _imp_cliparam(); } // FREESTORE static inline int _imp_EVENT_(void) { // historical clash of names. This is a workaround! return _imp_Event.EVENT; } // I'm on the verge of making Imp's EVENT record a %primrecord(EVENT FM)%function ... // macro version is not invoked for EVENT.ETC - if _imp_EVENT is not followed by // brackets, the struct is used. If it is, _imp_EVENT_(n) is returned instead. // None of this is ideal and it's ugly and messy. I think I just need to bite the // bullet and do away with the old-style integer EVENT which is now EVENT_EVENT. //#define _imp_EVENT(n) _imp_EVENT_(n) static inline eventfm _imp_EVENT(void) { return _imp_Event; } static inline int _imp_EVENTNO(void) { return _imp_Event.EVENT; } static inline int _imp_SUBEVENT(void) { return _imp_Event.SUBEVENT; } static inline int _imp_EVENTINFO(void) { return _imp_Event.EXTRA; } static inline _imp_string _imp_EVENTMESSAGE(void) { return _imp_Event.MESSAGE; } static inline _imp_string _imp_ITOS(int I, int P) { return _imp_itos(I, P); } // there are some other calls like ITOS I think. (Also check re ITOS2/ITOS) static inline _imp_string _imp_SSFMESSAGE(void) { return _imp_c2istr(strerror(errno)); } //extern void _imp_fault(const char *format, ...); // calls generated by the compiler. Not for users. //extern void _imp_warn(const char *format, ...); #ifdef NEVER static inline int _u(int I, int line) { if (I == 0xfefefefe) { _imp_signal(5,0,line,"Unassigned variable"); } return I; } #endif // More Imp to C support still to be be added here too, such as _imp_onevent() etc. // See perms.c from imptoc project for details. #ifndef PARM_OPT extern int __attribute__ ((noinline)) _imp_rcheck1d(int ix, int low, int high, char *arrayname); extern int __attribute__ ((noinline)) _imp_ucheck_int(int v, char *vs); #define _R(ix, low, high, vs) _imp_rcheck1d(ix, low, high, vs) // because this is inserted into machine generated code, // we know that 'v' will always be an atom, not an expression: //#define _U(v) _imp_ucheck_int(v, #v) #define _U(v) ((typeof(v))_imp_ucheck_int(v, #v)) #else //#ifndef IN_PERMS_C //#pragma message "This code has been compiled without runtime checks. Remove -DPARM_OPT to enable them." //#endif #define _R(ix, low, high, vs) (ix) #define _U(v) (v) #endif // PARM_OPT #endif // __IMP_PERMS__