|
|
1 # ifndef FUNCDEF
2 # include "kfun.h"
3 # include "path.h"
4 # include "comm.h"
5 # include "call_out.h"
6 # include "editor.h"
7 # include "node.h"
8 # include "control.h"
9 # include "compile.h"
10 # endif
11
12
13 # ifdef FUNCDEF
14 FUNCDEF("compile_object", kf_compile_object, pt_compile_object)
15 # else
16 char pt_compile_object[] = { C_TYPECHECKED | C_STATIC, T_OBJECT, 1, T_STRING };
17
18 /*
19 * NAME: kfun->compile_object()
20 * DESCRIPTION: compile an object
21 */
22 int kf_compile_object(f)
23 register frame *f;
24 {
25 char file[STRINGSZ];
26 register object *obj;
27
28 if (path_string(file, f->sp->u.string->text,
29 f->sp->u.string->len) == (char *) NULL) {
30 return 1;
31 }
32 obj = o_find(file, OACC_MODIFY);
33 if (obj != (object *) NULL) {
34 if (!(obj->flags & O_MASTER)) {
35 error("Cannot recompile cloned object");
36 }
37 if (O_UPGRADING(obj)) {
38 error("Object is already being upgraded");
39 }
40 if (O_INHERITED(obj)) {
41 error("Cannot recompile inherited object");
42 }
43 }
44 obj = c_compile(f, file, obj);
45 str_del(f->sp->u.string);
46 PUT_OBJVAL(f->sp, obj);
47
48 return 0;
49 }
50 # endif
51
52
53 # ifdef FUNCDEF
54 FUNCDEF("call_other", kf_call_other, pt_call_other)
55 # else
56 char pt_call_other[] = { C_TYPECHECKED | C_STATIC | C_KFUN_VARARGS, T_MIXED, 3,
57 T_MIXED, T_STRING, T_MIXED | T_ELLIPSIS };
58
59 /*
60 * NAME: kfun->call_other()
61 * DESCRIPTION: call a function in another object
62 */
63 int kf_call_other(f, nargs)
64 register frame *f;
65 int nargs;
66 {
67 register object *obj;
68 register value *val;
69
70 val = &f->sp[nargs - 1];
71 switch (val->type) {
72 case T_STRING:
73 *--f->sp = *val;
74 *val = nil_value; /* erase old copy */
75 call_driver_object(f, "call_object", 1);
76 if (f->sp->type != T_OBJECT) {
77 i_del_value(f->sp++);
78 return 1;
79 }
80 obj = OBJR(f->sp->oindex);
81 f->sp++;
82 break;
83
84 case T_OBJECT:
85 obj = OBJR(val->oindex);
86 break;
87
88 default:
89 /* bad arg 1 */
90 return 1;
91 }
92
93 /* default return value */
94 *val = nil_value;
95 --val;
96
97 if (OBJR(f->oindex)->count == 0) {
98 /*
99 * call from destructed object
100 */
101 i_pop(f, nargs - 1);
102 return 0;
103 }
104
105 if (i_call(f, obj, val->u.string->text, val->u.string->len, FALSE,
106 nargs - 2)) {
107 /* function exists */
108 val = f->sp++;
109 str_del((f->sp++)->u.string);
110 *f->sp = *val;
111 } else {
112 /* function doesn't exist */
113 str_del((f->sp++)->u.string);
114 }
115 return 0;
116 }
117 # endif
118
119
120 # ifdef FUNCDEF
121 FUNCDEF("this_object", kf_this_object, pt_this_object)
122 # else
123 char pt_this_object[] = { C_STATIC, T_OBJECT, 0 };
124
125 /*
126 * NAME: kfun->this_object()
127 * DESCRIPTION: return the current object
128 */
129 int kf_this_object(f)
130 register frame *f;
131 {
132 register object *obj;
133
134 --f->sp;
135 obj = OBJR(f->oindex);
136 if (obj->count != 0) {
137 PUT_OBJVAL(f->sp, obj);
138 } else {
139 *f->sp = nil_value;
140 }
141 return 0;
142 }
143 # endif
144
145
146 # ifdef FUNCDEF
147 FUNCDEF("previous_object", kf_previous_object, pt_previous_object)
148 # else
149 char pt_previous_object[] =
150 { C_TYPECHECKED | C_STATIC | C_KFUN_VARARGS | C_VARARGS, T_OBJECT, 1,
151 T_INT };
152
153 /*
154 * NAME: kfun->previous_object()
155 * DESCRIPTION: return the previous object in the call_other chain
156 */
157 int kf_previous_object(f, nargs)
158 register frame *f;
159 int nargs;
160 {
161 register object *obj;
162
163 if (nargs == 0) {
164 *--f->sp = nil_value;
165 } else if (f->sp->u.number < 0) {
166 return 1;
167 }
168
169 obj = i_prev_object(f, (int) f->sp->u.number);
170 if (obj != (object *) NULL) {
171 PUT_OBJVAL(f->sp, obj);
172 } else {
173 *f->sp = nil_value;
174 }
175 return 0;
176 }
177 # endif
178
179
180 # ifdef FUNCDEF
181 FUNCDEF("previous_program", kf_previous_program, pt_previous_program)
182 # else
183 char pt_previous_program[] =
184 { C_TYPECHECKED | C_STATIC | C_KFUN_VARARGS | C_VARARGS, T_STRING,
185 1, T_INT };
186
187 /*
188 * NAME: kfun->previous_program()
189 * DESCRIPTION: return the previous program in the function call chain
190 */
191 int kf_previous_program(f, nargs)
192 register frame *f;
193 int nargs;
194 {
195 char *prog;
196 register string *str;
197
198 if (nargs == 0) {
199 *--f->sp = nil_value;
200 } else if (f->sp->u.number < 0) {
201 return 1;
202 }
203
204 prog = i_prev_program(f, (int) f->sp->u.number);
205 if (prog != (char *) NULL) {
206 PUT_STRVAL(f->sp, str = str_new((char *) NULL, strlen(prog) + 1L));
207 str->text[0] = '/';
208 strcpy(str->text + 1, prog);
209 } else {
210 *f->sp = nil_value;
211 }
212 return 0;
213 }
214 # endif
215
216
217 # ifdef FUNCDEF
218 FUNCDEF("call_trace", kf_call_trace, pt_call_trace)
219 # else
220 char pt_call_trace[] = { C_STATIC, T_MIXED | (2 << REFSHIFT), 0 };
221
222 /*
223 * NAME: kfun->call_trace()
224 * DESCRIPTION: return the entire call_other chain
225 */
226 int kf_call_trace(f)
227 register frame *f;
228 {
229 PUSH_ARRVAL(f, i_call_trace(f));
230 return 0;
231 }
232 # endif
233
234
235 # ifdef FUNCDEF
236 FUNCDEF("clone_object", kf_clone_object, pt_clone_object)
237 # else
238 char pt_clone_object[] = { C_TYPECHECKED | C_STATIC, T_OBJECT, 1, T_OBJECT };
239
240 /*
241 * NAME: kfun->clone_object()
242 * DESCRIPTION: clone a new object
243 */
244 int kf_clone_object(f)
245 register frame *f;
246 {
247 register object *obj;
248
249 obj = OBJF(f->sp->oindex);
250 if (!(obj->flags & O_MASTER)) {
251 error("Cloning from a clone");
252 }
253 obj = o_clone(obj);
254 PUT_OBJ(f->sp, obj);
255 i_call(f, obj, "", 0, FALSE, 0); /* cause creator to be called */
256 return 0;
257 }
258 # endif
259
260
261 # ifdef FUNCDEF
262 FUNCDEF("destruct_object", kf_destruct_object, pt_destruct_object)
263 # else
264 char pt_destruct_object[] = { C_TYPECHECKED | C_STATIC, T_VOID, 1, T_OBJECT };
265
266 /*
267 * NAME: kfun->destruct_object()
268 * DESCRIPTION: destruct an object
269 */
270 int kf_destruct_object(f)
271 register frame *f;
272 {
273 register object *obj;
274
275 obj = OBJW(f->sp->oindex);
276 switch (obj->flags & O_SPECIAL) {
277 case O_USER:
278 comm_close(f, obj);
279 break;
280
281 case O_EDITOR:
282 if (f->level != 0) {
283 error("Destructing editor object in atomic function");
284 }
285 ed_del(obj);
286 break;
287
288 case O_SPECIAL:
289 if (ext_destruct != (void (*) P((object*))) NULL) {
290 (*ext_destruct)(obj);
291 }
292 break;
293 }
294 o_del(obj, f);
295 return 0;
296 }
297 # endif
298
299
300 # ifdef FUNCDEF
301 FUNCDEF("object_name", kf_object_name, pt_object_name)
302 # else
303 char pt_object_name[] = { C_TYPECHECKED | C_STATIC, T_STRING, 1, T_OBJECT };
304
305 /*
306 * NAME: kfun->object_name()
307 * DESCRIPTION: return the name of an object
308 */
309 int kf_object_name(f)
310 register frame *f;
311 {
312 char buffer[STRINGSZ + 12], *name;
313
314 name = o_name(buffer, OBJR(f->sp->oindex));
315 PUT_STRVAL(f->sp, str_new((char *) NULL, strlen(name) + 1L));
316 f->sp->u.string->text[0] = '/';
317 strcpy(f->sp->u.string->text + 1, name);
318 return 0;
319 }
320 # endif
321
322
323 # ifdef FUNCDEF
324 FUNCDEF("find_object", kf_find_object, pt_find_object)
325 # else
326 char pt_find_object[] = { C_TYPECHECKED | C_STATIC, T_OBJECT, 1, T_STRING };
327
328 /*
329 * NAME: kfun->find_object()
330 * DESCRIPTION: find the loaded object for a given object name
331 */
332 int kf_find_object(f)
333 register frame *f;
334 {
335 char path[STRINGSZ];
336 object *obj;
337
338 if (path_string(path, f->sp->u.string->text,
339 f->sp->u.string->len) == (char *) NULL) {
340 return 1;
341 }
342 i_add_ticks(f, 2);
343 obj = o_find(path, OACC_READ);
344 str_del(f->sp->u.string);
345 if (obj != (object *) NULL) {
346 PUT_OBJVAL(f->sp, obj);
347 } else {
348 *f->sp = nil_value;
349 }
350 return 0;
351 }
352 # endif
353
354
355 # ifdef FUNCDEF
356 FUNCDEF("function_object", kf_function_object, pt_function_object)
357 # else
358 char pt_function_object[] = { C_TYPECHECKED | C_STATIC, T_STRING, 2,
359 T_STRING, T_OBJECT };
360
361 /*
362 * NAME: kfun->function_object()
363 * DESCRIPTION: return the name of the program a function is in
364 */
365 int kf_function_object(f)
366 register frame *f;
367 {
368 object *obj;
369 dsymbol *symb;
370 char *name;
371
372 i_add_ticks(f, 2);
373 obj = OBJR(f->sp->oindex);
374 f->sp++;
375 symb = ctrl_symb(o_control(obj), f->sp->u.string->text,
376 f->sp->u.string->len);
377 str_del(f->sp->u.string);
378
379 if (symb != (dsymbol *) NULL) {
380 object *o;
381
382 o = OBJR(obj->ctrl->inherits[UCHAR(symb->inherit)].oindex);
383 if (!(d_get_funcdefs(o->ctrl)[UCHAR(symb->index)].class & C_STATIC) ||
384 obj->index == f->oindex) {
385 /*
386 * function exists and is callable
387 */
388 name = o->chain.name;
389 PUT_STR(f->sp, str_new((char *) NULL, strlen(name) + 1L));
390 f->sp->u.string->text[0] = '/';
391 strcpy(f->sp->u.string->text + 1, name);
392 return 0;
393 }
394 }
395 *f->sp = nil_value;
396 return 0;
397 }
398 # endif
399
400
401 # ifdef FUNCDEF
402 FUNCDEF("this_user", kf_this_user, pt_this_user)
403 # else
404 char pt_this_user[] = { C_STATIC, T_OBJECT, 0 };
405
406 /*
407 * NAME: kfun->this_user()
408 * DESCRIPTION: return the current user object (if any)
409 */
410 int kf_this_user(f)
411 register frame *f;
412 {
413 object *obj;
414
415 obj = comm_user();
416 if (obj != (object *) NULL) {
417 PUSH_OBJVAL(f, obj);
418 } else {
419 *--f->sp = nil_value;
420 }
421 return 0;
422 }
423 # endif
424
425
426 # ifdef FUNCDEF
427 FUNCDEF("query_ip_number", kf_query_ip_number, pt_query_ip_number)
428 # else
429 char pt_query_ip_number[] = { C_TYPECHECKED | C_STATIC, T_STRING, 1, T_OBJECT };
430
431 /*
432 * NAME: kfun->query_ip_number()
433 * DESCRIPTION: return the ip number of a user
434 */
435 int kf_query_ip_number(f)
436 register frame *f;
437 {
438 object *obj;
439
440 obj = OBJR(f->sp->oindex);
441 if ((obj->flags & O_SPECIAL) == O_USER) {
442 PUT_STRVAL(f->sp, comm_ip_number(obj));
443 } else {
444 *f->sp = nil_value;
445 }
446 return 0;
447 }
448 # endif
449
450
451 # ifdef FUNCDEF
452 FUNCDEF("query_ip_name", kf_query_ip_name, pt_query_ip_name)
453 # else
454 char pt_query_ip_name[] = { C_TYPECHECKED | C_STATIC, T_STRING, 1, T_OBJECT };
455
456 /*
457 * NAME: kfun->query_ip_name()
458 * DESCRIPTION: return the ip name of a user
459 */
460 int kf_query_ip_name(f)
461 register frame *f;
462 {
463 object *obj;
464
465 obj = OBJR(f->sp->oindex);
466 if ((obj->flags & O_SPECIAL) == O_USER) {
467 PUT_STRVAL(f->sp, comm_ip_name(obj));
468 } else {
469 *f->sp = nil_value;
470 }
471 return 0;
472 }
473 # endif
474
475
476 # ifdef FUNCDEF
477 FUNCDEF("users", kf_users, pt_users)
478 # else
479 char pt_users[] = { C_STATIC, T_OBJECT | (1 << REFSHIFT), 0 };
480
481 /*
482 * NAME: kfun->users()
483 * DESCRIPTION: return the array of users
484 */
485 int kf_users(f)
486 register frame *f;
487 {
488 PUSH_ARRVAL(f, comm_users(f->data));
489 i_add_ticks(f, f->sp->u.array->size);
490 return 0;
491 }
492 # endif
493
494
495 # ifdef FUNCDEF
496 FUNCDEF("strlen", kf_strlen, pt_strlen)
497 # else
498 char pt_strlen[] = { C_TYPECHECKED | C_STATIC, T_INT, 1, T_STRING };
499
500 /*
501 * NAME: kfun->strlen()
502 * DESCRIPTION: return the length of a string
503 */
504 int kf_strlen(f)
505 register frame *f;
506 {
507 ssizet len;
508
509 len = f->sp->u.string->len;
510 str_del(f->sp->u.string);
511 PUT_INTVAL(f->sp, len);
512 return 0;
513 }
514 # endif
515
516
517 # ifdef FUNCDEF
518 FUNCDEF("allocate", kf_allocate, pt_allocate)
519 # else
520 char pt_allocate[] = { C_TYPECHECKED | C_STATIC, T_MIXED | (1 << REFSHIFT), 1,
521 T_INT };
522
523 /*
524 * NAME: kfun->allocate()
525 * DESCRIPTION: allocate an array
526 */
527 int kf_allocate(f)
528 register frame *f;
529 {
530 register int i;
531 register value *v;
532
533 if (f->sp->u.number < 0) {
534 return 1;
535 }
536 i_add_ticks(f, f->sp->u.number);
537 PUT_ARRVAL(f->sp, arr_new(f->data, (long) f->sp->u.number));
538 for (i = f->sp->u.array->size, v = f->sp->u.array->elts; i > 0; --i, v++) {
539 *v = nil_value;
540 }
541 return 0;
542 }
543 # endif
544
545
546 # ifdef FUNCDEF
547 FUNCDEF("allocate_int", kf_allocate_int, pt_allocate_int)
548 # else
549 char pt_allocate_int[] = { C_TYPECHECKED | C_STATIC, T_INT | (1 << REFSHIFT), 1,
550 T_INT };
551
552 /*
553 * NAME: kfun->allocate_int()
554 * DESCRIPTION: allocate an array of integers
555 */
556 int kf_allocate_int(f)
557 register frame *f;
558 {
559 register int i;
560 register value *v;
561
562 if (f->sp->u.number < 0) {
563 return 1;
564 }
565 i_add_ticks(f, f->sp->u.number);
566 PUT_ARRVAL(f->sp, arr_new(f->data, (long) f->sp->u.number));
567 for (i = f->sp->u.array->size, v = f->sp->u.array->elts; i > 0; --i, v++) {
568 *v = zero_int;
569 }
570 return 0;
571 }
572 # endif
573
574
575 # ifdef FUNCDEF
576 FUNCDEF("allocate_float", kf_allocate_float, pt_allocate_float)
577 # else
578 char pt_allocate_float[] = { C_TYPECHECKED | C_STATIC,
579 T_FLOAT | (1 << REFSHIFT), 1, T_INT };
580
581 /*
582 * NAME: kfun->allocate_float()
583 * DESCRIPTION: allocate an array
584 */
585 int kf_allocate_float(f)
586 register frame *f;
587 {
588 register int i;
589 register value *v;
590
591 if (f->sp->u.number < 0) {
592 return 1;
593 }
594 i_add_ticks(f, f->sp->u.number);
595 PUT_ARRVAL(f->sp, arr_new(f->data, (long) f->sp->u.number));
596 for (i = f->sp->u.array->size, v = f->sp->u.array->elts; i > 0; --i, v++) {
597 *v = zero_float;
598 }
599 return 0;
600 }
601 # endif
602
603
604 # ifdef FUNCDEF
605 FUNCDEF("sizeof", kf_sizeof, pt_sizeof)
606 # else
607 char pt_sizeof[] = { C_TYPECHECKED | C_STATIC, T_INT, 1,
608 T_MIXED | (1 << REFSHIFT) };
609
610 /*
611 * NAME: kfun->sizeof()
612 * DESCRIPTION: return the size of an array
613 */
614 int kf_sizeof(f)
615 register frame *f;
616 {
617 unsigned short size;
618
619 size = f->sp->u.array->size;
620 arr_del(f->sp->u.array);
621 PUT_INTVAL(f->sp, size);
622 return 0;
623 }
624 # endif
625
626
627 # ifdef FUNCDEF
628 FUNCDEF("map_indices", kf_map_indices, pt_map_indices)
629 # else
630 char pt_map_indices[] = { C_TYPECHECKED | C_STATIC, T_MIXED | (1 << REFSHIFT),
631 1, T_MAPPING };
632
633 /*
634 * NAME: kfun->map_indices()
635 * DESCRIPTION: return the array of mapping indices
636 */
637 int kf_map_indices(f)
638 register frame *f;
639 {
640 array *a;
641
642 a = map_indices(f->data, f->sp->u.array);
643 i_add_ticks(f, f->sp->u.array->size);
644 arr_del(f->sp->u.array);
645 PUT_ARRVAL(f->sp, a);
646 return 0;
647 }
648 # endif
649
650
651 # ifdef FUNCDEF
652 FUNCDEF("map_values", kf_map_values, pt_map_values)
653 # else
654 char pt_map_values[] = { C_TYPECHECKED | C_STATIC, T_MIXED | (1 << REFSHIFT), 1,
655 T_MAPPING };
656
657 /*
658 * NAME: kfun->map_values()
659 * DESCRIPTION: return the array of mapping values
660 */
661 int kf_map_values(f)
662 register frame *f;
663 {
664 array *a;
665
666 a = map_values(f->data, f->sp->u.array);
667 i_add_ticks(f, f->sp->u.array->size);
668 arr_del(f->sp->u.array);
669 PUT_ARRVAL(f->sp, a);
670 return 0;
671 }
672 # endif
673
674
675 # ifdef FUNCDEF
676 FUNCDEF("map_sizeof", kf_map_sizeof, pt_map_sizeof)
677 # else
678 char pt_map_sizeof[] = { C_TYPECHECKED | C_STATIC, T_INT, 1, T_MAPPING };
679
680 /*
681 * NAME: kfun->map_sizeof()
682 * DESCRIPTION: return the number of index/value pairs in a mapping
683 */
684 int kf_map_sizeof(f)
685 register frame *f;
686 {
687 unsigned short size;
688
689 i_add_ticks(f, f->sp->u.array->size);
690 size = map_size(f->data, f->sp->u.array);
691 arr_del(f->sp->u.array);
692 PUT_INTVAL(f->sp, size);
693 return 0;
694 }
695 # endif
696
697
698 # ifdef FUNCDEF
699 FUNCDEF("typeof", kf_typeof, pt_typeof)
700 # else
701 char pt_typeof[] = { C_STATIC, T_INT, 1, T_MIXED };
702
703 /*
704 * NAME: kfun->typeof()
705 * DESCRIPTION: return the type of a value
706 */
707 int kf_typeof(f)
708 register frame *f;
709 {
710 i_del_value(f->sp);
711 PUT_INTVAL(f->sp, f->sp->type);
712 return 0;
713 }
714 # endif
715
716
717 # ifdef FUNCDEF
718 FUNCDEF("error", kf_error, pt_error)
719 # else
720 char pt_error[] = { C_TYPECHECKED | C_STATIC, T_VOID, 1, T_STRING };
721
722 /*
723 * NAME: kfun->error()
724 * DESCRIPTION: cause an error
725 */
726 int kf_error(f)
727 frame *f;
728 {
729 serror(f->sp->u.string);
730 return 0;
731 }
732 # endif
733
734
735 # ifdef FUNCDEF
736 FUNCDEF("send_message", kf_send_message, pt_send_message)
737 # else
738 char pt_send_message[] = { C_STATIC, T_INT, 1, T_MIXED };
739
740 /*
741 * NAME: kfun->send_message()
742 * DESCRIPTION: send a message to a user
743 */
744 int kf_send_message(f)
745 register frame *f;
746 {
747 register object *obj;
748 int num;
749
750 if (f->sp->type != T_STRING && f->sp->type != T_INT) {
751 return 1;
752 }
753
754 num = 0;
755 obj = OBJR(f->oindex);
756 if (obj->count != 0) {
757 if ((obj->flags & O_SPECIAL) == O_USER) {
758 if (f->sp->type == T_INT) {
759 num = comm_echo(obj, f->sp->u.number != 0);
760 } else {
761 num = comm_send(OBJW(obj->index), f->sp->u.string);
762 }
763 } else if ((obj->flags & O_DRIVER) && f->sp->type == T_STRING) {
764 P_message(f->sp->u.string->text);
765 num = f->sp->u.string->len;
766 }
767 }
768 if (f->sp->type == T_STRING) {
769 str_del(f->sp->u.string);
770 }
771 PUT_INTVAL(f->sp, num);
772 return 0;
773 }
774 # endif
775
776
777 # ifdef FUNCDEF
778 FUNCDEF("send_datagram", kf_send_datagram, pt_send_datagram)
779 # else
780 char pt_send_datagram[] = { C_TYPECHECKED | C_STATIC, T_INT, 1, T_STRING };
781
782 /*
783 * NAME: kfun->send_datagram()
784 * DESCRIPTION: send a datagram to a user
785 */
786 int kf_send_datagram(f)
787 register frame *f;
788 {
789 object *obj;
790 int num;
791
792 obj = OBJW(f->oindex);
793 if ((obj->flags & O_SPECIAL) == O_USER && obj->count != 0) {
794 num = comm_udpsend(obj, f->sp->u.string);
795 } else {
796 num = 0;
797 }
798 str_del(f->sp->u.string);
799 PUT_INTVAL(f->sp, num);
800 return 0;
801 }
802 # endif
803
804
805 # ifdef FUNCDEF
806 FUNCDEF("block_input", kf_block_input, pt_block_input)
807 # else
808 char pt_block_input[] = { C_TYPECHECKED | C_STATIC, T_VOID, 1, T_INT };
809
810 /*
811 * NAME: kfun->block_input()
812 * DESCRIPTION: block input for the current object
813 */
814 int kf_block_input(f)
815 register frame *f;
816 {
817 object *obj;
818
819 obj = OBJR(f->oindex);
820 if ((obj->flags & O_SPECIAL) == O_USER) {
821 comm_block(obj, f->sp->u.number != 0);
822 }
823 *f->sp = nil_value;
824 return 0;
825 }
826 # endif
827
828
829 # ifdef FUNCDEF
830 FUNCDEF("time", kf_time, pt_time)
831 # else
832 char pt_time[] = { C_STATIC, T_INT, 0 };
833
834 /*
835 * NAME: kfun->time()
836 * DESCRIPTION: return the current time
837 */
838 int kf_time(f)
839 frame *f;
840 {
841 PUSH_INTVAL(f, P_time());
842 return 0;
843 }
844 # endif
845
846
847 # ifdef FUNCDEF
848 FUNCDEF("millitime", kf_millitime, pt_millitime)
849 # else
850 char pt_millitime[] = { C_STATIC, T_MIXED | (1 << REFSHIFT), 0 };
851
852 /*
853 * NAME: kfun->millitime()
854 * DESCRIPTION: return the current time in milliseconds
855 */
856 int kf_millitime(f)
857 frame *f;
858 {
859 array *a;
860 unsigned short milli;
861 xfloat flt;
862
863 i_add_ticks(f, 2);
864 a = arr_new(f->data, 2L);
865 PUT_INTVAL(&a->elts[0], P_mtime(&milli));
866 flt_itof((Int) milli, &flt);
867 flt_mult(&flt, &thousandth);
868 PUT_FLTVAL(&a->elts[1], flt);
869 PUSH_ARRVAL(f, a);
870 return 0;
871 }
872 # endif
873
874
875 # ifdef FUNCDEF
876 FUNCDEF("call_out", kf_call_out, pt_call_out)
877 # else
878 char pt_call_out[] = { C_TYPECHECKED | C_STATIC | C_KFUN_VARARGS, T_INT, 3,
879 T_STRING, T_MIXED, T_MIXED | T_ELLIPSIS };
880
881 /*
882 * NAME: kfun->call_out()
883 * DESCRIPTION: start a call_out
884 */
885 int kf_call_out(f, nargs)
886 register frame *f;
887 int nargs;
888 {
889 Int delay;
890 unsigned short mdelay;
891 xfloat flt1, flt2;
892 uindex handle;
893
894 if (f->sp[nargs - 2].type == T_INT) {
895 delay = f->sp[nargs - 2].u.number;
896 if (delay < 0) {
897 /* delay less than 0 */
898 return 2;
899 }
900 mdelay = 0xffff;
901 } else if (f->sp[nargs - 2].type == T_FLOAT) {
902 GET_FLT(&f->sp[nargs - 2], flt1);
903 if (FLT_ISNEG(flt1.high, flt1.low) || flt_cmp(&flt1, &sixty) > 0) {
904 /* delay < 0.0 or delay > 60.0 */
905 return 2;
906 }
907 flt_modf(&flt1, &flt2);
908 delay = flt_ftoi(&flt2);
909 flt_mult(&flt1, &thousand);
910 mdelay = flt_ftoi(&flt1);
911 } else {
912 return 2;
913 }
914
915 i_add_ticks(f, nargs);
916 if (OBJR(f->oindex)->count != 0 &&
917 (handle=d_new_call_out(f->data, f->sp[nargs - 1].u.string, delay,
918 mdelay, f, nargs - 2)) != 0) {
919 /* pop duration */
920 f->sp++;
921 } else {
922 /* no call_out was started: pop all arguments */
923 i_pop(f, nargs - 1);
924 handle = 0;
925 }
926 str_del(f->sp->u.string);
927 PUT_INTVAL(f->sp, handle);
928
929 return 0;
930 }
931 # endif
932
933
934 # ifdef FUNCDEF
935 FUNCDEF("remove_call_out", kf_remove_call_out, pt_remove_call_out)
936 # else
937 char pt_remove_call_out[] = { C_TYPECHECKED | C_STATIC, T_MIXED, 1, T_INT };
938
939 /*
940 * NAME: kfun->remove_call_out()
941 * DESCRIPTION: remove a call_out
942 */
943 int kf_remove_call_out(f)
944 register frame *f;
945 {
946 Int delay;
947 xfloat flt;
948
949 i_add_ticks(f, 10);
950 delay = d_del_call_out(f->data, (Uint) f->sp->u.number);
951 if (delay < -1) {
952 flt_itof(-2 - delay, &flt);
953 flt_mult(&flt, &thousandth);
954 PUT_FLTVAL(f->sp, flt);
955 } else {
956 PUT_INT(f->sp, delay);
957 }
958 return 0;
959 }
960 # endif
961
962
963 # ifdef FUNCDEF
964 FUNCDEF("swapout", kf_swapout, pt_swapout)
965 # else
966 char pt_swapout[] = { C_STATIC, T_VOID, 0 };
967
968 /*
969 * NAME: kfun->swapout()
970 * DESCRIPTION: swap out all objects
971 */
972 int kf_swapout(f)
973 frame *f;
974 {
975 swapout();
976
977 *--f->sp = nil_value;
978 return 0;
979 }
980 # endif
981
982
983 # ifdef FUNCDEF
984 FUNCDEF("dump_state", kf_dump_state, pt_dump_state)
985 # else
986 char pt_dump_state[] = { C_STATIC, T_VOID, 0 };
987
988 /*
989 * NAME: kfun->dump_state()
990 * DESCRIPTION: dump state
991 */
992 int kf_dump_state(f)
993 frame *f;
994 {
995 dump_state();
996
997 *--f->sp = nil_value;
998 return 0;
999 }
1000 # endif
1001
1002
1003 # ifdef FUNCDEF
1004 FUNCDEF("shutdown", kf_shutdown, pt_shutdown)
1005 # else
1006 char pt_shutdown[] = { C_STATIC, T_VOID, 0 };
1007
1008 /*
1009 * NAME: kfun->shutdown()
1010 * DESCRIPTION: shut down the mud
1011 */
1012 int kf_shutdown(f)
1013 frame *f;
1014 {
1015 finish();
1016
1017 *--f->sp = nil_value;
1018 return 0;
1019 }
1020 # endif
1021
1022
1023 # ifdef FUNCDEF
1024 FUNCDEF("status", kf_status, pt_status)
1025 # else
1026 char pt_status[] = { C_TYPECHECKED | C_STATIC | C_KFUN_VARARGS | C_VARARGS,
1027 T_MIXED | (1 << REFSHIFT), 1, T_OBJECT };
1028
1029 /*
1030 * NAME: kfun->status()
1031 * DESCRIPTION: return an array with status information about the gamedriver
1032 * or an object
1033 */
1034 int kf_status(f, nargs)
1035 register frame *f;
1036 int nargs;
1037 {
1038 array *a;
1039
1040 i_add_ticks(f, 100);
1041 if (nargs == 0) {
1042 a = conf_status(f);
1043 --f->sp;
1044 } else {
1045 a = conf_object(f->data, OBJR(f->sp->oindex));
1046 }
1047 PUT_ARRVAL(f->sp, a);
1048 return 0;
1049 }
1050 # endif
1051
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.