mirror of
https://github.com/Interlisp/maiko.git
synced 2026-03-16 14:57:20 +00:00
Compare commits
1 Commits
lmm-hcfile
...
fgh_fix-21
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
959f77402f |
13
.github/workflows/Dockerfile_maiko
vendored
13
.github/workflows/Dockerfile_maiko
vendored
@@ -18,17 +18,8 @@ COPY . ${INSTALL_LOCATION}
|
||||
# Build maiko
|
||||
RUN cd ${INSTALL_LOCATION}/bin \
|
||||
&& ./makeright x cleanup \
|
||||
&& ./makeright x \
|
||||
&& ./makeright x
|
||||
RUN cd ${INSTALL_LOCATION}/bin \
|
||||
&& if [ "$(./machinetype)" = "x86_64" ]; then \
|
||||
./makeright init; \
|
||||
fi
|
||||
# Build specially for WSL1 by "fooling" a linux build
|
||||
RUN cd ${INSTALL_LOCATION}/bin \
|
||||
&& arch="$(./machinetype)" \
|
||||
&& if [ "$arch" = "x86_64" ] || [ "$arch" = "aarch64" ]; then \
|
||||
export LDEARCH="${arch}-microsoft-wsl1" \
|
||||
&& ./makeright x cleanup \
|
||||
&& ./makeright x \
|
||||
&& ./makeright init \
|
||||
; \
|
||||
fi
|
||||
|
||||
10
.github/workflows/buildRelease.yml
vendored
10
.github/workflows/buildRelease.yml
vendored
@@ -224,13 +224,7 @@ jobs:
|
||||
RELEASE_TAG: ${{ steps.tag.outputs.release_tag }}
|
||||
run: |
|
||||
mkdir -p /tmp/release_tars
|
||||
for OSARCH in \
|
||||
"linux.x86_64:linux_amd64" \
|
||||
"linux.aarch64:linux_arm64" \
|
||||
"linux.armv7l:linux_arm_v7" \
|
||||
"wsl1.x86_64:linux_amd64" \
|
||||
"wsl1.aarch64:linux_arm64" \
|
||||
; \
|
||||
for OSARCH in "linux.x86_64:linux_amd64" "linux.aarch64:linux_arm64" "linux.armv7l:linux_arm_v7" ; \
|
||||
do \
|
||||
pushd /tmp/docker_images/${OSARCH##*:}/usr/local/interlisp >/dev/null ; \
|
||||
/usr/bin/tar -c -z \
|
||||
@@ -252,8 +246,6 @@ jobs:
|
||||
artifacts:
|
||||
/tmp/release_tars/${{ steps.tag.outputs.release_tag }}-linux.x86_64.tgz,
|
||||
/tmp/release_tars/${{ steps.tag.outputs.release_tag }}-linux.aarch64.tgz,
|
||||
/tmp/release_tars/${{ steps.tag.outputs.release_tag }}-wsl1.x86_64.tgz,
|
||||
/tmp/release_tars/${{ steps.tag.outputs.release_tag }}-wsl1.aarch64.tgz,
|
||||
/tmp/release_tars/${{ steps.tag.outputs.release_tag }}-linux.armv7l.tgz
|
||||
tag: ${{ steps.tag.outputs.release_tag }}
|
||||
draft: ${{ needs.inputs.outputs.draft }}
|
||||
|
||||
1
.skip
1
.skip
@@ -1 +0,0 @@
|
||||
this file is here to prevent HCFILES process from descending into maiko repository
|
||||
@@ -364,6 +364,7 @@ SET(MAIKO_HDRS
|
||||
inc/lispemul.h
|
||||
inc/lispmap.h
|
||||
inc/lispver1.h
|
||||
inc/lispver2.h
|
||||
inc/llcolordefs.h
|
||||
inc/lldsp.h
|
||||
inc/llstkdefs.h
|
||||
|
||||
@@ -37,7 +37,6 @@ $ ./makeright x
|
||||
|
||||
* The build will (attempt to) detect the OS-type and cpu-type. It will build binaries `lde` and `ldex` in `../`_`ostype.cputype`_ (with .o files in `../`_`ostype.cputype-x`_. For example, Linux on a 64-bit x86 will use `linux.x86_64`, while macOS 11 on a (new M1) Mac will use `darwin.aarch64`.
|
||||
* If you prefer `gcc` over `clang`, you will need to edit the makefile fragment for your configuration (`makefile-ostype.cputype-x`) and comment out the line (with a #) that defines `CC` as `clang` and uncomment the line (delete the #) for the line that defines `CC` as `gcc`.
|
||||
* If you want to do your own loadups to construct sysout files (see [the Medley repository](https://github.com/Interlisp/medley) for details), you also need the `ldeinit` binary, which you can build using `./makeright init`.
|
||||
|
||||
### Building with CMake
|
||||
We provide a `CMakeLists.txt` which provides mostly matching build capabilities to the `make` setup.
|
||||
|
||||
@@ -18,7 +18,7 @@ SRCFILES = conspage.c gcoflow.c shift.c dbgtool.c gcr.c gcrcell.c llstk.
|
||||
OFILES = conspage.obj gcoflow.obj shift.obj dbgtool.obj gcr.obj gcrcell.obj llstk.obj gcscan.obj loopsops.obj storage.obj allocmds.obj dir.obj gvar2.obj lowlev1.obj subr.obj arithops.obj lowlev2.obj subr0374.obj doscomm.obj hardrtn.obj lsthandl.obj sxhash.obj draw.obj main.obj testtool.obj array.obj dsk.obj inet.obj misc7.obj timer.obj array2.obj dspif.obj initdsp.obj miscn.obj typeof.obj array3.obj initkbd.obj ubf1.obj array4.obj dspsubrs.obj initsout.obj mkatom.obj ubf2.obj array5.obj eqf.obj intcall.obj mkcell.obj ubf3.obj array6.obj ether.obj ufn.obj atom.obj findkey.obj kbdsubrs.obj mouseif.obj ufs.obj bbtsub.obj foreign.obj keyevent.obj unixcomm.obj bin.obj fp.obj binds.obj fvar.obj mvs.obj unwind.obj bitblt.obj gc.obj uraid.obj blt.obj gc2.obj kprint.obj osmsg.obj usrsubr.obj byteswap.obj gcarray.obj perrno.obj uutils.obj carcdr.obj asmbbt.obj gccode.obj vars3.obj gcfinal.obj ldsout.obj return.obj vmemsave.obj chardev.obj gchtfind.obj lineblt8.obj rpc.obj xc.obj common.obj gcmain3.obj lisp2c.obj rplcons.obj z2.obj vdate.obj $(COLORFILES) $(ARCHFILES) $(LPFILES)
|
||||
|
||||
|
||||
HFILES = address.h adr68k.h arithopsdefs.h arith.h cell.h dbprint.h display.h dspif.h ifpage.h iopage.h lispemul.h lispmap.h lsptypes.h miscstat.h lspglob.h array.h bb.h bbtmacro.h debug.h devconf.h dspdata.h fast_dsp.h gcdata.h initatms.h inlinec.h keyboard.h lispver1.h lldsp.h locfile.h medleyfp.h mouseif.h my.h opcodes.h osmsgprint.h pilotbbt.h print.h retmacro.h stack.h stream.h subrs.h timeout.h tos1defs.h tosfns.h tosret.h xdefs.h xbitmaps.h xkeymap.h
|
||||
HFILES = address.h adr68k.h arithopsdefs.h arith.h cell.h dbprint.h display.h dspif.h ifpage.h iopage.h lispemul.h lispmap.h lsptypes.h miscstat.h lspglob.h array.h bb.h bbtmacro.h debug.h devconf.h dspdata.h fast_dsp.h gcdata.h initatms.h inlinec.h keyboard.h lispver1.h lispver2.h lldsp.h locfile.h medleyfp.h mouseif.h my.h opcodes.h osmsgprint.h pilotbbt.h print.h retmacro.h stack.h stream.h subrs.h timeout.h tos1defs.h tosfns.h tosret.h xdefs.h xbitmaps.h xkeymap.h
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1,29 +0,0 @@
|
||||
# Options for Windows System for Linux v1, aarch64 processor, X windows, for INIT processing
|
||||
|
||||
CC = gcc $(GCC_CFLAGS)
|
||||
#CC = clang $(CLANG_CFLAGS)
|
||||
|
||||
XFILES = $(OBJECTDIR)xmkicon.o \
|
||||
$(OBJECTDIR)xbbt.o \
|
||||
$(OBJECTDIR)dspif.o \
|
||||
$(OBJECTDIR)xinit.o \
|
||||
$(OBJECTDIR)xscroll.o \
|
||||
$(OBJECTDIR)xcursor.o \
|
||||
$(OBJECTDIR)xlspwin.o \
|
||||
$(OBJECTDIR)xrdopt.o \
|
||||
$(OBJECTDIR)xwinman.o
|
||||
|
||||
|
||||
XFLAGS = -DXWINDOW
|
||||
|
||||
# OPTFLAGS is normally -O2, for INIT we want unoptimized in case we need to debug it
|
||||
OPTFLAGS = -O0 -g
|
||||
DEBUGFLAGS =
|
||||
DFLAGS = $(DEBUGFLAGS) $(XFLAGS) -DRELEASE=$(RELEASE) -DNOVERSION -DINIT -D__wsl1__
|
||||
|
||||
LDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
LDELDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
|
||||
OBJECTDIR = ../$(RELEASENAME)/
|
||||
|
||||
default : ../$(OSARCHNAME)/ldeinit
|
||||
@@ -1,29 +0,0 @@
|
||||
# Options for Windows System for Linux v1, Intel x86_64 processor, X windows, for INIT processing
|
||||
|
||||
CC = gcc $(GCC_CFLAGS)
|
||||
#CC = clang $(CLANG_CFLAGS)
|
||||
|
||||
XFILES = $(OBJECTDIR)xmkicon.o \
|
||||
$(OBJECTDIR)xbbt.o \
|
||||
$(OBJECTDIR)dspif.o \
|
||||
$(OBJECTDIR)xinit.o \
|
||||
$(OBJECTDIR)xscroll.o \
|
||||
$(OBJECTDIR)xcursor.o \
|
||||
$(OBJECTDIR)xlspwin.o \
|
||||
$(OBJECTDIR)xrdopt.o \
|
||||
$(OBJECTDIR)xwinman.o
|
||||
|
||||
|
||||
XFLAGS = -DXWINDOW
|
||||
|
||||
# OPTFLAGS is normally -O2, for INIT we want unoptimized in case we need to debug it
|
||||
OPTFLAGS = -O0 -g
|
||||
DEBUGFLAGS =
|
||||
DFLAGS = $(DEBUGFLAGS) $(XFLAGS) -DRELEASE=$(RELEASE) -DNOVERSION -DINIT -D__wsl1__
|
||||
|
||||
LDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
LDELDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
|
||||
OBJECTDIR = ../$(RELEASENAME)/
|
||||
|
||||
default : ../$(OSARCHNAME)/ldeinit
|
||||
@@ -340,7 +340,7 @@ $(OBJECTDIR)car-cdr.o: $(SRCDIR)car-cdr.c $(REQUIRED-INCS) \
|
||||
$(OBJECTDIR)chardev.o: $(SRCDIR)chardev.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
|
||||
$(INCDIR)adr68k.h $(INCDIR)lsptypes.h $(INCDIR)arith.h $(INCDIR)timeout.h \
|
||||
$(INCDIR)locfile.h $(INCDIR)dbprint.h \
|
||||
$(INCDIR)locfile.h $(INCDIR)lispver2.h $(INCDIR)dbprint.h \
|
||||
$(INCDIR)chardevdefs.h $(INCDIR)byteswapdefs.h $(INCDIR)commondefs.h \
|
||||
$(INCDIR)perrnodefs.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)chardev.c -o $(OBJECTDIR)chardev.o
|
||||
@@ -505,7 +505,7 @@ $(OBJECTDIR)dsk.o: $(SRCDIR)dsk.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
|
||||
$(INCDIR)adr68k.h $(INCDIR)lsptypes.h $(INCDIR)lspglob.h $(INCDIR)ifpage.h \
|
||||
$(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)arith.h $(INCDIR)stream.h \
|
||||
$(INCDIR)timeout.h $(INCDIR)locfile.h \
|
||||
$(INCDIR)timeout.h $(INCDIR)locfile.h $(INCDIR)lispver2.h \
|
||||
$(INCDIR)dbprint.h $(INCDIR)dskdefs.h $(INCDIR)byteswapdefs.h \
|
||||
$(INCDIR)car-cdrdefs.h $(INCDIR)cell.h $(INCDIR)commondefs.h \
|
||||
$(INCDIR)ufsdefs.h
|
||||
@@ -515,7 +515,7 @@ $(OBJECTDIR)ufs.o: $(SRCDIR)ufs.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
|
||||
$(INCDIR)adr68k.h $(INCDIR)lsptypes.h $(INCDIR)lspglob.h $(INCDIR)ifpage.h \
|
||||
$(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)arith.h $(INCDIR)stream.h \
|
||||
$(INCDIR)timeout.h $(INCDIR)locfile.h $(INCDIR)dbprint.h \
|
||||
$(INCDIR)timeout.h $(INCDIR)locfile.h $(INCDIR)lispver2.h $(INCDIR)dbprint.h \
|
||||
$(INCDIR)ufsdefs.h $(INCDIR)commondefs.h $(INCDIR)dskdefs.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)ufs.c -o $(OBJECTDIR)ufs.o
|
||||
|
||||
@@ -523,7 +523,7 @@ $(OBJECTDIR)dir.o: $(SRCDIR)dir.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
|
||||
$(INCDIR)adr68k.h $(INCDIR)lsptypes.h $(INCDIR)arith.h $(INCDIR)lspglob.h \
|
||||
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)timeout.h \
|
||||
$(INCDIR)locfile.h $(INCDIR)dirdefs.h \
|
||||
$(INCDIR)locfile.h $(INCDIR)lispver2.h $(INCDIR)dirdefs.h \
|
||||
$(INCDIR)commondefs.h $(INCDIR)dskdefs.h $(INCDIR)ufsdefs.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)dir.c -o $(OBJECTDIR)dir.o
|
||||
|
||||
@@ -640,7 +640,7 @@ $(OBJECTDIR)inet.o: $(SRCDIR)inet.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
|
||||
$(INCDIR)lsptypes.h $(INCDIR)arith.h $(INCDIR)emlglob.h $(INCDIR)lspglob.h \
|
||||
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)adr68k.h \
|
||||
$(INCDIR)dbprint.h $(INCDIR)locfile.h \
|
||||
$(INCDIR)dbprint.h $(INCDIR)locfile.h $(INCDIR)lispver2.h \
|
||||
$(INCDIR)inetdefs.h $(INCDIR)byteswapdefs.h $(INCDIR)commondefs.h \
|
||||
$(INCDIR)mkcelldefs.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)inet.c -o $(OBJECTDIR)inet.o
|
||||
@@ -674,7 +674,7 @@ $(OBJECTDIR)initsout.o: $(SRCDIR)initsout.c $(REQUIRED-INCS) \
|
||||
|
||||
$(OBJECTDIR)kbdsubrs.o: $(SRCDIR)kbdsubrs.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)kbdsubrsdefs.h \
|
||||
$(INCDIR)commondefs.h $(INCDIR)xwinmandefs.h \
|
||||
$(INCDIR)commondefs.h $(INCDIR)lisp2cdefs.h $(INCDIR)xwinmandefs.h \
|
||||
$(INCDIR)devif.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)kbdsubrs.c -o $(OBJECTDIR)kbdsubrs.o
|
||||
|
||||
@@ -758,7 +758,7 @@ $(OBJECTDIR)osmsg.o: $(SRCDIR)osmsg.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
|
||||
$(INCDIR)adr68k.h $(INCDIR)lsptypes.h $(INCDIR)arith.h $(INCDIR)stream.h \
|
||||
$(INCDIR)lspglob.h $(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h \
|
||||
$(INCDIR)timeout.h $(INCDIR)locfile.h $(INCDIR)osmsgprint.h \
|
||||
$(INCDIR)timeout.h $(INCDIR)locfile.h $(INCDIR)lispver2.h $(INCDIR)osmsgprint.h \
|
||||
$(INCDIR)dbprint.h $(INCDIR)commondefs.h $(INCDIR)osmsgdefs.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)osmsg.c -o $(OBJECTDIR)osmsg.o
|
||||
|
||||
@@ -865,7 +865,7 @@ $(OBJECTDIR)unixcomm.o: $(SRCDIR)unixcomm.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lspglob.h $(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h \
|
||||
$(INCDIR)cell.h $(INCDIR)stack.h $(INCDIR)arith.h $(INCDIR)dbprint.h \
|
||||
$(INCDIR)timeout.h $(INCDIR)unixcommdefs.h $(INCDIR)byteswapdefs.h \
|
||||
$(INCDIR)commondefs.h $(INCDIR)locfile.h
|
||||
$(INCDIR)commondefs.h $(INCDIR)locfile.h $(INCDIR)lispver2.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)unixcomm.c -o $(OBJECTDIR)unixcomm.o
|
||||
|
||||
$(OBJECTDIR)unixfork.o: $(SRCDIR)unixfork.c $(REQUIRED-INCS) \
|
||||
@@ -888,7 +888,7 @@ $(OBJECTDIR)rpc.o: $(SRCDIR)rpc.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
|
||||
$(INCDIR)lsptypes.h $(INCDIR)lspglob.h $(INCDIR)ifpage.h $(INCDIR)iopage.h \
|
||||
$(INCDIR)miscstat.h $(INCDIR)emlglob.h $(INCDIR)adr68k.h $(INCDIR)arith.h \
|
||||
$(INCDIR)locfile.h $(INCDIR)rpcdefs.h \
|
||||
$(INCDIR)locfile.h $(INCDIR)lispver2.h $(INCDIR)rpcdefs.h \
|
||||
$(INCDIR)commondefs.h
|
||||
$(CC) $(RFLAGS) $(SRCDIR)rpc.c -o $(OBJECTDIR)rpc.o
|
||||
|
||||
@@ -909,7 +909,7 @@ $(OBJECTDIR)vmemsave.o: $(SRCDIR)vmemsave.c $(REQUIRED-INCS) \
|
||||
$(INCDIR)lispemul.h \
|
||||
$(INCDIR)lispmap.h $(INCDIR)lspglob.h $(INCDIR)ifpage.h $(INCDIR)iopage.h \
|
||||
$(INCDIR)miscstat.h $(INCDIR)timeout.h $(INCDIR)adr68k.h \
|
||||
$(INCDIR)lsptypes.h $(INCDIR)locfile.h $(INCDIR)dbprint.h \
|
||||
$(INCDIR)lsptypes.h $(INCDIR)locfile.h $(INCDIR)lispver2.h $(INCDIR)dbprint.h \
|
||||
$(INCDIR)devif.h $(INCDIR)vmemsavedefs.h $(INCDIR)byteswapdefs.h $(INCDIR)commondefs.h \
|
||||
$(INCDIR)dskdefs.h $(INCDIR)initkbddefs.h $(INCDIR)perrnodefs.h \
|
||||
$(INCDIR)ufsdefs.h
|
||||
|
||||
@@ -1,25 +0,0 @@
|
||||
# Options for Windows System for Linux v1, ARM64 and SDL
|
||||
|
||||
CC = gcc $(GCC_CFLAGS)
|
||||
#CC = clang $(CLANG_CFLAGS)
|
||||
|
||||
XFILES = $(OBJECTDIR)sdl.o
|
||||
|
||||
#
|
||||
# For SDL version 2
|
||||
# -DSDL=2 in SDLFLAGS and -lSDL2 in LDFLAGS
|
||||
# For SDL version 3
|
||||
# -DSDL=3 in SDLFLAGS and -lSDL3 in LDFLAGS
|
||||
#
|
||||
SDLFLAGS = -DSDL=2
|
||||
|
||||
# OPTFLAGS is normally -O2.
|
||||
OPTFLAGS = -O2 -g3
|
||||
DFLAGS = $(SDLFLAGS) -DRELEASE=$(RELEASE) -D__wsl1__
|
||||
|
||||
LDFLAGS = -lSDL2 -lm
|
||||
LDELDFLAGS =
|
||||
|
||||
OBJECTDIR = ../$(RELEASENAME)/
|
||||
|
||||
default : ../$(OSARCHNAME)/lde ../$(OSARCHNAME)/ldesdl
|
||||
@@ -1,27 +0,0 @@
|
||||
# Options for Windows System for Linux v1, aarch64 and X-Window
|
||||
|
||||
CC = gcc $(GCC_CFLAGS)
|
||||
#CC = clang $(CLANG_CFLAGS)
|
||||
|
||||
XFILES = $(OBJECTDIR)xmkicon.o \
|
||||
$(OBJECTDIR)xbbt.o \
|
||||
$(OBJECTDIR)dspif.o \
|
||||
$(OBJECTDIR)xinit.o \
|
||||
$(OBJECTDIR)xscroll.o \
|
||||
$(OBJECTDIR)xcursor.o \
|
||||
$(OBJECTDIR)xlspwin.o \
|
||||
$(OBJECTDIR)xrdopt.o \
|
||||
$(OBJECTDIR)xwinman.o
|
||||
|
||||
XFLAGS = -DXWINDOW
|
||||
|
||||
# OPTFLAGS is normally -O2.
|
||||
OPTFLAGS = -O2 -g3
|
||||
DFLAGS = $(XFLAGS) -DRELEASE=$(RELEASE) -D__wsl1__
|
||||
|
||||
LDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
LDELDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
|
||||
OBJECTDIR = ../$(RELEASENAME)/
|
||||
|
||||
default : ../$(OSARCHNAME)/lde ../$(OSARCHNAME)/ldex
|
||||
@@ -1,25 +0,0 @@
|
||||
# Options for Windows System for Linux v1, Intel x86_64 and SDL
|
||||
|
||||
CC = gcc -m64 $(GCC_CFLAGS)
|
||||
# CC = clang -m64 $(CLANG_CFLAGS)
|
||||
|
||||
XFILES = $(OBJECTDIR)sdl.o
|
||||
|
||||
#
|
||||
# For SDL version 2
|
||||
# -DSDL=2 in XFLAGS and -lSDL2 in LDFLAGS
|
||||
# For SDL version 3
|
||||
# -DSDL=3 in XFLAGS and -lSDL3 in LDFLAGS
|
||||
#
|
||||
XFLAGS = -DSDL=2
|
||||
|
||||
# OPTFLAGS is normally -O2.
|
||||
OPTFLAGS = -O2 -g3
|
||||
DFLAGS = $(XFLAGS) -DRELEASE=$(RELEASE) -D__wsl1__
|
||||
|
||||
LDFLAGS = -lm -lSDL2
|
||||
LDELDFLAGS =
|
||||
|
||||
OBJECTDIR = ../$(RELEASENAME)/
|
||||
|
||||
default : ../$(OSARCHNAME)/lde ../$(OSARCHNAME)/ldesdl
|
||||
@@ -1,28 +0,0 @@
|
||||
# Options for Windows System for Linux v1, Intel x86_64 and X-Window
|
||||
|
||||
CC = gcc -m64 $(GCC_CFLAGS)
|
||||
# CC = clang -m64 $(CLANG_CFLAGS)
|
||||
|
||||
XFILES = $(OBJECTDIR)xmkicon.o \
|
||||
$(OBJECTDIR)xbbt.o \
|
||||
$(OBJECTDIR)dspif.o \
|
||||
$(OBJECTDIR)xinit.o \
|
||||
$(OBJECTDIR)xscroll.o \
|
||||
$(OBJECTDIR)xcursor.o \
|
||||
$(OBJECTDIR)xlspwin.o \
|
||||
$(OBJECTDIR)xrdopt.o \
|
||||
$(OBJECTDIR)xwinman.o
|
||||
|
||||
|
||||
XFLAGS = -DXWINDOW
|
||||
|
||||
# OPTFLAGS is normally -O2.
|
||||
OPTFLAGS = -O2 -g3
|
||||
DFLAGS = $(XFLAGS) -DRELEASE=$(RELEASE) -D__wsl1__
|
||||
|
||||
LDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
LDELDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
|
||||
|
||||
OBJECTDIR = ../$(RELEASENAME)/
|
||||
|
||||
default : ../$(OSARCHNAME)/lde ../$(OSARCHNAME)/ldex
|
||||
@@ -1,7 +1,7 @@
|
||||
#!/bin/sh
|
||||
if command -v "git" >/dev/null 2>&1; then
|
||||
MAIKO_REV="$(git status --porcelain)"
|
||||
if [ $? -eq 0 ]; then
|
||||
if [ $? == 0 ]; then
|
||||
if [ ! -z "$(git status --porcelain)" ]; then
|
||||
MAIKO_REV="$(git rev-parse --short HEAD)-dirty"
|
||||
else
|
||||
|
||||
@@ -8,14 +8,11 @@ case "$os" in
|
||||
*-*-solaris2*) echo sunos5 ;;
|
||||
alpha-dec-osf1) echo osf1 ;;
|
||||
*-apple-darwin*) echo darwin ;;
|
||||
*-*-linux*)
|
||||
if [ -n "${WSL_DISTRO_NAME}" ] && [ -z "${WSL_INTEROP}" ];
|
||||
then echo wsl1; else echo linux; fi ;;
|
||||
*-*-linux*) echo linux ;;
|
||||
*-*-openbsd*) echo openbsd ;;
|
||||
*-*-freebsd*) echo freebsd ;;
|
||||
*-*-cygwin*) echo cygwin ;;
|
||||
*-*-haiku*) echo haiku ;;
|
||||
*-microsoft-wsl1) echo wsl1 ;;
|
||||
esac
|
||||
### Don't leave the variable set.
|
||||
unset os
|
||||
|
||||
@@ -58,7 +58,7 @@ typedef struct dfinfo {
|
||||
} DFINFO;
|
||||
|
||||
#ifdef DOS
|
||||
int make_old_version(char *old, size_t oldsize, char *file);
|
||||
int make_old_version(char *old, char *file);
|
||||
#endif
|
||||
#ifdef FSDEBUG
|
||||
void print_finfo(FINFO *fp);
|
||||
|
||||
@@ -19,9 +19,7 @@ LispPTR COM_writepage(LispPTR *args);
|
||||
LispPTR COM_truncatefile(LispPTR *args);
|
||||
LispPTR COM_changedir(LispPTR *args);
|
||||
LispPTR COM_getfreeblock(LispPTR *args);
|
||||
void conc_dir_and_name(char *dir, char *name, char *fname, size_t fname_size);
|
||||
void conc_name_and_version(char *name, char *ver, char *rname, size_t rname_size);
|
||||
void separate_version(char *name, size_t namesize, char *ver, size_t versize, int checkp);
|
||||
void separate_version(char *name, char *ver, int checkp);
|
||||
int unpack_filename(char *file, char *dir, char *name, char *ver, int checkp);
|
||||
int true_name(char *path, size_t pathsize);
|
||||
int true_name(char *path);
|
||||
#endif
|
||||
|
||||
@@ -2,10 +2,14 @@
|
||||
#define GCFINALDEFS_H 1
|
||||
#include "lispemul.h" /* for LispPTR, DLword */
|
||||
void printarrayblock(LispPTR base);
|
||||
void printfreeblockchainn(int arlen);
|
||||
int integerlength(unsigned int n);
|
||||
LispPTR findptrsbuffer(LispPTR ptr);
|
||||
LispPTR releasingvmempage(LispPTR ptr);
|
||||
LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist);
|
||||
LispPTR deleteblock(LispPTR base);
|
||||
LispPTR linkblock(LispPTR base);
|
||||
LispPTR makefreearrayblock(LispPTR block, DLword length);
|
||||
LispPTR arrayblockmerger(LispPTR base, LispPTR nbase);
|
||||
LispPTR mergebackward(LispPTR base);
|
||||
LispPTR mergeforward(LispPTR base);
|
||||
LispPTR reclaimarrayblock(LispPTR ptr);
|
||||
|
||||
74
inc/lispver2.h
Normal file
74
inc/lispver2.h
Normal file
@@ -0,0 +1,74 @@
|
||||
#ifndef LISPVER2_H
|
||||
#define LISPVER2_H 1
|
||||
/* $Id: lispver2.h,v 1.2 1999/01/03 02:06:09 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
||||
|
||||
/* non-DOS version of LispVersionToUnixVersion */
|
||||
|
||||
#define LispVersionToUnixVersion(pathname) do { \
|
||||
\
|
||||
char *lv_cp; \
|
||||
char *lv_vp; \
|
||||
unsigned lv_ver; \
|
||||
char lv_ver_buf[VERSIONLEN]; \
|
||||
\
|
||||
lv_cp = pathname; \
|
||||
lv_vp = NULL; \
|
||||
while (*lv_cp) { \
|
||||
switch (*lv_cp) { \
|
||||
\
|
||||
case ';': \
|
||||
lv_vp = lv_cp; \
|
||||
lv_cp++; \
|
||||
break; \
|
||||
\
|
||||
case '\'': \
|
||||
if (*(lv_cp + 1) != 0) lv_cp += 2; \
|
||||
else lv_cp++; \
|
||||
break; \
|
||||
\
|
||||
default: \
|
||||
lv_cp++; \
|
||||
break; \
|
||||
} \
|
||||
} \
|
||||
\
|
||||
if (lv_vp != NULL) { \
|
||||
/* \
|
||||
* A semicolon which is not quoted has been found. \
|
||||
*/ \
|
||||
if (*(lv_vp + 1) == 0) { \
|
||||
/* \
|
||||
* The empty version field. \
|
||||
* This is regarded as a versionless file. \
|
||||
*/ \
|
||||
*lv_vp = 0; \
|
||||
} else { \
|
||||
NumericStringP((lv_vp + 1), YES, NO); \
|
||||
YES: \
|
||||
/* \
|
||||
* Convert the remaining field to digit. \
|
||||
*/ \
|
||||
lv_ver = strtoul(lv_vp + 1, (char **)NULL, 10); \
|
||||
if (lv_ver == 0) { \
|
||||
/* versionless */ \
|
||||
*lv_vp = 0; \
|
||||
} else { \
|
||||
sprintf(lv_ver_buf, ".~%u~", lv_ver); \
|
||||
*lv_vp = 0; \
|
||||
strcat(pathname, lv_ver_buf); \
|
||||
} \
|
||||
goto CONT; \
|
||||
\
|
||||
NO: \
|
||||
strcpy(lv_ver_buf, lv_vp + 1); \
|
||||
strcat(lv_ver_buf, "~"); \
|
||||
*lv_vp++ = '.'; \
|
||||
*lv_vp++ = '~'; \
|
||||
*lv_vp = 0; \
|
||||
strcat(pathname, lv_ver_buf); \
|
||||
CONT: \
|
||||
lv_vp--; /* Just for label */ \
|
||||
} \
|
||||
} \
|
||||
} while (0)
|
||||
#endif /* LISPVER2_H */
|
||||
314
inc/locfile.h
314
inc/locfile.h
@@ -12,7 +12,6 @@
|
||||
#include <limits.h> /* for NAME_MAX */
|
||||
#include <dirent.h> /* for MAXNAMLEN */
|
||||
#include "lispemul.h" /* for DLword */
|
||||
#include "commondefs.h" /* for error */
|
||||
|
||||
#define FDEV_PAGE_SIZE 512 /* 1 page == 512 byte */
|
||||
|
||||
@@ -35,8 +34,6 @@
|
||||
#define PROTECTION (S_POSITIVE | 6)
|
||||
#define EOL (S_POSITIVE | 7)
|
||||
#define ALL (S_POSITIVE | 8)
|
||||
#define INODE_LO (S_POSITIVE | 9)
|
||||
#define INODE_HI (S_POSITIVE | 10)
|
||||
|
||||
#define ToLispTime(x) ((int)(x) + 29969152)
|
||||
/* For getfileinfo. For WDATE&RDATE */
|
||||
@@ -47,17 +44,18 @@
|
||||
/* For getfileinfo. For WDATE&RDATE */
|
||||
/* 29969152 == (timer.c)LISP_UNIX_TIME_DIFF */
|
||||
|
||||
/*
|
||||
* Copy memory between native memory locations accounting for potential
|
||||
* byte-swapping necessary when then destination is within Lisp memory space
|
||||
* though the provided destination pointer is a native address within the
|
||||
* Lisp space.
|
||||
*/
|
||||
#define MemCpyToLispFromNative(lispbuf, cbuf, len) \
|
||||
do { \
|
||||
char *lf_sptr = (cbuf); \
|
||||
char *lf_dptr = (lispbuf); \
|
||||
for (size_t lf_i = 0; lf_i < (len); lf_i++) *BYTEPTR(lf_dptr++) = *lf_sptr++; \
|
||||
#define StrNCpyFromCToLisp(lispbuf, cbuf ,len) do { \
|
||||
char *lf_sptr = (cbuf); \
|
||||
char *lf_dptr = (lispbuf); \
|
||||
for(size_t lf_i=0;lf_i<(len);lf_i++)\
|
||||
GETBYTE(lf_dptr++) = *lf_sptr++; \
|
||||
} while (0)
|
||||
|
||||
#define StrNCpyFromLispToC(cbuf , lispbuf, len) do { \
|
||||
char *lf_sptr = (lispbuf); \
|
||||
char *lf_dptr = (cbuf); \
|
||||
for(size_t lf_i=0;lf_i<(len);lf_i++)\
|
||||
*lf_dptr++ = GETBYTE(lf_sptr++); \
|
||||
} while (0)
|
||||
|
||||
#define FGetNum(ptr, place) do { \
|
||||
@@ -66,10 +64,6 @@
|
||||
else {return(NIL);}} while (0)
|
||||
|
||||
|
||||
#ifndef min
|
||||
#define min(a, b) (((a) <= (b))?(a):(b))
|
||||
#endif /* min */
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* L i s p S t r i n g T o C S t r i n g */
|
||||
@@ -85,52 +79,65 @@
|
||||
/* */
|
||||
/************************************************************************/
|
||||
#ifndef BYTESWAP
|
||||
static void LispStringToCString(LispPTR Lisp, char *C, size_t MaxLen) {
|
||||
OneDArray *lf_arrayp;
|
||||
char *lf_base, *lf_dp;
|
||||
short *lf_sbase;
|
||||
size_t lf_length;
|
||||
lf_arrayp = (OneDArray *)NativeAligned4FromLAddr(Lisp);
|
||||
lf_length = min(MaxLen - 1, lf_arrayp->fillpointer);
|
||||
lf_dp = (C);
|
||||
switch (lf_arrayp->typenumber) {
|
||||
case THIN_CHAR_TYPENUMBER:
|
||||
lf_base = ((char *)(NativeAligned2FromLAddr(lf_arrayp->base))) + ((int)(lf_arrayp->offset));
|
||||
strncpy(lf_dp, lf_base, lf_length);
|
||||
lf_dp[lf_length] = '\0';
|
||||
break;
|
||||
|
||||
case FAT_CHAR_TYPENUMBER:
|
||||
lf_sbase = ((short *)(NativeAligned2FromLAddr(lf_arrayp->base))) + ((int)(lf_arrayp->offset));
|
||||
for (size_t lf_i = 0; lf_i < (lf_length); lf_i++) *lf_dp++ = (char)(*lf_sbase++);
|
||||
*lf_dp = '\0';
|
||||
break;
|
||||
default: error("LispStringToCString: Not a character array.\n");
|
||||
}
|
||||
}
|
||||
#define LispStringToCString(Lisp, C, MaxLen) \
|
||||
do { \
|
||||
OneDArray *lf_arrayp; \
|
||||
char *lf_base, *lf_dp; \
|
||||
short *lf_sbase; \
|
||||
size_t lf_length; \
|
||||
lf_arrayp = (OneDArray *)NativeAligned4FromLAddr(Lisp); \
|
||||
lf_length = min(MaxLen, lf_arrayp->fillpointer); \
|
||||
switch(lf_arrayp->typenumber) \
|
||||
{ \
|
||||
case THIN_CHAR_TYPENUMBER: \
|
||||
lf_base = ((char *)(NativeAligned2FromLAddr(lf_arrayp->base))) \
|
||||
+ ((int)(lf_arrayp->offset)); \
|
||||
strncpy(C, lf_base, lf_length); \
|
||||
(C)[lf_length] = '\0'; \
|
||||
break; \
|
||||
\
|
||||
case FAT_CHAR_TYPENUMBER: \
|
||||
lf_sbase = ((short *)(NativeAligned2FromLAddr(lf_arrayp->base))) \
|
||||
+ ((int)(lf_arrayp->offset)); \
|
||||
lf_dp = C; \
|
||||
for(size_t lf_i=0;lf_i<(lf_length);lf_i++) \
|
||||
*lf_dp++ = (char)(*lf_sbase++); \
|
||||
*lf_dp = '\0'; \
|
||||
break; \
|
||||
default: \
|
||||
error("LispStringToCString: Not a character array.\n"); \
|
||||
} \
|
||||
} while (0)
|
||||
#else /* BYTESWAP == T CHANGED-BY-TAKE */
|
||||
static void LispStringToCString(LispPTR Lisp, char *C, size_t MaxLen) {
|
||||
OneDArray *lf_arrayp;
|
||||
char *lf_base, *lf_dp;
|
||||
short *lf_sbase;
|
||||
size_t lf_length;
|
||||
lf_arrayp = (OneDArray *)(NativeAligned4FromLAddr(Lisp));
|
||||
lf_length = min(MaxLen - 1, lf_arrayp->fillpointer);
|
||||
lf_dp = (C);
|
||||
switch (lf_arrayp->typenumber) {
|
||||
case THIN_CHAR_TYPENUMBER:
|
||||
lf_base = ((char *)(NativeAligned2FromLAddr(lf_arrayp->base))) + ((int)(lf_arrayp->offset));
|
||||
for (size_t lf_i = 0; lf_i < lf_length; lf_i++) *lf_dp++ = GETBYTE(lf_base++);
|
||||
break;
|
||||
|
||||
case FAT_CHAR_TYPENUMBER:
|
||||
lf_sbase = ((short *)(NativeAligned2FromLAddr(lf_arrayp->base))) + ((int)(lf_arrayp->offset));
|
||||
for (size_t lf_ii = 0; lf_ii < lf_length; lf_ii++) *lf_dp++ = (char)(GETWORD(lf_sbase++));
|
||||
break;
|
||||
default: error("LispStringToCString: Not a character array.\n");
|
||||
}
|
||||
*lf_dp = '\0';
|
||||
}
|
||||
#define LispStringToCString(Lisp, C, MaxLen) \
|
||||
do { \
|
||||
OneDArray *lf_arrayp; \
|
||||
char *lf_base, *lf_dp; \
|
||||
short *lf_sbase; \
|
||||
size_t lf_length; \
|
||||
lf_arrayp = (OneDArray *)(NativeAligned4FromLAddr(Lisp)); \
|
||||
lf_length = min(MaxLen, lf_arrayp->fillpointer); \
|
||||
switch(lf_arrayp->typenumber) \
|
||||
{ \
|
||||
case THIN_CHAR_TYPENUMBER: \
|
||||
lf_base = ((char *)(NativeAligned2FromLAddr(lf_arrayp->base))) \
|
||||
+ ((int)(lf_arrayp->offset)); \
|
||||
StrNCpyFromLispToC(C , lf_base , lf_length ); \
|
||||
(C)[lf_length] = '\0'; \
|
||||
break; \
|
||||
\
|
||||
case FAT_CHAR_TYPENUMBER: \
|
||||
lf_sbase = ((short *)(NativeAligned2FromLAddr(lf_arrayp->base))) \
|
||||
+ ((int)(lf_arrayp->offset)); \
|
||||
lf_dp = C; \
|
||||
for(size_t lf_ii=0;lf_ii<(lf_length);lf_ii++,lf_sbase++) \
|
||||
*lf_dp++ = (char)(GETWORD(lf_sbase)); \
|
||||
*lf_dp = '\0'; \
|
||||
break; \
|
||||
default: \
|
||||
error("LispStringToCString: Not a character array.\n"); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
#endif /* BYTESWAP */
|
||||
|
||||
@@ -182,6 +189,10 @@ do { \
|
||||
(cstringp) = (char *)(NativeAligned2FromLAddr(((OneDArray *)lf_naddress)->base)); \
|
||||
} while (0)
|
||||
|
||||
#ifndef min
|
||||
#define min(a, b) (((a) <= (b))?(a):(b))
|
||||
#endif /* min */
|
||||
|
||||
#define LispNumToCInt(Lisp) \
|
||||
( (((Lisp) & SEGMASK) == S_POSITIVE) ? ((Lisp) & 0xFFFF) : \
|
||||
(((Lisp) & SEGMASK) == S_NEGATIVE) ? ((Lisp) | 0xFFFF0000) : \
|
||||
@@ -288,7 +299,7 @@ do { \
|
||||
* Argument: char *pathname
|
||||
* Xerox Lisp syntax pathname.
|
||||
*
|
||||
* Value: On success returns 1, otherwise 0.
|
||||
* Value: If succeed, returns 1, otherwise 0.
|
||||
*
|
||||
* Side Effect: The version part of pathname is destructively modified.
|
||||
*
|
||||
@@ -301,7 +312,7 @@ do { \
|
||||
* code.
|
||||
* This macro should be called at the top of the routines which accept the
|
||||
* file name from lisp before converting it into UNIX file name, because
|
||||
* locating the version part, the information about quoted characters are needed.
|
||||
* locating the version part, the informations about quoted characters are needed.
|
||||
* They might be lost in the course of the conversion.
|
||||
*
|
||||
*/
|
||||
@@ -312,10 +323,179 @@ do { \
|
||||
/* * * * * it gave "Too many characters in a character constant" errors! */
|
||||
#include "lispver1.h"
|
||||
#else /* DOS */
|
||||
/* NON-DOS version is inline in ufs.c */
|
||||
/* NON-DOS version of the macro LispVersionToUnixVersion */
|
||||
#include "lispver2.h"
|
||||
#endif /* DOS */
|
||||
|
||||
#define VERSIONLEN 24
|
||||
|
||||
/*
|
||||
* Name: UnixVersionToLispVersion
|
||||
*
|
||||
* Argument: char *pathname
|
||||
* UNIX syntax pathname.
|
||||
* int vlessp
|
||||
* If 0, versionless file is converted to version 1.
|
||||
* Otherwise, remains as versionless.
|
||||
*
|
||||
* Value: If succeed, returns 1, otherwise 0.
|
||||
*
|
||||
* Side Effect: The version part of pathname is destructively modified.
|
||||
*
|
||||
* Description:
|
||||
*
|
||||
* Destructively modify the version part of pathname which is following the
|
||||
* UNIX file naming convention to Xerox Lisp one.
|
||||
* This macro should be called, in the routines which convert the UNIX pathname
|
||||
* to Lisp one, just before it returns the result to Lisp, because converting
|
||||
* version field will append a semicolon and it might make the routine be
|
||||
* confused.
|
||||
* The file which has not a valid version field, that is ".~##~" form, is
|
||||
* dealt with as version 1.
|
||||
*/
|
||||
|
||||
#define UnixVersionToLispVersion(pathname, vlessp) do { \
|
||||
\
|
||||
char *start; \
|
||||
char *end; \
|
||||
char *lf_cp; \
|
||||
int ver_no; \
|
||||
size_t len; \
|
||||
char ver_buf[VERSIONLEN]; \
|
||||
\
|
||||
if ((start = strchr(pathname, '~')) != NULL) { \
|
||||
/* First of all, find the version field in pathname. */ \
|
||||
end = start; \
|
||||
lf_cp = start + 1; \
|
||||
while (*lf_cp) { \
|
||||
if (*lf_cp == '~') { \
|
||||
start = end; \
|
||||
end = lf_cp; \
|
||||
lf_cp++; \
|
||||
} else { \
|
||||
lf_cp++; \
|
||||
} \
|
||||
} \
|
||||
\
|
||||
if (start != end && *(start - 1) == '.' && end == (lf_cp - 1)) { \
|
||||
/* \
|
||||
* pathname ends in the form ".~###~". But we \
|
||||
* check ### is a valid number or not. \
|
||||
*/ \
|
||||
len = (end - start) - 1; \
|
||||
strncpy(ver_buf, start + 1, len); \
|
||||
ver_buf[len] = '\0'; \
|
||||
NumericStringP(ver_buf, YES, NO); \
|
||||
YES: \
|
||||
*(start - 1) = ';'; \
|
||||
*start = '\0'; \
|
||||
*end = '\0'; \
|
||||
/* call strtoul() to eliminate leading 0s. */ \
|
||||
ver_no = strtoul(start + 1, (char **)NULL, 10); \
|
||||
sprintf(ver_buf, "%u", ver_no); \
|
||||
strcat(pathname, ver_buf); \
|
||||
goto CONT; \
|
||||
\
|
||||
NO: \
|
||||
/* Dealt with as version 1 unless vlessp */ \
|
||||
if (!(vlessp)) strcat(pathname, ";1"); \
|
||||
CONT: \
|
||||
lf_cp--; /* Just for label */ \
|
||||
} else { \
|
||||
/* Dealt with as version 1 unless vlessp. */ \
|
||||
if (!(vlessp)) strcat(pathname, ";1"); \
|
||||
} \
|
||||
} else { \
|
||||
/* Dealt with as version 1 unless vlessp. */ \
|
||||
if (!(vlessp)) strcat(pathname, ";1"); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
/*
|
||||
* Name: ConcDirAndName
|
||||
*
|
||||
* Argument: char *dir The name of the directory.
|
||||
* char *name The name of a file.
|
||||
* char *fname The place where the full file name should be
|
||||
* stored.
|
||||
* Value: N/A
|
||||
*
|
||||
* Side Effect: fname is replaced with the full file name.
|
||||
*
|
||||
* Description:
|
||||
*
|
||||
* Concatenate the directory name and root file name. Checks if dir contains
|
||||
* the trail directory delimiter or not.
|
||||
*
|
||||
*/
|
||||
|
||||
#define ConcDirAndName(dir, name, fname) do { \
|
||||
\
|
||||
char *lf_cp1, *lf_cp2; \
|
||||
\
|
||||
lf_cp1 = dir; \
|
||||
lf_cp2 = dir; \
|
||||
\
|
||||
while (*lf_cp2 != '\0') { \
|
||||
switch (*lf_cp2) { \
|
||||
\
|
||||
case '/': \
|
||||
lf_cp1 = lf_cp2; \
|
||||
lf_cp2++; \
|
||||
break; \
|
||||
\
|
||||
default: \
|
||||
lf_cp2++; \
|
||||
break; \
|
||||
} \
|
||||
} \
|
||||
if (lf_cp1 == (lf_cp2 - 1)) { \
|
||||
if (lf_cp1 == (dir)) { \
|
||||
/* dir is a root directory. */ \
|
||||
strcpy(fname, "/"); \
|
||||
strcat(fname, name); \
|
||||
} else { \
|
||||
/* The trail directory is included. */ \
|
||||
strcpy(fname, dir); \
|
||||
strcat(fname, name); \
|
||||
} \
|
||||
} else { \
|
||||
/* The trail directory is not included */ \
|
||||
strcpy(fname, dir); \
|
||||
strcat(fname, "/"); \
|
||||
strcat(fname, name); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
/*
|
||||
* Name: ConcNameAndVersion
|
||||
*
|
||||
* Argument: char *name The root file name.
|
||||
* char *ver The file version.
|
||||
* char *rname The place where the concatenated file name will be
|
||||
* stored.
|
||||
* Value: N/A
|
||||
*
|
||||
* Side Effect: rname is replaced with the concatenated file name.
|
||||
*
|
||||
* Description:
|
||||
*
|
||||
* Concatenate the root file name and its version in UNIX format.
|
||||
*
|
||||
*/
|
||||
|
||||
#define ConcNameAndVersion(name, ver, rname) do { \
|
||||
if (*(ver) != '\0') { \
|
||||
strcpy(rname, name); \
|
||||
strcat(rname, ".~"); \
|
||||
strcat(rname, ver); \
|
||||
strcat(rname, "~"); \
|
||||
} else { \
|
||||
strcpy(rname, name); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
#define VERSIONLEN 16
|
||||
|
||||
#define MAXVERSION 999999999
|
||||
|
||||
#define LASTVERSIONARRAY ((unsigned) -1)
|
||||
|
||||
@@ -38,23 +38,13 @@
|
||||
# define MAIKO_OS_DETECTED 1
|
||||
#endif
|
||||
|
||||
#if defined(__linux__) && !defined(__wsl1__)
|
||||
#ifdef __linux__
|
||||
# define MAIKO_OS_LINUX 1
|
||||
# define MAIKO_OS_NAME "Linux"
|
||||
# define MAIKO_OS_UNIX_LIKE 1
|
||||
# define MAIKO_OS_DETECTED 1
|
||||
#endif
|
||||
|
||||
#if defined(__linux__) && defined(__wsl1__)
|
||||
# define MAIKO_OS_LINUX 1
|
||||
# define MAIKO_OS_WSL1 1
|
||||
# define MAIKO_OS_NAME "Windows System for Linux v1"
|
||||
# define MAIKO_OS_UNIX_LIKE 1
|
||||
# define MAIKO_EMULATE_TIMER_INTERRUPTS 1
|
||||
# define MAIKO_EMULATE_ASYNC_INTERRUPTS 1
|
||||
# define MAIKO_OS_DETECTED 1
|
||||
#endif
|
||||
|
||||
#ifdef __NetBSD__
|
||||
# define MAIKO_OS_NETBSD 1
|
||||
# define MAIKO_OS_NAME "NetBSD"
|
||||
|
||||
@@ -37,13 +37,10 @@ extern unsigned int TIMEOUT_TIME;
|
||||
alarm(0); \
|
||||
} while (0)
|
||||
|
||||
|
||||
/* After any use of S_TOUT one should call alarm(0) to cancel
|
||||
* the last pending alarm.
|
||||
*/
|
||||
#define S_TOUT(exp) \
|
||||
alarm(TIMEOUT_TIME), \
|
||||
(exp)
|
||||
alarm(TIMEOUT_TIME), \
|
||||
(exp), \
|
||||
alarm(0)
|
||||
|
||||
#define ERRSETJMP(rval) \
|
||||
do { \
|
||||
|
||||
@@ -5,14 +5,15 @@ LispPTR UFS_getfilename(LispPTR *args);
|
||||
LispPTR UFS_deletefile(LispPTR *args);
|
||||
LispPTR UFS_renamefile(LispPTR *args);
|
||||
LispPTR UFS_directorynamep(LispPTR *args);
|
||||
void UnixVersionToLispVersion(char *pathname, size_t pathsize, int vlessp);
|
||||
void LispVersionToUnixVersion(char *pathname, size_t pathsize);
|
||||
#ifdef DOS
|
||||
int unixpathname(char *src, char *dst, int dstlen, int versionp, int genp, char *drive, int *extlenptr, char *rawname);
|
||||
int unixpathname(char *src, char *dst, int versionp, int genp, char *drive, int *extlenptr, char *rawname);
|
||||
#else
|
||||
int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp);
|
||||
int unixpathname(char *src, char *dst, int versionp, int genp);
|
||||
#endif
|
||||
int lisppathname(char *fullname, char *lispname, size_t lispnamesize, int dirp, int versionp);
|
||||
int lisppathname(char *fullname, char *lispname, int dirp, int versionp);
|
||||
int quote_fname(char *file);
|
||||
int quote_fname_ufs(char *file);
|
||||
int quote_dname(char *dir);
|
||||
#ifdef DOS
|
||||
init_host_filesystem(void);
|
||||
exit_host_filesystem(void);
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
#include "stack.h" /* for FX */
|
||||
#include "lispemul.h" /* for LispPTR */
|
||||
|
||||
#define URMAXFXNUM 4096
|
||||
#define URMAXFXNUM 2000
|
||||
#define URMAXCOMM 512
|
||||
#define URSCAN_ALINK 0
|
||||
#define URSCAN_CLINK 1
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
#ifndef VMEMSAVEDEFS_H
|
||||
#define VMEMSAVEDEFS_H 1
|
||||
#include "lispemul.h" /* for LispPTR */
|
||||
#include "lispemul.h" /* for LispPTR, DLword */
|
||||
int lispstringP(LispPTR Lisp);
|
||||
LispPTR vmem_save(char *sysout_file_name);
|
||||
LispPTR vmem_save0(LispPTR *args);
|
||||
void lisp_finish(int exit_status);
|
||||
|
||||
@@ -468,7 +468,7 @@ LispPTR ether_get(LispPTR args[])
|
||||
log_debug(("ether_get() - begin\n"));
|
||||
|
||||
target = (u_char *)NativeAligned2FromLAddr(args[1]);
|
||||
maxByteCount = BYTESPER_DLWORD * LispIntToCInt(args[0]); /* words to bytes */
|
||||
maxByteCount = 2 * LispIntToCInt(args[0]); /* words to bytes */
|
||||
log_debug((" target = %p maxBytecount: %d bytes\n", (void *)target, maxByteCount));
|
||||
|
||||
ether_buf = target;
|
||||
@@ -501,7 +501,7 @@ LispPTR ether_send(LispPTR args[])
|
||||
log_debug(("ether_send() - begin\n"));
|
||||
|
||||
u_char *source = (u_char *)NativeAligned2FromLAddr(args[1]);
|
||||
int byteCount = BYTESPER_DLWORD * LispIntToCInt(args[0]); /* words to bytes */
|
||||
int byteCount = 2 * LispIntToCInt(args[0]); /* words to bytes */
|
||||
|
||||
log_debug((" source = %p , bytecount: %d bytes\n", (void *)source, byteCount));
|
||||
|
||||
|
||||
@@ -366,7 +366,7 @@ LispPTR ether_get(LispPTR args[])
|
||||
LispPTR MaxByteCount;
|
||||
sigset_t signals;
|
||||
|
||||
MaxByteCount = BYTERSPER_DLWORD * (0xFFFF & args[0]); /* words to bytes */
|
||||
MaxByteCount = 2 * (0xFFFF & args[0]); /* words to bytes */
|
||||
|
||||
DBPRINT(("Ether Get. "));
|
||||
|
||||
@@ -408,7 +408,7 @@ LispPTR ether_send(LispPTR args[])
|
||||
LispPTR MaxByteCount;
|
||||
u_char *BufferAddr; /* buffer address pointer(in native address) */
|
||||
|
||||
MaxByteCount = BYTESPER_DLWORD * (0xFFFF & args[0]); /* words to bytes */
|
||||
MaxByteCount = 2 * (0xFFFF & args[0]); /* words to bytes */
|
||||
BufferAddr = (u_char *)NativeAligned2FromLAddr(args[1]);
|
||||
|
||||
if (ether_fd > 0) {
|
||||
|
||||
@@ -99,35 +99,35 @@ struct hashtable {
|
||||
LispPTR aref1(LispPTR array, int index) {
|
||||
LispPTR retval = 0;
|
||||
LispPTR base;
|
||||
struct arrayheader *array_np;
|
||||
short typenumber;
|
||||
struct arrayheader *actarray;
|
||||
|
||||
array_np = (struct arrayheader *)NativeAligned4FromLAddr(array);
|
||||
if (index >= array_np->totalsize) {
|
||||
actarray = (struct arrayheader *)NativeAligned4FromLAddr(array);
|
||||
if (index >= actarray->totalsize) {
|
||||
printf("Invalid index in GC's AREF1: 0x%x\n", index);
|
||||
printf(" Array size limit: 0x%x\n", array_np->totalsize);
|
||||
printf(" Array size limit: 0x%x\n", actarray->totalsize);
|
||||
printf(" Array ptr: 0x%x\n", array);
|
||||
printf(" Array native ptr: %p\n", (void *)array_np);
|
||||
printf("base: 0x%x\n", array_np->base);
|
||||
printf("offset: 0x%x\n", array_np->offset);
|
||||
printf("type #: 0x%x\n", array_np->typenumber);
|
||||
printf("fill ptr: 0x%x\n", array_np->fillpointer);
|
||||
printf(" Array 68K ptr: %p\n", (void *)actarray);
|
||||
printf("base: 0x%x\n", actarray->base);
|
||||
printf("offset: 0x%x\n", actarray->offset);
|
||||
printf("type #: 0x%x\n", actarray->typenumber);
|
||||
printf("fill ptr: 0x%x\n", actarray->fillpointer);
|
||||
error("index out of range in GC's AREF1.");
|
||||
}
|
||||
index += array_np->offset;
|
||||
base = array_np->base;
|
||||
switch (array_np->typenumber) {
|
||||
case 3: /* unsigned 8 bits */
|
||||
retval = (GETBYTE(((char *)NativeAligned2FromLAddr(base)) + index)) & 0x0ff;
|
||||
retval |= S_POSITIVE;
|
||||
break;
|
||||
case 4: /* unsigned 16 bits */
|
||||
retval = (GETWORD(((DLword *)NativeAligned2FromLAddr(base)) + index)) & 0x0ffff;
|
||||
retval |= S_POSITIVE;
|
||||
break;
|
||||
case 38: /* pointer 32 bits */
|
||||
retval = (*(((LispPTR *)NativeAligned4FromLAddr(base)) + index));
|
||||
break;
|
||||
default: error("Not Implemented in gc's aref1 (other types)");
|
||||
index += actarray->offset;
|
||||
typenumber = actarray->typenumber;
|
||||
base = actarray->base;
|
||||
switch (typenumber) {
|
||||
case 3: /* unsigned 8bits */
|
||||
retval = (GETBYTE(((char *)NativeAligned2FromLAddr(base)) + index)) & 0x0ff;
|
||||
retval |= S_POSITIVE;
|
||||
break;
|
||||
case 4: /* unsigned 16bits */
|
||||
retval = (GETWORD(((DLword *)NativeAligned2FromLAddr(base)) + index)) & 0x0ffff;
|
||||
retval |= S_POSITIVE;
|
||||
break;
|
||||
case 38: retval = (*(((LispPTR *)NativeAligned4FromLAddr(base)) + index)); break;
|
||||
default: error("Not Implemented in gc's aref1 (other types)");
|
||||
}
|
||||
return (retval);
|
||||
}
|
||||
|
||||
413
src/gcfinal.c
413
src/gcfinal.c
@@ -50,7 +50,7 @@
|
||||
#include "gccodedefs.h" // for reclaimcodeblock
|
||||
#include "gcdata.h" // for DELREF, REC_GCLOOKUP
|
||||
#include "gchtfinddefs.h" // for htfind, rec_htfind
|
||||
#include "gcfinaldefs.h" // for checkarrayblock
|
||||
#include "gcfinaldefs.h" // for arrayblockmerger, checkarrayblock, deleteblock
|
||||
#include "lispemul.h" // for LispPTR, NIL, T, POINTERMASK, DLword, ATOM_T
|
||||
#include "llstkdefs.h" // for decusecount68k
|
||||
#include "lspglob.h" // for FreeBlockBuckets_word, ArrayMerging_word
|
||||
@@ -69,16 +69,13 @@
|
||||
#endif /* NEVER */
|
||||
|
||||
#define min(a, b) (((a) > (b)) ? (b) : (a))
|
||||
#define Trailer(ldatum, datum68) ((ldatum) + DLWORDSPER_CELL * ((datum68)->arlen - ARRAYBLOCKTRAILERCELLS))
|
||||
#define Trailer(ldatum, datum68) ((ldatum) + 2 * ((datum68)->arlen - ARRAYBLOCKTRAILERCELLS))
|
||||
#define BucketIndex(n) min(integerlength(n), MAXBUCKETINDEX)
|
||||
#define FreeBlockChainN(n) ((POINTERMASK & *FreeBlockBuckets_word) + 2 * BucketIndex(n))
|
||||
|
||||
/*
|
||||
* Declaration of buffer must be identical layout to Lisp BUFFER datatype in PMAP.
|
||||
*/
|
||||
#ifndef BYTESWAP
|
||||
#ifdef BIGVM
|
||||
struct buffer {
|
||||
struct buf {
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
@@ -89,7 +86,7 @@ struct buffer {
|
||||
unsigned sysnext : 28;
|
||||
};
|
||||
#else
|
||||
struct buffer {
|
||||
struct buf {
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
@@ -102,7 +99,7 @@ struct buffer {
|
||||
#endif /* BIGVM */
|
||||
#else
|
||||
#ifdef BIGVM
|
||||
struct buffer {
|
||||
struct buf {
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
@@ -113,7 +110,7 @@ struct buffer {
|
||||
unsigned noreference : 1;
|
||||
};
|
||||
#else
|
||||
struct buffer {
|
||||
struct buf {
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
@@ -126,32 +123,24 @@ struct buffer {
|
||||
#endif /* BIGVM */
|
||||
#endif /* BYTESWAP */
|
||||
|
||||
static int integerlength(unsigned int n) {
|
||||
int p = 0;
|
||||
/************* The following procedure is common !! **************************/
|
||||
|
||||
if (n <= 2) return (n); /* easy case */
|
||||
if (n >= 65536) {
|
||||
n >>= 16;
|
||||
p += 16;
|
||||
int integerlength(unsigned int n) {
|
||||
int cnt;
|
||||
if (n <= 2)
|
||||
return (n);
|
||||
else {
|
||||
cnt = 1;
|
||||
do {
|
||||
cnt++;
|
||||
n = (n >> 1);
|
||||
} while (n != 1);
|
||||
return (cnt);
|
||||
}
|
||||
if (n >= 256) {
|
||||
n >>= 8;
|
||||
p += 8;
|
||||
}
|
||||
if (n >= 16) {
|
||||
n >>= 4;
|
||||
p += 4;
|
||||
}
|
||||
if (n >= 4) {
|
||||
n >>= 2;
|
||||
p += 2;
|
||||
}
|
||||
if (n >= 2) {
|
||||
p += 1;
|
||||
}
|
||||
return (p + 1);
|
||||
}
|
||||
|
||||
/************* The above procedure is common !! **************************/
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* f i n d p t r s b u f f e r */
|
||||
@@ -162,16 +151,14 @@ static int integerlength(unsigned int n) {
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
static LispPTR findptrsbuffer(LispPTR ptr) {
|
||||
LispPTR buf;
|
||||
struct buffer *buf_np;
|
||||
buf = *System_Buffer_List_word;
|
||||
while (buf != NIL) {
|
||||
buf_np = (struct buffer *)NativeAligned4FromLAddr(buf);
|
||||
if (ptr == buf_np->vmempage) {
|
||||
return (buf);
|
||||
}
|
||||
buf = buf_np->sysnext;
|
||||
LispPTR findptrsbuffer(LispPTR ptr) {
|
||||
struct buf *bptr;
|
||||
bptr = (struct buf *)NativeAligned4FromLAddr(*System_Buffer_List_word);
|
||||
while (LAddrFromNative(bptr) != NIL) {
|
||||
if (ptr == bptr->vmempage)
|
||||
return (LAddrFromNative(bptr));
|
||||
else
|
||||
bptr = (struct buf *)NativeAligned4FromLAddr(bptr->sysnext);
|
||||
}
|
||||
return (NIL);
|
||||
}
|
||||
@@ -188,13 +175,13 @@ static LispPTR findptrsbuffer(LispPTR ptr) {
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR releasingvmempage(LispPTR ptr) {
|
||||
LispPTR buffer = findptrsbuffer(ptr);
|
||||
struct buffer *buffer_np;
|
||||
struct buf *bptr;
|
||||
LispPTR bufferptr = findptrsbuffer(ptr);
|
||||
|
||||
if (buffer == NIL) return (NIL); /* Not in use, OK to reclaim it */
|
||||
if (bufferptr == NIL) return (NIL); /* Not in use, OK to reclaim it */
|
||||
|
||||
buffer_np = (struct buffer *)NativeAligned4FromLAddr(buffer);
|
||||
buffer_np->noreference = T; /* Mark the buffer free to use ?? */
|
||||
bptr = (struct buf *)NativeAligned4FromLAddr(bufferptr);
|
||||
bptr->noreference = T; /* Mark the buffer free to use ?? */
|
||||
return (ATOM_T);
|
||||
}
|
||||
|
||||
@@ -205,9 +192,10 @@ LispPTR releasingvmempage(LispPTR ptr) {
|
||||
/* Given an array block, do consistency checks on it. */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
|
||||
struct arrayblock *base_np, *trailer_np;
|
||||
struct arrayblock *fwd_np, *bkwd_np, *rbase;
|
||||
struct arrayblock *bbase, *btrailer;
|
||||
struct arrayblock *bfwd, *bbwd, *rbase;
|
||||
LispPTR fbl;
|
||||
LispPTR *rover, *tmprover;
|
||||
#ifdef ARRAYCHECK
|
||||
@@ -216,51 +204,38 @@ LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
|
||||
if (*Array_Block_Checking_word != NIL)
|
||||
#endif
|
||||
{
|
||||
base_np = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
trailer_np = (struct arrayblock *)NativeAligned4FromLAddr(Trailer(base, base_np));
|
||||
#if 0
|
||||
printf("cblock: 0x%x free: %x onfreelist: %x pw: %x arlen %d\n",
|
||||
base, free, onfreelist, base_np->password, base_np->arlen);
|
||||
#endif
|
||||
if (base_np->password != ARRAYBLOCKPASSWORD) {
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
btrailer = (struct arrayblock *)NativeAligned4FromLAddr(Trailer(base, bbase));
|
||||
if (bbase->password != ARRAYBLOCKPASSWORD) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK password wrong\n");
|
||||
return(T);
|
||||
} else if (base_np->inuse == free) {
|
||||
} else if (bbase->inuse == free) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK INUSE bit set wrong\n");
|
||||
return(T);
|
||||
} else if (trailer_np->password != ARRAYBLOCKPASSWORD) {
|
||||
} else if (btrailer->password != ARRAYBLOCKPASSWORD) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK trailer password wrong\n");
|
||||
return(T);
|
||||
} else if (base_np->arlen != trailer_np->arlen) {
|
||||
} else if (bbase->arlen != btrailer->arlen) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK Header and Trailer length don't match\n");
|
||||
return(T);
|
||||
} else if (trailer_np->inuse == free)
|
||||
} else if (btrailer->inuse == free)
|
||||
/* This is not original source.(in original,
|
||||
trailer_np -> base_np) maybe, this is correction. */
|
||||
btrailer -> bbase) maybe, this is correction. */
|
||||
{
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK Trailer INUSE bit set wrong\n");
|
||||
return(T);
|
||||
} else if (!onfreelist || (base_np->arlen < MINARRAYBLOCKSIZE))
|
||||
} else if (!onfreelist || (bbase->arlen < MINARRAYBLOCKSIZE))
|
||||
return (NIL);
|
||||
/* Remaining tests only for free list. */
|
||||
fwd_np = (struct arrayblock *)NativeAligned4FromLAddr(base_np->fwd);
|
||||
bkwd_np = (struct arrayblock *)NativeAligned4FromLAddr(base_np->bkwd);
|
||||
if ((bkwd_np->fwd != base) || (fwd_np->bkwd != base)) {
|
||||
bfwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->fwd);
|
||||
bbwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->bkwd);
|
||||
if ((bbwd->fwd != base) || (bfwd->bkwd != base)) {
|
||||
error("ARRAYBLOCK links fouled\n");
|
||||
return(T);
|
||||
} else {
|
||||
fbl = FreeBlockChainN(base_np->arlen);
|
||||
fbl = FreeBlockChainN(bbase->arlen);
|
||||
rover = tmprover = (LispPTR *)NativeAligned4FromLAddr(fbl);
|
||||
/* GETBASEPTR */
|
||||
if ((*rover & POINTERMASK) == NIL) {
|
||||
error("Free Block's bucket empty\n");
|
||||
return(T);
|
||||
}
|
||||
if ((*rover & POINTERMASK) == NIL) error("Free Block's bucket empty\n");
|
||||
do {
|
||||
if ((*rover & POINTERMASK) == base) return (NIL);
|
||||
checkarrayblock((*rover & POINTERMASK), T, NIL);
|
||||
@@ -279,38 +254,32 @@ LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
/*
|
||||
* Removes "base", a block from the free list and
|
||||
* adjusts the forward and backward pointers of the blocks behind and
|
||||
* ahead of the deleted block.
|
||||
* The forward and backward pointers of this deleted block are left
|
||||
* dangling - as in the Lisp implementation. Also does not affect the
|
||||
* inuse bit in header and trailer.
|
||||
*/
|
||||
static void deleteblock(LispPTR base) {
|
||||
struct arrayblock *base_np, *f_np, *b_np;
|
||||
LispPTR f, b, fbl, freeblock;
|
||||
LispPTR *fbl_np;
|
||||
base_np = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
if ((base_np->arlen >= MINARRAYBLOCKSIZE) && (base_np->fwd != NIL)) {
|
||||
f = base_np->fwd;
|
||||
f_np = (struct arrayblock *)NativeAligned4FromLAddr(f);
|
||||
b = base_np->bkwd;
|
||||
b_np = (struct arrayblock *)NativeAligned4FromLAddr(b);
|
||||
fbl = FreeBlockChainN(base_np->arlen);
|
||||
fbl_np = (LispPTR *)NativeAligned4FromLAddr(fbl);
|
||||
freeblock = POINTERMASK & *fbl_np;
|
||||
if (base == f) {
|
||||
if (base == freeblock)
|
||||
*fbl_np = NIL;
|
||||
|
||||
LispPTR deleteblock(LispPTR base) {
|
||||
struct arrayblock *bbase, *fbbase, *bbbase;
|
||||
LispPTR fwd, bkwd, fbl, freeblocklsp;
|
||||
LispPTR *freeblock;
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
if ((bbase->arlen >= MINARRAYBLOCKSIZE) && (bbase->fwd != NIL)) {
|
||||
fwd = bbase->fwd;
|
||||
fbbase = (struct arrayblock *)NativeAligned4FromLAddr(fwd);
|
||||
bkwd = bbase->bkwd;
|
||||
bbbase = (struct arrayblock *)NativeAligned4FromLAddr(bkwd);
|
||||
fbl = FreeBlockChainN(bbase->arlen);
|
||||
freeblock = (LispPTR *)NativeAligned4FromLAddr(fbl);
|
||||
freeblocklsp = POINTERMASK & *freeblock;
|
||||
if (base == fwd) {
|
||||
if (base == freeblocklsp)
|
||||
*freeblock = NIL;
|
||||
else
|
||||
error("GC error:deleting last list # FREEBLOCKLIST\n");
|
||||
return;
|
||||
} else if (base == freeblock)
|
||||
*fbl_np = f;
|
||||
f_np->bkwd = b;
|
||||
b_np->fwd = f;
|
||||
return (NIL);
|
||||
} else if (base == freeblocklsp)
|
||||
*freeblock = fwd;
|
||||
fbbase->bkwd = bkwd;
|
||||
bbbase->fwd = fwd;
|
||||
}
|
||||
return (NIL);
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
@@ -320,53 +289,34 @@ static void deleteblock(LispPTR base) {
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
/*
|
||||
* Links a block onto the free list for a particular size range.
|
||||
* The free list is maintained as a doubly linked circular list accessed
|
||||
* from the block pointed to by the free list bucket for the size.
|
||||
* If there are no blocks in the free list bucket then the forward and
|
||||
* backward pointers of the newly added block point to the block itself.
|
||||
*/
|
||||
static LispPTR linkblock(LispPTR base) {
|
||||
struct arrayblock *base_np, *freeblock_np, *tail_np;
|
||||
LispPTR fbl, freeblock;
|
||||
LispPTR *fbl_np;
|
||||
|
||||
if (*FreeBlockBuckets_word == NIL)
|
||||
return (base);
|
||||
|
||||
base_np = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
if (base_np->arlen < MINARRAYBLOCKSIZE) {
|
||||
checkarrayblock(base, T, NIL);
|
||||
return (base);
|
||||
LispPTR linkblock(LispPTR base) {
|
||||
struct arrayblock *bbase, *fbbase, *tmpbase;
|
||||
LispPTR fbl, freeblocklsp;
|
||||
LispPTR *freeblock;
|
||||
if (*FreeBlockBuckets_word != NIL) {
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
if (bbase->arlen < MINARRAYBLOCKSIZE)
|
||||
checkarrayblock(base, T, NIL);
|
||||
else {
|
||||
fbl = FreeBlockChainN(bbase->arlen);
|
||||
freeblock = (LispPTR *)NativeAligned4FromLAddr(POINTERMASK & fbl);
|
||||
freeblocklsp = POINTERMASK & (*freeblock);
|
||||
if (freeblocklsp == NIL) {
|
||||
bbase->fwd = base;
|
||||
bbase->bkwd = base;
|
||||
} else {
|
||||
fbbase = (struct arrayblock *)NativeAligned4FromLAddr(freeblocklsp);
|
||||
bbase->fwd = freeblocklsp;
|
||||
bbase->bkwd = fbbase->bkwd;
|
||||
tmpbase = (struct arrayblock *)NativeAligned4FromLAddr(fbbase->bkwd);
|
||||
tmpbase->fwd = base;
|
||||
fbbase->bkwd = base;
|
||||
}
|
||||
*freeblock = base;
|
||||
checkarrayblock(base, T, T);
|
||||
}
|
||||
}
|
||||
|
||||
/* lisp pointer to bucket for size */
|
||||
fbl = FreeBlockChainN(base_np->arlen);
|
||||
/* native pointer to bucket */
|
||||
fbl_np = (LispPTR *)NativeAligned4FromLAddr(POINTERMASK & fbl);
|
||||
/* lisp pointer to first free block on chain */
|
||||
freeblock = POINTERMASK & (*fbl_np);
|
||||
if (freeblock == NIL) { /* no blocks already in chain */
|
||||
base_np->fwd = base;
|
||||
base_np->bkwd = base;
|
||||
} else {
|
||||
/* set up new block to be first free block on the chain */
|
||||
freeblock_np = (struct arrayblock *)NativeAligned4FromLAddr(freeblock);
|
||||
/* link new block forward to free block */
|
||||
base_np->fwd = freeblock;
|
||||
/* new block's backward link becomes free block's backward link */
|
||||
base_np->bkwd = freeblock_np->bkwd;
|
||||
/* get the tail location (backward pointer of freelist head) */
|
||||
tail_np = (struct arrayblock *)NativeAligned4FromLAddr(freeblock_np->bkwd);
|
||||
/* set its forward pointer to new block */
|
||||
tail_np->fwd = base;
|
||||
/* and the update the free block's backward link to new block */
|
||||
freeblock_np->bkwd = base;
|
||||
}
|
||||
/* new block becomes the head of the free list */
|
||||
*fbl_np = base;
|
||||
checkarrayblock(base, T, T); /* free, and on free list */
|
||||
return (base);
|
||||
}
|
||||
|
||||
@@ -380,26 +330,17 @@ static LispPTR linkblock(LispPTR base) {
|
||||
|
||||
LispPTR makefreearrayblock(LispPTR block, DLword length) {
|
||||
LispPTR trailer;
|
||||
struct arrayblock *block_np, *trailer_np;
|
||||
struct abdum *flags_np;
|
||||
block_np = (struct arrayblock *)NativeAligned4FromLAddr(block);
|
||||
/* this is an appropriate place to test whether the block that
|
||||
is about to be freed contains words that look like valid
|
||||
array header/trailer pairs as data. This may result in
|
||||
false positives, but could help if there's a real smash happening.
|
||||
*/
|
||||
/* struct abdum's abflags is a DLword and does not account for
|
||||
the BYTESWAP setup (as arrayblock does), so use WORDPTR to
|
||||
pick the correct word of the cell
|
||||
*/
|
||||
flags_np = (struct abdum *)WORDPTR(block_np);
|
||||
flags_np->abflags = FREEARRAYFLAGWORD;
|
||||
block_np->arlen = length;
|
||||
trailer = Trailer(block, block_np);
|
||||
trailer_np = (struct arrayblock *)NativeAligned4FromLAddr(trailer);
|
||||
flags_np = (struct abdum *)WORDPTR(trailer_np);
|
||||
flags_np->abflags = FREEARRAYFLAGWORD;
|
||||
trailer_np->arlen = length;
|
||||
struct arrayblock *bbase;
|
||||
struct abdum *dbase;
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(block);
|
||||
dbase = (struct abdum *)WORDPTR(bbase);
|
||||
dbase->abflags = FREEARRAYFLAGWORD;
|
||||
bbase->arlen = length;
|
||||
trailer = Trailer(block, bbase);
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(trailer);
|
||||
dbase = (struct abdum *)WORDPTR(bbase);
|
||||
dbase->abflags = FREEARRAYFLAGWORD;
|
||||
bbase->arlen = length;
|
||||
return (block);
|
||||
}
|
||||
|
||||
@@ -410,13 +351,13 @@ LispPTR makefreearrayblock(LispPTR block, DLword length) {
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
static LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
|
||||
LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
|
||||
DLword arlens, narlens, secondbite, minblocksize, shaveback;
|
||||
struct arrayblock *base_np, *nbase_np;
|
||||
base_np = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
nbase_np = (struct arrayblock *)NativeAligned4FromLAddr(nbase);
|
||||
arlens = base_np->arlen;
|
||||
narlens = nbase_np->arlen;
|
||||
struct arrayblock *bbase, *bnbase;
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
bnbase = (struct arrayblock *)NativeAligned4FromLAddr(nbase);
|
||||
arlens = bbase->arlen;
|
||||
narlens = bnbase->arlen;
|
||||
secondbite = MAXARRAYBLOCKSIZE - arlens;
|
||||
/* There are three cases for merging the blocks
|
||||
* (1) the total size of the two blocks is less than max:
|
||||
@@ -426,7 +367,7 @@ static LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
|
||||
* (3) creating a max size block leaves a non-viable leftover block
|
||||
* move the boundary to make a big block and a minimum size leftover block
|
||||
*/
|
||||
if (base + (DLWORDSPER_CELL * arlens) != nbase) {
|
||||
if (base + (2 * arlens) != nbase) {
|
||||
error("Attempt to merge non-adjacent blocks in array space\n");
|
||||
}
|
||||
if (narlens > secondbite) { /* (2) or (3) */
|
||||
@@ -440,7 +381,7 @@ static LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
|
||||
arlens += shaveback;
|
||||
secondbite += shaveback;
|
||||
}
|
||||
linkblock(makefreearrayblock(nbase + DLWORDSPER_CELL * secondbite, narlens));
|
||||
linkblock(makefreearrayblock(nbase + 2 * secondbite, narlens));
|
||||
narlens = 0;
|
||||
}
|
||||
return (linkblock(makefreearrayblock(base, arlens + narlens)));
|
||||
@@ -454,34 +395,18 @@ static LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
/*
|
||||
* merges this block into the block behind it, unless there are
|
||||
* disqualifying conditions:
|
||||
* merging is turned off or
|
||||
* this is the first block in array space or
|
||||
* this is the first block in the 2nd array space or
|
||||
* the block behind it is in use
|
||||
* in which case it is linked onto the freelist (fwd and backward pointers)
|
||||
* and added to the free block chain by size.
|
||||
* If it can be merged,
|
||||
*/
|
||||
LispPTR mergebackward(LispPTR base) {
|
||||
LispPTR pbase;
|
||||
struct arrayblock *ptrailer_np;
|
||||
struct arrayblock *ptrailer;
|
||||
|
||||
if (base == NIL)
|
||||
return (NIL);
|
||||
/* back up to get the trailer of the previous block */
|
||||
ptrailer_np = (struct arrayblock *)NativeAligned4FromLAddr(base - ARRAYBLOCKTRAILERWORDS);
|
||||
/* check that there are no disqualifying conditions for merging with previous block */
|
||||
ptrailer = (struct arrayblock *)NativeAligned4FromLAddr(base - ARRAYBLOCKTRAILERWORDS);
|
||||
if ((*ArrayMerging_word == NIL) ||
|
||||
((base == *ArraySpace_word) || ((base == *ArraySpace2_word) || (ptrailer_np->inuse == T))))
|
||||
((base == *ArraySpace_word) || ((base == *ArraySpace2_word) || (ptrailer->inuse == T))))
|
||||
return (linkblock(base));
|
||||
/* back up to the header of the previous block */
|
||||
pbase = base - DLWORDSPER_CELL * ptrailer_np->arlen;
|
||||
/* check that it is free, but skip free list checks */
|
||||
pbase = base - 2 * ptrailer->arlen;
|
||||
checkarrayblock(pbase, T, NIL);
|
||||
/* remove it from the free list */
|
||||
deleteblock(pbase);
|
||||
return (arrayblockmerger(pbase, base));
|
||||
}
|
||||
@@ -496,17 +421,17 @@ LispPTR mergebackward(LispPTR base) {
|
||||
|
||||
LispPTR mergeforward(LispPTR base) {
|
||||
LispPTR nbase, nbinuse;
|
||||
struct arrayblock *base_np, *nbase_np;
|
||||
struct arrayblock *bbase, *bnbase;
|
||||
if (*ArrayMerging_word == NIL) return NIL;
|
||||
if (base == NIL) return NIL;
|
||||
if (checkarrayblock(base, T, T)) return NIL;
|
||||
|
||||
base_np = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
nbase = base + DLWORDSPER_CELL * (base_np->arlen);
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
nbase = base + 2 * (bbase->arlen);
|
||||
if (nbase == *ArrayFrLst_word || nbase == *ArrayFrLst2_word) return NIL;
|
||||
|
||||
nbase_np = (struct arrayblock *)NativeAligned4FromLAddr(nbase);
|
||||
nbinuse = nbase_np->inuse;
|
||||
bnbase = (struct arrayblock *)NativeAligned4FromLAddr(nbase);
|
||||
nbinuse = bnbase->inuse;
|
||||
if (checkarrayblock(nbase, !nbinuse, NIL)) return NIL;
|
||||
if (nbinuse) return (NIL);
|
||||
deleteblock(nbase);
|
||||
@@ -521,13 +446,10 @@ LispPTR mergeforward(LispPTR base) {
|
||||
/* Reclaim a block of storage in the array-space heap. */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
/*
|
||||
* The pointer passed is to the data of the block, not the array block
|
||||
* header.
|
||||
*/
|
||||
|
||||
LispPTR reclaimarrayblock(LispPTR ptr) {
|
||||
LispPTR tmpptr, btrailer;
|
||||
struct arrayblock *base_np;
|
||||
struct arrayblock *base;
|
||||
LispPTR *tmpp;
|
||||
int reclaim_p;
|
||||
|
||||
@@ -536,7 +458,7 @@ LispPTR reclaimarrayblock(LispPTR ptr) {
|
||||
checkarrayblock(ptr - ARRAYBLOCKHEADERWORDS, NIL, NIL);
|
||||
#endif /* ARRAYCHECK */
|
||||
|
||||
base_np = (struct arrayblock *)NativeAligned4FromLAddr(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
base = (struct arrayblock *)NativeAligned4FromLAddr(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
#ifdef ARRAYCHECK
|
||||
if (HILOC(ptr) < FIRSTARRAYSEGMENT) {
|
||||
printarrayblock(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
@@ -544,11 +466,11 @@ LispPTR reclaimarrayblock(LispPTR ptr) {
|
||||
"Bad array block reclaimed [not in array space].\nContinue with 'q' but save state ASAP. "
|
||||
"\n");
|
||||
return (T);
|
||||
} else if (ARRAYBLOCKPASSWORD != base_np->password) {
|
||||
} else if (ARRAYBLOCKPASSWORD != base->password) {
|
||||
printarrayblock(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
error("Bad array block reclaimed [password wrong].\nContinue with 'q' but save state ASAP. \n");
|
||||
return (T);
|
||||
} else if (base_np->inuse == NIL) {
|
||||
} else if (base->inuse == NIL) {
|
||||
printarrayblock(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
error(
|
||||
"Bad array block reclaimed [block not in use].\nContinue with 'q' but save state ASAP. \n");
|
||||
@@ -557,15 +479,15 @@ LispPTR reclaimarrayblock(LispPTR ptr) {
|
||||
#else
|
||||
/* Normal case, just tell the guy something's wrong: */
|
||||
if ((HILOC(ptr) < FIRSTARRAYSEGMENT) ||
|
||||
((ARRAYBLOCKPASSWORD != base_np->password) || (base_np->inuse == NIL))) {
|
||||
((ARRAYBLOCKPASSWORD != base->password) || (base->inuse == NIL))) {
|
||||
error("Bad array block reclaimed--continue with 'q' but save state ASAP. \n");
|
||||
return (T);
|
||||
}
|
||||
#endif /* ARRAYCHECK */
|
||||
|
||||
switch (base_np->gctype) {
|
||||
switch (base->gctype) {
|
||||
case PTRBLOCK_GCT: {
|
||||
btrailer = (ptr - 2) + DLWORDSPER_CELL * (base_np->arlen - ARRAYBLOCKTRAILERCELLS);
|
||||
btrailer = (ptr - 2) + 2 * (base->arlen - ARRAYBLOCKTRAILERCELLS);
|
||||
tmpptr = ptr;
|
||||
do {
|
||||
tmpp = (LispPTR *)NativeAligned4FromLAddr(tmpptr);
|
||||
@@ -582,7 +504,7 @@ LispPTR reclaimarrayblock(LispPTR ptr) {
|
||||
/* default: No Action */
|
||||
}
|
||||
if (reclaim_p == T)
|
||||
mergeforward(mergebackward(makefreearrayblock(ptr - ARRAYBLOCKHEADERWORDS, base_np->arlen)));
|
||||
mergeforward(mergebackward(makefreearrayblock(ptr - ARRAYBLOCKHEADERWORDS, base->arlen)));
|
||||
return (T);
|
||||
}
|
||||
|
||||
@@ -614,62 +536,31 @@ LispPTR reclaimstackp(LispPTR ptr) /* This is the entry function */
|
||||
/************************************************************************/
|
||||
|
||||
void printarrayblock(LispPTR base) {
|
||||
struct arrayblock *base_np, *trailer_np, *ptrailer_np;
|
||||
struct arrayblock *bbase, *btrailer, *ptrailer;
|
||||
LispPTR *addr;
|
||||
|
||||
LispPTR pbase, nbase;
|
||||
|
||||
base_np = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
trailer_np = (struct arrayblock *)NativeAligned4FromLAddr(Trailer(base, base_np));
|
||||
ptrailer_np = (struct arrayblock *)NativeAligned4FromLAddr(base - ARRAYBLOCKTRAILERWORDS);
|
||||
bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
|
||||
btrailer = (struct arrayblock *)NativeAligned4FromLAddr(Trailer(base, bbase));
|
||||
ptrailer = (struct arrayblock *)NativeAligned4FromLAddr(base - ARRAYBLOCKTRAILERWORDS);
|
||||
|
||||
nbase = base + DLWORDSPER_CELL * base_np->arlen;
|
||||
pbase = base - DLWORDSPER_CELL * ptrailer_np->arlen;
|
||||
nbase = base + 2 * bbase->arlen;
|
||||
pbase = base - 2 * ptrailer->arlen;
|
||||
|
||||
printf("This array block: 0x%x. Previous: 0x%x. Next: 0x%x.\n", base, pbase, nbase);
|
||||
printf(" password: 0x%x gctype: 0x%x in use: %d\n", base_np->password,
|
||||
base_np->gctype, base_np->inuse);
|
||||
if (!base_np->inuse)
|
||||
printf(" Free list: fwd 0x%x bkwd 0x%x\n", base_np->fwd, base_np->bkwd);
|
||||
printf(" Header Length: %d cells.\n\n", base_np->arlen);
|
||||
printf(" Trailer Length: %d cells.\n\n", trailer_np->arlen);
|
||||
printf(" Length: %d cells.\n\n", bbase->arlen);
|
||||
|
||||
addr = ((LispPTR *)base_np) - 20;
|
||||
for (; addr < (LispPTR *)base_np; addr++) printf("%16p (0x%8x) %8x\n", (void *)addr, LAddrFromNative(addr), *addr);
|
||||
printf("%16p (0x%8x) %8x <- array header\n", (void *)addr, LAddrFromNative(addr), *addr);
|
||||
addr = ((LispPTR *)bbase) - 20;
|
||||
for (; addr < (LispPTR *)bbase; addr++) printf("%16p %8x\n", (void *)addr, *addr);
|
||||
printf("%16p %8x <- array header\n", (void *)addr, *addr);
|
||||
addr++;
|
||||
for (; addr < (LispPTR *)base_np + 20; addr++) printf("%16p (0x%8x) %8x\n", (void *)addr, LAddrFromNative(addr), *addr);
|
||||
for (; addr < (LispPTR *)bbase + 20; addr++) printf("%16p %8x\n", (void *)addr, *addr);
|
||||
printf(". . .\n");
|
||||
|
||||
addr = ((LispPTR *)trailer_np) - 20;
|
||||
for (; addr < (LispPTR *)trailer_np; addr++) printf("%16p (0x%8x) %8x\n", (void *)addr, LAddrFromNative(addr), *addr);
|
||||
printf("%16p (0x%8x) %8x <- array trailer\n", (void *)addr, LAddrFromNative(addr), *addr);
|
||||
addr = ((LispPTR *)btrailer) - 20;
|
||||
for (; addr < (LispPTR *)btrailer; addr++) printf("%16p %8x\n", (void *)addr, *addr);
|
||||
printf("%16p %8x <- array trailer\n", (void *)addr, *addr);
|
||||
addr++;
|
||||
for (; addr < (LispPTR *)trailer_np + 20; addr++) printf("%16p (0x%8x) %8x\n", (void *)addr, LAddrFromNative(addr), *addr);
|
||||
}
|
||||
|
||||
static void printfreeblockchainhead(int index)
|
||||
{
|
||||
LispPTR fbl, freeblock;
|
||||
LispPTR *fbl_np;
|
||||
|
||||
fbl = POINTERMASK & ((*FreeBlockBuckets_word) + (DLWORDSPER_CELL * index));
|
||||
fbl_np = (LispPTR *)NativeAligned4FromLAddr(fbl);
|
||||
/* lisp pointer to free block on chain */
|
||||
freeblock = POINTERMASK & (*fbl_np);
|
||||
if (freeblock == NIL) { /* no blocks in chain */
|
||||
printf("Free block chain (bucket %d): NIL\n", index);
|
||||
} else {
|
||||
printf("Free block chain(bucket %d): 0x%x\n", index, freeblock);
|
||||
}
|
||||
}
|
||||
|
||||
void printfreeblockchainn(int arlen)
|
||||
{
|
||||
if (arlen >= 0) {
|
||||
printfreeblockchainhead(BucketIndex(arlen));
|
||||
return;
|
||||
} else
|
||||
for (int i = 0; i <= MAXBUCKETINDEX; i++) {
|
||||
printfreeblockchainhead(i);
|
||||
}
|
||||
for (; addr < (LispPTR *)btrailer + 20; addr++) printf("%16p %8x\n", (void *)addr, *addr);
|
||||
}
|
||||
|
||||
@@ -28,6 +28,7 @@
|
||||
#include "kbdsubrsdefs.h"
|
||||
#include "commondefs.h"
|
||||
#ifdef XWINDOW
|
||||
#include "lisp2cdefs.h"
|
||||
#include "xwinmandefs.h"
|
||||
#endif
|
||||
|
||||
|
||||
10
src/kprint.c
10
src/kprint.c
@@ -98,12 +98,10 @@ void prindatum(LispPTR x) {
|
||||
break;
|
||||
case TYPE_ONED_ARRAY:
|
||||
case TYPE_GENERAL_ARRAY:
|
||||
/* this should probably use array.h's arrayheader */
|
||||
newstring = (NEWSTRINGP *)NativeAligned4FromLAddr(x);
|
||||
if (newstring->stringp) {
|
||||
print_NEWstring(x);
|
||||
}
|
||||
/* it would be useful to print non-string arrays, too */
|
||||
break;
|
||||
default: dtd_base = (struct dtd *)GetDTD(typen); printf("{");
|
||||
#ifdef BIGVM
|
||||
@@ -175,20 +173,14 @@ void print_string(LispPTR x) {
|
||||
void print_NEWstring(LispPTR x) {
|
||||
NEWSTRINGP *string_point;
|
||||
DLword st_length;
|
||||
DLword st_offset;
|
||||
DLbyte *string_base;
|
||||
|
||||
int i;
|
||||
|
||||
string_point = (NEWSTRINGP *)NativeAligned4FromLAddr(x);
|
||||
st_length = string_point->fillpointer;
|
||||
st_offset = string_point->offset;
|
||||
if (string_point->indirectp) {
|
||||
/* base points to another array header not the raw storage */
|
||||
string_point = (NEWSTRINGP *)NativeAligned4FromLAddr(string_point->base);
|
||||
}
|
||||
string_base = (DLbyte *)NativeAligned2FromLAddr(string_point->base);
|
||||
string_base += st_offset;
|
||||
string_base += string_point->offset;
|
||||
|
||||
printf("%c", DOUBLEQUOTE); /* print %" */
|
||||
|
||||
|
||||
@@ -200,7 +200,7 @@ int main(int argc, char *argv[]) {
|
||||
goto I_Give_Up;
|
||||
}
|
||||
bcopy(if_data.ifc_req[0].ifr_addr.sa_data, ether_host, 6);
|
||||
strlcpy(Ename, if_data.ifc_req[0].ifr_name, sizeof(Ename));
|
||||
strcpy(Ename, if_data.ifc_req[0].ifr_name);
|
||||
|
||||
fcntl(ether_fd, F_SETFL, fcntl(ether_fd, F_GETFL, 0) | O_ASYNC | O_NONBLOCK);
|
||||
|
||||
|
||||
@@ -216,8 +216,8 @@ unsigned sysout_loader(const char *sysout_file_name, unsigned sys_size) {
|
||||
}
|
||||
|
||||
if ((stat_buf.st_size & (BYTESPER_PAGE - 1)) != 0)
|
||||
printf("CAUTION::not an integral number of pages. sysout & 0x%x = 0x%x\n",
|
||||
BYTESPER_PAGE - 1, (int)(stat_buf.st_size & (BYTESPER_PAGE - 1)));
|
||||
printf("CAUTION::not an integral number of pages. sysout & 0x1ff = 0x%x\n",
|
||||
(int)(stat_buf.st_size & (BYTESPER_PAGE - 1)));
|
||||
|
||||
if (ifpage.nactivepages != (sysout_size / 2)) {
|
||||
printf("sysout_loader:IFPAGE says sysout size is %d\n", ifpage.nactivepages);
|
||||
|
||||
@@ -38,8 +38,6 @@ int LispStringSimpleLength(LispPTR lispstring) {
|
||||
return (arrayp->fillpointer);
|
||||
}
|
||||
|
||||
/* XXX: this string conversion is NOT useable on byte-swapped (little-endian) machines
|
||||
*/
|
||||
void LispStringToCStr(LispPTR lispstring, char *cstring) {
|
||||
OneDArray *arrayp;
|
||||
char *base;
|
||||
|
||||
@@ -315,7 +315,7 @@ const char *nethubHelpstring =
|
||||
const char *nethubHelpstring = "";
|
||||
#endif
|
||||
|
||||
#if defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
#if MAIKO_OS_LINUX || defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
extern int insnsCountdownForTimerAsyncEmulation;
|
||||
#endif
|
||||
|
||||
@@ -601,7 +601,7 @@ int main(int argc, char *argv[])
|
||||
}
|
||||
#endif /* MAIKO_ENABLE_NETHUB */
|
||||
|
||||
#if defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
#if MAIKO_OS_LINUX || defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
else if (!strcmp(argv[i], "-intr-emu-insns")) {
|
||||
if (argc > ++i) {
|
||||
errno = 0;
|
||||
|
||||
@@ -233,13 +233,15 @@ LispPTR mess_read(LispPTR *args)
|
||||
struct stat sbuf;
|
||||
int size, save_size;
|
||||
char *base;
|
||||
LispPTR *naddress;
|
||||
int i;
|
||||
static char temp_buf[MESSAGE_BUFFER_SIZE];
|
||||
|
||||
SETJMP(NIL);
|
||||
|
||||
/* Get buff address from LISP */
|
||||
STRING_BASE(args[0], base);
|
||||
naddress = (LispPTR *)(NativeAligned4FromLAddr(args[0]));
|
||||
base = (char *)(NativeAligned2FromLAddr(((OneDArray *)naddress)->base));
|
||||
|
||||
close(log_id);
|
||||
TIMEOUT(log_id = open(logfile, O_RDONLY));
|
||||
@@ -281,7 +283,7 @@ LispPTR mess_read(LispPTR *args)
|
||||
if (temp_buf[i] == '\n') temp_buf[i] = '\000';
|
||||
}
|
||||
/* COPY actual Lisp Buffer(for BYTESWAP magic) */
|
||||
MemCpyToLispFromNative(base, temp_buf, size);
|
||||
StrNCpyFromCToLisp(base, temp_buf, size);
|
||||
|
||||
return (GetSmallp(size));
|
||||
#else
|
||||
|
||||
12
src/timer.c
12
src/timer.c
@@ -454,6 +454,11 @@ static void int_timer_service(int sig)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
#if MAIKO_OS_LINUX
|
||||
// for WSL1, which doesn't support setitimer(ITIMER_VIRTUAL ...)
|
||||
int linux_emulate_timer = 0;
|
||||
#endif /* MAIKO_OS_LINUX */
|
||||
|
||||
static void int_timer_init(void)
|
||||
|
||||
{
|
||||
@@ -489,6 +494,11 @@ static void int_timer_init(void)
|
||||
/* then attach a timer to it and turn it loose */
|
||||
timert.it_interval.tv_sec = timert.it_value.tv_sec = 0;
|
||||
timert.it_interval.tv_usec = timert.it_value.tv_usec = TIMER_INTERVAL;
|
||||
|
||||
#if MAIKO_OS_LINUX
|
||||
// (For WSL1) Capture error output from setittimer to indicate need to emulate timer
|
||||
linux_emulate_timer =
|
||||
#endif /* MAIKO_OS_LINUX */
|
||||
setitimer(ITIMER_VIRTUAL, &timert, NULL);
|
||||
|
||||
DBPRINT(("Timer interval set to %ld usec\n", (long)timert.it_value.tv_usec));
|
||||
@@ -499,7 +509,7 @@ static void int_timer_init(void)
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/*
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
|
||||
395
src/ufs.c
395
src/ufs.c
@@ -9,7 +9,6 @@
|
||||
|
||||
#include "version.h"
|
||||
|
||||
#include <ctype.h>
|
||||
#include <errno.h>
|
||||
#include <fcntl.h>
|
||||
#include <setjmp.h>
|
||||
@@ -177,9 +176,9 @@ LispPTR UFS_getfilename(LispPTR *args)
|
||||
* unixpathname specifies it.
|
||||
*/
|
||||
#ifdef DOS
|
||||
if (unixpathname(lfname, file, sizeof(file), 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(lfname, file, 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
#else
|
||||
if (unixpathname(lfname, file, sizeof(file), 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(lfname, file, 0, 0) == 0) return (NIL);
|
||||
#endif /* DOS */
|
||||
|
||||
switch (args[1]) {
|
||||
@@ -201,7 +200,7 @@ LispPTR UFS_getfilename(LispPTR *args)
|
||||
case RECOG_NON:
|
||||
/*
|
||||
* "New" file means the "not existing" file. UNIX device always
|
||||
* recognizes a not existing file as is, the subsequent OPENFILE will
|
||||
* recognizes a not existing file as if, the subsequent OPENFILE will
|
||||
* find the truth.
|
||||
* "Non" recognition is used to recognize a sysout file.
|
||||
*/
|
||||
@@ -211,15 +210,15 @@ LispPTR UFS_getfilename(LispPTR *args)
|
||||
* Now, we convert a file name back to Lisp format. The version field have not
|
||||
* to be converted. The fourth argument for lisppathname specifies it.
|
||||
*/
|
||||
if (lisppathname(file, lfname, sizeof(lfname), 0, 0) == 0) return (NIL);
|
||||
if (lisppathname(file, lfname, 0, 0) == 0) return (NIL);
|
||||
|
||||
STRING_BASE(args[2], base);
|
||||
len = strlen(lfname);
|
||||
|
||||
#ifndef BYTESWAP
|
||||
strncpy(base, lfname, len);
|
||||
strncpy(base, lfname, len + 1);
|
||||
#else
|
||||
MemCpyToLispFromNative(base, lfname, len);
|
||||
StrNCpyFromCToLisp(base, lfname, len + 1);
|
||||
#endif /* BYTESWAP */
|
||||
|
||||
return (GetSmallp(len));
|
||||
@@ -260,9 +259,9 @@ LispPTR UFS_deletefile(LispPTR *args)
|
||||
LispStringToCString(args[0], fbuf, MAXPATHLEN);
|
||||
|
||||
#ifdef DOS
|
||||
if (unixpathname(fbuf, file, sizeof(file), 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(fbuf, file, 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
#else
|
||||
if (unixpathname(fbuf, file, sizeof(file), 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(fbuf, file, 0, 0) == 0) return (NIL);
|
||||
#endif /* DOS */
|
||||
/* check if we're operating on directory or file */
|
||||
TIMEOUT(rval = stat(file, &sbuf));
|
||||
@@ -328,15 +327,15 @@ LispPTR UFS_renamefile(LispPTR *args)
|
||||
|
||||
LispStringToCString(args[0], fbuf, MAXPATHLEN);
|
||||
#ifdef DOS
|
||||
if (unixpathname(fbuf, src, sizeof(src), 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(fbuf, src, 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
#else
|
||||
if (unixpathname(fbuf, src, sizeof(src), 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(fbuf, src, 0, 0) == 0) return (NIL);
|
||||
#endif /* DOS */
|
||||
LispStringToCString(args[1], fbuf, MAXPATHLEN);
|
||||
#ifdef DOS
|
||||
if (unixpathname(fbuf, dst, sizeof(dst), 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(fbuf, dst, 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
#else
|
||||
if (unixpathname(fbuf, dst, sizeof(dst), 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(fbuf, dst, 0, 0) == 0) return (NIL);
|
||||
#endif /* DOS */
|
||||
|
||||
TIMEOUT(rval = rename(src, dst));
|
||||
@@ -401,9 +400,9 @@ LispPTR UFS_directorynamep(LispPTR *args)
|
||||
|
||||
/* Convert Xerox Lisp file naming convention to Unix one. */
|
||||
#ifdef DOS
|
||||
if (unixpathname(dirname, fullname, sizeof(fullname), 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(dirname, fullname, 0, 0, 0, 0, 0) == 0) return (NIL);
|
||||
#else
|
||||
if (unixpathname(dirname, fullname, sizeof(fullname), 0, 0) == 0) return (NIL);
|
||||
if (unixpathname(dirname, fullname, 0, 0) == 0) return (NIL);
|
||||
#endif /* DOS */
|
||||
|
||||
TIMEOUT(rval = stat(fullname, &sbuf));
|
||||
@@ -415,109 +414,20 @@ LispPTR UFS_directorynamep(LispPTR *args)
|
||||
if (!S_ISDIR(sbuf.st_mode)) return (NIL);
|
||||
|
||||
/* Convert Unix file naming convention to Xerox Lisp one. */
|
||||
if (lisppathname(fullname, dirname, sizeof(dirname), 1, 0) == 0) return (NIL);
|
||||
if (lisppathname(fullname, dirname, 1, 0) == 0) return (NIL);
|
||||
|
||||
len = strlen(dirname);
|
||||
STRING_BASE(args[1], base);
|
||||
|
||||
#ifndef BYTESWAP
|
||||
strncpy(base, dirname, len);
|
||||
strncpy(base, dirname, len + 1);
|
||||
#else
|
||||
MemCpyToLispFromNative(base, dirname, len);
|
||||
StrNCpyFromCToLisp(base, dirname, len + 1);
|
||||
#endif /* BYTESWAP */
|
||||
|
||||
return (GetSmallp(len));
|
||||
}
|
||||
|
||||
/*
|
||||
* Name: UnixVersionToLispVersion
|
||||
*
|
||||
* Argument: char *pathname
|
||||
* size_t pathsize
|
||||
* int vlessp
|
||||
*
|
||||
* Description:
|
||||
*
|
||||
* Converts the Unix version in pathname to a Lisp syntax version.
|
||||
* If there is no recognizable version present, and vlessp is not
|
||||
* true then a Lisp version 1 (";1") will be added to the name.
|
||||
*
|
||||
* Initially only the "standard" .~nnn~ form of a version is recognized.
|
||||
* It may be possible in the future to recognize IFS "!nnn"
|
||||
*/
|
||||
|
||||
void UnixVersionToLispVersion(char *pathname, size_t pathsize, int vlessp) {
|
||||
char *ep = &pathname[strlen(pathname) - 1];
|
||||
char *uvp;
|
||||
|
||||
#ifdef IFSVERSION
|
||||
if (isdigit(*ep)) goto maybeifsversion; /* possibly foo!## */
|
||||
#endif
|
||||
if (*ep-- != '~') goto noversion; /* definitely not .~###~ */
|
||||
if (!isdigit(*ep)) goto noversion; /* requires at least one digit */
|
||||
while (isdigit(*ep)) ep--; /* consume all digits */
|
||||
if (*ep-- != '~') goto noversion; /* definitely not .~###~ */
|
||||
if (*ep != '.') goto noversion;
|
||||
/* must end .~###~ and ep points at the dot */
|
||||
*ep++ = ';'; /* smash . to ; and point to ~ where version will go*/
|
||||
for (uvp = ep + 1; *uvp == '0' && *(uvp + 1) != '~'; uvp++); /* skip leading zeroes */
|
||||
while (*uvp != '~') *ep++ = *uvp++; /* shift version back */
|
||||
*ep = '\0'; /* terminate the string */
|
||||
return;
|
||||
noversion:
|
||||
if (!vlessp) strlcat(pathname, ";1", pathsize);
|
||||
return;
|
||||
#ifdef IFSVERSION
|
||||
maybeifsversion:
|
||||
while (isdigit(*ep)) ep--; /* consume all digits */
|
||||
if (*ep != '!') goto noversion;
|
||||
*ep = ';';
|
||||
return;
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
* Name: LispVersionToUnixVersion
|
||||
*
|
||||
* Arguments: char *pathname Xerox Lisp style pathname
|
||||
* size_t pathsize Length of pathname buffer
|
||||
*
|
||||
* Helper procedure used by unixpathname to convert from a Lisp style path
|
||||
* with ";version" style version number to the ".~version~" format used in
|
||||
* the underlying host file system.
|
||||
* If a syntactically correct version (all numeric, starting at the rightmost
|
||||
* unescaped (') semicolon) is found it will be replaced by the host version,
|
||||
* otherwise the procedure will return the pathname unchanged.
|
||||
*
|
||||
*/
|
||||
void LispVersionToUnixVersion(char *pathname, size_t pathsize) {
|
||||
char version[VERSIONLEN] = {0};
|
||||
char *vp = NULL;
|
||||
char *ep = &pathname[strlen(pathname) - 1]; /* from the end */
|
||||
while (ep >= pathname) { /* until the beginning */
|
||||
if (*ep == ';' && /* found a semicolon */
|
||||
(ep == pathname || *(ep - 1) != '\'')) {/* at the beginning or not quoted */
|
||||
vp = ep; /* version starts at unquoted semicolon */
|
||||
break; /* stop when found version */
|
||||
}
|
||||
ep--; /* previous character */
|
||||
}
|
||||
|
||||
if (vp == NULL) return; /* there was no version field */
|
||||
|
||||
*vp++ = '\0'; /* end name at the semicolon */
|
||||
if (*vp == '\0') return; /* empty version field */
|
||||
|
||||
while (*vp == '0') vp++; /* skip leading zeros */
|
||||
if (*vp == '\0') return; /* all zero version is no version */
|
||||
version[0] = '.'; /* leading version marker */
|
||||
version[1] = '~'; /* leading version marker */
|
||||
strlcat(version, vp, VERSIONLEN); /* the trimmed version from the source */
|
||||
strlcat(version, "~", VERSIONLEN); /* trailing version marker */
|
||||
strlcat(pathname, version, pathsize); /* concatenate version to pathname */
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
* Name: unixpathname
|
||||
*
|
||||
@@ -527,7 +437,6 @@ void LispVersionToUnixVersion(char *pathname, size_t pathsize) {
|
||||
* if the pathname is passed as a directory, the
|
||||
* tail delimiter may be included.
|
||||
* char *dst The buffer to which the converted pathname is stored.
|
||||
* int dstlen The size of the dst buffer
|
||||
* int versionp
|
||||
* If 1, version field in src is converted to UNIX
|
||||
* version form. {DSK} device invokes unixpathname
|
||||
@@ -554,9 +463,9 @@ void LispVersionToUnixVersion(char *pathname, size_t pathsize) {
|
||||
*
|
||||
*/
|
||||
#ifdef DOS
|
||||
int unixpathname(char *src, char *dst, int dstlen, int versionp, int genp, char *drive, int *extlenptr, char *rawname)
|
||||
int unixpathname(char *src, char *dst, int versionp, int genp, char *drive, int *extlenptr, char *rawname)
|
||||
#else
|
||||
int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
int unixpathname(char *src, char *dst, int versionp, int genp)
|
||||
#endif /* DOS */
|
||||
{
|
||||
char *cp, *dp, *np;
|
||||
@@ -586,12 +495,12 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
* file system code.
|
||||
*/
|
||||
if (strcmp(src, "<") == 0) {
|
||||
strlcpy(dst, DIRSEPSTR, dstlen);
|
||||
strcpy(dst, DIRSEPSTR);
|
||||
return (1);
|
||||
}
|
||||
|
||||
/* Copy src to protect it from destructive modification. */
|
||||
strlcpy(lfname, src, sizeof(lfname));
|
||||
strcpy(lfname, src);
|
||||
|
||||
/*
|
||||
* If versionp is specified, we have to deal with the version field first,
|
||||
@@ -601,7 +510,7 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
#ifdef DOS
|
||||
if (versionp) LispVersionToUnixVersion(lfname, version); else version = -1;
|
||||
#else
|
||||
if (versionp) LispVersionToUnixVersion(lfname, sizeof(lfname));
|
||||
if (versionp) LispVersionToUnixVersion(lfname);
|
||||
#endif /* DOS */
|
||||
|
||||
cp = lfname;
|
||||
@@ -673,7 +582,7 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
TIMEOUT0(pwd = getpwuid(getuid()));
|
||||
if (pwd == NULL) return (0);
|
||||
|
||||
strlcpy(dst, pwd->pw_dir, dstlen);
|
||||
strcpy(dst, pwd->pw_dir);
|
||||
while (*dp != '\0') dp++;
|
||||
if (*(dp - 1) != DIRSEP) {
|
||||
/*
|
||||
@@ -697,7 +606,7 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
TIMEOUT0(pwd = getpwnam(name));
|
||||
if (pwd == NULL) return (0);
|
||||
|
||||
strlcpy(dst, pwd->pw_dir, dstlen);
|
||||
strcpy(dst, pwd->pw_dir);
|
||||
while (*dp != '\0') dp++;
|
||||
if (*(dp - 1) != DIRSEP) {
|
||||
/*
|
||||
@@ -860,8 +769,6 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
#ifdef DOS
|
||||
if (NameValid) *dp++ = *(cp + 1);
|
||||
CountNameChars;
|
||||
#else
|
||||
*dp++ = *(cp + 1);
|
||||
#endif /* DOS */
|
||||
cp += 2;
|
||||
break;
|
||||
@@ -900,10 +807,10 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
* for the convenience of the pattern matching routines, we don't
|
||||
* care about the last period character.
|
||||
*/
|
||||
strlcpy(fbuf1, lfname, sizeof(fbuf1));
|
||||
strlcpy(fbuf2, dst, sizeof(fbuf2));
|
||||
separate_version(fbuf1, sizeof(fbuf1), ver1, sizeof(ver1), 1);
|
||||
separate_version(fbuf2, sizeof(fbuf2), ver2, sizeof(ver2), 1);
|
||||
strcpy(fbuf1, lfname);
|
||||
strcpy(fbuf2, dst);
|
||||
separate_version(fbuf1, ver1, 1);
|
||||
separate_version(fbuf2, ver2, 1);
|
||||
for (cp = fbuf1; *cp; cp++) {}
|
||||
for (dp = fbuf2; *dp; dp++) {}
|
||||
if (*(cp - 1) == '.') {
|
||||
@@ -918,11 +825,11 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
}
|
||||
#ifdef DOS
|
||||
if (version >= 0)
|
||||
snprintf(ver2, sizeof(ver2), "%d", version);
|
||||
sprintf(ver2, "%d", version);
|
||||
else
|
||||
*ver2 = '\0';
|
||||
#endif /* DOS */
|
||||
conc_name_and_version(fbuf2, ver2, dst, dstlen);
|
||||
ConcNameAndVersion(fbuf2, ver2, dst);
|
||||
}
|
||||
return (1);
|
||||
}
|
||||
@@ -938,7 +845,6 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
* The lispname is used to determine which
|
||||
* character should be quoted in the result
|
||||
* Xerox Lisp pathname representation.
|
||||
* size_t lispnamesize size of storage available for lispname
|
||||
* int dirp If 1, fullname is a directory. If 0,
|
||||
* fullname is a file.
|
||||
* int versionp If 1, version field is also converted
|
||||
@@ -965,14 +871,14 @@ int unixpathname(char *src, char *dst, size_t dstlen, int versionp, int genp)
|
||||
*
|
||||
*/
|
||||
|
||||
int lisppathname(char *fullname, char *lispname, size_t lispnamesize, int dirp, int versionp)
|
||||
int lisppathname(char *fullname, char *lispname, int dirp, int versionp)
|
||||
{
|
||||
char *cp, *dp, *lnamep, *cnamep;
|
||||
char namebuf[MAXPATHLEN], fbuf[MAXPATHLEN], ver[VERSIONLEN];
|
||||
int i, mask, extensionp;
|
||||
|
||||
if (strcmp(fullname, DIRSEPSTR) == 0) {
|
||||
strlcpy(lispname, "<", lispnamesize);
|
||||
strcpy(lispname, "<");
|
||||
return (1);
|
||||
}
|
||||
|
||||
@@ -1034,7 +940,7 @@ int lisppathname(char *fullname, char *lispname, size_t lispnamesize, int dirp,
|
||||
* ' ''
|
||||
* . '. only if it is used as a part of the extension
|
||||
* field.
|
||||
* others as is
|
||||
* others as if
|
||||
*/
|
||||
|
||||
cp = fullname + 1;
|
||||
@@ -1076,7 +982,7 @@ int lisppathname(char *fullname, char *lispname, size_t lispnamesize, int dirp,
|
||||
if (dirp) {
|
||||
if (*(dp - 1) != '>' || *(dp - 2) == '\'') *dp++ = '>';
|
||||
*dp = '\0';
|
||||
strlcpy(lispname, namebuf, lispnamesize);
|
||||
strcpy(lispname, namebuf);
|
||||
return (1);
|
||||
}
|
||||
|
||||
@@ -1140,7 +1046,7 @@ int lisppathname(char *fullname, char *lispname, size_t lispnamesize, int dirp,
|
||||
* or not. If extension field is not included, we have to add a period
|
||||
* to specify empty extension field.
|
||||
*/
|
||||
strlcpy(fbuf, namebuf, sizeof(fbuf));
|
||||
strcpy(fbuf, namebuf);
|
||||
dp = cp = fbuf;
|
||||
while (*cp) {
|
||||
switch (*cp) {
|
||||
@@ -1160,7 +1066,7 @@ int lisppathname(char *fullname, char *lispname, size_t lispnamesize, int dirp,
|
||||
}
|
||||
}
|
||||
cp = dp + 1;
|
||||
if (versionp) separate_version(fbuf, sizeof(fbuf), ver, sizeof(ver), 1);
|
||||
if (versionp) separate_version(fbuf, ver, 1);
|
||||
extensionp = 0;
|
||||
while (*cp && !extensionp) {
|
||||
switch (*cp) {
|
||||
@@ -1181,16 +1087,237 @@ int lisppathname(char *fullname, char *lispname, size_t lispnamesize, int dirp,
|
||||
*cp = '\0';
|
||||
}
|
||||
if (versionp && *ver != '\0') {
|
||||
conc_name_and_version(fbuf, ver, namebuf, sizeof(namebuf));
|
||||
ConcNameAndVersion(fbuf, ver, namebuf);
|
||||
} else {
|
||||
strlcpy(namebuf, fbuf, sizeof(namebuf));
|
||||
strcpy(namebuf, fbuf);
|
||||
}
|
||||
|
||||
/*
|
||||
* Now, it's time to convert the version field.
|
||||
*/
|
||||
if (!dirp && versionp) UnixVersionToLispVersion(namebuf, sizeof(namebuf), 0);
|
||||
if (!dirp && versionp) UnixVersionToLispVersion(namebuf, 0);
|
||||
|
||||
strlcpy(lispname, namebuf, lispnamesize);
|
||||
strcpy(lispname, namebuf);
|
||||
return (1);
|
||||
}
|
||||
|
||||
/*
|
||||
* Name: quote_fname
|
||||
*
|
||||
* Argument: char *file The root file name in UNIX format. "Root"
|
||||
* file name contains the name, extension and
|
||||
* version fields. A valid version field is in a
|
||||
* form as ".~##~".
|
||||
*
|
||||
* Value: If succeed, returns 1, otherwise 0.
|
||||
*
|
||||
* Side Effect: If succeed, file is replaced with the file name in Xerox Lisp format
|
||||
* in which special characters are quoted.
|
||||
*
|
||||
* Description:
|
||||
*
|
||||
* Converts a UNIX root file name to Xerox Lisp one. This routine only quotes special
|
||||
* characters in Xerox file naming convention, does not care about the "true" name
|
||||
* which might be specified directly by the user as like lisppathname. Thus, this
|
||||
* routine can be invoked when you don't know how to escape the period character. This
|
||||
* is the case when you convert a file name in the course of the directory enumeration.
|
||||
*
|
||||
* This routine is used when file is a "FILE" name and being converted to {DSK} name.
|
||||
*
|
||||
* The special characters which is quoted include "<", ">", ";", and "'" itself. Notice
|
||||
* again that "." is not quoted, because we don't know it is a extension separator in
|
||||
* Lisp sense or not.
|
||||
*/
|
||||
|
||||
int quote_fname(char *file)
|
||||
{
|
||||
char *cp, *dp;
|
||||
int extensionp;
|
||||
char fbuf[MAXNAMLEN + 1], namebuf[MAXNAMLEN + 1], ver[VERSIONLEN];
|
||||
|
||||
cp = file;
|
||||
dp = fbuf;
|
||||
|
||||
while (*cp) {
|
||||
switch (*cp) {
|
||||
case '>':
|
||||
case ';':
|
||||
case '\'':
|
||||
*dp++ = '\'';
|
||||
*dp++ = *cp++;
|
||||
break;
|
||||
|
||||
default: *dp++ = *cp++; break;
|
||||
}
|
||||
}
|
||||
*dp = '\0';
|
||||
|
||||
/*
|
||||
* extensionp indicates whether extension field is included in a file
|
||||
* name or not. If extension field is not included, we have to add a
|
||||
* period to specify empty extension field.
|
||||
*/
|
||||
separate_version(fbuf, ver, 1);
|
||||
cp = fbuf;
|
||||
extensionp = 0;
|
||||
while (*cp && !extensionp) {
|
||||
switch (*cp) {
|
||||
case '.':
|
||||
if (*(cp + 1)) extensionp = 1;
|
||||
cp++;
|
||||
break;
|
||||
|
||||
case '\'':
|
||||
if (*(cp + 1) != '\0')
|
||||
cp += 2;
|
||||
else
|
||||
cp++;
|
||||
break;
|
||||
|
||||
default: cp++; break;
|
||||
}
|
||||
}
|
||||
if (!extensionp) {
|
||||
if (*(cp - 1) == '.') {
|
||||
*(cp - 1) = '\'';
|
||||
*cp++ = '.';
|
||||
}
|
||||
*cp++ = '.';
|
||||
*cp = '\0';
|
||||
}
|
||||
if (*ver != '\0') {
|
||||
ConcNameAndVersion(fbuf, ver, namebuf);
|
||||
} else {
|
||||
strcpy(namebuf, fbuf);
|
||||
}
|
||||
UnixVersionToLispVersion(namebuf, 1);
|
||||
strcpy(file, namebuf);
|
||||
return (1);
|
||||
}
|
||||
|
||||
/*
|
||||
* Name: quote_fname_ufs
|
||||
*
|
||||
* Argument: char *file The root file name in UNIX format. "Root"
|
||||
* file name contains the name, extension and
|
||||
* version fields. A valid version field is in a
|
||||
* form as ".~##~".
|
||||
*
|
||||
* Value: If succeed, returns 1, otherwise 0.
|
||||
*
|
||||
* Side Effect: If succeed, file is replaced with the file name in Xerox Lisp format
|
||||
* in which special characters are quoted.
|
||||
*
|
||||
* Description:
|
||||
*
|
||||
* Similar to quote_fname, but this routine is only used when file is a "FILE" name
|
||||
* and being converted to {UNIX} name.
|
||||
*/
|
||||
|
||||
int quote_fname_ufs(char *file)
|
||||
{
|
||||
char *cp, *dp;
|
||||
int extensionp;
|
||||
char fbuf[MAXNAMLEN + 1];
|
||||
|
||||
cp = file;
|
||||
dp = fbuf;
|
||||
|
||||
while (*cp) {
|
||||
switch (*cp) {
|
||||
case '>':
|
||||
case ';':
|
||||
case '\'':
|
||||
*dp++ = '\'';
|
||||
*dp++ = *cp++;
|
||||
break;
|
||||
|
||||
default: *dp++ = *cp++; break;
|
||||
}
|
||||
}
|
||||
*dp = '\0';
|
||||
|
||||
/*
|
||||
* extensionp indicates whether extension field is included in a file
|
||||
* name or not. If extension field is not included, we have to add a
|
||||
* period to specify empty extension field.
|
||||
*/
|
||||
cp = fbuf;
|
||||
extensionp = 0;
|
||||
while (*cp && !extensionp) {
|
||||
switch (*cp) {
|
||||
case '.':
|
||||
if (*(cp + 1)) extensionp = 1;
|
||||
cp++;
|
||||
break;
|
||||
|
||||
case '\'':
|
||||
if (*(cp + 1) != '\0')
|
||||
cp += 2;
|
||||
else
|
||||
cp++;
|
||||
break;
|
||||
|
||||
default: cp++; break;
|
||||
}
|
||||
}
|
||||
if (!extensionp) {
|
||||
if (*(cp - 1) == '.') {
|
||||
*(cp - 1) = '\'';
|
||||
*cp++ = '.';
|
||||
}
|
||||
*cp++ = '.';
|
||||
*cp = '\0';
|
||||
}
|
||||
strcpy(file, fbuf);
|
||||
return (1);
|
||||
}
|
||||
|
||||
/*
|
||||
* Name: quote_dname
|
||||
*
|
||||
* Argument: char *dir The directory name in UNIX format. Does not
|
||||
* include its parent name.
|
||||
*
|
||||
* Value: If succeed, returns 1, otherwise 0.
|
||||
*
|
||||
* Side Effect: If succeed, dir is replaced with the directory name in Xerox Lisp
|
||||
* format in which special characters are quoted.
|
||||
*
|
||||
* Description:
|
||||
*
|
||||
* Similar to quote_fname, but this routine is only used when dir is a "DIRECTORY"
|
||||
* name. Both {DSK} and {UNIX} uses this routine.
|
||||
*/
|
||||
|
||||
int quote_dname(char *dir)
|
||||
{
|
||||
char *cp, *dp;
|
||||
char fbuf[MAXNAMLEN + 1];
|
||||
|
||||
cp = dir;
|
||||
dp = fbuf;
|
||||
|
||||
while (*cp) {
|
||||
switch (*cp) {
|
||||
case '>':
|
||||
case ';':
|
||||
case '\'':
|
||||
*dp++ = '\'';
|
||||
*dp++ = *cp++;
|
||||
break;
|
||||
|
||||
default: *dp++ = *cp++; break;
|
||||
}
|
||||
}
|
||||
*dp = '\0';
|
||||
|
||||
if (*(dp - 1) == '.') {
|
||||
/* Trail period should be quoted. */
|
||||
*(dp - 1) = '\'';
|
||||
*dp++ = '.';
|
||||
}
|
||||
|
||||
strcpy(dir, fbuf);
|
||||
return (1);
|
||||
}
|
||||
|
||||
@@ -303,7 +303,7 @@ int FindUnixPipes(void) {
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
static int FindAvailablePty(char *Slave, size_t SlaveLen) {
|
||||
static int FindAvailablePty(char *Slave) {
|
||||
int res;
|
||||
|
||||
res = posix_openpt(O_RDWR);
|
||||
@@ -313,7 +313,7 @@ static int FindAvailablePty(char *Slave, size_t SlaveLen) {
|
||||
}
|
||||
grantpt(res);
|
||||
unlockpt(res);
|
||||
strlcpy(Slave, ptsname(res), SlaveLen);
|
||||
strcpy(Slave, ptsname(res));
|
||||
DBPRINT(("slave pty name is %s.\n", Slave));
|
||||
|
||||
if (res != -1) {
|
||||
@@ -392,7 +392,7 @@ LispPTR Unix_handlecomm(LispPTR *args) {
|
||||
PipeName = build_socket_pathname(sockFD);
|
||||
memset(&sock, 0, sizeof(sock));
|
||||
sock.sun_family = AF_UNIX;
|
||||
strlcpy(sock.sun_path, PipeName, sizeof(sock.sun_path));
|
||||
strcpy(sock.sun_path, PipeName);
|
||||
if (bind(sockFD, (struct sockaddr *)&sock, sizeof(struct sockaddr_un)) < 0) {
|
||||
close(sockFD);
|
||||
perror("binding sockets");
|
||||
@@ -570,7 +570,7 @@ LispPTR Unix_handlecomm(LispPTR *args) {
|
||||
int Master;
|
||||
unsigned short len;
|
||||
|
||||
Master = FindAvailablePty(SlavePTY, sizeof(SlavePTY));
|
||||
Master = FindAvailablePty(SlavePTY);
|
||||
DBPRINT(("Fork Shell; Master PTY = %d. Slave=%c%c.\n", Master, SlavePTY[0], SlavePTY[1]));
|
||||
if (Master < 0) {
|
||||
printf("Open of lisp side of PTY failed.\n");
|
||||
@@ -771,7 +771,6 @@ LispPTR Unix_handlecomm(LispPTR *args) {
|
||||
{
|
||||
int sockFD;
|
||||
struct sockaddr_un sock;
|
||||
size_t pathsize;
|
||||
|
||||
/* First open the socket */
|
||||
sockFD = socket(AF_UNIX, SOCK_STREAM, 0);
|
||||
@@ -783,13 +782,12 @@ LispPTR Unix_handlecomm(LispPTR *args) {
|
||||
socket into it */
|
||||
/* need to type-check the string here */
|
||||
LispStringToCString(args[1], shcom, 2048);
|
||||
pathsize = strlen(shcom) + 1;
|
||||
UJ[sockFD].pathname = malloc(pathsize);
|
||||
strlcpy(UJ[sockFD].pathname, shcom, pathsize);
|
||||
UJ[sockFD].pathname = malloc(strlen(shcom) + 1);
|
||||
strcpy(UJ[sockFD].pathname, shcom);
|
||||
/* Then bind it to the pathname, and get it listening properly */
|
||||
|
||||
sock.sun_family = AF_UNIX;
|
||||
strlcpy(sock.sun_path, shcom, sizeof(sock.sun_path));
|
||||
strcpy(sock.sun_path, shcom);
|
||||
if (bind(sockFD, (struct sockaddr *)&sock, sizeof(struct sockaddr_un)) < 0) {
|
||||
close(sockFD);
|
||||
free(UJ[sockFD].pathname);
|
||||
|
||||
@@ -358,7 +358,7 @@ int fork_Unix(void) {
|
||||
(void)snprintf(PipeName, sizeof(PipeName), "/tmp/LPU%ld-%d", StartTime, slot);
|
||||
memset(&addr, 0, sizeof(struct sockaddr_un));
|
||||
addr.sun_family = AF_UNIX;
|
||||
strlcpy(addr.sun_path, PipeName, sizeof(addr.sun_path));
|
||||
strcpy(addr.sun_path, PipeName);
|
||||
status =
|
||||
connect(sock, (struct sockaddr *)&addr, sizeof(struct sockaddr_un));
|
||||
if (status < 0) {
|
||||
|
||||
22
src/uraid.c
22
src/uraid.c
@@ -168,7 +168,6 @@ static const char *URaid_summary2 =
|
||||
"\n-- Memory display commands\n\
|
||||
a litatom\t\tDisplays the top-level value of the litatom\n\
|
||||
B Xaddress\t\tPrint the contents of the arrayblock at that address.\n\
|
||||
F [size]\t\tPrint the head of the array free list chain for given size, or all\n\
|
||||
d litatom\t\tDisplays the definition cell for the litatom\n\
|
||||
M\t\t\tDisplays TOS,CSP,PVAR,IVAR,PC\n\
|
||||
m func1 func2\t\tMOVD func1 to func2\n\
|
||||
@@ -202,7 +201,6 @@ l [type]\t\tDisplays backtrace for specified type of stack. (k|m|r|g|p|u|<null>)
|
||||
\n-- Memory display commands\n\
|
||||
a litatom\t\tDisplays the top-level value of the litatom\n\
|
||||
B Xaddress\t\tDisplays the contents of the arrayblock at that address.\n\
|
||||
F [size]\t\tPrint the head of the array free list chain for given size, or all\n\
|
||||
d litatom\t\tDisplays the definition cell of the litatom\n\
|
||||
M\t\t\tDisplays TOS,CSP,PVAR,IVAR,PC\n\
|
||||
m func1 func2\t\tMoves definition of func1 to func2 (MOVD)\n\
|
||||
@@ -469,26 +467,6 @@ LispPTR uraid_commands(void) {
|
||||
}
|
||||
break;
|
||||
|
||||
case 'F': { /* print array block free list head(s) */
|
||||
long size;
|
||||
if (URaid_argnum != 1 && URaid_argnum != 2) {
|
||||
printf("FREE-BLOCK-CHAIN: F [block-size (cells)]\n");
|
||||
return (T);
|
||||
}
|
||||
if (URaid_argnum == 1) {
|
||||
size = -1;
|
||||
} else {
|
||||
errno = 0;
|
||||
size = (LispPTR)strtol(URaid_arg1, &endpointer, 0);
|
||||
if (errno != 0 || *endpointer != '\0') {
|
||||
printf("Arg not number\n");
|
||||
return (T);
|
||||
}
|
||||
}
|
||||
printfreeblockchainn(size);
|
||||
}
|
||||
break;
|
||||
|
||||
case 'd': /* DEFCELL */
|
||||
if (URaid_argnum != 2) {
|
||||
printf("GETD: d litatom\n");
|
||||
|
||||
@@ -92,7 +92,7 @@ extern int please_fork;
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
static int lispstringP(LispPTR Lisp)
|
||||
int lispstringP(LispPTR Lisp)
|
||||
{
|
||||
switch (((OneDArray *)(NativeAligned4FromLAddr(Lisp)))->typenumber) {
|
||||
case THIN_CHAR_TYPENUMBER:
|
||||
@@ -156,36 +156,36 @@ LispPTR vmem_save0(LispPTR *args)
|
||||
LispStringToCString(args[0], pathname, MAXPATHLEN);
|
||||
separate_host(pathname, host);
|
||||
#ifdef DOS
|
||||
if (!unixpathname(pathname, sysout, sizeof(sysout), 0, 0, drive, 0, 0)) return (BADFILENAME);
|
||||
if (!unixpathname(pathname, sysout, 0, 0, drive, 0, 0)) return (BADFILENAME);
|
||||
#else
|
||||
if (!unixpathname(pathname, sysout, sizeof(sysout), 0, 0)) return (BADFILENAME);
|
||||
if (!unixpathname(pathname, sysout, 0, 0)) return (BADFILENAME);
|
||||
#endif /* DOS */
|
||||
return (vmem_save(sysout));
|
||||
} else {
|
||||
if ((def = getenv("LDEDESTSYSOUT")) == 0) {
|
||||
#ifdef DOS
|
||||
if (getcwd(pwd, MAXNAMLEN) == NULL) return (FILETIMEOUT);
|
||||
strlcpy(sysout, pwd, sizeof(sysout));
|
||||
strlcat(sysout, "/lisp.vm", sizeof(sysout));
|
||||
strcpy(sysout, pwd);
|
||||
strcat(sysout, "/lisp.vm");
|
||||
#else
|
||||
pwd = getpwuid(getuid()); /* NEED TIMEOUT */
|
||||
if (pwd == (struct passwd *)NULL) return (FILETIMEOUT);
|
||||
strlcpy(sysout, pwd->pw_dir, sizeof(sysout));
|
||||
strlcat(sysout, "/lisp.virtualmem", sizeof(sysout));
|
||||
strcpy(sysout, pwd->pw_dir);
|
||||
strcat(sysout, "/lisp.virtualmem");
|
||||
#endif /* DOS */
|
||||
} else {
|
||||
if (*def == '~' && (*(def + 1) == '/' || *(def + 1) == '\0')) {
|
||||
#ifdef DOS
|
||||
if (getcwd(pwd, MAXNAMLEN) == NULL) return (FILETIMEOUT);
|
||||
strlcpy(sysout, pwd, sizeof(sysout));
|
||||
strcpy(sysout, pwd);
|
||||
#else
|
||||
pwd = getpwuid(getuid()); /* NEED TIMEOUT */
|
||||
if (pwd == (struct passwd *)NULL) return (FILETIMEOUT);
|
||||
strlcpy(sysout, pwd->pw_dir, sizeof(sysout));
|
||||
strcpy(sysout, pwd->pw_dir);
|
||||
#endif /* DOS */
|
||||
strlcat(sysout, def + 1, sizeof(sysout));
|
||||
strcat(sysout, def + 1);
|
||||
} else {
|
||||
strlcpy(sysout, def, sizeof(sysout));
|
||||
strcpy(sysout, def);
|
||||
}
|
||||
}
|
||||
return (vmem_save(sysout));
|
||||
@@ -349,9 +349,9 @@ LispPTR vmem_save(char *sysout_file_name)
|
||||
SETJMP(FILETIMEOUT);
|
||||
#ifdef DOS
|
||||
/* Bloddy 8 char filenames in dos ... /jarl */
|
||||
make_old_version(tempname, sizeof(tempname), sysout_file_name);
|
||||
make_old_version(tempname, sysout_file_name);
|
||||
#else /* DOS */
|
||||
snprintf(tempname, sizeof(tempname), "%s-temp", sysout_file_name);
|
||||
sprintf(tempname, "%s-temp", sysout_file_name);
|
||||
#endif /* DOS */
|
||||
|
||||
/* Confirm protection of specified file by open/close */
|
||||
|
||||
19
src/xc.c
19
src/xc.c
@@ -173,7 +173,7 @@ static const int n_mask_array[16] = {
|
||||
|
||||
extern int TIMER_INTERVAL;
|
||||
|
||||
#if defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
#if MAIKO_OS_LINUX || defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
|
||||
# if !defined(MAIKO_TIMER_ASYNC_EMULATION_INSNS_COUNTDOWN)
|
||||
# define MAIKO_TIMER_ASYNC_EMULATION_INSNS_COUNTDOWN 20000
|
||||
@@ -181,7 +181,9 @@ extern int TIMER_INTERVAL;
|
||||
|
||||
int insnsCountdownForTimerAsyncEmulation = MAIKO_TIMER_ASYNC_EMULATION_INSNS_COUNTDOWN;
|
||||
static int pseudoTimerAsyncCountdown = MAIKO_TIMER_ASYNC_EMULATION_INSNS_COUNTDOWN;
|
||||
|
||||
#if MAIKO_OS_LINUX
|
||||
extern int linux_emulate_timer;
|
||||
#endif /* MAIKO_OS_LINUX */
|
||||
#endif
|
||||
|
||||
void dispatch(void) {
|
||||
@@ -282,10 +284,12 @@ nextopcode:
|
||||
#endif /* PCTRACE */
|
||||
|
||||
/* quick_stack_check();*/ /* JDS 2/12/98 */
|
||||
|
||||
#if defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
if (--pseudoTimerAsyncCountdown <= 0) {
|
||||
Irq_Stk_Check = 0;
|
||||
#if MAIKO_OS_LINUX || defined(MAIKO_EMULATE_TIMER_INTERRUPTS) || defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
#if MAIKO_OS_LINUX
|
||||
if (linux_emulate_timer) {
|
||||
#endif /* MAIKO_OS_LINUX */
|
||||
if (--pseudoTimerAsyncCountdown <= 0) {
|
||||
Irq_Stk_Check = 0;
|
||||
Irq_Stk_End = 0;
|
||||
#if defined(MAIKO_EMULATE_ASYNC_INTERRUPTS)
|
||||
IO_Signalled = TRUE;
|
||||
@@ -294,6 +298,9 @@ nextopcode:
|
||||
emscripten_sleep(1);
|
||||
#endif
|
||||
pseudoTimerAsyncCountdown = insnsCountdownForTimerAsyncEmulation;
|
||||
#if MAIKO_OS_LINUX
|
||||
}
|
||||
#endif /* MAIKO_OS_LINUX */
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
16
src/xrdopt.c
16
src/xrdopt.c
@@ -17,7 +17,7 @@
|
||||
#include <limits.h> // for PATH_MAX
|
||||
#include <stdio.h> // for fprintf, NULL, stderr, sscanf
|
||||
#include <stdlib.h> // for getenv, exit, strtol
|
||||
#include <string.h> // for strncpy, strlcat, strlcpy, strcmp
|
||||
#include <string.h> // for strncpy, strcat, strcpy, strcmp
|
||||
#include <sys/types.h> // for u_char
|
||||
#include <unistd.h> // for access, R_OK
|
||||
#include "xdefs.h" // for WINDOW_NAME
|
||||
@@ -211,13 +211,13 @@ void read_Xoption(int *argc, char *argv[])
|
||||
print_Xusage(argv[0]);
|
||||
} else {
|
||||
envname = getenv("DISPLAY");
|
||||
(void)strlcpy(Display_Name, envname, sizeof(Display_Name));
|
||||
(void)strcpy(Display_Name, envname);
|
||||
}
|
||||
if ((xdisplay = XOpenDisplay(Display_Name)) != NULL) {
|
||||
/* read the other databases */
|
||||
/* Start with app-defaults/medley */
|
||||
(void)strlcpy(tmp, "/usr/lib/X11/app-defaults/", sizeof(tmp));
|
||||
(void)strlcat(tmp, "medley", sizeof(tmp));
|
||||
(void)strcpy(tmp, "/usr/lib/X11/app-defaults/");
|
||||
(void)strcat(tmp, "medley");
|
||||
applicationDB = XrmGetFileDatabase(tmp);
|
||||
if (applicationDB != NULL) { (void)XrmMergeDatabases(applicationDB, &rDB); }
|
||||
/* Then try the displays defaults */
|
||||
@@ -232,8 +232,8 @@ void read_Xoption(int *argc, char *argv[])
|
||||
}
|
||||
|
||||
envname = getenv("HOME");
|
||||
(void)strlcpy(tmp, envname, sizeof(tmp));
|
||||
(void)strlcat(tmp, "/.Xdefaults", sizeof(tmp));
|
||||
(void)strcat(tmp, envname);
|
||||
(void)strcat(tmp, "/.Xdefaults");
|
||||
if (access(tmp, R_OK) != 0) {
|
||||
serverDB = XrmGetFileDatabase(tmp);
|
||||
if (serverDB != NULL) { (void)XrmMergeDatabases(serverDB, &rDB); }
|
||||
@@ -255,7 +255,7 @@ void read_Xoption(int *argc, char *argv[])
|
||||
if (XrmGetResource(rDB, "ldex.icontitle", "Ldex.icontitle", str_type, &value) == True) {
|
||||
(void)strncpy(iconTitle, value.addr, value.size);
|
||||
} else {
|
||||
(void)strlcpy(iconTitle, "Medley", sizeof(iconTitle));
|
||||
(void)strcpy(iconTitle, "Medley");
|
||||
}
|
||||
|
||||
if (XrmGetResource(rDB, "ldex.iconbitmap", "Ldex.Iconbitmap", str_type, &value) == True) {
|
||||
@@ -276,6 +276,8 @@ void read_Xoption(int *argc, char *argv[])
|
||||
&LispDisplayRequestedWidth, &LispDisplayRequestedHeight);
|
||||
}
|
||||
|
||||
(void)strcpy(tmp, ""); /* Clear the string */
|
||||
|
||||
if (XrmGetResource(rDB, "ldex.cursorColor", "Ldex.cursorColor", str_type, &value) == True) {
|
||||
(void)strncpy(cursorColor, value.addr, sizeof(cursorColor) - 1);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user