msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

remove the teyjus and utils folders

Browse Source
This commit is contained in:
krasimir
2017-04-12 10:31:01 +00:00
parent 3454812516
commit 4e19b1d510
75 changed files with 0 additions and 23922 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
src/runtime/c/teyjus/loader/searchtab.h
View File

@@ -1,44 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#ifndef _SEARCHTAB_H_
#define _SEARCHTAB_H_
#include "../system/memory.h"
#define SEARCHTAB_FCF_SEQNSEARCH 0
#define SEARCHTAB_FCF_HASHSEARCH 1
extern WordPtr LD_SEARCHTAB_LoadHashTab(MEM_GmtEnt* ent, int* size);
extern WordPtr LD_SEARCHTAB_LoadSeqSTab(MEM_GmtEnt* ent, int* size);
/**
\brief Find code function for hash tables.
\return The address of the code corresponding to the given index. Return address for values not in the table is undefined.
**/
extern CSpacePtr LD_SEARCHTAB_HashSrch(int constInd, int STabSize, MemPtr STabAddr);
/**
\brief Find code function for sequential search tables.
\return The address of the code corresponding to the given index. Return address for values not in the table is undefined.
**/
extern CSpacePtr LD_SEARCHTAB_SeqnSrch(int constInd, int STabSize, MemPtr STabAddr);
#endif //_SEARCHTAB_H_

617
src/runtime/c/teyjus/simulator/abstmachine.c
View File

@@ -1,617 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File abstmachine.c. This file defines the various registers, */
/* data areas and record types and their operations relevant to the */
/* abstract machine. */
/* */
/****************************************************************************/
#ifndef ABSTMACHINE_C
#define ABSTMACHINE_C
#include "mctypes.h"
#include "mcstring.h"
#include "dataformats.h"
#include "abstmachine.h"
#include "instraccess.h"
#include "../system/error.h"
#include "../system/memory.h"
/****************************************************************************/
/* ABSTRACT MACHINE REGISTERS (AND FLAGS) */
/****************************************************************************/
AM_DataType AM_regs[AM_NUM_OF_REG];//argument regs/temp variable
//data register access: return the address of the ith register
AM_DataTypePtr AM_reg(int i) { return (AM_regs + i); }
MemPtr AM_hreg; //heap top
MemPtr AM_hbreg; //heap backtrack point
MemPtr AM_ereg; //current environment
MemPtr AM_breg; //last choice point
MemPtr AM_b0reg; //cut point
MemPtr AM_ireg; //impl pt reg, defining prog context
MemPtr AM_cireg; //impl pt for current clause
MemPtr AM_cereg; //closure environment
MemPtr AM_tosreg; //top of stack impl or choice pt.
MemPtr AM_trreg; //trail top
MemPtr AM_pdlTop; //top of pdl
MemPtr AM_pdlBot; //(moving) bottom of pdl
MemPtr AM_typespdlBot; //(moving) bottom of types pdl
DF_TermPtr AM_sreg; //"structure" pointer
DF_TypePtr AM_tysreg; //type structure pointer
CSpacePtr AM_preg; //program pointer
CSpacePtr AM_cpreg; //continuation pointer
Flag AM_bndFlag; //does binding of free var (term) occur?
Flag AM_writeFlag; //in write mode?
Flag AM_tyWriteFlag; //in ty write mode?
Flag AM_ocFlag; //occurs check?
Flag AM_consFlag; //cons?
Flag AM_rigFlag; //rigid?
//The size of AM_numAbs is decided by that of relevant fields in term
//representations which can be found in dataformats.c
TwoBytes AM_numAbs; //number of abstractions in hnf
//The size of AM_numArgs is decided by that of relevant fields in term
//representations which can be found in dataformats.c
TwoBytes AM_numArgs; //number of arguments in hnf
DF_TermPtr AM_head; //head of a hnf
DF_TermPtr AM_argVec; //argument vector of a hnf
DF_TermPtr AM_vbbreg; //variable being bound for occ
DF_TypePtr AM_tyvbbreg; //type var being bound for occ
//The size of AM_adjreg is decided by that of relevant fields in term
//representations which can be found in dataformats.c
TwoBytes AM_adjreg; //univ count of variable being bound
TwoBytes AM_ucreg; //universe count register
DF_DisPairPtr AM_llreg; //ptr to the live list
/****************************************************************************/
/* STACK, HEAP, TRAIL AND PDL RELATED STUFF */
/****************************************************************************/
MemPtr AM_heapBeg, //beginning of the heap
AM_heapEnd, //end of the heap
AM_stackBeg, //beginning of the trail
AM_stackEnd, //end of the trail
AM_trailBeg, //beginning of the trail
AM_trailEnd, //end of the trail
AM_pdlBeg, //beginning of pdl
AM_pdlEnd, //end of pdl
AM_fstCP; //the first choice point
/****************************************************************************/
/* CODE PLACED IN THE HEAP BY THE SYSTEM */
/****************************************************************************/
CSpacePtr AM_failCode;
CSpacePtr AM_andCode;
CSpacePtr AM_orCode;
CSpacePtr AM_allCode;
CSpacePtr AM_solveCode;
CSpacePtr AM_builtinCode;
CSpacePtr AM_eqCode;
CSpacePtr AM_stopCode;
CSpacePtr AM_haltCode;
CSpacePtr AM_notCode1;
CSpacePtr AM_notCode2;
CSpacePtr AM_proceedCode;
Boolean AM_isFailInstr(CSpacePtr cptr) { return (cptr == AM_failCode); }
/****************************************************************************/
/* VITUAL MACHINE MEMORY OPERATIONS */
/****************************************************************************/
//is the given addr referring to a register?
Boolean AM_regAddr(MemPtr p)
{
//TODO:
// AM_reg lacked conversion to MemPtr; why is a function getting
// converted in this way?
return ((((MemPtr)AM_reg) <= p) && (p < (MemPtr)((MemPtr)AM_reg + AM_NUM_OF_REG)));
}
//is the given addr on stack?
Boolean AM_stackAddr(MemPtr p) { return (p > AM_hreg); }
//is the given addr not on heap?
Boolean AM_nHeapAddr(MemPtr p) { return ((p > AM_hreg) || (AM_heapBeg > p));}
//is the "first" impl/impt record?
Boolean AM_botIP(MemPtr p) { return (p == AM_stackBeg); }
//is the "first" choice point"?
Boolean AM_botCP() { return (AM_breg == AM_fstCP); }
//no env record left on the stack?
Boolean AM_noEnv() { return (AM_ereg == AM_stackBeg); }
MemPtr AM_findtos(int i)
{
return ((AM_tosreg > AM_ereg) ? AM_tosreg :
(MemPtr)(((AM_DataTypePtr)(AM_ereg + 2)) + i));
}
MemPtr AM_findtosEnv()
{
return ((AM_tosreg > AM_ereg) ? AM_tosreg :
(MemPtr)(((AM_DataTypePtr)(AM_ereg + 2))+INSACC_CALL_I1(AM_cpreg)));
}
//set AM_tosreg to the top imp or choice pt
void AM_settosreg()
{
if (AM_ireg > AM_breg) AM_tosreg = AM_ireg + AM_IMP_FIX_SIZE;
else AM_tosreg = AM_breg + 1;
}
/***************************************************************************/
/* ENVIRONMENT RECORD OPERATIONS */
/***************************************************************************/
//environment record creation function
MemPtr AM_mkEnv(MemPtr ep) //create the fixed part of env rec
{
*((MemPtr *)(ep - 3)) = AM_cireg; //CI field
*((MemPtr *)(ep - 2)) = AM_ereg; //CE field
*((int *)(ep - 1)) = AM_ucreg; //UC field
*((CSpacePtr *)ep) = AM_cpreg; //CP field
return (ep - 1);
}
MemPtr AM_mkEnvWOUC(MemPtr ep) //ct fixed part of env without uc
{
*((MemPtr *)(ep - 3)) = AM_cireg; //CI field
*((MemPtr *)(ep - 2)) = AM_ereg; //CE field
*((CSpacePtr *)ep) = AM_cpreg; //CP field
return (ep - 1);
}
//environment record access functions (current top-level env record)
//the env continuation point
CSpacePtr AM_envCP() { return *((CSpacePtr *)(AM_ereg + 1));}
//the uc value
int AM_envUC() { return *((int *)AM_ereg); }
//continuation point
MemPtr AM_envCE() { return *((MemPtr *)(AM_ereg - 1)); }
//impl point
MemPtr AM_envCI(MemPtr ep) { return *((MemPtr *)(AM_ereg - 2)); }
//the nth var fd
AM_DataTypePtr AM_envVar(int n)
{
return (AM_DataTypePtr)(((AM_DataTypePtr)AM_ereg) + n);
}
//is p an address in the current env?
Boolean AM_inCurEnv(MemPtr p) { return (p > AM_ereg); }
//access functions for clause environment
AM_DataTypePtr AM_cenvVar(int n) //the nth var fd in clause env
{
return (AM_DataTypePtr)(((AM_DataTypePtr)AM_cereg) + n);
}
/****************************************************************************/
/* CHOICE POINT OPERATIONS */
/****************************************************************************/
//choice point creation functions
void AM_mkCP(MemPtr cp, CSpacePtr label, int n) //create a choice pt
{
*((MemPtr *)cp) = AM_hreg; //heap point
*((CSpacePtr *)(cp - 1)) = label; //next clause ptr
*((MemPtr *)(cp - 2)) = AM_trreg; //trail point
*((DF_DisPairPtr *)(cp - 3)) = AM_llreg; //live list
*((MemPtr *)(cp - 4)) = AM_b0reg; //cut point
*((MemPtr *)(cp - 5)) = AM_breg; //previous choice pt
*((MemPtr *)(cp - 6)) = AM_cireg; //clause context
*((MemPtr *)(cp - 7)) = AM_ireg; //program context
*((CSpacePtr *)(cp - 8)) = AM_cpreg; //cont. code ptr
*((MemPtr *)(cp - 9)) = AM_ereg; //cont. env ptr
*((TwoBytes *)(cp - 10)) = AM_ucreg; //universe count
for (; n > 0; n--) //save reg(1) to reg(n)
*(((AM_DataTypePtr)(cp - 10)) - n) = *AM_reg(n);
}
void AM_saveStateCP(MemPtr cp, CSpacePtr label)
{
*((MemPtr *)cp) = AM_hreg; //heap point
*((CSpacePtr *)(cp - 1)) = label; //next clause ptr
*((MemPtr *)(cp - 2)) = AM_trreg; //trail point
*((DF_DisPairPtr *)(cp - 3)) = AM_llreg; //live list
*((MemPtr *)(cp - 4)) = AM_b0reg; //cut point
*((MemPtr *)(cp - 5)) = AM_breg; //previous choice pt
*((MemPtr *)(cp - 6)) = AM_cireg; //clause context
*((MemPtr *)(cp - 7)) = AM_ireg; //program context
*((CSpacePtr *)(cp - 8)) = AM_cpreg; //cont. code ptr
*((MemPtr *)(cp - 9)) = AM_ereg; //cont. env ptr
*((TwoBytes *)(cp - 10)) = AM_ucreg; //universe count
}
//set the next clause field in the current top choice point
void AM_setNClCP(CSpacePtr ncl)
{
*((CSpacePtr *)(AM_breg - 1)) = ncl;
}
//restore function
//restore all components of a choice point except the trail top and the
//backtrack point registers
void AM_restoreRegs(int n)
{
for (; n > 0; n--)
AM_regs[n] = *(((AM_DataTypePtr)(AM_breg - 10)) - n);
AM_hreg = *((MemPtr *)AM_breg);
AM_llreg = *((DF_DisPairPtr *)(AM_breg - 3));
AM_b0reg = *((MemPtr *)(AM_breg - 4));
AM_cireg = *((MemPtr *)(AM_breg - 6));
AM_ireg = *((MemPtr *)(AM_breg - 7));
AM_cpreg = *((CSpacePtr *)(AM_breg - 8));
AM_ereg = *((MemPtr *)(AM_breg - 9));
AM_ucreg = *((TwoBytes *)(AM_breg - 10));
}
//restore all components of a choice point except the trail top, the backtrack
//point and the clause context registers
void AM_restoreRegsWoCI(int n)
{
for (; n > 0; n--)
AM_regs[n] = *(((AM_DataTypePtr)(AM_breg - 10)) - n);
AM_hreg = *((MemPtr *)AM_breg);
AM_llreg = *((DF_DisPairPtr *)(AM_breg - 3));
AM_b0reg = *((MemPtr *)(AM_breg - 4));
AM_ireg = *((MemPtr *)(AM_breg - 7));
AM_cpreg = *((CSpacePtr *)(AM_breg - 8));
AM_ereg = *((MemPtr *)(AM_breg - 9));
AM_ucreg = *((TwoBytes *)(AM_breg - 10));
}
//access functions
MemPtr AM_cpH() { return *((MemPtr *)(AM_breg)); }
CSpacePtr AM_cpNCL() { return *((CSpacePtr *)(AM_breg - 1)); }
MemPtr AM_cpTR() { return *((MemPtr *)(AM_breg - 2)); }
MemPtr AM_cpB() { return *((MemPtr *)(AM_breg - 5)); }
MemPtr AM_cpCI() { return *((MemPtr *)(AM_breg - 6)); }
AM_DataTypePtr AM_cpArg(MemPtr cp, int n) //addr of nth arg in a given cp
{
return ((AM_DataTypePtr)(cp - 10)) - n;
}
/***************************************************************************/
/* IMPLICATION/IMPORT RECORD OPERATIONS */
/***************************************************************************/
/* The tags for distinguishing implication and import records */
typedef enum
{
AM_IMPTAG_IMPLICATION, //implication record
AM_IMPTAG_IMPTWOLOCAL, //import record without locals
AM_IMPTAG_IMPTWLOCAL //import record with locals
} AM_ImpTag;
//finding code for a predicate in the program context given by the value of
//the AM_ireg.
void AM_findCode(int constInd, CSpacePtr *clPtr, MemPtr *iptr)
{
CSpacePtr myclPtr = NULL;
MemPtr myiptr = AM_ireg;
int size;
while (!AM_botIP(myiptr)) {
if ((size = AM_impPSTS(myiptr)) &&
(myclPtr = (*(AM_impFC(myiptr)))(constInd,size,AM_impPST(myiptr))))
break;
else myiptr = AM_impPIP(myiptr);
}
*clPtr = myclPtr;
*iptr = myiptr;
}
//creating the fixed part of a new implication/import record
void AM_mkImplRec(MemPtr ip, MemPtr sTab, int sTabSize, MEM_FindCodeFnPtr fnPtr)
{
*((MemPtr *)ip) = AM_ereg; //CE: clause env
*(ip+1) = (Mem)AM_IMPTAG_IMPLICATION; //tag
*((MemPtr *)(ip+2)) = sTab; //PST: search table addr
*((MEM_FindCodeFnPtr *)(ip+3)) = fnPtr; //FC: find code fn ptr
*((MemPtr *)(ip+4)) = AM_ireg; //PIP: previous ip addr
*((int *)(ip+5)) = sTabSize; //PSTS: search table size
}
//creating the fixed part of a new import record with local consts
void AM_mkImptRecWL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
MEM_FindCodeFnPtr fnPtr)
{
*((int *)ip) = npreds; //NPred: # preds
*(ip+1) = (Mem)AM_IMPTAG_IMPTWLOCAL; //tag
*((MemPtr *)(ip+2)) = sTab; //PST: search table addr
*((MEM_FindCodeFnPtr *)(ip+3)) = fnPtr; //FC: find code fn ptr
*((MemPtr *)(ip+4)) = AM_ireg; //PIP: previous ip addr
*((int *)(ip+5)) = sTabSize; //PSTS: search table size
}
//creating the fixed part of a new import record without local consts
void AM_mkImptRecWOL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
MEM_FindCodeFnPtr fnPtr)
{
*((int *)ip) = npreds; //NPred: # preds
*(ip+1) = (Mem)AM_IMPTAG_IMPTWOLOCAL;//tag
*((MemPtr *)(ip+2)) = sTab; //PST: search table addr
*((MEM_FindCodeFnPtr *)(ip+3)) = fnPtr; //FC: find code fn ptr
*((MemPtr *)(ip+4)) = AM_ireg; //PIP: previous ip addr
*((int *)(ip+5)) = sTabSize; //PSTS: search table size
}
//creating a dummy import point
void AM_mkDummyImptRec(MemPtr ip)
{
*((int *)ip) = 0;
*(ip+1) = (Mem)AM_IMPTAG_IMPTWOLOCAL;
}
/*initializing the next clause table in an implication/import record.*/
void AM_mkImpNCLTab(MemPtr ip, MemPtr linkTab, int size)
{
int constInd;
CSpacePtr clausePtr;
MemPtr iptr;
MemPtr nextCl = AM_impNCL(ip, size);//the first entry in the NCL table
size--;
for (; size >= 0; size--) {
constInd = MEM_implIthLT(linkTab, size);
AM_findCode(constInd, &clausePtr, &iptr);
if (clausePtr) { //if found
*((CSpacePtr *)nextCl) = clausePtr;
*((MemPtr *)(nextCl+1))= iptr;
} else { //not found
*((CSpacePtr *)nextCl) = AM_failCode;
*((MemPtr *)(nextCl+1))= NULL;
}
nextCl += AM_NCLT_ENTRY_SIZE;
} //for loop
}
//initializing the backchained vector in an import record
void AM_initBCKVector(MemPtr ip, int nclTabSize, int nSegs)
{
MemPtr bcVecPtr = ip - nclTabSize - (AM_BCKV_ENTRY_SIZE * nSegs);
for (; (nSegs > 0); nSegs--){
*((int *)bcVecPtr) = 0;
*((MemPtr *)(bcVecPtr+1)) = AM_breg;
bcVecPtr += AM_BCKV_ENTRY_SIZE;
}
}
//set back chained number in a given back chained field
void AM_setBCKNo(MemPtr bck, int n) { *((int *)bck) = n; }
//set most recent cp in a given back chained field
void AM_setBCKMRCP(MemPtr bck, MemPtr mrcp) { *((MemPtr *)(bck+1)) = mrcp; }
//initializing the universe indices in the symbol table entries for constants
//local to a module
void AM_initLocs(int nlocs, MemPtr locTab)
{
nlocs--;
for (; nlocs >= 0; nlocs--)
AM_setCstUnivCount(MEM_impIthLCT(locTab, nlocs), AM_ucreg);
}
//implication/import record access functions
//the ith entry of next clause tab
MemPtr AM_impNCL(MemPtr ip, int i) {return (ip - AM_NCLT_ENTRY_SIZE * i);}
//code in a next clause field
CSpacePtr AM_impNCLCode(MemPtr ncl) {return *((CSpacePtr *)ncl); }
//ip in a next clause field
MemPtr AM_impNCLIP(MemPtr ncl) {return *((MemPtr *)(ncl+1)); }
//the ith entry of back chained vec
MemPtr AM_cimpBCK(int i)
{ return (AM_cireg-AM_NCLT_ENTRY_SIZE*AM_cimpNPreds()-AM_BCKV_ENTRY_SIZE*i); }
//back chain num in a bck field
int AM_impBCKNo(MemPtr bck) {return *((int *)bck); }
//most recent cp is a bck field
MemPtr AM_impBCKMRCP(MemPtr bck) {return *((MemPtr *)(bck+1)); }
//clause env of in imp rec referred to by cireg
MemPtr AM_cimpCE() {return *((MemPtr *)AM_cireg); }
//# preds of impt rec
int AM_cimpNPreds() {return *((int *)AM_cireg); }
//search table addr
MemPtr AM_impPST(MemPtr ip) {return *((MemPtr *)(ip + 2)); }
//find code function pointer
MEM_FindCodeFnPtr AM_impFC(MemPtr ip) {return *((MEM_FindCodeFnPtr *)(ip + 3));}
//PIP in given imp point
MemPtr AM_impPIP(MemPtr ip) {return *((MemPtr *)(ip + 4)); }
//previous ip in the current top imp point
MemPtr AM_curimpPIP() {return *((MemPtr *)(AM_ireg + 4)); }
//search table size
int AM_impPSTS(MemPtr ip) {return *((int *)(ip + 5)); }
Boolean AM_isImptWL(MemPtr ip) { //is an imp rec a import rec w local
return ((AM_ImpTag)(*(ip+1)) == AM_IMPTAG_IMPTWLOCAL);
}
Boolean AM_isImptWOL(MemPtr ip){ //is an imp rec a import rec wo local
return ((AM_ImpTag)(*(ip+1)) == AM_IMPTAG_IMPTWOLOCAL);
}
Boolean AM_isImpl(MemPtr ip){ //is an imp rec a implication rec
return ((AM_ImpTag)(*(ip+1)) == AM_IMPTAG_IMPLICATION);
}
Boolean AM_isImpt(MemPtr ip){ //is an imp rec a import rec
return ((AM_ImpTag)(*(ip+1)) != AM_IMPTAG_IMPLICATION);
}
Boolean AM_isImplCI(){ //is rec referred to by CI impl?
return ((AM_ImpTag)(*(AM_cireg+1)) == AM_IMPTAG_IMPLICATION);
}
Boolean AM_isCurImptWL(){ //is rec referred to by I impt with loc?
return ((AM_ImpTag)(*(AM_ireg+1)) == AM_IMPTAG_IMPTWLOCAL);
}
/***************************************************************************/
/* LIVE LIST OPERATIONS */
/***************************************************************************/
//live list is empty?
Boolean AM_empLiveList() { return (AM_llreg == DF_EMPTY_DIS_SET);}
//live list not empty?
Boolean AM_nempLiveList(){ return (AM_llreg != DF_EMPTY_DIS_SET);}
//add a dis pair to the live list when not knowning it is empty or not
void AM_addDisPair(DF_TermPtr tPtr1, DF_TermPtr tPtr2)
{
MemPtr nhtop = AM_hreg + DF_DISPAIR_SIZE;
AM_heapError(nhtop);
DF_mkDisPair(AM_hreg, AM_llreg, tPtr1, tPtr2);
AM_llreg = (DF_DisPairPtr)AM_hreg;
AM_hreg = nhtop;
}
/***************************************************************************/
/* PDL OPERATIONS */
/***************************************************************************/
//pop (term/type) PDL
MemPtr AM_popPDL() { return (MemPtr)(*(--AM_pdlTop)); }
//push (term/type) PDL
void AM_pushPDL(MemPtr addr) { (*AM_pdlTop++) = (Mem)addr; }
//is empty PDL?
Boolean AM_emptyPDL() { return (AM_pdlTop == AM_pdlBot); }
//is not empty PDL?
Boolean AM_nemptyPDL() { return (AM_pdlTop > AM_pdlBot); }
//initialize PDL
void AM_initPDL() { AM_pdlTop = AM_pdlBot = AM_pdlBeg; }
//is empty type PDL?
Boolean AM_emptyTypesPDL() { return (AM_pdlTop == AM_typespdlBot); }
//is not empty type PDL?
Boolean AM_nemptyTypesPDL() { return (AM_pdlTop > AM_typespdlBot); }
//initialize type PDL
void AM_initTypesPDL() { AM_typespdlBot = AM_pdlTop; }
//recover type PDL to the status before type unification
void AM_resetTypesPDL() { AM_pdlTop = AM_typespdlBot; }
/****************************************************************************/
/* RUN-TIME SYMBOL TABLES */
/****************************************************************************/
MEM_KstPtr AM_kstBase; //starting addr of the kind symbol table
MEM_TstPtr AM_tstBase; //starting addr of the type skel table
MEM_CstPtr AM_cstBase; //starting addr of the const symbol table
/* Kind symbol table */
char* AM_kstName(int n) //name of a type constructor in a given entry
{
return MCSTR_toCString(
DF_strDataValue(((MEM_KstPtr)(((MemPtr)AM_kstBase)
+ n*MEM_KST_ENTRY_SIZE)) -> name));
}
int AM_kstArity(int n) //arity of a type constructor in a given entry
{
return ((MEM_KstPtr)(((MemPtr)AM_kstBase) + n*MEM_KST_ENTRY_SIZE)) -> arity;
}
/* Type skeleton table */
DF_TypePtr AM_tstSkel(int n) //type skeleton in a given entry
{
return (DF_TypePtr)(((MemPtr)AM_tstBase) + n*MEM_TST_ENTRY_SIZE);
}
/* Constant symbol table */
char* AM_cstName(int n) //name of a constant in a given entry
{
DF_StrDataPtr nameData = ((MEM_CstPtr)(((MemPtr)AM_cstBase) +
n * MEM_CST_ENTRY_SIZE)) -> name;
if (nameData) return MCSTR_toCString(DF_strDataValue(nameData));
else return NULL;
//return MCSTR_toCString(
// DF_strDataValue(((MEM_CstPtr)(((MemPtr)AM_cstBase) +
// n*MEM_CST_ENTRY_SIZE)) -> name));
}
int AM_cstTyEnvSize(int n) //type environment size
{
return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
typeEnvSize;
}
int AM_cstNeeded(int n) //neededness info
{
return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
neededness;
}
int AM_cstUnivCount(int n) //universe count
{
return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->univCount;
}
int AM_cstPrecedence(int n) //precedence
{
return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
precedence;
}
int AM_cstFixity(int n) //fixity
{
return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->fixity;
}
int AM_cstTySkelInd(int n) //type skeleton index
{
return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
tskTabIndex;
}
void AM_setCstUnivCount(int n, int uc) //set universe count
{
((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->univCount = uc;
}
/****************************************************************************
* OVERFLOW ERROR FUNCTIONS *
****************************************************************************/
void AM_heapError(MemPtr p) //heap overflow
{
if (AM_heapEnd < p) EM_error(SIM_ERROR_HEAP_OVERFL);
}
void AM_stackError(MemPtr p) //stack overflow
{
if (AM_stackEnd < p) EM_error(SIM_ERROR_STACK_OVERFL);
}
void AM_pdlError(int n) //pdl overflow for n cells
{
if (AM_pdlEnd < (AM_pdlTop + n)) EM_error(SIM_ERROR_PDL_OVERFL);
}
void AM_trailError(int n) //trail overflow for n cells
{
if (AM_trailEnd < (AM_trreg + n))
EM_error(SIM_ERROR_TRAIL_OVERFL);
}
/****************************************************************************
* MISCELLANEOUS OTHER ERRORS *
****************************************************************************/
void AM_embedError(int n) //violation of max number of lambda embeddings
{
if (n > DF_MAX_BV_IND)
EM_error(SIM_ERROR_TOO_MANY_ABSTRACTIONS, DF_MAX_BV_IND);
}
void AM_arityError(int n) // violation of max number of arity in applications
{
if (n > DF_TM_MAX_ARITY) EM_error(SIM_ERROR_TOO_MANY_ARGUMENTS,
DF_TM_MAX_ARITY);
}
void AM_ucError(int n) //violation of maximum of universe count
{
if (n == DF_MAX_UNIVIND) EM_error(SIM_ERROR_TOO_MANY_UNIV_QUANTS);
}
#endif //ABSTMACHINE_C

346
src/runtime/c/teyjus/simulator/abstmachine.h
View File

@@ -1,346 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File abstmachine.h. This header file defines the various registers, */
/* data areas and record types relevant to the abstract machine. */
/* */
/****************************************************************************/
#ifndef ABSTMACHINE_H
#define ABSTMACHINE_H
#include <stdlib.h>
#include <math.h>
#include "mctypes.h"
#include "dataformats.h"
#include "../system/memory.h"
#include "../system/error.h"
/***************************######********************************************
* ERROR INFORMATION
*********************************######**************************************/
#define SIM_NUM_ERROR_MESSAGES 13
enum
{
SIM_ERROR = SIM_FIRST_ERR_INDEX,
SIM_ERROR_TOO_MANY_ABSTRACTIONS,
SIM_ERROR_TOO_MANY_ARGUMENTS,
SIM_ERROR_TOO_MANY_UNIV_QUANTS,
SIM_ERROR_HEAP_TOO_BIG,
SIM_ERROR_HEAP_TOO_SMALL,
SIM_ERROR_CANNOT_ALLOCATE_HEAP,
SIM_ERROR_CANNOT_ALLOCATE_HEAP_MESSAGE,
SIM_ERROR_CANNOT_ALLOCATE_HEAP_SUGGESTION,
SIM_ERROR_TRAIL_OVERFL,
SIM_ERROR_HEAP_OVERFL,
SIM_ERROR_STACK_OVERFL,
SIM_ERROR_PDL_OVERFL,
};
typedef union //the type of data: (atomic) term or type
{
DF_Term term;
DF_Type type;
} AM_DataType;
typedef AM_DataType *AM_DataTypePtr;
//#define AM_DATA_SIZE (int)ceil((double)sizeof(AM_DataType)/WORD_SIZE)
#define AM_DATA_SIZE 2
/****************************************************************************/
/* ABSTRACT MACHINE REGISTERS (AND FLAGS) */
/****************************************************************************/
typedef enum {OFF = 0, ON = 1} AM_FlagTypes; //FLAG type
typedef Byte Flag;
/*There are 255 argument registers numbered 1 through 255; Reg_0 is never
used. (agree with instruction format)*/
#define AM_NUM_OF_REG 256
extern AM_DataType AM_regs[AM_NUM_OF_REG];//argument regs/temp variables
//data register access: return the address of the ith register
AM_DataTypePtr AM_reg(int i);
extern MemPtr AM_hreg; //heap top
extern MemPtr AM_hbreg; //heap backtrack point
extern MemPtr AM_ereg; //current environment
extern MemPtr AM_breg; //last choice point
extern MemPtr AM_b0reg; //cut point
extern MemPtr AM_ireg; //impl pt reg, defining prog context
extern MemPtr AM_cireg; //impl pt for current clause
extern MemPtr AM_cereg; //closure environment
extern MemPtr AM_tosreg; //top of stack impl or choice pt.
extern MemPtr AM_trreg; //trail top
extern MemPtr AM_pdlTop; //top of pdl
extern MemPtr AM_pdlBot; //(moving) bottom of pdl
extern MemPtr AM_typespdlBot; //(moving) bottom of types pdl
extern DF_TermPtr AM_sreg; //"structure" pointer
extern DF_TypePtr AM_tysreg; //type structure pointer
extern CSpacePtr AM_preg; //program pointer
extern CSpacePtr AM_cpreg; //continuation pointer
extern DF_DisPairPtr AM_llreg; //ptr to the live list
extern Flag AM_bndFlag; //does binding on fv (term) occur?
extern Flag AM_writeFlag; //in write mode?
extern Flag AM_tyWriteFlag; //in ty write mode?
extern Flag AM_ocFlag; //occurs check?
extern Flag AM_consFlag; //cons?
extern Flag AM_rigFlag; //rigid?
extern TwoBytes AM_numAbs; //number of abstractions in hnf
extern TwoBytes AM_numArgs; //number of arguments in hnf
extern DF_TermPtr AM_head; //head of a hnf
extern DF_TermPtr AM_argVec; //argument vector of a hnf
extern DF_TermPtr AM_vbbreg; //variable being bound for occ
extern DF_TypePtr AM_tyvbbreg; //type var being bound for occ
extern TwoBytes AM_adjreg; //univ count of variable being bound
extern TwoBytes AM_ucreg; //universe count register
/****************************************************************************/
/* STACK, HEAP, TRAIL AND PDL RELATED STUFF */
/****************************************************************************/
extern MemPtr AM_heapBeg, //beginning of the heap
AM_heapEnd, //end of the heap
AM_stackBeg, //beginning of the stack
AM_stackEnd, //end of the stack
AM_trailBeg, //beginning of the trail
AM_trailEnd, //end of the trail
AM_pdlBeg, //beginning of pdl
AM_pdlEnd, //end of pdl
AM_fstCP; //the first choice point
/****************************************************************************/
/* CODE PLACED IN THE HEAP BY THE SYSTEM */
/****************************************************************************/
extern CSpacePtr AM_failCode;
extern CSpacePtr AM_andCode;
extern CSpacePtr AM_orCode;
extern CSpacePtr AM_allCode;
extern CSpacePtr AM_solveCode;
extern CSpacePtr AM_builtinCode;
extern CSpacePtr AM_eqCode;
extern CSpacePtr AM_stopCode;
extern CSpacePtr AM_haltCode;
extern CSpacePtr AM_notCode1;
extern CSpacePtr AM_notCode2;
extern CSpacePtr AM_proceedCode;
Boolean AM_isFailInstr(CSpacePtr cptr);
/****************************************************************************/
/* VITUAL MACHINE MEMORY OPERATIONS */
/****************************************************************************/
Boolean AM_regAddr(MemPtr p); //is the given addr referring to a register?
Boolean AM_stackAddr(MemPtr p); //is the given addr on stack?
Boolean AM_nHeapAddr(MemPtr p); //is the given addr on heap?
Boolean AM_botIP(MemPtr p); //is the "first" impl/impt record?
Boolean AM_botCP(); //is the "first" choice point?
Boolean AM_noEnv(); //no env record left on the stack?
MemPtr AM_findtos(int i);
MemPtr AM_findtosEnv();
void AM_settosreg(); //set AM_tosreg to the top imp or choice pt
/***************************************************************************/
/* ENVIRONMENT RECORD OPERATIONS */
/***************************************************************************/
#define AM_ENV_FIX_SIZE 4 //size of the fix part of env rec
//environment record creation function
MemPtr AM_mkEnv(MemPtr ep); //create the fixed part of env rec
MemPtr AM_mkEnvWOUC(MemPtr ep); //ct fixed part of env without uc
//environment record access functions (current top env record)
AM_DataTypePtr AM_envVar(int n); //the nth var fd
int AM_envUC(); //the env universe count
CSpacePtr AM_envCP(); //the env continuation point
MemPtr AM_envCE(); //continuation point
MemPtr AM_envCI(); //impl point
Boolean AM_inCurEnv(MemPtr p); //is p an addr in the curr env?
//access functions for clause environment
AM_DataTypePtr AM_cenvVar(int n); //the nth var fd in clause env
/****************************************************************************/
/* CHOICE POINT OPERATIONS */
/****************************************************************************/
#define AM_CP_FIX_SIZE 11 //size of the fix part of choice point
//choice point creation functions
void AM_mkCP(MemPtr cp, CSpacePtr label, int n); //create a choice pt
void AM_saveStateCP(MemPtr cp, CSpacePtr label);
void AM_setNClCP(CSpacePtr ncl); //set the ncl fd in top ch pt
//restore functions
//restore all components of a choice point except the trail top and the
//backtrack point registers
void AM_restoreRegs(int n);
//restore all components of a choice point except the trail top, the backtrack
//point and the clause context registers
void AM_restoreRegsWoCI(int n);
//access functions
MemPtr AM_cpH();
CSpacePtr AM_cpNCL();
MemPtr AM_cpTR();
MemPtr AM_cpB();
MemPtr AM_cpCI();
AM_DataTypePtr AM_cpArg(MemPtr cp, int n); //addr of nth arg in a given cp
/***************************************************************************/
/* IMPLICATION/IMPORT RECORD OPERATIONS */
/***************************************************************************/
#define AM_IMP_FIX_SIZE 6 //size of the fix part of impl/impt rec
#define AM_DUMMY_IMPT_REC_SIZE 2 //size of a dummy impt rec
#define AM_NCLT_ENTRY_SIZE 2 //size of each entry in next clause tab
#define AM_BCKV_ENTRY_SIZE 2 //size of ent. in back chained vector
//finding code for a predicate in the program context given by the value of
//the AM_ireg.
void AM_findCode(int constInd, CSpacePtr *clPtr, MemPtr *iptr);
//creating the fixed part of a new implication record
void AM_mkImplRec(MemPtr ip,MemPtr sTab,int sTabSize, MEM_FindCodeFnPtr fnPtr);
//creating the fixed part of a new import record with local consts
void AM_mkImptRecWL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
MEM_FindCodeFnPtr fnPtr);
//creating the fixed part of a new import record without local consts
void AM_mkImptRecWOL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
MEM_FindCodeFnPtr fnPtr);
//creating a dummy import point
void AM_mkDummyImptRec(MemPtr ip);
//initializing the next clause table in an implication/import record.
void AM_mkImpNCLTab(MemPtr ip, MemPtr linkTab, int size);
//initializing the backchained vector in an import record
void AM_initBCKVector(MemPtr ip, int nclTabSize, int noSegs);
//set back chained number in a given back chained field
void AM_setBCKNo(MemPtr bck, int n);
//set most recent cp in a given back chained field
void AM_setBCKMRCP(MemPtr bck, MemPtr cp);
//initializing the universe indices in the symbol table entries for constants
//local to a module
void AM_initLocs(int nlocs, MemPtr locTab);
//implication/import record access functions
MemPtr AM_impNCL(MemPtr ip, int i); //the ith entry of next clause tab
CSpacePtr AM_impNCLCode(MemPtr ncl); //code in a next clause field
MemPtr AM_impNCLIP(MemPtr ncl); //ip in a next clause field
MemPtr AM_cimpBCK(int i); //the ith entry of back chained vec in CI
int AM_impBCKNo(MemPtr bck); //back chain num in a bck field
MemPtr AM_impBCKMRCP(MemPtr bck); //most recent cp is a bck field
MemPtr AM_cimpCE(); //clause env of impl rec in CI
int AM_cimpNPreds(); //# preds of impt rec in CI
MemPtr AM_impPST(MemPtr ip); //search table field addr
MEM_FindCodeFnPtr AM_impFC(MemPtr ip); //find code function field addr
MemPtr AM_impPIP(MemPtr ip); //PIP in given imp point
MemPtr AM_curimpPIP(); //PIP in the current top imp point
int AM_impPSTS(MemPtr ip); //search table size field
Boolean AM_isImptWL(MemPtr ip); //is an imp rec a import rec w local
Boolean AM_isImptWOL(MemPtr ip); //is an imp rec a import rec wo local
Boolean AM_isImpl(MemPtr ip); //is an imp rec a implication rec
Boolean AM_isImpt(MemPtr ip); //is an imp rec a import rec
Boolean AM_isImplCI(); //is rec referred to by CI impl?
Boolean AM_isCurImptWL(); //is rec referred to by I impt with loc?
/***************************************************************************/
/* LIVE LIST OPERATIONS */
/***************************************************************************/
Boolean AM_empLiveList(); //live list is empty?
Boolean AM_nempLiveList(); //live list not empty?
//add a dpair to the beginning of live list
void AM_addDisPair(DF_TermPtr tPtr1, DF_TermPtr tPtr2);
/***************************************************************************/
/* PDL OPERATIONS */
/***************************************************************************/
MemPtr AM_popPDL(); //pop (term/type) PDL
void AM_pushPDL(MemPtr); //push (term/type) PDL
Boolean AM_emptyPDL(); //is empty PDL?
Boolean AM_nemptyPDL(); //is not empty PDL?
void AM_initPDL(); //initialize PDL
Boolean AM_emptyTypesPDL(); //is empty type PDL?
Boolean AM_nemptyTypesPDL(); //is not empty type PDL?
void AM_initTypesPDL(); //initialize type PDL
void AM_resetTypesPDL(); //reset PDL to that before ty unif
/****************************************************************************/
/* RUN-TIME SYMBOL TABLES */
/****************************************************************************/
extern MEM_KstPtr AM_kstBase; //starting addr of the kind symbol table
extern MEM_TstPtr AM_tstBase; //starting addr of the type skel table
extern MEM_CstPtr AM_cstBase; //starting addr of the const symbol table
/* Kind symbol table */
char* AM_kstName(int n); //name of a type constructor in a given entry
int AM_kstArity(int n); //arity of a type constructor in a given entry
/* Type skeleton table */
DF_TypePtr AM_tstSkel(int n); //type skeleton in a given entry
/* Constant symbol table */
char* AM_cstName(int n); //name of a constant in a given entry
int AM_cstTyEnvSize(int n); //type environment size
int AM_cstNeeded(int n); //neededness info
int AM_cstUnivCount(int n); //universe count
int AM_cstPrecedence(int n); //precedence
int AM_cstFixity(int n); //fixity
int AM_cstTySkelInd(int n); //type skeleton index
void AM_setCstUnivCount(int n, int uc); //set universe count
/****************************************************************************
* OVERFLOW ERROR FUNCTIONS *
****************************************************************************/
void AM_heapError(MemPtr); //heap overflow
void AM_stackError(MemPtr); //stack overflow
void AM_pdlError(int); //pdl stack overflow for n cells
void AM_trailError(int); //trail overflow for n cells
/****************************************************************************
* MISCELLANEOUS OTHER ERRORS *
****************************************************************************/
void AM_embedError(int); // violation of max number of lambda embeddings
void AM_arityError(int); // violation of max number of arity in applications
void AM_ucError(int); // violation of maximum of universe count
#endif //ABSTMACHINE_H

132
src/runtime/c/teyjus/simulator/builtins/builtins.h
View File

@@ -1,132 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* */
/* File builtins.h. This files defines the indexes of the builtin table, and */
/* provides signature for the function indexing into the builtin table and */
/* invokes the appropriate function. */
/*****************************************************************************/
#ifndef BUILTINS_H
#define BUILTINS_H
#include "../../system/error.h"
/***********************************************************************/
/* Builtin Dispatch Table Index */
/***********************************************************************/
typedef enum
{
BI_SOLVE = 0,
BI_EVAL = 1,
BI_NOT = 2,
BI_UNIFY = 3,
// comparison operations
BI_INT_LT = 4,
BI_INT_GT = 5,
BI_INT_LE = 6,
BI_INT_GE = 7,
BI_FLOAT_LT = 8,
BI_FLOAT_GT = 9,
BI_FLOAT_LE = 10,
BI_FLOAT_GE = 11,
BI_STR_LT = 12,
BI_STR_GT = 13,
BI_STR_LE = 14,
BI_STR_GE = 15,
//IO
BI_IO_OPEN_IN = 16,
BI_IO_OPEN_OUT = 17,
BI_IO_OPEN_APP = 18,
BI_IO_CLOSE_IN = 19,
BI_IO_CLOSE_OUT = 20,
BI_IO_OPEN_STR = 21,
BI_IO_INPUT = 22,
BI_IO_OUTPUT = 23,
BI_IO_INPUT_LINE = 24,
BI_IO_LOOKAHEAD = 25,
BI_IO_EOF = 26,
BI_IO_FLUSH = 27,
BI_IO_PRINT = 28,
BI_IO_READ = 29,
BI_IO_PRINTTERM = 30,
BI_IO_TERM_TO_STR = 31,
BI_IO_STR_TO_TERM = 32,
BI_IO_READTERM = 33,
BI_IO_GETENV = 34,
BI_IO_OPEN_SOCKET = 35,
BI_UNIX_TIME = 36,
BI_SYSTEM = 37
} BI_BuiltinTabIndex;
/*****************************************************************************/
/* Dispatching function for the builtin table */
/*****************************************************************************/
void BI_dispatch(int number);
/* builtin index "register"*/
extern BI_BuiltinTabIndex BI_number;
/***************************######********************************************
* ERROR INFORMATION
*********************************######**************************************/
#define BI_NUM_ERROR_MESSAGES 28
enum
{
BI_ERROR = BI_FIRST_ERR_INDEX,
BI_ERROR_TERM,
BI_ERROR_NOT_IMPLEMENTED,
BI_ERROR_FVAR_CAP,
BI_ERROR_TYFVAR_CAP,
BI_ERROR_DIV_BY_ZERO,
BI_ERROR_NEG_SQRT,
BI_ERROR_NEG_LOG,
BI_ERROR_CONST_IND,
BI_ERROR_FLEX_HEAD, /* takes term */
BI_ERROR_ILLEGAL_ARG, /* takes term */
BI_ERROR_EVAL_TYPE,
BI_ERROR_ILLEGAL_STREAM,
BI_ERROR_FLEX_GOAL,
BI_ERROR_NON_VAR_TERM, /* takes term */
BI_ERROR_INDEX_OUT_OF_BOUNDS,
BI_ERROR_NEGATIVE_VALUE,
BI_ERROR_UNBOUND_VARIABLE, /* takes string indicating desired arg. */
BI_ERROR_NON_STREAM_TERM, /* takes term */
BI_ERROR_STREAM_ALREADY_CLOSED,
BI_ERROR_CANNOT_OPEN_STREAM, /* takes filename */
BI_ERROR_STREAM, /* takes term (stream) */
BI_ERROR_READING_STREAM, /* takes term (stream) */
BI_ERROR_WRITING_STREAM, /* takes term (stream) */
BI_ERROR_FLUSHING_STREAM, /* takes term (stream) */
BI_ERROR_OPENING_STRING, /* takes string */
BI_ERROR_INTEGER_EXPECTED, /* takes term */
BI_ERROR_SUBSTRING
};
/***************************######********************************************
* Initialization
*********************************######**************************************/
void BI_init();
#endif //BUILTINS_H

711
src/runtime/c/teyjus/simulator/dataformats.c
View File

@@ -1,711 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File dataformat.c. */
/* The header file identifies the low-level representation of data objects */
/* that are manipulated by the machine, through various structure types. */
/****************************************************************************/
#ifndef DATAFORMATS_C
#define DATAFORMATS_C
#include <math.h>
#include <string.h>
#include "dataformats.h"
#include "mctypes.h"
#include "mcstring.h"
/********************************************************************/
/* */
/* TYPE REPRESENTATION */
/* */
/********************************************************************/
/* Types of relevant fields in type representations. */
typedef TwoBytes DF_KstTabInd; //kind symbol table index
typedef TwoBytes DF_StrTypeArity; //arity of type structure
typedef TwoBytes DF_SkelInd; //offset of variables in type skeletons
/* Structure definitions of each type category. */
typedef struct //type sort
{
DF_Tag tag;
DF_KstTabInd kindTabIndex;
} DF_SortType;
typedef struct //type reference
{
DF_Tag tag;
DF_TypePtr target;
} DF_RefType;
typedef struct //variables in type skeletons
{
DF_Tag tag;
DF_SkelInd offset;
} DF_SkVarType;
typedef struct //type arrows
{
DF_Tag tag;
DF_TypePtr args;
} DF_ArrowType;
typedef struct //type functors
{
DF_Tag tag;
DF_StrTypeArity arity;
DF_KstTabInd kindTabIndex;
} DF_FuncType;
typedef struct //type structures
{
DF_Tag tag;
DF_FuncType *funcAndArgs;
} DF_StrType;
/******************************************************************/
/* Interface functions */
/******************************************************************/
/* TYPE DEREFERENCE */
DF_TypePtr DF_typeDeref(DF_TypePtr tyPtr)
{
DF_Type ty = *tyPtr;
while ((ty.tag.categoryTag == DF_TY_TAG_REF)){
DF_TypePtr target = (DF_TypePtr)(ty.dummy);
if (tyPtr == target) return tyPtr;
tyPtr = target;
ty = *tyPtr;
}
return tyPtr;
}
/* TYPE RECOGNITION */
Boolean DF_isSortType(DF_TypePtr tyPtr)
{ return (tyPtr->tag.categoryTag == DF_TY_TAG_SORT); }
Boolean DF_isRefType(DF_TypePtr tyPtr)
{ return (tyPtr->tag.categoryTag == DF_TY_TAG_REF); }
Boolean DF_isSkelVarType(DF_TypePtr tyPtr)
{ return (tyPtr->tag.categoryTag == DF_TY_TAG_SKVAR);}
Boolean DF_isArrowType(DF_TypePtr tyPtr)
{ return (tyPtr->tag.categoryTag == DF_TY_TAG_ARROW);}
Boolean DF_isStrType(DF_TypePtr tyPtr)
{ return (tyPtr->tag.categoryTag == DF_TY_TAG_STR); }
Boolean DF_isFreeVarType(DF_TypePtr tyPtr)
{ return ((tyPtr->tag.categoryTag == DF_TY_TAG_REF)
&& ((DF_RefType*)tyPtr)->target == tyPtr); }
/* TYPE DECOMPOSITION */
int DF_typeTag(DF_TypePtr tyPtr) //generic type
{
return tyPtr->tag.categoryTag;
}
int DF_typeKindTabIndex(DF_TypePtr tyPtr) //sorts
{
return ((DF_SortType*)tyPtr) -> kindTabIndex;
}
int DF_typeSkelVarIndex(DF_TypePtr tyPtr) //skel var
{
return ((DF_SkVarType*)tyPtr) -> offset;
}
DF_TypePtr DF_typeRefTarget(DF_TypePtr tyPtr) //reference
{
return ((DF_RefType*)tyPtr) -> target;
}
DF_TypePtr DF_typeArrowArgs(DF_TypePtr tyPtr) //arrows
{
return ((DF_ArrowType*)tyPtr) -> args;
}
DF_TypePtr DF_typeStrFuncAndArgs(DF_TypePtr tyPtr) //structures
{
return (DF_TypePtr)(((DF_StrType*)tyPtr)->funcAndArgs);
}
int DF_typeStrFuncInd(DF_TypePtr tyPtr)
{//Note tyPtr must refer to funcAndArgs field
return ((DF_FuncType*)tyPtr)->kindTabIndex;
}
int DF_typeStrFuncArity(DF_TypePtr tyPtr)
{//Note tyPtr must refer to funcAndArgs field
return ((DF_FuncType*)tyPtr)->arity;
}
DF_TypePtr DF_typeStrArgs(DF_TypePtr tyPtr)
{//Note tyPtr must refer to funcAndArgs field
return (DF_TypePtr)(((MemPtr)tyPtr) + DF_TY_ATOMIC_SIZE);
}
/* TYPE CONSTRUCTION */
void DF_copyAtomicType(DF_TypePtr src, MemPtr dest)
{
*((DF_TypePtr)dest) = *src;
}
void DF_mkSortType(MemPtr loc, int ind)
{
((DF_SortType*)loc)->tag.categoryTag = DF_TY_TAG_SORT;
((DF_SortType*)loc)->kindTabIndex = ind;
}
void DF_mkRefType(MemPtr loc, DF_TypePtr target)
{
((DF_RefType*)loc)->tag.categoryTag = DF_TY_TAG_REF;
((DF_RefType*)loc)->target = target;
}
void DF_mkFreeVarType(MemPtr loc)
{
((DF_RefType*)loc)->tag.categoryTag = DF_TY_TAG_REF;
((DF_RefType*)loc)->target = (DF_TypePtr)loc;
}
void DF_mkSkelVarType(MemPtr loc, int offset)
{
((DF_SkVarType*)loc)->tag.categoryTag = DF_TY_TAG_SKVAR;
((DF_SkVarType*)loc)->offset = offset;
}
void DF_mkArrowType(MemPtr loc, DF_TypePtr args)
{
((DF_ArrowType*)loc)->tag.categoryTag = DF_TY_TAG_ARROW;
((DF_ArrowType*)loc)->args = args;
}
void DF_mkStrType(MemPtr loc, DF_TypePtr funcAndArgs)
{
((DF_StrType*)loc)->tag.categoryTag = DF_TY_TAG_STR;
((DF_StrType*)loc)->funcAndArgs = (DF_FuncType*)funcAndArgs;
}
void DF_mkStrFuncType(MemPtr loc, int ind, int n)
{
((DF_FuncType*)loc)->tag.categoryTag = DF_TY_TAG_FUNC;
((DF_FuncType*)loc)->kindTabIndex = ind;
((DF_FuncType*)loc)->arity = n;
}
/********************************************************************/
/* */
/* TERM REPRESENTATION */
/* */
/********************************************************************/
/* types of relevant fields in term representions */
typedef TwoBytes DF_UnivInd; //universe count
typedef TwoBytes DF_CstTabInd; //constant symbol table index
typedef TwoBytes DF_Arity; //application arity
typedef TwoBytes DF_DBInd; //de Bruijn ind, embed level and num of lams
typedef WordPtr DF_StreamTabInd;
typedef struct //logic variables
{
DF_Tag tag;
DF_UnivInd univCount;
} DF_VarTerm;
typedef struct //de Bruijn indices
{
DF_Tag tag;
DF_DBInd index;
} DF_BVTerm;
typedef struct { //name and universe count field for constants
DF_UnivInd univCount;
DF_CstTabInd symTabIndex;
} DF_NameAndUC;
typedef struct { //constant without type association
DF_Tag tag;
Boolean withType;
union {
unsigned int value;
DF_NameAndUC nameAndUC;
} data;
} DF_ConstTerm;
typedef struct { //constant with type association
DF_Tag tag;
Boolean withType;
union {
unsigned int value;
DF_NameAndUC nameAndUC;
} data;
DF_TypePtr typeEnv;
} DF_TConstTerm;
typedef struct //integers
{
DF_Tag tag;
long int value;
} DF_IntTerm;
typedef struct //floats
{
DF_Tag tag;
float value;
} DF_FloatTerm;
typedef struct //string
{
DF_Tag tag;
DF_StrDataPtr value;
} DF_StrTerm;
typedef struct //stream
{
DF_Tag tag;
DF_StreamTabInd index;
} DF_StreamTerm;
typedef struct //empty list
{
DF_Tag tag;
} DF_NilTerm;
typedef struct //reference
{
DF_Tag tag;
DF_TermPtr target;
} DF_RefTerm;
typedef struct //list cons
{
DF_Tag tag;
DF_TermPtr args;
} DF_ConsTerm;
typedef struct //abstractions
{
DF_Tag tag;
DF_DBInd numOfLams;
DF_TermPtr body;
} DF_LamTerm;
typedef struct //applications
{
DF_Tag tag;
DF_Arity arity;
DF_TermPtr functor;
DF_TermPtr args;
} DF_AppTerm;
typedef struct //suspensions
{
DF_Tag tag;
DF_DBInd ol;
DF_DBInd nl;
DF_TermPtr termSkel;
DF_EnvPtr envList;
} DF_SuspTerm;
//environment items
typedef struct //dummy environment item
{
//Boolean isDummy;
DF_Tag tag;
DF_DBInd embedLevel;
DF_EnvPtr rest;
} DF_DummyEnv;
typedef struct //pair environment item
{
//Boolean isDummy;
DF_Tag tag;
DF_DBInd embedLevel;
DF_EnvPtr rest;
DF_TermPtr term;
} DF_PairEnv;
/******************************************************************/
/* Interface functions */
/******************************************************************/
/* DEREFERENCE */
DF_TermPtr DF_termDeref(DF_TermPtr tmPtr)
{
while (DF_isRef(tmPtr)) tmPtr = ((DF_RefTerm*)tmPtr)->target;
return tmPtr;
}
/* TERM RECOGNITION */
//note ref is neither atomic nor complex
Boolean DF_isAtomic(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag < DF_TM_TAG_REF); }
Boolean DF_isNAtomic(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag > DF_TM_TAG_REF); }
Boolean DF_isFV(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_VAR); }
Boolean DF_isConst(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_CONST); }
/*assume the tmPtr is known to be a constant */
Boolean DF_isTConst(DF_TermPtr tmPtr)
{ return ((DF_ConstTerm*)tmPtr) -> withType; }
Boolean DF_isInt(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_INT); }
Boolean DF_isFloat(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_FLOAT); }
Boolean DF_isNil(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_NIL); }
Boolean DF_isStr(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_STR); }
Boolean DF_isBV(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_BVAR); }
Boolean DF_isStream(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_STREAM);}
Boolean DF_isRef(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_REF); }
Boolean DF_isCons(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_CONS); }
Boolean DF_isLam(DF_TermPtr tmPtr)
{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_LAM); }
Boolean DF_isApp(DF_TermPtr tmPtr)
{ return (tmPtr-> tag.categoryTag == DF_TM_TAG_APP); }
Boolean DF_isSusp(DF_TermPtr tmPtr)
{ return (tmPtr-> tag.categoryTag == DF_TM_TAG_SUSP); }
Boolean DF_isEmpEnv(DF_EnvPtr envPtr)
{ return (envPtr == DF_EMPTY_ENV); }
Boolean DF_isDummyEnv(DF_EnvPtr envPtr)
{ return envPtr -> tag.categoryTag == DF_ENV_TAG_DUMMY; }
/* TERM DECOMPOSITION */
int DF_termTag(DF_TermPtr tmPtr) // tag
{
return tmPtr -> tag.categoryTag;
}
//unbound variables
int DF_fvUnivCount(DF_TermPtr tmPtr) //universe count
{
return ((DF_VarTerm*)tmPtr)->univCount;
}
//constant (w/oc type associations)
int DF_constUnivCount(DF_TermPtr tmPtr) //universe count
{
return ((DF_ConstTerm*)tmPtr)->data.nameAndUC.univCount;
}
int DF_constTabIndex(DF_TermPtr tmPtr) //table index
{
return ((DF_ConstTerm*)tmPtr)->data.nameAndUC.symTabIndex;
}
//constants with type associations
DF_TypePtr DF_constType(DF_TermPtr tmPtr) //type env
{
return ((DF_TConstTerm*)tmPtr)->typeEnv;
}
//integer
long DF_intValue(DF_TermPtr tmPtr) //integer value
{
return ((DF_IntTerm*)tmPtr)->value;
}
//float
float DF_floatValue(DF_TermPtr tmPtr) //float value
{
return ((DF_FloatTerm*)tmPtr)->value;
}
//string
MCSTR_Str DF_strValue(DF_TermPtr tmPtr) //string value
{
return (MCSTR_Str)(((MemPtr)(((DF_StrTerm*)tmPtr)->value))
+ DF_STRDATA_HEAD_SIZE);
}
DF_StrDataPtr DF_strData(DF_TermPtr tmPtr) //string data field
{
return ((DF_StrTerm*)tmPtr)->value;
}
MCSTR_Str DF_strDataValue(DF_StrDataPtr tmPtr) //acc str value from data fd
{
return (MCSTR_Str)(((MemPtr)tmPtr) + DF_STRDATA_HEAD_SIZE);
}
//stream TEMP
WordPtr DF_streamTabIndex(DF_TermPtr tmPtr) //stream table index
{
return ((DF_StreamTerm*)tmPtr)->index;
}
//de Bruijn index
int DF_bvIndex(DF_TermPtr tmPtr) //de Bruijn index
{
return ((DF_BVTerm*)tmPtr)->index;
}
//reference
DF_TermPtr DF_refTarget(DF_TermPtr tmPtr) //target
{
return ((DF_RefTerm*)tmPtr)->target;
}
//list cons
DF_TermPtr DF_consArgs(DF_TermPtr tmPtr) //arg vector
{
return ((DF_ConsTerm*)tmPtr)->args;
}
//abstraction
int DF_lamNumAbs(DF_TermPtr tmPtr) //embedding level
{
return ((DF_LamTerm*)tmPtr)->numOfLams;
}
DF_TermPtr DF_lamBody(DF_TermPtr tmPtr) //abstraction body
{
return ((DF_LamTerm*)tmPtr)->body;
}
//application
int DF_appArity(DF_TermPtr tmPtr) //arity
{
return ((DF_AppTerm*)tmPtr)->arity;
}
DF_TermPtr DF_appFunc(DF_TermPtr tmPtr) //functor
{
return ((DF_AppTerm*)tmPtr)->functor;
}
DF_TermPtr DF_appArgs(DF_TermPtr tmPtr) //arg vector
{
return ((DF_AppTerm*)tmPtr)->args;
}
//suspension
int DF_suspOL(DF_TermPtr tmPtr) //ol
{
return ((DF_SuspTerm*)tmPtr)->ol;
}
int DF_suspNL(DF_TermPtr tmPtr) //nl
{
return ((DF_SuspTerm*)tmPtr)->nl;
}
DF_TermPtr DF_suspTermSkel(DF_TermPtr tmPtr) //term skeleton
{
return ((DF_SuspTerm*)tmPtr)->termSkel;
}
DF_EnvPtr DF_suspEnv(DF_TermPtr tmPtr) //environment list
{
return ((DF_SuspTerm*)tmPtr)->envList;
}
//environment item (dummy/pair)
DF_EnvPtr DF_envListRest(DF_EnvPtr envPtr) //next env item
{
return envPtr->rest;
}
DF_EnvPtr DF_envListNth(DF_EnvPtr envPtr, int n) //nth item
{
int i;
for (i=n; (i!=1); i--) envPtr = envPtr -> rest;
return envPtr;
}
int DF_envIndex(DF_EnvPtr envPtr) //l in @l or (t,l)
{
return envPtr -> embedLevel;
}
//pair environment item
DF_TermPtr DF_envPairTerm(DF_EnvPtr envPtr) //t in (t,l)
{
return ((DF_PairEnv*)envPtr) -> term;
}
/* TERM CONSTRUCTION */
void DF_copyAtomic(DF_TermPtr src, MemPtr dest) //copy atomic
{
*((DF_TermPtr)dest) = *src;
}
void DF_copyApp(DF_TermPtr src, MemPtr dest) //copy application
{
*((DF_AppTerm*)dest) = *((DF_AppTerm*)src);
}
void DF_copySusp(DF_TermPtr src, MemPtr dest) //copy suspension
{
*((DF_SuspTerm*)dest) = *((DF_SuspTerm*)src);
}
void DF_mkVar(MemPtr loc, int uc) //unbound variable
{
((DF_VarTerm*)loc) -> tag.categoryTag = DF_TM_TAG_VAR;
((DF_VarTerm*)loc) -> univCount = uc;
}
void DF_mkBV(MemPtr loc, int ind) //de Bruijn index
{
((DF_BVTerm*)loc) -> tag.categoryTag = DF_TM_TAG_BVAR;
((DF_BVTerm*)loc) -> index = ind;
}
void DF_mkConst(MemPtr loc, int uc, int ind) //const
{
((DF_ConstTerm*)loc) -> tag.categoryTag = DF_TM_TAG_CONST;
((DF_ConstTerm*)loc) -> withType = FALSE;
(((DF_ConstTerm*)loc) -> data).nameAndUC.univCount = uc;
(((DF_ConstTerm*)loc) -> data).nameAndUC.symTabIndex = ind;
}
void DF_mkTConst(MemPtr loc, int uc, int ind, DF_TypePtr typeEnv)
//const with type association
{
((DF_TConstTerm*)loc) -> tag.categoryTag = DF_TM_TAG_CONST;
((DF_TConstTerm*)loc) -> withType = TRUE;
(((DF_TConstTerm*)loc) -> data).nameAndUC.univCount = uc;
(((DF_TConstTerm*)loc) -> data).nameAndUC.symTabIndex = ind;
((DF_TConstTerm*)loc) -> typeEnv = typeEnv;
}
void DF_mkInt(MemPtr loc, long value) //int
{
((DF_IntTerm*)loc) -> tag.categoryTag = DF_TM_TAG_INT;
((DF_IntTerm*)loc) -> value = value;
}
void DF_mkFloat(MemPtr loc, float value) //float
{
((DF_FloatTerm*)loc) -> tag.categoryTag = DF_TM_TAG_FLOAT;
((DF_FloatTerm*)loc) -> value = value;
}
void DF_mkStr(MemPtr loc, DF_StrDataPtr data) //string
{
((DF_StrTerm*)loc) -> tag.categoryTag = DF_TM_TAG_STR;
((DF_StrTerm*)loc) -> value = data;
}
void DF_mkStrDataHead(MemPtr loc) //string data head
{
((DF_StrDataPtr)loc) -> tag.categoryTag = DF_TM_TAG_STRBODY;
}
void DF_mkStream(MemPtr loc, WordPtr ind) //stream
{
((DF_StreamTerm*)loc) -> tag.categoryTag = DF_TM_TAG_STREAM;
((DF_StreamTerm*)loc) -> index = ind;
}
void DF_setStreamInd(DF_TermPtr tm, WordPtr ind) //update stream ind
{
((DF_StreamTerm*)tm) -> index = ind;
}
void DF_mkNil(MemPtr loc) //nil
{
((DF_NilTerm*)loc) -> tag.categoryTag = DF_TM_TAG_NIL;
}
void DF_mkRef(MemPtr loc, DF_TermPtr target) //reference
{
((DF_RefTerm*)loc) -> tag.categoryTag = DF_TM_TAG_REF;
((DF_RefTerm*)loc) -> target = target;
}
void DF_mkCons(MemPtr loc, DF_TermPtr args) //cons
{
((DF_ConsTerm*)loc) -> tag.categoryTag = DF_TM_TAG_CONS;
((DF_ConsTerm*)loc) -> args = args;
}
void DF_mkLam(MemPtr loc, int n, DF_TermPtr body) //abstraction
{
((DF_LamTerm*)loc) -> tag.categoryTag = DF_TM_TAG_LAM;
((DF_LamTerm*)loc) -> numOfLams = n;
((DF_LamTerm*)loc) -> body = body;
}
void DF_mkApp(MemPtr loc, int n, DF_TermPtr func, DF_TermPtr args)
{ //application
((DF_AppTerm*)loc) -> tag.categoryTag = DF_TM_TAG_APP;
((DF_AppTerm*)loc) -> arity = n;
((DF_AppTerm*)loc) -> functor = func;
((DF_AppTerm*)loc) -> args = args;
}
void DF_mkSusp(MemPtr loc, int ol, int nl, DF_TermPtr tmPtr, DF_EnvPtr env)
//suspension
{
((DF_SuspTerm*)loc) -> tag.categoryTag = DF_TM_TAG_SUSP;
((DF_SuspTerm*)loc) -> ol = ol;
((DF_SuspTerm*)loc) -> nl = nl;
((DF_SuspTerm*)loc) -> termSkel = tmPtr;
((DF_SuspTerm*)loc) -> envList = env;
}
void DF_mkDummyEnv(MemPtr loc, int l, DF_EnvPtr rest) //@l env item
{
((DF_DummyEnv*)loc) -> tag.categoryTag = DF_ENV_TAG_DUMMY;
((DF_DummyEnv*)loc) -> embedLevel = l;
((DF_DummyEnv*)loc) -> rest = rest;
}
void DF_mkPairEnv(MemPtr loc, int l, DF_TermPtr t, DF_EnvPtr rest)
{
// (t, l) env item
((DF_PairEnv*)loc) -> tag.categoryTag = DF_ENV_TAG_PAIR;
((DF_PairEnv*)loc) -> embedLevel = l;
((DF_PairEnv*)loc) -> rest = rest;
((DF_PairEnv*)loc) -> term = t;
}
/* TERM MODIFICATION */
void DF_modVarUC(DF_TermPtr vPtr, int uc)
{
((DF_VarTerm*)vPtr) -> univCount = uc;
}
/* (NON_TRIVIAL) TERM COMPARISON */
Boolean DF_sameConsts(DF_TermPtr const1, DF_TermPtr const2) //same constant?
{
return (((DF_ConstTerm*)const1)->data.value ==
((DF_ConstTerm*)const2)->data.value);
}
Boolean DF_sameStrs(DF_TermPtr str1, DF_TermPtr str2) //same string?
{
if (str1 == str2) return TRUE;
else if (((DF_StrTerm*)str1)->value ==
((DF_StrTerm*)str2)->value) return TRUE; //compare data fd addr
//compare literals
return MCSTR_sameStrs(
(MCSTR_Str)(((MemPtr)(((DF_StrTerm*)str1)->value)) +
DF_STRDATA_HEAD_SIZE),
(MCSTR_Str)(((MemPtr)(((DF_StrTerm*)str2)->value)) +
DF_STRDATA_HEAD_SIZE));
}
Boolean DF_sameStrData(DF_TermPtr tmPtr, DF_StrDataPtr strData)
{
if (((DF_StrTerm*)tmPtr) -> value == strData) return TRUE; //compare addr
return MCSTR_sameStrs(
(MCSTR_Str)(((MemPtr)(((DF_StrTerm*)tmPtr)->value)) +
DF_STRDATA_HEAD_SIZE),
(MCSTR_Str)(((MemPtr)strData) + DF_STRDATA_HEAD_SIZE));
}
/********************************************************************/
/* */
/* DISAGREEMENT SET REPRESENTATION */
/* */
/* A double linked list */
/********************************************************************/
//create a new node at the given location
void DF_mkDisPair(MemPtr loc, DF_DisPairPtr next, DF_TermPtr first,
DF_TermPtr second)
{
((DF_DisPairPtr)(loc)) -> tag.categoryTag = DF_DISPAIR;
((DF_DisPairPtr)(loc)) -> next = next;
((DF_DisPairPtr)(loc)) -> firstTerm = first;
((DF_DisPairPtr)(loc)) -> secondTerm = second;
}
//decomposition
DF_DisPairPtr DF_disPairNext(DF_DisPairPtr disPtr){return disPtr -> next; }
DF_TermPtr DF_disPairFirstTerm(DF_DisPairPtr disPtr)
{
return disPtr -> firstTerm;
}
DF_TermPtr DF_disPairSecondTerm(DF_DisPairPtr disPtr)
{
return disPtr -> secondTerm;
}
//whether a given disagreement set is empty
Boolean DF_isEmpDisSet(DF_DisPairPtr disPtr)
{
return (disPtr == DF_EMPTY_DIS_SET);
}
Boolean DF_isNEmpDisSet(DF_DisPairPtr disPtr)
{
return (disPtr != DF_EMPTY_DIS_SET);
}
#endif //DATAFORMATS_C

417
src/runtime/c/teyjus/simulator/dataformats.h
View File

@@ -1,417 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File dataformat.h. */
/* The header file identifies the low-level representation of data objects */
/* that are manipulated by the machine, through various structure types. */
/****************************************************************************/
#ifndef DATAFORMATS_H
#define DATAFORMATS_H
#include <limits.h> // to be removed
#include <stdlib.h>
//#include <math.h>
#include "mctypes.h"
#include "mcstring.h"
/********************************************************************/
/* DATA TAG FIELD IN TYPES AND TERMS */
/********************************************************************/
/* The first byte is assumed to contain a type or term category tag,
and the second is to be used for marking in garbage collection */
typedef struct
{
Byte categoryTag;
Byte mark; //to be used in garbage collection
} DF_Tag;
/* The tags of heap items */
typedef enum
{
//type categories
DF_TY_TAG_SORT = 0, //sort
DF_TY_TAG_REF, //reference
DF_TY_TAG_SKVAR, //skeleton variable
DF_TY_TAG_ARROW, //type arrow
DF_TY_TAG_STR, //type structure
DF_TY_TAG_FUNC, //functor of type structure
//term categories
DF_TM_TAG_VAR = 6, // existential variables
DF_TM_TAG_CONST, // constants
DF_TM_TAG_INT, // integers
DF_TM_TAG_FLOAT, // floats
DF_TM_TAG_NIL, // empty lists
DF_TM_TAG_STR, // strings
DF_TM_TAG_STREAM, // streams
DF_TM_TAG_BVAR, // lambda bound variables (de Bruijn index)
// -- atoms above
DF_TM_TAG_REF, // references
// -- complex terms below
DF_TM_TAG_CONS, // list constructors
DF_TM_TAG_LAM, // abstractions
DF_TM_TAG_APP, // applications
DF_TM_TAG_SUSP, // suspensions
DF_TM_TAG_STRBODY = 19, // string body
//suspension environment items
DF_ENV_TAG_DUMMY = 20, //dummy environment
DF_ENV_TAG_PAIR, //pair environment
//disagreement pair
DF_DISPAIR = 22
} DF_HeapDataCategory;
/********************************************************************/
/* */
/* TYPE REPRESENTATION */
/* */
/********************************************************************/
/********************************************************************/
/* Only generic types are visible from outside. */
/* The "public" information for each specific type category is their*/
/* sizes. Their structure declarations are hidden in dataformat.c. */
/* Construction, recognization and decomposition of types should be */
/* performed through interface functions with declarations present */
/* in this file. */
/********************************************************************/
/*
//type categories
enum DF_TypeCategory
{
DF_TY_TAG_SORT, //sort
DF_TY_TAG_REF, //reference
DF_TY_TAG_SKVAR, //skeleton variable
DF_TY_TAG_ARROW, //type arrow
DF_TY_TAG_STR //type structure
};
*/
//generic type (head) for every category
typedef struct
{
DF_Tag tag; /* the common field for every type (head); can
be any one of enum TypeCategory.
rely on struct alignment */
Word dummy; /* a place holder which enforces the size of the
generic term to be 2 words. */
} DF_Type;
typedef DF_Type *DF_TypePtr; //type pointer
//sizes of different type items
#define DF_TY_ATOMIC_SIZE 2 //atomic size
//attributes of special type constructors
#define DF_TY_ARROW_ARITY 2 //arity of type arrow
/******************************************************************/
/* Interface functions */
/******************************************************************/
/* TYPE DEREFERENCE */
DF_TypePtr DF_typeDeref(DF_TypePtr);
/* TYPE RECOGNITION */
Boolean DF_isSortType(DF_TypePtr); // is sort?
Boolean DF_isRefType(DF_TypePtr); // is reference? (including free var)
Boolean DF_isFreeVarType(DF_TypePtr); // is free var?
Boolean DF_isSkelVarType(DF_TypePtr); // is skeleton var?
Boolean DF_isArrowType(DF_TypePtr); // is type arrow?
Boolean DF_isStrType(DF_TypePtr); // is type structure?
/* TYPE DECOMPOSITION */
int DF_typeTag(DF_TypePtr); //generic type
int DF_typeKindTabIndex(DF_TypePtr); //sorts
int DF_typeSkelVarIndex(DF_TypePtr); //skel var
DF_TypePtr DF_typeRefTarget(DF_TypePtr); //reference
DF_TypePtr DF_typeArrowArgs(DF_TypePtr); //arrows
DF_TypePtr DF_typeStrFuncAndArgs(DF_TypePtr); //structures
int DF_typeStrFuncInd(DF_TypePtr);
int DF_typeStrFuncArity(DF_TypePtr);
DF_TypePtr DF_typeStrArgs(DF_TypePtr);
/* TYPE CONSTRUCTION */
void DF_copyAtomicType(DF_TypePtr src, MemPtr dest);
void DF_mkSortType(MemPtr loc, int ind);
void DF_mkRefType(MemPtr loc, DF_TypePtr target);
void DF_mkFreeVarType(MemPtr loc);
void DF_mkSkelVarType(MemPtr loc, int offset);
void DF_mkArrowType(MemPtr loc, DF_TypePtr args);
void DF_mkStrType(MemPtr loc, DF_TypePtr funcAndArgs);
void DF_mkStrFuncType(MemPtr loc, int ind, int n);
/********************************************************************/
/* */
/* TERM REPRESENTATION */
/* */
/********************************************************************/
/********************************************************************/
/* Only generic terms (environment items) are visible from outside. */
/* The "public" information for each specific term category is their*/
/* sizes. Their structure declarations are hidden in dataformat.c. */
/* Construction, recognization and decomposition of terms should be */
/* performed through interface functions with declarations present */
/* in this file. */
/********************************************************************/
/*
//term categories
enum DF_TermCategory
{
DF_TM_TAG_VAR, // existential variables
DF_TM_TAG_CONST, // constants
DF_TM_TAG_INT, // integers
DF_TM_TAG_FLOAT, // floats
DF_TM_TAG_NIL, // empty lists
DF_TM_TAG_STR, // strings
DF_TM_TAG_STREAM, // streams
DF_TM_TAG_BVAR, // lambda bound variables (de Bruijn index)
// -- atoms above
DF_TM_TAG_REF, // references
// -- complex terms below
DF_TM_TAG_CONS, // list constructors
DF_TM_TAG_LAM, // abstractions
DF_TM_TAG_APP, // applications
DF_TM_TAG_SUSP // suspensions
};
*/
// a generic term (head) for every category
typedef struct
{
DF_Tag tag; /* the common field for every term (head); can
be any one of enum TermCategory.
rely on struct alignment */
Word dummy; /* a place holder which enforces the size of the
generic term to be 2 words. */
} DF_Term;
typedef DF_Term *DF_TermPtr; //term pointer
//sizes of different term items
#define DF_TM_ATOMIC_SIZE 2 // atomic size
#define DF_TM_TCONST_SIZE 3 // type associated constant (config set)
#define DF_TM_APP_SIZE 3 // application head
#define DF_TM_LAM_SIZE 2 // abstraction
#define DF_TM_CONS_SIZE 2 // cons
#define DF_TM_SUSP_SIZE 4 // suspension (config set)
// attributes of some special constants
#define DF_CONS_ARITY 2 //arity of cons
// head of string body (a tag word should be followed by encoding of literals)
typedef union
{
DF_Tag tag;
Word dummy;
} DF_StrData;
typedef DF_StrData *DF_StrDataPtr;
//#define DF_STRDATA_HEAD_SIZE (int)ceil((double)sizeof(DF_StrData)/WORD_SIZE)
#define DF_STRDATA_HEAD_SIZE 2
//a generic environment item in suspension
typedef struct DF_env
{
//Boolean isDummy;
DF_Tag tag;
TwoBytes embedLevel;
struct DF_env *rest; //the tail of the list
} DF_Env;
typedef DF_Env *DF_EnvPtr;
// empty environment list
#define DF_EMPTY_ENV NULL
//sizes of different environment items
#define DF_ENV_DUMMY_SIZE 2 // dummy environment item
#define DF_ENV_PAIR_SIZE 3 // pair environment item
//limits (to be set by configuration)
#define DF_MAX_BV_IND USHRT_MAX //max db ind (embedding level)
#define DF_TM_MAX_ARITY USHRT_MAX //max arity
#define DF_MAX_UNIVIND USHRT_MAX //max universe index
/******************************************************************/
/* Interface functions */
/******************************************************************/
/* DEREFERENCE */
DF_TermPtr DF_termDeref(DF_TermPtr); // term dereference
/* TERM RECOGNITION */
Boolean DF_isAtomic(DF_TermPtr); //note ref is neither atomic nor complex
Boolean DF_isNAtomic(DF_TermPtr);
Boolean DF_isFV(DF_TermPtr); // is unbound variable?
Boolean DF_isConst(DF_TermPtr); // is constant (typed and untyped)?
Boolean DF_isTConst(DF_TermPtr); // is a type associated constant?
// Note we assume the arg is known to be const
Boolean DF_isInt(DF_TermPtr); // is integer?
Boolean DF_isFloat(DF_TermPtr); // is float?
Boolean DF_isNil(DF_TermPtr); // is list nil?
Boolean DF_isStr(DF_TermPtr); // is string?
Boolean DF_isBV(DF_TermPtr); // is de Bruijn index?
Boolean DF_isStream(DF_TermPtr); // is stream?
Boolean DF_isRef(DF_TermPtr); // is reference?
Boolean DF_isCons(DF_TermPtr); // is list cons?
Boolean DF_isLam(DF_TermPtr); // is abstraction?
Boolean DF_isApp(DF_TermPtr); // is application?
Boolean DF_isSusp(DF_TermPtr); // is suspension?
Boolean DF_isEmpEnv(DF_EnvPtr); // is empty environment?
Boolean DF_isDummyEnv(DF_EnvPtr);// is dummy environment item?
/* TERM DECOMPOSITION */
//generic term
int DF_termTag(DF_TermPtr); // term category tag
//unbound variable
int DF_fvUnivCount(DF_TermPtr); // universe count
//constants (w/oc type associations)
int DF_constUnivCount(DF_TermPtr); // universe index
int DF_constTabIndex(DF_TermPtr); // symbol table index
//constants with type associations
DF_TypePtr DF_constType(DF_TermPtr); // type environment
//integer
long DF_intValue(DF_TermPtr); // integer value (long)
//float
float DF_floatValue(DF_TermPtr); // float value
//string
MCSTR_Str DF_strValue(DF_TermPtr); // string value
DF_StrDataPtr DF_strData(DF_TermPtr tmPtr); // string data field
MCSTR_Str DF_strDataValue(DF_StrDataPtr tmPtr); //acc str value from data fd
//stream
WordPtr DF_streamTabIndex(DF_TermPtr); // stream table index
//de Bruijn indices
int DF_bvIndex(DF_TermPtr); // de Bruijn index
//reference
DF_TermPtr DF_refTarget(DF_TermPtr); // target
//list cons
DF_TermPtr DF_consArgs(DF_TermPtr); // arg vector
//abstractions
int DF_lamNumAbs(DF_TermPtr); // embedding level
DF_TermPtr DF_lamBody(DF_TermPtr); // lambda body
//application
int DF_appArity(DF_TermPtr); // arity
DF_TermPtr DF_appFunc(DF_TermPtr); // functor
DF_TermPtr DF_appArgs(DF_TermPtr); // arg vector
//suspension
int DF_suspOL(DF_TermPtr); // ol
int DF_suspNL(DF_TermPtr); // nl
DF_TermPtr DF_suspTermSkel(DF_TermPtr); // term skel
DF_EnvPtr DF_suspEnv(DF_TermPtr); // environment list
//environment item (dummy/pair)
DF_EnvPtr DF_envListRest(DF_EnvPtr); // next env item
DF_EnvPtr DF_envListNth(DF_EnvPtr, int); // the nth item
int DF_envIndex(DF_EnvPtr); // l in @l or (t,l)
//pair environment item
DF_TermPtr DF_envPairTerm(DF_EnvPtr); // t in (t,l)
/* TERM CONSTRUCTION */
void DF_copyAtomic(DF_TermPtr src, MemPtr dest); //copy atomic
void DF_copyApp(DF_TermPtr src, MemPtr dest); //copy application
void DF_copySusp(DF_TermPtr src, MemPtr dest); //copy suspension
void DF_mkVar(MemPtr loc, int uc); //unbound variable
void DF_mkBV(MemPtr loc, int ind); //de Bruijn index
void DF_mkConst(MemPtr loc, int uc, int ind); //const
void DF_mkTConst(MemPtr loc, int uc, int ind, DF_TypePtr typeEnv);
//const with type association
void DF_mkInt(MemPtr loc, long value); //int
void DF_mkFloat(MemPtr loc, float value); //float
void DF_mkStr(MemPtr loc, DF_StrDataPtr data); //string
void DF_mkStrDataHead(MemPtr loc); //string data head
void DF_mkStream(MemPtr loc, WordPtr ind); //stream
void DF_setStreamInd(DF_TermPtr tm, WordPtr ind); //update index of a stream
void DF_mkNil(MemPtr loc); //nil
void DF_mkRef(MemPtr loc, DF_TermPtr target); //reference
void DF_mkCons(MemPtr loc, DF_TermPtr args); //cons
void DF_mkLam(MemPtr loc, int n, DF_TermPtr body); //abstraction
void DF_mkApp(MemPtr loc, int n, DF_TermPtr func, DF_TermPtr args);
//application
void DF_mkSusp(MemPtr loc, int ol, int nl, DF_TermPtr tp, DF_EnvPtr env);
//suspension
void DF_mkDummyEnv(MemPtr loc, int l, DF_EnvPtr rest); //@l env item
void DF_mkPairEnv(MemPtr loc, int l, DF_TermPtr t, DF_EnvPtr rest);
// (t, l) env item
/* TERM MODIFICATION */
void DF_modVarUC(DF_TermPtr vPtr, int uc);
/* (NON_TRIVIAL) TERM COMPARISON */
Boolean DF_sameConsts(DF_TermPtr const1, DF_TermPtr const2); //same const?
Boolean DF_sameStrs(DF_TermPtr str1, DF_TermPtr str2); //same string?
Boolean DF_sameStrData(DF_TermPtr tmPtr, DF_StrDataPtr strData); //same str?
/********************************************************************/
/* */
/* DISAGREEMENT SET REPRESENTATION */
/* */
/* Linked list */
/********************************************************************/
typedef struct DF_disPair //each node in the disagreement set
{
DF_Tag tag;
struct DF_disPair *next;
DF_TermPtr firstTerm;
DF_TermPtr secondTerm;
} DF_DisPair;
typedef DF_DisPair *DF_DisPairPtr; //pointer to a disagreement pair
//note this arithmatic should in reality be performed in configuration
#define DF_DISPAIR_SIZE (int)ceil((double)sizeof(DF_DisPair)/WORD_SIZE)
#define DF_EMPTY_DIS_SET NULL //empty disagreement set
/******************************************************************/
/* Interface functions */
/******************************************************************/
//create a new node at the given location
void DF_mkDisPair(MemPtr loc, DF_DisPairPtr next, DF_TermPtr first,
DF_TermPtr second);
//decomposition
DF_DisPairPtr DF_disPairNext(DF_DisPairPtr disPtr);
DF_TermPtr DF_disPairFirstTerm(DF_DisPairPtr disPtr);
DF_TermPtr DF_disPairSecondTerm(DF_DisPairPtr disPtr);
//whether a given disagreement set is empty
Boolean DF_isEmpDisSet(DF_DisPairPtr disPtr);
Boolean DF_isNEmpDisSet(DF_DisPairPtr disPtr);
#endif //DATAFORMATS_H

1128
src/runtime/c/teyjus/simulator/hnorm.c
View File

File diff suppressed because it is too large Load Diff

42
src/runtime/c/teyjus/simulator/hnorm.h
View File

@@ -1,42 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File hnorm.h. */
/* This header file identifies routines defined in hnorm.c that are */
/* exported from there. */
/****************************************************************************/
#ifndef HNORM_H
#define HNORM_H
#include "dataformats.h"
/* head normalization of the term in the argument */
void HN_hnorm(DF_TermPtr);
/* head normalization of the term in the argument with occurs-check */
void HN_hnormOcc(DF_TermPtr);
/* full normalization of the term in the argument */
void HN_lnorm(DF_TermPtr);
#endif //HNORM_H

597
src/runtime/c/teyjus/simulator/hnormlocal.c
View File

@@ -1,597 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* */
/* File hnormlocal.c. */
/* This file contains the definitions of some auxiliary functionw that are */
/* used exclusively in the (head) normalization routines. (hnorm.c) */
/*****************************************************************************/
#ifndef HNORMLOCAL_C
#define HNORMLOCAL_C
#include <stdlib.h>
#include "abstmachine.h"
#include "dataformats.h"
#include "trail.h"
/**********************************************************************/
/* Register setting upon hnorm initiation or termination */
/**********************************************************************/
/* initialize relevant registers */
void HNL_initRegs()
{
AM_numAbs = AM_numArgs = 0;
AM_head = AM_argVec = NULL;
}
/* when a cons head is found */
void HNL_setRegsCons(DF_TermPtr consPtr)
{
AM_consFlag = AM_rigFlag = ON;
AM_head = consPtr;
}
/* when a (special) constant head is found */
void HNL_setRegsRig(DF_TermPtr headPtr)
{
AM_consFlag = OFF;
AM_rigFlag = ON;
AM_head = headPtr;
}
/* when a unbound variable head is found */
void HNL_setRegsFlex(DF_TermPtr headPtr)
{
AM_consFlag = AM_rigFlag = OFF;
AM_head = headPtr;
}
/************************************************************************/
/* Term creation functions */
/************************************************************************/
/* Push de Bruijn index #ind on the current heap top */
void HNL_pushBV(int ind)
{
MemPtr newhtop = AM_hreg + DF_TM_ATOMIC_SIZE; //new heap top
AM_heapError(newhtop);
DF_mkBV(AM_hreg, ind);
AM_hreg = newhtop;
}
/* Push abstraction lam(n, body) on the current heap top. */
void HNL_pushLam(DF_TermPtr bodyPtr, int n)
{
MemPtr newhtop = AM_hreg + DF_TM_LAM_SIZE; //new heap top
AM_heapError(newhtop);
DF_mkLam(AM_hreg, n, bodyPtr);
AM_hreg = newhtop;
}
/* Push cons(argvecPtr) on the current heap top */
void HNL_pushCons(DF_TermPtr argvecPtr)
{
MemPtr newhtop = AM_hreg + DF_TM_CONS_SIZE; //new heap top
AM_heapError(newhtop);
DF_mkCons(AM_hreg, argvecPtr);
AM_hreg = newhtop;
}
/* Push an application on the current heap top. */
void HNL_pushApp(DF_TermPtr funcPtr, DF_TermPtr argvecPtr, int arity)
{
MemPtr newhtop = AM_hreg + DF_TM_APP_SIZE;
AM_heapError(newhtop);
DF_mkApp(AM_hreg, arity, funcPtr, argvecPtr);
AM_hreg = newhtop;
}
/* Push suspension [|skPtr, ol, nl, e|] on the current heap top. */
void HNL_pushSusp(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr e)
{
MemPtr newhtop = AM_hreg + DF_TM_SUSP_SIZE; //new heap top
AM_heapError(newhtop);
DF_mkSusp(AM_hreg, ol, nl, skPtr, e);
AM_hreg = newhtop;
}
/* Push suspension [|skPtr, ol, nl, e|] on a given location, the pointer to
that location is increamented as side-effect */
void HNL_pushSuspOnLoc(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr e,
MemPtr *locPtr)
{
MemPtr loc = *locPtr, newloc = loc + DF_TM_SUSP_SIZE;
AM_heapError(newloc);
DF_mkSusp(loc, ol, nl, skPtr, e);
*locPtr = newloc;
}
/* Destructively change the cell referred to by tmPtr to a reference.
The change is trailed if necessary. */
void HNL_updateToRef(DF_TermPtr tmPtr, DF_TermPtr target)
{
TR_trailHTerm(tmPtr);
DF_mkRef((MemPtr)tmPtr, target);
}
/************************************************************************/
/* Functions for eagerly evaluating implicit renumber suspensions */
/*----------------------------------------------------------------------*/
/* General comments: */
/* Renumbering suspensions [|skPtr, 0, nl, nil|] */
/* Specifically, if skPtr is a (special) constant, de Bruijn index or a */
/* unbound variable, the suspension is eagerly evaluated; otherwise */
/* it is suspended. In case skPtr is another suspension, combination is */
/* performed. */
/************************************************************************/
/* Used in HNL_BVSuspAsEnv.
The renumber suspension belongs to an environment list.
A pointer to the evaluation result is returned. New suspensions are
pushed on the current heap top if necessary.
*/
static DF_TermPtr HNL_renumberAsEnv(DF_TermPtr skPtr, int nl)
{
DF_TermPtr rtPtr = NULL; //term pointer to be returned
restart_renumberAsEnv:
switch (DF_termTag(skPtr)){
case DF_TM_TAG_VAR:
case DF_TM_TAG_CONST:
case DF_TM_TAG_INT:
case DF_TM_TAG_FLOAT:
case DF_TM_TAG_NIL:
case DF_TM_TAG_STR:
case DF_TM_TAG_STREAM:
{ rtPtr = skPtr; break; }
case DF_TM_TAG_LAM:
case DF_TM_TAG_CONS:
case DF_TM_TAG_APP: //[|skPtr, 0, nl, nil|]
{
if (nl == 0) rtPtr = skPtr;
else {
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushSusp(skPtr, 0, nl, DF_EMPTY_ENV);
}
break;
}
case DF_TM_TAG_SUSP: //[|[|t,ol,nl,e|],0,l,nil|] -> [|t,ol,nl+l,e|]
{
if (nl == 0) rtPtr = skPtr;
else {
int myol = DF_suspOL(skPtr), mynl = DF_suspNL(skPtr);
DF_EnvPtr myenv = DF_suspEnv(skPtr);
int newnl = mynl+nl;
AM_embedError(newnl);
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushSusp(skPtr, myol, newnl, myenv);
}
break;
}
case DF_TM_TAG_BVAR: //[|#i, 0, nl, nil |] -> #(i+nl)
{
int newind = DF_bvIndex(skPtr)+nl;
AM_embedError(newind);
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushBV(newind);
break;
}
case DF_TM_TAG_REF:{skPtr=DF_termDeref(skPtr); goto restart_renumberAsEnv; }
}//switch
return rtPtr;
}
/* Used in HNL_BVSuspAsArg.
The renumber suspension belongs to the arguments of an application or
cons.
In case the evaluation result has an atomic size and is not a unbound
variable, it is committed on the heap location referred to by loc.
If the evaluation result is a free variable or a constant with type
associations, a reference to the result is created on the heap location
referred to by loc.
Otherwise, the evaluation result must be a suspension, and in this case,
the new suspension is created on the location referred to by (*spLocPtr),
(*spLocPtr) is increamented by a suspension size, and a reference to the
new suspension is created on the location pointed by loc. */
static void HNL_renumberAsArg(DF_TermPtr skPtr, int nl, MemPtr loc,
MemPtr *spLocPtr)
{
restart_renumberAsArg:
switch (DF_termTag(skPtr)){
case DF_TM_TAG_VAR: { DF_mkRef(loc, skPtr); break; }
case DF_TM_TAG_CONST:
{
if (DF_isTConst(skPtr)) DF_mkRef(loc, skPtr);
else DF_copyAtomic(skPtr, loc);
break;
}
case DF_TM_TAG_INT:
case DF_TM_TAG_FLOAT:
case DF_TM_TAG_NIL:
case DF_TM_TAG_STR:
case DF_TM_TAG_STREAM:
{ DF_copyAtomic(skPtr, loc); break;}
case DF_TM_TAG_LAM:
case DF_TM_TAG_CONS:
case DF_TM_TAG_APP: //[|t, 0, nl, nil|]
{
if (nl == 0) DF_mkRef(loc, skPtr);
else {
DF_mkRef(loc, (DF_TermPtr)(*spLocPtr));
HNL_pushSuspOnLoc(skPtr, 0, nl, DF_EMPTY_ENV, spLocPtr);
}
break;
}
case DF_TM_TAG_SUSP: //[|[|t,ol,nl,e|],0,l,nil|] -> [|t,ol,nl+l,e|]
{
if (nl == 0) DF_mkRef(loc, skPtr);
else {
DF_TermPtr myskPtr = DF_termDeref(DF_suspTermSkel(skPtr));
int myol = DF_suspOL(skPtr), mynl = DF_suspNL(skPtr);
DF_EnvPtr myenv = DF_suspEnv(skPtr);
int newnl = mynl+nl;
AM_embedError(newnl);
DF_mkRef(loc, (DF_TermPtr)(*spLocPtr));
HNL_pushSuspOnLoc(myskPtr, myol, newnl, myenv, spLocPtr);
}
break;
}
case DF_TM_TAG_BVAR: //[|#i, 0, adj, nil |] -> #(i+adj)
{
int newind = DF_bvIndex(skPtr)+nl;
AM_embedError(newind);
DF_mkBV(loc, newind);
break;
}
case DF_TM_TAG_REF:{skPtr=DF_termDeref(skPtr); goto restart_renumberAsArg;}
}
}
/************************************************************************/
/* Functions for eagerly evaluating implicit suspensions with */
/* de Bruijn indices as term skeleton. */
/*----------------------------------------------------------------------*/
/* General comments: */
/* suspension [|#ind, ol, nl, env|] */
/* The suspension is eagerly evaluated till a non-suspension term or a */
/* un-trivial suspension is resulted. */
/************************************************************************/
/* Used in HNL_suspAsEnv.
The suspension belongs to an environment list.
A pointer to the evaluation result is returned. If new suspensions
need to be created, they are pushed on the current heap top. */
static DF_TermPtr HNL_BVSuspAsEnv(int ind, int ol, int nl, DF_EnvPtr env)
{
DF_TermPtr rtPtr; //term pointer to be returned
if (ind > ol){ //[|#i, ol, nl, env|] -> #(i-ol+nl), where i>ol
int newind = ind - ol + nl;
AM_embedError(newind);
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushBV(newind);
} else {// ind <= ol
DF_EnvPtr envitem = DF_envListNth(env, ind); //ith in env
int nladj = nl - DF_envIndex(envitem);
if (DF_isDummyEnv(envitem)){//[|#i,ol,nl,..@l..|]->#(nl-l), where i<=ol
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushBV(nladj);
} else { //DF_isPairEnv(envitem)
DF_TermPtr tmPtr = DF_envPairTerm(envitem);
rtPtr = HNL_renumberAsEnv(tmPtr, nladj);
}
} // ind <= ol
return rtPtr;
}
/* Used in HNL_suspAsArg.
The suspension belongs to the arguments of an application or cons.
The pointer loc refers to the heap location where the evaluation result
or a reference of the evaluation result is to be created, and if new
suspensions need to be created, they are created on the heap location
referred to by *spLocPtr.
*/
static void HNL_BVSuspAsArg(DF_TermPtr bv, int ol, int nl, DF_EnvPtr env,
MemPtr loc, MemPtr *spLocPtr)
{
int ind = DF_bvIndex(bv); //index of the bv
if (ind > ol){ //[|#i, ol, nl, env|] -> #(i-ol+nl), where i>ol
int newind = ind - ol + nl;
AM_embedError(newind);
DF_mkBV(loc, newind);
} else {//ind <= ol
DF_EnvPtr envitem = DF_envListNth(env, ind); //ith item in env
int nladj = nl - DF_envIndex(envitem);
if (DF_isDummyEnv(envitem)){//[|#i,ol,nl,..@l..|]->#(nl-l), where i<=ol
DF_mkBV(loc, nladj);
} else { //DF_IsPairEnv(envitem)
DF_TermPtr tmPtr = DF_envPairTerm(envitem);
HNL_renumberAsArg(tmPtr, nladj, loc, spLocPtr);
} //ind <= ol
}
}
/************************************************************************/
/* Functions for eagerly evaluating implicit suspensions */
/*----------------------------------------------------------------------*/
/* General comments: */
/* suspension [|skPtr ol, nl, env|] */
/* The suspension is eagerly evaluated till a non-suspension term or a */
/* un-trivial suspension is resulted. */
/************************************************************************/
/* The suspension belongs to an environment list.
A pointer to the evaluation result is returned. New suspensions are
pushed on the current heap top if necessary. */
DF_TermPtr HNL_suspAsEnv(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr env)
{
DF_TermPtr rtPtr = NULL; // term pointer to be returned
restart_suspAsEnv:
switch(DF_termTag(skPtr)){ //[|c, ol, nl, envlist|] -> c
case DF_TM_TAG_VAR:
case DF_TM_TAG_CONST:
case DF_TM_TAG_INT:
case DF_TM_TAG_FLOAT:
case DF_TM_TAG_NIL:
case DF_TM_TAG_STR:
case DF_TM_TAG_STREAM:
{ rtPtr = skPtr; break; }
case DF_TM_TAG_LAM:
case DF_TM_TAG_CONS:
case DF_TM_TAG_SUSP:
case DF_TM_TAG_APP:
{
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushSusp(skPtr, ol, nl, env);
break;
}
case DF_TM_TAG_BVAR:
{
int dbind = DF_bvIndex(skPtr);
rtPtr = HNL_BVSuspAsEnv(dbind, ol, nl, env);
break;
}
case DF_TM_TAG_REF: { skPtr = DF_termDeref(skPtr); goto restart_suspAsEnv; }
}
return rtPtr;
}
/* Used in HNL_pushSuspOverArgs.
The suspension belongs to the arguments of an application or cons.
The pointer loc refers to the heap location where the evaluation result
or a reference of the evaluation result is to be created, and if new
suspensions need to be created, they are created on the heap location
referred to by *spLocPtr.
A flag CHANGED is used to indicate whether the evaluation result is different
from skPtr.
*/
static void HNL_suspAsArg(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr env,
MemPtr loc, MemPtr *spLocPtr, Boolean *changed)
{
restart_suspAsArg:
switch(DF_termTag(skPtr)){
case DF_TM_TAG_VAR: { DF_mkRef(loc, skPtr); break; }
case DF_TM_TAG_CONST:
{
if (DF_isTConst(skPtr)) DF_mkRef(loc, skPtr);
else DF_copyAtomic(skPtr, loc);
break;
}
case DF_TM_TAG_INT:
case DF_TM_TAG_FLOAT:
case DF_TM_TAG_NIL:
case DF_TM_TAG_STR:
case DF_TM_TAG_STREAM:
{
DF_copyAtomic(skPtr, loc);
break;
}
case DF_TM_TAG_LAM:
case DF_TM_TAG_CONS:
case DF_TM_TAG_SUSP:
case DF_TM_TAG_APP:
{
DF_mkRef(loc, (DF_TermPtr)(*spLocPtr));
HNL_pushSuspOnLoc(skPtr, ol, nl, env, spLocPtr);
*changed = TRUE;
break;
}
case DF_TM_TAG_BVAR:
{
HNL_BVSuspAsArg(skPtr, ol, nl, env, loc, spLocPtr);
*changed = TRUE;
break;
}
case DF_TM_TAG_REF: { skPtr = DF_termDeref(skPtr); goto restart_suspAsArg; }
}
}
/************************************************************************/
/* Functions for creating application argument vectors */
/*----------------------------------------------------------------------*/
/* Gerenal comments: */
/* Two issues are considered here. */
/* 1. When the application (cons) is embedded inside a non-empty */
/* suspension, the suspension has to be propagated over their */
/* arguments. In this process, trivial suspensions (those over atomic*/
/* terms including de Bruijn indices) are eagerly evaluated. */
/* 2. When the application has a function being another application */
/* (indicated by AM_numArgs), the nested structures should be */
/* un-folded. In particular, an argument vector with that of the */
/* "top-level" application (possibly changed from propagating */
/* suspensions), and that of the "inner" application has to be */
/* created on the current top of heap. */
/* Such functionality is realized by the following procedures. */
/************************************************************************/
/* Copy an argument vector start from argvec onto the current top of
heap. Needed in unfolding nested applications.
Note that a reference has to be made for unbound variables as opposed
to duplication.
*/
void HNL_copyArgs(DF_TermPtr argvec, int arity)
{
int i;
for (i = 1; i <= arity; i++){
if (DF_isFV(argvec)) DF_mkRef(AM_hreg, argvec);
else DF_copyAtomic(argvec, AM_hreg);
AM_hreg += DF_TM_ATOMIC_SIZE;
argvec = (DF_TermPtr)(((MemPtr)argvec)+DF_TM_ATOMIC_SIZE);
}
}
/* Create an argument vector for applications inside an empty environment.
If no other application is nested in this one, the old argument vector is
used. Specifically, AM_argVec is set to refer the starting address of
the old argument vector, AM_numArgs is set to its arity, and FALSE is
returned to indicate no changes occur in the vector.
Otherwise, a new vector copied from that referred to by argvec and
the other referred to by AM_argVec is created on the current top of heap.
AM_argVec and AM_numArgs are updated correspondingly, and TRUE is
returned to indicate a new vector should be used for the application.
*/
Boolean HNL_makeArgvecEmpEnv(DF_TermPtr argvec, int arity)
{
if (AM_numArgs == 0) { //no nested app
AM_argVec = argvec; //reuse the old argvec
AM_numArgs = arity;
return FALSE;
} else { //unfold nested app
DF_TermPtr newArgvec = (DF_TermPtr)AM_hreg;
int newArity = arity + AM_numArgs;
MemPtr newhtop = AM_hreg + arity * DF_TM_ATOMIC_SIZE;
AM_arityError(newArity);
AM_heapError(newhtop);
HNL_copyArgs(AM_argVec, AM_numArgs); //lay out inner argvec
HNL_copyArgs(argvec, arity); //lay out top-level argvec
AM_argVec = newArgvec;
AM_numArgs = newArity;
return TRUE;
}
}
/* Propagate a suspension environment given by (ol, nl, env) over the
argument vector referred to by argvec. Trivial suspensions are eagerly
evaluated in this process. Non-trivial ones are created on the location
referred to by *spLocPtr.
Further, a flag changed is used to indicate whether the propagating
result is the same as the original argument vector.
*/
static void HNL_pushSuspOverArgs(DF_TermPtr argvec, int arity, int ol, int nl,
DF_EnvPtr env, MemPtr *spLocPtr,
Boolean *changed)
{
int i;
MemPtr myArgvec = AM_hreg;//AM_hreg has not been moved yet
for (i = 1; i <= arity; i++){
HNL_suspAsArg(argvec, ol, nl, env, myArgvec, spLocPtr, changed);
myArgvec = myArgvec + DF_TM_ATOMIC_SIZE;
argvec = (DF_TermPtr)(((MemPtr)argvec)+DF_TM_ATOMIC_SIZE);
}
}
/* Create an argument vector for applications inside a non-empty environment.
Actions are carried out in two steps:
First, nested applications are unfolded if arising. Second, the
non-empty environment is propagated over the argument vector of the (top)
application.
It is assumed that the vector will be changed in the beginning of both
processes, and a flag changed is used to indicate whether changes really
occur. The new argument vector is used and the top of heap is updated only
when the changed flag is TRUE upon termination. Otherwise, the old argument
is used. The flag changed is also returned to the caller to indicate which
vector is used.
*/
Boolean HNL_makeArgvec(DF_TermPtr argvec, int arity, int ol, int nl,
DF_EnvPtr env)
{
Boolean changed; //flag denoting if new argvec is made or the old is reused
MemPtr spLocPtr; //place where susps are to be created
MemPtr newArgvec = AM_hreg;
//unfold nested app first when necessary
if (AM_numArgs == 0){ //no nested app
//assume new arg vector has to be created because of susp propagating
spLocPtr = newArgvec + arity * DF_TM_ATOMIC_SIZE;
AM_heapError(spLocPtr);
AM_numArgs = arity;
changed = FALSE; //indicating no change is made for unfolding app
} else { //unfold nested app
int newArity = arity + AM_numArgs;
AM_arityError(newArity);
//assume new arg vector has to be created because of susp propagating
spLocPtr = newArgvec + newArity * DF_TM_ATOMIC_SIZE;
AM_heapError(spLocPtr);
HNL_copyArgs(AM_argVec, AM_numArgs); //lay out inner argvec
AM_numArgs = newArity;
changed = TRUE; //indicating changes are made for unfolding app
}
//push susp over the argument vector of the top-level app
HNL_pushSuspOverArgs(argvec, arity, ol, nl, env, &spLocPtr, &changed);
if (changed) { //changes because of unfold app or propagate susp
AM_hreg = spLocPtr;
AM_argVec = (DF_TermPtr)newArgvec;
} else AM_argVec = argvec; //no change, reuse the old arg vector
return changed;
}
/* A specialized version of HNL_makeArgvec for argument vectors on cons.
The arity of cons is fixed, and there is no need to considering "unfolding".
*/
Boolean HNL_makeConsArgvec(DF_TermPtr argvec, int ol, int nl, DF_EnvPtr env)
{
MemPtr spLocPtr;
MemPtr newArgvec = AM_hreg;
Boolean changed = FALSE;
spLocPtr = newArgvec + DF_CONS_ARITY * DF_TM_ATOMIC_SIZE;
AM_heapError(spLocPtr);
HNL_pushSuspOverArgs(argvec,DF_CONS_ARITY,ol,nl,env,&spLocPtr,&changed);
AM_numArgs = DF_CONS_ARITY;
if (changed){
AM_hreg = spLocPtr;
AM_argVec = (DF_TermPtr)newArgvec;
} else AM_argVec = argvec;
return changed;
}
#endif //HNORMLOCAL_C

75
src/runtime/c/teyjus/simulator/hnormlocal.h
View File

@@ -1,75 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* */
/* File hnormlocal.h. */
/* This header file identifies functions that are used exclusively in the */
/* (head) normalization routines. Thus, this file is imported only by */
/* hnorm.c. */
/*****************************************************************************/
#ifndef HNORMLOCAL_H
#define HNORMLOCAL_H
#include "dataformats.h"
/**********************************************************************/
/* Register setting upon hnorm initiation or termination */
/**********************************************************************/
void HNL_initRegs(); // initialize relevant registers
void HNL_setRegsCons(DF_TermPtr); // when a cons head is found
void HNL_setRegsRig(DF_TermPtr); // when a (special) constant head is found
void HNL_setRegsFlex(DF_TermPtr); // when a unbound variable head is found
/************************************************************************/
/* Term creation and destructive modification functions */
/************************************************************************/
/* Push de Bruijn index #ind on the current heap top. */
void HNL_pushBV(int ind);
/* Push abstraction lam(n, body) on the current heap top. */
void HNL_pushLam(DF_TermPtr body, int n);
/* Push cons on the current heap top. */
void HNL_pushCons(DF_TermPtr argvecPtr);
/* Push an application on the current heap top. */
void HNL_pushApp(DF_TermPtr funcPtr, DF_TermPtr argvecPtr, int arity);
/* Destructively change the cell referred to by tmPtr to a reference
The change is trailed if necessary. */
void HNL_updateToRef(DF_TermPtr tmPtr, DF_TermPtr target);
/************************************************************************/
/* Functions for eagerly evaluating implicit suspensions */
/************************************************************************/
/* The suspension belongs to an environment list. */
DF_TermPtr HNL_suspAsEnv(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr env);
/************************************************************************/
/* Functions for creating application argument vectors */
/************************************************************************/
/* Copy an argument vector start from argvec onto the current top of heap. */
void HNL_copyArgs(DF_TermPtr argvec, int arity);
/* Create an argument vector for applications inside an empty environment. */
Boolean HNL_makeArgvecEmpEnv(DF_TermPtr argvec, int arity);
/* Create an argument vector for applications inside a non-empty environment. */
Boolean HNL_makeArgvec(DF_TermPtr argvec, int arity, int ol, int nl,
DF_EnvPtr env);
/* A specialized version of HNL_makeArgvec for argument vectors on cons. */
Boolean HNL_makeConsArgvec(DF_TermPtr argvec, int ol, int nl, DF_EnvPtr env);
#endif //HNORMLOCAL_H

1693
src/runtime/c/teyjus/simulator/hopu.c
View File

File diff suppressed because it is too large Load Diff

85
src/runtime/c/teyjus/simulator/hopu.h
View File

@@ -1,85 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* File hopu.h. This header file defines the interface components for the */
/* code in hopu.c that implements higher-order pattern unification. */
/* */
/****************************************************************************/
#ifndef HOPU_H
#define HOPU_H
#include "mctypes.h"
#include "dataformats.h"
/* A flag denoting whether new structure is created during the process of */
/* finding substitutions. */
extern Boolean HOPU_copyFlagGlb;
/* Return the dereference of the abstraction body of the given term. */
DF_TermPtr HOPU_lamBody(DF_TermPtr tPtr);
/* Globalize a rigid term and make a variable binding. */
/* If the term pointer to the rigid term is not one referring to a heap */
/* address, its atomic content is then copied into the variable to be bound*/
/* Otherwise, the variable is made a reference to the rigid term. */
void HOPU_globalizeCopyRigid(DF_TermPtr rPtr, DF_TermPtr vPtr);
/* Globalize a flex term. */
/* If the term pointer is one referring to a stack address, (in which case */
/* the flex term must be a free variable itself), the atomic content is */
/* copied onto the current top of heap; the free variable on stack is then */
/* bound to the new heap term, and the binding is trailed if necessary; the */
/* term pointer is updated to the new heap term. */
DF_TermPtr HOPU_globalizeFlex(DF_TermPtr fPtr);
/* Try to find the (partial) structure of the substitution for a flex head */
/* of a LLambda term corresponding to an internal flex term which is not */
/* known to be LLambda in the compiled form of pattern unification. */
DF_TermPtr HOPU_flexNestedSubstC(DF_TermPtr fhPtr, DF_TermPtr args, int nargs,
DF_TermPtr tmPtr, int emblev);
/* Try to find the (partial) binding of the head of a flex term when */
/* unifying it with a rigid term possible under abstractions in the compiled*/
/* form of pattern unification. */
DF_TermPtr HOPU_rigNestedSubstC(DF_TermPtr rhPtr, DF_TermPtr rPtr,
DF_TermPtr args, int rnargs, int emblev);
/* Interpretively pattern unify first the pairs delayed on the PDL, then */
/* those delayed on the live list, if binding occured during the first step */
/* or previous compiled unification process. */
/* Upon successful termination, PDL should be empty and pairs left on the */
/* live list should be those other than LLambda. */
void HOPU_patternUnify();
/* Interpretively pattern unify a pair of terms given as parameters. This is*/
/* the counter part of HOPU_patterUnifyPDL that is invoked from the compiled*/
/* part of unification. In this situation, the procedure has to be applied */
/* to two terms as opposed to pairs delayed on the PDL stack. */
/* */
/* The input term pointers may dereference to register and stack addresses */
/* Care must be taken to avoid making a reference to a register (stack) */
/* address in binding a variable, and in making a disagreement pair. */
void HOPU_patternUnifyPair(DF_TermPtr tPtr1, DF_TermPtr tPtr2);
#endif //HOPU_H

300
src/runtime/c/teyjus/simulator/instraccess.h
View File

@@ -1,300 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*************************************************************************/
/* */
/* File instraccess.h. Micros for access instruction arguments are */
/* defined, which depends on the instruction format. */
/*************************************************************************/
#ifndef INSTRACCESS_H
#define INSTRACCESS_H
#include "../tables/instructions.h" //to be modified
#define INSACC_CALL_I1(op) (*((INSTR_OneByteInt *)((op) - INSTR_CALL_I1_LEN)))
//INSTR_CAT_X
#define INSACC_X() { AM_preg += INSTR_X_LEN; }
//INSTR_CAT_RX
#define INSACC_RX(op) {\
(op) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RX_R))); \
AM_preg += INSTR_RX_LEN; \
}
//INSTR_CAT_EX
#define INSACC_EX(op) {\
(op) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_EX_E))); \
AM_preg += INSTR_EX_LEN; \
}
//INSTR_CAT_I1X
#define INSACC_I1X(op) {\
(op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1X_I1)); \
AM_preg += INSTR_I1X_LEN; \
}
//INSTR_CAT_CX
#define INSACC_CX(op) {\
(op) = *((INSTR_CstIndex *)(AM_preg + INSTR_CX_C)); \
AM_preg += INSTR_CX_LEN; \
}
//INSTR_CAT_KX
#define INSACC_KX(op) {\
(op) = *((INSTR_KstIndex *)(AM_preg + INSTR_KX_K)); \
AM_preg += INSTR_KX_LEN; \
}
//INSTR_CAT_IX
#define INSACC_IX(op) {\
(op) = *((INSTR_Int *)(AM_preg + INSTR_IX_I)); \
AM_preg += INSTR_IX_LEN; \
}
//INSTR_CAT_FX
#define INSACC_FX(op) {\
(op) = *((INSTR_Float *)(AM_preg + INSTR_FX_F)); \
AM_preg += INSTR_FX_LEN; \
}
//INSTR_CAT_SX
#define INSACC_SX(op) {\
(op) = *((INSTR_Str *)(AM_preg + INSTR_SX_S)); \
AM_preg += INSTR_SX_LEN; \
}
//INSTR_CAT_MTX
#define INSACC_MTX(op) {\
(op) = *((INSTR_ModTab *)(AM_preg + INSTR_MTX_MT)); \
AM_preg += INSTR_MTX_LEN; \
}
//INSTR_CAT_RRX
#define INSACC_RRX(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRX_R1))); \
(op2) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRX_R2))); \
AM_preg += INSTR_RRX_LEN; \
}
//INSTR_CAT_ERX
#define INSACC_ERX(op1, op2) {\
(op1) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_ERX_E))); \
(op2) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_ERX_R))); \
AM_preg += INSTR_ERX_LEN; \
}
//INSTR_CAT_RCX
#define INSACC_RCX(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCX_R))); \
(op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_RCX_C)); \
AM_preg += INSTR_RCX_LEN; \
}
//INSTR_CAT_RIX
#define INSACC_RIX(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RIX_R))); \
(op2) = *((INSTR_Int *)(AM_preg + INSTR_RIX_I)); \
AM_preg += INSTR_RIX_LEN; \
}
//INSTR_CAT_RFX
#define INSACC_RFX(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RFX_R))); \
(op2) = *((INSTR_Float *)(AM_preg + INSTR_RFX_F)); \
AM_preg += INSTR_RFX_LEN; \
}
//INSTR_CAT_RSX
#define INSACC_RSX(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RSX_R))); \
(op2) = *((INSTR_Str *)(AM_preg + INSTR_RSX_S)); \
AM_preg += INSTR_RSX_LEN; \
}
//INSTR_CAT_RI1X
#define INSACC_RI1X(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RI1X_R))); \
(op2) = *((INSTR_OneByteInt *)(AM_preg + INSTR_RI1X_I1)); \
AM_preg += INSTR_RI1X_LEN; \
}
//INSTR_CAT_RCEX
#define INSACC_RCEX(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCEX_R))); \
(op2) = AM_cenvVar(*((INSTR_ClEnvInd *)(AM_preg + INSTR_RCEX_CE))); \
AM_preg += INSTR_RCEX_LEN; \
}
//INSTR_CAT_ECEX
#define INSACC_ECEX(op1, op2) {\
(op1) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_ECEX_E))); \
(op2) = AM_cenvVar(*((INSTR_ClEnvInd *)(AM_preg + INSTR_ECEX_CE))); \
AM_preg += INSTR_ECEX_LEN; \
}
//INSTR_CAT_CLX
#define INSACC_CLX(op1, op2) {\
(op1) = *((INSTR_CstIndex *)(AM_preg + INSTR_CLX_C)); \
(op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_CLX_L)); \
AM_preg += INSTR_CLX_LEN; \
}
//INSTR_CAT_RKX
#define INSACC_RKX(op1, op2) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RKX_R))); \
(op2) = *((INSTR_KstIndex *)(AM_preg + INSTR_RKX_K)); \
AM_preg += INSTR_RKX_LEN; \
}
//INSTR_CAT_ECX
#define INSACC_ECX(op1, op2) {\
(op1) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_ECX_E))); \
(op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_ECX_C)); \
AM_preg += INSTR_ECX_LEN; \
}
//INSTR_CAT_I1ITX
#define INSACC_I1ITX(op1, op2) {\
(op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1ITX_I1)); \
(op2) = *((INSTR_ImplTab *)(AM_preg + INSTR_I1ITX_IT)); \
AM_preg += INSTR_I1ITX_LEN; \
}
//INSTR_CAT_I1LX
#define INSACC_I1LX(op1, op2) {\
(op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LX_I1)); \
(op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LX_L)); \
AM_preg += INSTR_I1LX_LEN; \
}
//INSTR_CAT_SEGLX
#define INSACC_SEGLX(op1, op2) {\
(op1) = *((INSTR_ImpSegInd *)(AM_preg + INSTR_SEGLX_SEG)); \
(op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_SEGLX_L)); \
AM_preg += INSTR_SEGLX_LEN; \
}
//INSTR_CAT_I1NX
#define INSACC_I1NX(op1, op2) {\
(op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1NX_I1)); \
(op2) = *((INSTR_NextClauseInd *)(AM_preg + INSTR_I1NX_N)); \
AM_preg += INSTR_I1NX_LEN; \
}
//INSTR_CAT_I1HTX
#define INSACC_I1HTX(op1, op2) {\
(op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1HTX_I1)); \
(op2) = *((INSTR_HashTab *)(AM_preg + INSTR_I1HTX_HT)); \
AM_preg += INSTR_I1HTX_LEN; \
}
//INSTR_CAT_I1BVTX
#define INSACC_I1BVTX(op1, op2) {\
(op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1BVTX_I1)); \
(op2) = *((INSTR_BranchTab *)(AM_preg + INSTR_I1BVTX_BVT)); \
AM_preg += INSTR_I1BVTX_LEN; \
}
//INSTR_CAT_CWPX
#define INSACC_CWPX(op) {\
(op) = *((INSTR_CstIndex *)(AM_preg + INSTR_CWPX_C)); \
AM_preg += INSTR_CWPX_LEN; \
}
//INSTR_CAT_I1WPX
#define INSACC_I1WPX(op) {\
(op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1WPX_I1)); \
AM_preg += INSTR_I1WPX_LEN; \
}
//INSTR_CAT_RRI1X
#define INSACC_RRI1X(op1, op2, op3) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRI1X_R1))); \
(op2) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRI1X_R2))); \
(op3) = *((INSTR_OneByteInt *)(AM_preg + INSTR_RRI1X_I1)); \
AM_preg += INSTR_RRI1X_LEN; \
}
//INSTR_CAT_RCLX
#define INSACC_RCLX(op1, op2, op3) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCLX_R))); \
(op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_RCLX_C)); \
(op3) = *((INSTR_CodeLabel *)(AM_preg + INSTR_RCLX_L)); \
AM_preg += INSTR_RCLX_LEN; \
}
//INSTR_CAT_RCI1X
#define INSACC_RCI1X(op1, op2, op3) {\
(op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCI1X_R))); \
(op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_RCI1X_C)); \
(op3) = *((INSTR_OneByteInt *)(AM_preg + INSTR_RCI1X_I1)); \
AM_preg += INSTR_RCI1X_LEN; \
}
//INSTR_CAT_SEGI1LX
#define INSACC_SEGI1LX(op1, op2, op3) {\
(op1) = *((INSTR_ImpSegInd *)(AM_preg + INSTR_SEGI1LX_SEG)); \
(op2) = *((INSTR_OneByteInt *)(AM_preg + INSTR_SEGI1LX_I1)); \
(op3) = *((INSTR_CodeLabel *)(AM_preg + INSTR_SEGI1LX_L)); \
AM_preg += INSTR_SEGI1LX_LEN; \
}
//specialized
//INSTR_CAT_LX
#define INSACC_LX() {AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LX_L));}
//INSTR_CAT_I1LX
#define INSACC_I1LX_I1(op) {\
(op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LX_I1)); \
}
//INSTR_CAT_I1LWPX
#define INSACC_I1LWPX_I1(op) {\
(op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LWPX_I1)); \
}
//INSACC_CAT_I1LLX
#define INSACC_I1LLX(op1, op2) {\
(op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LLX_I1)); \
(op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LLX_L1)); \
AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LLX_L2)); \
}
//INSACC_CAT_NLLX
#define INSACC_NLLX_N(op) {\
(op) = *((INSTR_NextClauseInd *)(AM_preg + INSTR_NLLX_N)); \
}
//INSTR_CAT_I1CWPX
#define INSACC_I1CWPX_C(op) {\
(op) = *((INSTR_CstIndex *)(AM_preg + INSTR_I1CWPX_C)); \
}
//INSTR_CAT_I1I1WPX
#define INSACC_I1I1WPX(op1) {\
(op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1I1WPX_I12)); \
AM_preg += INSTR_I1I1WPX_LEN; \
}
#endif //INSTRACCESS_H

53
src/runtime/c/teyjus/simulator/io-datastructures.c
View File

@@ -1,53 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File io-datastructures.c. *
* *
****************************************************************************/
#include "io-datastructures.h"
/* The io free term variable table */
IO_FreeVarInfo IO_freeVarTab[IO_MAX_FREE_VARS];
/* index for the topmost cell that has been used */
int IO_freeVarTabTop;
/* initialize */
void IO_initIO()
{
IO_freeVarTabTop = 0;
}
/* check if the free term variable table is full */
Boolean IO_freeVarTabFull(int incSize)
{
return (IO_freeVarTabTop+incSize >= IO_MAX_FREE_VARS);
}
/* make an entry in the free term variable table */
void IO_enterFreeVarTab(DF_StrDataPtr name, DF_TermPtr varLoc)
{
int i = IO_freeVarTabTop++;
IO_freeVarTab[i].varName = name;
IO_freeVarTab[i].rigdes = varLoc;
}

66
src/runtime/c/teyjus/simulator/io-datastructures.h
View File

@@ -1,66 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File io-datastructures.h. *
* *
****************************************************************************/
#ifndef IODATASTRUCTURES_H
#define IODATASTRUCTURES_H
#include "mcstring.h"
#include "dataformats.h"
#include "mctypes.h"
/*****************************************************************************
* A data structure for maintaining information about query term variables *
* and other free variables encountered in the course of displaying answers. *
*****************************************************************************/
/* number of entries in the table for such variables. */
#define IO_MAX_FREE_VARS 500
/* Structure of each entry in the table; display name, and the rigid
designator in the form of the memory cell corresponding to the variable are
maintained. */
typedef struct
{
DF_StrDataPtr varName;
DF_TermPtr rigdes;
} IO_FreeVarInfo;
/* The table itself */
extern IO_FreeVarInfo IO_freeVarTab[IO_MAX_FREE_VARS];
/* index for the topmost cell that has been used */
extern int IO_freeVarTabTop;
/* initialize */
void IO_initIO();
/* check if the free term variable table is full */
Boolean IO_freeVarTabFull(int incSize);
/* make an entry in the free term variable table */
void IO_enterFreeVarTab(DF_StrDataPtr name, DF_TermPtr varLoc);
#endif //IODATASTRUCTURES_H

116
src/runtime/c/teyjus/simulator/mcstring.c
View File

@@ -1,116 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File mcstring.c. */
/****************************************************************************/
#include <string.h>
#include <stdio.h>
#include <math.h>
#include "mcstring.h"
#include "mctypes.h"
//length of a given string; the string pointer is assumed to not be NULL
int MCSTR_strLength(MCSTR_Str str)
{
return *((int *)str);
}
//number of words needed for a string with n characters
int MCSTR_numWords(int n)
{
return ((int)ceil(((double)(n+1))/WORD_SIZE)) + 1; //with '\0' terminator
}
//from machine string to c string
char* MCSTR_toCString(MCSTR_Str str)
{
return (char*)(str + 1);
}
//to string
void MCSTR_toString(MCSTR_Str loc, char* buf, int length)
{
char* chloc = (char*)(loc + 1);
*((int *)loc) = length;
strcpy(chloc, buf);
}
//compare whether two string literals are the same
Boolean MCSTR_sameStrs(MCSTR_Str str1, MCSTR_Str str2)
{
if (strcmp((char*)(str1+1), (char*)(str2+1)) == 0) return TRUE;
else return FALSE;
}
/* compare strings: return < 0 if str1 < str2
return == 0 if str1 == str2
return > 0 if str1 > str2
*/
int MCSTR_compareStrs(MCSTR_Str str1, MCSTR_Str str2)
{
return strcmp((char*)(str1+1), (char*)(str2+1));
}
//string concatenate (the new string is created at address started from loc)
void MCSTR_concat(MCSTR_Str loc, MCSTR_Str str1, MCSTR_Str str2)
{
char* chloc = (char*)(loc + 1);
*((int *)loc) = MCSTR_strLength(str1) + MCSTR_strLength(str2);
strcpy(chloc, (char*)(str1+1));
strcat(chloc, (char*)(str2+1));
}
//substring (the new string is created at address started from loc)
void MCSTR_subString(MCSTR_Str loc, MCSTR_Str str, int startPos, int length)
{
int i;
char* fromPtr = ((char*)(str + 1))+startPos;
char* toPtr = (char*)(loc + 1);
*((int *)loc) = (length + 1);
while (length > 0) {
*toPtr++ = *fromPtr++;
length--;
}
*toPtr = '\0';
}
//chr
void MCSTR_chr(MCSTR_Str loc, int integer)
{
char* chloc = (char*)(loc + 1);
*((int *)loc) = 1;
*chloc++ = (char)integer;
*chloc = '\0';
}
//ord
int MCSTR_ord(MCSTR_Str str)
{
return (int)(*((char*)(str + 1)));
}
//display on standard IO
void MCSTR_printStr(MCSTR_Str str)
{
printf("%s", (char*)(str+1));
}

67
src/runtime/c/teyjus/simulator/mcstring.h
View File

@@ -1,67 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File mcstring.h. The virtual machine encoding of string literals is */
/* contained in this module. Any change of such encoding format should be */
/* isolated here. */
/****************************************************************************/
#ifndef MCSTRING_H
#define MCSTRING_H
#include "mctypes.h"
/****************************************************************************/
/* Currently the string is encoded as one word being the length of the */
/* string followed by a list of characters in C string encoding (which is a */
/* sequence of chars ended with '\0'. */
/****************************************************************************/
typedef char MCSTR_Char;
typedef WordPtr MCSTR_Str;
//length of a given string; the string pointer is assumed to not be NULL
int MCSTR_strLength(MCSTR_Str str);
//number of words needed for a string with n characters
int MCSTR_numWords(int n);
//from machine string to c string
char* MCSTR_toCString(MCSTR_Str str);
//to string
void MCSTR_toString(MCSTR_Str loc, char* buf, int length);
//compare whether two string literals are the same
Boolean MCSTR_sameStrs(MCSTR_Str str1, MCSTR_Str str2);
//compare strings
int MCSTR_compareStrs(MCSTR_Str str1, MCSTR_Str str2);
//string concatenate (the new string is created at address started from loc)
void MCSTR_concat(MCSTR_Str loc, MCSTR_Str str1, MCSTR_Str str2);
//substring (the new string is created at address started from loc)
void MCSTR_subString(MCSTR_Str loc, MCSTR_Str str, int startPos, int length);
//chr
void MCSTR_chr(MCSTR_Str loc, int integer);
//ord
int MCSTR_ord(MCSTR_Str str);
//display on standard IO
void MCSTR_printStr(MCSTR_Str str);
#endif //MCSTRING_H

54
src/runtime/c/teyjus/simulator/mctypes.h
View File

@@ -1,54 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* */
/* File mctypes.h. */
/* This file contains the definitions of the low-level */
/* data types that are used in constructing the more complex objects that */
/* are used in data representation and in instruction formats. This file */
/* will likely be included by most others defining the overall system. */
/* */
/****************************************************************************/
#ifndef MCTYPES_H
#define MCTYPES_H
typedef unsigned char Byte; /* 8 bits */
typedef unsigned short TwoBytes; /* 16 bits */
typedef unsigned char Boolean; /* 8 bits: FALSE/TRUE */
#define TRUE 1
#define FALSE 0
typedef unsigned long Word;
typedef Word *WordPtr;
#define WORD_SIZE sizeof(Word) /* 4: 32-bits machine */
/* 8 64-bits machine */
typedef Word Mem; /* generic memory type */
typedef Mem *MemPtr; /* pointer to memory */
typedef Byte *CSpacePtr; /* code space pointer */
typedef Byte *BytePtr;
#endif //MCTYPES_H

814
src/runtime/c/teyjus/simulator/printterm.c
View File

@@ -1,814 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File printterm.c. This file contains routines for printing out lambda *
* terms. It is assumed that these routines will be needed in two *
* situations: printing out answers to queries and displaying terms as *
* needed by invocation of builtin goals. *
* The difference between these two situations is in the display of *
* free term variables. Only when displaying answers is an attempt made to *
* present these using sensible names: in this case, either the name in the *
* query is used or a concise name is cooked up. In the other situation, *
* the address of the variable cell is used as the name. *
* *
* Certain assumptions are relevant to avoiding name clashes. For local *
* constants, the assumption is that no constant names in user *
* programs begin with <lc- and end with >. The use of this idea is *
* buried inside the routine PRINT_writeHCName. *
* Violation of this condition is *not* checked. For term variables, the *
* assumption is that bound variables do not begin with _. *
* *
****************************************************************************/
#include <stdlib.h>
#include <string.h>
#include "printterm.h"
#include "mctypes.h"
#include "mcstring.h"
#include "hnorm.h"
#include "dataformats.h"
#include "abstmachine.h"
#include "io-datastructures.h"
#include "builtins/builtins.h"
#include "../system/stream.h"
#include "../system/error.h"
#include "../system/operators.h"
#include "../tables/pervasives.h"
//temp
#include <stdio.h>
/* This variable records the number of query variables */
int PRINT_numQueryVars;
/* flag determining whether or not to print sensible names for free vars */
Boolean PRINT_names = FALSE;
static void PRINT_writeTerm(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType infx, int inprec, OP_TermContext tc);
/****************************************************************************
* Auxiliary routines used in this file *
****************************************************************************/
static Boolean PRINT_parenNeeded(OP_FixityType opfx, int opprec,
OP_TermContext context, OP_FixityType fx,
int prec)
{
Boolean pparen = FALSE;
if (context == OP_LEFT_TERM) {
switch (fx) {
case OP_INFIX: case OP_INFIXR: case OP_POSTFIX:
if (opprec <= prec) pparen = TRUE; break;
case OP_INFIXL: case OP_POSTFIXL:
{
switch (opfx) {
case OP_PREFIX: case OP_INFIX: case OP_INFIXL: case OP_POSTFIX:
case OP_POSTFIXL:
if (opprec < prec) pparen = TRUE; break;
default:
if (opprec <= prec) pparen = TRUE; break;
}
break;
}
default:
break;
}
} else if (context == OP_RIGHT_TERM) {
switch (fx) {
case OP_INFIX: case OP_INFIXL: case OP_PREFIX:
if (opprec <= prec) pparen = TRUE; break;
case OP_INFIXR: case OP_PREFIXR:
{
switch (opfx) {
case OP_INFIXL: case OP_POSTFIXL:
if (opprec <= prec) pparen = TRUE; break;
default:
if (opprec < prec) pparen = TRUE; break;
}
}
default:
break;
}
}
return pparen;
}
/* making a name from the address of an unbound term variable */
static long PRINT_makeNumberName(DF_TermPtr tmPtr)
{ return (long)tmPtr - (long)AM_heapBeg; }
/****************************************************************************
* Routines for printing out keywords and punctuation symbols in the course *
* of displaying lambda terms. These have been extracted out of the other *
* routines so as to make stylistic changes at a later point easier to *
* effect. *
****************************************************************************/
static void PRINT_writeLParen(WordPtr outStream)
{ STREAM_printf(outStream, "("); }
static void PRINT_writeRParen(WordPtr outStream)
{ STREAM_printf(outStream, ")"); }
static void PRINT_writeConsSymbol(WordPtr outStream)
{ STREAM_printf(outStream, " :: "); }
static void PRINT_writeNilSymbol(WordPtr outStream)
{ STREAM_printf(outStream, "nil"); }
static void PRINT_writeInfixLam(WordPtr outStream)
{ STREAM_printf(outStream, "\\ "); }
static void PRINT_writeSpace(WordPtr outStream, int i)
{ while (i--) STREAM_printf(outStream, " "); }
static void PRINT_writeEquals(WordPtr outStream)
{ STREAM_printf(outStream, " = "); }
static void PRINT_writeComma(WordPtr outStream)
{ STREAM_printf(outStream, ","); }
static void PRINT_writeDPairStart(WordPtr outStream)
{ STREAM_printf(outStream, "<"); }
static void PRINT_writeDPairEnd(WordPtr outStream)
{ STREAM_printf(outStream, ">"); }
/***************************************************************************
* Writing out terms corresponding to the builtin constants. *
***************************************************************************/
/* Writing out an integer term to a given output stream */
static void PRINT_writeInt(WordPtr outStream, DF_TermPtr tmPtr)
{ STREAM_printf(outStream, "%d", DF_intValue(tmPtr)); }
/* Writing out a float term to a given output stream */
static void PRINT_writeFloat(WordPtr outStream, DF_TermPtr tmPtr)
{ STREAM_printf(outStream, "%f", DF_floatValue(tmPtr)); }
/* Writing out a string term to a given output stream */
static void PRINT_writeString(WordPtr outStream, DF_TermPtr tmPtr)
{ STREAM_printf(outStream, "\"%s\"", MCSTR_toCString(DF_strValue(tmPtr))); }
/* Writing out a stream constant to a given output stream */
static void PRINT_writeStream(WordPtr outStream, DF_TermPtr tmPtr)
{
WordPtr stream = DF_streamTabIndex(tmPtr);
STREAM_printf(outStream, "<stream ");
if (stream == STREAM_ILLEGAL) STREAM_printf(outStream, "-- closed>");
else STREAM_printf(outStream, "-- \"%s\">", STREAM_getName(stream));
}
/****************************************************************************
* Writing out a constant. Use the index into the runtime constant table *
* stored in the constant to get the constant name if one exists. If one *
* does not exist, i.e. if the constant is a local or hidden one, look for *
* it in a list of constants. If it is not in this list, make up a new *
* name. Eventually, the name consists of three parts: a generic name for *
* hidden constants, a part based on the runtime table index and a part *
* based on the universe index. *
****************************************************************************/
/* A structure for maintaining information about local constants encountered
while printing; this structure enables the assignment of a unique integer
to each runtime symbol table slot for such a constant. */
typedef struct PRINT_ConstList_ *PRINT_ConstList;
struct PRINT_ConstList_
{
int constInd;
int count;
PRINT_ConstList next;
};
static PRINT_ConstList PRINT_clist = NULL;
static int PRINT_lccount = 0;
static void PRINT_cleanCList()
{
PRINT_ConstList tmp;
PRINT_lccount = 0;
while (PRINT_clist){
tmp = PRINT_clist;
PRINT_clist = PRINT_clist -> next;
free(tmp);
}
}
/* writing out a hidden (local) constant name; as side effect, a note may be
made of a new hidden (local) constant seen during this printing. */
static void PRINT_writeHCName(WordPtr outStream, int constInd, int uc)
{
PRINT_ConstList lclist = PRINT_clist;
while (lclist && (lclist->constInd != constInd)) lclist = lclist->next;
if (!lclist) {
lclist = (PRINT_ConstList)EM_malloc(sizeof(struct PRINT_ConstList_));
lclist->constInd = constInd;
lclist->count = PRINT_lccount++;
lclist->next = PRINT_clist;
PRINT_clist = lclist;
}
STREAM_printf(outStream, "<lc-%d-%d>", lclist->count, uc);
}
/* Writing out a constant, hidden or global. */
static void PRINT_writeConst(WordPtr outStream, DF_TermPtr tmPtr)
{
int constInd = DF_constTabIndex(tmPtr);
char* name = AM_cstName(constInd);
if (name) STREAM_printf(outStream, "%s", name);
else PRINT_writeHCName(outStream, constInd, DF_constUnivCount(tmPtr));
}
/****************************************************************************
* Writing out a free variable. Two situations are possible, one where a *
* symbolic name is to be produced and the other where the `address' could *
* serve as the name. In the first case, if the variable is a query *
* variable, then its name from the query is used. Otherwise a new name is *
* invented that is distinct from other free term variable names; the *
* initial segment of the name guarantees that it will be distinct from *
* that of bound variables. *
****************************************************************************/
/* counter used to generate free variable name */
static int PRINT_fvcounter = 1;
/* Create a free term variable name; this starts with _ has a standard
string prefix and then a digit sequence */
static DF_StrDataPtr PRINT_makeFVarName()
{
int digits = 0;
int i = PRINT_fvcounter;
int length;
char* cname;
DF_StrDataPtr fvname;
while(i) { digits++; i = i/10; }
length = digits + 3;
cname = (char*)EM_malloc(sizeof(char)*length);
cname[0] = '_';
cname[1] = 'T';
cname[length-1] = '\0';
i = PRINT_fvcounter;
while(i) {
cname[digits+1] = (i%10 + '0');
i = i/10;
digits--;
}
PRINT_fvcounter++;
fvname = (DF_StrDataPtr)EM_malloc(sizeof(Word)*(MCSTR_numWords(length) +
DF_STRDATA_HEAD_SIZE));
DF_mkStrDataHead((MemPtr)fvname);
MCSTR_toString((MemPtr)((MemPtr)fvname + DF_STRDATA_HEAD_SIZE),
cname, length);
free(cname);
return fvname;
}
/* Does a made up name occur in the free term variable table? Clash can
only occur with names in the user query */
static Boolean PRINT_nameInFVTab(DF_StrDataPtr name)
{
int i;
for (i = 0; i < PRINT_numQueryVars ; i++){
if (MCSTR_sameStrs(DF_strDataValue(name),
DF_strDataValue(IO_freeVarTab[i].varName)))
return TRUE;
}
return FALSE;
}
/* The main routine for printing out an unbound term variable */
static void PRINT_writeFVar(WordPtr outStream, DF_TermPtr tmPtr)
{
int fvind = 0;
DF_StrDataPtr fvname;
//PRINT_names = TRUE;
if (PRINT_names) {
IO_freeVarTab[IO_freeVarTabTop].rigdes = tmPtr;
while (tmPtr != IO_freeVarTab[fvind].rigdes) fvind++;
if (fvind == IO_freeVarTabTop) {
/* i.e., a free variable not seen before */
if (IO_freeVarTabTop == IO_MAX_FREE_VARS)
EM_error(BI_ERROR_TYFVAR_CAP);
while(1) {//make a name
fvname = PRINT_makeFVarName();
if (!PRINT_nameInFVTab(fvname)) break;
free(fvname);
}
IO_freeVarTab[fvind].varName = fvname;
IO_freeVarTabTop++;
}
STREAM_printf(outStream,
MCSTR_toCString(DF_strDataValue(IO_freeVarTab[fvind].varName)));
} else { //PRINT_names = FALSE
STREAM_printf(outStream, "_%ld", PRINT_makeNumberName(tmPtr));
}
}
/****************************************************************************
* Routines for writing out bound variables (in lambda abstraction and *
* bound variable occurrence) *
****************************************************************************/
/* prefix for bound variables */
static char* PRINT_bvname = "W";
/* a counter for determining the suffix part of bound variables */
static int PRINT_bvcounter = 1;
/* A structure for maintaining information about bound variable names */
typedef struct PRINT_BVList_ *PRINT_BVList;
struct PRINT_BVList_ {
DF_StrDataPtr name;
PRINT_BVList next; };
/* the initial list of bound variable names; initialized in SIM_InitIo */
static PRINT_BVList PRINT_bvs = NULL;
static void PRINT_cleanBV(PRINT_BVList bv)
{
free(bv->name);
free(bv);
}
/* releasing the space for bound variables; needed only in case of error
exit */
static void PRINT_cleanBVList()
{
PRINT_BVList tbvl;
PRINT_bvcounter = 1;
while (PRINT_bvs) {
tbvl = PRINT_bvs; PRINT_bvs = PRINT_bvs->next;
PRINT_cleanBV(tbvl);
}
}
/****************************************************************************
* Writing out a bound variable *
****************************************************************************/
static void PRINT_writeBVar(WordPtr outStream, DF_TermPtr tmPtr)
{
int i;
int bvind = DF_bvIndex(tmPtr);
PRINT_BVList lbvs = PRINT_bvs;
for (i = bvind; ((i != 1) && lbvs) ; i--)
lbvs = lbvs->next;
// Is this checking and the else branch really necessary?
// Printing should start from top-level closed terms?
if (lbvs) STREAM_printf(outStream, "%s",
MCSTR_toCString(DF_strDataValue(lbvs->name)));
else STREAM_printf(outStream, "#%d", i);
}
/****************************************************************************
* Writing out an empty list *
****************************************************************************/
static void PRINT_writeNil(WordPtr outStream)
{ PRINT_writeNilSymbol(outStream); }
/****************************************************************************
* Writing out a non-empty list. *
****************************************************************************/
static void PRINT_writeCons(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType fx, int prec, OP_TermContext tc)
{
DF_TermPtr args = DF_consArgs(tmPtr);
OP_FixityType consfix = (OP_FixityType)AM_cstFixity(PERV_CONS_INDEX);
int consprec = AM_cstPrecedence(PERV_CONS_INDEX);
Boolean pparen = PRINT_parenNeeded(consfix, consprec, tc, fx,prec);
if (pparen) PRINT_writeLParen(outStream);
PRINT_writeTerm(outStream, args, consfix, consprec, OP_LEFT_TERM);
PRINT_writeConsSymbol(outStream);
do {
args++;
tmPtr = DF_termDeref(args);
if (DF_termTag(tmPtr) != DF_TM_TAG_CONS) break;
args = DF_consArgs(tmPtr);
PRINT_writeTerm(outStream, args, consfix, consprec, OP_LEFT_TERM);
PRINT_writeConsSymbol(outStream);
} while(1);
PRINT_writeTerm(outStream, tmPtr, consfix, consprec, OP_RIGHT_TERM);
if (pparen) PRINT_writeRParen(outStream);
}
/****************************************************************************
* Writing out an abstraction. *
****************************************************************************/
/* creating a bound variable name with bound variable prefix followed by the*/
/* current bound variable counter value. */
static DF_StrDataPtr PRINT_makeBVarName()
{
int digits = 0;
int i = PRINT_bvcounter;
int length;
char* cname;
DF_StrDataPtr bvname;
while(i) { digits++; i = i/10; }
length = digits + 2;
cname = (char*)EM_malloc(sizeof(char)*length);
strcpy(cname, PRINT_bvname);
cname[length-1] = '\0';
i = PRINT_bvcounter;
while(i) {
cname[digits] = (i%10 + '0');
i = i/10;
digits--;
}
PRINT_bvcounter++;
bvname = (DF_StrDataPtr)EM_malloc(sizeof(Word)*(MCSTR_numWords(length) +
DF_STRDATA_HEAD_SIZE));
DF_mkStrDataHead((MemPtr)bvname);
MCSTR_toString((MemPtr)((MemPtr)bvname + DF_STRDATA_HEAD_SIZE),
cname, length);
free(cname);
return bvname;
}
static void PRINT_writeAbstBinders(WordPtr outStream, int nabs)
{
DF_StrDataPtr bvname;
PRINT_BVList tmpbvs;
while(nabs > 0) {
nabs--;
while(1) {//make a bvname not in FV table
bvname = PRINT_makeBVarName();
if (!PRINT_nameInFVTab(bvname)) break;
free(bvname);
}
//record the name into the head of the current bvlist
tmpbvs = (PRINT_BVList)EM_malloc(sizeof(struct PRINT_BVList_));
tmpbvs->name = bvname;
tmpbvs->next = PRINT_bvs;
PRINT_bvs = tmpbvs;
//write out binder
STREAM_printf(outStream, "%s", MCSTR_toCString(DF_strDataValue(bvname)));
PRINT_writeInfixLam(outStream);
}
}
static void PRINT_writeAbst(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType fx, int prec, OP_TermContext tc)
{
int numabs = 0;
Boolean pparen = PRINT_parenNeeded(OP_LAM_FIXITY,OP_LAM_PREC,tc,fx,prec);
PRINT_BVList tmpbvs;
int tmpbvc = PRINT_bvcounter;
if (pparen) PRINT_writeLParen(outStream);
while (DF_isLam(tmPtr)){
numabs += DF_lamNumAbs(tmPtr);
tmPtr = DF_termDeref(DF_lamBody(tmPtr));
}
PRINT_writeAbstBinders(outStream, numabs);
PRINT_writeTerm(outStream, tmPtr, OP_LAM_FIXITY,OP_LAM_PREC,OP_RIGHT_TERM);
if (pparen) PRINT_writeRParen(outStream);
while (numabs > 0) {
numabs--;
tmpbvs = PRINT_bvs;
PRINT_bvs = PRINT_bvs->next;
PRINT_cleanBV(tmpbvs);
}
PRINT_bvcounter = tmpbvc;
}
/****************************************************************************
* WRITING OUT AN APPLICATION *
* *
* Note that it is assumed that nested application structures are flattened *
* during the full normalization process. *
****************************************************************************/
/* Getting the fixity and precedence for the head of an application.
Assume the pointer to the term head is already dereferenced. */
static void PRINT_getHeadInfo(DF_TermPtr hdPtr, OP_FixityType *fx, int* prec)
{
int cstInd;
switch (DF_termTag(hdPtr)) {
case DF_TM_TAG_CONST:
cstInd = DF_constTabIndex(hdPtr);
if (AM_cstName(cstInd)) {
*fx = (OP_FixityType)AM_cstFixity(cstInd);
*prec = AM_cstPrecedence(cstInd);
} else {
*fx = OP_NONE;
*prec = 0;
}
break;
case DF_TM_TAG_VAR:
*fx = OP_NONE;
*prec = OP_MINPREC;
break;
case DF_TM_TAG_BVAR:
*fx = OP_NONE;
*prec = OP_MINPREC;
break;
}
}
/* Writing out a term with a prefix operator as head; we use the knowledge
that the operator must be a constant here and that the pointer to it is
fully dereferenced */
static void PRINT_writePrefixTerm(WordPtr outStream, DF_TermPtr head,
OP_FixityType opfx, int opprec,
OP_TermContext tc, OP_FixityType fx,int prec,
DF_TermPtr args)
{
Boolean pparen = PRINT_parenNeeded(opfx, opprec, tc, fx, prec);
if (pparen) PRINT_writeLParen(outStream);
PRINT_writeConst(outStream, head);
PRINT_writeSpace(outStream, 1);
PRINT_writeTerm(outStream, args, opfx, opprec, OP_RIGHT_TERM);
if (pparen) PRINT_writeRParen(outStream);
}
static void PRINT_writeInfixTerm(WordPtr outStream, DF_TermPtr head,
OP_FixityType opfx, int opprec,
OP_TermContext tc, OP_FixityType fx, int prec,
DF_TermPtr args)
{
Boolean pparen = PRINT_parenNeeded(opfx, opprec, tc, fx, prec);
if(pparen) PRINT_writeLParen(outStream);
PRINT_writeTerm(outStream, args, opfx, opprec, OP_LEFT_TERM);
PRINT_writeSpace(outStream, 1);
PRINT_writeConst(outStream, head);
PRINT_writeSpace(outStream, 1);
PRINT_writeTerm(outStream, args+1, opfx, opprec, OP_RIGHT_TERM);
if (pparen) PRINT_writeRParen(outStream);
}
static void PRINT_writePostfixTerm(WordPtr outStream, DF_TermPtr head,
OP_FixityType opfx, int opprec,
OP_TermContext tc,OP_FixityType fx,int prec,
DF_TermPtr args)
{
Boolean pparen = PRINT_parenNeeded(opfx, opprec, tc, fx, prec);
if(pparen) PRINT_writeLParen(outStream);
PRINT_writeTerm(outStream, args, opfx, opprec, OP_LEFT_TERM);
PRINT_writeSpace(outStream, 1);
PRINT_writeConst(outStream, head);
if (pparen) PRINT_writeRParen(outStream);
}
/* Main routine for writing out an application term */
static void PRINT_writeApp(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType infx, int inprec, OP_TermContext tc)
{
DF_TermPtr head = DF_termDeref(DF_appFunc(tmPtr));
DF_TermPtr args = DF_appArgs(tmPtr);
int arity = DF_appArity(tmPtr);
Boolean pparen = PRINT_parenNeeded(OP_APP_FIXITY, OP_APP_PREC, tc, infx,
inprec);
OP_FixityType fix = 0;
int prec = 0;
HN_hnorm(tmPtr);
PRINT_getHeadInfo(AM_head, &fix, &prec);
switch(fix){
case OP_PREFIX: case OP_PREFIXR:
if (arity == 1) {
pparen = FALSE;
PRINT_writePrefixTerm(outStream, head, fix, prec, tc, infx, inprec,
args);
} else {
if (pparen) PRINT_writeLParen(outStream);
PRINT_writePrefixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
OP_APP_FIXITY, OP_APP_PREC, args);
}
arity--; args++;
break;
case OP_INFIX: case OP_INFIXL: case OP_INFIXR:
if (arity == 2) {
pparen = FALSE;
PRINT_writeInfixTerm(outStream, head, fix, prec, tc, infx, inprec,
args);
} else {
if (pparen) PRINT_writeLParen(outStream);
PRINT_writeInfixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
OP_APP_FIXITY, OP_APP_PREC, args);
}
arity -= 2; args += 2;
break;
case OP_POSTFIX: case OP_POSTFIXL:
if (arity == 1) {
pparen = FALSE;
PRINT_writePostfixTerm(outStream, head, fix, prec, tc, infx,
inprec, args);
} else {
if (pparen) PRINT_writeLParen(outStream);
PRINT_writePostfixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
OP_APP_FIXITY, OP_APP_PREC, args);
}
break;
case OP_NONE:
if (pparen) PRINT_writeLParen(outStream);
PRINT_writeTerm(outStream,head,OP_APP_FIXITY,OP_APP_PREC,OP_LEFT_TERM);
break;
} /*switch*/
/* print the arguments (if any) of the application */
while (arity > 0) {
PRINT_writeSpace(outStream, 1);
PRINT_writeTerm(outStream, args, OP_APP_FIXITY, OP_APP_PREC,
OP_RIGHT_TERM);
args++;
arity--;
}
if (pparen) PRINT_writeRParen(outStream);
}
/*****************************************************************************
* The main routine for writing out a term; this is called by the interface *
* routines to do the real job of printing. *
*****************************************************************************/
static void PRINT_writeTerm(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType infx, int inprec, OP_TermContext tc)
{
tmPtr = DF_termDeref(tmPtr);
switch (DF_termTag(tmPtr)) {
case DF_TM_TAG_INT: PRINT_writeInt(outStream, tmPtr); break;
case DF_TM_TAG_FLOAT: PRINT_writeFloat(outStream, tmPtr); break;
case DF_TM_TAG_STR: PRINT_writeString(outStream, tmPtr); break;
case DF_TM_TAG_STREAM: PRINT_writeStream(outStream, tmPtr); break;
case DF_TM_TAG_CONST: PRINT_writeConst(outStream, tmPtr); break;
case DF_TM_TAG_VAR: PRINT_writeFVar(outStream, tmPtr); break;
case DF_TM_TAG_BVAR: PRINT_writeBVar(outStream, tmPtr); break;
case DF_TM_TAG_NIL: PRINT_writeNil(outStream); break;
case DF_TM_TAG_CONS:
PRINT_writeCons(outStream, tmPtr, infx, inprec, tc); break;
case DF_TM_TAG_LAM:
PRINT_writeAbst(outStream, tmPtr, infx, inprec, tc); break;
case DF_TM_TAG_APP:
PRINT_writeApp(outStream, tmPtr, infx, inprec, tc); break;
} /* switch */
}
/* Printing a term to a specified output stream; names will be invented for
free variables if the boolean variable PRINT_names is set. */
void PRINT_fPrintTerm(WordPtr outStream, DF_TermPtr tmPtr)
{
HN_lnorm(tmPtr);
PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
}
/* Printing routine for debugging */
void PRINT_printTerm(DF_TermPtr tmPtr)
{
PRINT_fPrintTerm(STREAM_stdout, tmPtr);
STREAM_printf(STREAM_stdout, "\n");
}
/* printing an answer substitution pair */
static void PRINT_printSubsPair(WordPtr outStream, int ind)
{
DF_TermPtr tmPtr;
char *varName =
MCSTR_toCString(DF_strDataValue(IO_freeVarTab[ind].varName));
/* print the variable name if it is not an anonymous variable */
if (strcmp(varName, "_") != 0) {
STREAM_printf(outStream, varName);
/* Print the equals sign */
PRINT_writeEquals(outStream);
/* Print the binding of the variable */
tmPtr = IO_freeVarTab[ind].rigdes;
HN_lnorm(tmPtr);
PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
}
}
void PRINT_showAnswerSubs()
{
int i;
PRINT_names = TRUE;
for (i = 0; i < PRINT_numQueryVars; i++) {
PRINT_printSubsPair(STREAM_stdout, i);
STREAM_printf(STREAM_stdout, "\n");
}
}
/* Printing a disagreement pair to a specified output stream */
static void PRINT_printDPair(WordPtr outStream, DF_DisPairPtr dpair)
{
DF_TermPtr tmPtr;
PRINT_writeDPairStart(outStream);
tmPtr = DF_disPairFirstTerm(dpair);
HN_lnorm(tmPtr);
PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
PRINT_writeComma(outStream);
PRINT_writeSpace(outStream, 1);
tmPtr = DF_disPairSecondTerm(dpair);
HN_lnorm(tmPtr);
PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
PRINT_writeDPairEnd(outStream);
}
void PRINT_showDisAgreeList()
{
DF_DisPairPtr liveList = AM_llreg;
while (DF_isNEmpDisSet(liveList)) {
PRINT_printDPair(STREAM_stdout, liveList);
liveList = DF_disPairNext(liveList);
STREAM_printf(STREAM_stdout, "\n");
}
}
void PRINT_setQueryFreeVariables()
{
PRINT_numQueryVars = IO_freeVarTabTop;
}
/* Use this function to reset the top of the free variable table
after a read; this is logical and also needed to avoid trying
to release print name space accidentally at some other point. */
void PRINT_resetFreeVarTab()
{
IO_freeVarTabTop = PRINT_numQueryVars;
}
void PRINT_resetPrintState()
{
/* release space for term variables created during printing */
while (IO_freeVarTabTop > PRINT_numQueryVars){
IO_freeVarTabTop--;
free(IO_freeVarTab[IO_freeVarTabTop].varName);
}
/* reset counters used in names of anonymous term and type variables */
PRINT_fvcounter = 1;
/* free space for information created for local consts and reset counter */
PRINT_cleanCList();
/* free space for information created for bound vars and reset counter */
PRINT_cleanBVList();
}
Boolean PRINT_queryHasVars()
{
int i = PRINT_numQueryVars - 1;
while (!(i < 0) &&
(strcmp(MCSTR_toCString(DF_strDataValue(IO_freeVarTab[i].varName)),
"_") == 0))
i--;
if (i < 0) return FALSE;
else return TRUE;
}

62
src/runtime/c/teyjus/simulator/printterm.h
View File

@@ -1,62 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File printterm.h{c}. This file contains routines for printing out lambda *
* terms. It is assumed that these routines will be needed in two *
* situations: printing out answers to queries and displaying terms as *
* needed by invocation of builtin goals. *
* The difference between these two situations is in the display of *
* free term variables. Only when displaying answers is an attempt made to *
* present these using sensible names: in this case, either the name in the *
* query is used or a concise name is cooked up. In the other situation, *
* the address of the variable cell is used as the name. *
* *
* Certain assumptions are relevant to avoiding name clashes. For local *
* constants, the assumption is that no constant names in user *
* programs begin with <lc- and end with >. The use of this idea is *
* buried inside the routine PRINT_writeHCName. *
* Violation of this condition is *not* checked. For term variables, the *
* assumption is that bound variables do not begin with _. *
* *
****************************************************************************/
#ifndef PRINTTERM_H
#define PRINTTERM_H
#include "dataformats.h"
#include "mctypes.h"
/* set this variable to FALSE if variable names are to be displayed as
`numbers' */
extern Boolean PRINT_names;
void PRINT_fPrintTerm(WordPtr outStream, DF_TermPtr tmPtr);
void PRINT_showAnswerSubs();
void PRINT_showDisAgreeList();
void PRINT_resetFreeVarTab();
void PRINT_setQueryFreeVariables();
void PRINT_resetPrintState();
Boolean PRINT_queryHasVars();
//for debugging (display on stdout )
void PRINT_printTerm(DF_TermPtr tmPtr);
#endif //PRINTTERM_H

160
src/runtime/c/teyjus/simulator/simdispatch.c
View File

@@ -1,160 +0,0 @@
/***************************************************************************/
/* */
/* File simdispatch.c. The instruction dispatch table used by the */
/* simulator is defined here as an array of function pointers, each of */
/* which refers to a function realizing a corresponding instruction. */
/* These functions are defined in the file ./siminstr.c. */
/***************************************************************************/
#include "../tables/instructions.h" //to be modified
#include "siminstr.h"
#include "simdispatch.h"
SDP_InstrFunctionPtr SDP_dispatchTable[INSTR_NUM_INSTRS] = {
SINSTR_put_variable_t,
SINSTR_put_variable_p,
SINSTR_put_value_t,
SINSTR_put_value_p,
SINSTR_put_unsafe_value,
SINSTR_copy_value,
SINSTR_put_m_const,
SINSTR_put_p_const,
SINSTR_put_nil,
SINSTR_put_integer,
SINSTR_put_float,
SINSTR_put_string,
SINSTR_put_index,
SINSTR_put_app,
SINSTR_put_list,
SINSTR_put_lambda,
SINSTR_set_variable_t,
SINSTR_set_variable_te,
SINSTR_set_variable_p,
SINSTR_set_value_t,
SINSTR_set_value_p,
SINSTR_globalize_pt,
SINSTR_globalize_t,
SINSTR_set_m_const,
SINSTR_set_p_const,
SINSTR_set_nil,
SINSTR_set_integer,
SINSTR_set_float,
SINSTR_set_string,
SINSTR_set_index,
SINSTR_set_void,
SINSTR_deref,
SINSTR_set_lambda,
SINSTR_get_variable_t,
SINSTR_get_variable_p,
SINSTR_init_variable_t,
SINSTR_init_variable_p,
SINSTR_get_m_constant,
SINSTR_get_p_constant,
SINSTR_get_integer,
SINSTR_get_float,
SINSTR_get_string,
SINSTR_get_nil,
SINSTR_get_m_structure,
SINSTR_get_p_structure,
SINSTR_get_list,
SINSTR_unify_variable_t,
SINSTR_unify_variable_p,
SINSTR_unify_value_t,
SINSTR_unify_value_p,
SINSTR_unify_local_value_t,
SINSTR_unify_local_value_p,
SINSTR_unify_m_constant,
SINSTR_unify_p_constant,
SINSTR_unify_integer,
SINSTR_unify_float,
SINSTR_unify_string,
SINSTR_unify_nil,
SINSTR_unify_void,
SINSTR_put_type_variable_t,
SINSTR_put_type_variable_p,
SINSTR_put_type_value_t,
SINSTR_put_type_value_p,
SINSTR_put_type_unsafe_value,
SINSTR_put_type_const,
SINSTR_put_type_structure,
SINSTR_put_type_arrow,
SINSTR_set_type_variable_t,
SINSTR_set_type_variable_p,
SINSTR_set_type_value_t,
SINSTR_set_type_value_p,
SINSTR_set_type_local_value_t,
SINSTR_set_type_local_value_p,
SINSTR_set_type_constant,
SINSTR_get_type_variable_t,
SINSTR_get_type_variable_p,
SINSTR_init_type_variable_t,
SINSTR_init_type_variable_p,
SINSTR_get_type_value_t,
SINSTR_get_type_value_p,
SINSTR_get_type_constant,
SINSTR_get_type_structure,
SINSTR_get_type_arrow,
SINSTR_unify_type_variable_t,
SINSTR_unify_type_variable_p,
SINSTR_unify_type_value_t,
SINSTR_unify_type_value_p,
SINSTR_unify_envty_value_t,
SINSTR_unify_envty_value_p,
SINSTR_unify_type_local_value_t,
SINSTR_unify_type_local_value_p,
SINSTR_unify_envty_local_value_t,
SINSTR_unify_envty_local_value_p,
SINSTR_unify_type_constant,
SINSTR_pattern_unify_t,
SINSTR_pattern_unify_p,
SINSTR_finish_unify,
SINSTR_head_normalize_t,
SINSTR_head_normalize_p,
SINSTR_incr_universe,
SINSTR_decr_universe,
SINSTR_set_univ_tag,
SINSTR_tag_exists_t,
SINSTR_tag_exists_p,
SINSTR_tag_variable,
SINSTR_push_impl_point,
SINSTR_pop_impl_point,
SINSTR_add_imports,
SINSTR_remove_imports,
SINSTR_push_import,
SINSTR_pop_imports,
SINSTR_allocate,
SINSTR_deallocate,
SINSTR_call,
SINSTR_call_name,
SINSTR_execute,
SINSTR_execute_name,
SINSTR_proceed,
SINSTR_try_me_else,
SINSTR_retry_me_else,
SINSTR_trust_me,
SINSTR_try,
SINSTR_retry,
SINSTR_trust,
SINSTR_trust_ext,
SINSTR_try_else,
SINSTR_retry_else,
SINSTR_branch,
SINSTR_switch_on_term,
SINSTR_switch_on_constant,
SINSTR_switch_on_bvar,
SINSTR_switch_on_reg,
SINSTR_neck_cut,
SINSTR_get_level,
SINSTR_put_level,
SINSTR_cut,
SINSTR_call_builtin,
SINSTR_builtin,
SINSTR_stop,
SINSTR_halt,
SINSTR_fail,
SINSTR_create_type_variable,
SINSTR_execute_link_only,
SINSTR_call_link_only,
SINSTR_put_variable_te
};

37
src/runtime/c/teyjus/simulator/simdispatch.h
View File

@@ -1,37 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/***************************************************************************/
/* */
/* File simdispatch.h. The instruction dispatch table used by the */
/* simulator is defined here as an array of function pointers, each of */
/* which refers to a function realizing a corresponding instruction. */
/* These functions are defined in the file ./siminstr.c. */
/***************************************************************************/
#ifndef SIMDISPATCH_H
#define SIMDISPATCH_H
//the function pointer type of instructions
typedef void (* SDP_InstrFunctionPtr)();
//instruction dispatch table
extern SDP_InstrFunctionPtr SDP_dispatchTable[];
#endif //SIMDISPATCH_H

275
src/runtime/c/teyjus/simulator/siminit.c
View File

@@ -1,275 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/**************************************************************************/
/* */
/* File siminit.c. */
/**************************************************************************/
#ifndef SIMINIT_C
#define SIMINIT_C
#include "siminit.h"
#include "abstmachine.h"
#include "dataformats.h"
#include "io-datastructures.h"
#include "builtins/builtins.h"
#include "../tables/instructions.h"
#include "../system/error.h"
#include "../system/message.h"
#include <stdio.h>
/***************************######********************************************
* ERROR INFORMATION
*********************************######**************************************/
static MSG_Msg SIM_errorMessages[SIM_NUM_ERROR_MESSAGES] =
{
{ SIM_ERROR,
0,
"Simulator: ",
0, 0, 0 },
{ SIM_ERROR_TOO_MANY_ABSTRACTIONS,
SIM_ERROR,
"Abstraction embedding depth has exceeded maximum of %d.",
EM_NEWLINE, EM_TOP_LEVEL, 4 },
{ SIM_ERROR_TOO_MANY_ARGUMENTS,
SIM_ERROR,
"Application arguments has exceeded maximum of %d.",
EM_NEWLINE, EM_TOP_LEVEL, 4 },
{ SIM_ERROR_TOO_MANY_UNIV_QUANTS,
SIM_ERROR,
"Too many universal quantifiers.",
EM_NEWLINE, EM_TOP_LEVEL, 3 },
{ SIM_ERROR_HEAP_TOO_BIG,
SIM_ERROR,
"Specified heap size (%uK) is larger than maximum of 256Gb.",
EM_NEWLINE, EM_ABORT, 1 },
{ SIM_ERROR_HEAP_TOO_SMALL,
SIM_ERROR,
"Specified heap size (%uK) is smaller than minimum of 10K.",
EM_NEWLINE, EM_ABORT, 1 },
{ SIM_ERROR_CANNOT_ALLOCATE_HEAP,
SIM_ERROR_CANNOT_ALLOCATE_HEAP_MESSAGE,
"",
SIM_ERROR_CANNOT_ALLOCATE_HEAP_SUGGESTION, EM_ABORT, 1 },
{ SIM_ERROR_CANNOT_ALLOCATE_HEAP_MESSAGE,
SIM_ERROR,
"Could not allocate heap of size %uK at 0x%08x using %s.",
EM_NEWLINE, EM_NO_EXN, 1 },
{ SIM_ERROR_CANNOT_ALLOCATE_HEAP_SUGGESTION,
SIM_ERROR,
"Try modifying the configuration and recompiling.",
EM_NEWLINE, EM_NO_EXN, 1 },
{ SIM_ERROR_TRAIL_OVERFL,
SIM_ERROR,
"Trail overflow.",
EM_NEWLINE, EM_TOP_LEVEL, 1 },
{ SIM_ERROR_HEAP_OVERFL,
SIM_ERROR,
"Heap overflow.",
EM_NEWLINE, EM_TOP_LEVEL, 1 },
{ SIM_ERROR_STACK_OVERFL,
SIM_ERROR,
"Stack overflow.",
EM_NEWLINE, EM_TOP_LEVEL, 1 },
{ SIM_ERROR_PDL_OVERFL,
SIM_ERROR,
"PDL overflow.",
EM_NEWLINE, EM_TOP_LEVEL, 1 }
};
/*************************************************************************/
/* SETTING UP SPECIAL CODE SEGMENTS */
/*************************************************************************/
static const int SINIT_initSize = 31;
static void SINIT_initCode()
{
MemPtr nhreg = AM_hreg + SINIT_initSize;
CSpacePtr myhreg = (CSpacePtr)AM_hreg;
AM_heapError(nhreg);
//builtinCode
AM_builtinCode = myhreg;
*((INSTR_OpCode*)myhreg) = builtin; //builtin ...
myhreg += INSTR_I1X_LEN;
//eqCode
AM_eqCode = myhreg;
*((INSTR_OpCode*)myhreg) = pattern_unify_t; //pattern_unify A1, A2
*((INSTR_RegInd*)(myhreg + INSTR_RRX_R1)) = 1;
*((INSTR_RegInd*)(myhreg + INSTR_RRX_R2)) = 2;
myhreg += INSTR_RRX_LEN;
*((INSTR_OpCode*)myhreg) = finish_unify; //finish_unify
myhreg += INSTR_X_LEN;
*((INSTR_OpCode*)myhreg) = proceed; //proceed
myhreg += INSTR_X_LEN;
//failCode
AM_failCode = myhreg;
*((INSTR_OpCode*)myhreg) = fail; //fail
myhreg += INSTR_X_LEN;
//andCode
*((INSTR_OneByteInt*)(myhreg + INSTR_I1LX_I1)) = 2;//"call" 2 L
myhreg += INSTR_I1LX_LEN;
AM_andCode = myhreg;
*((INSTR_OpCode*)myhreg) = put_value_p; //put_value Y1, A1
*((INSTR_EnvInd*)(myhreg + INSTR_ERX_E)) = 1;
*((INSTR_RegInd*)(myhreg + INSTR_ERX_R)) = 1;
myhreg += INSTR_ERX_LEN;
*((INSTR_OpCode*)myhreg) = put_level; //put_level Y2
*((INSTR_EnvInd*)(myhreg + INSTR_EX_E)) = 2;
myhreg += INSTR_EX_LEN;
*((INSTR_OpCode*)myhreg) = deallocate; //deallocate
myhreg += INSTR_X_LEN;
//solveCode
AM_solveCode = myhreg;
*((INSTR_OpCode*)myhreg) = builtin; //builtin BI_SOLVE
*((INSTR_OneByteInt*)(myhreg + INSTR_I1X_I1)) = BI_SOLVE;
myhreg += INSTR_I1X_LEN;
//proceed
AM_proceedCode = myhreg; //proceed
*((INSTR_OpCode*)myhreg) = proceed;
myhreg += INSTR_X_LEN;
//orCode
AM_orCode = myhreg;
*((INSTR_OpCode*)myhreg) = trust_me; //trust_me 1
*((INSTR_OneByteInt*)(myhreg + INSTR_I1WPX_I1)) = 1;
myhreg += INSTR_I1WPX_LEN;
*((INSTR_OpCode*)myhreg) = builtin; //builtin BI_SOLVE
*((INSTR_OneByteInt*)(myhreg + INSTR_I1X_I1)) = BI_SOLVE;
myhreg += INSTR_I1X_LEN;
//allcode
*((INSTR_OneByteInt*)(myhreg + INSTR_I1LX_I1)) = 0; //"call" 0 L
myhreg += INSTR_I1LX_LEN;
AM_allCode = myhreg;
*((INSTR_OpCode*)myhreg) = decr_universe; //decr_universe
myhreg += INSTR_X_LEN;
*((INSTR_OpCode*)myhreg) = deallocate; //deallocate
myhreg += INSTR_X_LEN;
*((INSTR_OpCode*)myhreg) = proceed; //proceed
myhreg += INSTR_X_LEN;
//stopCode
AM_stopCode = myhreg;
*((INSTR_OpCode*)myhreg) = stop; //stop
myhreg += INSTR_X_LEN;
//notCode2
AM_notCode2 = myhreg;
*((INSTR_OpCode*)myhreg) = trust_me; //trust_me 0
*((INSTR_OneByteInt*)(myhreg + INSTR_I1WPX_I1)) = 0;
myhreg += INSTR_I1WPX_LEN;
*((INSTR_OpCode*)myhreg) = proceed; //proceed
myhreg += INSTR_X_LEN;
//notCode1
AM_notCode1 = myhreg;
*((INSTR_OpCode*)myhreg) = allocate; //allocate 2
*((INSTR_OneByteInt*)(myhreg + INSTR_I1X_I1)) = 2;
myhreg += INSTR_I1X_LEN;
*((INSTR_OpCode*)myhreg) = get_level; //get_level Y1
*((INSTR_EnvInd*)(myhreg + INSTR_EX_E)) = 1;
myhreg += INSTR_EX_LEN;
*((INSTR_OpCode*)myhreg) = call_builtin; //call_builtin 1 BI_SOLVE
*((INSTR_OneByteInt*)(myhreg + INSTR_I1I1WPX_I11)) = 1;
*((INSTR_OneByteInt*)(myhreg + INSTR_I1I1WPX_I12)) = BI_SOLVE;
myhreg += INSTR_I1I1WPX_LEN;
*((INSTR_OpCode*)myhreg) = cut; //cut 1
*((INSTR_EnvInd*)(myhreg + INSTR_EX_E)) = 1;
myhreg += INSTR_EX_LEN;
*((INSTR_OpCode*)myhreg) = fail; //fail
myhreg += INSTR_X_LEN;
//haltCode
AM_haltCode = myhreg;
*((INSTR_OpCode*)myhreg) = halt; //halt
myhreg += INSTR_X_LEN;
AM_hreg = nhreg;
}
/*****************************************************************************
* THE PUBLIC ROUTINES *
*****************************************************************************/
void SINIT_preInit()
{
/* errors get initialized before ANYTHING */
MSG_addMessages(SIM_NUM_ERROR_MESSAGES, SIM_errorMessages);
}
void SINIT_simInit()
{
AM_hreg = AM_heapBeg; //heap
AM_hbreg = AM_heapBeg;
AM_ereg = AM_stackBeg; //stack
AM_ireg = AM_stackBeg;
AM_cireg = AM_stackBeg;
AM_initPDL(); //pdl
AM_trreg = AM_trailBeg; //trail
AM_llreg = DF_EMPTY_DIS_SET; //live list
AM_bndFlag = OFF; //bind flag
AM_ucreg = 0; //uc reg
//make a dummy first mod point at the beginning of the stack
AM_mkDummyImptRec(AM_ireg);
/* perform initialization for the term io system */
IO_initIO();
/* and set up some built-in code */
SINIT_initCode();
/* set up the base branch register to put the heap back to this point */
AM_breg = AM_stackBeg + AM_DUMMY_IMPT_REC_SIZE;
*AM_breg = (Mem)AM_hreg;
AM_fstCP = AM_b0reg = AM_breg;
AM_tosreg = AM_breg + 1;
}
void SINIT_reInitSimState(Boolean inDoInitializeImports)
{
AM_initPDL(); //pdl
AM_ereg = AM_stackBeg; //stack
AM_trreg = AM_trailBeg; //trail
AM_llreg = DF_EMPTY_DIS_SET; //live list
AM_ucreg = 0; //uc reg
AM_bndFlag = OFF; //bind flag
AM_breg = AM_fstCP;
AM_hreg = AM_cpH();
AM_hreg = *((MemPtr *)AM_breg);
/* initialize ireg if necessary */
if (inDoInitializeImports) {
AM_ireg = AM_stackBeg;
AM_tosreg = AM_breg + 1;
}
IO_initIO();
}
#endif //SIMINIT_H

33
src/runtime/c/teyjus/simulator/siminit.h
View File

@@ -1,33 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/**************************************************************************/
/* */
/* File siminit.h. */
/**************************************************************************/
#ifndef SIMINIT_H
#define SIMINIT_H
#include "mctypes.h"
void SINIT_preInit();
void SINIT_simInit();
void SINIT_reInitSimState(Boolean inDoInitializeImports);
#endif //SIMUINIT_H

1846
src/runtime/c/teyjus/simulator/siminstr.c
View File

File diff suppressed because it is too large Load Diff

248
src/runtime/c/teyjus/simulator/siminstr.h
View File

@@ -1,248 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* */
/* File siminstr.h. The instruction set of the virtual machine. */
/*****************************************************************************/
#ifndef SIMINSTR_H
#define SIMINSTR_H
/*****************************************************************************/
/* INSTRUCTIONS FOR UNIFYING AND CREATING TERMS */
/*****************************************************************************/
/**********************************************************/
/* PUT CLASS */
/**********************************************************/
void SINSTR_put_variable_t();
void SINSTR_put_variable_te();
void SINSTR_put_variable_p();
void SINSTR_put_value_t();
void SINSTR_put_value_p();
void SINSTR_put_unsafe_value();
void SINSTR_copy_value();
void SINSTR_put_m_const();
void SINSTR_put_p_const();
void SINSTR_put_nil();
void SINSTR_put_integer();
void SINSTR_put_float();
void SINSTR_put_string();
void SINSTR_put_index();
void SINSTR_put_app();
void SINSTR_put_list();
void SINSTR_put_lambda();
/**********************************************************/
/* SET CLASS */
/**********************************************************/
void SINSTR_set_variable_t();
void SINSTR_set_variable_te();
void SINSTR_set_variable_p();
void SINSTR_set_value_t();
void SINSTR_set_value_p();
void SINSTR_globalize_pt();
void SINSTR_globalize_t();
void SINSTR_set_m_const();
void SINSTR_set_p_const();
void SINSTR_set_nil();
void SINSTR_set_integer();
void SINSTR_set_float();
void SINSTR_set_string();
void SINSTR_set_index();
void SINSTR_set_void();
//needed?
void SINSTR_deref();
void SINSTR_set_lambda();
/**********************************************************/
/* GET CLASS */
/**********************************************************/
void SINSTR_get_variable_t();
void SINSTR_get_variable_p();
void SINSTR_init_variable_t();
void SINSTR_init_variable_p();
void SINSTR_get_m_constant();
void SINSTR_get_p_constant();
void SINSTR_get_integer();
void SINSTR_get_float();
void SINSTR_get_string();
void SINSTR_get_nil();
void SINSTR_get_m_structure();
void SINSTR_get_p_structure();
void SINSTR_get_list();
/**********************************************************/
/* UNIFY CLASS */
/**********************************************************/
void SINSTR_unify_variable_t();
void SINSTR_unify_variable_p();
void SINSTR_unify_value_t();
void SINSTR_unify_value_p();
void SINSTR_unify_local_value_t();
void SINSTR_unify_local_value_p();
void SINSTR_unify_m_constant();
void SINSTR_unify_p_constant();
void SINSTR_unify_nil();
void SINSTR_unify_integer();
void SINSTR_unify_float();
void SINSTR_unify_string();
void SINSTR_unify_void();
/*****************************************************************************/
/* INSTRUCTIONS FOR UNIFYING AND CREATING TYPES */
/*****************************************************************************/
/**********************************************************/
/* PUT CLASS */
/**********************************************************/
void SINSTR_put_type_variable_t();
void SINSTR_put_type_variable_p();
void SINSTR_put_type_value_t();
void SINSTR_put_type_value_p();
void SINSTR_put_type_unsafe_value();
void SINSTR_put_type_const();
void SINSTR_put_type_structure();
void SINSTR_put_type_arrow();
/**********************************************************/
/* SET CLASS */
/**********************************************************/
void SINSTR_set_type_variable_t();
void SINSTR_set_type_variable_p();
void SINSTR_set_type_value_t();
void SINSTR_set_type_value_p();
void SINSTR_set_type_local_value_t();
void SINSTR_set_type_local_value_p();
void SINSTR_set_type_constant();
/**********************************************************/
/* GET CLASS */
/**********************************************************/
void SINSTR_get_type_variable_t();
void SINSTR_get_type_variable_p();
void SINSTR_init_type_variable_t();
void SINSTR_init_type_variable_p();
void SINSTR_get_type_value_t();
void SINSTR_get_type_value_p();
void SINSTR_get_type_constant();
void SINSTR_get_type_structure();
void SINSTR_get_type_arrow();
/**********************************************************/
/* UNIFY CLASS */
/**********************************************************/
void SINSTR_unify_type_variable_t();
void SINSTR_unify_type_variable_p();
void SINSTR_unify_type_value_t();
void SINSTR_unify_type_value_p();
void SINSTR_unify_envty_value_t();
void SINSTR_unify_envty_value_p();
void SINSTR_unify_type_local_value_t();
void SINSTR_unify_type_local_value_p();
void SINSTR_unify_envty_local_value_t();
void SINSTR_unify_envty_local_value_p();
void SINSTR_unify_type_constant();
/* init type var for implication goal */
void SINSTR_create_type_variable();
/*****************************************************************************/
/* HIGHER-ORDER INSTRUCTIONS */
/*****************************************************************************/
void SINSTR_pattern_unify_t();
void SINSTR_pattern_unify_p();
void SINSTR_finish_unify();
void SINSTR_head_normalize_t();
void SINSTR_head_normalize_p();
/*****************************************************************************/
/* LOGICAL INSTRUCTIONS */
/*****************************************************************************/
void SINSTR_incr_universe();
void SINSTR_decr_universe();
void SINSTR_set_univ_tag();
void SINSTR_tag_exists_t();
void SINSTR_tag_exists_p();
void SINSTR_tag_variable();
void SINSTR_push_impl_point();
void SINSTR_pop_impl_point();
void SINSTR_add_imports();
void SINSTR_remove_imports();
void SINSTR_push_import();
void SINSTR_pop_imports();
/*****************************************************************************/
/* CONTROL INSTRUCTIONS */
/*****************************************************************************/
void SINSTR_allocate();
void SINSTR_deallocate();
void SINSTR_call();
void SINSTR_call_name();
void SINSTR_execute();
void SINSTR_execute_name();
void SINSTR_proceed();
/*****************************************************************************/
/* CHOICE INSTRUCTIONS */
/*****************************************************************************/
void SINSTR_try_me_else();
void SINSTR_retry_me_else();
void SINSTR_trust_me();
void SINSTR_try();
void SINSTR_retry();
void SINSTR_trust();
void SINSTR_trust_ext();
void SINSTR_try_else();
void SINSTR_retry_else();
void SINSTR_branch();
/*****************************************************************************/
/* INDEXING INSTRUCTIONS */
/*****************************************************************************/
void SINSTR_switch_on_term();
void SINSTR_switch_on_constant();
void SINSTR_switch_on_bvar();
void SINSTR_switch_on_reg();
/*****************************************************************************/
/* CUT INSTRUCTIONS */
/*****************************************************************************/
void SINSTR_neck_cut();
void SINSTR_get_level();
void SINSTR_put_level();
void SINSTR_cut();
/*****************************************************************************/
/* MISCELLANEOUS INSTRUCTIONS */
/*****************************************************************************/
void SINSTR_call_builtin();
void SINSTR_builtin();
void SINSTR_stop();
void SINSTR_halt();
void SINSTR_fail();
/**************************************************************************/
/* linker only */
/**************************************************************************/
void SINSTR_execute_link_only();
void SINSTR_call_link_only();
#endif //SIMINSTR_H

583
src/runtime/c/teyjus/simulator/siminstrlocal.c
View File

@@ -1,583 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/***************************************************************************/
/* */
/* File siminstrlocal.c. This file contains the definitions of auxiliary */
/* functions used in siminstr.c. */
/***************************************************************************/
#include "siminstrlocal.h"
#include "dataformats.h"
#include "abstmachine.h"
#include "trail.h"
#include "hnorm.h"
#include "hopu.h"
#include "../system/error.h" //to be modified
#include <stdio.h> //to be removed
//Bind a free variable to a constant (without type association)
//Note the BND register is set to ON
static void SINSTRL_bindConst(DF_TermPtr varPtr, int c)
{
TR_trailTerm(varPtr);
DF_mkConst((MemPtr)varPtr, AM_cstUnivCount(c), c);
AM_bndFlag = ON;
}
//Bind a free variable to an integer
//Note the BND register is set to ON
static void SINSTRL_bindInt(DF_TermPtr varPtr, int i)
{
TR_trailTerm(varPtr);
DF_mkInt((MemPtr)varPtr, i);
AM_bndFlag = ON;
}
//Bind a free variable to a float
//Note the BND register is set to ON
static void SINSTRL_bindFloat(DF_TermPtr varPtr, float f)
{
TR_trailTerm(varPtr);
DF_mkFloat((MemPtr)varPtr, f);
AM_bndFlag = ON;
}
//Bind a free variable to a string
//Note the BND register is set to ON
void SINSTRL_bindString(DF_TermPtr varPtr, DF_StrDataPtr str)
{
TR_trailTerm(varPtr);
DF_mkStr((MemPtr)varPtr, str);
AM_bndFlag = ON;
}
//Bind a free variable to a constant with type association
//Note the BND register is set to ON; the TYWIRTE mode is set to ON
static void SINSTRL_bindTConst(DF_TermPtr varPtr, int c)
{
MemPtr nhreg = AM_hreg + DF_TM_TCONST_SIZE;
AM_heapError(nhreg + DF_TY_ATOMIC_SIZE * AM_cstTyEnvSize(c));
DF_mkTConst(AM_hreg, AM_cstUnivCount(c), c, (DF_TypePtr)nhreg);
TR_trailTerm(varPtr);
DF_mkRef((MemPtr)varPtr, (DF_TermPtr)AM_hreg);
AM_hreg = nhreg;
AM_bndFlag = ON;
AM_tyWriteFlag = ON;
}
//Bind a free variable to nil
//Note the BND register is set to ON
static void SINSTRL_bindNil(DF_TermPtr varPtr)
{
TR_trailTerm(varPtr);
DF_mkNil((MemPtr)varPtr);
AM_bndFlag = ON;
}
//Bind a free variable to an application object with a non-type-associated
//constant head.
//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
// 3)indicating the occurrence of binding (BND = ON).
void SINSTRL_bindStr(DF_TermPtr varPtr, int constInd, int arity)
{
MemPtr args = AM_hreg + DF_TM_APP_SIZE;
MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
MemPtr nhreg = func + DF_TM_ATOMIC_SIZE; //new heap top
AM_heapError(nhreg);
DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
DF_mkConst(func, AM_cstUnivCount(constInd), constInd); //mk const
//enter WRITE mode
AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON;
//enter OCC mode
AM_adjreg = DF_fvUnivCount(varPtr); AM_vbbreg = (DF_TermPtr)AM_hreg;
AM_ocFlag = ON;
//performing binding
TR_trailTerm(varPtr);
DF_mkRef((MemPtr)varPtr, (DF_TermPtr)AM_hreg);
AM_bndFlag = ON;
AM_hreg = nhreg;
}
//Bind a free variable to an application object with a type-associated
//constant head.
//Setting relevant registers for 1)entering WRITE and TYWRITE mode 2)entering
// OCC mode 3)indicating the occurrence of binding (BND = ON).
void SINSTRL_bindTStr(DF_TermPtr varPtr, int constInd, int arity)
{
MemPtr args = AM_hreg + DF_TM_APP_SIZE;
MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
MemPtr nhreg = func + DF_TM_TCONST_SIZE; //new heap top
AM_heapError(nhreg + AM_cstTyEnvSize(constInd) + DF_TY_ATOMIC_SIZE);
DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
DF_mkTConst(func, AM_cstUnivCount(constInd), constInd, (DF_TypePtr)nhreg);
//enter WRITE and TYWRITE mode
AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON; AM_tyWriteFlag = ON;
//enter OCC mode
AM_adjreg = DF_fvUnivCount(varPtr); AM_vbbreg = (DF_TermPtr)AM_hreg;
AM_ocFlag = ON;
//perform binding
TR_trailTerm(varPtr);
DF_mkRef((MemPtr)varPtr, (DF_TermPtr)AM_hreg);
AM_bndFlag = ON;
AM_hreg = nhreg;
}
//Bind a free variable to a list cons.
//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
// 3)indicating the occurrence of binding (BND = ON).
void SINSTRL_bindCons(DF_TermPtr varPtr)
{
MemPtr nhreg = AM_hreg + DF_CONS_ARITY * DF_TM_ATOMIC_SIZE; //new heap top
AM_heapError(nhreg);
//enter WRITE mode
AM_sreg = (DF_TermPtr)AM_hreg; AM_writeFlag = ON;
//enter OCC mode
AM_adjreg = DF_fvUnivCount(varPtr); AM_vbbreg = (DF_TermPtr)AM_hreg;
AM_ocFlag = ON;
//perform binding
TR_trailTerm(varPtr);
DF_mkCons((MemPtr)varPtr, AM_sreg);
AM_bndFlag = ON;
AM_hreg = nhreg;
}
// Delay a pair (onto the PDL stack) with a given term as the first, and a
// constant (without type association) as the second.
// Note this function is invoked in get_m_constant() when the 'dynamic' term
// is higher-order, and so it is guaranteed that tPtr is a heap address.
static void SINSTRL_delayConst(DF_TermPtr tPtr, int c)
{
MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
AM_heapError(nhreg);
DF_mkConst(AM_hreg, AM_cstUnivCount(c), c);
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
AM_hreg = nhreg;
}
//Delay a pair (onto the PDL stack) with a given term as the first, and a
//constant with type association the second.
//Note TYWRITE mode is set to ON.
static void SINSTRL_delayTConst(DF_TermPtr tPtr, int c)
{
MemPtr nhreg = AM_hreg + DF_TM_TCONST_SIZE;
AM_heapError(nhreg + DF_TY_ATOMIC_SIZE * AM_cstTyEnvSize(c));
DF_mkTConst(AM_hreg, AM_cstUnivCount(c), c, (DF_TypePtr)nhreg);
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
AM_hreg = nhreg;
AM_tyWriteFlag = ON;
}
//Delay a pair (onto the PDL stack) with a given term and an integer
static void SINSTRL_delayInt(DF_TermPtr tPtr, int i)
{
MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
AM_heapError(nhreg);
DF_mkInt(AM_hreg, i);
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
AM_hreg = nhreg;
}
//Delay a pair (onto the PDL stack) with a given term and a float
static void SINSTRL_delayFloat(DF_TermPtr tPtr, float f)
{
MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
AM_heapError(nhreg);
DF_mkFloat(AM_hreg, f);
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
AM_hreg = nhreg;
}
//Delay a pair (onto the PDL stack) with a given term and a string
static void SINSTRL_delayString(DF_TermPtr tPtr, DF_StrDataPtr str)
{
MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
AM_heapError(nhreg);
DF_mkStr(AM_hreg, str);
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
AM_hreg = nhreg;
}
//Delay a pair (onto the PDL stack) with a given term and nil list
static void SINSTRL_delayNil(DF_TermPtr tPtr)
{
MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
AM_heapError(nhreg);
DF_mkNil(AM_hreg);
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
AM_hreg = nhreg;
}
//Delay a pair (onto the PDL stack) with a given term and an application
//object with a non-type-associated constant head.
//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
//mode; 3) ADJ
void SINSTRL_delayStr(DF_TermPtr tPtr, int constInd, int arity)
{
MemPtr args = AM_hreg + DF_TM_APP_SIZE;
MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
MemPtr nhreg = func + DF_TM_ATOMIC_SIZE;
AM_heapError(nhreg);
DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
DF_mkConst(func, AM_cstUnivCount(constInd), constInd); //mk const
//push onto PDL
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
//enter WRITE mode
AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON;
//enter OCC OFF mode
AM_ocFlag = OFF;
AM_adjreg = AM_ucreg;
AM_hreg = nhreg;
}
//Delay a pair (onto the PDL stack) with a given term and an application
//object with a type-associated constant head.
//Setting registers 1)entering WRITE and TYWRITE mode: S, WRITE and TYWRITE;
// 2)entering OCC OFF mode; 3) ADJ
void SINSTRL_delayTStr(DF_TermPtr tPtr, int constInd, int arity)
{
MemPtr args = AM_hreg + DF_TM_APP_SIZE;
MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
MemPtr nhreg = func + DF_TM_TCONST_SIZE;
AM_heapError(nhreg + AM_cstTyEnvSize(constInd) + DF_TY_ATOMIC_SIZE);
DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
DF_mkTConst(func, AM_cstUnivCount(constInd), constInd, (DF_TypePtr)nhreg);
//push onto PDL
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
//enter WRITE and TYWRITE mode
AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON; AM_tyWriteFlag = ON;
//enter OCC OFF mode
AM_ocFlag = OFF;
AM_adjreg = AM_ucreg;
AM_hreg = nhreg;
}
//Delay a pair (onto the PDL stack) with a given term and a list cons
//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
//mode; 3) ADJ
void SINSTRL_delayCons(DF_TermPtr tPtr)
{
MemPtr args = AM_hreg + DF_TM_ATOMIC_SIZE;
MemPtr nhreg = args + DF_CONS_ARITY * DF_TM_ATOMIC_SIZE;
AM_heapError(nhreg);
DF_mkCons(AM_hreg, (DF_TermPtr)args);
//push onto PDL
AM_pdlError(2);
AM_pushPDL((MemPtr)tPtr);
AM_pushPDL(AM_hreg);
//enter WRITE mode
AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON;
//enter OCC OFF mode
AM_ocFlag = OFF;
AM_adjreg = AM_ucreg;
AM_hreg = nhreg;
}
/*The main action of unify_value in write mode. This code carries out the */
/*necessary occurs checking in the binding of a variable that has already */
/*commenced through an enclosing get_structure instruction. */
/*Care has been taken to avoid making a reference to a register or stack */
/*address. */
void SINSTRL_bindSreg(DF_TermPtr tmPtr)
{
DF_TermPtr bndBody;
int nabs;
HN_hnormOcc(tmPtr);
nabs = AM_numAbs;
HOPU_copyFlagGlb = FALSE;
if (AM_rigFlag) {
bndBody = HOPU_rigNestedSubstC(AM_head, HOPU_lamBody(tmPtr), AM_argVec,
AM_numArgs, nabs);
if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody); //no emb error
else {
if (HOPU_copyFlagGlb) DF_mkRef((MemPtr)AM_sreg, bndBody);
else HOPU_globalizeCopyRigid(bndBody, AM_sreg);
}
} else { //AM_rigFlag = FALSE
bndBody = HOPU_flexNestedSubstC(AM_head, AM_argVec, AM_numArgs,
HOPU_lamBody(tmPtr), nabs);
if (HOPU_copyFlagGlb == FALSE) bndBody = HOPU_globalizeFlex(bndBody);
if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody);
else DF_mkRef((MemPtr)AM_sreg, bndBody);
}
}
/*The main component of unify_local_value in write mode when it is determined */
/*that we are dealing with a heap cell. */
void SINSTRL_bindSregH(DF_TermPtr tmPtr)
{
DF_TermPtr bndBody;
int nabs;
HN_hnormOcc(tmPtr);
nabs = AM_numAbs;
HOPU_copyFlagGlb = FALSE;
if (AM_rigFlag) {
bndBody = HOPU_rigNestedSubstC(AM_head, HOPU_lamBody(tmPtr), AM_argVec,
AM_numArgs, nabs);
if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody);
else DF_mkRef((MemPtr)AM_sreg, bndBody);
} else { //AM_rigFlag = FALSE
bndBody = HOPU_flexNestedSubstC(AM_head, AM_argVec, AM_numArgs,
HOPU_lamBody(tmPtr), nabs);
if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody);
else DF_mkRef((MemPtr)AM_sreg, bndBody);
}
}
/*****************************************************************************/
/* Auxiliary functions for unifying terms used in get- and unify- instrutions*/
/*****************************************************************************/
//attempting to unify a dereference term with a constant without type assoc
void SINSTRL_unifyConst(DF_TermPtr tmPtr, int constInd)
{
switch (DF_termTag(tmPtr)) {
case DF_TM_TAG_VAR:
{
if (DF_fvUnivCount(tmPtr)<AM_cstUnivCount(constInd)) EM_THROW(EM_FAIL);
SINSTRL_bindConst(tmPtr, constInd);
return;
}
case DF_TM_TAG_CONST:
{
if (constInd != DF_constTabIndex(tmPtr)) EM_THROW(EM_FAIL);
return;
}
case DF_TM_TAG_APP:
{
if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
}
case DF_TM_TAG_LAM: case DF_TM_TAG_SUSP: //and other APP cases
{
HN_hnorm(tmPtr);
if (AM_rigFlag) {
if (DF_isConst(AM_head) && (DF_constTabIndex(AM_head) == constInd)){
if (AM_numAbs != AM_numArgs) EM_THROW(EM_FAIL);
if (AM_numAbs != 0) SINSTRL_delayConst(tmPtr, constInd);//h-ord
} else EM_THROW(EM_FAIL);
} else { // (AM_rigFlag == OFF)
if (AM_numArgs == 0) {
if ((AM_numAbs == 0) &&
(DF_fvUnivCount(AM_head) >= AM_cstUnivCount(constInd)))
SINSTRL_bindConst(AM_head, constInd);
else EM_THROW(EM_FAIL);
} else SINSTRL_delayConst(tmPtr, constInd); //higher-order
} // (AM_rigFlag == OFF)
return;
}
default:{ EM_THROW(EM_FAIL); } //CONS, NIL, BVAR, INT, FLOAT, STR, (STREAM)
} //switch
}
//attempting to unify a dereferenced term with an integer
void SINSTRL_unifyInt(DF_TermPtr tmPtr, int intValue)
{
switch (DF_termTag(tmPtr)) {
case DF_TM_TAG_VAR: { SINSTRL_bindInt(tmPtr, intValue); return; }
case DF_TM_TAG_INT:
{
if (intValue != DF_intValue(tmPtr)) EM_THROW(EM_FAIL);
return;
}
case DF_TM_TAG_APP:
{ //Note the functor of app cannot be an integer per well-typedness
if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
}
case DF_TM_TAG_SUSP: //and other APP cases
{ // Note ABS cannot occur due to well-typedness
HN_hnorm(tmPtr);
if (AM_rigFlag) {
if (DF_isInt(AM_head) && (DF_intValue(AM_head) == intValue)) return;
else EM_THROW(EM_FAIL);
} else { //(AM_rigFlag == OFF)
if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
SINSTRL_bindInt(AM_head, intValue);
else SINSTRL_delayInt(tmPtr, intValue);
return;
} //(AM_rigFlag == OFF)
}
default: { EM_THROW(EM_FAIL); } //BVAR, CONST
} //switch
}
//attempting to unify a dereferenced term with a real number
void SINSTRL_unifyFloat(DF_TermPtr tmPtr, float floatValue)
{
switch (DF_termTag(tmPtr)){
case DF_TM_TAG_VAR: { SINSTRL_bindFloat(tmPtr, floatValue); return; }
case DF_TM_TAG_FLOAT:
{
if (floatValue != DF_floatValue(tmPtr)) EM_THROW(EM_FAIL);
return;
}
case DF_TM_TAG_APP:
{ //Note the functor of app cannot be a float per well-typedness
if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
}
case DF_TM_TAG_SUSP: //other APP cases
{ //Note ABS cannot occur due to well-typedness
HN_hnorm(tmPtr);
if (AM_rigFlag) {
if (DF_isFloat(AM_head) && (DF_floatValue(AM_head) == floatValue))
return;
else EM_THROW(EM_FAIL);
} else { //(AM_rigFlag == OFF)
if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
SINSTRL_bindFloat(AM_head, floatValue);
else SINSTRL_delayFloat(tmPtr, floatValue);
return;
} //(AM_rigFlag == OFF)
}
default: { EM_THROW(EM_FAIL); } //BVAR, CONST
} //switch
}
//attempting to unify a dereferenced term with a string
void SINSTRL_unifyString(DF_TermPtr tmPtr, DF_StrDataPtr str)
{
switch (DF_termTag(tmPtr)){
case DF_TM_TAG_VAR: { SINSTRL_bindString(tmPtr, str); return; }
case DF_TM_TAG_STR:
{
if (!DF_sameStrData(tmPtr, str)) EM_THROW(EM_FAIL);
return;
}
case DF_TM_TAG_APP:
{ //Note the functor of app cannot be a string per well-typedness
if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
}
case DF_TM_TAG_SUSP: //and other APP cases
{ //Note ABS cannot occur due to well-typedness
HN_hnorm(tmPtr);
if (AM_rigFlag) {
if (DF_isStr(AM_head) && (DF_sameStrData(AM_head, str))) return;
else EM_THROW(EM_FAIL);
} else {//(AM_rigFlag == OFF)
if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
SINSTRL_bindString(AM_head, str);
else SINSTRL_delayString(tmPtr, str);
return;
} //(AM_rigFlag == OFF)
}
default: { EM_THROW(EM_FAIL); } //BVAR, CONST
} //switch
}
//attempting to unify a dereferenced term with a constant with type assoc
void SINSTRL_unifyTConst(DF_TermPtr tmPtr, int constInd, CSpacePtr label)
{
switch (DF_termTag(tmPtr)) {
case DF_TM_TAG_VAR:
{
if (DF_fvUnivCount(tmPtr)<AM_cstUnivCount(constInd)) EM_THROW(EM_FAIL);
SINSTRL_bindTConst(tmPtr, constInd);
return;
}
case DF_TM_TAG_CONST:
{
if (constInd != DF_constTabIndex(tmPtr)) EM_THROW(EM_FAIL);
AM_preg = label;
return;
}
case DF_TM_TAG_APP:
{
if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
}
case DF_TM_TAG_LAM: case DF_TM_TAG_SUSP: //other APP cases
{
HN_hnorm(tmPtr);
if (AM_rigFlag) {
if (DF_isConst(AM_head) && (DF_constTabIndex(AM_head) == constInd)){
if (AM_numAbs != AM_numArgs) EM_THROW(EM_FAIL);
if (AM_numAbs == 0) AM_preg = label; //first-order
else SINSTRL_delayTConst(tmPtr, constInd); //higher-order
} else EM_THROW(EM_FAIL);
} else { //(AM_rigFlag == OFF)
if (AM_numAbs == 0) {
if ((AM_numAbs == 0) &&
(DF_fvUnivCount(AM_head) >= AM_cstUnivCount(constInd)))
SINSTRL_bindTConst(AM_head, constInd);
else EM_THROW(EM_FAIL);
} else SINSTRL_delayTConst(tmPtr, constInd); //higher-order
} //(AM_rigFlag == OFF)
return;
}
default: { EM_THROW(EM_FAIL); } //CONS, NIL, BVAR, INT, FLOAT, STR, (STREAM)
} //switch
}
//attempting to unify a dereferenced term with a nil list
void SINSTRL_unifyNil(DF_TermPtr tmPtr)
{
switch (DF_termTag(tmPtr)){
case DF_TM_TAG_VAR: { SINSTRL_bindNil(tmPtr); return; }
case DF_TM_TAG_NIL: { return; }
case DF_TM_TAG_CONS: { EM_THROW(EM_FAIL);}
case DF_TM_TAG_APP:
{
if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
}
case DF_TM_TAG_SUSP: //and other APP cases
{ //Note ABS cannot occur due to well-typedness
HN_hnorm(tmPtr);
if (AM_consFlag) EM_THROW(EM_FAIL);
if (AM_rigFlag) {
if (DF_isNil(AM_head)) return;
EM_THROW(EM_FAIL);
} else { //(AM_rigFlag == OFF)
if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
SINSTRL_bindNil(AM_head);
else SINSTRL_delayNil(tmPtr);
return;
} //(AM_rigFlag == OFF)
}
default: { EM_THROW(EM_FAIL); }//BVAR, CONST, CONS
} //switch
}

99
src/runtime/c/teyjus/simulator/siminstrlocal.h
View File

@@ -1,99 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/***************************************************************************/
/* */
/* File siminstrlocal.h. This file contains the declarations of auxiliary */
/* functions used in siminstr.c. */
/***************************************************************************/
#ifndef SIMINSTRL_H
#define SIMINSTRL_H
#include "dataformats.h"
/*****************************************************************************/
/* Auxiliary functions for unifying terms used in get- and unify- instrutions*/
/*****************************************************************************/
//attempting to unify a dereferenced term with a constant without type assoc
void SINSTRL_unifyConst(DF_TermPtr tmPtr, int constInd);
//attempting to unify a dereferenced term with an integer
void SINSTRL_unifyInt(DF_TermPtr tmPtr, int intValue);
//attempting to unify a dereferenced term with a real number
void SINSTRL_unifyFloat(DF_TermPtr tmPtr, float floatValue);
//attempting to unify a dereferenced term with a string
void SINSTRL_unifyString(DF_TermPtr tmPtr, DF_StrDataPtr str);
//attempting to unify a dereferenced term with a constant with type assoc
void SINSTRL_unifyTConst(DF_TermPtr tmPtr, int constInd, CSpacePtr label);
//attempting to unify a dereferenced term with a nil list
void SINSTRL_unifyNil(DF_TermPtr tmPtr);
//Bind a free variable to an application object with a non-type-associated
//constant head.
//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
// 3)indicating the occurrence of binding (BND = ON).
void SINSTRL_bindStr(DF_TermPtr varPtr, int constInd, int arity);
//Bind a free variable to an application object with a type-associated
//constant head.
//Setting relevant registers for 1)entering WRITE and TYWRITE mode 2)entering
// OCC mode 3)indicating the occurrence of binding (BND = ON).
void SINSTRL_bindTStr(DF_TermPtr varPtr, int constInd, int arity);
//Bind a free variable to a list cons.
//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
// 3)indicating the occurrence of binding (BND = ON).
void SINSTRL_bindCons(DF_TermPtr varPtr);
//Delay a pair (onto the PDL stack) with a given term and an application
//object with a non-type-associated constant head.
//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
//mode; 3) ADJ
void SINSTRL_delayStr(DF_TermPtr tPtr, int constInd, int arity);
//Delay a pair (onto the PDL stack) with a given term and an application
//object with a type-associated constant head.
//Setting registers 1)entering WRITE and TYWRITE mode: S, WRITE and TYWRITE;
// 2)entering OCC OFF mode; 3) ADJ
void SINSTRL_delayTStr(DF_TermPtr tPtr, int constInd, int arity);
//Delay a pair (onto the PDL stack) with a given term and a list cons
//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
//mode; 3) ADJ
void SINSTRL_delayCons(DF_TermPtr tPtr);
/*The main action of unify_value in write mode. This code carries out the */
/*necessary occurs checking in the binding of a variable that has already */
/*commenced through an enclosing get_structure instruction. */
/*Care has been taken to avoid making a reference to a register or stack */
/*address. */
void SINSTRL_bindSreg(DF_TermPtr tmPtr);
/*The main component of unify_local_value in write mode when it is determined */
/*that we are dealing with a heap cell. */
void SINSTRL_bindSregH(DF_TermPtr tmPtr);
#endif //SIMINSTRL_H

62
src/runtime/c/teyjus/simulator/simulator.c
View File

@@ -1,62 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File simulator.c. This file contains the procedure that emulates the *
* lambda Prolog abstract machine. *
****************************************************************************/
#ifndef SIMULATOR_C
#define SIMULATOR_C
#include "simdispatch.h"
#include "abstmachine.h"
#include "trail.h"
#include "../system/error.h" //to be modified
#include "../tables/instructions.h" //to be modified
#include <stdio.h> //temp
void SIM_simulate()
{
restart_loop:
EM_TRY {
while(1) {
/*fprintf(stderr, "AM_preg %u opcode: %d\n", AM_preg,
*((INSTR_OpCode *)AM_preg)); */
SDP_dispatchTable[*((INSTR_OpCode *)AM_preg)]();
}
/* it's expected that this statement not be reached: the only
way out of this while loop is by an exception */
} EM_CATCH {
if (EM_CurrentExnType == EM_FAIL) {
if (AM_botCP()) EM_RETHROW();
else {
TR_unwindTrail(AM_cpTR());
AM_initPDL();
AM_bndFlag = OFF;
AM_preg = AM_cpNCL();
goto restart_loop;
}
} else EM_RETHROW();
}
}
#endif /* SIMULATOR_C */

32
src/runtime/c/teyjus/simulator/simulator.h
View File

@@ -1,32 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File simulator.h. This ``header'' file identifies the functions defined *
* in simulator.c that are exported from there. *
* *
****************************************************************************/
#ifndef SIMULATOR_H
#define SIMULATOR_H
void SIM_simulate();
#endif /* SIMULATOR_H */

141
src/runtime/c/teyjus/simulator/trail.c
View File

@@ -1,141 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File trail.c. This file defines the trail operations including */
/* trailing and unwinding. */
/* */
/****************************************************************************/
#ifndef TRAIL_C
#define TRAIL_C
#include "trail.h"
static int TR_trailItemTag(TR_TrailItem *trPtr) { return (trPtr -> tag); }
static MemPtr TR_trailItemAddr(TR_TrailItem *trPtr) { return (trPtr -> addr);}
/***************************************************************************/
/* TRAILING FUNCTIONS */
/***************************************************************************/
void TR_trailTerm(DF_TermPtr addr) //trailing a term of atomic size
{
if (((MemPtr)addr <= AM_hbreg) ||
((AM_hreg < (MemPtr)addr) && ((MemPtr)addr < AM_breg))) {
AM_trailError(TR_TRAIL_TERM_SIZE);
DF_copyAtomic(addr, AM_trreg);
((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE))->tag = TR_TAG_TERM;
((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE))->addr = (MemPtr)addr;
AM_trreg += TR_TRAIL_TERM_SIZE;
}
}
void TR_trailHTerm(DF_TermPtr addr) //trailing a heap term of atomic size
{
if ((MemPtr)addr < AM_hbreg) {
AM_trailError(TR_TRAIL_TERM_SIZE);
DF_copyAtomic(addr, AM_trreg);
((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> tag = TR_TAG_TERM;
((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> addr = (MemPtr)addr;
AM_trreg += TR_TRAIL_TERM_SIZE;
}
}
void TR_trailETerm(DF_TermPtr addr) //trailing a stack term
{
if ((MemPtr)addr < AM_breg) {
AM_trailError(TR_TRAIL_TERM_SIZE);
DF_copyAtomic(addr, AM_trreg);
((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> tag = TR_TAG_TERM;
((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> addr = (MemPtr)addr;
AM_trreg += TR_TRAIL_TERM_SIZE;
}
}
void TR_trailType(DF_TypePtr addr) //trailing a type (free variable)
{
if (((MemPtr)addr < AM_hbreg) ||
((AM_hreg < (MemPtr)addr) && ((MemPtr)addr < AM_breg))){
AM_trailError(TR_TRAIL_TYPE_SIZE);
((TR_TrailItem*)AM_trreg) -> tag = TR_TAG_TYPE;
((TR_TrailItem*)AM_trreg) -> addr = (MemPtr)addr;
AM_trreg += TR_TRAIL_TYPE_SIZE;
}
}
//temp
void TR_trailImport(MemPtr addr) //trailing a backchained field
{
AM_trailError(TR_TRAIL_MOD_SIZE);
*AM_trreg = *addr;
*(AM_trreg+1) = *(addr+1);
((TR_TrailItem*)(AM_trreg+2)) -> tag = TR_TAG_MOD;
((TR_TrailItem*)(AM_trreg+2)) -> addr = addr;
AM_trreg += TR_TRAIL_MOD_SIZE;
}
/****************************************************************************/
/* UNWIND TRAIL FUNCTION */
/****************************************************************************/
void TR_unwindTrail(MemPtr trOld)
{
MemPtr addr;
while (AM_trreg > trOld){
AM_trreg -= TR_TRAIL_ITEM_HEAD_SIZE;
addr = TR_trailItemAddr((TR_TrailItem*)AM_trreg);
switch (TR_trailItemTag((TR_TrailItem*)AM_trreg)){
case TR_TAG_TERM:
{
AM_trreg -= DF_TM_ATOMIC_SIZE;
DF_copyAtomic((DF_TermPtr)AM_trreg, addr);
break;
}
case TR_TAG_MULTERM1:
{
AM_trreg -= DF_TM_APP_SIZE;
DF_copyApp((DF_TermPtr)AM_trreg, addr);
break;
}
case TR_TAG_MULTERM2:
{
AM_trreg -= DF_TM_SUSP_SIZE;
DF_copySusp((DF_TermPtr)AM_trreg, addr);
break;
}
case TR_TAG_TYPE:
{
DF_mkFreeVarType(addr);
break;
}
case TR_TAG_MOD: //temp
{
AM_trreg -= 2;
*addr = *AM_trreg;
*(addr+1) = *(AM_trreg + 1);
break;
}
} //switch
} //while
}
#endif //TRAIL_C

80
src/runtime/c/teyjus/simulator/trail.h
View File

@@ -1,80 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File trail.h. This header file includes the interface functions */
/* for trail operations. */
/* */
/****************************************************************************/
#ifndef TRAIL_H
#define TRAIL_H
#include <stdlib.h>
#include "mctypes.h"
#include "abstmachine.h"
#include "dataformats.h"
/****************************************************************************/
/* DATA STRUCTURE OF TRAIL ITEMS */
/****************************************************************************/
/* The tags of trail items */
enum TR_TrailDataCategory
{
TR_TAG_TERM,
TR_TAG_MULTERM1,
TR_TAG_MULTERM2,
TR_TAG_TYPE,
TR_TAG_MOD
};
/* The leading slot of trail items */
typedef struct
{
Byte tag; //trial data category tag
MemPtr addr; //the starting address of the trailed item
} TR_TrailItem;
/* The size of the trail item head */
#define TR_TRAIL_ITEM_HEAD_SIZE (int)ceil((double)sizeof(TR_TrailItem)/WORD_SIZE)
/* The sizes of different trail items */
#define TR_TRAIL_TERM_SIZE TR_TRAIL_ITEM_HEAD_SIZE + DF_TM_ATOMIC_SIZE
#define TR_TRAIL_MULTERM1_SIZE TR_TRAIL_ITEM_HEAD_SIZE + DF_TM_APP_SIZE
#define TR_TRAIL_MULTERM2_SIZE TR_TRAIL_ITEM_HEAD_SIZE + DF_TM_SUSP_SIZE
#define TR_TRAIL_TYPE_SIZE TR_TRAIL_ITEM_HEAD_SIZE
//temp
#define TR_TRAIL_MOD_SIZE TR_TRAIL_ITEM_HEAD_SIZE + 2
/***************************************************************************/
/* TRAILING FUNCTIONS */
/***************************************************************************/
void TR_trailTerm(DF_TermPtr addr); //trailing a term of atomic size
void TR_trailHTerm(DF_TermPtr addr); //trailing a heap term of atomic size
void TR_trailETerm(DF_TermPtr addr); //trailing a stack term
void TR_trailType(DF_TypePtr addr); //trailing a type (free type variable)
void TR_trailImport(MemPtr addr); //trailing a backchained field
/****************************************************************************/
/* UNWIND TRAIL FUNCTION */
/****************************************************************************/
void TR_unwindTrail(MemPtr trOld);
#endif //TRAIL_H

194
src/runtime/c/teyjus/simulator/types.c
View File

@@ -1,194 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File types.c. This file contains routines implementing the interpretive */
/* part of type unification including those needed within (interpretive) */
/* higher-order pattern unification. */
/* */
/****************************************************************************/
#ifndef TYPES_C
#define TYPES_C
#include "dataformats.h"
#include "abstmachine.h"
#include "trail.h"
#include "../system/error.h"
/* Push n types onto PDL */
static void TY_pushTypesToPDL(MemPtr tyPtr, int n)
{
AM_pdlError(n);
n--; tyPtr += n * DF_TY_ATOMIC_SIZE; //start from the nth type
for (; n >= 0; n--) { AM_pushPDL(tyPtr); tyPtr -= DF_TY_ATOMIC_SIZE; }
}
/* Push n pair of types onto PDL. */
void TY_pushPairsToPDL(MemPtr tyPtr1, MemPtr tyPtr2, int n)
{
AM_pdlError(2*n);
n--; tyPtr1 += n * DF_TY_ATOMIC_SIZE; tyPtr2 += n * DF_TY_ATOMIC_SIZE;
for (; n >= 0; n--){ //start from the nth pair
AM_pushPDL(tyPtr1); tyPtr1 -= DF_TY_ATOMIC_SIZE;
AM_pushPDL(tyPtr2); tyPtr2 -= DF_TY_ATOMIC_SIZE;
}
}
/* Perform occurs check for the type variable currently referred to by
AM_tyvbbreg over the type on the current top of PDL.
*/
static void TY_typesOcc()
{
DF_TypePtr tyPtr; // current type structure being examined
MemPtr pdlBotTmp = AM_pdlTop - 1; //tmp PDL
while (AM_pdlTop > pdlBotTmp){
tyPtr = DF_typeDeref((DF_TypePtr)AM_popPDL());
switch (DF_typeTag(tyPtr)){
case DF_TY_TAG_REF: {
if (AM_tyvbbreg == tyPtr) EM_THROW(EM_FAIL);
break;
}
case DF_TY_TAG_SORT: break;
case DF_TY_TAG_STR: {
DF_TypePtr fPtr = DF_typeStrFuncAndArgs(tyPtr);
TY_pushTypesToPDL((MemPtr)DF_typeStrArgs(fPtr),
DF_typeStrFuncArity(fPtr));
break;
}
case DF_TY_TAG_ARROW: {
TY_pushTypesToPDL((MemPtr)DF_typeArrowArgs(tyPtr),
DF_TY_ARROW_ARITY);
break;
}
} //switch
} //while (AM_pdlTop > pdlBotTmp
}
/* Bind two free variables. The one with higher address is updated. */
static void TY_bindVars(DF_TypePtr varPtr1, DF_TypePtr varPtr2)
{
if (varPtr2 < varPtr1){
TR_trailType(varPtr1);
DF_copyAtomicType(varPtr2, (MemPtr)varPtr1);
} else {
TR_trailType(varPtr2);
DF_copyAtomicType(varPtr1, (MemPtr)varPtr2);
}
}
/* Bind a variable to a type. Note occurs-check is performed. */
static void TY_bind(DF_TypePtr varPtr, DF_TypePtr tyPtr)
{
AM_pdlError(1);
AM_pushPDL((MemPtr)tyPtr);
AM_tyvbbreg = varPtr; //type variable being bound
TY_typesOcc();
TR_trailType(varPtr);
DF_copyAtomicType(tyPtr, (MemPtr)varPtr);
}
/* The main routine for interpretive type unification. The assumption is
that the pair of types are referred from the top two cells in the PDL
stack.
*/
void TY_typesUnify()
{
DF_TypePtr tyPtr1, tyPtr2;
while (AM_nemptyTypesPDL()){
tyPtr2 = DF_typeDeref((DF_TypePtr)AM_popPDL());
tyPtr1 = DF_typeDeref((DF_TypePtr)AM_popPDL());
if (tyPtr1 != tyPtr2) { //not referring to the same mem location
if (DF_isRefType(tyPtr1))
if (DF_isRefType(tyPtr2)) TY_bindVars(tyPtr1, tyPtr2);
else TY_bind(tyPtr1, tyPtr2);
else { //tyPtr1 is not reference
switch (DF_typeTag(tyPtr2)){
case DF_TY_TAG_REF: { TY_bind(tyPtr2, tyPtr1); break; }
case DF_TY_TAG_SORT: {
if (!(DF_isSortType(tyPtr1) &&
DF_typeKindTabIndex(tyPtr1)==DF_typeKindTabIndex(tyPtr2)))
EM_THROW(EM_FAIL);
break;
}
case DF_TY_TAG_ARROW:{
if (!DF_isArrowType(tyPtr1)) EM_THROW(EM_FAIL);
TY_pushPairsToPDL((MemPtr)DF_typeArrowArgs(tyPtr1),
(MemPtr)DF_typeArrowArgs(tyPtr2),
DF_TY_ARROW_ARITY);
break;
}
case DF_TY_TAG_STR: {
if (DF_isStrType(tyPtr1)){
DF_TypePtr fPtr1 = DF_typeStrFuncAndArgs(tyPtr1),
fPtr2 = DF_typeStrFuncAndArgs(tyPtr2);
if (DF_typeStrFuncInd(fPtr1) == DF_typeStrFuncInd(fPtr2))
TY_pushPairsToPDL((MemPtr)DF_typeStrArgs(fPtr1),
(MemPtr)DF_typeStrArgs(fPtr2),
DF_typeStrFuncArity(fPtr1));
else EM_THROW(EM_FAIL); //different function
} else EM_THROW(EM_FAIL); //tyPtr1 not str or ref
break;
}
} //switch
} //tyPtr1 not ref
} //tyPtr1 != tyPtr2
} //while (AM_nemptyTypesPDL())
}
/*****************************************************************************
* Occurs check over types. This version is used when the check has to be *
* performed within the compiled form of unification. In particular, this *
* routine would be invoked from within the unify_type_value class of *
* instructions in read mode. The peculiarity of this situation is that the *
* binding of the relevant type variable would have been started already by *
* a get_type_structure or get_type_arrow instruction, so we have to check *
* for the occurrence of the structure created as a consequence of this *
* rather than for a variable occurrence. *
*****************************************************************************/
void TY_typesOccC()
{
DF_TypePtr tyPtr;
while (AM_nemptyTypesPDL()){
tyPtr = DF_typeDeref((DF_TypePtr)AM_popPDL());
switch (DF_typeTag(tyPtr)) {
case DF_TY_TAG_REF: case DF_TY_TAG_SORT: break;
case DF_TY_TAG_STR:
{
DF_TypePtr fPtr = DF_typeStrFuncAndArgs(tyPtr);
if (AM_tyvbbreg == fPtr) EM_THROW(EM_FAIL);
TY_pushTypesToPDL((MemPtr)DF_typeStrArgs(fPtr),
DF_typeStrFuncArity(fPtr));
break;
}
case DF_TY_TAG_ARROW:
{
DF_TypePtr args = DF_typeArrowArgs(tyPtr);
if (AM_tyvbbreg == args) EM_THROW(EM_FAIL);
TY_pushTypesToPDL((MemPtr)args, DF_TY_ARROW_ARITY);
break;
}
} //switch
} //while
}
#endif //TYPES_C

47
src/runtime/c/teyjus/simulator/types.h
View File

@@ -1,47 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* File types.h. This header file identifies the routines defined in */
/* types.c that are exported from there. These routines implement */
/* operations on types, in particular the interpretive unification on */
/* types. These operations are typically needed in the simulator */
/* (simulator.c) and higher-order pattern unification (houp.c). */
/* */
/****************************************************************************/
#ifndef TYPES_H
#define TYPES_H
void TY_typesUnify(); //interpretive unification on types
void TY_pushPairsToPDL(MemPtr, MemPtr, int);//push n pairs of types to PDL
/*****************************************************************************
* Occurs check over types. This version is used when the check has to be *
* performed within the compiled form of unification. In particular, this *
* routine would be invoked from within the unify_type_value class of *
* instructions in read mode. The peculiarity of this situation is that the *
* binding of the relevant type variable would have been started already by *
* a get_type_structure or get_type_arrow instruction, so we have to check *
* for the occurrence of the structure created as a consequence of this *
* rather than for a variable occurrence. *
*****************************************************************************/
void TY_typesOccC();
#endif //TYPES_H

170
src/runtime/c/teyjus/system/error.h
View File

@@ -1,170 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File error.h -- error-handling functions *
* *
****************************************************************************/
#ifndef ERROR_H
#define ERROR_H
#include <stdlib.h>
#include <stdarg.h>
#include <setjmp.h>
#include "tjsignal.h"
#include "../simulator/mctypes.h" //to be modified
/****************************************************************************
* Exception stack declarations. *
****************************************************************************/
typedef enum EM_ExnType{
EM_NO_ERR = 0, // no errors
EM_NO_EXN, // used for warnings ??
EM_ABORT, // exit the executable immediately
EM_EXIT, // traverse the exception stack and exit
EM_TOP_LEVEL, // return to the toplevel
EM_QUERY, // abort solving the query
EM_QUERY_RESULT, // query is solved; print answer
EM_FAIL, // fail to simulator level
} EM_ExnType;
//function call environment stack
extern SIGNAL_jmp_buf *EM_ExnHandlerStack;
extern int EM_ExnHandlerStackTop;
extern int EM_ExnHandlerStackSize;
//exception type
extern EM_ExnType EM_CurrentExnType;
/****************************************************************************
* Exception-handling macros *
****************************************************************************/
//try
#define EM_TRY \
if (EM_ExnHandlerStackTop >= EM_ExnHandlerStackSize) \
{ \
EM_ExnHandlerStackSize = \
(EM_ExnHandlerStackSize + 1) * 2; \
EM_ExnHandlerStack = \
(SIGNAL_jmp_buf *)EM_realloc((void *)EM_ExnHandlerStack, \
EM_ExnHandlerStackSize * sizeof(SIGNAL_jmp_buf)); \
} \
if (SIGNAL_setjmp(EM_ExnHandlerStack[EM_ExnHandlerStackTop++]) == 0) \
{
//catch
#define EM_CATCH \
EM_ExnHandlerStackTop--; \
} \
else
//throw
/* Jump to the nearest (in a dynamic sense) EM_Try block, setting
EM_CurrentExnType to TYPE. Given a constant, the conditional in
this macro will be optimized away.
TODO: added cast to EM_CurrentExnType. */
#define EM_THROW(type) EM_THROWVAL((type), 1)
#define EM_THROWVAL(type, val) \
do { \
if ((type) == EM_ABORT) \
exit(1); \
else \
{ \
EM_CurrentExnType = (EM_ExnType)(type); \
SIGNAL_longjmp(EM_ExnHandlerStack[--EM_ExnHandlerStackTop], val); \
} \
} while(0)
//rethrow
/* pass the current exception to the next handler. Use only within an
EM_Catch block. */
#define EM_RETHROW() \
SIGNAL_longjmp(EM_ExnHandlerStack[--EM_ExnHandlerStackTop], 1)
/* Here's an example use of the above macros:
...
EM_TRY
{
foo();
if (foobar)
EM_THROW(EM_FOOBAR);
}
EM_CATCH
{
un_foo(); // clean up
if (EM_CurrentExnType == EM_FOOBAR)
printf("foobar!"); // stop the error here
else
EM_RETHROW(); // let a later handler handle it
}
*/
/****************************************************************************
* Routines which will generate errors automatically. *
****************************************************************************/
void *EM_malloc(unsigned int);
void *EM_realloc(void *, unsigned int);
char *EM_strdup(char *);
/****************************************************************************
* Beginning error indices for different modules (by module abbreviation) *
****************************************************************************/
/* general errors */
#define EM_NO_ERROR 0
#define EM_FIRST_ERR_INDEX 1
#define LINKER_FIRST_ERR_INDEX 50
#define LOADER_FIRST_ERR_INDEX 100
#define STREAM_FIRST_ERR_INDEX 150
#define SIM_FIRST_ERR_INDEX 200
#define BI_FIRST_ERR_INDEX 300
#define RT_FIRST_ERR_INDEX 400
#define FRONT_FIRST_ERR_INDEX 500
/****************************************************************************
* General-use error messages *
****************************************************************************/
enum
{
EM_OUT_OF_MEMORY = EM_FIRST_ERR_INDEX,
EM_OUT_OF_HEAP,
EM_NEWLINE,
EM_ERROR_COLON,
EM_WARNING_COLON
};
/****************************************************************************
* The routine that gets called in the event of an error *
****************************************************************************/
void EM_error(int inIndex, ...);
/****************************************************************************
* Have there been any errors since last EM_Reset()? *
****************************************************************************/
extern Boolean EM_anyErrors;
void EM_reset();
#endif //ERROR_H

222
src/runtime/c/teyjus/system/memory.h
View File

@@ -1,222 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* */
/* Files memory.h{c}. These files define the system memory structures and */
/* their access functions, including the system memory, run-time symbol */
/* tables, implication and import tables and the system module table. */
/* */
/****************************************************************************/
#ifndef MEMORY_H
#define MEMORY_H
#include <limits.h>
#include <math.h>
#include "../simulator/mctypes.h" //to be changed
#include "../simulator/dataformats.h" //to be changed
//#include "../config.h"
/******************************************************************************/
/* FIND CODE FUNCTION */
/******************************************************************************/
//arguments: constInd, search table size, search table addr
typedef CSpacePtr (*MEM_FindCodeFnPtr)(int, int, MemPtr);
/******************************************************************************/
/* SYSTEM MEMORY MANAGEMENT */
/******************************************************************************/
extern WordPtr MEM_memBeg; //starting addr of the system memory
extern WordPtr MEM_memEnd; //end addr of the system memory
extern WordPtr MEM_memTop; //the first usable word in the system memory
extern WordPtr MEM_memBot; //the last usable word in the system memory
/* Asking for the system memory of a given size (in word), */
/* and initialize relevant global variables. */
void MEM_memInit(unsigned int size);
/* Asking the simulator (system) memory for space of a given size (in word) */
WordPtr MEM_memExtend(unsigned int size);
/******************************************************************************/
/* MODULE SPACE COMPONENTS */
/*----------------------------------------------------------------------------*/
/* I. Run time symbol tables: kind table; type skeleton table; constant table*/
/* II. Implication table */
/* III.Import table */
/******************************************************************************/
/*****************************************************************************/
/* KIND SYMBOL TABLE */
/*****************************************************************************/
/* kind symbol table entry */
typedef struct
{
DF_StrDataPtr name;
TwoBytes arity; //agree with DF_StrTypeArity (simulator/dataformats.c)
} MEM_KstEnt;
typedef MEM_KstEnt *MEM_KstPtr;
/* max possible index of kind table */
/* (agree with DF_KstTabInd in simulator/dataformats.c) */
#define MEM_KST_MAX_IND USHRT_MAX
/* size of each entry of this table (in word) */
//Note this arithematic should in reality go into "config.h"
#define MEM_KST_ENTRY_SIZE (int)ceil((double)sizeof(MEM_KstEnt)/WORD_SIZE)
/*****************************************************************************/
/* TYPE SKELETON TABLE */
/*****************************************************************************/
/* type skeleton table entry */
typedef DF_TypePtr MEM_TstEnt;
typedef MEM_TstEnt *MEM_TstPtr;
/* max possible index of type skeleton table */
#define MEM_TST_MAX_IND USHRT_MAX
/* size of each entry of this table (in word) */
//Note this arithematic should in reality go into "config.h"
#define MEM_TST_ENTRY_SIZE (int)ceil((double)sizeof(MEM_TstEnt)/WORD_SIZE)
/*****************************************************************************/
/* CONSTANT SYMBOL TABLE */
/*****************************************************************************/
/* constant symbol table entry */
typedef struct
{
DF_StrDataPtr name;
TwoBytes typeEnvSize;
TwoBytes tskTabIndex; //index to the type skeleton table
TwoBytes neededness; //neededness info
TwoBytes univCount;
int precedence;
int fixity;
} MEM_CstEnt;
typedef MEM_CstEnt *MEM_CstPtr;
/* max possible index of constant symbol table */
/* (agree with DF_CstTabInd in simulator/dataformats.c) */
#define MEM_CST_MAX_IND USHRT_MAX
//add one entry at the current top
/* size of each entry of this table (in word) */
//Note this arithematic should in reality go into "config.h"
#define MEM_CST_ENTRY_SIZE (int)(sizeof(MEM_CstEnt)/WORD_SIZE)
/*****************************************************************************/
/* ACCESSING THE IMPLICATION GOAL TABLE */
/*****************************************************************************/
#define MEM_IMPL_FIX_SIZE 3
/* functions for filling in the fields of an impl table */
/* Q: the data stored in each field in byte code: are they word or in their */
/* specific types? */
void MEM_implPutLTS(WordPtr tab, int lts); //# pred (def extended)
void MEM_implPutFC(WordPtr tab, MEM_FindCodeFnPtr fcPtr);//ptr to find code func
void MEM_implPutPSTS(WordPtr tab, int tabSize); //# entries link tab
void MEM_implPutLT(WordPtr tab, int ind, int cst); //link tab; ind from 0
/* functions for retrieving the addresses of associated tables */
MemPtr MEM_implLT(MemPtr tab); //start add of seq. of pred (link tab)
MemPtr MEM_implPST(MemPtr tab, int lts); //start add of pred search tab
/* functions for retrieving the fields of a impl table */
int MEM_implLTS(MemPtr tab); //pred field (def extended)
MEM_FindCodeFnPtr MEM_implFC(MemPtr tab); //ptr to find code func
int MEM_implPSTS(MemPtr tab); //num entries in link tab
int MEM_implIthLT(MemPtr ltab, int index); /* value in ith entry of link tab
ltab is the addr of link tab;
index should start from 0 */
/*****************************************************************************
* ACCESSING THE IMPORTED MODULE TABLE *
*****************************************************************************/
#define MEM_IMP_FIX_SIZE 5
/* functions for filling in the fields of an import table */
/* Q: the data stored in each field in byte code: are they word or in their */
/* specific types? */
void MEM_impPutNCSEG(WordPtr tab, int nseg); //# code segments
void MEM_impPutNLC(WordPtr tab, int nlc); //# local constants
void MEM_impPutLTS(WordPtr tab, int lts); //# pred (def extended)
void MEM_impPutFC(WordPtr tab, MEM_FindCodeFnPtr fcp); //ptr to find code func
void MEM_impPutPSTS(WordPtr tab, int tabSize); //# entries in link tab
void MEM_impPutLT(WordPtr tab, int ind, int cst); //link tab; ind from 0
void MEM_impPutLCT(WordPtr lcTab, int ind, int cst); /*loc c tab(may null)
lcTab addr of local
ctab; ind from 0 */
/* functions for retrieving the addresses of associated tables */
MemPtr MEM_impLT(MemPtr tab); //start addr of seq. of pred (link tab)
MemPtr MEM_impLCT(MemPtr tab, int lts); //start addr of local const table
MemPtr MEM_impPST(MemPtr tab, int lts, int nlc); //start addr of pred search tab
/* functions for retrieving the fields of a impl table */
int MEM_impNCSEG(MemPtr tab); //# code segments
int MEM_impNLC(MemPtr tab); //# local constants
int MEM_impLTS(MemPtr tab); //# of preds (def extended)
MEM_FindCodeFnPtr MEM_impFC(MemPtr tab); //ptr to find code func
int MEM_impPSTS(MemPtr tab); //# entries in link tab
int MEM_impIthLT(MemPtr lt, int ind); /* ith entry in the link table: lt addr
of link tab; ind start from 0 */
int MEM_impIthLCT(MemPtr lct, int ind); /* ith entry in the local const table:
lct local c tab; ind start from 0 */
/*****************************************************************************/
/* ACCESSING THE BOUND VARIABLE INDEXING TABLE (BRACHING TABLE) */
/*****************************************************************************/
int MEM_branchTabIndexVal(MemPtr tab, int index); //the nth index value
CSpacePtr MEM_branchTabCodePtr(MemPtr tab, int index); //transfer addr
/*****************************************************************************/
/* SYSTEM MODULE TABLE */
/*****************************************************************************/
typedef struct
{
char *modname; //(top-level) module name
CSpacePtr addtable; //addr to the add code table of the top module
MEM_KstPtr kstBase; //starting addr of kind table
MEM_TstPtr tstBase; //starting addr of type skel table
MEM_CstPtr cstBase; //starting addr of constant table
WordPtr modSpaceBeg; //starting addr of module space
WordPtr modSpaceEnd; //ending addr of module space
WordPtr codeSpaceBeg; //starting addr of module space
WordPtr codeSpaceEnd; //ending addr of module space
} MEM_GmtEnt;
#define MEM_MAX_MODULES 255 //max number of modules (temp)
typedef MEM_GmtEnt MEM_Gmt[MEM_MAX_MODULES];
extern MEM_Gmt MEM_modTable; //global module table
MEM_GmtEnt *MEM_findInModTable(char* name);
MEM_GmtEnt *MEM_findFreeModTableEntry();
void MEM_removeModTableEntry(char* name);
extern MEM_GmtEnt MEM_topModule; //top module
void MEM_topModuleInit();
extern MEM_GmtEnt *MEM_currentModule; //current module being used
#endif //MEMORY_H

76
src/runtime/c/teyjus/system/message.h
View File

@@ -1,76 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File message.h -- code to present messages to the user in Teyjus. *
* supports dynamically adding "%x"-style formatting switches, as well as *
* complete support for simply making separate builds. *
* *
****************************************************************************/
#ifndef MESSAGE_H
#define MESSAGE_H
#include <stdarg.h>
#include "../simulator/mctypes.h"
/****************************************************************************
* Type of a function to handle a particular formatting switch. *
****************************************************************************/
/* these functions should increment ioArgument as necessary. */
typedef void (*MSG_SwitchFunction)(char *inSwitch, WordPtr inStream,
va_list *ioArgument);
/****************************************************************************
* Type of a block of messages, with associated constants. *
****************************************************************************/
typedef struct MSG_Msg
{
int mIndex; /* Index of this error message */
int mPreChain; /* Index of message to print before this one */
char *mMessage; /* The message itself */
int mPostChain; /* Index of message to print after this one */
int mExnType; /* if MSG_NO_EXN, MSG_Error() will return */
unsigned int mExitStatus; /* value to return with abort() */
} MSG_Msg;
typedef struct MSG_MessageBlock
{
int mCount; /* No. of messages in this block */
int mMinIndex, mMaxIndex; /* mMinIndex <= every index <= mMaxIndex */
struct MSG_MessageBlock *mNext; /* Next block of messages in linked list */
MSG_Msg *mMessages; /* Array of messages */
} MSG_MessageBlock;
/****************************************************************************
* Initialization functions *
****************************************************************************/
void MSG_addSwitch(char inSwitch, MSG_SwitchFunction inFunction);
void MSG_addMessages(int inCount, MSG_Msg *inMessages);
/****************************************************************************
* The routine that gets called to print a message, returning the exception *
* type for the error message (mExnType) *
****************************************************************************/
int MSG_vMessage(int inIndex, va_list *ap);
#endif /* MESSAGE_H */

91
src/runtime/c/teyjus/system/operators.h
View File

@@ -1,91 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#ifndef OPERATORS_H
#define OPERATORS_H
//#include <limits.h>
/* Fixity types */
typedef enum
{
OP_INFIX = 0,
OP_INFIXL = 1,
OP_INFIXR = 2,
OP_NONE = 3,
OP_PREFIX = 4,
OP_PREFIXR = 5,
OP_POSTFIX = 6,
OP_POSTFIXL = 7
} OP_FixityType;
typedef enum {
OP_WHOLE_TERM,
OP_LEFT_TERM,
OP_RIGHT_TERM
} OP_TermContext;
#define OP_MAXPREC 255
#define OP_MINPREC 0
#define OP_LAM_FIXITY OP_PREFIXR
#define OP_LAM_PREC -1
#define OP_APP_FIXITY OP_INFIXL
#define OP_APP_PREC 257
//usful ?
/*
#define OP_CCOMMA_FIXITY OP_infixr
#define OP_CCOMMA_PREC -2
#define OP_LT_FIXITY OP_infix
#define OP_LT_PREC 130
#define OP_LE_FIXITY OP_infix
#define OP_LE_PREC 130
#define OP_GT_FIXITY OP_infix
#define OP_GT_PREC 130
#define OP_GE_FIXITY OP_infix
#define OP_GE_PREC 130
#define OP_UM_FIXITY OP_prefix
#define OP_UM_PREC 256 //?
#define OP_PLUS_FIXITY OP_infixl
#define OP_PLUS_PREC 150
#define OP_MINUS_FIXITY OP_infixl
#define OP_MINUS_PREC 150
#define OP_TIMES_FIXITY OP_infixl
#define OP_TIMES_PREC 160
#define OP_COMMA_FIXITY OP_infixl
#define OP_COMMA_PREC 110
*/
#endif // OPERATORS_H

90
src/runtime/c/teyjus/system/stream.h
View File

@@ -1,90 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* system/stream.h{c} implements stream support for the C part of the LP *
* system. *
****************************************************************************/
#ifndef STREAM_H
#define STREAM_H
#include <stdarg.h>
#include <stdio.h>
#include "../simulator/mctypes.h" //to be modified
/*****************************************************************************
* CONSTANTS *
*****************************************************************************/
#define STREAM_ILLEGAL 0
#define STREAM_READ "r"
#define STREAM_WRITE "w"
#define STREAM_APPEND "a"
/*****************************************************************************
* EXPORTED VARIABLES *
*****************************************************************************/
/* STREAMs corresponding to the three standard streams */
extern WordPtr STREAM_stdin, STREAM_stdout, STREAM_stderr;
/****************************************************************************
* BASIC FUNCTIONS *
****************************************************************************/
/* STREAM_open returns STREAM_ILLEGAL if the stream can't be opened;
if inDoCountLines is false, the line numbering calls below will not
work. */
WordPtr STREAM_open(char *inFilename, char *inMode, int inDoUsePaths);
/* open strings as streams. Note that the STREAM system does not
distinguish to_string and from_string streams after they are
opened. Results are undefined for a write to a from_string or read
from a to_string. */
WordPtr STREAM_fromString(char *inString, int inDoCopyString);
WordPtr STREAM_toString();
/* will not close the standard streams */
void STREAM_close(WordPtr inStream);
/***************************************************************************
* RAW I/O SUPPORT ROUTINES *
* each routine returns -1 to indicate an error *
***************************************************************************/
int STREAM_readCharacters(WordPtr inStream, int inMaxCount, char* outString,
int inDoStopOnNewline);
/* STREAM_printf and STREAM_sans_printf return the number of characters
written, -1 in case of error. STREAM_printf takes a format
STREAM_sans_printf interprets the input as a string to be printed */
int STREAM_printf(WordPtr inStream, char *format, ...);
int STREAM_sans_printf(WordPtr inStream, char *str);
/* STREAM_printf returns the number of characters written, -1 in case of error*/
int STREAM_lookahead(WordPtr inStream, char *outChar);
Boolean STREAM_eof(WordPtr inStream);
int STREAM_flush(WordPtr inStream);
/***************************************************************************
* ACCESSORS *
***************************************************************************/
char* STREAM_getString(WordPtr inStream);
FILE* STREAM_getFile(WordPtr inStream);
char* STREAM_getName(WordPtr inStream);
#endif //STREAM_H

41
src/runtime/c/teyjus/system/tjsignal.h
View File

@@ -1,41 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************
* *
* File signal.h -- code to implement signals and signal handlers for *
* Teyjus. (TEMP) *
* *
****************************************************************************/
#ifndef SIGNAL_H
#define SIGNAL_H
#include <setjmp.h>
/****************************************************************************
* Different sigsetjmp/siglongjmp depending on support.. *
****************************************************************************/
#define SIGNAL_jmp_buf jmp_buf
#define SIGNAL_setjmp(env) setjmp(env)
#define SIGNAL_longjmp(env, val) longjmp(env, val)
#endif /* SIGNAL_H */

27
src/runtime/c/teyjus/tables/README
View File

@@ -1,27 +0,0 @@
TABLES
======
The files in source/tables define the pervasive tables and instruction
format tables.
pervasives:
pervasives.h{c}
===============
Defines the pervasive tables for pervasive kinds, type skeletons
and constants. Note these files are automatically generated.
pervinit.h{c}
=============
Defines the initialization functions for pervasive tables: such functions
are necessary because the pervasive names in the system run-time have
special encoding in the simulator (source/simulator/mcstring.h{c}) for
garbage collection as opposed to simply C strings. These names have to
be laid out on the system memory upon system initialization.
instructions.h{c}
=================
Defines instruction formats and instruction opcodes.
Note these files are automatically generated.

292
src/runtime/c/teyjus/tables/instructions.c
View File

@@ -1,292 +0,0 @@
/****************************************************************************/
/* */
/* File instructions.c. This file defines the operand types table and */
/* the instruction information table. */
/* */
/****************************************************************************/
#include "instructions.h"
/****************************************************************************/
/* OPERAND TYPES TABLE */
/****************************************************************************/
/* Max number of operand that could be taken by instructions including the */
/* padding bytes and one to terminate the list. (machine dependent) */
#define INSTR_MAX_OPERAND 8
/* this array is indexed by instruction category. For each category,
INSTR_operandTypeTab contains a string of values indicating the type
of the operand at that position, terminated by INSTR_X. This
information is useful when parsing instruction streams. */
typedef INSTR_OperandType
INSTR_OperandTypeTab[INSTR_NUM_INSTR_CATS][INSTR_MAX_OPERAND];
INSTR_OperandTypeTab INSTR_operandTypeTable ={
//INSTR_CAT_X
{INSTR_P, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RX
{INSTR_R, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_EX
{INSTR_E, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1X
{INSTR_I1, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_CX
{INSTR_P, INSTR_C, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_KX
{INSTR_P, INSTR_K, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_IX
{INSTR_P, INSTR_P, INSTR_P, INSTR_I, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_FX
{INSTR_P, INSTR_P, INSTR_P, INSTR_F, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_SX
{INSTR_P, INSTR_P, INSTR_P, INSTR_S, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_MTX
{INSTR_P, INSTR_P, INSTR_P, INSTR_MT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_LX
{INSTR_P, INSTR_P, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RRX
{INSTR_R, INSTR_R, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_ERX
{INSTR_E, INSTR_R, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RCX
{INSTR_R, INSTR_C, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RIX
{INSTR_R, INSTR_P, INSTR_P, INSTR_I, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RFX
{INSTR_R, INSTR_P, INSTR_P, INSTR_F, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RSX
{INSTR_R, INSTR_P, INSTR_P, INSTR_S, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RI1X
{INSTR_R, INSTR_I1, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RCEX
{INSTR_R, INSTR_CE, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_ECEX
{INSTR_E, INSTR_CE, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_CLX
{INSTR_P, INSTR_C, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RKX
{INSTR_R, INSTR_K, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_ECX
{INSTR_E, INSTR_C, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1ITX
{INSTR_I1, INSTR_P, INSTR_P, INSTR_IT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1LX
{INSTR_I1, INSTR_P, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_SEGLX
{INSTR_SEG, INSTR_P, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1LWPX
{INSTR_I1, INSTR_P, INSTR_P, INSTR_L, INSTR_WP, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1NX
{INSTR_I1, INSTR_N, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1HTX
{INSTR_I1, INSTR_P, INSTR_P, INSTR_HT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1BVTX
{INSTR_I1, INSTR_P, INSTR_P, INSTR_BVT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_CWPX
{INSTR_P, INSTR_C, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1WPX
{INSTR_I1, INSTR_P, INSTR_P, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RRI1X
{INSTR_R, INSTR_R, INSTR_I1, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RCLX
{INSTR_R, INSTR_C, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_RCI1X
{INSTR_R, INSTR_C, INSTR_I1, INSTR_P, INSTR_P, INSTR_P, INSTR_X, INSTR_X},
//INSTR_CAT_SEGI1LX
{INSTR_SEG, INSTR_I1, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1LLX
{INSTR_I1, INSTR_P, INSTR_P, INSTR_L, INSTR_L, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_NLLX
{INSTR_N, INSTR_P, INSTR_P, INSTR_L, INSTR_L, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_LLLLX
{INSTR_P, INSTR_P, INSTR_P, INSTR_L, INSTR_L, INSTR_L, INSTR_L, INSTR_X},
//INSTR_CAT_I1CWPX
{INSTR_I1, INSTR_C, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
//INSTR_CAT_I1I1WPX
{INSTR_I1, INSTR_I1, INSTR_P, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X}
};
INSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index)
{
return INSTR_operandTypeTable[index];
}
/****************************************************************************/
/* INSTRUCTION INFORMATION TABLE */
/****************************************************************************/
typedef struct //entry of the instruction info table
{
char* name;
INSTR_InstrCategory type;
int size;
} INSTR_InstrInfoTab_;
typedef INSTR_InstrInfoTab_ INSTR_InstrInfoTab[INSTR_NUM_INSTRS];
INSTR_InstrInfoTab INSTR_instrInfoTable ={
{"put_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"put_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"put_value_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"put_value_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"put_unsafe_value", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"copy_value", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"put_m_const", INSTR_CAT_RCX, INSTR_RCX_LEN},
{"put_p_const", INSTR_CAT_RCX, INSTR_RCX_LEN},
{"put_nil", INSTR_CAT_RX, INSTR_RX_LEN},
{"put_integer", INSTR_CAT_RIX, INSTR_RIX_LEN},
{"put_float", INSTR_CAT_RFX, INSTR_RFX_LEN},
{"put_string", INSTR_CAT_RSX, INSTR_RSX_LEN},
{"put_index", INSTR_CAT_RI1X, INSTR_RI1X_LEN},
{"put_app", INSTR_CAT_RRI1X, INSTR_RRI1X_LEN},
{"put_list", INSTR_CAT_RX, INSTR_RX_LEN},
{"put_lambda", INSTR_CAT_RRI1X, INSTR_RRI1X_LEN},
{"set_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_variable_te", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"set_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"globalize_pt", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"globalize_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_m_const", INSTR_CAT_CX, INSTR_CX_LEN},
{"set_p_const", INSTR_CAT_CX, INSTR_CX_LEN},
{"set_nil", INSTR_CAT_X, INSTR_X_LEN},
{"set_integer", INSTR_CAT_IX, INSTR_IX_LEN},
{"set_float", INSTR_CAT_FX, INSTR_FX_LEN},
{"set_string", INSTR_CAT_SX, INSTR_SX_LEN},
{"set_index", INSTR_CAT_I1X, INSTR_I1X_LEN},
{"set_void", INSTR_CAT_I1X, INSTR_I1X_LEN},
{"deref", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_lambda", INSTR_CAT_RI1X, INSTR_RI1X_LEN},
{"get_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"get_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"init_variable_t", INSTR_CAT_RCEX, INSTR_RCEX_LEN},
{"init_variable_p", INSTR_CAT_ECEX, INSTR_ECEX_LEN},
{"get_m_constant", INSTR_CAT_RCX, INSTR_RCX_LEN},
{"get_p_constant", INSTR_CAT_RCLX, INSTR_RCLX_LEN},
{"get_integer", INSTR_CAT_RIX, INSTR_RIX_LEN},
{"get_float", INSTR_CAT_RFX, INSTR_RFX_LEN},
{"get_string", INSTR_CAT_RSX, INSTR_RSX_LEN},
{"get_nil", INSTR_CAT_RX, INSTR_RX_LEN},
{"get_m_structure", INSTR_CAT_RCI1X, INSTR_RCI1X_LEN},
{"get_p_structure", INSTR_CAT_RCI1X, INSTR_RCI1X_LEN},
{"get_list", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_m_constant", INSTR_CAT_CX, INSTR_CX_LEN},
{"unify_p_constant", INSTR_CAT_CLX, INSTR_CLX_LEN},
{"unify_integer", INSTR_CAT_IX, INSTR_IX_LEN},
{"unify_float", INSTR_CAT_FX, INSTR_FX_LEN},
{"unify_string", INSTR_CAT_SX, INSTR_SX_LEN},
{"unify_nil", INSTR_CAT_X, INSTR_X_LEN},
{"unify_void", INSTR_CAT_I1X, INSTR_I1X_LEN},
{"put_type_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"put_type_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"put_type_value_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"put_type_value_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"put_type_unsafe_value", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"put_type_const", INSTR_CAT_RKX, INSTR_RKX_LEN},
{"put_type_structure", INSTR_CAT_RKX, INSTR_RKX_LEN},
{"put_type_arrow", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_type_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_type_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"set_type_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_type_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"set_type_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"set_type_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"set_type_constant", INSTR_CAT_KX, INSTR_KX_LEN},
{"get_type_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"get_type_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"init_type_variable_t", INSTR_CAT_RCEX, INSTR_RCEX_LEN},
{"init_type_variable_p", INSTR_CAT_ECEX, INSTR_ECEX_LEN},
{"get_type_value_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"get_type_value_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"get_type_constant", INSTR_CAT_RKX, INSTR_RKX_LEN},
{"get_type_structure", INSTR_CAT_RKX, INSTR_RKX_LEN},
{"get_type_arrow", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_type_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_type_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_type_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_type_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_envty_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_envty_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_type_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_type_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_envty_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"unify_envty_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"unify_type_constant", INSTR_CAT_KX, INSTR_KX_LEN},
{"pattern_unify_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
{"pattern_unify_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
{"finish_unify", INSTR_CAT_X, INSTR_X_LEN},
{"head_normalize_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"head_normalize_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"incr_universe", INSTR_CAT_X, INSTR_X_LEN},
{"decr_universe", INSTR_CAT_X, INSTR_X_LEN},
{"set_univ_tag", INSTR_CAT_ECX, INSTR_ECX_LEN},
{"tag_exists_t", INSTR_CAT_RX, INSTR_RX_LEN},
{"tag_exists_p", INSTR_CAT_EX, INSTR_EX_LEN},
{"tag_variable", INSTR_CAT_EX, INSTR_EX_LEN},
{"push_impl_point", INSTR_CAT_I1ITX, INSTR_I1ITX_LEN},
{"pop_impl_point", INSTR_CAT_X, INSTR_X_LEN},
{"add_imports", INSTR_CAT_SEGI1LX, INSTR_SEGI1LX_LEN},
{"remove_imports", INSTR_CAT_SEGLX, INSTR_SEGLX_LEN},
{"push_import", INSTR_CAT_MTX, INSTR_MTX_LEN},
{"pop_imports", INSTR_CAT_I1X, INSTR_I1X_LEN},
{"allocate", INSTR_CAT_I1X, INSTR_I1X_LEN},
{"deallocate", INSTR_CAT_X, INSTR_X_LEN},
{"call", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
{"call_name", INSTR_CAT_I1CWPX, INSTR_I1CWPX_LEN},
{"execute", INSTR_CAT_LX, INSTR_LX_LEN},
{"execute_name", INSTR_CAT_CWPX, INSTR_CWPX_LEN},
{"proceed", INSTR_CAT_X, INSTR_X_LEN},
{"try_me_else", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
{"retry_me_else", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
{"trust_me", INSTR_CAT_I1WPX, INSTR_I1WPX_LEN},
{"try", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
{"retry", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
{"trust", INSTR_CAT_I1LWPX, INSTR_I1LWPX_LEN},
{"trust_ext", INSTR_CAT_I1NX, INSTR_I1NX_LEN},
{"try_else", INSTR_CAT_I1LLX, INSTR_I1LLX_LEN},
{"retry_else", INSTR_CAT_I1LLX, INSTR_I1LLX_LEN},
{"branch", INSTR_CAT_LX, INSTR_LX_LEN},
{"switch_on_term", INSTR_CAT_LLLLX, INSTR_LLLLX_LEN},
{"switch_on_constant", INSTR_CAT_I1HTX, INSTR_I1HTX_LEN},
{"switch_on_bvar", INSTR_CAT_I1BVTX, INSTR_I1BVTX_LEN},
{"switch_on_reg", INSTR_CAT_NLLX, INSTR_NLLX_LEN},
{"neck_cut", INSTR_CAT_X, INSTR_X_LEN},
{"get_level", INSTR_CAT_EX, INSTR_EX_LEN},
{"put_level", INSTR_CAT_EX, INSTR_EX_LEN},
{"cut", INSTR_CAT_EX, INSTR_EX_LEN},
{"call_builtin", INSTR_CAT_I1I1WPX, INSTR_I1I1WPX_LEN},
{"builtin", INSTR_CAT_I1X, INSTR_I1X_LEN},
{"stop", INSTR_CAT_X, INSTR_X_LEN},
{"halt", INSTR_CAT_X, INSTR_X_LEN},
{"fail", INSTR_CAT_X, INSTR_X_LEN},
{"create_type_variable", INSTR_CAT_EX, INSTR_EX_LEN},
{"execute_link_only", INSTR_CAT_CWPX, INSTR_CWPX_LEN},
{"call_link_only", INSTR_CAT_I1CWPX, INSTR_I1CWPX_LEN},
{"put_variable_te", INSTR_CAT_RRX, INSTR_RRX_LEN}
};
/* Accessing functions */
INSTR_InstrCategory INSTR_instrType(int index)
{
return (INSTR_instrInfoTable[index]).type;
}
char* INSTR_instrName(int index)
{
return (INSTR_instrInfoTable[index]).name;
}
int INSTR_instrSize(int index)
{
return (INSTR_instrInfoTable[index]).size;
}

480
src/runtime/c/teyjus/tables/instructions.h
View File

@@ -1,480 +0,0 @@
/****************************************************************************/
/* File instructions.h. */
/* This file defines instruction operand types, instruction categories and */
/* instruction opcode. */
/****************************************************************************/
#ifndef INSTRUCTIONS_H
#define INSTRUCTIONS_H
#include "../simulator/mctypes.h" //to be changed
#include "../simulator/dataformats.h" //to be changed
/****************************************************************************/
/* OPERAND TYPES */
/****************************************************************************/
/* possible types of instruction operands */
typedef enum INSTR_OperandType
{
// (1 byte) padding
INSTR_P,
// (1 word) padding
INSTR_WP,
// argument register number
INSTR_R,
// environment variable number
INSTR_E,
// next clause number in impt or impl pt
INSTR_N,
// 1 byte natural number
INSTR_I1,
// closure environment variable number
INSTR_CE,
// import segment index
INSTR_SEG,
// constant symbol table index
INSTR_C,
// kind symbol table index
INSTR_K,
// code location
INSTR_L,
// integer immediate value
INSTR_I,
// floating point immediate value
INSTR_F,
// string pointer
INSTR_S,
// module table address
INSTR_MT,
// impl table address
INSTR_IT,
// hash table address
INSTR_HT,
// branch table for bound var indexing
INSTR_BVT,
// operand list terminator
INSTR_X
} INSTR_OperandType;
/**************************************************************************/
/* Types for instruction operants */
/**************************************************************************/
typedef Byte INSTR_OpCode;
typedef Byte INSTR_RegInd;
typedef Byte INSTR_EnvInd;
typedef Byte INSTR_NextClauseInd;
typedef Byte INSTR_OneByteInt;
typedef Byte INSTR_ClEnvInd;
typedef Byte INSTR_ImpSegInd;
typedef TwoBytes INSTR_CstIndex;
typedef TwoBytes INSTR_KstIndex;
typedef CSpacePtr INSTR_CodeLabel;
typedef int INSTR_Int;
typedef float INSTR_Float;
typedef DF_StrDataPtr INSTR_Str;
typedef MemPtr INSTR_ModTab;
typedef MemPtr INSTR_ImplTab;
typedef MemPtr INSTR_HashTab;
typedef MemPtr INSTR_BranchTab;
/***************************************************************************/
/* INSTRUCTION CATEGORIES */
/***************************************************************************/
/* The names of instruction categories no longer include padding bytes. */
/* Thus we do not need to maintain two sets of names for different machine */
/* architectures. */
typedef enum INSTR_InstrCategory
{
INSTR_CAT_X = 0,
INSTR_CAT_RX = 1,
INSTR_CAT_EX = 2,
INSTR_CAT_I1X = 3,
INSTR_CAT_CX = 4,
INSTR_CAT_KX = 5,
INSTR_CAT_IX = 6,
INSTR_CAT_FX = 7,
INSTR_CAT_SX = 8,
INSTR_CAT_MTX = 9,
INSTR_CAT_LX = 10,
INSTR_CAT_RRX = 11,
INSTR_CAT_ERX = 12,
INSTR_CAT_RCX = 13,
INSTR_CAT_RIX = 14,
INSTR_CAT_RFX = 15,
INSTR_CAT_RSX = 16,
INSTR_CAT_RI1X = 17,
INSTR_CAT_RCEX = 18,
INSTR_CAT_ECEX = 19,
INSTR_CAT_CLX = 20,
INSTR_CAT_RKX = 21,
INSTR_CAT_ECX = 22,
INSTR_CAT_I1ITX = 23,
INSTR_CAT_I1LX = 24,
INSTR_CAT_SEGLX = 25,
INSTR_CAT_I1LWPX = 26,
INSTR_CAT_I1NX = 27,
INSTR_CAT_I1HTX = 28,
INSTR_CAT_I1BVTX = 29,
INSTR_CAT_CWPX = 30,
INSTR_CAT_I1WPX = 31,
INSTR_CAT_RRI1X = 32,
INSTR_CAT_RCLX = 33,
INSTR_CAT_RCI1X = 34,
INSTR_CAT_SEGI1LX = 35,
INSTR_CAT_I1LLX = 36,
INSTR_CAT_NLLX = 37,
INSTR_CAT_LLLLX = 38,
INSTR_CAT_I1CWPX = 39,
INSTR_CAT_I1I1WPX = 40
} INSTR_InstrCategory;
#define INSTR_NUM_INSTR_CATS 41
#define INSTR_CALL_I1_LEN 7
/**************************************************************************/
/* Macros defines instruction lengths and distances between op code and */
/* operands. */
/* The assumption is that the op code occupies 1 byte. */
/**************************************************************************/
//INSTR_CAT_X
#define INSTR_X_LEN 4
//INSTR_CAT_RX
#define INSTR_RX_LEN 4
#define INSTR_RX_R 1
//INSTR_CAT_EX
#define INSTR_EX_LEN 4
#define INSTR_EX_E 1
//INSTR_CAT_I1X
#define INSTR_I1X_LEN 4
#define INSTR_I1X_I1 1
//INSTR_CAT_CX
#define INSTR_CX_LEN 4
#define INSTR_CX_C 2
//INSTR_CAT_KX
#define INSTR_KX_LEN 4
#define INSTR_KX_K 2
//INSTR_CAT_IX
#define INSTR_IX_LEN 8
#define INSTR_IX_I 4
//INSTR_CAT_FX
#define INSTR_FX_LEN 8
#define INSTR_FX_F 4
//INSTR_CAT_SX
#define INSTR_SX_LEN 8
#define INSTR_SX_S 4
//INSTR_CAT_MTX
#define INSTR_MTX_LEN 8
#define INSTR_MTX_MT 4
//INSTR_CAT_LX
#define INSTR_LX_LEN 8
#define INSTR_LX_L 4
//INSTR_CAT_RRX
#define INSTR_RRX_LEN 4
#define INSTR_RRX_R1 1
#define INSTR_RRX_R2 2
//INSTR_CAT_ERX
#define INSTR_ERX_LEN 4
#define INSTR_ERX_E 1
#define INSTR_ERX_R 2
//INSTR_CAT_RCX
#define INSTR_RCX_LEN 4
#define INSTR_RCX_R 1
#define INSTR_RCX_C 2
//INSTR_CAT_RIX
#define INSTR_RIX_LEN 8
#define INSTR_RIX_R 1
#define INSTR_RIX_I 4
//INSTR_CAT_RFX
#define INSTR_RFX_LEN 8
#define INSTR_RFX_R 1
#define INSTR_RFX_F 4
//INSTR_CAT_RSX
#define INSTR_RSX_LEN 8
#define INSTR_RSX_R 1
#define INSTR_RSX_S 4
//INSTR_CAT_RI1X
#define INSTR_RI1X_LEN 4
#define INSTR_RI1X_R 1
#define INSTR_RI1X_I1 2
//INSTR_CAT_RCEX
#define INSTR_RCEX_LEN 4
#define INSTR_RCEX_R 1
#define INSTR_RCEX_CE 2
//INSTR_CAT_ECEX
#define INSTR_ECEX_LEN 4
#define INSTR_ECEX_E 1
#define INSTR_ECEX_CE 2
//INSTR_CAT_CLX
#define INSTR_CLX_LEN 8
#define INSTR_CLX_C 2
#define INSTR_CLX_L 4
//INSTR_CAT_RKX
#define INSTR_RKX_LEN 4
#define INSTR_RKX_R 1
#define INSTR_RKX_K 2
//INSTR_CAT_ECX
#define INSTR_ECX_LEN 4
#define INSTR_ECX_E 1
#define INSTR_ECX_C 2
//INSTR_CAT_I1ITX
#define INSTR_I1ITX_LEN 8
#define INSTR_I1ITX_I1 1
#define INSTR_I1ITX_IT 4
//INSTR_CAT_I1LX
#define INSTR_I1LX_LEN 8
#define INSTR_I1LX_I1 1
#define INSTR_I1LX_L 4
//INSTR_CAT_SEGLX
#define INSTR_SEGLX_LEN 8
#define INSTR_SEGLX_SEG 1
#define INSTR_SEGLX_L 4
//INSTR_CAT_I1LWPX
#define INSTR_I1LWPX_LEN 12
#define INSTR_I1LWPX_I1 1
#define INSTR_I1LWPX_L 4
//INSTR_CAT_I1NX
#define INSTR_I1NX_LEN 4
#define INSTR_I1NX_I1 1
#define INSTR_I1NX_N 2
//INSTR_CAT_I1HTX
#define INSTR_I1HTX_LEN 8
#define INSTR_I1HTX_I1 1
#define INSTR_I1HTX_HT 4
//INSTR_CAT_I1BVTX
#define INSTR_I1BVTX_LEN 8
#define INSTR_I1BVTX_I1 1
#define INSTR_I1BVTX_BVT 4
//INSTR_CAT_CWPX
#define INSTR_CWPX_LEN 8
#define INSTR_CWPX_C 2
//INSTR_CAT_I1WPX
#define INSTR_I1WPX_LEN 8
#define INSTR_I1WPX_I1 1
//INSTR_CAT_RRI1X
#define INSTR_RRI1X_LEN 4
#define INSTR_RRI1X_R1 1
#define INSTR_RRI1X_R2 2
#define INSTR_RRI1X_I1 3
//INSTR_CAT_RCLX
#define INSTR_RCLX_LEN 8
#define INSTR_RCLX_R 1
#define INSTR_RCLX_C 2
#define INSTR_RCLX_L 4
//INSTR_CAT_RCI1X
#define INSTR_RCI1X_LEN 8
#define INSTR_RCI1X_R 1
#define INSTR_RCI1X_C 2
#define INSTR_RCI1X_I1 4
//INSTR_CAT_SEGI1LX
#define INSTR_SEGI1LX_LEN 8
#define INSTR_SEGI1LX_SEG 1
#define INSTR_SEGI1LX_I1 2
#define INSTR_SEGI1LX_L 4
//INSTR_CAT_I1LLX
#define INSTR_I1LLX_LEN 12
#define INSTR_I1LLX_I1 1
#define INSTR_I1LLX_L1 4
#define INSTR_I1LLX_L2 8
//INSTR_CAT_NLLX
#define INSTR_NLLX_LEN 12
#define INSTR_NLLX_N 1
#define INSTR_NLLX_L1 4
#define INSTR_NLLX_L2 8
//INSTR_CAT_LLLLX
#define INSTR_LLLLX_LEN 20
#define INSTR_LLLLX_L1 4
#define INSTR_LLLLX_L2 8
#define INSTR_LLLLX_L3 12
#define INSTR_LLLLX_L4 16
//INSTR_CAT_I1CWPX
#define INSTR_I1CWPX_LEN 8
#define INSTR_I1CWPX_I1 1
#define INSTR_I1CWPX_C 2
//INSTR_CAT_I1I1WPX
#define INSTR_I1I1WPX_LEN 8
#define INSTR_I1I1WPX_I11 1
#define INSTR_I1I1WPX_I12 2
/****************************************************************************/
/* OPERAND TYPES TABLE */
/****************************************************************************/
//the operand types array in a given entry
INSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index);
/***************************************************************************/
/* OPCODES OF INSTRUCTIONS */
/***************************************************************************/
// Instructions for term unification and creation
#define put_variable_t 0
#define put_variable_p 1
#define put_value_t 2
#define put_value_p 3
#define put_unsafe_value 4
#define copy_value 5
#define put_m_const 6
#define put_p_const 7
#define put_nil 8
#define put_integer 9
#define put_float 10
#define put_string 11
#define put_index 12
#define put_app 13
#define put_list 14
#define put_lambda 15
#define set_variable_t 16
#define set_variable_te 17
#define set_variable_p 18
#define set_value_t 19
#define set_value_p 20
#define globalize_pt 21
#define globalize_t 22
#define set_m_const 23
#define set_p_const 24
#define set_nil 25
#define set_integer 26
#define set_float 27
#define set_string 28
#define set_index 29
#define set_void 30
#define deref 31
#define set_lambda 32
#define get_variable_t 33
#define get_variable_p 34
#define init_variable_t 35
#define init_variable_p 36
#define get_m_constant 37
#define get_p_constant 38
#define get_integer 39
#define get_float 40
#define get_string 41
#define get_nil 42
#define get_m_structure 43
#define get_p_structure 44
#define get_list 45
#define unify_variable_t 46
#define unify_variable_p 47
#define unify_value_t 48
#define unify_value_p 49
#define unify_local_value_t 50
#define unify_local_value_p 51
#define unify_m_constant 52
#define unify_p_constant 53
#define unify_integer 54
#define unify_float 55
#define unify_string 56
#define unify_nil 57
#define unify_void 58
// Instructions for type unification and creation
#define put_type_variable_t 59
#define put_type_variable_p 60
#define put_type_value_t 61
#define put_type_value_p 62
#define put_type_unsafe_value 63
#define put_type_const 64
#define put_type_structure 65
#define put_type_arrow 66
#define set_type_variable_t 67
#define set_type_variable_p 68
#define set_type_value_t 69
#define set_type_value_p 70
#define set_type_local_value_t 71
#define set_type_local_value_p 72
#define set_type_constant 73
#define get_type_variable_t 74
#define get_type_variable_p 75
#define init_type_variable_t 76
#define init_type_variable_p 77
#define get_type_value_t 78
#define get_type_value_p 79
#define get_type_constant 80
#define get_type_structure 81
#define get_type_arrow 82
#define unify_type_variable_t 83
#define unify_type_variable_p 84
#define unify_type_value_t 85
#define unify_type_value_p 86
#define unify_envty_value_t 87
#define unify_envty_value_p 88
#define unify_type_local_value_t 89
#define unify_type_local_value_p 90
#define unify_envty_local_value_t 91
#define unify_envty_local_value_p 92
#define unify_type_constant 93
// Instructions for handling higher-order aspects
#define pattern_unify_t 94
#define pattern_unify_p 95
#define finish_unify 96
#define head_normalize_t 97
#define head_normalize_p 98
// Instructions for handling logical aspects
#define incr_universe 99
#define decr_universe 100
#define set_univ_tag 101
#define tag_exists_t 102
#define tag_exists_p 103
#define tag_variable 104
#define push_impl_point 105
#define pop_impl_point 106
#define add_imports 107
#define remove_imports 108
#define push_import 109
#define pop_imports 110
// Control Instructions
#define allocate 111
#define deallocate 112
#define call 113
#define call_name 114
#define execute 115
#define execute_name 116
#define proceed 117
// Choice Instructions
#define try_me_else 118
#define retry_me_else 119
#define trust_me 120
#define try 121
#define retry 122
#define trust 123
#define trust_ext 124
#define try_else 125
#define retry_else 126
#define branch 127
// Indexing Instructions
#define switch_on_term 128
#define switch_on_constant 129
#define switch_on_bvar 130
#define switch_on_reg 131
// Cut Instructions
#define neck_cut 132
#define get_level 133
#define put_level 134
#define cut 135
// Miscellaneous Instructions
#define call_builtin 136
#define builtin 137
#define stop 138
#define halt 139
#define fail 140
// new added
#define create_type_variable 141
// resolved by the linker
#define execute_link_only 142
#define call_link_only 143
#define put_variable_te 144
#define INSTR_NUM_INSTRS 145
/***************************************************************************/
/* INSTRUCTION INFORMATION TABLE */
/***************************************************************************/
INSTR_InstrCategory INSTR_instrType(int index); //instr type in a given entry
char* INSTR_instrName(int index); //instr name in a given entry
int INSTR_instrSize(int index); //instr size in a given entry
#endif //INSTRUCTIONS_H

810
src/runtime/c/teyjus/tables/pervasives.c
View File

@@ -1,810 +0,0 @@
/***************************************************************************/
/* File pervasives.c. */
/***************************************************************************/
#ifndef PERVASIVES_C
#define PERVASIVES_C
#include <string.h>
#include "pervasives.h"
#include "../system/error.h" //to be changed
#include "../system/operators.h" //to be changed
/****************************************************************************/
/* PERVASIVE KIND */
/****************************************************************************/
//pervasive kind data table (array)
PERV_KindData PERV_kindDataTab[PERV_KIND_NUM] = {
//name, arity
// int
{"int", 0},
// real
{"real", 0},
// bool
{"o", 0},
// string
{"string", 0},
// list type constructor
{"list", 1},
// in_stream
{"in_stream", 0},
// out_stream
{"out_stream", 0}
};
PERV_KindData PERV_getKindData(int index)
{
return PERV_kindDataTab[index];
}
void PERV_copyKindDataTab(PERV_KindData* dst)
{
//this way of copy relies on the assumption that the pervasive kind data
//has the same structure as that of the run-time kind symbol table entries.
memcpy((void*)dst, (void*)PERV_kindDataTab,
sizeof(PERV_KindData) * PERV_KIND_NUM);
}
/***************************************************************************/
/* TYPE SKELETIONS FOR PERVASIVE CONSTANTS */
/****************************************************************************/
//pervasive type skeleton table (array)
PERV_TySkelData PERV_tySkelTab[PERV_TY_SKEL_NUM];
//pervasive type skeletons and type skeleton table initialization
//The type skeletons are created in the memory of the system through malloc,
//and addresses are entered into the pervasive type skeleton table.
void PERV_tySkelTabInit()
{
int tySkelInd = 0; //ts tab index
MemPtr tySkelBase = (MemPtr)EM_malloc(WORD_SIZE * 336 ); //ts area
// A
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
// (list A)
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkStrType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkStrFuncType(tySkelBase, PERV_LIST_INDEX, 1);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
// A->(list A)->(list A)
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkStrType(tySkelBase, (DF_TypePtr)(tySkelBase + 2 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkStrType(tySkelBase, (DF_TypePtr)(tySkelBase + 3 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkStrFuncType(tySkelBase, PERV_LIST_INDEX, 1);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkStrFuncType(tySkelBase, PERV_LIST_INDEX, 1);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
// int
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// real
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// o (type of proposition)
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// int -> int
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// int -> int -> int
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// int -> int -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// int -> real
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// real -> int
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// real -> real
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// real -> string
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// real -> real -> real
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// real -> real -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> int
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// int -> string
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> string -> string
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> string -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> int -> int -> string
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// o -> o -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// (A -> o) -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 2 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// A -> A -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// in_stream
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// out_stream
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> in_stream -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> out_stream -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// in_stream -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// out_stream -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// A -> string -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> A -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// out_stream -> string -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// in_stream -> int -> string -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// in_stream -> string -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// A -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// out_stream -> A -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// in_stream -> A -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSkelVarType(tySkelBase, 0);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// o -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> int -> in_stream -> out_stream -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
// string -> int -> o
PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
tySkelInd++;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_INT_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
tySkelBase += DF_TY_ATOMIC_SIZE;
}
void PERV_copyTySkelTab(PERV_TySkelData* dst)
{
memcpy((void*)dst, (void*)PERV_tySkelTab,
sizeof(PERV_TySkelData) * PERV_KIND_NUM);
}
/***************************************************************************/
/* PERVASIVE CONSTANTS */
/***************************************************************************/
//pervasive constant data table (array)
PERV_ConstData PERV_constDataTab[PERV_CONST_NUM] = {
//name, tesize, tst, neededness, UC, prec, fixity
// logical and
{",", 0, 21, 0, 0, 110, OP_INFIXL},
// logical or
{";", 0, 21, 0, 0, 100, OP_INFIXL},
// existential quantifier
{"sigma", 1, 22, 1, 0, 0, OP_NONE},
// universal quantifier
{"pi", 1, 22, 1, 0, 0, OP_NONE},
// true proposition
{"true", 0, 6, 0, 0, 0, OP_NONE},
// cut predicate
{"!", 0, 6, 0, 0, 0, OP_NONE},
// fail predicate
{"fail", 0, 6, 0, 0, 0, OP_NONE},
//nothing
{NULL, 0, 0, 0, 0, OP_NONE },
// another logical and
{"&", 0, 21, 0, 0, 120, OP_INFIXR},
// halt the system
{"halt", 0, 6, 0, 0, 0, OP_NONE},
// return to top level
{"stop", 0, 6, 0, 0, 0, OP_NONE},
// Prolog if; needed?
{":-", 0, 21, 0, 0, 0, OP_INFIXL},
// implication; needed?
{"=>", 0, 21, 0, 0, 130, OP_INFIXR},
//nothing
{NULL, 0, 0, 0, 0, OP_NONE },
//nothing
{NULL, 0, 0, 0, 0, OP_NONE },
// solve; used by code generator
{"solve", 0, 39, 0, 0, 0, OP_NONE},
// is
{"is", 1, 23, 1, 0, 130, OP_INFIX},
// not
{"not", 0, 39, 0, 0, 0, OP_NONE},
// equality (unify) predicate
{"=", 1, 23, 1, 0, 130, OP_INFIX},
// less than on integers
{"<", 0, 9, 0, 0, 130, OP_INFIX},
// greater than on integers
{">", 0, 9, 0, 0, 130, OP_INFIX},
// less than or eq on integers
{"<=", 0, 9, 0, 0, 130, OP_INFIX},
// greater than or eq on integers
{">=", 0, 9, 0, 0, 130, OP_INFIX},
// less than in reals
{"<", 0, 15, 0, 0, 130, OP_INFIX},
// greater than on reals
{">", 0, 15, 0, 0, 130, OP_INFIX},
// less than or eq on reals
{"<=", 0, 15, 0, 0, 130, OP_INFIX},
// greater than or eq on reals
{">=", 0, 15, 0, 0, 130, OP_INFIX},
// less than on strings
{"<", 0, 19, 0, 0, 130, OP_INFIX},
// greater than on strings
{">", 0, 19, 0, 0, 130, OP_INFIX},
// less than or eq on strings
{"<=", 0, 19, 0, 0, 130, OP_INFIX},
// greater than or eq on strings
{">=", 0, 19, 0, 0, 130, OP_INFIX},
// open_in
{"open_in", 0, 26, 0, 0, 0, OP_NONE},
// open_out
{"open_out", 0, 27, 0, 0, 0, OP_NONE},
// open_append
{"open_append", 0, 27, 0, 0, 0, OP_NONE},
// close_in
{"close_in", 0, 28, 0, 0, 0, OP_NONE},
// close_out
{"close_out", 0, 29, 0, 0, 0, OP_NONE},
// open_string
{"open_string", 0, 26, 0, 0, 0, OP_NONE},
// input
{"input", 0, 33, 0, 0, 0, OP_NONE},
// output
{"output", 0, 32, 0, 0, 0, OP_NONE},
// input_line
{"input_line", 0, 34, 0, 0, 0, OP_NONE},
// lookahead
{"lookahead", 0, 34, 0, 0, 0, OP_NONE},
// eof
{"eof", 0, 28, 0, 0, 0, OP_NONE},
// flush
{"flush", 0, 29, 0, 0, 0, OP_NONE},
// print
{"print", 0, 35, 0, 0, 0, OP_NONE},
// read
{"read", 1, 36, 1, 0, 0, OP_NONE},
// printterm
{"printterm", 1, 37, 0, 0, 0, OP_NONE},
// term_to_string
{"term_to_string", 1, 30, 0, 0, 0, OP_NONE},
// string_to_term
{"string_to_term", 1, 31, 1, 0, 0, OP_NONE},
// readterm
{"readterm", 1, 38, 1, 0, 0, OP_NONE},
// getenv predicate; needed?
{"getenv", 0, 19, 0, 0, 0, OP_NONE},
// open_socket predicate
{"open_socket", 0, 40, 0, 0, 0, OP_NONE},
// time predicate
{"time", 0, 9, 0, 0, 0, OP_NONE},
// system predicate
{"system", 0, 41, 0, 0, 0, OP_NONE},
//nothing
{NULL, 0, 0, 0, 0, OP_NONE },
//nothing
{NULL, 0, 0, 0, 0, OP_NONE },
//nothing
{NULL, 0, 0, 0, 0, OP_NONE },
// unary minus on integers
{"-", 0, 7, 0, 0, 256, OP_PREFIX},
// addition on integers
{"+", 0, 8, 0, 0, 150, OP_INFIXL},
// subtraction on integers
{"-", 0, 8, 0, 0, 150, OP_INFIXL},
// mutiplication on integers
{"*", 0, 8, 0, 0, 160, OP_INFIXL},
// integer division
{"div", 0, 8, 0, 0, 160, OP_INFIXL},
// modulus
{"mod", 0, 7, 0, 0, 160, OP_INFIXL},
// coercion to real
{"int_to_real", 0, 10, 0, 0, 0, OP_NONE},
// integer abs
{"abs", 0, 7, 0, 0, 0, OP_NONE},
// unary minus on real
{"-", 0, 12, 0, 0, 256, OP_PREFIX},
// addition on reals
{"+", 0, 14, 0, 0, 150, OP_INFIXL},
// subtraction on reals
{"-", 0, 14, 0, 0, 150, OP_INFIXL},
// multiplication on reals
{"*", 0, 14, 0, 0, 160, OP_INFIXL},
// division
{"/", 0, 14, 0, 0, 160, OP_INFIXL},
// square root
{"sqrt", 0, 12, 0, 0, 0, OP_NONE},
// sine
{"sin", 0, 12, 0, 0, 0, OP_NONE},
// cosine
{"cos", 0, 12, 0, 0, 0, OP_NONE},
// arc tan
{"arctan", 0, 12, 0, 0, 0, OP_NONE},
// natural log
{"ln", 0, 12, 0, 0, 0, OP_NONE},
// floor function
{"floor", 0, 11, 0, 0, 0, OP_NONE},
// ceiling function
{"ceil", 0, 11, 0, 0, 0, OP_NONE},
// truncation
{"truncate", 0, 11, 0, 0, 0, OP_NONE},
// real abs
{"rabs", 0, 12, 0, 0, 0, OP_NONE},
// string concatination
{"^", 0, 18, 0, 0, 150, OP_INFIXL},
// string length
{"size", 0, 16, 0, 0, 0, OP_NONE},
// chr function
{"chr", 0, 17, 0, 0, 0, OP_NONE},
// ord function
{"string_to_int", 0, 16, 0, 0, 0, OP_NONE},
// substring
{"substring", 0, 20, 0, 0, 0, OP_NONE},
// int to string
{"int_to_string", 0, 17, 0, 0, 0, OP_NONE},
// real to string
{"real_to_string", 0, 13, 0, 0, 0, OP_NONE},
// for unnamed universal constants (Note: tesize should be 0)
{"<constant>", 0, 0, 0, 0, 0, OP_NONE},
// std_in
{"std_in", 0, 24, 0, 0, 0, OP_NONE},
// std_out
{"std_out", 0, 25, 0, 0, 0, OP_NONE},
// std_err
{"std_err", 0, 25, 0, 0, 0, OP_NONE},
// nil
{"nil", 0, 1, 0, 0, 0, OP_NONE},
// integer constant
{"<int_constant>", 0, 3, 0, 0, 0, OP_NONE},
// real constant
{"<real_constant>", 0, 4, 0, 0, 0, OP_NONE},
// string constant
{"<str_constant>", 0, 5, 0, 0, 0, OP_NONE},
// cons
{"::", 0, 2, 0, 0, 140, OP_INFIXR}
};
PERV_ConstData PERV_getConstData(int index)
{
return PERV_constDataTab[index];
}
void PERV_copyConstDataTab(PERV_ConstData* dst)
{
//this way of copy relies on the assumption that the pervasive kind data
//has the same structure as that of the run-time kind symbol table entries.
memcpy((void*)dst, (void*)PERV_constDataTab,
sizeof(PERV_ConstData) * PERV_CONST_NUM);
}
Boolean PERV_isLogicSymb(int index)
{
return ((index >= PERV_LSSTART) && (index <= PERV_LSEND));
}
Boolean PERV_isPredSymb(int index)
{
return ((index >= PERV_PREDSTART) && (index <= PERV_PREDEND));
}
PERV_LogicSymbTypes PERV_logicSymb(int index)
{
return ((PERV_LogicSymbTypes)(index - PERV_LSSTART));
}
int PERV_predBuiltin(int index)
{
return (index - PERV_PREDSTART);
}
#endif //PERVASIVES_C

326
src/runtime/c/teyjus/tables/pervasives.h
View File

@@ -1,326 +0,0 @@
/****************************************************************************/
/* File pervasives.h. */
/****************************************************************************/
#ifndef PERVASIVES_H
#define PERVASIVES_H
#include "../simulator/mctypes.h" //to be changed
#include "../simulator/dataformats.h" //to be changed
/****************************************************************************/
/* PERVASIVE KIND */
/****************************************************************************/
//indices for predefined sorts and type constructors
typedef enum PERV_KindIndexType
{
// int
PERV_INT_INDEX = 0,
// real
PERV_REAL_INDEX = 1,
// bool
PERV_BOOL_INDEX = 2,
// string
PERV_STRING_INDEX = 3,
// list type constructor
PERV_LIST_INDEX = 4,
// in_stream
PERV_INSTREAM_INDEX = 5,
// out_stream
PERV_OUTSTREAM_INDEX = 6
} PERV_KindIndexType;
//total number of pervasive kinds
#define PERV_KIND_NUM 7
//pervasive kind data type
typedef struct
{
char *name;
TwoBytes arity;
} PERV_KindData;
//pervasive kind data table (array)
extern PERV_KindData PERV_kindDataTab[PERV_KIND_NUM];
//pervasive kind data access function
PERV_KindData PERV_getKindData(int index);
//pervasive kind table copy function (used in module space initialization)
//this functiion relies on the assumption that the pervasive kind data
//has the same structure as that of the run-time kind symbol table entries.
void PERV_copyKindDataTab(PERV_KindData* dst);
/***************************************************************************/
/* TYPE SKELETIONS FOR PERVASIVE CONSTANTS */
/****************************************************************************/
//total number of type skeletons needed for pervasive constants
#define PERV_TY_SKEL_NUM 42
//pervasive type skel data type
typedef DF_TypePtr PERV_TySkelData;
//pervasive type skel table (array)
extern PERV_TySkelData PERV_tySkelTab[PERV_TY_SKEL_NUM];
//pervasive type skeletons and type skeleton table initialization
//Note that type skeltons have to be dynamically allocated, and so does the
//info recorded in each entry of the pervasive type skeleton table
void PERV_tySkelTabInit();
//pervasive tyskel table copy function
void PERV_copyTySkelTab(PERV_TySkelData* dst);
/***************************************************************************/
/* PERVASIVE CONSTANTS */
/***************************************************************************/
//indices for predefined constants
typedef enum PERV_ConstIndexType
{
// logical and
PERV_AND_INDEX = 0,
// logical or
PERV_OR_INDEX = 1,
// existential quantifier
PERV_SOME_INDEX = 2,
// universal quantifier
PERV_ALL_INDEX = 3,
// true proposition
PERV_TRUE_INDEX = 4,
// cut predicate
PERV_CUT_INDEX = 5,
// fail predicate
PERV_FAIL_INDEX = 6,
// empty
// another logical and
PERV_AMPAND_INDEX = 8,
// halt the system
PERV_HALT_INDEX = 9,
// return to top level
PERV_STOP_INDEX = 10,
// Prolog if; needed?
PERV_COLONDASH_INDEX = 11,
// implication; needed?
PERV_IMPL_INDEX = 12,
// empty
// empty
// solve; used by code generator
PERV_SOLVE_INDEX = 15,
// is
PERV_IS_INDEX = 16,
// not
PERV_NOT_INDEX = 17,
// equality (unify) predicate
PERV_EQ_INDEX = 18,
// less than on integers
PERV_INTLSS_INDEX = 19,
// greater than on integers
PERV_INTGRT_INDEX = 20,
// less than or eq on integers
PERV_INTLEQ_INDEX = 21,
// greater than or eq on integers
PERV_INTGEQ_INDEX = 22,
// less than in reals
PERV_REALLSS_INDEX = 23,
// greater than on reals
PERV_REALGRT_INDEX = 24,
// less than or eq on reals
PERV_REALLEQ_INDEX = 25,
// greater than or eq on reals
PERV_REALGEQ_INDEX = 26,
// less than on strings
PERV_STRLSS_INDEX = 27,
// greater than on strings
PERV_STRGRT_INDEX = 28,
// less than or eq on strings
PERV_STRLEQ_INDEX = 29,
// greater than or eq on strings
PERV_STRGEQ_INDEX = 30,
// open_in
PERV_OPENIN_INDEX = 31,
// open_out
PERV_OPENOUT_INDEX = 32,
// open_append
PERV_OPENAPP_INDEX = 33,
// close_in
PERV_CLOSEIN_INDEX = 34,
// close_out
PERV_CLOSEOUT_INDEX = 35,
// open_string
PERV_OPENSTR_INDEX = 36,
// input
PERV_INPUT_INDEX = 37,
// output
PERV_OUTPUT_INDEX = 38,
// input_line
PERV_INPUTLINE_INDEX = 39,
// lookahead
PERV_LOOKAHEAD_INDEX = 40,
// eof
PERV_EOF_INDEX = 41,
// flush
PERV_FLUSH_INDEX = 42,
// print
PERV_PRINT_INDEX = 43,
// read
PERV_READ_INDEX = 44,
// printterm
PERV_PRINTTERM_INDEX = 45,
// term_to_string
PERV_TERMTOSTR_INDEX = 46,
// string_to_term
PERV_STRTOTERM_INDEX = 47,
// readterm
PERV_READTERM_INDEX = 48,
// getenv predicate; needed?
PERV_GETENV_INDEX = 49,
// open_socket predicate
PERV_OPENSOCKET_INDEX = 50,
// time predicate
PERV_TIME_INDEX = 51,
// system predicate
PERV_SYSTEM_INDEX = 52,
// empty
// empty
// empty
// unary minus on integers
PERV_INTUMINUS_INDEX = 56,
// addition on integers
PERV_INTPLUS_INDEX = 57,
// subtraction on integers
PERV_INTMINUS_INDEX = 58,
// mutiplication on integers
PERV_INTMULT_INDEX = 59,
// integer division
PERV_INTDIV_INDEX = 60,
// modulus
PERV_MOD_INDEX = 61,
// coercion to real
PERV_ITOR_INDEX = 62,
// integer abs
PERV_IABS_INDEX = 63,
// unary minus on real
PERV_REALUMINUS_INDEX = 64,
// addition on reals
PERV_REALPLUS_INDEX = 65,
// subtraction on reals
PERV_REALMINUS_INDEX = 66,
// multiplication on reals
PERV_REALMULT_INDEX = 67,
// division
PERV_REALDIV_INDEX = 68,
// square root
PERV_SQRT_INDEX = 69,
// sine
PERV_SIN_INDEX = 70,
// cosine
PERV_COS_INDEX = 71,
// arc tan
PERV_ARCTAN_INDEX = 72,
// natural log
PERV_LOG_INDEX = 73,
// floor function
PERV_FLOOR_INDEX = 74,
// ceiling function
PERV_CEIL_INDEX = 75,
// truncation
PERV_TRUNC_INDEX = 76,
// real abs
PERV_RABS_INDEX = 77,
// string concatination
PERV_SCAT_INDEX = 78,
// string length
PERV_SLEN_INDEX = 79,
// chr function
PERV_ITOCHR_INDEX = 80,
// ord function
PERV_STOI_INDEX = 81,
// substring
PERV_SUBSTR_INDEX = 82,
// int to string
PERV_ITOSTR_INDEX = 83,
// real to string
PERV_RTOS_INDEX = 84,
// for unnamed universal constants (Note: tesize should be 0)
PERV_UNIV_INDEX = 85,
// std_in
PERV_STDIN_INDEX = 86,
// std_out
PERV_STDOUT_INDEX = 87,
// std_err
PERV_STDERR_INDEX = 88,
// nil
PERV_NIL_INDEX = 89,
// integer constant
PERV_INTC_INDEX = 90,
// real constant
PERV_REALC_INDEX = 91,
// string constant
PERV_STRC_INDEX = 92,
// cons
PERV_CONS_INDEX = 93
} PERV_ConstIndexType;
//total number pervasive constants
#define PERV_CONST_NUM 94
//pervasive const data type
typedef struct
{
char *name;
TwoBytes typeEnvSize;
TwoBytes tskTabIndex; //index to the type skeleton table
TwoBytes neededness; //neededness (predicate constant)
TwoBytes univCount;
int precedence;
int fixity;
} PERV_ConstData;
//pervasive const data table (array)
extern PERV_ConstData PERV_constDataTab[PERV_CONST_NUM];
//pervasive const data access function
PERV_ConstData PERV_getConstData(int index);
//pervasive const table copy function (used in module space initialization)
//this functiion relies on the assumption that the pervasive kind data
//has the same structure as that of the run-time kind symbol table entries.
void PERV_copyConstDataTab(PERV_ConstData* dst);
#define PERV_LSSTART PERV_AND_INDEX //begin of interpretable symbols
#define PERV_LSEND PERV_STOP_INDEX //end of interpretable symbols
#define PERV_PREDSTART PERV_SOLVE_INDEX //begin of predicate symbols
#define PERV_PREDEND PERV_SYSTEM_INDEX //end of predicate symbols
typedef enum PERV_LogicSymbTypes
{
PERV_AND = 0,
PERV_OR = 1,
PERV_SOME = 2,
PERV_ALL = 3,
PERV_L_TRUE = 4,
PERV_CUT = 5,
PERV_FAIL = 6,
PERV_EQ = 7,
PERV_AMPAND = 8,
PERV_HALT = 9,
PERV_STOP = 10,
} PERV_LogicSymbTypes;
//functions used by the simulator for interpreted goals
Boolean PERV_isLogicSymb(int index);
Boolean PERV_isPredSymb(int index);
PERV_LogicSymbTypes PERV_logicSymb(int index);
int PERV_predBuiltin(int index);
#endif //PERVASIVES_H

152
src/runtime/c/teyjus/tables/pervinit.c
View File

@@ -1,152 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/***************************************************************************/
/* File pervinit.h{c}. */
/* Functions for setting up the symbol tables of pervasive constants and */
/* kinds are provided. */
/***************************************************************************/
#include <string.h>
#include <stdio.h>
#include "pervinit.h"
#include "pervasives.h"
#include "../system/memory.h"
#include "../simulator/dataformats.h"
#include "../simulator/mcstring.h"
#include "../simulator/mctypes.h"
DF_StrDataPtr PERVINIT_writeName(char* name)
{
int length = strlen(name);
MemPtr rtPtr, mcStr;
rtPtr = (MemPtr)MEM_memExtend(MCSTR_numWords(length) +
DF_STRDATA_HEAD_SIZE);
mcStr = rtPtr + DF_STRDATA_HEAD_SIZE;
//create data head
DF_mkStrDataHead((MemPtr)rtPtr);
//create the string data
MCSTR_toString((MCSTR_Str)mcStr, name, length);
return (DF_StrDataPtr)rtPtr;
}
/***************************************************************************/
/* PERVASIVE KINDS */
/***************************************************************************/
MEM_KstEnt PERVINIT_kindDataTab[PERV_KIND_NUM];
/* Set up pervasive kind symbol table. */
/* The kind names are supposed to be written in the current top of system */
/* memory. */
static void PERVINIT_kindTabInit()
{
int tabInd;
for (tabInd = 0; tabInd < PERV_KIND_NUM; tabInd++) {
if (PERV_kindDataTab[tabInd].name)
PERVINIT_kindDataTab[tabInd].name=
PERVINIT_writeName(PERV_kindDataTab[tabInd].name);
else PERVINIT_kindDataTab[tabInd].name = NULL;
PERVINIT_kindDataTab[tabInd].arity=PERV_kindDataTab[tabInd].arity;
}
}
/* copy the pervasive kind table into given address */
void PERVINIT_copyKindDataTab(MEM_KstPtr dst)
{
memcpy((void*)dst, (void*)PERVINIT_kindDataTab,
MEM_KST_ENTRY_SIZE * WORD_SIZE * PERV_KIND_NUM);
}
/***************************************************************************/
/* PERVASIVE TYPE SKELETONS */
/***************************************************************************/
MEM_TstPtr PERVINIT_tySkelTab;
/* Set up pervasive type skeleton table. */
static void PERVINIT_tySkelTabInit()
{
PERVINIT_tySkelTab = PERV_tySkelTab;
PERV_tySkelTabInit();
}
/* copy the pervasive type skeleton table into given address */
void PERVINIT_copyTySkelTab(PERV_TySkelData* dst)
{
memcpy((void*)dst, (void*)PERVINIT_tySkelTab,
MEM_TST_ENTRY_SIZE * WORD_SIZE * PERV_TY_SKEL_NUM);
}
/***************************************************************************/
/* PERVASIVE CONSTANTS */
/***************************************************************************/
MEM_CstEnt PERVINIT_constDataTab[PERV_CONST_NUM];
/* Set up pervasive constant symbol table. */
/* The constant names are supposed to be written in the current top of */
/* system memory. */
static void PERVINIT_constTabInit()
{
int tabInd;
for (tabInd = 0; tabInd < PERV_CONST_NUM; tabInd++) {
if (PERV_constDataTab[tabInd].name)
PERVINIT_constDataTab[tabInd].name =
PERVINIT_writeName(PERV_constDataTab[tabInd].name);
else PERVINIT_constDataTab[tabInd].name = NULL;
PERVINIT_constDataTab[tabInd].typeEnvSize =
PERV_constDataTab[tabInd].typeEnvSize;
PERVINIT_constDataTab[tabInd].tskTabIndex =
PERV_constDataTab[tabInd].tskTabIndex;
PERVINIT_constDataTab[tabInd].neededness =
PERV_constDataTab[tabInd].neededness;
PERVINIT_constDataTab[tabInd].univCount =
PERV_constDataTab[tabInd].univCount;
PERVINIT_constDataTab[tabInd].precedence =
PERV_constDataTab[tabInd].precedence;
PERVINIT_constDataTab[tabInd].fixity =
PERV_constDataTab[tabInd].fixity;
}
}
/* copy the pervsive constant table into given address */
void PERVINIT_copyConstDataTab(MEM_CstPtr dst)
{
memcpy((void*)dst, (void*)PERVINIT_constDataTab,
MEM_CST_ENTRY_SIZE * WORD_SIZE * PERV_CONST_NUM);
}
/***************************************************************************/
/* PERVASIVE TABLES INITIALIZATION */
/* Fill in the actual pervasive tables; create string data needed for names*/
/* onto the current top of the system memory; create the type skeletons in */
/* a malloced space. */
/***************************************************************************/
void PERVINIT_tableInit()
{
PERVINIT_kindTabInit();
PERVINIT_tySkelTabInit();
PERVINIT_constTabInit();
}

73
src/runtime/c/teyjus/tables/pervinit.h
View File

@@ -1,73 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/***************************************************************************/
/* File pervinit.h{c}. */
/* Functions for setting up the symbol tables of pervasive constants and */
/* kinds are provided. */
/***************************************************************************/
#ifndef PERVINIT_H
#define PERVINIT_H
#include "../simulator/dataformats.h" //to be modified
#include "../system/memory.h" //to be modified
#include "pervasives.h"
#include "../simulator/mctypes.h"
/***************************************************************************/
/* PERVASIVE KINDS */
/***************************************************************************/
//the actual pervasive kind table get copied during loading
extern MEM_KstEnt PERVINIT_kindDataTab[PERV_KIND_NUM];
/* copy the pervasive kind table into given address */
void PERVINIT_copyKindDataTab(MEM_KstPtr dst);
/***************************************************************************/
/* PERVASIVE TYPE SKELETONS */
/***************************************************************************/
//pervasive type skeleton table
extern MEM_TstPtr PERVINIT_tySkelTab;
/* copy the pervasive type skeleton table into given address */
void PERVINIT_copyTySkelTab(MEM_TstPtr dst);
/***************************************************************************/
/* PERVASIVE CONSTANTS */
/***************************************************************************/
//the acutual pervasive constant table get copied during loading
extern MEM_CstEnt PERVINIT_constDataTab[PERV_CONST_NUM];
/* copy the pervasive constant table into given address */
void PERVINIT_copyConstDataTab(MEM_CstPtr dst);
/***************************************************************************/
/* PERVASIVE TABLES INITIALIZATION */
/* Fill in the actual pervasive tables; create string data needed for names*/
/* onto the current top of the system memory; create the type skeletons in */
/* a malloced space. */
/***************************************************************************/
void PERVINIT_tableInit();
#endif //PERVINIT_H

30
src/runtime/c/teyjus/tables_gen/Makefile
View File

@@ -1,30 +0,0 @@
all: instrformats/gen pervasives/gen
(cd instrformats; ./gen)
(cd pervasives; ./gen)
instrformats/gen: instrformats/y.tab.o instrformats/lex.yy.o \
instrformats/instrgen-c.o instrformats/instrgen-haskell.o \
util/util.o
gcc -o instrformats/gen $^ -lm
pervasives/gen: pervasives/y.tab.o pervasives/lex.yy.o \
pervasives/ccode.o pervasives/ocamlcode.o \
pervasives/pervgen-c.o pervasives/pervgen-ocaml.o \
pervasives/types.o pervasives/op.o \
util/util.o
gcc -o pervasives/gen $^
.o : .c
gcc -c -o $@ $^
instrformats/y.tab.c instrformats/y.tab.h : instrformats/instrformats.y
yacc -o instrformats/y.tab.c --defines=instrformats/y.tab.h instrformats/instrformats.y
instrformats/lex.yy.c : instrformats/instrformats.l instrformats/y.tab.h
flex -o instrformats/lex.yy.c instrformats/instrformats.l
pervasives/y.tab.c pervasives/y.tab.h : pervasives/pervasives.y
yacc -o pervasives/y.tab.c --defines=pervasives/y.tab.h pervasives/pervasives.y
pervasives/lex.yy.c : pervasives/pervasives.l pervasives/y.tab.h
flex -o pervasives/lex.yy.c pervasives/pervasives.l

69
src/runtime/c/teyjus/tables_gen/instrformats/instrformats.l
View File

@@ -1,69 +0,0 @@
%{
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#include "y.tab.h"
#include <string.h>
#include <stdlib.h>
static int commentLev = 0;
%}
LETTER [A-Za-z]
DIGIT [0-9]
SYMBOL "_"|"+"|"-"|"*"|"/"|"!"|"~"|"@"|"$"|"%"|"^"|"&"|"*"|"<"|">"|"="|"'"|":"|","
ID ({LETTER}|{SYMBOL})({LETTER}|{DIGIT}|{SYMBOL})*
NUM {DIGIT}+
WSPACE [ \t]+
STRING [^*/]+
STRING2 [^}]+
%x COMMENT COMMENT2 INCLUDE
%%
<INITIAL,COMMENT>"\n" {continue; }
<INITIAL>";" {return SEMICOLON; }
<INITIAL>"[" {return LBRACKET; }
<INITIAL>"]" {return RBRACKET; }
<INITIAL>"OPERAND TYPES" {return OPTYPES; }
<INITIAL>"OPCODE" {return OPCODE; }
<INITIAL>"INSTR CATEGORY" {return INSTRCAT; }
<INITIAL>"MAX OPERAND" {return MAXOPERAND; }
<INITIAL>"CALL_I1_LEN" {return CALL_I1_LEN; }
<INITIAL>"INSTRUCTIONS" {return INSTRUCTIONS; }
<INITIAL>{WSPACE} {continue; }
<INITIAL>"/%" {commentLev = 1; BEGIN(COMMENT); continue; }
<INITIAL>"/*" {BEGIN(COMMENT2); continue; }
<INITIAL>"{" {BEGIN(INCLUDE); continue; }
<INITIAL>{ID} {yylval.name = strdup(yytext); return ID; }
<INITIAL>{NUM} {yylval.isval.ival = atoi(yytext);
yylval.isval.sval = strdup(yytext);
return NUM; }
<COMMENT2>"*/" {BEGIN(INITIAL); continue; }
<COMMENT2>{STRING} {yylval.text = strdup(yytext); return STRING; }
<COMMENT>[^%/\n]+ {continue; }
<COMMENT>"/%" {commentLev++; continue; }
<COMMENT>"%/" {commentLev--;
if (!commentLev) BEGIN(INITIAL); continue; }
<INCLUDE>"}" {BEGIN(INITIAL); continue; }
<INCLUDE>{STRING2} {yylval.text = strdup(yytext); return STRING2; }
. {return ERROR; }

282
src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y
View File

@@ -1,282 +0,0 @@
%{
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#include <stdio.h>
#include "instrgen-c.h"
#include "instrgen-haskell.h"
#include "../util/util.h"
extern int yylex();
int yywrap() {return 1;}
void yyerror(const char* str)
{
printf("%s\n", str);
}
%}
%union{
char* name;
char* text;
struct
{
int ival;
char* sval;
} isval;
}
%token OPTYPES INSTRCAT INSTRUCTIONS OPCODE MAXOPERAND
CALL_I1_LEN SEMICOLON ERROR LBRACKET RBRACKET
%token <name> ID
%token <isval> NUM
%token <text> STRING STRING2
%start instr_format
%type <name> operand_name operand_tname operand_type instr_name instr_cat
instr_head instr_length operand_comp_type
%type <text> comments compiler_include
%type <isval> max_operand opcode operand_size
%%
instr_format : compiler_include operands instrcats instructions
compiler_include : STRING2 { ocgenInclude($1);}
operands : OPTYPES operand_decs opcode_type
{ cgenOpsH(); ocgenOps();}
;
operand_decs : operand_dec operand_decs
| operand_dec_last
;
operand_dec : operand_name operand_tname operand_type operand_size operand_comp_type comments
{ cgenOpTypes($1, $2, $3, $6, 0);
ocgenOpType($1, $4.ival, $5);
}
| operand_name comments
{ cgenOpTypes($1, NULL, NULL, $2, 0); }
;
operand_dec_last : operand_name operand_tname operand_type operand_size operand_comp_type comments
{ cgenOpTypes($1, $2, $3, $6, 1);
ocgenOpType($1, $4.ival, $5);
}
| operand_name comments
{ cgenOpTypes($1, NULL, NULL, $2, 1); }
;
operand_name : ID { $$ = $1; }
;
operand_tname : ID { $$ = $1; }
;
operand_type : ID { $$ = $1; }
;
operand_comp_type : ID { $$ = $1; }
;
comments : STRING {$$ = $1; }
;
operand_size : NUM { $$ = $1; }
;
opcode_type : OPCODE ID operand_size
{ cgenOpCodeType($2);
ocgenOpCodeType($3.ival);}
;
instrcats : INSTRCAT max_operand instrcat_decs CALL_I1_LEN NUM
{ cgenInstrCatH($5.sval); cgenInstrCatC($2.sval);
ocgenInstrCat();
}
;
max_operand : MAXOPERAND NUM { $$ = $2; }
;
instrcat_decs : instrcat_dec instrcat_decs
| instrcat_dec_last
;
instrcat_dec : ID LBRACKET instr_format RBRACKET instr_lengths
{ cgenOneInstrCatH($1, 0); cgenOneInstrCatC($1, 0);
ocgenOneInstrCat($1);
}
;
instrcat_dec_last : ID LBRACKET instr_format RBRACKET instr_lengths
{ cgenOneInstrCatH($1, 1); cgenOneInstrCatC($1, 1);
ocgenOneInstrCat($1);
}
;
instr_format : oneOp instr_format
| lastOp
;
oneOp : ID { cgenInstrFormat($1, 0); ocgenInstrFormat($1); }
;
lastOp : ID { cgenInstrFormat($1, 1); ocgenInstrFormat($1); }
;
instr_lengths : instr_len_first SEMICOLON instr_lengths_rest
| instr_len_first
;
instr_lengths_rest : instr_len SEMICOLON instr_lengths_rest
| instr_len
;
instr_len_first : ID NUM
{cgenInstrLength($1, $2.sval);
ocgenInstrLength($1, $2.sval);}
;
instr_len : ID NUM { cgenInstrLength($1, $2.sval);}
;
instructions : instr_head instrs
{ cgenInstrH($1); cgenInstrC(); cgenSimDispatch();
ocgenInstr();
}
;
instr_head : INSTRUCTIONS NUM
{ cinitInstrC($2.ival);
cinitSimDispatch($2.ival);
$$ = $2.sval;
}
;
instrs : instr SEMICOLON instrs
| last_instr
;
instr : comments opcode instr_name instr_cat instr_length
{ cgenOneInstrH($1, $2.sval , $3);
cgenOneInstrC($2.ival, $3, $4, $5, 0);
cgenOneSimDispatch($2.ival, $3, 0);
ocgenOneInstr($2.sval, $3, $4, $5, 0);
}
| opcode instr_name instr_cat instr_length
{ cgenOneInstrH(NULL, $1.sval , $2);
cgenOneInstrC($1.ival, $2, $3, $4, 0);
cgenOneSimDispatch($1.ival, $2, 0);
ocgenOneInstr($1.sval, $2, $3, $4, 0);
}
;
last_instr : comments opcode instr_name instr_cat instr_length
{ cgenOneInstrH($1, $2.sval , $3);
cgenOneInstrC($2.ival, $3, $4, $5, 1);
cgenOneSimDispatch($2.ival, $3, 1);
ocgenOneInstr($2.sval, $3, $4, $5, 1);
}
| opcode instr_name instr_cat instr_length
{ cgenOneInstrH(NULL, $1.sval , $2);
cgenOneInstrC($1.ival, $2, $3, $4, 1);
cgenOneSimDispatch($1.ival, $2, 1);
ocgenOneInstr($1.sval, $2, $3, $4, 1);
}
;
opcode : NUM { $$ = $1; }
;
instr_name : ID { $$ = $1; }
;
instr_cat : ID { $$ = $1; }
;
instr_length : ID { $$ = $1; }
;
%%
extern FILE* yyin;
int main(argc, argv)
int argc;
char * argv[];
{
char * root = NULL;
int ret = 0;
if(argc <= 1)
{
if (sizeof(void*) == 8)
{
//printf("No input file specified; using 'instrformats_64.in'.\n");
yyin = UTIL_fopenR("instrformats_64.in");
}
else
{
//printf("No input file specified; using 'instrformats_32.in'.\n");
yyin = UTIL_fopenR("instrformats_32.in");
}
}
else
{
yyin = UTIL_fopenR(argv[1]);
}
if(argc > 2)
{
root = argv[2];
}
else
{
//printf("Teyjus source root directory not specified; using '../../'.\n");
root = "../../";
}
//printf("Generating instruction files...\n");
ret = yyparse();
UTIL_fclose(yyin);
if(ret != 0)
{
printf("Generation failed.\n");
return -1;
}
cspitCInstructionsH(root);
cspitCInstructionsC(root);
cspitSimDispatch(root);
ocSpitInstructionHS(root);
//printf("Done.\n");
return 0;
}

346
src/runtime/c/teyjus/tables_gen/instrformats/instrformats_32.in
View File

@@ -1,346 +0,0 @@
{
type intref = int ref
type aconstant = Absyn.aconstant
type akind = Absyn.akind
}
OPERAND TYPES
P /* (1 byte) padding */
WP /* (1 word) padding */
R RegInd Byte 1 int /* argument register number */
E EnvInd Byte 1 int /* environment variable number */
N NextClauseInd Byte 1 int /* next clause number in impt or impl pt */
I1 OneByteInt Byte 1 int /* 1 byte natural number */
CE ClEnvInd Byte 1 int /* closure environment variable number */
SEG ImpSegInd Byte 1 int /* import segment index */
C CstIndex TwoBytes 2 aconstant /* constant symbol table index */
K KstIndex TwoBytes 2 akind /* kind symbol table index */
L CodeLabel CSpacePtr 4 intref /* code location */
I Int int 4 int /* integer immediate value */
F Float float 4 float /* floating point immediate value */
S Str DF_StrDataPtr 2 int /* string pointer */
MT ModTab MemPtr 2 int /* module table address */
IT ImplTab MemPtr 2 int /* impl table address */
HT HashTab MemPtr 2 int /* hash table address */
BVT BranchTab MemPtr 2 int /* branch table for bound var indexing */
X /* operand list terminator */
OPCODE Byte 1
INSTR CATEGORY
MAX OPERAND 8
X [P P P X X X X X]
X_LEN 4
RX [R P P X X X X X]
RX_LEN 4; RX_R 1
EX [E P P X X X X X]
EX_LEN 4; EX_E 1
I1X [I1 P P X X X X X]
I1X_LEN 4; I1X_I1 1
CX [P C X X X X X X]
CX_LEN 4; CX_C 2
KX [P K X X X X X X]
KX_LEN 4; KX_K 2
IX [P P P I X X X X]
IX_LEN 8; IX_I 4
FX [P P P F X X X X]
FX_LEN 8; FX_F 4
SX [P P P S X X X X]
SX_LEN 8; SX_S 4
MTX [P P P MT X X X X]
MTX_LEN 8; MTX_MT 4
LX [P P P L X X X X]
LX_LEN 8; LX_L 4
RRX [R R P X X X X X]
RRX_LEN 4; RRX_R1 1; RRX_R2 2
ERX [E R P X X X X X]
ERX_LEN 4; ERX_E 1; ERX_R 2
RCX [R C X X X X X X]
RCX_LEN 4; RCX_R 1; RCX_C 2
RIX [R P P I X X X X]
RIX_LEN 8; RIX_R 1; RIX_I 4
RFX [R P P F X X X X]
RFX_LEN 8; RFX_R 1; RFX_F 4
RSX [R P P S X X X X]
RSX_LEN 8; RSX_R 1; RSX_S 4
RI1X [R I1 P X X X X X]
RI1X_LEN 4; RI1X_R 1; RI1X_I1 2
RCEX [R CE P X X X X X]
RCEX_LEN 4; RCEX_R 1; RCEX_CE 2
ECEX [E CE P X X X X X]
ECEX_LEN 4; ECEX_E 1; ECEX_CE 2
CLX [P C L X X X X X]
CLX_LEN 8; CLX_C 2; CLX_L 4
RKX [R K X X X X X X]
RKX_LEN 4; RKX_R 1; RKX_K 2
ECX [E C X X X X X X]
ECX_LEN 4; ECX_E 1; ECX_C 2
I1ITX [I1 P P IT X X X X]
I1ITX_LEN 8; I1ITX_I1 1; I1ITX_IT 4
I1LX [I1 P P L X X X X]
I1LX_LEN 8; I1LX_I1 1; I1LX_L 4
SEGLX [SEG P P L X X X X]
SEGLX_LEN 8; SEGLX_SEG 1; SEGLX_L 4
I1LWPX [I1 P P L WP X X X]
I1LWPX_LEN 12; I1LWPX_I1 1; I1LWPX_L 4
I1NX [I1 N P X X X X X]
I1NX_LEN 4; I1NX_I1 1; I1NX_N 2
I1HTX [I1 P P HT X X X X]
I1HTX_LEN 8; I1HTX_I1 1; I1HTX_HT 4
I1BVTX [I1 P P BVT X X X X]
I1BVTX_LEN 8; I1BVTX_I1 1; I1BVTX_BVT 4
CWPX [P C WP X X X X X]
CWPX_LEN 8; CWPX_C 2
I1WPX [I1 P P WP X X X X]
I1WPX_LEN 8; I1WPX_I1 1
RRI1X [R R I1 X X X X X]
RRI1X_LEN 4; RRI1X_R1 1; RRI1X_R2 2; RRI1X_I1 3
RCLX [R C L X X X X X]
RCLX_LEN 8; RCLX_R 1; RCLX_C 2; RCLX_L 4
RCI1X [R C I1 P P P X X]
RCI1X_LEN 8; RCI1X_R 1; RCI1X_C 2; RCI1X_I1 4
SEGI1LX [SEG I1 P L X X X X]
SEGI1LX_LEN 8; SEGI1LX_SEG 1; SEGI1LX_I1 2; SEGI1LX_L 4
I1LLX [I1 P P L L X X X]
I1LLX_LEN 12; I1LLX_I1 1; I1LLX_L1 4; I1LLX_L2 8
NLLX [N P P L L X X X]
NLLX_LEN 12; NLLX_N 1; NLLX_L1 4; NLLX_L2 8
LLLLX [P P P L L L L X]
LLLLX_LEN 20; LLLLX_L1 4; LLLLX_L2 8; LLLLX_L3 12; LLLLX_L4 16
I1CWPX [I1 C WP X X X X X]
I1CWPX_LEN 8; I1CWPX_I1 1; I1CWPX_C 2
I1I1WPX [I1 I1 P WP X X X X]
I1I1WPX_LEN 8; I1I1WPX_I11 1; I1I1WPX_I12 2
CALL_I1_LEN 7
INSTRUCTIONS 145
/* Instructions for term unification and creation */
0 put_variable_t RRX RRX_LEN;
1 put_variable_p ERX ERX_LEN;
2 put_value_t RRX RRX_LEN;
3 put_value_p ERX ERX_LEN;
4 put_unsafe_value ERX ERX_LEN;
5 copy_value ERX ERX_LEN;
6 put_m_const RCX RCX_LEN;
7 put_p_const RCX RCX_LEN;
8 put_nil RX RX_LEN;
9 put_integer RIX RIX_LEN;
10 put_float RFX RFX_LEN;
11 put_string RSX RSX_LEN;
12 put_index RI1X RI1X_LEN;
13 put_app RRI1X RRI1X_LEN;
14 put_list RX RX_LEN;
15 put_lambda RRI1X RRI1X_LEN;
16 set_variable_t RX RX_LEN;
17 set_variable_te RX RX_LEN;
18 set_variable_p EX EX_LEN;
19 set_value_t RX RX_LEN;
20 set_value_p EX EX_LEN;
21 globalize_pt ERX ERX_LEN;
22 globalize_t RX RX_LEN;
23 set_m_const CX CX_LEN;
24 set_p_const CX CX_LEN;
25 set_nil X X_LEN;
26 set_integer IX IX_LEN;
27 set_float FX FX_LEN;
28 set_string SX SX_LEN;
29 set_index I1X I1X_LEN;
30 set_void I1X I1X_LEN;
31 deref RX RX_LEN;
32 set_lambda RI1X RI1X_LEN;
33 get_variable_t RRX RRX_LEN;
34 get_variable_p ERX ERX_LEN;
35 init_variable_t RCEX RCEX_LEN;
36 init_variable_p ECEX ECEX_LEN;
37 get_m_constant RCX RCX_LEN;
38 get_p_constant RCLX RCLX_LEN;
39 get_integer RIX RIX_LEN;
40 get_float RFX RFX_LEN;
41 get_string RSX RSX_LEN;
42 get_nil RX RX_LEN;
43 get_m_structure RCI1X RCI1X_LEN;
44 get_p_structure RCI1X RCI1X_LEN;
45 get_list RX RX_LEN;
46 unify_variable_t RX RX_LEN;
47 unify_variable_p EX EX_LEN;
48 unify_value_t RX RX_LEN;
49 unify_value_p EX EX_LEN;
50 unify_local_value_t RX RX_LEN;
51 unify_local_value_p EX EX_LEN;
52 unify_m_constant CX CX_LEN;
53 unify_p_constant CLX CLX_LEN;
54 unify_integer IX IX_LEN;
55 unify_float FX FX_LEN;
56 unify_string SX SX_LEN;
57 unify_nil X X_LEN;
58 unify_void I1X I1X_LEN;
/* Instructions for type unification and creation */
59 put_type_variable_t RRX RRX_LEN;
60 put_type_variable_p ERX ERX_LEN;
61 put_type_value_t RRX RRX_LEN;
62 put_type_value_p ERX ERX_LEN;
63 put_type_unsafe_value ERX ERX_LEN;
64 put_type_const RKX RKX_LEN;
65 put_type_structure RKX RKX_LEN;
66 put_type_arrow RX RX_LEN;
67 set_type_variable_t RX RX_LEN;
68 set_type_variable_p EX EX_LEN;
69 set_type_value_t RX RX_LEN;
70 set_type_value_p EX EX_LEN;
71 set_type_local_value_t RX RX_LEN;
72 set_type_local_value_p EX EX_LEN;
73 set_type_constant KX KX_LEN;
74 get_type_variable_t RRX RRX_LEN;
75 get_type_variable_p ERX ERX_LEN;
76 init_type_variable_t RCEX RCEX_LEN;
77 init_type_variable_p ECEX ECEX_LEN;
78 get_type_value_t RRX RRX_LEN;
79 get_type_value_p ERX ERX_LEN;
80 get_type_constant RKX RKX_LEN;
81 get_type_structure RKX RKX_LEN;
82 get_type_arrow RX RX_LEN;
83 unify_type_variable_t RX RX_LEN;
84 unify_type_variable_p EX EX_LEN;
85 unify_type_value_t RX RX_LEN;
86 unify_type_value_p EX EX_LEN;
87 unify_envty_value_t RX RX_LEN;
88 unify_envty_value_p EX EX_LEN;
89 unify_type_local_value_t RX RX_LEN;
90 unify_type_local_value_p EX EX_LEN;
91 unify_envty_local_value_t RX RX_LEN;
92 unify_envty_local_value_p EX EX_LEN;
93 unify_type_constant KX KX_LEN;
/* Instructions for handling higher-order aspects */
94 pattern_unify_t RRX RRX_LEN;
95 pattern_unify_p ERX ERX_LEN;
96 finish_unify X X_LEN;
97 head_normalize_t RX RX_LEN;
98 head_normalize_p EX EX_LEN;
/* Instructions for handling logical aspects */
99 incr_universe X X_LEN;
100 decr_universe X X_LEN;
101 set_univ_tag ECX ECX_LEN;
102 tag_exists_t RX RX_LEN;
103 tag_exists_p EX EX_LEN;
104 tag_variable EX EX_LEN;
105 push_impl_point I1ITX I1ITX_LEN;
106 pop_impl_point X X_LEN;
107 add_imports SEGI1LX SEGI1LX_LEN;
108 remove_imports SEGLX SEGLX_LEN;
109 push_import MTX MTX_LEN;
110 pop_imports I1X I1X_LEN;
/* Control Instructions */
111 allocate I1X I1X_LEN;
112 deallocate X X_LEN;
113 call I1LX I1LX_LEN;
114 call_name I1CWPX I1CWPX_LEN;
115 execute LX LX_LEN;
116 execute_name CWPX CWPX_LEN;
117 proceed X X_LEN;
/* Choice Instructions */
118 try_me_else I1LX I1LX_LEN;
119 retry_me_else I1LX I1LX_LEN;
120 trust_me I1WPX I1WPX_LEN;
121 try I1LX I1LX_LEN;
122 retry I1LX I1LX_LEN;
123 trust I1LWPX I1LWPX_LEN;
124 trust_ext I1NX I1NX_LEN;
125 try_else I1LLX I1LLX_LEN;
126 retry_else I1LLX I1LLX_LEN;
127 branch LX LX_LEN;
/* Indexing Instructions */
128 switch_on_term LLLLX LLLLX_LEN;
129 switch_on_constant I1HTX I1HTX_LEN;
130 switch_on_bvar I1BVTX I1BVTX_LEN;
131 switch_on_reg NLLX NLLX_LEN;
/* Cut Instructions */
132 neck_cut X X_LEN;
133 get_level EX EX_LEN;
134 put_level EX EX_LEN;
135 cut EX EX_LEN;
/* Miscellaneous Instructions */
136 call_builtin I1I1WPX I1I1WPX_LEN;
137 builtin I1X I1X_LEN;
138 stop X X_LEN;
139 halt X X_LEN;
140 fail X X_LEN;
/* new added */
141 create_type_variable EX EX_LEN;
/* resolved by the linker */
142 execute_link_only CWPX CWPX_LEN;
143 call_link_only I1CWPX I1CWPX_LEN;
144 put_variable_te RRX RRX_LEN

346
src/runtime/c/teyjus/tables_gen/instrformats/instrformats_64.in
View File

@@ -1,346 +0,0 @@
{
type intref = int ref
type aconstant = Absyn.aconstant
type akind = Absyn.akind
}
OPERAND TYPES
P /* (1 byte) padding */
WP /* (1 word) padding */
R RegInd Byte 1 int /* argument register number */
E EnvInd Byte 1 int /* environment variable number */
N NextClauseInd Byte 1 int /* next clause number in impt or impl pt */
I1 OneByteInt Byte 1 int /* 1 byte natural number */
CE ClEnvInd Byte 1 int /* closure environment variable number */
SEG ImpSegInd Byte 1 int /* import segment index */
C CstIndex TwoBytes 2 aconstant /* constant symbol table index */
K KstIndex TwoBytes 2 akind /* kind symbol table index */
L CodeLabel CSpacePtr 8 intref /* code location */
I Int int 4 int /* integer immediate value */
F Float float 4 float /* floating point immediate value */
S Str DF_StrDataPtr 2 int /* string pointer */
MT ModTab MemPtr 2 int /* module table address */
IT ImplTab MemPtr 2 int /* impl table address */
HT HashTab MemPtr 2 int /* hash table address */
BVT BranchTab MemPtr 2 int /* branch table for bound var indexing */
X /* operand list terminator */
OPCODE Byte 1
INSTR CATEGORY
MAX OPERAND 12
X [P P P P P P P X X X X X]
X_LEN 8
RX [R P P P P P P X X X X X]
RX_LEN 8; RX_R 1
EX [E P P P P P P X X X X X]
EX_LEN 8; EX_E 1
I1X [I1 P P P P P P X X X X X]
I1X_LEN 8; I1X_I1 1
CX [P C P P P P X X X X X X]
CX_LEN 8; CX_C 2
KX [P K P P P P X X X X X X]
KX_LEN 8; KX_K 2
IX [P P P P P P P I X X X X]
IX_LEN 16; IX_I 8
FX [P P P P P P P F X X X X]
FX_LEN 16; FX_F 8
SX [P P P P P P P S X X X X]
SX_LEN 16; SX_S 8
MTX [P P P P P P P MT X X X X]
MTX_LEN 16; MTX_MT 8
LX [P P P P P P P L X X X X]
LX_LEN 16; LX_L 8
RRX [R R P P P P P X X X X X]
RRX_LEN 8; RRX_R1 1; RRX_R2 2
ERX [E R P P P P P X X X X X]
ERX_LEN 8; ERX_E 1; ERX_R 2
RCX [R C P P P P X X X X X X]
RCX_LEN 8; RCX_R 1; RCX_C 2
RIX [R P P P P P P I X X X X]
RIX_LEN 16; RIX_R 1; RIX_I 8
RFX [R P P P P P P F X X X X]
RFX_LEN 16; RFX_R 1; RFX_F 8
RSX [R P P P P P P S X X X X]
RSX_LEN 16; RSX_R 1; RSX_S 8
RI1X [R I1 P P P P P X X X X X]
RI1X_LEN 8; RI1X_R 1; RI1X_I1 2
RCEX [R CE P P P P P X X X X X]
RCEX_LEN 8; RCEX_R 1; RCEX_CE 2
ECEX [E CE P P P P P X X X X X]
ECEX_LEN 8; ECEX_E 1; ECEX_CE 2
CLX [P C P P P P L X X X X X]
CLX_LEN 16; CLX_C 2; CLX_L 8
RKX [R K P P P P X X X X X X]
RKX_LEN 8; RKX_R 1; RKX_K 2
ECX [E C P P P P X X X X X X]
ECX_LEN 8; ECX_E 1; ECX_C 2
I1ITX [I1 P P P P P P IT X X X X]
I1ITX_LEN 16; I1ITX_I1 1; I1ITX_IT 8
I1LX [I1 P P P P P P L X X X X]
I1LX_LEN 16; I1LX_I1 1; I1LX_L 8
SEGLX [SEG P P P P P P L X X X X]
SEGLX_LEN 16; SEGLX_SEG 1; SEGLX_L 8
I1LWPX [I1 P P P P P P L WP X X X]
I1LWPX_LEN 24; I1LWPX_I1 1; I1LWPX_L 8
I1NX [I1 N P P P P P X X X X X]
I1NX_LEN 8; I1NX_I1 1; I1NX_N 2
I1HTX [I1 P P P P P P HT X X X X]
I1HTX_LEN 16; I1HTX_I1 1; I1HTX_HT 8
I1BVTX [I1 P P P P P P BVT X X X X]
I1BVTX_LEN 16; I1BVTX_I1 1; I1BVTX_BVT 8
CWPX [P C P P P P WP X X X X X]
CWPX_LEN 16; CWPX_C 2
I1WPX [I1 P P P P P P WP X X X X]
I1WPX_LEN 16; I1WPX_I1 1
RRI1X [R R I1 P P P P X X X X X]
RRI1X_LEN 8; RRI1X_R1 1; RRI1X_R2 2; RRI1X_I1 3
RCLX [R C P P P P L X X X X X]
RCLX_LEN 16; RCLX_R 1; RCLX_C 2; RCLX_L 8
RCI1X [R C I1 P P P X X X X X X]
RCI1X_LEN 8; RCI1X_R 1; RCI1X_C 2; RCI1X_I1 4
SEGI1LX [SEG I1 P P P P P L X X X X]
SEGI1LX_LEN 16; SEGI1LX_SEG 1; SEGI1LX_I1 2; SEGI1LX_L 8
I1LLX [I1 P P P P P P L L X X X]
I1LLX_LEN 24; I1LLX_I1 1; I1LLX_L1 8; I1LLX_L2 16
NLLX [N P P P P P P L L X X X]
NLLX_LEN 24; NLLX_N 1; NLLX_L1 8; NLLX_L2 16
LLLLX [P P P P P P P L L L L X]
LLLLX_LEN 40; LLLLX_L1 8; LLLLX_L2 16; LLLLX_L3 24; LLLLX_L4 32
I1CWPX [I1 C P P P P WP X X X X X]
I1CWPX_LEN 16; I1CWPX_I1 1; I1CWPX_C 2
I1I1WPX [I1 I1 P P P P P WP X X X X]
I1I1WPX_LEN 16; I1I1WPX_I11 1; I1I1WPX_I12 2
CALL_I1_LEN 15
INSTRUCTIONS 145
/* Instructions for term unification and creation */
0 put_variable_t RRX RRX_LEN;
1 put_variable_p ERX ERX_LEN;
2 put_value_t RRX RRX_LEN;
3 put_value_p ERX ERX_LEN;
4 put_unsafe_value ERX ERX_LEN;
5 copy_value ERX ERX_LEN;
6 put_m_const RCX RCX_LEN;
7 put_p_const RCX RCX_LEN;
8 put_nil RX RX_LEN;
9 put_integer RIX RIX_LEN;
10 put_float RFX RFX_LEN;
11 put_string RSX RSX_LEN;
12 put_index RI1X RI1X_LEN;
13 put_app RRI1X RRI1X_LEN;
14 put_list RX RX_LEN;
15 put_lambda RRI1X RRI1X_LEN;
16 set_variable_t RX RX_LEN;
17 set_variable_te RX RX_LEN;
18 set_variable_p EX EX_LEN;
19 set_value_t RX RX_LEN;
20 set_value_p EX EX_LEN;
21 globalize_pt ERX ERX_LEN;
22 globalize_t RX RX_LEN;
23 set_m_const CX CX_LEN;
24 set_p_const CX CX_LEN;
25 set_nil X X_LEN;
26 set_integer IX IX_LEN;
27 set_float FX FX_LEN;
28 set_string SX SX_LEN;
29 set_index I1X I1X_LEN;
30 set_void I1X I1X_LEN;
31 deref RX RX_LEN;
32 set_lambda RI1X RI1X_LEN;
33 get_variable_t RRX RRX_LEN;
34 get_variable_p ERX ERX_LEN;
35 init_variable_t RCEX RCEX_LEN;
36 init_variable_p ECEX ECEX_LEN;
37 get_m_constant RCX RCX_LEN;
38 get_p_constant RCLX RCLX_LEN;
39 get_integer RIX RIX_LEN;
40 get_float RFX RFX_LEN;
41 get_string RSX RSX_LEN;
42 get_nil RX RX_LEN;
43 get_m_structure RCI1X RCI1X_LEN;
44 get_p_structure RCI1X RCI1X_LEN;
45 get_list RX RX_LEN;
46 unify_variable_t RX RX_LEN;
47 unify_variable_p EX EX_LEN;
48 unify_value_t RX RX_LEN;
49 unify_value_p EX EX_LEN;
50 unify_local_value_t RX RX_LEN;
51 unify_local_value_p EX EX_LEN;
52 unify_m_constant CX CX_LEN;
53 unify_p_constant CLX CLX_LEN;
54 unify_integer IX IX_LEN;
55 unify_float FX FX_LEN;
56 unify_string SX SX_LEN;
57 unify_nil X X_LEN;
58 unify_void I1X I1X_LEN;
/* Instructions for type unification and creation */
59 put_type_variable_t RRX RRX_LEN;
60 put_type_variable_p ERX ERX_LEN;
61 put_type_value_t RRX RRX_LEN;
62 put_type_value_p ERX ERX_LEN;
63 put_type_unsafe_value ERX ERX_LEN;
64 put_type_const RKX RKX_LEN;
65 put_type_structure RKX RKX_LEN;
66 put_type_arrow RX RX_LEN;
67 set_type_variable_t RX RX_LEN;
68 set_type_variable_p EX EX_LEN;
69 set_type_value_t RX RX_LEN;
70 set_type_value_p EX EX_LEN;
71 set_type_local_value_t RX RX_LEN;
72 set_type_local_value_p EX EX_LEN;
73 set_type_constant KX KX_LEN;
74 get_type_variable_t RRX RRX_LEN;
75 get_type_variable_p ERX ERX_LEN;
76 init_type_variable_t RCEX RCEX_LEN;
77 init_type_variable_p ECEX ECEX_LEN;
78 get_type_value_t RRX RRX_LEN;
79 get_type_value_p ERX ERX_LEN;
80 get_type_constant RKX RKX_LEN;
81 get_type_structure RKX RKX_LEN;
82 get_type_arrow RX RX_LEN;
83 unify_type_variable_t RX RX_LEN;
84 unify_type_variable_p EX EX_LEN;
85 unify_type_value_t RX RX_LEN;
86 unify_type_value_p EX EX_LEN;
87 unify_envty_value_t RX RX_LEN;
88 unify_envty_value_p EX EX_LEN;
89 unify_type_local_value_t RX RX_LEN;
90 unify_type_local_value_p EX EX_LEN;
91 unify_envty_local_value_t RX RX_LEN;
92 unify_envty_local_value_p EX EX_LEN;
93 unify_type_constant KX KX_LEN;
/* Instructions for handling higher-order aspects */
94 pattern_unify_t RRX RRX_LEN;
95 pattern_unify_p ERX ERX_LEN;
96 finish_unify X X_LEN;
97 head_normalize_t RX RX_LEN;
98 head_normalize_p EX EX_LEN;
/* Instructions for handling logical aspects */
99 incr_universe X X_LEN;
100 decr_universe X X_LEN;
101 set_univ_tag ECX ECX_LEN;
102 tag_exists_t RX RX_LEN;
103 tag_exists_p EX EX_LEN;
104 tag_variable EX EX_LEN;
105 push_impl_point I1ITX I1ITX_LEN;
106 pop_impl_point X X_LEN;
107 add_imports SEGI1LX SEGI1LX_LEN;
108 remove_imports SEGLX SEGLX_LEN;
109 push_import MTX MTX_LEN;
110 pop_imports I1X I1X_LEN;
/* Control Instructions */
111 allocate I1X I1X_LEN;
112 deallocate X X_LEN;
113 call I1LX I1LX_LEN;
114 call_name I1CWPX I1CWPX_LEN;
115 execute LX LX_LEN;
116 execute_name CWPX CWPX_LEN;
117 proceed X X_LEN;
/* Choice Instructions */
118 try_me_else I1LX I1LX_LEN;
119 retry_me_else I1LX I1LX_LEN;
120 trust_me I1WPX I1WPX_LEN;
121 try I1LX I1LX_LEN;
122 retry I1LX I1LX_LEN;
123 trust I1LWPX I1LWPX_LEN;
124 trust_ext I1NX I1NX_LEN;
125 try_else I1LLX I1LLX_LEN;
126 retry_else I1LLX I1LLX_LEN;
127 branch LX LX_LEN;
/* Indexing Instructions */
128 switch_on_term LLLLX LLLLX_LEN;
129 switch_on_constant I1HTX I1HTX_LEN;
130 switch_on_bvar I1BVTX I1BVTX_LEN;
131 switch_on_reg NLLX NLLX_LEN;
/* Cut Instructions */
132 neck_cut X X_LEN;
133 get_level EX EX_LEN;
134 put_level EX EX_LEN;
135 cut EX EX_LEN;
/* Miscellaneous Instructions */
136 call_builtin I1I1WPX I1I1WPX_LEN;
137 builtin I1X I1X_LEN;
138 stop X X_LEN;
139 halt X X_LEN;
140 fail X X_LEN;
/* new added */
141 create_type_variable EX EX_LEN;
/* resolved by the linker */
142 execute_link_only CWPX CWPX_LEN;
143 call_link_only I1CWPX I1CWPX_LEN;
144 put_variable_te RRX RRX_LEN

650
src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.c
View File

@@ -1,650 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/******************************************************************************/
/* File instrgen-c.h. This files contains function declarations for generating*/
/* files instructions.h and instructions.c */
/******************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "instrgen-c.h"
#include "../util/util.h"
#define INDENT1 " "
#define INDENT1_LEN 4u
#define PREFIX "INSTR_"
#define PREFIX_LEN 6u
#define CATPREFIX "INSTR_CAT_"
#define CATPREFIX_LEN 10u
#define DEF "#define "
#define DEF_LEN 8u
/*************************************************************************/
/* instructions.h */
/*************************************************************************/
#define COMMENTS_BEG_H \
"/****************************************************************************/\n/* File instructions.h. */ \n/* This file defines instruction operand types, instruction categories and */ \n/* instruction opcode. */ \n/****************************************************************************/ \n"
#define COMPDEF_BEG_H "#ifndef INSTRUCTIONS_H\n#define INSTRUCTIONS_H\n"
#define COMPDEF_END_H "#endif //INSTRUCTIONS_H\n"
#define INCLUDE_H \
"#include \"../simulator/mctypes.h\" //to be changed \n#include \"../simulator/dataformats.h\" //to be changed \n"
/* OPERAND TYPES */
#define OPTYPES_COMMENTS_H \
"/****************************************************************************/\n/* OPERAND TYPES */ \n/****************************************************************************/ \n\n"
#define OPTYPES_COMMENTS_H_LEN 300
#define OPERAND_TYPE_BEG \
"/* possible types of instruction operands */ \ntypedef enum INSTR_OperandType \n{\n"
#define OPERAND_TYPE_BEG_LEN 200
#define OPERAND_TYPE_END "} INSTR_OperandType;\n\n"
#define OPERAND_TYPE_END_LEN 30
static char* opTypes = NULL;
static char* opTypeMaps = NULL ;
void cgenOpTypes(char *name, char* typeName, char* types, char* comments,
int last)
{
char* myOpTypes = opTypes;
char* myOpTypeMaps = opTypeMaps;
size_t length;
size_t commentLen = comments ? strlen(comments) : 0u;
length = (opTypes ? strlen(opTypes) : 0u) + INDENT1_LEN + PREFIX_LEN +
strlen(name) + (comments ? strlen(comments) : 0u) + 30u;
opTypes = UTIL_mallocStr(length);
if (myOpTypes) { strcpy(opTypes, myOpTypes); strcat(opTypes, INDENT1); }
else strcpy(opTypes, INDENT1);
if (comments) {
strcat(opTypes, "//");
strcat(opTypes, comments);
strcat(opTypes, "\n");
strcat(opTypes, INDENT1);
}
strcat(opTypes, PREFIX);
strcat(opTypes, name);
if (last) strcat(opTypes, "\n");
else strcat(opTypes, ",\n");
if (myOpTypes) free(myOpTypes);
if (typeName) {
length = (opTypeMaps ? strlen(opTypeMaps) : 0u) + PREFIX_LEN +
strlen(types) + strlen(typeName) + 30u;
opTypeMaps = UTIL_mallocStr(length);
if (myOpTypeMaps) {
strcpy(opTypeMaps, myOpTypeMaps);
strcat(opTypeMaps, "typedef ");
} else strcpy(opTypeMaps, "typedef ");
strcat(opTypeMaps, types);
strcat(opTypeMaps, " ");
strcat(opTypeMaps, PREFIX);
strcat(opTypeMaps, typeName);
strcat(opTypeMaps, ";\n");
if (myOpTypeMaps) free(myOpTypeMaps);
}
}
#define OPTYPEMAP_COMMENT \
"/**************************************************************************/ \n/* Types for instruction operants */ \n/**************************************************************************/ \n\n"
#define OPTYPEMAP_COMMENT_LEN 300
static char *opcodeType = NULL;
void cgenOpCodeType(char* optype)
{
size_t length = PREFIX_LEN + strlen(optype) + 50;
opcodeType = UTIL_mallocStr(length);
strcpy(opcodeType, "typedef ");
strcat(opcodeType, optype);
strcat(opcodeType, " ");
strcat(opcodeType, PREFIX);
strcat(opcodeType, "OpCode;\n");
}
static char *opsH = NULL;
void cgenOpsH() //assume neither opTypes nor opTypeMaps is empty
{
size_t length = OPTYPES_COMMENTS_H_LEN + OPERAND_TYPE_BEG_LEN +
OPTYPEMAP_COMMENT_LEN + OPERAND_TYPE_END_LEN + strlen(opTypes) +
strlen(opTypeMaps) + strlen(opcodeType) + 50u;
opsH = UTIL_mallocStr(length);
strcpy(opsH, OPTYPES_COMMENTS_H);
strcat(opsH, OPERAND_TYPE_BEG);
strcat(opsH, opTypes);
strcat(opsH, OPERAND_TYPE_END);
strcat(opsH, OPTYPEMAP_COMMENT);
strcat(opsH, opcodeType);
strcat(opsH, opTypeMaps);
free(opTypes);
free(opcodeType);
free(opTypeMaps);
}
/* INSTRUCTION CATEGORIES */
#define INSTRCAT_COMMENTS_H \
"/***************************************************************************/ \n/* INSTRUCTION CATEGORIES */ \n/***************************************************************************/ \n"
#define INSTRCAT_COMMENTS_H_LEN 300
#define INSTRCAT_TYPE_BEG \
" /* The names of instruction categories no longer include padding bytes. */\n/* Thus we do not need to maintain two sets of names for different machine */ \n/* architectures. */ \ntypedef enum INSTR_InstrCategory \n{\n"
#define INSTRCAT_TYPE_BEG_LEN 350
#define INSTRCAT_TYPE_END "} INSTR_InstrCategory;\n\n"
#define INSTRCAT_TYPE_END_LEN 50
static char *instrcat_type = NULL;
static char *instrLen = NULL;
static char *oneInstrLen = NULL;
static int catNum = 0;
void cgenOneInstrCatH(char* name, int last)
{
char *myInstrCat = instrcat_type, *myInstrLen = instrLen;
size_t length = (myInstrCat ? strlen(myInstrCat) : 0u) + strlen(name) +
CATPREFIX_LEN + INDENT1_LEN + 10u;
instrcat_type = UTIL_mallocStr(length);
if (myInstrCat) {
strcpy(instrcat_type, myInstrCat);
strcat(instrcat_type, INDENT1);
} else strcpy(instrcat_type, INDENT1);
strcat(instrcat_type, CATPREFIX);
strcat(instrcat_type, name);
strcat(instrcat_type, " = ");
strcat(instrcat_type, UTIL_itoa(catNum));
if (last) strcat(instrcat_type, "\n");
else strcat(instrcat_type, ",\n");
catNum++;
if (myInstrCat) free(myInstrCat);
//assume oneInstrLen cannot be empty
length = (myInstrLen ? strlen(myInstrLen) : 0u) + strlen(name) +
CATPREFIX_LEN + 10u + strlen(oneInstrLen);
instrLen = UTIL_mallocStr(length);
if (myInstrLen) {
strcpy(instrLen, myInstrLen);
strcat(instrLen, "//");
} else strcpy(instrLen, "//");
strcat(instrLen, CATPREFIX);
strcat(instrLen, name);
strcat(instrLen, "\n");
strcat(instrLen, oneInstrLen);
free(oneInstrLen);
oneInstrLen = NULL;
if (myInstrLen) free(myInstrLen);
}
#define INSTRLEN_COMMENTS \
"/**************************************************************************/ \n/* Macros defines instruction lengths and distances between op code and */ \n/* operands. */ \n/* The assumption is that the op code occupies 1 byte. */ \n/**************************************************************************/ \n\n"
#define INSTRLEN_COMMENTS_LEN 450u
void cgenInstrLength(char* name, char* len)
{
char *myInstrLen = oneInstrLen;
size_t length = (myInstrLen ? strlen(myInstrLen) : 0u) + DEF_LEN + PREFIX_LEN
+ strlen(name) + strlen(len) + 10u;
oneInstrLen = UTIL_mallocStr(length);
if (myInstrLen) {
strcpy(oneInstrLen, myInstrLen);
strcat(oneInstrLen, DEF);
} else strcpy(oneInstrLen, DEF);
strcat(oneInstrLen, PREFIX);
strcat(oneInstrLen, name);
strcat(oneInstrLen, " ");
strcat(oneInstrLen, len);
strcat(oneInstrLen, "\n");
free(myInstrLen);
}
#define OPTYPE_TAB_H \
"/****************************************************************************/\n/* OPERAND TYPES TABLE */ \n/****************************************************************************/ \n \n//the operand types array in a given entry \nINSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index); \n"
#define OPTYPE_TAB_H_LEN 500
static char *instrCatH = NULL;
void cgenInstrCatH(char* callI1Len)
{
size_t length = strlen(instrcat_type) + strlen(instrLen) +
INSTRCAT_TYPE_BEG_LEN + INSTRCAT_TYPE_END_LEN + INSTRCAT_COMMENTS_H_LEN
+ INSTRLEN_COMMENTS_LEN + OPTYPE_TAB_H_LEN + 160u;
instrCatH = UTIL_mallocStr(length);
strcpy(instrCatH, INSTRCAT_COMMENTS_H);
strcat(instrCatH, INSTRCAT_TYPE_BEG);
strcat(instrCatH, instrcat_type);
strcat(instrCatH, INSTRCAT_TYPE_END);
strcat(instrCatH, DEF);
strcat(instrCatH, "INSTR_NUM_INSTR_CATS ");
strcat(instrCatH, UTIL_itoa(catNum));
strcat(instrCatH, "\n\n");
strcat(instrCatH, DEF);
strcat(instrCatH, "INSTR_CALL_I1_LEN ");
strcat(instrCatH, callI1Len);
strcat(instrCatH, "\n\n");
strcat(instrCatH, INSTRLEN_COMMENTS);
strcat(instrCatH, instrLen);
strcat(instrCatH, "\n");
strcat(instrCatH, OPTYPE_TAB_H);
free(instrcat_type);
free(instrLen);
}
#define INSTR_COMMENTS_H \
"/***************************************************************************/ \n/* OPCODES OF INSTRUCTIONS */ \n/***************************************************************************/ \n"
#define INSTR_COMMENTS_H_LEN 250
static char* instrH = NULL;
void cgenOneInstrH(char* comments, char* opCode, char* instrName)
{
char* myInstrH = instrH;
size_t length = (myInstrH ? strlen(myInstrH) : 0u) + strlen(instrName) +
strlen(opCode) + DEF_LEN + CATPREFIX_LEN +
(comments ? strlen(comments) : 0u) + 10u;
instrH = UTIL_mallocStr(length);
if (myInstrH) {
strcpy(instrH, myInstrH);
if (comments) {
strcat(instrH, "//");
strcat(instrH, comments);
strcat(instrH, "\n");
strcat(instrH, DEF);
} else strcat(instrH, DEF);
} else {
if (comments) {
strcpy(instrH, "//");
strcat(instrH, comments);
strcat(instrH, "\n");
strcat(instrH, DEF);
} else strcpy(instrH, DEF);
}
strcat(instrH, instrName);
strcat(instrH, " ");
strcat(instrH, opCode);
strcat(instrH, "\n");
if (myInstrH) free(myInstrH);
}
#define INSTRTAB_H \
"/***************************************************************************/ \n/* INSTRUCTION INFORMATION TABLE */ \n/***************************************************************************/ \nINSTR_InstrCategory INSTR_instrType(int index); //instr type in a given entry \nchar* INSTR_instrName(int index); //instr name in a given entry \nint INSTR_instrSize(int index); //instr size in a given entry \n"
#define INSTRTAB_H_LEN 500
char* instrOpc = NULL;
void cgenInstrH(char* numInstr)
{
size_t length = INSTR_COMMENTS_H_LEN + strlen(instrH) + DEF_LEN +
strlen(numInstr) + INSTRTAB_H_LEN + 20u;
instrOpc = UTIL_mallocStr(length);
strcpy(instrOpc, INSTR_COMMENTS_H);
strcat(instrOpc, instrH);
strcat(instrOpc, "\n\n");
strcat(instrOpc, DEF);
strcat(instrOpc, "INSTR_NUM_INSTRS");
strcat(instrOpc, " ");
strcat(instrOpc, numInstr);
strcat(instrOpc, "\n\n");
strcat(instrOpc, INSTRTAB_H);
free(instrH);
}
/* dump instructions.h" */
void cspitCInstructionsH(char * root)
{
FILE* outFile;
char * filename = malloc(strlen(root) + 32);
strcpy(filename, root);
strcat(filename, "tables/instructions.h");
outFile = UTIL_fopenW(filename);
fprintf(outFile, "%s\n%s\n%s\n", COMMENTS_BEG_H, COMPDEF_BEG_H, INCLUDE_H);
fprintf(outFile, "%s\n", opsH);
fprintf(outFile, "%s\n", instrCatH);
fprintf(outFile, "%s\n", instrOpc);
fprintf(outFile, "%s\n", COMPDEF_END_H);
UTIL_fclose(outFile);
free(opsH);
free(instrCatH);
free(instrOpc);
free(filename);
}
/*************************************************************************/
/* instructions.c */
/*************************************************************************/
#define COMMENTS_BEG_C \
"/****************************************************************************/\n/* */ \n/* File instructions.c. This file defines the operand types table and */ \n/* the instruction information table. */ \n/* */ \n/****************************************************************************/ \n\n"
#define INCLUDE_C "#include \"instructions.h\"\n"
/*OPERAND TYPE TABLE */
#define OPTYPE_TAB_COMMENTS \
"/****************************************************************************/\n/* OPERAND TYPES TABLE */ \n/****************************************************************************/ \n\n"
#define OPTYPE_TAB_COMMENTS_LEN 250
#define MAX_OP_COMMENTS \
"/* Max number of operand that could be taken by instructions including the */\n/* padding bytes and one to terminate the list. (machine dependent) */ \n"
#define MAX_OP_COMMENTS_LEN 200
#define OPTYPE_TAB_TYPE \
"/* this array is indexed by instruction category. For each category, \n INSTR_operandTypeTab contains a string of values indicating the type \n of the operand at that position, terminated by INSTR_X. This \n information is useful when parsing instruction streams. */ \ntypedef INSTR_OperandType \n INSTR_OperandTypeTab[INSTR_NUM_INSTR_CATS][INSTR_MAX_OPERAND]; \n\n"
#define OPTYPE_TAB_TYPE_LEN 500
#define OPTYPE_TAB_BEG "INSTR_OperandTypeTab INSTR_operandTypeTable ={\n"
#define OPTYPE_TAB_BEG_LEN 80
#define OPTYPE_TAB_END "};\n\n"
#define OPTYPE_TAB_END_LEN 10
static char* optypeTabEntry = NULL;
void cgenInstrFormat(char* opType, int last)
{
char* mytabEntry = optypeTabEntry;
size_t length = (mytabEntry ? strlen(mytabEntry) : 0u) + PREFIX_LEN +
strlen(opType) + 5u;
optypeTabEntry = UTIL_mallocStr(length);
if (mytabEntry) {
strcpy(optypeTabEntry, mytabEntry);
strcat(optypeTabEntry, PREFIX);
} else strcpy(optypeTabEntry, PREFIX);
strcat(optypeTabEntry, opType);
if (!last) strcat(optypeTabEntry, ", ");
if (mytabEntry) free(mytabEntry);
}
static char* optypeTab = NULL;
//assume optypeEntry is not empty
void cgenOneInstrCatC(char* name, int last)
{
char* myoptypeTab = optypeTab;
size_t length = (myoptypeTab ? strlen(myoptypeTab) : 0u) + INDENT1_LEN*2 +
strlen(optypeTabEntry) + strlen(name) + 10u + CATPREFIX_LEN;
optypeTab = UTIL_mallocStr(length);
if (myoptypeTab) {
strcpy(optypeTab, myoptypeTab);
strcat(optypeTab, INDENT1);
} else strcpy(optypeTab, INDENT1);
strcat(optypeTab, "//");
strcat(optypeTab, CATPREFIX);
strcat(optypeTab, name);
strcat(optypeTab, "\n");
strcat(optypeTab, INDENT1);
strcat(optypeTab, "{");
strcat(optypeTab, optypeTabEntry);
if (last) strcat(optypeTab, "}\n");
else strcat(optypeTab, "},\n");
free(optypeTabEntry);
optypeTabEntry = NULL;
if (myoptypeTab) free(myoptypeTab);
}
#define OPTYPE_FUNC \
"INSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index) \n{ \n return INSTR_operandTypeTable[index]; \n}\n"
#define OPTYPE_FUNC_LEN 250
static char* opTypeC = NULL;
void cgenInstrCatC(char* max_op){
size_t length = OPTYPE_TAB_COMMENTS_LEN + MAX_OP_COMMENTS_LEN +
OPTYPE_TAB_TYPE_LEN + OPTYPE_TAB_BEG_LEN + OPTYPE_TAB_END_LEN +
strlen(optypeTab) + OPTYPE_FUNC_LEN + strlen(max_op) + 100u;
opTypeC = UTIL_mallocStr(length);
strcpy(opTypeC, OPTYPE_TAB_COMMENTS);
strcat(opTypeC, MAX_OP_COMMENTS);
strcat(opTypeC, "#define INSTR_MAX_OPERAND ");
strcat(opTypeC, max_op);
strcat(opTypeC, "\n\n");
strcat(opTypeC, OPTYPE_TAB_TYPE);
strcat(opTypeC, OPTYPE_TAB_BEG);
strcat(opTypeC, optypeTab);
strcat(opTypeC, OPTYPE_TAB_END);
strcat(opTypeC, OPTYPE_FUNC);
}
//dynamic string array type
typedef struct StringArray
{
char **array;
unsigned int length;
} StringArray;
static StringArray instrTab;
void cinitInstrC(int numInstrs)
{
instrTab.length = numInstrs;
instrTab.array = (char**)UTIL_malloc(sizeof(char*)*numInstrs);
}
void cgenOneInstrC(int opcode, char* name, char* cat, char* len, int last)
{
size_t length = strlen(name) + strlen(cat) + strlen(len) + PREFIX_LEN
+ CATPREFIX_LEN + 20u + INDENT1_LEN ;
char* myText = UTIL_mallocStr(length);
strcpy(myText, INDENT1);
strcat(myText, "{\"");
strcat(myText, name);
strcat(myText, "\", ");
strcat(myText, CATPREFIX);
strcat(myText, cat);
strcat(myText, ", ");
strcat(myText, PREFIX);
strcat(myText, len);
if (last) strcat(myText, "}\n");
else strcat(myText, "},\n");
instrTab.array[opcode] = myText;
}
#define INSTR_TAB_C_COMMENTS \
"/****************************************************************************/\n/* INSTRUCTION INFORMATION TABLE */ \n/****************************************************************************/ \n"
#define INSTR_TAB_C_COMMENTS_LEN 250
#define INSTR_TAB_TYPE \
"typedef struct //entry of the instruction info table \n{ \n char* name; \n INSTR_InstrCategory type; \n int size; \n} INSTR_InstrInfoTab_; \n\ntypedef INSTR_InstrInfoTab_ INSTR_InstrInfoTab[INSTR_NUM_INSTRS]; \n\n"
#define INSTR_TAB_TYPE_LEN 600
#define INSTR_TAB_BEG "INSTR_InstrInfoTab INSTR_instrInfoTable ={\n"
#define INSTR_TAB_BEG_LEN 80
#define INSTR_TAB_END "};\n\n"
#define INSTR_TAB_END_LEN 10
#define INSTR_TAB_FUNC_C \
"/* Accessing functions */ \nINSTR_InstrCategory INSTR_instrType(int index) \n{ \n return (INSTR_instrInfoTable[index]).type; \n} \n\nchar* INSTR_instrName(int index) \n{ \n return (INSTR_instrInfoTable[index]).name; \n} \n\nint INSTR_instrSize(int index) \n{ \n return (INSTR_instrInfoTable[index]).size; \n}\n\n"
#define INSTR_TAB_FUNC_C_LEN 1000
static char* instrC = NULL;
void cgenInstrC()
{
size_t i, length;
char *myText = NULL, *myText2;
for (i = 0; i < instrTab.length; i++) {
if (instrTab.array[i]) {
length = (myText ? strlen(myText) : 0u) + strlen(instrTab.array[i]);
myText2 = UTIL_mallocStr(length + 100u);
if (myText) {
strcpy(myText2, myText);
strcat(myText2, instrTab.array[i]);
} else strcpy(myText2, instrTab.array[i]);
free(instrTab.array[i]);
free(myText);
myText = myText2;
}
}
free(instrTab.array);
length = INSTR_TAB_C_COMMENTS_LEN + INSTR_TAB_TYPE_LEN +
INSTR_TAB_BEG_LEN + INSTR_TAB_END_LEN + INSTR_TAB_FUNC_C_LEN +
strlen(myText);
instrC = UTIL_mallocStr(length);
strcpy(instrC, INSTR_TAB_C_COMMENTS);
strcat(instrC, INSTR_TAB_TYPE);
strcat(instrC, INSTR_TAB_BEG);
strcat(instrC, myText);
strcat(instrC, INSTR_TAB_END);
strcat(instrC, INSTR_TAB_FUNC_C);
free(myText);
}
/* dump instructions.c" */
void cspitCInstructionsC(char * root)
{
FILE* outFile;
char * filename = malloc(strlen(root) + 32);
strcpy(filename, root);
strcat(filename, "tables/instructions.c");
outFile = UTIL_fopenW(filename);
fprintf(outFile, "%s\n%s\n", COMMENTS_BEG_C, INCLUDE_C);
fprintf(outFile, "%s\n", opTypeC);
fprintf(outFile, "%s\n", instrC);
UTIL_fclose(outFile);
free(opTypeC);
free(instrC);
free(filename);
}
/* simdispatch.c */
#define SIMPREFIX "SINSTR_"
#define SIMPREFIX_LEN 7
#define SIMDIS_COMMENTS \
"/***************************************************************************/ \n/* */ \n/* File simdispatch.c. The instruction dispatch table used by the */ \n/* simulator is defined here as an array of function pointers, each of */ \n/* which refers to a function realizing a corresponding instruction. */ \n/* These functions are defined in the file ./siminstr.c. */ \n/***************************************************************************/ \n\n"
#define SIMDIS_COMMENTS_LEN 600
#define SIMDIS_INCLUDE \
"#include \"../tables/instructions.h\" //to be modified \n#include \"siminstr.h\" \n#include \"simdispatch.h\"\n\n"
#define SIMDIS_INCLUDE_LEN 250
#define SIMDIS_TAB_BEG \
"SDP_InstrFunctionPtr SDP_dispatchTable[INSTR_NUM_INSTRS] = {\n"
#define SIMDIS_TAB_BEG_LEN 80
#define SIMDIS_TAB_END "};\n"
#define SIMDIS_TAB_END_LEN 10
static StringArray dispatchTab;
void cinitSimDispatch(int size)
{
dispatchTab.length = size;
dispatchTab.array = (char**)UTIL_malloc(sizeof(char*)*size);
}
void cgenOneSimDispatch(int ind, char* instr, int last)
{
size_t length = strlen(instr) + SIMPREFIX_LEN + INDENT1_LEN + 10u;
char* myText = UTIL_mallocStr(length);
strcpy(myText, INDENT1);
strcat(myText, SIMPREFIX);
strcat(myText, instr);
if (last) strcat(myText, "\n");
else strcat(myText, ",\n");
dispatchTab.array[ind] = myText;
}
static char* dispatch = NULL;
void cgenSimDispatch()
{
size_t i, length;
char *myText = NULL, *myText2;
for(i = 0; i < dispatchTab.length; i++) {
if (dispatchTab.array[i]){
length = (myText ? strlen(myText) : 0)+strlen(dispatchTab.array[i]);
myText2 = UTIL_mallocStr(length);
if (myText){
strcpy(myText2, myText);
strcat(myText2, dispatchTab.array[i]);
} else strcpy(myText2, dispatchTab.array[i]);
free(dispatchTab.array[i]);
free(myText);
myText = myText2;
}
}
free(dispatchTab.array);
length = SIMDIS_COMMENTS_LEN + SIMDIS_INCLUDE_LEN + SIMDIS_TAB_BEG_LEN
+ SIMDIS_TAB_BEG_LEN + SIMDIS_TAB_END_LEN + strlen(myText);
dispatch = UTIL_mallocStr(length);
strcpy(dispatch, SIMDIS_COMMENTS);
strcat(dispatch, SIMDIS_INCLUDE);
strcat(dispatch, SIMDIS_TAB_BEG);
strcat(dispatch, myText);
strcat(dispatch, SIMDIS_TAB_END);
free(myText);
}
void cspitSimDispatch(char * root)
{
FILE* outFile;
char * filename = malloc(strlen(root) + 32);
strcpy(filename, root);
strcat(filename, "simulator/simdispatch.c");
outFile = UTIL_fopenW(filename);
fprintf(outFile, "%s\n", dispatch);
free(dispatch);
UTIL_fclose(outFile);
free(filename);
}

70
src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.h
View File

@@ -1,70 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/******************************************************************************/
/* File instrgen-c.h. This files contains function declarations for generating*/
/* files instructions.h and instructions.c */
/******************************************************************************/
/* instructions.h */
/* generating operand types */
void cgenOpTypes(char *name, char* typeName, char* types, char* comments,
int last);
void cgenOpCodeType(char* optype);
void cgenOpsH();
void cgenInstrCatH(char* callI1Len);
void cgenOneInstrCatH(char* name, int last);
void cgenInstrLength(char* name, char* length);
void cgenInstrH(char* numInstr);
void cgenOneInstrH(char* comments, char* opcode, char* name);
/* dump instructions.h" */
void cspitCInstructionsH(char * root);
/* instructions.c */
void cgenInstrFormat(char* opType, int last);
void cgenOneInstrCatC(char* name, int last);
void cgenInstrCatC(char* max_op);
void cinitInstrC(int numInstr);
void cgenOneInstrC(int opcode, char* name, char* cat, char* len, int last);
void cgenInstrC();
/* dump instructions.c" */
void cspitCInstructionsC(char * root);
/* simdispatch.c */
void cinitSimDispatch(int size);
void cgenOneSimDispatch(int ind, char* instr, int last);
void cgenSimDispatch();
void cspitSimDispatch(char * root);

845
src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.c
View File

@@ -1,845 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2012
// Krasimir Angelov
//////////////////////////////////////////////////////////////////////////////
/*************************************************************************/
/* functions for generating Haskell Instructions.hs */
/*************************************************************************/
#include "../util/util.h"
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
static char* addLine(char* str, char* addOn)
{
size_t length = (str ? strlen(str) : 0) + strlen(addOn) + 2;
char* newStr = UTIL_mallocStr(length);
if (str) {
strcpy(newStr, str);
strcat(newStr, addOn);
} else strcpy(newStr, addOn);
strcat(newStr, "\n");
return newStr;
}
static char* addStr(char* str, char* addOn)
{
size_t length = (str ? strlen(str) : 0) + strlen(addOn);
char* newStr = UTIL_mallocStr(length);
if (str) {
strcpy(newStr, str);
strcat(newStr, addOn);
} else strcpy(newStr, addOn);
return newStr;
}
/**********************************************************************/
/* auxiliary functions for making ocaml language constructs */
/**********************************************************************/
#define TYPE_SUFFIX "type"
#define SIZE_SUFFIX "Size"
#define PUT_PREFIX "put"
#define GET_PREFIX "get"
#define DISPLAY_PREFIX "display"
#define INDENT " "
#define INDENT2 " "
#define PUT "putWord"
#define GET "getWord"
#define DISPLAY "pp"
#define INSCAT_PREFIX1 "inscat"
#define INSCAT_PREFIX2 "Inscat"
#define INS_PREFIX "Ins_"
static char* HS_mkVarDef(char* varName, char* varType, char* defs)
{
size_t length = strlen(varName) + strlen(defs) + strlen(varType) + 10;
char* vardef = UTIL_mallocStr(length);
strcpy(vardef, varName);
strcat(vardef, " = ");
strcat(vardef, defs);
strcat(vardef, " :: ");
strcat(vardef, varType);
strcat(vardef, "\n");
return vardef;
}
static char* HS_mkTypeDec(char* typeName, char* defs)
{
size_t length = strlen(typeName) + strlen(defs) + 10;
char* typedec = UTIL_mallocStr(length);
strcpy(typedec, "type ");
strcat(typedec, typeName);
strcat(typedec, " = ");
strcat(typedec, defs);
strcat(typedec, "\n");
return typedec;
}
static char* HS_mkFunc(char* funcName, char* arg, char* body)
{
size_t length = strlen(funcName) + strlen(arg) + strlen(body) + 20;
char* func = UTIL_mallocStr(length);
strcpy(func, funcName);
strcat(func, " ");
strcat(func, arg);
strcat(func, " = ");
strcat(func, body);
strcat(func, "\n");
return func;
}
static char* HS_mkCrossType(char *lop, char *rop)
{
size_t length = strlen(lop) + strlen(rop) + 5;
char* crossType = UTIL_mallocStr(length);
strcpy(crossType, lop);
strcat(crossType, ", ");
strcat(crossType, rop);
return crossType;
}
static char* HS_mkValueCtr(char* ctrName, char* types)
{
size_t length = strlen(ctrName) + strlen(types) + 10;
char* ctr = UTIL_mallocStr(length);
strcpy(ctr, ctrName);
strcat(ctr, " ");
strcat(ctr, types);
return ctr;
}
static char* HS_mkDisjValueCtrs(char* prev, char* next)
{
size_t length = strlen(prev) + strlen(next) + 10;
char* ctr = UTIL_mallocStr(length);
strcpy(ctr, prev);
strcat(ctr, "\n");
strcat(ctr, INDENT);
strcat(ctr, "| ");
strcat(ctr, next);
return ctr;
}
static char* HS_mkCase(char* prev, char* next)
{
size_t length = strlen(prev) + strlen(next) + 10;
char* ctr = UTIL_mallocStr(length);
strcpy(ctr, prev);
strcat(ctr, "\n");
strcat(ctr, INDENT);
strcat(ctr, " ");
strcat(ctr, next);
return ctr;
}
static char* HS_mkFuncSeq(char* prev, char* new)
{
size_t length = strlen(prev) + strlen(new) + 20;
char* funcSeq = UTIL_mallocStr(length);
strcpy(funcSeq, prev);
strcat(funcSeq, " >> ");
strcat(funcSeq, new);
return funcSeq;
}
static char* HS_mkArgList(char* prev, char* new)
{
size_t length = strlen(prev) + strlen(new) + 2;
char* args = UTIL_mallocStr(length);
strcpy(args, prev);
strcat(args, ", ");
strcat(args, new);
return args;
}
static char* HS_mkStrConcat(char* prev, char* new)
{
size_t length = strlen(prev) + strlen(new) + 25;
char* str = UTIL_mallocStr(length);
strcpy(str, "(");
strcat(str, prev);
strcat(str, ") ++ \", \" ++ (");
strcat(str, new);
strcat(str, ")");
return str;
}
static char* HS_mkArrow(char* left, char* right)
{
size_t length = strlen(left) + strlen(right) + 20;
char* arrow = UTIL_mallocStr(length);
strcpy(arrow, left);
strcat(arrow, " -> ");
strcat(arrow, right);
return arrow;
}
static char* HS_mkStructure(char* func, char* arg)
{
size_t length = strlen(func) + strlen(arg) + 5;
char* app = UTIL_mallocStr(length);
strcpy(app, func);
strcat(app, " ");
strcat(app, arg);
return app;
}
static char* HS_mkDO(char* varName, char* def)
{
size_t length = strlen(varName) + strlen(def) + 20;
char* str = UTIL_mallocStr(length);
strcpy(str, INDENT);
strcat(str, varName);
strcat(str, " <- ");
strcat(str, def);
strcat(str, "\n");
return str;
}
/**************************************************************************/
/* type definitions */
/**************************************************************************/
static char* typeDefs;
void ocgenInclude(char* include)
{
typeDefs = include;
}
/**************************************************************************/
/* operand types */
/**************************************************************************/
static char* opTypes;
static char* opSizes;
static char* writeFuncs;
static char* readFuncs;
static char* ocgenWriteOpFunc(char* typeName, char* compType, int numBytes)
{
char* funcName = UTIL_appendStr(PUT_PREFIX, typeName);
char* numBitsText = UTIL_itoa(numBytes*8);
char* funcBody = UTIL_mallocStr(strlen(PUT)+strlen(numBitsText)+20);
char* func;
if (strcmp(typeName, "F") == 0) {
strcpy(funcBody, "putFloat");
strcat(funcBody, numBitsText);
if (numBytes > 1)
strcat(funcBody, "be");
} else if (strcmp(typeName, "C") == 0 || strcmp(typeName, "K") == 0) {
strcpy(funcBody, "put");
} else {
strcpy(funcBody, PUT);
strcat(funcBody, numBitsText);
if (numBytes > 1)
strcat(funcBody, "be");
strcat(funcBody, " . fromIntegral");
}
free(numBitsText);
func = HS_mkFunc(funcName, "", funcBody);
free(funcName);
free(funcBody);
return func;
}
static char* ocgenReadOpFunc(char* typeName, char* compType, int numBytes)
{
char* funcName = UTIL_appendStr(GET_PREFIX, typeName);
char* numBitsText = UTIL_itoa(numBytes*8);
char* funcBody = UTIL_mallocStr(strlen(GET)+strlen(numBitsText)+30);
char* func;
if (strcmp(typeName, "F") == 0) {
strcpy(funcBody, "getFloat");
strcat(funcBody, numBitsText);
if (numBytes > 1)
strcat(funcBody, "be");
} else if (strcmp(typeName, "C") == 0 || strcmp(typeName, "K") == 0) {
strcpy(funcBody, "get");
} else {
strcpy(funcBody, "fmap fromIntegral $ ");
strcat(funcBody, GET);
strcat(funcBody, numBitsText);
if (numBytes > 1)
strcat(funcBody, "be");
}
free(numBitsText);
func = HS_mkFunc(funcName, "", funcBody);
free(funcName);
free(funcBody);
return func;
}
void ocgenOpType(char* typeName, int numBytes, char* compType)
{
char* myCompType =
(strcmp(compType, "int") == 0) ? "Int" :
(strcmp(compType, "float") == 0) ? "Float" :
(strcmp(compType, "aconstant") == 0) ? "AConstant" :
(strcmp(compType, "akind") == 0) ? "AKind" :
(strcmp(compType, "intref") == 0) ? "IntRef" :
NULL;
/* generate type declarations*/
char* myTypeName = UTIL_appendStr(typeName, TYPE_SUFFIX);
char* myOpType = HS_mkTypeDec(myTypeName, myCompType);
char* myopTypes = addStr(opTypes, myOpType);
/* generate write functions */
char* func = ocgenWriteOpFunc(typeName, compType, numBytes);
char* myWriteFuncs = addStr(writeFuncs, func);
/* generate read functions */
char* readFunc = ocgenReadOpFunc(typeName, compType, numBytes);
char* myReadFuncs = addStr(readFuncs, readFunc);
/* generate sizes */
if (numBytes < 4) {
char* myName = UTIL_lowerCase(typeName);
char* mySizeName = UTIL_appendStr(myName, SIZE_SUFFIX);
char* size = UTIL_itoa((int)(pow(2,(numBytes * 8))-1));
char* myOpSize = HS_mkVarDef(mySizeName, "Int", size);
char* myopSizes = addStr(opSizes, myOpSize);
free(myName); free(mySizeName); free(size); free(myOpSize);
free(opSizes);
opSizes = myopSizes;
}
free(myTypeName);
free(opTypes); free(myOpType);
opTypes = myopTypes;
free(writeFuncs); free(func);
writeFuncs = myWriteFuncs;
free(readFuncs); free(readFunc);
readFuncs = myReadFuncs;
}
void ocgenOpCodeType(int numBytes)
{
char* mySizeName = UTIL_appendStr("opcode", SIZE_SUFFIX);
char* size = UTIL_itoa((int)(pow(2,(numBytes * 8))-1));
char* myOpCodeSize = HS_mkVarDef(mySizeName, "Int", size);
char* myopSizes = addLine(opSizes, myOpCodeSize);
char* func = ocgenWriteOpFunc("opcode", "Int", numBytes);
char* myWriteFuncs = addLine(writeFuncs, func);
char* readFunc = ocgenReadOpFunc("opcode", "Int", numBytes);
char* myReadFuncs = addLine(readFuncs, readFunc);
free(size); free(mySizeName);
free(opSizes); free(myOpCodeSize);
free(writeFuncs); free(func);
free(readFuncs); free(readFunc);
opSizes = myopSizes;
writeFuncs = myWriteFuncs;
readFuncs = myReadFuncs;
}
static char* opHS;
void ocgenOps()
{
char* wordSizeName = "wordSize";
char* wordSize = UTIL_itoa(sizeof(void*));
char* wordSizeHS = HS_mkVarDef(wordSizeName, "Int", wordSize);
char* text;
free(wordSize);
opHS = addLine(NULL, wordSizeHS); free(wordSizeHS);
text = addLine(opHS, opSizes); free(opSizes); free(opHS);
opHS = addLine(text, opTypes); free(opTypes); free(text);
text = addLine(opHS, writeFuncs); free(writeFuncs); free(opHS);
opHS = addLine(text, readFuncs); free(readFuncs); free(text);
}
/****************************************************************************/
/* instruction categories */
/****************************************************************************/
static char* instrCatWriteFunc = NULL;
static char* instrCatReadFunc = NULL;
static char* instrCatDisplayFunc = NULL;
static char* instrCatType = NULL;
static int argInd = 1;
static char* argList = NULL;
void ocgenInstrFormat(char* opName)
{
char *myOpName, *myFuncName, *myArgInd, *myFuncCall, *myArg,
*myArgList, *myinstrCatType, *myinstrCatWriteFunc, *myReadBody,
*myinstrCatReadFunc, * myinstrCatDisplayFunc;
if (strcmp(opName, "P") == 0 || strcmp(opName, "WP") == 0 ||
strcmp(opName, "X") == 0) return;
//type declaration
myOpName = UTIL_appendStr(opName, TYPE_SUFFIX);
if (instrCatType) {
myinstrCatType = HS_mkCrossType(instrCatType, myOpName);
free(instrCatType); free(myOpName);
instrCatType = myinstrCatType;
} else instrCatType = myOpName;
//argument
myArgInd = UTIL_itoa(argInd);
argInd++;
myArg = UTIL_appendStr("arg", myArgInd); free(myArgInd);
//argument list
if (argList) {
myArgList = HS_mkArgList(argList, myArg); free(argList);
argList = myArgList;
} else argList = myArg;
//write function
myFuncName = UTIL_appendStr(PUT_PREFIX, opName);
myFuncCall = UTIL_mallocStr(strlen(myFuncName) + strlen(myArg) + 5);
strcpy(myFuncCall, myFuncName); free(myFuncName);
strcat(myFuncCall, " ");
strcat(myFuncCall, myArg);
if (instrCatWriteFunc) {
myinstrCatWriteFunc = HS_mkFuncSeq(instrCatWriteFunc, myFuncCall);
free(instrCatWriteFunc);
instrCatWriteFunc = myinstrCatWriteFunc;
free(myFuncCall);
} else instrCatWriteFunc = myFuncCall;
//read function
myFuncName = UTIL_appendStr(GET_PREFIX, opName);
myReadBody = HS_mkDO(myArg, myFuncName); free(myFuncName);
if (instrCatReadFunc) {
myinstrCatReadFunc = UTIL_appendStr(instrCatReadFunc, myReadBody);
free(instrCatReadFunc);
instrCatReadFunc = myinstrCatReadFunc;
free(myReadBody);
} else instrCatReadFunc = myReadBody;
//display function
myFuncName = UTIL_appendStr(DISPLAY, opName);
myFuncCall = UTIL_mallocStr(strlen(myFuncName) + strlen(myArg) + 5);
strcpy(myFuncCall, myFuncName); free(myFuncName);
strcat(myFuncCall, " ");
strcat(myFuncCall, myArg);
if (instrCatDisplayFunc) {
myinstrCatDisplayFunc = HS_mkStrConcat(instrCatDisplayFunc, myFuncCall);
free(instrCatDisplayFunc);
instrCatDisplayFunc = myinstrCatDisplayFunc;
free(myFuncCall);
} else instrCatDisplayFunc = myFuncCall;
}
static char* instrCatTypes;
static char* instrCatWriteFuncs;
static char* instrCatReadFuncs;
static char* instrCatDisplayFuncs;
void ocgenOneInstrCat(char* catName)
{
char *myCatName, *myInstrCatType, *myInstrCatTypes, *myArgs,
*myWriteFuncName, *myWriteFunc, *myInstrCatWriteFuncs,
*myReadFuncName, *myReadFunc, *myReadFuncBody, *myInstrCatReadFuncs,
*myDisplayFuncName, *myDisplayFunc, *myInstrCatDisplayFuncs, *myArgs2, *temp;
if (instrCatType) {
char* instrCatType2 = UTIL_mallocStr(strlen(instrCatType) + 3);
strcpy(instrCatType2, "(");
strcat(instrCatType2, instrCatType);
strcat(instrCatType2, ")");
myCatName = UTIL_appendStr(INSCAT_PREFIX2, catName);
myInstrCatType = HS_mkTypeDec(myCatName, instrCatType2);
myInstrCatTypes = addStr(instrCatTypes, myInstrCatType);
myArgs = UTIL_mallocStr(strlen(argList) + 5);
strcpy(myArgs, "(");
strcat(myArgs, argList);
strcat(myArgs, ")");
/* write function */
myWriteFuncName = UTIL_appendStr(PUT_PREFIX, catName);
myWriteFunc = HS_mkFunc(myWriteFuncName, myArgs, instrCatWriteFunc);
myInstrCatWriteFuncs = addStr(instrCatWriteFuncs, myWriteFunc);
/* read function */
myReadFuncName = UTIL_appendStr(GET_PREFIX, catName);
temp = UTIL_appendStr(INDENT, "return ");
myArgs2 = UTIL_appendStr(temp, myArgs); free(temp);
temp = UTIL_appendStr(instrCatReadFunc, myArgs2); free(myArgs2);
myReadFuncBody= UTIL_appendStr("do\n", temp); free(temp);
myReadFunc = HS_mkFunc(myReadFuncName, "", myReadFuncBody);
myInstrCatReadFuncs = addStr(instrCatReadFuncs, myReadFunc);
/* display function */
myDisplayFuncName = UTIL_appendStr(DISPLAY_PREFIX, catName);
myDisplayFunc = HS_mkFunc(myDisplayFuncName, myArgs, instrCatDisplayFunc);
myInstrCatDisplayFuncs = addStr(instrCatDisplayFuncs, myDisplayFunc);
free(myCatName); free(myInstrCatType);
free(instrCatType); free(instrCatTypes);
free(myWriteFuncName); free(myWriteFunc);
free(instrCatWriteFunc); free(instrCatWriteFuncs);
free(myReadFuncName); free(myReadFunc);
free(instrCatReadFunc); free(instrCatReadFuncs);
free(myDisplayFuncName); free(myDisplayFunc);
free(instrCatDisplayFunc); free(instrCatDisplayFuncs);
free(argList);
argList = NULL; argInd = 1;
instrCatType = NULL;
instrCatWriteFunc = NULL; instrCatReadFunc = NULL;
instrCatDisplayFunc = NULL;
instrCatTypes = myInstrCatTypes;
instrCatWriteFuncs = myInstrCatWriteFuncs;
instrCatReadFuncs = myInstrCatReadFuncs;
instrCatDisplayFuncs = myInstrCatDisplayFuncs;
}
}
static char* instrCatLength;
void ocgenInstrLength(char* varName, char* numBytes)
{
char* myVarName = UTIL_appendStr(INSCAT_PREFIX1, varName);
char* varDef = HS_mkVarDef(myVarName, "Int", numBytes);
char* myInstrCatLength = addStr(instrCatLength, varDef);
free(myVarName); free(varDef); free(instrCatLength);
instrCatLength = myInstrCatLength;
}
static char* instrCat;
void ocgenInstrCat()
{
char* text = instrCatTypes;
char* text2 = addLine(text, "\n");
text = addLine(text2, instrCatWriteFuncs);
free(instrCatWriteFuncs); free(text2);
text2 = addLine(text, instrCatReadFuncs);
free(instrCatReadFuncs); free(text);
text = addLine(text2, instrCatDisplayFuncs);
free(instrCatDisplayFuncs); free(text2);
instrCat = addLine(text, instrCatLength);
free(text); free(instrCatLength);
}
/****************************************************************************/
/* instructions */
/****************************************************************************/
#define GETSIZE_PREFIX "getSize_"
#define PUTOPCODE "putopcode "
static char* instructionTypes;
static char* insWriteFuncBody;
static char* insReadFuncBody;
static char* insDisplayFuncBody;
static char* insSizesDec;
static char* insSizesDef;
static void ocgenReadFuncBody(char* opcode, char* myInsName, char* myInsLength, char* insCat,
int last)
{
char *ins, *readArgs, *returnValue, *myReadFuncBody, *tmp;
if (strcmp(insCat, "X") == 0) {
readArgs = strdup("");
ins = myInsName;
} else {
readArgs = UTIL_mallocStr(strlen(GET_PREFIX) +
strlen(insCat) +
20);
strcpy(readArgs, GET_PREFIX);
strcat(readArgs, insCat);
strcat(readArgs, " >>= \\x -> ");
ins = UTIL_mallocStr(strlen(readArgs) + strlen(myInsName) + 10);
strcpy(ins, myInsName);
strcat(ins, " x");
}
returnValue = UTIL_mallocStr(strlen(readArgs) +
strlen(ins) +
strlen(myInsLength) +
20);
strcpy(returnValue, readArgs);
strcat(returnValue, "return (");
strcat(returnValue, ins);
strcat(returnValue, ", ");
strcat(returnValue, myInsLength);
strcat(returnValue, ")");
free(readArgs);
char *tmp2 = " ";
tmp = addStr(tmp2, opcode);
tmp2 = addStr(tmp, " -> "); free(tmp);
tmp = addStr(tmp2, returnValue); free(tmp2);
tmp2 = addStr(tmp, "\n"); free(tmp);
tmp = tmp2;
free(returnValue);
if (insReadFuncBody) {
myReadFuncBody = UTIL_appendStr(insReadFuncBody, tmp);
free(insReadFuncBody); free(tmp);
insReadFuncBody = myReadFuncBody;
} else insReadFuncBody = tmp;
}
static char* OC_mkWS(int size)
{
int i;
char* text;
if (size > 0) {
text = UTIL_mallocStr(size);
for (i = 0; i < size; i++) text[i]= ' ';
text[size] = '\0';
} else text = strdup(" ");
return text;
}
static void ocgenDisplayFuncBody(char* pattern, char* insName, char* insLength,
char* insCat)
{
char *displayargs, *funcBody, *myInsName, *ins, *returnValue, *insText,
*myDisplayFuncBody;
myInsName = UTIL_appendStr(insName, OC_mkWS(25u - strlen(insName)));
insText = UTIL_mallocStr(strlen(myInsName) + 5);
strcpy(insText, "\"");
strcat(insText, myInsName); free(myInsName);
strcat(insText, "\"");
if (strcmp(insCat, "X") == 0) ins = insText;
else {
displayargs = UTIL_appendStr(DISPLAY_PREFIX, insCat);
ins = UTIL_mallocStr(strlen(displayargs) + strlen(insText) + 10);
strcpy(ins, insText);
strcat(ins, " ++ ");
strcat(ins, displayargs);
strcat(ins, " arg");
free(displayargs); free(insText);
}
returnValue = UTIL_mallocStr(strlen(ins) + strlen(insLength) + 5);
strcpy(returnValue, "(");
strcat(returnValue, ins);
strcat(returnValue, ", ");
strcat(returnValue, insLength);
strcat(returnValue, ")");
funcBody = HS_mkArrow(pattern, returnValue);
free(returnValue);
if (insDisplayFuncBody) {
myDisplayFuncBody = HS_mkCase(insDisplayFuncBody, funcBody);
free(insDisplayFuncBody); free(funcBody);
insDisplayFuncBody = myDisplayFuncBody;
} else {
insDisplayFuncBody = UTIL_appendStr(INDENT2, funcBody);
free(funcBody);
}
}
void ocgenOneInstr(char* opcode, char* insName, char* insCat, char* insLength,
int last)
{
char *myCatName, *myInsName, *myValueCtr, *myInstrTypes;
char *myInsSizeName, *myInsLength, *mySizeDef, *mySizeDec, *mySizeDefs,
*mySizeDecs;
char *myPattern, *myWriteOpCodeFunc, *myfuncBody, *myFunc, *myInsWriteFuncBody;
/* value constructors for type instruction */
myInsName = UTIL_appendStr(INS_PREFIX, insName);
if (strcmp(insCat, "X") == 0) {
myValueCtr = myInsName;
} else {
myCatName = UTIL_appendStr(INSCAT_PREFIX2, insCat);
myValueCtr = HS_mkValueCtr(myInsName, myCatName); free(myCatName);
}
if (instructionTypes) {
myInstrTypes = HS_mkDisjValueCtrs(instructionTypes, myValueCtr);
free(instructionTypes);
instructionTypes = myInstrTypes;
} else instructionTypes = myValueCtr;
/* write function body */
myWriteOpCodeFunc = UTIL_appendStr(PUTOPCODE, opcode);
if (strcmp(insCat, "X") == 0) {
myPattern = strdup(myInsName);
myfuncBody = myWriteOpCodeFunc;
} else {
char* myWriteArgsName = UTIL_appendStr(PUT_PREFIX, insCat);
char* myWriteArgs = UTIL_mallocStr(strlen(myWriteArgsName) + 5);
myPattern = HS_mkStructure(myInsName, "arg");
strcpy(myWriteArgs, myWriteArgsName); free(myWriteArgsName);
strcat(myWriteArgs, " arg");
myfuncBody = HS_mkFuncSeq(myWriteOpCodeFunc, myWriteArgs);
free(myWriteArgs);
}
myFunc = HS_mkArrow(myPattern, myfuncBody);
free(myfuncBody);
if (insWriteFuncBody) {
myInsWriteFuncBody = HS_mkCase(insWriteFuncBody, myFunc);
free(insWriteFuncBody); free(myFunc);
insWriteFuncBody = myInsWriteFuncBody;
} else {
insWriteFuncBody = UTIL_appendStr(INDENT2, myFunc);
free(myFunc);
}
/* instruction sizes */
myInsSizeName = UTIL_appendStr(GETSIZE_PREFIX, insName);
myInsLength = UTIL_appendStr(INSCAT_PREFIX1, insLength);
mySizeDef = HS_mkVarDef(myInsSizeName, "Int", myInsLength);
free(myInsSizeName);
mySizeDefs = addStr(insSizesDef, mySizeDef);
free(insSizesDef); free(mySizeDef);
insSizesDef = mySizeDefs;
ocgenReadFuncBody(opcode, myInsName, myInsLength, insCat, last);
ocgenDisplayFuncBody(myPattern, insName, myInsLength, insCat);
free(myInsName); free(myInsLength); free(myPattern);
}
#define INSTRTYPE_HEAD "data Instruction\n = "
#define INSTWRITEFUNC_DEF_HEAD "putInstruction :: Instruction -> Put\n" \
"putInstruction inst =\n" \
" case inst of\n"
#define INSTREADFUNC_DEF_HEAD "getInstruction :: Get (Instruction,Int)\n" \
"getInstruction = do\n" \
" opcode <- getopcode\n" \
" case opcode of\n"
#define INSTDISPLAYFUNC_DEF_HEAD \
"showInstruction :: Instruction -> (String, Int)\n" \
"showInstruction inst =\n" \
" case inst of\n"
static char* instrHS;
void ocgenInstr()
{
char* text = UTIL_appendStr(INSTRTYPE_HEAD, instructionTypes);
char* text2 = UTIL_appendStr(text, "\n\n");
free(instructionTypes); free(text);
text = addLine(text2, insSizesDef); free(text2); free(insSizesDef);
text2 = addStr(text, INSTWRITEFUNC_DEF_HEAD); free(text);
instrHS = addStr(text2, insWriteFuncBody);
free(text2); free(insWriteFuncBody);
text = addStr(instrHS, "\n\n"); free(instrHS);
text2 = addStr(text, INSTREADFUNC_DEF_HEAD); free(text);
instrHS = addStr(text2, insReadFuncBody);
free(text2); free(insReadFuncBody);
text = addStr(instrHS, "\n\n"); free(instrHS);
text2 = addStr(text, INSTDISPLAYFUNC_DEF_HEAD); free(text);
instrHS = addStr(text2, insDisplayFuncBody);
free(text2); free(insDisplayFuncBody);
}
/****************************************************************************/
/* dump files */
/****************************************************************************/
/* dump files */
void ocSpitInstructionHS(char * root)
{
FILE* outFile;
char * loc_path = "../../../compiler/GF/Compile/Instructions.hs";
char * filename = malloc(strlen(root) + strlen(loc_path)+1);
strcpy(filename, root);
strcat(filename, loc_path);
outFile = UTIL_fopenW(filename);
fputs("module GF.Compile.Instructions where\n", outFile);
fputs("\n", outFile);
fputs("import Data.IORef\n", outFile);
fputs("import Data.Binary\n", outFile);
fputs("import Data.Binary.Put\n", outFile);
fputs("import Data.Binary.Get\n", outFile);
fputs("import Data.Binary.IEEE754\n", outFile);
fputs("import PGF.CId\n", outFile);
fputs("import PGF.Binary\n", outFile);
fputs("\n", outFile);
fputs("type IntRef = Int\n", outFile);
fputs("type AConstant = CId\n", outFile);
fputs("type AKind = CId\n", outFile);
fputs("\n", outFile);
fputs("ppE = undefined\n", outFile);
fputs("ppF = undefined\n", outFile);
fputs("ppL = undefined\n", outFile);
fputs("ppC = undefined\n", outFile);
fputs("ppN = undefined\n", outFile);
fputs("ppR = undefined\n", outFile);
fputs("ppK = undefined\n", outFile);
fputs("ppS = undefined\n", outFile);
fputs("ppI = undefined\n", outFile);
fputs("ppI1 = undefined\n", outFile);
fputs("ppIT = undefined\n", outFile);
fputs("ppCE = undefined\n", outFile);
fputs("ppMT = undefined\n", outFile);
fputs("ppHT = undefined\n", outFile);
fputs("ppSEG = undefined\n", outFile);
fputs("ppBVT = undefined\n", outFile);
fputs("\n", outFile);
fputs(opHS, outFile); free(opHS);
fputs(instrCat, outFile); free(instrCat);
fputs("\n\n", outFile);
fputs(instrHS, outFile); free(instrHS);
free(typeDefs);
UTIL_fclose(outFile);
free(filename);
}

47
src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.h
View File

@@ -1,47 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*************************************************************************/
/* functions for generating ocaml instr.mli and instr.ml */
/*************************************************************************/
/* include */
void ocgenInclude(char* include);
/* operand types */
void ocgenOpType(char* typeName, int numBytes, char* compType);
void ocgenOpCodeType(int numBytes);
void ocgenOps();
/* instruction category */
void ocgenInstrFormat(char* opName);
void ocgenOneInstrCat(char* catName);
void ocgenInstrLength(char* varName, char* numBytes);
void ocgenInstrCat();
/* instructions */
void ocgenOneInstr(char* opcode, char* insName, char* insCat, char* insLength,
int last);
void ocgenInstr();
/* dump files */
void ocSpitInstructionMLI(char * root);
void ocSpitInstructionML(char * root);

1977
src/runtime/c/teyjus/tables_gen/instrformats/lex.yy.c
View File

File diff suppressed because it is too large Load Diff

104
src/runtime/c/teyjus/tables_gen/instrformats/y.tab.h
View File

@@ -1,104 +0,0 @@
/* A Bison parser, made by GNU Bison 2.4.1. */
/* Skeleton interface for Bison's Yacc-like parsers in C
Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
/* As a special exception, you may create a larger work that contains
part or all of the Bison parser skeleton and distribute that work
under terms of your choice, so long as that work isn't itself a
parser generator using the skeleton or a modified version thereof
as a parser skeleton. Alternatively, if you modify or redistribute
the parser skeleton itself, you may (at your option) remove this
special exception, which will cause the skeleton and the resulting
Bison output files to be licensed under the GNU General Public
License without this special exception.
This special exception was added by the Free Software Foundation in
version 2.2 of Bison. */
/* Tokens. */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
/* Put the tokens into the symbol table, so that GDB and other debuggers
know about them. */
enum yytokentype {
OPTYPES = 258,
INSTRCAT = 259,
INSTRUCTIONS = 260,
OPCODE = 261,
MAXOPERAND = 262,
CALL_I1_LEN = 263,
SEMICOLON = 264,
ERROR = 265,
LBRACKET = 266,
RBRACKET = 267,
ID = 268,
NUM = 269,
STRING = 270,
STRING2 = 271
};
#endif
/* Tokens. */
#define OPTYPES 258
#define INSTRCAT 259
#define INSTRUCTIONS 260
#define OPCODE 261
#define MAXOPERAND 262
#define CALL_I1_LEN 263
#define SEMICOLON 264
#define ERROR 265
#define LBRACKET 266
#define RBRACKET 267
#define ID 268
#define NUM 269
#define STRING 270
#define STRING2 271
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
typedef union YYSTYPE
{
/* Line 1676 of yacc.c */
#line 38 "instrformats/instrformats.y"
char* name;
char* text;
struct
{
int ival;
char* sval;
} isval;
/* Line 1676 of yacc.c */
#line 96 "instrformats/y.tab.h"
} YYSTYPE;
# define YYSTYPE_IS_TRIVIAL 1
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
#endif
extern YYSTYPE yylval;

1024
src/runtime/c/teyjus/tables_gen/pervasives/ccode.c
View File

File diff suppressed because it is too large Load Diff

80
src/runtime/c/teyjus/tables_gen/pervasives/ccode.h
View File

@@ -1,80 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#include "types.h"
#include "op.h"
/*******************************************************************/
/* commen structures */
/*******************************************************************/
/* // <comments> */
char* C_mkOneLineComments(char* comments);
/* // empty */
char* C_mkEmptyComments();
/*
//comments \n
PERV_<name>_INDEX = <indexNum>
*/
char* C_mkIndex(char* name, char* indexNum, char* comments);
/*
PERV_<name> = <indexNum>
*/
char* C_mkIndex2(char* name, char* indexNum);
/******************************************************************/
/* kind relevant components */
/******************************************************************/
char* C_mkNumKinds(char* num);
char* C_mkKindIndexType(char* body);
char* C_mkKindH(char* indexType, char* kindNum);
char* C_mkKindTabEntry(char* name, char* arity, char* comments);
char* C_mkKindTab(char* body);
char* C_mkKindC(char* kindTab);
/******************************************************************/
/* type skeleton relevant components */
/******************************************************************/
char* C_mkNumTySkels(char* num);
char* C_mkTySkelsH(char* numTySkels);
extern int C_totalSpace;
char* C_genTySkel(Type tyskel, char* comments);
char* C_mkTySkelTabInit(char* body, int space);
char* C_mkTySkelsC(char* tySkelTab);
/******************************************************************/
/* constant relevant components */
/******************************************************************/
char* C_mkNumConsts(char* num);
char* C_mkConstIndexType(char* body);
char* C_mkConstH(char* constIndexType, char* numConsts, char* property);
char* C_mkConstTabEntry(char* name, char* tesize, OP_Prec prec,
OP_Fixity fixity, char* tyskelInd, char* neededness,
char* comments);
char* C_mkConstTab(char* body);
char* C_mkConstC(char* constTab);
char* C_mkLSTypeDec(char* body);
char* C_mkLSRange(char* start, char* end);
char* C_mkPredRange(char* start, char* end);
char* C_mkFixedBegH();
char* C_mkFixedEndH();
char* C_mkFixedBegC();
char* C_mkFixedEndC();

1434
src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.c
View File

File diff suppressed because it is too large Load Diff

152
src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.h
View File

@@ -1,152 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/***************************************************************************/
/* ocamlcode.h{c}. */
/* These files contain usful macros and auxiliary functions for generating */
/* the pervasive.mli and pervasive.ml. */
/* The parts of the ocaml files that are independent to the pervasives.in */
/* also reside here. */
/* The length macros for string macros defined here may be larger than the */
/* extra lengthes of corresponding strings. This is ok because space and */
/* time efficiency are not of concern in generating system files. */
/***************************************************************************/
#include "types.h"
#include "op.h"
#include "../util/util.h"
/***************************************************************************/
/* Functions for making program components */
/***************************************************************************/
/* let t = Table.add (Symbol.symbol "<name>") <varName> t in\n
*/
char* OC_mkTabEntry(char* name, char* varName);
/****************************************************************************/
/* functions for making pervasive kind relevant components */
/****************************************************************************/
/* k<name> */
char* OC_mkKVarName(char* name);
/* is<name> */
char* OC_mkIsKindFuncName(char* name);
/* val <kindVarName> : Absyn.akind \n*/
char* OC_mkKindVarDec(char* kindVarName);
/* val <funcName> : Absyn.akind -> bool */
char* OC_mkIsKindFuncDec(char* funcName);
/* let <funcName> tm = tm == <kindVarName> */
char* OC_mkIsKindFuncDef(char* funcName, char* kindVarName);
/* let <varName> = Absyn.PervasiveKind(Symbol.symbol "<kindName>",
(Some <arity>), ref offset, Errormsg.none)
*/
char* OC_mkKindVar(char* varName, char* kindName, char* arity, char* offset);
/* let buildPervasiveKinds =
function () ->\n <inits> <entries>\n <tabName>\n\n */
char* OC_mkBuildKTabFunc(char* entries);
/****************************************************************************/
/* functions for making pervasive type skeleton components */
/****************************************************************************/
/* generating code for type skeleton */
char* OC_genTySkel(Type tyskel);
/* tyskel<number> */
char* OC_mkTySkelVarName(char* number);
/* Type Skeleton variable definition:
let <varName> = Some(Absyn.Skeleton(<tySkel>, ref None, ref false))
*/
char* OC_mkTYSkelVar(char* varName, char* tySkel);
/* generate tyskels for overloaded constants */
char* OC_mkFixedTySkels(char* tySkels);
/****************************************************************************/
/* functions for making pervasive constants components */
/****************************************************************************/
/* <name>Constant */
char* OC_mkCVarName(char* name);
/* is<name> */
char* OC_mkIsConstFuncName(char* name);
/* val <constVarName> : Absyn.aconstant \n*/
char* OC_mkConstVarDec(char* constVarName);
/* Constant variable definition :
let <varName> = Absyn.Constant(Symbol.symbolAlias "<constName>" "<printName>",
ref <fixity>,
ref <prec>, ref false, ref false, ref false, ref false,
ref false, ref <typrev>, ref false, ref <tySkel>,
ref <tyenvsize>, ref (Some <neededness>), ref <codeInfo>,
ref <constantCat>, ref offset, Errormsg.none)
*/
char* OC_mkConstVar(char* constName, OP_Fixity fixity, OP_Prec prec,
UTIL_Bool typrev, char* tySkel, int tyenvsize,
int neededness, OP_Code codeInfo, UTIL_Bool reDef,
char* varName, char* offset, char* printName);
/* val <funcName> : Absyn.aconstant -> bool */
char* OC_mkIsConstFuncDec(char* funcName);
/* let <funcName> tm = tm == <constVarName> */
char* OC_mkIsConstFuncDef(char* funcName, char* constVarName);
/* generate fixed constants */
char* OC_mkGenericConstVar(char* varList);
/* generate fixed constants decs */
char* OC_mkGenericConstVarDec(char* decList);
/* generate fixed constants entry in buildConstant function */
char* OC_mkGenericConstTabEntry(char* entries);
/* let buildPervasiveKinds =
function () ->\n <inits> <entries>\n <tabName>\n\n */
char* OC_mkBuildCTabFunc(char* entries);
/* make generaic const is function decs */
char* OC_mkGenericConstFuncDecs(char* funcDefs);
/* make generaic const is function defs */
char* OC_mkGenericConstFuncDefs(char* funcDefs);
char* OC_mkCompare(char* name);
char* OC_mkOr(char* operandl, char* operandr);
char* OC_mkRegClobFunc(char* body);
char* OC_mkBackTrackFunc(char* body);
/*****************************************************************************/
/* functions for making the fixed part of pervasive.mli */
/*****************************************************************************/
/*
val pervasiveKinds : Absyn.akind Table.SymbolTable.t
val pervasiveConstants : Absyn.aconstant Table.SymbolTable.t
val pervasiveTypeAbbrevs : Absyn.atypeabbrev Table.SymbolTable.t
*/
char* OC_mkFixedMLI();
/*****************************************************************************/
/* functions for making the fixed part of pervasive.ml */
/*****************************************************************************/
/*
let pervasiveKinds = buildPervasiveKinds ()
let pervasiveConstants = buildPervasiveConstants ()
let pervasiveTypeAbbrevs = Table.SymbolTable.empty
*/
char* OC_mkFixedML();

80
src/runtime/c/teyjus/tables_gen/pervasives/op.c
View File

@@ -1,80 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#include <stdlib.h>
#include <string.h>
#include "../util/util.h"
#include "op.h"
OP_Prec OP_mkPrecMin1()
{
OP_Prec prec;
prec.cat = OP_PREC;
prec.data.prec = -1;
return prec;
}
OP_Prec OP_mkPrecMin2()
{
OP_Prec prec;
prec.cat = OP_PREC;
prec.data.prec = -2;
return prec;
}
OP_Prec OP_mkPrec(int precedence)
{
OP_Prec prec;
prec.cat = OP_PREC;
prec.data.prec = precedence ;
return prec;
}
OP_Prec OP_mkPrecMax()
{
OP_Prec prec;
prec.cat = OP_PREC_NAME;
prec.data.name = strdup("MAX");
return prec;
}
int OP_precIsMax(OP_Prec prec)
{
if ((prec.cat == OP_PREC_NAME) && (strcmp(prec.data.name, "MAX") == 0))
return 1;
return 0;
}
OP_Code OP_mkCodeInfoNone()
{
return -1;
}
OP_Code OP_mkCodeInfo(int ind)
{
return ind;
}
int OP_codeInfoIsNone(OP_Code code)
{
return (code < 0);
}

58
src/runtime/c/teyjus/tables_gen/pervasives/op.h
View File

@@ -1,58 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#ifndef OP_H
#define OP_H
//fixity type
typedef enum {
OP_INFIX, OP_INFIXL, OP_INFIXR, OP_PREFIX, OP_PREFIXR, OP_POSTFIX,
OP_POSTFIXL, OP_NONE
} OP_Fixity;
typedef enum {
OP_PREC, OP_PREC_NAME
} OP_PrecTypeCat;
//precedence type
typedef struct
{
OP_PrecTypeCat cat;
union
{
int prec;
char* name;
} data;
} OP_Prec;
OP_Prec OP_mkPrecMin1();
OP_Prec OP_mkPrecMin2();
OP_Prec OP_mkPrec(int prec);
OP_Prec OP_mkPrecMax();
int OP_precIsMax(OP_Prec prec);
//code info type
typedef int OP_Code;
OP_Code OP_mkCodeInfoNone();
OP_Code OP_mkCodeInfo(int ind);
int OP_codeInfoIsNone(OP_Code code);
#endif

404
src/runtime/c/teyjus/tables_gen/pervasives/pervasives.in
View File

@@ -1,404 +0,0 @@
/% input file for pervasives files generation %/
/% section I: pervasive kinds %/
/% number of pervasive kinds %/
KIND 7
/% kind data table %/
/% index name index_name arity %/
/* int */
0 int int 0 ;;
/* real */
1 real real 0 ;;
/* bool */
2 o bool 0 ;;
/* string */
3 string string 0 ;;
/* list type constructor */
4 list list 1 ;;
/* in_stream */
5 in_stream instream 0 ;;
/* out_stream */
6 out_stream outstream 0
/% section II: pervasive constants and their type skeletons %/
/% section II.I : type skeletion and constant declarations %/
/% number of pervasive constants %/
CONST 94
/% number of type skeletons %/
TYPE SKEL 42
/% type skeleton and constant data table %/
/% type skeleton format:
[comments]
TYPE index type %/
/% constant format:
index name indname tesize neededness typerv redef prec fixity codeinfo
%/
/* A */
TYPE 0 #0
/* for unnamed universal constants (Note: tesize should be 0)*/
85 <constant> univ 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
;;
/* (list A) */
TYPE 1 (@ list 1 [#0])
/* nil */
89 nil nil 0 1 0 TRUE FALSE 0 NOFIXITY NOCODE
;;
/* A->(list A)->(list A) */
TYPE 2 #0 -> (@ list 1 [#0]) -> (@ list 1 [#0])
/* cons */
93 :: cons 0 1 0 TRUE FALSE 140 INFIXR NOCODE
;;
/* int */
TYPE 3 int
/* integer constant */
90 <int_constant> intc 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
;;
/* real */
TYPE 4 real
/* real constant */
91 <real_constant> realc 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
;;
/* string */
TYPE 5 string
/* string constant */
92 <str_constant> strc 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
;;
/* o (type of proposition)*/
TYPE 6 bool
/* true proposition */
4 true true 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
/* cut predicate */
5 ! cut 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
/* fail predicate */
6 fail fail 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
/* halt the system */
9 halt halt 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
/* return to top level */
10 stop stop 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
;;
/* int -> int */
TYPE 7 int -> int
/* unary minus on integers */
56 %i~ intuminus 0 0 0 TRUE FALSE MAX PREFIX NOCODE -
/* modulus */
61 mod mod 0 0 0 TRUE TRUE 160 INFIXL NOCODE
/* integer abs */
63 %iabs iabs 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE abs
;;
/* int -> int -> int */
TYPE 8 int -> int -> int
/* addition on integers */
57 %i+ intplus 0 0 0 TRUE FALSE 150 INFIXL NOCODE +
/* subtraction on integers */
58 %i- intminus 0 0 0 TRUE FALSE 150 INFIXL NOCODE -
/* mutiplication on integers */
59 %i* intmult 0 0 0 TRUE FALSE 160 INFIXL NOCODE *
/* integer division */
60 div intdiv 0 0 0 TRUE FALSE 160 INFIXL NOCODE
;;
/* int -> int -> o */
TYPE 9 int -> int -> bool
/* less than on integers */
19 %i< intlss 0 0 0 TRUE FALSE 130 INFIX 4 <
/* greater than on integers */
20 %i> intgrt 0 0 0 TRUE FALSE 130 INFIX 5 >
/* less than or eq on integers */
21 %i<= intleq 0 0 0 TRUE FALSE 130 INFIX 6 <=
/* greater than or eq on integers*/
22 %i>= intgeq 0 0 0 TRUE FALSE 130 INFIX 7 >=
/* time predicate */
51 time time 0 0 0 TRUE TRUE 0 NOFIXITY 36
;;
/* int -> real */
TYPE 10 int -> real
/* coercion to real */
62 int_to_real itor 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* real -> int */
TYPE 11 real -> int
/* floor function */
74 floor floor 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* ceiling function */
75 ceil ceil 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* truncation */
76 truncate trunc 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* real -> real */
TYPE 12 real -> real
/* unary minus on real */
64 %r~ realuminus 0 0 0 TRUE FALSE MAX PREFIX NOCODE -
/* square root */
69 sqrt sqrt 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* sine */
70 sin sin 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* cosine */
71 cos cos 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* arc tan */
72 arctan arctan 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* natural log */
73 ln log 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* real abs */
77 %rabs rabs 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE rabs
;;
/* real -> string */
TYPE 13 real -> string
/* real to string */
84 real_to_string rtos 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* real -> real -> real */
TYPE 14 real -> real -> real
/* addition on reals */
65 %r+ realplus 0 0 0 TRUE FALSE 150 INFIXL NOCODE +
/* subtraction on reals */
66 %r- realminus 0 0 0 TRUE FALSE 150 INFIXL NOCODE -
/* multiplication on reals */
67 %r* realmult 0 0 0 TRUE FALSE 160 INFIXL NOCODE *
/* division */
68 / realdiv 0 0 0 TRUE FALSE 160 INFIXL NOCODE
;;
/* real -> real -> o */
TYPE 15 real -> real -> bool
/* less than in reals */
23 %r< reallss 0 0 0 TRUE FALSE 130 INFIX 8 <
/* greater than on reals */
24 %r> realgrt 0 0 0 TRUE FALSE 130 INFIX 9 >
/* less than or eq on reals */
25 %r<= realleq 0 0 0 TRUE FALSE 130 INFIX 10 <=
/* greater than or eq on reals */
26 %r>= realgeq 0 0 0 TRUE FALSE 130 INFIX 11 >=
;;
/* string -> int */
TYPE 16 string -> int
/* string length */
79 size slen 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* ord function */
81 string_to_int stoi 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* int -> string */
TYPE 17 int -> string
/* chr function */
80 chr itochr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* int to string */
83 int_to_string itostr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* string -> string -> string */
TYPE 18 string -> string -> string
/* string concatination */
78 ^ scat 0 0 0 TRUE TRUE 150 INFIXL NOCODE
;;
/* string -> string -> o */
TYPE 19 string -> string -> bool
/* less than on strings */
27 %s< strlss 0 0 0 TRUE TRUE 130 INFIX 12 <
/* greater than on strings */
28 %s> strgrt 0 0 0 TRUE TRUE 130 INFIX 13 >
/* less than or eq on strings */
29 %s<= strleq 0 0 0 TRUE TRUE 130 INFIX 14 <=
/* greater than or eq on strings */
30 %s>= strgeq 0 0 0 TRUE TRUE 130 INFIX 15 >=
/* getenv predicate; needed? */
49 getenv getenv 0 0 0 TRUE TRUE 0 NOFIXITY 34
;;
/* string -> int -> int -> string */
TYPE 20 string -> int -> int -> string
/* substring */
82 substring substr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* o -> o -> o */
TYPE 21 bool -> bool -> bool
/* logical and */
0 , and 0 0 0 TRUE FALSE 110 INFIXL NOCODE
/* logical or */
1 ; or 0 0 0 TRUE FALSE 100 INFIXL NOCODE
/* another logical and */
8 & ampand 0 0 0 TRUE FALSE 120 INFIXR NOCODE
/* Prolog if; needed? */
11 :- colondash 0 0 0 TRUE FALSE 0 INFIXL NOCODE
/* implication; needed? */
12 => impl 0 0 0 TRUE FALSE 130 INFIXR NOCODE
;;
/* (A -> o) -> o */
TYPE 22 (#0 -> bool) -> bool
/* existential quantifier */
2 sigma some 1 1 1 FALSE FALSE 0 NOFIXITY NOCODE
/* universal quantifier */
3 pi all 1 1 1 FALSE FALSE 0 NOFIXITY NOCODE
;;
/* A -> A -> o */
TYPE 23 #0 -> #0 -> bool
/* is */
16 is is 1 1 1 FALSE FALSE 130 INFIX 1
/* equality (unify) predicate */
18 = eq 1 1 1 FALSE FALSE 130 INFIX 3
;;
/* in_stream */
TYPE 24 instream
/* std_in */
86 std_in stdin 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* out_stream */
TYPE 25 outstream
/* std_out */
87 std_out stdout 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
/* std_err */
88 std_err stderr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
;;
/* string -> in_stream -> o */
TYPE 26 string -> instream -> bool
/* open_in */
31 open_in openin 0 0 0 TRUE TRUE 0 NOFIXITY 16
/* open_string */
36 open_string openstr 0 0 0 TRUE TRUE 0 NOFIXITY 21
;;
/* string -> out_stream -> o */
TYPE 27 string -> outstream -> bool
/* open_out */
32 open_out openout 0 0 0 TRUE TRUE 0 NOFIXITY 17
/* open_append */
33 open_append openapp 0 0 0 TRUE TRUE 0 NOFIXITY 18
;;
/* in_stream -> o */
TYPE 28 instream -> bool
/* close_in */
34 close_in closein 0 0 0 TRUE TRUE 0 NOFIXITY 19
/* eof */
41 eof eof 0 0 0 TRUE TRUE 0 NOFIXITY 26
;;
/* out_stream -> o */
TYPE 29 outstream -> bool
/* close_out */
35 close_out closeout 0 0 0 TRUE TRUE 0 NOFIXITY 20
/* flush */
42 flush flush 0 0 0 TRUE TRUE 0 NOFIXITY 27
;;
/* A -> string -> o */
TYPE 30 #0 -> string -> bool
/* term_to_string */
46 term_to_string termtostr 1 1 0 FALSE TRUE 0 NOFIXITY 31
;;
/* string -> A -> o */
TYPE 31 string -> #0 -> bool
/* string_to_term */
47 string_to_term strtoterm 1 1 1 FALSE TRUE 0 NOFIXITY 32
;;
/* out_stream -> string -> o */
TYPE 32 outstream -> string -> bool
/* output */
38 output output 0 0 0 TRUE TRUE 0 NOFIXITY 23
;;
/* in_stream -> int -> string -> o */
TYPE 33 instream -> int -> string -> bool
/* input */
37 input input 0 0 0 TRUE TRUE 0 NOFIXITY 22
;;
/* in_stream -> string -> o */
TYPE 34 instream -> string -> bool
/* input_line */
39 input_line inputline 0 0 0 TRUE TRUE 0 NOFIXITY 24
/* lookahead */
40 lookahead lookahead 0 0 0 TRUE TRUE 0 NOFIXITY 25
;;
/* string -> o */
TYPE 35 string -> bool
/* print */
43 print print 0 0 0 TRUE TRUE 0 NOFIXITY 28
;;
/* A -> o */
TYPE 36 #0 -> bool
/* read */
44 read read 1 1 1 FALSE TRUE 0 NOFIXITY 29
;;
/* out_stream -> A -> o */
TYPE 37 outstream -> #0 -> bool
/* printterm */
45 printterm printterm 1 1 0 FALSE TRUE 0 NOFIXITY 30
;;
/* in_stream -> A -> o */
TYPE 38 instream -> #0 -> bool
/* readterm */
48 readterm readterm 1 1 1 FALSE TRUE 0 NOFIXITY 33
;;
/* o -> o */
TYPE 39 bool -> bool
/* solve; used by code generator */
15 solve solve 0 0 0 TRUE FALSE 0 NOFIXITY 0
/* not */
17 not not 0 0 0 TRUE FALSE 0 NOFIXITY 2
;;
/* string -> int -> in_stream -> out_stream -> o */
TYPE 40 string -> int -> instream -> outstream -> bool
/* open_socket predicate */
50 open_socket opensocket 0 0 0 FALSE TRUE 0 NOFIXITY 35
;;
/* string -> int -> o */
TYPE 41 string -> int -> bool
/* system predicate */
52 system system 0 0 0 FALSE TRUE 0 NOFIXITY 37
/% pervasive constant classification %/
LOGIC SYMBOL 11
LS_START and LS_END stop
/% logic symbol types %/
0 and
1 or
2 some
3 all
4 l_true
5 cut
6 fail
7 eq
8 ampand
9 halt
10 stop
PRED SYMBOL 37
PRED_START solve PRED_END system
REGCL solve not getenv strtoterm readterm read is lookahead input inputline
BACKTRACK eq

96
src/runtime/c/teyjus/tables_gen/pervasives/pervasives.l
View File

@@ -1,96 +0,0 @@
%{
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#include "../util/util.h"
#include "op.h"
#include "types.h"
#include "y.tab.h"
#include <stdlib.h>
#include <string.h>
static int commentLev = 0;
%}
LETTER [A-Za-z]
DIGIT [0-9]
SYMBOL "_"|"+"|"-"|"*"|"/"|"!"|"~"|"@"|"$"|"%"|"^"|"&"|"*"|"<"|">"|"="|"'"|";"|":"|","
ID ({LETTER}|{SYMBOL})({LETTER}|{DIGIT}|{SYMBOL})*
NUM {DIGIT}+
WSPACE [ \t]+
STRING [^*/]+
%x COMMENT C_COMMENT
/* Some versions of lex require an explicit positions argument */
%p 10000
%%
<INITIAL,COMMENT>"\n" {continue; }
<INITIAL>"KIND" {return KIND; }
<INITIAL>"CONST" {return CONST; }
<INITIAL>"TYPE SKEL" {return TYSKEL; }
<INITIAL>"TYPE" {return TYPE; }
<INITIAL>"->" {return TYARROW; }
<INITIAL>"@" {return TYAPP; }
<INITIAL>"[" {return LBRACKET; }
<INITIAL>"]" {return RBRACKET; }
<INITIAL>"(" {return LPAREN; }
<INITIAL>")" {return RPAREN; }
<INITIAL>"t," {return COMMA; }
<INITIAL>"#" {return POUND; }
<INITIAL>";;" {return SEMICOLON; }
<INITIAL>"INFIX" {return INFIX; }
<INITIAL>"INFIXL" {return INFIXL; }
<INITIAL>"INFIXR" {return INFIXR; }
<INITIAL>"PREFIX" {return PREFIX; }
<INITIAL>"PREFIXR" {return PREFIXR; }
<INITIAL>"POSTFIX" {return POSTFIX; }
<INITIAL>"POSTFIXL" {return POSTFIXL; }
<INITIAL>"NOFIXITY" {return NOFIXITY; }
<INITIAL>"MIN1" {return MIN1; }
<INITIAL>"MIN2" {return MIN2; }
<INITIAL>"MAX" {return MAX; }
<INITIAL>"NOCODE" {return NOCODE; }
<INITIAL>"LOGIC SYMBOL" {return LSSYMB; }
<INITIAL>"LS_START" {return LSSTART; }
<INITIAL>"LS_END" {return LSEND; }
<INITIAL>"PRED SYMBOL" {return PREDSYMB; }
<INITIAL>"PRED_START" {return PREDSTART; }
<INITIAL>"PRED_END" {return PREDEND; }
<INITIAL>"REGCL" {return REGCL; }
<INITIAL>"BACKTRACK" {return BACKTRACK; }
<INITIAL>"TRUE" {return TRUE; }
<INITIAL>"FALSE" {return FALSE; }
<INITIAL>{WSPACE} {continue; }
<INITIAL>"/%" {commentLev = 1; BEGIN(COMMENT); continue; }
<INITIAL>"/*" {BEGIN(C_COMMENT); continue; }
<INITIAL>{ID} {yylval.name = strdup(yytext); return ID; }
<INITIAL>{NUM} {yylval.isval.ival = atoi(yytext);
yylval.isval.sval = strdup(yytext);
return NUM; }
<C_COMMENT>"*/" {BEGIN(INITIAL); continue; }
<C_COMMENT>{STRING} {yylval.text = strdup(yytext); return STRING; }
<COMMENT>[^%/\n]+ {continue; }
<COMMENT>"/%" {commentLev++; continue; }
<COMMENT>"%/" {commentLev--;
if (!commentLev) BEGIN(INITIAL); continue; }
. {return ERROR; }

351
src/runtime/c/teyjus/tables_gen/pervasives/pervasives.y
View File

@@ -1,351 +0,0 @@
%{
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#include <stdio.h>
#include <stdlib.h>
#include "../util/util.h"
#include "op.h"
#include "types.h"
#include "pervgen-c.h"
#include "pervgen-ocaml.h"
//#include "ops.h"
extern int yylex();
int yywrap() {return 1;}
void yyerror(const char* str)
{
printf("Error: Unable to parse input: %s\n", str);
}
static int tySkelInd = 0;
%}
%union
{
char* name;
char* text;
OP_Fixity fixityType;
OP_Prec precType;
OP_Code codeType;
UTIL_Bool boolType;
struct
{
int ival;
char* sval;
} isval;
Type tyval;
TypeList tylistval;
}
%token LBRACKET RBRACKET LPAREN RPAREN COMMA POUND SEMICOLON TRUE
FALSE
TYARROW TYAPP
INFIX INFIXL INFIXR PREFIX PREFIXR POSTFIX POSTFIXL NOFIXITY
MIN1 MIN2 MAX
NOCODE
LSSYMB LSSTART LSEND PREDSYMB PREDSTART PREDEND REGCL
BACKTRACK
KIND CONST EMPTY TYSKEL TYPE EMPTYTYPE ERROR
%token <name> ID
%token <isval> NUM
%token <text> STRING
%start pervasives
%type <text> comments
%type <tyval> arrow_tyskel app_tyskel atomic_tyskel
%type <tylistval> tyskel_list
%type <isval> ty_index tesize neededness
%type <name> const_name const_ind_name
%type <fixityType> fixity
%type <precType> prec
%type <codeType> code_info
%type <boolType> redef typrev
%%
pervasives : kind const_tyskel
;
kind : kind_header kind_decls
{ cgenKindH(); cgenKindC(); ocamlGenKinds(); }
;
kind_header : KIND NUM
{ cgenKindInit($2.ival); cgenNumKinds($2.sval);
ocamlGenNumKinds($2.sval);
}
;
kind_decls : kind_decl SEMICOLON kind_decls
| kind_decl
;
kind_decl : NUM ID ID NUM
{ cgenKindIndex($1.ival, $3, $1.sval, NULL);
cgenKindData($1.ival, $2, $4.sval, NULL);
ocamlGenKind($2, $3, $4.sval, $1.sval); }
| comments NUM ID ID NUM
{ cgenKindIndex($2.ival, $4, $2.sval, $1);
cgenKindData($2.ival, $3, $5.sval, $1);
ocamlGenKind($3, $4, $5.sval, $2.sval); }
;
comments : STRING { $$ = $1;};
;
const_tyskel : const_tyskel_header const_tyskel_decls const_property
{ cgenTySkelsH(); cgenTySkelsC(); cgenConstProperty();
cgenConstH(); cgenConstC();
ocamlGenConsts();
}
;
const_tyskel_header : CONST NUM TYSKEL NUM
{ cgenNumTySkels($4.sval); cgenTySkelInit($4.ival);
cgenNumConsts($2.sval); cgenConstInit($2.ival);
ocamlGenNumConsts($2.sval);
}
;
const_tyskel_decls : const_tyskel_decl SEMICOLON const_tyskel_decls
| const_tyskel_decl
;
const_tyskel_decl : tyskel_decl const_decls
;
tyskel_decl : TYPE NUM arrow_tyskel
{tySkelInd = $2.ival;
ocamlGenTySkel($2.sval, $3);
cgenTySkelTab($2.ival, $3, NULL);
}
| comments TYPE NUM arrow_tyskel
{tySkelInd = $3.ival;
ocamlGenTySkel($3.sval, $4);
cgenTySkelTab($3.ival, $4, $1);
}
;
arrow_tyskel : app_tyskel TYARROW arrow_tyskel
{ $$ = mkArrowType($1, $3); }
| app_tyskel
{ $$ = $1; }
;
app_tyskel : LPAREN TYAPP ID NUM LBRACKET tyskel_list
RBRACKET RPAREN
{$$ = mkStrType(mkStrFuncType($3,$4.sval), $4.ival, $6);}
| atomic_tyskel
{$$ = $1; }
;
atomic_tyskel : ID
{ $$ = mkSortType($1); }
| ty_index
{ $$ = mkSkVarType($1.sval); }
| LPAREN arrow_tyskel RPAREN
{ $$ = $2; }
;
tyskel_list : arrow_tyskel COMMA tyskel_list
{ $$ = addItem($1, $3); }
| arrow_tyskel
{ $$ = addItem($1, NULL); }
ty_index : POUND NUM {$$ = $2;}
;
const_decls : const_decl const_decls
| const_decl
;
const_decl : NUM const_name const_ind_name tesize tesize neededness
typrev redef prec fixity code_info
{ cgenConstIndex($1.ival, $3, $1.sval, NULL);
cgenConstData($1.ival, $2, $4.sval, $9, $10, tySkelInd,
$5.sval, NULL);
ocamlGenConst($1.sval, $2, $3, $10, $9, $7, $8,
$4.ival, tySkelInd, $6.ival, $11,
$1.sval, $2);
}
| NUM const_name const_ind_name tesize tesize neededness
typrev redef prec fixity code_info const_name
{ cgenConstIndex($1.ival, $3, $1.sval, NULL);
cgenConstData($1.ival, $12, $4.sval, $9, $10, tySkelInd,
$5.sval, NULL);
ocamlGenConst($1.sval, $2, $3, $10, $9, $7, $8,
$4.ival, tySkelInd, $6.ival, $11,
$1.sval, $12);
}
| comments NUM const_name const_ind_name tesize tesize
neededness typrev redef prec fixity code_info
{ cgenConstIndex($2.ival, $4, $2.sval, $1);
cgenConstData($2.ival, $3, $5.sval, $10, $11,
tySkelInd, $7.sval, $1);
ocamlGenConst($2.sval, $3, $4, $11, $10, $8, $9,
$5.ival, tySkelInd, $7.ival, $12,
$2.sval, $3);
}
| comments NUM const_name const_ind_name tesize tesize
neededness typrev redef prec fixity code_info const_name
{ cgenConstIndex($2.ival, $4, $2.sval, $1);
cgenConstData($2.ival, $13, $5.sval, $10, $11,
tySkelInd, $7.sval, $1);
ocamlGenConst($2.sval, $3, $4, $11, $10, $8, $9,
$5.ival, tySkelInd, $7.ival, $12,
$2.sval, $13);
}
;
const_name : ID {$$ = $1;}
;
const_ind_name : ID {$$ = $1;}
;
tesize : NUM {$$ = $1;}
;
neededness : NUM {$$ = $1;}
;
typrev : TRUE {$$ = UTIL_TRUE;}
| FALSE {$$ = UTIL_FALSE;}
;
redef : TRUE {$$ = UTIL_TRUE;}
| FALSE {$$ = UTIL_FALSE;}
;
fixity : INFIX {$$ = OP_INFIX;}
| INFIXL {$$ = OP_INFIXL;}
| INFIXR {$$ = OP_INFIXR;}
| PREFIX {$$ = OP_PREFIX;}
| PREFIXR {$$ = OP_PREFIXR;}
| POSTFIX {$$ = OP_POSTFIX;}
| POSTFIXL {$$ = OP_POSTFIXL;}
| NOFIXITY {$$ = OP_NONE;}
;
prec : MIN1 {$$ = OP_mkPrecMin1();}
| MIN2 {$$ = OP_mkPrecMin2();}
| NUM {$$ = OP_mkPrec($1.ival);}
| MAX {$$ = OP_mkPrecMax();}
;
code_info : NOCODE {$$ = OP_mkCodeInfoNone();}
| NUM {$$ = OP_mkCodeInfo($1.ival);}
;
const_property : logic_symbol pred_symbol regclobber backtrackable
;
logic_symbol : ls_header ls_range ls_types
;
ls_header : LSSYMB NUM { cgenLogicSymbolInit($2.ival); }
;
ls_range : LSSTART const_ind_name LSEND const_ind_name
{ cgenLSRange($2, $4);}
;
ls_types : ls_type ls_types
| ls_type
;
ls_type : NUM ID {cgenLogicSymbType($1.ival, $2, $1.sval);}
;
pred_symbol : pred_header pred_range
;
pred_header : PREDSYMB NUM
{if ($2.ival == 0) {
fprintf(stderr,
"The number of predicate symbols cannot be 0\n");
exit(1);
}
}
;
pred_range : PREDSTART const_ind_name PREDEND const_ind_name
{ cgenPREDRange($2, $4); }
;
regclobber : REGCL const_list { ocamlGenRC(); }
;
backtrackable : BACKTRACK const_list { ocamlGenBC(); }
;
const_list : ID const_list { ocamlCollectConsts($1, 0); }
| ID { ocamlCollectConsts($1, 1); }
;
%%
extern FILE* yyin;
int main(argc, argv)
int argc;
char * argv[];
{
int ret = 0;
char * root = NULL;
if(argc == 1)
{
//printf("No input file specified; using 'Pervasives.in'.\n");
yyin = UTIL_fopenR("pervasives.in");
}
else
{
yyin = UTIL_fopenR(argv[1]);
}
if(argc > 2)
{
root = argv[2];
}
else
{
//printf("Teyjus source root directory not specified; using '../../'.\n");
root = "../../";
}
//printf("Generating pervasive files...\n");
ret = yyparse();
UTIL_fclose(yyin);
if(ret != 0)
{
printf("Generation failed.\n");
return -1;
}
spitCPervasivesH(root);
spitCPervasivesC(root);
//spitOCPervasiveMLI(root);
//spitOCPervasiveML(root);
//printf("Done.\n");
return 0;
}

454
src/runtime/c/teyjus/tables_gen/pervasives/pervgen-c.c
View File

@@ -1,454 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* File pervgen-c.c. This files contains function definitions for generating */
/* files pervasives.h and pervasives.c. */
/*****************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "pervgen-c.h"
#include "ccode.h"
#include "../util/util.h"
//dynamic string array type
typedef struct StringArray
{
char **array;
int length;
} StringArray;
//array initialization
static void arrayInit(char **array, int size)
{
int i ;
for (i =0; i < size; i++) array[i] = NULL;
}
//collect string in a StringArray into a single array
static char* collectStringArray(StringArray arr, char* emptyText)
{
char *myText = NULL;
char *myText2 = NULL;
int i;
int length = 0;
for (i = 0; i < arr.length; i++) {
char* text = arr.array[i];
if (text == NULL) text = emptyText;
if (myText) {
myText2 = UTIL_mallocStr(strlen(text) + strlen(myText));
strcpy(myText2, myText);
strcat(myText2, text);
free(myText);
} else {
myText2 = UTIL_mallocStr(strlen(text));
strcpy(myText2, text);
}
if (arr.array[i]) free(arr.array[i]);
myText = myText2;
}
free(arr.array);
return myText;
}
/****************************************************************************/
/* kind relevant components */
/****************************************************************************/
/***********************************************************************/
/* pervasives.h */
/***********************************************************************/
//number of pervasive kinds
static char* numKinds = NULL;
void cgenNumKinds(char* num)
{
numKinds = C_mkNumKinds(num);
}
//pervasive kind indices declaration
static StringArray kindIndices; //kind indices declaration
void cgenKindIndex(int index, char* name, char* indexT, char* comments)
{
char* kindIndex;
char* kindIndexText;
if (index >= kindIndices.length) {
fprintf(stderr, "kind index exceed total number of kinds\n");
exit(1);
}
kindIndex = C_mkIndex(name, indexT, comments);
kindIndexText = UTIL_mallocStr(strlen(kindIndex) + 2);
strcpy(kindIndexText, kindIndex); free(kindIndex);
if (index != (kindIndices.length - 1)) strcat(kindIndexText, ",");
strcat(kindIndexText, "\n");
kindIndices.array[index] = kindIndexText;
}
//pervasive kind relevant information in pervasives.h
static char* kindH;
void cgenKindH()
{
char* emptyText = C_mkEmptyComments();
char* kindIndexBody = collectStringArray(kindIndices, emptyText);
char* kindIndexTypeDef = C_mkKindIndexType(kindIndexBody);
kindH = C_mkKindH(kindIndexTypeDef, numKinds);
free(kindIndexBody); free(kindIndexTypeDef); free(numKinds);
free(emptyText);
}
/***********************************************************************/
/* pervasives.c */
/***********************************************************************/
//pervasive kind table entries
static StringArray kindData;
void cgenKindData(int index, char* name, char* arity, char* comments)
{
char* oneKindData;
char* kindDataText;
if (index >= kindData.length) {
fprintf(stderr, "kind index exceed total number of kinds\n");
exit(1);
}
oneKindData = C_mkKindTabEntry(name, arity, comments);
kindDataText = UTIL_mallocStr(strlen(oneKindData) + 2);
strcpy(kindDataText, oneKindData); free(oneKindData);
if (index != kindData.length - 1) strcat(kindDataText, ",");
strcat(kindDataText, "\n");
kindData.array[index] = kindDataText;
}
#define EMPTY_TEXT_KIND_TAB " //nothing \n {NULL, 0},\n"
//pervasive kind relevant information in pervasives.c
static char* kindC;
void cgenKindC()
{
char* kindTabBody = collectStringArray(kindData, EMPTY_TEXT_KIND_TAB);
char* kindTab = C_mkKindTab(kindTabBody);
kindC = C_mkKindC(kindTab);
free(kindTabBody); free(kindTab);
}
//kind indices info and kind table info initiation
void cgenKindInit(int length)
{
kindIndices.length = length;
kindIndices.array = (char**)UTIL_malloc(sizeof(char*)*length);
arrayInit(kindIndices.array, length);
kindData.length = length;
kindData.array = (char**)UTIL_malloc(sizeof(char*)*length);
arrayInit(kindData.array, length);
}
/****************************************************************************/
/* type skeleton relevant components */
/****************************************************************************/
/***********************************************************************/
/* pervasives.h */
/***********************************************************************/
//number of type skeletons for pervasive constants
static char* numTySkels = NULL;
void cgenNumTySkels(char* num)
{
numTySkels = C_mkNumTySkels(num);
}
//type skeleton relevant information in pervasives.h
static char* tySkelsH;
void cgenTySkelsH()
{
tySkelsH = C_mkTySkelsH(numTySkels);
free(numTySkels);
}
/***********************************************************************/
/* pervasives.c */
/***********************************************************************/
//type skeleton creation code
static StringArray tySkels;
void cgenTySkelTab(int index, Type tyskel, char* comments)
{
if (index >= tySkels.length){
fprintf(stderr,
"type skeleton index exceed total number of type skeletons\n");
exit(1);
}
tySkels.array[index] = C_genTySkel(tyskel, comments);
}
//generate types skeleton initialization code
static char* cgenTySkelTabInit()
{
char* body = collectStringArray(tySkels, "");
char* text = C_mkTySkelTabInit(body, C_totalSpace);
free(body);
return text;
}
//type skeleton info initiation
void cgenTySkelInit(int length)
{
if (length == 0) {
fprintf(stderr, "The number of type skeletons cannot be 0\n");
exit(1);
}
tySkels.length = length;
tySkels.array = (char**)UTIL_malloc(sizeof(char*)*length);
arrayInit(tySkels.array, length);
}
//type skeleton relevant information in pervasives.c
static char* tySkelsC;
void cgenTySkelsC()
{
char* tySkelTab = cgenTySkelTabInit();
tySkelsC = C_mkTySkelsC(tySkelTab); free(tySkelTab);
}
/****************************************************************************/
/* constant relevant components */
/****************************************************************************/
/***********************************************************************/
/* pervasives.h */
/***********************************************************************/
//number of pervasive constants
static char* numConsts = NULL;
void cgenNumConsts(char* num)
{
numConsts = C_mkNumConsts(num);
}
//pervasive constant indices declaration
static StringArray constIndices;
void cgenConstIndex(int index, char* name, char* indexT, char* comments)
{
char* constIndex;
char* constIndexText;
if (index >= constIndices.length) {
fprintf(stderr, "constant index exceed total number of constants\n");
exit(1);
}
constIndex = C_mkIndex(name, indexT, comments);
constIndexText = UTIL_mallocStr(strlen(constIndex) + 2);
strcpy(constIndexText, constIndex);
if (index != (constIndices.length - 1)) strcat(constIndexText, ",");
strcat(constIndexText, "\n");
constIndices.array[index] = constIndexText;
}
/***********************************************************************/
/* constant property functions */
/***********************************************************************/
static StringArray logicSymbTypes;
//initiale logic symb types
void cgenLogicSymbolInit(int length)
{
logicSymbTypes.length = length;
logicSymbTypes.array = (char**)UTIL_malloc(sizeof(char*)*length);
arrayInit(logicSymbTypes.array, length);
}
//generate logic symbol types
void cgenLogicSymbType(int index, char* name, char* indexT)
{
char* constIndex;
char* constIndexText;
if (index >= logicSymbTypes.length) {
fprintf(stderr, "logic symbol type index exceed the total number of logic symbols\n");
exit(1);
}
constIndex = C_mkIndex2(name, indexT);
constIndexText = UTIL_mallocStr(strlen(constIndex) + 2);
strcpy(constIndexText, constIndex);
if (index != (constIndices.length - 1)) strcat(constIndexText, ",");
strcat(constIndexText, "\n");
logicSymbTypes.array[index] = constIndexText;
}
static char* lsRange = NULL;
//generate logic symbol start/end position
void cgenLSRange(char* start, char* end)
{
lsRange = C_mkLSRange(start, end);
}
static char* predRange = NULL;
//generate predicate symbol start/end position
void cgenPREDRange(char* start, char* end)
{
predRange = C_mkPredRange(start, end);
}
static char* constProperty = NULL;
void cgenConstProperty()
{
char* emptyText = C_mkEmptyComments();
char* logicSymbTypeBody = collectStringArray(logicSymbTypes, emptyText);
char* logicSymbTypeDec = C_mkLSTypeDec(logicSymbTypeBody);
constProperty = UTIL_mallocStr(strlen(logicSymbTypeDec) + strlen(lsRange)
+ strlen(predRange));
strcpy(constProperty, lsRange);
strcat(constProperty, predRange);
strcat(constProperty , logicSymbTypeDec);
free(emptyText); free(logicSymbTypeBody); free(logicSymbTypeDec);
free(lsRange); free(predRange);
}
//pervasive kind relevant information in pervasives.h
static char* constH;
void cgenConstH()
{
char* emptyText = C_mkEmptyComments();
char* constIndexBody = collectStringArray(constIndices, emptyText);
char* constIndexTypeDef = C_mkConstIndexType(constIndexBody);
constH = C_mkConstH(constIndexTypeDef, numConsts, constProperty);
free(constIndexBody); free(constIndexTypeDef);
free(emptyText); free(constProperty);
}
/***********************************************************************/
/* pervasives.c */
/***********************************************************************/
//pervasive const table entries
static StringArray constData;
void cgenConstData(int index, char* name, char* tesize, OP_Prec prec,
OP_Fixity fixity, int tySkelInd, char* neededness,
char* comments)
{
char* oneConstData;
char* constDataText;
char* tySkelIndText = UTIL_itoa(tySkelInd);
if (index >= constData.length) {
fprintf(stderr, "const index exceed total number of consts\n");
exit(1);
}
oneConstData = C_mkConstTabEntry(name, tesize, prec, fixity, tySkelIndText,
neededness, comments);
free(tySkelIndText);
constDataText = UTIL_mallocStr(strlen(oneConstData) + 2);
strcpy(constDataText, oneConstData); free(oneConstData);
if (index != constData.length - 1) strcat(constDataText, ",");
strcat(constDataText, "\n");
constData.array[index] = constDataText;
}
#define EMPTY_TEXT_CONST_TAB \
" //nothing\n {NULL, 0, 0, 0, 0, OP_NONE },\n"
//pervasive const relevant information in pervasives.c
static char* constC;
void cgenConstC()
{
char* constTabBody = collectStringArray(constData, EMPTY_TEXT_CONST_TAB);
char* constTab = C_mkConstTab(constTabBody);
constC = C_mkConstC(constTab);
free(constTabBody); free(constTab);
}
//const indices info and const table info initiation
void cgenConstInit(int length)
{
constIndices.length = length;
constIndices.array = (char**)UTIL_malloc(sizeof(char*)*length);
arrayInit(constIndices.array, length);
constData.length = length;
constData.array = (char**)UTIL_malloc(sizeof(char*)*length);
arrayInit(constData.array, length);
}
/****************************************************************************/
/* Writing files */
/****************************************************************************/
static char* pervBegH;
static char* pervEndH;
static void cgenFixedH()
{
pervBegH = C_mkFixedBegH();
pervEndH = C_mkFixedEndH();
}
static char* pervBegC;
static char* pervEndC;
static void cgenFixedC()
{
pervBegC = C_mkFixedBegC();
pervEndC = C_mkFixedEndC();
}
/* dump peravsives.h */
void spitCPervasivesH(char * root)
{
FILE* outFile;
char * filename = malloc(strlen(root) + 32);
strcpy(filename, root);
strcat(filename, "tables/pervasives.h");
outFile = UTIL_fopenW(filename);
cgenFixedH();
fprintf(outFile, "%s\n", pervBegH); free(pervBegH);
fprintf(outFile, "%s\n", kindH); free(kindH);
fprintf(outFile, "%s\n", tySkelsH); free(tySkelsH);
fprintf(outFile, "%s\n", constH); free(constH);
fprintf(outFile, "%s\n", pervEndH); free(pervEndH);
UTIL_fclose(outFile);
free(filename);
}
/* dump pervasives.c */
void spitCPervasivesC(char * root)
{
FILE* outFile;
char * filename = malloc(strlen(root) + 32);
strcpy(filename, root);
strcat(filename, "tables/pervasives.c");
outFile = UTIL_fopenW(filename);
cgenFixedC();
fprintf(outFile, "%s\n", pervBegC); free(pervBegC);
fprintf(outFile, "%s\n", kindC); free(kindC);
fprintf(outFile, "%s\n", tySkelsC); free(tySkelsC);
fprintf(outFile, "%s\n", constC); free(constC);
fprintf(outFile, "%s\n", pervEndC); free(pervEndC);
UTIL_fclose(outFile);
free(filename);
}

95
src/runtime/c/teyjus/tables_gen/pervasives/pervgen-c.h
View File

@@ -1,95 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* File pervgen-c.h. This files contains function definitions for generating */
/* files pervasives.h and pervasives.c. */
/*****************************************************************************/
#include "types.h"
#include "op.h"
/****************************************************************************/
/* kind relevant components */
/****************************************************************************/
//kind indices info and kind table info initiation
void cgenKindInit(int size);
//number of pervasive kinds
void cgenNumKinds(char* num);
//pervasive kind indices declaration
void cgenKindIndex(int index, char* name, char* indexT, char* comments);
//pervasive kind relevant information in pervasives.h
void cgenKindH();
//pervasive kind table entries
void cgenKindData(int index, char* name, char* arity, char* comments);
//pervasive kind relevant information in pervasives.c
void cgenKindC();
/****************************************************************************/
/* type skeleton relevant components */
/****************************************************************************/
//number of type skeletons for pervasive constants
void cgenNumTySkels(char* num);
//type skeleton relevant information in pervasives.h
void cgenTySkelsH();
//type skeleton creation code
void cgenTySkelTab(int index, Type tyskel, char* comments);
//type skeleton info initiation
void cgenTySkelInit(int length);
//type skeleton relevant information in pervasives.c
void cgenTySkelsC();
/****************************************************************************/
/* constant relevant components */
/****************************************************************************/
//const indices info and const table info initiation
void cgenConstInit(int length);
//number of pervasive constants
void cgenNumConsts(char* num);
//pervasive constant indices declaration
void cgenConstIndex(int index, char* name, char* indexT, char* comments);
//pervasive constant relevant information in pervasives.h
void cgenConstH();
//pervasive constant table entries
void cgenConstData(int index, char* name, char* tesize, OP_Prec prec,
OP_Fixity fixity, int tySkelInd, char* neededness,
char* comments);
//pervasive const relevant information in pervasives.c
void cgenConstC();
//initiale logic symb types
void cgenLogicSymbolInit(int length);
//generate logic symbol types
void cgenLogicSymbType(int index, char* name, char* indexText);
//generate logic symbol start/end position
void cgenLSRange(char* start, char* end);
//generate predicate symbol start/end position
void cgenPREDRange(char* start, char* end);
void cgenConstProperty();
/****************************************************************************/
/* Writing files */
/****************************************************************************/
/* dump files pervasives.h */
void spitCPervasivesH(char * root);
/* dump files pervasives.c */
void spitCPervasivesC(char * root);

350
src/runtime/c/teyjus/tables_gen/pervasives/pervgen-ocaml.c
View File

@@ -1,350 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* File pervgen-ocaml.c. This files contains function definitions for */
/* generating files pervasive.mli and pervasive.ml. */
/*****************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "pervgen-ocaml.h"
#include "ocamlcode.h"
static char* addLine(char* str, char* addOn)
{
size_t length = (str ? strlen(str) : 0) + strlen(addOn) + 2;
char* newStr = UTIL_mallocStr(length);
if (str) {
strcpy(newStr, str);
strcat(newStr, addOn);
} else strcpy(newStr, addOn);
strcat(newStr, "\n\n");
return newStr;
}
static char* addStr(char* str, char* addOn)
{
size_t length = (str ? strlen(str) : 0) + strlen(addOn);
char* newStr = UTIL_mallocStr(length);
if (str) {
strcpy(newStr, str);
strcat(newStr, addOn);
} else strcpy(newStr, addOn);
return newStr;
}
/**************************************************************************/
/* generating pervasive kind relevant part */
/**************************************************************************/
static char* numKindsML = NULL;
static char* numKindsMLI = NULL;
void ocamlGenNumKinds(char* number)
{
numKindsMLI = strdup("val numberPervasiveKinds : int");
numKindsML = addStr("let numberPervasiveKinds = ", number);
}
static char* kindVarList = NULL; //kind variable definitions
static char* buildPervKindBody = NULL; //buildPervKind function defs
static char* kindVarDecs = NULL; //kind vars in signature
static char* isKindFuncDecs = NULL; //is kind function decs
static char* isKindFuncDefs = NULL; //is kind function defs
void ocamlGenKind(char* kindName, char* kVarName, char* arity, char* offset)
{
char* kindVarName = OC_mkKVarName(kVarName);
char* funcName = OC_mkIsKindFuncName(kindVarName);
char* kindVar = OC_mkKindVar(kindVarName, kindName, arity, offset);
char* kindTabEntry = OC_mkTabEntry(kindName, kindVarName);
char* kindVarDec = OC_mkKindVarDec(kindVarName);
char* funcDec = OC_mkIsKindFuncDec(funcName);
char* funcDef = OC_mkIsKindFuncDef(funcName, kindVarName);
char *myKindVarList, *myBuildPervKindBody, *myKindVarDecs,
*myisKindFuncDecs, *myisKindFuncDefs;
free(kindVarName);
myKindVarList = addLine(kindVarList, kindVar);
free(kindVarList); free(kindVar);
kindVarList = myKindVarList;
myBuildPervKindBody = addStr(buildPervKindBody, kindTabEntry);
free(buildPervKindBody); free(kindTabEntry);
buildPervKindBody = myBuildPervKindBody;
myKindVarDecs = addStr(kindVarDecs, kindVarDec);
free(kindVarDecs); free(kindVarDec);
kindVarDecs = myKindVarDecs;
myisKindFuncDecs = addStr(isKindFuncDecs, funcDec);
free(isKindFuncDecs); free(funcDec);
isKindFuncDecs = myisKindFuncDecs;
myisKindFuncDefs = addLine(isKindFuncDefs, funcDef);
free(isKindFuncDefs); free(funcDef);
isKindFuncDefs = myisKindFuncDefs;
}
static char* kindML = NULL; //kind relevant code in pervasive.ml
static char* kindMLI = NULL; //kind relevant code in pervasive.mli
void ocamlGenKinds()
{
char* buildTabFunc = OC_mkBuildKTabFunc(buildPervKindBody);
size_t length = strlen(kindVarList) + strlen(buildTabFunc) +
strlen(isKindFuncDefs) + strlen(numKindsML) + 4;
kindML = UTIL_mallocStr(length);
strcpy(kindML, kindVarList);
strcat(kindML, "\n");
strcat(kindML, numKindsML);
strcat(kindML, "\n\n");
strcat(kindML, buildTabFunc);
strcat(kindML, "\n");
strcat(kindML, isKindFuncDefs);
free(buildPervKindBody); free(buildTabFunc); free(kindVarList);
free(isKindFuncDefs); free(numKindsML);
length = strlen(kindVarDecs) + strlen(isKindFuncDecs) +
strlen(numKindsMLI) + 4;
kindMLI = UTIL_mallocStr(length);
strcpy(kindMLI, kindVarDecs);
strcat(kindMLI, "\n\n");
strcat(kindMLI, numKindsMLI);
strcat(kindMLI, "\n\n");
strcat(kindMLI, isKindFuncDecs);
free(kindVarDecs); free(isKindFuncDecs); free(numKindsMLI);
}
/**************************************************************************/
/* generating pervasive type skeleton relevant part */
/**************************************************************************/
static char* tySkelVarList = NULL; //type skel vars
void ocamlGenTySkel(char* ind, Type tySkel)
{
char* varName = OC_mkTySkelVarName(ind);
char* tySkelText = OC_genTySkel(tySkel);
char* tySkelVarDef = OC_mkTYSkelVar(varName, tySkelText);
size_t length = (tySkelVarList ? strlen(tySkelVarList) : 0) +
strlen(tySkelVarDef) + 1;
char* mytySkelVarList = UTIL_mallocStr(length + 1);
free(varName); free(tySkelText);
mytySkelVarList = addLine(tySkelVarList, tySkelVarDef);
free(tySkelVarList); free(tySkelVarDef);
tySkelVarList = mytySkelVarList;
}
/**************************************************************************/
/* generating pervasive constants relevant part */
/**************************************************************************/
static char* numConstsML = NULL;
static char* numConstsMLI = NULL;
void ocamlGenNumConsts(char* number)
{
numConstsMLI = strdup("val numberPervasiveConstants : int");
numConstsML = addStr("let numberPervasiveConstants = ", number);
}
static char* constVarList = NULL; //constant vars
static char* buildPervConstBody = NULL; //buildPervConst function defs
static char* constVarDecs = NULL; //constant vars in signature
static char* isConstFuncDecs = NULL; //is constant function decs
static char* isConstFuncDefs = NULL; //is constant function defs
void ocamlGenConst(char* ind, char* name, char* cVarName, OP_Fixity fixity,
OP_Prec prec, UTIL_Bool tyPrev, UTIL_Bool redef, int tesize,
int tyskelInd, int neededness, OP_Code codeInfo,
char* offset, char *printName)
{
char* constVarName = OC_mkCVarName(cVarName);
char* funcName = OC_mkIsConstFuncName(constVarName);
char* tyskelText = UTIL_itoa(tyskelInd);
char* tyskelName = OC_mkTySkelVarName(tyskelText);
char* constVar = OC_mkConstVar(name, fixity, prec, tyPrev, tyskelName,
tesize, neededness, codeInfo, redef,
constVarName, offset, printName);
char* constTabEntry = OC_mkTabEntry(name, constVarName);
char* constVarDec = OC_mkConstVarDec(constVarName);
char* funcDec = OC_mkIsConstFuncDec(funcName);
char* funcDef = OC_mkIsConstFuncDef(funcName, constVarName);
char *myConstVarList, *myBuildPervConstBody, *myConstVarDecs,
*myisConstFuncDecs, *myisConstFuncDefs;
free(constVarName); free(funcName); free(tyskelName); free(tyskelText);
myConstVarList = addLine(constVarList, constVar);
free(constVarList); free(constVar);
constVarList = myConstVarList;
myBuildPervConstBody = addStr(buildPervConstBody, constTabEntry);
free(buildPervConstBody); free(constTabEntry);
buildPervConstBody = myBuildPervConstBody;
myConstVarDecs = addStr(constVarDecs, constVarDec);
free(constVarDecs); free(constVarDec);
constVarDecs = myConstVarDecs;
myisConstFuncDecs = addStr(isConstFuncDecs, funcDec);
free(isConstFuncDecs); free(funcDec);
isConstFuncDecs = myisConstFuncDecs;
myisConstFuncDefs = addLine(isConstFuncDefs, funcDef);
free(isConstFuncDefs); free(funcDef);
isConstFuncDefs = myisConstFuncDefs;
}
static char* constMLI = NULL; //const relevant code in pervasive.mli
static char* constML = NULL; //const relevant code in pervasive.ml
void ocamlGenConsts()
{
char* tyskels = OC_mkFixedTySkels(tySkelVarList);
char* varDefs = OC_mkGenericConstVar(constVarList);
char* varDecs = OC_mkGenericConstVarDec(constVarDecs);
char* buildFuncBody = OC_mkGenericConstTabEntry(buildPervConstBody);
char* buildTabFunc = OC_mkBuildCTabFunc(buildFuncBody);
char* funcDefs = OC_mkGenericConstFuncDefs(isConstFuncDefs);
char* funcDecs = OC_mkGenericConstFuncDecs(isConstFuncDecs);
size_t length = strlen(varDefs) + strlen(buildTabFunc) + strlen(funcDefs)
+ strlen(numConstsML) + 4;
tySkelVarList = tyskels;
constML = UTIL_mallocStr(length);
strcpy(constML, varDefs); free(varDefs);
strcat(constML, "\n");
strcat(constML, numConstsML); free(numConstsML);
strcat(constML, "\n\n");
strcat(constML, buildTabFunc); free(buildTabFunc); free(buildFuncBody);
strcat(constML, "\n");
strcat(constML, funcDefs); free(funcDefs);
length = strlen(varDecs) + strlen(funcDecs) + strlen(numConstsMLI) + 4;
constMLI = UTIL_mallocStr(length);
strcpy(constMLI, varDecs); free(varDecs);
strcat(constMLI, "\n\n");
strcat(constMLI, numConstsMLI); free(numConstsMLI);
strcat(constMLI, "\n\n");
strcat(constMLI, funcDecs); free(funcDecs);
}
static char* constProperty = NULL;
void ocamlCollectConsts(char* name, int last)
{
char* constName = OC_mkCVarName(name);
char* cond = OC_mkCompare(constName);
char* body;
free(constName);
if (last) body = cond;
else {
if (constProperty) {
body = OC_mkOr(cond, constProperty);
free(constProperty);
free(cond);
} else body = cond;
}
constProperty = body;
}
static char* regClob = NULL;
void ocamlGenRC()
{
regClob = OC_mkRegClobFunc(constProperty);
free(constProperty);
constProperty = NULL;
}
static char* backTrack = NULL;
void ocamlGenBC()
{
backTrack = OC_mkBackTrackFunc(constProperty);
free(constProperty);
constProperty = NULL;
}
/**************************************************************************/
/* generating fixed part of pervasive.ml and pervasive.mli */
/**************************************************************************/
static char* fixedML = NULL; //fixed part of pervasive.ml
static char* fixedMLI = NULL; //fixed part of pervasive.mli
static void ocamlGenFixedML()
{
fixedML = OC_mkFixedML();
}
static void ocamlGenFixedMLI()
{
fixedMLI = OC_mkFixedMLI();
}
/***************************************************************************/
/* Dump code into pervasive.ml and pervasive.mli */
/***************************************************************************/
/* dump peravsive.ml */
void spitOCPervasiveML(char * root)
{
FILE* outFile;
char * filename = malloc(strlen(root) + 32);
strcpy(filename, root);
strcat(filename, "compiler/pervasive.ml");
outFile = UTIL_fopenW(filename);
ocamlGenFixedML();
fprintf(outFile, "%s\n\n", kindML); free(kindML);
fprintf(outFile, "%s\n\n", tySkelVarList); free(tySkelVarList);
fprintf(outFile, "%s\n\n", constML); free(constML);
fprintf(outFile, "%s\n\n", fixedML); free(fixedML);
fprintf(outFile, "%s\n\n", regClob); free(regClob);
fprintf(outFile, "%s\n\n", backTrack); free(backTrack);
UTIL_fclose(outFile);
free(filename);
}
/* dump peravsive.mli */
void spitOCPervasiveMLI(char * root)
{
FILE* outFile;
char * filename = malloc(strlen(root) + 32);
strcpy(filename, root);
strcat(filename, "compiler/pervasive.mli");
outFile = UTIL_fopenW(filename);
ocamlGenFixedMLI();
fprintf(outFile, "%s\n\n", kindMLI); free(kindMLI);
fprintf(outFile, "%s\n\n", constMLI); free(constMLI);
fprintf(outFile, "%s\n\n", fixedMLI); free(fixedMLI);
UTIL_fclose(outFile);
free(filename);
}

60
src/runtime/c/teyjus/tables_gen/pervasives/pervgen-ocaml.h
View File

@@ -1,60 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/*****************************************************************************/
/* File pervgen-ocaml.c. This files contains function definitions for */
/* generating files pervasive.mli and pervasive.ml. */
/*****************************************************************************/
#include "op.h"
#include "types.h"
#include "../util/util.h"
/**************************************************************************/
/* generating pervasive kind relevant part */
/**************************************************************************/
void ocamlGenNumKinds(char* number);
void ocamlGenKind(char* kindName, char* kVarName, char* arity, char* offset);
void ocamlGenKinds();
/**************************************************************************/
/* generating pervasive type skeleton relevant part */
/**************************************************************************/
void ocamlGenTySkel(char* ind, Type tySkel);
/**************************************************************************/
/* generating pervasive constants relevant part */
/**************************************************************************/
void ocamlGenNumConsts(char* number);
void ocamlGenConst(char* ind, char* name, char* cVarName, OP_Fixity fixity,
OP_Prec prec, UTIL_Bool tyPrev, UTIL_Bool redef, int tesize,
int tyskelInd, int neededness, OP_Code codeInfo,
char* offset, char* printName);
void ocamlGenConsts();
void ocamlCollectConsts(char* name, int last);
void ocamlGenRC();
void ocamlGenBC();
/***************************************************************************/
/* Dump code into pervasive.ml and pervasive.mli */
/***************************************************************************/
/* dump peravsive.ml */
void spitOCPervasiveML(char * root);
/* dump peravsive.mli */
void spitOCPervasiveMLI(char * root);

114
src/runtime/c/teyjus/tables_gen/pervasives/types.c
View File

@@ -1,114 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* File types.c. This file contains "abstract syntax" representation of */
/* type skeletons that is used for parsing those in pervasives.in. */
/****************************************************************************/
#include <stdlib.h>
#include "types.h"
#include "../util/util.h"
Type mkSortType(char* name)
{
Type rtPtr = (Type)UTIL_malloc(sizeof(Type_));
rtPtr -> tag = SORT;
rtPtr -> data.sort = name;
return rtPtr;
}
Type mkSkVarType(char* index)
{
Type rtPtr = (Type)UTIL_malloc(sizeof(Type_));
rtPtr -> tag = SKVAR;
rtPtr -> data.skvar = index;
return rtPtr;
}
Type mkStrFuncType(char* name, char* arity)
{
Type rtPtr = (Type)UTIL_malloc(sizeof(Type_));
rtPtr -> tag = FUNC;
rtPtr -> data.func.name = name;
rtPtr -> data.func.arity = arity;
return rtPtr;
}
Type mkStrType(Type func, int arity, TypeList args)
{
Type rtPtr = (Type)UTIL_malloc(sizeof(Type_));
rtPtr -> tag = STR;
rtPtr -> data.str.functor = func;
rtPtr -> data.str.arity = arity;
rtPtr -> data.str.args = args;
return rtPtr;
}
Type mkArrowType(Type lop, Type rop)
{
Type rtPtr = (Type)UTIL_malloc(sizeof(Type_));
rtPtr -> tag = ARROW;
rtPtr -> data.arrow.lop = lop;
rtPtr -> data.arrow.rop = rop;
return rtPtr;
}
void freeType(Type ty)
{
if (ty -> tag == SORT) free(ty->data.sort);
else if (ty -> tag == SKVAR) free(ty->data.skvar);
else if (ty -> tag == FUNC) {
free(ty->data.func.name);
free(ty->data.func.arity);
}
free(ty);
}
TypeList addItem(Type data, TypeList typeList)
{
TypeList new = (TypeList)UTIL_malloc(sizeof(TypeList_));
new -> oneType = data;
if (typeList) new -> next = typeList;
else new -> next = NULL;
typeList = new;
return typeList;
}
TypeList addItemToEnd(TypeList typeList, Type data)
{
TypeList new = (TypeList)UTIL_malloc(sizeof(TypeList_));
new -> oneType = data;
new -> next = NULL;
if (typeList) {
TypeList temp = typeList;
while (temp -> next) temp = temp -> next;
temp -> next = new;
} else typeList = new;
return typeList;
}
TypeList append(TypeList typeList1, TypeList typeList2)
{
if (typeList1) {
TypeList temp = typeList1;
while (temp -> next) temp = temp -> next;
temp -> next = typeList2;
} else typeList1 = typeList2;
return typeList1;
}

92
src/runtime/c/teyjus/tables_gen/pervasives/types.h
View File

@@ -1,92 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/****************************************************************************/
/* File types.h. This file contains "abstract syntax" representation of */
/* type skeletons that is used for parsing those in pervasives.in. */
/****************************************************************************/
#ifndef TYPES_H
#define TYPES_H
typedef struct Type_ *Type;
typedef struct TypeList_ *TypeList;
//type arrow information
typedef struct ArrowInfo
{
Type lop;
Type rop;
} ArrowInfo;
//structure functor information
typedef struct FuncInfo
{
char *name;
char *arity;
} FuncInfo;
//type structure information
typedef struct StrInfo
{
Type functor;
int arity;
TypeList args;
} StrInfo;
//type skeleton category
typedef enum {
SORT, SKVAR, ARROW, STR, FUNC
} TypeCats;
//type representation
typedef struct Type_
{
TypeCats tag;
union
{
char* sort;
char* skvar;
FuncInfo func;
ArrowInfo arrow;
StrInfo str;
} data;
} Type_;
//type list representation
typedef struct TypeList_
{
Type oneType;
TypeList next;
} TypeList_;
Type mkSortType(char* name);
Type mkSkVarType(char* index);
Type mkStrFuncType(char* name, char* arity);
Type mkStrType(Type name, int arity, TypeList args);
Type mkArrowType(Type lop, Type rop);
void freeType(Type ty);
TypeList addItem(Type data, TypeList typeList);
TypeList addItemToEnd(TypeList typeList, Type data);
TypeList append(TypeList typeList1, TypeList typeList2);
#endif //TYPES_H

135
src/runtime/c/teyjus/tables_gen/util/util.c
View File

@@ -1,135 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "util.h"
/**************************************************************************/
/* Space allocation */
/**************************************************************************/
/* allocate space of n bytes*/
void* UTIL_malloc(size_t n)
{
void* ptr = (void*)malloc(n);
if (ptr) return ptr;
printf("Error : cannot allocate space\n");
exit(1);
}
/* allocate space for a string of given size */
char* UTIL_mallocStr(size_t size)
{
char* ptr = (char*)malloc(sizeof(char)*(size + 1));
if (ptr) return ptr;
printf("Error : cannot allocate space\n");
exit(1);
}
/**************************************************************************/
/* string operation */
/**************************************************************************/
/* Append two strings */
char* UTIL_appendStr(char* str1, char* str2)
{
size_t length = strlen(str1) + strlen(str2);
char* ptr = UTIL_mallocStr(length + 1);
strcpy(ptr, str1);
strcat(ptr, str2);
return ptr;
}
//convert lower case letters in a string to upper case ones
char* UTIL_upperCase(char* str)
{
char *newstr, *tmp;
newstr = strdup(str);
tmp = newstr;
while ((*tmp) != '\0'){
if ((97 <= (int)*tmp) && ((int)*tmp <= 122))
*tmp = (char)((int)*tmp - 32);
tmp++;
}
return newstr;
}
//convert to lower cases
char* UTIL_lowerCase(char* str)
{
char *newstr, *tmp;
newstr = strdup(str);
tmp = newstr;
while ((*tmp) != '\0'){
if ((65 <= (int)*tmp) && ((int)*tmp) <= 90)
*tmp = (char)((int)*tmp + 32);
tmp++;
}
return newstr;
}
//covert an non-negtive integer to string
char* UTIL_itoa(int num)
{
char *str = UTIL_mallocStr(33);
sprintf(str, "%d", num);
return str;
}
/**************************************************************************/
/* file operation */
/**************************************************************************/
/* open file in read mode */
FILE* UTIL_fopenR(char* filename)
{
FILE* filePtr = fopen(filename, "r");
if (filePtr) return filePtr;
printf("Error : cannot open input file %s\n", filename);
exit(1);
}
/* open file in write mode */
FILE* UTIL_fopenW(char* filename)
{
FILE* filePtr = fopen(filename, "w");
if (filePtr) return filePtr;
printf("Error : cannot open output file %s\n", filename);
exit(1);
}
/* close file */
void UTIL_fclose(FILE* file)
{
fclose(file);
}

71
src/runtime/c/teyjus/tables_gen/util/util.h
View File

@@ -1,71 +0,0 @@
//////////////////////////////////////////////////////////////////////////////
//Copyright 2008
// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
//////////////////////////////////////////////////////////////////////////////
// This file is part of Teyjus. //
// //
// Teyjus is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// Teyjus is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
//////////////////////////////////////////////////////////////////////////////
/**************************************************************************/
/* util.h{c}. */
/* Auxiliary functions needed for generating source files. */
/**************************************************************************/
#ifndef UTIL_H
#define UTIL_H
#include <stdio.h>
/**************************************************************************/
/* Space allocation */
/**************************************************************************/
/* allocate space */
void* UTIL_malloc(size_t size);
/* allocate space for a string of given size */
char* UTIL_mallocStr(size_t size);
/**************************************************************************/
/* string operation */
/**************************************************************************/
/* append two strings */
char* UTIL_appendStr(char* str1, char* str2);
/* capitalizing */
char* UTIL_upperCase(char* str);
/* to lower cases */
char* UTIL_lowerCase(char* str);
/* covert a non-negative integer to string */
char* UTIL_itoa(int num);
/**************************************************************************/
/* file operation */
/**************************************************************************/
/* open file in read mode */
FILE* UTIL_fopenR(char* filename);
/* open file in write mode */
FILE* UTIL_fopenW(char* filename);
/* close file */
void UTIL_fclose(FILE* file);
/* bool type */
typedef enum {
UTIL_FALSE, UTIL_TRUE
} UTIL_Bool;
#endif