diff options
Diffstat (limited to 'mdk-stage1')
141 files changed, 1018 insertions, 56070 deletions
diff --git a/mdk-stage1/.gitignore b/mdk-stage1/.gitignore new file mode 100644 index 000000000..fe2469cea --- /dev/null +++ b/mdk-stage1/.gitignore @@ -0,0 +1,13 @@ +*.o +dhcp-client +init +probe-modules +rescue-gui +stage1 +pci-resource/pci-ids.h +usb-resource/usb-ids.h +pcmcia-resource/pcmcia-ids.h +pcmcia/lex_config.c +pcmcia/libpcmcia.a +pcmcia/yacc_config.c +pcmcia/yacc_config.h diff --git a/mdk-stage1/Makefile b/mdk-stage1/Makefile index 05f779195..1d66d22fe 100644 --- a/mdk-stage1/Makefile +++ b/mdk-stage1/Makefile @@ -2,8 +2,6 @@ # # mdk-stage1 - the program that will load second-stage install # - # $Id: Makefile 271082 2010-10-13 18:55:00Z tv $ - # # Pixel (pixel) (mostly done by Guillaume Cottenceau) # # Copyright 2000-2004 Mandriva @@ -15,33 +13,12 @@ # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -VERSION=1.63 +VERSION=2.62 PRODUCT=drakx-installer-binaries # # Portions from Erik Troan (ewt@redhat.com) Copyright 1996 Red Hat Software # - #***************************************************************************** - # - # Currently: - # - # ix86 - # init with dietlibc - # stage1 with dietlibc - # - # ppc - # init with dietlibc - # stage1 with glibc - # - # ia64 - # init with glibc - # stage1 with glibc - # - # x86-64 - # init with dietlibc - # stage1 with dietlibc - # - #***************************************************************************** top_dir = . @@ -50,57 +27,40 @@ include $(top_dir)/Makefile.common include $(top_dir)/../Makefile.config ARCHDIR=$(ARCH) ifeq (i386, $(ARCH)) -ARCHDIR=i586 +ARCHDIR=i686 endif DEFS = -DDISTRIB_NAME=\"$(DISTRIB_NAME)\" -DDISTRIB_VERSION=\"$(DISTRIB_VERSION)\" -DDISTRIB_TYPE=\"$(DISTRIB_TYPE)\" -DDISTRIB_DESCR=\"$(DISTRIB_DESCR)\" $(ADDITIONAL_DEFS) -D_FILE_OFFSET_BITS=64 -DARCH=\"$(ARCHDIR)\" -DCONFIG_USE_ZLIB -COMPILE = $(CC) $(DEFS) $(CFLAGS) +COMPILE = $(CC) $(DEFS) $(CFLAGS) -Wno-error=format-truncation -INIT_DEFS = INITSRC = init.c -ifneq (DIETLIBC, $(L)) -INIT_DEFS += $(GLIBC_INCLUDES) -endif -INITOBJS = $(subst .c,.o,$(INITSRC)) +STAGE1_DEFS=-DDISABLE_KA + +INITOBJS = $(INITSRC:.c=.o) #- frontends NEWT_FRONTEND_SRC = newt-frontend.c -NEWT_FRONTEND_LIBS = newt/libnewt.a slang/libslang.a +NEWT_FRONTEND_LIBS = -lnewt -lslang STDIO_FRONTEND_SRC = stdio-frontend.c STDIO_FRONTEND_LIBS = -STDIO_FRONTEND_LIBS = - -FRONTEND_OBJS = $(subst .c,.o,$($(F)_FRONTEND_SRC)) +FRONTEND_OBJS = $($(F)_FRONTEND_SRC:.c=.o) FRONTEND_LINK = $(FRONTEND_OBJS) $($(F)_FRONTEND_LIBS) -STAGE1_STATIC_LIBS = -STAGE1_STATIC_USR_LIBS = libz.a libldetect.a libkmod.a libpci.a liblzma.a -STAGE1_OWN_LIBS = -ifeq (DIETLIBC, $(L)) -STAGE1_OWN_LIBS = $(patsubst %,/usr/lib/dietlibc/lib-$(ARCH)/%,$(STAGE1_STATIC_USR_LIBS) $(STAGE1_STATIC_LIBS)) -else -STAGE1_OWN_LIBS = $(patsubst %,/usr/$(LIB)/%,$(STAGE1_STATIC_USR_LIBS)) $(patsubst %,/$(LIB)/%,$(STAGE1_STATIC_LIBS)) -endif +STAGE1_OWN_LIBS = -lz -lldetect -lkmod -lpci -llzma -lsysfs -ifeq (DIETLIBC, $(L)) -STAGE1_NETWORK_LIBS = /usr/lib/dietlibc/lib-$(ARCH)/librpc.a -else -STAGE1_NETWORK_LIBS = /usr/$(LIB)/libresolv.a -endif - #- stage1 itself STAGE1SRC = stage1.c log.c utils.c params.c tools.c modules.c probing.c mount.c automatic.c frontend-common.c lomount.c thirdparty.c zlibsupport.c CDROMSRC = cdrom.c DISKSRC = disk.c directory.c partition.c -NETWORKSRC = network.c nfsmount.c dhcp.c url.c dns.c adsl.c directory.c wireless.c -KASRC = ka.c +NETWORKSRC = network.c dhcp.c url.c dns.c adsl.c directory.c wireless.c +#KASRC = ka.c # use sort to remove duplicates STAGE1_ALLSRC = $(sort $(STAGE1SRC) $(CDROMSRC) $(DISKSRC) $(NETWORKSRC) $(KASRC)) @@ -121,77 +81,63 @@ STAGE1OBJS-NETWORK-STANDALONE = $(subst .c,-NETWORK-STANDALONE.o,$(STAGE1SRC) $( NETWORK_STANDALONE_DEFS = -DDISABLE_CDROM -DDISABLE_DISK -DENABLE_NETWORK_STANDALONE -DDISABLE_KA -STAGE1OBJS-FULL = $(subst .c,-FULL.o,$(STAGE1_ALLSRC)) +STAGE1OBJS-FULL = $(STAGE1_ALLSRC:.c=-FULL.o) BINS = init stage1 dhcp-client rescue-gui probe-modules -DIRS += pci-resource usb-resource slang newt -ifeq (i386, $(ARCH)) -DIRS += pcmcia pcmcia-resource sysfs -endif -ifeq (x86_64, $(ARCH)) -DIRS += pcmcia pcmcia-resource sysfs -endif -ifeq (mips, $(ARCH)) -DIRS += sysfs -endif -ifeq (arm, $(ARCH)) -DIRS += sysfs -endif - - -ifeq (i386,$(ARCH)) -PCMCIA_LIB = pcmcia/libpcmcia.a sysfs/libsysfs.a -PCMCIA_DEFS = -DENABLE_PCMCIA -endif -ifeq (x86_64,$(ARCH)) -PCMCIA_LIB = pcmcia/libpcmcia.a sysfs/libsysfs.a +OTHERS = pci-ids.h usb-ids.h +ifneq (,$(filter $(ARCH),i386 x86_64)) +OTHERS += pcmcia-ids.h pcmcia +PCMCIA_LIB = pcmcia/libpcmcia.a PCMCIA_DEFS = -DENABLE_PCMCIA endif -ifeq (mips,$(ARCH)) -PCMCIA_LIB = sysfs/libsysfs.a -endif -ifeq (arm,$(ARCH)) -PCMCIA_LIB = sysfs/libsysfs.a -endif USB_DEFS_GEN = -DENABLE_USB USB_DEFS = -DENABLE_USB -DDISABLE_PCIADAPTERS -all: dirs $(BINS) +all: $(OTHERS) $(BINS) -dirs: - @for n in . $(DIRS); do \ - [ "$$n" = "." ] || make -C $$n || exit 1 ;\ - done +pci-ids.h: /usr/share/ldetect-lst/pcitable.gz update-pci-ids.pl + perl update-pci-ids.pl > $@ || { rm -f $@; exit 1; } + +usb-ids.h: /usr/share/ldetect-lst/usbtable.gz update-usb-ids.pl + perl update-usb-ids.pl > $@ || rm -f $@ + +pcmcia-ids.h: update-pcmcia-ids.pl + perl update-pcmcia-ids.pl > $@ || { rm -f $@; exit 1; } + +pcmcia/libpcmcia.a: + make -j -C pcmcia + +probing.c: pci-ids.h -init: $(INITOBJS) $(STAGE1_LIBC) - $(DIET) $(CC) $(LDFLAGS) -o $@ $^ +init: $(INITOBJS) + $(CC) $(LDFLAGS) -o $@ $^ $(STRIPCMD) $@ -stage1: $(STAGE1OBJS-FULL) $(STAGE1_OWN_LIBS) $(STAGE1_NETWORK_LIBS) $(FRONTEND_LINK) bootsplash.o $(PCMCIA_LIB) $(STAGE1_LIBC) - $(DIET) $(CC) $(LDFLAGS) -o $@ $^ +stage1: $(STAGE1OBJS-FULL) $(STAGE1_OWN_LIBS) $(FRONTEND_LINK) $(PCMCIA_LIB) + $(CC) $(LDFLAGS) -o $@ $^ $(STRIPCMD) $@ -dhcp-client: $(STAGE1OBJS-NETWORK-STANDALONE) $(STAGE1_OWN_LIBS) $(STAGE1_NETWORK_LIBS) $(FRONTEND_LINK) $(STAGE1_LIBC) - $(DIET) $(CC) $(LDFLAGS) -o $@ $^ +dhcp-client: $(STAGE1OBJS-NETWORK-STANDALONE) $(STAGE1_OWN_LIBS) $(FRONTEND_LINK) + $(CC) $(LDFLAGS) -o $@ $^ $(STRIPCMD) $@ $(INITOBJS): %.o: %.c - $(COMPILE) $(INIT_DEFS) -c $< + $(COMPILE) -c $< $(STAGE1OBJS-NETWORK): %-NETWORK.o: %.c - $(DIET) $(COMPILE) $(INCLUDES) $(NETWORK_DEFS) $(PCMCIA_DEFS) $(USB_DEFS_GEN) -DENABLE_ADDITIONAL_MODULES -c $< -o $@ + $(COMPILE) $(INCLUDES) $(NETWORK_DEFS) $(PCMCIA_DEFS) $(USB_DEFS_GEN) -DENABLE_ADDITIONAL_MODULES -c $< -o $@ $(STAGE1OBJS-NETWORK-STANDALONE): %-NETWORK-STANDALONE.o: %.c - $(DIET) $(COMPILE) $(INCLUDES) $(NETWORK_STANDALONE_DEFS) $(USB_DEFS_GEN) -c $< -o $@ + $(COMPILE) $(INCLUDES) $(NETWORK_STANDALONE_DEFS) $(USB_DEFS_GEN) -c $< -o $@ $(STAGE1OBJS-FULL): %-FULL.o: %.c - $(DIET) $(COMPILE) $(INCLUDES) -DSPAWN_SHELL $(USB_DEFS_GEN) $(PCMCIA_DEFS) -DENABLE_BOOTSPLASH -c $< -o $@ + $(COMPILE) $(INCLUDES) -DSPAWN_SHELL $(USB_DEFS_GEN) $(PCMCIA_DEFS) $(STAGE1_DEFS) -c $< -o $@ .c.o: - $(DIET) $(COMPILE) $(INCLUDES) -DENABLE_BOOTSPLASH -c $< + $(COMPILE) $(INCLUDES) -c $< clean: localclean @@ -200,40 +146,22 @@ clean: localclean done localclean: - rm -f *.o .depend *.rdz *.img $(BINS) + rm -f *.o .depend *.rdz *.img pci-ids.h pcmcia-ids.h usb-ids.h $(BINS) -rescue-gui: rescue-gui.o frontend-common.o params.o utils.o log.o automatic.o $(FRONTEND_LINK) $(STAGE1_LIBC) - $(DIET) $(CC) $(LDFLAGS) -o $@ $^ +rescue-gui: rescue-gui.o frontend-common.o params.o utils.o log.o automatic.o $(FRONTEND_LINK) + $(CC) $(LDFLAGS) -o $@ $^ $(STRIPCMD) $@ -probe-modules: probe-modules.o probing-FULL.o modules-FULL.o params-FULL.o utils-FULL.o log-FULL.o automatic-FULL.o frontend-common-FULL.o stdio-frontend.o zlibsupport-FULL.o $(STAGE1_OWN_LIBS) $(PCMCIA_LIB) $(STAGE1_LIBC) - $(DIET) $(CC) $(LDFLAGS) -o $@ $^ +probe-modules: probe-modules.o probing-FULL.o modules-FULL.o params-FULL.o utils-FULL.o log-FULL.o automatic-FULL.o frontend-common-FULL.o stdio-frontend.o zlibsupport-FULL.o $(STAGE1_OWN_LIBS) $(PCMCIA_LIB) + $(CC) $(LDFLAGS) -o $@ $^ $(STRIPCMD) $@ dist: tar tar: rm -rf $(PRODUCT)*.tar* $(PRODUCT)-$(VERSION) - @if [ -e "../.svn" ]; then \ - $(MAKE) dist-svn; \ - elif [ -e "../.git" ]; then \ - $(MAKE) dist-git; \ - else \ - echo "Unknown SCM (not SVN nor GIT)";\ - exit 1; \ - fi; - $(info $(NAME)-$(VERSION).tar.xz is ready) - -dist-svn: - mkdir -p $(PRODUCT)-$(VERSION) - svn export -q -rBASE . $(PRODUCT)-$(VERSION)/mdk-stage1 - svn export -q -rBASE ../kernel $(PRODUCT)-$(VERSION)/kernel - cp ../Makefile.config $(PRODUCT)-$(VERSION)/ - tar cfa $(PRODUCT)-$(VERSION).tar.xz $(PRODUCT)-$(VERSION) - rm -rf $(PRODUCT)-$(VERSION) - -dist-git: @cd ..; git archive --prefix=$(PRODUCT)-$(VERSION)/ HEAD mdk-stage1 kernel Makefile.config | xz >mdk-stage1/$(PRODUCT)-$(VERSION).tar.xz; + $(info $(PRODUCT)-$(VERSION).tar.xz is ready) .depend: $(CPP) $(CFLAGS) -M $(ALLSRC) > .depend diff --git a/mdk-stage1/Makefile.common b/mdk-stage1/Makefile.common index 34c010905..f2c70273a 100644 --- a/mdk-stage1/Makefile.common +++ b/mdk-stage1/Makefile.common @@ -15,8 +15,7 @@ #***************************************************************************** ARCH := $(patsubst i%86,i386,$(shell uname -m)) -ARCH := $(patsubst sparc%,sparc,$(ARCH)) -ARCH := $(patsubst arm%,arm,$(ARCH)) +ARCH := $(ARCH:arm%=arm) # DEBUG = 1 @@ -27,22 +26,6 @@ else F = NEWT endif -# diet libc syscalls are broken on mips -ifneq (mips, $(ARCH)) -# diet libc eabi support is mostly broken -ifneq (arm, $(ARCH)) -DIET = $(shell test -x /usr/bin/diet && echo diet) -endif -endif - - -ifeq ($(DIET), diet) - #- default lib is dietlibc (honoured by main Makefile whenever possible) -L = DIETLIBC -else -L = GLIBC -endif - ifdef DEBUG OPTFLAGS = -g -DDEBUG else @@ -50,23 +33,11 @@ OPTFLAGS = -Os endif #- flags used by all stuff -CFLAGS = $(OPTFLAGS) -pipe -Wall -fomit-frame-pointer -fno-strict-aliasing - -ifneq (ppc, $(ARCH)) -ifneq (sparc, $(ARCH)) -CFLAGS += -Werror -endif -endif - -DIETLIBC_INCLUDES = -I/usr/lib/dietlibc/include -I. -DIETLIBC_LIBC = /usr/lib/dietlibc/lib-$(ARCH)/libcompat.a -GLIBC_INCLUDES = -I. -INCLUDES = $($(L)_INCLUDES) +CFLAGS = $(OPTFLAGS) -pipe -Wall -fomit-frame-pointer -fno-strict-aliasing -Werror -GLIBC_LDFLAGS = -static -LDFLAGS = $($(L)_LDFLAGS) +INCLUDES = -I. -STAGE1_LIBC = $($(L)_LIBC) +LDFLAGS = ifdef DEBUG STRIPCMD = echo not stripping diff --git a/mdk-stage1/NEWS b/mdk-stage1/NEWS index f25afb0fc..714ea3129 100644 --- a/mdk-stage1/NEWS +++ b/mdk-stage1/NEWS @@ -1,3 +1,330 @@ +- Replace i586 with i686 in files + +2.62 + +- Sync list_modules with kernel 6.4 + +2.61 + +- Sync with kernel 6.0 +- Increase MEM_LIMIT_* to match current stage2 size +- Fix the detection of available memory +- Fix a build failure with -Werror=address + +2.60 + +- Sync with kernel 5.17 +- Sync with kernel 5.18 +- Sync with kernel 5.19 +- Sync with kernel 6.0 +- Sync with kernel 6.1 + +2.59 + +- use 'nolock' option for NFS + +2.58 + +- fix 'disk' method after kernel-5.15 breakage + +2.57 + +- http server: allow to specify a port different than default "80" (mga#28367) + +2.56 + +- load exfat module to mount exfat (mga#28371) + +2.55 + +- recognize rtw89_pci HID driver + +2.53 + +- recognize amd_sfh HID driver + +2.52 + +- recognize more rtw88_* +- sync with kernel 5.10 + +2.51 + +- configure wpa_supplicant to try both nl80211 and wext interfaces + o some old wireless driver modules may only support wext +- improve help for entering wireless keys/passphrases + o note that ASCII strings can now be used for WEP keys (mga#21042) + +2.50 + +- add support for WPA/WPA2 (mga#9541) + +2.49 + +- sync with kernel 5.9 + +2.48 + +- sync with kernel 5.8 + +2.47 + +- sync with kernel 5.6/5.7 + +2.46 + +- make NVME code really generic and reuse if for most other disks + +2.45 + +- fix NVME code to work for disks with no vendor + +2.44 + +- add support for NVME disks + +2.43 + +- sync with kernel 5.5 + +2.42 + +- sync with kernel 5.4 + +2.41 + +- sync with kernel 5.3 + +2.40 + +- recognize 8821ce (mga#24605) + +2.39 + +- add AMD PCIe MP2 I2C detection + +2.38 + +- sync with kernel 5.1 + +2.37 + +- sync with kernel 5.0 + +2.36 + +- suppress mount error messages when probing for media (mga#24142) +- better gcc8 workarounds + +2.35 + +- fix compiling with gcc8 +- compile with -Wno-error=format-truncation for now + +2.34 + +- mounting: + o let libblk guess the right fs type rather than manually trying a long list + of potential fses + o use regular mount tool rather than manual system calls + o use regular mount tool for NFS too (support NFSv4, ...) + +2.33 + +- advertize "ext4" rather than "ext2" +- check for builtin modules in /sys/fs too (eg: ext4) +- support auto-install with "method:disk,disk:xxx,part:xxxY,dir:zzz" + +2.32 + +- list_modules: don't include vboxvideo (mga#23467) + +2.31 + +- sync with kernel 4.1[89] + +2.30 + +- add missing smartpqi driver (mga#23305) + +2.29 +- add missing Mellanox drivers (mga#23263) + +2.28 +- sync with kernel 4.1[5-7] + +2.27 +- further sync with kernel 4.14 + +2.26 +- sync with kernel 4.14 + +2.25 +- fix build with gcc7 + +2.24 +- recognize 8812au (mga#21043) + +2.23 +- recognize new kernel-4.8 drivers + +2.22 +- recognize new kernel-4.9 drivers + +2.21 +- recognize new kernel-4.7 drivers + +2.20 +- fix description of network interfaces (mga#15638) + +2.19 +- recognize some missing wireless drivers (mga#16768) + +2.18 +- recognize new kernel-4.6 drivers + +2.17 +- recognize new kernel-4.4 drivers + +2.16 +- recognize new kernel-4.3 drivers + +2.15 +- recognize new kernel-4.1 drivers + +2.14 +- network.c: fix -Werror=logical-not-parentheses + +2.13 +- mount again debugfs for ldetect (mga#14435) + (regression in 1.83) + +2.12 +- recognize new kernel-3.19 drivers + +2.11 +- recognize new kernel-3.18 drivers (mga#14799) + +2.10 +- include new 3.18 USB host drivers (mga#14799) + +2.9 +- glibc 2.20 wants _DEFAULT_SOURCE instead of _BSD_SOURCE + +2.8 +- recognize new kernel-3.17 drivers + +2.7 +- recognize hyper-v network card + +2.6 +- recognize new kernel-3.16 drivers + +2.5 +- stop creating /dev entries now that we use udev + +2.4 +- fix building with "make -j24" + +2.3 +- recognize new kernel-3.15 drivers + +2.2 +- drop support for supermount (dead since 2007) +- recognize new kernel-3.14 drivers + +2.1 +- drop support for SPARC +- support dynamic linking only +- use getaddrinfo() with glibc too now that use the dynamic library + +2.0 +- kernel modules and firmware is needed during stage2, so move and symlink + (symlinks are only for if you umount state2 /usr and want a still working initrd) + mga#11600 mga#11601 + +1.83 +- do initrd symlinking in 'init' rather than 'stage1' (stage1 is now run earlier) +- build init and stage1 as a shared library (due to bugs in directory handling + in dietlibc as exposed in libkmod but also because glibc is already include in + dracut) + +1.82 +- detect new kernel-3.12 modules + +1.81 +- sync with kernel-3.11 (might fix mga#11377) + +1.80 +- include latest list_modules.pl + (might fix mga#11377) + +1.79 +- fix compiling with gcc-4.8 + +1.78 +- probe virtual drivers too (mga#9546) + (install from Xen hd not supported yet) + +1.77 +- use kmod for module loading (mga#9242, based on Pok works @mdv) + +1.76 +- revert patch introduced in r7542 + +1.75 +- fix loading modules with "-" in their names (mga#9242) + +1.74.1 +- update list_modules for xen dom0 and virtio support (#9242) + +1.74 +- fix unitialized memory screwing up dialog input (pok, mdv, mga#8729) +- kill bootsplash support (we drop bootsplash in kernel in 2008) +- kill firmware loader now that firmware are loaded by the kernel + +1.73 +- add firmware loader written in C (based on hotplug2) (mga#6323) + +1.72 +- fix URL passed to stage2 when user didn't provide the arch in the + install path (mga#6823) +- retry with FTP instead of HTTP when there's no proxy and user didn't + provided the architecture in the URL + +1.71 +- silent hid_generic loading + +1.70 +- mount /dev as devtmpfs (pok, mdv) +- rely on /sys being created in images + +1.69 +- do not try to mount /proc/bus/usb +- load hid-generic + +1.68 +- mount /sys/kernel/debug (needed for new ldetect) + +1.67 +- make sure nurses get initialized in UTF-8 (mga#4894) +- revert to "linux" terminfo + +1.66 +- do not advice long dead pcmcia.img & network.img images (mga#5466) +- first attempt at supporting XenBlk discs +- hide "KA server" option (mga#5944) +- switch from gethostbyname() to getaddrinfo() (mga#4056) +- switch from gethostbyaddr() to getnameinfo() +- use system libraries for newtw, slang & sysfs (mdv) + +1.65 +- load btrfs module to mount btrfs +- try mounting as btrfs + +1.64 +- default to "screen" instead of "linux" terminfo (mga#4894) + 1.63 - do not try to load obsolete sqlzma & squashfs_lzma kernel modules - recognize c67x00, imx21-hcd, fhci, isp1362-hcd, oxu210hp-hcd & renesas-usbhs diff --git a/mdk-stage1/adsl.c b/mdk-stage1/adsl.c index ace741c18..70968f50b 100644 --- a/mdk-stage1/adsl.c +++ b/mdk-stage1/adsl.c @@ -156,8 +156,8 @@ enum return_type perform_adsl(struct interface_info * intf) intf->boot_proto = BOOTPROTO_ADSL_PPPOE; wait_message("Waiting for ADSL connection to show up..."); - my_insmod("ppp_generic", ANY_DRIVER_TYPE, NULL, 1); - my_insmod("ppp_async", ANY_DRIVER_TYPE, NULL, 1); + my_modprobe("ppp_generic", ANY_DRIVER_TYPE, NULL); + my_modprobe("ppp_async", ANY_DRIVER_TYPE, NULL); results = adsl_connect(intf, answers[0], answers[1], answers[2]); remove_wait_message(); diff --git a/mdk-stage1/automatic.c b/mdk-stage1/automatic.c index fd9eb3679..5e9ed56a2 100644 --- a/mdk-stage1/automatic.c +++ b/mdk-stage1/automatic.c @@ -102,7 +102,6 @@ char * get_auto_value(char * auto_param) enum return_type ask_from_list_auto(char *msg, char ** elems, char ** choice, char * auto_param, char ** elems_auto) { if (!IS_AUTOMATIC) { - exit_bootsplash(); return ask_from_list(msg, elems, choice); } else { char ** sav_elems = elems; @@ -124,7 +123,6 @@ enum return_type ask_from_list_auto(char *msg, char ** elems, char ** choice, ch enum return_type ask_from_list_comments_auto(char *msg, char ** elems, char ** elems_comments, char ** choice, char * auto_param, char ** elems_auto) { if (!IS_AUTOMATIC) { - exit_bootsplash(); return ask_from_list_comments(msg, elems, elems_comments, choice); } else { char ** sav_elems = elems; @@ -147,7 +145,6 @@ enum return_type ask_from_list_comments_auto(char *msg, char ** elems, char ** e enum return_type ask_from_entries_auto(char *msg, char ** questions, char *** answers, int entry_size, char ** questions_auto, void (*callback_func)(char ** strings)) { if (!IS_AUTOMATIC) { - exit_bootsplash(); return ask_from_entries(msg, questions, answers, entry_size, callback_func); } else { char * tmp_answers[50]; diff --git a/mdk-stage1/bootsplash.c b/mdk-stage1/bootsplash.c deleted file mode 100644 index 9d0d53327..000000000 --- a/mdk-stage1/bootsplash.c +++ /dev/null @@ -1,70 +0,0 @@ -/* - * Pixel (pixel) - * - * Copyright 2004 Mandriva - * - * This software may be freely redistributed under the terms of the GNU - * public license. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - * - */ - -#include <stdio.h> -#include "bootsplash.h" -#include "frontend.h" -#include "log.h" - -static int total_size; -static float previous; -static FILE* splash = NULL; - -static void update_progression_only(int current_size) -{ - if (splash && total_size) { - float ratio = (float) (current_size + 1) / total_size; - if (ratio > previous + 0.01) { - fprintf(splash, "show %d\n", (int) (ratio * 65534)); - fflush(splash); - previous = ratio; - } - } -} - -static void open_bootsplash(void) -{ - if (!splash) splash = fopen("/proc/splash", "w"); - if (!splash) log_message("opening /proc/splash failed"); -} - -void exit_bootsplash(void) -{ - log_message("exiting bootsplash"); - open_bootsplash(); - if (splash) { - fprintf(splash, "verbose\n"); - fflush(splash); - } -} - - -void init_progression(char *msg, int size) -{ - previous = 0; total_size = size; - open_bootsplash(); - update_progression_only(0); - init_progression_raw(msg, size); -} - -void update_progression(int current_size) -{ - update_progression_only(current_size); - update_progression_raw(current_size); -} - -void end_progression(void) -{ - end_progression_raw(); -} diff --git a/mdk-stage1/bootsplash.h b/mdk-stage1/bootsplash.h deleted file mode 100644 index 04c19c9f0..000000000 --- a/mdk-stage1/bootsplash.h +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Pixel (pixel) - * - * Copyright 2004 Mandriva - * - * This software may be freely redistributed under the terms of the GNU - * public license. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - * - */ - -#ifndef _BOOTSPLASH_H_ -#define _BOOTSPLASH_H_ - -#ifdef ENABLE_BOOTSPLASH -void exit_bootsplash(void); -void tell_bootsplash(char *cmd); -#else -#define exit_bootsplash() -#endif - -#endif diff --git a/mdk-stage1/cdrom.c b/mdk-stage1/cdrom.c index e75e0fde4..71db1da16 100644 --- a/mdk-stage1/cdrom.c +++ b/mdk-stage1/cdrom.c @@ -138,7 +138,7 @@ enum return_type cdrom_prepare(void) enum return_type results; static int already_probed_ide_generic = 0; - my_insmod("ide_cd_mod", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("ide_cd_mod", ANY_DRIVER_TYPE, NULL); if (IS_AUTOMATIC) { get_medias(CDROM, &medias, &medias_models, BUS_IDE); @@ -149,7 +149,7 @@ enum return_type cdrom_prepare(void) if ((i = try_automatic(medias, medias_models)) != -1) return do_with_device(medias[i], medias_models[i]); - my_insmod("sr_mod", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("sr_mod", ANY_DRIVER_TYPE, NULL); get_medias(CDROM, &medias, &medias_models, BUS_SCSI); if ((i = try_automatic(medias, medias_models)) != -1) return do_with_device(medias[i], medias_models[i]); @@ -159,7 +159,7 @@ enum return_type cdrom_prepare(void) return do_with_device(medias[i], medias_models[i]); /* detect hybrid isos (isos dumped to an USB stick) */ - my_insmod("sd_mod", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("sd_mod", ANY_DRIVER_TYPE, NULL); get_medias(DISK, &medias, &medias_models, BUS_USB); if ((i = try_automatic(medias, medias_models)) != -1) { return do_with_device(medias[i], medias_models[i]); @@ -167,7 +167,7 @@ enum return_type cdrom_prepare(void) unset_automatic(); } else - my_insmod("sr_mod", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("sr_mod", ANY_DRIVER_TYPE, NULL); get_medias(CDROM, &medias, &medias_models, BUS_ANY); @@ -180,7 +180,7 @@ enum return_type cdrom_prepare(void) if (count == 0) { if (!already_probed_ide_generic) { already_probed_ide_generic = 1; - my_insmod("ide_generic", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("ide_generic", ANY_DRIVER_TYPE, NULL); return cdrom_prepare(); } stg1_error_message("No CDROM device found."); diff --git a/mdk-stage1/config-stage1.h b/mdk-stage1/config-stage1.h index 4d27a58c9..e3409df98 100644 --- a/mdk-stage1/config-stage1.h +++ b/mdk-stage1/config-stage1.h @@ -22,9 +22,9 @@ /* If we have more than that amount of memory (in Mbytes), we assume we can load the second stage as a ramdisk */ -#define MEM_LIMIT_DRAKX 68 +#define MEM_LIMIT_DRAKX 192 /* If we have more than that amount of memory (in Mbytes), we preload the second stage as a ramdisk */ -#define MEM_LIMIT_DRAKX_PRELOAD 100 +#define MEM_LIMIT_DRAKX_PRELOAD 256 /* If we have more than that amount of memory (in Mbytes), we assume we can load the rescue as a ramdisk */ #define MEM_LIMIT_RESCUE 40 @@ -42,7 +42,7 @@ /* the remote media is mounted in MEDIA_LOCATION, and - IMAGE_LOCATION is a symlink image -> image/mdk/mirror/dir - - IMAGE_LOCATION is a symlink image -> loop/i586 and iso file is loopback mounted in LOOP_LOCATION + - IMAGE_LOCATION is a symlink image -> loop/i686 and iso file is loopback mounted in LOOP_LOCATION */ #define MEDIA_LOCATION_REL "media" #define MEDIA_LOCATION IMAGE_LOCATION_DIR MEDIA_LOCATION_REL diff --git a/mdk-stage1/dhcp.c b/mdk-stage1/dhcp.c index a4cc07446..678031e85 100644 --- a/mdk-stage1/dhcp.c +++ b/mdk-stage1/dhcp.c @@ -213,7 +213,7 @@ static void parse_reply(struct bootp_request * breq, struct interface_info * int unsigned char * chptr; unsigned char option, length; - if (breq->bootfile && strlen(breq->bootfile) > 0) { + if (strlen(breq->bootfile) > 0) { if (IS_NETAUTO) add_to_env("KICKSTART", breq->bootfile); else @@ -587,7 +587,7 @@ enum return_type perform_dhcp(struct interface_info * intf) log_message("DHCP: telling server to use name = %s", dhcp_hostname); } - memset(&client_addr.sin_addr, 0, sizeof(&client_addr.sin_addr)); + memset(&client_addr.sin_addr, 0, sizeof(client_addr.sin_addr)); client_addr.sin_family = AF_INET; client_addr.sin_port = htons(BOOTP_CLIENT_PORT); /* bootp client */ diff --git a/mdk-stage1/disk.c b/mdk-stage1/disk.c index 804c8ea2b..51a033639 100644 --- a/mdk-stage1/disk.c +++ b/mdk-stage1/disk.c @@ -45,6 +45,13 @@ static enum return_type try_automatic_with_partition(char *dev) { enum return_type results; int mounted; + char *dir= get_auto_value("directory"); + char location_full[500]; + strcpy(location_full, MEDIA_LOCATION); + if (dir) { + strcat(location_full, "/"); + strcat(location_full, dir); + } wait_message("Trying to access " DISTRIB_NAME " disk (partition %s)", dev); mounted = !try_mount(dev, MEDIA_LOCATION); remove_wait_message(); @@ -52,11 +59,13 @@ static enum return_type try_automatic_with_partition(char *dev) { create_IMAGE_LOCATION(MEDIA_LOCATION); if (image_has_stage2()) { results = try_with_directory(MEDIA_LOCATION, "disk", "disk-iso"); - if (results == RETURN_OK) { - if (!KEEP_MOUNTED) - umount(MEDIA_LOCATION); - return RETURN_OK; - } + } else { + results = try_with_directory(location_full, "disk", "disk-iso"); + } + if (results == RETURN_OK) { + if (!KEEP_MOUNTED) + umount(MEDIA_LOCATION); + return RETURN_OK; } } if (mounted) @@ -69,6 +78,7 @@ static enum return_type try_automatic_with_disk(char *disk, char *model) { char * parts_comments[50]; enum return_type results; char **dev; + char *part = get_auto_value("partition"); wait_message("Trying to access " DISTRIB_NAME " disk (drive %s)", model); if (list_partitions(disk, parts, parts_comments)) { stg1_error_message("Could not read partitions information."); @@ -77,10 +87,13 @@ static enum return_type try_automatic_with_disk(char *disk, char *model) { remove_wait_message(); dev = parts; while (dev && *dev) { + if (part && strcmp(part, *dev) != 0) + goto next; results = try_automatic_with_partition(*dev); if (results == RETURN_OK) { return RETURN_OK; } + next: dev++; } return RETURN_ERROR; @@ -90,11 +103,15 @@ static enum return_type try_automatic(char ** medias, char ** medias_models) { char ** model = medias_models; char ** ptr = medias; + char *disk = get_auto_value("disk"); while (ptr && *ptr) { enum return_type results; + if (disk && strcmp(disk, *ptr) != 0) + goto next; results = try_automatic_with_disk(*ptr, *model); if (results == RETURN_OK) return RETURN_OK; + next: ptr++; model++; } @@ -134,7 +151,7 @@ static enum return_type try_with_device(char *dev_name) /* in testing mode, assume the partition is already mounted on MEDIA_LOCATION */ if (!IS_TESTING && try_mount(choice, MEDIA_LOCATION)) { - stg1_error_message("I can't find a valid filesystem (tried: ext2, vfat, ntfs, reiserfs). " + stg1_error_message("I can't find a valid filesystem (tried: ext4, vfat, ntfs, reiserfs). " "Make sure the partition has been cleanly unmounted."); return try_with_device(dev_name); } @@ -191,7 +208,7 @@ enum return_type disk_prepare(void) if (count == 0) { if (!already_probed_ide_generic) { already_probed_ide_generic = 1; - my_insmod("ide_generic", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("ide_generic", ANY_DRIVER_TYPE, NULL); return disk_prepare(); } stg1_error_message("No DISK drive found."); diff --git a/mdk-stage1/dns.c b/mdk-stage1/dns.c index 63d801c62..f711758aa 100644 --- a/mdk-stage1/dns.c +++ b/mdk-stage1/dns.c @@ -21,10 +21,6 @@ #include <stdlib.h> -// dietlibc can do hostname lookup, whereas glibc can't when linked statically :-( - -#if defined(__dietlibc__) - #include <unistd.h> #include <string.h> #include <stdio.h> @@ -39,186 +35,56 @@ int mygethostbyname(char * name, struct in_addr * addr) { - struct hostent * h; + struct addrinfo hints, *res, *p; + int status; + char ipstr[INET6_ADDRSTRLEN]; + + memset(&hints, 0, sizeof hints); + hints.ai_family = AF_INET; //AF_UNSPEC for both IPv4 & IPv6 + hints.ai_socktype = SOCK_STREAM; /* prevent from timeouts */ if (_res.nscount == 0) return -1; - h = gethostbyname(name); - - if (!h && domain) { - // gethostbyname from dietlibc doesn't support domain handling - char fully_qualified[500]; - sprintf(fully_qualified, "%s.%s", name, domain); - h = gethostbyname(fully_qualified); + if ((status = getaddrinfo(name, NULL, &hints, &res)) != 0) { + log_message("getaddrinfo: %s\n", gai_strerror(status)); + return -1; } - if (h && h->h_addr_list && (h->h_addr_list)[0]) { - memcpy(addr, (h->h_addr_list)[0], sizeof(*addr)); - log_message("is-at: %s", inet_ntoa(*addr)); - return 0; + for (p = res;p != NULL; p = p->ai_next) { + void *tmp_addr; + + struct sockaddr_in *ipv = (struct sockaddr_in *)p->ai_addr; + tmp_addr = &(ipv->sin_addr); + + /* convert the IP to a string: */ + inet_ntop(p->ai_family, addr, ipstr, sizeof ipstr); + + memcpy(addr, tmp_addr, sizeof(*addr)); + log_message("is-at: %s\n", inet_ntoa(*addr)); } - log_message("unknown host %s", name); - return -1; + freeaddrinfo(res); // free the linked list + return 0; } char * mygethostbyaddr(char * ipnum) { - struct in_addr in; - struct hostent * host; + struct sockaddr_in sa; + char hbuf[NI_MAXHOST]; /* prevent from timeouts */ if (_res.nscount == 0) return NULL; - - if (!inet_aton(ipnum, &in)) - return NULL; - host = gethostbyaddr(&(in.s_addr), sizeof(in.s_addr) /* INADDRSZ */, AF_INET); - if (host && host->h_name) - return host->h_name; - return NULL; -} - -#elif defined(__GLIBC__) -#include <alloca.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <resolv.h> -#include <arpa/nameser.h> -#include <arpa/inet.h> -#include <stdlib.h> -#include <string.h> - -#include "log.h" + memset(&sa, 0, sizeof sa); + sa.sin_family = AF_INET; -#include "dns.h" + if (inet_pton(AF_INET, ipnum, &sa.sin_addr) != 1) + return NULL; -/* This is dumb, but glibc doesn't like to do hostname lookups w/o libc.so */ - -union dns_response { - HEADER hdr; - u_char buf[PACKETSZ]; -} ; - -static int do_query(char * query, int queryType, char ** domainName, struct in_addr * ipNum) -{ - int len, ancount, type; - u_char * data, * end; - char name[MAXDNAME]; - union dns_response response; - -#ifdef __sparc__ - /* from jj: */ - /* We have to wait till ethernet negotiation is done */ - _res.retry = 3; -#else - _res.retry = 2; -#endif - - - len = res_search(query, C_IN, queryType, (void *) &response, sizeof(response)); - if (len <= 0) - return -1; - - if (ntohs(response.hdr.rcode) != NOERROR) - return -1; - - ancount = ntohs(response.hdr.ancount); - if (ancount < 1) - return -1; - - data = response.buf + sizeof(HEADER); - end = response.buf + len; - - /* skip the question */ - data += dn_skipname(data, end) + QFIXEDSZ; - - /* parse the answer(s) */ - while (--ancount >= 0 && data < end) { - - /* skip the domain name portion of the RR record */ - data += dn_skipname(data, end); - - /* get RR information */ - GETSHORT(type, data); - data += INT16SZ; /* skipp class */ - data += INT32SZ; /* skipp TTL */ - GETSHORT(len, data); - - if (type == T_PTR) { - /* we got a pointer */ - len = dn_expand(response.buf, end, data, name, sizeof(name)); - if (len <= 0) return -1; - if (queryType == T_PTR && domainName) { - /* we wanted a pointer */ - *domainName = malloc(strlen(name) + 1); - strcpy(*domainName, name); - return 0; - } - } else if (type == T_A) { - /* we got an address */ - if (queryType == T_A && ipNum) { - /* we wanted an address */ - memcpy(ipNum, data, sizeof(*ipNum)); - return 0; - } - } - - /* move ahead to next RR */ - data += len; - } - - return -1; + if (getnameinfo((struct sockaddr*)&sa, sizeof(sa), hbuf, sizeof(hbuf), NULL, 0, 0 |NI_NAMEREQD) == 0) //NI_NUMERICHOST NI_NAMEREQD + return strdup(hbuf); + else return NULL; } - -char * mygethostbyaddr(char * ipnum) { - int rc; - char * result; - char * strbuf; - char * chptr; - char * splits[4]; - int i; - - _res.retry = 1; - - strbuf = alloca(strlen(ipnum) + 1); - strcpy(strbuf, ipnum); - - ipnum = alloca(strlen(strbuf) + 20); - - for (i = 0; i < 4; i++) { - chptr = strbuf; - while (*chptr && *chptr != '.') - chptr++; - *chptr = '\0'; - - if (chptr - strbuf > 3) return NULL; - splits[i] = strbuf; - strbuf = chptr + 1; - } - - sprintf(ipnum, "%s.%s.%s.%s.in-addr.arpa", splits[3], splits[2], splits[1], splits[0]); - - rc = do_query(ipnum, T_PTR, &result, NULL); - - if (rc) - return NULL; - else - return result; -} - -int mygethostbyname(char * name, struct in_addr * addr) { - int rc = do_query(name, T_A, NULL, addr); - if (!rc) - log_message("is-at %s", inet_ntoa(*addr)); - return rc; -} - -#else - -#error "Unsupported C library" - -#endif diff --git a/mdk-stage1/doc/README b/mdk-stage1/doc/README index 65e0174b4..28b81b39e 100644 --- a/mdk-stage1/doc/README +++ b/mdk-stage1/doc/README @@ -106,7 +106,7 @@ of the easiest way is to grab a local copy of the Distribution on one of your local hard drives, and to install from that location. At present time, you can install from IDE or SCSI drives, from Linux -(ext2), Windows (vfat) or Reiserfs partition. +(ext4), Windows (vfat) or Reiserfs partition. In that case, you'll need to use the "hd.img" image file. The dialogs will ask you to choose the DISK drive to use to install from, then the diff --git a/mdk-stage1/doc/TECH-INFOS b/mdk-stage1/doc/TECH-INFOS index 49c9c59b8..81d559a7f 100644 --- a/mdk-stage1/doc/TECH-INFOS +++ b/mdk-stage1/doc/TECH-INFOS @@ -6,7 +6,7 @@ This feature is used to replace redhat kickstart. It uses the kernel parameter "automatic" with keywords separated with commas and colons, on the following genres: - automatic=method:nfs,network:static,ip:192.168.1.24,server:192.168.1.7,directory:/stable/i586 + automatic=method:nfs,network:static,ip:192.168.1.24,server:192.168.1.7,directory:/stable/i686 automatic=method:ftp,network:dhcp,server:ftp.ciril.fr,directory:/pub/linux/mandriva-devel/cooker @@ -89,9 +89,9 @@ commandline), please find each keyword short-alias counterpart in file This gives for example for: - automatic=method:nfs,network:static,ip:192.168.1.24,server:192.168.1.7,directory:/stable/i586 + automatic=method:nfs,network:static,ip:192.168.1.24,server:192.168.1.7,directory:/stable/i686 ==> - automatic=met:nfs,net:static,ip:192.168.1.24,ser:192.168.1.7,dir:/stable/i586 + automatic=met:nfs,net:static,ip:192.168.1.24,ser:192.168.1.7,dir:/stable/i686 diff --git a/mdk-stage1/doc/WHY-DIETLIBC b/mdk-stage1/doc/WHY-DIETLIBC deleted file mode 100644 index e7c526b49..000000000 --- a/mdk-stage1/doc/WHY-DIETLIBC +++ /dev/null @@ -1,50 +0,0 @@ -(the dietlibc is a replacement for the glibc, which aim is to produce -smaller statically linked binaries) - - -The use for dietlibc in the stage1 was clear because currently used -install process on x86 is from a 1.44 Mbytes floppy. On this floppy we -need to fit the kernel, modules (scsi and network access), and the code to -do the basic things to load the stage2. The only part on which we could -progress was the code. - -As always, figures demonstrate evidences. Here are the size of the -binaries used for the cdrom, disk, network and full floppy installs, using -newt as the UI library: - - - with glibc - --rwxr-xr-x 1 gc gc 569448 May 15 15:29 stage1-cdrom --rwxr-xr-x 1 gc gc 572264 May 15 15:29 stage1-disk --rwxr-xr-x 1 gc gc 624712 May 15 15:30 stage1-network --rwxr-xr-x 1 gc gc 720360 May 15 15:29 stage1-full - - - with dietlibc - --rwxr-xr-x 1 gc gc 169332 May 15 14:26 stage1-cdrom --rwxr-xr-x 1 gc gc 172180 May 15 14:26 stage1-disk --rwxr-xr-x 1 gc gc 198612 May 15 14:26 stage1-network --rwxr-xr-x 1 gc gc 251764 May 15 14:26 stage1-full - - -The `stage1-full' binary has code for many things, most notably: data -decrunching (bzlib), archive extraction (in-house format), module loading -(insmod from busybox), PCI detection, ide and scsi handling, -cdrom/disk/loopback mounting, DHCP client negociation (redhat+grub), NFS -mounting (util-linux), FTP and HTTP transmission (redhat), pcmcia -initializing (pcmcia-cs), UI interaction (slang/newt); with use of the -dietlibc, the binary is only 250 kbytes! - - -Due to the modular coding, it is also possible to choose to not use -slang/newt as the UI, but a stdio-only UI. In that case, the binaries get -even smaller: - --rwxr-xr-x 1 gc gc 104500 May 15 15:46 stage1-cdrom* --rwxr-xr-x 1 gc gc 107348 May 15 15:46 stage1-disk* --rwxr-xr-x 1 gc gc 133972 May 15 15:47 stage1-network* --rwxr-xr-x 1 gc gc 187348 May 15 15:46 stage1-full* - - - -gc [Tue May 15 15:58:34 2001]
\ No newline at end of file diff --git a/mdk-stage1/init.c b/mdk-stage1/init.c index d9af9aac2..7c48f64ec 100644 --- a/mdk-stage1/init.c +++ b/mdk-stage1/init.c @@ -22,6 +22,7 @@ #include <stdlib.h> #include <unistd.h> #include <stdio.h> +#include <dirent.h> #include <string.h> #include <sys/types.h> #include <sys/socket.h> @@ -36,19 +37,12 @@ #include <linux/unistd.h> #include <sys/select.h> #include <sys/ioctl.h> +#include <linux/reboot.h> #include <sys/syscall.h> #define syslog(...) syscall(__NR_syslog, __VA_ARGS__) -#define LINUX_REBOOT_MAGIC1 0xfee1dead -#define LINUX_REBOOT_MAGIC2 672274793 -#define BMAGIC_HARD 0x89ABCDEF -#define BMAGIC_SOFT 0 -#define BMAGIC_REBOOT 0x01234567 -#define BMAGIC_HALT 0xCDEF0123 -#define BMAGIC_POWEROFF 0x4321FEDC - -static unsigned int reboot_magic = BMAGIC_REBOOT; +static unsigned int reboot_magic = LINUX_REBOOT_CMD_RESTART; static inline long reboot(unsigned int command) { @@ -58,25 +52,21 @@ static inline long reboot(unsigned int command) #include "config-stage1.h" #include <linux/cdrom.h> -#if defined(__powerpc__) -#define TIOCSCTTY 0x540E -#endif - -#define BINARY "/sbin/stage1" #define BINARY_STAGE2 "/usr/bin/runinstall2" char * env[] = { "PATH=/usr/bin:/bin:/sbin:/usr/sbin:/mnt/sbin:/mnt/usr/sbin:/mnt/bin:/mnt/usr/bin", - "LD_LIBRARY_PATH=/lib:/usr/lib:/mnt/lib:/mnt/usr/lib:/usr/X11R6/lib:/mnt/usr/X11R6/lib" -#if defined(__x86_64__) || defined(__ppc64__) - ":/lib64:/usr/lib64:/usr/X11R6/lib64:/mnt/lib64:/mnt/usr/lib64:/mnt/usr/X11R6/lib64" + "LD_LIBRARY_PATH=/lib:/usr/lib:/mnt/lib:/mnt/usr/lib" +#if defined(__x86_64__) + ":/lib64:/usr/lib64:/mnt/lib64:/mnt/usr/lib64" #endif , "HOME=/", "TERM=linux", "TERMINFO=/etc/terminfo", + "LC_CTYPE=UTF-8", NULL }; @@ -160,7 +150,6 @@ void doklog() return; } - mkdir("/tmp", 0755); if ((log = open("/tmp/syslog", O_WRONLY | O_CREAT | O_APPEND, 0644)) < 0) { print_error("error opening /tmp/syslog"); sleep(5); @@ -291,7 +280,9 @@ char* strcat(register char* s,register const char* t) char *dest=s; s+=strlen(s); for (;;) { - if (!(*s = *t)) break; ++s; ++t; + if (!(*s = *t)) + break; + ++s; ++t; } return dest; } @@ -379,13 +370,92 @@ int in_reboot(void) int i = read(fd, buf, sizeof(buf)); close(fd); if (strstr(buf, "halt")) - reboot_magic = BMAGIC_POWEROFF; + reboot_magic = LINUX_REBOOT_CMD_POWER_OFF; return i > 0; } return 0; } -int exit_value_proceed = 66; +int recursive_remove(char *file); +int recursive_remove(char *file) +{ + struct stat sb; + + if (lstat(file, &sb) != 0) { + printf("failed to stat %s: %d\n", file, errno); + return -1; + } + + /* only descend into subdirectories if device is same as dir */ + if (S_ISDIR(sb.st_mode)) { + char * strBuf = alloca(strlen(file) + 1024); + DIR * dir; + struct dirent * d; + + if (!(dir = opendir(file))) { + printf("error opening %s: %d\n", file, errno); + return -1; + } + while ((d = readdir(dir))) { + if (!strcmp(d->d_name, ".") || !strcmp(d->d_name, "..")) + continue; + + strcpy(strBuf, file); + strcat(strBuf, "/"); + strcat(strBuf, d->d_name); + + if (recursive_remove(strBuf) != 0) { + closedir(dir); + return -1; + } + } + closedir(dir); + + if (rmdir(file)) { + printf("failed to rmdir %s: %d\n", file, errno); + return -1; + } + } else { + if (unlink(file) != 0) { + printf("failed to remove %s: %d\n", file, errno); + return -1; + } + } + return 0; +} + + +int create_initial_fs_symlinks(char* symlinks) +{ + FILE *f; + char buf[5000]; + + if (!(f = fopen(symlinks, "rb"))) { + printf("Error opening symlink definitions file '%s'\n", symlinks); + return -1; + } + while (fgets(buf, sizeof(buf), f)) { + char oldpath[500], newpath[500]; + struct stat sb; + + buf[strlen(buf)-1] = '\0'; // trim \n + if (sscanf(buf, "%s %s", oldpath, newpath) != 2) { + snprintf(oldpath, sizeof(oldpath), "%s%s", STAGE2_LOCATION, buf); + snprintf(newpath, sizeof(newpath), "%s", buf); + } + if (lstat(newpath, &sb) == 0) + recursive_remove(newpath); + printf("Creating symlink %s -> %s\n", oldpath, newpath); + if (symlink(oldpath, newpath)) { + printf("Error creating symlink\n"); + return -1; + } + } + fclose(f); + return 0; +} + + int exit_value_restart = 0x35; int main(int argc, char **argv) @@ -393,7 +463,6 @@ int main(int argc, char **argv) pid_t installpid, childpid; int wait_status; int fd; - int counter = 0; int abnormal_termination = 0; if (argc > 1 && argv[1][0] >= '0' && argv[1][0] <= '9') { @@ -411,14 +480,10 @@ int main(int argc, char **argv) printf("*** TESTING MODE *** (pid is %d)\n", getpid()); - if (!testing) { - mkdir("/proc", 0755); - if (mount("/proc", "/proc", "proc", 0, NULL)) - fatal_error("Unable to mount proc filesystem"); - mkdir("/sys", 0755); - if (mount("none", "/sys", "sysfs", 0, NULL)) - fatal_error("Unable to mount sysfs filesystem"); - } + // needed for ldetect: + if (!testing) + if (mount("none", "/sys/kernel/debug", "debugfs", MS_NOSUID, "mode=0755")) + fatal_error("Unable to mount debugfs filesystem"); /* ignore Control-C and keyboard stop signals */ @@ -453,57 +518,66 @@ int main(int argc, char **argv) if (!testing) doklog(); - /* Go into normal init mode - keep going, and then do a orderly shutdown - when: + if (create_initial_fs_symlinks(STAGE2_LOCATION "/usr/share/symlinks") != 0) + fatal_error("Fatal error finishing initialization (could not create symlinks)."); - 1) install exits - 2) we receive a SIGHUP - */ + /* kernel modules and firmware is needed by stage2, so move them to the root */ + if (rename("/usr/lib/modules", "/modules")) + fatal_error("Cannot rename modules folder"); - do { - if (counter == 1) { - printf("proceeding, please wait...\n"); - } + if (rename("/usr/lib/firmware", "/firmware")) + fatal_error("Cannot rename firmware folder"); - if (!(installpid = fork())) { - /* child */ - char * child_argv[2]; - child_argv[0] = counter == 0 ? BINARY : BINARY_STAGE2; - child_argv[1] = NULL; + /* Add some symlinks so stage1 is still valid on it's own - not strictly needed */ + if (symlink("/modules", "/usr/lib/modules")) + fatal_error("Cannot symlink modules folder"); - execve(child_argv[0], child_argv, env); - printf("error in exec of %s :-( [%d]\n", child_argv[0], errno); - return 0; - } + if (symlink("/firmware", "/usr/lib/firmware")) + fatal_error("Cannot symlink firmware folder"); - do { - childpid = wait4(-1, &wait_status, 0, NULL); - } while (childpid != installpid); + if (mount(STAGE2_LOCATION "/usr", "/usr", "none", MS_BIND|MS_RDONLY, NULL)) + fatal_error("Unable to bind mount /usr filesystem from rescue or installer stage2"); - counter++; - } while (WIFEXITED(wait_status) && WEXITSTATUS(wait_status) == exit_value_restart); - /* allow Ctrl Alt Del to reboot */ - reboot(BMAGIC_HARD); + if (access("/run/drakx/run-init", R_OK) == 0) { + /* This is typically used in rescue mode */ + char * child_argv[2] = { "/sbin/init", NULL }; - if (in_reboot()) { - // any exitcode is valid if we're in_reboot - } else if (WIFEXITED(wait_status) && WEXITSTATUS(wait_status) == exit_value_proceed) { kill(klog_pid, 9); printf("proceeding, please wait...\n"); + execve(child_argv[0], child_argv, env); + fatal_error("failed to exec /sbin/init"); + } + + /* This is installer mode */ + do { + printf("proceeding, please wait...\n"); - { - char * child_argv[2] = { "/sbin/init", NULL }; + if (!(installpid = fork())) { + /* child */ + char * child_argv[2] = { BINARY_STAGE2, NULL }; execve(child_argv[0], child_argv, env); + printf("error in exec of %s :-( [%d]\n", child_argv[0], errno); + return 0; } - fatal_error("failed to exec /sbin/init"); - } else if (!WIFEXITED(wait_status) || WEXITSTATUS(wait_status) != 0) { + + do { + childpid = wait4(-1, &wait_status, 0, NULL); + } while (childpid != installpid); + } while (WIFEXITED(wait_status) && WEXITSTATUS(wait_status) == exit_value_restart); + + /* allow Ctrl Alt Del to reboot */ + reboot(LINUX_REBOOT_CMD_CAD_ON); + + if (in_reboot()) { + // any exitcode is valid if we're in_reboot + } else if (!WIFEXITED(wait_status) || WEXITSTATUS(wait_status) != 0) { printf("exited abnormally :-( "); if (WIFSIGNALED(wait_status)) printf("-- received signal %d", WTERMSIG(wait_status)); printf("\n"); abnormal_termination = 1; - } + } if (!abnormal_termination) { int i; @@ -532,7 +606,7 @@ int main(int argc, char **argv) sync(); sync(); if (!abnormal_termination) { - if (reboot_magic == BMAGIC_REBOOT) { + if (reboot_magic == LINUX_REBOOT_CMD_RESTART) { #ifdef DEBUG printf("automatic reboot in 10 seconds\n"); sleep(10); diff --git a/mdk-stage1/ka.c b/mdk-stage1/ka.c index 670abe5af..7b9d98fbe 100644 --- a/mdk-stage1/ka.c +++ b/mdk-stage1/ka.c @@ -44,7 +44,7 @@ static void my_pause(void) { static enum return_type ka_wait_for_stage2(int count) { char * ramdisk = "/dev/ram3"; /* warning, verify that this file exists in the initrd*/ - char * ka_launch[] = { "/ka/ka-d-client", "-w","-s","getstage2","-e","(cd /tmp/stage2; tar -x -f - )", NULL }; /* The command line for ka_launch */ + char * ka_launch[] = { "/ka/ka-d-client", "-w","-s","getstage2","-e","(cd " STAGE2_LOCATION "; tar -x -f - )", NULL }; /* The command line for ka_launch */ char * mkfs_launch[] = { "/sbin/mke2fs", "-m", "0", ramdisk, NULL}; /* The mkfs command for formating the ramdisk */ log_message("KA: Preparing to receive stage 2...."); diff --git a/mdk-stage1/lomount.c b/mdk-stage1/lomount.c index b7d61f24b..caca48ea1 100644 --- a/mdk-stage1/lomount.c +++ b/mdk-stage1/lomount.c @@ -165,9 +165,9 @@ lomount(char *loopfile, char *where, char **dev, int compressed) flag = MS_MGC_VAL; flag |= MS_RDONLY; - my_insmod("loop", ANY_DRIVER_TYPE, "max_loop=256", 1); + my_modprobe("loop", ANY_DRIVER_TYPE, "max_loop=256"); if (compressed) { - my_insmod("squashfs", ANY_DRIVER_TYPE, NULL, 1); + my_modprobe("squashfs", ANY_DRIVER_TYPE, NULL); } if (!(loopdev = find_free_loop())) { diff --git a/mdk-stage1/modules.c b/mdk-stage1/modules.c index 745070052..76177302e 100644 --- a/mdk-stage1/modules.c +++ b/mdk-stage1/modules.c @@ -32,6 +32,7 @@ #include <errno.h> #include <time.h> #include <sys/utsname.h> +#include <libkmod.h> #include "log.h" #include "utils.h" #include "frontend.h" @@ -40,16 +41,11 @@ #include "modules.h" -#define UEVENT_HELPER_FILE "/sys/kernel/uevent_helper" -#define UEVENT_HELPER_VALUE "/sbin/hotplug" - static char modules_directory[100]; -static struct module_deps_elem * modules_deps = NULL; static struct module_descr_elem * modules_descr = NULL; extern long init_module(void *, unsigned long, const char *); - static const char *moderror(int err) { switch (err) { @@ -124,76 +120,6 @@ static void find_modules_directory(void) sprintf(modules_directory , "%s/%s", prefix, release); } -static int load_modules_dependencies(void) -{ - char * deps_file = asprintf_("%s/%s", modules_directory, "modules.dep"); - char * buf, * ptr, * start, * end; - struct stat s; - int line, i; - - log_message("loading modules dependencies"); - buf = cat_file(deps_file, &s); - if (!buf) - return -1; - line = line_counts(buf); - modules_deps = malloc(sizeof(*modules_deps) * (line+1)); - - start = buf; - line = 0; - while (start < (buf+s.st_size) && *start) { - char * tmp_deps[50]; - - end = strchr(start, '\n'); - *end = '\0'; - - ptr = strchr(start, ':'); - if (!ptr) { - start = end + 1; - continue; - } - *ptr = '\0'; - ptr++; - - while (*ptr && (*ptr == ' ')) ptr++; - - /* sort of a good line */ - modules_deps[line].filename = start[0] == '/' ? strdup(start) : asprintf_("%s/%s", modules_directory, start); - modules_deps[line].modname = filename2modname(start); - - start = ptr; - i = 0; - while (start && *start && i < sizeof(tmp_deps)/sizeof(char *)) { - ptr = strchr(start, ' '); - if (ptr) *ptr = '\0'; - tmp_deps[i++] = filename2modname(start); - if (ptr) - start = ptr + 1; - else - start = NULL; - while (start && *start && *start == ' ') - start++; - } - if(i >= sizeof(tmp_deps)/sizeof(char *)-1) { - log_message("warning, more than %zu dependencies for module %s", - sizeof(tmp_deps)/sizeof(char *)-1, - modules_deps[line].modname); - i = sizeof(tmp_deps)/sizeof(char *)-1; - } - tmp_deps[i++] = NULL; - - modules_deps[line].deps = _memdup(tmp_deps, sizeof(char *) * i); - - line++; - start = end + 1; - } - modules_deps[line].modname = NULL; - - free(buf); - - return 0; -} - - static int load_modules_descriptions(void) { char * descr_file = asprintf_("%s/%s", modules_directory, "modules.description"); @@ -236,23 +162,9 @@ static int load_modules_descriptions(void) return 0; } -void init_firmware_loader(void) -{ - int fd = open(UEVENT_HELPER_FILE, O_WRONLY|O_TRUNC, 0666); - if (!fd) { - log_message("warning, unable to set firmware loader"); - return; - } - write(fd, UEVENT_HELPER_VALUE, strlen(UEVENT_HELPER_VALUE)); - close(fd); -} - void init_modules_insmoding(void) { find_modules_directory(); - if (load_modules_dependencies()) { - fatal_error("warning, error initing modules stuff, modules loading disabled"); - } if (load_modules_descriptions()) { log_message("warning, error initing modules stuff"); } @@ -309,52 +221,101 @@ int module_already_present(const char * name) answ = 1; free(path); } + if (!answ) { + asprintf(&path, "/sys/fs/%s", name); + if (!stat(path, &sb)) + answ = 1; + free(path); + } return answ; } #ifndef ENABLE_NETWORK_STANDALONE -static enum insmod_return insmod_with_deps(const char * mod_name, char * options, int allow_modules_floppy) -{ - struct module_deps_elem * dep; - const char * filename; - - dep = modules_deps; - while (dep && dep->modname && strcmp(dep->modname, mod_name)) dep++; - - if (dep && dep->modname && dep->deps) { - char ** one_dep; - one_dep = dep->deps; - while (*one_dep) { - /* here, we can fail but we don't care, if the error is - * important, the desired module will fail also */ - insmod_with_deps(*one_dep, NULL, allow_modules_floppy); - one_dep++; - } +static enum insmod_return insmod_with_deps(const char * alias, char * options) { + struct kmod_ctx *ctx; + struct kmod_list *l, *list = NULL; + int err = 0, flags = 0; + + if (!*modules_directory) + find_modules_directory(); + + ctx = kmod_new(modules_directory, NULL); + if (!ctx) { + fputs("Error: kmod_new() failed!\n", stderr); + goto exit; } - - if (dep && dep->filename) { - filename = dep->filename; - } else { - log_message("warning: unable to get module filename for %s", mod_name); - filename = mod_name; + kmod_load_resources(ctx); + + err = kmod_module_new_from_lookup(ctx, alias, &list); + if (err < 0) + goto exit; + + // No module found... + if (list == NULL) + goto exit; + + // filter through blacklist + struct kmod_list *filtered = NULL; + err = kmod_module_apply_filter(ctx, KMOD_FILTER_BLACKLIST, list, &filtered); + kmod_module_unref_list(list); + if (err < 0) + goto exit; + list = filtered; + + kmod_list_foreach(l, list) { + struct kmod_module *mod = kmod_module_get_module(l); + err = kmod_module_probe_insert_module(mod, flags, + options, NULL, NULL, NULL); + + if (err >= 0) + /* ignore flag return values such as a mod being blacklisted */ + err = 0; + else { + switch (err) { + case -EEXIST: + fprintf(stderr, "could not insert '%s': Module already in kernel\n", + kmod_module_get_name(mod)); + break; + case -ENOENT: + fprintf(stderr, "could not insert '%s': Unknown symbol in module, " + "or unknown parameter (see dmesg)\n", + kmod_module_get_name(mod)); + break; + default: + fprintf(stderr, "could not insert '%s': %s\n", + kmod_module_get_name(mod), + strerror(-err)); + break; + } + } + + kmod_module_unref(mod); + if (err < 0) + break; } - if (module_already_present(mod_name)) - return INSMOD_OK; + kmod_module_unref_list(list); - log_message("needs %s", filename); - { - return insmod_local_file((char *) filename, options); +exit: + kmod_unref(ctx); + + switch (err){ + case 0: + return INSMOD_OK; + case -ENOENT: + return INSMOD_FAILED_FILE_NOT_FOUND; + default: + return INSMOD_FAILED; } } #endif #ifndef DISABLE_NETWORK -enum insmod_return my_insmod(const char * mod_name, enum driver_type type, char * options, int allow_modules_floppy) +enum insmod_return my_modprobe(const char * mod_name, enum driver_type type, char * options) #else -enum insmod_return my_insmod(const char * mod_name, enum driver_type type __attribute__ ((unused)), char * options, int allow_modules_floppy) +enum insmod_return my_modprobe(const char * mod_name, enum driver_type type __attribute__ ((unused)), char * options) #endif { int i; @@ -380,7 +341,7 @@ enum insmod_return my_insmod(const char * mod_name, enum driver_type type __attr i = system(cmd); } #else - i = insmod_with_deps(mod_name, options, allow_modules_floppy); + i = insmod_with_deps(mod_name, options); #endif if (i == 0) { log_message("\tsucceeded %s", mod_name); @@ -398,7 +359,6 @@ enum insmod_return my_insmod(const char * mod_name, enum driver_type type __attr sprintf(alias, "alias %s %s", *new_net_devices, mod_name); add_modules_conf(alias); log_message("NET: %s", alias); - net_discovered_interface(*new_net_devices); already_present: new_net_devices++; @@ -425,9 +385,9 @@ static enum return_type insmod_with_options(char * mod, enum driver_type type) strcat(options, mod); strcat(options, " "); - strcat(options, answers[0]); // because my_insmod will eventually modify the string + strcat(options, answers[0]); // because my_modprobe will eventually modify the string - if (my_insmod(mod, type, answers[0], 1) != INSMOD_OK) { + if (my_modprobe(mod, type, answers[0]) != INSMOD_OK) { stg1_error_message("Insmod failed."); return RETURN_ERROR; } diff --git a/mdk-stage1/modules.h b/mdk-stage1/modules.h index 96ba48fc2..1a6d8753f 100644 --- a/mdk-stage1/modules.h +++ b/mdk-stage1/modules.h @@ -23,16 +23,10 @@ enum insmod_return { INSMOD_OK, INSMOD_FAILED, INSMOD_FAILED_FILE_NOT_FOUND }; void init_modules_insmoding(void); void init_firmware_loader(void); int insmod_local_file(char * path, char * options); -enum insmod_return my_insmod(const char * mod_name, enum driver_type type, char * options, int allow_modules_floppy); +enum insmod_return my_modprobe(const char * mod_name, enum driver_type type, char * options); enum return_type ask_insmod(enum driver_type); int module_already_present(const char * name); -struct module_deps_elem { - char * modname; - char * filename; - char ** deps; -}; - struct module_descr_elem { char * modname; char * description; diff --git a/mdk-stage1/mount.c b/mdk-stage1/mount.c index e73a2135a..14b2b2fc2 100644 --- a/mdk-stage1/mount.c +++ b/mdk-stage1/mount.c @@ -19,10 +19,12 @@ * */ +// for asprintf: +#define _GNU_SOURCE +#include <stdio.h> #include <stdlib.h> #include <unistd.h> #include <string.h> -#include <stdio.h> #include <sys/mount.h> #include <sys/stat.h> #include <sys/types.h> @@ -37,126 +39,16 @@ /* WARNING: this won't work if the argument is not /dev/ based */ int ensure_dev_exists(const char * dev) { - int major, minor; - int type = S_IFBLK; /* my default type is block. don't forget to change for chars */ - const char * name; struct stat buf; - char * ptr; - name = &dev[5]; /* we really need that dev be passed as /dev/something.. */ - if (!stat(dev, &buf)) return 0; /* if the file already exists, we assume it's correct */ - if (ptr_begins_static_str(name, "sd")) { - /* SCSI disks */ - major = 8; - minor = (name[2] - 'a') << 4; - if (name[3] && name[4]) { - minor += 10 + (name[4] - '0'); - if (name[3] > 1 || name[4] > 5) { - log_message("I don't know how to create device %s, please post bugreport to me!", dev); - return -1; - } - } else if (name[3]) - minor += (name[3] - '0'); - } else if (ptr_begins_static_str(name, "vd")) { - /* Virtual disks */ - major = 252; - minor = (name[2] - 'a') << 4; - if (name[3] && name[4]) { - minor += 10 + (name[4] - '0'); - if (name[3] > 1 || name[4] > 5) { - log_message("I don't know how to create device %s, please post bugreport to me!", dev); - return -1; - } - } else if (name[3]) - minor += (name[3] - '0'); - } else if (ptr_begins_static_str(name, "hd")) { - /* IDE disks/cd's */ - if (name[2] == 'a') - major = 3, minor = 0; - else if (name[2] == 'b') - major = 3, minor = 64; - else if (name[2] == 'c') - major = 22, minor = 0; - else if (name[2] == 'd') - major = 22, minor = 64; - else if (name[2] == 'e') - major = 33, minor = 0; - else if (name[2] == 'f') - major = 33, minor = 64; - else if (name[2] == 'g') - major = 34, minor = 0; - else if (name[2] == 'h') - major = 34, minor = 64; - else if (name[2] == 'i') - major = 56, minor = 0; - else if (name[2] == 'j') - major = 56, minor = 64; - else if (name[2] == 'k') - major = 57, minor = 0; - else if (name[2] == 'l') - major = 57, minor = 64; - else if (name[2] == 'm') - major = 88, minor = 0; - else if (name[2] == 'n') - major = 88, minor = 64; - else if (name[2] == 'o') - major = 89, minor = 0; - else if (name[2] == 'p') - major = 89, minor = 64; - else if (name[2] == 'q') - major = 90, minor = 0; - else if (name[2] == 'r') - major = 90, minor = 64; - else if (name[2] == 's') - major = 91, minor = 0; - else if (name[2] == 't') - major = 91, minor = 64; - else - return -1; - - if (name[3] && name[4]) - minor += 10 + (name[4] - '0'); - else if (name[3]) - minor += (name[3] - '0'); - } else if (ptr_begins_static_str(name , "sr")) { - /* SCSI cd's */ - major = 11; - minor = name[2] - '0'; - } else if (ptr_begins_static_str(name, "ida/") || - ptr_begins_static_str(name, "cciss/")) { - /* Compaq Smart Array "ida/c0d0{p1}" */ - ptr = strchr(name, '/'); - mkdir("/dev/ida", 0755); - mkdir("/dev/cciss", 0755); - major = ptr_begins_static_str(name, "ida/") ? 72 : 104 + charstar_to_int(ptr+2); - ptr = strchr(ptr, 'd'); - minor = 16 * charstar_to_int(ptr+1); - ptr = strchr(ptr, 'p'); - minor += charstar_to_int(ptr+1); - } else if (ptr_begins_static_str(name, "rd/")) { - /* DAC960 "rd/cXdXXpX" */ - mkdir("/dev/rd", 0755); - major = 48 + charstar_to_int(name+4); - ptr = strchr(name+4, 'd'); - minor = 8 * charstar_to_int(ptr+1); - ptr = strchr(ptr, 'p'); - minor += charstar_to_int(ptr+1); - } else if (ptr_begins_static_str(name, "loop")) { - major = 7; - minor = name[4] - '0'; - } else if (ptr_begins_static_str(name, "chloop")) { - major = 100; - minor = name[6] - '0'; - } else { - log_message("I don't know how to create device %s, please post bugreport to me!", dev); - return -1; - } + // give udev some time to create nodes if module was just insmoded: + system("udevadm settle"); - if (mknod(dev, type | 0600, makedev(major, minor))) { - log_perror(dev); + if (!stat(dev, &buf)) { + log_message("I don't know how to create device %s, please post bugreport to me!", dev); return -1; } @@ -167,7 +59,6 @@ int ensure_dev_exists(const char * dev) /* mounts, creating the device if needed+possible */ int my_mount(char *dev, char *location, char *fs, int force_rw) { - unsigned long flags = MS_MGC_VAL | (force_rw ? 0 : MS_RDONLY); char * opts = NULL; struct stat buf; int rc; @@ -199,56 +90,20 @@ int my_mount(char *dev, char *location, char *fs, int force_rw) } } - if (!strcmp(fs, "supermount")) { - my_insmod("supermount", ANY_DRIVER_TYPE, NULL, 1); - my_insmod("isofs", ANY_DRIVER_TYPE, NULL, 1); - opts = alloca(500); - sprintf(opts, "dev=%s,fs=iso9660,tray_lock=always", dev); - dev = "none"; - } - #ifndef DISABLE_MEDIAS - if (!strcmp(fs, "vfat")) { - my_insmod("nls_cp437", ANY_DRIVER_TYPE, NULL, 1); - my_insmod("nls_iso8859_1", ANY_DRIVER_TYPE, NULL, 1); - my_insmod("vfat", ANY_DRIVER_TYPE, NULL, 1); + if (!strcmp(fs, "nfs")) + opts = "nolock"; + if (!strcmp(fs, "vfat")) opts = "check=relaxed"; - } - - if (!strcmp(fs, "ntfs")) { - my_insmod("ntfs", ANY_DRIVER_TYPE, NULL, 1); - } - - if (!strcmp(fs, "reiserfs")) - my_insmod("reiserfs", ANY_DRIVER_TYPE, NULL, 1); - - if (!strcmp(fs, "reiser4")) - my_insmod("reiser4", ANY_DRIVER_TYPE, NULL, 1); - - if (!strcmp(fs, "jfs")) - my_insmod("jfs", ANY_DRIVER_TYPE, NULL, 1); - - if (!strcmp(fs, "xfs")) - my_insmod("xfs", ANY_DRIVER_TYPE, NULL, 1); - - if (!strcmp(fs, "ext4")) - my_insmod("ext4", ANY_DRIVER_TYPE, NULL, 1); - #endif - if (!strcmp(fs, "iso9660")) - my_insmod("isofs", ANY_DRIVER_TYPE, NULL, 1); - -#ifndef DISABLE_NETWORK - if (!strcmp(fs, "nfs")) { - my_insmod("nfs", ANY_DRIVER_TYPE, NULL, 1); - log_message("preparing nfsmount for %s", dev); - rc = nfsmount_prepare(dev, &opts); - if (rc != 0) - return rc; + char *cmd; + rc = asprintf(&cmd, "mount %s %s -t %s -o %s%s > /dev/null 2>&1", dev, location, fs, (force_rw ? "" : "ro,"), (opts ? opts : "")); + if (rc == -1) { + log_perror("asprint allocation failure"); + rmdir(location); + return rc; } -#endif - - rc = mount(dev, location, fs, flags, opts); + rc = system(cmd); if (rc != 0) { log_perror("mount failed"); rmdir(location); diff --git a/mdk-stage1/mount.h b/mdk-stage1/mount.h index e0d924901..dc8d674c3 100644 --- a/mdk-stage1/mount.h +++ b/mdk-stage1/mount.h @@ -22,10 +22,6 @@ #ifndef _MOUNT_H_ #define _MOUNT_H_ -#ifndef DISABLE_NETWORK -#include "nfsmount.h" -#endif - int my_mount(char *dev, char *location, char *fs, int force_rw); int ensure_dev_exists(const char * dev); diff --git a/mdk-stage1/mount_rpcgen.h b/mdk-stage1/mount_rpcgen.h deleted file mode 100644 index d70ccaf9d..000000000 --- a/mdk-stage1/mount_rpcgen.h +++ /dev/null @@ -1,208 +0,0 @@ -/* - * Please do not edit this file. - * It was generated using rpcgen. - */ - -#ifndef _MOUNT_H_RPCGEN -#define _MOUNT_H_RPCGEN - -#include <rpc/rpc.h> - -#define MNTPATHLEN 1024 -#define MNTNAMLEN 255 -#define FHSIZE 32 - -typedef char fhandle[FHSIZE]; -#ifdef __cplusplus -extern "C" bool_t xdr_fhandle(XDR *, fhandle); -#elif __STDC__ -extern bool_t xdr_fhandle(XDR *, fhandle); -#else /* Old Style C */ -bool_t xdr_fhandle(); -#endif /* Old Style C */ - - -struct fhstatus { - u_int fhs_status; - union { - fhandle fhs_fhandle; - } fhstatus_u; -}; -typedef struct fhstatus fhstatus; -#ifdef __cplusplus -extern "C" bool_t xdr_fhstatus(XDR *, fhstatus*); -#elif __STDC__ -extern bool_t xdr_fhstatus(XDR *, fhstatus*); -#else /* Old Style C */ -bool_t xdr_fhstatus(); -#endif /* Old Style C */ - - -typedef char *dirpath; -#ifdef __cplusplus -extern "C" bool_t xdr_dirpath(XDR *, dirpath*); -#elif __STDC__ -extern bool_t xdr_dirpath(XDR *, dirpath*); -#else /* Old Style C */ -bool_t xdr_dirpath(); -#endif /* Old Style C */ - - -typedef char *name; -#ifdef __cplusplus -extern "C" bool_t xdr_name(XDR *, name*); -#elif __STDC__ -extern bool_t xdr_name(XDR *, name*); -#else /* Old Style C */ -bool_t xdr_name(); -#endif /* Old Style C */ - - -typedef struct mountbody *mountlist; -#ifdef __cplusplus -extern "C" bool_t xdr_mountlist(XDR *, mountlist*); -#elif __STDC__ -extern bool_t xdr_mountlist(XDR *, mountlist*); -#else /* Old Style C */ -bool_t xdr_mountlist(); -#endif /* Old Style C */ - - -struct mountbody { - name ml_hostname; - dirpath ml_directory; - mountlist ml_next; -}; -typedef struct mountbody mountbody; -#ifdef __cplusplus -extern "C" bool_t xdr_mountbody(XDR *, mountbody*); -#elif __STDC__ -extern bool_t xdr_mountbody(XDR *, mountbody*); -#else /* Old Style C */ -bool_t xdr_mountbody(); -#endif /* Old Style C */ - - -typedef struct groupnode *groups; -#ifdef __cplusplus -extern "C" bool_t xdr_groups(XDR *, groups*); -#elif __STDC__ -extern bool_t xdr_groups(XDR *, groups*); -#else /* Old Style C */ -bool_t xdr_groups(); -#endif /* Old Style C */ - - -struct groupnode { - name gr_name; - groups gr_next; -}; -typedef struct groupnode groupnode; -#ifdef __cplusplus -extern "C" bool_t xdr_groupnode(XDR *, groupnode*); -#elif __STDC__ -extern bool_t xdr_groupnode(XDR *, groupnode*); -#else /* Old Style C */ -bool_t xdr_groupnode(); -#endif /* Old Style C */ - - -typedef struct exportnode *exports; -#ifdef __cplusplus -extern "C" bool_t xdr_exports(XDR *, exports*); -#elif __STDC__ -extern bool_t xdr_exports(XDR *, exports*); -#else /* Old Style C */ -bool_t xdr_exports(); -#endif /* Old Style C */ - - -struct exportnode { - dirpath ex_dir; - groups ex_groups; - exports ex_next; -}; -typedef struct exportnode exportnode; -#ifdef __cplusplus -extern "C" bool_t xdr_exportnode(XDR *, exportnode*); -#elif __STDC__ -extern bool_t xdr_exportnode(XDR *, exportnode*); -#else /* Old Style C */ -bool_t xdr_exportnode(); -#endif /* Old Style C */ - - -#define MOUNTPROG ((u_long)100005) -#define MOUNTVERS ((u_long)1) - -#ifdef __cplusplus -#define MOUNTPROC_NULL ((u_long)0) -extern "C" void * mountproc_null_1(void *, CLIENT *); -extern "C" void * mountproc_null_1_svc(void *, struct svc_req *); -#define MOUNTPROC_MNT ((u_long)1) -extern "C" fhstatus * mountproc_mnt_1(dirpath *, CLIENT *); -extern "C" fhstatus * mountproc_mnt_1_svc(dirpath *, struct svc_req *); -#define MOUNTPROC_DUMP ((u_long)2) -extern "C" mountlist * mountproc_dump_1(void *, CLIENT *); -extern "C" mountlist * mountproc_dump_1_svc(void *, struct svc_req *); -#define MOUNTPROC_UMNT ((u_long)3) -extern "C" void * mountproc_umnt_1(dirpath *, CLIENT *); -extern "C" void * mountproc_umnt_1_svc(dirpath *, struct svc_req *); -#define MOUNTPROC_UMNTALL ((u_long)4) -extern "C" void * mountproc_umntall_1(void *, CLIENT *); -extern "C" void * mountproc_umntall_1_svc(void *, struct svc_req *); -#define MOUNTPROC_EXPORT ((u_long)5) -extern "C" exports * mountproc_export_1(void *, CLIENT *); -extern "C" exports * mountproc_export_1_svc(void *, struct svc_req *); -#define MOUNTPROC_EXPORTALL ((u_long)6) -extern "C" exports * mountproc_exportall_1(void *, CLIENT *); -extern "C" exports * mountproc_exportall_1_svc(void *, struct svc_req *); - -#elif __STDC__ -#define MOUNTPROC_NULL ((u_long)0) -extern void * mountproc_null_1(void *, CLIENT *); -extern void * mountproc_null_1_svc(void *, struct svc_req *); -#define MOUNTPROC_MNT ((u_long)1) -extern fhstatus * mountproc_mnt_1(dirpath *, CLIENT *); -extern fhstatus * mountproc_mnt_1_svc(dirpath *, struct svc_req *); -#define MOUNTPROC_DUMP ((u_long)2) -extern mountlist * mountproc_dump_1(void *, CLIENT *); -extern mountlist * mountproc_dump_1_svc(void *, struct svc_req *); -#define MOUNTPROC_UMNT ((u_long)3) -extern void * mountproc_umnt_1(dirpath *, CLIENT *); -extern void * mountproc_umnt_1_svc(dirpath *, struct svc_req *); -#define MOUNTPROC_UMNTALL ((u_long)4) -extern void * mountproc_umntall_1(void *, CLIENT *); -extern void * mountproc_umntall_1_svc(void *, struct svc_req *); -#define MOUNTPROC_EXPORT ((u_long)5) -extern exports * mountproc_export_1(void *, CLIENT *); -extern exports * mountproc_export_1_svc(void *, struct svc_req *); -#define MOUNTPROC_EXPORTALL ((u_long)6) -extern exports * mountproc_exportall_1(void *, CLIENT *); -extern exports * mountproc_exportall_1_svc(void *, struct svc_req *); - -#else /* Old Style C */ -#define MOUNTPROC_NULL ((u_long)0) -extern void * mountproc_null_1(); -extern void * mountproc_null_1_svc(); -#define MOUNTPROC_MNT ((u_long)1) -extern fhstatus * mountproc_mnt_1(); -extern fhstatus * mountproc_mnt_1_svc(); -#define MOUNTPROC_DUMP ((u_long)2) -extern mountlist * mountproc_dump_1(); -extern mountlist * mountproc_dump_1_svc(); -#define MOUNTPROC_UMNT ((u_long)3) -extern void * mountproc_umnt_1(); -extern void * mountproc_umnt_1_svc(); -#define MOUNTPROC_UMNTALL ((u_long)4) -extern void * mountproc_umntall_1(); -extern void * mountproc_umntall_1_svc(); -#define MOUNTPROC_EXPORT ((u_long)5) -extern exports * mountproc_export_1(); -extern exports * mountproc_export_1_svc(); -#define MOUNTPROC_EXPORTALL ((u_long)6) -extern exports * mountproc_exportall_1(); -extern exports * mountproc_exportall_1_svc(); -#endif /* Old Style C */ - -#endif /* !_MOUNT_H_RPCGEN */ diff --git a/mdk-stage1/network.c b/mdk-stage1/network.c index d82ca28d5..ab512399a 100644 --- a/mdk-stage1/network.c +++ b/mdk-stage1/network.c @@ -291,7 +291,7 @@ static int save_netinfo(struct interface_info * intf) fprintf(f, "NETWORKING=yes\n"); fprintf(f, "FORWARD_IPV4=false\n"); - if (hostname && !intf->boot_proto == BOOTPROTO_DHCP) + if (hostname && !(intf->boot_proto == BOOTPROTO_DHCP)) fprintf(f, "HOSTNAME=%s\n", hostname); if (gateway.s_addr != 0) fprintf(f, "GATEWAY=%s\n", inet_ntoa(gateway)); @@ -538,7 +538,7 @@ static enum return_type configure_network(struct interface_info * intf) char * boulet; if (dhcp_hostname || dhcp_domain) { - answers = (char **) malloc(sizeof(questions)); + answers = (char **) calloc(1, sizeof(questions)); answers[0] = strdup(dhcp_hostname); answers[1] = strdup(dhcp_domain); } @@ -575,7 +575,7 @@ static enum return_type bringup_networking(struct interface_info * intf) /* badly */ fd = open("/proc/net/packet", O_RDONLY); if (fd < 0) - my_insmod("af_packet", ANY_DRIVER_TYPE, NULL, 1); + my_modprobe("af_packet", ANY_DRIVER_TYPE, NULL); else close(fd); @@ -691,8 +691,7 @@ static char * interface_select(void) } if (count == 0) { - stg1_error_message("No NET device found.\n" - "Hint: if you're using a Laptop, note that PCMCIA Network adapters are now supported either with `pcmcia.img' or `network.img', please try both these bootdisks."); + stg1_error_message("No NET device found."); i = ask_insmod(NETWORK_DEVICES); if (i == RETURN_BACK) return NULL; @@ -1002,11 +1001,12 @@ enum return_type ftp_prepare(void) char location_full[500]; int ftp_serv_response = -1; int fd, size; + int need_arch = 0; char ftp_hostname[500]; if (!IS_AUTOMATIC) { if (answers == NULL) - answers = (char **) malloc(sizeof(questions)); + answers = (char **) calloc(1, sizeof(questions)); results = choose_mirror_from_list(http_proxy_host, http_proxy_port, "ftp", &answers[0], &answers[1]); @@ -1077,9 +1077,14 @@ enum return_type ftp_prepare(void) log_message("%s failed.", location_full); char *with_arch = asprintf_("%s%s/%s/%s", answers[1][0] == '/' ? "" : "/", answers[1], ARCH, COMPRESSED_FILE_REL("/")); log_message("trying %s...", with_arch); - fd = http_download_file(answers[0], with_arch, &size, use_http_proxy ? "http" : NULL, http_proxy_host, http_proxy_port); - if (0 < fd) + if (use_http_proxy) + fd = http_download_file(answers[0], with_arch, &size, use_http_proxy ? "http" : NULL, http_proxy_host, http_proxy_port); + else + fd = ftp_start_download(ftp_serv_response, with_arch, &size); + if (0 < fd) { strcpy(location_full, with_arch); + need_arch = 1; + } } if (fd < 0) { @@ -1103,13 +1108,17 @@ enum return_type ftp_prepare(void) if (use_http_proxy) { add_to_env("METHOD", "http"); - sprintf(location_full, "ftp://%s%s", ftp_hostname, answers[1]); + snprintf(location_full, sizeof(location_full), "ftp://%s%s", ftp_hostname, answers[1]); + if (need_arch) + strcat(location_full, "/" ARCH); add_to_env("URLPREFIX", location_full); add_to_env("PROXY", http_proxy_host); add_to_env("PROXYPORT", http_proxy_port); } else { add_to_env("METHOD", "ftp"); add_to_env("HOST", answers[0]); + if (need_arch) + strcat(answers[1], "/" ARCH); add_to_env("PREFIX", answers[1]); if (!streq(answers[2], "")) { add_to_env("LOGIN", answers[2]); @@ -1145,17 +1154,17 @@ enum return_type http_prepare(void) do { char location_full[500]; - int fd, size; + int fd, size, need_arch = 0; int use_http_proxy; if (!IS_AUTOMATIC) { if (answers == NULL) - answers = (char **) malloc(sizeof(questions)); + answers = (char **) calloc(1, sizeof(questions)); results = choose_mirror_from_list(http_proxy_host, http_proxy_port, "http", &answers[0], &answers[1]); if (results == RETURN_BACK) - return ftp_prepare(); + return http_prepare(); } results = ask_from_entries_auto("Please enter the name or IP address of the HTTP server, " @@ -1182,8 +1191,10 @@ enum return_type http_prepare(void) char *with_arch = asprintf_("%s%s/%s/%s", answers[1][0] == '/' ? "" : "/", answers[1], ARCH, COMPRESSED_FILE_REL("/")); log_message("trying %s...", with_arch); fd = http_download_file(answers[0], with_arch, &size, use_http_proxy ? "http" : NULL, http_proxy_host, http_proxy_port); - if (0 < fd) + if (0 < fd) { strcpy(location_full, with_arch); + need_arch = 1; + } } if (fd < 0) { @@ -1205,6 +1216,8 @@ enum return_type http_prepare(void) add_to_env("METHOD", "http"); sprintf(location_full, "http://%s%s%s", answers[0], answers[1][0] == '/' ? "" : "/", answers[1]); + if (need_arch) + strcat(location_full, "/" ARCH); add_to_env("URLPREFIX", location_full); if (!streq(http_proxy_host, "")) add_to_env("PROXY", http_proxy_host); diff --git a/mdk-stage1/newt-frontend.c b/mdk-stage1/newt-frontend.c index e8a6ef6d3..c0489b58d 100644 --- a/mdk-stage1/newt-frontend.c +++ b/mdk-stage1/newt-frontend.c @@ -32,7 +32,7 @@ #include <stdio.h> #include <stdarg.h> #include <sys/time.h> -#include "newt/newt.h" +#include <newt.h> #include <probing.h> @@ -299,7 +299,7 @@ static int mynewtWinEntries(char * title, char * text, int suggestedWidth, int f for (i = 0; i < numItems; i++) { newtComponent entr = newtEntry(-1, -1, items[i].value ? *items[i].value : NULL, dataWidth, - items[i].value, items[i].flags); + (const char**)items[i].value, items[i].flags); newtGridSetField(subgrid, 0, i, NEWT_GRID_COMPONENT, newtLabel(-1, -1, items[i].text), @@ -361,7 +361,7 @@ enum return_type ask_from_entries(char *msg, char ** questions, char *** answers entries[i].value = NULL; if (*answers == NULL) - *answers = (char **) malloc(sizeof(char *) * i); + *answers = (char **) calloc(1, sizeof(char *) * i); else already_answers = *answers; diff --git a/mdk-stage1/newt/Makefile b/mdk-stage1/newt/Makefile deleted file mode 100644 index 9f6bd845a..000000000 --- a/mdk-stage1/newt/Makefile +++ /dev/null @@ -1,42 +0,0 @@ - #****************************************************************************** - # - # Guillaume Cottenceau (gc) - # - # Copyright 2000 Mandriva - # - # This software may be freely redistributed under the terms of the GNU - # public license. - # - # You should have received a copy of the GNU General Public License - # along with this program; if not, write to the Free Software - # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - # - #***************************************************************************** - -top_dir = .. - -include $(top_dir)/Makefile.common - - -LIBNAME = libnewt - -OBJS = newt.o button.o form.o checkbox.o entry.o label.o listbox.o scrollbar.o textbox.o scale.o grid.o windows.o buttonbar.o checkboxtree.o - -DEFS = -DVERSION=\"0.50.19\" - -INCS = -I../slang - - -TARGETS = $(LIBNAME).a - -all: $(TARGETS) - -clean: - rm -f *.o *.a - -$(LIBNAME).a: $(OBJS) - ar -cru $@ $^ - ranlib $@ - -$(OBJS): %.o: %.c - $(DIET) gcc $(CFLAGS) $(DEFS) $(INCS) $(INCLUDES) -c $< -o $@ diff --git a/mdk-stage1/newt/button.c b/mdk-stage1/newt/button.c deleted file mode 100644 index d7da58175..000000000 --- a/mdk-stage1/newt/button.c +++ /dev/null @@ -1,192 +0,0 @@ -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct button { - char * text; - int compact; -}; - -static void buttonDrawIt(newtComponent co, int active, int pushed); -static void buttonDrawText(newtComponent co, int active, int pushed); - -static void buttonDraw(newtComponent c); -static void buttonDestroy(newtComponent co); -static struct eventResult buttonEvent(newtComponent c, - struct event ev); -static void buttonPlace(newtComponent co, int newLeft, int newTop); - -static struct componentOps buttonOps = { - buttonDraw, - buttonEvent, - buttonDestroy, - buttonPlace, - newtDefaultMappedHandler, -} ; - -static newtComponent createButton(int left, int row, const char * text, int compact) { - newtComponent co; - struct button * bu; - - co = malloc(sizeof(*co)); - bu = malloc(sizeof(struct button)); - co->data = bu; - - bu->text = strdup(text); - bu->compact = compact; - co->ops = &buttonOps; - - if (bu->compact) { - co->height = 1; - co->width = strlen(text) + 3; - } else { - co->height = 4; - co->width = strlen(text) + 5; - } - - co->top = row; - co->left = left; - co->takesFocus = 1; - co->isMapped = 0; - - newtGotorc(co->top, co->left); - - return co; -} - -newtComponent newtCompactButton(int left, int row, const char * text) { - return createButton(left, row, text, 1); -} - -newtComponent newtButton(int left, int row, const char * text) { - return createButton(left, row, text, 0); -} - -static void buttonDestroy(newtComponent co) { - struct button * bu = co->data; - - free(bu->text); - free(bu); - free(co); -} - -static void buttonPlace(newtComponent co, int newLeft, int newTop) { - co->top = newTop; - co->left = newLeft; - - newtGotorc(co->top, co->left); -} - -static void buttonDraw(newtComponent co) { - buttonDrawIt(co, 0, 0); -} - -static void buttonDrawIt(newtComponent co, int active, int pushed) { - struct button * bu = co->data; - - if (!co->isMapped) return; - - SLsmg_set_color(NEWT_COLORSET_BUTTON); - - if (bu->compact) { - if (active) - SLsmg_set_color(NEWT_COLORSET_COMPACTBUTTON); - else - SLsmg_set_color(NEWT_COLORSET_BUTTON); - newtGotorc(co->top+ pushed, co->left + 1 + pushed); - SLsmg_write_char('<'); - SLsmg_write_string(bu->text); - SLsmg_write_char('>'); - } else { - if (pushed) { - SLsmg_set_color(NEWT_COLORSET_BUTTON); - newtDrawBox(co->left + 1, co->top + 1, co->width - 1, 3, 0); - - SLsmg_set_color(NEWT_COLORSET_WINDOW); - newtClearBox(co->left, co->top, co->width, 1); - newtClearBox(co->left, co->top, 1, co->height); - } else { - newtDrawBox(co->left, co->top, co->width - 1, 3, 1); - } - - buttonDrawText(co, active, pushed); - } -} - -static void buttonDrawText(newtComponent co, int active, int pushed) { - struct button * bu = co->data; - - if (pushed) pushed = 1; - - if (active) - SLsmg_set_color(NEWT_COLORSET_ACTBUTTON); - else - SLsmg_set_color(NEWT_COLORSET_BUTTON); - - newtGotorc(co->top + 1 + pushed, co->left + 1 + pushed); - SLsmg_write_char(' '); - SLsmg_write_string(bu->text); - SLsmg_write_char(' '); -} - -static struct eventResult buttonEvent(newtComponent co, - struct event ev) { - struct eventResult er; - struct button * bu = co->data; - er.result = ER_IGNORED; - er.u.focus = NULL; - - if (ev.when == EV_NORMAL) { - switch (ev.event) { - case EV_FOCUS: - buttonDrawIt(co, 1, 0); - er.result = ER_SWALLOWED; - break; - - case EV_UNFOCUS: - buttonDrawIt(co, 0, 0); - er.result = ER_SWALLOWED; - break; - - case EV_KEYPRESS: - if (ev.u.key == ' ' || ev.u.key == '\r') { - if (!bu->compact) { - /* look pushed */ - buttonDrawIt(co, 1, 1); - newtRefresh(); - newtDelay(150000); - buttonDrawIt(co, 1, 0); - newtRefresh(); - newtDelay(150000); - } - - er.result = ER_EXITFORM; - } else - er.result = ER_IGNORED; - break; - case EV_MOUSE: - if (ev.u.mouse.type == MOUSE_BUTTON_DOWN && - co->top <= ev.u.mouse.y && - co->top + co->height - !bu->compact > ev.u.mouse.y && - co->left <= ev.u.mouse.x && - co->left + co->width - !bu->compact > ev.u.mouse.x) { - if (!bu->compact) { - buttonDrawIt(co, 1, 1); - newtRefresh(); - newtDelay(150000); - buttonDrawIt(co, 1, 0); - newtRefresh(); - newtDelay(150000); - } - er.result = ER_EXITFORM; - } - break; - } - } else - er.result = ER_IGNORED; - - return er; -} diff --git a/mdk-stage1/newt/buttonbar.c b/mdk-stage1/newt/buttonbar.c deleted file mode 100644 index 45473c9d2..000000000 --- a/mdk-stage1/newt/buttonbar.c +++ /dev/null @@ -1,46 +0,0 @@ -#include <stdarg.h> - -#include "newt.h" - -/* if they try and pack more then 50 buttons, screw 'em */ -newtGrid newtButtonBarv(char * button1, newtComponent * b1comp, va_list args) { - newtGrid grid; - struct buttonInfo { - char * name; - newtComponent * compPtr; - } buttons[50]; - int num; - int i; - - buttons[0].name = button1, buttons[0].compPtr = b1comp, num = 1; - while (1) { - buttons[num].name = va_arg(args, char *); - if (!buttons[num].name) break; - buttons[num].compPtr = va_arg(args, newtComponent *); - num++; - } - - grid = newtCreateGrid(num, 1); - - for (i = 0; i < num; i++) { - *buttons[i].compPtr = newtButton(-1, -1, buttons[i].name); - newtGridSetField(grid, i, 0, NEWT_GRID_COMPONENT, - *buttons[i].compPtr, - num ? 1 : 0, 0, 0, 0, 0, 0); - } - - return grid; -} - -newtGrid newtButtonBar(char * button1, newtComponent * b1comp, ...) { - va_list args; - newtGrid grid; - - va_start(args, b1comp); - - grid = newtButtonBarv(button1, b1comp, args); - - va_end(args); - - return grid; -} diff --git a/mdk-stage1/newt/checkbox.c b/mdk-stage1/newt/checkbox.c deleted file mode 100644 index 643609d34..000000000 --- a/mdk-stage1/newt/checkbox.c +++ /dev/null @@ -1,292 +0,0 @@ -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -enum type { CHECK, RADIO }; - -struct checkbox { - char * text; - char * seq; - char * result; - newtComponent prevButton, lastButton; - enum type type; - char value; - int active, inactive; - const void * data; - int flags; - int hasFocus; -}; - -static void makeActive(newtComponent co); - -static void cbDraw(newtComponent c); -static void cbDestroy(newtComponent co); -struct eventResult cbEvent(newtComponent co, struct event ev); - -static struct componentOps cbOps = { - cbDraw, - cbEvent, - cbDestroy, - newtDefaultPlaceHandler, - newtDefaultMappedHandler, -} ; - -newtComponent newtRadiobutton(int left, int top, const char * text, int isDefault, - newtComponent prevButton) { - newtComponent co; - newtComponent curr; - struct checkbox * rb; - char initialValue; - - if (isDefault) - initialValue = '*'; - else - initialValue = ' '; - - co = newtCheckbox(left, top, text, initialValue, " *", NULL); - rb = co->data; - rb->type = RADIO; - - rb->prevButton = prevButton; - - for (curr = co; curr; curr = rb->prevButton) { - rb = curr->data; - rb->lastButton = co; - } - - return co; -} - -newtComponent newtRadioGetCurrent(newtComponent setMember) { - struct checkbox * rb = setMember->data; - - setMember = rb->lastButton; - rb = setMember->data; - - while (rb && rb->value != '*') { - setMember = rb->prevButton; - if (!setMember) - return NULL; - rb = setMember->data; - } - - return setMember; -} - -char newtCheckboxGetValue(newtComponent co) { - struct checkbox * cb = co->data; - - return cb->value; -} - -void newtCheckboxSetValue(newtComponent co, char value) { - struct checkbox * cb = co->data; - - *cb->result = value; - cbDraw(co); -} - -newtComponent newtCheckbox(int left, int top, const char * text, char defValue, - const char * seq, char * result) { - newtComponent co; - struct checkbox * cb; - - if (!seq) seq = " *"; - - co = malloc(sizeof(*co)); - cb = malloc(sizeof(struct checkbox)); - co->data = cb; - cb->flags = 0; - if (result) - cb->result = result; - else - cb->result = &cb->value; - - cb->text = strdup(text); - cb->seq = strdup(seq); - cb->type = CHECK; - cb->hasFocus = 0; - cb->inactive = COLORSET_CHECKBOX; - cb->active = COLORSET_ACTCHECKBOX; - defValue ? (*cb->result = defValue) : (*cb->result = cb->seq[0]); - - co->ops = &cbOps; - - co->callback = NULL; - co->height = 1; - co->width = strlen(text) + 4; - co->top = top; - co->left = left; - co->takesFocus = 1; - - return co; -} - -void newtCheckboxSetFlags(newtComponent co, int flags, enum newtFlagsSense sense) { - struct checkbox * cb = co->data; - int row, col; - - cb->flags = newtSetFlags(cb->flags, flags, sense); - - if (!(cb->flags & NEWT_FLAG_DISABLED)) - co->takesFocus = 1; - else - co->takesFocus = 0; - - newtGetrc(&row, &col); - cbDraw(co); - newtGotorc(row, col); -} - -static void cbDraw(newtComponent c) { - struct checkbox * cb = c->data; - - if (c->top == -1 || !c->isMapped) return; - - if (cb->flags & NEWT_FLAG_DISABLED) { - cb->inactive = NEWT_COLORSET_DISENTRY; - cb->active = NEWT_COLORSET_DISENTRY; - } else { - cb->inactive = COLORSET_CHECKBOX; - cb->active = COLORSET_ACTCHECKBOX; - } - - SLsmg_set_color(cb->inactive); - - newtGotorc(c->top, c->left); - - switch (cb->type) { - case RADIO: - SLsmg_write_string("( ) "); - break; - - case CHECK: - SLsmg_write_string("[ ] "); - break; - - default: - break; - } - - SLsmg_write_string(cb->text); - - if (cb->hasFocus) - SLsmg_set_color(cb->active); - - newtGotorc(c->top, c->left + 1); - SLsmg_write_char(*cb->result); -} - -static void cbDestroy(newtComponent co) { - struct checkbox * cb = co->data; - - free(cb->text); - free(cb->seq); - free(cb); - free(co); -} - -struct eventResult cbEvent(newtComponent co, struct event ev) { - struct checkbox * cb = co->data; - struct eventResult er; - const char * cur; - er.result = ER_IGNORED; - er.u.focus = NULL; - - if (ev.when == EV_NORMAL) { - switch (ev.event) { - case EV_FOCUS: - cb->hasFocus = 1; - cbDraw(co); - er.result = ER_SWALLOWED; - break; - - case EV_UNFOCUS: - cb->hasFocus = 0; - cbDraw(co); - er.result = ER_SWALLOWED; - break; - - case EV_KEYPRESS: - if (ev.u.key == ' ') { - if (cb->type == RADIO) { - makeActive(co); - } else if (cb->type == CHECK) { - cur = strchr(cb->seq, *cb->result); - if (!cur) - *cb->result = *cb->seq; - else { - cur++; - if (! *cur) - *cb->result = *cb->seq; - else - *cb->result = *cur; - } - cbDraw(co); - er.result = ER_SWALLOWED; - - if (co->callback) - co->callback(co, co->callbackData); - } else { - er.result = ER_IGNORED; - } - } else if(ev.u.key == NEWT_KEY_ENTER) { - er.result = ER_IGNORED; - } else { - er.result = ER_IGNORED; - } - break; - case EV_MOUSE: - if (ev.u.mouse.type == MOUSE_BUTTON_DOWN) { - if (cb->type == RADIO) { - makeActive(co); - } else if (cb->type == CHECK) { - cur = strchr(cb->seq, *cb->result); - if (!cur) - *cb->result = *cb->seq; - else { - cur++; - if (! *cur) - *cb->result = *cb->seq; - else - *cb->result = *cur; - } - cbDraw(co); - er.result = ER_SWALLOWED; - - if (co->callback) - co->callback(co, co->callbackData); - } - } - } - } else - er.result = ER_IGNORED; - - return er; -} - -static void makeActive(newtComponent co) { - struct checkbox * cb = co->data; - struct checkbox * rb; - newtComponent curr; - - /* find the one that's turned off */ - curr = cb->lastButton; - rb = curr->data; - while (curr && rb->value == rb->seq[0]) { - curr = rb->prevButton; - if (curr) rb = curr->data; - } - if (curr) { - rb->value = rb->seq[0]; - cbDraw(curr); - } - cb->value = cb->seq[1]; - cbDraw(co); - - if (co->callback) - co->callback(co, co->callbackData); -} diff --git a/mdk-stage1/newt/checkboxtree.c b/mdk-stage1/newt/checkboxtree.c deleted file mode 100644 index 00113f23e..000000000 --- a/mdk-stage1/newt/checkboxtree.c +++ /dev/null @@ -1,714 +0,0 @@ -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct items { - char * text; - const void *data; - unsigned char selected; - struct items *next; - struct items *prev; - struct items *branch; - int flags; - int depth; -}; - -struct CheckboxTree { - newtComponent sb; - int curWidth; /* size of text w/o scrollbar or border*/ - int curHeight; /* size of text w/o border */ - struct items * itemlist; - struct items ** flatList, ** currItem, ** firstItem; - int flatCount; - int flags; - int pad; - char * seq; - char * result; -}; - -static void ctDraw(newtComponent c); -static void ctDestroy(newtComponent co); -static void ctPlace(newtComponent co, int newLeft, int newTop); -struct eventResult ctEvent(newtComponent co, struct event ev); -static void ctMapped(newtComponent co, int isMapped); -static struct items * findItem(struct items * items, const void * data); -static void buildFlatList(newtComponent co); -static void doBuildFlatList(struct CheckboxTree * ct, struct items * item); -enum countWhat { COUNT_EXPOSED=0, COUNT_SELECTED=1 }; -static int countItems(struct items * item, enum countWhat justExposed); - -static struct componentOps ctOps = { - ctDraw, - ctEvent, - ctDestroy, - ctPlace, - ctMapped, -} ; - -static int countItems(struct items * item, enum countWhat what) { - int count = 0; - - while (item) { - if ((!item->branch && item->selected == what) || (what == COUNT_EXPOSED)) - count++; - if (item->branch || (what == COUNT_EXPOSED && item->selected)) - count += countItems(item->branch, what); - item = item->next; - } - - return count; -} - -static void doBuildFlatList(struct CheckboxTree * ct, struct items * item) { - while (item) { - ct->flatList[ct->flatCount++] = item; - if (item->branch && item->selected) doBuildFlatList(ct, item->branch); - item = item->next; - } -} - -static void buildFlatList(newtComponent co) { - struct CheckboxTree * ct = co->data; - - if (ct->flatList) free(ct->flatList); - ct->flatCount = countItems(ct->itemlist, COUNT_EXPOSED); - - ct->flatList = malloc(sizeof(*ct->flatList) * (ct->flatCount+1)); - ct->flatCount = 0; - doBuildFlatList(ct, ct->itemlist); - ct->flatList[ct->flatCount] = NULL; -} - -int newtCheckboxTreeAddItem(newtComponent co, - const char * text, const void * data, - int flags, int index, ...) { - va_list argList; - int numIndexes; - int * indexes; - int i; - - va_start(argList, index); - numIndexes = 0; - i = index; - while (i != NEWT_ARG_LAST) { - numIndexes++; - i = va_arg(argList, int); - } - - va_end(argList); - - indexes = alloca(sizeof(*indexes) * (numIndexes + 1)); - va_start(argList, index); - numIndexes = 0; - i = index; - va_start(argList, index); - while (i != NEWT_ARG_LAST) { - indexes[numIndexes++] = i; - i = va_arg(argList, int); - } - va_end(argList); - - indexes[numIndexes++] = NEWT_ARG_LAST; - - return newtCheckboxTreeAddArray(co, text, data, flags, indexes); -} - -static int doFindItemPath(struct items * items, void * data, int * path, - int * len) { - int where = 0; - - while (items) { - if (items->data == data) { - if (path) path[items->depth] = where; - if (len) *len = items->depth + 1; - return 1; - } - - if (items->branch && doFindItemPath(items->branch, data, path, len)) { - if (path) path[items->depth] = where; - return 1; - } - - items = items->next; - where++; - } - - return 0; -} - -int * newtCheckboxTreeFindItem(newtComponent co, void * data) { - int len; - int * path; - struct CheckboxTree * ct = co->data; - - if (!doFindItemPath(ct->itemlist, data, NULL, &len)) return NULL; - - path = malloc(sizeof(*path) * (len + 1)); - doFindItemPath(ct->itemlist, data, path, NULL); - path[len] = NEWT_ARG_LAST; - - return path; -} - -int newtCheckboxTreeAddArray(newtComponent co, - const char * text, const void * data, - int flags, int * indexes) { - struct items * curList, * newNode, * item = NULL; - struct items ** listPtr = NULL; - int i, index, numIndexes; - struct CheckboxTree * ct = co->data; - - numIndexes = 0; - while (indexes[numIndexes] != NEWT_ARG_LAST) numIndexes++; - - if (!ct->itemlist) { - if (numIndexes > 1) return -1; - - ct->itemlist = malloc(sizeof(*ct->itemlist)); - item = ct->itemlist; - item->prev = NULL; - item->next = NULL; - } else { - curList = ct->itemlist; - listPtr = &ct->itemlist; - - i = 0; - index = indexes[i]; - while (i < numIndexes) { - item = curList; - - if (index == NEWT_ARG_APPEND) { - item = NULL; - } else { - while (index && item) - item = item->next, index--; - } - - i++; - if (i < numIndexes) { - curList = item->branch; - listPtr = &item->branch; - if (!curList && (i + 1 != numIndexes)) return -1; - - index = indexes[i]; - } - } - - if (!curList) { /* create a new branch */ - item = malloc(sizeof(*curList->prev)); - item->next = item->prev = NULL; - *listPtr = item; - } else if (!item) { /* append to end */ - item = curList; - while (item->next) item = item->next; - item->next = malloc(sizeof(*curList->prev)); - item->next->prev = item; - item = item->next; - item->next = NULL; - } else { - newNode = malloc(sizeof(*newNode)); - newNode->prev = item->prev; - newNode->next = item; - - if (item->prev) item->prev->next = newNode; - item->prev = newNode; - item = newNode; - if (!item->prev) *listPtr = item; - } - } - - item->text = strdup(text); - item->data = data; - if (flags & NEWT_FLAG_SELECTED) { - item->selected = 1; - } else { - item->selected = 0; - } - item->flags = flags; - item->branch = NULL; - item->depth = numIndexes - 1; - - i = 4 + (3 * item->depth); - - if ((strlen(text) + i + ct->pad) > (size_t)co->width) { - co->width = strlen(text) + i + ct->pad; - } - - return 0; -} - -static struct items * findItem(struct items * items, const void * data) { - struct items * i; - - while (items) { - if (items->data == data) return items; - if (items->branch) { - i = findItem(items->branch, data); - if (i) return i; - } - - items = items->next; - } - - return NULL; -} - -static void listSelected(struct items * items, int * num, const void ** list, int seqindex) { - while (items) { - if ((seqindex ? items->selected==seqindex : items->selected) && !items->branch) - list[(*num)++] = (void *) items->data; - if (items->branch) - listSelected(items->branch, num, list, seqindex); - items = items->next; - } -} - -const void ** newtCheckboxTreeGetSelection(newtComponent co, int *numitems) -{ - return newtCheckboxTreeGetMultiSelection(co, numitems, 0); -} - -const void ** newtCheckboxTreeGetMultiSelection(newtComponent co, int *numitems, char seqnum) -{ - struct CheckboxTree * ct; - const void **retval; - int seqindex=0; - - if(!co || !numitems) return NULL; - - ct = co->data; - - if (seqnum) { - while( ct->seq[seqindex] && ( ct->seq[seqindex] != seqnum )) seqindex++; - } else { - seqindex = 0; - } - - *numitems = countItems(ct->itemlist, (seqindex ? seqindex : COUNT_SELECTED)); - if (!*numitems) return NULL; - - retval = malloc(*numitems * sizeof(void *)); - *numitems = 0; - listSelected(ct->itemlist, numitems, retval, seqindex); - - return retval; -} - -newtComponent newtCheckboxTree(int left, int top, int height, int flags) { - return newtCheckboxTreeMulti(left, top, height, NULL, flags); -} - -newtComponent newtCheckboxTreeMulti(int left, int top, int height, char *seq, int flags) { - newtComponent co; - struct CheckboxTree * ct; - - co = malloc(sizeof(*co)); - ct = malloc(sizeof(struct CheckboxTree)); - co->callback = NULL; - co->data = ct; - co->ops = &ctOps; - co->takesFocus = 1; - co->height = height; - co->width = 0; - co->isMapped = 0; - ct->itemlist = NULL; - ct->firstItem = NULL; - ct->currItem = NULL; - ct->flatList = NULL; - if (seq) - ct->seq = strdup(seq); - else - ct->seq = strdup(" *"); - if (flags & NEWT_FLAG_SCROLL) { - ct->sb = newtVerticalScrollbar(left, top, height, - COLORSET_LISTBOX, COLORSET_ACTLISTBOX); - ct->pad = 2; - } else { - ct->sb = NULL; - ct->pad = 0; - } - - return co; -} - -static void ctMapped(newtComponent co, int isMapped) { - struct CheckboxTree * ct = co->data; - - co->isMapped = isMapped; - if (ct->sb) - ct->sb->ops->mapped(ct->sb, isMapped); -} - -static void ctPlace(newtComponent co, int newLeft, int newTop) { - struct CheckboxTree * ct = co->data; - - co->top = newTop; - co->left = newLeft; - - if (ct->sb) - ct->sb->ops->place(ct->sb, co->left + co->width - 1, co->top); -} - -int ctSetItem(newtComponent co, struct items *item, enum newtFlagsSense sense) -{ - struct CheckboxTree * ct = co->data; - struct items * currItem; - struct items * firstItem; - - if (!item) - return 1; - - switch(sense) { - case NEWT_FLAGS_RESET: - item->selected = 0; - break; - case NEWT_FLAGS_SET: - item->selected = 1; - break; - case NEWT_FLAGS_TOGGLE: - if (item->branch) - item->selected = !item->selected; - else { - item->selected++; - if (item->selected==strlen(ct->seq)) - item->selected = 0; - } - break; - } - - if (item->branch) { - currItem = *ct->currItem; - firstItem = *ct->firstItem; - - buildFlatList(co); - - ct->currItem = ct->flatList; - while (*ct->currItem != currItem) ct->currItem++; - - ct->firstItem = ct->flatList; - if (ct->flatCount > co->height) { - struct items ** last = ct->flatList + ct->flatCount - co->height; - while (*ct->firstItem != firstItem && ct->firstItem != last) - ct->firstItem++; - } - } - - return 0; -} - -static void ctSetItems(struct items *item, int selected) -{ - for (; item; item = item->next) { - if (!item->branch) - item->selected = selected; - else - ctSetItems(item->branch, selected); - } -} - -static void ctDraw(newtComponent co) { - struct CheckboxTree * ct = co->data; - struct items ** item; - int i, j; - char * spaces = NULL; - int currRow = -1; - - if (!co->isMapped) return ; - - if (!ct->firstItem) { - buildFlatList(co); - ct->firstItem = ct->currItem = ct->flatList; - } - - item = ct->firstItem; - - i = 0; - while (*item && i < co->height) { - newtGotorc(co->top + i, co->left); - if (*item == *ct->currItem) { - SLsmg_set_color(NEWT_COLORSET_ACTLISTBOX); - currRow = co->top + i; - } else - SLsmg_set_color(NEWT_COLORSET_LISTBOX); - - for (j = 0; j < (*item)->depth; j++) - SLsmg_write_string(" "); - - if ((*item)->branch) { - if ((*item)->selected) - SLsmg_write_string("<-> "); - else - SLsmg_write_string("<+> "); - } else { - char tmp[5]; - snprintf(tmp,5,"[%c] ",ct->seq[(*item)->selected]); - SLsmg_write_string(tmp); - } - - SLsmg_write_nstring((*item)->text, co->width - 4 - - (3 * (*item)->depth)); - item++; - i++; - } - - /* There could be empty lines left (i.e. if the user closes an expanded - list which is the last thing in the tree, and whose elements are - displayed at the bottom of the screen */ - if (i < co->height) { - spaces = alloca(co->width); - memset(spaces, ' ', co->width); - SLsmg_set_color(NEWT_COLORSET_LISTBOX); - } - while (i < co->height) { - newtGotorc(co->top + i, co->left); - SLsmg_write_nstring(spaces, co->width); - i++; - } - - if(ct->sb) { - newtScrollbarSet(ct->sb, ct->currItem - ct->flatList, - ct->flatCount - 1); - ct->sb->ops->draw(ct->sb); - } - - newtGotorc(currRow, co->left + 1); -} - -static void ctDestroy(newtComponent co) { - struct CheckboxTree * ct = co->data; - struct items * item, * nextitem; - - nextitem = item = ct->itemlist; - - while (item != NULL) { - nextitem = item->next; - free(item->text); - free(item); - item = nextitem; - } - - free(ct->seq); - free(ct); - free(co); -} - -struct eventResult ctEvent(newtComponent co, struct event ev) { - struct CheckboxTree * ct = co->data; - struct eventResult er; - struct items ** listEnd, ** lastItem; - int key, selnum = 1; - - er.result = ER_IGNORED; - - if(ev.when == EV_EARLY || ev.when == EV_LATE) { - return er; - } - - switch(ev.event) { - case EV_KEYPRESS: - key = ev.u.key; - if (key == (char) key && key != ' ') { - for (selnum = 0; ct->seq[selnum]; selnum++) - if (key == ct->seq[selnum]) - break; - if (!ct->seq[selnum]) - switch (key) { - case '-': selnum = 0; break; - case '+': - case '*': selnum = 1; break; - } - if (ct->seq[selnum]) - key = '*'; - } - switch(key) { - case ' ': - case NEWT_KEY_ENTER: - ctSetItem(co, *ct->currItem, NEWT_FLAGS_TOGGLE); - er.result = ER_SWALLOWED; - if (!(*ct->currItem)->branch || (*ct->currItem)->selected) - key = NEWT_KEY_DOWN; - else - key = '*'; - break; - case '*': - if ((*ct->currItem)->branch) { - ctSetItems((*ct->currItem)->branch, selnum); - if (!(*ct->currItem)->selected) - key = NEWT_KEY_DOWN; - } else { - (*ct->currItem)->selected = selnum; - key = NEWT_KEY_DOWN; - } - er.result = ER_SWALLOWED; - break; - } - switch (key) { - case '*': - ctDraw(co); - if(co->callback) co->callback(co, co->callbackData); - return er; - case NEWT_KEY_HOME: - ct->currItem = ct->flatList; - ct->firstItem = ct->flatList; - ctDraw(co); - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - return er; - case NEWT_KEY_END: - ct->currItem = ct->flatList + ct->flatCount - 1; - if (ct->flatCount <= co->height) - ct->firstItem = ct->flatList; - else - ct->firstItem = ct->flatList + ct->flatCount - co->height; - ctDraw(co); - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - return er; - case NEWT_KEY_DOWN: - if (ev.u.key != NEWT_KEY_DOWN) { - if(co->callback) co->callback(co, co->callbackData); - if (strlen(ct->seq) != 2) { - ctDraw(co); - return er; - } - } - if ((ct->currItem - ct->flatList + 1) < ct->flatCount) { - ct->currItem++; - - if (ct->currItem - ct->firstItem >= co->height) - ct->firstItem++; - - ctDraw(co); - } else if (ev.u.key != NEWT_KEY_DOWN) - ctDraw(co); - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - return er; - case NEWT_KEY_UP: - if (ct->currItem != ct->flatList) { - ct->currItem--; - - if (ct->currItem < ct->firstItem) - ct->firstItem = ct->currItem; - - ctDraw(co); - } - er.result = ER_SWALLOWED; - if(co->callback) co->callback(co, co->callbackData); - return er; - case NEWT_KEY_PGUP: - if (ct->firstItem - co->height < ct->flatList) { - ct->firstItem = ct->currItem = ct->flatList; - } else { - ct->currItem -= co->height; - ct->firstItem -= co->height; - } - - ctDraw(co); - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - return er; - case NEWT_KEY_PGDN: - listEnd = ct->flatList + ct->flatCount - 1; - lastItem = ct->firstItem + co->height - 1; - - if (lastItem + co->height > listEnd) { - ct->firstItem = listEnd - co->height + 1; - ct->currItem = listEnd; - } else { - ct->currItem += co->height; - ct->firstItem += co->height; - } - - ctDraw(co); - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - return er; - } - break; - - case EV_FOCUS: - ctDraw(co); - er.result = ER_SWALLOWED; - break; - - case EV_UNFOCUS: - ctDraw(co); - er.result = ER_SWALLOWED; - break; - default: - break; - } - - return er; -} - -const void * newtCheckboxTreeGetCurrent(newtComponent co) { - struct CheckboxTree * ct = co->data; - - if (!ct->currItem) return NULL; - return (*ct->currItem)->data; -} - -void newtCheckboxTreeSetEntry(newtComponent co, const void * data, const char * text) -{ - struct CheckboxTree * ct; - struct items * item; - int i; - - if (!co) return; - ct = co->data; - item = findItem(ct->itemlist, data); - if (!item) return; - - free(item->text); - item->text = strdup(text); - - i = 4 + (3 * item->depth); - - if ((strlen(text) + i + ct->pad) > (size_t)co->width) { - co->width = strlen(text) + i + ct->pad; - } - - ctDraw(co); -} - -char newtCheckboxTreeGetEntryValue(newtComponent co, const void * data) -{ - struct CheckboxTree * ct; - struct items * item; - - if (!co) return -1; - ct = co->data; - item = findItem(ct->itemlist, data); - if (!item) return -1; - if (item->branch) - return item->selected ? NEWT_CHECKBOXTREE_EXPANDED : NEWT_CHECKBOXTREE_COLLAPSED; - else - return ct->seq[item->selected]; -} - -void newtCheckboxTreeSetEntryValue(newtComponent co, const void * data, char value) -{ - struct CheckboxTree * ct; - struct items * item; - int i; - - if (!co) return; - ct = co->data; - item = findItem(ct->itemlist, data); - if (!item || item->branch) return; - - for(i = 0; ct->seq[i]; i++) - if (value == ct->seq[i]) - break; - - if (!ct->seq[i]) return; - item->selected = i; - - ctDraw(co); -} - diff --git a/mdk-stage1/newt/entry.c b/mdk-stage1/newt/entry.c deleted file mode 100644 index 0ee449cf9..000000000 --- a/mdk-stage1/newt/entry.c +++ /dev/null @@ -1,378 +0,0 @@ -#include <ctype.h> -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct entry { - int flags; - char * buf; - char ** resultPtr; - int bufAlloced; - int bufUsed; /* amount of the buffer that's been used */ - int cursorPosition; /* cursor *in the string* on on screen */ - int firstChar; /* first character position being shown */ - newtEntryFilter filter; - void * filterData; -}; - -static void entryDraw(newtComponent co); -static void entryDestroy(newtComponent co); -static struct eventResult entryEvent(newtComponent co, - struct event ev); - -static struct eventResult entryHandleKey(newtComponent co, int key); - -static struct componentOps entryOps = { - entryDraw, - entryEvent, - entryDestroy, - newtDefaultPlaceHandler, - newtDefaultMappedHandler, -} ; - -void newtEntrySet(newtComponent co, const char * value, int cursorAtEnd) { - struct entry * en = co->data; - - if ((strlen(value) + 1) > (unsigned int)en->bufAlloced) { - free(en->buf); - en->bufAlloced = strlen(value) + 1; - en->buf = malloc(en->bufAlloced); - if (en->resultPtr) *en->resultPtr = en->buf; - } - memset(en->buf, 0, en->bufAlloced); /* clear the buffer */ - strcpy(en->buf, value); - en->bufUsed = strlen(value); - en->firstChar = 0; - if (cursorAtEnd) - en->cursorPosition = en->bufUsed; - else - en->cursorPosition = 0; - - entryDraw(co); -} ; - -newtComponent newtEntry(int left, int top, const char * initialValue, int width, - char ** resultPtr, int flags) { - newtComponent co; - struct entry * en; - - co = malloc(sizeof(*co)); - en = malloc(sizeof(struct entry)); - co->data = en; - - co->top = top; - co->left = left; - co->height = 1; - co->width = width; - co->isMapped = 0; - co->callback = NULL; - - co->ops = &entryOps; - - en->flags = flags; - en->cursorPosition = 0; - en->firstChar = 0; - en->bufUsed = 0; - en->bufAlloced = width + 1; - en->filter = NULL; - - if (!(en->flags & NEWT_FLAG_DISABLED)) - co->takesFocus = 1; - else - co->takesFocus = 0; - - if (initialValue && strlen(initialValue) > (unsigned int)width) { - en->bufAlloced = strlen(initialValue) + 1; - } - en->buf = malloc(en->bufAlloced); - en->resultPtr = resultPtr; - if (en->resultPtr) *en->resultPtr = en->buf; - - memset(en->buf, 0, en->bufAlloced); - if (initialValue) { - strcpy(en->buf, initialValue); - en->bufUsed = strlen(initialValue); - en->cursorPosition = en->bufUsed; - } else { - *en->buf = '\0'; - en->bufUsed = 0; - en->cursorPosition = 0; - } - - return co; -} - -static void entryDraw(newtComponent co) { - struct entry * en = co->data; - int i; - char * chptr; - int len; - - if (!co->isMapped) return; - - if (en->flags & NEWT_FLAG_DISABLED) - SLsmg_set_color(NEWT_COLORSET_DISENTRY); - else - SLsmg_set_color(NEWT_COLORSET_ENTRY); - - if (en->flags & NEWT_FLAG_HIDDEN) { - newtGotorc(co->top, co->left); - for (i = 0; i < co->width; i++) - SLsmg_write_char('_'); - newtGotorc(co->top, co->left); - - return; - } - - newtGotorc(co->top, co->left); - - if (en->cursorPosition < en->firstChar) { - /* scroll to the left */ - en->firstChar = en->cursorPosition; - } else if ((en->firstChar + co->width) <= en->cursorPosition) { - /* scroll to the right */ - en->firstChar = en->cursorPosition - co->width + 1; - } - - chptr = en->buf + en->firstChar; - - if (en->flags & NEWT_FLAG_PASSWORD) { - char *tmpptr, *p; - - tmpptr = alloca(strlen(chptr+2)); - strcpy(tmpptr, chptr); - for (p = tmpptr; *p; p++) - *p = '*'; - chptr = tmpptr; - } - - len = strlen(chptr); - - if (len <= co->width) { - i = len; - SLsmg_write_string(chptr); - while (i < co->width) { - SLsmg_write_char('_'); - i++; - } - } else { - SLsmg_write_nstring(chptr, co->width); - } - - if (en->flags & NEWT_FLAG_HIDDEN) - newtGotorc(co->top, co->left); - else - newtGotorc(co->top, co->left + (en->cursorPosition - en->firstChar)); -} - -void newtEntrySetFlags(newtComponent co, int flags, enum newtFlagsSense sense) { - struct entry * en = co->data; - int row, col; - - en->flags = newtSetFlags(en->flags, flags, sense); - - if (!(en->flags & NEWT_FLAG_DISABLED)) - co->takesFocus = 1; - else - co->takesFocus = 0; - - newtGetrc(&row, &col); - entryDraw(co); - newtGotorc(row, col); -} - -static void entryDestroy(newtComponent co) { - struct entry * en = co->data; - - free(en->buf); - free(en); - free(co); -} - -static struct eventResult entryEvent(newtComponent co, - struct event ev) { - struct entry * en = co->data; - struct eventResult er; - int ch; - er.result = ER_IGNORED; - er.u.focus = NULL; - - if (ev.when == EV_NORMAL) { - switch (ev.event) { - case EV_FOCUS: - newtCursorOn(); - if (en->flags & NEWT_FLAG_HIDDEN) - newtGotorc(co->top, co->left); - else - newtGotorc(co->top, co->left + - (en->cursorPosition - en->firstChar)); - er.result = ER_SWALLOWED; - break; - - case EV_UNFOCUS: - newtCursorOff(); - newtGotorc(0, 0); - er.result = ER_SWALLOWED; - if (co->callback) - co->callback(co, co->callbackData); - break; - - case EV_KEYPRESS: - ch = ev.u.key; - if (en->filter) - ch = en->filter(co, en->filterData, ch, en->cursorPosition); - if (ch) er = entryHandleKey(co, ch); - break; - - case EV_MOUSE: - if ((ev.u.mouse.type == MOUSE_BUTTON_DOWN) && - (en->flags ^ NEWT_FLAG_HIDDEN)) { - if (strlen(en->buf) >= (size_t) (ev.u.mouse.x - co->left)) { - en->cursorPosition = ev.u.mouse.x - co->left; - newtGotorc(co->top, - co->left +(en->cursorPosition - en->firstChar)); - } else { - en->cursorPosition = strlen(en->buf); - newtGotorc(co->top, - co->left +(en->cursorPosition - en->firstChar)); - } - } - break; - } - } else - er.result = ER_IGNORED; - - return er; -} - -static struct eventResult entryHandleKey(newtComponent co, int key) { - struct entry * en = co->data; - struct eventResult er; - char * chptr, * insPoint; - - er.result = ER_SWALLOWED; - switch (key) { - case '\r': /* Return */ - if (en->flags & NEWT_FLAG_RETURNEXIT) { - er.result = ER_EXITFORM; - } else { - er.result = ER_NEXTCOMP; - } - break; - - case '\001': /* ^A */ - case NEWT_KEY_HOME: - en->cursorPosition = 0; - break; - - case '\005': /* ^E */ - case NEWT_KEY_END: - en->cursorPosition = en->bufUsed; - break; - - case '\013': /* ^K */ - en->bufUsed = en->cursorPosition; - memset(en->buf + en->bufUsed, 0, en->bufAlloced - en->bufUsed); - break; - - case '\002': /* ^B */ - case NEWT_KEY_LEFT: - if (en->cursorPosition) - en->cursorPosition--; - break; - - case '\004': - case NEWT_KEY_DELETE: - chptr = en->buf + en->cursorPosition; - if (*chptr) { - chptr++; - while (*chptr) { - *(chptr - 1) = *chptr; - chptr++; - } - *(chptr - 1) = '\0'; - en->bufUsed--; - } - break; - - case NEWT_KEY_BKSPC: - if (en->cursorPosition) { - /* if this isn't true, there's nothing to erase */ - chptr = en->buf + en->cursorPosition; - en->bufUsed--; - en->cursorPosition--; - while (*chptr) { - *(chptr - 1) = *chptr; - chptr++; - } - *(chptr - 1) = '\0'; - } - break; - - case '\006': /* ^B */ - case NEWT_KEY_RIGHT: - if (en->cursorPosition < en->bufUsed) - en->cursorPosition++; - break; - - default: - if ((key >= 0x20 && key <= 0x7e) || (key >= 0xa0 && key <= 0xff)) { - if (!(en->flags & NEWT_FLAG_SCROLL) && en->bufUsed >= co->width) { - SLtt_beep(); - break; - } - - if ((en->bufUsed + 1) == en->bufAlloced) { - en->bufAlloced += 20; - en->buf = realloc(en->buf, en->bufAlloced); - if (en->resultPtr) *en->resultPtr = en->buf; - memset(en->buf + en->bufUsed + 1, 0, 20); - } - - if (en->cursorPosition == en->bufUsed) { - en->bufUsed++; - } else { - /* insert the new character */ - - /* chptr is the last character in the string */ - chptr = (en->buf + en->bufUsed) - 1; - if ((en->bufUsed + 1) == en->bufAlloced) { - /* this string fills the buffer, so clip it */ - chptr--; - } else - en->bufUsed++; - - insPoint = en->buf + en->cursorPosition; - - while (chptr >= insPoint) { - *(chptr + 1) = *chptr; - chptr--; - } - - } - - en->buf[en->cursorPosition++] = key; - } else { - er.result = ER_IGNORED; - } - } - - entryDraw(co); - - return er; -} - -char * newtEntryGetValue(newtComponent co) { - struct entry * en = co->data; - - return en->buf; -} - -void newtEntrySetFilter(newtComponent co, newtEntryFilter filter, void * data) { - struct entry * en = co->data; - en->filter = filter; - en->filterData = data; -} diff --git a/mdk-stage1/newt/form.c b/mdk-stage1/newt/form.c deleted file mode 100644 index ad7520e95..000000000 --- a/mdk-stage1/newt/form.c +++ /dev/null @@ -1,713 +0,0 @@ -#include <unistd.h> -#include <slang.h> -#include <stdarg.h> -#include <stdlib.h> -#include <string.h> -#include <sys/time.h> -#include <sys/types.h> - -#include "newt.h" -#include "newt_pr.h" - - -/**************************************************************************** - These forms handle vertical scrolling of components with a height of 1 - - Horizontal scrolling won't work, and scrolling large widgets will fail - miserably. It shouldn't be too hard to fix either of those if anyone - cares to. I only use scrolling for listboxes and text boxes though so - I didn't bother. -*****************************************************************************/ - -struct element { - int top, left; /* Actual, not virtual. These are translated */ - newtComponent co; /* into actual through vertOffset */ -}; - -struct fdInfo { - int fd; - int flags; -}; - -struct form { - int numCompsAlloced; - struct element * elements; - int numComps; - int currComp; - int fixedHeight; - int flags; - int vertOffset; - newtComponent vertBar, exitComp; - const char * help; - int numRows; - int * hotKeys; - int numHotKeys; - int background; - int beenSet; - int numFds; - struct fdInfo * fds; - int maxFd; - int timer; /* in milliseconds */ - struct timeval lastTimeout; - void * helpTag; - newtCallback helpCb; -}; - -static void gotoComponent(struct form * form, int newComp); -static struct eventResult formEvent(newtComponent co, struct event ev); -static struct eventResult sendEvent(newtComponent comp, struct event ev); -static void formPlace(newtComponent co, int left, int top); - -/* Global, ick */ -static newtCallback helpCallback; - -/* this isn't static as grid.c tests against it to find forms */ -struct componentOps formOps = { - newtDrawForm, - formEvent, - newtFormDestroy, - formPlace, - newtDefaultMappedHandler, -} ; - -static inline int componentFits(newtComponent co, int compNum) { - struct form * form = co->data; - struct element * el = form->elements + compNum; - - if ((co->top + form->vertOffset) > el->top) return 0; - if ((co->top + form->vertOffset + co->height) < - (el->top + el->co->height)) return 0; - - return 1; -} - -newtComponent newtForm(newtComponent vertBar, void * help, int flags) { - newtComponent co; - struct form * form; - - co = malloc(sizeof(*co)); - form = malloc(sizeof(*form)); - co->data = form; - co->width = 0; - co->height = 0; - co->top = -1; - co->left = -1; - co->isMapped = 0; - - co->takesFocus = 0; /* we may have 0 components */ - co->ops = &formOps; - - form->help = help; - form->flags = flags; - form->numCompsAlloced = 5; - form->numComps = 0; - form->currComp = -1; - form->vertOffset = 0; - form->fixedHeight = 0; - form->numRows = 0; - form->numFds = 0; - form->maxFd = 0; - form->fds = NULL; - form->beenSet = 0; - form->elements = malloc(sizeof(*(form->elements)) * form->numCompsAlloced); - - form->background = COLORSET_WINDOW; - form->hotKeys = malloc(sizeof(int)); - form->numHotKeys = 0; - form->timer = 0; - form->lastTimeout.tv_sec = form->lastTimeout.tv_usec = 0; - if (!(form->flags & NEWT_FLAG_NOF12)) { - newtFormAddHotKey(co, NEWT_KEY_F12); - } - - if (vertBar) - form->vertBar = vertBar; - else - form->vertBar = NULL; - - form->helpTag = help; - form->helpCb = helpCallback; - - return co; -} - -newtComponent newtFormGetCurrent(newtComponent co) { - struct form * form = co->data; - - return form->elements[form->currComp].co; -} - -void newtFormSetCurrent(newtComponent co, newtComponent subco) { - struct form * form = co->data; - int i, new; - - for (i = 0; i < form->numComps; i++) { - if (form->elements[i].co == subco) break; - } - - if (form->elements[i].co != subco) return; - new = i; - - if (co->isMapped && !componentFits(co, new)) { - gotoComponent(form, -1); - form->vertOffset = form->elements[new].top - co->top - 1; - if (form->vertOffset > (form->numRows - co->height)) - form->vertOffset = form->numRows - co->height; - } - - gotoComponent(form, new); -} - -void newtFormSetTimer(newtComponent co, int millisecs) { - struct form * form = co->data; - - form->timer = millisecs; - form->lastTimeout.tv_usec = 0; - form->lastTimeout.tv_sec = 0; -} - -void newtFormSetHeight(newtComponent co, int height) { - struct form * form = co->data; - - form->fixedHeight = 1; - co->height = height; -} - -void newtFormSetWidth(newtComponent co, int width) { - co->width = width; -} - -void newtFormAddComponent(newtComponent co, newtComponent newco) { - struct form * form = co->data; - - co->takesFocus = 1; - - if (form->numCompsAlloced == form->numComps) { - form->numCompsAlloced += 5; - form->elements = realloc(form->elements, - sizeof(*(form->elements)) * form->numCompsAlloced); - } - - /* we grab real values for these a bit later */ - form->elements[form->numComps].left = -2; - form->elements[form->numComps].top = -2; - form->elements[form->numComps].co = newco; - - if (newco->takesFocus && form->currComp == -1) - form->currComp = form->numComps; - - form->numComps++; -} - -void newtFormAddComponents(newtComponent co, ...) { - va_list ap; - newtComponent subco; - - va_start(ap, co); - - while ((subco = va_arg(ap, newtComponent))) - newtFormAddComponent(co, subco); - - va_end(ap); -} - -static void formPlace(newtComponent co, int left, int top) { - struct form * form = co->data; - int vertDelta, horizDelta; - struct element * el; - int i; - - newtFormSetSize(co); - - vertDelta = top - co->top; - horizDelta = left - co->left; - co->top = top; - co->left = left; - - for (i = 0, el = form->elements; i < form->numComps; i++, el++) { - el->co->top += vertDelta; - el->top += vertDelta; - el->co->left += horizDelta; - el->left += horizDelta; - } -} - -void newtDrawForm(newtComponent co) { - struct form * form = co->data; - struct element * el; - int i; - - newtFormSetSize(co); - - SLsmg_set_color(form->background); - newtClearBox(co->left, co->top, co->width, co->height); - for (i = 0, el = form->elements; i < form->numComps; i++, el++) { - /* the scrollbar *always* fits somewhere */ - if (el->co == form->vertBar) { - el->co->ops->mapped(el->co, 1); - el->co->ops->draw(el->co); - } else { - /* only draw it if it'll fit on the screen vertically */ - if (componentFits(co, i)) { - el->co->top = el->top - form->vertOffset; - el->co->ops->mapped(el->co, 1); - el->co->ops->draw(el->co); - } else { - el->co->ops->mapped(el->co, 0); - } - } - } - - if (form->vertBar) - newtScrollbarSet(form->vertBar, form->vertOffset, - form->numRows - co->height); -} - -static struct eventResult formEvent(newtComponent co, struct event ev) { - struct form * form = co->data; - newtComponent subco = form->elements[form->currComp].co; - int new, wrap = 0; - struct eventResult er; - int dir = 0, page = 0; - int i, num, found; - struct element * el; - - er.result = ER_IGNORED; - if (!form->numComps) return er; - - subco = form->elements[form->currComp].co; - - switch (ev.when) { - case EV_EARLY: - if (ev.event == EV_KEYPRESS) { - if (ev.u.key == NEWT_KEY_TAB) { - er.result = ER_SWALLOWED; - dir = 1; - wrap = 1; - } else if (ev.u.key == NEWT_KEY_UNTAB) { - er.result = ER_SWALLOWED; - dir = -1; - wrap = 1; - } - } - - if (form->numComps) { - i = form->currComp; - num = 0; - while (er.result == ER_IGNORED && num != form->numComps ) { - er = form->elements[i].co->ops->event(form->elements[i].co, ev); - - num++; - i++; - if (i == form->numComps) i = 0; - } - } - - break; - - case EV_NORMAL: - if (ev.event == EV_MOUSE) { - found = 0; - for (i = 0, el = form->elements; i < form->numComps; i++, el++) { - if ((el->co->top <= ev.u.mouse.y) && - (el->co->top + el->co->height > ev.u.mouse.y) && - (el->co->left <= ev.u.mouse.x) && - (el->co->left + el->co->width > ev.u.mouse.x)) { - found = 1; - if (el->co->takesFocus) { - gotoComponent(form, i); - subco = form->elements[form->currComp].co; - } - } - /* If we did not find a co to send this event to, we - should just swallow the event here. */ - } - if (!found) { - er.result = ER_SWALLOWED; - - return er; - } - } - er = subco->ops->event(subco, ev); - switch (er.result) { - case ER_NEXTCOMP: - er.result = ER_SWALLOWED; - dir = 1; - break; - - case ER_EXITFORM: - form->exitComp = subco; - break; - - default: - break; - } - break; - - case EV_LATE: - er = subco->ops->event(subco, ev); - - if (er.result == ER_IGNORED) { - switch (ev.u.key) { - case NEWT_KEY_UP: - case NEWT_KEY_LEFT: - case NEWT_KEY_BKSPC: - er.result = ER_SWALLOWED; - dir = -1; - break; - - case NEWT_KEY_DOWN: - case NEWT_KEY_RIGHT: - er.result = ER_SWALLOWED; - dir = 1; - break; - - case NEWT_KEY_PGUP: - er.result = ER_SWALLOWED; - dir = -1; - page = 1; - break; - - case NEWT_KEY_PGDN: - er.result = ER_SWALLOWED; - dir = 1; - page = 1; - break; - } - } - } - - if (dir) { - new = form->currComp; - - if (page) { - new += dir * co->height; - if (new < 0) - new = 0; - else if (new >= form->numComps) - new = (form->numComps - 1); - - while (!form->elements[new].co->takesFocus) - new = new - dir; - } else { - do { - new += dir; - - if (wrap) { - if (new < 0) - new = form->numComps - 1; - else if (new >= form->numComps) - new = 0; - } else if (new < 0 || new >= form->numComps) - return er; - } while (!form->elements[new].co->takesFocus); - } - - /* make sure this component is visible */ - if (!componentFits(co, new)) { - gotoComponent(form, -1); - - if (dir < 0) { - /* make the new component the first one */ - form->vertOffset = form->elements[new].top - co->top; - } else { - /* make the new component the last one */ - form->vertOffset = (form->elements[new].top + - form->elements[new].co->height) - - (co->top + co->height); - } - - if (form->vertOffset < 0) form->vertOffset = 0; - if (form->vertOffset > (form->numRows - co->height)) - form->vertOffset = form->numRows - co->height; - - newtDrawForm(co); - } - - gotoComponent(form, new); - er.result = ER_SWALLOWED; - } - - return er; -} - -/* this also destroys all of the components on the form */ -void newtFormDestroy(newtComponent co) { - newtComponent subco; - struct form * form = co->data; - int i; - - /* first, destroy all of the components */ - for (i = 0; i < form->numComps; i++) { - subco = form->elements[i].co; - if (subco->ops->destroy) { - subco->ops->destroy(subco); - } else { - if (subco->data) free(subco->data); - free(subco); - } - } - - if (form->hotKeys) free(form->hotKeys); - - free(form->elements); - free(form); - free(co); -} - -newtComponent newtRunForm(newtComponent co) { - struct newtExitStruct es; - - newtFormRun(co, &es); - if (es.reason == NEWT_EXIT_HOTKEY) { - if (es.u.key == NEWT_KEY_F12) { - es.reason = NEWT_EXIT_COMPONENT; - es.u.co = co; - } else { - return NULL; - } - } - - return es.u.co; -} - -void newtFormAddHotKey(newtComponent co, int key) { - struct form * form = co->data; - - form->numHotKeys++; - form->hotKeys = realloc(form->hotKeys, sizeof(int) * form->numHotKeys); - form->hotKeys[form->numHotKeys - 1] = key; -} - -void newtFormSetSize(newtComponent co) { - struct form * form = co->data; - int delta, i; - struct element * el; - - if (form->beenSet) return; - - form->beenSet = 1; - - if (!form->numComps) return; - - co->width = 0; - if (!form->fixedHeight) co->height = 0; - - co->top = form->elements[0].co->top; - co->left = form->elements[0].co->left; - for (i = 0, el = form->elements; i < form->numComps; i++, el++) { - if (el->co->ops == &formOps) - newtFormSetSize(el->co); - - el->left = el->co->left; - el->top = el->co->top; - - if (co->left > el->co->left) { - delta = co->left - el->co->left; - co->left -= delta; - co->width += delta; - } - - if (co->top > el->co->top) { - delta = co->top - el->co->top; - co->top -= delta; - if (!form->fixedHeight) - co->height += delta; - } - - if ((co->left + co->width) < (el->co->left + el->co->width)) - co->width = (el->co->left + el->co->width) - co->left; - - if (!form->fixedHeight) { - if ((co->top + co->height) < (el->co->top + el->co->height)) - co->height = (el->co->top + el->co->height) - co->top; - } - - if ((el->co->top + el->co->height - co->top) > form->numRows) { - form->numRows = el->co->top + el->co->height - co->top; - } - } -} - -void newtFormRun(newtComponent co, struct newtExitStruct * es) { - struct form * form = co->data; - struct event ev; - struct eventResult er; - int key, i, max; - int done = 0; - fd_set readSet, writeSet; - struct timeval nextTimeout, now, timeout; - - newtFormSetSize(co); - /* draw all of the components */ - newtDrawForm(co); - - if (form->currComp == -1) { - gotoComponent(form, 0); - } else - gotoComponent(form, form->currComp); - - while (!done) { - newtRefresh(); - - FD_ZERO(&readSet); - FD_ZERO(&writeSet); - FD_SET(0, &readSet); - max = form->maxFd; - - for (i = 0; i < form->numFds; i++) { - if (form->fds[i].flags & NEWT_FD_READ) - FD_SET(form->fds[i].fd, &readSet); - if (form->fds[i].flags & NEWT_FD_WRITE) - FD_SET(form->fds[i].fd, &writeSet); - } - - if (form->timer) { - /* Calculate when we next need to return with a timeout. Do - this inside the loop in case a callback resets the timer. */ - if (!form->lastTimeout.tv_sec && !form->lastTimeout.tv_usec) - gettimeofday(&form->lastTimeout, NULL); - - nextTimeout.tv_sec = form->lastTimeout.tv_sec + - (form->timer / 1000); - nextTimeout.tv_usec = form->lastTimeout.tv_usec + - (form->timer % 1000) * 1000; - - gettimeofday(&now, 0); - - if (now.tv_sec > nextTimeout.tv_sec) { - timeout.tv_sec = timeout.tv_usec = 0; - } else if (now.tv_sec == nextTimeout.tv_sec) { - timeout.tv_sec = 0; - if (now.tv_usec > nextTimeout.tv_usec) - timeout.tv_usec = 0; - else - timeout.tv_usec = nextTimeout.tv_usec - now.tv_usec; - } else if (now.tv_sec < nextTimeout.tv_sec) { - timeout.tv_sec = nextTimeout.tv_sec - now.tv_sec; - if (now.tv_usec > nextTimeout.tv_usec) - timeout.tv_sec--, - timeout.tv_usec = nextTimeout.tv_usec + 1000000 - - now.tv_usec; - else - timeout.tv_usec = nextTimeout.tv_usec - now.tv_usec; - } - } else { - timeout.tv_sec = timeout.tv_usec = 0; - } - - i = select(max + 1, &readSet, &writeSet, NULL, - form->timer ? &timeout : NULL); - if (i < 0) continue; /* ?? What should we do here? */ - - if (i == 0) { - done = 1; - es->reason = NEWT_EXIT_TIMER; - gettimeofday(&form->lastTimeout, NULL); - } else - { - if (FD_ISSET(0, &readSet)) { - - key = newtGetKey(); - - if (key == NEWT_KEY_RESIZE) { - /* newtResizeScreen(1); */ - continue; - } - - for (i = 0; i < form->numHotKeys; i++) { - if (form->hotKeys[i] == key) { - es->reason = NEWT_EXIT_HOTKEY; - es->u.key = key; - done = 1; - break; - } - } - - if (key == NEWT_KEY_F1 && form->helpTag && form->helpCb) - form->helpCb(co, form->helpTag); - - if (!done) { - ev.event = EV_KEYPRESS; - ev.u.key = key; - - er = sendEvent(co, ev); - - if (er.result == ER_EXITFORM) { - done = 1; - es->reason = NEWT_EXIT_COMPONENT; - es->u.co = form->exitComp; - } - } - } else { - es->reason = NEWT_EXIT_FDREADY; - done = 1; - } - } - } - newtRefresh(); -} - -static struct eventResult sendEvent(newtComponent co, struct event ev) { - struct eventResult er; - - ev.when = EV_EARLY; - er = co->ops->event(co, ev); - - if (er.result == ER_IGNORED) { - ev.when = EV_NORMAL; - er = co->ops->event(co, ev); - } - - if (er.result == ER_IGNORED) { - ev.when = EV_LATE; - er = co->ops->event(co, ev); - } - - return er; -} - -static void gotoComponent(struct form * form, int newComp) { - struct event ev; - - if (form->currComp != -1) { - ev.event = EV_UNFOCUS; - sendEvent(form->elements[form->currComp].co, ev); - } - - form->currComp = newComp; - - if (form->currComp != -1) { - ev.event = EV_FOCUS; - ev.when = EV_NORMAL; - sendEvent(form->elements[form->currComp].co, ev); - } -} - -void newtComponentAddCallback(newtComponent co, newtCallback f, void * data) { - co->callback = f; - co->callbackData = data; -} - -void newtComponentTakesFocus(newtComponent co, int val) { - co->takesFocus = val; -} - -void newtFormSetBackground(newtComponent co, int color) { - struct form * form = co->data; - - form->background = color; -} - -void newtFormWatchFd(newtComponent co, int fd, int fdFlags) { - struct form * form = co->data; - - form->fds = realloc(form->fds, (form->numFds + 1) * sizeof(*form->fds)); - form->fds[form->numFds].fd = fd; - form->fds[form->numFds++].flags = fdFlags; - if (form->maxFd < fd) form->maxFd = fd; -} - -void newtSetHelpCallback(newtCallback cb) { - helpCallback = cb; -} diff --git a/mdk-stage1/newt/grid.c b/mdk-stage1/newt/grid.c deleted file mode 100644 index 37d2b2e74..000000000 --- a/mdk-stage1/newt/grid.c +++ /dev/null @@ -1,389 +0,0 @@ -#include <alloca.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct gridField { - enum newtGridElement type; - union { - newtGrid grid; - newtComponent co; - } u; - int padLeft, padTop, padRight, padBottom; - int anchor; - int flags; -}; - -struct grid_s { - int rows, cols; - int width, height; /* totals, -1 means unknown */ - struct gridField ** fields; -}; - -/* this is a bit of a hack */ -extern struct componentOps formOps[]; - -newtGrid newtCreateGrid(int cols, int rows) { - newtGrid grid; - - grid = malloc(sizeof(*grid)); - grid->rows = rows; - grid->cols = cols; - - grid->fields = malloc(sizeof(*grid->fields) * cols); - while (cols--) { - grid->fields[cols] = malloc(sizeof(**(grid->fields)) * rows); - memset(grid->fields[cols], 0, sizeof(**(grid->fields)) * rows); - } - - grid->width = grid->height = -1; - - return grid; -} - -void newtGridSetField(newtGrid grid, int col, int row, - enum newtGridElement type, void * val, int padLeft, - int padTop, int padRight, int padBottom, int anchor, - int flags) { - struct gridField * field = &grid->fields[col][row]; - - if (field->type == NEWT_GRID_SUBGRID) - newtGridFree(field->u.grid, 1); - - field->type = type; - field->u.co = (void *) val; - - field->padLeft = padLeft; - field->padRight = padRight; - field->padTop = padTop; - field->padBottom = padBottom; - field->anchor = anchor; - field->flags = flags; - - grid->width = grid->height = -1; -} - -static void distSpace(int extra, int items, int * list) { - int all, some, i; - - all = extra / items; - some = extra % items; - for (i = 0; i < items; i++) { - list[i] += all; - if (some) { - list[i]++; - some--; - } - } -} - -static void shuffleGrid(newtGrid grid, int left, int top, int set) { - struct gridField * field; - int row, col; - int i, j; - int minWidth, minHeight; - int * widths, * heights; - int thisLeft, thisTop; - int x, y, remx, remy; - - widths = alloca(sizeof(*widths) * grid->cols); - memset(widths, 0, sizeof(*widths) * grid->cols); - heights = alloca(sizeof(*heights) * grid->rows); - memset(heights, 0, sizeof(*heights) * grid->rows); - - minWidth = 0; - for (row = 0; row < grid->rows; row++) { - i = 0; - for (col = 0; col < grid->cols; col++) { - field = &grid->fields[col][row]; - if (field->type == NEWT_GRID_SUBGRID) { - /* we'll have to redo this later */ - if (field->u.grid->width == -1) - shuffleGrid(field->u.grid, left, top, 0); - j = field->u.grid->width; - } else if (field->type == NEWT_GRID_COMPONENT) { - if (field->u.co->ops == formOps) - newtFormSetSize(field->u.co); - j = field->u.co->width; - } else - j = 0; - - j += field->padLeft + field->padRight; - - if (j > widths[col]) widths[col] = j; - i += widths[col]; - } - - if (i > minWidth) minWidth = i; - } - - minHeight = 0; - for (col = 0; col < grid->cols; col++) { - i = 0; - for (row = 0; row < grid->rows; row++) { - field = &grid->fields[col][row]; - if (field->type == NEWT_GRID_SUBGRID) { - /* we'll have to redo this later */ - if (field->u.grid->height == -1) - shuffleGrid(field->u.grid, 0, 0, 0); - j = field->u.grid->height; - } else if (field->type == NEWT_GRID_COMPONENT){ - j = field->u.co->height; - } else - j = 0; - - j += field->padTop + field->padBottom; - - if (j > heights[row]) heights[row] = j; - i += heights[row]; - } - - if (i > minHeight) minHeight = i; - } - - /* this catches the -1 case */ - if (grid->width < minWidth) grid->width = minWidth; /* ack! */ - if (grid->height < minHeight) grid->height = minHeight; /* ditto! */ - - if (!set) return; - - distSpace(grid->width - minWidth, grid->cols, widths); - distSpace(grid->height - minHeight, grid->rows, heights); - - thisTop = top; - for (row = 0; row < grid->rows; row++) { - i = 0; - thisLeft = left; - for (col = 0; col < grid->cols; col++) { - field = &grid->fields[col][row]; - - if (field->type == NEWT_GRID_EMPTY) continue; - - x = thisLeft + field->padLeft; - remx = widths[col] - field->padLeft - field->padRight; - y = thisTop + field->padTop; - remy = heights[row] - field->padTop - field->padBottom; - - if (field->type == NEWT_GRID_SUBGRID) { - remx -= field->u.grid->width; - remy -= field->u.grid->height; - } else if (field->type == NEWT_GRID_COMPONENT) { - remx -= field->u.co->width; - remy -= field->u.co->height; - } - - if (!(field->flags & NEWT_GRID_FLAG_GROWX)) { - if (field->anchor & NEWT_ANCHOR_RIGHT) - x += remx; - else if (!(field->anchor & NEWT_ANCHOR_LEFT)) - x += (remx / 2); - } - - if (!(field->flags & NEWT_GRID_FLAG_GROWY)) { - if (field->anchor & NEWT_ANCHOR_BOTTOM) - y += remx; - else if (!(field->anchor & NEWT_ANCHOR_TOP)) - y += (remy / 2); - } - - if (field->type == NEWT_GRID_SUBGRID) { - if (field->flags & NEWT_GRID_FLAG_GROWX) - field->u.grid->width = widths[col] - field->padLeft - - field->padRight; - if (field->flags & NEWT_GRID_FLAG_GROWY) - field->u.grid->height = heights[col] - field->padTop - - field->padBottom; - - shuffleGrid(field->u.grid, x, y, 1); - } else if (field->type == NEWT_GRID_COMPONENT) { - field->u.co->ops->place(field->u.co, x, y); - } - - thisLeft += widths[col]; - } - - thisTop += heights[row]; - } -} - -void newtGridPlace(newtGrid grid, int left, int top) { - shuffleGrid(grid, left, top, 1); -} - -void newtGridFree(newtGrid grid, int recurse) { - int row, col; - - for (col = 0; col < grid->cols; col++) { - if (recurse) { - for (row = 0; row < grid->rows; row++) { - if (grid->fields[col][row].type == NEWT_GRID_SUBGRID) - newtGridFree(grid->fields[col][row].u.grid, 1); - } - } - - free(grid->fields[col]); - } - - free(grid->fields); - free(grid); -} - -void newtGridGetSize(newtGrid grid, int * width, int * height) { - if (grid->width == -1 || grid->height == -1) { - grid->width = grid->height = -1; - shuffleGrid(grid, 0, 0, 1); - } - - *width = grid->width; - *height = grid->height; -} - -void newtGridWrappedWindow(newtGrid grid, char * title) { - int width, height, offset = 0; - - newtGridGetSize(grid, &width, &height); - if ((size_t)width < strlen(title) + 2) { - offset = ((strlen(title) + 2) - width) / 2; - width = strlen(title) + 2; - } - newtCenteredWindow(width + 2, height + 2, title); - newtGridPlace(grid, 1 + offset, 1); -} - -void newtGridWrappedWindowAt(newtGrid grid, char * title, int left, int top) { - int width, height; - - newtGridGetSize(grid, &width, &height); - newtOpenWindow(left, top, width + 2, height + 2, title); - newtGridPlace(grid, 1, 1); -} - -void newtGridAddComponentsToForm(newtGrid grid, newtComponent form, - int recurse) { - int row, col; - - for (col = 0; col < grid->cols; col++) { - for (row = 0; row < grid->rows; row++) { - if (grid->fields[col][row].type == NEWT_GRID_SUBGRID && recurse) - newtGridAddComponentsToForm(grid->fields[col][row].u.grid, - form, 1); - else if (grid->fields[col][row].type == NEWT_GRID_COMPONENT) - newtFormAddComponent(form, grid->fields[col][row].u.co); - } - } -} - -/* this handles up to 50 items */ -static newtGrid stackem(int isVert, enum newtGridElement type1, void * what1, - va_list args, int close) { - struct item { - enum newtGridElement type; - void * what; - } items[50]; - int i, num; - newtGrid grid; - - items[0].type = type1, items[0].what = what1, num = 1; - while (1) { - items[num].type = va_arg(args, enum newtGridElement); - if (items[num].type == NEWT_GRID_EMPTY) break; - - items[num].what = va_arg(args, void *); - num++; - } - - grid = newtCreateGrid(isVert ? 1 : num, isVert ? num : 1); - - for (i = 0; i < num; i++) { - newtGridSetField(grid, isVert ? 0 : i, isVert ? i : 0, - items[i].type, items[i].what, - close ? 0 : (i ? (isVert ? 0 : 1) : 0), - close ? 0 : (i ? (isVert ? 1 : 0) : 0), 0, 0, 0, 0); - } - - return grid; -} - -newtGrid newtGridHCloseStacked(enum newtGridElement type1, void * what1, ...) { - va_list args; - newtGrid grid; - - va_start(args, what1); - - grid = stackem(0, type1, what1, args, 1); - - va_start(args, what1); - - return grid; -} - -newtGrid newtGridVCloseStacked(enum newtGridElement type1, void * what1, ...) { - va_list args; - newtGrid grid; - - va_start(args, what1); - - grid = stackem(1, type1, what1, args, 1); - - va_start(args, what1); - - return grid; -} - -newtGrid newtGridVStacked(enum newtGridElement type1, void * what1, ...) { - va_list args; - newtGrid grid; - - va_start(args, what1); - - grid = stackem(1, type1, what1, args, 0); - - va_start(args, what1); - - return grid; -} - -newtGrid newtGridHStacked(enum newtGridElement type1, void * what1, ...) { - va_list args; - newtGrid grid; - - va_start(args, what1); - - grid = stackem(0, type1, what1, args, 0); - - va_start(args, what1); - - return grid; -} - -newtGrid newtGridBasicWindow(newtComponent text, newtGrid middle, - newtGrid buttons) { - newtGrid grid; - - grid = newtCreateGrid(1, 3); - newtGridSetField(grid, 0, 0, NEWT_GRID_COMPONENT, text, - 0, 0, 0, 0, NEWT_ANCHOR_LEFT, 0); - newtGridSetField(grid, 0, 1, NEWT_GRID_SUBGRID, middle, - 0, 1, 0, 0, 0, 0); - newtGridSetField(grid, 0, 2, NEWT_GRID_SUBGRID, buttons, - 0, 1, 0, 0, 0, NEWT_GRID_FLAG_GROWX); - - return grid; -} - -newtGrid newtGridSimpleWindow(newtComponent text, newtComponent middle, - newtGrid buttons) { - newtGrid grid; - - grid = newtCreateGrid(1, 3); - newtGridSetField(grid, 0, 0, NEWT_GRID_COMPONENT, text, - 0, 0, 0, 0, NEWT_ANCHOR_LEFT, 0); - newtGridSetField(grid, 0, 1, NEWT_GRID_COMPONENT, middle, - 0, 1, 0, 0, 0, 0); - newtGridSetField(grid, 0, 2, NEWT_GRID_SUBGRID, buttons, - 0, 1, 0, 0, 0, NEWT_GRID_FLAG_GROWX); - - return grid; -} diff --git a/mdk-stage1/newt/label.c b/mdk-stage1/newt/label.c deleted file mode 100644 index f1a9cebbf..000000000 --- a/mdk-stage1/newt/label.c +++ /dev/null @@ -1,81 +0,0 @@ -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct label { - char * text; - int length; -}; - -static void labelDraw(newtComponent co); -static void labelDestroy(newtComponent co); - -static struct componentOps labelOps = { - labelDraw, - newtDefaultEventHandler, - labelDestroy, - newtDefaultPlaceHandler, - newtDefaultMappedHandler, -} ; - -newtComponent newtLabel(int left, int top, const char * text) { - newtComponent co; - struct label * la; - - co = malloc(sizeof(*co)); - la = malloc(sizeof(struct label)); - co->data = la; - - co->ops = &labelOps; - - co->height = 1; - co->width = strlen(text); - co->top = top; - co->left = left; - co->takesFocus = 0; - - la->length = strlen(text); - la->text = strdup(text); - - return co; -} - -void newtLabelSetText(newtComponent co, const char * text) { - int newLength; - struct label * la = co->data; - - newLength = strlen(text); - if (newLength <= la->length) { - memset(la->text, ' ', la->length); - memcpy(la->text, text, newLength); - } else { - free(la->text); - la->text = strdup(text); - la->length = newLength; - co->width = newLength; - } - - labelDraw(co); -} - -static void labelDraw(newtComponent co) { - struct label * la = co->data; - - if (co->isMapped == -1) return; - - SLsmg_set_color(COLORSET_LABEL); - - newtGotorc(co->top, co->left); - SLsmg_write_string(la->text); -} - -static void labelDestroy(newtComponent co) { - struct label * la = co->data; - - free(la->text); - free(la); - free(co); -} diff --git a/mdk-stage1/newt/listbox.c b/mdk-stage1/newt/listbox.c deleted file mode 100644 index 0048c3782..000000000 --- a/mdk-stage1/newt/listbox.c +++ /dev/null @@ -1,752 +0,0 @@ -/* This goofed-up box whacked into shape by Elliot Lee <sopwith@cuc.edu> - (from the original listbox by Erik Troan <ewt@redhat.com>) - and contributed to newt for use under the LGPL license. - Copyright (C) 1996, 1997 Elliot Lee */ - -#include <slang.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <ctype.h> - -#include "newt.h" -#include "newt_pr.h" - - -/* Linked list of items in the listbox */ -struct items { - char * text; - const void *data; - unsigned char isSelected; - struct items *next; -}; - -/* Holds all the relevant information for this listbox */ -struct listbox { - newtComponent sb; /* Scrollbar on right side of listbox */ - int curWidth; /* size of text w/o scrollbar or border*/ - int curHeight; /* size of text w/o border */ - int sbAdjust; - int bdxAdjust, bdyAdjust; - int numItems, numSelected; - int userHasSetWidth; - int currItem, startShowItem; /* startShowItem is the first item displayed - on the screen */ - int isActive; /* If we handle key events all the time, it seems - to do things even when they are supposed to be for - another button/whatever */ - struct items *boxItems; - int grow; - int flags; /* flags for this listbox, right now just - NEWT_FLAG_RETURNEXIT */ -}; - -static void listboxDraw(newtComponent co); -static void listboxDestroy(newtComponent co); -static struct eventResult listboxEvent(newtComponent co, struct event ev); -static void newtListboxRealSetCurrent(newtComponent co); -static void listboxPlace(newtComponent co, int newLeft, int newTop); -static inline void updateWidth(newtComponent co, struct listbox * li, - int maxField); -static void listboxMapped(newtComponent co, int isMapped); - -static struct componentOps listboxOps = { - listboxDraw, - listboxEvent, - listboxDestroy, - listboxPlace, - listboxMapped, -}; - -static void listboxMapped(newtComponent co, int isMapped) { - struct listbox * li = co->data; - - co->isMapped = isMapped; - if (li->sb) - li->sb->ops->mapped(li->sb, isMapped); -} - -static void listboxPlace(newtComponent co, int newLeft, int newTop) { - struct listbox * li = co->data; - - co->top = newTop; - co->left = newLeft; - - if (li->sb) - li->sb->ops->place(li->sb, co->left + co->width - li->bdxAdjust - 1, - co->top); -} - -newtComponent newtListbox(int left, int top, int height, int flags) { - newtComponent co, sb; - struct listbox * li; - - if (!(co = malloc(sizeof(*co)))) - return NULL; - - if (!(li = malloc(sizeof(struct listbox)))) { - free(co); - return NULL; - } - - li->boxItems = NULL; - li->numItems = 0; - li->currItem = 0; - li->numSelected = 0; - li->isActive = 0; - li->userHasSetWidth = 0; - li->startShowItem = 0; - li->sbAdjust = 0; - li->bdxAdjust = 0; - li->bdyAdjust = 0; - li->flags = flags & (NEWT_FLAG_RETURNEXIT | NEWT_FLAG_BORDER | - NEWT_FLAG_MULTIPLE); - - if (li->flags & NEWT_FLAG_BORDER) { - li->bdxAdjust = 2; - li->bdyAdjust = 1; - } - - co->height = height; - li->curHeight = co->height - (2 * li->bdyAdjust); - - if (height) { - li->grow = 0; - if (flags & NEWT_FLAG_SCROLL) { - sb = newtVerticalScrollbar(left, top + li->bdyAdjust, - li->curHeight, - COLORSET_LISTBOX, COLORSET_ACTLISTBOX); - li->sbAdjust = 3; - } else { - sb = NULL; - } - } else { - li->grow = 1; - sb = NULL; - } - - li->sb = sb; - co->data = li; - co->isMapped = 0; - co->left = left; - co->top = top; - co->ops = &listboxOps; - co->takesFocus = 1; - co->callback = NULL; - - updateWidth(co, li, 5); - - return co; -} - -static inline void updateWidth(newtComponent co, struct listbox * li, - int maxField) { - li->curWidth = maxField; - co->width = li->curWidth + li->sbAdjust + 2 * li->bdxAdjust; - - if (li->sb) - li->sb->left = co->left + co->width - li->bdxAdjust - 1; -} - -void newtListboxSetCurrentByKey(newtComponent co, void * key) { - struct listbox * li = co->data; - struct items * item; - int i; - - item = li->boxItems, i = 0; - while (item && item->data != key) - item = item->next, i++; - - if (item) - newtListboxSetCurrent(co, i); -} - -void newtListboxSetCurrent(newtComponent co, int num) -{ - struct listbox * li = co->data; - - if (num >= li->numItems) - li->currItem = li->numItems - 1; - else if (num < 0) - li->currItem = 0; - else - li->currItem = num; - - if (li->currItem < li->startShowItem) - li->startShowItem = li->currItem; - else if (li->currItem - li->startShowItem > li->curHeight - 1) - li->startShowItem = li->currItem - li->curHeight + 1; - if (li->startShowItem + li->curHeight > li->numItems) - li->startShowItem = li->numItems - li->curHeight; - if(li->startShowItem < 0) - li->startShowItem = 0; - - newtListboxRealSetCurrent(co); -} - -static void newtListboxRealSetCurrent(newtComponent co) -{ - struct listbox * li = co->data; - - if(li->sb) - newtScrollbarSet(li->sb, li->currItem + 1, li->numItems); - listboxDraw(co); - if(co->callback) co->callback(co, co->callbackData); -} - -void newtListboxSetWidth(newtComponent co, int width) { - struct listbox * li = co->data; - - co->width = width; - li->curWidth = co->width - li->sbAdjust - 2 * li->bdxAdjust; - li->userHasSetWidth = 1; - if (li->sb) li->sb->left = co->width + co->left - 1; - listboxDraw(co); -} - -void * newtListboxGetCurrent(newtComponent co) { - struct listbox * li = co->data; - int i; - struct items *item; - - for(i = 0, item = li->boxItems; item != NULL && i < li->currItem; - i++, item = item->next); - - if (item) - return (void *)item->data; - else - return NULL; -} - -void newtListboxSelectItem(newtComponent co, const void * key, - enum newtFlagsSense sense) -{ - struct listbox * li = co->data; - int i; - struct items * item; - - item = li->boxItems, i = 0; - while (item && item->data != key) - item = item->next, i++; - - if (!item) return; - - if (item->isSelected) - li->numSelected--; - - switch(sense) { - case NEWT_FLAGS_RESET: - item->isSelected = 0; break; - case NEWT_FLAGS_SET: - item->isSelected = 1; break; - case NEWT_FLAGS_TOGGLE: - item->isSelected = !item->isSelected; - } - - if (item->isSelected) - li->numSelected++; - - listboxDraw(co); -} - -void newtListboxClearSelection(newtComponent co) -{ - struct items *item; - struct listbox * li = co->data; - - for(item = li->boxItems; item != NULL; - item = item->next) - item->isSelected = 0; - li->numSelected = 0; - listboxDraw(co); -} - -/* Free the returned array after use, but NOT the values in the array */ -void ** newtListboxGetSelection(newtComponent co, int *numitems) -{ - struct listbox * li; - int i; - void **retval; - struct items *item; - - if(!co || !numitems) return NULL; - - li = co->data; - if(!li || !li->numSelected) return NULL; - - retval = malloc(li->numSelected * sizeof(void *)); - for(i = 0, item = li->boxItems; item != NULL; - item = item->next) - if(item->isSelected) - retval[i++] = (void *)item->data; - *numitems = li->numSelected; - return retval; -} - -void newtListboxSetEntry(newtComponent co, int num, const char * text) { - struct listbox * li = co->data; - int i; - struct items *item; - - for(i = 0, item = li->boxItems; item != NULL && i < num; - i++, item = item->next); - - if(!item) - return; - else { - free(item->text); - item->text = strdup(text); - } - if (li->userHasSetWidth == 0 && strlen(text) > (size_t)li->curWidth) { - updateWidth(co, li, strlen(text)); - } - - if (num >= li->startShowItem && num <= li->startShowItem + co->height) - listboxDraw(co); -} - -void newtListboxSetData(newtComponent co, int num, void * data) { - struct listbox * li = co->data; - int i; - struct items *item; - - for(i = 0, item = li->boxItems; item != NULL && i < num; - i++, item = item->next); - - item->data = data; -} - -int newtListboxAppendEntry(newtComponent co, const char * text, - const void * data) { - struct listbox * li = co->data; - struct items *item; - - if(li->boxItems) { - for (item = li->boxItems; item->next != NULL; item = item->next); - - item = item->next = malloc(sizeof(struct items)); - } else { - item = li->boxItems = malloc(sizeof(struct items)); - } - - if (!li->userHasSetWidth && text && (strlen(text) > (size_t)li->curWidth)) - updateWidth(co, li, strlen(text)); - - item->text = strdup(text); item->data = data; item->next = NULL; - item->isSelected = 0; - - if (li->grow) - co->height++, li->curHeight++; - li->numItems++; - - return 0; -} - -int newtListboxInsertEntry(newtComponent co, const char * text, - const void * data, void * key) { - struct listbox * li = co->data; - struct items *item, *t; - - if (li->boxItems) { - if (key) { - item = li->boxItems; - while (item && item->data != key) item = item->next; - - if (!item) return 1; - - t = item->next; - item = item->next = malloc(sizeof(struct items)); - item->next = t; - } else { - t = li->boxItems; - item = li->boxItems = malloc(sizeof(struct items)); - item->next = t; - } - } else if (key) { - return 1; - } else { - item = li->boxItems = malloc(sizeof(struct items)); - item->next = NULL; - } - - if (!li->userHasSetWidth && text && (strlen(text) > (size_t)li->curWidth)) - updateWidth(co, li, strlen(text)); - - item->text = strdup(text?text:"(null)"); item->data = data; - item->isSelected = 0; - - if (li->sb) - li->sb->left = co->left + co->width - li->bdxAdjust - 1; - li->numItems++; - - listboxDraw(co); - - return 0; -} - -int newtListboxDeleteEntry(newtComponent co, void * key) { - struct listbox * li = co->data; - int widest = 0, t; - struct items *item, *item2 = NULL; - int num; - - if (li->boxItems == NULL || li->numItems <= 0) - return 0; - - num = 0; - - item2 = NULL, item = li->boxItems; - while (item && item->data != key) { - item2 = item; - item = item->next; - num++; - } - - if (!item) - return -1; - - if (item2) - item2->next = item->next; - else - li->boxItems = item->next; - - free(item->text); - free(item); - li->numItems--; - - if (!li->userHasSetWidth) { - widest = 0; - for (item = li->boxItems; item != NULL; item = item->next) - if ((t = strlen(item->text)) > widest) widest = t; - } - - if (li->currItem >= num) - li->currItem--; - - if (!li->userHasSetWidth) { - updateWidth(co, li, widest); - } - - listboxDraw(co); - - return 0; -} - -void newtListboxClear(newtComponent co) -{ - struct listbox * li; - struct items *anitem, *nextitem; - if(co == NULL || (li = co->data) == NULL) - return; - for(anitem = li->boxItems; anitem != NULL; anitem = nextitem) { - nextitem = anitem->next; - free(anitem->text); - free(anitem); - } - li->numItems = li->numSelected = li->currItem = li->startShowItem = 0; - li->boxItems = NULL; - if (!li->userHasSetWidth) - updateWidth(co, li, 5); -} - -/* If you don't want to get back the text, pass in NULL for the ptr-ptr. Same - goes for the data. */ -void newtListboxGetEntry(newtComponent co, int num, char **text, void **data) { - struct listbox * li = co->data; - int i; - struct items *item; - - if (!li->boxItems || num >= li->numItems) { - if(text) - *text = NULL; - if(data) - *data = NULL; - return; - } - - i = 0; - item = li->boxItems; - while (item && i < num) { - i++, item = item->next; - } - - if (item) { - if (text) - *text = item->text; - if (data) - *data = (void *)item->data; - } -} - -static void listboxDraw(newtComponent co) -{ - struct listbox * li = co->data; - struct items *item; - int i, j; - - if (!co->isMapped) return ; - - if(li->flags & NEWT_FLAG_BORDER) { - if(li->isActive) - SLsmg_set_color(NEWT_COLORSET_ACTLISTBOX); - else - SLsmg_set_color(NEWT_COLORSET_LISTBOX); - - newtDrawBox(co->left, co->top, co->width, co->height, 0); - } - - if(li->sb) - li->sb->ops->draw(li->sb); - - SLsmg_set_color(NEWT_COLORSET_LISTBOX); - - for(i = 0, item = li->boxItems; item != NULL && i < li->startShowItem; - i++, item = item->next); - - j = i; - - for (i = 0; item != NULL && i < li->curHeight; i++, item = item->next) { - if (!item->text) continue; - - newtGotorc(co->top + i + li->bdyAdjust, co->left + li->bdxAdjust); - if(j + i == li->currItem) { - if(item->isSelected) - SLsmg_set_color(NEWT_COLORSET_ACTSELLISTBOX); - else - SLsmg_set_color(NEWT_COLORSET_ACTLISTBOX); - } else if(item->isSelected) - SLsmg_set_color(NEWT_COLORSET_SELLISTBOX); - else - SLsmg_set_color(NEWT_COLORSET_LISTBOX); - - SLsmg_write_nstring(item->text, li->curWidth); - - } - newtGotorc(co->top + (li->currItem - li->startShowItem), co->left); -} - -static struct eventResult listboxEvent(newtComponent co, struct event ev) { - struct eventResult er; - struct listbox * li = co->data; - struct items *item; - int i; - - er.result = ER_IGNORED; - - if(ev.when == EV_EARLY || ev.when == EV_LATE) { - return er; - } - - switch(ev.event) { - case EV_KEYPRESS: - if (!li->isActive) break; - - switch(ev.u.key) { - case ' ': - if(!(li->flags & NEWT_FLAG_MULTIPLE)) break; - newtListboxSelectItem(co, li->boxItems[li->currItem].data, - NEWT_FLAGS_TOGGLE); - er.result = ER_SWALLOWED; - /* We don't break here, because it is cool to be able to - hold space to select a bunch of items in a list at once */ - - case NEWT_KEY_DOWN: - if(li->numItems <= 0) break; - if(li->currItem < li->numItems - 1) { - li->currItem++; - if(li->currItem > (li->startShowItem + li->curHeight - 1)) { - li->startShowItem = li->currItem - li->curHeight + 1; - if(li->startShowItem + li->curHeight > li->numItems) - li->startShowItem = li->numItems - li->curHeight; - } - if(li->sb) - newtScrollbarSet(li->sb, li->currItem + 1, li->numItems); - listboxDraw(co); - } - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_ENTER: - if(li->numItems <= 0) break; - if(li->flags & NEWT_FLAG_RETURNEXIT) - er.result = ER_EXITFORM; - break; - - case NEWT_KEY_UP: - if(li->numItems <= 0) break; - if(li->currItem > 0) { - li->currItem--; - if(li->currItem < li->startShowItem) - li->startShowItem = li->currItem; - if(li->sb) - newtScrollbarSet(li->sb, li->currItem + 1, li->numItems); - listboxDraw(co); - } - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_PGUP: - if(li->numItems <= 0) break; - li->startShowItem -= li->curHeight - 1; - if(li->startShowItem < 0) - li->startShowItem = 0; - li->currItem -= li->curHeight - 1; - if(li->currItem < 0) - li->currItem = 0; - newtListboxRealSetCurrent(co); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_PGDN: - if(li->numItems <= 0) break; - li->startShowItem += li->curHeight; - if(li->startShowItem > (li->numItems - li->curHeight)) { - li->startShowItem = li->numItems - li->curHeight; - } - li->currItem += li->curHeight; - if(li->currItem >= li->numItems) { - li->currItem = li->numItems - 1; - } - newtListboxRealSetCurrent(co); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_HOME: - if(li->numItems <= 0) break; - newtListboxSetCurrent(co, 0); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_END: - if(li->numItems <= 0) break; - li->startShowItem = li->numItems - li->curHeight; - if(li->startShowItem < 0) - li->startShowItem = 0; - li->currItem = li->numItems - 1; - newtListboxRealSetCurrent(co); - er.result = ER_SWALLOWED; - break; - default: - if (li->numItems <= 0) break; - if (ev.u.key < NEWT_KEY_EXTRA_BASE && isalpha(ev.u.key)) { - for(i = 0, item = li->boxItems; item != NULL && - i < li->currItem; i++, item = item->next); - - if (item && item->text && (toupper(*item->text) == toupper(ev.u.key))) { - item = item->next; - i++; - } else { - item = li->boxItems; - i = 0; - } - while (item && item->text && - toupper(*item->text) != toupper(ev.u.key)) { - item = item->next; - i++; - } - if (item) { - li->currItem = i; - if(li->currItem < li->startShowItem || - li->currItem > li->startShowItem) - li->startShowItem = - li->currItem > li->numItems - li->curHeight ? - li->numItems - li->curHeight : - li->currItem; - if(li->sb) - newtScrollbarSet(li->sb, li->currItem + 1, li->numItems); - newtListboxRealSetCurrent(co); - er.result = ER_SWALLOWED; - } - } - } - break; - - case EV_FOCUS: - li->isActive = 1; - listboxDraw(co); - er.result = ER_SWALLOWED; - break; - - case EV_UNFOCUS: - li->isActive = 0; - listboxDraw(co); - er.result = ER_SWALLOWED; - break; - - case EV_MOUSE: - /* if this mouse click was within the listbox, make the current - item the item clicked on. */ - /* Up scroll arrow */ - if (li->sb && - ev.u.mouse.x == co->left + co->width - li->bdxAdjust - 1 && - ev.u.mouse.y == co->top + li->bdyAdjust) { - if(li->numItems <= 0) break; - if(li->currItem > 0) { - li->currItem--; - if(li->currItem < li->startShowItem) - li->startShowItem = li->currItem; - if(li->sb) - newtScrollbarSet(li->sb, li->currItem + 1, li->numItems); - listboxDraw(co); - } - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - break; - } - /* Down scroll arrow */ - if (li->sb && - ev.u.mouse.x == co->left + co->width - li->bdxAdjust - 1 && - ev.u.mouse.y == co->top + co->height - li->bdyAdjust - 1) { - if(li->numItems <= 0) break; - if(li->currItem < li->numItems - 1) { - li->currItem++; - if(li->currItem > (li->startShowItem + li->curHeight - 1)) { - li->startShowItem = li->currItem - li->curHeight + 1; - if(li->startShowItem + li->curHeight > li->numItems) - li->startShowItem = li->numItems - li->curHeight; - } - if(li->sb) - newtScrollbarSet(li->sb, li->currItem + 1, li->numItems); - listboxDraw(co); - } - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - break; - } - if ((ev.u.mouse.y >= co->top + li->bdyAdjust) && - (ev.u.mouse.y <= co->top + co->height - (li->bdyAdjust * 2)) && - (ev.u.mouse.x >= co->left + li->bdxAdjust) && - (ev.u.mouse.x <= co->left + co->width + (li->bdxAdjust * 2))) { - li->currItem = li->startShowItem + - (ev.u.mouse.y - li->bdyAdjust - co->top); - newtListboxRealSetCurrent(co); - listboxDraw(co); - if(co->callback) co->callback(co, co->callbackData); - er.result = ER_SWALLOWED; - break; - } - } - - return er; -} - -static void listboxDestroy(newtComponent co) { - struct listbox * li = co->data; - struct items * item, * nextitem; - - nextitem = item = li->boxItems; - - while (item != NULL) { - nextitem = item->next; - free(item->text); - free(item); - item = nextitem; - } - - if (li->sb) li->sb->ops->destroy(li->sb); - - free(li); - free(co); -} diff --git a/mdk-stage1/newt/newt.c b/mdk-stage1/newt/newt.c deleted file mode 100644 index 8ff5e39a5..000000000 --- a/mdk-stage1/newt/newt.c +++ /dev/null @@ -1,672 +0,0 @@ -#include <slang.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <sys/signal.h> -#include <sys/time.h> -#include <sys/types.h> -#include <termios.h> -#include <unistd.h> - -#include "newt.h" -#include "newt_pr.h" - -struct Window { - int height, width, top, left; - short * buffer; - char * title; -}; - -struct keymap { - char * str; - int code; - char * tc; -}; - -static struct Window windowStack[20]; -static struct Window * currentWindow = NULL; - -static char * helplineStack[20]; -static char ** currentHelpline = NULL; - -static int cursorRow, cursorCol; -static int needResize; -static int cursorOn = 1; - -static const char * defaultHelpLine = -" <Tab>/<Alt-Tab> between elements | <Space> selects | <F12> next screen" -; - -const struct newtColors newtDefaultColorPalette = { - "cyan", "black", /* root fg, bg */ - "black", "blue", /* border fg, bg */ - "white", "blue", /* window fg, bg */ - "white", "black", /* shadow fg, bg */ - "white", "blue", /* title fg, bg */ - "black", "cyan", /* button fg, bg */ - "yellow", "cyan", /* active button fg, bg */ - "yellow", "blue", /* checkbox fg, bg */ - "blue", "brown", /* active checkbox fg, bg */ - "yellow", "blue", /* entry box fg, bg */ - "white", "blue", /* label fg, bg */ - "black", "cyan", /* listbox fg, bg */ - "yellow", "cyan", /* active listbox fg, bg */ - "white", "blue", /* textbox fg, bg */ - "cyan", "black", /* active textbox fg, bg */ - "white", "blue", /* help line */ - "yellow", "blue", /* root text */ - "blue", /* scale full */ - "red", /* scale empty */ - "blue", "cyan", /* disabled entry fg, bg */ - "white", "blue", /* compact button fg, bg */ - "yellow", "red", /* active & sel listbox */ - "black", "brown" /* selected listbox */ -}; - -static const struct keymap keymap[] = { - { "\033OA", NEWT_KEY_UP, "kh" }, - { "\033[A", NEWT_KEY_UP, "ku" }, - { "\033OB", NEWT_KEY_DOWN, "kd" }, - { "\033[B", NEWT_KEY_DOWN, "kd" }, - { "\033[C", NEWT_KEY_RIGHT, "kr" }, - { "\033OC", NEWT_KEY_RIGHT, "kr" }, - { "\033[D", NEWT_KEY_LEFT, "kl" }, - { "\033OD", NEWT_KEY_LEFT, "kl" }, - { "\033[H", NEWT_KEY_HOME, "kh" }, - { "\033[1~", NEWT_KEY_HOME, "kh" }, - { "\033Ow", NEWT_KEY_END, "kH" }, - { "\033[4~", NEWT_KEY_END, "kH" }, - - { "\033[3~", NEWT_KEY_DELETE, "kl" }, - { "\033[2~", NEWT_KEY_INSERT, NULL }, - - { "\033\t", NEWT_KEY_UNTAB, NULL }, - - { "\033[5~", NEWT_KEY_PGUP, NULL }, - { "\033[6~", NEWT_KEY_PGDN, NULL }, - { "\033V", NEWT_KEY_PGUP, "kH" }, - { "\033v", NEWT_KEY_PGUP, "kH" }, - - { "\033[[A", NEWT_KEY_F1, NULL }, - { "\033[[B", NEWT_KEY_F2, NULL }, - { "\033[[C", NEWT_KEY_F3, NULL }, - { "\033[[D", NEWT_KEY_F4, NULL }, - { "\033[[E", NEWT_KEY_F5, NULL }, - - { "\033OP", NEWT_KEY_F1, NULL }, - { "\033OQ", NEWT_KEY_F2, NULL }, - { "\033OR", NEWT_KEY_F3, NULL }, - { "\033OS", NEWT_KEY_F4, NULL }, - - { "\033[11~", NEWT_KEY_F1, NULL }, - { "\033[12~", NEWT_KEY_F2, NULL }, - { "\033[13~", NEWT_KEY_F3, NULL }, - { "\033[14~", NEWT_KEY_F4, NULL }, - { "\033[15~", NEWT_KEY_F5, NULL }, - { "\033[17~", NEWT_KEY_F6, NULL }, - { "\033[18~", NEWT_KEY_F7, NULL }, - { "\033[19~", NEWT_KEY_F8, NULL }, - { "\033[20~", NEWT_KEY_F9, NULL }, - { "\033[21~", NEWT_KEY_F10, NULL }, - { "\033[23~", NEWT_KEY_F11, NULL }, - { "\033[24~", NEWT_KEY_F12, NULL }, - - { NULL, 0, NULL }, /* LEAVE this one */ -}; -static char keyPrefix = '\033'; - -static const char * version = "Newt windowing library version " VERSION - " - (C) 1996-2000 Red Hat Software. " - "Redistributable under the term of the Library " - "GNU Public License. " - "Written by Erik Troan\n"; - -static newtSuspendCallback suspendCallback = NULL; -static void * suspendCallbackData = NULL; - -void newtSetSuspendCallback(newtSuspendCallback cb, void * data) { - suspendCallback = cb; - suspendCallbackData = data; -} - -static void handleSigwinch(int signum __attribute__ ((unused))) { - needResize = 1; -} - -static int getkeyInterruptHook(void) { - return -1; -} - -void newtFlushInput(void) { - while (SLang_input_pending(0)) { - SLang_getkey(); - } -} - -void newtRefresh(void) { - SLsmg_refresh(); -} - -void newtSuspend(void) { - SLtt_set_cursor_visibility (1); - SLsmg_suspend_smg(); - SLang_reset_tty(); - SLtt_set_cursor_visibility (cursorOn); -} - -void newtResume(void) { - SLsmg_resume_smg (); - SLsmg_refresh(); - SLang_init_tty(0, 0, 0); -} - -void newtCls(void) { - SLsmg_set_color(NEWT_COLORSET_ROOT); - SLsmg_gotorc(0, 0); - SLsmg_erase_eos(); - - newtRefresh(); -} - -#if defined(THIS_DOESNT_WORK) -void newtResizeScreen(int redraw) { - newtPushHelpLine(""); - - SLtt_get_screen_size(); - SLang_init_tty(0, 0, 0); - - SLsmg_touch_lines (0, SLtt_Screen_Rows - 1); - - /* I don't know why I need this */ - SLsmg_refresh(); - - newtPopHelpLine(); - - if (redraw) - SLsmg_refresh(); -} -#endif - -int newtInit(void) { - char * MonoValue, * MonoEnv = "NEWT_MONO"; - - /* use the version variable just to be sure it gets included */ - (void) strlen(version); - - SLtt_get_terminfo(); - SLtt_get_screen_size(); - - MonoValue = getenv(MonoEnv); - if ( MonoValue == NULL ) { - SLtt_Use_Ansi_Colors = 1; - } else { - SLtt_Use_Ansi_Colors = 0; - } - - SLsmg_init_smg(); - SLang_init_tty(0, 0, 0); - - newtSetColors(newtDefaultColorPalette); - newtCursorOff(); - /*initKeymap();*/ - - /*memset(&sa, 0, sizeof(sa)); - sa.sa_handler = handleSigwinch; - sigaction(SIGWINCH, &sa, NULL);*/ - - SLsignal_intr(SIGWINCH, handleSigwinch); - SLang_getkey_intr_hook = getkeyInterruptHook; - - - - return 0; -} - -int newtFinished(void) { - SLsmg_gotorc(SLtt_Screen_Rows - 1, 0); - newtCursorOn(); - SLsmg_refresh(); - SLsmg_reset_smg(); - SLang_reset_tty(); - - return 0; -} - -void newtSetColors(struct newtColors colors) { - SLtt_set_color(NEWT_COLORSET_ROOT, "", colors.rootFg, colors.rootBg); - SLtt_set_color(NEWT_COLORSET_BORDER, "", colors.borderFg, colors.borderBg); - SLtt_set_color(NEWT_COLORSET_WINDOW, "", colors.windowFg, colors.windowBg); - SLtt_set_color(NEWT_COLORSET_SHADOW, "", colors.shadowFg, colors.shadowBg); - SLtt_set_color(NEWT_COLORSET_TITLE, "", colors.titleFg, colors.titleBg); - SLtt_set_color(NEWT_COLORSET_BUTTON, "", colors.buttonFg, colors.buttonBg); - SLtt_set_color(NEWT_COLORSET_ACTBUTTON, "", colors.actButtonFg, - colors.actButtonBg); - SLtt_set_color(NEWT_COLORSET_CHECKBOX, "", colors.checkboxFg, - colors.checkboxBg); - SLtt_set_color(NEWT_COLORSET_ACTCHECKBOX, "", colors.actCheckboxFg, - colors.actCheckboxBg); - SLtt_set_color(NEWT_COLORSET_ENTRY, "", colors.entryFg, colors.entryBg); - SLtt_set_color(NEWT_COLORSET_LABEL, "", colors.labelFg, colors.labelBg); - SLtt_set_color(NEWT_COLORSET_LISTBOX, "", colors.listboxFg, - colors.listboxBg); - SLtt_set_color(NEWT_COLORSET_ACTLISTBOX, "", colors.actListboxFg, - colors.actListboxBg); - SLtt_set_color(NEWT_COLORSET_TEXTBOX, "", colors.textboxFg, - colors.textboxBg); - SLtt_set_color(NEWT_COLORSET_ACTTEXTBOX, "", colors.actTextboxFg, - colors.actTextboxBg); - SLtt_set_color(NEWT_COLORSET_HELPLINE, "", colors.helpLineFg, - colors.helpLineBg); - SLtt_set_color(NEWT_COLORSET_ROOTTEXT, "", colors.rootTextFg, - colors.rootTextBg); - - SLtt_set_color(NEWT_COLORSET_EMPTYSCALE, "", "black", - colors.emptyScale); - SLtt_set_color(NEWT_COLORSET_FULLSCALE, "", "black", - colors.fullScale); - SLtt_set_color(NEWT_COLORSET_DISENTRY, "", colors.disabledEntryFg, - colors.disabledEntryBg); - - SLtt_set_color(NEWT_COLORSET_COMPACTBUTTON, "", colors.compactButtonFg, - colors.compactButtonBg); - - SLtt_set_color(NEWT_COLORSET_ACTSELLISTBOX, "", colors.actSelListboxFg, - colors.actSelListboxBg); - SLtt_set_color(NEWT_COLORSET_SELLISTBOX, "", colors.selListboxFg, - colors.selListboxBg); -} - -int newtGetKey(void) { - int key; - char buf[10], * chptr = buf; - const struct keymap * curr; - - do { - key = SLang_getkey(); - if (key == 0xFFFF) { - if (needResize) - return NEWT_KEY_RESIZE; - - /* ignore other signals */ - continue; - } - - if (key == NEWT_KEY_SUSPEND && suspendCallback) - suspendCallback(suspendCallbackData); - } while (key == NEWT_KEY_SUSPEND); - - switch (key) { - case 'v' | 0x80: - case 'V' | 0x80: - return NEWT_KEY_PGUP; - - case 22: - return NEWT_KEY_PGDN; - - return NEWT_KEY_BKSPC; - case 0x7f: - return NEWT_KEY_BKSPC; - - case 0x08: - return NEWT_KEY_BKSPC; - - default: - if (key != keyPrefix) return key; - } - - memset(buf, 0, sizeof(buf)); - - *chptr++ = key; - while (SLang_input_pending(5)) { - key = SLang_getkey(); - if (key == keyPrefix) { - /* he hit unknown keys too many times -- start over */ - memset(buf, 0, sizeof(buf)); - chptr = buf; - } - - *chptr++ = key; - - /* this search should use bsearch(), but when we only look through - a list of 20 (or so) keymappings, it's probably faster just to - do a inline linear search */ - - for (curr = keymap; curr->code; curr++) { - if (curr->str) { - if (!strcmp(curr->str, buf)) - return curr->code; - } - } - } - - for (curr = keymap; curr->code; curr++) { - if (curr->str) { - if (!strcmp(curr->str, buf)) - return curr->code; - } - } - - /* Looks like we were a bit overzealous in reading characters. Return - just the first character, and put everything else back in the buffer - for later */ - - chptr--; - while (chptr > buf) - SLang_ungetkey(*chptr--); - - return *chptr; -} - -void newtWaitForKey(void) { - newtRefresh(); - - SLang_getkey(); - newtClearKeyBuffer(); -} - -void newtClearKeyBuffer(void) { - while (SLang_input_pending(1)) { - SLang_getkey(); - } -} - -int newtOpenWindow(int left, int top, int width, int height, - const char * title) { - int j, row, col; - int n; - int i; - - newtFlushInput(); - - if (!currentWindow) { - currentWindow = windowStack; - } else { - currentWindow++; - } - - currentWindow->left = left; - currentWindow->top = top; - currentWindow->width = width; - currentWindow->height = height; - currentWindow->title = title ? strdup(title) : NULL; - - currentWindow->buffer = malloc(sizeof(short) * (width + 3) * (height + 3)); - - row = top - 1; - col = left - 1; - n = 0; - for (j = 0; j < height + 3; j++, row++) { - SLsmg_gotorc(row, col); - SLsmg_read_raw((SLsmg_Char_Type *)currentWindow->buffer + n, - currentWindow->width + 3); - n += currentWindow->width + 3; - } - - SLsmg_set_color(NEWT_COLORSET_BORDER); - SLsmg_draw_box(top - 1, left - 1, height + 2, width + 2); - - if (currentWindow->title) { - i = strlen(currentWindow->title) + 4; - i = ((width - i) / 2) + left; - SLsmg_gotorc(top - 1, i); - SLsmg_set_char_set(1); - SLsmg_write_char(SLSMG_RTEE_CHAR); - SLsmg_set_char_set(0); - SLsmg_write_char(' '); - SLsmg_set_color(NEWT_COLORSET_TITLE); - SLsmg_write_string((char *)currentWindow->title); - SLsmg_set_color(NEWT_COLORSET_BORDER); - SLsmg_write_char(' '); - SLsmg_set_char_set(1); - SLsmg_write_char(SLSMG_LTEE_CHAR); - SLsmg_set_char_set(0); - } - - SLsmg_set_color(NEWT_COLORSET_WINDOW); - SLsmg_fill_region(top, left, height, width, ' '); - - SLsmg_set_color(NEWT_COLORSET_SHADOW); - SLsmg_fill_region(top + height + 1, left, 1, width + 2, ' '); - SLsmg_fill_region(top, left + width + 1, height + 1, 1, ' '); - - for (i = top; i < (top + height + 1); i++) { - SLsmg_gotorc(i, left + width + 1); - SLsmg_write_string(" "); - } - - return 0; -} - -int newtCenteredWindow(int width, int height, const char * title) { - int top, left; - - top = (SLtt_Screen_Rows - height) / 2; - - /* I don't know why, but this seems to look better */ - if ((SLtt_Screen_Rows % 2) && (top % 2)) top--; - - left = (SLtt_Screen_Cols - width) / 2; - - newtOpenWindow(left, top, width, height, title); - - return 0; -} - -void newtPopWindow(void) { - int j, row, col; - int n = 0; - - row = col = 0; - - row = currentWindow->top - 1; - col = currentWindow->left - 1; - for (j = 0; j < currentWindow->height + 3; j++, row++) { - SLsmg_gotorc(row, col); - SLsmg_write_raw((SLsmg_Char_Type *)currentWindow->buffer + n, - currentWindow->width + 3); - n += currentWindow->width + 3; - } - - free(currentWindow->buffer); - free(currentWindow->title); - - if (currentWindow == windowStack) - currentWindow = NULL; - else - currentWindow--; - - SLsmg_set_char_set(0); - - newtRefresh(); -} - -void newtGetWindowPos(int * x, int * y) { - if (currentWindow) { - *x = currentWindow->left; - *y = currentWindow->top; - } else - *x = *y = 0; -} - -void newtGetrc(int * row, int * col) { - *row = cursorRow; - *col = cursorCol; -} - -void newtGotorc(int newRow, int newCol) { - if (currentWindow) { - newRow += currentWindow->top; - newCol += currentWindow->left; - } - - cursorRow = newRow; - cursorCol = newCol; - SLsmg_gotorc(cursorRow, cursorCol); -} - -void newtDrawBox(int left, int top, int width, int height, int shadow) { - if (currentWindow) { - top += currentWindow->top; - left += currentWindow->left; - } - - SLsmg_draw_box(top, left, height, width); - - if (shadow) { - SLsmg_set_color(NEWT_COLORSET_SHADOW); - SLsmg_fill_region(top + height, left + 1, 1, width - 1, ' '); - SLsmg_fill_region(top + 1, left + width, height, 1, ' '); - } -} - -void newtClearBox(int left, int top, int width, int height) { - if (currentWindow) { - top += currentWindow->top; - left += currentWindow->left; - } - - SLsmg_fill_region(top, left, height, width, ' '); -} - -#if 0 -/* This doesn't seem to work quite right. I don't know why not, but when - I rsh from an rxvt into a box and run this code, the machine returns - console key's (\033[B) rather then xterm ones (\033OB). */ -static void initKeymap(void) { - struct keymap * curr; - - for (curr = keymap; curr->code; curr++) { - if (!curr->str) - curr->str = SLtt_tgetstr(curr->tc); - } - - /* Newt's keymap handling is a bit broken. It assumes that any extended - keystrokes begin with ESC. If you're using a homebrek terminal you - will probably need to fix this, or just yell at me and I'll be so - ashamed of myself for doing it this way I'll fix it */ - - keyPrefix = 0x1b; /* ESC */ -} -#endif - -void newtDelay(int usecs) { - fd_set set; - struct timeval tv; - - FD_ZERO(&set); - - tv.tv_sec = usecs / 1000000; - tv.tv_usec = usecs % 1000000; - - select(0, &set, &set, &set, &tv); -} - -struct eventResult newtDefaultEventHandler(newtComponent c __attribute__ ((unused)), - struct event ev __attribute__ ((unused))) { - struct eventResult er; - - er.result = ER_IGNORED; - return er; -} - -void newtRedrawHelpLine(void) { - char * buf; - - SLsmg_set_color(NEWT_COLORSET_HELPLINE); - - buf = alloca(SLtt_Screen_Cols + 1); - memset(buf, ' ', SLtt_Screen_Cols); - buf[SLtt_Screen_Cols] = '\0'; - - if (currentHelpline) - memcpy(buf, *currentHelpline, strlen(*currentHelpline)); - - SLsmg_gotorc(SLtt_Screen_Rows - 1, 0); - SLsmg_write_string(buf); -} - -void newtPushHelpLine(const char * text) { - if (!text) - text = defaultHelpLine; - - if (currentHelpline) - (*(++currentHelpline)) = strdup(text); - else { - currentHelpline = helplineStack; - *currentHelpline = strdup(text); - } - - newtRedrawHelpLine(); -} - -void newtPopHelpLine(void) { - if (!currentHelpline) return; - - free(*currentHelpline); - if (currentHelpline == helplineStack) - currentHelpline = NULL; - else - currentHelpline--; - - newtRedrawHelpLine(); -} - -void newtDrawRootText(int col, int row, const char * text) { - SLsmg_set_color(NEWT_COLORSET_ROOTTEXT); - - if (col < 0) { - col = SLtt_Screen_Cols + col; - } - - if (row < 0) { - row = SLtt_Screen_Rows + row; - } - - SLsmg_gotorc(row, col); - SLsmg_write_string((char *)text); -} - -int newtSetFlags(int oldFlags, int newFlags, enum newtFlagsSense sense) { - switch (sense) { - case NEWT_FLAGS_SET: - return oldFlags | newFlags; - - case NEWT_FLAGS_RESET: - return oldFlags & (~newFlags); - - case NEWT_FLAGS_TOGGLE: - return oldFlags ^ newFlags; - - default: - return oldFlags; - } -} - -void newtBell(void) -{ - SLtt_beep(); -} - -void newtGetScreenSize(int * cols, int * rows) { - if (rows) *rows = SLtt_Screen_Rows; - if (cols) *cols = SLtt_Screen_Cols; -} - -void newtDefaultPlaceHandler(newtComponent c, int newLeft, int newTop) { - c->left = newLeft; - c->top = newTop; -} - -void newtDefaultMappedHandler(newtComponent c, int isMapped) { - c->isMapped = isMapped; -} - -void newtCursorOff(void) { - cursorOn = 0; - SLtt_set_cursor_visibility (cursorOn); -} - -void newtCursorOn(void) { - cursorOn = 1; - SLtt_set_cursor_visibility (cursorOn); -} diff --git a/mdk-stage1/newt/newt.h b/mdk-stage1/newt/newt.h deleted file mode 100644 index d3fd8bedc..000000000 --- a/mdk-stage1/newt/newt.h +++ /dev/null @@ -1,362 +0,0 @@ -#ifndef H_NEWT -#define H_NEWT - -#ifdef __cplusplus -extern "C" { -#endif - -#include <stdarg.h> - -#define NEWT_COLORSET_ROOT 2 -#define NEWT_COLORSET_BORDER 3 -#define NEWT_COLORSET_WINDOW 4 -#define NEWT_COLORSET_SHADOW 5 -#define NEWT_COLORSET_TITLE 6 -#define NEWT_COLORSET_BUTTON 7 -#define NEWT_COLORSET_ACTBUTTON 8 -#define NEWT_COLORSET_CHECKBOX 9 -#define NEWT_COLORSET_ACTCHECKBOX 10 -#define NEWT_COLORSET_ENTRY 11 -#define NEWT_COLORSET_LABEL 12 -#define NEWT_COLORSET_LISTBOX 13 -#define NEWT_COLORSET_ACTLISTBOX 14 -#define NEWT_COLORSET_TEXTBOX 15 -#define NEWT_COLORSET_ACTTEXTBOX 16 -#define NEWT_COLORSET_HELPLINE 17 -#define NEWT_COLORSET_ROOTTEXT 18 -#define NEWT_COLORSET_EMPTYSCALE 19 -#define NEWT_COLORSET_FULLSCALE 20 -#define NEWT_COLORSET_DISENTRY 21 -#define NEWT_COLORSET_COMPACTBUTTON 22 -#define NEWT_COLORSET_ACTSELLISTBOX 23 -#define NEWT_COLORSET_SELLISTBOX 24 - -#define NEWT_ARG_LAST -100000 -#define NEWT_ARG_APPEND -1 - -struct newtColors { - char * rootFg, * rootBg; - char * borderFg, * borderBg; - char * windowFg, * windowBg; - char * shadowFg, * shadowBg; - char * titleFg, * titleBg; - char * buttonFg, * buttonBg; - char * actButtonFg, * actButtonBg; - char * checkboxFg, * checkboxBg; - char * actCheckboxFg, * actCheckboxBg; - char * entryFg, * entryBg; - char * labelFg, * labelBg; - char * listboxFg, * listboxBg; - char * actListboxFg, * actListboxBg; - char * textboxFg, * textboxBg; - char * actTextboxFg, * actTextboxBg; - char * helpLineFg, * helpLineBg; - char * rootTextFg, * rootTextBg; - char * emptyScale, * fullScale; - char * disabledEntryFg, * disabledEntryBg; - char * compactButtonFg, * compactButtonBg; - char * actSelListboxFg, * actSelListboxBg; - char * selListboxFg, * selListboxBg; -}; - -enum newtFlagsSense { NEWT_FLAGS_SET, NEWT_FLAGS_RESET, NEWT_FLAGS_TOGGLE }; - -#define NEWT_FLAG_RETURNEXIT (1 << 0) -#define NEWT_FLAG_HIDDEN (1 << 1) -#define NEWT_FLAG_SCROLL (1 << 2) -#define NEWT_FLAG_DISABLED (1 << 3) -/* OBSOLETE #define NEWT_FLAG_NOSCROLL (1 << 4) for listboxes */ -#define NEWT_FLAG_BORDER (1 << 5) -#define NEWT_FLAG_WRAP (1 << 6) -#define NEWT_FLAG_NOF12 (1 << 7) -#define NEWT_FLAG_MULTIPLE (1 << 8) -#define NEWT_FLAG_SELECTED (1 << 9) -#define NEWT_FLAG_CHECKBOX (1 << 10) -#define NEWT_FLAG_PASSWORD (1 << 11) /* draw '*' of chars in entrybox */ -#define NEWT_FD_READ (1 << 0) -#define NEWT_FD_WRITE (1 << 1) - -#define NEWT_CHECKBOXTREE_COLLAPSED '\0' -#define NEWT_CHECKBOXTREE_EXPANDED '\1' -#define NEWT_CHECKBOXTREE_UNSELECTED ' ' -#define NEWT_CHECKBOXTREE_SELECTED '*' - -/* Backwards compatibility */ -#define NEWT_LISTBOX_RETURNEXIT NEWT_FLAG_RETURNEXIT -#define NEWT_ENTRY_SCROLL NEWT_FLAG_SCROLL -#define NEWT_ENTRY_HIDDEN NEWT_FLAG_HIDDEN -#define NEWT_ENTRY_RETURNEXIT NEWT_FLAG_RETURNEXIT -#define NEWT_ENTRY_DISABLED NEWT_FLAG_DISABLED - -#define NEWT_TEXTBOX_WRAP NEWT_FLAG_WRAP -#define NEWT_TEXTBOX_SCROLL NEWT_FLAG_SCROLL -#define NEWT_FORM_NOF12 NEWT_FLAG_NOF12 - -#define newtListboxAddEntry newtListboxAppendEntry - - -typedef struct newtComponent_struct * newtComponent; - -extern const struct newtColors newtDefaultColorPalette; - -typedef void (*newtCallback)(newtComponent, void *); -typedef void (*newtSuspendCallback)(void * data); - -int newtInit(void); -int newtFinished(void); -void newtCls(void); -void newtResizeScreen(int redraw); -void newtWaitForKey(void); -void newtClearKeyBuffer(void); -void newtDelay(int usecs); -/* top, left are *not* counting the border */ -int newtOpenWindow(int left, int top, int width, int height, - const char * title); -int newtCenteredWindow(int width, int height, const char * title); -void newtPopWindow(void); -void newtSetColors(struct newtColors colors); -void newtRefresh(void); -void newtSuspend(void); -void newtSetSuspendCallback(newtSuspendCallback cb, void * data); -void newtSetHelpCallback(newtCallback cb); -void newtResume(void); -void newtPushHelpLine(const char * text); -void newtRedrawHelpLine(void); -void newtPopHelpLine(void); -void newtDrawRootText(int col, int row, const char * text); -void newtBell(void); -void newtCursorOff(void); -void newtCursorOn(void); - -/* Components */ - -newtComponent newtCompactButton(int left, int top, const char * text); -newtComponent newtButton(int left, int top, const char * text); -newtComponent newtCheckbox(int left, int top, const char * text, char defValue, - const char * seq, char * result); -char newtCheckboxGetValue(newtComponent co); -void newtCheckboxSetValue(newtComponent co, char value); -void newtCheckboxSetFlags(newtComponent co, int flags, enum newtFlagsSense sense); - - -newtComponent newtRadiobutton(int left, int top, const char * text, int isDefault, - newtComponent prevButton); -newtComponent newtRadioGetCurrent(newtComponent setMember); -newtComponent newtListitem(int left, int top, const char * text, int isDefault, - newtComponent prevItem, const void * data, int flags); -void newtListitemSet(newtComponent co, const char * text); -void * newtListitemGetData(newtComponent co); -void newtGetScreenSize(int * cols, int * rows); - -newtComponent newtLabel(int left, int top, const char * text); -void newtLabelSetText(newtComponent co, const char * text); -newtComponent newtVerticalScrollbar(int left, int top, int height, - int normalColorset, int thumbColorset); -void newtScrollbarSet(newtComponent co, int where, int total); - -newtComponent newtListbox(int left, int top, int height, int flags); -void * newtListboxGetCurrent(newtComponent co); -void newtListboxSetCurrent(newtComponent co, int num); -void newtListboxSetCurrentByKey(newtComponent co, void * key); -void newtListboxSetEntry(newtComponent co, int num, const char * text); -void newtListboxSetWidth(newtComponent co, int width); -void newtListboxSetData(newtComponent co, int num, void * data); -int newtListboxAppendEntry(newtComponent co, const char * text, - const void * data); -/* Send the key to insert after, or NULL to insert at the top */ -int newtListboxInsertEntry(newtComponent co, const char * text, const void * data, void * key); -int newtListboxDeleteEntry(newtComponent co, void * data); -void newtListboxClear(newtComponent co); /* removes all entries from listbox */ -void newtListboxGetEntry(newtComponent co, int num, char **text, void **data); -/* Returns an array of data pointers from items, last element is NULL */ -void **newtListboxGetSelection(newtComponent co, int *numitems); -void newtListboxClearSelection(newtComponent co); -void newtListboxSelectItem(newtComponent co, const void * key, - enum newtFlagsSense sense); - -newtComponent newtCheckboxTree(int left, int top, int height, int flags); -newtComponent newtCheckboxTreeMulti(int left, int top, int height, char *seq, int flags); -const void ** newtCheckboxTreeGetSelection(newtComponent co, int *numitems); -const void * newtCheckboxTreeGetCurrent(newtComponent co); -const void ** newtCheckboxTreeGetMultiSelection(newtComponent co, int *numitems, char seqnum); -/* last item is NEWT_ARG_LAST for all of these */ -int newtCheckboxTreeAddItem(newtComponent co, - const char * text, const void * data, - int flags, int index, ...); -int newtCheckboxTreeAddArray(newtComponent co, - const char * text, const void * data, - int flags, int * indexes); -int * newtCheckboxTreeFindItem(newtComponent co, void * data); -void newtCheckboxTreeSetEntry(newtComponent co, const void * data, - const char * text); -char newtCheckboxTreeGetEntryValue(newtComponent co, const void * data); -void newtCheckboxTreeSetEntryValue(newtComponent co, const void * data, - char value); - -newtComponent newtTextboxReflowed(int left, int top, char * text, int width, - int flexDown, int flexUp, int flags); -newtComponent newtTextbox(int left, int top, int width, int height, int flags); -void newtTextboxSetText(newtComponent co, const char * text); -void newtTextboxSetHeight(newtComponent co, int height); -int newtTextboxGetNumLines(newtComponent co); -char * newtReflowText(char * text, int width, int flexDown, int flexUp, - int * actualWidth, int * actualHeight); - -struct newtExitStruct { - enum { NEWT_EXIT_HOTKEY, NEWT_EXIT_COMPONENT, NEWT_EXIT_FDREADY, - NEWT_EXIT_TIMER } reason; - union { - int key; - newtComponent co; - } u; -} ; - -newtComponent newtForm(newtComponent vertBar, void * helpTag, int flags); -void newtFormSetTimer(newtComponent form, int millisecs); -void newtFormWatchFd(newtComponent form, int fd, int fdFlags); -void newtFormSetSize(newtComponent co); -newtComponent newtFormGetCurrent(newtComponent co); -void newtFormSetBackground(newtComponent co, int color); -void newtFormSetCurrent(newtComponent co, newtComponent subco); -void newtFormAddComponent(newtComponent form, newtComponent co); -void newtFormAddComponents(newtComponent form, ...); -void newtFormSetHeight(newtComponent co, int height); -void newtFormSetWidth(newtComponent co, int width); -newtComponent newtRunForm(newtComponent form); /* obsolete */ -void newtFormRun(newtComponent co, struct newtExitStruct * es); -void newtDrawForm(newtComponent form); -void newtFormAddHotKey(newtComponent co, int key); - -typedef int (*newtEntryFilter)(newtComponent entry, void * data, int ch, - int cursor); -newtComponent newtEntry(int left, int top, const char * initialValue, int width, - char ** resultPtr, int flags); -void newtEntrySet(newtComponent co, const char * value, int cursorAtEnd); -void newtEntrySetFilter(newtComponent co, newtEntryFilter filter, void * data); -char * newtEntryGetValue(newtComponent co); -void newtEntrySetFlags(newtComponent co, int flags, enum newtFlagsSense sense); - -newtComponent newtScale(int left, int top, int width, int fullValue); -void newtScaleSet(newtComponent co, unsigned int amount); - -void newtComponentAddCallback(newtComponent co, newtCallback f, void * data); -void newtComponentTakesFocus(newtComponent co, int val); - -/* this also destroys all of the components (including other forms) on the - form */ -void newtFormDestroy(newtComponent form); - -/* Key codes */ - -#define NEWT_KEY_TAB '\t' -#define NEWT_KEY_ENTER '\r' -#define NEWT_KEY_SUSPEND '\032' /* ctrl - z*/ -#define NEWT_KEY_RETURN NEWT_KEY_ENTER - -#define NEWT_KEY_EXTRA_BASE 0x8000 -#define NEWT_KEY_UP NEWT_KEY_EXTRA_BASE + 1 -#define NEWT_KEY_DOWN NEWT_KEY_EXTRA_BASE + 2 -#define NEWT_KEY_LEFT NEWT_KEY_EXTRA_BASE + 4 -#define NEWT_KEY_RIGHT NEWT_KEY_EXTRA_BASE + 5 -#define NEWT_KEY_BKSPC NEWT_KEY_EXTRA_BASE + 6 -#define NEWT_KEY_DELETE NEWT_KEY_EXTRA_BASE + 7 -#define NEWT_KEY_HOME NEWT_KEY_EXTRA_BASE + 8 -#define NEWT_KEY_END NEWT_KEY_EXTRA_BASE + 9 -#define NEWT_KEY_UNTAB NEWT_KEY_EXTRA_BASE + 10 -#define NEWT_KEY_PGUP NEWT_KEY_EXTRA_BASE + 11 -#define NEWT_KEY_PGDN NEWT_KEY_EXTRA_BASE + 12 -#define NEWT_KEY_INSERT NEWT_KEY_EXTRA_BASE + 13 - -#define NEWT_KEY_F1 NEWT_KEY_EXTRA_BASE + 101 -#define NEWT_KEY_F2 NEWT_KEY_EXTRA_BASE + 102 -#define NEWT_KEY_F3 NEWT_KEY_EXTRA_BASE + 103 -#define NEWT_KEY_F4 NEWT_KEY_EXTRA_BASE + 104 -#define NEWT_KEY_F5 NEWT_KEY_EXTRA_BASE + 105 -#define NEWT_KEY_F6 NEWT_KEY_EXTRA_BASE + 106 -#define NEWT_KEY_F7 NEWT_KEY_EXTRA_BASE + 107 -#define NEWT_KEY_F8 NEWT_KEY_EXTRA_BASE + 108 -#define NEWT_KEY_F9 NEWT_KEY_EXTRA_BASE + 109 -#define NEWT_KEY_F10 NEWT_KEY_EXTRA_BASE + 110 -#define NEWT_KEY_F11 NEWT_KEY_EXTRA_BASE + 111 -#define NEWT_KEY_F12 NEWT_KEY_EXTRA_BASE + 112 - -/* not really a key, but newtGetKey returns it */ -#define NEWT_KEY_RESIZE NEWT_KEY_EXTRA_BASE + 113 - -#define NEWT_ANCHOR_LEFT (1 << 0) -#define NEWT_ANCHOR_RIGHT (1 << 1) -#define NEWT_ANCHOR_TOP (1 << 2) -#define NEWT_ANCHOR_BOTTOM (1 << 3) - -#define NEWT_GRID_FLAG_GROWX (1 << 0) -#define NEWT_GRID_FLAG_GROWY (1 << 1) - -typedef struct grid_s * newtGrid; -enum newtGridElement { NEWT_GRID_EMPTY = 0, - NEWT_GRID_COMPONENT, NEWT_GRID_SUBGRID }; - -newtGrid newtCreateGrid(int cols, int rows); -/* TYPE, what, TYPE, what, ..., NULL */ -newtGrid newtGridVStacked(enum newtGridElement type, void * what, ...); -newtGrid newtGridVCloseStacked(enum newtGridElement type, void * what, ...); -newtGrid newtGridHStacked(enum newtGridElement type1, void * what1, ...); -newtGrid newtGridHCloseStacked(enum newtGridElement type1, void * what1, ...); -newtGrid newtGridBasicWindow(newtComponent text, newtGrid middle, - newtGrid buttons); -newtGrid newtGridSimpleWindow(newtComponent text, newtComponent middle, - newtGrid buttons); -void newtGridSetField(newtGrid grid, int col, int row, - enum newtGridElement type, void * val, int padLeft, - int padTop, int padRight, int padBottom, int anchor, - int flags); -void newtGridPlace(newtGrid grid, int left, int top); -#define newtGridDestroy newtGridFree -void newtGridFree(newtGrid grid, int recurse); -void newtGridGetSize(newtGrid grid, int * width, int * height); -void newtGridWrappedWindow(newtGrid grid, char * title); -void newtGridWrappedWindowAt(newtGrid grid, char * title, int left, int top); -void newtGridAddComponentsToForm(newtGrid grid, newtComponent form, - int recurse); - -/* convienve */ -newtGrid newtButtonBarv(char * button1, newtComponent * b1comp, va_list args); -newtGrid newtButtonBar(char * button1, newtComponent * b1comp, ...); - -/* automatically centered and shrink wrapped */ -void newtWinMessage(char * title, char * buttonText, char * text, ...); -void newtWinMessagev(char * title, char * buttonText, char * text, - va_list argv); - -/* having separate calls for these two seems silly, but having two separate - variable length-arg lists seems like a bad idea as well */ - -/* Returns 0 if F12 was pressed, 1 for button1, 2 for button2 */ -int newtWinChoice(char * title, char * button1, char * button2, - char * text, ...); -/* Returns 0 if F12 was pressed, 1 for button1, 2 for button2, - 3 for button3 */ -int newtWinTernary(char * title, char * button1, char * button2, - char * button3, char * message, ...); - -/* Returns the button number pressed, 0 on F12 */ -int newtWinMenu(char * title, char * text, int suggestedWidth, int flexDown, - int flexUp, int maxListHeight, char ** items, int * listItem, - char * button1, ...); - -struct newtWinEntry { - char * text; - char ** value; /* may be initialized to set default */ - int flags; -}; - -/* Returns the button number pressed, 0 on F12. The final values are - dynamically allocated, and need to be freed. */ -int newtWinEntries(char * title, char * text, int suggestedWidth, int flexDown, - int flexUp, int dataWidth, - struct newtWinEntry * items, char * button1, ...); - -#ifdef __cplusplus -} /* End of extern "C" { */ -#endif - -#endif /* H_NEWT */ diff --git a/mdk-stage1/newt/newt_pr.h b/mdk-stage1/newt/newt_pr.h deleted file mode 100644 index 76f5e2f6f..000000000 --- a/mdk-stage1/newt/newt_pr.h +++ /dev/null @@ -1,82 +0,0 @@ -#ifndef H_NEWT_PR -#define H_NEWT_PR - -#define COLORSET_ROOT NEWT_COLORSET_ROOT -#define COLORSET_BORDER NEWT_COLORSET_BORDER -#define COLORSET_WINDOW NEWT_COLORSET_WINDOW -#define COLORSET_SHADOW NEWT_COLORSET_SHADOW -#define COLORSET_TITLE NEWT_COLORSET_TITLE -#define COLORSET_BUTTON NEWT_COLORSET_BUTTON -#define COLORSET_ACTBUTTON NEWT_COLORSET_ACTBUTTON -#define COLORSET_CHECKBOX NEWT_COLORSET_CHECKBOX -#define COLORSET_ACTCHECKBOX NEWT_COLORSET_ACTCHECKBOX -#define COLORSET_ENTRY NEWT_COLORSET_ENTRY -#define COLORSET_LABEL NEWT_COLORSET_LABEL -#define COLORSET_LISTBOX NEWT_COLORSET_LISTBOX -#define COLORSET_ACTLISTBOX NEWT_COLORSET_ACTLISTBOX -#define COLORSET_TEXTBOX NEWT_COLORSET_TEXTBOX -#define COLORSET_ACTTEXTBOX NEWT_COLORSET_ACTTEXTBOX - -int newtSetFlags(int oldFlags, int newFlags, enum newtFlagsSense sense); - -void newtGotorc(int row, int col); -void newtGetrc(int * row, int * col); -void newtGetWindowPos(int * x, int * y); -void newtDrawBox(int left, int top, int width, int height, int shadow); -void newtClearBox(int left, int top, int width, int height); - -int newtGetKey(void); - -struct newtComponent_struct { - /* common data */ - int height, width; - int top, left; - int takesFocus; - int isMapped; - - struct componentOps * ops; - - newtCallback callback; - void * callbackData; - - void * data; -} ; - -enum eventResultTypes { ER_IGNORED, ER_SWALLOWED, ER_EXITFORM, ER_SETFOCUS, - ER_NEXTCOMP }; -struct eventResult { - enum eventResultTypes result; - union { - newtComponent focus; - } u; -}; - -enum eventTypes { EV_FOCUS, EV_UNFOCUS, EV_KEYPRESS, EV_MOUSE }; -enum eventSequence { EV_EARLY, EV_NORMAL, EV_LATE }; - -struct event { - enum eventTypes event; - enum eventSequence when; - union { - int key; - struct { - enum { MOUSE_MOTION, MOUSE_BUTTON_DOWN, MOUSE_BUTTON_UP } type; - int x, y; - } mouse; - } u; -} ; - -struct componentOps { - void (* draw)(newtComponent c); - struct eventResult (* event)(newtComponent c, struct event ev); - void (* destroy)(newtComponent c); - void (* place)(newtComponent c, int newLeft, int newTop); - void (* mapped)(newtComponent c, int isMapped); -} ; - -void newtDefaultPlaceHandler(newtComponent c, int newLeft, int newTop); -void newtDefaultMappedHandler(newtComponent c, int isMapped); -struct eventResult newtDefaultEventHandler(newtComponent c, - struct event ev); - -#endif /* H_NEWT_PR */ diff --git a/mdk-stage1/newt/scale.c b/mdk-stage1/newt/scale.c deleted file mode 100644 index 800958580..000000000 --- a/mdk-stage1/newt/scale.c +++ /dev/null @@ -1,72 +0,0 @@ -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct scale { - int fullValue; - int charsSet; -}; - -static void scaleDraw(newtComponent co); - -static struct componentOps scaleOps = { - scaleDraw, - newtDefaultEventHandler, - NULL, - newtDefaultPlaceHandler, - newtDefaultMappedHandler, -} ; - -newtComponent newtScale(int left, int top, int width, int fullValue) { - newtComponent co; - struct scale * sc; - - co = malloc(sizeof(*co)); - sc = malloc(sizeof(struct scale)); - co->data = sc; - - co->ops = &scaleOps; - - co->height = 1; - co->width = width; - co->top = top; - co->left = left; - co->takesFocus = 0; - - sc->fullValue = fullValue; - sc->charsSet = 0; - - return co; -} - -void newtScaleSet(newtComponent co, unsigned int amount) { - struct scale * sc = co->data; - int newCharsSet; - - newCharsSet = (amount * co->width) / sc->fullValue; - - if (newCharsSet != sc->charsSet) { - sc->charsSet = newCharsSet; - scaleDraw(co); - } -} - -static void scaleDraw(newtComponent co) { - struct scale * sc = co->data; - int i; - - if (co->top == -1) return; - - newtGotorc(co->top, co->left); - - SLsmg_set_color(NEWT_COLORSET_FULLSCALE); - for (i = 0; i < sc->charsSet; i++) - SLsmg_write_string(" "); - - SLsmg_set_color(NEWT_COLORSET_EMPTYSCALE); - for (i = 0; i < (co->width - sc->charsSet); i++) - SLsmg_write_string(" "); -} diff --git a/mdk-stage1/newt/scrollbar.c b/mdk-stage1/newt/scrollbar.c deleted file mode 100644 index cb4bc2757..000000000 --- a/mdk-stage1/newt/scrollbar.c +++ /dev/null @@ -1,124 +0,0 @@ -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct scrollbar { - int curr; - int cs, csThumb; - int arrows; -} ; - -static void sbDraw(newtComponent co); -static void sbDestroy(newtComponent co); -static void sbDrawThumb(newtComponent co, int isOn); - -static struct componentOps sbOps = { - sbDraw, - newtDefaultEventHandler, - sbDestroy, - newtDefaultPlaceHandler, - newtDefaultMappedHandler, -} ; - -void newtScrollbarSet(newtComponent co, int where, int total) { - struct scrollbar * sb = co->data; - int new; - - if (sb->arrows) - new = (where * (co->height - 3)) / (total ? total : 1) + 1; - else - new = (where * (co->height - 1)) / (total ? total : 1); - if (new != sb->curr) { - sbDrawThumb(co, 0); - sb->curr = new; - sbDrawThumb(co, 1); - } -} - -newtComponent newtVerticalScrollbar(int left, int top, int height, - int normalColorset, int thumbColorset) { - newtComponent co; - struct scrollbar * sb; - - co = malloc(sizeof(*co)); - sb = malloc(sizeof(*sb)); - co->data = sb; - - if (!strcmp(getenv("TERM"), "linux") && height >= 2) { - sb->arrows = 1; - sb->curr = 1; - } else { - sb->arrows = 0; - sb->curr = 0; - } - sb->cs = normalColorset; - sb->csThumb = thumbColorset; - - co->ops = &sbOps; - co->isMapped = 0; - co->left = left; - co->top = top; - co->height = height; - co->width = 1; - co->takesFocus = 0; - - return co; -} - -static void sbDraw(newtComponent co) { - struct scrollbar * sb = co->data; - int i; - - if (!co->isMapped) return; - - SLsmg_set_color(sb->cs); - - SLsmg_set_char_set(1); - if (sb->arrows) { - newtGotorc(co->top, co->left); - SLsmg_write_char('\x2d'); - for (i = 1; i < co->height - 1; i++) { - newtGotorc(i + co->top, co->left); - SLsmg_write_char('\x61'); - } - newtGotorc(co->top + co->height - 1, co->left); - SLsmg_write_char('\x2e'); - } else { - for (i = 0; i < co->height; i++) { - newtGotorc(i + co->top, co->left); - SLsmg_write_char('\x61'); - } - } - - SLsmg_set_char_set(0); - - sbDrawThumb(co, 1); -} - -static void sbDrawThumb(newtComponent co, int isOn) { - struct scrollbar * sb = co->data; - char ch = isOn ? '#' : '\x61'; - - if (!co->isMapped) return; - - newtGotorc(sb->curr + co->top, co->left); - SLsmg_set_char_set(1); - - /*if (isOn) - SLsmg_set_color(sb->csThumb); - else*/ - SLsmg_set_color(sb->cs); - - SLsmg_write_char(ch); - SLsmg_set_char_set(0); -} - -static void sbDestroy(newtComponent co) { - struct scrollbar * sb = co->data; - - free(sb); - free(co); -} diff --git a/mdk-stage1/newt/textbox.c b/mdk-stage1/newt/textbox.c deleted file mode 100644 index 8eb4ae4db..000000000 --- a/mdk-stage1/newt/textbox.c +++ /dev/null @@ -1,409 +0,0 @@ -#include <ctype.h> -#include <slang.h> -#include <stdlib.h> -#include <string.h> - -#include "newt.h" -#include "newt_pr.h" - -struct textbox { - char ** lines; - int numLines; - int linesAlloced; - int doWrap; - newtComponent sb; - int topLine; - int textWidth; -}; - -static char * expandTabs(const char * text); -static void textboxDraw(newtComponent co); -static void addLine(newtComponent co, const char * s, int len); -static void doReflow(const char * text, char ** resultPtr, int width, - int * badness, int * heightPtr); -static struct eventResult textboxEvent(newtComponent c, - struct event ev); -static void textboxDestroy(newtComponent co); -static void textboxPlace(newtComponent co, int newLeft, int newTop); -static void textboxMapped(newtComponent co, int isMapped); - -static struct componentOps textboxOps = { - textboxDraw, - textboxEvent, - textboxDestroy, - textboxPlace, - textboxMapped, -} ; - -static void textboxMapped(newtComponent co, int isMapped) { - struct textbox * tb = co->data; - - co->isMapped = isMapped; - if (tb->sb) - tb->sb->ops->mapped(tb->sb, isMapped); -} - -static void textboxPlace(newtComponent co, int newLeft, int newTop) { - struct textbox * tb = co->data; - - co->top = newTop; - co->left = newLeft; - - if (tb->sb) - tb->sb->ops->place(tb->sb, co->left + co->width - 1, co->top); -} - -void newtTextboxSetHeight(newtComponent co, int height) { - co->height = height; -} - -int newtTextboxGetNumLines(newtComponent co) { - struct textbox * tb = co->data; - - return (tb->numLines); -} - -newtComponent newtTextboxReflowed(int left, int top, char * text, int width, - int flexDown, int flexUp, int flags __attribute__ ((unused))) { - newtComponent co; - char * reflowedText; - int actWidth, actHeight; - - reflowedText = newtReflowText(text, width, flexDown, flexUp, - &actWidth, &actHeight); - - co = newtTextbox(left, top, actWidth, actHeight, NEWT_FLAG_WRAP); - newtTextboxSetText(co, reflowedText); - free(reflowedText); - - return co; -} - -newtComponent newtTextbox(int left, int top, int width, int height, int flags) { - newtComponent co; - struct textbox * tb; - - co = malloc(sizeof(*co)); - tb = malloc(sizeof(*tb)); - co->data = tb; - - co->ops = &textboxOps; - - co->height = height; - co->top = top; - co->left = left; - co->takesFocus = 0; - co->width = width; - - tb->doWrap = flags & NEWT_FLAG_WRAP; - tb->numLines = 0; - tb->linesAlloced = 0; - tb->lines = NULL; - tb->topLine = 0; - tb->textWidth = width; - - if (flags & NEWT_FLAG_SCROLL) { - co->width += 2; - tb->sb = newtVerticalScrollbar(co->left + co->width - 1, co->top, - co->height, COLORSET_TEXTBOX, COLORSET_TEXTBOX); - } else { - tb->sb = NULL; - } - - return co; -} - -static char * expandTabs(const char * text) { - int bufAlloced = strlen(text) + 40; - char * buf, * dest; - const char * src; - int bufUsed = 0; - int linePos = 0; - int i; - - buf = malloc(bufAlloced + 1); - for (src = text, dest = buf; *src; src++) { - if ((bufUsed + 10) > bufAlloced) { - bufAlloced += strlen(text) / 2; - buf = realloc(buf, bufAlloced + 1); - dest = buf + bufUsed; - } - if (*src == '\t') { - i = 8 - (linePos & 8); - memset(dest, ' ', i); - dest += i, bufUsed += i, linePos += i; - } else { - if (*src == '\n') - linePos = 0; - else - linePos++; - - *dest++ = *src; - bufUsed++; - } - } - - *dest = '\0'; - return buf; -} - -#define iseuckanji(c) (0xa1 <= (unsigned char)(c&0xff) && (unsigned char)(c&0xff) <= 0xfe) - -static void doReflow(const char * text, char ** resultPtr, int width, - int * badness, int * heightPtr) { - char * result = NULL; - const char * chptr, * end; - int i; - int howbad = 0; - int height = 0; - int kanji = 0; - - if (resultPtr) { - /* XXX I think this will work */ - result = malloc(strlen(text) + (strlen(text) / width) + 50); - *result = '\0'; - } - - while (*text) { - kanji = 0; - end = strchr(text, '\n'); - if (!end) - end = text + strlen(text); - - while (*text && text < end) { - if (end - text < width) { - if (result) { - strncat(result, text, end - text); - strcat(result, "\n"); - height++; - } - - if (end - text < (width / 2)) - howbad += ((width / 2) - (end - text)) / 2; - text = end; - if (*text) text++; - } else { - chptr = text; - kanji = 0; - for ( i = 0; i < width - 1; i++ ) { - if ( !iseuckanji(*chptr)) { - kanji = 0; - } else if ( kanji == 1 ) { - kanji = 2; - } else { - kanji = 1; - } - chptr++; - } - if (kanji == 0) { - while (chptr > text && !isspace(*chptr)) chptr--; - while (chptr > text && isspace(*chptr)) chptr--; - chptr++; - } - - if (chptr-text == 1 && !isspace(*chptr)) - chptr = text + width - 1; - - if (chptr > text) - howbad += width - (chptr - text) + 1; - if (result) { - if (kanji == 1) { - strncat(result, text, chptr - text + 1); - chptr++; - kanji = 0; - } else { - strncat(result, text, chptr - text); - } - strcat(result, "\n"); - height++; - } - - if (isspace(*chptr)) - text = chptr + 1; - else - text = chptr; - while (isspace(*text)) text++; - } - } - } - -// if (result) printf("result: %s\n", result); - - if (badness) *badness = howbad; - if (resultPtr) *resultPtr = result; - if (heightPtr) *heightPtr = height; -} - -char * newtReflowText(char * text, int width, int flexDown, int flexUp, - int * actualWidth, int * actualHeight) { - int min, max; - int i; - char * result; - int minbad, minbadwidth, howbad; - char * expandedText; - - expandedText = expandTabs(text); - - if (flexDown || flexUp) { - min = width - flexDown; - max = width + flexUp; - - minbad = -1; - minbadwidth = width; - - for (i = min; i <= max; i++) { - doReflow(expandedText, NULL, i, &howbad, NULL); - - if (minbad == -1 || howbad < minbad) { - minbad = howbad; - minbadwidth = i; - } - } - - width = minbadwidth; - } - - doReflow(expandedText, &result, width, NULL, actualHeight); - free(expandedText); - if (actualWidth) *actualWidth = width; - return result; -} - -void newtTextboxSetText(newtComponent co, const char * text) { - const char * start, * end; - struct textbox * tb = co->data; - char * reflowed, * expanded; - int badness, height; - - if (tb->lines) { - free(tb->lines); - tb->linesAlloced = tb->numLines = 0; - } - - expanded = expandTabs(text); - - if (tb->doWrap) { - doReflow(expanded, &reflowed, tb->textWidth, &badness, &height); - free(expanded); - expanded = reflowed; - } - - for (start = expanded; *start; start++) - if (*start == '\n') tb->linesAlloced++; - - /* This ++ leaves room for an ending line w/o a \n */ - tb->linesAlloced++; - tb->lines = malloc(sizeof(char *) * tb->linesAlloced); - - start = expanded; - while ((end = strchr(start, '\n'))) { - addLine(co, start, end - start); - start = end + 1; - } - - if (*start) - addLine(co, start, strlen(start)); - - free(expanded); -} - -/* This assumes the buffer is allocated properly! */ -static void addLine(newtComponent co, const char * s, int len) { - struct textbox * tb = co->data; - - if (len > tb->textWidth) len = tb->textWidth; - - tb->lines[tb->numLines] = malloc(tb->textWidth + 1); - memset(tb->lines[tb->numLines], ' ', tb->textWidth); - memcpy(tb->lines[tb->numLines], s, len); - tb->lines[tb->numLines++][tb->textWidth] = '\0'; -} - -static void textboxDraw(newtComponent c) { - int i; - struct textbox * tb = c->data; - int size; - - if (tb->sb) { - size = tb->numLines - c->height; - newtScrollbarSet(tb->sb, tb->topLine, size ? size : 0); - tb->sb->ops->draw(tb->sb); - } - - SLsmg_set_color(NEWT_COLORSET_TEXTBOX); - - for (i = 0; (i + tb->topLine) < tb->numLines && i < c->height; i++) { - newtGotorc(c->top + i, c->left); - SLsmg_write_string(tb->lines[i + tb->topLine]); - } -} - -static struct eventResult textboxEvent(newtComponent co, - struct event ev) { - struct textbox * tb = co->data; - struct eventResult er; - - er.result = ER_IGNORED; - - if (ev.when == EV_EARLY && ev.event == EV_KEYPRESS && tb->sb) { - switch (ev.u.key) { - case NEWT_KEY_UP: - if (tb->topLine) tb->topLine--; - textboxDraw(co); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_DOWN: - if (tb->topLine < (tb->numLines - co->height)) tb->topLine++; - textboxDraw(co); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_PGDN: - tb->topLine += co->height; - if (tb->topLine > (tb->numLines - co->height)) { - tb->topLine = tb->numLines - co->height; - if (tb->topLine < 0) tb->topLine = 0; - } - textboxDraw(co); - er.result = ER_SWALLOWED; - break; - - case NEWT_KEY_PGUP: - tb->topLine -= co->height; - if (tb->topLine < 0) tb->topLine = 0; - textboxDraw(co); - er.result = ER_SWALLOWED; - break; - } - } - if (ev.when == EV_EARLY && ev.event == EV_MOUSE && tb->sb) { - /* Top scroll arrow */ - if (ev.u.mouse.x == co->width && ev.u.mouse.y == co->top) { - if (tb->topLine) tb->topLine--; - textboxDraw(co); - - er.result = ER_SWALLOWED; - } - /* Bottom scroll arrow */ - if (ev.u.mouse.x == co->width && - ev.u.mouse.y == co->top + co->height - 1) { - if (tb->topLine < (tb->numLines - co->height)) tb->topLine++; - textboxDraw(co); - - er.result = ER_SWALLOWED; - } - } - return er; -} - -static void textboxDestroy(newtComponent co) { - int i; - struct textbox * tb = co->data; - - for (i = 0; i < tb->numLines; i++) - free(tb->lines[i]); - free(tb->lines); - free(tb); - free(co); -} diff --git a/mdk-stage1/newt/windows.c b/mdk-stage1/newt/windows.c deleted file mode 100644 index 30a8d526c..000000000 --- a/mdk-stage1/newt/windows.c +++ /dev/null @@ -1,275 +0,0 @@ -#include <errno.h> -#include <stdarg.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -#include "errno.h" -#include "newt.h" - -static void * newtvwindow(char * title, char * button1, char * button2, - char * button3, char * message, va_list args) { - newtComponent b1, b2 = NULL, b3 = NULL, t, f, answer; - char * buf = NULL; - int size = 0; - int i = 0; - int scroll = 0; - int width, height; - char * flowedText; - newtGrid grid, buttonGrid; - - do { - size += 1000; - if (buf) free(buf); - buf = malloc(size); - i = vsnprintf(buf, size, message, args); - } while (i >= size || i == -1); - - flowedText = newtReflowText(buf, 50, 5, 5, &width, &height); - if (height > 6) { - free(flowedText); - flowedText = newtReflowText(buf, 60, 5, 5, &width, &height); - } - free(buf); - - if (height > 12) { - height = 12; - scroll = NEWT_FLAG_SCROLL; - } - t = newtTextbox(-1, -1, width, height, NEWT_TEXTBOX_WRAP | scroll); - newtTextboxSetText(t, flowedText); - free(flowedText); - - if (button3) { - buttonGrid = newtButtonBar(button1, &b1, button2, &b2, - button3, &b3, NULL); - } else if (button2) { - buttonGrid = newtButtonBar(button1, &b1, button2, &b2, NULL); - } else { - buttonGrid = newtButtonBar(button1, &b1, NULL); - } - - newtGridSetField(buttonGrid, 0, 0, NEWT_GRID_COMPONENT, b1, - 0, 0, button2 ? 1 : 0, 0, 0, 0); - - grid = newtCreateGrid(1, 2); - newtGridSetField(grid, 0, 0, NEWT_GRID_COMPONENT, t, 0, 0, 0, 0, 0, 0); - newtGridSetField(grid, 0, 1, NEWT_GRID_SUBGRID, buttonGrid, - 0, 1, 0, 0, 0, NEWT_GRID_FLAG_GROWX); - newtGridWrappedWindow(grid, title); - - f = newtForm(NULL, NULL, 0); - newtFormAddComponents(f, t, b1, NULL); - - if (button2) - newtFormAddComponent(f, b2); - if (button3) - newtFormAddComponent(f, b3); - - answer = newtRunForm(f); - newtGridFree(grid, 1); - - newtFormDestroy(f); - newtPopWindow(); - - if (answer == f) - return NULL; - else if (answer == b1) - return button1; - else if (answer == b2) - return button2; - - return button3; -} - -int newtWinChoice(char * title, char * button1, char * button2, - char * message, ...) { - va_list args; - void * rc; - - va_start(args, message); - rc = newtvwindow(title, button1, button2, NULL, message, args); - va_end(args); - - if (rc == button1) - return 1; - else if (rc == button2) - return 2; - - return 0; -} - -void newtWinMessage(char * title, char * buttonText, char * text, ...) { - va_list args; - - va_start(args, text); - newtvwindow(title, buttonText, NULL, NULL, text, args); - va_end(args); -} - -void newtWinMessagev(char * title, char * buttonText, char * text, - va_list argv) { - newtvwindow(title, buttonText, NULL, NULL, text, argv); -} - -int newtWinTernary(char * title, char * button1, char * button2, - char * button3, char * message, ...) { - va_list args; - void * rc; - - va_start(args, message); - rc = newtvwindow(title, button1, button2, button3, message, args); - va_end(args); - - if (rc == button1) - return 1; - else if (rc == button2) - return 2; - else if (rc == button3) - return 3; - - return 0; -} - -/* only supports up to 50 buttons -- shucks! */ -int newtWinMenu(char * title, char * text, int suggestedWidth, int flexDown, - int flexUp, int maxListHeight, char ** items, int * listItem, - char * button1, ...) { - newtComponent textbox, listbox, result, form; - va_list args; - newtComponent buttons[50]; - newtGrid grid, buttonBar; - int numButtons; - int i, rc; - int needScroll; - char * buttonName; - - textbox = newtTextboxReflowed(-1, -1, text, suggestedWidth, flexDown, - flexUp, 0); - - for (i = 0; items[i]; i++) ; - if (i < maxListHeight) maxListHeight = i; - needScroll = i > maxListHeight; - - listbox = newtListbox(-1, -1, maxListHeight, - (needScroll ? NEWT_FLAG_SCROLL : 0) | NEWT_FLAG_RETURNEXIT); - for (i = 0; items[i]; i++) { - newtListboxAddEntry(listbox, items[i], (void *) (long)i); - } - - newtListboxSetCurrent(listbox, *listItem); - - buttonName = button1, numButtons = 0; - va_start(args, button1); - while (buttonName) { - buttons[numButtons] = newtButton(-1, -1, buttonName); - numButtons++; - buttonName = va_arg(args, char *); - } - - va_end(args); - - buttonBar = newtCreateGrid(numButtons, 1); - for (i = 0; i < numButtons; i++) { - newtGridSetField(buttonBar, i, 0, NEWT_GRID_COMPONENT, - buttons[i], - i ? 1 : 0, 0, 0, 0, 0, 0); - } - - grid = newtGridSimpleWindow(textbox, listbox, buttonBar); - newtGridWrappedWindow(grid, title); - - form = newtForm(NULL, 0, 0); - newtGridAddComponentsToForm(grid, form, 1); - newtGridFree(grid, 1); - - result = newtRunForm(form); - - *listItem = ((long) newtListboxGetCurrent(listbox)); - - for (rc = 0; result != buttons[rc] && rc < numButtons; rc++); - if (rc == numButtons) - rc = 0; /* F12 or return-on-exit (which are the same for us) */ - else - rc++; - - newtFormDestroy(form); - newtPopWindow(); - - return rc; -} - -/* only supports up to 50 buttons and entries -- shucks! */ -int newtWinEntries(char * title, char * text, int suggestedWidth, int flexDown, - int flexUp, int dataWidth, - struct newtWinEntry * items, char * button1, ...) { - newtComponent buttons[50], result, form, textw; - newtGrid grid, buttonBar, subgrid; - int numItems; - int rc, i; - int numButtons; - char * buttonName; - va_list args; - - textw = newtTextboxReflowed(-1, -1, text, suggestedWidth, flexDown, - flexUp, 0); - - for (numItems = 0; items[numItems].text; numItems++); - - buttonName = button1, numButtons = 0; - va_start(args, button1); - while (buttonName) { - buttons[numButtons] = newtButton(-1, -1, buttonName); - numButtons++; - buttonName = va_arg(args, char *); - } - - va_end(args); - - buttonBar = newtCreateGrid(numButtons, 1); - for (i = 0; i < numButtons; i++) { - newtGridSetField(buttonBar, i, 0, NEWT_GRID_COMPONENT, - buttons[i], - i ? 1 : 0, 0, 0, 0, 0, 0); - } - - subgrid = newtCreateGrid(2, numItems); - for (i = 0; i < numItems; i++) { - newtGridSetField(subgrid, 0, i, NEWT_GRID_COMPONENT, - newtLabel(-1, -1, items[i].text), - 0, 0, 0, 0, NEWT_ANCHOR_LEFT, 0); - newtGridSetField(subgrid, 1, i, NEWT_GRID_COMPONENT, - newtEntry(-1, -1, items[i].value ? - *items[i].value : NULL, dataWidth, - items[i].value, items[i].flags), - 1, 0, 0, 0, 0, 0); - } - - grid = newtCreateGrid(1, 3); - form = newtForm(NULL, 0, 0); - newtGridSetField(grid, 0, 0, NEWT_GRID_COMPONENT, textw, - 0, 0, 0, 0, NEWT_ANCHOR_LEFT, 0); - newtGridSetField(grid, 0, 1, NEWT_GRID_SUBGRID, subgrid, - 0, 1, 0, 0, 0, 0); - newtGridSetField(grid, 0, 2, NEWT_GRID_SUBGRID, buttonBar, - 0, 1, 0, 0, 0, NEWT_GRID_FLAG_GROWX); - newtGridAddComponentsToForm(grid, form, 1); - newtGridWrappedWindow(grid, title); - newtGridFree(grid, 1); - - result = newtRunForm(form); - - for (rc = 0; rc < numItems; rc++) - *items[rc].value = strdup(*items[rc].value); - - for (rc = 0; result != buttons[rc] && rc < numButtons; rc++); - if (rc == numButtons) - rc = 0; /* F12 */ - else - rc++; - - newtFormDestroy(form); - newtPopWindow(); - - return rc; -} diff --git a/mdk-stage1/nfs_mount4.h b/mdk-stage1/nfs_mount4.h deleted file mode 100644 index 85650773a..000000000 --- a/mdk-stage1/nfs_mount4.h +++ /dev/null @@ -1,54 +0,0 @@ -/* - * We want to be able to compile mount on old kernels in such a way - * that the binary will work well on more recent kernels. - * Thus, if necessary we teach nfsmount.c the structure of new fields - * that will come later. - * - * Moreover, the new kernel includes conflict with glibc includes - * so it is easiest to ignore the kernel altogether (at compile time). - */ - -#define NFS_MOUNT_VERSION 4 - -struct nfs2_fh { - char data[32]; -}; -struct nfs3_fh { - unsigned short size; - unsigned char data[64]; -}; - -struct nfs_mount_data { - int version; /* 1 */ - int fd; /* 1 */ - struct nfs2_fh old_root; /* 1 */ - int flags; /* 1 */ - int rsize; /* 1 */ - int wsize; /* 1 */ - int timeo; /* 1 */ - int retrans; /* 1 */ - int acregmin; /* 1 */ - int acregmax; /* 1 */ - int acdirmin; /* 1 */ - int acdirmax; /* 1 */ - struct sockaddr_in addr; /* 1 */ - char hostname[256]; /* 1 */ - int namlen; /* 2 */ - unsigned int bsize; /* 3 */ - struct nfs3_fh root; /* 4 */ -}; - -/* bits in the flags field */ - -#define NFS_MOUNT_SOFT 0x0001 /* 1 */ -#define NFS_MOUNT_INTR 0x0002 /* 1 */ -#define NFS_MOUNT_SECURE 0x0004 /* 1 */ -#define NFS_MOUNT_POSIX 0x0008 /* 1 */ -#define NFS_MOUNT_NOCTO 0x0010 /* 1 */ -#define NFS_MOUNT_NOAC 0x0020 /* 1 */ -#define NFS_MOUNT_TCP 0x0040 /* 2 */ -#define NFS_MOUNT_VER3 0x0080 /* 3 */ -#define NFS_MOUNT_KERBEROS 0x0100 /* 3 */ -#define NFS_MOUNT_NONLM 0x0200 /* 3 */ -#define NFS_MOUNT_BROKEN_SUID 0x0400 /* 4 */ - diff --git a/mdk-stage1/nfsmount.c b/mdk-stage1/nfsmount.c deleted file mode 100644 index 0345098f9..000000000 --- a/mdk-stage1/nfsmount.c +++ /dev/null @@ -1,735 +0,0 @@ - /* - * Guillaume Cottenceau (gc) - * - * Copyright 2003 Mandriva - * - * This software may be freely redistributed under the terms of the GNU - * public license. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - * - * basing on nfsmount.c from util-linux-2.11z: - * - use our logging facilities - * - use our host resolving stuff - * - remove unneeded code - */ - -/* - * nfsmount.c -- Linux NFS mount - * Copyright (C) 1993 Rick Sladkey <jrs@world.std.com> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * Wed Feb 8 12:51:48 1995, biro@yggdrasil.com (Ross Biro): allow all port - * numbers to be specified on the command line. - * - * Fri, 8 Mar 1996 18:01:39, Swen Thuemmler <swen@uni-paderborn.de>: - * Omit the call to connect() for Linux version 1.3.11 or later. - * - * Wed Oct 1 23:55:28 1997: Dick Streefland <dick_streefland@tasking.com> - * Implemented the "bg", "fg" and "retry" mount options for NFS. - * - * 1999-02-22 Arkadiusz Miśkiewicz <misiek@pld.ORG.PL> - * - added Native Language Support - * - * Modified by Olaf Kirch and Trond Myklebust for new NFS code, - * plus NFSv3 stuff. - * - * 2003-04-14 David Black <david.black@xilinx.com> - * - added support for multiple hostname NFS mounts - */ - -/* - * nfsmount.c,v 1.1.1.1 1993/11/18 08:40:51 jrs Exp - */ - -#define HAVE_rpcsvc_nfs_prot_h -#define HAVE_inet_aton - -#include <unistd.h> -#include <stdio.h> -#include <string.h> -#include <errno.h> -#include <netdb.h> -#include <time.h> -#include <rpc/rpc.h> -#include <rpc/pmap_prot.h> -#include <rpc/pmap_clnt.h> -#include <sys/socket.h> -#include <sys/time.h> -#include <sys/utsname.h> -#include <sys/stat.h> -#include <netinet/in.h> -#include <arpa/inet.h> -#include <values.h> - -#include "nfsmount.h" - -#ifdef HAVE_rpcsvc_nfs_prot_h -#include <rpcsvc/nfs_prot.h> -#else -#include <linux/nfs.h> -#define nfsstat nfs_stat -#endif - -#include "nfs_mount4.h" - -#include "log.h" -#include "dns.h" - -#ifndef NFS_PORT -#define NFS_PORT 2049 -#endif -#ifndef NFS_FHSIZE -#define NFS_FHSIZE 32 -#endif - -static char *nfs_strerror(int stat); - -#define MAKE_VERSION(p,q,r) (65536*(p) + 256*(q) + (r)) - -#define MAX_NFSPROT ((nfs_mount_version >= 4) ? 3 : 2) - -bool_t -xdr_fhandle3 (XDR *xdrs, fhandle3 *objp) -{ - if (!xdr_bytes (xdrs, (char **)&objp->fhandle3_val, (u_int *) &objp->fhandle3_len, FHSIZE3)) - return FALSE; - return TRUE; -} - -bool_t -xdr_mountstat3 (XDR *xdrs, mountstat3 *objp) -{ - if (!xdr_enum (xdrs, (enum_t *) objp)) - return FALSE; - return TRUE; -} - -bool_t -xdr_mountres3_ok (XDR *xdrs, mountres3_ok *objp) -{ - if (!xdr_fhandle3 (xdrs, &objp->fhandle)) - return FALSE; - if (!xdr_array (xdrs, (char **)&objp->auth_flavours.auth_flavours_val, (u_int *) &objp->auth_flavours.auth_flavours_len, ~0, - sizeof (int), (xdrproc_t) xdr_int)) - return FALSE; - return TRUE; -} - -bool_t -xdr_mountres3 (XDR *xdrs, mountres3 *objp) -{ - if (!xdr_mountstat3 (xdrs, &objp->fhs_status)) - return FALSE; - switch (objp->fhs_status) { - case MNT_OK: - if (!xdr_mountres3_ok (xdrs, &objp->mountres3_u.mountinfo)) - return FALSE; - break; - default: - break; - } - return TRUE; -} - -bool_t -xdr_dirpath (XDR *xdrs, dirpath *objp) -{ - if (!xdr_string (xdrs, objp, MNTPATHLEN)) - return FALSE; - return TRUE; -} - -bool_t -xdr_fhandle (XDR *xdrs, fhandle objp) -{ - if (!xdr_opaque (xdrs, objp, FHSIZE)) - return FALSE; - return TRUE; -} - -bool_t -xdr_fhstatus (XDR *xdrs, fhstatus *objp) -{ - if (!xdr_u_int (xdrs, &objp->fhs_status)) - return FALSE; - switch (objp->fhs_status) { - case 0: - if (!xdr_fhandle (xdrs, objp->fhstatus_u.fhs_fhandle)) - return FALSE; - break; - default: - break; - } - return TRUE; -} - - -static int -linux_version_code(void) { - struct utsname my_utsname; - int p, q, r; - - if (uname(&my_utsname) == 0) { - p = atoi(strtok(my_utsname.release, ".")); - q = atoi(strtok(NULL, ".")); - r = atoi(strtok(NULL, ".")); - return MAKE_VERSION(p,q,r); - } - return 0; -} - -/* - * Unfortunately, the kernel prints annoying console messages - * in case of an unexpected nfs mount version (instead of - * just returning some error). Therefore we'll have to try - * and figure out what version the kernel expects. - * - * Variables: - * NFS_MOUNT_VERSION: these nfsmount sources at compile time - * nfs_mount_version: version this source and running kernel can handle - */ -static int -find_kernel_nfs_mount_version(void) { - static int kernel_version = -1; - int nfs_mount_version = NFS_MOUNT_VERSION; - - if (kernel_version == -1) - kernel_version = linux_version_code(); - - if (kernel_version) { - if (kernel_version < MAKE_VERSION(2,1,32)) - nfs_mount_version = 1; - else if (kernel_version < MAKE_VERSION(2,2,18)) - nfs_mount_version = 3; - else if (kernel_version < MAKE_VERSION(2,3,0)) - nfs_mount_version = 4; /* since 2.2.18pre9 */ - else if (kernel_version < MAKE_VERSION(2,3,99)) - nfs_mount_version = 3; - else - nfs_mount_version = 4; /* since 2.3.99pre4 */ - } - if (nfs_mount_version > NFS_MOUNT_VERSION) - nfs_mount_version = NFS_MOUNT_VERSION; - log_message("nfsmount: kernel_nfs_mount_version: %d", nfs_mount_version); - return nfs_mount_version; -} - -static struct pmap * -get_mountport(struct sockaddr_in *server_addr, - long unsigned prog, - long unsigned version, - long unsigned proto, - long unsigned port, - int nfs_mount_version) -{ - struct pmaplist *pmap; - static struct pmap p = {0, 0, 0, 0}; - - if (version > MAX_NFSPROT) - version = MAX_NFSPROT; - if (!prog) - prog = MOUNTPROG; - p.pm_prog = prog; - p.pm_vers = version; - p.pm_prot = proto; - p.pm_port = port; - - server_addr->sin_port = PMAPPORT; - pmap = pmap_getmaps(server_addr); - - while (pmap) { - if (pmap->pml_map.pm_prog != prog) - goto next; - if (!version && p.pm_vers > pmap->pml_map.pm_vers) - goto next; - if (version > 2 && pmap->pml_map.pm_vers != version) - goto next; - if (version && version <= 2 && pmap->pml_map.pm_vers > 2) - goto next; - if (pmap->pml_map.pm_vers > MAX_NFSPROT || - (proto && p.pm_prot && pmap->pml_map.pm_prot != proto) || - (port && pmap->pml_map.pm_port != port)) - goto next; - memcpy(&p, &pmap->pml_map, sizeof(p)); - next: - pmap = pmap->pml_next; - } - if (!p.pm_vers) - p.pm_vers = MOUNTVERS; - if (!p.pm_prot) - p.pm_prot = IPPROTO_TCP; - return &p; -} - - - -int nfsmount_prepare(const char *spec, char **mount_opts) -{ - char hostdir[1024]; - CLIENT *mclient; - char *hostname, *dirname, *mounthost = NULL; - struct timeval total_timeout; - enum clnt_stat clnt_stat; - static struct nfs_mount_data data; - int nfs_mount_version; - struct sockaddr_in server_addr; - struct sockaddr_in mount_server_addr; - struct pmap *pm_mnt; - int msock, fsock; - struct timeval retry_timeout; - union { - struct fhstatus nfsv2; - struct mountres3 nfsv3; - } status; - char *s; - int port, mountport, proto, soft, intr; - int posix, nocto, noac, broken_suid, nolock; - int tcp; - int mountprog, mountvers, nfsprog, nfsvers; - int retval; - time_t t; - time_t prevt; - - nfs_mount_version = find_kernel_nfs_mount_version(); - - retval = -1; - msock = fsock = -1; - mclient = NULL; - if (strlen(spec) >= sizeof(hostdir)) { - log_message("nfsmount: excessively long host:dir argument"); - goto fail; - } - strcpy(hostdir, spec); - if ((s = strchr(hostdir, ':'))) { - hostname = hostdir; - dirname = s + 1; - *s = '\0'; - } else { - log_message("nfsmount: directory to mount not in host:dir format"); - goto fail; - } - - server_addr.sin_family = AF_INET; -#ifdef HAVE_inet_aton - if (!inet_aton(hostname, &server_addr.sin_addr)) -#endif - { - if (mygethostbyname(hostname, &server_addr.sin_addr)) { - log_message("nfsmount: can't get address for %s", hostname); - goto fail; - } - } - - memcpy (&mount_server_addr, &server_addr, sizeof (mount_server_addr)); - - - - /* Set default options. - * rsize/wsize are set to 8192 to enable nfs install on - * old i586 machines - * timeo is filled in after we know whether it'll be TCP or UDP. */ - memset(&data, 0, sizeof(data)); - data.rsize = 8192; - data.wsize = 8192; - data.retrans = 30; - data.acregmin = 3; - data.acregmax = 60; - data.acdirmin = 30; - data.acdirmax = 60; -#if NFS_MOUNT_VERSION >= 2 - data.namlen = NAME_MAX; -#endif - - soft = 1; - intr = 0; - posix = 0; - nocto = 0; - nolock = 1; - broken_suid = 0; - noac = 0; - tcp = 0; - - mountprog = MOUNTPROG; - mountvers = 0; - port = 0; - mountport = 0; - nfsprog = NFS_PROGRAM; - nfsvers = 0; - - - -retry_mount: - proto = (tcp) ? IPPROTO_TCP : IPPROTO_UDP; - - data.flags = (soft ? NFS_MOUNT_SOFT : 0) - | (intr ? NFS_MOUNT_INTR : 0) - | (posix ? NFS_MOUNT_POSIX : 0) - | (nocto ? NFS_MOUNT_NOCTO : 0) - | (noac ? NFS_MOUNT_NOAC : 0); -#if NFS_MOUNT_VERSION >= 2 - if (nfs_mount_version >= 2) - data.flags |= (tcp ? NFS_MOUNT_TCP : 0); -#endif -#if NFS_MOUNT_VERSION >= 3 - if (nfs_mount_version >= 3) - data.flags |= (nolock ? NFS_MOUNT_NONLM : 0); -#endif -#if NFS_MOUNT_VERSION >= 4 - if (nfs_mount_version >= 4) - data.flags |= (broken_suid ? NFS_MOUNT_BROKEN_SUID : 0); -#endif - if (nfsvers > MAX_NFSPROT) { - log_message("NFSv%d not supported!", nfsvers); - return 0; - } - if (mountvers > MAX_NFSPROT) { - log_message("NFSv%d not supported!", nfsvers); - return 0; - } - if (nfsvers && !mountvers) - mountvers = (nfsvers < 3) ? 1 : nfsvers; - if (nfsvers && nfsvers < mountvers) - mountvers = nfsvers; - - /* Adjust options if none specified */ - if (!data.timeo) - data.timeo = tcp ? 70 : 7; - -#ifdef NFS_MOUNT_DEBUG - log_message("rsize = %d, wsize = %d, timeo = %d, retrans = %d", - data.rsize, data.wsize, data.timeo, data.retrans); - log_message("acreg (min, max) = (%d, %d), acdir (min, max) = (%d, %d)", - data.acregmin, data.acregmax, data.acdirmin, data.acdirmax); - log_message("port = %d, retry = %d, flags = %.8x", - port, retry, data.flags); - log_message("mountprog = %d, mountvers = %d, nfsprog = %d, nfsvers = %d", - mountprog, mountvers, nfsprog, nfsvers); - log_message("soft = %d, intr = %d, posix = %d, nocto = %d, noac = %d", - (data.flags & NFS_MOUNT_SOFT) != 0, - (data.flags & NFS_MOUNT_INTR) != 0, - (data.flags & NFS_MOUNT_POSIX) != 0, - (data.flags & NFS_MOUNT_NOCTO) != 0, - (data.flags & NFS_MOUNT_NOAC) != 0); -#if NFS_MOUNT_VERSION >= 2 - log_message("tcp = %d", - (data.flags & NFS_MOUNT_TCP) != 0); -#endif -#endif - - data.version = nfs_mount_version; - *mount_opts = (char *) &data; - - - /* create mount deamon client */ - /* See if the nfs host = mount host. */ - if (mounthost) { - if (mounthost[0] >= '0' && mounthost[0] <= '9') { - mount_server_addr.sin_family = AF_INET; - mount_server_addr.sin_addr.s_addr = inet_addr(hostname); - } else { - if (mygethostbyname(mounthost, &mount_server_addr.sin_addr)) { - log_message("nfsmount: can't get address for %s", mounthost); - goto fail; - } - } - } - - /* - * The following loop implements the mount retries. On the first - * call, "running_bg" is 0. When the mount times out, and the - * "bg" option is set, the exit status EX_BG will be returned. - * For a backgrounded mount, there will be a second call by the - * child process with "running_bg" set to 1. - * - * The case where the mount point is not present and the "bg" - * option is set, is treated as a timeout. This is done to - * support nested mounts. - * - * The "retry" count specified by the user is the number of - * minutes to retry before giving up. - * - * Only the first error message will be displayed. - */ - retry_timeout.tv_sec = 3; - retry_timeout.tv_usec = 0; - total_timeout.tv_sec = 20; - total_timeout.tv_usec = 0; - prevt = 0; - t = 30; - - - /* be careful not to use too many CPU cycles */ - if (t - prevt < 30) - sleep(30); - - pm_mnt = get_mountport(&mount_server_addr, - mountprog, - mountvers, - proto, - mountport, - nfs_mount_version); - - /* contact the mount daemon via TCP */ - mount_server_addr.sin_port = htons(pm_mnt->pm_port); - msock = RPC_ANYSOCK; - - switch (pm_mnt->pm_prot) { - case IPPROTO_UDP: - mclient = clntudp_create(&mount_server_addr, - pm_mnt->pm_prog, - pm_mnt->pm_vers, - retry_timeout, - &msock); - if (mclient) - break; - mount_server_addr.sin_port = - htons(pm_mnt->pm_port); - msock = RPC_ANYSOCK; - case IPPROTO_TCP: - mclient = clnttcp_create(&mount_server_addr, - pm_mnt->pm_prog, - pm_mnt->pm_vers, - &msock, 0, 0); - break; - default: - mclient = 0; - } - - if (mclient) { - /* try to mount hostname:dirname */ - mclient->cl_auth = authunix_create_default(); - - /* make pointers in xdr_mountres3 NULL so - * that xdr_array allocates memory for us - */ - memset(&status, 0, sizeof(status)); - - log_message("nfsmount: doing client call in nfs version: %ld", pm_mnt->pm_vers); - if (pm_mnt->pm_vers == 3) - clnt_stat = clnt_call(mclient, - MOUNTPROC3_MNT, - (xdrproc_t) xdr_dirpath, - (caddr_t) &dirname, - (xdrproc_t) xdr_mountres3, - (caddr_t) &status, - total_timeout); - else - clnt_stat = clnt_call(mclient, - MOUNTPROC_MNT, - (xdrproc_t) xdr_dirpath, - (caddr_t) &dirname, - (xdrproc_t) xdr_fhstatus, - (caddr_t) &status, - total_timeout); - - if (clnt_stat == RPC_SUCCESS) - goto succeeded; - - if (prevt == 0) - log_message("could not call server: probably protocol or version error"); - auth_destroy(mclient->cl_auth); - clnt_destroy(mclient); - mclient = 0; - close(msock); - } else { - log_message("could not create rpc client: host probably not found or NFS server is down"); - } - prevt = t; - - goto fail; - - succeeded: - nfsvers = (pm_mnt->pm_vers < 2) ? 2 : pm_mnt->pm_vers; - - if (nfsvers == 2) { - if (status.nfsv2.fhs_status != 0) { - log_message("nfsmount: %s:%s failed, reason given by server: %s", - hostname, dirname, nfs_strerror(status.nfsv2.fhs_status)); - goto fail; - } - memcpy(data.root.data, - (char *) status.nfsv2.fhstatus_u.fhs_fhandle, - NFS_FHSIZE); -#if NFS_MOUNT_VERSION >= 4 - data.root.size = NFS_FHSIZE; - memcpy(data.old_root.data, - (char *) status.nfsv2.fhstatus_u.fhs_fhandle, - NFS_FHSIZE); -#endif - } else { -#if NFS_MOUNT_VERSION >= 4 - fhandle3 *fhandle; - if (status.nfsv3.fhs_status != 0) { - log_message("nfsmount: %s:%s failed, reason given by server: %s", - hostname, dirname, nfs_strerror(status.nfsv3.fhs_status)); - goto fail; - } - fhandle = &status.nfsv3.mountres3_u.mountinfo.fhandle; - memset(data.old_root.data, 0, NFS_FHSIZE); - memset(&data.root, 0, sizeof(data.root)); - data.root.size = fhandle->fhandle3_len; - memcpy(data.root.data, - (char *) fhandle->fhandle3_val, - fhandle->fhandle3_len); - - data.flags |= NFS_MOUNT_VER3; -#endif - } - - /* create nfs socket for kernel */ - - if (tcp) { - if (nfs_mount_version < 3) { - log_message("NFS over TCP is not supported."); - goto fail; - } - fsock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); - } else - fsock = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP); - if (fsock < 0) { - log_perror("nfs socket"); - goto fail; - } - if (bindresvport(fsock, 0) < 0) { - log_perror("nfs bindresvport"); - goto fail; - } - if (port == 0) { - server_addr.sin_port = PMAPPORT; - port = pmap_getport(&server_addr, nfsprog, nfsvers, - tcp ? IPPROTO_TCP : IPPROTO_UDP); -#if 1 - /* Here we check to see if user is mounting with the - * tcp option. If so, and if the portmap returns a - * '0' for port (service unavailable), we then notify - * the user, and retry with udp. - */ - if (port == 0 && tcp == 1) { - log_message("NFS server reported TCP not available, retrying with UDP..."); - tcp = 0; - goto retry_mount; - } -#endif - - if (port == 0) - port = NFS_PORT; -#ifdef NFS_MOUNT_DEBUG - else - log_message("used portmapper to find NFS port"); -#endif - } -#ifdef NFS_MOUNT_DEBUG - log_message("using port %d for nfs deamon", port); -#endif - server_addr.sin_port = htons(port); - /* - * connect() the socket for kernels 1.3.10 and below only, - * to avoid problems with multihomed hosts. - * --Swen - */ - if (linux_version_code() <= 66314 - && connect(fsock, (struct sockaddr *) &server_addr, - sizeof (server_addr)) < 0) { - log_perror("nfs connect"); - goto fail; - } - - /* prepare data structure for kernel */ - - data.fd = fsock; - memcpy((char *) &data.addr, (char *) &server_addr, sizeof(data.addr)); - strncpy(data.hostname, hostname, sizeof(data.hostname)); - - /* clean up */ - - auth_destroy(mclient->cl_auth); - clnt_destroy(mclient); - close(msock); - return 0; - - /* abort */ - - fail: - if (msock != -1) { - if (mclient) { - auth_destroy(mclient->cl_auth); - clnt_destroy(mclient); - } - close(msock); - } - if (fsock != -1) - close(fsock); - return retval; -} - -/* - * We need to translate between nfs status return values and - * the local errno values which may not be the same. - * - * Andreas Schwab <schwab@LS5.informatik.uni-dortmund.de>: change errno: - * "after #include <errno.h> the symbol errno is reserved for any use, - * it cannot even be used as a struct tag or field name". - */ - -#ifndef EDQUOT -#define EDQUOT ENOSPC -#endif - -static struct { - enum nfsstat stat; - int errnum; -} nfs_errtbl[] = { - { NFS_OK, 0 }, - { NFSERR_PERM, EPERM }, - { NFSERR_NOENT, ENOENT }, - { NFSERR_IO, EIO }, - { NFSERR_NXIO, ENXIO }, - { NFSERR_ACCES, EACCES }, - { NFSERR_EXIST, EEXIST }, - { NFSERR_NODEV, ENODEV }, - { NFSERR_NOTDIR, ENOTDIR }, - { NFSERR_ISDIR, EISDIR }, -#ifdef NFSERR_INVAL - { NFSERR_INVAL, EINVAL }, /* that Sun forgot */ -#endif - { NFSERR_FBIG, EFBIG }, - { NFSERR_NOSPC, ENOSPC }, - { NFSERR_ROFS, EROFS }, - { NFSERR_NAMETOOLONG, ENAMETOOLONG }, - { NFSERR_NOTEMPTY, ENOTEMPTY }, - { NFSERR_DQUOT, EDQUOT }, - { NFSERR_STALE, ESTALE }, -#ifdef EWFLUSH - { NFSERR_WFLUSH, EWFLUSH }, -#endif - /* Throw in some NFSv3 values for even more fun (HP returns these) */ - { 71, EREMOTE }, - - { -1, EIO } -}; - -static char *nfs_strerror(int stat) -{ - int i; - static char buf[256]; - - for (i = 0; nfs_errtbl[i].stat != (unsigned)-1; i++) { - if (nfs_errtbl[i].stat == (unsigned)stat) - return strerror(nfs_errtbl[i].errnum); - } - sprintf(buf, "unknown nfs status return value: %d", stat); - return buf; -} - diff --git a/mdk-stage1/nfsmount.h b/mdk-stage1/nfsmount.h deleted file mode 100644 index a27e8a8d7..000000000 --- a/mdk-stage1/nfsmount.h +++ /dev/null @@ -1,331 +0,0 @@ -/* - * Please do not edit this file. - * It was generated using rpcgen. - */ - -#ifndef _NFSMOUNT_H_RPCGEN -#define _NFSMOUNT_H_RPCGEN - -#include <rpc/rpc.h> - -int nfsmount_prepare(const char *spec, char **mount_opts); - - -#ifdef __cplusplus -extern "C" { -#endif - -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user or with the express written consent of - * Sun Microsystems, Inc. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -/* - * Copyright (c) 1985, 1990 by Sun Microsystems, Inc. - */ - -/* from @(#)mount.x 1.3 91/03/11 TIRPC 1.0 */ -#ifndef _rpcsvc_mount_h -#define _rpcsvc_mount_h -#include <asm/types.h> -#define MNTPATHLEN 1024 -#define MNTNAMLEN 255 -#define FHSIZE 32 -#define FHSIZE3 64 - -typedef char fhandle[FHSIZE]; - -typedef struct { - u_int fhandle3_len; - char *fhandle3_val; -} fhandle3; - -enum mountstat3 { - MNT_OK = 0, - MNT3ERR_PERM = 1, - MNT3ERR_NOENT = 2, - MNT3ERR_IO = 5, - MNT3ERR_ACCES = 13, - MNT3ERR_NOTDIR = 20, - MNT3ERR_INVAL = 22, - MNT3ERR_NAMETOOLONG = 63, - MNT3ERR_NOTSUPP = 10004, - MNT3ERR_SERVERFAULT = 10006, -}; -typedef enum mountstat3 mountstat3; - -struct fhstatus { - u_int fhs_status; - union { - fhandle fhs_fhandle; - } fhstatus_u; -}; -typedef struct fhstatus fhstatus; - -struct mountres3_ok { - fhandle3 fhandle; - struct { - u_int auth_flavours_len; - int *auth_flavours_val; - } auth_flavours; -}; -typedef struct mountres3_ok mountres3_ok; - -struct mountres3 { - mountstat3 fhs_status; - union { - mountres3_ok mountinfo; - } mountres3_u; -}; -typedef struct mountres3 mountres3; - -typedef char *dirpath; - -typedef char *name; - -typedef struct mountbody *mountlist; - -struct mountbody { - name ml_hostname; - dirpath ml_directory; - mountlist ml_next; -}; -typedef struct mountbody mountbody; - -typedef struct groupnode *groups; - -struct groupnode { - name gr_name; - groups gr_next; -}; -typedef struct groupnode groupnode; - -typedef struct exportnode *exports; - -struct exportnode { - dirpath ex_dir; - groups ex_groups; - exports ex_next; -}; -typedef struct exportnode exportnode; - -struct ppathcnf { - int pc_link_max; - short pc_max_canon; - short pc_max_input; - short pc_name_max; - short pc_path_max; - short pc_pipe_buf; - u_char pc_vdisable; - char pc_xxx; - short pc_mask[2]; -}; -typedef struct ppathcnf ppathcnf; -#endif /*!_rpcsvc_mount_h*/ - -#define MOUNTPROG 100005 -#define MOUNTVERS 1 - -#if defined(__STDC__) || defined(__cplusplus) -#define MOUNTPROC_NULL 0 -extern void * mountproc_null_1(void *, CLIENT *); -extern void * mountproc_null_1_svc(void *, struct svc_req *); -#define MOUNTPROC_MNT 1 -extern fhstatus * mountproc_mnt_1(dirpath *, CLIENT *); -extern fhstatus * mountproc_mnt_1_svc(dirpath *, struct svc_req *); -#define MOUNTPROC_DUMP 2 -extern mountlist * mountproc_dump_1(void *, CLIENT *); -extern mountlist * mountproc_dump_1_svc(void *, struct svc_req *); -#define MOUNTPROC_UMNT 3 -extern void * mountproc_umnt_1(dirpath *, CLIENT *); -extern void * mountproc_umnt_1_svc(dirpath *, struct svc_req *); -#define MOUNTPROC_UMNTALL 4 -extern void * mountproc_umntall_1(void *, CLIENT *); -extern void * mountproc_umntall_1_svc(void *, struct svc_req *); -#define MOUNTPROC_EXPORT 5 -extern exports * mountproc_export_1(void *, CLIENT *); -extern exports * mountproc_export_1_svc(void *, struct svc_req *); -#define MOUNTPROC_EXPORTALL 6 -extern exports * mountproc_exportall_1(void *, CLIENT *); -extern exports * mountproc_exportall_1_svc(void *, struct svc_req *); -extern int mountprog_1_freeresult (SVCXPRT *, xdrproc_t, caddr_t); - -#else /* K&R C */ -#define MOUNTPROC_NULL 0 -extern void * mountproc_null_1(); -extern void * mountproc_null_1_svc(); -#define MOUNTPROC_MNT 1 -extern fhstatus * mountproc_mnt_1(); -extern fhstatus * mountproc_mnt_1_svc(); -#define MOUNTPROC_DUMP 2 -extern mountlist * mountproc_dump_1(); -extern mountlist * mountproc_dump_1_svc(); -#define MOUNTPROC_UMNT 3 -extern void * mountproc_umnt_1(); -extern void * mountproc_umnt_1_svc(); -#define MOUNTPROC_UMNTALL 4 -extern void * mountproc_umntall_1(); -extern void * mountproc_umntall_1_svc(); -#define MOUNTPROC_EXPORT 5 -extern exports * mountproc_export_1(); -extern exports * mountproc_export_1_svc(); -#define MOUNTPROC_EXPORTALL 6 -extern exports * mountproc_exportall_1(); -extern exports * mountproc_exportall_1_svc(); -extern int mountprog_1_freeresult (); -#endif /* K&R C */ -#define MOUNTVERS_POSIX 2 - -#if defined(__STDC__) || defined(__cplusplus) -extern void * mountproc_null_2(void *, CLIENT *); -extern void * mountproc_null_2_svc(void *, struct svc_req *); -extern fhstatus * mountproc_mnt_2(dirpath *, CLIENT *); -extern fhstatus * mountproc_mnt_2_svc(dirpath *, struct svc_req *); -extern mountlist * mountproc_dump_2(void *, CLIENT *); -extern mountlist * mountproc_dump_2_svc(void *, struct svc_req *); -extern void * mountproc_umnt_2(dirpath *, CLIENT *); -extern void * mountproc_umnt_2_svc(dirpath *, struct svc_req *); -extern void * mountproc_umntall_2(void *, CLIENT *); -extern void * mountproc_umntall_2_svc(void *, struct svc_req *); -extern exports * mountproc_export_2(void *, CLIENT *); -extern exports * mountproc_export_2_svc(void *, struct svc_req *); -extern exports * mountproc_exportall_2(void *, CLIENT *); -extern exports * mountproc_exportall_2_svc(void *, struct svc_req *); -#define MOUNTPROC_PATHCONF 7 -extern ppathcnf * mountproc_pathconf_2(dirpath *, CLIENT *); -extern ppathcnf * mountproc_pathconf_2_svc(dirpath *, struct svc_req *); -extern int mountprog_2_freeresult (SVCXPRT *, xdrproc_t, caddr_t); - -#else /* K&R C */ -extern void * mountproc_null_2(); -extern void * mountproc_null_2_svc(); -extern fhstatus * mountproc_mnt_2(); -extern fhstatus * mountproc_mnt_2_svc(); -extern mountlist * mountproc_dump_2(); -extern mountlist * mountproc_dump_2_svc(); -extern void * mountproc_umnt_2(); -extern void * mountproc_umnt_2_svc(); -extern void * mountproc_umntall_2(); -extern void * mountproc_umntall_2_svc(); -extern exports * mountproc_export_2(); -extern exports * mountproc_export_2_svc(); -extern exports * mountproc_exportall_2(); -extern exports * mountproc_exportall_2_svc(); -#define MOUNTPROC_PATHCONF 7 -extern ppathcnf * mountproc_pathconf_2(); -extern ppathcnf * mountproc_pathconf_2_svc(); -extern int mountprog_2_freeresult (); -#endif /* K&R C */ -#define MOUNT_V3 3 - -#if defined(__STDC__) || defined(__cplusplus) -#define MOUNTPROC3_NULL 0 -extern void * mountproc3_null_3(void *, CLIENT *); -extern void * mountproc3_null_3_svc(void *, struct svc_req *); -#define MOUNTPROC3_MNT 1 -extern mountres3 * mountproc3_mnt_3(dirpath *, CLIENT *); -extern mountres3 * mountproc3_mnt_3_svc(dirpath *, struct svc_req *); -#define MOUNTPROC3_DUMP 2 -extern mountlist * mountproc3_dump_3(void *, CLIENT *); -extern mountlist * mountproc3_dump_3_svc(void *, struct svc_req *); -#define MOUNTPROC3_UMNT 3 -extern void * mountproc3_umnt_3(dirpath *, CLIENT *); -extern void * mountproc3_umnt_3_svc(dirpath *, struct svc_req *); -#define MOUNTPROC3_UMNTALL 4 -extern void * mountproc3_umntall_3(void *, CLIENT *); -extern void * mountproc3_umntall_3_svc(void *, struct svc_req *); -#define MOUNTPROC3_EXPORT 5 -extern exports * mountproc3_export_3(void *, CLIENT *); -extern exports * mountproc3_export_3_svc(void *, struct svc_req *); -extern int mountprog_3_freeresult (SVCXPRT *, xdrproc_t, caddr_t); - -#else /* K&R C */ -#define MOUNTPROC3_NULL 0 -extern void * mountproc3_null_3(); -extern void * mountproc3_null_3_svc(); -#define MOUNTPROC3_MNT 1 -extern mountres3 * mountproc3_mnt_3(); -extern mountres3 * mountproc3_mnt_3_svc(); -#define MOUNTPROC3_DUMP 2 -extern mountlist * mountproc3_dump_3(); -extern mountlist * mountproc3_dump_3_svc(); -#define MOUNTPROC3_UMNT 3 -extern void * mountproc3_umnt_3(); -extern void * mountproc3_umnt_3_svc(); -#define MOUNTPROC3_UMNTALL 4 -extern void * mountproc3_umntall_3(); -extern void * mountproc3_umntall_3_svc(); -#define MOUNTPROC3_EXPORT 5 -extern exports * mountproc3_export_3(); -extern exports * mountproc3_export_3_svc(); -extern int mountprog_3_freeresult (); -#endif /* K&R C */ - -/* the xdr functions */ - -#if defined(__STDC__) || defined(__cplusplus) -extern bool_t xdr_fhandle (XDR *, fhandle); -extern bool_t xdr_fhandle3 (XDR *, fhandle3*); -extern bool_t xdr_mountstat3 (XDR *, mountstat3*); -extern bool_t xdr_fhstatus (XDR *, fhstatus*); -extern bool_t xdr_mountres3_ok (XDR *, mountres3_ok*); -extern bool_t xdr_mountres3 (XDR *, mountres3*); -extern bool_t xdr_dirpath (XDR *, dirpath*); -extern bool_t xdr_name (XDR *, name*); -extern bool_t xdr_mountlist (XDR *, mountlist*); -extern bool_t xdr_mountbody (XDR *, mountbody*); -extern bool_t xdr_groups (XDR *, groups*); -extern bool_t xdr_groupnode (XDR *, groupnode*); -extern bool_t xdr_exports (XDR *, exports*); -extern bool_t xdr_exportnode (XDR *, exportnode*); -extern bool_t xdr_ppathcnf (XDR *, ppathcnf*); - -#else /* K&R C */ -extern bool_t xdr_fhandle (); -extern bool_t xdr_fhandle3 (); -extern bool_t xdr_mountstat3 (); -extern bool_t xdr_fhstatus (); -extern bool_t xdr_mountres3_ok (); -extern bool_t xdr_mountres3 (); -extern bool_t xdr_dirpath (); -extern bool_t xdr_name (); -extern bool_t xdr_mountlist (); -extern bool_t xdr_mountbody (); -extern bool_t xdr_groups (); -extern bool_t xdr_groupnode (); -extern bool_t xdr_exports (); -extern bool_t xdr_exportnode (); -extern bool_t xdr_ppathcnf (); - -#endif /* K&R C */ - -#ifdef __cplusplus -} -#endif - -#endif /* !_NFSMOUNT_H_RPCGEN */ - diff --git a/mdk-stage1/params.c b/mdk-stage1/params.c index 692c3e511..9398759ab 100644 --- a/mdk-stage1/params.c +++ b/mdk-stage1/params.c @@ -22,7 +22,6 @@ #include "utils.h" #include "automatic.h" #include "log.h" -#include "bootsplash.h" static struct param_elem params[50]; static int param_number = 0; @@ -173,5 +172,4 @@ void unset_automatic(void) { log_message("unsetting automatic"); unset_param(MODE_AUTOMATIC); - exit_bootsplash(); } diff --git a/mdk-stage1/partition.c b/mdk-stage1/partition.c index 83bfc5ce6..cb59f0514 100644 --- a/mdk-stage1/partition.c +++ b/mdk-stage1/partition.c @@ -74,7 +74,7 @@ static const char * detect_partition_type(char * dev) struct partition_detection_info partitions_signatures[] = { { "Linux Swap", { 4086, "SWAP-SPACE" }, { 0, NULL }, { 0, NULL } }, { "Linux Swap", { 4086, "SWAPSPACE2" }, { 0, NULL }, { 0, NULL } }, - { "Ext2", { 0x438, "\x53\xEF" }, { 0, NULL }, { 0, NULL } }, + { "Ext4", { 0x438, "\x53\xEF" }, { 0, NULL }, { 0, NULL } }, { "ReiserFS", { 0x10034, "ReIsErFs" }, { 0, NULL }, { 0, NULL } }, { "ReiserFS", { 0x10034, "ReIsEr2Fs" }, { 0, NULL }, { 0, NULL } }, { "XFS", { 0, "XFSB" }, { 0x200, "XAGF" }, { 0x400, "XAGI" } }, diff --git a/mdk-stage1/pci-resource/Makefile b/mdk-stage1/pci-resource/Makefile deleted file mode 100644 index c8214ddc1..000000000 --- a/mdk-stage1/pci-resource/Makefile +++ /dev/null @@ -1,25 +0,0 @@ - #****************************************************************************** - # - # $Id: Makefile 253685 2009-03-06 14:27:29Z tv $ - # - # Guillaume Cottenceau (gc) - # - # Copyright 2000 Mandriva - # - # This software may be freely redistributed under the terms of the GNU - # public license. - # - # You should have received a copy of the GNU General Public License - # along with this program; if not, write to the Free Software - # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - # - #***************************************************************************** - - -all: pci-ids.h - -pci-ids.h: /usr/share/ldetect-lst/pcitable.gz update-pci-ids.pl - perl update-pci-ids.pl > $@ || { rm -f $@; exit 1; } - -clean: - rm -f pci-ids.h diff --git a/mdk-stage1/pcmcia-resource/Makefile b/mdk-stage1/pcmcia-resource/Makefile deleted file mode 100644 index b27eb2f0b..000000000 --- a/mdk-stage1/pcmcia-resource/Makefile +++ /dev/null @@ -1,24 +0,0 @@ - #****************************************************************************** - # - # Olivier Blin (blino) - # - # Copyright 2006 Mandriva - # - # This software may be freely redistributed under the terms of the GNU - # public license. - # - # You should have received a copy of the GNU General Public License - # along with this program; if not, write to the Free Software - # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - # - #***************************************************************************** - -TARGET=pcmcia-ids.h - -all: $(TARGET) - -$(TARGET): - perl update-pcmcia-ids.pl > $@ || { rm -f $@; exit 1; } - -clean: - rm -f $(TARGET) diff --git a/mdk-stage1/pcmcia/Makefile b/mdk-stage1/pcmcia/Makefile index 5d077aac8..6b8bf0cb8 100644 --- a/mdk-stage1/pcmcia/Makefile +++ b/mdk-stage1/pcmcia/Makefile @@ -27,7 +27,7 @@ all: $(TARGET) pcmcia_probe.o clean: rm -f *.o $(TARGET) lex_config.c yacc_config.c yacc_config.h -FLAGS = -D__linux__ -Wall -Werror -Wno-deprecated-declarations -Os -fomit-frame-pointer -pipe -c -I.. -D_BSD_SOURCE +FLAGS = -D__linux__ -Wall -Werror -Wno-deprecated-declarations -Os -fomit-frame-pointer -pipe -c -I.. -D_DEFAULT_SOURCE # (blino) make sure yynewerror and yyerrlab are uselessly used FLAGS += -Dlint LFLAGS += --nounput @@ -46,7 +46,7 @@ $(TARGET): $(OBJS) yacc_config.h ranlib $@ $(OBJS): %.o: %.c - $(DIET) gcc $(FLAGS) $(INCLUDES) -c $< -o $@ + gcc $(FLAGS) $(INCLUDES) -c $< -o $@ pcmcia_probe.o: probe.c - $(DIET) gcc -fPIC $(FLAGS) $(INCLUDES) -c $< -o $@ + gcc -fPIC $(FLAGS) $(INCLUDES) -c $< -o $@ diff --git a/mdk-stage1/pcmcia/probe.c b/mdk-stage1/pcmcia/probe.c index 329b97890..240fe3a17 100644 --- a/mdk-stage1/pcmcia/probe.c +++ b/mdk-stage1/pcmcia/probe.c @@ -12,6 +12,9 @@ * * * Code comes from /anonymous@projects.sourceforge.net:/pub/pcmcia-cs/pcmcia-cs-3.1.29.tar.bz2 + * + * FIXME: resync with latest pcmcia-cs-3.2.8 or with pcmciautils-0.18 (which uses sysfs) + * */ /*====================================================================== @@ -55,14 +58,11 @@ #include <errno.h> #include <fcntl.h> -//mdk-stage1// #include <pcmcia/config.h> #include "log.h" #include "pcmcia.h" /*====================================================================*/ -//mdk-stage1// #ifdef CONFIG_PCI - typedef struct { u_short vendor, device; char *modname; @@ -138,7 +138,6 @@ static int pci_probe(void) u_int device, vendor, i; FILE *f; -//mdk-stage1// if (!module) log_message("PCMCIA: probing PCI bus.."); if ((f = fopen("/proc/bus/pci/devices", "r")) != NULL) { @@ -159,58 +158,20 @@ static int pci_probe(void) } } } -//mdk-stage1// else if ((f = fopen("/proc/pci", "r")) != NULL) { -//mdk-stage1// while (fgets(s, 256, f) != NULL) { -//mdk-stage1// t = strstr(s, "Device id="); -//mdk-stage1// if (t) { -//mdk-stage1// device = strtoul(t+10, NULL, 16); -//mdk-stage1// t = strstr(s, "Vendor id="); -//mdk-stage1// vendor = strtoul(t+10, NULL, 16); -//mdk-stage1// for (i = 0; i < PCI_COUNT; i++) -//mdk-stage1// if ((vendor == pci_id[i].vendor) && -//mdk-stage1// (device == pci_id[i].device)) break; -//mdk-stage1// } else -//mdk-stage1// for (i = 0; i < PCI_COUNT; i++) -//mdk-stage1// if (strstr(s, pci_id[i].tag) != NULL) break; -//mdk-stage1// if (i != PCI_COUNT) { -//mdk-stage1// name = pci_id[i].name; -//mdk-stage1// break; -//mdk-stage1// } else { -//mdk-stage1// t = strstr(s, "CardBus bridge"); -//mdk-stage1// if (t != NULL) { -//mdk-stage1// name = t + 16; -//mdk-stage1// t = strchr(s, '('); -//mdk-stage1// t[-1] = '\0'; -//mdk-stage1// break; -//mdk-stage1// } -//mdk-stage1// } -//mdk-stage1// } -//mdk-stage1// } fclose(f); if (name) { -//mdk-stage1// if (module) -//mdk-stage1// printf("i82365\n"); -//mdk-stage1// else log_message("\t%s found, 2 sockets (driver %s).", name, driver); return 0; } else { -//mdk-stage1// if (!module) log_message("\tnot found."); return -ENODEV; } } -//mdk-stage1// #endif /*====================================================================*/ -//mdk-stage1// #ifdef CONFIG_ISA -//mdk-stage1// -//mdk-stage1// #ifdef __GLIBC__ #include <sys/io.h> -//mdk-stage1// #else -//mdk-stage1// #include <asm/io.h> -//mdk-stage1// #endif typedef u_short ioaddr_t; #include "i82365.h" @@ -251,9 +212,7 @@ int i365_probe(void) int val, sock, done; char *name = "i82365sl"; -//mdk-stage1// if (!module) log_message("PCMCIA: probing for Intel PCIC (ISA).."); -//mdk-stage1// if (verbose) printf("\n"); sock = done = 0; if (ioperm(i365_base, 4, 1)) { @@ -263,8 +222,6 @@ int i365_probe(void) ioperm(0x80, 1, 1); for (; sock < 2; sock++) { val = i365_get(sock, I365_IDENT); -//mdk-stage1// if (verbose) -//mdk-stage1// printf(" ident(%d)=%#2.2x", sock, val); switch (val) { case 0x82: name = "i82365sl A step"; @@ -286,9 +243,7 @@ int i365_probe(void) if (done) break; } -//mdk-stage1// if (verbose) printf("\n "); if (sock == 0) { -//mdk-stage1// if (!module) log_message("\tnot found."); return -ENODEV; } @@ -327,24 +282,15 @@ int i365_probe(void) } } -//mdk-stage1// if (module) -//mdk-stage1// printf("i82365\n"); -//mdk-stage1// else printf("\t%s found, %d sockets.\n", name, sock); return 0; } /* i365_probe */ -//mdk-stage1//#endif /* CONFIG_ISA */ - /*====================================================================*/ -//mdk-stage1//#ifdef CONFIG_ISA - #include "tcic.h" -//mdk-stage1//static ioaddr_t tcic_base = TCIC_BASE; - static u_char tcic_getb(ioaddr_t base, u_char reg) { u_char val = inb(base+reg); @@ -401,7 +347,6 @@ int tcic_probe_at(ioaddr_t base) if (tcic_getw(base, i) == 0xffff) return -1; -//mdk-stage1// if (!module) log_message("\tat %#3.3x: ", base); fflush(stdout); /* Try to reset the chip */ @@ -427,7 +372,6 @@ int tcic_probe(void) { int sock, id; -//mdk-stage1// if (!module) log_message("PCMCIA: probing for Databook TCIC-2 (ISA).."); fflush(stdout); if (ioperm(TCIC_BASE, 16, 1)) { @@ -438,14 +382,10 @@ int tcic_probe(void) sock = tcic_probe_at(TCIC_BASE); if (sock <= 0) { -//mdk-stage1// if (!module) log_message("\tnot found."); return -ENODEV; } -//mdk-stage1// if (module) -//mdk-stage1// printf("tcic\n"); -//mdk-stage1// else { id = get_tcic_id(TCIC_BASE); switch (id) { case TCIC_ID_DB86082: @@ -466,55 +406,10 @@ int tcic_probe(void) log_message("Unknown TCIC-2 ID 0x%02x", id); } log_message(" found at %#6x, %d sockets.", TCIC_BASE, sock); -//mdk-stage1// } return 0; } /* tcic_probe */ -//mdk-stage1// #endif /* CONFIG_ISA */ - -//mdk-stage1// /*====================================================================*/ -//mdk-stage1// -//mdk-stage1// int main(int argc, char *argv[]) -//mdk-stage1// { -//mdk-stage1// int optch, errflg; -//mdk-stage1// extern char *optarg; -//mdk-stage1// int verbose = 0, module = 0; -//mdk-stage1// -//mdk-stage1// errflg = 0; -//mdk-stage1// while ((optch = getopt(argc, argv, "t:vxm")) != -1) { -//mdk-stage1// switch (optch) { -//mdk-stage1// #ifdef CONFIG_ISA -//mdk-stage1// case 't': -//mdk-stage1// tcic_base = strtoul(optarg, NULL, 0); break; -//mdk-stage1// #endif -//mdk-stage1// case 'v': -//mdk-stage1// verbose = 1; break; -//mdk-stage1// case 'm': -//mdk-stage1// module = 1; break; -//mdk-stage1// default: -//mdk-stage1// errflg = 1; break; -//mdk-stage1// } -//mdk-stage1// } -//mdk-stage1// if (errflg || (optind < argc)) { -//mdk-stage1// fprintf(stderr, "usage: %s [-t tcic_base] [-v] [-m]\n", argv[0]); -//mdk-stage1// exit(EXIT_FAILURE); -//mdk-stage1// } -//mdk-stage1// -//mdk-stage1// #ifdef CONFIG_PCI -//mdk-stage1// if (pci_probe(verbose, module) == 0) -//mdk-stage1// exit(EXIT_SUCCESS); -//mdk-stage1// #endif -//mdk-stage1// #ifdef CONFIG_ISA -//mdk-stage1// if (i365_probe(verbose, module) == 0) -//mdk-stage1// exit(EXIT_SUCCESS); -//mdk-stage1// else if (tcic_probe(verbose, module, tcic_base) == 0) -//mdk-stage1// exit(EXIT_SUCCESS); -//mdk-stage1// #endif -//mdk-stage1// exit(EXIT_FAILURE); -//mdk-stage1// return 0; -//mdk-stage1// } - char * pcmcia_probe(void) { diff --git a/mdk-stage1/probe-modules.c b/mdk-stage1/probe-modules.c index ad4f9e4cd..86b383b5e 100644 --- a/mdk-stage1/probe-modules.c +++ b/mdk-stage1/probe-modules.c @@ -22,7 +22,6 @@ #include <string.h> #include "utils.h" -void exit_bootsplash(void) {} void stg1_error_message(char *msg, ...) { va_list args; @@ -59,7 +58,7 @@ int main(int argc, char **argv, char **env) init_modules_insmoding(); if (module) { - my_insmod(module, ANY_DRIVER_TYPE, options, 0); + my_modprobe(module, ANY_DRIVER_TYPE, options); } else { find_media(bus); } diff --git a/mdk-stage1/probing.c b/mdk-stage1/probing.c index d841941b3..f956bb348 100644 --- a/mdk-stage1/probing.c +++ b/mdk-stage1/probing.c @@ -40,23 +40,27 @@ #include <fnmatch.h> #include <sys/socket.h> #include <net/if.h> +#include <linux/sockios.h> +#include <linux/ethtool.h> #include <sys/ioctl.h> #include <sys/mount.h> #include <pci/pci.h> #include <libldetect.h> +#include <errno.h> +#include <glob.h> #include "stage1.h" #include "log.h" #include "utils.h" #include "frontend.h" #include "modules.h" -#include "pci-resource/pci-ids.h" +#include "pci-ids.h" #ifdef ENABLE_USB -#include "usb-resource/usb-ids.h" +#include "usb-ids.h" #endif #ifdef ENABLE_PCMCIA #include "sysfs/libsysfs.h" -#include "pcmcia-resource/pcmcia-ids.h" +#include "pcmcia-ids.h" #endif #include "probing.h" @@ -82,54 +86,31 @@ static void warning_insmod_failed(enum insmod_return r) } #ifndef DISABLE_NETWORK -struct net_description_elem -{ - char * intf_name; - char * intf_description; -}; -static struct net_description_elem net_descriptions[50]; -static int net_descr_number = 0; -static char * intf_descr_for_discover = NULL; -static char * net_intf_too_early_name[50]; /* for modules providing more than one net intf */ -static int net_intf_too_early_number = 0; -static int net_intf_too_early_ptr = 0; - const char * safe_descr(const char * text) { return text ? text : "unknown"; } -void prepare_intf_descr(const char * intf_descr) +char * get_net_intf_description(char * intf_name) { - intf_descr_for_discover = strdup(intf_descr); -} + struct ifreq ifr; + struct ethtool_drvinfo drvinfo; + int s = socket(AF_INET, SOCK_DGRAM, 0); + char *res; -void net_discovered_interface(char * intf_name) -{ - if (!intf_descr_for_discover) { - net_intf_too_early_name[net_intf_too_early_number++] = strdup(intf_name); - return; - } - if (!intf_name) { - if (net_intf_too_early_ptr >= net_intf_too_early_number) { - log_message("NET: was expecting another network interface (broken net module?)"); - return; - } - net_descriptions[net_descr_number].intf_name = net_intf_too_early_name[net_intf_too_early_ptr++]; - } - else - net_descriptions[net_descr_number].intf_name = strdup(intf_name); - net_descriptions[net_descr_number].intf_description = strdup(intf_descr_for_discover); - intf_descr_for_discover = NULL; - net_descr_number++; -} + memset(&ifr, 0, sizeof(ifr)); + strncpy(ifr.ifr_name, intf_name, IFNAMSIZ); -char * get_net_intf_description(char * intf_name) -{ - int i; - for (i = 0; i < net_descr_number ; i++) - if (!strcmp(net_descriptions[i].intf_name, intf_name)) - return net_descriptions[i].intf_description; - return strdup("unknown"); + drvinfo.cmd = ETHTOOL_GDRVINFO; + ifr.ifr_data = (caddr_t) &drvinfo; + + if (ioctl(s, SIOCETHTOOL, &ifr) != -1) { + res = drvinfo.driver; + } else { + perror("SIOCETHTOOL"); + res = "unknown"; + } + close(s); + return strdup(res); } #endif @@ -272,10 +253,10 @@ void discovered_device(enum driver_type type, const char * description, const ch if (type == MEDIA_ADAPTERS) { const char * alternate = NULL; wait_message("Loading driver for media adapter:\n \n%s", description); - failed = my_insmod(driver, MEDIA_ADAPTERS, NULL, 1); + failed = my_modprobe(driver, MEDIA_ADAPTERS, NULL); alternate = get_alternate_module(driver); if (!IS_NOAUTO && alternate) { - failed = failed || my_insmod(alternate, MEDIA_ADAPTERS, NULL, 1); + failed = failed || my_modprobe(alternate, MEDIA_ADAPTERS, NULL); } remove_wait_message(); warning_insmod_failed(failed); @@ -283,19 +264,17 @@ void discovered_device(enum driver_type type, const char * description, const ch #endif #ifndef DISABLE_NETWORK if (type == NETWORK_DEVICES) { + log_message("NET: Loading driver for network device %s", description); wait_message("Loading driver for network device:\n \n%s", description); - prepare_intf_descr(description); - failed = my_insmod(driver, NETWORK_DEVICES, NULL, 1); + failed = my_modprobe(driver, NETWORK_DEVICES, NULL); warning_insmod_failed(failed); remove_wait_message(); - if (intf_descr_for_discover) /* for modules providing more than one net intf */ - net_discovered_interface(NULL); } #endif #ifdef ENABLE_USB if (type == USB_CONTROLLERS) /* we can't allow additional modules floppy since we need usbhid for keystrokes of usb keyboards */ - failed = my_insmod(driver, USB_CONTROLLERS, NULL, 0); + failed = my_modprobe(driver, USB_CONTROLLERS, NULL); #endif } @@ -337,7 +316,7 @@ void probe_virtio_modules(void) if (e->vendor == VIRTIO_PCI_VENDOR) { if (!loaded_pci) { log_message("loading virtio-pci"); - my_insmod("virtio_pci", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("virtio_pci", ANY_DRIVER_TYPE, NULL); loaded_pci = 1; } @@ -360,7 +339,7 @@ void probe_virtio_modules(void) } if (name) { log_message("virtio: loading %s", name); - my_insmod(name, ANY_DRIVER_TYPE, options, 0); + my_modprobe(name, ANY_DRIVER_TYPE, options); } } } @@ -429,14 +408,9 @@ void probe_that_type(enum driver_type type, enum media_bus bus __attribute__ ((u if (!already_mounted_usbdev) { already_mounted_usbdev = 1; - if (mount("none", "/proc/bus/usb", "usbfs", 0, NULL) && - mount("none", "/proc/bus/usb", "usbdevfs", 0, NULL)) { - log_message("USB: couldn't mount /proc/bus/usb"); - goto end_usb_probe; - } wait_message("Detecting USB devices."); sleep(4); /* sucking background work */ - my_insmod("usbhid", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("usbhid", ANY_DRIVER_TYPE, NULL); remove_wait_message(); } @@ -488,7 +462,7 @@ void probe_that_type(enum driver_type type, enum media_bus bus __attribute__ ((u for (dent = readdir(dir); dent != NULL; dent = readdir(dir)) { struct sysfs_attribute *modalias_attr; - char keyfile[256]; + char keyfile[300]; int i, id; if (dent->d_name[0] == '.') @@ -551,9 +525,9 @@ void probe_that_type(enum driver_type type, enum media_bus bus __attribute__ ((u already_probed_usb_controllers && !already_loaded_usb_scsi) { already_loaded_usb_scsi = 1; /* we can't allow additional modules floppy since we need usbkbd for keystrokes of usb keyboards */ - my_insmod("usb_storage", MEDIA_ADAPTERS, NULL, 0); + my_modprobe("usb_storage", MEDIA_ADAPTERS, NULL); if (module_already_present("ieee1394")) - my_insmod("sbp2", MEDIA_ADAPTERS, NULL, 0); + my_modprobe("sbp2", MEDIA_ADAPTERS, NULL); wait_message("Detecting USB mass-storage devices."); #ifndef DEBUG sleep(10); /* sucking background work */ @@ -565,13 +539,38 @@ void probe_that_type(enum driver_type type, enum media_bus bus __attribute__ ((u static struct media_info * medias = NULL; +// Read a short string from a file and strips it, intended for sysfs attributes +static ssize_t read_attribute(char *path, char *buf) { + ssize_t l = 0; + int fd = open(path, O_RDONLY); + buf[0] = '\0'; + if (fd == -1) { + log_message("Failed to open %s for reading", path); + } else { + ssize_t n = read(fd, buf, 32); + if (n == -1) { + log_message("Couldn't read file (%s)", path); + } else { + // Strip whitespaces and newline + for (int i = n-1; i >= 0; i--) { + if (buf[i] == '\n' || buf[i] == ' ') + continue; + l = i+1; + break; + } + buf[l] = '\0'; + } + close(fd); + } + log_message("Content of %s was %s", path, buf); + return l; +} + void find_media(enum media_bus bus) { - char b[50]; char buf[5000]; struct media_info tmp[50]; int count = 0; - int fd; if (medias) free(medias); /* that does not free the strings, by the way */ @@ -580,265 +579,6 @@ void find_media(enum media_bus bus) probe_that_type(MEDIA_ADAPTERS, bus); /* ----------------------------------------------- */ - if (bus != BUS_IDE && bus != BUS_ANY) - goto find_media_after_ide; - log_message("looking for ide media"); - - strcpy(b, "/proc/ide/hd"); - for (b[12] = 'a'; b[12] <= 't'; b[12]++) { - int i; - char ide_disk[] = "disk"; - char ide_cdrom[] = "cdrom"; - char ide_tape[] = "tape"; - char ide_floppy[] = "floppy"; - - /* first, test if file exists (will tell if attached medium exists) */ - b[13] = '\0'; - if (access(b, R_OK)) - continue; - - tmp[count].name = strdup("hda"); - tmp[count].name[2] = b[12]; - - /* media type */ - strcpy(b + 13, "/media"); - fd = open(b, O_RDONLY); - if (fd == -1) { - log_message("failed to open %s for reading", b); - continue; - } - - i = read(fd, buf, sizeof(buf)); - if (i == -1) { - log_message("failed to read %s", b); - continue; - } - buf[i] = '\0'; - close(fd); - - if (ptr_begins_static_str(buf, ide_disk)) - tmp[count].type = DISK; - else if (ptr_begins_static_str(buf, ide_cdrom)) - tmp[count].type = CDROM; - else if (ptr_begins_static_str(buf, ide_tape)) - tmp[count].type = TAPE; - else if (ptr_begins_static_str(buf, ide_floppy)) - tmp[count].type = FLOPPY; - else - tmp[count].type = UNKNOWN_MEDIA; - - /* media model */ - strcpy(b + 13, "/model"); - fd = open(b, O_RDONLY); - if (fd == -1) { - log_message("failed to open %s for reading", b); - continue; - } - - i = read(fd, buf, sizeof(buf)); - if (i <= 0) { - log_message("failed to read %s", b); - tmp[count].model = strdup("(none)"); - } - else { - buf[i-1] = '\0'; /* eat the \n */ - tmp[count].model = strdup(buf); - } - close(fd); - - log_message("IDE/%d: %s is a %s", tmp[count].type, tmp[count].name, tmp[count].model); - count++; - } - - find_media_after_ide: - /* ----------------------------------------------- */ - if (bus != BUS_SCSI && bus != BUS_USB && bus != BUS_PCMCIA && bus != BUS_ANY) - goto find_media_after_scsi; - log_message("looking for scsi media"); - - fd = open("/proc/scsi/scsi", O_RDONLY); - if (fd != -1) { - FILE * f; - - enum { SCSI_TOP, SCSI_HOST, SCSI_VENDOR, SCSI_TYPE } state = SCSI_TOP; - char * start, * chptr, * next, * end; - char scsi_disk_count = 'a'; - char scsi_cdrom_count = '0'; - char scsi_tape_count = '0'; - - char scsi_no_devices[] = "Attached devices: none"; - char scsi_some_devices[] = "Attached devices:"; - char scsi_host[] = "Host: "; - char scsi_vendor[] = " Vendor: "; - - int i = read(fd, &buf, sizeof(buf)-1); - if (i < 1) { - close(fd); - goto end_scsi; - } - close(fd); - buf[i] = '\0'; - - if (ptr_begins_static_str(buf, scsi_no_devices)) - goto end_scsi; - - start = buf; - while (*start) { - char tmp_model[50]; - char tmp_name[10]; - - chptr = start; - while (*chptr != '\n') chptr++; - *chptr = '\0'; - next = chptr + 1; - - switch (state) { - case SCSI_TOP: - if (!ptr_begins_static_str(start, scsi_some_devices)) - goto end_scsi; - state = SCSI_HOST; - break; - - case SCSI_HOST: - if (!ptr_begins_static_str(start, scsi_host)) - goto end_scsi; - state = SCSI_VENDOR; - break; - - case SCSI_VENDOR: - if (!ptr_begins_static_str(start, scsi_vendor)) - goto end_scsi; - - /* (1) Grab Vendor info */ - start += 10; - end = chptr = strstr(start, "Model:"); - if (!chptr) - goto end_scsi; - - chptr--; - while (*chptr == ' ') - chptr--; - if (*chptr == ':') { - chptr++; - *(chptr + 1) = '\0'; - strcpy(tmp_model,"(unknown)"); - } else { - *(chptr + 1) = '\0'; - strcpy(tmp_model, start); - } - - /* (2) Grab Model info */ - start = end; - start += 7; - - chptr = strstr(start, "Rev:"); - if (!chptr) - goto end_scsi; - - chptr--; - while (*chptr == ' ') chptr--; - *(chptr + 1) = '\0'; - - strcat(tmp_model, " "); - strcat(tmp_model, start); - - tmp[count].model = strdup(tmp_model); - - state = SCSI_TYPE; - - break; - - case SCSI_TYPE: - if (strncmp(" Type:", start, 7)) - goto end_scsi; - *tmp_name = '\0'; - - if (strstr(start, "Direct-Access")) { - sprintf(tmp_name, "sd%c", scsi_disk_count++); - tmp[count].type = DISK; - } else if (strstr(start, "Sequential-Access")) { - sprintf(tmp_name, "st%c", scsi_tape_count++); - tmp[count].type = TAPE; - } else if (strstr(start, "CD-ROM")) { - sprintf(tmp_name, "sr%c", scsi_cdrom_count++); - tmp[count].type = CDROM; - } - - if (!(f = fopen("/proc/partitions", "rb")) || !fgets(buf, sizeof(buf), f) || !fgets(buf, sizeof(buf), f)) { - log_message("Couldn't open /proc/partitions"); - } else { - while (fgets(buf, sizeof(buf), f)) { - char name[100]; - int major, minor, blocks; - struct stat statbuf; - char *ptr; - memset(name, 0, sizeof(name)); - strcpy(name, "/dev/"); - sscanf(buf, " %d %d %d %s", &major, &minor, &blocks, &name[5]); - if (streq(&name[5], tmp_name) && tmp[count].type == DISK && ((blocks == 1048575) || (blocks == 1440))) - tmp[count].type = FLOPPY; - /* Try to create all devices while we have major/minor */ - if ((ptr = strchr(&name[5], '/'))) { - *ptr = '\0'; - if (stat(name, &statbuf)) - mkdir(name, 0755); - *ptr = '/'; - } - if (stat(name, &statbuf) && mknod(name, S_IFBLK | 0600, makedev(major, minor))) { - log_perror(name); - } - } - fclose(f); - } - - if (*tmp_name) { - tmp[count].name = strdup(tmp_name); - log_message("SCSI/%d: %s is a %s", tmp[count].type, tmp[count].name, tmp[count].model); - count++; - } - - state = SCSI_HOST; - } - - start = next; - } - - end_scsi:; - } - - /* ----------------------------------------------- */ - log_message("looking for Compaq Smart Array media"); - { - char * procfiles[] = { "/proc/driver/cpqarray/ida0", "/proc/driver/cciss/cciss0", // 2.4 style - "/proc/array/ida", "/proc/cciss/cciss", // 2.2 style - NULL }; - static char cpq_descr[] = "Compaq RAID logical disk"; - char ** procfile; - FILE * f; - - for (procfile = procfiles; procfile && *procfile; procfile++) { - if((f = fopen(*procfile, "rb"))) { - while (fgets(buf, sizeof(buf), f)) { - if (ptr_begins_static_str(buf, "ida/") || ptr_begins_static_str(buf, "cciss/")) { - char * end = strchr(buf, ':'); - if (!end) - log_message("Inconsistency in %s, line:\n%s", *procfile, buf); - else { - *end = '\0'; - tmp[count].name = strdup(buf); - tmp[count].type = DISK; - tmp[count].model = cpq_descr; - log_message("CPQ: found %s", tmp[count].name); - count++; - } - } - } - fclose(f); - } - } - } - - /* ----------------------------------------------- */ log_message("looking for DAC960"); { FILE * f; @@ -869,41 +609,95 @@ void find_media(enum media_bus bus) } } /* ----------------------------------------------- */ - log_message("looking for VirtIO"); + log_message("looking for other disks"); { - int fd, i; - char b[50]; - char *name = b+11; - strcpy(b, "/sys/block/vd"); - for (b[13] = 'a'; b[13] <= 'c'; b[13]++) { - /* first, test if file exists (will tell if attached medium exists) */ - b[14] = '\0'; - if (access(b, R_OK)) + glob_t globbuf; + // TODO: We should switch everything to here, and later switch to ignoring + // some types of disks (ram, loop, ...) rather than a list to accept. + glob("/sys/block/nvme*", 0, NULL, &globbuf); + glob("/sys/block/vd*", GLOB_APPEND, NULL, &globbuf); + glob("/sys/block/cciss*", GLOB_APPEND, NULL, &globbuf); + glob("/sys/block/fd*", GLOB_APPEND, NULL, &globbuf); + glob("/sys/block/sd*", GLOB_APPEND, NULL, &globbuf); + glob("/sys/block/st*", GLOB_APPEND, NULL, &globbuf); + glob("/sys/block/sr*", GLOB_APPEND, NULL, &globbuf); + + for (int i = 0; i < globbuf.gl_pathc; i++) { + char *name, *pathend; + char path[64]; + char model[64]; + int vendor_length = 0; + + strncpy(path, globbuf.gl_pathv[i], sizeof(path)); + name = strdup(path + 11); + + // Replace ! with /, for example for cciss!c0d0 devices + char * c = name; + while((c = strchr(c, '!')) != NULL) { + *c = '/'; + c++; + } + + pathend = path + strlen(path); + + // Check if this device had been handled by other code + int exists = 0; + for (int j = 0; j < count; j++) { + if (!strcmp(name, tmp[j].name)) { + exists = 1; + break; + } + } + if (exists) { + free(name); continue; + } + + strcpy(model, "Unknown Disk"); - tmp[count].name = strdup(name); - tmp[count].type = DISK; //UNKNOWN_MEDIA; - tmp[count].model = strdup("VirtIO disk"); + strcpy(pathend, "/device/vendor"); + vendor_length = read_attribute(path, model); - /* media type */ - strcpy(b + 14, "/capability"); - fd = open(b, O_RDONLY); - if (fd == -1) { - log_message("failed to open %s for reading", b); - //continue; + if (vendor_length) { + strcat(model, " "); + vendor_length++; } - i = read(fd, buf, sizeof(buf)); - if (i == -1) { - log_message("Couldn't read capabilities file (%s)", b); - } else { - if (!strcmp(buf, "10")) - tmp[count].type = DISK; + + strcpy(pathend, "/device/model"); + read_attribute(path, model+vendor_length); + + strcpy(pathend, "/capability"); + read_attribute(path, buf); + long caps = strtol(buf, NULL, 16); + + // GENHD_FL_UP (0x0010): indicated that the block device is “up” but the kernel has removed that info + if (caps && 0) { + log_message("Ignoring device %s (not up)", name); + free(name); + continue; + } + + if (caps & 0x0400) { + log_message("Ignoring device %s (hidden)", name); + free(name); + continue; + } + + tmp[count].type = DISK; + if (caps & 0x0008 || !strncmp(name, "sr", 2)) { + tmp[count].type = CDROM; + } else if (!strncmp(name, "fd", 2)) { + tmp[count].type = FLOPPY; + } else if (!strncmp(name, "st", 2)) { + tmp[count].type = TAPE; } + tmp[count].name = name; + tmp[count].model = strdup(model); count++; } + globfree(&globbuf); } - find_media_after_scsi: /* ----------------------------------------------- */ tmp[count].name = NULL; @@ -965,7 +759,7 @@ char ** get_net_devices(void) int i = 0; if (!already_probed) { - already_probed = 1; /* cut off loop brought by: probe_that_type => my_insmod => get_net_devices */ + already_probed = 1; /* cut off loop brought by: probe_that_type => my_modprobe => get_net_devices */ probe_that_type(NETWORK_DEVICES, BUS_ANY); } diff --git a/mdk-stage1/probing.h b/mdk-stage1/probing.h index 63c44a4cb..702c9d056 100644 --- a/mdk-stage1/probing.h +++ b/mdk-stage1/probing.h @@ -37,9 +37,7 @@ enum media_bus { BUS_IDE, BUS_SCSI, BUS_USB, BUS_PCMCIA, BUS_ANY }; void find_media(enum media_bus bus); void get_medias(enum media_type media, char *** names, char *** models, enum media_bus bus); char ** get_net_devices(void); -void net_discovered_interface(char * intf_name); char * get_net_intf_description(char * intf_name); -void prepare_intf_descr(const char * intf_descr); void probe_that_type(enum driver_type type, enum media_bus bus); /* Make sure the MATCH_ALL value is greater than all possible values diff --git a/mdk-stage1/rescue-gui.c b/mdk-stage1/rescue-gui.c index 5a7e10de2..c7aae6126 100644 --- a/mdk-stage1/rescue-gui.c +++ b/mdk-stage1/rescue-gui.c @@ -27,6 +27,7 @@ #include <sys/ioctl.h> #include <linux/unistd.h> #include <sys/select.h> +#include <linux/reboot.h> #include "config-stage1.h" #include "frontend.h" @@ -35,13 +36,9 @@ #include <sys/syscall.h> -#define LINUX_REBOOT_MAGIC1 0xfee1dead -#define LINUX_REBOOT_MAGIC2 672274793 -#define BMAGIC_REBOOT 0x01234567 - static inline long reboot(void) { - return (long) syscall(__NR_reboot, LINUX_REBOOT_MAGIC1, LINUX_REBOOT_MAGIC2, BMAGIC_REBOOT, 0); + return (long) syscall(__NR_reboot, LINUX_REBOOT_MAGIC1, LINUX_REBOOT_MAGIC2, LINUX_REBOOT_CMD_RESTART, 0); } #if defined(__i386__) || defined(__x86_64__) @@ -50,9 +47,9 @@ static inline long reboot(void) char * env[] = { "PATH=/usr/bin:/bin:/sbin:/usr/sbin:/mnt/sbin:/mnt/usr/sbin:/mnt/bin:/mnt/usr/bin", - "LD_LIBRARY_PATH=/lib:/usr/lib:/mnt/lib:/mnt/usr/lib:/usr/X11R6/lib:/mnt/usr/X11R6/lib" -#if defined(__x86_64__) || defined(__ppc64__) - ":/lib64:/usr/lib64:/usr/X11R6/lib64:/mnt/lib64:/mnt/usr/lib64:/mnt/usr/X11R6/lib64" + "LD_LIBRARY_PATH=/lib:/usr/lib:/mnt/lib:/mnt/usr/lib" +#if defined(__x86_64__) + ":/lib64:/usr/lib64:/mnt/lib64:/mnt/usr/lib64" #endif , "HOME=/", @@ -156,7 +153,7 @@ void unmount_filesystems(void) for (i = nb = 0; i < numfs; i++) if (fs[i].mounted) { printf("\t%s umount failed\n", fs[i].name); - if (strcmp(fs[i].fs, "ext2") == 0) nb++; /* don't count not-ext2 umount failed */ + if (strcmp(fs[i].fs, "ext4") == 0) nb++; /* don't count not-ext4 umount failed */ } if (nb) { @@ -169,7 +166,6 @@ void unmount_filesystems(void) /* ------ UUURGH -- this is dirrrrrttttyyyyyy */ void probe_that_type(void) {} -void exit_bootsplash(void) {} int main(int argc __attribute__ ((unused)), char **argv __attribute__ ((unused))) diff --git a/mdk-stage1/slang/Makefile b/mdk-stage1/slang/Makefile deleted file mode 100644 index 85246f27e..000000000 --- a/mdk-stage1/slang/Makefile +++ /dev/null @@ -1,42 +0,0 @@ - #****************************************************************************** - # - # Guillaume Cottenceau (gc) - # - # Copyright 2000 Mandriva - # - # This software may be freely redistributed under the terms of the GNU - # public license. - # - # You should have received a copy of the GNU General Public License - # along with this program; if not, write to the Free Software - # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - # - #***************************************************************************** - -top_dir = .. - -include $(top_dir)/Makefile.common - - -LIBNAME = libslang - -OBJS = sltermin.o sldisply.o slutty.o slang.o slarray.o slclass.o slcmd.o slerr.o slgetkey.o slkeymap.o slmalloc.o slmath.o slmemchr.o slmemcmp.o slmemcpy.o slmemset.o slmisc.o slparse.o slprepr.o slregexp.o slrline.o slsearch.o slsmg.o slstd.o sltoken.o sltypes.o slxstrng.o slcurses.o slscroll.o slsignal.o slkeypad.o slerrno.o slstring.o slstruct.o slcmplex.o slarrfun.o slimport.o slpath.o slarith.o slassoc.o slcompat.o slposdir.o slstdio.o slproc.o sltime.o slstrops.o slbstr.o slpack.o slintall.o slistruc.o slposio.o slnspace.o slarrmis.o slospath.o slscanf.o - -DEFS = -Dunix -DSLANG - -INCS = - - -TARGETS = $(LIBNAME).a - -all: $(TARGETS) - -clean: - rm -f *.o *.a - -$(LIBNAME).a: $(OBJS) - ar -cru $@ $^ - ranlib $@ - -$(OBJS): %.o: %.c - $(DIET) gcc $(CFLAGS) $(DEFS) $(INCS) $(INCLUDES) -c $< -o $@ diff --git a/mdk-stage1/slang/_slang.h b/mdk-stage1/slang/_slang.h deleted file mode 100644 index 02ee13505..000000000 --- a/mdk-stage1/slang/_slang.h +++ /dev/null @@ -1,743 +0,0 @@ -#ifndef _PRIVATE_SLANG_H_ -#define _PRIVATE_SLANG_H_ -/* header file for S-Lang internal structures that users do not (should not) - need. Use slang.h for that purpose. */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -/* #include "config.h" */ -#include "jdmacros.h" -#include "sllimits.h" - -#ifdef VMS -# define SLANG_SYSTEM_NAME "_VMS" -#else -# if defined (IBMPC_SYSTEM) -# define SLANG_SYSTEM_NAME "_IBMPC" -# else -# define SLANG_SYSTEM_NAME "_UNIX" -# endif -#endif /* VMS */ - -/* These quantities are main_types for byte-compiled code. They are used - * by the inner_interp routine. The _BC_ means byte-code. - */ - -#define _SLANG_BC_LVARIABLE SLANG_LVARIABLE /* 0x01 */ -#define _SLANG_BC_GVARIABLE SLANG_GVARIABLE /* 0x02 */ -#define _SLANG_BC_IVARIABLE SLANG_IVARIABLE /* 0x03 */ -#define _SLANG_BC_RVARIABLE SLANG_RVARIABLE /* 0x04 */ -#define _SLANG_BC_INTRINSIC SLANG_INTRINSIC /* 0x05 */ -#define _SLANG_BC_FUNCTION SLANG_FUNCTION /* 0x06 */ -#define _SLANG_BC_MATH_UNARY SLANG_MATH_UNARY /* 0x07 */ -#define _SLANG_BC_APP_UNARY SLANG_APP_UNARY /* 0x08 */ -#define _SLANG_BC_ICONST SLANG_ICONSTANT /* 0x09 */ -#define _SLANG_BC_DCONST SLANG_DCONSTANT /* 0x0A */ -#define _SLANG_BC_PVARIABLE SLANG_PVARIABLE /* 0x0B */ -#define _SLANG_BC_PFUNCTION SLANG_PFUNCTION /* 0x0C */ - -#define _SLANG_BC_BINARY 0x10 -#define _SLANG_BC_LITERAL 0x11 /* constant objects */ -#define _SLANG_BC_LITERAL_INT 0x12 -#define _SLANG_BC_LITERAL_STR 0x13 -#define _SLANG_BC_BLOCK 0x14 - -/* These 3 MUST be in this order too ! */ -#define _SLANG_BC_RETURN 0x15 -#define _SLANG_BC_BREAK 0x16 -#define _SLANG_BC_CONTINUE 0x17 - -#define _SLANG_BC_EXCH 0x18 -#define _SLANG_BC_LABEL 0x19 -#define _SLANG_BC_LOBJPTR 0x1A -#define _SLANG_BC_GOBJPTR 0x1B -#define _SLANG_BC_X_ERROR 0x1C -/* These must be in this order */ -#define _SLANG_BC_X_USER0 0x1D -#define _SLANG_BC_X_USER1 0x1E -#define _SLANG_BC_X_USER2 0x1F -#define _SLANG_BC_X_USER3 0x20 -#define _SLANG_BC_X_USER4 0x21 - -#define _SLANG_BC_CALL_DIRECT 0x24 -#define _SLANG_BC_CALL_DIRECT_FRAME 0x25 -#define _SLANG_BC_UNARY 0x26 -#define _SLANG_BC_UNARY_FUNC 0x27 - -#define _SLANG_BC_DEREF_ASSIGN 0x30 -#define _SLANG_BC_SET_LOCAL_LVALUE 0x31 -#define _SLANG_BC_SET_GLOBAL_LVALUE 0x32 -#define _SLANG_BC_SET_INTRIN_LVALUE 0x33 -#define _SLANG_BC_SET_STRUCT_LVALUE 0x34 -#define _SLANG_BC_FIELD 0x35 -#define _SLANG_BC_SET_ARRAY_LVALUE 0x36 - -#define _SLANG_BC_LINE_NUM 0x40 - -#define _SLANG_BC_TMP 0x50 -#define _SLANG_BC_LVARIABLE_AGET 0x60 -#define _SLANG_BC_LVARIABLE_APUT 0x61 -#define _SLANG_BC_INTEGER_PLUS 0x62 -#define _SLANG_BC_INTEGER_MINUS 0x63 -#define _SLANG_BC_ARG_LVARIABLE 0x64 -#define _SLANG_BC_EARG_LVARIABLE 0x65 - -#define _SLANG_BC_CALL_DIRECT_INTRINSIC 0x80 -#define _SLANG_BC_INTRINSIC_CALL_DIRECT 0x81 -#define _SLANG_BC_CALL_DIRECT_LSTR 0x82 -#define _SLANG_BC_CALL_DIRECT_SLFUN 0x83 -#define _SLANG_BC_CALL_DIRECT_INTRSTOP 0x84 -#define _SLANG_BC_INTRINSIC_STOP 0x85 -#define _SLANG_BC_CALL_DIRECT_EARG_LVAR 0x86 -#define _SLANG_BC_CALL_DIRECT_LINT 0x87 -#define _SLANG_BC_CALL_DIRECT_LVAR 0x88 - - -/* Byte-Code Sub Types (_BCST_) */ - -/* These are sub_types of _SLANG_BC_BLOCK */ -#define _SLANG_BCST_ERROR_BLOCK 0x01 -#define _SLANG_BCST_EXIT_BLOCK 0x02 -#define _SLANG_BCST_USER_BLOCK0 0x03 -#define _SLANG_BCST_USER_BLOCK1 0x04 -#define _SLANG_BCST_USER_BLOCK2 0x05 -#define _SLANG_BCST_USER_BLOCK3 0x06 -#define _SLANG_BCST_USER_BLOCK4 0x07 -/* The user blocks MUST be in the above order */ -#define _SLANG_BCST_LOOP 0x10 -#define _SLANG_BCST_WHILE 0x11 -#define _SLANG_BCST_FOR 0x12 -#define _SLANG_BCST_FOREVER 0x13 -#define _SLANG_BCST_CFOR 0x14 -#define _SLANG_BCST_DOWHILE 0x15 -#define _SLANG_BCST_FOREACH 0x16 - -#define _SLANG_BCST_IF 0x20 -#define _SLANG_BCST_IFNOT 0x21 -#define _SLANG_BCST_ELSE 0x22 -#define _SLANG_BCST_ANDELSE 0x23 -#define _SLANG_BCST_ORELSE 0x24 -#define _SLANG_BCST_SWITCH 0x25 -#define _SLANG_BCST_NOTELSE 0x26 - -/* assignment (_SLANG_BC_SET_*_LVALUE) subtypes. The order MUST correspond - * to the assignment token order with the ASSIGN_TOKEN as the first! - */ -#define _SLANG_BCST_ASSIGN 0x01 -#define _SLANG_BCST_PLUSEQS 0x02 -#define _SLANG_BCST_MINUSEQS 0x03 -#define _SLANG_BCST_TIMESEQS 0x04 -#define _SLANG_BCST_DIVEQS 0x05 -#define _SLANG_BCST_BOREQS 0x06 -#define _SLANG_BCST_BANDEQS 0x07 -#define _SLANG_BCST_PLUSPLUS 0x08 -#define _SLANG_BCST_POST_PLUSPLUS 0x09 -#define _SLANG_BCST_MINUSMINUS 0x0A -#define _SLANG_BCST_POST_MINUSMINUS 0x0B - -/* These use SLANG_PLUS, SLANG_MINUS, SLANG_PLUSPLUS, etc... */ - -typedef union -{ -#if SLANG_HAS_FLOAT - double double_val; - float float_val; -#endif - long long_val; - unsigned long ulong_val; - VOID_STAR ptr_val; - char *s_val; - int int_val; - unsigned int uint_val; - SLang_MMT_Type *ref; - SLang_Name_Type *n_val; - struct _SLang_Struct_Type *struct_val; - struct _SLang_Array_Type *array_val; - short short_val; - unsigned short ushort_val; - char char_val; - unsigned char uchar_val; -} -_SL_Object_Union_Type; - -typedef struct _SLang_Object_Type -{ - unsigned char data_type; /* SLANG_INT_TYPE, ... */ - _SL_Object_Union_Type v; -} -SLang_Object_Type; - -struct _SLang_MMT_Type -{ - unsigned char data_type; /* int, string, etc... */ - VOID_STAR user_data; /* address of user structure */ - unsigned int count; /* number of references */ -}; - -extern int _SLang_pop_object_of_type (unsigned char, SLang_Object_Type *, int); - -typedef struct -{ - char *name; /* slstring */ - SLang_Object_Type obj; -} -_SLstruct_Field_Type; - -typedef struct _SLang_Struct_Type -{ - _SLstruct_Field_Type *fields; - unsigned int nfields; /* number used */ - unsigned int num_refs; -} -_SLang_Struct_Type; - -extern void _SLstruct_delete_struct (_SLang_Struct_Type *); -extern int _SLang_push_struct (_SLang_Struct_Type *); -extern int _SLang_pop_struct (_SLang_Struct_Type **); -extern int _SLstruct_init (void); -/* extern int _SLstruct_get_field (char *); */ -extern int _SLstruct_define_struct (void); -extern int _SLstruct_define_typedef (void); - -extern int _SLang_pop_datatype (unsigned char *); -extern int _SLang_push_datatype (unsigned char); - -struct _SLang_Ref_Type -{ - int is_global; - union - { - SLang_Name_Type *nt; - SLang_Object_Type *local_obj; - } - v; -}; - -extern int _SLang_dereference_ref (SLang_Ref_Type *); -extern int _SLang_deref_assign (SLang_Ref_Type *); -extern int _SLang_push_ref (int, VOID_STAR); - -extern int _SL_increment_frame_pointer (void); -extern int _SL_decrement_frame_pointer (void); - -extern int SLang_pop(SLang_Object_Type *); -extern void SLang_free_object (SLang_Object_Type *); -extern int _SLanytype_typecast (unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR); -extern void _SLstring_intrinsic (void); - - -/* These functions are used to create slstrings of a fixed length. Be - * very careful how they are used. In particular, if len bytes are allocated, - * then the string must be len characters long, no more and no less. - */ -extern char *_SLallocate_slstring (unsigned int); -extern char *_SLcreate_via_alloced_slstring (char *, unsigned int); -extern void _SLunallocate_slstring (char *, unsigned int); -extern int _SLpush_alloced_slstring (char *, unsigned int); - -typedef struct -{ - char **buf; - unsigned int max_num; - unsigned int num; - unsigned int delta_num; -} -_SLString_List_Type; -extern int _SLstring_list_append (_SLString_List_Type *, char *); -extern int _SLstring_list_init (_SLString_List_Type *, unsigned int, unsigned int); -extern void _SLstring_list_delete (_SLString_List_Type *); -extern int _SLstring_list_push (_SLString_List_Type *); - -/* This function assumes that s is an slstring. */ -extern char *_SLstring_dup_slstring (char *); -extern int _SLang_dup_and_push_slstring (char *); - - -extern int _SLang_init_import (void); - -/* This function checks to see if the referenced object is initialized */ -extern int _SLang_is_ref_initialized (SLang_Ref_Type *); -extern int _SLcheck_identifier_syntax (char *); -extern int _SLang_uninitialize_ref (SLang_Ref_Type *); - -extern int _SLpush_slang_obj (SLang_Object_Type *); - -extern char *_SLexpand_escaped_char(char *, char *); -extern void _SLexpand_escaped_string (char *, char *, char *); - -/* returns a pointer to an SLstring string-- use SLang_free_slstring */ -extern char *_SLstringize_object (SLang_Object_Type *); -extern int _SLdump_objects (char *, SLang_Object_Type *, unsigned int, int); - -extern SLang_Object_Type *_SLRun_Stack; -extern SLang_Object_Type *_SLStack_Pointer; - -struct _SLang_NameSpace_Type -{ - struct _SLang_NameSpace_Type *next; - char *name; /* this is the load_type name */ - char *namespace_name; /* this name is assigned by implements */ - unsigned int table_size; - SLang_Name_Type **table; -}; -extern SLang_NameSpace_Type *_SLns_allocate_namespace (char *, unsigned int); -extern SLang_NameSpace_Type *_SLns_find_namespace (char *); -extern int _SLns_set_namespace_name (SLang_NameSpace_Type *, char *); -extern SLang_Array_Type *_SLnspace_apropos (SLang_NameSpace_Type *, char *, unsigned int); -extern void _SLang_use_namespace_intrinsic (char *name); -extern char *_SLang_cur_namespace_intrinsic (void); -extern SLang_Array_Type *_SLang_apropos (char *, char *, unsigned int); -extern void _SLang_implements_intrinsic (char *); - -extern int _SLang_Trace; -extern int _SLstack_depth(void); -extern char *_SLang_Current_Function_Name; - -extern int _SLang_trace_fun(char *); -extern int _SLang_Compile_Line_Num_Info; - -extern char *_SLstring_dup_hashed_string (char *, unsigned long); -extern unsigned long _SLcompute_string_hash (char *); -extern char *_SLstring_make_hashed_string (char *, unsigned int, unsigned long *); -extern void _SLfree_hashed_string (char *, unsigned int, unsigned long); -unsigned long _SLstring_hash (unsigned char *, unsigned char *); -extern int _SLinit_slcomplex (void); - -extern int _SLang_init_slstrops (void); -extern int _SLstrops_do_sprintf_n (int); -extern int _SLang_sscanf (void); -extern double _SLang_atof (char *); -extern int _SLang_init_bstring (void); -extern int _SLang_init_sltime (void); -extern void _SLpack (void); -extern void _SLunpack (char *, SLang_BString_Type *); -extern void _SLpack_pad_format (char *); -extern unsigned int _SLpack_compute_size (char *); -extern int _SLusleep (unsigned long); - -/* frees upon error. NULL __NOT__ ok. */ -extern int _SLang_push_slstring (char *); - -extern unsigned char _SLarith_promote_type (unsigned char); -extern int _SLarith_get_precedence (unsigned char); -extern int _SLarith_typecast (unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR); - -extern int SLang_push(SLang_Object_Type *); -extern int SLadd_global_variable (char *); -extern void _SLang_clear_error (void); - -extern int _SLdo_pop (void); -extern unsigned int _SLsys_getkey (void); -extern int _SLsys_input_pending (int); -#ifdef IBMPC_SYSTEM -extern unsigned int _SLpc_convert_scancode (unsigned int, unsigned int, int); -#define _SLTT_KEY_SHIFT 1 -#define _SLTT_KEY_CTRL 2 -#define _SLTT_KEY_ALT 4 -#endif - -typedef struct _SLterminfo_Type SLterminfo_Type; -extern SLterminfo_Type *_SLtt_tigetent (char *); -extern char *_SLtt_tigetstr (SLterminfo_Type *, char *); -extern int _SLtt_tigetnum (SLterminfo_Type *, char *); -extern int _SLtt_tigetflag (SLterminfo_Type *, char *); - -#if SLTT_HAS_NON_BCE_SUPPORT -extern int _SLtt_get_bce_color_offset (void); -#endif -extern void (*_SLtt_color_changed_hook)(void); - -extern unsigned char SLang_Input_Buffer [SL_MAX_INPUT_BUFFER_LEN]; - -extern int _SLregister_types (void); -extern SLang_Class_Type *_SLclass_get_class (unsigned char); -extern VOID_STAR _SLclass_get_ptr_to_value (SLang_Class_Type *, SLang_Object_Type *); -extern void _SLclass_type_mismatch_error (unsigned char, unsigned char); -extern int _SLclass_init (void); -extern int _SLclass_copy_class (unsigned char, unsigned char); - -extern unsigned char _SLclass_Class_Type [256]; - -extern int (*_SLclass_get_typecast (unsigned char, unsigned char, int)) -(unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR); - -extern int (*_SLclass_get_binary_fun (int, SLang_Class_Type *, SLang_Class_Type *, SLang_Class_Type **, int)) -(int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR); - -extern int (*_SLclass_get_unary_fun (int, SLang_Class_Type *, SLang_Class_Type **, int)) -(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR); - -extern int _SLarith_register_types (void); -extern unsigned char _SLarith_Arith_Types []; -extern unsigned char _SLarith_Is_Arith_Type [256]; -extern int _SLarith_bin_op (SLang_Object_Type *, SLang_Object_Type *, int); - -extern int _SLarray_add_bin_op (unsigned char); - -extern int _SLang_call_funptr (SLang_Name_Type *); -extern void _SLset_double_format (char *); -extern SLang_Name_Type *_SLlocate_global_name (char *); -extern SLang_Name_Type *_SLlocate_name (char *); - -extern char *_SLdefines[]; - -#define SL_ERRNO_NOT_IMPLEMENTED 0x7FFF -extern int _SLerrno_errno; -extern int _SLerrno_init (void); - -extern int _SLstdio_fdopen (char *, int, char *); - -extern void _SLstruct_pop_args (int *); -extern void _SLstruct_push_args (SLang_Array_Type *); - -extern int _SLarray_aput (void); -extern int _SLarray_aget (void); -extern int _SLarray_inline_implicit_array (void); -extern int _SLarray_inline_array (void); -extern int _SLarray_wildcard_array (void); - -extern int -_SLarray_typecast (unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, int); - -extern int _SLarray_aput_transfer_elem (SLang_Array_Type *, int *, - VOID_STAR, unsigned int, int); -extern int _SLarray_aget_transfer_elem (SLang_Array_Type *, int *, - VOID_STAR, unsigned int, int); -extern void _SLarray_free_array_elements (SLang_Class_Type *, VOID_STAR, unsigned int); - -extern SLang_Foreach_Context_Type * -_SLarray_cl_foreach_open (unsigned char, unsigned int); -extern void _SLarray_cl_foreach_close (unsigned char, SLang_Foreach_Context_Type *); -extern int _SLarray_cl_foreach (unsigned char, SLang_Foreach_Context_Type *); - -extern int _SLarray_matrix_multiply (void); -extern void (*_SLang_Matrix_Multiply)(void); - -extern int _SLarray_init_slarray (void); -extern SLang_Array_Type * -SLang_create_array1 (unsigned char, int, VOID_STAR, int *, unsigned int, int); - -extern int _SLcompile_push_context (SLang_Load_Type *); -extern int _SLcompile_pop_context (void); -extern int _SLang_Auto_Declare_Globals; - -typedef struct -{ - union - { - long long_val; - char *s_val; /* Used for IDENT_TOKEN, FLOAT, etc... */ - SLang_BString_Type *b_val; - } v; - int free_sval_flag; - unsigned int num_refs; - unsigned long hash; -#if _SLANG_HAS_DEBUG_CODE - int line_number; -#endif - unsigned char type; -} -_SLang_Token_Type; - -extern void _SLcompile (_SLang_Token_Type *); -extern void (*_SLcompile_ptr)(_SLang_Token_Type *); - -/* *** TOKENS *** */ - -/* Note that that tokens corresponding to ^J, ^M, and ^Z should not be used. - * This is because a file that contains any of these characters will - * have an OS dependent interpretation, e.g., ^Z is EOF on MSDOS. - */ - -/* Special tokens */ -#define EOF_TOKEN 0x01 -#define RPN_TOKEN 0x02 -#define NL_TOKEN 0x03 -#define NOP_TOKEN 0x05 -#define FARG_TOKEN 0x06 -#define TMP_TOKEN 0x07 - -#define RESERVED1_TOKEN 0x0A /* \n */ -#define RESERVED2_TOKEN 0x0D /* \r */ - -/* Literal tokens */ -#define CHAR_TOKEN 0x10 -#define UCHAR_TOKEN 0x11 -#define SHORT_TOKEN 0x12 -#define USHORT_TOKEN 0x13 -#define INT_TOKEN 0x14 -#define UINT_TOKEN 0x15 -#define LONG_TOKEN 0x16 -#define ULONG_TOKEN 0x17 -#define IS_INTEGER_TOKEN(x) ((x >= CHAR_TOKEN) && (x <= ULONG_TOKEN)) -#define FLOAT_TOKEN 0x18 -#define DOUBLE_TOKEN 0x19 -#define RESERVED3_TOKEN 0x1A /* ^Z */ -#define COMPLEX_TOKEN 0x1B -#define STRING_TOKEN 0x1C -#define BSTRING_TOKEN 0x1D -#define _BSTRING_TOKEN 0x1E /* byte-compiled BSTRING */ -#define ESC_STRING_TOKEN 0x1F - -/* Tokens that can be LVALUES */ -#define IDENT_TOKEN 0x20 -#define ARRAY_TOKEN 0x21 -#define DOT_TOKEN 0x22 -#define IS_LVALUE_TOKEN (((t) <= DOT_TOKEN) && ((t) >= IDENT_TOKEN)) - -/* do not use these values */ -#define RESERVED4_TOKEN 0x23 /* # */ -#define RESERVED5_TOKEN 0x25 /* % */ - -/* Flags for struct fields */ -#define STATIC_TOKEN 0x26 -#define READONLY_TOKEN 0x27 -#define PRIVATE_TOKEN 0x28 -#define PUBLIC_TOKEN 0x29 - -/* Punctuation tokens */ -#define OBRACKET_TOKEN 0x2a -#define CBRACKET_TOKEN 0x2b -#define OPAREN_TOKEN 0x2c -#define CPAREN_TOKEN 0x2d -#define OBRACE_TOKEN 0x2e -#define CBRACE_TOKEN 0x2f - -#define COMMA_TOKEN 0x31 -#define SEMICOLON_TOKEN 0x32 -#define COLON_TOKEN 0x33 -#define NAMESPACE_TOKEN 0x34 - -/* Operators */ -#define POW_TOKEN 0x38 - -/* The order here must match the order in the Binop_Level table in slparse.c */ -#define FIRST_BINARY_OP 0x39 -#define ADD_TOKEN 0x39 -#define SUB_TOKEN 0x3a -#define TIMES_TOKEN 0x3b -#define DIV_TOKEN 0x3c -#define LT_TOKEN 0x3d -#define LE_TOKEN 0x3e -#define GT_TOKEN 0x3f -#define GE_TOKEN 0x40 -#define EQ_TOKEN 0x41 -#define NE_TOKEN 0x42 -#define AND_TOKEN 0x43 -#define OR_TOKEN 0x44 -#define MOD_TOKEN 0x45 -#define BAND_TOKEN 0x46 -#define SHL_TOKEN 0x47 -#define SHR_TOKEN 0x48 -#define BXOR_TOKEN 0x49 -#define BOR_TOKEN 0x4a -#define POUND_TOKEN 0x4b /* matrix multiplication */ - -#define LAST_BINARY_OP 0x4b -#define IS_BINARY_OP(t) ((t >= FIRST_BINARY_OP) && (t <= LAST_BINARY_OP)) - -/* unary tokens -- but not all of them (see grammar) */ -#define DEREF_TOKEN 0x4d -#define NOT_TOKEN 0x4e -#define BNOT_TOKEN 0x4f - -#define IS_INTERNAL_FUNC(t) ((t >= 0x50) && (t <= 0x56)) -#define POP_TOKEN 0x50 -#define CHS_TOKEN 0x51 -#define SIGN_TOKEN 0x52 -#define ABS_TOKEN 0x53 -#define SQR_TOKEN 0x54 -#define MUL2_TOKEN 0x55 -#define EXCH_TOKEN 0x56 - -/* Assignment tokens. Note: these must appear with sequential values. - * The order here must match the specific lvalue assignments below. - * These tokens are used by rpn routines in slang.c. slparse.c maps them - * onto the specific lvalue tokens while parsing infix. - * Also the assignment _SLANG_BCST_ assumes this order - */ -#define ASSIGN_TOKEN 0x57 -#define PLUSEQS_TOKEN 0x58 -#define MINUSEQS_TOKEN 0x59 -#define TIMESEQS_TOKEN 0x5A -#define DIVEQS_TOKEN 0x5B -#define BOREQS_TOKEN 0x5C -#define BANDEQS_TOKEN 0x5D -#define PLUSPLUS_TOKEN 0x5E -#define POST_PLUSPLUS_TOKEN 0x5F -#define MINUSMINUS_TOKEN 0x60 -#define POST_MINUSMINUS_TOKEN 0x61 - -/* Directives */ -#define FIRST_DIRECTIVE_TOKEN 0x62 -#define IFNOT_TOKEN 0x62 -#define IF_TOKEN 0x63 -#define ELSE_TOKEN 0x64 -#define FOREVER_TOKEN 0x65 -#define WHILE_TOKEN 0x66 -#define FOR_TOKEN 0x67 -#define _FOR_TOKEN 0x68 -#define LOOP_TOKEN 0x69 -#define SWITCH_TOKEN 0x6A -#define DOWHILE_TOKEN 0x6B -#define ANDELSE_TOKEN 0x6C -#define ORELSE_TOKEN 0x6D -#define ERRBLK_TOKEN 0x6E -#define EXITBLK_TOKEN 0x6F -/* These must be sequential */ -#define USRBLK0_TOKEN 0x70 -#define USRBLK1_TOKEN 0x71 -#define USRBLK2_TOKEN 0x72 -#define USRBLK3_TOKEN 0x73 -#define USRBLK4_TOKEN 0x74 - -#define CONT_TOKEN 0x75 -#define BREAK_TOKEN 0x76 -#define RETURN_TOKEN 0x77 - -#define CASE_TOKEN 0x78 -#define DEFINE_TOKEN 0x79 -#define DO_TOKEN 0x7a -#define VARIABLE_TOKEN 0x7b -#define GVARIABLE_TOKEN 0x7c -#define _REF_TOKEN 0x7d -#define PUSH_TOKEN 0x7e -#define STRUCT_TOKEN 0x7f -#define TYPEDEF_TOKEN 0x80 -#define NOTELSE_TOKEN 0x81 -#define DEFINE_STATIC_TOKEN 0x82 -#define FOREACH_TOKEN 0x83 -#define USING_TOKEN 0x84 -#define DEFINE_PRIVATE_TOKEN 0x85 -#define DEFINE_PUBLIC_TOKEN 0x86 - -/* Note: the order here must match the order of the generic assignment tokens. - * Also, the first token of each group must be the ?_ASSIGN_TOKEN. - * slparse.c exploits this order, as well as slang.h. - */ -#define FIRST_ASSIGN_TOKEN 0x90 -#define _STRUCT_ASSIGN_TOKEN 0x90 -#define _STRUCT_PLUSEQS_TOKEN 0x91 -#define _STRUCT_MINUSEQS_TOKEN 0x92 -#define _STRUCT_TIMESEQS_TOKEN 0x93 -#define _STRUCT_DIVEQS_TOKEN 0x94 -#define _STRUCT_BOREQS_TOKEN 0x95 -#define _STRUCT_BANDEQS_TOKEN 0x96 -#define _STRUCT_PLUSPLUS_TOKEN 0x97 -#define _STRUCT_POST_PLUSPLUS_TOKEN 0x98 -#define _STRUCT_MINUSMINUS_TOKEN 0x99 -#define _STRUCT_POST_MINUSMINUS_TOKEN 0x9A - -#define _ARRAY_ASSIGN_TOKEN 0xA0 -#define _ARRAY_PLUSEQS_TOKEN 0xA1 -#define _ARRAY_MINUSEQS_TOKEN 0xA2 -#define _ARRAY_TIMESEQS_TOKEN 0xA3 -#define _ARRAY_DIVEQS_TOKEN 0xA4 -#define _ARRAY_BOREQS_TOKEN 0xA5 -#define _ARRAY_BANDEQS_TOKEN 0xA6 -#define _ARRAY_PLUSPLUS_TOKEN 0xA7 -#define _ARRAY_POST_PLUSPLUS_TOKEN 0xA8 -#define _ARRAY_MINUSMINUS_TOKEN 0xA9 -#define _ARRAY_POST_MINUSMINUS_TOKEN 0xAA - -#define _SCALAR_ASSIGN_TOKEN 0xB0 -#define _SCALAR_PLUSEQS_TOKEN 0xB1 -#define _SCALAR_MINUSEQS_TOKEN 0xB2 -#define _SCALAR_TIMESEQS_TOKEN 0xB3 -#define _SCALAR_DIVEQS_TOKEN 0xB4 -#define _SCALAR_BOREQS_TOKEN 0xB5 -#define _SCALAR_BANDEQS_TOKEN 0xB6 -#define _SCALAR_PLUSPLUS_TOKEN 0xB7 -#define _SCALAR_POST_PLUSPLUS_TOKEN 0xB8 -#define _SCALAR_MINUSMINUS_TOKEN 0xB9 -#define _SCALAR_POST_MINUSMINUS_TOKEN 0xBA - -#define _DEREF_ASSIGN_TOKEN 0xC0 -#define _DEREF_PLUSEQS_TOKEN 0xC1 -#define _DEREF_MINUSEQS_TOKEN 0xC2 -#define _DEREF_TIMESEQS_TOKEN 0xC3 -#define _DEREF_DIVEQS_TOKEN 0xC4 -#define _DEREF_BOREQS_TOKEN 0xC5 -#define _DEREF_BANDEQS_TOKEN 0xC6 -#define _DEREF_PLUSPLUS_TOKEN 0xC7 -#define _DEREF_POST_PLUSPLUS_TOKEN 0xC8 -#define _DEREF_MINUSMINUS_TOKEN 0xC9 -#define _DEREF_POST_MINUSMINUS_TOKEN 0xCA - -#define LAST_ASSIGN_TOKEN 0xCA -#define IS_ASSIGN_TOKEN(t) (((t)>=FIRST_ASSIGN_TOKEN)&&((t)<=LAST_ASSIGN_TOKEN)) - -#define _INLINE_ARRAY_TOKEN 0xE0 -#define _INLINE_IMPLICIT_ARRAY_TOKEN 0xE1 -#define _NULL_TOKEN 0xE2 -#define _INLINE_WILDCARD_ARRAY_TOKEN 0xE3 - -#define LINE_NUM_TOKEN 0xFC -#define ARG_TOKEN 0xFD -#define EARG_TOKEN 0xFE -#define NO_OP_LITERAL 0xFF - -typedef struct -{ - /* sltoken.c */ - /* SLang_eval_object */ - SLang_Load_Type *llt; - SLPreprocess_Type *this_slpp; - /* prep_get_char() */ - char *input_line; - char cchar; - /* get_token() */ - int want_nl_token; - - /* slparse.c */ - _SLang_Token_Type ctok; - int block_depth; - int assignment_expression; - - /* slang.c : SLcompile() */ - _SLang_Token_Type save_token; - _SLang_Token_Type next_token; - void (*slcompile_ptr)(_SLang_Token_Type *); -} -_SLEval_Context; - -extern int _SLget_token (_SLang_Token_Type *); -extern void _SLparse_error (char *, _SLang_Token_Type *, int); -extern void _SLparse_start (SLang_Load_Type *); -extern int _SLget_rpn_token (_SLang_Token_Type *); -extern void _SLcompile_byte_compiled (void); - -extern int (*_SLprep_eval_hook) (char *); - -#ifdef HAVE_VSNPRINTF -#define _SLvsnprintf vsnprintf -#else -extern int _SLvsnprintf (char *, unsigned int, char *, va_list); -#endif - -#ifdef HAVE_SNPRINTF -# define _SLsnprintf snprintf -#else -extern int _SLsnprintf (char *, unsigned int, char *, ...); -#endif - -#undef _INLINE_ -#if defined(__GNUC__) && _SLANG_USE_INLINE_CODE -# define _INLINE_ __inline__ -#else -# define _INLINE_ -#endif - - -#endif /* _PRIVATE_SLANG_H_ */ diff --git a/mdk-stage1/slang/config.h b/mdk-stage1/slang/config.h deleted file mode 100644 index a5ab3273c..000000000 --- a/mdk-stage1/slang/config.h +++ /dev/null @@ -1,163 +0,0 @@ -/* src/sysconf.h. Generated automatically by configure. */ -/* -*- c -*- */ -/* Note: this is for unix only. */ - -#ifndef SL_CONFIG_H -#define SL_CONFIG_H - -/* define if you have stdlib.h */ -#define HAVE_STDLIB_H 1 - -/* define if you have unistd.h */ -#define HAVE_UNISTD_H 1 - -/* define if you have termios.h */ -#define HAVE_TERMIOS_H 1 - -/* define if you have memory.h */ -#define HAVE_MEMORY_H 1 - -/* define if you have malloc.h */ -#define HAVE_MALLOC_H 1 - -/* define if you have memset */ -#define HAVE_MEMSET 1 - -/* define if you have memcpy */ -#define HAVE_MEMCPY 1 - -//#define HAVE_SETLOCALE 1 -//#define HAVE_LOCALE_H 1 - -#define HAVE_VFSCANF 1 - -/* define if you have fcntl.h */ -#define HAVE_FCNTL_H 1 - -/* Define if you have the vsnprintf, snprintf functions and they return - * EOF upon failure. - */ -#define HAVE_VSNPRINTF 1 -#define HAVE_SNPRINTF 1 - -/* define if you have sys/fcntl.h */ -#define HAVE_SYS_FCNTL_H 1 - -#define HAVE_SYS_TYPES_H 1 -#define HAVE_SYS_WAIT_H 1 -#define HAVE_SYS_TIMES_H 1 - -/* Set these to the appropriate values */ -#define SIZEOF_SHORT 2 -#define SIZEOF_INT 4 -#define SIZEOF_LONG 4 -#define SIZEOF_FLOAT 4 -#define SIZEOF_DOUBLE 8 - -/* define if you have these. */ -#define HAVE_ATEXIT 1 -#define HAVE_ON_EXIT 1 -#define HAVE_PUTENV 1 -#define HAVE_GETCWD 1 -#define HAVE_TCGETATTR 1 -#define HAVE_TCSETATTR 1 -#define HAVE_CFGETOSPEED 1 -#define HAVE_LSTAT 1 -#define HAVE_KILL 1 -#define HAVE_CHOWN 1 -#define HAVE_VSNPRINTF 1 -#define HAVE_POPEN 1 -#define HAVE_UMASK 1 -#define HAVE_READLINK 1 -#define HAVE_TIMES 1 -#define HAVE_GMTIME 1 -#define HAVE_MKFIFO 1 - -#define HAVE_GETPPID 1 -#define HAVE_GETGID 1 -#define HAVE_GETEGID 1 -#define HAVE_GETEUID 1 -/* #undef HAVE_GETUID */ - -#define HAVE_SETGID 1 -#define HAVE_SETPGID 1 -#define HAVE_SETUID 1 - -#define HAVE_ACOSH 1 -#define HAVE_ASINH 1 -#define HAVE_ATANH 1 - -#define HAVE_DIRENT_H 1 -/* #undef HAVE_SYS_NDIR_H */ -/* #undef HAVE_SYS_DIR_H */ -/* #undef HAVE_NDIR_H */ - -#define HAVE_DLFCN_H 1 - -#define HAVE_SYS_UTSNAME_H 1 -#define HAVE_UNAME 1 - -/* These two are needed on DOS-like systems. Unix does not require them. - * They are included here for consistency. - * -#define HAVE_IO_H -#define HAVE_PROCESS_H - */ - -/* #undef USE_TERMCAP */ - -/* #undef mode_t */ -/* #undef uid_t */ -/* #undef pid_t */ -/* #undef gid_t */ - -/* Do we have posix signals? */ -#define HAVE_SIGACTION 1 -#define HAVE_SIGPROCMASK 1 -#define HAVE_SIGEMPTYSET 1 -#define HAVE_SIGADDSET 1 - -#if defined(HAVE_SIGADDSET) && defined(HAVE_SIGEMPTYSET) -# if defined(HAVE_SIGACTION) && defined(HAVE_SIGPROCMASK) -# define SLANG_POSIX_SIGNALS -# endif -#endif - -/* Define if you need to in order for stat and other things to work. */ -/* #undef _POSIX_SOURCE */ - -#ifdef _AIX -# ifndef _POSIX_SOURCE -# define _POSIX_SOURCE 1 -# endif -# ifndef _ALL_SOURCE -# define _ALL_SOURCE -# endif -/* This may generate warnings but the fact is that without it, xlc will - * INCORRECTLY inline many str* functions. */ -/* # undef __STR__ */ -#endif - -/* define USE_TERMCAP if you want to use it instead of terminfo. */ -#if defined(sequent) || defined(NeXT) -# ifndef USE_TERMCAP -# define USE_TERMCAP -# endif -#endif - -#if defined(ultrix) && !defined(__GNUC__) -# ifndef NO_PROTOTYPES -# define NO_PROTOTYPES -# endif -#endif - -#ifndef unix -# define unix 1 -#endif - -#ifndef __unix__ -# define __unix__ 1 -#endif - -#define _SLANG_SOURCE_ 1 -#endif /* SL_CONFIG_H */ diff --git a/mdk-stage1/slang/jdmacros.h b/mdk-stage1/slang/jdmacros.h deleted file mode 100644 index 70d491b78..000000000 --- a/mdk-stage1/slang/jdmacros.h +++ /dev/null @@ -1,53 +0,0 @@ -#ifndef _JD_MACROS_H_ -#define _JD_MACROS_H_ - -#ifndef SLMEMSET -# ifdef HAVE_MEMSET -# define SLMEMSET memset -# else -# define SLMEMSET SLmemset -# endif -#endif - -#ifndef SLMEMCHR -# ifdef HAVE_MEMCHR -# define SLMEMCHR memchr -# else -# define SLMEMCHR SLmemchr -# endif -#endif - -#ifndef SLMEMCPY -# ifdef HAVE_MEMCPY -# define SLMEMCPY memcpy -# else -# define SLMEMCPY SLmemcpy -# endif -#endif - -/* Note: HAVE_MEMCMP requires an unsigned memory comparison!!! */ -#ifndef SLMEMCMP -# ifdef HAVE_MEMCMP -# define SLMEMCMP memcmp -# else -# define SLMEMCMP SLmemcmp -# endif -#endif - -#ifndef SLFREE -# define SLFREE free -#endif - -#ifndef SLMALLOC -# define SLMALLOC malloc -#endif - -#ifndef SLCALLOC -# define SLCALLOC calloc -#endif - -#ifndef SLREALLOC -# define SLREALLOC realloc -#endif - -#endif /* _JD_MACROS_H_ */ diff --git a/mdk-stage1/slang/keywhash.c b/mdk-stage1/slang/keywhash.c deleted file mode 100644 index 17d94d5a3..000000000 --- a/mdk-stage1/slang/keywhash.c +++ /dev/null @@ -1,190 +0,0 @@ -/* Perfect hash generated by command line: - * ./a.out 1 - */ -#define MIN_HASH_VALUE 2 -#define MAX_HASH_VALUE 118 -#define MIN_KEYWORD_LEN 2 -#define MAX_KEYWORD_LEN 11 - -static unsigned char Keyword_Hash_Table [256] = -{ - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 1, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 9, 7, 1, 8, 2, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 0, 0, 119, 0, 119, 119, 119, 7, 119, 0, 0, 119, 119, 0, - 119, 119, 0, 0, 0, 0, 119, 119, 0, 119, 119, 119, 119, 119, 119, 2, - 119, 41, 1, 1, 9, 0, 55, 8, 0, 0, 119, 0, 27, 0, 0, 0, - 7, 2, 0, 21, 0, 0, 0, 3, 2, 0, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119 -}; - -static unsigned char keyword_hash (char *s, unsigned int len) -{ - unsigned int sum; - - sum = len; - while (len) - { - len--; - sum += (unsigned int) Keyword_Hash_Table [(unsigned char)s[len]]; - } - return sum; -} - -typedef struct -{ - char *name; - unsigned int type; -} -Keyword_Table_Type; - -static Keyword_Table_Type Keyword_Table [/* 117 */] = -{ - {"or", OR_TOKEN}, - {"not", NOT_TOKEN}, - {NULL,0}, - {"xor", BXOR_TOKEN}, - {"return", RETURN_TOKEN}, - {"exch", EXCH_TOKEN}, - {NULL,0}, - {"continue", CONT_TOKEN}, - {NULL,0}, - {"do", DO_TOKEN}, - {"mod", MOD_TOKEN}, - {"ERROR_BLOCK", ERRBLK_TOKEN}, - {"USER_BLOCK2", USRBLK2_TOKEN}, - {"USER_BLOCK4", USRBLK4_TOKEN}, - {"__tmp", TMP_TOKEN}, - {"pop", POP_TOKEN}, - {NULL,0}, - {"EXIT_BLOCK", EXITBLK_TOKEN}, - {"USER_BLOCK1", USRBLK1_TOKEN}, - {"USER_BLOCK3", USRBLK3_TOKEN}, - {"USER_BLOCK0", USRBLK0_TOKEN}, - {NULL,0}, - {"shr", SHR_TOKEN}, - {"chs", CHS_TOKEN}, - {"sqr", SQR_TOKEN}, - {NULL,0}, - {"struct", STRUCT_TOKEN}, - {NULL,0}, - {NULL,0}, - {"switch", SWITCH_TOKEN}, - {"mul2", MUL2_TOKEN}, - {"sign", SIGN_TOKEN}, - {"using", USING_TOKEN}, - {"while", WHILE_TOKEN}, - {NULL,0}, - {NULL,0}, - {"loop", LOOP_TOKEN}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {"public", PUBLIC_TOKEN}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {"break", BREAK_TOKEN}, - {NULL,0}, - {"do_while", DOWHILE_TOKEN}, - {NULL,0}, - {"shl", SHL_TOKEN}, - {"else", ELSE_TOKEN}, - {"and", AND_TOKEN}, - {"orelse", ORELSE_TOKEN}, - {"private", PRIVATE_TOKEN}, - {NULL,0}, - {"if", IF_TOKEN}, - {"for", FOR_TOKEN}, - {"!if", IFNOT_TOKEN}, - {NULL,0}, - {"_for", _FOR_TOKEN}, - {"forever", FOREVER_TOKEN}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {"abs", ABS_TOKEN}, - {"case", CASE_TOKEN}, - {NULL,0}, - {"static", STATIC_TOKEN}, - {"define", DEFINE_TOKEN}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {"typedef", TYPEDEF_TOKEN}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {"foreach", FOREACH_TOKEN}, - {"andelse", ANDELSE_TOKEN}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {NULL,0}, - {"variable", VARIABLE_TOKEN}, -}; - -static Keyword_Table_Type *is_keyword (char *str, unsigned int len) -{ - unsigned int hash; - char *name; - Keyword_Table_Type *kw; - - if ((len < MIN_KEYWORD_LEN) - || (len > MAX_KEYWORD_LEN)) - return NULL; - - hash = keyword_hash (str, len); - if ((hash > MAX_HASH_VALUE) || (hash < MIN_HASH_VALUE)) - return NULL; - - kw = &Keyword_Table[hash - MIN_HASH_VALUE]; - if ((NULL != (name = kw->name)) - && (*str == *name) - && (0 == strcmp (str, name))) - return kw; - return NULL; -} diff --git a/mdk-stage1/slang/sl-feat.h b/mdk-stage1/slang/sl-feat.h deleted file mode 100644 index 511d72451..000000000 --- a/mdk-stage1/slang/sl-feat.h +++ /dev/null @@ -1,60 +0,0 @@ -/* Setting this to 1 enables automatic support for associative arrays. - * If this is set to 0, an application must explicitly enable associative - * array support via SLang_init_slassoc. - */ -#define SLANG_HAS_ASSOC_ARRAYS 1 - -#define SLANG_HAS_COMPLEX 1 -#define SLANG_HAS_FLOAT 1 - -/* This is the old space-speed trade off. To reduce memory usage and code - * size, set this to zero. - */ -#define _SLANG_OPTIMIZE_FOR_SPEED 2 - -#define _SLANG_USE_INLINE_CODE 1 - -/* This is experimental. It adds extra information for tracking down - * errors. - */ -#define _SLANG_HAS_DEBUG_CODE 1 - -/* Allow optimizations based upon the __tmp operator. */ -#define _SLANG_USE_TMP_OPTIMIZATION 1 - -/* Setting this to one will map 8 bit vtxxx terminals to 7 bit. Terminals - * such as the vt320 can be set up to output the two-character escape sequence - * encoded as 'ESC [' as single character. Setting this variable to 1 will - * insert code to map such characters to the 7 bit equivalent. - * This affects just input characters in the range 128-160 on non PC - * systems. - */ -#if defined(VMS) || defined(AMIGA) -# define _SLANG_MAP_VTXXX_8BIT 1 -#else -# define _SLANG_MAP_VTXXX_8BIT 0 -#endif - -/* Add support for color terminals that cannot do background color erases - * Such terminals are poorly designed and are slowly disappearing but they - * are still quite common. For example, screen is one of them! - * - * This is experimental. In particular, it is not known to work if - * KANJI suupport is enabled. - */ -#if !defined(IBMPC_SYSTEM) -# define SLTT_HAS_NON_BCE_SUPPORT 1 -#else -# define SLTT_HAS_NON_BCE_SUPPORT 0 -#endif - -/* If you want slang to assume that an xterm always has the background color - * erase feature, then set this to 1. Otherwise, it will check the terminfo - * database. This may or may not be a good idea since most good color xterms - * support bce but many terminfo systems do not support it. - */ -#define SLTT_XTERM_ALWAYS_BCE 0 - -/* Set this to 1 to enable Kanji support. See above comment. */ -#define SLANG_HAS_KANJI_SUPPORT 0 - diff --git a/mdk-stage1/slang/slang.c b/mdk-stage1/slang/slang.c deleted file mode 100644 index 6edc7df37..000000000 --- a/mdk-stage1/slang/slang.c +++ /dev/null @@ -1,5547 +0,0 @@ -/* -*- mode: C; mode: fold; -*- */ -/* slang.c --- guts of S-Lang interpreter */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#if SLANG_HAS_FLOAT -# include <math.h> -#endif - -#include "slang.h" -#include "_slang.h" - -#define USE_COMBINED_BYTECODES 0 - -struct _SLBlock_Type; - -typedef struct -{ - struct _SLBlock_Type *body; - unsigned int num_refs; -} -_SLBlock_Header_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - - union - { - _SLBlock_Header_Type *header; /* body of function */ - char *autoload_filename; - } - v; -#if _SLANG_HAS_DEBUG_CODE - char *file; -#endif -#define SLANG_MAX_LOCAL_VARIABLES 254 -#define AUTOLOAD_NUM_LOCALS (SLANG_MAX_LOCAL_VARIABLES + 1) - unsigned char nlocals; /* number of local variables */ - unsigned char nargs; /* number of arguments */ -} -_SLang_Function_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - - SLang_Object_Type obj; -} -SLang_Global_Var_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - - int local_var_number; -} -SLang_Local_Var_Type; - -typedef struct _SLBlock_Type -{ - unsigned char bc_main_type; - unsigned char bc_sub_type; - union - { - struct _SLBlock_Type *blk; - int i_blk; - - SLang_Name_Type *nt_blk; - SLang_App_Unary_Type *nt_unary_blk; - SLang_Intrin_Var_Type *nt_ivar_blk; - SLang_Intrin_Fun_Type *nt_ifun_blk; - SLang_Global_Var_Type *nt_gvar_blk; - SLang_IConstant_Type *iconst_blk; - SLang_DConstant_Type *dconst_blk; - _SLang_Function_Type *nt_fun_blk; - - VOID_STAR ptr_blk; - char *s_blk; - SLang_BString_Type *bs_blk; - -#if SLANG_HAS_FLOAT - double *double_blk; /*literal double is a pointer */ -#endif - float float_blk; - long l_blk; - struct _SLang_Struct_Type *struct_blk; - int (*call_function)(void); - } - b; -} -SLBlock_Type; - -/* Debugging and tracing variables */ - -void (*SLang_Enter_Function)(char *) = NULL; -void (*SLang_Exit_Function)(char *) = NULL; -/* If non null, these call C functions before and after a slang function. */ - -int _SLang_Trace = 0; -/* If _SLang_Trace = -1, do not trace intrinsics */ -static int Trace_Mode = 0; - -static char *Trace_Function; /* function to be traced */ -int SLang_Traceback = 0; -/* non zero means do traceback. If less than 0, do not show local variables */ - -/* These variables handle _NARGS processing by the parser */ -int SLang_Num_Function_Args; -static int *Num_Args_Stack; -static unsigned int Recursion_Depth; -static SLang_Object_Type *Frame_Pointer; -static int Next_Function_Num_Args; -static unsigned int Frame_Pointer_Depth; -static unsigned int *Frame_Pointer_Stack; - -static int Lang_Break_Condition = 0; -/* true if any one below is true. This keeps us from testing 3 variables. - * I know this can be perfomed with a bitmapped variable, but... - */ -static int Lang_Break = 0; -static int Lang_Return = 0; -/* static int Lang_Continue = 0; */ - -SLang_Object_Type *_SLRun_Stack; -SLang_Object_Type *_SLStack_Pointer; -static SLang_Object_Type *_SLStack_Pointer_Max; - -/* Might want to increase this. */ -static SLang_Object_Type Local_Variable_Stack[SLANG_MAX_LOCAL_STACK]; -static SLang_Object_Type *Local_Variable_Frame = Local_Variable_Stack; - -static void free_function_header (_SLBlock_Header_Type *); - -void (*SLang_Dump_Routine)(char *); - -static void call_dump_routine (char *fmt, ...) -{ - char buf[1024]; - va_list ap; - - va_start (ap, fmt); - if (SLang_Dump_Routine != NULL) - { - (void) _SLvsnprintf (buf, sizeof (buf), fmt, ap); - (*SLang_Dump_Routine) (buf); - } - else - { - vfprintf (stderr, fmt, ap); - fflush (stderr); - } - va_end (ap); -} - -static void do_traceback (char *, unsigned int, char *); -static int init_interpreter (void); - -/*{{{ push/pop/etc stack manipulation functions */ - -/* This routine is assumed to work even in the presence of a SLang_Error. */ -_INLINE_ -int SLang_pop (SLang_Object_Type *x) -{ - register SLang_Object_Type *y; - - y = _SLStack_Pointer; - if (y == _SLRun_Stack) - { - if (SLang_Error == 0) SLang_Error = SL_STACK_UNDERFLOW; - x->data_type = 0; - return -1; - } - y--; - *x = *y; - - _SLStack_Pointer = y; - return 0; -} - -static int pop_ctrl_integer (int *i) -{ - int type; - SLang_Class_Type *cl; -#if _SLANG_OPTIMIZE_FOR_SPEED - register SLang_Object_Type *y; - - /* Most of the time, either an integer or a char will be on the stack. - * Optimize these cases. - */ - y = _SLStack_Pointer; - if (y == _SLRun_Stack) - { - if (SLang_Error == 0) SLang_Error = SL_STACK_UNDERFLOW; - return -1; - } - y--; - - type = y->data_type; - if (type == SLANG_INT_TYPE) - { - _SLStack_Pointer = y; - *i = y->v.int_val; - return 0; - } - if (type == SLANG_CHAR_TYPE) - { - _SLStack_Pointer = y; - *i = y->v.char_val; - return 0; - } -#else - if (-1 == (type = SLang_peek_at_stack ())) - return -1; -#endif - - cl = _SLclass_get_class ((unsigned char) type); - if (cl->cl_to_bool == NULL) - { - SLang_verror (SL_TYPE_MISMATCH, - "%s cannot be used in a boolean context", - cl->cl_name); - return -1; - } - return cl->cl_to_bool ((unsigned char) type, i); -} - -_INLINE_ -int SLang_peek_at_stack (void) -{ - if (_SLStack_Pointer == _SLRun_Stack) - { - if (SLang_Error == 0) - SLang_Error = SL_STACK_UNDERFLOW; - return -1; - } - - return (_SLStack_Pointer - 1)->data_type; -} - -int SLang_peek_at_stack1 (void) -{ - int type; - - type = SLang_peek_at_stack (); - if (type == SLANG_ARRAY_TYPE) - type = (_SLStack_Pointer - 1)->v.array_val->data_type; - - return type; -} - -_INLINE_ -void SLang_free_object (SLang_Object_Type *obj) -{ - unsigned char data_type; - SLang_Class_Type *cl; - - if (obj == NULL) return; - data_type = obj->data_type; -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [data_type]) - return; - if (data_type == SLANG_STRING_TYPE) - { - SLang_free_slstring (obj->v.s_val); - return; - } -#endif - cl = _SLclass_get_class (data_type); -#if !_SLANG_OPTIMIZE_FOR_SPEED - if (cl->cl_class_type != SLANG_CLASS_TYPE_SCALAR) -#endif - (*cl->cl_destroy) (data_type, (VOID_STAR) &obj->v); -} - -_INLINE_ -int SLang_push (SLang_Object_Type *x) -{ - register SLang_Object_Type *y; - y = _SLStack_Pointer; - - /* if there is a SLang_Error, probably not much harm will be done - if it is ignored here */ - /* if (SLang_Error) return; */ - - /* flag it now */ - if (y >= _SLStack_Pointer_Max) - { - if (!SLang_Error) SLang_Error = SL_STACK_OVERFLOW; - return -1; - } - - *y = *x; - _SLStack_Pointer = y + 1; - return 0; -} - -/* _INLINE_ */ -int SLclass_push_ptr_obj (unsigned char type, VOID_STAR pval) -{ - register SLang_Object_Type *y; - y = _SLStack_Pointer; - - if (y >= _SLStack_Pointer_Max) - { - if (!SLang_Error) SLang_Error = SL_STACK_OVERFLOW; - return -1; - } - - y->data_type = type; - y->v.ptr_val = pval; - - _SLStack_Pointer = y + 1; - return 0; -} - -_INLINE_ -int SLclass_push_int_obj (unsigned char type, int x) -{ - register SLang_Object_Type *y; - y = _SLStack_Pointer; - - if (y >= _SLStack_Pointer_Max) - { - if (!SLang_Error) SLang_Error = SL_STACK_OVERFLOW; - return -1; - } - - y->data_type = type; - y->v.int_val = x; - - _SLStack_Pointer = y + 1; - return 0; -} - -_INLINE_ -int _SLang_pop_object_of_type (unsigned char type, SLang_Object_Type *obj, - int allow_arrays) -{ - register SLang_Object_Type *y; - - y = _SLStack_Pointer; - if (y == _SLRun_Stack) - return SLang_pop (obj); - y--; - if (y->data_type != type) - { -#if _SLANG_OPTIMIZE_FOR_SPEED - /* This is an implicit typecast. We do not want to typecast - * floats to ints implicitly. - */ - if (_SLarith_Is_Arith_Type [type] - && _SLarith_Is_Arith_Type [y->data_type] - && (_SLarith_Is_Arith_Type [type] >= _SLarith_Is_Arith_Type[y->data_type])) - { - /* This should not fail */ - (void) _SLarith_typecast (y->data_type, (VOID_STAR)&y->v, 1, - type, (VOID_STAR)&obj->v); - obj->data_type = type; - _SLStack_Pointer = y; - return 0; - } -#endif - - if ((allow_arrays == 0) - || (y->data_type != SLANG_ARRAY_TYPE) - || (y->v.array_val->data_type != type)) - if (-1 == SLclass_typecast (type, 1, 0)) - return -1; - } - *obj = *y; - _SLStack_Pointer = y; - return 0; -} - -/* This function reverses the top n items on the stack and returns a - * an offset from the start of the stack to the last item. - */ -int SLreverse_stack (int n) -{ - SLang_Object_Type *otop, *obot, tmp; - - otop = _SLStack_Pointer; - if ((n > otop - _SLRun_Stack) || (n < 0)) - { - SLang_Error = SL_STACK_UNDERFLOW; - return -1; - } - obot = otop - n; - otop--; - while (otop > obot) - { - tmp = *obot; - *obot = *otop; - *otop = tmp; - otop--; - obot++; - } - return (int) ((_SLStack_Pointer - n) - _SLRun_Stack); -} - -_INLINE_ -int SLroll_stack (int np) -{ - int n, i; - SLang_Object_Type *otop, *obot, tmp; - - if ((n = abs(np)) <= 1) return 0; /* identity */ - - obot = otop = _SLStack_Pointer; - i = n; - while (i != 0) - { - if (obot <= _SLRun_Stack) - { - SLang_Error = SL_STACK_UNDERFLOW; - return -1; - } - obot--; - i--; - } - otop--; - - if (np > 0) - { - /* Put top on bottom and roll rest up. */ - tmp = *otop; - while (otop > obot) - { - *otop = *(otop - 1); - otop--; - } - *otop = tmp; - } - else - { - /* Put bottom on top and roll rest down. */ - tmp = *obot; - while (obot < otop) - { - *obot = *(obot + 1); - obot++; - } - *obot = tmp; - } - return 0; -} - -int _SLstack_depth (void) -{ - return (int) (_SLStack_Pointer - _SLRun_Stack); -} - -int SLdup_n (int n) -{ - SLang_Object_Type *bot, *top; - - if (n <= 0) - return 0; - - top = _SLStack_Pointer; - if (top < _SLRun_Stack + n) - { - if (SLang_Error == 0) - SLang_Error = SL_STACK_UNDERFLOW; - return -1; - } - if (top + n > _SLStack_Pointer_Max) - { - if (SLang_Error == 0) - SLang_Error = SL_STACK_OVERFLOW; - return -1; - } - bot = top - n; - - while (bot < top) - { - SLang_Class_Type *cl; - unsigned char data_type = bot->data_type; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [data_type]) - { - *_SLStack_Pointer++ = *bot++; - continue; - } -#endif - cl = _SLclass_get_class (data_type); - if (-1 == (*cl->cl_push) (data_type, (VOID_STAR) &bot->v)) - return -1; - bot++; - } - return 0; -} - -/*}}}*/ - -/*{{{ inner interpreter and support functions */ - -_INLINE_ -int _SL_increment_frame_pointer (void) -{ - if (Recursion_Depth >= SLANG_MAX_RECURSIVE_DEPTH) - { - SLang_verror (SL_STACK_OVERFLOW, "Num Args Stack Overflow"); - return -1; - } - Num_Args_Stack [Recursion_Depth] = SLang_Num_Function_Args; - - SLang_Num_Function_Args = Next_Function_Num_Args; - Next_Function_Num_Args = 0; - Recursion_Depth++; - return 0; -} - -_INLINE_ -int _SL_decrement_frame_pointer (void) -{ - if (Recursion_Depth == 0) - { - SLang_verror (SL_STACK_UNDERFLOW, "Num Args Stack Underflow"); - return -1; - } - - Recursion_Depth--; - if (Recursion_Depth < SLANG_MAX_RECURSIVE_DEPTH) - SLang_Num_Function_Args = Num_Args_Stack [Recursion_Depth]; - - return 0; -} - -_INLINE_ -int SLang_start_arg_list (void) -{ - if (Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH) - { - Frame_Pointer_Stack [Frame_Pointer_Depth] = (unsigned int) (Frame_Pointer - _SLRun_Stack); - Frame_Pointer = _SLStack_Pointer; - Frame_Pointer_Depth++; - Next_Function_Num_Args = 0; - return 0; - } - - SLang_verror (SL_STACK_OVERFLOW, "Frame Stack Overflow"); - return -1; -} - -_INLINE_ -int SLang_end_arg_list (void) -{ - if (Frame_Pointer_Depth == 0) - { - SLang_verror (SL_STACK_UNDERFLOW, "Frame Stack Underflow"); - return -1; - } - Frame_Pointer_Depth--; - if (Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH) - { - Next_Function_Num_Args = (int) (_SLStack_Pointer - Frame_Pointer); - Frame_Pointer = _SLRun_Stack + Frame_Pointer_Stack [Frame_Pointer_Depth]; - } - return 0; -} - -_INLINE_ -static int do_bc_call_direct_frame (int (*f)(void)) -{ - if ((0 == SLang_end_arg_list ()) - && (0 == _SL_increment_frame_pointer ())) - { - (void) (*f) (); - _SL_decrement_frame_pointer (); - } - if (SLang_Error) - return -1; - return 0; -} - -static int do_name_type_error (SLang_Name_Type *nt) -{ - char buf[256]; - if (nt != NULL) - { - (void) _SLsnprintf (buf, sizeof (buf), "(Error occurred processing %s)", nt->name); - do_traceback (buf, 0, NULL); - } - return -1; -} - -/* local and global variable assignments */ - -static int do_binary_ab (int op, SLang_Object_Type *obja, SLang_Object_Type *objb) -{ - SLang_Class_Type *a_cl, *b_cl, *c_cl; - unsigned char b_data_type, a_data_type, c_data_type; - int (*binary_fun) (int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR); - VOID_STAR pa; - VOID_STAR pb; - VOID_STAR pc; - int ret; - - b_data_type = objb->data_type; - a_data_type = obja->data_type; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (_SLarith_Is_Arith_Type[a_data_type] - && _SLarith_Is_Arith_Type[b_data_type]) - { - int status; - status = _SLarith_bin_op (obja, objb, op); - if (status != 1) - return status; - /* drop and try it the hard way */ - } -#endif - - a_cl = _SLclass_get_class (a_data_type); - if (a_data_type == b_data_type) - b_cl = a_cl; - else - b_cl = _SLclass_get_class (b_data_type); - - if (NULL == (binary_fun = _SLclass_get_binary_fun (op, a_cl, b_cl, &c_cl, 1))) - return -1; - - c_data_type = c_cl->cl_data_type; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [a_data_type]) - pa = (VOID_STAR) &obja->v; - else -#endif - pa = _SLclass_get_ptr_to_value (a_cl, obja); - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [b_data_type]) - pb = (VOID_STAR) &objb->v; - else -#endif - pb = _SLclass_get_ptr_to_value (b_cl, objb); - - pc = c_cl->cl_transfer_buf; - - if (1 != (*binary_fun) (op, - a_data_type, pa, 1, - b_data_type, pb, 1, - pc)) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "Binary operation between %s and %s failed", - a_cl->cl_name, b_cl->cl_name); - - return -1; - } - - /* apush will create a copy, so make sure we free after the push */ - ret = (*c_cl->cl_apush)(c_data_type, pc); -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [c_data_type]) -#endif - (*c_cl->cl_adestroy)(c_data_type, pc); - - return ret; -} - -_INLINE_ -static void do_binary (int op) -{ - SLang_Object_Type obja, objb; - - if (SLang_pop (&objb)) return; - if (0 == SLang_pop (&obja)) - { - (void) do_binary_ab (op, &obja, &objb); -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [obja.data_type]) -#endif - SLang_free_object (&obja); - } -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [objb.data_type]) -#endif - SLang_free_object (&objb); -} - -static int do_unary_op (int op, SLang_Object_Type *obj, int unary_type) -{ - int (*f) (int, unsigned char, VOID_STAR, unsigned int, VOID_STAR); - VOID_STAR pa; - VOID_STAR pb; - SLang_Class_Type *a_cl, *b_cl; - unsigned char a_type, b_type; - int ret; - - a_type = obj->data_type; - a_cl = _SLclass_get_class (a_type); - - if (NULL == (f = _SLclass_get_unary_fun (op, a_cl, &b_cl, unary_type))) - return -1; - - b_type = b_cl->cl_data_type; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [a_type]) - pa = (VOID_STAR) &obj->v; - else -#endif - pa = _SLclass_get_ptr_to_value (a_cl, obj); - - pb = b_cl->cl_transfer_buf; - - if (1 != (*f) (op, a_type, pa, 1, pb)) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "Unary operation for %s failed", a_cl->cl_name); - return -1; - } - - ret = (*b_cl->cl_apush)(b_type, pb); - /* cl_apush creates a copy, so make sure we call cl_adestroy */ -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [b_type]) -#endif - (*b_cl->cl_adestroy)(b_type, pb); - - return ret; -} - -_INLINE_ -static int do_unary (int op, int unary_type) -{ - SLang_Object_Type obj; - int ret; - - if (-1 == SLang_pop (&obj)) return -1; - ret = do_unary_op (op, &obj, unary_type); -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [obj.data_type]) -#endif - SLang_free_object (&obj); - return ret; -} - -static int do_assignment_binary (int op, SLang_Object_Type *obja_ptr) -{ - SLang_Object_Type objb; - int ret; - - if (SLang_pop (&objb)) - return -1; - - ret = do_binary_ab (op, obja_ptr, &objb); -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [objb.data_type]) -#endif - SLang_free_object (&objb); - return ret; -} - -/* The order of these is assumed to match the binary operators - * defined in slang.h - */ -static int -map_assignment_op_to_binary (unsigned char op_type, int *op, int *is_unary) -{ - *is_unary = 0; - switch (op_type) - { - case _SLANG_BCST_PLUSEQS: - case _SLANG_BCST_MINUSEQS: - case _SLANG_BCST_TIMESEQS: - case _SLANG_BCST_DIVEQS: - *op = SLANG_PLUS + (op_type - _SLANG_BCST_PLUSEQS); - break; - - case _SLANG_BCST_BOREQS: - *op = SLANG_BOR; - break; - - case _SLANG_BCST_BANDEQS: - *op = SLANG_BAND; - break; - - case _SLANG_BCST_POST_MINUSMINUS: - case _SLANG_BCST_MINUSMINUS: - *op = SLANG_MINUS; - *is_unary = 1; - break; - - case _SLANG_BCST_PLUSPLUS: - case _SLANG_BCST_POST_PLUSPLUS: - *op = SLANG_PLUS; - *is_unary = 1; - break; - - default: - SLang_verror (SL_NOT_IMPLEMENTED, "Assignment operator not implemented"); - return -1; - } - return 0; -} - -static int -perform_lvalue_operation (unsigned char op_type, SLang_Object_Type *obja_ptr) -{ - switch (op_type) - { - case _SLANG_BCST_ASSIGN: - break; - - /* The order of these is assumed to match the binary operators - * defined in slang.h - */ - case _SLANG_BCST_PLUSEQS: - case _SLANG_BCST_MINUSEQS: - case _SLANG_BCST_TIMESEQS: - case _SLANG_BCST_DIVEQS: - if (-1 == do_assignment_binary (SLANG_PLUS + (op_type - _SLANG_BCST_PLUSEQS), obja_ptr)) - return -1; - break; - - case _SLANG_BCST_BOREQS: - if (-1 == do_assignment_binary (SLANG_BOR, obja_ptr)) - return -1; - break; - - case _SLANG_BCST_BANDEQS: - if (-1 == do_assignment_binary (SLANG_BAND, obja_ptr)) - return -1; - break; - - case _SLANG_BCST_PLUSPLUS: - case _SLANG_BCST_POST_PLUSPLUS: -#if _SLANG_OPTIMIZE_FOR_SPEED - if (obja_ptr->data_type == SLANG_INT_TYPE) - return SLclass_push_int_obj (SLANG_INT_TYPE, obja_ptr->v.int_val + 1); -#endif - if (-1 == do_unary_op (SLANG_PLUSPLUS, obja_ptr, _SLANG_BC_UNARY)) - return -1; - break; - - case _SLANG_BCST_MINUSMINUS: - case _SLANG_BCST_POST_MINUSMINUS: -#if _SLANG_OPTIMIZE_FOR_SPEED - if (obja_ptr->data_type == SLANG_INT_TYPE) - return SLclass_push_int_obj (SLANG_INT_TYPE, obja_ptr->v.int_val - 1); -#endif - if (-1 == do_unary_op (SLANG_MINUSMINUS, obja_ptr, _SLANG_BC_UNARY)) - return -1; - break; - - default: - SLang_Error = SL_INTERNAL_ERROR; - return -1; - } - return 0; -} - -_INLINE_ -static int -set_lvalue_obj (unsigned char op_type, SLang_Object_Type *obja_ptr) -{ - if (op_type != _SLANG_BCST_ASSIGN) - { - if (-1 == perform_lvalue_operation (op_type, obja_ptr)) - return -1; - } -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [obja_ptr->data_type]) -#endif - SLang_free_object (obja_ptr); - - return SLang_pop(obja_ptr); -} - -static int -set_struct_lvalue (SLBlock_Type *bc_blk) -{ - int type; - SLang_Class_Type *cl; - char *name; - int op; - - if (-1 == (type = SLang_peek_at_stack ())) - return -1; - - cl = _SLclass_get_class (type); - if ((cl->cl_sput == NULL) - || (cl->cl_sget == NULL)) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "%s does not support structure access", - cl->cl_name); - SLdo_pop_n (2); /* object plus what was to be assigned */ - return -1; - } - name = bc_blk->b.s_blk; - op = bc_blk->bc_sub_type; - - if (op != _SLANG_BCST_ASSIGN) - { - /* We have something like (A.x += b) or (A.x++). In either case, - * we need A.x. - */ - SLang_Object_Type obj_A; - SLang_Object_Type obj; - - if (-1 == SLang_pop (&obj_A)) - return -1; - - if ((-1 == _SLpush_slang_obj (&obj_A)) - || (-1 == cl->cl_sget ((unsigned char) type, name)) - || (-1 == SLang_pop (&obj))) - { - SLang_free_object (&obj_A); - return -1; - } - /* Now the value of A.x is in obj. */ - if (-1 == perform_lvalue_operation (op, &obj)) - { - SLang_free_object (&obj); - SLang_free_object (&obj_A); - return -1; - } - SLang_free_object (&obj); - /* The result of the operation is now on the stack. - * Perform assignment */ - if (-1 == SLang_push (&obj_A)) - { - SLang_free_object (&obj_A); - return -1; - } - } - - return (*cl->cl_sput) ((unsigned char) type, name); -} - -static int make_unit_object (SLang_Object_Type *a, SLang_Object_Type *u) -{ - unsigned char type; - - type = a->data_type; - if (type == SLANG_ARRAY_TYPE) - type = a->v.array_val->data_type; - - u->data_type = type; - switch (type) - { - case SLANG_UCHAR_TYPE: - case SLANG_CHAR_TYPE: - u->v.char_val = 1; - break; - - case SLANG_SHORT_TYPE: - case SLANG_USHORT_TYPE: - u->v.short_val = 1; - break; - - case SLANG_LONG_TYPE: - case SLANG_ULONG_TYPE: - u->v.long_val = 1; - break; - -#if SLANG_HAS_FLOAT - case SLANG_FLOAT_TYPE: - u->v.float_val = 1; - break; - - case SLANG_COMPLEX_TYPE: - u->data_type = SLANG_DOUBLE_TYPE; - case SLANG_DOUBLE_TYPE: - u->v.double_val = 1; - break; -#endif - default: - u->data_type = SLANG_INT_TYPE; - u->v.int_val = 1; - } - return 0; -} - - -/* We want to convert 'A[i] op X' to 'A[i] = A[i] op X'. The code that - * has been generated is: X __args i A __aput-op - * where __aput-op represents this function. We need to generate: - * __args i A __eargs __aget X op __args i A __eargs __aput - * Here, __eargs implies a call to do_bc_call_direct_frame with either - * the aput or aget function. In addition, __args represents a call to - * SLang_start_arg_list. Of course, i represents a set of indices. - * - * Note: If op is an unary operation (e.g., ++ or --), then X will not - * b present an will have to be taken to be 1. - * - * Implementation note: For efficiency, calls to setup the frame, start - * arg list will be omitted and SLang_Num_Function_Args will be set. - * This is ugly but the alternative is much less efficient rendering these - * assignment operators useless. So, the plan is to roll the stack to get X, - * then duplicate the next N values, call __aget followed by op X, finally - * calling __aput. Hence, the sequence is: - * - * start: X i .. j A - * dupN: X i .. j A i .. j A - * __aget: X i .. j A Y - * roll: i .. j A Y X - * op: i .. j A Z - * roll: Z i .. j A - * __aput: - */ -static int -set_array_lvalue (int op) -{ - SLang_Object_Type x, y; - int num_args, is_unary; - - if (-1 == map_assignment_op_to_binary (op, &op, &is_unary)) - return -1; - - /* Grab the indices and the array. Do not start a new frame. */ - if (-1 == SLang_end_arg_list ()) - return -1; - num_args = Next_Function_Num_Args; - Next_Function_Num_Args = 0; - - if (-1 == SLdup_n (num_args)) - return -1; - - SLang_Num_Function_Args = num_args; - if (-1 == _SLarray_aget ()) - return -1; - - if (-1 == SLang_pop (&y)) - return -1; - - if (is_unary == 0) - { - if ((-1 == SLroll_stack (-(num_args + 1))) - || (-1 == SLang_pop (&x))) - { - SLang_free_object (&y); - return -1; - } - } - else if (-1 == make_unit_object (&y, &x)) - { - SLang_free_object (&y); - return -1; - } - - if (-1 == do_binary_ab (op, &y, &x)) - { - SLang_free_object (&y); - SLang_free_object (&x); - return -1; - } -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [y.data_type]) -#endif - SLang_free_object (&y); - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [x.data_type]) -#endif - SLang_free_object (&x); - - if (-1 == SLroll_stack (num_args + 1)) - return -1; - - SLang_Num_Function_Args = num_args; - return _SLarray_aput (); -} - - -static int -set_intrin_lvalue (SLBlock_Type *bc_blk) -{ - unsigned char op_type; - SLang_Object_Type obja; - SLang_Class_Type *cl; - SLang_Intrin_Var_Type *ivar; - VOID_STAR intrinsic_addr; - unsigned char intrinsic_type; - - ivar = bc_blk->b.nt_ivar_blk; - - intrinsic_type = ivar->type; - intrinsic_addr = ivar->addr; - - op_type = bc_blk->bc_sub_type; - - cl = _SLclass_get_class (intrinsic_type); - - if (op_type != _SLANG_BCST_ASSIGN) - { - /* We want to get the current value into obja. This is the - * easiest way. - */ - if ((-1 == (*cl->cl_push) (intrinsic_type, intrinsic_addr)) - || (-1 == SLang_pop (&obja))) - return -1; - - (void) perform_lvalue_operation (op_type, &obja); - SLang_free_object (&obja); - - if (SLang_Error) - return -1; - } - - return (*cl->cl_pop) (intrinsic_type, intrinsic_addr); -} - -int _SLang_deref_assign (SLang_Ref_Type *ref) -{ - SLang_Object_Type *objp; - SLang_Name_Type *nt; - SLBlock_Type blk; - - if (ref->is_global == 0) - { - objp = ref->v.local_obj; - if (objp > Local_Variable_Frame) - { - SLang_verror (SL_UNDEFINED_NAME, "Local variable reference is out of scope"); - return -1; - } - return set_lvalue_obj (_SLANG_BCST_ASSIGN, objp); - } - - nt = ref->v.nt; - switch (nt->name_type) - { - case SLANG_GVARIABLE: - case SLANG_PVARIABLE: - if (-1 == set_lvalue_obj (_SLANG_BCST_ASSIGN, - &((SLang_Global_Var_Type *)nt)->obj)) - { - do_name_type_error (nt); - return -1; - } - break; - - case SLANG_IVARIABLE: - blk.b.nt_blk = nt; - blk.bc_sub_type = _SLANG_BCST_ASSIGN; - if (-1 == set_intrin_lvalue (&blk)) - { - do_name_type_error (nt); - return -1; - } - break; - - case SLANG_LVARIABLE: - SLang_Error = SL_INTERNAL_ERROR; - /* set_intrin_lvalue (&blk); */ - return -1; - - case SLANG_RVARIABLE: - default: - SLang_verror (SL_READONLY_ERROR, "deref assignment to %s not allowed", nt->name); - return -1; - } - - return 0; -} - -static void set_deref_lvalue (SLBlock_Type *bc_blk) -{ - SLang_Object_Type *objp; - SLang_Ref_Type *ref; - - switch (bc_blk->bc_sub_type) - { - case SLANG_LVARIABLE: - objp = (Local_Variable_Frame - bc_blk->b.i_blk); - break; - case SLANG_GVARIABLE: - case SLANG_PVARIABLE: - objp = &bc_blk->b.nt_gvar_blk->obj; - break; - default: - SLang_Error = SL_INTERNAL_ERROR; - return; - } - - if (-1 == _SLpush_slang_obj (objp)) - return; - - if (-1 == SLang_pop_ref (&ref)) - return; - (void) _SLang_deref_assign (ref); - SLang_free_ref (ref); -} - -static int push_struct_field (char *name) -{ - int type; - SLang_Class_Type *cl; - - if (-1 == (type = SLang_peek_at_stack ())) - return -1; - - cl = _SLclass_get_class ((unsigned char) type); - if (cl->cl_sget == NULL) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "%s does not permit structure access", - cl->cl_name); - SLdo_pop_n (2); - return -1; - } - - return (*cl->cl_sget) ((unsigned char) type, name); -} - -static void trace_dump (char *format, char *name, SLang_Object_Type *objs, int n, int dir) -{ - unsigned int len; - char prefix [52]; - - len = Trace_Mode - 1; - if (len + 2 >= sizeof (prefix)) - len = sizeof (prefix) - 2; - - SLMEMSET (prefix, ' ', len); - prefix[len] = 0; - - call_dump_routine (prefix); - call_dump_routine (format, name, n); - - if (n > 0) - { - prefix[len] = ' '; - len++; - prefix[len] = 0; - - _SLdump_objects (prefix, objs, n, dir); - } -} - -/* Pop a data item from the stack and return a pointer to it. - * Strings are not freed from stack so use another routine to do it. - */ -static VOID_STAR pop_pointer (SLang_Object_Type *obj, unsigned char type) -{ -#ifndef _SLANG_OPTIMIZE_FOR_SPEED - SLang_Class_Type *cl; -#endif - - SLang_Array_Type *at; - - /* Arrays are special. Allow scalars to automatically convert to arrays. - */ - if (type == SLANG_ARRAY_TYPE) - { - if (-1 == SLang_pop_array (&at, 1)) - return NULL; - obj->data_type = SLANG_ARRAY_TYPE; - return obj->v.ptr_val = (VOID_STAR) at; - } - - if (type == 0) - { - /* This happens when an intrinsic is declared without any information - * regarding parameter types. - */ - if (-1 == SLang_pop (obj)) - return NULL; - type = obj->data_type; - } - else if (-1 == _SLang_pop_object_of_type (type, obj, 0)) - return NULL; - -#if _SLANG_OPTIMIZE_FOR_SPEED - type = _SLclass_Class_Type [type]; -#else - type = _SLclass_get_class (type)->cl_class_type; -#endif - - if (type == SLANG_CLASS_TYPE_SCALAR) - return (VOID_STAR) &obj->v; - else if (type == SLANG_CLASS_TYPE_MMT) - return SLang_object_from_mmt (obj->v.ref); - else - return obj->v.ptr_val; -} - -/* This is ugly. Does anyone have a advice for a cleaner way of doing - * this?? - */ -typedef void (*VF0_Type)(void); -typedef void (*VF1_Type)(VOID_STAR); -typedef void (*VF2_Type)(VOID_STAR, VOID_STAR); -typedef void (*VF3_Type)(VOID_STAR, VOID_STAR, VOID_STAR); -typedef void (*VF4_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef void (*VF5_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef void (*VF6_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef void (*VF7_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef long (*LF0_Type)(void); -typedef long (*LF1_Type)(VOID_STAR); -typedef long (*LF2_Type)(VOID_STAR, VOID_STAR); -typedef long (*LF3_Type)(VOID_STAR, VOID_STAR, VOID_STAR); -typedef long (*LF4_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef long (*LF5_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef long (*LF6_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef long (*LF7_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -#if SLANG_HAS_FLOAT -typedef double (*FF0_Type)(void); -typedef double (*FF1_Type)(VOID_STAR); -typedef double (*FF2_Type)(VOID_STAR, VOID_STAR); -typedef double (*FF3_Type)(VOID_STAR, VOID_STAR, VOID_STAR); -typedef double (*FF4_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef double (*FF5_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef double (*FF6_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -typedef double (*FF7_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR); -#endif - -static int execute_intrinsic_fun (SLang_Intrin_Fun_Type *objf) -{ -#if SLANG_HAS_FLOAT - double xf; -#endif - VOID_STAR p[SLANG_MAX_INTRIN_ARGS]; - SLang_Object_Type objs[SLANG_MAX_INTRIN_ARGS]; - long ret; - unsigned char type; - unsigned int argc; - unsigned int i; - FVOID_STAR fptr; - unsigned char *arg_types; - int stk_depth; - - fptr = objf->i_fun; - argc = objf->num_args; - type = objf->return_type; - arg_types = objf->arg_types; - - if (argc > SLANG_MAX_INTRIN_ARGS) - { - SLang_verror(SL_APPLICATION_ERROR, - "Intrinsic function %s requires too many parameters", objf->name); - return -1; - } - - if (-1 == _SL_increment_frame_pointer ()) - return -1; - - stk_depth = -1; - if (Trace_Mode && (_SLang_Trace > 0)) - { - int nargs; - - stk_depth = _SLstack_depth (); - - nargs = SLang_Num_Function_Args; - if (nargs == 0) - nargs = (int)argc; - - stk_depth -= nargs; - - if (stk_depth >= 0) - trace_dump (">>%s (%d args)\n", - objf->name, - _SLStack_Pointer - nargs, - nargs, - 1); - } - - i = argc; - while (i != 0) - { - i--; - if (NULL == (p[i] = pop_pointer (objs + i, arg_types[i]))) - { - i++; - goto free_and_return; - } - } - - ret = 0; -#if SLANG_HAS_FLOAT - xf = 0.0; -#endif - - switch (argc) - { - case 0: - if (type == SLANG_VOID_TYPE) ((VF0_Type) fptr) (); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF0_Type) fptr)(); -#endif - else ret = ((LF0_Type) fptr)(); - break; - - case 1: - if (type == SLANG_VOID_TYPE) ((VF1_Type) fptr)(p[0]); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF1_Type) fptr)(p[0]); -#endif - else ret = ((LF1_Type) fptr)(p[0]); - break; - - case 2: - if (type == SLANG_VOID_TYPE) ((VF2_Type) fptr)(p[0], p[1]); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF2_Type) fptr)(p[0], p[1]); -#endif - else ret = ((LF2_Type) fptr)(p[0], p[1]); - break; - - case 3: - if (type == SLANG_VOID_TYPE) ((VF3_Type) fptr)(p[0], p[1], p[2]); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF3_Type) fptr)(p[0], p[1], p[2]); -#endif - else ret = ((LF3_Type) fptr)(p[0], p[1], p[2]); - break; - - case 4: - if (type == SLANG_VOID_TYPE) ((VF4_Type) fptr)(p[0], p[1], p[2], p[3]); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF4_Type) fptr)(p[0], p[1], p[2], p[3]); -#endif - else ret = ((LF4_Type) fptr)(p[0], p[1], p[2], p[3]); - break; - - case 5: - if (type == SLANG_VOID_TYPE) ((VF5_Type) fptr)(p[0], p[1], p[2], p[3], p[4]); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF5_Type) fptr)(p[0], p[1], p[2], p[3], p[4]); -#endif - else ret = ((LF5_Type) fptr)(p[0], p[1], p[2], p[3], p[4]); - break; - - case 6: - if (type == SLANG_VOID_TYPE) ((VF6_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5]); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF6_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5]); -#endif - else ret = ((LF6_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5]); - break; - - case 7: - if (type == SLANG_VOID_TYPE) ((VF7_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5], p[6]); -#if SLANG_HAS_FLOAT - else if (type == SLANG_DOUBLE_TYPE) xf = ((FF7_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5], p[6]); -#endif - else ret = ((LF7_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5], p[6]); - break; - } - - switch (type) - { - case SLANG_VOID_TYPE: - break; - -#if SLANG_HAS_FLOAT - case SLANG_DOUBLE_TYPE: - (void) SLang_push_double (xf); - break; -#endif - case SLANG_UINT_TYPE: - case SLANG_INT_TYPE: (void) SLclass_push_int_obj (type, (int) ret); - break; - - case SLANG_CHAR_TYPE: - case SLANG_UCHAR_TYPE: (void) SLclass_push_char_obj (type, (char) ret); - break; - - case SLANG_SHORT_TYPE: - case SLANG_USHORT_TYPE: (void) SLclass_push_short_obj (type, (short) ret); - break; - - case SLANG_LONG_TYPE: - case SLANG_ULONG_TYPE: (void) SLclass_push_long_obj (type, ret); - break; - - case SLANG_STRING_TYPE: - if (NULL == (char *)ret) - { - if (SLang_Error == 0) SLang_Error = SL_INTRINSIC_ERROR; - } - else (void) SLang_push_string ((char *)ret); - break; - - default: - SLang_verror (SL_NOT_IMPLEMENTED, - "Support for intrinsic functions returning %s is not provided", - SLclass_get_datatype_name (type)); - } - - if (stk_depth >= 0) - { - stk_depth = _SLstack_depth () - stk_depth; - - trace_dump ("<<%s (returning %d values)\n", - objf->name, - _SLStack_Pointer - stk_depth, - stk_depth, - 1); - } - - free_and_return: - while (i < argc) - { - SLang_free_object (objs + i); - i++; - } - - return _SL_decrement_frame_pointer (); -} - -static int inner_interp(register SLBlock_Type *); - -/* Switch_Obj_Ptr points to the NEXT available free switch object */ -static SLang_Object_Type Switch_Objects[SLANG_MAX_NESTED_SWITCH]; -static SLang_Object_Type *Switch_Obj_Ptr = Switch_Objects; -static SLang_Object_Type *Switch_Obj_Max = Switch_Objects + SLANG_MAX_NESTED_SWITCH; - -static void -lang_do_loops (unsigned char stype, SLBlock_Type *block, unsigned int num_blocks) -{ - int i, ctrl; - int first, last; - SLBlock_Type *blks[4]; - char *loop_name; - SLang_Foreach_Context_Type *foreach_context; - SLang_Class_Type *cl; - int type; - unsigned int j; - - j = 0; - for (i = 0; i < (int) num_blocks; i++) - { - if (block[i].bc_main_type != _SLANG_BC_BLOCK) - { - if (block[i].bc_main_type == _SLANG_BC_LINE_NUM) - continue; - - SLang_verror (SL_SYNTAX_ERROR, "Bytecode is not a looping block"); - return; - } - blks[j] = block[i].b.blk; - j++; - } - - num_blocks = j; - block = blks[0]; - - switch (stype) - { - case _SLANG_BCST_FOREACH: - loop_name = "foreach"; - if (num_blocks != 1) - goto wrong_num_blocks_error; - - /* We should find Next_Function_Num_Args + 1 items on the stack. - * The first Next_Function_Num_Args items represent the arguments to - * to USING. The last item (deepest in stack) is the object to loop - * over. So, roll the stack up and grab it. - */ - if ((-1 == SLroll_stack (-(Next_Function_Num_Args + 1))) - || (-1 == (type = SLang_peek_at_stack ()))) - goto return_error; - - cl = _SLclass_get_class ((unsigned char) type); - if ((cl->cl_foreach == NULL) - || (cl->cl_foreach_open == NULL) - || (cl->cl_foreach_close == NULL)) - { - SLang_verror (SL_NOT_IMPLEMENTED, "%s does not permit foreach", cl->cl_name); - SLdo_pop_n (Next_Function_Num_Args + 1); - goto return_error; - } - - if (NULL == (foreach_context = (*cl->cl_foreach_open) ((unsigned char)type, Next_Function_Num_Args))) - goto return_error; - - while (1) - { - int status; - - if (SLang_Error) - { - (*cl->cl_foreach_close) ((unsigned char) type, foreach_context); - goto return_error; - } - - status = (*cl->cl_foreach) ((unsigned char) type, foreach_context); - if (status <= 0) - { - if (status == 0) - break; - - (*cl->cl_foreach_close) ((unsigned char) type, foreach_context); - goto return_error; - } - - inner_interp (block); - if (Lang_Break) break; - Lang_Break_Condition = /* Lang_Continue = */ 0; - } - (*cl->cl_foreach_close) ((unsigned char) type, foreach_context); - break; - - case _SLANG_BCST_WHILE: - loop_name = "while"; - - if (num_blocks != 2) - goto wrong_num_blocks_error; - - type = blks[1]->bc_main_type; - while (1) - { - if (SLang_Error) - goto return_error; - - inner_interp (block); - if (Lang_Break) break; - - if (-1 == pop_ctrl_integer (&ctrl)) - goto return_error; - - if (ctrl == 0) break; - - if (type) - { - inner_interp (blks[1]); - if (Lang_Break) break; - Lang_Break_Condition = /* Lang_Continue = */ 0; - } - } - break; - - case _SLANG_BCST_DOWHILE: - loop_name = "do...while"; - - if (num_blocks != 2) - goto wrong_num_blocks_error; - - while (1) - { - if (SLang_Error) - goto return_error; - - Lang_Break_Condition = /* Lang_Continue = */ 0; - inner_interp (block); - if (Lang_Break) break; - Lang_Break_Condition = /* Lang_Continue = */ 0; - inner_interp (blks[1]); - if (-1 == pop_ctrl_integer (&ctrl)) - goto return_error; - - if (ctrl == 0) break; - } - break; - - case _SLANG_BCST_CFOR: - loop_name = "for"; - - /* we need 4 blocks: first 3 control, the last is code */ - if (num_blocks != 4) goto wrong_num_blocks_error; - - inner_interp (block); - while (1) - { - if (SLang_Error) - goto return_error; - - inner_interp(blks[1]); /* test */ - if (-1 == pop_ctrl_integer (&ctrl)) - goto return_error; - - if (ctrl == 0) break; - inner_interp(blks[3]); /* code */ - if (Lang_Break) break; - inner_interp(blks[2]); /* bump */ - Lang_Break_Condition = /* Lang_Continue = */ 0; - } - break; - - case _SLANG_BCST_FOR: - loop_name = "_for"; - - if (num_blocks != 1) - goto wrong_num_blocks_error; - - /* 3 elements: first, last, step */ - if ((-1 == SLang_pop_integer (&ctrl)) - || (-1 == SLang_pop_integer (&last)) - || (-1 == SLang_pop_integer (&first))) - goto return_error; - - i = first; - while (1) - { - /* It is ugly to have this test here but I do not know of a - * simple way to do this without using two while loops. - */ - if (ctrl >= 0) - { - if (i > last) break; - } - else if (i < last) break; - - if (SLang_Error) goto return_error; - - SLclass_push_int_obj (SLANG_INT_TYPE, i); - inner_interp (block); - if (Lang_Break) break; - Lang_Break_Condition = /* Lang_Continue = */ 0; - - i += ctrl; - } - break; - - case _SLANG_BCST_LOOP: - loop_name = "loop"; - if (num_blocks != 1) - goto wrong_num_blocks_error; - - if (-1 == SLang_pop_integer (&ctrl)) - goto return_error; - while (ctrl > 0) - { - ctrl--; - - if (SLang_Error) - goto return_error; - - inner_interp (block); - if (Lang_Break) break; - Lang_Break_Condition = /* Lang_Continue = */ 0; - } - break; - - case _SLANG_BCST_FOREVER: - loop_name = "forever"; - - if (num_blocks != 1) - goto wrong_num_blocks_error; - - while (1) - { - if (SLang_Error) - goto return_error; - - inner_interp (block); - if (Lang_Break) break; - Lang_Break_Condition = /* Lang_Continue = */ 0; - } - break; - - default: SLang_verror(SL_INTERNAL_ERROR, "Unknown loop type"); - return; - } - Lang_Break = /* Lang_Continue = */ 0; - Lang_Break_Condition = Lang_Return; - return; - - wrong_num_blocks_error: - SLang_verror (SL_SYNTAX_ERROR, "Wrong number of blocks for '%s' construct", loop_name); - - /* drop */ - return_error: - do_traceback (loop_name, 0, NULL); -} - -static void lang_do_and_orelse (unsigned char stype, SLBlock_Type *addr, SLBlock_Type *addr_max) -{ - int test = 0; - int is_or; - - is_or = (stype == _SLANG_BCST_ORELSE); - - while (addr <= addr_max) - { - if (addr->bc_main_type == _SLANG_BC_LINE_NUM) - { - addr++; - continue; - } - - inner_interp (addr->b.blk); - if (SLang_Error - || Lang_Break_Condition - || (-1 == pop_ctrl_integer (&test))) - return; - - if (is_or == (test != 0)) - break; - - /* if (((stype == _SLANG_BCST_ANDELSE) && (test == 0)) - * || ((stype == _SLANG_BCST_ORELSE) && test)) - * break; - */ - - addr++; - } - SLclass_push_int_obj (SLANG_INT_TYPE, test); -} - -static void do_else_if (SLBlock_Type *zero_block, SLBlock_Type *non_zero_block) -{ - int test; - - if (-1 == pop_ctrl_integer (&test)) - return; - - if (test == 0) - non_zero_block = zero_block; - - if (non_zero_block != NULL) - inner_interp (non_zero_block->b.blk); -} - -int _SLang_trace_fun (char *f) -{ - if (NULL == (f = SLang_create_slstring (f))) - return -1; - - SLang_free_slstring (Trace_Function); - Trace_Function = f; - _SLang_Trace = 1; - return 0; -} - -int _SLdump_objects (char *prefix, SLang_Object_Type *x, unsigned int n, int dir) -{ - char *s; - SLang_Class_Type *cl; - - while (n) - { - cl = _SLclass_get_class (x->data_type); - - if (NULL == (s = _SLstringize_object (x))) - s = "??"; - - call_dump_routine ("%s[%s]:%s\n", prefix, cl->cl_name, s); - - SLang_free_slstring (s); - - x += dir; - n--; - } - return 0; -} - -static SLBlock_Type *Exit_Block_Ptr; -static SLBlock_Type *Global_User_Block[5]; -static SLBlock_Type **User_Block_Ptr = Global_User_Block; -char *_SLang_Current_Function_Name = NULL; - -static int execute_slang_fun (_SLang_Function_Type *fun) -{ - register unsigned int i; - register SLang_Object_Type *frame, *lvf; - register unsigned int n_locals; - _SLBlock_Header_Type *header; - /* SLBlock_Type *val; */ - SLBlock_Type *exit_block_save; - SLBlock_Type **user_block_save; - SLBlock_Type *user_blocks[5]; - char *save_fname; - - exit_block_save = Exit_Block_Ptr; - user_block_save = User_Block_Ptr; - User_Block_Ptr = user_blocks; - *(user_blocks) = NULL; - *(user_blocks + 1) = NULL; - *(user_blocks + 2) = NULL; - *(user_blocks + 3) = NULL; - *(user_blocks + 4) = NULL; - - Exit_Block_Ptr = NULL; - - save_fname = _SLang_Current_Function_Name; - _SLang_Current_Function_Name = fun->name; - - _SL_increment_frame_pointer (); - - /* need loaded? */ - if (fun->nlocals == AUTOLOAD_NUM_LOCALS) - { - header = NULL; - if (-1 == SLang_load_file(fun->v.autoload_filename)) - goto the_return; - - if (fun->nlocals == AUTOLOAD_NUM_LOCALS) - { - SLang_verror (SL_UNDEFINED_NAME, "%s: Function did not autoload", - _SLang_Current_Function_Name); - goto the_return; - } - } - - n_locals = fun->nlocals; - - /* let the error propagate through since it will do no harm - and allow us to restore stack. */ - - /* set new stack frame */ - lvf = frame = Local_Variable_Frame; - i = n_locals; - if ((lvf + i) > Local_Variable_Stack + SLANG_MAX_LOCAL_STACK) - { - SLang_verror(SL_STACK_OVERFLOW, "%s: Local Variable Stack Overflow", - _SLang_Current_Function_Name); - goto the_return; - } - - /* Make sure we do not allow this header to get destroyed by something - * like: define crash () { eval ("define crash ();") } - */ - header = fun->v.header; - header->num_refs++; - - while (i--) - { - lvf++; - lvf->data_type = SLANG_UNDEFINED_TYPE; - } - Local_Variable_Frame = lvf; - - /* read values of function arguments */ - i = fun->nargs; - while (i > 0) - { - i--; - (void) SLang_pop (Local_Variable_Frame - i); - } - - if (SLang_Enter_Function != NULL) (*SLang_Enter_Function)(_SLang_Current_Function_Name); - - if (_SLang_Trace) - { - int stack_depth; - - stack_depth = _SLstack_depth (); - - if ((Trace_Function != NULL) - && (0 == strcmp (Trace_Function, _SLang_Current_Function_Name)) - && (Trace_Mode == 0)) - Trace_Mode = 1; - - if (Trace_Mode) - { - /* The local variable frame grows backwards */ - trace_dump (">>%s (%d args)\n", - _SLang_Current_Function_Name, - Local_Variable_Frame, - (int) fun->nargs, - -1); - Trace_Mode++; - } - - inner_interp (header->body); - Lang_Break_Condition = Lang_Return = Lang_Break = 0; - if (Exit_Block_Ptr != NULL) inner_interp(Exit_Block_Ptr); - - if (Trace_Mode) - { - Trace_Mode--; - stack_depth = _SLstack_depth () - stack_depth; - - trace_dump ("<<%s (returning %d values)\n", - _SLang_Current_Function_Name, - _SLStack_Pointer - stack_depth, - stack_depth, - 1); - - if (Trace_Mode == 1) - Trace_Mode = 0; - } - } - else - { - inner_interp (header->body); - Lang_Break_Condition = Lang_Return = Lang_Break = 0; - if (Exit_Block_Ptr != NULL) inner_interp(Exit_Block_Ptr); - } - - if (SLang_Exit_Function != NULL) (*SLang_Exit_Function)(_SLang_Current_Function_Name); - - if (SLang_Error) - do_traceback(fun->name, n_locals, -#if _SLANG_HAS_DEBUG_CODE - fun->file -#else - NULL -#endif - ); - - /* free local variables.... */ - lvf = Local_Variable_Frame; - while (lvf > frame) - { -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [lvf->data_type]) -#endif - SLang_free_object (lvf); - lvf--; - } - Local_Variable_Frame = lvf; - - if (header->num_refs == 1) - free_function_header (header); - else - header->num_refs--; - - the_return: - - Lang_Break_Condition = Lang_Return = Lang_Break = 0; - Exit_Block_Ptr = exit_block_save; - User_Block_Ptr = user_block_save; - _SLang_Current_Function_Name = save_fname; - _SL_decrement_frame_pointer (); - - if (SLang_Error) - return -1; - - return 0; -} - -static void do_traceback (char *name, unsigned int locals, char *file) -{ - char *s; - unsigned int i; - SLang_Object_Type *objp; - unsigned short stype; - - /* FIXME: Priority=low - * I need to make this configurable!!! That is, let the - * application decide whether or not a usage error should result in a - * traceback. - */ - if (SLang_Error == SL_USAGE_ERROR) - return; - - if (SLang_Traceback == 0) - return; - - call_dump_routine ("S-Lang Traceback: %s\n", name); - if (SLang_Traceback < 0) - return; - - if (file != NULL) - call_dump_routine ("File: %s\n", file); - - if (locals == 0) - return; - - call_dump_routine (" Local Variables:\n"); - - for (i = 0; i < locals; i++) - { - SLang_Class_Type *cl; - char *class_name; - - objp = Local_Variable_Frame - i; - stype = objp->data_type; - - s = _SLstringize_object (objp); - cl = _SLclass_get_class (stype); - class_name = cl->cl_name; - - call_dump_routine ("\t$%d: Type: %s,\tValue:\t", i, class_name); - - if (s == NULL) call_dump_routine("??\n"); - else - { - char *q = ""; -#ifndef HAVE_VSNPRINTF - char buf[256]; - if (strlen (s) >= sizeof (buf)) - { - strncpy (buf, s, sizeof(buf)); - s = buf; - s[sizeof(buf) - 1] = 0; - } -#endif - if (SLANG_STRING_TYPE == stype) q = "\""; - call_dump_routine ("%s%s%s\n", q, s, q); - } - } -} - -static void do_app_unary (SLang_App_Unary_Type *nt) -{ - if (-1 == do_unary (nt->unary_op, nt->name_type)) - do_traceback (nt->name, 0, NULL); -} - -static int inner_interp_nametype (SLang_Name_Type *nt) -{ - SLBlock_Type bc_blks[2]; - - bc_blks[0].b.nt_blk = nt; - bc_blks[0].bc_main_type = nt->name_type; - bc_blks[1].bc_main_type = 0; - return inner_interp(bc_blks); -} - -int _SLang_dereference_ref (SLang_Ref_Type *ref) -{ - if (ref == NULL) - { - SLang_Error = SL_INTERNAL_ERROR; - return -1; - } - - if (ref->is_global == 0) - { - SLang_Object_Type *obj = ref->v.local_obj; - if (obj > Local_Variable_Frame) - { - SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope"); - return -1; - } - return _SLpush_slang_obj (ref->v.local_obj); - } - - (void) inner_interp_nametype (ref->v.nt); - return 0; -} - -int _SLang_is_ref_initialized (SLang_Ref_Type *ref) -{ - unsigned char type; - - if (ref == NULL) - { - SLang_Error = SL_INTERNAL_ERROR; - return -1; - } - - if (ref->is_global == 0) - { - SLang_Object_Type *obj = ref->v.local_obj; - if (obj > Local_Variable_Frame) - { - SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope"); - return -1; - } - type = ref->v.local_obj->data_type; - } - else - { - SLang_Name_Type *nt = ref->v.nt; - if ((nt->name_type != SLANG_GVARIABLE) - && (nt->name_type != SLANG_PVARIABLE)) - return 1; - type = ((SLang_Global_Var_Type *)nt)->obj.data_type; - } - return type != SLANG_UNDEFINED_TYPE; -} - -int _SLang_uninitialize_ref (SLang_Ref_Type *ref) -{ - SLang_Object_Type *obj; - - if (ref == NULL) - { - SLang_Error = SL_INTERNAL_ERROR; - return -1; - } - - if (ref->is_global == 0) - { - obj = ref->v.local_obj; - if (obj > Local_Variable_Frame) - { - SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope"); - return -1; - } - obj = ref->v.local_obj; - } - else - { - SLang_Name_Type *nt = ref->v.nt; - if ((nt->name_type != SLANG_GVARIABLE) - && (nt->name_type != SLANG_PVARIABLE)) - return -1; - obj = &((SLang_Global_Var_Type *)nt)->obj; - } - SLang_free_object (obj); - obj->data_type = SLANG_UNDEFINED_TYPE; - obj->v.ptr_val = NULL; - return 0; -} - -void (*SLang_Interrupt)(void); -static int Last_Error; -void (*SLang_User_Clear_Error)(void); -void _SLang_clear_error (void) -{ - if (Last_Error <= 0) - { - Last_Error = 0; - return; - } - Last_Error--; - if (SLang_User_Clear_Error != NULL) (*SLang_User_Clear_Error)(); -} - -int _SLpush_slang_obj (SLang_Object_Type *obj) -{ - unsigned char subtype; - SLang_Class_Type *cl; - - if (obj == NULL) return SLang_push_null (); - - subtype = obj->data_type; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type[subtype]) - return SLang_push (obj); -#endif - - cl = _SLclass_get_class (subtype); - return (*cl->cl_push) (subtype, (VOID_STAR) &obj->v); -} - -_INLINE_ -static int push_local_variable (int i) -{ - SLang_Class_Type *cl; - SLang_Object_Type *obj; - unsigned char subtype; - - obj = Local_Variable_Frame - i; - subtype = obj->data_type; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type[subtype]) - return SLang_push (obj); - if (subtype == SLANG_STRING_TYPE) - return _SLang_dup_and_push_slstring (obj->v.s_val); -#endif - - cl = _SLclass_get_class (subtype); - return (*cl->cl_push) (subtype, (VOID_STAR) &obj->v); -} - -static int push_intrinsic_variable (SLang_Intrin_Var_Type *ivar) -{ - SLang_Class_Type *cl; - unsigned char stype; - - stype = ivar->type; - cl = _SLclass_get_class (stype); - - if (-1 == (*cl->cl_push_intrinsic) (stype, ivar->addr)) - { - do_name_type_error ((SLang_Name_Type *) ivar); - return -1; - } - return 0; -} - -static int dereference_object (void) -{ - SLang_Object_Type obj; - SLang_Class_Type *cl; - unsigned char type; - int ret; - - if (-1 == SLang_pop (&obj)) - return -1; - - type = obj.data_type; - - cl = _SLclass_get_class (type); - ret = (*cl->cl_dereference)(type, (VOID_STAR) &obj.v); - - SLang_free_object (&obj); - return ret; -} - -static int case_function (void) -{ - unsigned char type; - SLang_Object_Type obj; - SLang_Object_Type *swobjptr; - - swobjptr = Switch_Obj_Ptr - 1; - - if ((swobjptr < Switch_Objects) - || (0 == (type = swobjptr->data_type))) - { - SLang_verror (SL_SYNTAX_ERROR, "Misplaced 'case' keyword"); - return -1; - } - - if (-1 == SLang_pop (&obj)) - return -1; - - if (obj.data_type != type) - { - SLang_Class_Type *a_cl, *b_cl; - - a_cl = _SLclass_get_class (obj.data_type); - b_cl = _SLclass_get_class (type); - - if (NULL == _SLclass_get_binary_fun (SLANG_EQ, a_cl, b_cl, &a_cl, 0)) - { - (void) SLclass_push_int_obj (SLANG_INT_TYPE, 0); - SLang_free_object (&obj); - return 0; - } - } - - (void) do_binary_ab (SLANG_EQ, swobjptr, &obj); - SLang_free_object (&obj); - return 0; -} - -static void tmp_variable_function (SLBlock_Type *addr) -{ - SLang_Object_Type *obj; - - switch (addr->bc_sub_type) - { - case SLANG_GVARIABLE: - case SLANG_PVARIABLE: - obj = &addr->b.nt_gvar_blk->obj; - break; - - case SLANG_LVARIABLE: - obj = Local_Variable_Frame - addr->b.i_blk; - break; - - default: - SLang_Error = SL_INTERNAL_ERROR; - return; - } - - /* There is no need to go through higher level routines since we are - * not creating or destroying extra copies. - */ - if (-1 == SLang_push (obj)) - return; - - obj->data_type = SLANG_UNDEFINED_TYPE; - obj->v.ptr_val = NULL; -} - - -static int -do_inner_interp_error (SLBlock_Type *err_block, - SLBlock_Type *addr_start, - SLBlock_Type *addr) -{ - int save_err, slerr; - - /* Someday I can use the these variable to provide extra information - * about what went wrong. - */ - (void) addr_start; - (void) addr; - - if (err_block == NULL) - goto return_error; - - if (SLang_Error < 0) /* errors less than 0 are severe */ - goto return_error; - - save_err = Last_Error++; - slerr = SLang_Error; - SLang_Error = 0; - inner_interp (err_block->b.blk); - - if (Last_Error <= save_err) - { - /* Caught error and cleared it */ - Last_Error = save_err; - if ((Lang_Break_Condition == 0) - /* An error may have cleared the error and then caused the - * function to return. We will allow that but let's not allow - * 'break' nor 'continue' statements until later. - */ - || Lang_Return) - return 0; - - /* drop--- either a break or continue was called */ - } - - Last_Error = save_err; - SLang_Error = slerr; - - return_error: -#if _SLANG_HAS_DEBUG_CODE - while (addr >= addr_start) - { - if (addr->bc_main_type == _SLANG_BC_LINE_NUM) - { - char buf[256]; - sprintf (buf, "(Error occurred on line %lu)", addr->b.l_blk); - do_traceback (buf, 0, NULL); - break; - } - /* Special hack for 16 bit systems to prevent pointer wrapping. */ -#if defined(__16_BIT_SYSTEM__) - if (addr == addr_start) - break; -#endif - addr--; - } -#endif - return -1; -} - - -#define GATHER_STATISTICS 0 -#if GATHER_STATISTICS -static unsigned int Bytecodes[0xFFFF]; - -static void print_stats (void) -{ - unsigned int i; - unsigned long total; - FILE *fp = fopen ("stats.txt", "w"); - if (fp == NULL) - return; - - total = 0; - for (i = 0; i < 0xFFFF; i++) - total += Bytecodes[i]; - - if (total == 0) - total = 1; - - for (i = 0; i < 0xFFFF; i++) - { - if (Bytecodes[i]) - fprintf (fp, "0x%04X %9u %e\n", i, Bytecodes[i], Bytecodes[i]/(double) total); - } - fclose (fp); -} - -static void add_to_statistics (SLBlock_Type *b) -{ - unsigned short x, y; - - x = b->bc_main_type; - if (x == 0) - { - Bytecodes[0] += 1; - return; - } - b++; - y = b->bc_main_type; - - Bytecodes[(x << 8) | y] += 1; -} - -#endif - -/* inner interpreter */ -/* The return value from this function is only meaningful when it is used - * to process blocks for the switch statement. If it returns 0, the calling - * routine should pass the next block to it. Otherwise it will - * return non-zero, with or without error. - */ -static int inner_interp (SLBlock_Type *addr_start) -{ - SLBlock_Type *block, *err_block, *addr; -#if GATHER_STATISTICS - static int inited = 0; - - if (inited == 0) - { - (void) SLang_add_cleanup_function (print_stats); - inited = 1; - } -#endif - - /* for systems that have no real interrupt facility (e.g. go32 on dos) */ - if (SLang_Interrupt != NULL) (*SLang_Interrupt)(); - - block = err_block = NULL; - addr = addr_start; - -#if GATHER_STATISTICS - add_to_statistics (addr); -#endif - while (1) - { - switch (addr->bc_main_type) - { - case 0: - return 1; - case _SLANG_BC_LVARIABLE: - push_local_variable (addr->b.i_blk); - break; - case _SLANG_BC_GVARIABLE: - if (-1 == _SLpush_slang_obj (&addr->b.nt_gvar_blk->obj)) - do_name_type_error (addr->b.nt_blk); - break; - - case _SLANG_BC_IVARIABLE: - case _SLANG_BC_RVARIABLE: - push_intrinsic_variable (addr->b.nt_ivar_blk); - break; - - case _SLANG_BC_INTRINSIC: - execute_intrinsic_fun (addr->b.nt_ifun_blk); - if (SLang_Error) - do_traceback(addr->b.nt_ifun_blk->name, 0, NULL); - break; - - case _SLANG_BC_FUNCTION: - execute_slang_fun (addr->b.nt_fun_blk); - if (Lang_Break_Condition) goto handle_break_condition; - break; - - case _SLANG_BC_MATH_UNARY: - case _SLANG_BC_APP_UNARY: - /* Make sure we treat these like function calls since the - * parser took sin(x) to be a function call. - */ - if (0 == _SL_increment_frame_pointer ()) - { - do_app_unary (addr->b.nt_unary_blk); - (void) _SL_decrement_frame_pointer (); - } - break; - - case _SLANG_BC_ICONST: - SLclass_push_int_obj (SLANG_INT_TYPE, addr->b.iconst_blk->i); - break; - -#if SLANG_HAS_FLOAT - case _SLANG_BC_DCONST: - SLang_push_double (addr->b.dconst_blk->d); - break; -#endif - - case _SLANG_BC_PVARIABLE: - if (-1 == _SLpush_slang_obj (&addr->b.nt_gvar_blk->obj)) - do_name_type_error (addr->b.nt_blk); - break; - - case _SLANG_BC_PFUNCTION: - execute_slang_fun (addr->b.nt_fun_blk); - if (Lang_Break_Condition) goto handle_break_condition; - break; - - case _SLANG_BC_BINARY: - do_binary (addr->b.i_blk); - break; - - case _SLANG_BC_LITERAL: -#if !_SLANG_OPTIMIZE_FOR_SPEED - case _SLANG_BC_LITERAL_INT: - case _SLANG_BC_LITERAL_STR: -#endif - { - SLang_Class_Type *cl = _SLclass_get_class (addr->bc_sub_type); - (*cl->cl_push_literal) (addr->bc_sub_type, (VOID_STAR) &addr->b.ptr_blk); - } - break; -#if _SLANG_OPTIMIZE_FOR_SPEED - case _SLANG_BC_LITERAL_INT: - SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk); - break; - - case _SLANG_BC_LITERAL_STR: - _SLang_dup_and_push_slstring (addr->b.s_blk); - break; -#endif - case _SLANG_BC_BLOCK: - switch (addr->bc_sub_type) - { - case _SLANG_BCST_ERROR_BLOCK: - err_block = addr; - break; - - case _SLANG_BCST_EXIT_BLOCK: - Exit_Block_Ptr = addr->b.blk; - break; - - case _SLANG_BCST_USER_BLOCK0: - case _SLANG_BCST_USER_BLOCK1: - case _SLANG_BCST_USER_BLOCK2: - case _SLANG_BCST_USER_BLOCK3: - case _SLANG_BCST_USER_BLOCK4: - User_Block_Ptr[addr->bc_sub_type - _SLANG_BCST_USER_BLOCK0] = addr->b.blk; - break; - - case _SLANG_BCST_LOOP: - case _SLANG_BCST_WHILE: - case _SLANG_BCST_FOR: - case _SLANG_BCST_FOREVER: - case _SLANG_BCST_CFOR: - case _SLANG_BCST_DOWHILE: - case _SLANG_BCST_FOREACH: - if (block == NULL) block = addr; - lang_do_loops(addr->bc_sub_type, block, 1 + (unsigned int) (addr - block)); - block = NULL; - break; - - case _SLANG_BCST_IFNOT: -#if _SLANG_OPTIMIZE_FOR_SPEED - { - int i; - - if ((0 == pop_ctrl_integer (&i)) && (i == 0)) - inner_interp (addr->b.blk); - } -#else - do_else_if (addr, NULL); -#endif - break; - - case _SLANG_BCST_IF: -#if _SLANG_OPTIMIZE_FOR_SPEED - { - int i; - - if ((0 == pop_ctrl_integer (&i)) && i) - inner_interp (addr->b.blk); - } -#else - do_else_if (NULL, addr); -#endif - break; - - case _SLANG_BCST_NOTELSE: - do_else_if (block, addr); - block = NULL; - break; - - case _SLANG_BCST_ELSE: - do_else_if (addr, block); - block = NULL; - break; - - case _SLANG_BCST_SWITCH: - if (Switch_Obj_Ptr == Switch_Obj_Max) - { - SLang_doerror("switch nesting too deep"); - break; - } - (void) SLang_pop (Switch_Obj_Ptr); - Switch_Obj_Ptr++; - - if (block == NULL) block = addr; - while ((SLang_Error == 0) - && (block <= addr) - && (Lang_Break_Condition == 0) - && (0 == inner_interp (block->b.blk))) - block++; - Switch_Obj_Ptr--; - SLang_free_object (Switch_Obj_Ptr); - Switch_Obj_Ptr->data_type = 0; - block = NULL; - break; - - case _SLANG_BCST_ANDELSE: - case _SLANG_BCST_ORELSE: - if (block == NULL) block = addr; - lang_do_and_orelse (addr->bc_sub_type, block, addr); - block = NULL; - break; - - default: - if (block == NULL) block = addr; - break; - } - if (Lang_Break_Condition) goto handle_break_condition; - break; - - case _SLANG_BC_RETURN: - Lang_Break_Condition = Lang_Return = Lang_Break = 1; return 1; - case _SLANG_BC_BREAK: - Lang_Break_Condition = Lang_Break = 1; return 1; - case _SLANG_BC_CONTINUE: - Lang_Break_Condition = /* Lang_Continue = */ 1; return 1; - - case _SLANG_BC_EXCH: - (void) SLreverse_stack (2); - break; - - case _SLANG_BC_LABEL: - { - int test; - if ((0 == SLang_pop_integer (&test)) - && (test == 0)) - return 0; - } - break; - - case _SLANG_BC_LOBJPTR: - (void)_SLang_push_ref (0, (VOID_STAR)(Local_Variable_Frame - addr->b.i_blk)); - break; - - case _SLANG_BC_GOBJPTR: - (void)_SLang_push_ref (1, (VOID_STAR)addr->b.nt_blk); - break; - - case _SLANG_BC_X_ERROR: - if (err_block != NULL) - { - inner_interp(err_block->b.blk); - if (SLang_Error) err_block = NULL; - } - else SLang_verror(SL_SYNTAX_ERROR, "No ERROR_BLOCK"); - if (Lang_Break_Condition) goto handle_break_condition; - break; - - case _SLANG_BC_X_USER0: - case _SLANG_BC_X_USER1: - case _SLANG_BC_X_USER2: - case _SLANG_BC_X_USER3: - case _SLANG_BC_X_USER4: - if (User_Block_Ptr[addr->bc_main_type - _SLANG_BC_X_USER0] != NULL) - { - inner_interp(User_Block_Ptr[addr->bc_main_type - _SLANG_BC_X_USER0]); - } - else SLang_verror(SL_SYNTAX_ERROR, "No block for X_USERBLOCK"); - if (Lang_Break_Condition) goto handle_break_condition; - break; - - case _SLANG_BC_CALL_DIRECT: - (*addr->b.call_function) (); - break; - - case _SLANG_BC_CALL_DIRECT_FRAME: - do_bc_call_direct_frame (addr->b.call_function); - break; - - case _SLANG_BC_UNARY: - do_unary (addr->b.i_blk, _SLANG_BC_UNARY); - break; - - case _SLANG_BC_UNARY_FUNC: - /* Make sure we treat these like function calls since the - * parser took abs(x) to be a function call. - */ - if (0 == _SL_increment_frame_pointer ()) - { - do_unary (addr->b.i_blk, _SLANG_BC_UNARY); - (void) _SL_decrement_frame_pointer (); - } - break; - - case _SLANG_BC_DEREF_ASSIGN: - set_deref_lvalue (addr); - break; - case _SLANG_BC_SET_LOCAL_LVALUE: - set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk); - break; - case _SLANG_BC_SET_GLOBAL_LVALUE: - if (-1 == set_lvalue_obj (addr->bc_sub_type, &addr->b.nt_gvar_blk->obj)) - do_name_type_error (addr->b.nt_blk); - break; - case _SLANG_BC_SET_INTRIN_LVALUE: - set_intrin_lvalue (addr); - break; - case _SLANG_BC_SET_STRUCT_LVALUE: - set_struct_lvalue (addr); - break; - - case _SLANG_BC_FIELD: - (void) push_struct_field (addr->b.s_blk); - break; - - case _SLANG_BC_SET_ARRAY_LVALUE: - set_array_lvalue (addr->bc_sub_type); - break; - -#if _SLANG_HAS_DEBUG_CODE - case _SLANG_BC_LINE_NUM: - break; -#endif - - case _SLANG_BC_TMP: - tmp_variable_function (addr); - break; - -#if _SLANG_OPTIMIZE_FOR_SPEED - case _SLANG_BC_LVARIABLE_AGET: - if (0 == push_local_variable (addr->b.i_blk)) - do_bc_call_direct_frame (_SLarray_aget); - break; - - case _SLANG_BC_LVARIABLE_APUT: - if (0 == push_local_variable (addr->b.i_blk)) - do_bc_call_direct_frame (_SLarray_aput); - break; - case _SLANG_BC_INTEGER_PLUS: - if (0 == SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk)) - do_binary (SLANG_PLUS); - break; - - case _SLANG_BC_INTEGER_MINUS: - if (0 == SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk)) - do_binary (SLANG_MINUS); - break; -#endif -#if 0 - case _SLANG_BC_ARG_LVARIABLE: - (void) SLang_start_arg_list (); - push_local_variable (addr->b.i_blk); - break; -#endif - case _SLANG_BC_EARG_LVARIABLE: - push_local_variable (addr->b.i_blk); - (void) SLang_end_arg_list (); - break; - -#if USE_COMBINED_BYTECODES - case _SLANG_BC_CALL_DIRECT_INTRINSIC: - (*addr->b.call_function) (); - addr++; - execute_intrinsic_fun (addr->b.nt_ifun_blk); - if (SLang_Error) - do_traceback(addr->b.nt_ifun_blk->name, 0, NULL); - break; - - case _SLANG_BC_INTRINSIC_CALL_DIRECT: - execute_intrinsic_fun (addr->b.nt_ifun_blk); - if (SLang_Error) - { - do_traceback(addr->b.nt_ifun_blk->name, 0, NULL); - break; - } - addr++; - (*addr->b.call_function) (); - break; - - case _SLANG_BC_CALL_DIRECT_LSTR: - (*addr->b.call_function) (); - addr++; - _SLang_dup_and_push_slstring (addr->b.s_blk); - break; - - case _SLANG_BC_CALL_DIRECT_SLFUN: - (*addr->b.call_function) (); - addr++; - execute_slang_fun (addr->b.nt_fun_blk); - if (Lang_Break_Condition) goto handle_break_condition; - break; - - case _SLANG_BC_CALL_DIRECT_INTRSTOP: - (*addr->b.call_function) (); - addr++; - /* drop */ - case _SLANG_BC_INTRINSIC_STOP: - execute_intrinsic_fun (addr->b.nt_ifun_blk); - if (SLang_Error == 0) - return 1; - do_traceback(addr->b.nt_ifun_blk->name, 0, NULL); - break; - - case _SLANG_BC_CALL_DIRECT_EARG_LVAR: - (*addr->b.call_function) (); - addr++; - push_local_variable (addr->b.i_blk); - (void) SLang_end_arg_list (); - break; - - case _SLANG_BC_CALL_DIRECT_LINT: - (*addr->b.call_function) (); - addr++; - SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk); - break; - - case _SLANG_BC_CALL_DIRECT_LVAR: - (*addr->b.call_function) (); - addr++; - push_local_variable (addr->b.i_blk); - break; -#endif /* USE_COMBINED_BYTECODES */ - - default: - SLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type); - } - - /* Someday I plan to add a 'signal' intrinsic function. Then when a - * signal is caught, a variable will be set to one and that value of - * that variable will need to be monitored here, e.g., - * if (Handle_Signal) handle_signal (); - * It would be nice to check only one variable instead of Handle_Signal - * and SLang_Error. Perhaps I should phase out SLang_Error = xxx - * and used something like: SLang_set_error (code); Then, I could - * use: - * if (Handle_Condition) - * { - * Handle_Condition = 0; - * if (SLang_Error) .... - * else if (Handle_Signal) handle_signal (); - * else.... - * } - */ - if (SLang_Error) - { - if (-1 == do_inner_interp_error (err_block, addr_start, addr)) - return 1; - if (SLang_Error) - return 1; - - /* Otherwise, error cleared. Continue onto next bytecode. - * Someday I need to add something to indicate where the - * next statement begins since continuing on the next - * bytecode is not really what is desired. - */ - if (Lang_Break_Condition) goto handle_break_condition; - } - addr++; - } - - handle_break_condition: - /* Get here if Lang_Break_Condition != 0, which implies that either - * Lang_Return, Lang_Break, or Lang_Continue is non zero - */ - if (Lang_Return) - Lang_Break = 1; - - return 1; -} - -/*}}}*/ - -/* The functions below this point are used to implement the parsed token - * to byte-compiled code. - */ -/* static SLang_Name_Type **Static_Hash_Table; */ - -static SLang_Name_Type **Locals_Hash_Table; -static int Local_Variable_Number; -static unsigned int Function_Args_Number; -int _SLang_Auto_Declare_Globals = 0; -int (*SLang_Auto_Declare_Var_Hook) (char *); - -static SLang_NameSpace_Type *This_Static_NameSpace; -static SLang_NameSpace_Type *Global_NameSpace; - -#if _SLANG_HAS_DEBUG_CODE -static char *This_Compile_Filename; -#endif -static SLBlock_Type SLShort_Blocks[6]; -/* These are initialized in add_table below. I cannot init a Union!! */ - -static int Lang_Defining_Function; -static void (*Default_Variable_Mode) (_SLang_Token_Type *); -static void (*Default_Define_Function) (char *, unsigned long); - -static int push_compile_context (char *); -static int pop_compile_context (void); - -typedef struct -{ - int block_type; - SLBlock_Type *block; /* beginning of block definition */ - SLBlock_Type *block_ptr; /* current location */ - SLBlock_Type *block_max; /* end of definition */ - SLang_NameSpace_Type *static_namespace; -} -Block_Context_Type; - -static Block_Context_Type Block_Context_Stack [SLANG_MAX_BLOCK_STACK_LEN]; -static unsigned int Block_Context_Stack_Len; - -static SLBlock_Type *Compile_ByteCode_Ptr; -static SLBlock_Type *This_Compile_Block; -static SLBlock_Type *This_Compile_Block_Max; -static int This_Compile_Block_Type; -#define COMPILE_BLOCK_TYPE_FUNCTION 1 -#define COMPILE_BLOCK_TYPE_BLOCK 2 -#define COMPILE_BLOCK_TYPE_TOP_LEVEL 3 - -/* If it returns 0, DO NOT FREE p */ -static int lang_free_branch (SLBlock_Type *p) -{ - /* Note: we look at 0,2,4, since these blocks are 0 terminated */ - if ((p == SLShort_Blocks) - || (p == SLShort_Blocks + 2) - || (p == SLShort_Blocks + 4) - ) - return 0; - - while (1) - { - SLang_Class_Type *cl; - - switch (p->bc_main_type) - { - case _SLANG_BC_BLOCK: - if (lang_free_branch(p->b.blk)) - SLfree((char *)p->b.blk); - break; - - case _SLANG_BC_LITERAL: - case _SLANG_BC_LITERAL_STR: - /* No user types should be here. */ - cl = _SLclass_get_class (p->bc_sub_type); - (*cl->cl_byte_code_destroy) (p->bc_sub_type, (VOID_STAR) &p->b.ptr_blk); - break; - - case _SLANG_BC_FIELD: - case _SLANG_BC_SET_STRUCT_LVALUE: - SLang_free_slstring (p->b.s_blk); - break; - - default: - break; - - case 0: - return 1; - } - p++; - } -} - -static void free_function_header (_SLBlock_Header_Type *h) -{ - if (h->num_refs > 1) - { - h->num_refs--; - return; - } - - if (h->body != NULL) - { - if (lang_free_branch (h->body)) - SLfree ((char *) h->body); - } - - SLfree ((char *) h); -} - -static int push_block_context (int type) -{ - Block_Context_Type *c; - unsigned int num; - SLBlock_Type *b; - - if (Block_Context_Stack_Len == SLANG_MAX_BLOCK_STACK_LEN) - { - SLang_verror (SL_STACK_OVERFLOW, "Block stack overflow"); - return -1; - } - - num = 5; /* 40 bytes */ - if (NULL == (b = (SLBlock_Type *) SLcalloc (num, sizeof (SLBlock_Type)))) - return -1; - - c = Block_Context_Stack + Block_Context_Stack_Len; - c->block = This_Compile_Block; - c->block_ptr = Compile_ByteCode_Ptr; - c->block_max = This_Compile_Block_Max; - c->block_type = This_Compile_Block_Type; - c->static_namespace = This_Static_NameSpace; - - Compile_ByteCode_Ptr = This_Compile_Block = b; - This_Compile_Block_Max = b + num; - This_Compile_Block_Type = type; - - Block_Context_Stack_Len += 1; - return 0; -} - -static int pop_block_context (void) -{ - Block_Context_Type *c; - - if (Block_Context_Stack_Len == 0) - return -1; - - Block_Context_Stack_Len -= 1; - c = Block_Context_Stack + Block_Context_Stack_Len; - - This_Compile_Block = c->block; - This_Compile_Block_Max = c->block_max; - This_Compile_Block_Type = c->block_type; - Compile_ByteCode_Ptr = c->block_ptr; - This_Static_NameSpace = c->static_namespace; - - return 0; -} - -int _SLcompile_push_context (SLang_Load_Type *load_object) -{ - if (-1 == push_compile_context (load_object->name)) - return -1; - - if (NULL == (This_Static_NameSpace = _SLns_allocate_namespace (load_object->name, SLSTATIC_HASH_TABLE_SIZE))) - { - pop_compile_context (); - return -1; - } - - if (-1 == push_block_context (COMPILE_BLOCK_TYPE_TOP_LEVEL)) - { - pop_compile_context (); - return -1; - } - - return 0; -} - -int _SLcompile_pop_context (void) -{ - if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_TOP_LEVEL) - { - Compile_ByteCode_Ptr->bc_main_type = 0; - if (lang_free_branch (This_Compile_Block)) - SLfree ((char *) This_Compile_Block); - } - - (void) pop_block_context (); - (void) pop_compile_context (); - - if (This_Compile_Block == NULL) - return 0; - -#if 0 - if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL) - { - SLang_verror (SL_INTERNAL_ERROR, "Not at top-level"); - return -1; - } -#endif - - return 0; -} - -/*{{{ Hash and Name Table Functions */ - -static SLang_Name_Type *locate_name_in_table (char *name, unsigned long hash, - SLang_Name_Type **table, unsigned int table_size) -{ - SLang_Name_Type *t; - char ch; - - t = table [(unsigned int) (hash % table_size)]; - ch = *name++; - - while (t != NULL) - { - if ((ch == t->name[0]) - && (0 == strcmp (t->name + 1, name))) - break; - - t = t->next; - } - - return t; -} - -static SLang_Name_Type *locate_namespace_encoded_name (char *name, int err_on_bad_ns) -{ - char *ns, *ns1; - SLang_NameSpace_Type *table; - SLang_Name_Type *nt; - - ns = name; - name = strchr (name, '-'); - if ((name == NULL) || (name [1] != '>')) - name = ns; - - ns1 = SLang_create_nslstring (ns, (unsigned int) (name - ns)); - if (ns1 == NULL) - return NULL; - if (ns != name) - name += 2; - ns = ns1; - - if (*ns == 0) - { - /* Use Global Namespace */ - SLang_free_slstring (ns); - return locate_name_in_table (name, _SLcompute_string_hash (name), - Global_NameSpace->table, Global_NameSpace->table_size); - } - - if (NULL == (table = _SLns_find_namespace (ns))) - { - if (err_on_bad_ns) - SLang_verror (SL_SYNTAX_ERROR, "Unable to find namespace called %s", ns); - SLang_free_slstring (ns); - return NULL; - } - SLang_free_slstring (ns); - - /* FIXME: the hash table size should be stored in the hash table itself */ - nt = locate_name_in_table (name, _SLcompute_string_hash (name), - table->table, table->table_size); - if (nt == NULL) - return NULL; - - switch (nt->name_type) - { - /* These are private and cannot be accessed through the namespace. */ - case SLANG_PVARIABLE: - case SLANG_PFUNCTION: - return NULL; - } - return nt; -} - -static SLang_Name_Type *locate_hashed_name (char *name, unsigned long hash) -{ - SLang_Name_Type *t; - - if (Lang_Defining_Function) - { - t = locate_name_in_table (name, hash, Locals_Hash_Table, SLLOCALS_HASH_TABLE_SIZE); - if (t != NULL) - return t; - } - - if ((This_Static_NameSpace != NULL) - && (NULL != (t = locate_name_in_table (name, hash, This_Static_NameSpace->table, This_Static_NameSpace->table_size)))) - return t; - - t = locate_name_in_table (name, hash, Global_NameSpace->table, Global_NameSpace->table_size); - if (NULL != t) - return t; - - return locate_namespace_encoded_name (name, 1); -} - -SLang_Name_Type *_SLlocate_name (char *name) -{ - return locate_hashed_name (name, _SLcompute_string_hash (name)); -} - -static SLang_Name_Type * -add_name_to_hash_table (char *name, unsigned long hash, - unsigned int sizeof_obj, unsigned char name_type, - SLang_Name_Type **table, unsigned int table_size, - int check_existing) -{ - SLang_Name_Type *t; - - if (check_existing) - { - t = locate_name_in_table (name, hash, table, table_size); - if (t != NULL) - return t; - } - - if (-1 == _SLcheck_identifier_syntax (name)) - return NULL; - - t = (SLang_Name_Type *) SLmalloc (sizeof_obj); - if (t == NULL) - return t; - - memset ((char *) t, 0, sizeof_obj); - if (NULL == (t->name = _SLstring_dup_hashed_string (name, hash))) - { - SLfree ((char *) t); - return NULL; - } - t->name_type = name_type; - - hash = hash % table_size; - t->next = table [(unsigned int)hash]; - table [(unsigned int) hash] = t; - - return t; -} - -static SLang_Name_Type * -add_global_name (char *name, unsigned long hash, - unsigned char name_type, unsigned int sizeof_obj, - SLang_NameSpace_Type *ns) -{ - SLang_Name_Type *nt; - SLang_Name_Type **table; - unsigned int table_size; - - table = ns->table; - table_size = ns->table_size; - - nt = locate_name_in_table (name, hash, table, table_size); - if (nt != NULL) - { - if (nt->name_type == name_type) - return nt; - - SLang_verror (SL_DUPLICATE_DEFINITION, "%s cannot be re-defined", name); - return NULL; - } - - return add_name_to_hash_table (name, hash, sizeof_obj, name_type, - table, table_size, 0); -} - -static int add_intrinsic_function (SLang_NameSpace_Type *ns, - char *name, FVOID_STAR addr, unsigned char ret_type, - unsigned int nargs, va_list ap) -{ - SLang_Intrin_Fun_Type *f; - unsigned int i; - - if (-1 == init_interpreter ()) - return -1; - - if (ns == NULL) ns = Global_NameSpace; - - if (nargs > SLANG_MAX_INTRIN_ARGS) - { - SLang_verror (SL_APPLICATION_ERROR, "Function %s requires too many arguments", name); - return -1; - } - - if (ret_type == SLANG_FLOAT_TYPE) - { - SLang_verror (SL_NOT_IMPLEMENTED, "Function %s is not permitted to return float", name); - return -1; - } - - f = (SLang_Intrin_Fun_Type *) add_global_name (name, _SLcompute_string_hash (name), - SLANG_INTRINSIC, sizeof (SLang_Intrin_Fun_Type), - ns); - - if (f == NULL) - return -1; - - f->i_fun = addr; - f->num_args = nargs; - f->return_type = ret_type; - - for (i = 0; i < nargs; i++) - f->arg_types [i] = va_arg (ap, unsigned int); - - return 0; -} - -int SLadd_intrinsic_function (char *name, FVOID_STAR addr, unsigned char ret_type, - unsigned int nargs, ...) -{ - va_list ap; - int status; - - va_start (ap, nargs); - status = add_intrinsic_function (NULL, name, addr, ret_type, nargs, ap); - va_end (ap); - - return status; -} - -int SLns_add_intrinsic_function (SLang_NameSpace_Type *ns, - char *name, FVOID_STAR addr, unsigned char ret_type, - unsigned int nargs, ...) -{ - va_list ap; - int status; - - va_start (ap, nargs); - status = add_intrinsic_function (ns, name, addr, ret_type, nargs, ap); - va_end (ap); - - return status; -} - -int SLns_add_intrinsic_variable (SLang_NameSpace_Type *ns, - char *name, VOID_STAR addr, unsigned char data_type, int ro) -{ - SLang_Intrin_Var_Type *v; - - if (-1 == init_interpreter ()) - return -1; - - if (ns == NULL) ns = Global_NameSpace; - - v = (SLang_Intrin_Var_Type *)add_global_name (name, - _SLcompute_string_hash (name), - (ro ? SLANG_RVARIABLE : SLANG_IVARIABLE), - sizeof (SLang_Intrin_Var_Type), - ns); - if (v == NULL) - return -1; - - v->addr = addr; - v->type = data_type; - return 0; -} - -int SLadd_intrinsic_variable (char *name, VOID_STAR addr, unsigned char data_type, int ro) -{ - return SLns_add_intrinsic_variable (NULL, name, addr, data_type, ro); -} - -static int -add_slang_function (char *name, unsigned char type, unsigned long hash, - unsigned int num_args, unsigned int num_locals, -#if _SLANG_HAS_DEBUG_CODE - char *file, -#endif - _SLBlock_Header_Type *h, - SLang_NameSpace_Type *ns) -{ - _SLang_Function_Type *f; - -#if _SLANG_HAS_DEBUG_CODE - if ((file != NULL) - && (NULL == (file = SLang_create_slstring (file)))) - return -1; -#endif - - f = (_SLang_Function_Type *)add_global_name (name, hash, - type, - sizeof (_SLang_Function_Type), - ns); - if (f == NULL) - { -#if _SLANG_HAS_DEBUG_CODE - SLang_free_slstring (file); /* NULL ok */ -#endif - return -1; - } - - if (f->v.header != NULL) - { - if (f->nlocals == AUTOLOAD_NUM_LOCALS) - SLang_free_slstring ((char *)f->v.autoload_filename); /* autoloaded filename */ - else - free_function_header (f->v.header); - } - -#if _SLANG_HAS_DEBUG_CODE - if (f->file != NULL) SLang_free_slstring (f->file); - f->file = file; -#endif - f->v.header = h; - f->nlocals = num_locals; - f->nargs = num_args; - - return 0; -} - -int SLang_autoload (char *name, char *file) -{ - _SLang_Function_Type *f; - unsigned long hash; - - hash = _SLcompute_string_hash (name); - f = (_SLang_Function_Type *)locate_name_in_table (name, hash, Global_NameSpace->table, Global_NameSpace->table_size); - - if ((f != NULL) - && (f->name_type == SLANG_FUNCTION) - && (f->v.header != NULL) - && (f->nlocals != AUTOLOAD_NUM_LOCALS)) - { - /* already loaded */ - return 0; - } - - file = SLang_create_slstring (file); - if (-1 == add_slang_function (name, SLANG_FUNCTION, hash, 0, AUTOLOAD_NUM_LOCALS, -#if _SLANG_HAS_DEBUG_CODE - file, -#endif - (_SLBlock_Header_Type *) file, - Global_NameSpace)) - { - SLang_free_slstring (file); - return -1; - } - - return 0; -} - -SLang_Name_Type *_SLlocate_global_name (char *name) -{ - unsigned long hash; - - hash = _SLcompute_string_hash (name); - return locate_name_in_table (name, hash, Global_NameSpace->table, - Global_NameSpace->table_size); -} - -/*}}}*/ - -static void free_local_variable_table (void) -{ - unsigned int i; - SLang_Name_Type *t, *t1; - - for (i = 0; i < SLLOCALS_HASH_TABLE_SIZE; i++) - { - t = Locals_Hash_Table [i]; - while (t != NULL) - { - SLang_free_slstring (t->name); - t1 = t->next; - SLfree ((char *) t); - t = t1; - } - Locals_Hash_Table [i] = NULL; - } - Local_Variable_Number = 0; -} - -/* call inner interpreter or return for more */ -static void lang_try_now(void) -{ - Compile_ByteCode_Ptr++; - if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL) - return; - - Compile_ByteCode_Ptr->bc_main_type = 0; /* so next command stops after this */ - - /* now do it */ - inner_interp (This_Compile_Block); - (void) lang_free_branch (This_Compile_Block); - Compile_ByteCode_Ptr = This_Compile_Block; -} - -SLang_Name_Type *SLang_get_fun_from_ref (SLang_Ref_Type *ref) -{ - if (ref->is_global) - { - SLang_Name_Type *nt = ref->v.nt; - - switch (nt->name_type) - { - case SLANG_PFUNCTION: - case SLANG_FUNCTION: - case SLANG_INTRINSIC: - case SLANG_MATH_UNARY: - case SLANG_APP_UNARY: - return nt; - } - SLang_verror (SL_TYPE_MISMATCH, - "Reference to a function expected. Found &%s", - nt->name); - } - - SLang_verror (SL_TYPE_MISMATCH, - "Reference to a function expected"); - return NULL; -} - -int SLexecute_function (SLang_Name_Type *nt) -{ - unsigned char type; - char *name; - - if (SLang_Error) - return -1; - - type = nt->name_type; - name = nt->name; - - switch (type) - { - case SLANG_PFUNCTION: - case SLANG_FUNCTION: - execute_slang_fun ((_SLang_Function_Type *) nt); - break; - - case SLANG_INTRINSIC: - execute_intrinsic_fun ((SLang_Intrin_Fun_Type *) nt); - break; - - case SLANG_MATH_UNARY: - case SLANG_APP_UNARY: - inner_interp_nametype (nt); - break; - - default: - SLang_verror (SL_TYPE_MISMATCH, "%s is not a function", name); - return -1; - } - - if (SLang_Error) - { - SLang_verror (SLang_Error, "Error while executing %s", name); - return -1; - } - - return 1; -} - -int SLang_execute_function (char *name) -{ - SLang_Name_Type *entry; - - if (NULL == (entry = SLang_get_function (name))) - return 0; - - return SLexecute_function (entry); -} - -/* return S-Lang function or NULL */ -SLang_Name_Type *SLang_get_function (char *name) -{ - SLang_Name_Type *entry; - - if (NULL == (entry = locate_namespace_encoded_name (name, 0))) - return NULL; - - if ((entry->name_type == SLANG_FUNCTION) - || (entry->name_type == SLANG_INTRINSIC)) - return entry; - - return NULL; -} - -static void lang_begin_function (void) -{ - if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL) - { - SLang_verror (SL_SYNTAX_ERROR, "Function nesting is illegal"); - return; - } - Lang_Defining_Function = 1; - (void) push_block_context (COMPILE_BLOCK_TYPE_FUNCTION); -} - -#if USE_COMBINED_BYTECODES -static void optimize_block (SLBlock_Type *b) -{ - while (1) - { - switch (b->bc_main_type) - { - case 0: - return; - - default: - b++; - break; - - case _SLANG_BC_CALL_DIRECT: - b++; - switch (b->bc_main_type) - { - case 0: - return; - case _SLANG_BC_INTRINSIC: - if ((b+1)->bc_main_type == 0) - { - (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_INTRSTOP; - return; - } - (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_INTRINSIC; - b++; - break; - case _SLANG_BC_LITERAL_STR: - (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_LSTR; - b++; - break; - case _SLANG_BC_FUNCTION: - case _SLANG_BC_PFUNCTION: - (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_SLFUN; - b++; - break; - case _SLANG_BC_EARG_LVARIABLE: - (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_EARG_LVAR; - b++; - break; - case _SLANG_BC_LITERAL_INT: - (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_LINT; - b++; - break; - case _SLANG_BC_LVARIABLE: - (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_LVAR; - b++; - break; - } - break; - - case _SLANG_BC_INTRINSIC: - b++; - switch (b->bc_main_type) - { - case _SLANG_BC_CALL_DIRECT: - (b-1)->bc_main_type = _SLANG_BC_INTRINSIC_CALL_DIRECT; - b++; - break; -#if 0 - case _SLANG_BC_BLOCK: - (b-1)->bc_main_type = _SLANG_BC_INTRINSIC_BLOCK; - b++; - break; -#endif - - case 0: - (b-1)->bc_main_type = _SLANG_BC_INTRINSIC_STOP; - return; - } - break; - } - } -} - -#endif - - -/* name will be NULL if the object is to simply terminate the function - * definition. See SLang_restart. - */ -static int lang_define_function (char *name, unsigned char type, unsigned long hash, - SLang_NameSpace_Type *ns) -{ - if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_FUNCTION) - { - SLang_verror (SL_SYNTAX_ERROR, "Premature end of function"); - return -1; - } - - /* terminate function */ - Compile_ByteCode_Ptr->bc_main_type = 0; - - if (name != NULL) - { - _SLBlock_Header_Type *h; - - h = (_SLBlock_Header_Type *)SLmalloc (sizeof (_SLBlock_Header_Type)); - if (h != NULL) - { - h->num_refs = 1; - h->body = This_Compile_Block; - -#if USE_COMBINED_BYTECODES - optimize_block (h->body); -#endif - - if (-1 == add_slang_function (name, type, hash, - Function_Args_Number, - Local_Variable_Number, -#if _SLANG_HAS_DEBUG_CODE - This_Compile_Filename, -#endif - h, ns)) - SLfree ((char *) h); - } - /* Drop through for clean-up */ - } - - free_local_variable_table (); - - Function_Args_Number = 0; - Lang_Defining_Function = 0; - - if (SLang_Error) return -1; - /* SLang_restart will finish this if there is a slang error. */ - - pop_block_context (); - - /* A function is only defined at top-level */ - if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL) - { - SLang_verror (SL_INTERNAL_ERROR, "Not at top-level"); - return -1; - } - Compile_ByteCode_Ptr = This_Compile_Block; - return 0; -} - -static void define_static_function (char *name, unsigned long hash) -{ - (void) lang_define_function (name, SLANG_FUNCTION, hash, This_Static_NameSpace); -} - -static void define_private_function (char *name, unsigned long hash) -{ - (void) lang_define_function (name, SLANG_PFUNCTION, hash, This_Static_NameSpace); -} - -static void define_public_function (char *name, unsigned long hash) -{ - (void) lang_define_function (name, SLANG_FUNCTION, hash, Global_NameSpace); -} - -static void lang_end_block (void) -{ - SLBlock_Type *node, *branch; - unsigned char mtype; - - if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK) - { - SLang_verror (SL_SYNTAX_ERROR, "Not defining a block"); - return; - } - - /* terminate the block */ - Compile_ByteCode_Ptr->bc_main_type = 0; - branch = This_Compile_Block; - - /* Try to save some space by using the cached blocks. */ - if (Compile_ByteCode_Ptr == branch + 1) - { - mtype = branch->bc_main_type; - if (((mtype == _SLANG_BC_BREAK) - || (mtype == _SLANG_BC_CONTINUE) - || (mtype == _SLANG_BC_RETURN)) - && (SLang_Error == 0)) - { - SLfree ((char *)branch); - branch = SLShort_Blocks + 2 * (int) (mtype - _SLANG_BC_RETURN); - } - } - -#if USE_COMBINED_BYTECODES - optimize_block (branch); -#endif - - pop_block_context (); - node = Compile_ByteCode_Ptr++; - - node->bc_main_type = _SLANG_BC_BLOCK; - node->bc_sub_type = 0; - node->b.blk = branch; -} - -static int lang_begin_block (void) -{ - return push_block_context (COMPILE_BLOCK_TYPE_BLOCK); -} - -static int lang_check_space (void) -{ - unsigned int n; - SLBlock_Type *p; - - if (NULL == (p = This_Compile_Block)) - { - SLang_verror (SL_INTERNAL_ERROR, "Top-level block not present"); - return -1; - } - - /* Allow 1 extra for terminator */ - if (Compile_ByteCode_Ptr + 1 < This_Compile_Block_Max) - return 0; - - n = (unsigned int) (This_Compile_Block_Max - p); - - /* enlarge the space by 2 objects */ - n += 2; - - if (NULL == (p = (SLBlock_Type *) SLrealloc((char *)p, n * sizeof(SLBlock_Type)))) - return -1; - - This_Compile_Block_Max = p + n; - n = (unsigned int) (Compile_ByteCode_Ptr - This_Compile_Block); - This_Compile_Block = p; - Compile_ByteCode_Ptr = p + n; - - return 0; -} - -/* returns positive number if name is a function or negative number if it - is a variable. If it is intrinsic, it returns magnitude of 1, else 2 */ -int SLang_is_defined(char *name) -{ - SLang_Name_Type *t; - - if (-1 == init_interpreter ()) - return -1; - - t = locate_namespace_encoded_name (name, 0); - if (t == NULL) - return 0; - - switch (t->name_type) - { - case SLANG_FUNCTION: - /* case SLANG_PFUNCTION: */ - return 2; - case SLANG_GVARIABLE: - /* case SLANG_PVARIABLE: */ - return -2; - - case SLANG_ICONSTANT: - case SLANG_DCONSTANT: - case SLANG_RVARIABLE: - case SLANG_IVARIABLE: - return -1; - - case SLANG_INTRINSIC: - default: - return 1; - } -} - -static int add_global_variable (char *name, char name_type, unsigned long hash, - SLang_NameSpace_Type *ns) -{ - SLang_Name_Type *g; - - /* Note the importance of checking if it is already defined or not. For example, - * suppose X is defined as an intrinsic variable. Then S-Lang code like: - * !if (is_defined("X")) { variable X; } - * will not result in a global variable X. On the other hand, this would - * not be an issue if 'variable' statements always were not processed - * immediately. That is, as it is now, 'if (0) {variable ZZZZ;}' will result - * in the variable ZZZZ being defined because of the immediate processing. - * The current solution is to do: if (0) { eval("variable ZZZZ;"); } - */ - /* hash = _SLcompute_string_hash (name); */ - g = locate_name_in_table (name, hash, ns->table, ns->table_size); - - if (g != NULL) - { - if (g->name_type == name_type) - return 0; - } - - if (NULL == add_global_name (name, hash, name_type, - sizeof (SLang_Global_Var_Type), ns)) - return -1; - - return 0; -} - -int SLadd_global_variable (char *name) -{ - if (-1 == init_interpreter ()) - return -1; - - return add_global_variable (name, SLANG_GVARIABLE, - _SLcompute_string_hash (name), - Global_NameSpace); -} - -static int add_local_variable (char *name, unsigned long hash) -{ - SLang_Local_Var_Type *t; - - /* local variable */ - if (Local_Variable_Number >= SLANG_MAX_LOCAL_VARIABLES) - { - SLang_verror (SL_SYNTAX_ERROR, "Too many local variables"); - return -1; - } - - if (NULL != locate_name_in_table (name, hash, Locals_Hash_Table, SLLOCALS_HASH_TABLE_SIZE)) - { - SLang_verror (SL_SYNTAX_ERROR, "Local variable %s has already been defined", name); - return -1; - } - - t = (SLang_Local_Var_Type *) - add_name_to_hash_table (name, hash, - sizeof (SLang_Local_Var_Type), SLANG_LVARIABLE, - Locals_Hash_Table, SLLOCALS_HASH_TABLE_SIZE, 0); - if (t == NULL) - return -1; - - t->local_var_number = Local_Variable_Number; - Local_Variable_Number++; - return 0; -} - -static void (*Compile_Mode_Function) (_SLang_Token_Type *); -static void compile_basic_token_mode (_SLang_Token_Type *); - -/* if an error occurs, discard current object, block, function, etc... */ -void SLang_restart (int localv) -{ - int save = SLang_Error; - - SLang_Error = SL_UNKNOWN_ERROR; - - _SLcompile_ptr = _SLcompile; - Compile_Mode_Function = compile_basic_token_mode; - - Lang_Break = /* Lang_Continue = */ Lang_Return = 0; - Trace_Mode = 0; - - while (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_BLOCK) - lang_end_block(); - - if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_FUNCTION) - { - /* Terminate function definition and free variables */ - lang_define_function (NULL, SLANG_FUNCTION, 0, Global_NameSpace); - if (lang_free_branch (This_Compile_Block)) - SLfree((char *)This_Compile_Block); - } - Lang_Defining_Function = 0; - - SLang_Error = save; - - if (SLang_Error == SL_STACK_OVERFLOW) - { - /* This loop guarantees that the stack is properly cleaned. */ - while (_SLStack_Pointer != _SLRun_Stack) - { - SLdo_pop (); - } - } - - while ((This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL) - && (0 == pop_block_context ())) - ; - - if (localv) - { - Next_Function_Num_Args = SLang_Num_Function_Args = 0; - Local_Variable_Frame = Local_Variable_Stack; - Recursion_Depth = 0; - Frame_Pointer = _SLStack_Pointer; - Frame_Pointer_Depth = 0; - Switch_Obj_Ptr = Switch_Objects; - while (Switch_Obj_Ptr < Switch_Obj_Max) - { - SLang_free_object (Switch_Obj_Ptr); - Switch_Obj_Ptr++; - } - Switch_Obj_Ptr = Switch_Objects; - } -} - -static void compile_directive (unsigned char sub_type) -{ - /* This function is called only from compile_directive_mode which is - * only possible when a block is available. - */ - - /* use BLOCK */ - Compile_ByteCode_Ptr--; - Compile_ByteCode_Ptr->bc_sub_type = sub_type; - - lang_try_now (); -} - -static void compile_unary (int op, unsigned char mt) -{ - Compile_ByteCode_Ptr->bc_main_type = mt; - Compile_ByteCode_Ptr->b.i_blk = op; - Compile_ByteCode_Ptr->bc_sub_type = 0; - - lang_try_now (); -} - - -static void compile_binary (int op) -{ - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_BINARY; - Compile_ByteCode_Ptr->b.i_blk = op; - Compile_ByteCode_Ptr->bc_sub_type = 0; - - lang_try_now (); -} - -#if _SLANG_OPTIMIZE_FOR_SPEED -static int try_compressed_bytecode (unsigned char last_bc, unsigned char bc) -{ - if (Compile_ByteCode_Ptr != This_Compile_Block) - { - SLBlock_Type *b; - b = Compile_ByteCode_Ptr - 1; - if (b->bc_main_type == last_bc) - { - Compile_ByteCode_Ptr = b; - b->bc_main_type = bc; - lang_try_now (); - return 0; - } - } - return -1; -} -#endif - -static void compile_fast_binary (int op, unsigned char bc) -{ -#if _SLANG_OPTIMIZE_FOR_SPEED - if (0 == try_compressed_bytecode (_SLANG_BC_LITERAL_INT, bc)) - return; -#else - (void) bc; -#endif - compile_binary (op); -} - -/* This is a hack */ -typedef struct _Special_NameTable_Type -{ - char *name; - int (*fun) (struct _Special_NameTable_Type *, _SLang_Token_Type *); - VOID_STAR blk_data; - unsigned char main_type; -} -Special_NameTable_Type; - -static int handle_special (Special_NameTable_Type *nt, _SLang_Token_Type *tok) -{ - (void) tok; - Compile_ByteCode_Ptr->bc_main_type = nt->main_type; - Compile_ByteCode_Ptr->b.ptr_blk = nt->blk_data; - return 0; -} - -static int handle_special_file (Special_NameTable_Type *nt, _SLang_Token_Type *tok) -{ - char *name; - - (void) nt; (void) tok; - - if (This_Static_NameSpace == NULL) name = "***Unknown***"; - else - name = This_Static_NameSpace->name; - - name = SLang_create_slstring (name); - if (name == NULL) - return -1; - - Compile_ByteCode_Ptr->b.s_blk = name; - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL_STR; - Compile_ByteCode_Ptr->bc_sub_type = SLANG_STRING_TYPE; - return 0; -} - -static int handle_special_line (Special_NameTable_Type *nt, _SLang_Token_Type *tok) -{ - (void) nt; - -#if _SLANG_HAS_DEBUG_CODE - Compile_ByteCode_Ptr->b.l_blk = (long) tok->line_number; -#endif - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL; - Compile_ByteCode_Ptr->bc_sub_type = SLANG_UINT_TYPE; - - return 0; -} - -static Special_NameTable_Type Special_Name_Table [] = -{ - {"EXECUTE_ERROR_BLOCK", handle_special, NULL, _SLANG_BC_X_ERROR}, - {"X_USER_BLOCK0", handle_special, NULL, _SLANG_BC_X_USER0}, - {"X_USER_BLOCK1", handle_special, NULL, _SLANG_BC_X_USER1}, - {"X_USER_BLOCK2", handle_special, NULL, _SLANG_BC_X_USER2}, - {"X_USER_BLOCK3", handle_special, NULL, _SLANG_BC_X_USER3}, - {"X_USER_BLOCK4", handle_special, NULL, _SLANG_BC_X_USER4}, - {"__FILE__", handle_special_file, NULL, 0}, - {"__LINE__", handle_special_line, NULL, 0}, -#if 0 - {"__NAMESPACE__", handle_special_namespace, NULL, 0}, -#endif - {NULL, NULL, NULL, 0} -}; - -static void compile_hashed_identifier (char *name, unsigned long hash, _SLang_Token_Type *tok) -{ - SLang_Name_Type *entry; - unsigned char name_type; - - entry = locate_hashed_name (name, hash); - - if (entry == NULL) - { - Special_NameTable_Type *nt = Special_Name_Table; - - while (nt->name != NULL) - { - if (strcmp (name, nt->name)) - { - nt++; - continue; - } - - if (0 == (*nt->fun)(nt, tok)) - lang_try_now (); - return; - } - - SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name); - return; - } - - name_type = entry->name_type; - Compile_ByteCode_Ptr->bc_main_type = name_type; - - if (name_type == SLANG_LVARIABLE) - Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) entry)->local_var_number; - else - Compile_ByteCode_Ptr->b.nt_blk = entry; - - lang_try_now (); -} - -static void compile_tmp_variable (char *name, unsigned long hash) -{ - SLang_Name_Type *entry; - unsigned char name_type; - - if (NULL == (entry = locate_hashed_name (name, hash))) - { - SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name); - return; - } - - name_type = entry->name_type; - switch (name_type) - { - case SLANG_LVARIABLE: - Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) entry)->local_var_number; - break; - - case SLANG_GVARIABLE: - case SLANG_PVARIABLE: - Compile_ByteCode_Ptr->b.nt_blk = entry; - break; - - default: - SLang_verror (SL_SYNTAX_ERROR, "__tmp(%s) does not specifiy a variable", name); - return; - } - - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_TMP; - Compile_ByteCode_Ptr->bc_sub_type = name_type; - - lang_try_now (); -} - -static void compile_simple (unsigned char main_type) -{ - Compile_ByteCode_Ptr->bc_main_type = main_type; - Compile_ByteCode_Ptr->bc_sub_type = 0; - Compile_ByteCode_Ptr->b.blk = NULL; - lang_try_now (); -} - -static void compile_identifier (char *name, _SLang_Token_Type *tok) -{ - compile_hashed_identifier (name, _SLcompute_string_hash (name), tok); -} - -static void compile_call_direct (int (*f) (void), unsigned char byte_code) -{ - Compile_ByteCode_Ptr->b.call_function = f; - Compile_ByteCode_Ptr->bc_main_type = byte_code; - Compile_ByteCode_Ptr->bc_sub_type = 0; - lang_try_now (); -} - -static void compile_lvar_call_direct (int (*f)(void), unsigned char bc, - unsigned char frame_op) -{ -#if _SLANG_OPTIMIZE_FOR_SPEED - if (0 == try_compressed_bytecode (_SLANG_BC_LVARIABLE, bc)) - return; -#else - (void) bc; -#endif - - compile_call_direct (f, frame_op); -} - -static void compile_integer (long i, unsigned char bc_main_type, unsigned char bc_sub_type) -{ - Compile_ByteCode_Ptr->b.l_blk = i; - Compile_ByteCode_Ptr->bc_main_type = bc_main_type; - Compile_ByteCode_Ptr->bc_sub_type = bc_sub_type; - - lang_try_now (); -} - -#if SLANG_HAS_FLOAT -static void compile_double (char *str, unsigned char type) -{ - double d; - unsigned int factor = 1; - double *ptr; - -#if 1 - d = _SLang_atof (str); -#else - if (1 != sscanf (str, "%lf", &d)) - { - SLang_verror (SL_SYNTAX_ERROR, "Unable to convert %s to double", str); - return; - } -#endif - -#if SLANG_HAS_COMPLEX - if (type == SLANG_COMPLEX_TYPE) factor = 2; -#endif - if (NULL == (ptr = (double *) SLmalloc(factor * sizeof(double)))) - return; - - Compile_ByteCode_Ptr->b.double_blk = ptr; -#if SLANG_HAS_COMPLEX - if (type == SLANG_COMPLEX_TYPE) - *ptr++ = 0; -#endif - *ptr = d; - - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL; - Compile_ByteCode_Ptr->bc_sub_type = type; - lang_try_now (); -} - -static void compile_float (char *s) -{ - float x; - -#if 1 - x = (float) _SLang_atof (s); -#else - if (1 != sscanf (s, "%f", &x)) - { - SLang_verror (SL_SYNTAX_ERROR, "Unable to convert %s to float", s); - return; - } -#endif - Compile_ByteCode_Ptr->b.float_blk = x; - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL; - Compile_ByteCode_Ptr->bc_sub_type = SLANG_FLOAT_TYPE; - lang_try_now (); -} - -#endif - -static void compile_string (char *s, unsigned long hash) -{ - if (NULL == (Compile_ByteCode_Ptr->b.s_blk = _SLstring_dup_hashed_string (s, hash))) - return; - - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL_STR; - Compile_ByteCode_Ptr->bc_sub_type = SLANG_STRING_TYPE; - - lang_try_now (); -} - -static void compile_bstring (SLang_BString_Type *s) -{ - if (NULL == (Compile_ByteCode_Ptr->b.bs_blk = SLbstring_dup (s))) - return; - - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL; - Compile_ByteCode_Ptr->bc_sub_type = SLANG_BSTRING_TYPE; - - lang_try_now (); -} - -/* assign_type is one of _SLANG_BCST_ASSIGN, ... values */ -static void compile_assign (unsigned char assign_type, - char *name, unsigned long hash) -{ - SLang_Name_Type *v; - unsigned char main_type; - SLang_Class_Type *cl; - - v = locate_hashed_name (name, hash); - if (v == NULL) - { - if ((_SLang_Auto_Declare_Globals == 0) - || (NULL != strchr (name, '-')) /* namespace->name form */ - || Lang_Defining_Function - || (assign_type != _SLANG_BCST_ASSIGN) - || (This_Static_NameSpace == NULL)) - { - SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name); - return; - } - /* Note that function local variables are not at top level */ - - /* Variables that are automatically declared are given static - * scope. - */ - if ((NULL != SLang_Auto_Declare_Var_Hook) - && (-1 == (*SLang_Auto_Declare_Var_Hook) (name))) - return; - - if ((-1 == add_global_variable (name, SLANG_GVARIABLE, hash, This_Static_NameSpace)) - || (NULL == (v = locate_hashed_name (name, hash)))) - return; - } - - switch (v->name_type) - { - case SLANG_LVARIABLE: - main_type = _SLANG_BC_SET_LOCAL_LVALUE; - Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) v)->local_var_number; - break; - - case SLANG_GVARIABLE: - case SLANG_PVARIABLE: - main_type = _SLANG_BC_SET_GLOBAL_LVALUE; - Compile_ByteCode_Ptr->b.nt_blk = v; - break; - - case SLANG_IVARIABLE: - cl = _SLclass_get_class (((SLang_Intrin_Var_Type *)v)->type); - if (cl->cl_class_type != SLANG_CLASS_TYPE_SCALAR) - { - SLang_verror (SL_SYNTAX_ERROR, "Assignment to %s is not allowed", name); - return; - } - main_type = _SLANG_BC_SET_INTRIN_LVALUE; - Compile_ByteCode_Ptr->b.nt_blk = v; - break; - - case SLANG_RVARIABLE: - SLang_verror (SL_READONLY_ERROR, "%s is read-only", name); - return; - - default: - SLang_verror (SL_DUPLICATE_DEFINITION, "%s may not be used as an lvalue", name); - return; - } - - Compile_ByteCode_Ptr->bc_sub_type = assign_type; - Compile_ByteCode_Ptr->bc_main_type = main_type; - - lang_try_now (); -} - -static void compile_deref_assign (char *name, unsigned long hash) -{ - SLang_Name_Type *v; - - v = locate_hashed_name (name, hash); - - if (v == NULL) - { - SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name); - return; - } - - switch (v->name_type) - { - case SLANG_LVARIABLE: - Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) v)->local_var_number; - break; - - case SLANG_GVARIABLE: - case SLANG_PVARIABLE: - Compile_ByteCode_Ptr->b.nt_blk = v; - break; - - default: - /* FIXME: Priority=low - * This could be made to work. It is not a priority because - * I cannot imagine application intrinsics which are references. - */ - SLang_verror (SL_NOT_IMPLEMENTED, "Deref assignment to %s is not allowed", name); - return; - } - - Compile_ByteCode_Ptr->bc_sub_type = v->name_type; - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_DEREF_ASSIGN; - - lang_try_now (); -} - -static void -compile_struct_assign (_SLang_Token_Type *t) -{ - Compile_ByteCode_Ptr->bc_sub_type = _SLANG_BCST_ASSIGN + (t->type - _STRUCT_ASSIGN_TOKEN); - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_SET_STRUCT_LVALUE; - Compile_ByteCode_Ptr->b.s_blk = _SLstring_dup_hashed_string (t->v.s_val, t->hash); - lang_try_now (); -} - -static void -compile_array_assign (_SLang_Token_Type *t) -{ - Compile_ByteCode_Ptr->bc_sub_type = _SLANG_BCST_ASSIGN + (t->type - _ARRAY_ASSIGN_TOKEN); - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_SET_ARRAY_LVALUE; - Compile_ByteCode_Ptr->b.s_blk = NULL; - lang_try_now (); -} - -static void compile_dot(_SLang_Token_Type *t) -{ - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_FIELD; - Compile_ByteCode_Ptr->b.s_blk = _SLstring_dup_hashed_string(t->v.s_val, t->hash); - lang_try_now (); -} - -static void compile_ref (char *name, unsigned long hash) -{ - SLang_Name_Type *entry; - unsigned char main_type; - - if (NULL == (entry = locate_hashed_name (name, hash))) - { - SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name); - return; - } - - main_type = entry->name_type; - - if (main_type == SLANG_LVARIABLE) - { - main_type = _SLANG_BC_LOBJPTR; - Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *)entry)->local_var_number; - } - else - { - main_type = _SLANG_BC_GOBJPTR; - Compile_ByteCode_Ptr->b.nt_blk = entry; - } - - Compile_ByteCode_Ptr->bc_main_type = main_type; - lang_try_now (); -} - -static void compile_break (unsigned char break_type, - int requires_block, int requires_fun, - char *str) -{ - if ((requires_fun - && (Lang_Defining_Function == 0)) - || (requires_block - && (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK))) - { - SLang_verror (SL_SYNTAX_ERROR, "misplaced %s", str); - return; - } - - Compile_ByteCode_Ptr->bc_main_type = break_type; - Compile_ByteCode_Ptr->bc_sub_type = 0; - - lang_try_now (); -} - -static void compile_public_variable_mode (_SLang_Token_Type *t) -{ - if (t->type == IDENT_TOKEN) - { - /* If the variable is already defined in the static hash table, - * generate an error. - */ - if ((This_Static_NameSpace != NULL) - && (NULL != locate_name_in_table (t->v.s_val, t->hash, This_Static_NameSpace->table, This_Static_NameSpace->table_size))) - { - SLang_verror (SL_DUPLICATE_DEFINITION, - "%s already has static or private linkage in this unit", - t->v.s_val); - return; - } - add_global_variable (t->v.s_val, SLANG_GVARIABLE, t->hash, Global_NameSpace); - } - else if (t->type == CBRACKET_TOKEN) - Compile_Mode_Function = compile_basic_token_mode; - else - SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list"); -} - -static void compile_local_variable_mode (_SLang_Token_Type *t) -{ - if (t->type == IDENT_TOKEN) - add_local_variable (t->v.s_val, t->hash); - else if (t->type == CBRACKET_TOKEN) - Compile_Mode_Function = compile_basic_token_mode; - else - SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list"); -} - -static void compile_static_variable_mode (_SLang_Token_Type *t) -{ - if (t->type == IDENT_TOKEN) - add_global_variable (t->v.s_val, SLANG_GVARIABLE, t->hash, This_Static_NameSpace); - else if (t->type == CBRACKET_TOKEN) - Compile_Mode_Function = compile_basic_token_mode; - else - SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list"); -} - -static void compile_private_variable_mode (_SLang_Token_Type *t) -{ - if (t->type == IDENT_TOKEN) - add_global_variable (t->v.s_val, SLANG_PVARIABLE, t->hash, This_Static_NameSpace); - else if (t->type == CBRACKET_TOKEN) - Compile_Mode_Function = compile_basic_token_mode; - else - SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list"); -} - -static void compile_function_mode (_SLang_Token_Type *t) -{ - if (-1 == lang_check_space ()) - return; - - if (t->type != IDENT_TOKEN) - SLang_verror (SL_SYNTAX_ERROR, "Expecting function name"); - else - lang_define_function (t->v.s_val, SLANG_FUNCTION, t->hash, Global_NameSpace); - - Compile_Mode_Function = compile_basic_token_mode; -} - -/* An error block is not permitted to contain continue or break statements. - * This restriction may be removed later but for now reject them. - */ -static int check_error_block (void) -{ - SLBlock_Type *p; - unsigned char t; - - /* Back up to the block and then scan it. */ - p = (Compile_ByteCode_Ptr - 1)->b.blk; - - while (0 != (t = p->bc_main_type)) - { - if ((t == _SLANG_BC_BREAK) - || (t == _SLANG_BC_CONTINUE)) - { - SLang_verror (SL_SYNTAX_ERROR, - "An ERROR_BLOCK is not permitted to contain continue or break statements"); - return -1; - } - p++; - } - return 0; -} - -/* The only allowed tokens are the directives and another block start. - * The mode is only active if a block is available. The inner_interp routine - * expects such safety checks. - */ -static void compile_directive_mode (_SLang_Token_Type *t) -{ - int bc_sub_type; - - if (-1 == lang_check_space ()) - return; - - bc_sub_type = -1; - - switch (t->type) - { - case FOREVER_TOKEN: - bc_sub_type = _SLANG_BCST_FOREVER; - break; - - case IFNOT_TOKEN: - bc_sub_type = _SLANG_BCST_IFNOT; - break; - - case IF_TOKEN: - bc_sub_type = _SLANG_BCST_IF; - break; - - case ANDELSE_TOKEN: - bc_sub_type = _SLANG_BCST_ANDELSE; - break; - - case SWITCH_TOKEN: - bc_sub_type = _SLANG_BCST_SWITCH; - break; - - case EXITBLK_TOKEN: - if (Lang_Defining_Function == 0) - { - SLang_verror (SL_SYNTAX_ERROR, "misplaced EXIT_BLOCK"); - break; - } - bc_sub_type = _SLANG_BCST_EXIT_BLOCK; - break; - - case ERRBLK_TOKEN: - if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_TOP_LEVEL) - { - SLang_verror (SL_SYNTAX_ERROR, "misplaced ERROR_BLOCK"); - break; - } - if (0 == check_error_block ()) - bc_sub_type = _SLANG_BCST_ERROR_BLOCK; - break; - - case USRBLK0_TOKEN: - case USRBLK1_TOKEN: - case USRBLK2_TOKEN: - case USRBLK3_TOKEN: - case USRBLK4_TOKEN: - if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_TOP_LEVEL) - { - SLang_verror (SL_SYNTAX_ERROR, "misplaced USER_BLOCK"); - break; - } - bc_sub_type = _SLANG_BCST_USER_BLOCK0 + (t->type - USRBLK0_TOKEN); - break; - - case NOTELSE_TOKEN: - bc_sub_type = _SLANG_BCST_NOTELSE; - break; - - case ELSE_TOKEN: - bc_sub_type = _SLANG_BCST_ELSE; - break; - - case LOOP_TOKEN: - bc_sub_type = _SLANG_BCST_LOOP; - break; - - case DOWHILE_TOKEN: - bc_sub_type = _SLANG_BCST_DOWHILE; - break; - - case WHILE_TOKEN: - bc_sub_type = _SLANG_BCST_WHILE; - break; - - case ORELSE_TOKEN: - bc_sub_type = _SLANG_BCST_ORELSE; - break; - - case _FOR_TOKEN: - bc_sub_type = _SLANG_BCST_FOR; - break; - - case FOR_TOKEN: - bc_sub_type = _SLANG_BCST_CFOR; - break; - - case FOREACH_TOKEN: - bc_sub_type = _SLANG_BCST_FOREACH; - break; - - case OBRACE_TOKEN: - lang_begin_block (); - break; - - default: - SLang_verror (SL_SYNTAX_ERROR, "Expecting directive token. Found 0x%X", t->type); - break; - } - - /* Reset this pointer first because compile_directive may cause a - * file to be loaded. - */ - Compile_Mode_Function = compile_basic_token_mode; - - if (bc_sub_type != -1) - compile_directive (bc_sub_type); -} - -static unsigned int Assign_Mode_Type; -static void compile_assign_mode (_SLang_Token_Type *t) -{ - if (t->type != IDENT_TOKEN) - { - SLang_verror (SL_SYNTAX_ERROR, "Expecting identifier for assignment"); - return; - } - - compile_assign (Assign_Mode_Type, t->v.s_val, t->hash); - Compile_Mode_Function = compile_basic_token_mode; -} - -static void compile_basic_token_mode (_SLang_Token_Type *t) -{ - if (-1 == lang_check_space ()) - return; - - switch (t->type) - { - case PUSH_TOKEN: - case NOP_TOKEN: - case EOF_TOKEN: - case READONLY_TOKEN: - case DO_TOKEN: - case VARIABLE_TOKEN: - case SEMICOLON_TOKEN: - default: - SLang_verror (SL_SYNTAX_ERROR, "Unknown or unsupported token type 0x%X", t->type); - break; - - case DEREF_TOKEN: - compile_call_direct (dereference_object, _SLANG_BC_CALL_DIRECT); - break; - - case STRUCT_TOKEN: - compile_call_direct (_SLstruct_define_struct, _SLANG_BC_CALL_DIRECT); - break; - - case TYPEDEF_TOKEN: - compile_call_direct (_SLstruct_define_typedef, _SLANG_BC_CALL_DIRECT); - break; - - case TMP_TOKEN: - compile_tmp_variable (t->v.s_val, t->hash); - break; - - case DOT_TOKEN: /* X . field */ - compile_dot (t); - break; - - case COMMA_TOKEN: - break; /* do nothing */ - - case IDENT_TOKEN: - compile_hashed_identifier (t->v.s_val, t->hash, t); - break; - - case _REF_TOKEN: - compile_ref (t->v.s_val, t->hash); - break; - - case ARG_TOKEN: - compile_call_direct (SLang_start_arg_list, _SLANG_BC_CALL_DIRECT); - break; - - case EARG_TOKEN: - compile_lvar_call_direct (SLang_end_arg_list, _SLANG_BC_EARG_LVARIABLE, _SLANG_BC_CALL_DIRECT); - break; - - case COLON_TOKEN: - if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_BLOCK) - compile_simple (_SLANG_BC_LABEL); - else SLang_Error = SL_SYNTAX_ERROR; - break; - - case POP_TOKEN: - compile_call_direct (SLdo_pop, _SLANG_BC_CALL_DIRECT); - break; - - case CASE_TOKEN: - if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK) - SLang_verror (SL_SYNTAX_ERROR, "Misplaced 'case'"); - else - compile_call_direct (case_function, _SLANG_BC_CALL_DIRECT); - break; - - case CHAR_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_CHAR_TYPE); - break; - case SHORT_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_SHORT_TYPE); - break; - case INT_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL_INT, SLANG_INT_TYPE); - break; - case UCHAR_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_UCHAR_TYPE); - break; - case USHORT_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_USHORT_TYPE); - break; - case UINT_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL_INT, SLANG_UINT_TYPE); - break; - case LONG_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_LONG_TYPE); - break; - case ULONG_TOKEN: - compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_ULONG_TYPE); - break; - -#if SLANG_HAS_FLOAT - case FLOAT_TOKEN: - compile_float (t->v.s_val); - break; - - case DOUBLE_TOKEN: - compile_double (t->v.s_val, SLANG_DOUBLE_TYPE); - break; -#endif -#if SLANG_HAS_COMPLEX - case COMPLEX_TOKEN: - compile_double (t->v.s_val, SLANG_COMPLEX_TYPE); - break; -#endif - - case STRING_TOKEN: - compile_string (t->v.s_val, t->hash); - break; - - case _BSTRING_TOKEN: - compile_bstring (SLbstring_create ((unsigned char *)t->v.s_val, (unsigned int) t->hash)); - break; - - case BSTRING_TOKEN: - compile_bstring (t->v.b_val); - break; - - case _NULL_TOKEN: - compile_identifier ("NULL", t); - break; - - case _INLINE_WILDCARD_ARRAY_TOKEN: - compile_call_direct (_SLarray_wildcard_array, _SLANG_BC_CALL_DIRECT); - break; - - case _INLINE_ARRAY_TOKEN: - compile_call_direct (_SLarray_inline_array, _SLANG_BC_CALL_DIRECT_FRAME); - break; - - case _INLINE_IMPLICIT_ARRAY_TOKEN: - compile_call_direct (_SLarray_inline_implicit_array, _SLANG_BC_CALL_DIRECT_FRAME); - break; - - case ARRAY_TOKEN: - compile_lvar_call_direct (_SLarray_aget, _SLANG_BC_LVARIABLE_AGET, _SLANG_BC_CALL_DIRECT_FRAME); - break; - - /* Note: I need to add the other _ARRAY assign tokens. */ - case _ARRAY_PLUSEQS_TOKEN: - case _ARRAY_MINUSEQS_TOKEN: - case _ARRAY_TIMESEQS_TOKEN: - case _ARRAY_DIVEQS_TOKEN: - case _ARRAY_BOREQS_TOKEN: - case _ARRAY_BANDEQS_TOKEN: - case _ARRAY_POST_MINUSMINUS_TOKEN: - case _ARRAY_MINUSMINUS_TOKEN: - case _ARRAY_POST_PLUSPLUS_TOKEN: - case _ARRAY_PLUSPLUS_TOKEN: - compile_array_assign (t); - break; - - case _ARRAY_ASSIGN_TOKEN: - compile_lvar_call_direct (_SLarray_aput, _SLANG_BC_LVARIABLE_APUT, _SLANG_BC_CALL_DIRECT_FRAME); - break; - - case _STRUCT_ASSIGN_TOKEN: - case _STRUCT_PLUSEQS_TOKEN: - case _STRUCT_MINUSEQS_TOKEN: - case _STRUCT_TIMESEQS_TOKEN: - case _STRUCT_DIVEQS_TOKEN: - case _STRUCT_BOREQS_TOKEN: - case _STRUCT_BANDEQS_TOKEN: - case _STRUCT_POST_MINUSMINUS_TOKEN: - case _STRUCT_MINUSMINUS_TOKEN: - case _STRUCT_POST_PLUSPLUS_TOKEN: - case _STRUCT_PLUSPLUS_TOKEN: - compile_struct_assign (t); - break; - - case _SCALAR_ASSIGN_TOKEN: - case _SCALAR_PLUSEQS_TOKEN: - case _SCALAR_MINUSEQS_TOKEN: - case _SCALAR_TIMESEQS_TOKEN: - case _SCALAR_DIVEQS_TOKEN: - case _SCALAR_BOREQS_TOKEN: - case _SCALAR_BANDEQS_TOKEN: - case _SCALAR_POST_MINUSMINUS_TOKEN: - case _SCALAR_MINUSMINUS_TOKEN: - case _SCALAR_POST_PLUSPLUS_TOKEN: - case _SCALAR_PLUSPLUS_TOKEN: - compile_assign (_SLANG_BCST_ASSIGN + (t->type - _SCALAR_ASSIGN_TOKEN), - t->v.s_val, t->hash); - break; - - case _DEREF_ASSIGN_TOKEN: - compile_deref_assign (t->v.s_val, t->hash); - break; - - /* For processing RPN tokens */ - case ASSIGN_TOKEN: - case PLUSEQS_TOKEN: - case MINUSEQS_TOKEN: - case TIMESEQS_TOKEN: - case DIVEQS_TOKEN: - case BOREQS_TOKEN: - case BANDEQS_TOKEN: - case POST_MINUSMINUS_TOKEN: - case MINUSMINUS_TOKEN: - case POST_PLUSPLUS_TOKEN: - case PLUSPLUS_TOKEN: - Compile_Mode_Function = compile_assign_mode; - Assign_Mode_Type = _SLANG_BCST_ASSIGN + (t->type - ASSIGN_TOKEN); - break; - - case LT_TOKEN: - compile_binary (SLANG_LT); - break; - - case LE_TOKEN: - compile_binary (SLANG_LE); - break; - - case GT_TOKEN: - compile_binary (SLANG_GT); - break; - - case GE_TOKEN: - compile_binary (SLANG_GE); - break; - - case EQ_TOKEN: - compile_binary (SLANG_EQ); - break; - - case NE_TOKEN: - compile_binary (SLANG_NE); - break; - - case AND_TOKEN: - compile_binary (SLANG_AND); - break; - - case ADD_TOKEN: - compile_fast_binary (SLANG_PLUS, _SLANG_BC_INTEGER_PLUS); - break; - - case SUB_TOKEN: - compile_fast_binary (SLANG_MINUS, _SLANG_BC_INTEGER_MINUS); - break; - - case TIMES_TOKEN: - compile_binary (SLANG_TIMES); - break; - - case DIV_TOKEN: - compile_binary (SLANG_DIVIDE); - break; - - case POW_TOKEN: - compile_binary (SLANG_POW); - break; - - case BXOR_TOKEN: - compile_binary (SLANG_BXOR); - break; - - case BAND_TOKEN: - compile_binary (SLANG_BAND); - break; - - case BOR_TOKEN: - compile_binary (SLANG_BOR); - break; - - case SHR_TOKEN: - compile_binary (SLANG_SHR); - break; - - case SHL_TOKEN: - compile_binary (SLANG_SHL); - break; - - case MOD_TOKEN: - compile_binary (SLANG_MOD); - break; - - case OR_TOKEN: - compile_binary (SLANG_OR); - break; - - case NOT_TOKEN: - compile_unary (SLANG_NOT, _SLANG_BC_UNARY); - break; - - case BNOT_TOKEN: - compile_unary (SLANG_BNOT, _SLANG_BC_UNARY); - break; - - case MUL2_TOKEN: - compile_unary (SLANG_MUL2, _SLANG_BC_UNARY_FUNC); - break; - - case CHS_TOKEN: - compile_unary (SLANG_CHS, _SLANG_BC_UNARY_FUNC); - break; - - case ABS_TOKEN: - compile_unary (SLANG_ABS, _SLANG_BC_UNARY_FUNC); - break; - - case SQR_TOKEN: - compile_unary (SLANG_SQR, _SLANG_BC_UNARY_FUNC); - break; - - case SIGN_TOKEN: - compile_unary (SLANG_SIGN, _SLANG_BC_UNARY_FUNC); - break; - - case BREAK_TOKEN: - compile_break (_SLANG_BC_BREAK, 1, 0, "break"); - break; - - case RETURN_TOKEN: - compile_break (_SLANG_BC_RETURN, 0, 1, "return"); - break; - - case CONT_TOKEN: - compile_break (_SLANG_BC_CONTINUE, 1, 0, "continue"); - break; - - case EXCH_TOKEN: - compile_break (_SLANG_BC_EXCH, 0, 0, ""); /* FIXME: Priority=low */ - break; - - case STATIC_TOKEN: - if (Lang_Defining_Function == 0) - Compile_Mode_Function = compile_static_variable_mode; - else - SLang_verror (SL_NOT_IMPLEMENTED, "static variables not permitted in functions"); - break; - - case PRIVATE_TOKEN: - if (Lang_Defining_Function == 0) - Compile_Mode_Function = compile_private_variable_mode; - else - SLang_verror (SL_NOT_IMPLEMENTED, "private variables not permitted in functions"); - break; - - case PUBLIC_TOKEN: - if (Lang_Defining_Function == 0) - Compile_Mode_Function = compile_public_variable_mode; - else - SLang_verror (SL_NOT_IMPLEMENTED, "public variables not permitted in functions"); - break; - - case OBRACKET_TOKEN: - if (Lang_Defining_Function == 0) - Compile_Mode_Function = Default_Variable_Mode; - else - Compile_Mode_Function = compile_local_variable_mode; - break; - - case OPAREN_TOKEN: - lang_begin_function (); - break; - - case DEFINE_STATIC_TOKEN: - if (Lang_Defining_Function) - define_static_function (t->v.s_val, t->hash); - else SLang_Error = SL_SYNTAX_ERROR; - break; - - case DEFINE_PRIVATE_TOKEN: - if (Lang_Defining_Function) - define_private_function (t->v.s_val, t->hash); - else SLang_Error = SL_SYNTAX_ERROR; - break; - - case DEFINE_PUBLIC_TOKEN: - if (Lang_Defining_Function) - define_public_function (t->v.s_val, t->hash); - else SLang_Error = SL_SYNTAX_ERROR; - break; - - case DEFINE_TOKEN: - if (Lang_Defining_Function) - (*Default_Define_Function) (t->v.s_val, t->hash); - else - SLang_Error = SL_SYNTAX_ERROR; - break; - - case CPAREN_TOKEN: - if (Lang_Defining_Function) - Compile_Mode_Function = compile_function_mode; - else SLang_Error = SL_SYNTAX_ERROR; - break; - - case CBRACE_TOKEN: - lang_end_block (); - Compile_Mode_Function = compile_directive_mode; - break; - - case OBRACE_TOKEN: - lang_begin_block (); - break; - - case FARG_TOKEN: - Function_Args_Number = Local_Variable_Number; - break; - -#if _SLANG_HAS_DEBUG_CODE - case LINE_NUM_TOKEN: - Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LINE_NUM; - Compile_ByteCode_Ptr->b.l_blk = t->v.long_val; - lang_try_now (); - break; -#endif - case POUND_TOKEN: - compile_call_direct (_SLarray_matrix_multiply, _SLANG_BC_CALL_DIRECT); - break; - } -} - -void _SLcompile (_SLang_Token_Type *t) -{ - if (SLang_Error == 0) - { - if (Compile_Mode_Function != compile_basic_token_mode) - { - if (Compile_Mode_Function == NULL) - Compile_Mode_Function = compile_basic_token_mode; -#if _SLANG_HAS_DEBUG_CODE - if (t->type == LINE_NUM_TOKEN) - { - compile_basic_token_mode (t); - return; - } -#endif - } - - (*Compile_Mode_Function) (t); - } - - if (SLang_Error) - { - Compile_Mode_Function = compile_basic_token_mode; - SLang_restart (0); - } -} - -void (*_SLcompile_ptr)(_SLang_Token_Type *) = _SLcompile; - -typedef struct _Compile_Context_Type -{ - struct _Compile_Context_Type *next; - SLang_NameSpace_Type *static_namespace; - void (*compile_variable_mode) (_SLang_Token_Type *); - void (*define_function) (char *, unsigned long); - int lang_defining_function; - int local_variable_number; - unsigned int function_args_number; - SLang_Name_Type **locals_hash_table; - void (*compile_mode_function)(_SLang_Token_Type *); -#if _SLANG_HAS_DEBUG_CODE - char *compile_filename; -#endif -} -Compile_Context_Type; - -static Compile_Context_Type *Compile_Context_Stack; - -/* The only way the push/pop_context functions can get called is via - * an eval type function. That can only happen when executed from a - * top level block. This means that Compile_ByteCode_Ptr can always be - * rest back to the beginning of a block. - */ - -static int pop_compile_context (void) -{ - Compile_Context_Type *cc; - - if (NULL == (cc = Compile_Context_Stack)) - return -1; - - This_Static_NameSpace = cc->static_namespace; - Compile_Context_Stack = cc->next; - Default_Variable_Mode = cc->compile_variable_mode; - Default_Define_Function = cc->define_function; - Compile_Mode_Function = cc->compile_mode_function; - - Lang_Defining_Function = cc->lang_defining_function; - Local_Variable_Number = cc->local_variable_number; - Function_Args_Number = cc->function_args_number; - -#if _SLANG_HAS_DEBUG_CODE - SLang_free_slstring (This_Compile_Filename); - This_Compile_Filename = cc->compile_filename; -#endif - - SLfree ((char *) Locals_Hash_Table); - Locals_Hash_Table = cc->locals_hash_table; - - SLfree ((char *) cc); - - return 0; -} - -static int push_compile_context (char *name) -{ - Compile_Context_Type *cc; - SLang_Name_Type **lns; - - cc = (Compile_Context_Type *)SLmalloc (sizeof (Compile_Context_Type)); - if (cc == NULL) - return -1; - memset ((char *) cc, 0, sizeof (Compile_Context_Type)); - - lns = (SLang_Name_Type **) SLcalloc (sizeof (SLang_Name_Type *), SLLOCALS_HASH_TABLE_SIZE); - if (lns == NULL) - { - SLfree ((char *) cc); - return -1; - } - -#if _SLANG_HAS_DEBUG_CODE - if ((name != NULL) - && (NULL == (name = SLang_create_slstring (name)))) - { - SLfree ((char *) cc); - SLfree ((char *) lns); - return -1; - } - - cc->compile_filename = This_Compile_Filename; - This_Compile_Filename = name; -#endif - - cc->static_namespace = This_Static_NameSpace; - cc->compile_variable_mode = Default_Variable_Mode; - cc->define_function = Default_Define_Function; - cc->locals_hash_table = Locals_Hash_Table; - - cc->lang_defining_function = Lang_Defining_Function; - cc->local_variable_number = Local_Variable_Number; - cc->function_args_number = Function_Args_Number; - cc->locals_hash_table = Locals_Hash_Table; - cc->compile_mode_function = Compile_Mode_Function; - - cc->next = Compile_Context_Stack; - Compile_Context_Stack = cc; - - Compile_Mode_Function = compile_basic_token_mode; - Default_Variable_Mode = compile_public_variable_mode; - Default_Define_Function = define_public_function; - Lang_Defining_Function = 0; - Local_Variable_Number = 0; - Function_Args_Number = 0; - Locals_Hash_Table = lns; - return 0; -} - -static int init_interpreter (void) -{ - SLang_NameSpace_Type *ns; - - if (Global_NameSpace != NULL) - return 0; - - if (NULL == (ns = _SLns_allocate_namespace ("***GLOBAL***", SLGLOBALS_HASH_TABLE_SIZE))) - return -1; - if (-1 == _SLns_set_namespace_name (ns, "Global")) - return -1; - Global_NameSpace = ns; - - _SLRun_Stack = (SLang_Object_Type *) SLcalloc (SLANG_MAX_STACK_LEN, - sizeof (SLang_Object_Type)); - if (_SLRun_Stack == NULL) - return -1; - - _SLStack_Pointer = _SLRun_Stack; - _SLStack_Pointer_Max = _SLRun_Stack + SLANG_MAX_STACK_LEN; - - SLShort_Blocks[0].bc_main_type = _SLANG_BC_RETURN; - SLShort_Blocks[2].bc_main_type = _SLANG_BC_BREAK; - SLShort_Blocks[4].bc_main_type = _SLANG_BC_CONTINUE; - - Num_Args_Stack = (int *) SLmalloc (sizeof (int) * SLANG_MAX_RECURSIVE_DEPTH); - if (Num_Args_Stack == NULL) - { - SLfree ((char *) _SLRun_Stack); - return -1; - } - Recursion_Depth = 0; - Frame_Pointer_Stack = (unsigned int *) SLmalloc (sizeof (unsigned int) * SLANG_MAX_RECURSIVE_DEPTH); - if (Frame_Pointer_Stack == NULL) - { - SLfree ((char *) _SLRun_Stack); - SLfree ((char *)Num_Args_Stack); - return -1; - } - Frame_Pointer_Depth = 0; - Frame_Pointer = _SLRun_Stack; - - Default_Variable_Mode = compile_public_variable_mode; - Default_Define_Function = define_public_function; - return 0; -} - -static int add_generic_table (SLang_NameSpace_Type *ns, - SLang_Name_Type *table, char *pp_name, - unsigned int entry_len) -{ - SLang_Name_Type *t, **ns_table; - char *name; - unsigned int table_size; - - if (-1 == init_interpreter ()) - return -1; - - if (ns == NULL) - ns = Global_NameSpace; - - ns_table = ns->table; - table_size = ns->table_size; - - if ((pp_name != NULL) - && (-1 == SLdefine_for_ifdef (pp_name))) - return -1; - - t = table; - while (NULL != (name = t->name)) - { - unsigned long hash; - - /* Backward compatibility: '.' WAS used as hash marker */ - if (*name == '.') - { - name++; - t->name = name; - } - - if (NULL == (name = SLang_create_slstring (name))) - return -1; - - t->name = name; - - hash = _SLcompute_string_hash (name); - hash = hash % table_size; - - t->next = ns_table [(unsigned int) hash]; - ns_table [(unsigned int) hash] = t; - - t = (SLang_Name_Type *) ((char *)t + entry_len); - } - - return 0; -} - -int SLadd_intrin_fun_table (SLang_Intrin_Fun_Type *tbl, char *pp) -{ - return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Fun_Type)); -} - -int SLadd_intrin_var_table (SLang_Intrin_Var_Type *tbl, char *pp) -{ - return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Var_Type)); -} - -int SLadd_app_unary_table (SLang_App_Unary_Type *tbl, char *pp) -{ - return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_App_Unary_Type)); -} - -int SLadd_math_unary_table (SLang_Math_Unary_Type *tbl, char *pp) -{ - return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Math_Unary_Type)); -} - -int SLadd_iconstant_table (SLang_IConstant_Type *tbl, char *pp) -{ - return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_IConstant_Type)); -} - -#if SLANG_HAS_FLOAT -int SLadd_dconstant_table (SLang_DConstant_Type *tbl, char *pp) -{ - return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_DConstant_Type)); -} -#endif - -/* ----------- */ -int SLns_add_intrin_fun_table (SLang_NameSpace_Type *ns, SLang_Intrin_Fun_Type *tbl, char *pp) -{ - return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Fun_Type)); -} - -int SLns_add_intrin_var_table (SLang_NameSpace_Type *ns, SLang_Intrin_Var_Type *tbl, char *pp) -{ - return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Var_Type)); -} - -int SLns_add_app_unary_table (SLang_NameSpace_Type *ns, SLang_App_Unary_Type *tbl, char *pp) -{ - return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_App_Unary_Type)); -} - -int SLns_add_math_unary_table (SLang_NameSpace_Type *ns, SLang_Math_Unary_Type *tbl, char *pp) -{ - return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Math_Unary_Type)); -} - -int SLns_add_iconstant_table (SLang_NameSpace_Type *ns, SLang_IConstant_Type *tbl, char *pp) -{ - return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_IConstant_Type)); -} - -#if SLANG_HAS_FLOAT -int SLns_add_dconstant_table (SLang_NameSpace_Type *ns, SLang_DConstant_Type *tbl, char *pp) -{ - return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_DConstant_Type)); -} -#endif - -/* what is a bitmapped value: - * 1 intrin fun - * 2 user fun - * 4 intrin var - * 8 user defined var - */ -SLang_Array_Type *_SLang_apropos (char *namespace_name, char *pat, unsigned int what) -{ - SLang_NameSpace_Type *ns; - - if (namespace_name == NULL) - namespace_name = "Global"; - - if (*namespace_name == 0) - ns = This_Static_NameSpace; - else ns = _SLns_find_namespace (namespace_name); - - return _SLnspace_apropos (ns, pat, what); -} - -void _SLang_implements_intrinsic (char *name) -{ - if (This_Static_NameSpace == NULL) - { - SLang_verror (SL_INTRINSIC_ERROR, "No namespace available"); - return; - } - - (void) _SLns_set_namespace_name (This_Static_NameSpace, name); - - Default_Define_Function = define_static_function; - Default_Variable_Mode = compile_static_variable_mode; -} - -void _SLang_use_namespace_intrinsic (char *name) -{ - SLang_NameSpace_Type *ns; - - if (NULL == (ns = _SLns_find_namespace (name))) - { - SLang_verror (SL_INTRINSIC_ERROR, "Namespace %s does not exist", name); - return; - } - This_Static_NameSpace = ns; - if (Global_NameSpace == ns) - { - Default_Define_Function = define_public_function; - Default_Variable_Mode = compile_public_variable_mode; - } - else - { - Default_Define_Function = define_static_function; - Default_Variable_Mode = compile_static_variable_mode; - } -} - - -char *_SLang_cur_namespace_intrinsic (void) -{ - if (This_Static_NameSpace == NULL) - return "Global"; - - if (This_Static_NameSpace->namespace_name == NULL) - return ""; - - return This_Static_NameSpace->namespace_name; -} diff --git a/mdk-stage1/slang/slang.h b/mdk-stage1/slang/slang.h deleted file mode 100644 index 900b14043..000000000 --- a/mdk-stage1/slang/slang.h +++ /dev/null @@ -1,1930 +0,0 @@ -#ifndef DAVIS_SLANG_H_ -#define DAVIS_SLANG_H_ -/* -*- mode: C; mode: fold; -*- */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#define SLANG_VERSION 10404 -#define SLANG_VERSION_STRING "1.4.4" - -/*{{{ System Dependent Macros and Typedefs */ - -#if defined(__WATCOMC__) && defined(DOS) -# ifndef __MSDOS__ -# define __MSDOS__ -# endif -# ifndef DOS386 -# define DOS386 -# endif -# ifndef IBMPC_SYSTEM -# define IBMPC_SYSTEM -# endif -#endif /* __watcomc__ */ - -#if defined(unix) || defined(__unix) -# ifndef __unix__ -# define __unix__ 1 -# endif -#endif - -#if !defined(__GO32__) -# ifdef __unix__ -# define REAL_UNIX_SYSTEM -# endif -#endif - -/* Set of the various defines for pc systems. This includes OS/2 */ -#ifdef __GO32__ -# ifndef __DJGPP__ -# define __DJGPP__ 1 -# endif -# ifndef IBMPC_SYSTEM -# define IBMPC_SYSTEM -# endif -#endif - -#ifdef __BORLANDC__ -# ifndef IBMPC_SYSTEM -# define IBMPC_SYSTEM -# endif -#endif - -#ifdef __MSDOS__ -# ifndef IBMPC_SYSTEM -# define IBMPC_SYSTEM -# endif -#endif - -#if defined(OS2) || defined(__os2__) -# ifndef IBMPC_SYSTEM -# define IBMPC_SYSTEM -# endif -# ifndef __os2__ -# define __os2__ -# endif -#endif - -#if defined(__NT__) || defined(__MINGW32__) || defined(__CYGWIN32__) -# ifndef IBMPC_SYSTEM -# define IBMPC_SYSTEM -# endif -#endif - -#if defined(IBMPC_SYSTEM) || defined(VMS) -# ifdef REAL_UNIX_SYSTEM -# undef REAL_UNIX_SYSTEM -# endif -#endif - -#ifdef __cplusplus -extern "C" { -#endif -#if 0 -} -#endif - -#include <stdio.h> -#include <stdarg.h> -#if defined(__STDC__) || defined(__BORLANDC__) || defined(__cplusplus) -# include <stddef.h> /* for offsetof */ -#endif - -/* ---------------------------- Generic Macros ----------------------------- */ - -/* __SC__ is defined for Symantec C++ - DOS386 is defined for -mx memory model, 32 bit DOS extender. */ - -#if defined(__SC__) && !defined(DOS386) -# include <dos.h> -#endif - -#if defined(__BORLANDC__) -# include <alloc.h> -#endif - -#if defined (__cplusplus) || defined(__STDC__) || defined(IBMPC_SYSTEM) - typedef void *VOID_STAR; -#else - typedef unsigned char *VOID_STAR; -#endif - -typedef int (*FVOID_STAR)(void); - -#if defined(__MSDOS_) && defined(__BORLANDC__) -# define SLFREE(buf) farfree((void far *)(buf)) -# define SLMALLOC(x) farmalloc((unsigned long) (x)) -# define SLREALLOC(buf, n) farrealloc((void far *) (buf), (unsigned long) (n)) -# define SLCALLOC(n, m) farcalloc((unsigned long) (n), (unsigned long) (m)) -#else -# if defined(VMS) && !defined(__DECC) -# define SLFREE VAXC$FREE_OPT -# define SLMALLOC VAXC$MALLOC_OPT -# define SLREALLOC VAXC$REALLOC_OPT -# define SLCALLOC VAXC$CALLOC_OPT -# else -# define SLFREE(x) free((char *)(x)) -# define SLMALLOC malloc -# define SLREALLOC realloc -# define SLCALLOC calloc -# endif -#endif - - extern char *SLdebug_malloc (unsigned long); - extern char *SLdebug_calloc (unsigned long, unsigned long); - extern char *SLdebug_realloc (char *, unsigned long); - extern void SLdebug_free (char *); - extern void SLmalloc_dump_statistics (void); - extern char *SLstrcpy(register char *, register char *); - extern int SLstrcmp(register char *, register char *); - extern char *SLstrncpy(char *, register char *, register int); - - extern void SLmemset (char *, char, int); - extern char *SLmemchr (register char *, register char, register int); - extern char *SLmemcpy (char *, char *, int); - extern int SLmemcmp (char *, char *, int); - -/*}}}*/ - -/*{{{ Interpreter Typedefs */ - -typedef struct _SLang_Name_Type -{ - char *name; - struct _SLang_Name_Type *next; - char name_type; - /* These values must be less than 0x10 because they map directly - * to byte codes. See _slang.h. - */ -#define SLANG_LVARIABLE 0x01 -#define SLANG_GVARIABLE 0x02 -#define SLANG_IVARIABLE 0x03 /* intrinsic variables */ - /* Note!!! For Macro MAKE_VARIABLE below to work, SLANG_IVARIABLE Must - be 1 less than SLANG_RVARIABLE!!! */ -#define SLANG_RVARIABLE 0x04 /* read only variable */ -#define SLANG_INTRINSIC 0x05 -#define SLANG_FUNCTION 0x06 -#define SLANG_MATH_UNARY 0x07 -#define SLANG_APP_UNARY 0x08 -#define SLANG_ICONSTANT 0x09 -#define SLANG_DCONSTANT 0x0A -#define SLANG_PVARIABLE 0x0B /* private */ -#define SLANG_PFUNCTION 0x0C /* private */ - - /* Rest of fields depend on name type */ -} -SLang_Name_Type; - -typedef struct -{ - char *name; - struct _SLang_Name_Type *next; /* this is for the hash table */ - char name_type; - - FVOID_STAR i_fun; /* address of object */ - - /* Do not change this without modifying slang.c:execute_intrinsic_fun */ -#define SLANG_MAX_INTRIN_ARGS 7 - unsigned char arg_types [SLANG_MAX_INTRIN_ARGS]; - unsigned char num_args; - unsigned char return_type; -} -SLang_Intrin_Fun_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - - VOID_STAR addr; - unsigned char type; -} -SLang_Intrin_Var_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - - int unary_op; -} -SLang_App_Unary_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - - int unary_op; -} -SLang_Math_Unary_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - int i; -} -SLang_IConstant_Type; - -typedef struct -{ - char *name; - SLang_Name_Type *next; - char name_type; - double d; -} -SLang_DConstant_Type; - -typedef struct -{ - char *field_name; - unsigned int offset; - unsigned char type; - unsigned char read_only; -} -SLang_IStruct_Field_Type; - -extern int SLadd_intrin_fun_table (SLang_Intrin_Fun_Type *, char *); -extern int SLadd_intrin_var_table (SLang_Intrin_Var_Type *, char *); -extern int SLadd_app_unary_table (SLang_App_Unary_Type *, char *); -extern int SLadd_math_unary_table (SLang_Math_Unary_Type *, char *); -extern int SLadd_iconstant_table (SLang_IConstant_Type *, char *); -extern int SLadd_dconstant_table (SLang_DConstant_Type *, char *); -extern int SLadd_istruct_table (SLang_IStruct_Field_Type *, VOID_STAR, char *); - -typedef struct _SLang_NameSpace_Type SLang_NameSpace_Type; - -extern int SLns_add_intrin_fun_table (SLang_NameSpace_Type *, SLang_Intrin_Fun_Type *, char *); -extern int SLns_add_intrin_var_table (SLang_NameSpace_Type *, SLang_Intrin_Var_Type *, char *); -extern int SLns_add_app_unary_table (SLang_NameSpace_Type *, SLang_App_Unary_Type *, char *); -extern int SLns_add_math_unary_table (SLang_NameSpace_Type *, SLang_Math_Unary_Type *, char *); -extern int SLns_add_iconstant_table (SLang_NameSpace_Type *, SLang_IConstant_Type *, char *); -extern int SLns_add_dconstant_table (SLang_NameSpace_Type *, SLang_DConstant_Type *, char *); -extern int SLns_add_istruct_table (SLang_NameSpace_Type *, SLang_IStruct_Field_Type *, VOID_STAR, char *); - -extern SLang_NameSpace_Type *SLns_create_namespace (char *); -extern void SLns_delete_namespace (SLang_NameSpace_Type *); - -typedef struct SLang_Load_Type -{ - int type; - - VOID_STAR client_data; - /* Pointer to data that client needs for loading */ - - int auto_declare_globals; - /* if non-zero, undefined global variables are declared as static */ - - char *(*read)(struct SLang_Load_Type *); - /* function to call to read next line from obj. */ - - unsigned int line_num; - /* Number of lines read, used for error reporting */ - - int parse_level; - /* 0 if at top level of parsing */ - - char *name; - /* Name of this object, e.g., filename. This name should be unique because - * it alone determines the name space for static objects associated with - * the compilable unit. - */ - - unsigned long reserved[4]; - /* For future expansion */ -} SLang_Load_Type; - -extern SLang_Load_Type *SLallocate_load_type (char *); -extern void SLdeallocate_load_type (SLang_Load_Type *); - -/* Returns SLang_Error upon failure */ -extern int SLang_load_object (SLang_Load_Type *); -extern int (*SLang_Load_File_Hook)(char *); -extern int (*SLang_Auto_Declare_Var_Hook) (char *); - -extern int SLang_generate_debug_info (int); - - -#if defined(ultrix) && !defined(__GNUC__) -# ifndef NO_PROTOTYPES -# define NO_PROTOTYPES -# endif -#endif - -#ifndef NO_PROTOTYPES -# define _PROTO(x) x -#else -# define _PROTO(x) () -#endif - -typedef struct SL_OOBinary_Type -{ - unsigned char data_type; /* partner type for binary op */ - - int (*binary_function)_PROTO((int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR)); - - int (*binary_result) _PROTO((int, unsigned char, unsigned char, unsigned char *)); - struct SL_OOBinary_Type *next; -} -SL_OOBinary_Type; - -typedef struct _SL_Typecast_Type -{ - unsigned char data_type; /* to_type */ - int allow_implicit; - - int (*typecast)_PROTO((unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR)); - struct _SL_Typecast_Type *next; -} -SL_Typecast_Type; - -typedef struct _SLang_Struct_Type SLang_Struct_Type; - -#if defined(SL_APP_WANTS_FOREACH) -/* It is up to the application to define struct _SLang_Foreach_Context_Type */ -typedef struct _SLang_Foreach_Context_Type SLang_Foreach_Context_Type; -#else -typedef int SLang_Foreach_Context_Type; -#endif - -typedef struct -{ - unsigned char cl_class_type; -#define SLANG_CLASS_TYPE_MMT 0 -#define SLANG_CLASS_TYPE_SCALAR 1 -#define SLANG_CLASS_TYPE_VECTOR 2 -#define SLANG_CLASS_TYPE_PTR 3 - - unsigned int cl_data_type; /* SLANG_INTEGER_TYPE, etc... */ - char *cl_name; /* slstring type */ - - unsigned int cl_sizeof_type; - VOID_STAR cl_transfer_buf; /* cl_sizeof_type bytes*/ - - /* Methods */ - - /* Most of the method functions are prototyped: - * int method (unsigned char type, VOID_STAR addr); - * Here, @type@ represents the type of object that the method is asked - * to deal with. The second parameter @addr@ will contain the ADDRESS of - * the object. For example, if type is SLANG_INT_TYPE, then @addr@ will - * actually be int *. Similary, if type is SLANG_STRING_TYPE, - * then @addr@ will contain the address of the string, i.e., char **. - */ - - void (*cl_destroy)_PROTO((unsigned char, VOID_STAR)); - /* Prototype: void destroy(unsigned type, VOID_STAR val) - * Called to delete/free the object */ - - char *(*cl_string)_PROTO((unsigned char, VOID_STAR)); - /* Prototype: char *to_string (unsigned char t, VOID_STAR p); - * Here p is a pointer to the object for which a string representation - * is to be returned. The returned pointer is to be a MALLOCED string. - */ - - /* Prototype: void push(unsigned char type, VOID_STAR v); - * Push a copy of the object of type @type@ at address @v@ onto the - * stack. - */ - int (*cl_push)_PROTO((unsigned char, VOID_STAR)); - - /* Prototype: int pop(unsigned char type, VOID_STAR v); - * Pops value from stack and assign it to object, whose address is @v@. - */ - int (*cl_pop)_PROTO((unsigned char, VOID_STAR)); - - int (*cl_unary_op_result_type)_PROTO((int, unsigned char, unsigned char *)); - int (*cl_unary_op)_PROTO((int, unsigned char, VOID_STAR, unsigned int, VOID_STAR)); - - int (*cl_app_unary_op_result_type)_PROTO((int, unsigned char, unsigned char *)); - int (*cl_app_unary_op)_PROTO((int, unsigned char, VOID_STAR, unsigned int, VOID_STAR)); - - /* If this function is non-NULL, it will be called for sin, cos, etc... */ -#define SLMATH_SIN 1 -#define SLMATH_COS 2 -#define SLMATH_TAN 3 -#define SLMATH_ATAN 4 -#define SLMATH_ASIN 5 -#define SLMATH_ACOS 6 -#define SLMATH_EXP 7 -#define SLMATH_LOG 8 -#define SLMATH_SQRT 9 -#define SLMATH_LOG10 10 -#define SLMATH_REAL 11 -#define SLMATH_IMAG 12 -#define SLMATH_SINH 13 -#define SLMATH_COSH 14 -#define SLMATH_TANH 15 -#define SLMATH_ATANH 16 -#define SLMATH_ASINH 17 -#define SLMATH_ACOSH 18 -#define SLMATH_TODOUBLE 19 -#define SLMATH_CONJ 20 - - int (*cl_math_op)_PROTO((int, unsigned char, VOID_STAR, unsigned int, VOID_STAR)); - int (*cl_math_op_result_type)_PROTO((int, unsigned char, unsigned char *)); - - SL_OOBinary_Type *cl_binary_ops; - SL_Typecast_Type *cl_typecast_funs; - - void (*cl_byte_code_destroy)_PROTO((unsigned char, VOID_STAR)); - void (*cl_user_destroy_fun)_PROTO((unsigned char, VOID_STAR)); - int (*cl_init_array_object)_PROTO((unsigned char, VOID_STAR)); - int (*cl_datatype_deref)_PROTO((unsigned char)); - SLang_Struct_Type *cl_struct_def; - int (*cl_dereference) _PROTO((unsigned char, VOID_STAR)); - int (*cl_acopy) (unsigned char, VOID_STAR, VOID_STAR); - int (*cl_apop) _PROTO((unsigned char, VOID_STAR)); - int (*cl_apush) _PROTO((unsigned char, VOID_STAR)); - int (*cl_push_literal) _PROTO((unsigned char, VOID_STAR)); - void (*cl_adestroy)_PROTO((unsigned char, VOID_STAR)); - int (*cl_push_intrinsic)_PROTO((unsigned char, VOID_STAR)); - int (*cl_void_typecast)_PROTO((unsigned char, VOID_STAR, unsigned int, unsigned char, VOID_STAR)); - - int (*cl_anytype_typecast)_PROTO((unsigned char, VOID_STAR, unsigned int, unsigned char, VOID_STAR)); - - /* Array access functions */ - int (*cl_aput) (unsigned char, unsigned int); - int (*cl_aget) (unsigned char, unsigned int); - int (*cl_anew) (unsigned char, unsigned int); - - /* length method */ - int (*cl_length) (unsigned char, VOID_STAR, unsigned int *); - - /* foreach */ - SLang_Foreach_Context_Type *(*cl_foreach_open) (unsigned char, unsigned int); - void (*cl_foreach_close) (unsigned char, SLang_Foreach_Context_Type *); - int (*cl_foreach) (unsigned char, SLang_Foreach_Context_Type *); - - /* Structure access: get and put (assign to) fields */ - int (*cl_sput) (unsigned char, char *); - int (*cl_sget) (unsigned char, char *); - - /* File I/O */ - int (*cl_fread) (unsigned char, FILE *, VOID_STAR, unsigned int, unsigned int *); - int (*cl_fwrite) (unsigned char, FILE *, VOID_STAR, unsigned int, unsigned int *); - int (*cl_fdread) (unsigned char, int, VOID_STAR, unsigned int, unsigned int *); - int (*cl_fdwrite) (unsigned char, int, VOID_STAR, unsigned int, unsigned int *); - - int (*cl_to_bool) (unsigned char, int *); - - int (*cl_cmp)(unsigned char, VOID_STAR, VOID_STAR, int *); - -} SLang_Class_Type; - -/* These are the low-level functions for building push/pop methods. They - * know nothing about memory management. For SLANG_CLASS_TYPE_MMT, use the - * MMT push/pop functions instead. - */ -extern int SLclass_push_double_obj (unsigned char, double); -extern int SLclass_push_float_obj (unsigned char, float); -extern int SLclass_push_long_obj (unsigned char, long); -extern int SLclass_push_int_obj (unsigned char, int); -extern int SLclass_push_short_obj (unsigned char, short); -extern int SLclass_push_char_obj (unsigned char, char); -extern int SLclass_push_ptr_obj (unsigned char, VOID_STAR); -extern int SLclass_pop_double_obj (unsigned char, double *); -extern int SLclass_pop_float_obj (unsigned char, float *); -extern int SLclass_pop_long_obj (unsigned char, long *); -extern int SLclass_pop_int_obj (unsigned char, int *); -extern int SLclass_pop_short_obj (unsigned char, short *); -extern int SLclass_pop_char_obj (unsigned char, char *); -extern int SLclass_pop_ptr_obj (unsigned char, VOID_STAR *); - -extern SLang_Class_Type *SLclass_allocate_class (char *); -extern int SLclass_get_class_id (SLang_Class_Type *cl); -extern int SLclass_create_synonym (char *, unsigned char); -extern int SLclass_is_class_defined (unsigned char); - -extern int SLclass_register_class (SLang_Class_Type *, unsigned char, unsigned int, unsigned char); -extern int SLclass_set_string_function (SLang_Class_Type *, char *(*)(unsigned char, VOID_STAR)); -extern int SLclass_set_destroy_function (SLang_Class_Type *, void (*)(unsigned char, VOID_STAR)); -extern int SLclass_set_push_function (SLang_Class_Type *, int (*)(unsigned char, VOID_STAR)); -extern int SLclass_set_pop_function (SLang_Class_Type *, int (*)(unsigned char, VOID_STAR)); - -extern int SLclass_set_aget_function (SLang_Class_Type *, int (*)(unsigned char, unsigned int)); -extern int SLclass_set_aput_function (SLang_Class_Type *, int (*)(unsigned char, unsigned int)); -extern int SLclass_set_anew_function (SLang_Class_Type *, int (*)(unsigned char, unsigned int)); - -extern int SLclass_set_sget_function (SLang_Class_Type *, int (*)(unsigned char, char *)); -extern int SLclass_set_sput_function (SLang_Class_Type *, int (*)(unsigned char, char *)); - -/* Typecast object on the stack to type p1. p2 and p3 should be set to 1 */ -extern int SLclass_typecast (unsigned char, int, int); - -extern int SLclass_add_unary_op (unsigned char, - int (*) (int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*) (int, unsigned char, unsigned char *)); - -extern int -SLclass_add_app_unary_op (unsigned char, - int (*) (int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*) (int, unsigned char, unsigned char *)); - -extern int -SLclass_add_binary_op (unsigned char, unsigned char, - int (*) (int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*) (int, unsigned char, unsigned char, unsigned char *)); - -extern int -SLclass_add_math_op (unsigned char, - int (*)(int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*)(int, unsigned char, unsigned char *)); - -extern int -SLclass_add_typecast (unsigned char /* from */, unsigned char /* to */, - int (*)_PROTO((unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR)), - int /* allow implicit typecasts */ - ); - -extern char *SLclass_get_datatype_name (unsigned char); - -extern double SLcomplex_abs (double *); -extern double *SLcomplex_times (double *, double *, double *); -extern double *SLcomplex_divide (double *, double *, double *); -extern double *SLcomplex_sin (double *, double *); -extern double *SLcomplex_cos (double *, double *); -extern double *SLcomplex_tan (double *, double *); -extern double *SLcomplex_asin (double *, double *); -extern double *SLcomplex_acos (double *, double *); -extern double *SLcomplex_atan (double *, double *); -extern double *SLcomplex_exp (double *, double *); -extern double *SLcomplex_log (double *, double *); -extern double *SLcomplex_log10 (double *, double *); -extern double *SLcomplex_sqrt (double *, double *); -extern double *SLcomplex_sinh (double *, double *); -extern double *SLcomplex_cosh (double *, double *); -extern double *SLcomplex_tanh (double *, double *); -extern double *SLcomplex_pow (double *, double *, double *); -extern double SLmath_hypot (double x, double y); - -/* Not implemented yet */ -extern double *SLcomplex_asinh (double *, double *); -extern double *SLcomplex_acosh (double *, double *); -extern double *SLcomplex_atanh (double *, double *); - -#ifdef _SLANG_SOURCE_ -typedef struct _SLang_MMT_Type SLang_MMT_Type; -#else -typedef int SLang_MMT_Type; -#endif - -extern void SLang_free_mmt (SLang_MMT_Type *); -extern VOID_STAR SLang_object_from_mmt (SLang_MMT_Type *); -extern SLang_MMT_Type *SLang_create_mmt (unsigned char, VOID_STAR); -extern int SLang_push_mmt (SLang_MMT_Type *); -extern SLang_MMT_Type *SLang_pop_mmt (unsigned char); -extern void SLang_inc_mmt (SLang_MMT_Type *); - -/* Maximum number of dimensions of an array. */ -#define SLARRAY_MAX_DIMS 7 -typedef struct _SLang_Array_Type -{ - unsigned char data_type; - unsigned int sizeof_type; - VOID_STAR data; - unsigned int num_elements; - unsigned int num_dims; - int dims [SLARRAY_MAX_DIMS]; - VOID_STAR (*index_fun)_PROTO((struct _SLang_Array_Type *, int *)); - /* This function is designed to allow a type to store an array in - * any manner it chooses. This function returns the address of the data - * value at the specified index location. - */ - unsigned int flags; -#define SLARR_DATA_VALUE_IS_READ_ONLY 1 -#define SLARR_DATA_VALUE_IS_POINTER 2 -#define SLARR_DATA_VALUE_IS_RANGE 4 -#define SLARR_DATA_VALUE_IS_INTRINSIC 8 - SLang_Class_Type *cl; - unsigned int num_refs; -} -SLang_Array_Type; - -extern int SLang_pop_array_of_type (SLang_Array_Type **, unsigned char); -extern int SLang_pop_array (SLang_Array_Type **, int); -extern int SLang_push_array (SLang_Array_Type *, int); -extern void SLang_free_array (SLang_Array_Type *); -extern SLang_Array_Type *SLang_create_array (unsigned char, int, VOID_STAR, int *, unsigned int); -extern SLang_Array_Type *SLang_duplicate_array (SLang_Array_Type *); -extern int SLang_get_array_element (SLang_Array_Type *, int *, VOID_STAR); -extern int SLang_set_array_element (SLang_Array_Type *, int *, VOID_STAR); - - -/*}}}*/ - -/*{{{ Interpreter Function Prototypes */ - - extern volatile int SLang_Error; -/* Non zero if error occurs. Must be reset to zero to continue. */ -/* error codes, severe errors are less than 0 */ -#define SL_APPLICATION_ERROR -2 -#define SL_VARIABLE_UNINITIALIZED -3 -#define SL_INTERNAL_ERROR -5 -#define SL_STACK_OVERFLOW -6 -#define SL_STACK_UNDERFLOW -7 -#define SL_UNDEFINED_NAME -8 -#define SL_SYNTAX_ERROR -9 -#define SL_DUPLICATE_DEFINITION -10 -#define SL_TYPE_MISMATCH -11 -#define SL_OBJ_UNKNOWN -13 -#define SL_UNKNOWN_ERROR -14 -#define SL_TYPE_UNDEFINED_OP_ERROR -16 - -#define SL_INTRINSIC_ERROR 1 -/* Intrinsic error is an error generated by intrinsic functions */ -#define SL_USER_BREAK 2 -#define SL_DIVIDE_ERROR 3 -#define SL_OBJ_NOPEN 4 -#define SL_USER_ERROR 5 -#define SL_USAGE_ERROR 6 -#define SL_READONLY_ERROR 7 -#define SL_INVALID_PARM 8 -#define SL_NOT_IMPLEMENTED 9 -#define SL_MALLOC_ERROR 10 -#define SL_OVERFLOW 11 -#define SL_FLOATING_EXCEPTION 12 - -/* Compatibility */ -#define USER_BREAK SL_USER_BREAK -#define INTRINSIC_ERROR SL_INTRINSIC_ERROR - - extern int SLang_Traceback; - /* If non-zero, dump an S-Lang traceback upon error. Available as - _traceback in S-Lang. */ - - extern char *SLang_User_Prompt; - /* Prompt to use when reading from stdin */ - extern int SLang_Version; - extern char *SLang_Version_String; -extern char *SLang_Doc_Dir; - -extern void (*SLang_VMessage_Hook) (char *, va_list); -extern void SLang_vmessage (char *, ...); - - extern void (*SLang_Error_Hook)(char *); - /* Pointer to application dependent error messaging routine. By default, - messages are displayed on stderr. */ - - extern void (*SLang_Exit_Error_Hook)(char *, va_list); - extern void SLang_exit_error (char *, ...); - extern void (*SLang_Dump_Routine)(char *); - /* Called if S-Lang traceback is enabled as well as other debugging - routines (e.g., trace). By default, these messages go to stderr. */ - - extern void (*SLang_Interrupt)(void); - /* function to call whenever inner interpreter is entered. This is - a good place to set SLang_Error to USER_BREAK. */ - - extern void (*SLang_User_Clear_Error)(void); - /* function that gets called when '_clear_error' is called. */ - - /* If non null, these call C functions before and after a slang function. */ - extern void (*SLang_Enter_Function)(char *); -extern void (*SLang_Exit_Function)(char *); - -extern int SLang_Num_Function_Args; - -/* Functions: */ - -extern int SLang_init_all (void); -/* Initializes interpreter and all modules */ - -extern int SLang_init_slang (void); -/* This function is mandatory and must be called by all applications that - * use the interpreter - */ -extern int SLang_init_posix_process (void); /* process specific intrinsics */ -extern int SLang_init_stdio (void); /* fgets, etc. stdio functions */ -extern int SLang_init_posix_dir (void); -extern int SLang_init_ospath (void); - -extern int SLang_init_slmath (void); -/* called if math functions sin, cos, etc... are needed. */ - - extern int SLang_init_slfile (void); - extern int SLang_init_slunix (void); - /* These functions are obsolte. Use init_stdio, posix_process, etc. */ - -extern int SLang_init_slassoc (void); -/* Assoc Arrays (Hashes) */ - -extern int SLang_init_array (void); -/* Additional arrays functions: transpose, etc... */ - -/* Dynamic linking facility */ -extern int SLang_init_import (void); - - extern int SLang_load_file (char *); - /* Load a file of S-Lang code for interpreting. If the parameter is - * NULL, input comes from stdin. */ - - extern void SLang_restart(int); - /* should be called if an error occurs. If the passed integer is - * non-zero, items are popped off the stack; otherwise, the stack is - * left intact. Any time the stack is believed to be trashed, this routine - * should be called with a non-zero argument (e.g., if setjmp/longjmp is - * called). */ - - extern int SLang_byte_compile_file(char *, int); - /* takes a file of S-Lang code and ``byte-compiles'' it for faster - * loading. The new filename is equivalent to the old except that a `c' is - * appended to the name. (e.g., init.sl --> init.slc). The second - * specified the method; currently, it is not used. - */ - - extern int SLang_autoload(char *, char *); - /* Automatically load S-Lang function p1 from file p2. This function - is also available via S-Lang */ - - extern int SLang_load_string(char *); - /* Like SLang_load_file except input is from a null terminated string. */ - - extern int SLdo_pop(void); - /* pops item off stack and frees any memory associated with it */ - extern int SLdo_pop_n(unsigned int); - /* pops n items off stack and frees any memory associated with them */ - -extern int SLang_pop_integer(int *); -extern int SLang_pop_uinteger(unsigned int *); - /* pops integer *p0 from the stack. Returns 0 upon success and non-zero - * if the stack is empty or a type mismatch occurs, setting SLang_Error. - */ -extern int SLang_pop_char (char *); -extern int SLang_pop_uchar (unsigned char *); -extern int SLang_pop_short(short *); -extern int SLang_pop_ushort(unsigned short *); -extern int SLang_pop_long(long *); -extern int SLang_pop_ulong(unsigned long *); - -extern int SLang_pop_float(float *); -extern int SLang_pop_double(double *, int *, int *); - /* Pops double *p1 from stack. If *p3 is non-zero, *p1 was derived - from the integer *p2. Returns zero upon success. */ - - extern int SLang_pop_complex (double *, double *); - - extern int SLpop_string (char **); - extern int SLang_pop_string(char **, int *); - /* pops string *p0 from stack. If *p1 is non-zero, the string must be - * freed after its use. DO NOT FREE p0 if *p1 IS ZERO! Returns 0 upon - * success */ - - extern int SLang_push_complex (double, double); - - extern int SLang_push_char (char); - extern int SLang_push_uchar (unsigned char); - - extern int SLang_push_integer(int); - extern int SLang_push_uinteger(unsigned int); - /* push integer p1 on stack */ - - extern int SLang_push_short(short); - extern int SLang_push_ushort(unsigned short); - extern int SLang_push_long(long); - extern int SLang_push_ulong(unsigned long); - extern int SLang_push_float(float); - extern int SLang_push_double(double); - /* Push double onto stack */ - - extern int SLang_push_string(char *); - /* Push string p1 onto stack */ - - extern int SLang_push_malloced_string(char *); - /* The normal SLang_push_string pushes an slstring. This one converts - * a normally malloced string to an slstring, and then frees the - * malloced string. So, do NOT use the malloced string after calling - * this routine because it will be freed! The routine returns -1 upon - * error, but the string will be freed. - */ - -extern int SLang_push_null (void); -extern int SLang_pop_null (void); - -extern int SLang_push_value (unsigned char type, VOID_STAR); -extern int SLang_pop_value (unsigned char type, VOID_STAR); -extern void SLang_free_value (unsigned char type, VOID_STAR); - -typedef struct _SLang_Object_Type SLang_Any_Type; - -extern int SLang_pop_anytype (SLang_Any_Type **); -extern int SLang_push_anytype (SLang_Any_Type *); -extern void SLang_free_anytype (SLang_Any_Type *); - -#ifdef _SLANG_SOURCE_ -typedef struct _SLang_Ref_Type SLang_Ref_Type; -#else -typedef int SLang_Ref_Type; -#endif - -extern int SLang_pop_ref (SLang_Ref_Type **); -extern void SLang_free_ref (SLang_Ref_Type *); -extern int SLang_assign_to_ref (SLang_Ref_Type *, unsigned char, VOID_STAR); -extern SLang_Name_Type *SLang_pop_function (void); -extern SLang_Name_Type *SLang_get_fun_from_ref (SLang_Ref_Type *); -extern void SLang_free_function (SLang_Name_Type *f); - - extern int SLang_is_defined(char *); - /* Return non-zero is p1 is defined otherwise returns 0. */ - - extern int SLang_run_hooks(char *, unsigned int, ...); - /* calls S-Lang function p1 pushing p2 strings in the variable argument - * list onto the stack first. - * Returns -1 upon error, 1 if hooks exists and it ran, - * or 0 if hook does not exist. Thus it returns non-zero is hook was called. - */ - -/* These functions return 1 if the indicated function exists and the function - * runs without error. If the function does not exist, the function returns - * 0. Otherwise -1 is returned with SLang_Error set appropriately. - */ -extern int SLexecute_function (SLang_Name_Type *); -extern int SLang_execute_function(char *); - - -extern int SLang_end_arg_list (void); -extern int SLang_start_arg_list (void); - -extern void SLang_verror (int, char *, ...); - -extern void SLang_doerror(char *); - /* set SLang_Error and display p1 as error message */ - -extern int SLang_add_intrinsic_array (char *, /* name */ - unsigned char, /* type */ - int, /* readonly */ - VOID_STAR, /* data */ - unsigned int, ...); /* num dims */ - -extern int SLextract_list_element (char *, unsigned int, char, - char *, unsigned int); - -extern void SLexpand_escaped_string (register char *, register char *, - register char *); - -extern SLang_Name_Type *SLang_get_function (char *); -extern void SLang_release_function (SLang_Name_Type *); - -extern int SLreverse_stack (int); -extern int SLroll_stack (int); -/* If argument p is positive, the top p objects on the stack are rolled - * up. If negative, the stack is rolled down. - */ -extern int SLdup_n (int n); -/* Duplicate top n elements of stack */ - -extern int SLang_peek_at_stack1 (void); -extern int SLang_peek_at_stack (void); -/* Returns type of next object on stack-- -1 upon stack underflow. */ -extern void SLmake_lut (unsigned char *, unsigned char *, unsigned char); - - extern int SLang_guess_type (char *); - -extern int SLstruct_create_struct (unsigned int, - char **, - unsigned char *, - VOID_STAR *); - -/*}}}*/ - -/*{{{ Misc Functions */ - -/* This is an interface to atexit */ -extern int SLang_add_cleanup_function (void (*)(void)); - -extern char *SLmake_string (char *); -extern char *SLmake_nstring (char *, unsigned int); -/* Returns a null terminated string made from the first n characters of the - * string. - */ - -/* The string created by this routine must be freed by SLang_free_slstring - * and nothing else!! Also these strings must not be modified. Use - * SLmake_string if you intend to modify them!! - */ -extern char *SLang_create_nslstring (char *, unsigned int); -extern char *SLang_create_slstring (char *); -extern void SLang_free_slstring (char *); /* handles NULL */ -extern int SLang_pop_slstring (char **); /* free with SLang_free_slstring */ -extern char *SLang_concat_slstrings (char *a, char *b); -extern char *SLang_create_static_slstring (char *); /* adds a string that will not get deleted */ -extern void SLstring_dump_stats (void); - -/* Binary strings */ -/* The binary string is an opaque type. Use the SLbstring_get_pointer function - * to get a pointer and length. - */ -typedef struct _SLang_BString_Type SLang_BString_Type; -extern unsigned char *SLbstring_get_pointer (SLang_BString_Type *, unsigned int *); - -extern SLang_BString_Type *SLbstring_dup (SLang_BString_Type *); -extern SLang_BString_Type *SLbstring_create (unsigned char *, unsigned int); - -/* The create_malloced function used the first argument which is assumed - * to be a pointer to a len + 1 malloced string. The extra byte is for - * \0 termination. - */ -extern SLang_BString_Type *SLbstring_create_malloced (unsigned char *, unsigned int, int); - -/* Create a bstring from an slstring */ -extern SLang_BString_Type *SLbstring_create_slstring (char *); - -extern void SLbstring_free (SLang_BString_Type *); -extern int SLang_pop_bstring (SLang_BString_Type **); -extern int SLang_push_bstring (SLang_BString_Type *); - -extern char *SLmalloc (unsigned int); -extern char *SLcalloc (unsigned int, unsigned int); -extern void SLfree(char *); /* This function handles NULL */ -extern char *SLrealloc (char *, unsigned int); - -extern char *SLcurrent_time_string (void); - -extern int SLatoi(unsigned char *); -extern long SLatol (unsigned char *); -extern unsigned long SLatoul (unsigned char *); - -extern int SLang_pop_fileptr (SLang_MMT_Type **, FILE **); -extern char *SLang_get_name_from_fileptr (SLang_MMT_Type *); - -typedef struct _SLFile_FD_Type SLFile_FD_Type; -extern SLFile_FD_Type *SLfile_create_fd (char *, int); -extern void SLfile_free_fd (SLFile_FD_Type *); -extern int SLfile_push_fd (SLFile_FD_Type *); -extern int SLfile_pop_fd (SLFile_FD_Type **); -extern int SLfile_get_fd (SLFile_FD_Type *, int *); -extern SLFile_FD_Type *SLfile_dup_fd (SLFile_FD_Type *f0); -extern int SLang_init_posix_io (void); - -typedef double (*SLang_To_Double_Fun_Type)(VOID_STAR); -extern SLang_To_Double_Fun_Type SLarith_get_to_double_fun (unsigned char, unsigned int *); - -extern int SLang_set_argc_argv (int, char **); - -/*}}}*/ - -/*{{{ SLang getkey interface Functions */ - -#ifdef REAL_UNIX_SYSTEM -extern int SLang_TT_Baud_Rate; -extern int SLang_TT_Read_FD; -#endif - -extern int SLang_init_tty (int, int, int); -/* Initializes the tty for single character input. If the first parameter *p1 - * is in the range 0-255, it will be used for the abort character; - * otherwise, (unix only) if it is -1, the abort character will be the one - * used by the terminal. If the second parameter p2 is non-zero, flow - * control is enabled. If the last parmeter p3 is zero, output processing - * is NOT turned on. A value of zero is required for the screen management - * routines. Returns 0 upon success. In addition, if SLang_TT_Baud_Rate == - * 0 when this function is called, SLang will attempt to determine the - * terminals baud rate. As far as the SLang library is concerned, if - * SLang_TT_Baud_Rate is less than or equal to zero, the baud rate is - * effectively infinite. - */ - -extern void SLang_reset_tty (void); -/* Resets tty to what it was prior to a call to SLang_init_tty */ -#ifdef REAL_UNIX_SYSTEM -extern void SLtty_set_suspend_state (int); - /* If non-zero argument, terminal driver will be told to react to the - * suspend character. If 0, it will not. - */ -extern int (*SLang_getkey_intr_hook) (void); -#endif - -#define SLANG_GETKEY_ERROR 0xFFFF -extern unsigned int SLang_getkey (void); -/* reads a single key from the tty. If the read fails, 0xFFFF is returned. */ - -#ifdef IBMPC_SYSTEM -extern int SLgetkey_map_to_ansi (int); -#endif - -extern int SLang_ungetkey_string (unsigned char *, unsigned int); -extern int SLang_buffer_keystring (unsigned char *, unsigned int); -extern int SLang_ungetkey (unsigned char); -extern void SLang_flush_input (void); -extern int SLang_input_pending (int); -extern int SLang_Abort_Char; -/* The value of the character (0-255) used to trigger SIGINT */ -extern int SLang_Ignore_User_Abort; -/* If non-zero, pressing the abort character will not result in USER_BREAK - * SLang_Error. */ - -extern int SLang_set_abort_signal (void (*)(int)); -/* If SIGINT is generated, the function p1 will be called. If p1 is NULL - * the SLang_default signal handler is called. This sets SLang_Error to - * USER_BREAK. I suspect most users will simply want to pass NULL. - */ -extern unsigned int SLang_Input_Buffer_Len; - -extern volatile int SLKeyBoard_Quit; - -#ifdef VMS -/* If this function returns -1, ^Y will be added to input buffer. */ -extern int (*SLtty_VMS_Ctrl_Y_Hook) (void); -#endif -/*}}}*/ - -/*{{{ SLang Keymap routines */ - -typedef struct SLKeymap_Function_Type -{ - char *name; - int (*f)(void); -} -SLKeymap_Function_Type; - -#define SLANG_MAX_KEYMAP_KEY_SEQ 14 -typedef struct SLang_Key_Type -{ - struct SLang_Key_Type *next; - union - { - char *s; - FVOID_STAR f; - unsigned int keysym; - } - f; - unsigned char type; /* type of function */ -#define SLKEY_F_INTERPRET 0x01 -#define SLKEY_F_INTRINSIC 0x02 -#define SLKEY_F_KEYSYM 0x03 - unsigned char str[SLANG_MAX_KEYMAP_KEY_SEQ + 1];/* key sequence */ -} -SLang_Key_Type; - -typedef struct SLKeyMap_List_Type -{ - char *name; /* hashed string */ - SLang_Key_Type *keymap; - SLKeymap_Function_Type *functions; /* intrinsic functions */ -} -SLKeyMap_List_Type; - -/* This is arbitrary but I have got to start somewhere */ -#define SLANG_MAX_KEYMAPS 30 -extern SLKeyMap_List_Type SLKeyMap_List[SLANG_MAX_KEYMAPS]; - -extern char *SLang_process_keystring(char *); - -extern int SLkm_define_key (char *, FVOID_STAR, SLKeyMap_List_Type *); - -extern int SLang_define_key(char *, char *, SLKeyMap_List_Type *); -/* Like define_key1 except that p2 is a string that is to be associated with - * a function in the functions field of p3. This routine calls define_key1. - */ - -extern int SLkm_define_keysym (char *, unsigned int, SLKeyMap_List_Type *); - -extern void SLang_undefine_key(char *, SLKeyMap_List_Type *); - -extern SLKeyMap_List_Type *SLang_create_keymap(char *, SLKeyMap_List_Type *); -/* create and returns a pointer to a new keymap named p1 created by copying - * keymap p2. If p2 is NULL, it is up to the calling routine to initialize - * the keymap. - */ - -extern char *SLang_make_keystring(unsigned char *); - -extern SLang_Key_Type *SLang_do_key(SLKeyMap_List_Type *, int (*)(void)); -/* read a key using keymap p1 with getkey function p2 */ - -extern - FVOID_STAR - SLang_find_key_function(char *, SLKeyMap_List_Type *); - -extern SLKeyMap_List_Type *SLang_find_keymap(char *); - -extern int SLang_Last_Key_Char; -extern int SLang_Key_TimeOut_Flag; - -/*}}}*/ - -/*{{{ SLang Readline Interface */ - -typedef struct SLang_Read_Line_Type -{ - struct SLang_Read_Line_Type *prev, *next; - unsigned char *buf; - int buf_len; /* number of chars in the buffer */ - int num; /* num and misc are application specific*/ - int misc; -} SLang_Read_Line_Type; - -/* Maximum size of display */ -#define SLRL_DISPLAY_BUFFER_SIZE 256 - -typedef struct -{ - SLang_Read_Line_Type *root, *tail, *last; - unsigned char *buf; /* edit buffer */ - int buf_len; /* sizeof buffer */ - int point; /* current editing point */ - int tab; /* tab width */ - int len; /* current line size */ - - /* display variables */ - int edit_width; /* length of display field */ - int curs_pos; /* current column */ - int start_column; /* column offset of display */ - int dhscroll; /* amount to use for horiz scroll */ - char *prompt; - - FVOID_STAR last_fun; /* last function executed by rl */ - - /* These two contain an image of what is on the display */ - unsigned char upd_buf1[SLRL_DISPLAY_BUFFER_SIZE]; - unsigned char upd_buf2[SLRL_DISPLAY_BUFFER_SIZE]; - unsigned char *old_upd, *new_upd; /* pointers to previous two buffers */ - int new_upd_len, old_upd_len; /* length of output buffers */ - - SLKeyMap_List_Type *keymap; - - /* tty variables */ - unsigned int flags; /* */ -#define SL_RLINE_NO_ECHO 1 -#define SL_RLINE_USE_ANSI 2 -#define SL_RLINE_BLINK_MATCH 4 - unsigned int (*getkey)(void); /* getkey function -- required */ - void (*tt_goto_column)(int); - void (*tt_insert)(char); - void (*update_hook)(unsigned char *, int, int); - /* The update hook is called with a pointer to a buffer p1 that contains - * an image of what the update hook is suppoed to produce. The length - * of the buffer is p2 and after the update, the cursor is to be placed - * in column p3. - */ - /* This function is only called when blinking matches */ - int (*input_pending)(int); - unsigned long reserved[4]; -} SLang_RLine_Info_Type; - -extern int SLang_RL_EOF_Char; - -extern SLang_Read_Line_Type * SLang_rline_save_line (SLang_RLine_Info_Type *); -extern int SLang_init_readline (SLang_RLine_Info_Type *); -extern int SLang_read_line (SLang_RLine_Info_Type *); -extern int SLang_rline_insert (char *); -extern void SLrline_redraw (SLang_RLine_Info_Type *); -extern int SLang_Rline_Quit; - -/*}}}*/ - -/*{{{ Low Level Screen Output Interface */ - -extern unsigned long SLtt_Num_Chars_Output; -extern int SLtt_Baud_Rate; - -typedef unsigned long SLtt_Char_Type; - -#define SLTT_BOLD_MASK 0x01000000UL -#define SLTT_BLINK_MASK 0x02000000UL -#define SLTT_ULINE_MASK 0x04000000UL -#define SLTT_REV_MASK 0x08000000UL -#define SLTT_ALTC_MASK 0x10000000UL - -extern int SLtt_Screen_Rows; -extern int SLtt_Screen_Cols; -extern int SLtt_Term_Cannot_Insert; -extern int SLtt_Term_Cannot_Scroll; -extern int SLtt_Use_Ansi_Colors; -extern int SLtt_Ignore_Beep; -#if defined(REAL_UNIX_SYSTEM) -extern int SLtt_Force_Keypad_Init; -extern int SLang_TT_Write_FD; -#endif - -#ifndef IBMPC_SYSTEM -extern char *SLtt_Graphics_Char_Pairs; -#endif - -#ifndef __GO32__ -#if defined(VMS) || defined(REAL_UNIX_SYSTEM) -extern int SLtt_Blink_Mode; -extern int SLtt_Use_Blink_For_ACS; -extern int SLtt_Newline_Ok; -extern int SLtt_Has_Alt_Charset; -extern int SLtt_Has_Status_Line; /* if 0, NO. If > 0, YES, IF -1, ?? */ -# ifndef VMS -extern int SLtt_Try_Termcap; -# endif -#endif -#endif - -#if defined(IBMPC_SYSTEM) -extern int SLtt_Msdos_Cheap_Video; -#endif - -typedef unsigned short SLsmg_Char_Type; -#define SLSMG_EXTRACT_CHAR(x) ((x) & 0xFF) -#define SLSMG_EXTRACT_COLOR(x) (((x)>>8)&0xFF) -#define SLSMG_BUILD_CHAR(ch,color) (((SLsmg_Char_Type)(unsigned char)(ch))|((color)<<8)) - -extern int SLtt_flush_output (void); -extern void SLtt_set_scroll_region(int, int); -extern void SLtt_reset_scroll_region(void); -extern void SLtt_reverse_video (int); -extern void SLtt_bold_video (void); -extern void SLtt_begin_insert(void); -extern void SLtt_end_insert(void); -extern void SLtt_del_eol(void); -extern void SLtt_goto_rc (int, int); -extern void SLtt_delete_nlines(int); -extern void SLtt_delete_char(void); -extern void SLtt_erase_line(void); -extern void SLtt_normal_video(void); -extern void SLtt_cls(void); -extern void SLtt_beep(void); -extern void SLtt_reverse_index(int); -extern void SLtt_smart_puts(SLsmg_Char_Type *, SLsmg_Char_Type *, int, int); -extern void SLtt_write_string (char *); -extern void SLtt_putchar(char); -extern int SLtt_init_video (void); -extern int SLtt_reset_video (void); -extern void SLtt_get_terminfo(void); -extern void SLtt_get_screen_size (void); -extern int SLtt_set_cursor_visibility (int); - -extern int SLtt_set_mouse_mode (int, int); - -#if defined(VMS) || defined(REAL_UNIX_SYSTEM) -extern int SLtt_initialize (char *); -extern void SLtt_enable_cursor_keys(void); -extern void SLtt_set_term_vtxxx(int *); -extern void SLtt_set_color_esc (int, char *); -extern void SLtt_wide_width(void); -extern void SLtt_narrow_width(void); -extern void SLtt_set_alt_char_set (int); -extern int SLtt_write_to_status_line (char *, int); -extern void SLtt_disable_status_line (void); -# ifdef REAL_UNIX_SYSTEM -/* These are termcap/terminfo routines that assume SLtt_initialize has - * been called. - */ -extern char *SLtt_tgetstr (char *); -extern int SLtt_tgetnum (char *); -extern int SLtt_tgetflag (char *); - -/* The following are terminfo-only routines -- these prototypes will change - * in V2.x. - */ -extern char *SLtt_tigetent (char *); -extern char *SLtt_tigetstr (char *, char **); -extern int SLtt_tigetnum (char *, char **); -# endif -#endif - -extern SLtt_Char_Type SLtt_get_color_object (int); -extern void SLtt_set_color_object (int, SLtt_Char_Type); -extern void SLtt_set_color (int, char *, char *, char *); -extern void SLtt_set_mono (int, char *, SLtt_Char_Type); -extern void SLtt_add_color_attribute (int, SLtt_Char_Type); -extern void SLtt_set_color_fgbg (int, SLtt_Char_Type, SLtt_Char_Type); - -/*}}}*/ - -/*{{{ SLang Preprocessor Interface */ - -typedef struct -{ - int this_level; - int exec_level; - int prev_exec_level; - char preprocess_char; - char comment_char; - unsigned char flags; -#define SLPREP_BLANK_LINES_OK 1 -#define SLPREP_COMMENT_LINES_OK 2 -} -SLPreprocess_Type; - -extern int SLprep_open_prep (SLPreprocess_Type *); -extern void SLprep_close_prep (SLPreprocess_Type *); -extern int SLprep_line_ok (char *, SLPreprocess_Type *); - extern int SLdefine_for_ifdef (char *); - /* Adds a string to the SLang #ifdef preparsing defines. SLang already - defines MSDOS, UNIX, and VMS on the appropriate system. */ -extern int (*SLprep_exists_hook) (char *, char); - -/*}}}*/ - -/*{{{ SLsmg Screen Management Functions */ - -extern void SLsmg_fill_region (int, int, unsigned int, unsigned int, unsigned char); -extern void SLsmg_set_char_set (int); -#ifndef IBMPC_SYSTEM -extern int SLsmg_Scroll_Hash_Border; -#endif -extern int SLsmg_suspend_smg (void); -extern int SLsmg_resume_smg (void); -extern void SLsmg_erase_eol (void); -extern void SLsmg_gotorc (int, int); -extern void SLsmg_erase_eos (void); -extern void SLsmg_reverse_video (void); -extern void SLsmg_set_color (int); -extern void SLsmg_normal_video (void); -extern void SLsmg_printf (char *, ...); -extern void SLsmg_vprintf (char *, va_list); -extern void SLsmg_write_string (char *); -extern void SLsmg_write_nstring (char *, unsigned int); -extern void SLsmg_write_char (char); -extern void SLsmg_write_nchars (char *, unsigned int); -extern void SLsmg_write_wrapped_string (char *, int, int, unsigned int, unsigned int, int); -extern void SLsmg_cls (void); -extern void SLsmg_refresh (void); -extern void SLsmg_touch_lines (int, unsigned int); -extern void SLsmg_touch_screen (void); -extern int SLsmg_init_smg (void); -extern int SLsmg_reinit_smg (void); -extern void SLsmg_reset_smg (void); -extern SLsmg_Char_Type SLsmg_char_at(void); -extern void SLsmg_set_screen_start (int *, int *); -extern void SLsmg_draw_hline (unsigned int); -extern void SLsmg_draw_vline (int); -extern void SLsmg_draw_object (int, int, unsigned char); -extern void SLsmg_draw_box (int, int, unsigned int, unsigned int); -extern int SLsmg_get_column(void); -extern int SLsmg_get_row(void); -extern void SLsmg_forward (int); -extern void SLsmg_write_color_chars (SLsmg_Char_Type *, unsigned int); -extern unsigned int SLsmg_read_raw (SLsmg_Char_Type *, unsigned int); -extern unsigned int SLsmg_write_raw (SLsmg_Char_Type *, unsigned int); -extern void SLsmg_set_color_in_region (int, int, int, unsigned int, unsigned int); -extern int SLsmg_Display_Eight_Bit; -extern int SLsmg_Tab_Width; - -#define SLSMG_NEWLINE_IGNORED 0 /* default */ -#define SLSMG_NEWLINE_MOVES 1 /* moves to next line, column 0 */ -#define SLSMG_NEWLINE_SCROLLS 2 /* moves but scrolls at bottom of screen */ -#define SLSMG_NEWLINE_PRINTABLE 3 /* prints as ^J */ -extern int SLsmg_Newline_Behavior; - -extern int SLsmg_Backspace_Moves; - -#ifdef IBMPC_SYSTEM -# define SLSMG_HLINE_CHAR 0xC4 -# define SLSMG_VLINE_CHAR 0xB3 -# define SLSMG_ULCORN_CHAR 0xDA -# define SLSMG_URCORN_CHAR 0xBF -# define SLSMG_LLCORN_CHAR 0xC0 -# define SLSMG_LRCORN_CHAR 0xD9 -# define SLSMG_RTEE_CHAR 0xB4 -# define SLSMG_LTEE_CHAR 0xC3 -# define SLSMG_UTEE_CHAR 0xC2 -# define SLSMG_DTEE_CHAR 0xC1 -# define SLSMG_PLUS_CHAR 0xC5 -/* There are several to choose from: 0xB0, 0xB1, and 0xB2 */ -# define SLSMG_CKBRD_CHAR 0xB0 -# define SLSMG_DIAMOND_CHAR 0x04 -# define SLSMG_DEGREE_CHAR 0xF8 -# define SLSMG_PLMINUS_CHAR 0xF1 -# define SLSMG_BULLET_CHAR 0xF9 -# define SLSMG_LARROW_CHAR 0x1B -# define SLSMG_RARROW_CHAR 0x1A -# define SLSMG_DARROW_CHAR 0x19 -# define SLSMG_UARROW_CHAR 0x18 -# define SLSMG_BOARD_CHAR 0xB2 -# define SLSMG_BLOCK_CHAR 0xDB -#else -# if defined(AMIGA) -# define SLSMG_HLINE_CHAR '-' -# define SLSMG_VLINE_CHAR '|' -# define SLSMG_ULCORN_CHAR '+' -# define SLSMG_URCORN_CHAR '+' -# define SLSMG_LLCORN_CHAR '+' -# define SLSMG_LRCORN_CHAR '+' -# define SLSMG_CKBRD_CHAR '#' -# define SLSMG_RTEE_CHAR '+' -# define SLSMG_LTEE_CHAR '+' -# define SLSMG_UTEE_CHAR '+' -# define SLSMG_DTEE_CHAR '+' -# define SLSMG_PLUS_CHAR '+' -# define SLSMG_DIAMOND_CHAR '+' -# define SLSMG_DEGREE_CHAR '\\' -# define SLSMG_PLMINUS_CHAR '#' -# define SLSMG_BULLET_CHAR 'o' -# define SLSMG_LARROW_CHAR '<' -# define SLSMG_RARROW_CHAR '>' -# define SLSMG_DARROW_CHAR 'v' -# define SLSMG_UARROW_CHAR '^' -# define SLSMG_BOARD_CHAR '#' -# define SLSMG_BLOCK_CHAR '#' -# else -# define SLSMG_HLINE_CHAR 'q' -# define SLSMG_VLINE_CHAR 'x' -# define SLSMG_ULCORN_CHAR 'l' -# define SLSMG_URCORN_CHAR 'k' -# define SLSMG_LLCORN_CHAR 'm' -# define SLSMG_LRCORN_CHAR 'j' -# define SLSMG_CKBRD_CHAR 'a' -# define SLSMG_RTEE_CHAR 'u' -# define SLSMG_LTEE_CHAR 't' -# define SLSMG_UTEE_CHAR 'w' -# define SLSMG_DTEE_CHAR 'v' -# define SLSMG_PLUS_CHAR 'n' -# define SLSMG_DIAMOND_CHAR '`' -# define SLSMG_DEGREE_CHAR 'f' -# define SLSMG_PLMINUS_CHAR 'g' -# define SLSMG_BULLET_CHAR '~' -# define SLSMG_LARROW_CHAR ',' -# define SLSMG_RARROW_CHAR '+' -# define SLSMG_DARROW_CHAR '.' -# define SLSMG_UARROW_CHAR '-' -# define SLSMG_BOARD_CHAR 'h' -# define SLSMG_BLOCK_CHAR '0' -# endif /* AMIGA */ -#endif /* IBMPC_SYSTEM */ - -#ifndef IBMPC_SYSTEM -# define SLSMG_COLOR_BLACK 0x000000 -# define SLSMG_COLOR_RED 0x000001 -# define SLSMG_COLOR_GREEN 0x000002 -# define SLSMG_COLOR_BROWN 0x000003 -# define SLSMG_COLOR_BLUE 0x000004 -# define SLSMG_COLOR_MAGENTA 0x000005 -# define SLSMG_COLOR_CYAN 0x000006 -# define SLSMG_COLOR_LGRAY 0x000007 -# define SLSMG_COLOR_GRAY 0x000008 -# define SLSMG_COLOR_BRIGHT_RED 0x000009 -# define SLSMG_COLOR_BRIGHT_GREEN 0x00000A -# define SLSMG_COLOR_BRIGHT_BROWN 0x00000B -# define SLSMG_COLOR_BRIGHT_BLUE 0x00000C -# define SLSMG_COLOR_BRIGHT_CYAN 0x00000D -# define SLSMG_COLOR_BRIGHT_MAGENTA 0x00000E -# define SLSMG_COLOR_BRIGHT_WHITE 0x00000F -#endif - -typedef struct -{ - void (*tt_normal_video)(void); - void (*tt_set_scroll_region)(int, int); - void (*tt_goto_rc)(int, int); - void (*tt_reverse_index)(int); - void (*tt_reset_scroll_region)(void); - void (*tt_delete_nlines)(int); - void (*tt_cls) (void); - void (*tt_del_eol) (void); - void (*tt_smart_puts) (SLsmg_Char_Type *, SLsmg_Char_Type *, int, int); - int (*tt_flush_output) (void); - int (*tt_reset_video) (void); - int (*tt_init_video) (void); - - int *tt_screen_rows; - int *tt_screen_cols; - - int *tt_term_cannot_scroll; - int *tt_has_alt_charset; - int *tt_use_blink_for_acs; - char **tt_graphic_char_pairs; - - long reserved[4]; -} -SLsmg_Term_Type; -extern void SLsmg_set_terminal_info (SLsmg_Term_Type *); - -/*}}}*/ - -/*{{{ SLang Keypad Interface */ - -#define SL_KEY_ERR 0xFFFF - -#define SL_KEY_UP 0x101 -#define SL_KEY_DOWN 0x102 -#define SL_KEY_LEFT 0x103 -#define SL_KEY_RIGHT 0x104 -#define SL_KEY_PPAGE 0x105 -#define SL_KEY_NPAGE 0x106 -#define SL_KEY_HOME 0x107 -#define SL_KEY_END 0x108 -#define SL_KEY_A1 0x109 -#define SL_KEY_A3 0x10A -#define SL_KEY_B2 0x10B -#define SL_KEY_C1 0x10C -#define SL_KEY_C3 0x10D -#define SL_KEY_REDO 0x10E -#define SL_KEY_UNDO 0x10F -#define SL_KEY_BACKSPACE 0x110 -#define SL_KEY_ENTER 0x111 -#define SL_KEY_IC 0x112 -#define SL_KEY_DELETE 0x113 - -#define SL_KEY_F0 0x200 -#define SL_KEY_F(X) (SL_KEY_F0 + X) - -/* I do not intend to use keysymps > 0x1000. Applications can use those. */ -/* Returns 0 upon success or -1 upon error. */ -extern int SLkp_define_keysym (char *, unsigned int); - -/* This function must be called AFTER SLtt_get_terminfo and not before. */ -extern int SLkp_init (void); - -/* This function uses SLang_getkey and assumes that what ever initialization - * is required for SLang_getkey has been performed. - */ -extern int SLkp_getkey (void); - -/*}}}*/ - -/*{{{ SLang Scroll Interface */ - -typedef struct _SLscroll_Type -{ - struct _SLscroll_Type *next; - struct _SLscroll_Type *prev; - unsigned int flags; -} -SLscroll_Type; - -typedef struct -{ - unsigned int flags; - SLscroll_Type *top_window_line; /* list element at top of window */ - SLscroll_Type *bot_window_line; /* list element at bottom of window */ - SLscroll_Type *current_line; /* current list element */ - SLscroll_Type *lines; /* first list element */ - unsigned int nrows; /* number of rows in window */ - unsigned int hidden_mask; /* applied to flags in SLscroll_Type */ - unsigned int line_num; /* current line number (visible) */ - unsigned int num_lines; /* total number of lines (visible) */ - unsigned int window_row; /* row of current_line in window */ - unsigned int border; /* number of rows that form scroll border */ - int cannot_scroll; /* should window scroll or recenter */ -} -SLscroll_Window_Type; - -extern int SLscroll_find_top (SLscroll_Window_Type *); -extern int SLscroll_find_line_num (SLscroll_Window_Type *); -extern unsigned int SLscroll_next_n (SLscroll_Window_Type *, unsigned int); -extern unsigned int SLscroll_prev_n (SLscroll_Window_Type *, unsigned int); -extern int SLscroll_pageup (SLscroll_Window_Type *); -extern int SLscroll_pagedown (SLscroll_Window_Type *); - -/*}}}*/ - -/*{{{ Signal Routines */ - -typedef void SLSig_Fun_Type (int); -extern SLSig_Fun_Type *SLsignal (int, SLSig_Fun_Type *); -extern SLSig_Fun_Type *SLsignal_intr (int, SLSig_Fun_Type *); -extern int SLsig_block_signals (void); -extern int SLsig_unblock_signals (void); -extern int SLsystem (char *); - -extern char *SLerrno_strerror (int); -extern int SLerrno_set_errno (int); - -/*}}}*/ - -/*{{{ Interpreter Macro Definitions */ - -/* The definitions here are for objects that may be on the run-time stack. - * They are actually sub_types of literal and data main_types. The actual - * numbers are historical. - */ -#define SLANG_UNDEFINED_TYPE 0x00 /* MUST be 0 */ -#define SLANG_VOID_TYPE 0x01 /* also matches ANY type */ -#define SLANG_INT_TYPE 0x02 -#define SLANG_DOUBLE_TYPE 0x03 -#define SLANG_CHAR_TYPE 0x04 -#define SLANG_INTP_TYPE 0x05 -/* An object of SLANG_INTP_TYPE should never really occur on the stack. Rather, - * the integer to which it refers will be there instead. It is defined here - * because it is a valid type for MAKE_VARIABLE. - */ -#define SLANG_REF_TYPE 0x06 -/* SLANG_REF_TYPE refers to an object on the stack that is a pointer (reference) - * to some other object. - */ -#define SLANG_COMPLEX_TYPE 0x07 -#define SLANG_NULL_TYPE 0x08 -#define SLANG_UCHAR_TYPE 0x09 -#define SLANG_SHORT_TYPE 0x0A -#define SLANG_USHORT_TYPE 0x0B -#define SLANG_UINT_TYPE 0x0C -#define SLANG_LONG_TYPE 0x0D -#define SLANG_ULONG_TYPE 0x0E -#define SLANG_STRING_TYPE 0x0F -#define SLANG_FLOAT_TYPE 0x10 -#define SLANG_STRUCT_TYPE 0x11 -#define SLANG_ISTRUCT_TYPE 0x12 -#define SLANG_ARRAY_TYPE 0x20 -#define SLANG_DATATYPE_TYPE 0x21 -#define SLANG_FILE_PTR_TYPE 0x22 -#define SLANG_ASSOC_TYPE 0x23 -#define SLANG_ANY_TYPE 0x24 -#define SLANG_BSTRING_TYPE 0x25 -#define SLANG_FILE_FD_TYPE 0x26 - -/* Compatibility */ -#ifdef FLOAT_TYPE -# undef FLOAT_TYPE -#endif -#define VOID_TYPE SLANG_VOID_TYPE -#define INT_TYPE SLANG_INT_TYPE -#define INTP_TYPE SLANG_INTP_TYPE -#define FLOAT_TYPE SLANG_DOUBLE_TYPE -#define ARRAY_TYPE SLANG_ARRAY_TYPE -#define CHAR_TYPE SLANG_CHAR_TYPE -#define STRING_TYPE SLANG_STRING_TYPE - -/* I am reserving values greater than or equal to 128 for user applications. - * The first 127 are reserved for S-Lang. - */ - -/* Binary and Unary Subtypes */ -/* Since the application can define new types and can overload the binary - * and unary operators, these definitions must be present in this file. - * The current implementation assumes both unary and binary are distinct. - */ -#define SLANG_PLUS 0x01 -#define SLANG_MINUS 0x02 -#define SLANG_TIMES 0x03 -#define SLANG_DIVIDE 0x04 -#define SLANG_EQ 0x05 -#define SLANG_NE 0x06 -#define SLANG_GT 0x07 -#define SLANG_GE 0x08 -#define SLANG_LT 0x09 -#define SLANG_LE 0x0A -#define SLANG_POW 0x0B -#define SLANG_OR 0x0C -#define SLANG_AND 0x0D -#define SLANG_BAND 0x0E -#define SLANG_BOR 0x0F -#define SLANG_BXOR 0x10 -#define SLANG_SHL 0x11 -#define SLANG_SHR 0x12 -#define SLANG_MOD 0x13 - -/* UNARY subtypes (may be overloaded) */ -#define SLANG_PLUSPLUS 0x20 -#define SLANG_MINUSMINUS 0x21 -#define SLANG_ABS 0x22 -#define SLANG_SIGN 0x23 -#define SLANG_SQR 0x24 -#define SLANG_MUL2 0x25 -#define SLANG_CHS 0x26 -#define SLANG_NOT 0x27 -#define SLANG_BNOT 0x28 - -extern char *SLang_Error_Message; - -int SLadd_intrinsic_variable (char *, VOID_STAR, unsigned char, int); -int SLadd_intrinsic_function (char *, FVOID_STAR, unsigned char, unsigned int,...); - -int SLns_add_intrinsic_variable (SLang_NameSpace_Type *, char *, VOID_STAR, unsigned char, int); -int SLns_add_intrinsic_function (SLang_NameSpace_Type *, char *, FVOID_STAR, unsigned char, unsigned int,...); - -extern void SLadd_at_handler (long *, char *); - -#define MAKE_INTRINSIC_N(n,f,out,in,a1,a2,a3,a4,a5,a6,a7) \ - {(n), NULL, SLANG_INTRINSIC, (FVOID_STAR) (f), \ - {a1,a2,a3,a4,a5,a6,a7}, (in), (out)} - -#define MAKE_INTRINSIC_7(n,f,out,a1,a2,a3,a4,a5,a6,a7) \ - MAKE_INTRINSIC_N(n,f,out,7,a1,a2,a3,a4,a5,a6,a7) -#define MAKE_INTRINSIC_6(n,f,out,a1,a2,a3,a4,a5,a6) \ - MAKE_INTRINSIC_N(n,f,out,6,a1,a2,a3,a4,a5,a6,0) -#define MAKE_INTRINSIC_5(n,f,out,a1,a2,a3,a4,a5) \ - MAKE_INTRINSIC_N(n,f,out,5,a1,a2,a3,a4,a5,0,0) -#define MAKE_INTRINSIC_4(n,f,out,a1,a2,a3,a4) \ - MAKE_INTRINSIC_N(n,f,out,4,a1,a2,a3,a4,0,0,0) -#define MAKE_INTRINSIC_3(n,f,out,a1,a2,a3) \ - MAKE_INTRINSIC_N(n,f,out,3,a1,a2,a3,0,0,0,0) -#define MAKE_INTRINSIC_2(n,f,out,a1,a2) \ - MAKE_INTRINSIC_N(n,f,out,2,a1,a2,0,0,0,0,0) -#define MAKE_INTRINSIC_1(n,f,out,a1) \ - MAKE_INTRINSIC_N(n,f,out,1,a1,0,0,0,0,0,0) -#define MAKE_INTRINSIC_0(n,f,out) \ - MAKE_INTRINSIC_N(n,f,out,0,0,0,0,0,0,0,0) - -#define MAKE_INTRINSIC_S(n,f,r) \ - MAKE_INTRINSIC_1(n,f,r,SLANG_STRING_TYPE) -#define MAKE_INTRINSIC_I(n,f,r) \ - MAKE_INTRINSIC_1(n,f,r,SLANG_INT_TYPE) - -#define MAKE_INTRINSIC_SS(n,f,r) \ - MAKE_INTRINSIC_2(n,f,r,SLANG_STRING_TYPE,SLANG_STRING_TYPE) -#define MAKE_INTRINSIC_SI(n,f,r) \ - MAKE_INTRINSIC_2(n,f,r,SLANG_STRING_TYPE,SLANG_INT_TYPE) -#define MAKE_INTRINSIC_IS(n,f,r) \ - MAKE_INTRINSIC_2(n,f,r,SLANG_INT_TYPE,SLANG_STRING_TYPE) -#define MAKE_INTRINSIC_II(n,f,r) \ - MAKE_INTRINSIC_2(n,f,r,SLANG_INT_TYPE,SLANG_INT_TYPE) - -#define MAKE_INTRINSIC_SSS(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_STRING_TYPE,SLANG_STRING_TYPE,SLANG_STRING_TYPE) -#define MAKE_INTRINSIC_SSI(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_STRING_TYPE,SLANG_STRING_TYPE,SLANG_INT_TYPE) -#define MAKE_INTRINSIC_SIS(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_STRING_TYPE,SLANG_INT_TYPE,SLANG_STRING_TYPE) -#define MAKE_INTRINSIC_SII(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_STRING_TYPE,SLANG_INT_TYPE,SLANG_INT_TYPE) -#define MAKE_INTRINSIC_ISS(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_INT_TYPE,SLANG_STRING_TYPE,SLANG_STRING_TYPE) -#define MAKE_INTRINSIC_ISI(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_INT_TYPE,SLANG_STRING_TYPE,SLANG_INT_TYPE) -#define MAKE_INTRINSIC_IIS(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_INT_TYPE,SLANG_INT_TYPE,SLANG_STRING_TYPE) -#define MAKE_INTRINSIC_III(n,f,r) \ - MAKE_INTRINSIC_3(n,f,r,SLANG_INT_TYPE,SLANG_INT_TYPE,SLANG_INT_TYPE) - -#define MAKE_INTRINSIC(n, f, out, in) \ - MAKE_INTRINSIC_N(n,f,out,in,0,0,0,0,0,0,0) - -#define MAKE_VARIABLE(n, v, t, r) \ - {n, NULL, SLANG_IVARIABLE + (r), (VOID_STAR)(v), (t)} - -#define MAKE_APP_UNARY(n,op) \ - {(n), NULL, SLANG_APP_UNARY, (op)} - -#define MAKE_MATH_UNARY(n,op) \ - {(n), NULL, SLANG_MATH_UNARY, (op)} - -#define MAKE_ICONSTANT(n,val) \ - {(n),NULL, SLANG_ICONSTANT, (val)} - -#define MAKE_DCONSTANT(n,val) \ - {(n),NULL, SLANG_DCONSTANT, (val)} - -#ifndef offsetof -# define offsetof(T,F) ((unsigned int)((char *)&((T *)0L)->F - (char *)0L)) -#endif -#define MAKE_ISTRUCT_FIELD(s,f,n,t,r) {(n), offsetof(s,f), (t), (r)} - -#define SLANG_END_TABLE {NULL} -#define SLANG_END_INTRIN_FUN_TABLE MAKE_INTRINSIC_0(NULL,NULL,0) -#define SLANG_END_DCONST_TABLE MAKE_DCONSTANT(NULL,0) -#define SLANG_END_MATH_UNARY_TABLE MAKE_MATH_UNARY(NULL,0) -#define SLANG_END_INTRIN_VAR_TABLE MAKE_VARIABLE(NULL,NULL,0,0) -#define SLANG_END_ICONST_TABLE MAKE_ICONSTANT(NULL,0) -#define SLANG_END_ISTRUCT_TABLE {NULL, 0, 0, 0} - - - -/*}}}*/ - -/*{{{ Upper/Lowercase Functions */ - -extern void SLang_define_case(int *, int *); -extern void SLang_init_case_tables (void); - -extern unsigned char _SLChg_UCase_Lut[256]; -extern unsigned char _SLChg_LCase_Lut[256]; -#define UPPER_CASE(x) (_SLChg_UCase_Lut[(unsigned char) (x)]) -#define LOWER_CASE(x) (_SLChg_LCase_Lut[(unsigned char) (x)]) -#define CHANGE_CASE(x) (((x) == _SLChg_LCase_Lut[(unsigned char) (x)]) ?\ - _SLChg_UCase_Lut[(unsigned char) (x)] : _SLChg_LCase_Lut[(unsigned char) (x)]) - -/*}}}*/ - -/*{{{ Regular Expression Interface */ - -typedef struct -{ - /* These must be set by calling routine. */ - unsigned char *pat; /* regular expression pattern */ - unsigned char *buf; /* buffer for compiled regexp */ - unsigned int buf_len; /* length of buffer */ - int case_sensitive; /* 1 if match is case sensitive */ - - /* The rest are set by SLang_regexp_compile */ - - int must_match; /* 1 if line must contain substring */ - int must_match_bol; /* true if it must match beginning of line */ - unsigned char must_match_str[16]; /* 15 char null term substring */ - int osearch; /* 1 if ordinary search suffices */ - unsigned int min_length; /* minimum length the match must be */ - int beg_matches[10]; /* offset of start of \( */ - unsigned int end_matches[10]; /* length of nth submatch - * Note that the entire match corresponds - * to \0 - */ - int offset; /* offset to be added to beg_matches */ - int reserved[10]; -} SLRegexp_Type; - -extern unsigned char *SLang_regexp_match(unsigned char *, - unsigned int, - SLRegexp_Type *); - -/* Returns 0 upon success. If failure, the offset into the - * pattern is returned (start = 1). - */ -extern int SLang_regexp_compile (SLRegexp_Type *); -extern char *SLregexp_quote_string (char *, char *, unsigned int); - -/*}}}*/ - -/*{{{ SLang Command Interface */ - -struct _SLcmd_Cmd_Type; /* Pre-declaration is needed below */ -typedef struct -{ - struct _SLcmd_Cmd_Type *table; - int argc; - /* Version 2.0 needs to use a union!! */ - char **string_args; - int *int_args; - double *double_args; - unsigned char *arg_type; - unsigned long reserved[4]; -} SLcmd_Cmd_Table_Type; - -typedef struct _SLcmd_Cmd_Type -{ - int (*cmdfun)(int, SLcmd_Cmd_Table_Type *); - char *cmd; - char *arg_type; -} SLcmd_Cmd_Type; - -extern int SLcmd_execute_string (char *, SLcmd_Cmd_Table_Type *); - -/*}}}*/ - -/*{{{ SLang Search Interface */ - -typedef struct -{ - int cs; /* case sensitive */ - unsigned char key[256]; - int ind[256]; - int key_len; - int dir; -} SLsearch_Type; - -extern int SLsearch_init (char *, int, int, SLsearch_Type *); -/* This routine must first be called before any search can take place. - * The second parameter specifies the direction of the search: greater than - * zero for a forwrd search and less than zero for a backward search. The - * third parameter specifies whether the search is case sensitive or not. - * The last parameter is a pointer to a structure that is filled by this - * function and it is this structure that must be passed to SLsearch. - */ - -extern unsigned char *SLsearch (unsigned char *, unsigned char *, SLsearch_Type *); -/* To use this routine, you must first call 'SLsearch_init'. Then the first - * two parameters p1 and p2 serve to define the region over which the search - * is to take place. The third parameter is the structure that was previously - * initialized by SLsearch_init. - * - * The routine returns a pointer to the match if found otherwise it returns - * NULL. - */ - -/*}}}*/ - -/*{{{ SLang Pathname Interface */ - -/* These function return pointers to the original space */ -extern char *SLpath_basename (char *); -extern char *SLpath_extname (char *); -extern int SLpath_is_absolute_path (char *); - -/* These return malloced strings--- NOT slstrings */ -extern char *SLpath_dircat (char *, char *); -extern char *SLpath_find_file_in_path (char *, char *); -extern char *SLpath_dirname (char *); -extern int SLpath_file_exists (char *); -extern char *SLpath_pathname_sans_extname (char *); - -/*}}}*/ - -extern int SLang_set_module_load_path (char *); - -#define SLANG_MODULE(name) \ - extern int init_##name##_module_ns (char *); \ - extern void deinit_##name##_module (void) - -#if 0 -{ -#endif -#ifdef __cplusplus -} -#endif - -#endif /* _DAVIS_SLANG_H_ */ diff --git a/mdk-stage1/slang/slarith.c b/mdk-stage1/slang/slarith.c deleted file mode 100644 index 07ad68687..000000000 --- a/mdk-stage1/slang/slarith.c +++ /dev/null @@ -1,1656 +0,0 @@ - -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include <math.h> - -#ifdef HAVE_LOCALE_H -# include <locale.h> -#endif - -#include "slang.h" -#include "_slang.h" - -/* - * This file defines binary and unary operations on all integer types. - * Supported types include: - * - * SLANG_CHAR_TYPE (char) - * SLANG_SHORT_TYPE (short) - * SLANG_INT_TYPE (int) - * SLANG_LONG_TYPE (long) - * SLANG_FLOAT_TYPE (float) - * SLANG_DOUBLE_TYPE (double) - * - * as well as unsigned types. The result-type of an arithmentic operation - * will depend upon the data types involved. I am going to distinguish - * between the boolean operations such as `and' and `or' from the arithmetic - * operations such as `plus'. Since the result of a boolean operation is - * either 1 or 0, a boolean result will be represented by SLANG_CHAR_TYPE. - * Ordinarily I would use an integer but for arrays it makes more sense to - * use a character data type. - * - * So, the following will be assumed (`+' is any arithmetic operator) - * - * char + char = int - * char|short + short = int - * char|short|int + int = int - * char|short|int|long + long = long - * char|short|int|long|float + float = float - * char|short|int|long|float|double + double = double - * - * In the actual implementation, a brute force approach is avoided. Such - * an approach would mean defining different functions for all possible - * combinations of types. Including the unsigned types, and not including - * the complex number type, there are 10 arithmetic types and 10*10=100 - * different combinations of types. Clearly this would be too much. - * - * One approach would be to define binary functions only between operands of - * the same type and then convert types as appropriate. This would require - * just 6 such functions (int, uint, long, ulong, float, double). - * However, many conversion functions are going to be required, particularly - * since we are going to allow typecasting from one arithmetic to another. - * Since the bit pattern of signed and unsigned types are the same, and only - * the interpretation differs, there will be no functions to convert between - * signed and unsigned forms of a given type. - */ - -#define MAX_ARITHMETIC_TYPES 10 - -unsigned char _SLarith_Is_Arith_Type [256]; - -unsigned char _SLarith_Arith_Types[] = -{ - SLANG_CHAR_TYPE, - SLANG_UCHAR_TYPE, - SLANG_SHORT_TYPE, - SLANG_USHORT_TYPE, - SLANG_INT_TYPE, - SLANG_UINT_TYPE, - SLANG_LONG_TYPE, - SLANG_ULONG_TYPE, - SLANG_FLOAT_TYPE, - SLANG_DOUBLE_TYPE, - 0 -}; - -/* Here are a bunch of functions to convert from one type to another. To - * facilitate the process, a macros will be used. - */ - -#define DEFUN_1(f,from_type,to_type) \ -static void f (to_type *y, from_type *x, unsigned int n) \ -{ \ - unsigned int i; \ - for (i = 0; i < n; i++) y[i] = (to_type) x[i]; \ -} - -#define DEFUN_2(f,from_type,to_type,copy_fun) \ -static VOID_STAR f (VOID_STAR xp, unsigned int n) \ -{ \ - from_type *x; \ - to_type *y; \ - x = (from_type *) xp; \ - if (NULL == (y = (to_type *) SLmalloc (sizeof (to_type) * n))) return NULL; \ - copy_fun (y, x, n); \ - return (VOID_STAR) y; \ -} -typedef VOID_STAR (*Convert_Fun_Type)(VOID_STAR, unsigned int); - -DEFUN_1(copy_char_to_char,char,char) -#if SIZEOF_INT != SIZEOF_SHORT -DEFUN_1(copy_char_to_short,char,short) -DEFUN_1(copy_char_to_ushort,char,unsigned short) -#else -# define copy_char_to_short copy_char_to_int -# define copy_char_to_ushort copy_char_to_uint -#endif -DEFUN_1(copy_char_to_int,char,int) -DEFUN_1(copy_char_to_uint,char,unsigned int) -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_1(copy_char_to_long,char,long) -DEFUN_1(copy_char_to_ulong,char,unsigned long) -#else -# define copy_char_to_long copy_char_to_int -# define copy_char_to_ulong copy_char_to_uint -#endif -DEFUN_1(copy_char_to_float,char,float) -DEFUN_1(copy_char_to_double,char,double) - -#if SIZEOF_INT != SIZEOF_SHORT -DEFUN_1(copy_uchar_to_short,unsigned char,short) -DEFUN_1(copy_uchar_to_ushort,unsigned char,unsigned short) -#else -# define copy_uchar_to_short copy_uchar_to_int -# define copy_uchar_to_ushort copy_uchar_to_uint -#endif -DEFUN_1(copy_uchar_to_int,unsigned char,int) -DEFUN_1(copy_uchar_to_uint,unsigned char,unsigned int) -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_1(copy_uchar_to_long,unsigned char,long) -DEFUN_1(copy_uchar_to_ulong,unsigned char,unsigned long) -#else -# define copy_uchar_to_long copy_uchar_to_int -# define copy_uchar_to_ulong copy_uchar_to_uint -#endif -DEFUN_1(copy_uchar_to_float,unsigned char,float) -DEFUN_1(copy_uchar_to_double,unsigned char,double) - -#if SIZEOF_INT != SIZEOF_SHORT -DEFUN_1(copy_short_to_char,short,char) -DEFUN_1(copy_short_to_uchar,short,unsigned char) -DEFUN_1(copy_short_to_short,short,short) -DEFUN_1(copy_short_to_int,short,int) -DEFUN_1(copy_short_to_uint,short,unsigned int) -DEFUN_1(copy_short_to_long,short,long) -DEFUN_1(copy_short_to_ulong,short,unsigned long) -DEFUN_1(copy_short_to_float,short,float) -DEFUN_1(copy_short_to_double,short,double) -DEFUN_1(copy_ushort_to_char,unsigned short,char) -DEFUN_1(copy_ushort_to_uchar,unsigned short,unsigned char) -DEFUN_1(copy_ushort_to_int,unsigned short,int) -DEFUN_1(copy_ushort_to_uint,unsigned short,unsigned int) -DEFUN_1(copy_ushort_to_long,unsigned short,long) -DEFUN_1(copy_ushort_to_ulong,unsigned short,unsigned long) -DEFUN_1(copy_ushort_to_float,unsigned short,float) -DEFUN_1(copy_ushort_to_double,unsigned short,double) -#else -# define copy_short_to_char copy_int_to_char -# define copy_short_to_uchar copy_int_to_uchar -# define copy_short_to_short copy_int_to_int -# define copy_short_to_int copy_int_to_int -# define copy_short_to_uint copy_int_to_int -# define copy_short_to_long copy_int_to_long -# define copy_short_to_ulong copy_int_to_ulong -# define copy_short_to_float copy_int_to_float -# define copy_short_to_double copy_int_to_double -# define copy_ushort_to_char copy_uint_to_char -# define copy_ushort_to_uchar copy_uint_to_uchar -# define copy_ushort_to_int copy_int_to_int -# define copy_ushort_to_uint copy_int_to_int -# define copy_ushort_to_long copy_uint_to_long -# define copy_ushort_to_ulong copy_uint_to_ulong -# define copy_ushort_to_float copy_uint_to_float -# define copy_ushort_to_double copy_uint_to_double -#endif - -DEFUN_1(copy_int_to_char,int,char) -DEFUN_1(copy_int_to_uchar,int,unsigned char) -DEFUN_1(copy_uint_to_char,unsigned int,char) -DEFUN_1(copy_uint_to_uchar,unsigned int,unsigned char) -#if SIZEOF_INT != SIZEOF_SHORT -DEFUN_1(copy_int_to_short,int,short) -DEFUN_1(copy_int_to_ushort,int,unsigned short) -DEFUN_1(copy_uint_to_short,unsigned int,short) -DEFUN_1(copy_uint_to_ushort,unsigned int,unsigned short) -#else -# define copy_int_to_short copy_int_to_int -# define copy_int_to_ushort copy_int_to_int -# define copy_uint_to_short copy_int_to_int -# define copy_uint_to_ushort copy_int_to_int -#endif -DEFUN_1(copy_int_to_int,int,int) -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_1(copy_int_to_long,int,long) -DEFUN_1(copy_int_to_ulong,int,unsigned long) -DEFUN_1(copy_uint_to_long,unsigned int,long) -DEFUN_1(copy_uint_to_ulong,unsigned int,unsigned long) -#else -# define copy_int_to_long copy_int_to_int -# define copy_int_to_ulong copy_int_to_int -# define copy_uint_to_long copy_int_to_int -# define copy_uint_to_ulong copy_int_to_int -#endif -DEFUN_1(copy_int_to_float,int,float) -DEFUN_1(copy_int_to_double,int,double) -DEFUN_1(copy_uint_to_float,unsigned int,float) -DEFUN_1(copy_uint_to_double,unsigned int,double) - -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_1(copy_long_to_char,long,char) -DEFUN_1(copy_long_to_uchar,long,unsigned char) -DEFUN_1(copy_long_to_short,long,short) -DEFUN_1(copy_long_to_ushort,long,unsigned short) -DEFUN_1(copy_long_to_int,long,int) -DEFUN_1(copy_long_to_uint,long,unsigned int) -DEFUN_1(copy_long_to_long,long,long) -DEFUN_1(copy_long_to_float,long,float) -DEFUN_1(copy_long_to_double,long,double) -DEFUN_1(copy_ulong_to_char,unsigned long,char) -DEFUN_1(copy_ulong_to_uchar,unsigned long,unsigned char) -DEFUN_1(copy_ulong_to_short,unsigned long,short) -DEFUN_1(copy_ulong_to_ushort,unsigned long,unsigned short) -DEFUN_1(copy_ulong_to_int,unsigned long,int) -DEFUN_1(copy_ulong_to_uint,unsigned long,unsigned int) -DEFUN_1(copy_ulong_to_float,unsigned long,float) -DEFUN_1(copy_ulong_to_double,unsigned long,double) -#else -#define copy_long_to_char copy_int_to_char -#define copy_long_to_uchar copy_int_to_uchar -#define copy_long_to_short copy_int_to_short -#define copy_long_to_ushort copy_int_to_ushort -#define copy_long_to_int copy_int_to_int -#define copy_long_to_uint copy_int_to_int -#define copy_long_to_long copy_int_to_int -#define copy_long_to_float copy_int_to_float -#define copy_long_to_double copy_int_to_double -#define copy_ulong_to_char copy_uint_to_char -#define copy_ulong_to_uchar copy_uint_to_uchar -#define copy_ulong_to_short copy_uint_to_short -#define copy_ulong_to_ushort copy_uint_to_ushort -#define copy_ulong_to_int copy_int_to_int -#define copy_ulong_to_uint copy_int_to_int -#define copy_ulong_to_float copy_uint_to_float -#define copy_ulong_to_double copy_uint_to_double -#endif - -DEFUN_1(copy_float_to_char,float,char) -DEFUN_1(copy_float_to_uchar,float,unsigned char) -#if SIZEOF_INT != SIZEOF_SHORT -DEFUN_1(copy_float_to_short,float,short) -DEFUN_1(copy_float_to_ushort,float,unsigned short) -#else -# define copy_float_to_short copy_float_to_int -# define copy_float_to_ushort copy_float_to_uint -#endif -DEFUN_1(copy_float_to_int,float,int) -DEFUN_1(copy_float_to_uint,float,unsigned int) -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_1(copy_float_to_long,float,long) -DEFUN_1(copy_float_to_ulong,float,unsigned long) -#else -# define copy_float_to_long copy_float_to_int -# define copy_float_to_ulong copy_float_to_uint -#endif -DEFUN_1(copy_float_to_float,float,float) -DEFUN_1(copy_float_to_double,float,double) - -DEFUN_1(copy_double_to_char,double,char) -DEFUN_1(copy_double_to_uchar,double,unsigned char) -#if SIZEOF_INT != SIZEOF_SHORT -DEFUN_1(copy_double_to_short,double,short) -DEFUN_1(copy_double_to_ushort,double,unsigned short) -#else -# define copy_double_to_short copy_double_to_int -# define copy_double_to_ushort copy_double_to_uint -#endif -DEFUN_1(copy_double_to_int,double,int) -DEFUN_1(copy_double_to_uint,double,unsigned int) -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_1(copy_double_to_long,double,long) -DEFUN_1(copy_double_to_ulong,double,unsigned long) -#else -# define copy_double_to_long copy_double_to_int -# define copy_double_to_ulong copy_double_to_uint -#endif -DEFUN_1(copy_double_to_float,double,float) -DEFUN_1(copy_double_to_double,double,double) - -DEFUN_2(char_to_int,char,int,copy_char_to_int) -DEFUN_2(char_to_uint,char,unsigned int,copy_char_to_uint) -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_2(char_to_long,char,long,copy_char_to_long) -DEFUN_2(char_to_ulong,char,unsigned long,copy_char_to_ulong) -#else -# define char_to_long char_to_int -# define char_to_ulong char_to_uint -#endif -DEFUN_2(char_to_float,char,float,copy_char_to_float) -DEFUN_2(char_to_double,char,double,copy_char_to_double) - -DEFUN_2(uchar_to_int,unsigned char,int,copy_uchar_to_int) -DEFUN_2(uchar_to_uint,unsigned char,unsigned int,copy_uchar_to_uint) -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_2(uchar_to_long,unsigned char,long,copy_uchar_to_long) -DEFUN_2(uchar_to_ulong,unsigned char,unsigned long,copy_uchar_to_ulong) -#else -# define uchar_to_long uchar_to_int -# define uchar_to_ulong uchar_to_uint -#endif -DEFUN_2(uchar_to_float,unsigned char,float,copy_uchar_to_float) -DEFUN_2(uchar_to_double,unsigned char,double,copy_uchar_to_double) - -#if SIZEOF_INT != SIZEOF_SHORT -DEFUN_2(short_to_int,short,int,copy_short_to_int) -DEFUN_2(short_to_uint,short,unsigned int,copy_short_to_uint) -DEFUN_2(short_to_long,short,long,copy_short_to_long) -DEFUN_2(short_to_ulong,short,unsigned long,copy_short_to_ulong) -DEFUN_2(short_to_float,short,float,copy_short_to_float) -DEFUN_2(short_to_double,short,double,copy_short_to_double) -DEFUN_2(ushort_to_int,unsigned short,int,copy_ushort_to_int) -DEFUN_2(ushort_to_uint,unsigned short,unsigned int,copy_ushort_to_uint) -DEFUN_2(ushort_to_long,unsigned short,long,copy_ushort_to_long) -DEFUN_2(ushort_to_ulong,unsigned short,unsigned long,copy_ushort_to_ulong) -DEFUN_2(ushort_to_float,unsigned short,float,copy_ushort_to_float) -DEFUN_2(ushort_to_double,unsigned short,double,copy_ushort_to_double) -#else -# define short_to_int NULL -# define short_to_uint NULL -# define short_to_long int_to_long -# define short_to_ulong int_to_ulong -# define short_to_float int_to_float -# define short_to_double int_to_double -# define ushort_to_int NULL -# define ushort_to_uint NULL -# define ushort_to_long uint_to_long -# define ushort_to_ulong uint_to_ulong -# define ushort_to_float uint_to_float -# define ushort_to_double uint_to_double -#endif - -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_2(int_to_long,int,long,copy_int_to_long) -DEFUN_2(int_to_ulong,int,unsigned long,copy_int_to_ulong) -#else -# define int_to_long NULL -# define int_to_ulong NULL -#endif -DEFUN_2(int_to_float,int,float,copy_int_to_float) -DEFUN_2(int_to_double,int,double,copy_int_to_double) - -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_2(uint_to_long,unsigned int,long,copy_uint_to_long) -DEFUN_2(uint_to_ulong,unsigned int,unsigned long,copy_uint_to_ulong) -#else -# define uint_to_long NULL -# define uint_to_ulong NULL -#endif -DEFUN_2(uint_to_float,unsigned int,float,copy_uint_to_float) -DEFUN_2(uint_to_double,unsigned int,double,copy_uint_to_double) - -#if SIZEOF_INT != SIZEOF_LONG -DEFUN_2(long_to_float,long,float,copy_long_to_float) -DEFUN_2(long_to_double,long,double,copy_long_to_double) -DEFUN_2(ulong_to_float,unsigned long,float,copy_ulong_to_float) -DEFUN_2(ulong_to_double,unsigned long,double,copy_ulong_to_double) -#else -# define long_to_float int_to_float -# define long_to_double int_to_double -# define ulong_to_float uint_to_float -# define ulong_to_double uint_to_double -#endif - -DEFUN_2(float_to_double,float,double,copy_float_to_double) - -#define TO_DOUBLE_FUN(name,type) \ -static double name (VOID_STAR x) { return (double) *(type *) x; } -TO_DOUBLE_FUN(char_to_one_double,char) -TO_DOUBLE_FUN(uchar_to_one_double,unsigned char) -#if SIZEOF_INT != SIZEOF_SHORT -TO_DOUBLE_FUN(short_to_one_double,short) -TO_DOUBLE_FUN(ushort_to_one_double,unsigned short) -#else -# define short_to_one_double int_to_one_double -# define ushort_to_one_double uint_to_one_double -#endif -TO_DOUBLE_FUN(int_to_one_double,int) -TO_DOUBLE_FUN(uint_to_one_double,unsigned int) -#if SIZEOF_INT != SIZEOF_LONG -TO_DOUBLE_FUN(long_to_one_double,long) -TO_DOUBLE_FUN(ulong_to_one_double,unsigned long) -#else -# define long_to_one_double int_to_one_double -# define ulong_to_one_double uint_to_one_double -#endif -TO_DOUBLE_FUN(float_to_one_double,float) -TO_DOUBLE_FUN(double_to_one_double,double) - -SLang_To_Double_Fun_Type -SLarith_get_to_double_fun (unsigned char type, unsigned int *sizeof_type) -{ - unsigned int da; - SLang_To_Double_Fun_Type to_double; - - switch (type) - { - default: - return NULL; - - case SLANG_CHAR_TYPE: - da = sizeof (char); to_double = char_to_one_double; - break; - case SLANG_UCHAR_TYPE: - da = sizeof (unsigned char); to_double = uchar_to_one_double; - break; - case SLANG_SHORT_TYPE: - da = sizeof (short); to_double = short_to_one_double; - break; - case SLANG_USHORT_TYPE: - da = sizeof (unsigned short); to_double = ushort_to_one_double; - break; - case SLANG_INT_TYPE: - da = sizeof (int); to_double = int_to_one_double; - break; - case SLANG_UINT_TYPE: - da = sizeof (unsigned int); to_double = uint_to_one_double; - break; - case SLANG_LONG_TYPE: - da = sizeof (long); to_double = long_to_one_double; - break; - case SLANG_ULONG_TYPE: - da = sizeof (unsigned long); to_double = ulong_to_one_double; - break; - case SLANG_FLOAT_TYPE: - da = sizeof (float); to_double = float_to_one_double; - break; - case SLANG_DOUBLE_TYPE: - da = sizeof (double); to_double = double_to_one_double; - break; - } - - if (sizeof_type != NULL) *sizeof_type = da; - return to_double; -} - -/* Each element of the matrix determines how the row maps onto the column. - * That is, let the matrix be B_ij. Where the i,j indices refer to - * precedence of the type. Then, - * B_ij->copy_function copies type i to type j. Similarly, - * B_ij->convert_function mallocs a new array of type j and copies i to it. - * - * Since types are always converted to higher levels of precedence for binary - * operations, many of the elements are NULL. - * - * Is the idea clear? - */ -typedef struct -{ - FVOID_STAR copy_function; - Convert_Fun_Type convert_function; -} -Binary_Matrix_Type; - -static Binary_Matrix_Type Binary_Matrix [MAX_ARITHMETIC_TYPES][MAX_ARITHMETIC_TYPES] = -{ - { - {(FVOID_STAR)copy_char_to_char, NULL}, - {(FVOID_STAR)copy_char_to_char, NULL}, - {(FVOID_STAR) copy_char_to_short, NULL}, - {(FVOID_STAR) copy_char_to_ushort, NULL}, - {(FVOID_STAR) copy_char_to_int, char_to_int}, - {(FVOID_STAR) copy_char_to_uint, char_to_uint}, - {(FVOID_STAR) copy_char_to_long, char_to_long}, - {(FVOID_STAR) copy_char_to_ulong, char_to_ulong}, - {(FVOID_STAR) copy_char_to_float, char_to_float}, - {(FVOID_STAR) copy_char_to_double, char_to_double}, - }, - - { - {(FVOID_STAR)copy_char_to_char, NULL}, - {(FVOID_STAR)copy_char_to_char, NULL}, - {(FVOID_STAR) copy_uchar_to_short, NULL}, - {(FVOID_STAR) copy_uchar_to_ushort, NULL}, - {(FVOID_STAR) copy_uchar_to_int, uchar_to_int}, - {(FVOID_STAR) copy_uchar_to_uint, uchar_to_uint}, - {(FVOID_STAR) copy_uchar_to_long, uchar_to_long}, - {(FVOID_STAR) copy_uchar_to_ulong, uchar_to_ulong}, - {(FVOID_STAR) copy_uchar_to_float, uchar_to_float}, - {(FVOID_STAR) copy_uchar_to_double, uchar_to_double}, - }, - - { - {(FVOID_STAR) copy_short_to_char, NULL}, - {(FVOID_STAR) copy_short_to_uchar, NULL}, - {(FVOID_STAR) copy_short_to_short, NULL}, - {(FVOID_STAR) copy_short_to_short, NULL}, - {(FVOID_STAR) copy_short_to_int, short_to_int}, - {(FVOID_STAR) copy_short_to_uint, short_to_uint}, - {(FVOID_STAR) copy_short_to_long, short_to_long}, - {(FVOID_STAR) copy_short_to_ulong, short_to_ulong}, - {(FVOID_STAR) copy_short_to_float, short_to_float}, - {(FVOID_STAR) copy_short_to_double, short_to_double}, - }, - - { - {(FVOID_STAR) copy_ushort_to_char, NULL}, - {(FVOID_STAR) copy_ushort_to_uchar, NULL}, - {(FVOID_STAR) copy_short_to_short, NULL}, - {(FVOID_STAR) copy_short_to_short, NULL}, - {(FVOID_STAR) copy_ushort_to_int, ushort_to_int}, - {(FVOID_STAR) copy_ushort_to_uint, ushort_to_uint}, - {(FVOID_STAR) copy_ushort_to_long, ushort_to_long}, - {(FVOID_STAR) copy_ushort_to_ulong, ushort_to_ulong}, - {(FVOID_STAR) copy_ushort_to_float, ushort_to_float}, - {(FVOID_STAR) copy_ushort_to_double, ushort_to_double}, - }, - - { - {(FVOID_STAR) copy_int_to_char, NULL}, - {(FVOID_STAR) copy_int_to_uchar, NULL}, - {(FVOID_STAR) copy_int_to_short, NULL}, - {(FVOID_STAR) copy_int_to_ushort, NULL}, - {(FVOID_STAR) copy_int_to_int, NULL}, - {(FVOID_STAR) copy_int_to_int, NULL}, - {(FVOID_STAR) copy_int_to_long, int_to_long}, - {(FVOID_STAR) copy_int_to_ulong, int_to_ulong}, - {(FVOID_STAR) copy_int_to_float, int_to_float}, - {(FVOID_STAR) copy_int_to_double, int_to_double}, - }, - - { - {(FVOID_STAR) copy_uint_to_char, NULL}, - {(FVOID_STAR) copy_uint_to_uchar, NULL}, - {(FVOID_STAR) copy_uint_to_short, NULL}, - {(FVOID_STAR) copy_uint_to_ushort, NULL}, - {(FVOID_STAR) copy_int_to_int, NULL}, - {(FVOID_STAR) copy_int_to_int, NULL}, - {(FVOID_STAR) copy_uint_to_long, uint_to_long}, - {(FVOID_STAR) copy_uint_to_ulong, uint_to_ulong}, - {(FVOID_STAR) copy_uint_to_float, uint_to_float}, - {(FVOID_STAR) copy_uint_to_double, uint_to_double}, - }, - - { - {(FVOID_STAR) copy_long_to_char, NULL}, - {(FVOID_STAR) copy_long_to_uchar, NULL}, - {(FVOID_STAR) copy_long_to_short, NULL}, - {(FVOID_STAR) copy_long_to_ushort, NULL}, - {(FVOID_STAR) copy_long_to_int, NULL}, - {(FVOID_STAR) copy_long_to_uint, NULL}, - {(FVOID_STAR) copy_long_to_long, NULL}, - {(FVOID_STAR) copy_long_to_long, NULL}, - {(FVOID_STAR) copy_long_to_float, long_to_float}, - {(FVOID_STAR) copy_long_to_double, long_to_double}, - }, - - { - {(FVOID_STAR) copy_ulong_to_char, NULL}, - {(FVOID_STAR) copy_ulong_to_uchar, NULL}, - {(FVOID_STAR) copy_ulong_to_short, NULL}, - {(FVOID_STAR) copy_ulong_to_ushort, NULL}, - {(FVOID_STAR) copy_ulong_to_int, NULL}, - {(FVOID_STAR) copy_ulong_to_uint, NULL}, - {(FVOID_STAR) copy_long_to_long, NULL}, - {(FVOID_STAR) copy_long_to_long, NULL}, - {(FVOID_STAR) copy_ulong_to_float, ulong_to_float}, - {(FVOID_STAR) copy_ulong_to_double, ulong_to_double}, - }, - - { - {(FVOID_STAR) copy_float_to_char, NULL}, - {(FVOID_STAR) copy_float_to_uchar, NULL}, - {(FVOID_STAR) copy_float_to_short, NULL}, - {(FVOID_STAR) copy_float_to_ushort, NULL}, - {(FVOID_STAR) copy_float_to_int, NULL}, - {(FVOID_STAR) copy_float_to_uint, NULL}, - {(FVOID_STAR) copy_float_to_long, NULL}, - {(FVOID_STAR) copy_float_to_ulong, NULL}, - {(FVOID_STAR) copy_float_to_float, NULL}, - {(FVOID_STAR) copy_float_to_double, float_to_double}, - }, - - { - {(FVOID_STAR) copy_double_to_char, NULL}, - {(FVOID_STAR) copy_double_to_uchar, NULL}, - {(FVOID_STAR) copy_double_to_short, NULL}, - {(FVOID_STAR) copy_double_to_ushort, NULL}, - {(FVOID_STAR) copy_double_to_int, NULL}, - {(FVOID_STAR) copy_double_to_uint, NULL}, - {(FVOID_STAR) copy_double_to_long, NULL}, - {(FVOID_STAR) copy_double_to_ulong, NULL}, - {(FVOID_STAR) copy_double_to_float, NULL}, - {(FVOID_STAR) copy_double_to_double, NULL}, - } -}; - -#define GENERIC_BINARY_FUNCTION int_int_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE int -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define ABS_FUNCTION abs -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define GENERIC_UNARY_FUNCTION int_unary_op -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define SCALAR_BINARY_FUNCTION int_int_scalar_bin_op -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_INT_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION int_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION uint_uint_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned int -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define GENERIC_UNARY_FUNCTION uint_unary_op -#define ABS_FUNCTION(a) (a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#define SCALAR_BINARY_FUNCTION uint_uint_scalar_bin_op -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_UINT_TYPE,(int)(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION uint_cmp_function -#include "slarith.inc" - -#if SIZEOF_LONG != SIZEOF_INT -#define GENERIC_BINARY_FUNCTION long_long_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE long -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define GENERIC_UNARY_FUNCTION long_unary_op -#define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a)) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define SCALAR_BINARY_FUNCTION long_long_scalar_bin_op -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_LONG_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION long_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION ulong_ulong_bin_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned long -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) ((a) % (b)) -#define GENERIC_UNARY_FUNCTION ulong_unary_op -#define ABS_FUNCTION(a) (a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#define SCALAR_BINARY_FUNCTION ulong_ulong_scalar_bin_op -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_ULONG_TYPE,(long)(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION ulong_cmp_function -#include "slarith.inc" -#else -#define long_long_bin_op int_int_bin_op -#define ulong_ulong_bin_op uint_uint_bin_op -#define long_unary_op int_unary_op -#define ulong_unary_op uint_unary_op -#define long_cmp_function int_cmp_function -#define ulong_cmp_function uint_cmp_function -#endif /* SIZEOF_INT != SIZEOF_LONG */ - -#define GENERIC_BINARY_FUNCTION float_float_bin_op -#define GENERIC_TYPE float -#define POW_FUNCTION(a,b) (float)pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE float -#define MOD_FUNCTION(a,b) (float)fmod((a),(b)) -#define GENERIC_UNARY_FUNCTION float_unary_op -#define ABS_FUNCTION(a) (float)fabs((double) a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define SCALAR_BINARY_FUNCTION float_float_scalar_bin_op -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE, (x)) -#define CMP_FUNCTION float_cmp_function -#include "slarith.inc" - -#define GENERIC_BINARY_FUNCTION double_double_bin_op -#define GENERIC_TYPE double -#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) -#define POW_RESULT_TYPE double -#define MOD_FUNCTION(a,b) (float)fmod((a),(b)) -#define GENERIC_UNARY_FUNCTION double_unary_op -#define ABS_FUNCTION(a) fabs(a) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define SCALAR_BINARY_FUNCTION double_double_scalar_bin_op -#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE,(x)) -#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) -#define CMP_FUNCTION double_cmp_function -#include "slarith.inc" - -#define GENERIC_UNARY_FUNCTION char_unary_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE signed char -#define ABS_FUNCTION abs -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define CMP_FUNCTION char_cmp_function -#include "slarith.inc" - -#define GENERIC_UNARY_FUNCTION uchar_unary_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned char -#define ABS_FUNCTION(x) (x) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#define CMP_FUNCTION uchar_cmp_function -#include "slarith.inc" - -#if SIZEOF_SHORT != SIZEOF_INT -#define GENERIC_UNARY_FUNCTION short_unary_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE short -#define ABS_FUNCTION abs -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) -#define CMP_FUNCTION short_cmp_function -#include "slarith.inc" - -#define GENERIC_UNARY_FUNCTION ushort_unary_op -#define GENERIC_BIT_OPERATIONS -#define GENERIC_TYPE unsigned short -#define ABS_FUNCTION(x) (x) -#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) -#define CMP_FUNCTION ushort_cmp_function -#include "slarith.inc" -#endif /* SIZEOF_INT != SIZEOF_SHORT */ - -/* Unfortunately, the numbers that were assigned to the data-types were - * not well thought out. So, I need to use the following table. - */ -#define MAXIMUM_ARITH_TYPE_VALUE SLANG_FLOAT_TYPE -#define IS_INTEGER_TYPE(x) \ - (((x) <= MAXIMUM_ARITH_TYPE_VALUE) \ - && (Type_Precedence_Table[x] < 8) && (Type_Precedence_Table[x] != -1)) -#define IS_ARITHMETIC_TYPE(x) \ - (((x) <= MAXIMUM_ARITH_TYPE_VALUE) && (Type_Precedence_Table[x] != -1)) - -#define LONG_PRECEDENCE_VALUE 6 -#define FLOAT_PRECEDENCE_VALUE 8 - -static signed char Type_Precedence_Table [MAXIMUM_ARITH_TYPE_VALUE + 1] = -{ - -1, /* SLANG_UNDEFINED_TYPE */ - -1, /* SLANG_VOID_TYPE */ - 4, /* SLANG_INT_TYPE */ - 9, /* SLANG_DOUBLE_TYPE */ - 0, /* SLANG_CHAR_TYPE */ - -1, /* SLANG_INTP_TYPE */ - -1, /* SLANG_REF_TYPE */ - -1, /* SLANG_COMPLEX_TYPE */ - -1, /* SLANG_NULL_TYPE */ - 1, /* SLANG_UCHAR_TYPE */ - 2, /* SLANG_SHORT_TYPE */ - 3, /* SLANG_USHORT_TYPE */ - 5, /* SLANG_UINT_TYPE */ - 6, /* SLANG_LONG_TYPE */ - 7, /* SLANG_ULONG_TYPE */ - -1, /* SLANG_STRING_TYPE */ - 8 /* SLANG_FLOAT_TYPE */ -}; - -int _SLarith_get_precedence (unsigned char type) -{ - if (type > MAXIMUM_ARITH_TYPE_VALUE) - return -1; - - return Type_Precedence_Table[type]; -} - -unsigned char _SLarith_promote_type (unsigned char t) -{ - switch (t) - { - case SLANG_FLOAT_TYPE: - case SLANG_DOUBLE_TYPE: - case SLANG_LONG_TYPE: - case SLANG_ULONG_TYPE: - case SLANG_INT_TYPE: - case SLANG_UINT_TYPE: - break; - - case SLANG_USHORT_TYPE: -#if SIZEOF_INT == SIZEOF_SHORT - t = SLANG_UINT_TYPE; - break; -#endif - /* drop */ - case SLANG_CHAR_TYPE: - case SLANG_UCHAR_TYPE: - case SLANG_SHORT_TYPE: - default: - t = SLANG_INT_TYPE; - } - - return t; -} - -static unsigned char promote_to_common_type (unsigned char a, unsigned char b) -{ - a = _SLarith_promote_type (a); - b = _SLarith_promote_type (b); - - return (Type_Precedence_Table[a] > Type_Precedence_Table[b]) ? a : b; -} - -static int arith_bin_op_result (int op, unsigned char a_type, unsigned char b_type, - unsigned char *c_type) -{ - switch (op) - { - case SLANG_EQ: - case SLANG_NE: - case SLANG_GT: - case SLANG_GE: - case SLANG_LT: - case SLANG_LE: - case SLANG_OR: - case SLANG_AND: - *c_type = SLANG_CHAR_TYPE; - return 1; - - case SLANG_POW: - if (SLANG_FLOAT_TYPE == promote_to_common_type (a_type, b_type)) - *c_type = SLANG_FLOAT_TYPE; - else - *c_type = SLANG_DOUBLE_TYPE; - return 1; - - case SLANG_BAND: - case SLANG_BXOR: - case SLANG_BOR: - case SLANG_SHL: - case SLANG_SHR: - /* The bit-level operations are defined just for integer types */ - if ((0 == IS_INTEGER_TYPE (a_type)) - || (0 == IS_INTEGER_TYPE(b_type))) - return 0; - break; - - default: - break; - } - - *c_type = promote_to_common_type (a_type, b_type); - return 1; -} - -typedef int (*Bin_Fun_Type) (int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR); - -/* This array of functions must be indexed by precedence after arithmetic - * promotions. - */ -static Bin_Fun_Type Bin_Fun_Map [MAX_ARITHMETIC_TYPES] = -{ - NULL, - NULL, - NULL, - NULL, - int_int_bin_op, - uint_uint_bin_op, - long_long_bin_op, - ulong_ulong_bin_op, - float_float_bin_op, - double_double_bin_op -}; - -static int arith_bin_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - Convert_Fun_Type af, bf; - Bin_Fun_Type binfun; - int a_indx, b_indx, c_indx; - unsigned char c_type; - int ret; - - c_type = promote_to_common_type (a_type, b_type); - - a_indx = Type_Precedence_Table [a_type]; - b_indx = Type_Precedence_Table [b_type]; - c_indx = Type_Precedence_Table [c_type]; - - af = Binary_Matrix[a_indx][c_indx].convert_function; - bf = Binary_Matrix[b_indx][c_indx].convert_function; - binfun = Bin_Fun_Map[c_indx]; - - if ((af != NULL) - && (NULL == (ap = (VOID_STAR) (*af) (ap, na)))) - return -1; - - if ((bf != NULL) - && (NULL == (bp = (VOID_STAR) (*bf) (bp, nb)))) - { - if (af != NULL) SLfree ((char *) ap); - return -1; - } - - ret = (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp); - if (af != NULL) SLfree ((char *) ap); - if (bf != NULL) SLfree ((char *) bp); - - return ret; -} - -static int arith_unary_op_result (int op, unsigned char a, unsigned char *b) -{ - (void) a; - switch (op) - { - default: - return 0; - - case SLANG_SQR: - case SLANG_MUL2: - case SLANG_PLUSPLUS: - case SLANG_MINUSMINUS: - case SLANG_CHS: - case SLANG_ABS: - *b = a; - break; - - case SLANG_NOT: - case SLANG_BNOT: - if (0 == IS_INTEGER_TYPE(a)) - return 0; - *b = a; - break; - - case SLANG_SIGN: - *b = SLANG_INT_TYPE; - break; - } - return 1; -} - -static int integer_pop (unsigned char type, VOID_STAR ptr) -{ - SLang_Object_Type obj; - int i, j; - void (*f)(VOID_STAR, VOID_STAR, unsigned int); - - if (-1 == SLang_pop (&obj)) - return -1; - - if ((obj.data_type > MAXIMUM_ARITH_TYPE_VALUE) - || ((j = Type_Precedence_Table[obj.data_type]) == -1) - || (j >= FLOAT_PRECEDENCE_VALUE)) - { - _SLclass_type_mismatch_error (type, obj.data_type); - SLang_free_object (&obj); - return -1; - } - - i = Type_Precedence_Table[type]; - f = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) - Binary_Matrix[j][i].copy_function; - - (*f) (ptr, (VOID_STAR)&obj.v, 1); - - return 0; -} - -static int integer_push (unsigned char type, VOID_STAR ptr) -{ - SLang_Object_Type obj; - int i; - void (*f)(VOID_STAR, VOID_STAR, unsigned int); - - i = Type_Precedence_Table[type]; - f = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) - Binary_Matrix[i][i].copy_function; - - obj.data_type = type; - - (*f) ((VOID_STAR)&obj.v, ptr, 1); - - return SLang_push (&obj); -} - -int SLang_pop_char (char *i) -{ - return integer_pop (SLANG_CHAR_TYPE, (VOID_STAR) i); -} - -int SLang_pop_uchar (unsigned char *i) -{ - return integer_pop (SLANG_UCHAR_TYPE, (VOID_STAR) i); -} - -int SLang_pop_short (short *i) -{ - return integer_pop (SLANG_SHORT_TYPE, (VOID_STAR) i); -} - -int SLang_pop_ushort (unsigned short *i) -{ - return integer_pop (SLANG_USHORT_TYPE, (VOID_STAR) i); -} - -int SLang_pop_long (long *i) -{ - return integer_pop (SLANG_LONG_TYPE, (VOID_STAR) i); -} - -int SLang_pop_ulong (unsigned long *i) -{ - return integer_pop (SLANG_ULONG_TYPE, (VOID_STAR) i); -} - -int SLang_pop_integer (int *i) -{ -#if _SLANG_OPTIMIZE_FOR_SPEED - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (SLANG_INT_TYPE, &obj, 0)) - return -1; - *i = obj.v.int_val; - return 0; -#else - return integer_pop (SLANG_INT_TYPE, (VOID_STAR) i); -#endif -} - -int SLang_pop_uinteger (unsigned int *i) -{ - return integer_pop (SLANG_UINT_TYPE, (VOID_STAR) i); -} - -int SLang_push_integer (int i) -{ - return SLclass_push_int_obj (SLANG_INT_TYPE, i); -} -int SLang_push_uinteger (unsigned int i) -{ - return SLclass_push_int_obj (SLANG_UINT_TYPE, (int) i); -} -int SLang_push_char (char i) -{ - return SLclass_push_char_obj (SLANG_CHAR_TYPE, i); -} -int SLang_push_uchar (unsigned char i) -{ - return SLclass_push_char_obj (SLANG_UCHAR_TYPE, (char) i); -} -int SLang_push_short (short i) -{ - return SLclass_push_short_obj (SLANG_SHORT_TYPE, i); -} -int SLang_push_ushort (unsigned short i) -{ - return SLclass_push_short_obj (SLANG_USHORT_TYPE, (unsigned short) i); -} -int SLang_push_long (long i) -{ - return SLclass_push_long_obj (SLANG_LONG_TYPE, i); -} -int SLang_push_ulong (unsigned long i) -{ - return SLclass_push_long_obj (SLANG_ULONG_TYPE, (long) i); -} - -_INLINE_ -int _SLarith_typecast (unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp) -{ - int i, j; - - void (*copy)(VOID_STAR, VOID_STAR, unsigned int); - - i = Type_Precedence_Table[a_type]; - j = Type_Precedence_Table[b_type]; - - copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) - Binary_Matrix[i][j].copy_function; - - (*copy) (bp, ap, na); - return 1; -} - -#if SLANG_HAS_FLOAT - -int SLang_pop_double(double *x, int *convertp, int *ip) -{ - SLang_Object_Type obj; - int i, convert; - - if (0 != SLang_pop (&obj)) - return -1; - - i = 0; - convert = 0; - - switch (obj.data_type) - { - case SLANG_FLOAT_TYPE: - *x = (double) obj.v.float_val; - break; - - case SLANG_DOUBLE_TYPE: - *x = obj.v.double_val; - break; - - case SLANG_INT_TYPE: - i = (int) obj.v.long_val; - *x = (double) i; - convert = 1; - break; - - case SLANG_CHAR_TYPE: *x = (double) obj.v.char_val; break; - case SLANG_UCHAR_TYPE: *x = (double) obj.v.uchar_val; break; - case SLANG_SHORT_TYPE: *x = (double) obj.v.short_val; break; - case SLANG_USHORT_TYPE: *x = (double) obj.v.ushort_val; break; - case SLANG_UINT_TYPE: *x = (double) obj.v.uint_val; break; - case SLANG_LONG_TYPE: *x = (double) obj.v.long_val; break; - case SLANG_ULONG_TYPE: *x = (double) obj.v.ulong_val; break; - - default: - _SLclass_type_mismatch_error (SLANG_DOUBLE_TYPE, obj.data_type); - SLang_free_object (&obj); - return -1; - } - - if (convertp != NULL) *convertp = convert; - if (ip != NULL) *ip = i; - - return 0; -} - -int SLang_push_double (double x) -{ - return SLclass_push_double_obj (SLANG_DOUBLE_TYPE, x); -} - -int SLang_pop_float (float *x) -{ - double d; - - /* Pop it as a double and let the double function do all the typcasting */ - if (-1 == SLang_pop_double (&d, NULL, NULL)) - return -1; - - *x = (float) d; - return 0; -} - -int SLang_push_float (float f) -{ - return SLclass_push_float_obj (SLANG_FLOAT_TYPE, (double) f); -} - -/* Double */ -static int double_push (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - SLang_push_double (*(double *) ptr); - return 0; -} - -static int double_push_literal (unsigned char type, VOID_STAR ptr) -{ - (void) type; - return SLang_push_double (**(double **)ptr); -} - -static int double_pop (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - return SLang_pop_double ((double *) ptr, NULL, NULL); -} - -static void double_byte_code_destroy (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - SLfree (*(char **) ptr); -} - -static int float_push (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - SLang_push_float (*(float *) ptr); - return 0; -} - -static int float_pop (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - return SLang_pop_float ((float *) ptr); -} - -#endif /* SLANG_HAS_FLOAT */ - -#if SLANG_HAS_FLOAT -static char Double_Format[16] = "%g"; - -void _SLset_double_format (char *s) -{ - strncpy (Double_Format, s, 15); - Double_Format[15] = 0; -} -#endif - -static char *arith_string (unsigned char type, VOID_STAR v) -{ - char buf [256]; - char *s; - - s = buf; - - switch (type) - { - default: - s = SLclass_get_datatype_name (type); - break; - - case SLANG_CHAR_TYPE: - sprintf (s, "%d", *(char *) v); - break; - case SLANG_UCHAR_TYPE: - sprintf (s, "%u", *(unsigned char *) v); - break; - case SLANG_SHORT_TYPE: - sprintf (s, "%d", *(short *) v); - break; - case SLANG_USHORT_TYPE: - sprintf (s, "%u", *(unsigned short *) v); - break; - case SLANG_INT_TYPE: - sprintf (s, "%d", *(int *) v); - break; - case SLANG_UINT_TYPE: - sprintf (s, "%u", *(unsigned int *) v); - break; - case SLANG_LONG_TYPE: - sprintf (s, "%ld", *(long *) v); - break; - case SLANG_ULONG_TYPE: - sprintf (s, "%lu", *(unsigned long *) v); - break; -#if SLANG_HAS_FLOAT - case SLANG_FLOAT_TYPE: - if (EOF == _SLsnprintf (buf, sizeof (buf), Double_Format, *(float *) v)) - sprintf (s, "%e", *(float *) v); - break; - case SLANG_DOUBLE_TYPE: - if (EOF == _SLsnprintf (buf, sizeof (buf), Double_Format, *(double *) v)) - sprintf (s, "%e", *(double *) v); - break; -#endif - } - - return SLmake_string (s); -} - -static int integer_to_bool (unsigned char type, int *t) -{ - (void) type; - return SLang_pop_integer (t); -} - -static int push_int_literal (unsigned char type, VOID_STAR ptr) -{ - return SLclass_push_int_obj (type, (int) *(long *) ptr); -} - -static int push_char_literal (unsigned char type, VOID_STAR ptr) -{ - return SLclass_push_char_obj (type, (char) *(long *) ptr); -} - -#if SIZEOF_SHORT != SIZEOF_INT -static int push_short_literal (unsigned char type, VOID_STAR ptr) -{ - return SLclass_push_short_obj (type, (short) *(long *) ptr); -} -#endif - -#if SIZEOF_INT != SIZEOF_LONG -static int push_long_literal (unsigned char type, VOID_STAR ptr) -{ - return SLclass_push_long_obj (type, *(long *) ptr); -} -#endif - -typedef struct -{ - char *name; - unsigned char data_type; - unsigned int sizeof_type; - int (*unary_fun)(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR); - int (*push_literal) (unsigned char, VOID_STAR); - int (*cmp_fun) (unsigned char, VOID_STAR, VOID_STAR, int *); -} -Integer_Info_Type; - -static Integer_Info_Type Integer_Types [8] = -{ - {"Char_Type", SLANG_CHAR_TYPE, sizeof (char), char_unary_op, push_char_literal, char_cmp_function}, - {"UChar_Type", SLANG_UCHAR_TYPE, sizeof (unsigned char), uchar_unary_op, push_char_literal, uchar_cmp_function}, -#if SIZEOF_INT != SIZEOF_SHORT - {"Short_Type", SLANG_SHORT_TYPE, sizeof (short), short_unary_op, push_short_literal, short_cmp_function}, - {"UShort_Type", SLANG_USHORT_TYPE, sizeof (unsigned short), ushort_unary_op, push_short_literal, ushort_cmp_function}, -#else - {NULL, SLANG_SHORT_TYPE}, - {NULL, SLANG_USHORT_TYPE}, -#endif - - {"Integer_Type", SLANG_INT_TYPE, sizeof (int), int_unary_op, push_int_literal, int_cmp_function}, - {"UInteger_Type", SLANG_UINT_TYPE, sizeof (unsigned int), uint_unary_op, push_int_literal, uint_cmp_function}, - -#if SIZEOF_INT != SIZEOF_LONG - {"Long_Type", SLANG_LONG_TYPE, sizeof (long), long_unary_op, push_long_literal, long_cmp_function}, - {"ULong_Type", SLANG_ULONG_TYPE, sizeof (unsigned long), ulong_unary_op, push_long_literal, ulong_cmp_function} -#else - {NULL, SLANG_LONG_TYPE, 0, NULL, NULL, NULL}, - {NULL, SLANG_ULONG_TYPE, 0, NULL, NULL, NULL} -#endif -}; - -static int create_synonyms (void) -{ - static char *names[8] = - { - "Int16_Type", "UInt16_Type", "Int32_Type", "UInt32_Type", - "Int64_Type", "UInt64_Type", - "Float32_Type", "Float64_Type" - }; - int types[8]; - unsigned int i; - - memset ((char *) types, 0, sizeof (types)); - - /* The assumption is that sizeof(unsigned X) == sizeof (X) */ -#if SIZEOF_INT == 2 - types[0] = SLANG_INT_TYPE; - types[1] = SLANG_UINT_TYPE; -#else -# if SIZEOF_SHORT == 2 - types[0] = SLANG_SHORT_TYPE; - types[1] = SLANG_USHORT_TYPE; -# else -# if SIZEOF_LONG == 2 - types[0] = SLANG_LONG_TYPE; - types[1] = SLANG_ULONG_TYPE; -# endif -# endif -#endif - -#if SIZEOF_INT == 4 - types[2] = SLANG_INT_TYPE; - types[3] = SLANG_UINT_TYPE; -#else -# if SIZEOF_SHORT == 4 - types[2] = SLANG_SHORT_TYPE; - types[3] = SLANG_USHORT_TYPE; -# else -# if SIZEOF_LONG == 4 - types[2] = SLANG_LONG_TYPE; - types[3] = SLANG_ULONG_TYPE; -# endif -# endif -#endif - -#if SIZEOF_INT == 8 - types[4] = SLANG_INT_TYPE; - types[5] = SLANG_UINT_TYPE; -#else -# if SIZEOF_SHORT == 8 - types[4] = SLANG_SHORT_TYPE; - types[5] = SLANG_USHORT_TYPE; -# else -# if SIZEOF_LONG == 8 - types[4] = SLANG_LONG_TYPE; - types[5] = SLANG_ULONG_TYPE; -# endif -# endif -#endif - -#if SLANG_HAS_FLOAT - -#if SIZEOF_FLOAT == 4 - types[6] = SLANG_FLOAT_TYPE; -#else -# if SIZEOF_DOUBLE == 4 - types[6] = SLANG_DOUBLE_TYPE; -# endif -#endif -#if SIZEOF_FLOAT == 8 - types[7] = SLANG_FLOAT_TYPE; -#else -# if SIZEOF_DOUBLE == 8 - types[7] = SLANG_DOUBLE_TYPE; -# endif -#endif - -#endif - - if ((-1 == SLclass_create_synonym ("Int_Type", SLANG_INT_TYPE)) - || (-1 == SLclass_create_synonym ("UInt_Type", SLANG_UINT_TYPE))) - return -1; - - for (i = 0; i < 8; i++) - { - if (types[i] == 0) continue; - - if (-1 == SLclass_create_synonym (names[i], types[i])) - return -1; - } - -#if SIZEOF_INT == SIZEOF_SHORT - if ((-1 == SLclass_create_synonym ("Short_Type", SLANG_INT_TYPE)) - || (-1 == SLclass_create_synonym ("UShort_Type", SLANG_UINT_TYPE)) - || (-1 == _SLclass_copy_class (SLANG_SHORT_TYPE, SLANG_INT_TYPE)) - || (-1 == _SLclass_copy_class (SLANG_USHORT_TYPE, SLANG_UINT_TYPE))) - return -1; -#endif -#if SIZEOF_INT == SIZEOF_LONG - if ((-1 == SLclass_create_synonym ("Long_Type", SLANG_INT_TYPE)) - || (-1 == SLclass_create_synonym ("ULong_Type", SLANG_UINT_TYPE)) - || (-1 == _SLclass_copy_class (SLANG_LONG_TYPE, SLANG_INT_TYPE)) - || (-1 == _SLclass_copy_class (SLANG_ULONG_TYPE, SLANG_UINT_TYPE))) - return -1; -#endif - return 0; -} - -int _SLarith_register_types (void) -{ - SLang_Class_Type *cl; - int a_type, b_type; - int i, j; - -#if defined(HAVE_SETLOCALE) && defined(LC_NUMERIC) - /* make sure decimal point it used --- the parser requires it */ - (void) setlocale (LC_NUMERIC, "C"); -#endif - - for (i = 0; i < 8; i++) - { - Integer_Info_Type *info; - - info = Integer_Types + i; - - if (info->name == NULL) - { - /* This happens when the object is the same size as an integer - * For this case, we really want to copy the integer class. - * We will handle that when the synonym is created. - */ - continue; - } - - if (NULL == (cl = SLclass_allocate_class (info->name))) - return -1; - - (void) SLclass_set_string_function (cl, arith_string); - (void) SLclass_set_push_function (cl, integer_push); - (void) SLclass_set_pop_function (cl, integer_pop); - cl->cl_push_literal = info->push_literal; - cl->cl_to_bool = integer_to_bool; - - cl->cl_cmp = info->cmp_fun; - - if (-1 == SLclass_register_class (cl, info->data_type, info->sizeof_type, - SLANG_CLASS_TYPE_SCALAR)) - return -1; - if (-1 == SLclass_add_unary_op (info->data_type, info->unary_fun, arith_unary_op_result)) - return -1; - - _SLarith_Is_Arith_Type [info->data_type] = 1; - } - -#if SLANG_HAS_FLOAT - if (NULL == (cl = SLclass_allocate_class ("Double_Type"))) - return -1; - (void) SLclass_set_push_function (cl, double_push); - (void) SLclass_set_pop_function (cl, double_pop); - (void) SLclass_set_string_function (cl, arith_string); - cl->cl_byte_code_destroy = double_byte_code_destroy; - cl->cl_push_literal = double_push_literal; - cl->cl_cmp = double_cmp_function; - - if (-1 == SLclass_register_class (cl, SLANG_DOUBLE_TYPE, sizeof (double), - SLANG_CLASS_TYPE_SCALAR)) - return -1; - if (-1 == SLclass_add_unary_op (SLANG_DOUBLE_TYPE, double_unary_op, arith_unary_op_result)) - return -1; - _SLarith_Is_Arith_Type [SLANG_DOUBLE_TYPE] = 2; - - if (NULL == (cl = SLclass_allocate_class ("Float_Type"))) - return -1; - (void) SLclass_set_string_function (cl, arith_string); - (void) SLclass_set_push_function (cl, float_push); - (void) SLclass_set_pop_function (cl, float_pop); - cl->cl_cmp = float_cmp_function; - - if (-1 == SLclass_register_class (cl, SLANG_FLOAT_TYPE, sizeof (float), - SLANG_CLASS_TYPE_SCALAR)) - return -1; - if (-1 == SLclass_add_unary_op (SLANG_FLOAT_TYPE, float_unary_op, arith_unary_op_result)) - return -1; - _SLarith_Is_Arith_Type [SLANG_FLOAT_TYPE] = 2; -#endif - - if (-1 == create_synonyms ()) - return -1; - - for (a_type = 0; a_type <= MAXIMUM_ARITH_TYPE_VALUE; a_type++) - { - if (-1 == (i = Type_Precedence_Table [a_type])) - continue; - - for (b_type = 0; b_type <= MAXIMUM_ARITH_TYPE_VALUE; b_type++) - { - int implicit_ok; - - if (-1 == (j = Type_Precedence_Table [b_type])) - continue; - - /* Allow implicit typecast, except from into to float */ - implicit_ok = ((j >= FLOAT_PRECEDENCE_VALUE) - || (i < FLOAT_PRECEDENCE_VALUE)); - - if (-1 == SLclass_add_binary_op (a_type, b_type, arith_bin_op, arith_bin_op_result)) - return -1; - - if (i != j) - if (-1 == SLclass_add_typecast (a_type, b_type, _SLarith_typecast, implicit_ok)) - return -1; - } - } - - return 0; -} - -#if _SLANG_OPTIMIZE_FOR_SPEED - -static void promote_objs (SLang_Object_Type *a, SLang_Object_Type *b, - SLang_Object_Type *c, SLang_Object_Type *d) -{ - unsigned char ia, ib, ic, id; - int i, j; - void (*copy)(VOID_STAR, VOID_STAR, unsigned int); - - ia = a->data_type; - ib = b->data_type; - - ic = _SLarith_promote_type (ia); - - if (ic == ib) id = ic; /* already promoted */ - else id = _SLarith_promote_type (ib); - - i = Type_Precedence_Table[ic]; - j = Type_Precedence_Table[id]; - if (i > j) - { - id = ic; - j = i; - } - - c->data_type = d->data_type = id; - - i = Type_Precedence_Table[ia]; - copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) - Binary_Matrix[i][j].copy_function; - (*copy) ((VOID_STAR) &c->v, (VOID_STAR)&a->v, 1); - - i = Type_Precedence_Table[ib]; - copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) - Binary_Matrix[i][j].copy_function; - (*copy) ((VOID_STAR) &d->v, (VOID_STAR)&b->v, 1); -} - -int _SLarith_bin_op (SLang_Object_Type *oa, SLang_Object_Type *ob, int op) -{ - unsigned char a_type, b_type; - - a_type = oa->data_type; - b_type = ob->data_type; - - if (a_type != b_type) - { - SLang_Object_Type obj_a, obj_b; - - /* Handle common cases */ - if ((a_type == SLANG_INT_TYPE) - && (b_type == SLANG_DOUBLE_TYPE)) - return double_double_scalar_bin_op (oa->v.int_val, ob->v.double_val, op); - - if ((a_type == SLANG_DOUBLE_TYPE) - && (b_type == SLANG_INT_TYPE)) - return double_double_scalar_bin_op (oa->v.double_val, ob->v.int_val, op); - - /* Otherwise do it the hard way */ - promote_objs (oa, ob, &obj_a, &obj_b); - oa = &obj_a; - ob = &obj_b; - - a_type = oa->data_type; - b_type = ob->data_type; - } - - - switch (a_type) - { - case SLANG_CHAR_TYPE: - return int_int_scalar_bin_op (oa->v.char_val, ob->v.char_val, op); - - case SLANG_UCHAR_TYPE: - return int_int_scalar_bin_op (oa->v.uchar_val, ob->v.uchar_val, op); - - case SLANG_SHORT_TYPE: - return int_int_scalar_bin_op (oa->v.short_val, ob->v.short_val, op); - - case SLANG_USHORT_TYPE: -# if SIZEOF_INT == SIZEOF_SHORT - return uint_uint_scalar_bin_op (oa->v.ushort_val, ob->v.ushort_val, op); -# else - return int_int_scalar_bin_op ((int)oa->v.ushort_val, (int)ob->v.ushort_val, op); -# endif - -#if SIZEOF_LONG == SIZEOF_INT - case SLANG_LONG_TYPE: -#endif - case SLANG_INT_TYPE: - return int_int_scalar_bin_op (oa->v.int_val, ob->v.int_val, op); - -#if SIZEOF_LONG == SIZEOF_INT - case SLANG_ULONG_TYPE: -#endif - case SLANG_UINT_TYPE: - return uint_uint_scalar_bin_op (oa->v.uint_val, ob->v.uint_val, op); - -#if SIZEOF_LONG != SIZEOF_INT - case SLANG_LONG_TYPE: - return long_long_scalar_bin_op (oa->v.long_val, ob->v.long_val, op); - case SLANG_ULONG_TYPE: - return ulong_ulong_scalar_bin_op (oa->v.ulong_val, ob->v.ulong_val, op); -#endif - case SLANG_FLOAT_TYPE: - return float_float_scalar_bin_op (oa->v.float_val, ob->v.float_val, op); - case SLANG_DOUBLE_TYPE: - return double_double_scalar_bin_op (oa->v.double_val, ob->v.double_val, op); - } - - return 1; -} -#endif diff --git a/mdk-stage1/slang/slarith.inc b/mdk-stage1/slang/slarith.inc deleted file mode 100644 index efa8a5e04..000000000 --- a/mdk-stage1/slang/slarith.inc +++ /dev/null @@ -1,783 +0,0 @@ -/* -*- c -*- */ - -/* This include file is a template for defining arithmetic binary operations - * on arithmetic types. I realize that doing it this way is not very - * elegant but it minimizes the number of lines of code and I believe it - * promotes clarity. - */ - -/* The following macros should be properly defined before including this file: - * - * GENERIC_BINARY_FUNCTION: The name of the binary function - * GENERIC_TYPE: The class data type - * MOD_FUNCTION: The function to use for mod - * ABS_FUNCTION: Name of the abs function - * SIGN_FUNCTION: Name of the sign function - * GENERIC_UNARY_FUNCTION Name of the unary function - * - * If GENERIC_BIT_OPERATIONS is defined, the bit-level binary operators - * will get included. If the data type has a power operation (SLANG_POW), - * then POW_FUNCTION should be defined to return POW_RESULT_TYPE. - */ -#ifdef GENERIC_BINARY_FUNCTION - -static int GENERIC_BINARY_FUNCTION -(int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - GENERIC_TYPE *c, *a, *b; -#ifdef POW_FUNCTION - POW_RESULT_TYPE *d; -#endif - unsigned int n; -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - unsigned int n_max, da, db; -#endif - char *cc; - - (void) a_type; /* Both SLANG_INT_TYPE */ - (void) b_type; - - a = (GENERIC_TYPE *) ap; - b = (GENERIC_TYPE *) bp; - c = (GENERIC_TYPE *) cp; - cc = (char *) cp; - -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - if (na == 1) da = 0; else da = 1; - if (nb == 1) db = 0; else db = 1; - - if (na > nb) n_max = na; else n_max = nb; -#endif - - switch (op) - { - default: - return 0; -#ifdef POW_FUNCTION - case SLANG_POW: - d = (POW_RESULT_TYPE *) cp; -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - d[n] = POW_FUNCTION(*a, *b); - a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - d[n] = POW_FUNCTION(a[n],b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - if (xb == 2) - for (n = 0; n < na; n++) - d[n] = a[n] * a[n]; - else - for (n = 0; n < na; n++) - d[n] = POW_FUNCTION(a[n], xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - d[n] = POW_FUNCTION(xa, b[n]); - } -#endif - break; -#endif - case SLANG_PLUS: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a + *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] + b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] + xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa + b[n]; - } -#endif - break; - - case SLANG_MINUS: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a - *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] - b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] - xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa - b[n]; - } -#endif - break; - - case SLANG_TIMES: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a * *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] * b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] * xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa * b[n]; - } -#endif - break; - - case SLANG_DIVIDE: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - if (*b == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = (*a / *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - { - if (b[n] == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = a[n] / b[n]; - } - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - - if (xb == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - for (n = 0; n < na; n++) - c[n] = a[n] / xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - { - if (b[n] == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = xa / b[n]; - } - } -#endif - break; - - case SLANG_MOD: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - if (*b == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = MOD_FUNCTION(*a, *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - { - if (b[n] == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = MOD_FUNCTION(a[n],b[n]); - } - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - if (xb == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - for (n = 0; n < na; n++) - c[n] = MOD_FUNCTION(a[n],xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - { - if (b[n] == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = MOD_FUNCTION(xa,b[n]); - } - } -#endif - break; - -#ifdef GENERIC_BIT_OPERATIONS - case SLANG_BAND: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a & *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] & b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] & xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa & b[n]; - } -#endif - break; - - case SLANG_BXOR: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a ^ *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] ^ b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] ^ xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa ^ b[n]; - } -#endif - break; - - case SLANG_BOR: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a | *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] | b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] | xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa | b[n]; - } -#endif - break; - - case SLANG_SHL: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a << *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] << b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] << xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa << b[n]; - } -#endif - break; - - case SLANG_SHR: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - c[n] = (*a >> *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - c[n] = a[n] >> b[n]; - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - c[n] = a[n] >> xb; - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - c[n] = xa >> b[n]; - } -#endif - break; -#endif /* GENERIC_BIT_OPERATIONS */ - case SLANG_EQ: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a == *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] == b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] == xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa == b[n]); - } -#endif - break; - - case SLANG_NE: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a != *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] != b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] != xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa != b[n]); - } -#endif - break; - - case SLANG_GT: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a > *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] > b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] > xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa > b[n]); - } -#endif - break; - - case SLANG_GE: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a >= *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] >= b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] >= xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa >= b[n]); - } -#endif - break; - - case SLANG_LT: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a < *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] < b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] < xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa < b[n]); - } -#endif - break; - - case SLANG_LE: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a <= *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] <= b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] <= xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa <= b[n]); - } -#endif - break; - - case SLANG_OR: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a || *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] || b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] || xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa || b[n]); - } -#endif - break; - - case SLANG_AND: -#if _SLANG_OPTIMIZE_FOR_SPEED < 2 - for (n = 0; n < n_max; n++) - { - cc[n] = (*a && *b); a += da; b += db; - } -#else - if (na == nb) - { - for (n = 0; n < na; n++) - cc[n] = (a[n] && b[n]); - } - else if (nb == 1) - { - GENERIC_TYPE xb = *b; - for (n = 0; n < na; n++) - cc[n] = (a[n] && xb); - } - else /* if (na == 1) */ - { - GENERIC_TYPE xa = *a; - for (n = 0; n < nb; n++) - cc[n] = (xa && b[n]); - } -#endif - break; - } - return 1; -} - -#endif /* GENERIC_BINARY_FUNCTION */ - - -#ifdef GENERIC_UNARY_FUNCTION - -static int GENERIC_UNARY_FUNCTION -(int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - VOID_STAR bp - ) -{ - GENERIC_TYPE *a, *b; - unsigned int n; - int *ib; - - (void) a_type; - - a = (GENERIC_TYPE *) ap; - b = (GENERIC_TYPE *) bp; - - switch (op) - { - default: - return 0; - - case SLANG_PLUSPLUS: - for (n = 0; n < na; n++) b[n] = (a[n] + 1); - break; - case SLANG_MINUSMINUS: - for (n = 0; n < na; n++) b[n] = (a[n] - 1); - break; - case SLANG_CHS: - for (n = 0; n < na; n++) b[n] = (GENERIC_TYPE) -(a[n]); - break; - case SLANG_SQR: - for (n = 0; n < na; n++) b[n] = (a[n] * a[n]); - break; - case SLANG_MUL2: - for (n = 0; n < na; n++) b[n] = (2 * a[n]); - break; - case SLANG_ABS: - for (n = 0; n < na; n++) b[n] = ABS_FUNCTION (a[n]); - break; - case SLANG_SIGN: - ib = (int *) bp; - for (n = 0; n < na; n++) - ib[n] = SIGN_FUNCTION(a[n]); - break; - -#ifdef GENERIC_BIT_OPERATIONS - case SLANG_NOT: - for (n = 0; n < na; n++) b[n] = !(a[n]); - break; - case SLANG_BNOT: - for (n = 0; n < na; n++) b[n] = ~(a[n]); - break; -#endif - } - - return 1; -} -#endif /* GENERIC_UNARY_FUNCTION */ - - -#ifdef SCALAR_BINARY_FUNCTION - -static int SCALAR_BINARY_FUNCTION (GENERIC_TYPE a, GENERIC_TYPE b, int op) -{ - switch (op) - { - default: - return 1; - -#ifdef POW_FUNCTION - case SLANG_POW: - return PUSH_POW_OBJ_FUN(POW_FUNCTION(a, b)); -#endif - case SLANG_PLUS: - return PUSH_SCALAR_OBJ_FUN (a + b); - case SLANG_MINUS: - return PUSH_SCALAR_OBJ_FUN (a - b); - case SLANG_TIMES: - return PUSH_SCALAR_OBJ_FUN (a * b); - case SLANG_DIVIDE: - if (b == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - return PUSH_SCALAR_OBJ_FUN (a / b); - case SLANG_MOD: - if (b == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - return PUSH_SCALAR_OBJ_FUN (MOD_FUNCTION(a,b)); -#ifdef GENERIC_BIT_OPERATIONS - case SLANG_BAND: - return PUSH_SCALAR_OBJ_FUN (a & b); - case SLANG_BXOR: - return PUSH_SCALAR_OBJ_FUN (a ^ b); - case SLANG_BOR: - return PUSH_SCALAR_OBJ_FUN (a | b); - case SLANG_SHL: - return PUSH_SCALAR_OBJ_FUN (a << b); - case SLANG_SHR: - return PUSH_SCALAR_OBJ_FUN (a >> b); -#endif - case SLANG_GT: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a > b)); - case SLANG_LT: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a < b)); - case SLANG_GE: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a >= b)); - case SLANG_LE: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a <= b)); - case SLANG_EQ: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a == b)); - case SLANG_NE: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a != b)); - case SLANG_OR: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a || b)); - case SLANG_AND: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a && b)); - } -} - -#endif /* SCALAR_BINARY_FUNCTION */ - -#ifdef CMP_FUNCTION -static int CMP_FUNCTION (unsigned char unused, VOID_STAR a, VOID_STAR b, int *c) -{ - GENERIC_TYPE x, y; - - (void) unused; - x = *(GENERIC_TYPE *) a; - y = *(GENERIC_TYPE *) b; - - if (x > y) *c = 1; - else if (x == y) *c = 0; - else *c = -1; - - return 0; -} -#endif - -#undef CMP_FUNCTION -#undef SCALAR_BINARY_FUNCTION -#undef PUSH_POW_OBJ_FUN -#undef PUSH_SCALAR_OBJ_FUN -#undef GENERIC_BINARY_FUNCTION -#undef GENERIC_UNARY_FUNCTION -#undef GENERIC_BIT_OPERATIONS -#undef GENERIC_TYPE -#undef POW_FUNCTION -#undef POW_RESULT_TYPE -#undef MOD_FUNCTION -#undef ABS_FUNCTION -#undef SIGN_FUNCTION diff --git a/mdk-stage1/slang/slarray.c b/mdk-stage1/slang/slarray.c deleted file mode 100644 index 0b9a1406c..000000000 --- a/mdk-stage1/slang/slarray.c +++ /dev/null @@ -1,3139 +0,0 @@ -/* Array manipulation routines for S-Lang */ -/* Copyright (c) 1997, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#define SL_APP_WANTS_FOREACH -#include "slang.h" -#include "_slang.h" - -typedef struct -{ - int first_index; - int last_index; - int delta; -} -SLarray_Range_Array_Type; - -/* Use SLang_pop_array when a linear array is required. */ -static int pop_array (SLang_Array_Type **at_ptr, int convert_scalar) -{ - SLang_Array_Type *at; - int one = 1; - int type; - - *at_ptr = NULL; - type = SLang_peek_at_stack (); - - switch (type) - { - case -1: - return -1; - - case SLANG_ARRAY_TYPE: - return SLclass_pop_ptr_obj (SLANG_ARRAY_TYPE, (VOID_STAR *) at_ptr); - - case SLANG_NULL_TYPE: - convert_scalar = 0; - /* drop */ - default: - if (convert_scalar == 0) - { - SLdo_pop (); - SLang_verror (SL_TYPE_MISMATCH, "Context requires an array. Scalar not converted"); - return -1; - } - break; - } - - if (NULL == (at = SLang_create_array ((unsigned char) type, 0, NULL, &one, 1))) - return -1; - - if (-1 == at->cl->cl_apop ((unsigned char) type, at->data)) - { - SLang_free_array (at); - return -1; - } - - *at_ptr = at; - - return 0; -} - -static VOID_STAR linear_get_data_addr (SLang_Array_Type *at, int *dims) -{ - unsigned int num_dims; - unsigned int ofs; - unsigned int i; - int *max_dims; - - ofs = 0; - max_dims = at->dims; - num_dims = at->num_dims; - - for (i = 0; i < num_dims; i++) - { - int d = dims[i]; - - if (d < 0) - d = d + max_dims[i]; - - ofs = ofs * (unsigned int)max_dims [i] + (unsigned int) d; - } - - return (VOID_STAR) ((char *)at->data + (ofs * at->sizeof_type)); -} - -static VOID_STAR get_data_addr (SLang_Array_Type *at, int *dims) -{ - VOID_STAR data; - - data = at->data; - if (data == NULL) - { - SLang_verror (SL_UNKNOWN_ERROR, "Array has no data"); - return NULL; - } - - data = (*at->index_fun) (at, dims); - - if (data == NULL) - { - SLang_verror (SL_UNKNOWN_ERROR, "Unable to access array element"); - return NULL; - } - - return data; -} - -void _SLarray_free_array_elements (SLang_Class_Type *cl, VOID_STAR s, unsigned int num) -{ - unsigned int sizeof_type; - void (*f) (unsigned char, VOID_STAR); - char *p; - unsigned char type; - - if ((cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR) - || (cl->cl_class_type == SLANG_CLASS_TYPE_VECTOR)) - return; - - f = cl->cl_destroy; - sizeof_type = cl->cl_sizeof_type; - type = cl->cl_data_type; - - p = (char *) s; - while (num != 0) - { - if (NULL != *(VOID_STAR *)p) - { - (*f) (type, (VOID_STAR)p); - *(VOID_STAR *) p = NULL; - } - p += sizeof_type; - num--; - } -} - -static int destroy_element (SLang_Array_Type *at, - int *dims, - VOID_STAR data) -{ - data = get_data_addr (at, dims); - if (data == NULL) - return -1; - - /* This function should only get called for arrays that have - * pointer elements. Do not call the destroy method if the element - * is NULL. - */ - if (NULL != *(VOID_STAR *)data) - { - (*at->cl->cl_destroy) (at->data_type, data); - *(VOID_STAR *) data = NULL; - } - return 0; -} - -/* This function only gets called when a new array is created. Thus there - * is no need to destroy the object first. - */ -static int new_object_element (SLang_Array_Type *at, - int *dims, - VOID_STAR data) -{ - data = get_data_addr (at, dims); - if (data == NULL) - return -1; - - return (*at->cl->cl_init_array_object) (at->data_type, data); -} - -static int next_index (int *dims, int *max_dims, unsigned int num_dims) -{ - while (num_dims) - { - int dims_i; - - num_dims--; - - dims_i = dims [num_dims] + 1; - if (dims_i != (int) max_dims [num_dims]) - { - dims [num_dims] = dims_i; - return 0; - } - dims [num_dims] = 0; - } - - return -1; -} - -static int do_method_for_all_elements (SLang_Array_Type *at, - int (*method)(SLang_Array_Type *, - int *, - VOID_STAR), - VOID_STAR client_data) -{ - int dims [SLARRAY_MAX_DIMS]; - int *max_dims; - unsigned int num_dims; - - if (at->num_elements == 0) - return 0; - - max_dims = at->dims; - num_dims = at->num_dims; - - SLMEMSET((char *)dims, 0, sizeof(dims)); - - do - { - if (-1 == (*method) (at, dims, client_data)) - return -1; - } - while (0 == next_index (dims, max_dims, num_dims)); - - return 0; -} - -void SLang_free_array (SLang_Array_Type *at) -{ - VOID_STAR data; - unsigned int flags; - - if (at == NULL) return; - - if (at->num_refs > 1) - { - at->num_refs -= 1; - return; - } - - data = at->data; - flags = at->flags; - - if (flags & SLARR_DATA_VALUE_IS_INTRINSIC) - return; /* not to be freed */ - - if (flags & SLARR_DATA_VALUE_IS_POINTER) - (void) do_method_for_all_elements (at, destroy_element, NULL); - - SLfree ((char *) data); - SLfree ((char *) at); -} - -SLang_Array_Type * -SLang_create_array1 (unsigned char type, int read_only, VOID_STAR data, - int *dims, unsigned int num_dims, int no_init) -{ - SLang_Class_Type *cl; - unsigned int i; - SLang_Array_Type *at; - unsigned int num_elements; - unsigned int sizeof_type; - unsigned int size; - - if (num_dims > SLARRAY_MAX_DIMS) - { - SLang_verror (SL_NOT_IMPLEMENTED, "%u dimensional arrays are not supported", num_dims); - return NULL; - } - - for (i = 0; i < num_dims; i++) - { - if (dims[i] < 0) - { - SLang_verror (SL_INVALID_PARM, "Size of array dim %u is less than 0", i); - return NULL; - } - } - - cl = _SLclass_get_class (type); - - at = (SLang_Array_Type *) SLmalloc (sizeof(SLang_Array_Type)); - if (at == NULL) - return NULL; - - SLMEMSET ((char*) at, 0, sizeof(SLang_Array_Type)); - - at->data_type = type; - at->cl = cl; - at->num_dims = num_dims; - at->num_refs = 1; - - if (read_only) at->flags = SLARR_DATA_VALUE_IS_READ_ONLY; - switch (cl->cl_class_type) - { - case SLANG_CLASS_TYPE_VECTOR: - case SLANG_CLASS_TYPE_SCALAR: - break; - - default: - at->flags |= SLARR_DATA_VALUE_IS_POINTER; - } - - num_elements = 1; - for (i = 0; i < num_dims; i++) - { - at->dims [i] = dims[i]; - num_elements = dims [i] * num_elements; - } - - /* Now set the rest of the unused dimensions to 1. This makes it easier - * when transposing arrays. - */ - while (i < SLARRAY_MAX_DIMS) - at->dims[i++] = 1; - - at->num_elements = num_elements; - at->index_fun = linear_get_data_addr; - at->sizeof_type = sizeof_type = cl->cl_sizeof_type; - - if (data != NULL) - { - at->data = data; - return at; - } - - size = num_elements * sizeof_type; - - if (size == 0) size = 1; - - if (NULL == (data = (VOID_STAR) SLmalloc (size))) - { - SLang_free_array (at); - return NULL; - } - - if (no_init == 0) - SLMEMSET ((char *) data, 0, size); - - at->data = data; - - if ((cl->cl_init_array_object != NULL) - && (-1 == do_method_for_all_elements (at, new_object_element, NULL))) - { - SLang_free_array (at); - return NULL; - } - return at; -} - -SLang_Array_Type * -SLang_create_array (unsigned char type, int read_only, VOID_STAR data, - int *dims, unsigned int num_dims) -{ - return SLang_create_array1 (type, read_only, data, dims, num_dims, 0); -} - -int SLang_add_intrinsic_array (char *name, - unsigned char type, - int read_only, - VOID_STAR data, - unsigned int num_dims, ...) -{ - va_list ap; - unsigned int i; - int dims[SLARRAY_MAX_DIMS]; - SLang_Array_Type *at; - - if ((num_dims > SLARRAY_MAX_DIMS) - || (name == NULL) - || (data == NULL)) - { - SLang_verror (SL_INVALID_PARM, "Unable to create intrinsic array"); - return -1; - } - - va_start (ap, num_dims); - for (i = 0; i < num_dims; i++) - dims [i] = va_arg (ap, int); - va_end (ap); - - at = SLang_create_array (type, read_only, data, dims, num_dims); - if (at == NULL) - return -1; - at->flags |= SLARR_DATA_VALUE_IS_INTRINSIC; - - /* Note: The variable that refers to the intrinsic array is regarded as - * read-only. That way, Array_Name = another_array; will fail. - */ - if (-1 == SLadd_intrinsic_variable (name, (VOID_STAR) at, SLANG_ARRAY_TYPE, 1)) - { - SLang_free_array (at); - return -1; - } - return 0; -} - -static int pop_array_indices (int *dims, unsigned int num_dims) -{ - unsigned int n; - int i; - - if (num_dims > SLARRAY_MAX_DIMS) - { - SLang_verror (SL_INVALID_PARM, "Array size not supported"); - return -1; - } - - n = num_dims; - while (n != 0) - { - n--; - if (-1 == SLang_pop_integer (&i)) - return -1; - - dims[n] = i; - } - - return 0; -} - -int SLang_push_array (SLang_Array_Type *at, int free_flag) -{ - if (at == NULL) - return SLang_push_null (); - - at->num_refs += 1; - - if (0 == SLclass_push_ptr_obj (SLANG_ARRAY_TYPE, (VOID_STAR) at)) - { - if (free_flag) - SLang_free_array (at); - return 0; - } - - at->num_refs -= 1; - - if (free_flag) SLang_free_array (at); - return -1; -} - -/* This function gets called via expressions such as Double_Type[10, 20]; - */ -static int push_create_new_array (void) -{ - unsigned int num_dims; - SLang_Array_Type *at; - unsigned char type; - int dims [SLARRAY_MAX_DIMS]; - int (*anew) (unsigned char, unsigned int); - - num_dims = (SLang_Num_Function_Args - 1); - - if (-1 == _SLang_pop_datatype (&type)) - return -1; - - anew = (_SLclass_get_class (type))->cl_anew; - if (anew != NULL) - return (*anew) (type, num_dims); - - if (-1 == pop_array_indices (dims, num_dims)) - return -1; - - if (NULL == (at = SLang_create_array (type, 0, NULL, dims, num_dims))) - return -1; - - return SLang_push_array (at, 1); -} - -static int push_element_at_addr (SLang_Array_Type *at, - VOID_STAR data, int allow_null) -{ - SLang_Class_Type *cl; - - cl = at->cl; - if ((at->flags & SLARR_DATA_VALUE_IS_POINTER) - && (*(VOID_STAR *) data == NULL)) - { - if (allow_null) - return SLang_push_null (); - - SLang_verror (SL_VARIABLE_UNINITIALIZED, - "%s array has unitialized element", cl->cl_name); - return -1; - } - - return (*cl->cl_apush)(at->data_type, data); -} - -static int coerse_array_to_linear (SLang_Array_Type *at) -{ - SLarray_Range_Array_Type *range; - int *data; - int xmin, dx; - unsigned int i, imax; - - /* FIXME: Priority = low. This assumes that if an array is not linear, then - * it is a range. - */ - if (0 == (at->flags & SLARR_DATA_VALUE_IS_RANGE)) - return 0; - - range = (SLarray_Range_Array_Type *) at->data; - xmin = range->first_index; - dx = range->delta; - - imax = at->num_elements; - data = (int *) SLmalloc ((imax + 1) * sizeof (int)); - if (data == NULL) - return -1; - - for (i = 0; i < imax; i++) - { - data [i] = xmin; - xmin += dx; - } - - SLfree ((char *) range); - at->data = (VOID_STAR) data; - at->flags &= ~SLARR_DATA_VALUE_IS_RANGE; - at->index_fun = linear_get_data_addr; - return 0; -} - -static void -free_index_objects (SLang_Object_Type *index_objs, unsigned int num_indices) -{ - unsigned int i; - SLang_Object_Type *obj; - - for (i = 0; i < num_indices; i++) - { - obj = index_objs + i; - if (obj->data_type != 0) - SLang_free_object (obj); - } -} - -static int -pop_indices (SLang_Object_Type *index_objs, unsigned int num_indices, - int *is_index_array) -{ - unsigned int i; - - SLMEMSET((char *) index_objs, 0, num_indices * sizeof (SLang_Object_Type)); - - *is_index_array = 0; - - if (num_indices >= SLARRAY_MAX_DIMS) - { - SLang_verror (SL_INVALID_PARM, "too many indices for array"); - return -1; - } - - i = num_indices; - while (i != 0) - { - SLang_Object_Type *obj; - - i--; - obj = index_objs + i; - if (-1 == _SLang_pop_object_of_type (SLANG_INT_TYPE, obj, 1)) - goto return_error; - - if (obj->data_type == SLANG_ARRAY_TYPE) - { - SLang_Array_Type *at = obj->v.array_val; - - if (at->num_dims == 1) - { - if ((num_indices == 1) - && (0 == (at->flags & SLARR_DATA_VALUE_IS_RANGE))) - *is_index_array = 1; - } - else - { - SLang_verror (SL_INVALID_PARM, "expecting a 1-d index array"); - goto return_error; - } - } - } - - return 0; - - return_error: - free_index_objects (index_objs, num_indices); - return -1; -} - -/* Here ind_at is a linear 1-d array of indices */ -static int -check_index_array_ranges (SLang_Array_Type *at, SLang_Array_Type *ind_at) -{ - int *indices, *indices_max; - unsigned int num_elements; - - num_elements = at->num_elements; - indices = (int *) ind_at->data; - indices_max = indices + ind_at->num_elements; - - while (indices < indices_max) - { - unsigned int d; - - d = (unsigned int) *indices++; - if (d >= num_elements) - { - SLang_verror (SL_INVALID_PARM, - "index-array is out of range"); - return -1; - } - } - return 0; -} - -static int -transfer_n_elements (SLang_Array_Type *at, VOID_STAR dest_data, VOID_STAR src_data, - unsigned int sizeof_type, unsigned int n, int is_ptr) -{ - unsigned char data_type; - SLang_Class_Type *cl; - - if (is_ptr == 0) - { - SLMEMCPY ((char *) dest_data, (char *)src_data, n * sizeof_type); - return 0; - } - - data_type = at->data_type; - cl = at->cl; - - while (n != 0) - { - if (*(VOID_STAR *)dest_data != NULL) - { - (*cl->cl_destroy) (data_type, dest_data); - *(VOID_STAR *) dest_data = NULL; - } - - if (*(VOID_STAR *) src_data == NULL) - *(VOID_STAR *) dest_data = NULL; - else - { - if (-1 == (*cl->cl_acopy) (data_type, src_data, dest_data)) - /* No need to destroy anything */ - return -1; - } - - src_data = (VOID_STAR) ((char *)src_data + sizeof_type); - dest_data = (VOID_STAR) ((char *)dest_data + sizeof_type); - - n--; - } - - return 0; -} - -int -_SLarray_aget_transfer_elem (SLang_Array_Type *at, int *indices, - VOID_STAR new_data, unsigned int sizeof_type, int is_ptr) -{ - VOID_STAR at_data; - - /* Since 1 element is being transferred, there is not need to coerse - * the array to linear. - */ - if (NULL == (at_data = get_data_addr (at, indices))) - return -1; - - return transfer_n_elements (at, new_data, at_data, sizeof_type, 1, is_ptr); -} - -/* Here the ind_at index-array is a 1-d array of indices. This function - * creates a 1-d array of made up of values of 'at' at the locations - * specified by the indices. The result is pushed. - */ -static int -aget_from_index_array (SLang_Array_Type *at, - SLang_Array_Type *ind_at) -{ - SLang_Array_Type *new_at; - int *indices, *indices_max; - unsigned char *new_data, *src_data; - unsigned int sizeof_type; - int is_ptr; - - if (-1 == coerse_array_to_linear (at)) - return -1; - - if (-1 == coerse_array_to_linear (ind_at)) - return -1; - - if (-1 == check_index_array_ranges (at, ind_at)) - return -1; - - if (NULL == (new_at = SLang_create_array (at->data_type, 0, NULL, ind_at->dims, 1))) - return -1; - - /* Since the index array is linear, I can address it directly */ - indices = (int *) ind_at->data; - indices_max = indices + ind_at->num_elements; - - src_data = (unsigned char *) at->data; - new_data = (unsigned char *) new_at->data; - sizeof_type = new_at->sizeof_type; - is_ptr = (new_at->flags & SLARR_DATA_VALUE_IS_POINTER); - - while (indices < indices_max) - { - unsigned int offset; - - offset = sizeof_type * (unsigned int)*indices; - if (-1 == transfer_n_elements (at, (VOID_STAR) new_data, - (VOID_STAR) (src_data + offset), - sizeof_type, 1, is_ptr)) - { - SLang_free_array (new_at); - return -1; - } - - new_data += sizeof_type; - indices++; - } - - return SLang_push_array (new_at, 1); -} - -/* This is extremely ugly. It is due to the fact that the index_objects - * may contain ranges. This is a utility function for the aget/aput - * routines - */ -static int -convert_nasty_index_objs (SLang_Array_Type *at, - SLang_Object_Type *index_objs, - unsigned int num_indices, - int **index_data, - int *range_buf, int *range_delta_buf, - int *max_dims, - unsigned int *num_elements, - int *is_array, int is_dim_array[SLARRAY_MAX_DIMS]) -{ - unsigned int i, total_num_elements; - SLang_Array_Type *ind_at; - - if (num_indices != at->num_dims) - { - SLang_verror (SL_INVALID_PARM, "Array requires %u indices", at->num_dims); - return -1; - } - - *is_array = 0; - total_num_elements = 1; - for (i = 0; i < num_indices; i++) - { - int max_index, min_index; - SLang_Object_Type *obj; - int at_dims_i; - - at_dims_i = at->dims[i]; - obj = index_objs + i; - range_delta_buf [i] = 0; - - if (obj->data_type == SLANG_INT_TYPE) - { - range_buf [i] = min_index = max_index = obj->v.int_val; - max_dims [i] = 1; - index_data[i] = range_buf + i; - is_dim_array[i] = 0; - } - else - { - *is_array = 1; - is_dim_array[i] = 1; - ind_at = obj->v.array_val; - - if (ind_at->flags & SLARR_DATA_VALUE_IS_RANGE) - { - SLarray_Range_Array_Type *r; - int delta; - int first_index, last_index; - - r = (SLarray_Range_Array_Type *) ind_at->data; - - /* In an array indexing context, range arrays have different - * semantics. Consider a[[0:10]]. Clearly this means elements - * 0-10 of a. But what does a[[0:-1]] mean? By itself, - * [0:-1] is a null matrix []. But, it is useful in an - * indexing context to allow -1 to refer to the last element - * of the array. Similarly, [-3:-1] refers to the last 3 - * elements. - * - * However, [-1:-3] does not refer to any of the elements. - */ - if ((first_index = r->first_index) < 0) - { - if (at_dims_i != 0) - first_index = (at_dims_i + first_index) % at_dims_i; - } - - if ((last_index = r->last_index) < 0) - { - if (at_dims_i != 0) - last_index = (at_dims_i + last_index) % at_dims_i; - } - - delta = r->delta; - - range_delta_buf [i] = delta; - range_buf[i] = first_index; - - if (delta > 0) - { - if (first_index > last_index) - max_dims[i] = min_index = max_index = 0; - else - { - max_index = min_index = first_index; - while (max_index + delta <= last_index) - max_index += delta; - max_dims [i] = 1 + (max_index - min_index) / delta; - } - } - else - { - if (first_index < last_index) - max_dims[i] = min_index = max_index = 0; - else - { - min_index = max_index = first_index; - while (min_index + delta >= last_index) - min_index += delta; - max_dims [i] = 1 + (max_index - min_index) / (-delta); - } - } - } - else - { - int *tmp, *tmp_max; - - if (0 == (max_dims[i] = ind_at->num_elements)) - { - total_num_elements = 0; - break; - } - - tmp = (int *) ind_at->data; - tmp_max = tmp + ind_at->num_elements; - index_data [i] = tmp; - - min_index = max_index = *tmp; - while (tmp < tmp_max) - { - if (max_index > *tmp) - max_index = *tmp; - if (min_index < *tmp) - min_index = *tmp; - - tmp++; - } - } - } - - if ((at_dims_i == 0) && (max_dims[i] == 0)) - { - total_num_elements = 0; - continue; - } - - if (max_index < 0) - max_index += at_dims_i; - if (min_index < 0) - min_index += at_dims_i; - - if ((min_index < 0) || (min_index >= at_dims_i) - || (max_index < 0) || (max_index >= at_dims_i)) - { - SLang_verror (SL_INVALID_PARM, "Array index %u ([%d:%d]) out of allowed range [0->%d]", - i, min_index, max_index, at_dims_i); - return -1; - } - - total_num_elements = total_num_elements * max_dims[i]; - } - - *num_elements = total_num_elements; - return 0; -} - -/* This routine pushes a 1-d vector of values from 'at' indexed by - * the objects 'index_objs'. These objects can either be integers or - * 1-d integer arrays. The fact that the 1-d arrays can be ranges - * makes this look ugly. - */ -static int -aget_from_indices (SLang_Array_Type *at, - SLang_Object_Type *index_objs, unsigned int num_indices) -{ - int *index_data [SLARRAY_MAX_DIMS]; - int range_buf [SLARRAY_MAX_DIMS]; - int range_delta_buf [SLARRAY_MAX_DIMS]; - int max_dims [SLARRAY_MAX_DIMS]; - unsigned int i, num_elements; - SLang_Array_Type *new_at; - int map_indices[SLARRAY_MAX_DIMS]; - int indices [SLARRAY_MAX_DIMS]; - unsigned int sizeof_type; - int is_ptr, ret, is_array; - char *new_data; - SLang_Class_Type *cl; - int is_dim_array[SLARRAY_MAX_DIMS]; - - if (-1 == convert_nasty_index_objs (at, index_objs, num_indices, - index_data, range_buf, range_delta_buf, - max_dims, &num_elements, &is_array, - is_dim_array)) - return -1; - - is_ptr = (at->flags & SLARR_DATA_VALUE_IS_POINTER); - sizeof_type = at->sizeof_type; - - cl = _SLclass_get_class (at->data_type); - - if ((is_array == 0) && (num_elements == 1)) - { - new_data = (char *)cl->cl_transfer_buf; - memset (new_data, 0, sizeof_type); - new_at = NULL; - } - else - { - int i_num_elements = (int)num_elements; - - new_at = SLang_create_array (at->data_type, 0, NULL, &i_num_elements, 1); - if (NULL == new_at) - return -1; - if (num_elements == 0) - return SLang_push_array (new_at, 1); - - new_data = (char *)new_at->data; - } - - SLMEMSET((char *) map_indices, 0, sizeof(map_indices)); - do - { - for (i = 0; i < num_indices; i++) - { - int j; - - j = map_indices[i]; - - if (0 != range_delta_buf[i]) - indices[i] = range_buf[i] + j * range_delta_buf[i]; - else - indices[i] = index_data [i][j]; - } - - if (-1 == _SLarray_aget_transfer_elem (at, indices, (VOID_STAR)new_data, sizeof_type, is_ptr)) - { - SLang_free_array (new_at); - return -1; - } - new_data += sizeof_type; - } - while (0 == next_index (map_indices, max_dims, num_indices)); - - if (new_at != NULL) - { - int num_dims = 0; - /* Fixup dimensions on array */ - for (i = 0; i < num_indices; i++) - { - if (is_dim_array[i]) /* was: (max_dims[i] > 1) */ - { - new_at->dims[num_dims] = max_dims[i]; - num_dims++; - } - } - - if (num_dims != 0) new_at->num_dims = num_dims; - return SLang_push_array (new_at, 1); - } - - /* Here new_data is a whole new copy, so free it after the push */ - new_data -= sizeof_type; - if (is_ptr && (*(VOID_STAR *)new_data == NULL)) - ret = SLang_push_null (); - else - { - ret = (*cl->cl_apush) (at->data_type, (VOID_STAR)new_data); - (*cl->cl_adestroy) (at->data_type, (VOID_STAR)new_data); - } - - return ret; -} - -static int push_string_as_array (unsigned char *s, unsigned int len) -{ - int ilen; - SLang_Array_Type *at; - - ilen = (int) len; - - at = SLang_create_array (SLANG_UCHAR_TYPE, 0, NULL, &ilen, 1); - if (at == NULL) - return -1; - - memcpy ((char *)at->data, (char *)s, len); - return SLang_push_array (at, 1); -} - -static int pop_array_as_string (char **sp) -{ - SLang_Array_Type *at; - int ret; - - *sp = NULL; - - if (-1 == SLang_pop_array_of_type (&at, SLANG_UCHAR_TYPE)) - return -1; - - ret = 0; - - if (NULL == (*sp = SLang_create_nslstring ((char *) at->data, at->num_elements))) - ret = -1; - - SLang_free_array (at); - return ret; -} - -static int pop_array_as_bstring (SLang_BString_Type **bs) -{ - SLang_Array_Type *at; - int ret; - - *bs = NULL; - - if (-1 == SLang_pop_array_of_type (&at, SLANG_UCHAR_TYPE)) - return -1; - - ret = 0; - - if (NULL == (*bs = SLbstring_create ((unsigned char *) at->data, at->num_elements))) - ret = -1; - - SLang_free_array (at); - return ret; -} - -static int aget_from_array (unsigned int num_indices) -{ - SLang_Array_Type *at; - SLang_Object_Type index_objs [SLARRAY_MAX_DIMS]; - int ret; - int is_index_array; - unsigned int i; - - if (num_indices > SLARRAY_MAX_DIMS) - { - SLang_verror (SL_INVALID_PARM, "Number of dims must be less than %d", SLARRAY_MAX_DIMS); - return -1; - } - - if (-1 == pop_array (&at, 1)) - return -1; - - if (-1 == pop_indices (index_objs, num_indices, &is_index_array)) - { - SLang_free_array (at); - return -1; - } - - if (is_index_array == 0) - ret = aget_from_indices (at, index_objs, num_indices); - else - ret = aget_from_index_array (at, index_objs[0].v.array_val); - - SLang_free_array (at); - for (i = 0; i < num_indices; i++) - SLang_free_object (index_objs + i); - - return ret; -} - -static int push_string_element (unsigned char type, unsigned char *s, unsigned int len) -{ - int i; - - if (SLang_peek_at_stack () == SLANG_ARRAY_TYPE) - { - char *str; - - /* The indices are array values. So, do this: */ - if (-1 == push_string_as_array (s, len)) - return -1; - - if (-1 == aget_from_array (1)) - return -1; - - if (type == SLANG_BSTRING_TYPE) - { - SLang_BString_Type *bs; - int ret; - - if (-1 == pop_array_as_bstring (&bs)) - return -1; - - ret = SLang_push_bstring (bs); - SLbstring_free (bs); - return ret; - } - - if (-1 == pop_array_as_string (&str)) - return -1; - return _SLang_push_slstring (str); /* frees s upon error */ - } - - if (-1 == SLang_pop_integer (&i)) - return -1; - - if (i < 0) i = i + (int)len; - if ((unsigned int) i > len) - i = len; /* get \0 character --- bstrings include it as well */ - - i = s[(unsigned int) i]; - - return SLang_push_integer (i); -} - -/* ARRAY[i, j, k] generates code: __args i j ...k ARRAY __aput/__aget - * Here i, j, ... k may be a mixture of integers and 1-d arrays, or - * a single 2-d array of indices. The 2-d index array is generated by the - * 'where' function. - * - * If ARRAY is of type DataType, then this function will create an array of - * the appropriate type. In that case, the indices i, j, ..., k must be - * integers. - */ -int _SLarray_aget (void) -{ - unsigned int num_indices; - int type; - int (*aget_fun) (unsigned char, unsigned int); - - num_indices = (SLang_Num_Function_Args - 1); - - type = SLang_peek_at_stack (); - switch (type) - { - case -1: - return -1; /* stack underflow */ - - case SLANG_DATATYPE_TYPE: - return push_create_new_array (); - - case SLANG_BSTRING_TYPE: - if (1 == num_indices) - { - SLang_BString_Type *bs; - int ret; - unsigned int len; - unsigned char *s; - - if (-1 == SLang_pop_bstring (&bs)) - return -1; - - if (NULL == (s = SLbstring_get_pointer (bs, &len))) - ret = -1; - else - ret = push_string_element (type, s, len); - - SLbstring_free (bs); - return ret; - } - break; - - case SLANG_STRING_TYPE: - if (1 == num_indices) - { - char *s; - int ret; - - if (-1 == SLang_pop_slstring (&s)) - return -1; - - ret = push_string_element (type, (unsigned char *)s, strlen (s)); - SLang_free_slstring (s); - return ret; - } - break; - - case SLANG_ARRAY_TYPE: - break; - - default: - aget_fun = _SLclass_get_class (type)->cl_aget; - if (NULL != aget_fun) - return (*aget_fun) (type, num_indices); - } - - return aget_from_array (num_indices); -} - -int -_SLarray_aput_transfer_elem (SLang_Array_Type *at, int *indices, - VOID_STAR data_to_put, unsigned int sizeof_type, int is_ptr) -{ - VOID_STAR at_data; - - /* Since 1 element is being transferred, there is no need to coerse - * the array to linear. - */ - if (NULL == (at_data = get_data_addr (at, indices))) - return -1; - - return transfer_n_elements (at, at_data, data_to_put, sizeof_type, 1, is_ptr); -} - -static int -aput_get_array_to_put (SLang_Class_Type *cl, unsigned int num_elements, int allow_array, - SLang_Array_Type **at_ptr, char **data_to_put, unsigned int *data_increment) -{ - unsigned char data_type; - SLang_Array_Type *at; - - *at_ptr = NULL; - - data_type = cl->cl_data_type; - if (-1 == SLclass_typecast (data_type, 1, allow_array)) - return -1; - - if ((data_type != SLANG_ARRAY_TYPE) - && (data_type != SLANG_ANY_TYPE) - && (SLANG_ARRAY_TYPE == SLang_peek_at_stack ())) - { - if (-1 == SLang_pop_array (&at, 0)) - return -1; - - if ((at->num_elements != num_elements) -#if 0 - || (at->num_dims != 1) -#endif - ) - { - SLang_verror (SL_TYPE_MISMATCH, "Array size is inappropriate for use with index-array"); - SLang_free_array (at); - return -1; - } - - *data_to_put = (char *) at->data; - *data_increment = at->sizeof_type; - *at_ptr = at; - return 0; - } - - *data_increment = 0; - *data_to_put = (char *) cl->cl_transfer_buf; - - if (-1 == (*cl->cl_apop)(data_type, (VOID_STAR) *data_to_put)) - return -1; - - return 0; -} - -static int -aput_from_indices (SLang_Array_Type *at, - SLang_Object_Type *index_objs, unsigned int num_indices) -{ - int *index_data [SLARRAY_MAX_DIMS]; - int range_buf [SLARRAY_MAX_DIMS]; - int range_delta_buf [SLARRAY_MAX_DIMS]; - int max_dims [SLARRAY_MAX_DIMS]; - unsigned int i, num_elements; - SLang_Array_Type *bt; - int map_indices[SLARRAY_MAX_DIMS]; - int indices [SLARRAY_MAX_DIMS]; - unsigned int sizeof_type; - int is_ptr, is_array, ret; - char *data_to_put; - unsigned int data_increment; - SLang_Class_Type *cl; - int is_dim_array [SLARRAY_MAX_DIMS]; - - if (-1 == convert_nasty_index_objs (at, index_objs, num_indices, - index_data, range_buf, range_delta_buf, - max_dims, &num_elements, &is_array, - is_dim_array)) - return -1; - - cl = at->cl; - - if (-1 == aput_get_array_to_put (cl, num_elements, is_array, - &bt, &data_to_put, &data_increment)) - return -1; - - sizeof_type = at->sizeof_type; - is_ptr = (at->flags & SLARR_DATA_VALUE_IS_POINTER); - - ret = -1; - - SLMEMSET((char *) map_indices, 0, sizeof(map_indices)); - if (num_elements) do - { - for (i = 0; i < num_indices; i++) - { - int j; - - j = map_indices[i]; - - if (0 != range_delta_buf[i]) - indices[i] = range_buf[i] + j * range_delta_buf[i]; - else - indices[i] = index_data [i][j]; - } - - if (-1 == _SLarray_aput_transfer_elem (at, indices, (VOID_STAR)data_to_put, sizeof_type, is_ptr)) - goto return_error; - - data_to_put += data_increment; - } - while (0 == next_index (map_indices, max_dims, num_indices)); - - ret = 0; - - /* drop */ - - return_error: - if (bt == NULL) - { - if (is_ptr) - (*cl->cl_destroy) (cl->cl_data_type, (VOID_STAR) data_to_put); - } - else SLang_free_array (bt); - - return ret; -} - -static int -aput_from_index_array (SLang_Array_Type *at, SLang_Array_Type *ind_at) -{ - int *indices, *indices_max; - unsigned int sizeof_type; - char *data_to_put, *dest_data; - unsigned int data_increment; - int is_ptr; - SLang_Array_Type *bt; - SLang_Class_Type *cl; - int ret; - - if (-1 == coerse_array_to_linear (at)) - return -1; - - if (-1 == coerse_array_to_linear (ind_at)) - return -1; - - if (-1 == check_index_array_ranges (at, ind_at)) - return -1; - - sizeof_type = at->sizeof_type; - - cl = at->cl; - - /* Note that if bt is returned as non NULL, then the array is a linear - * one. - */ - if (-1 == aput_get_array_to_put (cl, ind_at->num_elements, 1, - &bt, &data_to_put, &data_increment)) - return -1; - - /* Since the index array is linear, I can address it directly */ - indices = (int *) ind_at->data; - indices_max = indices + ind_at->num_elements; - - is_ptr = (at->flags & SLARR_DATA_VALUE_IS_POINTER); - dest_data = (char *) at->data; - - ret = -1; - while (indices < indices_max) - { - unsigned int offset; - - offset = sizeof_type * (unsigned int)*indices; - - if (-1 == transfer_n_elements (at, (VOID_STAR) (dest_data + offset), - (VOID_STAR) data_to_put, sizeof_type, 1, - is_ptr)) - goto return_error; - - indices++; - data_to_put += data_increment; - } - - ret = 0; - /* Drop */ - - return_error: - - if (bt == NULL) - { - if (is_ptr) - (*cl->cl_destroy) (cl->cl_data_type, (VOID_STAR)data_to_put); - } - else SLang_free_array (bt); - - return ret; -} - -/* ARRAY[i, j, k] = generates code: __args i j k ARRAY __aput - */ -int _SLarray_aput (void) -{ - unsigned int num_indices; - SLang_Array_Type *at; - SLang_Object_Type index_objs [SLARRAY_MAX_DIMS]; - int ret; - int is_index_array; - int (*aput_fun) (unsigned char, unsigned int); - int type; - - ret = -1; - num_indices = (SLang_Num_Function_Args - 1); - - type = SLang_peek_at_stack (); - switch (type) - { - case -1: - return -1; - - case SLANG_ARRAY_TYPE: - break; - - default: - if (NULL != (aput_fun = _SLclass_get_class (type)->cl_aput)) - return (*aput_fun) (type, num_indices); - break; - } - - if (-1 == SLang_pop_array (&at, 0)) - return -1; - - if (at->flags & SLARR_DATA_VALUE_IS_READ_ONLY) - { - SLang_verror (SL_READONLY_ERROR, "%s Array is read-only", - SLclass_get_datatype_name (at->data_type)); - SLang_free_array (at); - return -1; - } - - if (-1 == pop_indices (index_objs, num_indices, &is_index_array)) - { - SLang_free_array (at); - return -1; - } - - if (is_index_array == 0) - ret = aput_from_indices (at, index_objs, num_indices); - else - ret = aput_from_index_array (at, index_objs[0].v.array_val); - - SLang_free_array (at); - free_index_objects (index_objs, num_indices); - return ret; -} - -/* This is for 1-d matrices only. It is used by the sort function */ -static int push_element_at_index (SLang_Array_Type *at, int indx) -{ - VOID_STAR data; - - if (NULL == (data = get_data_addr (at, &indx))) - return -1; - - return push_element_at_addr (at, (VOID_STAR) data, 1); -} - -static SLang_Name_Type *Sort_Function; -static SLang_Array_Type *Sort_Array; - -static int sort_cmp_fun (int *a, int *b) -{ - int cmp; - - if (SLang_Error - || (-1 == push_element_at_index (Sort_Array, *a)) - || (-1 == push_element_at_index (Sort_Array, *b)) - || (-1 == SLexecute_function (Sort_Function)) - || (-1 == SLang_pop_integer (&cmp))) - { - /* DO not allow qsort to loop forever. Return something meaningful */ - if (*a > *b) return 1; - if (*a < *b) return -1; - return 0; - } - - return cmp; -} - -static int builtin_sort_cmp_fun (int *a, int *b) -{ - VOID_STAR a_data; - VOID_STAR b_data; - SLang_Class_Type *cl; - - cl = Sort_Array->cl; - - if ((SLang_Error == 0) - && (NULL != (a_data = get_data_addr (Sort_Array, a))) - && (NULL != (b_data = get_data_addr (Sort_Array, b)))) - { - int cmp; - - if ((Sort_Array->flags & SLARR_DATA_VALUE_IS_POINTER) - && ((*(VOID_STAR *) a_data == NULL) || (*(VOID_STAR *) a_data == NULL))) - { - SLang_verror (SL_VARIABLE_UNINITIALIZED, - "%s array has unitialized element", cl->cl_name); - } - else if (0 == (*cl->cl_cmp)(Sort_Array->data_type, a_data, b_data, &cmp)) - return cmp; - } - - - if (*a > *b) return 1; - if (*a == *b) return 0; - return -1; -} - -static void sort_array_internal (SLang_Array_Type *at_str, - SLang_Name_Type *entry, - int (*sort_fun)(int *, int *)) -{ - SLang_Array_Type *ind_at; - /* This is a silly hack to make up for braindead compilers and the lack of - * uniformity in prototypes for qsort. - */ - void (*qsort_fun) (char *, unsigned int, int, int (*)(int *, int *)); - int *indx; - int i, n; - int dims[1]; - - if (Sort_Array != NULL) - { - SLang_verror (SL_NOT_IMPLEMENTED, "array_sort is not recursive"); - return; - } - - n = at_str->num_elements; - - if (at_str->num_dims != 1) - { - SLang_verror (SL_INVALID_PARM, "sort is restricted to 1 dim arrays"); - return; - } - - dims [0] = n; - - if (NULL == (ind_at = SLang_create_array (SLANG_INT_TYPE, 0, NULL, dims, 1))) - return; - - indx = (int *) ind_at->data; - for (i = 0; i < n; i++) indx[i] = i; - - if (n > 1) - { - qsort_fun = (void (*)(char *, unsigned int, int, int (*)(int *, - int *))) - qsort; - - Sort_Array = at_str; - Sort_Function = entry; - (*qsort_fun) ((char *) indx, n, sizeof (int), sort_fun); - } - - Sort_Array = NULL; - (void) SLang_push_array (ind_at, 1); -} - -static void sort_array (void) -{ - SLang_Name_Type *entry; - SLang_Array_Type *at; - int (*sort_fun) (int *, int *); - - if (SLang_Num_Function_Args != 1) - { - sort_fun = sort_cmp_fun; - - if (NULL == (entry = SLang_pop_function ())) - return; - - if (-1 == SLang_pop_array (&at, 1)) - return; - } - else - { - sort_fun = builtin_sort_cmp_fun; - if (-1 == SLang_pop_array (&at, 1)) - return; - if (at->cl->cl_cmp == NULL) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "%s does not have a predefined sorting method", - at->cl->cl_name); - SLang_free_array (at); - return; - } - entry = NULL; - } - - sort_array_internal (at, entry, sort_fun); - SLang_free_array (at); - SLang_free_function (entry); -} - -static void bstring_to_array (SLang_BString_Type *bs) -{ - unsigned char *s; - unsigned int len; - - if (NULL == (s = SLbstring_get_pointer (bs, &len))) - (void) SLang_push_null (); - else - (void) push_string_as_array (s, len); -} - -static void array_to_bstring (SLang_Array_Type *at) -{ - unsigned int nbytes; - SLang_BString_Type *bs; - - nbytes = at->num_elements * at->sizeof_type; - bs = SLbstring_create ((unsigned char *)at->data, nbytes); - (void) SLang_push_bstring (bs); - SLbstring_free (bs); -} - -static void init_char_array (void) -{ - SLang_Array_Type *at; - char *s; - unsigned int n, ndim; - - if (SLang_pop_slstring (&s)) return; - - if (-1 == SLang_pop_array (&at, 0)) - goto free_and_return; - - if (at->data_type != SLANG_CHAR_TYPE) - { - SLang_doerror("Operation requires character array"); - goto free_and_return; - } - - n = strlen (s); - ndim = at->num_elements; - if (n > ndim) - { - SLang_doerror("String too big to init array"); - goto free_and_return; - } - - strncpy((char *) at->data, s, ndim); - /* drop */ - - free_and_return: - SLang_free_array (at); - SLang_free_slstring (s); -} - -static void array_info (void) -{ - SLang_Array_Type *at, *bt; - int num_dims; - - if (-1 == pop_array (&at, 1)) - return; - - num_dims = (int)at->num_dims; - - if (NULL != (bt = SLang_create_array (SLANG_INT_TYPE, 0, NULL, &num_dims, 1))) - { - int *bdata; - int i; - int *a_dims; - - a_dims = at->dims; - bdata = (int *) bt->data; - for (i = 0; i < num_dims; i++) bdata [i] = a_dims [i]; - - if (0 == SLang_push_array (bt, 1)) - { - (void) SLang_push_integer ((int) at->num_dims); - (void) _SLang_push_datatype (at->data_type); - } - } - - SLang_free_array (at); -} - -static VOID_STAR range_get_data_addr (SLang_Array_Type *at, int *dims) -{ - static int value; - SLarray_Range_Array_Type *r; - int d; - - d = *dims; - r = (SLarray_Range_Array_Type *)at->data; - - if (d < 0) - d += at->dims[0]; - - value = r->first_index + d * r->delta; - return (VOID_STAR) &value; -} - -static SLang_Array_Type *inline_implicit_int_array (int *xminptr, int *xmaxptr, int *dxptr) -{ - int delta; - SLang_Array_Type *at; - int dims, idims; - SLarray_Range_Array_Type *data; - - if (dxptr == NULL) delta = 1; - else delta = *dxptr; - - if (delta == 0) - { - SLang_verror (SL_INVALID_PARM, "range-array increment must be non-zero"); - return NULL; - } - - data = (SLarray_Range_Array_Type *) SLmalloc (sizeof (SLarray_Range_Array_Type)); - if (data == NULL) - return NULL; - - SLMEMSET((char *) data, 0, sizeof (SLarray_Range_Array_Type)); - data->delta = delta; - dims = 0; - - if (xminptr != NULL) - data->first_index = *xminptr; - else - data->first_index = 0; - - if (xmaxptr != NULL) - data->last_index = *xmaxptr; - else - data->last_index = -1; - -/* if ((xminptr != NULL) && (xmaxptr != NULL)) - { */ - idims = 1 + (data->last_index - data->first_index) / delta; - if (idims > 0) - dims = idims; - /* } */ - - if (NULL == (at = SLang_create_array (SLANG_INT_TYPE, 0, (VOID_STAR) data, &dims, 1))) - return NULL; - - at->index_fun = range_get_data_addr; - at->flags |= SLARR_DATA_VALUE_IS_RANGE; - - return at; -} - -#if SLANG_HAS_FLOAT -static SLang_Array_Type *inline_implicit_floating_array (unsigned char type, - double *xminptr, double *xmaxptr, double *dxptr) -{ - int n, i; - SLang_Array_Type *at; - int dims; - double xmin, xmax, dx; - - if ((xminptr == NULL) || (xmaxptr == NULL)) - { - SLang_verror (SL_INVALID_PARM, "range-array has unknown size"); - return NULL; - } - xmin = *xminptr; - xmax = *xmaxptr; - if (dxptr == NULL) dx = 1.0; - else dx = *dxptr; - - if (dx == 0.0) - { - SLang_doerror ("range-array increment must be non-zero"); - return NULL; - } - - /* I have convinced myself that it is better to use semi-open intervals - * because of less ambiguities. So, [a:b:c] will represent the set of - * values a, a + c, a + 2c ... a + nc - * such that a + nc < b. That is, b lies outside the interval. - */ - - /* Allow for roundoff by adding 0.5 before truncation */ - n = (int)(1.5 + ((xmax - xmin) / dx)); - if (n <= 0) - n = 0; - else - { - double last = xmin + (n-1) * dx; - - if (dx > 0.0) - { - if (last >= xmax) - n -= 1; - } - else if (last <= xmax) - n -= 1; - } - - dims = n; - if (NULL == (at = SLang_create_array1 (type, 0, NULL, &dims, 1, 1))) - return NULL; - - if (type == SLANG_DOUBLE_TYPE) - { - double *ptr; - - ptr = (double *) at->data; - - for (i = 0; i < n; i++) - ptr[i] = xmin + i * dx; - } - else - { - float *ptr; - - ptr = (float *) at->data; - - for (i = 0; i < n; i++) - ptr[i] = (float) (xmin + i * dx); - } - return at; -} -#endif - -/* FIXME: Priority=medium - * This needs to be updated to work with all integer types. - */ -int _SLarray_inline_implicit_array (void) -{ - int int_vals[3]; -#if SLANG_HAS_FLOAT - double double_vals[3]; -#endif - int has_vals[3]; - unsigned int i, count; - SLang_Array_Type *at; - int precedence; - unsigned char type; - int is_int; - - count = SLang_Num_Function_Args; - - if (count == 2) - has_vals [2] = 0; - else if (count != 3) - { - SLang_doerror ("wrong number of arguments to __implicit_inline_array"); - return -1; - } - -#if SLANG_HAS_FLOAT - is_int = 1; -#endif - - type = 0; - precedence = 0; - - i = count; - while (i--) - { - int this_type, this_precedence; - - if (-1 == (this_type = SLang_peek_at_stack ())) - return -1; - - this_precedence = _SLarith_get_precedence ((unsigned char) this_type); - if (precedence < this_precedence) - { - type = (unsigned char) this_type; - precedence = this_precedence; - } - - has_vals [i] = 1; - - switch (this_type) - { - case SLANG_NULL_TYPE: - has_vals[i] = 0; - (void) SLdo_pop (); - break; - -#if SLANG_HAS_FLOAT - case SLANG_DOUBLE_TYPE: - case SLANG_FLOAT_TYPE: - if (-1 == SLang_pop_double (double_vals + i, NULL, NULL)) - return -1; - is_int = 0; - break; -#endif - default: - if (-1 == SLang_pop_integer (int_vals + i)) - return -1; - double_vals[i] = (double) int_vals[i]; - } - } - -#if SLANG_HAS_FLOAT - if (is_int == 0) - at = inline_implicit_floating_array (type, - (has_vals[0] ? &double_vals[0] : NULL), - (has_vals[1] ? &double_vals[1] : NULL), - (has_vals[2] ? &double_vals[2] : NULL)); - else -#endif - at = inline_implicit_int_array ((has_vals[0] ? &int_vals[0] : NULL), - (has_vals[1] ? &int_vals[1] : NULL), - (has_vals[2] ? &int_vals[2] : NULL)); - - if (at == NULL) - return -1; - - return SLang_push_array (at, 1); -} - -int _SLarray_wildcard_array (void) -{ - SLang_Array_Type *at; - - if (NULL == (at = inline_implicit_int_array (NULL, NULL, NULL))) - return -1; - - return SLang_push_array (at, 1); -} - -static SLang_Array_Type *concat_arrays (unsigned int count) -{ - SLang_Array_Type **arrays; - SLang_Array_Type *at, *bt; - unsigned int i; - int num_elements; - unsigned char type; - char *src_data, *dest_data; - int is_ptr; - unsigned int sizeof_type; - int max_dims, min_dims, max_rows, min_rows; - - arrays = (SLang_Array_Type **)SLmalloc (count * sizeof (SLang_Array_Type *)); - if (arrays == NULL) - { - SLdo_pop_n (count); - return NULL; - } - SLMEMSET((char *) arrays, 0, count * sizeof(SLang_Array_Type *)); - - at = NULL; - - num_elements = 0; - i = count; - - while (i != 0) - { - i--; - - if (-1 == SLang_pop_array (&bt, 1)) - goto free_and_return; - - arrays[i] = bt; - num_elements += (int)bt->num_elements; - } - - type = arrays[0]->data_type; - max_dims = min_dims = arrays[0]->num_dims; - min_rows = max_rows = arrays[0]->dims[0]; - - for (i = 1; i < count; i++) - { - SLang_Array_Type *ct; - int num; - - bt = arrays[i]; - - num = bt->num_dims; - if (num > max_dims) max_dims = num; - if (num < min_dims) min_dims = num; - - num = bt->dims[0]; - if (num > max_rows) max_rows = num; - if (num < min_rows) min_rows = num; - - if (type == bt->data_type) - continue; - - if (1 != _SLarray_typecast (bt->data_type, (VOID_STAR) &bt, 1, - type, (VOID_STAR) &ct, 1)) - goto free_and_return; - - SLang_free_array (bt); - arrays [i] = ct; - } - - if (NULL == (at = SLang_create_array (type, 0, NULL, &num_elements, 1))) - goto free_and_return; - - is_ptr = (at->flags & SLARR_DATA_VALUE_IS_POINTER); - sizeof_type = at->sizeof_type; - dest_data = (char *) at->data; - - for (i = 0; i < count; i++) - { - bt = arrays[i]; - - src_data = (char *) bt->data; - num_elements = bt->num_elements; - - if (-1 == transfer_n_elements (bt, (VOID_STAR)dest_data, (VOID_STAR)src_data, sizeof_type, - num_elements, is_ptr)) - { - SLang_free_array (at); - at = NULL; - goto free_and_return; - } - - dest_data += num_elements * sizeof_type; - } - - /* If the arrays are all 1-d, and all the same size, then reshape to a - * 2-d array. This will allow us to do, e.g. - * a = [[1,2], [3,4]] - * to specifiy a 2-d. - * Someday I will generalize this. - */ - if ((max_dims == min_dims) && (max_dims == 1) && (min_rows == max_rows)) - { - at->num_dims = 2; - at->dims[0] = count; - at->dims[1] = min_rows; - } - - free_and_return: - - for (i = 0; i < count; i++) - SLang_free_array (arrays[i]); - SLfree ((char *) arrays); - - return at; -} - -int _SLarray_inline_array (void) -{ - SLang_Object_Type *obj; - unsigned char type, this_type; - unsigned int count; - SLang_Array_Type *at; - - obj = _SLStack_Pointer; - - count = SLang_Num_Function_Args; - type = 0; - - while ((count > 0) && (--obj >= _SLRun_Stack)) - { - this_type = obj->data_type; - - if (type == 0) - type = this_type; - - if ((type == this_type) || (type == SLANG_ARRAY_TYPE)) - { - count--; - continue; - } - - switch (this_type) - { - case SLANG_ARRAY_TYPE: - type = SLANG_ARRAY_TYPE; - break; - - case SLANG_INT_TYPE: - switch (type) - { -#if SLANG_HAS_FLOAT - case SLANG_DOUBLE_TYPE: - break; -#endif -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - break; -#endif - default: - goto type_mismatch; - } - break; -#if SLANG_HAS_FLOAT - case SLANG_DOUBLE_TYPE: - switch (type) - { - case SLANG_INT_TYPE: - type = SLANG_DOUBLE_TYPE; - break; -# if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - break; -# endif - default: - goto type_mismatch; - } - break; -#endif -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - switch (type) - { - case SLANG_INT_TYPE: - case SLANG_DOUBLE_TYPE: - type = SLANG_COMPLEX_TYPE; - break; - - default: - goto type_mismatch; - } - break; -#endif - default: - type_mismatch: - _SLclass_type_mismatch_error (type, this_type); - return -1; - } - count--; - } - - if (count != 0) - { - SLang_Error = SL_STACK_UNDERFLOW; - return -1; - } - - count = SLang_Num_Function_Args; - - if (count == 0) - { - SLang_verror (SL_NOT_IMPLEMENTED, "Empty inline-arrays not supported"); - return -1; - } - - if (type == SLANG_ARRAY_TYPE) - { - if (NULL == (at = concat_arrays (count))) - return -1; - } - else - { - SLang_Object_Type index_obj; - int icount = (int) count; - - if (NULL == (at = SLang_create_array (type, 0, NULL, &icount, 1))) - return -1; - - index_obj.data_type = SLANG_INT_TYPE; - while (count != 0) - { - count--; - index_obj.v.int_val = (int) count; - if (-1 == aput_from_indices (at, &index_obj, 1)) - { - SLang_free_array (at); - SLdo_pop_n (count); - return -1; - } - } - } - - return SLang_push_array (at, 1); -} - -static int array_binary_op_result (int op, unsigned char a, unsigned char b, - unsigned char *c) -{ - (void) op; - (void) a; - (void) b; - *c = SLANG_ARRAY_TYPE; - return 1; -} - -static int array_binary_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - SLang_Array_Type *at, *bt, *ct; - unsigned int i, num_dims; - int (*binary_fun) (int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR); - SLang_Class_Type *a_cl, *b_cl, *c_cl; - int no_init; - - if (a_type == SLANG_ARRAY_TYPE) - { - if (na != 1) - { - SLang_verror (SL_NOT_IMPLEMENTED, "Binary operation on multiple arrays not implemented"); - return -1; - } - - at = *(SLang_Array_Type **) ap; - if (-1 == coerse_array_to_linear (at)) - return -1; - ap = at->data; - a_type = at->data_type; - na = at->num_elements; - } - else - { - at = NULL; - } - - if (b_type == SLANG_ARRAY_TYPE) - { - if (nb != 1) - { - SLang_verror (SL_NOT_IMPLEMENTED, "Binary operation on multiple arrays not implemented"); - return -1; - } - - bt = *(SLang_Array_Type **) bp; - if (-1 == coerse_array_to_linear (bt)) - return -1; - bp = bt->data; - b_type = bt->data_type; - nb = bt->num_elements; - } - else - { - bt = NULL; - } - - if ((at != NULL) && (bt != NULL)) - { - num_dims = at->num_dims; - - if (num_dims != bt->num_dims) - { - SLang_verror (SL_TYPE_MISMATCH, "Arrays must have same dim for binary operation"); - return -1; - } - - for (i = 0; i < num_dims; i++) - { - if (at->dims[i] != bt->dims[i]) - { - SLang_verror (SL_TYPE_MISMATCH, "Arrays must be the same for binary operation"); - return -1; - } - } - } - - a_cl = _SLclass_get_class (a_type); - b_cl = _SLclass_get_class (b_type); - - if (NULL == (binary_fun = _SLclass_get_binary_fun (op, a_cl, b_cl, &c_cl, 1))) - return -1; - - no_init = ((c_cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR) - || (c_cl->cl_class_type == SLANG_CLASS_TYPE_VECTOR)); - - ct = NULL; -#if _SLANG_USE_TMP_OPTIMIZATION - /* If we are dealing with scalar (or vector) objects, and if the object - * appears to be owned by the stack, then use it instead of creating a - * new version. This can happen with code such as: - * @ x = [1,2,3,4]; - * @ x = __tmp(x) + 1; - */ - if (no_init) - { - if ((at != NULL) - && (at->num_refs == 1) - && (at->data_type == c_cl->cl_data_type)) - { - ct = at; - ct->num_refs = 2; - } - else if ((bt != NULL) - && (bt->num_refs == 1) - && (bt->data_type == c_cl->cl_data_type)) - { - ct = bt; - ct->num_refs = 2; - } - } -#endif /* _SLANG_USE_TMP_OPTIMIZATION */ - - if (ct == NULL) - { - if (at != NULL) ct = at; else ct = bt; - ct = SLang_create_array1 (c_cl->cl_data_type, 0, NULL, ct->dims, ct->num_dims, no_init); - if (ct == NULL) - return -1; - } - - - if ((na == 0) || (nb == 0) /* allow empty arrays */ - || (1 == (*binary_fun) (op, a_type, ap, na, b_type, bp, nb, ct->data))) - { - *(SLang_Array_Type **) cp = ct; - return 1; - } - - SLang_free_array (ct); - return -1; -} - -static void array_where (void) -{ - SLang_Array_Type *at, *bt; - char *a_data; - int *b_data; - unsigned int i, num_elements; - int b_num; - - if (-1 == SLang_pop_array (&at, 1)) - return; - - bt = NULL; - - if (at->data_type != SLANG_CHAR_TYPE) - { - int zero; - SLang_Array_Type *tmp_at; - - tmp_at = at; - zero = 0; - if (1 != array_binary_op (SLANG_NE, - SLANG_ARRAY_TYPE, (VOID_STAR) &at, 1, - SLANG_CHAR_TYPE, (VOID_STAR) &zero, 1, - (VOID_STAR) &tmp_at)) - goto return_error; - - SLang_free_array (at); - at = tmp_at; - if (at->data_type != SLANG_CHAR_TYPE) - { - SLang_Error = SL_TYPE_MISMATCH; - goto return_error; - } - } - - a_data = (char *) at->data; - num_elements = at->num_elements; - - b_num = 0; - for (i = 0; i < num_elements; i++) - if (a_data[i] != 0) b_num++; - - if (NULL == (bt = SLang_create_array1 (SLANG_INT_TYPE, 0, NULL, &b_num, 1, 1))) - goto return_error; - - b_data = (int *) bt->data; - - i = 0; - while (b_num) - { - if (a_data[i] != 0) - { - *b_data++ = i; - b_num--; - } - - i++; - } - - (void) SLang_push_array (bt, 0); - /* drop */ - - return_error: - SLang_free_array (at); - SLang_free_array (bt); -} - -static int do_array_reshape (SLang_Array_Type *at, SLang_Array_Type *ind_at) -{ - int *dims; - unsigned int i, num_dims; - unsigned int num_elements; - - if ((ind_at->data_type != SLANG_INT_TYPE) - || (ind_at->num_dims != 1)) - { - SLang_verror (SL_TYPE_MISMATCH, "Expecting 1-d integer array"); - return -1; - } - - num_dims = ind_at->num_elements; - dims = (int *) ind_at->data; - - num_elements = 1; - for (i = 0; i < num_dims; i++) - { - int d = dims[i]; - if (d < 0) - { - SLang_verror (SL_INVALID_PARM, "reshape: dimension is less then 0"); - return -1; - } - - num_elements = (unsigned int) d * num_elements; - } - - if ((num_elements != at->num_elements) - || (num_dims > SLARRAY_MAX_DIMS)) - { - SLang_verror (SL_INVALID_PARM, "Unable to reshape array to specified size"); - return -1; - } - - for (i = 0; i < num_dims; i++) - at->dims [i] = dims[i]; - - while (i < SLARRAY_MAX_DIMS) - { - at->dims [i] = 1; - i++; - } - - at->num_dims = num_dims; - return 0; -} - -static void array_reshape (SLang_Array_Type *at, SLang_Array_Type *ind_at) -{ - (void) do_array_reshape (at, ind_at); -} - -static void _array_reshape (SLang_Array_Type *ind_at) -{ - SLang_Array_Type *at; - SLang_Array_Type *new_at; - - if (-1 == SLang_pop_array (&at, 1)) - return; - - /* FIXME: Priority=low: duplicate_array could me modified to look at num_refs */ - - /* Now try to avoid the overhead of creating a new array if possible */ - if (at->num_refs == 1) - { - /* Great, we are the sole owner of this array. */ - if ((-1 == do_array_reshape (at, ind_at)) - || (-1 == SLclass_push_ptr_obj (SLANG_ARRAY_TYPE, (VOID_STAR)at))) - SLang_free_array (at); - return; - } - - new_at = SLang_duplicate_array (at); - if (new_at != NULL) - { - if (0 == do_array_reshape (new_at, ind_at)) - (void) SLang_push_array (new_at, 0); - - SLang_free_array (new_at); - } - SLang_free_array (at); -} - -typedef struct -{ - SLang_Array_Type *at; - unsigned int increment; - char *addr; -} -Map_Arg_Type; -/* Usage: array_map (Return-Type, func, args,....); */ -static void array_map (void) -{ - Map_Arg_Type *args; - unsigned int num_args; - unsigned int i, i_control; - SLang_Name_Type *nt; - unsigned int num_elements; - SLang_Array_Type *at; - char *addr; - unsigned char type; - - at = NULL; - args = NULL; - nt = NULL; - - if (SLang_Num_Function_Args < 3) - { - SLang_verror (SL_INVALID_PARM, - "Usage: array_map (Return-Type, &func, args...)"); - SLdo_pop_n (SLang_Num_Function_Args); - return; - } - - num_args = (unsigned int)SLang_Num_Function_Args - 2; - args = (Map_Arg_Type *) SLmalloc (num_args * sizeof (Map_Arg_Type)); - if (args == NULL) - { - SLdo_pop_n (SLang_Num_Function_Args); - return; - } - memset ((char *) args, 0, num_args * sizeof (Map_Arg_Type)); - i = num_args; - i_control = 0; - while (i > 0) - { - i--; - if (-1 == SLang_pop_array (&args[i].at, 1)) - { - SLdo_pop_n (i + 2); - goto return_error; - } - if (args[i].at->num_elements > 1) - i_control = i; - } - - if (NULL == (nt = SLang_pop_function ())) - { - SLdo_pop_n (1); - goto return_error; - } - - num_elements = args[i_control].at->num_elements; - - if (-1 == _SLang_pop_datatype (&type)) - goto return_error; - - if (type == SLANG_UNDEFINED_TYPE) /* Void_Type */ - at = NULL; - else - { - at = args[i_control].at; - - if (NULL == (at = SLang_create_array (type, 0, NULL, at->dims, at->num_dims))) - goto return_error; - } - - - for (i = 0; i < num_args; i++) - { - SLang_Array_Type *ati = args[i].at; - /* FIXME: Priority = low: The actual dimensions should be compared. */ - if (ati->num_elements == num_elements) - args[i].increment = ati->sizeof_type; - /* memset already guarantees increment to be zero */ - - if (ati->num_elements == 0) - { - SLang_verror (0, "array_map: function argument %d of %d is an empty array", - i+1, num_args); - goto return_error; - } - - args[i].addr = (char *) ati->data; - } - - if (at == NULL) - addr = NULL; - else - addr = (char *)at->data; - - for (i = 0; i < num_elements; i++) - { - unsigned int j; - - if (-1 == SLang_start_arg_list ()) - goto return_error; - - for (j = 0; j < num_args; j++) - { - if (-1 == push_element_at_addr (args[j].at, - (VOID_STAR) args[j].addr, - 1)) - { - SLdo_pop_n (j); - goto return_error; - } - - args[j].addr += args[j].increment; - } - - if (-1 == SLang_end_arg_list ()) - { - SLdo_pop_n (num_args); - goto return_error; - } - - if (-1 == SLexecute_function (nt)) - goto return_error; - - if (at == NULL) - continue; - - if (-1 == at->cl->cl_apop (type, (VOID_STAR) addr)) - goto return_error; - - addr += at->sizeof_type; - } - - if (at != NULL) - (void) SLang_push_array (at, 0); - - /* drop */ - - return_error: - SLang_free_array (at); - SLang_free_function (nt); - if (args != NULL) - { - for (i = 0; i < num_args; i++) - SLang_free_array (args[i].at); - - SLfree ((char *) args); - } -} - -static SLang_Intrin_Fun_Type Array_Table [] = -{ - MAKE_INTRINSIC_0("array_map", array_map, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("array_sort", sort_array, SLANG_VOID_TYPE), - MAKE_INTRINSIC_1("array_to_bstring", array_to_bstring, SLANG_VOID_TYPE, SLANG_ARRAY_TYPE), - MAKE_INTRINSIC_1("bstring_to_array", bstring_to_array, SLANG_VOID_TYPE, SLANG_BSTRING_TYPE), - MAKE_INTRINSIC("init_char_array", init_char_array, SLANG_VOID_TYPE, 0), - MAKE_INTRINSIC("array_info", array_info, SLANG_VOID_TYPE, 0), - MAKE_INTRINSIC("where", array_where, SLANG_VOID_TYPE, 0), - MAKE_INTRINSIC_2("reshape", array_reshape, SLANG_VOID_TYPE, SLANG_ARRAY_TYPE, SLANG_ARRAY_TYPE), - MAKE_INTRINSIC_1("_reshape", _array_reshape, SLANG_VOID_TYPE, SLANG_ARRAY_TYPE), - SLANG_END_INTRIN_FUN_TABLE -}; - -static char *array_string (unsigned char type, VOID_STAR v) -{ - SLang_Array_Type *at; - char buf[512]; - unsigned int i, num_dims; - int *dims; - - at = *(SLang_Array_Type **) v; - type = at->data_type; - num_dims = at->num_dims; - dims = at->dims; - - sprintf (buf, "%s[%d", SLclass_get_datatype_name (type), at->dims[0]); - - for (i = 1; i < num_dims; i++) - sprintf (buf + strlen(buf), ",%d", dims[i]); - strcat (buf, "]"); - - return SLmake_string (buf); -} - -static void array_destroy (unsigned char type, VOID_STAR v) -{ - (void) type; - SLang_free_array (*(SLang_Array_Type **) v); -} - -static int array_push (unsigned char type, VOID_STAR v) -{ - SLang_Array_Type *at; - - (void) type; - at = *(SLang_Array_Type **) v; - return SLang_push_array (at, 0); -} - -/* Intrinsic arrays are not stored in a variable. So, the address that - * would contain the variable holds the array address. - */ -static int array_push_intrinsic (unsigned char type, VOID_STAR v) -{ - (void) type; - return SLang_push_array ((SLang_Array_Type *) v, 0); -} - -int _SLarray_add_bin_op (unsigned char type) -{ - SL_OOBinary_Type *ab; - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - ab = cl->cl_binary_ops; - - while (ab != NULL) - { - if (ab->data_type == SLANG_ARRAY_TYPE) - return 0; - ab = ab->next; - } - - if ((-1 == SLclass_add_binary_op (SLANG_ARRAY_TYPE, type, array_binary_op, array_binary_op_result)) - || (-1 == SLclass_add_binary_op (type, SLANG_ARRAY_TYPE, array_binary_op, array_binary_op_result))) - return -1; - - return 0; -} - -static SLang_Array_Type * -do_array_math_op (int op, int unary_type, - SLang_Array_Type *at, unsigned int na) -{ - unsigned char a_type, b_type; - int (*f) (int, unsigned char, VOID_STAR, unsigned int, VOID_STAR); - SLang_Array_Type *bt; - SLang_Class_Type *b_cl; - int no_init; - - if (na != 1) - { - SLang_verror (SL_NOT_IMPLEMENTED, "Operation restricted to 1 array"); - return NULL; - } - - a_type = at->data_type; - if (NULL == (f = _SLclass_get_unary_fun (op, at->cl, &b_cl, unary_type))) - return NULL; - b_type = b_cl->cl_data_type; - - if (-1 == coerse_array_to_linear (at)) - return NULL; - - no_init = ((b_cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR) - || (b_cl->cl_class_type == SLANG_CLASS_TYPE_VECTOR)); - -#if _SLANG_USE_TMP_OPTIMIZATION - /* If we are dealing with scalar (or vector) objects, and if the object - * appears to be owned by the stack, then use it instead of creating a - * new version. This can happen with code such as: - * @ x = [1,2,3,4]; - * @ x = UNARY_OP(__tmp(x)); - */ - if (no_init - && (at->num_refs == 1) - && (at->data_type == b_cl->cl_data_type)) - { - bt = at; - bt->num_refs = 2; - } - else -#endif /* _SLANG_USE_TMP_OPTIMIZATION */ - if (NULL == (bt = SLang_create_array1 (b_type, 0, NULL, at->dims, at->num_dims, no_init))) - return NULL; - - if (1 != (*f)(op, a_type, at->data, at->num_elements, bt->data)) - { - SLang_free_array (bt); - return NULL; - } - return bt; -} - -static int -array_unary_op_result (int op, unsigned char a, unsigned char *b) -{ - (void) op; - (void) a; - *b = SLANG_ARRAY_TYPE; - return 1; -} - -static int -array_unary_op (int op, - unsigned char a, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - SLang_Array_Type *at; - - (void) a; - at = *(SLang_Array_Type **) ap; - if (NULL == (at = do_array_math_op (op, _SLANG_BC_UNARY, at, na))) - { - if (SLang_Error) return -1; - return 0; - } - *(SLang_Array_Type **) bp = at; - return 1; -} - -static int -array_math_op (int op, - unsigned char a, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - SLang_Array_Type *at; - - (void) a; - at = *(SLang_Array_Type **) ap; - if (NULL == (at = do_array_math_op (op, _SLANG_BC_MATH_UNARY, at, na))) - { - if (SLang_Error) return -1; - return 0; - } - *(SLang_Array_Type **) bp = at; - return 1; -} - -static int -array_app_op (int op, - unsigned char a, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - SLang_Array_Type *at; - - (void) a; - at = *(SLang_Array_Type **) ap; - if (NULL == (at = do_array_math_op (op, _SLANG_BC_APP_UNARY, at, na))) - { - if (SLang_Error) return -1; - return 0; - } - *(SLang_Array_Type **) bp = at; - return 1; -} - -int -_SLarray_typecast (unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, - int is_implicit) -{ - SLang_Array_Type *at, *bt; - SLang_Class_Type *b_cl; - int no_init; - int (*t) (unsigned char, VOID_STAR, unsigned int, unsigned char, VOID_STAR); - - if (na != 1) - { - SLang_verror (SL_NOT_IMPLEMENTED, "typecast of multiple arrays not implemented"); - return -1; - } - - at = *(SLang_Array_Type **) ap; - a_type = at->data_type; - - if (a_type == b_type) - { - at->num_refs += 1; - *(SLang_Array_Type **) bp = at; - return 1; - } - - if (NULL == (t = _SLclass_get_typecast (a_type, b_type, is_implicit))) - return -1; - - if (-1 == coerse_array_to_linear (at)) - return -1; - - b_cl = _SLclass_get_class (b_type); - - no_init = ((b_cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR) - || (b_cl->cl_class_type == SLANG_CLASS_TYPE_VECTOR)); - - if (NULL == (bt = SLang_create_array1 (b_type, 0, NULL, at->dims, at->num_dims, no_init))) - return -1; - - if (1 == (*t) (a_type, at->data, at->num_elements, b_type, bt->data)) - { - *(SLang_Array_Type **) bp = bt; - return 1; - } - - SLang_free_array (bt); - return 0; -} - -SLang_Array_Type *SLang_duplicate_array (SLang_Array_Type *at) -{ - SLang_Array_Type *bt; - char *data, *a_data; - unsigned int i, num_elements, sizeof_type; - unsigned int size; - int (*cl_acopy) (unsigned char, VOID_STAR, VOID_STAR); - unsigned char type; - - if (-1 == coerse_array_to_linear (at)) - return NULL; - - type = at->data_type; - num_elements = at->num_elements; - sizeof_type = at->sizeof_type; - size = num_elements * sizeof_type; - - if (NULL == (data = SLmalloc (size))) - return NULL; - - if (NULL == (bt = SLang_create_array (type, 0, (VOID_STAR)data, at->dims, at->num_dims))) - { - SLfree (data); - return NULL; - } - - a_data = (char *) at->data; - if (0 == (at->flags & SLARR_DATA_VALUE_IS_POINTER)) - { - SLMEMCPY (data, a_data, size); - return bt; - } - - SLMEMSET (data, 0, size); - - cl_acopy = at->cl->cl_acopy; - for (i = 0; i < num_elements; i++) - { - if (NULL != *(VOID_STAR *) a_data) - { - if (-1 == (*cl_acopy) (type, (VOID_STAR) a_data, (VOID_STAR) data)) - { - SLang_free_array (bt); - return NULL; - } - } - - data += sizeof_type; - a_data += sizeof_type; - } - - return bt; -} - -static int array_dereference (unsigned char type, VOID_STAR addr) -{ - SLang_Array_Type *at; - - (void) type; - at = SLang_duplicate_array (*(SLang_Array_Type **) addr); - if (at == NULL) return -1; - return SLang_push_array (at, 1); -} - -/* This function gets called via, e.g., @Array_Type (Double_Type, [10,20]); - */ -static int -array_datatype_deref (unsigned char type) -{ - SLang_Array_Type *ind_at; - SLang_Array_Type *at; - -#if 0 - /* The parser generated code for this as if a function call were to be - * made. However, the interpreter simply called the deref object routine - * instead of the function call. So, I must simulate the function call. - * This needs to be formalized to hide this detail from applications - * who wish to do the same. So... - * FIXME: Priority=medium - */ - if (0 == _SL_increment_frame_pointer ()) - (void) _SL_decrement_frame_pointer (); -#endif - - if (-1 == SLang_pop_array (&ind_at, 1)) - return -1; - - if ((ind_at->data_type != SLANG_INT_TYPE) - || (ind_at->num_dims != 1)) - { - SLang_verror (SL_TYPE_MISMATCH, "Expecting 1-d integer array"); - goto return_error; - } - - if (-1 == _SLang_pop_datatype (&type)) - goto return_error; - - if (NULL == (at = SLang_create_array (type, 0, NULL, - (int *) ind_at->data, - ind_at->num_elements))) - goto return_error; - - SLang_free_array (ind_at); - return SLang_push_array (at, 1); - - return_error: - SLang_free_array (ind_at); - return -1; -} - -static int array_length (unsigned char type, VOID_STAR v, unsigned int *len) -{ - SLang_Array_Type *at; - - (void) type; - at = *(SLang_Array_Type **) v; - *len = at->num_elements; - return 0; -} - -int -_SLarray_init_slarray (void) -{ - SLang_Class_Type *cl; - - if (-1 == SLadd_intrin_fun_table (Array_Table, NULL)) - return -1; - - if (NULL == (cl = SLclass_allocate_class ("Array_Type"))) - return -1; - - (void) SLclass_set_string_function (cl, array_string); - (void) SLclass_set_destroy_function (cl, array_destroy); - (void) SLclass_set_push_function (cl, array_push); - cl->cl_push_intrinsic = array_push_intrinsic; - cl->cl_dereference = array_dereference; - cl->cl_datatype_deref = array_datatype_deref; - cl->cl_length = array_length; - - if (-1 == SLclass_register_class (cl, SLANG_ARRAY_TYPE, sizeof (VOID_STAR), - SLANG_CLASS_TYPE_PTR)) - return -1; - - if ((-1 == SLclass_add_binary_op (SLANG_ARRAY_TYPE, SLANG_ARRAY_TYPE, array_binary_op, array_binary_op_result)) - || (-1 == SLclass_add_unary_op (SLANG_ARRAY_TYPE, array_unary_op, array_unary_op_result)) - || (-1 == SLclass_add_app_unary_op (SLANG_ARRAY_TYPE, array_app_op, array_unary_op_result)) - || (-1 == SLclass_add_math_op (SLANG_ARRAY_TYPE, array_math_op, array_unary_op_result)) - || (-1 == SLclass_add_math_op (SLANG_ARRAY_TYPE, array_math_op, array_unary_op_result))) - return -1; - - return 0; -} - -int SLang_pop_array (SLang_Array_Type **at_ptr, int convert_scalar) -{ - if (-1 == pop_array (at_ptr, convert_scalar)) - return -1; - - if (-1 == coerse_array_to_linear (*at_ptr)) - { - SLang_free_array (*at_ptr); - return -1; - } - return 0; -} - -int SLang_pop_array_of_type (SLang_Array_Type **at, unsigned char type) -{ - if (-1 == SLclass_typecast (type, 1, 1)) - return -1; - - return SLang_pop_array (at, 1); -} - -void (*_SLang_Matrix_Multiply)(void); - -int _SLarray_matrix_multiply (void) -{ - if (_SLang_Matrix_Multiply != NULL) - { - (*_SLang_Matrix_Multiply)(); - return 0; - } - SLang_verror (SL_NOT_IMPLEMENTED, "Matrix multiplication not available"); - return -1; -} - -struct _SLang_Foreach_Context_Type -{ - SLang_Array_Type *at; - unsigned int next_element_index; -}; - -SLang_Foreach_Context_Type * -_SLarray_cl_foreach_open (unsigned char type, unsigned int num) -{ - SLang_Foreach_Context_Type *c; - - if (num != 0) - { - SLdo_pop_n (num + 1); - SLang_verror (SL_NOT_IMPLEMENTED, - "%s does not support 'foreach using' form", - SLclass_get_datatype_name (type)); - return NULL; - } - - if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type)))) - return NULL; - - memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type)); - - if (-1 == pop_array (&c->at, 1)) - { - SLfree ((char *) c); - return NULL; - } - - return c; -} - -void _SLarray_cl_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c) -{ - (void) type; - if (c == NULL) return; - SLang_free_array (c->at); - SLfree ((char *) c); -} - -int _SLarray_cl_foreach (unsigned char type, SLang_Foreach_Context_Type *c) -{ - SLang_Array_Type *at; - VOID_STAR data; - - (void) type; - - if (c == NULL) - return -1; - - at = c->at; - if (at->num_elements == c->next_element_index) - return 0; - - /* FIXME: Priority = low. The following assumes linear arrays - * or Integer range arrays. Fixing it right requires a method to get the - * nth element of a multidimensional array. - */ - - if (at->flags & SLARR_DATA_VALUE_IS_RANGE) - { - int d = (int) c->next_element_index; - data = range_get_data_addr (at, &d); - } - else - data = (VOID_STAR) ((char *)at->data + (c->next_element_index * at->sizeof_type)); - - c->next_element_index += 1; - - if ((at->flags & SLARR_DATA_VALUE_IS_POINTER) - && (*(VOID_STAR *) data == NULL)) - { - if (-1 == SLang_push_null ()) - return -1; - } - else if (-1 == (*at->cl->cl_apush)(at->data_type, data)) - return -1; - - /* keep going */ - return 1; -} - diff --git a/mdk-stage1/slang/slarrfun.c b/mdk-stage1/slang/slarrfun.c deleted file mode 100644 index bfa6ec5e5..000000000 --- a/mdk-stage1/slang/slarrfun.c +++ /dev/null @@ -1,464 +0,0 @@ -/* Advanced array manipulation routines for S-Lang */ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -static int next_transposed_index (int *dims, int *max_dims, unsigned int num_dims) -{ - int i; - - for (i = 0; i < (int) num_dims; i++) - { - int dims_i; - - dims_i = dims [i] + 1; - if (dims_i != (int) max_dims [i]) - { - dims [i] = dims_i; - return 0; - } - dims [i] = 0; - } - - return -1; -} - -static SLang_Array_Type *allocate_transposed_array (SLang_Array_Type *at) -{ - unsigned int num_elements; - SLang_Array_Type *bt; - VOID_STAR b_data; - - num_elements = at->num_elements; - b_data = (VOID_STAR) SLmalloc (at->sizeof_type * num_elements); - if (b_data == NULL) - return NULL; - - bt = SLang_create_array (at->data_type, 0, b_data, at->dims, 2); - if (bt == NULL) - { - SLfree ((char *)b_data); - return NULL; - } - - bt->dims[1] = at->dims[0]; - bt->dims[0] = at->dims[1]; - - return bt; -} - -#define GENERIC_TYPE float -#define TRANSPOSE_2D_ARRAY transpose_floats -#define GENERIC_TYPE_A float -#define GENERIC_TYPE_B float -#define GENERIC_TYPE_C float -#define INNERPROD_FUNCTION innerprod_float_float -#if SLANG_HAS_COMPLEX -# define INNERPROD_COMPLEX_A innerprod_complex_float -# define INNERPROD_A_COMPLEX innerprod_float_complex -#endif -#include "slarrfun.inc" - -#define GENERIC_TYPE double -#define TRANSPOSE_2D_ARRAY transpose_doubles -#define GENERIC_TYPE_A double -#define GENERIC_TYPE_B double -#define GENERIC_TYPE_C double -#define INNERPROD_FUNCTION innerprod_double_double -#if SLANG_HAS_COMPLEX -# define INNERPROD_COMPLEX_A innerprod_complex_double -# define INNERPROD_A_COMPLEX innerprod_double_complex -#endif -#include "slarrfun.inc" - -#define GENERIC_TYPE_A double -#define GENERIC_TYPE_B float -#define GENERIC_TYPE_C double -#define INNERPROD_FUNCTION innerprod_double_float -#include "slarrfun.inc" - -#define GENERIC_TYPE_A float -#define GENERIC_TYPE_B double -#define GENERIC_TYPE_C double -#define INNERPROD_FUNCTION innerprod_float_double -#include "slarrfun.inc" - -/* Finally pick up the complex_complex multiplication - * and do the integers - */ -#if SLANG_HAS_COMPLEX -# define INNERPROD_COMPLEX_COMPLEX innerprod_complex_complex -#endif -#define GENERIC_TYPE int -#define TRANSPOSE_2D_ARRAY transpose_ints -#include "slarrfun.inc" - -#if SIZEOF_LONG != SIZEOF_INT -# define GENERIC_TYPE long -# define TRANSPOSE_2D_ARRAY transpose_longs -# include "slarrfun.inc" -#else -# define transpose_longs transpose_ints -#endif - -#if SIZEOF_SHORT != SIZEOF_INT -# define GENERIC_TYPE short -# define TRANSPOSE_2D_ARRAY transpose_shorts -# include "slarrfun.inc" -#else -# define transpose_shorts transpose_ints -#endif - -#define GENERIC_TYPE char -#define TRANSPOSE_2D_ARRAY transpose_chars -#include "slarrfun.inc" - -/* This routine works only with linear arrays */ -static SLang_Array_Type *transpose (SLang_Array_Type *at) -{ - int dims [SLARRAY_MAX_DIMS]; - int *max_dims; - unsigned int num_dims; - SLang_Array_Type *bt; - int i; - unsigned int sizeof_type; - int is_ptr; - char *b_data; - - max_dims = at->dims; - num_dims = at->num_dims; - - if ((at->num_elements == 0) - || (num_dims == 1)) - { - bt = SLang_duplicate_array (at); - if (num_dims == 1) bt->num_dims = 2; - goto transpose_dims; - } - - /* For numeric arrays skip the overhead below */ - if (num_dims == 2) - { - bt = allocate_transposed_array (at); - if (bt == NULL) return NULL; - - switch (at->data_type) - { - case SLANG_INT_TYPE: - case SLANG_UINT_TYPE: - return transpose_ints (at, bt); - case SLANG_DOUBLE_TYPE: - return transpose_doubles (at, bt); - case SLANG_FLOAT_TYPE: - return transpose_floats (at, bt); - case SLANG_CHAR_TYPE: - case SLANG_UCHAR_TYPE: - return transpose_chars (at, bt); - case SLANG_LONG_TYPE: - case SLANG_ULONG_TYPE: - return transpose_longs (at, bt); - case SLANG_SHORT_TYPE: - case SLANG_USHORT_TYPE: - return transpose_shorts (at, bt); - } - } - else - { - bt = SLang_create_array (at->data_type, 0, NULL, max_dims, num_dims); - if (bt == NULL) return NULL; - } - - sizeof_type = at->sizeof_type; - is_ptr = (at->flags & SLARR_DATA_VALUE_IS_POINTER); - - memset ((char *)dims, 0, sizeof(dims)); - - b_data = (char *) bt->data; - - do - { - if (-1 == _SLarray_aget_transfer_elem (at, dims, (VOID_STAR) b_data, - sizeof_type, is_ptr)) - { - SLang_free_array (bt); - return NULL; - } - b_data += sizeof_type; - } - while (0 == next_transposed_index (dims, max_dims, num_dims)); - - transpose_dims: - - num_dims = bt->num_dims; - for (i = 0; i < (int) num_dims; i++) - bt->dims[i] = max_dims [num_dims - i - 1]; - - return bt; -} - -static void array_transpose (SLang_Array_Type *at) -{ - if (NULL != (at = transpose (at))) - (void) SLang_push_array (at, 1); -} - -static int get_inner_product_parms (SLang_Array_Type *a, int *dp, - unsigned int *loops, unsigned int *other) -{ - int num_dims; - int d; - - d = *dp; - - num_dims = (int)a->num_dims; - if (num_dims == 0) - { - SLang_verror (SL_INVALID_PARM, "Inner-product operation requires an array of at least 1 dimension."); - return -1; - } - - /* An index of -1 refers to last dimension */ - if (d == -1) - d += num_dims; - *dp = d; - - if (a->num_elements == 0) - { /* [] # [] ==> [] */ - *loops = *other = 0; - return 0; - } - - *loops = a->num_elements / a->dims[d]; - - if (d == 0) - { - *other = *loops; /* a->num_elements / a->dims[0]; */ - return 0; - } - - *other = a->dims[d]; - return 0; -} - -/* This routines takes two arrays A_i..j and B_j..k and produces a third - * via C_i..k = A_i..j B_j..k. - * - * If A is a vector, and B is a 2-d matrix, then regard A as a 2-d matrix - * with 1-column. - */ -static void do_inner_product (void) -{ - SLang_Array_Type *a, *b, *c; - void (*fun)(SLang_Array_Type *, SLang_Array_Type *, SLang_Array_Type *, - unsigned int, unsigned int, unsigned int, unsigned int, - unsigned int); - unsigned char c_type; - int dims[SLARRAY_MAX_DIMS]; - int status; - unsigned int a_loops, b_loops, b_inc, a_stride; - int ai_dims, i, j; - unsigned int num_dims, a_num_dims, b_num_dims; - int ai, bi; - - /* The result of a inner_product will be either a float, double, or - * a complex number. - * - * If an integer array is used, it will be promoted to a float. - */ - - switch (SLang_peek_at_stack1 ()) - { - case SLANG_DOUBLE_TYPE: - if (-1 == SLang_pop_array_of_type (&b, SLANG_DOUBLE_TYPE)) - return; - break; - -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - if (-1 == SLang_pop_array_of_type (&b, SLANG_COMPLEX_TYPE)) - return; - break; -#endif - case SLANG_FLOAT_TYPE: - default: - if (-1 == SLang_pop_array_of_type (&b, SLANG_FLOAT_TYPE)) - return; - break; - } - - switch (SLang_peek_at_stack1 ()) - { - case SLANG_DOUBLE_TYPE: - status = SLang_pop_array_of_type (&a, SLANG_DOUBLE_TYPE); - break; - -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - status = SLang_pop_array_of_type (&a, SLANG_COMPLEX_TYPE); - break; -#endif - case SLANG_FLOAT_TYPE: - default: - status = SLang_pop_array_of_type (&a, SLANG_FLOAT_TYPE); - break; - } - - if (status == -1) - { - SLang_free_array (b); - return; - } - - ai = -1; /* last index of a */ - bi = 0; /* first index of b */ - if ((-1 == get_inner_product_parms (a, &ai, &a_loops, &a_stride)) - || (-1 == get_inner_product_parms (b, &bi, &b_loops, &b_inc))) - { - SLang_verror (SL_TYPE_MISMATCH, "Array dimensions are not compatible for inner-product"); - goto free_and_return; - } - - a_num_dims = a->num_dims; - b_num_dims = b->num_dims; - - /* Coerse a 1-d vector to 2-d */ - if ((a_num_dims == 1) - && (b_num_dims == 2) - && (a->num_elements)) - { - a_num_dims = 2; - ai = 1; - a_loops = a->num_elements; - a_stride = 1; - } - - if ((ai_dims = a->dims[ai]) != b->dims[bi]) - { - SLang_verror (SL_TYPE_MISMATCH, "Array dimensions are not compatible for inner-product"); - goto free_and_return; - } - - num_dims = a_num_dims + b_num_dims - 2; - if (num_dims > SLARRAY_MAX_DIMS) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "Inner-product result exceed max allowed dimensions"); - goto free_and_return; - } - - if (num_dims) - { - j = 0; - for (i = 0; i < (int)a_num_dims; i++) - if (i != ai) dims [j++] = a->dims[i]; - for (i = 0; i < (int)b_num_dims; i++) - if (i != bi) dims [j++] = b->dims[i]; - } - else - { - /* a scalar */ - num_dims = 1; - dims[0] = 1; - } - - c_type = 0; fun = NULL; - switch (a->data_type) - { - case SLANG_FLOAT_TYPE: - switch (b->data_type) - { - case SLANG_FLOAT_TYPE: - c_type = SLANG_FLOAT_TYPE; - fun = innerprod_float_float; - break; - case SLANG_DOUBLE_TYPE: - c_type = SLANG_DOUBLE_TYPE; - fun = innerprod_float_double; - break; -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - c_type = SLANG_COMPLEX_TYPE; - fun = innerprod_float_complex; - break; -#endif - } - break; - case SLANG_DOUBLE_TYPE: - switch (b->data_type) - { - case SLANG_FLOAT_TYPE: - c_type = SLANG_DOUBLE_TYPE; - fun = innerprod_double_float; - break; - case SLANG_DOUBLE_TYPE: - c_type = SLANG_DOUBLE_TYPE; - fun = innerprod_double_double; - break; -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - c_type = SLANG_COMPLEX_TYPE; - fun = innerprod_double_complex; - break; -#endif - } - break; -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - c_type = SLANG_COMPLEX_TYPE; - switch (b->data_type) - { - case SLANG_FLOAT_TYPE: - fun = innerprod_complex_float; - break; - case SLANG_DOUBLE_TYPE: - fun = innerprod_complex_double; - break; - case SLANG_COMPLEX_TYPE: - fun = innerprod_complex_complex; - break; - } - break; -#endif - default: - break; - } - - if (NULL == (c = SLang_create_array (c_type, 0, NULL, dims, num_dims))) - goto free_and_return; - - (*fun)(a, b, c, a_loops, a_stride, b_loops, b_inc, ai_dims); - - (void) SLang_push_array (c, 1); - /* drop */ - - free_and_return: - SLang_free_array (a); - SLang_free_array (b); -} - - - -static SLang_Intrin_Fun_Type Array_Fun_Table [] = -{ - MAKE_INTRINSIC_1("transpose", array_transpose, SLANG_VOID_TYPE, SLANG_ARRAY_TYPE), - SLANG_END_INTRIN_FUN_TABLE -}; - -int SLang_init_array (void) -{ - if (-1 == SLadd_intrin_fun_table (Array_Fun_Table, "__SLARRAY__")) - return -1; -#if SLANG_HAS_FLOAT - _SLang_Matrix_Multiply = do_inner_product; -#endif - return 0; -} - diff --git a/mdk-stage1/slang/slarrfun.inc b/mdk-stage1/slang/slarrfun.inc deleted file mode 100644 index 348473a6f..000000000 --- a/mdk-stage1/slang/slarrfun.inc +++ /dev/null @@ -1,257 +0,0 @@ -/* -*- mode: C -*- */ - -/* Some "inline" functions for generic scalar types */ - -#ifdef TRANSPOSE_2D_ARRAY -static SLang_Array_Type *TRANSPOSE_2D_ARRAY (SLang_Array_Type *at, SLang_Array_Type *bt) -{ - GENERIC_TYPE *a_data, *b_data; - int nr, nc, i; - - nr = at->dims[0]; - nc = at->dims[1]; - - a_data = (GENERIC_TYPE *) at->data; - b_data = (GENERIC_TYPE *) bt->data; - - for (i = 0; i < nr; i++) - { - GENERIC_TYPE *offset = b_data + i; - int j; - for (j = 0; j < nc; j++) - { - *offset = *a_data++; - offset += nr; - } - } - return bt; -} -#undef TRANSPOSE_2D_ARRAY -#endif - - -#ifdef INNERPROD_FUNCTION - -static void INNERPROD_FUNCTION - (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, - unsigned int a_loops, unsigned int a_stride, - unsigned int b_loops, unsigned int b_inc, - unsigned int inner_loops) -{ - GENERIC_TYPE_A *a; - GENERIC_TYPE_B *b; - GENERIC_TYPE_C *c; - - c = (GENERIC_TYPE_C *) ct->data; - b = (GENERIC_TYPE_B *) bt->data; - a = (GENERIC_TYPE_A *) at->data; - - while (a_loops--) - { - GENERIC_TYPE_B *bb; - unsigned int j; - - bb = b; - - for (j = 0; j < inner_loops; j++) - { - double x = (double) a[j]; - - if (x != 0.0) - { - unsigned int k; - - for (k = 0; k < b_loops; k++) - c[k] += x * bb[k]; - } - bb += b_inc; - } - c += b_loops; - a += a_stride; - } -} -#undef INNERPROD_FUNCTION - -#undef GENERIC_TYPE_A -#undef GENERIC_TYPE_B -#undef GENERIC_TYPE_C -#endif - -#ifdef INNERPROD_COMPLEX_A -static void INNERPROD_COMPLEX_A - (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, - unsigned int a_loops, unsigned int a_stride, - unsigned int b_loops, unsigned int b_inc, - unsigned int inner_loops) -{ - double *a; - GENERIC_TYPE *b; - double *c; - - c = (double *) ct->data; - b = (GENERIC_TYPE *) bt->data; - a = (double *) at->data; - - a_stride *= 2; - - while (a_loops--) - { - GENERIC_TYPE *bb; - unsigned int bb_loops; - - bb = b; - bb_loops = b_loops; - - while (bb_loops--) - { - double real_sum; - double imag_sum; - unsigned int iloops; - double *aa; - GENERIC_TYPE *bbb; - - aa = a; - bbb = bb; - iloops = inner_loops; - - real_sum = 0.0; - imag_sum = 0.0; - while (iloops--) - { - real_sum += aa[0] * (double)bbb[0]; - imag_sum += aa[1] * (double)bbb[0]; - aa += 2; - bbb += b_inc; - } - - *c++ = real_sum; - *c++ = imag_sum; - bb++; - } - - a += a_stride; - } -} - -static void INNERPROD_A_COMPLEX - (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, - unsigned int a_loops, unsigned int a_stride, - unsigned int b_loops, unsigned int b_inc, - unsigned int inner_loops) -{ - GENERIC_TYPE *a; - double *b; - double *c; - - c = (double *) ct->data; - b = (double *) bt->data; - a = (GENERIC_TYPE *) at->data; - - b_inc *= 2; - - while (a_loops--) - { - double *bb; - unsigned int bb_loops; - - bb = b; - bb_loops = b_loops; - - while (bb_loops--) - { - double real_sum; - double imag_sum; - unsigned int iloops; - GENERIC_TYPE *aa; - double *bbb; - - aa = a; - bbb = bb; - iloops = inner_loops; - - real_sum = 0.0; - imag_sum = 0.0; - while (iloops--) - { - real_sum += (double)aa[0] * bbb[0]; - imag_sum += (double)aa[0] * bbb[1]; - aa += 1; - bbb += b_inc; - } - - *c++ = real_sum; - *c++ = imag_sum; - bb += 2; - } - - a += a_stride; - } -} - -#undef INNERPROD_A_COMPLEX -#undef INNERPROD_COMPLEX_A -#endif /* INNERPROD_COMPLEX_A */ - - -#ifdef INNERPROD_COMPLEX_COMPLEX -static void INNERPROD_COMPLEX_COMPLEX - (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, - unsigned int a_loops, unsigned int a_stride, - unsigned int b_loops, unsigned int b_inc, - unsigned int inner_loops) -{ - double *a; - double *b; - double *c; - - c = (double *) ct->data; - b = (double *) bt->data; - a = (double *) at->data; - - a_stride *= 2; - b_inc *= 2; - - while (a_loops--) - { - double *bb; - unsigned int bb_loops; - - bb = b; - bb_loops = b_loops; - - while (bb_loops--) - { - double real_sum; - double imag_sum; - unsigned int iloops; - double *aa; - double *bbb; - - aa = a; - bbb = bb; - iloops = inner_loops; - - real_sum = 0.0; - imag_sum = 0.0; - while (iloops--) - { - real_sum += aa[0]*bbb[0] - aa[1]*bbb[1]; - imag_sum += aa[0]*bbb[1] + aa[1]*bbb[0]; - aa += 2; - bbb += b_inc; - } - - *c++ = real_sum; - *c++ = imag_sum; - bb += 2; - } - - a += a_stride; - } -} -#undef INNERPROD_COMPLEX_COMPLEX -#endif - -#ifdef GENERIC_TYPE -# undef GENERIC_TYPE -#endif diff --git a/mdk-stage1/slang/slarrmis.c b/mdk-stage1/slang/slarrmis.c deleted file mode 100644 index 330dcb53f..000000000 --- a/mdk-stage1/slang/slarrmis.c +++ /dev/null @@ -1,38 +0,0 @@ -/* Misc Array Functions */ -/* Copyright (c) 1997, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -int SLang_get_array_element (SLang_Array_Type *at, int *indices, VOID_STAR data) -{ - int is_ptr; - - if ((at == NULL) - || (indices == NULL) - || (data == NULL)) - return -1; - - is_ptr = (at->flags & SLARR_DATA_VALUE_IS_POINTER); - if (is_ptr) *(VOID_STAR *) data = NULL; - return _SLarray_aget_transfer_elem (at, indices, data, at->sizeof_type, is_ptr); -} - -int SLang_set_array_element (SLang_Array_Type *at, int *indices, VOID_STAR data) -{ - if ((at == NULL) - || (indices == NULL) - || (data == NULL)) - return -1; - - return _SLarray_aput_transfer_elem (at, indices, data, at->sizeof_type, - at->flags & SLARR_DATA_VALUE_IS_POINTER); -} - diff --git a/mdk-stage1/slang/slassoc.c b/mdk-stage1/slang/slassoc.c deleted file mode 100644 index 5997458d2..000000000 --- a/mdk-stage1/slang/slassoc.c +++ /dev/null @@ -1,713 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#define SL_APP_WANTS_FOREACH -#include "slang.h" -#include "_slang.h" - -#define USE_NEW_ANYTYPE_CODE 1 - -typedef struct _SLAssoc_Array_Element_Type -{ - char *key; /* slstring */ - struct _SLAssoc_Array_Element_Type *next; - SLang_Object_Type value; -} -_SLAssoc_Array_Element_Type; - -typedef struct -{ - _SLAssoc_Array_Element_Type *elements[SLASSOC_HASH_TABLE_SIZE]; - SLang_Object_Type default_value; - unsigned int num_elements; -#define HAS_DEFAULT_VALUE 1 - unsigned int flags; - unsigned char type; -} -SLang_Assoc_Array_Type; - -#define USE_CACHED_STRING 1 - -#if USE_CACHED_STRING -static char *Cached_String; -static SLang_Object_Type *Cached_Obj; -static SLang_Assoc_Array_Type *Cached_Array; -#endif - -static SLang_Assoc_Array_Type *alloc_assoc_array (unsigned char type, int has_default_value) -{ - SLang_Assoc_Array_Type *a; - - a = (SLang_Assoc_Array_Type *)SLmalloc (sizeof (SLang_Assoc_Array_Type)); - if (a == NULL) - { - if (has_default_value) - SLdo_pop_n (1); - return NULL; - } - - memset ((char *) a, 0, sizeof (SLang_Assoc_Array_Type)); - a->type = type; - - if (has_default_value) - { - if ( -#if USE_NEW_ANYTYPE_CODE - ((type != SLANG_ANY_TYPE) && (-1 == SLclass_typecast (type, 1, 1))) -#else - (-1 == SLclass_typecast (type, 1, 1)) -#endif - || (-1 == SLang_pop (&a->default_value))) - { - SLfree ((char *) a); - return NULL; - } - - a->flags |= HAS_DEFAULT_VALUE; - } - return a; -} - -static void free_element (_SLAssoc_Array_Element_Type *e) -{ - if (e == NULL) - return; - - SLang_free_object (&e->value); - SLang_free_slstring (e->key); -#if USE_CACHED_STRING - if (e->key == Cached_String) - Cached_String = NULL; -#endif - SLfree ((char *)e); -} - -static void delete_assoc_array (SLang_Assoc_Array_Type *a) -{ - unsigned int i; - - if (a == NULL) return; - - for (i = 0; i < SLASSOC_HASH_TABLE_SIZE; i++) - { - _SLAssoc_Array_Element_Type *e; - - e = a->elements[i]; - while (e != NULL) - { - _SLAssoc_Array_Element_Type *next_e; - - next_e = e->next; - free_element (e); - e = next_e; - } - } - if (a->flags & HAS_DEFAULT_VALUE) - SLang_free_object (&a->default_value); - - SLfree ((char *) a); -} - -_INLINE_ -static SLang_Object_Type * -find_element (SLang_Assoc_Array_Type *a, char *str, unsigned long hash) -{ - unsigned int h; - _SLAssoc_Array_Element_Type *e; - - h = (unsigned int) (hash % SLASSOC_HASH_TABLE_SIZE); - e = a->elements[h]; - - while (e != NULL) - { - if (str == e->key) /* slstrings can be compared this way */ - { -#if USE_CACHED_STRING - Cached_String = str; - Cached_Obj = &e->value; - Cached_Array = a; -#endif - return &e->value; - } - - e = e->next; - } - - return NULL; -} - -static _SLAssoc_Array_Element_Type * -create_element (SLang_Assoc_Array_Type *a, char *str, unsigned long hash) -{ - unsigned int h; - _SLAssoc_Array_Element_Type *e; - - e = (_SLAssoc_Array_Element_Type *) SLmalloc (sizeof (_SLAssoc_Array_Element_Type)); - if (e == NULL) - return NULL; - - memset ((char *) e, 0, sizeof (_SLAssoc_Array_Element_Type)); - h = (unsigned int) (hash % SLASSOC_HASH_TABLE_SIZE); - - if (NULL == (str = _SLstring_dup_hashed_string (str, hash))) - { - SLfree ((char *) e); - return NULL; - } - - e->key = str; - e->next = a->elements[h]; - a->elements[h] = e; - - a->num_elements += 1; -#if USE_CACHED_STRING - Cached_String = str; - Cached_Obj = &e->value; - Cached_Array = a; -#endif - return e; -} - -static int store_object (SLang_Assoc_Array_Type *a, char *s, SLang_Object_Type *obj) -{ - unsigned long hash; - SLang_Object_Type *v; - -#if USE_CACHED_STRING - if ((s == Cached_String) && (a == Cached_Array)) - { - v = Cached_Obj; - SLang_free_object (v); - } - else - { -#endif - hash = _SLcompute_string_hash (s); - if (NULL != (v = find_element (a, s, hash))) - SLang_free_object (v); - else - { - _SLAssoc_Array_Element_Type *e; - - e = create_element (a, s, hash); - if (e == NULL) - return -1; - - v = &e->value; - } -#if USE_CACHED_STRING - } -#endif - - *v = *obj; - - return 0; -} - -static void assoc_destroy (unsigned char type, VOID_STAR ptr) -{ - (void) type; - delete_assoc_array ((SLang_Assoc_Array_Type *) ptr); -} - -static int pop_index (unsigned int num_indices, - SLang_MMT_Type **mmt, - SLang_Assoc_Array_Type **a, - char **str) -{ - if (NULL == (*mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE))) - { - *a = NULL; - *str = NULL; - return -1; - } - - if ((num_indices != 1) - || (-1 == SLang_pop_slstring (str))) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "Assoc_Type arrays require a single string index"); - SLang_free_mmt (*mmt); - *mmt = NULL; - *a = NULL; - *str = NULL; - return -1; - } - - *a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (*mmt); - return 0; -} - -static int assoc_aget (unsigned char type, unsigned int num_indices) -{ - SLang_MMT_Type *mmt; - char *str; - SLang_Assoc_Array_Type *a; - SLang_Object_Type *obj; - int ret; - - (void) type; - - if (-1 == pop_index (num_indices, &mmt, &a, &str)) - return -1; - -#if USE_CACHED_STRING - if ((str == Cached_String) && (a == Cached_Array)) - obj = Cached_Obj; - else -#endif - obj = find_element (a, str, _SLcompute_string_hash (str)); - - if ((obj == NULL) - && (a->flags & HAS_DEFAULT_VALUE)) - obj = &a->default_value; - - if (obj == NULL) - { - SLang_verror (SL_INTRINSIC_ERROR, - "No such element in Assoc Array: %s", str); - ret = -1; - } - else - { -#if _SLANG_OPTIMIZE_FOR_SPEED - if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type[obj->data_type]) - ret = SLang_push (obj); -#endif - else - ret = _SLpush_slang_obj (obj); - } - - SLang_free_slstring (str); - SLang_free_mmt (mmt); - return ret; -} - -static int assoc_aput (unsigned char type, unsigned int num_indices) -{ - SLang_MMT_Type *mmt; - char *str; - SLang_Assoc_Array_Type *a; - SLang_Object_Type obj; - int ret; - - (void) type; - - if (-1 == pop_index (num_indices, &mmt, &a, &str)) - return -1; - - ret = -1; - - if (0 == SLang_pop (&obj)) - { - if ((obj.data_type != a->type) -#if USE_NEW_ANYTYPE_CODE - && (a->type != SLANG_ANY_TYPE) -#endif - ) - { - (void) SLang_push (&obj); - if ((-1 == SLclass_typecast (a->type, 1, 1)) - || (-1 == SLang_pop (&obj))) - goto the_return; - } - - if (-1 == store_object (a, str, &obj)) - SLang_free_object (&obj); - else - ret = 0; - } - - the_return: - SLang_free_slstring (str); - SLang_free_mmt (mmt); - return ret; -} - -static int assoc_anew (unsigned char type, unsigned int num_dims) -{ - SLang_MMT_Type *mmt; - SLang_Assoc_Array_Type *a; - int has_default_value; - - has_default_value = 0; - switch (num_dims) - { - case 0: - type = SLANG_ANY_TYPE; - break; - case 2: - (void) SLreverse_stack (2); - has_default_value = 1; - /* drop */ - case 1: - if (0 == _SLang_pop_datatype (&type)) - break; - num_dims--; - /* drop */ - default: - SLdo_pop_n (num_dims); - SLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type [DataType_Type]"); - return -1; - } - - a = alloc_assoc_array (type, has_default_value); - if (a == NULL) - return -1; - - if (NULL == (mmt = SLang_create_mmt (SLANG_ASSOC_TYPE, (VOID_STAR) a))) - { - delete_assoc_array (a); - return -1; - } - - if (-1 == SLang_push_mmt (mmt)) - { - SLang_free_mmt (mmt); - return -1; - } - - return 0; -} - -static void assoc_get_keys (SLang_Assoc_Array_Type *a) -{ - SLang_Array_Type *at; - int num; - unsigned int i, j; - char **data; - - /* Note: If support for threads is added, then we need to modify this - * algorithm to prevent another thread from modifying the array. - * However, that should be handled in inner_interp. - */ - num = a->num_elements; - - if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1))) - return; - - data = (char **)at->data; - - i = 0; - for (j = 0; j < SLASSOC_HASH_TABLE_SIZE; j++) - { - _SLAssoc_Array_Element_Type *e; - - e = a->elements[j]; - while (e != NULL) - { - /* Next cannot fail because it is an slstring */ - data [i] = SLang_create_slstring (e->key); - e = e->next; - i++; - } - } - (void) SLang_push_array (at, 1); -} - -static int -transfer_element (SLang_Class_Type *cl, VOID_STAR dest_data, - SLang_Object_Type *obj) -{ - unsigned int sizeof_type; - VOID_STAR src_data; - -#if USE_NEW_ANYTYPE_CODE - if (cl->cl_data_type == SLANG_ANY_TYPE) - { - SLang_Any_Type *any; - - if ((-1 == _SLpush_slang_obj (obj)) - || (-1 == SLang_pop_anytype (&any))) - return -1; - - *(SLang_Any_Type **)dest_data = any; - return 0; - } -#endif - /* Optimize for scalar */ - if (cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR) - { - sizeof_type = cl->cl_sizeof_type; - memcpy ((char *) dest_data, (char *)&obj->v, sizeof_type); - return 0; - } - - src_data = _SLclass_get_ptr_to_value (cl, obj); - - if (-1 == (*cl->cl_acopy) (cl->cl_data_type, src_data, dest_data)) - return -1; - - return 0; -} - -static void assoc_get_values (SLang_Assoc_Array_Type *a) -{ - SLang_Array_Type *at; - int num; - unsigned int i, j; - char *dest_data; - unsigned char type; - SLang_Class_Type *cl; - unsigned int sizeof_type; - - /* Note: If support for threads is added, then we need to modify this - * algorithm to prevent another thread from modifying the array. - * However, that should be handled in inner_interp. - */ - num = a->num_elements; - type = a->type; - - cl = _SLclass_get_class (type); - sizeof_type = cl->cl_sizeof_type; - - if (NULL == (at = SLang_create_array (type, 0, NULL, &num, 1))) - return; - - dest_data = (char *)at->data; - - i = 0; - for (j = 0; j < SLASSOC_HASH_TABLE_SIZE; j++) - { - _SLAssoc_Array_Element_Type *e; - - e = a->elements[j]; - while (e != NULL) - { - if (-1 == transfer_element (cl, (VOID_STAR) dest_data, &e->value)) - { - SLang_free_array (at); - return; - } - - dest_data += sizeof_type; - e = e->next; - i++; - } - } - (void) SLang_push_array (at, 1); -} - -static int assoc_key_exists (SLang_Assoc_Array_Type *a, char *key) -{ - return (NULL != find_element (a, key, _SLcompute_string_hash (key))); -} - -static void assoc_delete_key (SLang_Assoc_Array_Type *a, char *key) -{ - unsigned int h; - _SLAssoc_Array_Element_Type *v, *v0; - - h = (unsigned int) (_SLcompute_string_hash (key) % SLASSOC_HASH_TABLE_SIZE); - - v0 = NULL; - v = a->elements[h]; - while (v != NULL) - { - if (v->key == key) - { - if (v0 != NULL) - v0->next = v->next; - else - a->elements[h] = v->next; - - free_element (v); - a->num_elements -= 1; - return; - } - v0 = v; - v = v->next; - } - - /* No such element. Let it pass with no error. */ -} - -#define A SLANG_ASSOC_TYPE -#define S SLANG_STRING_TYPE -static SLang_Intrin_Fun_Type Assoc_Table [] = -{ - MAKE_INTRINSIC_1("assoc_get_keys", assoc_get_keys, SLANG_VOID_TYPE, A), - MAKE_INTRINSIC_1("assoc_get_values", assoc_get_values, SLANG_VOID_TYPE, A), - MAKE_INTRINSIC_2("assoc_key_exists", assoc_key_exists, SLANG_INT_TYPE, A, S), - MAKE_INTRINSIC_2("assoc_delete_key", assoc_delete_key, SLANG_VOID_TYPE, A, S), - - SLANG_END_INTRIN_FUN_TABLE -}; -#undef A -#undef S - -static int assoc_length (unsigned char type, VOID_STAR v, unsigned int *len) -{ - SLang_Assoc_Array_Type *a; - - (void) type; - a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (*(SLang_MMT_Type **)v); - *len = a->num_elements; - return 0; -} - -struct _SLang_Foreach_Context_Type -{ - SLang_MMT_Type *mmt; - SLang_Assoc_Array_Type *a; - unsigned int this_hash_index; - unsigned int next_same_hash_index; -#define CTX_WRITE_KEYS 1 -#define CTX_WRITE_VALUES 2 - unsigned char flags; -}; - -static SLang_Foreach_Context_Type * -cl_foreach_open (unsigned char type, unsigned int num) -{ - SLang_Foreach_Context_Type *c; - unsigned char flags; - SLang_MMT_Type *mmt; - - (void) type; - - if (NULL == (mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE))) - return NULL; - - flags = 0; - - while (num--) - { - char *s; - - if (-1 == SLang_pop_slstring (&s)) - { - SLang_free_mmt (mmt); - return NULL; - } - - if (0 == strcmp (s, "keys")) - flags |= CTX_WRITE_KEYS; - else if (0 == strcmp (s, "values")) - flags |= CTX_WRITE_VALUES; - else - { - SLang_verror (SL_NOT_IMPLEMENTED, - "using '%s' not supported by SLassoc_Type", - s); - SLang_free_slstring (s); - SLang_free_mmt (mmt); - return NULL; - } - - SLang_free_slstring (s); - } - - if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type)))) - { - SLang_free_mmt (mmt); - return NULL; - } - - memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type)); - - if (flags == 0) flags = CTX_WRITE_VALUES|CTX_WRITE_KEYS; - - c->flags = flags; - c->mmt = mmt; - c->a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (mmt); - - return c; -} - -static void cl_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c) -{ - (void) type; - if (c == NULL) return; - SLang_free_mmt (c->mmt); - SLfree ((char *) c); -} - -static int cl_foreach (unsigned char type, SLang_Foreach_Context_Type *c) -{ - SLang_Assoc_Array_Type *a; - _SLAssoc_Array_Element_Type *e; - unsigned int i, j; - - (void) type; - - if (c == NULL) - return -1; - - a = c->a; - - i = c->this_hash_index; - if (i >= SLASSOC_HASH_TABLE_SIZE) - return 0; - - e = a->elements[i]; - - j = c->next_same_hash_index; - c->next_same_hash_index = j + 1; - - while ((j > 0) && (e != NULL)) - { - j--; - e = e->next; - } - - if (e == NULL) - { - do - { - i++; - if (i >= SLASSOC_HASH_TABLE_SIZE) - return 0; /* no more */ - } - while (a->elements [i] == NULL); - - e = a->elements[i]; - c->this_hash_index = i; - c->next_same_hash_index = 1; - } - - if ((c->flags & CTX_WRITE_KEYS) - && (-1 == SLang_push_string (e->key))) - return -1; - - if ((c->flags & CTX_WRITE_VALUES) - && (-1 == _SLpush_slang_obj (&e->value))) - return -1; - - /* keep going */ - return 1; -} - -int SLang_init_slassoc (void) -{ - SLang_Class_Type *cl; - - if (SLclass_is_class_defined (SLANG_ASSOC_TYPE)) - return 0; - - if (NULL == (cl = SLclass_allocate_class ("Assoc_Type"))) - return -1; - - (void) SLclass_set_destroy_function (cl, assoc_destroy); - (void) SLclass_set_aput_function (cl, assoc_aput); - (void) SLclass_set_aget_function (cl, assoc_aget); - (void) SLclass_set_anew_function (cl, assoc_anew); - cl->cl_length = assoc_length; - cl->cl_foreach_open = cl_foreach_open; - cl->cl_foreach_close = cl_foreach_close; - cl->cl_foreach = cl_foreach; - - if (-1 == SLclass_register_class (cl, SLANG_ASSOC_TYPE, sizeof (SLang_Assoc_Array_Type), SLANG_CLASS_TYPE_MMT)) - return -1; - - if (-1 == SLadd_intrin_fun_table (Assoc_Table, "__SLASSOC__")) - return -1; - - return 0; -} - diff --git a/mdk-stage1/slang/slbstr.c b/mdk-stage1/slang/slbstr.c deleted file mode 100644 index b4b8c4c51..000000000 --- a/mdk-stage1/slang/slbstr.c +++ /dev/null @@ -1,615 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -struct _SLang_BString_Type -{ - unsigned int num_refs; - unsigned int len; - int ptr_type; -#define IS_SLSTRING 1 -#define IS_MALLOCED 2 -#define IS_NOT_TO_BE_FREED 3 - union - { - unsigned char bytes[1]; - unsigned char *ptr; - } - v; -}; - -#define BS_GET_POINTER(b) ((b)->ptr_type ? (b)->v.ptr : (b)->v.bytes) - -static SLang_BString_Type *create_bstring_of_type (char *bytes, unsigned int len, int type) -{ - SLang_BString_Type *b; - unsigned int size; - - size = sizeof(SLang_BString_Type); - if (type == 0) - size += len; - - if (NULL == (b = (SLang_BString_Type *)SLmalloc (size))) - return NULL; - - b->len = len; - b->num_refs = 1; - b->ptr_type = type; - - switch (type) - { - case 0: - if (bytes != NULL) memcpy ((char *) b->v.bytes, bytes, len); - /* Now \0 terminate it because we want to also use it as a C string - * whenever possible. Note that sizeof(SLang_BString_Type) includes - * space for 1 character and we allocated len extra bytes. Thus, it is - * ok to add a \0 to the end. - */ - b->v.bytes[len] = 0; - break; - - case IS_SLSTRING: - if (NULL == (b->v.ptr = (unsigned char *)SLang_create_nslstring (bytes, len))) - { - SLfree ((char *) b); - return NULL; - } - break; - - case IS_MALLOCED: - case IS_NOT_TO_BE_FREED: - b->v.ptr = (unsigned char *)bytes; - bytes [len] = 0; /* NULL terminate */ - break; - } - - return b; -} - -SLang_BString_Type * -SLbstring_create (unsigned char *bytes, unsigned int len) -{ - return create_bstring_of_type ((char *)bytes, len, 0); -} - -/* Note that ptr must be len + 1 bytes long for \0 termination */ -SLang_BString_Type * -SLbstring_create_malloced (unsigned char *ptr, unsigned int len, int free_on_error) -{ - SLang_BString_Type *b; - - if (ptr == NULL) - return NULL; - - if (NULL == (b = create_bstring_of_type ((char *)ptr, len, IS_MALLOCED))) - { - if (free_on_error) - SLfree ((char *) ptr); - } - return b; -} - -SLang_BString_Type *SLbstring_create_slstring (char *s) -{ - if (s == NULL) - return NULL; - - return create_bstring_of_type (s, strlen (s), IS_SLSTRING); -} - -SLang_BString_Type *SLbstring_dup (SLang_BString_Type *b) -{ - if (b != NULL) - b->num_refs += 1; - - return b; -} - -unsigned char *SLbstring_get_pointer (SLang_BString_Type *b, unsigned int *len) -{ - if (b == NULL) - { - *len = 0; - return NULL; - } - *len = b->len; - return BS_GET_POINTER(b); -} - -void SLbstring_free (SLang_BString_Type *b) -{ - if (b == NULL) - return; - - if (b->num_refs > 1) - { - b->num_refs -= 1; - return; - } - - switch (b->ptr_type) - { - case 0: - case IS_NOT_TO_BE_FREED: - default: - break; - - case IS_SLSTRING: - SLang_free_slstring ((char *)b->v.ptr); - break; - - case IS_MALLOCED: - SLfree ((char *)b->v.ptr); - break; - } - - SLfree ((char *) b); -} - -int SLang_pop_bstring (SLang_BString_Type **b) -{ - return SLclass_pop_ptr_obj (SLANG_BSTRING_TYPE, (VOID_STAR *)b); -} - -int SLang_push_bstring (SLang_BString_Type *b) -{ - if (b == NULL) - return SLang_push_null (); - - b->num_refs += 1; - - if (0 == SLclass_push_ptr_obj (SLANG_BSTRING_TYPE, (VOID_STAR)b)) - return 0; - - b->num_refs -= 1; - return -1; -} - -static int -bstring_bstring_bin_op_result (int op, unsigned char a, unsigned char b, - unsigned char *c) -{ - (void) a; - (void) b; - switch (op) - { - default: - return 0; - - case SLANG_PLUS: - *c = SLANG_BSTRING_TYPE; - break; - - case SLANG_GT: - case SLANG_GE: - case SLANG_LT: - case SLANG_LE: - case SLANG_EQ: - case SLANG_NE: - *c = SLANG_CHAR_TYPE; - break; - } - return 1; -} - -static int compare_bstrings (SLang_BString_Type *a, SLang_BString_Type *b) -{ - unsigned int len; - int ret; - - len = a->len; - if (b->len < len) len = b->len; - - ret = memcmp ((char *)BS_GET_POINTER(b), (char *)BS_GET_POINTER(a), len); - if (ret != 0) - return ret; - - if (a->len > b->len) - return 1; - if (a->len == b->len) - return 0; - - return -1; -} - -static SLang_BString_Type * -concat_bstrings (SLang_BString_Type *a, SLang_BString_Type *b) -{ - unsigned int len; - SLang_BString_Type *c; - char *bytes; - - len = a->len + b->len; - - if (NULL == (c = SLbstring_create (NULL, len))) - return NULL; - - bytes = (char *)BS_GET_POINTER(c); - - memcpy (bytes, (char *)BS_GET_POINTER(a), a->len); - memcpy (bytes + a->len, (char *)BS_GET_POINTER(b), b->len); - - return c; -} - -static void free_n_bstrings (SLang_BString_Type **a, unsigned int n) -{ - unsigned int i; - - if (a == NULL) return; - - for (i = 0; i < n; i++) - { - SLbstring_free (a[i]); - a[i] = NULL; - } -} - -static int -bstring_bstring_bin_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - char *ic; - SLang_BString_Type **a, **b, **c; - unsigned int n, n_max; - unsigned int da, db; - - (void) a_type; - (void) b_type; - - if (na == 1) da = 0; else da = 1; - if (nb == 1) db = 0; else db = 1; - - if (na > nb) n_max = na; else n_max = nb; - - a = (SLang_BString_Type **) ap; - b = (SLang_BString_Type **) bp; - for (n = 0; n < n_max; n++) - { - if ((*a == NULL) || (*b == NULL)) - { - SLang_verror (SL_VARIABLE_UNINITIALIZED, - "Binary string element[%u] not initialized for binary operation", n); - return -1; - } - a += da; b += db; - } - - a = (SLang_BString_Type **) ap; - b = (SLang_BString_Type **) bp; - ic = (char *) cp; - c = NULL; - - switch (op) - { - case SLANG_PLUS: - /* Concat */ - c = (SLang_BString_Type **) cp; - for (n = 0; n < n_max; n++) - { - if (NULL == (c[n] = concat_bstrings (*a, *b))) - goto return_error; - - a += da; b += db; - } - break; - - case SLANG_NE: - for (n = 0; n < n_max; n++) - { - ic [n] = (0 != compare_bstrings (*a, *b)); - a += da; - b += db; - } - break; - case SLANG_GT: - for (n = 0; n < n_max; n++) - { - ic [n] = (compare_bstrings (*a, *b) > 0); - a += da; - b += db; - } - break; - case SLANG_GE: - for (n = 0; n < n_max; n++) - { - ic [n] = (compare_bstrings (*a, *b) >= 0); - a += da; - b += db; - } - break; - case SLANG_LT: - for (n = 0; n < n_max; n++) - { - ic [n] = (compare_bstrings (*a, *b) < 0); - a += da; - b += db; - } - break; - case SLANG_LE: - for (n = 0; n < n_max; n++) - { - ic [n] = (compare_bstrings (*a, *b) <= 0); - a += da; - b += db; - } - break; - case SLANG_EQ: - for (n = 0; n < n_max; n++) - { - ic [n] = (compare_bstrings (*a, *b) == 0); - a += da; - b += db; - } - break; - } - return 1; - - return_error: - if (c != NULL) - { - free_n_bstrings (c, n); - while (n < n_max) - { - c[n] = NULL; - n++; - } - } - return -1; -} - -/* If preserve_ptr, then use a[i] as the bstring data. See how this function - * is called by the binary op routines for why. - */ -static SLang_BString_Type ** -make_n_bstrings (SLang_BString_Type **b, char **a, unsigned int n, int ptr_type) -{ - unsigned int i; - int malloc_flag; - - malloc_flag = 0; - if (b == NULL) - { - b = (SLang_BString_Type **) SLmalloc ((n + 1) * sizeof (SLang_BString_Type *)); - if (b == NULL) - return NULL; - malloc_flag = 1; - } - - for (i = 0; i < n; i++) - { - char *s = a[i]; - - if (s == NULL) - { - b[i] = NULL; - continue; - } - - if (NULL == (b[i] = create_bstring_of_type (s, strlen(s), ptr_type))) - { - free_n_bstrings (b, i); - if (malloc_flag) SLfree ((char *) b); - return NULL; - } - } - - return b; -} - -static int -bstring_string_bin_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - SLang_BString_Type **b; - int ret; - - if (NULL == (b = make_n_bstrings (NULL, (char **)bp, nb, IS_NOT_TO_BE_FREED))) - return -1; - - b_type = SLANG_BSTRING_TYPE; - ret = bstring_bstring_bin_op (op, - a_type, ap, na, - b_type, (VOID_STAR) b, nb, - cp); - free_n_bstrings (b, nb); - SLfree ((char *) b); - return ret; -} - -static int -string_bstring_bin_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - SLang_BString_Type **a; - int ret; - - if (NULL == (a = make_n_bstrings (NULL, (char **)ap, na, IS_NOT_TO_BE_FREED))) - return -1; - - a_type = SLANG_BSTRING_TYPE; - ret = bstring_bstring_bin_op (op, - a_type, (VOID_STAR) a, na, - b_type, bp, nb, - cp); - free_n_bstrings (a, na); - SLfree ((char *) a); - - return ret; -} - -static void bstring_destroy (unsigned char unused, VOID_STAR s) -{ - (void) unused; - SLbstring_free (*(SLang_BString_Type **) s); -} - -static int bstring_push (unsigned char unused, VOID_STAR sptr) -{ - (void) unused; - - return SLang_push_bstring (*(SLang_BString_Type **) sptr); -} - -static int string_to_bstring (unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp) -{ - char **s; - SLang_BString_Type **b; - - (void) a_type; - (void) b_type; - - s = (char **) ap; - b = (SLang_BString_Type **) bp; - - if (NULL == make_n_bstrings (b, s, na, IS_SLSTRING)) - return -1; - - return 1; -} - -static int bstring_to_string (unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp) -{ - char **s; - unsigned int i; - SLang_BString_Type **a; - - (void) a_type; - (void) b_type; - - s = (char **) bp; - a = (SLang_BString_Type **) ap; - - for (i = 0; i < na; i++) - { - SLang_BString_Type *ai = a[i]; - - if (ai == NULL) - { - s[i] = NULL; - continue; - } - - if (NULL == (s[i] = SLang_create_slstring ((char *)BS_GET_POINTER(ai)))) - { - while (i != 0) - { - i--; - SLang_free_slstring (s[i]); - s[i] = NULL; - } - return -1; - } - } - - return 1; -} - -static char *bstring_string (unsigned char type, VOID_STAR v) -{ - SLang_BString_Type *s; - unsigned char buf[128]; - unsigned char *bytes, *bytes_max; - unsigned char *b, *bmax; - - (void) type; - - s = *(SLang_BString_Type **) v; - bytes = BS_GET_POINTER(s); - bytes_max = bytes + s->len; - - b = buf; - bmax = buf + (sizeof (buf) - 4); - - while (bytes < bytes_max) - { - unsigned char ch = *bytes; - - if ((ch < 32) || (ch >= 127) || (ch == '\\')) - { - if (b + 4 > bmax) - break; - - sprintf ((char *) b, "\\%03o", ch); - b += 4; - } - else - { - if (b == bmax) - break; - - *b++ = ch; - } - - bytes++; - } - - if (bytes < bytes_max) - { - *b++ = '.'; - *b++ = '.'; - *b++ = '.'; - } - *b = 0; - - return SLmake_string ((char *)buf); -} - -static unsigned int bstrlen_cmd (SLang_BString_Type *b) -{ - return b->len; -} - -static SLang_Intrin_Fun_Type BString_Table [] = /*{{{*/ -{ - MAKE_INTRINSIC_1("bstrlen", bstrlen_cmd, SLANG_UINT_TYPE, SLANG_BSTRING_TYPE), - MAKE_INTRINSIC_0("pack", _SLpack, SLANG_VOID_TYPE), - MAKE_INTRINSIC_2("unpack", _SLunpack, SLANG_VOID_TYPE, SLANG_STRING_TYPE, SLANG_BSTRING_TYPE), - MAKE_INTRINSIC_1("pad_pack_format", _SLpack_pad_format, SLANG_VOID_TYPE, SLANG_STRING_TYPE), - MAKE_INTRINSIC_1("sizeof_pack", _SLpack_compute_size, SLANG_UINT_TYPE, SLANG_STRING_TYPE), - SLANG_END_INTRIN_FUN_TABLE -}; - -int _SLang_init_bstring (void) -{ - SLang_Class_Type *cl; - - if (NULL == (cl = SLclass_allocate_class ("BString_Type"))) - return -1; - (void) SLclass_set_destroy_function (cl, bstring_destroy); - (void) SLclass_set_push_function (cl, bstring_push); - (void) SLclass_set_string_function (cl, bstring_string); - - if (-1 == SLclass_register_class (cl, SLANG_BSTRING_TYPE, sizeof (char *), - SLANG_CLASS_TYPE_PTR)) - return -1; - - if ((-1 == SLclass_add_typecast (SLANG_BSTRING_TYPE, SLANG_STRING_TYPE, bstring_to_string, 1)) - || (-1 == SLclass_add_typecast (SLANG_STRING_TYPE, SLANG_BSTRING_TYPE, string_to_bstring, 1)) - || (-1 == SLclass_add_binary_op (SLANG_BSTRING_TYPE, SLANG_BSTRING_TYPE, bstring_bstring_bin_op, bstring_bstring_bin_op_result)) - || (-1 == SLclass_add_binary_op (SLANG_STRING_TYPE, SLANG_BSTRING_TYPE, string_bstring_bin_op, bstring_bstring_bin_op_result)) - || (-1 == SLclass_add_binary_op (SLANG_BSTRING_TYPE, SLANG_STRING_TYPE, bstring_string_bin_op, bstring_bstring_bin_op_result))) - - return -1; - - if (-1 == SLadd_intrin_fun_table (BString_Table, NULL)) - return -1; - - return 0; -} - diff --git a/mdk-stage1/slang/slclass.c b/mdk-stage1/slang/slclass.c deleted file mode 100644 index 733888cb8..000000000 --- a/mdk-stage1/slang/slclass.c +++ /dev/null @@ -1,1391 +0,0 @@ -/* User defined objects */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -#if _SLANG_OPTIMIZE_FOR_SPEED -unsigned char _SLclass_Class_Type [256]; -#endif - -static SLang_Class_Type *Registered_Types[256]; -SLang_Class_Type *_SLclass_get_class (unsigned char type) -{ - SLang_Class_Type *cl; - - cl = Registered_Types [type]; - if (cl == NULL) - SLang_exit_error ("Application error: Type %d not registered", (int) type); - - return cl; -} - -int SLclass_is_class_defined (unsigned char type) -{ - return (NULL != Registered_Types[type]); -} - -VOID_STAR _SLclass_get_ptr_to_value (SLang_Class_Type *cl, - SLang_Object_Type *obj) -{ - VOID_STAR p; - - switch (cl->cl_class_type) - { - case SLANG_CLASS_TYPE_MMT: - case SLANG_CLASS_TYPE_PTR: - case SLANG_CLASS_TYPE_SCALAR: - p = (VOID_STAR) &obj->v; - break; - - case SLANG_CLASS_TYPE_VECTOR: - p = obj->v.ptr_val; - break; - - default: - p = NULL; - } - return p; -} - -char *SLclass_get_datatype_name (unsigned char stype) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (stype); - return cl->cl_name; -} - -static int method_undefined_error (unsigned char type, char *method, char *name) -{ - if (name == NULL) name = SLclass_get_datatype_name (type); - - SLang_verror (SL_TYPE_MISMATCH, "%s method not defined for %s", - method, name); - return -1; -} - -static int -scalar_vector_bin_op_result (int op, unsigned char a, unsigned char b, - unsigned char *c) -{ - (void) a; (void) b; - switch (op) - { - case SLANG_NE: - case SLANG_EQ: - *c = SLANG_INT_TYPE; - return 1; - } - return 0; -} - -static int -scalar_vector_bin_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - int *c; - char *a, *b; - unsigned int da, db; - unsigned int n, n_max; - unsigned int data_type_len; - SLang_Class_Type *cl; - - (void) b_type; - cl = _SLclass_get_class (a_type); - - data_type_len = cl->cl_sizeof_type; - - a = (char *) ap; - b = (char *) bp; - c = (int *) cp; - - if (na == 1) da = 0; else da = data_type_len; - if (nb == 1) db = 0; else db = data_type_len; - if (na > nb) n_max = na; else n_max = nb; - - switch (op) - { - default: - return 0; - - case SLANG_NE: - for (n = 0; n < n_max; n++) - { - c[n] = (0 != SLMEMCMP(a, b, data_type_len)); - a += da; b += db; - } - break; - - case SLANG_EQ: - for (n = 0; n < n_max; n++) - { - c[n] = (0 == SLMEMCMP(a, b, data_type_len)); - a += da; b += db; - } - break; - } - return 1; -} - -static int scalar_fread (unsigned char type, FILE *fp, VOID_STAR ptr, - unsigned int desired, unsigned int *actual) -{ - unsigned int n; - - n = fread ((char *) ptr, _SLclass_get_class (type)->cl_sizeof_type, - desired, fp); - *actual = n; - return 0; -} - -static int scalar_fwrite (unsigned char type, FILE *fp, VOID_STAR ptr, - unsigned int desired, unsigned int *actual) -{ - unsigned int n; - - n = fwrite ((char *) ptr, _SLclass_get_class (type)->cl_sizeof_type, - desired, fp); - *actual = n; - return 0; -} - -static int vector_apush (unsigned char type, VOID_STAR ptr) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - return (*cl->cl_push)(type, (VOID_STAR) &ptr); -} - -static int vector_apop (unsigned char type, VOID_STAR ptr) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - return (*cl->cl_pop)(type, (VOID_STAR) &ptr); -} - -static int default_push_mmt (unsigned char type_unused, VOID_STAR ptr) -{ - SLang_MMT_Type *ref; - - (void) type_unused; - ref = *(SLang_MMT_Type **) ptr; - return SLang_push_mmt (ref); -} - -static void default_destroy_simple (unsigned char type_unused, VOID_STAR ptr_unused) -{ - (void) type_unused; - (void) ptr_unused; -} - -static void default_destroy_user (unsigned char type, VOID_STAR ptr) -{ - (void) type; - SLang_free_mmt (*(SLang_MMT_Type **) ptr); -} - -static int default_pop (unsigned char type, VOID_STAR ptr) -{ - return SLclass_pop_ptr_obj (type, (VOID_STAR *) ptr); -} - -static int default_datatype_deref (unsigned char type) -{ - return method_undefined_error (type, "datatype_deref", NULL); -} - -static int default_acopy (unsigned char type, VOID_STAR from, VOID_STAR to) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - if (-1 == (*cl->cl_apush) (type, from)) - return -1; - return (*cl->cl_apop) (type, to); -} - -static int default_dereference_object (unsigned char type, VOID_STAR ptr) -{ - (void) ptr; - return method_undefined_error (type, "dereference", NULL); -} - -static char *default_string (unsigned char stype, VOID_STAR v) -{ - char buf [256]; - char *s; -#if SLANG_HAS_COMPLEX - double *cplx; -#endif - s = buf; - - switch (stype) - { - case SLANG_STRING_TYPE: - s = *(char **) v; - break; - - case SLANG_NULL_TYPE: - s = "NULL"; - break; - - case SLANG_DATATYPE_TYPE: - s = SLclass_get_datatype_name ((unsigned char) *(int *)v); - break; - -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - cplx = *(double **) v; - if (cplx[1] < 0) - sprintf (s, "(%g - %gi)", cplx [0], -cplx [1]); - else - sprintf (s, "(%g + %gi)", cplx [0], cplx [1]); - break; -#endif - default: - s = SLclass_get_datatype_name (stype); - } - - return SLmake_string (s); -} - -static int -use_cmp_bin_op_result (int op, unsigned char a, unsigned char b, - unsigned char *c) -{ - if (a != b) - return 0; - switch (op) - { - case SLANG_NE: - case SLANG_EQ: - case SLANG_LT: - case SLANG_LE: - case SLANG_GT: - case SLANG_GE: - *c = SLANG_INT_TYPE; - return 1; - } - return 0; -} - -static int -use_cmp_bin_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - int *c; - char *a, *b; - unsigned int da, db; - unsigned int n, n_max; - unsigned int data_type_len; - SLang_Class_Type *cl; - int (*cmp)(unsigned char, VOID_STAR, VOID_STAR, int *); - - (void) b_type; - cl = _SLclass_get_class (a_type); - cmp = cl->cl_cmp; - data_type_len = cl->cl_sizeof_type; - - a = (char *) ap; - b = (char *) bp; - c = (int *) cp; - - if (na == 1) da = 0; else da = data_type_len; - if (nb == 1) db = 0; else db = data_type_len; - if (na > nb) n_max = na; else n_max = nb; - - switch (op) - { - int result; - - default: - return 0; - - case SLANG_NE: - for (n = 0; n < n_max; n++) - { - if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result)) - return -1; - c[n] = (result != 0); - a += da; b += db; - } - break; - - case SLANG_EQ: - for (n = 0; n < n_max; n++) - { - if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result)) - return -1; - c[n] = (result == 0); - a += da; b += db; - } - break; - - case SLANG_GT: - for (n = 0; n < n_max; n++) - { - if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result)) - return -1; - c[n] = (result > 0); - a += da; b += db; - } - break; - case SLANG_GE: - for (n = 0; n < n_max; n++) - { - if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result)) - return -1; - c[n] = (result >= 0); - a += da; b += db; - } - break; - case SLANG_LT: - for (n = 0; n < n_max; n++) - { - if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result)) - return -1; - c[n] = (result < 0); - a += da; b += db; - } - break; - case SLANG_LE: - for (n = 0; n < n_max; n++) - { - if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result)) - return -1; - c[n] = (result <= 0); - a += da; b += db; - } - break; - } - return 1; -} - - -int SLclass_get_class_id (SLang_Class_Type *cl) -{ - if (cl == NULL) - return -1; - return (int) cl->cl_data_type; -} - -SLang_Class_Type *SLclass_allocate_class (char *name) -{ - SLang_Class_Type *cl; - unsigned int i; - - for (i = 0; i < 256; i++) - { - cl = Registered_Types [i]; - if ((cl != NULL) - && (0 == strcmp (cl->cl_name, name))) - { - SLang_verror (SL_DUPLICATE_DEFINITION, "Type name %s already exists", name); - return NULL; - } - } - - cl = (SLang_Class_Type *) SLmalloc (sizeof (SLang_Class_Type)); - if (cl == NULL) return NULL; - - SLMEMSET ((char *) cl, 0, sizeof (SLang_Class_Type)); - - if (NULL == (cl->cl_name = SLang_create_slstring (name))) - { - SLfree ((char *) cl); - return NULL; - } - - return cl; -} - -static int DataType_Ids [256]; - -int _SLang_push_datatype (unsigned char data_type) -{ - /* This data type could be a copy of another type, e.g., short and - * int if they are the same size (Int16 == Short). So, make sure - * we push the original and not the copy. - */ - data_type = _SLclass_get_class (data_type)->cl_data_type; - return SLclass_push_int_obj (SLANG_DATATYPE_TYPE, (int) data_type); -} - -static int datatype_deref (unsigned char type, VOID_STAR ptr) -{ - SLang_Class_Type *cl; - int status; - - /* The parser generated code for this as if a function call were to be - * made. However, we are calling the deref object routine - * instead of the function call. So, I must simulate the function call. - */ - if (-1 == _SL_increment_frame_pointer ()) - return -1; - - type = (unsigned char) *(int *) ptr; - cl = _SLclass_get_class (type); - status = (*cl->cl_datatype_deref) (type); - - (void) _SL_decrement_frame_pointer (); - return status; -} - -static int datatype_push (unsigned char type_unused, VOID_STAR ptr) -{ - (void) type_unused; - return _SLang_push_datatype (*(int *) ptr); -} - -int _SLang_pop_datatype (unsigned char *type) -{ - int i; - - if (-1 == SLclass_pop_int_obj (SLANG_DATATYPE_TYPE, &i)) - return -1; - - *type = (unsigned char) i; - return 0; -} - -static int datatype_pop (unsigned char type, VOID_STAR ptr) -{ - if (-1 == _SLang_pop_datatype (&type)) - return -1; - - *(int *) ptr = type; - return 0; -} - -int _SLclass_init (void) -{ - SLang_Class_Type *cl; - - /* First initialize the container classes. This is so binary operations - * added later will work with them. - */ - if (-1 == _SLarray_init_slarray ()) - return -1; - - /* DataType_Type */ - if (NULL == (cl = SLclass_allocate_class ("DataType_Type"))) - return -1; - cl->cl_pop = datatype_pop; - cl->cl_push = datatype_push; - cl->cl_dereference = datatype_deref; - if (-1 == SLclass_register_class (cl, SLANG_DATATYPE_TYPE, sizeof(int), - SLANG_CLASS_TYPE_SCALAR)) - return -1; - - return 0; -} - -static int register_new_datatype (char *name, unsigned char type) -{ - DataType_Ids [type] = type; - return SLadd_intrinsic_variable (name, (VOID_STAR) (DataType_Ids + type), - SLANG_DATATYPE_TYPE, 1); -} - -int SLclass_create_synonym (char *name, unsigned char type) -{ - if (NULL == _SLclass_get_class (type)) - return -1; - - return register_new_datatype (name, type); -} - -int _SLclass_copy_class (unsigned char to, unsigned char from) -{ - SLang_Class_Type *cl = _SLclass_get_class (from); - - if (Registered_Types[to] != NULL) - SLang_exit_error ("Application error: Class already exists"); - - Registered_Types[to] = cl; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (to != SLANG_UNDEFINED_TYPE) - _SLclass_Class_Type [to] = cl->cl_class_type; -#endif - return 0; -} - -int SLclass_register_class (SLang_Class_Type *cl, unsigned char type, unsigned int type_size, unsigned char class_type) -{ - char *name; - unsigned int i; - int can_binop = 1; /* scalar_vector_bin_op should work - * for all data types. - */ - - if (type == SLANG_VOID_TYPE) for (i = 0; i < 256; i++) - { - if ((Registered_Types[i] == NULL) - && (i != SLANG_VOID_TYPE)) - { - type = (unsigned char) i; - break; - } - } - - if ((NULL != Registered_Types [type]) - || (type == SLANG_VOID_TYPE)) - { - SLang_verror (SL_APPLICATION_ERROR, "Class type %d already in use", (int) type); - return -1; - } - - cl->cl_data_type = type; - cl->cl_class_type = class_type; - name = cl->cl_name; - - switch (class_type) - { - case SLANG_CLASS_TYPE_MMT: - if (cl->cl_push == NULL) cl->cl_push = default_push_mmt; - if (cl->cl_destroy == NULL) - return method_undefined_error (type, "destroy", name); - cl->cl_user_destroy_fun = cl->cl_destroy; - cl->cl_destroy = default_destroy_user; - type_size = sizeof (VOID_STAR); - break; - - case SLANG_CLASS_TYPE_SCALAR: - if (cl->cl_destroy == NULL) cl->cl_destroy = default_destroy_simple; - if ((type_size == 0) - || (type_size > sizeof (_SL_Object_Union_Type))) - { - SLang_verror (SL_INVALID_PARM, - "Type size for %s not appropriate for SCALAR type", - name); - return -1; - } - if (cl->cl_pop == NULL) - return method_undefined_error (type, "pop", name); - if (cl->cl_fread == NULL) cl->cl_fread = scalar_fread; - if (cl->cl_fwrite == NULL) cl->cl_fwrite = scalar_fwrite; - - can_binop = 1; - break; - - case SLANG_CLASS_TYPE_PTR: - if (cl->cl_destroy == NULL) - return method_undefined_error (type, "destroy", name); - type_size = sizeof (VOID_STAR); - break; - - case SLANG_CLASS_TYPE_VECTOR: - if (cl->cl_destroy == NULL) - return method_undefined_error (type, "destroy", name); - if (cl->cl_pop == NULL) - return method_undefined_error (type, "pop", name); - cl->cl_apop = vector_apop; - cl->cl_apush = vector_apush; - cl->cl_adestroy = default_destroy_simple; - if (cl->cl_fread == NULL) cl->cl_fread = scalar_fread; - if (cl->cl_fwrite == NULL) cl->cl_fwrite = scalar_fwrite; - can_binop = 1; - break; - - default: - SLang_verror (SL_INVALID_PARM, "%s: unknown class type (%d)", name, class_type); - return -1; - } - -#if _SLANG_OPTIMIZE_FOR_SPEED - if (type != SLANG_UNDEFINED_TYPE) - _SLclass_Class_Type [type] = class_type; -#endif - - if (type_size == 0) - { - SLang_verror (SL_INVALID_PARM, "type size must be non-zero for %s", name); - return -1; - } - - if (cl->cl_string == NULL) cl->cl_string = default_string; - if (cl->cl_acopy == NULL) cl->cl_acopy = default_acopy; - if (cl->cl_datatype_deref == NULL) cl->cl_datatype_deref = default_datatype_deref; - - if (cl->cl_pop == NULL) cl->cl_pop = default_pop; - - if (cl->cl_push == NULL) - return method_undefined_error (type, "push", name); - - if (cl->cl_byte_code_destroy == NULL) - cl->cl_byte_code_destroy = cl->cl_destroy; - if (cl->cl_push_literal == NULL) - cl->cl_push_literal = cl->cl_push; - - if (cl->cl_dereference == NULL) - cl->cl_dereference = default_dereference_object; - - if (cl->cl_apop == NULL) cl->cl_apop = cl->cl_pop; - if (cl->cl_apush == NULL) cl->cl_apush = cl->cl_push; - if (cl->cl_adestroy == NULL) cl->cl_adestroy = cl->cl_destroy; - if (cl->cl_push_intrinsic == NULL) cl->cl_push_intrinsic = cl->cl_push; - - if ((cl->cl_foreach == NULL) - || (cl->cl_foreach_open == NULL) - || (cl->cl_foreach_close == NULL)) - { - cl->cl_foreach = _SLarray_cl_foreach; - cl->cl_foreach_open = _SLarray_cl_foreach_open; - cl->cl_foreach_close = _SLarray_cl_foreach_close; - } - - cl->cl_sizeof_type = type_size; - - if (NULL == (cl->cl_transfer_buf = (VOID_STAR) SLmalloc (type_size))) - return -1; - - Registered_Types[type] = cl; - - if (-1 == register_new_datatype (name, type)) - return -1; - - if (cl->cl_cmp != NULL) - { - if (-1 == SLclass_add_binary_op (type, type, use_cmp_bin_op, use_cmp_bin_op_result)) - return -1; - } - else if (can_binop - && (-1 == SLclass_add_binary_op (type, type, scalar_vector_bin_op, scalar_vector_bin_op_result))) - return -1; - - cl->cl_anytype_typecast = _SLanytype_typecast; - - return 0; -} - -int SLclass_add_math_op (unsigned char type, - int (*handler)(int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*result) (int, unsigned char, unsigned char *)) -{ - SLang_Class_Type *cl = _SLclass_get_class (type); - - cl->cl_math_op = handler; - cl->cl_math_op_result_type = result; - return 0; -} - -int SLclass_add_binary_op (unsigned char a, unsigned char b, - int (*f) (int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*r) (int, unsigned char, unsigned char, unsigned char *)) -{ - SLang_Class_Type *cl; - SL_OOBinary_Type *ab; - - if ((f == NULL) || (r == NULL)) - { - SLang_verror (SL_INVALID_PARM, "SLclass_add_binary_op"); - return -1; - } - - cl = _SLclass_get_class (a); - (void) _SLclass_get_class (b); - - if (NULL == (ab = (SL_OOBinary_Type *) SLmalloc (sizeof(SL_OOBinary_Type)))) - return -1; - - ab->data_type = b; - ab->binary_function = f; - ab->binary_result = r; - ab->next = cl->cl_binary_ops; - cl->cl_binary_ops = ab; - - if ((a != SLANG_ARRAY_TYPE) - && (b != SLANG_ARRAY_TYPE)) - { - if ((-1 == _SLarray_add_bin_op (a)) - || (-1 == _SLarray_add_bin_op (b))) - return -1; - } - - return 0; -} - -int SLclass_add_unary_op (unsigned char type, - int (*f)(int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*r)(int, unsigned char, unsigned char *)) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - if ((f == NULL) || (r == NULL)) - { - SLang_verror (SL_INVALID_PARM, "SLclass_add_unary_op"); - return -1; - } - - cl->cl_unary_op = f; - cl->cl_unary_op_result_type = r; - - return 0; -} - -int SLclass_add_app_unary_op (unsigned char type, - int (*f)(int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR), - int (*r)(int, unsigned char, unsigned char *)) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - if ((f == NULL) || (r == NULL)) - { - SLang_verror (SL_INVALID_PARM, "SLclass_add_app_unary_op"); - return -1; - } - - cl->cl_app_unary_op = f; - cl->cl_app_unary_op_result_type = r; - - return 0; -} - -int SLclass_set_pop_function (SLang_Class_Type *cl, int (*f)(unsigned char, VOID_STAR)) -{ - if (cl == NULL) return -1; - cl->cl_pop = f; - - return 0; -} - -int SLclass_set_push_function (SLang_Class_Type *cl, int (*f)(unsigned char, VOID_STAR)) -{ - if (cl == NULL) return -1; - cl->cl_push = f; - - return 0; -} - -int SLclass_set_string_function (SLang_Class_Type *cl, char *(*f)(unsigned char, VOID_STAR)) -{ - if (cl == NULL) return -1; - - cl->cl_string = f; - return 0; -} - -int SLclass_set_destroy_function (SLang_Class_Type *cl, void (*f)(unsigned char, VOID_STAR)) -{ - if (cl == NULL) return -1; - - cl->cl_destroy = f; - return 0; -} - -int SLclass_set_sget_function (SLang_Class_Type *cl, int (*f)(unsigned char, char *)) -{ - if (cl == NULL) return -1; - cl->cl_sget = f; - return 0; -} - -int SLclass_set_sput_function (SLang_Class_Type *cl, int (*f)(unsigned char, char *)) -{ - if (cl == NULL) return -1; - cl->cl_sput = f; - return 0; -} - -int SLclass_set_aget_function (SLang_Class_Type *cl, int (*f)(unsigned char, unsigned int)) -{ - if (cl == NULL) return -1; - cl->cl_aget = f; - return 0; -} - -int SLclass_set_aput_function (SLang_Class_Type *cl, int (*f)(unsigned char, unsigned int)) -{ - if (cl == NULL) return -1; - cl->cl_aput = f; - return 0; -} - -int SLclass_set_anew_function (SLang_Class_Type *cl, int (*f)(unsigned char, unsigned int)) -{ - if (cl == NULL) return -1; - cl->cl_anew = f; - return 0; -} - -/* Misc */ -void _SLclass_type_mismatch_error (unsigned char a, unsigned char b) -{ - SLang_verror (SL_TYPE_MISMATCH, "Expecting %s, found %s", - SLclass_get_datatype_name (a), - SLclass_get_datatype_name (b)); -} - -/* */ - -static int null_binary_fun (int op, - unsigned char a, VOID_STAR ap, unsigned int na, - unsigned char b, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - int *ic; - unsigned int i; - int c; - - (void) ap; (void) bp; - - switch (op) - { - case SLANG_EQ: - c = (a == b); - break; - - case SLANG_NE: - c = (a != b); - break; - - default: - return 0; - } - - if (na > nb) nb = na; - ic = (int *) cp; - for (i = 0; i < nb; i++) - ic[i] = c; - - return 1; -} - -static char *get_binary_op_string (int op) -{ - static char *ops[SLANG_MOD] = - { - "+", "=", "*", "/", "==", "!=", ">", ">=", "<", "<=", "^", - "or", "and", "&", "|", "xor", "shl", "shr", "mod" - }; - - if ((op > SLANG_MOD) || (op <= 0)) - return "??"; - return ops[op - 1]; -} - -int (*_SLclass_get_binary_fun (int op, - SLang_Class_Type *a_cl, SLang_Class_Type *b_cl, - SLang_Class_Type **c_cl, int do_error)) -(int, - unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR, unsigned int, - VOID_STAR) -{ - SL_OOBinary_Type *bt; - unsigned char a, b, c; - - a = a_cl->cl_data_type; - b = b_cl->cl_data_type; - - if ((a == SLANG_NULL_TYPE) || (b == SLANG_NULL_TYPE)) - { - *c_cl = _SLclass_get_class (SLANG_INT_TYPE); - return null_binary_fun; - } - - bt = a_cl->cl_binary_ops; - - while (bt != NULL) - { - if (bt->data_type == b) - { - if (1 != (*bt->binary_result)(op, a, b, &c)) - break; - - if (c == a) *c_cl = a_cl; - else if (c == b) *c_cl = b_cl; - else *c_cl = _SLclass_get_class (c); - - return bt->binary_function; - } - - bt = bt->next; - } - - if (do_error) - SLang_verror (SL_TYPE_MISMATCH, "%s %s %s is not possible", - a_cl->cl_name, get_binary_op_string (op), b_cl->cl_name); - - *c_cl = NULL; - return NULL; -} - -int (*_SLclass_get_unary_fun (int op, - SLang_Class_Type *a_cl, - SLang_Class_Type **b_cl, - int utype)) -(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR) -{ - int (*f)(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR); - int (*r)(int, unsigned char, unsigned char *); - unsigned char a; - unsigned char b; - - switch (utype) - { - case _SLANG_BC_UNARY: - f = a_cl->cl_unary_op; - r = a_cl->cl_unary_op_result_type; - break; - - case _SLANG_BC_MATH_UNARY: - f = a_cl->cl_math_op; - r = a_cl->cl_math_op_result_type; - break; - - case _SLANG_BC_APP_UNARY: - f = a_cl->cl_app_unary_op; - r = a_cl->cl_app_unary_op_result_type; - break; - - default: - f = NULL; - r = NULL; - } - - a = a_cl->cl_data_type; - if ((f != NULL) && (r != NULL) && (1 == (*r) (op, a, &b))) - { - if (a == b) - *b_cl = a_cl; - else - *b_cl = _SLclass_get_class (b); - return f; - } - - SLang_verror (SL_TYPE_MISMATCH, "undefined unary operation/function on %s", - a_cl->cl_name); - - *b_cl = NULL; - - return NULL; -} - -int -SLclass_typecast (unsigned char to_type, int is_implicit, int allow_array) -{ - unsigned char from_type; - SLang_Class_Type *cl_to, *cl_from; - SLang_Object_Type obj; - VOID_STAR ap; - VOID_STAR bp; - int status; - - if (-1 == SLang_pop (&obj)) - return -1; - - from_type = obj.data_type; - if (from_type == to_type) - { - SLang_push (&obj); - return 0; - } - - cl_from = _SLclass_get_class (from_type); - - /* Since the typecast functions are designed to work on arrays, - * get the pointer to the value instead of just &obj.v. - */ - ap = _SLclass_get_ptr_to_value (cl_from, &obj); - - if ((from_type == SLANG_ARRAY_TYPE) - && (allow_array || (to_type != SLANG_ANY_TYPE))) - { - if (allow_array == 0) - goto return_error; - - cl_to = _SLclass_get_class (SLANG_ARRAY_TYPE); - bp = cl_to->cl_transfer_buf; - status = _SLarray_typecast (from_type, ap, 1, to_type, bp, is_implicit); - } - else - { - int (*t) (unsigned char, VOID_STAR, unsigned int, unsigned char, VOID_STAR); - - if (NULL == (t = _SLclass_get_typecast (from_type, to_type, is_implicit))) - { - SLang_free_object (&obj); - return -1; - } - - cl_to = _SLclass_get_class (to_type); - bp = cl_to->cl_transfer_buf; - status = (*t) (from_type, ap, 1, to_type, bp); - } - - if (1 == status) - { - if (-1 == (*cl_to->cl_apush)(to_type, bp)) - { - (*cl_to->cl_adestroy) (to_type, bp); - SLang_free_object (&obj); - return -1; - } - - /* cl_apush will push a copy, so destry this one */ - (*cl_to->cl_adestroy) (to_type, bp); - SLang_free_object (&obj); - return 0; - } - - return_error: - - SLang_verror (SL_TYPE_MISMATCH, "Unable to typecast %s to %s", - cl_from->cl_name, - SLclass_get_datatype_name (to_type)); - SLang_free_object (&obj); - return -1; -} - -int (*_SLclass_get_typecast (unsigned char from, unsigned char to, int is_implicit)) -(unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR) -{ - SL_Typecast_Type *t; - SLang_Class_Type *cl_from; - - cl_from = _SLclass_get_class (from); - - t = cl_from->cl_typecast_funs; - while (t != NULL) - { - if (t->data_type != to) - { - t = t->next; - continue; - } - - if (is_implicit && (t->allow_implicit == 0)) - break; - - return t->typecast; - } - - if (to == SLANG_ANY_TYPE) - return _SLanytype_typecast; - - if ((is_implicit == 0) - && (cl_from->cl_void_typecast != NULL)) - return cl_from->cl_void_typecast; - - SLang_verror (SL_TYPE_MISMATCH, "Unable to typecast %s to %s", - cl_from->cl_name, - SLclass_get_datatype_name (to)); - - return NULL; -} - -int -SLclass_add_typecast (unsigned char from, unsigned char to, - int (*f)_PROTO((unsigned char, VOID_STAR, unsigned int, - unsigned char, VOID_STAR)), - int allow_implicit) -{ - SL_Typecast_Type *t; - SLang_Class_Type *cl; - - cl = _SLclass_get_class (from); - if (to == SLANG_VOID_TYPE) - { - cl->cl_void_typecast = f; - return 0; - } - - (void) _SLclass_get_class (to); - - if (NULL == (t = (SL_Typecast_Type *) SLmalloc (sizeof (SL_Typecast_Type)))) - return -1; - - SLMEMSET((char *) t, 0, sizeof(SL_Typecast_Type)); - t->data_type = to; - t->next = cl->cl_typecast_funs; - t->typecast = f; - t->allow_implicit = allow_implicit; - - cl->cl_typecast_funs = t; - - return 0; -} - -SLang_MMT_Type *SLang_pop_mmt (unsigned char type) /*{{{*/ -{ - SLang_MMT_Type *mmt; - - if (-1 == SLclass_pop_ptr_obj (type, (VOID_STAR *) &mmt)) - mmt = NULL; - return mmt; - -#if 0 - SLang_Object_Type obj; - SLang_Class_Type *cl; - - if (_SLang_pop_object_of_type (type, &obj)) - return NULL; - - cl = _SLclass_get_class (type); - if ((cl->cl_class_type == SLANG_CLASS_TYPE_MMT) - && (obj.data_type == type)) - { - return obj.v.ref; - } - - _SLclass_type_mismatch_error (type, obj.data_type); - SLang_free_object (&obj); - return NULL; -#endif -} - -/*}}}*/ - -int SLang_push_mmt (SLang_MMT_Type *ref) /*{{{*/ -{ - if (ref == NULL) - return SLang_push_null (); - - ref->count += 1; - - if (0 == SLclass_push_ptr_obj (ref->data_type, (VOID_STAR) ref)) - return 0; - - ref->count -= 1; - return -1; -} - -/*}}}*/ - -void SLang_inc_mmt (SLang_MMT_Type *ref) -{ - if (ref != NULL) - ref->count += 1; -} - -VOID_STAR SLang_object_from_mmt (SLang_MMT_Type *ref) -{ - if (ref == NULL) - return NULL; - - return ref->user_data; -} - -SLang_MMT_Type *SLang_create_mmt (unsigned char t, VOID_STAR p) -{ - SLang_MMT_Type *ref; - - (void) _SLclass_get_class (t); /* check to see if it is registered */ - - if (NULL == (ref = (SLang_MMT_Type *) SLmalloc (sizeof (SLang_MMT_Type)))) - return NULL; - - SLMEMSET ((char *) ref, 0, sizeof (SLang_MMT_Type)); - - ref->data_type = t; - ref->user_data = p; - /* FIXME!! To be consistent with other types, the reference count should - * be set to 1 here. However, doing so will require other code changes - * involving the use of MMTs. For instance, SLang_free_mmt would have - * to be called after every push of the MMT. - */ - return ref; -} - -void SLang_free_mmt (SLang_MMT_Type *ref) -{ - unsigned char type; - SLang_Class_Type *cl; - - if (ref == NULL) - return; - - /* This can be zero if SLang_create_mmt is called followed - * by this routine before anything gets a chance to attach itself - * to it. - */ - if (ref->count > 1) - { - ref->count -= 1; - return; - } - - type = ref->data_type; - cl = _SLclass_get_class (type); - (*cl->cl_user_destroy_fun) (type, ref->user_data); - SLfree ((char *)ref); -} - -int SLang_push_value (unsigned char type, VOID_STAR v) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - return (*cl->cl_apush)(type, v); -} - -int SLang_pop_value (unsigned char type, VOID_STAR v) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - return (*cl->cl_apop)(type, v); -} - -void SLang_free_value (unsigned char type, VOID_STAR v) -{ - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - (*cl->cl_adestroy) (type, v); -} - -/* These routines are very low-level and are designed for application data - * types to access the stack from their push/pop methods. The int and - * pointer versions are in slang.c - */ -#if SLANG_HAS_FLOAT -int SLclass_push_double_obj (unsigned char type, double x) -{ - SLang_Object_Type obj; - obj.data_type = type; - obj.v.double_val = x; - return SLang_push (&obj); -} -int SLclass_push_float_obj (unsigned char type, float x) -{ - SLang_Object_Type obj; - obj.data_type = type; - obj.v.float_val = x; - return SLang_push (&obj); -} - -#endif - -int SLclass_push_long_obj (unsigned char type, long x) -{ - SLang_Object_Type obj; - obj.data_type = type; - obj.v.long_val = x; - return SLang_push (&obj); -} - -int SLclass_push_short_obj (unsigned char type, short x) -{ - SLang_Object_Type obj; - obj.data_type = type; - obj.v.short_val = x; - return SLang_push (&obj); -} - -int SLclass_push_char_obj (unsigned char type, char x) -{ - SLang_Object_Type obj; - obj.data_type = type; - obj.v.char_val = x; - return SLang_push (&obj); -} - -#if SLANG_HAS_FLOAT -int SLclass_pop_double_obj (unsigned char type, double *x) -{ - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (type, &obj, 0)) - return -1; - - *x = obj.v.double_val; - return 0; -} - -int SLclass_pop_float_obj (unsigned char type, float *x) -{ - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (type, &obj, 0)) - return -1; - - *x = obj.v.float_val; - return 0; -} -#endif - -int SLclass_pop_long_obj (unsigned char type, long *x) -{ - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (type, &obj, 0)) - return -1; - - *x = obj.v.long_val; - return 0; -} - -int SLclass_pop_int_obj (unsigned char type, int *x) -{ - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (type, &obj, 0)) - return -1; - - *x = obj.v.int_val; - return 0; -} - -int SLclass_pop_short_obj (unsigned char type, short *x) -{ - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (type, &obj, 0)) - return -1; - - *x = obj.v.short_val; - return 0; -} - -int SLclass_pop_char_obj (unsigned char type, char *x) -{ - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (type, &obj, 0)) - return -1; - - *x = obj.v.char_val; - return 0; -} - -int SLclass_pop_ptr_obj (unsigned char type, VOID_STAR *s) -{ - SLang_Object_Type obj; - - if (-1 == _SLang_pop_object_of_type (type, &obj, 0)) - { - *s = (VOID_STAR) NULL; - return -1; - } - *s = obj.v.ptr_val; - return 0; -} - diff --git a/mdk-stage1/slang/slcmd.c b/mdk-stage1/slang/slcmd.c deleted file mode 100644 index 4a00a90fc..000000000 --- a/mdk-stage1/slang/slcmd.c +++ /dev/null @@ -1,351 +0,0 @@ -/* cmd line facility for slang */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#if SLANG_HAS_FLOAT -# include <math.h> -#endif - -#include "slang.h" -#include "_slang.h" - -#ifndef HAVE_STDLIB_H -/* Oh dear. Where is the prototype for atof? If not in stdlib, then - * I do not know where. Not in math.h onsome systems either. - */ -extern double atof (); -#endif - -static SLcmd_Cmd_Type *SLcmd_find_command (char *s, SLcmd_Cmd_Type *cmd) -{ - char *cmdstr; - char chs = *s++, ch; - - while ((cmd->cmdfun != NULL) - && (NULL != (cmdstr = cmd->cmd)) - && (0 != (ch = *cmdstr++))) - { - if ((ch == chs) && !strcmp (s, cmdstr)) return cmd; - cmd++; - } - return NULL; -} - -static int extract_token (char **strptr, char *buf) -{ - char *s, *b; - char ch, quote; - - *buf = 0; - - s = *strptr; - while (((ch = *s) != 0) - && ((ch == ' ') || (ch == '\t') || (ch == '\n'))) - s++; - - *strptr = s; - - if (ch == 0) return 0; - if (ch == '%') return 0; - - b = buf; - - *b++ = ch; - s++; - - if ((ch == '\'') || (ch == '"')) - { - quote = ch; - while ((ch = *s) != 0) - { - s++; - *b++ = ch; - if (ch == quote) - break; - - if (ch == '\\') - { - if (0 == (ch = *s)) - break; - *b++ = ch; - s++; - } - } - *strptr = s; - *b = 0; - return 1; - } - - while (((ch = *s) != 0) - && (ch != ' ') - && (ch != '\t') - && (ch != '\n') - && (ch != '%')) - *b++ = *s++; - - *strptr = s; - *b = 0; - return 1; -} - -static int allocate_arg_space (SLcmd_Cmd_Table_Type *table, int argc, unsigned int *space_ptr) -{ - unsigned int space = *space_ptr; - char *p; - - if (argc + 1 < (int) space) - return 0; - - if (space > 128) - { - if (space > 1024) space += 1024; - else space += 128; - } - else space += 32; - - if (NULL == (p = SLrealloc ((char *)table->string_args, space * sizeof (char *)))) - return -1; - table->string_args = (char **)p; - table->string_args [argc] = NULL; - - if (NULL == (p = SLrealloc ((char *)table->int_args, space * sizeof (int)))) - return -1; - table->int_args = (int *)p; - - if (NULL == (p = SLrealloc ((char *)table->double_args, space * sizeof (double)))) - return -1; - table->double_args = (double *)p; - - if (NULL == (p = SLrealloc ((char *)table->arg_type, space * sizeof (unsigned char)))) - return -1; - table->arg_type = (unsigned char *)p; - - *space_ptr = space; - return 0; -} - -int SLcmd_execute_string (char *str, SLcmd_Cmd_Table_Type *table) -{ - char *s, *b = NULL, *arg_type, *last_str, *cmd_name; - SLcmd_Cmd_Type *cmd; - char *buf; - int token_present; - int i; - int status; - unsigned int len; - int argc; - unsigned int space; - - table->argc = 0; - table->string_args = NULL; - table->int_args = NULL; - table->double_args = NULL; - table->arg_type = NULL; - - buf = SLmake_string (str); - if (buf == NULL) - return -1; - - status = extract_token (&str, buf); - if (status <= 0) - { - SLfree (buf); - return status; - } - - if (((len = strlen (buf)) >= 32) - || (NULL == (cmd = SLcmd_find_command (buf, table->table)))) - { - SLang_verror (SL_UNDEFINED_NAME,"%s: invalid command", buf); - SLfree (buf); - return -1; - } - - if (NULL == (cmd_name = SLmake_string (buf))) - { - SLfree (buf); - return -1; - } - - space = 0; - argc = 0; - if (-1 == allocate_arg_space (table, argc, &space)) - { - SLfree (buf); - return -1; - } - table->arg_type[argc] = SLANG_STRING_TYPE; - table->string_args[argc++] = cmd_name; - - arg_type = cmd->arg_type; - status = -1; - while (*arg_type) - { - int guess_type = 0; - - last_str = str; - - if (-1 == allocate_arg_space (table, argc, &space)) - goto error; - - if (-1 == (token_present = extract_token (&str, buf))) - goto error; - - table->string_args[argc] = NULL; - - if (token_present) - { - b = buf; - len = strlen (b); - - if ((*b == '"') && (len > 1)) - { - b++; - len -= 2; - b[len] = 0; - guess_type = SLANG_STRING_TYPE; - SLexpand_escaped_string (buf, b, b + len); - len = strlen (buf); - } - else if ((*b == '\'') && (len > 1)) - { - char ch; - b++; - len -= 2; - b[len] = 0; - guess_type = SLANG_INT_TYPE; - ch = *b; - if (ch == '\\') - (void) _SLexpand_escaped_char (b, &ch); - sprintf (buf, "%d", (unsigned char) ch); - len = strlen (buf); - } - else guess_type = SLang_guess_type (buf); - } - - switch (*arg_type++) - { - /* variable argument number */ - case 'v': - if (token_present == 0) break; - case 'V': - if (token_present == 0) - { - SLang_verror (SL_INVALID_PARM, "%s: Expecting argument", cmd_name); - goto error; - } - - while (*last_str == ' ') last_str++; - len = strlen (last_str); - str = last_str + len; - - s = SLmake_nstring (last_str, len); - if (s == NULL) goto error; - - table->arg_type[argc] = SLANG_STRING_TYPE; - table->string_args[argc++] = s; - break; - - case 's': - if (token_present == 0) break; - case 'S': - if (token_present == 0) - { - SLang_verror (SL_TYPE_MISMATCH, "%s: Expecting string argument", cmd_name); - goto error; - } - - s = SLmake_nstring (buf, len); - if (s == NULL) goto error; - table->arg_type[argc] = SLANG_STRING_TYPE; - table->string_args[argc++] = s; - break; - - /* integer argument */ - case 'i': - if (token_present == 0) break; - case 'I': - if ((token_present == 0) || (SLANG_INT_TYPE != guess_type)) - { - SLang_verror (SL_TYPE_MISMATCH, "%s: Expecting integer argument", cmd_name); - goto error; - } - - table->arg_type[argc] = SLANG_INT_TYPE; - table->int_args[argc++] = SLatoi((unsigned char *) buf); - break; - - /* floating point arg */ -#if SLANG_HAS_FLOAT - case 'f': - if (token_present == 0) break; - case 'F': - if ((token_present == 0) || (SLANG_STRING_TYPE == guess_type)) - { - SLang_verror (SL_TYPE_MISMATCH, "%s: Expecting double argument", cmd_name); - goto error; - } - table->arg_type[argc] = SLANG_DOUBLE_TYPE; - table->double_args[argc++] = atof(buf); - break; -#endif - /* Generic type */ - case 'g': - if (token_present == 0) break; - case 'G': - if (token_present == 0) - { - SLang_verror (SL_TYPE_MISMATCH, "%s: Expecting argument", cmd_name); - goto error; - } - - switch (guess_type) - { - case SLANG_INT_TYPE: - table->arg_type[argc] = SLANG_INT_TYPE; - table->int_args[argc++] = SLatoi((unsigned char *) buf); - break; - - case SLANG_STRING_TYPE: - s = SLmake_nstring (buf, len); - if (s == NULL) goto error; - - table->arg_type[argc] = SLANG_STRING_TYPE; - table->string_args[argc++] = s; - break; -#if SLANG_HAS_FLOAT - case SLANG_DOUBLE_TYPE: - table->arg_type[argc] = SLANG_DOUBLE_TYPE; - table->double_args[argc++] = atof(buf); -#endif - } - break; - } - } - - /* call function */ - status = (*cmd->cmdfun)(argc, table); - - error: - if (table->string_args != NULL) for (i = 0; i < argc; i++) - { - if (NULL != table->string_args[i]) - { - SLfree (table->string_args[i]); - table->string_args[i] = NULL; - } - } - SLfree ((char *)table->string_args); table->string_args = NULL; - SLfree ((char *)table->double_args); table->double_args = NULL; - SLfree ((char *)table->int_args); table->int_args = NULL; - SLfree ((char *)table->arg_type); table->arg_type = NULL; - - SLfree (buf); - return status; -} - diff --git a/mdk-stage1/slang/slcmplex.c b/mdk-stage1/slang/slcmplex.c deleted file mode 100644 index b210dfc04..000000000 --- a/mdk-stage1/slang/slcmplex.c +++ /dev/null @@ -1,1142 +0,0 @@ -/* Complex Data Type definition for S-Lang */ -/* Copyright (c) 1997, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -/* The rest of the file is enclosed in this #if */ -#if SLANG_HAS_COMPLEX - -#if SLANG_HAS_FLOAT -# include <math.h> -#endif - -#ifdef PI -# undef PI -#endif -#define PI 3.14159265358979323846 - -int SLang_pop_complex (double *r, double *i) -{ - double *c; - - switch (SLang_peek_at_stack ()) - { - case SLANG_COMPLEX_TYPE: - if (-1 == SLclass_pop_ptr_obj (SLANG_COMPLEX_TYPE, (VOID_STAR *)&c)) - return -1; - *r = c[0]; - *i = c[1]; - SLfree ((char *) c); - break; - - default: - *i = 0.0; - if (-1 == SLang_pop_double (r, NULL, NULL)) - return -1; - break; - - case -1: - return -1; - } - return 0; -} - -int SLang_push_complex (double r, double i) -{ - double *c; - - c = (double *) SLmalloc (2 * sizeof (double)); - if (c == NULL) - return -1; - - c[0] = r; - c[1] = i; - - if (-1 == SLclass_push_ptr_obj (SLANG_COMPLEX_TYPE, (VOID_STAR) c)) - { - SLfree ((char *) c); - return -1; - } - return 0; -} - -double *SLcomplex_times (double *c, double *a, double *b) -{ - double a_real, b_real, a_imag, b_imag; - - a_real = a[0]; - b_real = b[0]; - a_imag = a[1]; - b_imag = b[1]; - - c[0] = a_real * b_real - a_imag * b_imag; - c[1] = a_imag * b_real + a_real * b_imag; - - return c; -} - -double *SLcomplex_divide (double *c, double *a, double *b) -{ - double a_real, b_real, a_imag, b_imag; - double ratio, invden; - - a_real = a[0]; - b_real = b[0]; - a_imag = a[1]; - b_imag = b[1]; - - /* Do it this way to avoid overflow in the denom */ - if (fabs(b_real) > fabs(b_imag)) - { - ratio = b_imag / b_real; - invden = 1.0 / (b_real + b_imag * ratio); - c[0] = (a_real + ratio * a_imag) * invden; - c[1] = (a_imag - a_real * ratio) * invden; - } - else - { - ratio = b_real / b_imag; - invden = 1.0 / (b_real * ratio + b_imag); - c[0] = (a_real * ratio + a_imag) * invden; - c[1] = (a_imag * ratio - a_real) * invden; - } - return c; -} - -/* a^b = exp (b log a); */ -double *SLcomplex_pow (double *c, double *a, double *b) -{ - return SLcomplex_exp (c, SLcomplex_times (c, b, SLcomplex_log (c, a))); -} - -static double *complex_dpow (double *c, double *a, double b) -{ - SLcomplex_log (c, a); - c[0] *= b; - c[1] *= b; - return SLcomplex_exp (c, c); -} - -static double *dcomplex_pow (double *c, double a, double *b) -{ - a = log (a); - c[0] = a * b[0]; - c[1] = a * b[1]; - return SLcomplex_exp (c, c); -} - -double SLcomplex_abs (double *z) -{ - return SLmath_hypot (z[0], z[1]); -} - -/* It appears that FORTRAN assumes that the branch cut for the log function - * is along the -x axis. So, use this for atan2: - */ -static double my_atan2 (double y, double x) -{ - double val; - - val = atan (y/x); - - if (x >= 0) - return val; /* I, IV */ - - if (y <= 0) /* III */ - return val - PI; - - return PI + val; /* II */ -} - -static void polar_form (double *r, double *theta, double *z) -{ - double x, y; - - *r = SLcomplex_abs (z); - - x = z[0]; - y = z[1]; - - if (x == 0.0) - { - if (y >= 0) - *theta = 0.5 * PI; - else - *theta = 1.5 * PI; - } - else *theta = my_atan2 (y, x); -} - -double *SLcomplex_sin (double *sinz, double *z) -{ - double x, y; - - x = z[0]; y = z[1]; - sinz[0] = sin (x) * cosh (y); - sinz[1] = cos (x) * sinh (y); - return sinz; -} - -double *SLcomplex_cos (double *cosz, double *z) -{ - double x, y; - - x = z[0]; y = z[1]; - cosz[0] = cos (x) * cosh (y); - cosz[1] = -sin (x) * sinh (y); - return cosz; -} - -double *SLcomplex_exp (double *expz, double *z) -{ - double r, i; - - r = exp (z[0]); - i = z[1]; - expz[0] = r * cos (i); - expz[1] = r * sin (i); - return expz; -} - -double *SLcomplex_log (double *logz, double *z) -{ - double r, theta; - - polar_form (&r, &theta, z); /* log R.e^(ix) = log R + ix */ - logz[0] = log(r); - logz[1] = theta; - return logz; -} - -double *SLcomplex_log10 (double *log10z, double *z) -{ - double l10 = log (10.0); - (void) SLcomplex_log (log10z, z); - log10z[0] = log10z[0] / l10; - log10z[1] = log10z[1] / l10; - return log10z; -} - -double *SLcomplex_sqrt (double *sqrtz, double *z) -{ - double r, x, y; - - x = z[0]; - y = z[1]; - - r = SLmath_hypot (x, y); - - if (r == 0.0) - { - sqrtz [0] = sqrtz [1] = 0.0; - return sqrtz; - } - - if (x >= 0.0) - { - x = sqrt (0.5 * (r + x)); - y = 0.5 * y / x; - } - else - { - r = sqrt (0.5 * (r - x)); - x = 0.5 * y / r; - y = r; - - if (x < 0.0) - { - x = -x; - y = -y; - } - } - - sqrtz[0] = x; - sqrtz[1] = y; - - return sqrtz; -} - -double *SLcomplex_tan (double *tanz, double *z) -{ - double x, y, invden; - - x = 2 * z[0]; - y = 2 * z[1]; - invden = 1.0 / (cos (x) + cosh (y)); - tanz[0] = invden * sin (x); - tanz[1] = invden * sinh (y); - return tanz; -} - -/* Utility Function */ -static void compute_alpha_beta (double *z, double *alpha, double *beta) -{ - double x, y, a, b; - - x = z[0]; - y = z[1]; - a = 0.5 * SLmath_hypot (x + 1, y); - b = 0.5 * SLmath_hypot (x - 1, y); - - *alpha = a + b; - *beta = a - b; -} - -double *SLcomplex_asin (double *asinz, double *z) -{ - double alpha, beta; - - compute_alpha_beta (z, &alpha, &beta); - asinz[0] = asin (beta); - asinz[1] = log (alpha + sqrt (alpha * alpha - 1)); - return asinz; -} - -double *SLcomplex_acos (double *acosz, double *z) -{ - double alpha, beta; - - compute_alpha_beta (z, &alpha, &beta); - acosz[0] = acos (beta); - acosz[1] = -log (alpha + sqrt (alpha * alpha - 1)); - return acosz; -} - -double *SLcomplex_atan (double *atanz, double *z) -{ - double x, y; - double z1[2], z2[2]; - - x = z[0]; y = z[1]; - z1[0] = x; - z1[1] = 1 + y; - z2[0] = -x; - z2[1] = 1 - y; - - SLcomplex_log (z1, SLcomplex_divide (z2, z1, z2)); - atanz[0] = -0.5 * z1[1]; - atanz[1] = 0.5 * z1[0]; - - return atanz; -} - -double *SLcomplex_sinh (double *sinhz, double *z) -{ - double x, y; - x = z[0]; y = z[1]; - sinhz[0] = sinh (x) * cos (y); - sinhz[1] = cosh (x) * sin (y); - return sinhz; -} - -double *SLcomplex_cosh (double *coshz, double *z) -{ - double x, y; - x = z[0]; y = z[1]; - coshz[0] = cosh (x) * cos (y); - coshz[1] = sinh (x) * sin (y); - return coshz; -} - -double *SLcomplex_tanh (double *tanhz, double *z) -{ - double x, y, invden; - x = 2 * z[0]; - y = 2 * z[1]; - invden = 1.0 / (cosh (x) + cos (y)); - tanhz[0] = invden * sinh (x); - tanhz[1] = invden * sin (y); - return tanhz; -} -#if 0 -static double *not_implemented (char *fun, double *p) -{ - SLang_verror (SL_NOT_IMPLEMENTED, "%s for complex numbers has not been implemented", - fun); - *p = -1.0; - return p; -} -#endif -/* Use: asinh(z) = -i asin(iz) */ -double *SLcomplex_asinh (double *asinhz, double *z) -{ - double iz[2]; - - iz[0] = -z[1]; - iz[1] = z[0]; - - (void) SLcomplex_asin (iz, iz); - asinhz[0] = iz[1]; - asinhz[1] = -iz[0]; - - return asinhz; -} - -/* Use: acosh (z) = i acos(z) */ -double *SLcomplex_acosh (double *acoshz, double *z) -{ - double iz[2]; - - (void) SLcomplex_acos (iz, z); - acoshz[0] = -iz[1]; - acoshz[1] = iz[0]; - - return acoshz; -} - -/* Use: atanh(z) = -i atan(iz) */ -double *SLcomplex_atanh (double *atanhz, double *z) -{ - double iz[2]; - - iz[0] = -z[1]; - iz[1] = z[0]; - - (void) SLcomplex_atan (iz, iz); - atanhz[0] = iz[1]; - atanhz[1] = -iz[0]; - - return atanhz; -} - -static int complex_binary_result (int op, unsigned char a, unsigned char b, - unsigned char *c) -{ - (void) a; (void) b; - - switch (op) - { - default: - case SLANG_POW: - case SLANG_PLUS: - case SLANG_MINUS: - case SLANG_TIMES: - case SLANG_DIVIDE: - *c = SLANG_COMPLEX_TYPE; - break; - - case SLANG_EQ: - case SLANG_NE: - *c = SLANG_CHAR_TYPE; - break; - } - return 1; -} - -static int complex_complex_binary (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - char *ic; - double *a, *b, *c; - unsigned int n, n_max; - unsigned int da, db; - - (void) a_type; - (void) b_type; - - a = (double *) ap; - b = (double *) bp; - c = (double *) cp; - ic = (char *) cp; - - if (na == 1) da = 0; else da = 2; - if (nb == 1) db = 0; else db = 2; - - if (na > nb) n_max = na; else n_max = nb; - n_max = 2 * n_max; - - switch (op) - { - default: - return 0; - - case SLANG_PLUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] + b[0]; - c[n + 1] = a[1] + b[1]; - a += da; b += db; - } - break; - - case SLANG_MINUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] - b[0]; - c[n + 1] = a[1] - b[1]; - a += da; b += db; - } - break; - - case SLANG_TIMES: - for (n = 0; n < n_max; n += 2) - { - SLcomplex_times (c + n, a, b); - a += da; b += db; - } - break; - - case SLANG_DIVIDE: /* / */ - for (n = 0; n < n_max; n += 2) - { - if ((b[0] == 0.0) && (b[1] == 0.0)) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - SLcomplex_divide (c + n, a, b); - a += da; b += db; - } - break; - - case SLANG_EQ: /* == */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] == b[0]) && (a[1] == b[1])); - a += da; b += db; - } - break; - - case SLANG_NE: /* != */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] != b[0]) || (a[1] != b[1])); - a += da; b += db; - } - break; - - case SLANG_POW: - for (n = 0; n < n_max; n += 2) - { - SLcomplex_pow (c + n, a, b); - a += da; b += db; - } - break; - - } - - return 1; -} - -static int complex_double_binary (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - char *ic; - double *a, *b, *c; - unsigned int n, n_max; - unsigned int da, db; - - (void) a_type; - (void) b_type; - - a = (double *) ap; - b = (double *) bp; - c = (double *) cp; - ic = (char *) cp; - - if (na == 1) da = 0; else da = 2; - if (nb == 1) db = 0; else db = 1; - - if (na > nb) n_max = na; else n_max = nb; - n_max = 2 * n_max; - - switch (op) - { - default: - return 0; - - case SLANG_PLUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] + b[0]; - c[n + 1] = a[1]; - a += da; b += db; - } - break; - - case SLANG_MINUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] - b[0]; - c[n + 1] = a[1]; - a += da; b += db; - } - break; - - case SLANG_TIMES: - for (n = 0; n < n_max; n += 2) - { - double b0 = b[0]; - c[n] = a[0] * b0; - c[n + 1] = a[1] * b0; - a += da; b += db; - } - break; - - case SLANG_DIVIDE: /* / */ - for (n = 0; n < n_max; n += 2) - { - double b0 = b[0]; - if (b0 == 0.0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = a[0] / b0; - c[n + 1] = a[1] / b0; - a += da; b += db; - } - break; - - case SLANG_EQ: /* == */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] == b[0]) && (a[1] == 0.0)); - a += da; b += db; - } - break; - - case SLANG_NE: /* != */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] != b[0]) || (a[1] != 0.0)); - a += da; b += db; - } - break; - - case SLANG_POW: - for (n = 0; n < n_max; n += 2) - { - complex_dpow (c + n, a, b[0]); - a += da; b += db; - } - break; - } - - return 1; -} - -static int double_complex_binary (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - char *ic; - double *a, *b, *c; - unsigned int n, n_max; - unsigned int da, db; - - (void) a_type; - (void) b_type; - - a = (double *) ap; - b = (double *) bp; - c = (double *) cp; - ic = (char *) cp; - - if (na == 1) da = 0; else da = 1; - if (nb == 1) db = 0; else db = 2; - - if (na > nb) n_max = na; else n_max = nb; - n_max = 2 * n_max; - - switch (op) - { - default: - return 0; - - case SLANG_PLUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] + b[0]; - c[n + 1] = b[1]; - a += da; b += db; - } - break; - - case SLANG_MINUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] - b[0]; - c[n + 1] = -b[1]; - a += da; b += db; - } - break; - - case SLANG_TIMES: - for (n = 0; n < n_max; n += 2) - { - double a0 = a[0]; - c[n] = a0 * b[0]; - c[n + 1] = a0 * b[1]; - a += da; b += db; - } - break; - - case SLANG_DIVIDE: /* / */ - for (n = 0; n < n_max; n += 2) - { - double z[2]; - if ((b[0] == 0.0) && (b[1] == 0.0)) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - z[0] = a[0]; - z[1] = 0.0; - SLcomplex_divide (c + n, z, b); - a += da; b += db; - } - break; - - case SLANG_EQ: /* == */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] == b[0]) && (0.0 == b[1])); - a += da; b += db; - } - break; - - case SLANG_NE: /* != */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] != b[0]) || (0.0 != b[1])); - a += da; b += db; - } - break; - - case SLANG_POW: - for (n = 0; n < n_max; n += 2) - { - dcomplex_pow (c + n, a[0], b); - a += da; b += db; - } - break; - } - - return 1; -} - -static int complex_generic_binary (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - char *ic; - char *b; - double *a, *c; - unsigned int n, n_max; - unsigned int da, db; - unsigned int sizeof_b; - SLang_To_Double_Fun_Type to_double; - - if (NULL == (to_double = SLarith_get_to_double_fun (b_type, &sizeof_b))) - return 0; - - (void) a_type; - - a = (double *) ap; - b = (char *) bp; - c = (double *) cp; - ic = (char *) cp; - - if (na == 1) da = 0; else da = 2; - if (nb == 1) db = 0; else db = sizeof_b; - - if (na > nb) n_max = na; else n_max = nb; - n_max = 2 * n_max; - - switch (op) - { - default: - return 0; - - case SLANG_POW: - for (n = 0; n < n_max; n += 2) - { - complex_dpow (c + n, a, to_double((VOID_STAR)b)); - a += da; b += db; - } - break; - - case SLANG_PLUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] + to_double((VOID_STAR)b); - c[n + 1] = a[1]; - a += da; b += db; - } - break; - - case SLANG_MINUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = a[0] - to_double((VOID_STAR)b); - c[n + 1] = a[1]; - a += da; b += db; - } - break; - - case SLANG_TIMES: - for (n = 0; n < n_max; n += 2) - { - double b0 = to_double((VOID_STAR)b); - c[n] = a[0] * b0; - c[n + 1] = a[1] * b0; - a += da; b += db; - } - break; - - case SLANG_DIVIDE: /* / */ - for (n = 0; n < n_max; n += 2) - { - double b0 = to_double((VOID_STAR)b); - if (b0 == 0) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - c[n] = a[0] / b0; - c[n + 1] = a[1] / b0; - a += da; b += db; - } - break; - - case SLANG_EQ: /* == */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] == to_double((VOID_STAR)b)) && (a[1] == 0.0)); - a += da; b += db; - } - break; - - case SLANG_NE: /* != */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((a[0] != to_double((VOID_STAR)b)) || (a[1] != 0.0)); - a += da; b += db; - } - break; - } - - return 1; -} - -static int generic_complex_binary (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - double *b, *c; - char *a, *ic; - unsigned int n, n_max; - unsigned int da, db; - unsigned int sizeof_a; - SLang_To_Double_Fun_Type to_double; - - if (NULL == (to_double = SLarith_get_to_double_fun (a_type, &sizeof_a))) - return 0; - - (void) b_type; - - a = (char *) ap; - b = (double *) bp; - c = (double *) cp; - ic = (char *) cp; - - if (na == 1) da = 0; else da = sizeof_a; - if (nb == 1) db = 0; else db = 2; - - if (na > nb) n_max = na; else n_max = nb; - n_max = 2 * n_max; - - switch (op) - { - default: - return 0; - case SLANG_POW: - for (n = 0; n < n_max; n += 2) - { - dcomplex_pow (c + n, to_double((VOID_STAR)a), b); - a += da; b += db; - } - break; - - case SLANG_PLUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = to_double((VOID_STAR)a) + b[0]; - c[n + 1] = b[1]; - a += da; b += db; - } - break; - - case SLANG_MINUS: - for (n = 0; n < n_max; n += 2) - { - c[n] = to_double((VOID_STAR)a) - b[0]; - c[n + 1] = -b[1]; - a += da; b += db; - } - break; - - case SLANG_TIMES: - for (n = 0; n < n_max; n += 2) - { - double a0 = to_double((VOID_STAR)a); - c[n] = a0 * b[0]; - c[n + 1] = a0 * b[1]; - a += da; b += db; - } - break; - - case SLANG_DIVIDE: /* / */ - for (n = 0; n < n_max; n += 2) - { - double z[2]; - if ((b[0] == 0.0) && (b[1] == 0.0)) - { - SLang_Error = SL_DIVIDE_ERROR; - return -1; - } - z[0] = to_double((VOID_STAR)a); - z[1] = 0.0; - SLcomplex_divide (c + n, z, b); - a += da; b += db; - } - break; - - case SLANG_EQ: /* == */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((to_double((VOID_STAR)a) == b[0]) && (0.0 == b[1])); - a += da; b += db; - } - break; - - case SLANG_NE: /* != */ - for (n = 0; n < n_max; n += 2) - { - ic[n/2] = ((to_double((VOID_STAR)a) != b[0]) || (0.0 != b[1])); - a += da; b += db; - } - break; - } - - return 1; -} - -static int complex_unary_result (int op, unsigned char a, unsigned char *b) -{ - (void) a; - - switch (op) - { - default: - return 0; - - case SLANG_PLUSPLUS: - case SLANG_MINUSMINUS: - case SLANG_CHS: - case SLANG_MUL2: - *b = SLANG_COMPLEX_TYPE; - break; - - case SLANG_SQR: /* |Real|^2 + |Imag|^2 ==> double */ - case SLANG_ABS: /* |z| ==> double */ - *b = SLANG_DOUBLE_TYPE; - break; - - case SLANG_SIGN: - *b = SLANG_INT_TYPE; - break; - } - return 1; -} - -static int complex_unary (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - unsigned int n; - double *a, *b; - int *ic; - - (void) a_type; - - a = (double *) ap; - b = (double *) bp; - ic = (int *) bp; - - na = 2 * na; - - switch (op) - { - default: - return 0; - - case SLANG_PLUSPLUS: - for (n = 0; n < na; n += 2) b[n] = (a[n] + 1); - break; - case SLANG_MINUSMINUS: - for (n = 0; n < na; n += 2) b[n] = (a[n] - 1); - break; - case SLANG_CHS: - for (n = 0; n < na; n += 2) - { - b[n] = -(a[n]); - b[n + 1] = -(a[n + 1]); - } - break; - case SLANG_SQR: /* |Real|^2 + |Imag|^2 ==> double */ - for (n = 0; n < na; n += 2) - b[n/2] = (a[n] * a[n] + a[n + 1] * a[n + 1]); - break; - - case SLANG_MUL2: - for (n = 0; n < na; n += 2) - { - b[n] = (2 * a[n]); - b[n + 1] = (2 * a[n + 1]); - } - break; - - case SLANG_ABS: /* |z| ==> double */ - for (n = 0; n < na; n += 2) - b[n/2] = SLcomplex_abs (a + n); - break; - - case SLANG_SIGN: - /* Another creative extension. Lets return an integer which indicates - * whether the complex number is in the upperhalf plane or not. - */ - for (n = 0; n < na; n += 2) - { - if (a[n + 1] < 0.0) ic[n/2] = -1; - else if (a[n + 1] > 0.0) ic[n/2] = 1; - else ic[n/2] = 0; - } - break; - } - - return 1; -} - -static int -complex_typecast (unsigned char from_type, VOID_STAR from, unsigned int num, - unsigned char to_type, VOID_STAR to) -{ - double *z; - double *d; - char *i; - unsigned int n; - unsigned int sizeof_i; - SLang_To_Double_Fun_Type to_double; - - (void) to_type; - - z = (double *) to; - - switch (from_type) - { - default: - if (NULL == (to_double = SLarith_get_to_double_fun (from_type, &sizeof_i))) - return 0; - i = (char *) from; - for (n = 0; n < num; n++) - { - *z++ = to_double ((VOID_STAR) i); - *z++ = 0.0; - - i += sizeof_i; - } - break; - - case SLANG_DOUBLE_TYPE: - d = (double *) from; - for (n = 0; n < num; n++) - { - *z++ = d[n]; - *z++ = 0.0; - } - break; - } - - return 1; -} - -static void complex_destroy (unsigned char type, VOID_STAR ptr) -{ - (void) type; - SLfree ((char *)*(double **) ptr); -} - -static int complex_push (unsigned char type, VOID_STAR ptr) -{ - double *z; - - (void) type; - z = *(double **) ptr; - return SLang_push_complex (z[0], z[1]); -} - -static int complex_pop (unsigned char type, VOID_STAR ptr) -{ - double *z; - - (void) type; - z = *(double **) ptr; - return SLang_pop_complex (&z[0], &z[1]); -} - -int _SLinit_slcomplex (void) -{ - SLang_Class_Type *cl; - unsigned char *types; - - if (NULL == (cl = SLclass_allocate_class ("Complex_Type"))) - return -1; - - (void) SLclass_set_destroy_function (cl, complex_destroy); - (void) SLclass_set_push_function (cl, complex_push); - (void) SLclass_set_pop_function (cl, complex_pop); - - if (-1 == SLclass_register_class (cl, SLANG_COMPLEX_TYPE, 2 * sizeof (double), - SLANG_CLASS_TYPE_VECTOR)) - return -1; - - types = _SLarith_Arith_Types; - while (*types != SLANG_DOUBLE_TYPE) - { - unsigned char t = *types++; - - if ((-1 == SLclass_add_binary_op (t, SLANG_COMPLEX_TYPE, generic_complex_binary, complex_binary_result)) - || (-1 == SLclass_add_binary_op (SLANG_COMPLEX_TYPE, t, complex_generic_binary, complex_binary_result)) - || (-1 == (SLclass_add_typecast (t, SLANG_COMPLEX_TYPE, complex_typecast, 1)))) - return -1; - } - - if ((-1 == (SLclass_add_binary_op (SLANG_COMPLEX_TYPE, SLANG_COMPLEX_TYPE, complex_complex_binary, complex_binary_result))) - || (-1 == (SLclass_add_binary_op (SLANG_COMPLEX_TYPE, SLANG_DOUBLE_TYPE, complex_double_binary, complex_binary_result))) - || (-1 == (SLclass_add_binary_op (SLANG_DOUBLE_TYPE, SLANG_COMPLEX_TYPE, double_complex_binary, complex_binary_result))) - || (-1 == (SLclass_add_unary_op (SLANG_COMPLEX_TYPE, complex_unary, complex_unary_result))) - || (-1 == (SLclass_add_typecast (SLANG_DOUBLE_TYPE, SLANG_COMPLEX_TYPE, complex_typecast, 1)))) - return -1; - - return 0; -} - -#endif /* if SLANG_HAS_COMPLEX */ - diff --git a/mdk-stage1/slang/slcompat.c b/mdk-stage1/slang/slcompat.c deleted file mode 100644 index 5aa122483..000000000 --- a/mdk-stage1/slang/slcompat.c +++ /dev/null @@ -1,34 +0,0 @@ -/* These functions are provided for backward compatibility and are obsolete. - * Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -/* Compatibility */ -int SLang_init_slunix (void) -{ - if ((-1 == SLang_init_posix_dir ()) - || (-1 == SLang_init_posix_process ()) - || (-1 == SLdefine_for_ifdef ("__SLUNIX__"))) - return -1; - - return 0; -} - -int SLang_init_slfile (void) -{ - if ((-1 == SLang_init_stdio ()) - || (-1 == SLang_init_posix_dir ()) - || (-1 == SLdefine_for_ifdef("__SLFILE__"))) - return -1; - - return 0; -} - diff --git a/mdk-stage1/slang/slcurses.c b/mdk-stage1/slang/slcurses.c deleted file mode 100644 index f1212afc8..000000000 --- a/mdk-stage1/slang/slcurses.c +++ /dev/null @@ -1,972 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include <signal.h> -#include <errno.h> - -#include "slang.h" -#include "_slang.h" -#include "slcurses.h" - -/* This file is meant to implement a primitive curses implementation in - * terms of SLsmg calls. The fact is that the interfaces are sufficiently - * different that a 100% emulation is not possible. - */ - -SLcurses_Window_Type *SLcurses_Stdscr; -int SLcurses_Esc_Delay = 150; /* 0.15 seconds */ -SLtt_Char_Type SLcurses_Acs_Map [128]; -int SLcurses_Is_Endwin = 1; -int SLcurses_Num_Colors = 8; - -static void blank_line (SLsmg_Char_Type *b, unsigned int len, SLsmg_Char_Type color) -{ - SLsmg_Char_Type *bmax; - - bmax = b + len; - color = SLSMG_BUILD_CHAR(' ', color); - - while (b < bmax) *b++ = color; -} - -static int va_mvprintw (SLcurses_Window_Type *w, int r, int c, int do_move, - char *fmt, va_list ap) -{ - char buf[1024]; - - if (do_move) SLcurses_wmove (w, r, c); - - (void) _SLvsnprintf (buf, sizeof(buf), fmt, ap); - - SLcurses_waddnstr (w, buf, -1); - return 0; -} - -int SLcurses_mvprintw (int r, int c, char *fmt, ...) -{ - va_list ap; - - va_start(ap, fmt); - va_mvprintw (SLcurses_Stdscr, r, c, 1, fmt, ap); - va_end(ap); - - return 0; -} - -int SLcurses_mvwprintw (SLcurses_Window_Type *w, int r, int c, char *fmt, ...) -{ - va_list ap; - - va_start(ap, fmt); - va_mvprintw (w, r, c, 1, fmt, ap); - va_end(ap); - - return 0; -} - -int SLcurses_wprintw (SLcurses_Window_Type *w, char *fmt, ...) -{ - va_list ap; - - va_start(ap, fmt); - va_mvprintw (w, 0, 0, 0, fmt, ap); - va_end(ap); - - return 0; -} - -int SLcurses_printw (char *fmt, ...) -{ - va_list ap; - - va_start(ap, fmt); - va_mvprintw (SLcurses_Stdscr, 0, 0, 0, fmt, ap); - va_end(ap); - - return 0; -} - -int SLcurses_nil (void) -{ - return 0; -} - -int SLcurses_has_colors(void) -{ - return SLtt_Use_Ansi_Colors; -} - -int SLcurses_nodelay (SLcurses_Window_Type *w, int onoff) -{ - w->delay_off = (onoff ? 0 : -1); - return 0; -} - -int SLcurses_wgetch (SLcurses_Window_Type *w) -{ - if (w == NULL) - return ERR; - - SLcurses_wrefresh (w); - - if ((w->delay_off == -1) || - SLang_input_pending (w->delay_off)) - { - if (w->use_keypad) - { - int ch = SLang_getkey (); - if (ch == '\033') - { - if (0 == SLang_input_pending (ESCDELAY / 100)) - return ch; - } - else if (ch == 0xFFFF) return ERR; - SLang_ungetkey (ch); - return SLkp_getkey (); - } - return SLang_getkey (); - } - - return ERR; -} - -int SLcurses_getch (void) -{ - return SLcurses_wgetch (SLcurses_Stdscr); -} - -/* This is a super hack. That fact is that SLsmg and curses - * are incompatible. - */ -static unsigned char Color_Objects[256]; - -static unsigned int map_attr_to_object (SLtt_Char_Type attr) -{ - unsigned int obj; - SLtt_Char_Type at; - - obj = (attr >> 8) & 0xFF; - - if (SLtt_Use_Ansi_Colors) - { - if (Color_Objects[obj] != 0) return obj; - - at = SLtt_get_color_object (obj & 0xF); - - if (attr & A_BOLD) at |= SLTT_BOLD_MASK; - if (attr & A_UNDERLINE) at |= SLTT_ULINE_MASK; - if (attr & A_REVERSE) at |= SLTT_REV_MASK; - - SLtt_set_color_object (obj, at); - - Color_Objects[obj] = 1; - } - else obj = obj & 0xF0; - - return obj; - -} - -int SLcurses_start_color (void) -{ - int f, b; - int obj; - - if (SLtt_Use_Ansi_Colors == 0) return -1; - - obj = 0; - for (f = 0; f < 16; f++) - { - for (b = 0; b < 16; b++) - { - obj++; - SLtt_set_color_fgbg (obj, f, b); - } - } - return 0; -} - -#ifdef SIGINT -static void sigint_handler (int sig) -{ - SLang_reset_tty (); - SLsmg_reset_smg (); - exit (sig); -} -#endif - -/* Values are assumed to be 0, 1, 2. This fact is exploited */ -static int TTY_State; - -static int init_tty (int suspend_ok) -{ - if (-1 == SLang_init_tty (-1, 1, 0)) - return -1; - -#ifdef REAL_UNIX_SYSTEM - if (suspend_ok) SLtty_set_suspend_state (1); -#endif - return 0; -} - -int SLcurses_raw (void) -{ - TTY_State = 1; - return init_tty (0); -} - -int SLcurses_cbreak (void) -{ - TTY_State = 2; - return init_tty (1); -} - -#if defined(SIGTSTP) && defined(SIGSTOP) -static void sigtstp_handler (int sig) -{ - sig = errno; - - SLsmg_suspend_smg (); - - if (TTY_State) - SLang_reset_tty (); - - kill(getpid(),SIGSTOP); - - SLsmg_resume_smg (); - - if (TTY_State) init_tty (TTY_State - 1); - - signal (SIGTSTP, sigtstp_handler); - errno = sig; -} -#endif - -SLcurses_Window_Type *SLcurses_initscr (void) -{ - SLcurses_Is_Endwin = 0; - SLsmg_Newline_Behavior = SLSMG_NEWLINE_MOVES; - SLtt_get_terminfo (); - -#if !defined(IBMPC_SYSTEM) && !defined(VMS) - if (-1 == (SLcurses_Num_Colors = SLtt_tgetnum ("Co"))) -#endif - SLcurses_Num_Colors = 8; - - if ((-1 == SLkp_init ()) - || (-1 == SLcurses_cbreak ()) - || (NULL == (SLcurses_Stdscr = SLcurses_newwin (0, 0, 0, 0))) - || (-1 == SLsmg_init_smg ())) - { - SLang_doerror (NULL); - SLang_exit_error ("SLcurses_initscr: init failed\n"); - return NULL; - } - -#ifdef SIGINT - signal (SIGINT, sigint_handler); -#endif - -#if defined(SIGTSTP) && defined(SIGSTOP) - signal (SIGTSTP, sigtstp_handler); -#endif - - SLtt_set_mono (A_BOLD >> 8, NULL, SLTT_BOLD_MASK); - SLtt_set_mono (A_UNDERLINE >> 8, NULL, SLTT_ULINE_MASK); - SLtt_set_mono (A_REVERSE >> 8, NULL, SLTT_REV_MASK); - /* SLtt_set_mono (A_BLINK >> 8, NULL, SLTT_BLINK_MASK); */ - SLtt_set_mono ((A_BOLD|A_UNDERLINE) >> 8, NULL, SLTT_ULINE_MASK|SLTT_BOLD_MASK); - SLtt_set_mono ((A_REVERSE|A_UNDERLINE) >> 8, NULL, SLTT_ULINE_MASK|SLTT_REV_MASK); - - if (SLtt_Has_Alt_Charset) - { - SLcurses_Acs_Map[SLSMG_ULCORN_CHAR] = SLSMG_ULCORN_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_URCORN_CHAR] = SLSMG_URCORN_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_LLCORN_CHAR] = SLSMG_LLCORN_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_LRCORN_CHAR] = SLSMG_LRCORN_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_UTEE_CHAR] = SLSMG_UTEE_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_DTEE_CHAR] = SLSMG_DTEE_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_LTEE_CHAR] = SLSMG_LTEE_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_RTEE_CHAR] = SLSMG_RTEE_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_VLINE_CHAR] = SLSMG_VLINE_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_HLINE_CHAR] = SLSMG_HLINE_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_PLUS_CHAR] = SLSMG_PLUS_CHAR | A_ALTCHARSET; - SLcurses_Acs_Map[SLSMG_CKBRD_CHAR] = SLSMG_CKBRD_CHAR | A_ALTCHARSET; - } - else - { - /* ugly defaults to use on terminals which don't support graphics */ - SLcurses_Acs_Map[SLSMG_ULCORN_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_URCORN_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_LLCORN_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_LRCORN_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_UTEE_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_DTEE_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_LTEE_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_RTEE_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_VLINE_CHAR] = '|'; - SLcurses_Acs_Map[SLSMG_HLINE_CHAR] = '-'; - SLcurses_Acs_Map[SLSMG_PLUS_CHAR] = '+'; - SLcurses_Acs_Map[SLSMG_CKBRD_CHAR] = '#'; - } - - return SLcurses_Stdscr; -} - -int SLcurses_wattrset (SLcurses_Window_Type *w, SLtt_Char_Type ch) -{ - unsigned int obj; - - obj = map_attr_to_object (ch); - w->color = obj; - w->attr = ch; - return 0; -} - -int SLcurses_wattroff (SLcurses_Window_Type *w, SLtt_Char_Type ch) -{ - if (SLtt_Use_Ansi_Colors) - return SLcurses_wattrset (w, 0); - - w->attr &= ~ch; - return SLcurses_wattrset (w, w->attr); -} - -int SLcurses_wattron (SLcurses_Window_Type *w, SLtt_Char_Type ch) -{ - if (SLtt_Use_Ansi_Colors) - return SLcurses_wattrset (w, ch); - - w->attr |= ch; - return SLcurses_wattrset (w, w->attr); -} - -int SLcurses_delwin (SLcurses_Window_Type *w) -{ - if (w == NULL) return 0; - if (w->lines != NULL) - { - SLsmg_Char_Type **lines = w->lines; - if (w->is_subwin == 0) - { - unsigned int r, rmax; - - rmax = w->nrows; - for (r = 0; r < rmax; r++) - { - SLfree ((char *)lines[r]); - } - } - - SLfree ((char *)lines); - } - - SLfree ((char *)w); - if (w == SLcurses_Stdscr) - SLcurses_Stdscr = NULL; - return 0; -} - -SLcurses_Window_Type *SLcurses_newwin (unsigned int nrows, unsigned int ncols, - unsigned int r, unsigned int c) -{ - SLcurses_Window_Type *win; - SLsmg_Char_Type **lines; - - if (r >= (unsigned int) SLtt_Screen_Rows) - return NULL; - if (c >= (unsigned int) SLtt_Screen_Cols) - return NULL; - - if (NULL == (win = (SLcurses_Window_Type *) SLmalloc (sizeof (SLcurses_Window_Type)))) - return NULL; - - SLMEMSET ((char *) win, 0, sizeof (SLcurses_Window_Type)); - - if (nrows == 0) - nrows = (unsigned int) SLtt_Screen_Rows - r; - if (ncols == 0) - ncols = (unsigned int) SLtt_Screen_Cols - c; - - lines = (SLsmg_Char_Type **) SLmalloc (nrows * sizeof (SLsmg_Char_Type *)); - if (lines == NULL) - { - SLcurses_delwin (win); - return NULL; - } - - SLMEMSET ((char *) lines, 0, nrows * sizeof (SLsmg_Char_Type *)); - - win->lines = lines; - win->scroll_max = win->nrows = nrows; - win->ncols = ncols; - win->_begy = r; - win->_begx = c; - win->_maxx = (c + ncols) - 1; - win->_maxy = (r + nrows) - 1; - win->modified = 1; - win->delay_off = -1; - - for (r = 0; r < nrows; r++) - { - SLsmg_Char_Type *b; - - b = (SLsmg_Char_Type *) SLmalloc (ncols * sizeof (SLsmg_Char_Type)); - if (b == NULL) - { - SLcurses_delwin (win); - return NULL; - } - lines [r] = b; - blank_line (b, ncols, 0); - } - - return win; -} - -int SLcurses_wmove (SLcurses_Window_Type *win, unsigned int r, unsigned int c) -{ - if (win == NULL) return -1; - win->_cury = r; - win->_curx = c; - win->modified = 1; - return 0; -} - -static int do_newline (SLcurses_Window_Type *w) -{ - w->_curx = 0; - w->_cury += 1; - if (w->_cury >= w->scroll_max) - { - w->_cury = w->scroll_max - 1; - if (w->scroll_ok) - SLcurses_wscrl (w, 1); - } - - return 0; -} - -int SLcurses_waddch (SLcurses_Window_Type *win, SLtt_Char_Type attr) -{ - SLsmg_Char_Type *b, ch; - SLsmg_Char_Type color; - - if (win == NULL) return -1; - - if (win->_cury >= win->nrows) - { - /* Curses seems to move current postion to top of window. */ - win->_cury = win->_curx = 0; - return -1; - } - - win->modified = 1; - - ch = SLSMG_EXTRACT_CHAR(attr); - - if (attr == ch) - color = win->color; - else - { - /* hack to pick up the default color for graphics chars */ - if (((attr & A_COLOR) == 0) && ((attr & A_ALTCHARSET) != 0)) - { - /* FIXME: priority=medium: Use SLSMG_?? instead of << */ - attr |= win->color << 8; - } - color = map_attr_to_object (attr); - } - - if (ch < ' ') - { - if (ch == '\n') - { - SLcurses_wclrtoeol (win); - return do_newline (win); - } - - if (ch == '\r') - { - win->_curx = 0; - return 0; - } - - if (ch == '\b') - { - if (win->_curx > 0) - win->_curx--; - - return 0; - } - - /* HACK HACK!!!! */ - if (ch == '\t') ch = ' '; - } - - if (win->_curx >= win->ncols) - do_newline (win); - - b = win->lines[win->_cury] + win->_curx; - *b = SLSMG_BUILD_CHAR(ch,color); - win->_curx++; - - return 0; -} - -int SLcurses_wnoutrefresh (SLcurses_Window_Type *w) -{ - unsigned int len; - unsigned int r, c; - unsigned int i, imax; - - if (SLcurses_Is_Endwin) - { - if (TTY_State) init_tty (TTY_State - 1); - SLsmg_resume_smg (); - SLcurses_Is_Endwin = 0; - } - - if (w == NULL) - { - SLsmg_refresh (); - return -1; - } - - if (w->modified == 0) - return 0; - - r = w->_begy; - c = w->_begx; - - len = w->ncols; - imax = w->nrows; - - for (i = 0; i < imax; i++) - { - SLsmg_gotorc (r, c); - SLsmg_write_color_chars (w->lines[i], len); - r++; - } - - if (w->has_box) - SLsmg_draw_box(w->_begy, w->_begx, w->nrows, w->ncols); - - SLsmg_gotorc (w->_begy + w->_cury, w->_begx + w->_curx); - w->modified = 0; - return 0; -} - -int SLcurses_wrefresh (SLcurses_Window_Type *w) -{ - if (w == NULL) - return -1; - - if (w->modified == 0) - return 0; - - SLcurses_wnoutrefresh (w); - SLsmg_refresh (); - return 0; -} - -int SLcurses_wclrtoeol (SLcurses_Window_Type *w) -{ - SLsmg_Char_Type *b, *bmax; - SLsmg_Char_Type blank; - - if (w == NULL) return -1; - if (w->_cury >= w->nrows) - return 0; - - w->modified = 1; - - blank = SLSMG_BUILD_CHAR(' ',w->color); - - b = w->lines[w->_cury]; - bmax = b + w->ncols; - b += w->_curx; - - while (b < bmax) *b++ = blank; - return 0; -} - -int SLcurses_wclrtobot (SLcurses_Window_Type *w) -{ - SLsmg_Char_Type *b, *bmax; - SLsmg_Char_Type blank; - unsigned int r; - - if (w == NULL) return -1; - - w->modified = 1; - blank = SLSMG_BUILD_CHAR(' ',w->color); - SLcurses_wclrtoeol (w); - for (r = w->_cury + 1; r < w->nrows; r++) - { - b = w->lines [r]; - bmax = b + w->ncols; - - while (b < bmax) *b++ = blank; - } - - return 0; -} - -int SLcurses_wscrl (SLcurses_Window_Type *w, int n) -{ - SLsmg_Char_Type **lines; - unsigned int r, rmax, rmin, ncols; - SLsmg_Char_Type color; - - if ((w == NULL) || (w->scroll_ok == 0)) - return -1; - - w->modified = 1; -#if 0 - if (w->is_subwin) - { - SLang_reset_tty (); - SLsmg_reset_smg (); - fprintf (stderr, "\rAttempt to scroll a subwindow\n"); - exit (1); - } -#endif - - color = w->color; - ncols = w->ncols; - lines = w->lines; - rmax = w->scroll_max; - rmin = w->scroll_min; - if (rmax > w->nrows) - rmax = w->nrows; - if (rmin >= rmax) - return 0; - - while (n > 0) - { - for (r = rmin + 1; r < rmax; r++) - { - /* lines[r - 1] = lines[r]; */ - memcpy ((char *)lines[r - 1], (char *)lines[r], - sizeof (SLsmg_Char_Type) * ncols); - } - blank_line (lines[rmax - 1], ncols, color); - n--; - } - - rmax--; - while (n < 0) - { - for (r = rmax; r > rmin; r--) - { - memcpy ((char *)lines[r], (char *)lines[r - 1], - sizeof (SLsmg_Char_Type) * ncols); - } - blank_line (lines[rmin], ncols, color); - n++; - } - - /* wmove (w, w->nrows - 1, 0); */ - /* wclrtobot (w); */ - return 0; -} - -/* Note: if len is < 0, entire string will be used. - */ -int SLcurses_waddnstr (SLcurses_Window_Type *w, char *str, int len) -{ - SLsmg_Char_Type *b; - SLsmg_Char_Type color; - unsigned char ch; - unsigned int nrows, ncols, crow, ccol; - - if ((w == NULL) - || (str == NULL)) - return -1; - - w->modified = 1; - nrows = w->nrows; - ncols = w->ncols; - crow = w->_cury; - ccol = w->_curx; - color = w->color; - - if (w->scroll_max <= nrows) - nrows = w->scroll_max; - - if (crow >= nrows) - crow = 0; /* wrap back to top */ - - b = w->lines [crow] + ccol; - - while (len && ((ch = (unsigned char) *str++) != 0)) - { - len--; - - if (ch == '\n') - { - w->_cury = crow; - w->_curx = ccol; - SLcurses_wclrtoeol (w); - do_newline (w); - crow = w->_cury; - ccol = w->_curx; - b = w->lines[crow]; - continue; - } - - if (ccol >= ncols) - { - ccol = 0; - crow++; - if (crow >= nrows) - { - w->_curx = 0; - w->_cury = crow; - do_newline (w); - crow = w->_cury; - ccol = w->_curx; - } - - b = w->lines [crow]; - } - - if (ch == '\t') - { - unsigned int n = ccol; - n += SLsmg_Tab_Width; - n = SLsmg_Tab_Width - (n % SLsmg_Tab_Width); - if (ccol + n > ncols) n = ncols - len; - ccol += n; - while (n--) - *b++ = SLSMG_BUILD_CHAR(' ',color); - continue; - } - - *b++ = SLSMG_BUILD_CHAR(ch, color); - ccol++; - } - - w->_curx = ccol; - w->_cury = crow; - - return 0; -} - -/* This routine IS NOT CORRECT. It needs to compute the proper overlap - * and copy accordingly. Here, I just assume windows are same size. - */ -#if 0 -int SLcurses_overlay (SLcurses_Window_Type *swin, SLcurses_Window_Type *dwin) -{ - SLsmg_Char_Type *s, *smax, *d, *dmax; - - if ((swin == NULL) || (dwin == NULL)) - return -1; - - s = swin->buf; - smax = swin->bufmax; - d = dwin->buf; - dmax = dwin->bufmax; - - while ((s < smax) && (d < dmax)) - { - SLsmg_Char_Type ch = *s++; - if (SLSMG_EXTRACT_CHAR(ch) != ' ') - *d = ch; - d++; - } - - return -1; /* not implemented */ -} - -#endif - -SLcurses_Window_Type *SLcurses_subwin (SLcurses_Window_Type *orig, - unsigned int nlines, unsigned int ncols, - unsigned int begin_y, unsigned int begin_x) -{ - SLcurses_Window_Type *sw; - int r, c; - unsigned int i; - - if (orig == NULL) - return NULL; - - sw = (SLcurses_Window_Type *) SLmalloc (sizeof (SLcurses_Window_Type)); - if (sw == NULL) - return NULL; - - SLMEMSET ((char *)sw, 0, sizeof (SLcurses_Window_Type)); -#if 1 - r = begin_y - orig->_begy; -#else - r = 1 + ((int)orig->nrows - (int)nlines) / 2; -#endif - if (r < 0) r = 0; - if (r + nlines > orig->nrows) nlines = orig->nrows - r; - - c = ((int)orig->ncols - (int)ncols) / 2; - if (c < 0) c = 0; - if (c + ncols > orig->ncols) ncols = orig->ncols - c; - - sw->scroll_min = 0; - sw->scroll_max = sw->nrows = nlines; - sw->ncols = ncols; - sw->_begy = begin_y; - sw->_begx = begin_x; - sw->_maxx = (begin_x + ncols) - 1; - sw->_maxy = (begin_y + nlines) - 1; - - sw->lines = (SLsmg_Char_Type **) SLmalloc (nlines * sizeof (SLsmg_Char_Type *)); - if (sw->lines == NULL) - { - SLcurses_delwin (sw); - return NULL; - } - - for (i = 0; i < nlines; i++) - { - sw->lines [i] = orig->lines [r + i] + c; - } - - sw->is_subwin = 1; - return sw; -} - -int SLcurses_wclear (SLcurses_Window_Type *w) -{ - unsigned int i; - - if (w != NULL) w->modified = 1; - for (i=0; i < w->nrows; i++) - blank_line (w->lines[i], w->ncols, w->color); - return 0; -} - -int SLcurses_wdelch (SLcurses_Window_Type *w) -{ - SLsmg_Char_Type *p, *p1, *pmax; - - p = w->lines[w->_cury]; - pmax = p + w->ncols; - p += w->_curx; - p1 = p + 1; - - while (p1 < pmax) - { - *p = *p1; - p = p1; - p1++; - } - - if (p < pmax) - *p = SLSMG_BUILD_CHAR(' ',w->color); - - w->modified = 1; - return 0; -} - -int SLcurses_winsch (SLcurses_Window_Type *w, int ch) -{ - SLsmg_Char_Type *p, *p1, *pmax; - - p = w->lines[w->_cury]; - pmax = p + w->ncols; - p += w->_curx; - p1 = pmax - 1; - - while (pmax > p) - { - *pmax = *p1; - pmax = p1; - p1--; - } - - if (p < pmax) - *p = SLSMG_BUILD_CHAR(ch, w->color); - - w->modified = 1; - return 0; -} - -int SLcurses_endwin (void) -{ - SLcurses_Is_Endwin = 1; - SLsmg_suspend_smg (); - SLang_reset_tty (); - return 0; -} - -#if 0 -int SLcurses_mvwscanw (SLcurses_Window_Type *w, unsigned int r, unsigned int c, - char *fmt, ...) -{ -#if HAVE_VFSCANF - int ret; - va_list ap; - - SLcurses_wmove (w, r, c); - SLcurses_wrefresh (w); - - va_start(ap, fmt); - ret = vfscanf (stdin, fmt, ap); - va_end(ap); - return ret; -#else - return 0; -#endif -} - -int SLcurses_wscanw (SLcurses_Window_Type *w, char *fmt, ...) -{ -#if HAVE_VFSCANF - va_list ap; - int ret; - - SLcurses_wrefresh (w); - - va_start(ap, fmt); - ret = vfscanf (stdin, fmt, ap); - va_end(ap); - - return ret; -#else - return 0; -#endif -} - -int SLcurses_scanw (char *fmt, ...) -{ -#ifdef HAVE_VFSCANF - va_list ap; - int ret; - - SLcurses_wrefresh (SLcurses_Stdscr); - - va_start(ap, fmt); - ret = vfscanf (stdin, fmt, ap); - va_end(ap); - - return ret; -#else - return 0; -#endif -} -#endif - -int SLcurses_clearok (SLcurses_Window_Type *w, int bf) -{ - if (bf) - { - SLsmg_cls (); - w->modified = 1; - } - return 0; -} diff --git a/mdk-stage1/slang/slcurses.h b/mdk-stage1/slang/slcurses.h deleted file mode 100644 index fa082304f..000000000 --- a/mdk-stage1/slang/slcurses.h +++ /dev/null @@ -1,353 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include <stdio.h> - -#ifndef SLANG_VERSION -# include <slang.h> -#endif - -/* This is a temporary hack until lynx is fixed to not include this file. */ -#ifndef LYCURSES_H - -typedef struct -{ - unsigned int _begy, _begx, _maxy, _maxx; - unsigned int _curx, _cury; - unsigned int nrows, ncols; - unsigned int scroll_min, scroll_max; - SLsmg_Char_Type **lines; - SLsmg_Char_Type color; - int is_subwin; - SLtt_Char_Type attr; - int delay_off; - int scroll_ok; - int modified; - int has_box; - int use_keypad; -} -SLcurses_Window_Type; - -extern int SLcurses_wclrtobot (SLcurses_Window_Type *); -extern int SLcurses_wscrl (SLcurses_Window_Type *, int); -extern int SLcurses_wrefresh (SLcurses_Window_Type *); -extern int SLcurses_delwin (SLcurses_Window_Type *); -extern int SLcurses_wprintw (SLcurses_Window_Type *, char *, ...); -extern SLcurses_Window_Type *SLcurses_newwin (unsigned int, unsigned int, - unsigned int, unsigned int); - -extern SLcurses_Window_Type *SLcurses_subwin (SLcurses_Window_Type *, - unsigned int, unsigned int, - unsigned int, unsigned int); - -extern int SLcurses_wnoutrefresh (SLcurses_Window_Type *); -extern int SLcurses_wclrtoeol (SLcurses_Window_Type *); - -extern int SLcurses_wmove (SLcurses_Window_Type *, unsigned int, unsigned int); -extern int SLcurses_waddch (SLcurses_Window_Type *, SLtt_Char_Type); -extern int SLcurses_waddnstr (SLcurses_Window_Type *, char *, int); - -#define waddnstr SLcurses_waddnstr -#define waddch SLcurses_waddch -#define waddstr(w,s) waddnstr((w),(s),-1) -#define addstr(x) waddstr(stdscr, (x)) -#define addnstr(s,n) waddnstr(stdscr,(s),(n)) -#define addch(ch) waddch(stdscr,(ch)) - -#define mvwaddnstr(w,y,x,s,n) \ - (-1 == wmove((w),(y),(x)) ? -1 : waddnstr((w),(s),(n))) -#define mvwaddstr(w,y,x,s) \ - (-1 == wmove((w),(y),(x)) ? -1 : waddnstr((w),(s), -1)) -#define mvaddnstr(y,x,s,n) mvwaddnstr(stdscr,(y),(x),(s),(n)) -#define mvaddstr(y,x,s) mvwaddstr(stdscr,(y),(x),(s)) -#define mvwaddch(w,y,x,c) \ - ((-1 == wmove((w),(y),(x))) ? -1 : waddch((w),(c))) -#define mvaddch(y,x,c) mvwaddch(stdscr,(y),(x),(c)) - -extern int SLcurses_wclear (SLcurses_Window_Type *w); -extern int SLcurses_printw (char *, ...); - -#if 0 -/* Why are these functions part of curses??? */ -extern int SLcurses_mvwscanw (SLcurses_Window_Type *, unsigned int, unsigned int, - char *, ...); -extern int SLcurses_wscanw (SLcurses_Window_Type *, char *, ...); -extern int SLcurses_scanw (char *, ...); -#define mvwscanw SLcurses_mvwscanw -#define wscanw SLcurses_wscanw -#define scanw SLcurses_scanw -#endif - -extern SLcurses_Window_Type *SLcurses_Stdscr; -#define WINDOW SLcurses_Window_Type -#define stdscr SLcurses_Stdscr - -#define subwin SLcurses_subwin -#define wclrtobot SLcurses_wclrtobot -#define wscrl SLcurses_wscrl -#define scrl(n) wscrl(stdscr,(n)) -#define scroll(w) wscrl((w),1) -#define wrefresh SLcurses_wrefresh -#define delwin SLcurses_delwin -#define wmove SLcurses_wmove -#define newwin SLcurses_newwin -#define wnoutrefresh SLcurses_wnoutrefresh -#define werase(w) SLcurses_wmove((w),0,0); SLcurses_wclrtobot(w) -#define wclear(w) SLcurses_wmove((w),0,0); SLcurses_wclrtobot(w) -#define wprintw SLcurses_wprintw -#define mvwprintw SLcurses_mvwprintw - -#define winch(w) \ - ((((w)->_cury < (w)->nrows) && ((w)->_curx < (w)->ncols)) \ - ? ((w)->lines[(w)->_cury][(w)->_curx]) : 0) - -#define inch() winch(stdscr) -#define mvwinch(w,x,y) \ - ((-1 != wmove((w),(x),(y))) ? winch(w) : (-1)) -#define doupdate SLsmg_refresh - -#define mvwin(w,a,b) ((w)->_begy = (a), (w)->_begx = (b)) - -extern int SLcurses_mvprintw (int, int, char *, ...); -extern int SLcurses_mvwprintw (SLcurses_Window_Type *, int, int, char *, ...); -extern int SLcurses_has_colors(void); -extern int SLcurses_nil (void); -extern int SLcurses_wgetch (SLcurses_Window_Type *); -extern int SLcurses_getch (void); - -extern int SLcurses_wattrset (SLcurses_Window_Type *, SLtt_Char_Type); -extern int SLcurses_wattron (SLcurses_Window_Type *, SLtt_Char_Type); -extern int SLcurses_wattroff (SLcurses_Window_Type *, SLtt_Char_Type); -#define attrset(x) SLcurses_wattrset(stdscr, (x)) -#define attron(x) SLcurses_wattron(stdscr, (x)) -#define attroff(x) SLcurses_wattroff(stdscr, (x)) -#define wattrset(w, x) SLcurses_wattrset((w), (x)) -#define wattron(w, x) SLcurses_wattron((w), (x)) -#define wattroff(w, x) SLcurses_wattroff((w), (x)) -#define wattr_get(w) ((w)->color << 8) -#define attr_get() wattr_get(stdscr) - -#define COLOR_PAIR(x) ((x) << 8) - -extern int SLcurses_start_color (void); -#define start_color SLcurses_start_color - -#define ERR 0xFFFF -#define wgetch SLcurses_wgetch -#define getch SLcurses_getch - -extern int SLcurses_nodelay (SLcurses_Window_Type *, int); -extern SLcurses_Window_Type *SLcurses_initscr (void); -#define initscr SLcurses_initscr - -extern int SLcurses_cbreak (void); -extern int SLcurses_raw (void); -#define cbreak SLcurses_cbreak -#define crmode SLcurses_cbreak -#define raw SLcurses_raw -#define noraw SLang_reset_tty -#define nocbreak SLang_reset_tty - -#define mvprintw SLcurses_mvprintw -#define has_colors SLcurses_has_colors -#define nodelay SLcurses_nodelay - -#define ungetch SLang_ungetkey - -#define COLS SLtt_Screen_Cols -#define LINES SLtt_Screen_Rows - -#define move(x,y) SLcurses_wmove(stdscr, (x), (y)) -#define wclrtoeol SLcurses_wclrtoeol -#define clrtoeol() SLcurses_wclrtoeol(stdscr) -#define clrtobot() SLcurses_wclrtobot(stdscr) - -#define printw SLcurses_printw -#define mvprintw SLcurses_mvprintw -#define wstandout(w) SLcurses_wattrset((w),A_STANDOUT) -#define wstandend(w) SLcurses_wattrset((w),A_NORMAL) -#define standout() SLcurses_wattrset(stdscr,A_STANDOUT) -#define standend() SLcurses_wattrset(stdscr,A_NORMAL) - -#define refresh() SLcurses_wrefresh(stdscr) -#define clear() SLcurses_wclear(stdscr) -#define erase() werase(stdscr) -#define touchline SLsmg_touch_lines -#define resetterm SLang_reset_tty - -extern int SLcurses_endwin (void); -#define endwin SLcurses_endwin -extern int SLcurses_Is_Endwin; -#define isendwin() SLcurses_Is_Endwin - -#define keypad(w,x) ((w)->use_keypad = (x)) - -#define KEY_MIN SL_KEY_UP -#define KEY_DOWN SL_KEY_DOWN -#define KEY_UP SL_KEY_UP -#define KEY_LEFT SL_KEY_LEFT -#define KEY_RIGHT SL_KEY_RIGHT -#define KEY_A1 SL_KEY_A1 -#define KEY_B1 SL_KEY_B1 -#define KEY_C1 SL_KEY_C1 -#define KEY_A2 SL_KEY_A2 -#define KEY_B2 SL_KEY_B2 -#define KEY_C2 SL_KEY_C2 -#define KEY_A3 SL_KEY_A3 -#define KEY_B3 SL_KEY_B3 -#define KEY_C3 SL_KEY_C3 -#define KEY_REDO SL_KEY_REDO -#define KEY_UNDO SL_KEY_UNDO -#define KEY_BACKSPACE SL_KEY_BACKSPACE -#define KEY_PPAGE SL_KEY_PPAGE -#define KEY_NPAGE SL_KEY_NPAGE -#define KEY_HOME SL_KEY_HOME -#define KEY_END SL_KEY_END -#define KEY_F0 SL_KEY_F0 -#define KEY_F SL_KEY_F -#define KEY_ENTER SL_KEY_ENTER -#define KEY_MAX 0xFFFF - -/* Ugly Hacks that may not work */ -#define flushinp SLcurses_nil -#define winsertln(w) \ - ((w)->scroll_min=(w)->_cury, \ - (w)->scroll_max=(w)->nrows, \ - wscrl((w), -1)) - -extern SLtt_Char_Type SLcurses_Acs_Map [128]; -#define acs_map SLcurses_Acs_Map - -#define ACS_ULCORNER (acs_map[SLSMG_ULCORN_CHAR]) -#define ACS_URCORNER (acs_map[SLSMG_URCORN_CHAR]) -#define ACS_LRCORNER (acs_map[SLSMG_LRCORN_CHAR]) -#define ACS_LLCORNER (acs_map[SLSMG_LLCORN_CHAR]) -#define ACS_TTEE (acs_map[SLSMG_UTEE_CHAR]) -#define ACS_LTEE (acs_map[SLSMG_LTEE_CHAR]) -#define ACS_RTEE (acs_map[SLSMG_RTEE_CHAR]) -#define ACS_BTEE (acs_map[SLSMG_DTEE_CHAR]) -#define ACS_PLUS (acs_map[SLSMG_PLUS_CHAR]) -#define ACS_VLINE (acs_map[SLSMG_VLINE_CHAR]) -#define ACS_HLINE (acs_map[SLSMG_HLINE_CHAR]) -#define ACS_S1 '-' -#define ACS_S9 '-' -#define ACS_DIAMOND '&' -#define ACS_CKBOARD (acs_map[SLSMG_CKBRD_CHAR]) -#define ACS_DEGREE 'o' -#define ACS_PLMINUS '+' -#define ACS_BULLET '*' -#define ACS_LARROW '<' -#define ACS_RARROW '>' -#define ACS_DARROW 'v' -#define ACS_UARROW '^' -#define ACS_BOARD '#' -#define ACS_LANTERN '#' -#define ACS_BLOCK '#' - -#if 1 -#define hline(x,y) SLcurses_nil () -#define vline(x,y) SLcurses_nil () -#endif - -#define A_CHARTEXT 0x00FF -#define A_NORMAL 0 -#define A_BOLD 0x1000 -#define A_REVERSE 0x2000 -#define A_STANDOUT A_REVERSE -#define A_UNDERLINE 0x4000 -#define A_BLINK 0 -#define A_COLOR 0x0700 -#define A_ALTCHARSET 0x8000 -#define A_DIM 0 -#define A_PROTECT 0 -#define A_INVIS 0 - -#define COLOR_BLACK SLSMG_COLOR_BLACK -#define COLOR_RED SLSMG_COLOR_RED -#define COLOR_GREEN SLSMG_COLOR_GREEN -#define COLOR_YELLOW SLSMG_COLOR_BROWN -#define COLOR_BLUE SLSMG_COLOR_BLUE -#define COLOR_MAGENTA SLSMG_COLOR_MAGENTA -#define COLOR_CYAN SLSMG_COLOR_CYAN -#define COLOR_WHITE SLSMG_COLOR_LGRAY - -extern int SLcurses_Num_Colors; -#define COLORS SLcurses_Num_Colors -#define COLOR_PAIRS (SLcurses_Num_Colors*SLcurses_Num_Colors) - -#define init_pair(_x,_f,_b) \ - SLtt_set_color_object((_x), ((_f) == (_b) ? 0x0700 : ((_f) | ((_b) << 8)) << 8)) - -#define scrollok(a,b) ((a)->scroll_ok = (b)) -#define getyx(a,y,x) (y=(a)->_cury, x=(a)->_curx) -#define getmaxyx(a,y,x) (y=(a)->nrows, x=(a)->ncols) -#define napms(x) usleep(1000 * (x)) -typedef SLtt_Char_Type chtype; -#define beep SLtt_beep -#define curs_set(x) SLtt_set_cursor_visibility(x) -#define touchwin(x) SLsmg_touch_lines((x)->_begy, (x)->nrows) -#define flash SLtt_beep - -#define wsetscrreg(w,a,b) ((w)->scroll_min = (a), (w)->scroll_max = (b)) - -#define wtimeout(a,b) (a)->delay_off = ((b >= 0) ? (b) / 100 : -1) -#define timeout(a) wtimeout(stdscr, a) -extern int SLcurses_wdelch (SLcurses_Window_Type *); -#define wdelch SLcurses_wdelch -#define delch() wdelch(stdscr) - -extern int SLcurses_winsch (SLcurses_Window_Type *, int); -#define winsch SLcurses_winsch - -extern int SLcurses_Esc_Delay;/* ESC expire time in milliseconds (ncurses compatible) */ -#define ESCDELAY SLcurses_Esc_Delay - -extern int SLcurses_clearok (SLcurses_Window_Type *, int); -#define clearok SLcurses_clearok - -/* Functions that have not been implemented. */ -#define copywin(w,v,a,b,c,d,e,f,g) SLcurses_nil() -#define wdeleteln(win) SLcurses_nil() -#define resetty SLcurses_nil -#define savetty SLcurses_nil -#define overlay(u,v) SLcurses_nil() - -/* These functions do nothing */ -#define savetty SLcurses_nil -#define nonl SLcurses_nil -#define echo SLcurses_nil -#define noecho SLcurses_nil -#define saveterm SLcurses_nil -#define box(w,y,z) ((w)->has_box = 1, (w)->modified = 1) -#define leaveok(a,b) SLcurses_nil() -#define nl() SLcurses_nil() -#define trace(x) SLcurses_nil() -#define tigetstr(x) NULL - -/* These have no place in C */ -#define TRUE 1 -#define FALSE 0 -#define bool int - -/* Lynx compatability */ -#else - -#define stdscr NULL -#define COLS SLtt_Screen_Cols -#define LINES SLtt_Screen_Rows -#define move SLsmg_gotorc -#define addstr SLsmg_write_string -#define clear SLsmg_cls -#define standout SLsmg_reverse_video -#define standend SLsmg_normal_video -#define clrtoeol SLsmg_erase_eol -#define scrollok(a,b) SLsmg_Newline_Moves = ((b) ? 1 : -1) -#define addch SLsmg_write_char -#define echo() -#define printw SLsmg_printf -#define endwin SLsmg_reset_smg(),SLang_reset_tty - -#endif diff --git a/mdk-stage1/slang/sldisply.c b/mdk-stage1/slang/sldisply.c deleted file mode 100644 index 1e1161774..000000000 --- a/mdk-stage1/slang/sldisply.c +++ /dev/null @@ -1,2596 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include <time.h> -#include <ctype.h> - -#if !defined(VMS) || (__VMS_VER >= 70000000) -# include <sys/time.h> -# ifdef __QNX__ -# include <sys/select.h> -# endif -# include <sys/types.h> -#endif - -#ifdef __BEOS__ -/* Prototype for select */ -# include <net/socket.h> -#endif - -#ifdef HAVE_TERMIOS_H -# include <termios.h> -#endif - -#ifdef VMS -# include <unixlib.h> -# include <unixio.h> -# include <dvidef.h> -# include <descrip.h> -# include <lib$routines.h> -# include <starlet.h> -#else -# if !defined(sun) -# include <sys/ioctl.h> -# endif -#endif - -#ifdef SYSV -# include <sys/termio.h> -# include <sys/stream.h> -# include <sys/ptem.h> -# include <sys/tty.h> -#endif - -#if defined (_AIX) && !defined (FD_SET) -# include <sys/select.h> /* for FD_ISSET, FD_SET, FD_ZERO */ -#endif - -#include <errno.h> - -#if defined(__DECC) && defined(VMS) -/* These get prototypes for write an sleep */ -# include <unixio.h> -#endif -#include <signal.h> - -#include "slang.h" -#include "_slang.h" - -/* Colors: These definitions are used for the display. However, the - * application only uses object handles which get mapped to this - * internal representation. The mapping is performed by the Color_Map - * structure below. */ - -#define CHAR_MASK 0x000000FF -#define FG_MASK 0x0000FF00 -#define BG_MASK 0x00FF0000 -#define ATTR_MASK 0x1F000000 -#define BGALL_MASK 0x0FFF0000 - -/* The 0x10000000 bit represents the alternate character set. BGALL_MASK does - * not include this attribute. - */ - -#define GET_FG(color) ((color & FG_MASK) >> 8) -#define GET_BG(color) ((color & BG_MASK) >> 16) -#define MAKE_COLOR(fg, bg) (((fg) | ((bg) << 8)) << 8) - -int SLtt_Screen_Cols; -int SLtt_Screen_Rows; -int SLtt_Term_Cannot_Insert; -int SLtt_Term_Cannot_Scroll; -int SLtt_Use_Ansi_Colors; -int SLtt_Blink_Mode = 1; -int SLtt_Use_Blink_For_ACS = 0; -int SLtt_Newline_Ok = 0; -int SLtt_Has_Alt_Charset = 0; -int SLtt_Force_Keypad_Init = 0; - -void (*_SLtt_color_changed_hook)(void); - -#if SLTT_HAS_NON_BCE_SUPPORT -static int Bce_Color_Offset = 0; -#endif -static int Can_Background_Color_Erase = 1; - -/* -1 means unknown */ -int SLtt_Has_Status_Line = -1; /* hs */ -int SLang_TT_Write_FD = -1; - -static int Automatic_Margins; -/* static int No_Move_In_Standout; */ -static int Worthless_Highlight; -#define HP_GLITCH_CODE -#ifdef HP_GLITCH_CODE -/* This glitch is exclusive to HP term. Basically it means that to clear - * attributes, one has to erase to the end of the line. - */ -static int Has_HP_Glitch; -#endif - -static char *Reset_Color_String; -static int Is_Color_Terminal = 0; - -static int Linux_Console; - -/* It is crucial that JMAX_COLORS must be less than 128 since the high bit - * is used to indicate a character from the ACS (alt char set). The exception - * to this rule is if SLtt_Use_Blink_For_ACS is true. This means that of - * the highbit is set, we interpret that as a blink character. This is - * exploited by DOSemu. - */ -#define JMAX_COLORS 256 -#define JNORMAL_COLOR 0 - -typedef struct -{ - SLtt_Char_Type fgbg; - SLtt_Char_Type mono; - char *custom_esc; -} -Ansi_Color_Type; - -#define RGB1(r, g, b) ((r) | ((g) << 1) | ((b) << 2)) -#define RGB(r, g, b, br, bg, bb) ((RGB1(r, g, b) << 8) | (RGB1(br, bg, bb) << 16)) - -static Ansi_Color_Type Ansi_Color_Map[JMAX_COLORS] = -{ - {RGB(1, 1, 1, 0, 0, 0), 0x00000000, NULL}, /* white/black */ - {RGB(0, 1, 0, 0, 0, 0), SLTT_REV_MASK, NULL}, /* green/black */ - {RGB(1, 0, 1, 0, 0, 0), SLTT_REV_MASK, NULL}, /* magenta/black */ - {RGB(0, 1, 1, 0, 0, 0), SLTT_REV_MASK, NULL}, /* cyan/black */ - {RGB(1, 0, 0, 0, 0, 0), SLTT_REV_MASK, NULL}, - {RGB(0, 1, 0, 0, 0, 1), SLTT_REV_MASK, NULL}, - {RGB(1, 0, 0, 0, 0, 1), SLTT_REV_MASK, NULL}, - {RGB(1, 0, 0, 0, 1, 0), SLTT_REV_MASK, NULL}, - {RGB(0, 0, 1, 1, 0, 0), SLTT_REV_MASK, NULL}, - {RGB(0, 1, 0, 1, 0, 0), SLTT_REV_MASK, NULL}, - {RGB(0, 1, 1, 1, 1, 1), SLTT_REV_MASK, NULL}, - {RGB(1, 1, 0, 1, 1, 1), SLTT_REV_MASK, NULL}, - {RGB(1, 0, 1, 1, 1, 1), SLTT_REV_MASK, NULL}, - {RGB(0, 0, 0, 0, 1, 1), SLTT_REV_MASK, NULL}, - {RGB(0, 1, 0, 1, 1, 1), SLTT_REV_MASK, NULL}, - {RGB(0, 1, 0, 1, 1, 1), SLTT_REV_MASK, NULL}, - {RGB(0, 1, 0, 1, 1, 1), SLTT_REV_MASK, NULL}, - {RGB(0, 1, 0, 1, 1, 1), SLTT_REV_MASK, NULL} -}; - -static char *Color_Fg_Str = "\033[3%dm"; -static char *Color_Bg_Str = "\033[4%dm"; -static char *Default_Color_Fg_Str = "\033[39m"; -static char *Default_Color_Bg_Str = "\033[49m"; - -static int Max_Terminfo_Colors = 8; /* termcap Co */ - -char *SLtt_Graphics_Char_Pairs; /* ac termcap string -- def is vt100 */ - -/* 1 if terminal lacks the ability to go into insert mode or into delete - mode. Currently controlled by S-Lang but later perhaps termcap. */ - -static char *UnderLine_Vid_Str; -static char *Blink_Vid_Str; -static char *Bold_Vid_Str; -static char *Ins_Mode_Str; /* = "\033[4h"; */ /* ins mode (im) */ -static char *Eins_Mode_Str; /* = "\033[4l"; */ /* end ins mode (ei) */ -static char *Scroll_R_Str; /* = "\033[%d;%dr"; */ /* scroll region */ -static char *Cls_Str; /* = "\033[2J\033[H"; */ /* cl termcap STR for ansi terminals */ -static char *Rev_Vid_Str; /* = "\033[7m"; */ /* mr,so termcap string */ -static char *Norm_Vid_Str; /* = "\033[m"; */ /* me,se termcap string */ -static char *Del_Eol_Str; /* = "\033[K"; */ /* ce */ -static char *Del_Bol_Str; /* = "\033[1K"; */ /* cb */ -static char *Del_Char_Str; /* = "\033[P"; */ /* dc */ -static char *Del_N_Lines_Str; /* = "\033[%dM"; */ /* DL */ -static char *Add_N_Lines_Str; /* = "\033[%dL"; */ /* AL */ -static char *Rev_Scroll_Str; -static char *Curs_Up_Str; -static char *Curs_F_Str; /* RI termcap string */ -static char *Cursor_Visible_Str; /* ve termcap string */ -static char *Cursor_Invisible_Str; /* vi termcap string */ -#if 0 -static char *Start_Mouse_Rpt_Str; /* Start mouse reporting mode */ -static char *End_Mouse_Rpt_Str; /* End mouse reporting mode */ -#endif -static char *Start_Alt_Chars_Str; /* as */ -static char *End_Alt_Chars_Str; /* ae */ -static char *Enable_Alt_Char_Set; /* eA */ - -static char *Term_Init_Str; -static char *Keypad_Init_Str; -static char *Term_Reset_Str; -static char *Keypad_Reset_Str; - -/* status line functions */ -static char *Disable_Status_line_Str; /* ds */ -static char *Return_From_Status_Line_Str; /* fs */ -static char *Goto_Status_Line_Str; /* ts */ -static int Num_Status_Line_Columns; /* ws */ -/* static int Status_Line_Esc_Ok; */ /* es */ - -/* static int Len_Curs_F_Str = 5; */ - -/* cm string has %i%d since termcap numbers columns from 0 */ -/* char *CURS_POS_STR = "\033[%d;%df"; ansi-- hor and vert pos */ -static char *Curs_Pos_Str; /* = "\033[%i%d;%dH";*/ /* cm termcap string */ - -/* scrolling region */ -static int Scroll_r1 = 0, Scroll_r2 = 23; -static int Cursor_r, Cursor_c; /* 0 based */ - -/* current attributes --- initialized to impossible value */ -static SLtt_Char_Type Current_Fgbg = 0xFFFFFFFFU; - -static int Cursor_Set; /* 1 if cursor position known, 0 - * if not. -1 if only row is known - */ - -#define MAX_OUTPUT_BUFFER_SIZE 4096 - -static unsigned char Output_Buffer[MAX_OUTPUT_BUFFER_SIZE]; -static unsigned char *Output_Bufferp = Output_Buffer; - -unsigned long SLtt_Num_Chars_Output; - -int _SLusleep (unsigned long usecs) -{ -#if !defined(VMS) || (__VMS_VER >= 70000000) - struct timeval tv; - tv.tv_sec = usecs / 1000000; - tv.tv_usec = usecs % 1000000; - return select(0, NULL, NULL, NULL, &tv); -#else - return 0; -#endif -} - -int SLtt_flush_output (void) -{ - int nwrite = 0; - unsigned int total; - int n = (int) (Output_Bufferp - Output_Buffer); - - SLtt_Num_Chars_Output += n; - - total = 0; - while (n > 0) - { - nwrite = write (SLang_TT_Write_FD, (char *) Output_Buffer + total, n); - if (nwrite == -1) - { - nwrite = 0; -#ifdef EAGAIN - if (errno == EAGAIN) - { - _SLusleep (100000); /* 1/10 sec */ - continue; - } -#endif -#ifdef EWOULDBLOCK - if (errno == EWOULDBLOCK) - { - _SLusleep (100000); - continue; - } -#endif -#ifdef EINTR - if (errno == EINTR) continue; -#endif - break; - } - n -= nwrite; - total += nwrite; - } - Output_Bufferp = Output_Buffer; - return n; -} - -int SLtt_Baud_Rate; -static void tt_write(char *str, unsigned int n) -{ - static unsigned long last_time; - static int total; - unsigned long now; - unsigned int ndiff; - - if ((str == NULL) || (n == 0)) return; - total += n; - - while (1) - { - ndiff = MAX_OUTPUT_BUFFER_SIZE - (int) (Output_Bufferp - Output_Buffer); - if (ndiff < n) - { - SLMEMCPY ((char *) Output_Bufferp, (char *) str, ndiff); - Output_Bufferp += ndiff; - SLtt_flush_output (); - n -= ndiff; - str += ndiff; - } - else - { - SLMEMCPY ((char *) Output_Bufferp, str, n); - Output_Bufferp += n; - break; - } - } - - if (((SLtt_Baud_Rate > 150) && (SLtt_Baud_Rate <= 9600)) - && (10 * total > SLtt_Baud_Rate)) - { - total = 0; - if ((now = (unsigned long) time(NULL)) - last_time <= 1) - { - SLtt_flush_output (); - sleep((unsigned) 1); - } - last_time = now; - } -} - -static void tt_write_string (char *str) -{ - if (str != NULL) tt_write(str, strlen(str)); -} - -void SLtt_write_string (char *str) -{ - tt_write_string (str); - Cursor_Set = 0; -} - -void SLtt_putchar (char ch) -{ - SLtt_normal_video (); - if (Cursor_Set == 1) - { - if (ch >= ' ') Cursor_c++; - else if (ch == '\b') Cursor_c--; - else if (ch == '\r') Cursor_c = 0; - else Cursor_Set = 0; - - if ((Cursor_c + 1 == SLtt_Screen_Cols) - && Automatic_Margins) Cursor_Set = 0; - } - - if (Output_Bufferp < Output_Buffer + MAX_OUTPUT_BUFFER_SIZE) - { - *Output_Bufferp++ = (unsigned char) ch; - } - else tt_write (&ch, 1); -} - -static unsigned int tt_sprintf(char *buf, char *fmt, int x, int y) -{ - char *fmt_max; - register unsigned char *b, ch; - int offset; - int z, z1, parse_level; - int zero_pad; - int field_width; - int variables [26]; - int stack [64]; - unsigned int stack_len; - int parms [10]; -#define STACK_POP (stack_len ? stack[--stack_len] : 0) - - if (fmt == NULL) - { - *buf = 0; - return 0; - } - - stack [0] = y; /* pushed for termcap */ - stack [1] = x; - stack_len = 2; - - parms [1] = x; /* p1 */ - parms [2] = y; /* p2 */ - - offset = 0; - zero_pad = 0; - field_width = 0; - - b = (unsigned char *) buf; - fmt_max = fmt + strlen (fmt); - - while (fmt < fmt_max) - { - ch = *fmt++; - - if (ch != '%') - { - *b++ = ch; - continue; - } - - if (fmt == fmt_max) break; - ch = *fmt++; - - switch (ch) - { - default: - *b++ = ch; - break; - - case 'p': - - if (fmt == fmt_max) break; - ch = *fmt++; - if ((ch >= '0') && (ch <= '9')) - stack [stack_len++] = parms [ch - '0']; - break; - - case '\'': /* 'x' */ - if (fmt == fmt_max) break; - stack [stack_len++] = *fmt++; - if (fmt < fmt_max) fmt++; /* skip ' */ - break; - - case '{': /* literal constant, e.g. {30} */ - z = 0; - while ((fmt < fmt_max) && ((ch = *fmt) <= '9') && (ch >= '0')) - { - z = z * 10 + (ch - '0'); - fmt++; - } - stack [stack_len++] = z; - if ((ch == '}') && (fmt < fmt_max)) fmt++; - break; - - case '0': - if (fmt == fmt_max) break; - ch = *fmt; - if ((ch != '2') && (ch != '3')) - break; - zero_pad = 1; - fmt++; - /* drop */ - - case '2': - case '3': - if (fmt == fmt_max) - if (*fmt == 'x') - { - char x_fmt_buf [4]; - char *x_fmt_buf_ptr; - - x_fmt_buf_ptr = x_fmt_buf; - if (zero_pad) *x_fmt_buf_ptr++ = '0'; - *x_fmt_buf_ptr++ = ch; - *x_fmt_buf_ptr++ = 'X'; - *x_fmt_buf_ptr = 0; - - z = STACK_POP; - z += offset; - - sprintf ((char *)b, x_fmt_buf, z); - b += strlen ((char *)b); - zero_pad = 0; - break; - } - - field_width = (ch - '0'); - /* drop */ - - case 'd': - z = STACK_POP; - z += offset; - if (z >= 100) - { - *b++ = z / 100 + '0'; - z = z % 100; - zero_pad = 1; - field_width = 2; - } - else if (zero_pad && (field_width == 3)) - *b++ = '0'; - - if (z >= 10) - { - *b++ = z / 10 + '0'; - z = z % 10; - } - else if (zero_pad && (field_width >= 2)) - *b++ = '0'; - - *b++ = z + '0'; - field_width = zero_pad = 0; - break; - - case 'x': - z = STACK_POP; - z += offset; - sprintf ((char *) b, "%X", z); - b += strlen ((char *)b); - break; - - case 'i': - offset = 1; - break; - - case '+': - /* Handling this depends upon whether or not we are parsing - * terminfo. Terminfo requires the stack so use it as an - * indicator. - */ - if (stack_len > 2) - { - z = STACK_POP; - stack [stack_len - 1] += z; - } - else if (fmt < fmt_max) - { - ch = *fmt++; - if ((unsigned char) ch == 128) ch = 0; - ch = ch + (unsigned char) STACK_POP; - if (ch == '\n') ch++; - *b++ = ch; - } - break; - - /* Binary operators */ - case '-': - case '*': - case '/': - case 'm': - case '&': - case '|': - case '^': - case '=': - case '>': - case '<': - case 'A': - case 'O': - z1 = STACK_POP; - z = STACK_POP; - switch (ch) - { - case '-': z = (z - z1); break; - case '*': z = (z * z1); break; - case '/': z = (z / z1); break; - case 'm': z = (z % z1); break; - case '&': z = (z & z1); break; - case '|': z = (z | z1); break; - case '^': z = (z ^ z1); break; - case '=': z = (z == z1); break; - case '>': z = (z > z1); break; - case '<': z = (z < z1); break; - case 'A': z = (z && z1); break; - case 'O': z = (z || z1); break; - } - stack [stack_len++] = z; - break; - - /* unary */ - case '!': - z = STACK_POP; - stack [stack_len++] = !z; - break; - - case '~': - z = STACK_POP; - stack [stack_len++] = ~z; - break; - - case 'r': /* termcap -- swap parameters */ - z = stack [0]; - stack [0] = stack [1]; - stack [1] = z; - break; - - case '.': /* termcap */ - case 'c': - ch = (unsigned char) STACK_POP; - if (ch == '\n') ch++; - *b++ = ch; - break; - - case 'g': - if (fmt == fmt_max) break; - ch = *fmt++; - if ((ch >= 'a') && (ch <= 'z')) - stack [stack_len++] = variables [ch - 'a']; - break; - - case 'P': - if (fmt == fmt_max) break; - ch = *fmt++; - if ((ch >= 'a') && (ch <= 'z')) - variables [ch - 'a'] = STACK_POP; - break; - - /* If then else parsing. Actually, this is rather easy. The - * key is to notice that 'then' does all the work. 'if' simply - * there to indicate the start of a test and endif indicates - * the end of tests. If 'else' is seen, then skip to - * endif. - */ - case '?': /* if */ - case ';': /* endif */ - break; - - case 't': /* then */ - z = STACK_POP; - if (z != 0) - break; /* good. Continue parsing. */ - - /* z == 0 and test has failed. So, skip past this entire if - * expression to the matching else or matching endif. - */ - /* drop */ - case 'e': /* else */ - - parse_level = 0; - while (fmt < fmt_max) - { - unsigned char ch1; - - ch1 = *fmt++; - if ((ch1 != '%') || (fmt == fmt_max)) - continue; - - ch1 = *fmt++; - - if (ch1 == '?') parse_level++; /* new if */ - else if (ch1 == 'e') - { - if ((ch != 'e') && (parse_level == 0)) - break; - } - else if (ch1 == ';') - { - if (parse_level == 0) - break; - parse_level--; - } - } - break; - } - } - *b = 0; - return (unsigned int) (b - (unsigned char *) buf); -} - -static void tt_printf(char *fmt, int x, int y) -{ - char buf[1024]; - unsigned int n; - if (fmt == NULL) return; - n = tt_sprintf(buf, fmt, x, y); - tt_write(buf, n); -} - -void SLtt_set_scroll_region (int r1, int r2) -{ - Scroll_r1 = r1; - Scroll_r2 = r2; - tt_printf (Scroll_R_Str, Scroll_r1, Scroll_r2); - Cursor_Set = 0; -} - -void SLtt_reset_scroll_region (void) -{ - SLtt_set_scroll_region(0, SLtt_Screen_Rows - 1); -} - -int SLtt_set_cursor_visibility (int show) -{ - if ((Cursor_Visible_Str == NULL) || (Cursor_Invisible_Str == NULL)) - return -1; - - tt_write_string (show ? Cursor_Visible_Str : Cursor_Invisible_Str); - return 0; -} - -/* the goto_rc function moves to row relative to scrolling region */ -void SLtt_goto_rc(int r, int c) -{ - char *s = NULL; - int n; - char buf[6]; - - if ((c < 0) || (r < 0)) - { - Cursor_Set = 0; - return; - } - - /* if (No_Move_In_Standout && Current_Fgbg) SLtt_normal_video (); */ - r += Scroll_r1; - - if ((Cursor_Set > 0) || ((Cursor_Set < 0) && !Automatic_Margins)) - { - n = r - Cursor_r; - if ((n == -1) && (Cursor_Set > 0) && (Cursor_c == c) - && (Curs_Up_Str != NULL)) - { - s = Curs_Up_Str; - } - else if ((n >= 0) && (n <= 4)) - { - if ((n == 0) && (Cursor_Set == 1) - && ((c > 1) || (c == Cursor_c))) - { - if (Cursor_c == c) return; - if (Cursor_c == c + 1) - { - s = buf; - *s++ = '\b'; *s = 0; - s = buf; - } - } - else if (c == 0) - { - s = buf; - if ((Cursor_Set != 1) || (Cursor_c != 0)) *s++ = '\r'; - while (n--) *s++ = '\n'; -#ifdef VMS - /* Need to add this after \n to start a new record. Sheesh. */ - *s++ = '\r'; -#endif - *s = 0; - s = buf; - } - /* Will fail on VMS */ -#ifndef VMS - else if (SLtt_Newline_Ok && (Cursor_Set == 1) && - (Cursor_c >= c) && (c + 3 > Cursor_c)) - { - s = buf; - while (n--) *s++ = '\n'; - n = Cursor_c - c; - while (n--) *s++ = '\b'; - *s = 0; - s = buf; - } -#endif - } - } - if (s != NULL) tt_write_string(s); - else tt_printf(Curs_Pos_Str, r, c); - Cursor_c = c; Cursor_r = r; - Cursor_Set = 1; -} - -void SLtt_begin_insert (void) -{ - tt_write_string(Ins_Mode_Str); -} - -void SLtt_end_insert (void) -{ - tt_write_string(Eins_Mode_Str); -} - -void SLtt_delete_char (void) -{ - SLtt_normal_video (); - tt_write_string(Del_Char_Str); -} - -void SLtt_erase_line (void) -{ - tt_write_string("\r"); - Cursor_Set = 1; Cursor_c = 0; - SLtt_del_eol(); -} - -/* It appears that the Linux console, and most likely others do not - * like scrolling regions that consist of one line. So I have to - * resort to this stupidity to make up for that stupidity. - */ -static void delete_line_in_scroll_region (void) -{ - SLtt_goto_rc (Cursor_r - Scroll_r1, 0); - SLtt_del_eol (); -} - -void SLtt_delete_nlines (int n) -{ - int r1, curs; - char buf[132]; - - if (n <= 0) return; - SLtt_normal_video (); - - if (Scroll_r1 == Scroll_r2) - { - delete_line_in_scroll_region (); - return; - } - - if (Del_N_Lines_Str != NULL) tt_printf(Del_N_Lines_Str,n, 0); - else - /* get a new terminal */ - { - r1 = Scroll_r1; - curs = Cursor_r; - SLtt_set_scroll_region(curs, Scroll_r2); - SLtt_goto_rc(Scroll_r2 - Scroll_r1, 0); - SLMEMSET(buf, '\n', (unsigned int) n); - tt_write(buf, (unsigned int) n); - /* while (n--) tt_putchar('\n'); */ - SLtt_set_scroll_region(r1, Scroll_r2); - SLtt_goto_rc(curs, 0); - } -} - -void SLtt_cls (void) -{ - /* If the terminal is a color terminal but the user wants black and - * white, then make sure that the colors are reset. This appears to be - * necessary. - */ - if ((SLtt_Use_Ansi_Colors == 0) && Is_Color_Terminal) - { - if (Reset_Color_String != NULL) - tt_write_string (Reset_Color_String); - else - tt_write_string ("\033[0m\033[m"); - } - - SLtt_normal_video(); - SLtt_reset_scroll_region (); - tt_write_string(Cls_Str); -} - -void SLtt_reverse_index (int n) -{ - if (!n) return; - - SLtt_normal_video(); - - if (Scroll_r1 == Scroll_r2) - { - delete_line_in_scroll_region (); - return; - } - - if (Add_N_Lines_Str != NULL) tt_printf(Add_N_Lines_Str,n, 0); - else - { - while(n--) tt_write_string(Rev_Scroll_Str); - } -} - -int SLtt_Ignore_Beep = 1; -static char *Visible_Bell_Str; - -void SLtt_beep (void) -{ - if (SLtt_Ignore_Beep & 0x1) SLtt_putchar('\007'); - - if (SLtt_Ignore_Beep & 0x2) - { - if (Visible_Bell_Str != NULL) tt_write_string (Visible_Bell_Str); -#ifdef __linux__ - else if (Linux_Console) - { - tt_write_string ("\033[?5h"); - SLtt_flush_output (); - _SLusleep (50000); - tt_write_string ("\033[?5l"); - } -#endif - } - SLtt_flush_output (); -} - -static void del_eol (void) -{ - int c; - - if (Del_Eol_Str != NULL) - { - tt_write_string(Del_Eol_Str); - return; - } - - c = Cursor_c; - /* Avoid writing to the lower right corner. If the terminal does not - * have Del_Eol_Str, then it probably does not have what it takes to play - * games with insert for for a space into that corner. - */ - if (Cursor_r + 1 < SLtt_Screen_Rows) - c++; - - while (c < SLtt_Screen_Cols) - { - tt_write (" ", 1); - c++; - } -} - -void SLtt_del_eol (void) -{ - if (Current_Fgbg != 0xFFFFFFFFU) SLtt_normal_video (); - del_eol (); -} - -typedef struct -{ - char *name; - SLtt_Char_Type color; -} -Color_Def_Type; - -#define MAX_COLOR_NAMES 17 -static Color_Def_Type Color_Defs [MAX_COLOR_NAMES] = -{ - {"black", SLSMG_COLOR_BLACK}, - {"red", SLSMG_COLOR_RED}, - {"green", SLSMG_COLOR_GREEN}, - {"brown", SLSMG_COLOR_BROWN}, - {"blue", SLSMG_COLOR_BLUE}, - {"magenta", SLSMG_COLOR_MAGENTA}, - {"cyan", SLSMG_COLOR_CYAN}, - {"lightgray", SLSMG_COLOR_LGRAY}, - {"gray", SLSMG_COLOR_GRAY}, - {"brightred", SLSMG_COLOR_BRIGHT_RED}, - {"brightgreen", SLSMG_COLOR_BRIGHT_GREEN}, - {"yellow", SLSMG_COLOR_BRIGHT_BROWN}, - {"brightblue", SLSMG_COLOR_BRIGHT_BLUE}, - {"brightmagenta", SLSMG_COLOR_BRIGHT_CYAN}, - {"brightcyan", SLSMG_COLOR_BRIGHT_MAGENTA}, - {"white", SLSMG_COLOR_BRIGHT_WHITE}, -#define SLSMG_COLOR_DEFAULT 0xFF - {"default", SLSMG_COLOR_DEFAULT} -}; - -void SLtt_set_mono (int obj, char *what, SLtt_Char_Type mask) -{ - (void) what; - if ((obj < 0) || (obj >= JMAX_COLORS)) - { - return; - } - Ansi_Color_Map[obj].mono = mask & ATTR_MASK; -} - -static char *check_color_for_digit_form (char *color) -{ - unsigned int i, ich; - char *s = color; - - i = 0; - while ((ich = (int) *s) != 0) - { - if ((ich < '0') || (ich > '9')) - return color; - - i = i * 10 + (ich - '0'); - s++; - } - - if (i < MAX_COLOR_NAMES) - color = Color_Defs[i].name; - - return color; -} - -static int get_default_colors (char **fgp, char **bgp) -{ - static char fg_buf[16], bg_buf[16], *bg, *fg; - static int already_parsed; - char *p, *pmax; - - if (already_parsed == -1) - return -1; - - if (already_parsed) - { - *fgp = fg; - *bgp = bg; - return 0; - } - - already_parsed = -1; - - bg = getenv ("COLORFGBG"); - - if (bg == NULL) - { - bg = getenv ("DEFAULT_COLORS"); - if (bg == NULL) - return -1; - } - - p = fg_buf; - pmax = p + (sizeof (fg_buf) - 1); - - while ((*bg != 0) && (*bg != ';')) - { - if (p < pmax) *p++ = *bg; - bg++; - } - *p = 0; - - if (*bg) bg++; - - p = bg_buf; - pmax = p + (sizeof (bg_buf) - 1); - - /* Mark suggested allowing for extra spplication specific stuff following - * the background color. That is what the check for the semi-colon is for. - */ - while ((*bg != 0) && (*bg != ';')) - { - if (p < pmax) *p++ = *bg; - bg++; - } - *p = 0; - - if (!strcmp (fg_buf, "default") || !strcmp(bg_buf, "default")) - { - *fgp = *bgp = fg = bg = "default"; - } - else - { - *fgp = fg = check_color_for_digit_form (fg_buf); - *bgp = bg = check_color_for_digit_form (bg_buf); - } - already_parsed = 1; - return 0; -} - -static unsigned char FgBg_Stats[JMAX_COLORS]; - -static int Color_0_Modified = 0; - -void SLtt_set_color_object (int obj, SLtt_Char_Type attr) -{ - char *cust_esc; - - if ((obj < 0) || (obj >= JMAX_COLORS)) return; - - cust_esc = Ansi_Color_Map[obj].custom_esc; - if (cust_esc != NULL) - { - SLfree (cust_esc); - FgBg_Stats[(Ansi_Color_Map[obj].fgbg >> 8) & 0x7F] -= 1; - Ansi_Color_Map[obj].custom_esc = NULL; - } - - Ansi_Color_Map[obj].fgbg = attr; - if (obj == 0) Color_0_Modified = 1; - - if (_SLtt_color_changed_hook != NULL) - (*_SLtt_color_changed_hook)(); -} - -SLtt_Char_Type SLtt_get_color_object (int obj) -{ - if ((obj < 0) || (obj >= JMAX_COLORS)) return 0; - return Ansi_Color_Map[obj].fgbg; -} - -void SLtt_add_color_attribute (int obj, SLtt_Char_Type attr) -{ - if ((obj < 0) || (obj >= JMAX_COLORS)) return; - - Ansi_Color_Map[obj].fgbg |= (attr & ATTR_MASK); - if (obj == 0) Color_0_Modified = 1; - if (_SLtt_color_changed_hook != NULL) - (*_SLtt_color_changed_hook)(); -} - -static SLtt_Char_Type fb_to_fgbg (SLtt_Char_Type f, SLtt_Char_Type b) -{ - SLtt_Char_Type attr; - - if (Max_Terminfo_Colors != 8) - { - if (f != SLSMG_COLOR_DEFAULT) f %= Max_Terminfo_Colors; - if (b != SLSMG_COLOR_DEFAULT) b %= Max_Terminfo_Colors; - return ((f << 8) | (b << 16)); - } - - /* Otherwise we have 8 ansi colors. Try to get bright versions - * by using the BOLD and BLINK attributes. - */ - - attr = 0; - - /* Note: If f represents default, it will have the value 0xFF */ - if (f != SLSMG_COLOR_DEFAULT) - { - if (f & 0x8) attr = SLTT_BOLD_MASK; - f &= 0x7; - } - - if (b != SLSMG_COLOR_DEFAULT) - { - if (b & 0x8) attr |= SLTT_BLINK_MASK; - b &= 0x7; - } - - return ((f << 8) | (b << 16) | attr); -} - -/* This looks for colors with name form 'colorN'. If color is of this - * form, N is passed back via paramter list. - */ -static int parse_color_digit_name (char *color, SLtt_Char_Type *f) -{ - unsigned int i; - unsigned char ch; - - if (strncmp (color, "color", 5)) - return -1; - - color += 5; - if (*color == 0) - return -1; - - i = 0; - while (1) - { - ch = (unsigned char) *color++; - if (ch == 0) - break; - if ((ch > '9') || (ch < '0')) - return -1; - i = 10 * i + (ch - '0'); - } - - *f = (SLtt_Char_Type) i; - return 0; -} - -static int make_color_fgbg (char *fg, char *bg, SLtt_Char_Type *fgbg) -{ - SLtt_Char_Type f = 0xFFFFFFFFU, b = 0xFFFFFFFFU; - char *dfg, *dbg; - unsigned int i; - - if ((fg != NULL) && (*fg == 0)) fg = NULL; - if ((bg != NULL) && (*bg == 0)) bg = NULL; - - if ((fg == NULL) || (bg == NULL)) - { - if (-1 == get_default_colors (&dfg, &dbg)) - return -1; - - if (fg == NULL) fg = dfg; - if (bg == NULL) bg = dbg; - } - - if (-1 == parse_color_digit_name (fg, &f)) - { - for (i = 0; i < MAX_COLOR_NAMES; i++) - { - if (strcmp(fg, Color_Defs[i].name)) continue; - f = Color_Defs[i].color; - break; - } - } - - if (-1 == parse_color_digit_name (bg, &b)) - { - for (i = 0; i < MAX_COLOR_NAMES; i++) - { - if (strcmp(bg, Color_Defs[i].name)) continue; - b = Color_Defs[i].color; - break; - } - } - - if ((f == 0xFFFFFFFFU) || (b == 0xFFFFFFFFU)) - return -1; - - *fgbg = fb_to_fgbg (f, b); - return 0; -} - -void SLtt_set_color (int obj, char *what, char *fg, char *bg) -{ - SLtt_Char_Type fgbg; - - (void) what; - if ((obj < 0) || (obj >= JMAX_COLORS)) - return; - - if (-1 != make_color_fgbg (fg, bg, &fgbg)) - SLtt_set_color_object (obj, fgbg); -} - -void SLtt_set_color_fgbg (int obj, SLtt_Char_Type f, SLtt_Char_Type b) -{ - SLtt_set_color_object (obj, fb_to_fgbg (f, b)); -} - -void SLtt_set_color_esc (int obj, char *esc) -{ - char *cust_esc; - SLtt_Char_Type fgbg = 0; - int i; - - if ((obj < 0) || (obj >= JMAX_COLORS)) - { - return; - } - - cust_esc = Ansi_Color_Map[obj].custom_esc; - if (cust_esc != NULL) - { - SLfree (cust_esc); - FgBg_Stats[(Ansi_Color_Map[obj].fgbg >> 8) & 0x7F] -= 1; - } - - cust_esc = (char *) SLmalloc (strlen(esc) + 1); - if (cust_esc != NULL) strcpy (cust_esc, esc); - - Ansi_Color_Map[obj].custom_esc = cust_esc; - if (cust_esc == NULL) fgbg = 0; - else - { - /* The whole point of this is to generate a unique fgbg */ - for (i = 0; i < JMAX_COLORS; i++) - { - if (FgBg_Stats[i] == 0) fgbg = i; - - if (obj == i) continue; - if ((Ansi_Color_Map[i].custom_esc) == NULL) continue; - if (!strcmp (Ansi_Color_Map[i].custom_esc, cust_esc)) - { - fgbg = (Ansi_Color_Map[i].fgbg >> 8) & 0x7F; - break; - } - } - FgBg_Stats[fgbg] += 1; - } - - fgbg |= 0x80; - Ansi_Color_Map[obj].fgbg = (fgbg | (fgbg << 8)) << 8; - if (obj == 0) Color_0_Modified = 1; - if (_SLtt_color_changed_hook != NULL) - (*_SLtt_color_changed_hook)(); -} - -void SLtt_set_alt_char_set (int i) -{ - static int last_i; - if (SLtt_Has_Alt_Charset == 0) return; - if (i == last_i) return; - tt_write_string (i ? Start_Alt_Chars_Str : End_Alt_Chars_Str ); - last_i = i; -} - -static void write_attributes (SLtt_Char_Type fgbg) -{ - int bg0, fg0; - int unknown_attributes; - - if (Worthless_Highlight) return; - if (fgbg == Current_Fgbg) return; - - unknown_attributes = 0; - - /* Before spitting out colors, fix attributes */ - if ((fgbg & ATTR_MASK) != (Current_Fgbg & ATTR_MASK)) - { - if (Current_Fgbg & ATTR_MASK) - { - tt_write_string(Norm_Vid_Str); - /* In case normal video turns off ALL attributes: */ - if (fgbg & SLTT_ALTC_MASK) - Current_Fgbg &= ~SLTT_ALTC_MASK; - SLtt_set_alt_char_set (0); - } - - if ((fgbg & SLTT_ALTC_MASK) - != (Current_Fgbg & SLTT_ALTC_MASK)) - { - SLtt_set_alt_char_set ((int) (fgbg & SLTT_ALTC_MASK)); - } - - if (fgbg & SLTT_ULINE_MASK) tt_write_string (UnderLine_Vid_Str); - if (fgbg & SLTT_BOLD_MASK) SLtt_bold_video (); - if (fgbg & SLTT_REV_MASK) tt_write_string (Rev_Vid_Str); - if (fgbg & SLTT_BLINK_MASK) - { - /* Someday Linux will have a blink mode that set high intensity - * background. Lets be prepared. - */ - if (SLtt_Blink_Mode) tt_write_string (Blink_Vid_Str); - } - unknown_attributes = 1; - } - - if (SLtt_Use_Ansi_Colors) - { - fg0 = (int) GET_FG(fgbg); - bg0 = (int) GET_BG(fgbg); - - if (unknown_attributes - || (fg0 != (int)GET_FG(Current_Fgbg))) - { - if (fg0 == SLSMG_COLOR_DEFAULT) - tt_write_string (Default_Color_Fg_Str); - else - tt_printf (Color_Fg_Str, fg0, 0); - } - - if (unknown_attributes - || (bg0 != (int)GET_BG(Current_Fgbg))) - { - if (bg0 == SLSMG_COLOR_DEFAULT) - tt_write_string (Default_Color_Bg_Str); - else - tt_printf (Color_Bg_Str, bg0, 0); - } - } - - Current_Fgbg = fgbg; -} - -static int Video_Initialized; - -void SLtt_reverse_video (int color) -{ - SLtt_Char_Type fgbg; - char *esc; - - if (Worthless_Highlight) return; - if ((color < 0) || (color >= JMAX_COLORS)) return; - - if (Video_Initialized == 0) - { - if (color == JNORMAL_COLOR) - { - tt_write_string (Norm_Vid_Str); - } - else tt_write_string (Rev_Vid_Str); - Current_Fgbg = 0xFFFFFFFFU; - return; - } - - if (SLtt_Use_Ansi_Colors) - { - fgbg = Ansi_Color_Map[color].fgbg; - if ((esc = Ansi_Color_Map[color].custom_esc) != NULL) - { - if (fgbg != Current_Fgbg) - { - Current_Fgbg = fgbg; - tt_write_string (esc); - return; - } - } - } - else fgbg = Ansi_Color_Map[color].mono; - - if (fgbg == Current_Fgbg) return; - write_attributes (fgbg); -} - -void SLtt_normal_video (void) -{ - SLtt_reverse_video(JNORMAL_COLOR); -} - -void SLtt_narrow_width (void) -{ - tt_write_string("\033[?3l"); -} - -void SLtt_wide_width (void) -{ - tt_write_string("\033[?3h"); -} - -/* Highest bit represents the character set. */ -#define COLOR_MASK 0x7F00 - -#if SLTT_HAS_NON_BCE_SUPPORT -static int bce_color_eqs (unsigned int a, unsigned int b) -{ - a = (a & COLOR_MASK) >> 8; - b = (b & COLOR_MASK) >> 8; - - if (a == b) - return 1; - - if (SLtt_Use_Ansi_Colors == 0) - return Ansi_Color_Map[a].mono == Ansi_Color_Map[b].mono; - - if (Bce_Color_Offset == 0) - return Ansi_Color_Map[a].fgbg == Ansi_Color_Map[b].fgbg; - - /* If either are color 0, then we do not know what that means since the - * terminal does not support BCE */ - if ((a == 0) || (b == 0)) - return 0; - - return Ansi_Color_Map[a-1].fgbg == Ansi_Color_Map[b-1].fgbg; -} -#define COLOR_EQS(a,b) bce_color_eqs (a,b) -#else -# define COLOR_OF(x) (((unsigned int)(x) & COLOR_MASK) >> 8) -# define COLOR_EQS(a, b) \ - (SLtt_Use_Ansi_Colors \ - ? (Ansi_Color_Map[COLOR_OF(a)].fgbg == Ansi_Color_Map[COLOR_OF(b)].fgbg)\ - : (Ansi_Color_Map[COLOR_OF(a)].mono == Ansi_Color_Map[COLOR_OF(b)].mono)) -#endif - -#define CHAR_EQS(a, b) (((a) == (b))\ - || ((((a) & ~COLOR_MASK) == ((b) & ~COLOR_MASK))\ - && COLOR_EQS((a), (b)))) - -/* The whole point of this routine is to prevent writing to the last column - * and last row on terminals with automatic margins. - */ -static void write_string_with_care (char *str) -{ - unsigned int len; - - if (str == NULL) return; - - len = strlen (str); - if (Automatic_Margins && (Cursor_r + 1 == SLtt_Screen_Rows)) - { - if (len + (unsigned int) Cursor_c >= (unsigned int) SLtt_Screen_Cols) - { - /* For now, just do not write there. Later, something more - * sophisticated will be implemented. - */ - if (SLtt_Screen_Cols > Cursor_c) - len = SLtt_Screen_Cols - Cursor_c - 1; - else - len = 0; - } - } - tt_write (str, len); -} - -static void send_attr_str (SLsmg_Char_Type *s) -{ - unsigned char out[256], ch, *p; - register SLtt_Char_Type attr; - register SLsmg_Char_Type sh; - int color, last_color = -1; - - p = out; - while (0 != (sh = *s++)) - { - ch = sh & 0xFF; - color = ((int) sh & 0xFF00) >> 8; - -#if SLTT_HAS_NON_BCE_SUPPORT - if (Bce_Color_Offset - && (color >= Bce_Color_Offset)) - color -= Bce_Color_Offset; -#endif - - if (color != last_color) - { - if (SLtt_Use_Ansi_Colors) attr = Ansi_Color_Map[color & 0x7F].fgbg; - else attr = Ansi_Color_Map[color & 0x7F].mono; - - if (sh & 0x8000) /* alternate char set */ - { - if (SLtt_Use_Blink_For_ACS) - { - if (SLtt_Blink_Mode) attr |= SLTT_BLINK_MASK; - } - else attr |= SLTT_ALTC_MASK; - } - - if (attr != Current_Fgbg) - { - if ((ch != ' ') || - /* it is a space so only consider it different if it - * has different attributes. - */ - (attr & BGALL_MASK) != (Current_Fgbg & BGALL_MASK)) - { - if (p != out) - { - *p = 0; - write_string_with_care ((char *) out); - Cursor_c += (int) (p - out); - p = out; - } - - if (SLtt_Use_Ansi_Colors && (NULL != Ansi_Color_Map[color & 0x7F].custom_esc)) - { - tt_write_string (Ansi_Color_Map[color & 0x7F].custom_esc); - /* Just in case the custom escape sequence screwed up - * the alt character set state... - */ - if ((attr & SLTT_ALTC_MASK) != (Current_Fgbg & SLTT_ALTC_MASK)) - SLtt_set_alt_char_set ((int) (attr & SLTT_ALTC_MASK)); - Current_Fgbg = attr; - } - else write_attributes (attr); - - last_color = color; - } - } - } - *p++ = ch; - } - *p = 0; - if (p != out) write_string_with_care ((char *) out); - Cursor_c += (int) (p - out); -} - -static void forward_cursor (unsigned int n, int row) -{ - char buf [1024]; - - if (n <= 4) - { - SLtt_normal_video (); - SLMEMSET (buf, ' ', n); - buf[n] = 0; - write_string_with_care (buf); - Cursor_c += n; - } - else if (Curs_F_Str != NULL) - { - Cursor_c += n; - n = tt_sprintf(buf, Curs_F_Str, (int) n, 0); - tt_write(buf, n); - } - else SLtt_goto_rc (row, (int) (Cursor_c + n)); -} - - -void SLtt_smart_puts(SLsmg_Char_Type *neww, SLsmg_Char_Type *oldd, int len, int row) -{ - register SLsmg_Char_Type *p, *q, *qmax, *pmax, *buf; - SLsmg_Char_Type buffer[256]; - unsigned int n_spaces; - SLsmg_Char_Type *space_match, *last_buffered_match; -#ifdef HP_GLITCH_CODE - int handle_hp_glitch = 0; -#endif - SLsmg_Char_Type space_char; -#define SLTT_USE_INSERT_HACK 1 -#if SLTT_USE_INSERT_HACK - SLsmg_Char_Type insert_hack_prev = 0; - SLsmg_Char_Type insert_hack_char = 0; - - if ((row + 1 == SLtt_Screen_Rows) - && (len == SLtt_Screen_Cols) - && (len > 1) - && (SLtt_Term_Cannot_Insert == 0) - && Automatic_Margins) - { - insert_hack_char = neww[len-1]; - if (oldd[len-1] == insert_hack_char) - insert_hack_char = 0; - else - insert_hack_prev = neww[len-2]; - } -#endif - - q = oldd; p = neww; - qmax = oldd + len; - pmax = p + len; - - /* Find out where to begin --- while they match, we are ok */ - while (1) - { - if (q == qmax) return; -#if SLANG_HAS_KANJI_SUPPORT - if (*p & 0x80) - { /* new is kanji */ - if ((*q & 0x80) && ((q + 1) < qmax)) - { /* old is also kanji */ - if (((0xFF & *q) != (0xFF & *p)) - || ((0xFF & q[1]) != (0xFF & p[1]))) - break; /* both kanji, but not match */ - - else - { /* kanji match ! */ - if (!COLOR_EQS(*q, *p)) break; - q++; p++; - if (!COLOR_EQS(*q, *p)) break; - /* really match! */ - q++; p++; - continue; - } - } - else break; /* old is not kanji */ - } - else - { /* new is not kanji */ - if (*q & 0x80) break; /* old is kanji */ - } -#endif - if (!CHAR_EQS(*q, *p)) break; - q++; p++; - } - -#ifdef HP_GLITCH_CODE - if (Has_HP_Glitch) - { - SLsmg_Char_Type *qq = q; - - SLtt_goto_rc (row, (int) (p - neww)); - - while (qq < qmax) - { - if (*qq & 0xFF00) - { - SLtt_normal_video (); - SLtt_del_eol (); - qmax = q; - handle_hp_glitch = 1; - break; - } - qq++; - } - } -#endif - /* Find where the last non-blank character on old/new screen is */ - - space_char = ' '; - if ((*(pmax-1) & 0xFF) == ' ') - { - /* If we get here, then we can erase to the end of the line to create - * the final space. However, this will only work _if_ erasing will - * get us the correct color. If the terminal supports BCE, then this - * is easy. If it does not, then we can only perform this operation - * if the color is known via something like COLORFGBG. For now, - * I just will not perform the optimization for such terminals. - */ - if ((Can_Background_Color_Erase) - && SLtt_Use_Ansi_Colors) - space_char = *(pmax - 1); - - while (pmax > p) - { - pmax--; - if (!CHAR_EQS(*pmax, space_char)) - { - pmax++; - break; - } - } - } - - while (qmax > q) - { - qmax--; - if (!CHAR_EQS(*qmax, space_char)) - { - qmax++; - break; - } - } - - last_buffered_match = buf = buffer; /* buffer is empty */ - -#ifdef HP_GLITCH_CODE - if (handle_hp_glitch) - { - while (p < pmax) - { - *buf++ = *p++; - } - } -#endif - -#ifdef HP_GLITCH_CODE - if (Has_HP_Glitch == 0) - { -#endif - /* Try use use erase to bol if possible */ - if ((Del_Bol_Str != NULL) && ((*neww & 0xFF) == 32)) - { - SLsmg_Char_Type *p1; - SLsmg_Char_Type blank; - - p1 = neww; - if ((Can_Background_Color_Erase) - && SLtt_Use_Ansi_Colors) - blank = *p1; - /* black+white attributes do not support bce */ - else - blank = 32; - - while ((p1 < pmax) && (CHAR_EQS (*p1, blank))) - p1++; - - /* Is this optimization worth it? Assume Del_Bol_Str is ESC [ 1 K - * It costs 4 chars + the space needed to properly position the - * cursor, e.g., ESC [ 10;10H. So, it costs at least 13 characters. - */ - if ((p1 > neww + 13) - && (p1 >= p) - /* Avoid erasing from the end of the line */ - && ((p1 != pmax) || (pmax < neww + len))) - { - int ofs = (int) (p1 - neww); - q = oldd + ofs; - p = p1; - SLtt_goto_rc (row, ofs - 1); - SLtt_reverse_video (blank >> 8); - tt_write_string (Del_Bol_Str); - tt_write (" ", 1); - Cursor_c += 1; - } - else - SLtt_goto_rc (row, (int) (p - neww)); - } - else - SLtt_goto_rc (row, (int) (p - neww)); -#ifdef HP_GLITCH_CODE - } -#endif - - - /* loop using overwrite then skip algorithm until done */ - while (1) - { - /* while they do not match and we do not hit a space, buffer them up */ - n_spaces = 0; - while (p < pmax) - { - if (CHAR_EQS(*q, 32) && CHAR_EQS(*p, 32)) - { - /* If *q is not a space, we would have to overwrite it. - * However, if *q is a space, then while *p is also one, - * we only need to skip over the blank field. - */ - space_match = p; - p++; q++; - while ((p < pmax) - && CHAR_EQS(*q, 32) - && CHAR_EQS(*p, 32)) - { - p++; - q++; - } - n_spaces = (unsigned int) (p - space_match); - break; - } -#if SLANG_HAS_KANJI_SUPPORT - if ((*p & 0x80) && ((p + 1) < pmax)) - { /* new is kanji */ - if (*q & 0x80) - { /* old is also kanji */ - if (((0xFF & *q) != (0xFF & *p)) - || ((0xFF & q[1]) != (0xFF & p[1]))) - { - /* both kanji, but not match */ - *buf++ = *p++; - *buf++ = *p++; - q += 2; - continue; - } - else - { /* kanji match ? */ - if (!COLOR_EQS(*q, *p) || !COLOR_EQS(*(q+1), *(p+1))) - { - /* code is match, but color is diff */ - *buf++ = *p++; - *buf++ = *p++; - q += 2; - continue; - } - /* really match ! */ - break; - } - } - else - { /* old is not kanji */ - *buf++ = *p++; - *buf++ = *p++; - q += 2; - continue; - } - } - else - { /* new is not kanji */ - if (*q & 0x80) - { /* old is kanji */ - *buf++ = *p++; - q++; - continue; - } - } -#endif - - if (CHAR_EQS(*q, *p)) break; - *buf++ = *p++; - q++; - } - *buf = 0; - - if (buf != buffer) send_attr_str (buffer); - buf = buffer; - - if (n_spaces - && ((p < pmax) /* erase to eol will achieve this effect*/ - || (space_char != 32)))/* unless space_char is not a simple space */ - { - forward_cursor (n_spaces, row); - } - - /* Now we overwrote what we could and cursor is placed at position - * of a possible match of new and old. If this is the case, skip - * some more. - */ -#if !SLANG_HAS_KANJI_SUPPORT - while ((p < pmax) && CHAR_EQS(*p, *q)) - { - *buf++ = *p++; - q++; - } -#else - /* Kanji */ - while (p < pmax) - { - if ((*p & 0x80) && ((p + 1) < pmax)) - { /* new is kanji */ - if (*q & 0x80) - { /* old is also kanji */ - if (((0xFF & *q) == (0xFF & *p)) - && ((0xFF & q[1]) == (0xFF & p[1]))) - { - /* kanji match ? */ - if (!COLOR_EQS(*q, *p) - || !COLOR_EQS(q[1], p[1])) - break; - - *buf++ = *p++; - q++; - if (p >= pmax) - { - *buf++ = 32; - p++; - break; - } - else - { - *buf++ = *p++; - q++; - continue; - } - } - else break; /* both kanji, but not match */ - } - else break; /* old is not kanji */ - } - else - { /* new is not kanji */ - if (*q & 0x80) break; /* old is kanji */ - if (!CHAR_EQS(*q, *p)) break; - *buf++ = *p++; - q++; - } - } -#endif - last_buffered_match = buf; - if (p >= pmax) break; - - /* jump to new position is it is greater than 5 otherwise - * let it sit in the buffer and output it later. - */ - if ((int) (buf - buffer) >= 5) - { - forward_cursor ((unsigned int) (buf - buffer), row); - last_buffered_match = buf = buffer; - } - } - - if (buf != buffer) - { - if (q < qmax) - { - if ((buf == last_buffered_match) - && ((int) (buf - buffer) >= 5)) - { - forward_cursor ((unsigned int) (buf - buffer), row); - } - else - { - *buf = 0; - send_attr_str (buffer); - } - } - } - - if (q < qmax) - { - SLtt_reverse_video (space_char >> 8); - del_eol (); - } - -#if SLTT_USE_INSERT_HACK - else if (insert_hack_char) - { - SLtt_goto_rc (SLtt_Screen_Rows-1, SLtt_Screen_Cols-2); - buffer[0] = insert_hack_char; - buffer[1] = 0; - send_attr_str (buffer); - SLtt_goto_rc (SLtt_Screen_Rows-1, SLtt_Screen_Cols-2); - buffer[0] = insert_hack_prev; - SLtt_begin_insert (); - send_attr_str (buffer); - SLtt_end_insert (); - } -#endif - - if (Automatic_Margins && (Cursor_c + 1 >= SLtt_Screen_Cols)) Cursor_Set = 0; -} - -static void get_color_info (void) -{ - char *fg, *bg; - - /* Allow easy mechanism to override inadequate termcap/terminfo files. */ - if (SLtt_Use_Ansi_Colors == 0) - SLtt_Use_Ansi_Colors = (NULL != getenv ("COLORTERM")); - - if (SLtt_Use_Ansi_Colors) - Is_Color_Terminal = 1; - -#if SLTT_HAS_NON_BCE_SUPPORT - if (Can_Background_Color_Erase == 0) - Can_Background_Color_Erase = (NULL != getenv ("COLORTERM_BCE")); -#endif - - if (-1 == get_default_colors (&fg, &bg)) - return; - - /* Check to see if application has already set them. */ - if (Color_0_Modified) - return; - - SLtt_set_color (0, NULL, fg, bg); - SLtt_set_color (1, NULL, bg, fg); -} - -/* termcap stuff */ - -#ifdef __unix__ - -static int Termcap_Initalized = 0; - -#ifdef USE_TERMCAP -/* Termcap based system */ -static char Termcap_Buf[4096]; -static char Termcap_String_Buf[4096]; -static char *Termcap_String_Ptr; -extern char *tgetstr(char *, char **); -extern int tgetent(char *, char *); -extern int tgetnum(char *); -extern int tgetflag(char *); -#else -/* Terminfo */ -static SLterminfo_Type *Terminfo; -#endif - -#define TGETFLAG(x) (SLtt_tgetflag(x) > 0) - -static char *fixup_tgetstr (char *what) -{ - register char *w, *w1; - char *wsave; - - if (what == NULL) - return NULL; - - /* Check for AIX brain-damage */ - if (*what == '@') - return NULL; - - /* lose pad info --- with today's technology, term is a loser if - it is really needed */ - while ((*what == '.') || - ((*what >= '0') && (*what <= '9'))) what++; - if (*what == '*') what++; - - /* lose terminfo padding--- looks like $<...> */ - w = what; - while (*w) if ((*w++ == '$') && (*w == '<')) - { - w1 = w - 1; - while (*w && (*w != '>')) w++; - if (*w == 0) break; - w++; - wsave = w1; - while ((*w1++ = *w++) != 0); - w = wsave; - } - - if (*what == 0) what = NULL; - return what; -} - -char *SLtt_tgetstr (char *s) -{ - if (Termcap_Initalized == 0) - return NULL; - -#ifdef USE_TERMCAP - s = tgetstr (s, &Termcap_String_Ptr); -#else - s = _SLtt_tigetstr (Terminfo, s); -#endif - return fixup_tgetstr (s); -} - -int SLtt_tgetnum (char *s) -{ - if (Termcap_Initalized == 0) - return -1; -#ifdef USE_TERMCAP - return tgetnum (s); -#else - return _SLtt_tigetnum (Terminfo, s); -#endif -} - -int SLtt_tgetflag (char *s) -{ - if (Termcap_Initalized == 0) - return -1; -#ifdef USE_TERMCAP - return tgetflag (s); -#else - return _SLtt_tigetflag (Terminfo, s); -#endif -} - -static int Vt100_Like = 0; - -void SLtt_get_terminfo (void) -{ - char *term; - int status; - - term = getenv ("TERM"); - if (term == NULL) - SLang_exit_error("TERM environment variable needs set."); - - if (0 == (status = SLtt_initialize (term))) - return; - - if (status == -1) - { - SLang_exit_error ("Unknown terminal: %s\n\ -Check the TERM environment variable.\n\ -Also make sure that the terminal is defined in the terminfo database.\n\ -Alternatively, set the TERMCAP environment variable to the desired\n\ -termcap entry.", - term); - } - - if (status == -2) - { - SLang_exit_error ("\ -Your terminal lacks the ability to clear the screen or position the cursor.\n"); - } -} - -/* Returns 0 if all goes well, -1 if terminal capabilities cannot be deduced, - * or -2 if terminal cannot position the cursor. - */ -int SLtt_initialize (char *term) -{ - char *t, ch; - int is_xterm; - int almost_vtxxx; - - if (SLang_TT_Write_FD == -1) - { - /* Apparantly, this cannot fail according to the man pages. */ - SLang_TT_Write_FD = fileno (stdout); - } - - if (term == NULL) - { - term = getenv ("TERM"); - if (term == NULL) - return -1; - } - - Linux_Console = (!strncmp (term, "linux", 5) -# ifdef linux - || !strncmp(term, "con", 3) -# endif - ); - - t = term; - - if (strcmp(t, "vt52") && (*t++ == 'v') && (*t++ == 't') - && (ch = *t, (ch >= '1') && (ch <= '9'))) Vt100_Like = 1; - - is_xterm = ((0 == strncmp (term, "xterm", 5)) - || (0 == strncmp (term, "rxvt", 4)) - || (0 == strncmp (term, "Eterm", 5))); - - almost_vtxxx = (Vt100_Like - || Linux_Console - || is_xterm - || !strcmp (term, "screen")); - -# ifndef USE_TERMCAP - if (NULL == (Terminfo = _SLtt_tigetent (term))) - { - if (almost_vtxxx) /* Special cases. */ - { - int vt102 = 1; - if (!strcmp (term, "vt100")) vt102 = 0; - get_color_info (); - SLtt_set_term_vtxxx (&vt102); - return 0; - } - return -1; - } -# else /* USE_TERMCAP */ - if (1 != tgetent(Termcap_Buf, term)) - return -1; - Termcap_String_Ptr = Termcap_String_Buf; -# endif /* NOT USE_TERMCAP */ - - Termcap_Initalized = 1; - - Cls_Str = SLtt_tgetstr ("cl"); - Curs_Pos_Str = SLtt_tgetstr ("cm"); - - if ((NULL == (Ins_Mode_Str = SLtt_tgetstr("im"))) - || ( NULL == (Eins_Mode_Str = SLtt_tgetstr("ei"))) - || ( NULL == (Del_Char_Str = SLtt_tgetstr("dc")))) - SLtt_Term_Cannot_Insert = 1; - - Visible_Bell_Str = SLtt_tgetstr ("vb"); - Curs_Up_Str = SLtt_tgetstr ("up"); - Rev_Scroll_Str = SLtt_tgetstr("sr"); - Del_N_Lines_Str = SLtt_tgetstr("DL"); - Add_N_Lines_Str = SLtt_tgetstr("AL"); - - /* Actually these are used to initialize terminals that use cursor - * addressing. Hard to believe. - */ - Term_Init_Str = SLtt_tgetstr ("ti"); - Term_Reset_Str = SLtt_tgetstr ("te"); - - /* If I do this for vtxxx terminals, arrow keys start sending ESC O A, - * which I do not want. This is mainly for HP terminals. - */ - if ((almost_vtxxx == 0) || SLtt_Force_Keypad_Init) - { - Keypad_Init_Str = SLtt_tgetstr ("ks"); - Keypad_Reset_Str = SLtt_tgetstr ("ke"); - } - - /* Make up for defective termcap/terminfo databases */ - if ((Vt100_Like && (term[2] != '1')) - || Linux_Console - || is_xterm - ) - { - if (Del_N_Lines_Str == NULL) Del_N_Lines_Str = "\033[%dM"; - if (Add_N_Lines_Str == NULL) Add_N_Lines_Str = "\033[%dL"; - } - - Scroll_R_Str = SLtt_tgetstr("cs"); - - SLtt_get_screen_size (); - - if ((Scroll_R_Str == NULL) - || (((NULL == Del_N_Lines_Str) || (NULL == Add_N_Lines_Str)) - && (NULL == Rev_Scroll_Str))) - { - if (is_xterm - || Linux_Console - ) - { - /* Defective termcap mode!!!! */ - SLtt_set_term_vtxxx (NULL); - } - else SLtt_Term_Cannot_Scroll = 1; - } - - Del_Eol_Str = SLtt_tgetstr("ce"); - Del_Bol_Str = SLtt_tgetstr("cb"); - if (is_xterm && (Del_Bol_Str == NULL)) - Del_Bol_Str = "\033[1K"; - if (is_xterm && (Del_Eol_Str == NULL)) - Del_Bol_Str = "\033[K"; - - Rev_Vid_Str = SLtt_tgetstr("mr"); - if (Rev_Vid_Str == NULL) Rev_Vid_Str = SLtt_tgetstr("so"); - - Bold_Vid_Str = SLtt_tgetstr("md"); - - /* Although xterm cannot blink, it does display the blinking characters - * as bold ones. Some Rxvt will display the background as high intensity. - */ - if ((NULL == (Blink_Vid_Str = SLtt_tgetstr("mb"))) - && is_xterm) - Blink_Vid_Str = "\033[5m"; - - UnderLine_Vid_Str = SLtt_tgetstr("us"); - - Start_Alt_Chars_Str = SLtt_tgetstr ("as"); /* smacs */ - End_Alt_Chars_Str = SLtt_tgetstr ("ae"); /* rmacs */ - Enable_Alt_Char_Set = SLtt_tgetstr ("eA"); /* enacs */ - SLtt_Graphics_Char_Pairs = SLtt_tgetstr ("ac"); - - if (NULL == SLtt_Graphics_Char_Pairs) - { - /* make up for defective termcap/terminfo */ - if (Vt100_Like) - { - Start_Alt_Chars_Str = "\016"; - End_Alt_Chars_Str = "\017"; - Enable_Alt_Char_Set = "\033)0"; - } - } - - /* aixterm added by willi */ - if (is_xterm || !strncmp (term, "aixterm", 7)) - { - Start_Alt_Chars_Str = "\016"; - End_Alt_Chars_Str = "\017"; - Enable_Alt_Char_Set = "\033(B\033)0"; - } - - if ((SLtt_Graphics_Char_Pairs == NULL) && - ((Start_Alt_Chars_Str == NULL) || (End_Alt_Chars_Str == NULL))) - { - SLtt_Has_Alt_Charset = 0; - Enable_Alt_Char_Set = NULL; - } - else SLtt_Has_Alt_Charset = 1; - -#ifdef AMIGA - Enable_Alt_Char_Set = Start_Alt_Chars_Str = End_Alt_Chars_Str = NULL; -#endif - - /* status line capabilities */ - if ((SLtt_Has_Status_Line == -1) - && (0 != (SLtt_Has_Status_Line = TGETFLAG ("hs")))) - { - Disable_Status_line_Str = SLtt_tgetstr ("ds"); - Return_From_Status_Line_Str = SLtt_tgetstr ("fs"); - Goto_Status_Line_Str = SLtt_tgetstr ("ts"); - /* Status_Line_Esc_Ok = TGETFLAG("es"); */ - Num_Status_Line_Columns = SLtt_tgetnum ("ws"); - if (Num_Status_Line_Columns < 0) Num_Status_Line_Columns = 0; - } - - if (NULL == (Norm_Vid_Str = SLtt_tgetstr("me"))) - { - Norm_Vid_Str = SLtt_tgetstr("se"); - } - - Cursor_Invisible_Str = SLtt_tgetstr("vi"); - Cursor_Visible_Str = SLtt_tgetstr("ve"); - - Curs_F_Str = SLtt_tgetstr("RI"); - -# if 0 - if (NULL != Curs_F_Str) - { - Len_Curs_F_Str = strlen(Curs_F_Str); - } - else Len_Curs_F_Str = strlen(Curs_Pos_Str); -# endif - - Automatic_Margins = TGETFLAG ("am"); - /* No_Move_In_Standout = !TGETFLAG ("ms"); */ -# ifdef HP_GLITCH_CODE - Has_HP_Glitch = TGETFLAG ("xs"); -# else - Worthless_Highlight = TGETFLAG ("xs"); -# endif - - if (Worthless_Highlight == 0) - { /* Magic cookie glitch */ - Worthless_Highlight = (SLtt_tgetnum ("sg") > 0); - } - - if (Worthless_Highlight) - SLtt_Has_Alt_Charset = 0; - - Reset_Color_String = SLtt_tgetstr ("op"); - Color_Fg_Str = SLtt_tgetstr ("AF"); /* ANSI setaf */ - Color_Bg_Str = SLtt_tgetstr ("AB"); /* ANSI setbf */ - if ((Color_Fg_Str == NULL) || (Color_Bg_Str == NULL)) - { - Color_Fg_Str = SLtt_tgetstr ("Sf"); /* setf */ - Color_Bg_Str = SLtt_tgetstr ("Sb"); /* setb */ - } - - if ((Max_Terminfo_Colors = SLtt_tgetnum ("Co")) < 0) - Max_Terminfo_Colors = 8; - - if ((Color_Bg_Str != NULL) && (Color_Fg_Str != NULL)) - SLtt_Use_Ansi_Colors = 1; - else - { -#if 0 - Color_Fg_Str = "%?%p1%{7}%>%t\033[1;3%p1%{8}%m%dm%e\033[3%p1%dm%;"; - Color_Bg_Str = "%?%p1%{7}%>%t\033[5;4%p1%{8}%m%dm%e\033[4%p1%dm%;"; - Max_Terminfo_Colors = 16; -#else - Color_Fg_Str = "\033[3%dm"; - Color_Bg_Str = "\033[4%dm"; - Max_Terminfo_Colors = 8; -#endif - } - -#if SLTT_HAS_NON_BCE_SUPPORT - Can_Background_Color_Erase = TGETFLAG ("ut"); /* bce */ - /* Modern xterms have the BCE capability as well as the linux console */ - if (Can_Background_Color_Erase == 0) - { - Can_Background_Color_Erase = (Linux_Console -# if SLTT_XTERM_ALWAYS_BCE - || is_xterm -# endif - ); - } -#endif - get_color_info (); - - - if ((Cls_Str == NULL) - || (Curs_Pos_Str == NULL)) - return -2; - - return 0; -} - -#endif -/* Unix */ - -/* specific to vtxxx only */ -void SLtt_enable_cursor_keys (void) -{ -#ifdef __unix__ - if (Vt100_Like) -#endif - tt_write_string("\033=\033[?1l"); -} - -#ifdef VMS -int SLtt_initialize (char *term) -{ - SLtt_get_terminfo (); - return 0; -} - -void SLtt_get_terminfo () -{ - int zero = 0; - - Color_Fg_Str = "\033[3%dm"; - Color_Bg_Str = "\033[4%dm"; - Max_Terminfo_Colors = 8; - - get_color_info (); - - SLtt_set_term_vtxxx(&zero); - Start_Alt_Chars_Str = "\016"; - End_Alt_Chars_Str = "\017"; - SLtt_Has_Alt_Charset = 1; - SLtt_Graphics_Char_Pairs = "aaffgghhjjkkllmmnnooqqssttuuvvwwxx"; - Enable_Alt_Char_Set = "\033(B\033)0"; - SLtt_get_screen_size (); -} -#endif - -/* This sets term for vt102 terminals it parameter vt100 is 0. If vt100 - * is non-zero, set terminal appropriate for a only vt100 - * (no add line capability). */ - -void SLtt_set_term_vtxxx(int *vt100) -{ - Norm_Vid_Str = "\033[m"; - - Scroll_R_Str = "\033[%i%d;%dr"; - Cls_Str = "\033[2J\033[H"; - Rev_Vid_Str = "\033[7m"; - Bold_Vid_Str = "\033[1m"; - Blink_Vid_Str = "\033[5m"; - UnderLine_Vid_Str = "\033[4m"; - Del_Eol_Str = "\033[K"; - Del_Bol_Str = "\033[1K"; - Rev_Scroll_Str = "\033M"; - Curs_F_Str = "\033[%dC"; - /* Len_Curs_F_Str = 5; */ - Curs_Pos_Str = "\033[%i%d;%dH"; - if ((vt100 == NULL) || (*vt100 == 0)) - { - Ins_Mode_Str = "\033[4h"; - Eins_Mode_Str = "\033[4l"; - Del_Char_Str = "\033[P"; - Del_N_Lines_Str = "\033[%dM"; - Add_N_Lines_Str = "\033[%dL"; - SLtt_Term_Cannot_Insert = 0; - } - else - { - Del_N_Lines_Str = NULL; - Add_N_Lines_Str = NULL; - SLtt_Term_Cannot_Insert = 1; - } - SLtt_Term_Cannot_Scroll = 0; - /* No_Move_In_Standout = 0; */ -} - -int SLtt_init_video (void) -{ - /* send_string_to_term("\033[?6h"); */ - /* relative origin mode */ - tt_write_string (Term_Init_Str); - tt_write_string (Keypad_Init_Str); - SLtt_reset_scroll_region(); - SLtt_end_insert(); - tt_write_string (Enable_Alt_Char_Set); - Video_Initialized = 1; - return 0; -} - -int SLtt_reset_video (void) -{ - SLtt_goto_rc (SLtt_Screen_Rows - 1, 0); - Cursor_Set = 0; - SLtt_normal_video (); /* MSKermit requires this */ - tt_write_string(Norm_Vid_Str); - - Current_Fgbg = 0xFFFFFFFFU; - SLtt_set_alt_char_set (0); - if (SLtt_Use_Ansi_Colors) - { - if (Reset_Color_String == NULL) - { - SLtt_Char_Type attr; - if (-1 != make_color_fgbg (NULL, NULL, &attr)) - write_attributes (attr); - else tt_write_string ("\033[0m\033[m"); - } - else tt_write_string (Reset_Color_String); - Current_Fgbg = 0xFFFFFFFFU; - } - SLtt_erase_line (); - tt_write_string (Keypad_Reset_Str); - tt_write_string (Term_Reset_Str); - SLtt_flush_output (); - Video_Initialized = 0; - return 0; -} - -void SLtt_bold_video (void) -{ - tt_write_string (Bold_Vid_Str); -} - -int SLtt_set_mouse_mode (int mode, int force) -{ - char *term; - - if (force == 0) - { - if (NULL == (term = (char *) getenv("TERM"))) return -1; - if (strncmp ("xterm", term, 5)) - return -1; - } - - if (mode) - tt_write_string ("\033[?9h"); - else - tt_write_string ("\033[?9l"); - - return 0; -} - -void SLtt_disable_status_line (void) -{ - if (SLtt_Has_Status_Line > 0) - { - tt_write_string (Disable_Status_line_Str); - SLtt_flush_output (); - } -} - -int SLtt_write_to_status_line (char *s, int col) -{ - if ((SLtt_Has_Status_Line <= 0) - || (Goto_Status_Line_Str == NULL) - || (Return_From_Status_Line_Str == NULL)) - return -1; - - tt_printf (Goto_Status_Line_Str, col, 0); - tt_write_string (s); - tt_write_string (Return_From_Status_Line_Str); - return 0; -} - -void SLtt_get_screen_size (void) -{ -#ifdef VMS - int status, code; - unsigned short chan; - $DESCRIPTOR(dev_dsc, "SYS$INPUT:"); -#endif - int r = 0, c = 0; - -#ifdef TIOCGWINSZ - struct winsize wind_struct; - - do - { - if ((ioctl(1,TIOCGWINSZ,&wind_struct) == 0) - || (ioctl(0, TIOCGWINSZ, &wind_struct) == 0) - || (ioctl(2, TIOCGWINSZ, &wind_struct) == 0)) - { - c = (int) wind_struct.ws_col; - r = (int) wind_struct.ws_row; - break; - } - } - while (errno == EINTR); - -#endif - -#ifdef VMS - status = sys$assign(&dev_dsc,&chan,0,0,0); - if (status & 1) - { - code = DVI$_DEVBUFSIZ; - status = lib$getdvi(&code, &chan,0, &c, 0,0); - if (!(status & 1)) - c = 80; - code = DVI$_TT_PAGE; - status = lib$getdvi(&code, &chan,0, &r, 0,0); - if (!(status & 1)) - r = 24; - sys$dassgn(chan); - } -#endif - - if (r <= 0) - { - char *s = getenv ("LINES"); - if (s != NULL) r = atoi (s); - } - - if (c <= 0) - { - char *s = getenv ("COLUMNS"); - if (s != NULL) c = atoi (s); - } - - if (r <= 0) r = 24; - if (c <= 0) c = 80; -#if 0 - if ((r <= 0) || (r > 200)) r = 24; - if ((c <= 0) || (c > 250)) c = 80; -#endif - SLtt_Screen_Rows = r; - SLtt_Screen_Cols = c; -} - -#if SLTT_HAS_NON_BCE_SUPPORT -int _SLtt_get_bce_color_offset (void) -{ - if ((SLtt_Use_Ansi_Colors == 0) - || Can_Background_Color_Erase - || SLtt_Use_Blink_For_ACS) /* in this case, we cannot lose a color */ - Bce_Color_Offset = 0; - else - { - if (GET_BG(Ansi_Color_Map[0].fgbg) == SLSMG_COLOR_DEFAULT) - Bce_Color_Offset = 0; - else - Bce_Color_Offset = 1; - } - - return Bce_Color_Offset; -} -#endif diff --git a/mdk-stage1/slang/slerr.c b/mdk-stage1/slang/slerr.c deleted file mode 100644 index 139b3859b..000000000 --- a/mdk-stage1/slang/slerr.c +++ /dev/null @@ -1,181 +0,0 @@ -/* error handling common to all routines. */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -void (*SLang_VMessage_Hook) (char *, va_list); -void (*SLang_Error_Hook)(char *); -void (*SLang_Exit_Error_Hook)(char *, va_list); -volatile int SLang_Error = 0; -char *SLang_Error_Message; -volatile int SLKeyBoard_Quit = 0; - -static char *get_error_string (void) -{ - char *str; - - if (!SLang_Error) SLang_Error = SL_UNKNOWN_ERROR; - if (SLang_Error_Message != NULL) str = SLang_Error_Message; - else switch(SLang_Error) - { - case SL_NOT_IMPLEMENTED: str = "Not Implemented"; break; - case SL_APPLICATION_ERROR: str = "Application Error"; break; - case SL_VARIABLE_UNINITIALIZED: str = "Variable Uninitialized"; break; - case SL_MALLOC_ERROR : str = "Malloc Error"; break; - case SL_INTERNAL_ERROR: str = "Internal Error"; break; - case SL_STACK_OVERFLOW: str = "Stack Overflow"; break; - case SL_STACK_UNDERFLOW: str = "Stack Underflow"; break; - case SL_INTRINSIC_ERROR: str = "Intrinsic Error"; break; - case SL_USER_BREAK: str = "User Break"; break; - case SL_UNDEFINED_NAME: str = "Undefined Name"; break; - case SL_SYNTAX_ERROR: str = "Syntax Error"; break; - case SL_DUPLICATE_DEFINITION: str = "Duplicate Definition"; break; - case SL_TYPE_MISMATCH: str = "Type Mismatch"; break; - case SL_READONLY_ERROR: str = "Variable is read-only"; break; - case SL_DIVIDE_ERROR: str = "Divide by zero"; break; - case SL_OBJ_NOPEN: str = "Object not opened"; break; - case SL_OBJ_UNKNOWN: str = "Object unknown"; break; - case SL_INVALID_PARM: str = "Invalid Parameter"; break; - case SL_TYPE_UNDEFINED_OP_ERROR: - str = "Operation not defined for datatype"; break; - case SL_USER_ERROR: - str = "User Error"; break; - case SL_USAGE_ERROR: - str = "Illegal usage of function"; - break; - case SL_FLOATING_EXCEPTION: - str = "Floating Point Exception"; - break; - case SL_UNKNOWN_ERROR: - default: str = "Unknown Error Code"; - } - - SLang_Error_Message = NULL; - return str; -} - -void SLang_doerror (char *error) -{ - char *str = NULL; - char *err; - char *malloced_err_buf; - char err_buf [1024]; - - malloced_err_buf = NULL; - - if (((SLang_Error == SL_USER_ERROR) - || (SLang_Error == SL_USAGE_ERROR)) - && (error != NULL) && (*error != 0)) - err = error; - else - { - char *sle = "S-Lang Error: "; - unsigned int len; - char *fmt; - - str = get_error_string (); - - fmt = "%s%s%s"; - if ((error == NULL) || (*error == 0)) - error = ""; - else if (SLang_Error == SL_UNKNOWN_ERROR) - /* Do not display an unknown error message if error is non-NULL */ - str = ""; - else - fmt = "%s%s: %s"; - - len = strlen (sle) + strlen (str) + strlen(error) + 1; - - err = err_buf; - if (len >= sizeof (err_buf)) - { - if (NULL == (malloced_err_buf = SLmalloc (len))) - err = NULL; - else - err = malloced_err_buf; - } - - if (err != NULL) sprintf (err, fmt, sle, str, error); - else err = "Out of memory"; - } - - if (SLang_Error_Hook == NULL) - { - fputs (err, stderr); - fputs("\r\n", stderr); - fflush (stderr); - } - else - (*SLang_Error_Hook)(err); - - SLfree (malloced_err_buf); -} - -void SLang_verror (int err_code, char *fmt, ...) -{ - va_list ap; - char err [1024]; - - if (err_code == 0) err_code = SL_INTRINSIC_ERROR; - if (SLang_Error == 0) SLang_Error = err_code; - - if (fmt != NULL) - { - va_start(ap, fmt); - (void) _SLvsnprintf (err, sizeof (err), fmt, ap); - fmt = err; - va_end(ap); - } - - SLang_doerror (fmt); -} - -void SLang_exit_error (char *fmt, ...) -{ - va_list ap; - - va_start (ap, fmt); - if (SLang_Exit_Error_Hook != NULL) - { - (*SLang_Exit_Error_Hook) (fmt, ap); - exit (1); - } - - if (fmt != NULL) - { - vfprintf (stderr, fmt, ap); - fputs ("\r\n", stderr); - fflush (stderr); - } - va_end (ap); - - exit (1); -} - -void SLang_vmessage (char *fmt, ...) -{ - va_list ap; - - if (fmt == NULL) - return; - - va_start (ap, fmt); - - if (SLang_VMessage_Hook != NULL) - (*SLang_VMessage_Hook) (fmt, ap); - else - { - vfprintf (stdout, fmt, ap); - fputs ("\r\n", stdout); - } - - va_end (ap); -} diff --git a/mdk-stage1/slang/slerrno.c b/mdk-stage1/slang/slerrno.c deleted file mode 100644 index 662fadde1..000000000 --- a/mdk-stage1/slang/slerrno.c +++ /dev/null @@ -1,219 +0,0 @@ -/* The point of this file is to handle errno values in a system independent - * way so that they may be used in slang scripts. - */ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include <errno.h> -#include "slang.h" -#include "_slang.h" - -typedef struct -{ - char *msg; - int sys_errno; - char *symbolic_name; -} -Errno_Map_Type; - -static Errno_Map_Type Errno_Map [] = -{ -#ifndef EPERM -# define EPERM -1 -#endif - {"Not owner", EPERM, "EPERM"}, -#ifndef ENOENT -# define ENOENT -1 -#endif - {"No such file or directory", ENOENT, "ENOENT"}, -#ifndef ESRCH -# define ESRCH -1 -#endif - {"No such process", ESRCH, "ESRCH"}, -#ifndef EINTR -# define EINTR -1 -#endif - {"Interrupted system call", EINTR, "EINTR"}, -#ifndef EIO -# define EIO -1 -#endif - {"I/O error", EIO, "EIO"}, -#ifndef ENXIO -# define ENXIO -1 -#endif - {"No such device or address", ENXIO, "ENXIO"}, -#ifndef E2BIG -# define E2BIG -1 -#endif - {"Arg list too long", E2BIG, "E2BIG"}, -#ifndef ENOEXEC -# define ENOEXEC -1 -#endif - {"Exec format error", ENOEXEC,"ENOEXEC"}, -#ifndef EBADF -# define EBADF -1 -#endif - {"Bad file number", EBADF, "EBADF"}, -#ifndef ECHILD -# define ECHILD -1 -#endif - {"No children", ECHILD, "ECHILD"}, -#ifndef EAGAIN -# define EAGAIN -1 -#endif - {"Try again", EAGAIN, "EAGAIN"}, -#ifndef ENOMEM -# define ENOMEM -1 -#endif - {"Not enough core", ENOMEM, "ENOMEM"}, -#ifndef EACCES -# define EACCES -1 -#endif - {"Permission denied", EACCES, "EACCES"}, -#ifndef EFAULT -# define EFAULT -1 -#endif - {"Bad address", EFAULT, "EFAULT"}, -#ifndef ENOTBLK -# define ENOTBLK -1 -#endif - {"Block device required", ENOTBLK, "ENOTBLK"}, -#ifndef EBUSY -# define EBUSY -1 -#endif - {"Mount device busy", EBUSY, "EBUSY"}, -#ifndef EEXIST -# define EEXIST -1 -#endif - {"File exists", EEXIST, "EEXIST"}, -#ifndef EXDEV -# define EXDEV -1 -#endif - {"Cross-device link", EXDEV, "EXDEV"}, -#ifndef ENODEV -# define ENODEV -1 -#endif - {"No such device", ENODEV, "ENODEV"}, -#ifndef ENOTDIR -# define ENOTDIR -1 -#endif - {"Not a directory", ENOTDIR, "ENOTDIR"}, -#ifndef EISDIR -# define EISDIR -1 -#endif - {"Is a directory", EISDIR, "EISDIR"}, -#ifndef EINVAL -# define EINVAL -1 -#endif - {"Invalid argument", EINVAL, "EINVAL"}, -#ifndef ENFILE -# define ENFILE -1 -#endif - {"File table overflow", ENFILE, "ENFILE"}, -#ifndef EMFILE -# define EMFILE -1 -#endif - {"Too many open files", EMFILE, "EMFILE"}, -#ifndef ENOTTY -# define ENOTTY -1 -#endif - {"Not a typewriter", ENOTTY, "ENOTTY"}, -#ifndef ETXTBSY -# define ETXTBSY -1 -#endif - {"Text file busy", ETXTBSY, "ETXTBSY"}, -#ifndef EFBIG -# define EFBIG -1 -#endif - {"File too large", EFBIG, "EFBIG"}, -#ifndef ENOSPC -# define ENOSPC -1 -#endif - {"No space left on device", ENOSPC, "ENOSPC"}, -#ifndef ESPIPE -# define ESPIPE -1 -#endif - {"Illegal seek", ESPIPE, "ESPIPE"}, -#ifndef EROFS -# define EROFS -1 -#endif - {"Read-only file system", EROFS, "EROFS"}, -#ifndef EMLINK -# define EMLINK -1 -#endif - {"Too many links", EMLINK, "EMLINK"}, -#ifndef EPIPE -# define EPIPE -1 -#endif - {"Broken pipe", EPIPE, "EPIPE"}, -#ifndef ELOOP -# define ELOOP -1 -#endif - {"Too many levels of symbolic links",ELOOP, "ELOOP"}, -#ifndef ENAMETOOLONG -# define ENAMETOOLONG -1 -#endif - {"File name too long", ENAMETOOLONG, "ENAMETOOLONG"}, - - {NULL, 0, NULL} -}; - -int _SLerrno_errno; - -int SLerrno_set_errno (int sys_errno) -{ - _SLerrno_errno = sys_errno; - return 0; -} - -char *SLerrno_strerror (int sys_errno) -{ - Errno_Map_Type *e; - - e = Errno_Map; - while (e->msg != NULL) - { - if (e->sys_errno == sys_errno) - return e->msg; - - e++; - } - - if (sys_errno == SL_ERRNO_NOT_IMPLEMENTED) - return "System call not available for this platform"; - - return "Unknown error"; -} - -static char *intrin_errno_string (int *sys_errno) -{ - return SLerrno_strerror (*sys_errno); -} - -int _SLerrno_init (void) -{ - static Errno_Map_Type *e; - - if (e != NULL) /* already initialized */ - return 0; - - if ((-1 == SLadd_intrinsic_function ("errno_string", (FVOID_STAR) intrin_errno_string, - SLANG_STRING_TYPE, 1, SLANG_INT_TYPE)) - || (-1 == SLadd_intrinsic_variable ("errno", (VOID_STAR)&_SLerrno_errno, SLANG_INT_TYPE, 1))) - return -1; - - e = Errno_Map; - while (e->msg != NULL) - { - if (-1 == SLadd_intrinsic_variable (e->symbolic_name, (VOID_STAR) &e->sys_errno, SLANG_INT_TYPE, 1)) - return -1; - e++; - } - - return 0; -} diff --git a/mdk-stage1/slang/slgetkey.c b/mdk-stage1/slang/slgetkey.c deleted file mode 100644 index 2f2914f07..000000000 --- a/mdk-stage1/slang/slgetkey.c +++ /dev/null @@ -1,306 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -unsigned int SLang_Input_Buffer_Len = 0; -unsigned char SLang_Input_Buffer [SL_MAX_INPUT_BUFFER_LEN]; - -int SLang_Abort_Char = 7; -int SLang_Ignore_User_Abort = 0; - -/* This has the effect of mapping all characters in the range 128-169 to - * ESC [ something - */ - -unsigned int SLang_getkey (void) -{ - unsigned int imax; - unsigned int ch; - - if (SLang_Input_Buffer_Len) - { - ch = (unsigned int) *SLang_Input_Buffer; - SLang_Input_Buffer_Len--; - imax = SLang_Input_Buffer_Len; - - SLMEMCPY ((char *) SLang_Input_Buffer, - (char *) (SLang_Input_Buffer + 1), imax); - } - else if (SLANG_GETKEY_ERROR == (ch = _SLsys_getkey ())) return ch; - -#if _SLANG_MAP_VTXXX_8BIT -# if !defined(IBMPC_SYSTEM) - if (ch & 0x80) - { - unsigned char i; - i = (unsigned char) (ch & 0x7F); - if (i < ' ') - { - i += 64; - SLang_ungetkey (i); - ch = 27; - } - } -# endif -#endif - return(ch); -} - -int SLang_ungetkey_string (unsigned char *s, unsigned int n) -{ - register unsigned char *bmax, *b, *b1; - if (SLang_Input_Buffer_Len + n + 3 > SL_MAX_INPUT_BUFFER_LEN) - return -1; - - b = SLang_Input_Buffer; - bmax = (b - 1) + SLang_Input_Buffer_Len; - b1 = bmax + n; - while (bmax >= b) *b1-- = *bmax--; - bmax = b + n; - while (b < bmax) *b++ = *s++; - SLang_Input_Buffer_Len += n; - return 0; -} - -int SLang_buffer_keystring (unsigned char *s, unsigned int n) -{ - - if (n + SLang_Input_Buffer_Len + 3 > SL_MAX_INPUT_BUFFER_LEN) return -1; - - SLMEMCPY ((char *) SLang_Input_Buffer + SLang_Input_Buffer_Len, - (char *) s, n); - SLang_Input_Buffer_Len += n; - return 0; -} - -int SLang_ungetkey (unsigned char ch) -{ - return SLang_ungetkey_string(&ch, 1); -} - -int SLang_input_pending (int tsecs) -{ - int n; - unsigned char c; - if (SLang_Input_Buffer_Len) return (int) SLang_Input_Buffer_Len; - - n = _SLsys_input_pending (tsecs); - - if (n <= 0) return 0; - - c = (unsigned char) SLang_getkey (); - SLang_ungetkey_string (&c, 1); - - return n; -} - -void SLang_flush_input (void) -{ - int quit = SLKeyBoard_Quit; - - SLang_Input_Buffer_Len = 0; - SLKeyBoard_Quit = 0; - while (_SLsys_input_pending (0) > 0) - { - (void) _SLsys_getkey (); - /* Set this to 0 because _SLsys_getkey may stuff keyboard buffer if - * key sends key sequence (OS/2, DOS, maybe VMS). - */ - SLang_Input_Buffer_Len = 0; - } - SLKeyBoard_Quit = quit; -} - -#ifdef IBMPC_SYSTEM -static int Map_To_ANSI; -int SLgetkey_map_to_ansi (int enable) -{ - Map_To_ANSI = enable; - return 0; -} - -static int convert_scancode (unsigned int scan, - unsigned int shift, - int getkey, - unsigned int *ret_key) -{ - unsigned char buf[16]; - unsigned char *b; - unsigned char end; - int is_arrow; - - shift &= (_SLTT_KEY_ALT|_SLTT_KEY_SHIFT|_SLTT_KEY_CTRL); - - b = buf; - if (_SLTT_KEY_ALT == shift) - { - shift = 0; - *b++ = 27; - } - *b++ = 27; - *b++ = '['; - - is_arrow = 0; - end = '~'; - if (shift) - { - if (shift == _SLTT_KEY_CTRL) - end = '^'; - else if (shift == _SLTT_KEY_SHIFT) - end = '$'; - else shift = 0; - } - - /* These mappings correspond to what rxvt produces under Linux */ - switch (scan & 0xFF) - { - default: - return -1; - - case 0x47: /* home */ - *b++ = '1'; - break; - case 0x48: /* up */ - end = 'A'; - is_arrow = 1; - break; - case 0x49: /* PgUp */ - *b++ = '5'; - break; - case 0x4B: /* Left */ - end = 'D'; - is_arrow = 1; - break; - case 0x4D: /* Right */ - end = 'C'; - is_arrow = 1; - break; - case 0x4F: /* End */ - *b++ = '4'; - break; - case 0x50: /* Down */ - end = 'B'; - is_arrow = 1; - break; - case 0x51: /* PgDn */ - *b++ = '6'; - break; - case 0x52: /* Insert */ - *b++ = '2'; - break; - case 0x53: /* Delete */ - *b++ = '3'; - break; - case ';': /* F1 */ - *b++ = '1'; - *b++ = '1'; - break; - case '<': /* F2 */ - *b++ = '1'; - *b++ = '2'; - break; - case '=': /* F3 */ - *b++ = '1'; - *b++ = '3'; - break; - - case '>': /* F4 */ - *b++ = '1'; - *b++ = '4'; - break; - - case '?': /* F5 */ - *b++ = '1'; - *b++ = '5'; - break; - - case '@': /* F6 */ - *b++ = '1'; - *b++ = '7'; - break; - - case 'A': /* F7 */ - *b++ = '1'; - *b++ = '8'; - break; - - case 'B': /* F8 */ - *b++ = '1'; - *b++ = '9'; - break; - - case 'C': /* F9 */ - *b++ = '2'; - *b++ = '0'; - break; - - case 'D': /* F10 */ - *b++ = '2'; - *b++ = '1'; - break; - - case 0x57: /* F11 */ - *b++ = '2'; - *b++ = '3'; - break; - - case 0x58: /* F12 */ - *b++ = '2'; - *b++ = '4'; - break; - } - - if (is_arrow && shift) - { - if (shift == _SLTT_KEY_CTRL) - end &= 0x1F; - else - end |= 0x20; - } - *b++ = end; - - if (getkey) - { - (void) SLang_buffer_keystring (buf + 1, (unsigned int) (b - (buf + 1))); - *ret_key = buf[0]; - return 0; - } - - (void) SLang_buffer_keystring (buf, (unsigned int) (b - buf)); - return 0; -} - - -unsigned int _SLpc_convert_scancode (unsigned int scan, - unsigned int shift, - int getkey) -{ - unsigned char buf[16]; - - if (Map_To_ANSI) - { - if (0 == convert_scancode (scan, shift, getkey, &scan)) - return scan; - } - - if (getkey) - { - buf[0] = scan & 0xFF; - SLang_buffer_keystring (buf, 1); - return (scan >> 8) & 0xFF; - } - buf[0] = (scan >> 8) & 0xFF; - buf[1] = scan & 0xFF; - (void) SLang_buffer_keystring (buf, 2); - return 0; -} - -#endif diff --git a/mdk-stage1/slang/slimport.c b/mdk-stage1/slang/slimport.c deleted file mode 100644 index 44b4b25e1..000000000 --- a/mdk-stage1/slang/slimport.c +++ /dev/null @@ -1,281 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -#define SLANG_HAS_DYNAMIC_LINKING 1 - -#ifndef HAVE_DLFCN_H -# undef SLANG_HAS_DYNAMIC_LINKING -# define SLANG_HAS_DYNAMIC_LINKING 0 -#endif - -/* The rest of this file is in the if block */ -#if SLANG_HAS_DYNAMIC_LINKING - -#ifdef HAVE_DLFCN_H -# include <dlfcn.h> -#endif - -static char *Module_Path; -#define MODULE_PATH_ENV_NAME "SLANG_MODULE_PATH" -#ifndef MODULE_INSTALL_DIR -# define MODULE_INSTALL_DIR "/usr/local/lib/slang/modules" -#endif - -typedef struct _Handle_Type -{ - struct _Handle_Type *next; - char *name; - VOID_STAR handle; - void (*deinit_fun) (void); -} -Handle_Type; - -static Handle_Type *Handle_List; - -static void delete_handles (void) -{ - while (Handle_List != NULL) - { - Handle_Type *next = Handle_List->next; - - if (Handle_List->deinit_fun != NULL) - Handle_List->deinit_fun (); - (void) dlclose (Handle_List->handle); - SLang_free_slstring (Handle_List->name); - SLfree ((char *)Handle_List); - Handle_List = next; - } -} - -static Handle_Type *save_handle (char *name, VOID_STAR h, void (*df)(void)) -{ - Handle_Type *l; - - l = (Handle_Type *) SLmalloc (sizeof (Handle_Type)); - if (l == NULL) - return NULL; - memset ((char *) l, 0, sizeof(Handle_Type)); - if (NULL == (l->name = SLang_create_slstring (name))) - { - SLfree ((char *) l); - return NULL; - } - l->handle = h; - l->next = Handle_List; - l->deinit_fun = df; - Handle_List = l; - - return l; -} - -static Handle_Type *find_handle (char *name) -{ - Handle_Type *l; - - l = Handle_List; - while (l != NULL) - { - if (0 == strcmp (l->name, name)) - break; - l = l->next; - } - return l; -} - -static int import_from_library (char *name, - char *init_fun_name, char *deinit_fun_name, - char *file, - char *ns, - char *ns_init_fun_name) -{ - VOID_STAR handle; - int (*init_fun) (void); - int (*ns_init_fun) (char *); - void (*deinit_fun) (void); - char *err; - char filebuf[1024]; - char *fun_name; - - if (NULL != find_handle (name)) - return 0; /* already loaded */ - - while (1) - { -#ifndef RTLD_GLOBAL -# define RTLD_GLOBAL 0 -#endif -#ifdef RTLD_NOW - handle = (VOID_STAR) dlopen (file, RTLD_NOW | RTLD_GLOBAL); -#else - handle = (VOID_STAR) dlopen (file, RTLD_LAZY | RTLD_GLOBAL); -#endif - - if (handle != NULL) - break; - - if (NULL == strchr (file, '/')) - { - _SLsnprintf (filebuf, sizeof (filebuf), "./%s", file); - file = filebuf; - continue; - } - - if (NULL == (err = (char *) dlerror ())) - err = "UNKNOWN"; - - SLang_verror (SL_INTRINSIC_ERROR, - "Error linking to %s: %s", file, err); - return -1; - } - - fun_name = ns_init_fun_name; - ns_init_fun = (int (*)(char *)) dlsym (handle, fun_name); - if (ns_init_fun == NULL) - { - if ((ns != NULL) - && (0 != strcmp (ns, "Global"))) - goto return_error; - - fun_name = init_fun_name; - init_fun = (int (*)(void)) dlsym (handle, fun_name); - if (init_fun == NULL) - goto return_error; - - if (-1 == (*init_fun) ()) - { - dlclose (handle); - return -1; - } - } - else if (-1 == (*ns_init_fun) (ns)) - { - dlclose (handle); - return -1; - } - - - deinit_fun = (void (*)(void)) dlsym (handle, deinit_fun_name); - - (void) save_handle (name, handle, deinit_fun); - return 0; - - return_error: - - if (NULL == (err = (char *) dlerror ())) - err = "UNKNOWN"; - - dlclose (handle); - SLang_verror (SL_INTRINSIC_ERROR, - "Unable to get symbol %s from %s: %s", - name, file, err); - return -1; -} - -static void import_module (void) -{ - char module_name[256]; - char symbol_name[256]; - char deinit_name[256]; - char ns_init_name[256]; - char *path; - char *file; - char *module; - char *ns = NULL; - - if (SLang_Num_Function_Args == 2) - { - if (-1 == SLang_pop_slstring (&ns)) - return; - } - - if (-1 == SLang_pop_slstring (&module)) - { - SLang_free_slstring (ns); /* NULL ok */ - return; - } - - _SLsnprintf (symbol_name, sizeof(symbol_name), "init_%s_module", module); - _SLsnprintf (module_name, sizeof(module_name), "%s-module.so", module); - _SLsnprintf (deinit_name, sizeof(deinit_name), "deinit_%s_module", module); - _SLsnprintf (ns_init_name, sizeof (ns_init_name), "init_%s_module_ns", module); - - if (Module_Path != NULL) - file = SLpath_find_file_in_path (Module_Path, module_name); - else file = NULL; - - if ((file == NULL) - && (NULL != (path = getenv (MODULE_PATH_ENV_NAME)))) - file = SLpath_find_file_in_path (path, module_name); - - if (file == NULL) - file = SLpath_find_file_in_path (MODULE_INSTALL_DIR, module_name); - - if (file != NULL) - { - (void) import_from_library (symbol_name, symbol_name, deinit_name, file, ns, ns_init_name); - SLfree (file); - } - else - { - /* Maybe the system loader can find it in LD_LIBRARY_PATH */ - (void) import_from_library (symbol_name, symbol_name, deinit_name, module_name, ns, ns_init_name); - } -} - -static void set_import_module_path (char *path) -{ - (void) SLang_set_module_load_path (path); -} - -static char *get_import_module_path (void) -{ - char *path; - if (Module_Path != NULL) - return Module_Path; - if (NULL != (path = getenv (MODULE_PATH_ENV_NAME))) - return path; - return MODULE_INSTALL_DIR; -} - -static SLang_Intrin_Fun_Type Module_Intrins [] = -{ - MAKE_INTRINSIC_0("import", import_module, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("set_import_module_path", set_import_module_path, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("get_import_module_path", get_import_module_path, SLANG_STRING_TYPE), - SLANG_END_INTRIN_FUN_TABLE -}; - -#endif /* SLANG_HAS_DYNAMIC_LINKING */ - -int SLang_set_module_load_path (char *path) -{ -#if SLANG_HAS_DYNAMIC_LINKING - if (NULL == (path = SLang_create_slstring (path))) - return -1; - SLang_free_slstring (Module_Path); - Module_Path = path; - return 0; -#else - (void) path; - return -1; -#endif -} - -int SLang_init_import (void) -{ -#if SLANG_HAS_DYNAMIC_LINKING - (void) SLang_add_cleanup_function (delete_handles); - return SLadd_intrin_fun_table (Module_Intrins, "__IMPORT__"); -#else - return 0; -#endif -} diff --git a/mdk-stage1/slang/slinclud.h b/mdk-stage1/slang/slinclud.h deleted file mode 100644 index d60a4423e..000000000 --- a/mdk-stage1/slang/slinclud.h +++ /dev/null @@ -1,26 +0,0 @@ -#ifndef _SLANG_INCLUDE_H_ -#define _SLANG_INCLUDE_H_ - -#include "config.h" -#include "sl-feat.h" - -#include <stdio.h> -#include <string.h> - -#ifdef HAVE_STDLIB_H -# include <stdlib.h> -#endif - -#ifdef HAVE_UNISTD_H -# include <unistd.h> -#endif - -#ifdef HAVE_MALLOC_H -# include <malloc.h> -#endif - -#ifdef HAVE_MEMORY_H -# include <memory.h> -#endif - -#endif /* _SLANG_INCLUDE_H_ */ diff --git a/mdk-stage1/slang/slintall.c b/mdk-stage1/slang/slintall.c deleted file mode 100644 index a66b9d6d2..000000000 --- a/mdk-stage1/slang/slintall.c +++ /dev/null @@ -1,27 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -int SLang_init_all (void) -{ - if ((-1 == SLang_init_slang ()) - || (-1 == SLang_init_slmath ()) - || (-1 == SLang_init_posix_dir ()) - || (-1 == SLang_init_posix_process ()) - || (-1 == SLang_init_stdio ()) - || (-1 == SLang_init_array ()) - || (-1 == SLang_init_posix_io ()) - || (-1 == SLang_init_ospath ()) - ) - return -1; - - return 0; -} - diff --git a/mdk-stage1/slang/slistruc.c b/mdk-stage1/slang/slistruc.c deleted file mode 100644 index 06b8fd6ff..000000000 --- a/mdk-stage1/slang/slistruc.c +++ /dev/null @@ -1,218 +0,0 @@ -/* Intrinsic Structure type implementation */ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -/* Intrinsic structures */ - -typedef struct -{ - char *name; - VOID_STAR addr; - SLang_IStruct_Field_Type *fields; -} -_SLang_IStruct_Type; - -static SLang_IStruct_Field_Type *istruct_pop_field (char *name, int no_readonly, VOID_STAR *addr) -{ - _SLang_IStruct_Type *s; - SLang_IStruct_Field_Type *f; - char *struct_addr; - - /* Note: There is no need to free this object */ - if (-1 == SLclass_pop_ptr_obj (SLANG_ISTRUCT_TYPE, (VOID_STAR *) &s)) - return NULL; - - if (NULL == (struct_addr = *(char **)s->addr)) - { - SLang_verror (SL_INTRINSIC_ERROR, - "%s is NULL. Unable to access field", s->name); - return NULL; - } - - f = s->fields; - while (f->field_name != NULL) - { - /* Since both these are slstrings, just test pointers */ - if (f->field_name != name) - { - f++; - continue; - } - - if (no_readonly && f->read_only) - { - SLang_verror (SL_READONLY_ERROR, - "%s.%s is read-only", s->name, name); - return NULL; - } - - *addr = (VOID_STAR) (struct_addr + f->offset); - return f; - } - - SLang_verror (SL_TYPE_MISMATCH, - "%s has no field called %s", s->name, name); - return NULL; -} - -static int istruct_sget (unsigned char type, char *name) -{ - SLang_IStruct_Field_Type *f; - VOID_STAR addr; - SLang_Class_Type *cl; - - if (NULL == (f = istruct_pop_field (name, 0, &addr))) - return -1; - - type = f->type; - cl = _SLclass_get_class (type); - - return (cl->cl_push_intrinsic)(f->type, addr); -} - -static int istruct_sput (unsigned char type, char *name) -{ - SLang_IStruct_Field_Type *f; - VOID_STAR addr; - SLang_Class_Type *cl; - - if (NULL == (f = istruct_pop_field (name, 1, &addr))) - return -1; - - type = f->type; - cl = _SLclass_get_class (type); - - return (*cl->cl_pop) (type, addr); -} - -static int istruct_push (unsigned char type, VOID_STAR ptr) -{ - _SLang_IStruct_Type *s; - - s = *(_SLang_IStruct_Type **) ptr; - if ((s == NULL) - || (s->addr == NULL) - || (*(char **) s->addr == NULL)) - return SLang_push_null (); - - return SLclass_push_ptr_obj (type, (VOID_STAR) s); -} - -static int istruct_pop (unsigned char type, VOID_STAR ptr) -{ - return SLclass_pop_ptr_obj (type, (VOID_STAR *)ptr); -} - -static void istruct_destroy (unsigned char type, VOID_STAR ptr) -{ - (void) type; - (void) ptr; -} - -/* Intrinsic struct objects are not stored in a variable. So, the address that - * is passed here is actually a pointer to the struct. So, pass its address - * to istruct_push since v is a variable. Confusing, n'est pas? - */ -static int istruct_push_intrinsic (unsigned char type, VOID_STAR v) -{ - return istruct_push (type, (VOID_STAR) &v); -} - -static int init_intrin_struct (void) -{ - SLang_Class_Type *cl; - static int initialized; - - if (initialized) - return 0; - - if (NULL == (cl = SLclass_allocate_class ("IStruct_Type"))) - return -1; - - cl->cl_pop = istruct_pop; - cl->cl_push = istruct_push; - cl->cl_sget = istruct_sget; - cl->cl_sput = istruct_sput; - cl->cl_destroy = istruct_destroy; - cl->cl_push_intrinsic = istruct_push_intrinsic; - - if (-1 == SLclass_register_class (cl, SLANG_ISTRUCT_TYPE, sizeof (_SLang_IStruct_Type *), - SLANG_CLASS_TYPE_PTR)) - return -1; - - initialized = 1; - return 0; -} - -int SLadd_istruct_table (SLang_IStruct_Field_Type *fields, VOID_STAR addr, char *name) -{ - _SLang_IStruct_Type *s; - SLang_IStruct_Field_Type *f; - - if (-1 == init_intrin_struct ()) - return -1; - - if (addr == NULL) - { - SLang_verror (SL_INVALID_PARM, - "SLadd_istruct_table: address must be non-NULL"); - return -1; - } - - if (fields == NULL) - return -1; - - /* Make the field names slstrings so that only the pointers need to be - * compared. However, this table may have been already been added for - * another instance of the intrinsic object. So, check for the presence - * of an slstring. - */ - f = fields; - while (f->field_name != NULL) - { - char *fname; - - fname = SLang_create_slstring (f->field_name); - if (fname == NULL) - return -1; - - /* Here is the check for the slstring */ - if (f->field_name == fname) - SLang_free_slstring (fname); - else /* replace string literal with slstring */ - f->field_name = fname; - - f++; - } - - s = (_SLang_IStruct_Type *)SLmalloc (sizeof (_SLang_IStruct_Type)); - if (s == NULL) - return -1; - - memset ((char *)s, 0, sizeof (_SLang_IStruct_Type)); - if (NULL == (s->name = SLang_create_slstring (name))) - { - SLfree ((char *) s); - return -1; - } - - s->addr = addr; - s->fields = fields; - - if (-1 == SLadd_intrinsic_variable (name, (VOID_STAR) s, SLANG_ISTRUCT_TYPE, 1)) - { - SLang_free_slstring (s->name); - SLfree ((char *) s); - return -1; - } - - return 0; -} diff --git a/mdk-stage1/slang/slkeymap.c b/mdk-stage1/slang/slkeymap.c deleted file mode 100644 index dff65433e..000000000 --- a/mdk-stage1/slang/slkeymap.c +++ /dev/null @@ -1,596 +0,0 @@ -/* Keymap routines for SLang. The role of these keymap routines is simple: - * Just read keys from the tty and return a pointer to a keymap structure. - * That is, a keymap is simple a mapping of strings (keys from tty) to - * structures. Also included are routines for managing the keymaps. - */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -/* We need a define a rule for upperand lower case chars that user cannot - change! This could be a problem for international chars! */ - -#define UPPER_CASE_KEY(x) (((x) >= 'a') && ((x) <= 'z') ? (x) - 32 : (x)) -#define LOWER_CASE_KEY(x) (((x) >= 'A') && ((x) <= 'Z') ? (x) + 32 : (x)) - -int SLang_Key_TimeOut_Flag = 0; /* true if more than 1 sec has elapsed - without key in multikey sequence */ - -int SLang_Last_Key_Char; - -SLKeyMap_List_Type SLKeyMap_List[SLANG_MAX_KEYMAPS]; - -static SLang_Key_Type *malloc_key(unsigned char *str) -{ - SLang_Key_Type *neew; - - if (NULL == (neew = (SLang_Key_Type *) SLmalloc(sizeof(SLang_Key_Type)))) - return NULL; - - SLMEMSET ((char *) neew, 0, sizeof (SLang_Key_Type)); - SLMEMCPY((char *) neew->str, (char *) str, (unsigned int) *str); - return(neew); -} - -static SLKeyMap_List_Type *add_keymap (char *name, SLang_Key_Type *map) -{ - int i; - - for (i = 0; i < SLANG_MAX_KEYMAPS; i++) - { - if (SLKeyMap_List[i].keymap == NULL) - { - if (NULL == (name = SLang_create_slstring (name))) - return NULL; - - SLKeyMap_List[i].keymap = map; - SLKeyMap_List[i].name = name; - return &SLKeyMap_List[i]; - } - } - SLang_Error = SL_UNKNOWN_ERROR; - /* SLang_doerror ("Keymap quota exceeded."); */ - return NULL; -} - -FVOID_STAR SLang_find_key_function(char *name, SLKeyMap_List_Type *keymap) -{ - SLKeymap_Function_Type *fp = keymap -> functions; - char ch = *name; - - while ((fp != NULL) && (fp->name != NULL)) - { - if ((ch == *fp->name) - && (0 == strcmp(fp->name, name))) - return (FVOID_STAR) fp->f; - - fp++; - } - return NULL; -} - -#ifdef REAL_UNIX_SYSTEM -/* Expand termcap string specified by s. s as passed will have the format: - * "XY)..." where XY represents a termcap keyname. - */ -static char *process_termcap_string (char *s, char *str, int *ip, int imax) -{ - char c[3], *val; - int i; - - if ((0 == (c[0] = s[0])) - || (0 == (c[1] = s[1])) - || (s[2] != ')')) - { - SLang_verror (SL_SYNTAX_ERROR, "setkey: ^(%s is badly formed", s); - return NULL; - } - s += 3; - - c[2] = 0; - if ((NULL == (val = SLtt_tgetstr (c))) - || (*val == 0)) - return NULL; - - i = *ip; - while ((i < imax) && (*val != 0)) - { - str[i++] = *val++; - } - *ip = i; - - return s; -} -#endif - -/* convert things like "^A" to 1 etc... The 0th char is the strlen INCLUDING - * the length character itself. - */ -char *SLang_process_keystring(char *s) -{ - /* FIXME: v2.0, make this thread safe */ - static char str[32]; - unsigned char ch; - int i; - - i = 1; - while (*s != 0) - { - ch = (unsigned char) *s++; - if (ch == '^') - { - ch = *s++; - if (ch == 0) - { - if (i < 32) - str[i++] = '^'; - break; - } -#ifdef REAL_UNIX_SYSTEM - if (ch == '(') - { - s = process_termcap_string (s, str, &i, 32); - if (s == NULL) - { - str[0] = 1; - return str; - } - continue; - } -#endif - ch = UPPER_CASE_KEY(ch); - if (ch == '?') ch = 127; else ch = ch - 'A' + 1; - } - - if (i >= 32) break; - str[i++] = ch; - } - - if (i > SLANG_MAX_KEYMAP_KEY_SEQ) - { - SLang_verror (SL_INVALID_PARM, "Key sequence is too long"); - return NULL; - } - - str[0] = i; - return(str); -} - -static int key_string_compare (unsigned char *a, unsigned char *b, unsigned int len) -{ - unsigned char *amax = a + len; - int cha, chb, cha_up, chb_up; - - while (a < amax) - { - cha = *a++; - chb = *b++; - - if (cha == chb) continue; - - cha_up = UPPER_CASE_KEY(cha); - chb_up = UPPER_CASE_KEY(chb); - - if (cha_up == chb_up) - { - /* Use case-sensitive result. */ - return cha - chb; - } - /* Use case-insensitive result. */ - return cha_up - chb_up; - } - return 0; -} - -static char *Define_Key_Error = "Inconsistency in define key."; - -/* This function also performs an insertion in an ordered way. */ -static int find_the_key (char *s, SLKeyMap_List_Type *kml, SLang_Key_Type **keyp) -{ - unsigned char ch; - unsigned int str_len; - SLang_Key_Type *key, *last, *neew; - unsigned char *str; - - *keyp = NULL; - - if (NULL == (str = (unsigned char *) SLang_process_keystring(s))) - return -2; - - if (1 == (str_len = str[0])) - return 0; - - ch = str[1]; - key = kml->keymap + ch; - - if (str_len == 2) - { - if (key->next != NULL) - { - SLang_doerror (Define_Key_Error); - return -2; - } - - if (key->type == SLKEY_F_INTERPRET) - SLang_free_slstring (key->f.s); - - key->str[0] = str_len; - key->str[1] = ch; - - *keyp = key; - return 0; - } - - /* insert the key definition */ - while (1) - { - int cmp; - unsigned int key_len, len; - - last = key; - key = key->next; - - if ((key != NULL) && (key->str != NULL)) - { - len = key_len = key->str[0]; - if (len > str_len) len = str_len; - - cmp = key_string_compare (str + 1, key->str + 1, len - 1); - - if (cmp > 0) - continue; - - if (cmp == 0) - { - if (key_len != str_len) - { - SLang_doerror (Define_Key_Error); - return -2; - } - - if (key->type == SLKEY_F_INTERPRET) - SLang_free_slstring (key->f.s); - - *keyp = key; - return 0; - } - /* Drop to cmp < 0 case */ - } - - if (NULL == (neew = malloc_key(str))) return -1; - - neew -> next = key; - last -> next = neew; - - *keyp = neew; - return 0; - } -} - -/* returns -2 if inconsistent, -1 if malloc error, 0 upon success */ -int SLkm_define_key (char *s, FVOID_STAR f, SLKeyMap_List_Type *kml) -{ - SLang_Key_Type *key; - unsigned int type = SLKEY_F_INTRINSIC; - int ret; - - ret = find_the_key (s, kml, &key); - if ((ret != 0) || (key == NULL)) - return ret; - - key->type = type; - key->f.f = f; - return 0; -} - -int SLang_define_key (char *s, char *funct, SLKeyMap_List_Type *kml) -{ - SLang_Key_Type *key; - FVOID_STAR f; - int ret; - - ret = find_the_key (s, kml, &key); - if ((ret != 0) || (key == NULL)) - return ret; - - f = SLang_find_key_function(funct, kml); - - if (f == NULL) /* assume interpreted */ - { - char *str = SLang_create_slstring (funct); - if (str == NULL) return -1; - key->type = SLKEY_F_INTERPRET; - key->f.s = str; - } - else - { - key->type = SLKEY_F_INTRINSIC; - key->f.f = f; - } - return 0; -} - -int SLkm_define_keysym (char *s, unsigned int keysym, SLKeyMap_List_Type *kml) -{ - SLang_Key_Type *key; - int ret; - - ret = find_the_key (s, kml, &key); - - if ((ret != 0) || (key == NULL)) - return ret; - - key->type = SLKEY_F_KEYSYM; - key->f.keysym = keysym; - return 0; -} - -SLang_Key_Type *SLang_do_key(SLKeyMap_List_Type *kml, int (*getkey)(void)) -{ - register SLang_Key_Type *key, *next, *kmax; - unsigned int len; - unsigned char input_ch; - register unsigned char chup, chlow; - unsigned char key_ch = 0; - - SLang_Last_Key_Char = (*getkey)(); - SLang_Key_TimeOut_Flag = 0; - - if (SLANG_GETKEY_ERROR == (unsigned int) SLang_Last_Key_Char) - return NULL; - - input_ch = (unsigned char) SLang_Last_Key_Char; - - key = (SLang_Key_Type *) &((kml->keymap)[input_ch]); - - /* if the next one is null, then we know this MAY be it. */ - while (key->next == NULL) - { - if (key->type != 0) - return key; - - /* Try its opposite case counterpart */ - chlow = LOWER_CASE_KEY(input_ch); - if (input_ch == chlow) - input_ch = UPPER_CASE_KEY(input_ch); - - key = kml->keymap + input_ch; - if (key->type == 0) - return NULL; - } - - /* It appears to be a prefix character in a key sequence. */ - - len = 1; /* already read one character */ - key = key->next; /* Now we are in the key list */ - kmax = NULL; /* set to end of list */ - - while (1) - { - SLang_Key_TimeOut_Flag = 1; - SLang_Last_Key_Char = (*getkey)(); - SLang_Key_TimeOut_Flag = 0; - - len++; - - if ((SLANG_GETKEY_ERROR == (unsigned int) SLang_Last_Key_Char) - || SLKeyBoard_Quit) - break; - - input_ch = (unsigned char) SLang_Last_Key_Char; - - chup = UPPER_CASE_KEY(input_ch); chlow = LOWER_CASE_KEY(input_ch); - - while (key != kmax) - { - if (key->str[0] > len) - { - key_ch = key->str[len]; - if (chup == UPPER_CASE_KEY(key_ch)) - break; - } - key = key->next; - } - - if (key == kmax) break; - - /* If the input character is lowercase, check to see if there is - * a lowercase match. If so, set key to it. Note: the - * algorithm assumes the sorting performed by key_string_compare. - */ - if (input_ch != key_ch) - { - next = key->next; - while (next != kmax) - { - if (next->str[0] > len) - { - unsigned char next_ch = next->str[len]; - if (next_ch == input_ch) - { - key = next; - break; - } - if (next_ch != chup) - break; - } - next = next->next; - } - } - - /* Ok, we found the first position of a possible match. If it - * is exact, we are done. - */ - if ((unsigned int) key->str[0] == len + 1) - return key; - - /* Apparantly, there are some ambiguities. Read next key to resolve - * the ambiguity. Adjust kmax to encompass ambiguities. - */ - - next = key->next; - while (next != kmax) - { - if ((unsigned int) next->str[0] > len) - { - key_ch = next->str[len]; - if (chup != UPPER_CASE_KEY(key_ch)) - break; - } - next = next->next; - } - kmax = next; - } - - return NULL; -} - -void SLang_undefine_key(char *s, SLKeyMap_List_Type *kml) -{ - int n, i; - SLang_Key_Type *key, *next, *last, *key_root, *keymap; - unsigned char *str; - - keymap = kml -> keymap; - if (NULL == (str = (unsigned char *) SLang_process_keystring(s))) - return; - - if (0 == (n = *str++ - 1)) return; - i = *str; - - last = key_root = (SLang_Key_Type *) &(keymap[i]); - key = key_root->next; - - while (key != NULL) - { - next = key->next; - if (0 == SLMEMCMP ((char *)(key->str + 1), (char *) str, n)) - { - if (key->type == SLKEY_F_INTERPRET) - SLang_free_slstring (key->f.s); - - SLfree((char *) key); - last->next = next; - } - else last = key; - key = next; - } - - if (n == 1) - { - *key_root->str = 0; - key_root->f.f = NULL; - key_root->type = 0; - } -} - -char *SLang_make_keystring(unsigned char *s) -{ - static char buf [3 * SLANG_MAX_KEYMAP_KEY_SEQ + 1]; - char *b; - int n; - - n = *s++ - 1; - - if (n > SLANG_MAX_KEYMAP_KEY_SEQ) - { - SLang_verror (SL_INVALID_PARM, "Key sequence is too long"); - return NULL; - } - - b = buf; - while (n--) - { - if (*s < 32) - { - *b++ = '^'; - *b++ = *s + 'A' - 1; - } - else *b++ = *s; - s++; - } - *b = 0; - return(buf); -} - -static SLang_Key_Type *copy_keymap(SLKeyMap_List_Type *kml) -{ - int i; - SLang_Key_Type *neew, *old, *new_root, *km; - - if (NULL == (new_root = (SLang_Key_Type *) SLcalloc(256, sizeof(SLang_Key_Type)))) - return NULL; - - if (kml == NULL) return new_root; - km = kml->keymap; - - for (i = 0; i < 256; i++) - { - old = &(km[i]); - neew = &(new_root[i]); - - if (old->type == SLKEY_F_INTERPRET) - neew->f.s = SLang_create_slstring (old->f.s); - else - neew->f.f = old->f.f; - - neew->type = old->type; - SLMEMCPY((char *) neew->str, (char *) old->str, (unsigned int) *old->str); - - old = old->next; - while (old != NULL) - { - neew->next = malloc_key((unsigned char *) old->str); - neew = neew->next; - - if (old->type == SLKEY_F_INTERPRET) - neew->f.s = SLang_create_slstring (old->f.s); - else - neew->f.f = old->f.f; - - neew->type = old->type; - old = old->next; - } - neew->next = NULL; - } - return(new_root); -} - -SLKeyMap_List_Type *SLang_create_keymap(char *name, SLKeyMap_List_Type *map) -{ - SLang_Key_Type *neew; - SLKeyMap_List_Type *new_map; - - if ((NULL == (neew = copy_keymap(map))) - || (NULL == (new_map = add_keymap(name, neew)))) return NULL; - - if (map != NULL) new_map -> functions = map -> functions; - - return new_map; -} - -SLKeyMap_List_Type *SLang_find_keymap(char *name) -{ - SLKeyMap_List_Type *kmap, *kmap_max; - - kmap = SLKeyMap_List; - kmap_max = kmap + SLANG_MAX_KEYMAPS; - - while (kmap < kmap_max) - { - if ((kmap->name != NULL) - && (0 == strcmp (kmap->name, name))) - return kmap; - - kmap++; - } - return NULL; -} diff --git a/mdk-stage1/slang/slkeypad.c b/mdk-stage1/slang/slkeypad.c deleted file mode 100644 index 524dc80fa..000000000 --- a/mdk-stage1/slang/slkeypad.c +++ /dev/null @@ -1,163 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -static SLKeyMap_List_Type *Keymap_List; - -int SLkp_init (void) -{ - char esc_seq[10]; - int i; - - if (NULL == (Keymap_List = SLang_create_keymap ("_SLKeypad", NULL))) - return -1; - - esc_seq[1] = 0; - for (i = 1; i < 256; i++) - { - esc_seq[0] = (char) i; - SLkm_define_keysym (esc_seq, i, Keymap_List); - } - - /* Now add most common ones. */ -#ifndef IBMPC_SYSTEM - SLkm_define_keysym ("^@", 0, Keymap_List); - - SLkm_define_keysym ("\033[A", SL_KEY_UP, Keymap_List); - SLkm_define_keysym ("\033OA", SL_KEY_UP, Keymap_List); - SLkm_define_keysym ("\033[B", SL_KEY_DOWN, Keymap_List); - SLkm_define_keysym ("\033OB", SL_KEY_DOWN, Keymap_List); - SLkm_define_keysym ("\033[C", SL_KEY_RIGHT, Keymap_List); - SLkm_define_keysym ("\033OC", SL_KEY_RIGHT, Keymap_List); - SLkm_define_keysym ("\033[D", SL_KEY_LEFT, Keymap_List); - SLkm_define_keysym ("\033OD", SL_KEY_LEFT, Keymap_List); - SLkm_define_keysym ("\033[2~", SL_KEY_IC, Keymap_List); - SLkm_define_keysym ("\033[7~", SL_KEY_HOME, Keymap_List); - SLkm_define_keysym ("\033[5~", SL_KEY_PPAGE, Keymap_List); - SLkm_define_keysym ("\033[6~", SL_KEY_NPAGE, Keymap_List); - SLkm_define_keysym ("\033[8~", SL_KEY_END, Keymap_List); - SLkm_define_keysym ("\033[3~", SL_KEY_DELETE, Keymap_List); -#else - /* Note: This will not work if SLgetkey_map_to_ansi (1) has - * been called. - */ - SLkm_define_keysym ("^@\x48", SL_KEY_UP, Keymap_List ); - SLkm_define_keysym ("^@\x50", SL_KEY_DOWN, Keymap_List ); - SLkm_define_keysym ("^@\x4d", SL_KEY_RIGHT, Keymap_List ); - SLkm_define_keysym ("^@\x4b", SL_KEY_LEFT, Keymap_List ); - SLkm_define_keysym ("^@\x47", SL_KEY_HOME, Keymap_List ); - SLkm_define_keysym ("^@\x49", SL_KEY_PPAGE, Keymap_List ); - SLkm_define_keysym ("^@\x51", SL_KEY_NPAGE, Keymap_List ); - SLkm_define_keysym ("^@\x4f", SL_KEY_END, Keymap_List ); - SLkm_define_keysym ("^@\x52", SL_KEY_IC, Keymap_List ); - SLkm_define_keysym ("^@\x53", SL_KEY_DELETE, Keymap_List ); - - SLkm_define_keysym ("\xE0\x48", SL_KEY_UP, Keymap_List ); - SLkm_define_keysym ("\xE0\x50", SL_KEY_DOWN, Keymap_List ); - SLkm_define_keysym ("\xE0\x4d", SL_KEY_RIGHT, Keymap_List ); - SLkm_define_keysym ("\xE0\x4b", SL_KEY_LEFT, Keymap_List ); - SLkm_define_keysym ("\xE0\x47", SL_KEY_HOME, Keymap_List ); - SLkm_define_keysym ("\xE0\x49", SL_KEY_PPAGE, Keymap_List ); - SLkm_define_keysym ("\xE0\x51", SL_KEY_NPAGE, Keymap_List ); - SLkm_define_keysym ("\xE0\x4f", SL_KEY_END, Keymap_List ); - SLkm_define_keysym ("\xE0\x52", SL_KEY_IC, Keymap_List ); - SLkm_define_keysym ("\xE0\x53", SL_KEY_DELETE, Keymap_List ); - - strcpy (esc_seq, "^@ "); /* guarantees esc_seq[3] = 0. */ - - for (i = 0x3b; i < 0x45; i++) - { - esc_seq [2] = i; - SLkm_define_keysym (esc_seq, SL_KEY_F(i - 0x3a), Keymap_List); - } - esc_seq[2] = 0x57; SLkm_define_keysym (esc_seq, SL_KEY_F(11), Keymap_List); - esc_seq[2] = 0x58; SLkm_define_keysym (esc_seq, SL_KEY_F(12), Keymap_List); -#endif - -#ifdef REAL_UNIX_SYSTEM - strcpy (esc_seq, "^(kX)"); - for (i = 0; i <= 9; i++) - { - esc_seq[3] = '0' + i; - SLkm_define_keysym (esc_seq, SL_KEY_F(i), Keymap_List); - } - SLkm_define_keysym ("^(k;)", SL_KEY_F(10), Keymap_List); - - SLkm_define_keysym ("^(ku)", SL_KEY_UP, Keymap_List); - SLkm_define_keysym ("^(kd)", SL_KEY_DOWN, Keymap_List); - SLkm_define_keysym ("^(kl)", SL_KEY_LEFT, Keymap_List); - SLkm_define_keysym ("^(kr)", SL_KEY_RIGHT, Keymap_List); - SLkm_define_keysym ("^(kP)", SL_KEY_PPAGE, Keymap_List); - SLkm_define_keysym ("^(kN)", SL_KEY_NPAGE, Keymap_List); - SLkm_define_keysym ("^(kh)", SL_KEY_HOME, Keymap_List); - SLkm_define_keysym ("^(@7)", SL_KEY_END, Keymap_List); - SLkm_define_keysym ("^(K1)", SL_KEY_A1, Keymap_List); - SLkm_define_keysym ("^(K3)", SL_KEY_A3, Keymap_List); - SLkm_define_keysym ("^(K2)", SL_KEY_B2, Keymap_List); - SLkm_define_keysym ("^(K4)", SL_KEY_C1, Keymap_List); - SLkm_define_keysym ("^(K5)", SL_KEY_C3, Keymap_List); - SLkm_define_keysym ("^(%0)", SL_KEY_REDO, Keymap_List); - SLkm_define_keysym ("^(&8)", SL_KEY_UNDO, Keymap_List); - SLkm_define_keysym ("^(kb)", SL_KEY_BACKSPACE, Keymap_List); - SLkm_define_keysym ("^(@8)", SL_KEY_ENTER, Keymap_List); - SLkm_define_keysym ("^(kD)", SL_KEY_DELETE, Keymap_List); -#endif - - if (SLang_Error) - return -1; - return 0; -} - -int SLkp_getkey (void) -{ - SLang_Key_Type *key; - - key = SLang_do_key (Keymap_List, (int (*)(void)) SLang_getkey); - if ((key == NULL) || (key->type != SLKEY_F_KEYSYM)) - { - SLang_flush_input (); - return SL_KEY_ERR; - } - - return key->f.keysym; -} - -int SLkp_define_keysym (char *keystr, unsigned int keysym) -{ - if (SLkm_define_keysym (keystr, keysym, Keymap_List) < 0) - return -1; - - return 0; -} - -#if 0 -int main (int argc, char **argv) -{ - int ch; - - SLtt_get_terminfo (); - - if (-1 == SLkp_init ()) - return 1; - - SLang_init_tty (-1, 0, 0); - - while ('q' != (ch = SLkp_getkey ())) - { - fprintf (stdout, "Keycode = %d\r\n", ch); - fflush (stdout); - } - - SLang_reset_tty (); - - return 0; -} -#endif - diff --git a/mdk-stage1/slang/sllimits.h b/mdk-stage1/slang/sllimits.h deleted file mode 100644 index c4ae03b83..000000000 --- a/mdk-stage1/slang/sllimits.h +++ /dev/null @@ -1,64 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -/* sllimits.h */ - -/* slstring.c: Size of the hash table used for strings (prime numbers) */ -#ifdef __MSDOS_16BIT__ -# define SLSTRING_HASH_TABLE_SIZE 601 -# define SLASSOC_HASH_TABLE_SIZE 601 -#else -# define SLSTRING_HASH_TABLE_SIZE 2909 -# define SLASSOC_HASH_TABLE_SIZE 2909 -#endif - -/* slang.c: maximum size of run time stack */ -#ifdef __MSDOS_16BIT__ -# define SLANG_MAX_STACK_LEN 500 -#else -# define SLANG_MAX_STACK_LEN 2500 -#endif - -/* slang.c: This sets the size on the depth of function calls */ -#ifdef __MSDOS_16BIT__ -# define SLANG_MAX_RECURSIVE_DEPTH 50 -#else -# define SLANG_MAX_RECURSIVE_DEPTH 250 -#endif - -/* slang.c: Size of the stack used for local variables */ -#ifdef __MSDOS_16BIT__ -# define SLANG_MAX_LOCAL_STACK 200 -#else -# define SLANG_MAX_LOCAL_STACK 1024 -#endif - -/* slang.c: The size of the hash table used for local and global objects. - * These should be prime numbers. - */ -#define SLGLOBALS_HASH_TABLE_SIZE 2909 -#define SLLOCALS_HASH_TABLE_SIZE 73 -#define SLSTATIC_HASH_TABLE_SIZE 73 - -/* Size of the keyboard buffer use by the ungetkey routines */ -#ifdef __MSDOS_16BIT__ -# define SL_MAX_INPUT_BUFFER_LEN 40 -#else -# define SL_MAX_INPUT_BUFFER_LEN 1024 -#endif - -/* Maximum number of nested switch statements */ -#define SLANG_MAX_NESTED_SWITCH 10 - -/* Size of the block stack (used in byte-compiling) */ -#define SLANG_MAX_BLOCK_STACK_LEN 50 - -/* slfile.c: Max number of open file pointers */ -#ifdef __MSDOS_16BIT__ -# define SL_MAX_FILES 32 -#else -# define SL_MAX_FILES 256 -#endif diff --git a/mdk-stage1/slang/slmalloc.c b/mdk-stage1/slang/slmalloc.c deleted file mode 100644 index be4ed6cae..000000000 --- a/mdk-stage1/slang/slmalloc.c +++ /dev/null @@ -1,165 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#ifdef SL_MALLOC_DEBUG -# undef SL_MALLOC_DEBUG -#endif - -#include "slang.h" -#include "_slang.h" - -#ifdef __alpha -# define Chunk 8 -#else -# define Chunk 4 -#endif - -static long Total_Allocated; -static long Max_Single_Allocation; -static long Max_Allocated; -/* #define SLDEBUG_DOUT */ - -#ifdef SLDEBUG_DOUT -static FILE *dout; -#endif - -void SLmalloc_dump_statistics (void) -{ -#ifdef SLDEBUG_DOUT - fflush (dout); -#endif - fprintf (stderr, "Total Allocated: %ld\nHighest single allocation: %ld\nHighest Total Allocated:%ld\n", - Total_Allocated, Max_Single_Allocation, Max_Allocated); -} - -static void register_at_exit_fun (void) -{ - static int is_registered = 0; - if (is_registered) - return; - is_registered = 1; - -#ifdef SLDEBUG_DOUT - if (dout == NULL) dout = fopen ("malloc.out", "w"); -#endif - SLang_add_cleanup_function (SLmalloc_dump_statistics); -} - -static void fixup (unsigned char *p, unsigned long n, char *what) -{ - register_at_exit_fun (); - - p += Chunk; - *(p - 4)= (unsigned char) ((n >> 24) & 0xFF); - *(p - 3) = (unsigned char) ((n >> 16) & 0xFF); - *(p - 2) = (unsigned char) ((n >> 8) & 0xFF); - *(p - 1) = (unsigned char) (n & 0xFF); - *(p + (int) n) = 27; - *(p + (int) (n + 1)) = 182; - *(p + (int) (n + 2)) = 81; - *(p + (int) (n + 3)) = 86; - Total_Allocated += (long) n; - if (Total_Allocated > Max_Allocated) Max_Allocated = Total_Allocated; - if ((long) n > Max_Single_Allocation) - Max_Single_Allocation = (long) n; - -#ifdef SLDEBUG_DOUT - fprintf (dout, "ALLOC: %s\t%p %ld\n", what, p, (long) n); -#else - (void) what; -#endif -} - -static void SLmalloc_doerror (char *buf) -{ - SLang_doerror (buf); -} - -static int check_memory (unsigned char *p, char *what) -{ - char buf[128]; - unsigned long n; - - register_at_exit_fun (); - - n = ((unsigned long) *(p - 4)) << 24; - n |= ((unsigned long) *(p - 3)) << 16; - n |= ((unsigned long) *(p - 2)) << 8; - n |= (unsigned long) *(p - 1); - - if (n == 0xFFFFFFFFUL) - { - sprintf (buf, "%s: %p: Already FREE! Abort NOW.", what, (void*)p - Chunk); - SLmalloc_doerror (buf); - return -1; - } - - if ((*(p + (int) n) != 27) - || (*(p + (int) (n + 1)) != 182) - || (*(p + (int) (n + 2)) != 81) - || (*(p + (int) (n + 3)) != 86)) - { - sprintf (buf, "\007%s: %p: Memory corrupt! Abort NOW.", what, (void*)p); - SLmalloc_doerror (buf); - return -1; - } - - *(p - 4) = *(p - 3) = *(p - 2) = *(p - 1) = 0xFF; - - Total_Allocated -= (long) n; - if (Total_Allocated < 0) - { - sprintf (buf, "\007%s: %p\nFreed %ld, Allocated is: %ld!\n", - what, (void*)p, (long) n, Total_Allocated); - SLang_doerror (buf); - } -#ifdef SLDEBUG_DOUT - fprintf (dout, "FREE: %s:\t%p %ld\n", what, p, (long) n); -#endif - return 0; -} - -void SLdebug_free (char *p) -{ - if (p == NULL) return; - if (-1 == check_memory ((unsigned char *) p, "FREE")) return; - - SLFREE (p - Chunk); -} - -char *SLdebug_malloc (unsigned long n) -{ - char *p; - - if ((p = (char *) SLMALLOC (n + 2 * Chunk)) == NULL) return NULL; - - fixup ((unsigned char *) p, n, "MALLOC"); - return p + Chunk; -} - -char *SLdebug_realloc (char *p, unsigned long n) -{ - if (-1 == check_memory ((unsigned char *) p, "REALLOC")) return NULL; - if ((p = (char *) SLREALLOC (p - Chunk, n + 2 * Chunk)) == NULL) return NULL; - fixup ((unsigned char *) p, n, "REALLOC"); - return p + Chunk; -} - -char *SLdebug_calloc (unsigned long n, unsigned long size) -{ - char *p; - int m; - - /* This is tough -- hope this is a good assumption!! */ - if (size >= Chunk) m = 1; else m = Chunk; - - if ((p = (char *) SLCALLOC (n + m + m, size)) == NULL) return NULL; - fixup ((unsigned char *) p, size * n, "CALLOC"); - return p + Chunk; -} - diff --git a/mdk-stage1/slang/slmath.c b/mdk-stage1/slang/slmath.c deleted file mode 100644 index 1d61e14d3..000000000 --- a/mdk-stage1/slang/slmath.c +++ /dev/null @@ -1,565 +0,0 @@ -/* sin, cos, etc, for S-Lang */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include <math.h> - -#include "slang.h" -#include "_slang.h" - -#ifdef PI -# undef PI -#endif -#define PI 3.14159265358979323846264338327950288 - -#if defined(__unix__) -#include <signal.h> -#include <errno.h> - -#define SIGNAL SLsignal - -static void math_floating_point_exception (int sig) -{ - sig = errno; - if (SLang_Error == 0) SLang_Error = SL_FLOATING_EXCEPTION; - (void) SIGNAL (SIGFPE, math_floating_point_exception); - errno = sig; -} -#endif - -double SLmath_hypot (double x, double y) -{ - double fr, fi, ratio; - - fr = fabs(x); - fi = fabs(y); - - if (fr > fi) - { - ratio = y / x; - x = fr * sqrt (1.0 + ratio * ratio); - } - else if (fi == 0.0) x = 0.0; - else - { - ratio = x / y; - x = fi * sqrt (1.0 + ratio * ratio); - } - - return x; -} - -/* usage here is a1 a2 ... an n x ==> a1x^n + a2 x ^(n - 1) + ... + an */ -static double math_poly (void) -{ - int n; - double xn = 1.0, sum = 0.0; - double an, x; - - if ((SLang_pop_double(&x, NULL, NULL)) - || (SLang_pop_integer(&n))) return(0.0); - - while (n-- > 0) - { - if (SLang_pop_double(&an, NULL, NULL)) break; - sum += an * xn; - xn = xn * x; - } - return (double) sum; -} - -static int double_math_op_result (int op, unsigned char a, unsigned char *b) -{ - (void) op; - - if (a != SLANG_FLOAT_TYPE) - *b = SLANG_DOUBLE_TYPE; - else - *b = a; - - return 1; -} - -#ifdef HAVE_ASINH -# define ASINH_FUN asinh -#else -# define ASINH_FUN my_asinh -static double my_asinh (double x) -{ - return log (x + sqrt (x*x + 1)); -} -#endif -#ifdef HAVE_ACOSH -# define ACOSH_FUN acosh -#else -# define ACOSH_FUN my_acosh -static double my_acosh (double x) -{ - return log (x + sqrt(x*x - 1)); /* x >= 1 */ -} -#endif -#ifdef HAVE_ATANH -# define ATANH_FUN atanh -#else -# define ATANH_FUN my_atanh -static double my_atanh (double x) -{ - return 0.5 * log ((1.0 + x)/(1.0 - x)); /* 0 <= x^2 < 1 */ -} -#endif - -static int double_math_op (int op, - unsigned char type, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - double *a, *b; - unsigned int i; - double (*fun) (double); - - (void) type; - a = (double *) ap; - b = (double *) bp; - - switch (op) - { - default: - return 0; - - case SLMATH_SINH: - fun = sinh; - break; - case SLMATH_COSH: - fun = cosh; - break; - case SLMATH_TANH: - fun = tanh; - break; - case SLMATH_TAN: - fun = tan; - break; - case SLMATH_ASIN: - fun = asin; - break; - case SLMATH_ACOS: - fun = acos; - break; - case SLMATH_ATAN: - fun = atan; - break; - case SLMATH_EXP: - fun = exp; - break; - case SLMATH_LOG: - fun = log; - break; - case SLMATH_LOG10: - fun = log10; - break; - case SLMATH_SQRT: - fun = sqrt; - break; - case SLMATH_SIN: - fun = sin; - break; - case SLMATH_COS: - fun = cos; - break; - - case SLMATH_ASINH: - fun = ASINH_FUN; - break; - case SLMATH_ATANH: - fun = ATANH_FUN; - break; - case SLMATH_ACOSH: - fun = ACOSH_FUN; - break; - - case SLMATH_CONJ: - case SLMATH_REAL: - for (i = 0; i < na; i++) - b[i] = a[i]; - return 1; - case SLMATH_IMAG: - for (i = 0; i < na; i++) - b[i] = 0.0; - return 1; - } - - for (i = 0; i < na; i++) - b[i] = (*fun) (a[i]); - - return 1; -} - -static int float_math_op (int op, - unsigned char type, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - float *a, *b; - unsigned int i; - double (*fun) (double); - - (void) type; - a = (float *) ap; - b = (float *) bp; - - - switch (op) - { - default: - return 0; - - case SLMATH_SINH: - fun = sinh; - break; - case SLMATH_COSH: - fun = cosh; - break; - case SLMATH_TANH: - fun = tanh; - break; - case SLMATH_TAN: - fun = tan; - break; - case SLMATH_ASIN: - fun = asin; - break; - case SLMATH_ACOS: - fun = acos; - break; - case SLMATH_ATAN: - fun = atan; - break; - case SLMATH_EXP: - fun = exp; - break; - case SLMATH_LOG: - fun = log; - break; - case SLMATH_LOG10: - fun = log10; - break; - case SLMATH_SQRT: - fun = sqrt; - break; - case SLMATH_SIN: - fun = sin; - break; - case SLMATH_COS: - fun = cos; - break; - - case SLMATH_ASINH: - fun = ASINH_FUN; - break; - case SLMATH_ATANH: - fun = ATANH_FUN; - break; - case SLMATH_ACOSH: - fun = ACOSH_FUN; - break; - - case SLMATH_CONJ: - case SLMATH_REAL: - for (i = 0; i < na; i++) - b[i] = a[i]; - return 1; - case SLMATH_IMAG: - for (i = 0; i < na; i++) - b[i] = 0.0; - return 1; - } - - for (i = 0; i < na; i++) - b[i] = (float) (*fun) ((double) a[i]); - - return 1; -} - -static int generic_math_op (int op, - unsigned char type, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - double *b; - unsigned int i; - SLang_To_Double_Fun_Type to_double; - double (*fun) (double); - unsigned int da; - char *a; - - if (NULL == (to_double = SLarith_get_to_double_fun (type, &da))) - return 0; - - b = (double *) bp; - a = (char *) ap; - - switch (op) - { - default: - return 0; - - case SLMATH_SINH: - fun = sinh; - break; - case SLMATH_COSH: - fun = cosh; - break; - case SLMATH_TANH: - fun = tanh; - break; - case SLMATH_TAN: - fun = tan; - break; - case SLMATH_ASIN: - fun = asin; - break; - case SLMATH_ACOS: - fun = acos; - break; - case SLMATH_ATAN: - fun = atan; - break; - case SLMATH_EXP: - fun = exp; - break; - case SLMATH_LOG: - fun = log; - break; - case SLMATH_LOG10: - fun = log10; - break; - case SLMATH_SQRT: - fun = sqrt; - break; - case SLMATH_SIN: - fun = sin; - break; - case SLMATH_COS: - fun = cos; - break; - - case SLMATH_ASINH: - fun = ASINH_FUN; - break; - case SLMATH_ATANH: - fun = ATANH_FUN; - break; - case SLMATH_ACOSH: - fun = ACOSH_FUN; - break; - - - case SLMATH_CONJ: - case SLMATH_REAL: - for (i = 0; i < na; i++) - { - b[i] = to_double((VOID_STAR) a); - a += da; - } - return 1; - - case SLMATH_IMAG: - for (i = 0; i < na; i++) - b[i] = 0.0; - return 1; - } - - for (i = 0; i < na; i++) - { - b[i] = (*fun) (to_double ((VOID_STAR) a)); - a += da; - } - - return 1; -} - -#if SLANG_HAS_COMPLEX -static int complex_math_op_result (int op, unsigned char a, unsigned char *b) -{ - (void) a; - switch (op) - { - default: - *b = SLANG_COMPLEX_TYPE; - break; - - case SLMATH_REAL: - case SLMATH_IMAG: - *b = SLANG_DOUBLE_TYPE; - break; - } - return 1; -} - -static int complex_math_op (int op, - unsigned char type, VOID_STAR ap, unsigned int na, - VOID_STAR bp) -{ - double *a, *b; - unsigned int i; - unsigned int na2 = na * 2; - double *(*fun) (double *, double *); - - (void) type; - a = (double *) ap; - b = (double *) bp; - - switch (op) - { - default: - return 0; - - case SLMATH_REAL: - for (i = 0; i < na; i++) - b[i] = a[2 * i]; - return 1; - - case SLMATH_IMAG: - for (i = 0; i < na; i++) - b[i] = a[2 * i + 1]; - return 1; - - case SLMATH_CONJ: - for (i = 0; i < na2; i += 2) - { - b[i] = a[i]; - b[i+1] = -a[i+1]; - } - return 1; - - case SLMATH_ATANH: - fun = SLcomplex_atanh; - break; - case SLMATH_ACOSH: - fun = SLcomplex_acosh; - break; - case SLMATH_ASINH: - fun = SLcomplex_asinh; - break; - case SLMATH_EXP: - fun = SLcomplex_exp; - break; - case SLMATH_LOG: - fun = SLcomplex_log; - break; - case SLMATH_LOG10: - fun = SLcomplex_log10; - break; - case SLMATH_SQRT: - fun = SLcomplex_sqrt; - break; - case SLMATH_SIN: - fun = SLcomplex_sin; - break; - case SLMATH_COS: - fun = SLcomplex_cos; - break; - case SLMATH_SINH: - fun = SLcomplex_sinh; - break; - case SLMATH_COSH: - fun = SLcomplex_cosh; - break; - case SLMATH_TANH: - fun = SLcomplex_tanh; - break; - case SLMATH_TAN: - fun = SLcomplex_tan; - break; - case SLMATH_ASIN: - fun = SLcomplex_asin; - break; - case SLMATH_ACOS: - fun = SLcomplex_acos; - break; - case SLMATH_ATAN: - fun = SLcomplex_atan; - break; - } - - for (i = 0; i < na2; i += 2) - (void) (*fun) (b + i, a + i); - - return 1; -} -#endif - -static SLang_DConstant_Type DConst_Table [] = -{ - MAKE_DCONSTANT("E", 2.718281828459045), - MAKE_DCONSTANT("PI", 3.14159265358979323846264338327950288), - SLANG_END_DCONST_TABLE -}; - -static SLang_Math_Unary_Type SLmath_Table [] = -{ - MAKE_MATH_UNARY("sinh", SLMATH_SINH), - MAKE_MATH_UNARY("asinh", SLMATH_ASINH), - MAKE_MATH_UNARY("cosh", SLMATH_COSH), - MAKE_MATH_UNARY("acosh", SLMATH_ACOSH), - MAKE_MATH_UNARY("tanh", SLMATH_TANH), - MAKE_MATH_UNARY("atanh", SLMATH_ATANH), - MAKE_MATH_UNARY("sin", SLMATH_SIN), - MAKE_MATH_UNARY("cos", SLMATH_COS), - MAKE_MATH_UNARY("tan", SLMATH_TAN), - MAKE_MATH_UNARY("atan", SLMATH_ATAN), - MAKE_MATH_UNARY("acos", SLMATH_ACOS), - MAKE_MATH_UNARY("asin", SLMATH_ASIN), - MAKE_MATH_UNARY("exp", SLMATH_EXP), - MAKE_MATH_UNARY("log", SLMATH_LOG), - MAKE_MATH_UNARY("sqrt", SLMATH_SQRT), - MAKE_MATH_UNARY("log10", SLMATH_LOG10), -#if SLANG_HAS_COMPLEX - MAKE_MATH_UNARY("Real", SLMATH_REAL), - MAKE_MATH_UNARY("Imag", SLMATH_IMAG), - MAKE_MATH_UNARY("Conj", SLMATH_CONJ), -#endif - SLANG_END_MATH_UNARY_TABLE -}; - -static SLang_Intrin_Fun_Type SLang_Math_Table [] = -{ - MAKE_INTRINSIC_0("polynom", math_poly, SLANG_DOUBLE_TYPE), - SLANG_END_INTRIN_FUN_TABLE -}; - -int SLang_init_slmath (void) -{ - unsigned char *int_types; - -#if defined(__unix__) - (void) SIGNAL (SIGFPE, math_floating_point_exception); -#endif - - int_types = _SLarith_Arith_Types; - - while (*int_types != SLANG_FLOAT_TYPE) - { - if (-1 == SLclass_add_math_op (*int_types, generic_math_op, double_math_op_result)) - return -1; - int_types++; - } - - if ((-1 == SLclass_add_math_op (SLANG_FLOAT_TYPE, float_math_op, double_math_op_result)) - || (-1 == SLclass_add_math_op (SLANG_DOUBLE_TYPE, double_math_op, double_math_op_result)) -#if SLANG_HAS_COMPLEX - || (-1 == SLclass_add_math_op (SLANG_COMPLEX_TYPE, complex_math_op, complex_math_op_result)) -#endif - ) - return -1; - - if ((-1 == SLadd_math_unary_table (SLmath_Table, "__SLMATH__")) - || (-1 == SLadd_intrin_fun_table (SLang_Math_Table, NULL)) - || (-1 == SLadd_dconstant_table (DConst_Table, NULL))) - return -1; - - return 0; -} - diff --git a/mdk-stage1/slang/slmemchr.c b/mdk-stage1/slang/slmemchr.c deleted file mode 100644 index 1417bc549..000000000 --- a/mdk-stage1/slang/slmemchr.c +++ /dev/null @@ -1,47 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -/* These routines are fast memcpy, memset routines. When available, I - use system rouines. For msdos, I use inline assembly. */ - -/* The current versions only work in the forward direction only!! */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -char *SLmemchr(register char *p, register char c, register int n) -{ - int n2; - register char *pmax; - - pmax = p + (n - 32); - - while (p <= pmax) - { - if ((*p == c) || (*++p == c) || (*++p == c) || (*++p == c) - || (*++p == c) || (*++p == c) || (*++p == c) || (*++p == c) - || (*++p == c) || (*++p == c) || (*++p == c) || (*++p == c) - || (*++p == c) || (*++p == c) || (*++p == c) || (*++p == c) - || (*++p == c) || (*++p == c) || (*++p == c) || (*++p == c) - || (*++p == c) || (*++p == c) || (*++p == c) || (*++p == c) - || (*++p == c) || (*++p == c) || (*++p == c) || (*++p == c) - || (*++p == c) || (*++p == c) || (*++p == c) || (*++p == c)) - return p; - p++; - } - - n2 = n % 32; - - while (n2--) - { - if (*p == c) return p; - p++; - } - return(NULL); -} diff --git a/mdk-stage1/slang/slmemcmp.c b/mdk-stage1/slang/slmemcmp.c deleted file mode 100644 index c5ed50095..000000000 --- a/mdk-stage1/slang/slmemcmp.c +++ /dev/null @@ -1,76 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -/* These routines are fast memcpy, memset routines. When available, I - use system rouines. For msdos, I use inline assembly. */ - -/* The current versions only work in the forward direction only!! */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -/* This is an UNSIGNED comparison designed for systems that either do not have -* this function or performed a signed comparison (SunOS) -*/ -int SLmemcmp(register char *s1, register char *s2, int n) -{ - register int cmp; - register char *s1max; - - s1max = s1 + (n - 32); - - while (s1 <= s1max) - { - if (*s1 != *s2) return ((unsigned char) *s1 - (unsigned char) *s2); - if (*(s1 + 1) != *(s2 + 1)) return ((unsigned char) *(s1 + 1) - (unsigned char) *(s2 + 1)); - if (*(s1 + 2) != *(s2 + 2)) return ((unsigned char) *(s1 + 2) - (unsigned char) *(s2 + 2)); - if (*(s1 + 3) != *(s2 + 3)) return ((unsigned char) *(s1 + 3) - (unsigned char) *(s2 + 3)); - if (*(s1 + 4) != *(s2 + 4)) return ((unsigned char) *(s1 + 4) - (unsigned char) *(s2 + 4)); - if (*(s1 + 5) != *(s2 + 5)) return ((unsigned char) *(s1 + 5) - (unsigned char) *(s2 + 5)); - if (*(s1 + 6) != *(s2 + 6)) return ((unsigned char) *(s1 + 6) - (unsigned char) *(s2 + 6)); - if (*(s1 + 7) != *(s2 + 7)) return ((unsigned char) *(s1 + 7) - (unsigned char) *(s2 + 7)); - if (*(s1 + 8) != *(s2 + 8)) return ((unsigned char) *(s1 + 8) - (unsigned char) *(s2 + 8)); - if (*(s1 + 9) != *(s2 + 9)) return ((unsigned char) *(s1 + 9) - (unsigned char) *(s2 + 9)); - if (*(s1 + 10) != *(s2 + 10)) return ((unsigned char) *(s1 + 10) - (unsigned char) *(s2 + 10)); - if (*(s1 + 11) != *(s2 + 11)) return ((unsigned char) *(s1 + 11) - (unsigned char) *(s2 + 11)); - if (*(s1 + 12) != *(s2 + 12)) return ((unsigned char) *(s1 + 12) - (unsigned char) *(s2 + 12)); - if (*(s1 + 13) != *(s2 + 13)) return ((unsigned char) *(s1 + 13) - (unsigned char) *(s2 + 13)); - if (*(s1 + 14) != *(s2 + 14)) return ((unsigned char) *(s1 + 14) - (unsigned char) *(s2 + 14)); - if (*(s1 + 15) != *(s2 + 15)) return ((unsigned char) *(s1 + 15) - (unsigned char) *(s2 + 15)); - if (*(s1 + 16) != *(s2 + 16)) return ((unsigned char) *(s1 + 16) - (unsigned char) *(s2 + 16)); - if (*(s1 + 17) != *(s2 + 17)) return ((unsigned char) *(s1 + 17) - (unsigned char) *(s2 + 17)); - if (*(s1 + 18) != *(s2 + 18)) return ((unsigned char) *(s1 + 18) - (unsigned char) *(s2 + 18)); - if (*(s1 + 19) != *(s2 + 19)) return ((unsigned char) *(s1 + 19) - (unsigned char) *(s2 + 19)); - if (*(s1 + 20) != *(s2 + 20)) return ((unsigned char) *(s1 + 20) - (unsigned char) *(s2 + 20)); - if (*(s1 + 21) != *(s2 + 21)) return ((unsigned char) *(s1 + 21) - (unsigned char) *(s2 + 21)); - if (*(s1 + 22) != *(s2 + 22)) return ((unsigned char) *(s1 + 22) - (unsigned char) *(s2 + 22)); - if (*(s1 + 23) != *(s2 + 23)) return ((unsigned char) *(s1 + 23) - (unsigned char) *(s2 + 23)); - if (*(s1 + 24) != *(s2 + 24)) return ((unsigned char) *(s1 + 24) - (unsigned char) *(s2 + 24)); - if (*(s1 + 25) != *(s2 + 25)) return ((unsigned char) *(s1 + 25) - (unsigned char) *(s2 + 25)); - if (*(s1 + 26) != *(s2 + 26)) return ((unsigned char) *(s1 + 26) - (unsigned char) *(s2 + 26)); - if (*(s1 + 27) != *(s2 + 27)) return ((unsigned char) *(s1 + 27) - (unsigned char) *(s2 + 27)); - if (*(s1 + 28) != *(s2 + 28)) return ((unsigned char) *(s1 + 28) - (unsigned char) *(s2 + 28)); - if (*(s1 + 29) != *(s2 + 29)) return ((unsigned char) *(s1 + 29) - (unsigned char) *(s2 + 29)); - if (*(s1 + 30) != *(s2 + 30)) return ((unsigned char) *(s1 + 30) - (unsigned char) *(s2 + 30)); - if (*(s1 + 31) != *(s2 + 31)) return ((unsigned char) *(s1 + 31) - (unsigned char) *(s2 + 31)); - s1 += 32; s2 += 32; - } - - s1max = s1 + (n % 32); - - while (s1 < s1max) - { - cmp = (unsigned char) *s1 - (unsigned char) *s2; - if (cmp) return(cmp); - s1++; - s2++; - } - - return(0); -} diff --git a/mdk-stage1/slang/slmemcpy.c b/mdk-stage1/slang/slmemcpy.c deleted file mode 100644 index e8665e4c6..000000000 --- a/mdk-stage1/slang/slmemcpy.c +++ /dev/null @@ -1,49 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -/* These routines are fast memcpy, memset routines. When available, I - use system rouines. For msdos, I use inline assembly. */ - -/* The current versions only work in the forward direction only!! */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -char *SLmemcpy(char *s1, char *s2, int n) -{ -#if defined(__BORLANDC__) && defined(__MSDOS__) - asm mov ax, ds - asm mov bx, si - asm mov dx, di - asm mov cx, n - asm les di, s1 - asm lds si, s2 - asm cld - asm rep movsb - asm mov ds, ax - asm mov si, bx - asm mov di, dx - return(s1); - -#else - register char *smax, *s = s1; - int n2; - - n2 = n % 4; - smax = s + (n - 4); - while (s <= smax) - { - *s = *s2; *(s + 1) = *(s2 + 1); *(s + 2) = *(s2 + 2); *(s + 3) = *(s2 + 3); - s += 4; - s2 += 4; - } - while (n2--) *s++ = *s2++; - return(s1); -#endif -} diff --git a/mdk-stage1/slang/slmemset.c b/mdk-stage1/slang/slmemset.c deleted file mode 100644 index 3851663c5..000000000 --- a/mdk-stage1/slang/slmemset.c +++ /dev/null @@ -1,39 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -/* These routines are fast memcpy, memset routines. When available, I - use system rouines. For msdos, I use inline assembly. */ - -/* The current versions only work in the forward direction only!! */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -void SLmemset(char *p, char space, int n) -{ -#if defined(__BORLANDC__) && defined(__MSDOS__) - asm mov al, space - asm mov dx, di - asm mov cx, n - asm les di, p - asm cld - asm rep stosb - asm mov di, dx -#else - register char *pmax; - - pmax = p + (n - 4); - n = n % 4; - while (p <= pmax) - { - *p++ = space; *p++ = space; *p++ = space; *p++= space; - } - while (n--) *p++ = space; -#endif -} diff --git a/mdk-stage1/slang/slmisc.c b/mdk-stage1/slang/slmisc.c deleted file mode 100644 index ccc7a9bdf..000000000 --- a/mdk-stage1/slang/slmisc.c +++ /dev/null @@ -1,330 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -#define DEBUG_MALLOC 0 - -#if DEBUG_MALLOC -# define SLREALLOC_FUN SLdebug_realloc -# define SLMALLOC_FUN SLdebug_malloc -# define SLFREE_FUN SLdebug_free -#else -# define SLREALLOC_FUN SLREALLOC -# define SLMALLOC_FUN SLMALLOC -# define SLFREE_FUN SLFREE -#endif - -/* Version information goes here since this file is always needed. */ -int SLang_Version = SLANG_VERSION; -char *SLang_Version_String = SLANG_VERSION_STRING; - -char *SLmake_string(char *str) -{ - return SLmake_nstring(str, strlen (str)); -} - -char *SLmake_nstring (char *str, unsigned int n) -{ - char *ptr; - - if (NULL == (ptr = SLmalloc(n + 1))) - { - return NULL; - } - SLMEMCPY (ptr, str, n); - ptr[n] = 0; - return(ptr); -} - -void SLmake_lut (unsigned char *lut, unsigned char *range, unsigned char reverse) -{ - register unsigned char *l = lut, *lmax = lut + 256; - int i, r1, r2; - - while (l < lmax) *l++ = reverse; - reverse = !reverse; - - r1 = *range++; - while (r1) - { - r2 = *range++; - if ((r2 == '-') && (*range != 0)) - { - r2 = *range++; - for (i = r1; i <= r2; i++) lut[i] = reverse; - r1 = *range++; - continue; - } - lut[r1] = reverse; - r1 = r2; - } -} - -char *SLmalloc (unsigned int len) -{ - char *p; - - p = (char *) SLMALLOC_FUN (len); - if (p == NULL) - SLang_Error = SL_MALLOC_ERROR; - - return p; -} - -void SLfree (char *p) -{ - if (p != NULL) SLFREE_FUN (p); -} - -char *SLrealloc (char *p, unsigned int len) -{ - if (len == 0) - { - SLfree (p); - return NULL; - } - - if (p == NULL) p = SLmalloc (len); - else - { - p = (char *)SLREALLOC_FUN (p, len); - if (p == NULL) - SLang_Error = SL_MALLOC_ERROR; - } - return p; -} - -char *SLcalloc (unsigned int nelems, unsigned int len) -{ - char *p; - - len = nelems * len; - p = SLmalloc (len); - if (p != NULL) SLMEMSET (p, 0, len); - return p; -} - -/* p and ch may point to the same buffer */ -char *_SLexpand_escaped_char(char *p, char *ch) -{ - int i = 0; - int max = 0, num, base = 0; - char ch1; - - ch1 = *p++; - - switch (ch1) - { - default: num = ch1; break; - case 'n': num = '\n'; break; - case 't': num = '\t'; break; - case 'v': num = '\v'; break; - case 'b': num = '\b'; break; - case 'r': num = '\r'; break; - case 'f': num = '\f'; break; - case 'E': case 'e': num = 27; break; - case 'a': num = 7; - break; - - /* octal */ - case '0': case '1': case '2': case '3': - case '4': case '5': case '6': case '7': - max = '7'; - base = 8; i = 2; num = ch1 - '0'; - break; - - case 'd': /* decimal -- S-Lang extension */ - base = 10; - i = 3; - max = '9'; - num = 0; - break; - - case 'x': /* hex */ - base = 16; - max = '9'; - i = 2; - num = 0; - break; - } - - while (i--) - { - ch1 = *p; - - if ((ch1 <= max) && (ch1 >= '0')) - { - num = base * num + (ch1 - '0'); - } - else if (base == 16) - { - ch1 |= 0x20; - if ((ch1 < 'a') || ((ch1 > 'f'))) break; - num = base * num + 10 + (ch1 - 'a'); - } - else break; - p++; - } - - *ch = (char) num; - return p; -} - -/* s and t could represent the same space */ -void SLexpand_escaped_string (register char *s, register char *t, - register char *tmax) -{ - char ch; - - while (t < tmax) - { - ch = *t++; - if (ch == '\\') - { - t = _SLexpand_escaped_char (t, &ch); - } - *s++ = ch; - } - *s = 0; -} - -int SLextract_list_element (char *list, unsigned int nth, char delim, - char *elem, unsigned int buflen) -{ - char *el, *elmax; - char ch; - - while (nth > 0) - { - while ((0 != (ch = *list)) && (ch != delim)) - list++; - - if (ch == 0) return -1; - - list++; - nth--; - } - - el = elem; - elmax = el + (buflen - 1); - - while ((0 != (ch = *list)) && (ch != delim) && (el < elmax)) - *el++ = *list++; - *el = 0; - - return 0; -} - -#ifndef HAVE_VSNPRINTF -int _SLvsnprintf (char *buf, unsigned int buflen, char *fmt, va_list ap) -{ -#if 1 - unsigned int len; - - /* On some systems vsprintf returns useless information. So, punt */ - vsprintf (buf, fmt, ap); - len = strlen (buf); - if (len >= buflen) - { - SLang_exit_error ("\ -Your system lacks the vsnprintf system call and vsprintf overflowed a buffer.\n\ -The integrity of this program has been violated.\n"); - return EOF; /* NOT reached */ - } - return (int)len; -#else - int status; - - status = vsprintf (buf, fmt, ap); - if (status >= (int) buflen) - { - /* If we are lucky, we will get this far. The real solution is to - * provide a working version of vsnprintf - */ - SLang_exit_error ("\ -Your system lacks the vsnprintf system call and vsprintf overflowed a buffer.\n\ -The integrity of this program has been violated.\n"); - return EOF; /* NOT reached */ - } - return status; -#endif -} -#endif - -#ifndef HAVE_SNPRINTF -int _SLsnprintf (char *buf, unsigned int buflen, char *fmt, ...) -{ - int status; - - va_list ap; - - va_start (ap, fmt); - status = _SLvsnprintf (buf, buflen, fmt, ap); - va_end (ap); - - return status; -} -#endif - -typedef struct _Cleanup_Function_Type -{ - struct _Cleanup_Function_Type *next; - void (*f)(void); -} -Cleanup_Function_Type; - -static Cleanup_Function_Type *Cleanup_Function_List; - -static void cleanup_slang (void) -{ - while (Cleanup_Function_List != NULL) - { - Cleanup_Function_Type *next = Cleanup_Function_List->next; - (*Cleanup_Function_List->f)(); - SLFREE_FUN ((char *) Cleanup_Function_List); - Cleanup_Function_List = next; - } -} - -#ifndef HAVE_ATEXIT -# ifdef HAVE_ON_EXIT -static void on_exit_cleanup_slang (int arg_unused) -{ - (void) arg_unused; - cleanup_slang (); -} -# endif -#endif - -int SLang_add_cleanup_function (void (*f)(void)) -{ - Cleanup_Function_Type *l; - - l = (Cleanup_Function_Type *) SLMALLOC_FUN (sizeof (Cleanup_Function_Type)); - if (l == NULL) - return -1; - - l->f = f; - l->next = Cleanup_Function_List; - - if (Cleanup_Function_List == NULL) - { -#ifdef HAVE_ATEXIT - (void) atexit (cleanup_slang); -#else -# ifdef HAVE_ON_EXIT - (void) on_exit (on_exit_cleanup_slang, 0); -# endif -#endif - } - Cleanup_Function_List = l; - return 0; -} - diff --git a/mdk-stage1/slang/slnspace.c b/mdk-stage1/slang/slnspace.c deleted file mode 100644 index 174ba7c81..000000000 --- a/mdk-stage1/slang/slnspace.c +++ /dev/null @@ -1,242 +0,0 @@ -/* -*- mode: C; mode: fold; -*- */ -/* slnspace.c --- Name Space implementation */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -static SLang_NameSpace_Type *Namespace_Tables; - -static SLang_NameSpace_Type *find_name_table (char *name) -{ - SLang_NameSpace_Type *table_list; - - table_list = Namespace_Tables; - while (table_list != NULL) - { - if (0 == strcmp (table_list->name, name)) - break; - table_list = table_list->next; - } - return table_list; -} - -SLang_NameSpace_Type *_SLns_find_namespace (char *name) -{ - SLang_NameSpace_Type *table_list; - - table_list = Namespace_Tables; - while (table_list != NULL) - { - if ((table_list->namespace_name != NULL) - && (0 == strcmp (table_list->namespace_name, name))) - break; - table_list = table_list->next; - } - return table_list; -} - -SLang_NameSpace_Type *_SLns_allocate_namespace (char *name, unsigned int size) -{ - SLang_NameSpace_Type *table_list; - SLang_Name_Type **nt; - - if (NULL != (table_list = find_name_table (name))) - return table_list; - - if (NULL == (name = SLang_create_slstring (name))) - return NULL; - - if (NULL == (table_list = (SLang_NameSpace_Type *) - SLmalloc (sizeof (SLang_NameSpace_Type)))) - { - SLang_free_slstring (name); - return NULL; - } - - if (NULL == (nt = (SLang_Name_Type **) SLmalloc (sizeof (SLang_Name_Type *) * size))) - { - SLang_free_slstring (name); - SLfree ((char *)table_list); - return NULL; - } - - memset ((char *)nt, 0, size * sizeof (SLang_Name_Type *)); - memset ((char *) table_list, 0, sizeof (SLang_NameSpace_Type)); - - table_list->name = name; - table_list->table = nt; - table_list->table_size = size; - - table_list->next = Namespace_Tables; - Namespace_Tables = table_list; - - return table_list; -} - -int _SLns_set_namespace_name (SLang_NameSpace_Type *t, char *name) -{ - SLang_NameSpace_Type *t1; - - t1 = _SLns_find_namespace (name); - if (t1 == NULL) - t1 = t; - - if ((t != t1) || (*name == 0)) - { - SLang_verror (SL_INTRINSIC_ERROR, "Namespace \"%s\" already exists", - name); - return -1; - } - - if (NULL == (name = SLang_create_slstring (name))) - return -1; - - SLang_free_slstring (t->namespace_name); /* NULL ok */ - t->namespace_name = name; - - return 0; -} - -SLang_Array_Type *_SLnspace_apropos (SLang_NameSpace_Type *ns, char *pat, unsigned int what) -{ - SLang_Array_Type *at; - unsigned int table_size; - SLang_Name_Type *t, **table; - int num_matches; - unsigned int i; - SLRegexp_Type rexp; - unsigned char rbuf[512]; - unsigned int two; - - at = NULL; - - if ((ns == NULL) - || ((table = ns->table) == NULL)) - return NULL; - - memset ((char *) &rexp, 0, sizeof (SLRegexp_Type)); - rexp.case_sensitive = 1; - rexp.buf = rbuf; - rexp.buf_len = sizeof (rbuf); - rexp.pat = (unsigned char *)pat; - - if (0 != SLang_regexp_compile (&rexp)) - { - SLang_verror (SL_INVALID_PARM, "Invalid regular expression: %s", pat); - return NULL; - } - - table_size = ns->table_size; - - two = 2; - while (two != 0) - { - two--; - - num_matches = 0; - for (i = 0; i < table_size; i++) - { - t = table[i]; - while (t != NULL) - { - unsigned int flags; - char *name = t->name; - - switch (t->name_type) - { - case SLANG_GVARIABLE: - flags = 8; - break; - - case SLANG_ICONSTANT: - case SLANG_DCONSTANT: - case SLANG_RVARIABLE: - case SLANG_IVARIABLE: - flags = 4; - break; - - case SLANG_INTRINSIC: - case SLANG_MATH_UNARY: - case SLANG_APP_UNARY: - flags = 1; - break; - - case SLANG_FUNCTION: - flags = 2; - break; - - default: - flags = 0; - break; - } - - if ((flags & what) - && (NULL != SLang_regexp_match ((unsigned char *)name, strlen (name), &rexp))) - { - if (at != NULL) - { - if (-1 == SLang_set_array_element (at, &num_matches, (VOID_STAR)&name)) - goto return_error; - } - num_matches++; - } - t = t->next; - } - } - - if (at == NULL) - { - at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num_matches, 1); - if (at == NULL) - goto return_error; - } - } - - return at; - - return_error: - SLang_free_array (at); - return NULL; -} - -SLang_NameSpace_Type *SLns_create_namespace (char *namespace_name) -{ - SLang_NameSpace_Type *ns; - static int num; - char name[64]; - - if (namespace_name == NULL) - namespace_name = "Global"; - - ns = _SLns_find_namespace (namespace_name); - if (ns != NULL) - return ns; - - sprintf (name, " *** internal ns <%d> *** ", num); - - if (NULL == (ns = _SLns_allocate_namespace (name, SLSTATIC_HASH_TABLE_SIZE))) - return NULL; - - num++; - if (-1 == _SLns_set_namespace_name (ns, namespace_name)) - { - SLns_delete_namespace (ns); - return NULL; - } - - return ns; -} - -void SLns_delete_namespace (SLang_NameSpace_Type *ns) -{ - (void) ns; - /* V2.0 */ -} diff --git a/mdk-stage1/slang/slospath.c b/mdk-stage1/slang/slospath.c deleted file mode 100644 index 644931e81..000000000 --- a/mdk-stage1/slang/slospath.c +++ /dev/null @@ -1,73 +0,0 @@ -/* Pathname intrinsic functions */ -/* Copyright (c) 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -static void path_concat (char *a, char *b) -{ - SLang_push_malloced_string (SLpath_dircat (a,b)); -} - -static void path_extname (char *path) -{ -#ifdef VMS - char *p; -#endif - - path = SLpath_extname (path); -#ifndef VMS - SLang_push_string (path); -#else - p = strchr (path, ';'); - if (p == NULL) - (void)SLang_push_string (p); - else - (void)SLang_push_malloced_string (SLmake_nstring (path, (unsigned int)(p - path))); -#endif -} - -static void path_basename (char *path) -{ - (void) SLang_push_string (SLpath_basename (path)); -} - -static void path_dirname (char *path) -{ - (void) SLang_push_malloced_string (SLpath_dirname (path)); -} - -static void path_sans_extname (char *path) -{ - (void) SLang_push_malloced_string (SLpath_pathname_sans_extname (path)); -} - - - -static SLang_Intrin_Fun_Type Path_Name_Table [] = -{ - MAKE_INTRINSIC_SS("path_concat", path_concat, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("path_extname", path_extname, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("path_dirname", path_dirname, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("path_basename", path_basename, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("path_sans_extname", path_sans_extname, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("path_is_absolute", SLpath_is_absolute_path, SLANG_INT_TYPE), - SLANG_END_INTRIN_FUN_TABLE -}; - -int SLang_init_ospath (void) -{ - if (-1 == SLadd_intrin_fun_table(Path_Name_Table, "__OSPATH__")) - return -1; - - return 0; -} - - diff --git a/mdk-stage1/slang/slpack.c b/mdk-stage1/slang/slpack.c deleted file mode 100644 index 53ef63643..000000000 --- a/mdk-stage1/slang/slpack.c +++ /dev/null @@ -1,785 +0,0 @@ -/* Pack objects as a binary string */ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include <ctype.h> - -#include "slang.h" -#include "_slang.h" - -#ifndef isdigit -# define isdigit(c) (((c)>='0')&&((c)<= '9')) -#endif -#ifndef isspace -# define isspace(c) (((c)==' ') || ((c)=='\t') || ((c)=='\n')) -#endif - -/* format description: - * - * s = string (null padded) - * S = string (space padded) - * c = signed char - * C = unsigned char - * h = short - * H = unsigned short - * i = int - * I = unsigned int - * l = long - * L = unsigned long - * j = 16 bit signed integer (short) - * J = 16 bit unsigned integer (short) - * k = 32 bit signed integer (long) - * K = 32 bit unsigned integer (long) - * f = float (native format) - * F = 32 bit double - * d = double (native format) - * D = 64 bit double - * x = null pad byte - * > = big-endian mode - * < = little-endian mode - * = = native mode - */ - -#define NATIVE_ORDER 0 -#define BIGENDIAN_ORDER 1 -#define LILENDIAN_ORDER 2 -static int Native_Byte_Order = NATIVE_ORDER; - -typedef struct -{ - char format_type; - unsigned char data_type; - unsigned int repeat; - unsigned int sizeof_type; - char pad; - int byteorder; - int is_scalar; -} -Format_Type; - -static int get_int_type_for_size (unsigned int size, unsigned char *s, unsigned char *u) -{ - if (sizeof (int) == size) - { - if (s != NULL) *s = SLANG_INT_TYPE; - if (u != NULL) *u = SLANG_UINT_TYPE; - return 0; - } - - if (sizeof (short) == size) - { - if (s != NULL) *s = SLANG_SHORT_TYPE; - if (u != NULL) *u = SLANG_USHORT_TYPE; - return 1; - } - - if (sizeof (long) == size) - { - if (s != NULL) *s = SLANG_LONG_TYPE; - if (u != NULL) *u = SLANG_ULONG_TYPE; - return 1; - } - - if (s != NULL) *s = 0; - if (u != NULL) *u = 0; - SLang_verror (SL_NOT_IMPLEMENTED, - "This OS does not support a %u byte int", size); - return -1; -} - -static int get_float_type_for_size (unsigned int size, unsigned char *s) -{ - if (sizeof (float) == size) - { - *s = SLANG_FLOAT_TYPE; - return 0; - } - - if (sizeof (double) == size) - { - *s = SLANG_DOUBLE_TYPE; - return 0; - } - - SLang_verror (SL_NOT_IMPLEMENTED, - "This OS does not support a %u byte float", size); - return -1; -} - -static int parse_a_format (char **format, Format_Type *ft) -{ - char *f; - char ch; - unsigned repeat; - - f = *format; - - while (((ch = *f++) != 0) - && isspace (ch)) - ; - - switch (ch) - { - default: - ft->byteorder = NATIVE_ORDER; - break; - - case '=': - ft->byteorder = NATIVE_ORDER; - ch = *f++; - break; - - case '>': - ft->byteorder = BIGENDIAN_ORDER; - ch = *f++; - break; - - case '<': - ft->byteorder = LILENDIAN_ORDER; - ch = *f++; - break; - } - - if (ch == 0) - { - f--; - *format = f; - return 0; - } - - ft->format_type = ch; - ft->repeat = 1; - - if (isdigit (*f)) - { - repeat = (unsigned int) (*f - '0'); - f++; - - while (isdigit (*f)) - { - unsigned int repeat10 = 10 * repeat + (unsigned int)(*f - '0'); - - /* Check overflow */ - if (repeat != repeat10 / 10) - { - SLang_verror (SL_OVERFLOW, - "Repeat count too large in [un]pack format"); - return -1; - } - repeat = repeat10; - f++; - } - ft->repeat = repeat; - } - - *format = f; - - ft->is_scalar = 1; - ft->pad = 0; - - switch (ft->format_type) - { - default: - SLang_verror (SL_NOT_IMPLEMENTED, - "[un]pack format character '%c' not supported", ft->format_type); - return -1; - - case 'D': - ft->sizeof_type = 8; - if (-1 == get_float_type_for_size (8, &ft->data_type)) - return -1; - break; - - case 'd': - ft->data_type = SLANG_DOUBLE_TYPE; - ft->sizeof_type = sizeof (double); - break; - - case 'F': - ft->sizeof_type = 4; - if (-1 == get_float_type_for_size (4, &ft->data_type)) - return -1; - break; - case 'f': - ft->data_type = SLANG_FLOAT_TYPE; - ft->sizeof_type = sizeof (float); - break; - - case 'h': - ft->data_type = SLANG_SHORT_TYPE; - ft->sizeof_type = sizeof (short); - break; - case 'H': - ft->data_type = SLANG_USHORT_TYPE; - ft->sizeof_type = sizeof (unsigned short); - break; - case 'i': - ft->data_type = SLANG_INT_TYPE; - ft->sizeof_type = sizeof (int); - break; - case 'I': - ft->data_type = SLANG_UINT_TYPE; - ft->sizeof_type = sizeof (unsigned int); - break; - case 'l': - ft->data_type = SLANG_LONG_TYPE; - ft->sizeof_type = sizeof (long); - break; - case 'L': - ft->data_type = SLANG_ULONG_TYPE; - ft->sizeof_type = sizeof (unsigned long); - break; - - /* 16 bit ints */ - case 'j': - ft->sizeof_type = 2; - if (-1 == get_int_type_for_size (2, &ft->data_type, NULL)) - return -1; - break; - case 'J': - ft->sizeof_type = 2; - if (-1 == get_int_type_for_size (2, NULL, &ft->data_type)) - return -1; - break; - - /* 32 bit ints */ - case 'k': - ft->sizeof_type = 4; - if (-1 == get_int_type_for_size (4, &ft->data_type, NULL)) - return -1; - break; - case 'K': - ft->sizeof_type = 4; - if (-1 == get_int_type_for_size (4, NULL, &ft->data_type)) - return -1; - break; - - case 'x': - ft->sizeof_type = 1; - ft->data_type = 0; - break; - - case 'c': - ft->sizeof_type = 1; - ft->data_type = SLANG_CHAR_TYPE; - break; - - case 'C': - ft->data_type = SLANG_UCHAR_TYPE; - ft->sizeof_type = 1; - break; - - case 'S': - case 'A': - ft->pad = ' '; - case 'a': - case 's': - ft->data_type = SLANG_BSTRING_TYPE; - ft->sizeof_type = 1; - ft->is_scalar = 0; - break; - } - return 1; -} - -static int compute_size_for_format (char *format, unsigned int *num_bytes) -{ - unsigned int size; - Format_Type ft; - int status; - - *num_bytes = size = 0; - - while (1 == (status = parse_a_format (&format, &ft))) - size += ft.repeat * ft.sizeof_type; - - *num_bytes = size; - return status; -} - -static void byte_swap64 (unsigned char *ss, unsigned int n) /*{{{*/ -{ - unsigned char *p, *pmax, ch; - - if (n == 0) return; - p = (unsigned char *) ss; - pmax = p + 8 * n; - while (p < pmax) - { - ch = *p; - *p = *(p + 7); - *(p + 7) = ch; - - ch = *(p + 6); - *(p + 6) = *(p + 1); - *(p + 1) = ch; - - ch = *(p + 5); - *(p + 5) = *(p + 2); - *(p + 2) = ch; - - ch = *(p + 4); - *(p + 4) = *(p + 3); - *(p + 3) = ch; - - p += 8; - } -} - -/*}}}*/ -static void byte_swap32 (unsigned char *ss, unsigned int n) /*{{{*/ -{ - unsigned char *p, *pmax, ch; - - p = (unsigned char *) ss; - pmax = p + 4 * n; - while (p < pmax) - { - ch = *p; - *p = *(p + 3); - *(p + 3) = ch; - - ch = *(p + 1); - *(p + 1) = *(p + 2); - *(p + 2) = ch; - p += 4; - } -} - -/*}}}*/ -static void byte_swap16 (unsigned char *p, unsigned int nread) /*{{{*/ -{ - unsigned char *pmax, ch; - - pmax = p + 2 * nread; - while (p < pmax) - { - ch = *p; - *p = *(p + 1); - *(p + 1) = ch; - p += 2; - } -} - -/*}}}*/ - -static int byteswap (int order, unsigned char *b, unsigned int size, unsigned int num) -{ - if (Native_Byte_Order == order) - return 0; - - switch (size) - { - case 2: - byte_swap16 (b, num); - break; - case 4: - byte_swap32 (b, num); - break; - case 8: - byte_swap64 (b, num); - break; - default: - return -1; - } - - return 0; -} - -static void check_native_byte_order (void) -{ - unsigned short x; - - if (Native_Byte_Order != NATIVE_ORDER) - return; - - x = 0xFF; - if (*(unsigned char *)&x == 0xFF) - Native_Byte_Order = LILENDIAN_ORDER; - else - Native_Byte_Order = BIGENDIAN_ORDER; -} - -static SLang_BString_Type * -pack_according_to_format (char *format, unsigned int nitems) -{ - unsigned int size, num; - unsigned char *buf, *b; - SLang_BString_Type *bs; - Format_Type ft; - - buf = NULL; - - if (-1 == compute_size_for_format (format, &size)) - goto return_error; - - if (NULL == (buf = (unsigned char *) SLmalloc (size + 1))) - goto return_error; - - b = buf; - - while (1 == parse_a_format (&format, &ft)) - { - unsigned char *ptr; - unsigned int repeat; - - repeat = ft.repeat; - if (ft.data_type == 0) - { - memset ((char *) b, ft.pad, repeat); - b += repeat; - continue; - } - - if (ft.is_scalar) - { - unsigned char *bstart; - num = repeat; - - bstart = b; - while (repeat != 0) - { - unsigned int nelements; - SLang_Array_Type *at; - - if (nitems == 0) - { - SLang_verror (SL_INVALID_PARM, - "Not enough items for pack format"); - goto return_error; - } - - if (-1 == SLang_pop_array_of_type (&at, ft.data_type)) - goto return_error; - - nelements = at->num_elements; - if (repeat < nelements) - nelements = repeat; - repeat -= nelements; - - nelements = nelements * ft.sizeof_type; - memcpy ((char *)b, (char *)at->data, nelements); - - b += nelements; - SLang_free_array (at); - nitems--; - } - - if (ft.byteorder != NATIVE_ORDER) - byteswap (ft.byteorder, bstart, ft.sizeof_type, num); - - continue; - } - - /* Otherwise we have a string */ - if (-1 == SLang_pop_bstring (&bs)) - goto return_error; - - ptr = SLbstring_get_pointer (bs, &num); - if (repeat < num) num = repeat; - memcpy ((char *)b, (char *)ptr, num); - b += num; - repeat -= num; - memset ((char *)b, ft.pad, repeat); - SLbstring_free (bs); - b += repeat; - nitems--; - } - - *b = 0; - bs = SLbstring_create_malloced (buf, size, 0); - if (bs == NULL) - goto return_error; - - SLdo_pop_n (nitems); - return bs; - - return_error: - SLdo_pop_n (nitems); - if (buf != NULL) - SLfree ((char *) buf); - - return NULL; -} - -void _SLpack (void) -{ - SLang_BString_Type *bs; - char *fmt; - int nitems; - - check_native_byte_order (); - - nitems = SLang_Num_Function_Args; - if (nitems <= 0) - { - SLang_verror (SL_SYNTAX_ERROR, - "pack: not enough arguments"); - return; - } - - if ((-1 == SLreverse_stack (nitems)) - || (-1 == SLang_pop_slstring (&fmt))) - bs = NULL; - else - { - bs = pack_according_to_format (fmt, (unsigned int)nitems - 1); - SLang_free_slstring (fmt); - } - - SLang_push_bstring (bs); - SLbstring_free (bs); -} - -void _SLunpack (char *format, SLang_BString_Type *bs) -{ - Format_Type ft; - unsigned char *b; - unsigned int len; - unsigned int num_bytes; - - check_native_byte_order (); - - if (-1 == compute_size_for_format (format, &num_bytes)) - return; - - b = SLbstring_get_pointer (bs, &len); - if (b == NULL) - return; - - if (len < num_bytes) - { - SLang_verror (SL_INVALID_PARM, - "unpack format %s is too large for input string", - format); - return; - } - - while (1 == parse_a_format (&format, &ft)) - { - char *str, *s; - - if (ft.repeat == 0) - continue; - - if (ft.data_type == 0) - { /* skip padding */ - b += ft.repeat; - continue; - } - - if (ft.is_scalar) - { - SLang_Array_Type *at; - int dims; - - if (ft.repeat == 1) - { - SLang_Class_Type *cl; - - cl = _SLclass_get_class (ft.data_type); - memcpy ((char *)cl->cl_transfer_buf, (char *)b, ft.sizeof_type); - if (ft.byteorder != NATIVE_ORDER) - byteswap (ft.byteorder, (unsigned char *)cl->cl_transfer_buf, ft.sizeof_type, 1); - - if (-1 == (cl->cl_apush (ft.data_type, cl->cl_transfer_buf))) - return; - b += ft.sizeof_type; - continue; - } - - dims = (int) ft.repeat; - at = SLang_create_array (ft.data_type, 0, NULL, &dims, 1); - if (at == NULL) - return; - - num_bytes = ft.repeat * ft.sizeof_type; - memcpy ((char *)at->data, (char *)b, num_bytes); - if (ft.byteorder != NATIVE_ORDER) - byteswap (ft.byteorder, (unsigned char *)at->data, ft.sizeof_type, ft.repeat); - - if (-1 == SLang_push_array (at, 1)) - return; - - b += num_bytes; - continue; - } - - len = ft.repeat; - str = SLmalloc (len + 1); - if (str == NULL) - return; - - memcpy ((char *) str, (char *)b, len); - str [len] = 0; - - if (ft.pad == ' ') - { - unsigned int new_len; - - s = str + len; - while (s > str) - { - s--; - if ((*s != ' ') && (*s != 0)) - { - s++; - break; - } - *s = 0; - } - new_len = (unsigned int) (s - str); - - if (new_len != len) - { - s = SLrealloc (str, new_len + 1); - if (s == NULL) - { - SLfree (str); - return; - } - str = s; - len = new_len; - } - } - - /* Avoid a bstring if possible */ - s = SLmemchr (str, 0, len); - if (s == NULL) - { - if (-1 == SLang_push_malloced_string (str)) - return; - } - else - { - SLang_BString_Type *new_bs; - - new_bs = SLbstring_create_malloced ((unsigned char *)str, len, 1); - if (new_bs == NULL) - return; - - if (-1 == SLang_push_bstring (new_bs)) - { - SLfree (str); - return; - } - SLbstring_free (new_bs); - } - - b += ft.repeat; - } -} - -unsigned int _SLpack_compute_size (char *format) -{ - unsigned int n; - - n = 0; - (void) compute_size_for_format (format, &n); - return n; -} - -void _SLpack_pad_format (char *format) -{ - unsigned int len, max_len; - Format_Type ft; - char *buf, *b; - - check_native_byte_order (); - - /* Just check the syntax */ - if (-1 == compute_size_for_format (format, &max_len)) - return; - - /* This should be sufficient to handle any needed xyy padding characters. - * I cannot see how this will be overrun - */ - max_len = 4 * (strlen (format) + 1); - if (NULL == (buf = SLmalloc (max_len + 1))) - return; - - b = buf; - len = 0; - while (1 == parse_a_format (&format, &ft)) - { - struct { char a; short b; } s_h; - struct { char a; int b; } s_i; - struct { char a; long b; } s_l; - struct { char a; float b; } s_f; - struct { char a; double b; } s_d; - unsigned int pad; - - if (ft.repeat == 0) - continue; - - if (ft.data_type == 0) - { /* pad */ - sprintf (b, "x%u", ft.repeat); - b += strlen (b); - len += ft.repeat; - continue; - } - - switch (ft.data_type) - { - default: - case SLANG_STRING_TYPE: - case SLANG_BSTRING_TYPE: - case SLANG_CHAR_TYPE: - case SLANG_UCHAR_TYPE: - pad = 0; - break; - - case SLANG_SHORT_TYPE: - case SLANG_USHORT_TYPE: - pad = ((unsigned int) ((char *)&s_h.b - (char *)&s_h.a)); - break; - - case SLANG_INT_TYPE: - case SLANG_UINT_TYPE: - pad = ((unsigned int) ((char *)&s_i.b - (char *)&s_i.a)); - break; - - case SLANG_LONG_TYPE: - case SLANG_ULONG_TYPE: - pad = ((unsigned int) ((char *)&s_l.b - (char *)&s_l.a)); - break; - - case SLANG_FLOAT_TYPE: - pad = ((unsigned int) ((char *)&s_f.b - (char *)&s_f.a)); - break; - - case SLANG_DOUBLE_TYPE: - pad = ((unsigned int) ((char *)&s_d.b - (char *)&s_d.a)); - break; - } - - /* Pad to a length that is an integer multiple of pad. */ - if (pad) - pad = pad * ((len + pad - 1)/pad) - len; - - if (pad) - { - sprintf (b, "x%u", pad); - b += strlen (b); - len += pad; - } - - *b++ = ft.format_type; - if (ft.repeat > 1) - { - sprintf (b, "%u", ft.repeat); - b += strlen (b); - } - - len += ft.repeat * ft.sizeof_type; - } - *b = 0; - - (void) SLang_push_malloced_string (buf); -} diff --git a/mdk-stage1/slang/slparse.c b/mdk-stage1/slang/slparse.c deleted file mode 100644 index bc709d1fb..000000000 --- a/mdk-stage1/slang/slparse.c +++ /dev/null @@ -1,1970 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -static SLang_Load_Type *LLT; -int _SLang_Compile_Line_Num_Info; - -static void free_token (_SLang_Token_Type *t) -{ - register unsigned int nrefs = t->num_refs; - - if (nrefs == 0) - return; - - if (nrefs == 1) - { - if (t->free_sval_flag) - { - if (t->type == BSTRING_TOKEN) - SLbstring_free (t->v.b_val); - else - _SLfree_hashed_string (t->v.s_val, strlen (t->v.s_val), t->hash); - t->v.s_val = NULL; - } - } - - t->num_refs = nrefs - 1; -} - -static void init_token (_SLang_Token_Type *t) -{ - memset ((char *) t, 0, sizeof (_SLang_Token_Type)); -#if _SLANG_HAS_DEBUG_CODE - t->line_number = -1; -#endif -} - -/* Allow room for one push back of a token. This is necessary for - * multiple assignment. - */ -static unsigned int Use_Next_Token; -static _SLang_Token_Type Next_Token; -#if _SLANG_HAS_DEBUG_CODE -static int Last_Line_Number = -1; -#endif - -static int unget_token (_SLang_Token_Type *ctok) -{ - if (SLang_Error) - return -1; - if (Use_Next_Token != 0) - { - _SLparse_error ("unget_token failed", ctok, 0); - return -1; - } - - Use_Next_Token++; - Next_Token = *ctok; - init_token (ctok); - return 0; -} - -static int get_token (_SLang_Token_Type *ctok) -{ - if (ctok->num_refs) - free_token (ctok); - - if (Use_Next_Token) - { - Use_Next_Token--; - *ctok = Next_Token; - return ctok->type; - } - - return _SLget_token (ctok); -} - -static int compile_token (_SLang_Token_Type *t) -{ -#if _SLANG_HAS_DEBUG_CODE - if (_SLang_Compile_Line_Num_Info - && (t->line_number != Last_Line_Number) - && (t->line_number != -1)) - { - _SLang_Token_Type tok; - tok.type = LINE_NUM_TOKEN; - tok.v.long_val = Last_Line_Number = t->line_number; - (*_SLcompile_ptr) (&tok); - } -#endif - (*_SLcompile_ptr) (t); - return 0; -} - -typedef struct -{ -#define USE_PARANOID_MAGIC 0 -#if USE_PARANOID_MAGIC - unsigned long magic; -#endif - _SLang_Token_Type *stack; - unsigned int len; - unsigned int size; -} -Token_List_Type; - -#define MAX_TOKEN_LISTS 16 -static Token_List_Type Token_List_Stack [MAX_TOKEN_LISTS]; -static unsigned int Token_List_Stack_Depth = 0; -static Token_List_Type *Token_List = NULL; - -static void init_token_list (Token_List_Type *t) -{ - t->size = 0; - t->len = 0; - t->stack = NULL; -#if USE_PARANOID_MAGIC - t->magic = 0xABCDEF12; -#endif -} - -static void free_token_list (Token_List_Type *t) -{ - _SLang_Token_Type *s; - - if (t == NULL) - return; -#if USE_PARANOID_MAGIC - if (t->magic != 0xABCDEF12) - { - SLang_doerror ("Magic error."); - return; - } -#endif - s = t->stack; - if (s != NULL) - { - _SLang_Token_Type *smax = s + t->len; - while (s != smax) - { - if (s->num_refs) free_token (s); - s++; - } - - SLfree ((char *) t->stack); - } - - memset ((char *) t, 0, sizeof (Token_List_Type)); -} - -static Token_List_Type *push_token_list (void) -{ - if (Token_List_Stack_Depth == MAX_TOKEN_LISTS) - { - _SLparse_error ("Token list stack size exceeded", NULL, 0); - return NULL; - } - - Token_List = Token_List_Stack + Token_List_Stack_Depth; - Token_List_Stack_Depth++; - init_token_list (Token_List); - return Token_List; -} - -static int pop_token_list (int do_free) -{ - if (Token_List_Stack_Depth == 0) - { - if (SLang_Error == 0) - _SLparse_error ("Token list stack underflow", NULL, 0); - return -1; - } - Token_List_Stack_Depth--; - - if (do_free) free_token_list (Token_List); - - if (Token_List_Stack_Depth != 0) - Token_List = Token_List_Stack + (Token_List_Stack_Depth - 1); - else - Token_List = NULL; - - return 0; -} - -static int check_token_list_space (Token_List_Type *t, unsigned int delta_size) -{ - _SLang_Token_Type *st; - unsigned int len; -#if USE_PARANOID_MAGIC - if (t->magic != 0xABCDEF12) - { - SLang_doerror ("Magic error."); - return -1; - } -#endif - len = t->len + delta_size; - if (len <= t->size) return 0; - - if (delta_size < 4) - { - delta_size = 4; - len = t->len + delta_size; - } - - st = (_SLang_Token_Type *) SLrealloc((char *) t->stack, - len * sizeof(_SLang_Token_Type)); - if (st == NULL) - { - _SLparse_error ("Malloc error", NULL, 0); - return -1; - } - - memset ((char *) (st + t->len), 0, delta_size); - - t->stack = st; - t->size = len; - return 0; -} - -static int append_token (_SLang_Token_Type *t) -{ - if (-1 == check_token_list_space (Token_List, 1)) - return -1; - - Token_List->stack [Token_List->len] = *t; - Token_List->len += 1; - t->num_refs = 0; /* stealing it */ - return 0; -} - -static int append_token_of_type (unsigned char t) -{ - _SLang_Token_Type *tok; - - if (-1 == check_token_list_space (Token_List, 1)) - return -1; - - /* The memset when the list was created ensures that the other fields - * are properly initialized. - */ - tok = Token_List->stack + Token_List->len; - init_token (tok); - tok->type = t; - Token_List->len += 1; - return 0; -} - -static _SLang_Token_Type *get_last_token (void) -{ - unsigned int len; - - if ((Token_List == NULL) - || (0 == (len = Token_List->len))) - return NULL; - - len--; - return Token_List->stack + len; -} - -/* This function does NOT free the list. */ -static int compile_token_list_with_fun (int dir, Token_List_Type *list, - int (*f)(_SLang_Token_Type *)) -{ - _SLang_Token_Type *t0, *t1; - - if (list == NULL) - return -1; - - if (f == NULL) - f = compile_token; - - t0 = list->stack; - t1 = t0 + list->len; - - if (dir < 0) - { - /* backwards */ - - while ((SLang_Error == 0) && (t1 > t0)) - { - t1--; - (*f) (t1); - } - return 0; - } - - /* forward */ - while ((SLang_Error == 0) && (t0 < t1)) - { - (*f) (t0); - t0++; - } - return 0; -} - -static int compile_token_list (void) -{ - if (Token_List == NULL) - return -1; - - compile_token_list_with_fun (1, Token_List, NULL); - pop_token_list (1); - return 0; -} - -/* Take all elements in the list from pos2 to the end and exchange them - * with the elements at pos1, e.g., - * ...ABCDEabc ==> ...abcABCDE - * where pos1 denotes A and pos2 denotes a. - */ -static int token_list_element_exchange (unsigned int pos1, unsigned int pos2) -{ - _SLang_Token_Type *s, *s1, *s2; - unsigned int len, nloops; - - if (Token_List == NULL) - return -1; - - s = Token_List->stack; - len = Token_List->len; - - if ((s == NULL) || (len == 0) - || (pos2 >= len)) - return -1; - - /* This may not be the most efficient algorithm but the number to swap - * is most-likely going to be small, e.g, 3 - * The algorithm is to rotate the list. The particular rotation - * direction was chosen to make insert_token fast. - * It works like: - * @ ABCabcde --> BCabcdeA --> CabcdeAB --> abcdefAB - * which is optimal for Abcdef sequence produced by function calls. - * - * Profiling indicates that nloops is almost always 1, whereas the inner - * loop can loop many times (e.g., 9 times). - */ - - s2 = s + (len - 1); - s1 = s + pos1; - nloops = pos2 - pos1; - - while (nloops) - { - _SLang_Token_Type save; - - s = s1; - save = *s; - - while (s < s2) - { - *s = *(s + 1); - s++; - } - *s = save; - - nloops--; - } - return 0; -} - -#if 0 -static int insert_token (_SLang_Token_Type *t, unsigned int pos) -{ - if (-1 == append_token (t)) - return -1; - - return token_list_element_exchange (pos, Token_List->len - 1); -} -#endif -static void compile_token_of_type (unsigned char t) -{ - _SLang_Token_Type tok; - -#if _SLANG_HAS_DEBUG_CODE - tok.line_number = -1; -#endif - tok.type = t; - compile_token(&tok); -} - -static void statement (_SLang_Token_Type *); -static void compound_statement (_SLang_Token_Type *); -static void expression_with_parenthesis (_SLang_Token_Type *); -static void handle_semicolon (_SLang_Token_Type *); -static void statement_list (_SLang_Token_Type *); -static void variable_list (_SLang_Token_Type *, unsigned char); -static void struct_declaration (_SLang_Token_Type *); -static void define_function_args (_SLang_Token_Type *); -static void typedef_definition (_SLang_Token_Type *); -static void function_args_expression (_SLang_Token_Type *, int); -static void expression (_SLang_Token_Type *); -static void expression_with_commas (_SLang_Token_Type *, int); -static void simple_expression (_SLang_Token_Type *); -static void unary_expression (_SLang_Token_Type *); -static void postfix_expression (_SLang_Token_Type *); -static int check_for_lvalue (unsigned char, _SLang_Token_Type *); -/* static void primary_expression (_SLang_Token_Type *); */ -static void block (_SLang_Token_Type *); -static void inline_array_expression (_SLang_Token_Type *); -static void array_index_expression (_SLang_Token_Type *); -static void do_multiple_assignment (_SLang_Token_Type *); -static void try_multiple_assignment (_SLang_Token_Type *); -#if 0 -static void not_implemented (char *what) -{ - char err [256]; - sprintf (err, "Expression not implemented: %s", what); - _SLparse_error (err, NULL, 0); -} -#endif -static void rpn_parse_line (_SLang_Token_Type *tok) -{ - do - { - /* multiple RPN tokens possible when the file looks like: - * . <end of line> - * . <end of line> - */ - if (tok->type != RPN_TOKEN) - compile_token (tok); - free_token (tok); - } - while (EOF_TOKEN != _SLget_rpn_token (tok)); -} - -static int get_identifier_token (_SLang_Token_Type *tok) -{ - if (IDENT_TOKEN == get_token (tok)) - return IDENT_TOKEN; - - _SLparse_error ("Expecting identifier", tok, 0); - return tok->type; -} - -static void define_function (_SLang_Token_Type *ctok, unsigned char type) -{ - _SLang_Token_Type fname; - - switch (type) - { - case STATIC_TOKEN: - type = DEFINE_STATIC_TOKEN; - break; - - case PUBLIC_TOKEN: - type = DEFINE_PUBLIC_TOKEN; - break; - - case PRIVATE_TOKEN: - type = DEFINE_PRIVATE_TOKEN; - } - - init_token (&fname); - if (IDENT_TOKEN != get_identifier_token (&fname)) - { - free_token (&fname); - return; - } - - compile_token_of_type(OPAREN_TOKEN); - get_token (ctok); - define_function_args (ctok); - compile_token_of_type(FARG_TOKEN); - - if (ctok->type == OBRACE_TOKEN) - compound_statement(ctok); - - else if (ctok->type != SEMICOLON_TOKEN) - { - _SLparse_error("Expecting {", ctok, 0); - free_token (&fname); - return; - } - - fname.type = type; - compile_token (&fname); - free_token (&fname); -} - -/* statement: - * compound-statement - * if ( expression ) statement - * if ( expression ) statement else statement - * !if ( expression ) statement - * loop ( expression ) statement - * _for ( expression ) statement - * foreach ( expression ) statement - * foreach (expression ) using (expression-list) statement - * while ( expression ) statement - * do statement while (expression) ; - * for ( expressionopt ; expressionopt ; expressionopt ) statement - * ERROR_BLOCK statement - * EXIT_BLOCK statement - * USER_BLOCK0 statement - * USER_BLOCK1 statement - * USER_BLOCK2 statement - * USER_BLOCK3 statement - * USER_BLOCK4 statement - * forever statement - * break ; - * continue ; - * return expressionopt ; - * variable variable-list ; - * struct struct-decl ; - * define identifier function-args ; - * define identifier function-args compound-statement - * switch ( expression ) statement - * rpn-line - * at-line - * push ( expression ) - * ( expression ) = expression ; - * expression ; - * expression : - */ - -/* Note: This function does not return with a new token. It is up to the - * calling routine to handle that. - */ -static void statement (_SLang_Token_Type *ctok) -{ - unsigned char type; - - if (SLang_Error) - return; - - LLT->parse_level += 1; - - switch (ctok->type) - { - case OBRACE_TOKEN: - compound_statement (ctok); - break; - - case IF_TOKEN: - case IFNOT_TOKEN: - type = ctok->type; - get_token (ctok); - expression_with_parenthesis (ctok); - block (ctok); - - if (ELSE_TOKEN != get_token (ctok)) - { - compile_token_of_type (type); - unget_token (ctok); - break; - } - get_token (ctok); - block (ctok); - if (type == IF_TOKEN) type = ELSE_TOKEN; else type = NOTELSE_TOKEN; - compile_token_of_type (type); - break; - - /* case IFNOT_TOKEN: */ - case LOOP_TOKEN: - case _FOR_TOKEN: - type = ctok->type; - get_token (ctok); - expression_with_parenthesis (ctok); - block (ctok); - compile_token_of_type (type); - break; - - case FOREACH_TOKEN: - get_token (ctok); - expression_with_parenthesis (ctok); - - if (NULL == push_token_list ()) - break; - - append_token_of_type (ARG_TOKEN); - if (ctok->type == USING_TOKEN) - { - if (OPAREN_TOKEN != get_token (ctok)) - { - _SLparse_error ("Expected 'using ('", ctok, 0); - break; - } - get_token (ctok); - function_args_expression (ctok, 0); - } - append_token_of_type (EARG_TOKEN); - - compile_token_list (); - - block (ctok); - compile_token_of_type (FOREACH_TOKEN); - break; - - case WHILE_TOKEN: - get_token (ctok); - compile_token_of_type (OBRACE_TOKEN); - expression_with_parenthesis (ctok); - compile_token_of_type (CBRACE_TOKEN); - block (ctok); - compile_token_of_type (WHILE_TOKEN); - break; - - case DO_TOKEN: - get_token (ctok); - block (ctok); - - if (WHILE_TOKEN != get_token (ctok)) - { - _SLparse_error("Expecting while", ctok, 0); - break; - } - - get_token (ctok); - - compile_token_of_type (OBRACE_TOKEN); - expression_with_parenthesis (ctok); - compile_token_of_type (CBRACE_TOKEN); - compile_token_of_type (DOWHILE_TOKEN); - handle_semicolon (ctok); - break; - - case FOR_TOKEN: - - /* Look for (exp_opt ; exp_opt ; exp_opt ) */ - - if (OPAREN_TOKEN != get_token (ctok)) - { - _SLparse_error("Expecting (.", ctok, 0); - break; - } - - if (NULL == push_token_list ()) - break; - - append_token_of_type (OBRACE_TOKEN); - if (SEMICOLON_TOKEN != get_token (ctok)) - { - expression (ctok); - if (ctok->type != SEMICOLON_TOKEN) - { - _SLparse_error("Expecting ;", ctok, 0); - break; - } - } - append_token_of_type (CBRACE_TOKEN); - - append_token_of_type (OBRACE_TOKEN); - if (SEMICOLON_TOKEN != get_token (ctok)) - { - expression (ctok); - if (ctok->type != SEMICOLON_TOKEN) - { - _SLparse_error("Expecting ;", ctok, 0); - break; - } - } - append_token_of_type (CBRACE_TOKEN); - - append_token_of_type (OBRACE_TOKEN); - if (CPAREN_TOKEN != get_token (ctok)) - { - expression (ctok); - if (ctok->type != CPAREN_TOKEN) - { - _SLparse_error("Expecting ).", ctok, 0); - break; - } - } - append_token_of_type (CBRACE_TOKEN); - - compile_token_list (); - - get_token (ctok); - block (ctok); - compile_token_of_type (FOR_TOKEN); - break; - - case ERRBLK_TOKEN: - case EXITBLK_TOKEN: - case USRBLK0_TOKEN: - case USRBLK1_TOKEN: - case USRBLK2_TOKEN: - case USRBLK3_TOKEN: - case USRBLK4_TOKEN: - case FOREVER_TOKEN: - type = ctok->type; - get_token (ctok); - block (ctok); - compile_token_of_type (type); - break; - - case BREAK_TOKEN: - case CONT_TOKEN: - compile_token_of_type (ctok->type); - get_token (ctok); - handle_semicolon (ctok); - break; - - case RETURN_TOKEN: - if (SEMICOLON_TOKEN != get_token (ctok)) - { - if (NULL == push_token_list ()) - break; - - expression (ctok); - - if (ctok->type != SEMICOLON_TOKEN) - { - _SLparse_error ("Expecting ;", ctok, 0); - break; - } - compile_token_list (); - } - compile_token_of_type (RETURN_TOKEN); - handle_semicolon (ctok); - break; - - case STATIC_TOKEN: - case PRIVATE_TOKEN: - case PUBLIC_TOKEN: - type = ctok->type; - get_token (ctok); - if (ctok->type == VARIABLE_TOKEN) - { - get_token (ctok); - variable_list (ctok, type); - handle_semicolon (ctok); - break; - } - if (ctok->type == DEFINE_TOKEN) - { - define_function (ctok, type); - break; - } - _SLparse_error ("Expecting 'variable' or 'define'", ctok, 0); - break; - - case VARIABLE_TOKEN: - get_token (ctok); - variable_list (ctok, OBRACKET_TOKEN); - handle_semicolon (ctok); - break; - - case TYPEDEF_TOKEN: - get_token (ctok); - if (NULL == push_token_list ()) - break; - typedef_definition (ctok); - compile_token_list (); - - handle_semicolon (ctok); - break; - - case DEFINE_TOKEN: - define_function (ctok, DEFINE_TOKEN); - break; - - case SWITCH_TOKEN: - get_token (ctok); - expression_with_parenthesis (ctok); - - while ((SLang_Error == 0) - && (OBRACE_TOKEN == ctok->type)) - { - compile_token_of_type (OBRACE_TOKEN); - compound_statement (ctok); - compile_token_of_type (CBRACE_TOKEN); - get_token (ctok); - } - compile_token_of_type (SWITCH_TOKEN); - unget_token (ctok); - break; - - case EOF_TOKEN: - break; -#if 0 - case PUSH_TOKEN: - get_token (ctok); - expression_list_with_parenthesis (ctok); - handle_semicolon (ctok); - break; -#endif - - case SEMICOLON_TOKEN: - handle_semicolon (ctok); - break; - - case RPN_TOKEN: - if (POUND_TOKEN == get_token (ctok)) - _SLcompile_byte_compiled (); - else if (ctok->type != EOF_TOKEN) - rpn_parse_line (ctok); - break; - - case OPAREN_TOKEN: /* multiple assignment */ - try_multiple_assignment (ctok); - if (ctok->type == COLON_TOKEN) - compile_token_of_type (COLON_TOKEN); - else handle_semicolon (ctok); - break; - - default: - - if (NULL == push_token_list ()) - break; - - expression (ctok); - compile_token_list (); - - if (ctok->type == COLON_TOKEN) - compile_token_of_type (COLON_TOKEN); - else handle_semicolon (ctok); - break; - } - - LLT->parse_level -= 1; -} - -static void block (_SLang_Token_Type *ctok) -{ - compile_token_of_type (OBRACE_TOKEN); - statement (ctok); - compile_token_of_type (CBRACE_TOKEN); -} - -/* - * statement-list: - * statement - * statement-list statement - */ -static void statement_list (_SLang_Token_Type *ctok) -{ - while ((SLang_Error == 0) - && (ctok->type != CBRACE_TOKEN) - && (ctok->type != EOF_TOKEN)) - { - statement(ctok); - get_token (ctok); - } -} - -/* compound-statement: - * { statement-list } - */ -static void compound_statement (_SLang_Token_Type *ctok) -{ - /* ctok->type is OBRACE_TOKEN here */ - get_token (ctok); - statement_list(ctok); - if (CBRACE_TOKEN != ctok->type) - { - _SLparse_error ("Expecting '}'", ctok, 0); - return; - } -} - -/* This function is only called from statement. */ -static void expression_with_parenthesis (_SLang_Token_Type *ctok) -{ - if (ctok->type != OPAREN_TOKEN) - { - _SLparse_error("Expecting (", ctok, 0); - return; - } - - if (NULL == push_token_list ()) - return; - - get_token (ctok); - expression (ctok); - - if (ctok->type != CPAREN_TOKEN) - _SLparse_error("Expecting )", ctok, 0); - - compile_token_list (); - - get_token (ctok); -} - -static void handle_semicolon (_SLang_Token_Type *ctok) -{ - if ((ctok->type == SEMICOLON_TOKEN) - || (ctok->type == EOF_TOKEN)) - return; - - _SLparse_error ("Expecting ;", ctok, 0); -} - -void _SLparse_start (SLang_Load_Type *llt) -{ - _SLang_Token_Type ctok; - SLang_Load_Type *save_llt; - unsigned int save_use_next_token; - _SLang_Token_Type save_next_token; - Token_List_Type *save_list; -#if _SLANG_HAS_DEBUG_CODE - int save_last_line_number = Last_Line_Number; - - Last_Line_Number = -1; -#endif - save_use_next_token = Use_Next_Token; - save_next_token = Next_Token; - save_list = Token_List; - save_llt = LLT; - LLT = llt; - - init_token (&Next_Token); - Use_Next_Token = 0; - init_token (&ctok); - get_token (&ctok); - - llt->parse_level = 0; - statement_list (&ctok); - - if ((SLang_Error == 0) - && (ctok.type != EOF_TOKEN)) - _SLparse_error ("Parse ended prematurely", &ctok, 0); - - - if (SLang_Error) - { - if (SLang_Error < 0) /* severe error */ - save_list = NULL; - - while (Token_List != save_list) - { - if (-1 == pop_token_list (1)) - break; /* ??? when would this happen? */ - } - } - - free_token (&ctok); - LLT = save_llt; - if (Use_Next_Token) - free_token (&Next_Token); - Use_Next_Token = save_use_next_token; - Next_Token = save_next_token; -#if _SLANG_HAS_DEBUG_CODE - Last_Line_Number = save_last_line_number; -#endif -} - -/* variable-list: - * variable-decl - * variable-decl variable-list - * - * variable-decl: - * identifier - * identifier = simple-expression - */ -static void variable_list (_SLang_Token_Type *name_token, unsigned char variable_type) -{ - int declaring; - _SLang_Token_Type tok; - - if (name_token->type != IDENT_TOKEN) - { - _SLparse_error ("Expecting a variable name", name_token, 0); - return; - } - - declaring = 0; - do - { - if (declaring == 0) - { - declaring = 1; - compile_token_of_type (variable_type); - } - - compile_token (name_token); - - init_token (&tok); - if (ASSIGN_TOKEN == get_token (&tok)) - { - compile_token_of_type (CBRACKET_TOKEN); - declaring = 0; - - get_token (&tok); - - push_token_list (); - simple_expression (&tok); - compile_token_list (); - - name_token->type = _SCALAR_ASSIGN_TOKEN; - compile_token (name_token); - } - - free_token (name_token); - *name_token = tok; - } - while ((name_token->type == COMMA_TOKEN) - && (IDENT_TOKEN == get_token (name_token))); - - if (declaring) compile_token_of_type (CBRACKET_TOKEN); -} - -/* struct-declaration: - * struct { struct-field-list }; - * - * struct-field-list: - * struct-field-name , struct-field-list - * struct-field-name - * - * Generates code: "field-name-1" ... "field-name-N" N STRUCT_TOKEN - */ -static void struct_declaration (_SLang_Token_Type *ctok) -{ - int n; - _SLang_Token_Type num_tok; - - if (ctok->type != OBRACE_TOKEN) - { - _SLparse_error ("Expecting {", ctok, 0); - return; - } - - n = 0; - while (IDENT_TOKEN == get_token (ctok)) - { - n++; - ctok->type = STRING_TOKEN; - append_token (ctok); - if (COMMA_TOKEN != get_token (ctok)) - break; - } - - if (ctok->type != CBRACE_TOKEN) - { - _SLparse_error ("Expecting }", ctok, 0); - return; - } - if (n == 0) - { - _SLparse_error ("struct requires at least 1 field", ctok, 0); - return; - } - - init_token (&num_tok); - num_tok.type = INT_TOKEN; - num_tok.v.long_val = n; - append_token (&num_tok); - append_token_of_type (STRUCT_TOKEN); - - get_token (ctok); -} - -/* struct-declaration: - * typedef struct { struct-field-list } Type_Name; - * - * struct-field-list: - * struct-field-name , struct-field-list - * struct-field-name - * - * Generates code: "field-name-1" ... "field-name-N" N STRUCT_TOKEN typedef - */ -static void typedef_definition (_SLang_Token_Type *t) -{ - - if (t->type != STRUCT_TOKEN) - { - _SLparse_error ("Expecting `struct'", t, 0); - return; - } - get_token (t); - - struct_declaration (t); - if (t->type != IDENT_TOKEN) - { - _SLparse_error ("Expecting identifier", t, 0); - return; - } - - t->type = STRING_TOKEN; - append_token (t); - append_token_of_type (TYPEDEF_TOKEN); - - get_token (t); -} - -/* function-args: - * ( args-dec-opt ) - * - * args-decl-opt: - * identifier - * args-decl , identifier - */ -static void define_function_args (_SLang_Token_Type *ctok) -{ - if (CPAREN_TOKEN == get_token (ctok)) - { - get_token (ctok); - return; - } - - compile_token_of_type(OBRACKET_TOKEN); - - while ((SLang_Error == 0) - && (ctok->type == IDENT_TOKEN)) - { - compile_token (ctok); - if (COMMA_TOKEN != get_token (ctok)) - break; - - get_token (ctok); - } - - if (CPAREN_TOKEN != ctok->type) - { - _SLparse_error("Expecting )", ctok, 0); - return; - } - compile_token_of_type(CBRACKET_TOKEN); - - get_token (ctok); -} - -void try_multiple_assignment (_SLang_Token_Type *ctok) -{ - /* This is called with ctok->type == OPAREN_TOKEN. We have no idea - * what follows this. There are various possibilities such as: - * @ () = x; - * @ ( expression ) = x; - * @ ( expression ) ; - * @ ( expression ) OP expression; - * @ ( expression ) [expression] = expression; - * and only the first two constitute a multiple assignment. The last - * two forms create the difficulty. - * - * Here is the plan. First parse (expression) and then check next token. - * If it is an equal operator, then it will be parsed as a multiple - * assignment. In fact, that is the easy part. - * - * The hard part stems from the fact that by parsing (expression), we - * have effectly truncated the parse if (expression) is part of a binary - * or unary expression. Somehow, the parsing must be resumed. The trick - * here is to use a dummy literal that generates no code: NO_OP_LITERAL - * Using it, we just call 'expression' and proceed. - */ - - if (NULL == push_token_list ()) - return; - - get_token (ctok); - - if (ctok->type != CPAREN_TOKEN) - { - expression_with_commas (ctok, 1); - if (ctok->type != CPAREN_TOKEN) - { - _SLparse_error ("Expecting )", ctok, 0); - return; - } - } - - switch (get_token (ctok)) - { - case ASSIGN_TOKEN: - case PLUSEQS_TOKEN: - case MINUSEQS_TOKEN: - case TIMESEQS_TOKEN: - case DIVEQS_TOKEN: - case BOREQS_TOKEN: - case BANDEQS_TOKEN: - do_multiple_assignment (ctok); - pop_token_list (1); - break; - - default: - unget_token (ctok); - ctok->type = NO_OP_LITERAL; - expression (ctok); - compile_token_list (); - break; - } -} - -/* Note: expression never gets compiled directly. Rather, it gets - * appended to the token list and then compiled by a calling - * routine. - */ - -/* expression: - * simple_expression - * simple-expression , expression - * <none> - */ -static void expression_with_commas (_SLang_Token_Type *ctok, int save_comma) -{ - while (SLang_Error == 0) - { - if (ctok->type != COMMA_TOKEN) - { - if (ctok->type == CPAREN_TOKEN) - return; - - simple_expression (ctok); - - if (ctok->type != COMMA_TOKEN) - break; - } - if (save_comma) append_token (ctok); - get_token (ctok); - } -} - -static void expression (_SLang_Token_Type *ctok) -{ - expression_with_commas (ctok, 0); -} - -/* priority levels of binary operations */ -static unsigned char Binop_Level[] = -{ -/* ADD_TOKEN */ 2, -/* SUB_TOKEN */ 2, -/* MUL_TOKEN */ 1, -/* DIV_TOKEN */ 1, -/* LT_TOKEN */ 4, -/* LE_TOKEN */ 4, -/* GT_TOKEN */ 4, -/* GE_TOKEN */ 4, -/* EQ_TOKEN */ 5, -/* NE_TOKEN */ 5, -/* AND_TOKEN */ 9, -/* OR_TOKEN */ 10, -/* MOD_TOKEN */ 1, -/* BAND_TOKEN */ 6, -/* SHL_TOKEN */ 3, -/* SHR_TOKEN */ 3, -/* BXOR_TOKEN */ 7, -/* BOR_TOKEN */ 8, -/* POUND_TOKEN */ 1 /* Matrix Multiplication */ -}; - -/* % Note: simple-expression groups operators OP1 at same level. The - * % actual implementation will not do this. - * simple-expression: - * unary-expression - * binary-expression BINARY-OP unary-expression - * andelse xxelse-expression-list - * orelse xxelse-expression-list - * - * xxelse-expression-list: - * { expression } - * xxelse-expression-list { expression } - * binary-expression: - * unary-expression - * unary-expression BINARY-OP binary-expression - */ -static void simple_expression (_SLang_Token_Type *ctok) -{ - unsigned char type; - unsigned char op_stack [64]; - unsigned char level_stack [64]; - unsigned char level; - unsigned int op_num; - - switch (ctok->type) - { - case ANDELSE_TOKEN: - case ORELSE_TOKEN: - type = ctok->type; - if (OBRACE_TOKEN != get_token (ctok)) - { - _SLparse_error ("Expecting '{'", ctok, 0); - return; - } - - while (ctok->type == OBRACE_TOKEN) - { - append_token (ctok); - get_token (ctok); - expression (ctok); - if (CBRACE_TOKEN != ctok->type) - { - _SLparse_error("Expecting }", ctok, 0); - return; - } - append_token (ctok); - get_token (ctok); - } - append_token_of_type (type); - return; - - /* avoid unary-expression if possible */ - case STRING_TOKEN: - append_token (ctok); - get_token (ctok); - break; - - default: - unary_expression (ctok); - break; - } - - if (SEMICOLON_TOKEN == (type = ctok->type)) - return; - - op_num = 0; - - while ((SLang_Error == 0) - && (IS_BINARY_OP(type))) - { - level = Binop_Level[type - FIRST_BINARY_OP]; - - while ((op_num > 0) && (level_stack [op_num - 1] <= level)) - append_token_of_type (op_stack [--op_num]); - - if (op_num >= sizeof (op_stack) - 1) - { - _SLparse_error ("Binary op stack overflow", ctok, 0); - return; - } - - op_stack [op_num] = type; - level_stack [op_num] = level; - op_num++; - - get_token (ctok); - unary_expression (ctok); - type = ctok->type; - } - - while (op_num > 0) - append_token_of_type(op_stack[--op_num]); -} - -/* unary-expression: - * postfix-expression - * ++ postfix-expression - * -- postfix-expression - * case unary-expression - * OP3 unary-expression - * (OP3: + - ~ & not @) - * - * Note: This grammar permits: case case case WHATEVER - */ -static void unary_expression (_SLang_Token_Type *ctok) -{ - unsigned char save_unary_ops [16]; - unsigned int num_unary_ops; - unsigned char type; - _SLang_Token_Type *last_token; - - num_unary_ops = 0; - while (SLang_Error == 0) - { - type = ctok->type; - - switch (type) - { - case PLUSPLUS_TOKEN: - case MINUSMINUS_TOKEN: - get_token (ctok); - postfix_expression (ctok); - check_for_lvalue (type, NULL); - goto out_of_switch; - - case ADD_TOKEN: - get_token (ctok); /* skip it-- it's unary here */ - break; - - case SUB_TOKEN: - (void) get_token (ctok); - if (IS_INTEGER_TOKEN (ctok->type)) - { - ctok->v.long_val = -ctok->v.long_val; - break; - } - - if (num_unary_ops == 16) - goto stack_overflow_error; - save_unary_ops [num_unary_ops++] = CHS_TOKEN; - break; - - case DEREF_TOKEN: - case BNOT_TOKEN: - case NOT_TOKEN: - case CASE_TOKEN: - if (num_unary_ops == 16) - goto stack_overflow_error; - - save_unary_ops [num_unary_ops++] = type; - get_token (ctok); - break; - - /* Try to avoid ->postfix_expression->primary_expression - * subroutine calls. - */ - case STRING_TOKEN: - append_token (ctok); - get_token (ctok); - goto out_of_switch; - - default: - postfix_expression (ctok); - goto out_of_switch; - } - } - - out_of_switch: - if (num_unary_ops == 0) - return; - - if ((DEREF_TOKEN == save_unary_ops[num_unary_ops - 1]) - && (NULL != (last_token = get_last_token ())) - && (IS_ASSIGN_TOKEN(last_token->type))) - { - /* FIXME: Priority=medium - * This needs generalized so that things like @a.y = 1 will work properly. - */ - if ((num_unary_ops != 1) - || (last_token->type != _SCALAR_ASSIGN_TOKEN)) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "Only derefence assignments to simple variables are possible"); - return; - } - - last_token->type += (_DEREF_ASSIGN_TOKEN - _SCALAR_ASSIGN_TOKEN); - return; - } - - while (num_unary_ops) - { - num_unary_ops--; - append_token_of_type (save_unary_ops [num_unary_ops]); - } - return; - - stack_overflow_error: - _SLparse_error ("Too many unary operators.", ctok, 0); -} - -static int combine_namespace_tokens (_SLang_Token_Type *a, _SLang_Token_Type *b) -{ - char *sa, *sb, *sc; - unsigned int lena, lenb; - unsigned long hash; - - /* This is somewhat of a hack. Combine the TWO identifier names - * (NAMESPACE) and (name) into the form NAMESPACE->name. Then when the - * byte compiler compiles the object it will not be found. It will then - * check for this hack and make the appropriate namespace lookup. - */ - - sa = a->v.s_val; - sb = b->v.s_val; - - lena = strlen (sa); - lenb = strlen (sb); - - sc = SLmalloc (lena + lenb + 3); - if (sc == NULL) - return -1; - - strcpy (sc, sa); - strcpy (sc + lena, "->"); - strcpy (sc + lena + 2, sb); - - sb = _SLstring_make_hashed_string (sc, lena + lenb + 2, &hash); - SLfree (sc); - if (sb == NULL) - return -1; - - /* I can free this string because no other token should be referencing it. - * (num_refs == 1). - */ - _SLfree_hashed_string (sa, lena, a->hash); - a->v.s_val = sb; - a->hash = hash; - - return 0; -} - -static void append_identifier_token (_SLang_Token_Type *ctok) -{ - _SLang_Token_Type *last_token; - - append_token (ctok); - - if (NAMESPACE_TOKEN != get_token (ctok)) - return; - - if (IDENT_TOKEN != get_token (ctok)) - { - _SLparse_error ("Expecting name-space identifier", ctok, 0); - return; - } - - last_token = get_last_token (); - if (-1 == combine_namespace_tokens (last_token, ctok)) - return; - - (void) get_token (ctok); -} - -static int get_identifier_expr_token (_SLang_Token_Type *ctok) -{ - _SLang_Token_Type next_token; - - if (IDENT_TOKEN != get_identifier_token (ctok)) - return -1; - - init_token (&next_token); - if (NAMESPACE_TOKEN != get_token (&next_token)) - { - unget_token (&next_token); - return IDENT_TOKEN; - } - - if (IDENT_TOKEN != get_identifier_token (&next_token)) - { - free_token (&next_token); - return -1; - } - - if (-1 == combine_namespace_tokens (ctok, &next_token)) - { - free_token (&next_token); - return -1; - } - free_token (&next_token); - return IDENT_TOKEN; -} - -/* postfix-expression: - * primary-expression - * postfix-expression [ expression ] - * postfix-expression ( function-args-expression ) - * postfix-expression . identifier - * postfix-expression ^ unary-expression - * postfix-expression ++ - * postfix-expression -- - * postfix-expression = simple-expression - * postfix-expression += simple-expression - * postfix-expression -= simple-expression - * - * primary-expression: - * literal - * identifier-expr - * ( expression_opt ) - * [ inline-array-expression ] - * &identifier-expr - * struct-definition - * __tmp(identifier-expr) - * - * identifier-expr: - * identifier - * identifier->identifier - */ -static void postfix_expression (_SLang_Token_Type *ctok) -{ - unsigned int start_pos, end_pos; - unsigned char type; - - if (Token_List == NULL) - return; - - start_pos = Token_List->len; - - switch (ctok->type) - { - case IDENT_TOKEN: - append_identifier_token (ctok); - break; - - case CHAR_TOKEN: - case SHORT_TOKEN: - case INT_TOKEN: - case LONG_TOKEN: - case UCHAR_TOKEN: - case USHORT_TOKEN: - case UINT_TOKEN: - case ULONG_TOKEN: - case STRING_TOKEN: - case BSTRING_TOKEN: -#ifdef SLANG_HAS_FLOAT - case DOUBLE_TOKEN: - case FLOAT_TOKEN: -#endif -#ifdef SLANG_HAS_COMPLEX - case COMPLEX_TOKEN: -#endif - append_token (ctok); - get_token (ctok); - break; - - case OPAREN_TOKEN: - if (CPAREN_TOKEN != get_token (ctok)) - { - expression (ctok); - if (ctok->type != CPAREN_TOKEN) - _SLparse_error("Expecting )", ctok, 0); - } - get_token (ctok); - break; - - case BAND_TOKEN: - if (IDENT_TOKEN != get_identifier_expr_token (ctok)) - break; - - ctok->type = _REF_TOKEN; - append_token (ctok); - get_token (ctok); - break; - - case OBRACKET_TOKEN: - get_token (ctok); - inline_array_expression (ctok); - break; - - case NO_OP_LITERAL: - /* This token was introduced by try_multiple_assignment. There, - * a new token_list was pushed and (expression) was evaluated. - * NO_OP_LITERAL represents the result of expression. However, - * we need to tweak the start_pos variable to point to the beginning - * of the token list to complete the equivalence. - */ - start_pos = 0; - get_token (ctok); - break; - - case STRUCT_TOKEN: - get_token (ctok); - struct_declaration (ctok); - break; - - case TMP_TOKEN: - get_token (ctok); - if (ctok->type == OPAREN_TOKEN) - { - if (IDENT_TOKEN == get_identifier_expr_token (ctok)) - { - ctok->type = TMP_TOKEN; - append_token (ctok); - get_token (ctok); - if (ctok->type == CPAREN_TOKEN) - { - get_token (ctok); - break; - } - } - } - _SLparse_error ("Expecting form __tmp(NAME)", ctok, 0); - break; - - default: - if (IS_INTERNAL_FUNC(ctok->type)) - { - append_token (ctok); - get_token (ctok); - } - else - _SLparse_error("Expecting a PRIMARY", ctok, 0); - } - - while (SLang_Error == 0) - { - end_pos = Token_List->len; - type = ctok->type; - switch (type) - { - case OBRACKET_TOKEN: /* X[args] ==> [args] X ARRAY */ - get_token (ctok); - append_token_of_type (ARG_TOKEN); - if (ctok->type != CBRACKET_TOKEN) - array_index_expression (ctok); - - if (ctok->type != CBRACKET_TOKEN) - { - _SLparse_error ("Expecting ']'", ctok, 0); - return; - } - get_token (ctok); - /* append_token_of_type (EARG_TOKEN); -- ARRAY_TOKEN implicitely does this */ - token_list_element_exchange (start_pos, end_pos); - append_token_of_type (ARRAY_TOKEN); - break; - - case OPAREN_TOKEN: - /* f(args) ==> args f */ - if (CPAREN_TOKEN != get_token (ctok)) - { - function_args_expression (ctok, 1); - token_list_element_exchange (start_pos, end_pos); - } - else get_token (ctok); - break; - - case DOT_TOKEN: - /* S.a ==> "a" S DOT - * This means that if S is X[b], then X[b].a ==> a b X ARRAY DOT - * and f(a).X[b].c ==> "c" b "X" a f . ARRAY . - * Also, f(a).X[b] = g(x); ==> x g b "X" a f . - */ - if (IDENT_TOKEN != get_identifier_token (ctok)) - return; - - ctok->type = DOT_TOKEN; - append_token (ctok); - get_token (ctok); - break; - - case PLUSPLUS_TOKEN: - case MINUSMINUS_TOKEN: - check_for_lvalue (type, NULL); - get_token (ctok); - break; - - case ASSIGN_TOKEN: - case PLUSEQS_TOKEN: - case MINUSEQS_TOKEN: - case TIMESEQS_TOKEN: - case DIVEQS_TOKEN: - case BOREQS_TOKEN: - case BANDEQS_TOKEN: - check_for_lvalue (type, NULL); - get_token (ctok); - simple_expression (ctok); - token_list_element_exchange (start_pos, end_pos); - break; - - case POW_TOKEN: - get_token (ctok); - unary_expression (ctok); - append_token_of_type (POW_TOKEN); - break; - - default: - return; - } - } -} - -static void function_args_expression (_SLang_Token_Type *ctok, int handle_num_args) -{ - unsigned char last_type, this_type; - - if (handle_num_args) append_token_of_type (ARG_TOKEN); - - last_type = COMMA_TOKEN; - - while (SLang_Error == 0) - { - this_type = ctok->type; - - switch (this_type) - { - case COMMA_TOKEN: - if (last_type == COMMA_TOKEN) - append_token_of_type (_NULL_TOKEN); - get_token (ctok); - break; - - case CPAREN_TOKEN: - if (last_type == COMMA_TOKEN) - append_token_of_type (_NULL_TOKEN); - if (handle_num_args) append_token_of_type (EARG_TOKEN); - get_token (ctok); - return; - - default: - simple_expression (ctok); - if ((ctok->type != COMMA_TOKEN) - && (ctok->type != CPAREN_TOKEN)) - { - _SLparse_error ("Expecting ')'", ctok, 0); - break; - } - } - last_type = this_type; - } -} - -static int check_for_lvalue (unsigned char eqs_type, _SLang_Token_Type *ctok) -{ - unsigned char type; - - if ((ctok == NULL) - && (NULL == (ctok = get_last_token ()))) - return -1; - - type = ctok->type; - - eqs_type -= ASSIGN_TOKEN; - - if (type == IDENT_TOKEN) - eqs_type += _SCALAR_ASSIGN_TOKEN; - else if (type == ARRAY_TOKEN) - eqs_type += _ARRAY_ASSIGN_TOKEN; - else if (type == DOT_TOKEN) - eqs_type += _STRUCT_ASSIGN_TOKEN; - else - { - _SLparse_error ("Expecting LVALUE", ctok, 0); - return -1; - } - - ctok->type = eqs_type; - return 0; -} - -static void array_index_expression (_SLang_Token_Type *ctok) -{ - unsigned int num_commas; - - num_commas = 0; - while (1) - { - switch (ctok->type) - { - case COLON_TOKEN: - if (num_commas) - _SLparse_error ("Misplaced ':'", ctok, 0); - return; - - case TIMES_TOKEN: - append_token_of_type (_INLINE_WILDCARD_ARRAY_TOKEN); - get_token (ctok); - break; - - case COMMA_TOKEN: - _SLparse_error ("Misplaced ','", ctok, 0); - return; - - default: - simple_expression (ctok); - } - - if (ctok->type != COMMA_TOKEN) - return; - num_commas++; - get_token (ctok); - } -} - -/* inline-array-expression: - * array_index_expression - * simple_expression : simple_expression - * simple_expression : simple_expression : simple_expression - */ -static void inline_array_expression (_SLang_Token_Type *ctok) -{ - int num_colons = 0; - - append_token_of_type (ARG_TOKEN); - - if (ctok->type == COLON_TOKEN) /* [:...] */ - append_token_of_type (_NULL_TOKEN); - else if (ctok->type != CBRACKET_TOKEN) - array_index_expression (ctok); - - if (ctok->type == COLON_TOKEN) - { - num_colons++; - if ((COLON_TOKEN == get_token (ctok)) - || (ctok->type == CBRACKET_TOKEN)) - append_token_of_type (_NULL_TOKEN); - else - simple_expression (ctok); - - if (ctok->type == COLON_TOKEN) - { - num_colons++; - get_token (ctok); - simple_expression (ctok); - } - } - - if (ctok->type != CBRACKET_TOKEN) - { - _SLparse_error ("Expecting ']'", ctok, 0); - return; - } - - /* append_token_of_type (EARG_TOKEN); */ - if (num_colons) - append_token_of_type (_INLINE_IMPLICIT_ARRAY_TOKEN); - else - append_token_of_type (_INLINE_ARRAY_TOKEN); - get_token (ctok); -} - -static void do_multiple_assignment (_SLang_Token_Type *ctok) -{ - _SLang_Token_Type *s; - unsigned int i, k, len; - unsigned char assign_type; - - assign_type = ctok->type; - - /* The LHS token list has already been pushed. Here we do the RHS - * so push to another token list, process it, then come back to - * LHS for assignment. - */ - if (NULL == push_token_list ()) - return; - - get_token (ctok); - expression (ctok); - compile_token_list (); - - if (SLang_Error) - return; - - /* Finally compile the LHS of the assignment expression - * that has been saved. - */ - s = Token_List->stack; - len = Token_List->len; - - if (len == 0) - { - compile_token_of_type (POP_TOKEN); - return; - } - - while (len > 0) - { - /* List is of form: - * a , b, c d e, f , g , , , h , - * The missing expressions will be replaced by a POP - * ,,a - */ - - /* Start from back looking for a COMMA */ - k = len - 1; - if (s[k].type == COMMA_TOKEN) - { - compile_token_of_type (POP_TOKEN); - len = k; - continue; - } - - if (-1 == check_for_lvalue (assign_type, s + k)) - return; - - i = 0; - while (1) - { - if (s[k].type == COMMA_TOKEN) - { - i = k + 1; - break; - } - - if (k == 0) - break; - - k--; - } - - while (i < len) - { - compile_token (s + i); - i++; - } - - len = k; - } - - if (s[0].type == COMMA_TOKEN) - compile_token_of_type (POP_TOKEN); -} - diff --git a/mdk-stage1/slang/slpath.c b/mdk-stage1/slang/slpath.c deleted file mode 100644 index 831bd34df..000000000 --- a/mdk-stage1/slang/slpath.c +++ /dev/null @@ -1,344 +0,0 @@ -/* Pathname and filename functions */ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#ifdef HAVE_IO_H -# include <io.h> -#endif - -#include <sys/types.h> -#include <sys/stat.h> -#include <signal.h> -#include <time.h> - -#include <errno.h> -#include <string.h> - -#include "slang.h" -#include "_slang.h" - -/* In this file, all file names are assumed to be specified in the Unix - * format, or in the native format. - * - * Aboout VMS: - * VMS pathnames are a mess. In general, they look like - * node::device:[dir.dir]file.ext;version - * and I do not know of a well-defined Unix representation for them. So, - * I am going to punt and encourage users to stick to the native - * representation. - */ - -#if defined(IBMPC_SYSTEM) -# define PATH_SEP '\\' -# define DRIVE_SPECIFIER ':' -# define SEARCH_PATH_DELIMITER ';' -# define THIS_DIR_STRING "." -#else -# if defined(VMS) -# define PATH_SEP ']' -# define DRIVE_SPECIFIER ':' -# define SEARCH_PATH_DELIMITER ' ' -# define THIS_DIR_STRING "[]" /* Is this correct?? */ -# else -# define PATH_SEP '/' -# define UNIX_PATHNAMES_OK -# define SEARCH_PATH_DELIMITER ':' -# define THIS_DIR_STRING "." -# endif -#endif - -#ifdef UNIX_PATHNAMES_OK -# define IS_PATH_SEP(x) ((x) == PATH_SEP) -#else -# define IS_PATH_SEP(x) (((x) == PATH_SEP) || ((x) == '/')) -#endif - -/* If file is /a/b/c/basename, this function returns a pointer to basename */ -char *SLpath_basename (char *file) -{ - char *b; - - if (file == NULL) return NULL; - b = file + strlen (file); - - while (b != file) - { - b--; - if (IS_PATH_SEP(*b)) - return b + 1; -#ifdef DRIVE_SPECIFIER - if (*b == DRIVE_SPECIFIER) - return b + 1; -#endif - } - - return b; -} - -/* Returns a malloced string */ -char *SLpath_pathname_sans_extname (char *file) -{ - char *b; - - file = SLmake_string (file); - if (file == NULL) - return NULL; - - b = file + strlen (file); - - while (b != file) - { - b--; - if (*b == '.') - { - *b = 0; - return file; - } - } - - return file; -} - -/* If path looks like: A/B/C/D/whatever, it returns A/B/C/D as a malloced - * string. - */ -char *SLpath_dirname (char *file) -{ - char *b; - - if (file == NULL) return NULL; - b = file + strlen (file); - - while (b != file) - { - b--; - if (IS_PATH_SEP(*b)) - { - if (b == file) b++; - break; - } - -#ifdef DRIVE_SPECIFIER - if (*b == DRIVE_SPECIFIER) - { - b++; - break; - } -#endif - } - - if (b == file) - return SLmake_string (THIS_DIR_STRING); - - return SLmake_nstring (file, (unsigned int) (b - file)); -} - -/* Note: VMS filenames also contain version numbers. The caller will have - * to deal with that. - * - * The extension includes the '.'. If no extension is present, "" is returned. - */ -char *SLpath_extname (char *file) -{ - char *b; - - if (NULL == (file = SLpath_basename (file))) - return NULL; - - b = file + strlen (file); - while (b != file) - { - b--; - if (*b == '.') - return b; - } - - if (*b == '.') - return b; - - /* Do not return a literal "" */ - return file + strlen (file); -} - -#ifdef IBMPC_SYSTEM -static void convert_slashes (char *f) -{ - while (*f) - { - if (*f == '/') *f = PATH_SEP; - f++; - } -} -#endif - -int SLpath_is_absolute_path (char *name) -{ -#ifdef UNIX_PATHNAMES_OK - return (*name == '/'); -#else - if (IS_PATH_SEP (*name)) - return 1; - -# ifdef DRIVE_SPECIFIER - /* Look for a drive specifier */ - while (*name) - { - if (*name == DRIVE_SPECIFIER) - return 1; - - name++; - } -# endif - - return 0; -#endif -} - -/* This returns a MALLOCED string */ -char *SLpath_dircat (char *dir, char *name) -{ - unsigned int len, dirlen; - char *file; -#ifndef VMS - int requires_fixup; -#endif - - if (name == NULL) - name = ""; - - if ((dir == NULL) || (SLpath_is_absolute_path (name))) - dir = ""; - - /* Both VMS and MSDOS have default directories associated with each drive. - * That is, the meaning of something like C:X depends upon more than just - * the syntax of the string. Since this concept has more power under VMS - * it will be honored here. However, I am going to treat C:X as C:\X - * under MSDOS. - * - * Note!!! - * VMS has problems of its own regarding path names, so I am simply - * going to strcat. Hopefully the VMS RTL is smart enough to deal with - * the result. - */ - dirlen = strlen (dir); -#ifndef VMS - requires_fixup = (dirlen && (0 == IS_PATH_SEP(dir[dirlen - 1]))); -#endif - - len = dirlen + strlen (name) + 2; - if (NULL == (file = SLmalloc (len))) - return NULL; - - strcpy (file, dir); - -#ifndef VMS - if (requires_fixup) - file[dirlen++] = PATH_SEP; -#endif - - strcpy (file + dirlen, name); - -#if defined(IBMPC_SYSTEM) - convert_slashes (file); -#endif - - return file; -} - -int SLpath_file_exists (char *file) -{ - struct stat st; - int m; - -#if defined(__os2__) && !defined(S_IFMT) -/* IBM VA3 doesn't declare S_IFMT */ -# define S_IFMT (S_IFDIR | S_IFCHR | S_IFREG) -#endif - -#ifdef _S_IFDIR -# ifndef S_IFDIR -# define S_IFDIR _S_IFDIR -# endif -#endif - -#ifndef S_ISDIR -# ifdef S_IFDIR -# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) -# else -# define S_ISDIR(m) 0 -# endif -#endif - - if (file == NULL) - return -1; - - if (stat(file, &st) < 0) return 0; - m = st.st_mode; - - if (S_ISDIR(m)) return (2); - return 1; -} - -char *SLpath_find_file_in_path (char *path, char *name) -{ - unsigned int max_path_len; - unsigned int this_path_len; - char *file, *dir; - char *p; - unsigned int nth; - - if ((path == NULL) || (*path == 0) - || (name == NULL) || (*name == 0)) - return NULL; - - max_path_len = 0; - this_path_len = 0; - p = path; - while (*p != 0) - { - if (*p++ == SEARCH_PATH_DELIMITER) - { - if (this_path_len > max_path_len) max_path_len = this_path_len; - this_path_len = 0; - } - else this_path_len++; - } - if (this_path_len > max_path_len) max_path_len = this_path_len; - max_path_len++; - - if (NULL == (dir = SLmalloc (max_path_len))) - return NULL; - - nth = 0; - while (-1 != SLextract_list_element (path, nth, SEARCH_PATH_DELIMITER, - dir, max_path_len)) - { - nth++; - if (*dir == 0) - continue; - - if (NULL == (file = SLpath_dircat (dir, name))) - { - SLfree (dir); - return NULL; - } - - if (1 == SLpath_file_exists (file)) - { - SLfree (dir); - return file; - } - - SLfree (file); - } - - SLfree (dir); - return NULL; -} - diff --git a/mdk-stage1/slang/slposdir.c b/mdk-stage1/slang/slposdir.c deleted file mode 100644 index 33799e574..000000000 --- a/mdk-stage1/slang/slposdir.c +++ /dev/null @@ -1,1057 +0,0 @@ -/* file intrinsics for S-Lang */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#if defined(__unix__) || (defined (__os2__) && defined (__EMX__)) -# include <sys/types.h> -#endif - -#ifdef HAVE_IO_H -# include <io.h> /* for chmod */ -#endif - -#if defined(__BORLANDC__) -# include <process.h> -# include <dos.h> -#endif - -#ifdef HAVE_FCNTL_H -# include <fcntl.h> -#endif -#ifdef HAVE_SYS_FCNTL_H -# include <sys/fcntl.h> -#endif - -#ifdef __unix__ -# include <sys/file.h> -#endif - -#if defined(__BORLANDC__) -# include <dir.h> -#endif - -#if defined(_MSC_VER) -# include <io.h> -#endif - -#if defined(__DECC) && defined(VMS) -# include <unixio.h> -# include <unixlib.h> -#endif - -#ifdef VMS -# include <stat.h> -#else -# include <sys/stat.h> -#endif - -#if defined(VMS) -# define USE_LISTDIR_INTRINSIC 0 -#else -# define USE_LISTDIR_INTRINSIC 1 -#endif - -#if USE_LISTDIR_INTRINSIC - -#if defined(__WIN32__) -# include <windows.h> -#else -# if defined(__OS2__) && defined(__IBMC__) -# define INCL_DOS -# define INCL_ERRORS -# include <os2.h> -# include <direct.h> -# include <ctype.h> -# else -# ifdef HAVE_DIRENT_H -# include <dirent.h> -# else -# ifdef HAVE_DIRECT_H -# include <direct.h> -# else -# define dirent direct -# define NEED_D_NAMLEN -# if HAVE_SYS_NDIR_H -# include <sys/ndir.h> -# endif -# if HAVE_SYS_DIR_H -# include <sys/dir.h> -# endif -# if HAVE_NDIR_H -# include <ndir.h> -# endif -# endif -# endif -# endif -#endif - -#endif /* USE_LISTDIR_INTRINSIC */ - -#include <errno.h> - -#include "slang.h" -#include "_slang.h" - -static int push_stat_struct (struct stat *st, int opt_attrs) -{ - char *field_names [12]; - unsigned char field_types[12]; - VOID_STAR field_values [12]; - int int_values [12]; - unsigned int i; - - field_names [0] = "st_dev"; int_values [0] = (int) st->st_dev; - field_names [1] = "st_ino"; int_values [1] = (int) st->st_ino; - field_names [2] = "st_mode"; int_values [2] = (int) st->st_mode; - field_names [3] = "st_nlink"; int_values [3] = (int) st->st_nlink; - field_names [4] = "st_uid"; int_values [4] = (int) st->st_uid; - field_names [5] = "st_gid"; int_values [5] = (int) st->st_gid; - field_names [6] = "st_rdev"; int_values [6] = (int) st->st_rdev; - field_names [7] = "st_size"; int_values [7] = (int) st->st_size; - field_names [8] = "st_atime"; int_values [8] = (int) st->st_atime; - field_names [9] = "st_mtime"; int_values [9] = (int) st->st_mtime; - field_names [10] = "st_ctime"; int_values [10] = (int) st->st_ctime; - - field_names [11] = "st_opt_attrs"; int_values[11] = opt_attrs; - - for (i = 0; i < 12; i++) - { - field_types [i] = SLANG_INT_TYPE; - field_values [i] = (VOID_STAR) (int_values + i); - } - - return SLstruct_create_struct (12, field_names, field_types, field_values); -} - -static void stat_cmd (char *file) -{ - struct stat st; - int status; - int opt_attrs; - - status = stat (file, &st); - -#if defined(__MSDOS__) || defined(__WIN32__) - if (status == -1) - { - unsigned int len = strlen (file); - if (len && ((file[len-1] == '\\') || (file[len-1] == '/'))) - { - file = SLmake_nstring (file, len-1); - if (file == NULL) - return; - - status = stat (file, &st); - SLfree (file); - } - } -#endif - if (status == -1) - { - _SLerrno_errno = errno; - SLang_push_null (); - return; - } - -#ifdef __WIN32__ - opt_attrs = GetFileAttributes (file); -#else - opt_attrs = 0; -#endif - - push_stat_struct (&st, opt_attrs); -} - -static void lstat_cmd (char *file) -{ -#ifdef HAVE_LSTAT - struct stat st; - int opt_attrs; - - if (-1 == lstat (file, &st)) - { - _SLerrno_errno = errno; - SLang_push_null (); - return; - } - -#ifdef __WIN32__ - opt_attrs = GetFileAttributes (file); -#else - opt_attrs = 0; -#endif - - push_stat_struct (&st, opt_attrs); -#else - stat_cmd (file); -#endif -} - -/* Well, it appears that on some systems, these are not defined. Here I - * provide them. These are derived from the Linux stat.h file. - */ - -#ifdef __os2__ -# ifdef __IBMC__ -/* IBM VA3 doesn't declare S_IFMT */ -# define S_IFMT (S_IFDIR | S_IFCHR | S_IFREG) -# endif -#endif - -#ifndef S_ISLNK -# ifdef S_IFLNK -# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) -# else -# define S_ISLNK(m) 0 -# endif -#endif - -#ifndef S_ISREG -# ifdef S_IFREG -# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) -# else -# define S_ISREG(m) 0 -# endif -#endif - -#ifndef S_ISDIR -# ifdef S_IFDIR -# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) -# else -# define S_ISDIR(m) 0 -# endif -#endif - -#ifndef S_ISCHR -# ifdef S_IFCHR -# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) -# else -# define S_ISCHR(m) 0 -# endif -#endif - -#ifndef S_ISBLK -# ifdef S_IFBLK -# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK) -# else -# define S_ISBLK(m) 0 -# endif -#endif - -#ifndef S_ISFIFO -# ifdef S_IFIFO -# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) -# else -# define S_ISFIFO(m) 0 -# endif -#endif - -#ifndef S_ISSOCK -# ifdef S_IFSOCK -# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK) -# else -# define S_ISSOCK(m) 0 -# endif -#endif - -static char stat_is_cmd (char *what, int *mode_ptr) -{ - int ret; - int st_mode = *mode_ptr; - - if (!strcmp (what, "sock")) ret = S_ISSOCK(st_mode); - else if (!strcmp (what, "fifo")) ret = S_ISFIFO(st_mode); - else if (!strcmp (what, "blk")) ret = S_ISBLK(st_mode); - else if (!strcmp (what, "chr")) ret = S_ISCHR(st_mode); - else if (!strcmp (what, "dir")) ret = S_ISDIR(st_mode); - else if (!strcmp (what, "reg")) ret = S_ISREG(st_mode); - else if (!strcmp (what, "lnk")) ret = S_ISLNK(st_mode); - else - { - SLang_verror (SL_INVALID_PARM, "stat_is: Unrecognized type: %s", what); - return -1; - } - - return (char) (ret != 0); -} - -#ifdef HAVE_READLINK -static void readlink_cmd (char *s) -{ - char buf[2048]; - int n; - - n = readlink (s, buf, sizeof (buf)-1); - if (n == -1) - { - _SLerrno_errno = errno; - s = NULL; - } - else - { - buf[n] = 0; - s = buf; - } - - (void) SLang_push_string (s); -} -#endif - -static int chmod_cmd (char *file, int *mode) -{ - if (-1 == chmod(file, (mode_t) *mode)) - { - _SLerrno_errno = errno; - return -1; - } - return 0; -} - -#ifdef HAVE_CHOWN -static int chown_cmd (char *file, int *owner, int *group) -{ - int ret; - - if (-1 == (ret = chown(file, (uid_t) *owner, (gid_t) *group))) - _SLerrno_errno = errno; - return ret; -} -#endif - -/* add trailing slash to dir */ -static void fixup_dir (char *dir) -{ -#ifndef VMS - int n; - - if ((n = strlen(dir)) > 1) - { - n--; -#if defined(IBMPC_SYSTEM) - if ( dir[n] != '/' && dir[n] != '\\' ) - strcat(dir, "\\" ); -#else - if (dir[n] != '/' ) - strcat(dir, "/" ); -#endif - } -#endif /* !VMS */ -} - -static void slget_cwd (void) -{ - char cwd[1024]; - char *p; - -#ifndef HAVE_GETCWD - p = getwd (cwd); -#else -# if defined (__EMX__) - p = _getcwd2(cwd, 1022); /* includes drive specifier */ -# else - p = getcwd(cwd, 1022); /* djggp includes drive specifier */ -# endif -#endif - - if (p == NULL) - { - _SLerrno_errno = errno; - SLang_push_null (); - return; - } - -#ifndef VMS -#ifdef __GO32__ - /* You never know about djgpp since it favors unix */ - { - char ch; - p = cwd; - while ((ch = *p) != 0) - { - if (ch == '/') *p = '\\'; - p++; - } - } -#endif - fixup_dir (cwd); -#endif - SLang_push_string (cwd); -} - -static int chdir_cmd (char *s) -{ - int ret; - - while (-1 == (ret = chdir (s))) - { -#ifdef EINTR - if (errno == EINTR) - continue; -#endif - _SLerrno_errno = errno; - break; - } - return ret; -} - -#ifdef VMS -static int remove_cmd (char *); -/* If the file looks like xxx, then change it to xxx.dir. If - * it looks like A:[B.xxx] then change it to A:[B]xxx.dir. - */ - -static char *vms_convert_dirspec_to_vms_dir (char *str) -{ - char *s; - char *version; - unsigned int len; - char *dot; - - len = strlen (str); - - version = strchr (str, ';'); - if (version == NULL) - version = str + len; - /* version points to the version of the input string */ - - - if (NULL == (s = SLmalloc (len + 8)))/* allow extra space to work with */ - return NULL; - - len = (unsigned int) (version - str); - strncpy (s, str, len); - s[len] = 0; - str = s; - - /* Lowercase the whole thing */ - while (*s != 0) - { - *s = LOWER_CASE(*s); - s++; - } - - if ((s > str) - && (s[-1] != ']')) - { - if ((s >= str + 4) - && (0 == strcmp (s - 4, ".dir"))) - s -= 4; - goto add_dir_version; - } - - /* Check for one of two possibilities: - * - * dev:[x] --> dev:x - * dev:[a.x] --> dev:[a]x - */ - - if (NULL == (dot = strchr (str, '.'))) - { - /* First possibility */ - if (NULL == (s = strchr (str, '['))) - return str; /* let someone else figure this out */ - while (s[1] != ']') - { - s[0] = s[1]; - s++; - } - *s = 0; - goto add_dir_version; - } - - while (NULL != (s = strchr (dot + 1, '.'))) - dot = s; - - *dot = ']'; - s = str + (len - 1); - - /* Drop */ - - add_dir_version: - strcpy (s, ".dir"); - strcpy (s+4, version); - return str; -} -#endif - -static int rmdir_cmd (char *s) -{ -#ifdef VMS - int status; - - if (NULL == (s = vms_convert_dirspec_to_vms_dir (s))) - return -1; - - status = remove_cmd (s); - SLfree (s); - - return status; - -#else - int ret; - - while (-1 == (ret = rmdir (s))) - { -#ifdef EINTR - if (errno == EINTR) - continue; -#endif - _SLerrno_errno = errno; - break; - } - return ret; -#endif -} - -static int remove_cmd (char *s) -{ - int ret; -#ifdef VMS -# define REMOVE delete -#else -# ifdef REAL_UNIX_SYSTEM -# define REMOVE unlink -# else -# define REMOVE remove -# endif -#endif - - while (-1 == (ret = REMOVE (s))) - { -#ifdef EINTR - if (errno == EINTR) - continue; -#endif - _SLerrno_errno = errno; - break; - } - return ret; -} - -static int rename_cmd (char *oldpath, char *newpath) -{ - int ret; - while (-1 == (ret = rename (oldpath, newpath))) - { -#ifdef EINTR - if (errno == EINTR) - continue; -#endif - _SLerrno_errno = errno; - break; - } - return ret; -} - -static int mkdir_cmd (char *s, int *mode_ptr) -{ - int ret; - - (void) mode_ptr; - errno = 0; - -#if defined (__MSDOS__) && !defined(__GO32__) -# define MKDIR(x,y) mkdir(x) -#else -# if defined (__os2__) && !defined (__EMX__) -# define MKDIR(x,y) mkdir(x) -# else -# if defined (__WIN32__) && !defined (__CYGWIN32__) -# define MKDIR(x,y) mkdir(x) -# else -# define MKDIR mkdir -# endif -# endif -#endif - - while (-1 == (ret = MKDIR(s, *mode_ptr))) - { -#ifdef EINTR - if (errno == EINTR) - continue; -#endif - _SLerrno_errno = errno; - break; - } - return ret; -} - -#ifdef HAVE_MKFIFO -static int mkfifo_cmd (char *path, int *mode) -{ - if (-1 == mkfifo (path, *mode)) - { - _SLerrno_errno = errno; - return -1; - } - return 0; -} -#endif - -#if USE_LISTDIR_INTRINSIC - -static void free_dir_list (char **list, unsigned int num) -{ - unsigned int i; - - if (list == NULL) - return; - - for (i = 0; i < num; i++) - SLang_free_slstring (list[i]); - SLfree ((char *) list); -} - -#if defined(__WIN32__) || defined(__os2__) && defined(__IBMC__) -static int build_dirlist (char *file, char *opt, char ***listp, unsigned int *nump, unsigned int *maxnum) -{ -# ifdef __WIN32__ - DWORD status; - HANDLE h; - WIN32_FIND_DATA fd; -# else - APIRET rc; - FILESTATUS3 status; - HDIR h; - FILEFINDBUF3 fd; - ULONG cFileNames; -# endif - char *pat; - unsigned int len; - char **list; - unsigned int num; - unsigned int max_num; - int hok; - - /* If an option is present, assume ok to list hidden files. Later - * I will formalize this. - */ - hok = (opt != NULL); - -# ifdef __WIN32__ - status = GetFileAttributes (file); -# else - rc = DosQueryPathInfo(file, FIL_STANDARD, &status, sizeof(FILESTATUS3)); -# endif - - -# ifdef __WIN32__ - if (status == (DWORD)-1) - { - _SLerrno_errno = ENOENT; - return -1; - } - if (0 == (status & FILE_ATTRIBUTE_DIRECTORY)) - { - _SLerrno_errno = ENOTDIR; - return -1; - } -# else - if ((rc != 0) || (status.attrFile & FILE_DIRECTORY) == 0) - { - /* ENOTDIR isn't defined in VA3. */ - _SLerrno_errno = ENOENT; - return -1; - } -# endif - - len = strlen (file); - pat = SLmalloc (len + 3); - if (pat == NULL) - return -1; - - strcpy (pat, file); - file = pat; - while (*file != 0) - { - if (*file == '/') *file = '\\'; - file++; - } - - if (len && (pat[len-1] != '\\')) - { - pat[len] = '\\'; - len++; - } - pat[len++] = '*'; - pat[len] = 0; - - num = 0; - max_num = 50; - list = (char **)SLmalloc (max_num * sizeof(char *)); - if (list == NULL) - { - SLfree (pat); - return -1; - } - -# ifdef __WIN32__ - h = FindFirstFile(pat, &fd); - if (h == INVALID_HANDLE_VALUE) - { - if (ERROR_NO_MORE_FILES != GetLastError()) - { - SLfree (pat); - SLfree ((char *)list); - return -1; - } - } -# else - h = HDIR_CREATE; - cFileNames = 1; - rc = DosFindFirst(pat, &h, FILE_READONLY | FILE_DIRECTORY | - FILE_ARCHIVED, &fd, sizeof(fd), &cFileNames, FIL_STANDARD); - if (rc != 0) - { - if (rc != ERROR_NO_MORE_FILES) - { - SLfree (pat); - SLfree ((char *)list); - return -1; - } - } -# endif - else while (1) - { - /* Do not include hidden files in the list. Also, do not - * include "." and ".." entries. - */ -#ifdef __WIN32__ - file = fd.cFileName; -#else - file = fd.achName; -#endif - if ( -#ifdef __WIN32__ - (hok || (0 == (fd.dwFileAttributes & FILE_ATTRIBUTE_HIDDEN))) -#else - (hok || (0 == (fd.attrFile & FILE_HIDDEN))) -#endif - && ((*file != '.') - || ((0 != strcmp (file, ".")) - && (0 != strcmp (file, ".."))))) - { - if (num == max_num) - { - char **new_list; - - max_num += 100; - new_list = (char **)SLrealloc ((char *)list, max_num * sizeof (char *)); - if (new_list == NULL) - goto return_error; - - list = new_list; - } - - file = SLang_create_slstring (file); - if (file == NULL) - goto return_error; - - list[num] = file; - num++; - } - -#ifdef __WIN32__ - if (FALSE == FindNextFile(h, &fd)) - { - if (ERROR_NO_MORE_FILES == GetLastError()) - { - FindClose (h); - break; - } - - _SLerrno_errno = errno; - FindClose (h); - goto return_error; - } -#else - cFileNames = 1; - rc = DosFindNext(h, &fd, sizeof(fd), &cFileNames); - if (rc != 0) - { - if (rc == ERROR_NO_MORE_FILES) - { - DosFindClose (h); - break; - } - - _SLerrno_errno = errno; - DosFindClose (h); - goto return_error; - } -#endif - } - - SLfree (pat); - *maxnum = max_num; - *nump = num; - *listp = list; - return 0; - - return_error: - free_dir_list (list, num); - SLfree (pat); - return -1; -} - -#else /* NOT __WIN32__ */ - -static int build_dirlist (char *dir, char *opt, char ***listp, unsigned int *nump, unsigned int *maxnum) -{ - DIR *dp; - struct dirent *ep; - unsigned int num_files; - unsigned int max_num_files; - char **list; - - (void) opt; - - if (NULL == (dp = opendir (dir))) - { - _SLerrno_errno = errno; - return -1; - } - - num_files = max_num_files = 0; - list = NULL; - while (NULL != (ep = readdir (dp))) - { - unsigned int len; - char *name; - - name = ep->d_name; -# ifdef NEED_D_NAMLEN - len = ep->d_namlen; -# else - len = strlen (name); -# endif - if ((*name == '.') && (len <= 2)) - { - if (len == 1) continue; - if (name [1] == '.') continue; - } - - if (num_files == max_num_files) - { - char **new_list; - - max_num_files += 100; - if (NULL == (new_list = (char **) SLrealloc ((char *)list, max_num_files * sizeof(char *)))) - goto return_error; - - list = new_list; - } - - if (NULL == (list[num_files] = SLang_create_nslstring (name, len))) - goto return_error; - - num_files++; - } - - closedir (dp); - *nump = num_files; - *maxnum = max_num_files; - *listp = list; - return 0; - - return_error: - if (dp != NULL) - closedir (dp); - free_dir_list (list, num_files); - return -1; -} -# endif /* NOT __WIN32__ */ - -static void listdir_cmd (char *dir, char *opt) -{ - SLang_Array_Type *at; - unsigned int num_files; - unsigned int max_num_files; - int inum_files; - char **list; - - if (-1 == build_dirlist (dir, opt, &list, &num_files, &max_num_files)) - { - SLang_push_null (); - return; - } - /* If max_num_files == 0, then num_files == 0 and list == NULL. - * The realloc step below will malloc list for us. - */ - if (num_files + 1 < max_num_files) - { - char **new_list; - if (NULL == (new_list = (char **) SLrealloc ((char *)list, (num_files + 1)* sizeof(char*)))) - { - free_dir_list (list, num_files); - SLang_push_null (); - return; - } - list = new_list; - } - - inum_files = (int) num_files; - if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, (VOID_STAR) list, &inum_files, 1))) - { - free_dir_list (list, num_files); - SLang_push_null (); - return; - } - - /* Allow the array to free this list if push fails */ - if (-1 == SLang_push_array (at, 1)) - SLang_push_null (); -} - -static void listdir_cmd_wrap (void) -{ - char *s, *sopt; - - sopt = NULL; - switch (SLang_Num_Function_Args) - { - case 2: - if (-1 == SLang_pop_slstring (&sopt)) - return; - case 1: - if (-1 == SLang_pop_slstring (&s)) - { - SLang_free_slstring (sopt); - return; - } - break; - default: - SLang_verror (SL_INVALID_PARM, "usage: listdir (string, [opt-string]"); - return; - } - - listdir_cmd (s, sopt); - SLang_free_slstring (s); - SLang_free_slstring (sopt); -} - -#endif /* USE_LISTDIR_INTRINSIC */ - -#ifdef HAVE_UMASK -static int umask_cmd (int *u) -{ - return umask (*u); -} -#endif - -static SLang_Intrin_Fun_Type PosixDir_Name_Table [] = -{ -#ifdef HAVE_READLINK - MAKE_INTRINSIC_S("readlink", readlink_cmd, SLANG_VOID_TYPE), -#endif - MAKE_INTRINSIC_S("lstat_file", lstat_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("stat_file", stat_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SI("stat_is", stat_is_cmd, SLANG_CHAR_TYPE), -#ifdef HAVE_MKFIFO - MAKE_INTRINSIC_SI("mkfifo", mkfifo_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_CHOWN - MAKE_INTRINSIC_SII("chown", chown_cmd, SLANG_INT_TYPE), -#endif - MAKE_INTRINSIC_SI("chmod", chmod_cmd, SLANG_INT_TYPE), -#ifdef HAVE_UMASK - MAKE_INTRINSIC_I("umask", umask_cmd, SLANG_INT_TYPE), -#endif - MAKE_INTRINSIC_0("getcwd", slget_cwd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SI("mkdir", mkdir_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_S("chdir", chdir_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_S("rmdir", rmdir_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_S("remove", remove_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_SS("rename", rename_cmd, SLANG_INT_TYPE), -#if USE_LISTDIR_INTRINSIC - MAKE_INTRINSIC("listdir", listdir_cmd_wrap, SLANG_VOID_TYPE, 0), -#endif - SLANG_END_INTRIN_FUN_TABLE -}; - -static SLang_IConstant_Type PosixDir_Consts [] = -{ -#ifndef S_IRWXU -# define S_IRWXU 00700 -#endif - MAKE_ICONSTANT("S_IRWXU", S_IRWXU), -#ifndef S_IRUSR -# define S_IRUSR 00400 -#endif - MAKE_ICONSTANT("S_IRUSR", S_IRUSR), -#ifndef S_IWUSR -# define S_IWUSR 00200 -#endif - MAKE_ICONSTANT("S_IWUSR", S_IWUSR), -#ifndef S_IXUSR -# define S_IXUSR 00100 -#endif - MAKE_ICONSTANT("S_IXUSR", S_IXUSR), -#ifndef S_IRWXG -# define S_IRWXG 00070 -#endif - MAKE_ICONSTANT("S_IRWXG", S_IRWXG), -#ifndef S_IRGRP -# define S_IRGRP 00040 -#endif - MAKE_ICONSTANT("S_IRGRP", S_IRGRP), -#ifndef S_IWGRP -# define S_IWGRP 00020 -#endif - MAKE_ICONSTANT("S_IWGRP", S_IWGRP), -#ifndef S_IXGRP -# define S_IXGRP 00010 -#endif - MAKE_ICONSTANT("S_IXGRP", S_IXGRP), -#ifndef S_IRWXO -# define S_IRWXO 00007 -#endif - MAKE_ICONSTANT("S_IRWXO", S_IRWXO), -#ifndef S_IROTH -# define S_IROTH 00004 -#endif - MAKE_ICONSTANT("S_IROTH", S_IROTH), -#ifndef S_IWOTH -# define S_IWOTH 00002 -#endif - MAKE_ICONSTANT("S_IWOTH", S_IWOTH), -#ifndef S_IXOTH -# define S_IXOTH 00001 -#endif - MAKE_ICONSTANT("S_IXOTH", S_IXOTH), -#ifdef __WIN32__ - MAKE_ICONSTANT("FILE_ATTRIBUTE_ARCHIVE", FILE_ATTRIBUTE_ARCHIVE), - MAKE_ICONSTANT("FILE_ATTRIBUTE_COMPRESSED", FILE_ATTRIBUTE_COMPRESSED), - MAKE_ICONSTANT("FILE_ATTRIBUTE_NORMAL", FILE_ATTRIBUTE_NORMAL), - MAKE_ICONSTANT("FILE_ATTRIBUTE_DIRECTORY", FILE_ATTRIBUTE_DIRECTORY), - MAKE_ICONSTANT("FILE_ATTRIBUTE_HIDDEN", FILE_ATTRIBUTE_HIDDEN), - MAKE_ICONSTANT("FILE_ATTRIBUTE_READONLY", FILE_ATTRIBUTE_READONLY), - MAKE_ICONSTANT("FILE_ATTRIBUTE_SYSTEM", FILE_ATTRIBUTE_SYSTEM), - MAKE_ICONSTANT("FILE_ATTRIBUTE_TEMPORARY", FILE_ATTRIBUTE_TEMPORARY), -#endif - SLANG_END_ICONST_TABLE -}; - -static int Initialized; - -int SLang_init_posix_dir (void) -{ - if (Initialized) - return 0; - - if ((-1 == SLadd_intrin_fun_table(PosixDir_Name_Table, "__POSIX_DIR__")) - || (-1 == SLadd_iconstant_table (PosixDir_Consts, NULL)) - || (-1 == _SLerrno_init ())) - return -1; - - Initialized = 1; - - return 0; -} - diff --git a/mdk-stage1/slang/slposio.c b/mdk-stage1/slang/slposio.c deleted file mode 100644 index ab1e9f689..000000000 --- a/mdk-stage1/slang/slposio.c +++ /dev/null @@ -1,568 +0,0 @@ -/* This module implements an interface to posix system calls */ -/* file stdio intrinsics for S-Lang */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#if defined(__unix__) || (defined (__os2__) && defined (__EMX__)) -# include <sys/types.h> -#endif - -#ifdef HAVE_FCNTL_H -# include <fcntl.h> -#endif -#ifdef HAVE_SYS_FCNTL_H -# include <sys/fcntl.h> -#endif - -#ifdef __unix__ -# include <sys/file.h> -#endif - -#ifdef HAVE_IO_H -# include <io.h> -#endif - -#if defined(__BORLANDC__) -# include <dir.h> -#endif - -#if defined(__DECC) && defined(VMS) -# include <unixio.h> -# include <unixlib.h> -#endif - -#ifdef VMS -# include <stat.h> -#else -# include <sys/stat.h> -#endif - -#include <errno.h> - -#include "slang.h" -#include "_slang.h" - -struct _SLFile_FD_Type -{ - char *name; - unsigned int num_refs; /* reference counting */ - int fd; - SLang_MMT_Type *stdio_mmt; /* fdopen'd stdio object */ - - /* methods */ - int (*close)(int); - int (*read) (int, char *, unsigned int *); - int (*write)(int, char *, unsigned int *); -}; - -static int close_method (int fd) -{ - return close (fd); -} - -static int write_method (int fd, char *buf, unsigned int *nump) -{ - int num; - - if (-1 == (num = write (fd, buf, *nump))) - { - *nump = 0; - return -1; - } - - *nump = (unsigned int) num; - return 0; -} - -static int read_method (int fd, char *buf, unsigned int *nump) -{ - int num; - - num = read (fd, buf, *nump); - if (num == -1) - { - *nump = 0; - return -1; - } - *nump = (unsigned int) num; - return 0; -} - -static int check_fd (int fd) -{ - if (fd == -1) - { -#ifdef EBADF - _SLerrno_errno = EBADF; -#endif - return -1; - } - - return 0; -} - -static int posix_close (SLFile_FD_Type *f) -{ - if (-1 == check_fd (f->fd)) - return -1; - - if ((f->close != NULL) - && (-1 == f->close (f->fd))) - { - _SLerrno_errno = errno; - return -1; - } - - if (f->stdio_mmt != NULL) - { - SLang_free_mmt (f->stdio_mmt); - f->stdio_mmt = NULL; - } - - f->fd = -1; - return 0; -} - -/* Usage: Uint write (f, buf); */ -static void posix_write (SLFile_FD_Type *f, SLang_BString_Type *bstr) -{ - unsigned int len; - char *p; - - if ((-1 == check_fd (f->fd)) - || (NULL == (p = (char *)SLbstring_get_pointer (bstr, &len)))) - { - SLang_push_integer (-1); - return; - } - - if (-1 == f->write (f->fd, p, &len)) - { - _SLerrno_errno = errno; - SLang_push_integer (-1); - return; - } - - (void) SLang_push_uinteger (len); -} - -/* Usage: nn = read (f, &buf, n); */ -static void posix_read (SLFile_FD_Type *f, SLang_Ref_Type *ref, unsigned int *nbytes) -{ - unsigned int len; - char *b; - SLang_BString_Type *bstr; - - b = NULL; - - len = *nbytes; - if ((-1 == check_fd (f->fd)) - || (NULL == (b = SLmalloc (len + 1)))) - goto return_error; - - if (-1 == f->read (f->fd, b, &len)) - { - _SLerrno_errno = errno; - goto return_error; - } - - if (len != *nbytes) - { - char *b1 = SLrealloc (b, len + 1); - if (b1 == NULL) - goto return_error; - b = b1; - } - - bstr = SLbstring_create_malloced ((unsigned char *) b, len, 0); - if (bstr != NULL) - { - if ((-1 != SLang_assign_to_ref (ref, SLANG_BSTRING_TYPE, (VOID_STAR)&bstr)) - && (-1 != SLang_push_uinteger (len))) - return; - - SLbstring_free (bstr); - b = NULL; - /* drop */ - } - - return_error: - if (b != NULL) SLfree ((char *)b); - (void) SLang_assign_to_ref (ref, SLANG_NULL_TYPE, NULL); - (void) SLang_push_integer (-1); -} - -SLFile_FD_Type *SLfile_create_fd (char *name, int fd) -{ - SLFile_FD_Type *f; - - if (NULL == (f = (SLFile_FD_Type *) SLmalloc (sizeof (SLFile_FD_Type)))) - return NULL; - - memset ((char *) f, 0, sizeof (SLFile_FD_Type)); - if (NULL == (f->name = SLang_create_slstring (name))) - { - SLfree ((char *)f); - return NULL; - } - - f->fd = fd; - f->num_refs = 1; - - f->close = close_method; - f->read = read_method; - f->write = write_method; - - return f; -} - -SLFile_FD_Type *SLfile_dup_fd (SLFile_FD_Type *f0) -{ - SLFile_FD_Type *f; - int fd0, fd; - - if (f0 == NULL) - return NULL; - fd0 = f0->fd; - if (-1 == check_fd (fd0)) - return NULL; - - while (-1 == (fd = dup (fd0))) - { -#ifdef EINTR - if (errno == EINTR) - continue; -#endif - _SLerrno_errno = errno; - return NULL; - } - - if (NULL == (f = SLfile_create_fd (f0->name, fd))) - { - f0->close (fd); - return NULL; - } - - return f; -} - -int SLfile_get_fd (SLFile_FD_Type *f, int *fd) -{ - if (f == NULL) - return -1; - - *fd = f->fd; - if (-1 == check_fd (*fd)) - return -1; - - return 0; -} - -void SLfile_free_fd (SLFile_FD_Type *f) -{ - if (f == NULL) - return; - - if (f->num_refs > 1) - { - f->num_refs -= 1; - return; - } - - if (f->fd != -1) - { - if (f->close != NULL) - (void) f->close (f->fd); - - f->fd = -1; - } - - if (f->stdio_mmt != NULL) - SLang_free_mmt (f->stdio_mmt); - - SLfree ((char *) f); -} - -static int pop_string_int (char **s, int *i) -{ - *s = NULL; - if ((-1 == SLang_pop_integer (i)) - || (-1 == SLang_pop_slstring (s))) - return -1; - - return 0; -} - -static int pop_string_int_int (char **s, int *a, int *b) -{ - *s = NULL; - if ((-1 == SLang_pop_integer (b)) - || (-1 == pop_string_int (s, a))) - return -1; - - return 0; -} - -static void posix_open (void) -{ - char *file; - int mode, flags; - SLFile_FD_Type *f; - - switch (SLang_Num_Function_Args) - { - case 3: - if (-1 == pop_string_int_int (&file, &flags, &mode)) - { - SLang_push_null (); - return; - } - break; - - case 2: - default: - if (-1 == pop_string_int (&file, &flags)) - return; - mode = 0777; - break; - } - - f = SLfile_create_fd (file, -1); - if (f == NULL) - { - SLang_free_slstring (file); - SLang_push_null (); - return; - } - SLang_free_slstring (file); - - if (-1 == (f->fd = open (f->name, flags, mode))) - { - _SLerrno_errno = errno; - SLfile_free_fd (f); - SLang_push_null (); - return; - } - - if (-1 == SLfile_push_fd (f)) - SLang_push_null (); - SLfile_free_fd (f); -} - -static void posix_fileno (void) -{ - FILE *fp; - SLang_MMT_Type *mmt; - int fd; - SLFile_FD_Type *f; - char *name; - - if (-1 == SLang_pop_fileptr (&mmt, &fp)) - { - SLang_push_null (); - return; - } - name = SLang_get_name_from_fileptr (mmt); - fd = fileno (fp); - - f = SLfile_create_fd (name, fd); - if (f != NULL) - f->close = NULL; /* prevent fd from being closed - * when it goes out of scope - */ - SLang_free_mmt (mmt); - - if (-1 == SLfile_push_fd (f)) - SLang_push_null (); - SLfile_free_fd (f); -} - -static void posix_fdopen (SLFile_FD_Type *f, char *mode) -{ - if (f->stdio_mmt == NULL) - { - if (-1 == _SLstdio_fdopen (f->name, f->fd, mode)) - return; - - if (NULL == (f->stdio_mmt = SLang_pop_mmt (SLANG_FILE_PTR_TYPE))) - return; - } - - (void) SLang_push_mmt (f->stdio_mmt); -} - -static long posix_lseek (SLFile_FD_Type *f, long ofs, int whence) -{ - long status; - - if (-1 == (status = lseek (f->fd, ofs, whence))) - _SLerrno_errno = errno; - - return status; -} - -static int posix_isatty (void) -{ - int ret; - SLFile_FD_Type *f; - - if (SLang_peek_at_stack () == SLANG_FILE_PTR_TYPE) - { - SLang_MMT_Type *mmt; - FILE *fp; - - if (-1 == SLang_pop_fileptr (&mmt, &fp)) - return 0; /* invalid descriptor */ - - ret = isatty (fileno (fp)); - SLang_free_mmt (mmt); - return ret; - } - - if (-1 == SLfile_pop_fd (&f)) - return 0; - - ret = isatty (f->fd); - SLfile_free_fd (f); - - return ret; -} - -static void posix_dup (SLFile_FD_Type *f) -{ - if ((NULL == (f = SLfile_dup_fd (f))) - || (-1 == SLfile_push_fd (f))) - SLang_push_null (); - - SLfile_free_fd (f); -} - -#define I SLANG_INT_TYPE -#define V SLANG_VOID_TYPE -#define F SLANG_FILE_FD_TYPE -#define B SLANG_BSTRING_TYPE -#define R SLANG_REF_TYPE -#define U SLANG_UINT_TYPE -#define S SLANG_STRING_TYPE -#define L SLANG_LONG_TYPE -static SLang_Intrin_Fun_Type Fd_Name_Table [] = -{ - MAKE_INTRINSIC_0("fileno", posix_fileno, V), - MAKE_INTRINSIC_0("isatty", posix_isatty, I), - MAKE_INTRINSIC_0("open", posix_open, V), - MAKE_INTRINSIC_3("read", posix_read, V, F, R, U), - MAKE_INTRINSIC_3("lseek", posix_lseek, L, F, L, I), - MAKE_INTRINSIC_2("fdopen", posix_fdopen, V, F, S), - MAKE_INTRINSIC_2("write", posix_write, V, F, B), - MAKE_INTRINSIC_1("dup_fd", posix_dup, V, F), - MAKE_INTRINSIC_1("close", posix_close, I, F), - SLANG_END_INTRIN_FUN_TABLE -}; -#undef I -#undef V -#undef F -#undef B -#undef R -#undef S -#undef L -#undef U - -static SLang_IConstant_Type PosixIO_Consts [] = -{ -#ifdef O_RDONLY - MAKE_ICONSTANT("O_RDONLY", O_RDONLY), -#endif -#ifdef O_WRONLY - MAKE_ICONSTANT("O_WRONLY", O_WRONLY), -#endif -#ifdef O_RDWR - MAKE_ICONSTANT("O_RDWR", O_RDWR), -#endif -#ifdef O_APPEND - MAKE_ICONSTANT("O_APPEND", O_APPEND), -#endif -#ifdef O_CREAT - MAKE_ICONSTANT("O_CREAT", O_CREAT), -#endif -#ifdef O_EXCL - MAKE_ICONSTANT("O_EXCL", O_EXCL), -#endif -#ifdef O_NOCTTY - MAKE_ICONSTANT("O_NOCTTY", O_NOCTTY), -#endif -#ifdef O_NONBLOCK - MAKE_ICONSTANT("O_NONBLOCK", O_NONBLOCK), -#endif -#ifdef O_TRUNC - MAKE_ICONSTANT("O_TRUNC", O_TRUNC), -#endif -#ifndef O_BINARY -# define O_BINARY 0 -#endif - MAKE_ICONSTANT("O_BINARY", O_BINARY), -#ifndef O_TEXT -# define O_TEXT 0 -#endif - MAKE_ICONSTANT("O_TEXT", O_TEXT), - - SLANG_END_ICONST_TABLE -}; - -int SLfile_push_fd (SLFile_FD_Type *f) -{ - if (f == NULL) - return SLang_push_null (); - - f->num_refs += 1; - - if (0 == SLclass_push_ptr_obj (SLANG_FILE_FD_TYPE, (VOID_STAR) f)) - return 0; - - f->num_refs -= 1; - - return -1; -} - -int SLfile_pop_fd (SLFile_FD_Type **f) -{ - return SLclass_pop_ptr_obj (SLANG_FILE_FD_TYPE, (VOID_STAR *) f); -} - -static void destroy_fd_type (unsigned char type, VOID_STAR ptr) -{ - (void) type; - SLfile_free_fd (*(SLFile_FD_Type **) ptr); -} - -static int fd_push (unsigned char type, VOID_STAR v) -{ - (void) type; - return SLfile_push_fd (*(SLFile_FD_Type **)v); -} - -int SLang_init_posix_io (void) -{ - SLang_Class_Type *cl; - - if (NULL == (cl = SLclass_allocate_class ("FD_Type"))) - return -1; - cl->cl_destroy = destroy_fd_type; - (void) SLclass_set_push_function (cl, fd_push); - - if (-1 == SLclass_register_class (cl, SLANG_FILE_FD_TYPE, sizeof (SLFile_FD_Type), SLANG_CLASS_TYPE_PTR)) - return -1; - - if ((-1 == SLadd_intrin_fun_table(Fd_Name_Table, "__POSIXIO__")) - || (-1 == SLadd_iconstant_table (PosixIO_Consts, NULL)) - || (-1 == _SLerrno_init ())) - return -1; - - return 0; -} - diff --git a/mdk-stage1/slang/slprepr.c b/mdk-stage1/slang/slprepr.c deleted file mode 100644 index 358eeb874..000000000 --- a/mdk-stage1/slang/slprepr.c +++ /dev/null @@ -1,427 +0,0 @@ -/* Copyright (c) 1996, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -/*--------------------------------*-C-*---------------------------------* - * File: slprepr.c - * - * preprocessing routines - */ -/*{{{ notes: */ -/* - * various preprocessing tokens supported - * - * #ifdef TOKEN1 TOKEN2 ... - * - True if any of TOKEN1 TOKEN2 ... are defined - * - * #ifndef TOKEN1 TOKEN2 ... - * - True if none of TOKEN1 TOKEN2 ... are defined - * - * #iftrue - * #ifnfalse - * - always True - * - * #iffalse - * #ifntrue - * - always False - * - * #if$ENV - * - True if the enviroment variable ENV is set - * - * #ifn$ENV - * - True if the enviroment variable ENV is not set - * - * #if$ENV TOKEN1 TOKEN2 ... - * - True if the contents of enviroment variable ENV match - * any of TOKEN1 TOKEN2 ... - * - * #ifn$ENV TOKEN1 TOKEN2 ... - * - True if the contents of enviroment variable ENV do not match - * any of TOKEN1 TOKEN2 ... - * - * NB: For $ENV, the tokens may contain wildcard characters: - * '?' - match any single character - * '*' - match any number of characters - * - * #elif... - * #else - * #endif - * - * - * mj olesen - *----------------------------------------------------------------------*/ -/*}}}*/ -/*{{{ includes: */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" -/*}}}*/ - -int (*SLprep_exists_hook) (char *, char); -int (*_SLprep_eval_hook) (char *); - -/*{{{ SLprep_open_prep (), SLprep_close_prep () */ -int SLprep_open_prep (SLPreprocess_Type *pt) -{ - pt->this_level = 0; - pt->exec_level = 0; - pt->prev_exec_level = 0; - pt->comment_char = '%'; - pt->preprocess_char = '#'; - pt->flags = 0; - return 0; -} - -void SLprep_close_prep (SLPreprocess_Type *pt) -{ - (void) pt; -} -/*}}}*/ - -/*{{{ SLwildcard () */ -/*----------------------------------------------------------------------* - * Does `string' match `pattern' ? - * - * '*' in pattern matches any sub-string (including the null string) - * '?' matches any single char. - * - * Code taken from that donated by Paul Hudson <paulh@harlequin.co.uk> - * to the fvwm project. - * It is public domain, no strings attached. No guarantees either. - *----------------------------------------------------------------------*/ -static int SLwildcard (char *pattern, char *string) -{ - if (pattern == NULL || *pattern == '\0' || !strcmp (pattern, "*")) - return 1; - else if (string == NULL) - return 0; - - while (*pattern && *string) switch (*pattern) - { - case '?': - /* match any single character */ - pattern++; - string++; - break; - - case '*': - /* see if rest of pattern matches any trailing */ - /* substring of the string. */ - if (*++pattern == '\0') - return 1; /* trailing * must match rest */ - - while (*string) - { - if (SLwildcard (pattern, string)) return 1; - string++; - } - return 0; - - /* break; */ - - default: - if (*pattern == '\\') - { - if (*++pattern == '\0') - pattern--; /* don't skip trailing backslash */ - } - if (*pattern++ != *string++) return 0; - break; - } - - return ((*string == '\0') - && ((*pattern == '\0') || !strcmp (pattern, "*"))); -} -/*}}}*/ - -#if defined(__16_BIT_SYSTEM__) -# define MAX_DEFINES 10 -#else -# define MAX_DEFINES 128 -#endif - -/* The extra one is for NULL termination */ -char *_SLdefines [MAX_DEFINES + 1]; - -int SLdefine_for_ifdef (char *s) /*{{{*/ -{ - unsigned int i; - - for (i = 0; i < MAX_DEFINES; i++) - { - char *s1 = _SLdefines [i]; - - if (s1 == s) - return 0; /* already defined (hashed string) */ - - if (s1 != NULL) - continue; - - s = SLang_create_slstring (s); - if (s == NULL) - return -1; - - _SLdefines[i] = s; - return 0; - } - return -1; -} -/*}}}*/ - -/*{{{ static functions */ -static int is_any_defined(char *buf, char comment) /*{{{*/ -{ - char *sys; - unsigned int i; - - while (1) - { - register char ch; - - /* Skip whitespace */ - while (((ch = *buf) == ' ') || (ch == '\t')) - buf++; - - if ((ch == '\n') || (ch == 0) || (ch == comment)) - return 0; - - i = 0; - while (NULL != (sys = _SLdefines [i++])) - { - unsigned int n; - - if (*sys != ch) - continue; - - n = strlen (sys); - if (0 == strncmp (buf, sys, n)) - { - char ch1 = *(buf + n); - - if ((ch1 == '\n') || (ch1 == 0) || - (ch1 == ' ') || (ch1 == '\t') || (ch1 == comment)) - return 1; - } - } - - /* Skip past word */ - while (((ch = *buf) != ' ') - && (ch != '\n') - && (ch != 0) - && (ch != '\t') - && (ch != comment)) - buf++; - } -} -/*}}}*/ - -static unsigned char *tokenize (unsigned char *buf, char *token, unsigned int len) -{ - register char *token_end; - - token_end = token + (len - 1); /* allow room for \0 */ - - while ((token < token_end) && (*buf > ' ')) - *token++ = *buf++; - - if (*buf > ' ') return NULL; /* token too long */ - - *token = '\0'; - - while ((*buf == ' ') || (*buf == '\t')) buf++; - - return buf; -} - -static int is_env_defined (char *buf, char comment) /*{{{*/ -{ - char * env, token [32]; - - if ((*buf <= ' ') || (*buf == comment)) return 0; /* no token */ - - if (NULL == (buf = (char *) tokenize ((unsigned char *) buf, - token, sizeof (token)))) - return 0; - - if (NULL == (env = getenv (token))) - return 0; /* ENV not defined */ - - if ((*buf == '\0') || (*buf == '\n') || (*buf == comment)) - return 1; /* no tokens, but getenv() worked */ - - do - { - buf = (char *) tokenize ((unsigned char *) buf, token, sizeof (token)); - if (buf == NULL) return 0; - - if (SLwildcard (token, env)) - return 1; - } - while (*buf && (*buf != '\n') && (*buf != comment)); - - return 0; -} -/*}}}*/ -/*}}}*/ - -int SLprep_line_ok (char *buf, SLPreprocess_Type *pt) /*{{{*/ -{ - int level, prev_exec_level, exec_level; - - if ((buf == NULL) || (pt == NULL)) return 1; - - if (*buf != pt->preprocess_char) - { - if (pt->this_level != pt->exec_level) - return 0; - - if (*buf == '\n') return pt->flags & SLPREP_BLANK_LINES_OK; - if (*buf == pt->comment_char) return pt->flags & SLPREP_COMMENT_LINES_OK; - - return 1; - } - - level = pt->this_level; - exec_level = pt->exec_level; - prev_exec_level = pt->prev_exec_level; - - buf++; - - /* Allow '#!' to pass. This could be a shell script with something - like '#! /local/bin/slang' */ - if ((*buf == '!') && (pt->preprocess_char == '#')) - return 0; - - /* Allow whitespace as in '# ifdef' */ - while ((*buf == ' ') || (*buf == '\t')) buf++; - if (*buf < 'a') return (level == exec_level); - - if (!strncmp(buf, "endif", 5)) - { - if (level == exec_level) - { - exec_level--; - prev_exec_level = exec_level; - } - level--; - if (level < prev_exec_level) prev_exec_level = level; - goto done; - } - - if ((buf[0] == 'e') && (buf[1] == 'l')) /* else, elifdef, ... */ - { - if ((level == exec_level + 1) - && (prev_exec_level != level)) - { - /* We are in position to execute */ - buf += 2; - if ((buf[0] == 's') && (buf[1] == 'e')) - { - /* "else" */ - exec_level = level; - goto done; - } - - /* drop through to ifdef testing. First set variable - * to values appropriate for ifdef testing. - */ - level--; /* now == to exec level */ - } - else - { - if (level == exec_level) - { - exec_level--; - } - goto done; - } - } - - if ((buf[0] == 'i') && (buf[1] == 'f')) - { - int truth; - - if (level != exec_level) - { - /* Not interested */ - level++; - goto done; - } - - level++; - - buf += 2; - if (buf[0] == 'n') - { - truth = 0; - buf++; - } - else truth = 1; - - if (!strncmp (buf, "def", 3)) - truth = (truth == is_any_defined(buf + 3, pt->comment_char)); - - else if (!strncmp (buf, "false", 5)) - truth = !truth; - - else if (*buf == '$') - truth = (truth == is_env_defined (buf + 1, pt->comment_char)); - - else if (!strncmp (buf, "exists", 6) - && (SLprep_exists_hook != NULL)) - truth = (truth == (*SLprep_exists_hook)(buf + 6, pt->comment_char)); - - else if (!strncmp (buf, "eval", 4) - && (_SLprep_eval_hook != NULL)) - truth = (truth == (*_SLprep_eval_hook) (buf + 4)); - - else if (0 != strncmp (buf, "true", 4)) - return 1; /* let it bomb */ - - if (truth) - { - exec_level = level; - prev_exec_level = exec_level; - } - } - else return 1; /* let it bomb. */ - - done: - - if (exec_level < 0) return 1; - - pt->this_level = level; - pt->exec_level = exec_level; - pt->prev_exec_level = prev_exec_level; - return 0; -} -/*}}}*/ - -/*{{{ main() - for testing only */ -#if 0 -int main () -{ - char buf[1024]; - SLPreprocess_Type pt; - - SLprep_open_prep (&pt); - - SLdefine_for_ifdef ("UNIX"); - - while (NULL != fgets (buf, sizeof (buf) - 1, stdin)) - { - if (SLprep_line_ok (buf, &pt)) - { - fputs (buf, stdout); - } - } - - SLprep_close_prep (&pt); - return 0; -} -#endif -/*}}}*/ diff --git a/mdk-stage1/slang/slproc.c b/mdk-stage1/slang/slproc.c deleted file mode 100644 index 8b266f28f..000000000 --- a/mdk-stage1/slang/slproc.c +++ /dev/null @@ -1,155 +0,0 @@ -/* Process specific system calls */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#ifdef HAVE_IO_H -# include <io.h> /* for chmod */ -#endif - -#ifdef HAVE_PROCESS_H -# include <process.h> /* for getpid */ -#endif - -#if defined(__BORLANDC__) -# include <dos.h> -#endif - -#include <sys/types.h> -#include <sys/stat.h> -#include <signal.h> -#include <time.h> - -#include <errno.h> - -#include "slang.h" -#include "_slang.h" - -#ifdef HAVE_KILL -static int kill_cmd (int *pid, int *sig) -{ - int ret; - - if (-1 == (ret = kill ((pid_t) *pid, *sig))) - _SLerrno_errno = errno; - return ret; -} -#endif - -static int getpid_cmd (void) -{ - return getpid (); -} - -#ifdef HAVE_GETPPID -static int getppid_cmd (void) -{ - return getppid (); -} -#endif - -#ifdef HAVE_GETGID -static int getgid_cmd (void) -{ - return getgid (); -} -#endif - -#ifdef HAVE_GETEGID -static int getegid_cmd (void) -{ - return getegid (); -} -#endif - -#ifdef HAVE_GETEUID -static int geteuid_cmd (void) -{ - return geteuid (); -} -#endif - -#ifdef HAVE_GETUID -static int getuid_cmd (void) -{ - return getuid (); -} -#endif - -#ifdef HAVE_SETGID -static int setgid_cmd (int *gid) -{ - if (0 == setgid (*gid)) - return 0; - _SLerrno_errno = errno; - return -1; -} -#endif - -#ifdef HAVE_SETPGID -static int setpgid_cmd (int *pid, int *pgid) -{ - if (0 == setpgid (*pid, *pgid)) - return 0; - _SLerrno_errno = errno; - return -1; -} -#endif - -#ifdef HAVE_SETUID -static int setuid_cmd (int *uid) -{ - if (0 == setuid (*uid)) - return 0; - _SLerrno_errno = errno; - return -1; -} -#endif - -static SLang_Intrin_Fun_Type Process_Name_Table[] = -{ - MAKE_INTRINSIC_0("getpid", getpid_cmd, SLANG_INT_TYPE), - -#ifdef HAVE_GETPPID - MAKE_INTRINSIC_0("getppid", getppid_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_GETGID - MAKE_INTRINSIC_0("getgid", getgid_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_GETEGID - MAKE_INTRINSIC_0("getegid", getegid_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_GETEUID - MAKE_INTRINSIC_0("geteuid", geteuid_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_GETUID - MAKE_INTRINSIC_0("getuid", getuid_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_SETGID - MAKE_INTRINSIC_I("setgid", setgid_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_SETPGID - MAKE_INTRINSIC_II("setpgid", setpgid_cmd, SLANG_INT_TYPE), -#endif -#ifdef HAVE_SETUID - MAKE_INTRINSIC_I("setuid", setuid_cmd, SLANG_INT_TYPE), -#endif - -#ifdef HAVE_KILL - MAKE_INTRINSIC_II("kill", kill_cmd, SLANG_INT_TYPE), -#endif - SLANG_END_INTRIN_FUN_TABLE -}; - -int SLang_init_posix_process (void) -{ - if ((-1 == SLadd_intrin_fun_table (Process_Name_Table, "__POSIX_PROCESS__")) - || (-1 == _SLerrno_init ())) - return -1; - return 0; -} diff --git a/mdk-stage1/slang/slregexp.c b/mdk-stage1/slang/slregexp.c deleted file mode 100644 index 6592a5a63..000000000 --- a/mdk-stage1/slang/slregexp.c +++ /dev/null @@ -1,935 +0,0 @@ -/* ed style regular expressions */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -#define SET_BIT(b, n) b[(unsigned int) (n) >> 3] |= 1 << ((unsigned int) (n) % 8) -#define TEST_BIT(b, n) (b[(unsigned int)(n) >> 3] & (1 << ((unsigned int) (n) % 8))) -#define LITERAL 1 -#define RANGE 2 /* [...] */ -#define ANY 3 /* . */ -#define BOL 4 /* ^ */ -#define EOL 5 /* $ */ -#define NTH_MATCH 6 /* \1 \2 ... \9 */ -#define OPAREN 7 /* \( */ -#define CPAREN 0x8 /* \) */ -#define ANY_DIGIT 0x9 /* \d */ -#define BOW 0xA /* \< */ -#define EOW 0xB /* \> */ -#if 0 -#define NOT_LITERAL 0xC /* \~ */ -#endif -#define STAR 0x80 /* * */ -#define LEAST_ONCE 0x40 /* + */ -#define MAYBE_ONCE 0x20 /* ? */ -#define MANY 0x10 /* {n,m} */ -/* The rest are additions */ -#define YES_CASE (STAR | BOL) -#define NO_CASE (STAR | EOL) - -#define UPPERCASE(x) (cs ? (x) : UPPER_CASE(x)) -#define LOWERCASE(x) (cs ? (x) : LOWER_CASE(x)) - -static unsigned char Word_Chars[256]; -#define IS_WORD_CHAR(x) Word_Chars[(unsigned int) (x)] - -#if 0 -static int ctx->open_paren_number; -static char Closed_Paren_Matches[10]; - -static SLRegexp_Type *This_Reg; -static unsigned char *This_Str; -#endif - -typedef struct -{ - SLRegexp_Type *reg; - unsigned char *str; - unsigned int len; - char closed_paren_matches[10]; - int open_paren_number; -} -Re_Context_Type; - -static unsigned char *do_nth_match (Re_Context_Type *ctx, int n, unsigned char *str, unsigned char *estr) -{ - unsigned char *bpos; - - if (ctx->closed_paren_matches[n] == 0) - return NULL; - - bpos = ctx->reg->beg_matches[n] + ctx->str; - n = ctx->reg->end_matches[n]; - if (n == 0) return(str); - if (n > (int) (estr - str)) return (NULL); - - /* This needs fixed for case sensitive match */ - if (0 != strncmp((char *) str, (char *) bpos, (unsigned int) n)) return (NULL); - str += n; - return (str); -} - -/* returns pointer to the end of regexp or NULL */ -static unsigned char *regexp_looking_at (Re_Context_Type *ctx, register unsigned char *str, unsigned char *estr, unsigned char *buf, register int cs) -{ - register unsigned char p, p1; - unsigned char *save_str, *tmpstr; - int n, n0, n1; - int save_num_open; - char save_closed_matches[10]; - - p = *buf++; - - while (p != 0) - { - /* p1 = UPPERCASE(*buf); */ - /* if (str < estr) c = UPPERCASE(*str); */ - - switch((unsigned char) p) - { - case BOW: - if ((str != ctx->str) - && ((str >= estr) - || IS_WORD_CHAR(*(str - 1)) - || (0 == IS_WORD_CHAR(*str)))) return NULL; - break; - - case EOW: - if ((str < estr) - && IS_WORD_CHAR (*str)) return NULL; - break; - - case YES_CASE: cs = 1; break; - case NO_CASE: cs = 0; break; - - case OPAREN: - ctx->open_paren_number++; - ctx->reg->beg_matches[ctx->open_paren_number] = (int) (str - ctx->str); - break; - case CPAREN: - n = ctx->open_paren_number; - while (n > 0) - { - if (ctx->closed_paren_matches[n] != 0) - { - n--; - continue; - } - ctx->closed_paren_matches[n] = 1; - ctx->reg->end_matches[n] = (unsigned int) (str - (ctx->str + ctx->reg->beg_matches[n])); - break; - } - break; -#ifdef NOT_LITERAL - case NOT_LITERAL: - if ((str >= estr) || (*buf == UPPERCASE(*str))) return (NULL); - str++; buf++; - break; - - case MAYBE_ONCE | NOT_LITERAL: - save_str = str; - if ((str < estr) && (*buf != UPPERCASE(*str))) str++; - buf++; - goto match_rest; - - case NOT_LITERAL | LEAST_ONCE: /* match at least once */ - if ((str >= estr) || (UPPERCASE(*str) == UPPERCASE(*buf))) return (NULL); - str++; - /* drop */ - case STAR | NOT_LITERAL: - save_str = str; p1 = *buf; - while ((str < estr) && (UPPERCASE(*str) != p1)) str++; - buf++; - goto match_rest; - - /* this type consists of the expression + two bytes that - determine number of matches to perform */ - case MANY | NOT_LITERAL: - p1 = *buf; buf++; - n = n0 = (int) (unsigned char) *buf++; - /* minimum number to match--- could be 0 */ - n1 = (int) (unsigned char) *buf++; - /* maximum number to match */ - - while (n && (str < estr) && (p1 != *str)) - { - n--; - str++; - } - if (n) return (NULL); - - save_str = str; - n = n1 - n0; - while (n && (str < estr) && (p1 != *str)) - { - n--; - str++; - } - goto match_rest; -#endif /* NOT_LITERAL */ - case LITERAL: - if ((str >= estr) || (*buf != UPPERCASE(*str))) return (NULL); - str++; buf++; - break; - - case MAYBE_ONCE | LITERAL: - save_str = str; - if ((str < estr) && (*buf == UPPERCASE(*str))) str++; - buf++; - goto match_rest; - - case LITERAL | LEAST_ONCE: /* match at least once */ - if ((str >= estr) || (UPPERCASE(*str) != UPPERCASE(*buf))) return (NULL); - str++; - /* drop */ - case STAR | LITERAL: - save_str = str; p1 = *buf; - while ((str < estr) && (UPPERCASE(*str) == p1)) str++; - buf++; - goto match_rest; - - /* this type consists of the expression + two bytes that - determine number of matches to perform */ - case MANY | LITERAL: - p1 = *buf; buf++; - n = n0 = (int) (unsigned char) *buf++; - /* minimum number to match--- could be 0 */ - n1 = (int) (unsigned char) *buf++; - /* maximum number to match */ - - while (n && (str < estr) && (p1 == *str)) - { - n--; - str++; - } - if (n) return (NULL); - - save_str = str; - n = n1 - n0; - while (n && (str < estr) && (p1 == *str)) - { - n--; - str++; - } - goto match_rest; - - case NTH_MATCH: - if ((str = do_nth_match(ctx, (int) (unsigned char) *buf, str, estr)) == NULL) return(NULL); - buf++; - break; - - case MAYBE_ONCE | NTH_MATCH: - save_str = str; - tmpstr = do_nth_match (ctx, (int) (unsigned char) *buf, str, estr); - buf++; - if (tmpstr != NULL) - { - str = tmpstr; - goto match_rest; - } - continue; - - case LEAST_ONCE | NTH_MATCH: - if ((str = do_nth_match(ctx, (int) (unsigned char) *buf, str, estr)) == NULL) return(NULL); - /* drop */ - case STAR | NTH_MATCH: - save_str = str; - while (NULL != (tmpstr = do_nth_match(ctx, (int) (unsigned char) *buf, str, estr))) - { - str = tmpstr; - } - buf++; - goto match_rest; - - case MANY | NTH_MATCH: return(NULL); - /* needs done */ - - case RANGE: - if (str >= estr) return (NULL); - if (TEST_BIT(buf, UPPERCASE(*str)) == 0) return (NULL); - buf += 32; str++; - break; - - case MAYBE_ONCE | RANGE: - save_str = str; - if ((str < estr) && TEST_BIT(buf, UPPERCASE(*str))) str++; - buf += 32; - goto match_rest; - - case LEAST_ONCE | RANGE: - if ((str >= estr) || (0 == TEST_BIT(buf, UPPERCASE(*str)))) return NULL; - str++; - /* drop */ - case STAR | RANGE: - save_str = str; - while ((str < estr) && TEST_BIT(buf, UPPERCASE(*str))) str++; - buf += 32; - goto match_rest; - - /* The first 32 bytes correspond to the range and the two - * following bytes indicate the min and max number of matches. - */ - case MANY | RANGE: - /* minimum number to match--- could be 0 */ - n = n0 = (int) (unsigned char) *(buf + 32); - /* maximum number to match */ - n1 = (int) (unsigned char) *(buf + 33); - - while (n && (str < estr) && (TEST_BIT(buf, UPPERCASE(*str)))) - { - n--; - str++; - } - if (n) return (NULL); - save_str = str; - n = n1 - n0; - while (n && (str < estr) && (TEST_BIT(buf, UPPERCASE(*str)))) - { - n--; - str++; - } - buf += 34; /* 32 + 2 */ - goto match_rest; - - case ANY_DIGIT: - if ((str >= estr) || (*str > '9') || (*str < '0')) return (NULL); - str++; - break; - - case MAYBE_ONCE | ANY_DIGIT: - save_str = str; - if ((str < estr) && ((*str > '9') || (*str < '0'))) str++; - goto match_rest; - - case LEAST_ONCE | ANY_DIGIT: - if ((str >= estr) || ((*str > '9') || (*str < '0'))) return NULL; - str++; - /* drop */ - case STAR | ANY_DIGIT: - save_str = str; - while ((str < estr) && ((*str <= '9') && (*str >= '0'))) str++; - goto match_rest; - - case MANY | ANY_DIGIT: - /* needs finished */ - return (NULL); - - case ANY: - if ((str >= estr) || (*str == '\n')) return (NULL); - str++; - break; - - case MAYBE_ONCE | ANY: - save_str = str; - if ((str < estr) && (*str != '\n')) str++; - goto match_rest; - - case LEAST_ONCE | ANY: - if ((str >= estr) || (*str == '\n')) return (NULL); - str++; - /* drop */ - case STAR | ANY: - save_str = str; - while ((str < estr) && (*str != '\n')) str++; - goto match_rest; - - case MANY | ANY: - return (NULL); - /* needs finished */ - - case EOL: - if ((str >= estr) || (*str == '\n')) return (str); - return(NULL); - - default: return (NULL); - } - p = *buf++; - continue; - - match_rest: - if (save_str == str) - { - p = *buf++; - continue; - } - - /* if (p == EOL) - * { - * if (str < estr) return (NULL); else return (str); - * } - */ - - SLMEMCPY(save_closed_matches, ctx->closed_paren_matches, sizeof(save_closed_matches)); - save_num_open = ctx->open_paren_number; - while (str >= save_str) - { - tmpstr = regexp_looking_at (ctx, str, estr, buf, cs); - if (tmpstr != NULL) return(tmpstr); - SLMEMCPY(ctx->closed_paren_matches, save_closed_matches, sizeof(ctx->closed_paren_matches)); - ctx->open_paren_number = save_num_open; - str--; - } - return NULL; - } - if ((p != 0) && (p != EOL)) return (NULL); else return (str); -} - -static void -fixup_beg_end_matches (Re_Context_Type *ctx, SLRegexp_Type *r, unsigned char *str, unsigned char *epos) -{ - int i; - - if (str == NULL) - { - r->beg_matches[0] = -1; - r->end_matches[0] = 0; - SLMEMSET(ctx->closed_paren_matches, 0, sizeof(ctx->closed_paren_matches)); - } - else - { - r->beg_matches[0] = (int) (str - ctx->str); - r->end_matches[0] = (unsigned int) (epos - str); - } - - for (i = 1; i < 10; i++) - { - if (ctx->closed_paren_matches [i] == 0) - { - r->beg_matches[i] = -1; - r->end_matches[i] = 0; - } - } -} - -static void init_re_context (Re_Context_Type *ctx, SLRegexp_Type *reg, - unsigned char *str, unsigned int len) -{ - memset ((char *) ctx, 0, sizeof (Re_Context_Type)); - ctx->reg = reg; - ctx->str = str; - ctx->len = len; -} - -unsigned char *SLang_regexp_match(unsigned char *str, - unsigned int len, SLRegexp_Type *reg) -{ - register unsigned char c = 0, *estr = str + len; - int cs = reg->case_sensitive, lit = 0; - unsigned char *buf = reg->buf, *epos = NULL; - Re_Context_Type ctx_buf; - - if (reg->min_length > len) return NULL; - - init_re_context (&ctx_buf, reg, str, len); - - if (*buf == BOL) - { - if (NULL == (epos = regexp_looking_at (&ctx_buf, str, estr, buf + 1, cs))) - str = NULL; - - fixup_beg_end_matches (&ctx_buf, reg, str, epos); - return str; - } - - if (*buf == NO_CASE) - { - buf++; cs = 0; - } - - if (*buf == YES_CASE) - { - buf++; cs = 1; - } - - if (*buf == LITERAL) - { - lit = 1; - c = *(buf + 1); - } - else if ((*buf == OPAREN) && (*(buf + 1) == LITERAL)) - { - lit = 1; - c = *(buf + 2); - } - - while (str < estr) - { - ctx_buf.open_paren_number = 0; - memset (ctx_buf.closed_paren_matches, 0, sizeof(ctx_buf.closed_paren_matches)); - /* take care of leading chars */ - if (lit) - { - while ((str < estr) && (c != UPPERCASE(*str))) str++; - if (str >= estr) - break; /* failed */ - } - - if (NULL != (epos = regexp_looking_at(&ctx_buf, str, estr, buf, cs))) - { - fixup_beg_end_matches (&ctx_buf, reg, str, epos); - return str; - } - str++; - } - fixup_beg_end_matches (&ctx_buf, reg, NULL, epos); - return NULL; -} - -static unsigned char *convert_digit(unsigned char *pat, int *nn) -{ - int n = 0, m = 0; - unsigned char c; - while (c = (unsigned char) *pat, (c <= '9') && (c >= '0')) - { - pat++; - n = 10 * n + (c - '0'); - m++; - } - if (m == 0) - { - return (NULL); - } - *nn = n; - return pat; -} - -#define ERROR return (int) (pat - reg->pat) - -/* Returns 0 if successful or offset in pattern of error */ -int SLang_regexp_compile (SLRegexp_Type *reg) -{ - register unsigned char *buf, *ebuf, *pat; - unsigned char *last = NULL, *tmppat; - register unsigned char c; - int i, reverse = 0, n, cs; - int oparen = 0, nparen = 0; - /* substring stuff */ - int count, last_count, this_max_mm = 0, max_mm = 0, ordinary_search, - no_osearch = 0, min_length = 0; - unsigned char *mm_p = NULL, *this_mm_p = NULL; - static int already_initialized; - - reg->beg_matches[0] = reg->end_matches[0] = 0; - buf = reg->buf; - ebuf = (reg->buf + reg->buf_len) - 2; /* make some room */ - pat = reg->pat; - cs = reg->case_sensitive; - - if (already_initialized == 0) - { - SLang_init_case_tables (); -#ifdef IBMPC_SYSTEM - SLmake_lut (Word_Chars, (unsigned char *) "_0-9a-zA-Z\200-\232\240-\245\341-\353", 0); -#else - SLmake_lut (Word_Chars, (unsigned char *) "_0-9a-zA-Z\277-\326\330-\336\340-\366\370-\376", 0); -#endif - already_initialized = 1; - } - - i = 1; while (i < 10) - { - reg->beg_matches[i] = -1; - reg->end_matches[i] = 0; - i++; - } - - if (*pat == '\\') - { - if (pat[1] == 'c') - { - cs = 1; - pat += 2; - no_osearch = 1; - } - else if (pat[1] == 'C') - { - cs = 0; - pat += 2; - no_osearch = 1; - } - } - - if (*pat == '^') - { - pat++; - *buf++ = BOL; - reg->must_match_bol = 1; - } - else reg->must_match_bol = 0; - - if (cs != reg->case_sensitive) - { - if (cs) *buf++ = YES_CASE; - else *buf++ = NO_CASE; - } - - *buf = 0; - - last_count = count = 0; - while ((c = *pat++) != 0) - { - if (buf >= ebuf - 3) - { - SLang_doerror ("Pattern too large to be compiled."); - ERROR; - } - - count++; - switch (c) - { - case '$': - if (*pat != 0) goto literal_char; - *buf++ = EOL; - break; - - case '\\': - c = *pat++; - no_osearch = 1; - switch(c) - { - case 'e': c = 033; goto literal_char; - case 'n': c = '\n'; goto literal_char; - case 't': c = '\t'; goto literal_char; - case 'C': cs = 0; *buf++ = NO_CASE; break; - case 'c': cs = 1; *buf++ = YES_CASE; break; - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - c = c - '0'; - if ((int) c > nparen) ERROR; - last = buf; - *buf++ = NTH_MATCH; *buf++ = c; - break; -#ifdef NOT_LITERAL - case '~': /* slang extension */ - if ((c = *pat) == 0) ERROR; - pat++; - last = buf; - *buf++ = NOT_LITERAL; - *buf++ = c; - min_length++; - break; -#endif - case 'd': /* slang extension */ - last = buf; - *buf++ = ANY_DIGIT; - min_length++; - break; - - case '<': - last = NULL; - *buf++ = BOW; - break; - - case '>': - last = NULL; - *buf++ = EOW; - break; - - case '{': - if (last == NULL) goto literal_char; - *last |= MANY; - tmppat = convert_digit(pat, &n); - if (tmppat == NULL) ERROR; - pat = tmppat; - *buf++ = n; - - min_length += (n - 1); - - if (*pat == '\\') - { - *buf++ = n; - } - else if (*pat == ',') - { - pat++; - if (*pat == '\\') - { - n = 255; - } - else - { - tmppat = convert_digit(pat, &n); - if (tmppat == NULL) ERROR; - pat = tmppat; - if (*pat != '\\') ERROR; - } - *buf++ = n; - } - else ERROR; - last = NULL; - pat++; - if (*pat != '}') ERROR; - pat++; - break; /* case '{' */ - - case '(': - oparen++; - if (oparen > 9) ERROR; - *buf++ = OPAREN; - break; - case ')': - if (oparen == 0) ERROR; - oparen--; - nparen++; - *buf++ = CPAREN; - break; - - case 0: ERROR; - default: - goto literal_char; - } - break; - - case '[': - - *buf = RANGE; - last = buf++; - - if (buf + 32 >= ebuf) ERROR; - - for (i = 0; i < 32; i++) buf[i] = 0; - c = *pat++; - if (c == '^') - { - reverse = 1; - SET_BIT(buf, '\n'); - c = *pat++; - } - - if (c == ']') - { - SET_BIT(buf, c); - c = *pat++; - } - while (c && (c != ']')) - { - if (c == '\\') - { - c = *pat++; - switch(c) - { - case 'n': c = '\n'; break; - case 't': c = '\t'; break; - case 0: ERROR; - } - } - - if (*pat == '-') - { - pat++; - while (c < *pat) - { - if (cs == 0) - { - SET_BIT(buf, UPPERCASE(c)); - SET_BIT(buf, LOWERCASE(c)); - } - else SET_BIT(buf, c); - c++; - } - } - if (cs == 0) - { - SET_BIT(buf, UPPERCASE(c)); - SET_BIT(buf, LOWERCASE(c)); - } - else SET_BIT(buf, c); - c = *pat++; - } - if (c != ']') ERROR; - if (reverse) for (i = 0; i < 32; i++) buf[i] = buf[i] ^ 0xFF; - reverse = 0; - buf += 32; - min_length++; - break; - - case '.': - last = buf; - *buf++ = ANY; - min_length++; - break; - - case '*': - if (last == NULL) goto literal_char; - *last |= STAR; - min_length--; - last = NULL; - break; - - case '+': - if (last == NULL) goto literal_char; - *last |= LEAST_ONCE; - last = NULL; - break; - - case '?': - if (last == NULL) goto literal_char; - *last |= MAYBE_ONCE; - last = NULL; - min_length--; - break; - - literal_char: - default: - /* This is to keep track of longest substring */ - min_length++; - this_max_mm++; - if (last_count + 1 == count) - { - if (this_max_mm == 1) - { - this_mm_p = buf; - } - else if (max_mm < this_max_mm) - { - mm_p = this_mm_p; - max_mm = this_max_mm; - } - } - else - { - this_mm_p = buf; - this_max_mm = 1; - } - - last_count = count; - - last = buf; - *buf++ = LITERAL; - *buf++ = UPPERCASE(c); - } - } - *buf = 0; - /* Check for ordinary search */ - ebuf = buf; - buf = reg->buf; - - if (no_osearch) ordinary_search = 0; - else - { - ordinary_search = 1; - while (buf < ebuf) - { - if (*buf != LITERAL) - { - ordinary_search = 0; - break; - } - buf += 2; - } - } - - reg->osearch = ordinary_search; - reg->must_match_str[15] = 0; - reg->min_length = (min_length > 0) ? (unsigned int) min_length : 0; - if (ordinary_search) - { - strncpy((char *) reg->must_match_str, (char *) reg->pat, 15); - reg->must_match = 1; - return(0); - } - /* check for longest substring of pattern */ - reg->must_match = 0; - if ((mm_p == NULL) && (this_mm_p != NULL)) mm_p = this_mm_p; - if (mm_p == NULL) - { - return (0); - } - n = 15; - pat = reg->must_match_str; - buf = mm_p; - while (n--) - { - if (*buf++ != LITERAL) break; - *pat++ = *buf++; - } - *pat = 0; - if (pat != reg->must_match_str) reg->must_match = 1; - return(0); -} - -char *SLregexp_quote_string (char *re, char *buf, unsigned int buflen) -{ - char ch; - char *b, *bmax; - - if (re == NULL) return NULL; - - b = buf; - bmax = buf + buflen; - - while (b < bmax) - { - switch (ch = *re++) - { - case 0: - *b = 0; - return buf; - - case '$': - case '\\': - case '[': - case ']': - case '.': - case '^': - case '*': - case '+': - case '?': - *b++ = '\\'; - if (b == bmax) break; - /* drop */ - - default: - *b++ = ch; - } - } - return NULL; -} - -#if 0 -#define MAX_EXP 4096 -int main(int argc, char **argv) -{ - FILE *fp; - char *regexp, *file; - char expbuf[MAX_EXP], buf[512]; - SLRegexp_Type reg; - - file = argv[2]; - regexp = argv[1]; - - if (NULL == (fp = fopen(file, "r"))) - { - fprintf(stderr, "File not open\n"); - return(1); - } - - reg.buf = expbuf; - reg.buf_len = MAX_EXP; - reg.pat = regexp; - reg.case_sensitive = 1; - - if (!regexp_compile(®)) while (NULL != fgets(buf, 511, fp)) - { - if (reg.osearch) - { - if (NULL == strstr(buf, reg.pat)) continue; - } - else - { - if (reg.must_match && (NULL == strstr(buf, reg.must_match_str))) continue; - if (0 == regexp_match(buf, buf + strlen(buf), ®)) continue; - } - - fputs(buf, stdout); - } - return (0); -} -#endif diff --git a/mdk-stage1/slang/slrline.c b/mdk-stage1/slang/slrline.c deleted file mode 100644 index 1874be0bb..000000000 --- a/mdk-stage1/slang/slrline.c +++ /dev/null @@ -1,836 +0,0 @@ -/* SLang_read_line interface --- uses SLang tty stuff */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -#ifdef REAL_UNIX_SYSTEM -int SLang_RL_EOF_Char = 4; -#else -int SLang_RL_EOF_Char = 26; -#endif - -int SLang_Rline_Quit; -static SLang_RLine_Info_Type *This_RLI; - -static unsigned char Char_Widths[256]; -static void position_cursor (int); - -static void rl_beep (void) -{ - putc(7, stdout); - fflush (stdout); -} - -/* editing functions */ -static int rl_bol (void) -{ - if (This_RLI->point == 0) return 0; - This_RLI->point = 0; - return 1; -} - -static int rl_eol (void) -{ - if (This_RLI->point == This_RLI->len) return 0; - This_RLI->point = This_RLI->len; - return 1; -} - -static int rl_right (void) -{ - if (This_RLI->point == This_RLI->len) return 0; - This_RLI->point++; - return 1; -} - -static int rl_left (void) -{ - if (This_RLI->point == 0) return 0; - This_RLI->point--; - return 1; -} - -static int rl_self_insert (void) -{ - unsigned char *pmin, *p; - - if (This_RLI->len == This_RLI->buf_len) - { - rl_beep (); - return 0; - } - - pmin = This_RLI->buf + This_RLI->point; - p = This_RLI->buf + This_RLI->len; - while (p > pmin) - { - *p = *(p - 1); - p--; - } - *pmin = SLang_Last_Key_Char; - - This_RLI->len++; - This_RLI->point++; - if ((This_RLI->curs_pos + 2 >= This_RLI->edit_width) - || (This_RLI->tt_insert == NULL) - || (Char_Widths[SLang_Last_Key_Char] != 1)) return 1; - - (*This_RLI->tt_insert)((char) SLang_Last_Key_Char); - /* update screen buf */ - p = This_RLI->old_upd + (This_RLI->len - 1); - pmin = This_RLI->old_upd + (This_RLI->point - 1); - while (p > pmin) - { - *p = *(p - 1); - p--; - } - *pmin = SLang_Last_Key_Char; - return 0; -} - -int SLang_rline_insert (char *s) -{ - unsigned char *pmin, *p; - int n; - - n = strlen (s); - if (n > This_RLI->buf_len - This_RLI->len) - n = This_RLI->buf_len - This_RLI->len; - - if (n == 0) return 0; - - pmin = This_RLI->buf + This_RLI->point; - p = This_RLI->buf + (This_RLI->len - 1); - - while (p >= pmin) - { - *(p + n) = *p; - p--; - } - SLMEMCPY ((char *) pmin, s, n); - - This_RLI->len += n; - This_RLI->point += n; - return n; -} - -static int rl_deln (int n) -{ - unsigned char *pmax, *p; - - p = This_RLI->buf + This_RLI->point; - pmax = This_RLI->buf + This_RLI->len; - - if (p + n > pmax) n = (int) (pmax - p); - while (p < pmax) - { - *p = *(p + n); - p++; - } - This_RLI->len -= n; - return n; -} - -static int rl_del (void) -{ - return rl_deln(1); -} - -static int rl_quote_insert (void) -{ - int err = SLang_Error; - SLang_Error = 0; - SLang_Last_Key_Char = (*This_RLI->getkey)(); - rl_self_insert (); - if (SLang_Error == SL_USER_BREAK) SLang_Error = 0; - else SLang_Error = err; - return 1; -} - -static int rl_trim (void) -{ - unsigned char *p, *pmax, *p1; - p = This_RLI->buf + This_RLI->point; - pmax = This_RLI->buf + This_RLI->len; - - if (p == pmax) - { - if (p == This_RLI->buf) return 0; - p--; - } - - if ((*p != ' ') && (*p != '\t')) return 0; - p1 = p; - while ((p1 < pmax) && ((*p1 == ' ') || (*p1 == '\t'))) p1++; - pmax = p1; - p1 = This_RLI->buf; - - while ((p >= p1) && ((*p == ' ') || (*p == '\t'))) p--; - if (p == pmax) return 0; - p++; - - This_RLI->point = (int) (p - p1); - return rl_deln ((int) (pmax - p)); -} - -static int rl_bdel (void) -{ - if (rl_left()) return rl_del(); - return 0; -} - -static int rl_deleol (void) -{ - if (This_RLI->point == This_RLI->len) return 0; - *(This_RLI->buf + This_RLI->point) = 0; - This_RLI->len = This_RLI->point; - return 1; -} - -static int rl_delete_line (void) -{ - This_RLI->point = 0; - *(This_RLI->buf + This_RLI->point) = 0; - This_RLI->len = 0; - return 1; -} - -static int rl_enter (void) -{ - *(This_RLI->buf + This_RLI->len) = 0; - SLang_Rline_Quit = 1; - return 1; -} - -static SLKeyMap_List_Type *RL_Keymap; - -/* This update is designed for dumb terminals. It assumes only that the - * terminal can backspace via ^H, and move cursor to start of line via ^M. - * There is a hook so the user can provide a more sophisticated update if - * necessary. - */ - -static void position_cursor (int col) -{ - unsigned char *p, *pmax; - int dc; - - if (col == This_RLI->curs_pos) - { - fflush (stdout); - return; - } - - if (This_RLI->tt_goto_column != NULL) - { - (*This_RLI->tt_goto_column)(col); - This_RLI->curs_pos = col; - fflush (stdout); - return; - } - - dc = This_RLI->curs_pos - col; - if (dc < 0) - { - p = This_RLI->new_upd + This_RLI->curs_pos; - pmax = This_RLI->new_upd + col; - while (p < pmax) putc((char) *p++, stdout); - } - else - { - if (dc < col) - { - while (dc--) putc(8, stdout); - } - else - { - putc('\r', stdout); - p = This_RLI->new_upd; - pmax = This_RLI->new_upd + col; - while (p < pmax) putc((char) *p++, stdout); - } - } - This_RLI->curs_pos = col; - fflush (stdout); -} - -static void erase_eol (SLang_RLine_Info_Type *rli) -{ - unsigned char *p, *pmax; - - p = rli->old_upd + rli->curs_pos; - pmax = rli->old_upd + rli->old_upd_len; - - while (p++ < pmax) putc(' ', stdout); - - rli->curs_pos = rli->old_upd_len; -} - -static unsigned char *spit_out(SLang_RLine_Info_Type *rli, unsigned char *p) -{ - unsigned char *pmax; - position_cursor ((int) (p - rli->new_upd)); - pmax = rli->new_upd + rli->new_upd_len; - while (p < pmax) putc((char) *p++, stdout); - rli->curs_pos = rli->new_upd_len; - return pmax; -} - -static void really_update (SLang_RLine_Info_Type *rli, int new_curs_position) -{ - unsigned char *b = rli->old_upd, *p = rli->new_upd, chb, chp; - unsigned char *pmax; - - if (rli->update_hook != NULL) - { - (*rli->update_hook)(p, rli->edit_width, new_curs_position); - } - else - { - pmax = p + rli->edit_width; - while (p < pmax) - { - chb = *b++; chp = *p++; - if (chb == chp) continue; - - if (rli->old_upd_len <= rli->new_upd_len) - { - /* easy one */ - (void) spit_out (rli, p - 1); - break; - } - spit_out(rli, p - 1); - erase_eol (rli); - break; - } - position_cursor (new_curs_position); - } - - /* update finished, so swap */ - - rli->old_upd_len = rli->new_upd_len; - p = rli->old_upd; - rli->old_upd = rli->new_upd; - rli->new_upd = p; -} - -static void RLupdate (SLang_RLine_Info_Type *rli) -{ - int len, dlen, start_len = 0, prompt_len = 0, tw = 0, count; - int want_cursor_pos; - unsigned char *b, chb, *b_point, *p; - int no_echo; - - no_echo = rli->flags & SL_RLINE_NO_ECHO; - - b_point = (unsigned char *) (rli->buf + rli->point); - *(rli->buf + rli->len) = 0; - - /* expand characters for output buffer --- handle prompt first. - * Do two passes --- first to find out where to begin upon horiz - * scroll and the second to actually fill the buffer. */ - len = 0; - count = 2; /* once for prompt and once for buf */ - - b = (unsigned char *) rli->prompt; - while (count--) - { - if ((count == 0) && no_echo) - break; - - /* The prompt could be NULL */ - if (b != NULL) while ((chb = *b) != 0) - { - /* This will ensure that the screen is scrolled a third of the edit - * width each time */ - if (b_point == b) break; - dlen = Char_Widths[chb]; - if ((chb == '\t') && tw) - { - dlen = tw * ((len - prompt_len) / tw + 1) - (len - prompt_len); - } - len += dlen; - b++; - } - tw = rli->tab; - b = (unsigned char *) rli->buf; - if (count == 1) want_cursor_pos = prompt_len = len; - } - - if (len < rli->edit_width - rli->dhscroll) start_len = 0; - else if ((rli->start_column > len) - || (rli->start_column + rli->edit_width <= len)) - { - start_len = len - (rli->edit_width - rli->dhscroll); - if (start_len < 0) start_len = 0; - } - else start_len = rli->start_column; - rli->start_column = start_len; - - want_cursor_pos = len - start_len; - - /* second pass */ - p = rli->new_upd; - - len = 0; - count = 2; - b = (unsigned char *) rli->prompt; - if (b == NULL) b = (unsigned char *) ""; - - while ((len < start_len) && (*b)) - { - len += Char_Widths[*b++]; - } - - tw = 0; - if (*b == 0) - { - b = (unsigned char *) rli->buf; - while (len < start_len) - { - len += Char_Widths[*b++]; - } - tw = rli->tab; - count--; - } - - len = 0; - while (count--) - { - if ((count == 0) && (no_echo)) - break; - - while ((len < rli->edit_width) && ((chb = *b++) != 0)) - { - dlen = Char_Widths[chb]; - if (dlen == 1) *p++ = chb; - else - { - if ((chb == '\t') && tw) - { - dlen = tw * ((len + start_len - prompt_len) / tw + 1) - (len + start_len - prompt_len); - len += dlen; /* ok since dlen comes out 0 */ - if (len > rli->edit_width) dlen = len - rli->edit_width; - while (dlen--) *p++ = ' '; - dlen = 0; - } - else - { - if (dlen == 3) - { - chb &= 0x7F; - *p++ = '~'; - } - - *p++ = '^'; - if (chb == 127) *p++ = '?'; - else *p++ = chb + '@'; - } - } - len += dlen; - } - /* if (start_len > prompt_len) break; */ - tw = rli->tab; - b = (unsigned char *) rli->buf; - } - - rli->new_upd_len = (int) (p - rli->new_upd); - while (p < rli->new_upd + rli->edit_width) *p++ = ' '; - really_update (rli, want_cursor_pos); -} - -void SLrline_redraw (SLang_RLine_Info_Type *rli) -{ - unsigned char *p = rli->new_upd; - unsigned char *pmax = p + rli->edit_width; - while (p < pmax) *p++ = ' '; - rli->new_upd_len = rli->edit_width; - really_update (rli, 0); - RLupdate (rli); -} - -static int rl_eof_insert (void) -{ - if (This_RLI->len == 0) - { - SLang_Last_Key_Char = SLang_RL_EOF_Char; - /* rl_self_insert (); */ - return rl_enter (); - } - return 0; -} - -/* This is very naive. It knows very little about nesting and nothing - * about quoting. - */ -static void blink_match (SLang_RLine_Info_Type *rli) -{ - unsigned char bra, ket; - unsigned int delta_column; - unsigned char *p, *pmin; - int dq_level, sq_level; - int level; - - pmin = rli->buf; - p = pmin + rli->point; - if (pmin == p) - return; - - ket = SLang_Last_Key_Char; - switch (ket) - { - case ')': - bra = '('; - break; - case ']': - bra = '['; - break; - case '}': - bra = '{'; - break; - default: - return; - } - - level = 0; - sq_level = dq_level = 0; - - delta_column = 0; - while (p > pmin) - { - char ch; - - p--; - delta_column++; - ch = *p; - - if (ch == ket) - { - if ((dq_level == 0) && (sq_level == 0)) - level++; - } - else if (ch == bra) - { - if ((dq_level != 0) || (sq_level != 0)) - continue; - - level--; - if (level == 0) - { - rli->point -= delta_column; - RLupdate (rli); - (*rli->input_pending)(10); - rli->point += delta_column; - RLupdate (rli); - break; - } - if (level < 0) - break; - } - else if (ch == '"') dq_level = !dq_level; - else if (ch == '\'') sq_level = !sq_level; - } -} - -int SLang_read_line (SLang_RLine_Info_Type *rli) -{ - unsigned char *p, *pmax; - SLang_Key_Type *key; - - SLang_Rline_Quit = 0; - This_RLI = rli; - p = rli->old_upd; pmax = p + rli->edit_width; - while (p < pmax) *p++ = ' '; - - /* Sanity checking */ - rli->len = strlen ((char *) rli->buf); - if (rli->len >= rli->buf_len) - { - rli->len = 0; - *rli->buf = 0; - } - if (rli->point > rli->len) rli->point = rli->len; - if (rli->point < 0) rli->point = 0; - - rli->curs_pos = rli->start_column = 0; - rli->new_upd_len = rli->old_upd_len = 0; - - This_RLI->last_fun = NULL; - if (rli->update_hook == NULL) - putc ('\r', stdout); - - RLupdate (rli); - - while (1) - { - key = SLang_do_key (RL_Keymap, (int (*)(void)) rli->getkey); - - if ((key == NULL) || (key->f.f == NULL)) - rl_beep (); - else - { - if ((SLang_Last_Key_Char == SLang_RL_EOF_Char) - && (*key->str == 2) - && (This_RLI->len == 0)) - rl_eof_insert (); - else if (key->type == SLKEY_F_INTRINSIC) - { - if ((key->f.f)()) - RLupdate (rli); - - if ((rli->flags & SL_RLINE_BLINK_MATCH) - && (rli->input_pending != NULL)) - blink_match (rli); - } - - if (SLang_Rline_Quit) - { - This_RLI->buf[This_RLI->len] = 0; - if (SLang_Error == SL_USER_BREAK) - { - SLang_Error = 0; - return -1; - } - return This_RLI->len; - } - } - if (key != NULL) - This_RLI->last_fun = key->f.f; - } -} - -static int rl_abort (void) -{ - rl_delete_line (); - return rl_enter (); -} - -/* TTY interface --- ANSI */ - -static void ansi_goto_column (int n) -{ - putc('\r', stdout); - if (n) fprintf(stdout, "\033[%dC", n); -} - -static void rl_select_line (SLang_Read_Line_Type *p) -{ - This_RLI->last = p; - strcpy ((char *) This_RLI->buf, (char *) p->buf); - This_RLI->point = This_RLI->len = strlen((char *) p->buf); -} -static int rl_next_line (void); -static int rl_prev_line (void) -{ - SLang_Read_Line_Type *prev; - - if (((This_RLI->last_fun != (FVOID_STAR) rl_prev_line) - && (This_RLI->last_fun != (FVOID_STAR) rl_next_line)) - || (This_RLI->last == NULL)) - { - prev = This_RLI->tail; - } - else prev = This_RLI->last->prev; - - if (prev == NULL) - { - rl_beep (); - return 0; - } - - rl_select_line (prev); - return 1; -} -static int rl_redraw (void) -{ - SLrline_redraw (This_RLI); - return 1; -} - -static int rl_next_line (void) -{ - SLang_Read_Line_Type *next; - - if (((This_RLI->last_fun != (FVOID_STAR) rl_prev_line) - && (This_RLI->last_fun != (FVOID_STAR) rl_next_line)) - || (This_RLI->last == NULL)) - { - rl_beep (); - return 0; - } - - next = This_RLI->last->next; - - if (next == NULL) - { - This_RLI->len = This_RLI->point = 0; - *This_RLI->buf = 0; - This_RLI->last = NULL; - } - else rl_select_line (next); - return 1; -} - -static SLKeymap_Function_Type SLReadLine_Functions[] = -{ - {"up", rl_prev_line}, - {"down", rl_next_line}, - {"bol", rl_bol}, - {"eol", rl_eol}, - {"right", rl_right}, - {"left", rl_left}, - {"self_insert", rl_self_insert}, - {"bdel", rl_bdel}, - {"del", rl_del}, - {"deleol", rl_deleol}, - {"enter", rl_enter}, - {"trim", rl_trim}, - {"quoted_insert", rl_quote_insert}, - {(char *) NULL, NULL} -}; - -int SLang_init_readline (SLang_RLine_Info_Type *rli) -{ - int ch; - char simple[2]; - - if (RL_Keymap == NULL) - { - simple[1] = 0; - if (NULL == (RL_Keymap = SLang_create_keymap ("ReadLine", NULL))) - return -1; - - RL_Keymap->functions = SLReadLine_Functions; - - /* This breaks under some DEC ALPHA compilers (scary!) */ -#ifndef __DECC - for (ch = ' '; ch < 256; ch++) - { - simple[0] = (char) ch; - SLkm_define_key (simple, (FVOID_STAR) rl_self_insert, RL_Keymap); - } -#else - ch = ' '; - while (1) - { - simple[0] = (char) ch; - SLkm_define_key (simple, (FVOID_STAR) rl_self_insert, RL_Keymap); - ch = ch + 1; - if (ch == 256) break; - } -#endif /* NOT __DECC */ - - simple[0] = SLang_Abort_Char; - SLkm_define_key (simple, (FVOID_STAR) rl_abort, RL_Keymap); - simple[0] = SLang_RL_EOF_Char; - SLkm_define_key (simple, (FVOID_STAR) rl_eof_insert, RL_Keymap); - -#ifndef IBMPC_SYSTEM - SLkm_define_key ("^[[A", (FVOID_STAR) rl_prev_line, RL_Keymap); - SLkm_define_key ("^[[B", (FVOID_STAR) rl_next_line, RL_Keymap); - SLkm_define_key ("^[[C", (FVOID_STAR) rl_right, RL_Keymap); - SLkm_define_key ("^[[D", (FVOID_STAR) rl_left, RL_Keymap); - SLkm_define_key ("^[OA", (FVOID_STAR) rl_prev_line, RL_Keymap); - SLkm_define_key ("^[OB", (FVOID_STAR) rl_next_line, RL_Keymap); - SLkm_define_key ("^[OC", (FVOID_STAR) rl_right, RL_Keymap); - SLkm_define_key ("^[OD", (FVOID_STAR) rl_left, RL_Keymap); -#else - SLkm_define_key ("^@H", (FVOID_STAR) rl_prev_line, RL_Keymap); - SLkm_define_key ("^@P", (FVOID_STAR) rl_next_line, RL_Keymap); - SLkm_define_key ("^@M", (FVOID_STAR) rl_right, RL_Keymap); - SLkm_define_key ("^@K", (FVOID_STAR) rl_left, RL_Keymap); - SLkm_define_key ("^@S", (FVOID_STAR) rl_del, RL_Keymap); - SLkm_define_key ("^@O", (FVOID_STAR) rl_eol, RL_Keymap); - SLkm_define_key ("^@G", (FVOID_STAR) rl_bol, RL_Keymap); - - SLkm_define_key ("\xE0H", (FVOID_STAR) rl_prev_line, RL_Keymap); - SLkm_define_key ("\xE0P", (FVOID_STAR) rl_next_line, RL_Keymap); - SLkm_define_key ("\xE0M", (FVOID_STAR) rl_right, RL_Keymap); - SLkm_define_key ("\xE0K", (FVOID_STAR) rl_left, RL_Keymap); - SLkm_define_key ("\xE0S", (FVOID_STAR) rl_del, RL_Keymap); - SLkm_define_key ("\xE0O", (FVOID_STAR) rl_eol, RL_Keymap); - SLkm_define_key ("\xE0G", (FVOID_STAR) rl_bol, RL_Keymap); -#endif - SLkm_define_key ("^C", (FVOID_STAR) rl_abort, RL_Keymap); - SLkm_define_key ("^E", (FVOID_STAR) rl_eol, RL_Keymap); - SLkm_define_key ("^G", (FVOID_STAR) rl_abort, RL_Keymap); - SLkm_define_key ("^I", (FVOID_STAR) rl_self_insert, RL_Keymap); - SLkm_define_key ("^A", (FVOID_STAR) rl_bol, RL_Keymap); - SLkm_define_key ("\r", (FVOID_STAR) rl_enter, RL_Keymap); - SLkm_define_key ("\n", (FVOID_STAR) rl_enter, RL_Keymap); - SLkm_define_key ("^K", (FVOID_STAR) rl_deleol, RL_Keymap); - SLkm_define_key ("^L", (FVOID_STAR) rl_deleol, RL_Keymap); - SLkm_define_key ("^V", (FVOID_STAR) rl_del, RL_Keymap); - SLkm_define_key ("^D", (FVOID_STAR) rl_del, RL_Keymap); - SLkm_define_key ("^F", (FVOID_STAR) rl_right, RL_Keymap); - SLkm_define_key ("^B", (FVOID_STAR) rl_left, RL_Keymap); - SLkm_define_key ("^?", (FVOID_STAR) rl_bdel, RL_Keymap); - SLkm_define_key ("^H", (FVOID_STAR) rl_bdel, RL_Keymap); - SLkm_define_key ("^P", (FVOID_STAR) rl_prev_line, RL_Keymap); - SLkm_define_key ("^N", (FVOID_STAR) rl_next_line, RL_Keymap); - SLkm_define_key ("^R", (FVOID_STAR) rl_redraw, RL_Keymap); - SLkm_define_key ("`", (FVOID_STAR) rl_quote_insert, RL_Keymap); - SLkm_define_key ("\033\\", (FVOID_STAR) rl_trim, RL_Keymap); - if (SLang_Error) return -1; - } - - if (rli->prompt == NULL) rli->prompt = ""; - if (rli->keymap == NULL) rli->keymap = RL_Keymap; - rli->old_upd = rli->upd_buf1; - rli->new_upd = rli->upd_buf2; - *rli->buf = 0; - rli->point = 0; - - if (rli->flags & SL_RLINE_USE_ANSI) - { - if (rli->tt_goto_column == NULL) rli->tt_goto_column = ansi_goto_column; - } - - if (Char_Widths[0] == 2) return 0; - - for (ch = 0; ch < 32; ch++) Char_Widths[ch] = 2; - for (ch = 32; ch < 256; ch++) Char_Widths[ch] = 1; - Char_Widths[127] = 2; -#ifndef IBMPC_SYSTEM - for (ch = 128; ch < 160; ch++) Char_Widths[ch] = 3; -#endif - - return 0; -} - -SLang_Read_Line_Type *SLang_rline_save_line (SLang_RLine_Info_Type *rli) -{ - SLang_Read_Line_Type *rl = NULL; - unsigned char *buf; - - if ((rli == NULL) || (rli->buf == NULL)) - return NULL; - - if (NULL == (rl = (SLang_Read_Line_Type *) SLmalloc (sizeof (SLang_Read_Line_Type))) - || (NULL == (buf = (unsigned char *) SLmake_string ((char *)rli->buf)))) - { - SLfree ((char *)rl); - return NULL; - } - rl->buf = buf; - rl->buf_len = strlen ((char *)buf); - rl->num = rl->misc = 0; - rl->next = rl->prev = NULL; - - if (rli->tail != NULL) - { - rli->tail->next = rl; - rl->prev = rli->tail; - } - rli->tail = rl; - - return rl; -} diff --git a/mdk-stage1/slang/slscanf.c b/mdk-stage1/slang/slscanf.c deleted file mode 100644 index 5bd93ff41..000000000 --- a/mdk-stage1/slang/slscanf.c +++ /dev/null @@ -1,718 +0,0 @@ -/* sscanf function for S-Lang */ -/* Copyright (c) 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" -#include <ctype.h> -#include <math.h> -#include <errno.h> - -#include "slang.h" -#include "_slang.h" - -static char *skip_whitespace (char *s) -{ - while (isspace (*s)) - s++; - - return s; -} - -static void init_map (unsigned char map[256], int base) -{ - memset ((char *) map, 0xFF, 256); - - map['0'] = 0; map['1'] = 1; map['2'] = 2; map['3'] = 3; - map['4'] = 4; map['5'] = 5; map['6'] = 6; map['7'] = 7; - if (base == 8) - return; - - map['8'] = 8; map['9'] = 9; - if (base == 10) - return; - - map['A'] = 10; map['B'] = 11; map['C'] = 12; map['D'] = 13; - map['E'] = 14; map['F'] = 15; map['a'] = 10; map['b'] = 11; - map['c'] = 12; map['d'] = 13; map['e'] = 14; map['f'] = 15; -} - -static char *get_sign (char *s, char *smax, int *sign) -{ - *sign = 1; - if (s + 1 < smax) - { - if (*s == '+') s++; - else if (*s == '-') - { - s++; - *sign = -1; - } - } - return s; -} - - -static int parse_long (char **sp, char *smax, long *np, - long base, unsigned char map[256]) -{ - char *s, *s0; - long n; - int sign; - - s = s0 = get_sign (*sp, smax, &sign); - - n = 0; - while (s < smax) - { - unsigned char value; - - value = map [(unsigned char) *s]; - if (value == 0xFF) - break; - - n = base * n + value; - s++; - } - - *sp = s; - if (s == s0) - return 0; - - *np = n * sign; - - return 1; -} - - -static int parse_int (char **sp, char *smax, int *np, - long base, unsigned char map[256]) -{ - long n; - int status; - - if (1 == (status = parse_long (sp, smax, &n, base, map))) - *np = (int) n; - return status; -} - -static int parse_short (char **sp, char *smax, short *np, - long base, unsigned char map[256]) -{ - long n; - int status; - - if (1 == (status = parse_long (sp, smax, &n, base, map))) - *np = (short) n; - return status; -} - -static int parse_ulong (char **sp, char *smax, unsigned long *np, - long base, unsigned char map[256]) -{ - return parse_long (sp, smax, (long *) np, base, map); -} - -static int parse_uint (char **sp, char *smax, unsigned int *np, - long base, unsigned char map[256]) -{ - return parse_int (sp, smax, (int *) np, base, map); -} - -static int parse_ushort (char **sp, char *smax, unsigned short *np, - long base, unsigned char map[256]) -{ - return parse_short (sp, smax, (short *) np, base, map); -} - -#if SLANG_HAS_FLOAT -/* - * In an ideal world, strtod would be the correct function to use. However, - * there may be problems relying on this function because some systems do - * not support and some that do get it wrong. So, I will handle the parsing - * of the string and let atof or strtod handle the arithmetic. - */ -static int parse_double (char **sp, char *smax, double *d) -{ - char *s, *s0; - int sign; - int expon; - unsigned char map[256]; - char buf[128]; - int has_leading_zeros; - char *start_pos, *sign_pos; - char *b, *bmax; - - start_pos = *sp; - s = get_sign (start_pos, smax, &sign); - if (s >= smax) - { - errno = _SLerrno_errno = EINVAL; - return 0; - } - - /* Prepare the buffer that will be passed to strtod */ - /* Allow the exponent to be 5 significant digits: E+xxxxx\0 */ - bmax = buf + (sizeof (buf) - 8); - buf[0] = '0'; buf[1] = '.'; - b = buf + 2; - - init_map (map, 10); - - /* Skip leading 0s */ - s0 = s; - while ((s < smax) && (*s == '0')) - s++; - has_leading_zeros = (s != s0); - - expon = 0; - while (s < smax) - { - unsigned char value = map [(unsigned char) *s]; - - if (value == 0xFF) - break; - - if (b < bmax) - *b++ = *s; - - expon++; - s++; - } - - if ((s < smax) && (*s == '.')) - { - s++; - if (b == buf + 2) /* nothing added yet */ - { - while ((s < smax) && (*s == '0')) - { - expon--; - s++; - } - } - - while (s < smax) - { - unsigned char value = map [(unsigned char) *s]; - - if (value == 0xFF) - break; - - if (b < bmax) - *b++ = *s; - s++; - } - } - - if ((b == buf + 2) - && (has_leading_zeros == 0)) - { - *sp = start_pos; - errno = EINVAL; - return 0; - } - - if ((s + 1 < smax) && ((*s == 'E') || (*s == 'e'))) - { - int e; - int esign; - - s0 = s; - s = get_sign (s + 1, smax, &esign); - sign_pos = s; - e = 0; - while (s < smax) - { - unsigned char value = map [(unsigned char) *s]; - if (value == 0xFF) - break; - if (e < 25000) /* avoid overflow if 16 bit */ - e = 10 * e + value; - s++; - } -#ifdef ERANGE - if (e >= 25000) - errno = ERANGE; -#endif - if (s == sign_pos) - s = s0; /* ...E-X */ - else - { - e = esign * e; - expon += e; - } - } - - if (expon != 0) - sprintf (b, "e%d", expon); - else - *b = 0; - - *sp = s; -#if HAVE_STRTOD - *d = sign * strtod (buf, NULL); -#else - *d = sign * atof (buf); -#endif - return 1; -} - -static int parse_float (char **sp, char *smax, float *d) -{ - double x; - if (1 == parse_double (sp, smax, &x)) - { - *d = (float) x; - return 1; - } - return 0; -} -#endif /* SLANG_HAS_FLOAT */ - -static int parse_string (char **sp, char *smax, char **str) -{ - char *s, *s0; - - s0 = s = *sp; - while (s < smax) - { - if (isspace (*s)) - break; - s++; - } - if (NULL == (*str = SLang_create_nslstring (s0, (unsigned int) (s - s0)))) - return -1; - - *sp = s; - return 1; -} - -static int parse_bstring (char **sp, char *smax, char **str) -{ - char *s; - - s = *sp; - if (NULL == (*str = SLang_create_nslstring (s, (unsigned int) (smax - s)))) - return -1; - - *sp = smax; - return 1; -} - -static int parse_range (char **sp, char *smax, char **fp, char **str) -{ - char *s, *s0; - char *range; - char *f; - unsigned char map[256]; - unsigned char reverse; - - /* How can one represent a range with just '^'? The naive answer is - * is [^]. However, this may be interpreted as meaning any character - * but ']' and others. Let's assume that the user will not use a range - * to match '^'. - */ - f = *fp; - /* f is a pointer to (one char after) [...]. */ - if (*f == '^') - { - f++; - reverse = 1; - } - else reverse = 0; - - s0 = f; - if (*f == ']') - f++; - - while (1) - { - char ch = *f; - - if (ch == 0) - { - SLang_verror (SL_INVALID_PARM, "Unexpected end of range in format"); - return -1; - } - if (ch == ']') - break; - f++; - } - if (NULL == (range = SLmake_nstring (s0, (unsigned int) (f - s0)))) - return -1; - *fp = f + 1; /* skip ] */ - - SLmake_lut (map, (unsigned char *) range, reverse); - SLfree (range); - - s0 = s = *sp; - while ((s < smax) && map [(unsigned char) *s]) - s++; - - if (NULL == (*str = SLang_create_nslstring (s0, (unsigned int) (s - s0)))) - return -1; - - *sp = s; - return 1; -} - - -int _SLang_sscanf (void) -{ - int num; - unsigned int num_refs; - char *format; - char *input_string, *input_string_max; - char *f, *s; - unsigned char map8[256], map10[256], map16[256]; - - if (SLang_Num_Function_Args < 2) - { - SLang_verror (SL_INVALID_PARM, "Int_Type sscanf (str, format, ...)"); - return -1; - } - - num_refs = (unsigned int) SLang_Num_Function_Args; - if (-1 == SLreverse_stack (num_refs)) - return -1; - num_refs -= 2; - - if (-1 == SLang_pop_slstring (&input_string)) - return -1; - - if (-1 == SLang_pop_slstring (&format)) - { - SLang_free_slstring (input_string); - return -1; - } - - f = format; - s = input_string; - input_string_max = input_string + strlen (input_string); - - init_map (map8, 8); - init_map (map10, 10); - init_map (map16, 16); - - num = 0; - - while (num_refs != 0) - { - SLang_Object_Type obj; - SLang_Ref_Type *ref; - char *smax; - unsigned char *map; - int base; - int no_assign; - int is_short; - int is_long; - int status; - char chf; - unsigned int width; - int has_width; - - chf = *f++; - - if (chf == 0) - { - /* Hmmm.... what is the most useful thing to do?? */ -#if 1 - break; -#else - SLang_verror (SL_INVALID_PARM, "sscanf: format not big enough for output list"); - goto return_error; -#endif - } - - if (isspace (chf)) - { - s = skip_whitespace (s); - continue; - } - - if ((chf != '%') - || ((chf = *f++) == '%')) - { - if (*s != chf) - break; - s++; - continue; - } - - no_assign = 0; - is_short = 0; - is_long = 0; - width = 0; - smax = input_string_max; - - /* Look for the flag character */ - if (chf == '*') - { - no_assign = 1; - chf = *f++; - } - - /* Width */ - has_width = isdigit (chf); - if (has_width) - { - f--; - (void) parse_uint (&f, f + strlen(f), &width, 10, map10); - chf = *f++; - } - - /* Now the type modifier */ - switch (chf) - { - case 'h': - is_short = 1; - chf = *f++; - break; - - case 'L': /* not implemented */ - case 'l': - is_long = 1; - chf = *f++; - break; - } - - status = -1; - - if ((chf != 'c') && (chf != '[')) - s = skip_whitespace (s); - - if (has_width) - { - if (width > (unsigned int) (input_string_max - s)) - width = (unsigned int) (input_string_max - s); - smax = s + width; - } - - /* Now the format descriptor */ - - map = map10; - base = 10; - - try_again: /* used by i, x, and o, conversions */ - switch (chf) - { - case 0: - SLang_verror (SL_INVALID_PARM, "sscanf: Unexpected end of format"); - goto return_error; - case 'D': - is_long = 1; - case 'd': - if (is_short) - { - obj.data_type = SLANG_SHORT_TYPE; - status = parse_short (&s, smax, &obj.v.short_val, base, map); - } - else if (is_long) - { - obj.data_type = SLANG_LONG_TYPE; - status = parse_long (&s, smax, &obj.v.long_val, base, map); - } - else - { - obj.data_type = SLANG_INT_TYPE; - status = parse_int (&s, smax, &obj.v.int_val, base, map); - } - break; - - - case 'U': - is_long = 1; - case 'u': - if (is_short) - { - obj.data_type = SLANG_USHORT_TYPE; - status = parse_ushort (&s, smax, &obj.v.ushort_val, base, map); - } - else if (is_long) - { - obj.data_type = SLANG_ULONG_TYPE; - status = parse_ulong (&s, smax, &obj.v.ulong_val, base, map); - } - else - { - obj.data_type = SLANG_INT_TYPE; - status = parse_uint (&s, smax, &obj.v.uint_val, base, map); - } - break; - - case 'I': - is_long = 1; - case 'i': - if ((s + 1 >= smax) - || (*s != 0)) - chf = 'd'; - else if (((s[1] == 'x') || (s[1] == 'X')) - && (s + 2 < smax)) - { - s += 2; - chf = 'x'; - } - else chf = 'o'; - goto try_again; - - case 'O': - is_long = 1; - case 'o': - map = map8; - base = 8; - chf = 'd'; - goto try_again; - - case 'X': - is_long = 1; - case 'x': - base = 16; - map = map16; - chf = 'd'; - goto try_again; - - case 'E': - case 'F': - is_long = 1; - case 'e': - case 'f': - case 'g': -#if SLANG_HAS_FLOAT - if (is_long) - { - obj.data_type = SLANG_DOUBLE_TYPE; - status = parse_double (&s, smax, &obj.v.double_val); - } - else - { - obj.data_type = SLANG_FLOAT_TYPE; - status = parse_float (&s, smax, &obj.v.float_val); - } -#else - SLang_verror (SL_NOT_IMPLEMENTED, - "This version of the S-Lang does not support floating point"); - status = -1; -#endif - break; - - case 's': - obj.data_type = SLANG_STRING_TYPE; - status = parse_string (&s, smax, &obj.v.s_val); - break; - - case 'c': - if (has_width == 0) - { - obj.data_type = SLANG_UCHAR_TYPE; - obj.v.uchar_val = *s++; - status = 1; - break; - } - obj.data_type = SLANG_STRING_TYPE; - status = parse_bstring (&s, smax, &obj.v.s_val); - break; - - case '[': - obj.data_type = SLANG_STRING_TYPE; - status = parse_range (&s, smax, &f, &obj.v.s_val); - break; - - case 'n': - obj.data_type = SLANG_UINT_TYPE; - obj.v.uint_val = (unsigned int) (s - input_string); - status = 1; - break; - - default: - status = -1; - SLang_verror (SL_NOT_IMPLEMENTED, "format specifier '%c' is not supported", chf); - break; - } - - if (status == 0) - break; - - if (status == -1) - goto return_error; - - if (no_assign) - { - SLang_free_object (&obj); - continue; - } - - if (-1 == SLang_pop_ref (&ref)) - { - SLang_free_object (&obj); - goto return_error; - } - - if (-1 == SLang_push (&obj)) - { - SLang_free_object (&obj); - SLang_free_ref (ref); - goto return_error; - } - - if (-1 == _SLang_deref_assign (ref)) - { - SLang_free_ref (ref); - goto return_error; - } - SLang_free_ref (ref); - - num++; - num_refs--; - } - - if (-1 == SLdo_pop_n (num_refs)) - goto return_error; - - SLang_free_slstring (format); - SLang_free_slstring (input_string); - return num; - - return_error: - /* NULLS ok */ - SLang_free_slstring (format); - SLang_free_slstring (input_string); - return -1; -} - - -# if SLANG_HAS_FLOAT - -#ifndef HAVE_STDLIB_H -/* Oh dear. Where is the prototype for atof? If not in stdlib, then - * I do not know where. Not in math.h on some systems either. - */ -extern double atof (); -#endif - -double _SLang_atof (char *s) -{ - double x; - - s = skip_whitespace (s); - errno = 0; - - if (1 != parse_double (&s, s + strlen (s), &x)) - { - if ((0 == strcmp ("NaN", s)) - || (0 == strcmp ("-Inf", s)) - || (0 == strcmp ("Inf", s))) - return atof (s); /* let this deal with it */ -#ifdef EINVAL - errno = _SLerrno_errno = EINVAL; -#endif - return 0.0; - } - if (errno) - _SLerrno_errno = errno; - return x; -} -#endif diff --git a/mdk-stage1/slang/slscroll.c b/mdk-stage1/slang/slscroll.c deleted file mode 100644 index 358296116..000000000 --- a/mdk-stage1/slang/slscroll.c +++ /dev/null @@ -1,450 +0,0 @@ -/* SLang Scrolling Window Routines */ -/* Copyright (c) 1996, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -static void find_window_bottom (SLscroll_Window_Type *win) -{ - unsigned int nrows; - unsigned int hidden_mask; - SLscroll_Type *bot, *cline, *last_bot; - unsigned int row; - - nrows = win->nrows; - hidden_mask = win->hidden_mask; - cline = win->current_line; - - win->window_row = row = 0; - last_bot = bot = win->top_window_line; - - while (row < nrows) - { - if (bot == cline) - win->window_row = row; - - last_bot = bot; - - if (bot == NULL) - break; - - bot = bot->next; - - if (hidden_mask) - { - while ((bot != NULL) && (bot->flags & hidden_mask)) - bot = bot->next; - } - - row++; - } - - win->bot_window_line = last_bot; -} - -static int find_top_to_recenter (SLscroll_Window_Type *win) -{ - unsigned int nrows; - unsigned int hidden_mask; - SLscroll_Type *prev, *last_prev, *cline; - - nrows = win->nrows; - cline = win->current_line; - hidden_mask = win->hidden_mask; - - nrows = nrows / 2; - - last_prev = prev = cline; - - while (nrows && (prev != NULL)) - { - nrows--; - last_prev = prev; - do - { - prev = prev->prev; - } - while (hidden_mask - && (prev != NULL) - && (prev->flags & hidden_mask)); - } - - if (prev == NULL) prev = last_prev; - - win->top_window_line = prev; - find_window_bottom (win); - - return 0; -} - -#define HAS_BORDER_CODE 1 -int SLscroll_find_top (SLscroll_Window_Type *win) -{ - unsigned int i; - SLscroll_Type *cline, *prev, *next; - SLscroll_Type *top_window_line; - unsigned int nrows; - unsigned int hidden_mask; - int scroll_mode; - unsigned int border; - - cline = win->current_line; - nrows = win->nrows; - scroll_mode = win->cannot_scroll; - border = win->border; - if (scroll_mode == 2) - border = 0; - - if ((cline == NULL) || (nrows <= 1)) - { - win->top_window_line = cline; - find_window_bottom (win); - return 0; - } - - hidden_mask = win->hidden_mask; - - /* Note: top_window_line might be a bogus pointer. This means that I cannot - * access it unless it really corresponds to a pointer in the buffer. - */ - top_window_line = win->top_window_line; - - if (top_window_line == NULL) - return find_top_to_recenter (win); - - /* Chances are that the current line is visible in the window. This means - * that the top window line should be above it. - */ - prev = cline; - - i = 0; - - while ((i < nrows) && (prev != NULL)) - { - if (prev == top_window_line) - { - SLscroll_Type *twl = top_window_line; - int dir = 0; - - if (i < border) dir = -1; else if (i + border >= nrows) dir = 1; - - if (dir) while (border) - { - if (dir < 0) twl = twl->prev; - else twl = twl->next; - - if (twl == NULL) - { - twl = top_window_line; - break; - } - if ((hidden_mask == 0) - || (0 == (twl->flags & hidden_mask))) - border--; - } - - win->top_window_line = twl; - find_window_bottom (win); - return 0; - } - - do - { - prev = prev->prev; - } - while (hidden_mask - && (prev != NULL) - && (prev->flags & hidden_mask)); - i++; - } - - /* Now check the borders of the window. Perhaps the current line lies - * outsider the border by a line. Only do this if terminal can scroll. - */ - - if (scroll_mode == 1) - return find_top_to_recenter (win); - else if (scroll_mode == -1) - scroll_mode = 0; - - next = cline->next; - while (hidden_mask - && (next != NULL) - && (next->flags & hidden_mask)) - next = next->next; - - if ((next != NULL) - && (next == top_window_line)) - { - /* The current line is one line above the window. This means user - * has moved up past the top of the window. If scroll_mode is set - * to scroll by pages, we need to do a page up. - */ - - win->top_window_line = cline; - find_window_bottom (win); - - if (scroll_mode) return SLscroll_pageup (win); - - return 0; - } - - prev = cline->prev; - - while (hidden_mask - && (prev != NULL) - && (prev->flags & hidden_mask)) - prev = prev->prev; - - if ((prev == NULL) - || (prev != win->bot_window_line)) - return find_top_to_recenter (win); - - /* It looks like cline is below window by one line. See what line should - * be at top to scroll it into view. Only do this unless we are scrolling - * by pages. - */ - if (scroll_mode) - { - win->top_window_line = cline; - find_window_bottom (win); - return 0; - } - - i = 2; - while ((i < nrows) && (prev != NULL)) - { - do - { - prev = prev->prev; - } - while (hidden_mask - && (prev != NULL) - && (prev->flags & hidden_mask)); - i++; - } - - if (prev != NULL) - { - win->top_window_line = prev; - find_window_bottom (win); - return 0; - } - - return find_top_to_recenter (win); -} - -int SLscroll_find_line_num (SLscroll_Window_Type *win) -{ - SLscroll_Type *cline, *l; - unsigned int n; - unsigned int hidden_mask; - - if (win == NULL) return -1; - - hidden_mask = win->hidden_mask; - cline = win->current_line; - - n = 1; - - l = win->lines; - while (l != cline) - { - if ((hidden_mask == 0) - || (0 == (l->flags & hidden_mask))) - n++; - - l = l->next; - } - - win->line_num = n; - n--; - - while (l != NULL) - { - if ((hidden_mask == 0) - || (0 == (l->flags & hidden_mask))) - n++; - l = l->next; - } - win->num_lines = n; - - return 0; -} - -unsigned int SLscroll_next_n (SLscroll_Window_Type *win, unsigned int n) -{ - unsigned int i; - unsigned int hidden_mask; - SLscroll_Type *l, *cline; - - if ((win == NULL) - || (NULL == (cline = win->current_line))) - return 0; - - hidden_mask = win->hidden_mask; - l = cline; - i = 0; - while (i < n) - { - l = l->next; - while (hidden_mask - && (l != NULL) && (l->flags & hidden_mask)) - l = l->next; - - if (l == NULL) - break; - - i++; - cline = l; - } - - win->current_line = cline; - win->line_num += i; - return i; -} - -unsigned int SLscroll_prev_n (SLscroll_Window_Type *win, unsigned int n) -{ - unsigned int i; - unsigned int hidden_mask; - SLscroll_Type *l, *cline; - - if ((win == NULL) - || (NULL == (cline = win->current_line))) - return 0; - - hidden_mask = win->hidden_mask; - l = cline; - i = 0; - while (i < n) - { - l = l->prev; - while (hidden_mask - && (l != NULL) && (l->flags & hidden_mask)) - l = l->prev; - - if (l == NULL) - break; - - i++; - cline = l; - } - - win->current_line = cline; - win->line_num -= i; - return i; -} - -int SLscroll_pageup (SLscroll_Window_Type *win) -{ - SLscroll_Type *l, *top; - unsigned int nrows, hidden_mask; - unsigned int n; - - if (win == NULL) - return -1; - - (void) SLscroll_find_top (win); - - nrows = win->nrows; - - if ((NULL != (top = win->top_window_line)) - && (nrows > 2)) - { - n = 0; - hidden_mask = win->hidden_mask; - l = win->current_line; - while ((l != NULL) && (l != top)) - { - l = l->prev; - if ((hidden_mask == 0) - || ((l != NULL) && (0 == (l->flags & hidden_mask)))) - n++; - } - - if (l != NULL) - { - unsigned int save_line_num; - int ret = 0; - - win->current_line = l; - win->line_num -= n; - - /* Compute a new top/bottom header */ - save_line_num = win->line_num; - - if ((0 == SLscroll_prev_n (win, nrows - 1)) - && (n == 0)) - ret = -1; - - win->top_window_line = win->current_line; - win->current_line = l; - win->line_num = save_line_num; - - find_window_bottom (win); - return ret; - } - } - - if (nrows < 2) nrows++; - if (0 == SLscroll_prev_n (win, nrows - 1)) - return -1; - return 0; -} - -int SLscroll_pagedown (SLscroll_Window_Type *win) -{ - SLscroll_Type *l, *bot; - unsigned int nrows, hidden_mask; - unsigned int n; - - if (win == NULL) - return -1; - - (void) SLscroll_find_top (win); - - nrows = win->nrows; - - if ((NULL != (bot = win->bot_window_line)) - && (nrows > 2)) - { - n = 0; - hidden_mask = win->hidden_mask; - l = win->current_line; - while ((l != NULL) && (l != bot)) - { - l = l->next; - if ((hidden_mask == 0) - || ((l != NULL) && (0 == (l->flags & hidden_mask)))) - n++; - } - - if (l != NULL) - { - win->current_line = l; - win->top_window_line = l; - win->line_num += n; - - find_window_bottom (win); - - if (n || (bot != win->bot_window_line)) - return 0; - - return -1; - } - } - - if (nrows < 2) nrows++; - if (0 == SLscroll_next_n (win, nrows - 1)) - return -1; - return 0; -} - diff --git a/mdk-stage1/slang/slsearch.c b/mdk-stage1/slang/slsearch.c deleted file mode 100644 index a9a427a7d..000000000 --- a/mdk-stage1/slang/slsearch.c +++ /dev/null @@ -1,239 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -#ifdef upcase -# undef upcase -#endif - -#define upcase(ch) (cs ? ch : UPPER_CASE(ch)) - -static unsigned char *search_forward (register unsigned char *beg, - unsigned char *end, - unsigned char *key, - register int key_len, int cs, int *ind) -{ - register unsigned char char1; - unsigned char *pos; - int j, str_len; - register unsigned char ch; - register int db; - - str_len = (int) (end - beg); - if (str_len < key_len) return (NULL); - - if (key_len == 0) - return NULL; - - char1 = key[key_len - 1]; - beg += (key_len - 1); - - while(1) - { - if (cs) while (beg < end) - { - ch = *beg; - db = ind[(unsigned char) ch]; - if ((db < key_len) && (ch == char1)) break; - beg += db; /* ind[(unsigned char) ch]; */ - } - else while (beg < end) - { - ch = *beg; - db = ind[(unsigned char) ch]; - if ((db < key_len) && - (UPPER_CASE(ch) == char1)) break; - beg += db; /* ind[(unsigned char) ch]; */ - } - - if (beg >= end) return(NULL); - - pos = beg - (key_len - 1); - for (j = 0; j < key_len; j++) - { - ch = upcase(pos[j]); - if (ch != (unsigned char) key[j]) break; - } - - if (j == key_len) return(pos); - beg += 1; - } -} - -static unsigned char *search_backward (unsigned char *beg,unsigned char *end, - unsigned char *key, int key_len, - int cs, int *ind) -{ - unsigned char ch, char1; - int j, str_len, ofs; - - str_len = (int) (end - beg); - if (str_len < key_len) return (NULL); - - if (key_len == 0) - return NULL; - - /* end -= (key_len - 1); */ - end -= key_len; - - char1 = key[0]; - - while(1) - { - while ((beg <= end) && (ch = *end, ch = upcase(ch), ch != char1)) - { - ofs = ind[(unsigned char) ch]; -#ifdef __MSDOS__ - /* This is needed for msdos segment wrapping problems */ - if (beg + ofs > end) return(NULL); -#endif - end -= ofs; - } - if (beg > end) return(NULL); - for (j = 1; j < key_len; j++) - { - ch = upcase(end[j]); - if (ch != key[j]) break; - } - if (j == key_len) return(end); - end--; - } -} - -unsigned char *SLsearch (unsigned char *pmin, unsigned char *pmax, - SLsearch_Type *st) -{ - if (st->dir > 0) return search_forward (pmin, pmax, st->key, - st->key_len, st->cs, st->ind); - else return search_backward (pmin, pmax, st->key, - st->key_len, st->cs, st->ind); -} - -static int Case_Tables_Ok; - -int SLsearch_init (char *str, int dir, int cs, SLsearch_Type *st) -{ - int i, maxi; - register int max = strlen(str); - unsigned char *w, *work = st->key; - register int *indp, *indpm; - int *ind = st->ind; - - if (max >= (int) sizeof (st->key)) - { - SLang_doerror ("Search string too long."); - return -1; - } - - st->dir = dir; st->cs = cs; - - if (!Case_Tables_Ok) SLang_init_case_tables (); - - if (dir > 0) - { - w = work; - } - else - { - maxi = max - 1; - str = str + maxi; - w = work + maxi; - } - - /* for (i = 0; i < 256; i++) ind[i] = max; */ - indp = ind; indpm = ind + 256; - while (indp < indpm) - { - *indp++ = max; - *indp++ = max; - *indp++ = max; - *indp++ = max; - } - - i = 0; - if (cs) while (i < max) - { - i++; - maxi = max - i; - *w = *str; - ind[(unsigned char) *str] = maxi; - str += dir; w += dir; - } - else while (i < max) - { - i++; - maxi = max - i; - *w = UPPER_CASE(*str); - ind[(unsigned char) *w] = maxi; - ind[(unsigned char) LOWER_CASE(*str)] = maxi; - str += dir; w += dir; - } - - work[max] = 0; - st->key_len = max; - return max; -} - -/* 8bit clean upper and lowercase macros */ -unsigned char _SLChg_LCase_Lut[256]; -unsigned char _SLChg_UCase_Lut[256]; - -void SLang_define_case (int *u, int *l) -{ - unsigned char up = (unsigned char) *u, dn = (unsigned char) *l; - - _SLChg_LCase_Lut[up] = dn; - _SLChg_LCase_Lut[dn] = dn; - _SLChg_UCase_Lut[dn] = up; - _SLChg_UCase_Lut[up] = up; -} - -void SLang_init_case_tables (void) -{ - int i, j; - if (Case_Tables_Ok) return; - - for (i = 0; i < 256; i++) - { - _SLChg_UCase_Lut[i] = i; - _SLChg_LCase_Lut[i] = i; - } - - for (i = 'A'; i <= 'Z'; i++) - { - j = i + 32; - _SLChg_UCase_Lut[j] = i; - _SLChg_LCase_Lut[i] = j; - } -#ifdef PC_SYSTEM - /* Initialize for DOS code page 437. */ - _SLChg_UCase_Lut[135] = 128; _SLChg_LCase_Lut[128] = 135; - _SLChg_UCase_Lut[132] = 142; _SLChg_LCase_Lut[142] = 132; - _SLChg_UCase_Lut[134] = 143; _SLChg_LCase_Lut[143] = 134; - _SLChg_UCase_Lut[130] = 144; _SLChg_LCase_Lut[144] = 130; - _SLChg_UCase_Lut[145] = 146; _SLChg_LCase_Lut[146] = 145; - _SLChg_UCase_Lut[148] = 153; _SLChg_LCase_Lut[153] = 148; - _SLChg_UCase_Lut[129] = 154; _SLChg_LCase_Lut[154] = 129; - _SLChg_UCase_Lut[164] = 165; _SLChg_LCase_Lut[165] = 164; -#else - /* ISO Latin */ - for (i = 192; i <= 221; i++) - { - j = i + 32; - _SLChg_UCase_Lut[j] = i; - _SLChg_LCase_Lut[i] = j; - } - _SLChg_UCase_Lut[215] = 215; _SLChg_LCase_Lut[215] = 215; - _SLChg_UCase_Lut[223] = 223; _SLChg_LCase_Lut[223] = 223; - _SLChg_UCase_Lut[247] = 247; _SLChg_LCase_Lut[247] = 247; - _SLChg_UCase_Lut[255] = 255; _SLChg_LCase_Lut[255] = 255; -#endif - Case_Tables_Ok = 1; -} diff --git a/mdk-stage1/slang/slsignal.c b/mdk-stage1/slang/slsignal.c deleted file mode 100644 index 30707dea5..000000000 --- a/mdk-stage1/slang/slsignal.c +++ /dev/null @@ -1,336 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include <signal.h> - -#ifdef HAVE_SYS_TYPES_H -# include <sys/types.h> -#endif -#ifdef HAVE_SYS_WAIT_H -# include <sys/wait.h> -#endif - -#include <errno.h> - -#include "slang.h" -#include "_slang.h" - -/* Do not trust these environments */ -#if defined(__CYGWIN32__) || defined(__MINGW32__) || defined(AMIGA) -# ifdef SLANG_POSIX_SIGNALS -# undef SLANG_POSIX_SIGNALS -# endif -#endif - -/* This function will cause system calls to be restarted after signal if possible */ -SLSig_Fun_Type *SLsignal (int sig, SLSig_Fun_Type *f) -{ -#if defined(SLANG_POSIX_SIGNALS) - struct sigaction old_sa, new_sa; - -# ifdef SIGALRM - /* We want system calls to be interrupted by SIGALRM. */ - if (sig == SIGALRM) return SLsignal_intr (sig, f); -# endif - - sigemptyset (&new_sa.sa_mask); - new_sa.sa_handler = f; - - new_sa.sa_flags = 0; -# ifdef SA_RESTART - new_sa.sa_flags |= SA_RESTART; -# endif - - if (-1 == sigaction (sig, &new_sa, &old_sa)) - return (SLSig_Fun_Type *) SIG_ERR; - - return old_sa.sa_handler; -#else - /* Not POSIX. */ - return signal (sig, f); -#endif -} - -/* This function will NOT cause system calls to be restarted after - * signal if possible - */ -SLSig_Fun_Type *SLsignal_intr (int sig, SLSig_Fun_Type *f) -{ -#ifdef SLANG_POSIX_SIGNALS - struct sigaction old_sa, new_sa; - - sigemptyset (&new_sa.sa_mask); - new_sa.sa_handler = f; - - new_sa.sa_flags = 0; -# ifdef SA_INTERRUPT - new_sa.sa_flags |= SA_INTERRUPT; -# endif - - if (-1 == sigaction (sig, &new_sa, &old_sa)) - return (SLSig_Fun_Type *) SIG_ERR; - - return old_sa.sa_handler; -#else - /* Not POSIX. */ - return signal (sig, f); -#endif -} - -/* We are primarily interested in blocking signals that would cause the - * application to reset the tty. These include suspend signals and - * possibly interrupt signals. - */ -#ifdef SLANG_POSIX_SIGNALS -static sigset_t Old_Signal_Mask; -#endif - -static volatile unsigned int Blocked_Depth; - -int SLsig_block_signals (void) -{ -#ifdef SLANG_POSIX_SIGNALS - sigset_t new_mask; -#endif - - Blocked_Depth++; - if (Blocked_Depth != 1) - { - return 0; - } - -#ifdef SLANG_POSIX_SIGNALS - sigemptyset (&new_mask); -# ifdef SIGQUIT - sigaddset (&new_mask, SIGQUIT); -# endif -# ifdef SIGTSTP - sigaddset (&new_mask, SIGTSTP); -# endif -# ifdef SIGINT - sigaddset (&new_mask, SIGINT); -# endif -# ifdef SIGTTIN - sigaddset (&new_mask, SIGTTIN); -# endif -# ifdef SIGTTOU - sigaddset (&new_mask, SIGTTOU); -# endif -# ifdef SIGWINCH - sigaddset (&new_mask, SIGWINCH); -# endif - - (void) sigprocmask (SIG_BLOCK, &new_mask, &Old_Signal_Mask); - return 0; -#else - /* Not implemented. */ - return -1; -#endif -} - -int SLsig_unblock_signals (void) -{ - if (Blocked_Depth == 0) - return -1; - - Blocked_Depth--; - - if (Blocked_Depth != 0) - return 0; - -#ifdef SLANG_POSIX_SIGNALS - (void) sigprocmask (SIG_SETMASK, &Old_Signal_Mask, NULL); - return 0; -#else - return -1; -#endif -} - -#ifdef MSWINDOWS -int SLsystem (char *cmd) -{ - SLang_verror (SL_NOT_IMPLEMENTED, "system not implemented"); - return -1; -} - -#else -int SLsystem (char *cmd) -{ -#ifdef SLANG_POSIX_SIGNALS - pid_t pid; - int status; - struct sigaction ignore; -# ifdef SIGINT - struct sigaction save_intr; -# endif -# ifdef SIGQUIT - struct sigaction save_quit; -# endif -# ifdef SIGCHLD - sigset_t child_mask, save_mask; -# endif - - if (cmd == NULL) return 1; - - ignore.sa_handler = SIG_IGN; - sigemptyset (&ignore.sa_mask); - ignore.sa_flags = 0; - -# ifdef SIGINT - if (-1 == sigaction (SIGINT, &ignore, &save_intr)) - return -1; -# endif - -# ifdef SIGQUIT - if (-1 == sigaction (SIGQUIT, &ignore, &save_quit)) - { - (void) sigaction (SIGINT, &save_intr, NULL); - return -1; - } -# endif - -# ifdef SIGCHLD - sigemptyset (&child_mask); - sigaddset (&child_mask, SIGCHLD); - if (-1 == sigprocmask (SIG_BLOCK, &child_mask, &save_mask)) - { -# ifdef SIGINT - (void) sigaction (SIGINT, &save_intr, NULL); -# endif -# ifdef SIGQUIT - (void) sigaction (SIGQUIT, &save_quit, NULL); -# endif - return -1; - } -# endif - - pid = fork(); - - if (pid == -1) - status = -1; - else if (pid == 0) - { - /* Child */ -# ifdef SIGINT - (void) sigaction (SIGINT, &save_intr, NULL); -# endif -# ifdef SIGQUIT - (void) sigaction (SIGQUIT, &save_quit, NULL); -# endif -# ifdef SIGCHLD - (void) sigprocmask (SIG_SETMASK, &save_mask, NULL); -# endif - - execl ("/bin/sh", "sh", "-c", cmd, NULL); - _exit (127); - } - else - { - /* parent */ - while (-1 == waitpid (pid, &status, 0)) - { -# ifdef EINTR - if (errno == EINTR) - continue; -# endif -# ifdef ERESTARTSYS - if (errno == ERESTARTSYS) - continue; -# endif - status = -1; - break; - } - } -# ifdef SIGINT - if (-1 == sigaction (SIGINT, &save_intr, NULL)) - status = -1; -# endif -# ifdef SIGQUIT - if (-1 == sigaction (SIGQUIT, &save_quit, NULL)) - status = -1; -# endif -# ifdef SIGCHLD - if (-1 == sigprocmask (SIG_SETMASK, &save_mask, NULL)) - status = -1; -# endif - - return status; - -#else /* No POSIX Signals */ -# ifdef SIGINT - void (*sint)(int); -# endif -# ifdef SIGQUIT - void (*squit)(int); -# endif - int status; - -# ifdef SIGQUIT - squit = SLsignal (SIGQUIT, SIG_IGN); -# endif -# ifdef SIGINT - sint = SLsignal (SIGINT, SIG_IGN); -# endif - status = system (cmd); -# ifdef SIGINT - SLsignal (SIGINT, sint); -# endif -# ifdef SIGQUIT - SLsignal (SIGQUIT, squit); -# endif - return status; -#endif /* POSIX_SIGNALS */ -} -#endif - -#if 0 -#include <windows.h> -static int msw_system (char *cmd) -{ - STARTUPINFO startup_info; - PROCESS_INFORMATION process_info; - int status; - - if (cmd == NULL) return -1; - - memset ((char *) &startup_info, 0, sizeof (STARTUPINFO)); - startup_info.cb = sizeof(STARTUPINFO); - startup_info.dwFlags = STARTF_USESHOWWINDOW; - startup_info.wShowWindow = SW_SHOWDEFAULT; - - if (FALSE == CreateProcess (NULL, - cmd, - NULL, - NULL, - FALSE, - NORMAL_PRIORITY_CLASS|CREATE_NEW_CONSOLE, - NULL, - NULL, - &startup_info, - &process_info)) - { - SLang_verror (0, "%s: CreateProcess failed.", cmd); - return -1; - } - - status = -1; - - if (0xFFFFFFFFUL != WaitForSingleObject (process_info.hProcess, INFINITE)) - { - DWORD exit_code; - - if (TRUE == GetExitCodeProcess (process_info.hProcess, &exit_code)) - status = (int) exit_code; - } - - CloseHandle (process_info.hThread); - CloseHandle (process_info.hProcess); - - return status; -} -#endif diff --git a/mdk-stage1/slang/slsmg.c b/mdk-stage1/slang/slsmg.c deleted file mode 100644 index 088557f27..000000000 --- a/mdk-stage1/slang/slsmg.c +++ /dev/null @@ -1,1584 +0,0 @@ -/* SLang Screen management routines */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -typedef struct Screen_Type - { - int n; /* number of chars written last time */ - int flags; /* line untouched, etc... */ - SLsmg_Char_Type *old, *neew; -#ifndef IBMPC_SYSTEM - unsigned long old_hash, new_hash; -#endif - } -Screen_Type; - -#define TOUCHED 0x1 -#define TRASHED 0x2 -static int Screen_Trashed; - -#if !defined(__MSDOS_16BIT__) -# define MAX_SCREEN_SIZE 256 -#else -# define MAX_SCREEN_SIZE 75 -#endif - -Screen_Type SL_Screen[MAX_SCREEN_SIZE]; -static int Start_Col, Start_Row; -static int Screen_Cols, Screen_Rows; -static int This_Row, This_Col; -static int This_Color; /* only the first 8 bits of this - * are used. The highest bit is used - * to indicate an alternate character - * set. This leaves 127 userdefineable - * color combination. - */ - -#ifndef IBMPC_SYSTEM -#define ALT_CHAR_FLAG 0x80 -#else -#define ALT_CHAR_FLAG 0x00 -#endif - -#if SLTT_HAS_NON_BCE_SUPPORT && !defined(IBMPC_SYSTEM) -#define REQUIRES_NON_BCE_SUPPORT 1 -static int Bce_Color_Offset; -#endif - -int SLsmg_Newline_Behavior = 0; -int SLsmg_Backspace_Moves = 0; -/* Backward compatibility. Not used. */ -/* int SLsmg_Newline_Moves; */ - -static void (*tt_normal_video)(void) = SLtt_normal_video; -static void (*tt_goto_rc)(int, int) = SLtt_goto_rc; -static void (*tt_cls) (void) = SLtt_cls; -static void (*tt_del_eol) (void) = SLtt_del_eol; -static void (*tt_smart_puts) (SLsmg_Char_Type *, SLsmg_Char_Type *, int, int) = SLtt_smart_puts; -static int (*tt_flush_output) (void) = SLtt_flush_output; -static int (*tt_reset_video) (void) = SLtt_reset_video; -static int (*tt_init_video) (void) = SLtt_init_video; -static int *tt_Screen_Rows = &SLtt_Screen_Rows; -static int *tt_Screen_Cols = &SLtt_Screen_Cols; - -#ifndef IBMPC_SYSTEM -static void (*tt_set_scroll_region)(int, int) = SLtt_set_scroll_region; -static void (*tt_reverse_index)(int) = SLtt_reverse_index; -static void (*tt_reset_scroll_region)(void) = SLtt_reset_scroll_region; -static void (*tt_delete_nlines)(int) = SLtt_delete_nlines; -#endif - -#ifndef IBMPC_SYSTEM -static int *tt_Term_Cannot_Scroll = &SLtt_Term_Cannot_Scroll; -static int *tt_Has_Alt_Charset = &SLtt_Has_Alt_Charset; -static char **tt_Graphics_Char_Pairs = &SLtt_Graphics_Char_Pairs; -static int *tt_Use_Blink_For_ACS = &SLtt_Use_Blink_For_ACS; -#endif - -static int Smg_Inited; - -static void blank_line (SLsmg_Char_Type *p, int n, unsigned char ch) -{ - register SLsmg_Char_Type *pmax = p + n; - register SLsmg_Char_Type color_ch; - - color_ch = SLSMG_BUILD_CHAR(ch,This_Color); - - while (p < pmax) - { - *p++ = color_ch; - } -} - -static void clear_region (int row, int n) -{ - int i; - int imax = row + n; - - if (imax > Screen_Rows) imax = Screen_Rows; - for (i = row; i < imax; i++) - { - if (i >= 0) - { - blank_line (SL_Screen[i].neew, Screen_Cols, ' '); - SL_Screen[i].flags |= TOUCHED; - } - } -} - -void SLsmg_erase_eol (void) -{ - int r, c; - - if (Smg_Inited == 0) return; - - c = This_Col - Start_Col; - r = This_Row - Start_Row; - - if ((r < 0) || (r >= Screen_Rows)) return; - if (c < 0) c = 0; else if (c >= Screen_Cols) return; - blank_line (SL_Screen[This_Row].neew + c , Screen_Cols - c, ' '); - SL_Screen[This_Row].flags |= TOUCHED; -} - -static void scroll_up (void) -{ - unsigned int i, imax; - SLsmg_Char_Type *neew; - - neew = SL_Screen[0].neew; - imax = Screen_Rows - 1; - for (i = 0; i < imax; i++) - { - SL_Screen[i].neew = SL_Screen[i + 1].neew; - SL_Screen[i].flags |= TOUCHED; - } - SL_Screen[i].neew = neew; - SL_Screen[i].flags |= TOUCHED; - blank_line (neew, Screen_Cols, ' '); - This_Row--; -} - -void SLsmg_gotorc (int r, int c) -{ - This_Row = r; - This_Col = c; -} - -int SLsmg_get_row (void) -{ - return This_Row; -} - -int SLsmg_get_column (void) -{ - return This_Col; -} - -void SLsmg_erase_eos (void) -{ - if (Smg_Inited == 0) return; - - SLsmg_erase_eol (); - clear_region (This_Row + 1, Screen_Rows); -} - -static int This_Alt_Char; - -void SLsmg_set_char_set (int i) -{ -#ifdef IBMPC_SYSTEM - (void) i; -#else - if ((tt_Use_Blink_For_ACS != NULL) - && (*tt_Use_Blink_For_ACS != 0)) - return;/* alt chars not used and the alt bit - * is used to indicate a blink. - */ - - if (i) This_Alt_Char = ALT_CHAR_FLAG; - else This_Alt_Char = 0; - - This_Color &= 0x7F; - This_Color |= This_Alt_Char; -#endif -} - -void SLsmg_set_color (int color) -{ - if (color < 0) return; -#ifdef REQUIRES_NON_BCE_SUPPORT - color += Bce_Color_Offset; -#endif - This_Color = color | This_Alt_Char; -} - -void SLsmg_reverse_video (void) -{ - SLsmg_set_color (1); -} - -void SLsmg_normal_video (void) -{ - SLsmg_set_color (0); -} - -static int point_visible (int col_too) -{ - return ((This_Row >= Start_Row) && (This_Row < Start_Row + Screen_Rows) - && ((col_too == 0) - || ((This_Col >= Start_Col) - && (This_Col < Start_Col + Screen_Cols)))); -} - -void SLsmg_write_string (char *str) -{ - SLsmg_write_nchars (str, strlen (str)); -} - -void SLsmg_write_nstring (char *str, unsigned int n) -{ - unsigned int width; - char blank = ' '; - - /* Avoid a problem if a user accidently passes a negative value */ - if ((int) n < 0) - return; - - if (str == NULL) width = 0; - else - { - width = strlen (str); - if (width > n) width = n; - SLsmg_write_nchars (str, width); - } - while (width++ < n) SLsmg_write_nchars (&blank, 1); -} - -void SLsmg_write_wrapped_string (char *s, int r, int c, - unsigned int dr, unsigned int dc, - int fill) -{ - register char ch, *p; - int maxc = (int) dc; - - if ((dr == 0) || (dc == 0)) return; - p = s; - dc = 0; - while (1) - { - ch = *p++; - if ((ch == 0) || (ch == '\n')) - { - int diff; - - diff = maxc - (int) dc; - - SLsmg_gotorc (r, c); - SLsmg_write_nchars (s, dc); - if (fill && (diff > 0)) - { - while (diff--) SLsmg_write_char (' '); - } - if ((ch == 0) || (dr == 1)) break; - - r++; - dc = 0; - dr--; - s = p; - } - else if ((int) dc == maxc) - { - SLsmg_gotorc (r, c); - SLsmg_write_nchars (s, dc + 1); - if (dr == 1) break; - - r++; - dc = 0; - dr--; - s = p; - } - else dc++; - } -} - -int SLsmg_Tab_Width = 8; - -/* Minimum value for which eight bit char is displayed as is. */ - -#ifndef IBMPC_SYSTEM -int SLsmg_Display_Eight_Bit = 160; -static unsigned char Alt_Char_Set[129];/* 129th is used as a flag */ -#else -int SLsmg_Display_Eight_Bit = 128; -#endif - -void SLsmg_write_nchars (char *str, unsigned int n) -{ - register SLsmg_Char_Type *p, old, neew, color; - unsigned char ch; - unsigned int flags; - int len, start_len, max_len; - char *str_max; - int newline_flag; -#ifndef IBMPC_SYSTEM - int alt_char_set_flag; - - alt_char_set_flag = ((This_Color & ALT_CHAR_FLAG) - && ((tt_Use_Blink_For_ACS == NULL) - || (*tt_Use_Blink_For_ACS == 0))); -#endif - - if (Smg_Inited == 0) return; - - str_max = str + n; - color = This_Color; - - top: /* get here only on newline */ - - newline_flag = 0; - start_len = Start_Col; - - if (point_visible (0) == 0) return; - - len = This_Col; - max_len = start_len + Screen_Cols; - - p = SL_Screen[This_Row - Start_Row].neew; - if (len > start_len) p += (len - start_len); - - flags = SL_Screen[This_Row - Start_Row].flags; - while ((len < max_len) && (str < str_max)) - { - ch = (unsigned char) *str++; - -#ifndef IBMPC_SYSTEM - if (alt_char_set_flag) - ch = Alt_Char_Set [ch & 0x7F]; -#endif - if (((ch >= ' ') && (ch < 127)) - || (ch >= (unsigned char) SLsmg_Display_Eight_Bit) -#ifndef IBMPC_SYSTEM - || alt_char_set_flag -#endif - ) - { - len += 1; - if (len > start_len) - { - old = *p; - neew = SLSMG_BUILD_CHAR(ch,color); - if (old != neew) - { - flags |= TOUCHED; - *p = neew; - } - p++; - } - } - - else if ((ch == '\t') && (SLsmg_Tab_Width > 0)) - { - n = len; - n += SLsmg_Tab_Width; - n = SLsmg_Tab_Width - (n % SLsmg_Tab_Width); - if ((unsigned int) len + n > (unsigned int) max_len) - n = (unsigned int) (max_len - len); - neew = SLSMG_BUILD_CHAR(' ',color); - while (n--) - { - len += 1; - if (len > start_len) - { - if (*p != neew) - { - flags |= TOUCHED; - *p = neew; - } - p++; - } - } - } - else if ((ch == '\n') - && (SLsmg_Newline_Behavior != SLSMG_NEWLINE_PRINTABLE)) - { - newline_flag = 1; - break; - } - else if ((ch == 0x8) && SLsmg_Backspace_Moves) - { - if (len != 0) len--; - } - else - { - if (ch & 0x80) - { - neew = SLSMG_BUILD_CHAR('~',color); - len += 1; - if (len > start_len) - { - if (*p != neew) - { - *p = neew; - flags |= TOUCHED; - } - p++; - if (len == max_len) break; - ch &= 0x7F; - } - } - - len += 1; - if (len > start_len) - { - neew = SLSMG_BUILD_CHAR('^',color); - if (*p != neew) - { - *p = neew; - flags |= TOUCHED; - } - p++; - if (len == max_len) break; - } - - if (ch == 127) ch = '?'; else ch = ch + '@'; - len++; - if (len > start_len) - { - neew = SLSMG_BUILD_CHAR(ch,color); - if (*p != neew) - { - *p = neew; - flags |= TOUCHED; - } - p++; - } - } - } - - SL_Screen[This_Row - Start_Row].flags = flags; - This_Col = len; - - if (SLsmg_Newline_Behavior == 0) - return; - - if (newline_flag == 0) - { - while (str < str_max) - { - if (*str == '\n') break; - str++; - } - if (str == str_max) return; - str++; - } - - This_Row++; - This_Col = 0; - if (This_Row == Start_Row + Screen_Rows) - { - if (SLsmg_Newline_Behavior == SLSMG_NEWLINE_SCROLLS) scroll_up (); - } - goto top; -} - -void SLsmg_write_char (char ch) -{ - SLsmg_write_nchars (&ch, 1); -} - -static int Cls_Flag; - -void SLsmg_cls (void) -{ - int tac; - if (Smg_Inited == 0) return; - - tac = This_Alt_Char; This_Alt_Char = 0; - SLsmg_set_color (0); - clear_region (0, Screen_Rows); - This_Alt_Char = tac; - SLsmg_set_color (0); - Cls_Flag = 1; -} -#if 0 -static void do_copy (SLsmg_Char_Type *a, SLsmg_Char_Type *b) -{ - SLsmg_Char_Type *amax = a + Screen_Cols; - - while (a < amax) *a++ = *b++; -} -#endif - -#ifndef IBMPC_SYSTEM -int SLsmg_Scroll_Hash_Border = 0; -static unsigned long compute_hash (SLsmg_Char_Type *s, int n) -{ - register unsigned long h = 0, g; - register unsigned long sum = 0; - register SLsmg_Char_Type *smax, ch; - int is_blank = 2; - - s += SLsmg_Scroll_Hash_Border; - smax = s + (n - SLsmg_Scroll_Hash_Border); - while (s < smax) - { - ch = *s++; - if (is_blank && (SLSMG_EXTRACT_CHAR(ch) != 32)) is_blank--; - - sum += ch; - - h = sum + (h << 3); - if ((g = h & 0xE0000000UL) != 0) - { - h = h ^ (g >> 24); - h = h ^ g; - } - } - if (is_blank) return 0; - return h; -} - -static unsigned long Blank_Hash; - -static int try_scroll_down (int rmin, int rmax) -{ - int i, r1, r2, di, j; - unsigned long hash; - int did_scroll; - int color; - SLsmg_Char_Type *tmp; - int ignore; - - did_scroll = 0; - for (i = rmax; i > rmin; i--) - { - hash = SL_Screen[i].new_hash; - if (hash == Blank_Hash) continue; - - if ((hash == SL_Screen[i].old_hash) -#if 0 - || ((i + 1 < Screen_Rows) && (hash == SL_Screen[i + 1].old_hash)) - || ((i - 1 > rmin) && (SL_Screen[i].old_hash == SL_Screen[i - 1].new_hash)) -#endif - ) - continue; - - for (j = i - 1; j >= rmin; j--) - { - if (hash == SL_Screen[j].old_hash) break; - } - if (j < rmin) continue; - - r2 = i; /* end scroll region */ - - di = i - j; - j--; - ignore = 0; - while ((j >= rmin) && (SL_Screen[j].old_hash == SL_Screen[j + di].new_hash)) - { - if (SL_Screen[j].old_hash == Blank_Hash) ignore++; - j--; - } - r1 = j + 1; - - /* If this scroll only scrolls this line into place, don't do it. - */ - if ((di > 1) && (r1 + di + ignore == r2)) continue; - - /* If there is anything in the scrolling region that is ok, abort the - * scroll. - */ - - for (j = r1; j <= r2; j++) - { - if ((SL_Screen[j].old_hash != Blank_Hash) - && (SL_Screen[j].old_hash == SL_Screen[j].new_hash)) - { - /* See if the scroll is happens to scroll this one into place. */ - if ((j + di > r2) || (SL_Screen[j].old_hash != SL_Screen[j + di].new_hash)) - break; - } - } - if (j <= r2) continue; - - color = This_Color; This_Color = 0; - did_scroll = 1; - (*tt_normal_video) (); - (*tt_set_scroll_region) (r1, r2); - (*tt_goto_rc) (0, 0); - (*tt_reverse_index) (di); - (*tt_reset_scroll_region) (); - /* Now we have a hole in the screen. - * Make the virtual screen look like it. - * - * Note that if the terminal does not support BCE, then we have - * no idea what color the hole is. So, for this case, we do not - * want to add Bce_Color_Offset to This_Color since if Bce_Color_Offset - * is non-zero, then This_Color = 0 does not match any valid color - * obtained by adding Bce_Color_Offset. - */ - for (j = r1; j <= r2; j++) SL_Screen[j].flags = TOUCHED; - - while (di--) - { - tmp = SL_Screen[r2].old; - for (j = r2; j > r1; j--) - { - SL_Screen[j].old = SL_Screen[j - 1].old; - SL_Screen[j].old_hash = SL_Screen[j - 1].old_hash; - } - SL_Screen[r1].old = tmp; - blank_line (SL_Screen[r1].old, Screen_Cols, ' '); - SL_Screen[r1].old_hash = Blank_Hash; - r1++; - } - This_Color = color; - } - - return did_scroll; -} - -static int try_scroll_up (int rmin, int rmax) -{ - int i, r1, r2, di, j; - unsigned long hash; - int did_scroll; - int color; - SLsmg_Char_Type *tmp; - int ignore; - - did_scroll = 0; - for (i = rmin; i < rmax; i++) - { - hash = SL_Screen[i].new_hash; - if (hash == Blank_Hash) continue; - if (hash == SL_Screen[i].old_hash) - continue; - /* find a match further down screen */ - for (j = i + 1; j <= rmax; j++) - { - if (hash == SL_Screen[j].old_hash) break; - } - if (j > rmax) continue; - - r1 = i; /* beg scroll region */ - di = j - i; /* number of lines to scroll */ - j++; /* since we know this is a match */ - - /* find end of scroll region */ - ignore = 0; - while ((j <= rmax) && (SL_Screen[j].old_hash == SL_Screen[j - di].new_hash)) - { - if (SL_Screen[j].old_hash == Blank_Hash) ignore++; - j++; - } - r2 = j - 1; /* end of scroll region */ - - /* If this scroll only scrolls this line into place, don't do it. - */ - if ((di > 1) && (r1 + di + ignore == r2)) continue; - - /* If there is anything in the scrolling region that is ok, abort the - * scroll. - */ - - for (j = r1; j <= r2; j++) - { - if ((SL_Screen[j].old_hash != Blank_Hash) - && (SL_Screen[j].old_hash == SL_Screen[j].new_hash)) - { - if ((j - di < r1) || (SL_Screen[j].old_hash != SL_Screen[j - di].new_hash)) - break; - } - - } - if (j <= r2) continue; - - did_scroll = 1; - - /* See the above comments about BCE */ - color = This_Color; This_Color = 0; - (*tt_normal_video) (); - (*tt_set_scroll_region) (r1, r2); - (*tt_goto_rc) (0, 0); /* relative to scroll region */ - (*tt_delete_nlines) (di); - (*tt_reset_scroll_region) (); - /* Now we have a hole in the screen. Make the virtual screen look - * like it. - */ - for (j = r1; j <= r2; j++) SL_Screen[j].flags = TOUCHED; - - while (di--) - { - tmp = SL_Screen[r1].old; - for (j = r1; j < r2; j++) - { - SL_Screen[j].old = SL_Screen[j + 1].old; - SL_Screen[j].old_hash = SL_Screen[j + 1].old_hash; - } - SL_Screen[r2].old = tmp; - blank_line (SL_Screen[r2].old, Screen_Cols, ' '); - SL_Screen[r2].old_hash = Blank_Hash; - r2--; - } - This_Color = color; - } - return did_scroll; -} - -static void try_scroll (void) -{ - int r1, rmin, rmax; - int num_up, num_down; - /* find region limits. */ - - for (rmax = Screen_Rows - 1; rmax > 0; rmax--) - { - if (SL_Screen[rmax].new_hash != SL_Screen[rmax].old_hash) - { - r1 = rmax - 1; - if ((r1 == 0) - || (SL_Screen[r1].new_hash != SL_Screen[r1].old_hash)) - break; - - rmax = r1; - } - } - - for (rmin = 0; rmin < rmax; rmin++) - { - if (SL_Screen[rmin].new_hash != SL_Screen[rmin].old_hash) - { - r1 = rmin + 1; - if ((r1 == rmax) - || (SL_Screen[r1].new_hash != SL_Screen[r1].old_hash)) - break; - - rmin = r1; - } - } - - /* Below, we have two scrolling algorithms. The first has the effect of - * scrolling lines down. This is usually appropriate when one moves - * up the display, e.g., with the UP arrow. The second algorithm is - * appropriate for going the other way. It is important to choose the - * correct one. - */ - - num_up = 0; - for (r1 = rmin; r1 < rmax; r1++) - { - if (SL_Screen[r1].new_hash == SL_Screen[r1 + 1].old_hash) - num_up++; - } - - num_down = 0; - for (r1 = rmax; r1 > rmin; r1--) - { - if (SL_Screen[r1 - 1].old_hash == SL_Screen[r1].new_hash) - num_down++; - } - - if (num_up > num_down) - { - if (try_scroll_up (rmin, rmax)) - return; - - (void) try_scroll_down (rmin, rmax); - } - else - { - if (try_scroll_down (rmin, rmax)) - return; - - (void) try_scroll_up (rmin, rmax); - } -} -#endif /* NOT IBMPC_SYSTEM */ - - -#ifdef REQUIRES_NON_BCE_SUPPORT -static void adjust_colors (void) -{ - int bce; - int i; - - bce = Bce_Color_Offset; - Bce_Color_Offset = _SLtt_get_bce_color_offset (); - if (bce == Bce_Color_Offset) - return; - - if ((tt_Use_Blink_For_ACS != NULL) - && (*tt_Use_Blink_For_ACS != 0)) - return; /* this mode does not support non-BCE - * terminals. - */ - - for (i = 0; i < Screen_Rows; i++) - { - SLsmg_Char_Type *s, *smax; - - SL_Screen[i].flags |= TRASHED; - s = SL_Screen[i].neew; - smax = s + Screen_Cols; - - while (s < smax) - { - int color = (int) SLSMG_EXTRACT_COLOR(*s); - int acs; - - if (color < 0) - { - s++; - continue; - } - - acs = color & 0x80; - color = (color & 0x7F) - bce; - color += Bce_Color_Offset; - if (color >= 0) - { - unsigned char ch = SLSMG_EXTRACT_CHAR(*s); - *s = SLSMG_BUILD_CHAR(ch, ((color&0x7F)|acs)); - } - s++; - } - } -} -#endif - -void SLsmg_refresh (void) -{ - int i; -#ifndef IBMPC_SYSTEM - int trashed = 0; -#endif - - if (Smg_Inited == 0) return; - - if (Screen_Trashed) - { - Cls_Flag = 1; - for (i = 0; i < Screen_Rows; i++) - SL_Screen[i].flags |= TRASHED; -#ifdef REQUIRES_NON_BCE_SUPPORT - adjust_colors (); -#endif - } - -#ifndef IBMPC_SYSTEM - for (i = 0; i < Screen_Rows; i++) - { - if (SL_Screen[i].flags == 0) continue; - SL_Screen[i].new_hash = compute_hash (SL_Screen[i].neew, Screen_Cols); - trashed = 1; - } -#endif - - if (Cls_Flag) - { - (*tt_normal_video) (); (*tt_cls) (); - } -#ifndef IBMPC_SYSTEM - else if (trashed && (*tt_Term_Cannot_Scroll == 0)) try_scroll (); -#endif - - for (i = 0; i < Screen_Rows; i++) - { - if (SL_Screen[i].flags == 0) continue; - - if (Cls_Flag || SL_Screen[i].flags & TRASHED) - { - int color = This_Color; - - if (Cls_Flag == 0) - { - (*tt_goto_rc) (i, 0); - (*tt_del_eol) (); - } - This_Color = 0; - blank_line (SL_Screen[i].old, Screen_Cols, ' '); - This_Color = color; - } - - SL_Screen[i].old[Screen_Cols] = 0; - SL_Screen[i].neew[Screen_Cols] = 0; - - (*tt_smart_puts) (SL_Screen[i].neew, SL_Screen[i].old, Screen_Cols, i); - - SLMEMCPY ((char *) SL_Screen[i].old, (char *) SL_Screen[i].neew, - Screen_Cols * sizeof (SLsmg_Char_Type)); - - SL_Screen[i].flags = 0; -#ifndef IBMPC_SYSTEM - SL_Screen[i].old_hash = SL_Screen[i].new_hash; -#endif - } - - if (point_visible (1)) (*tt_goto_rc) (This_Row - Start_Row, This_Col - Start_Col); - (*tt_flush_output) (); - Cls_Flag = 0; - Screen_Trashed = 0; -} - -static int compute_clip (int row, int n, int box_start, int box_end, - int *rmin, int *rmax) -{ - int row_max; - - if (n < 0) return 0; - if (row >= box_end) return 0; - row_max = row + n; - if (row_max <= box_start) return 0; - - if (row < box_start) row = box_start; - if (row_max >= box_end) row_max = box_end; - *rmin = row; - *rmax = row_max; - return 1; -} - -void SLsmg_touch_lines (int row, unsigned int n) -{ - int i; - int r1, r2; - - /* Allow this function to be called even when we are not initialied. - * Calling this function is useful after calling SLtt_set_color - * to force the display to be redrawn - */ - - if (Smg_Inited == 0) - return; - - if (0 == compute_clip (row, (int) n, Start_Row, Start_Row + Screen_Rows, &r1, &r2)) - return; - - r1 -= Start_Row; - r2 -= Start_Row; - for (i = r1; i < r2; i++) - { - SL_Screen[i].flags |= TRASHED; - } -} - -void SLsmg_touch_screen (void) -{ - Screen_Trashed = 1; -} - - -#ifndef IBMPC_SYSTEM -static char Fake_Alt_Char_Pairs [] = "a:j+k+l+m+q-t+u+v+w+x|n+`+f\\g#~o,<+>.v-^h#0#"; - -static void init_alt_char_set (void) -{ - int i; - unsigned char *p, *pmax, ch; - - if (Alt_Char_Set[128] == 128) return; - - i = 32; - memset ((char *)Alt_Char_Set, ' ', i); - while (i <= 128) - { - Alt_Char_Set [i] = i; - i++; - } - - /* Map to VT100 */ - if (*tt_Has_Alt_Charset) - { - if (tt_Graphics_Char_Pairs == NULL) p = NULL; - else p = (unsigned char *) *tt_Graphics_Char_Pairs; - if (p == NULL) return; - } - else p = (unsigned char *) Fake_Alt_Char_Pairs; - pmax = p + strlen ((char *) p); - - /* Some systems have messed up entries for this */ - while (p < pmax) - { - ch = *p++; - ch &= 0x7F; /* should be unnecessary */ - Alt_Char_Set [ch] = *p; - p++; - } -} -#endif - -#ifndef IBMPC_SYSTEM -# define BLOCK_SIGNALS SLsig_block_signals () -# define UNBLOCK_SIGNALS SLsig_unblock_signals () -#else -# define BLOCK_SIGNALS (void)0 -# define UNBLOCK_SIGNALS (void)0 -#endif - -static int Smg_Suspended; -int SLsmg_suspend_smg (void) -{ - BLOCK_SIGNALS; - - if (Smg_Suspended == 0) - { - (*tt_reset_video) (); - Smg_Suspended = 1; - } - - UNBLOCK_SIGNALS; - return 0; -} - -int SLsmg_resume_smg (void) -{ - BLOCK_SIGNALS; - - if (Smg_Suspended == 0) - { - UNBLOCK_SIGNALS; - return 0; - } - - Smg_Suspended = 0; - - if (-1 == (*tt_init_video) ()) - { - UNBLOCK_SIGNALS; - return -1; - } - - Cls_Flag = 1; - SLsmg_touch_screen (); - SLsmg_refresh (); - - UNBLOCK_SIGNALS; - return 0; -} - - -static void reset_smg (void) -{ - int i; - if (Smg_Inited == 0) - return; - - for (i = 0; i < Screen_Rows; i++) - { - SLfree ((char *)SL_Screen[i].old); - SLfree ((char *)SL_Screen[i].neew); - SL_Screen[i].old = SL_Screen[i].neew = NULL; - } - This_Alt_Char = This_Color = 0; - Smg_Inited = 0; -} - - -static int init_smg (void) -{ - int i, len; - SLsmg_Char_Type *old, *neew; - - Smg_Inited = 0; - -#ifdef REQUIRES_NON_BCE_SUPPORT - Bce_Color_Offset = _SLtt_get_bce_color_offset (); -#endif - - Screen_Rows = *tt_Screen_Rows; - if (Screen_Rows > MAX_SCREEN_SIZE) - Screen_Rows = MAX_SCREEN_SIZE; - - Screen_Cols = *tt_Screen_Cols; - - This_Col = This_Row = Start_Col = Start_Row = 0; - - This_Alt_Char = 0; - SLsmg_set_color (0); - Cls_Flag = 1; -#ifndef IBMPC_SYSTEM - init_alt_char_set (); -#endif - len = Screen_Cols + 3; - for (i = 0; i < Screen_Rows; i++) - { - if ((NULL == (old = (SLsmg_Char_Type *) SLmalloc (sizeof(SLsmg_Char_Type) * len))) - || ((NULL == (neew = (SLsmg_Char_Type *) SLmalloc (sizeof(SLsmg_Char_Type) * len))))) - { - SLfree ((char *) old); - return -1; - } - blank_line (old, len, ' '); - blank_line (neew, len, ' '); - SL_Screen[i].old = old; - SL_Screen[i].neew = neew; - SL_Screen[i].flags = 0; -#ifndef IBMPC_SYSTEM - Blank_Hash = compute_hash (old, Screen_Cols); - SL_Screen[i].new_hash = SL_Screen[i].old_hash = Blank_Hash; -#endif - } - - _SLtt_color_changed_hook = SLsmg_touch_screen; - Screen_Trashed = 1; - Smg_Inited = 1; - return 0; -} - - -int SLsmg_init_smg (void) -{ - int ret; - - BLOCK_SIGNALS; - - if (Smg_Inited) - SLsmg_reset_smg (); - - if (-1 == (*tt_init_video) ()) - { - UNBLOCK_SIGNALS; - return -1; - } - - if (-1 == (ret = init_smg ())) - (void) (*tt_reset_video)(); - - UNBLOCK_SIGNALS; - return ret; -} - -int SLsmg_reinit_smg (void) -{ - int ret; - - if (Smg_Inited == 0) - return SLsmg_init_smg (); - - BLOCK_SIGNALS; - reset_smg (); - ret = init_smg (); - UNBLOCK_SIGNALS; - return ret; -} - -void SLsmg_reset_smg (void) -{ - if (Smg_Inited == 0) - return; - - BLOCK_SIGNALS; - - reset_smg (); - (*tt_reset_video)(); - - UNBLOCK_SIGNALS; -} - -SLsmg_Char_Type SLsmg_char_at (void) -{ - if (Smg_Inited == 0) return 0; - - if (point_visible (1)) - { - return SL_Screen[This_Row - Start_Row].neew[This_Col - Start_Col]; - } - return 0; -} - -void SLsmg_vprintf (char *fmt, va_list ap) -{ - char buf[1024]; - - if (Smg_Inited == 0) return; - - (void) _SLvsnprintf (buf, sizeof (buf), fmt, ap); - SLsmg_write_string (buf); -} - -void SLsmg_printf (char *fmt, ...) -{ - va_list ap; - unsigned int len; - char *f; - - if (Smg_Inited == 0) return; - - va_start(ap, fmt); - - f = fmt; - while (*f && (*f != '%')) - f++; - len = (unsigned int) (f - fmt); - if (len) SLsmg_write_nchars (fmt, len); - - if (*f != 0) - SLsmg_vprintf (f, ap); - - va_end (ap); -} - -void SLsmg_set_screen_start (int *r, int *c) -{ - int orow = Start_Row, oc = Start_Col; - - if (Smg_Inited == 0) return; - - if (c == NULL) Start_Col = 0; - else - { - Start_Col = *c; - *c = oc; - } - if (r == NULL) Start_Row = 0; - else - { - Start_Row = *r; - *r = orow; - } -} - -void SLsmg_draw_object (int r, int c, unsigned char object) -{ - This_Row = r; This_Col = c; - - if (Smg_Inited == 0) return; - - if (point_visible (1)) - { - int color = This_Color; - This_Color |= ALT_CHAR_FLAG; - SLsmg_write_char (object); - This_Color = color; - } - - This_Col = c + 1; -} - -void SLsmg_draw_hline (unsigned int n) -{ - static unsigned char hbuf[16]; - int count; - int cmin, cmax; - int final_col = This_Col + (int) n; - int save_color; - - if (Smg_Inited == 0) return; - - if ((This_Row < Start_Row) || (This_Row >= Start_Row + Screen_Rows) - || (0 == compute_clip (This_Col, n, Start_Col, Start_Col + Screen_Cols, - &cmin, &cmax))) - { - This_Col = final_col; - return; - } - - if (hbuf[0] == 0) - { - SLMEMSET ((char *) hbuf, SLSMG_HLINE_CHAR, 16); - } - - n = (unsigned int)(cmax - cmin); - count = n / 16; - - save_color = This_Color; - This_Color |= ALT_CHAR_FLAG; - This_Col = cmin; - - SLsmg_write_nchars ((char *) hbuf, n % 16); - while (count-- > 0) - { - SLsmg_write_nchars ((char *) hbuf, 16); - } - - This_Color = save_color; - This_Col = final_col; -} - -void SLsmg_draw_vline (int n) -{ - unsigned char ch = SLSMG_VLINE_CHAR; - int c = This_Col, rmin, rmax; - int final_row = This_Row + n; - int save_color; - - if (Smg_Inited == 0) return; - - if (((c < Start_Col) || (c >= Start_Col + Screen_Cols)) || - (0 == compute_clip (This_Row, n, Start_Row, Start_Row + Screen_Rows, - &rmin, &rmax))) - { - This_Row = final_row; - return; - } - - save_color = This_Color; - This_Color |= ALT_CHAR_FLAG; - - for (This_Row = rmin; This_Row < rmax; This_Row++) - { - This_Col = c; - SLsmg_write_nchars ((char *) &ch, 1); - } - - This_Col = c; This_Row = final_row; - This_Color = save_color; -} - -void SLsmg_draw_box (int r, int c, unsigned int dr, unsigned int dc) -{ - if (Smg_Inited == 0) return; - - if (!dr || !dc) return; - This_Row = r; This_Col = c; - dr--; dc--; - SLsmg_draw_hline (dc); - SLsmg_draw_vline (dr); - This_Row = r; This_Col = c; - SLsmg_draw_vline (dr); - SLsmg_draw_hline (dc); - SLsmg_draw_object (r, c, SLSMG_ULCORN_CHAR); - SLsmg_draw_object (r, c + (int) dc, SLSMG_URCORN_CHAR); - SLsmg_draw_object (r + (int) dr, c, SLSMG_LLCORN_CHAR); - SLsmg_draw_object (r + (int) dr, c + (int) dc, SLSMG_LRCORN_CHAR); - This_Row = r; This_Col = c; -} - -void SLsmg_fill_region (int r, int c, unsigned int dr, unsigned int dc, unsigned char ch) -{ - static unsigned char hbuf[16]; - int count; - int dcmax, rmax; - - if (Smg_Inited == 0) return; - - SLsmg_gotorc (r, c); - r = This_Row; c = This_Col; - - dcmax = Screen_Cols - This_Col; - if (dcmax < 0) - return; - - if (dc > (unsigned int) dcmax) dc = (unsigned int) dcmax; - - rmax = This_Row + dr; - if (rmax > Screen_Rows) rmax = Screen_Rows; - -#if 0 - ch = Alt_Char_Set[ch]; -#endif - if (ch != hbuf[0]) SLMEMSET ((char *) hbuf, (char) ch, 16); - - for (This_Row = r; This_Row < rmax; This_Row++) - { - This_Col = c; - count = dc / 16; - SLsmg_write_nchars ((char *) hbuf, dc % 16); - while (count-- > 0) - { - SLsmg_write_nchars ((char *) hbuf, 16); - } - } - - This_Row = r; -} - -void SLsmg_forward (int n) -{ - This_Col += n; -} - -void SLsmg_write_color_chars (SLsmg_Char_Type *s, unsigned int len) -{ - SLsmg_Char_Type *smax, sh; - char buf[32], *b, *bmax; - int color, save_color; - - if (Smg_Inited == 0) return; - - smax = s + len; - b = buf; - bmax = b + sizeof (buf); - - save_color = This_Color; - - while (s < smax) - { - sh = *s++; - - color = SLSMG_EXTRACT_COLOR(sh); - -#if REQUIRES_NON_BCE_SUPPORT - if (Bce_Color_Offset) - { - if (color & 0x80) - color = ((color & 0x7F) + Bce_Color_Offset) | 0x80; - else - color = ((color & 0x7F) + Bce_Color_Offset) & 0x7F; - } -#endif - - if ((color != This_Color) || (b == bmax)) - { - if (b != buf) - { - SLsmg_write_nchars (buf, (int) (b - buf)); - b = buf; - } - This_Color = color; - } - *b++ = (char) SLSMG_EXTRACT_CHAR(sh); - } - - if (b != buf) - SLsmg_write_nchars (buf, (unsigned int) (b - buf)); - - This_Color = save_color; -} - -unsigned int SLsmg_read_raw (SLsmg_Char_Type *buf, unsigned int len) -{ - unsigned int r, c; - - if (Smg_Inited == 0) return 0; - - if (0 == point_visible (1)) return 0; - - r = (unsigned int) (This_Row - Start_Row); - c = (unsigned int) (This_Col - Start_Col); - - if (c + len > (unsigned int) Screen_Cols) - len = (unsigned int) Screen_Cols - c; - - memcpy ((char *) buf, (char *) (SL_Screen[r].neew + c), len * sizeof (SLsmg_Char_Type)); - return len; -} - -unsigned int SLsmg_write_raw (SLsmg_Char_Type *buf, unsigned int len) -{ - unsigned int r, c; - SLsmg_Char_Type *dest; - - if (Smg_Inited == 0) return 0; - - if (0 == point_visible (1)) return 0; - - r = (unsigned int) (This_Row - Start_Row); - c = (unsigned int) (This_Col - Start_Col); - - if (c + len > (unsigned int) Screen_Cols) - len = (unsigned int) Screen_Cols - c; - - dest = SL_Screen[r].neew + c; - - if (0 != memcmp ((char *) dest, (char *) buf, len * sizeof (SLsmg_Char_Type))) - { - memcpy ((char *) dest, (char *) buf, len * sizeof (SLsmg_Char_Type)); - SL_Screen[r].flags |= TOUCHED; - } - return len; -} - -void -SLsmg_set_color_in_region (int color, int r, int c, unsigned int dr, unsigned int dc) -{ - int cmax, rmax; - SLsmg_Char_Type char_mask; - - if (Smg_Inited == 0) return; - - c -= Start_Col; - r -= Start_Row; - - cmax = c + (int) dc; - rmax = r + (int) dr; - - if (cmax > Screen_Cols) cmax = Screen_Cols; - if (rmax > Screen_Rows) rmax = Screen_Rows; - - if (c < 0) c = 0; - if (r < 0) r = 0; - -#if REQUIRES_NON_BCE_SUPPORT - if (Bce_Color_Offset) - { - if (color & 0x80) - color = ((color & 0x7F) + Bce_Color_Offset) | 0x80; - else - color = ((color & 0x7F) + Bce_Color_Offset) & 0x7F; - } -#endif - color = color << 8; - - char_mask = 0xFF; - -#ifndef IBMPC_SYSTEM - if ((tt_Use_Blink_For_ACS == NULL) - || (0 == *tt_Use_Blink_For_ACS)) - char_mask = 0x80FF; -#endif - - while (r < rmax) - { - SLsmg_Char_Type *s, *smax; - - SL_Screen[r].flags |= TOUCHED; - s = SL_Screen[r].neew; - smax = s + cmax; - s += c; - - while (s < smax) - { - *s = (*s & char_mask) | color; - s++; - } - r++; - } -} - -void SLsmg_set_terminal_info (SLsmg_Term_Type *tt) -{ - if (tt == NULL) /* use default */ - return; - - if ((tt->tt_normal_video == NULL) - || (tt->tt_goto_rc == NULL) - || (tt->tt_cls == NULL) - || (tt->tt_del_eol == NULL) - || (tt->tt_smart_puts == NULL) - || (tt->tt_flush_output == NULL) - || (tt->tt_reset_video == NULL) - || (tt->tt_init_video == NULL) -#ifndef IBMPC_SYSTEM - || (tt->tt_set_scroll_region == NULL) - || (tt->tt_reverse_index == NULL) - || (tt->tt_reset_scroll_region == NULL) - || (tt->tt_delete_nlines == NULL) - /* Variables */ - || (tt->tt_term_cannot_scroll == NULL) - || (tt->tt_has_alt_charset == NULL) -#if 0 /* These can be NULL */ - || (tt->tt_use_blink_for_acs == NULL) - || (tt->tt_graphic_char_pairs == NULL) -#endif - || (tt->tt_screen_cols == NULL) - || (tt->tt_screen_rows == NULL) -#endif - ) - SLang_exit_error ("Terminal not powerful enough for SLsmg"); - - tt_normal_video = tt->tt_normal_video; - tt_goto_rc = tt->tt_goto_rc; - tt_cls = tt->tt_cls; - tt_del_eol = tt->tt_del_eol; - tt_smart_puts = tt->tt_smart_puts; - tt_flush_output = tt->tt_flush_output; - tt_reset_video = tt->tt_reset_video; - tt_init_video = tt->tt_init_video; - -#ifndef IBMPC_SYSTEM - tt_set_scroll_region = tt->tt_set_scroll_region; - tt_reverse_index = tt->tt_reverse_index; - tt_reset_scroll_region = tt->tt_reset_scroll_region; - tt_delete_nlines = tt->tt_delete_nlines; - - tt_Term_Cannot_Scroll = tt->tt_term_cannot_scroll; - tt_Has_Alt_Charset = tt->tt_has_alt_charset; - tt_Use_Blink_For_ACS = tt->tt_use_blink_for_acs; - tt_Graphics_Char_Pairs = tt->tt_graphic_char_pairs; -#endif - - tt_Screen_Cols = tt->tt_screen_cols; - tt_Screen_Rows = tt->tt_screen_rows; -} - diff --git a/mdk-stage1/slang/slstd.c b/mdk-stage1/slang/slstd.c deleted file mode 100644 index b05dfcddb..000000000 --- a/mdk-stage1/slang/slstd.c +++ /dev/null @@ -1,724 +0,0 @@ -/* -*- mode: C; mode: fold; -*- */ -/* Standard intrinsic functions for S-Lang. Included here are string - and array operations */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" -/*{{{ Include Files */ - -#include <time.h> - -#ifndef __QNX__ -# if defined(__GO32__) || defined(__WATCOMC__) -# include <dos.h> -# include <bios.h> -# endif -#endif - -#if SLANG_HAS_FLOAT -# include <math.h> -#endif - -#include "slang.h" -#include "_slang.h" - -/*}}}*/ - -/* builtin stack manipulation functions */ -int SLdo_pop(void) /*{{{*/ -{ - return SLdo_pop_n (1); -} - -/*}}}*/ - -int SLdo_pop_n (unsigned int n) -{ - SLang_Object_Type x; - - while (n--) - { - if (SLang_pop(&x)) return -1; - SLang_free_object (&x); - } - - return 0; -} - -static void do_dup(void) /*{{{*/ -{ - (void) SLdup_n (1); -} - -/*}}}*/ - -static int length_cmd (void) -{ - SLang_Class_Type *cl; - SLang_Object_Type obj; - VOID_STAR p; - unsigned int length; - int len; - - if (-1 == SLang_pop (&obj)) - return -1; - - cl = _SLclass_get_class (obj.data_type); - p = _SLclass_get_ptr_to_value (cl, &obj); - - len = 1; - if (cl->cl_length != NULL) - { - if (0 == (*cl->cl_length)(obj.data_type, p, &length)) - len = (int) length; - else - len = -1; - } - - SLang_free_object (&obj); - return len; -} - -/* convert integer to a string of length 1 */ -static void char_cmd (int *x) /*{{{*/ -{ - char ch, buf[2]; - - ch = (char) *x; - buf[0] = ch; - buf[1] = 0; - SLang_push_string (buf); -} - -/*}}}*/ - -/* format object into a string and returns slstring */ -char *_SLstringize_object (SLang_Object_Type *obj) /*{{{*/ -{ - SLang_Class_Type *cl; - unsigned char stype; - VOID_STAR p; - char *s, *s1; - - stype = obj->data_type; - p = (VOID_STAR) &obj->v.ptr_val; - - cl = _SLclass_get_class (stype); - - s = (*cl->cl_string) (stype, p); - if (s != NULL) - { - s1 = SLang_create_slstring (s); - SLfree (s); - s = s1; - } - return s; -} -/*}}}*/ - -int SLang_run_hooks(char *hook, unsigned int num_args, ...) -{ - unsigned int i; - va_list ap; - - if (SLang_Error) return -1; - - if (0 == SLang_is_defined (hook)) - return 0; - - (void) SLang_start_arg_list (); - va_start (ap, num_args); - for (i = 0; i < num_args; i++) - { - char *arg; - - arg = va_arg (ap, char *); - if (-1 == SLang_push_string (arg)) - break; - } - va_end (ap); - (void) SLang_end_arg_list (); - - if (SLang_Error) return -1; - return SLang_execute_function (hook); -} - -static void intrin_getenv_cmd (char *s) -{ - SLang_push_string (getenv (s)); -} - -#ifdef HAVE_PUTENV -static void intrin_putenv (void) /*{{{*/ -{ - char *s; - - /* Some putenv implementations required malloced strings. */ - if (SLpop_string(&s)) return; - - if (putenv (s)) - { - SLang_Error = SL_INTRINSIC_ERROR; - SLfree (s); - } - - /* Note that s is NOT freed */ -} - -/*}}}*/ - -#endif - -static void lang_print_stack (void) /*{{{*/ -{ - char buf[32]; - unsigned int n; - - n = (unsigned int) (_SLStack_Pointer - _SLRun_Stack); - while (n) - { - n--; - sprintf (buf, "(%u)", n); - _SLdump_objects (buf, _SLRun_Stack + n, 1, 1); - } -} - -/*}}}*/ - -static void byte_compile_file (char *f, int *m) -{ - SLang_byte_compile_file (f, *m); -} - -static void intrin_type_info1 (void) -{ - SLang_Object_Type obj; - unsigned int type; - - if (-1 == SLang_pop (&obj)) - return; - - type = obj.data_type; - if (type == SLANG_ARRAY_TYPE) - type = obj.v.array_val->data_type; - - SLang_free_object (&obj); - - _SLang_push_datatype (type); -} - -static void intrin_type_info (void) -{ - SLang_Object_Type obj; - - if (-1 == SLang_pop (&obj)) - return; - - _SLang_push_datatype (obj.data_type); - SLang_free_object (&obj); -} - -void _SLstring_intrinsic (void) /*{{{*/ -{ - SLang_Object_Type x; - char *s; - - if (SLang_pop (&x)) return; - if (NULL != (s = _SLstringize_object (&x))) - _SLang_push_slstring (s); - - SLang_free_object (&x); -} - -/*}}}*/ - -static void intrin_typecast (void) -{ - unsigned char to_type; - if (0 == _SLang_pop_datatype (&to_type)) - (void) SLclass_typecast (to_type, 0, 1); -} - -#if SLANG_HAS_FLOAT -static void intrin_double (void) -{ - (void) SLclass_typecast (SLANG_DOUBLE_TYPE, 0, 1); -} - -#endif - -static void intrin_int (void) /*{{{*/ -{ - (void) SLclass_typecast (SLANG_INT_TYPE, 0, 1); -} - -/*}}}*/ - -static char * -intrin_function_name (void) -{ - if (NULL == _SLang_Current_Function_Name) - return ""; - return _SLang_Current_Function_Name; -} - -static void intrin_message (char *s) -{ - SLang_vmessage ("%s", s); -} - -static void intrin_error (char *s) -{ - SLang_verror (SL_USER_ERROR, "%s", s); -} - -static void intrin_pop_n (int *n) -{ - SLdo_pop_n ((unsigned int) *n); -} - -static void intrin_reverse_stack (int *n) -{ - SLreverse_stack (*n); -} - -static void intrin_roll_stack (int *n) -{ - SLroll_stack (*n); -} - -static void usage (void) -{ - char *msg; - - _SLstrops_do_sprintf_n (SLang_Num_Function_Args - 1); /* do not include format */ - - if (-1 == SLang_pop_slstring (&msg)) - return; - - SLang_verror (SL_USAGE_ERROR, "Usage: %s", msg); - SLang_free_slstring (msg); -} - -/* Convert string to integer */ -static int intrin_integer (char *s) -{ - int i; - - i = SLatoi ((unsigned char *) s); - - if (SLang_Error) - SLang_verror (SL_TYPE_MISMATCH, "Unable to convert string to integer"); - return i; -} -/*}}}*/ - -static void guess_type (char *s) -{ - _SLang_push_datatype (SLang_guess_type(s)); -} - -static int load_file (char *s) -{ - if (-1 == SLang_load_file (s)) - return 0; - return 1; -} - -static void get_doc_string (char *file, char *topic) -{ - FILE *fp; - char line[1024]; - unsigned int topic_len, str_len; - char *str; - char ch; - - if (NULL == (fp = fopen (file, "r"))) - { - SLang_push_null (); - return; - } - - topic_len = strlen (topic); - ch = *topic; - - while (1) - { - if (NULL == fgets (line, sizeof(line), fp)) - { - fclose (fp); - (void) SLang_push_null (); - return; - } - - if ((ch == *line) - && (0 == strncmp (line, topic, topic_len)) - && ((line[topic_len] == '\n') || (line [topic_len] == 0) - || (line[topic_len] == ' ') || (line[topic_len] == '\t'))) - break; - } - - if (NULL == (str = SLmake_string (line))) - { - fclose (fp); - (void) SLang_push_null (); - return; - } - str_len = strlen (str); - - while (NULL != fgets (line, sizeof (line), fp)) - { - unsigned int len; - char *new_str; - - ch = *line; - if (ch == '#') continue; - if (ch == '-') break; - - len = strlen (line); - if (NULL == (new_str = SLrealloc (str, str_len + len + 1))) - { - SLfree (str); - str = NULL; - break; - } - str = new_str; - strcpy (str + str_len, line); - str_len += len; - } - - fclose (fp); - - (void) SLang_push_malloced_string (str); -} - -static int push_string_array_elements (SLang_Array_Type *at) -{ - char **strs; - unsigned int num; - unsigned int i; - - if (at == NULL) - return -1; - - strs = (char **)at->data; - num = at->num_elements; - for (i = 0; i < num; i++) - { - if (-1 == SLang_push_string (strs[i])) - { - SLdo_pop_n (i); - return -1; - } - } - SLang_push_integer ((int) num); - return 0; -} - - -static void intrin_apropos (void) -{ - int num_args; - char *pat; - char *namespace_name; - unsigned int flags; - SLang_Array_Type *at; - - num_args = SLang_Num_Function_Args; - - if (-1 == SLang_pop_uinteger (&flags)) - return; - if (-1 == SLang_pop_slstring (&pat)) - return; - - namespace_name = NULL; - at = NULL; - if (num_args == 3) - { - if (-1 == SLang_pop_slstring (&namespace_name)) - goto free_and_return; - } - - at = _SLang_apropos (namespace_name, pat, flags); - if (num_args == 3) - { - (void) SLang_push_array (at, 0); - goto free_and_return; - } - - /* Maintain compatibility with old version of the function. That version - * did not take three arguments and returned everything to the stack. - * Yuk. - */ - (void) push_string_array_elements (at); - - free_and_return: - /* NULLs ok */ - SLang_free_slstring (namespace_name); - SLang_free_slstring (pat); - SLang_free_array (at); -} - -static int intrin_get_defines (void) -{ - int n = 0; - char **s = _SLdefines; - - while (*s != NULL) - { - if (-1 == SLang_push_string (*s)) - { - SLdo_pop_n ((unsigned int) n); - return -1; - } - s++; - n++; - } - return n; -} - -static void intrin_get_reference (char *name) -{ - _SLang_push_ref (1, (VOID_STAR) _SLlocate_name (name)); -} - -#ifdef HAVE_SYS_UTSNAME_H -# include <sys/utsname.h> -#endif - -static void uname_cmd (void) -{ -#ifdef HAVE_UNAME - struct utsname u; - char *field_names [6]; - unsigned char field_types[6]; - VOID_STAR field_values [6]; - char *ptrs[6]; - int i; - - if (-1 == uname (&u)) - (void) SLang_push_null (); - - field_names[0] = "sysname"; ptrs[0] = u.sysname; - field_names[1] = "nodename"; ptrs[1] = u.nodename; - field_names[2] = "release"; ptrs[2] = u.release; - field_names[3] = "version"; ptrs[3] = u.version; - field_names[4] = "machine"; ptrs[4] = u.machine; - - for (i = 0; i < 5; i++) - { - field_types[i] = SLANG_STRING_TYPE; - field_values[i] = (VOID_STAR) &ptrs[i]; - } - - if (0 == SLstruct_create_struct (5, field_names, field_types, field_values)) - return; -#endif - - SLang_push_null (); -} - -static void uninitialize_ref_intrin (SLang_Ref_Type *ref) -{ - (void) _SLang_uninitialize_ref (ref); -} - -static SLang_Intrin_Fun_Type SLang_Basic_Table [] = /*{{{*/ -{ - MAKE_INTRINSIC_1("__is_initialized", _SLang_is_ref_initialized, SLANG_INT_TYPE, SLANG_REF_TYPE), - MAKE_INTRINSIC_S("__get_reference", intrin_get_reference, SLANG_VOID_TYPE), - MAKE_INTRINSIC_1("__uninitialize", uninitialize_ref_intrin, SLANG_VOID_TYPE, SLANG_REF_TYPE), - MAKE_INTRINSIC_SS("get_doc_string_from_file", get_doc_string, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SS("autoload", SLang_autoload, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("is_defined", SLang_is_defined, SLANG_INT_TYPE), - MAKE_INTRINSIC_0("string", _SLstring_intrinsic, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("uname", uname_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("getenv", intrin_getenv_cmd, SLANG_VOID_TYPE), -#ifdef HAVE_PUTENV - MAKE_INTRINSIC_0("putenv", intrin_putenv, SLANG_VOID_TYPE), -#endif - MAKE_INTRINSIC_S("evalfile", load_file, SLANG_INT_TYPE), - MAKE_INTRINSIC_I("char", char_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("eval", SLang_load_string, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("dup", do_dup, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("integer", intrin_integer, SLANG_INT_TYPE), - MAKE_INTRINSIC_S("system", SLsystem, SLANG_INT_TYPE), - MAKE_INTRINSIC_0("_apropos", intrin_apropos, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("_trace_function", _SLang_trace_fun, SLANG_VOID_TYPE), -#if SLANG_HAS_FLOAT - MAKE_INTRINSIC_S("atof", _SLang_atof, SLANG_DOUBLE_TYPE), - MAKE_INTRINSIC_0("double", intrin_double, SLANG_VOID_TYPE), -#endif - MAKE_INTRINSIC_0("int", intrin_int, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("typecast", intrin_typecast, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("_stkdepth", _SLstack_depth, SLANG_INT_TYPE), - MAKE_INTRINSIC_I("_stk_reverse", intrin_reverse_stack, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("typeof", intrin_type_info, VOID_TYPE), - MAKE_INTRINSIC_0("_typeof", intrin_type_info1, VOID_TYPE), - MAKE_INTRINSIC_I("_pop_n", intrin_pop_n, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("_print_stack", lang_print_stack, SLANG_VOID_TYPE), - MAKE_INTRINSIC_I("_stk_roll", intrin_roll_stack, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SI("byte_compile_file", byte_compile_file, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("_clear_error", _SLang_clear_error, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("_function_name", intrin_function_name, SLANG_STRING_TYPE), -#if SLANG_HAS_FLOAT - MAKE_INTRINSIC_S("set_float_format", _SLset_double_format, SLANG_VOID_TYPE), -#endif - MAKE_INTRINSIC_S("_slang_guess_type", guess_type, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("error", intrin_error, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("message", intrin_message, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("__get_defined_symbols", intrin_get_defines, SLANG_INT_TYPE), - MAKE_INTRINSIC_I("__pop_args", _SLstruct_pop_args, SLANG_VOID_TYPE), - MAKE_INTRINSIC_1("__push_args", _SLstruct_push_args, SLANG_VOID_TYPE, SLANG_ARRAY_TYPE), - MAKE_INTRINSIC_0("usage", usage, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("implements", _SLang_implements_intrinsic, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("use_namespace", _SLang_use_namespace_intrinsic, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("current_namespace", _SLang_cur_namespace_intrinsic, SLANG_STRING_TYPE), - MAKE_INTRINSIC_0("length", length_cmd, SLANG_INT_TYPE), - SLANG_END_INTRIN_FUN_TABLE -}; - -/*}}}*/ - -#ifdef SLANG_DOC_DIR -char *SLang_Doc_Dir = SLANG_DOC_DIR; -#else -char *SLang_Doc_Dir = ""; -#endif - -static SLang_Intrin_Var_Type Intrin_Vars[] = -{ - MAKE_VARIABLE("_debug_info", &_SLang_Compile_Line_Num_Info, SLANG_INT_TYPE, 0), - MAKE_VARIABLE("_auto_declare", &_SLang_Auto_Declare_Globals, SLANG_INT_TYPE, 0), - MAKE_VARIABLE("_traceback", &SLang_Traceback, SLANG_INT_TYPE, 0), - MAKE_VARIABLE("_slangtrace", &_SLang_Trace, SLANG_INT_TYPE, 0), - MAKE_VARIABLE("_slang_version", &SLang_Version, SLANG_INT_TYPE, 1), - MAKE_VARIABLE("_slang_version_string", &SLang_Version_String, SLANG_STRING_TYPE, 1), - MAKE_VARIABLE("_NARGS", &SLang_Num_Function_Args, SLANG_INT_TYPE, 1), - MAKE_VARIABLE("_slang_doc_dir", &SLang_Doc_Dir, SLANG_STRING_TYPE, 1), - MAKE_VARIABLE("NULL", NULL, SLANG_NULL_TYPE, 1), - SLANG_END_INTRIN_VAR_TABLE -}; - -int SLang_init_slang (void) /*{{{*/ -{ - char name[3]; - unsigned int i; - char **s; - static char *sys_defines [] = - { -#if defined(__os2__) - "OS2", -#endif -#if defined(__MSDOS__) - "MSDOS", -#endif -#if defined(__WIN16__) - "WIN16", -#endif -#if defined (__WIN32__) - "WIN32", -#endif -#if defined(__NT__) - "NT", -#endif -#if defined (VMS) - "VMS", -#endif -#ifdef REAL_UNIX_SYSTEM - "UNIX", -#endif -#if SLANG_HAS_FLOAT - "SLANG_DOUBLE_TYPE", -#endif - NULL - }; - - if (-1 == _SLregister_types ()) return -1; - - if ((-1 == SLadd_intrin_fun_table(SLang_Basic_Table, NULL)) - || (-1 == SLadd_intrin_var_table (Intrin_Vars, NULL)) - || (-1 == _SLang_init_slstrops ()) - || (-1 == _SLang_init_sltime ()) - || (-1 == _SLstruct_init ()) -#if SLANG_HAS_COMPLEX - || (-1 == _SLinit_slcomplex ()) -#endif -#if SLANG_HAS_ASSOC_ARRAYS - || (-1 == SLang_init_slassoc ()) -#endif - ) - return -1; - - SLadd_global_variable (SLANG_SYSTEM_NAME); - - s = sys_defines; - while (*s != NULL) - { - if (-1 == SLdefine_for_ifdef (*s)) return -1; - s++; - } - - /* give temp global variables $0 --> $9 */ - name[2] = 0; name[0] = '$'; - for (i = 0; i < 10; i++) - { - name[1] = (char) (i + '0'); - SLadd_global_variable (name); - } - - SLang_init_case_tables (); - - /* Now add a couple of macros */ - SLang_load_string (".(_NARGS 1 - Sprintf error)verror"); - SLang_load_string (".(_NARGS 1 - Sprintf message)vmessage"); - - if (SLang_Error) - return -1; - - return 0; -} - -/*}}}*/ - -int SLang_set_argc_argv (int argc, char **argv) -{ - static int this_argc; - static char **this_argv; - int i; - - if (argc < 0) argc = 0; - this_argc = argc; - - if (NULL == (this_argv = (char **) SLmalloc ((argc + 1) * sizeof (char *)))) - return -1; - memset ((char *) this_argv, 0, sizeof (char *) * (argc + 1)); - - for (i = 0; i < argc; i++) - { - if (NULL == (this_argv[i] = SLang_create_slstring (argv[i]))) - goto return_error; - } - - if (-1 == SLadd_intrinsic_variable ("__argc", (VOID_STAR)&this_argc, - SLANG_INT_TYPE, 1)) - goto return_error; - - if (-1 == SLang_add_intrinsic_array ("__argv", SLANG_STRING_TYPE, 1, - (VOID_STAR) this_argv, 1, argc)) - goto return_error; - - return 0; - - return_error: - for (i = 0; i < argc; i++) - SLang_free_slstring (this_argv[i]); /* NULL ok */ - SLfree ((char *) this_argv); - - return -1; -} diff --git a/mdk-stage1/slang/slstdio.c b/mdk-stage1/slang/slstdio.c deleted file mode 100644 index 05db1af77..000000000 --- a/mdk-stage1/slang/slstdio.c +++ /dev/null @@ -1,1050 +0,0 @@ -/* file stdio intrinsics for S-Lang */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#if defined(__unix__) || (defined (__os2__) && defined (__EMX__)) -# include <sys/types.h> -#endif - -#ifdef HAVE_FCNTL_H -# include <fcntl.h> -#endif -#ifdef HAVE_SYS_FCNTL_H -# include <sys/fcntl.h> -#endif - -#ifdef __unix__ -# include <sys/file.h> -#endif - -#if defined(__BORLANDC__) -# include <io.h> -# include <dir.h> -#endif - -#if defined(__DECC) && defined(VMS) -# include <unixio.h> -# include <unixlib.h> -#endif - -#ifdef VMS -# include <stat.h> -#else -# include <sys/stat.h> -#endif - -#include <errno.h> - -#define SL_APP_WANTS_FOREACH -#include "slang.h" -#include "_slang.h" - -typedef struct -{ - FILE *fp; /* kind of obvious */ - char *file; /* file name associated with pointer */ - - unsigned int flags; /* modes, etc... */ -#define SL_READ 0x0001 -#define SL_WRITE 0x0002 -#define SL_BINARY 0x0004 -#define SL_FDOPEN 0x2000 -#define SL_PIPE 0x4000 -#define SL_INUSE 0x8000 -} -SL_File_Table_Type; - -static SL_File_Table_Type *SL_File_Table; - -static SL_File_Table_Type *get_free_file_table_entry (void) -{ - SL_File_Table_Type *t = SL_File_Table, *tmax; - - tmax = t + SL_MAX_FILES; - while (t < tmax) - { - if (t->flags == 0) - { - memset ((char *) t, 0, sizeof (SL_File_Table_Type)); - return t; - } - t++; - } - - return NULL; -} - -static unsigned int file_process_flags (char *mode) -{ - char ch; - unsigned int flags = 0; - - while (1) - { - ch = *mode++; - switch (ch) - { - case 'r': flags |= SL_READ; - break; - case 'w': - case 'a': - case 'A': - flags |= SL_WRITE; - break; - case '+': flags |= SL_WRITE | SL_READ; - break; - case 'b': flags |= SL_BINARY; - break; - case 0: - return flags; - - default: - SLang_verror (SL_INVALID_PARM, "File flag %c is not supported", ch); - return 0; - } - } -} - -static int open_file_type (char *file, int fd, char *mode, - FILE *(*open_fun)(char *, char *), - int (*close_fun)(FILE *), - unsigned int xflags) -{ - FILE *fp; - SL_File_Table_Type *t; - unsigned int flags; - SLang_MMT_Type *mmt; - - fp = NULL; - t = NULL; - mmt = NULL; - - if ((NULL == (t = get_free_file_table_entry ())) - || (0 == (flags = file_process_flags(mode)))) - goto return_error; - - if (fd != -1) - fp = fdopen (fd, mode); - else - fp = open_fun (file, mode); - - if (fp == NULL) - { - _SLerrno_errno = errno; - goto return_error; - } - - if (NULL == (mmt = SLang_create_mmt (SLANG_FILE_PTR_TYPE, (VOID_STAR) t))) - goto return_error; - - t->fp = fp; - t->flags = flags | xflags; - fp = NULL; /* allow free_mmt to close fp */ - - if ((NULL != (t->file = SLang_create_slstring (file))) - && (0 == SLang_push_mmt (mmt))) - return 0; - - /* drop */ - - return_error: - if (fp != NULL) (*close_fun) (fp); - if (mmt != NULL) SLang_free_mmt (mmt); - (void) SLang_push_null (); - return -1; -} - -/* Since some compilers do not have popen/pclose prototyped and in scope, - * and pc compilers sometimes have silly prototypes involving PASCAL, etc. - * use wrappers around the function to avoid compilation errors. - */ - -static FILE *fopen_fun (char *f, char *m) -{ - return fopen (f, m); -} -static int fclose_fun (FILE *fp) -{ - return fclose (fp); -} - -static void stdio_fopen (char *file, char *mode) -{ - (void) open_file_type (file, -1, mode, fopen_fun, fclose_fun, 0); -} - -int _SLstdio_fdopen (char *file, int fd, char *mode) -{ - if (fd == -1) - { - _SLerrno_errno = EBADF; - (void) SLang_push_null (); - return -1; - } - - return open_file_type (file, fd, mode, NULL, fclose_fun, SL_FDOPEN); -} - -#ifdef HAVE_POPEN -static int pclose_fun (FILE *fp) -{ - return pclose (fp); -} - -static FILE *popen_fun (char *file, char *mode) -{ - return popen (file, mode); -} - -static void stdio_popen (char *file, char *mode) -{ - (void) open_file_type (file, -1, mode, popen_fun, pclose_fun, SL_PIPE); -} -#endif - -/* returns pointer to file entry if it is open and consistent with - flags. Returns NULL otherwise */ -static SLang_MMT_Type *pop_fp (unsigned int flags, FILE **fp_ptr) -{ - SL_File_Table_Type *t; - SLang_MMT_Type *mmt; - - *fp_ptr = NULL; - - if (NULL == (mmt = SLang_pop_mmt (SLANG_FILE_PTR_TYPE))) - return NULL; - - t = (SL_File_Table_Type *) SLang_object_from_mmt (mmt); - if ((t->flags & flags) - && (NULL != (*fp_ptr = t->fp))) - return mmt; - - SLang_free_mmt (mmt); - return NULL; -} - -static FILE *check_fp (SL_File_Table_Type *t, unsigned flags) -{ - if ((t != NULL) && (t->flags & flags)) - return t->fp; - - return NULL; -} - -char *SLang_get_name_from_fileptr (SLang_MMT_Type *mmt) -{ - SL_File_Table_Type *ft; - - ft = (SL_File_Table_Type *) SLang_object_from_mmt (mmt); - if (ft == NULL) - return NULL; - return ft->file; -} - -int SLang_pop_fileptr (SLang_MMT_Type **mmt, FILE **fp) -{ - if (NULL == (*mmt = pop_fp (0xFFFF, fp))) - { -#ifdef EBADF - _SLerrno_errno = EBADF; -#endif - return -1; - } - - return 0; -} - -static int close_file_type (SL_File_Table_Type *t) -{ - int ret = 0; - FILE *fp; - - if (t == NULL) - return -1; - - fp = t->fp; - - if (NULL == fp) ret = -1; - else - { - if (0 == (t->flags & SL_PIPE)) - { - if (EOF == (ret = fclose (fp))) - _SLerrno_errno = errno; - } -#ifdef HAVE_POPEN - else - { - if (-1 == (ret = pclose (fp))) - _SLerrno_errno = errno; - } -#endif - } - - if (t->file != NULL) SLang_free_slstring (t->file); - memset ((char *) t, 0, sizeof (SL_File_Table_Type)); - return ret; -} - -static int stdio_fclose (SL_File_Table_Type *t) -{ - int ret; - - if (NULL == check_fp (t, 0xFFFF)) - return -1; - - ret = close_file_type (t); - - t->flags = SL_INUSE; - return ret; -} - -static int read_one_line (FILE *fp, char **strp, unsigned int *lenp) -{ - char buf[512]; - char *str; - unsigned int len; - - *strp = NULL; - len = 0; - str = NULL; - - while (NULL != fgets (buf, sizeof (buf), fp)) - { - unsigned int dlen; - char *new_str; - int done_flag; - - dlen = strlen (buf); - /* Note: If the file contains embedded \0 characters, then this - * fails to work properly since dlen will not be correct. - */ - done_flag = ((dlen + 1 < sizeof (buf)) - || (buf[dlen - 1] == '\n')); - - if (done_flag && (str == NULL)) - { - /* Avoid the malloc */ - str = buf; - len = dlen; - break; - } - - if (NULL == (new_str = SLrealloc (str, len + dlen + 1))) - { - SLfree (str); - return -1; - } - - str = new_str; - strcpy (str + len, buf); - len += dlen; - - if (done_flag) break; - } - - if (str == NULL) - return 0; - - *strp = SLang_create_nslstring (str, len); - if (str != buf) SLfree (str); - - if (*strp == NULL) return -1; - - *lenp = len; - return 1; -} - -/* returns number of characters read and pushes the string to the stack. - If it fails, it returns -1 */ -static int stdio_fgets (SLang_Ref_Type *ref, SL_File_Table_Type *t) -{ - char *s; - unsigned int len; - FILE *fp; - int status; - - if (NULL == (fp = check_fp (t, SL_READ))) - return -1; - - status = read_one_line (fp, &s, &len); - if (status <= 0) - return -1; - - status = SLang_assign_to_ref (ref, SLANG_STRING_TYPE, (VOID_STAR)&s); - SLang_free_slstring (s); - - if (status == -1) - return -1; - - return (int) len; -} - -static void stdio_fgetslines_internal (FILE *fp, unsigned int n) -{ - unsigned int num_lines, max_num_lines; - char **list; - SLang_Array_Type *at; - int inum_lines; - - if (n > 1024) - max_num_lines = 1024; - else - { - max_num_lines = n; - if (max_num_lines == 0) - max_num_lines++; - } - - list = (char **) SLmalloc (sizeof (char *) * max_num_lines); - if (list == NULL) - return; - - num_lines = 0; - while (num_lines < n) - { - int status; - char *line; - unsigned int len; - - status = read_one_line (fp, &line, &len); - if (status == -1) - goto return_error; - - if (status == 0) - break; - - if (max_num_lines == num_lines) - { - char **new_list; - - if (max_num_lines + 4096 > n) - max_num_lines = n; - else - max_num_lines += 4096; - - new_list = (char **) SLrealloc ((char *)list, sizeof (char *) * max_num_lines); - if (new_list == NULL) - { - SLang_free_slstring (line); - goto return_error; - } - list = new_list; - } - - list[num_lines] = line; - num_lines++; - } - - if (num_lines != max_num_lines) - { - char **new_list; - - new_list = (char **)SLrealloc ((char *)list, sizeof (char *) * (num_lines + 1)); - if (new_list == NULL) - goto return_error; - - list = new_list; - } - - inum_lines = (int) num_lines; - if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, (VOID_STAR) list, &inum_lines, 1))) - goto return_error; - - if (-1 == SLang_push_array (at, 1)) - SLang_push_null (); - return; - - return_error: - while (num_lines > 0) - { - num_lines--; - SLfree (list[num_lines]); - } - SLfree ((char *)list); - SLang_push_null (); -} - -static void stdio_fgetslines (void) -{ - unsigned int n; - FILE *fp; - SLang_MMT_Type *mmt; - - n = (unsigned int)-1; - - if (SLang_Num_Function_Args == 2) - { - if (-1 == SLang_pop_uinteger (&n)) - return; - } - - if (NULL == (mmt = pop_fp (SL_READ, &fp))) - { - SLang_push_null (); - return; - } - - stdio_fgetslines_internal (fp, n); - SLang_free_mmt (mmt); -} - - -static int stdio_fputs (char *s, SL_File_Table_Type *t) -{ - FILE *fp; - - if (NULL == (fp = check_fp (t, SL_WRITE))) - return -1; - - if (EOF == fputs(s, fp)) return -1; - return (int) strlen (s); -} - -static int stdio_fflush (SL_File_Table_Type *t) -{ - FILE *fp; - - if (NULL == (fp = check_fp (t, SL_WRITE))) - return -1; - - if (EOF == fflush (fp)) - { - _SLerrno_errno = errno; - return -1; - } - - return 0; -} - -/* Usage: n = fread (&str, data-type, nelems, fp); */ -static void stdio_fread (SLang_Ref_Type *ref, int *data_typep, unsigned int *num_elemns, SL_File_Table_Type *t) -{ - char *s; - FILE *fp; - int ret; - unsigned int num_read, num_to_read; - unsigned int nbytes; - SLang_Class_Type *cl; - unsigned int sizeof_type; - int data_type; - - ret = -1; - s = NULL; - cl = NULL; - - if (NULL == (fp = check_fp (t, SL_READ))) - goto the_return; - - /* FIXME: priority = low : I should add some mechanism to support - * other types. - */ - data_type = *data_typep; - - cl = _SLclass_get_class ((unsigned char) data_type); - - if (cl->cl_fread == NULL) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "fread does not support %s objects", - cl->cl_name); - goto the_return; - } - - sizeof_type = cl->cl_sizeof_type; - - num_to_read = *num_elemns; - nbytes = (unsigned int) num_to_read * sizeof_type; - - s = SLmalloc (nbytes + 1); - if (s == NULL) - goto the_return; - - ret = cl->cl_fread (data_type, fp, (VOID_STAR)s, num_to_read, &num_read); - - if ((num_read == 0) - && (num_read != num_to_read)) - ret = -1; - - if ((ret == -1) && ferror (fp)) - _SLerrno_errno = errno; - - if ((ret == 0) - && (num_read != num_to_read)) - { - char *new_s; - - nbytes = num_read * sizeof_type; - new_s = SLrealloc (s, nbytes + 1); - if (new_s == NULL) - ret = -1; - else - s = new_s; - } - - if (ret == 0) - { - if (num_read == 1) - { - ret = SLang_assign_to_ref (ref, data_type, (VOID_STAR)s); - SLfree (s); - } - else if ((data_type == SLANG_CHAR_TYPE) - || (data_type == SLANG_UCHAR_TYPE)) - { - SLang_BString_Type *bs; - - bs = SLbstring_create_malloced ((unsigned char *)s, num_read, 1); - ret = SLang_assign_to_ref (ref, SLANG_BSTRING_TYPE, (VOID_STAR)&bs); - SLbstring_free (bs); - } - else - { - SLang_Array_Type *at; - int inum_read = (int) num_read; - at = SLang_create_array (data_type, 0, (VOID_STAR)s, &inum_read, 1); - ret = SLang_assign_to_ref (ref, SLANG_ARRAY_TYPE, (VOID_STAR)&at); - SLang_free_array (at); - } - s = NULL; - } - - the_return: - - if (s != NULL) - SLfree (s); - - if (ret == -1) - SLang_push_integer (ret); - else - SLang_push_uinteger (num_read); -} - -/* Usage: n = fwrite (str, fp); */ -static void stdio_fwrite (SL_File_Table_Type *t) -{ - FILE *fp; - unsigned char *s; - unsigned int num_to_write, num_write; - int ret; - SLang_BString_Type *b; - SLang_Array_Type *at; - SLang_Class_Type *cl; - - ret = -1; - b = NULL; - at = NULL; - - switch (SLang_peek_at_stack ()) - { - case SLANG_BSTRING_TYPE: - case SLANG_STRING_TYPE: - if (-1 == SLang_pop_bstring (&b)) - goto the_return; - - if (NULL == (s = SLbstring_get_pointer (b, &num_to_write))) - goto the_return; - - cl = _SLclass_get_class (SLANG_UCHAR_TYPE); - break; - - default: - if (-1 == SLang_pop_array (&at, 1)) - goto the_return; - - cl = at->cl; - num_to_write = at->num_elements; - s = (unsigned char *) at->data; - } - - if (NULL == (fp = check_fp (t, SL_WRITE))) - goto the_return; - - if (cl->cl_fwrite == NULL) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "fwrite does not support %s objects", cl->cl_name); - goto the_return; - } - - ret = cl->cl_fwrite (cl->cl_data_type, fp, s, num_to_write, &num_write); - - if ((ret == -1) && ferror (fp)) - _SLerrno_errno = errno; - - /* drop */ - the_return: - if (b != NULL) - SLbstring_free (b); - if (at != NULL) - SLang_free_array (at); - - if (ret == -1) - SLang_push_integer (ret); - else - SLang_push_uinteger (num_write); -} - -static int stdio_fseek (SL_File_Table_Type *t, int *ofs, int *whence) -{ - FILE *fp; - - if (NULL == (fp = check_fp (t, 0xFFFF))) - return -1; - - if (-1 == fseek (fp, (long) *ofs, *whence)) - { - _SLerrno_errno = errno; - return -1; - } - - return 0; -} - -static int stdio_ftell (SL_File_Table_Type *t) -{ - FILE *fp; - long ofs; - - if (NULL == (fp = check_fp (t, 0xFFFF))) - return -1; - - if (-1L == (ofs = ftell (fp))) - { - _SLerrno_errno = errno; - return -1; - } - - return (int) ofs; -} - -static int stdio_feof (SL_File_Table_Type *t) -{ - FILE *fp; - - if (NULL == (fp = check_fp (t, 0xFFFF))) - return -1; - - return feof (fp); -} - -static int stdio_ferror (SL_File_Table_Type *t) -{ - FILE *fp; - - if (NULL == (fp = check_fp (t, 0xFFFF))) - return -1; - - return ferror (fp); -} - -static void stdio_clearerr (SL_File_Table_Type *t) -{ - FILE *fp; - - if (NULL != (fp = check_fp (t, 0xFFFF))) - clearerr (fp); -} - -/* () = fprintf (fp, "FORMAT", arg...); */ -static int stdio_fprintf (void) -{ - char *s; - FILE *fp; - SLang_MMT_Type *mmt; - int status; - - if (-1 == _SLstrops_do_sprintf_n (SLang_Num_Function_Args - 2)) - return -1; - - if (-1 == SLang_pop_slstring (&s)) - return -1; - - if (NULL == (mmt = pop_fp (SL_WRITE, &fp))) - { - SLang_free_slstring (s); - return -1; - } - - if (EOF == fputs(s, fp)) - status = -1; - else - status = (int) strlen (s); - - SLang_free_mmt (mmt); - SLang_free_slstring (s); - return status; -} - -static int stdio_printf (void) -{ - char *s; - int status; - - if (-1 == _SLstrops_do_sprintf_n (SLang_Num_Function_Args - 1)) - return -1; - - if (-1 == SLang_pop_slstring (&s)) - return -1; - - if (EOF == fputs(s, stdout)) - status = -1; - else - status = (int) strlen (s); - - SLang_free_slstring (s); - return status; -} - - -#define F SLANG_FILE_PTR_TYPE -#define R SLANG_REF_TYPE -#define I SLANG_INT_TYPE -#define V SLANG_VOID_TYPE -#define S SLANG_STRING_TYPE -#define B SLANG_BSTRING_TYPE -#define U SLANG_UINT_TYPE -#define D SLANG_DATATYPE_TYPE -static SLang_Intrin_Fun_Type Stdio_Name_Table[] = -{ - MAKE_INTRINSIC_0("fgetslines", stdio_fgetslines, V), - MAKE_INTRINSIC_SS("fopen", stdio_fopen, V), - MAKE_INTRINSIC_1("feof", stdio_feof, I, F), - MAKE_INTRINSIC_1("ferror", stdio_ferror, I, F), - MAKE_INTRINSIC_1("fclose", stdio_fclose, I, F), - MAKE_INTRINSIC_2("fgets", stdio_fgets, I, R, F), - MAKE_INTRINSIC_1("fflush", stdio_fflush, I, F), - MAKE_INTRINSIC_2("fputs", stdio_fputs, I, S, F), - MAKE_INTRINSIC_0("fprintf", stdio_fprintf, I), - MAKE_INTRINSIC_0("printf", stdio_printf, I), - MAKE_INTRINSIC_3("fseek", stdio_fseek, I, F, I, I), - MAKE_INTRINSIC_1("ftell", stdio_ftell, I, F), - MAKE_INTRINSIC_1("clearerr", stdio_clearerr, V, F), - MAKE_INTRINSIC_4("fread", stdio_fread, V, R, D, U, F), - MAKE_INTRINSIC_1("fwrite", stdio_fwrite, V, F), -#ifdef HAVE_POPEN - MAKE_INTRINSIC_SS("popen", stdio_popen, V), - MAKE_INTRINSIC_1("pclose", stdio_fclose, I, F), -#endif - SLANG_END_INTRIN_FUN_TABLE -}; -#undef F -#undef I -#undef R -#undef V -#undef S -#undef B -#undef U -#undef D - -#ifndef SEEK_SET -# define SEEK_SET 0 -#endif -#ifndef SEEK_CUR -# define SEEK_CUR 1 -#endif -#ifndef SEEK_END -# define SEEK_END 2 -#endif - -static SLang_IConstant_Type Stdio_Consts [] = -{ - MAKE_ICONSTANT("SEEK_SET", SEEK_SET), - MAKE_ICONSTANT("SEEK_END", SEEK_END), - MAKE_ICONSTANT("SEEK_CUR", SEEK_CUR), - SLANG_END_ICONST_TABLE -}; - -static void destroy_file_type (unsigned char type, VOID_STAR ptr) -{ - (void) type; - (void) close_file_type ((SL_File_Table_Type *) ptr); -} - - -struct _SLang_Foreach_Context_Type -{ - SLang_MMT_Type *mmt; - FILE *fp; -#define CTX_USE_LINE 1 -#define CTX_USE_CHAR 2 - unsigned char type; -}; - - -static SLang_Foreach_Context_Type * -cl_foreach_open (unsigned char type, unsigned int num) -{ - SLang_Foreach_Context_Type *c; - SLang_MMT_Type *mmt; - FILE *fp; - - if (NULL == (mmt = pop_fp (SL_READ, &fp))) - return NULL; - - type = CTX_USE_LINE; - - switch (num) - { - char *s; - - case 0: - type = CTX_USE_LINE; - break; - - case 1: - if (-1 == SLang_pop_slstring (&s)) - { - SLang_free_mmt (mmt); - return NULL; - } - if (0 == strcmp (s, "char")) - type = CTX_USE_CHAR; - else if (0 == strcmp (s, "line")) - type = CTX_USE_LINE; - else - { - SLang_verror (SL_NOT_IMPLEMENTED, - "using '%s' not supported by File_Type", - s); - SLang_free_slstring (s); - SLang_free_mmt (mmt); - return NULL; - } - SLang_free_slstring (s); - break; - - default: - SLdo_pop_n (num); - SLang_verror (SL_NOT_IMPLEMENTED, - "Usage: foreach (File_Type) using ([line|char])"); - SLang_free_mmt (mmt); - return NULL; - } - - if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type)))) - { - SLang_free_mmt (mmt); - return NULL; - } - memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type)); - - c->type = type; - c->mmt = mmt; - c->fp = fp; - - return c; -} - -static void cl_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c) -{ - (void) type; - if (c == NULL) return; - SLang_free_mmt (c->mmt); - SLfree ((char *) c); -} - -static int cl_foreach (unsigned char type, SLang_Foreach_Context_Type *c) -{ - int status; - int ch; - unsigned int len; - char *s; - - (void) type; - - if (c == NULL) - return -1; - - switch (c->type) - { - case CTX_USE_CHAR: - if (EOF == (ch = getc (c->fp))) - return 0; - if (-1 == SLang_push_uchar ((unsigned char) ch)) - return -1; - return 1; - - case CTX_USE_LINE: - status = read_one_line (c->fp, &s, &len); - if (status <= 0) - return status; - if (0 == _SLang_push_slstring (s)) - return 1; - return -1; - } - - return -1; -} - -static int Stdio_Initialized; -static SLang_MMT_Type *Stdio_Mmts[3]; - -int SLang_init_stdio (void) -{ - unsigned int i; - SL_File_Table_Type *s; - SLang_Class_Type *cl; - char *names[3]; - - if (Stdio_Initialized) - return 0; - - SL_File_Table = (SL_File_Table_Type *)SLcalloc(sizeof (SL_File_Table_Type), SL_MAX_FILES); - if (SL_File_Table == NULL) - return -1; - - if (NULL == (cl = SLclass_allocate_class ("File_Type"))) - return -1; - cl->cl_destroy = destroy_file_type; - cl->cl_foreach_open = cl_foreach_open; - cl->cl_foreach_close = cl_foreach_close; - cl->cl_foreach = cl_foreach; - - - if (-1 == SLclass_register_class (cl, SLANG_FILE_PTR_TYPE, sizeof (SL_File_Table_Type), SLANG_CLASS_TYPE_MMT)) - return -1; - - if ((-1 == SLadd_intrin_fun_table(Stdio_Name_Table, "__STDIO__")) - || (-1 == SLadd_iconstant_table (Stdio_Consts, NULL)) - || (-1 == _SLerrno_init ())) - return -1; - - names[0] = "stdin"; - names[1] = "stdout"; - names[2] = "stderr"; - - s = SL_File_Table; - s->fp = stdin; s->flags = SL_READ; - - s++; - s->fp = stdout; s->flags = SL_WRITE; - - s++; - s->fp = stderr; s->flags = SL_WRITE|SL_READ; - - s = SL_File_Table; - for (i = 0; i < 3; i++) - { - if (NULL == (s->file = SLang_create_slstring (names[i]))) - return -1; - - if (NULL == (Stdio_Mmts[i] = SLang_create_mmt (SLANG_FILE_PTR_TYPE, (VOID_STAR) s))) - return -1; - SLang_inc_mmt (Stdio_Mmts[i]); - - if (-1 == SLadd_intrinsic_variable (s->file, (VOID_STAR)&Stdio_Mmts[i], SLANG_FILE_PTR_TYPE, 1)) - return -1; - s++; - } - - Stdio_Initialized = 1; - return 0; -} - diff --git a/mdk-stage1/slang/slstring.c b/mdk-stage1/slang/slstring.c deleted file mode 100644 index 529c41827..000000000 --- a/mdk-stage1/slang/slstring.c +++ /dev/null @@ -1,546 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -typedef struct _SLstring_Type -{ - struct _SLstring_Type *next; - unsigned int ref_count; - char bytes [1]; -} -SLstring_Type; - -static SLstring_Type *String_Hash_Table [SLSTRING_HASH_TABLE_SIZE]; -static char Single_Char_Strings [256 * 2]; - -#if _SLANG_OPTIMIZE_FOR_SPEED -#define MAX_FREE_STORE_LEN 32 -static SLstring_Type *SLS_Free_Store [MAX_FREE_STORE_LEN]; - -# define NUM_CACHED_STRINGS 601 -typedef struct -{ - unsigned long hash; - SLstring_Type *sls; - unsigned int len; -} -Cached_String_Type; -static Cached_String_Type Cached_Strings [NUM_CACHED_STRINGS]; - -#define GET_CACHED_STRING(s) \ - (Cached_Strings + (unsigned int)(((unsigned long) (s)) % NUM_CACHED_STRINGS)) - -_INLINE_ -static void cache_string (SLstring_Type *sls, unsigned int len, unsigned long hash) -{ - Cached_String_Type *cs; - - cs = GET_CACHED_STRING(sls->bytes); - cs->sls = sls; - cs->hash = hash; - cs->len = len; -} - -_INLINE_ -static void uncache_string (char *s) -{ - Cached_String_Type *cs; - - cs = GET_CACHED_STRING(s); - if ((cs->sls != NULL) - && (cs->sls->bytes == s)) - cs->sls = NULL; -} -#endif - - - -_INLINE_ -unsigned long _SLstring_hash (unsigned char *s, unsigned char *smax) -{ - register unsigned long h = 0; - register unsigned long sum = 0; - unsigned char *smax4; - - smax4 = smax - 4; - - while (s < smax4) - { - sum += s[0]; - h = sum + (h << 1); - sum += s[1]; - h = sum + (h << 1); - sum += s[2]; - h = sum + (h << 1); - sum += s[3]; - h = sum + (h << 1); - - s += 4; - } - - while (s < smax) - { - sum += *s++; - h ^= sum + (h << 3); /* slightly different */ - } - - return h; -} - -unsigned long _SLcompute_string_hash (char *s) -{ -#if _SLANG_OPTIMIZE_FOR_SPEED - Cached_String_Type *cs; - SLstring_Type *sls; - - cs = GET_CACHED_STRING(s); - if (((sls = cs->sls) != NULL) - && (sls->bytes == s)) - return cs->hash; -#endif - return _SLstring_hash ((unsigned char *) s, (unsigned char *) s + strlen (s)); -} - -_INLINE_ -/* This routine works with any (long) string */ -static SLstring_Type *find_string (char *s, unsigned int len, unsigned long hash) -{ - SLstring_Type *sls; - char ch; - - sls = String_Hash_Table [(unsigned int)(hash % SLSTRING_HASH_TABLE_SIZE)]; - - if (sls == NULL) - return NULL; - - ch = s[0]; - do - { - char *bytes = sls->bytes; - - /* Note that we need to actually make sure that bytes[len] == 0. - * In this case, it is not enough to just compare pointers. In fact, - * this is called from create_nstring, etc... It is unlikely that the - * pointer is a slstring - */ - if ((/* (s == bytes) || */ ((ch == bytes[0]) - && (0 == strncmp (s, bytes, len)))) - && (bytes [len] == 0)) - break; - - sls = sls->next; - } - while (sls != NULL); - - return sls; -} - -_INLINE_ -static SLstring_Type *find_slstring (char *s, unsigned long hash) -{ - SLstring_Type *sls; - - sls = String_Hash_Table [(unsigned int)(hash % SLSTRING_HASH_TABLE_SIZE)]; - while (sls != NULL) - { - if (s == sls->bytes) - return sls; - - sls = sls->next; - } - return sls; -} - -_INLINE_ -static SLstring_Type *allocate_sls (unsigned int len) -{ - SLstring_Type *sls; - -#if _SLANG_OPTIMIZE_FOR_SPEED - if ((len < MAX_FREE_STORE_LEN) - && (NULL != (sls = SLS_Free_Store [len]))) - { - SLS_Free_Store[len] = NULL; - return sls; - } -#endif - /* FIXME: use structure padding */ - return (SLstring_Type *) SLmalloc (len + sizeof (SLstring_Type)); -} - -_INLINE_ -static void free_sls (SLstring_Type *sls, unsigned int len) -{ -#if _SLANG_OPTIMIZE_FOR_SPEED - if ((len < MAX_FREE_STORE_LEN) - && (SLS_Free_Store[len] == NULL)) - { - SLS_Free_Store [len] = sls; - return; - } -#else - (void) len; -#endif - SLfree ((char *)sls); -} - -_INLINE_ -static char *create_long_string (char *s, unsigned int len, unsigned long hash) -{ - SLstring_Type *sls; - - sls = find_string (s, len, hash); - - if (sls != NULL) - { - sls->ref_count++; - s = sls->bytes; - -#if _SLANG_OPTIMIZE_FOR_SPEED - cache_string (sls, len, hash); -#endif - return s; - } - - sls = allocate_sls (len); - if (sls == NULL) - return NULL; - - strncpy (sls->bytes, s, len); - sls->bytes[len] = 0; - sls->ref_count = 1; - -#if _SLANG_OPTIMIZE_FOR_SPEED - cache_string (sls, len, hash); -#endif - - hash = hash % SLSTRING_HASH_TABLE_SIZE; - sls->next = String_Hash_Table [(unsigned int)hash]; - String_Hash_Table [(unsigned int)hash] = sls; - - return sls->bytes; -} - -_INLINE_ -static char *create_short_string (char *s, unsigned int len) -{ - char ch; - - /* Note: if len is 0, then it does not matter what *s is. This is - * important for SLang_create_nslstring. - */ - if (len) ch = *s; else ch = 0; - - len = 2 * (unsigned int) ((unsigned char) ch); - Single_Char_Strings [len] = ch; - Single_Char_Strings [len + 1] = 0; - return Single_Char_Strings + len; -} - -/* s cannot be NULL */ -_INLINE_ -static char *create_nstring (char *s, unsigned int len, unsigned long *hash_ptr) -{ - unsigned long hash; - - if (len < 2) - return create_short_string (s, len); - - hash = _SLstring_hash ((unsigned char *) s, (unsigned char *) (s + len)); - *hash_ptr = hash; - - return create_long_string (s, len, hash); -} - -char *SLang_create_nslstring (char *s, unsigned int len) -{ - unsigned long hash; - return create_nstring (s, len, &hash); -} - -char *_SLstring_make_hashed_string (char *s, unsigned int len, unsigned long *hashptr) -{ - unsigned long hash; - - if (s == NULL) return NULL; - - hash = _SLstring_hash ((unsigned char *) s, (unsigned char *) s + len); - *hashptr = hash; - - if (len < 2) - return create_short_string (s, len); - - return create_long_string (s, len, hash); -} - -char *_SLstring_dup_hashed_string (char *s, unsigned long hash) -{ - unsigned int len; -#if _SLANG_OPTIMIZE_FOR_SPEED - Cached_String_Type *cs; - SLstring_Type *sls; - - if (s == NULL) return NULL; - if (s[0] == 0) - return create_short_string (s, 0); - if (s[1] == 0) - return create_short_string (s, 1); - - cs = GET_CACHED_STRING(s); - if (((sls = cs->sls) != NULL) - && (sls->bytes == s)) - { - sls->ref_count += 1; - return s; - } -#else - if (s == NULL) return NULL; -#endif - - len = strlen (s); -#if !_SLANG_OPTIMIZE_FOR_SPEED - if (len < 2) return create_short_string (s, len); -#endif - - return create_long_string (s, len, hash); -} - -char *_SLstring_dup_slstring (char *s) -{ - SLstring_Type *sls; - unsigned int len; - unsigned long hash; -#if _SLANG_OPTIMIZE_FOR_SPEED - Cached_String_Type *cs; - - cs = GET_CACHED_STRING(s); - if (((sls = cs->sls) != NULL) - && (sls->bytes == s)) - { - sls->ref_count += 1; - return s; - } -#endif - - if ((s == NULL) || ((len = strlen (s)) < 2)) - return s; - - hash = _SLstring_hash ((unsigned char *)s, (unsigned char *)(s + len)); - - sls = find_slstring (s, hash); - if (sls == NULL) - { - SLang_Error = SL_INTERNAL_ERROR; - return NULL; - } - - sls->ref_count++; -#if _SLANG_OPTIMIZE_FOR_SPEED - cache_string (sls, len, hash); -#endif - return s; -} - -static void free_sls_string (SLstring_Type *sls, char *s, unsigned int len, - unsigned long hash) -{ - SLstring_Type *sls1, *prev; - -#if _SLANG_OPTIMIZE_FOR_SPEED - uncache_string (s); -#endif - - hash = hash % SLSTRING_HASH_TABLE_SIZE; - - sls1 = String_Hash_Table [(unsigned int) hash]; - - prev = NULL; - - /* This should not fail. */ - while (sls1 != sls) - { - prev = sls1; - sls1 = sls1->next; - } - - if (prev != NULL) - prev->next = sls->next; - else - String_Hash_Table [(unsigned int) hash] = sls->next; - - free_sls (sls, len); -} - -_INLINE_ -static void free_long_string (char *s, unsigned int len, unsigned long hash) -{ - SLstring_Type *sls; - - if (NULL == (sls = find_slstring (s, hash))) - { - SLang_doerror ("Application internal error: invalid attempt to free string"); - return; - } - - sls->ref_count--; - if (sls->ref_count != 0) - { -#if _SLANG_OPTIMIZE_FOR_SPEED - /* cache_string (sls, len, hash); */ -#endif - return; - } - - - free_sls_string (sls, s, len, hash); -} - -/* This routine may be passed NULL-- it is not an error. */ -void SLang_free_slstring (char *s) -{ - unsigned long hash; - unsigned int len; -#if _SLANG_OPTIMIZE_FOR_SPEED - Cached_String_Type *cs; - SLstring_Type *sls; - - cs = GET_CACHED_STRING(s); - if (((sls = cs->sls) != NULL) - && (sls->bytes == s)) - { - if (sls->ref_count <= 1) - free_sls_string (sls, s, cs->len, cs->hash); - else - sls->ref_count -= 1; - return; - } -#endif - - if (s == NULL) return; - - if ((len = strlen (s)) < 2) - return; - - hash = _SLstring_hash ((unsigned char *)s, (unsigned char *) s + len); - free_long_string (s, len, hash); -} - -char *SLang_create_slstring (char *s) -{ - unsigned long hash; -#if _SLANG_OPTIMIZE_FOR_SPEED - Cached_String_Type *cs; - SLstring_Type *sls; - - cs = GET_CACHED_STRING(s); - if (((sls = cs->sls) != NULL) - && (sls->bytes == s)) - { - sls->ref_count += 1; - return s; - } -#endif - - if (s == NULL) return NULL; - return create_nstring (s, strlen (s), &hash); -} - -void _SLfree_hashed_string (char *s, unsigned int len, unsigned long hash) -{ - if ((s == NULL) || (len < 2)) return; - free_long_string (s, len, hash); -} - - -char *_SLallocate_slstring (unsigned int len) -{ - SLstring_Type *sls = allocate_sls (len); - if (sls == NULL) - return NULL; - - return sls->bytes; -} - -void _SLunallocate_slstring (char *s, unsigned int len) -{ - SLstring_Type *sls; - - if (s == NULL) - return; - - sls = (SLstring_Type *) (s - offsetof(SLstring_Type,bytes[0])); - free_sls (sls, len); -} - -char *_SLcreate_via_alloced_slstring (char *s, unsigned int len) -{ - unsigned long hash; - SLstring_Type *sls; - - if (s == NULL) - return NULL; - - if (len < 2) - { - char *s1 = create_short_string (s, len); - _SLunallocate_slstring (s, len); - return s1; - } - - /* s is not going to be in the cache because when it was malloced, its - * value was unknown. This simplifies the coding. - */ - hash = _SLstring_hash ((unsigned char *)s, (unsigned char *)s + len); - sls = find_string (s, len, hash); - if (sls != NULL) - { - sls->ref_count++; - _SLunallocate_slstring (s, len); - s = sls->bytes; - -#if _SLANG_OPTIMIZE_FOR_SPEED - cache_string (sls, len, hash); -#endif - return s; - } - - sls = (SLstring_Type *) (s - offsetof(SLstring_Type,bytes[0])); - sls->ref_count = 1; - -#if _SLANG_OPTIMIZE_FOR_SPEED - cache_string (sls, len, hash); -#endif - - hash = hash % SLSTRING_HASH_TABLE_SIZE; - sls->next = String_Hash_Table [(unsigned int)hash]; - String_Hash_Table [(unsigned int)hash] = sls; - - return s; -} - -/* Note, a and b may be ordinary strings. The result is an slstring */ -char *SLang_concat_slstrings (char *a, char *b) -{ - unsigned int lena, len; - char *c; - - lena = strlen (a); - len = lena + strlen (b); - - c = _SLallocate_slstring (len); - if (c == NULL) - return NULL; - - strcpy (c, a); - strcpy (c + lena, b); - - return _SLcreate_via_alloced_slstring (c, len); -} - diff --git a/mdk-stage1/slang/slstrops.c b/mdk-stage1/slang/slstrops.c deleted file mode 100644 index a57ef6389..000000000 --- a/mdk-stage1/slang/slstrops.c +++ /dev/null @@ -1,1686 +0,0 @@ -/* -*- mode: C; mode: fold; -*- */ -/* string manipulation functions for S-Lang. */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" -/*{{{ Include Files */ - -#include <time.h> - -#ifndef __QNX__ -# if defined(__GO32__) || defined(__WATCOMC__) -# include <dos.h> -# include <bios.h> -# endif -#endif - -#if SLANG_HAS_FLOAT -#include <math.h> -#endif - -#include <string.h> -#include <stdarg.h> -#include <ctype.h> - -#ifndef isdigit -# define isdigit(x) (((x) >= '0') && ((x) <= '9')) -#endif - -#include "slang.h" -#include "_slang.h" - -/*}}}*/ - -#define USE_ALLOC_STSTRING 1 - -/*{{{ Utility Functions */ - -static char Utility_Char_Table [256]; -static unsigned char WhiteSpace_Lut[256]; - -static void set_utility_char_table (char *pos) /*{{{*/ -{ - register char *t = Utility_Char_Table, *tmax; - register unsigned char ch; - - tmax = t + 256; - while (t < tmax) *t++ = 0; - - t = Utility_Char_Table; - while ((ch = (unsigned char) *pos++) != 0) t[ch] = 1; -} - -/*}}}*/ - -_INLINE_ -static unsigned char *make_whitespace_lut (void) -{ - if (WhiteSpace_Lut[' '] != 1) - { - WhiteSpace_Lut[' '] = WhiteSpace_Lut['\r'] - = WhiteSpace_Lut ['\n'] = WhiteSpace_Lut['\t'] - = WhiteSpace_Lut ['\f'] = 1; - } - return WhiteSpace_Lut; -} - -static unsigned char *make_lut (unsigned char *s, unsigned char *lut) -{ - int reverse = 0; - - if (*s == '^') - { - reverse = 1; - s++; - } - SLmake_lut (lut, s, reverse); - return lut; -} - -static unsigned int do_trim (char **beg, int do_beg, - char **end, int do_end, - char *white) /*{{{*/ -{ - unsigned int len; - char *a, *b; - - set_utility_char_table (white); - - a = *beg; - len = strlen (a); - b = a + len; - - if (do_beg) - while (Utility_Char_Table[(unsigned char) *a]) a++; - - if (do_end) - { - b--; - while ((b >= a) && (Utility_Char_Table[(unsigned char) *b])) b--; - b++; - } - - len = (unsigned int) (b - a); - *beg = a; - *end = b; - return len; -} - -/*}}}*/ - -/*}}}*/ - -static int pop_3_strings (char **a, char **b, char **c) -{ - *a = *b = *c = NULL; - if (-1 == SLpop_string (c)) - return -1; - - if (-1 == SLpop_string (b)) - { - SLfree (*c); - *c = NULL; - return -1; - } - - if (-1 == SLpop_string (a)) - { - SLfree (*b); - SLfree (*c); - *b = *c = NULL; - return -1; - } - - return 0; -} - -static void free_3_strings (char *a, char *b, char *c) -{ - SLfree (a); - SLfree (b); - SLfree (c); -} - -static void strcat_cmd (void) /*{{{*/ -{ - char *c, *c1; - int nargs; - int i; - char **ptrs; - unsigned int len; -#if !USE_ALLOC_STSTRING - char buf[256]; -#endif - nargs = SLang_Num_Function_Args; - if (nargs <= 0) nargs = 2; - - if (NULL == (ptrs = (char **)SLmalloc (nargs * sizeof (char *)))) - return; - - memset ((char *) ptrs, 0, sizeof (char *) * nargs); - - c = NULL; - i = nargs; - len = 0; - while (i != 0) - { - char *s; - - i--; - if (-1 == SLang_pop_slstring (&s)) - goto free_and_return; - ptrs[i] = s; - len += strlen (s); - } -#if USE_ALLOC_STSTRING - if (NULL == (c = _SLallocate_slstring (len))) - goto free_and_return; -#else - len++; /* \0 char */ - if (len <= sizeof (buf)) - c = buf; - else if (NULL == (c = SLmalloc (len))) - goto free_and_return; -#endif - - c1 = c; - for (i = 0; i < nargs; i++) - { - strcpy (c1, ptrs[i]); - c1 += strlen (c1); - } - - free_and_return: - for (i = 0; i < nargs; i++) - SLang_free_slstring (ptrs[i]); - SLfree ((char *) ptrs); - -#if USE_ALLOC_STSTRING - (void) _SLpush_alloced_slstring (c, len); -#else - if (c != buf) - (void) SLang_push_malloced_string (c); /* NULL ok */ - else - (void) SLang_push_string (c); -#endif -} - -/*}}}*/ - -static int _SLang_push_nstring (char *a, unsigned int len) -{ - a = SLang_create_nslstring (a, len); - if (a == NULL) - return -1; - - return _SLang_push_slstring (a); -} - - -static void strtrim_cmd_internal (char *str, int do_beg, int do_end) -{ - char *beg, *end, *white; - int free_str; - unsigned int len; - - /* Go through SLpop_string to get a private copy since it will be - * modified. - */ - - free_str = 0; - if (SLang_Num_Function_Args == 2) - { - white = str; - if (-1 == SLang_pop_slstring (&str)) - return; - free_str = 1; - } - else white = " \t\f\r\n"; - - beg = str; - len = do_trim (&beg, do_beg, &end, do_end, white); - - (void) _SLang_push_nstring (beg, len); - if (free_str) - SLang_free_slstring (str); -} - - -static void strtrim_cmd (char *str) -{ - strtrim_cmd_internal (str, 1, 1); -} - -static void strtrim_beg_cmd (char *str) -{ - strtrim_cmd_internal (str, 1, 0); -} - -static void strtrim_end_cmd (char *str) -{ - strtrim_cmd_internal (str, 0, 1); -} - - -static void strcompress_cmd (void) /*{{{*/ -{ - char *str, *white, *c; - unsigned char *s, *beg, *end; - unsigned int len; - char pref_char; - - if (SLpop_string (&white)) return; - if (SLpop_string (&str)) - { - SLfree (white); - return; - } - - /* The first character of white is the preferred whitespace character */ - pref_char = *white; - - beg = (unsigned char *) str; - (void) do_trim ((char **) &beg, 1, (char **) &end, 1, white); - SLfree (white); - - /* Determine the effective length */ - len = 0; - s = (unsigned char *) beg; - while (s < end) - { - len++; - if (Utility_Char_Table[*s++]) - { - while ((s < end) && Utility_Char_Table[*s]) s++; - } - } - -#if USE_ALLOC_STSTRING - c = _SLallocate_slstring (len); -#else - c = SLmalloc (len + 1); -#endif - if (c == NULL) - { - SLfree (str); - return; - } - - s = (unsigned char *) c; - - while (beg < end) - { - unsigned char ch = *beg++; - - if (0 == Utility_Char_Table[ch]) - { - *s++ = ch; - continue; - } - - *s++ = (unsigned char) pref_char; - - while ((beg < end) && Utility_Char_Table[*beg]) - beg++; - } - - *s = 0; - -#if USE_ALLOC_STSTRING - (void) _SLpush_alloced_slstring (c, len); -#else - SLang_push_malloced_string(c); -#endif - - SLfree(str); -} - -/*}}}*/ - -static int str_replace_cmd_1 (char *orig, char *match, char *rep, unsigned int max_num_replaces, - char **new_strp) /*{{{*/ -{ - char *s, *t, *new_str; - unsigned int rep_len, match_len, new_len; - unsigned int num_replaces; - - *new_strp = NULL; - - match_len = strlen (match); - - if (match_len == 0) - return 0; - - num_replaces = 0; - s = orig; - while (num_replaces < max_num_replaces) - { - s = strstr (s, match); - if (s == NULL) - break; - s += match_len; - num_replaces++; - } - - if (num_replaces == 0) - return 0; - - max_num_replaces = num_replaces; - - rep_len = strlen (rep); - - new_len = (strlen (orig) - num_replaces * match_len) + num_replaces * rep_len; - new_str = SLmalloc (new_len + 1); - if (new_str == NULL) - return -1; - - s = orig; - t = new_str; - - for (num_replaces = 0; num_replaces < max_num_replaces; num_replaces++) - { - char *next_s; - unsigned int len; - - next_s = strstr (s, match); /* cannot be NULL */ - len = (unsigned int) (next_s - s); - strncpy (t, s, len); - t += len; - strcpy (t, rep); - t += rep_len; - - s = next_s + match_len; - } - strcpy (t, s); - *new_strp = new_str; - - return (int) num_replaces; -} - -/*}}}*/ - -static void reverse_string (char *a) -{ - char *b; - - b = a + strlen (a); - while (b > a) - { - char ch; - - b--; - ch = *a; - *a++ = *b; - *b = ch; - } -} - -static int strreplace_cmd (int *np) -{ - char *orig, *match, *rep; - char *new_str; - int max_num_replaces; - int ret; - - max_num_replaces = *np; - - if (-1 == pop_3_strings (&orig, &match, &rep)) - return -1; - - if (max_num_replaces < 0) - { - reverse_string (orig); - reverse_string (match); - reverse_string (rep); - ret = str_replace_cmd_1 (orig, match, rep, -max_num_replaces, &new_str); - if (ret > 0) reverse_string (new_str); - else if (ret == 0) - reverse_string (orig); - } - else ret = str_replace_cmd_1 (orig, match, rep, max_num_replaces, &new_str); - - if (ret == 0) - { - if (-1 == SLang_push_malloced_string (orig)) - ret = -1; - orig = NULL; - } - else if (ret > 0) - { - if (-1 == SLang_push_malloced_string (new_str)) - ret = -1; - } - - free_3_strings (orig, match, rep); - return ret; -} - -static int str_replace_cmd (char *orig, char *match, char *rep) -{ - char *s; - int ret; - - ret = str_replace_cmd_1 (orig, match, rep, 1, &s); - if (ret == 1) - (void) SLang_push_malloced_string (s); - return ret; -} - - - -static void strtok_cmd (char *str) -{ - _SLString_List_Type sl; - unsigned char white_buf[256]; - char *s; - unsigned char *white; - - if (SLang_Num_Function_Args == 1) - white = make_whitespace_lut (); - else - { - white = white_buf; - make_lut ((unsigned char *)str, white); - if (-1 == SLang_pop_slstring (&str)) - return; - } - - if (-1 == _SLstring_list_init (&sl, 256, 1024)) - goto the_return; - - s = str; - while (*s != 0) - { - char *s0; - - s0 = s; - /* Skip whitespace */ - while ((*s0 != 0) && (0 != white[(unsigned char)*s0])) - s0++; - - if (*s0 == 0) - break; - - s = s0; - while ((*s != 0) && (0 == white[(unsigned char) *s])) - s++; - - /* sl deleted upon failure */ - if (-1 == _SLstring_list_append (&sl, SLang_create_nslstring (s0, (unsigned int) (s - s0)))) - goto the_return; - } - - /* Deletes sl */ - (void) _SLstring_list_push (&sl); - - the_return: - if (white == white_buf) - SLang_free_slstring (str); -} - -/* This routine returns the string with text removed between single character - comment delimiters from the set b and e. */ - -static void str_uncomment_string_cmd (char *str, char *b, char *e) /*{{{*/ -{ - unsigned char chb, che; - unsigned char *s, *cbeg, *mark; - - if (strlen(b) != strlen(e)) - { - SLang_doerror ("Comment delimiter length mismatch."); - return; - } - - set_utility_char_table (b); - - if (NULL == (str = (char *) SLmake_string(str))) return; - - s = (unsigned char *) str; - - while ((chb = *s++) != 0) - { - if (Utility_Char_Table [chb] == 0) continue; - - mark = s - 1; - - cbeg = (unsigned char *) b; - while (*cbeg != chb) cbeg++; - - che = (unsigned char) *(e + (int) (cbeg - (unsigned char *) b)); - - while (((chb = *s++) != 0) && (chb != che)); - - if (chb == 0) - { - /* end of string and end not found. Just truncate it a return; */ - *mark = 0; - break; - } - - strcpy ((char *) mark, (char *)s); - s = mark; - } - SLang_push_malloced_string (str); -} - -/*}}}*/ - -static void str_quote_string_cmd (char *str, char *quotes, int *slash_ptr) /*{{{*/ -{ - char *q; - int slash; - unsigned int len; - register char *t, *s, *q1; - register unsigned char ch; - - slash = *slash_ptr; - - if ((slash > 255) || (slash < 0)) - { - SLang_Error = SL_INVALID_PARM; - return; - } - - /* setup the utility table to have 1s at quote char postitions. */ - set_utility_char_table (quotes); - - t = Utility_Char_Table; - t[(unsigned int) slash] = 1; - - /* calculate length */ - s = str; - len = 0; - while ((ch = (unsigned char) *s++) != 0) if (t[ch]) len++; - len += (unsigned int) (s - str); - - if (NULL != (q = SLmalloc(len))) - { - s = str; q1 = q; - while ((ch = (unsigned char) *s++) != 0) - { - if (t[ch]) *q1++ = slash; - *q1++ = (char) ch; - } - *q1 = 0; - SLang_push_malloced_string(q); - } -} - -/*}}}*/ - -/* returns the position of substrin in a string or null */ -static int issubstr_cmd (char *a, char *b) /*{{{*/ -{ - char *c; - - if (NULL == (c = (char *) strstr(a, b))) - return 0; - - return 1 + (int) (c - a); -} - -/*}}}*/ - -/* returns to stack string at pos n to n + m of a */ -static void substr_cmd (char *a, int *n_ptr, int *m_ptr) /*{{{*/ -{ - int n, m; - int lena; - - n = *n_ptr; - m = *m_ptr; - - lena = strlen (a); - if (n > lena) n = lena + 1; - if (n < 1) - { - SLang_Error = SL_INVALID_PARM; - return; - } - - n--; - if (m < 0) m = lena; - if (n + m > lena) m = lena - n; - - (void) _SLang_push_nstring (a + n, (unsigned int) m); -} - -/*}}}*/ - -/* substitute char m at positin string n in string*/ -static void strsub_cmd (int *nptr, int *mptr) /*{{{*/ -{ - char *a; - int n, m; - unsigned int lena; - - if (-1 == SLpop_string (&a)) - return; - - n = *nptr; - m = *mptr; - - lena = strlen (a); - - if ((n <= 0) || (lena < (unsigned int) n)) - { - SLang_Error = SL_INVALID_PARM; - SLfree(a); - return; - } - - a[n - 1] = (char) m; - - SLang_push_malloced_string (a); -} - -/*}}}*/ - -static void strup_cmd(void) /*{{{*/ -{ - unsigned char c, *a; - char *str; - - if (SLpop_string (&str)) - return; - - a = (unsigned char *) str; - while ((c = *a) != 0) - { - /* if ((*a >= 'a') && (*a <= 'z')) *a -= 32; */ - *a = UPPER_CASE(c); - a++; - } - - SLang_push_malloced_string (str); -} - -/*}}}*/ - -static int isdigit_cmd (char *what) /*{{{*/ -{ - return isdigit((unsigned char)*what); -} - -/*}}}*/ -static int toupper_cmd (int *ch) /*{{{*/ -{ - return UPPER_CASE(*ch); -} - -/*}}}*/ - -static int tolower_cmd (int *ch) /*{{{*/ -{ - return LOWER_CASE(*ch); -} - -/*}}}*/ - -static void strlow_cmd (void) /*{{{*/ -{ - unsigned char c, *a; - char *str; - - if (SLpop_string(&str)) return; - a = (unsigned char *) str; - while ((c = *a) != 0) - { - /* if ((*a >= 'a') && (*a <= 'z')) *a -= 32; */ - *a = LOWER_CASE(c); - a++; - } - - SLang_push_malloced_string ((char *) str); -} - -/*}}}*/ - -static SLang_Array_Type *do_strchop (char *str, int delim, int quote) -{ - int count; - char *s0, *elm; - register char *s1; - register unsigned char ch; - int quoted; - SLang_Array_Type *at; - char **data; - - if ((quote < 0) || (quote > 255) - || (delim <= 0) || (delim > 255)) - { - SLang_Error = SL_INVALID_PARM; - return NULL; - } - - s1 = s0 = str; - - quoted = 0; - count = 1; /* at least 1 */ - while (1) - { - ch = (unsigned char) *s1++; - if ((ch == quote) && quote) - { - if (*s1 == 0) - break; - - s1++; - continue; - } - - if (ch == delim) - { - count++; - continue; - } - - if (ch == 0) - break; - } - - if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &count, 1))) - return NULL; - - data = (char **)at->data; - - count = 0; - s1 = s0; - - while (1) - { - ch = (unsigned char) *s1; - - if ((ch == quote) && quote) - { - s1++; - if (*s1 != 0) s1++; - quoted = 1; - continue; - } - - if ((ch == delim) || (ch == 0)) - { - if (quoted == 0) - elm = SLang_create_nslstring (s0, (unsigned int) (s1 - s0)); - else - { - register char ch1, *p, *p1; - char *tmp; - - tmp = SLmake_nstring (s0, (unsigned int)(s1 - s0)); - if (tmp == NULL) - break; - - /* Now unquote it */ - p = p1 = tmp; - do - { - ch1 = *p1++; - if (ch1 == '\\') ch1 = *p1++; - *p++ = ch1; - } - while (ch1 != 0); - quoted = 0; - - elm = SLang_create_slstring (tmp); - SLfree (tmp); - } - - if (elm == NULL) - break; - - data[count] = elm; - count++; - - if (ch == 0) - return at; - - s1++; /* skip past delim */ - s0 = s1; /* and reset */ - } - else s1++; - } - - SLang_free_array (at); - return NULL; -} - -static void strchop_cmd (char *str, int *q, int *d) -{ - (void) SLang_push_array (do_strchop (str, *q, *d), 1); -} - -static void strchopr_cmd (char *str, int *q, int *d) -{ - SLang_Array_Type *at; - - if (NULL != (at = do_strchop (str, *q, *d))) - { - char **d0, **d1; - - d0 = (char **) at->data; - d1 = d0 + (at->num_elements - 1); - - while (d0 < d1) - { - char *tmp; - - tmp = *d0; - *d0 = *d1; - *d1 = tmp; - d0++; - d1--; - } - } - SLang_push_array (at, 1); -} - -static int strcmp_cmd (char *a, char *b) /*{{{*/ -{ - return strcmp(a, b); -} - -/*}}}*/ - -static int strncmp_cmd (char *a, char *b, int *n) /*{{{*/ -{ - return strncmp(a, b, (unsigned int) *n); -} - -/*}}}*/ - -static int strlen_cmd (char *s) /*{{{*/ -{ - return (int) strlen (s); -} -/*}}}*/ - -static void extract_element_cmd (char *list, int *nth_ptr, int *delim_ptr) -{ - char buf[1024], *b; - - b = buf; - if (-1 == SLextract_list_element (list, *nth_ptr, *delim_ptr, buf, sizeof(buf))) - b = NULL; - - SLang_push_string (b); -} - -/* sprintf functionality for S-Lang */ - -static char *SLdo_sprintf (char *fmt) /*{{{*/ -{ - register char *p = fmt, ch; - char *out = NULL, *outp = NULL; - char dfmt[1024]; /* used to hold part of format */ - char *f; - VOID_STAR varp; - int want_width, width, precis, use_varp, int_var; - long long_var; - unsigned int len = 0, malloc_len = 0, dlen; - int do_free, guess_size; -#if SLANG_HAS_FLOAT - int tmp1, tmp2, use_double; - double x; -#endif - int use_long = 0; - - while (1) - { - while ((ch = *p) != 0) - { - if (ch == '%') - break; - p++; - } - - /* p points at '%' or 0 */ - - dlen = (unsigned int) (p - fmt); - - if (len + dlen >= malloc_len) - { - malloc_len = len + dlen; - if (out == NULL) outp = SLmalloc(malloc_len + 1); - else outp = SLrealloc(out, malloc_len + 1); - if (NULL == outp) - return out; - out = outp; - outp = out + len; - } - - strncpy(outp, fmt, dlen); - len += dlen; - outp = out + len; - *outp = 0; - if (ch == 0) break; - - /* bump it beyond '%' */ - ++p; - fmt = p; - - f = dfmt; - *f++ = ch; - /* handle flag char */ - ch = *p++; - - /* Make sure cases such as "% #g" can be handled. */ - if ((ch == '-') || (ch == '+') || (ch == ' ') || (ch == '#')) - { - *f++ = ch; - ch = *p++; - if ((ch == '-') || (ch == '+') || (ch == ' ') || (ch == '#')) - { - *f++ = ch; - ch = *p++; - } - } - - - /* width */ - /* I have got to parse it myself so that I can see how big it needs - * to be. - */ - want_width = width = 0; - if (ch == '*') - { - if (SLang_pop_integer(&width)) return (out); - want_width = 1; - ch = *p++; - } - else - { - if (ch == '0') - { - *f++ = '0'; - ch = *p++; - } - - while ((ch <= '9') && (ch >= '0')) - { - width = width * 10 + (ch - '0'); - ch = *p++; - want_width = 1; - } - } - - if (want_width) - { - sprintf(f, "%d", width); - f += strlen (f); - } - precis = 0; - /* precision -- also indicates max number of chars from string */ - if (ch == '.') - { - *f++ = ch; - ch = *p++; - want_width = 0; - if (ch == '*') - { - if (SLang_pop_integer(&precis)) return (out); - ch = *p++; - want_width = 1; - } - else while ((ch <= '9') && (ch >= '0')) - { - precis = precis * 10 + (ch - '0'); - ch = *p++; - want_width = 1; - } - if (want_width) - { - sprintf(f, "%d", precis); - f += strlen (f); - } - else precis = 0; - } - - long_var = 0; - int_var = 0; - varp = NULL; - guess_size = 32; -#if SLANG_HAS_FLOAT - use_double = 0; -#endif - use_long = 0; - use_varp = 0; - do_free = 0; - - if (ch == 'l') - { - use_long = 1; - ch = *p++; - } - else if (ch == 'h') ch = *p++; /* not supported */ - - /* Now the actual format specifier */ - switch (ch) - { - case 'S': - _SLstring_intrinsic (); - ch = 's'; - /* drop */ - case 's': - if (SLang_pop_slstring((char **) &varp)) return (out); - do_free = 1; - guess_size = strlen((char *) varp); - use_varp = 1; - break; - - case '%': - guess_size = 1; - do_free = 0; - use_varp = 1; - varp = (VOID_STAR) "%"; - break; - - case 'c': guess_size = 1; - use_long = 0; - /* drop */ - case 'd': - case 'i': - case 'o': - case 'u': - case 'X': - case 'x': - if (SLang_pop_long (&long_var)) return(out); - if (use_long == 0) - int_var = (int) long_var; - else - *f++ = 'l'; - break; - - case 'f': - case 'e': - case 'g': - case 'E': - case 'G': -#if SLANG_HAS_FLOAT - if (SLang_pop_double(&x, &tmp1, &tmp2)) return (out); - use_double = 1; - guess_size = 256; - (void) tmp1; (void) tmp2; - use_long = 0; - break; -#endif - case 'p': - guess_size = 32; - /* Pointer type?? Why?? */ - if (-1 == SLdo_pop ()) - return out; - varp = (VOID_STAR) _SLStack_Pointer; - use_varp = 1; - use_long = 0; - break; - - default: - SLang_doerror("Invalid Format."); - return(out); - } - *f++ = ch; *f = 0; - - width = width + precis; - if (width > guess_size) guess_size = width; - - if (len + guess_size > malloc_len) - { - outp = (char *) SLrealloc(out, len + guess_size + 1); - if (outp == NULL) - { - SLang_Error = SL_MALLOC_ERROR; - return (out); - } - out = outp; - outp = out + len; - malloc_len = len + guess_size; - } - - if (use_varp) - { - sprintf(outp, dfmt, varp); - if (do_free) SLang_free_slstring ((char *)varp); - } -#if SLANG_HAS_FLOAT - else if (use_double) sprintf(outp, dfmt, x); -#endif - else if (use_long) sprintf (outp, dfmt, long_var); - else sprintf(outp, dfmt, int_var); - - len += strlen(outp); - outp = out + len; - fmt = p; - } - - if (out != NULL) - { - outp = SLrealloc (out, (unsigned int) (outp - out) + 1); - if (outp != NULL) out = outp; - } - - return (out); -} - -/*}}}*/ - -int _SLstrops_do_sprintf_n (int n) /*{{{*/ -{ - char *p; - char *fmt; - SLang_Object_Type *ptr; - int ofs; - - if (-1 == (ofs = SLreverse_stack (n + 1))) - return -1; - - ptr = _SLRun_Stack + ofs; - - if (SLang_pop_slstring(&fmt)) - return -1; - - p = SLdo_sprintf (fmt); - SLang_free_slstring (fmt); - - while (_SLStack_Pointer > ptr) - SLdo_pop (); - - if (SLang_Error) - { - SLfree (p); - return -1; - } - - return SLang_push_malloced_string (p); -} - -/*}}}*/ - -static void sprintf_n_cmd (int *n) -{ - _SLstrops_do_sprintf_n (*n); -} - -static void sprintf_cmd (void) -{ - _SLstrops_do_sprintf_n (SLang_Num_Function_Args - 1); /* do not include format */ -} - -/* converts string s to a form that can be used in an eval */ -static void make_printable_string(char *s) /*{{{*/ -{ - unsigned int len; - register char *s1 = s, ch, *ss1; - char *ss; - - /* compute length */ - len = 3; - while ((ch = *s1++) != 0) - { - if ((ch == '\n') || (ch == '\\') || (ch == '"')) len++; - len++; - } - - if (NULL == (ss = SLmalloc(len))) - return; - - s1 = s; - ss1 = ss; - *ss1++ = '"'; - while ((ch = *s1++) != 0) - { - if (ch == '\n') - { - ch = 'n'; - *ss1++ = '\\'; - } - else if ((ch == '\\') || (ch == '"')) - { - *ss1++ = '\\'; - } - *ss1++ = ch; - } - *ss1++ = '"'; - *ss1 = 0; - if (-1 == SLang_push_string (ss)) - SLfree (ss); -} - -/*}}}*/ - -static int is_list_element_cmd (char *list, char *elem, int *d_ptr) -{ - char ch; - int d, n; - unsigned int len; - char *lbeg, *lend; - - d = *d_ptr; - - len = strlen (elem); - - n = 1; - lend = list; - - while (1) - { - lbeg = lend; - while ((0 != (ch = *lend)) && (ch != (char) d)) lend++; - - if ((lbeg + len == lend) - && (0 == strncmp (elem, lbeg, len))) - break; - - if (ch == 0) - { - n = 0; - break; - } - lend++; /* skip delim */ - n++; - } - - return n; -} - -/*}}}*/ - -/* Regular expression routines for strings */ -static SLRegexp_Type regexp_reg; - -static int string_match_cmd (char *str, char *pat, int *nptr) /*{{{*/ -{ - int n; - unsigned int len; - unsigned char rbuf[512], *match; - - n = *nptr; - - regexp_reg.case_sensitive = 1; - regexp_reg.buf = rbuf; - regexp_reg.pat = (unsigned char *) pat; - regexp_reg.buf_len = sizeof (rbuf); - - if (SLang_regexp_compile (®exp_reg)) - { - SLang_verror (SL_INVALID_PARM, "Unable to compile pattern"); - return -1; - } - - n--; - len = strlen(str); - if ((n < 0) || ((unsigned int) n >= len)) - { - /* SLang_Error = SL_INVALID_PARM; */ - return 0; - } - - str += n; - len -= n; - - if (NULL == (match = SLang_regexp_match((unsigned char *) str, len, ®exp_reg))) - return 0; - - /* adjust offsets */ - regexp_reg.offset = n; - - return (1 + (int) ((char *) match - str)); -} - -/*}}}*/ - -static int string_match_nth_cmd (int *nptr) /*{{{*/ -{ - int n, beg; - - n = *nptr; - - if ((n < 0) || (n > 9) || (regexp_reg.pat == NULL) - || ((beg = regexp_reg.beg_matches[n]) == -1)) - { - SLang_Error = SL_INVALID_PARM; - return -1; - } - SLang_push_integer(beg + regexp_reg.offset); - return regexp_reg.end_matches[n]; -} - -/*}}}*/ - -static char *create_delimited_string (char **list, unsigned int n, - char *delim) -{ - unsigned int len, dlen; - unsigned int i; - unsigned int num; - char *str, *s; - - len = 1; /* allow room for \0 char */ - num = 0; - for (i = 0; i < n; i++) - { - if (list[i] == NULL) continue; - len += strlen (list[i]); - num++; - } - - dlen = strlen (delim); - if (num > 1) - len += (num - 1) * dlen; - - if (NULL == (str = SLmalloc (len))) - return NULL; - - *str = 0; - s = str; - i = 0; - - while (num > 1) - { - while (list[i] == NULL) - i++; - - strcpy (s, list[i]); - s += strlen (list[i]); - strcpy (s, delim); - s += dlen; - i++; - num--; - } - - if (num) - { - while (list[i] == NULL) - i++; - - strcpy (s, list[i]); - } - - return str; -} - -static void create_delimited_string_cmd (int *nptr) -{ - unsigned int n, i; - char **strings; - char *str; - - str = NULL; - - n = 1 + (unsigned int) *nptr; /* n includes delimiter */ - - if (NULL == (strings = (char **)SLmalloc (n * sizeof (char *)))) - { - SLdo_pop_n (n); - return; - } - memset((char *)strings, 0, n * sizeof (char *)); - - i = n; - while (i != 0) - { - i--; - if (-1 == SLang_pop_slstring (strings + i)) - goto return_error; - } - - str = create_delimited_string (strings + 1, (n - 1), strings[0]); - /* drop */ - return_error: - for (i = 0; i < n; i++) SLang_free_slstring (strings[i]); - SLfree ((char *)strings); - - (void) SLang_push_malloced_string (str); /* NULL Ok */ -} - -static void strjoin_cmd (char *delim) -{ - SLang_Array_Type *at; - char *str; - - if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE)) - return; - - str = create_delimited_string ((char **)at->data, at->num_elements, delim); - SLang_free_array (at); - (void) SLang_push_malloced_string (str); /* NULL Ok */ -} - -static void str_delete_chars_cmd (char *s, char *d) -{ - unsigned char lut[256]; - unsigned char *s1, *s2; - unsigned char ch; - - make_lut ((unsigned char *)d, lut); - if (NULL == (s = SLmake_string (s))) - return; - - s1 = s2 = (unsigned char *) s; - while ((ch = *s2++) != 0) - { - if (0 == lut[ch]) - *s1++ = ch; - } - *s1 = 0; - - (void) SLang_push_malloced_string (s); -} - -static unsigned char *make_lut_string (unsigned char *s) -{ - unsigned char lut[256]; - unsigned char *l; - unsigned int i; - - /* Complement-- a natural order is imposed */ - make_lut (s, lut); - l = lut; - for (i = 1; i < 256; i++) - { - if (lut[i]) - *l++ = (unsigned char) i; - } - *l = 0; - return (unsigned char *) SLmake_string ((char *)lut); -} - -static unsigned char *make_str_range (unsigned char *s) -{ - unsigned char *s1, *range; - unsigned int num; - unsigned char ch; - int len; - - if (*s == '^') - return make_lut_string (s); - - num = 0; - s1 = s; - while ((ch = *s1++) != 0) - { - unsigned char ch1; - - ch1 = *s1; - if (ch1 == '-') - { - s1++; - ch1 = *s1; - len = (int)ch1 - (int)ch; - if (len < 0) - len = -len; - - num += (unsigned int) len; - if (ch1 != 0) - s1++; - } - - num++; - } - - range = (unsigned char *)SLmalloc (num + 1); - if (range == NULL) - return NULL; - - s1 = s; - s = range; - while ((ch = *s1++) != 0) - { - unsigned char ch1; - unsigned int i; - - ch1 = *s1; - if (ch1 != '-') - { - *s++ = ch; - continue; - } - - s1++; - ch1 = *s1; - - if (ch > ch1) - { - if (ch1 == 0) - ch1 = 1; - - for (i = (unsigned int) ch; i >= (unsigned int) ch1; i--) - *s++ = (unsigned char) i; - - if (*s1 == 0) - break; - } - else - { - for (i = (unsigned int) ch; i <= (unsigned int) ch1; i++) - *s++ = (unsigned char) i; - } - s1++; - } - -#if 0 - if (range + num != s) - SLang_verror (SL_INTERNAL_ERROR, "make_str_range: num wrong"); -#endif - *s = 0; - - return range; -} - -static void strtrans_cmd (char *s, unsigned char *from, unsigned char *to) -{ - unsigned char map[256]; - char *s1; - unsigned int i; - unsigned char ch; - unsigned char last_to; - unsigned char *from_range, *to_range; - - for (i = 0; i < 256; i++) map[i] = (unsigned char) i; - - if (*to == 0) - { - str_delete_chars_cmd (s, (char *)from); - return; - } - - from_range = make_str_range (from); - if (from_range == NULL) - return; - to_range = make_str_range (to); - if (to_range == NULL) - { - SLfree ((char *)from_range); - return; - } - - from = from_range; - to = to_range; - - last_to = 0; - while ((ch = *from++) != 0) - { - unsigned char to_ch; - - if (0 == (to_ch = *to++)) - { - do - { - map[ch] = last_to; - } - while (0 != (ch = *from++)); - break; - } - - last_to = map[ch] = to_ch; - } - - SLfree ((char *)from_range); - SLfree ((char *)to_range); - - s = SLmake_string (s); - if (s == NULL) - return; - - s1 = s; - while ((ch = (unsigned char) *s1) != 0) - *s1++ = (char) map[ch]; - - (void) SLang_push_malloced_string (s); -} - - -static SLang_Intrin_Fun_Type Strops_Table [] = /*{{{*/ -{ - MAKE_INTRINSIC_I("create_delimited_string", create_delimited_string_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SS("strcmp", strcmp_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_SSI("strncmp", strncmp_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_0("strcat", strcat_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("strlen", strlen_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_SII("strchop", strchop_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SII("strchopr", strchopr_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_I("strreplace", strreplace_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_SSS("str_replace", str_replace_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_SII("substr", substr_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SS("is_substr", issubstr_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_II("strsub", strsub_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SII("extract_element", extract_element_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SSI("is_list_element", is_list_element_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_SSI("string_match", string_match_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_I("string_match_nth", string_match_nth_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_0("strlow", strlow_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_I("tolower", tolower_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_I("toupper", toupper_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_0("strup", strup_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("isdigit", isdigit_cmd, SLANG_INT_TYPE), - MAKE_INTRINSIC_S("strtrim", strtrim_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("strtrim_end", strtrim_end_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("strtrim_beg", strtrim_beg_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("strcompress", strcompress_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_I("Sprintf", sprintf_n_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("sprintf", sprintf_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("sscanf", _SLang_sscanf, SLANG_INT_TYPE), - MAKE_INTRINSIC_S("make_printable_string", make_printable_string, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SSI("str_quote_string", str_quote_string_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SSS("str_uncomment_string", str_uncomment_string_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_II("define_case", SLang_define_case, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("strtok", strtok_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_S("strjoin", strjoin_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SSS("strtrans", strtrans_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_SS("str_delete_chars", str_delete_chars_cmd, SLANG_VOID_TYPE), - - SLANG_END_INTRIN_FUN_TABLE -}; - -/*}}}*/ - -int _SLang_init_slstrops (void) -{ - return SLadd_intrin_fun_table (Strops_Table, NULL); -} diff --git a/mdk-stage1/slang/slstruct.c b/mdk-stage1/slang/slstruct.c deleted file mode 100644 index 33d182373..000000000 --- a/mdk-stage1/slang/slstruct.c +++ /dev/null @@ -1,932 +0,0 @@ -/* Structure type implementation */ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#define SL_APP_WANTS_FOREACH -#include "slang.h" -#include "_slang.h" - -void _SLstruct_delete_struct (_SLang_Struct_Type *s) -{ - _SLstruct_Field_Type *field, *field_max; - - if (s == NULL) return; - - if (s->num_refs > 1) - { - s->num_refs -= 1; - return; - } - - field = s->fields; - if (field != NULL) - { - field_max = field + s->nfields; - - while (field < field_max) - { - SLang_free_object (&field->obj); - SLang_free_slstring (field->name); /* could be NULL */ - field++; - } - SLfree ((char *) s->fields); - } - SLfree ((char *) s); -} - -static _SLang_Struct_Type *allocate_struct (unsigned int nfields) -{ - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - unsigned int i, size; - - s = (_SLang_Struct_Type *) SLmalloc (sizeof (_SLang_Struct_Type)); - if (s == NULL) return NULL; - - SLMEMSET((char *) s, 0, sizeof (_SLang_Struct_Type)); - - size = nfields * sizeof(_SLstruct_Field_Type); - if (NULL == (f = (_SLstruct_Field_Type *) SLmalloc (size))) - { - SLfree ((char *) s); - return NULL; - } - SLMEMSET ((char *) f, 0, size); - s->nfields = nfields; - s->fields = f; - - /* By default, all structs will be created with elements set to NULL. I - * do not know whether or not it is better to use SLANG_UNDEFINED_TYPE. - */ - for (i = 0; i < nfields; i++) - f[i].obj.data_type = SLANG_NULL_TYPE; - - return s; -} - -static int push_struct_of_type (unsigned char type, _SLang_Struct_Type *s) -{ - SLang_Object_Type obj; - - obj.data_type = type; - obj.v.struct_val = s; - s->num_refs += 1; - - if (0 == SLang_push (&obj)) - return 0; - - s->num_refs -= 1; - return -1; -} - -int _SLang_push_struct (_SLang_Struct_Type *s) -{ - return push_struct_of_type (SLANG_STRUCT_TYPE, s); -} - -int _SLang_pop_struct (_SLang_Struct_Type **sp) -{ - SLang_Object_Type obj; - SLang_Class_Type *cl; - unsigned char type; - - if (0 != SLang_pop (&obj)) - return -1; - - type = obj.data_type; - if (type != SLANG_STRUCT_TYPE) - { - cl = _SLclass_get_class (type); - if (cl->cl_struct_def == NULL) - { - *sp = NULL; - SLang_free_object (&obj); - SLang_verror (SL_TYPE_MISMATCH, - "Expecting struct type object. Found %s", - cl->cl_name); - return -1; - } - } - - *sp = obj.v.struct_val; - return 0; -} - -static void struct_destroy (unsigned char type, VOID_STAR vs) -{ - (void) type; - _SLstruct_delete_struct (*(_SLang_Struct_Type **) vs); -} - -static int struct_push (unsigned char type, VOID_STAR ptr) -{ - return push_struct_of_type (type, *(_SLang_Struct_Type **) ptr); -} - -static _SLstruct_Field_Type *find_field (_SLang_Struct_Type *s, char *name) -{ - _SLstruct_Field_Type *f, *fmax; - - f = s->fields; - fmax = f + s->nfields; - - while (f < fmax) - { - /* Since both these are slstrings, only compare pointer */ - if (name == f->name) - return f; - - f++; - } - - return NULL; -} - -static _SLstruct_Field_Type *pop_field (_SLang_Struct_Type *s, char *name) -{ - _SLstruct_Field_Type *f; - - f = find_field (s, name); - if (f == NULL) - SLang_verror (SL_SYNTAX_ERROR, "struct has no field named %s", name); - return f; -} - -int SLstruct_create_struct (unsigned int nfields, - char **field_names, - unsigned char *field_types, - VOID_STAR *field_values) -{ - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - unsigned int i; - - if (NULL == (s = allocate_struct (nfields))) - return -1; - - f = s->fields; - for (i = 0; i < nfields; i++) - { - unsigned char type; - SLang_Class_Type *cl; - VOID_STAR value; - char *name = field_names [i]; - - if (name == NULL) - { - SLang_verror (SL_INVALID_PARM, "A struct field name cannot be NULL"); - goto return_error; - } - - if (NULL == (f->name = SLang_create_slstring (name))) - goto return_error; - - if ((field_values == NULL) - || (NULL == (value = field_values [i]))) - { - f++; - continue; - } - - type = field_types[i]; - cl = _SLclass_get_class (type); - - if ((-1 == (cl->cl_push (type, value))) - || (-1 == SLang_pop (&f->obj))) - goto return_error; - - f++; - } - - if (0 == _SLang_push_struct (s)) - return 0; - /* drop */ - - return_error: - _SLstruct_delete_struct (s); - return -1; -} - -/* Interpreter interface */ - -int _SLstruct_define_struct (void) -{ - int nfields; - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - - if (-1 == SLang_pop_integer (&nfields)) - return -1; - - if (nfields <= 0) - { - SLang_verror (SL_INVALID_PARM, "Number of struct fields must be > 0"); - return -1; - } - - if (NULL == (s = allocate_struct (nfields))) - return -1; - - f = s->fields; - while (nfields) - { - char *name; - - nfields--; - if (-1 == SLang_pop_slstring (&name)) - { - _SLstruct_delete_struct (s); - return -1; - } - f[nfields].name = name; - } - - if (-1 == _SLang_push_struct (s)) - { - _SLstruct_delete_struct (s); - return -1; - } - return 0; -} - -/* Simply make a struct that contains the same fields as struct s. Do not - * duplicate the field values. - */ -static _SLang_Struct_Type *make_struct_shell (_SLang_Struct_Type *s) -{ - _SLang_Struct_Type *new_s; - _SLstruct_Field_Type *new_f, *old_f; - unsigned int i, nfields; - - nfields = s->nfields; - if (NULL == (new_s = allocate_struct (nfields))) - return NULL; - - new_f = new_s->fields; - old_f = s->fields; - - for (i = 0; i < nfields; i++) - { - if (NULL == (new_f[i].name = SLang_create_slstring (old_f[i].name))) - { - _SLstruct_delete_struct (new_s); - return NULL; - } - } - return new_s; -} - -static int struct_init_array_object (unsigned char type, VOID_STAR addr) -{ - SLang_Class_Type *cl; - _SLang_Struct_Type *s; - - cl = _SLclass_get_class (type); - if (NULL == (s = make_struct_shell (cl->cl_struct_def))) - return -1; - - s->num_refs = 1; - *(_SLang_Struct_Type **) addr = s; - return 0; -} - -static int -typedefed_struct_datatype_deref (unsigned char type) -{ - SLang_Class_Type *cl; - _SLang_Struct_Type *s; - - cl = _SLclass_get_class (type); - if (NULL == (s = make_struct_shell (cl->cl_struct_def))) - return -1; - - if (-1 == push_struct_of_type (type, s)) - { - _SLstruct_delete_struct (s); - return -1; - } - - return 0; -} - -static _SLang_Struct_Type *duplicate_struct (_SLang_Struct_Type *s) -{ - _SLang_Struct_Type *new_s; - _SLstruct_Field_Type *new_f, *f, *fmax; - - new_s = make_struct_shell (s); - - if (new_s == NULL) - return NULL; - - f = s->fields; - fmax = f + s->nfields; - new_f = new_s->fields; - - while (f < fmax) - { - SLang_Object_Type *obj; - - obj = &f->obj; - if (obj->data_type != SLANG_UNDEFINED_TYPE) - { - if ((-1 == _SLpush_slang_obj (obj)) - || (-1 == SLang_pop (&new_f->obj))) - { - _SLstruct_delete_struct (new_s); - return NULL; - } - } - new_f++; - f++; - } - - return new_s; -} - -static int struct_dereference (unsigned char type, VOID_STAR addr) -{ - _SLang_Struct_Type *s; - - if (NULL == (s = duplicate_struct (*(_SLang_Struct_Type **) addr))) - return -1; - - if (-1 == push_struct_of_type (type, s)) - { - _SLstruct_delete_struct (s); - return -1; - } - - return 0; -} - -/*{{{ foreach */ - -struct _SLang_Foreach_Context_Type -{ - _SLang_Struct_Type *s; - char *next_field_name; -}; - -static SLang_Foreach_Context_Type * -struct_foreach_open (unsigned char type, unsigned int num) -{ - SLang_Foreach_Context_Type *c; - _SLang_Struct_Type *s; - char *next_name; - - (void) type; - - if (-1 == _SLang_pop_struct (&s)) - return NULL; - - switch (num) - { - case 0: - next_name = SLang_create_slstring ("next"); - break; - - case 1: - if (-1 == SLang_pop_slstring (&next_name)) - next_name = NULL; - break; - - default: - next_name = NULL; - SLang_verror (SL_NOT_IMPLEMENTED, - "'foreach (Struct_Type) using' requires single control value"); - SLdo_pop_n (num); - break; - } - - if (next_name == NULL) - { - _SLstruct_delete_struct (s); - return NULL; - } - - c = (SLang_Foreach_Context_Type *)SLmalloc (sizeof (SLang_Foreach_Context_Type)); - if (c == NULL) - { - _SLstruct_delete_struct (s); - SLang_free_slstring (next_name); - return NULL; - } - memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type)); - - c->next_field_name = next_name; - c->s = s; - - return c; -} - -static void struct_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c) -{ - (void) type; - if (c == NULL) return; - - SLang_free_slstring (c->next_field_name); - if (c->s != NULL) _SLstruct_delete_struct (c->s); - SLfree ((char *) c); -} - -static int struct_foreach (unsigned char type, SLang_Foreach_Context_Type *c) -{ - _SLstruct_Field_Type *f; - _SLang_Struct_Type *next_s; - - (void) type; - - if (c == NULL) - return -1; - - if (c->s == NULL) - return 0; /* done */ - - if (-1 == _SLang_push_struct (c->s)) - return -1; - - /* Now get the next one ready for the next foreach loop */ - - next_s = NULL; - if (NULL != (f = find_field (c->s, c->next_field_name))) - { - SLang_Class_Type *cl; - - cl = _SLclass_get_class (f->obj.data_type); - /* Note that I cannot simply look for SLANG_STRUCT_TYPE since the - * user may have typedefed another struct type. So, look at the - * class methods. - */ - if (cl->cl_foreach_open == struct_foreach_open) - { - next_s = f->obj.v.struct_val; - next_s->num_refs += 1; - } - } - - _SLstruct_delete_struct (c->s); - c->s = next_s; - - /* keep going */ - return 1; -} - -/*}}}*/ - -static int struct_sput (unsigned char type, char *name) -{ - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - SLang_Object_Type obj; - - (void) type; - - if (-1 == _SLang_pop_struct (&s)) - return -1; - - if ((NULL == (f = pop_field (s, name))) - || (-1 == SLang_pop (&obj))) - { - _SLstruct_delete_struct (s); - return -1; - } - - SLang_free_object (&f->obj); - f->obj = obj; - _SLstruct_delete_struct (s); - return 0; -} - -static int struct_sget (unsigned char type, char *name) -{ - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - int ret; - - (void) type; - - if (-1 == _SLang_pop_struct (&s)) - return -1; - - if (NULL == (f = pop_field (s, name))) - { - _SLstruct_delete_struct (s); - return -1; - } - - ret = _SLpush_slang_obj (&f->obj); - _SLstruct_delete_struct (s); - return ret; -} - -static int struct_typecast - (unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp) -{ - _SLang_Struct_Type **a, **b; - unsigned int i; - - (void) a_type; - (void) b_type; - - a = (_SLang_Struct_Type **) ap; - b = (_SLang_Struct_Type **) bp; - for (i = 0; i < na; i++) - { - b[i] = a[i]; - if (a[i] != NULL) - a[i]->num_refs += 1; - } - - return 1; -} - -int _SLstruct_define_typedef (void) -{ - char *type_name; - _SLang_Struct_Type *s, *s1; - SLang_Class_Type *cl; - - if (-1 == SLang_pop_slstring (&type_name)) - return -1; - - if (-1 == _SLang_pop_struct (&s)) - { - SLang_free_slstring (type_name); - return -1; - } - - if (NULL == (s1 = make_struct_shell (s))) - { - SLang_free_slstring (type_name); - _SLstruct_delete_struct (s); - return -1; - } - - _SLstruct_delete_struct (s); - - if (NULL == (cl = SLclass_allocate_class (type_name))) - { - SLang_free_slstring (type_name); - _SLstruct_delete_struct (s1); - return -1; - } - SLang_free_slstring (type_name); - - cl->cl_struct_def = s1; - cl->cl_init_array_object = struct_init_array_object; - cl->cl_datatype_deref = typedefed_struct_datatype_deref; - cl->cl_destroy = struct_destroy; - cl->cl_push = struct_push; - cl->cl_dereference = struct_dereference; - cl->cl_foreach_open = struct_foreach_open; - cl->cl_foreach_close = struct_foreach_close; - cl->cl_foreach = struct_foreach; - - cl->cl_sget = struct_sget; - cl->cl_sput = struct_sput; - - if (-1 == SLclass_register_class (cl, - SLANG_VOID_TYPE, /* any open slot */ - sizeof (_SLang_Struct_Type), - SLANG_CLASS_TYPE_PTR)) - { - /* FIXME: Priority=low */ - /* There is a memory leak here if this fails... */ - return -1; - } - /* Note: typecast from a user type struct type allowed but not the other - * way. - */ - if (-1 == SLclass_add_typecast (cl->cl_data_type, SLANG_STRUCT_TYPE, struct_typecast, 1)) - return -1; - - return 0; -} - -static int -struct_datatype_deref (unsigned char stype) -{ - (void) stype; - - if (SLang_peek_at_stack () == SLANG_ARRAY_TYPE) - { - SLang_Array_Type *at; - int status; - - if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE)) - return -1; - - status = SLstruct_create_struct (at->num_elements, - (char **) at->data, NULL, NULL); - - SLang_free_array (at); - return status; - } - - SLang_push_integer (SLang_Num_Function_Args); - return _SLstruct_define_struct (); -} - -static int register_struct (void) -{ - SLang_Class_Type *cl; - - if (NULL == (cl = SLclass_allocate_class ("Struct_Type"))) - return -1; - - (void) SLclass_set_destroy_function (cl, struct_destroy); - (void) SLclass_set_push_function (cl, struct_push); - cl->cl_dereference = struct_dereference; - cl->cl_datatype_deref = struct_datatype_deref; - - cl->cl_foreach_open = struct_foreach_open; - cl->cl_foreach_close = struct_foreach_close; - cl->cl_foreach = struct_foreach; - - cl->cl_sget = struct_sget; - cl->cl_sput = struct_sput; - - if (-1 == SLclass_register_class (cl, SLANG_STRUCT_TYPE, sizeof (_SLang_Struct_Type), - SLANG_CLASS_TYPE_PTR)) - return -1; - - return 0; -} - -static void get_struct_field_names (_SLang_Struct_Type *s) -{ - SLang_Array_Type *a; - char **data; - int i, nfields; - _SLstruct_Field_Type *f; - - nfields = (int) s->nfields; - - if (NULL == (a = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &nfields, 1))) - return; - - f = s->fields; - data = (char **) a->data; - for (i = 0; i < nfields; i++) - { - /* Since we are dealing with hashed strings, the next call should not - * fail. If it does, the interpreter will handle it at some other - * level. - */ - data [i] = SLang_create_slstring (f[i].name); - } - - SLang_push_array (a, 1); -} - -static int push_struct_fields (_SLang_Struct_Type *s) -{ - _SLstruct_Field_Type *f, *fmax; - int num; - - f = s->fields; - fmax = f + s->nfields; - - num = 0; - while (fmax > f) - { - fmax--; - if (-1 == _SLpush_slang_obj (&fmax->obj)) - break; - - num++; - } - - return num; -} - -/* Syntax: set_struct_field (s, name, value); */ -static void struct_set_field (void) -{ - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - SLang_Object_Type obj; - char *name; - - if (-1 == SLang_pop (&obj)) - return; - - if (-1 == SLang_pop_slstring (&name)) - { - SLang_free_object (&obj); - return; - } - - if (-1 == _SLang_pop_struct (&s)) - { - SLang_free_slstring (name); - SLang_free_object (&obj); - return; - } - - if (NULL == (f = pop_field (s, name))) - { - _SLstruct_delete_struct (s); - SLang_free_slstring (name); - SLang_free_object (&obj); - return; - } - - SLang_free_object (&f->obj); - f->obj = obj; - - _SLstruct_delete_struct (s); - SLang_free_slstring (name); -} - -/* Syntax: set_struct_fields (s, values....); */ -static void set_struct_fields (void) -{ - unsigned int n; - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - - n = (unsigned int) SLang_Num_Function_Args; - - if (-1 == SLreverse_stack (n)) - return; - - n--; - if (-1 == _SLang_pop_struct (&s)) - { - SLdo_pop_n (n); - return; - } - - if (n > s->nfields) - { - SLdo_pop_n (n); - SLang_verror (SL_INVALID_PARM, "Too many values for structure"); - _SLstruct_delete_struct (s); - return; - } - - f = s->fields; - while (n > 0) - { - SLang_Object_Type obj; - - if (-1 == SLang_pop (&obj)) - break; - - SLang_free_object (&f->obj); - f->obj = obj; - - f++; - n--; - } - - _SLstruct_delete_struct (s); -} - -static void get_struct_field (char *name) -{ - (void) struct_sget (0, name); -} - -static int is_struct_type (void) -{ - SLang_Object_Type obj; - unsigned char type; - int status; - - if (-1 == SLang_pop (&obj)) - return -1; - - type = obj.data_type; - if (type == SLANG_STRUCT_TYPE) - status = 1; - else - status = (NULL != _SLclass_get_class (type)->cl_struct_def); - SLang_free_object (&obj); - return status; -} - - -static SLang_Intrin_Fun_Type Struct_Table [] = -{ - MAKE_INTRINSIC_1("get_struct_field_names", get_struct_field_names, SLANG_VOID_TYPE, SLANG_STRUCT_TYPE), - MAKE_INTRINSIC_1("get_struct_field", get_struct_field, SLANG_VOID_TYPE, SLANG_STRING_TYPE), - MAKE_INTRINSIC_1("_push_struct_field_values", push_struct_fields, SLANG_INT_TYPE, SLANG_STRUCT_TYPE), - MAKE_INTRINSIC_0("set_struct_field", struct_set_field, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("set_struct_fields", set_struct_fields, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("is_struct_type", is_struct_type, SLANG_INT_TYPE), - /* MAKE_INTRINSIC_I("_create_struct", create_struct, SLANG_VOID_TYPE), */ - SLANG_END_INTRIN_FUN_TABLE -}; - -int _SLstruct_init (void) -{ - if ((-1 == SLadd_intrin_fun_table (Struct_Table, NULL)) - || (-1 == register_struct ())) - return -1; - - return 0; -} - -void _SLstruct_pop_args (int *np) -{ - SLang_Array_Type *at; - int i, n; - _SLang_Struct_Type **data; - - n = *np; - - if (n < 0) - { - SLang_Error = SL_INVALID_PARM; - return; - } - - data = (_SLang_Struct_Type **) SLmalloc ((n + 1) * sizeof (_SLang_Struct_Type *)); - if (data == NULL) - { - SLdo_pop_n (n); - return; - } - - memset ((char *)data, 0, n * sizeof (_SLang_Struct_Type *)); - - i = n; - while (i > 0) - { - _SLang_Struct_Type *s; - _SLstruct_Field_Type *f; - - i--; - - if (NULL == (s = allocate_struct (1))) - goto return_error; - - data[i] = s; - s->num_refs += 1; /* keeping a copy */ - - f = s->fields; - if (NULL == (f->name = SLang_create_slstring ("value"))) - goto return_error; - - if (-1 == SLang_pop (&f->obj)) - goto return_error; - } - - if (NULL == (at = SLang_create_array (SLANG_STRUCT_TYPE, 0, - (VOID_STAR) data, &n, 1))) - goto return_error; - - (void) SLang_push_array (at, 1); - return; - - return_error: - for (i = 0; i < n; i++) - { - _SLang_Struct_Type *s; - - s = data[i]; - if (s != NULL) - _SLstruct_delete_struct (s); - } - - SLfree ((char *) data); -} - -void _SLstruct_push_args (SLang_Array_Type *at) -{ - _SLang_Struct_Type **sp; - unsigned int num; - - if (at->data_type != SLANG_STRUCT_TYPE) - { - SLang_Error = SL_TYPE_MISMATCH; - return; - } - - sp = (_SLang_Struct_Type **) at->data; - num = at->num_elements; - - while ((SLang_Error == 0) && (num > 0)) - { - _SLang_Struct_Type *s; - - num--; - if (NULL == (s = *sp++)) - { - SLang_push_null (); - continue; - } - - /* I should check to see if the value field is present, but... */ - (void) _SLpush_slang_obj (&s->fields->obj); - } -} diff --git a/mdk-stage1/slang/sltermin.c b/mdk-stage1/slang/sltermin.c deleted file mode 100644 index f9c64f0b2..000000000 --- a/mdk-stage1/slang/sltermin.c +++ /dev/null @@ -1,1155 +0,0 @@ -/* This file contains enough terminfo reading capabilities sufficient for - * the slang SLtt interface. - */ - -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -/* - * The majority of the comments found in the file were taken from the - * term(4) man page on an SGI. - */ - -/* Short integers are stored in two 8-bit bytes. The first byte contains - * the least significant 8 bits of the value, and the second byte contains - * the most significant 8 bits. (Thus, the value represented is - * 256*second+first.) The value -1 is represented by 0377,0377, and the - * value -2 is represented by 0376,0377; other negative values are illegal. - * The -1 generally means that a capability is missing from this terminal. - * The -2 means that the capability has been cancelled in the terminfo - * source and also is to be considered missing. - */ - -static int make_integer (unsigned char *buf) -{ - register int lo, hi; - lo = (int) *buf++; hi = (int) *buf; - if (hi == 0377) - { - if (lo == 0377) return -1; - if (lo == 0376) return -2; - } - return lo + 256 * hi; -} - -/* - * The compiled file is created from the source file descriptions of the - * terminals (see the -I option of infocmp) by using the terminfo compiler, - * tic, and read by the routine setupterm [see curses(3X).] The file is - * divided into six parts in the following order: the header, terminal - * names, boolean flags, numbers, strings, and string table. - * - * The header section begins the file. This section contains six short - * integers in the format described below. These integers are (1) the magic - * number (octal 0432); (2) the size, in bytes, of the names section; (3) - * the number of bytes in the boolean section; (4) the number of short - * integers in the numbers section; (5) the number of offsets (short - * integers) in the strings section; (6) the size, in bytes, of the string - * table. - */ - -#define MAGIC 0432 - -/* In this structure, all char * fields are malloced EXCEPT if the - * structure is SLTERMCAP. In that case, only terminal_names is malloced - * and the other fields are pointers into it. - */ -struct _SLterminfo_Type -{ -#define SLTERMINFO 1 -#define SLTERMCAP 2 - unsigned int flags; - - unsigned int name_section_size; - char *terminal_names; - - unsigned int boolean_section_size; - unsigned char *boolean_flags; - - unsigned int num_numbers; - unsigned char *numbers; - - unsigned int num_string_offsets; - unsigned char *string_offsets; - - unsigned int string_table_size; - char *string_table; - -}; - -static char *tcap_getstr (char *, SLterminfo_Type *); -static int tcap_getnum (char *, SLterminfo_Type *); -static int tcap_getflag (char *, SLterminfo_Type *); -static int tcap_getent (char *, SLterminfo_Type *); - -static FILE *open_terminfo (char *file, SLterminfo_Type *h) -{ - FILE *fp; - unsigned char buf[12]; - - /* Alan Cox reported a security problem here if the application using the - * library is setuid. So, I need to make sure open the file as a normal - * user. Unfortunately, there does not appear to be a portable way of - * doing this, so I am going to use 'setfsgid' and 'setfsuid', which - * are not portable. - * - * I will also look into the use of setreuid, seteuid and setregid, setegid. - * FIXME: Priority=medium - */ - fp = fopen (file, "rb"); - if (fp == NULL) return NULL; - - if ((12 == fread ((char *) buf, 1, 12, fp) && (MAGIC == make_integer (buf)))) - { - h->name_section_size = make_integer (buf + 2); - h->boolean_section_size = make_integer (buf + 4); - h->num_numbers = make_integer (buf + 6); - h->num_string_offsets = make_integer (buf + 8); - h->string_table_size = make_integer (buf + 10); - } - else - { - fclose (fp); - fp = NULL; - } - return fp; -} - -/* - * The terminal names section comes next. It contains the first line of the - * terminfo description, listing the various names for the terminal, - * separated by the bar ( | ) character (see term(5)). The section is - * terminated with an ASCII NUL character. - */ - -/* returns pointer to malloced space */ -static unsigned char *read_terminfo_section (FILE *fp, unsigned int size) -{ - char *s; - - if (NULL == (s = (char *) SLmalloc (size))) return NULL; - if (size != fread (s, 1, size, fp)) - { - SLfree (s); - return NULL; - } - return (unsigned char *) s; -} - -static char *read_terminal_names (FILE *fp, SLterminfo_Type *t) -{ - return t->terminal_names = (char *) read_terminfo_section (fp, t->name_section_size); -} - -/* - * The boolean flags have one byte for each flag. This byte is either 0 or - * 1 as the flag is present or absent. The value of 2 means that the flag - * has been cancelled. The capabilities are in the same order as the file - * <term.h>. - */ - -static unsigned char *read_boolean_flags (FILE *fp, SLterminfo_Type *t) -{ - /* Between the boolean section and the number section, a null byte is - * inserted, if necessary, to ensure that the number section begins on an - * even byte offset. All short integers are aligned on a short word - * boundary. - */ - - unsigned int size = (t->name_section_size + t->boolean_section_size) % 2; - size += t->boolean_section_size; - - return t->boolean_flags = read_terminfo_section (fp, size); -} - -/* - * The numbers section is similar to the boolean flags section. Each - * capability takes up two bytes, and is stored as a short integer. If the - * value represented is -1 or -2, the capability is taken to be missing. - */ - -static unsigned char *read_numbers (FILE *fp, SLterminfo_Type *t) -{ - return t->numbers = read_terminfo_section (fp, 2 * t->num_numbers); -} - -/* The strings section is also similar. Each capability is stored as a - * short integer, in the format above. A value of -1 or -2 means the - * capability is missing. Otherwise, the value is taken as an offset from - * the beginning of the string table. Special characters in ^X or \c - * notation are stored in their interpreted form, not the printing - * representation. Padding information ($<nn>) and parameter information - * (%x) are stored intact in uninterpreted form. - */ - -static unsigned char *read_string_offsets (FILE *fp, SLterminfo_Type *t) -{ - return t->string_offsets = (unsigned char *) read_terminfo_section (fp, 2 * t->num_string_offsets); -} - -/* The final section is the string table. It contains all the values of - * string capabilities referenced in the string section. Each string is - * null terminated. - */ - -static char *read_string_table (FILE *fp, SLterminfo_Type *t) -{ - return t->string_table = (char *) read_terminfo_section (fp, t->string_table_size); -} - -/* - * Compiled terminfo(4) descriptions are placed under the directory - * /usr/share/lib/terminfo. In order to avoid a linear search of a huge - * UNIX system directory, a two-level scheme is used: - * /usr/share/lib/terminfo/c/name where name is the name of the terminal, - * and c is the first character of name. Thus, att4425 can be found in the - * file /usr/share/lib/terminfo/a/att4425. Synonyms for the same terminal - * are implemented by multiple links to the same compiled file. - */ - -#define MAX_TI_DIRS 7 -static char *Terminfo_Dirs [MAX_TI_DIRS] = -{ - NULL, /* $HOME/.terminfo */ - NULL, /* $TERMINFO */ - "/usr/share/terminfo", - "/usr/lib/terminfo", - "/usr/share/lib/terminfo", - "/etc/terminfo", - "/usr/local/lib/terminfo" -}; - -SLterminfo_Type *_SLtt_tigetent (char *term) -{ - char *tidir; - int i; - FILE *fp = NULL; - char file[1024]; - static char home_ti [1024]; - char *home; - SLterminfo_Type *ti; - - if ( - (term == NULL) -#ifdef SLANG_UNTIC - && (SLang_Untic_Terminfo_File == NULL) -#endif - ) - return NULL; - - if (NULL == (ti = (SLterminfo_Type *) SLmalloc (sizeof (SLterminfo_Type)))) - { - return NULL; - } - -#ifdef SLANG_UNTIC - if (SLang_Untic_Terminfo_File != NULL) - { - fp = open_terminfo (SLang_Untic_Terminfo_File, ti); - goto fp_open_label; - } - else -#endif - /* If we are on a termcap based system, use termcap */ - if (0 == tcap_getent (term, ti)) return ti; - - if (NULL != (home = getenv ("HOME"))) - { - strncpy (home_ti, home, sizeof (home_ti) - 11); - home_ti [sizeof(home_ti) - 11] = 0; - strcat (home_ti, "/.terminfo"); - Terminfo_Dirs [0] = home_ti; - } - - Terminfo_Dirs[1] = getenv ("TERMINFO"); - i = 0; - while (i < MAX_TI_DIRS) - { - tidir = Terminfo_Dirs[i]; - if ((tidir != NULL) - && (sizeof (file) > strlen (tidir) + 2 + strlen (term))) - { - sprintf (file, "%s/%c/%s", tidir, *term, term); - if (NULL != (fp = open_terminfo (file, ti))) - break; - } - i++; - } -#ifdef SLANG_UNTIC - fp_open_label: -#endif - - if (fp != NULL) - { - if (NULL != read_terminal_names (fp, ti)) - { - if (NULL != read_boolean_flags (fp, ti)) - { - if (NULL != read_numbers (fp, ti)) - { - if (NULL != read_string_offsets (fp, ti)) - { - if (NULL != read_string_table (fp, ti)) - { - /* success */ - fclose (fp); - ti->flags = SLTERMINFO; - return ti; - } - SLfree ((char *)ti->string_offsets); - } - SLfree ((char *)ti->numbers); - } - SLfree ((char *)ti->boolean_flags); - } - SLfree ((char *)ti->terminal_names); - } - fclose (fp); - } - - SLfree ((char *)ti); - return NULL; -} - -#ifdef SLANG_UNTIC -# define UNTIC_COMMENT(x) ,x -#else -# define UNTIC_COMMENT(x) -#endif - -typedef struct -{ - char name[3]; - int offset; -#ifdef SLANG_UNTIC - char *comment; -#endif -} -Tgetstr_Map_Type; - -/* I need to add: K1-5, %0-5(not important), @8, &8... */ -static Tgetstr_Map_Type Tgetstr_Map [] = -{ - {"!1", 212 UNTIC_COMMENT("shifted key")}, - {"!2", 213 UNTIC_COMMENT("shifted key")}, - {"!3", 214 UNTIC_COMMENT("shifted key")}, - {"#1", 198 UNTIC_COMMENT("shifted key")}, - {"#2", 199 UNTIC_COMMENT("Key S-Home")}, - {"#3", 200 UNTIC_COMMENT("Key S-Insert")}, - {"#4", 201 UNTIC_COMMENT("Key S-Left")}, - {"%0", 177 UNTIC_COMMENT("redo key")}, - {"%1", 168 UNTIC_COMMENT("help key")}, - {"%2", 169 UNTIC_COMMENT("mark key")}, - {"%3", 170 UNTIC_COMMENT("message key")}, - {"%4", 171 UNTIC_COMMENT("move key")}, - {"%5", 172 UNTIC_COMMENT("next key")}, - {"%6", 173 UNTIC_COMMENT("open key")}, - {"%7", 174 UNTIC_COMMENT("options key")}, - {"%8", 175 UNTIC_COMMENT("previous key")}, - {"%9", 176 UNTIC_COMMENT("print key")}, - {"%a", 202 UNTIC_COMMENT("shifted key")}, - {"%b", 203 UNTIC_COMMENT("shifted key")}, - {"%c", 204 UNTIC_COMMENT("Key S-Next")}, - {"%d", 205 UNTIC_COMMENT("shifted key")}, - {"%e", 206 UNTIC_COMMENT("Key S-Previous")}, - {"%f", 207 UNTIC_COMMENT("shifted key")}, - {"%g", 208 UNTIC_COMMENT("shifted key")}, - {"%h", 209 UNTIC_COMMENT("shifted key")}, - {"%i", 210 UNTIC_COMMENT("Key S-Right")}, - {"%j", 211 UNTIC_COMMENT("shifted key")}, - {"&0", 187 UNTIC_COMMENT("shifted key")}, - {"&1", 178 UNTIC_COMMENT("reference key")}, - {"&2", 179 UNTIC_COMMENT("refresh key")}, - {"&3", 180 UNTIC_COMMENT("replace key")}, - {"&4", 181 UNTIC_COMMENT("restart key")}, - {"&5", 182 UNTIC_COMMENT("resume key")}, - {"&6", 183 UNTIC_COMMENT("save key")}, - {"&7", 184 UNTIC_COMMENT("suspend key")}, - {"&8", 185 UNTIC_COMMENT("undo key")}, - {"&9", 186 UNTIC_COMMENT("shifted key")}, - {"*0", 197 UNTIC_COMMENT("shifted key")}, - {"*1", 188 UNTIC_COMMENT("shifted key")}, - {"*2", 189 UNTIC_COMMENT("shifted key")}, - {"*3", 190 UNTIC_COMMENT("shifted key")}, - {"*4", 191 UNTIC_COMMENT("Key S-Delete")}, - {"*5", 192 UNTIC_COMMENT("shifted key")}, - {"*6", 193 UNTIC_COMMENT("select key")}, - {"*7", 194 UNTIC_COMMENT("Key S-End")}, - {"*8", 195 UNTIC_COMMENT("shifted key")}, - {"*9", 196 UNTIC_COMMENT("shifted key")}, - {"@0", 167 UNTIC_COMMENT("find key")}, - {"@1", 158 UNTIC_COMMENT("begin key")}, - {"@2", 159 UNTIC_COMMENT("cancel key")}, - {"@3", 160 UNTIC_COMMENT("close key")}, - {"@4", 161 UNTIC_COMMENT("command key")}, - {"@5", 162 UNTIC_COMMENT("copy key")}, - {"@6", 163 UNTIC_COMMENT("create key")}, - {"@7", 164 UNTIC_COMMENT("Key End")}, - {"@8", 165 UNTIC_COMMENT("enter/send key")}, - {"@9", 166 UNTIC_COMMENT("exit key")}, - {"AB", 360 UNTIC_COMMENT("set ANSI color background")}, - {"AF", 359 UNTIC_COMMENT("set ANSI color foreground")}, - {"AL", 110 UNTIC_COMMENT("parm_insert_line")}, - {"CC", 9 UNTIC_COMMENT("terminal settable cmd character in prototype !?")}, - {"CM", 15 UNTIC_COMMENT("memory relative cursor addressing")}, - {"CW", 277 UNTIC_COMMENT("define a window #1 from #2, #3 to #4, #5")}, - {"DC", 105 UNTIC_COMMENT("delete #1 chars")}, - {"DI", 280 UNTIC_COMMENT("dial number #1")}, - {"DK", 275 UNTIC_COMMENT("display clock at (#1,#2)")}, - {"DL", 106 UNTIC_COMMENT("parm_delete_line")}, - {"DO", 107 UNTIC_COMMENT("down #1 lines")}, - {"F1", 216 UNTIC_COMMENT("key_f11")}, - {"F2", 217 UNTIC_COMMENT("key_f12")}, - {"F3", 218 UNTIC_COMMENT("key_f13")}, - {"F4", 219 UNTIC_COMMENT("key_f14")}, - {"F5", 220 UNTIC_COMMENT("key_f15")}, - {"F6", 221 UNTIC_COMMENT("key_f16")}, - {"F7", 222 UNTIC_COMMENT("key_f17")}, - {"F8", 223 UNTIC_COMMENT("key_f18")}, - {"F9", 224 UNTIC_COMMENT("key_f19")}, - {"FA", 225 UNTIC_COMMENT("key_f20")}, - {"FB", 226 UNTIC_COMMENT("F21 function key")}, - {"FC", 227 UNTIC_COMMENT("F22 function key")}, - {"FD", 228 UNTIC_COMMENT("F23 function key")}, - {"FE", 229 UNTIC_COMMENT("F24 function key")}, - {"FF", 230 UNTIC_COMMENT("F25 function key")}, - {"FG", 231 UNTIC_COMMENT("F26 function key")}, - {"FH", 232 UNTIC_COMMENT("F27 function key")}, - {"FI", 233 UNTIC_COMMENT("F28 function key")}, - {"FJ", 234 UNTIC_COMMENT("F29 function key")}, - {"FK", 235 UNTIC_COMMENT("F30 function key")}, - {"FL", 236 UNTIC_COMMENT("F31 function key")}, - {"FM", 237 UNTIC_COMMENT("F32 function key")}, - {"FN", 238 UNTIC_COMMENT("F33 function key")}, - {"FO", 239 UNTIC_COMMENT("F34 function key")}, - {"FP", 240 UNTIC_COMMENT("F35 function key")}, - {"FQ", 241 UNTIC_COMMENT("F36 function key")}, - {"FR", 242 UNTIC_COMMENT("F37 function key")}, - {"FS", 243 UNTIC_COMMENT("F38 function key")}, - {"FT", 244 UNTIC_COMMENT("F39 function key")}, - {"FU", 245 UNTIC_COMMENT("F40 function key")}, - {"FV", 246 UNTIC_COMMENT("F41 function key")}, - {"FW", 247 UNTIC_COMMENT("F42 function key")}, - {"FX", 248 UNTIC_COMMENT("F43 function key")}, - {"FY", 249 UNTIC_COMMENT("F44 function key")}, - {"FZ", 250 UNTIC_COMMENT("F45 function key")}, - {"Fa", 251 UNTIC_COMMENT("F46 function key")}, - {"Fb", 252 UNTIC_COMMENT("F47 function key")}, - {"Fc", 253 UNTIC_COMMENT("F48 function key")}, - {"Fd", 254 UNTIC_COMMENT("F49 function key")}, - {"Fe", 255 UNTIC_COMMENT("F50 function key")}, - {"Ff", 256 UNTIC_COMMENT("F51 function key")}, - {"Fg", 257 UNTIC_COMMENT("F52 function key")}, - {"Fh", 258 UNTIC_COMMENT("F53 function key")}, - {"Fi", 259 UNTIC_COMMENT("F54 function key")}, - {"Fj", 260 UNTIC_COMMENT("F55 function key")}, - {"Fk", 261 UNTIC_COMMENT("F56 function key")}, - {"Fl", 262 UNTIC_COMMENT("F57 function key")}, - {"Fm", 263 UNTIC_COMMENT("F58 function key")}, - {"Fn", 264 UNTIC_COMMENT("F59 function key")}, - {"Fo", 265 UNTIC_COMMENT("F60 function key")}, - {"Fp", 266 UNTIC_COMMENT("F61 function key")}, - {"Fq", 267 UNTIC_COMMENT("F62 function key")}, - {"Fr", 268 UNTIC_COMMENT("F63 function key")}, - {"G1", 400 UNTIC_COMMENT("single upper right")}, - {"G2", 398 UNTIC_COMMENT("single upper left")}, - {"G3", 399 UNTIC_COMMENT("single lower left")}, - {"G4", 401 UNTIC_COMMENT("single lower right")}, - {"GC", 408 UNTIC_COMMENT("single intersection")}, - {"GD", 405 UNTIC_COMMENT("tee pointing down")}, - {"GH", 406 UNTIC_COMMENT("single horizontal line")}, - {"GL", 403 UNTIC_COMMENT("tee pointing left")}, - {"GR", 402 UNTIC_COMMENT("tee pointing right")}, - {"GU", 404 UNTIC_COMMENT("tee pointing up")}, - {"GV", 407 UNTIC_COMMENT("single vertical line")}, - {"Gm", 358 UNTIC_COMMENT("Curses should get button events")}, - {"HU", 279 UNTIC_COMMENT("hang-up phone")}, - {"IC", 108 UNTIC_COMMENT("insert #1 chars")}, - {"Ic", 299 UNTIC_COMMENT("initialize color #1 to (#2,#3,#4)")}, - {"Ip", 300 UNTIC_COMMENT("Initialize color pair #1 to fg=(#2,#3,#4), bg=(#5,#6,#7)")}, - {"K1", 139 UNTIC_COMMENT("upper left of keypad")}, - {"K2", 141 UNTIC_COMMENT("center of keypad")}, - {"K3", 140 UNTIC_COMMENT("upper right of keypad")}, - {"K4", 142 UNTIC_COMMENT("lower left of keypad")}, - {"K5", 143 UNTIC_COMMENT("lower right of keypad")}, - {"Km", 355 UNTIC_COMMENT("Mouse event has occurred")}, - {"LE", 111 UNTIC_COMMENT("move #1 chars to the left")}, - {"LF", 157 UNTIC_COMMENT("turn off soft labels")}, - {"LO", 156 UNTIC_COMMENT("turn on soft labels")}, - {"Lf", 273 UNTIC_COMMENT("label format")}, - {"MC", 270 UNTIC_COMMENT("clear right and left soft margins")}, - {"ML", 271 UNTIC_COMMENT("set left soft margin")}, - {"ML", 368 UNTIC_COMMENT("Set both left and right margins to #1, #2")}, - {"MR", 272 UNTIC_COMMENT("set right soft margin")}, - {"MT", 369 UNTIC_COMMENT("Sets both top and bottom margins to #1, #2")}, - {"Mi", 356 UNTIC_COMMENT("Mouse status information")}, - {"PA", 285 UNTIC_COMMENT("pause for 2-3 seconds")}, - {"PU", 283 UNTIC_COMMENT("select pulse dialling")}, - {"QD", 281 UNTIC_COMMENT("dial number #1 without checking")}, - {"RA", 152 UNTIC_COMMENT("turn off automatic margins")}, - {"RC", 276 UNTIC_COMMENT("remove clock")}, - {"RF", 215 UNTIC_COMMENT("send next input char (for ptys)")}, - {"RI", 112 UNTIC_COMMENT("parm_right_cursor")}, - {"RQ", 357 UNTIC_COMMENT("Request mouse position")}, - {"RX", 150 UNTIC_COMMENT("turn off xon/xoff handshaking")}, - {"S1", 378 UNTIC_COMMENT("Display PC character")}, - {"S2", 379 UNTIC_COMMENT("Enter PC character display mode")}, - {"S3", 380 UNTIC_COMMENT("Exit PC character display mode")}, - {"S4", 381 UNTIC_COMMENT("Enter PC scancode mode")}, - {"S5", 382 UNTIC_COMMENT("Exit PC scancode mode")}, - {"S6", 383 UNTIC_COMMENT("PC terminal options")}, - {"S7", 384 UNTIC_COMMENT("Escape for scancode emulation")}, - {"S8", 385 UNTIC_COMMENT("Alternate escape for scancode emulation")}, - {"SA", 151 UNTIC_COMMENT("turn on automatic margins")}, - {"SC", 274 UNTIC_COMMENT("set clock, #1 hrs #2 mins #3 secs")}, - {"SF", 109 UNTIC_COMMENT("scroll forward #1 lines")}, - {"SR", 113 UNTIC_COMMENT("scroll back #1 lines")}, - {"SX", 149 UNTIC_COMMENT("turn on xon/xoff handshaking")}, - {"Sb", 303 UNTIC_COMMENT("set background (color)")}, - {"Sf", 302 UNTIC_COMMENT("set foreground (color)")}, - {"TO", 282 UNTIC_COMMENT("select touch tone dialing")}, - {"UP", 114 UNTIC_COMMENT("up #1 lines")}, - {"WA", 286 UNTIC_COMMENT("wait for dial-tone")}, - {"WG", 278 UNTIC_COMMENT("go to window #1")}, - {"XF", 154 UNTIC_COMMENT("XOFF character")}, - {"XN", 153 UNTIC_COMMENT("XON character")}, - {"Xh", 386 UNTIC_COMMENT("Enter horizontal highlight mode")}, - {"Xl", 387 UNTIC_COMMENT("Enter left highlight mode")}, - {"Xo", 388 UNTIC_COMMENT("Enter low highlight mode")}, - {"Xr", 389 UNTIC_COMMENT("Enter right highlight mode")}, - {"Xt", 390 UNTIC_COMMENT("Enter top highlight mode")}, - {"Xv", 391 UNTIC_COMMENT("Enter vertical highlight mode")}, - {"Xy", 370 UNTIC_COMMENT("Repeat bit image cell #1 #2 times")}, - {"YZ", 377 UNTIC_COMMENT("Set page length to #1 lines")}, - {"Yv", 372 UNTIC_COMMENT("Move to beginning of same row")}, - {"Yw", 373 UNTIC_COMMENT("Give name for color #1")}, - {"Yx", 374 UNTIC_COMMENT("Define rectangualar bit image region")}, - {"Yy", 375 UNTIC_COMMENT("End a bit-image region")}, - {"Yz", 376 UNTIC_COMMENT("Change to ribbon color #1")}, - {"ZA", 304 UNTIC_COMMENT("Change number of characters per inch")}, - {"ZB", 305 UNTIC_COMMENT("Change number of lines per inch")}, - {"ZC", 306 UNTIC_COMMENT("Change horizontal resolution")}, - {"ZD", 307 UNTIC_COMMENT("Change vertical resolution")}, - {"ZE", 308 UNTIC_COMMENT("Define a character")}, - {"ZF", 309 UNTIC_COMMENT("Enter double-wide mode")}, - {"ZG", 310 UNTIC_COMMENT("Enter draft-quality mode")}, - {"ZH", 311 UNTIC_COMMENT("Enter italic mode")}, - {"ZI", 312 UNTIC_COMMENT("Start leftward carriage motion")}, - {"ZJ", 313 UNTIC_COMMENT("Start micro-motion mode")}, - {"ZK", 314 UNTIC_COMMENT("Enter NLQ mode")}, - {"ZL", 315 UNTIC_COMMENT("Wnter normal-quality mode")}, - {"ZM", 316 UNTIC_COMMENT("Enter shadow-print mode")}, - {"ZN", 317 UNTIC_COMMENT("Enter subscript mode")}, - {"ZO", 318 UNTIC_COMMENT("Enter superscript mode")}, - {"ZP", 319 UNTIC_COMMENT("Start upward carriage motion")}, - {"ZQ", 320 UNTIC_COMMENT("End double-wide mode")}, - {"ZR", 321 UNTIC_COMMENT("End italic mode")}, - {"ZS", 322 UNTIC_COMMENT("End left-motion mode")}, - {"ZT", 323 UNTIC_COMMENT("End micro-motion mode")}, - {"ZU", 324 UNTIC_COMMENT("End shadow-print mode")}, - {"ZV", 325 UNTIC_COMMENT("End subscript mode")}, - {"ZW", 326 UNTIC_COMMENT("End superscript mode")}, - {"ZX", 327 UNTIC_COMMENT("End reverse character motion")}, - {"ZY", 328 UNTIC_COMMENT("Like column_address in micro mode")}, - {"ZZ", 329 UNTIC_COMMENT("Like cursor_down in micro mode")}, - {"Za", 330 UNTIC_COMMENT("Like cursor_left in micro mode")}, - {"Zb", 331 UNTIC_COMMENT("Like cursor_right in micro mode")}, - {"Zc", 332 UNTIC_COMMENT("Like row_address in micro mode")}, - {"Zd", 333 UNTIC_COMMENT("Like cursor_up in micro mode")}, - {"Ze", 334 UNTIC_COMMENT("Match software bits to print-head pins")}, - {"Zf", 335 UNTIC_COMMENT("Like parm_down_cursor in micro mode")}, - {"Zg", 336 UNTIC_COMMENT("Like parm_left_cursor in micro mode")}, - {"Zh", 337 UNTIC_COMMENT("Like parm_right_cursor in micro mode")}, - {"Zi", 338 UNTIC_COMMENT("Like parm_up_cursor in micro mode")}, - {"Zj", 339 UNTIC_COMMENT("Select character set")}, - {"Zk", 340 UNTIC_COMMENT("Set bottom margin at current line")}, - {"Zl", 341 UNTIC_COMMENT("Set bottom margin at line #1 or #2 lines from bottom")}, - {"Zm", 342 UNTIC_COMMENT("Set left (right) margin at column #1 (#2)")}, - {"Zn", 343 UNTIC_COMMENT("Set right margin at column #1")}, - {"Zo", 344 UNTIC_COMMENT("Set top margin at current line")}, - {"Zp", 345 UNTIC_COMMENT("Set top (bottom) margin at row #1 (#2)")}, - {"Zq", 346 UNTIC_COMMENT("Start printing bit image braphics")}, - {"Zr", 347 UNTIC_COMMENT("Start character set definition")}, - {"Zs", 348 UNTIC_COMMENT("Stop printing bit image graphics")}, - {"Zt", 349 UNTIC_COMMENT("End definition of character aet")}, - {"Zu", 350 UNTIC_COMMENT("List of subscriptable characters")}, - {"Zv", 351 UNTIC_COMMENT("List of superscriptable characters")}, - {"Zw", 352 UNTIC_COMMENT("Printing any of these chars causes CR")}, - {"Zx", 353 UNTIC_COMMENT("No motion for subsequent character")}, - {"Zy", 354 UNTIC_COMMENT("List of character set names")}, - {"Zz", 371 UNTIC_COMMENT("Move to next row of the bit image")}, - {"ac", 146 UNTIC_COMMENT("acs_chars")}, - {"ae", 38 UNTIC_COMMENT("exit_alt_charset_mode")}, - {"al", 53 UNTIC_COMMENT("insert line")}, - {"as", 25 UNTIC_COMMENT("enter_alt_charset_mode")}, - {"bc", 395 UNTIC_COMMENT("move left, if not ^H")}, - {"bl", 1 UNTIC_COMMENT("audible signal (bell)")}, - {"bt", 0 UNTIC_COMMENT("back tab")}, - {"bx", 411 UNTIC_COMMENT("box chars primary set")}, - {"cb", 269 UNTIC_COMMENT("Clear to beginning of line")}, - {"cd", 7 UNTIC_COMMENT("clear to end of screen")}, - {"ce", 6 UNTIC_COMMENT("clr_eol")}, - {"ch", 8 UNTIC_COMMENT("horizontal position #1, absolute")}, - {"ci", 363 UNTIC_COMMENT("Init sequence for multiple codesets")}, - {"cl", 5 UNTIC_COMMENT("clear screen and home cursor")}, - {"cm", 10 UNTIC_COMMENT("move to row #1 columns #2")}, - {"cr", 2 UNTIC_COMMENT("carriage return")}, - {"cs", 3 UNTIC_COMMENT("change region to line #1 to line #2")}, - {"ct", 4 UNTIC_COMMENT("clear all tab stops")}, - {"cv", 127 UNTIC_COMMENT("vertical position #1 absolute")}, - {"dc", 21 UNTIC_COMMENT("delete character")}, - {"dl", 22 UNTIC_COMMENT("delete line")}, - {"dm", 29 UNTIC_COMMENT("enter delete mode")}, - {"do", 11 UNTIC_COMMENT("down one line")}, - {"ds", 23 UNTIC_COMMENT("disable status line")}, - {"dv", 362 UNTIC_COMMENT("Indicate language/codeset support")}, - {"eA", 155 UNTIC_COMMENT("enable alternate char set")}, - {"ec", 37 UNTIC_COMMENT("erase #1 characters")}, - {"ed", 41 UNTIC_COMMENT("end delete mode")}, - {"ei", 42 UNTIC_COMMENT("exit insert mode")}, - {"ff", 46 UNTIC_COMMENT("hardcopy terminal page eject")}, - {"fh", 284 UNTIC_COMMENT("flash switch hook")}, - {"fs", 47 UNTIC_COMMENT("return from status line")}, - {"hd", 24 UNTIC_COMMENT("half a line down")}, - {"ho", 12 UNTIC_COMMENT("home cursor (if no cup)")}, - {"hu", 137 UNTIC_COMMENT("half a line up")}, - {"i1", 48 UNTIC_COMMENT("initialization string")}, - {"i2", 392 UNTIC_COMMENT("secondary initialization string")}, - {"i3", 50 UNTIC_COMMENT("initialization string")}, - {"iP", 138 UNTIC_COMMENT("path name of program for initialization")}, - {"ic", 52 UNTIC_COMMENT("insert character")}, - {"if", 51 UNTIC_COMMENT("name of initialization file")}, - {"im", 31 UNTIC_COMMENT("enter insert mode")}, - {"ip", 54 UNTIC_COMMENT("insert padding after inserted character")}, - {"is", 49 UNTIC_COMMENT("initialization string")}, - {"k0", 65 UNTIC_COMMENT("F0 function key")}, - {"k1", 66 UNTIC_COMMENT("F1 function key")}, - {"k2", 68 UNTIC_COMMENT("F2 function key")}, - {"k3", 69 UNTIC_COMMENT("F3 function key")}, - {"k4", 70 UNTIC_COMMENT("F4 function key")}, - {"k5", 71 UNTIC_COMMENT("F5 function key")}, - {"k6", 72 UNTIC_COMMENT("F6 function key")}, - {"k7", 73 UNTIC_COMMENT("F7 function key")}, - {"k8", 74 UNTIC_COMMENT("F8 fucntion key")}, - {"k9", 75 UNTIC_COMMENT("F9 function key")}, - {"k;", 67 UNTIC_COMMENT("F10 function key")}, - {"kA", 78 UNTIC_COMMENT("insert-line key")}, - {"kB", 148 UNTIC_COMMENT("back-tab key")}, - {"kC", 57 UNTIC_COMMENT("clear-screen or erase key")}, - {"kD", 59 UNTIC_COMMENT("delete-character key")}, - {"kE", 63 UNTIC_COMMENT("clear-to-end-of-line key")}, - {"kF", 84 UNTIC_COMMENT("scroll-forward key")}, - {"kH", 80 UNTIC_COMMENT("last-line key")}, - {"kI", 77 UNTIC_COMMENT("insert-character key")}, - {"kL", 60 UNTIC_COMMENT("delete-line key")}, - {"kM", 62 UNTIC_COMMENT("sent by rmir or smir in insert mode")}, - {"kN", 81 UNTIC_COMMENT("next-page key")}, - {"kP", 82 UNTIC_COMMENT("prev-page key")}, - {"kR", 85 UNTIC_COMMENT("scroll-backward key")}, - {"kS", 64 UNTIC_COMMENT("clear-to-end-of-screen key")}, - {"kT", 86 UNTIC_COMMENT("set-tab key")}, - {"ka", 56 UNTIC_COMMENT("clear-all-tabs key")}, - {"kb", 55 UNTIC_COMMENT("backspace key")}, - {"kd", 61 UNTIC_COMMENT("down-arrow key")}, - {"ke", 88 UNTIC_COMMENT("leave 'keyboard_transmit' mode")}, - {"kh", 76 UNTIC_COMMENT("home key")}, - {"kl", 79 UNTIC_COMMENT("left-arrow key")}, - {"ko", 396 UNTIC_COMMENT("list of self-mapped keycaps")}, - {"kr", 83 UNTIC_COMMENT("right-arrow key")}, - {"ks", 89 UNTIC_COMMENT("enter 'keyboard_transmit' mode")}, - {"kt", 58 UNTIC_COMMENT("clear-tab key")}, - {"ku", 87 UNTIC_COMMENT("up-arrow key")}, - {"l0", 90 UNTIC_COMMENT("label on function key f0 if not f0")}, - {"l1", 91 UNTIC_COMMENT("label on function key f1 if not f1")}, - {"l2", 93 UNTIC_COMMENT("label on function key f2 if not f2")}, - {"l3", 94 UNTIC_COMMENT("label on function key f3 if not f3")}, - {"l4", 95 UNTIC_COMMENT("label on function key f4 if not f4")}, - {"l5", 96 UNTIC_COMMENT("lable on function key f5 if not f5")}, - {"l6", 97 UNTIC_COMMENT("label on function key f6 if not f6")}, - {"l7", 98 UNTIC_COMMENT("label on function key f7 if not f7")}, - {"l8", 99 UNTIC_COMMENT("label on function key f8 if not f8")}, - {"l9", 100 UNTIC_COMMENT("label on function key f9 if not f9")}, - {"la", 92 UNTIC_COMMENT("label on function key f10 if not f10")}, - {"le", 14 UNTIC_COMMENT("move left one space")}, - {"ll", 18 UNTIC_COMMENT("last line, first column (if no cup)")}, - {"ma", 397 UNTIC_COMMENT("map arrow keys rogue(1) motion keys")}, - {"mb", 26 UNTIC_COMMENT("turn on blinking")}, - {"md", 27 UNTIC_COMMENT("turn on bold (extra bright) mode")}, - {"me", 39 UNTIC_COMMENT("turn off all attributes")}, - {"mh", 30 UNTIC_COMMENT("turn on half-bright mode")}, - {"mk", 32 UNTIC_COMMENT("turn on blank mode (characters invisible)")}, - {"ml", 409 UNTIC_COMMENT("memory lock above")}, - {"mm", 102 UNTIC_COMMENT("turn on meta mode (8th-bit on)")}, - {"mo", 101 UNTIC_COMMENT("turn off meta mode")}, - {"mp", 33 UNTIC_COMMENT("turn on protected mode")}, - {"mr", 34 UNTIC_COMMENT("turn on reverse video mode")}, - {"mu", 410 UNTIC_COMMENT("memory unlock")}, - {"nd", 17 UNTIC_COMMENT("move right one space")}, - {"nl", 394 UNTIC_COMMENT("use to move down")}, - {"nw", 103 UNTIC_COMMENT("newline (behave like cr followed by lf)")}, - {"oc", 298 UNTIC_COMMENT("Set all color pairs to the original ones")}, - {"op", 297 UNTIC_COMMENT("Set default pair to its original value")}, - {"pO", 144 UNTIC_COMMENT("turn on printer for #1 bytes")}, - {"pc", 104 UNTIC_COMMENT("padding char (instead of null)")}, - {"pf", 119 UNTIC_COMMENT("turn off printer")}, - {"pk", 115 UNTIC_COMMENT("program function key #1 to type string #2")}, - {"pl", 116 UNTIC_COMMENT("program function key #1 to execute string #2")}, - {"pn", 147 UNTIC_COMMENT("program label #1 to show string #2")}, - {"po", 120 UNTIC_COMMENT("turn on printer")}, - {"ps", 118 UNTIC_COMMENT("print contents of screen")}, - {"px", 117 UNTIC_COMMENT("program function key #1 to transmit string #2")}, - {"r1", 122 UNTIC_COMMENT("reset string")}, - {"r2", 123 UNTIC_COMMENT("reset string")}, - {"r3", 124 UNTIC_COMMENT("reset string")}, - {"rP", 145 UNTIC_COMMENT("like ip but when in insert mode")}, - {"rc", 126 UNTIC_COMMENT("restore cursor to last position of sc")}, - {"rf", 125 UNTIC_COMMENT("name of reset file")}, - {"rp", 121 UNTIC_COMMENT("repeat char #1 #2 times")}, - {"rs", 393 UNTIC_COMMENT("terminal reset string")}, - {"s0", 364 UNTIC_COMMENT("Shift to code set 0 (EUC set 0, ASCII)")}, - {"s1", 365 UNTIC_COMMENT("Shift to code set 1")}, - {"s2", 366 UNTIC_COMMENT("Shift to code set 2")}, - {"s3", 367 UNTIC_COMMENT("Shift to code set 3")}, - {"sa", 131 UNTIC_COMMENT("define video attributes #1-#9 (PG9)")}, - {"sc", 128 UNTIC_COMMENT("save current cursor position")}, - {"se", 43 UNTIC_COMMENT("exit standout mode")}, - {"sf", 129 UNTIC_COMMENT("scroll text up")}, - {"so", 35 UNTIC_COMMENT("begin standout mode")}, - {"sp", 301 UNTIC_COMMENT("Set current color pair to #1")}, - {"sr", 130 UNTIC_COMMENT("scroll text down")}, - {"st", 132 UNTIC_COMMENT("set a tab in every row, current columns")}, - {"ta", 134 UNTIC_COMMENT("tab to next 8-space hardware tab stop")}, - {"te", 40 UNTIC_COMMENT("strings to end programs using cup")}, - {"ti", 28 UNTIC_COMMENT("string to start programs using cup")}, - {"ts", 135 UNTIC_COMMENT("move to status line")}, - {"u0", 287 UNTIC_COMMENT("User string #0")}, - {"u1", 288 UNTIC_COMMENT("User string #1")}, - {"u2", 289 UNTIC_COMMENT("User string #2")}, - {"u3", 290 UNTIC_COMMENT("User string #3")}, - {"u4", 291 UNTIC_COMMENT("User string #4")}, - {"u5", 292 UNTIC_COMMENT("User string #5")}, - {"u6", 293 UNTIC_COMMENT("User string #6")}, - {"u7", 294 UNTIC_COMMENT("User string #7")}, - {"u8", 295 UNTIC_COMMENT("User string #8")}, - {"u9", 296 UNTIC_COMMENT("User string #9")}, - {"uc", 136 UNTIC_COMMENT("underline char and move past it")}, - {"ue", 44 UNTIC_COMMENT("exit underline mode")}, - {"up", 19 UNTIC_COMMENT("up one line")}, - {"us", 36 UNTIC_COMMENT("begin underline mode")}, - {"vb", 45 UNTIC_COMMENT("visible bell (may not move cursor)")}, - {"ve", 16 UNTIC_COMMENT("make cursor appear normal (undo civis/cvvis)")}, - {"vi", 13 UNTIC_COMMENT("make cursor invisible")}, - {"vs", 20 UNTIC_COMMENT("make cursor very visible")}, - {"wi", 133 UNTIC_COMMENT("current window is lines #1-#2 cols #3-#4")}, - {"xl", 361 UNTIC_COMMENT("Program function key #1 to type string #2 and show string #3")}, - {"", -1 UNTIC_COMMENT(NULL)} -}; - -static int compute_cap_offset (char *cap, SLterminfo_Type *t, Tgetstr_Map_Type *map, unsigned int max_ofs) -{ - char cha, chb; - - (void) t; - cha = *cap++; chb = *cap; - - while (*map->name != 0) - { - if ((cha == *map->name) && (chb == *(map->name + 1))) - { - if (map->offset >= (int) max_ofs) return -1; - return map->offset; - } - map++; - } - return -1; -} - -char *_SLtt_tigetstr (SLterminfo_Type *t, char *cap) -{ - int offset; - - if (t == NULL) - return NULL; - - if (t->flags == SLTERMCAP) return tcap_getstr (cap, t); - - offset = compute_cap_offset (cap, t, Tgetstr_Map, t->num_string_offsets); - if (offset < 0) return NULL; - offset = make_integer (t->string_offsets + 2 * offset); - if (offset < 0) return NULL; - return t->string_table + offset; -} - -static Tgetstr_Map_Type Tgetnum_Map[] = -{ - {"BT", 30 UNTIC_COMMENT("number of buttons on mouse")}, - {"Co", 13 UNTIC_COMMENT("maximum numbers of colors on screen")}, - {"MW", 12 UNTIC_COMMENT("maxumum number of defineable windows")}, - {"NC", 15 UNTIC_COMMENT("video attributes that can't be used with colors")}, - {"Nl", 8 UNTIC_COMMENT("number of labels on screen")}, - {"Ya", 16 UNTIC_COMMENT("numbers of bytes buffered before printing")}, - {"Yb", 17 UNTIC_COMMENT("spacing of pins vertically in pins per inch")}, - {"Yc", 18 UNTIC_COMMENT("spacing of dots horizontally in dots per inch")}, - {"Yd", 19 UNTIC_COMMENT("maximum value in micro_..._address")}, - {"Ye", 20 UNTIC_COMMENT("maximum value in parm_..._micro")}, - {"Yf", 21 UNTIC_COMMENT("character size when in micro mode")}, - {"Yg", 22 UNTIC_COMMENT("line size when in micro mode")}, - {"Yh", 23 UNTIC_COMMENT("numbers of pins in print-head")}, - {"Yi", 24 UNTIC_COMMENT("horizontal resolution in units per line")}, - {"Yj", 25 UNTIC_COMMENT("vertical resolution in units per line")}, - {"Yk", 26 UNTIC_COMMENT("horizontal resolution in units per inch")}, - {"Yl", 27 UNTIC_COMMENT("vertical resolution in units per inch")}, - {"Ym", 28 UNTIC_COMMENT("print rate in chars per second")}, - {"Yn", 29 UNTIC_COMMENT("character step size when in double wide mode")}, - {"Yo", 31 UNTIC_COMMENT("number of passed for each bit-image row")}, - {"Yp", 32 UNTIC_COMMENT("type of bit-image device")}, - {"co", 0 UNTIC_COMMENT("number of columns in aline")}, - {"dB", 36 UNTIC_COMMENT("padding required for ^H")}, - {"dC", 34 UNTIC_COMMENT("pad needed for CR")}, - {"dN", 35 UNTIC_COMMENT("pad needed for LF")}, - {"dT", 37 UNTIC_COMMENT("padding required for ^I")}, - {"it", 1 UNTIC_COMMENT("tabs initially every # spaces")}, - {"kn", 38 UNTIC_COMMENT("count of function keys")}, - {"lh", 9 UNTIC_COMMENT("rows in each label")}, - {"li", 2 UNTIC_COMMENT("number of lines on screen or page")}, - {"lm", 3 UNTIC_COMMENT("lines of memory if > line. 0 => varies")}, - {"lw", 10 UNTIC_COMMENT("columns in each label")}, - {"ma", 11 UNTIC_COMMENT("maximum combined attributes terminal can handle")}, - {"pa", 14 UNTIC_COMMENT("maximum number of color-pairs on the screen")}, - {"pb", 5 UNTIC_COMMENT("lowest baud rate where padding needed")}, - {"sg", 4 UNTIC_COMMENT("number of blank chars left by smso or rmso")}, - {"ug", 33 UNTIC_COMMENT("number of blanks left by ul")}, - {"vt", 6 UNTIC_COMMENT("virtual terminal number (CB/unix)")}, - {"ws", 7 UNTIC_COMMENT("columns in status line")}, - {"", -1 UNTIC_COMMENT(NULL)} -}; - -int _SLtt_tigetnum (SLterminfo_Type *t, char *cap) -{ - int offset; - - if (t == NULL) - return -1; - - if (t->flags == SLTERMCAP) return tcap_getnum (cap, t); - - offset = compute_cap_offset (cap, t, Tgetnum_Map, t->num_numbers); - if (offset < 0) return -1; - return make_integer (t->numbers + 2 * offset); -} - -static Tgetstr_Map_Type Tgetflag_Map[] = -{ - {"5i", 22 UNTIC_COMMENT("printer won't echo on screen")}, - {"HC", 23 UNTIC_COMMENT("cursor is hard to see")}, - {"MT", 40 UNTIC_COMMENT("has meta key")}, - {"ND", 26 UNTIC_COMMENT("scrolling region is non-destructive")}, - {"NL", 41 UNTIC_COMMENT("move down with \n")}, - {"NP", 25 UNTIC_COMMENT("pad character does not exist")}, - {"NR", 24 UNTIC_COMMENT("smcup does not reverse rmcup")}, - {"YA", 30 UNTIC_COMMENT("only positive motion for hpa/mhpa caps")}, - {"YB", 31 UNTIC_COMMENT("using cr turns off micro mode")}, - {"YC", 32 UNTIC_COMMENT("printer needs operator to change character set")}, - {"YD", 33 UNTIC_COMMENT("only positive motion for vpa/mvpa caps")}, - {"YE", 34 UNTIC_COMMENT("printing in last column causes cr")}, - {"YF", 35 UNTIC_COMMENT("changing character pitch changes resolution")}, - {"YG", 36 UNTIC_COMMENT("changing line pitch changes resolution")}, - {"am", 1 UNTIC_COMMENT("terminal has automatic margins")}, - {"bs", 37 UNTIC_COMMENT("uses ^H to move left")}, - {"bw", 0 UNTIC_COMMENT("cub1 wraps from column 0 to last column")}, - {"cc", 27 UNTIC_COMMENT("terminal can re-define existing colors")}, - {"da", 11 UNTIC_COMMENT("display may be retained above the screen")}, - {"db", 12 UNTIC_COMMENT("display may be retained below the screen")}, - {"eo", 5 UNTIC_COMMENT("can erase overstrikes with a blank")}, - {"es", 16 UNTIC_COMMENT("escape can be used on the status line")}, - {"gn", 6 UNTIC_COMMENT("generic line type")}, - {"hc", 7 UNTIC_COMMENT("hardcopy terminal")}, - {"hl", 29 UNTIC_COMMENT("terminal uses only HLS color notation (tektronix)")}, - {"hs", 9 UNTIC_COMMENT("has extra status line")}, - {"hz", 18 UNTIC_COMMENT("can't print ~'s (hazeltine)")}, - {"in", 10 UNTIC_COMMENT("insert mode distinguishes nulls")}, - {"km", 8 UNTIC_COMMENT("Has a meta key, sets msb high")}, - {"mi", 13 UNTIC_COMMENT("safe to move while in insert mode")}, - {"ms", 14 UNTIC_COMMENT("safe to move while in standout mode")}, - {"nc", 39 UNTIC_COMMENT("no way to go to start of line")}, - {"ns", 38 UNTIC_COMMENT("crt cannot scroll")}, - {"nx", 21 UNTIC_COMMENT("padding won't work, xon/xoff required")}, - {"os", 15 UNTIC_COMMENT("terminal can overstrike")}, - {"pt", 42 UNTIC_COMMENT("has 8-char tabs invoked with ^I")}, - {"ul", 19 UNTIC_COMMENT("underline character overstrikes")}, - {"ut", 28 UNTIC_COMMENT("screen erased with background color")}, - {"xb", 2 UNTIC_COMMENT("beehive (f1=escape, f2=ctrl C)")}, - {"xn", 4 UNTIC_COMMENT("newline ignored after 80 cols (concept)")}, - {"xo", 20 UNTIC_COMMENT("terminal uses xon/xoff handshaking")}, - {"xr", 43 UNTIC_COMMENT("return clears the line")}, - {"xs", 3 UNTIC_COMMENT("standout not erased by overwriting (hp)")}, - {"xt", 17 UNTIC_COMMENT("tabs destructive, magic so char (t1061)")}, - {"", -1 UNTIC_COMMENT(NULL)} -}; - -int _SLtt_tigetflag (SLterminfo_Type *t, char *cap) -{ - int offset; - - if (t == NULL) return -1; - - if (t->flags == SLTERMCAP) return tcap_getflag (cap, t); - - offset = compute_cap_offset (cap, t, Tgetflag_Map, t->boolean_section_size); - - if (offset < 0) return -1; - return (int) *(t->boolean_flags + offset); -} - -/* These are my termcap routines. They only work with the TERMCAP environment - * variable. This variable must contain the termcap entry and NOT the file. - */ - -static int tcap_getflag (char *cap, SLterminfo_Type *t) -{ - char a, b; - char *f = (char *) t->boolean_flags; - char *fmax; - - if (f == NULL) return 0; - fmax = f + t->boolean_section_size; - - a = *cap; - b = *(cap + 1); - while (f < fmax) - { - if ((a == f[0]) && (b == f[1])) - return 1; - f += 2; - } - return 0; -} - -static char *tcap_get_cap (unsigned char *cap, unsigned char *caps, unsigned int len) -{ - unsigned char c0, c1; - unsigned char *caps_max; - - c0 = cap[0]; - c1 = cap[1]; - - if (caps == NULL) return NULL; - caps_max = caps + len; - while (caps < caps_max) - { - if ((c0 == caps[0]) && (c1 == caps[1])) - { - return (char *) caps + 3; - } - caps += (int) caps[2]; - } - return NULL; -} - -static int tcap_getnum (char *cap, SLterminfo_Type *t) -{ - cap = tcap_get_cap ((unsigned char *) cap, t->numbers, t->num_numbers); - if (cap == NULL) return -1; - return atoi (cap); -} - -static char *tcap_getstr (char *cap, SLterminfo_Type *t) -{ - return tcap_get_cap ((unsigned char *) cap, (unsigned char *) t->string_table, t->string_table_size); -} - -static int tcap_extract_field (unsigned char *t0) -{ - register unsigned char ch, *t = t0; - while (((ch = *t) != 0) && (ch != ':')) t++; - if (ch == ':') return (int) (t - t0); - return -1; -} - -int SLtt_Try_Termcap = 1; -static int tcap_getent (char *term, SLterminfo_Type *ti) -{ - unsigned char *termcap, ch; - unsigned char *buf, *b; - unsigned char *t; - int len; - - if (SLtt_Try_Termcap == 0) return -1; -#if 1 - /* XFREE86 xterm sets the TERMCAP environment variable to an invalid - * value. Specifically, it lacks the tc= string. - */ - if (!strncmp (term, "xterm", 5)) - return -1; -#endif - termcap = (unsigned char *) getenv ("TERMCAP"); - if ((termcap == NULL) || (*termcap == '/')) return -1; - - /* We have a termcap so lets use it provided it does not have a reference - * to another terminal via tc=. In that case, use terminfo. The alternative - * would be to parse the termcap file which I do not want to do right now. - * Besides, this is a terminfo based system and if the termcap were parsed - * terminfo would almost never get a chance to run. In addition, the tc= - * thing should not occur if tset is used to set the termcap entry. - */ - t = termcap; - while ((len = tcap_extract_field (t)) != -1) - { - if ((len > 3) && (t[0] == 't') && (t[1] == 'c') && (t[2] == '=')) - return -1; - t += (len + 1); - } - - /* malloc some extra space just in case it is needed. */ - len = strlen ((char *) termcap) + 256; - if (NULL == (buf = (unsigned char *) SLmalloc ((unsigned int) len))) return -1; - - b = buf; - - /* The beginning of the termcap entry contains the names of the entry. - * It is terminated by a colon. - */ - - ti->terminal_names = (char *) b; - t = termcap; - len = tcap_extract_field (t); - if (len < 0) - { - SLfree ((char *)buf); - return -1; - } - strncpy ((char *) b, (char *) t, (unsigned int) len); - b[len] = 0; - b += len + 1; - ti->name_section_size = len; - - /* Now, we are really at the start of the termcap entries. Point the - * termcap variable here since we want to refer to this a number of times. - */ - termcap = t + (len + 1); - - /* Process strings first. */ - ti->string_table = (char *) b; - t = termcap; - while (-1 != (len = tcap_extract_field (t))) - { - unsigned char *b1; - unsigned char *tmax; - - /* We are looking for: XX=something */ - if ((len < 4) || (t[2] != '=') || (*t == '.')) - { - t += len + 1; - continue; - } - tmax = t + len; - b1 = b; - - while (t < tmax) - { - ch = *t++; - if ((ch == '\\') && (t < tmax)) - { - t = (unsigned char *) _SLexpand_escaped_char ((char *) t, (char *) &ch); - } - else if ((ch == '^') && (t < tmax)) - { - ch = *t++; - if (ch == '?') ch = 127; - else ch = (ch | 0x20) - ('a' - 1); - } - *b++ = ch; - } - /* Null terminate it. */ - *b++ = 0; - len = (int) (b - b1); - b1[2] = (unsigned char) len; /* replace the = by the length */ - /* skip colon to next field. */ - t++; - } - ti->string_table_size = (int) (b - (unsigned char *) ti->string_table); - - /* Now process the numbers. */ - - t = termcap; - ti->numbers = b; - while (-1 != (len = tcap_extract_field (t))) - { - unsigned char *b1; - unsigned char *tmax; - - /* We are looking for: XX#NUMBER */ - if ((len < 4) || (t[2] != '#') || (*t == '.')) - { - t += len + 1; - continue; - } - tmax = t + len; - b1 = b; - - while (t < tmax) - { - *b++ = *t++; - } - /* Null terminate it. */ - *b++ = 0; - len = (int) (b - b1); - b1[2] = (unsigned char) len; /* replace the # by the length */ - t++; - } - ti->num_numbers = (int) (b - ti->numbers); - - /* Now process the flags. */ - t = termcap; - ti->boolean_flags = b; - while (-1 != (len = tcap_extract_field (t))) - { - /* We are looking for: XX#NUMBER */ - if ((len != 2) || (*t == '.') || (*t <= ' ')) - { - t += len + 1; - continue; - } - b[0] = t[0]; - b[1] = t[1]; - t += 3; - b += 2; - } - ti->boolean_section_size = (int) (b - ti->boolean_flags); - ti->flags = SLTERMCAP; - return 0; -} - - -/* These routines are provided only for backward binary compatability. - * They will vanish in V2.x - */ -char *SLtt_tigetent (char *s) -{ - return (char *) _SLtt_tigetent (s); -} - -extern char *SLtt_tigetstr (char *s, char **p) -{ - if (p == NULL) - return NULL; - return _SLtt_tigetstr ((SLterminfo_Type *) *p, s); -} - -extern int SLtt_tigetnum (char *s, char **p) -{ - if (p == NULL) - return -1; - return _SLtt_tigetnum ((SLterminfo_Type *) *p, s); -} - - diff --git a/mdk-stage1/slang/sltime.c b/mdk-stage1/slang/sltime.c deleted file mode 100644 index 14fc6ec16..000000000 --- a/mdk-stage1/slang/sltime.c +++ /dev/null @@ -1,310 +0,0 @@ -/* time related system calls */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include <sys/types.h> -#include <time.h> - -#if defined(__BORLANDC__) -# include <dos.h> -#endif -#if defined(__GO32__) || defined(__WATCOMC__) -# include <dos.h> -# include <bios.h> -#endif - -#include <errno.h> - -#include "slang.h" -#include "_slang.h" - -#ifdef __WIN32__ -#include <windows.h> -/* Sleep is defined badly in MSVC... */ -# ifdef _MSC_VER -# define sleep(n) _sleep((n)*1000) -# else -# ifdef sleep -# undef sleep -# endif -# define sleep(x) if(x)Sleep((x)*1000) -# endif -#endif - - -#if defined(IBMPC_SYSTEM) -/* For other system (Unix and VMS), _SLusleep is in sldisply.c */ -int _SLusleep (unsigned long s) -{ - sleep (s/1000000L); - s = s % 1000000L; - -# if defined(__WIN32__) - Sleep (s/1000); -#else -# if defined(__IBMC__) - DosSleep(s/1000); -# else -# if defined(_MSC_VER) - _sleep (s/1000); -# endif -# endif -#endif - return 0; -} -#endif - -#if defined(__IBMC__) && !defined(_AIX) -/* sleep is not a standard function in VA3. */ -unsigned int sleep (unsigned int seconds) -{ - DosSleep(1000L * ((long)seconds)); - return 0; -} -#endif - -static char *ctime_cmd (unsigned long *tt) -{ - char *t; - - t = ctime ((time_t *) tt); - t[24] = 0; /* knock off \n */ - return (t); -} - -static void sleep_cmd (void) -{ - unsigned int secs; -#if SLANG_HAS_FLOAT - unsigned long usecs; - double x; - - if (-1 == SLang_pop_double (&x, NULL, NULL)) - return; - - if (x < 0.0) - x = 0.0; - secs = (unsigned int) x; - sleep (secs); - x -= (double) secs; - usecs = (unsigned long) (1e6 * x); - if (usecs > 0) _SLusleep (usecs); -#else - if (-1 == SLang_pop_uinteger (&secs)) - return; - if (secs != 0) sleep (secs); -#endif -} - -static unsigned long _time_cmd (void) -{ - return (unsigned long) time (NULL); -} - -#if defined(__GO32__) -static char *djgpp_current_time (void) /*{{{*/ -{ - union REGS rg; - unsigned int year; - unsigned char month, day, weekday, hour, minute, sec; - char days[] = "SunMonTueWedThuFriSat"; - char months[] = "JanFebMarAprMayJunJulAugSepOctNovDec"; - static char the_date[26]; - - rg.h.ah = 0x2A; -#ifndef __WATCOMC__ - int86(0x21, &rg, &rg); - year = rg.x.cx & 0xFFFF; -#else - int386(0x21, &rg, &rg); - year = rg.x.ecx & 0xFFFF; -#endif - - month = 3 * (rg.h.dh - 1); - day = rg.h.dl; - weekday = 3 * rg.h.al; - - rg.h.ah = 0x2C; - -#ifndef __WATCOMC__ - int86(0x21, &rg, &rg); -#else - int386(0x21, &rg, &rg); -#endif - - hour = rg.h.ch; - minute = rg.h.cl; - sec = rg.h.dh; - - /* we want this form: Thu Apr 14 15:43:39 1994\n */ - sprintf(the_date, "%.3s %.3s%3d %02d:%02d:%02d %d\n", - days + weekday, months + month, - day, hour, minute, sec, year); - return the_date; -} - -/*}}}*/ - -#endif - -char *SLcurrent_time_string (void) /*{{{*/ -{ - char *the_time; -#ifndef __GO32__ - time_t myclock; - - myclock = time((time_t *) 0); - the_time = (char *) ctime(&myclock); -#else - the_time = djgpp_current_time (); -#endif - /* returns the form Sun Sep 16 01:03:52 1985\n\0 */ - the_time[24] = '\0'; - return(the_time); -} - -/*}}}*/ - -static int push_tm_struct (struct tm *tms) -{ - char *field_names [9]; - unsigned char field_types[9]; - VOID_STAR field_values [9]; - int int_values [9]; - unsigned int i; - - if (tms == NULL) - return SLang_push_null (); - - field_names [0] = "tm_sec"; int_values [0] = tms->tm_sec; - field_names [1] = "tm_min"; int_values [1] = tms->tm_min; - field_names [2] = "tm_hour"; int_values [2] = tms->tm_hour; - field_names [3] = "tm_mday"; int_values [3] = tms->tm_mday; - field_names [4] = "tm_mon"; int_values [4] = tms->tm_mon; - field_names [5] = "tm_year"; int_values [5] = tms->tm_year; - field_names [6] = "tm_wday"; int_values [6] = tms->tm_wday; - field_names [7] = "tm_yday"; int_values [7] = tms->tm_yday; - field_names [8] = "tm_isdst"; int_values [8] = tms->tm_isdst; - - for (i = 0; i < 9; i++) - { - field_types [i] = SLANG_INT_TYPE; - field_values [i] = (VOID_STAR) (int_values + i); - } - - return SLstruct_create_struct (9, field_names, field_types, field_values); -} - - -static void localtime_cmd (long *t) -{ - time_t tt = (time_t) *t; - (void) push_tm_struct (localtime (&tt)); -} - -static void gmtime_cmd (long *t) -{ -#ifdef HAVE_GMTIME - time_t tt = (time_t) *t; - (void) push_tm_struct (gmtime (&tt)); -#else - localtime_cmd (t); -#endif -} - -#ifdef HAVE_TIMES - -# ifdef HAVE_SYS_TIMES_H -# include <sys/times.h> -# endif - -#include <limits.h> - -#ifdef CLK_TCK -# define SECS_PER_TICK (1.0/(double)CLK_TCK) -#else -# ifdef CLOCKS_PER_SEC -# define SECS_PER_TICK (1.0/(double)CLOCKS_PER_SEC) -# else -# define SECS_PER_TICK (1.0/60.0) -# endif -#endif - -static void times_cmd (void) -{ - double dvals[4]; - struct tms t; - VOID_STAR field_values[4]; - char *field_names[4]; - unsigned int i; - unsigned char field_types[4]; - - (void) times (&t); - - field_names[0] = "tms_utime"; dvals[0] = (double)t.tms_utime; - field_names[1] = "tms_stime"; dvals[1] = (double)t.tms_stime; - field_names[2] = "tms_cutime"; dvals[2] = (double)t.tms_cutime; - field_names[3] = "tms_cstime"; dvals[3] = (double)t.tms_cstime; - - for (i = 0; i < 4; i++) - { - dvals[i] *= SECS_PER_TICK; - field_values[i] = (VOID_STAR) &dvals[i]; - field_types[i] = SLANG_DOUBLE_TYPE; - } - (void) SLstruct_create_struct (4, field_names, field_types, field_values); -} - -static struct tms Tic_TMS; - -static void tic_cmd (void) -{ - (void) times (&Tic_TMS); -} - -static double toc_cmd (void) -{ - struct tms t; - double d; - - (void) times (&t); - d = ((t.tms_utime - Tic_TMS.tms_utime) - + (t.tms_stime - Tic_TMS.tms_stime)) * SECS_PER_TICK; - Tic_TMS = t; - return d; -} - -#endif /* HAVE_TIMES */ - - -static SLang_Intrin_Fun_Type Time_Funs_Table [] = -{ - MAKE_INTRINSIC_1("ctime", ctime_cmd, SLANG_STRING_TYPE, SLANG_ULONG_TYPE), - MAKE_INTRINSIC_0("sleep", sleep_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("_time", _time_cmd, SLANG_ULONG_TYPE), - MAKE_INTRINSIC_0("time", SLcurrent_time_string, SLANG_STRING_TYPE), - MAKE_INTRINSIC_1("localtime", localtime_cmd, SLANG_VOID_TYPE, SLANG_LONG_TYPE), - MAKE_INTRINSIC_1("gmtime", gmtime_cmd, SLANG_VOID_TYPE, SLANG_LONG_TYPE), - -#ifdef HAVE_TIMES - MAKE_INTRINSIC_0("times", times_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("tic", tic_cmd, SLANG_VOID_TYPE), - MAKE_INTRINSIC_0("toc", toc_cmd, SLANG_DOUBLE_TYPE), -#endif - SLANG_END_INTRIN_FUN_TABLE -}; - -int _SLang_init_sltime (void) -{ -#ifdef HAVE_TIMES - (void) tic_cmd (); -#endif - return SLadd_intrin_fun_table (Time_Funs_Table, NULL); -} - diff --git a/mdk-stage1/slang/sltoken.c b/mdk-stage1/slang/sltoken.c deleted file mode 100644 index c9852e68a..000000000 --- a/mdk-stage1/slang/sltoken.c +++ /dev/null @@ -1,1702 +0,0 @@ -/* Copyright (c) 1998, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ -#include "slinclud.h" - -#include "slang.h" -#include "_slang.h" - -#define MAX_TOKEN_LEN 254 -#define MAX_FILE_LINE_LEN 256 - -static char Empty_Line[1] = {0}; - -static int Default_Compile_Line_Num_Info; -static char *Input_Line = Empty_Line; -static char *Input_Line_Pointer; - -static SLPreprocess_Type *This_SLpp; - -static SLang_Load_Type *LLT; - -static char *map_token_to_string (_SLang_Token_Type *tok) -{ - char *s; - static char numbuf [32]; - unsigned char type; - s = NULL; - - if (tok != NULL) type = tok->type; - else type = 0; - - switch (type) - { - case 0: - s = "??"; - break; - - case CHAR_TOKEN: - case SHORT_TOKEN: - case INT_TOKEN: - case LONG_TOKEN: - s = numbuf; - sprintf (s, "%ld", tok->v.long_val); - break; - - case UCHAR_TOKEN: - case USHORT_TOKEN: - case UINT_TOKEN: - case ULONG_TOKEN: - s = numbuf; - sprintf (s, "%lu", (unsigned long)tok->v.long_val); - break; - - case OBRACKET_TOKEN: s = "["; break; - case CBRACKET_TOKEN: s = "]"; break; - case OPAREN_TOKEN: s = "("; break; - case CPAREN_TOKEN: s = ")"; break; - case OBRACE_TOKEN: s = "{"; break; - case CBRACE_TOKEN: s = "}"; break; - case DEREF_TOKEN: s = "@"; break; - case POUND_TOKEN: s = "#"; break; - case COMMA_TOKEN: s = ","; break; - case SEMICOLON_TOKEN: s = ";"; break; - case COLON_TOKEN: s = ":"; break; - -#if SLANG_HAS_FLOAT - case FLOAT_TOKEN: - case DOUBLE_TOKEN: - case COMPLEX_TOKEN: -#endif - case IDENT_TOKEN: - if ((tok->free_sval_flag == 0) || (tok->num_refs == 0)) - break; - /* drop */ - default: - s = tok->v.s_val; - break; - } - - if (s == NULL) - { - s = numbuf; - sprintf (s, "(0x%02X)", type); - } - - return s; -} - -static char *make_line_file_error (char *buf, unsigned int buflen, - _SLang_Token_Type *tok, char *dsc, int line, char *file) -{ -#if _SLANG_HAS_DEBUG_CODE - if (tok != NULL) line = tok->line_number; -#endif - if (file == NULL) file = "??"; - - (void) _SLsnprintf (buf, buflen, "%s: found '%s', line %d, file: %s", - dsc, map_token_to_string (tok), line, file); - - return buf; -} - -void _SLparse_error(char *str, _SLang_Token_Type *tok, int flag) -{ - char buf [1024]; - - if (str == NULL) - str = "Parse Error"; - - make_line_file_error (buf, sizeof (buf), tok, str, LLT->line_num, (char *) LLT->name); - - if ((flag == 0) && SLang_Error) - return; - - SLang_verror (SL_SYNTAX_ERROR, "%s", buf); -} - -static void do_line_file_error (int line, char *file) -{ - SLang_verror (SL_SYNTAX_ERROR, - "called from line %d, file: %s", line, file); -} - -#define ALPHA_CHAR 1 -#define DIGIT_CHAR 2 -#define EXCL_CHAR 3 -#define SEP_CHAR 4 -#define OP_CHAR 5 -#define DOT_CHAR 6 -#define BOLDOT_CHAR 7 -#define DQUOTE_CHAR 8 -#define QUOTE_CHAR 9 -#define COMMENT_CHAR 10 -#define NL_CHAR 11 -#define BAD_CHAR 12 -#define WHITE_CHAR 13 - -#define CHAR_EOF 255 - -#define CHAR_CLASS(c) (Char_Type_Table[(c)][0]) -#define CHAR_DATA(c) (Char_Type_Table[(c)][1]) - -/* In this table, if a single character can represent an operator, e.g., - * '&' (BAND_TOKEN), then it must be placed before multiple-character - * operators that begin with the same character, e.g., "&=". See - * get_op_token to see how this is exploited. - * - * The third character null terminates the operator string. This is for - * the token structure. - */ -static char Operators [29][4] = -{ -#define OFS_EXCL 0 - {'!', '=', 0, NE_TOKEN}, -#define OFS_POUND 1 - {'#', 0, 0, POUND_TOKEN}, -#define OFS_BAND 2 - {'&', 0, 0, BAND_TOKEN}, - {'&', '&', 0, EOF_TOKEN}, - {'&', '=', 0, BANDEQS_TOKEN}, -#define OFS_STAR 5 - {'*', 0, 0, TIMES_TOKEN}, - {'*', '=', 0, TIMESEQS_TOKEN}, -#define OFS_PLUS 7 - {'+', 0, 0, ADD_TOKEN}, - {'+', '+', 0, PLUSPLUS_TOKEN}, - {'+', '=', 0, PLUSEQS_TOKEN}, -#define OFS_MINUS 10 - {'-', 0, 0, SUB_TOKEN}, - {'-', '-', 0, MINUSMINUS_TOKEN}, - {'-', '=', 0, MINUSEQS_TOKEN}, - {'-', '>', 0, NAMESPACE_TOKEN}, -#define OFS_DIV 14 - {'/', 0, 0, DIV_TOKEN}, - {'/', '=', 0, DIVEQS_TOKEN}, -#define OFS_LT 16 - {'<', 0, 0, LT_TOKEN}, - {'<', '=', 0, LE_TOKEN}, -#define OFS_EQS 18 - {'=', 0, 0, ASSIGN_TOKEN}, - {'=', '=', 0, EQ_TOKEN}, -#define OFS_GT 20 - {'>', 0, 0, GT_TOKEN}, - {'>', '=', 0, GE_TOKEN}, -#define OFS_AT 22 - {'@', 0, 0, DEREF_TOKEN}, -#define OFS_POW 23 - {'^', 0, 0, POW_TOKEN}, -#define OFS_BOR 24 - {'|', 0, 0, BOR_TOKEN}, - {'|', '|', 0, EOF_TOKEN}, - {'|', '=', 0, BOREQS_TOKEN}, -#define OFS_BNOT 27 - {'~', 0, 0, BNOT_TOKEN}, - { 0, 0, 0, EOF_TOKEN} -}; - -static unsigned char Char_Type_Table[256][2] = -{ - { NL_CHAR, 0 }, /* 0x0 */ { BAD_CHAR, 0 }, /* 0x1 */ - { BAD_CHAR, 0 }, /* 0x2 */ { BAD_CHAR, 0 }, /* 0x3 */ - { BAD_CHAR, 0 }, /* 0x4 */ { BAD_CHAR, 0 }, /* 0x5 */ - { BAD_CHAR, 0 }, /* 0x6 */ { BAD_CHAR, 0 }, /* 0x7 */ - { WHITE_CHAR, 0 }, /* 0x8 */ { WHITE_CHAR, 0 }, /* 0x9 */ - { NL_CHAR, 0 }, /* \n */ { WHITE_CHAR, 0 }, /* 0xb */ - { WHITE_CHAR, 0 }, /* 0xc */ { WHITE_CHAR, 0 }, /* \r */ - { BAD_CHAR, 0 }, /* 0xe */ { BAD_CHAR, 0 }, /* 0xf */ - { BAD_CHAR, 0 }, /* 0x10 */ { BAD_CHAR, 0 }, /* 0x11 */ - { BAD_CHAR, 0 }, /* 0x12 */ { BAD_CHAR, 0 }, /* 0x13 */ - { BAD_CHAR, 0 }, /* 0x14 */ { BAD_CHAR, 0 }, /* 0x15 */ - { BAD_CHAR, 0 }, /* 0x16 */ { BAD_CHAR, 0 }, /* 0x17 */ - { BAD_CHAR, 0 }, /* 0x18 */ { BAD_CHAR, 0 }, /* 0x19 */ - { BAD_CHAR, 0 }, /* 0x1a */ { BAD_CHAR, 0 }, /* 0x1b */ - { BAD_CHAR, 0 }, /* 0x1c */ { BAD_CHAR, 0 }, /* 0x1d */ - { BAD_CHAR, 0 }, /* 0x1e */ { BAD_CHAR, 0 }, /* 0x1f */ - { WHITE_CHAR, 0 }, /* 0x20 */ { EXCL_CHAR, OFS_EXCL }, /* ! */ - { DQUOTE_CHAR, 0 }, /* " */ { OP_CHAR, OFS_POUND }, /* # */ - { ALPHA_CHAR, 0 }, /* $ */ { NL_CHAR, 0 },/* % */ - { OP_CHAR, OFS_BAND }, /* & */ { QUOTE_CHAR, 0 }, /* ' */ - { SEP_CHAR, OPAREN_TOKEN }, /* ( */ { SEP_CHAR, CPAREN_TOKEN }, /* ) */ - { OP_CHAR, OFS_STAR }, /* * */ { OP_CHAR, OFS_PLUS}, /* + */ - { SEP_CHAR, COMMA_TOKEN }, /* , */ { OP_CHAR, OFS_MINUS }, /* - */ - { DOT_CHAR, 0 }, /* . */ { OP_CHAR, OFS_DIV }, /* / */ - { DIGIT_CHAR, 0 }, /* 0 */ { DIGIT_CHAR, 0 }, /* 1 */ - { DIGIT_CHAR, 0 }, /* 2 */ { DIGIT_CHAR, 0 }, /* 3 */ - { DIGIT_CHAR, 0 }, /* 4 */ { DIGIT_CHAR, 0 }, /* 5 */ - { DIGIT_CHAR, 0 }, /* 6 */ { DIGIT_CHAR, 0 }, /* 7 */ - { DIGIT_CHAR, 0 }, /* 8 */ { DIGIT_CHAR, 0 }, /* 9 */ - { SEP_CHAR, COLON_TOKEN }, /* : */ { SEP_CHAR, SEMICOLON_TOKEN }, /* ; */ - { OP_CHAR, OFS_LT }, /* < */ { OP_CHAR, OFS_EQS }, /* = */ - { OP_CHAR, OFS_GT }, /* > */ { BAD_CHAR, 0 }, /* ? */ - { OP_CHAR, OFS_AT}, /* @ */ { ALPHA_CHAR, 0 }, /* A */ - { ALPHA_CHAR, 0 }, /* B */ { ALPHA_CHAR, 0 }, /* C */ - { ALPHA_CHAR, 0 }, /* D */ { ALPHA_CHAR, 0 }, /* E */ - { ALPHA_CHAR, 0 }, /* F */ { ALPHA_CHAR, 0 }, /* G */ - { ALPHA_CHAR, 0 }, /* H */ { ALPHA_CHAR, 0 }, /* I */ - { ALPHA_CHAR, 0 }, /* J */ { ALPHA_CHAR, 0 }, /* K */ - { ALPHA_CHAR, 0 }, /* L */ { ALPHA_CHAR, 0 }, /* M */ - { ALPHA_CHAR, 0 }, /* N */ { ALPHA_CHAR, 0 }, /* O */ - { ALPHA_CHAR, 0 }, /* P */ { ALPHA_CHAR, 0 }, /* Q */ - { ALPHA_CHAR, 0 }, /* R */ { ALPHA_CHAR, 0 }, /* S */ - { ALPHA_CHAR, 0 }, /* T */ { ALPHA_CHAR, 0 }, /* U */ - { ALPHA_CHAR, 0 }, /* V */ { ALPHA_CHAR, 0 }, /* W */ - { ALPHA_CHAR, 0 }, /* X */ { ALPHA_CHAR, 0 }, /* Y */ - { ALPHA_CHAR, 0 }, /* Z */ { SEP_CHAR, OBRACKET_TOKEN }, /* [ */ - { BAD_CHAR, 0 }, /* \ */ { SEP_CHAR, CBRACKET_TOKEN }, /* ] */ - { OP_CHAR, OFS_POW }, /* ^ */ { ALPHA_CHAR, 0 }, /* _ */ - { BAD_CHAR, 0 }, /* ` */ { ALPHA_CHAR, 0 }, /* a */ - { ALPHA_CHAR, 0 }, /* b */ { ALPHA_CHAR, 0 }, /* c */ - { ALPHA_CHAR, 0 }, /* d */ { ALPHA_CHAR, 0 }, /* e */ - { ALPHA_CHAR, 0 }, /* f */ { ALPHA_CHAR, 0 }, /* g */ - { ALPHA_CHAR, 0 }, /* h */ { ALPHA_CHAR, 0 }, /* i */ - { ALPHA_CHAR, 0 }, /* j */ { ALPHA_CHAR, 0 }, /* k */ - { ALPHA_CHAR, 0 }, /* l */ { ALPHA_CHAR, 0 }, /* m */ - { ALPHA_CHAR, 0 }, /* n */ { ALPHA_CHAR, 0 }, /* o */ - { ALPHA_CHAR, 0 }, /* p */ { ALPHA_CHAR, 0 }, /* q */ - { ALPHA_CHAR, 0 }, /* r */ { ALPHA_CHAR, 0 }, /* s */ - { ALPHA_CHAR, 0 }, /* t */ { ALPHA_CHAR, 0 }, /* u */ - { ALPHA_CHAR, 0 }, /* v */ { ALPHA_CHAR, 0 }, /* w */ - { ALPHA_CHAR, 0 }, /* x */ { ALPHA_CHAR, 0 }, /* y */ - { ALPHA_CHAR, 0 }, /* z */ { SEP_CHAR, OBRACE_TOKEN }, /* { */ - { OP_CHAR, OFS_BOR }, /* | */ { SEP_CHAR, CBRACE_TOKEN }, /* } */ - { OP_CHAR, OFS_BNOT }, /* ~ */ { BAD_CHAR, 0 }, /* 0x7f */ - - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /*
*/ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* */ { ALPHA_CHAR, 0 }, /* ¡ */ - { ALPHA_CHAR, 0 }, /* ¢ */ { ALPHA_CHAR, 0 }, /* £ */ - { ALPHA_CHAR, 0 }, /* ¤ */ { ALPHA_CHAR, 0 }, /* ¥ */ - { ALPHA_CHAR, 0 }, /* ¦ */ { ALPHA_CHAR, 0 }, /* § */ - { ALPHA_CHAR, 0 }, /* ¨ */ { ALPHA_CHAR, 0 }, /* © */ - { ALPHA_CHAR, 0 }, /* ª */ { ALPHA_CHAR, 0 }, /* « */ - { ALPHA_CHAR, 0 }, /* ¬ */ { ALPHA_CHAR, 0 }, /* */ - { ALPHA_CHAR, 0 }, /* ® */ { ALPHA_CHAR, 0 }, /* ¯ */ - { ALPHA_CHAR, 0 }, /* ° */ { ALPHA_CHAR, 0 }, /* ± */ - { ALPHA_CHAR, 0 }, /* ² */ { ALPHA_CHAR, 0 }, /* ³ */ - { ALPHA_CHAR, 0 }, /* ´ */ { ALPHA_CHAR, 0 }, /* µ */ - { ALPHA_CHAR, 0 }, /* ¶ */ { ALPHA_CHAR, 0 }, /* · */ - { ALPHA_CHAR, 0 }, /* ¸ */ { ALPHA_CHAR, 0 }, /* ¹ */ - { ALPHA_CHAR, 0 }, /* º */ { ALPHA_CHAR, 0 }, /* » */ - { ALPHA_CHAR, 0 }, /* ¼ */ { ALPHA_CHAR, 0 }, /* ½ */ - { ALPHA_CHAR, 0 }, /* ¾ */ { ALPHA_CHAR, 0 }, /* ¿ */ - { ALPHA_CHAR, 0 }, /* À */ { ALPHA_CHAR, 0 }, /* Á */ - { ALPHA_CHAR, 0 }, /* Â */ { ALPHA_CHAR, 0 }, /* Ã */ - { ALPHA_CHAR, 0 }, /* Ä */ { ALPHA_CHAR, 0 }, /* Å */ - { ALPHA_CHAR, 0 }, /* Æ */ { ALPHA_CHAR, 0 }, /* Ç */ - { ALPHA_CHAR, 0 }, /* È */ { ALPHA_CHAR, 0 }, /* É */ - { ALPHA_CHAR, 0 }, /* Ê */ { ALPHA_CHAR, 0 }, /* Ë */ - { ALPHA_CHAR, 0 }, /* Ì */ { ALPHA_CHAR, 0 }, /* Í */ - { ALPHA_CHAR, 0 }, /* Î */ { ALPHA_CHAR, 0 }, /* Ï */ - { ALPHA_CHAR, 0 }, /* Ð */ { ALPHA_CHAR, 0 }, /* Ñ */ - { ALPHA_CHAR, 0 }, /* Ò */ { ALPHA_CHAR, 0 }, /* Ó */ - { ALPHA_CHAR, 0 }, /* Ô */ { ALPHA_CHAR, 0 }, /* Õ */ - { ALPHA_CHAR, 0 }, /* Ö */ { ALPHA_CHAR, 0 }, /* × */ - { ALPHA_CHAR, 0 }, /* Ø */ { ALPHA_CHAR, 0 }, /* Ù */ - { ALPHA_CHAR, 0 }, /* Ú */ { ALPHA_CHAR, 0 }, /* Û */ - { ALPHA_CHAR, 0 }, /* Ü */ { ALPHA_CHAR, 0 }, /* Ý */ - { ALPHA_CHAR, 0 }, /* Þ */ { ALPHA_CHAR, 0 }, /* ß */ - { ALPHA_CHAR, 0 }, /* à */ { ALPHA_CHAR, 0 }, /* á */ - { ALPHA_CHAR, 0 }, /* â */ { ALPHA_CHAR, 0 }, /* ã */ - { ALPHA_CHAR, 0 }, /* ä */ { ALPHA_CHAR, 0 }, /* å */ - { ALPHA_CHAR, 0 }, /* æ */ { ALPHA_CHAR, 0 }, /* ç */ - { ALPHA_CHAR, 0 }, /* è */ { ALPHA_CHAR, 0 }, /* é */ - { ALPHA_CHAR, 0 }, /* ê */ { ALPHA_CHAR, 0 }, /* ë */ - { ALPHA_CHAR, 0 }, /* ì */ { ALPHA_CHAR, 0 }, /* í */ - { ALPHA_CHAR, 0 }, /* î */ { ALPHA_CHAR, 0 }, /* ï */ - { ALPHA_CHAR, 0 }, /* ð */ { ALPHA_CHAR, 0 }, /* ñ */ - { ALPHA_CHAR, 0 }, /* ò */ { ALPHA_CHAR, 0 }, /* ó */ - { ALPHA_CHAR, 0 }, /* ô */ { ALPHA_CHAR, 0 }, /* õ */ - { ALPHA_CHAR, 0 }, /* ö */ { ALPHA_CHAR, 0 }, /* ÷ */ - { ALPHA_CHAR, 0 }, /* ø */ { ALPHA_CHAR, 0 }, /* ù */ - { ALPHA_CHAR, 0 }, /* ú */ { ALPHA_CHAR, 0 }, /* û */ - { ALPHA_CHAR, 0 }, /* ü */ { ALPHA_CHAR, 0 }, /* ý */ - { ALPHA_CHAR, 0 }, /* þ */ { ALPHA_CHAR, 0 }, /* ÿ */ -}; - -int _SLcheck_identifier_syntax (char *name) -{ - unsigned char *p; - - p = (unsigned char *) name; - if (ALPHA_CHAR == Char_Type_Table[*p][0]) while (1) - { - unsigned ch; - unsigned char type; - - ch = *++p; - - type = Char_Type_Table [ch][0]; - if ((type != ALPHA_CHAR) && (type != DIGIT_CHAR)) - { - if (ch == 0) - return 0; - break; - } - } - - SLang_verror (SL_SYNTAX_ERROR, - "Name %s contains an illegal character", name); - return -1; -} - -static unsigned char prep_get_char (void) -{ - register unsigned char ch; - - if (0 != (ch = *Input_Line_Pointer++)) - return ch; - - Input_Line_Pointer--; - return 0; -} - -static void unget_prep_char (unsigned char ch) -{ - if ((Input_Line_Pointer != Input_Line) - && (ch != 0)) - Input_Line_Pointer--; - /* *Input_Line_Pointer = ch; -- Do not modify the Input_Line */ -} - -#include "keywhash.c" - -static int get_ident_token (_SLang_Token_Type *tok, unsigned char *s, unsigned int len) -{ - unsigned char ch; - unsigned char type; - Keyword_Table_Type *table; - - while (1) - { - ch = prep_get_char (); - type = CHAR_CLASS (ch); - if ((type != ALPHA_CHAR) && (type != DIGIT_CHAR)) - { - unget_prep_char (ch); - break; - } - s [len++] = ch; - } - - s[len] = 0; - - /* check if keyword */ - table = is_keyword ((char *) s, len); - if (table != NULL) - { - tok->v.s_val = table->name; - return (tok->type = table->type); - } - - tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash); - tok->free_sval_flag = 1; - return (tok->type = IDENT_TOKEN); -} - -static int get_number_token (_SLang_Token_Type *tok, unsigned char *s, unsigned int len) -{ - unsigned char ch; - unsigned char type; - - /* Look for pattern [0-9.xX]*([eE][-+]?[digits])?[ijfhul]? */ - while (1) - { - ch = prep_get_char (); - - type = CHAR_CLASS (ch); - if ((type != DIGIT_CHAR) && (type != DOT_CHAR)) - { - if ((ch != 'x') && (ch != 'X')) - break; - /* It must be hex */ - do - { - if (len == (MAX_TOKEN_LEN - 1)) - goto too_long_return_error; - - s[len++] = ch; - ch = prep_get_char (); - type = CHAR_CLASS (ch); - } - while ((type == DIGIT_CHAR) || (type == ALPHA_CHAR)); - break; - } - if (len == (MAX_TOKEN_LEN - 1)) - goto too_long_return_error; - s [len++] = ch; - } - - /* At this point, type and ch are synchronized */ - - if ((ch == 'e') || (ch == 'E')) - { - if (len == (MAX_TOKEN_LEN - 1)) - goto too_long_return_error; - s[len++] = ch; - ch = prep_get_char (); - if ((ch == '+') || (ch == '-')) - { - if (len == (MAX_TOKEN_LEN - 1)) - goto too_long_return_error; - s[len++] = ch; - ch = prep_get_char (); - } - - while (DIGIT_CHAR == (type = CHAR_CLASS(ch))) - { - if (len == (MAX_TOKEN_LEN - 1)) - goto too_long_return_error; - s[len++] = ch; - ch = prep_get_char (); - } - } - - while (ALPHA_CHAR == type) - { - if (len == (MAX_TOKEN_LEN - 1)) - goto too_long_return_error; - s[len++] = ch; - ch = prep_get_char (); - type = CHAR_CLASS(ch); - } - - unget_prep_char (ch); - s[len] = 0; - - switch (SLang_guess_type ((char *) s)) - { - default: - tok->v.s_val = (char *) s; - _SLparse_error ("Not a number", tok, 0); - return (tok->type = EOF_TOKEN); - -#if SLANG_HAS_FLOAT - case SLANG_FLOAT_TYPE: - tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash); - tok->free_sval_flag = 1; - return (tok->type = FLOAT_TOKEN); - - case SLANG_DOUBLE_TYPE: - tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash); - tok->free_sval_flag = 1; - return (tok->type = DOUBLE_TOKEN); -#endif -#if SLANG_HAS_COMPLEX - case SLANG_COMPLEX_TYPE: - tok->v.s_val = _SLstring_make_hashed_string ((char *)s, len, &tok->hash); - tok->free_sval_flag = 1; - return (tok->type = COMPLEX_TOKEN); -#endif - case SLANG_CHAR_TYPE: - tok->v.long_val = (char)SLatol (s); - return tok->type = CHAR_TOKEN; - case SLANG_UCHAR_TYPE: - tok->v.long_val = (unsigned char)SLatol (s); - return tok->type = UCHAR_TOKEN; - case SLANG_SHORT_TYPE: - tok->v.long_val = (short)SLatol (s); - return tok->type = SHORT_TOKEN; - case SLANG_USHORT_TYPE: - tok->v.long_val = (unsigned short)SLatoul (s); - return tok->type = USHORT_TOKEN; - case SLANG_INT_TYPE: - tok->v.long_val = (int)SLatol (s); - return tok->type = INT_TOKEN; - case SLANG_UINT_TYPE: - tok->v.long_val = (unsigned int)SLatoul (s); - return tok->type = UINT_TOKEN; - case SLANG_LONG_TYPE: - tok->v.long_val = SLatol (s); - return tok->type = LONG_TOKEN; - case SLANG_ULONG_TYPE: - tok->v.long_val = SLatoul (s); - return tok->type = ULONG_TOKEN; - } - - too_long_return_error: - _SLparse_error ("Number too long for buffer", NULL, 0); - return (tok->type == EOF_TOKEN); -} - -static int get_op_token (_SLang_Token_Type *tok, char ch) -{ - unsigned int offset; - char second_char; - unsigned char type; - char *name; - - /* operators are: + - / * ++ -- += -= = == != > < >= <= | etc.. - * These lex to the longest valid operator token. - */ - - offset = CHAR_DATA((unsigned char) ch); - if (0 == Operators [offset][1]) - { - name = Operators [offset]; - type = name [3]; - } - else - { - type = EOF_TOKEN; - name = NULL; - } - - second_char = prep_get_char (); - do - { - if (second_char == Operators[offset][1]) - { - name = Operators [offset]; - type = name [3]; - break; - } - offset++; - } - while (ch == Operators[offset][0]); - - tok->type = type; - - if (type == EOF_TOKEN) - { - _SLparse_error ("Operator not supported", NULL, 0); - return type; - } - - tok->v.s_val = name; - - if (name[1] == 0) - unget_prep_char (second_char); - - return type; -} - -/* If this returns non-zero, then it is a binary string */ -static int expand_escaped_string (register char *s, - register char *t, register char *tmax, - unsigned int *lenp) -{ - char *s0; - int is_binary = 0; - char ch; - - s0 = s; - while (t < tmax) - { - ch = *t++; - if (ch == '\\') - { - t = _SLexpand_escaped_char (t, &ch); - if (ch == 0) is_binary = 1; - } - *s++ = ch; - } - *s = 0; - - *lenp = (unsigned char) (s - s0); - return is_binary; -} - -static int get_string_token (_SLang_Token_Type *tok, unsigned char quote_char, - unsigned char *s) -{ - unsigned char ch; - unsigned int len = 0; - int has_quote = 0; - int is_binary; - - while (1) - { - ch = prep_get_char (); - if (ch == 0) - { - _SLparse_error("Expecting quote-character", NULL, 0); - return (tok->type = EOF_TOKEN); - } - if (ch == quote_char) break; - - s[len++] = ch; - - if (len == (MAX_TOKEN_LEN - 1)) - { - _SLparse_error ("String too long for buffer", NULL, 0); - return (tok->type == EOF_TOKEN); - } - - if (ch == '\\') - { - has_quote = 1; - ch = prep_get_char (); - s[len++] = ch; - } - } - - s[len] = 0; - - if (has_quote) - is_binary = expand_escaped_string ((char *) s, (char *)s, (char *)s + len, &len); - else is_binary = 0; - - if ('"' == quote_char) - { - tok->free_sval_flag = 1; - if (is_binary) - { - tok->v.b_val = SLbstring_create (s, len); - return tok->type = BSTRING_TOKEN; - } - else - { - tok->v.s_val = _SLstring_make_hashed_string ((char *)s, - len, - &tok->hash); - tok->free_sval_flag = 1; - return (tok->type = STRING_TOKEN); - } - } - - /* else single character */ - if (s[1] != 0) - { - _SLparse_error("Single char expected", NULL, 0); - return (tok->type = EOF_TOKEN); - } - - tok->v.long_val = s[0]; - return (tok->type = UCHAR_TOKEN); -} - -static int extract_token (_SLang_Token_Type *tok, unsigned char ch, unsigned char t) -{ - unsigned char s [MAX_TOKEN_LEN]; - unsigned int slen; - - s[0] = (char) ch; - slen = 1; - - switch (t) - { - case ALPHA_CHAR: - return get_ident_token (tok, s, slen); - - case OP_CHAR: - return get_op_token (tok, ch); - - case DIGIT_CHAR: - return get_number_token (tok, s, slen); - - case EXCL_CHAR: - ch = prep_get_char (); - s [slen++] = ch; - t = CHAR_CLASS(ch); - if (t == ALPHA_CHAR) return get_ident_token (tok, s, slen); - if (t == OP_CHAR) - { - unget_prep_char (ch); - return get_op_token (tok, '!'); - } - _SLparse_error("Misplaced !", NULL, 0); - return -1; - - case DOT_CHAR: - ch = prep_get_char (); - if (DIGIT_CHAR == CHAR_CLASS(ch)) - { - s [slen++] = ch; - return get_number_token (tok, s, slen); - } - unget_prep_char (ch); - return (tok->type = DOT_TOKEN); - - case SEP_CHAR: - return (tok->type = CHAR_DATA(ch)); - - case DQUOTE_CHAR: - case QUOTE_CHAR: - return get_string_token (tok, ch, s); - - default: - _SLparse_error("Invalid character", NULL, 0); - return (tok->type = EOF_TOKEN); - } -} - -int _SLget_rpn_token (_SLang_Token_Type *tok) -{ - unsigned char ch; - - tok->v.s_val = "??"; - while ((ch = *Input_Line_Pointer) != 0) - { - unsigned char t; - - Input_Line_Pointer++; - if (WHITE_CHAR == (t = CHAR_CLASS(ch))) - continue; - - if (NL_CHAR == t) - break; - - return extract_token (tok, ch, t); - } - Input_Line_Pointer = Empty_Line; - return EOF_TOKEN; -} - -int _SLget_token (_SLang_Token_Type *tok) -{ - unsigned char ch; - unsigned char t; - - tok->num_refs = 1; - tok->free_sval_flag = 0; - tok->v.s_val = "??"; -#if _SLANG_HAS_DEBUG_CODE - tok->line_number = LLT->line_num; -#endif - if (SLang_Error || (Input_Line == NULL)) - return (tok->type = EOF_TOKEN); - - while (1) - { - ch = *Input_Line_Pointer++; - if (WHITE_CHAR == (t = CHAR_CLASS (ch))) - continue; - - if (t != NL_CHAR) - return extract_token (tok, ch, t); - - do - { - LLT->line_num++; -#if _SLANG_HAS_DEBUG_CODE - tok->line_number++; -#endif - Input_Line = LLT->read(LLT); - if ((NULL == Input_Line) || SLang_Error) - { - Input_Line_Pointer = Input_Line = NULL; - return (tok->type = EOF_TOKEN); - } - } - while (0 == SLprep_line_ok(Input_Line, This_SLpp)); - - Input_Line_Pointer = Input_Line; - if (*Input_Line_Pointer == '.') - { - Input_Line_Pointer++; - return tok->type = RPN_TOKEN; - } - } -} - -static int prep_exists_function (char *line, char comment) -{ - char buf[MAX_FILE_LINE_LEN], *b, *bmax; - unsigned char ch; - - bmax = buf + (sizeof (buf) - 1); - - while (1) - { - /* skip whitespace */ - while ((ch = (unsigned char) *line), - ch && (ch != '\n') && (ch <= ' ')) - line++; - - if ((ch <= '\n') - || (ch == (unsigned char) comment)) break; - - b = buf; - while ((ch = (unsigned char) *line) > ' ') - { - if (b < bmax) *b++ = (char) ch; - line++; - } - *b = 0; - - if (SLang_is_defined (buf)) - return 1; - } - - return 0; -} - -static int prep_eval_expr (char *expr) -{ - int ret; - - if (0 != SLang_load_string (expr)) - return -1; - if (-1 == SLang_pop_integer (&ret)) - return -1; - return (ret != 0); -} - - -int SLang_load_object (SLang_Load_Type *x) -{ - SLPreprocess_Type this_pp; - SLPreprocess_Type *save_this_pp; - SLang_Load_Type *save_llt; - char *save_input_line, *save_input_line_ptr; -#if _SLANG_HAS_DEBUG_CODE - int save_compile_line_num_info; -#endif - int save_auto_declare_variables; - - if (SLprep_exists_hook == NULL) - SLprep_exists_hook = prep_exists_function; - - if (_SLprep_eval_hook == NULL) - _SLprep_eval_hook = prep_eval_expr; - - if (-1 == SLprep_open_prep (&this_pp)) return -1; - - if (-1 == _SLcompile_push_context (x)) - return -1; - -#if _SLANG_HAS_DEBUG_CODE - save_compile_line_num_info = _SLang_Compile_Line_Num_Info; -#endif - save_this_pp = This_SLpp; - save_input_line = Input_Line; - save_input_line_ptr = Input_Line_Pointer; - save_llt = LLT; - save_auto_declare_variables = _SLang_Auto_Declare_Globals; - - This_SLpp = &this_pp; - Input_Line_Pointer = Input_Line = Empty_Line; - LLT = x; - - x->line_num = 0; - x->parse_level = 0; - _SLang_Auto_Declare_Globals = x->auto_declare_globals; - -#if _SLANG_HAS_DEBUG_CODE - _SLang_Compile_Line_Num_Info = Default_Compile_Line_Num_Info; -#endif - - _SLparse_start (x); - if (SLang_Error) - do_line_file_error (x->line_num, x->name); - - _SLang_Auto_Declare_Globals = save_auto_declare_variables; - - if (SLang_Error) SLang_restart (0); - - (void) _SLcompile_pop_context (); - - Input_Line = save_input_line; - Input_Line_Pointer = save_input_line_ptr; - LLT = save_llt; - This_SLpp = save_this_pp; - -#if _SLANG_HAS_DEBUG_CODE - _SLang_Compile_Line_Num_Info = save_compile_line_num_info; -#endif - - if (SLang_Error) return -1; - return 0; -} - -SLang_Load_Type *SLallocate_load_type (char *name) -{ - SLang_Load_Type *x; - - if (NULL == (x = (SLang_Load_Type *)SLmalloc (sizeof (SLang_Load_Type)))) - return NULL; - memset ((char *) x, 0, sizeof (SLang_Load_Type)); - - if (name == NULL) name = ""; - - x->name = SLang_create_slstring (name); - if (x->name == NULL) - { - SLfree ((char *) x); - return NULL; - } - return x; -} - -void SLdeallocate_load_type (SLang_Load_Type *x) -{ - if (x != NULL) - { - SLang_free_slstring (x->name); - SLfree ((char *) x); - } -} - -typedef struct -{ - char *string; - char *ptr; -} -String_Client_Data_Type; - -static char *read_from_string (SLang_Load_Type *x) -{ - String_Client_Data_Type *data; - char *s, *s1, ch; - - data = (String_Client_Data_Type *)x->client_data; - s1 = s = data->ptr; - - if (*s == 0) - return NULL; - - while ((ch = *s) != 0) - { - s++; - if (ch == '\n') - break; - } - - data->ptr = s; - return s1; -} - -int SLang_load_string (char *string) -{ - SLang_Load_Type *x; - String_Client_Data_Type data; - int ret; - - if (string == NULL) - return -1; - - /* Grab a private copy in case loading modifies string */ - if (NULL == (string = SLang_create_slstring (string))) - return -1; - - /* To avoid creating a static data space for every string loaded, - * all string objects will be regarded as identical. So, identify - * all of them by ***string*** - */ - if (NULL == (x = SLallocate_load_type ("***string***"))) - { - SLang_free_slstring (string); - return -1; - } - - x->client_data = (VOID_STAR) &data; - x->read = read_from_string; - - data.ptr = data.string = string; - if (-1 == (ret = SLang_load_object (x))) - SLang_verror (SLang_Error, "called from eval: %s", string); - - SLang_free_slstring (string); - SLdeallocate_load_type (x); - return ret; -} - -typedef struct -{ - char *buf; - FILE *fp; -} -File_Client_Data_Type; - -char *SLang_User_Prompt; -static char *read_from_file (SLang_Load_Type *x) -{ - FILE *fp; - File_Client_Data_Type *c; - - c = (File_Client_Data_Type *)x->client_data; - fp = c->fp; - - if ((fp == stdin) && (SLang_User_Prompt != NULL)) - { - fputs (SLang_User_Prompt, stdout); - fflush (stdout); - } - - return fgets (c->buf, MAX_FILE_LINE_LEN, c->fp); -} - -/* Note that file could be freed from Slang during run of this routine - * so get it and store it !! (e.g., autoloading) - */ -int (*SLang_Load_File_Hook) (char *); -int SLang_load_file (char *f) -{ - File_Client_Data_Type client_data; - SLang_Load_Type *x; - char *name, *buf; - FILE *fp; - - if (SLang_Load_File_Hook != NULL) - return (*SLang_Load_File_Hook) (f); - - if (f == NULL) name = "<stdin>"; else name = f; - - name = SLang_create_slstring (name); - if (name == NULL) - return -1; - - if (NULL == (x = SLallocate_load_type (name))) - { - SLang_free_slstring (name); - return -1; - } - - buf = NULL; - - if (f != NULL) - fp = fopen (f, "r"); - else - fp = stdin; - - if (fp == NULL) - SLang_verror (SL_OBJ_NOPEN, "Unable to open %s", name); - else if (NULL != (buf = SLmalloc (MAX_FILE_LINE_LEN + 1))) - { - client_data.fp = fp; - client_data.buf = buf; - x->client_data = (VOID_STAR) &client_data; - x->read = read_from_file; - - (void) SLang_load_object (x); - } - - if ((fp != NULL) && (fp != stdin)) - fclose (fp); - - SLfree (buf); - SLang_free_slstring (name); - SLdeallocate_load_type (x); - - if (SLang_Error) - return -1; - - return 0; -} - -int SLang_guess_type (char *t) -{ - char *p; - register char ch; - int modifier = 0; - - if (*t == '-') t++; - p = t; - -#if SLANG_HAS_FLOAT - if (*p != '.') - { -#endif - modifier = 0; - while ((*p >= '0') && (*p <= '9')) p++; - if (t == p) return (SLANG_STRING_TYPE); - if ((*p == 'x') && (p == t + 1)) /* 0x?? */ - { - modifier |= 8; - p++; - while (ch = *p, - ((ch >= '0') && (ch <= '9')) - || (((ch | 0x20) >= 'a') && ((ch | 0x20) <= 'f'))) p++; - } - - /* Now look for UL, LU, UH, HU, L, H modifiers */ - while ((ch = *p) != 0) - { - ch |= 0x20; - if (ch == 'h') modifier |= 1; - else if (ch == 'l') modifier |= 2; - else if (ch == 'u') modifier |= 4; - else break; - p++; - } - if ((1|2) == (modifier & (1|2))) /* hl present */ - return SLANG_STRING_TYPE; - - if (ch == 0) - { - if ((modifier & 0x7) == 0) return SLANG_INT_TYPE; - if (modifier & 4) - { - if (modifier & 1) return SLANG_USHORT_TYPE; - if (modifier & 2) return SLANG_ULONG_TYPE; - return SLANG_UINT_TYPE; - } - if (modifier & 1) return SLANG_SHORT_TYPE; - if (modifier & 2) return SLANG_LONG_TYPE; - return SLANG_INT_TYPE; - } - - if (modifier) return SLANG_STRING_TYPE; -#if SLANG_HAS_FLOAT - } - - /* now down to double case */ - if (*p == '.') - { - p++; - while ((*p >= '0') && (*p <= '9')) p++; - } - if (*p == 0) return(SLANG_DOUBLE_TYPE); - if ((*p != 'e') && (*p != 'E')) - { -# if SLANG_HAS_COMPLEX - if (((*p == 'i') || (*p == 'j')) - && (p[1] == 0)) - return SLANG_COMPLEX_TYPE; -# endif - if (((*p | 0x20) == 'f') && (p[1] == 0)) - return SLANG_FLOAT_TYPE; - - return SLANG_STRING_TYPE; - } - - p++; - if ((*p == '-') || (*p == '+')) p++; - while ((*p >= '0') && (*p <= '9')) p++; - if (*p != 0) - { -# if SLANG_HAS_COMPLEX - if (((*p == 'i') || (*p == 'j')) - && (p[1] == 0)) - return SLANG_COMPLEX_TYPE; -# endif - if (((*p | 0x20) == 'f') && (p[1] == 0)) - return SLANG_FLOAT_TYPE; - - return SLANG_STRING_TYPE; - } - return SLANG_DOUBLE_TYPE; -#else - return SLANG_STRING_TYPE; -#endif /* SLANG_HAS_FLOAT */ -} - -static int hex_atoul (unsigned char *s, unsigned long *ul) -{ - register unsigned char ch; - register unsigned long value; - register int base; - - s++; /* skip the leading 0 */ - - /* look for 'x' which indicates hex */ - if ((*s | 0x20) == 'x') - { - base = 16; - s++; - if (*s == 0) - { - SLang_Error = SL_SYNTAX_ERROR; - return -1; - } - } - else base = 8; - - value = 0; - while ((ch = *s++) != 0) - { - char ch1 = ch | 0x20; - switch (ch1) - { - default: - SLang_Error = SL_SYNTAX_ERROR; - break; - - case 'u': - case 'l': - case 'h': - *ul = value; - return 0; - - case '8': - case '9': - if (base != 16) SLang_Error = SL_SYNTAX_ERROR; - /* drop */ - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - ch1 -= '0'; - break; - - case 'a': - case 'b': - case 'c': - case 'd': - case 'e': - case 'f': - if (base != 16) SLang_Error = SL_SYNTAX_ERROR; - ch1 = (ch1 - 'a') + 10; - break; - } - value = value * base + ch1; - } - *ul = value; - return 0; -} - -/* Note: These routines do not check integer overflow. I would use the C - * library functions atol and atoul but some implementations check overflow - * and some do not. The following implementations provide a consistent - * behavior. - */ -unsigned long SLatoul (unsigned char *s) -{ - int sign; - unsigned long value; - - if (*s == '-') sign = -1; - else - { - sign = 1; - if (*s == '+') s++; - } - - if (*s == '0') - { - if (-1 == hex_atoul (s, &value)) - return (unsigned long) -1; - } - else - { - while (WHITE_CHAR == CHAR_CLASS(*s)) - s++; - - value = 0; - while (DIGIT_CHAR == CHAR_CLASS(*s)) - { - value = value * 10 + (unsigned long) (*s - '0'); - s++; - } - } - - if (sign == -1) - value = (unsigned long)-1L * value; - - return value; -} - -long SLatol (unsigned char *s) -{ - while (WHITE_CHAR == CHAR_CLASS(*s)) - s++; - - if (*s == '-') - { - long value = (long) SLatoul (s+1); - return -value; - } - return (long) SLatoul (s); -} - -int SLatoi (unsigned char *s) -{ - return (int) SLatol (s); -} - -static char *check_byte_compiled_token (char *buf) -{ - unsigned int len_lo, len_hi, len; - - len_lo = (unsigned char) *Input_Line_Pointer++; - if ((len_lo < 32) - || ((len_hi = (unsigned char)*Input_Line_Pointer++) < 32) - || ((len = (len_lo - 32) | ((len_hi - 32) << 7)) >= MAX_TOKEN_LEN)) - { - SLang_doerror ("Byte compiled file appears corrupt"); - return NULL; - } - - SLMEMCPY (buf, Input_Line_Pointer, len); - buf += len; - Input_Line_Pointer += len; - *buf = 0; - return buf; -} - -void _SLcompile_byte_compiled (void) -{ - unsigned char type; - _SLang_Token_Type tok; - char buf[MAX_TOKEN_LEN]; - char *ebuf; - unsigned int len; - - memset ((char *) &tok, 0, sizeof (_SLang_Token_Type)); - - while (SLang_Error == 0) - { - top_of_switch: - type = (unsigned char) *Input_Line_Pointer++; - switch (type) - { - case '\n': - case 0: - if (NULL == (Input_Line = LLT->read(LLT))) - { - Input_Line_Pointer = Input_Line = NULL; - return; - } - Input_Line_Pointer = Input_Line; - goto top_of_switch; - - case LINE_NUM_TOKEN: - case CHAR_TOKEN: - case UCHAR_TOKEN: - case SHORT_TOKEN: - case USHORT_TOKEN: - case INT_TOKEN: - case UINT_TOKEN: - case LONG_TOKEN: - case ULONG_TOKEN: - if (NULL == check_byte_compiled_token (buf)) - return; - tok.v.long_val = atol (buf); - break; - - case COMPLEX_TOKEN: - case FLOAT_TOKEN: - case DOUBLE_TOKEN: - if (NULL == check_byte_compiled_token (buf)) - return; - tok.v.s_val = buf; - break; - - case ESC_STRING_TOKEN: - if (NULL == (ebuf = check_byte_compiled_token (buf))) - return; - tok.v.s_val = buf; - if (expand_escaped_string (buf, buf, ebuf, &len)) - { - tok.hash = len; - type = _BSTRING_TOKEN; - } - else - { - tok.hash = _SLstring_hash ((unsigned char *)buf, (unsigned char *)buf + len); - type = STRING_TOKEN; - } - break; - - case TMP_TOKEN: - case DEFINE_TOKEN: - case DEFINE_STATIC_TOKEN: - case DEFINE_PRIVATE_TOKEN: - case DEFINE_PUBLIC_TOKEN: - case DOT_TOKEN: - case STRING_TOKEN: - case IDENT_TOKEN: - case _REF_TOKEN: - case _DEREF_ASSIGN_TOKEN: - case _SCALAR_ASSIGN_TOKEN: - case _SCALAR_PLUSEQS_TOKEN: - case _SCALAR_MINUSEQS_TOKEN: - case _SCALAR_TIMESEQS_TOKEN: - case _SCALAR_DIVEQS_TOKEN: - case _SCALAR_BOREQS_TOKEN: - case _SCALAR_BANDEQS_TOKEN: - case _SCALAR_PLUSPLUS_TOKEN: - case _SCALAR_POST_PLUSPLUS_TOKEN: - case _SCALAR_MINUSMINUS_TOKEN: - case _SCALAR_POST_MINUSMINUS_TOKEN: - case _STRUCT_ASSIGN_TOKEN: - case _STRUCT_PLUSEQS_TOKEN: - case _STRUCT_MINUSEQS_TOKEN: - case _STRUCT_TIMESEQS_TOKEN: - case _STRUCT_DIVEQS_TOKEN: - case _STRUCT_BOREQS_TOKEN: - case _STRUCT_BANDEQS_TOKEN: - case _STRUCT_POST_MINUSMINUS_TOKEN: - case _STRUCT_MINUSMINUS_TOKEN: - case _STRUCT_POST_PLUSPLUS_TOKEN: - case _STRUCT_PLUSPLUS_TOKEN: - if (NULL == (ebuf = check_byte_compiled_token (buf))) - return; - tok.v.s_val = buf; - tok.hash = _SLstring_hash ((unsigned char *)buf, (unsigned char *)ebuf); - break; - - default: - break; - } - tok.type = type; - - (*_SLcompile_ptr) (&tok); - } -} - -static int escape_string (unsigned char *s, unsigned char *smax, - unsigned char *buf, unsigned char *buf_max, - int *is_escaped) -{ - unsigned char ch; - - *is_escaped = 0; - while (buf < buf_max) - { - if (s == smax) - { - *buf = 0; - return 0; - } - - ch = *s++; - switch (ch) - { - default: - *buf++ = ch; - break; - - case 0: - *buf++ = '\\'; - if (buf < buf_max) *buf++ = 'x'; - if (buf < buf_max) *buf++ = '0'; - if (buf < buf_max) *buf++ = '0'; - *is_escaped = 1; - break; /* return 0; */ - - case '\n': - *buf++ = '\\'; - if (buf < buf_max) *buf++ = 'n'; - *is_escaped = 1; - break; - - case '\r': - *buf++ = '\\'; - if (buf < buf_max) *buf++ = 'r'; - *is_escaped = 1; - break; - - case 0x1A: /* ^Z */ - *buf++ = '\\'; - if (buf < buf_max) *buf++ = 'x'; - if (buf < buf_max) *buf++ = '1'; - if (buf < buf_max) *buf++ = 'A'; - *is_escaped = 1; - break; - - case '\\': - *buf++ = ch; - if (buf < buf_max) *buf++ = ch; - *is_escaped = 1; - break; - } - } - _SLparse_error ("String too long to byte-compile", NULL, 0); - return -1; -} - -static FILE *Byte_Compile_Fp; -static unsigned int Byte_Compile_Line_Len; - -static int bytecomp_write_data (char *buf, unsigned int len) -{ - char *err = "Write Error"; - - if ((Byte_Compile_Line_Len + len + 1) >= MAX_FILE_LINE_LEN) - { - if (EOF == fputs ("\n", Byte_Compile_Fp)) - { - SLang_doerror (err); - return -1; - } - Byte_Compile_Line_Len = 0; - } - - if (EOF == fputs (buf, Byte_Compile_Fp)) - { - SLang_doerror (err); - return -1; - } - Byte_Compile_Line_Len += len; - return 0; -} - -static void byte_compile_token (_SLang_Token_Type *tok) -{ - unsigned char buf [MAX_TOKEN_LEN + 4], *buf_max; - unsigned int len; - char *b3; - int is_escaped; - unsigned char *s; - - if (SLang_Error) return; - - buf [0] = (unsigned char) tok->type; - buf [1] = 0; - - buf_max = buf + sizeof(buf); - b3 = (char *) buf + 3; - - switch (tok->type) - { - case LINE_NUM_TOKEN: - case CHAR_TOKEN: - case SHORT_TOKEN: - case INT_TOKEN: - case LONG_TOKEN: - sprintf (b3, "%ld", tok->v.long_val); - break; - - case UCHAR_TOKEN: - case USHORT_TOKEN: - case UINT_TOKEN: - case ULONG_TOKEN: - sprintf (b3, "%lu", tok->v.long_val); - break; - - case _BSTRING_TOKEN: - s = (unsigned char *) tok->v.s_val; - len = (unsigned int) tok->hash; - - if (-1 == escape_string (s, s + len, - (unsigned char *)b3, buf_max, - &is_escaped)) - return; - - buf[0] = ESC_STRING_TOKEN; - break; - - case BSTRING_TOKEN: - if (NULL == (s = SLbstring_get_pointer (tok->v.b_val, &len))) - return; - - if (-1 == escape_string (s, s + len, - (unsigned char *)b3, buf_max, - &is_escaped)) - return; - buf[0] = ESC_STRING_TOKEN; - break; - - case STRING_TOKEN: - s = (unsigned char *)tok->v.s_val; - - if (-1 == escape_string (s, s + strlen ((char *)s), - (unsigned char *)b3, buf_max, - &is_escaped)) - return; - - if (is_escaped) - buf[0] = ESC_STRING_TOKEN; - break; - - /* a _SCALAR_* token is attached to an identifier. */ - case _DEREF_ASSIGN_TOKEN: - case _SCALAR_ASSIGN_TOKEN: - case _SCALAR_PLUSEQS_TOKEN: - case _SCALAR_MINUSEQS_TOKEN: - case _SCALAR_TIMESEQS_TOKEN: - case _SCALAR_DIVEQS_TOKEN: - case _SCALAR_BOREQS_TOKEN: - case _SCALAR_BANDEQS_TOKEN: - case _SCALAR_PLUSPLUS_TOKEN: - case _SCALAR_POST_PLUSPLUS_TOKEN: - case _SCALAR_MINUSMINUS_TOKEN: - case _SCALAR_POST_MINUSMINUS_TOKEN: - case DOT_TOKEN: - case TMP_TOKEN: - case DEFINE_TOKEN: - case DEFINE_STATIC_TOKEN: - case DEFINE_PRIVATE_TOKEN: - case DEFINE_PUBLIC_TOKEN: - case FLOAT_TOKEN: - case DOUBLE_TOKEN: - case COMPLEX_TOKEN: - case IDENT_TOKEN: - case _REF_TOKEN: - case _STRUCT_ASSIGN_TOKEN: - case _STRUCT_PLUSEQS_TOKEN: - case _STRUCT_MINUSEQS_TOKEN: - case _STRUCT_TIMESEQS_TOKEN: - case _STRUCT_DIVEQS_TOKEN: - case _STRUCT_BOREQS_TOKEN: - case _STRUCT_BANDEQS_TOKEN: - case _STRUCT_POST_MINUSMINUS_TOKEN: - case _STRUCT_MINUSMINUS_TOKEN: - case _STRUCT_POST_PLUSPLUS_TOKEN: - case _STRUCT_PLUSPLUS_TOKEN: - strcpy (b3, tok->v.s_val); - break; - - default: - b3 = NULL; - } - - if (b3 != NULL) - { - len = strlen (b3); - buf[1] = (unsigned char) ((len & 0x7F) + 32); - buf[2] = (unsigned char) (((len >> 7) & 0x7F) + 32); - len += 3; - } - else len = 1; - - (void) bytecomp_write_data ((char *)buf, len); -} - -int SLang_byte_compile_file (char *name, int method) -{ - char file [1024]; - - (void) method; - if (strlen (name) + 2 >= sizeof (file)) - { - SLang_verror (SL_INVALID_PARM, "Filename too long"); - return -1; - } - sprintf (file, "%sc", name); - if (NULL == (Byte_Compile_Fp = fopen (file, "w"))) - { - SLang_verror(SL_OBJ_NOPEN, "%s: unable to open", file); - return -1; - } - - Byte_Compile_Line_Len = 0; - if (-1 != bytecomp_write_data (".#", 2)) - { - _SLcompile_ptr = byte_compile_token; - (void) SLang_load_file (name); - _SLcompile_ptr = _SLcompile; - - (void) bytecomp_write_data ("\n", 1); - } - - if (EOF == fclose (Byte_Compile_Fp)) - SLang_doerror ("Write Error"); - - if (SLang_Error) - { - SLang_verror (0, "Error processing %s", name); - return -1; - } - return 0; -} - -int SLang_generate_debug_info (int x) -{ - int y = Default_Compile_Line_Num_Info; - Default_Compile_Line_Num_Info = x; - return y; -} diff --git a/mdk-stage1/slang/sltypes.c b/mdk-stage1/slang/sltypes.c deleted file mode 100644 index 05b8741b1..000000000 --- a/mdk-stage1/slang/sltypes.c +++ /dev/null @@ -1,966 +0,0 @@ -/* Basic type operations for S-Lang */ -/* Copyright (c) 1992, 1996, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#if SLANG_HAS_FLOAT -# include <math.h> -#endif - -#define SL_APP_WANTS_FOREACH /* for String_Type */ -#include "slang.h" -#include "_slang.h" - -int SLpop_string (char **s) /*{{{*/ -{ - char *sls; - - *s = NULL; - - if (-1 == SLang_pop_slstring (&sls)) - return -1; - - if (NULL == (*s = SLmake_string (sls))) - { - SLang_free_slstring (sls); - return -1; - } - - SLang_free_slstring (sls); - return 0; -} - -/*}}}*/ - -int SLang_pop_slstring (char **s) /*{{{*/ -{ - return SLclass_pop_ptr_obj (SLANG_STRING_TYPE, (VOID_STAR *)s); -} - -/*}}}*/ - -/* if *data != 0, string should be freed upon use. */ -int SLang_pop_string(char **s, int *data) /*{{{*/ -{ - if (SLpop_string (s)) - return -1; - - *data = 1; - return 0; -} - -/*}}}*/ - -int _SLang_push_slstring (char *s) -{ - if (0 == SLclass_push_ptr_obj (SLANG_STRING_TYPE, (VOID_STAR)s)) - return 0; - - SLang_free_slstring (s); - return -1; -} - -int _SLpush_alloced_slstring (char *s, unsigned int len) -{ - if (NULL == (s = _SLcreate_via_alloced_slstring (s, len))) - return -1; - - return _SLang_push_slstring (s); -} - -int SLang_push_string (char *t) /*{{{*/ -{ - if (t == NULL) - return SLang_push_null (); - - if (NULL == (t = SLang_create_slstring (t))) - return -1; - - return _SLang_push_slstring (t); -} - -/*}}}*/ - -int _SLang_dup_and_push_slstring (char *s) -{ - if (NULL == (s = _SLstring_dup_slstring (s))) - return SLang_push_null (); - - return _SLang_push_slstring (s); -} - - -/* This function _always_ frees the malloced string */ -int SLang_push_malloced_string (char *c) /*{{{*/ -{ - int ret; - - ret = SLang_push_string (c); - SLfree (c); - - return ret; -} - -/*}}}*/ - -#if 0 -static int int_int_power (int a, int b) -{ - int r, s; - - if (a == 0) return 0; - if (b < 0) return 0; - if (b == 0) return 1; - - s = 1; - if (a < 0) - { - if ((b % 2) == 1) s = -1; - a = -a; - } - - /* FIXME: Priority=low - * This needs optimized - */ - r = 1; - while (b) - { - r = r * a; - b--; - } - return r * s; -} -#endif - -static int -string_string_bin_op_result (int op, unsigned char a, unsigned char b, - unsigned char *c) -{ - (void) a; - (void) b; - switch (op) - { - default: - return 0; - - case SLANG_PLUS: - *c = SLANG_STRING_TYPE; - break; - - case SLANG_GT: - case SLANG_GE: - case SLANG_LT: - case SLANG_LE: - case SLANG_EQ: - case SLANG_NE: - *c = SLANG_CHAR_TYPE; - break; - } - return 1; -} - -static int -string_string_bin_op (int op, - unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp, unsigned int nb, - VOID_STAR cp) -{ - char *ic; - char **a, **b, **c; - unsigned int n, n_max; - unsigned int da, db; - - (void) a_type; - (void) b_type; - - if (na == 1) da = 0; else da = 1; - if (nb == 1) db = 0; else db = 1; - - if (na > nb) n_max = na; else n_max = nb; - - a = (char **) ap; - b = (char **) bp; - for (n = 0; n < n_max; n++) - { - if ((*a == NULL) || (*b == NULL)) - { - SLang_verror (SL_VARIABLE_UNINITIALIZED, "String element[%u] not initialized for binary operation", n); - return -1; - } - a += da; b += db; - } - - a = (char **) ap; - b = (char **) bp; - ic = (char *) cp; - c = NULL; - - switch (op) - { - case SLANG_DIVIDE: - case SLANG_MINUS: - default: - return 0; - - case SLANG_PLUS: - /* Concat */ - c = (char **) cp; - for (n = 0; n < n_max; n++) - { - if (NULL == (c[n] = SLang_concat_slstrings (*a, *b))) - goto return_error; - - a += da; b += db; - } - break; - - case SLANG_NE: - for (n = 0; n < n_max; n++) - { - ic [n] = (0 != strcmp (*a, *b)); - a += da; - b += db; - } - break; - case SLANG_GT: - for (n = 0; n < n_max; n++) - { - ic [n] = (strcmp (*a, *b) > 0); - a += da; - b += db; - } - break; - case SLANG_GE: - for (n = 0; n < n_max; n++) - { - ic [n] = (strcmp (*a, *b) >= 0); - a += da; - b += db; - } - break; - case SLANG_LT: - for (n = 0; n < n_max; n++) - { - ic [n] = (strcmp (*a, *b) < 0); - a += da; - b += db; - } - break; - case SLANG_LE: - for (n = 0; n < n_max; n++) - { - ic [n] = (strcmp (*a, *b) <= 0); - a += da; - b += db; - } - break; - case SLANG_EQ: - for (n = 0; n < n_max; n++) - { - ic [n] = (strcmp (*a, *b) == 0); - a += da; - b += db; - } - break; - } - return 1; - - return_error: - if (c != NULL) - { - unsigned int nn; - for (nn = 0; nn < n; nn++) - { - SLang_free_slstring (c[nn]); - c[nn] = NULL; - } - for (nn = n; nn < n_max; nn++) - c[nn] = NULL; - } - return -1; -} - -static void string_destroy (unsigned char unused, VOID_STAR s) -{ - (void) unused; - SLang_free_slstring (*(char **) s); -} - -static int string_push (unsigned char unused, VOID_STAR sptr) -{ - (void) unused; - return SLang_push_string (*(char **) sptr); -} - -static int string_cmp (unsigned char unused, VOID_STAR ap, VOID_STAR bp, int *c) -{ - char *a, *b; - (void) unused; - - a = *(char **) ap; - b = *(char **) bp; - if (a != b) - { - if (a == NULL) *c = -1; - else if (b == NULL) *c = 1; - else *c = strcmp (a, b); - return 0; - } - *c = 0; - return 0; -} - -static int string_to_int (unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp) -{ - char **s; - unsigned int i; - int *b; - - (void) a_type; - (void) b_type; - - s = (char **) ap; - b = (int *) bp; - for (i = 0; i < na; i++) - { - if (s[i] == NULL) b[i] = 0; - else b[i] = s[i][0]; - } - return 1; -} - -struct _SLang_Foreach_Context_Type -{ - char *string; - unsigned int n; -}; - -static SLang_Foreach_Context_Type * -string_foreach_open (unsigned char type, unsigned int num) -{ - char *s; - SLang_Foreach_Context_Type *c; - - (void) type; - if (num != 0) - { - SLang_verror (SL_NOT_IMPLEMENTED, - "'foreach using' form not supported by String_Type"); - SLdo_pop_n (num + 1); - return NULL; - } - if (-1 == SLang_pop_slstring (&s)) - return NULL; - - c = (SLang_Foreach_Context_Type *)SLmalloc (sizeof (SLang_Foreach_Context_Type)); - if (c == NULL) - { - SLang_free_slstring (s); - return NULL; - } - - memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type)); - c->string = s; - - return c; -} - -static void string_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c) -{ - (void) type; - if (c == NULL) return; - SLang_free_slstring (c->string); - SLfree ((char *) c); -} - -static int string_foreach (unsigned char type, SLang_Foreach_Context_Type *c) -{ - char ch; - - (void) type; - ch = c->string[c->n]; - if (ch == 0) - return 0; /* done */ - - c->n += 1; - - if (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, ch)) - return -1; - - return 1; -} - -int _SLstring_list_push (_SLString_List_Type *p) -{ - unsigned int num; - int inum; - SLang_Array_Type *at; - char **buf; - - if ((buf = p->buf) == NULL) - return SLang_push_null (); - - num = p->num; - inum = (int) num; - - if (num == 0) num++; - if (num != p->max_num) - { - if (NULL == (buf = (char **)SLrealloc ((char *) buf, sizeof (char *) * num))) - { - _SLstring_list_delete (p); - return -1; - } - p->max_num = num; - p->buf = buf; - } - - if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, (VOID_STAR) buf, &inum, 1))) - { - _SLstring_list_delete (p); - return -1; - } - p->buf = NULL; - _SLstring_list_delete (p); - return SLang_push_array (at, 1); -} - -int _SLstring_list_init (_SLString_List_Type *p, unsigned int max_num, unsigned int delta_num) -{ - if (NULL == (p->buf = (char **) SLmalloc (max_num * sizeof (char *)))) - return -1; - - p->max_num = max_num; - p->num = 0; - p->delta_num = delta_num; - return 0; -} - -int _SLstring_list_append (_SLString_List_Type *p, char *s) -{ - if (s == NULL) - { - _SLstring_list_delete (p); - return -1; - } - - if (p->max_num == p->num) - { - char **b; - unsigned int max_num = p->num + p->delta_num; - b = (char **)SLrealloc ((char *)p->buf, max_num * sizeof (char *)); - if (b == NULL) - { - _SLstring_list_delete (p); - SLang_free_slstring (s); - return -1; - } - p->buf = b; - p->max_num = max_num; - } - - p->buf[p->num] = s; - p->num++; - return 0; -} - -void _SLstring_list_delete (_SLString_List_Type *p) -{ - if (p->buf != NULL) - { - unsigned int i, imax; - char **buf = p->buf; - imax = p->num; - for (i = 0; i < imax; i++) - SLang_free_slstring (buf[i]); - SLfree ((char *)buf); - p->buf = NULL; - } -} - -/* Ref type */ -int SLang_pop_ref (SLang_Ref_Type **ref) -{ - return SLclass_pop_ptr_obj (SLANG_REF_TYPE, (VOID_STAR *)ref); -} - -/* Note: This is ok if ptr is NULL. Some routines rely on this behavior */ -int _SLang_push_ref (int is_global, VOID_STAR ptr) -{ - SLang_Ref_Type *r; - - if (ptr == NULL) - return SLang_push_null (); - - r = (SLang_Ref_Type *) SLmalloc (sizeof (SLang_Ref_Type)); - if (r == NULL) return -1; - - r->is_global = is_global; - r->v.nt = (SLang_Name_Type *) ptr; - - if (-1 == SLclass_push_ptr_obj (SLANG_REF_TYPE, (VOID_STAR) r)) - { - SLfree ((char *) r); - return -1; - } - return 0; -} - -static void ref_destroy (unsigned char type, VOID_STAR ptr) -{ - (void) type; - SLfree ((char *) *(SLang_Ref_Type **)ptr); -} - -void SLang_free_ref (SLang_Ref_Type *ref) -{ - SLfree ((char *) ref); -} - -static int ref_push (unsigned char type, VOID_STAR ptr) -{ - SLang_Ref_Type *ref; - - (void) type; - - ref = *(SLang_Ref_Type **) ptr; - - if (ref == NULL) - return SLang_push_null (); - - return _SLang_push_ref (ref->is_global, (VOID_STAR) ref->v.nt); -} - -int SLang_assign_to_ref (SLang_Ref_Type *ref, unsigned char type, VOID_STAR v) -{ - SLang_Object_Type *stkptr; - SLang_Class_Type *cl; - - cl = _SLclass_get_class (type); - - /* Use apush since this function is passing ``array'' bytes rather than the - * address of the data. I need to somehow make this more consistent. To - * see what I mean, consider: - * - * double z[2]; - * char *s = "silly"; - * int i; - * - * SLang_assign_to_ref (ref, SLANG_INT_TYPE, &i); - * SLang_assign_to_ref (ref, SLANG_STRING_TYPE, &s); - * SLang_assign_to_ref (ref, SLANG_COMPLEX_TYPE, z); - * - * That is, all external routines that take a VOID_STAR argument need to - * be documented such that how the function should be called with the - * various class_types. - */ - if (-1 == (*cl->cl_apush) (type, v)) - return -1; - - stkptr = _SLStack_Pointer; - if (0 == _SLang_deref_assign (ref)) - return 0; - - if (stkptr != _SLStack_Pointer) - SLdo_pop (); - - return -1; -} - -static char *ref_string (unsigned char type, VOID_STAR ptr) -{ - SLang_Ref_Type *ref; - - (void) type; - ref = *(SLang_Ref_Type **) ptr; - if (ref->is_global) - { - char *name, *s; - - name = ref->v.nt->name; - if ((name != NULL) - && (NULL != (s = SLmalloc (strlen(name) + 2)))) - { - *s = '&'; - strcpy (s + 1, name); - return s; - } - - return NULL; - } - return SLmake_string ("Local Variable Reference"); -} - -static int ref_dereference (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - return _SLang_dereference_ref (*(SLang_Ref_Type **) ptr); -} - -static int ref_cmp (unsigned char type, VOID_STAR a, VOID_STAR b, int *c) -{ - SLang_Ref_Type *ra, *rb; - - (void) type; - - ra = *(SLang_Ref_Type **)a; - rb = *(SLang_Ref_Type **)b; - - if (ra == NULL) - { - if (rb == NULL) *c = 0; - else *c = -1; - return 0; - } - if (rb == NULL) - { - *c = 1; - return 0; - } - - if (ra->v.nt == rb->v.nt) - *c = 0; - else *c = strcmp (ra->v.nt->name, rb->v.nt->name); - return 0; -} - - -SLang_Name_Type *SLang_pop_function (void) -{ - SLang_Ref_Type *ref; - SLang_Name_Type *f; - - if (SLang_peek_at_stack () == SLANG_STRING_TYPE) - { - char *name; - - if (-1 == SLang_pop_slstring (&name)) - return NULL; - - if (NULL == (f = SLang_get_function (name))) - { - SLang_verror (SL_UNDEFINED_NAME, "Function %s does not exist", name); - SLang_free_slstring (name); - return NULL; - } - SLang_free_slstring (name); - return f; - } - - if (-1 == SLang_pop_ref (&ref)) - return NULL; - - f = SLang_get_fun_from_ref (ref); - SLang_free_ref (ref); - return f; -} - -/* This is a placeholder for version 2 */ -void SLang_free_function (SLang_Name_Type *f) -{ - (void) f; -} - -/* NULL type */ -int SLang_push_null (void) -{ - return SLclass_push_ptr_obj (SLANG_NULL_TYPE, NULL); -} - -int SLang_pop_null (void) -{ - SLang_Object_Type obj; - return _SLang_pop_object_of_type (SLANG_NULL_TYPE, &obj, 0); -} - -static int null_push (unsigned char unused, VOID_STAR ptr_unused) -{ - (void) unused; (void) ptr_unused; - return SLang_push_null (); -} - -static int null_pop (unsigned char type, VOID_STAR ptr) -{ - (void) type; - - if (-1 == SLang_pop_null ()) - return -1; - - *(char **) ptr = NULL; - return 0; -} - -/* Implement foreach (NULL) using (whatever) to do nothing. This is useful - * because suppose that X is a list but is NULL in some situations. Then - * when it is NULL, we want foreach(X) to do nothing. - */ -static SLang_Foreach_Context_Type * -null_foreach_open (unsigned char type, unsigned int num) -{ - (void) type; - SLdo_pop_n (num + 1); - return (SLang_Foreach_Context_Type *)1; -} - -static void null_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c) -{ - (void) type; - (void) c; -} - -static int null_foreach (unsigned char type, SLang_Foreach_Context_Type *c) -{ - (void) type; - (void) c; - return 0; -} - -static int null_to_bool (unsigned char type, int *t) -{ - (void) type; - *t = 0; - return SLang_pop_null (); -} - -/* AnyType */ -int _SLanytype_typecast (unsigned char a_type, VOID_STAR ap, unsigned int na, - unsigned char b_type, VOID_STAR bp) -{ - SLang_Class_Type *cl; - SLang_Any_Type **any; - unsigned int i; - unsigned int sizeof_type; - - (void) b_type; - - any = (SLang_Any_Type **) bp; - - cl = _SLclass_get_class (a_type); - sizeof_type = cl->cl_sizeof_type; - - for (i = 0; i < na; i++) - { - if ((-1 == (*cl->cl_apush) (a_type, ap)) - || (-1 == SLang_pop_anytype (&any[i]))) - { - while (i != 0) - { - i--; - SLang_free_anytype (any[i]); - any[i] = NULL; - } - return -1; - } - ap = (VOID_STAR)((char *)ap + sizeof_type); - } - - return 1; -} - -int SLang_pop_anytype (SLang_Any_Type **any) -{ - SLang_Object_Type *obj; - - *any = NULL; - - if (NULL == (obj = (SLang_Object_Type *) SLmalloc (sizeof (SLang_Object_Type)))) - return -1; - - if (-1 == SLang_pop (obj)) - { - SLfree ((char *) obj); - return -1; - } - *any = (SLang_Any_Type *)obj; - return 0; -} - -/* This function will result in an object that is represented by the - * anytype object. - */ -int SLang_push_anytype (SLang_Any_Type *any) -{ - return _SLpush_slang_obj ((SLang_Object_Type *)any); -} - -/* After this call, the stack will contain an Any_Type object */ -static int anytype_push (unsigned char type, VOID_STAR ptr) -{ - SLang_Any_Type *obj; - - /* Push the object onto the stack, then pop it back off into our anytype - * container. That way, any memory managing associated with the type - * will be performed automatically. Another way to think of it is that - * pushing an Any_Type onto the stack will create another copy of the - * object represented by it. - */ - if (-1 == _SLpush_slang_obj (*(SLang_Object_Type **)ptr)) - return -1; - - if (-1 == SLang_pop_anytype (&obj)) - return -1; - - /* There is no need to reference count the anytype objects since every - * push results in a new anytype container. - */ - if (-1 == SLclass_push_ptr_obj (type, (VOID_STAR) obj)) - { - SLang_free_anytype (obj); - return -1; - } - - return 0; -} - -static void anytype_destroy (unsigned char type, VOID_STAR ptr) -{ - SLang_Object_Type *obj; - - (void) type; - obj = *(SLang_Object_Type **)ptr; - SLang_free_object (obj); - SLfree ((char *) obj); -} - -void SLang_free_anytype (SLang_Any_Type *any) -{ - if (any != NULL) - anytype_destroy (SLANG_ANY_TYPE, (VOID_STAR) &any); -} - -static int anytype_dereference (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - return _SLpush_slang_obj (*(SLang_Object_Type **) ptr); -} - -/* SLANG_INTP_TYPE */ -static int intp_push (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - return SLclass_push_int_obj (SLANG_INT_TYPE, **(int **)ptr); -} - -static int intp_pop (unsigned char unused, VOID_STAR ptr) -{ - (void) unused; - return SLang_pop_integer (*(int **) ptr); -} - -static int undefined_push (unsigned char t, VOID_STAR p) -{ - (void) t; (void) p; - if (SLang_Error == 0) - SLang_Error = SL_VARIABLE_UNINITIALIZED; - return -1; -} - -int _SLregister_types (void) -{ - SLang_Class_Type *cl; - - /* A good compiler should optimize this code away. */ - if ((sizeof(short) != SIZEOF_SHORT) - || (sizeof(int) != SIZEOF_INT) - || (sizeof(long) != SIZEOF_LONG) - || (sizeof(float) != SIZEOF_FLOAT) - || (sizeof(double) != SIZEOF_DOUBLE)) - SLang_exit_error ("S-Lang Library not built properly. Fix SIZEOF_* in config.h and recompile"); - - if (-1 == _SLclass_init ()) - return -1; - - /* Undefined Type */ - if (NULL == (cl = SLclass_allocate_class ("Undefined_Type"))) - return -1; - (void) SLclass_set_push_function (cl, undefined_push); - (void) SLclass_set_pop_function (cl, undefined_push); - if (-1 == SLclass_register_class (cl, SLANG_UNDEFINED_TYPE, sizeof (int), - SLANG_CLASS_TYPE_SCALAR)) - return -1; - /* Make Void_Type a synonym for Undefined_Type. Note that this does - * not mean that Void_Type represents SLANG_VOID_TYPE. Void_Type is - * used by array_map to indicate no array is to be created. - */ - if (-1 == SLclass_create_synonym ("Void_Type", SLANG_UNDEFINED_TYPE)) - return -1; - - if (-1 == _SLarith_register_types ()) - return -1; - - /* SLANG_INTP_TYPE */ - if (NULL == (cl = SLclass_allocate_class ("_IntegerP_Type"))) - return -1; - (void) SLclass_set_push_function (cl, intp_push); - (void) SLclass_set_pop_function (cl, intp_pop); - if (-1 == SLclass_register_class (cl, SLANG_INTP_TYPE, sizeof (int), - SLANG_CLASS_TYPE_SCALAR)) - return -1; - - /* String Type */ - - if (NULL == (cl = SLclass_allocate_class ("String_Type"))) - return -1; - (void) SLclass_set_destroy_function (cl, string_destroy); - (void) SLclass_set_push_function (cl, string_push); - cl->cl_foreach_open = string_foreach_open; - cl->cl_foreach_close = string_foreach_close; - cl->cl_foreach = string_foreach; - cl->cl_cmp = string_cmp; - if (-1 == SLclass_register_class (cl, SLANG_STRING_TYPE, sizeof (char *), - SLANG_CLASS_TYPE_PTR)) - return -1; - - /* ref Type */ - if (NULL == (cl = SLclass_allocate_class ("Ref_Type"))) - return -1; - cl->cl_dereference = ref_dereference; - cl->cl_push = ref_push; - cl->cl_destroy = ref_destroy; - cl->cl_string = ref_string; - cl->cl_cmp = ref_cmp; - if (-1 == SLclass_register_class (cl, SLANG_REF_TYPE, - sizeof (SLang_Ref_Type *), - SLANG_CLASS_TYPE_PTR)) - return -1; - - /* NULL Type */ - - if (NULL == (cl = SLclass_allocate_class ("Null_Type"))) - return -1; - cl->cl_push = null_push; - cl->cl_pop = null_pop; - cl->cl_foreach_open = null_foreach_open; - cl->cl_foreach_close = null_foreach_close; - cl->cl_foreach = null_foreach; - cl->cl_to_bool = null_to_bool; - if (-1 == SLclass_register_class (cl, SLANG_NULL_TYPE, sizeof (char *), - SLANG_CLASS_TYPE_SCALAR)) - return -1; - - /* AnyType */ - if (NULL == (cl = SLclass_allocate_class ("Any_Type"))) - return -1; - (void) SLclass_set_push_function (cl, anytype_push); - (void) SLclass_set_destroy_function (cl, anytype_destroy); - cl->cl_dereference = anytype_dereference; - if (-1 == SLclass_register_class (cl, SLANG_ANY_TYPE, sizeof (VOID_STAR), - SLANG_CLASS_TYPE_PTR)) - return -1; - - if (-1 == _SLang_init_bstring ()) - return -1; - - if ((-1 == SLclass_add_typecast (SLANG_STRING_TYPE, SLANG_INT_TYPE, string_to_int, 0)) - || (-1 == SLclass_add_binary_op (SLANG_STRING_TYPE, SLANG_STRING_TYPE, string_string_bin_op, string_string_bin_op_result))) - return -1; - - return 0; -} - diff --git a/mdk-stage1/slang/slutty.c b/mdk-stage1/slang/slutty.c deleted file mode 100644 index 636c1bb90..000000000 --- a/mdk-stage1/slang/slutty.c +++ /dev/null @@ -1,596 +0,0 @@ -/* slutty.c --- Unix Low level terminal (tty) functions for S-Lang */ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -#include "slinclud.h" - -#include <signal.h> -/* sequent support thanks to Kenneth Lorber <keni@oasys.dt.navy.mil> */ -/* SYSV (SYSV ISC R3.2 v3.0) provided by iain.lea@erlm.siemens.de */ - -#if defined (_AIX) && !defined (_ALL_SOURCE) -# define _ALL_SOURCE /* so NBBY is defined in <sys/types.h> */ -#endif - -#include <sys/time.h> -#include <sys/types.h> - -#ifdef SYSV -# include <fcntl.h> -# ifndef CRAY -# include <sys/termio.h> -# include <sys/stream.h> -# include <sys/ptem.h> -# include <sys/tty.h> -# endif -#endif - -#ifdef __BEOS__ -/* Prototype for select */ -# include <net/socket.h> -#endif - -#include <sys/file.h> - -#ifndef sun -# include <sys/ioctl.h> -#endif - -#ifdef __QNX__ -# include <sys/select.h> -#endif - -#include <sys/stat.h> -#include <errno.h> - -#if defined (_AIX) && !defined (FD_SET) -# include <sys/select.h> /* for FD_ISSET, FD_SET, FD_ZERO */ -#endif - -#ifndef O_RDWR -# include <fcntl.h> -#endif - -#include "slang.h" -#include "_slang.h" - -int SLang_TT_Read_FD = -1; -int SLang_TT_Baud_Rate; - -#ifdef HAVE_TERMIOS_H -# if !defined(HAVE_TCGETATTR) || !defined(HAVE_TCSETATTR) -# undef HAVE_TERMIOS_H -# endif -#endif - -#ifndef HAVE_TERMIOS_H - -# if !defined(CBREAK) && defined(sun) -# ifndef BSD_COMP -# define BSD_COMP 1 -# endif -# include <sys/ioctl.h> -# endif - -typedef struct - { - struct tchars t; - struct ltchars lt; - struct sgttyb s; - } -TTY_Termio_Type; -#else -# include <termios.h> -typedef struct termios TTY_Termio_Type; -#endif - -static TTY_Termio_Type Old_TTY; - -#ifdef HAVE_TERMIOS_H -typedef struct -{ - unsigned int key; - unsigned int value; -} Baud_Rate_Type; - -static Baud_Rate_Type Baud_Rates [] = -{ -#ifdef B0 - {B0, 0}, -#endif -#ifdef B50 - {B50, 50}, -#endif -#ifdef B75 - {B75, 75}, -#endif -#ifdef B110 - {B110, 110}, -#endif -#ifdef B134 - {B134, 134}, -#endif -#ifdef B150 - {B150, 150}, -#endif -#ifdef B200 - {B200, 200}, -#endif -#ifdef B300 - {B300, 300}, -#endif -#ifdef B600 - {B600, 600}, -#endif -#ifdef B1200 - {B1200, 1200}, -#endif -#ifdef B1800 - {B1800, 1800}, -#endif -#ifdef B2400 - {B2400, 2400}, -#endif -#ifdef B4800 - {B4800, 4800}, -#endif -#ifdef B9600 - {B9600, 9600}, -#endif -#ifdef B19200 - {B19200, 19200}, -#endif -#ifdef B38400 - {B38400, 38400}, -#endif -#ifdef B57600 - {B57600, 57600}, -#endif -#ifdef B115200 - {B115200, 115200}, -#endif -#ifdef B230400 - {B230400, 230400}, -#endif - {0, 0} -}; - -static void -set_baud_rate (TTY_Termio_Type *tty) -{ -#ifdef HAVE_CFGETOSPEED - unsigned int speed; - Baud_Rate_Type *b, *bmax; - - if (SLang_TT_Baud_Rate) - return; /* already set */ - - speed = (unsigned int) cfgetospeed (tty); - - b = Baud_Rates; - bmax = b + (sizeof (Baud_Rates)/sizeof(Baud_Rates[0])); - while (b < bmax) - { - if (b->key == speed) - { - SLang_TT_Baud_Rate = b->value; - return; - } - b++; - } -#else - (void) tty; -#endif -} - -#endif /* HAVE_TERMIOS_H */ - -#ifdef HAVE_TERMIOS_H -# define GET_TERMIOS(fd, x) tcgetattr(fd, x) -# define SET_TERMIOS(fd, x) tcsetattr(fd, TCSADRAIN, x) -#else -# ifdef TCGETS -# define GET_TERMIOS(fd, x) ioctl(fd, TCGETS, x) -# define SET_TERMIOS(fd, x) ioctl(fd, TCSETS, x) -# else -# define X(x,m) &(((TTY_Termio_Type *)(x))->m) -# define GET_TERMIOS(fd, x) \ - ((ioctl(fd, TIOCGETC, X(x,t)) || \ - ioctl(fd, TIOCGLTC, X(x,lt)) || \ - ioctl(fd, TIOCGETP, X(x,s))) ? -1 : 0) -# define SET_TERMIOS(fd, x) \ - ((ioctl(fd, TIOCSETC, X(x,t)) ||\ - ioctl(fd, TIOCSLTC, X(x,lt)) || \ - ioctl(fd, TIOCSETP, X(x,s))) ? -1 : 0) -# endif -#endif - -static int TTY_Inited = 0; -static int TTY_Open = 0; - -#ifdef ultrix /* Ultrix gets _POSIX_VDISABLE wrong! */ -# define NULL_VALUE -1 -#else -# ifdef _POSIX_VDISABLE -# define NULL_VALUE _POSIX_VDISABLE -# else -# define NULL_VALUE 255 -# endif -#endif - -int SLang_init_tty (int abort_char, int no_flow_control, int opost) -{ - TTY_Termio_Type newtty; - - SLsig_block_signals (); - - if (TTY_Inited) - { - SLsig_unblock_signals (); - return 0; - } - - TTY_Open = 0; - - if ((SLang_TT_Read_FD == -1) - || (1 != isatty (SLang_TT_Read_FD))) - { -#ifdef O_RDWR -# ifndef __BEOS__ /* I have been told that BEOS will HANG if passed /dev/tty */ - if ((SLang_TT_Read_FD = open("/dev/tty", O_RDWR)) >= 0) - { - TTY_Open = 1; - } -# endif -#endif - if (TTY_Open == 0) - { - SLang_TT_Read_FD = fileno (stderr); - if (1 != isatty (SLang_TT_Read_FD)) - { - SLang_TT_Read_FD = fileno (stdin); - if (1 != isatty (SLang_TT_Read_FD)) - { - fprintf (stderr, "Failed to open terminal."); - return -1; - } - } - } - } - - SLang_Abort_Char = abort_char; - - /* Some systems may not permit signals to be blocked. As a result, the - * return code must be checked. - */ - while (-1 == GET_TERMIOS(SLang_TT_Read_FD, &Old_TTY)) - { - if (errno != EINTR) - { - SLsig_unblock_signals (); - return -1; - } - } - - while (-1 == GET_TERMIOS(SLang_TT_Read_FD, &newtty)) - { - if (errno != EINTR) - { - SLsig_unblock_signals (); - return -1; - } - } - -#ifndef HAVE_TERMIOS_H - newtty.s.sg_flags &= ~(ECHO); - newtty.s.sg_flags &= ~(CRMOD); - /* if (Flow_Control == 0) newtty.s.sg_flags &= ~IXON; */ - newtty.t.t_eofc = 1; - if (abort_char == -1) SLang_Abort_Char = newtty.t.t_intrc; - newtty.t.t_intrc = SLang_Abort_Char; /* ^G */ - newtty.t.t_quitc = 255; - newtty.lt.t_suspc = 255; /* to ignore ^Z */ - newtty.lt.t_dsuspc = 255; /* to ignore ^Y */ - newtty.lt.t_lnextc = 255; - newtty.s.sg_flags |= CBREAK; /* do I want cbreak or raw????? */ -#else - - /* get baud rate */ - - newtty.c_iflag &= ~(ECHO | INLCR | ICRNL); -#ifdef ISTRIP - /* newtty.c_iflag &= ~ISTRIP; */ -#endif - if (opost == 0) newtty.c_oflag &= ~OPOST; - - set_baud_rate (&newtty); - - if (no_flow_control) newtty.c_iflag &= ~IXON; else newtty.c_iflag |= IXON; - - newtty.c_cc[VEOF] = 1; - newtty.c_cc[VMIN] = 1; - newtty.c_cc[VTIME] = 0; - newtty.c_lflag = ISIG | NOFLSH; - if (abort_char == -1) SLang_Abort_Char = newtty.c_cc[VINTR]; - newtty.c_cc[VINTR] = SLang_Abort_Char; /* ^G */ - newtty.c_cc[VQUIT] = NULL_VALUE; - newtty.c_cc[VSUSP] = NULL_VALUE; /* to ignore ^Z */ -#ifdef VDSUSP - newtty.c_cc[VDSUSP] = NULL_VALUE; /* to ignore ^Y */ -#endif -#ifdef VLNEXT - newtty.c_cc[VLNEXT] = NULL_VALUE; /* to ignore ^V ? */ -#endif -#ifdef VSWTCH - newtty.c_cc[VSWTCH] = NULL_VALUE; /* to ignore who knows what */ -#endif -#endif /* NOT HAVE_TERMIOS_H */ - - while (-1 == SET_TERMIOS(SLang_TT_Read_FD, &newtty)) - { - if (errno != EINTR) - { - SLsig_unblock_signals (); - return -1; - } - } - - TTY_Inited = 1; - SLsig_unblock_signals (); - return 0; -} - -void SLtty_set_suspend_state (int mode) -{ - TTY_Termio_Type newtty; - - SLsig_block_signals (); - - if (TTY_Inited == 0) - { - SLsig_unblock_signals (); - return; - } - - while ((-1 == GET_TERMIOS (SLang_TT_Read_FD, &newtty)) - && (errno == EINTR)) - ; - -#ifndef HAVE_TERMIOS_H - /* I do not know if all systems define the t_dsuspc field */ - if (mode == 0) - { - newtty.lt.t_suspc = 255; - newtty.lt.t_dsuspc = 255; - } - else - { - newtty.lt.t_suspc = Old_TTY.lt.t_suspc; - newtty.lt.t_dsuspc = Old_TTY.lt.t_dsuspc; - } -#else - if (mode == 0) - { - newtty.c_cc[VSUSP] = NULL_VALUE; -#ifdef VDSUSP - newtty.c_cc[VDSUSP] = NULL_VALUE; -#endif - } - else - { - newtty.c_cc[VSUSP] = Old_TTY.c_cc[VSUSP]; -#ifdef VDSUSP - newtty.c_cc[VDSUSP] = Old_TTY.c_cc[VDSUSP]; -#endif - } -#endif - - while ((-1 == SET_TERMIOS (SLang_TT_Read_FD, &newtty)) - && (errno == EINTR)) - ; - - SLsig_unblock_signals (); -} - -void SLang_reset_tty (void) -{ - SLsig_block_signals (); - - if (TTY_Inited == 0) - { - SLsig_unblock_signals (); - return; - } - - while ((-1 == SET_TERMIOS(SLang_TT_Read_FD, &Old_TTY)) - && (errno == EINTR)) - ; - - if (TTY_Open) - { - while ((-1 == close (SLang_TT_Read_FD)) - && (errno == EINTR)) - ; - - TTY_Open = 0; - SLang_TT_Read_FD = -1; - } - - TTY_Inited = 0; - SLsig_unblock_signals (); -} - -static void default_sigint (int sig) -{ - sig = errno; /* use parameter */ - - SLKeyBoard_Quit = 1; - if (SLang_Ignore_User_Abort == 0) SLang_Error = SL_USER_BREAK; - SLsignal_intr (SIGINT, default_sigint); - errno = sig; -} - -int SLang_set_abort_signal (void (*hand)(int)) -{ - int save_errno = errno; - SLSig_Fun_Type *f; - - if (hand == NULL) hand = default_sigint; - f = SLsignal_intr (SIGINT, hand); - - errno = save_errno; - - if (f == (SLSig_Fun_Type *) SIG_ERR) - return -1; - - return 0; -} - -#ifndef FD_SET -#define FD_SET(fd, tthis) *(tthis) = 1 << (fd) -#define FD_ZERO(tthis) *(tthis) = 0 -#define FD_ISSET(fd, tthis) (*(tthis) & (1 << fd)) -typedef int fd_set; -#endif - -static fd_set Read_FD_Set; - -/* HACK: If > 0, use 1/10 seconds. If < 0, use 1/1000 seconds */ - -int _SLsys_input_pending(int tsecs) -{ - struct timeval wait; - long usecs, secs; - - if (TTY_Inited == 0) return -1; - - if (tsecs >= 0) - { - secs = tsecs / 10; - usecs = (tsecs % 10) * 100000; - } - else - { - tsecs = -tsecs; - secs = tsecs / 1000; - usecs = (tsecs % 1000) * 1000; - } - - wait.tv_sec = secs; - wait.tv_usec = usecs; - - FD_ZERO(&Read_FD_Set); - FD_SET(SLang_TT_Read_FD, &Read_FD_Set); - - return select(SLang_TT_Read_FD + 1, &Read_FD_Set, NULL, NULL, &wait); -} - -int (*SLang_getkey_intr_hook) (void); - -static int handle_interrupt (void) -{ - if (SLang_getkey_intr_hook != NULL) - { - int save_tty_fd = SLang_TT_Read_FD; - - if (-1 == (*SLang_getkey_intr_hook) ()) - return -1; - - if (save_tty_fd != SLang_TT_Read_FD) - return -1; - } - - return 0; -} - -unsigned int _SLsys_getkey (void) -{ - unsigned char c; - - if (TTY_Inited == 0) - { - int ic = fgetc (stdin); - if (ic == EOF) return SLANG_GETKEY_ERROR; - return (unsigned int) ic; - } - - while (1) - { - int ret; - - if (SLKeyBoard_Quit) - return SLang_Abort_Char; - - if (0 == (ret = _SLsys_input_pending (100))) - continue; - - if (ret != -1) - break; - - if (SLKeyBoard_Quit) - return SLang_Abort_Char; - - if (errno == EINTR) - { - if (-1 == handle_interrupt ()) - return SLANG_GETKEY_ERROR; - - continue; - } - - break; /* let read handle it */ - } - - while (1) - { - int status = read(SLang_TT_Read_FD, (char *) &c, 1); - - if (status > 0) - break; - - if (status == 0) - { - /* We are at the end of a file. Let application handle it. */ - return SLANG_GETKEY_ERROR; - } - - if (errno == EINTR) - { - if (-1 == handle_interrupt ()) - return SLANG_GETKEY_ERROR; - - if (SLKeyBoard_Quit) - return SLang_Abort_Char; - - continue; - } -#ifdef EAGAIN - if (errno == EAGAIN) - { - sleep (1); - continue; - } -#endif -#ifdef EWOULDBLOCK - if (errno == EWOULDBLOCK) - { - sleep (1); - continue; - } -#endif -#ifdef EIO - if (errno == EIO) - { - SLang_exit_error ("_SLsys_getkey: EIO error."); - } -#endif - return SLANG_GETKEY_ERROR; - } - - return((unsigned int) c); -} - diff --git a/mdk-stage1/slang/slxstrng.c b/mdk-stage1/slang/slxstrng.c deleted file mode 100644 index 3f8a4dffa..000000000 --- a/mdk-stage1/slang/slxstrng.c +++ /dev/null @@ -1,43 +0,0 @@ -/* Copyright (c) 1992, 1999, 2001 John E. Davis - * This file is part of the S-Lang library. - * - * You may distribute under the terms of either the GNU General Public - * License or the Perl Artistic License. - */ - -/* These routines are simple and inefficient. They were designed to work on - * SunOS when using Electric Fence. - */ - -#include "slang.h" -#include "_slang.h" -char *SLstrcpy(register char *aa, register char *b) -{ - char *a = aa; - while ((*a++ = *b++) != 0); - return aa; -} - -int SLstrcmp(register char *a, register char *b) -{ - while (*a && (*a == *b)) - { - a++; - b++; - } - if (*a) return((unsigned char) *a - (unsigned char) *b); - else if (*b) return ((unsigned char) *a - (unsigned char) *b); - else return 0; -} - -char *SLstrncpy(char *a, register char *b,register int n) -{ - register char *aa = a; - while ((n > 0) && *b) - { - *aa++ = *b++; - n--; - } - while (n-- > 0) *aa++ = 0; - return (a); -} diff --git a/mdk-stage1/stage1.c b/mdk-stage1/stage1.c index 4493f35ea..94bb1e0df 100644 --- a/mdk-stage1/stage1.c +++ b/mdk-stage1/stage1.c @@ -121,7 +121,7 @@ static pid_t shell_pid = 0; static void spawn_shell(void) { int fd; - char * shell_name[] = { "/sbin/sh", NULL }; + char * shell_name[] = { "/bin/sh", NULL }; log_message("spawning a shell"); @@ -225,12 +225,12 @@ static void handle_pcmcia(void) log_message("no pcmcia adapter found"); return; } - my_insmod("pcmcia_core", ANY_DRIVER_TYPE, NULL, 0); - my_insmod(pcmcia_adapter, ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("pcmcia_core", ANY_DRIVER_TYPE, NULL); + my_modprobe(pcmcia_adapter, ANY_DRIVER_TYPE, NULL); /* ds is an alias for pcmcia in recent 2.6 kernels but we don't have modules.alias in install, so try to load both */ - my_insmod("ds", ANY_DRIVER_TYPE, NULL, 0); - my_insmod("pcmcia", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("ds", ANY_DRIVER_TYPE, NULL); + my_modprobe("pcmcia", ANY_DRIVER_TYPE, NULL); /* setup a dynamic resource database for non statically mapped PCMCIA sockets */ pcmcia_socket_startup(-1); @@ -248,8 +248,9 @@ static void handle_hid(void) entry_list = hid_probe(); for (i = 0; i < entry_list.nb; i++) { if (entry_list.entries[i].module != NULL) - my_insmod(entry_list.entries[i].module, ANY_DRIVER_TYPE, NULL, 0); + my_modprobe(entry_list.entries[i].module, ANY_DRIVER_TYPE, NULL); } + my_modprobe("hid_generic", ANY_DRIVER_TYPE, NULL); } @@ -343,39 +344,8 @@ static void method_select_and_prepare(void) } #endif -static enum return_type create_initial_fs_symlinks(char* symlinks) -{ - FILE *f; - char buf[5000]; - - if (scall(!(f = fopen(symlinks, "rb")), "fopen")) - return RETURN_ERROR; - while (fgets(buf, sizeof(buf), f)) { - char oldpath[500], newpath[500]; - buf[strlen(buf)-1] = '\0'; // trim \n - if (sscanf(buf, "%s %s", oldpath, newpath) != 2) { - sprintf(oldpath, "%s%s", STAGE2_LOCATION, buf); - sprintf(newpath, "%s", buf); - } - recursiveRemove_if_it_exists(newpath); - log_message("creating symlink %s -> %s", oldpath, newpath); - if (scall(symlink(oldpath, newpath), "symlink")) - return RETURN_ERROR; - } - fclose(f); - return RETURN_OK; -} - void finish_preparing(void) { - recursiveRemove("/init"); - - if (create_initial_fs_symlinks(STAGE2_LOCATION "/usr/share/symlinks") != RETURN_OK) - stg1_fatal_message("Fatal error finishing initialization."); - - /* /tmp/syslog is used by the second init, so it must be copied now, not in stage2 */ - /* we remove it to ensure the old one is not copied over it in stage2 */ - #ifdef SPAWN_SHELL if (shell_pid != 0) { int fd; @@ -419,7 +389,6 @@ int main(int argc __attribute__ ((unused)), char **argv __attribute__ ((unused)) spawn_shell(); #endif init_modules_insmoding(); - init_firmware_loader(); init_frontend("Welcome to " DISTRIB_DESCR ", " __DATE__ " " __TIME__); probe_that_type(VIRTIO_DEVICES, BUS_ANY); @@ -468,7 +437,7 @@ int main(int argc __attribute__ ((unused)), char **argv __attribute__ ((unused)) if (IS_RESCUE) return 66; /* ask init to exec new init */ - else - return 0x35; /* ask init to run stage2 binary */ + + return 0; #endif } diff --git a/mdk-stage1/stdio-frontend.c b/mdk-stage1/stdio-frontend.c index d82f4852d..8c09330b5 100644 --- a/mdk-stage1/stdio-frontend.c +++ b/mdk-stage1/stdio-frontend.c @@ -325,7 +325,7 @@ enum return_type ask_from_entries(char *msg, char ** questions, char *** answers } if (*answers == NULL) - *answers = (char **) malloc(sizeof(char *) * i); + *answers = (char **) calloc(1, sizeof(char *) * i); else already_answers = *answers; diff --git a/mdk-stage1/sysfs/Makefile b/mdk-stage1/sysfs/Makefile deleted file mode 100644 index e3f965c43..000000000 --- a/mdk-stage1/sysfs/Makefile +++ /dev/null @@ -1,39 +0,0 @@ - #****************************************************************************** - # - # Guillaume Cottenceau (gc) - # Olivier Blin (blino) - # - # Copyright 2006 Mandriva - # - # This software may be freely redistributed under the terms of the GNU - # public license. - # - # You should have received a copy of the GNU General Public License - # along with this program; if not, write to the Free Software - # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - # - #***************************************************************************** - -# minimal sysfs library ripped from sysfsutils-2.0.0 - -top_dir = .. - -include $(top_dir)/Makefile.common - -TARGET = libsysfs.a - -all: $(TARGET) - -clean: - rm -f *.o $(TARGET) - -FLAGS = -D__linux__ -Wall -Werror -Wno-deprecated-declarations -Os -fomit-frame-pointer -pipe -c -I.. -D_BSD_SOURCE - -OBJS = sysfs_attr.o sysfs_utils.o - -$(TARGET): $(OBJS) - ar -cru $@ $^ - ranlib $@ - -$(OBJS): %.o: %.c - $(DIET) gcc $(FLAGS) $(INCLUDES) -c $< -o $@ diff --git a/mdk-stage1/sysfs/libsysfs.h b/mdk-stage1/sysfs/libsysfs.h deleted file mode 100644 index 7bdf54fea..000000000 --- a/mdk-stage1/sysfs/libsysfs.h +++ /dev/null @@ -1,90 +0,0 @@ -/* - * libsysfs.h - * - * Header Definitions for libsysfs - * - * Copyright (C) IBM Corp. 2004-2005 - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - */ -#ifndef _LIBSYSFS_H_ -#define _LIBSYSFS_H_ - -#include <sys/types.h> -#include <string.h> - -#define SYSFS_FSTYPE_NAME "sysfs" -#define SYSFS_PROC_MNTS "/proc/mounts" -#define SYSFS_BUS_NAME "bus" -#define SYSFS_CLASS_NAME "class" -#define SYSFS_BLOCK_NAME "block" -#define SYSFS_DEVICES_NAME "devices" -#define SYSFS_DRIVERS_NAME "drivers" -#define SYSFS_MODULE_NAME "module" -#define SYSFS_NAME_ATTRIBUTE "name" -#define SYSFS_MOD_PARM_NAME "parameters" -#define SYSFS_MOD_SECT_NAME "sections" -#define SYSFS_UNKNOWN "unknown" -#define SYSFS_PATH_ENV "SYSFS_PATH" - -#define SYSFS_PATH_MAX 256 -#define SYSFS_NAME_LEN 64 -#define SYSFS_BUS_ID_SIZE 32 - -/* mount path for sysfs, can be overridden by exporting SYSFS_PATH */ -#define SYSFS_MNT_PATH "/sys" - -enum sysfs_attribute_method { - SYSFS_METHOD_SHOW = 0x01, /* attr can be read by user */ - SYSFS_METHOD_STORE = 0x02, /* attr can be changed by user */ -}; - -/* - * NOTE: - * 1. We have the statically allocated "name" as the first element of all - * the structures. This feature is used in the "sorter" function for dlists - * 2. As is the case with attrlist - * 3. As is the case with path - */ -struct sysfs_attribute { - char name[SYSFS_NAME_LEN]; - char path[SYSFS_PATH_MAX]; - char *value; - unsigned short len; /* value length */ - enum sysfs_attribute_method method; /* show and store */ -}; - -#ifdef __cplusplus -extern "C" { -#endif - -/* - * Function Prototypes - */ -extern int sysfs_get_name_from_path(const char *path, char *name, size_t len); - -/* sysfs directory and file access */ -extern void sysfs_close_attribute(struct sysfs_attribute *sysattr); -extern struct sysfs_attribute *sysfs_open_attribute(const char *path); -extern int sysfs_read_attribute(struct sysfs_attribute *sysattr); -extern int sysfs_write_attribute(struct sysfs_attribute *sysattr, - const char *new_value, size_t len); - -#ifdef __cplusplus -} -#endif - -#endif /* _LIBSYSFS_H_ */ diff --git a/mdk-stage1/sysfs/sysfs.h b/mdk-stage1/sysfs/sysfs.h deleted file mode 100644 index 76754a421..000000000 --- a/mdk-stage1/sysfs/sysfs.h +++ /dev/null @@ -1,64 +0,0 @@ -/* - * sysfs.h - * - * Internal Header Definitions for libsysfs - * - * Copyright (C) IBM Corp. 2003-2005 - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - */ -#ifndef _SYSFS_H_ -#define _SYSFS_H_ - -#include <stdio.h> -#include <stdlib.h> -#include <unistd.h> -#include <string.h> -#include <ctype.h> -#include <dirent.h> -#include <sys/stat.h> -#include <fcntl.h> -#include <errno.h> - -#define safestrcpy(to, from) strncpy(to, from, sizeof(to)-1) -#define safestrcat(to, from) strncat(to, from, sizeof(to) - strlen(to)-1) - -#define safestrcpymax(to, from, max) \ -do { \ - to[max-1] = '\0'; \ - strncpy(to, from, max-1); \ -} while (0) - -#define safestrcatmax(to, from, max) \ -do { \ - to[max-1] = '\0'; \ - strncat(to, from, max - strlen(to)-1); \ -} while (0) - -extern struct sysfs_attribute *get_attribute(void *dev, const char *name); -extern struct dlist *read_dir_subdirs(const char *path); -extern struct dlist *read_dir_links(const char *path); -extern struct dlist *get_dev_attributes_list(void *dev); -extern struct dlist *get_attributes_list(struct dlist *alist, const char *path); - -/* Debugging */ -#ifdef DEBUG -#define dprintf(format, arg...) fprintf(stderr, format, ## arg) -#else -#define dprintf(format, arg...) do { } while (0) -#endif - -#endif /* _SYSFS_H_ */ diff --git a/mdk-stage1/sysfs/sysfs_attr.c b/mdk-stage1/sysfs/sysfs_attr.c deleted file mode 100644 index 6d6771188..000000000 --- a/mdk-stage1/sysfs/sysfs_attr.c +++ /dev/null @@ -1,241 +0,0 @@ -/* - * sysfs_dir.c - * - * Directory utility functions for libsysfs - * - * Copyright (C) IBM Corp. 2003-2005 - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - */ -#include "libsysfs.h" -#include "sysfs.h" - -/** - * sysfs_close_attribute: closes and cleans up attribute - * @sysattr: attribute to close. - */ -void sysfs_close_attribute(struct sysfs_attribute *sysattr) -{ - if (sysattr) { - if (sysattr->value) - free(sysattr->value); - free(sysattr); - } -} - -/** - * alloc_attribute: allocates and initializes attribute structure - * returns struct sysfs_attribute with success and NULL with error. - */ -static struct sysfs_attribute *alloc_attribute(void) -{ - return (struct sysfs_attribute *) - calloc(1, sizeof(struct sysfs_attribute)); -} - -/** - * sysfs_open_attribute: creates sysfs_attribute structure - * @path: path to attribute. - * returns sysfs_attribute struct with success and NULL with error. - */ -struct sysfs_attribute *sysfs_open_attribute(const char *path) -{ - struct sysfs_attribute *sysattr = NULL; - struct stat fileinfo; - - if (!path) { - errno = EINVAL; - return NULL; - } - sysattr = alloc_attribute(); - if (!sysattr) { - dprintf("Error allocating attribute at %s\n", path); - return NULL; - } - if (sysfs_get_name_from_path(path, sysattr->name, - SYSFS_NAME_LEN) != 0) { - dprintf("Error retrieving attrib name from path: %s\n", path); - sysfs_close_attribute(sysattr); - return NULL; - } - safestrcpy(sysattr->path, path); - if ((stat(sysattr->path, &fileinfo)) != 0) { - dprintf("Stat failed: No such attribute?\n"); - sysattr->method = 0; - free(sysattr); - sysattr = NULL; - } else { - if (fileinfo.st_mode & S_IRUSR) - sysattr->method |= SYSFS_METHOD_SHOW; - if (fileinfo.st_mode & S_IWUSR) - sysattr->method |= SYSFS_METHOD_STORE; - } - - return sysattr; -} - -/** - * sysfs_read_attribute: reads value from attribute - * @sysattr: attribute to read - * returns 0 with success and -1 with error. - */ -int sysfs_read_attribute(struct sysfs_attribute *sysattr) -{ - char *fbuf = NULL; - char *vbuf = NULL; - ssize_t length = 0; - long pgsize = 0; - int fd; - - if (!sysattr) { - errno = EINVAL; - return -1; - } - if (!(sysattr->method & SYSFS_METHOD_SHOW)) { - dprintf("Show method not supported for attribute %s\n", - sysattr->path); - errno = EACCES; - return -1; - } - pgsize = getpagesize(); - fbuf = (char *)calloc(1, pgsize+1); - if (!fbuf) { - dprintf("calloc failed\n"); - return -1; - } - if ((fd = open(sysattr->path, O_RDONLY)) < 0) { - dprintf("Error reading attribute %s\n", sysattr->path); - free(fbuf); - return -1; - } - length = read(fd, fbuf, pgsize); - if (length < 0) { - dprintf("Error reading from attribute %s\n", sysattr->path); - close(fd); - free(fbuf); - return -1; - } - if (sysattr->len > 0) { - if ((sysattr->len == length) && - (!(strncmp(sysattr->value, fbuf, length)))) { - close(fd); - free(fbuf); - return 0; - } - free(sysattr->value); - } - sysattr->len = length; - close(fd); - vbuf = (char *)realloc(fbuf, length+1); - if (!vbuf) { - dprintf("realloc failed\n"); - free(fbuf); - return -1; - } - sysattr->value = vbuf; - - return 0; -} - -/** - * sysfs_write_attribute: write value to the attribute - * @sysattr: attribute to write - * @new_value: value to write - * @len: length of "new_value" - * returns 0 with success and -1 with error. - */ -int sysfs_write_attribute(struct sysfs_attribute *sysattr, - const char *new_value, size_t len) -{ - int fd; - int length; - - if (!sysattr || !new_value || len == 0) { - errno = EINVAL; - return -1; - } - - if (!(sysattr->method & SYSFS_METHOD_STORE)) { - dprintf ("Store method not supported for attribute %s\n", - sysattr->path); - errno = EACCES; - return -1; - } - if (sysattr->method & SYSFS_METHOD_SHOW) { - /* - * read attribute again to see if we can get an updated value - */ - if ((sysfs_read_attribute(sysattr))) { - dprintf("Error reading attribute\n"); - return -1; - } - if ((strncmp(sysattr->value, new_value, sysattr->len)) == 0 && - (len == sysattr->len)) { - dprintf("Attr %s already has the requested value %s\n", - sysattr->name, new_value); - return 0; - } - } - /* - * open O_WRONLY since some attributes have no "read" but only - * "write" permission - */ - if ((fd = open(sysattr->path, O_WRONLY)) < 0) { - dprintf("Error reading attribute %s\n", sysattr->path); - return -1; - } - - length = write(fd, new_value, len); - if (length < 0) { - dprintf("Error writing to the attribute %s - invalid value?\n", - sysattr->name); - close(fd); - return -1; - } else if ((unsigned int)length != len) { - dprintf("Could not write %zd bytes to attribute %s\n", - len, sysattr->name); - /* - * since we could not write user supplied number of bytes, - * restore the old value if one available - */ - if (sysattr->method & SYSFS_METHOD_SHOW) { - length = write(fd, sysattr->value, sysattr->len); - close(fd); - return -1; - } - } - - /* - * Validate length that has been copied. Alloc appropriate area - * in sysfs_attribute. Verify first if the attribute supports reading - * (show method). If it does not, do not bother - */ - if (sysattr->method & SYSFS_METHOD_SHOW) { - if (length != sysattr->len) { - sysattr->value = (char *)realloc - (sysattr->value, length); - sysattr->len = length; - safestrcpymax(sysattr->value, new_value, length); - } else { - /*"length" of the new value is same as old one */ - safestrcpymax(sysattr->value, new_value, length); - } - } - - close(fd); - return 0; -} - diff --git a/mdk-stage1/sysfs/sysfs_utils.c b/mdk-stage1/sysfs/sysfs_utils.c deleted file mode 100644 index a0354a8f8..000000000 --- a/mdk-stage1/sysfs/sysfs_utils.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * sysfs_utils.c - * - * System utility functions for libsysfs - * - * Copyright (C) IBM Corp. 2003-2005 - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - */ -#include "libsysfs.h" -#include "sysfs.h" - -/** - * sysfs_get_name_from_path: returns last name from a "/" delimited path - * @path: path to get name from - * @name: where to put name - * @len: size of name - */ -int sysfs_get_name_from_path(const char *path, char *name, size_t len) -{ - char tmp[SYSFS_PATH_MAX]; - char *n = NULL; - - if (!path || !name || len == 0) { - errno = EINVAL; - return -1; - } - memset(tmp, 0, SYSFS_PATH_MAX); - safestrcpy(tmp, path); - n = strrchr(tmp, '/'); - if (n == NULL) { - errno = EINVAL; - return -1; - } - if (*(n+1) == '\0') { - *n = '\0'; - n = strrchr(tmp, '/'); - if (n == NULL) { - errno = EINVAL; - return -1; - } - } - n++; - safestrcpymax(name, n, len); - return 0; -} diff --git a/mdk-stage1/thirdparty.c b/mdk-stage1/thirdparty.c index 57f38a2a4..78bbf485a 100644 --- a/mdk-stage1/thirdparty.c +++ b/mdk-stage1/thirdparty.c @@ -244,7 +244,7 @@ static void thirdparty_load_pcitable(const char *modules_location) char pcitable_filename[100]; FILE * f = NULL; - sprintf(pcitable_filename, "%s/pcitable", modules_location); + snprintf(pcitable_filename, sizeof(pcitable_filename), "%s/pcitable", modules_location); if (!(f = fopen(pcitable_filename, "rb"))) { log_message("third_party: no external pcitable found"); return; @@ -333,7 +333,7 @@ static enum return_type thirdparty_autoload_modules(const char *modules_location entry++; } if (!entry || !*entry) { - enum insmod_return ret = my_insmod(module, ANY_DRIVER_TYPE, options, 0); + enum insmod_return ret = my_modprobe(module, ANY_DRIVER_TYPE, options); if (ret != INSMOD_OK) { log_message("\t%s (marfile): failed", module); stg1_error_message("Insmod %s (marfile) failed.", module); diff --git a/mdk-stage1/tools.c b/mdk-stage1/tools.c index 08fab5559..2e27688ea 100644 --- a/mdk-stage1/tools.c +++ b/mdk-stage1/tools.c @@ -148,65 +148,6 @@ enum return_type copy_file(char * from, char * to, void (*callback_func)(int ove } } -enum return_type recursiveRemove(char *file) -{ - struct stat sb; - - if (lstat(file, &sb) != 0) { - log_message("failed to stat %s: %d", file, errno); - return RETURN_ERROR; - } - - /* only descend into subdirectories if device is same as dir */ - if (S_ISDIR(sb.st_mode)) { - char * strBuf = alloca(strlen(file) + 1024); - DIR * dir; - struct dirent * d; - - if (!(dir = opendir(file))) { - log_message("error opening %s: %d", file, errno); - return RETURN_ERROR; - } - while ((d = readdir(dir))) { - if (!strcmp(d->d_name, ".") || !strcmp(d->d_name, "..")) - continue; - - strcpy(strBuf, file); - strcat(strBuf, "/"); - strcat(strBuf, d->d_name); - - if (recursiveRemove(strBuf) != 0) { - closedir(dir); - return RETURN_ERROR; - } - } - closedir(dir); - - if (rmdir(file)) { - log_message("failed to rmdir %s: %d", file, errno); - return RETURN_ERROR; - } - } else { - if (unlink(file) != 0) { - log_message("failed to remove %s: %d", file, errno); - return RETURN_ERROR; - } - } - return RETURN_OK; -} - -enum return_type recursiveRemove_if_it_exists(char *file) -{ - struct stat sb; - - if (lstat(file, &sb) != 0) { - /* if file doesn't exist, simply return OK */ - return RETURN_OK; - } - - return recursiveRemove(file); -} - enum return_type mount_compressed_image(char *compressed_image, char *location_mount) { if (lomount(compressed_image, location_mount, NULL, 1)) { @@ -272,14 +213,7 @@ int try_mount(char * dev, char * location) char device_fullname[50]; snprintf(device_fullname, sizeof(device_fullname), "/dev/%s", dev); - if (my_mount(device_fullname, location, "ext4", 0) == -1 && - my_mount(device_fullname, location, "vfat", 0) == -1 && - my_mount(device_fullname, location, "ntfs", 0) == -1 && - my_mount(device_fullname, location, "reiserfs", 0) == -1 && - my_mount(device_fullname, location, "reiser4", 0) == -1 && - my_mount(device_fullname, location, "jfs", 0) == -1 && - my_mount(device_fullname, location, "xfs", 0) == -1 && - my_mount(device_fullname, location, "iso9660", 0) == -1) { + if (my_mount(device_fullname, location, "auto", 0) == -1) { return 1; } @@ -292,8 +226,8 @@ int get_disks(char *** names, char *** models) char ** ptr; int count = 0; - my_insmod("ide_disk", ANY_DRIVER_TYPE, NULL, 0); - my_insmod("sd_mod", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("ide_disk", ANY_DRIVER_TYPE, NULL); + my_modprobe("sd_mod", ANY_DRIVER_TYPE, NULL); get_medias(DISK, names, models, BUS_ANY); @@ -313,8 +247,8 @@ int get_cdroms(char *** names, char *** models) char ** ptr; int count = 0; - my_insmod("ide_cd_mod", ANY_DRIVER_TYPE, NULL, 0); - my_insmod("sr_mod", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("ide_cd_mod", ANY_DRIVER_TYPE, NULL); + my_modprobe("sr_mod", ANY_DRIVER_TYPE, NULL); get_medias(CDROM, names, models, BUS_ANY); @@ -332,7 +266,7 @@ char * floppy_device(void) { char ** names, ** models; int fd; - my_insmod("floppy", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("floppy", ANY_DRIVER_TYPE, NULL); fd = open("/dev/fd0", O_RDONLY|O_NONBLOCK); if (fd != -1) { char drivtyp[17]; @@ -352,7 +286,7 @@ char * floppy_device(void) close(fd); } log_message("seems that you don't have a regular floppy drive"); - my_insmod("sd_mod", ANY_DRIVER_TYPE, NULL, 0); + my_modprobe("sd_mod", ANY_DRIVER_TYPE, NULL); get_medias(FLOPPY, &names, &models, BUS_ANY); if (names && *names) return asprintf_("/dev/%s", *names); diff --git a/mdk-stage1/tools.h b/mdk-stage1/tools.h index 9954c5e20..87c0c1d49 100644 --- a/mdk-stage1/tools.h +++ b/mdk-stage1/tools.h @@ -24,14 +24,11 @@ #define _TOOLS_H_ #include <stdlib.h> -#include "bootsplash.h" int image_has_stage2(); enum return_type create_IMAGE_LOCATION(char *location_full); int ramdisk_possible(void); enum return_type copy_file(char * from, char * to, void (*callback_func)(int overall)); -enum return_type recursiveRemove(char *file); -enum return_type recursiveRemove_if_it_exists(char *file); enum return_type preload_mount_compressed_fd(int compressed_fd, int image_size, char *image_name, char *location_mount); enum return_type mount_compressed_image(char *compressed_image, char *location_mount); enum return_type mount_compressed_image_may_preload(char *image_name, char *location_mount, int preload); diff --git a/mdk-stage1/pci-resource/update-pci-ids.pl b/mdk-stage1/update-pci-ids.pl index c6653a735..1b084ea80 100755 --- a/mdk-stage1/pci-resource/update-pci-ids.pl +++ b/mdk-stage1/update-pci-ids.pl @@ -6,13 +6,13 @@ use MDK::Common; my %t = ( - network => 'network/main|gigabit|tokenring|wireless|pcmcia', + network => 'network/main|gigabit|pcmcia|virtual|wireless', medias_ide => 'disk/ide', - medias_other => 'disk/scsi|hardware_raid|sata bus/firewire', + medias_other => 'disk/scsi|hardware_raid|sata|virtual bus/firewire', ); foreach my $type (keys %t) { - my @modules = chomp_(`perl ../../kernel/modules.pl pci_modules4stage1 "$t{$type}"`) + my @modules = chomp_(`perl ../kernel/modules.pl pci_modules4stage1 "$t{$type}"`) or die "unable to get PCI modules"; print "#ifndef DISABLE_".uc($type)." diff --git a/mdk-stage1/pcmcia-resource/update-pcmcia-ids.pl b/mdk-stage1/update-pcmcia-ids.pl index 67e0ca9a7..9eb25c66e 100755 --- a/mdk-stage1/pcmcia-resource/update-pcmcia-ids.pl +++ b/mdk-stage1/update-pcmcia-ids.pl @@ -25,7 +25,7 @@ my %t = ( ); foreach my $type (keys %t) { - my @modules = chomp_(`perl ../../kernel/modules.pl pci_modules4stage1 "$t{$type}"`) + my @modules = chomp_(`perl ../kernel/modules.pl pci_modules4stage1 "$t{$type}"`) or die "unable to get PCMCIA modules"; print "#ifndef DISABLE_".uc($type)." diff --git a/mdk-stage1/usb-resource/update-usb-ids.pl b/mdk-stage1/update-usb-ids.pl index 9d6ca1cfc..1ea45f9df 100755 --- a/mdk-stage1/usb-resource/update-usb-ids.pl +++ b/mdk-stage1/update-usb-ids.pl @@ -4,7 +4,7 @@ use lib '../kernel'; use strict; use MDK::Common; -my @modules = chomp_(`perl ../../kernel/modules.pl pci_modules4stage1 "bus/usb"`) +my @modules = chomp_(`perl ../kernel/modules.pl pci_modules4stage1 "bus/usb"`) or die "unable to get USB controller modules"; print "char *usb_controller_modules[] = { "; @@ -13,7 +13,7 @@ print "}; unsigned int usb_controller_modules_len = sizeof(usb_controller_modules) / sizeof(char *); "; -@modules = chomp_(`perl ../../kernel/modules.pl pci_modules4stage1 "network/usb disk/usb"`) +@modules = chomp_(`perl ../kernel/modules.pl pci_modules4stage1 "network/usb disk/usb"`) or die "unable to get USB modules"; print "char *usb_modules[] = { diff --git a/mdk-stage1/url.c b/mdk-stage1/url.c index 3d2846649..14f1e25d6 100644 --- a/mdk-stage1/url.c +++ b/mdk-stage1/url.c @@ -398,9 +398,10 @@ char *str_ftp_error(int error) } -static int _http_download_file(char * hostname, char * remotename, int * size, char * proxyprotocol, char * proxyname, char * proxyport, int recursion) +static int _http_download_file(char * hostport, char * remotename, int * size, char * proxyprotocol, char * proxyname, char * proxyport, int recursion) { char * buf; + char * hostname = strdup(hostport); char headers[4096]; char * nextChar = headers; int statusCode; @@ -418,8 +419,15 @@ static int _http_download_file(char * hostname, char * remotename, int * size, c http_server_name = proxyname; http_server_port = atoi(proxyport); } else { - http_server_name = hostname; - http_server_port = 80; + char *port = strchr(hostname, ':'); + if (port) { + *port = '\0'; + http_server_name = hostname; + http_server_port = atoi(++port); + } else { + http_server_name = hostname; + http_server_port = 80; + } } log_message("HTTP: connecting to server %s:%i (%s)", @@ -430,6 +438,7 @@ static int _http_download_file(char * hostname, char * remotename, int * size, c sock = socket(AF_INET, SOCK_STREAM, IPPROTO_IP); if (sock < 0) { + free(hostname); return FTPERR_FAILED_CONNECT; } @@ -439,6 +448,7 @@ static int _http_download_file(char * hostname, char * remotename, int * size, c if (connect(sock, (struct sockaddr *) &destPort, sizeof(destPort))) { close(sock); + free(hostname); return FTPERR_FAILED_CONNECT; } @@ -446,6 +456,7 @@ static int _http_download_file(char * hostname, char * remotename, int * size, c : asprintf_("GET %s HTTP/1.0\r\nHost: %s\r\n\r\n", remotename, hostname); write(sock, buf, strlen(buf)); + free(hostname); /* This is fun; read the response a character at a time until we: diff --git a/mdk-stage1/usb-resource/Makefile b/mdk-stage1/usb-resource/Makefile deleted file mode 100644 index e21832a3f..000000000 --- a/mdk-stage1/usb-resource/Makefile +++ /dev/null @@ -1,25 +0,0 @@ - #****************************************************************************** - # - # $Id: Makefile 253685 2009-03-06 14:27:29Z tv $ - # - # Guillaume Cottenceau (gc) - # - # Copyright 2000 Mandriva - # - # This software may be freely redistributed under the terms of the GNU - # public license. - # - # You should have received a copy of the GNU General Public License - # along with this program; if not, write to the Free Software - # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - # - #***************************************************************************** - - -all: usb-ids.h - -usb-ids.h: /usr/share/ldetect-lst/usbtable.gz update-usb-ids.pl - perl update-usb-ids.pl > $@ || rm -f $@ - -clean: - rm -f usb-ids.h diff --git a/mdk-stage1/utils.c b/mdk-stage1/utils.c index af5ee9af3..6ad3a8f6f 100644 --- a/mdk-stage1/utils.c +++ b/mdk-stage1/utils.c @@ -21,6 +21,7 @@ #include <unistd.h> #include <ctype.h> #include <dirent.h> +#include <sys/sysinfo.h> #include <sys/utsname.h> #include "utils.h" @@ -83,9 +84,12 @@ int line_counts(const char * buf) { int total_memory(void) { int value; - - /* drakx powered: use /proc/kcore and rounds every 4 Mbytes */ - value = 4 * ((int)((float)file_size("/proc/kcore") / 1024 / 1024 / 4 + 0.5)); + struct sysinfo sys_info; + if (sysinfo(&sys_info) < 0) { + log_perror("sysinfo"); + return 0; + } + value = sys_info.totalram * sys_info.mem_unit / 1024 / 1024; log_message("Total Memory: %d Mbytes", value); return value; @@ -162,14 +166,6 @@ char * asprintf_(const char *msg, ...) return strdup(""); } -int scall_(int retval, char * msg, char * file, int line) -{ - char tmp[5000]; - sprintf(tmp, "%s(%s:%d) failed", msg, file, line); - if (retval) - log_perror(tmp); - return retval; -} void lowercase(char *s) { diff --git a/mdk-stage1/utils.h b/mdk-stage1/utils.h index d42c52d06..b8a77b0ad 100644 --- a/mdk-stage1/utils.h +++ b/mdk-stage1/utils.h @@ -27,9 +27,7 @@ void add_to_env(char * name, char * value); char ** list_directory(char * direct); int string_array_length(char ** a); char * asprintf_(const char *msg, ...); -int scall_(int retval, char * msg, char * file, int line); char *my_dirname(char *path); -#define scall(retval, msg) scall_(retval, msg, __FILE__, __LINE__) void lowercase(char *s); #define ptr_begins_static_str(pointer,static_str) (!strncmp(pointer,static_str,sizeof(static_str)-1)) diff --git a/mdk-stage1/wireless.c b/mdk-stage1/wireless.c index c9e363048..2fde04f84 100644 --- a/mdk-stage1/wireless.c +++ b/mdk-stage1/wireless.c @@ -1,7 +1,9 @@ /* * Olivier Blin (oblin) + * Martin Whitaker (martinw) * * Copyright 2005 Mandriva + * Copyright 2020 Mageia * * This software may be freely redistributed under the terms of the GNU * public license. @@ -16,7 +18,9 @@ #include <sys/types.h> #include <sys/socket.h> #include <errno.h> +#include <signal.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <unistd.h> #include <linux/types.h> @@ -29,11 +33,10 @@ #include "utils.h" #include "wireless.h" -static int wireless_ioctl(int socket, const char *ifname, int request, struct iwreq *wrq); -static int wireless_set_mode_managed(int socket, const char *ifname); -static int wireless_disable_key(int socket, const char *ifname); -static int wireless_set_restricted_key(int socket, const char *ifname, const char *key); -static int wireless_set_essid(int socket, const char *ifname, const char *essid); +#define WPA_SUPPLICANT_CONF "/etc/wpa_supplicant.conf" +#define WPA_SUPPLICANT_CTRL "/var/run/wpa_supplicant" +#define WPA_SUPPLICANT_LOG "/var/log/wpa_supplicant.log" +#define WPA_SUPPLICANT_PID "/var/run/wpa_supplicant.pid" int wireless_open_socket() { @@ -57,104 +60,101 @@ int wireless_is_aware(int socket, const char *ifname) return wireless_ioctl(socket, ifname, SIOCGIWNAME, &wrq) == 0; } -static int wireless_set_mode_managed(int socket, const char *ifname) -{ - struct iwreq wrq; - - wrq.u.mode = IW_MODE_INFRA; /* managed */ - - return wireless_ioctl(socket, ifname, SIOCSIWMODE, &wrq) == 0; -} - -static int wireless_set_essid(int socket, const char *ifname, const char *essid) -{ - struct iwreq wrq; - - wrq.u.essid.flags = 1; - wrq.u.essid.pointer = (void *) essid; - wrq.u.essid.length = strlen(essid) + 1; - - return wireless_ioctl(socket, ifname, SIOCSIWESSID, &wrq) == 0; -} - -static int wireless_disable_key(int socket, const char *ifname) -{ - struct iwreq wrq; - - wrq.u.data.flags = IW_ENCODE_DISABLED; - wrq.u.data.pointer = NULL; - wrq.u.data.length = 0; - - return wireless_ioctl(socket, ifname, SIOCSIWENCODE, &wrq) == 0; -} - -static int wireless_set_restricted_key(int socket, const char *ifname, const char *key) -{ - struct iwreq wrq; - char real_key[IW_ENCODING_TOKEN_MAX]; - int key_len = 0; - unsigned int tmp; - - while (sscanf(key + 2*key_len, "%2X", &tmp) == 1) - real_key[key_len++] = (char) tmp; - - wrq.u.data.flags = IW_ENCODE_RESTRICTED; - wrq.u.data.pointer = (char *) real_key; - wrq.u.data.length = key_len; - - return wireless_ioctl(socket, ifname, SIOCSIWENCODE, &wrq) == 0; -} - enum return_type configure_wireless(const char *ifname) { enum return_type results; - char * questions[] = { "ESSID", "WEP key", NULL }; - char * questions_auto[] = { "essid", "wep_key" }; + char * security[] = { "No security", "WEP", "WPA/WPA2 Personal", NULL }; + char * security_auto[] = { "none", "wep", "wpa_psk", NULL }; + char * choice = NULL; + char * message = NULL; + char * questions[] = { "ESSID", "", NULL }; + char * questions_auto[] = { "essid", "" }; + char * key_mgmt = NULL; static char ** answers = NULL; - int wsock = wireless_open_socket(); + FILE * fd; + char cmd[256]; + int status; + int wsock = wireless_open_socket(); if (!wireless_is_aware(wsock, ifname)) { log_message("interface %s doesn't support wireless", ifname); wireless_close_socket(wsock); return RETURN_OK; } + wireless_close_socket(wsock); - results = ask_from_entries_auto("Please enter your wireless settings. " - "The ESSID is your wireless network identifier. " - "The WEP key must be entered in hexadecimal, without any separator.", - questions, &answers, 32, questions_auto, NULL); + results = ask_from_list_auto("Please select your wireless security mode.", + security, &choice, "wireless_security", security_auto); if (results != RETURN_OK) { - wireless_close_socket(wsock); return RETURN_BACK; } - if (!wireless_set_mode_managed(wsock, ifname)) { - stg1_error_message("unable to set mode Managed on device \"%s\": %s", ifname, strerror(errno)); - wireless_close_socket(wsock); - return RETURN_ERROR; + if (streq(choice, security[2])) { + message = "Please enter your wireless settings. " + "The ESSID is your wireless network identifier. " + "The passphrase must be a string of between 8 and 63 ASCII characters."; + questions[1] = "passphrase"; + questions_auto[1] = "wpa_psk"; + key_mgmt = "WPA-PSK"; + } else if (streq(choice, security[1])) { + message = "Please enter your wireless settings. " + "The ESSID is your wireless network identifier. " + "The WEP key must be either a string of 10 or 26 hexadecimal digits, without any separators, " + "or a string of 5 or 13 ASCII characters enclosed in double quote marks (e.g. \"12345\")."; + questions[1] = "WEP key"; + questions_auto[1] = "wep_key"; + key_mgmt = "NONE"; + } else { + message = "Please enter your wireless settings. " + "The ESSID is your wireless network identifier."; + questions[1] = NULL; + questions_auto[1] = NULL; + key_mgmt = "NONE"; + } + results = ask_from_entries_auto(message, questions, &answers, 32, questions_auto, NULL); + if (results != RETURN_OK) { + return RETURN_BACK; } - if (answers[1] && !streq(answers[1], "")) { - log_message("setting WEP key \"%s\" on device \"%s\"", answers[1], ifname); - if (!wireless_set_restricted_key(wsock, ifname, answers[1])) { - stg1_error_message("unable to set WEP key \"%s\" on device \"%s\": %s", answers[1], ifname, strerror(errno)); - return RETURN_ERROR; - } - } else { - log_message("disabling WEP key on device \"%s\"", ifname); - if (!wireless_disable_key(wsock, ifname)) { - stg1_error_message("unable to disable WEP key on device \"%s\": %s", ifname, strerror(errno)); - return RETURN_ERROR; + fd = fopen(WPA_SUPPLICANT_PID, "r"); + if (fd) { + unsigned pid = 0; + unsigned count = fscanf(fd, "%u", &pid); + fclose(fd); + if (count == 1 && pid > 1) { + log_message("terminating wpa_supplicant (pid %u)", pid); + kill(pid, SIGQUIT); + sleep(1); } } - /* most devices perform discovery when ESSID is set, it needs to be last */ - log_message("setting ESSID \"%s\" on device \"%s\"", answers[0], ifname); - if (!wireless_set_essid(wsock, ifname, answers[0])) { - stg1_error_message("unable to set ESSID \"%s\" on device \"%s\": %s", answers[0], ifname, strerror(errno)); + fd = fopen(WPA_SUPPLICANT_CONF, "w"); + if (fd == NULL) { + stg1_error_message("unable to create " WPA_SUPPLICANT_CONF ": %s", strerror(errno)); + return RETURN_ERROR; + } + fprintf(fd, "ctrl_interface=" WPA_SUPPLICANT_CTRL "\n"); + fprintf(fd, "ap_scan=1\n"); + fprintf(fd, "network={\n"); + fprintf(fd, " key_mgmt=%s\n", key_mgmt); + fprintf(fd, " scan_ssid=1\n"); + fprintf(fd, " ssid=\"%s\"\n", answers[0]); + if (streq(choice, security[2])) { + fprintf(fd, " psk=\"%s\"\n", answers[1]); + } else if (streq(choice, security[1])) { + fprintf(fd, " wep_key0=%s\n", answers[1]); + } + fprintf(fd, "}\n"); + fclose(fd); + + snprintf(cmd, sizeof(cmd), "/usr/sbin/wpa_supplicant -D nl80211,wext -B -i %s -c %s -f %s -P %s", + ifname, WPA_SUPPLICANT_CONF, WPA_SUPPLICANT_LOG, WPA_SUPPLICANT_PID); + log_message("running %s", cmd); + status = system(cmd); + if (status != 0) { + stg1_error_message("unable to start wpa_supplicant daemon for interface \"%s\": %d", ifname, status); return RETURN_ERROR; } - wireless_close_socket(wsock); return RETURN_OK; } |