├── BUSY ├── Gingko.pro ├── LICENSE ├── NOTICE ├── README_Maiko.md ├── Readme.md ├── address.h ├── adr68k.h ├── allocmds.c ├── allocmdsdefs.h ├── arith.h ├── arithops.c ├── arithopsdefs.h ├── array.h ├── arrayops.c ├── arrayopsdefs.h ├── bb.h ├── bbtsub.c ├── bbtsubdefs.h ├── bin.c ├── bindefs.h ├── binds.c ├── bindsdefs.h ├── bitblt.c ├── bitblt.h ├── bitbltdefs.h ├── blt.c ├── bltdefs.h ├── byteswap.c ├── byteswapdefs.h ├── car-cdr.c ├── car-cdrdefs.h ├── cell.h ├── chardev.c ├── chardevdefs.h ├── common.c ├── commondefs.h ├── conspage.c ├── conspagedefs.h ├── dbprint.h ├── debug.h ├── devconf.h ├── devif.h ├── dir.c ├── dirdefs.h ├── display.c ├── display.h ├── draw.c ├── drawdefs.h ├── dsk.c ├── dskdefs.h ├── dspdata.h ├── dspifdefs.h ├── dspsubrs.c ├── dspsubrsdefs.h ├── eqf.c ├── eqfdefs.h ├── findkey.c ├── findkeydefs.h ├── fp.c ├── fpdefs.h ├── fvar.c ├── fvardefs.h ├── gc.c ├── gc2.c ├── gc2defs.h ├── gcarray.c ├── gcarraydefs.h ├── gccode.c ├── gccodedefs.h ├── gcdata.h ├── gcdefs.h ├── gcfinal.c ├── gcfinaldefs.h ├── gchtfind.c ├── gchtfinddefs.h ├── gcmain3.c ├── gcmain3defs.h ├── gcoflow.c ├── gcoflowdefs.h ├── gcr.c ├── gcrcell.c ├── gcrcelldefs.h ├── gcrdefs.h ├── gcscan.c ├── gcscandefs.h ├── gvar2.c ├── gvar2defs.h ├── hardrtn.c ├── hardrtndefs.h ├── ifpage.h ├── inet.c ├── inetdefs.h ├── initatms.h ├── initdsp.c ├── initdspdefs.h ├── initkbd.c ├── initkbddefs.h ├── initsout.c ├── initsoutdefs.h ├── inlineC.h ├── intcall.c ├── intcalldefs.h ├── iopage.h ├── keyboard.h ├── keyevent.c ├── keyeventdefs.h ├── kprint.c ├── kprintdefs.h ├── ldsout.c ├── ldsoutdefs.h ├── lineblt8.c ├── lineblt8defs.h ├── lisp2c.c ├── lisp2cdefs.h ├── lispemul.h ├── lispmap.h ├── lispver2.h ├── llstk.c ├── llstkdefs.h ├── locfile.h ├── loopsops.c ├── loopsopsdefs.h ├── lowlev1.c ├── lowlev1defs.h ├── lowlev2.c ├── lowlev2defs.h ├── lspglob.h ├── lsptypes.h ├── lsthandl.c ├── lsthandldefs.h ├── main.c ├── maindefs.h ├── medleyfp.h ├── misc7.c ├── misc7defs.h ├── miscn.c ├── miscndefs.h ├── miscstat.h ├── mkatom.c ├── mkatomdefs.h ├── mkcell.c ├── mkcelldefs.h ├── mvs.c ├── mvsdefs.h ├── my.h ├── opcodes.h ├── osmsg.h ├── perrno.c ├── perrnodefs.h ├── pilotbbt.h ├── platform.h ├── print.h ├── return.c ├── return.h ├── returndefs.h ├── rplcons.c ├── rplconsdefs.h ├── run-medley ├── sdl.c ├── sdldefs.h ├── shift.c ├── shiftdefs.h ├── stack.h ├── storage.c ├── storagedefs.h ├── stream.h ├── subr.c ├── subr0374.c ├── subr0374defs.h ├── subrdefs.h ├── subrs.h ├── sxhash.c ├── sxhashdefs.h ├── testtool.c ├── testtooldefs.h ├── timeout.h ├── timer.c ├── timerdefs.h ├── tinydir.h ├── tos1defs.h ├── tosfns.h ├── tosret.h ├── typeof.c ├── typeofdefs.h ├── ubf1.c ├── ubf1defs.h ├── ubf2.c ├── ubf2defs.h ├── ubf3.c ├── ubf3defs.h ├── ufs.c ├── ufsdefs.h ├── unwind.c ├── unwinddefs.h ├── usrsubr.c ├── usrsubrdefs.h ├── uutils.c ├── uutilsdefs.h ├── vars3.c ├── vars3defs.h ├── version.h ├── vmem_alloc.c ├── vmemsave.c ├── vmemsave.h ├── vmemsavedefs.h ├── xc.c ├── xcdefs.h ├── z2.c └── z2defs.h /Gingko.pro: -------------------------------------------------------------------------------- 1 | QT -= core 2 | QT -= gui 3 | 4 | TARGET = gingko 5 | CONFIG += console 6 | CONFIG -= app_bundle 7 | 8 | TEMPLATE = app 9 | 10 | QMAKE_CFLAGS += -std=c99 -fno-strict-aliasing 11 | # NOTE: if we leave away -fno-strict-aliasing, the VM crashes randomly 12 | # NOTE: the original build also has -g3 and -std=gnu99, but this has no influence on stability 13 | 14 | LIBS += -lSDL2 15 | 16 | SOURCES += \ 17 | arithops.c \ 18 | arrayops.c \ 19 | bin.c \ 20 | binds.c \ 21 | bitblt.c \ 22 | bbtsub.c \ 23 | blt.c \ 24 | car-cdr.c \ 25 | chardev.c \ 26 | common.c \ 27 | conspage.c \ 28 | mkcell.c \ 29 | draw.c \ 30 | findkey.c \ 31 | fvar.c \ 32 | xc.c \ 33 | gc.c \ 34 | gc2.c \ 35 | gvar2.c \ 36 | hardrtn.c \ 37 | inet.c \ 38 | intcall.c \ 39 | lineblt8.c \ 40 | lsthandl.c \ 41 | llstk.c \ 42 | loopsops.c \ 43 | lowlev1.c \ 44 | lowlev2.c \ 45 | misc7.c \ 46 | mvs.c \ 47 | return.c \ 48 | rplcons.c \ 49 | shift.c \ 50 | subr.c \ 51 | sxhash.c \ 52 | miscn.c \ 53 | subr0374.c \ 54 | timer.c \ 55 | typeof.c \ 56 | unwind.c \ 57 | vars3.c \ 58 | z2.c \ 59 | eqf.c \ 60 | fp.c \ 61 | ubf1.c \ 62 | ubf2.c \ 63 | ubf3.c \ 64 | uutils.c \ 65 | perrno.c \ 66 | lisp2c.c \ 67 | testtool.c \ 68 | kprint.c \ 69 | byteswap.c \ 70 | main.c \ 71 | initsout.c \ 72 | storage.c \ 73 | allocmds.c \ 74 | vmemsave.c \ 75 | mkatom.c \ 76 | ldsout.c \ 77 | dspsubrs.c \ 78 | initdsp.c \ 79 | dsk.c \ 80 | ufs.c \ 81 | dir.c \ 82 | keyevent.c \ 83 | initkbd.c \ 84 | gcscan.c \ 85 | gcarray.c \ 86 | gccode.c \ 87 | gcfinal.c \ 88 | gcrcell.c \ 89 | gchtfind.c \ 90 | gcmain3.c \ 91 | gcr.c \ 92 | gcoflow.c \ 93 | sdl.c \ 94 | usrsubr.c \ 95 | display.c \ 96 | vmem_alloc.c 97 | 98 | HEADERS += \ 99 | address.h \ 100 | adr68k.h \ 101 | allocmdsdefs.h \ 102 | arith.h \ 103 | arithopsdefs.h \ 104 | array.h \ 105 | arrayopsdefs.h \ 106 | bb.h \ 107 | bbtsubdefs.h \ 108 | bindefs.h \ 109 | bindsdefs.h \ 110 | bitblt.h \ 111 | bitbltdefs.h \ 112 | bltdefs.h \ 113 | byteswapdefs.h \ 114 | car-cdrdefs.h \ 115 | cell.h \ 116 | chardevdefs.h \ 117 | commondefs.h \ 118 | conspagedefs.h \ 119 | dbprint.h \ 120 | debug.h \ 121 | devconf.h \ 122 | devif.h \ 123 | dirdefs.h \ 124 | display.h \ 125 | drawdefs.h \ 126 | dskdefs.h \ 127 | dspdata.h \ 128 | dspifdefs.h \ 129 | dspsubrsdefs.h \ 130 | emlglob.h \ 131 | eqfdefs.h \ 132 | findkeydefs.h \ 133 | fpdefs.h \ 134 | fvardefs.h \ 135 | gc2defs.h \ 136 | gcarraydefs.h \ 137 | gccodedefs.h \ 138 | gcdata.h \ 139 | gcdefs.h \ 140 | gcfinaldefs.h \ 141 | gchtfinddefs.h \ 142 | gcmain3defs.h \ 143 | gcoflowdefs.h \ 144 | gcrcelldefs.h \ 145 | gcrdefs.h \ 146 | gcscandefs.h \ 147 | gvar2defs.h \ 148 | hardrtndefs.h \ 149 | ifpage.h \ 150 | inetdefs.h \ 151 | initatms.h \ 152 | initdspdefs.h \ 153 | initkbddefs.h \ 154 | initsoutdefs.h \ 155 | inlineC.h \ 156 | intcalldefs.h \ 157 | iopage.h \ 158 | keyboard.h \ 159 | keyeventdefs.h \ 160 | kprintdefs.h \ 161 | ldsoutdefs.h \ 162 | lineblt8defs.h \ 163 | lisp2cdefs.h \ 164 | lispemul.h \ 165 | lispmap.h \ 166 | lispver2.h \ 167 | llstkdefs.h \ 168 | locfile.h \ 169 | loopsopsdefs.h \ 170 | lowlev1defs.h \ 171 | lowlev2defs.h \ 172 | lspglob.h \ 173 | lsptypes.h \ 174 | lsthandldefs.h \ 175 | maindefs.h \ 176 | medleyfp.h \ 177 | misc7defs.h \ 178 | miscndefs.h \ 179 | miscstat.h \ 180 | mkatomdefs.h \ 181 | mkcelldefs.h \ 182 | mvsdefs.h \ 183 | my.h \ 184 | opcodes.h \ 185 | osmsg.h \ 186 | perrnodefs.h \ 187 | pilotbbt.h \ 188 | platform.h \ 189 | print.h \ 190 | return.h \ 191 | returndefs.h \ 192 | rplconsdefs.h \ 193 | sdldefs.h \ 194 | shiftdefs.h \ 195 | stack.h \ 196 | storagedefs.h \ 197 | stream.h \ 198 | subr0374defs.h \ 199 | subrdefs.h \ 200 | subrs.h \ 201 | sxhashdefs.h \ 202 | testtooldefs.h \ 203 | timeout.h \ 204 | timerdefs.h \ 205 | tos1defs.h \ 206 | tosfns.h \ 207 | tosret.h \ 208 | ttydefs.h \ 209 | typeofdefs.h \ 210 | ubf1defs.h \ 211 | ubf2defs.h \ 212 | ubf3defs.h \ 213 | ufsdefs.h \ 214 | unwinddefs.h \ 215 | usrsubrdefs.h \ 216 | uutilsdefs.h \ 217 | vars3defs.h \ 218 | version.h \ 219 | vmemsave.h \ 220 | vmemsavedefs.h \ 221 | xcdefs.h \ 222 | xrdoptdefs.h \ 223 | z2defs.h \ 224 | tinydir.h 225 | 226 | 227 | 228 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Venue (Wayne Booth Marci, Estate of John Sybalsky) and Interlisp contributers. 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | Many thanks to Wayne Booth Marci, who inherited the rights of Venue, 2 | including the copyright of works identified as Copyright Venue. 3 | 4 | Permission to release these files with the open source MIT License 5 | has been granted. 6 | -------------------------------------------------------------------------------- /README_Maiko.md: -------------------------------------------------------------------------------- 1 | # Maiko 2 | 3 | Maiko is the implementation of the Medley Interlisp virtual machine, for a 4 | byte-coded Lisp instruction set and some low-level functions for 5 | connecting with Lisp for access to display (via X11) and disk etc. 6 | 7 | For an overview, see [Medley Interlisp Introduction](https://interlisp.org/medley/using/docs/medley/). 8 | 9 | See [the Medley repository](https://github.com/Interlisp/medley) for 10 | * [Issues](https://github.com/Interlisp/medley/issues) (note that maiko issues are there too) 11 | * [Discussions](https://github.com/Interlisp/medley/discussions) (Q&A, announcements, etc) 12 | * [Medley's README](https://github.com/Interlisp/medley/blob/master/README.md) 13 | 14 | Bug reports, feature requests, fixes and improvements, support for additional platforms and hardware are all welcome. 15 | 16 | ## Development Platforms 17 | 18 | We are developing on FreeBSD, Linux, macOS, and Solaris currently 19 | on arm7l, arm64, PowerPC, SPARC, i386, and x86_64 hardware. 20 | 21 | 22 | ## Building Maiko 23 | 24 | Building requires `clang`, `make`, X11 client libraries (`libx11-dev`). For example, 25 | 26 | ``` sh 27 | $ sudo apt update 28 | $ sudo apt install clang make libx11-dev 29 | ``` 30 | 31 | ``` 32 | $ cd maiko/bin 33 | $ ./makeright x 34 | ``` 35 | 36 | * 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`. 37 | * If you prefer using `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` for `clang` and uncomment the line (delete the #) for the line that defines `CC` for `gcc`. 38 | * There is a cmake configuration (TBD To Be Described here). 39 | 40 | ### Building For macOS 41 | 42 | * Running on macOS requires an X server, and building on a Mac requires X client libraries. 43 | An X-server for macOS (and X11 client libraries) can be freely obtained at https://www.xquartz.org/releases 44 | 45 | ### Building for Windows 10 46 | 47 | Windows 10 currently requires "Docker for Desktop" or WSL2 and a (Windows X-server). 48 | See [Medley's README](https://github.com/Interlisp/medley/blob/master/README.md) for more. 49 | 50 | -------------------------------------------------------------------------------- /address.h: -------------------------------------------------------------------------------- 1 | #ifndef ADDRESS_H 2 | #define ADDRESS_H 1 3 | /* $Id: address.h,v 1.2 1999/01/03 02:05:51 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | 7 | 8 | /************************************************************************/ 9 | /* */ 10 | /* (C) Copyright 1989-92 Venue. All Rights Reserved. */ 11 | /* Manufactured in the United States of America. */ 12 | /* */ 13 | /************************************************************************/ 14 | 15 | /**********************************************************************/ 16 | /* 17 | File Name : address.h 18 | 19 | Address Manipulate Macros(for LISP pointer) 20 | 21 | Date : December 8, 1986 22 | Edited by : Takeshi Shimizu 23 | Changed : Dec.22.86 (take) 24 | Changed : Jan.14.87(take) 25 | Changed : Apr.20.87(mitani) 26 | Sep.02.87 take 27 | (add parenthesises) 28 | */ 29 | /**********************************************************************/ 30 | 31 | /* NOTE: These MACRO should be used for the pointers in LISP SYSOUT */ 32 | #define LLSH(datum, n) ((datum) << (n)) 33 | #define LRSH(datum, n) ((datum) >> (n)) 34 | 35 | #define HILOC(ptr) (LRSH(((unsigned int)(ptr) & SEGMASK),16)) 36 | #define LOLOC(ptr) ((unsigned int)(ptr) & 0x0ffff) 37 | 38 | #define VAG2(hi,lo) (LispPTR)(LLSH((hi),16) | (lo)) 39 | 40 | 41 | /* NOTE: argument off must be WORD offset */ 42 | #define ADDBASE(ptr,off) ((UNSIGNED)(ptr) + (off)) 43 | #define GETBASE(ptr,off) (GETWORD(((DLword *)(ptr)) + (off))) 44 | 45 | 46 | 47 | /* Following MACRO defs. is related with POINTER which is defined as ACCESSFNS in Interlisp(LLNEW) */ 48 | #ifdef BIGVM 49 | #define POINTER_PAGE(datum) (((unsigned int)(datum) & 0x0fffff00) >> 8 ) 50 | #define POINTER_PAGEBASE(datum) ((datum) & 0x0fffff00) 51 | #else 52 | #define POINTER_PAGE(datum) (((unsigned int)(datum) & 0x0ffff00) >> 8 ) 53 | #define POINTER_PAGEBASE(datum) ((datum) & 0x0ffff00) 54 | #endif /* BIGVM */ 55 | #endif /* ADDRESS_H */ 56 | -------------------------------------------------------------------------------- /adr68k.h: -------------------------------------------------------------------------------- 1 | #ifndef ADR68K_H 2 | #define ADR68K_H 1 3 | /* $Id: adr68k.h,v 1.2 1999/01/03 02:05:52 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /* 6 | * Copyright (C) 1987 by Fuji Xerox Co., Ltd. All rights reserved. 7 | * 8 | * Author : Takeshi Shimizu 9 | * Hiroshi Hayata 10 | */ 11 | 12 | /************************************************************************/ 13 | /* */ 14 | /* Copyright 1989, 1990 Venue, Fuji Xerox Co., Ltd, Xerox Corp. */ 15 | /* */ 16 | /* This file is work-product resulting from the Xerox/Venue */ 17 | /* Agreement dated 18-August-1989 for support of Medley. */ 18 | /* */ 19 | /************************************************************************/ 20 | 21 | /**********************************************************************/ 22 | /* 23 | Func name : adr68k.h 24 | Translate 68k address to Lisp or Lisp to 68k 25 | 26 | Date : January 16, 1987 27 | Create : Takeshi Shimizu 28 | */ 29 | /**********************************************************************/ 30 | 31 | #include 32 | #include 33 | #include "lispemul.h" 34 | #include "lspglob.h" 35 | 36 | static inline LispPTR LAddrFromNative(void *NAddr) 37 | { 38 | if ((uintptr_t)NAddr & 1) { 39 | printf("Misaligned pointer in LAddrFromNative %p\n", NAddr); 40 | } 41 | return (LispPTR)(((DLword *)NAddr) - Lisp_world); 42 | } 43 | 44 | static inline DLword *NativeAligned2FromLAddr(LispPTR LAddr) 45 | { 46 | return (Lisp_world + LAddr); 47 | } 48 | 49 | static inline LispPTR *NativeAligned4FromLAddr(LispPTR LAddr) 50 | { 51 | if (LAddr & 1) { 52 | printf("Misaligned pointer in NativeAligned4FromLAddr 0x%x\n", LAddr); 53 | } 54 | return (LispPTR *)(Lisp_world + LAddr); 55 | } 56 | 57 | static inline LispPTR *NativeAligned4FromLPage(LispPTR LPage) 58 | { 59 | return (LispPTR *)(Lisp_world + (LPage << 8)); 60 | } 61 | 62 | static inline DLword StackOffsetFromNative(void *SAddr) 63 | { 64 | /* Stack offsets are expressed as an offset in DLwords from the stack base */ 65 | ptrdiff_t hoffset = (DLword *)SAddr - Stackspace; 66 | if (hoffset > 0xffff || hoffset < 0) { 67 | printf("Stack offset is out of range: 0x%tx\n", hoffset); 68 | } 69 | return (DLword)hoffset; 70 | } 71 | 72 | static inline DLword *NativeAligned2FromStackOffset(DLword StackOffset) 73 | { 74 | return Stackspace + StackOffset; 75 | } 76 | 77 | static inline LispPTR *NativeAligned4FromStackOffset(DLword StackOffset) 78 | { 79 | if (StackOffset & 1) { 80 | printf("Misaligned StackOffset in NativeAligned4FromStackOffset 0x%hx\n", StackOffset); 81 | } 82 | return (LispPTR *)(Stackspace + StackOffset); 83 | } 84 | 85 | static inline LispPTR LPageFromNative(void *NAddr) 86 | { 87 | if ((uintptr_t)NAddr & 1) { 88 | printf("Misaligned pointer in LPageFromNative %p\n", NAddr); 89 | } 90 | return (LispPTR)((((DLword *)NAddr) - Lisp_world) >> 8); 91 | } 92 | #endif /* ADR68K_H */ 93 | -------------------------------------------------------------------------------- /allocmdsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef ALLOCMDSDEFS_H 2 | #define ALLOCMDSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | LispPTR initmdspage(LispPTR *base, DLword size, LispPTR prev); 5 | LispPTR *alloc_mdspage(short int type); 6 | #endif 7 | -------------------------------------------------------------------------------- /arithopsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef ARITHOPSDEFS_H 2 | #define ARITHOPSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_plus2(LispPTR tosm1, LispPTR tos); 5 | LispPTR N_OP_iplus2(LispPTR tosm1, LispPTR tos); 6 | LispPTR N_OP_difference(LispPTR tosm1, LispPTR tos); 7 | LispPTR N_OP_idifference(LispPTR tosm1, LispPTR tos); 8 | LispPTR N_OP_logxor(LispPTR tosm1, LispPTR tos); 9 | LispPTR N_OP_logand(LispPTR tosm1, LispPTR tos); 10 | LispPTR N_OP_logor(LispPTR tosm1, LispPTR tos); 11 | LispPTR N_OP_greaterp(LispPTR tosm1, LispPTR tos); 12 | LispPTR N_OP_igreaterp(LispPTR tosm1, LispPTR tos); 13 | LispPTR N_OP_iplusn(LispPTR tos, int n); 14 | LispPTR N_OP_idifferencen(LispPTR tos, int n); 15 | LispPTR N_OP_makenumber(LispPTR tosm1, LispPTR tos); 16 | LispPTR N_OP_boxiplus(LispPTR a, LispPTR tos); 17 | LispPTR N_OP_boxidiff(LispPTR a, LispPTR tos); 18 | LispPTR N_OP_times2(LispPTR tosm1, LispPTR tos); 19 | LispPTR N_OP_itimes2(LispPTR tosm1, LispPTR tos); 20 | LispPTR N_OP_quot(LispPTR tosm1, LispPTR tos); 21 | LispPTR N_OP_iquot(LispPTR tosm1, LispPTR tos); 22 | LispPTR N_OP_iremainder(LispPTR tosm1, LispPTR tos); 23 | #endif 24 | -------------------------------------------------------------------------------- /arrayopsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef ARRAYOPSDEFS_H 2 | #define ARRAYOPSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_misc3(LispPTR baseL, LispPTR typenumber, LispPTR inx, int alpha); 5 | LispPTR N_OP_misc4(LispPTR data, LispPTR base, LispPTR typenumber, LispPTR inx, int alpha); 6 | LispPTR N_OP_aref1(LispPTR arrayarg, LispPTR inx); 7 | LispPTR N_OP_aset1(LispPTR data, LispPTR arrayarg, LispPTR inx); 8 | LispPTR N_OP_aref2(LispPTR arrayarg, LispPTR inx0, LispPTR inx1); 9 | LispPTR N_OP_aset2(LispPTR data, LispPTR arrayarg, LispPTR inx0, LispPTR inx1); 10 | #endif 11 | -------------------------------------------------------------------------------- /bbtsubdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef BBTSUBDEFS_H 2 | #define BBTSUBDEFS_H 1 3 | 4 | /********************************************************/ 5 | /* */ 6 | /* Don Charnley's bitblt code */ 7 | /* */ 8 | /********************************************************/ 9 | #include "lispemul.h" /* for LispPTR, DLword */ 10 | 11 | void bitbltsub(LispPTR *argv); 12 | LispPTR n_new_cursorin(DLword *baseaddr, int dx, int dy, int w, int h); 13 | LispPTR bitblt_bitmap(LispPTR *args); 14 | LispPTR bitshade_bitmap(LispPTR *args); 15 | void bltchar(LispPTR *args); 16 | void newbltchar(LispPTR *args); 17 | void ccfuncall(unsigned int atom_index, int argnum, int bytenum); 18 | void tedit_bltchar(LispPTR *args); 19 | 20 | #endif 21 | -------------------------------------------------------------------------------- /bin.c: -------------------------------------------------------------------------------- 1 | /* $Id: bin.c,v 1.3 1999/05/31 23:35:24 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | /***********************************************************************/ 11 | /* 12 | File Name : bin.c 13 | 14 | Desc : 15 | 16 | Date : Jul. 22, 1987 17 | Edited by : Takeshi Shimizu 18 | Changed : 19 | 20 | Including : OP_bin 21 | 22 | 23 | */ 24 | /**********************************************************************/ 25 | #include "version.h" 26 | #include "adr68k.h" // for NativeAligned2FromLAddr, NativeAligned4FromLAddr 27 | #include "bindefs.h" // for N_OP_bin 28 | #include "lispmap.h" // for S_POSITIVE 29 | #include "lspglob.h" 30 | #include "lsptypes.h" // for state, ERROR_EXIT, GetTypeNumber, Get_BYTE 31 | #include "stream.h" // for Stream 32 | 33 | LispPTR N_OP_bin(LispPTR tos) { 34 | Stream *stream68k; /* stream instance on TOS */ 35 | char *buff68k; /* pointer to BUFF */ 36 | 37 | if (GetTypeNumber(tos) == TYPE_STREAM) { 38 | stream68k = (Stream *)NativeAligned4FromLAddr(tos); 39 | 40 | if (!stream68k->BINABLE) ERROR_EXIT(tos); 41 | 42 | if (stream68k->COFFSET >= stream68k->CBUFSIZE) ERROR_EXIT(tos); 43 | 44 | /* get BUFFER instance */ 45 | buff68k = (char *)NativeAligned2FromLAddr(stream68k->CBUFPTR); 46 | 47 | /* get BYTE data and set it to TOS */ 48 | return (S_POSITIVE | (Get_BYTE(buff68k + (stream68k->COFFSET)++))); 49 | } else 50 | ERROR_EXIT(tos); 51 | } 52 | -------------------------------------------------------------------------------- /bindefs.h: -------------------------------------------------------------------------------- 1 | #ifndef BINDEFS_H 2 | #define BINDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_bin(LispPTR tos); 5 | #endif 6 | -------------------------------------------------------------------------------- /binds.c: -------------------------------------------------------------------------------- 1 | /* $Id: binds.c,v 1.3 1999/05/31 23:35:24 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | #include 13 | #include "lispemul.h" 14 | #include "lspglob.h" 15 | #include "testtooldefs.h" 16 | #include "bindsdefs.h" 17 | 18 | /************************************************** 19 | N_OP_bind(stack_pointer, tos, n1, n2) 20 | 21 | Entry: BIND opcode[021] 22 | 23 | 1. bind PVAR slot to NIL. (n1 times) 24 | 2. bind PVAR slot to value of slot in Evaluation stack. (n2 times) 25 | or push TopOfStack to Evaluation stack. 26 | 3. Push [upper word] 1's complement of bind slots 27 | [lower word] 2word offset from PVar 28 | 29 | ***************************************************/ 30 | 31 | LispPTR *N_OP_bind(LispPTR *stack_pointer, LispPTR tos, unsigned byte1, unsigned byte2) { 32 | unsigned n1; /* # slots to bind to NIL (0, 0) */ 33 | unsigned n2; /* # slots to bind to value in stack */ 34 | LispPTR *ppvar; /* pointer to argued slot in Pvar area */ 35 | unsigned i; /* temporary for control */ 36 | 37 | #ifdef TRACE 38 | printPC(); 39 | printf("TRACE: N_OP_bind()\n"); 40 | #endif 41 | 42 | n1 = byte1 >> 4; 43 | n2 = byte1 & 0xf; 44 | ppvar = (LispPTR *)PVar + 1 + byte2; 45 | 46 | for (i = 0; i < n1; i++) { *--ppvar = NIL_PTR; } 47 | 48 | if (n2 == 0) { 49 | *stack_pointer++ = tos; /* push TopOfStack to Evaluation stack */ 50 | } else { 51 | *--ppvar = tos; /* bind to TopOfStack */ 52 | for (i = 1; i < n2; i++) { *--ppvar = *(--stack_pointer); } 53 | } 54 | 55 | i = ~(n1 + n2); /* x: 1's complement of number of bind slots */ 56 | *stack_pointer = (i << 16) | (byte2 << 1); 57 | return (stack_pointer); 58 | } 59 | 60 | /************************************************** 61 | LispPTR N_OP_unbind(stackpointer) 62 | 63 | Entry: UNBIND opcode[022] 64 | 65 | 1. pop stackpointer until the slot (num, lastpvar) is found 66 | (Note: TOPOFSTACK is ignored) 67 | 2. unbind lastpvar slot (set to 0xFFFF). (num times) 68 | 69 | ***************************************************/ 70 | 71 | LispPTR *N_OP_unbind(LispPTR *stack_pointer) { 72 | DLword num; /* number of unbind sot */ 73 | LispPTR *ppvar; /* pointer to last PVAR slot. */ 74 | DLword i; /* temporary for control */ 75 | LispPTR value; 76 | 77 | #ifdef TRACE 78 | printPC(); 79 | printf("TRACE: N_OP_unbind()\n"); 80 | #endif 81 | 82 | /* now, stack_pointer points the latter part in slot */ 83 | for (; !(*--stack_pointer & 0x80000000);) 84 | ; /* scan (until MSB == 1) */ 85 | 86 | value = *stack_pointer; 87 | num = (DLword) ~(value >> 16); 88 | ppvar = (LispPTR *)(PVar + 2 + GetLoWord(value)); 89 | value = 0xffffffff; 90 | for (i = 0; i < num; i++) { *--ppvar = value; } 91 | return (stack_pointer); 92 | } 93 | 94 | /************************************************** 95 | N_OP_dunbind 96 | 97 | Entry: DUNBIND opcode[023] 98 | 99 | 1. if TopOfStack is unbound 100 | unbind num slots from PVar. 101 | if TopOfStack is bound 102 | pop CurrentStack until the slot (num, lastpvar) is found. 103 | unbind num slots from lastpvar. 104 | 2. pop the top of CurrentStackPTR to TopOfStack. 105 | 106 | ***************************************************/ 107 | 108 | LispPTR *N_OP_dunbind(LispPTR *stack_pointer, LispPTR tos) { 109 | DLword num; /* number of unbind sot */ 110 | LispPTR *ppvar; /* pointer to last PVAR slot. */ 111 | DLword i; /* temporary for control */ 112 | LispPTR value; 113 | 114 | #ifdef TRACE 115 | printPC(); 116 | printf("TRACE: N_OP_dunbind()\n"); 117 | #endif 118 | 119 | if (tos & 0x80000000) { 120 | /* check MSB bit of High word in tos, 1: unbound, 0: bound */ 121 | 122 | /* tos is unbound */ 123 | num = ~(GetHiWord(tos)); 124 | value = 0xffffffff; 125 | if (num != 0) { 126 | ppvar = (LispPTR *)(PVar + 2 + GetLoWord(tos)); 127 | for (i = 0; i < num; ++i) { *--ppvar = value; } 128 | } 129 | } else { 130 | /* tos is bound */ 131 | /* now, stack_pointer points the latter part in slot */ 132 | for (; !((*--stack_pointer) & 0x80000000);) 133 | ; 134 | /* scan (until MSB == 1) */ 135 | 136 | value = *stack_pointer; 137 | num = ~(GetHiWord(value)); 138 | ppvar = (LispPTR *)(PVar + 2 + GetLoWord(value)); 139 | value = 0xffffffff; 140 | for (i = 0; i < num; i++) { *--ppvar = value; } 141 | } 142 | 143 | return (stack_pointer); 144 | } 145 | -------------------------------------------------------------------------------- /bindsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef BINDSDEFS_H 2 | #define BINDSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR *N_OP_bind(LispPTR *stack_pointer, LispPTR tos, unsigned byte1, unsigned byte2); 5 | LispPTR *N_OP_unbind(LispPTR *stack_pointer); 6 | LispPTR *N_OP_dunbind(LispPTR *stack_pointer, LispPTR tos); 7 | #endif 8 | -------------------------------------------------------------------------------- /bitblt.c: -------------------------------------------------------------------------------- 1 | /* $Id: bitblt.c,v 1.2 1999/01/03 02:06:47 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | #include 14 | 15 | #include "lispemul.h" 16 | #include "lspglob.h" 17 | #include "lispmap.h" 18 | #include "adr68k.h" 19 | #include "address.h" 20 | 21 | #include "pilotbbt.h" 22 | #include "display.h" 23 | #include "bitblt.h" 24 | #include "bb.h" 25 | 26 | #include "bitbltdefs.h" 27 | #include "initdspdefs.h" 28 | 29 | #if defined(INIT) 30 | #include "initkbddefs.h" 31 | extern int kbd_for_makeinit; 32 | #endif 33 | 34 | extern int ScreenLocked; 35 | 36 | /*****************************************************************************/ 37 | /** **/ 38 | /** N_OP_pilotbitblt **/ 39 | /** **/ 40 | /** The Native-code compatible version of the opcode for bitblt. **/ 41 | /** **/ 42 | /** **/ 43 | /*****************************************************************************/ 44 | 45 | LispPTR N_OP_pilotbitblt(LispPTR pilot_bt_tbl, LispPTR tos) 46 | { 47 | PILOTBBT *pbt; 48 | DLword *srcbase, *dstbase; 49 | int sx, dx, w, h, srcbpl, dstbpl, backwardflg; 50 | int src_comp, op, gray, num_gray, curr_gray_line; 51 | 52 | #ifdef INIT 53 | 54 | /* for init, we have to initialize the pointers at the 55 | first call to pilotbitblt or we die. If we do it 56 | earlier we die also. We set a new flag so we don't 57 | do it more than once which is a lose also. 58 | 59 | I put this in an ifdef so there won't be any extra 60 | code when making a regular LDE. */ 61 | 62 | if (!kbd_for_makeinit) { 63 | init_keyboard(0); 64 | kbd_for_makeinit = 1; 65 | } 66 | 67 | #endif 68 | 69 | pbt = (PILOTBBT *)NativeAligned4FromLAddr(pilot_bt_tbl); 70 | 71 | w = pbt->pbtwidth; 72 | h = pbt->pbtheight; 73 | if ((h <= 0) || (w <= 0)) return (pilot_bt_tbl); 74 | dx = pbt->pbtdestbit; 75 | sx = pbt->pbtsourcebit; 76 | backwardflg = pbt->pbtbackward; 77 | /* if displayflg != 0 then source or destination is DisplayBitMap */ 78 | ScreenLocked = T; 79 | 80 | srcbase = (DLword *)NativeAligned2FromLAddr(VAG2(pbt->pbtsourcehi, pbt->pbtsourcelo)); 81 | dstbase = (DLword *)NativeAligned2FromLAddr(VAG2(pbt->pbtdesthi, pbt->pbtdestlo)); 82 | 83 | srcbpl = pbt->pbtsourcebpl; 84 | dstbpl = pbt->pbtdestbpl; 85 | src_comp = pbt->pbtsourcetype; 86 | op = pbt->pbtoperation; 87 | gray = pbt->pbtusegray; 88 | num_gray = ((TEXTUREBBT *)pbt)->pbtgrayheightlessone + 1; 89 | curr_gray_line = ((TEXTUREBBT *)pbt)->pbtgrayoffset; 90 | 91 | new_bitblt_code; 92 | 93 | ScreenLocked = NIL; 94 | 95 | return (pilot_bt_tbl); 96 | 97 | } /* end of N_OP_pilotbitblt */ 98 | 99 | /************************************************************************/ 100 | /* */ 101 | /* c u r s o r i n */ 102 | /* */ 103 | /* */ 104 | /* */ 105 | /************************************************************************/ 106 | 107 | /* for MONO only */ 108 | int cursorin(DLword addrhi, DLword addrlo, int w, int h, int backward) 109 | { 110 | int x, y; 111 | if (addrhi == DISPLAY_HI) { 112 | y = addrlo / DisplayRasterWidth; 113 | x = (addrlo - y * DisplayRasterWidth) << 4; 114 | } else if (addrhi == DISPLAY_HI + 1) { 115 | y = (addrlo + DLWORDSPER_SEGMENT) / DisplayRasterWidth; 116 | x = ((addrlo + DLWORDSPER_SEGMENT) - y * DisplayRasterWidth) << 4; 117 | } else 118 | return (NIL); 119 | 120 | if (backward) y -= h; 121 | 122 | if ((x < MOUSEXR) && (x + w > MOUSEXL) && (y < MOUSEYH) && (y + h > MOUSEYL)) 123 | return (T); 124 | else 125 | return (NIL); 126 | } 127 | -------------------------------------------------------------------------------- /bitblt.h: -------------------------------------------------------------------------------- 1 | #ifndef BITBLT_H 2 | #define BITBLT_H 1 3 | /* $Id: bitblt.h,v 1.2 1999/01/03 02:05:54 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | /* 5 | * Copyright (C) 1988 by Fuji Xerox Co., Ltd. All rights reserved. 6 | * 7 | * File : bitblt.h 8 | * 9 | * Author : Osamu Nakamura 10 | * 11 | */ 12 | 13 | /************************************************************************/ 14 | /* */ 15 | /* Copyright 1989, 1990 Venue, Fuji Xerox Co., Ltd, Xerox Corp. */ 16 | /* */ 17 | /* This file is work-product resulting from the Xerox/Venue */ 18 | /* Agreement dated 18-August-1989 for support of Medley. */ 19 | /* */ 20 | /************************************************************************/ 21 | #include "lispemul.h" /* for DLword */ 22 | 23 | #define REPLACE 0 24 | #define PAINT 2 25 | #define ERASE 1 26 | #define INVERT 3 27 | #define ERROR PIX_SRC 28 | 29 | #define PixOperation( SRCTYPE, OPERATION ) \ 30 | ( (SRCTYPE) == ERASE ? \ 31 | ((OPERATION) == REPLACE ? PIX_NOT(PIX_SRC) : \ 32 | ((OPERATION) == PAINT ? PIX_NOT(PIX_SRC) | PIX_DST : \ 33 | ((OPERATION) == ERASE ? PIX_NOT(PIX_SRC) & PIX_DST : \ 34 | ((OPERATION) == INVERT ? PIX_NOT(PIX_SRC) ^ PIX_DST : ERROR)))) : \ 35 | /* SRCTYPE == INPUT */ \ 36 | ((OPERATION) == REPLACE ? PIX_SRC : \ 37 | ((OPERATION) == PAINT ? PIX_SRC | PIX_DST : \ 38 | ((OPERATION) == ERASE ? PIX_SRC & PIX_DST : \ 39 | ((OPERATION) == INVERT ? PIX_SRC ^ PIX_DST : ERROR))))) 40 | 41 | 42 | extern DLword *EmMouseX68K, *EmMouseY68K; 43 | extern int DisplayRasterWidth; 44 | #define XDELTA 50 45 | #define YDELTA 50 46 | #define MOUSEXL ((int)*EmMouseX68K - XDELTA) 47 | #define MOUSEXR ((int)*EmMouseX68K + XDELTA) 48 | #define MOUSEYL ((int)*EmMouseY68K - YDELTA) 49 | #define MOUSEYH ((int)*EmMouseY68K + YDELTA) 50 | 51 | 52 | extern DLword *EmCursorX68K,*EmCursorY68K; 53 | #define HideCursor { taking_mouse_down();} 54 | #define ShowCursor { taking_mouse_up(*EmCursorX68K,*EmCursorY68K);} 55 | 56 | #define refresh_CG6 \ 57 | HideCursor; \ 58 | pr_rop(ColorDisplayPixrect, 0, 0, displaywidth, displayheight, \ 59 | PIX_SRC,DisplayRegionPixrect, 0, 0); \ 60 | ShowCursor; 61 | 62 | #define clear_CG6 \ 63 | HideCursor; \ 64 | pr_rop(ColorDisplayPixrect, 0, 0, displaywidth, displayheight, \ 65 | PIX_CLR, ColorDisplayPixrect, 0, 0); \ 66 | ShowCursor; 67 | 68 | 69 | /* Macro for locking and unlocking screen to prevent multiple updates */ 70 | 71 | 72 | #define LOCKSCREEN ScreenLocked = T 73 | #define UNLOCKSCREEN ScreenLocked = NIL 74 | 75 | #endif /* BITBLT_H */ 76 | -------------------------------------------------------------------------------- /bitbltdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef BITBLTDEFS_H 2 | #define BITBLTDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | LispPTR N_OP_pilotbitblt(LispPTR pilot_bt_tbl, LispPTR tos); 5 | int cursorin(DLword addrhi, DLword addrlo, int w, int h, int backward); 6 | #endif 7 | 8 | -------------------------------------------------------------------------------- /blt.c: -------------------------------------------------------------------------------- 1 | /* $Id: blt.c,v 1.3 1999/05/31 23:35:24 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | /* 13 | * 14 | * Author : Takeshi Shimizu 15 | * 16 | */ 17 | /******************************************************************/ 18 | /* 19 | File Name : blt.c 20 | Including : OP_blt 21 | 22 | Created : jul 9, 1987 by T.Shimizu 23 | */ 24 | /******************************************************************/ 25 | 26 | #include "lispemul.h" 27 | #include "address.h" 28 | #include "adr68k.h" 29 | #include "lsptypes.h" 30 | #include "lispmap.h" 31 | #include "stack.h" 32 | #include "lspglob.h" 33 | #include "cell.h" 34 | 35 | #include "bltdefs.h" 36 | 37 | /* 38 | N_OP_blt takes 3 arguments. 39 | STK-1 has destination's pointer. 40 | STK has source's pointer. 41 | TOS has number of words to be translated. 42 | */ 43 | 44 | LispPTR N_OP_blt(LispPTR destptr, LispPTR sourceptr, LispPTR wordcount) { 45 | DLword *source68k; 46 | DLword *dest68k; 47 | int nw; 48 | 49 | if ((wordcount & SEGMASK) != S_POSITIVE) ERROR_EXIT(wordcount); 50 | nw = wordcount & 0xffff; 51 | 52 | source68k = NativeAligned2FromLAddr(sourceptr) + nw; 53 | dest68k = NativeAligned2FromLAddr(destptr) + nw; 54 | 55 | while (nw) { 56 | (GETWORD(--dest68k)) = GETWORD(--source68k); 57 | nw--; 58 | } 59 | 60 | return (wordcount); 61 | } /* end N_OP_blt */ 62 | -------------------------------------------------------------------------------- /bltdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef BLTDEFS_H 2 | #define BLTDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_blt(LispPTR destptr, LispPTR sourceptr, LispPTR wordcount); 5 | #endif 6 | 7 | -------------------------------------------------------------------------------- /byteswapdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef BYTESWAPDEFS_H 2 | #define BYTESWAPDEFS_H 1 3 | 4 | /****************************************************************/ 5 | /* */ 6 | /* swap halves of a single 4-byte word */ 7 | /* */ 8 | /****************************************************************/ 9 | static inline unsigned int swapx(unsigned int word) { 10 | return (((word >> 16) & 0xffff) | ((word & 0xffff) << 16)); 11 | } 12 | 13 | void word_swap_page(void *page, unsigned longwordcount); 14 | void bit_reverse_region(unsigned short *top, int width, int height, int rasterwidth); 15 | #ifdef RESWAPPEDCODESTREAM 16 | unsigned int byte_swap_code_block(unsigned int *base); 17 | #endif 18 | #endif 19 | -------------------------------------------------------------------------------- /car-cdrdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef CAR_CDRDEFS_H 2 | #define CAR_CDRDEFS_H 1 3 | #include "cell.h" /* for ConsCell */ 4 | #include "lispemul.h" /* for LispPTR */ 5 | LispPTR car(LispPTR datum); 6 | LispPTR cdr(LispPTR datum); 7 | LispPTR rplaca(LispPTR x, LispPTR y); 8 | LispPTR rplacd(LispPTR x, LispPTR y); 9 | LispPTR N_OP_car(LispPTR tos); 10 | LispPTR N_OP_cdr(LispPTR tos); 11 | LispPTR N_OP_rplaca(LispPTR tosm1, LispPTR tos); 12 | LispPTR N_OP_rplacd(LispPTR tosm1, LispPTR tos); 13 | ConsCell *find_close_prior_cell(struct conspage *page, LispPTR oldcell); 14 | #endif 15 | -------------------------------------------------------------------------------- /chardevdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef CHARDEVDEFS_H 2 | #define CHARDEVDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR CHAR_openfile(LispPTR *args); 5 | LispPTR CHAR_closefile(LispPTR *args); 6 | LispPTR CHAR_ioctl(LispPTR *args); 7 | LispPTR CHAR_bin(int id, LispPTR errn); 8 | LispPTR CHAR_bout(int id, LispPTR ch, LispPTR errn); 9 | LispPTR CHAR_bins(LispPTR *args); 10 | LispPTR CHAR_bouts(LispPTR *args); 11 | #endif 12 | -------------------------------------------------------------------------------- /common.c: -------------------------------------------------------------------------------- 1 | /* $Id: common.c,v 1.2 1999/01/03 02:06:52 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989, 1990, 1990, 1991, 1992, 1993, 1994, 1995 Venue. */ 7 | /* All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | 12 | #include "version.h" 13 | 14 | #include // for fflush, fprintf, printf, getchar, stderr 15 | #include // for exit 16 | #include // for memset 17 | #include "commondefs.h" // for error, stab, warn 18 | #include "dbprint.h" // for DBPRINT 19 | #include "kprintdefs.h" // for print 20 | #include "lispemul.h" // for NIL, DLword, LispPTR 21 | #include "lspglob.h" 22 | #include "tinydir.h" 23 | #ifdef _WIN32 24 | #include 25 | #define _mkdir mkdir 26 | #else 27 | #include 28 | #endif 29 | 30 | void stab(void) { DBPRINT(("Now in stab\n")); } 31 | 32 | /*************************************************************** 33 | error 34 | common sub-routine. 35 | 36 | Printout error message. 37 | Enter URAID. 38 | And exit.(takeshi) 39 | 40 | ******************************************************************/ 41 | 42 | extern int LispKbdFd; 43 | extern struct screen LispScreen; 44 | extern int displaywidth, displayheight; 45 | extern DLword *DisplayRegion68k; 46 | extern int FrameBufferFd; 47 | extern int BT_temp; /* holds the continue-character the user typed */ 48 | 49 | /* Currentry Don't care Ether re-initial */ 50 | /* Medley only */ 51 | 52 | /************************************************************************/ 53 | /* */ 54 | /* e r r o r */ 55 | /* */ 56 | /* Last-ditch error handling; enters URAID, low-level debug. */ 57 | /* */ 58 | /************************************************************************/ 59 | 60 | LispPTR Uraid_mess = NIL; 61 | 62 | int error(const char *cp) { 63 | #if 0 64 | if (device_before_raid() < 0) { 65 | (void)fprintf(stderr, "Can't Enter URAID.\n"); 66 | exit(-1); 67 | } 68 | #endif 69 | /* comm read */ 70 | (void)fprintf(stderr, "\n*Error* %s\n", cp); 71 | fflush(stdin); 72 | 73 | exit(-1); 74 | return (0); 75 | } 76 | 77 | /************************************************************************/ 78 | /* */ 79 | /* w a r n */ 80 | /* */ 81 | /* Print a warning message, but don't stop running. */ 82 | /* */ 83 | /************************************************************************/ 84 | 85 | void warn(const char *s) 86 | { printf("\nWARN: %s \n", s); } 87 | 88 | 89 | ////////////////////////////////////////////////////////////////////////// 90 | 91 | 92 | int file_exists(const char* path) 93 | { 94 | tinydir_file file; 95 | return tinydir_file_open(&file, path); 96 | } 97 | 98 | int can_read_file(const char* path) 99 | { 100 | tinydir_file file; 101 | const int res = tinydir_file_open(&file, path); 102 | if( res < 0 ) 103 | return res; 104 | if( !(file._s.st_mode & S_IRUSR) ) 105 | { 106 | errno = EACCES; 107 | return -1; 108 | } 109 | return 0; 110 | } 111 | 112 | #define MAX_FILE_DESCRIPTOR 100 113 | 114 | static FILE* file_descriptors[MAX_FILE_DESCRIPTOR] = {0}; 115 | 116 | int create_file_descriptor(FILE* file) 117 | { 118 | if( file == NULL ) 119 | return -1; 120 | for( int i = 0; i < MAX_FILE_DESCRIPTOR; i++ ) 121 | { 122 | if( file_descriptors[i] == 0 ) 123 | { 124 | file_descriptors[i] = file; 125 | return i; 126 | } 127 | } 128 | return -1; 129 | } 130 | 131 | FILE* get_file_pointer(int fd) 132 | { 133 | if( fd < 0 || fd >= MAX_FILE_DESCRIPTOR ) 134 | return 0; 135 | return file_descriptors[fd]; 136 | } 137 | 138 | void free_file_descriptor(int fd) 139 | { 140 | if( fd < 0 || fd >= MAX_FILE_DESCRIPTOR ) 141 | return; 142 | file_descriptors[fd] = 0; 143 | } 144 | 145 | int create_dir(const char* path) 146 | { 147 | return mkdir(path, 0777); 148 | } 149 | 150 | -------------------------------------------------------------------------------- /commondefs.h: -------------------------------------------------------------------------------- 1 | #ifndef COMMONDEFS_H 2 | #define COMMONDEFS_H 1 3 | 4 | #include 5 | 6 | extern void stab(void); 7 | extern void warn(const char *s); 8 | extern int error(const char *s); 9 | extern int file_exists(const char*); 10 | extern int can_read_file(const char*); 11 | extern const char* get_home_dir(); 12 | extern int create_file_descriptor(FILE*); 13 | extern void free_file_descriptor(int fd); 14 | extern FILE* get_file_pointer(int fd); 15 | extern int create_dir(const char* path); 16 | 17 | #endif 18 | -------------------------------------------------------------------------------- /conspagedefs.h: -------------------------------------------------------------------------------- 1 | #ifndef CONSPAGEDEFS_H 2 | #define CONSPAGEDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | struct conspage *next_conspage(void); 5 | LispPTR N_OP_cons(LispPTR cons_car, LispPTR cons_cdr); 6 | LispPTR cons(LispPTR cons_car, LispPTR cons_cdr); 7 | #endif 8 | -------------------------------------------------------------------------------- /dbprint.h: -------------------------------------------------------------------------------- 1 | #ifndef DBPRINT_H 2 | #define DBPRINT_H 1 3 | /* $Id: dbprint.h,v 1.2 1999/01/03 02:05:55 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | 7 | /************************************************************************/ 8 | /* */ 9 | /* (C) Copyright 1989-92 Venue. All Rights Reserved. */ 10 | /* Manufactured in the United States of America. */ 11 | /* */ 12 | /************************************************************************/ 13 | 14 | #include 15 | 16 | /* ================================================================ */ 17 | /* Debugprint usage: DBPRINT( paren'ed arglist ) 18 | 19 | e.g. DBPRINT ( ("value of foo is %d\n", foo) ); 20 | 21 | the double parens are needed because of cpp's limited macro 22 | capability (can only handle variable number of args if they 23 | are paren'ed. The motivation for this macro is, its easier to 24 | read: 25 | DBPRINT ( ("value of foo is %d\n", foo) ); 26 | than: 27 | #ifdef DEBUG 28 | printf("value of foo is %d\n", foo); 29 | #endif 30 | 31 | e.g. TRACER(expr); 32 | 33 | executes the expression if TRACE is on. */ 34 | /* ================================================================ */ 35 | 36 | /* For debugging print statements */ 37 | 38 | #if defined(DEBUG) || defined(TRACE) || defined(OPTRACE) || defined(FNTRACE) || defined(FNSTKCHECK) 39 | extern int flushing; 40 | #endif 41 | 42 | #ifdef DEBUG 43 | #define DBPRINT(X) do { printf("%s:%d ", __FILE__, __LINE__); printf X ; if (flushing) fflush(stdout); } while(0) 44 | #define DEBUGGER(X) X 45 | #else 46 | #define DBPRINT(X) if (0) do {printf X ; } while(0) 47 | #define DEBUGGER(X) 48 | #endif 49 | 50 | 51 | /* For trace print statements */ 52 | 53 | #ifdef TRACE 54 | #define TPRINT(X) do { printf("%s:%d ", __FILE__, __LINE__); printf X; if (flushing) fflush(stdout); } while (0) 55 | #define TRACER(X) X 56 | #else /* TRACE */ 57 | 58 | #define TPRINT(X) if (0) do { printf X; } while (0) 59 | #define TRACER(X) 60 | #endif /* TRACE */ 61 | 62 | 63 | 64 | /* For tracing individual opcode executions */ 65 | 66 | #ifdef OPTRACE 67 | #define OPTPRINT(X) do { printf("%s:%d ", __FILE__, __LINE__); printf X; if (flushing) fflush(stdout); } while (0) 68 | #define OPTRACER(X) X 69 | #else 70 | #define OPTPRINT(X) if (0) do { printf X; } while (0) 71 | #define OPTRACER(X) 72 | #endif 73 | 74 | 75 | /* For tracing function calls */ 76 | 77 | #ifdef FNTRACE 78 | #define FNTPRINT(X) do { printf("%s:%d ", __FILE__, __LINE__); printf X; if (flushing) fflush(stdout); } while (0) 79 | #define FNTRACER(X) X 80 | #else 81 | #define FNTPRINT(X) if (0) do { printf X; } while (0) 82 | #define FNTRACER(X) 83 | #endif 84 | 85 | 86 | /* For function-call & return stack checking */ 87 | 88 | #ifdef FNSTKCHECK 89 | #define FNCHKPRINT(X) do { printf("%s:%d ", __FILE__, __LINE__); printf X ; if (flushing) fflush(stdout); } while (0) 90 | #define FNCHECKER(X) X 91 | #else 92 | #define FNCHKPRINT(X) if (0) do { printf X; } while (0) 93 | #define FNCHECKER(X) 94 | #endif 95 | 96 | #endif /* DBPRINT_H */ 97 | -------------------------------------------------------------------------------- /devconf.h: -------------------------------------------------------------------------------- 1 | #ifndef DEVCONF_H 2 | #define DEVCONF_H 1 3 | /* $Id: devconf.h,v 1.2 1999/01/03 02:05:56 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | /**********************************************************/ 5 | /* 6 | devconf.h 7 | 8 | Device Configurations assignments 9 | for IFPAGE->devconfig 10 | 11 | LSB(0)~3 -> KBD 12 | 4~7 -> DISPLAY, 13 | 8~10 -> CPU 14 | 15 | [CPU] [DSP] [KB] 16 | !!!!!! !!! !!!! !!! LSB> 17 | 18 | By Takeshi 19 | */ 20 | /**********************************************************/ 21 | 22 | 23 | 24 | /************************************************************************/ 25 | /* */ 26 | /* Copyright 1989, 1990 Venue, Fuji Xerox Co., Ltd, Xerox Corp. */ 27 | /* */ 28 | /* This file is work-product resulting from the Xerox/Venue */ 29 | /* Agreement dated 18-August-1989 for support of Medley. */ 30 | /* */ 31 | /************************************************************************/ 32 | 33 | 34 | 35 | 36 | /* MAIKO(sun3,sun4)*/ 37 | /* KBD */ 38 | #define SUN_KEYTYPE_MASK 7 39 | #define SUN_TYPE3_KBD 0x0 40 | #define SUN_TYPE4_KBD 0x1 41 | 42 | /* DISPLAY */ 43 | #define SUN_DISPTYPE_MASK 0x78 44 | #define SUN2BW (2<<3) 45 | #define SUN2COLOR (3<<3) 46 | #define SUN4COLOR (8<<3) 47 | #define SUNMEMCOLOR (7<<3) 48 | 49 | /* CPUTYPE NOT IMPLEMENTED */ 50 | 51 | /* useful macros */ 52 | #define SUN_GETKEYTYPE (InterfacePage->devconfig & SUN_KEYTYPE_MASK) 53 | #define SUN_GETDISPTYPE (InterfacePage->devconfig & SUN_DISPTYPE_MASK) 54 | #endif /* DEVCONF_H */ 55 | -------------------------------------------------------------------------------- /dirdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef DIRDEFS_H 2 | #define DIRDEFS_H 1 3 | 4 | #include "lispemul.h" // for LispPTR 5 | #include "locfile.h" // for MAXNAMLEN 6 | /* 7 | * FINFO and FPROP are used to store the information of the enumerated files 8 | * and directories. They are arranged in a form of linked list. Each list is 9 | * corresponding to the each directory enumeration. All of the informations 10 | * Lisp needs are stored in the list. This list is in the emulator's address space 11 | * and can be specified by "ID" which is the interface between the emulator and Lisp 12 | * code. In this implementation, ID is represented as an integer and is actually 13 | * an index of the array of the lists. 14 | * 15 | * To avoid the overhead of the FINFO and FPROP structure dynamic allocation and 16 | * deallocation, some number of their instances are pre-allocated when the emulator 17 | * starts and managed in a free list. If all of the pre-allocated instances are in 18 | * use, new instances are allocated. The new instances are linked to the free list 19 | * when it is freed. 20 | * 21 | * As described above, the linked list result of the enumeration is stored in a 22 | * array for the subsequent request from Lisp. Lisp code requests the emulator to 23 | * release the list when it enumerated all of the entries in the list or the 24 | * enumerating operation is aborted. 25 | */ 26 | 27 | 28 | #ifdef FSDEBUG 29 | void print_finfo(FINFO *fp); 30 | #endif 31 | int init_finfo(void); 32 | LispPTR COM_gen_files(LispPTR *args); 33 | LispPTR COM_next_file(LispPTR *args); 34 | LispPTR COM_finish_finfo(LispPTR *args); 35 | #endif 36 | -------------------------------------------------------------------------------- /display.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 2025 Rochus Keller 3 | * 4 | * This file is part of the Gingko project. 5 | * 6 | * The following is the license that applies to this copy of the 7 | * file. For a license to use the file under conditions 8 | * other than those described here, please email to me@rochus-keller.ch. 9 | * 10 | * GNU General Public License Usage 11 | * This file may be used under the terms of the GNU General Public 12 | * License (GPL) versions 2.0 or 3.0 as published by the Free Software 13 | * Foundation and appearing in the file LICENSE.GPL included in 14 | * the packaging of this file. Please review the following information 15 | * to ensure GNU General Public Licensing requirements will be met: 16 | * http://www.fsf.org/licensing/licenses/info/GPLv2.html and 17 | * http://www.gnu.org/copyleft/gpl.html. 18 | */ 19 | 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include "sdldefs.h" 26 | #include "byteswapdefs.h" 27 | #include "lispemul.h" 28 | #include "lsptypes.h" 29 | #include "keyboard.h" 30 | #include "lspglob.h" // for IOPage 31 | #include "display.h" // for CURSORHEIGHT, DisplayRegion68k 32 | #include "keyboard.h" 33 | 34 | extern int error(const char *s); 35 | extern DLword *EmKbdAd068K, *EmKbdAd168K, *EmKbdAd268K, *EmKbdAd368K, *EmKbdAd468K, *EmKbdAd568K, 36 | *EmRealUtilin68K; 37 | extern DLword *CTopKeyevent; 38 | extern LispPTR *KEYBUFFERING68k; 39 | extern int URaid_req; 40 | extern DLword *EmCursorX68K, *EmCursorY68K; 41 | extern DLword *EmMouseX68K, *EmMouseY68K; 42 | extern LispPTR *CLastUserActionCell68k; 43 | extern int KBDEventFlg; 44 | /* Mouse buttons */ 45 | #define MOUSE_LEFT 13 46 | #define MOUSE_RIGHT 14 47 | #define MOUSE_MIDDLE 15 48 | 49 | void display_notify_lisp() { 50 | DLword w, r; 51 | KBEVENT *kbevent; 52 | 53 | /* DEL is not generally present on a Mac X keyboard, Ctrl-shift-ESC would be 18496 */ 54 | if (((*EmKbdAd268K) & 2113) == 0) { /*Ctrl-shift-NEXT*/ 55 | error("****** EMERGENCY Interrupt ******"); 56 | *EmKbdAd268K = KB_ALLUP; /*reset*/ 57 | ((RING *)CTopKeyevent)->read = 0; /* reset queue */ 58 | ((RING *)CTopKeyevent)->write = MINKEYEVENT; 59 | /*return(0);*/ 60 | } else if (((*EmKbdAd268K) & 2114) == 0) { /* Ctrl-Shift-DEL */ 61 | *EmKbdAd268K = KB_ALLUP; /*reset*/ 62 | URaid_req = T; 63 | ((RING *)CTopKeyevent)->read = 0; /* reset queue */ 64 | ((RING *)CTopKeyevent)->write = MINKEYEVENT; 65 | /*return(0);*/ 66 | } 67 | 68 | r = RING_READ(CTopKeyevent); 69 | w = RING_WRITE(CTopKeyevent); 70 | 71 | if (r == w) /* event queue FULL */ 72 | { 73 | printf("event queue FULL\n"); 74 | fflush(stdout); 75 | goto KBnext; 76 | } 77 | 78 | kbevent = (KBEVENT *)(CTopKeyevent + w); 79 | /* RCLK(kbevent->time); */ 80 | kbevent->W0 = *EmKbdAd068K; 81 | kbevent->W1 = *EmKbdAd168K; 82 | kbevent->W2 = *EmKbdAd268K; 83 | kbevent->W3 = *EmKbdAd368K; 84 | kbevent->W4 = *EmKbdAd468K; 85 | kbevent->W5 = *EmKbdAd568K; 86 | kbevent->WU = *EmRealUtilin68K; 87 | 88 | if (r == 0) /* Queue was empty */ 89 | ((RING *)CTopKeyevent)->read = w; 90 | if (w >= MAXKEYEVENT) 91 | ((RING *)CTopKeyevent)->write = MINKEYEVENT; 92 | else 93 | ((RING *)CTopKeyevent)->write = w + KEYEVENTSIZE; 94 | 95 | KBnext: 96 | if (*KEYBUFFERING68k == NIL) *KEYBUFFERING68k = ATOM_T; 97 | 98 | if ((KBDEventFlg += 1) > 0) Irq_Stk_End = Irq_Stk_Check = 0; 99 | } 100 | 101 | void display_notify_mouse_pos(int x, int y) 102 | { 103 | *CLastUserActionCell68k = MiscStats->secondstmp; 104 | *EmCursorX68K = (*((DLword *)EmMouseX68K)) = (short)(x & 0xFFFF); 105 | *EmCursorY68K = (*((DLword *)EmMouseY68K)) = (short)(y & 0xFFFF); 106 | } 107 | 108 | void display_left_mouse_button(int on) 109 | { 110 | PUTBASEBIT68K(EmRealUtilin68K, MOUSE_LEFT, !on); 111 | } 112 | 113 | void display_mid_mouse_button(int on) 114 | { 115 | PUTBASEBIT68K(EmRealUtilin68K, MOUSE_MIDDLE, !on); 116 | } 117 | 118 | void display_right_mouse_button(int on) 119 | { 120 | PUTBASEBIT68K(EmRealUtilin68K, MOUSE_RIGHT, !on); 121 | } 122 | 123 | -------------------------------------------------------------------------------- /display.h: -------------------------------------------------------------------------------- 1 | #ifndef DISPLAY_H 2 | #define DISPLAY_H 1 3 | 4 | /* $Id: display.h,v 1.2 1999/01/03 02:05:57 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 5 | 6 | /************************************************************************/ 7 | /* */ 8 | /* (C) Copyright 1989-94 Venue. All Rights Reserved. */ 9 | /* Manufactured in the United States of America. */ 10 | /* */ 11 | /************************************************************************/ 12 | #include "lispemul.h" /* for DLword */ 13 | 14 | #define BCPLDISPLAY stdout 15 | 16 | #define CURSORWIDTH 16 17 | #define CURSORHEIGHT 16 18 | 19 | /* Max address for HI-RES DISPLAY */ 20 | /* Osamu '90/02/08 21 | * Change into variable for efficiency 22 | #define DISP_MAX_Address (DisplayRegion68k + 1600*1280/8) 23 | */ 24 | extern DLword *DISP_MAX_Address; 25 | 26 | /* Is the bitmap in the display region? */ 27 | 28 | #define IN_DISPLAY_BANK(hiaddr) (((hiaddr)==DISPLAY_HI)|((hiaddr)==(DISPLAY_HI+1))) 29 | 30 | #define DLWORD_PERLINE (displaywidth/16) 31 | #define HARD_CURSORWIDTH 16 32 | #define HARD_CURSORHEIGHT 16 33 | #define COLOR_BITSPER_PIXEL 8 34 | #define MONO_SCREEN 0 35 | #define COLOR_SCREEN 1 36 | #define COLOR_MAX_Address (ColorDisplayRegion68k + 1152 * 900) 37 | 38 | /* Replicate a 4-bit pattern to fill a word */ 39 | #define Expand4Bit(BITS) \ 40 | ((BITS) | ((BITS) << 4) | ((BITS) << 8) | ((BITS) << 12)) 41 | 42 | #if defined SDL 43 | #define DISPLAYBUFFER 44 | #endif /* SDL */ 45 | 46 | #ifdef DISPLAYBUFFER 47 | /************************************************************************/ 48 | /* */ 49 | /* i n _ d i s p l a y _ s e g m e n t */ 50 | /* */ 51 | /* Returns T if the base address for this bitblt is in the */ 52 | /* display segment. */ 53 | /* */ 54 | /************************************************************************/ 55 | /* Osamu '90/02/08 56 | * This definition is moved from initdsp.c 57 | * Changed into a macro for efficiency. 58 | * Also DISP_MAX_Address is changed to a variable 59 | * to avoid doing the same calculation every time it is used. 60 | *********************************************************************/ 61 | extern DLword *DisplayRegion68k; 62 | 63 | #define in_display_segment(baseaddr) \ 64 | (((DisplayRegion68k <= (baseaddr)) && \ 65 | ((baseaddr) <= DISP_MAX_Address)) ? T : NIL ) 66 | #endif 67 | 68 | extern void display_notify_lisp(); 69 | extern void display_notify_mouse_pos(int x, int y); 70 | extern void display_left_mouse_button(int on); 71 | extern void display_mid_mouse_button(int on); 72 | extern void display_right_mouse_button(int on); 73 | 74 | #endif 75 | -------------------------------------------------------------------------------- /drawdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef DRAWDEFS_H 2 | #define DRAWDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | int N_OP_drawline(LispPTR ptr, int curbit, int xsize, int width, int ysize, int op, int delta, int numx, int numy); 5 | #endif 6 | -------------------------------------------------------------------------------- /dskdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef DSKDEFS_H 2 | #define DSKDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | void separate_host(char *lfname, char *host); 5 | LispPTR COM_openfile(LispPTR *args); 6 | LispPTR COM_closefile(LispPTR *args); 7 | LispPTR DSK_getfilename(LispPTR *args); 8 | LispPTR DSK_deletefile(LispPTR *args); 9 | LispPTR DSK_renamefile(LispPTR *args); 10 | LispPTR DSK_directorynamep(LispPTR *args); 11 | LispPTR COM_getfileinfo(LispPTR *args); 12 | LispPTR COM_setfileinfo(LispPTR *args); 13 | LispPTR COM_readpage(LispPTR *args); 14 | LispPTR COM_writepage(LispPTR *args); 15 | LispPTR COM_truncatefile(LispPTR *args); 16 | LispPTR COM_changedir(LispPTR *args); 17 | LispPTR COM_getfreeblock(LispPTR *args); 18 | void separate_version(char *name, char *ver, int checkp); 19 | int unpack_filename(char *file, char *dir, char *name, char *ver, int checkp); 20 | int true_name(char *path); 21 | #endif 22 | -------------------------------------------------------------------------------- /dspdata.h: -------------------------------------------------------------------------------- 1 | #ifndef DSPDATA_H 2 | #define DSPDATA_H 1 3 | /* $Id: dspdata.h,v 1.2 1999/01/03 02:05:58 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /************************************************************************/ 6 | /* */ 7 | /* (C) Copyright 1989-92 Venue. All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | #include "lispemul.h" /* for LispPTR, DLword */ 12 | #include "version.h" /* for BIGVM */ 13 | 14 | #ifndef BYTESWAP 15 | /******************************************************/ 16 | /* Normal-byte-order declarations, for, e.g., 68020's */ 17 | /******************************************************/ 18 | typedef struct displaydata{ 19 | 20 | LispPTR ddxposition ; 21 | LispPTR ddyposition; 22 | LispPTR ddxoffset; 23 | LispPTR ddyoffset; 24 | LispPTR dddestination; 25 | LispPTR ddclippingregion; 26 | LispPTR ddfont; 27 | LispPTR ddslowprintingcase; 28 | LispPTR ddwidthscache; 29 | LispPTR ddoffsetscache; 30 | LispPTR ddcolor; 31 | LispPTR ddlinefeed; 32 | LispPTR ddrightmargin; 33 | LispPTR ddleftmargin; 34 | LispPTR ddscroll; 35 | LispPTR ddoperation; 36 | unsigned ddheldflg : 1; 37 | #ifdef BIGVM 38 | unsigned nil1 : 3; 39 | unsigned ddsourcetype : 28; 40 | #else 41 | unsigned nil1 : 7; 42 | unsigned ddsourcetype : 24; 43 | #endif /* BIGVM */ 44 | DLword ddclippingleft; 45 | DLword ddclippingright; 46 | DLword ddclippingbottom; 47 | DLword ddclippingtop; 48 | DLword nil2; 49 | DLword ddcharsetascent; 50 | LispPTR xwindowhint ; /* xpointer */ 51 | LispPTR ddpilotbbt; 52 | LispPTR ddxscale; 53 | LispPTR ddyscale; 54 | LispPTR ddcharimagewidths;/* Lisp POINTER to DLword array (49,50)*/ 55 | LispPTR ddeolfn; 56 | LispPTR ddpagefullfn; 57 | LispPTR ddtexture; 58 | LispPTR ddmicaxpos; 59 | LispPTR ddmicaypos; 60 | LispPTR ddmicarightmargin; 61 | LispPTR ddcharset; 62 | DLword ddcharsetdescent; 63 | DLword ddspacewidth; /* ??*/ 64 | LispPTR ddcharheightdelta; /* NUM PTR */ 65 | }DISPLAYDATA; 66 | 67 | #else 68 | /*************************************************/ 69 | /* Byte-swapped declarations, for, e.g., 80386's */ 70 | /*************************************************/ 71 | typedef struct displaydata{ 72 | 73 | LispPTR ddxposition ; 74 | LispPTR ddyposition; 75 | LispPTR ddxoffset; 76 | LispPTR ddyoffset; 77 | LispPTR dddestination; 78 | LispPTR ddclippingregion; 79 | LispPTR ddfont; 80 | LispPTR ddslowprintingcase; 81 | LispPTR ddwidthscache; 82 | LispPTR ddoffsetscache; 83 | LispPTR ddcolor; 84 | LispPTR ddlinefeed; 85 | LispPTR ddrightmargin; 86 | LispPTR ddleftmargin; 87 | LispPTR ddscroll; 88 | LispPTR ddoperation; 89 | #ifdef BIGVM 90 | unsigned ddsourcetype : 28; 91 | unsigned nil1 : 3; 92 | #else 93 | unsigned ddsourcetype : 24; 94 | unsigned nil1 : 7; 95 | #endif /* BIGVM */ 96 | unsigned ddheldflg : 1; 97 | 98 | DLword ddclippingright; 99 | DLword ddclippingleft; 100 | DLword ddclippingtop; 101 | DLword ddclippingbottom; 102 | DLword ddcharsetascent; 103 | DLword nil2; 104 | 105 | LispPTR xwindowhint ; /* xpointer */ 106 | LispPTR ddpilotbbt; 107 | LispPTR ddxscale; 108 | LispPTR ddyscale; 109 | LispPTR ddcharimagewidths;/* Lisp POINTER to DLword array (49,50)*/ 110 | LispPTR ddeolfn; 111 | LispPTR ddpagefullfn; 112 | LispPTR ddtexture; 113 | LispPTR ddmicaxpos; 114 | LispPTR ddmicaypos; 115 | LispPTR ddmicarightmargin; 116 | LispPTR ddcharset; 117 | DLword ddspacewidth; /* ??*/ 118 | DLword ddcharsetdescent; 119 | LispPTR ddcharheightdelta; /* NUM PTR */ 120 | }DISPLAYDATA; 121 | 122 | #endif /* BYTESWAP */ 123 | 124 | #endif /* DSPDATA_H */ 125 | -------------------------------------------------------------------------------- /dspifdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef DSPIFDEFS_H 2 | #define DSPIFDEFS_H 1 3 | #include "devif.h" 4 | void make_dsp_instance(DspInterface dsp, char *lispbitmap, int width_hint, int height_hint, int depth_hint); 5 | unsigned long GenericReturnT(void *d); 6 | void GenericReturnVoid(void *d); 7 | void GenericPanic(void *d); 8 | void describedsp(DspInterface dsp); 9 | #endif 10 | -------------------------------------------------------------------------------- /dspsubrs.c: -------------------------------------------------------------------------------- 1 | /* $Id: dspsubrs.c,v 1.3 2001/12/26 22:17:02 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | /*** ADOPTED NEW VERSION ***/ 4 | 5 | /************************************************************************/ 6 | /* */ 7 | /* (C) Copyright 1989-2000 Venue. All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | 12 | #include "version.h" 13 | 14 | #include // for putc 15 | #include "arith.h" // for GetSmalldata 16 | #include "display.h" // for BCPLDISPLAY, CURSORHEIGHT 17 | #include "dspsubrsdefs.h" // for DSP_Cursor, DSP_ScreenHight, DSP_ScreenWidth 18 | #include "lispemul.h" // for LispPTR, DLword, ATOM_T, NIL 19 | #include "lispmap.h" // for S_POSITIVE 20 | #include "lsptypes.h" // for GETWORD 21 | #if defined(SDL) 22 | #include "sdldefs.h" 23 | #endif 24 | 25 | extern int DebugDSP; 26 | extern int displaywidth, displayheight; 27 | 28 | /**************************************************** 29 | * 30 | * DSP_dspbout() entry of SUBRCALL 9 1 31 | * called from (DSPBOUT X) 32 | * 33 | ****************************************************/ 34 | 35 | void DSP_dspbout(LispPTR *args) /* args[0] : charcode */ 36 | { putc((args[0] & 0xFFFF) & 0x7f, BCPLDISPLAY); } 37 | 38 | /**************************************************** 39 | * 40 | * DSP_showdisplay() entry of SUBRCALL 19 2 41 | * called from (SHOWDISPLAY BASE RASTERWIDTH) 42 | * 43 | ****************************************************/ 44 | 45 | extern int DisplayInitialized; 46 | 47 | void DSP_showdisplay(LispPTR *args) 48 | { DisplayInitialized = 1; } 49 | 50 | /**************************************************** 51 | * 52 | * DSP_VideoColor() entry of SUBRCALL 66 1 53 | * called from (VIDEOCLOR BLACKFLG) 54 | * 55 | ****************************************************/ 56 | 57 | LispPTR DSP_VideoColor(LispPTR *args) /* args[0] : black flag */ 58 | { 59 | int invert = args[0] & 0xFFFF; 60 | #if defined(SDL) 61 | sdl_set_invert(invert); 62 | #endif 63 | if (invert) 64 | return ATOM_T; 65 | else 66 | return NIL; 67 | 68 | } 69 | 70 | extern struct cursor CurrentCursor; 71 | 72 | /**************************************************** 73 | * 74 | * DSP_Cursor() entry of SUBRCALL 64 2 75 | * called from "\HARDCURSORUP" etc. 76 | * 77 | ****************************************************/ 78 | void DSP_Cursor(LispPTR *args, int argnum) 79 | /* args[0] : hot spot X 80 | * args[1] : hot spot Y 81 | */ 82 | { 83 | extern int ScreenLocked; 84 | extern DLword *EmCursorX68K, *EmCursorY68K; 85 | extern int LastCursorX, LastCursorY; 86 | 87 | 88 | #if defined(SDL) 89 | sdl_setCursor((int)(args[0] & 0xFFFF), (int)(args[1] & 0xFFFF)); 90 | #endif /* SDL */ 91 | } 92 | 93 | /**************************************************** 94 | * 95 | * DSP_SetMousePos() entry of SUBRCALL 65 2 96 | * called from macro "\SETMOUSEXY" etc. 97 | * 98 | ****************************************************/ 99 | /* args[0] : X pos 100 | * args[1] : Y pos 101 | */ 102 | void DSP_SetMousePos(LispPTR *args) 103 | { 104 | int x = (int)(GetSmalldata(args[0])); 105 | int y = (int)(GetSmalldata(args[1])); 106 | #ifdef SDL 107 | sdl_setMousePosition(x, y); 108 | #endif /* SDL */ 109 | } 110 | 111 | /**************************************************** 112 | * 113 | * DSP_ScreenWidth() entry of SUBRCALL 67 0 114 | * called from UPDATESCREENDIMENSIONS 115 | * 116 | ****************************************************/ 117 | LispPTR DSP_ScreenWidth(LispPTR *args) 118 | { return (S_POSITIVE | (0xFFFF & displaywidth)); } 119 | 120 | /**************************************************** 121 | * 122 | * DSP_ScreenHight() entry of SUBRCALL 68 0 123 | * called from UPDATESCREENDIMENSIONS 124 | * 125 | ****************************************************/ 126 | LispPTR DSP_ScreenHight(LispPTR *args) 127 | { return (S_POSITIVE | (0xFFFF & displayheight)); } 128 | 129 | /**************************************************** 130 | * 131 | * flip_cursor() 132 | * 133 | ****************************************************/ 134 | 135 | extern DLword *EmCursorBitMap68K; 136 | extern int for_makeinit; 137 | 138 | void flip_cursor(void) { 139 | DLword *word; 140 | int cnt; 141 | extern int ScreenLocked; 142 | extern DLword *EmCursorX68K, *EmCursorY68K; 143 | 144 | word = EmCursorBitMap68K; 145 | 146 | #ifdef INIT 147 | 148 | /* since this is called frequently, and you don't want to have 149 | to build a different LDE to run the 2 parts of a Loadup, there is 150 | an ifdef AND a test. This way we don't generate 151 | extra code for anybody else building an LDE 152 | except those who want to try building loadups. */ 153 | 154 | if (!for_makeinit) { 155 | for (cnt = CURSORHEIGHT; (cnt--);) { GETWORD(word++) ^= 0xFFFF; } 156 | } 157 | 158 | #else 159 | 160 | for (cnt = CURSORHEIGHT; (cnt--);) { GETWORD(word++) ^= 0xFFFF; } 161 | 162 | #endif 163 | 164 | 165 | #if defined(SDL) 166 | sdl_setCursor(0, 0); // TODO: keep track of the current hot_x and hot_y 167 | #endif /* SDL */ 168 | } 169 | -------------------------------------------------------------------------------- /dspsubrsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef DSPSUBRSDEFS_H 2 | #define DSPSUBRSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | void DSP_dspbout(LispPTR *args); 5 | void DSP_showdisplay(LispPTR *args); 6 | LispPTR DSP_VideoColor(LispPTR *args); 7 | void DSP_Cursor(LispPTR *args, int argnum); 8 | void DSP_SetMousePos(LispPTR *args); 9 | LispPTR DSP_ScreenWidth(LispPTR *args); 10 | LispPTR DSP_ScreenHight(LispPTR *args); 11 | void flip_cursor(void); 12 | #endif 13 | -------------------------------------------------------------------------------- /eqfdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef EQFDEFS_H 2 | #define EQFDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_clequal(LispPTR arg1, LispPTR arg2); 5 | LispPTR N_OP_eqlop(LispPTR arg1, LispPTR arg2); 6 | LispPTR N_OP_equal(LispPTR arg1, LispPTR arg2); 7 | LispPTR N_OP_eqq(LispPTR arg1, LispPTR arg2); 8 | #endif 9 | -------------------------------------------------------------------------------- /findkey.c: -------------------------------------------------------------------------------- 1 | /* $Id: findkey.c,v 1.3 1999/05/31 23:35:28 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | #include 14 | #include "lispemul.h" 15 | #include "lispmap.h" 16 | #include "stack.h" 17 | #include "lspglob.h" 18 | #include "adr68k.h" 19 | #include "testtooldefs.h" 20 | #include "findkeydefs.h" 21 | 22 | /***********************************************************************/ 23 | /* 24 | File Name : findkey.c 25 | 26 | Desc : 27 | 28 | Date : Mar. 29 88 29 | Edited by : Bob Krivacic 30 | Including : N_OP_findkey 31 | 32 | 33 | */ 34 | /**********************************************************************/ 35 | 36 | LispPTR N_OP_findkey(LispPTR tos, int byte) { 37 | LispPTR *ptr; 38 | DLword *find_end; 39 | DLword arg_nth; 40 | 41 | #ifdef TRACE 42 | printPC(); 43 | printf("TRACE : N_OP_findkey \n"); 44 | #endif 45 | 46 | if (CURRENTFX->alink & 1) { /* slow case */ 47 | find_end = NativeAligned2FromStackOffset(CURRENTFX->blink - 4); 48 | } else { /* Fast cae */ 49 | find_end = ((DLword *)CURRENTFX) - 2 - 4; 50 | } 51 | 52 | arg_nth = byte + 1; 53 | 54 | for (ptr = (LispPTR *)(IVar + ((byte * 2) - 2)); (UNSIGNED)find_end >= (UNSIGNED)ptr; 55 | ptr += 2, arg_nth += 2) { 56 | if (*ptr == tos) { /* KEY founded */ 57 | return (S_POSITIVE | arg_nth); 58 | } 59 | } /* for end */ 60 | 61 | /* No matched */ 62 | 63 | return (NIL_PTR); 64 | 65 | } /* end N_OP_findkey() */ 66 | -------------------------------------------------------------------------------- /findkeydefs.h: -------------------------------------------------------------------------------- 1 | #ifndef FINDKEYDEFS_H 2 | #define FINDKEYDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_findkey(LispPTR tos, int byte); 5 | #endif 6 | -------------------------------------------------------------------------------- /fp.c: -------------------------------------------------------------------------------- 1 | /* $Id: fp.c,v 1.3 1999/05/31 23:35:29 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | /************************************************************************/ 13 | /* */ 14 | /* F P . C */ 15 | /* */ 16 | /* Floating-point arithmetic code. */ 17 | /* */ 18 | /************************************************************************/ 19 | 20 | #include "adr68k.h" // for LAddrFromNative 21 | #include "fpdefs.h" // for N_OP_fdifference, N_OP_fgreaterp, N_OP_fplus2 22 | #include "lispemul.h" // for state, LispPTR, DLword, ERROR_EXIT, ATOM_T 23 | #include "lspglob.h" 24 | #include "lsptypes.h" // for TYPE_FLOATP 25 | #include "medleyfp.h" // for FPCLEAR, FPTEST 26 | #include "mkcelldefs.h" // for createcell68k 27 | #include "my.h" // for N_MakeFloat 28 | 29 | /************************************************************ 30 | N_OP_fplus2 -- op 350 31 | N_OP_fdifference -- op 351 32 | N_OP_ftimes2 -- op 352 33 | N_OP_fquotient -- op 353 34 | N_OP_fgreaterp -- op 362 35 | ***********************************************************/ 36 | 37 | /************************************************************************/ 38 | /* */ 39 | /* N _ O P _ f p l u s 2 */ 40 | /* */ 41 | /* 2-argument floating point addition opcode */ 42 | /* */ 43 | /************************************************************************/ 44 | 45 | LispPTR N_OP_fplus2(LispPTR parg1, LispPTR parg2) { 46 | float arg1; 47 | float arg2; 48 | float result; 49 | float *wordp; 50 | 51 | N_MakeFloat(parg1, arg1, parg2); 52 | N_MakeFloat(parg2, arg2, parg2); 53 | FPCLEAR; 54 | result = arg1 + arg2; 55 | if (FPTEST(result)) ERROR_EXIT(parg2); 56 | wordp = (float *)createcell68k(TYPE_FLOATP); 57 | *wordp = result; 58 | return (LAddrFromNative(wordp)); 59 | } /* end N_OP_fplus2() */ 60 | 61 | /************************************************************************/ 62 | /* */ 63 | /* N _ O P _ f d i f f e r e n c e */ 64 | /* */ 65 | /* 2-argument floating-point subtraction. */ 66 | /* */ 67 | /************************************************************************/ 68 | 69 | LispPTR N_OP_fdifference(LispPTR parg1, LispPTR parg2) { 70 | float arg1, arg2; 71 | float result; 72 | float *wordp; 73 | 74 | N_MakeFloat(parg1, arg1, parg2); 75 | N_MakeFloat(parg2, arg2, parg2); 76 | FPCLEAR; 77 | result = arg1 - arg2; 78 | if (FPTEST(result)) ERROR_EXIT(parg2); 79 | wordp = (float *)createcell68k(TYPE_FLOATP); 80 | *wordp = result; 81 | return (LAddrFromNative(wordp)); 82 | } /* end N_OP_fdifference() */ 83 | 84 | /************************************************************************/ 85 | /* */ 86 | /* N _ O P _ f t i m e s 2 */ 87 | /* */ 88 | /* Floating-point multiplication */ 89 | /* */ 90 | /************************************************************************/ 91 | 92 | LispPTR N_OP_ftimes2(LispPTR parg1, LispPTR parg2) { 93 | float arg1, arg2; 94 | float result; 95 | float *wordp; 96 | 97 | N_MakeFloat(parg1, arg1, parg2); 98 | N_MakeFloat(parg2, arg2, parg2); 99 | FPCLEAR; 100 | result = arg1 * arg2; 101 | if (FPTEST(result)) ERROR_EXIT(parg2); 102 | wordp = (float *)createcell68k(TYPE_FLOATP); 103 | *wordp = result; 104 | return (LAddrFromNative(wordp)); 105 | } /* end N_OP_ftimes2() */ 106 | 107 | /************************************************************************/ 108 | /* */ 109 | /* N _ O P _ f q u o t i e n t */ 110 | /* */ 111 | /* floating-point division */ 112 | /* */ 113 | /************************************************************************/ 114 | 115 | LispPTR N_OP_fquotient(LispPTR parg1, LispPTR parg2) { 116 | float arg1, arg2; 117 | float result; 118 | float *wordp; 119 | 120 | N_MakeFloat(parg1, arg1, parg2); 121 | N_MakeFloat(parg2, arg2, parg2); 122 | FPCLEAR; 123 | result = arg1 / arg2; 124 | 125 | if (FPTEST(result)) ERROR_EXIT(parg2); 126 | wordp = (float *)createcell68k(TYPE_FLOATP); 127 | *wordp = result; 128 | return (LAddrFromNative(wordp)); 129 | } /* end N_OP_fquotient() */ 130 | 131 | /************************************************************************/ 132 | /* */ 133 | /* N _ O P _ f g r e a t e r p */ 134 | /* */ 135 | /* Floating-point > */ 136 | /* */ 137 | /************************************************************************/ 138 | 139 | LispPTR N_OP_fgreaterp(LispPTR parg1, LispPTR parg2) { 140 | float arg1, arg2; 141 | 142 | N_MakeFloat(parg1, arg1, parg2); 143 | N_MakeFloat(parg2, arg2, parg2); 144 | if (arg1 > arg2) 145 | return (ATOM_T); 146 | else 147 | return (NIL_PTR); 148 | } /* end N_OP_fgreaterp() */ 149 | -------------------------------------------------------------------------------- /fpdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef FPDEFS_H 2 | #define FPDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_fplus2(LispPTR parg1, LispPTR parg2); 5 | LispPTR N_OP_fdifference(LispPTR parg1, LispPTR parg2); 6 | LispPTR N_OP_ftimes2(LispPTR parg1, LispPTR parg2); 7 | LispPTR N_OP_fquotient(LispPTR parg1, LispPTR parg2); 8 | LispPTR N_OP_fgreaterp(LispPTR parg1, LispPTR parg2); 9 | #endif 10 | -------------------------------------------------------------------------------- /fvardefs.h: -------------------------------------------------------------------------------- 1 | #ifndef FVARDEFS_H 2 | #define FVARDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | #include "stack.h" /* for fnhead, frameex1 */ 5 | LispPTR N_OP_fvarn(int n); 6 | LispPTR N_OP_stkscan(LispPTR tos); 7 | LispPTR N_OP_fvar_(LispPTR tos, int n); 8 | void nnewframe(struct frameex1 *newpfra2, DLword *achain, int name); 9 | void nfvlookup(struct frameex1 *apframe1, DLword *achain, struct fnhead *apfnhead1); 10 | LispPTR native_newframe(int slot); 11 | #endif 12 | -------------------------------------------------------------------------------- /gc.c: -------------------------------------------------------------------------------- 1 | /* $Id: gc.c,v 1.3 1999/05/31 23:35:29 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | #include // for printf 13 | #include "gcdata.h" // for GCLOOKUPV 14 | #include "gchtfinddefs.h" // for htfind, rec_htfind 15 | #include "gcdefs.h" // for OP_gcref 16 | #include "lspglob.h" 17 | #include "lsptypes.h" // for state, ByteCode, PC, TopOfStack, Get_code_... 18 | #include "testtooldefs.h" // for printPC 19 | 20 | /************************************************************ 21 | 22 | entry OP_gcref OPCODE[025] 23 | 24 | 1. alpha is ADDREF or DELREF, STKREF. 25 | TopOfStack is argued slot address. 26 | 2. call gclookup with alpha and TopOfStack. 27 | 3. if stk=0 and refcnt=0 of entry of HashMainTable, 28 | TopOfStack left alone. 29 | else replace TopOfStack with 0. 30 | 4. increment PC by 2. 31 | 32 | ***********************************************************/ 33 | 34 | void OP_gcref(void) { 35 | #ifdef TRACE 36 | printPC(); 37 | printf("TRACE:OP_gcref()\n"); 38 | #endif 39 | GCLOOKUPV(TopOfStack, Get_code_BYTE(PC + 1), TopOfStack); 40 | PC += 2; 41 | return; 42 | } 43 | -------------------------------------------------------------------------------- /gc2.c: -------------------------------------------------------------------------------- 1 | /* $Id: gc2.c,v 1.3 1999/05/31 23:35:30 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | /**********************************************************************/ 13 | /* 14 | File Name: gc2.c 15 | Desc: implement opcode SCAN1,SCAN2,GCRECLAIMCELL 16 | 17 | 18 | Including : OP_scan1 19 | OP_scan2 20 | OP_gcreccell 21 | 22 | */ 23 | /**********************************************************************/ 24 | 25 | #include // for printf 26 | #include "address.h" // for LOLOC 27 | #include "gc2defs.h" // for OP_gcscan1, OP_gcscan2 28 | #include "gcscandefs.h" // for gcscan1, gcscan2 29 | #include "lispemul.h" // for state, TopOfStack, NIL, PC, SEGMASK 30 | #include "lispmap.h" // for S_POSITIVE 31 | #include "lspglob.h" 32 | #include "lsptypes.h" 33 | #include "testtooldefs.h" // for printPC 34 | 35 | /**********************************************************************/ 36 | /* 37 | Func Name : OP_gcscan1 38 | */ 39 | /**********************************************************************/ 40 | 41 | void OP_gcscan1(void) { 42 | int scan; 43 | #ifdef TRACE 44 | printPC(); 45 | printf("TRACE: OP_gcscan1()\n"); 46 | #endif 47 | if ((TopOfStack & SEGMASK) == S_POSITIVE) { 48 | scan = gcscan1(LOLOC(TopOfStack)); 49 | TopOfStack = (scan == -1) ? NIL : scan | S_POSITIVE; 50 | } else { 51 | printf("OP_gcscan1: not a number\n"); 52 | } 53 | PC++; 54 | } /* OP_gcscan1 end */ 55 | 56 | /**********************************************************************/ 57 | /* 58 | Func Name : OP_gcscan2 59 | */ 60 | /**********************************************************************/ 61 | 62 | void OP_gcscan2(void) { 63 | int scan; 64 | #ifdef TRACE 65 | printPC(); 66 | printf("TRACE: OP_gcscan2()\n"); 67 | #endif 68 | if ((TopOfStack & SEGMASK) == S_POSITIVE) { 69 | scan = gcscan2(LOLOC(TopOfStack)); 70 | TopOfStack = (scan == -1) ? NIL : scan | S_POSITIVE; 71 | } 72 | PC++; 73 | } /* OP_gcscan2 end */ 74 | -------------------------------------------------------------------------------- /gc2defs.h: -------------------------------------------------------------------------------- 1 | #ifndef GC2DEFS_H 2 | #define GC2DEFS_H 1 3 | void OP_gcscan1(void); 4 | void OP_gcscan2(void); 5 | #endif 6 | -------------------------------------------------------------------------------- /gcarraydefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCARRAYDEFS_H 2 | #define GCARRAYDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | LispPTR aref1(LispPTR array, int index); 5 | LispPTR find_symbol(const char *char_base, DLword offset, DLword length, LispPTR hashtbl, DLword fatp, DLword lispp); 6 | LispPTR get_package_atom(const char *char_base, DLword charlen, const char *packname, DLword packlen, int externalp); 7 | LispPTR with_symbol(LispPTR char_base, LispPTR offset, LispPTR charlen, LispPTR fatp, LispPTR hashtbl, LispPTR result); 8 | #endif 9 | -------------------------------------------------------------------------------- /gccodedefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCCODEDEFS_H 2 | #define GCCODEDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR reclaimcodeblock(LispPTR codebase); 5 | int code_block_size(long unsigned int codeblock68k); 6 | #endif 7 | -------------------------------------------------------------------------------- /gcdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCDEFS_H 2 | #define GCDEFS_H 1 3 | void OP_gcref(void); 4 | #endif 5 | -------------------------------------------------------------------------------- /gcfinaldefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCFINALDEFS_H 2 | #define GCFINALDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | void printarrayblock(LispPTR base); 5 | int integerlength(unsigned int n); 6 | LispPTR findptrsbuffer(LispPTR ptr); 7 | LispPTR releasingvmempage(LispPTR ptr); 8 | LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist); 9 | LispPTR deleteblock(LispPTR base); 10 | LispPTR linkblock(LispPTR base); 11 | LispPTR makefreearrayblock(LispPTR block, DLword length); 12 | LispPTR arrayblockmerger(LispPTR base, LispPTR nbase); 13 | LispPTR mergebackward(LispPTR base); 14 | LispPTR mergeforward(LispPTR base); 15 | LispPTR reclaimarrayblock(LispPTR ptr); 16 | LispPTR reclaimstackp(LispPTR ptr); 17 | #endif 18 | 19 | 20 | -------------------------------------------------------------------------------- /gchtfinddefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCHTFINDDEFS_H 2 | #define GCHTFINDDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | #include "gcdata.h" /* for GCENTRY */ 5 | void enter_big_reference_count(LispPTR ptr); 6 | void modify_big_reference_count(GCENTRY *entry, DLword casep, LispPTR ptr); 7 | LispPTR htfind(LispPTR ptr, int casep); 8 | LispPTR rec_htfind(LispPTR ptr, int casep); 9 | #endif 10 | -------------------------------------------------------------------------------- /gcmain3defs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCMAIN3DEFS_H 2 | #define GCMAIN3DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR gcmapscan(void); 5 | LispPTR gcmapscan(void); 6 | LispPTR gcmapunscan(void); 7 | LispPTR gcscanstack(void); 8 | #endif 9 | -------------------------------------------------------------------------------- /gcoflow.c: -------------------------------------------------------------------------------- 1 | /* $Id: gcoflow.c,v 1.3 1999/05/31 23:35:32 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /*************************************************************************/ 10 | /* */ 11 | /* File Name : gcpunt.c */ 12 | /* */ 13 | /*************************************************************************/ 14 | /* */ 15 | /* Creation Date : July-8-1987 */ 16 | /* Written by Tomoru Teruuchi */ 17 | /* */ 18 | /*************************************************************************/ 19 | /* */ 20 | /* Functions : gc_handleoverflow(arg); */ 21 | /* gcmaptable(arg); */ 22 | /* */ 23 | /*************************************************************************/ 24 | /* Description : */ 25 | /* */ 26 | /*************************************************************************/ 27 | /* \Tomtom */ 28 | /*************************************************************************/ 29 | 30 | #include "version.h" 31 | 32 | #include "arith.h" // for GetSmalldata 33 | #include "gcdata.h" // for htoverflow, REC_GCLOOKUP 34 | #include "gchtfinddefs.h" // for htfind, rec_htfind 35 | #include "gcoflowdefs.h" // for gc_handleoverflow, gcmaptable 36 | #include "gcrdefs.h" // for doreclaim 37 | #include "lispemul.h" // for NIL, DLword, LispPTR 38 | #include "lspglob.h" // for Reclaim_cnt_word, HToverflow, MaxTypeNumber_word 39 | #include "lsptypes.h" // for dtd, GetDTD, TYPE_LISTP 40 | 41 | #define Increment_Allocation_Count(n) \ 42 | do { \ 43 | if (*Reclaim_cnt_word != NIL) { \ 44 | if (*Reclaim_cnt_word > (n)) \ 45 | (*Reclaim_cnt_word) -= (n); \ 46 | else { \ 47 | *Reclaim_cnt_word = NIL; \ 48 | doreclaim(); \ 49 | } \ 50 | } \ 51 | } while (0) 52 | 53 | DLword gc_handleoverflow(DLword arg) { 54 | struct htoverflow *cell; 55 | struct dtd *ptr; 56 | LispPTR cellcnt; 57 | LispPTR addr; 58 | cell = (struct htoverflow *)HToverflow; 59 | /* This proc. protected from interrupt */ 60 | while ((addr = cell->ptr) != NIL) { 61 | REC_GCLOOKUP(addr, cell->pcase); 62 | cell->ptr = 0; 63 | cell->pcase = 0; 64 | ++cell; /* (\ADDBASE CELL WORDSPERCELL) */ 65 | } 66 | ptr = (struct dtd *)GetDTD(TYPE_LISTP); 67 | /* same as "extern struct dtd *ListpDTD" */ 68 | if ((cellcnt = ptr->dtd_cnt0) > 1024) { 69 | Increment_Allocation_Count(cellcnt); 70 | ptr->dtd_oldcnt += cellcnt; 71 | ptr->dtd_cnt0 = 0; 72 | } 73 | return (arg); 74 | } 75 | 76 | DLword gcmaptable(DLword arg) { 77 | struct htoverflow *cell; 78 | struct dtd *ptr; 79 | LispPTR cellcnt; 80 | int typnum; 81 | LispPTR addr; 82 | int maxtypenumber = GetSmalldata(*MaxTypeNumber_word); 83 | 84 | cell = (struct htoverflow *)HToverflow; 85 | /* This proc. protected from interrupt */ 86 | while ((addr = cell->ptr) != NIL) { 87 | REC_GCLOOKUP(addr, cell->pcase); 88 | cell->ptr = 0; 89 | cell->pcase = 0; 90 | ++cell; /* (\ADDBASE CELL WORDSPERCELL) */ 91 | } 92 | for (typnum = 1; typnum <= maxtypenumber; ++typnum) 93 | /* applied alltype */ 94 | { 95 | ptr = (struct dtd *)GetDTD(typnum); 96 | if ((cellcnt = ptr->dtd_cnt0) != 0) { 97 | ptr->dtd_oldcnt += cellcnt; 98 | ptr->dtd_cnt0 = 0; 99 | Increment_Allocation_Count(cellcnt); 100 | } 101 | } 102 | return (arg); 103 | } 104 | -------------------------------------------------------------------------------- /gcoflowdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCOFLOWDEFS_H 2 | #define GCOFLOWDEFS_H 1 3 | #include "lispemul.h" /* for DLword */ 4 | DLword gc_handleoverflow(DLword arg); 5 | DLword gcmaptable(DLword arg); 6 | #endif 7 | -------------------------------------------------------------------------------- /gcrcelldefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCRCELLDEFS_H 2 | #define GCRCELLDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | void freelistcell(LispPTR cell); 5 | LispPTR gcreccell(LispPTR cell); 6 | void freelistcell(LispPTR cell); 7 | #endif 8 | -------------------------------------------------------------------------------- /gcrdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCRDEFS_H 2 | #define GCRDEFS_H 1 3 | void gcarrangementstack(void); 4 | void dogc01(void); 5 | void doreclaim(void); 6 | void disablegc1(int noerror); 7 | #endif 8 | -------------------------------------------------------------------------------- /gcscan.c: -------------------------------------------------------------------------------- 1 | /* $Id: gcscan.c,v 1.3 1999/05/31 23:35:33 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | /*************************************************************************/ 14 | /* */ 15 | /* File Name : gcscan.c */ 16 | /* */ 17 | /*************************************************************************/ 18 | /* */ 19 | /* Creation Date : July-7-1987 */ 20 | /* Written by Tomoru Teruuchi */ 21 | /* */ 22 | /*************************************************************************/ 23 | /* */ 24 | /* Functions : */ 25 | /* gcscan1(probe) */ 26 | /* gcscan2(probe) */ 27 | /* */ 28 | /*************************************************************************/ 29 | /* Description : */ 30 | /* */ 31 | /* The functions "gcscan1" and "gcscan2" are the translated functions */ 32 | /* from the Lisp Functions "\GCSCAN1" & "\GCSCAN2". */ 33 | /* These functions' role is to scan the HTmain Table and return the */ 34 | /* existing entry(by "gcscan1") & the entry whose STKBIT field is ON */ 35 | /* (by "gcscan2").These functions are the UFN functions that are called */ 36 | /* by OPCODES "GCSCAN1" & "GCSCAN2". */ 37 | /* */ 38 | /* gcscan1 */ 39 | /* INPUT : probe (the starting offset in the HTmain table) */ 40 | /* OUTPUT : the entry's offset or NIL (no more entry existing) */ 41 | /* */ 42 | /* gcscan2 */ 43 | /* INPUT : probe (the starting offset in the HTmain table) */ 44 | /* OUTPUT : the entry's offset or NIL (no more entry existing) */ 45 | /*************************************************************************/ 46 | /* \Tomtom */ 47 | /*************************************************************************/ 48 | 49 | #include "lispemul.h" 50 | #include "lspglob.h" 51 | #include "gcdata.h" 52 | #include "lsptypes.h" 53 | 54 | #include "gcscandefs.h" 55 | 56 | #ifdef BIGVM 57 | #define HTSTKBIT 0x10000 /* = 512 */ 58 | #define HTENDS ((struct hashentry *)htlptr) 59 | #define GetStkCnt(entry1) ((entry1) >> 16) 60 | #else 61 | #define HTSTKBIT 0x200 /* = 512 */ 62 | #define HTENDS ((struct hashentry *)htlptr) 63 | #define GetStkCnt(entry1) (entry1 >> 9) 64 | #endif /* BIGVM */ 65 | 66 | int gcscan1(int probe) 67 | /* probe is offset */ 68 | { 69 | struct htlinkptr *htlptr; /* overlay access method */ 70 | int contents; 71 | while (--probe >= 0) /* End of HTmain Table ? */ 72 | { 73 | /* Start addr. of scanning */ 74 | htlptr = (struct htlinkptr *)(HTmain + probe); 75 | contents = ((struct htlinkptr *)GCPTR(htlptr))->contents; 76 | if (contents && (((struct hashentry *)GCPTR(HTENDS))->collision || (GetStkCnt(contents) == 0))) 77 | return (probe); 78 | } 79 | return (-1); 80 | } 81 | 82 | int gcscan2(int probe) 83 | /* probe is offset */ 84 | { 85 | struct htlinkptr *htlptr; /* overlay access method */ 86 | while (--probe >= 0) /* End of HTmain Table ? */ 87 | { 88 | htlptr = (struct htlinkptr *)(HTmain + probe); 89 | /* Start addr. of scanning */ 90 | if (((HTSTKBIT | 1) & ((struct htlinkptr *)GCPTR(htlptr))->contents) != 0) 91 | return (probe); /* stackref or collision ON */ 92 | } 93 | return (-1); 94 | } 95 | -------------------------------------------------------------------------------- /gcscandefs.h: -------------------------------------------------------------------------------- 1 | #ifndef GCSCANDEFS_H 2 | #define GCSCANDEFS_H 1 3 | int gcscan1(int probe); 4 | int gcscan2(int probe); 5 | #endif 6 | -------------------------------------------------------------------------------- /gvar2.c: -------------------------------------------------------------------------------- 1 | /* $Id: gvar2.c,v 1.3 1999/05/31 23:35:33 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | #include "adr68k.h" // for NativeAligned4FromLAddr 13 | #include "cell.h" // for xpointer 14 | #include "commondefs.h" // for error 15 | #include "dbprint.h" // for DEBUGGER 16 | #include "gcdata.h" // for FRPLPTR 17 | #include "gchtfinddefs.h" // for htfind, rec_htfind 18 | #include "gvar2defs.h" // for N_OP_gvar_, N_OP_rplptr 19 | #include "lispemul.h" // for LispPTR, DLword, NEWATOM_VALUE_OFFSET, NEWAT... 20 | #include "lspglob.h" // for AtomSpace 21 | #include "lsptypes.h" 22 | 23 | /************************************************************************/ 24 | /* */ 25 | /* N _ O P _ g v a r _ */ 26 | /* */ 27 | /* GVAR_ opcode (027). Assign a value to a global variable. */ 28 | /* */ 29 | /* atom_index is the "atom number," either the lo half of the */ 30 | /* old litatom, or the new-atom itself. */ 31 | /* */ 32 | /* * call gclookup with DELREF and address of GVAR slot. */ 33 | /* * call gclookup with ADDREF and TopOFStack. */ 34 | /* * replace GVAR slot with tos. */ 35 | /* * If Hash Table is overflow, call fn1ext. */ 36 | /* */ 37 | /************************************************************************/ 38 | 39 | LispPTR N_OP_gvar_(LispPTR tos, unsigned int atom_index) { 40 | LispPTR *pslot; /* Native pointer to GVAR slot of atom */ 41 | 42 | #ifdef BIGATOMS 43 | if (0 != (atom_index & SEGMASK)) 44 | pslot = (LispPTR *)NativeAligned4FromLAddr(atom_index + NEWATOM_VALUE_OFFSET); 45 | else 46 | #endif /* BIGATOMS */ 47 | 48 | #ifdef BIGVM 49 | pslot = ((LispPTR *)AtomSpace) + (5 * atom_index) + NEWATOM_VALUE_PTROFF; 50 | #else 51 | pslot = (LispPTR *)Valspace + atom_index; 52 | #endif /* BIGVM */ 53 | DEBUGGER(if (tos & 0xF0000000) error("Setting GVAR with high bits on")); 54 | FRPLPTR(((struct xpointer *)pslot)->addr, tos); 55 | return (tos); 56 | } 57 | 58 | /************************************************************************/ 59 | /* */ 60 | /* N _ O P _ r p l p t r */ 61 | /* */ 62 | /* RPLPTR opcode (024). Replace a pointer field somewhere, */ 63 | /* updating the reference counts for the old value and the new */ 64 | /* value (DELREF and ADDREF, respectively). */ 65 | /* */ 66 | /* tos_m_1 is the base, and alpha is a word-offset for finding */ 67 | /* the cell to replace contents of. */ 68 | /* tos is the new value. */ 69 | /* */ 70 | /************************************************************************/ 71 | 72 | LispPTR N_OP_rplptr(LispPTR tos_m_1, LispPTR tos, unsigned int alpha) { 73 | struct xpointer *pslot; 74 | 75 | pslot = (struct xpointer *)NativeAligned4FromLAddr(tos_m_1 + alpha); 76 | FRPLPTR(pslot->addr, tos); 77 | return (tos_m_1); 78 | } 79 | -------------------------------------------------------------------------------- /gvar2defs.h: -------------------------------------------------------------------------------- 1 | #ifndef GVAR2DEFS_H 2 | #define GVAR2DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_gvar_(LispPTR tos, unsigned int atom_index); 5 | LispPTR N_OP_rplptr(LispPTR tos_m_1, LispPTR tos, unsigned int alpha); 6 | #endif 7 | -------------------------------------------------------------------------------- /hardrtndefs.h: -------------------------------------------------------------------------------- 1 | #ifndef HARDRTNDEFS_H 2 | #define HARDRTNDEFS_H 1 3 | #include "stack.h" /* for FX */ 4 | int slowreturn(void); 5 | void incusecount68k(FX *fx68k); 6 | #endif 7 | -------------------------------------------------------------------------------- /inetdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef INETDEFS_H 2 | #define INETDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR subr_TCP_ops(int op, LispPTR nameConn, LispPTR proto, LispPTR length, LispPTR bufaddr, LispPTR maxlen); 5 | #endif 6 | -------------------------------------------------------------------------------- /initatms.h: -------------------------------------------------------------------------------- 1 | #ifndef INITATMS_H 2 | #define INITATMS_H 1 3 | /* $Id: initatms.h,v 1.2 1999/01/03 02:06:02 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | /************************************************************************/ 7 | /* */ 8 | /* Copyright 1989, 1990 Venue, Fuji Xerox Co., Ltd, Xerox Corp. */ 9 | /* */ 10 | /* This file is work-product resulting from the Xerox/Venue */ 11 | /* Agreement dated 18-August-1989 for support of Medley. */ 12 | /* */ 13 | /************************************************************************/ 14 | 15 | 16 | /* 17 | * 18 | * Author : Takeshi Shimizu 19 | * Hiroshi Hayata 20 | */ 21 | /*********************************************************/ 22 | /* 23 | File : initatms.h 24 | System ATOMs 25 | 26 | last changed : 5-Mar-87 (take) 27 | 12-Aug-87 take 28 | ** MERGED AT AIS 29 | 30 | */ 31 | /*********************************************************/ 32 | 33 | #define ATOM_EVALFORM 248 34 | #define ATOM_GCHANDLEOVERFLOW 249 35 | #define ATOM_INTERPRETER 256 36 | 37 | #define ATOM_SMALLP 257 38 | #define ATOM_FIXP 258 39 | #define ATOM_FLOATP 259 40 | #define ATOM_LITATOM 260 41 | #define ATOM_LISTP 261 42 | #define ATOM_ARRAYP 262 43 | #define ATOM_STRINGP 263 44 | #define ATOM_STACKP 264 45 | #define ATOM_CHARACTER 265 46 | #define ATOM_VMEMPAGEP 266 47 | #endif /* INITATMS_H */ 48 | -------------------------------------------------------------------------------- /initdspdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef INITDSPDEFS_H 2 | #define INITDSPDEFS_H 1 3 | #include "lispemul.h" /* for DLword */ 4 | #include "version.h" /* for UNSIGNED */ 5 | void init_cursor(void); 6 | void set_cursor(void); 7 | void clear_display(void); 8 | void init_display2(DLword *display_addr, unsigned display_max); 9 | void display_before_exit(void); 10 | void flush_display_buffer(void); 11 | void flush_display_region(int x, int y, int w, int h); 12 | void byte_swapped_displayregion(int x, int y, int w, int h); 13 | void flush_display_lineregion(UNSIGNED x, DLword *ybase, int w, int h); 14 | void flush_display_ptrregion(DLword *ybase, UNSIGNED bitoffset, int w, int h); 15 | #endif 16 | -------------------------------------------------------------------------------- /initkbddefs.h: -------------------------------------------------------------------------------- 1 | #ifndef INITKBDDEFS_H 2 | #define INITKBDDEFS_H 1 3 | void set_kbd_iopointers(void); 4 | void keyboardtype(); 5 | void init_keyboard(int flg); 6 | void device_before_exit(void); 7 | void set_kbd_iopointers(void); 8 | void keyboardtype(); 9 | #endif 10 | -------------------------------------------------------------------------------- /initsoutdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef INITSOUTDEFS_H 2 | #define INITSOUTDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR *fixp_value(LispPTR *ptr); 5 | void init_ifpage(unsigned sysout_size); 6 | void init_iopage(void); 7 | void build_lisp_map(void); 8 | void init_for_keyhandle(void); 9 | void init_for_bltchar(void); 10 | void init_for_bitblt(void); 11 | #endif 12 | -------------------------------------------------------------------------------- /intcall.c: -------------------------------------------------------------------------------- 1 | /* $Id: intcall.c,v 1.3 1999/05/31 23:35:34 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | #include "adr68k.h" // for StackOffsetFromNative, NativeAligned4FromLAddr 14 | #include "cell.h" // for definition_cell, GetDEFCELL68k 15 | #include "intcalldefs.h" // for cause_interruptcall 16 | #include "llstkdefs.h" // for do_stackoverflow 17 | #include "lspglob.h" 18 | #include "lsptypes.h" // for GETWORD 19 | #include "returndefs.h" // for contextsw 20 | #include "stack.h" // for state, CurrentStackPTR, DLword, FX, FuncObj 21 | #include "tosfns.h" // for SWAPPED_FN_CHECK 22 | 23 | void cause_interruptcall(unsigned int atom_index) 24 | /* Atomindex for Function you want to invoke */ 25 | { 26 | struct definition_cell *defcell68k; /* Definition Cell PTR */ 27 | short pv_num; /* scratch for pv */ 28 | struct fnhead *tmp_fn; 29 | int rest; /* use for alignments */ 30 | 31 | CURRENTFX->nopush = T; 32 | CURRENTFX->nextblock = StackOffsetFromNative(CurrentStackPTR) + 4; 33 | PushCStack; /* save TOS */ 34 | 35 | /* Setup IVar */ 36 | IVar = NativeAligned2FromStackOffset(CURRENTFX->nextblock); 37 | 38 | /* Set PC to the Next Instruction and save into pre-FX */ 39 | CURRENTFX->pc = ((UNSIGNED)PC - (UNSIGNED)FuncObj); 40 | 41 | /* Get DEFCELL 68k address */ 42 | defcell68k = (struct definition_cell *)GetDEFCELL68k(atom_index); 43 | 44 | /* Interrupt FN should be compiled code */ 45 | tmp_fn = (struct fnhead *)NativeAligned4FromLAddr(defcell68k->defpointer); 46 | 47 | /* This used to be >=, but I think that was a change from earlier, 48 | when it was originally >. I changed it back on 2/2/98 to see 49 | if that fixes stack overflow trouble. --JDS */ 50 | if ((UNSIGNED)(CurrentStackPTR + tmp_fn->stkmin + STK_SAFE) > (UNSIGNED)EndSTKP) { 51 | /*printf("Interrupt:$$ STKOVER when "); 52 | print(atom_index); 53 | printf(" was called *****\n");*/ 54 | DOSTACKOVERFLOW(0, -1); 55 | } 56 | FuncObj = tmp_fn; 57 | SWAPPED_FN_CHECK; /* Check for need to re-swap code stream */ 58 | if (FuncObj->na >= 0) { 59 | /* This Function is Spread Type */ 60 | /* Arguments on Stack Adjustment */ 61 | rest = 0 - (FuncObj->na); 62 | 63 | while (rest < 0) { 64 | PushStack(NIL_PTR); 65 | rest++; 66 | } 67 | CurrentStackPTR -= (rest << 1); 68 | } /* if end */ 69 | 70 | /* Set up BF */ 71 | CurrentStackPTR += 2; 72 | GETWORD(CurrentStackPTR) = BF_MARK; 73 | GETWORD(CurrentStackPTR + 1) = CURRENTFX->nextblock; 74 | CurrentStackPTR += 2; 75 | 76 | /* Set up FX */ 77 | GETWORD(CurrentStackPTR) = FX_MARK; 78 | 79 | /* Now SET new FX */ 80 | /* Make it SLOWP */ 81 | ((FX *)CurrentStackPTR)->alink = StackOffsetFromNative(PVar) + 1; 82 | ((FX *)CurrentStackPTR)->blink = StackOffsetFromNative(DUMMYBF(CurrentStackPTR)); 83 | ((FX *)CurrentStackPTR)->clink = StackOffsetFromNative(PVar); 84 | PVar = (DLword *)CurrentStackPTR + FRAMESIZE; 85 | #ifdef BIGVM 86 | ((FX *)CurrentStackPTR)->fnheader = (defcell68k->defpointer); 87 | #else 88 | ((FX *)CurrentStackPTR)->lofnheader = (defcell68k->defpointer) & 0x0ffff; 89 | ((FX *)CurrentStackPTR)->hi2fnheader = ((defcell68k->defpointer) & SEGMASK) >> 16; 90 | #endif /* BIGVM */ 91 | 92 | CurrentStackPTR = PVar; 93 | 94 | /* Set up PVar area */ 95 | pv_num = FuncObj->pv + 1; 96 | while (pv_num > 0) { 97 | *((LispPTR *)CurrentStackPTR) = 0x0ffffffff; 98 | CurrentStackPTR += DLWORDSPER_CELL; 99 | *((LispPTR *)CurrentStackPTR) = 0x0ffffffff; 100 | CurrentStackPTR += DLWORDSPER_CELL; 101 | pv_num--; 102 | } 103 | 104 | /* Set PC points New Function's first OPCODE */ 105 | PC = (ByteCode *)FuncObj + FuncObj->startpc; 106 | CURRENTFX->nextblock = StackOffsetFromNative(CurrentStackPTR); 107 | MAKEFREEBLOCK(CurrentStackPTR, ((UNSIGNED)EndSTKP - (UNSIGNED)CurrentStackPTR) >> 1); 108 | } /* end */ 109 | -------------------------------------------------------------------------------- /intcalldefs.h: -------------------------------------------------------------------------------- 1 | #ifndef INTCALLDEFS_H 2 | #define INTCALLDEFS_H 1 3 | void cause_interruptcall(unsigned int atom_index); 4 | #endif 5 | -------------------------------------------------------------------------------- /iopage.h: -------------------------------------------------------------------------------- 1 | #ifndef IOPAGE_H 2 | #define IOPAGE_H 1 3 | /* $Id: iopage.h,v 1.2 1999/01/03 02:06:06 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /************************************************************************/ 6 | /* */ 7 | /* (C) Copyright 1989-92 Venue. All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | #include "lispemul.h" /* for DLword */ 12 | 13 | #ifndef BYTESWAP 14 | /* Normal definition, for big-endian machines */ 15 | typedef struct iopage { 16 | DLword dummy0[022]; 17 | DLword dlmaintpanel; 18 | DLword dlfloppycmd; 19 | DLword dlttyportcmd; 20 | DLword dlprocessorcmd; 21 | DLword newmousestate; 22 | DLword dlbeepcmd; 23 | DLword dlrs232cmisccommand; 24 | DLword dlrs232cputflag; 25 | DLword dlrs232cgetflag; 26 | DLword dummy1[6]; 27 | DLword dlfloppy; 28 | DLword dlttyout; 29 | DLword dummy2; 30 | DLword dlttyin; 31 | DLword dummy3; 32 | DLword dlprocessor2; 33 | DLword dlprocessor1; 34 | DLword dlprocessor0; 35 | DLword newmousex; 36 | DLword newmousey; 37 | DLword dlbeepfreq; 38 | DLword dlrs232cparametercsblo; 39 | DLword dlrs232cparametercsbhi; 40 | DLword dlrs232csetrs366status[3]; 41 | DLword dlrs232cputcsblo; 42 | DLword dlrs232cputcsbhi; 43 | DLword dlrs232cgetcsblo; 44 | DLword dlrs232cgetcsbhi; 45 | DLword dlrs232cdevicestatus; 46 | DLword dlrs232cparameteroutcome; 47 | DLword dltodvalid; 48 | DLword dltodlo; 49 | DLword dltodhi; 50 | DLword dltodlo2; 51 | DLword dlmousex; 52 | DLword dlmousey; 53 | DLword dlutilin; 54 | DLword dlkbdad0; 55 | DLword dlkbdad1; 56 | DLword dlkbdad2; 57 | DLword dlkbdad3; 58 | DLword dlkbdad4; 59 | DLword dlkbdad5; 60 | DLword dllsepimagecsb[040]; 61 | DLword dliophardwareconfig; 62 | DLword dummy4[013]; 63 | DLword dlrs232cparametercsblo_11; 64 | DLword dlrs232cparametercsbhi_11; 65 | DLword dlrs232csetrs366status_11[016] ; 66 | DLword dummy5[074]; 67 | DLword dlmagtape[4]; 68 | DLword dlethernet[014]; 69 | DLword dummy6[037]; 70 | DLword dldispinterrupt; 71 | DLword dldispcontrol; 72 | DLword dldispborder; 73 | DLword dlcursorx; 74 | DLword dlcursory; 75 | DLword dlcursorbitmap[020]; 76 | } IOPAGE; 77 | #else 78 | /***********************************************************/ 79 | /* Byte-swapped/word-swapped version, for 386i */ 80 | /***********************************************************/ 81 | typedef struct iopage { 82 | DLword dummy0[022]; 83 | DLword dlfloppycmd; 84 | DLword dlmaintpanel; /* hi */ 85 | DLword dlprocessorcmd; 86 | DLword dlttyportcmd; /* hi */ 87 | DLword dlbeepcmd; 88 | DLword newmousestate; /* hi */ 89 | DLword dlrs232cputflag; 90 | DLword dlrs232cmisccommand; /* hi */ 91 | DLword dummy1b; 92 | DLword dlrs232cgetflag; /* hi */ 93 | DLword dummy1[4]; 94 | DLword dlfloppy; 95 | DLword dummy1a; /* hi */ 96 | DLword dummy2; 97 | DLword dlttyout; /* hi */ 98 | DLword dummy3; 99 | DLword dlttyin; /* hi */ 100 | DLword dlprocessor1; 101 | DLword dlprocessor2; /* hi */ 102 | DLword newmousex; 103 | DLword dlprocessor0; /* hi */ 104 | DLword dlbeepfreq; 105 | DLword newmousey; /* hi */ 106 | DLword dlrs232cparametercsbhi; 107 | DLword dlrs232cparametercsblo; /* hi */ 108 | DLword dlrs232csetrs366status[2]; 109 | DLword dlrs232cputcsblo; 110 | DLword dlrs232csetrs366statusa; /* hi */ 111 | DLword dlrs232cgetcsblo; 112 | DLword dlrs232cputcsbhi; /* hi */ 113 | DLword dlrs232cdevicestatus; 114 | DLword dlrs232cgetcsbhi; /* hi */ 115 | DLword dltodvalid; 116 | DLword dlrs232cparameteroutcome; /* hi */ 117 | DLword dltodhi; 118 | DLword dltodlo; /* hi */ 119 | DLword dlmousex; 120 | DLword dltodlo2; /* hi */ 121 | DLword dlutilin; 122 | DLword dlmousey; /* hi */ 123 | DLword dlkbdad1; 124 | DLword dlkbdad0; /* hi */ 125 | DLword dlkbdad3; 126 | DLword dlkbdad2; /* hi */ 127 | DLword dlkbdad5; 128 | DLword dlkbdad4; /* hi */ 129 | DLword dllsepimagecsb[040]; 130 | DLword dummy4a; 131 | DLword dliophardwareconfig; /* hi */ 132 | DLword dummy4[012]; 133 | DLword dlrs232cparametercsbhi_11; 134 | DLword dlrs232cparametercsblo_11; /* hi */ 135 | DLword dlrs232csetrs366status_11[016] ; 136 | DLword dummy5[074]; 137 | DLword dlmagtape[4]; 138 | DLword dlethernet[014]; 139 | DLword dummy6[036]; 140 | DLword dldispinterrupt; 141 | DLword dummy6a; 142 | DLword dldispborder; 143 | DLword dldispcontrol; /* hi */ 144 | DLword dlcursory; 145 | DLword dlcursorx; /* hi */ 146 | DLword dlcursorbitmap[020]; 147 | } IOPAGE; 148 | #endif /* BYTESWAP */ 149 | 150 | #endif 151 | -------------------------------------------------------------------------------- /keyboard.h: -------------------------------------------------------------------------------- 1 | #ifndef KEYBOARD_H 2 | #define KEYBOARD_H 1 3 | /* $Id: keyboard.h,v 1.2 1999/01/03 02:06:06 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /** Header File for K/B MOUSE */ 6 | 7 | /************************************************************************/ 8 | /* */ 9 | /* (C) Copyright 1989-92 Venue. All Rights Reserved. */ 10 | /* Manufactured in the United States of America. */ 11 | /* */ 12 | /************************************************************************/ 13 | #include "lispemul.h" /* for DLword */ 14 | 15 | #define MOUSE_LEFT 13 16 | #define MOUSE_MIDDLE 15 17 | #define MOUSE_RIGHT 14 18 | #define CAPSKEY 16 19 | #define DLMOUSEUP 0 20 | #define DLMOUSEWAITING 1 21 | #define DLMOUSENORMAL 2 22 | #define MOUSE_ALLBITS 7 23 | #define KB_ALLUP 0xffff 24 | #define HARDCURSORHEIGHT 16 25 | 26 | #ifndef BYTESWAP 27 | typedef struct 28 | { 29 | DLword read; 30 | DLword write; 31 | } RING; 32 | #else 33 | typedef struct 34 | { 35 | DLword write; 36 | DLword read; 37 | } RING; 38 | #endif /* BYTESWAP */ 39 | 40 | 41 | /* macros for getting to the next-read and next-write ring buf ptrs */ 42 | #define RING_READ(head68k) (((RING*)(head68k))->read) 43 | #define RING_WRITE(head68k) (((RING*)(head68k))->write) 44 | 45 | 46 | /* for feature use */ 47 | #ifndef BYTESWAP 48 | typedef struct 49 | { 50 | DLword mousex; 51 | DLword mousey; 52 | DLword utilin; 53 | DLword kbdad0; 54 | DLword kbdad1; 55 | DLword kbdad2; 56 | DLword kbdad3; 57 | DLword kbdad4; 58 | DLword kbdad5; 59 | DLword nil; 60 | } IOState; 61 | 62 | /* Corresponds to the Lisp KEYBOARDEVENT structure */ 63 | typedef struct 64 | { 65 | DLword W0; 66 | DLword W1; 67 | DLword W2; 68 | DLword W3; 69 | DLword WU; 70 | DLword W4; 71 | DLword W5; 72 | /* int time; */ 73 | short timehi; 74 | short timelo; 75 | unsigned mousestate : 3; 76 | unsigned shift1 : 1; 77 | unsigned shift2 : 1; 78 | unsigned lock : 1; 79 | unsigned ctrl : 1; 80 | unsigned meta : 1; 81 | unsigned font : 1; 82 | unsigned usermode1 : 1; 83 | unsigned usermode2 : 1; 84 | unsigned usermode3 : 1; 85 | unsigned altgr : 1; 86 | unsigned deadkey : 1; 87 | unsigned nil : 2; 88 | DLword mousex; 89 | DLword mousey; 90 | /* DLword nil2; */ 91 | LispPTR deadkeyalist; 92 | } KBEVENT; 93 | 94 | #define RCLK(place) { struct timeval time;\ 95 | gettimeofday(&time,NULL);\ 96 | (place)=(time.tv_sec * 1000000)+time.tv_usec;} 97 | 98 | #else 99 | typedef struct 100 | { 101 | DLword mousey; 102 | DLword mousex; 103 | DLword kbdad0; 104 | DLword utilin; 105 | DLword kbdad2; 106 | DLword kbdad1; 107 | DLword kbdad4; 108 | DLword kbdad3; 109 | DLword nil; 110 | DLword kbdad5; 111 | } IOState; 112 | 113 | /* Corresponds to the Lisp KEYBOARDEVENT structure */ 114 | typedef struct 115 | { 116 | DLword W1; 117 | DLword W0; 118 | DLword W3; 119 | DLword W2; 120 | DLword W4; 121 | DLword WU; 122 | DLword timehi; 123 | DLword W5; 124 | short timelo; 125 | 126 | DLword mousex; 127 | unsigned nil : 4; 128 | unsigned usermode3 : 1; 129 | unsigned usermode2 : 1; 130 | unsigned usermode1 : 1; 131 | unsigned font : 1; 132 | unsigned meta : 1; 133 | unsigned ctrl : 1; 134 | unsigned lock : 1; 135 | unsigned shift2 : 1; 136 | unsigned shift1 : 1; 137 | unsigned mousestate : 3; 138 | /* DLword nil2; */ 139 | DLword mousey; 140 | LispPTR deadkeyalist; 141 | } KBEVENT; /* CHANGED-BY-TAKE ***/ 142 | 143 | /*** OBSOLETE 144 | **#define RCLK(hi,lo) \ 145 | { \ 146 | struct timeval time;\ 147 | int timetemp; \ 148 | gettimeofday(&time,NULL);\ 149 | timetemp = (time.tv_sec * 1000000)+time.tv_usec; \ 150 | (hi)=(DLword)(timetemp>>16); \ 151 | (lo) = (DLword)(timetemp & 0xFFFF); \ 152 | } 153 | ******/ 154 | #define RCLK(place) { struct timeval time;\ 155 | gettimeofday(&time,NULL);\ 156 | (place)=(time.tv_sec * 1000000)+time.tv_usec;} 157 | 158 | #endif /* BYTESWAP */ 159 | 160 | 161 | 162 | 163 | /* Size of a KEYBOARDEVENT structure, and */ 164 | /* the size of the kbd-event ring buffer */ 165 | #define MINKEYEVENT 2 /* leave 2 words for read,write offsets */ 166 | #ifdef NOEUROKBD /* set to disable new european kbd support */ 167 | #define KEYEVENTSIZE 12 168 | #else 169 | #define KEYEVENTSIZE ((sizeof(KBEVENT)+1)>>1) 170 | #endif 171 | /* Offset of the end of the ring buffer */ 172 | #define MAXKEYEVENT (MINKEYEVENT + (383*KEYEVENTSIZE)) 173 | #define NOEUROKEYEVENTSIZE 12 174 | #define EUROKEYEVENTSIZE ((sizeof(KBEVENT) + 1) >> 1) 175 | #define NUMBEROFKEYEVENTS 383 176 | 177 | 178 | typedef union 179 | { 180 | struct 181 | { 182 | RING vectorindex; /* Index for the vector of DLwords in this structure */ 183 | KBEVENT event[NUMBEROFKEYEVENTS + 1]; 184 | } ring; 185 | /* The array of KBEVENTS (indexed by DLword) for euro */ 186 | DLword euro[MINKEYEVENT + (NUMBEROFKEYEVENTS * EUROKEYEVENTSIZE)]; 187 | /* The array of KBEVENTS (indexed by DLword) for noeuro */ 188 | DLword noeuro[MINKEYEVENT + (NUMBEROFKEYEVENTS * NOEUROKEYEVENTSIZE)]; 189 | } keybuffer; 190 | 191 | #endif /* KEYBOARD_H */ 192 | -------------------------------------------------------------------------------- /keyeventdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef KEYEVENTDEFS_H 2 | #define KEYEVENTDEFS_H 1 3 | void process_io_events(void); 4 | void kb_trans(uint16_t keycode, uint16_t upflg); 5 | void taking_mouse_down(void); 6 | void taking_mouse_up(int newx, int newy); 7 | void copy_cursor(int newx, int newy); 8 | void cursor_hidden_bitmap(int x, int y); 9 | #endif 10 | -------------------------------------------------------------------------------- /kprintdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef KPRINTDEFS_H 2 | #define KPRINTDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | void prindatum(LispPTR x); 5 | LispPTR print(LispPTR x); 6 | void print_NEWstring(LispPTR x); 7 | void print_fixp(LispPTR x); 8 | void print_floatp(LispPTR x); 9 | void print_string(LispPTR x); 10 | #endif 11 | -------------------------------------------------------------------------------- /ldsoutdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef LDSOUTDEFS_H 2 | #define LDSOUTDEFS_H 1 3 | unsigned sysout_loader(const char * sysout_file_name, unsigned sys_size); 4 | #endif 5 | -------------------------------------------------------------------------------- /lineblt8defs.h: -------------------------------------------------------------------------------- 1 | #ifndef LINEBLT8DEFS_H 2 | #define LINEBLT8DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | void lineBlt8(DLword *srcbase, int offset, uint8_t *destl, int width, 5 | uint8_t color0, uint8_t color1, LispPTR sourcetype, LispPTR operation); 6 | #endif 7 | -------------------------------------------------------------------------------- /lisp2c.c: -------------------------------------------------------------------------------- 1 | /* $Id: lisp2c.c,v 1.3 1999/05/31 23:35:37 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | /* File containing the conversion functions between lisp and C */ 4 | /* -jarl */ 5 | 6 | /************************************************************************/ 7 | /* */ 8 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 9 | /* Manufactured in the United States of America. */ 10 | /* */ 11 | /************************************************************************/ 12 | 13 | #include "version.h" 14 | 15 | #include // for sprintf 16 | #include // for abs 17 | #include "adr68k.h" // for NativeAligned4FromLAddr, LAddrFromNative 18 | #include "commondefs.h" // for error 19 | #include "lisp2cdefs.h" // for CIntToLispInt, LispIntToCInt, LispStringSimpleLength 20 | #include "lispemul.h" // for LispPTR 21 | #include "lispmap.h" // for S_NEGATIVE, S_POSITIVE 22 | #include "lspglob.h" 23 | #include "lsptypes.h" // for OneDArray, FAT_CHAR_TYPENUMBER, THIN_CHAR_TY... 24 | #include "mkcelldefs.h" // for createcell68k 25 | 26 | int LispStringP(LispPTR object) { 27 | int type; 28 | 29 | type = ((OneDArray *)NativeAligned4FromLAddr(object))->typenumber; 30 | return ((type == THIN_CHAR_TYPENUMBER) || (type == FAT_CHAR_TYPENUMBER)); 31 | } 32 | 33 | int LispStringSimpleLength(LispPTR lispstring) { 34 | OneDArray *arrayp; 35 | 36 | arrayp = (OneDArray *)(NativeAligned4FromLAddr(lispstring)); 37 | return (arrayp->fillpointer); 38 | } 39 | 40 | void LispStringToCStr(LispPTR lispstring, char *cstring) { 41 | OneDArray *arrayp; 42 | char *base; 43 | short *sbase; 44 | int i, Len; 45 | 46 | arrayp = (OneDArray *)(NativeAligned4FromLAddr(lispstring)); 47 | Len = arrayp->fillpointer; 48 | 49 | switch (arrayp->typenumber) { 50 | case THIN_CHAR_TYPENUMBER: 51 | base = ((char *)(NativeAligned2FromLAddr(arrayp->base))) + ((int)(arrayp->offset)); 52 | for (i = 0; i < Len; i++) cstring[i] = base[i]; 53 | cstring[Len] = '\0'; 54 | break; 55 | 56 | case FAT_CHAR_TYPENUMBER: 57 | sbase = ((short *)(NativeAligned2FromLAddr(arrayp->base))) + ((int)(arrayp->offset)); 58 | base = (char *)sbase; 59 | for (i = 0; i < Len * 2; i++) cstring[i] = base[i]; 60 | cstring[Len * 2] = '\0'; 61 | break; 62 | 63 | default: error("Arg not Lisp string.\n"); 64 | } 65 | } 66 | 67 | int LispIntToCInt(LispPTR lispint) { 68 | switch ((0xFFFF0000 & lispint)) { 69 | case S_POSITIVE: return (lispint & 0xFFFF); 70 | case S_NEGATIVE: return (lispint | 0xFFFF0000); 71 | default: 72 | if (GetTypeNumber(lispint) == TYPE_FIXP) { 73 | return (*((int *)NativeAligned4FromLAddr(lispint))); 74 | } else { 75 | char msg[200]; 76 | sprintf(msg, "Arg 0x%x isn't a lisp integer.", lispint); 77 | error(msg); 78 | /* NOTREACHED */ 79 | return(0); 80 | } 81 | } 82 | } 83 | 84 | LispPTR CIntToLispInt(int cint) { 85 | if (abs(cint) > 0xFFFF) { /* its a fixp! */ 86 | LispPTR *wordp; 87 | wordp = (LispPTR *)createcell68k(TYPE_FIXP); 88 | *((int *)wordp) = cint; 89 | return (LAddrFromNative(wordp)); 90 | } else if (cint >= 0) { /* its a positive smallp! */ 91 | return (S_POSITIVE | cint); 92 | } else { /* its a negative smallp! */ 93 | return (S_NEGATIVE | (0xFFFF & cint)); 94 | } 95 | } 96 | -------------------------------------------------------------------------------- /lisp2cdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef LISP2CDEFS_H 2 | #define LISP2CDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | int LispStringP(LispPTR object); 5 | int LispStringSimpleLength(LispPTR lispstring); 6 | void LispStringToCStr(LispPTR lispstring, char *cstring); 7 | int LispIntToCInt(LispPTR lispint); 8 | LispPTR CIntToLispInt(int cint); 9 | #endif 10 | -------------------------------------------------------------------------------- /lispmap.h: -------------------------------------------------------------------------------- 1 | #ifndef LISPMAP_H 2 | #define LISPMAP_H 1 3 | 4 | /* $Id: lispmap.h,v 1.3 1999/01/03 02:06:08 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 5 | 6 | 7 | /************************************************************************/ 8 | /* */ 9 | /* (C) Copyright 1989-98 Venue. All Rights Reserved. */ 10 | /* Manufactured in the United States of America. */ 11 | /* */ 12 | /************************************************************************/ 13 | /* 14 | File Name : lispmap.h(for TEST) 15 | 16 | **************NOTE***************** 17 | OLD DEFs are MOVED to lispmap.FULL 18 | **************NOTE***************** 19 | 20 | Global variables for LispSYSOUT 21 | 22 | Date : December 18, 1986 23 | Edited by : Takeshi Shimizu 24 | 25 | */ 26 | 27 | // RK: streamlined and reorganized 28 | 29 | /* for ATOMSPACE */ 30 | #define ATOM_OFFSET 0x00000 31 | #define ATOM_HI 0 32 | 33 | /* for IOPAGE */ 34 | #define IOPAGE_OFFSET 0x0FF00 35 | 36 | /* for STACKSPACE */ 37 | #define STK_OFFSET 0x10000 38 | #define STK_HI 1 39 | 40 | #define PLIS_HI 2 /* place holder, really -- keep the old value, even though it's inconsistent with the OFFSET, because it's known by LISP, and is used as a dispatch constant. */ 41 | 42 | #define FPTOVP_HI 4 /* again, inconsistent with OFFSET. */ 43 | 44 | /* for PNPSPACE */ 45 | /* Now used to hold initial atoms */ 46 | #define PNP_OFFSET 0x80000 47 | #define PNP_HI 8 /* Fake */ 48 | 49 | #define ATOMS_SIZE 0x20000 50 | 51 | /* for DEFSPACE */ 52 | #define DEFS_HI 10 53 | #define DEFS_OFFSET 0xA0000 54 | 55 | /* for VALSPACE */ 56 | #define VALS_HI 12 57 | #define VALS_OFFSET 0xC0000 58 | 59 | /* for Small Positive */ 60 | #define SPOS_HI 14 61 | #define S_POSITIVE 0xE0000 62 | 63 | /* for Small Negative */ 64 | #define S_NEGATIVE 0xF0000 65 | 66 | #define S_CHARACTER 0x70000 67 | 68 | /* DISPLAYREGION */ 69 | 70 | #define DISPLAY_HI 18 71 | #define DISPLAY_OFFSET 0x120000 72 | 73 | 74 | #ifdef BIGBIGVM 75 | 76 | /**********************************************/ 77 | /* */ 78 | /* BIG-BIG-VM sysout layout (256Mb sysout) */ 79 | /* */ 80 | /**********************************************/ 81 | 82 | 83 | /* for PLISTSPACE */ 84 | #define PLIS_OFFSET 0x30000 85 | 86 | #define FPTOVP_OFFSET 0x20000 87 | 88 | 89 | /* for InterfacePage */ 90 | #define IFPAGE_OFFSET 0x140000 91 | 92 | /* for MISCSTATS */ 93 | #define MISCSTATS_OFFSET 0x140A00 94 | 95 | /* for UFNTable */ 96 | #define UFNTBL_OFFSET 0x140C00 97 | 98 | /* for DTDspace */ 99 | #define DTD_OFFSET 0x141000 100 | 101 | /* for MDSTT */ 102 | 103 | #define MDS_OFFSET 0x180000 104 | 105 | 106 | /* for AtomHashTable */ 107 | #define ATMHT_OFFSET 0x150000 108 | 109 | #define ATOMS_HI 44 110 | #define ATOMS_OFFSET 0x2c0000 111 | 112 | /* for HTMAIN */ 113 | #define HTMAIN_OFFSET 0x160000 114 | #define HTMAIN_SIZE 0x10000 115 | 116 | /* for HTOVERFLOW */ 117 | #define HTOVERFLOW_OFFSET 0x170000 118 | 119 | /* for HTBIGCOUNT */ 120 | #define HTBIG_OFFSET 0x170100 121 | 122 | /* for HTCOLL */ 123 | #define HTCOLL_OFFSET 0x1C0000 124 | #define HTCOLL_SIZE 0x100000 125 | 126 | #else 127 | 128 | /* NOT BIG-BIG VM */ 129 | 130 | 131 | /* for PLISTSPACE */ 132 | #ifndef BIGVM 133 | #define PLIS_OFFSET 0x20000 134 | #else 135 | #define PLIS_OFFSET 0x30000 136 | #endif 137 | 138 | #ifdef BIGVM 139 | #define FPTOVP_OFFSET 0x20000 140 | #else 141 | #define FPTOVP_OFFSET 0x40000 142 | #endif /* BIGVM */ 143 | 144 | /* for InterfacePage */ 145 | #define IFPAGE_OFFSET 0x60000 146 | 147 | #define MISCSTATS_OFFSET 0x60A00 148 | 149 | /* for UFNTable */ 150 | #define UFNTBL_OFFSET 0x60C00 151 | 152 | /* for DTDspace */ 153 | #define DTD_OFFSET 0x61000 154 | 155 | /* for MDSTT */ 156 | #ifdef BIGVM 157 | /* In BIGVM, MDS type table is at 19.,,0 for 1 segment */ 158 | #define MDS_OFFSET 0x140000 159 | #else 160 | #define MDS_OFFSET 0x68000 161 | #endif /* BIGVM */ 162 | 163 | /* for AtomHashTable */ 164 | #define ATMHT_OFFSET 0x70000 165 | 166 | #define ATOMS_HI 8 167 | #define ATOMS_OFFSET 0x80000 168 | 169 | #define HTMAIN_OFFSET 0x100000 170 | 171 | #ifdef BIGVM 172 | #define HTMAIN_SIZE 0x10000 173 | #define HTOVERFLOW_OFFSET 0x110000 174 | #define HTBIG_OFFSET 0x110100 175 | #define HTCOLL_OFFSET 0xA0000 176 | #define HTCOLL_SIZE 0x40000 177 | #else 178 | #define HTMAIN_SIZE 0x8000 179 | #define HTOVERFLOW_OFFSET 0x108000 180 | #define HTBIG_OFFSET 0x108100 181 | #define HTCOLL_OFFSET 0x110000 182 | #define HTCOLL_SIZE 0x10000 183 | #endif /* BIGVM */ 184 | 185 | 186 | #endif /* BIGBIGVM */ 187 | 188 | 189 | 190 | #endif 191 | -------------------------------------------------------------------------------- /lispver2.h: -------------------------------------------------------------------------------- 1 | #ifndef LISPVER2_H 2 | #define LISPVER2_H 1 3 | /* $Id: lispver2.h,v 1.2 1999/01/03 02:06:09 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /* non-DOS version of LispVersionToUnixVersion */ 6 | 7 | #define LispVersionToUnixVersion(pathname) do { \ 8 | \ 9 | char *lv_cp; \ 10 | char *lv_vp; \ 11 | unsigned lv_ver; \ 12 | char lv_ver_buf[VERSIONLEN]; \ 13 | \ 14 | lv_cp = pathname; \ 15 | lv_vp = NULL; \ 16 | while (*lv_cp) { \ 17 | switch (*lv_cp) { \ 18 | \ 19 | case ';': \ 20 | lv_vp = lv_cp; \ 21 | lv_cp++; \ 22 | break; \ 23 | \ 24 | case '\'': \ 25 | if (*(lv_cp + 1) != 0) lv_cp += 2; \ 26 | else lv_cp++; \ 27 | break; \ 28 | \ 29 | default: \ 30 | lv_cp++; \ 31 | break; \ 32 | } \ 33 | } \ 34 | \ 35 | if (lv_vp != NULL) { \ 36 | /* \ 37 | * A semicolon which is not quoted has been found. \ 38 | */ \ 39 | if (*(lv_vp + 1) == 0) { \ 40 | /* \ 41 | * The empty version field. \ 42 | * This is regarded as a versionless file. \ 43 | */ \ 44 | *lv_vp = 0; \ 45 | } else { \ 46 | NumericStringP((lv_vp + 1), YES, NO); \ 47 | YES: \ 48 | /* \ 49 | * Convert the remaining field to digit. \ 50 | */ \ 51 | lv_ver = strtoul(lv_vp + 1, (char **)NULL, 10); \ 52 | if (lv_ver == 0) { \ 53 | /* versionless */ \ 54 | *lv_vp = 0; \ 55 | } else { \ 56 | sprintf(lv_ver_buf, ".~%u~", lv_ver); \ 57 | *lv_vp = 0; \ 58 | strcat(pathname, lv_ver_buf); \ 59 | } \ 60 | goto CONT; \ 61 | \ 62 | NO: \ 63 | strcpy(lv_ver_buf, lv_vp + 1); \ 64 | strcat(lv_ver_buf, "~"); \ 65 | *lv_vp++ = '.'; \ 66 | *lv_vp++ = '~'; \ 67 | *lv_vp = 0; \ 68 | strcat(pathname, lv_ver_buf); \ 69 | CONT: \ 70 | lv_vp--; /* Just for label */ \ 71 | } \ 72 | } \ 73 | } while (0) 74 | #endif /* LISPVER2_H */ 75 | -------------------------------------------------------------------------------- /llstkdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef LLSTKDEFS_H 2 | #define LLSTKDEFS_H 1 3 | #include "lispemul.h" /* for DLword */ 4 | #include "stack.h" /* for FX, StackWord, Bframe */ 5 | int do_stackoverflow(int incallp); 6 | DLword *freestackblock(DLword n, StackWord *start68k, int align); 7 | void decusecount68k(FX *frame68k); 8 | void flip_cursorbar(int n); 9 | void blt(DLword *dest68k, DLword *source68k, int nw); 10 | void stack_check(StackWord *start68k); 11 | void walk_stack(StackWord *start68k); 12 | int quick_stack_check(void); 13 | void check_FX(FX *fx68k); 14 | void check_BF(Bframe *bf68k); 15 | int check_stack_rooms(FX *fx68k); 16 | #endif 17 | -------------------------------------------------------------------------------- /loopsopsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef LOOPSOPSDEFS_H 2 | #define LOOPSOPSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR lcfuncall(unsigned int atom_index, int argnum, int bytenum); 5 | LispPTR LCinit(void); 6 | LispPTR LCFetchMethod(LispPTR class_, LispPTR selector); 7 | LispPTR LCFetchMethodOrHelp(LispPTR object, LispPTR selector); 8 | LispPTR LCFindVarIndex(LispPTR iv, LispPTR object); 9 | LispPTR LCGetIVValue(LispPTR object, LispPTR iv); 10 | LispPTR LCPutIVValue(LispPTR object, LispPTR iv, LispPTR val); 11 | LispPTR lcfuncall(unsigned int atom_index, int argnum, int bytenum); 12 | #endif 13 | -------------------------------------------------------------------------------- /lowlev1defs.h: -------------------------------------------------------------------------------- 1 | #ifndef LOWLEV1DEFS_H 2 | #define LOWLEV1DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_putbitsnfd(LispPTR base, LispPTR data, int word_offset, int beta); 5 | LispPTR N_OP_getbitsnfd(int base_addr, int word_offset, int beta); 6 | LispPTR N_OP_putbasen(LispPTR base, LispPTR tos, int n); 7 | LispPTR N_OP_putbaseptrn(LispPTR base, LispPTR tos, int n); 8 | #endif 9 | -------------------------------------------------------------------------------- /lowlev2.c: -------------------------------------------------------------------------------- 1 | /* $Id: lowlev2.c,v 1.3 1999/05/31 23:35:38 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | #include "adr68k.h" // for NativeAligned2FromLAddr, NativeAligned4FromLAddr 14 | #include "lispemul.h" // for state, LispPTR, ERROR_EXIT, SEGMASK, POINTE... 15 | #include "lispmap.h" // for S_POSITIVE, S_NEGATIVE 16 | #include "lowlev2defs.h" // for N_OP_addbase, N_OP_getbasebyte, N_OP_putbas... 17 | #include "lspglob.h" 18 | #include "lsptypes.h" // for GETBYTE, GetTypeNumber, TYPE_FIXP 19 | 20 | /*** NOTE: these routines likely not called (see inlinedefsC.h) ***/ 21 | 22 | /************************************************************ 23 | N_OP_addbase 24 | entry ADDBASE OPCODE[0320] 25 | 26 | 1. <> 27 | TopOfStack: offset 28 | *(CurrentStackPTR): base address 29 | 2. if High word of TopOfStack is SMALLPL or SMALLNEG, 30 | then add base address and offset and set result to TopOfStack. 31 | else call ufn2incs. 32 | 4. <> 33 | return: new address 34 | 35 | ***********************************************************/ 36 | 37 | LispPTR N_OP_addbase(LispPTR base, LispPTR offset) { 38 | base = POINTERMASK & base; 39 | switch ((SEGMASK & offset)) { 40 | case S_POSITIVE: return (base + (offset & 0x0000FFFF)); 41 | case S_NEGATIVE: return (base + (offset | 0xFFFF0000)); 42 | default: 43 | switch ((GetTypeNumber(offset))) { 44 | case TYPE_FIXP: 45 | /* overflow or underflow isn't check */ 46 | return (base + *(int *)NativeAligned4FromLAddr(offset)); 47 | default: /* floatp also */ ERROR_EXIT(offset); 48 | } /* end switch */ 49 | } /* end switch */ 50 | } 51 | 52 | /************************************************************ 53 | N_OP_getbasebyte 54 | entry GETBASEBYTE OPCODE[0302] 55 | 56 | 1. <> 57 | *(--CurrentStackPTR): base address. 58 | TopOfStack: Low word - byte offset. 59 | 2. if high word of TopOfStack is not SMALLPL, 60 | then call ufn2incS. 61 | else fetch 8 bits word at (base address + byte offset). 62 | 4. <> 63 | return: Least Low Byte - fetched data 64 | 65 | ***********************************************************/ 66 | 67 | LispPTR N_OP_getbasebyte(LispPTR base_addr, LispPTR byteoffset) { 68 | switch ((SEGMASK & byteoffset)) { 69 | case S_POSITIVE: byteoffset = byteoffset & 0x0000FFFF; break; 70 | case S_NEGATIVE: byteoffset = byteoffset | 0xFFFF0000; break; 71 | default: 72 | switch ((GetTypeNumber(byteoffset))) { 73 | case TYPE_FIXP: byteoffset = *((int *)NativeAligned4FromLAddr(byteoffset)); break; 74 | default: /* floatp also fall thru */ ERROR_EXIT(byteoffset); 75 | } /* end switch */ 76 | break; 77 | } /* end switch */ 78 | return ((0xFF & (GETBYTE((char *)NativeAligned2FromLAddr((POINTERMASK & base_addr)) + byteoffset))) | 79 | S_POSITIVE); 80 | } 81 | 82 | /************************************************************ 83 | N_OP_putbasebyte 84 | entry PUTBASEBYTE OPCODE[0307] 85 | 86 | 1. <> 87 | TopOfStack: Least Low Byte - replace data. 88 | *((int *)(CurrentStackPTR-1)): byte offset. 89 | *((int *)(CurrentStackPTR-2)): base address. 90 | 4. <> 91 | return: Least Low Byte - replace data ? 92 | 93 | ***********************************************************/ 94 | 95 | LispPTR N_OP_putbasebyte(LispPTR base_addr, LispPTR byteoffset, LispPTR tos) { 96 | if (((SEGMASK & tos) != S_POSITIVE) || ((unsigned short)tos >= 256)) ERROR_EXIT(tos); 97 | switch ((SEGMASK & byteoffset)) { 98 | case S_POSITIVE: byteoffset &= 0x0000FFFF; break; 99 | case S_NEGATIVE: byteoffset |= 0xFFFF0000; break; 100 | default: 101 | /* ucode and ufn don't handle displacement not smallp */ 102 | ERROR_EXIT(tos); 103 | } /* end switch */ 104 | GETBYTE(((char *)NativeAligned2FromLAddr(POINTERMASK & base_addr)) + byteoffset) = 0xFF & tos; 105 | return (tos); 106 | } 107 | -------------------------------------------------------------------------------- /lowlev2defs.h: -------------------------------------------------------------------------------- 1 | #ifndef LOWLEV2DEFS_H 2 | #define LOWLEV2DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_addbase(LispPTR base, LispPTR offset); 5 | LispPTR N_OP_getbasebyte(LispPTR base_addr, LispPTR byteoffset); 6 | LispPTR N_OP_putbasebyte(LispPTR base_addr, LispPTR byteoffset, LispPTR tos); 7 | #endif 8 | -------------------------------------------------------------------------------- /lsthandl.c: -------------------------------------------------------------------------------- 1 | /* $Id: lsthandl.c,v 1.4 1999/05/31 23:35:38 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-99 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | /************************************************************************/ 12 | /* 13 | Including : OP_fmemb 14 | OP_listget 15 | 16 | */ 17 | /**********************************************************************/ 18 | 19 | #include "version.h" 20 | 21 | #include "car-cdrdefs.h" // for car, cdr 22 | #include "cell.h" // for cadr_cell 23 | #include "lispemul.h" // for state, LispPTR, ERROR_EXIT, NIL_PTR, Scrat... 24 | #include "lspglob.h" 25 | #include "lsptypes.h" // for Listp, GetTypeNumber, TYPE_LISTP 26 | #include "lsthandldefs.h" // for N_OP_fmemb, N_OP_listget, fmemb 27 | #include "vars3defs.h" // for cadr 28 | 29 | /***********************************************************************/ 30 | /* N_OP_fmemb */ 31 | /**********************************************************************/ 32 | 33 | LispPTR N_OP_fmemb(LispPTR item, LispPTR tos) { /* OP 34Q */ 34 | 35 | while (Listp(tos)) { 36 | if (item == car(tos)) return tos; 37 | tos = cdr(tos); 38 | /* if we get an interrupt, punt so we can handle it safely */ 39 | if (!Irq_Stk_End) { TIMER_EXIT(tos); } 40 | } 41 | if (tos) ERROR_EXIT(tos); 42 | return tos; 43 | 44 | } /* N_OP_fmemb end */ 45 | 46 | /***********************************************************************/ 47 | /* 48 | Func Name : fmemb(item,list) 49 | >>For User programming<< 50 | NOTE: You should not handle long list, because it doesn't care 51 | about interrupt. 52 | 53 | */ 54 | /**********************************************************************/ 55 | 56 | LispPTR fmemb(LispPTR item, LispPTR list) { 57 | while (Listp(list)) { 58 | if (item == car(list)) return (list); 59 | list = cdr(list); 60 | } 61 | 62 | if (list) return (list); 63 | return (list); 64 | 65 | } /* fmemb end */ 66 | 67 | /***********************************************************************/ 68 | /* 69 | Func Name : N_OP_listget 70 | Opcode : 47Q 71 | */ 72 | /**********************************************************************/ 73 | 74 | #define SAVE_ERROR_EXIT2(topcstk, tos) \ 75 | do { \ 76 | Scratch_CSTK = topcstk; \ 77 | ERROR_EXIT(tos); \ 78 | } while (0) 79 | 80 | #define S_N_CHECKANDCADR2(sour, dest, tos, tcstk) \ 81 | do { \ 82 | LispPTR parm = sour; \ 83 | if (GetTypeNumber(parm) != TYPE_LISTP) { \ 84 | SAVE_ERROR_EXIT2(tcstk, tos); \ 85 | } else \ 86 | (dest) = cadr(parm); \ 87 | } while (0) 88 | 89 | LispPTR N_OP_listget(LispPTR plist, LispPTR tos) { 90 | struct cadr_cell cadrobj; 91 | 92 | while (plist != NIL_PTR) { 93 | S_N_CHECKANDCADR2(plist, cadrobj, tos, plist); 94 | 95 | if (cadrobj.car_cell == tos) { 96 | if (cadrobj.cdr_cell == NIL_PTR) return NIL_PTR; 97 | 98 | if (Listp(cadrobj.cdr_cell)) 99 | return (car(cadrobj.cdr_cell)); 100 | else /* must punt in case car/cdrerr */ 101 | SAVE_ERROR_EXIT2(plist, tos); 102 | } 103 | 104 | if (!Listp(cadrobj.cdr_cell)) { /* this list ended before we found prop */ 105 | return (NIL_PTR); 106 | } 107 | 108 | S_N_CHECKANDCADR2(cadrobj.cdr_cell, cadrobj, tos, plist); 109 | plist = cadrobj.cdr_cell; 110 | 111 | if (!Irq_Stk_End) { 112 | /* for continuation, it becomes plist on next time */ 113 | Scratch_CSTK = plist; 114 | TIMER_EXIT(tos); 115 | } 116 | } 117 | 118 | return (NIL_PTR); 119 | 120 | } /* N_OP_listget end */ 121 | -------------------------------------------------------------------------------- /lsthandldefs.h: -------------------------------------------------------------------------------- 1 | #ifndef LSTHANDLDEFS_H 2 | #define LSTHANDLDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_fmemb(LispPTR item, LispPTR tos); 5 | LispPTR fmemb(LispPTR item, LispPTR list); 6 | LispPTR N_OP_listget(LispPTR plist, LispPTR tos); 7 | #endif 8 | -------------------------------------------------------------------------------- /maindefs.h: -------------------------------------------------------------------------------- 1 | #ifndef MAINDEFS_H 2 | #define MAINDEFS_H 1 3 | void start_lisp(void); 4 | void print_info_lines(void); 5 | #endif 6 | -------------------------------------------------------------------------------- /medleyfp.h: -------------------------------------------------------------------------------- 1 | #ifndef MEDLEYFP_H 2 | #define MEDLEYFP_H 1 3 | /* $Id: medleyfp.h,v 1.2 1999/01/03 02:06:16 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | /************************************************************************/ 7 | /* */ 8 | /* (C) Copyright 1989-94 Venue. All Rights Reserved. */ 9 | /* Manufactured in the United States of America. */ 10 | /* */ 11 | /************************************************************************/ 12 | 13 | /************************************************************************/ 14 | /* */ 15 | /* */ 16 | /* */ 17 | /* */ 18 | /* */ 19 | /************************************************************************/ 20 | 21 | /* -------------------------------------------------- 22 | FPCLEAR - clear status as necessary 23 | FPTEST(result) - check result or status 24 | 25 | Sun 4 compiler w. -O2 moves too much code around 26 | to use FLTINT. 27 | -------------------------------------------------- */ 28 | 29 | #ifdef FLTINT 30 | #include 31 | extern volatile sig_atomic_t FP_error; 32 | 33 | /* Note that a compiler may very likely move code around the arithmetic 34 | operation, causing this test (set by an interrupt handler) to be 35 | incorrect. For example, the Sun SPARC compiler with -O2 makes 36 | this test incorrect. 37 | */ 38 | 39 | #define FPCLEAR FP_error = 0; 40 | #define FPTEST(result) FP_error 41 | #else 42 | #include 43 | #define FPCLEAR do {} while (0) 44 | #define FPTEST(result) (!isfinite(result)) 45 | 46 | #endif /* FLTINT */ 47 | #endif /* MEDLEYFP_H */ 48 | -------------------------------------------------------------------------------- /misc7.c: -------------------------------------------------------------------------------- 1 | /* $Id: misc7.c,v 1.2 1999/01/03 02:07:22 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | /* misc7.c 13 | */ 14 | #include "adr68k.h" // for NativeAligned2FromLAddr 15 | #include "arith.h" // for N_GETNUMBER 16 | #include "bbtsubdefs.h" // for n_new_cursorin 17 | #include "dbprint.h" // for DBPRINT 18 | #include "display.h" // for in_display_segment 19 | #include "initdspdefs.h" // for flush_display_ptrregion 20 | #include "lispemul.h" // for LispPTR, DLword, state, BITSPER_DLWORD, ERR... 21 | #include "lispmap.h" // for S_POSITIVE 22 | #include "lspglob.h" 23 | #include "lsptypes.h" // for GETWORDBASEWORD 24 | #include "misc7defs.h" // for N_OP_misc7 25 | 26 | 27 | /*************************************************/ 28 | /* Possible operation fields for FBITMAPBIT */ 29 | /*************************************************/ 30 | 31 | #define OP_INVERT 0 /* Invert the bit at the given location */ 32 | #define OP_ERASE 1 /* Turn the given bit off. */ 33 | #define OP_READ 2 /* Just read the bit that's there. */ 34 | #define OP_PAINT 3 /* Turn the bit on. */ 35 | 36 | extern int ScreenLocked; 37 | 38 | /*** N_OP_misc7 -- pseudocolor or fbitmapbit ***/ 39 | LispPTR N_OP_misc7(LispPTR arg1, LispPTR arg2, LispPTR arg3, LispPTR arg4, LispPTR arg5, LispPTR arg6, LispPTR arg7, int alpha) 40 | { 41 | DLword *base; 42 | int x, y, operation, heightminus1, rasterwidth, oldbit; 43 | int offset; 44 | DLword bmdata; 45 | DLword bmmask; 46 | int displayflg; 47 | 48 | DBPRINT(("MISC7 op with alpha byte %d.\n", alpha)); 49 | 50 | if (alpha != 1) ERROR_EXIT(arg7); 51 | 52 | base = NativeAligned2FromLAddr(arg1); 53 | N_GETNUMBER(arg2, x, doufn); 54 | N_GETNUMBER(arg3, y, doufn); 55 | N_GETNUMBER(arg4, operation, doufn); 56 | N_GETNUMBER(arg5, heightminus1, doufn); 57 | N_GETNUMBER(arg6, rasterwidth, doufn); 58 | 59 | DBPRINT(("MISC7 args OK.\n")); 60 | 61 | displayflg = n_new_cursorin(base, x, (heightminus1 - y), 1, 1); 62 | 63 | /* Bitmaps use a positive integer coordinate system with the lower left 64 | corner pixel at coordinate (0, 0). Storage is allocated in 16-bit words 65 | from the upper left corner (0, h-1), with rasterwidth 16-bit words per row. 66 | */ 67 | offset = (rasterwidth * (heightminus1 - y)) + (x / BITSPER_DLWORD); 68 | bmmask = (1 << (BITSPER_DLWORD - 1)) >> (x & (BITSPER_DLWORD - 1)); 69 | bmdata = GETWORDBASEWORD(base, offset); 70 | oldbit = bmdata & bmmask; 71 | 72 | ScreenLocked = T; 73 | 74 | switch (operation) { 75 | case OP_INVERT: GETWORDBASEWORD(base, offset) = bmdata ^ bmmask; break; 76 | case OP_ERASE: GETWORDBASEWORD(base, offset) = bmdata & ~bmmask; break; 77 | case OP_READ: break; 78 | default: GETWORDBASEWORD(base, offset) = bmdata | bmmask; 79 | } 80 | 81 | ScreenLocked = NIL; 82 | DBPRINT(("FBITMAPBIT old bit = 0x%x.\n", oldbit)); 83 | return (S_POSITIVE | (oldbit ? 1 : 0)); 84 | 85 | doufn: 86 | ERROR_EXIT(arg7); 87 | 88 | } /* end N_OP_misc7() */ 89 | -------------------------------------------------------------------------------- /misc7defs.h: -------------------------------------------------------------------------------- 1 | #ifndef MISC7DEFS_H 2 | #define MISC7DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_misc7(LispPTR arg1, LispPTR arg2, LispPTR arg3, LispPTR arg4, LispPTR arg5, LispPTR arg6, LispPTR arg7, int alpha); 5 | #endif 6 | -------------------------------------------------------------------------------- /miscn.c: -------------------------------------------------------------------------------- 1 | /* $Id: miscn.c,v 1.3 1999/05/31 23:35:39 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | /***********************************************************/ 13 | /* 14 | File Name: miscn.c 15 | Including: OP_miscn 16 | */ 17 | /***********************************************************/ 18 | 19 | #include "arith.h" // for N_GETNUMBER 20 | #include "commondefs.h" // for error 21 | #include "lispemul.h" // for LispPTR, state, CurrentStackPTR, TopOfStack 22 | #include "loopsopsdefs.h" // for LCFetchMethod, LCFetchMethodOrHelp, LCFind... 23 | #include "lspglob.h" 24 | #include "lsptypes.h" 25 | #include "miscndefs.h" // for OP_miscn 26 | #include "mvsdefs.h" // for values, values_list 27 | #include "subrs.h" // for miscn_LCFetchMethod, miscn_LCFetchMethodOr... 28 | #include "sxhashdefs.h" // for STRING_EQUAL_HASHBITS, STRING_HASHBITS 29 | #include "usrsubrdefs.h" // for UserSubr 30 | 31 | /***********************************************************/ 32 | /* 33 | Func Name : OP_miscn 34 | 35 | Interface: Global Machine State 36 | Returns: (must UFN) 37 | 0 = continue, C code succeeded. 38 | 1 = must UFN, C code failed. 39 | */ 40 | /***********************************************************/ 41 | 42 | int OP_miscn(int misc_index, int arg_count) { 43 | LispPTR *stk; 44 | int result; 45 | static LispPTR args[255]; 46 | 47 | /* Put the Args into a Vector */ 48 | 49 | args[0] = NIL_PTR; 50 | stk = ((LispPTR *)(void *)CurrentStackPTR) + 1; 51 | 52 | { 53 | int arg_num = arg_count; 54 | if (arg_num > 0) { 55 | *stk++ = (LispPTR)TopOfStack; 56 | while (arg_num > 0) args[--arg_num] = *--stk; 57 | } 58 | } 59 | 60 | /* Select the Misc Number */ 61 | 62 | switch (misc_index) { 63 | case miscn_USER_SUBR: { 64 | int user_subr; 65 | N_GETNUMBER(args[0], user_subr, do_ufn); 66 | if ((result = UserSubr(user_subr, arg_count - 1, &args[1])) < 0) goto do_ufn; 67 | } break; 68 | case miscn_SXHASH: result = SX_hash(args[0]); break; 69 | 70 | case miscn_STRING_EQUAL_HASHBITS: result = STRING_EQUAL_HASHBITS(args[0]); break; 71 | 72 | case miscn_STRINGHASHBITS: result = STRING_HASHBITS(args[0]); break; 73 | 74 | case miscn_VALUES: 75 | if (arg_count > 255) { 76 | error("miscn: arg_count too big! continue punts"); 77 | goto do_ufn; 78 | } 79 | result = values(arg_count, args); 80 | break; 81 | 82 | case miscn_VALUES_LIST: 83 | /*** debugging: should be impossible, but ADB found this once -FS *****/ 84 | if (arg_count > 255) { 85 | error("miscn: arg_count too big! continue punts"); 86 | goto do_ufn; 87 | } 88 | result = values_list(arg_count, args); 89 | break; 90 | 91 | case miscn_LCFetchMethod: 92 | result = LCFetchMethod(args[0], args[1]); 93 | if (result < 0) goto lc_ufn; 94 | break; 95 | 96 | case miscn_LCFetchMethodOrHelp: 97 | result = LCFetchMethodOrHelp(args[0], args[1]); 98 | if (result < 0) goto lc_ufn; 99 | break; 100 | 101 | case miscn_LCFindVarIndex: 102 | result = LCFindVarIndex(args[0], args[1]); 103 | if (result < 0) goto lc_ufn; 104 | break; 105 | 106 | case miscn_LCGetIVValue: 107 | result = LCGetIVValue(args[0], args[1]); 108 | if (result < 0) goto lc_ufn; 109 | break; 110 | 111 | case miscn_LCPutIVValue: 112 | result = LCPutIVValue(args[0], args[1], args[2]); 113 | if (result < 0) goto lc_ufn; 114 | break; 115 | 116 | case /* miscn_CALL_C*/ 014: 117 | /* result = call_c_fn(args); */ 118 | result = 0; 119 | break; 120 | 121 | default: goto do_ufn; 122 | 123 | } /* switch end */ 124 | 125 | /* Setup Global Machine State for a Normal Return */ 126 | 127 | PC += 3; 128 | CurrentStackPTR = (DLword *)(stk - 1); 129 | TopOfStack = (LispPTR)result; 130 | return (0); 131 | 132 | /* A UFN request, so return 1 & don't change the Machine State */ 133 | 134 | do_ufn: 135 | return (1); 136 | lc_ufn: 137 | if (result == -2) { 138 | return (0); /* have built new stack frame */ 139 | } else { 140 | goto do_ufn; 141 | } 142 | 143 | } /* OP_miscn */ 144 | -------------------------------------------------------------------------------- /miscndefs.h: -------------------------------------------------------------------------------- 1 | #ifndef MISCNDEFS_H 2 | #define MISCNDEFS_H 1 3 | int OP_miscn(int misc_index, int arg_count); 4 | #endif 5 | -------------------------------------------------------------------------------- /miscstat.h: -------------------------------------------------------------------------------- 1 | #ifndef MISCSTAT_H 2 | #define MISCSTAT_H 1 3 | /* $Id: miscstat.h,v 1.2 1999/01/03 02:06:17 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /* 6 | * Copyright (C) 1987 by Fuji Xerox Co., Ltd. All rights reserved. 7 | * 8 | * by : Yasuhiko Kiuchi 9 | */ 10 | 11 | 12 | /************************************************************************/ 13 | /* */ 14 | /* Copyright 1989, 1990 Venue, Fuji Xerox Co., Ltd, Xerox Corp. */ 15 | /* */ 16 | /* This file is work-product resulting from the Xerox/Venue */ 17 | /* Agreement dated 18-August-1989 for support of Medley. */ 18 | /* */ 19 | /************************************************************************/ 20 | 21 | 22 | typedef struct misc 23 | { 24 | int starttime; 25 | int totaltime; 26 | int swapwaittime; 27 | int pagefaults; 28 | int swapwrites; 29 | int diskiotime; 30 | int diskops; 31 | int keyboardwaittime; 32 | int gctime; 33 | int netiotime; 34 | int netioops; 35 | int swaptemp0; 36 | int swaptemp1; 37 | unsigned int rclksecond; 38 | unsigned int secondsclock; 39 | unsigned int millisecondsclock; 40 | unsigned int baseclock; 41 | unsigned int rclktemp0; 42 | unsigned int secondstmp; 43 | unsigned int millisecondstmp; 44 | unsigned int basetmp; 45 | int excesstimetmp; 46 | int clocktemp0; 47 | int disktemp0; 48 | int disktemp1; 49 | int teleraidtemp1; 50 | int teleraidtemp2; 51 | int teleraidtemp3; 52 | int lastuseraction; 53 | int dlmousetimer; 54 | int dlmousetemp; 55 | } MISCSTATS; 56 | #endif /* MISCSTAT_H */ 57 | -------------------------------------------------------------------------------- /mkatomdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef MKATOMDEFS_H 2 | #define MKATOMDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | DLword compute_hash(const char *char_base, DLword offset, DLword length); 5 | DLword compute_lisp_hash(const char *char_base, DLword offset, DLword length, DLword fatp); 6 | LispPTR compare_chars(const char *char1, const char *char2, DLword length); 7 | LispPTR compare_lisp_chars(const char *char1, const char *char2, DLword length, DLword fat1, DLword fat2); 8 | LispPTR make_atom(const char *char_base, DLword offset, DLword length); 9 | #endif 10 | -------------------------------------------------------------------------------- /mkcell.c: -------------------------------------------------------------------------------- 1 | /* $Id: mkcell.c,v 1.3 1999/05/31 23:35:39 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | /***********************************************************************/ 14 | /* 15 | File Name : mkcell.c 16 | 17 | Desc : 18 | 19 | Date : Jun. 4, 1987 20 | Edited by : Takeshi Shimizu 21 | Changed : 9 Jun 1987 take 22 | 26 Oct. 1987 take(add mask) 23 | 24 | Including : OP_createcell 25 | 26 | 27 | */ 28 | /**********************************************************************/ 29 | 30 | #include "adr68k.h" // for NativeAligned2FromLAddr 31 | #include "allocmdsdefs.h" // for alloc_mdspage, initmdspage 32 | #include "commondefs.h" // for error 33 | #include "gcdata.h" // for DELREF, GCLOOKUP 34 | #include "gchtfinddefs.h" // for htfind, rec_htfind 35 | #include "lispemul.h" // for LispPTR, DLword, NIL, POINTERMASK, state 36 | #include "lispmap.h" // for S_POSITIVE 37 | #include "lspglob.h" 38 | #include "lsptypes.h" // for dtd, GETWORD, GetDTD 39 | #include "mkcelldefs.h" // for N_OP_createcell, createcell68k 40 | #ifdef DTDDEBUG 41 | #include "testtooldefs.h" 42 | #endif 43 | 44 | static LispPTR oldoldfree; 45 | static LispPTR oldfree; 46 | 47 | LispPTR N_OP_createcell(LispPTR tos) { 48 | struct dtd *dtd68k; 49 | DLword *ptr, *lastptr; 50 | LispPTR newcell; 51 | unsigned int type; 52 | 53 | if ((tos & SEGMASK) != S_POSITIVE) ERROR_EXIT(tos); 54 | type = tos & 0xffff; 55 | 56 | #ifdef DTDDEBUG 57 | if (type == TYPE_LISTP) error("N_OP_createcell : Can't create Listp cell with CREATECELL"); 58 | check_dtd_chain(type); 59 | #endif 60 | 61 | dtd68k = (struct dtd *)GetDTD(type); 62 | 63 | oldoldfree = oldfree; 64 | oldfree = dtd68k->dtd_free; 65 | 66 | if (dtd68k->dtd_size == 0) ERROR_EXIT(tos); 67 | /* error("OP_createcell : Attempt to create a cell not declared yet"); */ 68 | 69 | retry: 70 | if ((tos = newcell = ((dtd68k->dtd_free) & POINTERMASK)) != NIL) { 71 | ptr = (DLword *)NativeAligned2FromLAddr(newcell); 72 | if (917505 == *(LispPTR *)ptr) error("N_OP_createcell E0001 error"); 73 | /* replace dtd_free with newcell's top DLword (it may keep next chain)*/ 74 | dtd68k->dtd_free = (*((LispPTR *)ptr)) & POINTERMASK; 75 | if (dtd68k->dtd_free & 0x8000001) error("bad entry on free chain."); 76 | 77 | dtd68k->dtd_oldcnt++; 78 | 79 | /* clear 0 */ 80 | for (lastptr = ptr + dtd68k->dtd_size; ptr != lastptr; ptr++) { GETWORD(ptr) = 0; } 81 | 82 | /* IncAllocCnt(1); */ 83 | GCLOOKUP(tos, DELREF); 84 | return (tos); 85 | } else { 86 | dtd68k->dtd_free = initmdspage(alloc_mdspage(dtd68k->dtd_typeentry), dtd68k->dtd_size, NIL); 87 | if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain."); 88 | goto retry; 89 | } 90 | 91 | } /* N_OP_createcell end */ 92 | 93 | void *createcell68k(unsigned int type) { 94 | struct dtd *dtd68k; 95 | DLword *ptr, *lastptr; 96 | LispPTR newcell; 97 | #ifdef DTDDEBUG 98 | if (type == TYPE_LISTP) error("createcell : Can't create Listp cell with CREATECELL"); 99 | if (type == TYPE_STREAM) stab(); 100 | 101 | check_dtd_chain(type); 102 | 103 | #endif 104 | 105 | dtd68k = (struct dtd *)GetDTD(type); 106 | 107 | if (dtd68k->dtd_size == 0) error("createcell : Attempt to create a cell not declared yet"); 108 | 109 | retry: 110 | if ((newcell = (dtd68k->dtd_free & POINTERMASK)) != NIL) { 111 | #ifdef DTDDEBUG 112 | if (type != GetTypeNumber(newcell)) error("createcell : BAD cell in dtdfree"); 113 | if (newcell > POINTERMASK) error("createcell : BAD Lisp address"); 114 | #endif 115 | 116 | ptr = NativeAligned2FromLAddr(newcell); 117 | 118 | if (917505 == *(LispPTR *)ptr) error("N_OP_createcell E0001 error"); 119 | 120 | /* replace dtd_free with newcell's top DLword (it may keep next chain)*/ 121 | dtd68k->dtd_free = (*((LispPTR *)ptr)) & POINTERMASK; 122 | if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain."); 123 | 124 | #ifdef DTDDEBUG 125 | if ((dtd68k->dtd_free != 0) && (type != GetTypeNumber(dtd68k->dtd_free))) 126 | error("createcell : BAD cell in next dtdfree"); 127 | check_dtd_chain(type); 128 | 129 | #endif 130 | 131 | dtd68k->dtd_oldcnt++; 132 | 133 | /* clear 0 */ 134 | for (lastptr = ptr + dtd68k->dtd_size; ptr != lastptr; ptr++) { GETWORD(ptr) = 0; } 135 | 136 | /* IncAllocCnt(1); */ 137 | GCLOOKUP(newcell, DELREF); 138 | 139 | #ifdef DTDDEBUG 140 | check_dtd_chain(type); 141 | #endif 142 | 143 | return (NativeAligned2FromLAddr(newcell)); /* XXX: is it really only aligned(2)? */ 144 | 145 | } else { 146 | dtd68k->dtd_free = initmdspage(alloc_mdspage(dtd68k->dtd_typeentry), dtd68k->dtd_size, NIL); 147 | if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain."); 148 | 149 | #ifdef DTDDEBUG 150 | check_dtd_chain(type); 151 | #endif 152 | 153 | goto retry; 154 | } 155 | 156 | } /* createcell68k end */ 157 | -------------------------------------------------------------------------------- /mkcelldefs.h: -------------------------------------------------------------------------------- 1 | #ifndef MKCELLDEFS_H 2 | #define MKCELLDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | LispPTR N_OP_createcell(LispPTR tos); 5 | void *createcell68k(unsigned int type); 6 | #endif 7 | -------------------------------------------------------------------------------- /mvsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef MVSDEFS_H 2 | #define MVSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | #include "stack.h" /* for FX2 */ 5 | LispPTR make_value_list(int argcount, LispPTR *argarray); 6 | void simulate_unbind(FX2 *frame, int unbind_count, FX2 *returner); 7 | LispPTR values(int arg_count, LispPTR *args); 8 | LispPTR values_list(int arg_count, LispPTR *args); 9 | #endif 10 | -------------------------------------------------------------------------------- /osmsg.h: -------------------------------------------------------------------------------- 1 | #ifndef OSMSG_H 2 | #define OSMSG_H 1 3 | /* $Id: osmsg.h,v 1.2 1999/01/03 02:06:20 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | /************************************************* 7 | This is OSMESSAGE stuff. 8 | 9 | Print a console message. 10 | *************************************************/ 11 | 12 | /************************************************************************/ 13 | /* */ 14 | /* (C) Copyright 1989-98 Venue. All Rights Reserved. */ 15 | /* Manufactured in the United States of America. */ 16 | /* */ 17 | /************************************************************************/ 18 | 19 | #define OSMESSAGE_PRINT(print_exp) \ 20 | do { \ 21 | print_exp; \ 22 | } while (0) 23 | 24 | #endif /* OSMSG_H */ 25 | -------------------------------------------------------------------------------- /perrno.c: -------------------------------------------------------------------------------- 1 | /* $Id: perrno.c,v 1.4 2001/12/26 22:17:04 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | #include // for errno 14 | #include // for fprintf, perror, stderr, NULL 15 | #include // for strerror 16 | #include "osmsg.h" // for OSMESSAGE_PRINT 17 | #include "perrnodefs.h" // for err_mess, perrorn 18 | 19 | /************************************************************************/ 20 | /* */ 21 | /* p e r r o r n */ 22 | /* */ 23 | /* Print the error message to go with a given error number. */ 24 | /* */ 25 | /************************************************************************/ 26 | 27 | void perrorn(char *s, int n) { 28 | if (s != NULL && *s != '\0') { (void)fprintf(stderr, "%s: ", s); } 29 | (void)fprintf(stderr, "%s\n", strerror(n)); 30 | } 31 | 32 | /************************************************************************/ 33 | /* */ 34 | /* e r r _ m e s s */ 35 | /* */ 36 | /* Print an error message and call 'perror' to get the */ 37 | /* canonical error explanation. Called by emulator I/O code. */ 38 | /* */ 39 | /************************************************************************/ 40 | 41 | void err_mess(const char *from, int no) { 42 | const int save_errno = errno; /* Save errno around OSMESSAGE_PRINT */ 43 | 44 | OSMESSAGE_PRINT({ 45 | (void)fprintf(stderr, "System call error: %s errno=%d ", from, no); 46 | perror(""); 47 | }); 48 | 49 | errno = save_errno; 50 | } 51 | -------------------------------------------------------------------------------- /perrnodefs.h: -------------------------------------------------------------------------------- 1 | #ifndef PERRNODEFS_H 2 | #define PERRNODEFS_H 1 3 | void perrorn(char *s, int n); 4 | void err_mess(const char *from, int no); 5 | #endif 6 | -------------------------------------------------------------------------------- /platform.h: -------------------------------------------------------------------------------- 1 | #ifndef MAIKO_PLATFORM_H 2 | #define MAIKO_PLATFORM_H 1 3 | 4 | /* 5 | * Set up various preprocessor definitions based upon 6 | * the platform. 7 | */ 8 | 9 | #if defined(__APPLE__) && defined(__MACH__) 10 | # define MAIKO_OS_MACOS 1 11 | # define MAIKO_OS_NAME "macOS" 12 | # define MAIKO_OS_UNIX_LIKE 1 13 | # define MAIKO_OS_DETECTED 1 14 | #endif 15 | 16 | #ifdef __linux__ 17 | # define MAIKO_OS_LINUX 1 18 | # define MAIKO_OS_NAME "Linux" 19 | # define MAIKO_OS_UNIX_LIKE 1 20 | # define MAIKO_OS_DETECTED 1 21 | #endif 22 | 23 | #if defined(_WIN32) || defined(__WINDOWS__) 24 | # define MAIKO_OS_WINDOWS 1 25 | # define MAIKO_OS_NAME "Windows" 26 | # define MAIKO_OS_DETECTED 1 27 | #endif 28 | 29 | /* __x86_64__: GNU C, __x86_64: Sun Studio, _M_AMD64: Visual Studio */ 30 | #if defined(__x86_64__) || defined(__x86_64) || defined(_M_AMD64) 31 | # define MAIKO_ARCH_X86_64 1 32 | # define MAIKO_ARCH_NAME "x86_64" 33 | # define MAIKO_ARCH_WORD_BITS 64 34 | # define MAIKO_ARCH_DETECTED 1 35 | #endif 36 | 37 | /* __arm__: GNU C */ 38 | #ifdef __arm__ 39 | # define MAIKO_ARCH_ARM 1 40 | # define MAIKO_ARCH_NAME "arm" 41 | # define MAIKO_ARCH_WORD_BITS 32 42 | # define MAIKO_ARCH_DETECTED 1 43 | #endif 44 | 45 | /* __aarch64__: GNU C */ 46 | #ifdef __aarch64__ 47 | # define MAIKO_ARCH_ARM64 1 48 | # define MAIKO_ARCH_NAME "arm64" 49 | # define MAIKO_ARCH_WORD_BITS 64 50 | # define MAIKO_ARCH_DETECTED 1 51 | #endif 52 | 53 | /* __i386: GNU C, Sun Studio, _M_IX86: Visual Studio */ 54 | #if defined(__i386) || defined(_M_IX86) 55 | # define MAIKO_ARCH_X86 1 56 | # define MAIKO_ARCH_NAME "x86" 57 | # define MAIKO_ARCH_WORD_BITS 32 58 | # define MAIKO_ARCH_DETECTED 1 59 | #endif 60 | 61 | 62 | /* Modern GNU C, Clang, Sun Studio provide __BYTE_ORDER__ 63 | * Older GNU C (ca. 4.0.1) provides __BIG_ENDIAN__/__LITTLE_ENDIAN__ 64 | */ 65 | #if defined(__BYTE_ORDER__) 66 | # if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ 67 | # define BYTESWAP 1 68 | # elif __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ 69 | # undef BYTESWAP 70 | # else 71 | # error "Unknown byte order" 72 | # endif 73 | #elif __BIG_ENDIAN__ == 1 74 | # undef BYTESWAP 75 | #elif __LITTLE_ENDIAN__ == 1 76 | # define BYTESWAP 1 77 | #else 78 | # error "Could not detect byte order" 79 | #endif 80 | 81 | #ifndef MAIKO_OS_DETECTED 82 | # error "Could not detect OS." 83 | #endif 84 | 85 | #ifndef MAIKO_ARCH_DETECTED 86 | # error "Could not detect system architecture." 87 | #endif 88 | 89 | #endif /* MAIKO_PLATFORM_H */ 90 | -------------------------------------------------------------------------------- /print.h: -------------------------------------------------------------------------------- 1 | #ifndef PRINT_H 2 | #define PRINT_H 1 3 | /* $Id: print.h,v 1.2 1999/01/03 02:06:21 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | 7 | /************************************************************************/ 8 | /* */ 9 | /* (C) Copyright 1989-96 Venue. All Rights Reserved. */ 10 | /* Manufactured in the United States of America. */ 11 | /* */ 12 | /************************************************************************/ 13 | 14 | /************************************************************************/ 15 | /* */ 16 | /* Syntax-class & character defns for PRINT code in C. */ 17 | /* */ 18 | /* */ 19 | /* */ 20 | /************************************************************************/ 21 | 22 | 23 | /************************************************************************/ 24 | /* */ 25 | /* Copyright 1989, 1990 Venue, Fuji Xerox Co., Ltd, Xerox Corp. */ 26 | /* */ 27 | /* This file is work-product resulting from the Xerox/Venue */ 28 | /* Agreement dated 18-August-1989 for support of Medley. */ 29 | /* */ 30 | /************************************************************************/ 31 | 32 | 33 | 34 | #define LEFT_PAREN 40 35 | #define RIGHT_PAREN 41 36 | #define SPACE 32 37 | #define PERCENT 37 38 | #define DOTCODE 46 39 | #define DOUBLEQUOTE 34 40 | #define ATOMINDEXDOT 48 41 | 42 | #endif /* PRINT_H */ 43 | -------------------------------------------------------------------------------- /return.h: -------------------------------------------------------------------------------- 1 | #ifndef RETURN_H 2 | #define RETURN_H 1 3 | /* $Id: return.h,v 1.2 1999/01/03 02:06:22 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | /**************************************************************/ 7 | /* 8 | 9 | File Name : return.h 10 | Desc. : Macros for return,contextsw 11 | 12 | Written by : Takeshi Shimizu 13 | 11-May-88 14 | 15 | */ 16 | /**************************************************************/ 17 | 18 | 19 | /************************************************************************/ 20 | /* */ 21 | /* (C) Copyright 1989-98 Venue. All Rights Reserved. */ 22 | /* Manufactured in the United States of America. */ 23 | /* */ 24 | /************************************************************************/ 25 | 26 | 27 | #ifdef BIGVM 28 | #define FX_FNHEADER CURRENTFX->fnheader 29 | #else 30 | #define FX_FNHEADER (CURRENTFX->hi2fnheader << 16) | CURRENTFX->lofnheader 31 | #endif /* BIGVM */ 32 | 33 | 34 | 35 | /* FAST case return use */ 36 | #ifndef RESWAPPEDCODESTREAM 37 | #define FastRetCALL \ 38 | do { \ 39 | /* Get IVar from Returnee's IVAR offset slot(BF) */ \ 40 | IVar = NativeAligned2FromStackOffset(GETWORD((DLword *)CURRENTFX - 1)); \ 41 | /* Get FuncObj from Returnee's FNHEAD slot in FX */ \ 42 | FuncObj = (struct fnhead *)NativeAligned4FromLAddr(FX_FNHEADER); \ 43 | /* Get PC from Returnee's pc slot in FX */ \ 44 | PC = (ByteCode *)FuncObj + CURRENTFX->pc ; \ 45 | } while (0) 46 | #else 47 | #define FastRetCALL \ 48 | do { \ 49 | /* Get IVar from Returnee's IVAR offset slot(BF) */ \ 50 | IVar = NativeAligned2FromStackOffset(GETWORD((DLword *)CURRENTFX - 1)); \ 51 | /* Get FuncObj from Returnee's FNHEAD slot in FX */ \ 52 | FuncObj = (struct fnhead *)NativeAligned4FromLAddr(FX_FNHEADER); \ 53 | /* Get PC from Returnee's pc slot in FX */ \ 54 | PC = (ByteCode *)FuncObj + CURRENTFX->pc ; \ 55 | if (!(FuncObj->byteswapped)) \ 56 | { \ 57 | byte_swap_code_block(FuncObj); \ 58 | FuncObj->byteswapped = 1; \ 59 | } \ 60 | } while (0) 61 | #endif /* RESWAPPEDCODESTREAM */ 62 | 63 | 64 | 65 | /** in CONTEXTSW , for exchanging context **/ 66 | 67 | #define Midpunt(fxnum) \ 68 | do { DLword midpunt; \ 69 | midpunt = LOLOC(LAddrFromNative(CURRENTFX)); \ 70 | PVar=(DLword *) \ 71 | NativeAligned2FromStackOffset( \ 72 | (GETWORD(((DLword *)InterfacePage) + (fxnum)))) \ 73 | + FRAMESIZE; \ 74 | GETWORD(((DLword *)InterfacePage) + (fxnum)) = midpunt ; \ 75 | } while (0) 76 | 77 | 78 | #define CHECKFX \ 79 | do { if (((UNSIGNED)PVar -(UNSIGNED)CURRENTFX) != 20) \ 80 | { printf("Invalid FX(0x%x) and PV(0x%x) \n", \ 81 | LAddrFromNative(CURRENTFX),LAddrFromNative(PVar)); \ 82 | } \ 83 | } while (0) 84 | 85 | 86 | 87 | /**** Calls when invoke the function is assumed 88 | that it is called by CONTEXTSW in original LISP code **/ 89 | 90 | #define BEFORE_CONTEXTSW \ 91 | do { CurrentStackPTR += 2; \ 92 | CURRENTFX->nextblock=StackOffsetFromNative(CurrentStackPTR); \ 93 | GETWORD(CurrentStackPTR)=STK_FSB_WORD; \ 94 | GETWORD(CurrentStackPTR+1)= (((UNSIGNED)EndSTKP-(UNSIGNED)(CurrentStackPTR))>>1); \ 95 | if (GETWORD(CurrentStackPTR+1) == 0) error("0-long free block."); \ 96 | } while (0) 97 | 98 | 99 | #define AFTER_CONTEXTSW \ 100 | do { DLword *ac_ptr68k,*ac_freeptr; \ 101 | ac_ptr68k = (DLword*)NativeAligned2FromStackOffset(CURRENTFX->nextblock); \ 102 | if(GETWORD(ac_ptr68k) != STK_FSB_WORD) error("pre_moveframe: MP9316"); \ 103 | CHECK_FX(CURRENTFX); \ 104 | ac_freeptr=ac_ptr68k; \ 105 | while(GETWORD(ac_freeptr) == STK_FSB_WORD) \ 106 | EndSTKP=ac_freeptr=ac_freeptr+ GETWORD(ac_freeptr+1); \ 107 | S_CHECK(CURRENTFX->incall== NIL, "CONTEXTSW during fn call"); \ 108 | /*S_CHECK(CURRENTFX->nopush== NIL, "CONTEXTSW, NOPUSH is set"); ** JDS 4/9/96 this seems not to matter, so I removed it. */\ 109 | CurrentStackPTR = ac_ptr68k- 2 ; \ 110 | CHECK_FX(CURRENTFX); \ 111 | S_CHECK( EndSTKP > CurrentStackPTR, \ 112 | "End of stack isn't beyond current stk pointer."); \ 113 | } while (0) 114 | #endif /* RETURN_H */ 115 | -------------------------------------------------------------------------------- /returndefs.h: -------------------------------------------------------------------------------- 1 | #ifndef RETURNDEFS_H 2 | #define RETURNDEFS_H 1 3 | #include "lispemul.h" /* for DLword */ 4 | void OP_contextsw(void); 5 | void contextsw(DLword fxnum, DLword bytenum, DLword flags); 6 | #endif 7 | -------------------------------------------------------------------------------- /rplcons.c: -------------------------------------------------------------------------------- 1 | /* $Id: rplcons.c,v 1.3 1999/05/31 23:35:41 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | /***********************************************************************/ 14 | /* 15 | File Name : rplcons.c 16 | 17 | Desc : rplcons 18 | 19 | Including : rplcons 20 | OP_rplcons 21 | 22 | */ 23 | /**********************************************************************/ 24 | 25 | #include "car-cdrdefs.h" // for N_OP_rplacd 26 | #include "conspagedefs.h" // for cons 27 | #include "lispemul.h" // for LispPTR, state, ERROR_EXIT, NIL_PTR 28 | #include "lspglob.h" 29 | #include "lsptypes.h" // for Listp 30 | #include "rplconsdefs.h" // for N_OP_rplcons 31 | #ifndef NEWCDRCODING 32 | #include "gcdata.h" 33 | #include "gchtfinddefs.h" // for htfind, rec_htfind 34 | #include "address.h" 35 | #endif 36 | 37 | /***************************************************/ 38 | 39 | LispPTR N_OP_rplcons(LispPTR list, LispPTR item) { 40 | #ifndef NEWCDRCODING 41 | struct conspage *conspage; 42 | ConsCell *new_cell; 43 | ConsCell *list68k; 44 | LispPTR page; 45 | #endif 46 | 47 | if (!Listp(list)) ERROR_EXIT(item); 48 | 49 | /* There are some rest Cell and "list" must be ONPAGE cdr_coded */ 50 | #ifndef NEWCDRCODING 51 | page = POINTER_PAGE(list); 52 | list68k = (ConsCell *)NativeAligned4FromLAddr(list); 53 | 54 | if ((GetCONSCount(page) != 0) && (list68k->cdr_code > CDR_MAXINDIRECT)) { 55 | GCLOOKUP(item, ADDREF); 56 | GCLOOKUP(cdr(list), DELREF); 57 | 58 | conspage = (struct conspage *)NativeAligned4FromLPage(page); 59 | new_cell = (ConsCell *)GetNewCell_68k(conspage); 60 | 61 | conspage->count--; 62 | conspage->next_cell = ((freecons *)new_cell)->next_free; 63 | 64 | new_cell->car_field = item; 65 | new_cell->cdr_code = CDR_NIL; 66 | 67 | ListpDTD->dtd_cnt0++; 68 | 69 | list68k->cdr_code = CDR_ONPAGE | ((LAddrFromNative(new_cell) & 0xff) >> 1); 70 | 71 | return (LAddrFromNative(new_cell)); 72 | 73 | } else 74 | #endif /* ndef NEWCDRCODING */ 75 | { 76 | N_OP_rplacd(list, item = cons(item, NIL_PTR)); 77 | return (item); 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /rplconsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef RPLCONSDEFS_H 2 | #define RPLCONSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_rplcons(LispPTR list, LispPTR item); 5 | #endif 6 | -------------------------------------------------------------------------------- /run-medley: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # Run Medley 3 | # 4 | # Syntax: run-medley [-noscroll] #turn off scrollbars 5 | # [--dimensions WIDTHxHEIGHT] # sets both -g -sc 6 | # [-g WIDTHxHEIGHT] 7 | # [-sc WIDTHxHEIGHT] 8 | # [--display X_DISPLAY] # defaults to $DISPLAY or :0 9 | # [-prog LDEFILE] 10 | # [--vmem | --vmfile FILE] 11 | # [--nogreet | --greet FILE | 12 | # --loadup FILE ] 13 | # [-n | -nl | -full | -lisp | 14 | # [SYSOUTFILE] 15 | 16 | # Variables accessible from Lisp via UNIX-GETENV 17 | # LDESRCESYSOUT SYSOUT full-file name you want to run 18 | # LDEDESTSYSOUT name for destination of SaveVM/LOGOUT 19 | # MEDLEYDIR used by init file to set other path variables 20 | 21 | #for x in "$@"; do echo $x; done 22 | #exit 23 | 24 | inferred_medleydir=false 25 | 26 | if [ -z "$MEDLEYDIR" ] ; then 27 | export MEDLEYDIR="$( cd "$(dirname "$0")" >/dev/null 2>&1 ; pwd -P )" 28 | inferred_medleydir=true 29 | fi 30 | 31 | if [ ! -d "$MEDLEYDIR/loadups" ] ; then 32 | echo "MEDLEYDIR has no loadups: $MEDLEYDIR" 33 | if [ $inferred_medleydir = true ] ; then 34 | echo "I tried to infer it based on your working directory, but that didn't work." 35 | echo "Try cd there or setting the MEDLEYDIR environment variable to its location." 36 | fi 37 | exit 1 38 | fi 39 | 40 | # set defaults, overridden if suppplied explicitly 41 | 42 | prog="./gingko" 43 | pass="" 44 | mem="-m 256" 45 | scroll=22 46 | noscroll="" 47 | display="" 48 | title="Medley Interlisp" 49 | 50 | if [ -z "$LDEDESTSYSOUT" ] ; then 51 | if [ -z "$LOGINDIR" ] ; then 52 | export LDEDESTSYSOUT="${HOME}/lisp.virtualmem" 53 | else 54 | export LDEDESTSYSOUT="${LOGINDIR}/lisp.virtualmem" 55 | fi 56 | fi 57 | 58 | if [ -z "$LDEINIT" ] ; then 59 | export LDEINIT="$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT" 60 | fi 61 | 62 | while [ "$#" -ne 0 ]; do 63 | case "$1" in 64 | -loadup) 65 | # Keep (GREET) from finding a different init file 66 | mkdir -p $MEDLEYDIR/tmp/logindir 67 | export LOGINDIR=$MEDLEYDIR/tmp/logindir 68 | export MEDLEYLOADUP="$2" 69 | export LDEINIT="$2" 70 | shift 71 | ;; 72 | -nogreet | --nogreet) 73 | # Keep (GREET) from finding an init file 74 | mkdir -p $MEDLEYDIR/tmp/logindir 75 | export LOGINDIR=$MEDLEYDIR/tmp/logindir 76 | export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET" 77 | ;; 78 | -greet | --greet) 79 | export LDEINIT="$2" 80 | shift 81 | ;; 82 | -noscroll) 83 | scroll=0 84 | noscroll="-noscroll" 85 | ;; 86 | --dimensions | -dimensions) 87 | sw=`expr "$2" : "\([0-9]*\)x[0-9]*$"` 88 | sh=`expr "$2" : "[0-9]*x\([0-9]*\)$"` 89 | if [ -n "$sw" -a -n "$sh" ] ; then 90 | sw=$(( (31+$sw)/32*32 )) 91 | gw=$(( $scroll+$sw )) 92 | gh=$(( $scroll+$sh )) 93 | geometry="-g ${gw}x${gh}" 94 | screensize="-sc ${sw}x${sh}" 95 | fi 96 | shift 97 | ;; 98 | --geometry | -geometry | -g) 99 | geometry="-g $2" 100 | shift 101 | ;; 102 | --screensize | -screensize | -sc) 103 | screensize="-sc $2" 104 | shift 105 | ;; 106 | --display | -d) 107 | display="-display $2" 108 | shift 109 | ;; 110 | -prog) 111 | prog="$2" 112 | shift 113 | ;; 114 | -m | -mem) 115 | mem="-m $2 " 116 | shift 117 | ;; 118 | -title) 119 | if [ -n "$2" ] ; then 120 | title="$2" 121 | fi 122 | shift 123 | ;; 124 | -vmem | --vmem | -vmfile) 125 | export LDEDESTSYSOUT="$2" 126 | shift 127 | ;; 128 | -full) 129 | export LDESRCESYSOUT="$MEDLEYDIR/loadups/full.sysout" 130 | ;; 131 | -lisp) 132 | export LDESRCESYSOUT="$MEDLEYDIR/loadups/lisp.sysout" 133 | ;; 134 | -n | -new | -newfull) 135 | export LDESRCESYSOUT="$MEDLEYDIR/tmp/full.sysout" 136 | ;; 137 | -nl | -newlisp) 138 | export LDESRCESYSOUT="$MEDLEYDIR/tmp/lisp.sysout" 139 | ;; 140 | -NF) 141 | pass="$pass $1" # for making init, don't fork 142 | ;; 143 | -*) 144 | pass="$pass $1 $2" 145 | shift 146 | ;; 147 | *) 148 | echo sysout "$1" 149 | export LDESRCESYSOUT="$1" 150 | ;; 151 | esac 152 | shift 153 | done 154 | 155 | if [ -z "$LDESRCESYSOUT" ] ; then 156 | if [ -f "$LDEDESTSYSOUT" ] ; then 157 | export LDESRCESYSOUT="$LDEDESTSYSOUT" 158 | else 159 | export LDESRCESYSOUT="$MEDLEYDIR/loadups/full.sysout" 160 | fi 161 | fi 162 | 163 | if [ -z "$geometry" ] ; then 164 | # maiko guesses wrong 165 | geometry="-g 1200x768" 166 | screensize="-sc 1200x768" 167 | fi 168 | 169 | 170 | echo "running: $prog $display $noscroll $geometry $screensize -title \"$title\" $mem $pass $LDESRCESYSOUT" 171 | echo "greet: $LDEINIT" 172 | 173 | export INMEDLEY=1 174 | 175 | "$prog" $display $noscroll $geometry $screensize $mem -title "$title" $pass "$LDESRCESYSOUT" 176 | -------------------------------------------------------------------------------- /sdldefs.h: -------------------------------------------------------------------------------- 1 | #ifndef SDLDEFS_H 2 | #define SDLDEFS_H 1 3 | 4 | void sdl_notify_damage(int x, int y, int w, int h); 5 | void sdl_setCursor(int hot_x, int hot_y); 6 | void sdl_set_invert(int flag); 7 | void sdl_setMousePosition(int x, int y); 8 | void process_SDLevents(); 9 | int init_SDL(const char *windowtitle, int w, int h, int s); 10 | #endif 11 | -------------------------------------------------------------------------------- /shift.c: -------------------------------------------------------------------------------- 1 | /* $Id: shift.c,v 1.3 1999/05/31 23:35:42 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | #include "arith.h" // for N_GETNUMBER, N_ARITH_SWITCH 13 | #include "lispemul.h" // for state, ERROR_EXIT, LispPTR 14 | #include "lspglob.h" 15 | #include "lsptypes.h" 16 | #include "shiftdefs.h" // for N_OP_llsh1, N_OP_llsh8, N_OP_lrsh1, N_OP_lrsh8 17 | 18 | /* 19 | * XXX: it feels as though something is not clean here, looks like the 20 | * "int a" arguments are really LispPTR types, though perhaps it doesn't 21 | * matter. NBriggs, May 2017 -- Yes. Replaced. NBriggs, Aug 2022 22 | */ 23 | 24 | /************************************************************ 25 | N_OP_llsh1 26 | entry LLSH1 OPCODE[0340] 27 | return(a << 1) 28 | ************************************************************/ 29 | LispPTR N_OP_llsh1(LispPTR a) { 30 | int arg1; 31 | 32 | N_GETNUMBER(a, arg1, du_ufn); 33 | arg1 <<= 1; 34 | N_ARITH_SWITCH(arg1); 35 | 36 | du_ufn: 37 | ERROR_EXIT(a); 38 | } 39 | 40 | /************************************************************ 41 | N_OP_llsh8 42 | entry LLSH8 OPCODE[0341] 43 | return(a << 8) 44 | ************************************************************/ 45 | LispPTR N_OP_llsh8(LispPTR a) { 46 | int arg1; 47 | 48 | N_GETNUMBER(a, arg1, du_ufn); 49 | arg1 <<= 8; 50 | N_ARITH_SWITCH(arg1); 51 | 52 | du_ufn: 53 | ERROR_EXIT(a); 54 | } 55 | 56 | /************************************************************ 57 | N_OP_lrsh1 58 | entry LRSH1 OPCODE[0342] 59 | return(a >> 1) 60 | ************************************************************/ 61 | LispPTR N_OP_lrsh1(LispPTR a) { 62 | int arg1; 63 | 64 | N_GETNUMBER(a, arg1, du_ufn); 65 | arg1 = (unsigned)arg1 >> 1; 66 | N_ARITH_SWITCH(arg1); 67 | 68 | du_ufn: 69 | ERROR_EXIT(a); 70 | 71 | } 72 | 73 | /************************************************************ 74 | N_OP_lrsh8 75 | entry LRSH8 OPCODE[0343] 76 | return(a >> 8) 77 | ************************************************************/ 78 | LispPTR N_OP_lrsh8(LispPTR a) { 79 | int arg1; 80 | 81 | N_GETNUMBER(a, arg1, du_ufn); 82 | arg1 = (unsigned)arg1 >> 8; 83 | N_ARITH_SWITCH(arg1); 84 | 85 | du_ufn: 86 | ERROR_EXIT(a); 87 | } 88 | 89 | /************************************************************ 90 | N_OP_lsh 91 | entry LSH OPCODE[0347] 92 | return(a b) 93 | ************************************************************/ 94 | LispPTR N_OP_lsh(LispPTR a, LispPTR b) { 95 | int arg, arg2; 96 | int size; 97 | /*DLword *wordp;*/ 98 | 99 | N_GETNUMBER(b, size, do_ufn); 100 | N_GETNUMBER(a, arg2, do_ufn); 101 | 102 | if (size > 0) { 103 | if (size > 31) goto do_ufn; 104 | arg = arg2 << size; 105 | if ((arg >> size) != arg2) goto do_ufn; 106 | } else if (size < 0) { 107 | if (size < -31) goto do_ufn; 108 | arg = arg2 >> -size; 109 | /*** Commented out JDS 1/27/89: This punts if you shifted ***/ 110 | /*** ANY 1 bits off the right edge. You CAN'T overflow ***/ 111 | /*** in this direction!! ***/ 112 | /* if ((arg << -size) != arg2) goto do_ufn; */ 113 | } else 114 | return (a); 115 | 116 | N_ARITH_SWITCH(arg); 117 | 118 | do_ufn: 119 | ERROR_EXIT(b); 120 | } 121 | -------------------------------------------------------------------------------- /shiftdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef SHIFTDEFS_H 2 | #define SHIFTDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_llsh1(LispPTR a); 5 | LispPTR N_OP_llsh8(LispPTR a); 6 | LispPTR N_OP_lrsh1(LispPTR a); 7 | LispPTR N_OP_lrsh8(LispPTR a); 8 | LispPTR N_OP_lsh(LispPTR a, LispPTR b); 9 | #endif 10 | -------------------------------------------------------------------------------- /storagedefs.h: -------------------------------------------------------------------------------- 1 | #ifndef STORAGEDEFS_H 2 | #define STORAGEDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | void checkfor_storagefull(unsigned int npages); 5 | LispPTR newpage(LispPTR base); 6 | void init_storage(void); 7 | #endif 8 | -------------------------------------------------------------------------------- /stream.h: -------------------------------------------------------------------------------- 1 | #ifndef STREAM_H 2 | #define STREAM_H 1 3 | /* $Id: stream.h,v 1.2 1999/01/03 02:06:23 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /************************************************************************/ 6 | /* */ 7 | /* (C) Copyright 1989-92 Venue. All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | #include "version.h" /* for BIGVM */ 12 | #include "lispemul.h" /* for LispPTR, DLword, DLbyte */ 13 | 14 | #ifndef BYTESWAP 15 | /********************************/ 16 | /* Normal byte-order definition */ 17 | /********************************/ 18 | typedef struct stream{ 19 | DLword COFFSET; 20 | DLword CBUFSIZE; 21 | #ifndef BIGVM 22 | unsigned BINABLE :1; 23 | unsigned BOUTABLE :1; 24 | unsigned EXTENDABLE :1; 25 | unsigned CBUFDIRTY :1; 26 | unsigned PEEKEDCHARP :1; 27 | unsigned ACCESS :3; 28 | unsigned CBUFPTR :24; 29 | #else 30 | unsigned PEEKEDCHARP :1; 31 | unsigned ACCESS :3; 32 | unsigned CBUFPTR :28; 33 | #endif /* BIGVM */ 34 | DLbyte BYTESIZE; 35 | DLbyte CHARSET; 36 | DLword PEEKEDCHAR; 37 | DLword CHARPOSITION; 38 | DLword CBUFMAXSIZE; 39 | unsigned NONDEFAULTDATEFLG :1; 40 | unsigned REVALIDATEFLG :1; 41 | unsigned MULTIBUFFERHINT :1; 42 | unsigned USERCLOSEABLE :1; 43 | #ifndef BIGVM 44 | unsigned USERVISIBLE :1; 45 | unsigned EOLCONVENTION :2; 46 | unsigned NIL1 :1; 47 | unsigned FULLFILENAME :24; 48 | #else 49 | unsigned FULLFILENAME :28; 50 | #endif /* BIGVM */ 51 | #ifdef BIGVM 52 | unsigned BINABLE :1; 53 | unsigned BOUTABLE :1; 54 | unsigned EXTENDABLE :1; 55 | unsigned CBUFDIRTY :1; 56 | unsigned DEVICE: 28; 57 | #else 58 | LispPTR DEVICE; 59 | #endif /* BIGVM */ 60 | #ifdef BIGVM 61 | unsigned USERVISIBLE :1; 62 | unsigned EOLCONVENTION :2; 63 | unsigned NIL1 :1; 64 | unsigned VALIDATION: 28; 65 | #else 66 | LispPTR VALIDATION; 67 | #endif /* BIGVM */ 68 | LispPTR CPAGE; 69 | LispPTR EPAGE; 70 | DLword EOFFSET; 71 | DLword LINELENGTH; 72 | LispPTR F1; 73 | LispPTR F2; 74 | LispPTR F3; 75 | LispPTR F4; 76 | LispPTR F5; 77 | DLword FW6; 78 | DLword FW7; 79 | DLword FW8; 80 | DLword FW9; 81 | LispPTR F10; 82 | LispPTR STRMBINFN; 83 | LispPTR STRMBOUTFN; 84 | LispPTR OUTCHARFN; 85 | LispPTR ENDOFSTREAMOP; 86 | LispPTR OTHERPROPS; 87 | LispPTR IMAGEOPS; 88 | LispPTR IMAGEDATA; 89 | LispPTR BUFFS; 90 | DLword MAXBUFFERS; 91 | DLword NIL2; 92 | LispPTR EXTRASTREAMOP; 93 | }Stream; 94 | 95 | #else 96 | 97 | /***************************/ 98 | /* Byte-swapped definition */ 99 | /***************************/ 100 | typedef struct stream 101 | { 102 | DLword CBUFSIZE; 103 | DLword COFFSET; 104 | #ifndef BIGVM 105 | unsigned CBUFPTR :24; 106 | unsigned ACCESS :3; 107 | unsigned PEEKEDCHARP :1; 108 | unsigned CBUFDIRTY :1; 109 | unsigned EXTENDABLE :1; 110 | unsigned BOUTABLE :1; 111 | unsigned BINABLE :1; 112 | #else 113 | unsigned CBUFPTR :28; 114 | unsigned ACCESS :3; 115 | unsigned PEEKEDCHARP :1; 116 | #endif /* BIGVM */ 117 | DLword PEEKEDCHAR; 118 | DLbyte CHARSET; 119 | DLbyte BYTESIZE; 120 | DLword CBUFMAXSIZE; 121 | DLword CHARPOSITION; 122 | #ifdef BIGVM 123 | unsigned FULLFILENAME :28; 124 | #else 125 | unsigned FULLFILENAME :24; 126 | unsigned NIL1 :1; 127 | unsigned EOLCONVENTION :2; 128 | unsigned USERVISIBLE :1; 129 | #endif /* BIGVM */ 130 | unsigned USERCLOSEABLE :1; 131 | unsigned MULTIBUFFERHINT :1; 132 | unsigned REVALIDATEFLG :1; 133 | unsigned NONDEFAULTDATEFLG :1; 134 | #ifndef BIGVM 135 | LispPTR DEVICE; 136 | #else 137 | unsigned DEVICE: 28; 138 | unsigned CBUFDIRTY :1; 139 | unsigned EXTENDABLE :1; 140 | unsigned BOUTABLE :1; 141 | unsigned BINABLE :1; 142 | #endif /* BIGVM */ 143 | #ifndef BIGVM 144 | LispPTR VALIDATION; 145 | #else 146 | unsigned VALIDATION: 28; 147 | unsigned NIL1 :1; 148 | unsigned EOLCONVENTION :2; 149 | unsigned USERVISIBLE :1; 150 | #endif /* BIGVM */ 151 | LispPTR CPAGE; 152 | LispPTR EPAGE; 153 | DLword LINELENGTH; 154 | DLword EOFFSET; 155 | LispPTR F1; 156 | LispPTR F2; 157 | LispPTR F3; 158 | LispPTR F4; 159 | LispPTR F5; 160 | DLword FW7; 161 | DLword FW6; 162 | DLword FW9; 163 | DLword FW8; 164 | LispPTR F10; 165 | LispPTR STRMBINFN; 166 | LispPTR STRMBOUTFN; 167 | LispPTR OUTCHARFN; 168 | LispPTR ENDOFSTREAMOP; 169 | LispPTR OTHERPROPS; 170 | LispPTR IMAGEOPS; 171 | LispPTR IMAGEDATA; 172 | LispPTR BUFFS; 173 | DLword NIL2; 174 | DLword MAXBUFFERS; 175 | LispPTR EXTRASTREAMOP; 176 | }Stream; 177 | 178 | #endif /* BYTESWAP */ 179 | 180 | #endif /* STREAM_H */ 181 | -------------------------------------------------------------------------------- /subr0374.c: -------------------------------------------------------------------------------- 1 | /* $Id: subr0374.c,v 1.3 1999/05/31 23:35:43 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | /* 14 | * This doesn't appear to be used anywhere. 15 | * Adjusted result to be LispPTR and return value to NIL instead of 16 | * being an int/return 0. 17 | * 18 | * NBriggs, May 2017 19 | */ 20 | 21 | /********************************************************/ 22 | /* 23 | subr_k_trace() 24 | 25 | subr----0130 for maiko trace 26 | first argument is base address of 27 | error message in Lisp. 28 | second argument is length of message. 29 | */ 30 | /********************************************************/ 31 | 32 | #include 33 | #include "lispemul.h" 34 | #include "adr68k.h" 35 | #include "lspglob.h" 36 | 37 | #include "subr0374defs.h" 38 | 39 | LispPTR subr_k_trace(LispPTR *args) { 40 | int len; 41 | char *base; 42 | 43 | len = 0xFFFF & args[1]; 44 | base = (char *)NativeAligned2FromLAddr(args[0]); 45 | while (len-- > 0) putc(*base++, stderr); 46 | putc('\n', stderr); 47 | return (NIL); 48 | } 49 | -------------------------------------------------------------------------------- /subr0374defs.h: -------------------------------------------------------------------------------- 1 | #ifndef SUBR0374DEFS_H 2 | #define SUBR0374DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR subr_k_trace(LispPTR *args); 5 | #endif 6 | -------------------------------------------------------------------------------- /subrdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef SUBRDEFS_H 2 | #define SUBRDEFS_H 1 3 | void OP_subrcall(int subr_no, int argnum); 4 | #endif 5 | -------------------------------------------------------------------------------- /sxhashdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef SXHASHDEFS_H 2 | #define SXHASHDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR SX_hash(LispPTR object); 5 | LispPTR STRING_EQUAL_HASHBITS(LispPTR object); 6 | LispPTR STRING_HASHBITS(LispPTR object); 7 | #endif 8 | -------------------------------------------------------------------------------- /testtooldefs.h: -------------------------------------------------------------------------------- 1 | #ifndef TESTTOOLDEFS_H 2 | #define TESTTOOLDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword, DLbyte */ 4 | #include "cell.h" /* for conspage */ 5 | #include "stack.h" /* for frameex1, FX, Bframe, fnhead */ 6 | void print_package_name(int index); 7 | void print_atomname(LispPTR index); 8 | int find_package_from_name(const char *packname, int len); 9 | void print_package_name(int index); 10 | void dump_dtd(void); 11 | void check_type_68k(int type, LispPTR *ptr); 12 | int type_num(LispPTR lispptr); 13 | void dump_conspage(struct conspage *base, int linking); 14 | void trace_listpDTD(void); 15 | void a68k(LispPTR lispptr); 16 | void laddr(DLword *addr68k); 17 | void dump_fnbody(LispPTR fnblockaddr); 18 | void dump_fnobj(LispPTR index); 19 | int print_opcode(int pc, DLbyte *addr, struct fnhead *fnobj); 20 | void doko(void); 21 | void dumpl(LispPTR laddr); 22 | void dumps(LispPTR laddr); 23 | void printPC(void); 24 | void dump_bf(Bframe *bf); 25 | void dump_fx(struct frameex1 *fx_addr68k); 26 | void dump_stackframe(struct frameex1 *fx_addr68k); 27 | void dump_CSTK(int before); 28 | int get_framename(struct frameex1 *fx_addr68k); 29 | LispPTR MAKEATOM(char *string); 30 | LispPTR *MakeAtom68k(char *string); 31 | void GETTOPVAL(char *string); 32 | void all_stack_dump(DLword start, DLword end, DLword silent); 33 | void dtd_chain(DLword type); 34 | void check_dtd_chain(DLword type); 35 | void Trace_FNCall(int numargs, int atomindex, int arg1, LispPTR *tos); 36 | void Trace_APPLY(int atomindex); 37 | #endif 38 | -------------------------------------------------------------------------------- /timeout.h: -------------------------------------------------------------------------------- 1 | #ifndef TIMEOUT_H 2 | #define TIMEOUT_H 1 3 | /* $Id: timeout.h,v 1.2 1999/01/03 02:06:27 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | /************************************************************************/ 6 | /* */ 7 | /* (C) Copyright 1989-98 Venue. All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | #include /* for jmp_buf */ 12 | 13 | extern jmp_buf jmpbuf; 14 | 15 | /*** TIMEOUT_TIME is changeable by UNIX env var LDEFILETIMEOUT. 16 | #define TIMEOUT_TIME 10 **/ 17 | 18 | extern unsigned int TIMEOUT_TIME; 19 | 20 | #define SETJMP(x) \ 21 | do { \ 22 | if(setjmp(jmpbuf) != 0) return(x); \ 23 | } while (0) 24 | 25 | #define TIMEOUT(exp) \ 26 | do { \ 27 | alarm(TIMEOUT_TIME); \ 28 | INTRSAFE(exp); \ 29 | alarm(0); \ 30 | } while (0) 31 | 32 | #define TIMEOUT0(exp) \ 33 | do { \ 34 | alarm(TIMEOUT_TIME); \ 35 | INTRSAFE0(exp); \ 36 | alarm(0); \ 37 | } while (0) 38 | 39 | #define S_TOUT(exp) \ 40 | alarm(TIMEOUT_TIME), \ 41 | (exp), \ 42 | alarm(0) 43 | 44 | #define ERRSETJMP(rval) \ 45 | do { \ 46 | if(setjmp(jmpbuf) != 0) \ 47 | { \ 48 | *Lisp_errno = 100; \ 49 | return(rval); \ 50 | } \ 51 | } while (0) 52 | 53 | 54 | /************************************************************************/ 55 | /* */ 56 | /* INTRSAFE */ 57 | /* */ 58 | /* Put a check for EINTR around a system call, and keep executing */ 59 | /* the call until we don't get that error any more. */ 60 | /* */ 61 | /************************************************************************/ 62 | 63 | #define INTRSAFE(exp) \ 64 | do {errno = 0; } while ((exp) == -1 && errno == EINTR) 65 | 66 | #define INTRSAFE0(exp) \ 67 | do {errno = 0; } while ((exp) == NULL && errno == EINTR) 68 | #endif /* TIMEOUT_H */ 69 | -------------------------------------------------------------------------------- /timerdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef TIMERDEFS_H 2 | #define TIMERDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | void update_miscstats(void); 5 | void init_miscstats(void); 6 | LispPTR subr_gettime(LispPTR args[]); 7 | void subr_settime(LispPTR args[]); 8 | void subr_copytimestats(LispPTR args[]); 9 | LispPTR N_OP_rclk(LispPTR tos); 10 | void update_timer(void); 11 | void int_io_open(int fd); 12 | void int_io_close(int fd); 13 | void int_block(void); 14 | void int_unblock(void); 15 | void int_init(void); 16 | #endif 17 | -------------------------------------------------------------------------------- /tos1defs.h: -------------------------------------------------------------------------------- 1 | #ifndef TOS1DEFS_H 2 | #define TOS1DEFS_H 1 3 | /* $Id: tos1defs.h,v 1.2 1999/01/03 02:06:27 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 4 | */ 5 | 6 | /************************************************************************/ 7 | /* */ 8 | /* (C) Copyright 1989-92 Venue. All Rights Reserved. */ 9 | /* Manufactured in the United States of America. */ 10 | /* */ 11 | /************************************************************************/ 12 | 13 | /************************************************************************/ 14 | /* */ 15 | /* T O P - O F - S T A C K D E F I N I T I O N S */ 16 | /* */ 17 | /* TOPOFSTACK cached top of stack value. */ 18 | /* CSTKPTR points to where TOPOFSTACK should be stored. */ 19 | /* */ 20 | /************************************************************************/ 21 | 22 | #ifndef BYTESWAP 23 | /********************************************************/ 24 | /* Normal byte-order definitions, for e.g., 68020s */ 25 | /********************************************************/ 26 | 27 | /* These are the TOS manipulation Macros */ 28 | 29 | #define HARD_PUSH(x) *(CSTKPTRL++) = x 30 | #define PUSH(x) \ 31 | do { \ 32 | HARD_PUSH(TOPOFSTACK); \ 33 | TOPOFSTACK = x; \ 34 | } while (0) 35 | #define POP TOPOFSTACK = *(--CSTKPTRL) 36 | #define GET_TOS_1 *(CSTKPTR - 1) 37 | #define GET_TOS_2 *(CSTKPTR - 2) 38 | #define GET_POPPED *CSTKPTR 39 | #define POP_TOS_1 *(--CSTKPTRL) 40 | #define TOPOFSTACK tscache 41 | #define GET_TOS_1_HI *((DLword *)(CSTKPTR - 1)) 42 | #define GET_TOS_1_LO *((DLword *)(CSTKPTR - 1) + 1) 43 | 44 | #else 45 | 46 | /********************************************************/ 47 | /* Byte-swapped definitions, for e.g., 80386s */ 48 | /********************************************************/ 49 | 50 | /* These are the TOS manipulation Macros */ 51 | 52 | #define HARD_PUSH(x) *(CSTKPTRL++) = x 53 | #define PUSH(x) \ 54 | do { \ 55 | HARD_PUSH(TOPOFSTACK); \ 56 | TOPOFSTACK = x; \ 57 | } while (0) 58 | #define POP TOPOFSTACK = *(--CSTKPTRL) 59 | #define GET_TOS_1 *(CSTKPTR - 1) 60 | #define GET_TOS_2 *(CSTKPTR - 2) 61 | #define GET_POPPED *CSTKPTR 62 | #define POP_TOS_1 *(--CSTKPTRL) 63 | #define TOPOFSTACK tscache 64 | #define GET_TOS_1_HI GETWORD((DLword *)(CSTKPTR - 1)) 65 | #define GET_TOS_1_LO GETWORD((DLword *)(CSTKPTR - 1) + 1) 66 | 67 | #endif /* BYTESWAP */ 68 | 69 | /* OPCODE interface routines */ 70 | 71 | #define StackPtrSave \ 72 | do { CurrentStackPTR = (DLword *)(CSTKPTR - 1); /* CSTKPTR in cells */ } while (0) 73 | #define StackPtrRestore \ 74 | do { CSTKPTRL = (LispPTR *)(CurrentStackPTR + 2); /* CurrentStackPTR in DLwords */ } while (0) 75 | 76 | #define EXT \ 77 | do { \ 78 | PC = pccache - 1; \ 79 | TopOfStack = TOPOFSTACK; \ 80 | StackPtrSave; \ 81 | } while (0) 82 | 83 | #define RET \ 84 | do { \ 85 | pccache = PC + 1; \ 86 | StackPtrRestore; \ 87 | TOPOFSTACK = TopOfStack; \ 88 | } while (0) 89 | 90 | #define NRET \ 91 | do { \ 92 | RET; \ 93 | nextop0; \ 94 | } while (0) 95 | 96 | #endif /* TOS1DEFS_H */ 97 | -------------------------------------------------------------------------------- /tosret.h: -------------------------------------------------------------------------------- 1 | #ifndef TOSRET_H 2 | #define TOSRET_H 1 3 | /* $Id: tosret.h,v 1.2 1999/01/03 02:06:28 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | 7 | 8 | /************************************************************************/ 9 | /* */ 10 | /* (C) Copyright 1989, 1990, 1998 Venue. All Rights Reserved. */ 11 | /* Manufactured in the United States of America. */ 12 | /* */ 13 | /************************************************************************/ 14 | 15 | #include "kprintdefs.h" // for prindatum 16 | 17 | /************************************************************************/ 18 | /* */ 19 | /* t o s r e t m a c r o . h */ 20 | /* */ 21 | /* Implements RETURN for the inner evaluation loop. */ 22 | /* */ 23 | /************************************************************************/ 24 | 25 | #define OPRETURN { \ 26 | struct frameex2 *returnFX ; \ 27 | int alink; \ 28 | FNCHECKER(struct frameex2 *old_bce_fx = (struct frameex2 *) BCE_CURRENTFX); \ 29 | alink = ((struct frameex2 *) BCE_CURRENTFX)->alink; \ 30 | FNTPRINT(("RETURN = 0x%x, ", TOPOFSTACK)); \ 31 | FNTRACER(prindatum(TOPOFSTACK); printf("\n"); fflush(stdout);) \ 32 | if (alink & 1) { EXT; if(slowreturn()) goto stackoverflow_help; RET; \ 33 | Irq_Stk_Check = STK_END_COMPUTE(EndSTKP,FuncObj); \ 34 | if (((UNSIGNED)(CSTKPTR) >= Irq_Stk_Check) || (Irq_Stk_End <= 0)) \ 35 | { goto check_interrupt; } \ 36 | Irq_Stk_End = (UNSIGNED) EndSTKP; \ 37 | goto retxit; \ 38 | }; \ 39 | CSTKPTRL = (LispPTR *) IVAR; \ 40 | returnFX = (struct frameex2 *) \ 41 | ((DLword *) \ 42 | (PVARL = (DLword *) NativeAligned2FromStackOffset(alink)) \ 43 | - FRAMESIZE); \ 44 | IVARL = (DLword *) \ 45 | NativeAligned2FromStackOffset(GETWORD((DLword *)returnFX -1));\ 46 | /* Get PC from Returnee's pc slot in FX */ \ 47 | PCMACL = returnFX->pc + (ByteCode *) \ 48 | (FuncObj = (struct fnhead *) \ 49 | NativeAligned4FromLAddr(SWAP_FNHEAD(returnFX->fnheader) & POINTERMASK)) + 1;\ 50 | Irq_Stk_Check = STK_END_COMPUTE(EndSTKP,FuncObj); \ 51 | FNCHECKER(if (quick_stack_check()) printf("In RETURN.\n")); \ 52 | if (((UNSIGNED)(CSTKPTR) >= Irq_Stk_Check) || (Irq_Stk_End <= 0)) \ 53 | { goto check_interrupt; } \ 54 | Irq_Stk_End = (UNSIGNED) EndSTKP; \ 55 | retxit: {} \ 56 | } /* OPRETURN end */ 57 | 58 | #endif /* TOSRET_H */ 59 | -------------------------------------------------------------------------------- /typeof.c: -------------------------------------------------------------------------------- 1 | /* $Id: typeof.c,v 1.3 1999/05/31 23:35:44 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | /****************************************************************/ 14 | /* LISTP(3Q),NTYPEX(4Q),TYPEP(5Q),DTEST(6Q) ,INSTANCEP(303Q) */ 15 | /****************************************************************/ 16 | /* 17 | changed : Jan. 13 1987 take 18 | changed : Feb. 05 1987 take 19 | changed : Jul. 24 1987 take 20 | 21 | */ 22 | 23 | #include "lispemul.h" // for LispPTR, ATOM_T, NIL_PTR 24 | #include "lspglob.h" 25 | #include "lsptypes.h" // for dtd, GetDTD, GetTypeNumber 26 | #include "typeofdefs.h" // for N_OP_instancep 27 | 28 | /************************************************************************/ 29 | /* */ 30 | /* N _ O P _ i n s t a n c e p */ 31 | /* */ 32 | /* Returns T if tos has type named by atom_index, else NIL. */ 33 | /* */ 34 | /************************************************************************/ 35 | 36 | LispPTR N_OP_instancep(LispPTR tos, int atom_index) { 37 | struct dtd *dtd68k; 38 | 39 | for (dtd68k = (struct dtd *)GetDTD(GetTypeNumber(tos)); 40 | #ifdef BIGVM 41 | atom_index != dtd68k->dtd_name; 42 | #else 43 | atom_index != dtd68k->dtd_namelo + (dtd68k->dtd_namehi << 16); 44 | #endif /* BIGVM */ 45 | dtd68k = (struct dtd *)GetDTD(dtd68k->dtd_supertype)) { 46 | if (dtd68k->dtd_supertype == 0) { return (NIL_PTR); } 47 | } 48 | return (ATOM_T); 49 | 50 | } /* N_OP_instancep END */ 51 | -------------------------------------------------------------------------------- /typeofdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef TYPEOFDEFS_H 2 | #define TYPEOFDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_dtest(LispPTR tos, int atom_index); 5 | LispPTR N_OP_instancep(LispPTR tos, int atom_index); 6 | #endif 7 | -------------------------------------------------------------------------------- /ubf1.c: -------------------------------------------------------------------------------- 1 | /* $Id: ubf1.c,v 1.3 1999/05/31 23:35:44 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | #include "adr68k.h" // for LAddrFromNative 13 | #include "arith.h" // for N_ARITH_SWITCH 14 | #include "lispemul.h" // for state, ERROR_EXIT, DLword, LispPTR 15 | #include "lspglob.h" 16 | #include "lsptypes.h" // for TYPE_FLOATP 17 | #include "mkcelldefs.h" // for createcell68k 18 | #include "my.h" // for N_MakeFloat 19 | #include "ubf1defs.h" // for N_OP_ubfloat1 20 | 21 | /************************************************************ 22 | OP_ubfloat1 -- op 355 == UBFLOAT1 23 | 355/0 BOX 24 | 355/1 UNBOX 25 | 355/2 ABS 26 | 355/3 NEGATE 27 | 355/4 UFIX 28 | ***********************************************************/ 29 | 30 | LispPTR N_OP_ubfloat1(LispPTR arg, int alpha) { 31 | switch (alpha) { 32 | case 0: /* box */ 33 | { 34 | LispPTR *wordp; 35 | wordp = (LispPTR *)createcell68k(TYPE_FLOATP); 36 | *wordp = arg; 37 | return (LAddrFromNative(wordp)); 38 | } 39 | case 1: /* unbox */ 40 | { 41 | float dest; 42 | LispPTR ret; 43 | N_MakeFloat(arg, dest, arg); 44 | ret = *(LispPTR *)&dest; 45 | return (ret); 46 | } 47 | case 2: /* abs */ return (0x7FFFFFFF & arg); 48 | case 3: /* neg */ return (0x80000000 ^ arg); 49 | case 4: /* ufix */ 50 | { 51 | float temp; 52 | int val; 53 | temp = *(float *)&arg; 54 | if ((temp > ((float)0x7fffffff)) || (temp < ((float)0x80000000))) ERROR_EXIT(arg); 55 | val = (int)temp; 56 | N_ARITH_SWITCH(val); 57 | } 58 | default: ERROR_EXIT(arg); 59 | } /* end switch */ 60 | } /* end N_OP_ubfloat1() */ 61 | 62 | /* end module */ 63 | -------------------------------------------------------------------------------- /ubf1defs.h: -------------------------------------------------------------------------------- 1 | #ifndef UBF1DEFS_H 2 | #define UBF1DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_ubfloat1(LispPTR arg, int alpha); 5 | #endif 6 | -------------------------------------------------------------------------------- /ubf2.c: -------------------------------------------------------------------------------- 1 | /* $Id: ubf2.c,v 1.3 1999/05/31 23:35:44 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | /* ubf2.c 3 | */ 4 | 5 | /************************************************************************/ 6 | /* */ 7 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | 12 | #include "version.h" 13 | 14 | #include // for fmodf 15 | #include "lispemul.h" // for state, ERROR_EXIT, ATOM_T, LispPTR, NIL_PTR 16 | #include "medleyfp.h" // for FPCLEAR, FPTEST 17 | #include "ubf2defs.h" // for N_OP_ubfloat2 18 | 19 | /************************************************************ 20 | OP_ub2 -- op 354 == UBFLOAT2 21 | 354/0 ADD 22 | 354/1 SUB 23 | 354/2 ISUB 24 | 354/3 MULT 25 | 354/4 DIV 26 | 354/5 GREAT 27 | 354/6 MAX 28 | 354/7 MIN 29 | 354/8 REM 30 | 354/9 AREF 31 | ***********************************************************/ 32 | LispPTR N_OP_ubfloat2(int a2, int a1, int alpha) { 33 | float arg1, arg2; 34 | float ans; 35 | int ret; 36 | 37 | /* Unboxed floating point args (a1, a2) look like float, but */ 38 | /* can't be declared as such because all float args get passed */ 39 | /* as double. (That can be avoided in ansi C.) Instead, they */ 40 | /* are declared int and accessed as float through cast pointers. */ 41 | /* The return value is handled similarly. */ 42 | 43 | arg1 = *(float *)&a1; 44 | arg2 = *(float *)&a2; 45 | FPCLEAR; 46 | switch (alpha) { 47 | case 0: /* add */ ans = arg1 + arg2; break; 48 | case 1: /* sub */ ans = arg2 - arg1; break; 49 | case 2: /* isub */ ans = arg1 - arg2; break; 50 | case 3: /* mul */ ans = arg1 * arg2; break; 51 | case 4: /* div */ ans = arg2 / arg1; break; 52 | case 5: /* gt */ 53 | if (arg2 > arg1) 54 | return (ATOM_T); 55 | else 56 | return (NIL_PTR); 57 | case 6: /* max */ 58 | if (arg2 > arg1) 59 | return (a2); 60 | else 61 | return (a1); 62 | case 7: /* min */ 63 | if (arg2 > arg1) 64 | return (a1); 65 | else 66 | return (a2); 67 | case 8: /* rem */ ans = fmodf(arg2, arg1); break; 68 | default: ERROR_EXIT(a1); 69 | } /* end switch */ 70 | 71 | ret = *(int *)&ans; /* Convert it back to int for 32 bit storage */ 72 | if (FPTEST(ans)) ERROR_EXIT(a1); 73 | return (ret); 74 | 75 | } /* end N_OP_ub2() */ 76 | 77 | /* end module */ 78 | -------------------------------------------------------------------------------- /ubf2defs.h: -------------------------------------------------------------------------------- 1 | #ifndef UBF2DEFS_H 2 | #define UBF2DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_ubfloat2(int a2, int a1, int alpha); 5 | #endif 6 | -------------------------------------------------------------------------------- /ubf3.c: -------------------------------------------------------------------------------- 1 | /* $Id: ubf3.c,v 1.3 1999/05/31 23:35:45 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | /* ubf3.c 3 | */ 4 | 5 | /************************************************************************/ 6 | /* */ 7 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 8 | /* Manufactured in the United States of America. */ 9 | /* */ 10 | /************************************************************************/ 11 | 12 | #include "version.h" 13 | 14 | #include "adr68k.h" // for NativeAligned4FromLAddr 15 | #include "lispemul.h" // for state, ERROR_EXIT, LispPTR, SEGMASK 16 | #include "lispmap.h" // for S_POSITIVE 17 | #include "lspglob.h" 18 | #include "medleyfp.h" // for FPCLEAR, FPTEST 19 | #include "ubf3defs.h" // for N_OP_ubfloat3 20 | 21 | /************************************************************ 22 | N_OP_ubfloat3 -- op 062 23 | 062/0 POLY 24 | ***********************************************************/ 25 | 26 | LispPTR N_OP_ubfloat3(int arg3, LispPTR arg2, LispPTR arg1, int alpha) { 27 | float val; 28 | float ans; 29 | float *fptr; 30 | int degree; 31 | int ret; 32 | float flot; 33 | 34 | val = *(float *)&arg3; /* why? */ 35 | if (alpha) ERROR_EXIT(arg1); 36 | FPCLEAR; 37 | if ((arg1 & SEGMASK) != S_POSITIVE) ERROR_EXIT(arg1); 38 | degree = 0xFFFF & arg1; 39 | fptr = (float *)NativeAligned4FromLAddr(arg2); 40 | ans = *((float *)fptr); 41 | while (degree--) ans = (ans * val) + *((float *)(++fptr)); 42 | if (FPTEST(ans)) ERROR_EXIT(arg1); /* relies on contagion of inf, nan? */ 43 | flot = ans; 44 | ret = *(int *)&flot; /* why? */ 45 | return (ret); 46 | } /* end N_OP_ubfloat3() */ 47 | 48 | /* end module */ 49 | -------------------------------------------------------------------------------- /ubf3defs.h: -------------------------------------------------------------------------------- 1 | #ifndef UBF3DEFS_H 2 | #define UBF3DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_ubfloat3(int arg3, LispPTR arg2, LispPTR arg1, int alpha); 5 | #endif 6 | -------------------------------------------------------------------------------- /ufsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef UFSDEFS_H 2 | #define UFSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR UFS_getfilename(LispPTR *args); 5 | LispPTR UFS_deletefile(LispPTR *args); 6 | LispPTR UFS_renamefile(LispPTR *args); 7 | LispPTR UFS_directorynamep(LispPTR *args); 8 | int unixpathname(char *src, char *dst, int versionp, int genp); 9 | int lisppathname(char *fullname, char *lispname, int dirp, int versionp); 10 | int quote_fname(char *file); 11 | int quote_fname_ufs(char *file); 12 | int quote_dname(char *dir); 13 | #endif 14 | -------------------------------------------------------------------------------- /unwinddefs.h: -------------------------------------------------------------------------------- 1 | #ifndef UNWINDDEFS_H 2 | #define UNWINDDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR *N_OP_unwind(LispPTR *cstkptr, LispPTR tos, int n, int keep); 5 | #endif 6 | -------------------------------------------------------------------------------- /usrsubr.c: -------------------------------------------------------------------------------- 1 | /* $Id: usrsubr.c,v 1.3 1999/05/31 23:35:46 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved 2 | */ 3 | 4 | /************************************************************************/ 5 | /* */ 6 | /* (C) Copyright 1989-95 Venue. All Rights Reserved. */ 7 | /* Manufactured in the United States of America. */ 8 | /* */ 9 | /************************************************************************/ 10 | 11 | #include "version.h" 12 | 13 | #include 14 | 15 | #include "usrsubrdefs.h" 16 | 17 | /** User defined subrs here. Do NOT attempt to use this unless you FULLY 18 | understand the dependencies of the LDE architecture. **/ 19 | 20 | int UserSubr(int user_subr_index, int num_args, unsigned *args) { 21 | int result = 0; 22 | 23 | /* *** remove the printf when finished debugging your user subr *** */ 24 | 25 | printf("debug: case: 0x%x, args: 0x%x\n", user_subr_index, num_args); 26 | { 27 | int i; 28 | for (i = 0; i < num_args; i++) printf("debug: arg[%d]: 0x%x\n", i, args[i]); 29 | } 30 | 31 | switch (user_subr_index) { 32 | case 0: 33 | printf("sample UFN\n"); 34 | result = args[0]; 35 | break; 36 | default: 37 | return (-1); /* DO UFN */ 38 | } 39 | 40 | return (result); 41 | } 42 | -------------------------------------------------------------------------------- /usrsubrdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef USRSUBRDEFS_H 2 | #define USRSUBRDEFS_H 1 3 | int UserSubr(int user_subr_index, int num_args, unsigned *args); 4 | #endif 5 | -------------------------------------------------------------------------------- /uutilsdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef UUTILSDEFS_H 2 | #define UUTILSDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR check_unix_password(LispPTR *args); 5 | LispPTR unix_username(LispPTR *args); 6 | LispPTR unix_getparm(LispPTR *args); 7 | LispPTR unix_getenv(LispPTR *args); 8 | LispPTR unix_fullname(LispPTR *args); 9 | LispPTR suspend_lisp(LispPTR *args); 10 | #endif 11 | -------------------------------------------------------------------------------- /vars3.c: -------------------------------------------------------------------------------- 1 | /* $Id: vars3.c,v 1.4 2001/12/24 01:09:07 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 2 | 3 | /************************************************************************/ 4 | /* */ 5 | /* (C) Copyright 1989-99 Venue. All Rights Reserved. */ 6 | /* Manufactured in the United States of America. */ 7 | /* */ 8 | /************************************************************************/ 9 | 10 | #include "version.h" 11 | 12 | #include "adr68k.h" // for NativeAligned4FromLAddr 13 | #include "car-cdrdefs.h" // for car, cdr 14 | #include "cell.h" // for cadr_cell, CDR_NIL, CDR_INDIRECT, S_N_CHECK... 15 | #include "lispemul.h" // for state, ConsCell, LispPTR, NIL_PTR, DLword 16 | #include "lispmap.h" // for S_POSITIVE 17 | #include "lspglob.h" // for Stackspace 18 | #include "lsptypes.h" // for Listp 19 | #include "stack.h" // for frameex1 20 | #include "vars3defs.h" // for N_OP_arg0, N_OP_assoc, cadr 21 | 22 | /******************************************* 23 | cadr 24 | 25 | common routine. 26 | used by OP_assoc, OP_fmemb 27 | 28 | 29 | *******************************************/ 30 | struct cadr_cell cadr(LispPTR cell_adr) 31 | /* address of cell */ 32 | /* Lisp address (word addressing) */ 33 | { 34 | ConsCell *pcons; 35 | struct cadr_cell cadr1; /* return value */ 36 | short offset; 37 | 38 | if (Listp(cell_adr) == NIL) { 39 | if (cell_adr == NIL) { 40 | cadr1.car_cell = 0; 41 | cadr1.cdr_cell = 0; 42 | return (cadr1); 43 | } else { 44 | cadr1.car_cell = car(cell_adr); 45 | cadr1.cdr_cell = cdr(cell_adr); 46 | return (cadr1); 47 | } 48 | } 49 | pcons = (ConsCell *)NativeAligned4FromLAddr(cell_adr); 50 | while (pcons->cdr_code == CDR_INDIRECT) { 51 | /* CDR indirect */ 52 | cell_adr = pcons->car_field; 53 | pcons = (ConsCell *)NativeAligned4FromLAddr(pcons->car_field); 54 | } /* skip CDR_INDIRECT cell */ 55 | 56 | cadr1.car_cell = pcons->car_field; 57 | 58 | if (pcons->cdr_code == CDR_NIL) { 59 | /* CDR nil */ 60 | cadr1.cdr_cell = NIL_PTR; 61 | return (cadr1); 62 | } 63 | #ifdef NEWCDRCODING 64 | offset = (0x7 & pcons->cdr_code) << 1; 65 | if (pcons->cdr_code > CDR_NIL) { 66 | /* CDR on page */ 67 | cadr1.cdr_cell = cell_adr + offset; 68 | } else { 69 | /* CDR different page */ 70 | pcons = (ConsCell *)NativeAligned4FromLAddr((cell_adr) + offset); 71 | cadr1.cdr_cell = pcons->car_field; 72 | } 73 | #else 74 | offset = (0x7F & pcons->cdr_code) << 1; 75 | if (pcons->cdr_code > CDR_NIL) { 76 | /* CDR on page */ 77 | cadr1.cdr_cell = (mPAGEMASK & cell_adr) | offset; 78 | } else { 79 | /* CDR different page */ 80 | pcons = (ConsCell *)NativeAligned4FromLAddr(((mPAGEMASK & cell_adr) | offset)); 81 | cadr1.cdr_cell = pcons->car_field; 82 | } 83 | #endif /* NEWCDRCODING */ 84 | 85 | return (cadr1); 86 | } 87 | 88 | /*********************************************************** 89 | N_OP_arg0 90 | 91 | Entry: ARG0 opcode[0141] 92 | 93 | 94 | TopOfStack : slot number of IVAR area 95 | 96 | return : the contents of the slot. 97 | 98 | No effect to CurrentStack. 99 | 100 | 101 | ************************************************************/ 102 | 103 | LispPTR N_OP_arg0(LispPTR tos) { 104 | int num; 105 | DLword *bf; /* index of Basic frame */ 106 | int nargs; 107 | 108 | if ((SEGMASK & tos) != S_POSITIVE) { 109 | /* error("OP_arg0: Bad TopOfStack\n"); */ 110 | ERROR_EXIT(tos); 111 | } else 112 | num = 0xFFFF & tos; 113 | if (CURRENTFX->alink & 0x1) { 114 | /* slow */ 115 | bf = Stackspace + CURRENTFX->blink; 116 | } else { 117 | /* fast */ 118 | bf = ((DLword *)CURRENTFX) - BFSIZE; 119 | /* bf : pointer to 1st word of BasicFramePointer */ 120 | } 121 | nargs = ((UNSIGNED)bf - (UNSIGNED)IVar) >> 2; 122 | /* nargs : number of IVAR slots */ 123 | if ((num == 0) || (num > nargs)) { 124 | /* error("OP_arg0: Bad argument number\n"); */ 125 | ERROR_EXIT(tos); 126 | } 127 | return (*((int *)IVar + num - 1)); 128 | } 129 | 130 | /******************************************* 131 | N_OP_assoc 132 | 133 | Entry: ASSOC opcode[026] 134 | 135 | TopOfStack -- A-list (cons cell of Lisp address) 136 | *(int *)(CurrentStackPTR) -- Key (cons cell of Lisp address) 137 | 138 | 139 | 140 | *******************************************/ 141 | 142 | LispPTR N_OP_assoc(LispPTR key, LispPTR list) { 143 | struct cadr_cell cadr1; 144 | LispPTR cdr; /* address of (cdr A-list); Lisp address */ 145 | 146 | if (list == NIL_PTR) { return (NIL_PTR); } 147 | 148 | if (!Listp(list)) { return (NIL_PTR); } 149 | 150 | S_N_CHECKANDCADR(list, cadr1, list); 151 | 152 | do { 153 | cdr = cadr1.cdr_cell; /* the rest of A-list */ 154 | if (Listp(cadr1.car_cell) && key == car(cadr1.car_cell)) { 155 | /* cons data found */ 156 | return (cadr1.car_cell); 157 | } 158 | /* search the rest of A-list */ 159 | if (Listp(cdr)) 160 | cadr1 = cadr(cdr); 161 | else 162 | cdr = NIL; 163 | /* check for interrupts and punt to handle one safely */ 164 | if (!Irq_Stk_End) { 165 | TopOfStack = cdr; /* for next execution */ 166 | TIMER_EXIT(cdr); 167 | } 168 | } while (cdr != NIL_PTR); 169 | 170 | return (NIL_PTR); 171 | } 172 | -------------------------------------------------------------------------------- /vars3defs.h: -------------------------------------------------------------------------------- 1 | #ifndef VARS3DEFS_H 2 | #define VARS3DEFS_H 1 3 | #include "cell.h" /* for cadr_cell */ 4 | #include "lispemul.h" /* for LispPTR */ 5 | struct cadr_cell cadr(LispPTR cell_adr); 6 | LispPTR N_OP_arg0(LispPTR tos); 7 | LispPTR N_OP_assoc(LispPTR key, LispPTR list); 8 | #endif 9 | -------------------------------------------------------------------------------- /vmem_alloc.c: -------------------------------------------------------------------------------- 1 | #include "version.h" 2 | 3 | #ifdef _WIN32 4 | 5 | #include 6 | 7 | void* vmem_alloc(long size) 8 | { 9 | return VirtualAlloc( 10 | NULL, // Let the system choose the starting address 11 | size, // Size of the allocation 12 | MEM_RESERVE | MEM_COMMIT, // Reserve and commit the memory 13 | PAGE_READWRITE // Set initial protection to read/write 14 | ); 15 | } 16 | 17 | #else 18 | 19 | // UNIX 20 | #include // for mmap, MAP_FAILED 21 | #ifndef MAP_FAILED 22 | #define MAP_FAILED ((void *)-1) 23 | #endif 24 | #ifndef MAP_ANONYMOUS 25 | # define MAP_ANONYMOUS 0x20 /* Don't use a file. */ 26 | #endif 27 | 28 | 29 | void* vmem_alloc(long size) 30 | { 31 | void* res = mmap(0, size, PROT_READ|PROT_WRITE, MAP_ANONYMOUS | MAP_PRIVATE, -1, 0); 32 | if (res == MAP_FAILED) 33 | return 0; 34 | else 35 | return res; 36 | } 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /vmemsave.h: -------------------------------------------------------------------------------- 1 | #ifndef VMEMSAVE_H 2 | #define VMEMSAVE_H 1 3 | /* $Id: vmemsave.h,v 1.2 1999/01/03 02:06:29 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */ 4 | 5 | 6 | 7 | /************************************************************************/ 8 | /* */ 9 | /* (C) Copyright 1989-96 Venue. All Rights Reserved. */ 10 | /* Manufactured in the United States of America. */ 11 | /* */ 12 | /************************************************************************/ 13 | 14 | 15 | /* 16 | File Name : vmemsave.h 17 | DEfinition for vmemsave 18 | */ 19 | 20 | #define FP_IFPAGE 512 /* IFPAGE address in sysoutfile by Byte */ 21 | #define DOMINOPAGES 301 /* skip dominopages in fptovp */ 22 | #define SKIPPAGES 301 /* save first filepage */ 23 | #define SKIP_DOMINOPAGES 153600 /* Byte size in sysoutfile for dominocode */ 24 | #define SAVE_IFPAGE 223 /* Virtual address for IFPAGES's buffer page. This value is \EMUSWAPBUFFERS in lisp. */ 25 | #endif /* VMEMSAVE_H */ 26 | -------------------------------------------------------------------------------- /vmemsavedefs.h: -------------------------------------------------------------------------------- 1 | #ifndef VMEMSAVEDEFS_H 2 | #define VMEMSAVEDEFS_H 1 3 | #include "lispemul.h" /* for LispPTR, DLword */ 4 | int lispstringP(LispPTR Lisp); 5 | LispPTR vmem_save(char *sysout_file_name); 6 | LispPTR vmem_save0(LispPTR *args); 7 | void lisp_finish(void); 8 | #endif 9 | -------------------------------------------------------------------------------- /xcdefs.h: -------------------------------------------------------------------------------- 1 | #ifndef XCDEFS_H 2 | #define XCDEFS_H 1 3 | void dispatch(void); 4 | void do_brk(void); 5 | #endif 6 | -------------------------------------------------------------------------------- /z2defs.h: -------------------------------------------------------------------------------- 1 | #ifndef Z2DEFS_H 2 | #define Z2DEFS_H 1 3 | #include "lispemul.h" /* for LispPTR */ 4 | LispPTR N_OP_classoc(LispPTR key, LispPTR list); 5 | LispPTR N_OP_clfmemb(LispPTR item, LispPTR list); 6 | LispPTR N_OP_restlist(LispPTR tail, int last, int skip); 7 | #endif 8 | --------------------------------------------------------------------------------