home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / fweb153.zip / fweb-1.53 / web / macs.c < prev    next >
Text File  |  1995-09-23  |  73KB  |  3,518 lines
  1. #if(0)
  2.   FTANGLE v1.53, created with UNIX on "Thursday, September 21, 1995 at 15:06."  \
  3.   COMMAND LINE: "web/ftangle web/macs -A -# --F -= 1.53/web/macs.c" \
  4.   RUN TIME: "Saturday, September 23, 1995 at 16:17." \
  5.   WEB FILE:    "web/macs.web" \
  6.   CHANGE FILE: (none)
  7. #endif
  8. #define _MACS_h   \
  9.  
  10. #define stringg  (eight_bits)02 /* Extended ASCII alpha should not appear. (The funny \
  11.     spelling is to avoid conflict with the VAX' \.{stdlib}.) */
  12. #define constant  (eight_bits)03 /* Numerical constant. */
  13. #define begin_Xmeta  or_or
  14. #define end_Xmeta  star_star
  15. #define cdir  (eight_bits)06 /* Brackets compiler directive.. */
  16. #define colon_colon  (eight_bits)011 /* \Cpp\ and \Fortran--90: `$\CF$'. */ \
  17.  
  18. #define join  (eight_bits)0177 /* |ASCII| delete will not appear. */ \
  19.  
  20. #define ID0  0200 /* $128 =$ end of the 7-bit ASCII codes. */
  21. #define TOKEN1(a)((a)<ID0)/* Is |a|~a single-byte token? */ \
  22.  
  23. #define MACRO_ARGUMENT  0377 /* See the related definition and discussion of \
  24.                 |MOD0|. */
  25. #define BASE2  0400 /* |0xFF + 1 = 0x100 = 256| */ \
  26.  
  27. #define MODULE_NAME  10240 /* |024000= 10240 = (0250-0200)*0400| */
  28. #define MODULE_NUM  20480 /* |050000 = 20480 = (0320-0200)*0400| */
  29. #define LINE_NUM  53248L /* |0150000==0320*0400| */ \
  30.  
  31. #define IDENTIFIER(left,right) \
  32. ((sixteen_bits)(((left)-ID0)*BASE2+(sixteen_bits)(right))) \
  33. /* Construct two-byte token out of its constituents. */ \
  34.  
  35. #define LEFT(a,id)((eight_bits)(((a)/BASE2+(id))))/* Make left-hand byte out of \
  36.                     |sixteen_bits|. */
  37. #define RIGHT(a)((eight_bits)(((a)%BASE2)))/* Make right-hand byte. */ \
  38.  
  39. #define ignore  0 /* Control code of no interest to \.{TANGLE}. */ \
  40.  
  41. #define begin_comment0  (eight_bits)0376 /* Sent from |input_ln|; marker for long comment. */
  42. #define begin_comment1  (eight_bits)0375 /* As above; marker for short comment. */ \
  43.  
  44. #define module_number  (eight_bits)0201 /* Code returned by |get_output| for mod.\ numbers. */
  45. #define identifier  (eight_bits)0202 /* Code returned by |get_output| for identifiers. */
  46. #define id_keyword  (eight_bits)0203 /* As above, but for expandable keyword. */ \
  47.  
  48. #define L_switch  (eight_bits)0257 /* Control code for `\.{@L}'. */
  49. #define begin_FORTRAN  (eight_bits)0260
  50. #define begin_RATFOR  (eight_bits)0261
  51. #define begin_C  (eight_bits)0262
  52. #define begin_LITERAL  (eight_bits)0263 \
  53.  
  54. #define verbatim  (eight_bits)0264 /* Can't be~|02| as for \.{fweave}, because \
  55.                 |stringg| is defined to be that. */ \
  56.  
  57. #define invisible_cmnt  (eight_bits)0265 /* Control code for `\.{@\%}'. */
  58. #define compiler_directive  (eight_bits)0266 /* No longer used. */
  59. #define Compiler_Directive  (eight_bits)0267 /* Control code for `\.{@?}'. */
  60. #define no_index  (eight_bits)0300 /* Control code for `\.{@-}'. */
  61. #define yes_index  (eight_bits)0301 /* Control code for `\.{@+}'. */ \
  62.  
  63. #define ascii_constant  (eight_bits)0302 /* Control code for `\.{@'}'. */
  64. #define begin_vcmnt  (eight_bits)0303 /* Control code for `\.{@\slashstar}'. */
  65. #define big_line_break  (eight_bits)0304 /* Control code for `\.{@\#}'. */ \
  66.  
  67. #define begin_bp  (eight_bits)0305
  68. #define insert_bp  (eight_bits)0306 \
  69.  
  70. #define begin_meta  (eight_bits)017 /* Control code for |"@("|. */
  71. #define end_meta  (eight_bits)027 \
  72.  
  73. #define TeX_string  (eight_bits)0307
  74. #define xref_roman  (eight_bits)0310
  75. #define xref_typewriter  (eight_bits)0311
  76. #define xref_wildcard  (eight_bits)0312 \
  77.  
  78. #define control_text  (eight_bits)0313 /* Control code for `\.{@t}', `\.{@\^}', etc. */ \
  79.  
  80. #define begin_nuweb  (eight_bits)0314
  81. #define no_mac_expand  (eight_bits)0315 /* Control code for `\.{@\~}' */
  82. #define set_line_info  (eight_bits)0316 /* Expt'l control code for `\.{@Q}'. */ \
  83.  
  84. #define formatt  (eight_bits)0320 /* Control code for `\.{@f}'. */ \
  85.  
  86. #define limbo_text  (eight_bits)0323 /* Control code for `\.{@l}'. */
  87. #define op_def  (eight_bits)0324 /* Control code for `\.{@v}'. */
  88. #define macro_def  (eight_bits)0325 /* Control code for `\.{@W}'. */ \
  89.  
  90. #define ignore_defn  (eight_bits)0327 /* Stuff to here should be ignored when scanning defn. */ \
  91.  
  92. #define new_output_file  (eight_bits)0331 /* Control code for `\.{@o}'. */ \
  93.  
  94. #define definition  (eight_bits)0332 /* Control code for `\.{@d}'. */
  95. #define undefinition  (eight_bits)0333 /* Control code for `\.{@u}'. */
  96. #define WEB_definition  (eight_bits)0334 /* Control code for `\.{@m}'. */ \
  97.  
  98. #define m_ifdef  (eight_bits)0335
  99. #define m_ifndef  (eight_bits)0336
  100. #define m_if  (eight_bits)0337
  101. #define m_else  (eight_bits)0340
  102. #define m_elif  (eight_bits)0341
  103. #define m_endif  (eight_bits)0342
  104. #define m_for  (eight_bits)0343
  105. #define m_endfor  (eight_bits)0344
  106. #define m_line  (eight_bits)0345
  107. #define m_undef  (eight_bits)0346 \
  108.  
  109. #define end_of_buffer  (eight_bits)0347 \
  110.  
  111. #define begin_code  (eight_bits)0350 /* Control code for `\.{@a}'. */
  112. #define module_name  (eight_bits)0351 /* Control code for `\.{@<}'. */ \
  113.  
  114. #define new_module  (eight_bits)0352 /* Control code for `\.{@\ }' and `\.{@*}'. */ \
  115.  
  116. #define cur_end  cur_state.end_field /* Current ending location in |tok_mem|. */
  117. #define cur_byte  cur_state.byte_field /* Location of next output byte in |tok_mem|. */
  118. #define cur_name  cur_state.name_field /* Pointer to current name being expanded. */
  119. #define cur_repl  cur_state.repl_field /* Pointer to current replacement text. */
  120. #define cur_mod  cur_state.mod_field /* Current module number being expanded. */ \
  121.  
  122. #define cur_language  cur_state.language /* Current language. */
  123. #define cur_global_language  cur_state.global_params.Language \
  124. /* Global language for this level. */ \
  125.  \
  126. /* Current flags. */
  127. #define cur_params  cur_state.params /*  Local flags. */
  128. #define cur_global_params  cur_state.global_params /*  Global flags. */ \
  129.  \
  130. /* Current macro buffer params. */
  131. #define macrobuf  cur_state.macro_buf
  132. #define macrobuf_end  cur_state.macro_buf_end \
  133.  
  134. #define BP_MARKER  1 \
  135.  
  136. #define PROPER_END(end) \
  137. end= (np+1)->byte_start; \
  138. if(*end==BP_MARKER&&np!=npmax)end= ((BP*)end)->byte_start \
  139.  
  140. #define MAX_ID_LENGTH  32 /* Truncated identifiers can't be longer than this. */ \
  141.  
  142. #define semi  01 /* Kludge! */ \
  143.  
  144. #define SILENT  (boolean)NO
  145. #define COMPLAIN  (boolean)YES \
  146.  
  147. #define OUTER_MACRO  0xFF
  148. #define OUTER_UNMACRO  0xFE
  149. #define UNDEFINED_MACRO  0xFD \
  150.  
  151. #define MAX_XLEVELS  200 \
  152.  
  153. #define equiv  equiv_or_xref /* Info corresponding to names. */
  154. #define EQUIV  ASCII HUGE*/* For casting into the above field. */ \
  155.  \
  156. /* Note that the following function retrieves not only regular \WEB\ \
  157. macros, but also built-in functions. */
  158. #define MAC_LOOKUP(cur_val)(cur_val<MODULE_NAME? \
  159. (text_pointer)(name_dir+(cur_val))->equiv:NULL) \
  160.  
  161. #define macro  0 /* For appending a macro; distinguishes from a module. */ \
  162.  \
  163.  \
  164. /* The following are the values of the |macro_type| field of \
  165. |name_pointer|s. */
  166. #define NOT_DEFINED  0
  167. #define DEFERRED_MACRO  1 /* Numbers chosen so that |DEFERRED_MACRO + \
  168.     scanning_defn| gives the two choices. */
  169. #define IMMEDIATE_MACRO  2
  170. #define FILE_NAME  3 /* Used to prevent truncations from affecting file names. */ \
  171.  
  172. #define MAKE_RECURSIVE  052 /* To allow a WEB macro to be recursive, preface its \
  173.     definition by this symbol, as in `\.{@m *R R}'.  (Recursive macros \
  174.     are not presently implemented.) */ \
  175.  
  176. #define AUTO_INSERT  0133
  177. #define END_AUTO_INSERT  0135 \
  178.  \
  179. /* Guard against overflow of the macro buffer. */
  180. #define MCHECK(n,reason)if(mp+(n)>macrobuf_end) \
  181. mbuf_full((unsigned long)(n),(outer_char*)reason) \
  182.  
  183. #define MAKE_16(start)(((sixteen_bits)(*start)<<8)+(sixteen_bits)(*(start+1))) \
  184.  
  185. #define TYPE_DESCR_LEN  20 /* Should be long enough to hold the reasonable type \
  186. descriptions that are constructed below. */ \
  187.  
  188. #define save_name(a){if(xids->level>=MAX_XLEVELS) \
  189. { \
  190.  \
  191. macro_err(OC("! Macro inner recursion depth exceeded"),YES); \
  192. FATAL(M,"!! BYE.",""); \
  193. } \
  194. xids->token[slevel= xids->level++]= a; \
  195. } \
  196.  
  197. #define unsave_name  xids->level= slevel \
  198.  
  199. #define DEFINED_ERR(s){ \
  200. macro_err(OC(s),YES);goto done_expanding;} \
  201.  
  202. #define ERR_IF_DEFINED_AT_END  if(p>=end) \
  203. DEFINED_ERR("! `defined' ends prematurely") \
  204.  
  205. #define UNNAMED_MODULE  0
  206. #define CPY_OP(token,trans)case token:cpy_op(OC(trans));break \
  207.  
  208. #define MUST_QUOTE(name,p,p1)must_quote(OC(name),p,p1) \
  209.  
  210. #define CHECK_QUOTE(var,n)if(*var++!=end_char) \
  211. macro_err(OC("! Argument %d of \
  212. $TRANSLIT doesn't begin with '%c'"),YES,n,end_char) \
  213.  
  214. #define N_ENVBUF  200 \
  215.  
  216. #define SAVE_ENV(aval)if(t<temp_end)*t++= XCHR(aval); \
  217. else OVERFLW("Env_buf","") \
  218.  
  219. #define DOES_ARG_FOLLOW(c) \
  220. if(*p0!=MACRO_ARGUMENT) \
  221. { \
  222.  \
  223. macro_err(OC("! Macro token `#%c' must be followed by a parameter"),YES,c); \
  224. break; \
  225. } \
  226. p0++/* Skip over |MACRO_ARGUMENT|. */ \
  227.  
  228. #define INS_ARG_LIST  pargs,m,n,&p0,&pasting,&xpn_argument,last_was_paste \
  229.  
  230. #define STOP  YES \
  231.  
  232. #define arg_must_be_constant(name) \
  233.  \
  234. macro_err(OC("Argument of \"%s\" must be constant or string"),YES,name); \
  235.  
  236. #define MTEXT_SIZE  2500 \
  237.  
  238. #define SAVE_MTEXT(val)if(p<mtext_end)*p++= (eight_bits)(val); \
  239. else OVERFLW("Mtext","") \
  240.  
  241.  
  242.  
  243. #include "typedefs.h"
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250. #include "map.h"
  251.  
  252.  
  253.  
  254.  
  255. typedef struct
  256. {
  257. eight_bits HUGE*tok_start;/* Pointer into |tok_mem| (for a module or \
  258. regular macro).  For an internal macro, points to the internal function. */
  259. sixteen_bits text_link;/* Relates replacement texts  (0 for a macro). */
  260. boolean Language;/* Which language referenced this name. */
  261. eight_bits nargs;/* Number of macro arguments. */
  262. unsigned moffset:8,/* Offset to macro replacement text from start. */
  263. recursive:1,/* Is this macro allowed to be recursive? */
  264. var_args:1,/* Can it have variable number of arguments? */
  265. module_text:1,/* Distinguishes from preprocessor fragment. */
  266. built_in:1;/* Is it a built-in function (internal macro)? */
  267. }text;
  268.  
  269. typedef text HUGE*text_pointer;
  270.  
  271.  
  272.  
  273. typedef struct{
  274. eight_bits HUGE*end_field;/* Ending location of replacement text. */
  275. eight_bits HUGE*byte_field;/* Present location within replacement text. */
  276. name_pointer name_field;/* |byte_start| index for text being output. */
  277. text_pointer repl_field;/* |tok_start| index for text being output. */
  278. sixteen_bits mod_field;/* Module number, or zero if not a module. */
  279. PARAMS global_params,params;/* Various flags. */
  280. eight_bits HUGE*macro_buf,HUGE*macro_buf_end;/* Current macro buffer. */
  281. }output_state;
  282.  
  283. typedef output_state HUGE*stack_pointer;
  284.  
  285.  
  286.  
  287. /* Precedence of the various operators. */
  288. typedef enum{BAD_TOKEN,OR_OR,AND_AND,BIT_OR,BIT_XOR,BIT_AND,LOG_EQ,LOG_LT,
  289. BIT_SHIFT,PLUS_MINUS,TIMES,EXP,UNARY,HIGHEST_UNARY}PRECEDENCE;
  290.  
  291. /* An operator, together with its precedence. */
  292. typedef struct
  293. {
  294. eight_bits token;
  295. PRECEDENCE precedence;
  296. }OP;
  297.  
  298. /* The actual data value. */
  299. typedef union
  300. {
  301. long i;/* All integers are long, to humor the pc people. */
  302. double d;/* We handle just one floating-point type. */
  303. sixteen_bits id;/* An identifier token. */
  304. OP op;
  305. }VALUE;
  306.  
  307. /* Type of the data value. The relative order must be preserved here, \
  308. because it is used in the type promotion routine |promote|. */
  309. typedef enum{Int,Double,Id,Op}TYPE;
  310.  
  311. /* Complete data structure for the token; includes links to the next and \
  312. last |VAL| structures. */
  313. typedef struct val
  314. {
  315. VALUE value;/* The actual data value or operator token. */
  316. TYPE type;/* The type of value stored in |value|. */
  317. struct val HUGE*last,HUGE*next;/* Link to the last and next values. */
  318. }VAL;
  319.  
  320.  
  321.  
  322. #if(0)
  323. IN_COMMON boolean truncate_ids;/* Truncate identifers? */
  324. IN_COMMON unsigned short tr_max[];/* Truncate to this length. */
  325. IN_COMMON name_pointer npmax;/* |name_ptr - 1|. */
  326. #endif
  327.  
  328. /* Back-pointer structure points back to the original name in |name_dir|. */
  329. typedef struct Bp
  330. {
  331. ASCII c;/* Dummy byte that always remains~|BP_MARKER|. */
  332. LANGUAGE Language;
  333. CONST ASCII HUGE*byte_start,HUGE*byte_end;/* Points to original, \
  334. untruncated name. */
  335. struct Bp HUGE*next;/* Links to next back-pointer structure, in \
  336. case a truncated name came from more than one original name. */
  337. struct Trunc HUGE*Root;
  338. }BP;
  339.  
  340. /* Info about a truncated identifier. */
  341. typedef struct Trunc
  342. {
  343. boolean Language;/* All languages associated with this name. */
  344. size_t num[NUM_LANGUAGES];
  345. /* \# of instances of the truncated name. */
  346. ASCII HUGE*id,HUGE*id_end;/* Truncated variable name. */
  347. BP HUGE*first,HUGE*last;/* First and last back-pointer structures. */
  348. struct Trunc HUGE*next;/* Next structure in truncated chain. */
  349. }TRUNC;
  350.  
  351.  
  352.  
  353.  
  354. typedef struct
  355. {
  356. sixteen_bits token[MAX_XLEVELS];
  357. int level;
  358. }XIDS;
  359.  
  360.  
  361.  
  362. typedef struct
  363. {
  364. const char*name;/* Identifier. */
  365. int len;/* Length of identifier. Filled in by |ini_internal_fcns|. */
  366. SRTN(*expnd)PROTO((int,unsigned char**));
  367. /* Function that expands this token.  This prototype really \
  368. should read |(int,PARGS)|, but that didn't work on the DECstation.  The \
  369. name |expand| also seemed special to the DECstation. */
  370. boolean Language;
  371. eight_bits nargs;
  372. boolean var_args;
  373. boolean recursive;
  374. sixteen_bits id;/* The id code returned from |id_lookup|. */
  375. }INTERNAL_FCN;
  376.  
  377.  
  378.  
  379.  
  380. #include "t_type.h" /* Prototypes for \.{ftangle.web}, etc. */
  381.  
  382.  
  383.  
  384.  
  385. /* The shorter length here is primarily to keep the stack under control. \
  386. Now that |N_MSGBUF| is used  dynamically, maybe this statement isn't \
  387. necessary. */
  388. #ifdef SMALL_MEMORY
  389. #define N_MSGBUF 2000
  390. #else
  391. #define N_MSGBUF 10000
  392. #endif
  393.  
  394.  
  395.  
  396.  
  397.  
  398. EXTERN long max_texts;/* Number of replacement texts, must be $< 10240$. */
  399. EXTERN text HUGE*text_info;/* Dynamic array. */
  400. EXTERN text_pointer text_end;/* End of above. */
  401.  
  402. EXTERN long dtexts_max;/* Number of deferred replacement texts. */
  403. EXTERN text HUGE*txt_dinfo;/* Dynamic array. */
  404. EXTERN text_pointer textd_end;
  405.  
  406. EXTERN text_pointer text_ptr,txt_dptr;/* First unused position in |text_info| \
  407.                     and in |txt_dinfo|. */
  408.  
  409. EXTERN long max_toks;/* Number of bytes in compressed code. */
  410. EXTERN eight_bits HUGE*tok_mem;/* Dynamic array. */
  411. EXTERN eight_bits HUGE*tok_m_end;
  412.  
  413. EXTERN long max_dtoks;/* Number of bytes in deferred macros. */
  414. EXTERN eight_bits HUGE*tok_dmem;/* Dynamic array. */
  415. EXTERN eight_bits HUGE*tokd_end;
  416.  
  417. EXTERN eight_bits HUGE*tok_ptr,HUGE*tok_dptr;/* First unused position in \
  418.             |tok_mem| and in |tok_dmem|. */
  419. EXTERN eight_bits HUGE*mx_tok_ptr,HUGE*mx_dtok_ptr;/* Largest value \
  420.     assumed by |tok_ptr|  and |tok_ptrd|; for statistics. */
  421.  
  422. EXTERN text_pointer macro_text;
  423.  
  424.  
  425.  
  426. EXTERN output_state cur_state;/* |cur_end|, |cur_byte|, |cur_name|, \
  427.     |cur_repl|, |cur_mod|, |cur_global_language|, and |cur_language|. */
  428.  
  429. EXTERN long stck_size;/* Number of simultaneous levels of macro expansion. */
  430. EXTERN output_state HUGE*stack;/* Dynamic array: Info for non-current levels. */
  431. EXTERN stack_pointer stck_end;/* End of |stack|. */
  432. EXTERN stack_pointer stck_ptr;/* First unused loc.\ in the output state stack. */
  433.  
  434.  
  435.  
  436. IN_COMMON STMT_LBL max_stmt;/* See \.{common.web}. */
  437.  
  438. EXTERN sixteen_bits outp_line[NUM_LANGUAGES]
  439. #ifdef _FTANGLE_h
  440. #if(part == 0 || part == 1)
  441. = {1,1,1,1,1,1,1,1}
  442. #endif /* |part == 1| */
  443. #endif /* |_FTANGLE_h| */
  444. ;
  445.  
  446.  
  447.  
  448. IN_COMMON sixteen_bits HUGE*args;/* Token list of current macro arguments. \
  449.                 Allocated in |predefine_macros| just below. */
  450. IN_COMMON BUF_SIZE max_margs;/* Allocated length of |args|. */
  451.  
  452.  
  453.  
  454. INTERNAL_FCN internal_fcns[]= {
  455. {"$$ASCII",0,i_ascii_,0xF,1,NO,NO},
  456. {"$ASSERT",0,i_assert_,0xF,1,NO,NO},
  457. {"$$CONST",0,i_const_,0xF,2,YES,NO},
  458. {"$DEFINE",0,i_define_,0xF,1,NO,NO},
  459. {"_DUMPDEF",0,i_dumpdef_,0xF,0,YES,NO},
  460. {"$DUMPDEF",0,i_dumpdef_,0xF,0,YES,NO},
  461. {"$$ERROR",0,i_error_,0xF,1,NO,NO},
  462. {"$$EVAL",0,i_eval_,0xF,1,NO,NO},
  463. {"$$GETENV",0,i_getenv_,0xF,1,NO,NO},
  464. {"$IF",0,i_if_,0xF,3,NO,YES},
  465. {"$IFCASE",0,i_ifcase_,0xF,1,YES,YES},
  466. {"$IFDEF",0,i_ifdef_,0xF,3,NO,YES},
  467. {"$IFNDEF",0,i_ifndef_,0xF,3,NO,YES},
  468. {"$IFELSE",0,i_ifelse_,0xF,4,NO,YES},
  469. {"_INPUT_LINE",0,i_inp_line_,0xF,0,NO,NO},
  470. {"$INPUT_LINE",0,i_inp_line_,0xF,0,NO,NO},
  471. {"_LANGUAGE",0,i_lang_,0xF,0,NO,NO},
  472. {"$LANGUAGE",0,i_lang_,0xF,0,NO,NO},
  473. {"$$LC",0,i_lowercase_,0xF,1,NO,NO},
  474. {"$$LEN",0,i_len_,0xF,1,NO,NO},
  475. {"$$LOG",0,i_log_,0xF,2,NO,NO},
  476. {"_LANGUAGE_NUM",0,i_lnum_,0xF,0,NO,NO},
  477. {"$LANGUAGE_NUM",0,i_lnum_,0xF,0,NO,NO},
  478. {"$M",0,i_define_,0xF,1,NO,NO},
  479. {"$$META",0,i_meta_,0xF,1,NO,NO},
  480. {"$$MIN_MAX",0,i_min_max_,0xF,2,YES,NO},
  481. {"$$MODULE_NAME",0,i_mod_name_,0xF,0,NO,NO},
  482. {"$$MODULES",0,i_modules_,0xF,1,NO,NO},
  483. {"$$NARGS",0,i_nargs_,0xF,1,NO,NO},
  484. {"_OUTPUT_LINE",0,i_outp_line_,0xF,0,NO,NO},
  485. {"$OUTPUT_LINE",0,i_outp_line_,0xF,0,NO,NO},
  486. {"$$ROUTINE",0,i_routine_,RATFOR,0,NO,NO},
  487. {"_SECTION_NUM",0,i_sect_num_,0xF,0,NO,NO},
  488. {"$SECTION_NUM",0,i_sect_num_,0xF,0,NO,NO},
  489. {"$$SWITCH",0,i_switch_,0,0,NO,NO},
  490. {"$$TM",0,i_tm_,0xF,1,NO,NO},
  491. {"$$TRANSLIT",0,i_translit_,0xF,3,NO,NO},
  492. {"$UNDEF",0,i_undef_,0xF,1,NO,NO},
  493. {"$UNSTRING",0,i_unstring_,0xF,1,NO,NO},
  494. {"$$UC",0,i_uppercase_,0xF,1,NO,NO},
  495. {"$$VERBATIM",0,i_verbatim_,0xF,1,NO,NO},
  496. {"$$VERSION",0,i_version_,0xF,0,NO,NO},
  497. {"_XX",0,i_xflag_,0xF,1,NO,NO},
  498. {"$XX",0,i_xflag_,0xF,1,NO,NO},
  499. {"",0,NULL}/* The null string terminates the list. */
  500. };
  501.  
  502. /* Put the internal function names into the table. */
  503. SRTN ini_internal_fcns(VOID)
  504. {
  505. INTERNAL_FCN HUGE*s;
  506. name_pointer np;
  507. text_pointer m;
  508.  
  509. for(s= internal_fcns;(s->len= STRLEN(s->name))!=0;s++)
  510. {
  511. ASCII HUGE*p= x_to_ASCII(OC(s->name));
  512.  
  513. s->id= ID_NUM_ptr(np,p,p+s->len);
  514.  
  515. np->equiv= (ASCII HUGE*)(m= text_ptr++);
  516. np->macro_type= IMMEDIATE_MACRO;
  517.  
  518. m->tok_start= (eight_bits HUGE*)s->expnd;/* NON-ANSI cast??? */
  519. m->text_link= 0;
  520. m->Language= s->Language;
  521. m->nargs= s->nargs;
  522. m->recursive= s->recursive;
  523. m->var_args= s->var_args;
  524. m->module_text= NO;
  525. m->built_in= YES;
  526. }
  527.  
  528. /* Regular macro definitions store the replacement text in the token \
  529. memory. */
  530. text_ptr->tok_start= tok_mem;
  531. }
  532.  
  533.  
  534.  
  535. IN_TANGLE text_pointer cur_text;/* See \.{ftangle.web}. */
  536. IN_TANGLE LINE_NUMBER nearest_line;
  537.  
  538.  
  539.  
  540. XIDS HUGE*pids[MAX_XLEVELS];
  541. int xlevel= 0;
  542.  
  543.  
  544.  
  545. static boolean keep_intact;
  546. static boolean single_quote= NO,double_quote= NO;
  547.  
  548.  
  549. OUTPUT_STATE copy_state;
  550.  
  551.  
  552.  
  553. int xflag= 1;
  554.  
  555.  
  556.  
  557.  
  558.  
  559.  
  560.  
  561. SRTN predefine_macros(VOID)
  562. {
  563.  
  564. {
  565. if(macrobuf==NULL)
  566. {
  567. macrobuf= GET_MEM("macrobuf",mbuf_size,eight_bits);
  568. macrobuf_end= macrobuf+mbuf_size;
  569. }
  570.  
  571. mp= macrobuf;/* Initialize current pointer to the start. */
  572. }
  573.  
  574. ;
  575.  
  576.  
  577.  
  578. SAVE_MACRO("_DEFINED(macro)$EVAL(defined #!macro)");
  579. SAVE_MACRO("$DEFINED(macro)$EVAL(defined #!macro)");
  580.  
  581.  
  582.  
  583. SAVE_MACRO("_ABS(a)$IF((a) > 0,$EVAL(a),$EVAL(-(a)))");
  584. SAVE_MACRO("$ABS(a)$IF((a) > 0,$EVAL(a),$EVAL(-(a)))");
  585.  
  586.  
  587.  
  588. SAVE_MACRO("_STRING(expr)$STRING0(`expr`)");
  589. SAVE_MACRO("$STRING(expr)$STRING0(`expr`)");/* Expand the argument. \
  590.     Quotes take care of possible commas in |expr|. */
  591.  
  592. SAVE_MACRO("_STRING0(expr)#*expr");
  593. SAVE_MACRO("$STRING0(expr)#*expr");
  594.  
  595.  
  596.  
  597. SAVE_MACRO("_LEN(s)$$LEN(#*s)");/* Don't expand argument. */
  598. SAVE_MACRO("$LEN(s)$$LEN(#*s)");/* Don't expand argument. */
  599.  
  600.  
  601.  
  602. SAVE_MACRO("_VERBATIM(s)$$VERBATIM(s)");/* Possibly expand the argument. */
  603. SAVE_MACRO("$VERBATIM(s)$$VERBATIM(s)");/* Possibly expand the argument. */
  604.  
  605. SAVE_MACRO("_UNQUOTE(s)$$VERBATIM(s)");/* Alternative name. */
  606. SAVE_MACRO("$UNQUOTE(s)$$VERBATIM(s)");/* Alternative name. */
  607.  
  608. SAVE_MACRO("_P $VERBATIM(\"#\")");/* Preprocessor symbol. */
  609. SAVE_MACRO("$P $VERBATIM(\"#\")");/* Preprocessor symbol. */
  610.  
  611.  
  612.  
  613. SAVE_MACRO("_TRANSLIT(s,from,to)$$TRANSLIT(#*s,#*from,#*to)");
  614. SAVE_MACRO("$TRANSLIT(s,from,to)$$TRANSLIT(#*s,#*from,#*to)");/* Make \
  615.    strings from the arguments (but do nothing if they're already strings).  */
  616.  
  617.  
  618.  
  619. SAVE_MACRO("_GETENV(var)$STRING($$GETENV(#*var))");
  620. SAVE_MACRO("$GETENV(var)$STRING($$GETENV(#*var))");
  621.  
  622. SAVE_MACRO("_HOME $GETENV(HOME)");
  623. SAVE_MACRO("$HOME $GETENV(HOME)");/* An important special case: the \
  624.                     user's home directory. */
  625.  
  626.  
  627.  
  628. SAVE_MACRO("_COMMENT(cmnt)$$META(#*cmnt)");
  629. SAVE_MACRO("$COMMENT(cmnt)$$META(#*cmnt)");
  630.  
  631.  
  632.  
  633. SAVE_MACRO("_ERROR(text)$$ERROR(#*text)");
  634. SAVE_MACRO("$ERROR(text)$$ERROR(#*text)");
  635.  
  636.  
  637.  
  638. SAVE_MACRO("_ROUTINE $STRING($$ROUTINE)");
  639. SAVE_MACRO("$ROUTINE $STRING($$ROUTINE)");
  640.  
  641.  
  642.  
  643. SAVE_MACRO("_L(name)$$LC(name)");/* Possibly expand the argument. */
  644. SAVE_MACRO("$L(name)$$LC(name)");/* Possibly expand the argument. */
  645.  
  646. SAVE_MACRO("_U(name)$$UC(name)");
  647. SAVE_MACRO("$U(name)$$UC(name)");
  648.  
  649.  
  650.  
  651. SAVE_MACRO("_NARGS(mname)$$NARGS(#!mname)");
  652. SAVE_MACRO("$NARGS(mname)$$NARGS(#!mname)");
  653.  
  654. ;/* We accrete to this from various places, as \
  655.         it becomes convenient to discuss the particular macro. */
  656. t_macros();/* Internal macros from \.{ftangle.web}. */
  657. e_macros();/* Internal macros from \.{eval.web}. */
  658. }
  659.  
  660.  
  661. SRTN new_mbuf(VOID)
  662. {
  663.  
  664. {
  665. if(macrobuf==NULL)
  666. {
  667. macrobuf= GET_MEM("macrobuf",mbuf_size,eight_bits);
  668. macrobuf_end= macrobuf+mbuf_size;
  669. }
  670.  
  671. mp= macrobuf;/* Initialize current pointer to the start. */
  672. }
  673.  
  674.  
  675. }
  676.  
  677.  
  678. eight_bits HUGE*argize FCN((start,end))
  679. eight_bits HUGE*start C0("Beginning of the raw tokens.")
  680. eight_bits HUGE*end C1("End.")
  681. {
  682. eight_bits k,l;
  683. eight_bits HUGE*p,HUGE*last2,HUGE*start0;
  684. boolean var_args;/* Whether variable arguments or not. */
  685.  
  686. start0= start;/* Remember the beginning of the raw tokens. */
  687.  
  688. if(TOKEN1(*start))
  689. {
  690.  
  691. err0_print(ERR_M,OC("! Macro must start with identifier"),0);
  692. /* SHOULD FLUSH HERE. */
  693. return end;
  694. }
  695.  
  696. /* Determine the number~|k| of macro arguments and return starting position \
  697. of text after arguments. */
  698. start= get_dargs(start,end,args,&k,&var_args);
  699. cur_text->moffset= (unsigned char)(start-start0);
  700. /* Offset to text after $(\dots)$ (or \
  701.         to text after macro name if no arguments). */
  702. cur_text->nargs= k;/* Number of macro arguments. */
  703. cur_text->var_args= var_args;
  704.  
  705. /* Start after right paren. */
  706. for(last2= p= start;p<end;p++)
  707. {
  708. if(TOKEN1(*p))
  709. switch(*p)
  710. {
  711. case 043:
  712.  
  713. {
  714. int n;/* The argument number; must be |int|. */
  715. eight_bits HUGE*q= p;/* |q|~remembers the position of the number. */
  716. outer_char*tmp;/* Temporary buffer for argument number. */
  717. size_t i;
  718.  
  719. if(*(p+1)!=constant)continue;/* This isn't the case \.{\#\It{n}}. */
  720.  
  721. p+= 2;/* Position after |constant|. */
  722.  
  723. for(i= 0;p[i]!=constant;i++)
  724. ;/* Find the length of the constant. */
  725.  
  726. tmp= GET_MEM("var arg buf",i+1,outer_char);
  727.  
  728. for(i= 0;p[i]!=constant;i++)
  729. tmp[i]= XCHR(p[i]);/* Convert to |outer_char|. */
  730. tmp[i+1]= '\0';
  731.  
  732. n= ATOI(tmp);/* Eval.\ the arg.~\#, starting after |constant|. */
  733.  
  734. /* \bfit SHOULD CHECK FOR TOO BIG HERE. */
  735.  
  736. FREE_MEM(tmp,"var arg buf",i+1,outer_char);
  737.  
  738. if(!var_args)
  739. macro_err(OC("! #%d may only be used with variable-argument \
  740. macros"),YES,n);
  741.  
  742. while(*p!=constant)*p++= ignore;
  743.  
  744. if(n<0)
  745. macro_err(OC("! #%d is not allowed"),YES,n);
  746. else if(n==0)
  747. *(q+1)= 060;/* Marker for future expansion---the \# of variable \
  748. arguments. */
  749. else
  750. {/* Overwrite the \.\# and the |constant|. */
  751. *q= MACRO_ARGUMENT;
  752. *(q+1)= (eight_bits)(k+(eight_bits)(n-1));
  753. /* We must offset by the fixed number of arguments. */
  754. }
  755.  
  756. last2= p;
  757. *p= ignore;
  758. }
  759.  
  760.  
  761. continue;
  762.  
  763. case dot_const:
  764. p++;
  765.  
  766. default:
  767. continue;/* Skip ordinary token. */
  768. }
  769.  
  770. /* Search for match with argument token. */
  771. for(l= 0;l<k;++l)
  772. /* The following effects |if(args[l] == *(sixteen_bits *)p)|. See the \
  773. analogous bit manipulations in |store_two_bytes|. */
  774. if(args[l]>>8==*p&&(args[l]&0x00FF)==*(p+1))
  775. {
  776. *p= MACRO_ARGUMENT;/* Mark as macro argument. */
  777. *(p+1)= l;/* Store argument number in following \
  778.                         byte. */
  779. break;
  780. }
  781.  
  782. last2= ++p;/* Advance over second byte of two-byte token. \
  783. Remember the position |last2| of a two-byte token so we can strip \
  784. off newlines properly below. */
  785. }
  786.  
  787.  
  788.  
  789. for(last2++;p>last2;)
  790. if(*(p-1)==012||*(p-1)==040)
  791. p--;
  792. else
  793. break;
  794.  
  795. ;
  796. return p;
  797. }
  798.  
  799.  
  800. eight_bits HUGE*get_dargs FCN((start,end,args,n,pvar_args))
  801. eight_bits HUGE*start C0("Start of token string.")
  802. eight_bits HUGE*end C0("End of token string.")
  803. sixteen_bits HUGE*args C0("Array of argument tokens, to be returned.")
  804. eight_bits*n C0("Number of arguments found.")
  805. boolean*pvar_args C1("Return whether variable arguments")
  806. {
  807. eight_bits k;/* Counts the arguments. */
  808. sixteen_bits id_token;/* Identifier for this macro. */
  809.  
  810. *pvar_args= NO;/* To begin, assume no variable arguments. */
  811.  
  812. id_token= IDENTIFIER(*start,*(start+1));
  813. start+= 2;/* After initial identifier. */
  814.  
  815. if(*start!=050)
  816. {/* No args; nothing to do. */
  817. *n= 0;
  818. while(*start==040)start++;
  819. return start;
  820. }
  821.  
  822. for(k= 0,++start;*start!=051;++k)
  823. {
  824. if(start==end)
  825. {
  826.  
  827. err0_print(ERR_M,OC("Missing right paren in definition of macro \"%s\""),1,name_of(id_token));
  828. *n= k;
  829. return end;
  830. }
  831.  
  832. if(TOKEN1(*start))
  833. {
  834.  
  835.  
  836. if(*start==ellipsis)
  837. {
  838. if(*++start!=051)
  839. err0_print(ERR_M,OC("Expected ')' after ellipsis"),0);
  840. else*pvar_args= YES;
  841.  
  842. break;
  843. }
  844.  
  845.  
  846.  
  847.  
  848. err0_print(ERR_M,OC("Invalid macro parameter in definition of macro \
  849. \"%s\". Token %s is invalid; \
  850. can only have identifiers and commas between (...)"),2,name_of(id_token),type1(*start));
  851. *n= 0;
  852. return start;
  853. }
  854.  
  855. if(k>=(eight_bits)max_margs)
  856. mac_args(id_token);
  857.  
  858. args[k]= MAKE_16(start);/* Store the argument token. */
  859.  
  860. start+= 2;/* After argument token, positioned now either on comma \
  861. or right paren. */
  862. if(*start==054)++start;/* Skip comma. */
  863. }
  864.  
  865. /* Special case of no argument list. We assume this means one dummy \
  866. argument. */
  867. if(*start==051&&k==0&&!*pvar_args)args[k++]= 0;
  868.  
  869. *n= k;/* Number of arguments found. */
  870. return start+1;/* Position after right paren. */
  871. }
  872.  
  873.  
  874. SRTN mac_args FCN((id_token))
  875. sixteen_bits id_token C1("")
  876. {
  877. char temp[200];
  878.  
  879. sprintf(temp,"arguments to macro \"%s\"",(char*)name_of(id_token));
  880. OVERFLW(temp,"ma");
  881. }
  882.  
  883.  
  884. outer_char*type1 FCN((c))
  885. eight_bits c C1("")
  886. {
  887. outer_char*p= NULL;
  888. static outer_char type_descr[TYPE_DESCR_LEN];
  889.  
  890. if(isprint(XCHR(c)))
  891. {
  892. if(
  893. nsprintf(type_descr,OC("'%c'"),1,XCHR(c))>=(int)(TYPE_DESCR_LEN))OVERFLW("type_descr","");}/* Printable \
  894.             character. */
  895. else
  896. {
  897. switch(c)
  898. {
  899. case constant:
  900. p= OC("constant");break;
  901.  
  902. case stringg:
  903. p= OC("string");break;
  904.  
  905. case 012:
  906. p= OC("newline");break;
  907. }
  908.  
  909. if(p){
  910. if(
  911. nsprintf(type_descr,OC("'%s'"),1,p)>=(int)(TYPE_DESCR_LEN))OVERFLW("type_descr","");}/* Special \
  912. \WEB\ token. */
  913. else{
  914. if(
  915. nsprintf(type_descr,OC("0x%x"),1,c)>=(int)(TYPE_DESCR_LEN))OVERFLW("type_descr","");}/* Unknown \
  916. byte. */
  917. }
  918.  
  919. return type_descr;
  920. }
  921.  
  922.  
  923. eight_bits HUGE*get_margs0 FCN((start,end,pcur_byte,the_end,var_args,pargs,n))
  924. eight_bits HUGE*start C0("Beginning of the tokens for this \
  925. macro call.")
  926. eight_bits HUGE*end C0("Maximum possible end.")
  927. eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
  928. eight_bits HUGE*the_end C0("End of the current buffer.")
  929. boolean var_args C0("Does macro have variable arguments?")
  930. PARGS pargs C0("Array of pointers to the actual arguments, \
  931. to be returned.")
  932. eight_bits*n C1("Number of arguments found.")
  933. {
  934. eight_bits k;
  935. int bal,bbal;/* Balance for parens and brackets. */
  936. boolean mac_protected;
  937. sixteen_bits id_token;/* Identifier for this macro. */
  938.  
  939. id_token= IDENTIFIER(*start,*(start+1));/* Remember for error processing. */
  940. start+= 2;/* After initial identifier. */
  941.  
  942. /* Read more arguments into buffer if necessary. */
  943. if(start==end&&the_end!=NULL)
  944. end= args_to_macrobuf(end,pcur_byte,the_end,var_args);
  945.  
  946. /* Does a parenthesized list follow identifier? */
  947. if(start==end||*start!=050)
  948. {
  949. return pargs[*n= 0]= start;/* No args; nothing to do. Position \
  950. after macro name identifier.  */
  951. }
  952.  
  953. pargs[k= 0]= start++;/* Beginning of first actual argument \
  954.     token string. (Actually, this is the position of the left paren, \
  955.     one less than the position of the first token. This is so the ending \
  956.     position, which will point to a comma, can be used as the start of \
  957.     the next argument. The value~1 is added in |x0macro|.) */
  958.  
  959. bal= 1;/* Keep track of balanced parens. Already past the opening one. */
  960. bbal= 0;/* Also keep track of balanced brackets. */
  961. mac_protected= NO;/* Reverse accent protects commas, etc. */
  962.  
  963. while(start<end)
  964. {
  965. eight_bits c= *start;
  966.  
  967. if(TOKEN1(c))
  968. {
  969. switch(c)
  970. {
  971. case 043:
  972. if(start+1<end&&*(start+1)==054)
  973. {/* Skip over `\.{\#,}'. */
  974. *start= '\0';/* Replace '\.\#' by null. */
  975. start+= 2;
  976. continue;
  977. }
  978. break;
  979.  
  980. case constant:
  981. case stringg:
  982. for(start++;*start++!=c;);
  983. continue;
  984.  
  985. case dot_const:
  986. start+= 2;
  987. continue;
  988.  
  989. case 0140:
  990. mac_protected= BOOLEAN(!mac_protected);
  991. *start++= '\0';/* Replace the protection \
  992. character by a null. */
  993. continue;
  994.  
  995. /* The following scheme needs to be generalized.  Doesn't check for syntax \
  996. such as `\.{[(]}' or `\.{([)}'.  Probably must stack counters. */
  997. case 050:
  998. bal++;
  999. break;
  1000.  
  1001. case 051:
  1002. if(bal==0)
  1003.  
  1004. macro_err(OC("Unexpected ')' in macro argument"),YES);
  1005. else if(bal>0)bal--;
  1006. break;
  1007.  
  1008. case 0133:
  1009. bbal++;
  1010. break;
  1011.  
  1012. case 0135:
  1013. if(bbal==0)
  1014.  
  1015. macro_err(OC("Unexpected ']' in macro argument"),YES);
  1016. else if(bbal>0)bbal--;
  1017. break;
  1018. }
  1019.  
  1020. if(!mac_protected&&((bal==1&&bbal==0&&(c==054))
  1021. ||bal==0))
  1022. {/* Found end of argument token list. Record the \
  1023. upper limit. */
  1024. if(++k>=max_margs)
  1025. mac_args(id_token);
  1026.  
  1027. pargs[k]= start++;/* Count the argument, skip \
  1028. over comma or paren. */
  1029. if(bal==0)break;/* End of arguments. */
  1030. }
  1031. else start++;/* Skip over one-byte token. */
  1032. }
  1033. else
  1034. start+= (c<0250?2:4+4*1);
  1035. /* Skip over two-byte token. (`1' for |line_info|.) */
  1036. }
  1037.  
  1038. *n= k;
  1039. return start;/* Positioned after right paren. */
  1040. }
  1041.  
  1042.  
  1043. void HUGE*mac_lookup FCN((cur_val))
  1044. sixteen_bits cur_val C1("Current id token.")
  1045. {
  1046. return(void*)MAC_LOOKUP(cur_val);
  1047. }
  1048.  
  1049.  
  1050.  
  1051. SRTN i_ifdef_ FCN((n,pargs))
  1052. int n C0("")
  1053. PARGS pargs C1("")
  1054. {
  1055. text_pointer m;
  1056. sixteen_bits id;
  1057. eight_bits HUGE*p0= pargs[0]+1;
  1058. boolean e;
  1059.  
  1060. CHK_ARGS("$IFDEF",3);
  1061.  
  1062. if(TOKEN1(*p0))
  1063. {
  1064.  
  1065. macro_err(OC("! First argument of $IFDEF or $IFNDEF must be a macro"),YES);
  1066. return;
  1067. }
  1068.  
  1069. id= IDENTIFIER(p0[0],p0[1]);
  1070. e= ((m= mac_lookup(id))!=NULL&&!(m->built_in));
  1071.  
  1072. if(e)
  1073. {MCHECK(pargs[2]-pargs[1]-1,"ifdef");
  1074. for(p0= pargs[1]+1;p0<pargs[2];)*mp++= *p0++;}
  1075. else
  1076. {MCHECK(pargs[3]-pargs[2]-1,"ifdef");
  1077. for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
  1078. }
  1079.  
  1080. SRTN i_ifndef_ FCN((n,pargs))
  1081. int n C0("")
  1082. PARGS pargs C1("")
  1083. {
  1084. text_pointer m;
  1085. sixteen_bits id;
  1086. eight_bits HUGE*p0= pargs[0]+1;
  1087. boolean e;
  1088.  
  1089. CHK_ARGS("$IFDEF",3);
  1090.  
  1091. if(TOKEN1(*p0))
  1092. {
  1093.  
  1094. macro_err(OC("! First argument of $IFDEF or $IFNDEF must be a macro"),YES);
  1095. return;
  1096. }
  1097.  
  1098. id= IDENTIFIER(p0[0],p0[1]);
  1099. e= ((m= mac_lookup(id))!=NULL&&!(m->built_in));
  1100.  
  1101. if(!e)
  1102. {MCHECK(pargs[2]-pargs[1]-1,"ifndef");
  1103. for(p0= pargs[1]+1;p0<pargs[2];)*mp++= *p0++;}
  1104. else
  1105. {MCHECK(pargs[3]-pargs[2]-1,"ifndef");
  1106. for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
  1107. }
  1108.  
  1109.  
  1110. SRTN i_ifelse_ FCN((n,pargs))
  1111. int n C0("")
  1112. PARGS pargs C1("")
  1113. {
  1114. eight_bits HUGE*p0;
  1115. eight_bits HUGE*pp0,HUGE*pp1,HUGE*mp0,HUGE*mp1;
  1116. boolean args_identical= YES;
  1117.  
  1118. CHK_ARGS("$IFELSE",4);
  1119.  
  1120. pp0= xmac_text(mp0= mp,pargs[0]+1,pargs[1]);
  1121. mp1= mp;/* |expr0| is now in |(pp0,mp1)|. */
  1122.  
  1123. pp1= xmac_text(mp,pargs[1]+1,pargs[2]);
  1124. /* |expr1| is now in |(pp1,mp)|. */
  1125.  
  1126. /* Are the arguments identical?  For speed, first check just the length of \
  1127. the arguments; then compare byte by byte. */
  1128. if(mp-pp1!=mp1-pp0)
  1129. args_identical= NO;
  1130. else
  1131. while(pp0<mp1)
  1132. if(*pp0++!=*pp1++)
  1133. args_identical= NO;
  1134.  
  1135. mp= mp0;
  1136.  
  1137. if(args_identical)
  1138. {MCHECK(pargs[3]-pargs[2]-1,"_ifelse_");
  1139. for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
  1140. else
  1141. {MCHECK(pargs[4]-pargs[3]-1,"_ifelse_");
  1142. for(p0= pargs[3]+1;p0<pargs[4];)*mp++= *p0++;}
  1143. }
  1144.  
  1145.  
  1146. SRTN i_if_ FCN((n,pargs))
  1147. int n C0("")
  1148. PARGS pargs C1("")
  1149. {
  1150. eight_bits HUGE*pp;
  1151. eight_bits HUGE*mp0;
  1152. eight_bits HUGE*p0;
  1153. boolean e;
  1154.  
  1155. CHK_ARGS("$IF",3);
  1156.  
  1157. pp= xmac_text(mp0= mp,p0= pargs[0]+1,pargs[1]);/* Expand the expr. */
  1158. e= eval(pp,mp);
  1159. mp= mp0;
  1160.  
  1161. if(e)
  1162. {MCHECK(pargs[2]-pargs[1]-1,"_if_");
  1163. for(p0= pargs[1]+1;p0<pargs[2];)*mp++= *p0++;}
  1164. else
  1165. {MCHECK(pargs[3]-pargs[2]-1,"_if_");
  1166. for(p0= pargs[2]+1;p0<pargs[3];)*mp++= *p0++;}
  1167. }
  1168.  
  1169.  
  1170. SRTN i_ifcase_ FCN((n,pargs))
  1171. int n C0("Total number of arguments")
  1172. PARGS pargs C1("")
  1173. {
  1174. eight_bits HUGE*pp;
  1175. eight_bits HUGE*mp0;
  1176. int ncase;
  1177.  
  1178. CHK_ARGS("$IFCASE",-1);
  1179. pp= xmac_text(mp0= mp,pargs[0]+1,pargs[1]);/* Expand the |ncase|. */
  1180. ncase= neval(pp,mp);
  1181. mp= mp0;
  1182. copy_nth_arg(ncase,n-3,pargs);/* Evaluate the |ncase|. */
  1183. }
  1184.  
  1185.  
  1186. SRTN copy_nth_arg FCN((n0,n,pargs))
  1187. int n0 C0("Should be a non-negative integer")
  1188. int n C0("Cases are numbered 0--n, default")
  1189. PARGS pargs C1("")
  1190. {
  1191. eight_bits HUGE*p0;
  1192.  
  1193. if(n0<0||n0>n)n0= n+1;/* Do the default case. */
  1194.  
  1195. n0++;/* Don't count the index argument. */
  1196. MCHECK(pargs[n0+1]-pargs[n0]-1,"copy_nth_arg");
  1197. for(p0= pargs[n0]+1;p0<pargs[n0+1];)*mp++= *p0++;
  1198. }
  1199.  
  1200.  
  1201. SRTN i_switch_ FCN((n,pargs))
  1202. int n C0("")
  1203. PARGS pargs C1("")
  1204. {}
  1205.  
  1206.  
  1207. SRTN undef FCN((cur_val,warning))
  1208. sixteen_bits cur_val C0("Token to be undefined.")
  1209. boolean warning C1("Complain is there's an error?")
  1210. {
  1211. name_pointer np= name_dir+cur_val;
  1212.  
  1213. if(np->macro_type==NOT_DEFINED)
  1214. {
  1215. if(warning)
  1216.  
  1217. macro_err(OC("WARNING: \"%s\" is already undefined"),YES,name_of(cur_val));
  1218.  
  1219. return;
  1220. }
  1221.  
  1222.  
  1223. if(np->equiv==NULL)
  1224. {
  1225. if(np->macro_type==IMMEDIATE_MACRO)
  1226. {
  1227.  
  1228. macro_err(OC("Attempting to @#undef deferred macro \"%s\" \
  1229. during phase 1; consider using $UNDEF(%s)"),YES,name_of(cur_val),name_of(cur_val));
  1230. }
  1231. else
  1232. {
  1233.  
  1234. macro_err(OC("Missing equivalence field while undefining \"%s\"; \
  1235. this shouldn't happen!"),YES,name_of(cur_val));
  1236.  
  1237. np->macro_type= NOT_DEFINED;
  1238. }
  1239.  
  1240. return;
  1241. }
  1242.  
  1243. np->macro_type= NOT_DEFINED;
  1244. ((text_pointer)np->equiv)->nargs= UNDEFINED_MACRO;
  1245. np->equiv= NULL;
  1246. }
  1247.  
  1248.  
  1249. boolean recursive_name FCN((a,xids,last_level))
  1250. sixteen_bits a C0("")
  1251. XIDS HUGE*xids C0("")
  1252. int last_level C1("")
  1253. {
  1254. int i;
  1255.  
  1256. /* Hunt through levels lower than the present one. */
  1257. for(i= 0;i<last_level;i++)
  1258. if(xids->token[i]==a)return YES;
  1259.  
  1260. return NO;
  1261. }
  1262.  
  1263.  
  1264.  
  1265. SRTN macro_err FCN(VA_ALIST((s,trail VA_ARGS)))
  1266. VA_DCL(
  1267. CONST outer_char s[]C0("Error message about macro expansion.")
  1268. int trail C2("Do we print out the expansion trail?"))
  1269. {
  1270. VA_LIST(arg_ptr)
  1271. outer_char HUGE*temp,HUGE*temp1,HUGE*t,HUGE*near_line;
  1272. int i,ntemp;
  1273. #if(NUM_VA_ARGS == 1)
  1274. CONST outer_char s[];
  1275. int trail;
  1276. #endif
  1277.  
  1278. /* We allocate dynamically to keep the size of the stack down. */
  1279. temp= GET_MEM("macro_err:temp",N_MSGBUF,outer_char);
  1280. temp1= GET_MEM("macro_err:temp1",N_MSGBUF,outer_char);
  1281. near_line= GET_MEM("macro_err:near_line",N_MSGBUF,outer_char);
  1282.  
  1283. VA_START(arg_ptr,trail);
  1284.  
  1285. #if(NUM_VA_ARGS==1)
  1286. {
  1287. char*fmt0= va_arg(arg_ptr,char*);
  1288.  
  1289. va_arg(arg_ptr,int);
  1290. vsprintf((char*)(char*)temp1,fmt0,arg_ptr);
  1291. }
  1292. #else
  1293. vsprintf((char*)temp1,(CONST char*)s,arg_ptr);
  1294. #endif
  1295. va_end(arg_ptr);
  1296.  
  1297. if(phase==2)
  1298. if(
  1299. nsprintf(near_line,OC("; near input l. %u"),1,nearest_line)>=(int)(N_MSGBUF))OVERFLW("near_line","");
  1300.  
  1301. /* We surround the message that we construct with double quotes. These are \
  1302. printed into the file, but not to the terminal.  This is to help out \
  1303. preprocessors that parse the message prematurely and get confused by \
  1304. unmatched quotes. */
  1305.  
  1306. if(
  1307. nsprintf(temp,OC("\"%s.  (%s l. %u in %s%s.) %s"),6,temp1,phase==1?"Input":"Output",phase==1?cur_line:OUTPUT_LINE,phase==1?cur_file_name:params.OUTPUT_FILE_NAME,near_line,trail&&(xlevel>0)?"Expanding ":"")>=(int)(N_MSGBUF))OVERFLW("temp","");
  1308.  
  1309. t= temp+STRLEN(temp);
  1310.  
  1311. /* `Print out' levels associated with each invocation of |xmac_buf| by \
  1312. attaching them to end of |temp|. */
  1313. if(trail&&(xlevel>0))
  1314. for(i= 0;i<1;i++)see_xlevel(&t,pids[i]);
  1315.  
  1316. ntemp= STRLEN(temp);
  1317. temp[ntemp]= '"';
  1318. temp[ntemp+1]= '\0';
  1319.  
  1320. /* Message to file. */
  1321. OUT_MSG(to_ASCII(temp),NULL);
  1322.  
  1323. /* Message to terminal. */
  1324. temp[ntemp]= '\0';/* Kill off final quote. */
  1325. printf("\n%s\n",(char*)to_outer((ASCII HUGE*)temp)+1);
  1326.  
  1327. mark_harmless;
  1328.  
  1329. FREE_MEM(temp,"macro_err:temp",N_MSGBUF,outer_char);
  1330. FREE_MEM(temp1,"macro_err:temp1",N_MSGBUF,outer_char);
  1331. FREE_MEM(near_line,"macro_err:near_line",N_MSGBUF,outer_char);
  1332. }
  1333.  
  1334.  
  1335. SRTN see_xlevel FCN((pt,p))
  1336. outer_char HUGE**pt C0("")
  1337. XIDS HUGE*p C1("")
  1338. {
  1339. int i,level;
  1340.  
  1341. level= p->level;/* Total number at this level. */
  1342.  
  1343. for(i= 0;i<level;
  1344. i++,sprintf((char*)(*pt),"%s",i==level?". ":", "),(*pt)+= 2)
  1345. prn_mname(pt,p->token[i]);
  1346. }
  1347.  
  1348. /* Print one name. */
  1349. SRTN prn_mname FCN((pt,token))
  1350. outer_char HUGE**pt C0("")
  1351. sixteen_bits token C1("")
  1352. {
  1353. name_pointer np;
  1354. ASCII HUGE*p;
  1355. CONST ASCII HUGE*end;
  1356.  
  1357. np= name_dir+token;
  1358.  
  1359. PROPER_END(end);
  1360.  
  1361. for(p= np->byte_start;p<end;)
  1362. *(*pt)++= XCHR(*p++);
  1363. }
  1364.  
  1365.  
  1366. SRTN i_inp_line_ FCN((n,pargs))
  1367. int n C0("")
  1368. PARGS pargs C1("")
  1369. {
  1370. num_to_mbuf(n,pargs,"$INPUT_LINE",0,"nearest line",nearest_line);
  1371. }
  1372.  
  1373. SRTN i_outp_line_ FCN((n,pargs))
  1374. int n C0("")
  1375. PARGS pargs C1("")
  1376. {
  1377. num_to_mbuf(n,pargs,"$OUTPUT_LINE",0,"output line",OUTPUT_LINE);
  1378. }
  1379.  
  1380.  
  1381. SRTN num_to_mbuf FCN((n,pargs,built_in_name,num_args,num_descr,num))
  1382. int n C0("")
  1383. PARGS pargs C0("")
  1384. CONST char*built_in_name C0("")
  1385. int num_args C0("")
  1386. CONST char*num_descr C0("")
  1387. int num C1("")
  1388. {
  1389. CHK_ARGS(built_in_name,num_args);
  1390.  
  1391. MCHECK0(20,num_descr);
  1392.  
  1393. *mp++= constant;
  1394. sprintf((char*)mp,"%d",num);
  1395. to_ASCII((outer_char HUGE*)mp);/* Convert the number in place to |ASCII|. */
  1396. mp+= STRLEN(mp);
  1397. *mp++= constant;
  1398. }
  1399.  
  1400.  
  1401.  
  1402. boolean x0macro FCN((p,end,xids,pcur_byte,the_end))
  1403. eight_bits HUGE*p C0("Present position in the input buffer.")
  1404. eight_bits HUGE*end C0("Last filled position of the input \
  1405. buffer plus~1.")
  1406. XIDS HUGE*xids C0("")
  1407. eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
  1408. eight_bits HUGE*the_end C1("End of buffer.")
  1409. {
  1410. boolean expanded;/* Was a macro expanded in this pass? */
  1411. sixteen_bits a;
  1412. eight_bits a0,a1;/* Left and right parts of |sixteen_bits| token. */
  1413. text_pointer m;/* Points to info about current macro being expanded. */
  1414. eight_bits HUGE*p0,HUGE*p1;
  1415. eight_bits HUGE*HUGE*pargs= GET_MEM("pargs",max_margs,eight_bits HUGE*);
  1416. boolean must_paste= NO,pasting= NO;
  1417. int level0= xids->level;
  1418. boolean mac_protected= NO;/* Protection flag flipped by left quote. */
  1419.  
  1420. expanded= NO;/* If no macros were expanded in this pass, then we're done. */
  1421.  
  1422. /* |p| is current position in input buffer. */
  1423. while(p<end)
  1424. {
  1425. a0= *p++;/* The next token to be examined. */
  1426.  
  1427. if(p==end&&a0==012)break;
  1428.  
  1429. if(TOKEN1(a0))
  1430. {
  1431. switch(a0)
  1432. {
  1433. case 0140:
  1434. mac_protected= BOOLEAN(!mac_protected);
  1435. continue;
  1436.  
  1437. case stringg:
  1438. case constant:
  1439. MCHECK(1,"`");
  1440. *mp++= a0;/* |stringg| or |constant| token. */
  1441.  
  1442. copy_string:
  1443. do
  1444. {
  1445. if(!TOKEN1(*mp= *p++))
  1446. {
  1447. MCHECK(1,"id prefix");
  1448. *++mp= *p++;
  1449. }
  1450. MCHECK(1,"8-bit token");
  1451. }
  1452. while(*mp++!=a0);
  1453.  
  1454. if(a0==stringg)
  1455. {
  1456. eight_bits HUGE*p00;
  1457.  
  1458. /* Scan over possible white space. */
  1459. for(p00= p;p<end;p++)
  1460. if(*p!=040&&*p!=011)break;
  1461.  
  1462. if(p<end&&*p==stringg)
  1463. {
  1464. eight_bits mchar= *(mp-2);/* Quote character from last string. */
  1465. eight_bits pchar= *(p+1);/* Quote character from next string. */
  1466.  
  1467. if((mchar==047||mchar==042)&&
  1468. (pchar==047||pchar==042))
  1469. {
  1470. mp-= 2;/* Back over |stringg| and quote char. */
  1471. p+= 2;/* Move over |stringg| and quote char. */
  1472. goto copy_string;
  1473. }
  1474. }
  1475. else p= p00;/* Didn't find another string. */
  1476. }
  1477.  
  1478.  
  1479.  
  1480. continue;
  1481.  
  1482. case dot_const:
  1483. MCHECK(2,"dot_const");
  1484. *mp++= a0;
  1485. *mp++= *p++;
  1486. continue;
  1487.  
  1488. default:
  1489. MCHECK(1,"`");
  1490. *mp++= a0;/* Copy over ASCII token to the macro buffer. */
  1491. continue;
  1492. }
  1493. }
  1494.  
  1495.  
  1496. else
  1497. {
  1498. a= IDENTIFIER(a0,a1= *p++);
  1499.  
  1500. if(a==id_defined)
  1501. {
  1502.  
  1503. {
  1504. MCHECK(6,"defined stuff");
  1505.  
  1506. /* Copy the |defined| token. */
  1507. *mp++= a0;
  1508. *mp++= a1;
  1509.  
  1510. ERR_IF_DEFINED_AT_END;
  1511. if(TOKEN1(a0= *p++))/* Possible parenthesis */
  1512. {
  1513. if(a0!=050)DEFINED_ERR("! Invalid token after `defined'")
  1514. else*mp++= a0;
  1515.  
  1516. ERR_IF_DEFINED_AT_END;
  1517. if(TOKEN1(a0= *p++))DEFINED_ERR("! Invalid argument of `defined'")
  1518. else
  1519. {/* Copy parenthesized id token. */
  1520. *mp++= a0;
  1521. *mp++= *p++;
  1522. }
  1523.  
  1524. ERR_IF_DEFINED_AT_END;
  1525. if(TOKEN1(a0= *p++))
  1526. if(a0!=051)DEFINED_ERR("! Missing ')' after `defined'")
  1527. else*mp++= a0;
  1528. }
  1529. else
  1530. {/* Copy non-parenthesized id token. */
  1531. *mp++= a0;
  1532. *mp++= *p++;
  1533. }
  1534. }
  1535.  
  1536.  
  1537.  
  1538. continue;
  1539. }
  1540.  
  1541. /* If it's a macro token, we must decide whether to expand it. If this \
  1542. token is already on the |xids| stack from an earlier level of recursive \
  1543. expansion, then we don't expand. If we haven't encountered this name \
  1544. before, then we expand the macro. */
  1545. if((m= MAC_LOOKUP(a))!=NULL)
  1546. if(mac_protected)
  1547. {
  1548. MCHECK(2,"protected macro token");
  1549. *mp++= a0;
  1550. *mp++= a1;
  1551. }
  1552. else if(recursive_name(a,xids,level0))
  1553.  
  1554. {
  1555. name_pointer np;
  1556. CONST ASCII HUGE*end;
  1557.  
  1558. np= name_dir+a;
  1559.  
  1560. PROPER_END(end);
  1561. copy_id(np->byte_start,end,"recursive macro name");
  1562.  
  1563. /* Can't do this; infinite recursion! */
  1564. }
  1565.  
  1566.  
  1567.  
  1568.  
  1569. else
  1570. {
  1571. int slevel= ignore;
  1572.  
  1573. if(!m->recursive)save_name(a);/* To prevent recursion. */
  1574.  
  1575. {
  1576. eight_bits n= 0;/* Number of actual arguments found. */
  1577. eight_bits HUGE*mp0= NULL,HUGE*mp1,HUGE*m_start,HUGE*m_end;
  1578. boolean xpn_argument= YES;
  1579. boolean last_was_paste;
  1580. long max_n= 0;/* Maximum statement label offset encountered. */
  1581.  
  1582.  
  1583. /* Get pointers to $n$~actual argument tokens. */
  1584. if(m->nargs>0||m->var_args)
  1585. p= get_margs0(p-2,end,pcur_byte,the_end,
  1586. (boolean)(m->var_args),pargs,&n);
  1587.  
  1588. if((!m->var_args&&n!=m->nargs)||(m->var_args&&n<m->nargs))
  1589. {
  1590.  
  1591. macro_err(OC("! Actual number of WEB macro arguments (%u) does not match \
  1592. number of def'n (%u); %s"),YES,n,m->nargs,n<m->nargs?"missing ones assumed to be NULL":
  1593. "extra ones discarded");
  1594.  
  1595. /* If there are too many, we'll just ignore the remainder. However, if \
  1596. there are too few, we'll essentially supply null arguments by fleshing out \
  1597. the pointer list. */
  1598. while(n<m->nargs)
  1599. {
  1600. pargs[n+1]= pargs[n]+1;
  1601. n++;
  1602. }
  1603. }
  1604.  
  1605. /* Copy macro text, substituting arguments. */
  1606. m_start= mp;/* Remember the beginning. */
  1607. last_was_paste= NO;/* Remember whether last token was |paste|. */
  1608.  
  1609. if(m->built_in)
  1610. {
  1611. (*(SRTN(*)(int,unsigned char**))(m->tok_start))(n,pargs);
  1612. }
  1613. else
  1614. {
  1615. /* Beginning and end of the text for this macro. */
  1616. p0= m->tok_start+m->moffset;
  1617. p1= (m+1)->tok_start;
  1618.  
  1619. while(p0<p1)
  1620. {
  1621. if(TOKEN1(a= *p0++))
  1622. {
  1623. if(!(a==043&&*p0==056))last_was_paste= NO;
  1624.  
  1625. if(p0==p1&&a==012)break;
  1626.  
  1627. switch(a)
  1628. {
  1629. case 043:
  1630.  
  1631. {
  1632. keep_intact= NO;
  1633.  
  1634. switch(*p0++)
  1635. {
  1636. case 046:
  1637.  
  1638. {
  1639. sixteen_bits id;
  1640.  
  1641.  
  1642. if(p0==p1)
  1643. macro_err(OC("! Missing internal function name after #&"),YES);
  1644. else
  1645. {
  1646. if(TOKEN1(a= *p0++))
  1647. macro_err(OC("! Identifier must follow #&"),YES);
  1648. else if(!x_int_fcn(id= IDENTIFIER(a,*p0++),n,pargs))
  1649.  
  1650. macro_err(OC("! Internal function name \"%s\" not defined"),YES,name_of(id));
  1651. }
  1652. }
  1653.  
  1654. break;
  1655.  
  1656. case 072:
  1657.  
  1658. {
  1659. int m;
  1660. long n;/* Label increment. */
  1661. outer_char*tmp;/* Temporary buffer for the number. */
  1662. size_t i;
  1663.  
  1664.  
  1665. if(*p0!=constant)
  1666. {
  1667.  
  1668. macro_err(OC("Expected constant after \"#:\""),YES);
  1669. break;
  1670. }
  1671.  
  1672. p0++;/* Position after |constant|. */
  1673.  
  1674. for(i= 0;p0[i]!=constant;i++)
  1675. ;/* Find size of the constant. */
  1676.  
  1677. tmp= GET_MEM("stmt number",i+1,outer_char);
  1678.  
  1679. /* Convert to |outer_char|, and also position to after |constant|. */
  1680. for(i= 0;*p0!=constant;i++,p0++)
  1681. tmp[i]= XCHR(*p0);
  1682. tmp[i+1]= '\0';
  1683. p0++;
  1684.  
  1685. n= ATOL(tmp);/* Convert the following number. */
  1686.  
  1687. FREE_MEM(tmp,"stmt number",i+1,outer_char);
  1688.  
  1689. if(n<=0)
  1690. {
  1691.  
  1692. macro_err(OC("! Invalid statement number offset (%ld) after #:; 1 assumed"),YES,n);
  1693. n= 1;
  1694. }
  1695.  
  1696. if(n>max_n)max_n= n;/* Remember the maximum offset. */
  1697.  
  1698. MCHECK(2,"|constant|");
  1699. *mp++= constant;
  1700.  
  1701. m= 
  1702. nsprintf((outer_char*)mp,OC("%lu"),1,max_stmt+n-1);
  1703. MCHECK(m,"stmt label");
  1704. to_ASCII((outer_char HUGE*)mp);
  1705. mp+= m;
  1706.  
  1707. *mp++= constant;
  1708. }
  1709.  
  1710.  
  1711. break;
  1712.  
  1713. case 041:
  1714. if(*p0==MACRO_ARGUMENT)xpn_argument= NO;
  1715. else
  1716. macro_err(OC("! Macro token '#!' must be followed by \
  1717. a parameter"),YES);
  1718. break;
  1719.  
  1720. case 047:
  1721. single_quote= YES;
  1722. DOES_ARG_FOLLOW('\'');
  1723. goto do_stringize;
  1724.  
  1725. case 042:
  1726. double_quote= YES;
  1727. DOES_ARG_FOLLOW('\"');/* Without the escape, bug on VAX. */
  1728. goto do_stringize;
  1729.  
  1730. case 052:
  1731. DOES_ARG_FOLLOW('*');
  1732. keep_intact= YES;
  1733. /* Falls through to next case! */
  1734.  
  1735. case MACRO_ARGUMENT:
  1736.  
  1737. {
  1738. eight_bits HUGE*begin;
  1739.  
  1740.  
  1741. do_stringize:
  1742. for(begin= pargs[*p0]+1;*begin=='\0';begin++)
  1743. ;/* Skip over leading nulls (that possibly replace protection \
  1744.         characters. */
  1745.  
  1746.  
  1747. MCHECK(1,"stringg");*mp++= stringg
  1748.  
  1749. ;
  1750.  
  1751. if(!keep_intact||*begin!=stringg)
  1752.  
  1753. {
  1754. MCHECK(1,"quote");
  1755. *mp++= (eight_bits)(single_quote||(!double_quote&&R77_or_F)?
  1756. 047:042);
  1757. }
  1758.  
  1759.  
  1760.  
  1761. str_to_mb(begin,pargs[*p0+1],YES);
  1762. p0++;/* Don't put this into previous stmt, because order of evaluation is \
  1763.         undefined. */
  1764.  
  1765. if(!keep_intact||*begin!=stringg)
  1766.  
  1767. {
  1768. MCHECK(1,"quote");
  1769. *mp++= (eight_bits)(single_quote||(!double_quote&&R77_or_F)?
  1770. 047:042);
  1771. }
  1772.  
  1773.  
  1774.  
  1775.  
  1776. MCHECK(1,"stringg");*mp++= stringg
  1777.  
  1778. ;
  1779.  
  1780. single_quote= double_quote= NO;
  1781. }
  1782.  
  1783. break;
  1784.  
  1785. case 060:
  1786.  
  1787. {
  1788. eight_bits HUGE*mp0;/* For converting the number to |ASCII|. */
  1789.  
  1790. p0+= 2;/* Skip over null tokens. */
  1791.  
  1792. MCHECK(4,"tokens for number of variable arguments");
  1793. *mp++= constant;
  1794. mp0= mp;
  1795. mp+= 
  1796. nsprintf((outer_char*)mp0,OC("%d"),1,n-m->nargs);
  1797. to_ASCII((outer_char HUGE*)mp0);
  1798. *mp++= constant;
  1799. }
  1800.  
  1801.  
  1802. break;
  1803.  
  1804. case 0173:
  1805.  
  1806. expanded|= ins_arg(0173,0175,INS_ARG_LIST);
  1807.  
  1808.  
  1809. break;
  1810.  
  1811. case 0133:
  1812.  
  1813. expanded|= ins_arg(0133,0135,INS_ARG_LIST);
  1814.  
  1815.  
  1816. break;
  1817.  
  1818. case 056:
  1819.  
  1820. {
  1821. eight_bits k;
  1822. boolean next_is_paste= BOOLEAN(*p0==paste);
  1823.  
  1824. for(k= m->nargs;k<n;k++)
  1825. {
  1826. pasting= cp_macro_arg(pargs,k,n,&xpn_argument,
  1827. (boolean)(last_was_paste&&k==m->nargs),
  1828. (boolean)(next_is_paste&&k==(eight_bits)(n-1)));
  1829. *mp++= 054;
  1830. }
  1831.  
  1832. if(*(mp-1)==054)mp--;
  1833. /* If we inserted at least one arg, kill off last comma. */
  1834. }
  1835.  
  1836.  
  1837. break;
  1838.  
  1839. default:
  1840. p0--;
  1841.  
  1842. macro_err(OC(_Xx("! Invalid token 0x%x ('%c') after '#'")),YES,*p0,isprint(*p0)?*p0:'.');
  1843. break;
  1844. }
  1845. }
  1846.  
  1847.  
  1848. break;
  1849.  
  1850. case stringg:
  1851. MCHECK(1,"\"");
  1852. *mp++= (eight_bits)a;/* |stringg| token. */
  1853.  
  1854. do
  1855. {
  1856. if(!TOKEN1(*mp= *p0++))
  1857. {
  1858. MCHECK(1,"id prefix");
  1859. *++mp= *p0++;
  1860. }
  1861. MCHECK(1,"8-bit token");
  1862. }
  1863. while(*mp++!=(eight_bits)a);
  1864.  
  1865. break;
  1866.  
  1867. case dot_const:
  1868. MCHECK(2,"dot_const");
  1869. *mp++= (eight_bits)a;
  1870. *mp++= *p0++;
  1871. break;
  1872.  
  1873. default:
  1874. /* Copy over single-byte token; remember if it was |paste|. */
  1875. MCHECK(1,"single-byte token");
  1876. if((*mp++= (eight_bits)a)==paste)
  1877. last_was_paste= must_paste= YES;
  1878. break;
  1879. }
  1880. }
  1881.  
  1882.  
  1883. else if(a==MACRO_ARGUMENT)
  1884. {
  1885. eight_bits k= *p0++;
  1886.  
  1887. pasting= cp_macro_arg(pargs,k,n,&xpn_argument,
  1888. last_was_paste,(boolean)(*p0==paste));
  1889. }
  1890. else
  1891. {/* Copy nonargument two-byte macro token. */
  1892. last_was_paste= NO;
  1893. MCHECK(2,"nonargument macro token");
  1894. *mp++= (eight_bits)a;
  1895. *mp++= *p0++;
  1896. }
  1897. }
  1898. }
  1899.  
  1900.  
  1901.  
  1902. /* If any |paste| tokens were encountered, implement them. */
  1903. if(must_paste)
  1904. {
  1905. m_end= mp;/* End of the macro tokens to be scanned for pasting; beginning \
  1906.         of the new, pasted expansion. */
  1907.  
  1908. /* Copy from |mp0| to |mp|. If we find |paste|, execute that operation. */
  1909. copy_and_paste(m_start,m_end);
  1910.  
  1911. /* Copy pasted expansion back to start of this macro. */
  1912. for(mp1= mp,mp= m_start,mp0= m_end;mp0<mp1;)
  1913. *mp++= *mp0++;
  1914. }
  1915.  
  1916.  
  1917.  
  1918. if(max_n>0)max_stmt+= max_n;
  1919.  
  1920. xpn_before(m_start,xids,pcur_byte,the_end);
  1921. #if 0
  1922. if(must_paste)
  1923. #endif
  1924. expanded= YES;/* If we pasted something, a new macro may \
  1925.                 have been created. */
  1926. }
  1927.  
  1928.  
  1929. if(!m->recursive)unsave_name;
  1930. }
  1931. else
  1932. {/* Copy a nonmacro 2-byte token to the output buffer (pointed to \
  1933. by~|mp|). */
  1934. MCHECK(2,"ordinary id");
  1935. *mp++= a0;
  1936. *mp++= a1;
  1937.  
  1938. /* If we're actually dealing with a module name, we punt here and don't \
  1939. expand it at this time; it will be expanded on output. */
  1940. if(a0>=0250)
  1941. {
  1942. int n= 2+4*1;/* `1' for |line_info|. */
  1943.  
  1944. MCHECK(n,"module defn");
  1945. while(n-->0)
  1946. *mp++= *p++;
  1947. }
  1948. }
  1949. }
  1950.  
  1951.  
  1952.  
  1953. }
  1954.  
  1955. /* Get directly to here from |MACRO_ERR|. */
  1956. done_expanding:
  1957. FREE_MEM(pargs,"pargs",max_margs,eight_bits HUGE*);
  1958. return expanded;/* Return flag to say whether any macro was \
  1959.             expanded. If nothing was, then we're done. */
  1960. }
  1961.  
  1962.  
  1963. SRTN cpy_op FCN((s))
  1964. CONST outer_char HUGE*s C1("String such as \.{++}.")
  1965. {
  1966. MCHECK(2,"cpy_op");
  1967.  
  1968. while(*s)
  1969. *mp++= XORD(*s++);
  1970.  
  1971. copy_state= MISCELLANEOUS;
  1972. }
  1973.  
  1974.  
  1975. eight_bits HUGE*str_to_mb FCN((begin_arg,end_arg,esc_chars))
  1976. CONST eight_bits HUGE*begin_arg C0("Beginning of string.")
  1977. CONST eight_bits HUGE*end_arg C0("End of string.")
  1978. boolean esc_chars C1("Insert escape characters?")
  1979. {
  1980. eight_bits HUGE*mp0= mp;
  1981. sixteen_bits c;
  1982.  
  1983. copy_state= MISCELLANEOUS;
  1984.  
  1985. while(begin_arg<end_arg)
  1986. {
  1987. if(TOKEN1(c= *begin_arg++))
  1988. {
  1989.  
  1990.  
  1991. switch(c)
  1992. {
  1993. case ignore:
  1994. break;
  1995.  
  1996.  
  1997.  
  1998. CPY_OP(plus_plus,"++");
  1999. CPY_OP(minus_minus,"--");
  2000. CPY_OP(minus_gt,C_LIKE(language)?"->":".EQV.");
  2001. CPY_OP(gt_gt,">>");
  2002. CPY_OP(eq_eq,"==");
  2003. CPY_OP(lt_lt,"<<");
  2004. CPY_OP(gt_eq,">=");
  2005. CPY_OP(lt_eq,"<=");
  2006. CPY_OP(not_eq,"!=");
  2007. CPY_OP(and_and,"&&");
  2008. CPY_OP(or_or,"||");
  2009. CPY_OP(star_star,"**");
  2010. CPY_OP(slash_slash,"//");
  2011. CPY_OP(ellipsis,C_LIKE(language)?"...":".XOR.");
  2012.  
  2013. case dot_const:
  2014. cpy_op(OC("."));
  2015. {
  2016. ASCII*symbol= dots[*begin_arg++].symbol;
  2017.  
  2018. cpy_op(to_outer(symbol));
  2019. to_ASCII((outer_char*)symbol);
  2020. }
  2021. cpy_op(OC("."));
  2022. break;
  2023.  
  2024.  
  2025.  
  2026. case join:
  2027. copy_state= UNBREAKABLE;
  2028. break;
  2029.  
  2030. case constant:
  2031. if(copy_state==NUM_OR_ID)
  2032.  
  2033. {
  2034. MCHECK(1,"' '");*mp++= 040;
  2035. }
  2036.  
  2037.  
  2038.  
  2039. {
  2040. if(!keep_intact&&c==stringg)esc_certain_chars(*begin_arg++,YES);
  2041. /* Escape the opening quote. */
  2042.  
  2043. while(*begin_arg!=(eight_bits)c)
  2044. {
  2045. MCHECK(1,"constant");
  2046. *mp++= *begin_arg++;
  2047. }
  2048.  
  2049. if(!keep_intact&&c==stringg)
  2050. esc_certain_chars((sixteen_bits)*(--mp),YES);/* Escape the closing \
  2051. quote. */
  2052.  
  2053. begin_arg++;/* Skip the closing |stringg| or |constant|. */
  2054. }
  2055.  
  2056.  
  2057. copy_state= NUM_OR_ID;
  2058. break;
  2059.  
  2060. case stringg:
  2061.  
  2062. {
  2063. if(!keep_intact&&c==stringg)esc_certain_chars(*begin_arg++,YES);
  2064. /* Escape the opening quote. */
  2065.  
  2066. while(*begin_arg!=(eight_bits)c)
  2067. {
  2068. MCHECK(1,"constant");
  2069. *mp++= *begin_arg++;
  2070. }
  2071.  
  2072. if(!keep_intact&&c==stringg)
  2073. esc_certain_chars((sixteen_bits)*(--mp),YES);/* Escape the closing \
  2074. quote. */
  2075.  
  2076. begin_arg++;/* Skip the closing |stringg| or |constant|. */
  2077. }
  2078.  
  2079.  
  2080. copy_state= MISCELLANEOUS;
  2081. break;
  2082.  
  2083. case 073:
  2084. if(R77_or_F)
  2085. {
  2086.  
  2087. {
  2088. MCHECK(3,"\";\"");
  2089. *mp++= constant;
  2090. *mp++= 073;
  2091. *mp++= constant;
  2092. }
  2093.  
  2094. ;
  2095. break;
  2096. }
  2097.  
  2098. default:
  2099. esc_certain_chars(c,esc_chars);
  2100. if(copy_state!=VERBATIM)copy_state= MISCELLANEOUS;
  2101. break;
  2102. }
  2103.  
  2104.  
  2105. }
  2106. else
  2107. {
  2108. name_pointer np;
  2109.  
  2110. if(copy_state==NUM_OR_ID)
  2111.  
  2112. {
  2113. MCHECK(1,"' '");*mp++= 040;
  2114. }
  2115.  
  2116.  
  2117.  
  2118. if(c==MACRO_ARGUMENT)
  2119.  
  2120. {
  2121. outer_char temp[10];
  2122. int n;
  2123.  
  2124. n= 
  2125. nsprintf(temp,OC("$%d"),1,*begin_arg++);
  2126. to_ASCII(temp);
  2127. MCHECK(n,"%arg");
  2128. STRCPY(mp,temp);
  2129. mp+= n;
  2130. }
  2131.  
  2132.  
  2133. else
  2134.  
  2135. {
  2136. c= IDENTIFIER(c,*begin_arg++);
  2137.  
  2138. switch(c/MODULE_NAME)
  2139. {
  2140. case 0:/* Ordinary identifier. */
  2141. np= name_dir+c;
  2142.  
  2143. {
  2144. TRUNC HUGE*s;
  2145. ASCII HUGE*pc= np->byte_start;
  2146.  
  2147. if(*pc!=BP_MARKER)
  2148. {/* Not truncated. */
  2149. CONST ASCII HUGE*end;
  2150.  
  2151. PROPER_END(end);
  2152. copy_id((CONST ASCII HUGE*)pc,end,"copied id");
  2153. }
  2154. else
  2155. {
  2156. s= ((BP HUGE*)pc)->Root;
  2157. copy_id(s->id,s->id_end,"copied id");
  2158. }
  2159. }
  2160.  
  2161.  
  2162. break;
  2163.  
  2164. case 1:/* Module name. */
  2165. *mp++= 043;
  2166. *mp++= 074;
  2167.  
  2168. c-= MODULE_NAME;
  2169.  
  2170. np= name_dir+c;
  2171.  
  2172. if(np->equiv!=(EQUIV)text_info)
  2173.  
  2174. {
  2175. TRUNC HUGE*s;
  2176. ASCII HUGE*pc= np->byte_start;
  2177.  
  2178. if(*pc!=BP_MARKER)
  2179. {/* Not truncated. */
  2180. CONST ASCII HUGE*end;
  2181.  
  2182. PROPER_END(end);
  2183. copy_id((CONST ASCII HUGE*)pc,end,"copied id");
  2184. }
  2185. else
  2186. {
  2187. s= ((BP HUGE*)pc)->Root;
  2188. copy_id(s->id,s->id_end,"copied id");
  2189. }
  2190. }
  2191.  
  2192.  
  2193. else if(c!=UNNAMED_MODULE)*mp++= 077;
  2194.  
  2195. *mp++= 0100;
  2196. *mp++= 076;
  2197. break;
  2198.  
  2199. default:
  2200. if(c==MODULE_NUM)
  2201. begin_arg+= 4*1;/* `1' for |line_info|. */
  2202. /* Skip over line number info. */
  2203. break;
  2204. }
  2205. }
  2206.  
  2207.  
  2208.  
  2209. copy_state= NUM_OR_ID;
  2210. }
  2211. }
  2212.  
  2213. *mp= '\0';
  2214. return mp0;
  2215. }
  2216.  
  2217.  
  2218. SRTN esc_certain_chars FCN((c,esc_chars))
  2219. sixteen_bits c C0("Character to be maybe escaped.")
  2220. boolean esc_chars C1("Do we escape them?")
  2221. {
  2222. if(esc_chars)
  2223. if(C_LIKE(language))
  2224. {
  2225. if(c==0134||c==042)
  2226. {
  2227. MCHECK(1,"'\\'");
  2228. *mp++= 0134;
  2229. }
  2230. }
  2231. else if(R77_or_F)
  2232. {
  2233. if(c==047)
  2234. {
  2235. MCHECK(1,"doubled quote");
  2236. *mp++= (eight_bits)c;/* Double the quote in Fortran \
  2237. string. */
  2238. }
  2239. }
  2240. else
  2241. {
  2242. if(c==042)
  2243. {
  2244. MCHECK(1,"'\"'");
  2245. *mp++= (eight_bits)c;
  2246. }
  2247. }
  2248.  
  2249. /* We've added the escape character. Now copy the character itself. */
  2250. MCHECK(1,"escaped character");
  2251. *mp++= (eight_bits)c;
  2252. }
  2253.  
  2254.  
  2255. SRTN i_len_ FCN((n,pargs))
  2256. int n C0("")
  2257. PARGS pargs C1("")
  2258. {
  2259. int m,num;
  2260.  
  2261. CHK_ARGS("$LEN",1);
  2262.  
  2263. m= (int)(pargs[1]-pargs[0]-5);
  2264. /* 5: 1 from |pargs[0]|, 2 from |constant|, 2 from quotes. \
  2265.         Should this be |unsigned|? */
  2266.  
  2267. num= 
  2268. nsprintf((outer_char HUGE*)mp,OC("%d"),1,m);
  2269. MCHECK(num,"_len_");
  2270. to_ASCII((outer_char HUGE*)mp);
  2271. mp+= num;
  2272. }
  2273.  
  2274.  
  2275. SRTN i_verbatim_ FCN((n,pargs))
  2276. int n C0("")
  2277. PARGS pargs C1("")
  2278. {
  2279. eight_bits HUGE*p,delim[2];
  2280. eight_bits quote_char[3];
  2281.  
  2282. CHK_ARGS("$VERBATIM",1);
  2283.  
  2284. if(*(p= pargs[0]+1)!=stringg)
  2285. {
  2286. MUST_QUOTE("$VERBATIM",p,pargs[1]);
  2287. return;
  2288. }
  2289.  
  2290. STRNCPY(delim,"\0\0",2);
  2291. STRNCPY(quote_char,"\42\0\0",3);
  2292.  
  2293. /* At this point, |quote_char[0]| is initialized to a double quote. */
  2294. switch(language)
  2295. {
  2296. case FORTRAN:
  2297. quote_char[0]= 047;
  2298. break;
  2299.  
  2300. case FORTRAN_90:
  2301. quote_char[1]= 047;/* Two possibilities for \Fortran--90. */
  2302. break;
  2303.  
  2304. case TEX:
  2305. return;
  2306.  
  2307. default:
  2308. break;
  2309. }
  2310.  
  2311. /* Beginning |stringg| token. */
  2312. MCHECK(1,"string token");
  2313. *mp++= *p++;
  2314.  
  2315. /* Check to ensure it's really a quoted string. */
  2316. delim[0]= *p;/* Make the quote character into a string. */
  2317.  
  2318. if(STRSPN(delim,quote_char))p++;/* Advance over the quote. */
  2319. else delim[0]= stringg;
  2320.  
  2321. while(*p!=stringg)
  2322. {
  2323. MCHECK(1,"verbatim token");
  2324. *mp++= *p++;
  2325. }
  2326.  
  2327. /* Kill off the final quote, replacing it by |stringg|. */
  2328. if(STRSPN(delim,quote_char))*(mp---1)= stringg;
  2329. }
  2330.  
  2331.  
  2332. SRTN i_unstring_ FCN((n,pargs))
  2333. int n C0("")
  2334. PARGS pargs C1("")
  2335. {
  2336. eight_bits HUGE*p,delim[2];
  2337. eight_bits quote_char[3];
  2338.  
  2339. CHK_ARGS("$UNSTRING",1);
  2340.  
  2341. if(*(p= pargs[0]+1)!=stringg)
  2342. {
  2343. MUST_QUOTE("$UNSTRING",p,pargs[1]);
  2344. return;
  2345. }
  2346.  
  2347. STRNCPY(delim,"\0\0",2);
  2348. STRNCPY(quote_char,"\42\0\0",3);
  2349.  
  2350. /* At this point, |quote_char[0]| is initialized to a double quote. */
  2351. switch(language)
  2352. {
  2353. case FORTRAN:
  2354. quote_char[0]= 047;
  2355. break;
  2356.  
  2357. case FORTRAN_90:
  2358. quote_char[1]= 047;/* Two possibilities for \Fortran--90. */
  2359. break;
  2360.  
  2361. case TEX:
  2362. return;
  2363.  
  2364. default:
  2365. break;
  2366. }
  2367.  
  2368. /* Skip beginning |stringg| token. */
  2369. p++;
  2370.  
  2371. /* Check to ensure it's really a quoted string. */
  2372. delim[0]= *p;/* Make the quote character into a string. */
  2373.  
  2374. if(STRSPN(delim,quote_char))
  2375. p++;/* Advance over the quote. */
  2376. else
  2377. delim[0]= stringg;
  2378.  
  2379. while(*p!=stringg)
  2380. {
  2381. MCHECK(1,"verbatim token");
  2382. *mp++= *p++;
  2383. }
  2384.  
  2385. /* Kill off the final quote */
  2386. if(STRSPN(delim,quote_char))
  2387. mp--;
  2388. }
  2389.  
  2390.  
  2391. SRTN must_quote FCN((name,p,p1))
  2392. CONST outer_char*name C0("")
  2393. eight_bits HUGE*p C0("")
  2394. eight_bits HUGE*p1 C1("")
  2395. {
  2396.  
  2397. macro_err(OC("! Argument of %s must be a quoted string"),YES,name);
  2398.  
  2399. /* Just copy over the argument. */
  2400. MCHECK(p1-p,"copy quotes");
  2401. while(p<p1)*mp++= *p++;
  2402. }
  2403.  
  2404.  
  2405. SRTN i_translit_ FCN((n,pargs))
  2406. int n C0("")
  2407. PARGS pargs C1("")
  2408. {
  2409. int k;
  2410.  
  2411. CHK_ARGS("$TRANSLIT",3);
  2412.  
  2413. for(k= 0;k<2;k++)
  2414. if(*(pargs[k]+1)!=stringg)
  2415. macro_err(OC("! Argument %d of $TRANSLIT \
  2416. must be a string"),YES,k);
  2417.  
  2418. translit((ASCII HUGE*)(pargs[0]+2),
  2419. (ASCII HUGE*)(pargs[1]+2),
  2420. (ASCII HUGE*)(pargs[2]+2));
  2421. }
  2422.  
  2423.  
  2424. SRTN translit FCN((s,from,to))
  2425. CONST ASCII HUGE*s C0("String to be transliterated")
  2426. CONST ASCII HUGE*from C0("Characters to replace")
  2427. CONST ASCII HUGE*to C1("Replace by")
  2428. {
  2429. short code[128],i,n;
  2430. ASCII end_char= *s++;
  2431. ASCII c,cfrom,cto;
  2432. ASCII esc_achar PROTO((CONST ASCII HUGE*HUGE*));
  2433.  
  2434. CHECK_QUOTE(from,1);
  2435. CHECK_QUOTE(to,2);
  2436.  
  2437.  
  2438. MCHECK(1,"stringg");*mp++= stringg
  2439.  
  2440. ;
  2441.  
  2442. /* First, construct the identity. */
  2443. for(i= 0;i<128;i++)
  2444. code[i]= i;
  2445.  
  2446. /* Put the new characters into the table. */
  2447. while(*(to+1)!=stringg)
  2448. {
  2449. if(*(from+1)==stringg)break;/* Stop when the |from| characters end. */
  2450.  
  2451. /* We must watch out for escaped characters. */
  2452. if((cfrom= *from++)==0134)cfrom= esc_achar(&from);
  2453. if((cto= *to++)==0134)cto= esc_achar(&to);
  2454.  
  2455. code[cfrom]= cto;
  2456. }
  2457.  
  2458. /* If there are more |from| characters than replacement ones, give the \
  2459. extra ones a special delete code of~|-1|. */
  2460. if(*(from+1)!=stringg)
  2461. while(*(from+1)!=stringg)
  2462. {
  2463. if((cfrom= *from++)==0134)cfrom= esc_achar(&from);
  2464.  
  2465. code[cfrom]= -1;/* Delete code. */
  2466. }
  2467.  
  2468. /* Now translate the string. */
  2469. while(*(s+1)!=stringg)
  2470. {
  2471. if((c= *s++)==0134)c= esc_achar(&s);
  2472.  
  2473. if((n= code[c])==-1)continue;/* Skip deleted characters. */
  2474. MCHECK(1,"_translit_");
  2475. *mp++= (eight_bits)n;/* Put the translation into the |macrobuf|. */
  2476. }
  2477.  
  2478.  
  2479. MCHECK(1,"stringg");*mp++= stringg
  2480.  
  2481. ;
  2482. }
  2483.  
  2484.  
  2485. SRTN i_getenv_ FCN((n,pargs))
  2486. int n C0("")
  2487. PARGS pargs C1("")
  2488. {
  2489. ASCII HUGE*p;
  2490. outer_char*pvar,HUGE*t;
  2491. outer_char HUGE*temp,HUGE*temp_end;/* Holds the name of the requested \
  2492.                     variable. */
  2493.  
  2494. #if !HAVE_GETENV
  2495.  
  2496. macro_err(OC("Sorry, this machine doesn't support getenv"),YES);
  2497. #else
  2498.  
  2499. CHK_ARGS("$GETENV",1);
  2500.  
  2501.  
  2502. temp= GET_MEM("_getenv_:temp",N_ENVBUF,outer_char);
  2503. temp_end= temp+N_ENVBUF;
  2504.  
  2505. for(p= (ASCII HUGE*)(pargs[0]+3),t= temp;*(p+1)!=stringg;)
  2506. SAVE_ENV(*p++);
  2507.  
  2508. SAVE_ENV('\0');
  2509.  
  2510. if((pvar= GETENV((CONST char*)temp))!=NULL)mcopy(pvar);
  2511.  
  2512. FREE_MEM(temp,"_getenv_:temp",N_ENVBUF,outer_char);
  2513.  
  2514. #endif /* |HAVE_GETENV| */
  2515. }
  2516.  
  2517.  
  2518. boolean cp_macro_arg FCN((pargs,k,n,pxpn_argument,
  2519. last_was_paste,next_is_paste))
  2520. PARGS pargs C0("")
  2521. eight_bits k C0("Current argument to process")
  2522. eight_bits n C0("")
  2523. boolean HUGE*pxpn_argument C0("")
  2524. boolean last_was_paste C0("")
  2525. boolean next_is_paste C1("")
  2526. {
  2527. boolean pasting;
  2528. eight_bits HUGE*begin_arg,HUGE*end_arg,HUGE*mp0= NULL;
  2529.  
  2530. /* Check for requested argument number bigger than the maximum actually \
  2531. used in the call. */
  2532. if(k>=n)
  2533. {/* Make it of zero length. */
  2534. pargs[k]= pargs[n];
  2535. pargs[k+1]= pargs[n]+1;
  2536. }
  2537.  
  2538. begin_arg= pargs[k]+1;/* The next byte (|k|) after the marker token \
  2539.     has the argument number. Make \
  2540.     |begin_arg| point to the token list of the appropriate actual \
  2541.     argument. */
  2542. while(*begin_arg==012)begin_arg++;
  2543.  
  2544. end_arg= pargs[k+1];/* The end is in the next element of |pargs|. */
  2545.  
  2546. /* Check if the last (already copied to |macrobuf|) or next token to this \
  2547. parameter is |paste|. */
  2548. if(last_was_paste||next_is_paste)pasting= YES;
  2549. else
  2550. {
  2551. pasting= NO;
  2552. mp0= mp;/* Remember where this argument text started. */
  2553. }
  2554.  
  2555. /* Copy the tokens of the argument. If it's a null argument to be pasted, \
  2556. explicitly insert a null character to avoid a warning message and/or to \
  2557. prevent the paste from pasting the previous identifier. */
  2558. if(begin_arg==end_arg)
  2559. {
  2560. if(pasting)
  2561. {
  2562. MCHECK(1,"null character");
  2563. *mp++= '\0';
  2564. }
  2565. }
  2566. else
  2567. {/* Copy the argument. */
  2568. MCHECK(end_arg-begin_arg,"argument tokens");
  2569. while(begin_arg<end_arg)*mp++= *begin_arg++;
  2570. }
  2571.  
  2572. /* If the parameter is to be pasted, the argument does not get expanded. \
  2573. It also doesn't get expanded if it was immediately preceded by `\.{\#!}', \
  2574. in which case |xpn_argument| was set to |NO|. \
  2575. Otherwise, the argument gets expanded before finally substituting it for \
  2576. the parameter. */
  2577. if(!*pxpn_argument)*pxpn_argument= YES;
  2578. else if(!pasting)xpn_before(mp0,NULL,NULL,NULL);
  2579.  
  2580. return pasting;
  2581. }
  2582.  
  2583.  
  2584. boolean ins_arg FCN((cleft,cright,
  2585. pargs,m,n,pp0,ppasting,pxpn_argument,last_was_paste))
  2586. ASCII cleft C0("")
  2587. ASCII cright C0("")
  2588. PARGS pargs C0("")
  2589. text_pointer m C0("")
  2590. eight_bits n C0("")
  2591. eight_bits HUGE*HUGE*pp0 C0("")
  2592. boolean*ppasting C0("")
  2593. boolean*pxpn_argument C0("")
  2594. boolean last_was_paste C1("")
  2595. {
  2596. int k;
  2597. boolean next_is_paste= BOOLEAN(*(*pp0)==paste);
  2598. eight_bits HUGE*pp;
  2599. eight_bits HUGE*mp0= mp;
  2600. eight_bits HUGE*p00= (*pp0);
  2601. boolean fixed= BOOLEAN(cleft==0133);
  2602.  
  2603. WHILE()
  2604. if(*(*pp0)==cright)
  2605. {
  2606. break;
  2607. }
  2608. else if(TOKEN1(*(*pp0)))(*pp0)++;
  2609. else(*pp0)+= 2;
  2610.  
  2611. pp= xmac_text(mp0,p00,(*pp0)++);
  2612. k= neval(pp,mp);
  2613.  
  2614. mp= mp0;
  2615.  
  2616. /* For debugging */
  2617. if(k==0)
  2618. {
  2619. *mp++= 043;
  2620. *mp++= 0173;
  2621.  
  2622. while(p00<*pp0)
  2623. *mp++= *p00++;
  2624.  
  2625. return YES;
  2626. }
  2627.  
  2628. if(k<=0)
  2629. {/* Insert the total number of arguments. */
  2630. outer_char temp[5];
  2631.  
  2632.  
  2633. nsprintf(temp,OC("#%c0%c"),3,5,XCHR(cleft),XCHR(cright));
  2634. MCHECK(4,temp);
  2635. *mp++= constant;
  2636. mp0= mp;
  2637. mp+= 
  2638. nsprintf((outer_char*)mp0,OC("%d"),1,n-(fixed?0:m->nargs));
  2639. to_ASCII((outer_char HUGE*)mp0);
  2640. *mp++= constant;
  2641. }
  2642. else
  2643. *ppasting= cp_macro_arg(pargs,(eight_bits)(k-1+(fixed?0:m->nargs)),
  2644. n,pxpn_argument,last_was_paste,next_is_paste);
  2645.  
  2646. return NO;
  2647. }
  2648.  
  2649.  
  2650. SRTN xpn_before FCN((mp0,xids,pcur_byte,the_end))
  2651. eight_bits HUGE*mp0 C0("Remember this end of |macro_buf|.")
  2652. XIDS HUGE*xids C0("")
  2653. eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
  2654. eight_bits HUGE*the_end C1("End of buffer.")
  2655. {
  2656. eight_bits HUGE*mp1;
  2657.  
  2658. mp1= xmac_buf(mp0,xids,pcur_byte,the_end);/* Expand argument before \
  2659. substitution. */
  2660.  
  2661. while(mp1<mp)*mp0++= *mp1++;
  2662. /* Copy the expansion back to original place. */
  2663.  
  2664. mp= mp0;/* Current end of |macrobuf|. */
  2665. }
  2666.  
  2667.  
  2668. boolean x_int_fcn FCN((id,n,pargs))
  2669. sixteen_bits id C0("Token for internal function.")
  2670. int n C0("Number of arguments")
  2671. PARGS pargs C1("Array of pointers to arguments.")
  2672. {
  2673. INTERNAL_FCN HUGE*f;
  2674.  
  2675. for(f= internal_fcns;f->len!=0;f++)
  2676. if(f->id==id)
  2677. {
  2678. (*f->expnd)(n,pargs);/* Feed the internal function the list \
  2679. of (pointers to) arguments; put the expansion into the |macrobuf|. */
  2680. return YES;
  2681. }
  2682.  
  2683. return NO;/* Function not found. */
  2684. }
  2685.  
  2686.  
  2687. eight_bits HUGE*copy_and_paste FCN((m_start,m_end))
  2688. eight_bits HUGE*m_start C0("Start of range.")
  2689. eight_bits HUGE*m_end C1("End of range.")
  2690. {
  2691. eight_bits HUGE*mp0;
  2692. eight_bits a0;
  2693. eight_bits HUGE*m_last= m_start;/* Remember start of last token. */
  2694.  
  2695. for(mp0= m_start;mp0<m_end;)
  2696. {
  2697. if(TOKEN1(a0= *mp0))
  2698. {
  2699. if(a0==paste)
  2700. {
  2701. eight_bits HUGE*p;
  2702.  
  2703. p= mp;/* Beginning of the juxtaposition. */
  2704.  
  2705. paste1(m_last,m_start);/* Paste tokens to left of `\.{\#\#}'. */
  2706. mp0= paste1(++mp0,m_end);/* Paste tokens to right. */
  2707.  
  2708. /* Tokenize the juxtaposition. */
  2709. divert((ASCII HUGE*)p,(ASCII HUGE*)mp,STOP);/* Make the next |scan_repl| \
  2710.     read from |macrobuf| between~|p| and~|mp|. */
  2711. scan_repl(macro,STOP);
  2712.  
  2713. /* Copy tokenized stuff back into |macrobuf|, overwriting the juxtaposition. */
  2714. mp= m_last;
  2715. m_last= copy_and_paste(cur_text->tok_start,tok_ptr);
  2716.  
  2717. /* Back up the text buffer. */
  2718. text_ptr= cur_text;
  2719. mx_tok_ptr= tok_ptr;
  2720. tok_ptr= text_ptr->tok_start;
  2721. }
  2722.  
  2723.  
  2724. else
  2725. {
  2726. if(a0==ignore)
  2727. {
  2728. mp0++;/* Just skip any nulls that sneak in. */
  2729. continue;
  2730. }
  2731.  
  2732. m_last= mp;
  2733.  
  2734. switch(a0)
  2735. {
  2736. case constant:
  2737. case stringg:
  2738. MCHECK(1,"|constant| or |stringg|");
  2739. *mp++= *mp0++;
  2740.  
  2741. do
  2742. {
  2743. *mp= *mp0++;
  2744. MCHECK(1,"text of \
  2745. |constant| or |stringg|");
  2746. }
  2747. while(*mp++!=a0);
  2748.  
  2749. break;
  2750.  
  2751. case dot_const:
  2752. MCHECK(2,"dot_const");
  2753. *mp++= *mp0++;
  2754. *mp++= *mp0++;
  2755. break;
  2756.  
  2757. default:/* Copy ASCII token. */
  2758. MCHECK(1,"ASCII token");
  2759. *mp++= *mp0++;
  2760. break;
  2761. }
  2762. }
  2763. }
  2764. else
  2765. {/* Copy two-byte token. */
  2766. m_last= mp;
  2767. MCHECK(2,"two-byte token");
  2768. *mp++= *mp0++;*mp++= *mp0++;
  2769. }
  2770. }
  2771.  
  2772. return m_last;
  2773. }
  2774.  
  2775.  
  2776. eight_bits HUGE*paste1 FCN((p0,begin_or_end))
  2777. eight_bits HUGE*p0 C0("Beginning of tokens to be expanded.")
  2778. eight_bits HUGE*begin_or_end C1("")
  2779. {
  2780. eight_bits a0,a1;
  2781. sixteen_bits a;
  2782.  
  2783. if(p0==begin_or_end)
  2784. {
  2785.  
  2786. macro_err(OC("! Missing argument to token-paste operation. Null assumed"),YES);
  2787. return p0;
  2788. }
  2789.  
  2790. if(TOKEN1(a0= *p0++))
  2791. switch(a0)
  2792. {
  2793. case ignore:break;
  2794.  
  2795. case constant:
  2796. case stringg:
  2797. /* Copy the stuff sandwiched between tokens. */
  2798. while((a1= *p0++)!=a0)
  2799. {
  2800. MCHECK(1,"stuff between tokens");
  2801. *mp++= a1;
  2802. }
  2803. break;
  2804.  
  2805. case dot_const:
  2806. MCHECK(2,"dot_const");
  2807. *mp++= a0;
  2808. *mp++= *p0++;
  2809. break;
  2810.  
  2811. default:
  2812. MCHECK(1,"default ASCII token");
  2813. *mp++= a0;/* Copy ASCII token. */
  2814. break;
  2815. }
  2816. else
  2817. {
  2818. a= IDENTIFIER(a0,*p0++);
  2819.  
  2820. if(a<MODULE_NAME)
  2821. {
  2822. name_pointer np;
  2823.  
  2824. np= name_dir+a;
  2825.  
  2826. {
  2827. TRUNC HUGE*s;
  2828. ASCII HUGE*pc= np->byte_start;
  2829.  
  2830. if(*pc!=BP_MARKER)
  2831. {/* Not truncated. */
  2832. CONST ASCII HUGE*end;
  2833.  
  2834. PROPER_END(end);
  2835. copy_id((CONST ASCII HUGE*)pc,end,"copied id");
  2836. }
  2837. else
  2838. {
  2839. s= ((BP HUGE*)pc)->Root;
  2840. copy_id(s->id,s->id_end,"copied id");
  2841. }
  2842. }
  2843.  
  2844.  
  2845. }
  2846. else{}/* ?? */
  2847. }
  2848.  
  2849. return p0;
  2850. }
  2851.  
  2852.  
  2853. SRTN copy_id FCN((start,end,descr))
  2854. CONST ASCII HUGE*start C0("Beginning of identifier name.")
  2855. CONST ASCII HUGE*end C0("End of identifier name.")
  2856. CONST char*descr C1("")
  2857. {
  2858. CONST ASCII HUGE*j;
  2859.  
  2860. MCHECK(end-start,descr);
  2861.  
  2862. for(j= start;j<end;)
  2863. *mp++= (eight_bits)(*j++);
  2864. }
  2865.  
  2866.  
  2867. SRTN mbuf_full FCN((n,reason))
  2868. unsigned long n C0("Number of bytes requested.")
  2869. CONST outer_char reason[]C1("Reason for request.")
  2870. {
  2871.  
  2872. macro_err(OC("! Macro buffer full; %lu byte(s) requested for %s"),YES,n,reason);
  2873. OVERFLW("macro buffer bytes","mb");
  2874. }
  2875.  
  2876. /* Interface from independently compiled modules. */
  2877. SRTN mcheck0 FCN((n,reason))
  2878. unsigned long n C0("Number of bytes requested.")
  2879. CONST outer_char reason[]C1("Reason for request.")
  2880. {
  2881. MCHECK(n,reason);
  2882. }
  2883.  
  2884.  
  2885. eight_bits HUGE*xmacro FCN((macro_text,pcur_byte,the_end,mp0))
  2886. text_pointer macro_text C0("")
  2887. eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
  2888. eight_bits HUGE*the_end C0("End of buffer.")
  2889. eight_bits HUGE*mp0 C1("Build the expansion beginning here in \
  2890. |macrobuf|.")
  2891. {
  2892. eight_bits HUGE*macro_start;
  2893. extern long cur_val;
  2894.  
  2895. /* Copy the token of this macro. */
  2896. mp= mp0;/* Current position in |macrobuf|. */
  2897.  
  2898. MCHECK(2,"macro token");
  2899.  
  2900. if(macro_text->built_in)
  2901. {
  2902. *mp++= LEFT(cur_val,ID0);
  2903. *mp++= RIGHT(cur_val);
  2904. }
  2905. else
  2906. {
  2907. macro_start= macro_text->tok_start;
  2908. *mp++= *macro_start++;*mp++= *macro_start++;
  2909. }
  2910.  
  2911. /* If there are arguments, must get more tokens, through end of \
  2912. parens. Put all these into beginning of |macrobuf|. */
  2913. if(macro_text->nargs>0||macro_text->var_args)
  2914. mp= args_to_macrobuf(mp,pcur_byte,the_end,
  2915. (boolean)(macro_text->var_args));
  2916.  
  2917. return xmac_buf(mp0,NULL,pcur_byte,the_end);/* Start at expansion level~0; \
  2918.     return pointer to start of final expansion. */
  2919. }
  2920.  
  2921.  
  2922. eight_bits HUGE*args_to_macrobuf FCN((mp,pcur_byte,the_end,var_args))
  2923. eight_bits HUGE*mp C0("Next available position in |macro_buf|.")
  2924. eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
  2925. eight_bits HUGE*the_end C0("End of buffer.")
  2926. boolean var_args C1("Does macro have variable args?")
  2927. {
  2928. eight_bits c;/* First token of identifier. */
  2929. sixteen_bits id_token;/* Name of this macro. */
  2930. int bal= 0;/* Keep track of balanced parens. */
  2931.  
  2932. id_token= IDENTIFIER(*(mp-2),*(mp-1));/* Name of the macro; remember for \
  2933.                         error processing. */
  2934.  
  2935. do
  2936. {
  2937. if(*pcur_byte==the_end)
  2938. {
  2939.  
  2940. macro_err(OC("! No ')' in call to macro \"%s\""),YES,name_of(id_token));
  2941. break;
  2942. }
  2943.  
  2944. MCHECK(1,"arg to macrobuf");
  2945. c= *mp++= *(*pcur_byte)++;
  2946.  
  2947. if(TOKEN1(c))
  2948.  
  2949. {
  2950. switch(c)
  2951. {
  2952. case stringg:
  2953. do
  2954. {
  2955. MCHECK(1,"string arg");
  2956. *mp= *(*pcur_byte)++;
  2957. }
  2958. while(*mp++!=stringg);
  2959. break;
  2960.  
  2961. case dot_const:
  2962. MCHECK(1,"dot const");
  2963. *mp++= *(*pcur_byte)++;
  2964. break;
  2965.  
  2966. case 050:
  2967. bal++;
  2968. break;
  2969.  
  2970. case 051:
  2971. if(bal==0&&!var_args)
  2972. {
  2973.  
  2974. macro_err(OC("! Missing '(' in call to macro \"%s\""),YES,name_of(id_token));
  2975. goto done_copying;
  2976. }
  2977. else bal--;
  2978.  
  2979. break;
  2980. }
  2981. }
  2982.  
  2983.  
  2984. else
  2985. {/* Copy second token of identifier, or stuff relating to \
  2986. module name and line number. */
  2987. int n;/* Number of remaining bytes to copy. */
  2988.  
  2989. n= (c<0250?1:3+4*1);/* `1' for |line_info|. */
  2990. MCHECK(n,"second id token");
  2991. while(n-->0)*mp++= *(*pcur_byte)++;
  2992. continue;
  2993. }
  2994. }
  2995. while(bal>0);
  2996.  
  2997. done_copying:
  2998. return mp;/* New end. */
  2999. }
  3000.  
  3001.  
  3002. eight_bits HUGE*xmac_buf FCN((mp0,old_xids,pcur_byte,the_end))
  3003. eight_bits HUGE*mp0 C0("Text to be expanded begins here.")
  3004. XIDS HUGE*old_xids C0("")
  3005. eight_bits HUGE**pcur_byte C0("Pointer to |cur_byte|.")
  3006. eight_bits HUGE*the_end C1("End of buffer.")
  3007. {
  3008. eight_bits HUGE*p,HUGE*p1;
  3009. XIDS xids;
  3010. XIDS HUGE*pid;
  3011.  
  3012. xids.level= 0;
  3013.  
  3014. if(xlevel>=MAX_XLEVELS)
  3015. {
  3016.  
  3017. macro_err(OC("! Macro outer recursion depth exceeded"),YES);
  3018. FATAL(M,"!! BYE.","");
  3019. }
  3020.  
  3021. pid= pids[xlevel++]= old_xids?old_xids:&xids;/* Store the address of \
  3022.             this bunch of recursive names. */
  3023.  
  3024. for(p= mp0,p1= mp;x0macro(p,p1,pid,pcur_byte,the_end);p= p1,p1= mp);
  3025.  
  3026. xlevel--;/* Pop the outer recursion stack. */
  3027.  
  3028. return p1;/* Return beginning of the expanded text. */
  3029. }
  3030.  
  3031.  
  3032. eight_bits HUGE*xmac_text FCN((mp0,start,end))
  3033. eight_bits HUGE*mp0 C0("")
  3034. eight_bits HUGE*start C0("")
  3035. eight_bits HUGE*end C1("")
  3036. {
  3037. /* Copy the text to the macrobuf. */
  3038. for(mp= mp0;start<end;)
  3039. *mp++= *start++;
  3040.  
  3041. /* Expand the contents and return pointer. */
  3042. return xmac_buf(mp0,NULL,NULL,NULL);
  3043. }
  3044.  
  3045.  
  3046. SRTN i_meta_ FCN((n,pargs))
  3047. int n C0("")
  3048. PARGS pargs C1("")
  3049. {
  3050. eight_bits HUGE*p;
  3051.  
  3052. CHK_ARGS("$COMMENT",1);
  3053.  
  3054.  
  3055. p= pargs[0]+1;
  3056. if(!(*p==constant||*p==stringg))
  3057. {
  3058. arg_must_be_constant("$COMMENT");
  3059. return;
  3060. };
  3061.  
  3062.  
  3063. {
  3064. static eight_bits begin_C_meta[]= {constant,057,052,constant,'\0'};
  3065. eight_bits HUGE*p;
  3066.  
  3067.  
  3068. if(C_LIKE(language))
  3069. {
  3070. MCHECK0(4,"begin_C_meta");
  3071. for(p= begin_C_meta;*p;)*mp++= *p++;
  3072. }
  3073. else
  3074. {
  3075. MCHECK0(2,"begin_meta");
  3076. *mp++= begin_meta;
  3077. *mp++= begin_meta;
  3078. }
  3079. }
  3080.  
  3081. ;
  3082.  
  3083. *(p+1)= *(pargs[1]-2)= 040;/* Change quotes to blanks. */
  3084.  
  3085. do
  3086. {
  3087. MCHECK0(1,"_meta_");
  3088. *mp++= *p++;
  3089. }
  3090. while(p<pargs[1]);
  3091.  
  3092.  
  3093. {
  3094. static eight_bits end_C_meta[]= "\52\57";
  3095. eight_bits HUGE*p;
  3096.  
  3097.  
  3098. if(C_LIKE(language))
  3099. {
  3100. MCHECK0(2,"end_C_meta");
  3101. for(p= end_C_meta;*p;)*mp++= *p++;
  3102. }
  3103. else
  3104. {
  3105. MCHECK0(1,"end_meta");
  3106. *mp++= end_meta;
  3107. }
  3108. }
  3109.  
  3110. ;
  3111. }
  3112.  
  3113.  
  3114. SRTN i_assert_ FCN((n,pargs))
  3115. int n C0("")
  3116. PARGS pargs C1("")
  3117. {
  3118. eight_bits HUGE*p;
  3119. eight_bits HUGE*pp;
  3120. eight_bits HUGE*mp0;
  3121. boolean e;
  3122.  
  3123. CHK_ARGS("$ASSERT",1);
  3124.  
  3125. pp= xmac_text(mp0= mp,p= pargs[0]+1,pargs[1]);/* Expand the expression. */
  3126. e= eval(pp,mp);
  3127. mp= mp0;
  3128.  
  3129. if(e)
  3130. return;
  3131.  
  3132. mp= str_to_mb(p,pargs[1],YES);
  3133.  
  3134.  
  3135. macro_err(OC("! $ASSERT(%s) failed"),NO,to_outer((ASCII HUGE*)mp));
  3136. FATAL(M,"","Processing ABORTED!");
  3137. }
  3138.  
  3139.  
  3140. SRTN i_error_ FCN((n,pargs))
  3141. int n C0("")
  3142. PARGS pargs C1("")
  3143. {
  3144. eight_bits c;
  3145. eight_bits HUGE*t,HUGE*p,HUGE*temp;
  3146.  
  3147. CHK_ARGS("$ERROR",1);
  3148.  
  3149.  
  3150. p= pargs[0]+1;
  3151. if(!(*p==constant||*p==stringg))
  3152. {
  3153. arg_must_be_constant("$ERROR");
  3154. return;
  3155. };
  3156.  
  3157. temp= GET_MEM("_error_:temp",N_MSGBUF,eight_bits);
  3158.  
  3159. for(c= *p++,t= temp;*p!=c;)*t++= *p++;
  3160. *t= '\0';
  3161.  
  3162.  
  3163. macro_err(OC("%cUSER ERROR:  %s"),NO,beep(1),to_outer((ASCII HUGE*)temp));
  3164. FREE_MEM(temp,"_error_:temp",N_MSGBUF,eight_bits);
  3165. }
  3166.  
  3167.  
  3168. SRTN i_routine_ FCN((n,pargs))
  3169. int n C0("")
  3170. PARGS pargs C1("")
  3171. {
  3172. name_pointer np;
  3173. CONST ASCII HUGE*f,HUGE*end;
  3174.  
  3175. CHK_ARGS("$ROUTINE",0);
  3176.  
  3177. if(!(is_RATFOR_(language)))return;/* So far, only \Ratfor\ is active. */
  3178. if(!RAT_OK(""))CONFUSION("_routine_","Language shouldn't be Ratfor here");
  3179.  
  3180. if(cur_fcn==NO_FCN)
  3181. {
  3182. MCHECK0(1,"'?'");
  3183. *mp++= 077;
  3184. return;
  3185. }
  3186.  
  3187. np= name_dir+cur_fcn;
  3188. end= proper_end(np);
  3189.  
  3190. MCHECK0(end-np->byte_start,"_routine_");
  3191. for(f= np->byte_start;f<end;)
  3192. *mp++= *f++;
  3193. }
  3194.  
  3195.  
  3196.  
  3197. SRTN i_lowercase_ FCN((n,pargs))
  3198. int n C0("")
  3199. PARGS pargs C1("")
  3200. {
  3201. eight_bits HUGE*p= pargs[0]+1,HUGE*p1= pargs[1];
  3202.  
  3203. CHK_ARGS("$LC",1);
  3204.  
  3205. if(*p!=stringg)
  3206. {
  3207. MUST_QUOTE("_L",p,p1);
  3208. return;
  3209. }
  3210.  
  3211. MCHECK(p1-p,"lowercase");
  3212.  
  3213. for(;p<p1;p++)
  3214. *mp++= A_TO_LOWER(*p);/* Watch out for side effects in |A_TO_LOWER|! */
  3215. }
  3216.  
  3217. SRTN i_uppercase_ FCN((n,pargs))
  3218. int n C0("")
  3219. PARGS pargs C1("")
  3220. {
  3221. eight_bits HUGE*p= pargs[0]+1,HUGE*p1= pargs[1];
  3222.  
  3223. CHK_ARGS("$UC",1);
  3224.  
  3225. if(*p!=stringg)
  3226. {
  3227. MUST_QUOTE("_U",p,p1);
  3228. return;
  3229. }
  3230.  
  3231. MCHECK(p1-p,"lowercase");
  3232.  
  3233. for(;p<p1;p++)
  3234. *mp++= A_TO_UPPER(*p);/* Watch out for side effects in |A_TO_LOWER|! */
  3235. }
  3236.  
  3237.  
  3238. SRTN i_nargs_ FCN((n,pargs))
  3239. int n C0("")
  3240. PARGS pargs C1("")
  3241. {
  3242. text_pointer m;
  3243. eight_bits*pa= pargs[0]+1;
  3244.  
  3245. if((m= MAC_LOOKUP(IDENTIFIER(pa[0],pa[1])))==NULL)
  3246. {
  3247.  
  3248. macro_err(OC("! Argument of $NARGS is not a WEB macro"),YES);
  3249. put_long(-1L);
  3250. }
  3251. else put_long((long)m->nargs);
  3252. }
  3253.  
  3254.  
  3255. SRTN put_long FCN((l))
  3256. long l C1("")
  3257. {
  3258. outer_char temp[100];
  3259. int n;
  3260.  
  3261. n= 
  3262. nsprintf(temp,OC("%ld"),1,l);
  3263. to_ASCII(temp);
  3264. MCHECK(n+2,"long");
  3265. *mp++= constant;
  3266. STRCPY(mp,temp);
  3267. mp+= n;
  3268. *mp++= constant;
  3269. }
  3270.  
  3271.  
  3272. SRTN chk_args FCN((name,proper_num,actual_num,pargs))
  3273. outer_char*name C0("")
  3274. int proper_num C0("")
  3275. int actual_num C0("")
  3276. PARGS pargs C1("")
  3277. {
  3278. if(proper_num>=0)
  3279. {
  3280. if(actual_num!=proper_num)
  3281.  
  3282. macro_err(OC("Built-in macro %s should be called with %d \
  3283. argument(s), not %d"),NO,name,proper_num,actual_num);
  3284. }
  3285. }
  3286.  
  3287.  
  3288. SRTN see_macro FCN((p0,p1))
  3289. CONST eight_bits HUGE*p0 C0("Beginning of token list.")
  3290. CONST eight_bits HUGE*p1 C1("End of token list.")
  3291. {
  3292. int k,l,num_tokens;
  3293. ASCII HUGE*q0;
  3294. sixteen_bits HUGE*tokens;
  3295. ASCII HUGE*mtext;
  3296.  
  3297. num_tokens= PTR_DIFF(int,p1,p0);/* Why is this |int|? */
  3298.  
  3299. tokens= GET_MEM("see_macro:tokens",num_tokens,sixteen_bits);
  3300. mtext= GET_MEM("see_macro:mtext",MTEXT_SIZE,ASCII);
  3301.  
  3302. k= rcvr_macro(mtext,tokens,p0,p1);
  3303.  
  3304. printf(">> \"");
  3305. for(l= 0;l<k;++l)
  3306. printf(_Xx("%x "),tokens[l]);
  3307.  
  3308. printf("\"\n== \"");
  3309. for(q0= mtext;q0<mtext+k;++q0)
  3310. putchar(XCHR(*q0));
  3311. puts("\"");
  3312.  
  3313. FREE_MEM(mtext,"see_macro:mtext",MTEXT_SIZE,ASCII);
  3314. if(num_tokens)FREE_MEM(tokens,"see_macro:tokens",num_tokens,sixteen_bits);
  3315. }
  3316.  
  3317.  
  3318. int rcvr_macro FCN((mtext,tokens,p0,p1))
  3319. ASCII HUGE*mtext C0("Holds readable translation of the    text.")
  3320. sixteen_bits HUGE*tokens C0("Slightly translated tokens.")
  3321. CONST eight_bits HUGE*p0 C0("")
  3322. CONST eight_bits HUGE*p1 C1("")
  3323. {
  3324. ASCII HUGE*mtext_end= mtext+MTEXT_SIZE;
  3325. ASCII HUGE*p;/* Current position in output text buffer. */
  3326. ASCII HUGE*j;
  3327. int k;
  3328. sixteen_bits a;/* The current token. */
  3329.  
  3330. for(k= 0,p= mtext;p0<p1;k++)
  3331. {
  3332. if(TOKEN1(a= *p0++))
  3333. switch(a)
  3334. {
  3335. case paste:
  3336. SAVE_MTEXT(043);SAVE_MTEXT(043);
  3337. break;
  3338.  
  3339. default:
  3340. SAVE_MTEXT(a);
  3341. break;
  3342. }
  3343. else if(a==MACRO_ARGUMENT)
  3344. {
  3345. SAVE_MTEXT(044);
  3346. a= (sixteen_bits)(-(*p0));
  3347. SAVE_MTEXT(*p0+++060);/* Only for 9 or less??? */
  3348. }
  3349. else
  3350. {
  3351. a= IDENTIFIER(a,*p0++);
  3352.  
  3353. if(a<MODULE_NAME)
  3354. {
  3355. CONST ASCII HUGE*end;
  3356. name_pointer np= name_dir+a;
  3357.  
  3358. PROPER_END(end);
  3359.  
  3360. for(j= np->byte_start;j<end;++j)
  3361. {SAVE_MTEXT(*j);}
  3362. }
  3363. else
  3364. {
  3365. SAVE_MTEXT(0115);
  3366. }
  3367. }
  3368.  
  3369. if(tokens)tokens[k]= a;/* Should have special color marker for ids. */
  3370. }
  3371.  
  3372. return k;
  3373. }
  3374.  
  3375.  
  3376. SRTN i_xflag_ FCN((n,pargs))
  3377. int n C0("")
  3378. PARGS pargs C1("")
  3379. {
  3380. eight_bits HUGE*p= pargs[0]+1;
  3381. outer_char temp[100],*t= temp;
  3382.  
  3383. CHK_ARGS("$XX",1);
  3384.  
  3385. if(*p++!=constant)
  3386. {
  3387.  
  3388. macro_err(OC("Argument of $XX is not a numerical constant"),NO);
  3389. return;
  3390. }
  3391.  
  3392. while(*p!=constant)
  3393. *t++= XCHR(*p++);
  3394.  
  3395. TERMINATE(t,0);
  3396.  
  3397. xflag= ATOI(temp);
  3398. }
  3399.  
  3400.  
  3401. SRTN i_dumpdef_ FCN((n,pargs))
  3402. int n C0("")
  3403. PARGS pargs C1("")
  3404. {
  3405. int k;
  3406. eight_bits HUGE*p,HUGE*mp0,HUGE*mp1,HUGE*mp2;
  3407. sixteen_bits a;
  3408. extern long cur_val;
  3409. eight_bits HUGE*q0,HUGE*q1;
  3410. ASCII HUGE*mtext= GET_MEM("rcvr_macro:mtext",MTEXT_SIZE,ASCII);
  3411. ASCII HUGE*mx,HUGE*mx0;
  3412. name_pointer np;
  3413.  
  3414. CHK_ARGS("$DUMPDEF",INT_MIN);
  3415.  
  3416. for(k= 0;k<n;k++)
  3417. {/* Print translation of $k^{{\rm th}}$ macro. */
  3418. text_pointer m;
  3419.  
  3420. if(xflag)
  3421. printf("\n");
  3422.  
  3423. mp0= mp;
  3424.  
  3425. p= pargs[k]+1;/* Start of argument. */
  3426.  
  3427. while(IS_WHITE(*p)||*p==012)p++;
  3428.  
  3429. a= IDENTIFIER(*p,*(p+1));
  3430.  
  3431. if((m= MAC_LOOKUP(a))==NULL)
  3432. {/* Not a valid WEB macro. */
  3433. str_to_mb(p,pargs[k+1],NO);
  3434. printf("NOT WEB MACRO:  %s\n",(char*)to_outer((ASCII*)mp0));
  3435. }
  3436. else
  3437.  
  3438. {
  3439. p+= 2;
  3440.  
  3441. /* Copy the name. */
  3442. np= name_dir+a;
  3443.  
  3444. for(mx= mtext,mx0= np->byte_start;mx0<(np+1)->byte_start;)
  3445. *mx++= *mx0++;
  3446.  
  3447. *mx++= '\0';
  3448. to_outer(mtext);
  3449.  
  3450. /* Translate the definition. */
  3451. if(m->built_in)
  3452. {
  3453. cur_val= a;
  3454. STRCPY(mp0,"<built-in>");
  3455. mp= mp0+STRLEN(mp0)+1;
  3456. }
  3457. else
  3458. {
  3459. q0= m->tok_start+m->moffset;
  3460. q1= (m+1)->tok_start;
  3461.  
  3462. str_to_mb(q0,q1,NO);
  3463. mp++;
  3464. to_outer((ASCII*)mp0);
  3465. }
  3466.  
  3467. /* Print the definition. */
  3468. printf("%s",(char*)mtext);
  3469.  
  3470. if(m->nargs||m->var_args)
  3471. {
  3472. eight_bits n;
  3473.  
  3474. printf("(");
  3475. for(n= 0;n<m->nargs;n++)
  3476. printf("$%d%s",(int)n,
  3477. CHOICE(n==(eight_bits)(m->nargs-1),"",","));
  3478. if(m->var_args)printf("%s...",
  3479. CHOICE(m->nargs,",",""));
  3480. printf(")");
  3481. }
  3482.  
  3483. printf(" = %s\n",(char*)(mp= mp0));
  3484.  
  3485. if(xflag)
  3486. {
  3487. /* Convert arguments to readable form. */
  3488. mp0= mp;
  3489. str_to_mb(p,pargs[k+1],NO);
  3490. mp++;
  3491. to_outer((ASCII*)mp0);
  3492.  
  3493. /* Expand the macro. */
  3494. mp1= xmacro(m,&p,pargs[k+1],mp);
  3495. *mp++= '\0';
  3496. mp2= mp;
  3497. str_to_mb(mp1,mp,NO);
  3498. mp++;
  3499. to_outer((ASCII*)mp2);
  3500.  
  3501. printf("%s%s = %s\n",(char*)mtext,(char*)mp0,(char*)(mp= mp2));
  3502.  
  3503. if(p!=pargs[k+1])
  3504.  
  3505. err0_print(ERR_M,OC("Extra text after macro call"),0);
  3506. }
  3507. }
  3508.  
  3509.  
  3510.  
  3511. mp= mp0;
  3512. }
  3513.  
  3514. FREE_MEM(mtext,"_dumpdef_:mtext",MTEXT_SIZE,ASCII);
  3515. }
  3516.  
  3517.  
  3518.