home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progpas / pxsc.arj / P88RTS.H < prev    next >
Text File  |  1991-03-12  |  21KB  |  602 lines

  1. /* file: p88rts.h
  2.  * Header File of the PASCAL 88 to C runtime system
  3. {*  last modification:  18.02.91  11:57   }
  4.  * uli 05.02.91: s_ixcn defined.
  5.  * uli 05.02.91: tp_000 is no longer static.
  6.  * uli 18.02.91: tp_000 is extern now.
  7. */
  8.  
  9. #define LINT_ARGS /* new-style prototyping */
  10.  
  11. #define IBMva     /* IBM style variable argument lists */
  12.  
  13.  
  14. #define a_RETC 0  /* value returned by main (default) */
  15.  
  16. /*---------------------------------------------------*/
  17. /*  global pointer variable, used by var-traversing  */
  18. /*---------------------------------------------------*/
  19. extern char *tp_000;
  20.  
  21. /*----------------------------------------------*/
  22. /* Number of characters forming a set value     */
  23. /*----------------------------------------------*/
  24. #define s_SIZE          32
  25.  
  26.  
  27. /*--------------------------------------*/
  28. /*   standard data types of Pascal-SC   */
  29. /*--------------------------------------*/
  30. typedef unsigned char a_byte ;
  31.  
  32. #ifdef LINT_ARGS
  33. typedef void * a_VOID ;
  34. #else
  35. typedef char * a_VOID ;
  36. #endif
  37.  
  38. typedef long int        a_intg ;   /* adjust a_imax, if you modify a_intg */
  39. typedef double          a_real ;
  40. typedef unsigned char   a_char ;
  41. typedef a_byte          a_bool ;
  42. typedef unsigned long   a_btyp ;
  43.  
  44. typedef struct s_trng { char *ptr;
  45.             size_t alen;
  46.             size_t clen;
  47.             unsigned int fix  : 1;
  48.             unsigned int suba : 1;
  49.             unsigned int tmp  : 1; } s_trng;
  50. typedef a_char          s_etof [s_SIZE];
  51. typedef a_btyp   *      d_otpr ;
  52. typedef struct a_cmpx { a_real RE , IM; } a_cmpx ;
  53. typedef struct a_intv { a_real INF, SUP;} a_intv ;
  54. typedef struct a_cinv { a_intv RE , IM ;} a_cinv ;
  55.  
  56.  
  57. /*----------------------------------------*/
  58. /*   error handling, exception handling   */
  59. /*----------------------------------------*/
  60. extern int e_line ;
  61. #ifdef LINT_ARGS
  62. #ifdef IBMva
  63. extern void e_trap () ;
  64. #else
  65. extern void e_trap (a_btyp code, int e_argc, ...) ;
  66. #endif
  67. extern void e_push (char * functionname, char * filename) ;
  68. extern void e_popp (void) ;
  69. #else
  70. extern void e_trap () ;
  71. extern void e_push ( ) ;
  72. extern void e_popp ( ) ;
  73. #endif
  74.  
  75.  
  76. /*-------------------------------------*/
  77. /*   standard constants of Pascal-SC   */
  78. /*-------------------------------------*/
  79. #define a_true 1
  80. #define a_flse 0
  81. #define a_imax 0x7fffffff      /* = MAXINT */
  82.  
  83. /*--------------------------*/
  84. /* Real constant conversion */
  85. /*--------------------------*/
  86.  
  87. #ifdef LINT_ARGS
  88. extern a_real r_cnst (a_char*) ;
  89. #else
  90. extern a_real r_cnst () ;
  91. #endif
  92.  
  93.  
  94. /*-----------------------*/
  95. /*   Memory management   */
  96. /*-----------------------*/
  97. #define a_asgn(s1,s2,c)    memcpy((s1),(s2),(c))
  98. #define a_clrm(s,c)        memset((s),0,(c))
  99. #ifdef LINT_ARGS
  100. extern a_VOID  a_lloc (size_t) ;   /* malloc + errorhandling */
  101. extern void    a_free (char **) ;  /* free + errorhandling   */
  102. #else
  103. extern a_VOID  a_lloc () ;
  104. extern void    a_free () ;
  105. #endif
  106.  
  107. /*--------------------*/
  108. /*   Set Operations   */
  109. /*--------------------*/
  110. #ifdef LINT_ARGS
  111. extern a_bool  s_etin (a_intg, s_etof) ;                /* operator "in" */
  112. extern a_VOID /* s_etof */  s_zero (s_etof) ;     /* empty set constructor [] */
  113. #ifdef IBMva
  114. extern a_VOID /* s_etof */  s_cons () ;           /* set constructor */
  115. #else
  116. extern a_VOID   s_cons (s_etof res, a_char * ctrl,...);   /* set constructor */
  117. #endif
  118.  
  119. extern a_VOID /* s_etof */  s_add (s_etof, s_etof, s_etof); /* set = set + set */
  120. extern a_VOID /* s_etof */  s_sub (s_etof, s_etof, s_etof); /* set = set - set */
  121. extern a_VOID /* s_etof */  s_mul (s_etof, s_etof, s_etof); /* set = set * set */
  122. extern a_bool  s_eteq (s_etof, s_etof);                   /* set == set */
  123. extern a_bool  s_etne (s_etof, s_etof);                   /* set != set */
  124. extern a_bool  s_etge (s_etof, s_etof);                   /* set >= set */
  125. extern a_bool  s_etgt (s_etof, s_etof);                   /* set >  set */
  126. extern a_bool  s_etle (s_etof, s_etof);                   /* set <= set */
  127. extern a_bool  s_etlt (s_etof, s_etof);                   /* set <  set */
  128.  
  129. #else
  130. extern a_bool  s_etin () ;                      /* operator "in" */
  131. extern a_VOID  s_zero () ;                      /* empty set constructor [] */
  132. extern a_VOID  s_cons () ;                      /* set constructor */
  133.  
  134. extern a_VOID /* s_etof */ s_add ();            /* set = set + set */
  135. extern a_VOID /* s_etof */ s_sub ();            /* set = set - set */
  136. extern a_VOID /* s_etof */ s_mul ();            /* set = set * set */
  137. extern a_bool  s_eteq ();                       /* set == set */
  138. extern a_bool  s_etne ();                       /* set != set */
  139. extern a_bool  s_etge ();                       /* set >= set */
  140. extern a_bool  s_etgt ();                       /* set >  set */
  141. extern a_bool  s_etle ();                       /* set <= set */
  142. extern a_bool  s_etlt ();                       /* set <  set */
  143.  
  144. #endif
  145.  
  146.  
  147. /*-----------------------*/
  148. /*   String Operations   */
  149. /*-----------------------*/
  150. #define s_inxn( s, i)  (*((s).ptr + (i) - 1))     /* index access without check */
  151. #define s_asta( d, s, l)  s_asgn ((s_trng*)(d), s_stat ((s), (l)))
  152.                   /* assigns a static array to a dynamic array */
  153. #ifdef LINT_ARGS
  154. extern a_intg s_ixch (a_intg index, size_t length) ;
  155. extern a_char * s_inxc (s_trng, a_intg) ;         /* index access with check */
  156.     /*   (*((s).ptr + s_ixch((i),(s).alen)))   */
  157.     /* s_inxc must not be a macro, because the string variable s may */
  158.     /*   contain indices with function calls.  */
  159.     /* s_inxc must return a pointer, because it must be a left-value. */
  160. extern a_char * s_ixcn (s_trng*, a_intg) ;        /* index access with check */
  161.     /* s_ixcn must have a var parameter, because "resize" might be necessary */
  162.  
  163. extern a_bool  s_aaeq (a_char[], a_intg, a_char[], a_intg );
  164. extern a_bool  s_aceq (a_char[], a_intg, a_char   );
  165. extern a_bool  s_caeq (a_char          , a_char[], a_intg );
  166. extern a_bool  s_aane (a_char[], a_intg, a_char[], a_intg );
  167. extern a_bool  s_acne (a_char[], a_intg, a_char   );
  168. extern a_bool  s_cane (a_char          , a_char[], a_intg );
  169. extern a_bool  s_aage (a_char[], a_intg, a_char[], a_intg );
  170. extern a_bool  s_acge (a_char[], a_intg, a_char   );
  171. extern a_bool  s_cage (a_char          , a_char[], a_intg );
  172. extern a_bool  s_aagt (a_char[], a_intg, a_char[], a_intg );
  173. extern a_bool  s_acgt (a_char[], a_intg, a_char   );
  174. extern a_bool  s_cagt (a_char          , a_char[], a_intg );
  175. extern a_bool  s_aale (a_char[], a_intg, a_char[], a_intg );
  176. extern a_bool  s_acle (a_char[], a_intg, a_char   );
  177. extern a_bool  s_cale (a_char          , a_char[], a_intg );
  178. extern a_bool  s_aalt (a_char[], a_intg, a_char[], a_intg );
  179. extern a_bool  s_aclt (a_char[], a_intg, a_char   );
  180. extern a_bool  s_calt (a_char          , a_char[], a_intg );
  181.  
  182. extern a_bool  s_sseq (s_trng, s_trng);
  183. extern a_bool  s_sceq (s_trng, a_char);
  184. extern a_bool  s_cseq (a_char, s_trng );
  185. extern a_bool  s_ssne (s_trng, s_trng );
  186. extern a_bool  s_scne (s_trng, a_char);
  187. extern a_bool  s_csne (a_char, s_trng );
  188. extern a_bool  s_ssge (s_trng, s_trng );
  189. extern a_bool  s_scge (s_trng, a_char);
  190. extern a_bool  s_csge (a_char, s_trng );
  191. extern a_bool  s_ssgt (s_trng, s_trng );
  192. extern a_bool  s_scgt (s_trng, a_char);
  193. extern a_bool  s_csgt (a_char, s_trng );
  194. extern a_bool  s_ssle (s_trng, s_trng );
  195. extern a_bool  s_scle (s_trng, a_char);
  196. extern a_bool  s_csle (a_char, s_trng );
  197. extern a_bool  s_sslt (s_trng, s_trng );
  198. extern a_bool  s_sclt (s_trng, a_char);
  199. extern a_bool  s_cslt (a_char, s_trng );
  200. extern void    s_vlcp (s_trng *);
  201. extern void    s_utmp (s_trng *);
  202. extern void    s_temp (s_trng *);
  203. extern s_trng  s_stat (a_char [], a_intg);
  204. extern void    s_init (s_trng *,size_t);
  205. extern void    s_free (s_trng *);
  206. extern s_trng  s_conc (s_trng, s_trng);
  207. extern s_trng  s_char (a_char);
  208. extern void    s_asgn (s_trng *,s_trng);
  209. #else
  210. /* not LINT_ARGS */
  211. extern a_intg  s_ixch () ;
  212. extern a_char *s_inxc ();
  213. extern a_char *s_ixcn () ;
  214. extern a_bool  s_aaeq ();
  215. extern a_bool  s_aceq ();
  216. extern a_bool  s_caeq ();
  217. extern a_bool  s_aane ();
  218. extern a_bool  s_acne ();
  219. extern a_bool  s_cane ();
  220. extern a_bool  s_aage ();
  221. extern a_bool  s_acge ();
  222. extern a_bool  s_cage ();
  223. extern a_bool  s_aagt ();
  224. extern a_bool  s_acgt ();
  225. extern a_bool  s_cagt ();
  226. extern a_bool  s_aale ();
  227. extern a_bool  s_acle ();
  228. extern a_bool  s_cale ();
  229. extern a_bool  s_aalt ();
  230. extern a_bool  s_aclt ();
  231. extern a_bool  s_calt ();
  232.  
  233. extern a_bool  s_sseq ();
  234. extern a_bool  s_sceq ();
  235. extern a_bool  s_cseq ();
  236. extern a_bool  s_ssne ();
  237. extern a_bool  s_scne ();
  238. extern a_bool  s_csne ();
  239. extern a_bool  s_ssge ();
  240. extern a_bool  s_scge ();
  241. extern a_bool  s_csge ();
  242. extern a_bool  s_ssgt ();
  243. extern a_bool  s_scgt ();
  244. extern a_bool  s_csgt ();
  245. extern a_bool  s_ssle ();
  246. extern a_bool  s_scle ();
  247. extern a_bool  s_csle ();
  248. extern a_bool  s_sslt ();
  249. extern a_bool  s_sclt ();
  250. extern a_bool  s_cslt ();
  251. extern void    s_vlcp ();
  252. extern void    s_utmp ();
  253. extern void    s_temp ();
  254. extern s_trng  s_stat ();
  255. extern void    s_init ();
  256. extern void    s_free ();
  257. extern s_trng  s_conc ();
  258. extern s_trng  s_char ();
  259. extern void    s_asgn ();
  260. #endif
  261. /* end   not LINT_ARGS */
  262.  
  263. /*-------------------------------------*/
  264. /*   Scalar product for static arrays  */
  265. /*-------------------------------------*/
  266. #ifdef LINT_ARGS
  267. extern a_real  r_scps (a_real x[], a_real y[], a_intg size, a_intg rdmode) ;
  268. #else
  269. extern a_real  r_scps () ;
  270. #endif
  271.  
  272. /*------------------------------*/
  273. /*  dotprecision routines       */
  274. /*------------------------------*/
  275. #ifdef LINT_ARGS
  276. extern void d_init (d_otpr * ) ;
  277. extern void d_vlcp (d_otpr * ) ;
  278. extern void d_free (d_otpr * ) ;
  279. extern void d_temp (d_otpr * ) ;
  280. extern void d_utmp (d_otpr * ) ;
  281. #else
  282. extern void d_init () ;
  283. extern void d_vlcp () ;
  284. extern void d_free () ;
  285. extern void d_temp () ;
  286. extern void d_utmp () ;
  287. #endif
  288.  
  289. /*------------------------------*/
  290. /*  routines for #-expressions  */
  291. /*------------------------------*/
  292.  
  293. #ifdef LINT_ARGS
  294. void         c_cadd(d_otpr *cr,d_otpr *ci,a_cmpx a);
  295. void         c_csub(d_otpr *cr,d_otpr *ci,a_cmpx a);
  296. void         c_padd(d_otpr *cr,d_otpr *ci,a_cmpx a,a_cmpx b);
  297. void         c_psub(d_otpr *cr,d_otpr *ci,a_cmpx a,a_cmpx b);
  298. void         c_rcad(d_otpr *cr,d_otpr *ci,a_real a,a_cmpx b);
  299. void         c_rcsb(d_otpr *cr,d_otpr *ci,a_real a,a_cmpx b);
  300. a_cmpx       c_stad(d_otpr cr,d_otpr ci);
  301. a_cmpx       c_stan(d_otpr cr,d_otpr ci);
  302. a_cmpx       c_stau(d_otpr cr,d_otpr ci);
  303. void         d_ass(d_otpr *a,d_otpr b);
  304. void         d_clr(d_otpr *a);
  305. void         d_dadd(d_otpr *a,d_otpr b);
  306. void         d_dsub(d_otpr *a,d_otpr b);
  307. a_bool       d_eq(d_otpr a,d_otpr b);
  308. void         d_free(d_otpr *a);
  309. a_bool       d_ge(d_otpr a,d_otpr b);
  310. a_bool       d_gt(d_otpr a,d_otpr b);
  311. void         d_init(d_otpr *a);
  312. a_bool       d_le(d_otpr a,d_otpr b);
  313. a_bool       d_lt(d_otpr a,d_otpr b);
  314. a_bool       d_ne(d_otpr a,d_otpr b);
  315. void         d_padd(d_otpr *c,a_real a,a_real b);
  316. void         d_psub(d_otpr *c,a_real a,a_real b);
  317. void         d_radd(d_otpr *c,a_real a);
  318. void         d_rsub(d_otpr *c,a_real a);
  319. a_real       d_stad(d_otpr a);
  320. a_real       d_stan(d_otpr a);
  321. a_real       d_stau(d_otpr a);
  322. void         i_iadd(d_otpr *cl,d_otpr *cu,a_intv a);
  323. a_intv       i_ista(d_otpr cl,d_otpr cu);
  324. void         i_isub(d_otpr *cl,d_otpr *cu,a_intv a);
  325. void         i_padd(d_otpr *cl,d_otpr *cu,a_intv a,a_intv b);
  326. void         i_psub(d_otpr *cl,d_otpr *cu,a_intv a,a_intv b);
  327. void         i_riad(d_otpr *cl,d_otpr *cu,a_real a,a_intv b);
  328. void         i_risb(d_otpr *cl,d_otpr *cu,a_real a,a_intv b);
  329. void         z_ciad(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cmpx a,a_intv b);
  330. void         z_cisb(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cmpx a,a_intv b);
  331. void         z_czad(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cmpx a,a_cinv b);
  332. void         z_czsb(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cmpx a,a_cinv b);
  333. void         z_izad(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_intv a,a_cinv b);
  334. void         z_izsb(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_intv a,a_cinv b);
  335. void         z_padd(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cinv a,a_cinv b);
  336. void         z_psub(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cinv a,a_cinv b);
  337. void         z_rzad(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_real a,a_cinv b);
  338. void         z_rzsb(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_real a,a_cinv b);
  339. void         z_zadd(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cinv a);
  340. a_cinv       z_zsta(d_otpr crl,d_otpr cil,d_otpr cru,d_otpr ciu);
  341. void         z_zsub(d_otpr *crl,d_otpr *cil,d_otpr *cru,d_otpr *ciu,a_cinv a);
  342. #else
  343. a_cinv       z_zsta();
  344. a_cmpx       c_stad(), c_stan(), c_stau();
  345. a_intv       i_ista();
  346. a_real       d_stad(), d_stan(), d_stau();
  347. a_bool       d_eq(),   d_ge(),   d_gt(),   d_le(),   d_lt(),   d_ne();
  348. void         c_cadd(), c_csub(), c_padd(), c_psub(), c_rcad(), c_rcsb(),
  349.          d_ass(),  d_clr(),  d_dadd(), d_dsub(), d_free(), d_init(),
  350.          d_padd(), d_psub(), d_radd(), d_rsub(), i_iadd(), i_isub(),
  351.          i_padd(), i_psub(), i_riad(), i_risb(), z_ciad(), z_cisb(),
  352.          z_czad(), z_czsb(), z_izad(), z_izsb(), z_padd(), z_psub(),
  353.          z_rzad(), z_rzsb(), z_zadd(), z_zsub();
  354. #endif
  355.  
  356.  
  357. /*--------------------*/
  358. /*   Runtime Checks   */
  359. /*--------------------*/
  360. #ifdef LINT_ARGS
  361. extern a_btyp a_ixch (a_intg index, a_intg lb, a_intg ub) ;   /* Index Check */
  362.                                /* returns index - lb */
  363. extern a_VOID a_nilc (a_VOID pointer) ;                     /* Pointer Check */
  364.                               /* returns pointer */
  365. #else
  366. extern a_btyp a_ixch ( ) ;
  367. extern a_VOID a_nilc ( ) ;
  368. #endif
  369.  
  370.  
  371. /*--------------------*/
  372. /*   Dynamic Arrays   */
  373. /*--------------------*/
  374.                        /* Array descriptor */
  375. typedef struct {
  376.      a_intg lbound, ubound;
  377.      size_t stride ;
  378.     }   y_bnds ;
  379. #define y_arof( typ, dim) \
  380.    struct                 \
  381.     {  typ   * array ;    \
  382.        a_byte  subarr ;   \
  383.        a_byte  destroy ;  \
  384.        a_byte  numdim ;   \
  385.        size_t  elsize ;   \
  386.        size_t  elnum ;    \
  387.        y_bnds  fd [dim] ; \
  388.     }
  389.  
  390. #ifdef LINT_ARGS
  391.  
  392. /* #define  descrtype   y_arof (void, 255) */
  393. typedef  y_arof (void, 255)   y_desc ;
  394. /* The typedef may cause an error message */
  395. typedef  y_desc descrtype ;
  396.  
  397.                         /* Stride initialization */
  398. extern void y_init (y_desc * d, a_byte dim, size_t elsize) ;
  399. extern void y_free (y_desc * d) ;
  400. #else
  401. /* #define  descrtype   y_arof (char, 255) */
  402. typedef  y_arof(char, 255)   y_desc ;
  403. typedef  y_desc descrtype ;
  404.  
  405. extern void y_init () ;
  406. extern void y_free () ;
  407. #endif
  408.  
  409. #define y_lbnd(d,n)  ((d)->fd[(n)-1].lbound)
  410. #define y_ubnd(d,n)  ((d)->fd[(n)-1].ubound)
  411.  
  412.                        /* Array access without indexcheck*/
  413. #define y_inx1( d, i)                                  \
  414.  (*( (d).array + ((i) - (d).fd[0].lbound) * (d).fd[0].stride \
  415.   ))                                                   /* vector */
  416. #define y_inx2( d, i, j)                               \
  417.  (*( (d).array + ((i) - (d).fd[0].lbound) * (d).fd[0].stride \
  418.            + ((j) - (d).fd[1].lbound) * (d).fd[1].stride \
  419.   ))                                                   /* matrix */
  420. #define y_inx3( d, i, j, k)                            \
  421.  (*( (d).array + ((i) - (d).fd[0].lbound) * (d).fd[0].stride \
  422.            + ((j) - (d).fd[1].lbound) * (d).fd[1].stride \
  423.            + ((k) - (d).fd[2].lbound) * (d).fd[2].stride \
  424.   ))                                                   /* tensor */
  425.   /* later, if a dynamic array may be component variable, then */
  426.   /*  side effects in d become dangerous. d has to be a value parameter. */
  427.  
  428.  
  429.                        /* Array access with indexcheck*/
  430. #define y_ixc1( d, i)       \
  431.  (*((d).array + y_ixch ((i), (d).fd[0]) ))             /* vector */
  432. #define y_ixc2( d, i, j)    \
  433.  (*((d).array + y_ixch ((i), (d).fd[0]) + y_ixch ((j), (d).fd[1]) ))
  434.                                /* matrix */
  435. #define y_ixc3( d, i, j, k) \
  436.  (*((d).array + y_ixch ((i), (d).fd[0]) + y_ixch ((j), (d).fd[1]) \
  437.           + y_ixch ((k), (d).fd[2]) ))             /* tensor */
  438.  
  439.  
  440. /*   Array access for #-expressions    */
  441.  
  442.                        /* Array access without indexcheck*/
  443. #define y_ynx1( d, i)                                  \
  444.  (*( (d).array + ((i)) * (d).fd[0].stride \
  445.   ))                                                   /* vector */
  446. #define y_ynx2( d, i, j)                               \
  447.  (*( (d).array + ((i) ) * (d).fd[0].stride \
  448.            + ((j) ) * (d).fd[1].stride \
  449.   ))                                                   /* matrix */
  450. #define y_ynx3( d, i, j, k)                            \
  451.  (*( (d).array + ((i) ) * (d).fd[0].stride \
  452.            + ((j) ) * (d).fd[1].stride \
  453.            + ((k) ) * (d).fd[2].stride \
  454.   ))                                                   /* tensor */
  455.   /* later, if a dynamic array may be component variable, then */
  456.   /*  side effects in d become dangerous. d has to be a value parameter. */
  457.  
  458.  
  459.                        /* Array access with indexcheck*/
  460. #define y_yxc1( d, i) \
  461.  (*((d).array + y_yxch ((i), (d).fd[0]) ))              /* vector */
  462. #define y_yxc2( d, i, j) \
  463.  (*((d).array + y_yxch ((i), (d).fd[0]) + y_yxch ((j), (d).fd[1]) ))
  464.                             /* matrix */
  465. #define y_yxc3( d, i, j, k) \
  466.  (*((d).array + y_yxch ((i), (d).fd[0]) + y_yxch ((j), (d).fd[1]) \
  467.           + y_yxch ((k), (d).fd[2]) ))              /* tensor */
  468.  
  469. #ifdef LINT_ARGS
  470.                        /* Index check */
  471. extern a_btyp y_ixch (a_intg index, y_bnds bounds) ;
  472. extern a_btyp y_yxch (a_intg index, y_bnds bounds) ;
  473.                        /* Dynamic array assignment */
  474. extern void y_asgn (y_desc * target, y_desc * source) ;
  475. extern void y_vlcp (y_desc * ) ;
  476. extern void y_temp (y_desc * ) ;
  477. extern void y_utmp (y_desc * ) ;
  478.  
  479.  
  480. #ifdef IBMva
  481. extern a_VOID y_inxn( ) ;
  482. extern a_VOID y_ixcn( ) ;
  483. extern a_VOID y_suba( ) ;
  484. extern a_VOID y_stat( ) ;
  485. extern a_VOID y_ynxn( ) ;
  486. extern a_VOID y_yxcn( ) ;
  487.  
  488. #else
  489.                        /*--------------*/
  490.                        /* Array access */
  491. extern a_VOID y_inxn (y_desc * ,...) ; /*  without Index check */
  492. extern a_VOID y_ixcn (y_desc * ,...) ; /*  with Index check */
  493.  
  494.                        /* Subarray access: */
  495.                        /* Subarray descriptor generation */
  496. extern a_VOID y_suba (y_desc * md, y_desc * sd,
  497.               a_char * mode ,... ) ;
  498.  
  499.                        /* convert static to dynamic array */
  500. extern a_VOID y_stat (y_desc * d, a_VOID statarray, size_t elsize,
  501.               a_byte dim, ...) ;
  502. extern a_VOID y_ynxn (y_desc * ,...) ; /*  without Index check */
  503. extern a_VOID y_yxcn (y_desc * ,...) ; /*  with Index check */
  504. #endif
  505.  
  506. #else
  507. extern a_btyp y_ixch () ;
  508. extern a_btyp y_yxch () ;
  509. extern a_VOID y_inxn () ;
  510. extern a_VOID y_ixcn () ;
  511. extern void   y_asgn () ;
  512. extern void   y_vlcp () ;
  513. extern void   y_temp () ;
  514. extern void   y_utmp () ;
  515. extern a_VOID y_stat () ;
  516. extern a_VOID y_ynxn () ;
  517. extern a_VOID y_yxcn () ;
  518. extern a_VOID y_suba () ;
  519. #endif
  520.  
  521.  
  522. /*-----------------*/
  523. /*  File Handling  */
  524. /*-----------------*/
  525.  
  526. #define f_fnsz 64
  527.                         /* Filedescriptor */
  528.  
  529. #define f_ilof(typ)  struct {\
  530.  FILE * fp ;\
  531.  unsigned eof  : 1 ;\
  532.  unsigned eoln : 1 ;\
  533.  unsigned text : 1 ;\
  534.  unsigned infl : 1 ;\
  535.  unsigned outf : 1 ;\
  536.  unsigned stdi : 1 ;\
  537.  unsigned stdo : 1 ;\
  538.  unsigned asgd : 1 ;\
  539.  unsigned err  : 1 ;\
  540.  unsigned temp : 1 ;\
  541.  size_t   ellen ;\
  542.  char   name[f_fnsz] ;\
  543.  char *org;\
  544.  union {\
  545.    double f; /* forces alignm */\
  546.    typ dow ;\
  547.    char ch [sizeof (typ)] ;\
  548.  } win ;\
  549. }
  550. typedef f_ilof (a_char) f_text ;
  551.  
  552. extern f_text f_inpu, f_outp ;
  553.  
  554. #ifdef LINT_ARGS
  555. extern void f_init (int argc, char ** argv) ;
  556. extern void f_assg (f_text * filevar, char * filename, size_t ellen) ;
  557. extern void f_eofp (void) ;
  558. extern void f_rset (f_text*, char *, a_char *) ;
  559. extern void f_rwri (f_text*, char *, a_char *) ;
  560. extern void f_get_ (f_text*) ;
  561. extern void f_put_ (f_text*) ;
  562. extern void f_read (f_text*, a_VOID) ;
  563. extern void f_writ (f_text*, a_VOID) ;
  564. extern void f_wrc1 (f_text*, a_char *, a_intg) ;
  565. extern void f_wrc2 (f_text*, a_char *, a_intg, a_intg) ;
  566. extern void f_free (f_text*) ;
  567. #else
  568. extern void f_init ( ) ;
  569. extern void f_assg ( ) ;
  570. extern void f_eofp ( ) ;
  571. extern void f_rset ( ) ;
  572. extern void f_rwri ( ) ;
  573. extern void f_get_ ( ) ;
  574. extern void f_put_ ( ) ;
  575. extern void f_read ( ) ;
  576. extern void f_writ ( ) ;
  577. extern void f_wrc1 ( ) ;
  578. extern void f_wrc2 ( ) ;
  579. extern void f_free ( ) ;
  580. #endif
  581.  
  582.  
  583. /*-----------------------------------------------*/
  584. /*   standard dynamic array types of Pascal-SC   */
  585. /*-----------------------------------------------*/
  586. typedef y_arof (a_real,1) a_rvty ;
  587. typedef y_arof (a_cmpx,1) a_cvty ;
  588. typedef y_arof (a_intv,1) a_ivty ;
  589. typedef y_arof (a_cinv,1) a_civt ;
  590. typedef y_arof (a_real,2) a_rmty ;
  591. typedef y_arof (a_cmpx,2) a_cmty ;
  592. typedef y_arof (a_intv,2) a_imty ;
  593. typedef y_arof (a_cinv,2) a_cimt ;
  594.  
  595. /*-----------------------*/
  596. /*  Standard functions:  */
  597. /*-----------------------*/
  598.  
  599. #define a_chr_     (a_char)
  600. #define a_odd_(x)  (1&(x))
  601.  
  602.