#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. // and I am struggling with calling the linux C library from Imp77... // (see stdlib.inc for testing and examples) #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 = {.charno = {1, '\n'} }; return SNL; } static inline double _imp_PI(void) { return 3.141592653589793238462; } // 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_closestream(int str); 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 void _imp_printfhex(double R); 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); static inline _imp_string *_imp_strdup(_imp_string s); 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); #define _imp_SIZEOF(ptr) (sizeof(*(ptr))) 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 /* Perms from the earliest Imp compiler (allimpc1): SELECTINPUT SELECTOUTPUT NEWLINE SPACE SKIPSYMBOL RUNOUT NEWLINES SPACES NEXTSYMBOL PRINTSYMBOL READSYMBOL READ WRITE NEWPAGE ADDR ARCSIN INT INTPT FRACPT PRINT PRINTFL REAL INTEGER MOD ARCCOS SQRT LOG SIN COS TAN EXP MAPRECORD BYTEINTEGER SHORTINTEGER RADIUS ARCTAN PARITY PRINTSTRING NL LONGREAL PRINTCH READCH STRING Unimplemented ones are: runout (paper tape, can ignore!) maprecord (probably old name for RECORD()) radius (sqrt(a^2+b^2) parity So... *might* want to implement RADIUS() and PARITY()??? */ 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_CLOSESTREAM(int stream); 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 void _imp_PRINTFHEX(double R); 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_string _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 int _ur(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) { // TO DO: check 0 <= i <= LENGTH(str) 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_strdup(_imp_string s) { _imp_string *heap = malloc(sizeof(_imp_string)); // TO DO: instead of copying max size, copy actual length memmove(heap, &s, sizeof(_imp_string)); return heap; } //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 int unassigned_string(_imp_string *s) { return (s->charno[0] = s->charno[1]) && (memcmp(&s->charno[0], &s->charno[1], 255) == 0); } static inline _imp_string _imp_join(_imp_string left, _imp_string right) { _imp_string joined; if (unassigned_string(&left)) { // TO DO: make into a signal fprintf(stderr, "UNASSIGNED STRING in left operand of string concatenation in %s line %d\n", _imp_current_file, _imp_current_line); exit(1); // short-term error message. Needs _imp_signal. *TO DO* } if (unassigned_string(&right)) { // TO DO: make into a signal fprintf(stderr, "UNASSIGNED STRING in right operand of string concatenation in %s line %d\n", _imp_current_file, _imp_current_line); exit(1); // short-term error message. Needs _imp_signal. *TO DO* } int combined_length = *_imp_LENGTH(&left)+*_imp_LENGTH(&right); if (combined_length > 255) { // TO DO: make into a signal fprintf(stderr, "STRING CAPACITY EXCEEDED: \"%s\".\"%s\"\n", _imp_i2cstr(&left), _imp_i2cstr(&right)); exit(1); // short-term error message. Needs _imp_signal. *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 SUB/*EVENT*/; int INFO/*EXTRA*/; // Below this line are for internal use only. Not to be accessed by user programs. _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, IMPSIGOVERFLOW = 1, /* 'OVERFLOW' gave a name clash on older gcc on 32 bit ARM. This enum isn't used yet anyway. */ STOREEXCEEDED = 2, CONVERSIONERROR = 4, ARGUMENTERROR = 5, RANGEERROR = 6, STRINGRESOLUTIONFAILS = 7, UNDEFINEDVALUE = 8, INPUTENDED = 9, IOERROR = 10, JUMPOUT = 11, USEREVENT = 12, }; extern int handler_at_this_level; extern void sig_handler(int signo); #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; \ if (signal(SIGSEGV, sig_handler) == SIG_ERR) {printf("\nCan't catch SIGSEGV\n");} \ if (signal(SIGFPE, sig_handler) == SIG_ERR) {printf("\nCan't catch SIGFPE\n");} \ if (signal(SIGILL, sig_handler) == SIG_ERR) {printf("\nCan't catch SIGILL\n");} \ setjmp(this_handler.env) && _imp_caught_on_event(_imp_Event.EVENT,__VA_ARGS__,-1); \ } ) // Unfortunately to work portably, imp backtrace 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) // 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(_imp_string file, int line, _imp_string message, 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(_imp_current_file ? _imp_c2istr(_imp_current_file) : _imp_str_literal(__FILE__), _imp_current_line ? _imp_current_line : __LINE__, _imp_c2istr(D), A,B,C) #define signal_event(E,S,X) _signal_event(_imp_current_file ? _imp_c2istr(_imp_current_file) : _imp_str_literal(__FILE__), _imp_current_line ? _imp_current_line : __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; } //%record(*)%map NEW(%name v) *** This is a tricky one and may need some work. #define _imp_NEW(var) ((typeof(var))malloc(sizeof(*(var)))) //%routine DISPOSE(%name v) #define _imp_DISPOSE(var) free(var) 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; } /* 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 void _imp_SETSTREAMS(void) { /* To do - not a serious implementation yet. */ // Just enough to get layout.imp from the Dec10 running! _imp_OPENOUTPUT(2, _imp_str_literal("/dev/stdout")); } static inline int _imp_INSTREAM(void) { return _imp_InStream; } static inline int _imp_OUTSTREAM(void) { return _imp_OutStream; } static inline int _imp_OUTDEV(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_CLOSESTREAM(int stream) { _imp_closestream(stream); } /* EMAS */ 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); } static inline void _imp_PRINTFHEX(double R) { _imp_printfhex(R); } // 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_FREESTORE(void) { return 0x8000; } // made up value for old Imp15 programs. Could do a real number for modern linux. 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.SUB/*EVENT*/; } static inline int _imp_EVENTINFO(void) { return _imp_Event.INFO/*EXTRA*/; } static inline _imp_string _imp_EVENTMESSAGE(void) { if (_imp_Event.MESSAGE == 0/*NULL*/) return _imp_str_literal(""); return *_imp_Event.MESSAGE; } static inline int _imp_EVENTLINE(void) { return _imp_Event.LINE; } static inline _imp_string _imp_EVENTFILE(void) { if (_imp_Event.FILE == 0/*NULL*/) return _imp_str_literal(""); return *_imp_Event.FILE; } 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, ...); #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); extern double __attribute__ ((noinline)) _imp_urcheck_double(double v, char *vs); extern int __attribute__ ((noinline)) _imp_zcheck_int(int v, char *vs); extern int __attribute__ ((noinline)) _imp_zcheck_double(double 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)) #define _UR(v) ((typeof(v))_imp_urcheck_double(v, #v)) #define _Z(v) ((typeof(v))_imp_zcheck_int(v, #v)) #define _ZR(v) ((typeof(v))_imp_zcheck_double(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) #define _UR(v) (v) #define _Z(v) (v) #endif // PARM_OPT #endif // __IMP_PERMS__