Newsgroups: comp.sources.unix From: tschudin@cui.unige.ch (Christian Tschudin) Subject: v28i053: m0 - a messenger execution environment, Part03/12 References: <1.770917478.19277@gw.home.vix.com> Sender: unix-sources-moderator@gw.home.vix.com Approved: vixie@gw.home.vix.com Submitted-By: tschudin@cui.unige.ch (Christian Tschudin) Posting-Number: Volume 28, Issue 53 Archive-Name: m0/part03 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh 'c_nit.c' <<'END_OF_FILE' X/* X c_nit.c X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#include "c_proto.h" X X X#ifdef CHANNEL_NIT X X/* sun NIT (network interface tap) device for M0 */ X X#include X#include X X#include X#include X#include X#include X#include X#include X#include X X#include X#include X#include X X#include X#include X#include X#include X#include X X Xstruct nit_data { X eindex chankey; X sint chan; X byte dest[6]; X}; X X#define MAXNITCHANNELS 2 Xstatic int nit_fd[MAXNITCHANNELS]; Xstatic ushort m0_eth_type; Xstatic byte eth_buf[1450]; X Xeindex nit_addr; Xeindex nit_name; X X X/* ------------------------------------------------------------------------ */ X X Xchar** Xget_eth_devices() X{ Xstatic char* names[] = {"le0", "le1", "le2", "ie0", "ie1", "ie2", 0}; X return names; X} X X Xint Xnit_init(char **devs, int proto) X{ X int i, j; X char **d; X X for (d = devs, i = 0; d && *d; d++, i++); X if (!i) X return -1; X X nit_addr = new_array(0, i); X nit_name = name_add("ether", 5, A_EXECUTABLE); X m0_eth_type = htons(proto); X X for (d = devs, i = 0, j = 0; d && *d && j < MAXNITCHANNELS; d++, i++) { X struct ifreq ifr; X struct packetfilt pf; X register u_short *fwp = pf.Pf_Filter; X int fd; X eindex e; X byteptr a; X X fd = open("/dev/nit", O_RDWR); X if (fd < 0) X break; X X if (ioctl(fd, I_SRDOPT, (char*)RMSGN) < 0 || X ioctl(fd, I_PUSH, "pf") < 0) X continue; X X *fwp++ = ENF_PUSHWORD + 6; X *fwp++ = ENF_PUSHLIT; X *fwp++ = m0_eth_type; X *fwp++ = ENF_EQ; X pf.Pf_FilterLen = fwp - &pf.Pf_Filter[0]; X if (ioctl(fd, NIOCSETF, (char*)&pf) < 0) X continue; X X strncpy(ifr.ifr_name, *d, sizeof(ifr.ifr_name)); X ifr.ifr_name[sizeof(ifr.ifr_name) - 1] = '\0'; X if( ioctl(fd, NIOCBIND, (char*)&ifr) || X ioctl(fd, NIOCSFLAGS, (char*)0) < 0 || X ioctl(fd, I_FLUSH, (char*)FLUSHR) < 0 || X ioctl(fd, SIOCGIFADDR, (char*)&ifr) < 0) X continue; X X nit_fd[j] = fd; X add_incoming(fd, nit_recv, nit_name, j); X X a = malloc(6); X memcpy(a, ifr.ifr_ifru.ifru_addr.sa_data, 6); X TRACE(3, printf("eth address: %02x:%02x:%02x:%02x:%02x:%02x\n", X a[0], a[1], a[2], a[3], a[4], a[5])) X e = str_import(0, a, 6, 6); X epattr(gaddr(e)) &= ~A_WRITE; X X array_put(0, nit_addr, j, e); X j++; X } X X if (!j) { X decref(0, nit_addr); X nit_addr = 0; X decref(0, nit_name); X nit_name = 0; X return -1; X } X eplen(gaddr(nit_addr)) = j; X X return 0; X} X X Xvoid Xnit_recv(int fd, eindex *m, eindex *o) X{ X#define ETHFRAMESIZE 1500 X byteptr buf = malloc(ETHFRAMESIZE); X eindex s; X int len; X X len = read(fd, buf, ETHFRAMESIZE); X if( len < 0 ) { X *m = 0; X perror("nit_getmsg"); X free(buf); X return; X } X X TRACE(3, printf("nit receive (%d bytes): ", len)) X TRACE(3, printf("%02x %02x %02x %02x %02x %02x\n", X buf[14], buf[15], buf[16], buf[17], buf[18], buf[19])) X X s = str_import(0, buf, len, ETHFRAMESIZE); X X *o = make_sub(0, s, 6); X eplen(gaddr(*o)) = 6; X *m = make_sub(0, s, 14); X eplen(gaddr(*m)) = len - 14; X X decref(0, s); X} X X Xint Xnit_send(sint chan, byteptr dest, byteptr packet, uint len) X{ X struct strbuf data, ctrl; X struct sockaddr sa; X X TRACE(3, printf("nit send (%d bytes, %02x:%02x:%02x:%02x:%02x:%02x)\n", X len, dest[0], dest[1], dest[2], dest[3], dest[4], dest[5])) X X sa.sa_family = AF_UNSPEC; X X memcpy(sa.sa_data, dest, 6); X sa.sa_data[12] = m0_eth_type>>8; X sa.sa_data[13] = m0_eth_type & 0xff; X X data.buf = (char *) packet; X data.len = len; X ctrl.buf = (char *) &sa; X ctrl.len = sizeof(sa); X X if( putmsg(nit_fd[chan], &ctrl, &data, 0) < 0 ) { X perror("nit_putmsg"); X return -1; X } X return len; X} X X Xstatic void Xnit_submit(mproc p, void *data, eindex m) X{ X struct nit_data *n = (struct nit_data*) data; X eptr mp = eaddr(p, m); X uint len = eplen(mp); X X len = len > sizeof(eth_buf) ? sizeof(eth_buf) : len; X if (epattr(mp) & (A_SUB | A_FRAG)) { X str_export(p, eth_buf, m, 0, len); X nit_send(n->chan, n->dest, eth_buf, len); X } else X nit_send(n->chan, n->dest, mp->V.str.s, len); X X dict_undef(0, channeldict, n->chankey); X free(n); X return; X} X X Xeindex Xadd_nit_channel(sint chan_no, byteptr dest) X{ X eindex key; X byte keybits[8]; X struct nit_data *n; X X random64(keybits); X key = key_add(keybits); X X n = (struct nit_data*) malloc(sizeof(struct nit_data)); X n->chankey = key; X n->chan = chan_no; X memcpy(n->dest, dest, 6); X new_channel(key, n, nit_submit); X X return key; X} X X#endif END_OF_FILE if test 5400 -ne `wc -c <'c_nit.c'`; then echo shar: \"'c_nit.c'\" unpacked with wrong size! fi # end of 'c_nit.c' fi if test -f 'c_udp.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'c_udp.c'\" else echo shar: Extracting \"'c_udp.c'\" \(5501 characters\) sed "s/^X//" >'c_udp.c' <<'END_OF_FILE' X/* X c_udp.c X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#include "c_proto.h" X X X#ifdef CHANNEL_UDP X X#include X#include X#include X X#include X#include X#include X#include X#include X#include X#include X#include X#include X#include X X#ifndef MAXHOSTNAMELEN X# define MAXHOSTNAMELEN 64 X#endif X Xstruct udp_data { X eindex chankey; X ushort chan; X uint host; X ushort port; X}; X Xeindex udp_addr; Xeindex udp_name; X X#define MAXUDPPORTS 5 Xstatic int send_socket[MAXUDPPORTS]; X X Xint Xudp_listen(uint host, int port) X{ X struct sockaddr_in host_addr; X int s; X X if ((s = socket(AF_INET, SOCK_DGRAM, 0)) < 0) X return -1; X X bzero( &host_addr, sizeof(host_addr) ); X host_addr.sin_family = AF_INET; X host_addr.sin_addr.s_addr = htonl(host ? host : INADDR_ANY); X host_addr.sin_port = htons((ushort) port); X X if (bind(s, &host_addr, sizeof(struct sockaddr)) < 0) X return -1; X X return s; X} X X Xuint* Xget_ip_addresses() X{ Xstatic uint* my_addresses; X X if (!my_addresses) { X char myname[MAXHOSTNAMELEN]; X struct hostent *hentry; X int i; X uint **ipp; X X gethostname(myname, sizeof(myname)); X hentry = gethostbyname(myname); X X for (i = 0, ipp = (uint**)(hentry->h_addr_list); X *ipp ; i++, ipp++); X X my_addresses = calloc(i+1, sizeof(uint)); X for (i = 0, ipp = (uint**)(hentry->h_addr_list); X *ipp ; i++, ipp++) X my_addresses[i] = ntohl(**ipp); X my_addresses[i] = 0; X } X return my_addresses; X} X X Xint Xudp_init(uint *ip, int port) X{ X uint *p2; X int s, i; X eindex p; X eptr pp; X X for (p2 = ip, i = 0; p2 && *p2; p2++, i++); X if (!i) X return -1; X X if (i > MAXUDPPORTS) X i = MAXUDPPORTS; X udp_addr = new_array(0, i); X udp_name = name_add((byteptr)"udpip", 5, A_EXECUTABLE); X X p = new_element(0, T_INT); X pp = gaddr(p); X pp->V.i = port; X X for (p2 = ip, i = 0; *p2 && i < MAXUDPPORTS; p2++) { X eindex a, e; X X s = udp_listen(*p2, port); X if (s > 0) { X add_incoming(s, udp_recv, udp_name, i); X send_socket[i] = s; X a = new_array(0, 2); X e = new_element(0, T_INT); X gaddr(e)->V.i = (sint) *p2; X array_put(0, a, 0, e); X array_put(0, a, 1, p); X increfp(pp); X epattr(gaddr(a)) &= ~A_WRITE; X array_put(0, udp_addr, i++, a); X } X } X X decrefp(0, p, pp); X if (!i) { X decref(0, udp_addr); X udp_addr = 0; X decref(0, udp_name); X udp_name = 0; X return -1; X } X eplen(gaddr(udp_addr)) = i; X X return 0; X} X X Xvoid Xudp_recv(int s, eindex *msgr, eindex *src) X{ X#define UDPFRAMESIZE 8092 X struct sockaddr_in from; X int len, cnt, fromlen = sizeof(from); X eindex a, h, p; X byteptr buf; X X *msgr = 0; X if (ioctl(s, FIONREAD, &len) < 0) { X perror("udp_recv, FIONREAD"); X return; X } X if (len > UDPFRAMESIZE) X len = UDPFRAMESIZE; X buf = malloc(len); X X cnt = recvfrom(s, buf, len, 0, &from, &fromlen); X if (cnt < 0) { X perror("recvfrom"); X free(buf); X return; X } X X *msgr = str_import(0, buf, cnt, len); X if (!*msgr) { X free(buf); X return; X } X h = new_element(0, T_INT); X gaddr(h)->V.i = ntohl(from.sin_addr.s_addr); X p = new_element(0, T_INT); X gaddr(p)->V.i = ntohs(from.sin_port); X a = new_array(0, 2); X array_put(0, a, 0, h); X array_put(0, a, 1, p); X *src = a; X} X X Xint udp_send(int s, uint host, int port, byteptr packet, int len) X{ Xstatic struct sockaddr_in sockaddr; X X TRACE(5, printf("udp send: %u %d (%d bytes)\n", host, port, len)) X X bzero(&sockaddr, sizeof(struct sockaddr_in)); X sockaddr.sin_family = AF_INET; X sockaddr.sin_addr.s_addr = htonl(host); X sockaddr.sin_port = htons(port); X X return sendto(s, packet, len, 0, X (struct sockaddr *)&sockaddr, sizeof (struct sockaddr)); X} X X Xchar* Xiptoa(uint i) X{ Xstatic char str[30]; X byteptr ip = (byteptr)&i; X X i = htonl(i); X sprintf(str, "%d.%d.%d.%d", ip[0], ip[1], ip[2], ip[3]); X return str; X} X X Xstatic void Xudp_submit(mproc p, void *data, eindex m) X{ X struct udp_data *d = (struct udp_data*) data; X uint len = elen(p,m); X byteptr s; X X len = len > 8000 ? 8000 : len; X s = malloc(len); X str_export(p, s, m, 0, len); X X if (udp_send(send_socket[d->chan], d->host, d->port, s, len) < 0) X perror("udp_submit"); X X dict_undef(0, channeldict, d->chankey); X free(d); X free(s); X return; X} X X Xeindex Xadd_udp_channel(sint chan, uint host, ushort port) X{ X eindex key; X byte bits[8]; X struct udp_data *d; X X random64(bits); X key = key_add(bits); X d = (struct udp_data*) malloc(sizeof(struct udp_data)); X d->chankey = key; X d->chan = chan; X d->host = host; X d->port = port; X new_channel(key, d, udp_submit); X X return key; X} X X#endif /* CHANNEL_UDP */ END_OF_FILE if test 5501 -ne `wc -c <'c_udp.c'`; then echo shar: \"'c_udp.c'\" unpacked with wrong size! fi # end of 'c_udp.c' fi if test -f 'cons_ini.m0' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'cons_ini.m0'\" else echo shar: Extracting \"'cons_ini.m0'\" \(4312 characters\) sed "s/^X//" >'cons_ini.m0' <<'END_OF_FILE' X# cons_ini.m0 X X# Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X# X# Distributed under the terms of the GNU General Public License X# version 2 of june 1991 as published by the Free Software X# Foundation, Inc. X# X# This file is part of M0. X# X# M0 is distributed in the hope that it will be useful, but WITHOUT ANY X# WARRANTY. No author or distributor accepts responsibility to anyone for X# the consequences of using it or for whether it serves any particular X# purpose or works at all, unless he says so in writing. Refer to the GNU X# General Public License for full details. X# X# Everyone is granted permission to copy, modify and redistribute M0, but X# only under the conditions described in the GNU General Public License. X# A copy of this license is supposed to have been given to you along with X# M0 so you can know your rights and responsibilities. It should be in a X# file named LICENSE. Among other things, the copyright notice and this X# notice must be preserved on all copies. X X X# console initialisation code X X X# The cons_ini.m0 file is included at run-time by m0c and m0uc X X# This console messenger installs itself as server and replies to X# requests by returning the result of their execution. X X# The server process always stays in the same (initial) queue. The X# associated key is also used to fetch the requests. X X# The data field of this server messenger contains a procedure that X# generates a key to use for sending back the reply X X X # get the longdict underneath the user dict X .)longdict(( X X # the current userdict becomes the server's dictionary: X . '_sdict . : X X # store the channel creating procedure (to send back the replies) X # inside the reply procedure. It is expected to be on the operand stack. X .'print X {.!X$}0I0_dat!: X B: X X # install an error handler X .'_inerror 0: X .'_err{ X _sdict '_inerror G X {}{ X _sdict '_inerror 1: X "*** error: " X _cts + " in " + print X ptop P stack X "Dictionary stack: " dictstack {`_cte " "++} L X _wrline X }? Z X }B: X X # define a procedure for turning an operand into a string X .'_tostrdict D ( X .'up{"--unprintable--"}B: X .'len{0I`_cte"("X+") "+X}B: X .'_err{Z}: # mainly for the _cte operator in case of circular arrays X X .'array {len {_cte}H{PPP"??circular-array??"}{}? +}B: X .'channel {P"??channel??"}B: X .'dict {len P up+}B: X .'empty {P"??empty??"}B: X .'int {_cte}B: X .'key {_cte[0 18]G}B: X .'mark {P"["}B: X .'name {_cts}B: X .'null {P""}B: X .'oper {[X_sys{2I={_ctsX}{P}?}LP]0I`0={Pup}{0G}?}B: X .'string {len _cte +}B: X .'time {_cts}B: X . ) : X .'_tostr{_tostrdict(0IY.XG!)}B: X X # define a procedure generating the prompt string X .'_prompt{1O0I0={P"M0> "}{_cte"M0<"X+"> "+}?}B: X X # other useful procedures: X .'_wrline{\0a\+print}B: X .'ptop{0I_tostr _wrline}B: X .'stack{ X "--- top"_wrline X 1O{I0IY_cts0I`7X-{P" "+}Lprint ptopP}L X "--- bottom"_wrline X }B: X X .'input{ X _myqueue E # reenter the queue and wait for a request X ,1Q # stop the queue X _,G # get the request globally via the queue's key X }B: X X .'quit{_sdict'_quit1:Z}B: X .'_quit0: X X # stop the current queue, store the key to it X ,1Q X .'_myqueue,: X X # redefine some critical operators: X # prevent popping off _sys, longdict, server dict and the user dict: X . ') {2O4>{)}{_sys')G'stack_underflow _err}?} B: X # in fact, we would need to redefine _sys and longdict too X # and remove the ) and end entry from them! X # Finally, the count and _stk operators also need some adjustments etc X X X # confirm our installation X "*** Console server process OK (use `quit' to shut down the server process)\x0a" X "*** running on host "+ _hid _tostr+ X ", platform id "+ _pid _tostr+ \0a0a\+ print X X # push an empty user dictionary on the dict stack X D( X # redefine the standard entries: X .'_loc .: X X X # the infinite loop X 1N{ X _prompt print # send the prompt X input # get a line from the user X 0Inull={P}{ # if empty then ignore X {!}H # execute the request X _sdict'_quitG{J}{}? # jump out if loop of quit was requested X {_sdict '_inerror G X {_sdict '_inerror 0:} X {"*** error: no `halted' context" _wrline}? X }{}? X }? X }L X "\x0a*** server process exits ..." _wrline X X # send an empty code field for terminating the console program: X "" print X# eof END_OF_FILE if test 4312 -ne `wc -c <'cons_ini.m0'`; then echo shar: \"'cons_ini.m0'\" unpacked with wrong size! fi # end of 'cons_ini.m0' fi if test -f 'element.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'element.h'\" else echo shar: Extracting \"'element.h'\" \(4484 characters\) sed "s/^X//" >'element.h' <<'END_OF_FILE' X/* X element.h X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#ifndef ELEMENT_H X#define ELEMENT_H X X#include "std.h" X X#define MAXLOCALS 256 X#define MAXGLOBALS 8192 /* must fit into a short */ X Xtypedef struct mproc_s *mproc; X X#ifdef __MSDOS__ X typedef struct element_s huge *eptr; X#else X typedef struct element_s *eptr; X#endif Xtypedef short eindex; /* index in element table */ Xtypedef void (*submitfct)(mproc p, void *data, eindex m); Xtypedef void (*receivefct)(int fd, eindex *msgr, eindex *orig); X X/* adjust type_names (in l_elemnt.c) if you change this sequence: */ Xenum { X T_EMPTY=0, T_NULL, T_INT, T_TIME, T_NAME, T_KEY, T_ARRAY, X T_STRING, T_DICT, T_PROC, T_MARK, T_QUEUE, T_CHANNEL, LAST_TYPE X}; X X X/* attributes: */ X#define A_READ 0x01 X#define A_WRITE 0x02 X#define A_EXEC 0x04 X#define A_EXECUTABLE 0x08 X#define A_SUB 0x10 /* sub for name/key/array/dict/string */ X#define A_FRAG 0x20 /* for strings only */ X/* X#define A_COPYONWRITE 0x40 X*/ X#define A_VISITED 0x80 X X#define A_ALL (A_READ|A_WRITE|A_EXEC) X X/* --------------------------------------------------------------------- */ X X/* type specific data structures, no more than 8 bytes */ X Xstruct array_s { X uint alen; /* number of allocated entries */ X eindex *a; X}; X X Xstruct chan_s { X void *data; X submitfct submit; X}; X Xstruct dict_s { X uint alen; /* number of allocated entries */ X eindex *d; /* array of 2*alen eindex entries */ X}; X Xstruct frag_s { X eindex f[2]; /* the two fragments */ X}; X Xstruct name_s { X eindex next; /* used for external hashing */ X union { X byteptr s; X#define SHORTNAMELEN 6 /* (2*sizeof(byteptr)-2) */ X byte n[SHORTNAMELEN]; /* short names with length <= 6 */ X } u; X}; X/* note: keys are stored as 8-byte names i.e., under V.nam.u.s */ X Xstruct proc_s { X ushort pop, push; /* number of elements cons. and prod. */ X int (*fct)(); X}; X Xstruct queue_s { X mproc head; X mproc tail; X}; X Xstruct string_s { X uint alen; /* length of allocated buffer */ X byteptr s; X}; X Xstruct sub_s { X uint offset; X eindex e; X}; X Xstruct time_s { X uint sec; /* seconds since 1970-01-01 */ X uint usec; /* micro seconds */ X}; X X X/* --------------------------------------------------------------------- */ X Xstruct element_s { /* 16 bytes: */ X byte T; /* 1 byte type */ X byte A; /* 1 byte attribute */ X ushort R; /* 2 bytes reference count */ X uint L; /* 4 bytes length */ X union { /* 8 bytes value: */ X long i; /* integer */ X struct array_s arr; X struct chan_s cha; X struct dict_s dic; X struct frag_s fra; X struct name_s nam; X struct proc_s pro; X struct queue_s que; X struct string_s str; X struct sub_s sub; X struct time_s tim; X } V; X}; X X/* --------------------------------------------------------------------- */ X X#define eptype(ep) ((ep)->T) X#define eplen(ep) ((ep)->L) X#define epattr(ep) ((ep)->A) X#define eprefcnt(ep) ((ep)->R) X X#define epis_str(ep) (eptype(ep)==T_STRING \ X || eptype(ep)==T_SUBSTR \ X || eptype(ep)==T_FRAGSTR) X X#define gaddr(ei) (global-(ei)-1) X#define eaddr(p,ei) ((ei)<0 ? gaddr(ei) : p->local+(ei)-1) X X#define etype(p,ei) eptype(eaddr(p,ei)) X#define elen(p,ei) eplen(eaddr(p,ei)) X#define eattr(p,ei) epattr(eaddr(p,ei)) X#define erefcnt(p,ei) eprefcnt(eaddr(p,ei)) X X#define is_string(p,ei) epis_string(eaddr(p,ei)) X X#define incref(p,ei) erefcnt(p,ei)++ X#define increfp(ep) eprefcnt(ep)++ X X#define decrefp(p,ei,ep) if (ei && eptype(ep)!=T_EMPTY) { \ X eprefcnt(ep)--; \ X if (eprefcnt(ep) == 0) \ X free_element(p,ei); \ X } X X/* ---------------------------------------------------------------------- */ X X#endif END_OF_FILE if test 4484 -ne `wc -c <'element.h'`; then echo shar: \"'element.h'\" unpacked with wrong size! fi # end of 'element.h' fi if test -f 'l_dict.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'l_dict.c'\" else echo shar: Extracting \"'l_dict.c'\" \(4850 characters\) sed "s/^X//" >'l_dict.c' <<'END_OF_FILE' X/* X l_dict.c X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#include X X#include "l_proto.h" X X#define DICTSIZE 512 X X/* use the index value of a key as 'hashing' into the dict array, X except for integers where we use the value itself X We use linear probing. X*/ X#define hash(k,m) (((k) + MAXGLOBALS) % m) X X X Xeindex Xnew_dict(mproc p) X{ X eindex ei = new_element(p, T_DICT); X eptr ep = eaddr(p, ei); X X if (!ei) X return 0; X ep->V.dic.alen = DICTSIZE; X ep->V.dic.d = (eindex*) calloc(2*DICTSIZE,sizeof(eindex)); X return ei; X} X X Xretcode Xdict_def(mproc p, eindex d, eindex key, eindex val) X{ X eptr epd = eaddr(p,d), epk; X uint alen = epd->V.dic.alen, h; X eindex *a, v, k; X int i, j=-1; X X if (etype(p,key)==T_NAME) X key = desub(p, key); X X if (d < 0) { X v = make_global(p, val); X k = make_global(p, key); X } else { X v = val; X incref(p, v); X k = key; X incref(p, k); X } X epk = eaddr(p,k); X X if (eptype(epk) == T_INT) X h = hash(epk->V.i, alen); X else X h = hash(k, alen); X X for (i = alen; i > 0; i--, h = (h+1)%alen) { X a = epd->V.dic.d + 2*h; X if (!*a || *a == DICT_DELETED) { X if (j < 0) X j = h; X if (*a) X continue; X else X break; X } X if (*a == k || (eptype(epk) == T_INT && X etype(p,*a) == T_INT && X epk->V.i == eaddr(p,*a)->V.i)) { X decref(p, *a); X decref(p, *(a+1)); X goto define; X } X } X if (j < 0 ) { X decref(p, v); X decref(p, k); X return ERR_DICT_FULL; X } X eplen(epd) += 1; X a = epd->V.dic.d + 2*j; Xdefine: X *a++ = k; X *a = v; X X return OK; X} X X X/* this is one of the interpreter's most often called routines */ X/* warning: one should use epd->V.dic.alen instead of DICTSIZE! */ X Xeindex Xdict_get(mproc p, eindex d, register eindex key) X{ X register ushort h, i; X register eindex *ip; X register eindex ei; X eptr epk, ep; X X if (etype(p,key) == T_NAME) X key = desub(p, key); X epk = eaddr(p,key); X X if (eptype(epk) == T_INT) X h = hash(epk->V.i, DICTSIZE); X else X h = hash(key, DICTSIZE); X X for (i = DICTSIZE, ip = eaddr(p,d)->V.dic.d + 2*h; i != 0; i--) { X ei = *ip; X if (!ei) X return 0; X if (ei == key) X return *(ip+1); X if (ei != DICT_DELETED && eptype(epk) == T_INT && X etype(p,ei) == T_INT && X epk->V.i == eaddr(p,ei)->V.i) X return *(ip+1); X h++; X if (h == DICTSIZE) { X h = 0; X ip = eaddr(p,d)->V.dic.d; X } else X ip += 2; X } X X return 0; X} X X Xretcode Xdict_undef(mproc p, eindex d, eindex key) X{ X eptr epd = eaddr(p,d), epk; X eindex *a = epd->V.dic.d; X int i; X uint alen = epd->V.dic.alen, h; X X if (etype(p,key)==T_NAME) X key = desub(p, key); X epk = eaddr(p,key); X X if (eptype(epk) == T_INT) X h = hash(epk->V.i, alen); X else X h = hash(key, alen); X X for (i = alen; i > 0; i--, h = (h+1)%alen) { X a = epd->V.dic.d + 2*h; X if (!*a) X return ERR_UNDEFINED; X if (*a == DICT_DELETED) X continue; X if ( *a == key X || (eptype(epk) == T_INT && etype(p,*a) == T_INT && X epk->V.i == eaddr(p,*a)->V.i) X ) { X decref(p,*a); X *a++ = DICT_DELETED; X decref(p,*a); X *a = 0; X eplen(epd) -= 1; X return OK; X } X } X return ERR_UNDEFINED; X} X X X/* should be called by free_element only! */ Xvoid Xdict_free(mproc p, eindex d) X{ X eptr ep = eaddr(p, d); X int i; X eindex *ea, k, v; X X TRACE(3, printf("dict_free of dict %d, %d elements\n", d, eplen(ep))) X X eptype(ep) = T_EMPTY; X for (i=ep->V.dic.alen, ea = ep->V.dic.d; i>0; i--, ea += 2) X if (*ea && *ea != DICT_DELETED) { X k = *ea; v = *(ea+1); X *ea = 0; X *(ea+1) = 0; X decref(p, k); X decref(p, v); X } X free(ep->V.dic.d); X} X X Xretcode Xdict_copy(mproc p, eindex e, eptr from, eptr to) X{ X eindex *ip; X int i; X X to->V.dic.d = (eindex*) malloc(2*DICTSIZE*sizeof(eindex)); X X if (!to->V.dic.d) X return ERR_MALLOC_FAILED; X to->V.dic.alen = DICTSIZE; X memcpy(to->V.dic.d, from->V.dic.d, 2*DICTSIZE*sizeof(eindex)); X X for (i = to->V.dic.alen, ip = to->V.dic.d; i > 0; i--, ip += 2) X if (*ip) { X incref(p, *ip); X incref(p, *ip+1); X } X X epattr(to) = A_ALL; X return OK; X} END_OF_FILE if test 4850 -ne `wc -c <'l_dict.c'`; then echo shar: \"'l_dict.c'\" unpacked with wrong size! fi # end of 'l_dict.c' fi if test -f 'l_name.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'l_name.c'\" else echo shar: Extracting \"'l_name.c'\" \(3841 characters\) sed "s/^X//" >'l_name.c' <<'END_OF_FILE' X/* X l_name.c X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#include "l_proto.h" X X X#define HASHTABSIZE 401 X Xstatic eindex hash_tab[HASHTABSIZE]; Xstatic eindex one_char_name['~' - ' ']; X Xushort hash(byteptr s, uint len) X{ X ushort h = 0; X X while (len>0) { X if (len--%2) X h ^= *s++ << 8; X else X h ^= *s++; X } X return h % HASHTABSIZE; X} X X X/* X always increments the ref count, even if the name already existed X*/ Xeindex Xname_add(byteptr s, uint len, byte attr) X{ X eindex ei; X eptr ep; X ushort h; X X if (len == 1) { X ei = one_char_name[*s - ' ' - 1]; X if (!ei) { X ei = new_element(0, T_NAME); X ep = gaddr(ei); X X eplen(ep) = 1; X epattr(ep) = attr; X ep->V.nam.u.n[0] = *s; X one_char_name[*s - ' ' - 1] = ei; X } else X increfp(gaddr(ei)); X return ei; X } X h = hash(s, len); X ei = hash_tab[h]; X while (ei) { X ep = gaddr(ei); X if (eplen(ep) == len && eptype(ep) == T_NAME) { X byteptr cp = (len<=SHORTNAMELEN) ? ep->V.nam.u.n : ep->V.nam.u.s; X if (memcmp((char*)cp,(char*)s,len) == 0) { X increfp(ep); X return ei; X } X } X ei = ep->V.nam.next; X } X ei = new_element(0, T_NAME); X ep = gaddr(ei); X eplen(ep) = len; X epattr(ep) = attr; X ep->V.nam.next = hash_tab[h]; X hash_tab[h] = ei; X if (len <= SHORTNAMELEN) X memcpy((char*)(ep->V.nam.u.n), (char*)s, len); X else { X ep->V.nam.u.s = (byteptr) malloc(len); X memcpy((char*)(ep->V.nam.u.s), (char*)s, len); X } X TRACE(4,printf("adding name %d\n", ei)) X X return ei; X} X X Xint Xname_eq(eindex n1, eindex n2) X{ X X return desub(0, n1) == desub(0, n2) ? 1 : 0; X} X X Xeindex Xkey_add(byteptr k) X{ X eindex ei; X eptr ep; X ushort h; X X h = hash(k, 8); X ei = hash_tab[h]; X while (ei) { X ep = gaddr(ei); X if (eptype(ep) == T_KEY) { X if (memcmp((char*)(ep->V.nam.u.s), (char*)k, 8) == 0) { X increfp(ep); X return ei; X } X } X ei = ep->V.nam.next; X } X ei = new_element(0, T_KEY); X ep = gaddr(ei); X eplen(ep) = 8; X ep->V.nam.next = hash_tab[h]; X hash_tab[h] = ei; X ep->V.nam.u.s = (byteptr) malloc(8); X memcpy((char*)(ep->V.nam.u.s), (char*)k, 8); X X TRACE(4, printf("adding key %d\n", ei)) X X return ei; X} X X Xint Xkey_eq(eindex k1, eindex k2) X{ X X return desub(0, k1) == desub(0, k2) ? 1 : 0; X} X X Xvoid Xfree_name(eindex ei) X{ X eptr ep = gaddr(ei); X ushort h; X X TRACE(4, printf("freeing name %d (%d)\n", ei, eplen(ep))) X X if (eplen(ep) == 1) { X one_char_name[ep->V.nam.u.n[0] - ' ' - 1] = 0; X eptype(ep) = T_EMPTY; X return; X } X X if (eplen(ep) > SHORTNAMELEN) { X h = hash(ep->V.nam.u.s, eplen(ep)); X free((char*)(ep->V.nam.u.s)); X } else X h = hash(ep->V.nam.u.n, eplen(ep)); X if (hash_tab[h] == ei) X hash_tab[h] = ep->V.nam.next; X else { X eindex e = hash_tab[h]; X while (e && gaddr(e)->V.nam.next!=ei) X e = gaddr(e)->V.nam.next; X if (!e) X fprintf(stderr, X" ## *** internal error: empty hash chain while freeing name %d (%d)\n", X ei, eplen(ep)); X else X gaddr(e)->V.nam.next = ep->V.nam.next; X } X eptype(ep) = T_EMPTY; X return; X} END_OF_FILE if test 3841 -ne `wc -c <'l_name.c'`; then echo shar: \"'l_name.c'\" unpacked with wrong size! fi # end of 'l_name.c' fi if test -f 'm0.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'m0.c'\" else echo shar: Extracting \"'m0.c'\" \(4801 characters\) sed "s/^X//" >'m0.c' <<'END_OF_FILE' X/* X m0.c X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#include X#include X X#include "l_proto.h" X#include "c_proto.h" X#include "copyrght.h" X X X#define VERSION "0.11" X Xstatic statline = 0; Xstatic void usage(FILE *f); X X Xmain(argc, argv) Xint argc; Xchar *argv[]; X{ X ushort port = UDP_SERVERPORT; X X while (argc > 1 && argv[1][0] == '-') { X argc--, argv++; X switch(argv[0][1]) { X case 'h': X usage(stdout); break; X case 's': X statline = !statline; break; X#ifdef DEBUG X case 't': X trace = atoi(argv[0]+2); break; X#endif X case 'u': X if (argc < 2) usage(stderr); X port = strtol(argv[1], NULL, 0); X argc--; argv++; break; X case 'v': X printf("The M0 platform, version %s (compiled %s at %s)\n", X VERSION, __DATE__, __TIME__); X exit(0); X default: X usage(stderr); X } X } X X printf("## Welcome to the M0 platform (v%s, compiled %s at %s)\n", X VERSION, __DATE__, __TIME__); X printf("## %s\n\n", COPYRIGHT); X X if (init(port)) { X fprintf(stderr, "M0 initialisation failed\n"); X exit(1); X } X X server_loop(); X X exit(0); X} X X/* ---------------------------------------------------------------------- */ X X Xinit(int port) X{ X char *bin, *lib; X byte h[8]; X X if ( low_level_init() != OK || operator_init() != OK) { X fprintf(stderr, "low level initialization error\n"); X exit(1); X } X X#ifdef CHANNEL_UDP X if (udp_init(get_ip_addresses(), port) != 0) X fprintf(stderr, "## Cannot find an empty UDP port\n"); X else { X int i; X printf("## Listening on UDP port 0x%04x at IP address(es)", port); X for (i = 0; i < eplen(gaddr(udp_addr)); i++) { X eindex e = array_get(0, array_get(0, udp_addr, i), 0); X printf(" %s (=%u)", iptoa(gaddr(e)->V.i), gaddr(e)->V.i); X } X printf("\n"); X } X#endif X X#ifdef CHANNEL_NIT X if (nit_init(get_eth_devices(), ETHERNET_TYPE) != 0) X fprintf(stderr, "## Cannot open ethernet device(s)\n"); X else { X int i; X printf("## Listening for 0x%04x ethernet frames on", ETHERNET_TYPE); X for (i = 0; i < eplen(gaddr(nit_addr)); i++) { X eindex e = array_get(0, nit_addr, i); X byte s[6]; X str_export(0, s, e, 0, 6); X printf(" %02x:%02x:%02x:%02x:%02x:%02x", X s[0], s[1], s[2], s[3], s[4], s[5]); X } X printf("\n"); X } X#endif X X if (channel_defs() != OK) { X fprintf(stderr, "channel level initialization error\n"); X exit(1); X } X X#ifdef SUNOS5 X setuid(getuid()); X seteuid(getuid()); X#else X# ifndef __MSDOS__ X setreuid(getuid(), getuid()); X# endif X#endif X X bin = getenv("M0BIN"); X lib = getenv("M0LIB"); X if( init_interpreter(bin?bin:DEFBINPATH, lib?lib:DEFLIBPATH) != OK) X return 1; X X signal(SIGHUP, terminate); X signal(SIGINT, terminate); X signal(SIGTERM, terminate); X X fillin_hostid(h); X printf("## This is M0 host \\%02x%02x%02x%02x%02x%02x%02x%02x\\\n", X h[0], h[1], h[2], h[3], h[4], h[5], h[6], h[7]); X X return 0; X} X X Xserver_loop() X{ X long to; X X for (;;) { X for (;;) { X if (runable()) X run(); X to = next_timeout(); X if (to == 0) X timeout(time_queue); X if (!incoming_wouldblock()) { X to = 0; X break; X } X if (to != 0 && !runable()) { X remove_refcycles(); X break; X } X } X if (statline) X statusline(); X serve_incoming(to); X } X} X X Xvoid usage(FILE *f) X{ X fprintf(f, "The M0 platform, version %s (compiled %s at %s)\n", X VERSION, __DATE__, __TIME__); X fprintf(f, "%s\n", COPYRIGHT); X fprintf(f, "usage: m0 [options]\n"); X fprintf(f, "options:\n" X "\t-help\n" X "\t-s \n" X#ifdef DEBUG X "\t-t\n" X#endif X "\t-u \n" X "\t-version\n"); X fprintf(f, "environment variables:\n" X "\tM0BIN path for finding the m0strip binary\n" X "\tM0LIB path for finding the M0 startup files\n"); X exit(f == stdout ? 0 : 1); X} X X Xstatusline() X{ X uint a, b, t; X X get_proc_stats( &a, &b, &t); X printf(" %d process(es): %d active, %d blocked, %d timeout \r", X a+b+t, a, b, t); X fflush(stdout); X} END_OF_FILE if test 4801 -ne `wc -c <'m0.c'`; then echo shar: \"'m0.c'\" unpacked with wrong size! fi # end of 'm0.c' fi if test -f 'm0c.1' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'m0c.1'\" else echo shar: Extracting \"'m0c.1'\" \(4672 characters\) sed "s/^X//" >'m0c.1' <<'END_OF_FILE' X.TH M0C 1 X.SH NAME Xm0c \- a messenger language interpreter and execution environment Xwith built-in console. X.SH SYNOPSIS X.B m0c X[ X.B -h X] [ X.B -I X] [ X.B -t X] [ X.B -v X] [ X.B file X] X.SH DESCRIPTION X.I M0c Xis an execution platform for concurrent M0 processes similar to the X.I m0 Xinterpreter. However, it has a built-in console where M0 commands can Xbe typed in interactively. X.PP XBeside the command line interface, X.I m0c Xlistens on UDP port 0x4d30 and Xfilters ethernet frames with protocol type 0x4d30 for the reception of Xmessengers (whether both interfaces are supported or not depends on the XUNIX platform on which the M0 interpreter was compiled). X.PP XLines entered by the user are inserted into a messenger which delivers Xits content to a previously installed console messenger process. XThis server process executes the given M0 commands. As a side-effect of this Xexecution it is possible that some results are returned to the user, Xthus are printed on stdout. X.PP XOptions: X.IP -h XPrint a brief usage indication to stdout. X.IP -I XTell X.I m0strip Xwhere the include files of a file to download can be found. X.IP -t XSet the tracing level (for debugging reasons). This only works if the XM0 interpreter was compiled with the -DDEBUG flag. Default is 0. A Xvalue of 1 forces a dump of all aborted messenger processes to files of Xthe form X.I abrt_*. XIf an error occurs in the initialisation (startup) phase of M0, a file X.I stup_* Xis created. Still with the option X.I -t1 Xor higher, a file X.I exit_* Xis created when the interpreter is interrupted (^C). Higher levels of Xtracing print subsequently more information, level 5 currently being Xthe highest level. X.IP -v XPrint the version to stdout. X.IP file XRead the given file and send it to the console server process after it Xhas installed itself. This allows a user to download M0 code into a Xplatform in order to interactively test it via the console. X.PP XParts of the initialisation code needed by X.I m0c Xis found in the X.I startup.m0 Xand X.I longdict.m0 Xfiles. These ASCII files are first treated with the X.I m0strip Xprogram before being read in by the M0 interpreter. As a next step, the Xfile X.I cons_ini.m0 Xis read and turned into a messenger process: it becomes the console Xserver process which executes the typed-in commands. X.PP XA file to be downloaded is also treated by the X.I m0strip Xprogram. If the file contains ``include'' statements, the X.I -I Xoption can be used to tell X.I m0strip Xin which directory these files to be included can be found. X.PP XThe console messenger offers five additional commands which are not Xpart of a standard M0 execution environment: X.IP print XSend to the console a string to display. X.IP input XWait for a line from the console and return the string (or null if Xempty). X.IP ptop XPrint (non-destructively) the top-most operand. X.IP stack XPrint (non-destructively) the content of the operand stack. X.IP quit XTerminate the console program. X.SH FILES X.IP startup.m0 XStartup code (in M0) for the M0 execution platform. X.IP longdict.m0 XStandard definitions of long command words, included by X.I startup.m0. X.IP cons_ini.m0 XM0 code for the console server process. X.IP abrt_* XDump (ASCII) of aborted messengers (only of tracing level >0). X.IP exit_* XDump (ASCII) of all messenger processes and global memory of the M0 Xplatform (only when tracing level >0 and INT signal (^C) received). X.IP stup_* XDump (ASCII) of an aborted initialisation messenger process that Xexecutes the code found in X.I startup.m0. X.IP M0.ps XPostScript document describing the messenger approach and containing a Xcomplete M0 language manual with examples. X.SH ENVIRONMENT X.IP M0BIN XOverrides the default path where auxiliary programs X.I (m0strip) Xcan be found. X.IP M0LIB XOverrides the default path where the startup files X.I (startup.m0 Xand X.I longdict.m0) Xand the console code X.I (cons_ini.m0) Xcan be found. X.SH SEE ALSO Xm0strip(1), m0(1), m0uc(1) X.SH BUGS XThe interfaces where X.I m0c Xshould listen for incoming messengers cannot Xbe specified: currently all available interfaces (IP and ethernet) are Xtried and served. The UDP port cannot be set too, leading thus to Xcollisions on the port number with other M0 platforms or console Xprograms. X.PP XThe interception of messengers which are encapsulated in ethernet frames Xrequires this program to be installed with root as owner and with the XSETUID bit set (due to the access protections of the ethernet devices). XInsufficient privileges to open the ethernet device simply deactivates Xin X.I m0c Xthe ethernet interface. X.PP XOnly one file can be donwloaded. X.SH AUTHOR XChristian F. Tschudin, , May 1994 END_OF_FILE if test 4672 -ne `wc -c <'m0c.1'`; then echo shar: \"'m0c.1'\" unpacked with wrong size! fi # end of 'm0c.1' fi if test -f 'o_misc.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'o_misc.c'\" else echo shar: Extracting \"'o_misc.c'\" \(4022 characters\) sed "s/^X//" >'o_misc.c' <<'END_OF_FILE' X/* X o_misc.c X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#include X X X#include "l_proto.h" X#include "o_proto.h" X X Xretcode Xo_get() X{ X eindex r; X X load_2_args(e, i, ep, ip); X X if (!(epattr(ep) & A_READ)) X return ERR_ACCESS_CHECK; X if (eptype(ep) == T_DICT) { X r = dict_get(current, e, i); X if (!r) X return ERR_UNDEFINED; X incref(current,r); X } else if (eptype(ep) == T_ARRAY || eptype(ep) == T_STRING) { X if (eptype(ip) == T_INT) { X if (ip->V.i < 0 || ip->V.i >= eplen(ep)) X return ERR_RANGE_CHECK; X X if (eptype(ep) == T_STRING) { X r = new_element(current, T_INT); X eaddr(current,r)->V.i = str_get(current, e, ip->V.i); X } else { X r = array_get(current, e, ip->V.i); X incref(current,r); X } X } else if (eptype(ip) == T_ARRAY && eplen(ip) == 2) { X eindex offs, len; X sint o, l; X X offs = array_get(current, i, 0); X len = array_get(current, i, 1); X if (etype(current,offs) != T_INT || X etype(current,len) != T_INT) X return ERR_TYPE_CHECK; X o = eaddr(current,offs)->V.i; X l = eaddr(current,len)->V.i; X if (o < 0 || l < 0 || (o+l) > eplen(ep)) X return ERR_RANGE_CHECK; X r = make_sub(current, e, o); X elen(current,r) = l; X } else X return ERR_TYPE_CHECK; X } else X return ERR_TYPE_CHECK; X decrefp(current,e, ep); X decrefp(current,i, ip); X return_ok_result(2, r); X} X X Xretcode Xo_gmt() X{ X if (current->osp >= MAXOSTACK) X return ERR_OSTACK_OVERFLOW; X current->os[current->osp++] = time_now(current); X return OK; X} X X X Xretcode Xo_hostid() X{ X if (current->osp >= MAXOSTACK) X return ERR_OSTACK_OVERFLOW; X current->os[current->osp++] = host_id; X incref(current, host_id); X X return OK; X} X X Xretcode Xo_length() X{ X uint len; X X load_1_arg(ei, ep); X X if (eptype(ep) != T_ARRAY && eptype(ep) != T_STRING && X eptype(ep) != T_DICT) X return ERR_TYPE_CHECK; X if (!(epattr(ep) & A_READ)) X return ERR_ACCESS_CHECK; X len = eplen(ep); X decrefp(current, ei, ep); X ei = new_element(current, T_INT); X ep = eaddr(current, ei); X ep->V.i = len; X current->os[current->osp-1] = ei; X X return OK; X} X X Xretcode Xo_put() X{ X load_3_args(e, i, v, ep, ip, vp); X X if (!(epattr(ep) & A_WRITE)) X return ERR_ACCESS_CHECK; X if (eptype(ep) == T_DICT) { X retcode rc = dict_def(current, e, i, v); X if (rc != OK) X return rc; X decrefp(current,v, vp); X } else { X if (eptype(ip) != T_INT) X return ERR_TYPE_CHECK; X if (ip->V.i < 0 || ip->V.i >= eplen(ep)) X return ERR_RANGE_CHECK; X X switch (eptype(ep)) { X case T_STRING: X if (eptype(vp) != T_INT) X return ERR_TYPE_CHECK; X if (vp->V.i < 0 || vp->V.i > 255) X return ERR_RANGE_CHECK; X str_put(current, e, ip->V.i, vp->V.i); X decrefp(current,v,vp); X break; X case T_ARRAY: X /* we should check for circular constructs! */ X array_put(current, e, ip->V.i, v); X break; X default: X return ERR_TYPE_CHECK; X } X } X decrefp(current, i, ip); X decrefp(current, e, ep); X current->osp -= 3; X X return OK; X} X X Xretcode Xo_random() X{ X byte k[8]; X X if (current->osp >= MAXOSTACK) X return ERR_OSTACK_OVERFLOW; X X random64(k); X current->os[current->osp++] = key_add(k); X X return OK; X} END_OF_FILE if test 4022 -ne `wc -c <'o_misc.c'`; then echo shar: \"'o_misc.c'\" unpacked with wrong size! fi # end of 'o_misc.c' fi if test -f 'o_proto.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'o_proto.h'\" else echo shar: Extracting \"'o_proto.h'\" \(4486 characters\) sed "s/^X//" >'o_proto.h' <<'END_OF_FILE' X/* X o_proto.h X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#ifndef O_PROTO_H X#define O_PROTO_H X X#include "error.h" X X/* o_arith.c */ Xextern retcode o_add(); Xextern retcode o_and(); Xextern retcode o_not(); Xextern retcode o_div(); Xextern retcode o_eq(); Xextern retcode o_gt(); Xextern retcode o_lt(); Xextern retcode o_mod(); Xextern retcode o_mul(); Xextern retcode o_neg(); Xextern retcode o_or(); Xextern retcode o_sub(); Xextern retcode o_xor(); X X/* o_array.c */ Xextern retcode o_array(); Xextern retcode o_bind(); Xextern retcode o_makearray(); Xextern retcode o_mark(); X X/* o_attr.c */ Xextern retcode o_getattr(); Xextern retcode o_setattr(); X X/* o_chan.c */ Xextern retcode channel_defs(); X X/* o_ctrl.c */ Xextern retcode o_exec(); Xextern retcode o_exit(); Xextern retcode o_halt(); Xextern retcode o_halted(); Xextern retcode the_halted_proc(); Xextern retcode o_ifelse(); Xextern retcode o_loop(); Xextern retcode the_loop_iproc(); Xextern retcode the_loop_aproc(); Xextern retcode the_loop_dproc(); Xextern retcode the_loop_sproc(); X X/* o_dict.c */ Xextern retcode o_begin(); Xextern retcode o_currentdict(); Xextern retcode o_dict(); Xextern retcode o_end(); Xextern retcode o_find(); Xextern retcode o_known(); Xextern retcode o_undef(); Xextern retcode dict_find(mproc p, eindex key, eindex *dict); Xextern retcode dict_load(mproc p, eindex key, eindex *val); X X/* o_misc.c */ Xextern retcode o_get(); Xextern retcode o_gmt(); Xextern retcode o_hostid(); Xextern retcode o_length(); Xextern retcode o_put(); Xextern retcode o_random(); X X/* o_msgr.c */ Xextern retcode o_currentqueue(); Xextern retcode o_enter(); Xextern retcode o_leave(); Xextern retcode o_qstate(); Xextern retcode o_submit(); X X/* o_stack.c */ Xextern retcode o_copy(); Xextern retcode o_count(); Xextern retcode o_exch(); Xextern retcode o_pop(); Xextern retcode o_index(); Xextern retcode o_roll(); Xextern retcode o_stack(); X X X/* o_string.c */ Xextern retcode o_string(); X X/* o_type.c */ Xextern retcode o_type(); Xextern retcode o_toarray(); Xextern retcode o_toexecutable(); Xextern retcode o_toextern(); Xextern retcode o_tokey(); Xextern retcode o_toint(); Xextern retcode o_toliteral(); Xextern retcode o_tomsgr(); Xextern retcode o_toname(); Xextern retcode o_tostring(); Xextern retcode o_totime(); X X X/* o_init.c */ Xextern eindex loop_mark; /* used by exit on the exec stack */ Xextern eindex loop_iproc; /* loop procedure for int arg */ Xextern eindex loop_aproc; /* loop procedure for array arg */ Xextern eindex loop_dproc; /* loop procedure for dict arg */ Xextern eindex loop_sproc; /* loop procedure for string arg */ Xextern eindex halt_mark; /* used by halt on the exec stack */ Xextern eindex halted_proc; /* halted procedure */ Xextern retcode operator_init(); X X#define check_o_stack(n) \ X if (current->osp < (n)) return ERR_STACK_UNDERFLOW X X#define load_1_arg(a1, p1) \ X eindex a1; eptr p1; \ X check_o_stack(1); \ X a1 = current->os[current->osp-1]; p1 = eaddr(current, a1) X X#define load_2_args(a1, a2, p1, p2) \ X eindex a1, a2; \ X eptr p1, p2; \ X check_o_stack(2); \ X a1 = current->os[current->osp-2]; p1 = eaddr(current, a1); \ X a2 = current->os[current->osp-1]; p2 = eaddr(current, a2) X X#define load_3_args(a1, a2, a3, p1, p2, p3) \ X eindex a1, a2, a3; \ X eptr p1, p2, p3; \ X check_o_stack(3); \ X a1 = current->os[current->osp-3]; p1 = eaddr(current, a1); \ X a2 = current->os[current->osp-2]; p2 = eaddr(current, a2); \ X a3 = current->os[current->osp-1]; p3 = eaddr(current, a3) X X#define return_ok_result(popcnt, res) \ X current->osp -= popcnt-1; \ X current->os[current->osp-1] = res; \ X return OK X X#endif END_OF_FILE if test 4486 -ne `wc -c <'o_proto.h'`; then echo shar: \"'o_proto.h'\" unpacked with wrong size! fi # end of 'o_proto.h' fi if test -f 'o_stack.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'o_stack.c'\" else echo shar: Extracting \"'o_stack.c'\" \(4002 characters\) sed "s/^X//" >'o_stack.c' <<'END_OF_FILE' X/* X o_stack.c X*/ X/* Copyright (c) 1994 Christian F. Tschudin. All rights reserved. X X Distributed under the terms of the GNU General Public License X version 2 of june 1991 as published by the Free Software X Foundation, Inc. X X This file is part of M0. X XM0 is distributed in the hope that it will be useful, but WITHOUT ANY XWARRANTY. No author or distributor accepts responsibility to anyone for Xthe consequences of using it or for whether it serves any particular Xpurpose or works at all, unless he says so in writing. Refer to the GNU XGeneral Public License for full details. X XEveryone is granted permission to copy, modify and redistribute M0, but Xonly under the conditions described in the GNU General Public License. XA copy of this license is supposed to have been given to you along with XM0 so you can know your rights and responsibilities. It should be in a Xfile named LICENSE. Among other things, the copyright notice and this Xnotice must be preserved on all copies. */ X X#include "l_proto.h" X#include "o_proto.h" X X Xretcode Xo_copy() X{ X load_1_arg(ei, ep); X X if ((eptype(ep) == T_STRING || eptype(ep) == T_ARRAY || X eptype(ep) == T_DICT) && !(epattr(ep) & A_READ)) X return ERR_ACCESS_CHECK; X X current->os[current->osp-1] = element_copy(current, ei); X decrefp(current, ei, ep); X X return OK; X} X X Xretcode Xo_count() X{ X eindex *ip; X ushort i; X X load_1_arg(ei, ep); X X if (eptype(ep) != T_INT) X return ERR_TYPE_CHECK; X switch (ep->V.i) { X case 0: X for (i=current->osp, ip=current->os+i-1; i > 0; i--, ip--) X if (*ip == mark) X break; X i = current->osp - i - 1; X break; X case 1: i = current->osp-1; break; X case 2: i = current->dsp; break; X case 3: i = current->esp; break; X default: X return ERR_RANGE_CHECK; X } X decrefp(current, ei, ep); X ei = current->os[current->osp-1] = new_element(current, T_INT); X eaddr(current,ei)->V.i = i; X return OK; X} X X Xretcode Xo_exch() X{ X eindex ei, *ip; X X if (current->osp < 2) X return ERR_STACK_UNDERFLOW; X ip = current->os + current->osp - 1; X ei = *ip; X *ip = *(ip-1); X *(ip-1) = ei; X return OK; X} X X Xretcode Xo_pop() X{ X if (current->osp < 1) X return ERR_STACK_UNDERFLOW; X decref(current, current->os[current->osp-1]); X current->osp -= 1; X return OK; X} X X Xretcode Xo_index() X{ X eindex ei, i; X eptr ep; X X if (current->osp < 2) X return ERR_STACK_UNDERFLOW; X ei = current->os[current->osp-1]; X ep = eaddr(current, ei); X if (eptype(ep) != T_INT) X return ERR_TYPE_CHECK; X if (ep->V.i < 0) X return ERR_RANGE_CHECK; X if (current->osp < 2 + ep->V.i) X return ERR_STACK_UNDERFLOW; X i = current->os[current->osp - 2 - ep->V.i]; X decrefp(current, ei, ep); X current->os[current->osp-1] = i; X incref(current, i); X X return OK; X} X X Xretcode Xo_roll() X{ X sshort d, m; X X load_2_args(e1, e2, ep1, ep2); X X if (eptype(ep1) != T_INT || eptype(ep2) != T_INT) X return ERR_TYPE_CHECK; X m = ep1->V.i; X if (m < 1) X return ERR_RANGE_CHECK; X if (current->osp < 2 + m) X return ERR_STACK_UNDERFLOW; X X d = (m - ep2->V.i) % m; X if (d < 0) X d += m; X X if (d != 0) { X eindex *s = current->os + current->osp - 2 - m; X ushort n, root; X X for (root=0, n=m; n > 0; root++) { X ushort i, j; X eindex ei; X X n--; X for (i=root, ei=s[root], j=(i+d)%m; j != root; X n--, i=j, j=(i+d)%m) X s[i] = s[j]; X s[i] = ei; X } X } X decrefp(current, e1, ep1); X decrefp(current, e2, ep2); X current->osp -= 2; X X return OK; X} X X Xretcode Xo_stack() X{ X eindex r, *ip; X eptr rp; X uint i; X X load_1_arg(ei, ep); X X if (eptype(ep) != T_INT) X return ERR_TYPE_CHECK; X switch (ep->V.i) { X case 1: X r = make_array(current, current->os, current->osp); X break; X case 2: X r = make_array(current, current->ds, current->dsp); X break; X case 3: X r = make_array(current, current->es, current->esp); X break; X default: X return ERR_RANGE_CHECK; X } X rp = eaddr(current, r); X for (i = eplen(rp), ip = rp->V.arr.a; i > 0; i--, ip++) X incref(current, *ip); X epattr(rp) &= ~A_WRITE; X decrefp(current, ei, ep); X current->os[current->osp-1] = r; X X return OK; X} END_OF_FILE if test 4002 -ne `wc -c <'o_stack.c'`; then echo shar: \"'o_stack.c'\" unpacked with wrong size! fi # end of 'o_stack.c' fi echo shar: End of archive 3 \(of 12\). cp /dev/null ark3isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 12 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0