github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-16 08:15:31 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #437 from Interlisp/combine-array-files

Browse Source 
Combine six small array opcode implementation files into one
This commit is contained in:
Nick Briggs 2022-08-10 20:13:38 -07:00 committed by GitHub
commit 6010df35fe
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
17 changed files with 232 additions and 415 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
CMakeLists.txt
View File

@ -124,12 +124,7 @@ SET(MAIKO_SRCS
src/arith2.c
src/arith3.c
src/arith4.c
src/array2.c
src/array3.c
src/array4.c
src/array5.c
src/array6.c
src/array.c
src/arrayops.c
src/asmbbt.c
src/bbtsub.c
src/bin.c
@ -227,12 +222,7 @@ SET(MAIKO_HDRS
inc/arith3defs.h
inc/arith4defs.h
inc/arith.h
inc/array2defs.h
inc/array3defs.h
inc/array4defs.h
inc/array5defs.h
inc/array6defs.h
inc/arraydefs.h
inc/arrayopsdefs.h
inc/array.h
inc/bb.h
inc/bbtsubdefs.h

73
bin/makefile-tail
View File

@ -41,12 +41,7 @@ RFLAGS = -c $(CFLAGS) -I$(INCDIR) -I$(INCLUDEDIR)
OFILES = $(OBJECTDIR)arith2.o \
$(OBJECTDIR)arith3.o \
$(OBJECTDIR)arith4.o \
$(OBJECTDIR)array.o \
$(OBJECTDIR)array2.o \
$(OBJECTDIR)array3.o \
$(OBJECTDIR)array4.o \
$(OBJECTDIR)array5.o \
$(OBJECTDIR)array6.o \
$(OBJECTDIR)arrayops.o \
$(OBJECTDIR)bin.o \
$(OBJECTDIR)binds.o \
$(OBJECTDIR)bitblt.o \
@ -267,26 +262,24 @@ $(OBJECTDIR)arith4.o: $(SRCDIR)arith4.c $(REQUIRED-INCS) \
$(INCDIR)mkcelldefs.h
$(CC) $(RFLAGS) $(SRCDIR)arith4.c -o $(OBJECTDIR)arith4.o
$(OBJECTDIR)array.o: $(SRCDIR)array.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lspglob.h \
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)adr68k.h \
$(INCDIR)lispmap.h $(INCDIR)lsptypes.h $(INCDIR)emlglob.h $(INCDIR)arraydefs.h \
$(INCDIR)mkcelldefs.h $(INCDIR)arith.h $(INCDIR)my.h
$(CC) $(RFLAGS) $(SRCDIR)array.c -o $(OBJECTDIR)array.o
$(OBJECTDIR)array3.o: $(SRCDIR)array3.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lspglob.h \
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)adr68k.h \
$(INCDIR)lispmap.h $(INCDIR)lsptypes.h $(INCDIR)emlglob.h \
$(INCDIR)array3defs.h $(INCDIR)mkcelldefs.h $(INCDIR)arith.h $(INCDIR)my.h
$(CC) $(RFLAGS) $(SRCDIR)array3.c -o $(OBJECTDIR)array3.o
$(OBJECTDIR)array5.o: $(SRCDIR)array5.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lspglob.h \
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)adr68k.h \
$(INCDIR)lispmap.h $(INCDIR)lsptypes.h $(INCDIR)emlglob.h \
$(INCDIR)array5defs.h $(INCDIR)mkcelldefs.h $(INCDIR)arith.h $(INCDIR)my.h
$(CC) $(RFLAGS) $(SRCDIR)array5.c -o $(OBJECTDIR)array5.o
$(OBJECTDIR)arrayops.o: $(SRCDIR)arrayops.c $(REQUIRED-INCS) \
$(INCDIR)adr68k.h \
$(INCDIR)arrayopsdefs.h \
$(INCDIR)lispemul.h \
$(INCDIR)lispmap.h \
$(INCDIR)emlglob.h \
$(INCDIR)lspglob.h \
$(INCDIR)ifpage.h \
$(INCDIR)iopage.h \
$(INCDIR)miscstat.h \
$(INCDIR)lsptypes.h \
$(INCDIR)my.h \
$(INCDIR)arith.h \
$(INCDIR)commondefs.h \
$(INCDIR)mkcelldefs.h \
$(INCDIR)gcdata.h \
$(INCDIR)gchtfinddefs.h
$(CC) $(RFLAGS) $(SRCDIR)arrayops.c -o $(OBJECTDIR)arrayops.o
$(OBJECTDIR)bin.o: $(SRCDIR)bin.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lispmap.h \
@ -914,29 +907,6 @@ $(OBJECTDIR)vmemsave.o: $(SRCDIR)vmemsave.c $(REQUIRED-INCS) \
$(INCDIR)ufsdefs.h
$(CC) $(RFLAGS) $(SRCDIR)vmemsave.c -o $(OBJECTDIR)vmemsave.o
$(OBJECTDIR)array2.o: $(SRCDIR)array2.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lspglob.h \
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)adr68k.h \
$(INCDIR)lispmap.h $(INCDIR)lsptypes.h $(INCDIR)emlglob.h $(INCDIR)gcdata.h \
$(INCDIR)mkcelldefs.h $(INCDIR)arith.h $(INCDIR)my.h $(INCDIR)array2defs.h \
$(INCDIR)gchtfinddefs.h
$(CC) $(RFLAGS) $(SRCDIR)array2.c -o $(OBJECTDIR)array2.o
$(OBJECTDIR)array4.o: $(SRCDIR)array4.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lspglob.h \
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)adr68k.h \
$(INCDIR)lispmap.h $(INCDIR)lsptypes.h $(INCDIR)mkcelldefs.h $(INCDIR)arith.h \
$(INCDIR)gcdata.h $(INCDIR)my.h $(INCDIR)array4defs.h $(INCDIR)gchtfinddefs.h
$(CC) $(RFLAGS) $(SRCDIR)array4.c -o $(OBJECTDIR)array4.o
$(OBJECTDIR)array6.o: $(SRCDIR)array6.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lspglob.h \
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)adr68k.h \
$(INCDIR)lispmap.h $(INCDIR)lsptypes.h $(INCDIR)emlglob.h $(INCDIR)gcdata.h \
$(INCDIR)mkcelldefs.h $(INCDIR)arith.h $(INCDIR)my.h $(INCDIR)array6defs.h \
$(INCDIR)gchtfinddefs.h
$(CC) $(RFLAGS) $(SRCDIR)array6.c -o $(OBJECTDIR)array6.o
$(OBJECTDIR)sxhash.o: $(SRCDIR)sxhash.c $(REQUIRED-INCS) \
$(INCDIR)lispemul.h $(INCDIR)lspglob.h \
$(INCDIR)ifpage.h $(INCDIR)iopage.h $(INCDIR)miscstat.h $(INCDIR)lispmap.h \
@ -957,9 +927,8 @@ $(OBJECTDIR)xc.o: $(SRCDIR)xc.c $(REQUIRED-INCS) \
$(INCDIR)initatms.h $(INCDIR)gcdata.h $(INCDIR)arith.h $(INCDIR)stream.h \
$(INCDIR)tos1defs.h $(INCDIR)tosret.h $(INCDIR)tosfns.h $(INCDIR)inlineC.h \
$(INCDIR)xcdefs.h $(INCDIR)arith2defs.h $(INCDIR)arith3defs.h \
$(INCDIR)arith4defs.h $(INCDIR)arraydefs.h $(INCDIR)array2defs.h \
$(INCDIR)array3defs.h $(INCDIR)array4defs.h $(INCDIR)array5defs.h \
$(INCDIR)array6defs.h $(INCDIR)bitbltdefs.h $(INCDIR)bltdefs.h \
$(INCDIR)arith4defs.h $(INCDIR)arrayopsdefs.h \
$(INCDIR)bitbltdefs.h $(INCDIR)bltdefs.h \
$(INCDIR)byteswapdefs.h $(INCDIR)car-cdrdefs.h $(INCDIR)commondefs.h \
$(INCDIR)conspagedefs.h $(INCDIR)drawdefs.h $(INCDIR)eqfdefs.h \
$(INCDIR)findkeydefs.h $(INCDIR)fpdefs.h $(INCDIR)fvardefs.h \

6
inc/array2defs.h
View File

@ -1,6 +0,0 @@
#ifndef ARRAY2DEFS_H
#define ARRAY2DEFS_H 1
#include "lispemul.h" /* for LispPTR */
LispPTR N_OP_misc4(register LispPTR data, register LispPTR base, register LispPTR typenumber,
register LispPTR inx, int alpha);
#endif

5
inc/array3defs.h
View File

@ -1,5 +0,0 @@
#ifndef ARRAY3DEFS_H
#define ARRAY3DEFS_H 1
#include "lispemul.h" /* for LispPTR */
LispPTR N_OP_aref1(register LispPTR arrayarg, register LispPTR inx);
#endif

5
inc/array4defs.h
View File

@ -1,5 +0,0 @@
#ifndef ARRAY4DEFS_H
#define ARRAY4DEFS_H 1
#include "lispemul.h" /* for LispPTR */
LispPTR N_OP_aset1(register LispPTR data, LispPTR arrayarg, register int inx);
#endif

5
inc/array5defs.h
View File

@ -1,5 +0,0 @@
#ifndef ARRAY5DEFS_H
#define ARRAY5DEFS_H 1
#include "lispemul.h" /* for LispPTR */
LispPTR N_OP_aref2(LispPTR arrayarg, LispPTR inx0, LispPTR inx1);
#endif

5
inc/array6defs.h
View File

@ -1,5 +0,0 @@
#ifndef ARRAY6DEFS_H
#define ARRAY6DEFS_H 1
#include "lispemul.h" /* for LispPTR */
LispPTR N_OP_aset2(register LispPTR data, LispPTR arrayarg, LispPTR inx0, LispPTR inx1);
#endif

5
inc/arraydefs.h
View File

@ -1,5 +0,0 @@
#ifndef ARRAYDEFS_H
#define ARRAYDEFS_H 1
#include "lispemul.h" /* for LispPTR */
LispPTR N_OP_misc3(LispPTR baseL, LispPTR typenumber, LispPTR inx, int alpha);
#endif

10
inc/arrayopsdefs.h Normal file
View File

@ -0,0 +1,10 @@
#ifndef ARRAYOPSDEFS_H
#define ARRAYOPSDEFS_H 1
#include "lispemul.h" /* for LispPTR */
LispPTR N_OP_misc3(LispPTR baseL, LispPTR typenumber, LispPTR inx, int alpha);
LispPTR N_OP_misc4(LispPTR data, LispPTR base, LispPTR typenumber, LispPTR inx, int alpha);
LispPTR N_OP_aref1(LispPTR arrayarg, LispPTR inx);
LispPTR N_OP_aset1(LispPTR data, LispPTR arrayarg, int inx);
LispPTR N_OP_aref2(LispPTR arrayarg, LispPTR inx0, LispPTR inx1);
LispPTR N_OP_aset2(LispPTR data, LispPTR arrayarg, LispPTR inx0, LispPTR inx1);
#endif

49
src/array.c
View File

@ -1,49 +0,0 @@
/* @(#) array.c Version 2.8 (12/23/88). copyright envos & Fuji Xerox */
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
#include "version.h"
#include "arraydefs.h" // for N_OP_misc3
#include "emlglob.h"
#include "lispemul.h" // for state, LispPTR, ERROR_EXIT
#include "lspglob.h"
#include "my.h" // for aref_switch, N_GetPos
/************************************************************
OP_claref -- op 372/9 (base typenumber index)
type size typenumber
0 0 0 unsigned : 1 bit
0 3 3 unsigned : 8 bits
0 4 4 unsigned : 16 bits
1 4 20 signed : 16 bits
1 6 22 signed : 32 bits
2 6 38 pointer : 32 bits
3 6 54 float : 32 bits
4 3 67 character : 8 bits
4 4 68 character : 16 bits
5 6 86 Xpointer : 32 bits
***********************************************************/
/*** N_OP_misc3 -- op 372/9 (base typenumber index) ***/
LispPTR N_OP_misc3(LispPTR baseL, LispPTR typenumber, LispPTR inx, int alpha) {
register int index, type;
if (alpha != 9) ERROR_EXIT(inx);
/* test and setup index */
N_GetPos(inx, index, inx);
/* test and setup typenumber */
N_GetPos(typenumber, type, inx);
/* disp on type */
return (aref_switch(type, inx, baseL, index));
} /* end N_OP_misc3() */

52
src/array2.c
View File

@ -1,52 +0,0 @@
/* This is G-file @(#) array2.c Version 2.9 (10/12/88). copyright Xerox & Fuji Xerox */
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
/************************************************************************/
/* */
/* A R R A Y 2 . C */
/* */
/* Contains N_OP_misc4, the ASET opcode. */
/* */
/************************************************************************/
#include "version.h"
#include "array2defs.h" // for N_OP_misc4
#include "emlglob.h"
#include "lispemul.h" // for state, LispPTR, ERROR_EXIT
#include "lspglob.h"
#include "lsptypes.h"
#include "my.h" // for N_GetPos, aset_switch
/************************************************************************/
/* */
/* N _ O P _ m i s c 4 */
/* */
/* CL:ASET opcode op 373/7 (data, base typenumber, index) */
/* */
/************************************************************************/
LispPTR N_OP_misc4(register LispPTR data, register LispPTR base, register LispPTR typenumber,
register LispPTR inx, int alpha) {
register int new;
register int index;
int type;
if (alpha != 7) ERROR_EXIT(inx);
/* test and setup index */
N_GetPos(inx, index, inx);
/* test and setup typenumber */
N_GetPos(typenumber, type, inx);
aset_switch(type, inx);
doufn:
ERROR_EXIT(inx);
} /* end N_OP_misc4() */

49
src/array3.c
View File

@ -1,49 +0,0 @@
/* This is G-file @(#) array3.c Version 2.9 (10/12/88). copyright Xerox & Fuji Xerox */
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
#include "version.h"
/************************************************************************/
/* */
/* A R R A Y 3 . C */
/* */
/* Contains: N_OP_aref1 */
/* */
/************************************************************************/
#include "version.h"
#include "adr68k.h" // for Addr68k_from_LADDR
#include "array3defs.h" // for N_OP_aref1
#include "emlglob.h"
#include "lispemul.h" // for state, LispPTR, ERROR_EXIT
#include "lspglob.h"
#include "lsptypes.h" // for OneDArray, GetTypeNumber, TYPE_ONED_ARRAY
#include "my.h" // for aref_switch, N_GetPos
/*** N_OP_aref1 -- op 266 (array index) ***/
LispPTR N_OP_aref1(register LispPTR arrayarg, register LispPTR inx) {
register LispPTR baseL;
register int index;
register OneDArray *arrayblk;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_ONED_ARRAY) ERROR_EXIT(inx);
arrayblk = (OneDArray *)Addr68k_from_LADDR(arrayarg);
/* test and setup index */
N_GetPos(inx, index, inx);
if (index >= arrayblk->totalsize) ERROR_EXIT(inx);
index += arrayblk->offset;
/* setup base */
baseL = arrayblk->base;
/* disp on type */
return (aref_switch(arrayblk->typenumber, inx, baseL, index));
} /* end N_OP_aref1() */

62
src/array4.c
View File

@ -1,62 +0,0 @@
/* This is G-file @(#) array4.c Version 2.7 (10/12/88). copyright Xerox & Fuji Xerox */
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
#include "version.h"
/************************************************************************/
/* */
/* A R R A Y 4 . C */
/* */
/* Contains: N_OP_aset1 */
/* */
/************************************************************************/
#include "version.h"
#include "adr68k.h" // for Addr68k_from_LADDR
#include "array4defs.h" // for N_OP_aset1
#include "lispemul.h" // for state, LispPTR, ERROR_EXIT
#include "lspglob.h"
#include "lsptypes.h" // for OneDArray, GetTypeNumber, TYPE_ONED_ARRAY
#include "my.h" // for N_GetPos, aset_switch
/*** N_OP_aset1 -- op 267 (new-value array index) ***/
/************************************************************************/
/* */
/* N _ O P _ a s e t 1 */
/* */
/* 1-dimensional array setter. */
/* */
/************************************************************************/
LispPTR N_OP_aset1(register LispPTR data, LispPTR arrayarg, register int inx) {
register OneDArray *arrayblk;
register LispPTR base;
register int new;
register int index;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_ONED_ARRAY) ERROR_EXIT(inx);
arrayblk = (OneDArray *)Addr68k_from_LADDR(arrayarg);
/* test and setup index */
N_GetPos(inx, index, inx);
if (index >= arrayblk->totalsize) ERROR_EXIT(inx);
index += arrayblk->offset;
/* setup base */
base = arrayblk->base;
/* disp on type */
aset_switch(arrayblk->typenumber, inx);
doufn:
ERROR_EXIT(inx);
} /* end N_OP_aset1() */

56
src/array5.c
View File

@ -1,56 +0,0 @@
/* This is G-file @(#) array5.c Version 2.7 (10/12/88). copyright Xerox & Fuji Xerox */
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
/************************************************************************/
/* */
/* A R R A Y 5 . C */
/* */
/* Contains: N_OP_aref2 2-d AREF opcode */
/* */
/************************************************************************/
#include "version.h"
#include "adr68k.h" // for Addr68k_from_LADDR
#include "array5defs.h" // for N_OP_aref2
#include "emlglob.h"
#include "lispemul.h" // for state, LispPTR, ERROR_EXIT
#include "lspglob.h"
#include "lsptypes.h" // for LispArray, GetTypeNumber, TYPE_TWOD_ARRAY
#include "my.h" // for aref_switch, N_GetPos
/************************************************************************/
/* */
/* N _ O P _ a r e f 2 */
/* */
/* 2-d AREF op 356 (array index0 index1) */
/* */
/************************************************************************/
LispPTR N_OP_aref2(LispPTR arrayarg, LispPTR inx0, LispPTR inx1) {
LispPTR baseL;
int arindex, temp;
LispArray *arrayblk;
int j;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_TWOD_ARRAY) ERROR_EXIT(inx1);
arrayblk = (LispArray *)Addr68k_from_LADDR(arrayarg);
baseL = arrayblk->base;
/* test and setup index */
N_GetPos(inx1, temp, inx1);
if (temp >= (j = arrayblk->Dim1)) ERROR_EXIT(inx1);
N_GetPos(inx0, arindex, inx1);
if (arindex >= arrayblk->Dim0) ERROR_EXIT(inx1);
arindex *= j;
arindex += temp;
/* disp on type */
return (aref_switch(arrayblk->typenumber, inx1, baseL, arindex));
} /* end N_OP_aref2() */

46
src/array6.c
View File

@ -1,46 +0,0 @@
/* This is G-file @(#) array6.c Version 2.10 (4/21/92). copyright Xerox & Fuji Xerox */
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
#include "version.h"
#include "adr68k.h" // for Addr68k_from_LADDR
#include "array6defs.h" // for N_OP_aset2
#include "emlglob.h"
#include "lispemul.h" // for state, LispPTR, ERROR_EXIT
#include "lspglob.h"
#include "lsptypes.h" // for LispArray, GetTypeNumber, TYPE_TWOD_ARRAY
#include "my.h" // for N_GetPos, aset_switch
/*** N_OP_aset2 -- op 357 (new-value array index0 index1) ***/
LispPTR N_OP_aset2(register LispPTR data, LispPTR arrayarg, LispPTR inx0, LispPTR inx1) {
register LispArray *arrayblk;
register LispPTR base;
register int new;
register int index, temp;
int j;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_TWOD_ARRAY) ERROR_EXIT(inx1);
arrayblk = (LispArray *)Addr68k_from_LADDR(arrayarg);
base = arrayblk->base;
/* test and setup index */
N_GetPos(inx1, temp, inx1);
if (temp >= (j = arrayblk->Dim1)) ERROR_EXIT(inx1);
N_GetPos(inx0, index, inx1);
if (index >= arrayblk->Dim0) ERROR_EXIT(inx1);
index *= j;
index += temp;
/* disp on type */
aset_switch(arrayblk->typenumber, inx1);
doufn:
ERROR_EXIT(inx1);
} /* end N_OP_aset2() */

198
src/arrayops.c Normal file
View File

@ -0,0 +1,198 @@
/************************************************************************/
/* */
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
#include "version.h"
#include "adr68k.h" // for Addr68k_from_LADDR
#include "arrayopsdefs.h" // for N_OP_misc3, N_OP_misc4, N_OP_aref1, N_OP_aset1, N_OP_aref2, N_OP_aset2
#include "emlglob.h"
#include "lispemul.h" // for state, LispPTR, ERROR_EXIT
#include "lspglob.h"
#include "lsptypes.h"
#include "my.h" // for aref_switch, N_GetPos
/************************************************************
OP_claref -- op 372/9 (base typenumber index)
type size typenumber
0 0 0 unsigned : 1 bit
0 3 3 unsigned : 8 bits
0 4 4 unsigned : 16 bits
1 4 20 signed : 16 bits
1 6 22 signed : 32 bits
2 6 38 pointer : 32 bits
3 6 54 float : 32 bits
4 3 67 character : 8 bits
4 4 68 character : 16 bits
5 6 86 Xpointer : 32 bits
***********************************************************/
/*** N_OP_misc3 -- op 372/9 (base typenumber index) ***/
LispPTR N_OP_misc3(LispPTR baseL, LispPTR typenumber, LispPTR inx, int alpha) {
int index, type;
if (alpha != 9) ERROR_EXIT(inx);
/* test and setup index */
N_GetPos(inx, index, inx);
/* test and setup typenumber */
N_GetPos(typenumber, type, inx);
/* dispatch on type */
return (aref_switch(type, inx, baseL, index));
} /* end N_OP_misc3() */
/************************************************************************/
/* */
/* N _ O P _ m i s c 4 */
/* */
/* CL:ASET opcode op 373/7 (data, base typenumber, index) */
/* */
/************************************************************************/
LispPTR N_OP_misc4(LispPTR data, LispPTR base, LispPTR typenumber,
LispPTR inx, int alpha) {
int new;
int index;
int type;
if (alpha != 7) ERROR_EXIT(inx);
/* test and setup index */
N_GetPos(inx, index, inx);
/* test and setup typenumber */
N_GetPos(typenumber, type, inx);
aset_switch(type, inx);
doufn:
ERROR_EXIT(inx);
} /* end N_OP_misc4() */
/*** N_OP_aref1 -- op 266 (array index) ***/
LispPTR N_OP_aref1(LispPTR arrayarg, LispPTR inx) {
LispPTR baseL;
int index;
OneDArray *arrayblk;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_ONED_ARRAY) ERROR_EXIT(inx);
arrayblk = (OneDArray *)Addr68k_from_LADDR(arrayarg);
/* test and setup index */
N_GetPos(inx, index, inx);
if (index >= arrayblk->totalsize) ERROR_EXIT(inx);
index += arrayblk->offset;
/* setup base */
baseL = arrayblk->base;
/* dispatch on type */
return (aref_switch(arrayblk->typenumber, inx, baseL, index));
} /* end N_OP_aref1() */
/*** N_OP_aset1 -- op 267 (new-value array index) ***/
/************************************************************************/
/* */
/* N _ O P _ a s e t 1 */
/* */
/* 1-dimensional array setter. */
/* */
/************************************************************************/
LispPTR N_OP_aset1(LispPTR data, LispPTR arrayarg, int inx) {
OneDArray *arrayblk;
LispPTR base;
int new;
int index;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_ONED_ARRAY) ERROR_EXIT(inx);
arrayblk = (OneDArray *)Addr68k_from_LADDR(arrayarg);
/* test and setup index */
N_GetPos(inx, index, inx);
if (index >= arrayblk->totalsize) ERROR_EXIT(inx);
index += arrayblk->offset;
/* setup base */
base = arrayblk->base;
/* dispatch on type */
aset_switch(arrayblk->typenumber, inx);
doufn:
ERROR_EXIT(inx);
} /* end N_OP_aset1() */
/************************************************************************/
/* */
/* N _ O P _ a r e f 2 */
/* */
/* 2-d AREF op 356 (array index0 index1) */
/* */
/************************************************************************/
LispPTR N_OP_aref2(LispPTR arrayarg, LispPTR inx0, LispPTR inx1) {
LispPTR baseL;
int arindex, temp;
LispArray *arrayblk;
int j;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_TWOD_ARRAY) ERROR_EXIT(inx1);
arrayblk = (LispArray *)Addr68k_from_LADDR(arrayarg);
baseL = arrayblk->base;
/* test and setup index */
N_GetPos(inx1, temp, inx1);
if (temp >= (j = arrayblk->Dim1)) ERROR_EXIT(inx1);
N_GetPos(inx0, arindex, inx1);
if (arindex >= arrayblk->Dim0) ERROR_EXIT(inx1);
arindex *= j;
arindex += temp;
/* disp on type */
return (aref_switch(arrayblk->typenumber, inx1, baseL, arindex));
} /* end N_OP_aref2() */
/*** N_OP_aset2 -- op 357 (new-value array index0 index1) ***/
LispPTR N_OP_aset2(LispPTR data, LispPTR arrayarg, LispPTR inx0, LispPTR inx1) {
LispArray *arrayblk;
LispPTR base;
int new;
int index, temp;
int j;
/* verify array */
if (GetTypeNumber(arrayarg) != TYPE_TWOD_ARRAY) ERROR_EXIT(inx1);
arrayblk = (LispArray *)Addr68k_from_LADDR(arrayarg);
base = arrayblk->base;
/* test and setup index */
N_GetPos(inx1, temp, inx1);
if (temp >= (j = arrayblk->Dim1)) ERROR_EXIT(inx1);
N_GetPos(inx0, index, inx1);
if (index >= arrayblk->Dim0) ERROR_EXIT(inx1);
index *= j;
index += temp;
/* dispatch on type */
aset_switch(arrayblk->typenumber, inx1);
doufn:
ERROR_EXIT(inx1);
} /* end N_OP_aset2() */

7
src/xc.c
View File

@ -60,12 +60,7 @@
#include "arith2defs.h"
#include "arith3defs.h"
#include "arith4defs.h"
#include "arraydefs.h"
#include "array2defs.h"
#include "array3defs.h"
#include "array4defs.h"
#include "array5defs.h"
#include "array6defs.h"
#include "arrayopsdefs.h"
#include "bitbltdefs.h"
#include "bltdefs.h"
#include "byteswapdefs.h"