* Copyright (c) 1980 Regents of the University of California.
* All rights reserved. The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
static char sccsid
[] = "@(#)func.c 5.1 (Berkeley) 6/5/85";
* Funccod generates code for
* built in function calls and calls
* call to generate calls to user
* defined functions and procedures.
register struct tnode
*al
;
struct tnode
*argv
, tr
, tr2
;
* Verify that the given name
* is defined and the name of
p
= lookup(r
->pcall_node
.proc_id
);
rvlist(r
->pcall_node
.arg
);
if (p
->class != FUNC
&& p
->class != FFUNC
) {
error("%s is not a function", p
->symbol
);
rvlist(r
->pcall_node
.arg
);
argv
= r
->pcall_node
.arg
;
* Call handles user defined
* procedures and functions
return (call(p
, argv
, FUNC
, bn
));
for (al
= argv
; al
!= TR_NIL
; al
= al
->list_node
.next
)
* Built-in functions have
* their interpreter opcode
op
= p
->value
[0] &~ NSTAND
;
if (opt('s') && (p
->value
[0] & NSTAND
)) {
error("%s is a nonstandard function", p
->symbol
);
* Parameterless functions
error("%s takes no arguments", p
->symbol
);
tr
.list_node
.list
= (&tr2
);
tr2
.var_node
.cptr
= input
->symbol
;
tr2
.var_node
.line_no
= NIL
;
tr2
.var_node
.qual
= TR_NIL
;
error("%s takes either zero or one argument", p
->symbol
);
* All other functions take
error("%s takes exactly one argument", p
->symbol
);
if (op
== O_EOF
|| op
== O_EOLN
)
p1
= stklval(argv
->list_node
.list
, NIL
);
p1
= stkrval(argv
->list_node
.list
, NLNIL
, (long) RREQ
);
error("%s is an unimplemented 6000-3.4 extension", p
->symbol
);
convert( nl
+T4INT
, nl
+TDOUBLE
);
else if (isnta(p1
, "d")) {
error("%s's argument must be integer or real, not %s", p
->symbol
, nameof(p1
));
error("seed's argument must be an integer, not %s", nameof(p1
));
error("%s's argument must be a real, not %s", p
->symbol
, nameof(p1
));
(void) put(1, op
+ O_ABS8
-O_ABS2
);
(void) put(1, op
+ (width(p1
) >> 2));
error("%s's argument must be an integer or real, not %s", p
->symbol
, nameof(p1
));
if (classify(p1
) == TPTR
) {
error("ord's argument must be of scalar type, not %s",
error("%s is forbidden for reals", p
->symbol
);
if ( isnta( p1
, "bcsi" ) ) {
error("%s's argument must be of scalar type, not %s", p
->symbol
, nameof(p1
));
tempnlp
= p1
-> class == TYPE
? p1
-> type
: p1
;
op
+= O_PRED24
- O_PRED2
;
(void) put(3, op
, (int)tempnlp
->range
[0],
(void) put(3, op
, tempnlp
->range
[0],
(void) put(3, op
, (int)tempnlp
->range
[0],
error("odd's argument must be an integer, not %s", nameof(p1
));
(void) put(1, op
+ (width(p1
) >> 2));
error("chr's argument must be an integer, not %s", nameof(p1
));
(void) put(1, op
+ (width(p1
) >> 2));
error("Argument to card must be a set, not %s", nameof(p1
));
(void) put(2, O_CARD
, width(p1
));
error("Argument to eoln must be a text file, not %s", nameof(p1
));
if (p1
->class != FILET
) {
error("Argument to eof must be file, not %s", nameof(p1
));