1 LABEL(paren_docol) /* (docol) ( -- R:a_retaddr ) S0 -- S0  */
2 /* run-time routine for colon definitions */
3 NAME("(docol)")
4 {
5 DEF_CA
6 Cell * a_retaddr;
7 NEXT_P0;
8 #ifdef VM_DEBUG
9 if (vm_debug) {
10 }
11 #endif
12 rp += -1;
13 {
14 #line 157 "prim"
15 #ifdef NO_IP
16 a_retaddr = next_code;
17 SUPER_END;
18 
19 #ifdef VM_DEBUG
20 if (vm_debug) {
21 fputs(" -- ", vm_out); fputs(" a_retaddr=", vm_out); printarg_a_(a_retaddr);
22 fputc('\n', vm_out);
23 }
24 #endif
25 NEXT_P1;
26 vm_a_2Cell(a_retaddr,rp[0]);
27 
28 goto **(Label *)PFA(CFA);
29 #else /* !defined(NO_IP) */
30 a_retaddr = (Cell *)IP;
31 SET_IP((Xt *)PFA(CFA));
32 #endif /* !defined(NO_IP) */
33 #line 34 "prim.i"
34 }
35 SUPER_END;
36 
37 #ifdef VM_DEBUG
38 if (vm_debug) {
39 fputs(" -- ", vm_out); fputs(" a_retaddr=", vm_out); printarg_a_(a_retaddr);
40 fputc('\n', vm_out);
41 }
42 #endif
43 NEXT_P1;
44 vm_a_2Cell(a_retaddr,rp[0]);
45 LABEL2(paren_docol)
46 NEXT_P1_5;
47 LABEL3(paren_docol)
48 DO_GOTO;
49 }
50 
51 LABEL(paren_docon) /* (docon) ( -- w ) S0 -- S0  */
52 /* run-time routine for constants */
53 NAME("(docon)")
54 {
55 DEF_CA
56 Cell w;
57 NEXT_P0;
58 #ifdef VM_DEBUG
59 if (vm_debug) {
60 }
61 #endif
62 sp += -1;
63 {
64 #line 168 "prim"
65 w = *(Cell *)PFA(CFA);
66 #ifdef NO_IP
67 
68 #ifdef VM_DEBUG
69 if (vm_debug) {
70 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
71 fputc('\n', vm_out);
72 }
73 #endif
74 NEXT_P1;
75 vm_w2Cell(w,sp[0]);
76 
77 goto *next_code;
78 #endif /* defined(NO_IP) */
79 #line 80 "prim.i"
80 }
81 
82 #ifdef VM_DEBUG
83 if (vm_debug) {
84 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
85 fputc('\n', vm_out);
86 }
87 #endif
88 NEXT_P1;
89 vm_w2Cell(w,sp[0]);
90 LABEL2(paren_docon)
91 NEXT_P1_5;
92 LABEL3(paren_docon)
93 DO_GOTO;
94 }
95 
96 LABEL(paren_dovar) /* (dovar) ( -- a_body ) S0 -- S0  */
97 /* run-time routine for variables and CREATEd words */
98 NAME("(dovar)")
99 {
100 DEF_CA
101 Cell * a_body;
102 NEXT_P0;
103 #ifdef VM_DEBUG
104 if (vm_debug) {
105 }
106 #endif
107 sp += -1;
108 {
109 #line 176 "prim"
110 a_body = PFA(CFA);
111 #ifdef NO_IP
112 
113 #ifdef VM_DEBUG
114 if (vm_debug) {
115 fputs(" -- ", vm_out); fputs(" a_body=", vm_out); printarg_a_(a_body);
116 fputc('\n', vm_out);
117 }
118 #endif
119 NEXT_P1;
120 vm_a_2Cell(a_body,sp[0]);
121 
122 goto *next_code;
123 #endif /* defined(NO_IP) */
124 #line 125 "prim.i"
125 }
126 
127 #ifdef VM_DEBUG
128 if (vm_debug) {
129 fputs(" -- ", vm_out); fputs(" a_body=", vm_out); printarg_a_(a_body);
130 fputc('\n', vm_out);
131 }
132 #endif
133 NEXT_P1;
134 vm_a_2Cell(a_body,sp[0]);
135 LABEL2(paren_dovar)
136 NEXT_P1_5;
137 LABEL3(paren_dovar)
138 DO_GOTO;
139 }
140 
141 LABEL(paren_douser) /* (douser) ( -- a_user ) S0 -- S0  */
142 /* run-time routine for constants */
143 NAME("(douser)")
144 {
145 DEF_CA
146 Cell * a_user;
147 NEXT_P0;
148 #ifdef VM_DEBUG
149 if (vm_debug) {
150 }
151 #endif
152 sp += -1;
153 {
154 #line 184 "prim"
155 a_user = (Cell *)(up+*(Cell *)PFA(CFA));
156 #ifdef NO_IP
157 
158 #ifdef VM_DEBUG
159 if (vm_debug) {
160 fputs(" -- ", vm_out); fputs(" a_user=", vm_out); printarg_a_(a_user);
161 fputc('\n', vm_out);
162 }
163 #endif
164 NEXT_P1;
165 vm_a_2Cell(a_user,sp[0]);
166 
167 goto *next_code;
168 #endif /* defined(NO_IP) */
169 #line 170 "prim.i"
170 }
171 
172 #ifdef VM_DEBUG
173 if (vm_debug) {
174 fputs(" -- ", vm_out); fputs(" a_user=", vm_out); printarg_a_(a_user);
175 fputc('\n', vm_out);
176 }
177 #endif
178 NEXT_P1;
179 vm_a_2Cell(a_user,sp[0]);
180 LABEL2(paren_douser)
181 NEXT_P1_5;
182 LABEL3(paren_douser)
183 DO_GOTO;
184 }
185 
186 LABEL(paren_dodefer) /* (dodefer) ( -- ) S0 -- S0  */
187 /* run-time routine for deferred words */
188 NAME("(dodefer)")
189 {
190 DEF_CA
191 NEXT_P0;
192 #ifdef VM_DEBUG
193 if (vm_debug) {
194 }
195 #endif
196 {
197 #line 192 "prim"
198 #ifndef NO_IP
199 ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */
200 #endif /* !defined(NO_IP) */
201 SUPER_END; /* !! probably unnecessary and may lead to measurement errors */
202 VM_JUMP(EXEC1(*(Xt *)PFA(CFA)));
203 #line 204 "prim.i"
204 }
205 
206 #ifdef VM_DEBUG
207 if (vm_debug) {
208 fputs(" -- ", vm_out); fputc('\n', vm_out);
209 }
210 #endif
211 LABEL2(paren_dodefer)
212 LABEL3(paren_dodefer)
213 DO_GOTO;
214 }
215 
216 LABEL(paren_field) /* (dofield) ( n1 -- n2 ) S0 -- S0  */
217 /* run-time routine for fields */
218 NAME("(dofield)")
219 {
220 DEF_CA
221 MAYBE_UNUSED Cell n1;
222 Cell n2;
223 NEXT_P0;
224 vm_Cell2n(sp[0],n1);
225 #ifdef VM_DEBUG
226 if (vm_debug) {
227 fputs(" n1=", vm_out); printarg_n(n1);
228 }
229 #endif
230 {
231 #line 200 "prim"
232 n2 = n1 + *(Cell *)PFA(CFA);
233 #ifdef NO_IP
234 
235 #ifdef VM_DEBUG
236 if (vm_debug) {
237 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
238 fputc('\n', vm_out);
239 }
240 #endif
241 NEXT_P1;
242 vm_n2Cell(n2,sp[0]);
243 
244 goto *next_code;
245 #endif /* defined(NO_IP) */
246 #line 247 "prim.i"
247 }
248 
249 #ifdef VM_DEBUG
250 if (vm_debug) {
251 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
252 fputc('\n', vm_out);
253 }
254 #endif
255 NEXT_P1;
256 vm_n2Cell(n2,sp[0]);
257 LABEL2(paren_field)
258 NEXT_P1_5;
259 LABEL3(paren_field)
260 DO_GOTO;
261 }
262 
263 LABEL(paren_doval) /* (dovalue) ( -- w ) S0 -- S0  */
264 /* run-time routine for constants */
265 NAME("(dovalue)")
266 {
267 DEF_CA
268 Cell w;
269 NEXT_P0;
270 #ifdef VM_DEBUG
271 if (vm_debug) {
272 }
273 #endif
274 sp += -1;
275 {
276 #line 208 "prim"
277 w = *(Cell *)PFA(CFA);
278 #ifdef NO_IP
279 
280 #ifdef VM_DEBUG
281 if (vm_debug) {
282 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
283 fputc('\n', vm_out);
284 }
285 #endif
286 NEXT_P1;
287 vm_w2Cell(w,sp[0]);
288 
289 goto *next_code;
290 #endif /* defined(NO_IP) */
291 #line 292 "prim.i"
292 }
293 
294 #ifdef VM_DEBUG
295 if (vm_debug) {
296 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
297 fputc('\n', vm_out);
298 }
299 #endif
300 NEXT_P1;
301 vm_w2Cell(w,sp[0]);
302 LABEL2(paren_doval)
303 NEXT_P1_5;
304 LABEL3(paren_doval)
305 DO_GOTO;
306 }
307 
308 LABEL(paren_dodoes) /* (dodoes) ( -- a_body R:a_retaddr ) S0 -- S0  */
309 /* run-time routine for @code{does>}-defined words */
310 NAME("(dodoes)")
311 {
312 DEF_CA
313 Cell * a_body;
314 Cell * a_retaddr;
315 NEXT_P0;
316 #ifdef VM_DEBUG
317 if (vm_debug) {
318 }
319 #endif
320 sp += -1;
321 rp += -1;
322 {
323 #line 216 "prim"
324 #ifdef NO_IP
325 a_retaddr = next_code;
326 a_body = PFA(CFA);
327 SUPER_END;
328 
329 #ifdef VM_DEBUG
330 if (vm_debug) {
331 fputs(" -- ", vm_out); fputs(" a_body=", vm_out); printarg_a_(a_body);
332 fputs(" a_retaddr=", vm_out); printarg_a_(a_retaddr);
333 fputc('\n', vm_out);
334 }
335 #endif
336 NEXT_P1;
337 vm_a_2Cell(a_body,sp[0]);
338 vm_a_2Cell(a_retaddr,rp[0]);
339 
340 #ifdef DEBUG
341 fprintf(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body);
342 #endif
343 goto **(Label *)DOES_CODE1(CFA);
344 #else /* !defined(NO_IP) */
345 a_retaddr = (Cell *)IP;
346 a_body = PFA(CFA);
347 #ifdef DEBUG
348 fprintf(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body);
349 #endif
350 SET_IP(DOES_CODE1(CFA));
351 #endif /* !defined(NO_IP) */
352 #line 353 "prim.i"
353 }
354 SUPER_END;
355 
356 #ifdef VM_DEBUG
357 if (vm_debug) {
358 fputs(" -- ", vm_out); fputs(" a_body=", vm_out); printarg_a_(a_body);
359 fputs(" a_retaddr=", vm_out); printarg_a_(a_retaddr);
360 fputc('\n', vm_out);
361 }
362 #endif
363 NEXT_P1;
364 vm_a_2Cell(a_body,sp[0]);
365 vm_a_2Cell(a_retaddr,rp[0]);
366 LABEL2(paren_dodoes)
367 NEXT_P1_5;
368 LABEL3(paren_dodoes)
369 DO_GOTO;
370 }
371 
372 LABEL(paren_does_handler) /* (does-handler) ( -- ) S0 -- S0  */
373 /* just a slot to have an encoding for the DOESJUMP,
374 which is no longer used anyway (!! eliminate this) */
375 NAME("(does-handler)")
376 {
377 DEF_CA
378 NEXT_P0;
379 #ifdef VM_DEBUG
380 if (vm_debug) {
381 }
382 #endif
383 {
384 #line 236 "prim"
385 #line 386 "prim.i"
386 }
387 
388 #ifdef VM_DEBUG
389 if (vm_debug) {
390 fputs(" -- ", vm_out); fputc('\n', vm_out);
391 }
392 #endif
393 NEXT_P1;
394 LABEL2(paren_does_handler)
395 NEXT_P1_5;
396 LABEL3(paren_does_handler)
397 DO_GOTO;
398 }
399 
400 GROUPADD(9)
401 GROUP( control, 9)
LABEL(noop)402 LABEL(noop) /* noop ( -- ) S0 -- S0  */
403 /*  */
404 NAME("noop")
405 {
406 DEF_CA
407 NEXT_P0;
408 #ifdef VM_DEBUG
409 if (vm_debug) {
410 }
411 #endif
412 {
413 #line 242 "prim"
414 #line 415 "prim.i"
415 }
416 
417 #ifdef VM_DEBUG
418 if (vm_debug) {
419 fputs(" -- ", vm_out); fputc('\n', vm_out);
420 }
421 #endif
422 NEXT_P1;
423 LABEL2(noop)
424 NEXT_P1_5;
425 LABEL3(noop)
426 DO_GOTO;
427 }
428 
429 LABEL(call) /* call ( #a_callee -- R:a_retaddr ) S0 -- S0  */
430 /* Call callee (a variant of docol with inline argument). */
431 NAME("call")
432 {
433 DEF_CA
434 MAYBE_UNUSED Cell * a_callee;
435 Cell * a_retaddr;
436 NEXT_P0;
437 vm_Cell2a_(IMM_ARG(IPTOS,305397760 ),a_callee);
438 #ifdef VM_DEBUG
439 if (vm_debug) {
440 fputs(" a_callee=", vm_out); printarg_a_(a_callee);
441 }
442 #endif
443 INC_IP(1);
444 rp += -1;
445 {
446 #line 247 "prim"
447 #ifdef NO_IP
448 assert(0);
449 SUPER_END;
450 
451 #ifdef VM_DEBUG
452 if (vm_debug) {
453 fputs(" -- ", vm_out); fputs(" a_retaddr=", vm_out); printarg_a_(a_retaddr);
454 fputc('\n', vm_out);
455 }
456 #endif
457 NEXT_P1;
458 vm_a_2Cell(a_retaddr,rp[0]);
459 
460 JUMP(a_callee);
461 #else
462 #ifdef DEBUG
463     {
464       CFA_TO_NAME((((Cell *)a_callee)-2));
465       fprintf(stderr,"%08lx: call %08lx %.*s\n",(Cell)ip,(Cell)a_callee,
466 	      len,name);
467     }
468 #endif
469 a_retaddr = (Cell *)IP;
470 SET_IP((Xt *)a_callee);
471 #endif
472 #line 473 "prim.i"
473 }
474 SUPER_END;
475 
476 #ifdef VM_DEBUG
477 if (vm_debug) {
478 fputs(" -- ", vm_out); fputs(" a_retaddr=", vm_out); printarg_a_(a_retaddr);
479 fputc('\n', vm_out);
480 }
481 #endif
482 NEXT_P1;
483 vm_a_2Cell(a_retaddr,rp[0]);
484 LABEL2(call)
485 NEXT_P1_5;
486 LABEL3(call)
487 DO_GOTO;
488 }
489 
490 LABEL(execute) /* execute ( xt -- ) S0 -- S0  */
491 /* Perform the semantics represented by the execution token, @i{xt}. */
492 NAME("execute")
493 {
494 DEF_CA
495 MAYBE_UNUSED Xt xt;
496 NEXT_P0;
497 vm_Cell2xt(sp[0],xt);
498 #ifdef VM_DEBUG
499 if (vm_debug) {
500 fputs(" xt=", vm_out); printarg_xt(xt);
501 }
502 #endif
503 sp += 1;
504 {
505 #line 265 "prim"
506 #ifdef DEBUG
507 fprintf(stderr, "execute %08x\n", xt);
508 #endif
509 #ifndef NO_IP
510 ip=IP;
511 #endif
512 SUPER_END;
513 VM_JUMP(EXEC1(xt));
514 #line 515 "prim.i"
515 }
516 
517 #ifdef VM_DEBUG
518 if (vm_debug) {
519 fputs(" -- ", vm_out); fputc('\n', vm_out);
520 }
521 #endif
522 LABEL2(execute)
523 LABEL3(execute)
524 DO_GOTO;
525 }
526 
527 LABEL(perform) /* perform ( a_addr -- ) S0 -- S0  */
528 /* @code{@@ execute}. */
529 NAME("perform")
530 {
531 DEF_CA
532 MAYBE_UNUSED Cell * a_addr;
533 NEXT_P0;
534 vm_Cell2a_(sp[0],a_addr);
535 #ifdef VM_DEBUG
536 if (vm_debug) {
537 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
538 }
539 #endif
540 sp += 1;
541 {
542 #line 276 "prim"
543 /* and pfe */
544 #ifndef NO_IP
545 ip=IP;
546 #endif
547 SUPER_END;
548 VM_JUMP(EXEC1(*(Xt *)a_addr));
549 #line 550 "prim.i"
550 }
551 
552 #ifdef VM_DEBUG
553 if (vm_debug) {
554 fputs(" -- ", vm_out); fputc('\n', vm_out);
555 }
556 #endif
557 LABEL2(perform)
558 LABEL3(perform)
559 DO_GOTO;
560 }
561 
562 LABEL(semis) /* ;s ( R:w -- ) S0 -- S0  */
563 /* The primitive compiled by @code{EXIT}. */
564 NAME(";s")
565 {
566 DEF_CA
567 MAYBE_UNUSED Cell w;
568 NEXT_P0;
569 vm_Cell2w(rp[0],w);
570 #ifdef VM_DEBUG
571 if (vm_debug) {
572 fputs(" w=", vm_out); printarg_w(w);
573 }
574 #endif
575 rp += 1;
576 {
577 #line 287 "prim"
578 #ifdef NO_IP
579 SUPER_END;
580 
581 #ifdef VM_DEBUG
582 if (vm_debug) {
583 fputs(" -- ", vm_out); fputc('\n', vm_out);
584 }
585 #endif
586 NEXT_P1;
587 
588 goto *(void *)w;
589 #else
590 SET_IP((Xt *)w);
591 #endif
592 #line 593 "prim.i"
593 }
594 SUPER_END;
595 
596 #ifdef VM_DEBUG
597 if (vm_debug) {
598 fputs(" -- ", vm_out); fputc('\n', vm_out);
599 }
600 #endif
601 NEXT_P1;
602 LABEL2(semis)
603 NEXT_P1_5;
604 LABEL3(semis)
605 DO_GOTO;
606 }
607 
608 LABEL(unloop) /* unloop ( R:w1 R:w2 -- ) S0 -- S0  */
609 /*  */
610 NAME("unloop")
611 {
612 DEF_CA
613 MAYBE_UNUSED Cell w1;
614 MAYBE_UNUSED Cell w2;
615 NEXT_P0;
616 vm_Cell2w(rp[1],w1);
617 vm_Cell2w(rp[0],w2);
618 #ifdef VM_DEBUG
619 if (vm_debug) {
620 fputs(" w1=", vm_out); printarg_w(w1);
621 fputs(" w2=", vm_out); printarg_w(w2);
622 }
623 #endif
624 rp += 2;
625 {
626 #line 295 "prim"
627 /* !! alias for 2rdrop */
628 #line 629 "prim.i"
629 }
630 
631 #ifdef VM_DEBUG
632 if (vm_debug) {
633 fputs(" -- ", vm_out); fputc('\n', vm_out);
634 }
635 #endif
636 NEXT_P1;
637 LABEL2(unloop)
638 NEXT_P1_5;
639 LABEL3(unloop)
640 DO_GOTO;
641 }
642 
643 LABEL(lit_perform) /* lit-perform ( #a_addr -- ) S0 -- S0  */
644 /*  */
645 NAME("lit-perform")
646 {
647 DEF_CA
648 MAYBE_UNUSED Cell * a_addr;
649 NEXT_P0;
650 vm_Cell2a_(IMM_ARG(IPTOS,305397761 ),a_addr);
651 #ifdef VM_DEBUG
652 if (vm_debug) {
653 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
654 }
655 #endif
656 INC_IP(1);
657 {
658 #line 300 "prim"
659 #ifndef NO_IP
660 ip=IP;
661 #endif
662 SUPER_END;
663 VM_JUMP(EXEC1(*(Xt *)a_addr));
664 #line 665 "prim.i"
665 }
666 
667 #ifdef VM_DEBUG
668 if (vm_debug) {
669 fputs(" -- ", vm_out); fputc('\n', vm_out);
670 }
671 #endif
672 LABEL2(lit_perform)
673 LABEL3(lit_perform)
674 DO_GOTO;
675 }
676 
677 LABEL(does_exec) /* does-exec ( #a_cfa -- R:nest a_pfa ) S0 -- S0  */
678 /*  */
679 NAME("does-exec")
680 {
681 DEF_CA
682 MAYBE_UNUSED Cell * a_cfa;
683 Cell nest;
684 Cell * a_pfa;
685 NEXT_P0;
686 vm_Cell2a_(IMM_ARG(IPTOS,305397762 ),a_cfa);
687 #ifdef VM_DEBUG
688 if (vm_debug) {
689 fputs(" a_cfa=", vm_out); printarg_a_(a_cfa);
690 }
691 #endif
692 INC_IP(1);
693 sp += -1;
694 rp += -1;
695 {
696 #line 307 "prim"
697 #ifdef NO_IP
698 /* compiled to LIT CALL by compile_prim */
699 assert(0);
700 #else
701 a_pfa = PFA(a_cfa);
702 nest = (Cell)IP;
703 #ifdef DEBUG
704     {
705       CFA_TO_NAME(a_cfa);
706       fprintf(stderr,"%08lx: does %08lx %.*s\n",
707 	      (Cell)ip,(Cell)a_cfa,len,name);
708     }
709 #endif
710 SET_IP(DOES_CODE1(a_cfa));
711 #endif
712 #line 713 "prim.i"
713 }
714 SUPER_END;
715 
716 #ifdef VM_DEBUG
717 if (vm_debug) {
718 fputs(" -- ", vm_out); fputs(" nest=", vm_out); printarg_n(nest);
719 fputs(" a_pfa=", vm_out); printarg_a_(a_pfa);
720 fputc('\n', vm_out);
721 }
722 #endif
723 NEXT_P1;
724 vm_n2Cell(nest,rp[0]);
725 vm_a_2Cell(a_pfa,sp[0]);
726 LABEL2(does_exec)
727 NEXT_P1_5;
728 LABEL3(does_exec)
729 DO_GOTO;
730 }
731 
732 GROUPADD(8)
733 #ifdef HAS_GLOCALS
LABEL(branch_lp_plus_store_number)734 LABEL(branch_lp_plus_store_number) /* branch-lp+!# ( #a_target #nlocals -- ) S0 -- S0  */
735 /*  */
736 NAME("branch-lp+!#")
737 {
738 DEF_CA
739 MAYBE_UNUSED Cell * a_target;
740 MAYBE_UNUSED Cell nlocals;
741 NEXT_P0;
742 vm_Cell2a_(IMM_ARG(IPTOS,305397763 ),a_target);
743 vm_Cell2n(IMM_ARG(IP[1],305397764 ),nlocals);
744 #ifdef VM_DEBUG
745 if (vm_debug) {
746 fputs(" a_target=", vm_out); printarg_a_(a_target);
747 fputs(" nlocals=", vm_out); printarg_n(nlocals);
748 }
749 #endif
750 INC_IP(2);
751 {
752 #line 326 "prim"
753 /* this will probably not be used */
754 lp += nlocals;
755 #ifdef NO_IP
756 SUPER_END;
757 
758 #ifdef VM_DEBUG
759 if (vm_debug) {
760 fputs(" -- ", vm_out); fputc('\n', vm_out);
761 }
762 #endif
763 NEXT_P1;
764 
765 JUMP(a_target);
766 #else
767 SET_IP((Xt *)a_target);
768 #endif
769 #line 770 "prim.i"
770 }
771 SUPER_END;
772 
773 #ifdef VM_DEBUG
774 if (vm_debug) {
775 fputs(" -- ", vm_out); fputc('\n', vm_out);
776 }
777 #endif
778 NEXT_P1;
779 LABEL2(branch_lp_plus_store_number)
780 NEXT_P1_5;
781 LABEL3(branch_lp_plus_store_number)
782 DO_GOTO;
783 }
784 
785 GROUPADD(1)
786 #endif
LABEL(branch)787 LABEL(branch) /* branch ( #a_target -- ) S0 -- S0  */
788 /*  */
789 NAME("branch")
790 {
791 DEF_CA
792 MAYBE_UNUSED Cell * a_target;
793 NEXT_P0;
794 vm_Cell2a_(IMM_ARG(IPTOS,305397765 ),a_target);
795 #ifdef VM_DEBUG
796 if (vm_debug) {
797 fputs(" a_target=", vm_out); printarg_a_(a_target);
798 }
799 #endif
800 INC_IP(1);
801 {
802 #line 338 "prim"
803 #ifdef NO_IP
804 SUPER_END;
805 
806 #ifdef VM_DEBUG
807 if (vm_debug) {
808 fputs(" -- ", vm_out); fputc('\n', vm_out);
809 }
810 #endif
811 NEXT_P1;
812 
813 JUMP(a_target);
814 #else
815 SET_IP((Xt *)a_target);
816 #endif
817 #line 818 "prim.i"
818 }
819 SUPER_END;
820 
821 #ifdef VM_DEBUG
822 if (vm_debug) {
823 fputs(" -- ", vm_out); fputc('\n', vm_out);
824 }
825 #endif
826 NEXT_P1;
827 LABEL2(branch)
828 NEXT_P1_5;
829 LABEL3(branch)
830 DO_GOTO;
831 }
832 
833 LABEL(question_branch) /* ?branch ( #a_target f -- ) S0 -- S0  */
834 /*  */
835 NAME("?branch")
836 {
837 DEF_CA
838 MAYBE_UNUSED Cell * a_target;
839 MAYBE_UNUSED Bool f;
840 NEXT_P0;
841 vm_Cell2a_(IMM_ARG(IPTOS,305397766 ),a_target);
842 vm_Cell2f(sp[0],f);
843 #ifdef VM_DEBUG
844 if (vm_debug) {
845 fputs(" a_target=", vm_out); printarg_a_(a_target);
846 fputs(" f=", vm_out); printarg_f(f);
847 }
848 #endif
849 INC_IP(1);
850 sp += 1;
851 {
852 #line 383 "prim"
853 	#ifdef NO_IP
854 #line 382
855 SUPER_END;
856 
857 #ifdef VM_DEBUG
858 if (vm_debug) {
859 fputs(" -- ", vm_out); fputc('\n', vm_out);
860 }
861 #endif
862 NEXT_P1;
863 
864 #line 382
865 #endif
866 #line 382
867 if (f==0) {
868 #line 382
869 	#ifdef NO_IP
870 #line 382
871 JUMP(a_target);
872 #line 382
873 #else
874 #line 382
875 SET_IP((Xt *)a_target);
876 #line 382
877 /* 0=0 */
878 #line 382
879 #endif
880 #line 382
881 }
882 #line 382
883 /* 0=0 */
884 #line 382
885 #line 886 "prim.i"
886 }
887 SUPER_END;
888 
889 #ifdef VM_DEBUG
890 if (vm_debug) {
891 fputs(" -- ", vm_out); fputc('\n', vm_out);
892 }
893 #endif
894 NEXT_P1;
895 LABEL2(question_branch)
896 NEXT_P1_5;
897 LABEL3(question_branch)
898 DO_GOTO;
899 }
900 
901 GROUPADD(2)
902 #ifdef HAS_GLOCALS
LABEL(question_branch_lp_plus_store_number)903 LABEL(question_branch_lp_plus_store_number) /* ?branch-lp+!# ( #a_target #nlocals f -- ) S0 -- S0  */
904 /*  */
905 NAME("?branch-lp+!#")
906 {
907 DEF_CA
908 MAYBE_UNUSED Cell * a_target;
909 MAYBE_UNUSED Cell nlocals;
910 MAYBE_UNUSED Bool f;
911 NEXT_P0;
912 vm_Cell2a_(IMM_ARG(IPTOS,305397767 ),a_target);
913 vm_Cell2n(IMM_ARG(IP[1],305397768 ),nlocals);
914 vm_Cell2f(sp[0],f);
915 #ifdef VM_DEBUG
916 if (vm_debug) {
917 fputs(" a_target=", vm_out); printarg_a_(a_target);
918 fputs(" nlocals=", vm_out); printarg_n(nlocals);
919 fputs(" f=", vm_out); printarg_f(f);
920 }
921 #endif
922 INC_IP(2);
923 sp += 1;
924 {
925 #line 383 "prim"
926 	#ifdef NO_IP
927 #line 382
928 SUPER_END;
929 
930 #ifdef VM_DEBUG
931 if (vm_debug) {
932 fputs(" -- ", vm_out); fputc('\n', vm_out);
933 }
934 #endif
935 NEXT_P1;
936 
937 #line 382
938 #endif
939 #line 382
940 if (f==0) {
941 #line 382
942 	lp += nlocals;
943 #line 382
944 #ifdef NO_IP
945 #line 382
946 JUMP(a_target);
947 #line 382
948 #else
949 #line 382
950 SET_IP((Xt *)a_target);
951 #line 382
952 /* 0=0 */
953 #line 382
954 #endif
955 #line 382
956 }
957 #line 382
958 /* 0=0 */
959 #line 382
960 #line 961 "prim.i"
961 }
962 SUPER_END;
963 
964 #ifdef VM_DEBUG
965 if (vm_debug) {
966 fputs(" -- ", vm_out); fputc('\n', vm_out);
967 }
968 #endif
969 NEXT_P1;
970 LABEL2(question_branch_lp_plus_store_number)
971 NEXT_P1_5;
972 LABEL3(question_branch_lp_plus_store_number)
973 DO_GOTO;
974 }
975 
976 GROUPADD(1)
977 #endif
978 GROUPADD(0)
979 #ifdef HAS_XCONDS
LABEL(question_dupe_question_branch)980 LABEL(question_dupe_question_branch) /* ?dup-?branch ( #a_target f -- S:... ) S0 -- S0  */
981 /* The run-time procedure compiled by @code{?DUP-IF}. */
982 NAME("?dup-?branch")
983 {
984 DEF_CA
985 MAYBE_UNUSED Cell * a_target;
986 MAYBE_UNUSED Bool f;
987 NEXT_P0;
988 vm_Cell2a_(IMM_ARG(IPTOS,305397769 ),a_target);
989 vm_Cell2f(sp[0],f);
990 #ifdef VM_DEBUG
991 if (vm_debug) {
992 fputs(" a_target=", vm_out); printarg_a_(a_target);
993 fputs(" f=", vm_out); printarg_f(f);
994 }
995 #endif
996 INC_IP(1);
997 sp += 1;
998 {
999 #line 398 "prim"
1000 if (f==0) {
1001 #ifdef NO_IP
1002 SUPER_END;
1003 
1004 #ifdef VM_DEBUG
1005 if (vm_debug) {
1006 fputs(" -- ", vm_out); fputc('\n', vm_out);
1007 }
1008 #endif
1009 NEXT_P1;
1010 
1011 JUMP(a_target);
1012 #else
1013 SET_IP((Xt *)a_target);
1014 #endif
1015 } else {
1016 sp--;
1017 sp[0]=f;
1018 }
1019 #line 1020 "prim.i"
1020 }
1021 SUPER_END;
1022 
1023 #ifdef VM_DEBUG
1024 if (vm_debug) {
1025 fputs(" -- ", vm_out); fputc('\n', vm_out);
1026 }
1027 #endif
1028 NEXT_P1;
1029 LABEL2(question_dupe_question_branch)
1030 NEXT_P1_5;
1031 LABEL3(question_dupe_question_branch)
1032 DO_GOTO;
1033 }
1034 
1035 LABEL(question_dupe_zero_equals_question_branch) /* ?dup-0=-?branch ( #a_target f -- S:... ) S0 -- S0  */
1036 /* The run-time procedure compiled by @code{?DUP-0=-IF}. */
1037 NAME("?dup-0=-?branch")
1038 {
1039 DEF_CA
1040 MAYBE_UNUSED Cell * a_target;
1041 MAYBE_UNUSED Bool f;
1042 NEXT_P0;
1043 vm_Cell2a_(IMM_ARG(IPTOS,305397770 ),a_target);
1044 vm_Cell2f(sp[0],f);
1045 #ifdef VM_DEBUG
1046 if (vm_debug) {
1047 fputs(" a_target=", vm_out); printarg_a_(a_target);
1048 fputs(" f=", vm_out); printarg_f(f);
1049 }
1050 #endif
1051 INC_IP(1);
1052 sp += 1;
1053 {
1054 #line 412 "prim"
1055 if (f!=0) {
1056   sp--;
1057   sp[0]=f;
1058 #ifdef NO_IP
1059   JUMP(a_target);
1060 #else
1061   SET_IP((Xt *)a_target);
1062 #endif
1063 }
1064 #line 1065 "prim.i"
1065 }
1066 SUPER_END;
1067 
1068 #ifdef VM_DEBUG
1069 if (vm_debug) {
1070 fputs(" -- ", vm_out); fputc('\n', vm_out);
1071 }
1072 #endif
1073 NEXT_P1;
1074 LABEL2(question_dupe_zero_equals_question_branch)
1075 NEXT_P1_5;
1076 LABEL3(question_dupe_zero_equals_question_branch)
1077 DO_GOTO;
1078 }
1079 
1080 GROUPADD(2)
1081 #endif
LABEL(paren_next)1082 LABEL(paren_next) /* (next) ( #a_target R:n1 -- R:n2 ) S0 -- S0  */
1083 /*  */
1084 NAME("(next)")
1085 {
1086 DEF_CA
1087 MAYBE_UNUSED Cell * a_target;
1088 MAYBE_UNUSED Cell n1;
1089 Cell n2;
1090 NEXT_P0;
1091 vm_Cell2a_(IMM_ARG(IPTOS,305397771 ),a_target);
1092 vm_Cell2n(rp[0],n1);
1093 #ifdef VM_DEBUG
1094 if (vm_debug) {
1095 fputs(" a_target=", vm_out); printarg_a_(a_target);
1096 fputs(" n1=", vm_out); printarg_n(n1);
1097 }
1098 #endif
1099 INC_IP(1);
1100 {
1101 #line 425 "prim"
1102 n2=n1-1;
1103 #line 424
1104 	#ifdef NO_IP
1105 #line 424
1106 SUPER_END;
1107 
1108 #ifdef VM_DEBUG
1109 if (vm_debug) {
1110 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1111 fputc('\n', vm_out);
1112 }
1113 #endif
1114 NEXT_P1;
1115 vm_n2Cell(n2,rp[0]);
1116 
1117 #line 424
1118 #endif
1119 #line 424
1120 if (n1) {
1121 #line 424
1122 	#ifdef NO_IP
1123 #line 424
1124 JUMP(a_target);
1125 #line 424
1126 #else
1127 #line 424
1128 SET_IP((Xt *)a_target);
1129 #line 424
1130 /* 0=0 */
1131 #line 424
1132 #endif
1133 #line 424
1134 }
1135 #line 424
1136 /* 0=0 */
1137 #line 424
1138 #line 1139 "prim.i"
1139 }
1140 SUPER_END;
1141 
1142 #ifdef VM_DEBUG
1143 if (vm_debug) {
1144 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1145 fputc('\n', vm_out);
1146 }
1147 #endif
1148 NEXT_P1;
1149 vm_n2Cell(n2,rp[0]);
1150 LABEL2(paren_next)
1151 NEXT_P1_5;
1152 LABEL3(paren_next)
1153 DO_GOTO;
1154 }
1155 
1156 GROUPADD(1)
1157 #ifdef HAS_GLOCALS
LABEL(paren_next_lp_plus_store_number)1158 LABEL(paren_next_lp_plus_store_number) /* (next)-lp+!# ( #a_target #nlocals R:n1 -- R:n2 ) S0 -- S0  */
1159 /*  */
1160 NAME("(next)-lp+!#")
1161 {
1162 DEF_CA
1163 MAYBE_UNUSED Cell * a_target;
1164 MAYBE_UNUSED Cell nlocals;
1165 MAYBE_UNUSED Cell n1;
1166 Cell n2;
1167 NEXT_P0;
1168 vm_Cell2a_(IMM_ARG(IPTOS,305397772 ),a_target);
1169 vm_Cell2n(IMM_ARG(IP[1],305397773 ),nlocals);
1170 vm_Cell2n(rp[0],n1);
1171 #ifdef VM_DEBUG
1172 if (vm_debug) {
1173 fputs(" a_target=", vm_out); printarg_a_(a_target);
1174 fputs(" nlocals=", vm_out); printarg_n(nlocals);
1175 fputs(" n1=", vm_out); printarg_n(n1);
1176 }
1177 #endif
1178 INC_IP(2);
1179 {
1180 #line 425 "prim"
1181 n2=n1-1;
1182 #line 424
1183 	#ifdef NO_IP
1184 #line 424
1185 SUPER_END;
1186 
1187 #ifdef VM_DEBUG
1188 if (vm_debug) {
1189 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1190 fputc('\n', vm_out);
1191 }
1192 #endif
1193 NEXT_P1;
1194 vm_n2Cell(n2,rp[0]);
1195 
1196 #line 424
1197 #endif
1198 #line 424
1199 if (n1) {
1200 #line 424
1201 	lp += nlocals;
1202 #line 424
1203 #ifdef NO_IP
1204 #line 424
1205 JUMP(a_target);
1206 #line 424
1207 #else
1208 #line 424
1209 SET_IP((Xt *)a_target);
1210 #line 424
1211 /* 0=0 */
1212 #line 424
1213 #endif
1214 #line 424
1215 }
1216 #line 424
1217 /* 0=0 */
1218 #line 424
1219 #line 1220 "prim.i"
1220 }
1221 SUPER_END;
1222 
1223 #ifdef VM_DEBUG
1224 if (vm_debug) {
1225 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1226 fputc('\n', vm_out);
1227 }
1228 #endif
1229 NEXT_P1;
1230 vm_n2Cell(n2,rp[0]);
1231 LABEL2(paren_next_lp_plus_store_number)
1232 NEXT_P1_5;
1233 LABEL3(paren_next_lp_plus_store_number)
1234 DO_GOTO;
1235 }
1236 
1237 GROUPADD(1)
1238 #endif
LABEL(paren_loop)1239 LABEL(paren_loop) /* (loop) ( #a_target R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1240 /*  */
1241 NAME("(loop)")
1242 {
1243 DEF_CA
1244 MAYBE_UNUSED Cell * a_target;
1245 MAYBE_UNUSED Cell nlimit;
1246 MAYBE_UNUSED Cell n1;
1247 Cell n2;
1248 NEXT_P0;
1249 vm_Cell2a_(IMM_ARG(IPTOS,305397774 ),a_target);
1250 vm_Cell2n(rp[1],nlimit);
1251 vm_Cell2n(rp[0],n1);
1252 #ifdef VM_DEBUG
1253 if (vm_debug) {
1254 fputs(" a_target=", vm_out); printarg_a_(a_target);
1255 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1256 fputs(" n1=", vm_out); printarg_n(n1);
1257 }
1258 #endif
1259 INC_IP(1);
1260 {
1261 #line 432 "prim"
1262 n2=n1+1;
1263 #line 431
1264 	#ifdef NO_IP
1265 #line 431
1266 SUPER_END;
1267 
1268 #ifdef VM_DEBUG
1269 if (vm_debug) {
1270 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1271 fputc('\n', vm_out);
1272 }
1273 #endif
1274 NEXT_P1;
1275 vm_n2Cell(n2,rp[0]);
1276 
1277 #line 431
1278 #endif
1279 #line 431
1280 if (n2 != nlimit) {
1281 #line 431
1282 	#ifdef NO_IP
1283 #line 431
1284 JUMP(a_target);
1285 #line 431
1286 #else
1287 #line 431
1288 SET_IP((Xt *)a_target);
1289 #line 431
1290 /* 0=0 */
1291 #line 431
1292 #endif
1293 #line 431
1294 }
1295 #line 431
1296 /* 0=0 */
1297 #line 431
1298 #line 1299 "prim.i"
1299 }
1300 SUPER_END;
1301 
1302 #ifdef VM_DEBUG
1303 if (vm_debug) {
1304 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1305 fputc('\n', vm_out);
1306 }
1307 #endif
1308 NEXT_P1;
1309 vm_n2Cell(n2,rp[0]);
1310 LABEL2(paren_loop)
1311 NEXT_P1_5;
1312 LABEL3(paren_loop)
1313 DO_GOTO;
1314 }
1315 
1316 GROUPADD(1)
1317 #ifdef HAS_GLOCALS
LABEL(paren_loop_lp_plus_store_number)1318 LABEL(paren_loop_lp_plus_store_number) /* (loop)-lp+!# ( #a_target #nlocals R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1319 /*  */
1320 NAME("(loop)-lp+!#")
1321 {
1322 DEF_CA
1323 MAYBE_UNUSED Cell * a_target;
1324 MAYBE_UNUSED Cell nlocals;
1325 MAYBE_UNUSED Cell nlimit;
1326 MAYBE_UNUSED Cell n1;
1327 Cell n2;
1328 NEXT_P0;
1329 vm_Cell2a_(IMM_ARG(IPTOS,305397775 ),a_target);
1330 vm_Cell2n(IMM_ARG(IP[1],305397776 ),nlocals);
1331 vm_Cell2n(rp[1],nlimit);
1332 vm_Cell2n(rp[0],n1);
1333 #ifdef VM_DEBUG
1334 if (vm_debug) {
1335 fputs(" a_target=", vm_out); printarg_a_(a_target);
1336 fputs(" nlocals=", vm_out); printarg_n(nlocals);
1337 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1338 fputs(" n1=", vm_out); printarg_n(n1);
1339 }
1340 #endif
1341 INC_IP(2);
1342 {
1343 #line 432 "prim"
1344 n2=n1+1;
1345 #line 431
1346 	#ifdef NO_IP
1347 #line 431
1348 SUPER_END;
1349 
1350 #ifdef VM_DEBUG
1351 if (vm_debug) {
1352 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1353 fputc('\n', vm_out);
1354 }
1355 #endif
1356 NEXT_P1;
1357 vm_n2Cell(n2,rp[0]);
1358 
1359 #line 431
1360 #endif
1361 #line 431
1362 if (n2 != nlimit) {
1363 #line 431
1364 	lp += nlocals;
1365 #line 431
1366 #ifdef NO_IP
1367 #line 431
1368 JUMP(a_target);
1369 #line 431
1370 #else
1371 #line 431
1372 SET_IP((Xt *)a_target);
1373 #line 431
1374 /* 0=0 */
1375 #line 431
1376 #endif
1377 #line 431
1378 }
1379 #line 431
1380 /* 0=0 */
1381 #line 431
1382 #line 1383 "prim.i"
1383 }
1384 SUPER_END;
1385 
1386 #ifdef VM_DEBUG
1387 if (vm_debug) {
1388 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1389 fputc('\n', vm_out);
1390 }
1391 #endif
1392 NEXT_P1;
1393 vm_n2Cell(n2,rp[0]);
1394 LABEL2(paren_loop_lp_plus_store_number)
1395 NEXT_P1_5;
1396 LABEL3(paren_loop_lp_plus_store_number)
1397 DO_GOTO;
1398 }
1399 
1400 GROUPADD(1)
1401 #endif
LABEL(paren_plus_loop)1402 LABEL(paren_plus_loop) /* (+loop) ( #a_target n R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1403 /*  */
1404 NAME("(+loop)")
1405 {
1406 DEF_CA
1407 MAYBE_UNUSED Cell * a_target;
1408 MAYBE_UNUSED Cell n;
1409 MAYBE_UNUSED Cell nlimit;
1410 MAYBE_UNUSED Cell n1;
1411 Cell n2;
1412 NEXT_P0;
1413 vm_Cell2a_(IMM_ARG(IPTOS,305397777 ),a_target);
1414 vm_Cell2n(sp[0],n);
1415 vm_Cell2n(rp[1],nlimit);
1416 vm_Cell2n(rp[0],n1);
1417 #ifdef VM_DEBUG
1418 if (vm_debug) {
1419 fputs(" a_target=", vm_out); printarg_a_(a_target);
1420 fputs(" n=", vm_out); printarg_n(n);
1421 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1422 fputs(" n1=", vm_out); printarg_n(n1);
1423 }
1424 #endif
1425 INC_IP(1);
1426 sp += 1;
1427 {
1428 #line 440 "prim"
1429 /* !! check this thoroughly */
1430 #line 439
1431 /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */
1432 #line 439
1433 /* dependent upon two's complement arithmetic */
1434 #line 439
1435 Cell olddiff = n1-nlimit;
1436 #line 439
1437 n2=n1+n;
1438 #line 439
1439 	#ifdef NO_IP
1440 #line 439
1441 SUPER_END;
1442 
1443 #ifdef VM_DEBUG
1444 if (vm_debug) {
1445 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1446 fputc('\n', vm_out);
1447 }
1448 #endif
1449 NEXT_P1;
1450 vm_n2Cell(n2,rp[0]);
1451 
1452 #line 439
1453 #endif
1454 #line 439
1455 if (((olddiff^(olddiff+n))    /* the limit is not crossed */
1456 #line 439
1457      &(olddiff^n))	       /* OR it is a wrap-around effect */
1458 #line 439
1459     >=0) { /* & is used to avoid having two branches for gforth-native */
1460 #line 439
1461 	#ifdef NO_IP
1462 #line 439
1463 JUMP(a_target);
1464 #line 439
1465 #else
1466 #line 439
1467 SET_IP((Xt *)a_target);
1468 #line 439
1469 /* 0=0 */
1470 #line 439
1471 #endif
1472 #line 439
1473 }
1474 #line 439
1475 /* 0=0 */
1476 #line 439
1477 #line 1478 "prim.i"
1478 }
1479 SUPER_END;
1480 
1481 #ifdef VM_DEBUG
1482 if (vm_debug) {
1483 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1484 fputc('\n', vm_out);
1485 }
1486 #endif
1487 NEXT_P1;
1488 vm_n2Cell(n2,rp[0]);
1489 LABEL2(paren_plus_loop)
1490 NEXT_P1_5;
1491 LABEL3(paren_plus_loop)
1492 DO_GOTO;
1493 }
1494 
1495 GROUPADD(1)
1496 #ifdef HAS_GLOCALS
LABEL(paren_plus_loop_lp_plus_store_number)1497 LABEL(paren_plus_loop_lp_plus_store_number) /* (+loop)-lp+!# ( #a_target #nlocals n R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1498 /*  */
1499 NAME("(+loop)-lp+!#")
1500 {
1501 DEF_CA
1502 MAYBE_UNUSED Cell * a_target;
1503 MAYBE_UNUSED Cell nlocals;
1504 MAYBE_UNUSED Cell n;
1505 MAYBE_UNUSED Cell nlimit;
1506 MAYBE_UNUSED Cell n1;
1507 Cell n2;
1508 NEXT_P0;
1509 vm_Cell2a_(IMM_ARG(IPTOS,305397778 ),a_target);
1510 vm_Cell2n(IMM_ARG(IP[1],305397779 ),nlocals);
1511 vm_Cell2n(sp[0],n);
1512 vm_Cell2n(rp[1],nlimit);
1513 vm_Cell2n(rp[0],n1);
1514 #ifdef VM_DEBUG
1515 if (vm_debug) {
1516 fputs(" a_target=", vm_out); printarg_a_(a_target);
1517 fputs(" nlocals=", vm_out); printarg_n(nlocals);
1518 fputs(" n=", vm_out); printarg_n(n);
1519 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1520 fputs(" n1=", vm_out); printarg_n(n1);
1521 }
1522 #endif
1523 INC_IP(2);
1524 sp += 1;
1525 {
1526 #line 440 "prim"
1527 /* !! check this thoroughly */
1528 #line 439
1529 /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */
1530 #line 439
1531 /* dependent upon two's complement arithmetic */
1532 #line 439
1533 Cell olddiff = n1-nlimit;
1534 #line 439
1535 n2=n1+n;
1536 #line 439
1537 	#ifdef NO_IP
1538 #line 439
1539 SUPER_END;
1540 
1541 #ifdef VM_DEBUG
1542 if (vm_debug) {
1543 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1544 fputc('\n', vm_out);
1545 }
1546 #endif
1547 NEXT_P1;
1548 vm_n2Cell(n2,rp[0]);
1549 
1550 #line 439
1551 #endif
1552 #line 439
1553 if (((olddiff^(olddiff+n))    /* the limit is not crossed */
1554 #line 439
1555      &(olddiff^n))	       /* OR it is a wrap-around effect */
1556 #line 439
1557     >=0) { /* & is used to avoid having two branches for gforth-native */
1558 #line 439
1559 	lp += nlocals;
1560 #line 439
1561 #ifdef NO_IP
1562 #line 439
1563 JUMP(a_target);
1564 #line 439
1565 #else
1566 #line 439
1567 SET_IP((Xt *)a_target);
1568 #line 439
1569 /* 0=0 */
1570 #line 439
1571 #endif
1572 #line 439
1573 }
1574 #line 439
1575 /* 0=0 */
1576 #line 439
1577 #line 1578 "prim.i"
1578 }
1579 SUPER_END;
1580 
1581 #ifdef VM_DEBUG
1582 if (vm_debug) {
1583 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1584 fputc('\n', vm_out);
1585 }
1586 #endif
1587 NEXT_P1;
1588 vm_n2Cell(n2,rp[0]);
1589 LABEL2(paren_plus_loop_lp_plus_store_number)
1590 NEXT_P1_5;
1591 LABEL3(paren_plus_loop_lp_plus_store_number)
1592 DO_GOTO;
1593 }
1594 
1595 GROUPADD(1)
1596 #endif
1597 GROUPADD(0)
1598 #ifdef HAS_XCONDS
LABEL(paren_minus_loop)1599 LABEL(paren_minus_loop) /* (-loop) ( #a_target u R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1600 /*  */
1601 NAME("(-loop)")
1602 {
1603 DEF_CA
1604 MAYBE_UNUSED Cell * a_target;
1605 MAYBE_UNUSED UCell u;
1606 MAYBE_UNUSED Cell nlimit;
1607 MAYBE_UNUSED Cell n1;
1608 Cell n2;
1609 NEXT_P0;
1610 vm_Cell2a_(IMM_ARG(IPTOS,305397780 ),a_target);
1611 vm_Cell2u(sp[0],u);
1612 vm_Cell2n(rp[1],nlimit);
1613 vm_Cell2n(rp[0],n1);
1614 #ifdef VM_DEBUG
1615 if (vm_debug) {
1616 fputs(" a_target=", vm_out); printarg_a_(a_target);
1617 fputs(" u=", vm_out); printarg_u(u);
1618 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1619 fputs(" n1=", vm_out); printarg_n(n1);
1620 }
1621 #endif
1622 INC_IP(1);
1623 sp += 1;
1624 {
1625 #line 459 "prim"
1626 UCell olddiff = n1-nlimit;
1627 #line 458
1628 n2=n1-u;
1629 #line 458
1630 	#ifdef NO_IP
1631 #line 458
1632 SUPER_END;
1633 
1634 #ifdef VM_DEBUG
1635 if (vm_debug) {
1636 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1637 fputc('\n', vm_out);
1638 }
1639 #endif
1640 NEXT_P1;
1641 vm_n2Cell(n2,rp[0]);
1642 
1643 #line 458
1644 #endif
1645 #line 458
1646 if (olddiff>u) {
1647 #line 458
1648 	#ifdef NO_IP
1649 #line 458
1650 JUMP(a_target);
1651 #line 458
1652 #else
1653 #line 458
1654 SET_IP((Xt *)a_target);
1655 #line 458
1656 /* 0=0 */
1657 #line 458
1658 #endif
1659 #line 458
1660 }
1661 #line 458
1662 /* 0=0 */
1663 #line 458
1664 #line 1665 "prim.i"
1665 }
1666 SUPER_END;
1667 
1668 #ifdef VM_DEBUG
1669 if (vm_debug) {
1670 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1671 fputc('\n', vm_out);
1672 }
1673 #endif
1674 NEXT_P1;
1675 vm_n2Cell(n2,rp[0]);
1676 LABEL2(paren_minus_loop)
1677 NEXT_P1_5;
1678 LABEL3(paren_minus_loop)
1679 DO_GOTO;
1680 }
1681 
1682 GROUPADD(1)
1683 #ifdef HAS_GLOCALS
LABEL(paren_minus_loop_lp_plus_store_number)1684 LABEL(paren_minus_loop_lp_plus_store_number) /* (-loop)-lp+!# ( #a_target #nlocals u R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1685 /*  */
1686 NAME("(-loop)-lp+!#")
1687 {
1688 DEF_CA
1689 MAYBE_UNUSED Cell * a_target;
1690 MAYBE_UNUSED Cell nlocals;
1691 MAYBE_UNUSED UCell u;
1692 MAYBE_UNUSED Cell nlimit;
1693 MAYBE_UNUSED Cell n1;
1694 Cell n2;
1695 NEXT_P0;
1696 vm_Cell2a_(IMM_ARG(IPTOS,305397781 ),a_target);
1697 vm_Cell2n(IMM_ARG(IP[1],305397782 ),nlocals);
1698 vm_Cell2u(sp[0],u);
1699 vm_Cell2n(rp[1],nlimit);
1700 vm_Cell2n(rp[0],n1);
1701 #ifdef VM_DEBUG
1702 if (vm_debug) {
1703 fputs(" a_target=", vm_out); printarg_a_(a_target);
1704 fputs(" nlocals=", vm_out); printarg_n(nlocals);
1705 fputs(" u=", vm_out); printarg_u(u);
1706 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1707 fputs(" n1=", vm_out); printarg_n(n1);
1708 }
1709 #endif
1710 INC_IP(2);
1711 sp += 1;
1712 {
1713 #line 459 "prim"
1714 UCell olddiff = n1-nlimit;
1715 #line 458
1716 n2=n1-u;
1717 #line 458
1718 	#ifdef NO_IP
1719 #line 458
1720 SUPER_END;
1721 
1722 #ifdef VM_DEBUG
1723 if (vm_debug) {
1724 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1725 fputc('\n', vm_out);
1726 }
1727 #endif
1728 NEXT_P1;
1729 vm_n2Cell(n2,rp[0]);
1730 
1731 #line 458
1732 #endif
1733 #line 458
1734 if (olddiff>u) {
1735 #line 458
1736 	lp += nlocals;
1737 #line 458
1738 #ifdef NO_IP
1739 #line 458
1740 JUMP(a_target);
1741 #line 458
1742 #else
1743 #line 458
1744 SET_IP((Xt *)a_target);
1745 #line 458
1746 /* 0=0 */
1747 #line 458
1748 #endif
1749 #line 458
1750 }
1751 #line 458
1752 /* 0=0 */
1753 #line 458
1754 #line 1755 "prim.i"
1755 }
1756 SUPER_END;
1757 
1758 #ifdef VM_DEBUG
1759 if (vm_debug) {
1760 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1761 fputc('\n', vm_out);
1762 }
1763 #endif
1764 NEXT_P1;
1765 vm_n2Cell(n2,rp[0]);
1766 LABEL2(paren_minus_loop_lp_plus_store_number)
1767 NEXT_P1_5;
1768 LABEL3(paren_minus_loop_lp_plus_store_number)
1769 DO_GOTO;
1770 }
1771 
1772 GROUPADD(1)
1773 #endif
LABEL(paren_symmetric_plus_loop)1774 LABEL(paren_symmetric_plus_loop) /* (s+loop) ( #a_target n R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1775 /* The run-time procedure compiled by S+LOOP. It loops until the index
1776 crosses the boundary between limit and limit-sign(n). I.e. a symmetric
1777 version of (+LOOP). */
1778 NAME("(s+loop)")
1779 {
1780 DEF_CA
1781 MAYBE_UNUSED Cell * a_target;
1782 MAYBE_UNUSED Cell n;
1783 MAYBE_UNUSED Cell nlimit;
1784 MAYBE_UNUSED Cell n1;
1785 Cell n2;
1786 NEXT_P0;
1787 vm_Cell2a_(IMM_ARG(IPTOS,305397783 ),a_target);
1788 vm_Cell2n(sp[0],n);
1789 vm_Cell2n(rp[1],nlimit);
1790 vm_Cell2n(rp[0],n1);
1791 #ifdef VM_DEBUG
1792 if (vm_debug) {
1793 fputs(" a_target=", vm_out); printarg_a_(a_target);
1794 fputs(" n=", vm_out); printarg_n(n);
1795 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1796 fputs(" n1=", vm_out); printarg_n(n1);
1797 }
1798 #endif
1799 INC_IP(1);
1800 sp += 1;
1801 {
1802 #line 465 "prim"
1803 /* !! check this thoroughly */
1804 #line 464
1805 Cell diff = n1-nlimit;
1806 #line 464
1807 Cell newdiff = diff+n;
1808 #line 464
1809 if (n<0) {
1810 #line 464
1811     diff = -diff;
1812 #line 464
1813     newdiff = -newdiff;
1814 #line 464
1815 }
1816 #line 464
1817 n2=n1+n;
1818 #line 464
1819 	#ifdef NO_IP
1820 #line 464
1821 SUPER_END;
1822 
1823 #ifdef VM_DEBUG
1824 if (vm_debug) {
1825 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1826 fputc('\n', vm_out);
1827 }
1828 #endif
1829 NEXT_P1;
1830 vm_n2Cell(n2,rp[0]);
1831 
1832 #line 464
1833 #endif
1834 #line 464
1835 if (((~diff)|newdiff)<0) { /* use | to avoid two branches for gforth-native */
1836 #line 464
1837 	#ifdef NO_IP
1838 #line 464
1839 JUMP(a_target);
1840 #line 464
1841 #else
1842 #line 464
1843 SET_IP((Xt *)a_target);
1844 #line 464
1845 /* 0=0 */
1846 #line 464
1847 #endif
1848 #line 464
1849 }
1850 #line 464
1851 /* 0=0 */
1852 #line 464
1853 #line 1854 "prim.i"
1854 }
1855 SUPER_END;
1856 
1857 #ifdef VM_DEBUG
1858 if (vm_debug) {
1859 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1860 fputc('\n', vm_out);
1861 }
1862 #endif
1863 NEXT_P1;
1864 vm_n2Cell(n2,rp[0]);
1865 LABEL2(paren_symmetric_plus_loop)
1866 NEXT_P1_5;
1867 LABEL3(paren_symmetric_plus_loop)
1868 DO_GOTO;
1869 }
1870 
1871 GROUPADD(1)
1872 #ifdef HAS_GLOCALS
LABEL(paren_symmetric_plus_loop_lp_plus_store_number)1873 LABEL(paren_symmetric_plus_loop_lp_plus_store_number) /* (s+loop)-lp+!# ( #a_target #nlocals n R:nlimit R:n1 -- R:nlimit R:n2 ) S0 -- S0  */
1874 /* The run-time procedure compiled by S+LOOP. It loops until the index
1875 crosses the boundary between limit and limit-sign(n). I.e. a symmetric
1876 version of (+LOOP). */
1877 NAME("(s+loop)-lp+!#")
1878 {
1879 DEF_CA
1880 MAYBE_UNUSED Cell * a_target;
1881 MAYBE_UNUSED Cell nlocals;
1882 MAYBE_UNUSED Cell n;
1883 MAYBE_UNUSED Cell nlimit;
1884 MAYBE_UNUSED Cell n1;
1885 Cell n2;
1886 NEXT_P0;
1887 vm_Cell2a_(IMM_ARG(IPTOS,305397784 ),a_target);
1888 vm_Cell2n(IMM_ARG(IP[1],305397785 ),nlocals);
1889 vm_Cell2n(sp[0],n);
1890 vm_Cell2n(rp[1],nlimit);
1891 vm_Cell2n(rp[0],n1);
1892 #ifdef VM_DEBUG
1893 if (vm_debug) {
1894 fputs(" a_target=", vm_out); printarg_a_(a_target);
1895 fputs(" nlocals=", vm_out); printarg_n(nlocals);
1896 fputs(" n=", vm_out); printarg_n(n);
1897 fputs(" nlimit=", vm_out); printarg_n(nlimit);
1898 fputs(" n1=", vm_out); printarg_n(n1);
1899 }
1900 #endif
1901 INC_IP(2);
1902 sp += 1;
1903 {
1904 #line 465 "prim"
1905 /* !! check this thoroughly */
1906 #line 464
1907 Cell diff = n1-nlimit;
1908 #line 464
1909 Cell newdiff = diff+n;
1910 #line 464
1911 if (n<0) {
1912 #line 464
1913     diff = -diff;
1914 #line 464
1915     newdiff = -newdiff;
1916 #line 464
1917 }
1918 #line 464
1919 n2=n1+n;
1920 #line 464
1921 	#ifdef NO_IP
1922 #line 464
1923 SUPER_END;
1924 
1925 #ifdef VM_DEBUG
1926 if (vm_debug) {
1927 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1928 fputc('\n', vm_out);
1929 }
1930 #endif
1931 NEXT_P1;
1932 vm_n2Cell(n2,rp[0]);
1933 
1934 #line 464
1935 #endif
1936 #line 464
1937 if (((~diff)|newdiff)<0) { /* use | to avoid two branches for gforth-native */
1938 #line 464
1939 	lp += nlocals;
1940 #line 464
1941 #ifdef NO_IP
1942 #line 464
1943 JUMP(a_target);
1944 #line 464
1945 #else
1946 #line 464
1947 SET_IP((Xt *)a_target);
1948 #line 464
1949 /* 0=0 */
1950 #line 464
1951 #endif
1952 #line 464
1953 }
1954 #line 464
1955 /* 0=0 */
1956 #line 464
1957 #line 1958 "prim.i"
1958 }
1959 SUPER_END;
1960 
1961 #ifdef VM_DEBUG
1962 if (vm_debug) {
1963 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
1964 fputc('\n', vm_out);
1965 }
1966 #endif
1967 NEXT_P1;
1968 vm_n2Cell(n2,rp[0]);
1969 LABEL2(paren_symmetric_plus_loop_lp_plus_store_number)
1970 NEXT_P1_5;
1971 LABEL3(paren_symmetric_plus_loop_lp_plus_store_number)
1972 DO_GOTO;
1973 }
1974 
1975 GROUPADD(1)
1976 #endif
1977 GROUPADD(0)
1978 #endif
LABEL(paren_for)1979 LABEL(paren_for) /* (for) ( ncount -- R:nlimit R:ncount ) S0 -- S0  */
1980 /*  */
1981 NAME("(for)")
1982 {
1983 DEF_CA
1984 MAYBE_UNUSED Cell ncount;
1985 Cell nlimit;
1986 NEXT_P0;
1987 vm_Cell2n(sp[0],ncount);
1988 #ifdef VM_DEBUG
1989 if (vm_debug) {
1990 fputs(" ncount=", vm_out); printarg_n(ncount);
1991 }
1992 #endif
1993 sp += 1;
1994 rp += -2;
1995 {
1996 #line 483 "prim"
1997 /* or (for) = >r -- collides with unloop! */
1998 nlimit=0;
1999 #line 2000 "prim.i"
2000 }
2001 
2002 #ifdef VM_DEBUG
2003 if (vm_debug) {
2004 fputs(" -- ", vm_out); fputs(" nlimit=", vm_out); printarg_n(nlimit);
2005 fputc('\n', vm_out);
2006 }
2007 #endif
2008 NEXT_P1;
2009 vm_n2Cell(nlimit,rp[1]);
2010 vm_n2Cell(ncount,rp[0]);
2011 LABEL2(paren_for)
2012 NEXT_P1_5;
2013 LABEL3(paren_for)
2014 DO_GOTO;
2015 }
2016 
2017 LABEL(paren_do) /* (do) ( nlimit nstart -- R:nlimit R:nstart ) S0 -- S0  */
2018 /*  */
2019 NAME("(do)")
2020 {
2021 DEF_CA
2022 MAYBE_UNUSED Cell nlimit;
2023 MAYBE_UNUSED Cell nstart;
2024 NEXT_P0;
2025 vm_Cell2n(sp[1],nlimit);
2026 vm_Cell2n(sp[0],nstart);
2027 #ifdef VM_DEBUG
2028 if (vm_debug) {
2029 fputs(" nlimit=", vm_out); printarg_n(nlimit);
2030 fputs(" nstart=", vm_out); printarg_n(nstart);
2031 }
2032 #endif
2033 sp += 2;
2034 rp += -2;
2035 {
2036 #line 489 "prim"
2037 #line 2038 "prim.i"
2038 }
2039 
2040 #ifdef VM_DEBUG
2041 if (vm_debug) {
2042 fputs(" -- ", vm_out); fputc('\n', vm_out);
2043 }
2044 #endif
2045 NEXT_P1;
2046 vm_n2Cell(nlimit,rp[1]);
2047 vm_n2Cell(nstart,rp[0]);
2048 LABEL2(paren_do)
2049 NEXT_P1_5;
2050 LABEL3(paren_do)
2051 DO_GOTO;
2052 }
2053 
2054 LABEL(paren_question_do) /* (?do) ( #a_target nlimit nstart -- R:nlimit R:nstart ) S0 -- S0  */
2055 /*  */
2056 NAME("(?do)")
2057 {
2058 DEF_CA
2059 MAYBE_UNUSED Cell * a_target;
2060 MAYBE_UNUSED Cell nlimit;
2061 MAYBE_UNUSED Cell nstart;
2062 NEXT_P0;
2063 vm_Cell2a_(IMM_ARG(IPTOS,305397786 ),a_target);
2064 vm_Cell2n(sp[1],nlimit);
2065 vm_Cell2n(sp[0],nstart);
2066 #ifdef VM_DEBUG
2067 if (vm_debug) {
2068 fputs(" a_target=", vm_out); printarg_a_(a_target);
2069 fputs(" nlimit=", vm_out); printarg_n(nlimit);
2070 fputs(" nstart=", vm_out); printarg_n(nstart);
2071 }
2072 #endif
2073 INC_IP(1);
2074 sp += 2;
2075 rp += -2;
2076 {
2077 #line 493 "prim"
2078 #ifdef NO_IP
2079     SUPER_END;
2080 
2081 #ifdef VM_DEBUG
2082 if (vm_debug) {
2083 fputs(" -- ", vm_out); fputc('\n', vm_out);
2084 }
2085 #endif
2086 NEXT_P1;
2087 vm_n2Cell(nlimit,rp[1]);
2088 vm_n2Cell(nstart,rp[0]);
2089 
2090 #endif
2091 if (nstart == nlimit) {
2092 #ifdef NO_IP
2093     JUMP(a_target);
2094 #else
2095     SET_IP((Xt *)a_target);
2096 #endif
2097 }
2098 #line 2099 "prim.i"
2099 }
2100 SUPER_END;
2101 
2102 #ifdef VM_DEBUG
2103 if (vm_debug) {
2104 fputs(" -- ", vm_out); fputc('\n', vm_out);
2105 }
2106 #endif
2107 NEXT_P1;
2108 vm_n2Cell(nlimit,rp[1]);
2109 vm_n2Cell(nstart,rp[0]);
2110 LABEL2(paren_question_do)
2111 NEXT_P1_5;
2112 LABEL3(paren_question_do)
2113 DO_GOTO;
2114 }
2115 
2116 GROUPADD(3)
2117 #ifdef HAS_XCONDS
LABEL(paren_plus_do)2118 LABEL(paren_plus_do) /* (+do) ( #a_target nlimit nstart -- R:nlimit R:nstart ) S0 -- S0  */
2119 /*  */
2120 NAME("(+do)")
2121 {
2122 DEF_CA
2123 MAYBE_UNUSED Cell * a_target;
2124 MAYBE_UNUSED Cell nlimit;
2125 MAYBE_UNUSED Cell nstart;
2126 NEXT_P0;
2127 vm_Cell2a_(IMM_ARG(IPTOS,305397787 ),a_target);
2128 vm_Cell2n(sp[1],nlimit);
2129 vm_Cell2n(sp[0],nstart);
2130 #ifdef VM_DEBUG
2131 if (vm_debug) {
2132 fputs(" a_target=", vm_out); printarg_a_(a_target);
2133 fputs(" nlimit=", vm_out); printarg_n(nlimit);
2134 fputs(" nstart=", vm_out); printarg_n(nstart);
2135 }
2136 #endif
2137 INC_IP(1);
2138 sp += 2;
2139 rp += -2;
2140 {
2141 #line 514 "prim"
2142 #ifdef NO_IP
2143     SUPER_END;
2144 
2145 #ifdef VM_DEBUG
2146 if (vm_debug) {
2147 fputs(" -- ", vm_out); fputc('\n', vm_out);
2148 }
2149 #endif
2150 NEXT_P1;
2151 vm_n2Cell(nlimit,rp[1]);
2152 vm_n2Cell(nstart,rp[0]);
2153 
2154 #endif
2155 if (nstart >= nlimit) {
2156 #ifdef NO_IP
2157     JUMP(a_target);
2158 #else
2159     SET_IP((Xt *)a_target);
2160 #endif
2161 }
2162 #line 2163 "prim.i"
2163 }
2164 SUPER_END;
2165 
2166 #ifdef VM_DEBUG
2167 if (vm_debug) {
2168 fputs(" -- ", vm_out); fputc('\n', vm_out);
2169 }
2170 #endif
2171 NEXT_P1;
2172 vm_n2Cell(nlimit,rp[1]);
2173 vm_n2Cell(nstart,rp[0]);
2174 LABEL2(paren_plus_do)
2175 NEXT_P1_5;
2176 LABEL3(paren_plus_do)
2177 DO_GOTO;
2178 }
2179 
2180 LABEL(paren_u_plus_do) /* (u+do) ( #a_target ulimit ustart -- R:ulimit R:ustart ) S0 -- S0  */
2181 /*  */
2182 NAME("(u+do)")
2183 {
2184 DEF_CA
2185 MAYBE_UNUSED Cell * a_target;
2186 MAYBE_UNUSED UCell ulimit;
2187 MAYBE_UNUSED UCell ustart;
2188 NEXT_P0;
2189 vm_Cell2a_(IMM_ARG(IPTOS,305397788 ),a_target);
2190 vm_Cell2u(sp[1],ulimit);
2191 vm_Cell2u(sp[0],ustart);
2192 #ifdef VM_DEBUG
2193 if (vm_debug) {
2194 fputs(" a_target=", vm_out); printarg_a_(a_target);
2195 fputs(" ulimit=", vm_out); printarg_u(ulimit);
2196 fputs(" ustart=", vm_out); printarg_u(ustart);
2197 }
2198 #endif
2199 INC_IP(1);
2200 sp += 2;
2201 rp += -2;
2202 {
2203 #line 535 "prim"
2204 #ifdef NO_IP
2205     SUPER_END;
2206 
2207 #ifdef VM_DEBUG
2208 if (vm_debug) {
2209 fputs(" -- ", vm_out); fputc('\n', vm_out);
2210 }
2211 #endif
2212 NEXT_P1;
2213 vm_u2Cell(ulimit,rp[1]);
2214 vm_u2Cell(ustart,rp[0]);
2215 
2216 #endif
2217 if (ustart >= ulimit) {
2218 #ifdef NO_IP
2219 JUMP(a_target);
2220 #else
2221 SET_IP((Xt *)a_target);
2222 #endif
2223 }
2224 #line 2225 "prim.i"
2225 }
2226 SUPER_END;
2227 
2228 #ifdef VM_DEBUG
2229 if (vm_debug) {
2230 fputs(" -- ", vm_out); fputc('\n', vm_out);
2231 }
2232 #endif
2233 NEXT_P1;
2234 vm_u2Cell(ulimit,rp[1]);
2235 vm_u2Cell(ustart,rp[0]);
2236 LABEL2(paren_u_plus_do)
2237 NEXT_P1_5;
2238 LABEL3(paren_u_plus_do)
2239 DO_GOTO;
2240 }
2241 
2242 LABEL(paren_minus_do) /* (-do) ( #a_target nlimit nstart -- R:nlimit R:nstart ) S0 -- S0  */
2243 /*  */
2244 NAME("(-do)")
2245 {
2246 DEF_CA
2247 MAYBE_UNUSED Cell * a_target;
2248 MAYBE_UNUSED Cell nlimit;
2249 MAYBE_UNUSED Cell nstart;
2250 NEXT_P0;
2251 vm_Cell2a_(IMM_ARG(IPTOS,305397789 ),a_target);
2252 vm_Cell2n(sp[1],nlimit);
2253 vm_Cell2n(sp[0],nstart);
2254 #ifdef VM_DEBUG
2255 if (vm_debug) {
2256 fputs(" a_target=", vm_out); printarg_a_(a_target);
2257 fputs(" nlimit=", vm_out); printarg_n(nlimit);
2258 fputs(" nstart=", vm_out); printarg_n(nstart);
2259 }
2260 #endif
2261 INC_IP(1);
2262 sp += 2;
2263 rp += -2;
2264 {
2265 #line 556 "prim"
2266 #ifdef NO_IP
2267     SUPER_END;
2268 
2269 #ifdef VM_DEBUG
2270 if (vm_debug) {
2271 fputs(" -- ", vm_out); fputc('\n', vm_out);
2272 }
2273 #endif
2274 NEXT_P1;
2275 vm_n2Cell(nlimit,rp[1]);
2276 vm_n2Cell(nstart,rp[0]);
2277 
2278 #endif
2279 if (nstart <= nlimit) {
2280 #ifdef NO_IP
2281 JUMP(a_target);
2282 #else
2283 SET_IP((Xt *)a_target);
2284 #endif
2285 }
2286 #line 2287 "prim.i"
2287 }
2288 SUPER_END;
2289 
2290 #ifdef VM_DEBUG
2291 if (vm_debug) {
2292 fputs(" -- ", vm_out); fputc('\n', vm_out);
2293 }
2294 #endif
2295 NEXT_P1;
2296 vm_n2Cell(nlimit,rp[1]);
2297 vm_n2Cell(nstart,rp[0]);
2298 LABEL2(paren_minus_do)
2299 NEXT_P1_5;
2300 LABEL3(paren_minus_do)
2301 DO_GOTO;
2302 }
2303 
2304 LABEL(paren_u_minus_do) /* (u-do) ( #a_target ulimit ustart -- R:ulimit R:ustart ) S0 -- S0  */
2305 /*  */
2306 NAME("(u-do)")
2307 {
2308 DEF_CA
2309 MAYBE_UNUSED Cell * a_target;
2310 MAYBE_UNUSED UCell ulimit;
2311 MAYBE_UNUSED UCell ustart;
2312 NEXT_P0;
2313 vm_Cell2a_(IMM_ARG(IPTOS,305397790 ),a_target);
2314 vm_Cell2u(sp[1],ulimit);
2315 vm_Cell2u(sp[0],ustart);
2316 #ifdef VM_DEBUG
2317 if (vm_debug) {
2318 fputs(" a_target=", vm_out); printarg_a_(a_target);
2319 fputs(" ulimit=", vm_out); printarg_u(ulimit);
2320 fputs(" ustart=", vm_out); printarg_u(ustart);
2321 }
2322 #endif
2323 INC_IP(1);
2324 sp += 2;
2325 rp += -2;
2326 {
2327 #line 577 "prim"
2328 #ifdef NO_IP
2329     SUPER_END;
2330 
2331 #ifdef VM_DEBUG
2332 if (vm_debug) {
2333 fputs(" -- ", vm_out); fputc('\n', vm_out);
2334 }
2335 #endif
2336 NEXT_P1;
2337 vm_u2Cell(ulimit,rp[1]);
2338 vm_u2Cell(ustart,rp[0]);
2339 
2340 #endif
2341 if (ustart <= ulimit) {
2342 #ifdef NO_IP
2343 JUMP(a_target);
2344 #else
2345 SET_IP((Xt *)a_target);
2346 #endif
2347 }
2348 #line 2349 "prim.i"
2349 }
2350 SUPER_END;
2351 
2352 #ifdef VM_DEBUG
2353 if (vm_debug) {
2354 fputs(" -- ", vm_out); fputc('\n', vm_out);
2355 }
2356 #endif
2357 NEXT_P1;
2358 vm_u2Cell(ulimit,rp[1]);
2359 vm_u2Cell(ustart,rp[0]);
2360 LABEL2(paren_u_minus_do)
2361 NEXT_P1_5;
2362 LABEL3(paren_u_minus_do)
2363 DO_GOTO;
2364 }
2365 
2366 GROUPADD(4)
2367 #endif
LABEL(i)2368 LABEL(i) /* i ( R:n -- R:n n ) S0 -- S0  */
2369 /*  */
2370 NAME("i")
2371 {
2372 DEF_CA
2373 MAYBE_UNUSED Cell n;
2374 NEXT_P0;
2375 vm_Cell2n(rp[0],n);
2376 #ifdef VM_DEBUG
2377 if (vm_debug) {
2378 fputs(" n=", vm_out); printarg_n(n);
2379 }
2380 #endif
2381 sp += -1;
2382 {
2383 #line 603 "prim"
2384 #line 2385 "prim.i"
2385 }
2386 
2387 #ifdef VM_DEBUG
2388 if (vm_debug) {
2389 fputs(" -- ", vm_out); fputc('\n', vm_out);
2390 }
2391 #endif
2392 NEXT_P1;
2393 vm_n2Cell(n,sp[0]);
2394 LABEL2(i)
2395 NEXT_P1_5;
2396 LABEL3(i)
2397 DO_GOTO;
2398 }
2399 
2400 LABEL(i_tick) /* i' ( R:w R:w2 -- R:w R:w2 w ) S0 -- S0  */
2401 /*  */
2402 NAME("i'")
2403 {
2404 DEF_CA
2405 MAYBE_UNUSED Cell w;
2406 MAYBE_UNUSED Cell w2;
2407 NEXT_P0;
2408 vm_Cell2w(rp[1],w);
2409 vm_Cell2w(rp[0],w2);
2410 #ifdef VM_DEBUG
2411 if (vm_debug) {
2412 fputs(" w=", vm_out); printarg_w(w);
2413 fputs(" w2=", vm_out); printarg_w(w2);
2414 }
2415 #endif
2416 sp += -1;
2417 {
2418 #line 608 "prim"
2419 #line 2420 "prim.i"
2420 }
2421 
2422 #ifdef VM_DEBUG
2423 if (vm_debug) {
2424 fputs(" -- ", vm_out); fputc('\n', vm_out);
2425 }
2426 #endif
2427 NEXT_P1;
2428 vm_w2Cell(w,sp[0]);
2429 LABEL2(i_tick)
2430 NEXT_P1_5;
2431 LABEL3(i_tick)
2432 DO_GOTO;
2433 }
2434 
2435 LABEL(j) /* j ( R:w R:w1 R:w2 -- w R:w R:w1 R:w2 ) S0 -- S0  */
2436 /*  */
2437 NAME("j")
2438 {
2439 DEF_CA
2440 MAYBE_UNUSED Cell w;
2441 MAYBE_UNUSED Cell w1;
2442 MAYBE_UNUSED Cell w2;
2443 NEXT_P0;
2444 vm_Cell2w(rp[2],w);
2445 vm_Cell2w(rp[1],w1);
2446 vm_Cell2w(rp[0],w2);
2447 #ifdef VM_DEBUG
2448 if (vm_debug) {
2449 fputs(" w=", vm_out); printarg_w(w);
2450 fputs(" w1=", vm_out); printarg_w(w1);
2451 fputs(" w2=", vm_out); printarg_w(w2);
2452 }
2453 #endif
2454 sp += -1;
2455 {
2456 #line 614 "prim"
2457 #line 2458 "prim.i"
2458 }
2459 
2460 #ifdef VM_DEBUG
2461 if (vm_debug) {
2462 fputs(" -- ", vm_out); fputc('\n', vm_out);
2463 }
2464 #endif
2465 NEXT_P1;
2466 vm_w2Cell(w,sp[0]);
2467 LABEL2(j)
2468 NEXT_P1_5;
2469 LABEL3(j)
2470 DO_GOTO;
2471 }
2472 
2473 LABEL(k) /* k ( R:w R:w1 R:w2 R:w3 R:w4 -- w R:w R:w1 R:w2 R:w3 R:w4 ) S0 -- S0  */
2474 /*  */
2475 NAME("k")
2476 {
2477 DEF_CA
2478 MAYBE_UNUSED Cell w;
2479 MAYBE_UNUSED Cell w1;
2480 MAYBE_UNUSED Cell w2;
2481 MAYBE_UNUSED Cell w3;
2482 MAYBE_UNUSED Cell w4;
2483 NEXT_P0;
2484 vm_Cell2w(rp[4],w);
2485 vm_Cell2w(rp[3],w1);
2486 vm_Cell2w(rp[2],w2);
2487 vm_Cell2w(rp[1],w3);
2488 vm_Cell2w(rp[0],w4);
2489 #ifdef VM_DEBUG
2490 if (vm_debug) {
2491 fputs(" w=", vm_out); printarg_w(w);
2492 fputs(" w1=", vm_out); printarg_w(w1);
2493 fputs(" w2=", vm_out); printarg_w(w2);
2494 fputs(" w3=", vm_out); printarg_w(w3);
2495 fputs(" w4=", vm_out); printarg_w(w4);
2496 }
2497 #endif
2498 sp += -1;
2499 {
2500 #line 620 "prim"
2501 #line 2502 "prim.i"
2502 }
2503 
2504 #ifdef VM_DEBUG
2505 if (vm_debug) {
2506 fputs(" -- ", vm_out); fputc('\n', vm_out);
2507 }
2508 #endif
2509 NEXT_P1;
2510 vm_w2Cell(w,sp[0]);
2511 LABEL2(k)
2512 NEXT_P1_5;
2513 LABEL3(k)
2514 DO_GOTO;
2515 }
2516 
2517 GROUPADD(4)
2518 GROUP( strings, 44)
LABEL(move)2519 LABEL(move) /* move ( c_from c_to ucount -- ) S0 -- S0  */
2520 /* Copy the contents of @i{ucount} aus at @i{c-from} to
2521 @i{c-to}. @code{move} works correctly even if the two areas overlap. */
2522 NAME("move")
2523 {
2524 DEF_CA
2525 MAYBE_UNUSED Char * c_from;
2526 MAYBE_UNUSED Char * c_to;
2527 MAYBE_UNUSED UCell ucount;
2528 NEXT_P0;
2529 vm_Cell2c_(sp[2],c_from);
2530 vm_Cell2c_(sp[1],c_to);
2531 vm_Cell2u(sp[0],ucount);
2532 #ifdef VM_DEBUG
2533 if (vm_debug) {
2534 fputs(" c_from=", vm_out); printarg_c_(c_from);
2535 fputs(" c_to=", vm_out); printarg_c_(c_to);
2536 fputs(" ucount=", vm_out); printarg_u(ucount);
2537 }
2538 #endif
2539 sp += 3;
2540 {
2541 #line 634 "prim"
2542 /* !! note that the standard specifies addr, not c-addr */
2543 memmove(c_to,c_from,ucount);
2544 /* make an Ifdef for bsd and others? */
2545 #line 2546 "prim.i"
2546 }
2547 
2548 #ifdef VM_DEBUG
2549 if (vm_debug) {
2550 fputs(" -- ", vm_out); fputc('\n', vm_out);
2551 }
2552 #endif
2553 NEXT_P1;
2554 LABEL2(move)
2555 NEXT_P1_5;
2556 LABEL3(move)
2557 DO_GOTO;
2558 }
2559 
2560 LABEL(c_move) /* cmove ( c_from c_to u -- ) S0 -- S0  */
2561 /* Copy the contents of @i{ucount} characters from data space at
2562 @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
2563 from low address to high address; i.e., for overlapping areas it is
2564 safe if @i{c-to}=<@i{c-from}. */
2565 NAME("cmove")
2566 {
2567 DEF_CA
2568 MAYBE_UNUSED Char * c_from;
2569 MAYBE_UNUSED Char * c_to;
2570 MAYBE_UNUSED UCell u;
2571 NEXT_P0;
2572 vm_Cell2c_(sp[2],c_from);
2573 vm_Cell2c_(sp[1],c_to);
2574 vm_Cell2u(sp[0],u);
2575 #ifdef VM_DEBUG
2576 if (vm_debug) {
2577 fputs(" c_from=", vm_out); printarg_c_(c_from);
2578 fputs(" c_to=", vm_out); printarg_c_(c_to);
2579 fputs(" u=", vm_out); printarg_u(u);
2580 }
2581 #endif
2582 sp += 3;
2583 {
2584 #line 645 "prim"
2585 cmove(c_from,c_to,u);
2586 #line 2587 "prim.i"
2587 }
2588 
2589 #ifdef VM_DEBUG
2590 if (vm_debug) {
2591 fputs(" -- ", vm_out); fputc('\n', vm_out);
2592 }
2593 #endif
2594 NEXT_P1;
2595 LABEL2(c_move)
2596 NEXT_P1_5;
2597 LABEL3(c_move)
2598 DO_GOTO;
2599 }
2600 
2601 LABEL(c_move_up) /* cmove> ( c_from c_to u -- ) S0 -- S0  */
2602 /* Copy the contents of @i{ucount} characters from data space at
2603 @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
2604 from high address to low address; i.e., for overlapping areas it is
2605 safe if @i{c-to}>=@i{c-from}. */
2606 NAME("cmove>")
2607 {
2608 DEF_CA
2609 MAYBE_UNUSED Char * c_from;
2610 MAYBE_UNUSED Char * c_to;
2611 MAYBE_UNUSED UCell u;
2612 NEXT_P0;
2613 vm_Cell2c_(sp[2],c_from);
2614 vm_Cell2c_(sp[1],c_to);
2615 vm_Cell2u(sp[0],u);
2616 #ifdef VM_DEBUG
2617 if (vm_debug) {
2618 fputs(" c_from=", vm_out); printarg_c_(c_from);
2619 fputs(" c_to=", vm_out); printarg_c_(c_to);
2620 fputs(" u=", vm_out); printarg_u(u);
2621 }
2622 #endif
2623 sp += 3;
2624 {
2625 #line 654 "prim"
2626 cmove_up(c_from,c_to,u);
2627 #line 2628 "prim.i"
2628 }
2629 
2630 #ifdef VM_DEBUG
2631 if (vm_debug) {
2632 fputs(" -- ", vm_out); fputc('\n', vm_out);
2633 }
2634 #endif
2635 NEXT_P1;
2636 LABEL2(c_move_up)
2637 NEXT_P1_5;
2638 LABEL3(c_move_up)
2639 DO_GOTO;
2640 }
2641 
2642 LABEL(fill) /* fill ( c_addr u c -- ) S0 -- S0  */
2643 /* Store @i{c} in @i{u} chars starting at @i{c-addr}. */
2644 NAME("fill")
2645 {
2646 DEF_CA
2647 MAYBE_UNUSED Char * c_addr;
2648 MAYBE_UNUSED UCell u;
2649 MAYBE_UNUSED Char c;
2650 NEXT_P0;
2651 vm_Cell2c_(sp[2],c_addr);
2652 vm_Cell2u(sp[1],u);
2653 vm_Cell2c(sp[0],c);
2654 #ifdef VM_DEBUG
2655 if (vm_debug) {
2656 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
2657 fputs(" u=", vm_out); printarg_u(u);
2658 fputs(" c=", vm_out); printarg_c(c);
2659 }
2660 #endif
2661 sp += 3;
2662 {
2663 #line 662 "prim"
2664 memset(c_addr,c,u);
2665 #line 2666 "prim.i"
2666 }
2667 
2668 #ifdef VM_DEBUG
2669 if (vm_debug) {
2670 fputs(" -- ", vm_out); fputc('\n', vm_out);
2671 }
2672 #endif
2673 NEXT_P1;
2674 LABEL2(fill)
2675 NEXT_P1_5;
2676 LABEL3(fill)
2677 DO_GOTO;
2678 }
2679 
2680 LABEL(compare) /* compare ( c_addr1 u1 c_addr2 u2 -- n ) S0 -- S0  */
2681 /* Compare two strings lexicographically. If they are equal, @i{n} is 0; if
2682 the first string is smaller, @i{n} is -1; if the first string is larger, @i{n}
2683 is 1. Currently this is based on the machine's character
2684 comparison. In the future, this may change to consider the current
2685 locale and its collation order. */
2686 NAME("compare")
2687 {
2688 DEF_CA
2689 MAYBE_UNUSED Char * c_addr1;
2690 MAYBE_UNUSED UCell u1;
2691 MAYBE_UNUSED Char * c_addr2;
2692 MAYBE_UNUSED UCell u2;
2693 Cell n;
2694 NEXT_P0;
2695 vm_Cell2c_(sp[3],c_addr1);
2696 vm_Cell2u(sp[2],u1);
2697 vm_Cell2c_(sp[1],c_addr2);
2698 vm_Cell2u(sp[0],u2);
2699 #ifdef VM_DEBUG
2700 if (vm_debug) {
2701 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
2702 fputs(" u1=", vm_out); printarg_u(u1);
2703 fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
2704 fputs(" u2=", vm_out); printarg_u(u2);
2705 }
2706 #endif
2707 sp += 3;
2708 {
2709 #line 673 "prim"
2710 /* close ' to keep fontify happy */
2711 n = compare(c_addr1, u1, c_addr2, u2);
2712 #line 2713 "prim.i"
2713 }
2714 
2715 #ifdef VM_DEBUG
2716 if (vm_debug) {
2717 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
2718 fputc('\n', vm_out);
2719 }
2720 #endif
2721 NEXT_P1;
2722 vm_n2Cell(n,sp[0]);
2723 LABEL2(compare)
2724 NEXT_P1_5;
2725 LABEL3(compare)
2726 DO_GOTO;
2727 }
2728 
2729 LABEL(toupper) /* toupper ( c1 -- c2 ) S0 -- S0  */
2730 /* If @i{c1} is a lower-case character (in the current locale), @i{c2}
2731 is the equivalent upper-case character. All other characters are unchanged. */
2732 NAME("toupper")
2733 {
2734 DEF_CA
2735 MAYBE_UNUSED Char c1;
2736 Char c2;
2737 NEXT_P0;
2738 vm_Cell2c(sp[0],c1);
2739 #ifdef VM_DEBUG
2740 if (vm_debug) {
2741 fputs(" c1=", vm_out); printarg_c(c1);
2742 }
2743 #endif
2744 {
2745 #line 702 "prim"
2746 c2 = toupper(c1);
2747 #line 2748 "prim.i"
2748 }
2749 
2750 #ifdef VM_DEBUG
2751 if (vm_debug) {
2752 fputs(" -- ", vm_out); fputs(" c2=", vm_out); printarg_c(c2);
2753 fputc('\n', vm_out);
2754 }
2755 #endif
2756 NEXT_P1;
2757 vm_c2Cell(c2,sp[0]);
2758 LABEL2(toupper)
2759 NEXT_P1_5;
2760 LABEL3(toupper)
2761 DO_GOTO;
2762 }
2763 
2764 LABEL(capscompare) /* capscompare ( c_addr1 u1 c_addr2 u2 -- n ) S0 -- S0  */
2765 /* Compare two strings lexicographically. If they are equal, @i{n} is 0; if
2766 the first string is smaller, @i{n} is -1; if the first string is larger, @i{n}
2767 is 1. Currently this is based on the machine's character
2768 comparison. In the future, this may change to consider the current
2769 locale and its collation order. */
2770 NAME("capscompare")
2771 {
2772 DEF_CA
2773 MAYBE_UNUSED Char * c_addr1;
2774 MAYBE_UNUSED UCell u1;
2775 MAYBE_UNUSED Char * c_addr2;
2776 MAYBE_UNUSED UCell u2;
2777 Cell n;
2778 NEXT_P0;
2779 vm_Cell2c_(sp[3],c_addr1);
2780 vm_Cell2u(sp[2],u1);
2781 vm_Cell2c_(sp[1],c_addr2);
2782 vm_Cell2u(sp[0],u2);
2783 #ifdef VM_DEBUG
2784 if (vm_debug) {
2785 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
2786 fputs(" u1=", vm_out); printarg_u(u1);
2787 fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
2788 fputs(" u2=", vm_out); printarg_u(u2);
2789 }
2790 #endif
2791 sp += 3;
2792 {
2793 #line 712 "prim"
2794 /* close ' to keep fontify happy */
2795 n = capscompare(c_addr1, u1, c_addr2, u2);
2796 #line 2797 "prim.i"
2797 }
2798 
2799 #ifdef VM_DEBUG
2800 if (vm_debug) {
2801 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
2802 fputc('\n', vm_out);
2803 }
2804 #endif
2805 NEXT_P1;
2806 vm_n2Cell(n,sp[0]);
2807 LABEL2(capscompare)
2808 NEXT_P1_5;
2809 LABEL3(capscompare)
2810 DO_GOTO;
2811 }
2812 
2813 LABEL(slash_string) /* /string ( c_addr1 u1 n -- c_addr2 u2 ) S0 -- S0  */
2814 /* Adjust the string specified by @i{c-addr1, u1} to remove @i{n}
2815 characters from the start of the string. */
2816 NAME("/string")
2817 {
2818 DEF_CA
2819 MAYBE_UNUSED Char * c_addr1;
2820 MAYBE_UNUSED UCell u1;
2821 MAYBE_UNUSED Cell n;
2822 Char * c_addr2;
2823 UCell u2;
2824 NEXT_P0;
2825 vm_Cell2c_(sp[2],c_addr1);
2826 vm_Cell2u(sp[1],u1);
2827 vm_Cell2n(sp[0],n);
2828 #ifdef VM_DEBUG
2829 if (vm_debug) {
2830 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
2831 fputs(" u1=", vm_out); printarg_u(u1);
2832 fputs(" n=", vm_out); printarg_n(n);
2833 }
2834 #endif
2835 sp += 1;
2836 {
2837 #line 718 "prim"
2838 c_addr2 = c_addr1+n;
2839 u2 = u1-n;
2840 #line 2841 "prim.i"
2841 }
2842 
2843 #ifdef VM_DEBUG
2844 if (vm_debug) {
2845 fputs(" -- ", vm_out); fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
2846 fputs(" u2=", vm_out); printarg_u(u2);
2847 fputc('\n', vm_out);
2848 }
2849 #endif
2850 NEXT_P1;
2851 vm_c_2Cell(c_addr2,sp[1]);
2852 vm_u2Cell(u2,sp[0]);
2853 LABEL2(slash_string)
2854 NEXT_P1_5;
2855 LABEL3(slash_string)
2856 DO_GOTO;
2857 }
2858 
2859 GROUPADD(8)
2860 GROUP( arith, 52)
LABEL(lit)2861 LABEL(lit) /* lit ( #w -- w ) S0 -- S0  */
2862 /*  */
2863 NAME("lit")
2864 {
2865 DEF_CA
2866 MAYBE_UNUSED Cell w;
2867 NEXT_P0;
2868 vm_Cell2w(IMM_ARG(IPTOS,305397791 ),w);
2869 #ifdef VM_DEBUG
2870 if (vm_debug) {
2871 fputs(" w=", vm_out); printarg_w(w);
2872 }
2873 #endif
2874 INC_IP(1);
2875 sp += -1;
2876 {
2877 #line 726 "prim"
2878 #line 2879 "prim.i"
2879 }
2880 
2881 #ifdef VM_DEBUG
2882 if (vm_debug) {
2883 fputs(" -- ", vm_out); fputc('\n', vm_out);
2884 }
2885 #endif
2886 NEXT_P1;
2887 vm_w2Cell(w,sp[0]);
2888 LABEL2(lit)
2889 NEXT_P1_5;
2890 LABEL3(lit)
2891 DO_GOTO;
2892 }
2893 
2894 LABEL(plus) /* + ( n1 n2 -- n ) S0 -- S0  */
2895 /*  */
2896 NAME("+")
2897 {
2898 DEF_CA
2899 MAYBE_UNUSED Cell n1;
2900 MAYBE_UNUSED Cell n2;
2901 Cell n;
2902 NEXT_P0;
2903 vm_Cell2n(sp[1],n1);
2904 vm_Cell2n(sp[0],n2);
2905 #ifdef VM_DEBUG
2906 if (vm_debug) {
2907 fputs(" n1=", vm_out); printarg_n(n1);
2908 fputs(" n2=", vm_out); printarg_n(n2);
2909 }
2910 #endif
2911 sp += 1;
2912 {
2913 #line 730 "prim"
2914 n = n1+n2;
2915 #line 2916 "prim.i"
2916 }
2917 
2918 #ifdef VM_DEBUG
2919 if (vm_debug) {
2920 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
2921 fputc('\n', vm_out);
2922 }
2923 #endif
2924 NEXT_P1;
2925 vm_n2Cell(n,sp[0]);
2926 LABEL2(plus)
2927 NEXT_P1_5;
2928 LABEL3(plus)
2929 DO_GOTO;
2930 }
2931 
2932 LABEL(lit_plus) /* lit+ ( n1 #n2 -- n ) S0 -- S0  */
2933 /*  */
2934 NAME("lit+")
2935 {
2936 DEF_CA
2937 MAYBE_UNUSED Cell n1;
2938 MAYBE_UNUSED Cell n2;
2939 Cell n;
2940 NEXT_P0;
2941 vm_Cell2n(sp[0],n1);
2942 vm_Cell2n(IMM_ARG(IPTOS,305397792 ),n2);
2943 #ifdef VM_DEBUG
2944 if (vm_debug) {
2945 fputs(" n1=", vm_out); printarg_n(n1);
2946 fputs(" n2=", vm_out); printarg_n(n2);
2947 }
2948 #endif
2949 INC_IP(1);
2950 {
2951 #line 735 "prim"
2952 #ifdef DEBUG
2953 fprintf(stderr, "lit+ %08x\n", n2);
2954 #endif
2955 n=n1+n2;
2956 #line 2957 "prim.i"
2957 }
2958 
2959 #ifdef VM_DEBUG
2960 if (vm_debug) {
2961 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
2962 fputc('\n', vm_out);
2963 }
2964 #endif
2965 NEXT_P1;
2966 vm_n2Cell(n,sp[0]);
2967 LABEL2(lit_plus)
2968 NEXT_P1_5;
2969 LABEL3(lit_plus)
2970 DO_GOTO;
2971 }
2972 
2973 LABEL(under_plus) /* under+ ( n1 n2 n3 -- n n2 ) S0 -- S0  */
2974 /* add @i{n3} to @i{n1} (giving @i{n}) */
2975 NAME("under+")
2976 {
2977 DEF_CA
2978 MAYBE_UNUSED Cell n1;
2979 MAYBE_UNUSED Cell n2;
2980 MAYBE_UNUSED Cell n3;
2981 Cell n;
2982 NEXT_P0;
2983 vm_Cell2n(sp[2],n1);
2984 vm_Cell2n(sp[1],n2);
2985 vm_Cell2n(sp[0],n3);
2986 #ifdef VM_DEBUG
2987 if (vm_debug) {
2988 fputs(" n1=", vm_out); printarg_n(n1);
2989 fputs(" n2=", vm_out); printarg_n(n2);
2990 fputs(" n3=", vm_out); printarg_n(n3);
2991 }
2992 #endif
2993 sp += 1;
2994 {
2995 #line 743 "prim"
2996 n = n1+n3;
2997 #line 2998 "prim.i"
2998 }
2999 
3000 #ifdef VM_DEBUG
3001 if (vm_debug) {
3002 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
3003 fputc('\n', vm_out);
3004 }
3005 #endif
3006 NEXT_P1;
3007 vm_n2Cell(n,sp[1]);
3008 LABEL2(under_plus)
3009 NEXT_P1_5;
3010 LABEL3(under_plus)
3011 DO_GOTO;
3012 }
3013 
3014 LABEL(minus) /* - ( n1 n2 -- n ) S0 -- S0  */
3015 /*  */
3016 NAME("-")
3017 {
3018 DEF_CA
3019 MAYBE_UNUSED Cell n1;
3020 MAYBE_UNUSED Cell n2;
3021 Cell n;
3022 NEXT_P0;
3023 vm_Cell2n(sp[1],n1);
3024 vm_Cell2n(sp[0],n2);
3025 #ifdef VM_DEBUG
3026 if (vm_debug) {
3027 fputs(" n1=", vm_out); printarg_n(n1);
3028 fputs(" n2=", vm_out); printarg_n(n2);
3029 }
3030 #endif
3031 sp += 1;
3032 {
3033 #line 748 "prim"
3034 n = n1-n2;
3035 #line 3036 "prim.i"
3036 }
3037 
3038 #ifdef VM_DEBUG
3039 if (vm_debug) {
3040 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
3041 fputc('\n', vm_out);
3042 }
3043 #endif
3044 NEXT_P1;
3045 vm_n2Cell(n,sp[0]);
3046 LABEL2(minus)
3047 NEXT_P1_5;
3048 LABEL3(minus)
3049 DO_GOTO;
3050 }
3051 
3052 LABEL(negate) /* negate ( n1 -- n2 ) S0 -- S0  */
3053 /*  */
3054 NAME("negate")
3055 {
3056 DEF_CA
3057 MAYBE_UNUSED Cell n1;
3058 Cell n2;
3059 NEXT_P0;
3060 vm_Cell2n(sp[0],n1);
3061 #ifdef VM_DEBUG
3062 if (vm_debug) {
3063 fputs(" n1=", vm_out); printarg_n(n1);
3064 }
3065 #endif
3066 {
3067 #line 753 "prim"
3068 /* use minus as alias */
3069 n2 = -n1;
3070 #line 3071 "prim.i"
3071 }
3072 
3073 #ifdef VM_DEBUG
3074 if (vm_debug) {
3075 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
3076 fputc('\n', vm_out);
3077 }
3078 #endif
3079 NEXT_P1;
3080 vm_n2Cell(n2,sp[0]);
3081 LABEL2(negate)
3082 NEXT_P1_5;
3083 LABEL3(negate)
3084 DO_GOTO;
3085 }
3086 
3087 LABEL(one_plus) /* 1+ ( n1 -- n2 ) S0 -- S0  */
3088 /*  */
3089 NAME("1+")
3090 {
3091 DEF_CA
3092 MAYBE_UNUSED Cell n1;
3093 Cell n2;
3094 NEXT_P0;
3095 vm_Cell2n(sp[0],n1);
3096 #ifdef VM_DEBUG
3097 if (vm_debug) {
3098 fputs(" n1=", vm_out); printarg_n(n1);
3099 }
3100 #endif
3101 {
3102 #line 759 "prim"
3103 n2 = n1+1;
3104 #line 3105 "prim.i"
3105 }
3106 
3107 #ifdef VM_DEBUG
3108 if (vm_debug) {
3109 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
3110 fputc('\n', vm_out);
3111 }
3112 #endif
3113 NEXT_P1;
3114 vm_n2Cell(n2,sp[0]);
3115 LABEL2(one_plus)
3116 NEXT_P1_5;
3117 LABEL3(one_plus)
3118 DO_GOTO;
3119 }
3120 
3121 LABEL(one_minus) /* 1- ( n1 -- n2 ) S0 -- S0  */
3122 /*  */
3123 NAME("1-")
3124 {
3125 DEF_CA
3126 MAYBE_UNUSED Cell n1;
3127 Cell n2;
3128 NEXT_P0;
3129 vm_Cell2n(sp[0],n1);
3130 #ifdef VM_DEBUG
3131 if (vm_debug) {
3132 fputs(" n1=", vm_out); printarg_n(n1);
3133 }
3134 #endif
3135 {
3136 #line 764 "prim"
3137 n2 = n1-1;
3138 #line 3139 "prim.i"
3139 }
3140 
3141 #ifdef VM_DEBUG
3142 if (vm_debug) {
3143 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
3144 fputc('\n', vm_out);
3145 }
3146 #endif
3147 NEXT_P1;
3148 vm_n2Cell(n2,sp[0]);
3149 LABEL2(one_minus)
3150 NEXT_P1_5;
3151 LABEL3(one_minus)
3152 DO_GOTO;
3153 }
3154 
3155 LABEL(max) /* max ( n1 n2 -- n ) S0 -- S0  */
3156 /*  */
3157 NAME("max")
3158 {
3159 DEF_CA
3160 MAYBE_UNUSED Cell n1;
3161 MAYBE_UNUSED Cell n2;
3162 Cell n;
3163 NEXT_P0;
3164 vm_Cell2n(sp[1],n1);
3165 vm_Cell2n(sp[0],n2);
3166 #ifdef VM_DEBUG
3167 if (vm_debug) {
3168 fputs(" n1=", vm_out); printarg_n(n1);
3169 fputs(" n2=", vm_out); printarg_n(n2);
3170 }
3171 #endif
3172 sp += 1;
3173 {
3174 #line 769 "prim"
3175 if (n1<n2)
3176   n = n2;
3177 else
3178   n = n1;
3179 #line 3180 "prim.i"
3180 }
3181 
3182 #ifdef VM_DEBUG
3183 if (vm_debug) {
3184 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
3185 fputc('\n', vm_out);
3186 }
3187 #endif
3188 NEXT_P1;
3189 vm_n2Cell(n,sp[0]);
3190 LABEL2(max)
3191 NEXT_P1_5;
3192 LABEL3(max)
3193 DO_GOTO;
3194 }
3195 
3196 LABEL(min) /* min ( n1 n2 -- n ) S0 -- S0  */
3197 /*  */
3198 NAME("min")
3199 {
3200 DEF_CA
3201 MAYBE_UNUSED Cell n1;
3202 MAYBE_UNUSED Cell n2;
3203 Cell n;
3204 NEXT_P0;
3205 vm_Cell2n(sp[1],n1);
3206 vm_Cell2n(sp[0],n2);
3207 #ifdef VM_DEBUG
3208 if (vm_debug) {
3209 fputs(" n1=", vm_out); printarg_n(n1);
3210 fputs(" n2=", vm_out); printarg_n(n2);
3211 }
3212 #endif
3213 sp += 1;
3214 {
3215 #line 777 "prim"
3216 if (n1<n2)
3217   n = n1;
3218 else
3219   n = n2;
3220 #line 3221 "prim.i"
3221 }
3222 
3223 #ifdef VM_DEBUG
3224 if (vm_debug) {
3225 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
3226 fputc('\n', vm_out);
3227 }
3228 #endif
3229 NEXT_P1;
3230 vm_n2Cell(n,sp[0]);
3231 LABEL2(min)
3232 NEXT_P1_5;
3233 LABEL3(min)
3234 DO_GOTO;
3235 }
3236 
3237 LABEL(abs) /* abs ( n -- u ) S0 -- S0  */
3238 /*  */
3239 NAME("abs")
3240 {
3241 DEF_CA
3242 MAYBE_UNUSED Cell n;
3243 UCell u;
3244 NEXT_P0;
3245 vm_Cell2n(sp[0],n);
3246 #ifdef VM_DEBUG
3247 if (vm_debug) {
3248 fputs(" n=", vm_out); printarg_n(n);
3249 }
3250 #endif
3251 {
3252 #line 785 "prim"
3253 if (n<0)
3254   u = -n;
3255 else
3256   u = n;
3257 #line 3258 "prim.i"
3258 }
3259 
3260 #ifdef VM_DEBUG
3261 if (vm_debug) {
3262 fputs(" -- ", vm_out); fputs(" u=", vm_out); printarg_u(u);
3263 fputc('\n', vm_out);
3264 }
3265 #endif
3266 NEXT_P1;
3267 vm_u2Cell(u,sp[0]);
3268 LABEL2(abs)
3269 NEXT_P1_5;
3270 LABEL3(abs)
3271 DO_GOTO;
3272 }
3273 
3274 LABEL(star) /* * ( n1 n2 -- n ) S0 -- S0  */
3275 /*  */
3276 NAME("*")
3277 {
3278 DEF_CA
3279 MAYBE_UNUSED Cell n1;
3280 MAYBE_UNUSED Cell n2;
3281 Cell n;
3282 NEXT_P0;
3283 vm_Cell2n(sp[1],n1);
3284 vm_Cell2n(sp[0],n2);
3285 #ifdef VM_DEBUG
3286 if (vm_debug) {
3287 fputs(" n1=", vm_out); printarg_n(n1);
3288 fputs(" n2=", vm_out); printarg_n(n2);
3289 }
3290 #endif
3291 sp += 1;
3292 {
3293 #line 793 "prim"
3294 n = n1*n2;
3295 #line 3296 "prim.i"
3296 }
3297 
3298 #ifdef VM_DEBUG
3299 if (vm_debug) {
3300 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
3301 fputc('\n', vm_out);
3302 }
3303 #endif
3304 NEXT_P1;
3305 vm_n2Cell(n,sp[0]);
3306 LABEL2(star)
3307 NEXT_P1_5;
3308 LABEL3(star)
3309 DO_GOTO;
3310 }
3311 
3312 LABEL(slash) /* / ( n1 n2 -- n ) S0 -- S0  */
3313 /*  */
3314 NAME("/")
3315 {
3316 DEF_CA
3317 MAYBE_UNUSED Cell n1;
3318 MAYBE_UNUSED Cell n2;
3319 Cell n;
3320 NEXT_P0;
3321 vm_Cell2n(sp[1],n1);
3322 vm_Cell2n(sp[0],n2);
3323 #ifdef VM_DEBUG
3324 if (vm_debug) {
3325 fputs(" n1=", vm_out); printarg_n(n1);
3326 fputs(" n2=", vm_out); printarg_n(n2);
3327 }
3328 #endif
3329 sp += 1;
3330 {
3331 #line 798 "prim"
3332 n = n1/n2;
3333 if (CHECK_DIVISION_SW && n2 == 0)
3334   throw(BALL_DIVZERO);
3335 if (CHECK_DIVISION_SW && n2 == -1 && n1 == CELL_MIN)
3336   throw(BALL_RESULTRANGE);
3337 if (FLOORED_DIV && ((n1^n2) < 0) && (n1%n2 != 0))
3338   n--;
3339 #line 3340 "prim.i"
3340 }
3341 
3342 #ifdef VM_DEBUG
3343 if (vm_debug) {
3344 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
3345 fputc('\n', vm_out);
3346 }
3347 #endif
3348 NEXT_P1;
3349 vm_n2Cell(n,sp[0]);
3350 LABEL2(slash)
3351 NEXT_P1_5;
3352 LABEL3(slash)
3353 DO_GOTO;
3354 }
3355 
3356 LABEL(mod) /* mod ( n1 n2 -- n ) S0 -- S0  */
3357 /*  */
3358 NAME("mod")
3359 {
3360 DEF_CA
3361 MAYBE_UNUSED Cell n1;
3362 MAYBE_UNUSED Cell n2;
3363 Cell n;
3364 NEXT_P0;
3365 vm_Cell2n(sp[1],n1);
3366 vm_Cell2n(sp[0],n2);
3367 #ifdef VM_DEBUG
3368 if (vm_debug) {
3369 fputs(" n1=", vm_out); printarg_n(n1);
3370 fputs(" n2=", vm_out); printarg_n(n2);
3371 }
3372 #endif
3373 sp += 1;
3374 {
3375 #line 809 "prim"
3376 n = n1%n2;
3377 if (CHECK_DIVISION_SW && n2 == 0)
3378   throw(BALL_DIVZERO);
3379 if (CHECK_DIVISION_SW && n2 == -1 && n1 == CELL_MIN)
3380   throw(BALL_RESULTRANGE);
3381 if(FLOORED_DIV && ((n1^n2) < 0) && n!=0) n += n2;
3382 #line 3383 "prim.i"
3383 }
3384 
3385 #ifdef VM_DEBUG
3386 if (vm_debug) {
3387 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
3388 fputc('\n', vm_out);
3389 }
3390 #endif
3391 NEXT_P1;
3392 vm_n2Cell(n,sp[0]);
3393 LABEL2(mod)
3394 NEXT_P1_5;
3395 LABEL3(mod)
3396 DO_GOTO;
3397 }
3398 
3399 LABEL(slash_mod) /* /mod ( n1 n2 -- n3 n4 ) S0 -- S0  */
3400 /*  */
3401 NAME("/mod")
3402 {
3403 DEF_CA
3404 MAYBE_UNUSED Cell n1;
3405 MAYBE_UNUSED Cell n2;
3406 Cell n3;
3407 Cell n4;
3408 NEXT_P0;
3409 vm_Cell2n(sp[1],n1);
3410 vm_Cell2n(sp[0],n2);
3411 #ifdef VM_DEBUG
3412 if (vm_debug) {
3413 fputs(" n1=", vm_out); printarg_n(n1);
3414 fputs(" n2=", vm_out); printarg_n(n2);
3415 }
3416 #endif
3417 {
3418 #line 819 "prim"
3419 n4 = n1/n2;
3420 n3 = n1%n2; /* !! is this correct? look into C standard! */
3421 if (CHECK_DIVISION_SW && n2 == 0)
3422   throw(BALL_DIVZERO);
3423 if (CHECK_DIVISION_SW && n2 == -1 && n1 == CELL_MIN)
3424   throw(BALL_RESULTRANGE);
3425 if (FLOORED_DIV && ((n1^n2) < 0) && n3!=0) {
3426   n4--;
3427   n3+=n2;
3428 }
3429 #line 3430 "prim.i"
3430 }
3431 
3432 #ifdef VM_DEBUG
3433 if (vm_debug) {
3434 fputs(" -- ", vm_out); fputs(" n3=", vm_out); printarg_n(n3);
3435 fputs(" n4=", vm_out); printarg_n(n4);
3436 fputc('\n', vm_out);
3437 }
3438 #endif
3439 NEXT_P1;
3440 vm_n2Cell(n3,sp[1]);
3441 vm_n2Cell(n4,sp[0]);
3442 LABEL2(slash_mod)
3443 NEXT_P1_5;
3444 LABEL3(slash_mod)
3445 DO_GOTO;
3446 }
3447 
3448 LABEL(star_slash_mod) /* x/mod ( n1 n2 n3 -- n4 n5 ) S0 -- S0  */
3449 /* n1*n2=n3*n5+n4, with the intermediate result (n1*n2) being double. */
3450 NAME("*/mod")
3451 {
3452 DEF_CA
3453 MAYBE_UNUSED Cell n1;
3454 MAYBE_UNUSED Cell n2;
3455 MAYBE_UNUSED Cell n3;
3456 Cell n4;
3457 Cell n5;
3458 NEXT_P0;
3459 vm_Cell2n(sp[2],n1);
3460 vm_Cell2n(sp[1],n2);
3461 vm_Cell2n(sp[0],n3);
3462 #ifdef VM_DEBUG
3463 if (vm_debug) {
3464 fputs(" n1=", vm_out); printarg_n(n1);
3465 fputs(" n2=", vm_out); printarg_n(n2);
3466 fputs(" n3=", vm_out); printarg_n(n3);
3467 }
3468 #endif
3469 sp += 1;
3470 {
3471 #line 834 "prim"
3472 #ifdef BUGGY_LL_MUL
3473 DCell d = mmul(n1,n2);
3474 #else
3475 DCell d = (DCell)n1 * (DCell)n2;
3476 #endif
3477 #ifdef ASM_SM_SLASH_REM
3478 ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, n4, n5);
3479 if (FLOORED_DIV && ((DHI(d)^n3)<0) && n4!=0) {
3480   if (CHECK_DIVISION && n5 == CELL_MIN)
3481     throw(BALL_RESULTRANGE);
3482   n5--;
3483   n4+=n3;
3484 }
3485 #else
3486 DCell r = FLOORED_DIV ? fmdiv(d,n3) : smdiv(d,n3);
3487 n4=DHI(r);
3488 n5=DLO(r);
3489 #endif
3490 #line 3491 "prim.i"
3491 }
3492 
3493 #ifdef VM_DEBUG
3494 if (vm_debug) {
3495 fputs(" -- ", vm_out); fputs(" n4=", vm_out); printarg_n(n4);
3496 fputs(" n5=", vm_out); printarg_n(n5);
3497 fputc('\n', vm_out);
3498 }
3499 #endif
3500 NEXT_P1;
3501 vm_n2Cell(n4,sp[1]);
3502 vm_n2Cell(n5,sp[0]);
3503 LABEL2(star_slash_mod)
3504 NEXT_P1_5;
3505 LABEL3(star_slash_mod)
3506 DO_GOTO;
3507 }
3508 
3509 LABEL(star_slash) /* x/ ( n1 n2 n3 -- n4 ) S0 -- S0  */
3510 /* n4=(n1*n2)/n3, with the intermediate result being double. */
3511 NAME("*/")
3512 {
3513 DEF_CA
3514 MAYBE_UNUSED Cell n1;
3515 MAYBE_UNUSED Cell n2;
3516 MAYBE_UNUSED Cell n3;
3517 Cell n4;
3518 NEXT_P0;
3519 vm_Cell2n(sp[2],n1);
3520 vm_Cell2n(sp[1],n2);
3521 vm_Cell2n(sp[0],n3);
3522 #ifdef VM_DEBUG
3523 if (vm_debug) {
3524 fputs(" n1=", vm_out); printarg_n(n1);
3525 fputs(" n2=", vm_out); printarg_n(n2);
3526 fputs(" n3=", vm_out); printarg_n(n3);
3527 }
3528 #endif
3529 sp += 2;
3530 {
3531 #line 857 "prim"
3532 #ifdef BUGGY_LL_MUL
3533 DCell d = mmul(n1,n2);
3534 #else
3535 DCell d = (DCell)n1 * (DCell)n2;
3536 #endif
3537 #ifdef ASM_SM_SLASH_REM
3538 Cell remainder;
3539 ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, remainder, n4);
3540 if (FLOORED_DIV && ((DHI(d)^n3)<0) && remainder!=0) {
3541   if (CHECK_DIVISION && n4 == CELL_MIN)
3542     throw(BALL_RESULTRANGE);
3543   n4--;
3544 }
3545 #else
3546 DCell r = FLOORED_DIV ? fmdiv(d,n3) : smdiv(d,n3);
3547 n4=DLO(r);
3548 #endif
3549 #line 3550 "prim.i"
3550 }
3551 
3552 #ifdef VM_DEBUG
3553 if (vm_debug) {
3554 fputs(" -- ", vm_out); fputs(" n4=", vm_out); printarg_n(n4);
3555 fputc('\n', vm_out);
3556 }
3557 #endif
3558 NEXT_P1;
3559 vm_n2Cell(n4,sp[0]);
3560 LABEL2(star_slash)
3561 NEXT_P1_5;
3562 LABEL3(star_slash)
3563 DO_GOTO;
3564 }
3565 
3566 LABEL(two_star) /* 2* ( n1 -- n2 ) S0 -- S0  */
3567 /* Shift left by 1; also works on unsigned numbers */
3568 NAME("2*")
3569 {
3570 DEF_CA
3571 MAYBE_UNUSED Cell n1;
3572 Cell n2;
3573 NEXT_P0;
3574 vm_Cell2n(sp[0],n1);
3575 #ifdef VM_DEBUG
3576 if (vm_debug) {
3577 fputs(" n1=", vm_out); printarg_n(n1);
3578 }
3579 #endif
3580 {
3581 #line 879 "prim"
3582 n2 = 2*n1;
3583 #line 3584 "prim.i"
3584 }
3585 
3586 #ifdef VM_DEBUG
3587 if (vm_debug) {
3588 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
3589 fputc('\n', vm_out);
3590 }
3591 #endif
3592 NEXT_P1;
3593 vm_n2Cell(n2,sp[0]);
3594 LABEL2(two_star)
3595 NEXT_P1_5;
3596 LABEL3(two_star)
3597 DO_GOTO;
3598 }
3599 
3600 LABEL(two_slash) /* 2/ ( n1 -- n2 ) S0 -- S0  */
3601 /* Arithmetic shift right by 1.  For signed numbers this is a floored
3602 division by 2 (note that @code{/} not necessarily floors). */
3603 NAME("2/")
3604 {
3605 DEF_CA
3606 MAYBE_UNUSED Cell n1;
3607 Cell n2;
3608 NEXT_P0;
3609 vm_Cell2n(sp[0],n1);
3610 #ifdef VM_DEBUG
3611 if (vm_debug) {
3612 fputs(" n1=", vm_out); printarg_n(n1);
3613 }
3614 #endif
3615 {
3616 #line 886 "prim"
3617 n2 = n1>>1;
3618 #line 3619 "prim.i"
3619 }
3620 
3621 #ifdef VM_DEBUG
3622 if (vm_debug) {
3623 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
3624 fputc('\n', vm_out);
3625 }
3626 #endif
3627 NEXT_P1;
3628 vm_n2Cell(n2,sp[0]);
3629 LABEL2(two_slash)
3630 NEXT_P1_5;
3631 LABEL3(two_slash)
3632 DO_GOTO;
3633 }
3634 
3635 LABEL(f_m_slash_mod) /* fm/mod ( d1 n1 -- n2 n3 ) S0 -- S0  */
3636 /* Floored division: @i{d1} = @i{n3}*@i{n1}+@i{n2}, @i{n1}>@i{n2}>=0 or 0>=@i{n2}>@i{n1}. */
3637 NAME("fm/mod")
3638 {
3639 DEF_CA
3640 MAYBE_UNUSED DCell d1;
3641 MAYBE_UNUSED Cell n1;
3642 Cell n2;
3643 Cell n3;
3644 NEXT_P0;
3645 vm_twoCell2d(sp[2], sp[1], d1)
3646 vm_Cell2n(sp[0],n1);
3647 #ifdef VM_DEBUG
3648 if (vm_debug) {
3649 fputs(" d1=", vm_out); printarg_d(d1);
3650 fputs(" n1=", vm_out); printarg_n(n1);
3651 }
3652 #endif
3653 sp += 1;
3654 {
3655 #line 896 "prim"
3656 #ifdef ASM_SM_SLASH_REM
3657 ASM_SM_SLASH_REM(DLO(d1), DHI(d1), n1, n2, n3);
3658 if (((DHI(d1)^n1)<0) && n2!=0) {
3659   if (CHECK_DIVISION && n3 == CELL_MIN)
3660     throw(BALL_RESULTRANGE);
3661   n3--;
3662   n2+=n1;
3663 }
3664 #else /* !defined(ASM_SM_SLASH_REM) */
3665 DCell r = fmdiv(d1,n1);
3666 n2=DHI(r);
3667 n3=DLO(r);
3668 #endif /* !defined(ASM_SM_SLASH_REM) */
3669 #line 3670 "prim.i"
3670 }
3671 
3672 #ifdef VM_DEBUG
3673 if (vm_debug) {
3674 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
3675 fputs(" n3=", vm_out); printarg_n(n3);
3676 fputc('\n', vm_out);
3677 }
3678 #endif
3679 NEXT_P1;
3680 vm_n2Cell(n2,sp[1]);
3681 vm_n2Cell(n3,sp[0]);
3682 LABEL2(f_m_slash_mod)
3683 NEXT_P1_5;
3684 LABEL3(f_m_slash_mod)
3685 DO_GOTO;
3686 }
3687 
3688 LABEL(s_m_slash_rem) /* sm/rem ( d1 n1 -- n2 n3 ) S0 -- S0  */
3689 /* Symmetric division: @i{d1} = @i{n3}*@i{n1}+@i{n2}, sign(@i{n2})=sign(@i{d1}) or 0. */
3690 NAME("sm/rem")
3691 {
3692 DEF_CA
3693 MAYBE_UNUSED DCell d1;
3694 MAYBE_UNUSED Cell n1;
3695 Cell n2;
3696 Cell n3;
3697 NEXT_P0;
3698 vm_twoCell2d(sp[2], sp[1], d1)
3699 vm_Cell2n(sp[0],n1);
3700 #ifdef VM_DEBUG
3701 if (vm_debug) {
3702 fputs(" d1=", vm_out); printarg_d(d1);
3703 fputs(" n1=", vm_out); printarg_n(n1);
3704 }
3705 #endif
3706 sp += 1;
3707 {
3708 #line 917 "prim"
3709 #ifdef ASM_SM_SLASH_REM
3710 ASM_SM_SLASH_REM(DLO(d1), DHI(d1), n1, n2, n3);
3711 #else /* !defined(ASM_SM_SLASH_REM) */
3712 DCell r = smdiv(d1,n1);
3713 n2=DHI(r);
3714 n3=DLO(r);
3715 #endif /* !defined(ASM_SM_SLASH_REM) */
3716 #line 3717 "prim.i"
3717 }
3718 
3719 #ifdef VM_DEBUG
3720 if (vm_debug) {
3721 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
3722 fputs(" n3=", vm_out); printarg_n(n3);
3723 fputc('\n', vm_out);
3724 }
3725 #endif
3726 NEXT_P1;
3727 vm_n2Cell(n2,sp[1]);
3728 vm_n2Cell(n3,sp[0]);
3729 LABEL2(s_m_slash_rem)
3730 NEXT_P1_5;
3731 LABEL3(s_m_slash_rem)
3732 DO_GOTO;
3733 }
3734 
3735 LABEL(m_star) /* m* ( n1 n2 -- d ) S0 -- S0  */
3736 /*  */
3737 NAME("m*")
3738 {
3739 DEF_CA
3740 MAYBE_UNUSED Cell n1;
3741 MAYBE_UNUSED Cell n2;
3742 DCell d;
3743 NEXT_P0;
3744 vm_Cell2n(sp[1],n1);
3745 vm_Cell2n(sp[0],n2);
3746 #ifdef VM_DEBUG
3747 if (vm_debug) {
3748 fputs(" n1=", vm_out); printarg_n(n1);
3749 fputs(" n2=", vm_out); printarg_n(n2);
3750 }
3751 #endif
3752 {
3753 #line 931 "prim"
3754 #ifdef BUGGY_LL_MUL
3755 d = mmul(n1,n2);
3756 #else
3757 d = (DCell)n1 * (DCell)n2;
3758 #endif
3759 #line 3760 "prim.i"
3760 }
3761 
3762 #ifdef VM_DEBUG
3763 if (vm_debug) {
3764 fputs(" -- ", vm_out); fputs(" d=", vm_out); printarg_d(d);
3765 fputc('\n', vm_out);
3766 }
3767 #endif
3768 NEXT_P1;
3769 vm_d2twoCell(d, sp[1], sp[0])
3770 LABEL2(m_star)
3771 NEXT_P1_5;
3772 LABEL3(m_star)
3773 DO_GOTO;
3774 }
3775 
3776 LABEL(u_m_star) /* um* ( u1 u2 -- ud ) S0 -- S0  */
3777 /*  */
3778 NAME("um*")
3779 {
3780 DEF_CA
3781 MAYBE_UNUSED UCell u1;
3782 MAYBE_UNUSED UCell u2;
3783 UDCell ud;
3784 NEXT_P0;
3785 vm_Cell2u(sp[1],u1);
3786 vm_Cell2u(sp[0],u2);
3787 #ifdef VM_DEBUG
3788 if (vm_debug) {
3789 fputs(" u1=", vm_out); printarg_u(u1);
3790 fputs(" u2=", vm_out); printarg_u(u2);
3791 }
3792 #endif
3793 {
3794 #line 942 "prim"
3795 /* use u* as alias */
3796 #ifdef BUGGY_LL_MUL
3797 ud = ummul(u1,u2);
3798 #else
3799 ud = (UDCell)u1 * (UDCell)u2;
3800 #endif
3801 #line 3802 "prim.i"
3802 }
3803 
3804 #ifdef VM_DEBUG
3805 if (vm_debug) {
3806 fputs(" -- ", vm_out); fputs(" ud=", vm_out); printarg_ud(ud);
3807 fputc('\n', vm_out);
3808 }
3809 #endif
3810 NEXT_P1;
3811 vm_ud2twoCell(ud, sp[1], sp[0])
3812 LABEL2(u_m_star)
3813 NEXT_P1_5;
3814 LABEL3(u_m_star)
3815 DO_GOTO;
3816 }
3817 
3818 LABEL(u_m_slash_mod) /* um/mod ( ud u1 -- u2 u3 ) S0 -- S0  */
3819 /* ud=u3*u1+u2, u1>u2>=0 */
3820 NAME("um/mod")
3821 {
3822 DEF_CA
3823 MAYBE_UNUSED UDCell ud;
3824 MAYBE_UNUSED UCell u1;
3825 UCell u2;
3826 UCell u3;
3827 NEXT_P0;
3828 vm_twoCell2ud(sp[2], sp[1], ud)
3829 vm_Cell2u(sp[0],u1);
3830 #ifdef VM_DEBUG
3831 if (vm_debug) {
3832 fputs(" ud=", vm_out); printarg_ud(ud);
3833 fputs(" u1=", vm_out); printarg_u(u1);
3834 }
3835 #endif
3836 sp += 1;
3837 {
3838 #line 959 "prim"
3839 #ifdef ASM_UM_SLASH_MOD
3840 ASM_UM_SLASH_MOD(DLO(ud), DHI(ud), u1, u2, u3);
3841 #else /* !defined(ASM_UM_SLASH_MOD) */
3842 UDCell r = umdiv(ud,u1);
3843 u2=DHI(r);
3844 u3=DLO(r);
3845 #endif /* !defined(ASM_UM_SLASH_MOD) */
3846 #line 3847 "prim.i"
3847 }
3848 
3849 #ifdef VM_DEBUG
3850 if (vm_debug) {
3851 fputs(" -- ", vm_out); fputs(" u2=", vm_out); printarg_u(u2);
3852 fputs(" u3=", vm_out); printarg_u(u3);
3853 fputc('\n', vm_out);
3854 }
3855 #endif
3856 NEXT_P1;
3857 vm_u2Cell(u2,sp[1]);
3858 vm_u2Cell(u3,sp[0]);
3859 LABEL2(u_m_slash_mod)
3860 NEXT_P1_5;
3861 LABEL3(u_m_slash_mod)
3862 DO_GOTO;
3863 }
3864 
3865 LABEL(m_plus) /* m+ ( d1 n -- d2 ) S0 -- S0  */
3866 /*  */
3867 NAME("m+")
3868 {
3869 DEF_CA
3870 MAYBE_UNUSED DCell d1;
3871 MAYBE_UNUSED Cell n;
3872 DCell d2;
3873 NEXT_P0;
3874 vm_twoCell2d(sp[2], sp[1], d1)
3875 vm_Cell2n(sp[0],n);
3876 #ifdef VM_DEBUG
3877 if (vm_debug) {
3878 fputs(" d1=", vm_out); printarg_d(d1);
3879 fputs(" n=", vm_out); printarg_n(n);
3880 }
3881 #endif
3882 sp += 1;
3883 {
3884 #line 977 "prim"
3885 #ifdef BUGGY_LL_ADD
3886 DLO_IS(d2, DLO(d1)+n);
3887 DHI_IS(d2, DHI(d1) - (n<0) + (DLO(d2)<DLO(d1)));
3888 #else
3889 d2 = d1+n;
3890 #endif
3891 #line 3892 "prim.i"
3892 }
3893 
3894 #ifdef VM_DEBUG
3895 if (vm_debug) {
3896 fputs(" -- ", vm_out); fputs(" d2=", vm_out); printarg_d(d2);
3897 fputc('\n', vm_out);
3898 }
3899 #endif
3900 NEXT_P1;
3901 vm_d2twoCell(d2, sp[1], sp[0])
3902 LABEL2(m_plus)
3903 NEXT_P1_5;
3904 LABEL3(m_plus)
3905 DO_GOTO;
3906 }
3907 
3908 LABEL(d_plus) /* d+ ( d1 d2 -- d ) S0 -- S0  */
3909 /*  */
3910 NAME("d+")
3911 {
3912 DEF_CA
3913 MAYBE_UNUSED DCell d1;
3914 MAYBE_UNUSED DCell d2;
3915 DCell d;
3916 NEXT_P0;
3917 vm_twoCell2d(sp[3], sp[2], d1)
3918 vm_twoCell2d(sp[1], sp[0], d2)
3919 #ifdef VM_DEBUG
3920 if (vm_debug) {
3921 fputs(" d1=", vm_out); printarg_d(d1);
3922 fputs(" d2=", vm_out); printarg_d(d2);
3923 }
3924 #endif
3925 sp += 2;
3926 {
3927 #line 987 "prim"
3928 #ifdef BUGGY_LL_ADD
3929 DLO_IS(d, DLO(d1) + DLO(d2));
3930 DHI_IS(d, DHI(d1) + DHI(d2) + (d.lo<DLO(d1)));
3931 #else
3932 d = d1+d2;
3933 #endif
3934 #line 3935 "prim.i"
3935 }
3936 
3937 #ifdef VM_DEBUG
3938 if (vm_debug) {
3939 fputs(" -- ", vm_out); fputs(" d=", vm_out); printarg_d(d);
3940 fputc('\n', vm_out);
3941 }
3942 #endif
3943 NEXT_P1;
3944 vm_d2twoCell(d, sp[1], sp[0])
3945 LABEL2(d_plus)
3946 NEXT_P1_5;
3947 LABEL3(d_plus)
3948 DO_GOTO;
3949 }
3950 
3951 LABEL(d_minus) /* d- ( d1 d2 -- d ) S0 -- S0  */
3952 /*  */
3953 NAME("d-")
3954 {
3955 DEF_CA
3956 MAYBE_UNUSED DCell d1;
3957 MAYBE_UNUSED DCell d2;
3958 DCell d;
3959 NEXT_P0;
3960 vm_twoCell2d(sp[3], sp[2], d1)
3961 vm_twoCell2d(sp[1], sp[0], d2)
3962 #ifdef VM_DEBUG
3963 if (vm_debug) {
3964 fputs(" d1=", vm_out); printarg_d(d1);
3965 fputs(" d2=", vm_out); printarg_d(d2);
3966 }
3967 #endif
3968 sp += 2;
3969 {
3970 #line 997 "prim"
3971 #ifdef BUGGY_LL_ADD
3972 DLO_IS(d, DLO(d1) - DLO(d2));
3973 DHI_IS(d, DHI(d1)-DHI(d2)-(DLO(d1)<DLO(d2)));
3974 #else
3975 d = d1-d2;
3976 #endif
3977 #line 3978 "prim.i"
3978 }
3979 
3980 #ifdef VM_DEBUG
3981 if (vm_debug) {
3982 fputs(" -- ", vm_out); fputs(" d=", vm_out); printarg_d(d);
3983 fputc('\n', vm_out);
3984 }
3985 #endif
3986 NEXT_P1;
3987 vm_d2twoCell(d, sp[1], sp[0])
3988 LABEL2(d_minus)
3989 NEXT_P1_5;
3990 LABEL3(d_minus)
3991 DO_GOTO;
3992 }
3993 
3994 LABEL(d_negate) /* dnegate ( d1 -- d2 ) S0 -- S0  */
3995 /*  */
3996 NAME("dnegate")
3997 {
3998 DEF_CA
3999 MAYBE_UNUSED DCell d1;
4000 DCell d2;
4001 NEXT_P0;
4002 vm_twoCell2d(sp[1], sp[0], d1)
4003 #ifdef VM_DEBUG
4004 if (vm_debug) {
4005 fputs(" d1=", vm_out); printarg_d(d1);
4006 }
4007 #endif
4008 {
4009 #line 1007 "prim"
4010 /* use dminus as alias */
4011 #ifdef BUGGY_LL_ADD
4012 d2 = dnegate(d1);
4013 #else
4014 d2 = -d1;
4015 #endif
4016 #line 4017 "prim.i"
4017 }
4018 
4019 #ifdef VM_DEBUG
4020 if (vm_debug) {
4021 fputs(" -- ", vm_out); fputs(" d2=", vm_out); printarg_d(d2);
4022 fputc('\n', vm_out);
4023 }
4024 #endif
4025 NEXT_P1;
4026 vm_d2twoCell(d2, sp[1], sp[0])
4027 LABEL2(d_negate)
4028 NEXT_P1_5;
4029 LABEL3(d_negate)
4030 DO_GOTO;
4031 }
4032 
4033 LABEL(d_two_star) /* d2* ( d1 -- d2 ) S0 -- S0  */
4034 /* Shift left by 1; also works on unsigned numbers */
4035 NAME("d2*")
4036 {
4037 DEF_CA
4038 MAYBE_UNUSED DCell d1;
4039 DCell d2;
4040 NEXT_P0;
4041 vm_twoCell2d(sp[1], sp[0], d1)
4042 #ifdef VM_DEBUG
4043 if (vm_debug) {
4044 fputs(" d1=", vm_out); printarg_d(d1);
4045 }
4046 #endif
4047 {
4048 #line 1018 "prim"
4049 d2 = DLSHIFT(d1,1);
4050 #line 4051 "prim.i"
4051 }
4052 
4053 #ifdef VM_DEBUG
4054 if (vm_debug) {
4055 fputs(" -- ", vm_out); fputs(" d2=", vm_out); printarg_d(d2);
4056 fputc('\n', vm_out);
4057 }
4058 #endif
4059 NEXT_P1;
4060 vm_d2twoCell(d2, sp[1], sp[0])
4061 LABEL2(d_two_star)
4062 NEXT_P1_5;
4063 LABEL3(d_two_star)
4064 DO_GOTO;
4065 }
4066 
4067 LABEL(d_two_slash) /* d2/ ( d1 -- d2 ) S0 -- S0  */
4068 /* Arithmetic shift right by 1.  For signed numbers this is a floored
4069 division by 2. */
4070 NAME("d2/")
4071 {
4072 DEF_CA
4073 MAYBE_UNUSED DCell d1;
4074 DCell d2;
4075 NEXT_P0;
4076 vm_twoCell2d(sp[1], sp[0], d1)
4077 #ifdef VM_DEBUG
4078 if (vm_debug) {
4079 fputs(" d1=", vm_out); printarg_d(d1);
4080 }
4081 #endif
4082 {
4083 #line 1025 "prim"
4084 #ifdef BUGGY_LL_SHIFT
4085 DHI_IS(d2, DHI(d1)>>1);
4086 DLO_IS(d2, (DLO(d1)>>1) | (DHI(d1)<<(CELL_BITS-1)));
4087 #else
4088 d2 = d1>>1;
4089 #endif
4090 #line 4091 "prim.i"
4091 }
4092 
4093 #ifdef VM_DEBUG
4094 if (vm_debug) {
4095 fputs(" -- ", vm_out); fputs(" d2=", vm_out); printarg_d(d2);
4096 fputc('\n', vm_out);
4097 }
4098 #endif
4099 NEXT_P1;
4100 vm_d2twoCell(d2, sp[1], sp[0])
4101 LABEL2(d_two_slash)
4102 NEXT_P1_5;
4103 LABEL3(d_two_slash)
4104 DO_GOTO;
4105 }
4106 
4107 LABEL(and) /* and ( w1 w2 -- w ) S0 -- S0  */
4108 /*  */
4109 NAME("and")
4110 {
4111 DEF_CA
4112 MAYBE_UNUSED Cell w1;
4113 MAYBE_UNUSED Cell w2;
4114 Cell w;
4115 NEXT_P0;
4116 vm_Cell2w(sp[1],w1);
4117 vm_Cell2w(sp[0],w2);
4118 #ifdef VM_DEBUG
4119 if (vm_debug) {
4120 fputs(" w1=", vm_out); printarg_w(w1);
4121 fputs(" w2=", vm_out); printarg_w(w2);
4122 }
4123 #endif
4124 sp += 1;
4125 {
4126 #line 1036 "prim"
4127 w = w1&w2;
4128 #line 4129 "prim.i"
4129 }
4130 
4131 #ifdef VM_DEBUG
4132 if (vm_debug) {
4133 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
4134 fputc('\n', vm_out);
4135 }
4136 #endif
4137 NEXT_P1;
4138 vm_w2Cell(w,sp[0]);
4139 LABEL2(and)
4140 NEXT_P1_5;
4141 LABEL3(and)
4142 DO_GOTO;
4143 }
4144 
4145 LABEL(or) /* or ( w1 w2 -- w ) S0 -- S0  */
4146 /*  */
4147 NAME("or")
4148 {
4149 DEF_CA
4150 MAYBE_UNUSED Cell w1;
4151 MAYBE_UNUSED Cell w2;
4152 Cell w;
4153 NEXT_P0;
4154 vm_Cell2w(sp[1],w1);
4155 vm_Cell2w(sp[0],w2);
4156 #ifdef VM_DEBUG
4157 if (vm_debug) {
4158 fputs(" w1=", vm_out); printarg_w(w1);
4159 fputs(" w2=", vm_out); printarg_w(w2);
4160 }
4161 #endif
4162 sp += 1;
4163 {
4164 #line 1039 "prim"
4165 w = w1|w2;
4166 #line 4167 "prim.i"
4167 }
4168 
4169 #ifdef VM_DEBUG
4170 if (vm_debug) {
4171 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
4172 fputc('\n', vm_out);
4173 }
4174 #endif
4175 NEXT_P1;
4176 vm_w2Cell(w,sp[0]);
4177 LABEL2(or)
4178 NEXT_P1_5;
4179 LABEL3(or)
4180 DO_GOTO;
4181 }
4182 
4183 LABEL(x_or) /* xor ( w1 w2 -- w ) S0 -- S0  */
4184 /*  */
4185 NAME("xor")
4186 {
4187 DEF_CA
4188 MAYBE_UNUSED Cell w1;
4189 MAYBE_UNUSED Cell w2;
4190 Cell w;
4191 NEXT_P0;
4192 vm_Cell2w(sp[1],w1);
4193 vm_Cell2w(sp[0],w2);
4194 #ifdef VM_DEBUG
4195 if (vm_debug) {
4196 fputs(" w1=", vm_out); printarg_w(w1);
4197 fputs(" w2=", vm_out); printarg_w(w2);
4198 }
4199 #endif
4200 sp += 1;
4201 {
4202 #line 1044 "prim"
4203 w = w1^w2;
4204 #line 4205 "prim.i"
4205 }
4206 
4207 #ifdef VM_DEBUG
4208 if (vm_debug) {
4209 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
4210 fputc('\n', vm_out);
4211 }
4212 #endif
4213 NEXT_P1;
4214 vm_w2Cell(w,sp[0]);
4215 LABEL2(x_or)
4216 NEXT_P1_5;
4217 LABEL3(x_or)
4218 DO_GOTO;
4219 }
4220 
4221 LABEL(invert) /* invert ( w1 -- w2 ) S0 -- S0  */
4222 /*  */
4223 NAME("invert")
4224 {
4225 DEF_CA
4226 MAYBE_UNUSED Cell w1;
4227 Cell w2;
4228 NEXT_P0;
4229 vm_Cell2w(sp[0],w1);
4230 #ifdef VM_DEBUG
4231 if (vm_debug) {
4232 fputs(" w1=", vm_out); printarg_w(w1);
4233 }
4234 #endif
4235 {
4236 #line 1047 "prim"
4237 w2 = ~w1;
4238 #line 4239 "prim.i"
4239 }
4240 
4241 #ifdef VM_DEBUG
4242 if (vm_debug) {
4243 fputs(" -- ", vm_out); fputs(" w2=", vm_out); printarg_w(w2);
4244 fputc('\n', vm_out);
4245 }
4246 #endif
4247 NEXT_P1;
4248 vm_w2Cell(w2,sp[0]);
4249 LABEL2(invert)
4250 NEXT_P1_5;
4251 LABEL3(invert)
4252 DO_GOTO;
4253 }
4254 
4255 LABEL(r_shift) /* rshift ( u1 n -- u2 ) S0 -- S0  */
4256 /* Logical shift right by @i{n} bits. */
4257 NAME("rshift")
4258 {
4259 DEF_CA
4260 MAYBE_UNUSED UCell u1;
4261 MAYBE_UNUSED Cell n;
4262 UCell u2;
4263 NEXT_P0;
4264 vm_Cell2u(sp[1],u1);
4265 vm_Cell2n(sp[0],n);
4266 #ifdef VM_DEBUG
4267 if (vm_debug) {
4268 fputs(" u1=", vm_out); printarg_u(u1);
4269 fputs(" n=", vm_out); printarg_n(n);
4270 }
4271 #endif
4272 sp += 1;
4273 {
4274 #line 1053 "prim"
4275 #ifdef BROKEN_SHIFT
4276   u2 = rshift(u1, n);
4277 #else
4278   u2 = u1 >> n;
4279 #endif
4280 #line 4281 "prim.i"
4281 }
4282 
4283 #ifdef VM_DEBUG
4284 if (vm_debug) {
4285 fputs(" -- ", vm_out); fputs(" u2=", vm_out); printarg_u(u2);
4286 fputc('\n', vm_out);
4287 }
4288 #endif
4289 NEXT_P1;
4290 vm_u2Cell(u2,sp[0]);
4291 LABEL2(r_shift)
4292 NEXT_P1_5;
4293 LABEL3(r_shift)
4294 DO_GOTO;
4295 }
4296 
4297 LABEL(l_shift) /* lshift ( u1 n -- u2 ) S0 -- S0  */
4298 /*  */
4299 NAME("lshift")
4300 {
4301 DEF_CA
4302 MAYBE_UNUSED UCell u1;
4303 MAYBE_UNUSED Cell n;
4304 UCell u2;
4305 NEXT_P0;
4306 vm_Cell2u(sp[1],u1);
4307 vm_Cell2n(sp[0],n);
4308 #ifdef VM_DEBUG
4309 if (vm_debug) {
4310 fputs(" u1=", vm_out); printarg_u(u1);
4311 fputs(" n=", vm_out); printarg_n(n);
4312 }
4313 #endif
4314 sp += 1;
4315 {
4316 #line 1062 "prim"
4317 #ifdef BROKEN_SHIFT
4318   u2 = lshift(u1, n);
4319 #else
4320   u2 = u1 << n;
4321 #endif
4322 #line 4323 "prim.i"
4323 }
4324 
4325 #ifdef VM_DEBUG
4326 if (vm_debug) {
4327 fputs(" -- ", vm_out); fputs(" u2=", vm_out); printarg_u(u2);
4328 fputc('\n', vm_out);
4329 }
4330 #endif
4331 NEXT_P1;
4332 vm_u2Cell(u2,sp[0]);
4333 LABEL2(l_shift)
4334 NEXT_P1_5;
4335 LABEL3(l_shift)
4336 DO_GOTO;
4337 }
4338 
4339 GROUPADD(36)
4340 GROUP( compare, 88)
LABEL(zero_equals)4341 LABEL(zero_equals) /* 0= ( n -- f ) S0 -- S0  */
4342 /*  */
4343 NAME("0=")
4344 {
4345 DEF_CA
4346 MAYBE_UNUSED Cell n;
4347 Bool f;
4348 NEXT_P0;
4349 vm_Cell2n(sp[0],n);
4350 #ifdef VM_DEBUG
4351 if (vm_debug) {
4352 fputs(" n=", vm_out); printarg_n(n);
4353 }
4354 #endif
4355 {
4356 #line 1123 "prim"
4357 f = FLAG(n==0);
4358 #line 1122
4359 #line 4360 "prim.i"
4360 }
4361 
4362 #ifdef VM_DEBUG
4363 if (vm_debug) {
4364 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4365 fputc('\n', vm_out);
4366 }
4367 #endif
4368 NEXT_P1;
4369 vm_f2Cell(f,sp[0]);
4370 LABEL2(zero_equals)
4371 NEXT_P1_5;
4372 LABEL3(zero_equals)
4373 DO_GOTO;
4374 }
4375 
4376 LABEL(zero_not_equals) /* 0<> ( n -- f ) S0 -- S0  */
4377 /*  */
4378 NAME("0<>")
4379 {
4380 DEF_CA
4381 MAYBE_UNUSED Cell n;
4382 Bool f;
4383 NEXT_P0;
4384 vm_Cell2n(sp[0],n);
4385 #ifdef VM_DEBUG
4386 if (vm_debug) {
4387 fputs(" n=", vm_out); printarg_n(n);
4388 }
4389 #endif
4390 {
4391 #line 1123 "prim"
4392 f = FLAG(n!=0);
4393 #line 1122
4394 #line 4395 "prim.i"
4395 }
4396 
4397 #ifdef VM_DEBUG
4398 if (vm_debug) {
4399 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4400 fputc('\n', vm_out);
4401 }
4402 #endif
4403 NEXT_P1;
4404 vm_f2Cell(f,sp[0]);
4405 LABEL2(zero_not_equals)
4406 NEXT_P1_5;
4407 LABEL3(zero_not_equals)
4408 DO_GOTO;
4409 }
4410 
4411 LABEL(zero_less_than) /* 0< ( n -- f ) S0 -- S0  */
4412 /*  */
4413 NAME("0<")
4414 {
4415 DEF_CA
4416 MAYBE_UNUSED Cell n;
4417 Bool f;
4418 NEXT_P0;
4419 vm_Cell2n(sp[0],n);
4420 #ifdef VM_DEBUG
4421 if (vm_debug) {
4422 fputs(" n=", vm_out); printarg_n(n);
4423 }
4424 #endif
4425 {
4426 #line 1123 "prim"
4427 f = FLAG(n<0);
4428 #line 1122
4429 #line 4430 "prim.i"
4430 }
4431 
4432 #ifdef VM_DEBUG
4433 if (vm_debug) {
4434 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4435 fputc('\n', vm_out);
4436 }
4437 #endif
4438 NEXT_P1;
4439 vm_f2Cell(f,sp[0]);
4440 LABEL2(zero_less_than)
4441 NEXT_P1_5;
4442 LABEL3(zero_less_than)
4443 DO_GOTO;
4444 }
4445 
4446 LABEL(zero_greater_than) /* 0> ( n -- f ) S0 -- S0  */
4447 /*  */
4448 NAME("0>")
4449 {
4450 DEF_CA
4451 MAYBE_UNUSED Cell n;
4452 Bool f;
4453 NEXT_P0;
4454 vm_Cell2n(sp[0],n);
4455 #ifdef VM_DEBUG
4456 if (vm_debug) {
4457 fputs(" n=", vm_out); printarg_n(n);
4458 }
4459 #endif
4460 {
4461 #line 1123 "prim"
4462 f = FLAG(n>0);
4463 #line 1122
4464 #line 4465 "prim.i"
4465 }
4466 
4467 #ifdef VM_DEBUG
4468 if (vm_debug) {
4469 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4470 fputc('\n', vm_out);
4471 }
4472 #endif
4473 NEXT_P1;
4474 vm_f2Cell(f,sp[0]);
4475 LABEL2(zero_greater_than)
4476 NEXT_P1_5;
4477 LABEL3(zero_greater_than)
4478 DO_GOTO;
4479 }
4480 
4481 LABEL(zero_less_or_equal) /* 0<= ( n -- f ) S0 -- S0  */
4482 /*  */
4483 NAME("0<=")
4484 {
4485 DEF_CA
4486 MAYBE_UNUSED Cell n;
4487 Bool f;
4488 NEXT_P0;
4489 vm_Cell2n(sp[0],n);
4490 #ifdef VM_DEBUG
4491 if (vm_debug) {
4492 fputs(" n=", vm_out); printarg_n(n);
4493 }
4494 #endif
4495 {
4496 #line 1123 "prim"
4497 f = FLAG(n<=0);
4498 #line 1122
4499 #line 4500 "prim.i"
4500 }
4501 
4502 #ifdef VM_DEBUG
4503 if (vm_debug) {
4504 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4505 fputc('\n', vm_out);
4506 }
4507 #endif
4508 NEXT_P1;
4509 vm_f2Cell(f,sp[0]);
4510 LABEL2(zero_less_or_equal)
4511 NEXT_P1_5;
4512 LABEL3(zero_less_or_equal)
4513 DO_GOTO;
4514 }
4515 
4516 LABEL(zero_greater_or_equal) /* 0>= ( n -- f ) S0 -- S0  */
4517 /*  */
4518 NAME("0>=")
4519 {
4520 DEF_CA
4521 MAYBE_UNUSED Cell n;
4522 Bool f;
4523 NEXT_P0;
4524 vm_Cell2n(sp[0],n);
4525 #ifdef VM_DEBUG
4526 if (vm_debug) {
4527 fputs(" n=", vm_out); printarg_n(n);
4528 }
4529 #endif
4530 {
4531 #line 1123 "prim"
4532 f = FLAG(n>=0);
4533 #line 1122
4534 #line 4535 "prim.i"
4535 }
4536 
4537 #ifdef VM_DEBUG
4538 if (vm_debug) {
4539 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4540 fputc('\n', vm_out);
4541 }
4542 #endif
4543 NEXT_P1;
4544 vm_f2Cell(f,sp[0]);
4545 LABEL2(zero_greater_or_equal)
4546 NEXT_P1_5;
4547 LABEL3(zero_greater_or_equal)
4548 DO_GOTO;
4549 }
4550 
4551 LABEL(equals) /* = ( n1 n2 -- f ) S0 -- S0  */
4552 /*  */
4553 NAME("=")
4554 {
4555 DEF_CA
4556 MAYBE_UNUSED Cell n1;
4557 MAYBE_UNUSED Cell n2;
4558 Bool f;
4559 NEXT_P0;
4560 vm_Cell2n(sp[1],n1);
4561 vm_Cell2n(sp[0],n2);
4562 #ifdef VM_DEBUG
4563 if (vm_debug) {
4564 fputs(" n1=", vm_out); printarg_n(n1);
4565 fputs(" n2=", vm_out); printarg_n(n2);
4566 }
4567 #endif
4568 sp += 1;
4569 {
4570 #line 1124 "prim"
4571 f = FLAG(n1==n2);
4572 #line 1123
4573 #line 4574 "prim.i"
4574 }
4575 
4576 #ifdef VM_DEBUG
4577 if (vm_debug) {
4578 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4579 fputc('\n', vm_out);
4580 }
4581 #endif
4582 NEXT_P1;
4583 vm_f2Cell(f,sp[0]);
4584 LABEL2(equals)
4585 NEXT_P1_5;
4586 LABEL3(equals)
4587 DO_GOTO;
4588 }
4589 
4590 LABEL(not_equals) /* <> ( n1 n2 -- f ) S0 -- S0  */
4591 /*  */
4592 NAME("<>")
4593 {
4594 DEF_CA
4595 MAYBE_UNUSED Cell n1;
4596 MAYBE_UNUSED Cell n2;
4597 Bool f;
4598 NEXT_P0;
4599 vm_Cell2n(sp[1],n1);
4600 vm_Cell2n(sp[0],n2);
4601 #ifdef VM_DEBUG
4602 if (vm_debug) {
4603 fputs(" n1=", vm_out); printarg_n(n1);
4604 fputs(" n2=", vm_out); printarg_n(n2);
4605 }
4606 #endif
4607 sp += 1;
4608 {
4609 #line 1124 "prim"
4610 f = FLAG(n1!=n2);
4611 #line 1123
4612 #line 4613 "prim.i"
4613 }
4614 
4615 #ifdef VM_DEBUG
4616 if (vm_debug) {
4617 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4618 fputc('\n', vm_out);
4619 }
4620 #endif
4621 NEXT_P1;
4622 vm_f2Cell(f,sp[0]);
4623 LABEL2(not_equals)
4624 NEXT_P1_5;
4625 LABEL3(not_equals)
4626 DO_GOTO;
4627 }
4628 
4629 LABEL(less_than) /* < ( n1 n2 -- f ) S0 -- S0  */
4630 /*  */
4631 NAME("<")
4632 {
4633 DEF_CA
4634 MAYBE_UNUSED Cell n1;
4635 MAYBE_UNUSED Cell n2;
4636 Bool f;
4637 NEXT_P0;
4638 vm_Cell2n(sp[1],n1);
4639 vm_Cell2n(sp[0],n2);
4640 #ifdef VM_DEBUG
4641 if (vm_debug) {
4642 fputs(" n1=", vm_out); printarg_n(n1);
4643 fputs(" n2=", vm_out); printarg_n(n2);
4644 }
4645 #endif
4646 sp += 1;
4647 {
4648 #line 1124 "prim"
4649 f = FLAG(n1<n2);
4650 #line 1123
4651 #line 4652 "prim.i"
4652 }
4653 
4654 #ifdef VM_DEBUG
4655 if (vm_debug) {
4656 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4657 fputc('\n', vm_out);
4658 }
4659 #endif
4660 NEXT_P1;
4661 vm_f2Cell(f,sp[0]);
4662 LABEL2(less_than)
4663 NEXT_P1_5;
4664 LABEL3(less_than)
4665 DO_GOTO;
4666 }
4667 
4668 LABEL(greater_than) /* > ( n1 n2 -- f ) S0 -- S0  */
4669 /*  */
4670 NAME(">")
4671 {
4672 DEF_CA
4673 MAYBE_UNUSED Cell n1;
4674 MAYBE_UNUSED Cell n2;
4675 Bool f;
4676 NEXT_P0;
4677 vm_Cell2n(sp[1],n1);
4678 vm_Cell2n(sp[0],n2);
4679 #ifdef VM_DEBUG
4680 if (vm_debug) {
4681 fputs(" n1=", vm_out); printarg_n(n1);
4682 fputs(" n2=", vm_out); printarg_n(n2);
4683 }
4684 #endif
4685 sp += 1;
4686 {
4687 #line 1124 "prim"
4688 f = FLAG(n1>n2);
4689 #line 1123
4690 #line 4691 "prim.i"
4691 }
4692 
4693 #ifdef VM_DEBUG
4694 if (vm_debug) {
4695 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4696 fputc('\n', vm_out);
4697 }
4698 #endif
4699 NEXT_P1;
4700 vm_f2Cell(f,sp[0]);
4701 LABEL2(greater_than)
4702 NEXT_P1_5;
4703 LABEL3(greater_than)
4704 DO_GOTO;
4705 }
4706 
4707 LABEL(less_or_equal) /* <= ( n1 n2 -- f ) S0 -- S0  */
4708 /*  */
4709 NAME("<=")
4710 {
4711 DEF_CA
4712 MAYBE_UNUSED Cell n1;
4713 MAYBE_UNUSED Cell n2;
4714 Bool f;
4715 NEXT_P0;
4716 vm_Cell2n(sp[1],n1);
4717 vm_Cell2n(sp[0],n2);
4718 #ifdef VM_DEBUG
4719 if (vm_debug) {
4720 fputs(" n1=", vm_out); printarg_n(n1);
4721 fputs(" n2=", vm_out); printarg_n(n2);
4722 }
4723 #endif
4724 sp += 1;
4725 {
4726 #line 1124 "prim"
4727 f = FLAG(n1<=n2);
4728 #line 1123
4729 #line 4730 "prim.i"
4730 }
4731 
4732 #ifdef VM_DEBUG
4733 if (vm_debug) {
4734 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4735 fputc('\n', vm_out);
4736 }
4737 #endif
4738 NEXT_P1;
4739 vm_f2Cell(f,sp[0]);
4740 LABEL2(less_or_equal)
4741 NEXT_P1_5;
4742 LABEL3(less_or_equal)
4743 DO_GOTO;
4744 }
4745 
4746 LABEL(greater_or_equal) /* >= ( n1 n2 -- f ) S0 -- S0  */
4747 /*  */
4748 NAME(">=")
4749 {
4750 DEF_CA
4751 MAYBE_UNUSED Cell n1;
4752 MAYBE_UNUSED Cell n2;
4753 Bool f;
4754 NEXT_P0;
4755 vm_Cell2n(sp[1],n1);
4756 vm_Cell2n(sp[0],n2);
4757 #ifdef VM_DEBUG
4758 if (vm_debug) {
4759 fputs(" n1=", vm_out); printarg_n(n1);
4760 fputs(" n2=", vm_out); printarg_n(n2);
4761 }
4762 #endif
4763 sp += 1;
4764 {
4765 #line 1124 "prim"
4766 f = FLAG(n1>=n2);
4767 #line 1123
4768 #line 4769 "prim.i"
4769 }
4770 
4771 #ifdef VM_DEBUG
4772 if (vm_debug) {
4773 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4774 fputc('\n', vm_out);
4775 }
4776 #endif
4777 NEXT_P1;
4778 vm_f2Cell(f,sp[0]);
4779 LABEL2(greater_or_equal)
4780 NEXT_P1_5;
4781 LABEL3(greater_or_equal)
4782 DO_GOTO;
4783 }
4784 
4785 LABEL(u_equals) /* u= ( u1 u2 -- f ) S0 -- S0  */
4786 /*  */
4787 NAME("u=")
4788 {
4789 DEF_CA
4790 MAYBE_UNUSED UCell u1;
4791 MAYBE_UNUSED UCell u2;
4792 Bool f;
4793 NEXT_P0;
4794 vm_Cell2u(sp[1],u1);
4795 vm_Cell2u(sp[0],u2);
4796 #ifdef VM_DEBUG
4797 if (vm_debug) {
4798 fputs(" u1=", vm_out); printarg_u(u1);
4799 fputs(" u2=", vm_out); printarg_u(u2);
4800 }
4801 #endif
4802 sp += 1;
4803 {
4804 #line 1125 "prim"
4805 f = FLAG(u1==u2);
4806 #line 1124
4807 #line 4808 "prim.i"
4808 }
4809 
4810 #ifdef VM_DEBUG
4811 if (vm_debug) {
4812 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4813 fputc('\n', vm_out);
4814 }
4815 #endif
4816 NEXT_P1;
4817 vm_f2Cell(f,sp[0]);
4818 LABEL2(u_equals)
4819 NEXT_P1_5;
4820 LABEL3(u_equals)
4821 DO_GOTO;
4822 }
4823 
4824 LABEL(u_not_equals) /* u<> ( u1 u2 -- f ) S0 -- S0  */
4825 /*  */
4826 NAME("u<>")
4827 {
4828 DEF_CA
4829 MAYBE_UNUSED UCell u1;
4830 MAYBE_UNUSED UCell u2;
4831 Bool f;
4832 NEXT_P0;
4833 vm_Cell2u(sp[1],u1);
4834 vm_Cell2u(sp[0],u2);
4835 #ifdef VM_DEBUG
4836 if (vm_debug) {
4837 fputs(" u1=", vm_out); printarg_u(u1);
4838 fputs(" u2=", vm_out); printarg_u(u2);
4839 }
4840 #endif
4841 sp += 1;
4842 {
4843 #line 1125 "prim"
4844 f = FLAG(u1!=u2);
4845 #line 1124
4846 #line 4847 "prim.i"
4847 }
4848 
4849 #ifdef VM_DEBUG
4850 if (vm_debug) {
4851 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4852 fputc('\n', vm_out);
4853 }
4854 #endif
4855 NEXT_P1;
4856 vm_f2Cell(f,sp[0]);
4857 LABEL2(u_not_equals)
4858 NEXT_P1_5;
4859 LABEL3(u_not_equals)
4860 DO_GOTO;
4861 }
4862 
4863 LABEL(u_less_than) /* u< ( u1 u2 -- f ) S0 -- S0  */
4864 /*  */
4865 NAME("u<")
4866 {
4867 DEF_CA
4868 MAYBE_UNUSED UCell u1;
4869 MAYBE_UNUSED UCell u2;
4870 Bool f;
4871 NEXT_P0;
4872 vm_Cell2u(sp[1],u1);
4873 vm_Cell2u(sp[0],u2);
4874 #ifdef VM_DEBUG
4875 if (vm_debug) {
4876 fputs(" u1=", vm_out); printarg_u(u1);
4877 fputs(" u2=", vm_out); printarg_u(u2);
4878 }
4879 #endif
4880 sp += 1;
4881 {
4882 #line 1125 "prim"
4883 f = FLAG(u1<u2);
4884 #line 1124
4885 #line 4886 "prim.i"
4886 }
4887 
4888 #ifdef VM_DEBUG
4889 if (vm_debug) {
4890 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4891 fputc('\n', vm_out);
4892 }
4893 #endif
4894 NEXT_P1;
4895 vm_f2Cell(f,sp[0]);
4896 LABEL2(u_less_than)
4897 NEXT_P1_5;
4898 LABEL3(u_less_than)
4899 DO_GOTO;
4900 }
4901 
4902 LABEL(u_greater_than) /* u> ( u1 u2 -- f ) S0 -- S0  */
4903 /*  */
4904 NAME("u>")
4905 {
4906 DEF_CA
4907 MAYBE_UNUSED UCell u1;
4908 MAYBE_UNUSED UCell u2;
4909 Bool f;
4910 NEXT_P0;
4911 vm_Cell2u(sp[1],u1);
4912 vm_Cell2u(sp[0],u2);
4913 #ifdef VM_DEBUG
4914 if (vm_debug) {
4915 fputs(" u1=", vm_out); printarg_u(u1);
4916 fputs(" u2=", vm_out); printarg_u(u2);
4917 }
4918 #endif
4919 sp += 1;
4920 {
4921 #line 1125 "prim"
4922 f = FLAG(u1>u2);
4923 #line 1124
4924 #line 4925 "prim.i"
4925 }
4926 
4927 #ifdef VM_DEBUG
4928 if (vm_debug) {
4929 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4930 fputc('\n', vm_out);
4931 }
4932 #endif
4933 NEXT_P1;
4934 vm_f2Cell(f,sp[0]);
4935 LABEL2(u_greater_than)
4936 NEXT_P1_5;
4937 LABEL3(u_greater_than)
4938 DO_GOTO;
4939 }
4940 
4941 LABEL(u_less_or_equal) /* u<= ( u1 u2 -- f ) S0 -- S0  */
4942 /*  */
4943 NAME("u<=")
4944 {
4945 DEF_CA
4946 MAYBE_UNUSED UCell u1;
4947 MAYBE_UNUSED UCell u2;
4948 Bool f;
4949 NEXT_P0;
4950 vm_Cell2u(sp[1],u1);
4951 vm_Cell2u(sp[0],u2);
4952 #ifdef VM_DEBUG
4953 if (vm_debug) {
4954 fputs(" u1=", vm_out); printarg_u(u1);
4955 fputs(" u2=", vm_out); printarg_u(u2);
4956 }
4957 #endif
4958 sp += 1;
4959 {
4960 #line 1125 "prim"
4961 f = FLAG(u1<=u2);
4962 #line 1124
4963 #line 4964 "prim.i"
4964 }
4965 
4966 #ifdef VM_DEBUG
4967 if (vm_debug) {
4968 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
4969 fputc('\n', vm_out);
4970 }
4971 #endif
4972 NEXT_P1;
4973 vm_f2Cell(f,sp[0]);
4974 LABEL2(u_less_or_equal)
4975 NEXT_P1_5;
4976 LABEL3(u_less_or_equal)
4977 DO_GOTO;
4978 }
4979 
4980 LABEL(u_greater_or_equal) /* u>= ( u1 u2 -- f ) S0 -- S0  */
4981 /*  */
4982 NAME("u>=")
4983 {
4984 DEF_CA
4985 MAYBE_UNUSED UCell u1;
4986 MAYBE_UNUSED UCell u2;
4987 Bool f;
4988 NEXT_P0;
4989 vm_Cell2u(sp[1],u1);
4990 vm_Cell2u(sp[0],u2);
4991 #ifdef VM_DEBUG
4992 if (vm_debug) {
4993 fputs(" u1=", vm_out); printarg_u(u1);
4994 fputs(" u2=", vm_out); printarg_u(u2);
4995 }
4996 #endif
4997 sp += 1;
4998 {
4999 #line 1125 "prim"
5000 f = FLAG(u1>=u2);
5001 #line 1124
5002 #line 5003 "prim.i"
5003 }
5004 
5005 #ifdef VM_DEBUG
5006 if (vm_debug) {
5007 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5008 fputc('\n', vm_out);
5009 }
5010 #endif
5011 NEXT_P1;
5012 vm_f2Cell(f,sp[0]);
5013 LABEL2(u_greater_or_equal)
5014 NEXT_P1_5;
5015 LABEL3(u_greater_or_equal)
5016 DO_GOTO;
5017 }
5018 
5019 GROUPADD(18)
5020 #ifdef HAS_DCOMPS
LABEL(d_equals)5021 LABEL(d_equals) /* d= ( d1 d2 -- f ) S0 -- S0  */
5022 /*  */
5023 NAME("d=")
5024 {
5025 DEF_CA
5026 MAYBE_UNUSED DCell d1;
5027 MAYBE_UNUSED DCell d2;
5028 Bool f;
5029 NEXT_P0;
5030 vm_twoCell2d(sp[3], sp[2], d1)
5031 vm_twoCell2d(sp[1], sp[0], d2)
5032 #ifdef VM_DEBUG
5033 if (vm_debug) {
5034 fputs(" d1=", vm_out); printarg_d(d1);
5035 fputs(" d2=", vm_out); printarg_d(d2);
5036 }
5037 #endif
5038 sp += 3;
5039 {
5040 #line 1175 "prim"
5041 #ifdef BUGGY_LL_CMP
5042 #line 1174
5043 f = FLAG(d1.lo==d2.lo && d1.hi==d2.hi);
5044 #line 1174
5045 #else
5046 #line 1174
5047 f = FLAG(d1==d2);
5048 #line 1174
5049 #endif
5050 #line 1174
5051 #line 5052 "prim.i"
5052 }
5053 
5054 #ifdef VM_DEBUG
5055 if (vm_debug) {
5056 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5057 fputc('\n', vm_out);
5058 }
5059 #endif
5060 NEXT_P1;
5061 vm_f2Cell(f,sp[0]);
5062 LABEL2(d_equals)
5063 NEXT_P1_5;
5064 LABEL3(d_equals)
5065 DO_GOTO;
5066 }
5067 
5068 LABEL(d_not_equals) /* d<> ( d1 d2 -- f ) S0 -- S0  */
5069 /*  */
5070 NAME("d<>")
5071 {
5072 DEF_CA
5073 MAYBE_UNUSED DCell d1;
5074 MAYBE_UNUSED DCell d2;
5075 Bool f;
5076 NEXT_P0;
5077 vm_twoCell2d(sp[3], sp[2], d1)
5078 vm_twoCell2d(sp[1], sp[0], d2)
5079 #ifdef VM_DEBUG
5080 if (vm_debug) {
5081 fputs(" d1=", vm_out); printarg_d(d1);
5082 fputs(" d2=", vm_out); printarg_d(d2);
5083 }
5084 #endif
5085 sp += 3;
5086 {
5087 #line 1175 "prim"
5088 #ifdef BUGGY_LL_CMP
5089 #line 1174
5090 f = FLAG(d1.lo!=d2.lo || d1.hi!=d2.hi);
5091 #line 1174
5092 #else
5093 #line 1174
5094 f = FLAG(d1!=d2);
5095 #line 1174
5096 #endif
5097 #line 1174
5098 #line 5099 "prim.i"
5099 }
5100 
5101 #ifdef VM_DEBUG
5102 if (vm_debug) {
5103 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5104 fputc('\n', vm_out);
5105 }
5106 #endif
5107 NEXT_P1;
5108 vm_f2Cell(f,sp[0]);
5109 LABEL2(d_not_equals)
5110 NEXT_P1_5;
5111 LABEL3(d_not_equals)
5112 DO_GOTO;
5113 }
5114 
5115 LABEL(d_less_than) /* d< ( d1 d2 -- f ) S0 -- S0  */
5116 /*  */
5117 NAME("d<")
5118 {
5119 DEF_CA
5120 MAYBE_UNUSED DCell d1;
5121 MAYBE_UNUSED DCell d2;
5122 Bool f;
5123 NEXT_P0;
5124 vm_twoCell2d(sp[3], sp[2], d1)
5125 vm_twoCell2d(sp[1], sp[0], d2)
5126 #ifdef VM_DEBUG
5127 if (vm_debug) {
5128 fputs(" d1=", vm_out); printarg_d(d1);
5129 fputs(" d2=", vm_out); printarg_d(d2);
5130 }
5131 #endif
5132 sp += 3;
5133 {
5134 #line 1175 "prim"
5135 #ifdef BUGGY_LL_CMP
5136 #line 1174
5137 f = FLAG(d1.hi==d2.hi ? d1.lo<d2.lo : d1.hi<d2.hi);
5138 #line 1174
5139 #else
5140 #line 1174
5141 f = FLAG(d1<d2);
5142 #line 1174
5143 #endif
5144 #line 1174
5145 #line 5146 "prim.i"
5146 }
5147 
5148 #ifdef VM_DEBUG
5149 if (vm_debug) {
5150 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5151 fputc('\n', vm_out);
5152 }
5153 #endif
5154 NEXT_P1;
5155 vm_f2Cell(f,sp[0]);
5156 LABEL2(d_less_than)
5157 NEXT_P1_5;
5158 LABEL3(d_less_than)
5159 DO_GOTO;
5160 }
5161 
5162 LABEL(d_greater_than) /* d> ( d1 d2 -- f ) S0 -- S0  */
5163 /*  */
5164 NAME("d>")
5165 {
5166 DEF_CA
5167 MAYBE_UNUSED DCell d1;
5168 MAYBE_UNUSED DCell d2;
5169 Bool f;
5170 NEXT_P0;
5171 vm_twoCell2d(sp[3], sp[2], d1)
5172 vm_twoCell2d(sp[1], sp[0], d2)
5173 #ifdef VM_DEBUG
5174 if (vm_debug) {
5175 fputs(" d1=", vm_out); printarg_d(d1);
5176 fputs(" d2=", vm_out); printarg_d(d2);
5177 }
5178 #endif
5179 sp += 3;
5180 {
5181 #line 1175 "prim"
5182 #ifdef BUGGY_LL_CMP
5183 #line 1174
5184 f = FLAG(d1.hi==d2.hi ? d1.lo>d2.lo : d1.hi>d2.hi);
5185 #line 1174
5186 #else
5187 #line 1174
5188 f = FLAG(d1>d2);
5189 #line 1174
5190 #endif
5191 #line 1174
5192 #line 5193 "prim.i"
5193 }
5194 
5195 #ifdef VM_DEBUG
5196 if (vm_debug) {
5197 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5198 fputc('\n', vm_out);
5199 }
5200 #endif
5201 NEXT_P1;
5202 vm_f2Cell(f,sp[0]);
5203 LABEL2(d_greater_than)
5204 NEXT_P1_5;
5205 LABEL3(d_greater_than)
5206 DO_GOTO;
5207 }
5208 
5209 LABEL(d_less_or_equal) /* d<= ( d1 d2 -- f ) S0 -- S0  */
5210 /*  */
5211 NAME("d<=")
5212 {
5213 DEF_CA
5214 MAYBE_UNUSED DCell d1;
5215 MAYBE_UNUSED DCell d2;
5216 Bool f;
5217 NEXT_P0;
5218 vm_twoCell2d(sp[3], sp[2], d1)
5219 vm_twoCell2d(sp[1], sp[0], d2)
5220 #ifdef VM_DEBUG
5221 if (vm_debug) {
5222 fputs(" d1=", vm_out); printarg_d(d1);
5223 fputs(" d2=", vm_out); printarg_d(d2);
5224 }
5225 #endif
5226 sp += 3;
5227 {
5228 #line 1175 "prim"
5229 #ifdef BUGGY_LL_CMP
5230 #line 1174
5231 f = FLAG(d1.hi==d2.hi ? d1.lo<=d2.lo : d1.hi<=d2.hi);
5232 #line 1174
5233 #else
5234 #line 1174
5235 f = FLAG(d1<=d2);
5236 #line 1174
5237 #endif
5238 #line 1174
5239 #line 5240 "prim.i"
5240 }
5241 
5242 #ifdef VM_DEBUG
5243 if (vm_debug) {
5244 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5245 fputc('\n', vm_out);
5246 }
5247 #endif
5248 NEXT_P1;
5249 vm_f2Cell(f,sp[0]);
5250 LABEL2(d_less_or_equal)
5251 NEXT_P1_5;
5252 LABEL3(d_less_or_equal)
5253 DO_GOTO;
5254 }
5255 
5256 LABEL(d_greater_or_equal) /* d>= ( d1 d2 -- f ) S0 -- S0  */
5257 /*  */
5258 NAME("d>=")
5259 {
5260 DEF_CA
5261 MAYBE_UNUSED DCell d1;
5262 MAYBE_UNUSED DCell d2;
5263 Bool f;
5264 NEXT_P0;
5265 vm_twoCell2d(sp[3], sp[2], d1)
5266 vm_twoCell2d(sp[1], sp[0], d2)
5267 #ifdef VM_DEBUG
5268 if (vm_debug) {
5269 fputs(" d1=", vm_out); printarg_d(d1);
5270 fputs(" d2=", vm_out); printarg_d(d2);
5271 }
5272 #endif
5273 sp += 3;
5274 {
5275 #line 1175 "prim"
5276 #ifdef BUGGY_LL_CMP
5277 #line 1174
5278 f = FLAG(d1.hi==d2.hi ? d1.lo>=d2.lo : d1.hi>=d2.hi);
5279 #line 1174
5280 #else
5281 #line 1174
5282 f = FLAG(d1>=d2);
5283 #line 1174
5284 #endif
5285 #line 1174
5286 #line 5287 "prim.i"
5287 }
5288 
5289 #ifdef VM_DEBUG
5290 if (vm_debug) {
5291 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5292 fputc('\n', vm_out);
5293 }
5294 #endif
5295 NEXT_P1;
5296 vm_f2Cell(f,sp[0]);
5297 LABEL2(d_greater_or_equal)
5298 NEXT_P1_5;
5299 LABEL3(d_greater_or_equal)
5300 DO_GOTO;
5301 }
5302 
5303 LABEL(d_zero_equals) /* d0= ( d -- f ) S0 -- S0  */
5304 /*  */
5305 NAME("d0=")
5306 {
5307 DEF_CA
5308 MAYBE_UNUSED DCell d;
5309 Bool f;
5310 NEXT_P0;
5311 vm_twoCell2d(sp[1], sp[0], d)
5312 #ifdef VM_DEBUG
5313 if (vm_debug) {
5314 fputs(" d=", vm_out); printarg_d(d);
5315 }
5316 #endif
5317 sp += 1;
5318 {
5319 #line 1176 "prim"
5320 #ifdef BUGGY_LL_CMP
5321 #line 1175
5322 f = FLAG(d.lo==DZERO.lo && d.hi==DZERO.hi);
5323 #line 1175
5324 #else
5325 #line 1175
5326 f = FLAG(d==DZERO);
5327 #line 1175
5328 #endif
5329 #line 1175
5330 #line 5331 "prim.i"
5331 }
5332 
5333 #ifdef VM_DEBUG
5334 if (vm_debug) {
5335 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5336 fputc('\n', vm_out);
5337 }
5338 #endif
5339 NEXT_P1;
5340 vm_f2Cell(f,sp[0]);
5341 LABEL2(d_zero_equals)
5342 NEXT_P1_5;
5343 LABEL3(d_zero_equals)
5344 DO_GOTO;
5345 }
5346 
5347 LABEL(d_zero_not_equals) /* d0<> ( d -- f ) S0 -- S0  */
5348 /*  */
5349 NAME("d0<>")
5350 {
5351 DEF_CA
5352 MAYBE_UNUSED DCell d;
5353 Bool f;
5354 NEXT_P0;
5355 vm_twoCell2d(sp[1], sp[0], d)
5356 #ifdef VM_DEBUG
5357 if (vm_debug) {
5358 fputs(" d=", vm_out); printarg_d(d);
5359 }
5360 #endif
5361 sp += 1;
5362 {
5363 #line 1176 "prim"
5364 #ifdef BUGGY_LL_CMP
5365 #line 1175
5366 f = FLAG(d.lo!=DZERO.lo || d.hi!=DZERO.hi);
5367 #line 1175
5368 #else
5369 #line 1175
5370 f = FLAG(d!=DZERO);
5371 #line 1175
5372 #endif
5373 #line 1175
5374 #line 5375 "prim.i"
5375 }
5376 
5377 #ifdef VM_DEBUG
5378 if (vm_debug) {
5379 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5380 fputc('\n', vm_out);
5381 }
5382 #endif
5383 NEXT_P1;
5384 vm_f2Cell(f,sp[0]);
5385 LABEL2(d_zero_not_equals)
5386 NEXT_P1_5;
5387 LABEL3(d_zero_not_equals)
5388 DO_GOTO;
5389 }
5390 
5391 LABEL(d_zero_less_than) /* d0< ( d -- f ) S0 -- S0  */
5392 /*  */
5393 NAME("d0<")
5394 {
5395 DEF_CA
5396 MAYBE_UNUSED DCell d;
5397 Bool f;
5398 NEXT_P0;
5399 vm_twoCell2d(sp[1], sp[0], d)
5400 #ifdef VM_DEBUG
5401 if (vm_debug) {
5402 fputs(" d=", vm_out); printarg_d(d);
5403 }
5404 #endif
5405 sp += 1;
5406 {
5407 #line 1176 "prim"
5408 #ifdef BUGGY_LL_CMP
5409 #line 1175
5410 f = FLAG(d.hi==DZERO.hi ? d.lo<DZERO.lo : d.hi<DZERO.hi);
5411 #line 1175
5412 #else
5413 #line 1175
5414 f = FLAG(d<DZERO);
5415 #line 1175
5416 #endif
5417 #line 1175
5418 #line 5419 "prim.i"
5419 }
5420 
5421 #ifdef VM_DEBUG
5422 if (vm_debug) {
5423 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5424 fputc('\n', vm_out);
5425 }
5426 #endif
5427 NEXT_P1;
5428 vm_f2Cell(f,sp[0]);
5429 LABEL2(d_zero_less_than)
5430 NEXT_P1_5;
5431 LABEL3(d_zero_less_than)
5432 DO_GOTO;
5433 }
5434 
5435 LABEL(d_zero_greater_than) /* d0> ( d -- f ) S0 -- S0  */
5436 /*  */
5437 NAME("d0>")
5438 {
5439 DEF_CA
5440 MAYBE_UNUSED DCell d;
5441 Bool f;
5442 NEXT_P0;
5443 vm_twoCell2d(sp[1], sp[0], d)
5444 #ifdef VM_DEBUG
5445 if (vm_debug) {
5446 fputs(" d=", vm_out); printarg_d(d);
5447 }
5448 #endif
5449 sp += 1;
5450 {
5451 #line 1176 "prim"
5452 #ifdef BUGGY_LL_CMP
5453 #line 1175
5454 f = FLAG(d.hi==DZERO.hi ? d.lo>DZERO.lo : d.hi>DZERO.hi);
5455 #line 1175
5456 #else
5457 #line 1175
5458 f = FLAG(d>DZERO);
5459 #line 1175
5460 #endif
5461 #line 1175
5462 #line 5463 "prim.i"
5463 }
5464 
5465 #ifdef VM_DEBUG
5466 if (vm_debug) {
5467 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5468 fputc('\n', vm_out);
5469 }
5470 #endif
5471 NEXT_P1;
5472 vm_f2Cell(f,sp[0]);
5473 LABEL2(d_zero_greater_than)
5474 NEXT_P1_5;
5475 LABEL3(d_zero_greater_than)
5476 DO_GOTO;
5477 }
5478 
5479 LABEL(d_zero_less_or_equal) /* d0<= ( d -- f ) S0 -- S0  */
5480 /*  */
5481 NAME("d0<=")
5482 {
5483 DEF_CA
5484 MAYBE_UNUSED DCell d;
5485 Bool f;
5486 NEXT_P0;
5487 vm_twoCell2d(sp[1], sp[0], d)
5488 #ifdef VM_DEBUG
5489 if (vm_debug) {
5490 fputs(" d=", vm_out); printarg_d(d);
5491 }
5492 #endif
5493 sp += 1;
5494 {
5495 #line 1176 "prim"
5496 #ifdef BUGGY_LL_CMP
5497 #line 1175
5498 f = FLAG(d.hi==DZERO.hi ? d.lo<=DZERO.lo : d.hi<=DZERO.hi);
5499 #line 1175
5500 #else
5501 #line 1175
5502 f = FLAG(d<=DZERO);
5503 #line 1175
5504 #endif
5505 #line 1175
5506 #line 5507 "prim.i"
5507 }
5508 
5509 #ifdef VM_DEBUG
5510 if (vm_debug) {
5511 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5512 fputc('\n', vm_out);
5513 }
5514 #endif
5515 NEXT_P1;
5516 vm_f2Cell(f,sp[0]);
5517 LABEL2(d_zero_less_or_equal)
5518 NEXT_P1_5;
5519 LABEL3(d_zero_less_or_equal)
5520 DO_GOTO;
5521 }
5522 
5523 LABEL(d_zero_greater_or_equal) /* d0>= ( d -- f ) S0 -- S0  */
5524 /*  */
5525 NAME("d0>=")
5526 {
5527 DEF_CA
5528 MAYBE_UNUSED DCell d;
5529 Bool f;
5530 NEXT_P0;
5531 vm_twoCell2d(sp[1], sp[0], d)
5532 #ifdef VM_DEBUG
5533 if (vm_debug) {
5534 fputs(" d=", vm_out); printarg_d(d);
5535 }
5536 #endif
5537 sp += 1;
5538 {
5539 #line 1176 "prim"
5540 #ifdef BUGGY_LL_CMP
5541 #line 1175
5542 f = FLAG(d.hi==DZERO.hi ? d.lo>=DZERO.lo : d.hi>=DZERO.hi);
5543 #line 1175
5544 #else
5545 #line 1175
5546 f = FLAG(d>=DZERO);
5547 #line 1175
5548 #endif
5549 #line 1175
5550 #line 5551 "prim.i"
5551 }
5552 
5553 #ifdef VM_DEBUG
5554 if (vm_debug) {
5555 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5556 fputc('\n', vm_out);
5557 }
5558 #endif
5559 NEXT_P1;
5560 vm_f2Cell(f,sp[0]);
5561 LABEL2(d_zero_greater_or_equal)
5562 NEXT_P1_5;
5563 LABEL3(d_zero_greater_or_equal)
5564 DO_GOTO;
5565 }
5566 
5567 LABEL(d_u_equals) /* du= ( ud1 ud2 -- f ) S0 -- S0  */
5568 /*  */
5569 NAME("du=")
5570 {
5571 DEF_CA
5572 MAYBE_UNUSED UDCell ud1;
5573 MAYBE_UNUSED UDCell ud2;
5574 Bool f;
5575 NEXT_P0;
5576 vm_twoCell2ud(sp[3], sp[2], ud1)
5577 vm_twoCell2ud(sp[1], sp[0], ud2)
5578 #ifdef VM_DEBUG
5579 if (vm_debug) {
5580 fputs(" ud1=", vm_out); printarg_ud(ud1);
5581 fputs(" ud2=", vm_out); printarg_ud(ud2);
5582 }
5583 #endif
5584 sp += 3;
5585 {
5586 #line 1177 "prim"
5587 #ifdef BUGGY_LL_CMP
5588 #line 1176
5589 f = FLAG(ud1.lo==ud2.lo && ud1.hi==ud2.hi);
5590 #line 1176
5591 #else
5592 #line 1176
5593 f = FLAG(ud1==ud2);
5594 #line 1176
5595 #endif
5596 #line 1176
5597 #line 5598 "prim.i"
5598 }
5599 
5600 #ifdef VM_DEBUG
5601 if (vm_debug) {
5602 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5603 fputc('\n', vm_out);
5604 }
5605 #endif
5606 NEXT_P1;
5607 vm_f2Cell(f,sp[0]);
5608 LABEL2(d_u_equals)
5609 NEXT_P1_5;
5610 LABEL3(d_u_equals)
5611 DO_GOTO;
5612 }
5613 
5614 LABEL(d_u_not_equals) /* du<> ( ud1 ud2 -- f ) S0 -- S0  */
5615 /*  */
5616 NAME("du<>")
5617 {
5618 DEF_CA
5619 MAYBE_UNUSED UDCell ud1;
5620 MAYBE_UNUSED UDCell ud2;
5621 Bool f;
5622 NEXT_P0;
5623 vm_twoCell2ud(sp[3], sp[2], ud1)
5624 vm_twoCell2ud(sp[1], sp[0], ud2)
5625 #ifdef VM_DEBUG
5626 if (vm_debug) {
5627 fputs(" ud1=", vm_out); printarg_ud(ud1);
5628 fputs(" ud2=", vm_out); printarg_ud(ud2);
5629 }
5630 #endif
5631 sp += 3;
5632 {
5633 #line 1177 "prim"
5634 #ifdef BUGGY_LL_CMP
5635 #line 1176
5636 f = FLAG(ud1.lo!=ud2.lo || ud1.hi!=ud2.hi);
5637 #line 1176
5638 #else
5639 #line 1176
5640 f = FLAG(ud1!=ud2);
5641 #line 1176
5642 #endif
5643 #line 1176
5644 #line 5645 "prim.i"
5645 }
5646 
5647 #ifdef VM_DEBUG
5648 if (vm_debug) {
5649 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5650 fputc('\n', vm_out);
5651 }
5652 #endif
5653 NEXT_P1;
5654 vm_f2Cell(f,sp[0]);
5655 LABEL2(d_u_not_equals)
5656 NEXT_P1_5;
5657 LABEL3(d_u_not_equals)
5658 DO_GOTO;
5659 }
5660 
5661 LABEL(d_u_less_than) /* du< ( ud1 ud2 -- f ) S0 -- S0  */
5662 /*  */
5663 NAME("du<")
5664 {
5665 DEF_CA
5666 MAYBE_UNUSED UDCell ud1;
5667 MAYBE_UNUSED UDCell ud2;
5668 Bool f;
5669 NEXT_P0;
5670 vm_twoCell2ud(sp[3], sp[2], ud1)
5671 vm_twoCell2ud(sp[1], sp[0], ud2)
5672 #ifdef VM_DEBUG
5673 if (vm_debug) {
5674 fputs(" ud1=", vm_out); printarg_ud(ud1);
5675 fputs(" ud2=", vm_out); printarg_ud(ud2);
5676 }
5677 #endif
5678 sp += 3;
5679 {
5680 #line 1177 "prim"
5681 #ifdef BUGGY_LL_CMP
5682 #line 1176
5683 f = FLAG(ud1.hi==ud2.hi ? ud1.lo<ud2.lo : ud1.hi<ud2.hi);
5684 #line 1176
5685 #else
5686 #line 1176
5687 f = FLAG(ud1<ud2);
5688 #line 1176
5689 #endif
5690 #line 1176
5691 #line 5692 "prim.i"
5692 }
5693 
5694 #ifdef VM_DEBUG
5695 if (vm_debug) {
5696 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5697 fputc('\n', vm_out);
5698 }
5699 #endif
5700 NEXT_P1;
5701 vm_f2Cell(f,sp[0]);
5702 LABEL2(d_u_less_than)
5703 NEXT_P1_5;
5704 LABEL3(d_u_less_than)
5705 DO_GOTO;
5706 }
5707 
5708 LABEL(d_u_greater_than) /* du> ( ud1 ud2 -- f ) S0 -- S0  */
5709 /*  */
5710 NAME("du>")
5711 {
5712 DEF_CA
5713 MAYBE_UNUSED UDCell ud1;
5714 MAYBE_UNUSED UDCell ud2;
5715 Bool f;
5716 NEXT_P0;
5717 vm_twoCell2ud(sp[3], sp[2], ud1)
5718 vm_twoCell2ud(sp[1], sp[0], ud2)
5719 #ifdef VM_DEBUG
5720 if (vm_debug) {
5721 fputs(" ud1=", vm_out); printarg_ud(ud1);
5722 fputs(" ud2=", vm_out); printarg_ud(ud2);
5723 }
5724 #endif
5725 sp += 3;
5726 {
5727 #line 1177 "prim"
5728 #ifdef BUGGY_LL_CMP
5729 #line 1176
5730 f = FLAG(ud1.hi==ud2.hi ? ud1.lo>ud2.lo : ud1.hi>ud2.hi);
5731 #line 1176
5732 #else
5733 #line 1176
5734 f = FLAG(ud1>ud2);
5735 #line 1176
5736 #endif
5737 #line 1176
5738 #line 5739 "prim.i"
5739 }
5740 
5741 #ifdef VM_DEBUG
5742 if (vm_debug) {
5743 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5744 fputc('\n', vm_out);
5745 }
5746 #endif
5747 NEXT_P1;
5748 vm_f2Cell(f,sp[0]);
5749 LABEL2(d_u_greater_than)
5750 NEXT_P1_5;
5751 LABEL3(d_u_greater_than)
5752 DO_GOTO;
5753 }
5754 
5755 LABEL(d_u_less_or_equal) /* du<= ( ud1 ud2 -- f ) S0 -- S0  */
5756 /*  */
5757 NAME("du<=")
5758 {
5759 DEF_CA
5760 MAYBE_UNUSED UDCell ud1;
5761 MAYBE_UNUSED UDCell ud2;
5762 Bool f;
5763 NEXT_P0;
5764 vm_twoCell2ud(sp[3], sp[2], ud1)
5765 vm_twoCell2ud(sp[1], sp[0], ud2)
5766 #ifdef VM_DEBUG
5767 if (vm_debug) {
5768 fputs(" ud1=", vm_out); printarg_ud(ud1);
5769 fputs(" ud2=", vm_out); printarg_ud(ud2);
5770 }
5771 #endif
5772 sp += 3;
5773 {
5774 #line 1177 "prim"
5775 #ifdef BUGGY_LL_CMP
5776 #line 1176
5777 f = FLAG(ud1.hi==ud2.hi ? ud1.lo<=ud2.lo : ud1.hi<=ud2.hi);
5778 #line 1176
5779 #else
5780 #line 1176
5781 f = FLAG(ud1<=ud2);
5782 #line 1176
5783 #endif
5784 #line 1176
5785 #line 5786 "prim.i"
5786 }
5787 
5788 #ifdef VM_DEBUG
5789 if (vm_debug) {
5790 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5791 fputc('\n', vm_out);
5792 }
5793 #endif
5794 NEXT_P1;
5795 vm_f2Cell(f,sp[0]);
5796 LABEL2(d_u_less_or_equal)
5797 NEXT_P1_5;
5798 LABEL3(d_u_less_or_equal)
5799 DO_GOTO;
5800 }
5801 
5802 LABEL(d_u_greater_or_equal) /* du>= ( ud1 ud2 -- f ) S0 -- S0  */
5803 /*  */
5804 NAME("du>=")
5805 {
5806 DEF_CA
5807 MAYBE_UNUSED UDCell ud1;
5808 MAYBE_UNUSED UDCell ud2;
5809 Bool f;
5810 NEXT_P0;
5811 vm_twoCell2ud(sp[3], sp[2], ud1)
5812 vm_twoCell2ud(sp[1], sp[0], ud2)
5813 #ifdef VM_DEBUG
5814 if (vm_debug) {
5815 fputs(" ud1=", vm_out); printarg_ud(ud1);
5816 fputs(" ud2=", vm_out); printarg_ud(ud2);
5817 }
5818 #endif
5819 sp += 3;
5820 {
5821 #line 1177 "prim"
5822 #ifdef BUGGY_LL_CMP
5823 #line 1176
5824 f = FLAG(ud1.hi==ud2.hi ? ud1.lo>=ud2.lo : ud1.hi>=ud2.hi);
5825 #line 1176
5826 #else
5827 #line 1176
5828 f = FLAG(ud1>=ud2);
5829 #line 1176
5830 #endif
5831 #line 1176
5832 #line 5833 "prim.i"
5833 }
5834 
5835 #ifdef VM_DEBUG
5836 if (vm_debug) {
5837 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5838 fputc('\n', vm_out);
5839 }
5840 #endif
5841 NEXT_P1;
5842 vm_f2Cell(f,sp[0]);
5843 LABEL2(d_u_greater_or_equal)
5844 NEXT_P1_5;
5845 LABEL3(d_u_greater_or_equal)
5846 DO_GOTO;
5847 }
5848 
5849 GROUPADD(18)
5850 #endif
LABEL(within)5851 LABEL(within) /* within ( u1 u2 u3 -- f ) S0 -- S0  */
5852 /* u2=<u1<u3 or: u3=<u2 and u1 is not in [u3,u2).  This works for
5853 unsigned and signed numbers (but not a mixture).  Another way to think
5854 about this word is to consider the numbers as a circle (wrapping
5855 around from @code{max-u} to 0 for unsigned, and from @code{max-n} to
5856 min-n for signed numbers); now consider the range from u2 towards
5857 increasing numbers up to and excluding u3 (giving an empty range if
5858 u2=u3); if u1 is in this range, @code{within} returns true. */
5859 NAME("within")
5860 {
5861 DEF_CA
5862 MAYBE_UNUSED UCell u1;
5863 MAYBE_UNUSED UCell u2;
5864 MAYBE_UNUSED UCell u3;
5865 Bool f;
5866 NEXT_P0;
5867 vm_Cell2u(sp[2],u1);
5868 vm_Cell2u(sp[1],u2);
5869 vm_Cell2u(sp[0],u3);
5870 #ifdef VM_DEBUG
5871 if (vm_debug) {
5872 fputs(" u1=", vm_out); printarg_u(u1);
5873 fputs(" u2=", vm_out); printarg_u(u2);
5874 fputs(" u3=", vm_out); printarg_u(u3);
5875 }
5876 #endif
5877 sp += 2;
5878 {
5879 #line 1189 "prim"
5880 f = FLAG(u1-u2 < u3-u2);
5881 #line 5882 "prim.i"
5882 }
5883 
5884 #ifdef VM_DEBUG
5885 if (vm_debug) {
5886 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
5887 fputc('\n', vm_out);
5888 }
5889 #endif
5890 NEXT_P1;
5891 vm_f2Cell(f,sp[0]);
5892 LABEL2(within)
5893 NEXT_P1_5;
5894 LABEL3(within)
5895 DO_GOTO;
5896 }
5897 
5898 GROUPADD(1)
5899 GROUP( stack, 125)
LABEL(useraddr)5900 LABEL(useraddr) /* useraddr ( #u -- a_addr ) S0 -- S0  */
5901 /*  */
5902 NAME("useraddr")
5903 {
5904 DEF_CA
5905 MAYBE_UNUSED UCell u;
5906 Cell * a_addr;
5907 NEXT_P0;
5908 vm_Cell2u(IMM_ARG(IPTOS,305397793 ),u);
5909 #ifdef VM_DEBUG
5910 if (vm_debug) {
5911 fputs(" u=", vm_out); printarg_u(u);
5912 }
5913 #endif
5914 INC_IP(1);
5915 sp += -1;
5916 {
5917 #line 1196 "prim"
5918 a_addr = (Cell *)(up+u);
5919 #line 5920 "prim.i"
5920 }
5921 
5922 #ifdef VM_DEBUG
5923 if (vm_debug) {
5924 fputs(" -- ", vm_out); fputs(" a_addr=", vm_out); printarg_a_(a_addr);
5925 fputc('\n', vm_out);
5926 }
5927 #endif
5928 NEXT_P1;
5929 vm_a_2Cell(a_addr,sp[0]);
5930 LABEL2(useraddr)
5931 NEXT_P1_5;
5932 LABEL3(useraddr)
5933 DO_GOTO;
5934 }
5935 
5936 LABEL(up_store) /* up! ( a_addr -- ) S0 -- S0  */
5937 /*  */
5938 NAME("up!")
5939 {
5940 DEF_CA
5941 MAYBE_UNUSED Cell * a_addr;
5942 NEXT_P0;
5943 vm_Cell2a_(sp[0],a_addr);
5944 #ifdef VM_DEBUG
5945 if (vm_debug) {
5946 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
5947 }
5948 #endif
5949 sp += 1;
5950 {
5951 #line 1199 "prim"
5952 gforth_UP=up=(Address)a_addr;
5953 #line 5954 "prim.i"
5954 }
5955 
5956 #ifdef VM_DEBUG
5957 if (vm_debug) {
5958 fputs(" -- ", vm_out); fputc('\n', vm_out);
5959 }
5960 #endif
5961 NEXT_P1;
5962 LABEL2(up_store)
5963 NEXT_P1_5;
5964 LABEL3(up_store)
5965 DO_GOTO;
5966 }
5967 
5968 LABEL(sp_fetch) /* sp@ ( S:... -- a_addr ) S0 -- S0  */
5969 /*  */
5970 NAME("sp@")
5971 {
5972 DEF_CA
5973 Cell * a_addr;
5974 NEXT_P0;
5975 #ifdef VM_DEBUG
5976 if (vm_debug) {
5977 }
5978 #endif
5979 {
5980 #line 1205 "prim"
5981 a_addr = sp;
5982 #line 5983 "prim.i"
5983 }
5984 
5985 #ifdef VM_DEBUG
5986 if (vm_debug) {
5987 fputs(" -- ", vm_out); fputs(" a_addr=", vm_out); printarg_a_(a_addr);
5988 fputc('\n', vm_out);
5989 }
5990 #endif
5991 NEXT_P1;
5992 sp += -1;
5993 vm_a_2Cell(a_addr,sp[0]);
5994 LABEL2(sp_fetch)
5995 NEXT_P1_5;
5996 LABEL3(sp_fetch)
5997 DO_GOTO;
5998 }
5999 
6000 LABEL(sp_store) /* sp! ( a_addr -- S:... ) S0 -- S0  */
6001 /*  */
6002 NAME("sp!")
6003 {
6004 DEF_CA
6005 MAYBE_UNUSED Cell * a_addr;
6006 NEXT_P0;
6007 vm_Cell2a_(sp[0],a_addr);
6008 #ifdef VM_DEBUG
6009 if (vm_debug) {
6010 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
6011 }
6012 #endif
6013 sp += 1;
6014 {
6015 #line 1208 "prim"
6016 sp = a_addr;
6017 #line 6018 "prim.i"
6018 }
6019 
6020 #ifdef VM_DEBUG
6021 if (vm_debug) {
6022 fputs(" -- ", vm_out); fputc('\n', vm_out);
6023 }
6024 #endif
6025 NEXT_P1;
6026 LABEL2(sp_store)
6027 NEXT_P1_5;
6028 LABEL3(sp_store)
6029 DO_GOTO;
6030 }
6031 
6032 LABEL(rp_fetch) /* rp@ ( -- a_addr ) S0 -- S0  */
6033 /*  */
6034 NAME("rp@")
6035 {
6036 DEF_CA
6037 Cell * a_addr;
6038 NEXT_P0;
6039 #ifdef VM_DEBUG
6040 if (vm_debug) {
6041 }
6042 #endif
6043 sp += -1;
6044 {
6045 #line 1211 "prim"
6046 a_addr = rp;
6047 #line 6048 "prim.i"
6048 }
6049 
6050 #ifdef VM_DEBUG
6051 if (vm_debug) {
6052 fputs(" -- ", vm_out); fputs(" a_addr=", vm_out); printarg_a_(a_addr);
6053 fputc('\n', vm_out);
6054 }
6055 #endif
6056 NEXT_P1;
6057 vm_a_2Cell(a_addr,sp[0]);
6058 LABEL2(rp_fetch)
6059 NEXT_P1_5;
6060 LABEL3(rp_fetch)
6061 DO_GOTO;
6062 }
6063 
6064 LABEL(rp_store) /* rp! ( a_addr -- ) S0 -- S0  */
6065 /*  */
6066 NAME("rp!")
6067 {
6068 DEF_CA
6069 MAYBE_UNUSED Cell * a_addr;
6070 NEXT_P0;
6071 vm_Cell2a_(sp[0],a_addr);
6072 #ifdef VM_DEBUG
6073 if (vm_debug) {
6074 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
6075 }
6076 #endif
6077 sp += 1;
6078 {
6079 #line 1214 "prim"
6080 rp = a_addr;
6081 #line 6082 "prim.i"
6082 }
6083 
6084 #ifdef VM_DEBUG
6085 if (vm_debug) {
6086 fputs(" -- ", vm_out); fputc('\n', vm_out);
6087 }
6088 #endif
6089 NEXT_P1;
6090 LABEL2(rp_store)
6091 NEXT_P1_5;
6092 LABEL3(rp_store)
6093 DO_GOTO;
6094 }
6095 
6096 GROUPADD(6)
6097 #ifdef HAS_FLOATING
LABEL(fp_fetch)6098 LABEL(fp_fetch) /* fp@ ( f:... -- f_addr ) S0 -- S0  */
6099 /*  */
6100 NAME("fp@")
6101 {
6102 DEF_CA
6103 Float * f_addr;
6104 NEXT_P0;
6105 #ifdef VM_DEBUG
6106 if (vm_debug) {
6107 }
6108 #endif
6109 sp += -1;
6110 {
6111 #line 1219 "prim"
6112 f_addr = fp;
6113 #line 6114 "prim.i"
6114 }
6115 
6116 #ifdef VM_DEBUG
6117 if (vm_debug) {
6118 fputs(" -- ", vm_out); fputs(" f_addr=", vm_out); printarg_f_(f_addr);
6119 fputc('\n', vm_out);
6120 }
6121 #endif
6122 NEXT_P1;
6123 vm_f_2Cell(f_addr,sp[0]);
6124 LABEL2(fp_fetch)
6125 NEXT_P1_5;
6126 LABEL3(fp_fetch)
6127 DO_GOTO;
6128 }
6129 
6130 LABEL(fp_store) /* fp! ( f_addr -- f:... ) S0 -- S0  */
6131 /*  */
6132 NAME("fp!")
6133 {
6134 DEF_CA
6135 MAYBE_UNUSED Float * f_addr;
6136 NEXT_P0;
6137 vm_Cell2f_(sp[0],f_addr);
6138 #ifdef VM_DEBUG
6139 if (vm_debug) {
6140 fputs(" f_addr=", vm_out); printarg_f_(f_addr);
6141 }
6142 #endif
6143 sp += 1;
6144 {
6145 #line 1222 "prim"
6146 fp = f_addr;
6147 #line 6148 "prim.i"
6148 }
6149 
6150 #ifdef VM_DEBUG
6151 if (vm_debug) {
6152 fputs(" -- ", vm_out); fputc('\n', vm_out);
6153 }
6154 #endif
6155 NEXT_P1;
6156 LABEL2(fp_store)
6157 NEXT_P1_5;
6158 LABEL3(fp_store)
6159 DO_GOTO;
6160 }
6161 
6162 GROUPADD(2)
6163 #endif
LABEL(to_r)6164 LABEL(to_r) /* >r ( w -- R:w ) S0 -- S0  */
6165 /*  */
6166 NAME(">r")
6167 {
6168 DEF_CA
6169 MAYBE_UNUSED Cell w;
6170 NEXT_P0;
6171 vm_Cell2w(sp[0],w);
6172 #ifdef VM_DEBUG
6173 if (vm_debug) {
6174 fputs(" w=", vm_out); printarg_w(w);
6175 }
6176 #endif
6177 sp += 1;
6178 rp += -1;
6179 {
6180 #line 1227 "prim"
6181 #line 6182 "prim.i"
6182 }
6183 
6184 #ifdef VM_DEBUG
6185 if (vm_debug) {
6186 fputs(" -- ", vm_out); fputc('\n', vm_out);
6187 }
6188 #endif
6189 NEXT_P1;
6190 vm_w2Cell(w,rp[0]);
6191 LABEL2(to_r)
6192 NEXT_P1_5;
6193 LABEL3(to_r)
6194 DO_GOTO;
6195 }
6196 
6197 LABEL(r_from) /* r> ( R:w -- w ) S0 -- S0  */
6198 /*  */
6199 NAME("r>")
6200 {
6201 DEF_CA
6202 MAYBE_UNUSED Cell w;
6203 NEXT_P0;
6204 vm_Cell2w(rp[0],w);
6205 #ifdef VM_DEBUG
6206 if (vm_debug) {
6207 fputs(" w=", vm_out); printarg_w(w);
6208 }
6209 #endif
6210 sp += -1;
6211 rp += 1;
6212 {
6213 #line 1232 "prim"
6214 #line 6215 "prim.i"
6215 }
6216 
6217 #ifdef VM_DEBUG
6218 if (vm_debug) {
6219 fputs(" -- ", vm_out); fputc('\n', vm_out);
6220 }
6221 #endif
6222 NEXT_P1;
6223 vm_w2Cell(w,sp[0]);
6224 LABEL2(r_from)
6225 NEXT_P1_5;
6226 LABEL3(r_from)
6227 DO_GOTO;
6228 }
6229 
6230 LABEL(rdrop) /* rdrop ( R:w -- ) S0 -- S0  */
6231 /*  */
6232 NAME("rdrop")
6233 {
6234 DEF_CA
6235 MAYBE_UNUSED Cell w;
6236 NEXT_P0;
6237 vm_Cell2w(rp[0],w);
6238 #ifdef VM_DEBUG
6239 if (vm_debug) {
6240 fputs(" w=", vm_out); printarg_w(w);
6241 }
6242 #endif
6243 rp += 1;
6244 {
6245 #line 1237 "prim"
6246 #line 6247 "prim.i"
6247 }
6248 
6249 #ifdef VM_DEBUG
6250 if (vm_debug) {
6251 fputs(" -- ", vm_out); fputc('\n', vm_out);
6252 }
6253 #endif
6254 NEXT_P1;
6255 LABEL2(rdrop)
6256 NEXT_P1_5;
6257 LABEL3(rdrop)
6258 DO_GOTO;
6259 }
6260 
6261 LABEL(two_to_r) /* 2>r ( d -- R:d ) S0 -- S0  */
6262 /*  */
6263 NAME("2>r")
6264 {
6265 DEF_CA
6266 MAYBE_UNUSED DCell d;
6267 NEXT_P0;
6268 vm_twoCell2d(sp[1], sp[0], d)
6269 #ifdef VM_DEBUG
6270 if (vm_debug) {
6271 fputs(" d=", vm_out); printarg_d(d);
6272 }
6273 #endif
6274 sp += 2;
6275 rp += -2;
6276 {
6277 #line 1241 "prim"
6278 #line 6279 "prim.i"
6279 }
6280 
6281 #ifdef VM_DEBUG
6282 if (vm_debug) {
6283 fputs(" -- ", vm_out); fputc('\n', vm_out);
6284 }
6285 #endif
6286 NEXT_P1;
6287 vm_d2twoCell(d, rp[1], rp[0])
6288 LABEL2(two_to_r)
6289 NEXT_P1_5;
6290 LABEL3(two_to_r)
6291 DO_GOTO;
6292 }
6293 
6294 LABEL(two_r_from) /* 2r> ( R:d -- d ) S0 -- S0  */
6295 /*  */
6296 NAME("2r>")
6297 {
6298 DEF_CA
6299 MAYBE_UNUSED DCell d;
6300 NEXT_P0;
6301 vm_twoCell2d(rp[1], rp[0], d)
6302 #ifdef VM_DEBUG
6303 if (vm_debug) {
6304 fputs(" d=", vm_out); printarg_d(d);
6305 }
6306 #endif
6307 sp += -2;
6308 rp += 2;
6309 {
6310 #line 1245 "prim"
6311 #line 6312 "prim.i"
6312 }
6313 
6314 #ifdef VM_DEBUG
6315 if (vm_debug) {
6316 fputs(" -- ", vm_out); fputc('\n', vm_out);
6317 }
6318 #endif
6319 NEXT_P1;
6320 vm_d2twoCell(d, sp[1], sp[0])
6321 LABEL2(two_r_from)
6322 NEXT_P1_5;
6323 LABEL3(two_r_from)
6324 DO_GOTO;
6325 }
6326 
6327 LABEL(two_r_fetch) /* 2r@ ( R:d -- R:d d ) S0 -- S0  */
6328 /*  */
6329 NAME("2r@")
6330 {
6331 DEF_CA
6332 MAYBE_UNUSED DCell d;
6333 NEXT_P0;
6334 vm_twoCell2d(rp[1], rp[0], d)
6335 #ifdef VM_DEBUG
6336 if (vm_debug) {
6337 fputs(" d=", vm_out); printarg_d(d);
6338 }
6339 #endif
6340 sp += -2;
6341 {
6342 #line 1249 "prim"
6343 #line 6344 "prim.i"
6344 }
6345 
6346 #ifdef VM_DEBUG
6347 if (vm_debug) {
6348 fputs(" -- ", vm_out); fputc('\n', vm_out);
6349 }
6350 #endif
6351 NEXT_P1;
6352 vm_d2twoCell(d, rp[1], rp[0])
6353 vm_d2twoCell(d, sp[1], sp[0])
6354 LABEL2(two_r_fetch)
6355 NEXT_P1_5;
6356 LABEL3(two_r_fetch)
6357 DO_GOTO;
6358 }
6359 
6360 LABEL(two_r_drop) /* 2rdrop ( R:d -- ) S0 -- S0  */
6361 /*  */
6362 NAME("2rdrop")
6363 {
6364 DEF_CA
6365 MAYBE_UNUSED DCell d;
6366 NEXT_P0;
6367 vm_twoCell2d(rp[1], rp[0], d)
6368 #ifdef VM_DEBUG
6369 if (vm_debug) {
6370 fputs(" d=", vm_out); printarg_d(d);
6371 }
6372 #endif
6373 rp += 2;
6374 {
6375 #line 1253 "prim"
6376 #line 6377 "prim.i"
6377 }
6378 
6379 #ifdef VM_DEBUG
6380 if (vm_debug) {
6381 fputs(" -- ", vm_out); fputc('\n', vm_out);
6382 }
6383 #endif
6384 NEXT_P1;
6385 LABEL2(two_r_drop)
6386 NEXT_P1_5;
6387 LABEL3(two_r_drop)
6388 DO_GOTO;
6389 }
6390 
6391 LABEL(over) /* over ( w1 w2 -- w1 w2 w1 ) S0 -- S0  */
6392 /*  */
6393 NAME("over")
6394 {
6395 DEF_CA
6396 MAYBE_UNUSED Cell w1;
6397 MAYBE_UNUSED Cell w2;
6398 NEXT_P0;
6399 vm_Cell2w(sp[1],w1);
6400 vm_Cell2w(sp[0],w2);
6401 #ifdef VM_DEBUG
6402 if (vm_debug) {
6403 fputs(" w1=", vm_out); printarg_w(w1);
6404 fputs(" w2=", vm_out); printarg_w(w2);
6405 }
6406 #endif
6407 sp += -1;
6408 {
6409 #line 1257 "prim"
6410 #line 6411 "prim.i"
6411 }
6412 
6413 #ifdef VM_DEBUG
6414 if (vm_debug) {
6415 fputs(" -- ", vm_out); fputc('\n', vm_out);
6416 }
6417 #endif
6418 NEXT_P1;
6419 vm_w2Cell(w1,sp[0]);
6420 LABEL2(over)
6421 NEXT_P1_5;
6422 LABEL3(over)
6423 DO_GOTO;
6424 }
6425 
6426 LABEL(drop) /* drop ( w -- ) S0 -- S0  */
6427 /*  */
6428 NAME("drop")
6429 {
6430 DEF_CA
6431 MAYBE_UNUSED Cell w;
6432 NEXT_P0;
6433 vm_Cell2w(sp[0],w);
6434 #ifdef VM_DEBUG
6435 if (vm_debug) {
6436 fputs(" w=", vm_out); printarg_w(w);
6437 }
6438 #endif
6439 sp += 1;
6440 {
6441 #line 1261 "prim"
6442 #line 6443 "prim.i"
6443 }
6444 
6445 #ifdef VM_DEBUG
6446 if (vm_debug) {
6447 fputs(" -- ", vm_out); fputc('\n', vm_out);
6448 }
6449 #endif
6450 NEXT_P1;
6451 LABEL2(drop)
6452 NEXT_P1_5;
6453 LABEL3(drop)
6454 DO_GOTO;
6455 }
6456 
6457 LABEL(swap) /* swap ( w1 w2 -- w2 w1 ) S0 -- S0  */
6458 /*  */
6459 NAME("swap")
6460 {
6461 DEF_CA
6462 MAYBE_UNUSED Cell w1;
6463 MAYBE_UNUSED Cell w2;
6464 NEXT_P0;
6465 vm_Cell2w(sp[1],w1);
6466 vm_Cell2w(sp[0],w2);
6467 #ifdef VM_DEBUG
6468 if (vm_debug) {
6469 fputs(" w1=", vm_out); printarg_w(w1);
6470 fputs(" w2=", vm_out); printarg_w(w2);
6471 }
6472 #endif
6473 {
6474 #line 1265 "prim"
6475 #line 6476 "prim.i"
6476 }
6477 
6478 #ifdef VM_DEBUG
6479 if (vm_debug) {
6480 fputs(" -- ", vm_out); fputc('\n', vm_out);
6481 }
6482 #endif
6483 NEXT_P1;
6484 vm_w2Cell(w2,sp[1]);
6485 vm_w2Cell(w1,sp[0]);
6486 LABEL2(swap)
6487 NEXT_P1_5;
6488 LABEL3(swap)
6489 DO_GOTO;
6490 }
6491 
6492 LABEL(dupe) /* dup ( w -- w w ) S0 -- S0  */
6493 /*  */
6494 NAME("dup")
6495 {
6496 DEF_CA
6497 MAYBE_UNUSED Cell w;
6498 NEXT_P0;
6499 vm_Cell2w(sp[0],w);
6500 #ifdef VM_DEBUG
6501 if (vm_debug) {
6502 fputs(" w=", vm_out); printarg_w(w);
6503 }
6504 #endif
6505 sp += -1;
6506 {
6507 #line 1270 "prim"
6508 #line 6509 "prim.i"
6509 }
6510 
6511 #ifdef VM_DEBUG
6512 if (vm_debug) {
6513 fputs(" -- ", vm_out); fputc('\n', vm_out);
6514 }
6515 #endif
6516 NEXT_P1;
6517 vm_w2Cell(w,sp[0]);
6518 LABEL2(dupe)
6519 NEXT_P1_5;
6520 LABEL3(dupe)
6521 DO_GOTO;
6522 }
6523 
6524 LABEL(rote) /* rot ( w1 w2 w3 -- w2 w3 w1 ) S0 -- S0  */
6525 /*  */
6526 NAME("rot")
6527 {
6528 DEF_CA
6529 MAYBE_UNUSED Cell w1;
6530 MAYBE_UNUSED Cell w2;
6531 MAYBE_UNUSED Cell w3;
6532 NEXT_P0;
6533 vm_Cell2w(sp[2],w1);
6534 vm_Cell2w(sp[1],w2);
6535 vm_Cell2w(sp[0],w3);
6536 #ifdef VM_DEBUG
6537 if (vm_debug) {
6538 fputs(" w1=", vm_out); printarg_w(w1);
6539 fputs(" w2=", vm_out); printarg_w(w2);
6540 fputs(" w3=", vm_out); printarg_w(w3);
6541 }
6542 #endif
6543 {
6544 #line 1274 "prim"
6545 #line 6546 "prim.i"
6546 }
6547 
6548 #ifdef VM_DEBUG
6549 if (vm_debug) {
6550 fputs(" -- ", vm_out); fputc('\n', vm_out);
6551 }
6552 #endif
6553 NEXT_P1;
6554 vm_w2Cell(w2,sp[2]);
6555 vm_w2Cell(w3,sp[1]);
6556 vm_w2Cell(w1,sp[0]);
6557 LABEL2(rote)
6558 NEXT_P1_5;
6559 LABEL3(rote)
6560 DO_GOTO;
6561 }
6562 
6563 LABEL(not_rote) /* -rot ( w1 w2 w3 -- w3 w1 w2 ) S0 -- S0  */
6564 /*  */
6565 NAME("-rot")
6566 {
6567 DEF_CA
6568 MAYBE_UNUSED Cell w1;
6569 MAYBE_UNUSED Cell w2;
6570 MAYBE_UNUSED Cell w3;
6571 NEXT_P0;
6572 vm_Cell2w(sp[2],w1);
6573 vm_Cell2w(sp[1],w2);
6574 vm_Cell2w(sp[0],w3);
6575 #ifdef VM_DEBUG
6576 if (vm_debug) {
6577 fputs(" w1=", vm_out); printarg_w(w1);
6578 fputs(" w2=", vm_out); printarg_w(w2);
6579 fputs(" w3=", vm_out); printarg_w(w3);
6580 }
6581 #endif
6582 {
6583 #line 1283 "prim"
6584 #line 6585 "prim.i"
6585 }
6586 
6587 #ifdef VM_DEBUG
6588 if (vm_debug) {
6589 fputs(" -- ", vm_out); fputc('\n', vm_out);
6590 }
6591 #endif
6592 NEXT_P1;
6593 vm_w2Cell(w3,sp[2]);
6594 vm_w2Cell(w1,sp[1]);
6595 vm_w2Cell(w2,sp[0]);
6596 LABEL2(not_rote)
6597 NEXT_P1_5;
6598 LABEL3(not_rote)
6599 DO_GOTO;
6600 }
6601 
6602 LABEL(nip) /* nip ( w1 w2 -- w2 ) S0 -- S0  */
6603 /*  */
6604 NAME("nip")
6605 {
6606 DEF_CA
6607 MAYBE_UNUSED Cell w1;
6608 MAYBE_UNUSED Cell w2;
6609 NEXT_P0;
6610 vm_Cell2w(sp[1],w1);
6611 vm_Cell2w(sp[0],w2);
6612 #ifdef VM_DEBUG
6613 if (vm_debug) {
6614 fputs(" w1=", vm_out); printarg_w(w1);
6615 fputs(" w2=", vm_out); printarg_w(w2);
6616 }
6617 #endif
6618 sp += 1;
6619 {
6620 #line 1287 "prim"
6621 #line 6622 "prim.i"
6622 }
6623 
6624 #ifdef VM_DEBUG
6625 if (vm_debug) {
6626 fputs(" -- ", vm_out); fputc('\n', vm_out);
6627 }
6628 #endif
6629 NEXT_P1;
6630 vm_w2Cell(w2,sp[0]);
6631 LABEL2(nip)
6632 NEXT_P1_5;
6633 LABEL3(nip)
6634 DO_GOTO;
6635 }
6636 
6637 LABEL(tuck) /* tuck ( w1 w2 -- w2 w1 w2 ) S0 -- S0  */
6638 /*  */
6639 NAME("tuck")
6640 {
6641 DEF_CA
6642 MAYBE_UNUSED Cell w1;
6643 MAYBE_UNUSED Cell w2;
6644 NEXT_P0;
6645 vm_Cell2w(sp[1],w1);
6646 vm_Cell2w(sp[0],w2);
6647 #ifdef VM_DEBUG
6648 if (vm_debug) {
6649 fputs(" w1=", vm_out); printarg_w(w1);
6650 fputs(" w2=", vm_out); printarg_w(w2);
6651 }
6652 #endif
6653 sp += -1;
6654 {
6655 #line 1291 "prim"
6656 #line 6657 "prim.i"
6657 }
6658 
6659 #ifdef VM_DEBUG
6660 if (vm_debug) {
6661 fputs(" -- ", vm_out); fputc('\n', vm_out);
6662 }
6663 #endif
6664 NEXT_P1;
6665 vm_w2Cell(w2,sp[2]);
6666 vm_w2Cell(w1,sp[1]);
6667 vm_w2Cell(w2,sp[0]);
6668 LABEL2(tuck)
6669 NEXT_P1_5;
6670 LABEL3(tuck)
6671 DO_GOTO;
6672 }
6673 
6674 LABEL(question_dupe) /* ?dup ( w -- S:... w ) S0 -- S0  */
6675 /* Actually the stack effect is: @code{( w -- 0 | w w )}.  It performs a
6676 @code{dup} if w is nonzero. */
6677 NAME("?dup")
6678 {
6679 DEF_CA
6680 MAYBE_UNUSED Cell w;
6681 NEXT_P0;
6682 vm_Cell2w(sp[0],w);
6683 #ifdef VM_DEBUG
6684 if (vm_debug) {
6685 fputs(" w=", vm_out); printarg_w(w);
6686 }
6687 #endif
6688 sp += 1;
6689 {
6690 #line 1297 "prim"
6691 if (w!=0) {
6692   *--sp = w;
6693 }
6694 #line 6695 "prim.i"
6695 }
6696 
6697 #ifdef VM_DEBUG
6698 if (vm_debug) {
6699 fputs(" -- ", vm_out); fputc('\n', vm_out);
6700 }
6701 #endif
6702 NEXT_P1;
6703 sp += -1;
6704 vm_w2Cell(w,sp[0]);
6705 LABEL2(question_dupe)
6706 NEXT_P1_5;
6707 LABEL3(question_dupe)
6708 DO_GOTO;
6709 }
6710 
6711 LABEL(pick) /* pick ( S:... u -- S:... w ) S0 -- S0  */
6712 /* Actually the stack effect is @code{ x0 ... xu u -- x0 ... xu x0 }. */
6713 NAME("pick")
6714 {
6715 DEF_CA
6716 MAYBE_UNUSED UCell u;
6717 Cell w;
6718 NEXT_P0;
6719 vm_Cell2u(sp[0],u);
6720 #ifdef VM_DEBUG
6721 if (vm_debug) {
6722 fputs(" u=", vm_out); printarg_u(u);
6723 }
6724 #endif
6725 sp += 1;
6726 {
6727 #line 1305 "prim"
6728 w = sp[u];
6729 #line 6730 "prim.i"
6730 }
6731 
6732 #ifdef VM_DEBUG
6733 if (vm_debug) {
6734 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
6735 fputc('\n', vm_out);
6736 }
6737 #endif
6738 NEXT_P1;
6739 sp += -1;
6740 vm_w2Cell(w,sp[0]);
6741 LABEL2(pick)
6742 NEXT_P1_5;
6743 LABEL3(pick)
6744 DO_GOTO;
6745 }
6746 
6747 LABEL(two_drop) /* 2drop ( w1 w2 -- ) S0 -- S0  */
6748 /*  */
6749 NAME("2drop")
6750 {
6751 DEF_CA
6752 MAYBE_UNUSED Cell w1;
6753 MAYBE_UNUSED Cell w2;
6754 NEXT_P0;
6755 vm_Cell2w(sp[1],w1);
6756 vm_Cell2w(sp[0],w2);
6757 #ifdef VM_DEBUG
6758 if (vm_debug) {
6759 fputs(" w1=", vm_out); printarg_w(w1);
6760 fputs(" w2=", vm_out); printarg_w(w2);
6761 }
6762 #endif
6763 sp += 2;
6764 {
6765 #line 1310 "prim"
6766 #line 6767 "prim.i"
6767 }
6768 
6769 #ifdef VM_DEBUG
6770 if (vm_debug) {
6771 fputs(" -- ", vm_out); fputc('\n', vm_out);
6772 }
6773 #endif
6774 NEXT_P1;
6775 LABEL2(two_drop)
6776 NEXT_P1_5;
6777 LABEL3(two_drop)
6778 DO_GOTO;
6779 }
6780 
6781 LABEL(two_dupe) /* 2dup ( w1 w2 -- w1 w2 w1 w2 ) S0 -- S0  */
6782 /*  */
6783 NAME("2dup")
6784 {
6785 DEF_CA
6786 MAYBE_UNUSED Cell w1;
6787 MAYBE_UNUSED Cell w2;
6788 NEXT_P0;
6789 vm_Cell2w(sp[1],w1);
6790 vm_Cell2w(sp[0],w2);
6791 #ifdef VM_DEBUG
6792 if (vm_debug) {
6793 fputs(" w1=", vm_out); printarg_w(w1);
6794 fputs(" w2=", vm_out); printarg_w(w2);
6795 }
6796 #endif
6797 sp += -2;
6798 {
6799 #line 1314 "prim"
6800 #line 6801 "prim.i"
6801 }
6802 
6803 #ifdef VM_DEBUG
6804 if (vm_debug) {
6805 fputs(" -- ", vm_out); fputc('\n', vm_out);
6806 }
6807 #endif
6808 NEXT_P1;
6809 vm_w2Cell(w1,sp[1]);
6810 vm_w2Cell(w2,sp[0]);
6811 LABEL2(two_dupe)
6812 NEXT_P1_5;
6813 LABEL3(two_dupe)
6814 DO_GOTO;
6815 }
6816 
6817 LABEL(two_over) /* 2over ( w1 w2 w3 w4 -- w1 w2 w3 w4 w1 w2 ) S0 -- S0  */
6818 /*  */
6819 NAME("2over")
6820 {
6821 DEF_CA
6822 MAYBE_UNUSED Cell w1;
6823 MAYBE_UNUSED Cell w2;
6824 MAYBE_UNUSED Cell w3;
6825 MAYBE_UNUSED Cell w4;
6826 NEXT_P0;
6827 vm_Cell2w(sp[3],w1);
6828 vm_Cell2w(sp[2],w2);
6829 vm_Cell2w(sp[1],w3);
6830 vm_Cell2w(sp[0],w4);
6831 #ifdef VM_DEBUG
6832 if (vm_debug) {
6833 fputs(" w1=", vm_out); printarg_w(w1);
6834 fputs(" w2=", vm_out); printarg_w(w2);
6835 fputs(" w3=", vm_out); printarg_w(w3);
6836 fputs(" w4=", vm_out); printarg_w(w4);
6837 }
6838 #endif
6839 sp += -2;
6840 {
6841 #line 1318 "prim"
6842 #line 6843 "prim.i"
6843 }
6844 
6845 #ifdef VM_DEBUG
6846 if (vm_debug) {
6847 fputs(" -- ", vm_out); fputc('\n', vm_out);
6848 }
6849 #endif
6850 NEXT_P1;
6851 vm_w2Cell(w1,sp[1]);
6852 vm_w2Cell(w2,sp[0]);
6853 LABEL2(two_over)
6854 NEXT_P1_5;
6855 LABEL3(two_over)
6856 DO_GOTO;
6857 }
6858 
6859 LABEL(two_swap) /* 2swap ( w1 w2 w3 w4 -- w3 w4 w1 w2 ) S0 -- S0  */
6860 /*  */
6861 NAME("2swap")
6862 {
6863 DEF_CA
6864 MAYBE_UNUSED Cell w1;
6865 MAYBE_UNUSED Cell w2;
6866 MAYBE_UNUSED Cell w3;
6867 MAYBE_UNUSED Cell w4;
6868 NEXT_P0;
6869 vm_Cell2w(sp[3],w1);
6870 vm_Cell2w(sp[2],w2);
6871 vm_Cell2w(sp[1],w3);
6872 vm_Cell2w(sp[0],w4);
6873 #ifdef VM_DEBUG
6874 if (vm_debug) {
6875 fputs(" w1=", vm_out); printarg_w(w1);
6876 fputs(" w2=", vm_out); printarg_w(w2);
6877 fputs(" w3=", vm_out); printarg_w(w3);
6878 fputs(" w4=", vm_out); printarg_w(w4);
6879 }
6880 #endif
6881 {
6882 #line 1322 "prim"
6883 #line 6884 "prim.i"
6884 }
6885 
6886 #ifdef VM_DEBUG
6887 if (vm_debug) {
6888 fputs(" -- ", vm_out); fputc('\n', vm_out);
6889 }
6890 #endif
6891 NEXT_P1;
6892 vm_w2Cell(w3,sp[3]);
6893 vm_w2Cell(w4,sp[2]);
6894 vm_w2Cell(w1,sp[1]);
6895 vm_w2Cell(w2,sp[0]);
6896 LABEL2(two_swap)
6897 NEXT_P1_5;
6898 LABEL3(two_swap)
6899 DO_GOTO;
6900 }
6901 
6902 LABEL(two_rote) /* 2rot ( w1 w2 w3 w4 w5 w6 -- w3 w4 w5 w6 w1 w2 ) S0 -- S0  */
6903 /*  */
6904 NAME("2rot")
6905 {
6906 DEF_CA
6907 MAYBE_UNUSED Cell w1;
6908 MAYBE_UNUSED Cell w2;
6909 MAYBE_UNUSED Cell w3;
6910 MAYBE_UNUSED Cell w4;
6911 MAYBE_UNUSED Cell w5;
6912 MAYBE_UNUSED Cell w6;
6913 NEXT_P0;
6914 vm_Cell2w(sp[5],w1);
6915 vm_Cell2w(sp[4],w2);
6916 vm_Cell2w(sp[3],w3);
6917 vm_Cell2w(sp[2],w4);
6918 vm_Cell2w(sp[1],w5);
6919 vm_Cell2w(sp[0],w6);
6920 #ifdef VM_DEBUG
6921 if (vm_debug) {
6922 fputs(" w1=", vm_out); printarg_w(w1);
6923 fputs(" w2=", vm_out); printarg_w(w2);
6924 fputs(" w3=", vm_out); printarg_w(w3);
6925 fputs(" w4=", vm_out); printarg_w(w4);
6926 fputs(" w5=", vm_out); printarg_w(w5);
6927 fputs(" w6=", vm_out); printarg_w(w6);
6928 }
6929 #endif
6930 {
6931 #line 1326 "prim"
6932 #line 6933 "prim.i"
6933 }
6934 
6935 #ifdef VM_DEBUG
6936 if (vm_debug) {
6937 fputs(" -- ", vm_out); fputc('\n', vm_out);
6938 }
6939 #endif
6940 NEXT_P1;
6941 vm_w2Cell(w3,sp[5]);
6942 vm_w2Cell(w4,sp[4]);
6943 vm_w2Cell(w5,sp[3]);
6944 vm_w2Cell(w6,sp[2]);
6945 vm_w2Cell(w1,sp[1]);
6946 vm_w2Cell(w2,sp[0]);
6947 LABEL2(two_rote)
6948 NEXT_P1_5;
6949 LABEL3(two_rote)
6950 DO_GOTO;
6951 }
6952 
6953 LABEL(two_nip) /* 2nip ( w1 w2 w3 w4 -- w3 w4 ) S0 -- S0  */
6954 /*  */
6955 NAME("2nip")
6956 {
6957 DEF_CA
6958 MAYBE_UNUSED Cell w1;
6959 MAYBE_UNUSED Cell w2;
6960 MAYBE_UNUSED Cell w3;
6961 MAYBE_UNUSED Cell w4;
6962 NEXT_P0;
6963 vm_Cell2w(sp[3],w1);
6964 vm_Cell2w(sp[2],w2);
6965 vm_Cell2w(sp[1],w3);
6966 vm_Cell2w(sp[0],w4);
6967 #ifdef VM_DEBUG
6968 if (vm_debug) {
6969 fputs(" w1=", vm_out); printarg_w(w1);
6970 fputs(" w2=", vm_out); printarg_w(w2);
6971 fputs(" w3=", vm_out); printarg_w(w3);
6972 fputs(" w4=", vm_out); printarg_w(w4);
6973 }
6974 #endif
6975 sp += 2;
6976 {
6977 #line 1330 "prim"
6978 #line 6979 "prim.i"
6979 }
6980 
6981 #ifdef VM_DEBUG
6982 if (vm_debug) {
6983 fputs(" -- ", vm_out); fputc('\n', vm_out);
6984 }
6985 #endif
6986 NEXT_P1;
6987 vm_w2Cell(w3,sp[1]);
6988 vm_w2Cell(w4,sp[0]);
6989 LABEL2(two_nip)
6990 NEXT_P1_5;
6991 LABEL3(two_nip)
6992 DO_GOTO;
6993 }
6994 
6995 LABEL(two_tuck) /* 2tuck ( w1 w2 w3 w4 -- w3 w4 w1 w2 w3 w4 ) S0 -- S0  */
6996 /*  */
6997 NAME("2tuck")
6998 {
6999 DEF_CA
7000 MAYBE_UNUSED Cell w1;
7001 MAYBE_UNUSED Cell w2;
7002 MAYBE_UNUSED Cell w3;
7003 MAYBE_UNUSED Cell w4;
7004 NEXT_P0;
7005 vm_Cell2w(sp[3],w1);
7006 vm_Cell2w(sp[2],w2);
7007 vm_Cell2w(sp[1],w3);
7008 vm_Cell2w(sp[0],w4);
7009 #ifdef VM_DEBUG
7010 if (vm_debug) {
7011 fputs(" w1=", vm_out); printarg_w(w1);
7012 fputs(" w2=", vm_out); printarg_w(w2);
7013 fputs(" w3=", vm_out); printarg_w(w3);
7014 fputs(" w4=", vm_out); printarg_w(w4);
7015 }
7016 #endif
7017 sp += -2;
7018 {
7019 #line 1334 "prim"
7020 #line 7021 "prim.i"
7021 }
7022 
7023 #ifdef VM_DEBUG
7024 if (vm_debug) {
7025 fputs(" -- ", vm_out); fputc('\n', vm_out);
7026 }
7027 #endif
7028 NEXT_P1;
7029 vm_w2Cell(w3,sp[5]);
7030 vm_w2Cell(w4,sp[4]);
7031 vm_w2Cell(w1,sp[3]);
7032 vm_w2Cell(w2,sp[2]);
7033 vm_w2Cell(w3,sp[1]);
7034 vm_w2Cell(w4,sp[0]);
7035 LABEL2(two_tuck)
7036 NEXT_P1_5;
7037 LABEL3(two_tuck)
7038 DO_GOTO;
7039 }
7040 
7041 GROUPADD(24)
7042 GROUP( memory, 157)
LABEL(fetch)7043 LABEL(fetch) /* @ ( a_addr -- w ) S0 -- S0  */
7044 /* @i{w} is the cell stored at @i{a_addr}. */
7045 NAME("@")
7046 {
7047 DEF_CA
7048 MAYBE_UNUSED Cell * a_addr;
7049 Cell w;
7050 NEXT_P0;
7051 vm_Cell2a_(sp[0],a_addr);
7052 #ifdef VM_DEBUG
7053 if (vm_debug) {
7054 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7055 }
7056 #endif
7057 {
7058 #line 1343 "prim"
7059 w = *a_addr;
7060 #line 7061 "prim.i"
7061 }
7062 
7063 #ifdef VM_DEBUG
7064 if (vm_debug) {
7065 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
7066 fputc('\n', vm_out);
7067 }
7068 #endif
7069 NEXT_P1;
7070 vm_w2Cell(w,sp[0]);
7071 LABEL2(fetch)
7072 NEXT_P1_5;
7073 LABEL3(fetch)
7074 DO_GOTO;
7075 }
7076 
7077 LABEL(lit_fetch) /* lit@ ( #a_addr -- w ) S0 -- S0  */
7078 /*  */
7079 NAME("lit@")
7080 {
7081 DEF_CA
7082 MAYBE_UNUSED Cell * a_addr;
7083 Cell w;
7084 NEXT_P0;
7085 vm_Cell2a_(IMM_ARG(IPTOS,305397794 ),a_addr);
7086 #ifdef VM_DEBUG
7087 if (vm_debug) {
7088 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7089 }
7090 #endif
7091 INC_IP(1);
7092 sp += -1;
7093 {
7094 #line 1348 "prim"
7095 w = *a_addr;
7096 #line 7097 "prim.i"
7097 }
7098 
7099 #ifdef VM_DEBUG
7100 if (vm_debug) {
7101 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
7102 fputc('\n', vm_out);
7103 }
7104 #endif
7105 NEXT_P1;
7106 vm_w2Cell(w,sp[0]);
7107 LABEL2(lit_fetch)
7108 NEXT_P1_5;
7109 LABEL3(lit_fetch)
7110 DO_GOTO;
7111 }
7112 
7113 LABEL(store) /* ! ( w a_addr -- ) S0 -- S0  */
7114 /* Store @i{w} into the cell at @i{a-addr}. */
7115 NAME("!")
7116 {
7117 DEF_CA
7118 MAYBE_UNUSED Cell w;
7119 MAYBE_UNUSED Cell * a_addr;
7120 NEXT_P0;
7121 vm_Cell2w(sp[1],w);
7122 vm_Cell2a_(sp[0],a_addr);
7123 #ifdef VM_DEBUG
7124 if (vm_debug) {
7125 fputs(" w=", vm_out); printarg_w(w);
7126 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7127 }
7128 #endif
7129 sp += 2;
7130 {
7131 #line 1352 "prim"
7132 *a_addr = w;
7133 #line 7134 "prim.i"
7134 }
7135 
7136 #ifdef VM_DEBUG
7137 if (vm_debug) {
7138 fputs(" -- ", vm_out); fputc('\n', vm_out);
7139 }
7140 #endif
7141 NEXT_P1;
7142 LABEL2(store)
7143 NEXT_P1_5;
7144 LABEL3(store)
7145 DO_GOTO;
7146 }
7147 
7148 LABEL(plus_store) /* +! ( n a_addr -- ) S0 -- S0  */
7149 /* Add @i{n} to the cell at @i{a-addr}. */
7150 NAME("+!")
7151 {
7152 DEF_CA
7153 MAYBE_UNUSED Cell n;
7154 MAYBE_UNUSED Cell * a_addr;
7155 NEXT_P0;
7156 vm_Cell2n(sp[1],n);
7157 vm_Cell2a_(sp[0],a_addr);
7158 #ifdef VM_DEBUG
7159 if (vm_debug) {
7160 fputs(" n=", vm_out); printarg_n(n);
7161 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7162 }
7163 #endif
7164 sp += 2;
7165 {
7166 #line 1356 "prim"
7167 *a_addr += n;
7168 #line 7169 "prim.i"
7169 }
7170 
7171 #ifdef VM_DEBUG
7172 if (vm_debug) {
7173 fputs(" -- ", vm_out); fputc('\n', vm_out);
7174 }
7175 #endif
7176 NEXT_P1;
7177 LABEL2(plus_store)
7178 NEXT_P1_5;
7179 LABEL3(plus_store)
7180 DO_GOTO;
7181 }
7182 
7183 LABEL(c_fetch) /* c@ ( c_addr -- c ) S0 -- S0  */
7184 /* @i{c} is the char stored at @i{c_addr}. */
7185 NAME("c@")
7186 {
7187 DEF_CA
7188 MAYBE_UNUSED Char * c_addr;
7189 Char c;
7190 NEXT_P0;
7191 vm_Cell2c_(sp[0],c_addr);
7192 #ifdef VM_DEBUG
7193 if (vm_debug) {
7194 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7195 }
7196 #endif
7197 {
7198 #line 1362 "prim"
7199 c = *c_addr;
7200 #line 7201 "prim.i"
7201 }
7202 
7203 #ifdef VM_DEBUG
7204 if (vm_debug) {
7205 fputs(" -- ", vm_out); fputs(" c=", vm_out); printarg_c(c);
7206 fputc('\n', vm_out);
7207 }
7208 #endif
7209 NEXT_P1;
7210 vm_c2Cell(c,sp[0]);
7211 LABEL2(c_fetch)
7212 NEXT_P1_5;
7213 LABEL3(c_fetch)
7214 DO_GOTO;
7215 }
7216 
7217 LABEL(c_store) /* c! ( c c_addr -- ) S0 -- S0  */
7218 /* Store @i{c} into the char at @i{c-addr}. */
7219 NAME("c!")
7220 {
7221 DEF_CA
7222 MAYBE_UNUSED Char c;
7223 MAYBE_UNUSED Char * c_addr;
7224 NEXT_P0;
7225 vm_Cell2c(sp[1],c);
7226 vm_Cell2c_(sp[0],c_addr);
7227 #ifdef VM_DEBUG
7228 if (vm_debug) {
7229 fputs(" c=", vm_out); printarg_c(c);
7230 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7231 }
7232 #endif
7233 sp += 2;
7234 {
7235 #line 1388 "prim"
7236 *c_addr = c;
7237 #line 7238 "prim.i"
7238 }
7239 
7240 #ifdef VM_DEBUG
7241 if (vm_debug) {
7242 fputs(" -- ", vm_out); fputc('\n', vm_out);
7243 }
7244 #endif
7245 NEXT_P1;
7246 LABEL2(c_store)
7247 NEXT_P1_5;
7248 LABEL3(c_store)
7249 DO_GOTO;
7250 }
7251 
7252 LABEL(two_store) /* 2! ( w1 w2 a_addr -- ) S0 -- S0  */
7253 /* Store @i{w2} into the cell at @i{c-addr} and @i{w1} into the next cell. */
7254 NAME("2!")
7255 {
7256 DEF_CA
7257 MAYBE_UNUSED Cell w1;
7258 MAYBE_UNUSED Cell w2;
7259 MAYBE_UNUSED Cell * a_addr;
7260 NEXT_P0;
7261 vm_Cell2w(sp[2],w1);
7262 vm_Cell2w(sp[1],w2);
7263 vm_Cell2a_(sp[0],a_addr);
7264 #ifdef VM_DEBUG
7265 if (vm_debug) {
7266 fputs(" w1=", vm_out); printarg_w(w1);
7267 fputs(" w2=", vm_out); printarg_w(w2);
7268 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7269 }
7270 #endif
7271 sp += 3;
7272 {
7273 #line 1418 "prim"
7274 a_addr[0] = w2;
7275 a_addr[1] = w1;
7276 #line 7277 "prim.i"
7277 }
7278 
7279 #ifdef VM_DEBUG
7280 if (vm_debug) {
7281 fputs(" -- ", vm_out); fputc('\n', vm_out);
7282 }
7283 #endif
7284 NEXT_P1;
7285 LABEL2(two_store)
7286 NEXT_P1_5;
7287 LABEL3(two_store)
7288 DO_GOTO;
7289 }
7290 
7291 LABEL(two_fetch) /* 2@ ( a_addr -- w1 w2 ) S0 -- S0  */
7292 /* @i{w2} is the content of the cell stored at @i{a-addr}, @i{w1} is
7293 the content of the next cell. */
7294 NAME("2@")
7295 {
7296 DEF_CA
7297 MAYBE_UNUSED Cell * a_addr;
7298 Cell w1;
7299 Cell w2;
7300 NEXT_P0;
7301 vm_Cell2a_(sp[0],a_addr);
7302 #ifdef VM_DEBUG
7303 if (vm_debug) {
7304 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7305 }
7306 #endif
7307 sp += -1;
7308 {
7309 #line 1426 "prim"
7310 w2 = a_addr[0];
7311 w1 = a_addr[1];
7312 #line 7313 "prim.i"
7313 }
7314 
7315 #ifdef VM_DEBUG
7316 if (vm_debug) {
7317 fputs(" -- ", vm_out); fputs(" w1=", vm_out); printarg_w(w1);
7318 fputs(" w2=", vm_out); printarg_w(w2);
7319 fputc('\n', vm_out);
7320 }
7321 #endif
7322 NEXT_P1;
7323 vm_w2Cell(w1,sp[1]);
7324 vm_w2Cell(w2,sp[0]);
7325 LABEL2(two_fetch)
7326 NEXT_P1_5;
7327 LABEL3(two_fetch)
7328 DO_GOTO;
7329 }
7330 
7331 LABEL(cell_plus) /* cell+ ( a_addr1 -- a_addr2 ) S0 -- S0  */
7332 /* @code{1 cells +} */
7333 NAME("cell+")
7334 {
7335 DEF_CA
7336 MAYBE_UNUSED Cell * a_addr1;
7337 Cell * a_addr2;
7338 NEXT_P0;
7339 vm_Cell2a_(sp[0],a_addr1);
7340 #ifdef VM_DEBUG
7341 if (vm_debug) {
7342 fputs(" a_addr1=", vm_out); printarg_a_(a_addr1);
7343 }
7344 #endif
7345 {
7346 #line 1433 "prim"
7347 a_addr2 = a_addr1+1;
7348 #line 7349 "prim.i"
7349 }
7350 
7351 #ifdef VM_DEBUG
7352 if (vm_debug) {
7353 fputs(" -- ", vm_out); fputs(" a_addr2=", vm_out); printarg_a_(a_addr2);
7354 fputc('\n', vm_out);
7355 }
7356 #endif
7357 NEXT_P1;
7358 vm_a_2Cell(a_addr2,sp[0]);
7359 LABEL2(cell_plus)
7360 NEXT_P1_5;
7361 LABEL3(cell_plus)
7362 DO_GOTO;
7363 }
7364 
7365 LABEL(cells) /* cells ( n1 -- n2 ) S0 -- S0  */
7366 /*  @i{n2} is the number of address units of @i{n1} cells. */
7367 NAME("cells")
7368 {
7369 DEF_CA
7370 MAYBE_UNUSED Cell n1;
7371 Cell n2;
7372 NEXT_P0;
7373 vm_Cell2n(sp[0],n1);
7374 #ifdef VM_DEBUG
7375 if (vm_debug) {
7376 fputs(" n1=", vm_out); printarg_n(n1);
7377 }
7378 #endif
7379 {
7380 #line 1439 "prim"
7381 n2 = n1 * sizeof(Cell);
7382 #line 7383 "prim.i"
7383 }
7384 
7385 #ifdef VM_DEBUG
7386 if (vm_debug) {
7387 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
7388 fputc('\n', vm_out);
7389 }
7390 #endif
7391 NEXT_P1;
7392 vm_n2Cell(n2,sp[0]);
7393 LABEL2(cells)
7394 NEXT_P1_5;
7395 LABEL3(cells)
7396 DO_GOTO;
7397 }
7398 
7399 LABEL(char_plus) /* char+ ( c_addr1 -- c_addr2 ) S0 -- S0  */
7400 /* @code{1 chars +}. */
7401 NAME("char+")
7402 {
7403 DEF_CA
7404 MAYBE_UNUSED Char * c_addr1;
7405 Char * c_addr2;
7406 NEXT_P0;
7407 vm_Cell2c_(sp[0],c_addr1);
7408 #ifdef VM_DEBUG
7409 if (vm_debug) {
7410 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
7411 }
7412 #endif
7413 {
7414 #line 1450 "prim"
7415 c_addr2 = c_addr1 + 1;
7416 #line 7417 "prim.i"
7417 }
7418 
7419 #ifdef VM_DEBUG
7420 if (vm_debug) {
7421 fputs(" -- ", vm_out); fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
7422 fputc('\n', vm_out);
7423 }
7424 #endif
7425 NEXT_P1;
7426 vm_c_2Cell(c_addr2,sp[0]);
7427 LABEL2(char_plus)
7428 NEXT_P1_5;
7429 LABEL3(char_plus)
7430 DO_GOTO;
7431 }
7432 
7433 LABEL(paren_chars) /* (chars) ( n1 -- n2 ) S0 -- S0  */
7434 /*  */
7435 NAME("(chars)")
7436 {
7437 DEF_CA
7438 MAYBE_UNUSED Cell n1;
7439 Cell n2;
7440 NEXT_P0;
7441 vm_Cell2n(sp[0],n1);
7442 #ifdef VM_DEBUG
7443 if (vm_debug) {
7444 fputs(" n1=", vm_out); printarg_n(n1);
7445 }
7446 #endif
7447 {
7448 #line 1455 "prim"
7449 n2 = n1 * sizeof(Char);
7450 #line 7451 "prim.i"
7451 }
7452 
7453 #ifdef VM_DEBUG
7454 if (vm_debug) {
7455 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
7456 fputc('\n', vm_out);
7457 }
7458 #endif
7459 NEXT_P1;
7460 vm_n2Cell(n2,sp[0]);
7461 LABEL2(paren_chars)
7462 NEXT_P1_5;
7463 LABEL3(paren_chars)
7464 DO_GOTO;
7465 }
7466 
7467 LABEL(count) /* count ( c_addr1 -- c_addr2 u ) S0 -- S0  */
7468 /* @i{c-addr2} is the first character and @i{u} the length of the
7469 counted string at @i{c-addr1}. */
7470 NAME("count")
7471 {
7472 DEF_CA
7473 MAYBE_UNUSED Char * c_addr1;
7474 Char * c_addr2;
7475 UCell u;
7476 NEXT_P0;
7477 vm_Cell2c_(sp[0],c_addr1);
7478 #ifdef VM_DEBUG
7479 if (vm_debug) {
7480 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
7481 }
7482 #endif
7483 sp += -1;
7484 {
7485 #line 1462 "prim"
7486 u = *c_addr1;
7487 c_addr2 = c_addr1+1;
7488 #line 7489 "prim.i"
7489 }
7490 
7491 #ifdef VM_DEBUG
7492 if (vm_debug) {
7493 fputs(" -- ", vm_out); fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
7494 fputs(" u=", vm_out); printarg_u(u);
7495 fputc('\n', vm_out);
7496 }
7497 #endif
7498 NEXT_P1;
7499 vm_c_2Cell(c_addr2,sp[1]);
7500 vm_u2Cell(u,sp[0]);
7501 LABEL2(count)
7502 NEXT_P1_5;
7503 LABEL3(count)
7504 DO_GOTO;
7505 }
7506 
7507 GROUPADD(13)
7508 GROUP( compiler, 170)
7509 GROUPADD(0)
7510 #ifdef HAS_F83HEADERSTRING
LABEL(paren_f83find)7511 LABEL(paren_f83find) /* (f83find) ( c_addr u f83name1 -- f83name2 ) S0 -- S0  */
7512 /*  */
7513 NAME("(f83find)")
7514 {
7515 DEF_CA
7516 MAYBE_UNUSED Char * c_addr;
7517 MAYBE_UNUSED UCell u;
7518 MAYBE_UNUSED struct F83Name * f83name1;
7519 struct F83Name * f83name2;
7520 NEXT_P0;
7521 vm_Cell2c_(sp[2],c_addr);
7522 vm_Cell2u(sp[1],u);
7523 vm_Cell2f83name(sp[0],f83name1);
7524 #ifdef VM_DEBUG
7525 if (vm_debug) {
7526 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7527 fputs(" u=", vm_out); printarg_u(u);
7528 fputs(" f83name1=", vm_out); printarg_f83name(f83name1);
7529 }
7530 #endif
7531 sp += 2;
7532 {
7533 #line 1472 "prim"
7534 for (; f83name1 != NULL; f83name1 = (struct F83Name *)(f83name1->next))
7535   if ((UCell)F83NAME_COUNT(f83name1)==u &&
7536       memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
7537     break;
7538 f83name2=f83name1;
7539 #ifdef DEBUG
7540 fprintf(stderr, "F83find ");
7541 fwrite(c_addr, u, 1, stderr);
7542 fprintf(stderr, " found %08x\n", f83name2);
7543 #endif
7544 #line 7545 "prim.i"
7545 }
7546 
7547 #ifdef VM_DEBUG
7548 if (vm_debug) {
7549 fputs(" -- ", vm_out); fputs(" f83name2=", vm_out); printarg_f83name(f83name2);
7550 fputc('\n', vm_out);
7551 }
7552 #endif
7553 NEXT_P1;
7554 vm_f83name2Cell(f83name2,sp[0]);
7555 LABEL2(paren_f83find)
7556 NEXT_P1_5;
7557 LABEL3(paren_f83find)
7558 DO_GOTO;
7559 }
7560 
7561 GROUPADD(1)
7562 #else /* 171 */
7563 LABEL(paren_listlfind) /* (listlfind) ( c_addr u longname1 -- longname2 ) S0 -- S0  */
7564 /*  */
7565 NAME("(listlfind)")
7566 {
7567 DEF_CA
7568 MAYBE_UNUSED Char * c_addr;
7569 MAYBE_UNUSED UCell u;
7570 MAYBE_UNUSED struct Longname * longname1;
7571 struct Longname * longname2;
7572 NEXT_P0;
7573 vm_Cell2c_(sp[2],c_addr);
7574 vm_Cell2u(sp[1],u);
7575 vm_Cell2longname(sp[0],longname1);
7576 #ifdef VM_DEBUG
7577 if (vm_debug) {
7578 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7579 fputs(" u=", vm_out); printarg_u(u);
7580 fputs(" longname1=", vm_out); printarg_longname(longname1);
7581 }
7582 #endif
7583 sp += 2;
7584 {
7585 #line 1502 "prim"
7586 longname2=listlfind(c_addr, u, longname1);
7587 #line 7588 "prim.i"
7588 }
7589 
7590 #ifdef VM_DEBUG
7591 if (vm_debug) {
7592 fputs(" -- ", vm_out); fputs(" longname2=", vm_out); printarg_longname(longname2);
7593 fputc('\n', vm_out);
7594 }
7595 #endif
7596 NEXT_P1;
7597 vm_longname2Cell(longname2,sp[0]);
7598 LABEL2(paren_listlfind)
7599 NEXT_P1_5;
7600 LABEL3(paren_listlfind)
7601 DO_GOTO;
7602 }
7603 
7604 GROUPADD(1)
7605 #ifdef HAS_HASH
7606 LABEL(paren_hashlfind) /* (hashlfind) ( c_addr u a_addr -- longname2 ) S0 -- S0  */
7607 /*  */
7608 NAME("(hashlfind)")
7609 {
7610 DEF_CA
7611 MAYBE_UNUSED Char * c_addr;
7612 MAYBE_UNUSED UCell u;
7613 MAYBE_UNUSED Cell * a_addr;
7614 struct Longname * longname2;
7615 NEXT_P0;
7616 vm_Cell2c_(sp[2],c_addr);
7617 vm_Cell2u(sp[1],u);
7618 vm_Cell2a_(sp[0],a_addr);
7619 #ifdef VM_DEBUG
7620 if (vm_debug) {
7621 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7622 fputs(" u=", vm_out); printarg_u(u);
7623 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7624 }
7625 #endif
7626 sp += 2;
7627 {
7628 #line 1523 "prim"
7629 longname2 = hashlfind(c_addr, u, a_addr);
7630 #line 7631 "prim.i"
7631 }
7632 
7633 #ifdef VM_DEBUG
7634 if (vm_debug) {
7635 fputs(" -- ", vm_out); fputs(" longname2=", vm_out); printarg_longname(longname2);
7636 fputc('\n', vm_out);
7637 }
7638 #endif
7639 NEXT_P1;
7640 vm_longname2Cell(longname2,sp[0]);
7641 LABEL2(paren_hashlfind)
7642 NEXT_P1_5;
7643 LABEL3(paren_hashlfind)
7644 DO_GOTO;
7645 }
7646 
7647 LABEL(paren_tablelfind) /* (tablelfind) ( c_addr u a_addr -- longname2 ) S0 -- S0  */
7648 /* A case-sensitive variant of @code{(hashfind)} */
7649 NAME("(tablelfind)")
7650 {
7651 DEF_CA
7652 MAYBE_UNUSED Char * c_addr;
7653 MAYBE_UNUSED UCell u;
7654 MAYBE_UNUSED Cell * a_addr;
7655 struct Longname * longname2;
7656 NEXT_P0;
7657 vm_Cell2c_(sp[2],c_addr);
7658 vm_Cell2u(sp[1],u);
7659 vm_Cell2a_(sp[0],a_addr);
7660 #ifdef VM_DEBUG
7661 if (vm_debug) {
7662 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7663 fputs(" u=", vm_out); printarg_u(u);
7664 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7665 }
7666 #endif
7667 sp += 2;
7668 {
7669 #line 1534 "prim"
7670 longname2 = tablelfind(c_addr, u, a_addr);
7671 #line 7672 "prim.i"
7672 }
7673 
7674 #ifdef VM_DEBUG
7675 if (vm_debug) {
7676 fputs(" -- ", vm_out); fputs(" longname2=", vm_out); printarg_longname(longname2);
7677 fputc('\n', vm_out);
7678 }
7679 #endif
7680 NEXT_P1;
7681 vm_longname2Cell(longname2,sp[0]);
7682 LABEL2(paren_tablelfind)
7683 NEXT_P1_5;
7684 LABEL3(paren_tablelfind)
7685 DO_GOTO;
7686 }
7687 
7688 LABEL(paren_hashkey1) /* (hashkey1) ( c_addr u ubits -- ukey ) S0 -- S0  */
7689 /* ukey is the hash key for the string c_addr u fitting in ubits bits */
7690 NAME("(hashkey1)")
7691 {
7692 DEF_CA
7693 MAYBE_UNUSED Char * c_addr;
7694 MAYBE_UNUSED UCell u;
7695 MAYBE_UNUSED UCell ubits;
7696 UCell ukey;
7697 NEXT_P0;
7698 vm_Cell2c_(sp[2],c_addr);
7699 vm_Cell2u(sp[1],u);
7700 vm_Cell2u(sp[0],ubits);
7701 #ifdef VM_DEBUG
7702 if (vm_debug) {
7703 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7704 fputs(" u=", vm_out); printarg_u(u);
7705 fputs(" ubits=", vm_out); printarg_u(ubits);
7706 }
7707 #endif
7708 sp += 2;
7709 {
7710 #line 1551 "prim"
7711 ukey = hashkey1(c_addr, u, ubits);
7712 #line 7713 "prim.i"
7713 }
7714 
7715 #ifdef VM_DEBUG
7716 if (vm_debug) {
7717 fputs(" -- ", vm_out); fputs(" ukey=", vm_out); printarg_u(ukey);
7718 fputc('\n', vm_out);
7719 }
7720 #endif
7721 NEXT_P1;
7722 vm_u2Cell(ukey,sp[0]);
7723 LABEL2(paren_hashkey1)
7724 NEXT_P1_5;
7725 LABEL3(paren_hashkey1)
7726 DO_GOTO;
7727 }
7728 
7729 GROUPADD(3)
7730 #endif
7731 GROUPADD(0)
7732 #endif
LABEL(paren_parse_white)7733 LABEL(paren_parse_white) /* (parse-white) ( c_addr1 u1 -- c_addr2 u2 ) S0 -- S0  */
7734 /*  */
7735 NAME("(parse-white)")
7736 {
7737 DEF_CA
7738 MAYBE_UNUSED Char * c_addr1;
7739 MAYBE_UNUSED UCell u1;
7740 Char * c_addr2;
7741 UCell u2;
7742 NEXT_P0;
7743 vm_Cell2c_(sp[1],c_addr1);
7744 vm_Cell2u(sp[0],u1);
7745 #ifdef VM_DEBUG
7746 if (vm_debug) {
7747 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
7748 fputs(" u1=", vm_out); printarg_u(u1);
7749 }
7750 #endif
7751 {
7752 #line 1570 "prim"
7753 struct Cellpair r=parse_white(c_addr1, u1);
7754 c_addr2 = (Char *)(r.n1);
7755 u2 = r.n2;
7756 #line 7757 "prim.i"
7757 }
7758 
7759 #ifdef VM_DEBUG
7760 if (vm_debug) {
7761 fputs(" -- ", vm_out); fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
7762 fputs(" u2=", vm_out); printarg_u(u2);
7763 fputc('\n', vm_out);
7764 }
7765 #endif
7766 NEXT_P1;
7767 vm_c_2Cell(c_addr2,sp[1]);
7768 vm_u2Cell(u2,sp[0]);
7769 LABEL2(paren_parse_white)
7770 NEXT_P1_5;
7771 LABEL3(paren_parse_white)
7772 DO_GOTO;
7773 }
7774 
7775 LABEL(aligned) /* aligned ( c_addr -- a_addr ) S0 -- S0  */
7776 /*  @i{a-addr} is the first aligned address greater than or equal to @i{c-addr}. */
7777 NAME("aligned")
7778 {
7779 DEF_CA
7780 MAYBE_UNUSED Char * c_addr;
7781 Cell * a_addr;
7782 NEXT_P0;
7783 vm_Cell2c_(sp[0],c_addr);
7784 #ifdef VM_DEBUG
7785 if (vm_debug) {
7786 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7787 }
7788 #endif
7789 {
7790 #line 1581 "prim"
7791 a_addr = (Cell *)((((Cell)c_addr)+(sizeof(Cell)-1))&(-sizeof(Cell)));
7792 #line 7793 "prim.i"
7793 }
7794 
7795 #ifdef VM_DEBUG
7796 if (vm_debug) {
7797 fputs(" -- ", vm_out); fputs(" a_addr=", vm_out); printarg_a_(a_addr);
7798 fputc('\n', vm_out);
7799 }
7800 #endif
7801 NEXT_P1;
7802 vm_a_2Cell(a_addr,sp[0]);
7803 LABEL2(aligned)
7804 NEXT_P1_5;
7805 LABEL3(aligned)
7806 DO_GOTO;
7807 }
7808 
7809 LABEL(f_aligned) /* faligned ( c_addr -- f_addr ) S0 -- S0  */
7810 /*  @i{f-addr} is the first float-aligned address greater than or equal to @i{c-addr}. */
7811 NAME("faligned")
7812 {
7813 DEF_CA
7814 MAYBE_UNUSED Char * c_addr;
7815 Float * f_addr;
7816 NEXT_P0;
7817 vm_Cell2c_(sp[0],c_addr);
7818 #ifdef VM_DEBUG
7819 if (vm_debug) {
7820 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
7821 }
7822 #endif
7823 {
7824 #line 1587 "prim"
7825 f_addr = (Float *)((((Cell)c_addr)+(sizeof(Float)-1))&(-sizeof(Float)));
7826 #line 7827 "prim.i"
7827 }
7828 
7829 #ifdef VM_DEBUG
7830 if (vm_debug) {
7831 fputs(" -- ", vm_out); fputs(" f_addr=", vm_out); printarg_f_(f_addr);
7832 fputc('\n', vm_out);
7833 }
7834 #endif
7835 NEXT_P1;
7836 vm_f_2Cell(f_addr,sp[0]);
7837 LABEL2(f_aligned)
7838 NEXT_P1_5;
7839 LABEL3(f_aligned)
7840 DO_GOTO;
7841 }
7842 
7843 LABEL(threading_method) /* threading-method ( -- n ) S0 -- S0  */
7844 /* 0 if the engine is direct threaded. Note that this may change during
7845 the lifetime of an image. */
7846 NAME("threading-method")
7847 {
7848 DEF_CA
7849 Cell n;
7850 NEXT_P0;
7851 #ifdef VM_DEBUG
7852 if (vm_debug) {
7853 }
7854 #endif
7855 sp += -1;
7856 {
7857 #line 1596 "prim"
7858 #if defined(DOUBLY_INDIRECT)
7859 n=2;
7860 #else
7861 # if defined(DIRECT_THREADED)
7862 n=0;
7863 # else
7864 n=1;
7865 # endif
7866 #endif
7867 #line 7868 "prim.i"
7868 }
7869 
7870 #ifdef VM_DEBUG
7871 if (vm_debug) {
7872 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
7873 fputc('\n', vm_out);
7874 }
7875 #endif
7876 NEXT_P1;
7877 vm_n2Cell(n,sp[0]);
7878 LABEL2(threading_method)
7879 NEXT_P1_5;
7880 LABEL3(threading_method)
7881 DO_GOTO;
7882 }
7883 
7884 GROUPADD(4)
7885 GROUP( hostos, 179)
LABEL(paren_key_file)7886 LABEL(paren_key_file) /* key-file ( wfileid -- c ) S0 -- S0  */
7887 /* Read one character @i{c} from @i{wfileid}.  This word disables
7888 buffering for @i{wfileid}.  If you want to read characters from a
7889 terminal in non-canonical (raw) mode, you have to put the terminal in
7890 non-canonical mode yourself (using the C interface); the exception is
7891 @code{stdin}: Gforth automatically puts it into non-canonical mode. */
7892 NAME("key-file")
7893 {
7894 DEF_CA
7895 MAYBE_UNUSED Cell wfileid;
7896 Char c;
7897 NEXT_P0;
7898 vm_Cell2w(sp[0],wfileid);
7899 #ifdef VM_DEBUG
7900 if (vm_debug) {
7901 fputs(" wfileid=", vm_out); printarg_w(wfileid);
7902 }
7903 #endif
7904 {
7905 #line 1618 "prim"
7906 #ifdef HAS_FILE
7907 fflush(stdout);
7908 c = key((FILE*)wfileid);
7909 #else
7910 c = key(stdin);
7911 #endif
7912 #line 7913 "prim.i"
7913 }
7914 
7915 #ifdef VM_DEBUG
7916 if (vm_debug) {
7917 fputs(" -- ", vm_out); fputs(" c=", vm_out); printarg_c(c);
7918 fputc('\n', vm_out);
7919 }
7920 #endif
7921 NEXT_P1;
7922 vm_c2Cell(c,sp[0]);
7923 LABEL2(paren_key_file)
7924 NEXT_P1_5;
7925 LABEL3(paren_key_file)
7926 DO_GOTO;
7927 }
7928 
7929 LABEL(key_q_file) /* key?-file ( wfileid -- f ) S0 -- S0  */
7930 /* @i{f} is true if at least one character can be read from @i{wfileid}
7931 without blocking.  If you also want to use @code{read-file} or
7932 @code{read-line} on the file, you have to call @code{key?-file} or
7933 @code{key-file} first (these two words disable buffering). */
7934 NAME("key?-file")
7935 {
7936 DEF_CA
7937 MAYBE_UNUSED Cell wfileid;
7938 Bool f;
7939 NEXT_P0;
7940 vm_Cell2w(sp[0],wfileid);
7941 #ifdef VM_DEBUG
7942 if (vm_debug) {
7943 fputs(" wfileid=", vm_out); printarg_w(wfileid);
7944 }
7945 #endif
7946 {
7947 #line 1630 "prim"
7948 #ifdef HAS_FILE
7949 fflush(stdout);
7950 f = key_query((FILE*)wfileid);
7951 #else
7952 f = key_query(stdin);
7953 #endif
7954 #line 7955 "prim.i"
7955 }
7956 
7957 #ifdef VM_DEBUG
7958 if (vm_debug) {
7959 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
7960 fputc('\n', vm_out);
7961 }
7962 #endif
7963 NEXT_P1;
7964 vm_f2Cell(f,sp[0]);
7965 LABEL2(key_q_file)
7966 NEXT_P1_5;
7967 LABEL3(key_q_file)
7968 DO_GOTO;
7969 }
7970 
7971 LABEL(stdin) /* stdin ( -- wfileid ) S0 -- S0  */
7972 /* The standard input file of the Gforth process. */
7973 NAME("stdin")
7974 {
7975 DEF_CA
7976 Cell wfileid;
7977 NEXT_P0;
7978 #ifdef VM_DEBUG
7979 if (vm_debug) {
7980 }
7981 #endif
7982 sp += -1;
7983 {
7984 #line 1639 "prim"
7985 wfileid = (Cell)stdin;
7986 #line 7987 "prim.i"
7987 }
7988 
7989 #ifdef VM_DEBUG
7990 if (vm_debug) {
7991 fputs(" -- ", vm_out); fputs(" wfileid=", vm_out); printarg_w(wfileid);
7992 fputc('\n', vm_out);
7993 }
7994 #endif
7995 NEXT_P1;
7996 vm_w2Cell(wfileid,sp[0]);
7997 LABEL2(stdin)
7998 NEXT_P1_5;
7999 LABEL3(stdin)
8000 DO_GOTO;
8001 }
8002 
8003 LABEL(stdout) /* stdout ( -- wfileid ) S0 -- S0  */
8004 /* The standard output file of the Gforth process. */
8005 NAME("stdout")
8006 {
8007 DEF_CA
8008 Cell wfileid;
8009 NEXT_P0;
8010 #ifdef VM_DEBUG
8011 if (vm_debug) {
8012 }
8013 #endif
8014 sp += -1;
8015 {
8016 #line 1643 "prim"
8017 wfileid = (Cell)stdout;
8018 #line 8019 "prim.i"
8019 }
8020 
8021 #ifdef VM_DEBUG
8022 if (vm_debug) {
8023 fputs(" -- ", vm_out); fputs(" wfileid=", vm_out); printarg_w(wfileid);
8024 fputc('\n', vm_out);
8025 }
8026 #endif
8027 NEXT_P1;
8028 vm_w2Cell(wfileid,sp[0]);
8029 LABEL2(stdout)
8030 NEXT_P1_5;
8031 LABEL3(stdout)
8032 DO_GOTO;
8033 }
8034 
8035 LABEL(stderr) /* stderr ( -- wfileid ) S0 -- S0  */
8036 /* The standard error output file of the Gforth process. */
8037 NAME("stderr")
8038 {
8039 DEF_CA
8040 Cell wfileid;
8041 NEXT_P0;
8042 #ifdef VM_DEBUG
8043 if (vm_debug) {
8044 }
8045 #endif
8046 sp += -1;
8047 {
8048 #line 1647 "prim"
8049 wfileid = (Cell)stderr;
8050 #line 8051 "prim.i"
8051 }
8052 
8053 #ifdef VM_DEBUG
8054 if (vm_debug) {
8055 fputs(" -- ", vm_out); fputs(" wfileid=", vm_out); printarg_w(wfileid);
8056 fputc('\n', vm_out);
8057 }
8058 #endif
8059 NEXT_P1;
8060 vm_w2Cell(wfileid,sp[0]);
8061 LABEL2(stderr)
8062 NEXT_P1_5;
8063 LABEL3(stderr)
8064 DO_GOTO;
8065 }
8066 
8067 GROUPADD(5)
8068 #ifdef HAS_OS
LABEL(form)8069 LABEL(form) /* form ( -- urows ucols ) S0 -- S0  */
8070 /* The number of lines and columns in the terminal. These numbers may
8071 change with the window size.  Note that it depends on the OS whether
8072 this reflects the actual size and changes with the window size
8073 (currently only on Unix-like OSs).  On other OSs you just get a
8074 default, and can tell Gforth the terminal size by setting the
8075 environment variables @code{COLUMNS} and @code{LINES} before starting
8076 Gforth. */
8077 NAME("form")
8078 {
8079 DEF_CA
8080 UCell urows;
8081 UCell ucols;
8082 NEXT_P0;
8083 #ifdef VM_DEBUG
8084 if (vm_debug) {
8085 }
8086 #endif
8087 sp += -2;
8088 {
8089 #line 1659 "prim"
8090 /* we could block SIGWINCH here to get a consistent size, but I don't
8091  think this is necessary or always beneficial */
8092 urows=rows;
8093 ucols=cols;
8094 #line 8095 "prim.i"
8095 }
8096 
8097 #ifdef VM_DEBUG
8098 if (vm_debug) {
8099 fputs(" -- ", vm_out); fputs(" urows=", vm_out); printarg_u(urows);
8100 fputs(" ucols=", vm_out); printarg_u(ucols);
8101 fputc('\n', vm_out);
8102 }
8103 #endif
8104 NEXT_P1;
8105 vm_u2Cell(urows,sp[1]);
8106 vm_u2Cell(ucols,sp[0]);
8107 LABEL2(form)
8108 NEXT_P1_5;
8109 LABEL3(form)
8110 DO_GOTO;
8111 }
8112 
8113 LABEL(wcwidth) /* wcwidth ( u -- n ) S0 -- S0  */
8114 /* The number of fixed-width characters per unicode character u */
8115 NAME("wcwidth")
8116 {
8117 DEF_CA
8118 MAYBE_UNUSED UCell u;
8119 Cell n;
8120 NEXT_P0;
8121 vm_Cell2u(sp[0],u);
8122 #ifdef VM_DEBUG
8123 if (vm_debug) {
8124 fputs(" u=", vm_out); printarg_u(u);
8125 }
8126 #endif
8127 {
8128 #line 1666 "prim"
8129 #ifdef HAVE_WCWIDTH
8130 n = wcwidth(u);
8131 #else
8132 n = 1;
8133 #endif
8134 #line 8135 "prim.i"
8135 }
8136 
8137 #ifdef VM_DEBUG
8138 if (vm_debug) {
8139 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
8140 fputc('\n', vm_out);
8141 }
8142 #endif
8143 NEXT_P1;
8144 vm_n2Cell(n,sp[0]);
8145 LABEL2(wcwidth)
8146 NEXT_P1_5;
8147 LABEL3(wcwidth)
8148 DO_GOTO;
8149 }
8150 
8151 LABEL(flush_icache) /* flush-icache ( c_addr u -- ) S0 -- S0  */
8152 /* Make sure that the instruction cache of the processor (if there is
8153 one) does not contain stale data at @i{c-addr} and @i{u} bytes
8154 afterwards. @code{END-CODE} performs a @code{flush-icache}
8155 automatically. Caveat: @code{flush-icache} might not work on your
8156 installation; this is usually the case if direct threading is not
8157 supported on your machine (take a look at your @file{machine.h}) and
8158 your machine has a separate instruction cache. In such cases,
8159 @code{flush-icache} does nothing instead of flushing the instruction
8160 cache. */
8161 NAME("flush-icache")
8162 {
8163 DEF_CA
8164 MAYBE_UNUSED Char * c_addr;
8165 MAYBE_UNUSED UCell u;
8166 NEXT_P0;
8167 vm_Cell2c_(sp[1],c_addr);
8168 vm_Cell2u(sp[0],u);
8169 #ifdef VM_DEBUG
8170 if (vm_debug) {
8171 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8172 fputs(" u=", vm_out); printarg_u(u);
8173 }
8174 #endif
8175 sp += 2;
8176 {
8177 #line 1682 "prim"
8178 FLUSH_ICACHE((caddr_t)c_addr,u);
8179 #line 8180 "prim.i"
8180 }
8181 
8182 #ifdef VM_DEBUG
8183 if (vm_debug) {
8184 fputs(" -- ", vm_out); fputc('\n', vm_out);
8185 }
8186 #endif
8187 NEXT_P1;
8188 LABEL2(flush_icache)
8189 NEXT_P1_5;
8190 LABEL3(flush_icache)
8191 DO_GOTO;
8192 }
8193 
8194 LABEL(paren_bye) /* (bye) ( n -- ) S0 -- S0  */
8195 /*  */
8196 NAME("(bye)")
8197 {
8198 DEF_CA
8199 MAYBE_UNUSED Cell n;
8200 NEXT_P0;
8201 vm_Cell2n(sp[0],n);
8202 #ifdef VM_DEBUG
8203 if (vm_debug) {
8204 fputs(" n=", vm_out); printarg_n(n);
8205 }
8206 #endif
8207 sp += 1;
8208 {
8209 #line 1685 "prim"
8210 SUPER_END;
8211 return (Label *)n;
8212 #line 8213 "prim.i"
8213 }
8214 
8215 #ifdef VM_DEBUG
8216 if (vm_debug) {
8217 fputs(" -- ", vm_out); fputc('\n', vm_out);
8218 }
8219 #endif
8220 NEXT_P1;
8221 LABEL2(paren_bye)
8222 NEXT_P1_5;
8223 LABEL3(paren_bye)
8224 DO_GOTO;
8225 }
8226 
8227 LABEL(paren_system) /* (system) ( c_addr u -- wretval wior ) S0 -- S0  */
8228 /*  */
8229 NAME("(system)")
8230 {
8231 DEF_CA
8232 MAYBE_UNUSED Char * c_addr;
8233 MAYBE_UNUSED UCell u;
8234 Cell wretval;
8235 Cell wior;
8236 NEXT_P0;
8237 vm_Cell2c_(sp[1],c_addr);
8238 vm_Cell2u(sp[0],u);
8239 #ifdef VM_DEBUG
8240 if (vm_debug) {
8241 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8242 fputs(" u=", vm_out); printarg_u(u);
8243 }
8244 #endif
8245 {
8246 #line 1689 "prim"
8247 wretval = gforth_system(c_addr, u);
8248 wior = IOR(wretval==-1 || (wretval==127 && errno != 0));
8249 #line 8250 "prim.i"
8250 }
8251 
8252 #ifdef VM_DEBUG
8253 if (vm_debug) {
8254 fputs(" -- ", vm_out); fputs(" wretval=", vm_out); printarg_w(wretval);
8255 fputs(" wior=", vm_out); printarg_w(wior);
8256 fputc('\n', vm_out);
8257 }
8258 #endif
8259 NEXT_P1;
8260 vm_w2Cell(wretval,sp[1]);
8261 vm_w2Cell(wior,sp[0]);
8262 LABEL2(paren_system)
8263 NEXT_P1_5;
8264 LABEL3(paren_system)
8265 DO_GOTO;
8266 }
8267 
8268 LABEL(getenv) /* getenv ( c_addr1 u1 -- c_addr2 u2 ) S0 -- S0  */
8269 /* The string @i{c-addr1 u1} specifies an environment variable. The string @i{c-addr2 u2}
8270 is the host operating system's expansion of that environment variable. If the
8271 environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters
8272 in length. */
8273 NAME("getenv")
8274 {
8275 DEF_CA
8276 MAYBE_UNUSED Char * c_addr1;
8277 MAYBE_UNUSED UCell u1;
8278 Char * c_addr2;
8279 UCell u2;
8280 NEXT_P0;
8281 vm_Cell2c_(sp[1],c_addr1);
8282 vm_Cell2u(sp[0],u1);
8283 #ifdef VM_DEBUG
8284 if (vm_debug) {
8285 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
8286 fputs(" u1=", vm_out); printarg_u(u1);
8287 }
8288 #endif
8289 {
8290 #line 1697 "prim"
8291 /* close ' to keep fontify happy */
8292 c_addr2 = (Char *)getenv(cstr(c_addr1,u1,1));
8293 u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2));
8294 #line 8295 "prim.i"
8295 }
8296 
8297 #ifdef VM_DEBUG
8298 if (vm_debug) {
8299 fputs(" -- ", vm_out); fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
8300 fputs(" u2=", vm_out); printarg_u(u2);
8301 fputc('\n', vm_out);
8302 }
8303 #endif
8304 NEXT_P1;
8305 vm_c_2Cell(c_addr2,sp[1]);
8306 vm_u2Cell(u2,sp[0]);
8307 LABEL2(getenv)
8308 NEXT_P1_5;
8309 LABEL3(getenv)
8310 DO_GOTO;
8311 }
8312 
8313 LABEL(open_pipe) /* open-pipe ( c_addr u wfam -- wfileid wior ) S0 -- S0  */
8314 /*  */
8315 NAME("open-pipe")
8316 {
8317 DEF_CA
8318 MAYBE_UNUSED Char * c_addr;
8319 MAYBE_UNUSED UCell u;
8320 MAYBE_UNUSED Cell wfam;
8321 Cell wfileid;
8322 Cell wior;
8323 NEXT_P0;
8324 vm_Cell2c_(sp[2],c_addr);
8325 vm_Cell2u(sp[1],u);
8326 vm_Cell2w(sp[0],wfam);
8327 #ifdef VM_DEBUG
8328 if (vm_debug) {
8329 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8330 fputs(" u=", vm_out); printarg_u(u);
8331 fputs(" wfam=", vm_out); printarg_w(wfam);
8332 }
8333 #endif
8334 sp += 1;
8335 {
8336 #line 1702 "prim"
8337 wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */
8338 wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */
8339 #line 8340 "prim.i"
8340 }
8341 
8342 #ifdef VM_DEBUG
8343 if (vm_debug) {
8344 fputs(" -- ", vm_out); fputs(" wfileid=", vm_out); printarg_w(wfileid);
8345 fputs(" wior=", vm_out); printarg_w(wior);
8346 fputc('\n', vm_out);
8347 }
8348 #endif
8349 NEXT_P1;
8350 vm_w2Cell(wfileid,sp[1]);
8351 vm_w2Cell(wior,sp[0]);
8352 LABEL2(open_pipe)
8353 NEXT_P1_5;
8354 LABEL3(open_pipe)
8355 DO_GOTO;
8356 }
8357 
8358 LABEL(close_pipe) /* close-pipe ( wfileid -- wretval wior ) S0 -- S0  */
8359 /*  */
8360 NAME("close-pipe")
8361 {
8362 DEF_CA
8363 MAYBE_UNUSED Cell wfileid;
8364 Cell wretval;
8365 Cell wior;
8366 NEXT_P0;
8367 vm_Cell2w(sp[0],wfileid);
8368 #ifdef VM_DEBUG
8369 if (vm_debug) {
8370 fputs(" wfileid=", vm_out); printarg_w(wfileid);
8371 }
8372 #endif
8373 sp += -1;
8374 {
8375 #line 1706 "prim"
8376 wretval = pclose((FILE *)wfileid);
8377 wior = IOR(wretval==-1);
8378 #line 8379 "prim.i"
8379 }
8380 
8381 #ifdef VM_DEBUG
8382 if (vm_debug) {
8383 fputs(" -- ", vm_out); fputs(" wretval=", vm_out); printarg_w(wretval);
8384 fputs(" wior=", vm_out); printarg_w(wior);
8385 fputc('\n', vm_out);
8386 }
8387 #endif
8388 NEXT_P1;
8389 vm_w2Cell(wretval,sp[1]);
8390 vm_w2Cell(wior,sp[0]);
8391 LABEL2(close_pipe)
8392 NEXT_P1_5;
8393 LABEL3(close_pipe)
8394 DO_GOTO;
8395 }
8396 
8397 LABEL(time_and_date) /* time&date ( -- nsec nmin nhour nday nmonth nyear ) S0 -- S0  */
8398 /* Report the current time of day. Seconds, minutes and hours are numbered from 0.
8399 Months are numbered from 1. */
8400 NAME("time&date")
8401 {
8402 DEF_CA
8403 Cell nsec;
8404 Cell nmin;
8405 Cell nhour;
8406 Cell nday;
8407 Cell nmonth;
8408 Cell nyear;
8409 NEXT_P0;
8410 #ifdef VM_DEBUG
8411 if (vm_debug) {
8412 }
8413 #endif
8414 sp += -6;
8415 {
8416 #line 1712 "prim"
8417 #if 1
8418 time_t now;
8419 struct tm *ltime;
8420 time(&now);
8421 ltime=localtime(&now);
8422 #else
8423 struct timeval time1;
8424 struct timezone zone1;
8425 struct tm *ltime;
8426 gettimeofday(&time1,&zone1);
8427 /* !! Single Unix specification:
8428    If tzp is not a null pointer, the behaviour is unspecified. */
8429 ltime=localtime((time_t *)&time1.tv_sec);
8430 #endif
8431 nyear =ltime->tm_year+1900;
8432 nmonth=ltime->tm_mon+1;
8433 nday  =ltime->tm_mday;
8434 nhour =ltime->tm_hour;
8435 nmin  =ltime->tm_min;
8436 nsec  =ltime->tm_sec;
8437 #line 8438 "prim.i"
8438 }
8439 
8440 #ifdef VM_DEBUG
8441 if (vm_debug) {
8442 fputs(" -- ", vm_out); fputs(" nsec=", vm_out); printarg_n(nsec);
8443 fputs(" nmin=", vm_out); printarg_n(nmin);
8444 fputs(" nhour=", vm_out); printarg_n(nhour);
8445 fputs(" nday=", vm_out); printarg_n(nday);
8446 fputs(" nmonth=", vm_out); printarg_n(nmonth);
8447 fputs(" nyear=", vm_out); printarg_n(nyear);
8448 fputc('\n', vm_out);
8449 }
8450 #endif
8451 NEXT_P1;
8452 vm_n2Cell(nsec,sp[5]);
8453 vm_n2Cell(nmin,sp[4]);
8454 vm_n2Cell(nhour,sp[3]);
8455 vm_n2Cell(nday,sp[2]);
8456 vm_n2Cell(nmonth,sp[1]);
8457 vm_n2Cell(nyear,sp[0]);
8458 LABEL2(time_and_date)
8459 NEXT_P1_5;
8460 LABEL3(time_and_date)
8461 DO_GOTO;
8462 }
8463 
8464 LABEL(ms) /* ms ( u -- ) S0 -- S0  */
8465 /* Wait at least @i{n} milli-second. */
8466 NAME("ms")
8467 {
8468 DEF_CA
8469 MAYBE_UNUSED UCell u;
8470 NEXT_P0;
8471 vm_Cell2u(sp[0],u);
8472 #ifdef VM_DEBUG
8473 if (vm_debug) {
8474 fputs(" u=", vm_out); printarg_u(u);
8475 }
8476 #endif
8477 sp += 1;
8478 {
8479 #line 1735 "prim"
8480 gforth_ms(u);
8481 #line 8482 "prim.i"
8482 }
8483 
8484 #ifdef VM_DEBUG
8485 if (vm_debug) {
8486 fputs(" -- ", vm_out); fputc('\n', vm_out);
8487 }
8488 #endif
8489 NEXT_P1;
8490 LABEL2(ms)
8491 NEXT_P1_5;
8492 LABEL3(ms)
8493 DO_GOTO;
8494 }
8495 
8496 LABEL(allocate) /* allocate ( u -- a_addr wior ) S0 -- S0  */
8497 /* Allocate @i{u} address units of contiguous data space. The initial
8498 contents of the data space is undefined. If the allocation is successful,
8499 @i{a-addr} is the start address of the allocated region and @i{wior}
8500 is 0. If the allocation fails, @i{a-addr} is undefined and @i{wior}
8501 is a non-zero I/O result code. */
8502 NAME("allocate")
8503 {
8504 DEF_CA
8505 MAYBE_UNUSED UCell u;
8506 Cell * a_addr;
8507 Cell wior;
8508 NEXT_P0;
8509 vm_Cell2u(sp[0],u);
8510 #ifdef VM_DEBUG
8511 if (vm_debug) {
8512 fputs(" u=", vm_out); printarg_u(u);
8513 }
8514 #endif
8515 sp += -1;
8516 {
8517 #line 1743 "prim"
8518 a_addr = (Cell *)malloc(u?u:1);
8519 wior = IOR(a_addr==NULL);
8520 #line 8521 "prim.i"
8521 }
8522 
8523 #ifdef VM_DEBUG
8524 if (vm_debug) {
8525 fputs(" -- ", vm_out); fputs(" a_addr=", vm_out); printarg_a_(a_addr);
8526 fputs(" wior=", vm_out); printarg_w(wior);
8527 fputc('\n', vm_out);
8528 }
8529 #endif
8530 NEXT_P1;
8531 vm_a_2Cell(a_addr,sp[1]);
8532 vm_w2Cell(wior,sp[0]);
8533 LABEL2(allocate)
8534 NEXT_P1_5;
8535 LABEL3(allocate)
8536 DO_GOTO;
8537 }
8538 
8539 LABEL(free) /* free ( a_addr -- wior ) S0 -- S0  */
8540 /* Return the region of data space starting at @i{a-addr} to the system.
8541 The region must originally have been obtained using @code{allocate} or
8542 @code{resize}. If the operational is successful, @i{wior} is 0.
8543 If the operation fails, @i{wior} is a non-zero I/O result code. */
8544 NAME("free")
8545 {
8546 DEF_CA
8547 MAYBE_UNUSED Cell * a_addr;
8548 Cell wior;
8549 NEXT_P0;
8550 vm_Cell2a_(sp[0],a_addr);
8551 #ifdef VM_DEBUG
8552 if (vm_debug) {
8553 fputs(" a_addr=", vm_out); printarg_a_(a_addr);
8554 }
8555 #endif
8556 {
8557 #line 1751 "prim"
8558 free(a_addr);
8559 wior = 0;
8560 #line 8561 "prim.i"
8561 }
8562 
8563 #ifdef VM_DEBUG
8564 if (vm_debug) {
8565 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
8566 fputc('\n', vm_out);
8567 }
8568 #endif
8569 NEXT_P1;
8570 vm_w2Cell(wior,sp[0]);
8571 LABEL2(free)
8572 NEXT_P1_5;
8573 LABEL3(free)
8574 DO_GOTO;
8575 }
8576 
8577 LABEL(resize) /* resize ( a_addr1 u -- a_addr2 wior ) S0 -- S0  */
8578 /* Change the size of the allocated area at @i{a-addr1} to @i{u}
8579 address units, possibly moving the contents to a different
8580 area. @i{a-addr2} is the address of the resulting area.
8581 If the operation is successful, @i{wior} is 0.
8582 If the operation fails, @i{wior} is a non-zero
8583 I/O result code. If @i{a-addr1} is 0, Gforth's (but not the Standard)
8584 @code{resize} @code{allocate}s @i{u} address units. */
8585 NAME("resize")
8586 {
8587 DEF_CA
8588 MAYBE_UNUSED Cell * a_addr1;
8589 MAYBE_UNUSED UCell u;
8590 Cell * a_addr2;
8591 Cell wior;
8592 NEXT_P0;
8593 vm_Cell2a_(sp[1],a_addr1);
8594 vm_Cell2u(sp[0],u);
8595 #ifdef VM_DEBUG
8596 if (vm_debug) {
8597 fputs(" a_addr1=", vm_out); printarg_a_(a_addr1);
8598 fputs(" u=", vm_out); printarg_u(u);
8599 }
8600 #endif
8601 {
8602 #line 1762 "prim"
8603 /* the following check is not necessary on most OSs, but it is needed
8604    on SunOS 4.1.2. */
8605 /* close ' to keep fontify happy */
8606 if (a_addr1==NULL)
8607   a_addr2 = (Cell *)malloc(u);
8608 else
8609   a_addr2 = (Cell *)realloc(a_addr1, u);
8610 wior = IOR(a_addr2==NULL);	/* !! Define a return code */
8611 #line 8612 "prim.i"
8612 }
8613 
8614 #ifdef VM_DEBUG
8615 if (vm_debug) {
8616 fputs(" -- ", vm_out); fputs(" a_addr2=", vm_out); printarg_a_(a_addr2);
8617 fputs(" wior=", vm_out); printarg_w(wior);
8618 fputc('\n', vm_out);
8619 }
8620 #endif
8621 NEXT_P1;
8622 vm_a_2Cell(a_addr2,sp[1]);
8623 vm_w2Cell(wior,sp[0]);
8624 LABEL2(resize)
8625 NEXT_P1_5;
8626 LABEL3(resize)
8627 DO_GOTO;
8628 }
8629 
8630 LABEL(strerror) /* strerror ( n -- c_addr u ) S0 -- S0  */
8631 /*  */
8632 NAME("strerror")
8633 {
8634 DEF_CA
8635 MAYBE_UNUSED Cell n;
8636 Char * c_addr;
8637 UCell u;
8638 NEXT_P0;
8639 vm_Cell2n(sp[0],n);
8640 #ifdef VM_DEBUG
8641 if (vm_debug) {
8642 fputs(" n=", vm_out); printarg_n(n);
8643 }
8644 #endif
8645 sp += -1;
8646 {
8647 #line 1772 "prim"
8648 c_addr = (Char *)strerror(n);
8649 u = strlen((char *)c_addr);
8650 #line 8651 "prim.i"
8651 }
8652 
8653 #ifdef VM_DEBUG
8654 if (vm_debug) {
8655 fputs(" -- ", vm_out); fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8656 fputs(" u=", vm_out); printarg_u(u);
8657 fputc('\n', vm_out);
8658 }
8659 #endif
8660 NEXT_P1;
8661 vm_c_2Cell(c_addr,sp[1]);
8662 vm_u2Cell(u,sp[0]);
8663 LABEL2(strerror)
8664 NEXT_P1_5;
8665 LABEL3(strerror)
8666 DO_GOTO;
8667 }
8668 
8669 LABEL(strsignal) /* strsignal ( n -- c_addr u ) S0 -- S0  */
8670 /*  */
8671 NAME("strsignal")
8672 {
8673 DEF_CA
8674 MAYBE_UNUSED Cell n;
8675 Char * c_addr;
8676 UCell u;
8677 NEXT_P0;
8678 vm_Cell2n(sp[0],n);
8679 #ifdef VM_DEBUG
8680 if (vm_debug) {
8681 fputs(" n=", vm_out); printarg_n(n);
8682 }
8683 #endif
8684 sp += -1;
8685 {
8686 #line 1776 "prim"
8687 c_addr = (Char *)strsignal(n);
8688 u = strlen((char *)c_addr);
8689 #line 8690 "prim.i"
8690 }
8691 
8692 #ifdef VM_DEBUG
8693 if (vm_debug) {
8694 fputs(" -- ", vm_out); fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8695 fputs(" u=", vm_out); printarg_u(u);
8696 fputc('\n', vm_out);
8697 }
8698 #endif
8699 NEXT_P1;
8700 vm_c_2Cell(c_addr,sp[1]);
8701 vm_u2Cell(u,sp[0]);
8702 LABEL2(strsignal)
8703 NEXT_P1_5;
8704 LABEL3(strsignal)
8705 DO_GOTO;
8706 }
8707 
8708 LABEL(call_c) /* call-c ( ... w -- ... ) S0 -- S0  */
8709 /* Call the C function pointed to by @i{w}. The C function has to
8710 access the stack itself. The stack pointers are exported in the global
8711 variables @code{gforth_SP} and @code{gforth_FP}. */
8712 NAME("call-c")
8713 {
8714 DEF_CA
8715 MAYBE_UNUSED Cell w;
8716 NEXT_P0;
8717 vm_Cell2w(sp[0],w);
8718 #ifdef VM_DEBUG
8719 if (vm_debug) {
8720 fputs(" w=", vm_out); printarg_w(w);
8721 }
8722 #endif
8723 sp += 1;
8724 {
8725 #line 1783 "prim"
8726 /* This is a first attempt at support for calls to C. This may change in
8727    the future */
8728 IF_fpTOS(fp[0]=fpTOS);
8729 gforth_FP=fp;
8730 gforth_SP=sp;
8731 gforth_RP=rp;
8732 gforth_LP=lp;
8733 #ifdef HAS_LINKBACK
8734 ((void (*)())w)();
8735 #else
8736 ((void (*)(void *))w)(gforth_pointers);
8737 #endif
8738 sp=gforth_SP;
8739 fp=gforth_FP;
8740 rp=gforth_RP;
8741 lp=gforth_LP;
8742 IF_fpTOS(fpTOS=fp[0]);
8743 #line 8744 "prim.i"
8744 }
8745 
8746 #ifdef VM_DEBUG
8747 if (vm_debug) {
8748 fputs(" -- ", vm_out); fputc('\n', vm_out);
8749 }
8750 #endif
8751 NEXT_P1;
8752 LABEL2(call_c)
8753 NEXT_P1_5;
8754 LABEL3(call_c)
8755 DO_GOTO;
8756 }
8757 
8758 GROUPADD(16)
8759 #endif
8760 GROUPADD(0)
8761 #ifdef HAS_FILE
LABEL(close_file)8762 LABEL(close_file) /* close-file ( wfileid -- wior ) S0 -- S0  */
8763 /*  */
8764 NAME("close-file")
8765 {
8766 DEF_CA
8767 MAYBE_UNUSED Cell wfileid;
8768 Cell wior;
8769 NEXT_P0;
8770 vm_Cell2w(sp[0],wfileid);
8771 #ifdef VM_DEBUG
8772 if (vm_debug) {
8773 fputs(" wfileid=", vm_out); printarg_w(wfileid);
8774 }
8775 #endif
8776 {
8777 #line 1805 "prim"
8778 wior = IOR(fclose((FILE *)wfileid)==EOF);
8779 #line 8780 "prim.i"
8780 }
8781 
8782 #ifdef VM_DEBUG
8783 if (vm_debug) {
8784 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
8785 fputc('\n', vm_out);
8786 }
8787 #endif
8788 NEXT_P1;
8789 vm_w2Cell(wior,sp[0]);
8790 LABEL2(close_file)
8791 NEXT_P1_5;
8792 LABEL3(close_file)
8793 DO_GOTO;
8794 }
8795 
8796 LABEL(open_file) /* open-file ( c_addr u wfam -- wfileid wior ) S0 -- S0  */
8797 /*  */
8798 NAME("open-file")
8799 {
8800 DEF_CA
8801 MAYBE_UNUSED Char * c_addr;
8802 MAYBE_UNUSED UCell u;
8803 MAYBE_UNUSED Cell wfam;
8804 Cell wfileid;
8805 Cell wior;
8806 NEXT_P0;
8807 vm_Cell2c_(sp[2],c_addr);
8808 vm_Cell2u(sp[1],u);
8809 vm_Cell2w(sp[0],wfam);
8810 #ifdef VM_DEBUG
8811 if (vm_debug) {
8812 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8813 fputs(" u=", vm_out); printarg_u(u);
8814 fputs(" wfam=", vm_out); printarg_w(wfam);
8815 }
8816 #endif
8817 sp += 1;
8818 {
8819 #line 1808 "prim"
8820 wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, 0, &wior);
8821 #line 8822 "prim.i"
8822 }
8823 
8824 #ifdef VM_DEBUG
8825 if (vm_debug) {
8826 fputs(" -- ", vm_out); fputs(" wfileid=", vm_out); printarg_w(wfileid);
8827 fputs(" wior=", vm_out); printarg_w(wior);
8828 fputc('\n', vm_out);
8829 }
8830 #endif
8831 NEXT_P1;
8832 vm_w2Cell(wfileid,sp[1]);
8833 vm_w2Cell(wior,sp[0]);
8834 LABEL2(open_file)
8835 NEXT_P1_5;
8836 LABEL3(open_file)
8837 DO_GOTO;
8838 }
8839 
8840 LABEL(create_file) /* create-file ( c_addr u wfam -- wfileid wior ) S0 -- S0  */
8841 /*  */
8842 NAME("create-file")
8843 {
8844 DEF_CA
8845 MAYBE_UNUSED Char * c_addr;
8846 MAYBE_UNUSED UCell u;
8847 MAYBE_UNUSED Cell wfam;
8848 Cell wfileid;
8849 Cell wior;
8850 NEXT_P0;
8851 vm_Cell2c_(sp[2],c_addr);
8852 vm_Cell2u(sp[1],u);
8853 vm_Cell2w(sp[0],wfam);
8854 #ifdef VM_DEBUG
8855 if (vm_debug) {
8856 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8857 fputs(" u=", vm_out); printarg_u(u);
8858 fputs(" wfam=", vm_out); printarg_w(wfam);
8859 }
8860 #endif
8861 sp += 1;
8862 {
8863 #line 1811 "prim"
8864 wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, O_CREAT|O_TRUNC, &wior);
8865 #line 8866 "prim.i"
8866 }
8867 
8868 #ifdef VM_DEBUG
8869 if (vm_debug) {
8870 fputs(" -- ", vm_out); fputs(" wfileid=", vm_out); printarg_w(wfileid);
8871 fputs(" wior=", vm_out); printarg_w(wior);
8872 fputc('\n', vm_out);
8873 }
8874 #endif
8875 NEXT_P1;
8876 vm_w2Cell(wfileid,sp[1]);
8877 vm_w2Cell(wior,sp[0]);
8878 LABEL2(create_file)
8879 NEXT_P1_5;
8880 LABEL3(create_file)
8881 DO_GOTO;
8882 }
8883 
8884 LABEL(delete_file) /* delete-file ( c_addr u -- wior ) S0 -- S0  */
8885 /*  */
8886 NAME("delete-file")
8887 {
8888 DEF_CA
8889 MAYBE_UNUSED Char * c_addr;
8890 MAYBE_UNUSED UCell u;
8891 Cell wior;
8892 NEXT_P0;
8893 vm_Cell2c_(sp[1],c_addr);
8894 vm_Cell2u(sp[0],u);
8895 #ifdef VM_DEBUG
8896 if (vm_debug) {
8897 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
8898 fputs(" u=", vm_out); printarg_u(u);
8899 }
8900 #endif
8901 sp += 1;
8902 {
8903 #line 1814 "prim"
8904 wior = IOR(unlink(tilde_cstr(c_addr, u, 1))==-1);
8905 #line 8906 "prim.i"
8906 }
8907 
8908 #ifdef VM_DEBUG
8909 if (vm_debug) {
8910 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
8911 fputc('\n', vm_out);
8912 }
8913 #endif
8914 NEXT_P1;
8915 vm_w2Cell(wior,sp[0]);
8916 LABEL2(delete_file)
8917 NEXT_P1_5;
8918 LABEL3(delete_file)
8919 DO_GOTO;
8920 }
8921 
8922 LABEL(rename_file) /* rename-file ( c_addr1 u1 c_addr2 u2 -- wior ) S0 -- S0  */
8923 /* Rename file @i{c_addr1 u1} to new name @i{c_addr2 u2} */
8924 NAME("rename-file")
8925 {
8926 DEF_CA
8927 MAYBE_UNUSED Char * c_addr1;
8928 MAYBE_UNUSED UCell u1;
8929 MAYBE_UNUSED Char * c_addr2;
8930 MAYBE_UNUSED UCell u2;
8931 Cell wior;
8932 NEXT_P0;
8933 vm_Cell2c_(sp[3],c_addr1);
8934 vm_Cell2u(sp[2],u1);
8935 vm_Cell2c_(sp[1],c_addr2);
8936 vm_Cell2u(sp[0],u2);
8937 #ifdef VM_DEBUG
8938 if (vm_debug) {
8939 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
8940 fputs(" u1=", vm_out); printarg_u(u1);
8941 fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
8942 fputs(" u2=", vm_out); printarg_u(u2);
8943 }
8944 #endif
8945 sp += 3;
8946 {
8947 #line 1818 "prim"
8948 wior = rename_file(c_addr1, u1, c_addr2, u2);
8949 #line 8950 "prim.i"
8950 }
8951 
8952 #ifdef VM_DEBUG
8953 if (vm_debug) {
8954 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
8955 fputc('\n', vm_out);
8956 }
8957 #endif
8958 NEXT_P1;
8959 vm_w2Cell(wior,sp[0]);
8960 LABEL2(rename_file)
8961 NEXT_P1_5;
8962 LABEL3(rename_file)
8963 DO_GOTO;
8964 }
8965 
8966 LABEL(file_position) /* file-position ( wfileid -- ud wior ) S0 -- S0  */
8967 /*  */
8968 NAME("file-position")
8969 {
8970 DEF_CA
8971 MAYBE_UNUSED Cell wfileid;
8972 UDCell ud;
8973 Cell wior;
8974 NEXT_P0;
8975 vm_Cell2w(sp[0],wfileid);
8976 #ifdef VM_DEBUG
8977 if (vm_debug) {
8978 fputs(" wfileid=", vm_out); printarg_w(wfileid);
8979 }
8980 #endif
8981 sp += -2;
8982 {
8983 #line 1821 "prim"
8984 /* !! use tell and lseek? */
8985 ud = OFF2UD(ftello((FILE *)wfileid));
8986 wior = IOR(UD2OFF(ud)==-1);
8987 #line 8988 "prim.i"
8988 }
8989 
8990 #ifdef VM_DEBUG
8991 if (vm_debug) {
8992 fputs(" -- ", vm_out); fputs(" ud=", vm_out); printarg_ud(ud);
8993 fputs(" wior=", vm_out); printarg_w(wior);
8994 fputc('\n', vm_out);
8995 }
8996 #endif
8997 NEXT_P1;
8998 vm_ud2twoCell(ud, sp[2], sp[1])
8999 vm_w2Cell(wior,sp[0]);
9000 LABEL2(file_position)
9001 NEXT_P1_5;
9002 LABEL3(file_position)
9003 DO_GOTO;
9004 }
9005 
9006 LABEL(reposition_file) /* reposition-file ( ud wfileid -- wior ) S0 -- S0  */
9007 /*  */
9008 NAME("reposition-file")
9009 {
9010 DEF_CA
9011 MAYBE_UNUSED UDCell ud;
9012 MAYBE_UNUSED Cell wfileid;
9013 Cell wior;
9014 NEXT_P0;
9015 vm_twoCell2ud(sp[2], sp[1], ud)
9016 vm_Cell2w(sp[0],wfileid);
9017 #ifdef VM_DEBUG
9018 if (vm_debug) {
9019 fputs(" ud=", vm_out); printarg_ud(ud);
9020 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9021 }
9022 #endif
9023 sp += 2;
9024 {
9025 #line 1826 "prim"
9026 wior = IOR(fseeko((FILE *)wfileid, UD2OFF(ud), SEEK_SET)==-1);
9027 #line 9028 "prim.i"
9028 }
9029 
9030 #ifdef VM_DEBUG
9031 if (vm_debug) {
9032 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9033 fputc('\n', vm_out);
9034 }
9035 #endif
9036 NEXT_P1;
9037 vm_w2Cell(wior,sp[0]);
9038 LABEL2(reposition_file)
9039 NEXT_P1_5;
9040 LABEL3(reposition_file)
9041 DO_GOTO;
9042 }
9043 
9044 LABEL(file_size) /* file-size ( wfileid -- ud wior ) S0 -- S0  */
9045 /*  */
9046 NAME("file-size")
9047 {
9048 DEF_CA
9049 MAYBE_UNUSED Cell wfileid;
9050 UDCell ud;
9051 Cell wior;
9052 NEXT_P0;
9053 vm_Cell2w(sp[0],wfileid);
9054 #ifdef VM_DEBUG
9055 if (vm_debug) {
9056 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9057 }
9058 #endif
9059 sp += -2;
9060 {
9061 #line 1829 "prim"
9062 struct stat buf;
9063 wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1);
9064 ud = OFF2UD(buf.st_size);
9065 #line 9066 "prim.i"
9066 }
9067 
9068 #ifdef VM_DEBUG
9069 if (vm_debug) {
9070 fputs(" -- ", vm_out); fputs(" ud=", vm_out); printarg_ud(ud);
9071 fputs(" wior=", vm_out); printarg_w(wior);
9072 fputc('\n', vm_out);
9073 }
9074 #endif
9075 NEXT_P1;
9076 vm_ud2twoCell(ud, sp[2], sp[1])
9077 vm_w2Cell(wior,sp[0]);
9078 LABEL2(file_size)
9079 NEXT_P1_5;
9080 LABEL3(file_size)
9081 DO_GOTO;
9082 }
9083 
9084 LABEL(resize_file) /* resize-file ( ud wfileid -- wior ) S0 -- S0  */
9085 /*  */
9086 NAME("resize-file")
9087 {
9088 DEF_CA
9089 MAYBE_UNUSED UDCell ud;
9090 MAYBE_UNUSED Cell wfileid;
9091 Cell wior;
9092 NEXT_P0;
9093 vm_twoCell2ud(sp[2], sp[1], ud)
9094 vm_Cell2w(sp[0],wfileid);
9095 #ifdef VM_DEBUG
9096 if (vm_debug) {
9097 fputs(" ud=", vm_out); printarg_ud(ud);
9098 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9099 }
9100 #endif
9101 sp += 2;
9102 {
9103 #line 1834 "prim"
9104 wior = IOR(ftruncate(fileno((FILE *)wfileid), UD2OFF(ud))==-1);
9105 #line 9106 "prim.i"
9106 }
9107 
9108 #ifdef VM_DEBUG
9109 if (vm_debug) {
9110 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9111 fputc('\n', vm_out);
9112 }
9113 #endif
9114 NEXT_P1;
9115 vm_w2Cell(wior,sp[0]);
9116 LABEL2(resize_file)
9117 NEXT_P1_5;
9118 LABEL3(resize_file)
9119 DO_GOTO;
9120 }
9121 
9122 LABEL(read_file) /* read-file ( c_addr u1 wfileid -- u2 wior ) S0 -- S0  */
9123 /*  */
9124 NAME("read-file")
9125 {
9126 DEF_CA
9127 MAYBE_UNUSED Char * c_addr;
9128 MAYBE_UNUSED UCell u1;
9129 MAYBE_UNUSED Cell wfileid;
9130 UCell u2;
9131 Cell wior;
9132 NEXT_P0;
9133 vm_Cell2c_(sp[2],c_addr);
9134 vm_Cell2u(sp[1],u1);
9135 vm_Cell2w(sp[0],wfileid);
9136 #ifdef VM_DEBUG
9137 if (vm_debug) {
9138 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9139 fputs(" u1=", vm_out); printarg_u(u1);
9140 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9141 }
9142 #endif
9143 sp += 1;
9144 {
9145 #line 1837 "prim"
9146 /* !! fread does not guarantee enough */
9147 u2 = fread(c_addr, sizeof(Char), u1, (FILE *)wfileid);
9148 wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
9149 /* !! is the value of ferror errno-compatible? */
9150 if (wior)
9151   clearerr((FILE *)wfileid);
9152 #line 9153 "prim.i"
9153 }
9154 
9155 #ifdef VM_DEBUG
9156 if (vm_debug) {
9157 fputs(" -- ", vm_out); fputs(" u2=", vm_out); printarg_u(u2);
9158 fputs(" wior=", vm_out); printarg_w(wior);
9159 fputc('\n', vm_out);
9160 }
9161 #endif
9162 NEXT_P1;
9163 vm_u2Cell(u2,sp[1]);
9164 vm_w2Cell(wior,sp[0]);
9165 LABEL2(read_file)
9166 NEXT_P1_5;
9167 LABEL3(read_file)
9168 DO_GOTO;
9169 }
9170 
9171 LABEL(paren_read_line) /* (read-line) ( c_addr u1 wfileid -- u2 flag u3 wior ) S0 -- S0  */
9172 /*  */
9173 NAME("(read-line)")
9174 {
9175 DEF_CA
9176 MAYBE_UNUSED Char * c_addr;
9177 MAYBE_UNUSED UCell u1;
9178 MAYBE_UNUSED Cell wfileid;
9179 UCell u2;
9180 Bool flag;
9181 UCell u3;
9182 Cell wior;
9183 NEXT_P0;
9184 vm_Cell2c_(sp[2],c_addr);
9185 vm_Cell2u(sp[1],u1);
9186 vm_Cell2w(sp[0],wfileid);
9187 #ifdef VM_DEBUG
9188 if (vm_debug) {
9189 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9190 fputs(" u1=", vm_out); printarg_u(u1);
9191 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9192 }
9193 #endif
9194 sp += -1;
9195 {
9196 #line 1845 "prim"
9197 struct Cellquad r = read_line(c_addr, u1, wfileid);
9198 u2   = r.n1;
9199 flag = r.n2;
9200 u3   = r.n3;
9201 wior = r.n4;
9202 #line 9203 "prim.i"
9203 }
9204 
9205 #ifdef VM_DEBUG
9206 if (vm_debug) {
9207 fputs(" -- ", vm_out); fputs(" u2=", vm_out); printarg_u(u2);
9208 fputs(" flag=", vm_out); printarg_f(flag);
9209 fputs(" u3=", vm_out); printarg_u(u3);
9210 fputs(" wior=", vm_out); printarg_w(wior);
9211 fputc('\n', vm_out);
9212 }
9213 #endif
9214 NEXT_P1;
9215 vm_u2Cell(u2,sp[3]);
9216 vm_f2Cell(flag,sp[2]);
9217 vm_u2Cell(u3,sp[1]);
9218 vm_w2Cell(wior,sp[0]);
9219 LABEL2(paren_read_line)
9220 NEXT_P1_5;
9221 LABEL3(paren_read_line)
9222 DO_GOTO;
9223 }
9224 
9225 GROUPADD(11)
9226 #endif
LABEL(write_file)9227 LABEL(write_file) /* write-file ( c_addr u1 wfileid -- wior ) S0 -- S0  */
9228 /*  */
9229 NAME("write-file")
9230 {
9231 DEF_CA
9232 MAYBE_UNUSED Char * c_addr;
9233 MAYBE_UNUSED UCell u1;
9234 MAYBE_UNUSED Cell wfileid;
9235 Cell wior;
9236 NEXT_P0;
9237 vm_Cell2c_(sp[2],c_addr);
9238 vm_Cell2u(sp[1],u1);
9239 vm_Cell2w(sp[0],wfileid);
9240 #ifdef VM_DEBUG
9241 if (vm_debug) {
9242 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9243 fputs(" u1=", vm_out); printarg_u(u1);
9244 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9245 }
9246 #endif
9247 sp += 2;
9248 {
9249 #line 1854 "prim"
9250 /* !! fwrite does not guarantee enough */
9251 #ifdef HAS_FILE
9252 {
9253   UCell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);
9254   wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
9255   if (wior)
9256     clearerr((FILE *)wfileid);
9257 }
9258 #else
9259 TYPE(c_addr, u1);
9260 #endif
9261 #line 9262 "prim.i"
9262 }
9263 
9264 #ifdef VM_DEBUG
9265 if (vm_debug) {
9266 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9267 fputc('\n', vm_out);
9268 }
9269 #endif
9270 NEXT_P1;
9271 vm_w2Cell(wior,sp[0]);
9272 LABEL2(write_file)
9273 NEXT_P1_5;
9274 LABEL3(write_file)
9275 DO_GOTO;
9276 }
9277 
9278 LABEL(emit_file) /* emit-file ( c wfileid -- wior ) S0 -- S0  */
9279 /*  */
9280 NAME("emit-file")
9281 {
9282 DEF_CA
9283 MAYBE_UNUSED Char c;
9284 MAYBE_UNUSED Cell wfileid;
9285 Cell wior;
9286 NEXT_P0;
9287 vm_Cell2c(sp[1],c);
9288 vm_Cell2w(sp[0],wfileid);
9289 #ifdef VM_DEBUG
9290 if (vm_debug) {
9291 fputs(" c=", vm_out); printarg_c(c);
9292 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9293 }
9294 #endif
9295 sp += 1;
9296 {
9297 #line 1867 "prim"
9298 #ifdef HAS_FILE
9299 wior = FILEIO(putc(c, (FILE *)wfileid)==EOF);
9300 if (wior)
9301   clearerr((FILE *)wfileid);
9302 #else
9303 PUTC(c);
9304 #endif
9305 #line 9306 "prim.i"
9306 }
9307 
9308 #ifdef VM_DEBUG
9309 if (vm_debug) {
9310 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9311 fputc('\n', vm_out);
9312 }
9313 #endif
9314 NEXT_P1;
9315 vm_w2Cell(wior,sp[0]);
9316 LABEL2(emit_file)
9317 NEXT_P1_5;
9318 LABEL3(emit_file)
9319 DO_GOTO;
9320 }
9321 
9322 GROUPADD(2)
9323 #ifdef HAS_FILE
LABEL(flush_file)9324 LABEL(flush_file) /* flush-file ( wfileid -- wior ) S0 -- S0  */
9325 /*  */
9326 NAME("flush-file")
9327 {
9328 DEF_CA
9329 MAYBE_UNUSED Cell wfileid;
9330 Cell wior;
9331 NEXT_P0;
9332 vm_Cell2w(sp[0],wfileid);
9333 #ifdef VM_DEBUG
9334 if (vm_debug) {
9335 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9336 }
9337 #endif
9338 {
9339 #line 1878 "prim"
9340 wior = IOR(fflush((FILE *) wfileid)==EOF);
9341 #line 9342 "prim.i"
9342 }
9343 
9344 #ifdef VM_DEBUG
9345 if (vm_debug) {
9346 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9347 fputc('\n', vm_out);
9348 }
9349 #endif
9350 NEXT_P1;
9351 vm_w2Cell(wior,sp[0]);
9352 LABEL2(flush_file)
9353 NEXT_P1_5;
9354 LABEL3(flush_file)
9355 DO_GOTO;
9356 }
9357 
9358 LABEL(file_status) /* file-status ( c_addr u -- wfam wior ) S0 -- S0  */
9359 /*  */
9360 NAME("file-status")
9361 {
9362 DEF_CA
9363 MAYBE_UNUSED Char * c_addr;
9364 MAYBE_UNUSED UCell u;
9365 Cell wfam;
9366 Cell wior;
9367 NEXT_P0;
9368 vm_Cell2c_(sp[1],c_addr);
9369 vm_Cell2u(sp[0],u);
9370 #ifdef VM_DEBUG
9371 if (vm_debug) {
9372 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9373 fputs(" u=", vm_out); printarg_u(u);
9374 }
9375 #endif
9376 {
9377 #line 1881 "prim"
9378 struct Cellpair r = file_status(c_addr, u);
9379 wfam = r.n1;
9380 wior = r.n2;
9381 #line 9382 "prim.i"
9382 }
9383 
9384 #ifdef VM_DEBUG
9385 if (vm_debug) {
9386 fputs(" -- ", vm_out); fputs(" wfam=", vm_out); printarg_w(wfam);
9387 fputs(" wior=", vm_out); printarg_w(wior);
9388 fputc('\n', vm_out);
9389 }
9390 #endif
9391 NEXT_P1;
9392 vm_w2Cell(wfam,sp[1]);
9393 vm_w2Cell(wior,sp[0]);
9394 LABEL2(file_status)
9395 NEXT_P1_5;
9396 LABEL3(file_status)
9397 DO_GOTO;
9398 }
9399 
9400 LABEL(file_eof_query) /* file-eof? ( wfileid -- flag ) S0 -- S0  */
9401 /*  */
9402 NAME("file-eof?")
9403 {
9404 DEF_CA
9405 MAYBE_UNUSED Cell wfileid;
9406 Bool flag;
9407 NEXT_P0;
9408 vm_Cell2w(sp[0],wfileid);
9409 #ifdef VM_DEBUG
9410 if (vm_debug) {
9411 fputs(" wfileid=", vm_out); printarg_w(wfileid);
9412 }
9413 #endif
9414 {
9415 #line 1886 "prim"
9416 flag = FLAG(feof((FILE *) wfileid));
9417 #line 9418 "prim.i"
9418 }
9419 
9420 #ifdef VM_DEBUG
9421 if (vm_debug) {
9422 fputs(" -- ", vm_out); fputs(" flag=", vm_out); printarg_f(flag);
9423 fputc('\n', vm_out);
9424 }
9425 #endif
9426 NEXT_P1;
9427 vm_f2Cell(flag,sp[0]);
9428 LABEL2(file_eof_query)
9429 NEXT_P1_5;
9430 LABEL3(file_eof_query)
9431 DO_GOTO;
9432 }
9433 
9434 LABEL(open_dir) /* open-dir ( c_addr u -- wdirid wior ) S0 -- S0  */
9435 /* Open the directory specified by @i{c-addr, u}
9436 and return @i{dir-id} for futher access to it. */
9437 NAME("open-dir")
9438 {
9439 DEF_CA
9440 MAYBE_UNUSED Char * c_addr;
9441 MAYBE_UNUSED UCell u;
9442 Cell wdirid;
9443 Cell wior;
9444 NEXT_P0;
9445 vm_Cell2c_(sp[1],c_addr);
9446 vm_Cell2u(sp[0],u);
9447 #ifdef VM_DEBUG
9448 if (vm_debug) {
9449 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9450 fputs(" u=", vm_out); printarg_u(u);
9451 }
9452 #endif
9453 {
9454 #line 1891 "prim"
9455 wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1));
9456 wior =  IOR(wdirid == 0);
9457 #line 9458 "prim.i"
9458 }
9459 
9460 #ifdef VM_DEBUG
9461 if (vm_debug) {
9462 fputs(" -- ", vm_out); fputs(" wdirid=", vm_out); printarg_w(wdirid);
9463 fputs(" wior=", vm_out); printarg_w(wior);
9464 fputc('\n', vm_out);
9465 }
9466 #endif
9467 NEXT_P1;
9468 vm_w2Cell(wdirid,sp[1]);
9469 vm_w2Cell(wior,sp[0]);
9470 LABEL2(open_dir)
9471 NEXT_P1_5;
9472 LABEL3(open_dir)
9473 DO_GOTO;
9474 }
9475 
9476 LABEL(read_dir) /* read-dir ( c_addr u1 wdirid -- u2 flag wior ) S0 -- S0  */
9477 /* Attempt to read the next entry from the directory specified
9478 by @i{dir-id} to the buffer of length @i{u1} at address @i{c-addr}.
9479 If the attempt fails because there is no more entries,
9480 @i{ior}=0, @i{flag}=0, @i{u2}=0, and the buffer is unmodified.
9481 If the attempt to read the next entry fails because of any other reason,
9482 return @i{ior}<>0.
9483 If the attempt succeeds, store file name to the buffer at @i{c-addr}
9484 and return @i{ior}=0, @i{flag}=true and @i{u2} equal to the size of the file name.
9485 If the length of the file name is greater than @i{u1},
9486 store first @i{u1} characters from file name into the buffer and
9487 indicate "name too long" with @i{ior}, @i{flag}=true, and @i{u2}=@i{u1}. */
9488 NAME("read-dir")
9489 {
9490 DEF_CA
9491 MAYBE_UNUSED Char * c_addr;
9492 MAYBE_UNUSED UCell u1;
9493 MAYBE_UNUSED Cell wdirid;
9494 UCell u2;
9495 Bool flag;
9496 Cell wior;
9497 NEXT_P0;
9498 vm_Cell2c_(sp[2],c_addr);
9499 vm_Cell2u(sp[1],u1);
9500 vm_Cell2w(sp[0],wdirid);
9501 #ifdef VM_DEBUG
9502 if (vm_debug) {
9503 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9504 fputs(" u1=", vm_out); printarg_u(u1);
9505 fputs(" wdirid=", vm_out); printarg_w(wdirid);
9506 }
9507 #endif
9508 {
9509 #line 1906 "prim"
9510 struct dirent * dent;
9511 dent = readdir((DIR *)wdirid);
9512 wior = 0;
9513 flag = -1;
9514 if(dent == NULL) {
9515   u2 = 0;
9516   flag = 0;
9517 } else {
9518   u2 = strlen((char *)dent->d_name);
9519   if(u2 > u1) {
9520     u2 = u1;
9521     wior = -512-ENAMETOOLONG;
9522   }
9523   memmove(c_addr, dent->d_name, u2);
9524 }
9525 #line 9526 "prim.i"
9526 }
9527 
9528 #ifdef VM_DEBUG
9529 if (vm_debug) {
9530 fputs(" -- ", vm_out); fputs(" u2=", vm_out); printarg_u(u2);
9531 fputs(" flag=", vm_out); printarg_f(flag);
9532 fputs(" wior=", vm_out); printarg_w(wior);
9533 fputc('\n', vm_out);
9534 }
9535 #endif
9536 NEXT_P1;
9537 vm_u2Cell(u2,sp[2]);
9538 vm_f2Cell(flag,sp[1]);
9539 vm_w2Cell(wior,sp[0]);
9540 LABEL2(read_dir)
9541 NEXT_P1_5;
9542 LABEL3(read_dir)
9543 DO_GOTO;
9544 }
9545 
9546 LABEL(close_dir) /* close-dir ( wdirid -- wior ) S0 -- S0  */
9547 /* Close the directory specified by @i{dir-id}. */
9548 NAME("close-dir")
9549 {
9550 DEF_CA
9551 MAYBE_UNUSED Cell wdirid;
9552 Cell wior;
9553 NEXT_P0;
9554 vm_Cell2w(sp[0],wdirid);
9555 #ifdef VM_DEBUG
9556 if (vm_debug) {
9557 fputs(" wdirid=", vm_out); printarg_w(wdirid);
9558 }
9559 #endif
9560 {
9561 #line 1924 "prim"
9562 wior = IOR(closedir((DIR *)wdirid));
9563 #line 9564 "prim.i"
9564 }
9565 
9566 #ifdef VM_DEBUG
9567 if (vm_debug) {
9568 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9569 fputc('\n', vm_out);
9570 }
9571 #endif
9572 NEXT_P1;
9573 vm_w2Cell(wior,sp[0]);
9574 LABEL2(close_dir)
9575 NEXT_P1_5;
9576 LABEL3(close_dir)
9577 DO_GOTO;
9578 }
9579 
9580 LABEL(match_file) /* filename-match ( c_addr1 u1 c_addr2 u2 -- flag ) S0 -- S0  */
9581 /*  */
9582 NAME("filename-match")
9583 {
9584 DEF_CA
9585 MAYBE_UNUSED Char * c_addr1;
9586 MAYBE_UNUSED UCell u1;
9587 MAYBE_UNUSED Char * c_addr2;
9588 MAYBE_UNUSED UCell u2;
9589 Bool flag;
9590 NEXT_P0;
9591 vm_Cell2c_(sp[3],c_addr1);
9592 vm_Cell2u(sp[2],u1);
9593 vm_Cell2c_(sp[1],c_addr2);
9594 vm_Cell2u(sp[0],u2);
9595 #ifdef VM_DEBUG
9596 if (vm_debug) {
9597 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
9598 fputs(" u1=", vm_out); printarg_u(u1);
9599 fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
9600 fputs(" u2=", vm_out); printarg_u(u2);
9601 }
9602 #endif
9603 sp += 3;
9604 {
9605 #line 1927 "prim"
9606 char * string = cstr(c_addr1, u1, 1);
9607 char * pattern = cstr(c_addr2, u2, 0);
9608 flag = FLAG(!fnmatch(pattern, string, 0));
9609 #line 9610 "prim.i"
9610 }
9611 
9612 #ifdef VM_DEBUG
9613 if (vm_debug) {
9614 fputs(" -- ", vm_out); fputs(" flag=", vm_out); printarg_f(flag);
9615 fputc('\n', vm_out);
9616 }
9617 #endif
9618 NEXT_P1;
9619 vm_f2Cell(flag,sp[0]);
9620 LABEL2(match_file)
9621 NEXT_P1_5;
9622 LABEL3(match_file)
9623 DO_GOTO;
9624 }
9625 
9626 LABEL(set_dir) /* set-dir ( c_addr u -- wior ) S0 -- S0  */
9627 /* Change the current directory to @i{c-addr, u}.
9628 Return an error if this is not possible */
9629 NAME("set-dir")
9630 {
9631 DEF_CA
9632 MAYBE_UNUSED Char * c_addr;
9633 MAYBE_UNUSED UCell u;
9634 Cell wior;
9635 NEXT_P0;
9636 vm_Cell2c_(sp[1],c_addr);
9637 vm_Cell2u(sp[0],u);
9638 #ifdef VM_DEBUG
9639 if (vm_debug) {
9640 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9641 fputs(" u=", vm_out); printarg_u(u);
9642 }
9643 #endif
9644 sp += 1;
9645 {
9646 #line 1934 "prim"
9647 wior = IOR(chdir(tilde_cstr(c_addr, u, 1)));
9648 #line 9649 "prim.i"
9649 }
9650 
9651 #ifdef VM_DEBUG
9652 if (vm_debug) {
9653 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9654 fputc('\n', vm_out);
9655 }
9656 #endif
9657 NEXT_P1;
9658 vm_w2Cell(wior,sp[0]);
9659 LABEL2(set_dir)
9660 NEXT_P1_5;
9661 LABEL3(set_dir)
9662 DO_GOTO;
9663 }
9664 
9665 LABEL(get_dir) /* get-dir ( c_addr1 u1 -- c_addr2 u2 ) S0 -- S0  */
9666 /* Store the current directory in the buffer specified by @i{c-addr1, u1}.
9667 If the buffer size is not sufficient, return 0 0 */
9668 NAME("get-dir")
9669 {
9670 DEF_CA
9671 MAYBE_UNUSED Char * c_addr1;
9672 MAYBE_UNUSED UCell u1;
9673 Char * c_addr2;
9674 UCell u2;
9675 NEXT_P0;
9676 vm_Cell2c_(sp[1],c_addr1);
9677 vm_Cell2u(sp[0],u1);
9678 #ifdef VM_DEBUG
9679 if (vm_debug) {
9680 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
9681 fputs(" u1=", vm_out); printarg_u(u1);
9682 }
9683 #endif
9684 {
9685 #line 1939 "prim"
9686 c_addr2 = (Char *)getcwd((char *)c_addr1, u1);
9687 if(c_addr2 != NULL) {
9688   u2 = strlen((char *)c_addr2);
9689 } else {
9690   u2 = 0;
9691 }
9692 #line 9693 "prim.i"
9693 }
9694 
9695 #ifdef VM_DEBUG
9696 if (vm_debug) {
9697 fputs(" -- ", vm_out); fputs(" c_addr2=", vm_out); printarg_c_(c_addr2);
9698 fputs(" u2=", vm_out); printarg_u(u2);
9699 fputc('\n', vm_out);
9700 }
9701 #endif
9702 NEXT_P1;
9703 vm_c_2Cell(c_addr2,sp[1]);
9704 vm_u2Cell(u2,sp[0]);
9705 LABEL2(get_dir)
9706 NEXT_P1_5;
9707 LABEL3(get_dir)
9708 DO_GOTO;
9709 }
9710 
9711 LABEL(equals_mkdir) /* =mkdir ( c_addr u wmode -- wior ) S0 -- S0  */
9712 /* Create directory @i{c-addr u} with mode @i{wmode}. */
9713 NAME("=mkdir")
9714 {
9715 DEF_CA
9716 MAYBE_UNUSED Char * c_addr;
9717 MAYBE_UNUSED UCell u;
9718 MAYBE_UNUSED Cell wmode;
9719 Cell wior;
9720 NEXT_P0;
9721 vm_Cell2c_(sp[2],c_addr);
9722 vm_Cell2u(sp[1],u);
9723 vm_Cell2w(sp[0],wmode);
9724 #ifdef VM_DEBUG
9725 if (vm_debug) {
9726 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9727 fputs(" u=", vm_out); printarg_u(u);
9728 fputs(" wmode=", vm_out); printarg_w(wmode);
9729 }
9730 #endif
9731 sp += 2;
9732 {
9733 #line 1948 "prim"
9734 wior = IOR(mkdir(tilde_cstr(c_addr,u,1),wmode));
9735 #line 9736 "prim.i"
9736 }
9737 
9738 #ifdef VM_DEBUG
9739 if (vm_debug) {
9740 fputs(" -- ", vm_out); fputs(" wior=", vm_out); printarg_w(wior);
9741 fputc('\n', vm_out);
9742 }
9743 #endif
9744 NEXT_P1;
9745 vm_w2Cell(wior,sp[0]);
9746 LABEL2(equals_mkdir)
9747 NEXT_P1_5;
9748 LABEL3(equals_mkdir)
9749 DO_GOTO;
9750 }
9751 
9752 GROUPADD(10)
9753 #endif
LABEL(newline)9754 LABEL(newline) /* newline ( -- c_addr u ) S0 -- S0  */
9755 /* String containing the newline sequence of the host OS */
9756 NAME("newline")
9757 {
9758 DEF_CA
9759 Char * c_addr;
9760 UCell u;
9761 NEXT_P0;
9762 #ifdef VM_DEBUG
9763 if (vm_debug) {
9764 }
9765 #endif
9766 sp += -2;
9767 {
9768 #line 1954 "prim"
9769 static const char newline[] = {
9770 #if DIRSEP=='/'
9771 /* Unix */
9772 '\n'
9773 #else
9774 /* DOS, Win, OS/2 */
9775 '\r','\n'
9776 #endif
9777 };
9778 c_addr=(Char *)newline;
9779 u=sizeof(newline);
9780 #line 9781 "prim.i"
9781 }
9782 
9783 #ifdef VM_DEBUG
9784 if (vm_debug) {
9785 fputs(" -- ", vm_out); fputs(" c_addr=", vm_out); printarg_c_(c_addr);
9786 fputs(" u=", vm_out); printarg_u(u);
9787 fputc('\n', vm_out);
9788 }
9789 #endif
9790 NEXT_P1;
9791 vm_c_2Cell(c_addr,sp[1]);
9792 vm_u2Cell(u,sp[0]);
9793 LABEL2(newline)
9794 NEXT_P1_5;
9795 LABEL3(newline)
9796 DO_GOTO;
9797 }
9798 
9799 GROUPADD(1)
9800 #ifdef HAS_OS
LABEL(utime)9801 LABEL(utime) /* utime ( -- dtime ) S0 -- S0  */
9802 /* Report the current time in microseconds since some epoch. */
9803 NAME("utime")
9804 {
9805 DEF_CA
9806 DCell dtime;
9807 NEXT_P0;
9808 #ifdef VM_DEBUG
9809 if (vm_debug) {
9810 }
9811 #endif
9812 sp += -2;
9813 {
9814 #line 1973 "prim"
9815 struct timeval time1;
9816 gettimeofday(&time1,NULL);
9817 dtime = timeval2us(&time1);
9818 #line 9819 "prim.i"
9819 }
9820 
9821 #ifdef VM_DEBUG
9822 if (vm_debug) {
9823 fputs(" -- ", vm_out); fputs(" dtime=", vm_out); printarg_d(dtime);
9824 fputc('\n', vm_out);
9825 }
9826 #endif
9827 NEXT_P1;
9828 vm_d2twoCell(dtime, sp[1], sp[0])
9829 LABEL2(utime)
9830 NEXT_P1_5;
9831 LABEL3(utime)
9832 DO_GOTO;
9833 }
9834 
9835 LABEL(cputime) /* cputime ( -- duser dsystem ) S0 -- S0  */
9836 /* duser and dsystem are the respective user- and system-level CPU
9837 times used since the start of the Forth system (excluding child
9838 processes), in microseconds (the granularity may be much larger,
9839 however).  On platforms without the getrusage call, it reports elapsed
9840 time (since some epoch) for duser and 0 for dsystem. */
9841 NAME("cputime")
9842 {
9843 DEF_CA
9844 DCell duser;
9845 DCell dsystem;
9846 NEXT_P0;
9847 #ifdef VM_DEBUG
9848 if (vm_debug) {
9849 }
9850 #endif
9851 sp += -4;
9852 {
9853 #line 1983 "prim"
9854 #ifdef HAVE_GETRUSAGE
9855 struct rusage usage;
9856 getrusage(RUSAGE_SELF, &usage);
9857 duser = timeval2us(&usage.ru_utime);
9858 dsystem = timeval2us(&usage.ru_stime);
9859 #else
9860 struct timeval time1;
9861 gettimeofday(&time1,NULL);
9862 duser = timeval2us(&time1);
9863 dsystem = DZERO;
9864 #endif
9865 #line 9866 "prim.i"
9866 }
9867 
9868 #ifdef VM_DEBUG
9869 if (vm_debug) {
9870 fputs(" -- ", vm_out); fputs(" duser=", vm_out); printarg_d(duser);
9871 fputs(" dsystem=", vm_out); printarg_d(dsystem);
9872 fputc('\n', vm_out);
9873 }
9874 #endif
9875 NEXT_P1;
9876 vm_d2twoCell(duser, sp[3], sp[2])
9877 vm_d2twoCell(dsystem, sp[1], sp[0])
9878 LABEL2(cputime)
9879 NEXT_P1_5;
9880 LABEL3(cputime)
9881 DO_GOTO;
9882 }
9883 
9884 GROUPADD(2)
9885 #endif
9886 GROUPADD(0)
9887 #ifdef HAS_FLOATING
9888 GROUPADD(0)
9889 GROUP( floating, 226)
LABEL(f_equals)9890 LABEL(f_equals) /* f= ( r1 r2 -- f ) S0 -- S0  */
9891 /*  */
9892 NAME("f=")
9893 {
9894 DEF_CA
9895 MAYBE_UNUSED Float r1;
9896 MAYBE_UNUSED Float r2;
9897 Bool f;
9898 NEXT_P0;
9899 vm_Float2r(fp[1],r1);
9900 vm_Float2r(fp[0],r2);
9901 #ifdef VM_DEBUG
9902 if (vm_debug) {
9903 fputs(" r1=", vm_out); printarg_r(r1);
9904 fputs(" r2=", vm_out); printarg_r(r2);
9905 }
9906 #endif
9907 sp += -1;
9908 fp += 2;
9909 {
9910 #line 2001 "prim"
9911 f = FLAG(r1==r2);
9912 #line 2000
9913 #line 9914 "prim.i"
9914 }
9915 
9916 #ifdef VM_DEBUG
9917 if (vm_debug) {
9918 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
9919 fputc('\n', vm_out);
9920 }
9921 #endif
9922 NEXT_P1;
9923 vm_f2Cell(f,sp[0]);
9924 LABEL2(f_equals)
9925 NEXT_P1_5;
9926 LABEL3(f_equals)
9927 DO_GOTO;
9928 }
9929 
9930 LABEL(f_not_equals) /* f<> ( r1 r2 -- f ) S0 -- S0  */
9931 /*  */
9932 NAME("f<>")
9933 {
9934 DEF_CA
9935 MAYBE_UNUSED Float r1;
9936 MAYBE_UNUSED Float r2;
9937 Bool f;
9938 NEXT_P0;
9939 vm_Float2r(fp[1],r1);
9940 vm_Float2r(fp[0],r2);
9941 #ifdef VM_DEBUG
9942 if (vm_debug) {
9943 fputs(" r1=", vm_out); printarg_r(r1);
9944 fputs(" r2=", vm_out); printarg_r(r2);
9945 }
9946 #endif
9947 sp += -1;
9948 fp += 2;
9949 {
9950 #line 2001 "prim"
9951 f = FLAG(r1!=r2);
9952 #line 2000
9953 #line 9954 "prim.i"
9954 }
9955 
9956 #ifdef VM_DEBUG
9957 if (vm_debug) {
9958 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
9959 fputc('\n', vm_out);
9960 }
9961 #endif
9962 NEXT_P1;
9963 vm_f2Cell(f,sp[0]);
9964 LABEL2(f_not_equals)
9965 NEXT_P1_5;
9966 LABEL3(f_not_equals)
9967 DO_GOTO;
9968 }
9969 
9970 LABEL(f_less_than) /* f< ( r1 r2 -- f ) S0 -- S0  */
9971 /*  */
9972 NAME("f<")
9973 {
9974 DEF_CA
9975 MAYBE_UNUSED Float r1;
9976 MAYBE_UNUSED Float r2;
9977 Bool f;
9978 NEXT_P0;
9979 vm_Float2r(fp[1],r1);
9980 vm_Float2r(fp[0],r2);
9981 #ifdef VM_DEBUG
9982 if (vm_debug) {
9983 fputs(" r1=", vm_out); printarg_r(r1);
9984 fputs(" r2=", vm_out); printarg_r(r2);
9985 }
9986 #endif
9987 sp += -1;
9988 fp += 2;
9989 {
9990 #line 2001 "prim"
9991 f = FLAG(r1<r2);
9992 #line 2000
9993 #line 9994 "prim.i"
9994 }
9995 
9996 #ifdef VM_DEBUG
9997 if (vm_debug) {
9998 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
9999 fputc('\n', vm_out);
10000 }
10001 #endif
10002 NEXT_P1;
10003 vm_f2Cell(f,sp[0]);
10004 LABEL2(f_less_than)
10005 NEXT_P1_5;
10006 LABEL3(f_less_than)
10007 DO_GOTO;
10008 }
10009 
10010 LABEL(f_greater_than) /* f> ( r1 r2 -- f ) S0 -- S0  */
10011 /*  */
10012 NAME("f>")
10013 {
10014 DEF_CA
10015 MAYBE_UNUSED Float r1;
10016 MAYBE_UNUSED Float r2;
10017 Bool f;
10018 NEXT_P0;
10019 vm_Float2r(fp[1],r1);
10020 vm_Float2r(fp[0],r2);
10021 #ifdef VM_DEBUG
10022 if (vm_debug) {
10023 fputs(" r1=", vm_out); printarg_r(r1);
10024 fputs(" r2=", vm_out); printarg_r(r2);
10025 }
10026 #endif
10027 sp += -1;
10028 fp += 2;
10029 {
10030 #line 2001 "prim"
10031 f = FLAG(r1>r2);
10032 #line 2000
10033 #line 10034 "prim.i"
10034 }
10035 
10036 #ifdef VM_DEBUG
10037 if (vm_debug) {
10038 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10039 fputc('\n', vm_out);
10040 }
10041 #endif
10042 NEXT_P1;
10043 vm_f2Cell(f,sp[0]);
10044 LABEL2(f_greater_than)
10045 NEXT_P1_5;
10046 LABEL3(f_greater_than)
10047 DO_GOTO;
10048 }
10049 
10050 LABEL(f_less_or_equal) /* f<= ( r1 r2 -- f ) S0 -- S0  */
10051 /*  */
10052 NAME("f<=")
10053 {
10054 DEF_CA
10055 MAYBE_UNUSED Float r1;
10056 MAYBE_UNUSED Float r2;
10057 Bool f;
10058 NEXT_P0;
10059 vm_Float2r(fp[1],r1);
10060 vm_Float2r(fp[0],r2);
10061 #ifdef VM_DEBUG
10062 if (vm_debug) {
10063 fputs(" r1=", vm_out); printarg_r(r1);
10064 fputs(" r2=", vm_out); printarg_r(r2);
10065 }
10066 #endif
10067 sp += -1;
10068 fp += 2;
10069 {
10070 #line 2001 "prim"
10071 f = FLAG(r1<=r2);
10072 #line 2000
10073 #line 10074 "prim.i"
10074 }
10075 
10076 #ifdef VM_DEBUG
10077 if (vm_debug) {
10078 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10079 fputc('\n', vm_out);
10080 }
10081 #endif
10082 NEXT_P1;
10083 vm_f2Cell(f,sp[0]);
10084 LABEL2(f_less_or_equal)
10085 NEXT_P1_5;
10086 LABEL3(f_less_or_equal)
10087 DO_GOTO;
10088 }
10089 
10090 LABEL(f_greater_or_equal) /* f>= ( r1 r2 -- f ) S0 -- S0  */
10091 /*  */
10092 NAME("f>=")
10093 {
10094 DEF_CA
10095 MAYBE_UNUSED Float r1;
10096 MAYBE_UNUSED Float r2;
10097 Bool f;
10098 NEXT_P0;
10099 vm_Float2r(fp[1],r1);
10100 vm_Float2r(fp[0],r2);
10101 #ifdef VM_DEBUG
10102 if (vm_debug) {
10103 fputs(" r1=", vm_out); printarg_r(r1);
10104 fputs(" r2=", vm_out); printarg_r(r2);
10105 }
10106 #endif
10107 sp += -1;
10108 fp += 2;
10109 {
10110 #line 2001 "prim"
10111 f = FLAG(r1>=r2);
10112 #line 2000
10113 #line 10114 "prim.i"
10114 }
10115 
10116 #ifdef VM_DEBUG
10117 if (vm_debug) {
10118 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10119 fputc('\n', vm_out);
10120 }
10121 #endif
10122 NEXT_P1;
10123 vm_f2Cell(f,sp[0]);
10124 LABEL2(f_greater_or_equal)
10125 NEXT_P1_5;
10126 LABEL3(f_greater_or_equal)
10127 DO_GOTO;
10128 }
10129 
10130 LABEL(f_zero_equals) /* f0= ( r -- f ) S0 -- S0  */
10131 /*  */
10132 NAME("f0=")
10133 {
10134 DEF_CA
10135 MAYBE_UNUSED Float r;
10136 Bool f;
10137 NEXT_P0;
10138 vm_Float2r(fp[0],r);
10139 #ifdef VM_DEBUG
10140 if (vm_debug) {
10141 fputs(" r=", vm_out); printarg_r(r);
10142 }
10143 #endif
10144 sp += -1;
10145 fp += 1;
10146 {
10147 #line 2002 "prim"
10148 f = FLAG(r==0.);
10149 #line 2001
10150 #line 10151 "prim.i"
10151 }
10152 
10153 #ifdef VM_DEBUG
10154 if (vm_debug) {
10155 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10156 fputc('\n', vm_out);
10157 }
10158 #endif
10159 NEXT_P1;
10160 vm_f2Cell(f,sp[0]);
10161 LABEL2(f_zero_equals)
10162 NEXT_P1_5;
10163 LABEL3(f_zero_equals)
10164 DO_GOTO;
10165 }
10166 
10167 LABEL(f_zero_not_equals) /* f0<> ( r -- f ) S0 -- S0  */
10168 /*  */
10169 NAME("f0<>")
10170 {
10171 DEF_CA
10172 MAYBE_UNUSED Float r;
10173 Bool f;
10174 NEXT_P0;
10175 vm_Float2r(fp[0],r);
10176 #ifdef VM_DEBUG
10177 if (vm_debug) {
10178 fputs(" r=", vm_out); printarg_r(r);
10179 }
10180 #endif
10181 sp += -1;
10182 fp += 1;
10183 {
10184 #line 2002 "prim"
10185 f = FLAG(r!=0.);
10186 #line 2001
10187 #line 10188 "prim.i"
10188 }
10189 
10190 #ifdef VM_DEBUG
10191 if (vm_debug) {
10192 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10193 fputc('\n', vm_out);
10194 }
10195 #endif
10196 NEXT_P1;
10197 vm_f2Cell(f,sp[0]);
10198 LABEL2(f_zero_not_equals)
10199 NEXT_P1_5;
10200 LABEL3(f_zero_not_equals)
10201 DO_GOTO;
10202 }
10203 
10204 LABEL(f_zero_less_than) /* f0< ( r -- f ) S0 -- S0  */
10205 /*  */
10206 NAME("f0<")
10207 {
10208 DEF_CA
10209 MAYBE_UNUSED Float r;
10210 Bool f;
10211 NEXT_P0;
10212 vm_Float2r(fp[0],r);
10213 #ifdef VM_DEBUG
10214 if (vm_debug) {
10215 fputs(" r=", vm_out); printarg_r(r);
10216 }
10217 #endif
10218 sp += -1;
10219 fp += 1;
10220 {
10221 #line 2002 "prim"
10222 f = FLAG(r<0.);
10223 #line 2001
10224 #line 10225 "prim.i"
10225 }
10226 
10227 #ifdef VM_DEBUG
10228 if (vm_debug) {
10229 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10230 fputc('\n', vm_out);
10231 }
10232 #endif
10233 NEXT_P1;
10234 vm_f2Cell(f,sp[0]);
10235 LABEL2(f_zero_less_than)
10236 NEXT_P1_5;
10237 LABEL3(f_zero_less_than)
10238 DO_GOTO;
10239 }
10240 
10241 LABEL(f_zero_greater_than) /* f0> ( r -- f ) S0 -- S0  */
10242 /*  */
10243 NAME("f0>")
10244 {
10245 DEF_CA
10246 MAYBE_UNUSED Float r;
10247 Bool f;
10248 NEXT_P0;
10249 vm_Float2r(fp[0],r);
10250 #ifdef VM_DEBUG
10251 if (vm_debug) {
10252 fputs(" r=", vm_out); printarg_r(r);
10253 }
10254 #endif
10255 sp += -1;
10256 fp += 1;
10257 {
10258 #line 2002 "prim"
10259 f = FLAG(r>0.);
10260 #line 2001
10261 #line 10262 "prim.i"
10262 }
10263 
10264 #ifdef VM_DEBUG
10265 if (vm_debug) {
10266 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10267 fputc('\n', vm_out);
10268 }
10269 #endif
10270 NEXT_P1;
10271 vm_f2Cell(f,sp[0]);
10272 LABEL2(f_zero_greater_than)
10273 NEXT_P1_5;
10274 LABEL3(f_zero_greater_than)
10275 DO_GOTO;
10276 }
10277 
10278 LABEL(f_zero_less_or_equal) /* f0<= ( r -- f ) S0 -- S0  */
10279 /*  */
10280 NAME("f0<=")
10281 {
10282 DEF_CA
10283 MAYBE_UNUSED Float r;
10284 Bool f;
10285 NEXT_P0;
10286 vm_Float2r(fp[0],r);
10287 #ifdef VM_DEBUG
10288 if (vm_debug) {
10289 fputs(" r=", vm_out); printarg_r(r);
10290 }
10291 #endif
10292 sp += -1;
10293 fp += 1;
10294 {
10295 #line 2002 "prim"
10296 f = FLAG(r<=0.);
10297 #line 2001
10298 #line 10299 "prim.i"
10299 }
10300 
10301 #ifdef VM_DEBUG
10302 if (vm_debug) {
10303 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10304 fputc('\n', vm_out);
10305 }
10306 #endif
10307 NEXT_P1;
10308 vm_f2Cell(f,sp[0]);
10309 LABEL2(f_zero_less_or_equal)
10310 NEXT_P1_5;
10311 LABEL3(f_zero_less_or_equal)
10312 DO_GOTO;
10313 }
10314 
10315 LABEL(f_zero_greater_or_equal) /* f0>= ( r -- f ) S0 -- S0  */
10316 /*  */
10317 NAME("f0>=")
10318 {
10319 DEF_CA
10320 MAYBE_UNUSED Float r;
10321 Bool f;
10322 NEXT_P0;
10323 vm_Float2r(fp[0],r);
10324 #ifdef VM_DEBUG
10325 if (vm_debug) {
10326 fputs(" r=", vm_out); printarg_r(r);
10327 }
10328 #endif
10329 sp += -1;
10330 fp += 1;
10331 {
10332 #line 2002 "prim"
10333 f = FLAG(r>=0.);
10334 #line 2001
10335 #line 10336 "prim.i"
10336 }
10337 
10338 #ifdef VM_DEBUG
10339 if (vm_debug) {
10340 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
10341 fputc('\n', vm_out);
10342 }
10343 #endif
10344 NEXT_P1;
10345 vm_f2Cell(f,sp[0]);
10346 LABEL2(f_zero_greater_or_equal)
10347 NEXT_P1_5;
10348 LABEL3(f_zero_greater_or_equal)
10349 DO_GOTO;
10350 }
10351 
10352 LABEL(s_to_f) /* s>f ( n -- r ) S0 -- S0  */
10353 /*  */
10354 NAME("s>f")
10355 {
10356 DEF_CA
10357 MAYBE_UNUSED Cell n;
10358 Float r;
10359 NEXT_P0;
10360 vm_Cell2n(sp[0],n);
10361 #ifdef VM_DEBUG
10362 if (vm_debug) {
10363 fputs(" n=", vm_out); printarg_n(n);
10364 }
10365 #endif
10366 sp += 1;
10367 fp += -1;
10368 {
10369 #line 2005 "prim"
10370 r = n;
10371 #line 10372 "prim.i"
10372 }
10373 
10374 #ifdef VM_DEBUG
10375 if (vm_debug) {
10376 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
10377 fputc('\n', vm_out);
10378 }
10379 #endif
10380 NEXT_P1;
10381 vm_r2Float(r,fp[0]);
10382 LABEL2(s_to_f)
10383 NEXT_P1_5;
10384 LABEL3(s_to_f)
10385 DO_GOTO;
10386 }
10387 
10388 LABEL(d_to_f) /* d>f ( d -- r ) S0 -- S0  */
10389 /*  */
10390 NAME("d>f")
10391 {
10392 DEF_CA
10393 MAYBE_UNUSED DCell d;
10394 Float r;
10395 NEXT_P0;
10396 vm_twoCell2d(sp[1], sp[0], d)
10397 #ifdef VM_DEBUG
10398 if (vm_debug) {
10399 fputs(" d=", vm_out); printarg_d(d);
10400 }
10401 #endif
10402 sp += 2;
10403 fp += -1;
10404 {
10405 #line 2008 "prim"
10406 #ifdef BUGGY_LL_D2F
10407 extern double ldexp(double x, int exp);
10408 if (DHI(d)<0) {
10409 #ifdef BUGGY_LL_ADD
10410   DCell d2=dnegate(d);
10411 #else
10412   DCell d2=-d;
10413 #endif
10414   r = -(ldexp((Float)DHI(d2),CELL_BITS) + (Float)DLO(d2));
10415 } else
10416   r = ldexp((Float)DHI(d),CELL_BITS) + (Float)DLO(d);
10417 #else
10418 r = d;
10419 #endif
10420 #line 10421 "prim.i"
10421 }
10422 
10423 #ifdef VM_DEBUG
10424 if (vm_debug) {
10425 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
10426 fputc('\n', vm_out);
10427 }
10428 #endif
10429 NEXT_P1;
10430 vm_r2Float(r,fp[0]);
10431 LABEL2(d_to_f)
10432 NEXT_P1_5;
10433 LABEL3(d_to_f)
10434 DO_GOTO;
10435 }
10436 
10437 LABEL(f_to_d) /* f>d ( r -- d ) S0 -- S0  */
10438 /*  */
10439 NAME("f>d")
10440 {
10441 DEF_CA
10442 MAYBE_UNUSED Float r;
10443 DCell d;
10444 NEXT_P0;
10445 vm_Float2r(fp[0],r);
10446 #ifdef VM_DEBUG
10447 if (vm_debug) {
10448 fputs(" r=", vm_out); printarg_r(r);
10449 }
10450 #endif
10451 sp += -2;
10452 fp += 1;
10453 {
10454 #line 2024 "prim"
10455 extern DCell double2ll(Float r);
10456 d = double2ll(r);
10457 #line 10458 "prim.i"
10458 }
10459 
10460 #ifdef VM_DEBUG
10461 if (vm_debug) {
10462 fputs(" -- ", vm_out); fputs(" d=", vm_out); printarg_d(d);
10463 fputc('\n', vm_out);
10464 }
10465 #endif
10466 NEXT_P1;
10467 vm_d2twoCell(d, sp[1], sp[0])
10468 LABEL2(f_to_d)
10469 NEXT_P1_5;
10470 LABEL3(f_to_d)
10471 DO_GOTO;
10472 }
10473 
10474 LABEL(f_to_s) /* f>s ( r -- n ) S0 -- S0  */
10475 /*  */
10476 NAME("f>s")
10477 {
10478 DEF_CA
10479 MAYBE_UNUSED Float r;
10480 Cell n;
10481 NEXT_P0;
10482 vm_Float2r(fp[0],r);
10483 #ifdef VM_DEBUG
10484 if (vm_debug) {
10485 fputs(" r=", vm_out); printarg_r(r);
10486 }
10487 #endif
10488 sp += -1;
10489 fp += 1;
10490 {
10491 #line 2028 "prim"
10492 n = (Cell)r;
10493 #line 10494 "prim.i"
10494 }
10495 
10496 #ifdef VM_DEBUG
10497 if (vm_debug) {
10498 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
10499 fputc('\n', vm_out);
10500 }
10501 #endif
10502 NEXT_P1;
10503 vm_n2Cell(n,sp[0]);
10504 LABEL2(f_to_s)
10505 NEXT_P1_5;
10506 LABEL3(f_to_s)
10507 DO_GOTO;
10508 }
10509 
10510 LABEL(f_store) /* f! ( r f_addr -- ) S0 -- S0  */
10511 /* Store @i{r} into the float at address @i{f-addr}. */
10512 NAME("f!")
10513 {
10514 DEF_CA
10515 MAYBE_UNUSED Float r;
10516 MAYBE_UNUSED Float * f_addr;
10517 NEXT_P0;
10518 vm_Float2r(fp[0],r);
10519 vm_Cell2f_(sp[0],f_addr);
10520 #ifdef VM_DEBUG
10521 if (vm_debug) {
10522 fputs(" r=", vm_out); printarg_r(r);
10523 fputs(" f_addr=", vm_out); printarg_f_(f_addr);
10524 }
10525 #endif
10526 sp += 1;
10527 fp += 1;
10528 {
10529 #line 2032 "prim"
10530 *f_addr = r;
10531 #line 10532 "prim.i"
10532 }
10533 
10534 #ifdef VM_DEBUG
10535 if (vm_debug) {
10536 fputs(" -- ", vm_out); fputc('\n', vm_out);
10537 }
10538 #endif
10539 NEXT_P1;
10540 LABEL2(f_store)
10541 NEXT_P1_5;
10542 LABEL3(f_store)
10543 DO_GOTO;
10544 }
10545 
10546 LABEL(f_fetch) /* f@ ( f_addr -- r ) S0 -- S0  */
10547 /* @i{r} is the float at address @i{f-addr}. */
10548 NAME("f@")
10549 {
10550 DEF_CA
10551 MAYBE_UNUSED Float * f_addr;
10552 Float r;
10553 NEXT_P0;
10554 vm_Cell2f_(sp[0],f_addr);
10555 #ifdef VM_DEBUG
10556 if (vm_debug) {
10557 fputs(" f_addr=", vm_out); printarg_f_(f_addr);
10558 }
10559 #endif
10560 sp += 1;
10561 fp += -1;
10562 {
10563 #line 2036 "prim"
10564 r = *f_addr;
10565 #line 10566 "prim.i"
10566 }
10567 
10568 #ifdef VM_DEBUG
10569 if (vm_debug) {
10570 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
10571 fputc('\n', vm_out);
10572 }
10573 #endif
10574 NEXT_P1;
10575 vm_r2Float(r,fp[0]);
10576 LABEL2(f_fetch)
10577 NEXT_P1_5;
10578 LABEL3(f_fetch)
10579 DO_GOTO;
10580 }
10581 
10582 LABEL(d_f_fetch) /* df@ ( df_addr -- r ) S0 -- S0  */
10583 /* Fetch the double-precision IEEE floating-point value @i{r} from the address @i{df-addr}. */
10584 NAME("df@")
10585 {
10586 DEF_CA
10587 MAYBE_UNUSED DFloat * df_addr;
10588 Float r;
10589 NEXT_P0;
10590 vm_Cell2df_(sp[0],df_addr);
10591 #ifdef VM_DEBUG
10592 if (vm_debug) {
10593 fputs(" df_addr=", vm_out); printarg_df_(df_addr);
10594 }
10595 #endif
10596 sp += 1;
10597 fp += -1;
10598 {
10599 #line 2040 "prim"
10600 #ifdef IEEE_FP
10601 r = *df_addr;
10602 #else
10603 !! df@
10604 #endif
10605 #line 10606 "prim.i"
10606 }
10607 
10608 #ifdef VM_DEBUG
10609 if (vm_debug) {
10610 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
10611 fputc('\n', vm_out);
10612 }
10613 #endif
10614 NEXT_P1;
10615 vm_r2Float(r,fp[0]);
10616 LABEL2(d_f_fetch)
10617 NEXT_P1_5;
10618 LABEL3(d_f_fetch)
10619 DO_GOTO;
10620 }
10621 
10622 LABEL(d_f_store) /* df! ( r df_addr -- ) S0 -- S0  */
10623 /* Store @i{r} as double-precision IEEE floating-point value to the
10624 address @i{df-addr}. */
10625 NAME("df!")
10626 {
10627 DEF_CA
10628 MAYBE_UNUSED Float r;
10629 MAYBE_UNUSED DFloat * df_addr;
10630 NEXT_P0;
10631 vm_Float2r(fp[0],r);
10632 vm_Cell2df_(sp[0],df_addr);
10633 #ifdef VM_DEBUG
10634 if (vm_debug) {
10635 fputs(" r=", vm_out); printarg_r(r);
10636 fputs(" df_addr=", vm_out); printarg_df_(df_addr);
10637 }
10638 #endif
10639 sp += 1;
10640 fp += 1;
10641 {
10642 #line 2049 "prim"
10643 #ifdef IEEE_FP
10644 *df_addr = r;
10645 #else
10646 !! df!
10647 #endif
10648 #line 10649 "prim.i"
10649 }
10650 
10651 #ifdef VM_DEBUG
10652 if (vm_debug) {
10653 fputs(" -- ", vm_out); fputc('\n', vm_out);
10654 }
10655 #endif
10656 NEXT_P1;
10657 LABEL2(d_f_store)
10658 NEXT_P1_5;
10659 LABEL3(d_f_store)
10660 DO_GOTO;
10661 }
10662 
10663 LABEL(s_f_fetch) /* sf@ ( sf_addr -- r ) S0 -- S0  */
10664 /* Fetch the single-precision IEEE floating-point value @i{r} from the address @i{sf-addr}. */
10665 NAME("sf@")
10666 {
10667 DEF_CA
10668 MAYBE_UNUSED SFloat * sf_addr;
10669 Float r;
10670 NEXT_P0;
10671 vm_Cell2sf_(sp[0],sf_addr);
10672 #ifdef VM_DEBUG
10673 if (vm_debug) {
10674 fputs(" sf_addr=", vm_out); printarg_sf_(sf_addr);
10675 }
10676 #endif
10677 sp += 1;
10678 fp += -1;
10679 {
10680 #line 2057 "prim"
10681 #ifdef IEEE_FP
10682 r = *sf_addr;
10683 #else
10684 !! sf@
10685 #endif
10686 #line 10687 "prim.i"
10687 }
10688 
10689 #ifdef VM_DEBUG
10690 if (vm_debug) {
10691 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
10692 fputc('\n', vm_out);
10693 }
10694 #endif
10695 NEXT_P1;
10696 vm_r2Float(r,fp[0]);
10697 LABEL2(s_f_fetch)
10698 NEXT_P1_5;
10699 LABEL3(s_f_fetch)
10700 DO_GOTO;
10701 }
10702 
10703 LABEL(s_f_store) /* sf! ( r sf_addr -- ) S0 -- S0  */
10704 /* Store @i{r} as single-precision IEEE floating-point value to the
10705 address @i{sf-addr}. */
10706 NAME("sf!")
10707 {
10708 DEF_CA
10709 MAYBE_UNUSED Float r;
10710 MAYBE_UNUSED SFloat * sf_addr;
10711 NEXT_P0;
10712 vm_Float2r(fp[0],r);
10713 vm_Cell2sf_(sp[0],sf_addr);
10714 #ifdef VM_DEBUG
10715 if (vm_debug) {
10716 fputs(" r=", vm_out); printarg_r(r);
10717 fputs(" sf_addr=", vm_out); printarg_sf_(sf_addr);
10718 }
10719 #endif
10720 sp += 1;
10721 fp += 1;
10722 {
10723 #line 2066 "prim"
10724 #ifdef IEEE_FP
10725 *sf_addr = r;
10726 #else
10727 !! sf!
10728 #endif
10729 #line 10730 "prim.i"
10730 }
10731 
10732 #ifdef VM_DEBUG
10733 if (vm_debug) {
10734 fputs(" -- ", vm_out); fputc('\n', vm_out);
10735 }
10736 #endif
10737 NEXT_P1;
10738 LABEL2(s_f_store)
10739 NEXT_P1_5;
10740 LABEL3(s_f_store)
10741 DO_GOTO;
10742 }
10743 
10744 LABEL(f_plus) /* f+ ( r1 r2 -- r3 ) S0 -- S0  */
10745 /*  */
10746 NAME("f+")
10747 {
10748 DEF_CA
10749 MAYBE_UNUSED Float r1;
10750 MAYBE_UNUSED Float r2;
10751 Float r3;
10752 NEXT_P0;
10753 vm_Float2r(fp[1],r1);
10754 vm_Float2r(fp[0],r2);
10755 #ifdef VM_DEBUG
10756 if (vm_debug) {
10757 fputs(" r1=", vm_out); printarg_r(r1);
10758 fputs(" r2=", vm_out); printarg_r(r2);
10759 }
10760 #endif
10761 fp += 1;
10762 {
10763 #line 2073 "prim"
10764 r3 = r1+r2;
10765 #line 10766 "prim.i"
10766 }
10767 
10768 #ifdef VM_DEBUG
10769 if (vm_debug) {
10770 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
10771 fputc('\n', vm_out);
10772 }
10773 #endif
10774 NEXT_P1;
10775 vm_r2Float(r3,fp[0]);
10776 LABEL2(f_plus)
10777 NEXT_P1_5;
10778 LABEL3(f_plus)
10779 DO_GOTO;
10780 }
10781 
10782 LABEL(f_minus) /* f- ( r1 r2 -- r3 ) S0 -- S0  */
10783 /*  */
10784 NAME("f-")
10785 {
10786 DEF_CA
10787 MAYBE_UNUSED Float r1;
10788 MAYBE_UNUSED Float r2;
10789 Float r3;
10790 NEXT_P0;
10791 vm_Float2r(fp[1],r1);
10792 vm_Float2r(fp[0],r2);
10793 #ifdef VM_DEBUG
10794 if (vm_debug) {
10795 fputs(" r1=", vm_out); printarg_r(r1);
10796 fputs(" r2=", vm_out); printarg_r(r2);
10797 }
10798 #endif
10799 fp += 1;
10800 {
10801 #line 2076 "prim"
10802 r3 = r1-r2;
10803 #line 10804 "prim.i"
10804 }
10805 
10806 #ifdef VM_DEBUG
10807 if (vm_debug) {
10808 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
10809 fputc('\n', vm_out);
10810 }
10811 #endif
10812 NEXT_P1;
10813 vm_r2Float(r3,fp[0]);
10814 LABEL2(f_minus)
10815 NEXT_P1_5;
10816 LABEL3(f_minus)
10817 DO_GOTO;
10818 }
10819 
10820 LABEL(f_star) /* f* ( r1 r2 -- r3 ) S0 -- S0  */
10821 /*  */
10822 NAME("f*")
10823 {
10824 DEF_CA
10825 MAYBE_UNUSED Float r1;
10826 MAYBE_UNUSED Float r2;
10827 Float r3;
10828 NEXT_P0;
10829 vm_Float2r(fp[1],r1);
10830 vm_Float2r(fp[0],r2);
10831 #ifdef VM_DEBUG
10832 if (vm_debug) {
10833 fputs(" r1=", vm_out); printarg_r(r1);
10834 fputs(" r2=", vm_out); printarg_r(r2);
10835 }
10836 #endif
10837 fp += 1;
10838 {
10839 #line 2079 "prim"
10840 r3 = r1*r2;
10841 #line 10842 "prim.i"
10842 }
10843 
10844 #ifdef VM_DEBUG
10845 if (vm_debug) {
10846 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
10847 fputc('\n', vm_out);
10848 }
10849 #endif
10850 NEXT_P1;
10851 vm_r2Float(r3,fp[0]);
10852 LABEL2(f_star)
10853 NEXT_P1_5;
10854 LABEL3(f_star)
10855 DO_GOTO;
10856 }
10857 
10858 LABEL(f_slash) /* f/ ( r1 r2 -- r3 ) S0 -- S0  */
10859 /*  */
10860 NAME("f/")
10861 {
10862 DEF_CA
10863 MAYBE_UNUSED Float r1;
10864 MAYBE_UNUSED Float r2;
10865 Float r3;
10866 NEXT_P0;
10867 vm_Float2r(fp[1],r1);
10868 vm_Float2r(fp[0],r2);
10869 #ifdef VM_DEBUG
10870 if (vm_debug) {
10871 fputs(" r1=", vm_out); printarg_r(r1);
10872 fputs(" r2=", vm_out); printarg_r(r2);
10873 }
10874 #endif
10875 fp += 1;
10876 {
10877 #line 2082 "prim"
10878 r3 = r1/r2;
10879 #line 10880 "prim.i"
10880 }
10881 
10882 #ifdef VM_DEBUG
10883 if (vm_debug) {
10884 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
10885 fputc('\n', vm_out);
10886 }
10887 #endif
10888 NEXT_P1;
10889 vm_r2Float(r3,fp[0]);
10890 LABEL2(f_slash)
10891 NEXT_P1_5;
10892 LABEL3(f_slash)
10893 DO_GOTO;
10894 }
10895 
10896 LABEL(f_star_star) /* f** ( r1 r2 -- r3 ) S0 -- S0  */
10897 /* @i{r3} is @i{r1} raised to the @i{r2}th power. */
10898 NAME("f**")
10899 {
10900 DEF_CA
10901 MAYBE_UNUSED Float r1;
10902 MAYBE_UNUSED Float r2;
10903 Float r3;
10904 NEXT_P0;
10905 vm_Float2r(fp[1],r1);
10906 vm_Float2r(fp[0],r2);
10907 #ifdef VM_DEBUG
10908 if (vm_debug) {
10909 fputs(" r1=", vm_out); printarg_r(r1);
10910 fputs(" r2=", vm_out); printarg_r(r2);
10911 }
10912 #endif
10913 fp += 1;
10914 {
10915 #line 2086 "prim"
10916 CLOBBER_TOS_WORKAROUND_START;
10917 r3 = pow(r1,r2);
10918 CLOBBER_TOS_WORKAROUND_END;
10919 #line 10920 "prim.i"
10920 }
10921 
10922 #ifdef VM_DEBUG
10923 if (vm_debug) {
10924 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
10925 fputc('\n', vm_out);
10926 }
10927 #endif
10928 NEXT_P1;
10929 vm_r2Float(r3,fp[0]);
10930 LABEL2(f_star_star)
10931 NEXT_P1_5;
10932 LABEL3(f_star_star)
10933 DO_GOTO;
10934 }
10935 
10936 LABEL(fm_star) /* fm* ( r1 n -- r2 ) S0 -- S0  */
10937 /*  */
10938 NAME("fm*")
10939 {
10940 DEF_CA
10941 MAYBE_UNUSED Float r1;
10942 MAYBE_UNUSED Cell n;
10943 Float r2;
10944 NEXT_P0;
10945 vm_Float2r(fp[0],r1);
10946 vm_Cell2n(sp[0],n);
10947 #ifdef VM_DEBUG
10948 if (vm_debug) {
10949 fputs(" r1=", vm_out); printarg_r(r1);
10950 fputs(" n=", vm_out); printarg_n(n);
10951 }
10952 #endif
10953 sp += 1;
10954 {
10955 #line 2091 "prim"
10956 r2 = r1*n;
10957 #line 10958 "prim.i"
10958 }
10959 
10960 #ifdef VM_DEBUG
10961 if (vm_debug) {
10962 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
10963 fputc('\n', vm_out);
10964 }
10965 #endif
10966 NEXT_P1;
10967 vm_r2Float(r2,fp[0]);
10968 LABEL2(fm_star)
10969 NEXT_P1_5;
10970 LABEL3(fm_star)
10971 DO_GOTO;
10972 }
10973 
10974 LABEL(fm_slash) /* fm/ ( r1 n -- r2 ) S0 -- S0  */
10975 /*  */
10976 NAME("fm/")
10977 {
10978 DEF_CA
10979 MAYBE_UNUSED Float r1;
10980 MAYBE_UNUSED Cell n;
10981 Float r2;
10982 NEXT_P0;
10983 vm_Float2r(fp[0],r1);
10984 vm_Cell2n(sp[0],n);
10985 #ifdef VM_DEBUG
10986 if (vm_debug) {
10987 fputs(" r1=", vm_out); printarg_r(r1);
10988 fputs(" n=", vm_out); printarg_n(n);
10989 }
10990 #endif
10991 sp += 1;
10992 {
10993 #line 2094 "prim"
10994 r2 = r1/n;
10995 #line 10996 "prim.i"
10996 }
10997 
10998 #ifdef VM_DEBUG
10999 if (vm_debug) {
11000 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11001 fputc('\n', vm_out);
11002 }
11003 #endif
11004 NEXT_P1;
11005 vm_r2Float(r2,fp[0]);
11006 LABEL2(fm_slash)
11007 NEXT_P1_5;
11008 LABEL3(fm_slash)
11009 DO_GOTO;
11010 }
11011 
11012 LABEL(fm_star_slash) /* fmx/ ( r1 n1 n2 -- r2 ) S0 -- S0  */
11013 /*  */
11014 NAME("fm*/")
11015 {
11016 DEF_CA
11017 MAYBE_UNUSED Float r1;
11018 MAYBE_UNUSED Cell n1;
11019 MAYBE_UNUSED Cell n2;
11020 Float r2;
11021 NEXT_P0;
11022 vm_Float2r(fp[0],r1);
11023 vm_Cell2n(sp[1],n1);
11024 vm_Cell2n(sp[0],n2);
11025 #ifdef VM_DEBUG
11026 if (vm_debug) {
11027 fputs(" r1=", vm_out); printarg_r(r1);
11028 fputs(" n1=", vm_out); printarg_n(n1);
11029 fputs(" n2=", vm_out); printarg_n(n2);
11030 }
11031 #endif
11032 sp += 2;
11033 {
11034 #line 2097 "prim"
11035 r2 = (r1*n1)/n2;
11036 #line 11037 "prim.i"
11037 }
11038 
11039 #ifdef VM_DEBUG
11040 if (vm_debug) {
11041 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11042 fputc('\n', vm_out);
11043 }
11044 #endif
11045 NEXT_P1;
11046 vm_r2Float(r2,fp[0]);
11047 LABEL2(fm_star_slash)
11048 NEXT_P1_5;
11049 LABEL3(fm_star_slash)
11050 DO_GOTO;
11051 }
11052 
11053 LABEL(fm_square) /* f**2 ( r1 -- r2 ) S0 -- S0  */
11054 /*  */
11055 NAME("f**2")
11056 {
11057 DEF_CA
11058 MAYBE_UNUSED Float r1;
11059 Float r2;
11060 NEXT_P0;
11061 vm_Float2r(fp[0],r1);
11062 #ifdef VM_DEBUG
11063 if (vm_debug) {
11064 fputs(" r1=", vm_out); printarg_r(r1);
11065 }
11066 #endif
11067 {
11068 #line 2100 "prim"
11069 r2 = r1*r1;
11070 #line 11071 "prim.i"
11071 }
11072 
11073 #ifdef VM_DEBUG
11074 if (vm_debug) {
11075 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11076 fputc('\n', vm_out);
11077 }
11078 #endif
11079 NEXT_P1;
11080 vm_r2Float(r2,fp[0]);
11081 LABEL2(fm_square)
11082 NEXT_P1_5;
11083 LABEL3(fm_square)
11084 DO_GOTO;
11085 }
11086 
11087 LABEL(f_negate) /* fnegate ( r1 -- r2 ) S0 -- S0  */
11088 /*  */
11089 NAME("fnegate")
11090 {
11091 DEF_CA
11092 MAYBE_UNUSED Float r1;
11093 Float r2;
11094 NEXT_P0;
11095 vm_Float2r(fp[0],r1);
11096 #ifdef VM_DEBUG
11097 if (vm_debug) {
11098 fputs(" r1=", vm_out); printarg_r(r1);
11099 }
11100 #endif
11101 {
11102 #line 2103 "prim"
11103 r2 = - r1;
11104 #line 11105 "prim.i"
11105 }
11106 
11107 #ifdef VM_DEBUG
11108 if (vm_debug) {
11109 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11110 fputc('\n', vm_out);
11111 }
11112 #endif
11113 NEXT_P1;
11114 vm_r2Float(r2,fp[0]);
11115 LABEL2(f_negate)
11116 NEXT_P1_5;
11117 LABEL3(f_negate)
11118 DO_GOTO;
11119 }
11120 
11121 LABEL(f_drop) /* fdrop ( r -- ) S0 -- S0  */
11122 /*  */
11123 NAME("fdrop")
11124 {
11125 DEF_CA
11126 MAYBE_UNUSED Float r;
11127 NEXT_P0;
11128 vm_Float2r(fp[0],r);
11129 #ifdef VM_DEBUG
11130 if (vm_debug) {
11131 fputs(" r=", vm_out); printarg_r(r);
11132 }
11133 #endif
11134 fp += 1;
11135 {
11136 #line 2106 "prim"
11137 #line 11138 "prim.i"
11138 }
11139 
11140 #ifdef VM_DEBUG
11141 if (vm_debug) {
11142 fputs(" -- ", vm_out); fputc('\n', vm_out);
11143 }
11144 #endif
11145 NEXT_P1;
11146 LABEL2(f_drop)
11147 NEXT_P1_5;
11148 LABEL3(f_drop)
11149 DO_GOTO;
11150 }
11151 
11152 LABEL(f_dupe) /* fdup ( r -- r r ) S0 -- S0  */
11153 /*  */
11154 NAME("fdup")
11155 {
11156 DEF_CA
11157 MAYBE_UNUSED Float r;
11158 NEXT_P0;
11159 vm_Float2r(fp[0],r);
11160 #ifdef VM_DEBUG
11161 if (vm_debug) {
11162 fputs(" r=", vm_out); printarg_r(r);
11163 }
11164 #endif
11165 fp += -1;
11166 {
11167 #line 2108 "prim"
11168 #line 11169 "prim.i"
11169 }
11170 
11171 #ifdef VM_DEBUG
11172 if (vm_debug) {
11173 fputs(" -- ", vm_out); fputc('\n', vm_out);
11174 }
11175 #endif
11176 NEXT_P1;
11177 vm_r2Float(r,fp[0]);
11178 LABEL2(f_dupe)
11179 NEXT_P1_5;
11180 LABEL3(f_dupe)
11181 DO_GOTO;
11182 }
11183 
11184 LABEL(f_swap) /* fswap ( r1 r2 -- r2 r1 ) S0 -- S0  */
11185 /*  */
11186 NAME("fswap")
11187 {
11188 DEF_CA
11189 MAYBE_UNUSED Float r1;
11190 MAYBE_UNUSED Float r2;
11191 NEXT_P0;
11192 vm_Float2r(fp[1],r1);
11193 vm_Float2r(fp[0],r2);
11194 #ifdef VM_DEBUG
11195 if (vm_debug) {
11196 fputs(" r1=", vm_out); printarg_r(r1);
11197 fputs(" r2=", vm_out); printarg_r(r2);
11198 }
11199 #endif
11200 {
11201 #line 2110 "prim"
11202 #line 11203 "prim.i"
11203 }
11204 
11205 #ifdef VM_DEBUG
11206 if (vm_debug) {
11207 fputs(" -- ", vm_out); fputc('\n', vm_out);
11208 }
11209 #endif
11210 NEXT_P1;
11211 vm_r2Float(r2,fp[1]);
11212 vm_r2Float(r1,fp[0]);
11213 LABEL2(f_swap)
11214 NEXT_P1_5;
11215 LABEL3(f_swap)
11216 DO_GOTO;
11217 }
11218 
11219 LABEL(f_over) /* fover ( r1 r2 -- r1 r2 r1 ) S0 -- S0  */
11220 /*  */
11221 NAME("fover")
11222 {
11223 DEF_CA
11224 MAYBE_UNUSED Float r1;
11225 MAYBE_UNUSED Float r2;
11226 NEXT_P0;
11227 vm_Float2r(fp[1],r1);
11228 vm_Float2r(fp[0],r2);
11229 #ifdef VM_DEBUG
11230 if (vm_debug) {
11231 fputs(" r1=", vm_out); printarg_r(r1);
11232 fputs(" r2=", vm_out); printarg_r(r2);
11233 }
11234 #endif
11235 fp += -1;
11236 {
11237 #line 2112 "prim"
11238 #line 11239 "prim.i"
11239 }
11240 
11241 #ifdef VM_DEBUG
11242 if (vm_debug) {
11243 fputs(" -- ", vm_out); fputc('\n', vm_out);
11244 }
11245 #endif
11246 NEXT_P1;
11247 vm_r2Float(r1,fp[0]);
11248 LABEL2(f_over)
11249 NEXT_P1_5;
11250 LABEL3(f_over)
11251 DO_GOTO;
11252 }
11253 
11254 LABEL(f_rote) /* frot ( r1 r2 r3 -- r2 r3 r1 ) S0 -- S0  */
11255 /*  */
11256 NAME("frot")
11257 {
11258 DEF_CA
11259 MAYBE_UNUSED Float r1;
11260 MAYBE_UNUSED Float r2;
11261 MAYBE_UNUSED Float r3;
11262 NEXT_P0;
11263 vm_Float2r(fp[2],r1);
11264 vm_Float2r(fp[1],r2);
11265 vm_Float2r(fp[0],r3);
11266 #ifdef VM_DEBUG
11267 if (vm_debug) {
11268 fputs(" r1=", vm_out); printarg_r(r1);
11269 fputs(" r2=", vm_out); printarg_r(r2);
11270 fputs(" r3=", vm_out); printarg_r(r3);
11271 }
11272 #endif
11273 {
11274 #line 2114 "prim"
11275 #line 11276 "prim.i"
11276 }
11277 
11278 #ifdef VM_DEBUG
11279 if (vm_debug) {
11280 fputs(" -- ", vm_out); fputc('\n', vm_out);
11281 }
11282 #endif
11283 NEXT_P1;
11284 vm_r2Float(r2,fp[2]);
11285 vm_r2Float(r3,fp[1]);
11286 vm_r2Float(r1,fp[0]);
11287 LABEL2(f_rote)
11288 NEXT_P1_5;
11289 LABEL3(f_rote)
11290 DO_GOTO;
11291 }
11292 
11293 LABEL(f_nip) /* fnip ( r1 r2 -- r2 ) S0 -- S0  */
11294 /*  */
11295 NAME("fnip")
11296 {
11297 DEF_CA
11298 MAYBE_UNUSED Float r1;
11299 MAYBE_UNUSED Float r2;
11300 NEXT_P0;
11301 vm_Float2r(fp[1],r1);
11302 vm_Float2r(fp[0],r2);
11303 #ifdef VM_DEBUG
11304 if (vm_debug) {
11305 fputs(" r1=", vm_out); printarg_r(r1);
11306 fputs(" r2=", vm_out); printarg_r(r2);
11307 }
11308 #endif
11309 fp += 1;
11310 {
11311 #line 2116 "prim"
11312 #line 11313 "prim.i"
11313 }
11314 
11315 #ifdef VM_DEBUG
11316 if (vm_debug) {
11317 fputs(" -- ", vm_out); fputc('\n', vm_out);
11318 }
11319 #endif
11320 NEXT_P1;
11321 vm_r2Float(r2,fp[0]);
11322 LABEL2(f_nip)
11323 NEXT_P1_5;
11324 LABEL3(f_nip)
11325 DO_GOTO;
11326 }
11327 
11328 LABEL(f_tuck) /* ftuck ( r1 r2 -- r2 r1 r2 ) S0 -- S0  */
11329 /*  */
11330 NAME("ftuck")
11331 {
11332 DEF_CA
11333 MAYBE_UNUSED Float r1;
11334 MAYBE_UNUSED Float r2;
11335 NEXT_P0;
11336 vm_Float2r(fp[1],r1);
11337 vm_Float2r(fp[0],r2);
11338 #ifdef VM_DEBUG
11339 if (vm_debug) {
11340 fputs(" r1=", vm_out); printarg_r(r1);
11341 fputs(" r2=", vm_out); printarg_r(r2);
11342 }
11343 #endif
11344 fp += -1;
11345 {
11346 #line 2118 "prim"
11347 #line 11348 "prim.i"
11348 }
11349 
11350 #ifdef VM_DEBUG
11351 if (vm_debug) {
11352 fputs(" -- ", vm_out); fputc('\n', vm_out);
11353 }
11354 #endif
11355 NEXT_P1;
11356 vm_r2Float(r2,fp[2]);
11357 vm_r2Float(r1,fp[1]);
11358 vm_r2Float(r2,fp[0]);
11359 LABEL2(f_tuck)
11360 NEXT_P1_5;
11361 LABEL3(f_tuck)
11362 DO_GOTO;
11363 }
11364 
11365 LABEL(float_plus) /* float+ ( f_addr1 -- f_addr2 ) S0 -- S0  */
11366 /* @code{1 floats +}. */
11367 NAME("float+")
11368 {
11369 DEF_CA
11370 MAYBE_UNUSED Float * f_addr1;
11371 Float * f_addr2;
11372 NEXT_P0;
11373 vm_Cell2f_(sp[0],f_addr1);
11374 #ifdef VM_DEBUG
11375 if (vm_debug) {
11376 fputs(" f_addr1=", vm_out); printarg_f_(f_addr1);
11377 }
11378 #endif
11379 {
11380 #line 2121 "prim"
11381 f_addr2 = f_addr1+1;
11382 #line 11383 "prim.i"
11383 }
11384 
11385 #ifdef VM_DEBUG
11386 if (vm_debug) {
11387 fputs(" -- ", vm_out); fputs(" f_addr2=", vm_out); printarg_f_(f_addr2);
11388 fputc('\n', vm_out);
11389 }
11390 #endif
11391 NEXT_P1;
11392 vm_f_2Cell(f_addr2,sp[0]);
11393 LABEL2(float_plus)
11394 NEXT_P1_5;
11395 LABEL3(float_plus)
11396 DO_GOTO;
11397 }
11398 
11399 LABEL(floats) /* floats ( n1 -- n2 ) S0 -- S0  */
11400 /* @i{n2} is the number of address units of @i{n1} floats. */
11401 NAME("floats")
11402 {
11403 DEF_CA
11404 MAYBE_UNUSED Cell n1;
11405 Cell n2;
11406 NEXT_P0;
11407 vm_Cell2n(sp[0],n1);
11408 #ifdef VM_DEBUG
11409 if (vm_debug) {
11410 fputs(" n1=", vm_out); printarg_n(n1);
11411 }
11412 #endif
11413 {
11414 #line 2125 "prim"
11415 n2 = n1*sizeof(Float);
11416 #line 11417 "prim.i"
11417 }
11418 
11419 #ifdef VM_DEBUG
11420 if (vm_debug) {
11421 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
11422 fputc('\n', vm_out);
11423 }
11424 #endif
11425 NEXT_P1;
11426 vm_n2Cell(n2,sp[0]);
11427 LABEL2(floats)
11428 NEXT_P1_5;
11429 LABEL3(floats)
11430 DO_GOTO;
11431 }
11432 
11433 LABEL(floor) /* floor ( r1 -- r2 ) S0 -- S0  */
11434 /* Round towards the next smaller integral value, i.e., round toward negative infinity. */
11435 NAME("floor")
11436 {
11437 DEF_CA
11438 MAYBE_UNUSED Float r1;
11439 Float r2;
11440 NEXT_P0;
11441 vm_Float2r(fp[0],r1);
11442 #ifdef VM_DEBUG
11443 if (vm_debug) {
11444 fputs(" r1=", vm_out); printarg_r(r1);
11445 }
11446 #endif
11447 {
11448 #line 2129 "prim"
11449 /* !! unclear wording */
11450 CLOBBER_TOS_WORKAROUND_START;
11451 r2 = floor(r1);
11452 CLOBBER_TOS_WORKAROUND_END;
11453 #line 11454 "prim.i"
11454 }
11455 
11456 #ifdef VM_DEBUG
11457 if (vm_debug) {
11458 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11459 fputc('\n', vm_out);
11460 }
11461 #endif
11462 NEXT_P1;
11463 vm_r2Float(r2,fp[0]);
11464 LABEL2(floor)
11465 NEXT_P1_5;
11466 LABEL3(floor)
11467 DO_GOTO;
11468 }
11469 
11470 LABEL(f_round) /* fround ( r1 -- r2 ) S0 -- S0  */
11471 /* Round to the nearest integral value. */
11472 NAME("fround")
11473 {
11474 DEF_CA
11475 MAYBE_UNUSED Float r1;
11476 Float r2;
11477 NEXT_P0;
11478 vm_Float2r(fp[0],r1);
11479 #ifdef VM_DEBUG
11480 if (vm_debug) {
11481 fputs(" r1=", vm_out); printarg_r(r1);
11482 }
11483 #endif
11484 {
11485 #line 2136 "prim"
11486 CLOBBER_TOS_WORKAROUND_START;
11487 r2 = rint(r1);
11488 CLOBBER_TOS_WORKAROUND_END;
11489 #line 11490 "prim.i"
11490 }
11491 
11492 #ifdef VM_DEBUG
11493 if (vm_debug) {
11494 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11495 fputc('\n', vm_out);
11496 }
11497 #endif
11498 NEXT_P1;
11499 vm_r2Float(r2,fp[0]);
11500 LABEL2(f_round)
11501 NEXT_P1_5;
11502 LABEL3(f_round)
11503 DO_GOTO;
11504 }
11505 
11506 LABEL(f_max) /* fmax ( r1 r2 -- r3 ) S0 -- S0  */
11507 /*  */
11508 NAME("fmax")
11509 {
11510 DEF_CA
11511 MAYBE_UNUSED Float r1;
11512 MAYBE_UNUSED Float r2;
11513 Float r3;
11514 NEXT_P0;
11515 vm_Float2r(fp[1],r1);
11516 vm_Float2r(fp[0],r2);
11517 #ifdef VM_DEBUG
11518 if (vm_debug) {
11519 fputs(" r1=", vm_out); printarg_r(r1);
11520 fputs(" r2=", vm_out); printarg_r(r2);
11521 }
11522 #endif
11523 fp += 1;
11524 {
11525 #line 2141 "prim"
11526 if (r1<r2)
11527   r3 = r2;
11528 else
11529   r3 = r1;
11530 #line 11531 "prim.i"
11531 }
11532 
11533 #ifdef VM_DEBUG
11534 if (vm_debug) {
11535 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
11536 fputc('\n', vm_out);
11537 }
11538 #endif
11539 NEXT_P1;
11540 vm_r2Float(r3,fp[0]);
11541 LABEL2(f_max)
11542 NEXT_P1_5;
11543 LABEL3(f_max)
11544 DO_GOTO;
11545 }
11546 
11547 LABEL(f_min) /* fmin ( r1 r2 -- r3 ) S0 -- S0  */
11548 /*  */
11549 NAME("fmin")
11550 {
11551 DEF_CA
11552 MAYBE_UNUSED Float r1;
11553 MAYBE_UNUSED Float r2;
11554 Float r3;
11555 NEXT_P0;
11556 vm_Float2r(fp[1],r1);
11557 vm_Float2r(fp[0],r2);
11558 #ifdef VM_DEBUG
11559 if (vm_debug) {
11560 fputs(" r1=", vm_out); printarg_r(r1);
11561 fputs(" r2=", vm_out); printarg_r(r2);
11562 }
11563 #endif
11564 fp += 1;
11565 {
11566 #line 2147 "prim"
11567 if (r1<r2)
11568   r3 = r1;
11569 else
11570   r3 = r2;
11571 #line 11572 "prim.i"
11572 }
11573 
11574 #ifdef VM_DEBUG
11575 if (vm_debug) {
11576 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
11577 fputc('\n', vm_out);
11578 }
11579 #endif
11580 NEXT_P1;
11581 vm_r2Float(r3,fp[0]);
11582 LABEL2(f_min)
11583 NEXT_P1_5;
11584 LABEL3(f_min)
11585 DO_GOTO;
11586 }
11587 
11588 LABEL(represent) /* represent ( r c_addr u -- n f1 f2 ) S0 -- S0  */
11589 /*  */
11590 NAME("represent")
11591 {
11592 DEF_CA
11593 MAYBE_UNUSED Float r;
11594 MAYBE_UNUSED Char * c_addr;
11595 MAYBE_UNUSED UCell u;
11596 Cell n;
11597 Bool f1;
11598 Bool f2;
11599 NEXT_P0;
11600 vm_Float2r(fp[0],r);
11601 vm_Cell2c_(sp[1],c_addr);
11602 vm_Cell2u(sp[0],u);
11603 #ifdef VM_DEBUG
11604 if (vm_debug) {
11605 fputs(" r=", vm_out); printarg_r(r);
11606 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
11607 fputs(" u=", vm_out); printarg_u(u);
11608 }
11609 #endif
11610 sp += -1;
11611 fp += 1;
11612 {
11613 #line 2153 "prim"
11614 char *sig;
11615 size_t siglen;
11616 int flag;
11617 int decpt;
11618 sig=ecvt(r, u, &decpt, &flag);
11619 n=(r==0. ? 1 : decpt);
11620 f1=FLAG(flag!=0);
11621 f2=FLAG(isdigit((unsigned)(sig[0]))!=0);
11622 siglen=strlen((char *)sig);
11623 if (siglen>u) /* happens in glibc-2.1.3 if 999.. is rounded up */
11624   siglen=u;
11625 if (!f2) /* workaround Cygwin trailing 0s for Inf and Nan */
11626   for (; sig[siglen-1]=='0'; siglen--);
11627     ;
11628 memcpy(c_addr,sig,siglen);
11629 memset(c_addr+siglen,f2?'0':' ',u-siglen);
11630 #line 11631 "prim.i"
11631 }
11632 
11633 #ifdef VM_DEBUG
11634 if (vm_debug) {
11635 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
11636 fputs(" f1=", vm_out); printarg_f(f1);
11637 fputs(" f2=", vm_out); printarg_f(f2);
11638 fputc('\n', vm_out);
11639 }
11640 #endif
11641 NEXT_P1;
11642 vm_n2Cell(n,sp[2]);
11643 vm_f2Cell(f1,sp[1]);
11644 vm_f2Cell(f2,sp[0]);
11645 LABEL2(represent)
11646 NEXT_P1_5;
11647 LABEL3(represent)
11648 DO_GOTO;
11649 }
11650 
11651 LABEL(to_float) /* >float ( c_addr u -- f:... flag ) S0 -- S0  */
11652 /* Actual stack effect: ( c_addr u -- r t | f ).  Attempt to convert the
11653 character string @i{c-addr u} to internal floating-point
11654 representation. If the string represents a valid floating-point number
11655 @i{r} is placed on the floating-point stack and @i{flag} is
11656 true. Otherwise, @i{flag} is false. A string of blanks is a special
11657 case and represents the floating-point number 0. */
11658 NAME(">float")
11659 {
11660 DEF_CA
11661 MAYBE_UNUSED Char * c_addr;
11662 MAYBE_UNUSED UCell u;
11663 Bool flag;
11664 NEXT_P0;
11665 vm_Cell2c_(sp[1],c_addr);
11666 vm_Cell2u(sp[0],u);
11667 #ifdef VM_DEBUG
11668 if (vm_debug) {
11669 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
11670 fputs(" u=", vm_out); printarg_u(u);
11671 }
11672 #endif
11673 sp += 1;
11674 {
11675 #line 2177 "prim"
11676 Float r;
11677 flag = to_float(c_addr, u, &r);
11678 if (flag) {
11679   fp--;
11680   fp[0]=r;
11681 }
11682 #line 11683 "prim.i"
11683 }
11684 
11685 #ifdef VM_DEBUG
11686 if (vm_debug) {
11687 fputs(" -- ", vm_out); fputs(" flag=", vm_out); printarg_f(flag);
11688 fputc('\n', vm_out);
11689 }
11690 #endif
11691 NEXT_P1;
11692 vm_f2Cell(flag,sp[0]);
11693 LABEL2(to_float)
11694 NEXT_P1_5;
11695 LABEL3(to_float)
11696 DO_GOTO;
11697 }
11698 
11699 LABEL(f_abs) /* fabs ( r1 -- r2 ) S0 -- S0  */
11700 /*  */
11701 NAME("fabs")
11702 {
11703 DEF_CA
11704 MAYBE_UNUSED Float r1;
11705 Float r2;
11706 NEXT_P0;
11707 vm_Float2r(fp[0],r1);
11708 #ifdef VM_DEBUG
11709 if (vm_debug) {
11710 fputs(" r1=", vm_out); printarg_r(r1);
11711 }
11712 #endif
11713 {
11714 #line 2185 "prim"
11715 r2 = fabs(r1);
11716 #line 11717 "prim.i"
11717 }
11718 
11719 #ifdef VM_DEBUG
11720 if (vm_debug) {
11721 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11722 fputc('\n', vm_out);
11723 }
11724 #endif
11725 NEXT_P1;
11726 vm_r2Float(r2,fp[0]);
11727 LABEL2(f_abs)
11728 NEXT_P1_5;
11729 LABEL3(f_abs)
11730 DO_GOTO;
11731 }
11732 
11733 LABEL(f_a_cos) /* facos ( r1 -- r2 ) S0 -- S0  */
11734 /*  */
11735 NAME("facos")
11736 {
11737 DEF_CA
11738 MAYBE_UNUSED Float r1;
11739 Float r2;
11740 NEXT_P0;
11741 vm_Float2r(fp[0],r1);
11742 #ifdef VM_DEBUG
11743 if (vm_debug) {
11744 fputs(" r1=", vm_out); printarg_r(r1);
11745 }
11746 #endif
11747 {
11748 #line 2188 "prim"
11749 CLOBBER_TOS_WORKAROUND_START;
11750 r2 = acos(r1);
11751 CLOBBER_TOS_WORKAROUND_END;
11752 #line 11753 "prim.i"
11753 }
11754 
11755 #ifdef VM_DEBUG
11756 if (vm_debug) {
11757 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11758 fputc('\n', vm_out);
11759 }
11760 #endif
11761 NEXT_P1;
11762 vm_r2Float(r2,fp[0]);
11763 LABEL2(f_a_cos)
11764 NEXT_P1_5;
11765 LABEL3(f_a_cos)
11766 DO_GOTO;
11767 }
11768 
11769 LABEL(f_a_sine) /* fasin ( r1 -- r2 ) S0 -- S0  */
11770 /*  */
11771 NAME("fasin")
11772 {
11773 DEF_CA
11774 MAYBE_UNUSED Float r1;
11775 Float r2;
11776 NEXT_P0;
11777 vm_Float2r(fp[0],r1);
11778 #ifdef VM_DEBUG
11779 if (vm_debug) {
11780 fputs(" r1=", vm_out); printarg_r(r1);
11781 }
11782 #endif
11783 {
11784 #line 2193 "prim"
11785 CLOBBER_TOS_WORKAROUND_START;
11786 r2 = asin(r1);
11787 CLOBBER_TOS_WORKAROUND_END;
11788 #line 11789 "prim.i"
11789 }
11790 
11791 #ifdef VM_DEBUG
11792 if (vm_debug) {
11793 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11794 fputc('\n', vm_out);
11795 }
11796 #endif
11797 NEXT_P1;
11798 vm_r2Float(r2,fp[0]);
11799 LABEL2(f_a_sine)
11800 NEXT_P1_5;
11801 LABEL3(f_a_sine)
11802 DO_GOTO;
11803 }
11804 
11805 LABEL(f_a_tan) /* fatan ( r1 -- r2 ) S0 -- S0  */
11806 /*  */
11807 NAME("fatan")
11808 {
11809 DEF_CA
11810 MAYBE_UNUSED Float r1;
11811 Float r2;
11812 NEXT_P0;
11813 vm_Float2r(fp[0],r1);
11814 #ifdef VM_DEBUG
11815 if (vm_debug) {
11816 fputs(" r1=", vm_out); printarg_r(r1);
11817 }
11818 #endif
11819 {
11820 #line 2198 "prim"
11821 CLOBBER_TOS_WORKAROUND_START;
11822 r2 = atan(r1);
11823 CLOBBER_TOS_WORKAROUND_END;
11824 #line 11825 "prim.i"
11825 }
11826 
11827 #ifdef VM_DEBUG
11828 if (vm_debug) {
11829 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11830 fputc('\n', vm_out);
11831 }
11832 #endif
11833 NEXT_P1;
11834 vm_r2Float(r2,fp[0]);
11835 LABEL2(f_a_tan)
11836 NEXT_P1_5;
11837 LABEL3(f_a_tan)
11838 DO_GOTO;
11839 }
11840 
11841 LABEL(f_a_tan_two) /* fatan2 ( r1 r2 -- r3 ) S0 -- S0  */
11842 /* @i{r1/r2}=tan(@i{r3}). ANS Forth does not require, but probably
11843 intends this to be the inverse of @code{fsincos}. In gforth it is. */
11844 NAME("fatan2")
11845 {
11846 DEF_CA
11847 MAYBE_UNUSED Float r1;
11848 MAYBE_UNUSED Float r2;
11849 Float r3;
11850 NEXT_P0;
11851 vm_Float2r(fp[1],r1);
11852 vm_Float2r(fp[0],r2);
11853 #ifdef VM_DEBUG
11854 if (vm_debug) {
11855 fputs(" r1=", vm_out); printarg_r(r1);
11856 fputs(" r2=", vm_out); printarg_r(r2);
11857 }
11858 #endif
11859 fp += 1;
11860 {
11861 #line 2205 "prim"
11862 CLOBBER_TOS_WORKAROUND_START;
11863 r3 = atan2(r1,r2);
11864 CLOBBER_TOS_WORKAROUND_END;
11865 #line 11866 "prim.i"
11866 }
11867 
11868 #ifdef VM_DEBUG
11869 if (vm_debug) {
11870 fputs(" -- ", vm_out); fputs(" r3=", vm_out); printarg_r(r3);
11871 fputc('\n', vm_out);
11872 }
11873 #endif
11874 NEXT_P1;
11875 vm_r2Float(r3,fp[0]);
11876 LABEL2(f_a_tan_two)
11877 NEXT_P1_5;
11878 LABEL3(f_a_tan_two)
11879 DO_GOTO;
11880 }
11881 
11882 LABEL(f_cos) /* fcos ( r1 -- r2 ) S0 -- S0  */
11883 /*  */
11884 NAME("fcos")
11885 {
11886 DEF_CA
11887 MAYBE_UNUSED Float r1;
11888 Float r2;
11889 NEXT_P0;
11890 vm_Float2r(fp[0],r1);
11891 #ifdef VM_DEBUG
11892 if (vm_debug) {
11893 fputs(" r1=", vm_out); printarg_r(r1);
11894 }
11895 #endif
11896 {
11897 #line 2210 "prim"
11898 CLOBBER_TOS_WORKAROUND_START;
11899 r2 = cos(r1);
11900 CLOBBER_TOS_WORKAROUND_END;
11901 #line 11902 "prim.i"
11902 }
11903 
11904 #ifdef VM_DEBUG
11905 if (vm_debug) {
11906 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11907 fputc('\n', vm_out);
11908 }
11909 #endif
11910 NEXT_P1;
11911 vm_r2Float(r2,fp[0]);
11912 LABEL2(f_cos)
11913 NEXT_P1_5;
11914 LABEL3(f_cos)
11915 DO_GOTO;
11916 }
11917 
11918 LABEL(f_e_x_p) /* fexp ( r1 -- r2 ) S0 -- S0  */
11919 /*  */
11920 NAME("fexp")
11921 {
11922 DEF_CA
11923 MAYBE_UNUSED Float r1;
11924 Float r2;
11925 NEXT_P0;
11926 vm_Float2r(fp[0],r1);
11927 #ifdef VM_DEBUG
11928 if (vm_debug) {
11929 fputs(" r1=", vm_out); printarg_r(r1);
11930 }
11931 #endif
11932 {
11933 #line 2215 "prim"
11934 CLOBBER_TOS_WORKAROUND_START;
11935 r2 = exp(r1);
11936 CLOBBER_TOS_WORKAROUND_END;
11937 #line 11938 "prim.i"
11938 }
11939 
11940 #ifdef VM_DEBUG
11941 if (vm_debug) {
11942 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11943 fputc('\n', vm_out);
11944 }
11945 #endif
11946 NEXT_P1;
11947 vm_r2Float(r2,fp[0]);
11948 LABEL2(f_e_x_p)
11949 NEXT_P1_5;
11950 LABEL3(f_e_x_p)
11951 DO_GOTO;
11952 }
11953 
11954 LABEL(f_e_x_p_m_one) /* fexpm1 ( r1 -- r2 ) S0 -- S0  */
11955 /* @i{r2}=@i{e}**@i{r1}@minus{}1 */
11956 NAME("fexpm1")
11957 {
11958 DEF_CA
11959 MAYBE_UNUSED Float r1;
11960 Float r2;
11961 NEXT_P0;
11962 vm_Float2r(fp[0],r1);
11963 #ifdef VM_DEBUG
11964 if (vm_debug) {
11965 fputs(" r1=", vm_out); printarg_r(r1);
11966 }
11967 #endif
11968 {
11969 #line 2221 "prim"
11970 CLOBBER_TOS_WORKAROUND_START;
11971 #ifdef HAVE_EXPM1
11972 extern double
11973 #ifdef NeXT
11974               const
11975 #endif
11976                     expm1(double);
11977 r2 = expm1(r1);
11978 #else
11979 r2 = exp(r1)-1.;
11980 #endif
11981 CLOBBER_TOS_WORKAROUND_END;
11982 #line 11983 "prim.i"
11983 }
11984 
11985 #ifdef VM_DEBUG
11986 if (vm_debug) {
11987 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
11988 fputc('\n', vm_out);
11989 }
11990 #endif
11991 NEXT_P1;
11992 vm_r2Float(r2,fp[0]);
11993 LABEL2(f_e_x_p_m_one)
11994 NEXT_P1_5;
11995 LABEL3(f_e_x_p_m_one)
11996 DO_GOTO;
11997 }
11998 
11999 LABEL(f_l_n) /* fln ( r1 -- r2 ) S0 -- S0  */
12000 /*  */
12001 NAME("fln")
12002 {
12003 DEF_CA
12004 MAYBE_UNUSED Float r1;
12005 Float r2;
12006 NEXT_P0;
12007 vm_Float2r(fp[0],r1);
12008 #ifdef VM_DEBUG
12009 if (vm_debug) {
12010 fputs(" r1=", vm_out); printarg_r(r1);
12011 }
12012 #endif
12013 {
12014 #line 2235 "prim"
12015 CLOBBER_TOS_WORKAROUND_START;
12016 r2 = log(r1);
12017 CLOBBER_TOS_WORKAROUND_END;
12018 #line 12019 "prim.i"
12019 }
12020 
12021 #ifdef VM_DEBUG
12022 if (vm_debug) {
12023 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12024 fputc('\n', vm_out);
12025 }
12026 #endif
12027 NEXT_P1;
12028 vm_r2Float(r2,fp[0]);
12029 LABEL2(f_l_n)
12030 NEXT_P1_5;
12031 LABEL3(f_l_n)
12032 DO_GOTO;
12033 }
12034 
12035 LABEL(f_l_n_p_one) /* flnp1 ( r1 -- r2 ) S0 -- S0  */
12036 /* @i{r2}=ln(@i{r1}+1) */
12037 NAME("flnp1")
12038 {
12039 DEF_CA
12040 MAYBE_UNUSED Float r1;
12041 Float r2;
12042 NEXT_P0;
12043 vm_Float2r(fp[0],r1);
12044 #ifdef VM_DEBUG
12045 if (vm_debug) {
12046 fputs(" r1=", vm_out); printarg_r(r1);
12047 }
12048 #endif
12049 {
12050 #line 2241 "prim"
12051 CLOBBER_TOS_WORKAROUND_START;
12052 #ifdef HAVE_LOG1P
12053 extern double
12054 #ifdef NeXT
12055               const
12056 #endif
12057                     log1p(double);
12058 r2 = log1p(r1);
12059 #else
12060 r2 = log(r1+1.);
12061 #endif
12062 CLOBBER_TOS_WORKAROUND_END;
12063 #line 12064 "prim.i"
12064 }
12065 
12066 #ifdef VM_DEBUG
12067 if (vm_debug) {
12068 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12069 fputc('\n', vm_out);
12070 }
12071 #endif
12072 NEXT_P1;
12073 vm_r2Float(r2,fp[0]);
12074 LABEL2(f_l_n_p_one)
12075 NEXT_P1_5;
12076 LABEL3(f_l_n_p_one)
12077 DO_GOTO;
12078 }
12079 
12080 LABEL(f_log) /* flog ( r1 -- r2 ) S0 -- S0  */
12081 /* The decimal logarithm. */
12082 NAME("flog")
12083 {
12084 DEF_CA
12085 MAYBE_UNUSED Float r1;
12086 Float r2;
12087 NEXT_P0;
12088 vm_Float2r(fp[0],r1);
12089 #ifdef VM_DEBUG
12090 if (vm_debug) {
12091 fputs(" r1=", vm_out); printarg_r(r1);
12092 }
12093 #endif
12094 {
12095 #line 2256 "prim"
12096 CLOBBER_TOS_WORKAROUND_START;
12097 r2 = log10(r1);
12098 CLOBBER_TOS_WORKAROUND_END;
12099 #line 12100 "prim.i"
12100 }
12101 
12102 #ifdef VM_DEBUG
12103 if (vm_debug) {
12104 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12105 fputc('\n', vm_out);
12106 }
12107 #endif
12108 NEXT_P1;
12109 vm_r2Float(r2,fp[0]);
12110 LABEL2(f_log)
12111 NEXT_P1_5;
12112 LABEL3(f_log)
12113 DO_GOTO;
12114 }
12115 
12116 LABEL(f_a_log) /* falog ( r1 -- r2 ) S0 -- S0  */
12117 /* @i{r2}=10**@i{r1} */
12118 NAME("falog")
12119 {
12120 DEF_CA
12121 MAYBE_UNUSED Float r1;
12122 Float r2;
12123 NEXT_P0;
12124 vm_Float2r(fp[0],r1);
12125 #ifdef VM_DEBUG
12126 if (vm_debug) {
12127 fputs(" r1=", vm_out); printarg_r(r1);
12128 }
12129 #endif
12130 {
12131 #line 2262 "prim"
12132 extern double pow10(double);
12133 CLOBBER_TOS_WORKAROUND_START;
12134 r2 = pow10(r1);
12135 CLOBBER_TOS_WORKAROUND_END;
12136 #line 12137 "prim.i"
12137 }
12138 
12139 #ifdef VM_DEBUG
12140 if (vm_debug) {
12141 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12142 fputc('\n', vm_out);
12143 }
12144 #endif
12145 NEXT_P1;
12146 vm_r2Float(r2,fp[0]);
12147 LABEL2(f_a_log)
12148 NEXT_P1_5;
12149 LABEL3(f_a_log)
12150 DO_GOTO;
12151 }
12152 
12153 LABEL(f_sine) /* fsin ( r1 -- r2 ) S0 -- S0  */
12154 /*  */
12155 NAME("fsin")
12156 {
12157 DEF_CA
12158 MAYBE_UNUSED Float r1;
12159 Float r2;
12160 NEXT_P0;
12161 vm_Float2r(fp[0],r1);
12162 #ifdef VM_DEBUG
12163 if (vm_debug) {
12164 fputs(" r1=", vm_out); printarg_r(r1);
12165 }
12166 #endif
12167 {
12168 #line 2268 "prim"
12169 CLOBBER_TOS_WORKAROUND_START;
12170 r2 = sin(r1);
12171 #line 12172 "prim.i"
12172 }
12173 
12174 #ifdef VM_DEBUG
12175 if (vm_debug) {
12176 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12177 fputc('\n', vm_out);
12178 }
12179 #endif
12180 NEXT_P1;
12181 vm_r2Float(r2,fp[0]);
12182 LABEL2(f_sine)
12183 NEXT_P1_5;
12184 LABEL3(f_sine)
12185 DO_GOTO;
12186 }
12187 
12188 LABEL(f_sine_cos) /* fsincos ( r1 -- r2 r3 ) S0 -- S0  */
12189 /* @i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1}) */
12190 NAME("fsincos")
12191 {
12192 DEF_CA
12193 MAYBE_UNUSED Float r1;
12194 Float r2;
12195 Float r3;
12196 NEXT_P0;
12197 vm_Float2r(fp[0],r1);
12198 #ifdef VM_DEBUG
12199 if (vm_debug) {
12200 fputs(" r1=", vm_out); printarg_r(r1);
12201 }
12202 #endif
12203 fp += -1;
12204 {
12205 #line 2273 "prim"
12206 CLOBBER_TOS_WORKAROUND_START;
12207 r2 = sin(r1);
12208 r3 = cos(r1);
12209 CLOBBER_TOS_WORKAROUND_END;
12210 #line 12211 "prim.i"
12211 }
12212 
12213 #ifdef VM_DEBUG
12214 if (vm_debug) {
12215 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12216 fputs(" r3=", vm_out); printarg_r(r3);
12217 fputc('\n', vm_out);
12218 }
12219 #endif
12220 NEXT_P1;
12221 vm_r2Float(r2,fp[1]);
12222 vm_r2Float(r3,fp[0]);
12223 LABEL2(f_sine_cos)
12224 NEXT_P1_5;
12225 LABEL3(f_sine_cos)
12226 DO_GOTO;
12227 }
12228 
12229 LABEL(f_square_root) /* fsqrt ( r1 -- r2 ) S0 -- S0  */
12230 /*  */
12231 NAME("fsqrt")
12232 {
12233 DEF_CA
12234 MAYBE_UNUSED Float r1;
12235 Float r2;
12236 NEXT_P0;
12237 vm_Float2r(fp[0],r1);
12238 #ifdef VM_DEBUG
12239 if (vm_debug) {
12240 fputs(" r1=", vm_out); printarg_r(r1);
12241 }
12242 #endif
12243 {
12244 #line 2279 "prim"
12245 CLOBBER_TOS_WORKAROUND_START;
12246 r2 = sqrt(r1);
12247 CLOBBER_TOS_WORKAROUND_END;
12248 #line 12249 "prim.i"
12249 }
12250 
12251 #ifdef VM_DEBUG
12252 if (vm_debug) {
12253 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12254 fputc('\n', vm_out);
12255 }
12256 #endif
12257 NEXT_P1;
12258 vm_r2Float(r2,fp[0]);
12259 LABEL2(f_square_root)
12260 NEXT_P1_5;
12261 LABEL3(f_square_root)
12262 DO_GOTO;
12263 }
12264 
12265 LABEL(f_tan) /* ftan ( r1 -- r2 ) S0 -- S0  */
12266 /*  */
12267 NAME("ftan")
12268 {
12269 DEF_CA
12270 MAYBE_UNUSED Float r1;
12271 Float r2;
12272 NEXT_P0;
12273 vm_Float2r(fp[0],r1);
12274 #ifdef VM_DEBUG
12275 if (vm_debug) {
12276 fputs(" r1=", vm_out); printarg_r(r1);
12277 }
12278 #endif
12279 {
12280 #line 2284 "prim"
12281 CLOBBER_TOS_WORKAROUND_START;
12282 r2 = tan(r1);
12283 CLOBBER_TOS_WORKAROUND_END;
12284 #line 12285 "prim.i"
12285 }
12286 
12287 #ifdef VM_DEBUG
12288 if (vm_debug) {
12289 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12290 fputc('\n', vm_out);
12291 }
12292 #endif
12293 NEXT_P1;
12294 vm_r2Float(r2,fp[0]);
12295 LABEL2(f_tan)
12296 NEXT_P1_5;
12297 LABEL3(f_tan)
12298 DO_GOTO;
12299 }
12300 
12301 LABEL(f_cinch) /* fsinh ( r1 -- r2 ) S0 -- S0  */
12302 /*  */
12303 NAME("fsinh")
12304 {
12305 DEF_CA
12306 MAYBE_UNUSED Float r1;
12307 Float r2;
12308 NEXT_P0;
12309 vm_Float2r(fp[0],r1);
12310 #ifdef VM_DEBUG
12311 if (vm_debug) {
12312 fputs(" r1=", vm_out); printarg_r(r1);
12313 }
12314 #endif
12315 {
12316 #line 2291 "prim"
12317 CLOBBER_TOS_WORKAROUND_START;
12318 r2 = sinh(r1);
12319 CLOBBER_TOS_WORKAROUND_END;
12320 #line 12321 "prim.i"
12321 }
12322 
12323 #ifdef VM_DEBUG
12324 if (vm_debug) {
12325 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12326 fputc('\n', vm_out);
12327 }
12328 #endif
12329 NEXT_P1;
12330 vm_r2Float(r2,fp[0]);
12331 LABEL2(f_cinch)
12332 NEXT_P1_5;
12333 LABEL3(f_cinch)
12334 DO_GOTO;
12335 }
12336 
12337 LABEL(f_cosh) /* fcosh ( r1 -- r2 ) S0 -- S0  */
12338 /*  */
12339 NAME("fcosh")
12340 {
12341 DEF_CA
12342 MAYBE_UNUSED Float r1;
12343 Float r2;
12344 NEXT_P0;
12345 vm_Float2r(fp[0],r1);
12346 #ifdef VM_DEBUG
12347 if (vm_debug) {
12348 fputs(" r1=", vm_out); printarg_r(r1);
12349 }
12350 #endif
12351 {
12352 #line 2298 "prim"
12353 CLOBBER_TOS_WORKAROUND_START;
12354 r2 = cosh(r1);
12355 CLOBBER_TOS_WORKAROUND_END;
12356 #line 12357 "prim.i"
12357 }
12358 
12359 #ifdef VM_DEBUG
12360 if (vm_debug) {
12361 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12362 fputc('\n', vm_out);
12363 }
12364 #endif
12365 NEXT_P1;
12366 vm_r2Float(r2,fp[0]);
12367 LABEL2(f_cosh)
12368 NEXT_P1_5;
12369 LABEL3(f_cosh)
12370 DO_GOTO;
12371 }
12372 
12373 LABEL(f_tan_h) /* ftanh ( r1 -- r2 ) S0 -- S0  */
12374 /*  */
12375 NAME("ftanh")
12376 {
12377 DEF_CA
12378 MAYBE_UNUSED Float r1;
12379 Float r2;
12380 NEXT_P0;
12381 vm_Float2r(fp[0],r1);
12382 #ifdef VM_DEBUG
12383 if (vm_debug) {
12384 fputs(" r1=", vm_out); printarg_r(r1);
12385 }
12386 #endif
12387 {
12388 #line 2305 "prim"
12389 CLOBBER_TOS_WORKAROUND_START;
12390 r2 = tanh(r1);
12391 CLOBBER_TOS_WORKAROUND_END;
12392 #line 12393 "prim.i"
12393 }
12394 
12395 #ifdef VM_DEBUG
12396 if (vm_debug) {
12397 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12398 fputc('\n', vm_out);
12399 }
12400 #endif
12401 NEXT_P1;
12402 vm_r2Float(r2,fp[0]);
12403 LABEL2(f_tan_h)
12404 NEXT_P1_5;
12405 LABEL3(f_tan_h)
12406 DO_GOTO;
12407 }
12408 
12409 LABEL(f_a_cinch) /* fasinh ( r1 -- r2 ) S0 -- S0  */
12410 /*  */
12411 NAME("fasinh")
12412 {
12413 DEF_CA
12414 MAYBE_UNUSED Float r1;
12415 Float r2;
12416 NEXT_P0;
12417 vm_Float2r(fp[0],r1);
12418 #ifdef VM_DEBUG
12419 if (vm_debug) {
12420 fputs(" r1=", vm_out); printarg_r(r1);
12421 }
12422 #endif
12423 {
12424 #line 2312 "prim"
12425 CLOBBER_TOS_WORKAROUND_START;
12426 r2 = asinh(r1);
12427 CLOBBER_TOS_WORKAROUND_END;
12428 #line 12429 "prim.i"
12429 }
12430 
12431 #ifdef VM_DEBUG
12432 if (vm_debug) {
12433 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12434 fputc('\n', vm_out);
12435 }
12436 #endif
12437 NEXT_P1;
12438 vm_r2Float(r2,fp[0]);
12439 LABEL2(f_a_cinch)
12440 NEXT_P1_5;
12441 LABEL3(f_a_cinch)
12442 DO_GOTO;
12443 }
12444 
12445 LABEL(f_a_cosh) /* facosh ( r1 -- r2 ) S0 -- S0  */
12446 /*  */
12447 NAME("facosh")
12448 {
12449 DEF_CA
12450 MAYBE_UNUSED Float r1;
12451 Float r2;
12452 NEXT_P0;
12453 vm_Float2r(fp[0],r1);
12454 #ifdef VM_DEBUG
12455 if (vm_debug) {
12456 fputs(" r1=", vm_out); printarg_r(r1);
12457 }
12458 #endif
12459 {
12460 #line 2319 "prim"
12461 CLOBBER_TOS_WORKAROUND_START;
12462 r2 = acosh(r1);
12463 CLOBBER_TOS_WORKAROUND_END;
12464 #line 12465 "prim.i"
12465 }
12466 
12467 #ifdef VM_DEBUG
12468 if (vm_debug) {
12469 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12470 fputc('\n', vm_out);
12471 }
12472 #endif
12473 NEXT_P1;
12474 vm_r2Float(r2,fp[0]);
12475 LABEL2(f_a_cosh)
12476 NEXT_P1_5;
12477 LABEL3(f_a_cosh)
12478 DO_GOTO;
12479 }
12480 
12481 LABEL(f_a_tan_h) /* fatanh ( r1 -- r2 ) S0 -- S0  */
12482 /*  */
12483 NAME("fatanh")
12484 {
12485 DEF_CA
12486 MAYBE_UNUSED Float r1;
12487 Float r2;
12488 NEXT_P0;
12489 vm_Float2r(fp[0],r1);
12490 #ifdef VM_DEBUG
12491 if (vm_debug) {
12492 fputs(" r1=", vm_out); printarg_r(r1);
12493 }
12494 #endif
12495 {
12496 #line 2326 "prim"
12497 CLOBBER_TOS_WORKAROUND_START;
12498 r2 = atanh(r1);
12499 CLOBBER_TOS_WORKAROUND_END;
12500 #line 12501 "prim.i"
12501 }
12502 
12503 #ifdef VM_DEBUG
12504 if (vm_debug) {
12505 fputs(" -- ", vm_out); fputs(" r2=", vm_out); printarg_r(r2);
12506 fputc('\n', vm_out);
12507 }
12508 #endif
12509 NEXT_P1;
12510 vm_r2Float(r2,fp[0]);
12511 LABEL2(f_a_tan_h)
12512 NEXT_P1_5;
12513 LABEL3(f_a_tan_h)
12514 DO_GOTO;
12515 }
12516 
12517 LABEL(s_floats) /* sfloats ( n1 -- n2 ) S0 -- S0  */
12518 /* @i{n2} is the number of address units of @i{n1}
12519 single-precision IEEE floating-point numbers. */
12520 NAME("sfloats")
12521 {
12522 DEF_CA
12523 MAYBE_UNUSED Cell n1;
12524 Cell n2;
12525 NEXT_P0;
12526 vm_Cell2n(sp[0],n1);
12527 #ifdef VM_DEBUG
12528 if (vm_debug) {
12529 fputs(" n1=", vm_out); printarg_n(n1);
12530 }
12531 #endif
12532 {
12533 #line 2336 "prim"
12534 n2 = n1*sizeof(SFloat);
12535 #line 12536 "prim.i"
12536 }
12537 
12538 #ifdef VM_DEBUG
12539 if (vm_debug) {
12540 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
12541 fputc('\n', vm_out);
12542 }
12543 #endif
12544 NEXT_P1;
12545 vm_n2Cell(n2,sp[0]);
12546 LABEL2(s_floats)
12547 NEXT_P1_5;
12548 LABEL3(s_floats)
12549 DO_GOTO;
12550 }
12551 
12552 LABEL(d_floats) /* dfloats ( n1 -- n2 ) S0 -- S0  */
12553 /* @i{n2} is the number of address units of @i{n1}
12554 double-precision IEEE floating-point numbers. */
12555 NAME("dfloats")
12556 {
12557 DEF_CA
12558 MAYBE_UNUSED Cell n1;
12559 Cell n2;
12560 NEXT_P0;
12561 vm_Cell2n(sp[0],n1);
12562 #ifdef VM_DEBUG
12563 if (vm_debug) {
12564 fputs(" n1=", vm_out); printarg_n(n1);
12565 }
12566 #endif
12567 {
12568 #line 2341 "prim"
12569 n2 = n1*sizeof(DFloat);
12570 #line 12571 "prim.i"
12571 }
12572 
12573 #ifdef VM_DEBUG
12574 if (vm_debug) {
12575 fputs(" -- ", vm_out); fputs(" n2=", vm_out); printarg_n(n2);
12576 fputc('\n', vm_out);
12577 }
12578 #endif
12579 NEXT_P1;
12580 vm_n2Cell(n2,sp[0]);
12581 LABEL2(d_floats)
12582 NEXT_P1_5;
12583 LABEL3(d_floats)
12584 DO_GOTO;
12585 }
12586 
12587 LABEL(s_f_aligned) /* sfaligned ( c_addr -- sf_addr ) S0 -- S0  */
12588 /* @i{sf-addr} is the first single-float-aligned address greater
12589 than or equal to @i{c-addr}. */
12590 NAME("sfaligned")
12591 {
12592 DEF_CA
12593 MAYBE_UNUSED Char * c_addr;
12594 SFloat * sf_addr;
12595 NEXT_P0;
12596 vm_Cell2c_(sp[0],c_addr);
12597 #ifdef VM_DEBUG
12598 if (vm_debug) {
12599 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
12600 }
12601 #endif
12602 {
12603 #line 2346 "prim"
12604 sf_addr = (SFloat *)((((Cell)c_addr)+(sizeof(SFloat)-1))&(-sizeof(SFloat)));
12605 #line 12606 "prim.i"
12606 }
12607 
12608 #ifdef VM_DEBUG
12609 if (vm_debug) {
12610 fputs(" -- ", vm_out); fputs(" sf_addr=", vm_out); printarg_sf_(sf_addr);
12611 fputc('\n', vm_out);
12612 }
12613 #endif
12614 NEXT_P1;
12615 vm_sf_2Cell(sf_addr,sp[0]);
12616 LABEL2(s_f_aligned)
12617 NEXT_P1_5;
12618 LABEL3(s_f_aligned)
12619 DO_GOTO;
12620 }
12621 
12622 LABEL(d_f_aligned) /* dfaligned ( c_addr -- df_addr ) S0 -- S0  */
12623 /* @i{df-addr} is the first double-float-aligned address greater
12624 than or equal to @i{c-addr}. */
12625 NAME("dfaligned")
12626 {
12627 DEF_CA
12628 MAYBE_UNUSED Char * c_addr;
12629 DFloat * df_addr;
12630 NEXT_P0;
12631 vm_Cell2c_(sp[0],c_addr);
12632 #ifdef VM_DEBUG
12633 if (vm_debug) {
12634 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
12635 }
12636 #endif
12637 {
12638 #line 2353 "prim"
12639 df_addr = (DFloat *)((((Cell)c_addr)+(sizeof(DFloat)-1))&(-sizeof(DFloat)));
12640 #line 12641 "prim.i"
12641 }
12642 
12643 #ifdef VM_DEBUG
12644 if (vm_debug) {
12645 fputs(" -- ", vm_out); fputs(" df_addr=", vm_out); printarg_df_(df_addr);
12646 fputc('\n', vm_out);
12647 }
12648 #endif
12649 NEXT_P1;
12650 vm_df_2Cell(df_addr,sp[0]);
12651 LABEL2(d_f_aligned)
12652 NEXT_P1_5;
12653 LABEL3(d_f_aligned)
12654 DO_GOTO;
12655 }
12656 
12657 LABEL(v_star) /* v* ( f_addr1 nstride1 f_addr2 nstride2 ucount -- r ) S0 -- S0  */
12658 /* dot-product: r=v1*v2.  The first element of v1 is at f_addr1, the
12659 next at f_addr1+nstride1 and so on (similar for v2). Both vectors have
12660 ucount elements. */
12661 NAME("v*")
12662 {
12663 DEF_CA
12664 MAYBE_UNUSED Float * f_addr1;
12665 MAYBE_UNUSED Cell nstride1;
12666 MAYBE_UNUSED Float * f_addr2;
12667 MAYBE_UNUSED Cell nstride2;
12668 MAYBE_UNUSED UCell ucount;
12669 Float r;
12670 NEXT_P0;
12671 vm_Cell2f_(sp[4],f_addr1);
12672 vm_Cell2n(sp[3],nstride1);
12673 vm_Cell2f_(sp[2],f_addr2);
12674 vm_Cell2n(sp[1],nstride2);
12675 vm_Cell2u(sp[0],ucount);
12676 #ifdef VM_DEBUG
12677 if (vm_debug) {
12678 fputs(" f_addr1=", vm_out); printarg_f_(f_addr1);
12679 fputs(" nstride1=", vm_out); printarg_n(nstride1);
12680 fputs(" f_addr2=", vm_out); printarg_f_(f_addr2);
12681 fputs(" nstride2=", vm_out); printarg_n(nstride2);
12682 fputs(" ucount=", vm_out); printarg_u(ucount);
12683 }
12684 #endif
12685 sp += 5;
12686 fp += -1;
12687 {
12688 #line 2361 "prim"
12689 r = v_star(f_addr1, nstride1, f_addr2, nstride2, ucount);
12690 #line 12691 "prim.i"
12691 }
12692 
12693 #ifdef VM_DEBUG
12694 if (vm_debug) {
12695 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
12696 fputc('\n', vm_out);
12697 }
12698 #endif
12699 NEXT_P1;
12700 vm_r2Float(r,fp[0]);
12701 LABEL2(v_star)
12702 NEXT_P1_5;
12703 LABEL3(v_star)
12704 DO_GOTO;
12705 }
12706 
12707 LABEL(faxpy) /* faxpy ( ra f_x nstridex f_y nstridey ucount -- ) S0 -- S0  */
12708 /* vy=ra*vx+vy */
12709 NAME("faxpy")
12710 {
12711 DEF_CA
12712 MAYBE_UNUSED Float ra;
12713 MAYBE_UNUSED Float * f_x;
12714 MAYBE_UNUSED Cell nstridex;
12715 MAYBE_UNUSED Float * f_y;
12716 MAYBE_UNUSED Cell nstridey;
12717 MAYBE_UNUSED UCell ucount;
12718 NEXT_P0;
12719 vm_Float2r(fp[0],ra);
12720 vm_Cell2f_(sp[4],f_x);
12721 vm_Cell2n(sp[3],nstridex);
12722 vm_Cell2f_(sp[2],f_y);
12723 vm_Cell2n(sp[1],nstridey);
12724 vm_Cell2u(sp[0],ucount);
12725 #ifdef VM_DEBUG
12726 if (vm_debug) {
12727 fputs(" ra=", vm_out); printarg_r(ra);
12728 fputs(" f_x=", vm_out); printarg_f_(f_x);
12729 fputs(" nstridex=", vm_out); printarg_n(nstridex);
12730 fputs(" f_y=", vm_out); printarg_f_(f_y);
12731 fputs(" nstridey=", vm_out); printarg_n(nstridey);
12732 fputs(" ucount=", vm_out); printarg_u(ucount);
12733 }
12734 #endif
12735 sp += 5;
12736 fp += 1;
12737 {
12738 #line 2369 "prim"
12739 faxpy(ra, f_x, nstridex, f_y, nstridey, ucount);
12740 #line 12741 "prim.i"
12741 }
12742 
12743 #ifdef VM_DEBUG
12744 if (vm_debug) {
12745 fputs(" -- ", vm_out); fputc('\n', vm_out);
12746 }
12747 #endif
12748 NEXT_P1;
12749 LABEL2(faxpy)
12750 NEXT_P1_5;
12751 LABEL3(faxpy)
12752 DO_GOTO;
12753 }
12754 
12755 GROUPADD(75)
12756 #endif
12757 GROUPADD(0)
12758 #ifdef HAS_GLOCALS
12759 GROUPADD(0)
12760 GROUP( locals, 301)
LABEL(fetch_local_number)12761 LABEL(fetch_local_number) /* @local# ( #noffset -- w ) S0 -- S0  */
12762 /*  */
12763 NAME("@local#")
12764 {
12765 DEF_CA
12766 MAYBE_UNUSED Cell noffset;
12767 Cell w;
12768 NEXT_P0;
12769 vm_Cell2n(IMM_ARG(IPTOS,305397795 ),noffset);
12770 #ifdef VM_DEBUG
12771 if (vm_debug) {
12772 fputs(" noffset=", vm_out); printarg_n(noffset);
12773 }
12774 #endif
12775 INC_IP(1);
12776 sp += -1;
12777 {
12778 #line 2389 "prim"
12779 w = *(Cell *)(lp+noffset);
12780 #line 12781 "prim.i"
12781 }
12782 
12783 #ifdef VM_DEBUG
12784 if (vm_debug) {
12785 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
12786 fputc('\n', vm_out);
12787 }
12788 #endif
12789 NEXT_P1;
12790 vm_w2Cell(w,sp[0]);
12791 LABEL2(fetch_local_number)
12792 NEXT_P1_5;
12793 LABEL3(fetch_local_number)
12794 DO_GOTO;
12795 }
12796 
12797 LABEL(fetch_local_zero) /* @local0 ( -- w ) S0 -- S0  */
12798 /*  */
12799 NAME("@local0")
12800 {
12801 DEF_CA
12802 Cell w;
12803 NEXT_P0;
12804 #ifdef VM_DEBUG
12805 if (vm_debug) {
12806 }
12807 #endif
12808 sp += -1;
12809 {
12810 #line 2392 "prim"
12811 w = ((Cell *)lp)[0];
12812 #line 12813 "prim.i"
12813 }
12814 
12815 #ifdef VM_DEBUG
12816 if (vm_debug) {
12817 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
12818 fputc('\n', vm_out);
12819 }
12820 #endif
12821 NEXT_P1;
12822 vm_w2Cell(w,sp[0]);
12823 LABEL2(fetch_local_zero)
12824 NEXT_P1_5;
12825 LABEL3(fetch_local_zero)
12826 DO_GOTO;
12827 }
12828 
12829 LABEL(fetch_local_four) /* @local1 ( -- w ) S0 -- S0  */
12830 /*  */
12831 NAME("@local1")
12832 {
12833 DEF_CA
12834 Cell w;
12835 NEXT_P0;
12836 #ifdef VM_DEBUG
12837 if (vm_debug) {
12838 }
12839 #endif
12840 sp += -1;
12841 {
12842 #line 2395 "prim"
12843 w = ((Cell *)lp)[1];
12844 #line 12845 "prim.i"
12845 }
12846 
12847 #ifdef VM_DEBUG
12848 if (vm_debug) {
12849 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
12850 fputc('\n', vm_out);
12851 }
12852 #endif
12853 NEXT_P1;
12854 vm_w2Cell(w,sp[0]);
12855 LABEL2(fetch_local_four)
12856 NEXT_P1_5;
12857 LABEL3(fetch_local_four)
12858 DO_GOTO;
12859 }
12860 
12861 LABEL(fetch_local_eight) /* @local2 ( -- w ) S0 -- S0  */
12862 /*  */
12863 NAME("@local2")
12864 {
12865 DEF_CA
12866 Cell w;
12867 NEXT_P0;
12868 #ifdef VM_DEBUG
12869 if (vm_debug) {
12870 }
12871 #endif
12872 sp += -1;
12873 {
12874 #line 2398 "prim"
12875 w = ((Cell *)lp)[2];
12876 #line 12877 "prim.i"
12877 }
12878 
12879 #ifdef VM_DEBUG
12880 if (vm_debug) {
12881 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
12882 fputc('\n', vm_out);
12883 }
12884 #endif
12885 NEXT_P1;
12886 vm_w2Cell(w,sp[0]);
12887 LABEL2(fetch_local_eight)
12888 NEXT_P1_5;
12889 LABEL3(fetch_local_eight)
12890 DO_GOTO;
12891 }
12892 
12893 LABEL(fetch_local_twelve) /* @local3 ( -- w ) S0 -- S0  */
12894 /*  */
12895 NAME("@local3")
12896 {
12897 DEF_CA
12898 Cell w;
12899 NEXT_P0;
12900 #ifdef VM_DEBUG
12901 if (vm_debug) {
12902 }
12903 #endif
12904 sp += -1;
12905 {
12906 #line 2401 "prim"
12907 w = ((Cell *)lp)[3];
12908 #line 12909 "prim.i"
12909 }
12910 
12911 #ifdef VM_DEBUG
12912 if (vm_debug) {
12913 fputs(" -- ", vm_out); fputs(" w=", vm_out); printarg_w(w);
12914 fputc('\n', vm_out);
12915 }
12916 #endif
12917 NEXT_P1;
12918 vm_w2Cell(w,sp[0]);
12919 LABEL2(fetch_local_twelve)
12920 NEXT_P1_5;
12921 LABEL3(fetch_local_twelve)
12922 DO_GOTO;
12923 }
12924 
12925 GROUPADD(5)
12926 #ifdef HAS_FLOATING
LABEL(f_fetch_local_number)12927 LABEL(f_fetch_local_number) /* f@local# ( #noffset -- r ) S0 -- S0  */
12928 /*  */
12929 NAME("f@local#")
12930 {
12931 DEF_CA
12932 MAYBE_UNUSED Cell noffset;
12933 Float r;
12934 NEXT_P0;
12935 vm_Cell2n(IMM_ARG(IPTOS,305397796 ),noffset);
12936 #ifdef VM_DEBUG
12937 if (vm_debug) {
12938 fputs(" noffset=", vm_out); printarg_n(noffset);
12939 }
12940 #endif
12941 INC_IP(1);
12942 fp += -1;
12943 {
12944 #line 2406 "prim"
12945 r = *(Float *)(lp+noffset);
12946 #line 12947 "prim.i"
12947 }
12948 
12949 #ifdef VM_DEBUG
12950 if (vm_debug) {
12951 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
12952 fputc('\n', vm_out);
12953 }
12954 #endif
12955 NEXT_P1;
12956 vm_r2Float(r,fp[0]);
12957 LABEL2(f_fetch_local_number)
12958 NEXT_P1_5;
12959 LABEL3(f_fetch_local_number)
12960 DO_GOTO;
12961 }
12962 
12963 LABEL(f_fetch_local_zero) /* f@local0 ( -- r ) S0 -- S0  */
12964 /*  */
12965 NAME("f@local0")
12966 {
12967 DEF_CA
12968 Float r;
12969 NEXT_P0;
12970 #ifdef VM_DEBUG
12971 if (vm_debug) {
12972 }
12973 #endif
12974 fp += -1;
12975 {
12976 #line 2409 "prim"
12977 r = ((Float *)lp)[0];
12978 #line 12979 "prim.i"
12979 }
12980 
12981 #ifdef VM_DEBUG
12982 if (vm_debug) {
12983 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
12984 fputc('\n', vm_out);
12985 }
12986 #endif
12987 NEXT_P1;
12988 vm_r2Float(r,fp[0]);
12989 LABEL2(f_fetch_local_zero)
12990 NEXT_P1_5;
12991 LABEL3(f_fetch_local_zero)
12992 DO_GOTO;
12993 }
12994 
12995 LABEL(f_fetch_local_eight) /* f@local1 ( -- r ) S0 -- S0  */
12996 /*  */
12997 NAME("f@local1")
12998 {
12999 DEF_CA
13000 Float r;
13001 NEXT_P0;
13002 #ifdef VM_DEBUG
13003 if (vm_debug) {
13004 }
13005 #endif
13006 fp += -1;
13007 {
13008 #line 2412 "prim"
13009 r = ((Float *)lp)[1];
13010 #line 13011 "prim.i"
13011 }
13012 
13013 #ifdef VM_DEBUG
13014 if (vm_debug) {
13015 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
13016 fputc('\n', vm_out);
13017 }
13018 #endif
13019 NEXT_P1;
13020 vm_r2Float(r,fp[0]);
13021 LABEL2(f_fetch_local_eight)
13022 NEXT_P1_5;
13023 LABEL3(f_fetch_local_eight)
13024 DO_GOTO;
13025 }
13026 
13027 GROUPADD(3)
13028 #endif
LABEL(laddr_number)13029 LABEL(laddr_number) /* laddr# ( #noffset -- c_addr ) S0 -- S0  */
13030 /*  */
13031 NAME("laddr#")
13032 {
13033 DEF_CA
13034 MAYBE_UNUSED Cell noffset;
13035 Char * c_addr;
13036 NEXT_P0;
13037 vm_Cell2n(IMM_ARG(IPTOS,305397797 ),noffset);
13038 #ifdef VM_DEBUG
13039 if (vm_debug) {
13040 fputs(" noffset=", vm_out); printarg_n(noffset);
13041 }
13042 #endif
13043 INC_IP(1);
13044 sp += -1;
13045 {
13046 #line 2417 "prim"
13047 /* this can also be used to implement lp@ */
13048 c_addr = (Char *)(lp+noffset);
13049 #line 13050 "prim.i"
13050 }
13051 
13052 #ifdef VM_DEBUG
13053 if (vm_debug) {
13054 fputs(" -- ", vm_out); fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13055 fputc('\n', vm_out);
13056 }
13057 #endif
13058 NEXT_P1;
13059 vm_c_2Cell(c_addr,sp[0]);
13060 LABEL2(laddr_number)
13061 NEXT_P1_5;
13062 LABEL3(laddr_number)
13063 DO_GOTO;
13064 }
13065 
13066 LABEL(lp_plus_store_number) /* lp+!# ( #noffset -- ) S0 -- S0  */
13067 /* used with negative immediate values it allocates memory on the
13068 local stack, a positive immediate argument drops memory from the local
13069 stack */
13070 NAME("lp+!#")
13071 {
13072 DEF_CA
13073 MAYBE_UNUSED Cell noffset;
13074 NEXT_P0;
13075 vm_Cell2n(IMM_ARG(IPTOS,305397798 ),noffset);
13076 #ifdef VM_DEBUG
13077 if (vm_debug) {
13078 fputs(" noffset=", vm_out); printarg_n(noffset);
13079 }
13080 #endif
13081 INC_IP(1);
13082 {
13083 #line 2424 "prim"
13084 lp += noffset;
13085 #line 13086 "prim.i"
13086 }
13087 
13088 #ifdef VM_DEBUG
13089 if (vm_debug) {
13090 fputs(" -- ", vm_out); fputc('\n', vm_out);
13091 }
13092 #endif
13093 NEXT_P1;
13094 LABEL2(lp_plus_store_number)
13095 NEXT_P1_5;
13096 LABEL3(lp_plus_store_number)
13097 DO_GOTO;
13098 }
13099 
13100 LABEL(minus_four_lp_plus_store) /* lp- ( -- ) S0 -- S0  */
13101 /*  */
13102 NAME("lp-")
13103 {
13104 DEF_CA
13105 NEXT_P0;
13106 #ifdef VM_DEBUG
13107 if (vm_debug) {
13108 }
13109 #endif
13110 {
13111 #line 2427 "prim"
13112 lp += -sizeof(Cell);
13113 #line 13114 "prim.i"
13114 }
13115 
13116 #ifdef VM_DEBUG
13117 if (vm_debug) {
13118 fputs(" -- ", vm_out); fputc('\n', vm_out);
13119 }
13120 #endif
13121 NEXT_P1;
13122 LABEL2(minus_four_lp_plus_store)
13123 NEXT_P1_5;
13124 LABEL3(minus_four_lp_plus_store)
13125 DO_GOTO;
13126 }
13127 
13128 LABEL(eight_lp_plus_store) /* lp+ ( -- ) S0 -- S0  */
13129 /*  */
13130 NAME("lp+")
13131 {
13132 DEF_CA
13133 NEXT_P0;
13134 #ifdef VM_DEBUG
13135 if (vm_debug) {
13136 }
13137 #endif
13138 {
13139 #line 2430 "prim"
13140 lp += sizeof(Float);
13141 #line 13142 "prim.i"
13142 }
13143 
13144 #ifdef VM_DEBUG
13145 if (vm_debug) {
13146 fputs(" -- ", vm_out); fputc('\n', vm_out);
13147 }
13148 #endif
13149 NEXT_P1;
13150 LABEL2(eight_lp_plus_store)
13151 NEXT_P1_5;
13152 LABEL3(eight_lp_plus_store)
13153 DO_GOTO;
13154 }
13155 
13156 LABEL(sixteen_lp_plus_store) /* lp+2 ( -- ) S0 -- S0  */
13157 /*  */
13158 NAME("lp+2")
13159 {
13160 DEF_CA
13161 NEXT_P0;
13162 #ifdef VM_DEBUG
13163 if (vm_debug) {
13164 }
13165 #endif
13166 {
13167 #line 2433 "prim"
13168 lp += 2*sizeof(Float);
13169 #line 13170 "prim.i"
13170 }
13171 
13172 #ifdef VM_DEBUG
13173 if (vm_debug) {
13174 fputs(" -- ", vm_out); fputc('\n', vm_out);
13175 }
13176 #endif
13177 NEXT_P1;
13178 LABEL2(sixteen_lp_plus_store)
13179 NEXT_P1_5;
13180 LABEL3(sixteen_lp_plus_store)
13181 DO_GOTO;
13182 }
13183 
13184 LABEL(lp_store) /* lp! ( c_addr -- ) S0 -- S0  */
13185 /*  */
13186 NAME("lp!")
13187 {
13188 DEF_CA
13189 MAYBE_UNUSED Char * c_addr;
13190 NEXT_P0;
13191 vm_Cell2c_(sp[0],c_addr);
13192 #ifdef VM_DEBUG
13193 if (vm_debug) {
13194 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13195 }
13196 #endif
13197 sp += 1;
13198 {
13199 #line 2436 "prim"
13200 lp = (Address)c_addr;
13201 #line 13202 "prim.i"
13202 }
13203 
13204 #ifdef VM_DEBUG
13205 if (vm_debug) {
13206 fputs(" -- ", vm_out); fputc('\n', vm_out);
13207 }
13208 #endif
13209 NEXT_P1;
13210 LABEL2(lp_store)
13211 NEXT_P1_5;
13212 LABEL3(lp_store)
13213 DO_GOTO;
13214 }
13215 
13216 LABEL(to_l) /* >l ( w -- ) S0 -- S0  */
13217 /*  */
13218 NAME(">l")
13219 {
13220 DEF_CA
13221 MAYBE_UNUSED Cell w;
13222 NEXT_P0;
13223 vm_Cell2w(sp[0],w);
13224 #ifdef VM_DEBUG
13225 if (vm_debug) {
13226 fputs(" w=", vm_out); printarg_w(w);
13227 }
13228 #endif
13229 sp += 1;
13230 {
13231 #line 2439 "prim"
13232 lp -= sizeof(Cell);
13233 *(Cell *)lp = w;
13234 #line 13235 "prim.i"
13235 }
13236 
13237 #ifdef VM_DEBUG
13238 if (vm_debug) {
13239 fputs(" -- ", vm_out); fputc('\n', vm_out);
13240 }
13241 #endif
13242 NEXT_P1;
13243 LABEL2(to_l)
13244 NEXT_P1_5;
13245 LABEL3(to_l)
13246 DO_GOTO;
13247 }
13248 
13249 GROUPADD(7)
13250 #ifdef HAS_FLOATING
LABEL(f_to_l)13251 LABEL(f_to_l) /* f>l ( r -- ) S0 -- S0  */
13252 /*  */
13253 NAME("f>l")
13254 {
13255 DEF_CA
13256 MAYBE_UNUSED Float r;
13257 NEXT_P0;
13258 vm_Float2r(fp[0],r);
13259 #ifdef VM_DEBUG
13260 if (vm_debug) {
13261 fputs(" r=", vm_out); printarg_r(r);
13262 }
13263 #endif
13264 fp += 1;
13265 {
13266 #line 2445 "prim"
13267 lp -= sizeof(Float);
13268 *(Float *)lp = r;
13269 #line 13270 "prim.i"
13270 }
13271 
13272 #ifdef VM_DEBUG
13273 if (vm_debug) {
13274 fputs(" -- ", vm_out); fputc('\n', vm_out);
13275 }
13276 #endif
13277 NEXT_P1;
13278 LABEL2(f_to_l)
13279 NEXT_P1_5;
13280 LABEL3(f_to_l)
13281 DO_GOTO;
13282 }
13283 
13284 LABEL(fpick) /* fpick ( f:... u -- f:... r ) S0 -- S0  */
13285 /* Actually the stack effect is @code{ r0 ... ru u -- r0 ... ru r0 }. */
13286 NAME("fpick")
13287 {
13288 DEF_CA
13289 MAYBE_UNUSED UCell u;
13290 Float r;
13291 NEXT_P0;
13292 vm_Cell2u(sp[0],u);
13293 #ifdef VM_DEBUG
13294 if (vm_debug) {
13295 fputs(" u=", vm_out); printarg_u(u);
13296 }
13297 #endif
13298 sp += 1;
13299 {
13300 #line 2450 "prim"
13301 r = fp[u];
13302 #line 13303 "prim.i"
13303 }
13304 
13305 #ifdef VM_DEBUG
13306 if (vm_debug) {
13307 fputs(" -- ", vm_out); fputs(" r=", vm_out); printarg_r(r);
13308 fputc('\n', vm_out);
13309 }
13310 #endif
13311 NEXT_P1;
13312 fp += -1;
13313 vm_r2Float(r,fp[0]);
13314 LABEL2(fpick)
13315 NEXT_P1_5;
13316 LABEL3(fpick)
13317 DO_GOTO;
13318 }
13319 
13320 GROUPADD(2)
13321 #endif
13322 GROUPADD(0)
13323 #endif
13324 GROUPADD(0)
13325 #ifdef HAS_OS
13326 GROUPADD(0)
13327 GROUP( syslib, 318)
LABEL(open_lib)13328 LABEL(open_lib) /* open-lib ( c_addr1 u1 -- u2 ) S0 -- S0  */
13329 /*  */
13330 NAME("open-lib")
13331 {
13332 DEF_CA
13333 MAYBE_UNUSED Char * c_addr1;
13334 MAYBE_UNUSED UCell u1;
13335 UCell u2;
13336 NEXT_P0;
13337 vm_Cell2c_(sp[1],c_addr1);
13338 vm_Cell2u(sp[0],u1);
13339 #ifdef VM_DEBUG
13340 if (vm_debug) {
13341 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
13342 fputs(" u1=", vm_out); printarg_u(u1);
13343 }
13344 #endif
13345 sp += 1;
13346 {
13347 #line 2462 "prim"
13348 u2 = gforth_dlopen(c_addr1, u1);
13349 #line 13350 "prim.i"
13350 }
13351 
13352 #ifdef VM_DEBUG
13353 if (vm_debug) {
13354 fputs(" -- ", vm_out); fputs(" u2=", vm_out); printarg_u(u2);
13355 fputc('\n', vm_out);
13356 }
13357 #endif
13358 NEXT_P1;
13359 vm_u2Cell(u2,sp[0]);
13360 LABEL2(open_lib)
13361 NEXT_P1_5;
13362 LABEL3(open_lib)
13363 DO_GOTO;
13364 }
13365 
13366 LABEL(lib_sym) /* lib-sym ( c_addr1 u1 u2 -- u3 ) S0 -- S0  */
13367 /*  */
13368 NAME("lib-sym")
13369 {
13370 DEF_CA
13371 MAYBE_UNUSED Char * c_addr1;
13372 MAYBE_UNUSED UCell u1;
13373 MAYBE_UNUSED UCell u2;
13374 UCell u3;
13375 NEXT_P0;
13376 vm_Cell2c_(sp[2],c_addr1);
13377 vm_Cell2u(sp[1],u1);
13378 vm_Cell2u(sp[0],u2);
13379 #ifdef VM_DEBUG
13380 if (vm_debug) {
13381 fputs(" c_addr1=", vm_out); printarg_c_(c_addr1);
13382 fputs(" u1=", vm_out); printarg_u(u1);
13383 fputs(" u2=", vm_out); printarg_u(u2);
13384 }
13385 #endif
13386 sp += 2;
13387 {
13388 #line 2465 "prim"
13389 #ifdef HAVE_LIBLTDL
13390 u3 = (UCell) lt_dlsym((lt_dlhandle)u2, cstr(c_addr1, u1, 1));
13391 #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
13392 u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1));
13393 #else
13394 #  ifdef _WIN32
13395 u3 = (Cell) GetProcAddress((HMODULE)u2, cstr(c_addr1, u1, 1));
13396 #  else
13397 #warning Define lib-sym!
13398 u3 = 0;
13399 #  endif
13400 #endif
13401 #line 13402 "prim.i"
13402 }
13403 
13404 #ifdef VM_DEBUG
13405 if (vm_debug) {
13406 fputs(" -- ", vm_out); fputs(" u3=", vm_out); printarg_u(u3);
13407 fputc('\n', vm_out);
13408 }
13409 #endif
13410 NEXT_P1;
13411 vm_u2Cell(u3,sp[0]);
13412 LABEL2(lib_sym)
13413 NEXT_P1_5;
13414 LABEL3(lib_sym)
13415 DO_GOTO;
13416 }
13417 
13418 LABEL(wcall) /* wcall ( ... u -- ... ) S0 -- S0  */
13419 /*  */
13420 NAME("wcall")
13421 {
13422 DEF_CA
13423 MAYBE_UNUSED UCell u;
13424 NEXT_P0;
13425 vm_Cell2u(sp[0],u);
13426 #ifdef VM_DEBUG
13427 if (vm_debug) {
13428 fputs(" u=", vm_out); printarg_u(u);
13429 }
13430 #endif
13431 sp += 1;
13432 {
13433 #line 2479 "prim"
13434 gforth_FP=fp;
13435 sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &gforth_FP);
13436 fp=gforth_FP;
13437 #line 13438 "prim.i"
13438 }
13439 
13440 #ifdef VM_DEBUG
13441 if (vm_debug) {
13442 fputs(" -- ", vm_out); fputc('\n', vm_out);
13443 }
13444 #endif
13445 NEXT_P1;
13446 LABEL2(wcall)
13447 NEXT_P1_5;
13448 LABEL3(wcall)
13449 DO_GOTO;
13450 }
13451 
13452 LABEL(u_w_fetch) /* uw@ ( c_addr -- u ) S0 -- S0  */
13453 /* @i{u} is the zero-extended 16-bit value stored at @i{c_addr}. */
13454 NAME("uw@")
13455 {
13456 DEF_CA
13457 MAYBE_UNUSED Char * c_addr;
13458 UCell u;
13459 NEXT_P0;
13460 vm_Cell2c_(sp[0],c_addr);
13461 #ifdef VM_DEBUG
13462 if (vm_debug) {
13463 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13464 }
13465 #endif
13466 {
13467 #line 2485 "prim"
13468 u = *(UWyde*)(c_addr);
13469 #line 13470 "prim.i"
13470 }
13471 
13472 #ifdef VM_DEBUG
13473 if (vm_debug) {
13474 fputs(" -- ", vm_out); fputs(" u=", vm_out); printarg_u(u);
13475 fputc('\n', vm_out);
13476 }
13477 #endif
13478 NEXT_P1;
13479 vm_u2Cell(u,sp[0]);
13480 LABEL2(u_w_fetch)
13481 NEXT_P1_5;
13482 LABEL3(u_w_fetch)
13483 DO_GOTO;
13484 }
13485 
13486 LABEL(s_w_fetch) /* sw@ ( c_addr -- n ) S0 -- S0  */
13487 /* @i{n} is the sign-extended 16-bit value stored at @i{c_addr}. */
13488 NAME("sw@")
13489 {
13490 DEF_CA
13491 MAYBE_UNUSED Char * c_addr;
13492 Cell n;
13493 NEXT_P0;
13494 vm_Cell2c_(sp[0],c_addr);
13495 #ifdef VM_DEBUG
13496 if (vm_debug) {
13497 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13498 }
13499 #endif
13500 {
13501 #line 2489 "prim"
13502 n = *(Wyde*)(c_addr);
13503 #line 13504 "prim.i"
13504 }
13505 
13506 #ifdef VM_DEBUG
13507 if (vm_debug) {
13508 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
13509 fputc('\n', vm_out);
13510 }
13511 #endif
13512 NEXT_P1;
13513 vm_n2Cell(n,sp[0]);
13514 LABEL2(s_w_fetch)
13515 NEXT_P1_5;
13516 LABEL3(s_w_fetch)
13517 DO_GOTO;
13518 }
13519 
13520 LABEL(w_store) /* w! ( w c_addr -- ) S0 -- S0  */
13521 /* Store the bottom 16 bits of @i{w} at @i{c_addr}. */
13522 NAME("w!")
13523 {
13524 DEF_CA
13525 MAYBE_UNUSED Cell w;
13526 MAYBE_UNUSED Char * c_addr;
13527 NEXT_P0;
13528 vm_Cell2w(sp[1],w);
13529 vm_Cell2c_(sp[0],c_addr);
13530 #ifdef VM_DEBUG
13531 if (vm_debug) {
13532 fputs(" w=", vm_out); printarg_w(w);
13533 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13534 }
13535 #endif
13536 sp += 2;
13537 {
13538 #line 2493 "prim"
13539 *(Wyde*)(c_addr) = w;
13540 #line 13541 "prim.i"
13541 }
13542 
13543 #ifdef VM_DEBUG
13544 if (vm_debug) {
13545 fputs(" -- ", vm_out); fputc('\n', vm_out);
13546 }
13547 #endif
13548 NEXT_P1;
13549 LABEL2(w_store)
13550 NEXT_P1_5;
13551 LABEL3(w_store)
13552 DO_GOTO;
13553 }
13554 
13555 LABEL(u_l_fetch) /* ul@ ( c_addr -- u ) S0 -- S0  */
13556 /* @i{u} is the zero-extended 32-bit value stored at @i{c_addr}. */
13557 NAME("ul@")
13558 {
13559 DEF_CA
13560 MAYBE_UNUSED Char * c_addr;
13561 UCell u;
13562 NEXT_P0;
13563 vm_Cell2c_(sp[0],c_addr);
13564 #ifdef VM_DEBUG
13565 if (vm_debug) {
13566 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13567 }
13568 #endif
13569 {
13570 #line 2497 "prim"
13571 u = *(UTetrabyte*)(c_addr);
13572 #line 13573 "prim.i"
13573 }
13574 
13575 #ifdef VM_DEBUG
13576 if (vm_debug) {
13577 fputs(" -- ", vm_out); fputs(" u=", vm_out); printarg_u(u);
13578 fputc('\n', vm_out);
13579 }
13580 #endif
13581 NEXT_P1;
13582 vm_u2Cell(u,sp[0]);
13583 LABEL2(u_l_fetch)
13584 NEXT_P1_5;
13585 LABEL3(u_l_fetch)
13586 DO_GOTO;
13587 }
13588 
13589 LABEL(s_l_fetch) /* sl@ ( c_addr -- n ) S0 -- S0  */
13590 /* @i{n} is the sign-extended 32-bit value stored at @i{c_addr}. */
13591 NAME("sl@")
13592 {
13593 DEF_CA
13594 MAYBE_UNUSED Char * c_addr;
13595 Cell n;
13596 NEXT_P0;
13597 vm_Cell2c_(sp[0],c_addr);
13598 #ifdef VM_DEBUG
13599 if (vm_debug) {
13600 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13601 }
13602 #endif
13603 {
13604 #line 2501 "prim"
13605 n = *(Tetrabyte*)(c_addr);
13606 #line 13607 "prim.i"
13607 }
13608 
13609 #ifdef VM_DEBUG
13610 if (vm_debug) {
13611 fputs(" -- ", vm_out); fputs(" n=", vm_out); printarg_n(n);
13612 fputc('\n', vm_out);
13613 }
13614 #endif
13615 NEXT_P1;
13616 vm_n2Cell(n,sp[0]);
13617 LABEL2(s_l_fetch)
13618 NEXT_P1_5;
13619 LABEL3(s_l_fetch)
13620 DO_GOTO;
13621 }
13622 
13623 LABEL(l_store) /* l! ( w c_addr -- ) S0 -- S0  */
13624 /* Store the bottom 32 bits of @i{w} at @i{c_addr}. */
13625 NAME("l!")
13626 {
13627 DEF_CA
13628 MAYBE_UNUSED Cell w;
13629 MAYBE_UNUSED Char * c_addr;
13630 NEXT_P0;
13631 vm_Cell2w(sp[1],w);
13632 vm_Cell2c_(sp[0],c_addr);
13633 #ifdef VM_DEBUG
13634 if (vm_debug) {
13635 fputs(" w=", vm_out); printarg_w(w);
13636 fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13637 }
13638 #endif
13639 sp += 2;
13640 {
13641 #line 2505 "prim"
13642 *(Tetrabyte*)(c_addr) = w;
13643 #line 13644 "prim.i"
13644 }
13645 
13646 #ifdef VM_DEBUG
13647 if (vm_debug) {
13648 fputs(" -- ", vm_out); fputc('\n', vm_out);
13649 }
13650 #endif
13651 NEXT_P1;
13652 LABEL2(l_store)
13653 NEXT_P1_5;
13654 LABEL3(l_store)
13655 DO_GOTO;
13656 }
13657 
13658 LABEL(lib_error) /* lib-error ( -- c_addr u ) S0 -- S0  */
13659 /* Error message for last failed @code{open-lib} or @code{lib-sym}. */
13660 NAME("lib-error")
13661 {
13662 DEF_CA
13663 Char * c_addr;
13664 UCell u;
13665 NEXT_P0;
13666 #ifdef VM_DEBUG
13667 if (vm_debug) {
13668 }
13669 #endif
13670 sp += -2;
13671 {
13672 #line 2509 "prim"
13673 #ifdef HAVE_LIBLTDL
13674 c_addr = (Char *)lt_dlerror();
13675 u = (c_addr == NULL) ? 0 : strlen((char *)c_addr);
13676 #else
13677 c_addr = "libltdl is not configured";
13678 u = strlen(c_addr);
13679 #endif
13680 #line 13681 "prim.i"
13681 }
13682 
13683 #ifdef VM_DEBUG
13684 if (vm_debug) {
13685 fputs(" -- ", vm_out); fputs(" c_addr=", vm_out); printarg_c_(c_addr);
13686 fputs(" u=", vm_out); printarg_u(u);
13687 fputc('\n', vm_out);
13688 }
13689 #endif
13690 NEXT_P1;
13691 vm_c_2Cell(c_addr,sp[1]);
13692 vm_u2Cell(u,sp[0]);
13693 LABEL2(lib_error)
13694 NEXT_P1_5;
13695 LABEL3(lib_error)
13696 DO_GOTO;
13697 }
13698 
13699 GROUPADD(10)
13700 #endif
13701 GROUPADD(0)
13702 GROUP( peephole, 328)
13703 GROUPADD(0)
13704 #ifdef HAS_PEEPHOLE
LABEL(compile_prim1)13705 LABEL(compile_prim1) /* compile-prim1 ( a_prim -- ) S0 -- S0  */
13706 /* compile prim (incl. immargs) at @var{a_prim} */
13707 NAME("compile-prim1")
13708 {
13709 DEF_CA
13710 MAYBE_UNUSED Cell * a_prim;
13711 NEXT_P0;
13712 vm_Cell2a_(sp[0],a_prim);
13713 #ifdef VM_DEBUG
13714 if (vm_debug) {
13715 fputs(" a_prim=", vm_out); printarg_a_(a_prim);
13716 }
13717 #endif
13718 sp += 1;
13719 {
13720 #line 2524 "prim"
13721 compile_prim1(a_prim);
13722 #line 13723 "prim.i"
13723 }
13724 
13725 #ifdef VM_DEBUG
13726 if (vm_debug) {
13727 fputs(" -- ", vm_out); fputc('\n', vm_out);
13728 }
13729 #endif
13730 NEXT_P1;
13731 LABEL2(compile_prim1)
13732 NEXT_P1_5;
13733 LABEL3(compile_prim1)
13734 DO_GOTO;
13735 }
13736 
13737 LABEL(finish_code) /* finish-code ( ... -- ... ) S0 -- S0  */
13738 /* Perform delayed steps in code generation (branch resolution, I-cache
13739 flushing). */
13740 NAME("finish-code")
13741 {
13742 DEF_CA
13743 NEXT_P0;
13744 #ifdef VM_DEBUG
13745 if (vm_debug) {
13746 }
13747 #endif
13748 {
13749 #line 2529 "prim"
13750 /* The ... above are a workaround for a bug in gcc-2.95, which fails
13751    to save spTOS (gforth-fast --enable-force-reg) */
13752 finish_code();
13753 #line 13754 "prim.i"
13754 }
13755 
13756 #ifdef VM_DEBUG
13757 if (vm_debug) {
13758 fputs(" -- ", vm_out); fputc('\n', vm_out);
13759 }
13760 #endif
13761 NEXT_P1;
13762 LABEL2(finish_code)
13763 NEXT_P1_5;
13764 LABEL3(finish_code)
13765 DO_GOTO;
13766 }
13767 
13768 LABEL(forget_dyncode) /* forget-dyncode ( c_code -- f ) S0 -- S0  */
13769 /*  */
13770 NAME("forget-dyncode")
13771 {
13772 DEF_CA
13773 MAYBE_UNUSED Char * c_code;
13774 Bool f;
13775 NEXT_P0;
13776 vm_Cell2c_(sp[0],c_code);
13777 #ifdef VM_DEBUG
13778 if (vm_debug) {
13779 fputs(" c_code=", vm_out); printarg_c_(c_code);
13780 }
13781 #endif
13782 {
13783 #line 2534 "prim"
13784 f = forget_dyncode(c_code);
13785 #line 13786 "prim.i"
13786 }
13787 
13788 #ifdef VM_DEBUG
13789 if (vm_debug) {
13790 fputs(" -- ", vm_out); fputs(" f=", vm_out); printarg_f(f);
13791 fputc('\n', vm_out);
13792 }
13793 #endif
13794 NEXT_P1;
13795 vm_f2Cell(f,sp[0]);
13796 LABEL2(forget_dyncode)
13797 NEXT_P1_5;
13798 LABEL3(forget_dyncode)
13799 DO_GOTO;
13800 }
13801 
13802 LABEL(decompile_prim) /* decompile-prim ( a_code -- a_prim ) S0 -- S0  */
13803 /* a_prim is the code address of the primitive that has been
13804 compile_prim1ed to a_code */
13805 NAME("decompile-prim")
13806 {
13807 DEF_CA
13808 MAYBE_UNUSED Cell * a_code;
13809 Cell * a_prim;
13810 NEXT_P0;
13811 vm_Cell2a_(sp[0],a_code);
13812 #ifdef VM_DEBUG
13813 if (vm_debug) {
13814 fputs(" a_code=", vm_out); printarg_a_(a_code);
13815 }
13816 #endif
13817 {
13818 #line 2539 "prim"
13819 a_prim = (Cell *)decompile_code((Label)a_code);
13820 #line 13821 "prim.i"
13821 }
13822 
13823 #ifdef VM_DEBUG
13824 if (vm_debug) {
13825 fputs(" -- ", vm_out); fputs(" a_prim=", vm_out); printarg_a_(a_prim);
13826 fputc('\n', vm_out);
13827 }
13828 #endif
13829 NEXT_P1;
13830 vm_a_2Cell(a_prim,sp[0]);
13831 LABEL2(decompile_prim)
13832 NEXT_P1_5;
13833 LABEL3(decompile_prim)
13834 DO_GOTO;
13835 }
13836 
13837 LABEL(set_next_code) /* set-next-code ( #w -- ) S0 -- S0  */
13838 /*  */
13839 NAME("set-next-code")
13840 {
13841 DEF_CA
13842 MAYBE_UNUSED Cell w;
13843 NEXT_P0;
13844 vm_Cell2w(IMM_ARG(IPTOS,305397799 ),w);
13845 #ifdef VM_DEBUG
13846 if (vm_debug) {
13847 fputs(" w=", vm_out); printarg_w(w);
13848 }
13849 #endif
13850 INC_IP(1);
13851 {
13852 #line 2545 "prim"
13853 #ifdef NO_IP
13854 next_code = (Label)w;
13855 #endif
13856 #line 13857 "prim.i"
13857 }
13858 
13859 #ifdef VM_DEBUG
13860 if (vm_debug) {
13861 fputs(" -- ", vm_out); fputc('\n', vm_out);
13862 }
13863 #endif
13864 NEXT_P1;
13865 LABEL2(set_next_code)
13866 NEXT_P1_5;
13867 LABEL3(set_next_code)
13868 DO_GOTO;
13869 }
13870 
13871 LABEL(call2) /* call2 ( #a_callee #a_ret_addr -- R:a_ret_addr ) S0 -- S0  */
13872 /*  */
13873 NAME("call2")
13874 {
13875 DEF_CA
13876 MAYBE_UNUSED Cell * a_callee;
13877 MAYBE_UNUSED Cell * a_ret_addr;
13878 NEXT_P0;
13879 vm_Cell2a_(IMM_ARG(IPTOS,305397800 ),a_callee);
13880 vm_Cell2a_(IMM_ARG(IP[1],305397801 ),a_ret_addr);
13881 #ifdef VM_DEBUG
13882 if (vm_debug) {
13883 fputs(" a_callee=", vm_out); printarg_a_(a_callee);
13884 fputs(" a_ret_addr=", vm_out); printarg_a_(a_ret_addr);
13885 }
13886 #endif
13887 INC_IP(2);
13888 rp += -1;
13889 {
13890 #line 2550 "prim"
13891 /* call with explicit return address */
13892 #ifdef NO_IP
13893 
13894 #ifdef VM_DEBUG
13895 if (vm_debug) {
13896 fputs(" -- ", vm_out); fputc('\n', vm_out);
13897 }
13898 #endif
13899 NEXT_P1;
13900 vm_a_2Cell(a_ret_addr,rp[0]);
13901 
13902 JUMP(a_callee);
13903 #else
13904 assert(0);
13905 #endif
13906 #line 13907 "prim.i"
13907 }
13908 
13909 #ifdef VM_DEBUG
13910 if (vm_debug) {
13911 fputs(" -- ", vm_out); fputc('\n', vm_out);
13912 }
13913 #endif
13914 NEXT_P1;
13915 vm_a_2Cell(a_ret_addr,rp[0]);
13916 LABEL2(call2)
13917 NEXT_P1_5;
13918 LABEL3(call2)
13919 DO_GOTO;
13920 }
13921 
13922 LABEL(tag_offsets) /* tag-offsets ( -- a_addr ) S0 -- S0  */
13923 /*  */
13924 NAME("tag-offsets")
13925 {
13926 DEF_CA
13927 Cell * a_addr;
13928 NEXT_P0;
13929 #ifdef VM_DEBUG
13930 if (vm_debug) {
13931 }
13932 #endif
13933 sp += -1;
13934 {
13935 #line 2559 "prim"
13936 extern Cell groups[32];
13937 a_addr = groups;
13938 #line 13939 "prim.i"
13939 }
13940 
13941 #ifdef VM_DEBUG
13942 if (vm_debug) {
13943 fputs(" -- ", vm_out); fputs(" a_addr=", vm_out); printarg_a_(a_addr);
13944 fputc('\n', vm_out);
13945 }
13946 #endif
13947 NEXT_P1;
13948 vm_a_2Cell(a_addr,sp[0]);
13949 LABEL2(tag_offsets)
13950 NEXT_P1_5;
13951 LABEL3(tag_offsets)
13952 DO_GOTO;
13953 }
13954 
13955 GROUPADD(7)
13956 #endif
13957 GROUPADD(0)
13958 GROUP( static_super, 335)
13959 GROUPADD(0)
13960 GROUP( end, 335)
13961