mirror of
https://github.com/Interlisp/maiko.git
synced 2026-02-05 16:04:45 +00:00
Reformat all C source files with Clang-format in Google style w/ 100 col width.
This commit is contained in:
Nick Briggs
247
src/vars3.c
Executable file → Normal file
247
src/vars3.c
Executable file → Normal file
@@ -1,8 +1,6 @@
|
||||
/* $Id: vars3.c,v 1.4 2001/12/24 01:09:07 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
||||
/* $Id: vars3.c,v 1.4 2001/12/24 01:09:07 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
||||
static char *id = "$Id: vars3.c,v 1.4 2001/12/24 01:09:07 sybalsky Exp $ Copyright (C) Venue";
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* (C) Copyright 1989-99 Venue. All Rights Reserved. */
|
||||
@@ -17,16 +15,15 @@ static char *id = "$Id: vars3.c,v 1.4 2001/12/24 01:09:07 sybalsky Exp $ Copyrig
|
||||
|
||||
#include "version.h"
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include "lispemul.h"
|
||||
#include "lspglob.h"
|
||||
#include "lispmap.h"
|
||||
#include "adr68k.h"
|
||||
#include "emlglob.h"
|
||||
#include "cell.h"
|
||||
#include "lsptypes.h"
|
||||
#include "stack.h"
|
||||
#include <stdio.h>
|
||||
#include "lispemul.h"
|
||||
#include "lspglob.h"
|
||||
#include "lispmap.h"
|
||||
#include "adr68k.h"
|
||||
#include "emlglob.h"
|
||||
#include "cell.h"
|
||||
#include "lsptypes.h"
|
||||
#include "stack.h"
|
||||
|
||||
/* def. of car_cell moved to cell.h */
|
||||
|
||||
@@ -35,160 +32,150 @@ struct cadr_cell cadr(LispPTR cell_adr);
|
||||
/*******************************************
|
||||
cadr
|
||||
|
||||
common routine.
|
||||
used by OP_assoc, OP_fmemb
|
||||
common routine.
|
||||
used by OP_assoc, OP_fmemb
|
||||
|
||||
|
||||
*******************************************/
|
||||
struct cadr_cell
|
||||
cadr(LispPTR cell_adr)
|
||||
/* address of cell */
|
||||
/* Lisp address (word addressing) */
|
||||
struct cadr_cell cadr(LispPTR cell_adr)
|
||||
/* address of cell */
|
||||
/* Lisp address (word addressing) */
|
||||
{
|
||||
ConsCell *pcons;
|
||||
struct cadr_cell cadr1; /* return value */
|
||||
short offset;
|
||||
ConsCell *pcons;
|
||||
struct cadr_cell cadr1; /* return value */
|
||||
short offset;
|
||||
|
||||
if (Listp(cell_adr) == NIL)
|
||||
if (cell_adr == NIL) {
|
||||
cadr1.car_cell = 0;
|
||||
cadr1.cdr_cell = 0;
|
||||
return (cadr1);
|
||||
} else {
|
||||
cadr1.car_cell = car(cell_adr);
|
||||
cadr1.cdr_cell = cdr(cell_adr);
|
||||
return (cadr1);
|
||||
}
|
||||
|
||||
if( Listp(cell_adr) == NIL)
|
||||
if(cell_adr == NIL){
|
||||
cadr1.car_cell = 0;
|
||||
cadr1.cdr_cell = 0;
|
||||
return(cadr1);
|
||||
} else {
|
||||
cadr1.car_cell = car(cell_adr);
|
||||
cadr1.cdr_cell = cdr(cell_adr);
|
||||
return(cadr1);
|
||||
}
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR(cell_adr);
|
||||
while (pcons->cdr_code == CDR_INDIRECT) {
|
||||
/* CDR indirect */
|
||||
cell_adr = pcons->car_field;
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR(pcons->car_field);
|
||||
} /* skip CDR_INDIRECT cell */
|
||||
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR(cell_adr);
|
||||
while( pcons->cdr_code == CDR_INDIRECT ){
|
||||
/* CDR indirect */
|
||||
cell_adr = pcons->car_field;
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR(pcons->car_field);
|
||||
}/* skip CDR_INDIRECT cell */
|
||||
|
||||
cadr1.car_cell = pcons->car_field;
|
||||
cadr1.car_cell = pcons->car_field;
|
||||
|
||||
if( pcons->cdr_code == CDR_NIL ){
|
||||
/* CDR nil */
|
||||
cadr1.cdr_cell = NIL_PTR;
|
||||
return(cadr1);
|
||||
}
|
||||
if (pcons->cdr_code == CDR_NIL) {
|
||||
/* CDR nil */
|
||||
cadr1.cdr_cell = NIL_PTR;
|
||||
return (cadr1);
|
||||
}
|
||||
#ifdef NEWCDRCODING
|
||||
offset = (0x7 & pcons->cdr_code) << 1;
|
||||
if(pcons->cdr_code > CDR_NIL){
|
||||
/* CDR on page */
|
||||
cadr1.cdr_cell = cell_adr + offset;
|
||||
}else{
|
||||
/* CDR different page */
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR( (cell_adr) + offset) ;
|
||||
cadr1.cdr_cell = pcons->car_field;
|
||||
}
|
||||
offset = (0x7 & pcons->cdr_code) << 1;
|
||||
if (pcons->cdr_code > CDR_NIL) {
|
||||
/* CDR on page */
|
||||
cadr1.cdr_cell = cell_adr + offset;
|
||||
} else {
|
||||
/* CDR different page */
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR((cell_adr) + offset);
|
||||
cadr1.cdr_cell = pcons->car_field;
|
||||
}
|
||||
#else
|
||||
offset = (0x7F & pcons->cdr_code) << 1;
|
||||
if(pcons->cdr_code > CDR_NIL){
|
||||
/* CDR on page */
|
||||
cadr1.cdr_cell = (mPAGEMASK & cell_adr) | offset;
|
||||
}else{
|
||||
/* CDR different page */
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR( ((mPAGEMASK & cell_adr) | offset) );
|
||||
cadr1.cdr_cell = pcons->car_field;
|
||||
}
|
||||
offset = (0x7F & pcons->cdr_code) << 1;
|
||||
if (pcons->cdr_code > CDR_NIL) {
|
||||
/* CDR on page */
|
||||
cadr1.cdr_cell = (mPAGEMASK & cell_adr) | offset;
|
||||
} else {
|
||||
/* CDR different page */
|
||||
pcons = (ConsCell *)Addr68k_from_LADDR(((mPAGEMASK & cell_adr) | offset));
|
||||
cadr1.cdr_cell = pcons->car_field;
|
||||
}
|
||||
#endif /* NEWCDRCODING */
|
||||
|
||||
return(cadr1);
|
||||
return (cadr1);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/***********************************************************
|
||||
N_OP_arg0
|
||||
|
||||
Entry: ARG0 opcode[0141]
|
||||
Entry: ARG0 opcode[0141]
|
||||
|
||||
<Entry>
|
||||
TopOfStack : slot number of IVAR area
|
||||
<Exit>
|
||||
return : the contents of the slot.
|
||||
<Entry>
|
||||
TopOfStack : slot number of IVAR area
|
||||
<Exit>
|
||||
return : the contents of the slot.
|
||||
|
||||
No effect to CurrentStack.
|
||||
No effect to CurrentStack.
|
||||
|
||||
|
||||
************************************************************/
|
||||
|
||||
LispPTR N_OP_arg0(register LispPTR tos)
|
||||
{
|
||||
register int num;
|
||||
register DLword *bf; /* index of Basic frame */
|
||||
register int nargs;
|
||||
LispPTR N_OP_arg0(register LispPTR tos) {
|
||||
register int num;
|
||||
register DLword *bf; /* index of Basic frame */
|
||||
register int nargs;
|
||||
|
||||
|
||||
if( (SEGMASK & tos ) != S_POSITIVE){
|
||||
/* error("OP_arg0: Bad TopOfStack\n"); */
|
||||
ERROR_EXIT(tos);
|
||||
}else
|
||||
num = 0xFFFF & tos;
|
||||
if(CURRENTFX->alink & 0x1){
|
||||
/* slow */
|
||||
bf = Stackspace + CURRENTFX->blink;
|
||||
}else{
|
||||
/* fast */
|
||||
bf = ((DLword *)CURRENTFX) - BFSIZE;
|
||||
/* bf : pointer to 1st word of BasicFramePointer */
|
||||
}
|
||||
nargs = ((UNSIGNED)bf - (UNSIGNED)IVar)>>2;
|
||||
/* nargs : number of IVAR slots */
|
||||
if((num ==0) || (num > nargs)){
|
||||
/* error("OP_arg0: Bad argument number\n"); */
|
||||
ERROR_EXIT(tos);
|
||||
}
|
||||
return(*((int *)IVar + num - 1));
|
||||
if ((SEGMASK & tos) != S_POSITIVE) {
|
||||
/* error("OP_arg0: Bad TopOfStack\n"); */
|
||||
ERROR_EXIT(tos);
|
||||
} else
|
||||
num = 0xFFFF & tos;
|
||||
if (CURRENTFX->alink & 0x1) {
|
||||
/* slow */
|
||||
bf = Stackspace + CURRENTFX->blink;
|
||||
} else {
|
||||
/* fast */
|
||||
bf = ((DLword *)CURRENTFX) - BFSIZE;
|
||||
/* bf : pointer to 1st word of BasicFramePointer */
|
||||
}
|
||||
nargs = ((UNSIGNED)bf - (UNSIGNED)IVar) >> 2;
|
||||
/* nargs : number of IVAR slots */
|
||||
if ((num == 0) || (num > nargs)) {
|
||||
/* error("OP_arg0: Bad argument number\n"); */
|
||||
ERROR_EXIT(tos);
|
||||
}
|
||||
return (*((int *)IVar + num - 1));
|
||||
}
|
||||
|
||||
|
||||
/*******************************************
|
||||
N_OP_assoc
|
||||
|
||||
Entry: ASSOC opcode[026]
|
||||
Entry: ASSOC opcode[026]
|
||||
|
||||
TopOfStack -- A-list (cons cell of Lisp address)
|
||||
*(int *)(CurrentStackPTR) -- Key (cons cell of Lisp address)
|
||||
|
||||
TopOfStack -- A-list (cons cell of Lisp address)
|
||||
*(int *)(CurrentStackPTR) -- Key (cons cell of Lisp address)
|
||||
|
||||
|
||||
|
||||
*******************************************/
|
||||
|
||||
LispPTR N_OP_assoc(register LispPTR key, register LispPTR list) {
|
||||
REGISTER struct cadr_cell cadr1;
|
||||
register LispPTR cdr; /* address of (cdr A-list); Lisp address */
|
||||
|
||||
LispPTR N_OP_assoc(register LispPTR key, register LispPTR list)
|
||||
{
|
||||
REGISTER struct cadr_cell cadr1;
|
||||
register LispPTR cdr; /* address of (cdr A-list); Lisp address */
|
||||
if (list == NIL_PTR) { return (NIL_PTR); }
|
||||
|
||||
if (!Listp(list)) { return (NIL_PTR); }
|
||||
|
||||
if (list == NIL_PTR) { return(NIL_PTR); }
|
||||
|
||||
if (!Listp( list )) { return(NIL_PTR); }
|
||||
|
||||
S_N_CHECKANDCADR(list, cadr1, list);
|
||||
S_N_CHECKANDCADR(list, cadr1, list);
|
||||
|
||||
do{
|
||||
cdr = cadr1.cdr_cell; /* the rest of A-list */
|
||||
if(Listp(cadr1.car_cell) && key == car(cadr1.car_cell)){
|
||||
/* cons data found */
|
||||
return(cadr1.car_cell);
|
||||
}
|
||||
/* search the rest of A-list */
|
||||
if(Listp(cdr))
|
||||
cadr1 = cadr(cdr);
|
||||
else cdr = NIL;
|
||||
/* check for interrupts and punt to handle one safely */
|
||||
if (!Irq_Stk_End) {
|
||||
TopOfStack = cdr; /* for next execution */
|
||||
TIMER_EXIT(cdr);
|
||||
}
|
||||
}while(cdr != NIL_PTR);
|
||||
do {
|
||||
cdr = cadr1.cdr_cell; /* the rest of A-list */
|
||||
if (Listp(cadr1.car_cell) && key == car(cadr1.car_cell)) {
|
||||
/* cons data found */
|
||||
return (cadr1.car_cell);
|
||||
}
|
||||
/* search the rest of A-list */
|
||||
if (Listp(cdr))
|
||||
cadr1 = cadr(cdr);
|
||||
else
|
||||
cdr = NIL;
|
||||
/* check for interrupts and punt to handle one safely */
|
||||
if (!Irq_Stk_End) {
|
||||
TopOfStack = cdr; /* for next execution */
|
||||
TIMER_EXIT(cdr);
|
||||
}
|
||||
} while (cdr != NIL_PTR);
|
||||
|
||||
return(NIL_PTR);
|
||||
return (NIL_PTR);
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user