pax_global_header 0000666 0000000 0000000 00000000064 14126326331 0014513 g ustar 00root root 0000000 0000000 52 comment=13efebef12254fd39110b6f9dd80a7b5b0a579c2
mescc-tools-Release_1.3/ 0000775 0000000 0000000 00000000000 14126326331 0015246 5 ustar 00root root 0000000 0000000 mescc-tools-Release_1.3/.gitignore 0000664 0000000 0000000 00000002212 14126326331 0017233 0 ustar 00root root 0000000 0000000 ## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see
Added catm NASM prototype to simplify build
Added catm M1 prototype to reduce bootstrap dependency
Added catm hex0 prototype to eliminate bootstrap dependencies down to hex0
Added M0 NASM prototype to simplify build
Added M0 M1 prototype to reduce bootstrap dependency
Added M0 hex2 prototype to eliminate bootstrap dependencies down to hex2
Verified ARM port to support M2-Planet
** Changed
Updated build.sh and kaem.run to the current mescc-tools syntax
Reduced get_machine's build dependencies
Cleaned up x86 elf headers
Removed kaem's dependence on getopt
Replaced --Architecture with --architecture
changed get_machine's default output to filter machine names into known families
Reduced M1 null padding of strings to a single null for all architectures except Knight
Updated AMD64 bootstrap kaem.run to include steps from hex0 to M0
** Fixed
Fixed broken test9 thanks to janneke
Fixed wrong displacement calculations for ARM immediates
Fixed typo in license header
Fixed kaem.run to actually function and produce identical results
Fixed regression caused by linux 4.17
Removed false newline added in numerate_number for zero case
Fixed broken bootstrap script
** Removed
Removed final dependency on getopt
Removed need to know architecture numbers as that was a bad idea
* 0.5 - 2018-06-15
** Added
Added INSTALL notes
Added HACKING notes
Added examples of minimal Hex1, Hex2 and M1-macro programs that may need to be
written to bootstrap a particular architecture.
Added useful functions to reduce bootstrap dependencies
Added support for binary output in M1-macro
** Changed
Changed Knight architecture offset calculation to match new standard
Updated test3 lisp.s to include more functionality
Updated test3 definitions file to reflect changes in Knight instruction encoding
enhanced README to be more useful
Pulled numerate_string functionality out of hex2 and M1 into a shared library
Eliminated getopt from M1-Macro, hex2-linker and blood-elf; use --Architecture 1 instead of --Architecture=1
** Fixed
Corrected M1-macro incorrectly expressing negative numbers
Updated test3 checksum to reflect new version of lisp.s
fixed check.sh to actually perform all checks.
Fixed build.sh to function in a self-hosting fashion
** Removed
Removed blood-elf's dependency on getopt
Removed C preprocessor macro from blood-elf needed for mescc support
Removed hex2's dependency on getopt
Removed C preprocessor macro from hex2 needed for mescc support
Removed need for octal support in the building of hex2
Removed M1's dependency on getopt
Removed C preprocessor macro from M1 needed for mescc support
Removed need for sprintf from M1
* 0.4 - 2018-02-24
** Added
Added file checks to reduce the number of error messageless faults
Added a current generation M1.M1 file as a test for mescc-tools
Added prototype kaem build script
M1-macro now catches undefined macros to allow easier troubleshooting
Added kaem build tool
Added ability to track build progress in kaem
Added support for line escapes in kaem
Added support for --strict in kaem to halt in the event of errors
Added selectable script file support in kaem
Added support for PATH search to kaem with fallbacks in the event of NULL environments
** Changed
flipped blood-elf from ignoring :: to :_
converted test8 into a full test
Added bash style line comments to kaem
Added support for raw strings to kaem
Stopped showing comment lines in kaem --verbose
Removed dependence on getenv to have more control over environmental lookup
** Fixed
Fixed stack overflow bug caused by too deeply nested recursion by transforming into iteration
Fixed default repo to point to current repo
Added missing license header to kaem.c
Fixed infinite looping in kaem scripts that hit an error that resets the file descriptor
** Removed
Removed need for strtol
Removed need for a global variable in M1-Macro
Removed legacy functions from kaem
* 0.3 - 2017-12-01
** Added
Incorporated a hex0 test which implements hex1 functionality
Added --output and --exec_enable options to hex2
Added --output option to M1
Wrote Hex1 in Hex0 for AMD64/ELF
Added the ability to specify an output file
Added exec_enable to allow the arbitrary setting of executable bits
Added get_machine to enable better scripting
Incorporated janneke's build scripts
Added a test to test for unusual nybble and byte order/formatting issues
Added blood-elf to generate elf footer capable of being used by objdump
** Changed
Renamed MESCC_Tools to mescc-tools to harmonize with guix package name
Now all tests will be architecture specific
Modified sprintf to behave correctly for negative numbers
Converted blood-elf to read M1-macro input and output M1-macro output
replaced uint with unsigned to better match the standard
Harmonized MAXSTRING to 4096bytess
** Fixed
Incorporated janneke's patchs to fix mescc compatibility
Fixed test on ARM platforms
Fixed range check to behave correctly with unsigned ints
** Removed
Removed the need to redirect hex2 output into a file
Removed the need for chmod u+x in development paths
Removed the need to redirect M1 output into a file
Removed the need for chmod entirely from bootstrap path
Removed dependency on shell supporting redirects
Removed need for stdint and stdbool
Removed need for enum support
Removed need for strtol in M1-macro
* 0.2 - 2017-07-25
** Added
created test2 (a 32bit x86 hex assembler) with its associated build and test changes
Fixed proof answers for test1 and test2
Added support to M0 for multiple architectures
Added range checking into M0 to make sure immediates will fit into specified space
Added a basic tutorial for generating new M0 definitions
Created a M1 compatible version of test0
Added an amd64 program for enabling execute bits (might need to later alter the 0777)
Added an i386 program for enabling execute bits (might need to later alter the 0777)
Added rain1's improvements to gcc flags
Added rain1's stack reduction recommendations
Incorporated an AMD64/elf hex1 example program as a test
Incorporated Test7 into make test and make clean flows
** Changed
Adjusted tags to reflect current CHANGELOG
Make test now depends upon test2 completing
Changed how M0 processes input to reduce stack usage and improve performance
Renamed M0 to M1 to reflect the additional functionality it provides
Applied Janneke's patch for accepting hex numerics in M1
Refactored x86/amd64 elf headers to a standard to avoid duplication
Standardized C flags for compiling M1 and Hex2
Made eval_immediates iterative instead of recursive
Made identify_macros iterative instead of recursive
Made process_string iterative instead of recursive
Made preserve_other iterative instead of recursive
Made print_hex iterative instead of recursive
Incremented version numbers for hex2 and M1
Updated guix.scm to match the new version and finish the release
Converted guix.scm definition for mescc_tools to use uri method instead of git
** Fixed
Removed unrequired temp file in test1
Clarified meaning of Label>base displacement conditional
Corrected error in test0 elf32
Test1 and Test2 to reflect the fact that /bin/bash doesn't exist in guix
Fixed M0 regression to continue to support original test code
Corrected makefile and build scripts to reflect rename
Modified test make scripts to reflect new standard elf headers
Fixed base address needed by test5 and its associated checksum
Harmonized flags for displaying version with standard
** Removed
Removed bashisms from Test1 and Test2 to allow proper behavior on debian based systems
Removed alerting on missing files in cleanup target
Removed massive M0 Definition lists as they don't serve a useful purpose
* 0.1 - 2017-06-25
** Added
Incorporated support for little Endian output format in hex2
Incorporated support for multiple input files in hex2
Added range checking for Hex2
Added support for 1 and 4 byte relative displacements
Added Hex2 Test
Added the ability to specify a new base address
Added example M0 x86 opcode definitions
Incorporated support for multiple input files in M0
Added support for little Endian immediate output in M0
Added Hex assembler example test
Added support for Label>base in Hex2
Added Version info
Added install target
Added inital guix package definition
** Changed
Displacement calculations are now based on architecture specific rules
M0 Immediates now need prefixes to specify the storage space to use for the immediate
** Fixed
Behavior regarding !label displacements
** Removed
* 0.0 - 2017-05-10
Initial release of MESCC Tools from stage0 High Level prototypes
mescc-tools-Release_1.3/COPYING 0000664 0000000 0000000 00000104513 14126326331 0016305 0 ustar 00root root 0000000 0000000 GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Copyright (C)
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 Copyright (C)
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
.
mescc-tools-Release_1.3/Generating_M0_Definitions.org 0000664 0000000 0000000 00000025526 14126326331 0022743 0 ustar 00root root 0000000 0000000 * License
## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see :
8048074: 30 31 xor %dh,(%ecx)
8048076: 32 33 xor (%ebx),%dh
8048078: 34 35 xor $0x35,%al
804807a: 36 37 ss aaa
804807c: 38 39 cmp %bh,(%ecx)
804807e: 41 inc %ecx
804807f: 42 inc %edx
8048080: 43 inc %ebx
8048081: 44 inc %esp
8048082: 45 inc %ebp
8048083: 46 inc %esi
8048084: 0a .byte 0xa
08048085 :
8048085: ba 01 00 00 00 mov $0x1,%edx
804808a: 89 c1 mov %eax,%ecx
804808c: bb 01 00 00 00 mov $0x1,%ebx
8048091: b8 04 00 00 00 mov $0x4,%eax
8048096: cd 80 int $0x80
8048098: c3 ret
08048099 :
8048099: ba 01 00 00 00 mov $0x1,%edx
804809e: b9 f3 90 04 08 mov $0x80490f3,%ecx
80480a3: bb 00 00 00 00 mov $0x0,%ebx
80480a8: b8 03 00 00 00 mov $0x3,%eax
80480ad: cd 80 int $0x80
80480af: 85 c0 test %eax,%eax
80480b1: 74 34 je 80480e7
80480b3: a0 f3 90 04 08 mov 0x80490f3,%al
80480b8: 0f b6 c0 movzbl %al,%eax
80480bb: c3 ret
080480bc <_start>:
80480bc: e8 d8 ff ff ff call 8048099
80480c1: 89 c6 mov %eax,%esi
80480c3: 89 c5 mov %eax,%ebp
80480c5: c1 ee 04 shr $0x4,%esi
80480c8: 83 e5 0f and $0xf,%ebp
80480cb: 81 c6 74 80 04 08 add $0x8048074,%esi
80480d1: 81 c5 74 80 04 08 add $0x8048074,%ebp
80480d7: 89 f0 mov %esi,%eax
80480d9: e8 a7 ff ff ff call 8048085
80480de: 89 e8 mov %ebp,%eax
80480e0: e8 a0 ff ff ff call 8048085
80480e5: eb d5 jmp 80480bc <_start>
080480e7 :
80480e7: bb 00 00 00 00 mov $0x0,%ebx
80480ec: b8 01 00 00 00 mov $0x1,%eax
80480f1: cd 80 int $0x80
** making sense of the objdump information
*** Labels
When you see 08048074 :
It indicates that at address 0x08048074 the definition of the function output resides.
*** 1OP Instructions
When you see 8048098: c3 ret
It indicates that at address 0x8048098 there is a Return instruction which as the Hex opcode encoding of C3 and could be implemented in M1 as:
DEFINE RETURN C3
Or any other mnemonic term that is more optimal for the problem at hand.
*** 2OP Instructions
When you see 80480c1: 89 c6 mov %eax,%esi
It indicate that at address 0x80480C1 there is a Move instruction that copies the value of register eax to register esi and has the Hex opcode encoding of 89C6 and therefor can be defined in M1 as:
DEFINE COPY_EAX_To_ESI 89C6
or
If we assume (eax=>R0, ebx=>R1, ecx=>R2, edx=>R3, esi=>R4, edi=>R5, ebp=>R6, and esp=>R7)
DEFINE COPY_R0_To_R4 89C6
*** Instructions with Immediates or displacements
Immediates occur in variable sizes but an immediate can not exist without an instruction
**** Trivial example
Most immediates are common values such as 1 (01) or -1 (FF..FF) that are immediately obvious:
80480a8: b8 03 00 00 00 mov $0x3,%eax
8048091: b8 04 00 00 00 mov $0x4,%eax
80480ec: b8 01 00 00 00 mov $0x1,%eax
Espcially when there is a very familiar pattern and leading (or in x86's case trailing zeros)
It should be immediately obvious that B8 is the opcode for loading a 32bit immediate value into eax, which can be written in M1 as:
DEFINE MOV_Immediate32_EAX B8
or
DEFINE LOADI32_R0 B8
You only need to remember to follow that mnemonic with a 32bit immediate (%4 works)
**** Easy example
For some immediate instructions the size and placement of the immediate is obvious (or perhaps obvious once you realize the Endianness of the instruction set you are working with)
For example:
80480b3: a0 f3 90 04 08 mov 0x80490f3,%al
Knowing that x86 is little endian, the 08 should pop out at you.
f3 90 04 08 is the little endian encoding of the number 0x080490F3
and thus we know that the opcode is A0 and it requires a 32bit value (An absolute address) and that it writes that result to al (which is the bottom 8bits of the eax register)
Thus we can express this opcode as:
DEFINE MOV_Absolute32_al A0
or
LOAD8_R0_Absolute32 A0
Which then always has to be followed by a 32bit absolute address ($foo works)
**** Annoying example
For some instructions, you may have to lookup the opcode to determine its length and thus the length of its immediate such as:
80480b1: 74 34 je 80480e7
Which when confronted with such a case, simply lookup the 74 in http://ref.x86asm.net/coder32.html
thus resolving to it is both jz and je and it takes a 8bit relative address (the 34).
Thus we can define our newly determined opcode in M1 as:
DEFINE JE8 74
DEFINE JZ8 74
or
DEFINE Jump_if_Zero8 74
but we need to make sure that whenever we use our mnemonic we follow it with a 8bit relative value (!label works well)
*** Things objdump gets wrong
The thing all disassemblers tend to get wrong and dependes entirely on heuristics is the identification of strings and byte constants.
In our case, it has identified our table as a set of instructions (also correctly determined their representation)
08048074 :
8048074: 30 31 xor %dh,(%ecx)
8048076: 32 33 xor (%ebx),%dh
8048078: 34 35 xor $0x35,%al
804807a: 36 37 ss aaa
804807c: 38 39 cmp %bh,(%ecx)
804807e: 41 inc %ecx
804807f: 42 inc %edx
8048080: 43 inc %ebx
8048081: 44 inc %esp
8048082: 45 inc %ebp
8048083: 46 inc %esi
8048084: 0a .byte 0xa
In M1 we have the ability to do things like strings to store such a table.
Which would probably be the following:
:output
"0123456789ABCDEF"
Which certainly alot easier to read and understand than
output: .byte 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x0A
* Using that opcode information to write a M1 program
Thus we would come to a defintion list that looks something like this:
DEFINE MOVZBL_al_To_eax 0FB6C0
DEFINE JE8 74
DEFINE ADD_Immediate32_To_ebp 81C5
DEFINE ADD_Immediate32_To_esi 81C6
DEFINE ANDI8_ebp 83E5
DEFINE TEST_eax_eax 85C0
DEFINE MOV_eax_To_ecx 89C1
DEFINE MOV_eax_To_ebp 89C5
DEFINE MOV_eax_To_esi 89C6
DEFINE MOV_ebp_To_eax 89E8
DEFINE MOV_esi_To_eax 89F0
DEFINE LOAD8_al A0
DEFINE LOADI32_eax B8
DEFINE LOADI32_ecx B9
DEFINE LOADI32_edx BA
DEFINE LOADI32_ebx BB
DEFINE SHIFT_RIGHT_Immediate8_esi C1EE
DEFINE RETURN C3
DEFINE INT_80 CD80
DEFINE CALLI32 E8
DEFINE JUMP8 EB
** emacs tips
Using the objdump output, first clear the labels and not instruction data.
Then leverage C-x ( and C-x ) to define a keyboard macro that deletes the address from the start of the line. C-x e followed by e repeatedly to clear all of the lines.
M-x sort-lines, will sort all selected lines (very useful as now all instructions with the same opcode are next to each other for easy pruning)
M-x delete-duplicate-lines will purge all exact duplicates (very handy for compiler output)
Then all that remains is determining the immediates and figuring out what line actually does. This is left as an exercise for the reader.
mescc-tools-Release_1.3/HACKING 0000664 0000000 0000000 00000005310 14126326331 0016234 0 ustar 00root root 0000000 0000000 -*-mode:org-*-
## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see
#include
#include
#include
#include
#include "kaem.h"
/* Prototypes from other files */
void handle_variables(char** argv, struct Token* n);
/*
* UTILITY FUNCTIONS
*/
/* Function to find a character in a string */
char* find_char(char* string, char a)
{
if(0 == string[0]) return NULL;
while(a != string[0])
{
string = string + 1;
if(0 == string[0]) return string;
}
return string;
}
/* Function to find the length of a char**; an array of strings */
int array_length(char** array)
{
int length = 0;
while(array[length] != NULL)
{
length = length + 1;
}
return length;
}
/* Search for a variable in the env linked-list */
char* env_lookup(char* variable)
{
/* Start at the head */
struct Token* n = env;
/* Loop over the linked-list */
while(n != NULL)
{
if(match(variable, n->var))
{ /* We have found the correct node */
return n->value; /* Done */
}
/* Nope, try the next */
n = n->next;
}
/* We didn't find anything! */
return NULL;
}
/* Find the full path to an executable */
char* find_executable(char* name)
{
if(match("", name)) return NULL;
if(('.' == name[0]) || ('/' == name[0]))
{ /* assume names that start with . or / are relative or absolute */
return name;
}
char* trial = calloc(MAX_STRING, sizeof(char));
char* MPATH = calloc(MAX_STRING, sizeof(char)); /* Modified PATH */
require(MPATH != NULL, "Memory initialization of MPATH in find_executable failed\n");
strcpy(MPATH, PATH);
FILE* t;
char* next = find_char(MPATH, ':');
int index;
int offset;
int mpath_length;
int name_length;
int trial_length;
while(NULL != next)
{
/* Reset trial */
trial_length = strlen(trial);
for(index = 0; index < trial_length; index = index + 1)
{
trial[index] = 0;
}
next[0] = 0;
/* prepend_string(MPATH, prepend_string("/", name)) */
mpath_length = strlen(MPATH);
for(index = 0; index < mpath_length; index = index + 1)
{
require(MAX_STRING > index, "Element of PATH is too long\n");
trial[index] = MPATH[index];
}
trial[index] = '/';
offset = strlen(trial);
name_length = strlen(name);
for(index = 0; index < name_length; index = index + 1)
{
require(MAX_STRING > index, "Element of PATH is too long\n");
trial[index + offset] = name[index];
}
/* Try the trial */
require(strlen(trial) < MAX_STRING, "COMMAND TOO LONG!\nABORTING HARD\n");
t = fopen(trial, "r");
if(NULL != t)
{
fclose(t);
return trial;
}
MPATH = next + 1;
next = find_char(MPATH, ':');
}
return NULL;
}
/* Function to convert a Token linked-list into an array of strings */
char** list_to_array(struct Token* s)
{
char* hold;
struct Token* n;
n = s;
char** array = calloc(MAX_ARRAY, sizeof(char*));
require(array != NULL, "Memory initialization of array in conversion of list to array failed\n");
char* element = calloc(MAX_STRING, sizeof(char));
require(element != NULL, "Memory initialization of element in conversion of list to array failed\n");
int index = 0;
int i;
int value_length;
int var_length;
int offset;
while(n != NULL)
{ /* Loop through each node and assign it to an array index */
array[index] = calloc(MAX_STRING, sizeof(char));
require(array[index] != NULL, "Memory initialization of array[index] in conversion of list to array failed\n");
/* Bounds checking */
/* No easy way to tell which it is, output generic message */
require(index < MAX_ARRAY, "SCRIPT TOO LONG or TOO MANY ENVARS\nABORTING HARD\n");
if(n->var == NULL)
{ /* It is a line */
array[index] = n->value;
}
else
{ /* It is a var */
/* prepend_string(n->var, prepend_string("=", n->value)) */
var_length = strlen(n->var);
for(i = 0; i < var_length; i = i + 1)
{
element[i] = n->var[i];
}
element[i] = '=';
i = i + 1;
offset = i;
value_length = strlen(n->value);
for(i = 0; i < value_length; i = i + 1)
{
element[i + offset] = n->value[i];
}
}
/* Insert elements if not empty */
if(!match("", element)) strcpy(array[index], element);
n = n->next;
index = index + 1;
/* Reset element */
for(i = 0; i < MAX_STRING; i = i + 1) element[i] = 0;
}
return array;
}
/* Function to handle the correct options for escapes */
int handle_escape(int c)
{
if(c == '\n')
{ /* Do nothing - eat up the newline */
return -1;
}
else if('n' == c)
{ /* Add a newline to the token */
return '\n';
}
else if('r' == c)
{ /* Add a return to the token */
return '\r';
}
else if('\\' == c)
{ /* Add a real backslash to the token */
return '\\';
}
else
{ /* Just add it to the token (eg, quotes) */
return c;
}
}
/*
* TOKEN COLLECTION FUNCTIONS
*/
/* Function for skipping over line comments */
void collect_comment(FILE* input)
{
int c;
/* Eat up the comment, one character at a time */
/*
* Sanity check that the comment ends with \n.
* Remove the comment from the FILE*
*/
do
{
c = fgetc(input);
/* We reached an EOF!! */
require(EOF != c, "IMPROPERLY TERMINATED LINE COMMENT!\nABORTING HARD\n");
} while('\n' != c); /* We can now be sure it ended with \n -- and have purged the comment */
}
/* Function for collecting strings and removing the "" pair that goes with them */
int collect_string(FILE* input, char* n, int index)
{
int string_done = FALSE;
int c;
int cc;
do
{
/* Bounds check */
require(MAX_STRING > index, "LINE IS TOO LONG\nABORTING HARD\n");
c = fgetc(input);
require(EOF != c, "IMPROPERLY TERMINATED STRING!\nABORTING HARD\n");
if('\\' == c)
{ /* We are escaping the next character */
/* This correctly handles escaped quotes as it just returns the quote */
c = fgetc(input);
cc = handle_escape(c);
n[index] = c;
index = index + 1;
}
else if('"' == c)
{ /* End of string */
string_done = TRUE;
}
else
{
n[index] = c;
index = index + 1;
}
} while(string_done == FALSE);
return index;
}
/* Function to parse and assign token->value */
int collect_token(FILE* input, char* n, int last_index)
{
int c;
int cc;
int token_done = FALSE;
char* token = calloc(MAX_STRING, sizeof(char));
require(token != NULL, "Memory initialization of token in collect_token failed\n");
int index = 0;
do
{ /* Loop over each character in the token */
c = fgetc(input);
/* Bounds checking */
require(MAX_STRING > index, "LINE IS TOO LONG\nABORTING HARD\n");
if(EOF == c)
{ /* End of file -- this means script complete */
/* We don't actually exit here. This logically makes more sense;
* let the code follow its natural path of execution and exit
* sucessfuly at the end of main().
*/
token_done = TRUE;
command_done = TRUE;
return -1;
}
else if((' ' == c) || ('\t' == c))
{ /* Space and tab are token seperators */
token_done = TRUE;
}
else if('\n' == c)
{ /* Command terminates at end of a line */
command_done = TRUE;
token_done = TRUE;
if(0 == index) index = last_index;
}
else if('"' == c)
{ /* Handle strings -- everything between a pair of "" */
index = collect_string(input, n, index);
token_done = TRUE;
}
else if('#' == c)
{ /* Handle line comments */
collect_comment(input);
command_done = TRUE;
token_done = TRUE;
if(0 == index) index = last_index;
}
else if('\\' == c)
{ /* Support for escapes */
c = fgetc(input); /* Skips over \, gets the next char */
cc = handle_escape(c);
if(-1 != cc)
{ /* We need to put it into the token */
n[index] = cc;
}
index = index + 1;
}
else if(0 == c)
{ /* We have come to the end of the token */
token_done = TRUE;
}
else
{ /* It's a character to assign */
n[index] = c;
index = index + 1;
}
} while (token_done == FALSE);
return index;
}
/*
* EXECUTION FUNCTIONS
* Note: All of the builtins return FALSE (0) when they exit successfully
* and TRUE (1) when they fail.
*/
/* Function to check if the token is an envar */
int is_envar(char* token)
{
int i = 0;
int token_length = strlen(token);
while(i < token_length)
{
if(token[i] == '=')
{
return TRUE;
}
i = i + 1;
}
return FALSE;
}
/* Add an envar */
void add_envar()
{
/* Pointers to strings we want */
char* name = calloc(strlen(token->value) + 4, sizeof(char));
char* value = token->value;
char* newvalue;
int i = 0;
/* Isolate the name */
while('=' != value[i])
{
name[i] = value[i];
i = i + 1;
}
/* Isolate the value */
newvalue = name + i + 2;
value = value + i + 1;
i = 0;
require(0 != value[i], "add_envar recieved improper variable\n");
while(0 != value[i])
{
newvalue[i] = value[i];
i = i + 1;
}
/* If we are in init-mode and this is the first var env == NULL, rectify */
if(env == NULL)
{
env = calloc(1, sizeof(struct Token));
require(env != NULL, "Memory initialization of env failed\n");
env->var = name; /* Add our first variable */
}
/*
* If the name of the envar is PATH, then we need to set our (internal)
* global PATH value.
*/
if(match(name, "PATH"))
{
strcpy(PATH, newvalue);
}
struct Token* n = env;
/* Find match if possible */
while(!match(name, n->var))
{
if(NULL == n->next)
{
n->next = calloc(1, sizeof(struct Token));
require(n->next != NULL, "Memory initialization of next env node in add_envar failed\n");
n->next->var = name;
} /* Loop will match and exit */
n = n->next;
}
/* Since we found the variable we need only to set it to its new value */
n->value = newvalue;
}
/* cd builtin */
int cd()
{
if(NULL == token->next) return TRUE;
token = token->next;
if(NULL == token->value) return TRUE;
int ret = chdir(token->value);
if(0 > ret) return TRUE;
return FALSE;
}
/* pwd builtin */
int pwd()
{
char* path = calloc(MAX_STRING, sizeof(char));
require(path != NULL, "Memory initialization of path in pwd failed\n");
getcwd(path, MAX_STRING);
require(!match("", path), "getcwd() failed\n");
fputs(path, stdout);
fputs("\n", stdout);
return FALSE;
}
/* set builtin */
int set()
{
/* Get the options */
int i;
if(NULL == token->next) goto cleanup_set;
token = token->next;
if(NULL == token->value) goto cleanup_set;
char* options = calloc(MAX_STRING, sizeof(char));
require(options != NULL, "Memory initialization of options in set failed\n");
int last_position = strlen(token->value) - 1;
for(i = 0; i < last_position; i = i + 1)
{
options[i] = token->value[i + 1];
}
/* Parse the options */
int options_length = strlen(options);
for(i = 0; i < options_length; i = i + 1)
{
if(options[i] == 'a')
{ /* set -a is on by default and cannot be disabled at this time */
if(WARNINGS)
{
fputs("set -a is on by default and cannot be disabled\n", stdout);
}
continue;
}
else if(options[i] == 'e')
{ /* Fail on failure */
STRICT = TRUE;
}
else if(options[i] == 'x')
{ /* Show commands as executed */
/* TODO: this currently behaves like -v. Make it do what it should */
VERBOSE = TRUE;
/*
* Output the set -x because VERBOSE didn't catch it before.
* We don't do just -x because we support multiple options in one command,
* eg set -ex.
*/
fputs(" +> set -", stdout);
fputs(options, stdout);
fputs("\n", stdout);
fflush(stdout);
}
else
{ /* Invalid */
fputc(options[i], stderr);
fputs(" is an invalid set option!\n", stderr);
exit(EXIT_FAILURE);
}
}
return FALSE;
cleanup_set:
return TRUE;
}
/* echo builtin */
void echo()
{
if(token->next == NULL)
{ /* No arguments */
fputs("\n", stdout);
return;
}
if(token->next->value == NULL)
{ /* No arguments */
fputs("\n", stdout);
return;
}
token = token->next; /* Skip the actual echo */
while(token != NULL)
{ /* Output each argument to echo to stdout */
/* M2-Planet doesn't let us do this in the while */
if(token->value == NULL) break;
fputs(token->value, stdout);
token = token->next;
}
fputs("\n", stdout);
}
/* unset builtin */
void unset()
{
struct Token* e;
/* We support multiple variables on the same line */
struct Token* t;
t = token->next;
while(t != NULL)
{
e = env;
/* Look for the variable; we operate on ->next because we need to remove ->next */
while(e->next != NULL)
{
if(NULL == t->value) break;
if(match(e->next->var, t->value)) break;
e = e->next;
}
t = t->next;
/* If it's NULL nothing was found */
if(e->next == NULL) continue;
/* Otherwise there is something to unset */
e->next = e->next->next;
}
}
/* Execute program */
int execute()
{ /* Run the command */
/* rc = return code */
int rc;
/* Actually do the execution */
if(is_envar(token->value) == TRUE)
{
add_envar();
return 0;
}
else if(match(token->value, "cd"))
{
rc = cd();
if(STRICT) require(rc == FALSE, "cd failed!\n");
return 0;
}
else if(match(token->value, "set"))
{
rc = set();
if(STRICT) require(rc == FALSE, "set failed!\n");
return 0;
}
else if(match(token->value, "pwd"))
{
rc = pwd();
if(STRICT) require(rc == FALSE, "pwd failed!\n");
return 0;
}
else if(match(token->value, "echo"))
{
echo();
return 0;
}
else if(match(token->value, "unset"))
{
unset();
return 0;
}
/* If it is not a builtin, run it as an executable */
int status; /* i.e. return code */
char** array;
char** envp;
/* Get the full path to the executable */
char* program = find_executable(token->value);
/* Check we can find the executable */
if(NULL == program)
{
if(STRICT == TRUE)
{
fputs("WHILE EXECUTING ", stderr);
fputs(token->value, stderr);
fputs(" NOT FOUND!\nABORTING HARD\n", stderr);
exit(EXIT_FAILURE);
}
/* If we are not strict simply return */
return 0;
}
int f = fork();
/* Ensure fork succeeded */
if (f == -1)
{
fputs("WHILE EXECUTING ", stderr);
fputs(token->value, stderr);
fputs("fork() FAILED\nABORTING HARD\n", stderr);
exit(EXIT_FAILURE);
}
else if (f == 0)
{ /* Child */
/**************************************************************
* Fuzzing produces random stuff; we don't want it running *
* dangerous commands. So we just don't execve. *
* But, we still do the list_to_array calls to check for *
* segfaults. *
**************************************************************/
array = list_to_array(token);
envp = list_to_array(env);
if(FALSE == FUZZING)
{ /* We are not fuzzing */
/* execve() returns only on error */
execve(program, array, envp);
}
/* Prevent infinite loops */
_exit(EXIT_SUCCESS);
}
/* Otherwise we are the parent */
/* And we should wait for it to complete */
waitpid(f, &status, 0);
return status;
}
int collect_command(FILE* script, char** argv)
{
command_done = FALSE;
/* Initialize token */
struct Token* n;
n = calloc(1, sizeof(struct Token));
require(n != NULL, "Memory initialization of token in collect_command failed\n");
char* s = calloc(MAX_STRING, sizeof(char));
require(s != NULL, "Memory initialization of token in collect_command failed\n");
token = n;
int index = 0;
/* Get the tokens */
while(command_done == FALSE)
{
index = collect_token(script, s, index);
/* Don't allocate another node if the current one yielded nothing, OR
* if we are done.
*/
if(match(s, "")) continue;
/* add to token */
n->value = s;
s = calloc(MAX_STRING, sizeof(char));
require(s != NULL, "Memory initialization of next token node in collect_command failed\n");
/* Deal with variables */
handle_variables(argv, n);
/* If the variable expands into nothing*/
if(match(n->value, " "))
{
n->value = NULL;
continue;
}
/* Prepare for next loop */
n->next = calloc(1, sizeof(struct Token));
require(n->next != NULL, "Memory initialization of next token node in collect_command failed\n");
n = n->next;
}
/* -1 means the script is done */
if(EOF == index) return index;
/* Output the command if verbose is set */
/* Also if there is nothing in the command skip over */
if(VERBOSE && !match(token->value, "") && !match(token->value, NULL))
{
n = token;
fputs(" +>", stdout);
while(n != NULL)
{ /* Print out each token token */
fputs(" ", stdout);
/* M2-Planet doesn't let us do this in the while */
if(n->value != NULL)
{
if(!match(n->value, "")) fputs(n->value, stdout);
}
n = n->next;
}
fputc('\n', stdout);
fflush(stdout);
}
return index;
}
/* Function for executing our programs with desired arguments */
void run_script(FILE* script, char** argv)
{
int index;
int status;
while(TRUE)
{
/*
* Tokens has to be reset each time, as we need a new linked-list for
* each line.
* See, the program flows like this as a high level overview:
* Get line -> Sanitize line and perform variable replacement etc ->
* Execute line -> Next.
* We don't need the previous lines once they are done with, so tokens
* are hence for each line.
*/
index = collect_command(script, argv);
/* -1 means the script is done */
if(EOF == index) break;
if(0 == index) continue;
/* Stuff to exec */
status = execute();
if(STRICT == TRUE && (0 != status))
{ /* Clearly the script hit an issue that should never have happened */
fputs("Subprocess error ", stderr);
fputs(int2str(status, 10, TRUE), stderr);
fputs("\nABORTING HARD\n", stderr);
exit(EXIT_FAILURE);
}
}
}
/* Function to populate env */
void populate_env(char** envp)
{
/* You can't populate a NULL environment */
if(NULL == envp) return;
/* avoid empty arrays */
int max = array_length(envp);
if(0 == max) return;
/* Initialize env and n */
env = calloc(1, sizeof(struct Token));
require(env != NULL, "Memory initialization of env failed\n");
struct Token* n;
n = env;
int i;
int j;
int k;
char* envp_line;
for(i = 0; i < max; i = i + 1)
{
n->var = calloc(MAX_STRING, sizeof(char));
require(n->var != NULL, "Memory initialization of n->var in population of env failed\n");
n->value = calloc(MAX_STRING, sizeof(char));
require(n->value != NULL, "Memory initialization of n->var in population of env failed\n");
j = 0;
/*
* envp is weird.
* When referencing envp[i]'s characters directly, they were all jumbled.
* So just copy envp[i] to envp_line, and work with that - that seems
* to fix it.
*/
envp_line = calloc(MAX_STRING, sizeof(char));
require(envp_line != NULL, "Memory initialization of envp_line in population of env failed\n");
strcpy(envp_line, envp[i]);
while(envp_line[j] != '=')
{ /* Copy over everything up to = to var */
n->var[j] = envp_line[j];
j = j + 1;
}
/* If we get strange input, we need to ignore it */
if(n->var == NULL) continue;
j = j + 1; /* Skip over = */
k = 0; /* As envp[i] will continue as j but n->value begins at 0 */
while(envp_line[j] != 0)
{ /* Copy everything else to value */
n->value[k] = envp_line[j];
j = j + 1;
k = k + 1;
}
/* Sometimes, we get lines like VAR=, indicating nothing is in the variable */
if(n->value == NULL) n->value = "";
/* Advance to next part of linked list */
n->next = calloc(1, sizeof(struct Token));
require(n->next != NULL, "Memory initialization of n->next in population of env failed\n");
n = n->next;
}
/* Get rid of node on the end */
n = NULL;
/* Also destroy the n->next reference */
n = env;
while(n->next->var != NULL) n = n->next;
n->next = NULL;
}
int main(int argc, char** argv, char** envp)
{
VERBOSE = FALSE;
STRICT = FALSE;
FUZZING = FALSE;
WARNINGS = FALSE;
char* filename = "kaem.run";
FILE* script = NULL;
/* Initalize structs */
token = calloc(1, sizeof(struct Token));
require(token != NULL, "Memory initialization of token failed\n");
int i = 1;
/* Loop over arguments */
while(i <= argc)
{
if(NULL == argv[i])
{ /* Ignore the argument */
i = i + 1;
}
else if(match(argv[i], "-h") || match(argv[i], "--help"))
{ /* Help information */
fputs("Usage: ", stdout);
fputs(argv[0], stdout);
fputs(" [-h | --help] [-V | --version] [--file filename | -f filename] [-i | --init-mode] [-v | --verbose] [--strict] [--warn] [--fuzz]\n", stdout);
exit(EXIT_SUCCESS);
}
else if(match(argv[i], "-f") || match(argv[i], "--file"))
{ /* Set the filename */
if(argv[i + 1] != NULL)
{
filename = argv[i + 1];
}
i = i + 2;
}
else if(match(argv[i], "-i") || match(argv[i], "--init-mode"))
{ /* init mode does not populate env */
INIT_MODE = TRUE;
i = i + 1;
}
else if(match(argv[i], "-V") || match(argv[i], "--version"))
{ /* Output version */
fputs("kaem version 1.1.0\n", stdout);
exit(EXIT_SUCCESS);
}
else if(match(argv[i], "-v") || match(argv[i], "--verbose"))
{ /* Set verbose */
VERBOSE = TRUE;
i = i + 1;
}
else if(match(argv[i], "--strict"))
{ /* Set strict */
STRICT = TRUE;
i = i + 1;
}
else if(match(argv[i], "--warn"))
{ /* Set warnings */
WARNINGS = TRUE;
i = i + 1;
}
else if(match(argv[i], "--fuzz"))
{ /* Set fuzzing */
FUZZING = TRUE;
i = i + 1;
}
else if(match(argv[i], "--"))
{ /* Nothing more after this */
break;
}
else
{ /* We don't know this argument */
fputs("UNKNOWN ARGUMENT\n", stdout);
exit(EXIT_FAILURE);
}
}
/* Populate env */
if(INIT_MODE == FALSE)
{
populate_env(envp);
}
/* Populate PATH variable
* We don't need to calloc() because env_lookup() does this for us.
*/
PATH = env_lookup("PATH");
/* Populate USERNAME variable */
char* USERNAME = env_lookup("LOGNAME");
/* Handle edge cases */
if((NULL == PATH) && (NULL == USERNAME))
{ /* We didn't find either of PATH or USERNAME -- use a generic PATH */
PATH = calloc(MAX_STRING, sizeof(char));
require(PATH != NULL, "Memory initialization of PATH failed\n");
strcpy(PATH, "/root/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin");
}
else if(NULL == PATH)
{ /* We did find a username but not a PATH -- use a generic PATH but with /home/USERNAME */
PATH = calloc(MAX_STRING, sizeof(char));
PATH = strcat(PATH, "/home/");
PATH = strcat(PATH, USERNAME);
PATH = strcat(PATH, "/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games");
}
/* Open the script */
script = fopen(filename, "r");
if(NULL == script)
{
fputs("The file: ", stderr);
fputs(filename, stderr);
fputs(" can not be opened!\n", stderr);
exit(EXIT_FAILURE);
}
/* Run the commands */
run_script(script, argv);
/* Cleanup */
fclose(script);
return EXIT_SUCCESS;
}
mescc-tools-Release_1.3/Kaem/kaem.h 0000664 0000000 0000000 00000002651 14126326331 0017215 0 ustar 00root root 0000000 0000000 /* Copyright (C) 2016-2020 Jeremiah Orians
* Copyright (C) 2020 fosslinux
* This file is part of mescc-tools.
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
#include "../M2libc/bootstrappable.h"
/*
* DEFINES
*/
#define FALSE 0
#define TRUE 1
#define MAX_STRING 4096
#define MAX_ARRAY 256
/*
* Here is the token struct. It is used for both the token linked-list and
* env linked-list.
*/
struct Token
{
/*
* For the token linked-list, this stores the token; for the env linked-list
* this stores the value of the variable.
*/
char* value;
/*
* Used only for the env linked-list. It holds a string containing the
* name of the var.
*/
char* var;
/*
* This struct stores a node of a singly linked list, store the pointer to
* the next node.
*/
struct Token* next;
};
#include "kaem_globals.h"
mescc-tools-Release_1.3/Kaem/kaem_globals.c 0000664 0000000 0000000 00000002010 14126326331 0020700 0 ustar 00root root 0000000 0000000 /* Copyright (C) 2016-2020 Jeremiah Orians
* Copyright (C) 2020 fosslinux
* This file is part of mescc-tools.
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
#include
#include
#include
#include "kaem.h"
/* Prototypes from other files */
int array_length(char** array);
char* env_lookup(char* variable);
/*
* VARIABLE HANDLING FUNCTIONS
*/
/* Substitute a variable into n->value */
int run_substitution(char* var_name, struct Token* n)
{
char* value = env_lookup(var_name);
/* If there is nothing to substitute, don't substitute anything! */
if(value != NULL)
{
char* s = calloc(MAX_STRING, sizeof(char));
s = strcat(s, n->value);
s = strcat(s, value);
n->value = s;
return TRUE;
}
return FALSE;
}
/* Handle ${var:-text} format of variables - i.e. ifset format */
int variable_substitute_ifset(char* input, struct Token* n, int index)
{
/*
* In ${var:-text} format, we evaluate like follows.
* If var is set as an envar, then we substitute the contents of that
* envar. If it is not set, we substitute alternative text.
*
* In this function, we assume that input is the raw token,
* n->value is everything already done in variable_substitute,
* index is where we are up to in input. offset is for n->value.
*/
/*
* Check if we should even be performing this function.
* We perform this function when we come across ${var:-text} syntax.
*/
int index_old = index;
int perform = FALSE;
int input_length = strlen(input);
while(index < input_length)
{ /* Loop over each character */
if(input[index] == ':' && input[index + 1] == '-')
{ /* Yes, this is (most likely) ${var:-text} format. */
perform = TRUE;
break;
}
index = index + 1;
}
/* Don't perform it if we shouldn't */
if(perform == FALSE) return index_old;
index = index_old;
/*
* Get offset.
* offset is the difference between the index of the variable we write to
* in the following blocks and input.
* This stays relatively constant.
*/
int offset = index;
/* Get the variable name */
char* var_name = calloc(MAX_STRING, sizeof(char));
require(var_name != NULL, "Memory initialization of var_name in variable_substitute_ifset failed\n");
while(input[index] != ':')
{ /* Copy into var_name until :- */
var_name[index - offset] = input[index];
index = index + 1;
}
/* Skip over :- */
index = index + 2;
offset = index;
/* Get the alternative text */
char* text = calloc(MAX_STRING, sizeof(char));
require(text != NULL, "Memory initialization of text in variable_substitute_ifset failed\n");
while(input[index] != '}')
{ /* Copy into text until } */
require(input_length > index, "IMPROPERLY TERMINATED VARIABLE\nABORTING HARD\n");
text[index - offset] = input[index];
index = index + 1;
}
/* Do the substitution */
if(run_substitution(var_name, n) == FALSE)
{ /* The variable was not found. Substitute the alternative text. */
char* s = calloc(MAX_STRING, sizeof(char));
s = strcat(s, n->value);
s = strcat(s, text);
n->value = s;
}
return index;
}
/* Controls substitution for ${variable} and derivatives */
int variable_substitute(char* input, struct Token* n, int index)
{
/* NOTE: index is the pos of input */
index = index + 1; /* We don't want the { */
/*
* Check for "special" types
* If we do find a special type we delegate the substitution to it
* and return here; as we are done... there's nothing more do do in
* that case.
*/
int index_old = index;
index = variable_substitute_ifset(input, n, index);
if(index != index_old) return index;
/* Reset index */
index = index_old;
/*
* If we reach here it is a normal substitution
* Let's do it!
*/
/* Initialize var_name and offset */
char* var_name = calloc(MAX_STRING, sizeof(char));
require(var_name != NULL, "Memory initialization of var_name in variable_substitute failed\n");
int offset = index;
/* Get the variable name */
int substitute_done = FALSE;
char c;
while(substitute_done == FALSE)
{
c = input[index];
require(MAX_STRING > index, "LINE IS TOO LONG\nABORTING HARD\n");
if(EOF == c || '\n' == c || index > strlen(input))
{ /* We never should hit EOF, EOL or run past the end of the line
while collecting a variable */
fputs("IMPROPERLY TERMINATED VARIABLE!\nABORTING HARD\n", stderr);
exit(EXIT_FAILURE);
}
else if('\\' == c)
{ /* Drop the \ - poor mans escaping. */
index = index + 1;
}
else if('}' == c)
{ /* End of variable name */
substitute_done = TRUE;
}
else
{
var_name[index - offset] = c;
index = index + 1;
}
}
/* Substitute the variable */
run_substitution(var_name, n);
return index;
}
/* Function to concatenate all command line arguments */
void variable_all(char** argv, struct Token* n)
{
fflush(stdout);
/* index refernences the index of n->value, unlike other functions */
int index = 0;
int argv_length = array_length(argv);
int i = 0;
char* argv_element = calloc(MAX_STRING, sizeof(char));
char* hold = argv[i];
n->value = argv_element;
/* Assuming the form kaem -f script or kaem -f script -- 123 we want matching results to bash, so skip the kaem, -f and script */
while(!match("--", hold))
{
i = i + 1;
hold = argv[i];
if(argv_length == i) break;
}
/* put i = i + 1 in the for initialization to skip past the -- */
for(; i < argv_length; i = i + 1)
{
/* Ends up with (n->value) (argv[i]) */
/* If we don't do this we get jumbled results in M2-Planet */
hold = argv[i];
strcpy(argv_element + index, hold);
index = index + strlen(hold);
/* Add space on the end */
n->value[index] = ' ';
index = index + 1;
}
/* Remove trailing space */
index = index - 1;
n->value[index] = 0;
}
/* Function controlling substitution of variables */
void handle_variables(char** argv, struct Token* n)
{
/* NOTE: index is the position of input */
int index = 0;
/* Create input */
char* input = calloc(MAX_STRING, sizeof(char));
require(input != NULL, "Memory initialization of input in collect_variable failed\n");
strcpy(input, n->value);
/* Reset n->value */
n->value = calloc(MAX_STRING, sizeof(char));
require(n->value != NULL, "Memory initialization of n->value in collect_variable failed\n");
/* Copy everything up to the $ */
/*
* TODO: Not need allocation of input before this check if there is no
* variable in it.
*/
while(input[index] != '$')
{
if(input[index] == 0)
{ /* No variable in it */
n->value = input;
return; /* We don't need to do anything more */
}
n->value[index] = input[index];
index = index + 1;
}
/* Must be outside the loop */
int offset;
substitute:
index = index + 1; /* We are uninterested in the $ */
/* Run the substitution */
if(input[index] == '{')
{ /* Handle everything ${ related */
index = variable_substitute(input, n, index);
index = index + 1; /* We don't want the closing } */
}
else if(input[index] == '@')
{ /* Handles $@ */
index = index + 1; /* We don't want the @ */
variable_all(argv, n);
}
else
{ /* We don't know that */
fputs("IMPROPERLY USED VARIABLE!\nOnly ${foo} and $@ format are accepted at this time.\nABORTING HARD\n", stderr);
exit(EXIT_FAILURE);
}
offset = strlen(n->value) - index;
/* Copy everything from the end of the variable to the end of the token */
while(input[index] != 0)
{
if(input[index] == '$')
{ /* We have found another variable */
fflush(stdout);
goto substitute;
}
n->value[index + offset] = input[index];
index = index + 1;
}
}
mescc-tools-Release_1.3/M1-macro.c 0000664 0000000 0000000 00000046013 14126326331 0016772 0 ustar 00root root 0000000 0000000 /* -*- c-file-style: "linux";indent-tabs-mode:t -*- */
/* Copyright (C) 2016 Jeremiah Orians
* Copyright (C) 2017 Jan Nieuwenhuizen
* This file is part of mescc-tools.
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
#include
#include
#include "M2libc/bootstrappable.h"
/* Internal processing Constants */
// CONSTANT max_string 4096
#define max_string 4096
// CONSTANT PROCESSED 1
#define PROCESSED 1
// CONSTANT STR 2
#define STR 2
// CONSTANT NEWLINE 3
#define NEWLINE 3
/* Unique code for each architecture */
// CONSTANT KNIGHT 0
#define KNIGHT 0
// CONSTANT X86 3
#define X86 0x03
// CONSTANT AMD64 62
#define AMD64 0x3E
// CONSTANT ARMV7L 40
#define ARMV7L 0x28
// CONSTANT AARM64 183
#define AARM64 0xB7
// CONSTANT PPC64LE 21
#define PPC64LE 0x15
// CONSTANT RISCV32 243
#define RISCV32 0xF3
// CONSTANT RISCV64 65779
#define RISCV64 0x100F3 /* Because RISC-V unlike all other architectures does get a seperate e_machine when changing from 32 to 64bit */
/* How do you want that output? */
// CONSTANT HEX 16
#define HEX 16
// CONSTANT OCTAL 8
#define OCTAL 8
// CONSTANT BINARY 2
#define BINARY 2
/* Imported from stringify.c */
int stringify(char* s, int digits, int divisor, int value, int shift);
void LittleEndian(char* start, int ByteMode);
struct blob
{
struct blob* next;
int type;
char* Text;
char* Expression;
struct blob* hash_next;
};
struct Token
{
struct Token* next;
struct blob* contents;
char* filename;
int linenumber;
};
/* Globals */
FILE* source_file;
FILE* destination_file;
int BigEndian;
int ByteMode;
int Architecture;
int linenumber;
struct Token* token_list;
struct blob* blob_list;
struct blob* define_blob;
struct blob* newline_blob;
int blob_count;
char* SCRATCH;
struct blob** hash_table;
void line_error(char* filename, int linenumber)
{
fputs(filename, stderr);
fputs(":", stderr);
fputs(int2str(linenumber,10, FALSE), stderr);
fputs(" :", stderr);
}
void ClearScratch()
{
int i = 0;
int c = SCRATCH[i];
while(0 != c)
{
SCRATCH[i] = 0;
i = i + 1;
c = SCRATCH[i];
}
}
int GetHash(char* s)
{
int i = 5381;
while(0 != s[0])
{
i = (i << 5) + i + s[0];
s = s + 1;
}
return i & 0xFFFF;
}
struct blob* FindBlob()
{
int hash = GetHash(SCRATCH);
struct blob* i = hash_table[hash];
while(NULL != i)
{
if(match(SCRATCH, i->Text)) return i;
i = i->hash_next;
}
return NULL;
}
void AddHash(struct blob* a, char* s)
{
int i = GetHash(s);
a->hash_next = hash_table[i];
hash_table[i] = a;
}
void NewBlob(int size)
{
blob_count = blob_count + 1;
struct blob* a = calloc(1, sizeof(struct blob));
require(NULL != a, "Exhausted available memory\n");
a->Text = calloc(size + 1, sizeof(char));
require(NULL != a->Text, "Exhausted available memory\n");
int i = 0;
while(i <= size)
{
a->Text[i] = SCRATCH[i];
i = i + 1;
}
a->next = blob_list;
blob_list = a;
AddHash(a, SCRATCH);
}
struct Token* newToken(char* filename, int linenumber)
{
struct Token* p;
p = calloc (1, sizeof (struct Token));
require(NULL != p, "Exhausted available memory\n");
p->filename = filename;
p->linenumber = linenumber;
return p;
}
struct Token* reverse_list(struct Token* head)
{
struct Token* root = NULL;
struct Token* next;
while(NULL != head)
{
next = head->next;
head->next = root;
root = head;
head = next;
}
return root;
}
void purge_lineComment()
{
int c = fgetc(source_file);
while(!in_set(c, "\n\r"))
{
if(EOF == c) break;
c = fgetc(source_file);
}
}
struct Token* append_newline(struct Token* head, char* filename)
{
linenumber = linenumber + 1;
if(NULL == head) return NULL;
if(NEWLINE == head->contents->type)
{/* Don't waste whitespace*/
return head;
}
struct Token* lf = newToken(filename, linenumber);
lf->contents = newline_blob;
lf->next = head;
return lf;
}
struct Token* store_atom(struct Token* head, char c, char* filename)
{
ClearScratch();
int ch = c;
int i = 0;
do
{
SCRATCH[i] = ch;
ch = fgetc(source_file);
i = i + 1;
if(i >= max_string)
{
fputs("storing atom of size larger than max_string\n", stderr);
line_error(filename, linenumber);
fputc('\n', stderr);
exit(EXIT_FAILURE);
}
if(EOF == ch) break;
} while (!in_set(ch, "\t\n "));
head->contents = FindBlob();
if(NULL == head->contents)
{
NewBlob(i);
head->contents = blob_list;
}
if('\n' == ch)
{
return append_newline(head, filename);
}
return head;
}
struct blob* store_string(char c, char* filename)
{
ClearScratch();
int ch = c;
int i = 0;
do
{
SCRATCH[i] = ch;
i = i + 1;
if('\n' == ch) linenumber = linenumber + 1;
ch = fgetc(source_file);
require(EOF != ch, "Unmatched \"!\n");
if(max_string == i)
{
line_error(filename, linenumber);
fputs("String: ", stderr);
fputs(SCRATCH, stderr);
fputs(" exceeds max string size\n", stderr);
exit(EXIT_FAILURE);
}
} while(ch != c);
struct blob* a = FindBlob();
if(NULL == a)
{
NewBlob(i);
a = blob_list;
a->type = STR;
}
return a;
}
struct Token* Tokenize_Line(struct Token* head, char* filename)
{
int c;
struct Token* p;
linenumber = 1;
do
{
restart:
c = fgetc(source_file);
if(in_set(c, ";#"))
{
purge_lineComment();
head = append_newline(head, filename);
goto restart;
}
if(in_set(c, "\t "))
{
goto restart;
}
if('\n' == c)
{
head = append_newline(head, filename);
goto restart;
}
if(EOF == c)
{
head = append_newline(head, filename);
goto done;
}
p = newToken(filename, linenumber);
p->next = head;
if(in_set(c, "'\""))
{
p->contents = store_string(c, filename);
}
else
{
p = store_atom(p, c, filename);
}
head = p;
} while(TRUE);
done:
return head;
}
void line_macro(struct Token* p)
{
struct Token* i;
for(i = p; NULL != i; i = i->next)
{
if(define_blob == i->contents)
{
require(NULL != i->next, "Macro name must exist\n");
require(NULL != i->next->next, "Macro value must exist\n");
if(PROCESSED == i->next->contents->type)
{
line_error(i->filename, i->linenumber);
fputs("Multiple definitions for macro ", stderr);
fputs(i->next->contents->Text, stderr);
fputs("\n", stderr);
exit(EXIT_FAILURE);
}
i->contents = newline_blob;
if (STR == i->next->next->contents->type)
{
i->contents->Expression = i->next->next->contents->Text + 1;
}
else
{
i->next->contents->Expression = i->next->next->contents->Text;
}
i->next = i->next->next->next;
}
}
}
void hexify_string(struct blob* p)
{
char* table = "0123456789ABCDEF";
int i = strlen(p->Text);
int size;
if(HEX == ByteMode) size = (((i << 1) + i) + 12);
else if(OCTAL == ByteMode) size = (i << 2) + 1;
else if(BINARY == ByteMode) size = (i << 3) + i + 1;
else size = 1;
require(1 != size, "hexify_string lacked a valid bytemode\n");
char* d = calloc(size, sizeof(char));
require(NULL != d, "Exhausted available memory\n");
p->Expression = d;
char* S = p->Text;
if((KNIGHT == Architecture) && (HEX == ByteMode))
{
i = (((((i - 1) >> 2) + 1) << 3) + i);
while( 0 < i)
{
i = i - 1;
d[i] = '0';
}
}
if(HEX == ByteMode)
{
while(0 != S[0])
{
S = S + 1;
d[0] = table[S[0] >> 4];
d[1] = table[S[0] & 0xF];
d[2] = ' ';
d = d + 3;
}
}
else if(OCTAL == ByteMode)
{
while(0 != S[0])
{
S = S + 1;
d[0] = table[S[0] >> 6];
d[1] = table[(S[0] >> 3) & 0x7];
d[2] = table[S[0] & 0x7];
d[3] = ' ';
d = d + 4;
}
}
else if(BINARY == ByteMode)
{
while(0 != S[0])
{
S = S + 1;
d[0] = table[S[0] >> 7];
d[1] = table[(S[0] >> 6) & 0x1];
d[2] = table[(S[0] >> 5) & 0x1];
d[3] = table[(S[0] >> 4) & 0x1];
d[4] = table[(S[0] >> 3) & 0x1];
d[5] = table[(S[0] >> 2) & 0x1];
d[6] = table[(S[0] >> 1) & 0x1];
d[7] = table[S[0] & 0x1];
d[8] = ' ';
d = d + 9;
}
}
}
void process_string(struct blob* p)
{
struct blob* i;
for(i = p; NULL != i; i = i->next)
{
if(STR == i->type)
{
if('\'' == i->Text[0])
{
i->Expression = i->Text + 1;
}
else if('"' == i->Text[0])
{
hexify_string(i);
}
}
}
}
char* pad_nulls(int size, char* nil)
{
if(0 == size) return nil;
require(size > 0, "negative null padding not possible\n");
if(HEX == ByteMode) size = size * 2;
else if (OCTAL == ByteMode) size = size * 3;
else if (BINARY == ByteMode) size = size * 8;
char* s = calloc(size + 1, sizeof(char));
require(NULL != s, "Exhausted available memory\n");
int i = 0;
while(i < size)
{
s[i] = '0';
i = i + 1;
}
return s;
}
void preserve_other(struct blob* p)
{
struct blob* i;
char c;
for(i = p; NULL != i; i = i->next)
{
if((NULL == i->Expression) && !(i->type & PROCESSED))
{
c = i->Text[0];
if(in_set(c, "!@$~%&:^"))
{
i->Expression = i->Text;
}
else if('<' == c)
{
i->Expression = pad_nulls(strtoint(i->Text + 1), i->Text);
}
}
}
}
void bound_values(int displacement, int number_of_bytes, int low, int high)
{
if((high < displacement) || (displacement < low))
{
fputs("A displacement of ", stderr);
fputs(int2str(displacement, 10, TRUE), stderr);
fputs(" does not fit in ", stderr);
fputs(int2str(number_of_bytes, 10, TRUE), stderr);
fputs(" bytes\n", stderr);
exit(EXIT_FAILURE);
}
}
void range_check(int displacement, int number_of_bytes)
{
if(4 == number_of_bytes) return;
else if(3 == number_of_bytes)
{
bound_values(displacement, number_of_bytes, -8388608, 16777216);
return;
}
else if(2 == number_of_bytes)
{
bound_values(displacement, number_of_bytes, -32768, 65535);
return;
}
else if(1 == number_of_bytes)
{
bound_values(displacement, number_of_bytes, -128, 255);
return;
}
fputs("Received an invalid number of bytes in range_check\n", stderr);
exit(EXIT_FAILURE);
}
char* express_number(int value, char c)
{
char* ch = calloc(42, sizeof(char));
require(NULL != ch, "Exhausted available memory\n");
int size;
int number_of_bytes;
int shift;
if('!' == c)
{
number_of_bytes = 1;
value = value & 0xFF;
}
else if('@' == c)
{
number_of_bytes = 2;
value = value & 0xFFFF;
}
else if('~' == c)
{
number_of_bytes = 3;
value = value & 0xFFFFFF;
}
else if('%' == c)
{
number_of_bytes = 4;
value = value & 0xFFFFFFFF;
}
else
{
fputs("Given symbol ", stderr);
fputc(c, stderr);
fputs(" to express immediate value ", stderr);
fputs(int2str(value, 10, TRUE), stderr);
fputc('\n', stderr);
exit(EXIT_FAILURE);
}
range_check(value, number_of_bytes);
if(HEX == ByteMode)
{
size = number_of_bytes * 2;
shift = 4;
}
else if(OCTAL == ByteMode)
{
size = number_of_bytes * 3;
shift = 3;
}
else if(BINARY == ByteMode)
{
size = number_of_bytes * 8;
shift = 1;
}
else
{
fputs("Got invalid ByteMode in express_number\n", stderr);
exit(EXIT_FAILURE);
}
stringify(ch, size, ByteMode, value, shift);
if(!BigEndian) LittleEndian(ch, ByteMode);
return ch;
}
char* express_word(int value, char c)
{
char* s = calloc(43, sizeof(char));
s[0] = '.';
char* ch = s + 1;
require(NULL != ch, "Exhausted available memory\n");
int size;
int shift;
int immediate;
if('!' == c)
{
/* Corresponds to RISC-V I format */
immediate = (value & 0xFFF) << 20;
}
else if('@' == c)
{
/* Corresponds to RISC-V S format */
immediate = ((value & 0x1F) << 7) | ((value & 0xFE0) << (31 - 11));
}
else if('~' == c)
{
/* Corresponds with RISC-V U format */
if ((value & 0xFFF) < 0x800)
{
immediate = value & 0xFFFFF000;
}
else
{
immediate = (value & 0xFFFFF000) + 0x1000;
}
}
else if('%' == c)
{
/* provides an option for 32bit immediate constants */
immediate = value & 0xFFFFFFFF;
/* Drop the leading . */
ch = s;
}
else
{
fputs("Given symbol ", stderr);
fputc(c, stderr);
fputs(" to express immediate value ", stderr);
fputs(int2str(value, 10, TRUE), stderr);
fputc('\n', stderr);
exit(EXIT_FAILURE);
}
if(HEX == ByteMode)
{
size = 4 * 2;
shift = 4;
}
else if(OCTAL == ByteMode)
{
size = 4 * 3;
shift = 3;
}
else if(BINARY == ByteMode)
{
size = 4 * 8;
shift = 1;
}
else
{
fputs("Got invalid ByteMode in express_number\n", stderr);
exit(EXIT_FAILURE);
}
stringify(ch, size, ByteMode, immediate, shift);
if(!BigEndian) LittleEndian(ch, ByteMode);
return s;
}
void eval_immediates(struct blob* p)
{
struct blob* i;
int value;
for(i = p; NULL != i; i = i->next)
{
if(PROCESSED == i->type) continue;
else if(NEWLINE == i->type) continue;
else if('<' == i->Text[0]) continue;
else if(NULL == i->Expression)
{
if((X86 == Architecture) || (AMD64 == Architecture) || (ARMV7L == Architecture) || (AARM64 == Architecture) || (PPC64LE == Architecture))
{
if(in_set(i->Text[0], "%~@!"))
{
value = strtoint(i->Text + 1);
if(('0' == i->Text[1]) || (0 != value))
{
i->Expression = express_number(value, i->Text[0]);
}
}
}
else if((RISCV32 == Architecture) || (RISCV64 == Architecture))
{
if(in_set(i->Text[0], "%~@!"))
{
value = strtoint(i->Text + 1);
if(('0' == i->Text[1]) || (0 != value))
{
i->Expression = express_word(value, i->Text[0]);
}
}
}
else if(KNIGHT == Architecture)
{
value = strtoint(i->Text);
if(('0' == i->Text[0]) || (0 != value))
{
i->Expression = express_number(value, '@');
}
}
else
{
fputs("Unknown architecture received in eval_immediates\n", stderr);
exit(EXIT_FAILURE);
}
}
}
}
void print_hex(struct Token* p)
{
struct Token* i;
for(i = p; NULL != i; i = i->next)
{
if(NEWLINE == i->contents->type)
{
if(NULL == i->next) fputc('\n', destination_file);
else if(NEWLINE != i->next->contents->type) fputc('\n', destination_file);
}
else if(NULL != i->contents->Expression)
{
fputs(i->contents->Expression, destination_file);
if(NEWLINE != i->next->contents->type) fputc(' ', destination_file);
}
else
{
line_error(i->filename, i->linenumber);
fputs("Received invalid other; ", stderr);
fputs(i->contents->Text, stderr);
fputs("\n", stderr);
exit(EXIT_FAILURE);
}
}
}
/* Standard C main program */
int main(int argc, char **argv)
{
BigEndian = TRUE;
Architecture = KNIGHT;
destination_file = stdout;
ByteMode = HEX;
char* filename;
char* arch;
blob_count = 2;
hash_table = calloc(65537, sizeof(struct blob*));
/* Create newline blob */
newline_blob = calloc(1, sizeof(struct blob));
newline_blob->Text = "\n";
newline_blob->Expression = "\n";
newline_blob->type = NEWLINE;
AddHash(newline_blob, "\n");
/* Start the blob list with DEFINE and newline */
blob_list = calloc(1, sizeof(struct blob));
blob_list->Text = "DEFINE";
define_blob = blob_list;
blob_list->next = newline_blob;
AddHash(define_blob, "DEFINE");
/* Initialize scratch */
SCRATCH = calloc(max_string + 1, sizeof(char));
int option_index = 1;
while(option_index <= argc)
{
if(NULL == argv[option_index])
{
option_index = option_index + 1;
}
else if(match(argv[option_index], "--BigEndian"))
{
fputs("--BigEndian is now depreciated and replaced by --big-endian\nAnd will stop working in a future release\n", stderr);
BigEndian = TRUE;
option_index = option_index + 1;
}
else if(match(argv[option_index], "--big-endian"))
{
BigEndian = TRUE;
option_index = option_index + 1;
}
else if(match(argv[option_index], "--LittleEndian"))
{
fputs("--LittleEndian is now depreciated and replaced by --little-endian\nAnd will stop working in a future release\n", stderr);
BigEndian = FALSE;
option_index = option_index + 1;
}
else if(match(argv[option_index], "--little-endian"))
{
BigEndian = FALSE;
option_index = option_index + 1;
}
else if(match(argv[option_index], "-A") || match(argv[option_index], "--architecture"))
{
arch = argv[option_index + 1];
if(match("knight-native", arch) || match("knight-posix", arch)) Architecture = KNIGHT;
else if(match("x86", arch)) Architecture = X86;
else if(match("amd64", arch)) Architecture = AMD64;
else if(match("armv7l", arch)) Architecture = ARMV7L;
else if(match("aarch64", arch)) Architecture = AARM64;
else if(match("ppc64le", arch)) Architecture = PPC64LE;
else if(match("riscv32", arch)) Architecture = RISCV32;
else if(match("riscv64", arch)) Architecture = RISCV64;
else
{
fputs("Unknown architecture: ", stderr);
fputs(arch, stderr);
fputs(" know values are: knight-native, knight-posix, x86, amd64, armv7l, aarch64, ppc64le, riscv32 and riscv64", stderr);
exit(EXIT_FAILURE);
}
option_index = option_index + 2;
}
else if(match(argv[option_index], "-b") || match(argv[option_index], "--binary"))
{
ByteMode = BINARY;
option_index = option_index + 1;
}
else if(match(argv[option_index], "-h") || match(argv[option_index], "--help"))
{
fputs("Usage: ", stderr);
fputs(argv[0], stderr);
fputs(" --file FILENAME1 {-f FILENAME2} (--big-endian|--little-endian) ", stderr);
fputs("[--architecture name]\nArchitectures: knight-native, knight-posix, x86, amd64, armv7, riscv32 and riscv64\n", stderr);
fputs("To leverage octal or binary output: --octal, --binary\n", stderr);
exit(EXIT_SUCCESS);
}
else if(match(argv[option_index], "-f") || match(argv[option_index], "--file"))
{
filename = argv[option_index + 1];
source_file = fopen(filename, "r");
if(NULL == source_file)
{
fputs("The file: ", stderr);
fputs(argv[option_index + 1], stderr);
fputs(" can not be opened!\n", stderr);
exit(EXIT_FAILURE);
}
token_list = Tokenize_Line(token_list, filename);
fclose(source_file);
option_index = option_index + 2;
}
else if(match(argv[option_index], "-o") || match(argv[option_index], "--output"))
{
destination_file = fopen(argv[option_index + 1], "w");
if(NULL == destination_file)
{
fputs("The file: ", stderr);
fputs(argv[option_index + 1], stderr);
fputs(" can not be opened!\n", stderr);
exit(EXIT_FAILURE);
}
option_index = option_index + 2;
}
else if(match(argv[option_index], "-O") || match(argv[option_index], "--octal"))
{
ByteMode = OCTAL;
option_index = option_index + 1;
}
else if(match(argv[option_index], "-V") || match(argv[option_index], "--version"))
{
fputs("M1 1.1.0\n", stdout);
exit(EXIT_SUCCESS);
}
else
{
fputs("Unknown option\n", stderr);
exit(EXIT_FAILURE);
}
}
if(NULL == token_list)
{
fputs("Either no input files were given or they were empty\n", stderr);
exit(EXIT_FAILURE);
}
token_list = reverse_list(token_list);
line_macro(token_list);
process_string(blob_list);
eval_immediates(blob_list);
preserve_other(blob_list);
print_hex(token_list);
fclose(destination_file);
return EXIT_SUCCESS;
}
mescc-tools-Release_1.3/M2libc/ 0000775 0000000 0000000 00000000000 14126326331 0016356 5 ustar 00root root 0000000 0000000 mescc-tools-Release_1.3/README.md 0000664 0000000 0000000 00000003630 14126326331 0016527 0 ustar 00root root 0000000 0000000 ## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see
* This file is part of mescc-tools
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
#include
#include
#include
#include
#include
#include "M2libc/bootstrappable.h"
// CONSTANT max_string 4096
#define max_string 4096
int BITSIZE;
int BigEndian;
// CONSTANT HEX 16
#define HEX 16
// CONSTANT OCTAL 8
#define OCTAL 8
// CONSTANT BINARY 2
#define BINARY 2
/* Strings needed for constants */
char* zero_8;
char* zero_16;
char* zero_32;
char* one_16;
char* one_32;
char* two_8;
char* two_32;
char* three_32;
char* six_32;
char* sixteen_32;
char* twentyfour_32;
/* Imported from stringify.c */
int stringify(char* s, int digits, int divisor, int value, int shift);
void LittleEndian(char* start, int ByteMode);
struct entry
{
struct entry* next;
char* name;
};
FILE* output;
struct entry* jump_table;
int count;
char* entry;
void consume_token(FILE* source_file, char* s)
{
int i = 0;
int c = fgetc(source_file);
require(EOF != c, "Can not have an EOF token\n");
do
{
s[i] = c;
i = i + 1;
require(max_string > i, "Token exceeds token length restriction\n");
c = fgetc(source_file);
if(EOF == c) break;
} while(!in_set(c, " \t\n>"));
}
void storeLabel(FILE* source_file)
{
struct entry* entry = calloc(1, sizeof(struct entry));
/* Prepend to list */
entry->next = jump_table;
jump_table = entry;
/* Store string */
entry->name = calloc((max_string + 1), sizeof(char));
consume_token(source_file, entry->name);
count = count + 1;
}
void line_Comment(FILE* source_file)
{
int c = fgetc(source_file);
while(!in_set(c, "\n\r"))
{
if(EOF == c) break;
c = fgetc(source_file);
}
}
void purge_string(FILE* source_file)
{
int c = fgetc(source_file);
while((EOF != c) && ('"' != c))
{
c = fgetc(source_file);
}
}
void first_pass(struct entry* input)
{
if(NULL == input) return;
first_pass(input->next);
FILE* source_file = fopen(input->name, "r");
if(NULL == source_file)
{
fputs("The file: ", stderr);
fputs(input->name, stderr);
fputs(" can not be opened!\n", stderr);
exit(EXIT_FAILURE);
}
int c;
for(c = fgetc(source_file); EOF != c; c = fgetc(source_file))
{
/* Check for and deal with label */
if(58 == c)
{
storeLabel(source_file);
}
/* Check for and deal with line comments */
else if (c == '#' || c == ';')
{
line_Comment(source_file);
}
else if ('"' == c)
{
purge_string(source_file);
}
}
fclose(source_file);
}
void output_string_table(struct entry* node)
{
fputs("\n# Generated string table\n:ELF_str\n", output);
fputs(zero_8, output);
fputs("\t# NULL string\n", output);
struct entry* i;
for(i = node; NULL != i; i = i->next)
{
fputs(":ELF_str_", output);
fputs(i->name, output);
fputs("\t\"", output);
fputs(i->name, output);
fputs("\"\n", output);
}
fputs("# END Generated string table\n\n", output);
}
void output_symbol_table(struct entry* node)
{
fputs("\n# Generated symbol table\n:ELF_sym\n# Required NULL symbol entry\n", output);
if(64 == BITSIZE)
{
fputs(zero_32, output);
fputs("\t# st_name\n", output);
fputs(zero_8, output);
fputs("\t# st_info\n", output);
fputs(zero_8, output);
fputs("\t# st_other\n", output);
fputs(one_16, output);
fputs("\t# st_shndx\n", output);
fputs(zero_32, output);
fputc(' ', output);
fputs(zero_32, output);
fputs("\t# st_value\n", output);
fputs(zero_32, output);
fputc(' ', output);
fputs(zero_32, output);
fputs("\t# st_size\n\n", output);
}
else
{
fputs(zero_32, output);
fputs("\t# st_name\n", output);
fputs(zero_32, output);
fputs("\t# st_value\n", output);
fputs(zero_32, output);
fputs("\t# st_size\n", output);
fputs(zero_8, output);
fputs("\t# st_info\n", output);
fputs(zero_8, output);
fputs("\t# st_other\n", output);
fputs(one_16, output);
fputs("\t# st_shndx\n\n", output);
}
struct entry* i;
for(i = node; NULL != i; i = i->next)
{
fputs("%ELF_str_", output);
fputs(i->name, output);
fputs(">ELF_str\t# st_name\n", output);
if(64 == BITSIZE)
{
fputs(two_8, output);
fputs("\t# st_info (FUNC)\n", output);
if(('_' == i->name[0]) && !match(entry, i->name))
{
fputs(two_8, output);
fputs("\t# st_other (hidden)\n", output);
}
else
{
fputs(zero_8, output);
fputs("\t# st_other (other)\n", output);
}
fputs(one_16, output);
fputs("\t# st_shndx\n", output);
fputs("&", output);
fputs(i->name, output);
fputc(' ', output);
fputs(zero_32, output);
fputs("\t# st_value\n", output);
fputs(zero_32, output);
fputc(' ', output);
fputs(zero_32, output);
fputs("\t# st_size (unknown size)\n\n", output);
}
else
{
fputs("&", output);
fputs(i->name, output);
fputs("\t#st_value\n", output);
fputs(zero_32, output);
fputs("\t# st_size (unknown size)\n", output);
fputs(two_8, output);
fputs("\t# st_info (FUNC)\n", output);
if(('_' == i->name[0]) && !match(entry, i->name))
{
fputs(two_8, output);
fputs("\t# st_other (hidden)\n", output);
}
else
{
fputs(zero_8, output);
fputs("\t# st_other (default)\n", output);
}
fputs(one_16, output);
fputs("\t# st_shndx\n\n", output);
}
}
fputs("# END Generated symbol table\n", output);
}
struct entry* reverse_list(struct entry* head)
{
struct entry* root = NULL;
struct entry* next;
while(NULL != head)
{
next = head->next;
head->next = root;
root = head;
head = next;
}
return root;
}
void write_int(char* field, char* label)
{
fputs(field, output);
fputs("\t#", output);
fputs(label, output);
fputc('\n', output);
}
void write_register(char* field, char* label)
{
/* $field section in the section headers are different size for 32 and 64bits */
/* The below is broken for BigEndian */
fputs(field, output);
if(64 == BITSIZE)
{
fputc(' ', output);
fputs(zero_32, output);
}
fputs("\t#", output);
fputs(label, output);
fputc('\n', output);
}
void write_section(char* label, char* name, char* type, char* flags, char* address, char* offset, char* size, char* link, char* info, char* entry)
{
/* Write label */
fputc('\n', output);
fputs(label, output);
fputc('\n', output);
write_int(name, "sh_name");
write_int(type, "sh_type");
write_register(flags, "sh_flags");
write_register(address, "sh_addr");
write_register(offset, "sh_offset");
write_register(size, "sh_size");
write_int(link, "sh_link");
/* Deal with the ugly case of stubs */
fputs(info, output);
fputs("\t#sh_info\n", output);
/* Alignment section in the section headers are different size for 32 and 64bits */
/* The below is broken for BigEndian */
if(64 == BITSIZE)
{
fputs(one_32, output);
fputc(' ', output);
fputs(zero_32, output);
fputs("\t#sh_addralign\n", output);
}
else
{
fputs(one_32, output);
fputs("\t#sh_addralign\n", output);
}
write_register(entry, "sh_entsize");
}
char* get_string(int value, int size, int ByteMode, int shift)
{
char* ch = calloc(42, sizeof(char));
require(NULL != ch, "Exhausted available memory\n");
ch[0] = '\'';
stringify(ch+1, size, ByteMode, value, shift);
if(!BigEndian) LittleEndian(ch+1, ByteMode);
int i = 0;
while(0 != ch[i])
{
i = i + 1;
}
ch[i] = '\'';
return ch;
}
char* setup_string(int value, int number_of_bytes, int ByteMode)
{
int shift;
int size;
if(HEX == ByteMode)
{
size = 2;
shift = 4;
}
else if(OCTAL == ByteMode)
{
size = 3;
shift = 3;
}
else if(BINARY == ByteMode)
{
size = 8;
shift = 1;
}
else
{
fputs("reached impossible mode\n", stderr);
exit(EXIT_FAILURE);
}
return get_string(value, number_of_bytes *size, ByteMode, shift);
}
void setup_strings(int ByteMode)
{
zero_8 = setup_string(0, 1, ByteMode);
zero_16 = setup_string(0, 2, ByteMode);
zero_32 = setup_string(0, 4, ByteMode);
one_16 = setup_string(1, 2, ByteMode);
one_32 = setup_string(1, 4, ByteMode);
two_8 = setup_string(2, 1, ByteMode);
two_32 = setup_string(2, 4, ByteMode);
three_32 = setup_string(3, 4, ByteMode);
six_32 = setup_string(6, 4, ByteMode);
sixteen_32 = setup_string(16, 4, ByteMode);
twentyfour_32 = setup_string(24, 4, ByteMode);
}
/* Standard C main program */
int main(int argc, char **argv)
{
jump_table = NULL;
struct entry* input = NULL;
output = stdout;
char* output_file = "";
entry = "";
BITSIZE = 32;
count = 1;
BigEndian = TRUE;
int ByteMode = HEX;
int set = FALSE;
struct entry* temp;
struct entry* head;
int option_index = 1;
while(option_index <= argc)
{
if(NULL == argv[option_index])
{
option_index = option_index + 1;
}
else if(match(argv[option_index], "-h") || match(argv[option_index], "--help"))
{
fputs("Usage: ", stderr);
fputs(argv[0], stderr);
fputs(" --file FILENAME1 {--file FILENAME2} --output FILENAME\n", stderr);
exit(EXIT_SUCCESS);
}
else if(match(argv[option_index], "--64"))
{
BITSIZE = 64;
option_index = option_index + 1;
}
else if(match(argv[option_index], "-f") || match(argv[option_index], "--file"))
{
temp = calloc(1, sizeof(struct entry));
temp->name = argv[option_index + 1];
temp->next = input;
input = temp;
option_index = option_index + 2;
}
else if(match(argv[option_index], "-o") || match(argv[option_index], "--output"))
{
output_file = argv[option_index + 1];
output = fopen(output_file, "w");
if(NULL == output)
{
fputs("The file: ", stderr);
fputs(input->name, stderr);
fputs(" can not be opened!\n", stderr);
exit(EXIT_FAILURE);
}
option_index = option_index + 2;
}
else if(match(argv[option_index], "-b") || match(argv[option_index], "--binary"))
{
ByteMode = BINARY;
option_index = option_index + 1;
}
else if(match(argv[option_index], "-O") || match(argv[option_index], "--octal"))
{
ByteMode = OCTAL;
option_index = option_index + 1;
}
else if(match(argv[option_index], "-X") || match(argv[option_index], "--hex"))
{
ByteMode = HEX;
option_index = option_index + 1;
}
else if(match(argv[option_index], "--big-endian"))
{
BigEndian = TRUE;
set = TRUE;
option_index = option_index + 1;
}
else if(match(argv[option_index], "--little-endian"))
{
BigEndian = FALSE;
set = TRUE;
option_index = option_index + 1;
}
else if(match(argv[option_index], "-V") || match(argv[option_index], "--version"))
{
fputs("blood-elf 2.0.0\n(Basically Launches Odd Object Dump ExecutabLe Files\n", stdout);
exit(EXIT_SUCCESS);
}
else if(match(argv[option_index], "--entry"))
{
head = calloc(1, sizeof(struct entry));
/* Include _start or any other entry from your .hex2 */
head->next = jump_table;
jump_table = head;
jump_table->name = argv[option_index + 1];
/* However only the last one will be exempt from the _name hidden rule */
entry = argv[option_index + 1];
option_index = option_index + 2;
count = count + 1;
}
else
{
fputs("Unknown option\n", stderr);
exit(EXIT_FAILURE);
}
}
/* Make sure we have a program tape to run */
if (NULL == input)
{
return EXIT_FAILURE;
}
/* Force setting of endianness */
if(!set)
{
fputs("either --little-endian or --big-endian MUST be set\n", stderr);
return EXIT_FAILURE;
}
/* Setup the ugly formating because RISC-V sucks */
setup_strings(ByteMode);
/* Get all of the labels */
first_pass(input);
/* Reverse their order */
jump_table = reverse_list(jump_table);
/* Create sections */
/* Create string names for sections */
fputs("# Generated sections\n:ELF_shstr\n", output);
fputs(zero_8, output);
fputs("\t# NULL\n", output);
fputs(":ELF_shstr__text\n\".text\"\n", output);
fputs(":ELF_shstr__shstr\n\".shstrtab\"\n", output);
fputs(":ELF_shstr__sym\n\".symtab\"\n", output);
fputs(":ELF_shstr__str\n\".strtab\"\n", output);
/* Create NULL section header as is required by the Spec. So dumb and waste of bytes*/
write_section(":ELF_section_headers", zero_32, zero_32, zero_32, zero_32, zero_32, zero_32, zero_32, zero_32, zero_32);
write_section(":ELF_section_header_text", "%ELF_shstr__text>ELF_shstr", one_32, six_32, "&ELF_text", "%ELF_text>ELF_base", "%ELF_data>ELF_text", zero_32, zero_32, zero_32);
write_section(":ELF_section_header_shstr", "%ELF_shstr__shstr>ELF_shstr", three_32, zero_32, "&ELF_shstr", "%ELF_shstr>ELF_base", "%ELF_section_headers>ELF_shstr", zero_32, zero_32, zero_32);
write_section(":ELF_section_header_str", "%ELF_shstr__str>ELF_shstr", three_32, zero_32, "&ELF_str", "%ELF_str>ELF_base", "%ELF_sym>ELF_str", zero_32, zero_32, zero_32);
if(64 == BITSIZE) write_section(":ELF_section_header_sym", "%ELF_shstr__sym>ELF_shstr", two_32, zero_32, "&ELF_sym", "%ELF_sym>ELF_base", "%ELF_end>ELF_sym", three_32, setup_string(count, 4, ByteMode), twentyfour_32);
else write_section(":ELF_section_header_sym", "%ELF_shstr__sym>ELF_shstr", two_32, zero_32, "&ELF_sym", "%ELF_sym>ELF_base", "%ELF_end>ELF_sym", three_32, setup_string(count, 4, ByteMode), sixteen_32);
/* Create dwarf stubs needed for objdump -d to get function names */
output_string_table(jump_table);
output_symbol_table(jump_table);
fputs("\n:ELF_end\n", output);
/* Close output file */
fclose(output);
return EXIT_SUCCESS;
}
mescc-tools-Release_1.3/catm.c 0000664 0000000 0000000 00000003211 14126326331 0016333 0 ustar 00root root 0000000 0000000 /* Copyright (C) 2019 Jeremiah Orians
* This file is part of mescc-tools
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
#include
#include
#include
// CONSTANT BUFFER_SIZE 4096
#define BUFFER_SIZE 4096
int main(int argc, char** argv)
{
if(2 > argc)
{
fputs("catm requires 2 or more arguments\n", stderr);
exit(EXIT_FAILURE);
}
int output = open(argv[1], 577 , 384);
if(-1 == output)
{
fputs("The file: ", stderr);
fputs(argv[1], stderr);
fputs(" is not a valid output file name\n", stderr);
exit(EXIT_FAILURE);
}
int i;
int bytes;
char* buffer = calloc(BUFFER_SIZE + 1, sizeof(char));
int input;
for(i = 2; i < argc ; i = i + 1)
{
input = open(argv[i], 0, 0);
if(-1 == input)
{
fputs("The file: ", stderr);
fputs(argv[i], stderr);
fputs(" is not a valid input file name\n", stderr);
exit(EXIT_FAILURE);
}
keep:
bytes = read(input, buffer, BUFFER_SIZE);
write(output, buffer, bytes);
if(BUFFER_SIZE == bytes) goto keep;
}
free(buffer);
return EXIT_SUCCESS;
}
mescc-tools-Release_1.3/check.sh 0000775 0000000 0000000 00000002551 14126326331 0016665 0 ustar 00root root 0000000 0000000 #! /usr/bin/env bash
# Copyright © 2017 Jan Nieuwenhuizen
# Copyright © 2017 Jeremiah Orians
# Copyright (C) 2019 ng0
#
# This file is part of mescc-tools
#
# mescc-tools 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.
#
# mescc-tools 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 mescc-tools. If not, see
.br
Jan (janneke) Nieuwenhuizen
.SH COPYRIGHT
Copyright 2016-2019 Jeremiah Orians
.br
Copyright 2017 Jan Nieuwenhuizen
.br
License GPLv3+.
.SH "SEE ALSO"
hex2(1), blood-elf(1), kaem(1), syscalls(2)
mescc-tools-Release_1.3/docs/blood-elf.1 0000664 0000000 0000000 00000002546 14126326331 0020132 0 ustar 00root root 0000000 0000000 .\"Made with Love
.TH blood-elf 1 "JULY 2019" Linux "User Manuals"
.SH NAME
blood-elf - Get mescc with dwarfs
.SH SYNOPSIS
.na
blood-elf --file FILE [--output FILE --64]
.SH DESCRIPTION
blood-elf exists to generate ELF debug tables in M1-macro
format from M1-macro assembly files.
.br
At its core is read until you find :LABEL and then add it
to the list of things to output. It will ignore labels that
have '_' prefixing their name. eg :_foo will not get an entry.
If no output is specified, the result will be sent to Standard
Out.
.br
Fortunately the only architecture difference that you need
to concern yourself with is if your binary is going to be
64bits or 32bits (which is the default) and to pass the flag:
--64 should you need that alternate format
.SH EXAMPLES
Typically, blood-elf will be called in scripts used in bootstrapping
.br
# blood-elf -f cc.M1 -o cc-footer.M1
.br
# blood-elf --file cc.M1 --64 --output cc-footer.M1
.br
.SH COMPATIBILITY
blood-elf is compatible with all Turing complete machines;
even the ones that try to be Turing complete -1.
.SH AUTHORS
Jeremiah Orians
.br
Jan (janneke) Nieuwenhuizen
.SH COPYRIGHT
Copyright 2016-2019 Jeremiah Orians
.br
Copyright 2017 Jan Nieuwenhuizen
.br
License GPLv3+.
.SH "SEE ALSO"
M1(1), hex2(1), kaem(1), syscalls(2)
mescc-tools-Release_1.3/docs/get_machine.1 0000664 0000000 0000000 00000003371 14126326331 0020527 0 ustar 00root root 0000000 0000000 .\"Made with Love
.TH get_machine 1 "JULY 2019" Linux "User Manuals"
.SH NAME
get_machine - identify running hardware architecture
.SH SYNOPSIS
.na
get_machine [ --exact --override OVERRIDE --os ]
.SH DESCRIPTION
get_machine exists to make simple shell scripts that need
to know that hardware architecture it is assuming or what
host operating system is being used.
.br
At its core is figure out the general hardware architecture
and return it as quickly as possible. Although it is sometimes
useful to return something different; which is why --override
exists and thus what ever is supplied by with it is returned.
Scripts that wish to expose that can leverage the environment
variable GET_MACHINE_FLAGS to allow efficient overriding in
their scripts. Or if they wish to only override what Operating
system is running the environment variable GET_MACHINE_OS_FLAGS
should be used.
.br
If one wishes for something more exact than x86 or amd64, the
option --exact will return more specific values like i686-pae.
.br
Should one desire to know the host operating system: --os
.br
A word of warning; --override always will take top precedence
and can return anything you desire.
.SH EXAMPLES
Typically, get_machine will be in scripts used in bootstrapping
.br
# get_machine
.br
# get_machine --override "I am the very model of a modern major general"
.br
# get_machine ${GET_MACHINE_FLAGS}
.br
# get_machine ${GET_MACHINE_OS_FLAGS} --os
.br
.SH COMPATIBILITY
get_machine is compatible with all Turing complete machines;
even the ones that try to be Turing complete -1
.SH AUTHORS
Jeremiah Orians
.SH COPYRIGHT
Copyright 2016-2021 Jeremiah Orians
.br
License GPLv3+.
.SH "SEE ALSO"
M1(1), hex2(1), blood-elf(1), kaem(1), syscalls(2)
mescc-tools-Release_1.3/docs/hex2.1 0000664 0000000 0000000 00000004730 14126326331 0017132 0 ustar 00root root 0000000 0000000 .\"Made with Love
.TH hex2 1 "JULY 2019" Linux "User Manuals"
.SH NAME
hex2 - The trivially bootstrappable linker that is designed to be introspectable by humans
.SH SYNOPSIS
.na
hex2 --architecture ARCHITECTURE --base-address ADDRESS --file FILE [--output FILE [--non-executable]]
.SH DESCRIPTION
hex2 is designed to allow humans to write elf and other binary
files by hand in a format that allows comments and ease of understanding.
.br
At its core is read 2 hex characters add them together
and output a single byte. You can override this and use
binary or octal input if you so desire, using the --octal
or --binary option.
.br
If no output file is specified the output will be send to standard out.
By default the file will be executable unless the option:
--non-executable is also passed.
.br
The supported ARCHITECTURES are as follows: knight-native,
knight-posix, x86, amd64, armv7l and aarch64.
If you fail to specify an architecture, the default of knight-native
will be used.
.br
The base address for which the binary is to be loaded into memory
and thus the relative and absolute pointers should be based,
is passed via --base-address if it is not provided the default
value of ZERO will be assumed.
.br
hex2 also support labels in the :LABEL format and relative
and absolute pointers to those labels in 8, 16, 24 or 32bit sizes.
!LABEL, @LABEL, ~LABEL and %LABEL for 8, 16, 24 and 32bit relative addresses
respectively and $LABEL and &LABEL for 16 and 32bit absolute
addresses respectively.
Should you wish to specify the bit and byte encoding of the
addresses to match your target --big-endian and --little-endian
On architectures that require word alignment the < and ^
characters have a special meaning; particulary pad to word
and use word base address calculation rather than standard
byte based address calculation; generally seen in the form:
^~LABEL EB for calls in ARM
.SH EXAMPLES
Typically, hex2 will be called in scripts used in bootstrapping
.br
# hex2 -f ELF-armv7l.hex2 -f cc.hex2 --little-endian --architecture armv7l --base-address 0x10000 -o cc
.br
.SH COMPATIBILITY
hex2 is compatible with all Turing complete machines;
even the ones that try to be Turing complete -1
.SH AUTHORS
Jeremiah Orians
.br
Jan (janneke) Nieuwenhuizen
.SH COPYRIGHT
Copyright 2016-2019 Jeremiah Orians
.br
Copyright 2017 Jan Nieuwenhuizen
.br
License GPLv3+.
.SH "SEE ALSO"
M1(1), blood-elf(1), kaem(1), syscalls(2)
mescc-tools-Release_1.3/docs/kaem.1 0000664 0000000 0000000 00000003201 14126326331 0017171 0 ustar 00root root 0000000 0000000 .\"Made with Love
.TH kaem 1 "JULY 2019" Linux "User Manuals"
.SH NAME
kaem - Like running with scissors but shell scripts without a shell
.SH SYNOPSIS
.na
kaem [--file FILE --strict --verbose --nightmare-mode]
.SH DESCRIPTION
kaem exists to be the most minimal shell needed in the bootstrap
processes; that has the ability to function as an init
thus allowing the bootstrap to occur with only itself and a
hex0 assembler as the only binaries running on the system.
.br
At its core is read a line (except when the line is terminated
with a '\\', when it is read the next line too) and then collect
the arguments into an array, lookup the program in the path
provided by the name or if not found in the ENVIRONMENT and
then execute the program with the specified options.
.br
If no filename is passed, it then attempts to execute a file
called kaem.run; which is the standard name for kaem scripts.
If you wish for kaem to stop when one of the lines throws or
returns an error code, simply add --strict. If you wish to
see what is being executed, simply add --verbose. If you
hate dealing with an environment and want to eliminate it
entirely --nightmare-mode.
.SH EXAMPLES
Typically, kaem will be in running scripts used in bootstrapping
.br
# kaem --verbose --strict
.br
# kaem -f bootstrap.sh --nightmare-mode
.br
.SH COMPATIBILITY
kaem is compatible with all Turing complete machines;
even the ones that try to be Turing complete -1
.SH AUTHORS
Jeremiah Orians
.SH COPYRIGHT
Copyright 2016-2019 Jeremiah Orians
.br
License GPLv3+.
.SH "SEE ALSO"
M1(1), hex2(1), blood-elf(1), get_machine(1), syscalls(2)
mescc-tools-Release_1.3/elf_headers/ 0000775 0000000 0000000 00000000000 14126326331 0017507 5 ustar 00root root 0000000 0000000 mescc-tools-Release_1.3/elf_headers/elf32-ARM-debug.hex2 0000664 0000000 0000000 00000005713 14126326331 0022721 0 ustar 00root root 0000000 0000000 ### Copyright (C) 2016 Jeremiah Orians
### Copyright (C) 2017 Jan Nieuwenhuizen
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see 1 byte relative
### $ 2 byte address
### @ 2 byte relative
### & 4 byte address
### % 4 byte relative
### elf32.hex2: 32 bit elf header in hex2
### if you wish to use this header, you need to add :ELF_end to the end of your
### M1 or hex2 files.
## ELF Header
:ELF_base
7F 45 4C 46 # e_ident[EI_MAG0-3] ELF's magic number
01 # e_ident[EI_CLASS] Indicating 32 bit
01 # e_ident[EI_DATA] Indicating little endianness
01 # e_ident[EI_VERSION] Indicating original elf
03 # e_ident[EI_OSABI] Set at 3 because FreeBSD is strict
00 # e_ident[EI_ABIVERSION] See above
00 00 00 00 00 00 00 # e_ident[EI_PAD]
02 00 # e_type Indicating Executable
28 00 # e_machine Indicating 32bit ARM
01 00 00 00 # e_version Indicating original elf
&_start # e_entry Address of the entry point
%ELF_program_headers>ELF_base # e_phoff Address of program header table
%ELF_section_headers>ELF_base # e_shoff Address of section header table
00 02 00 05 # e_flags
34 00 # e_ehsize Indicating our 52 Byte header
20 00 # e_phentsize size of a program header table
01 00 # e_phnum number of entries in program table
28 00 # e_shentsize size of a section header table
05 00 # e_shnum number of entries in section table
02 00 # e_shstrndx index of the section names
# @40
:ELF_program_headers
:ELF_program_header__text
01 00 00 00 # ph_type: PT-LOAD = 1
00 00 00 00 # ph_offset
&ELF_base # ph_vaddr
&ELF_base # ph_physaddr
%ELF_end>ELF_base # ph_filesz
%ELF_end>ELF_base # ph_memsz
07 00 00 00 # ph_flags: PF-X|PF-W|PF-R = 7
00 00 01 00 # alignment
:ELF_text
mescc-tools-Release_1.3/elf_headers/elf32-ARM.hex2 0000664 0000000 0000000 00000005726 14126326331 0021641 0 ustar 00root root 0000000 0000000 ### Copyright (C) 2016 Jeremiah Orians
### Copyright (C) 2017 Jan Nieuwenhuizen
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see 1 byte relative
### $ 2 byte address
### @ 2 byte relative
### & 4 byte address
### % 4 byte relative
### elf32.hex2: 32 bit elf header in hex2
### if you wish to use this header, you need to add :ELF_end to the end of your
### M1 or hex2 files.
## ELF Header
:ELF_base
7F 45 4C 46 # e_ident[EI_MAG0-3] ELF's magic number
01 # e_ident[EI_CLASS] Indicating 32 bit
01 # e_ident[EI_DATA] Indicating little endianness
01 # e_ident[EI_VERSION] Indicating original elf
03 # e_ident[EI_OSABI] Set at 3 because FreeBSD is strict
00 # e_ident[EI_ABIVERSION] See above
00 00 00 00 00 00 00 # e_ident[EI_PAD]
02 00 # e_type Indicating Executable
28 00 # e_machine Indicating 32bit ARM
01 00 00 00 # e_version Indicating original elf
&_start # e_entry Address of the entry point
%ELF_program_headers>ELF_base # e_phoff Address of program header table
00 00 00 00 # e_shoff Address of section header table
00 02 00 05 # e_flags
34 00 # e_ehsize Indicating our 52 Byte header
20 00 # e_phentsize size of a program header table
01 00 # e_phnum number of entries in program table
00 00 # e_shentsize size of a section header table
00 00 # e_shnum number of entries in section table
00 00 # e_shstrndx index of the section names
## Program Header
:ELF_program_headers
:ELF_program_header__text
01 00 00 00 # ph_type: PT-LOAD = 1
00 00 00 00 # ph_offset
&ELF_base # ph_vaddr
&ELF_base # ph_physaddr
%ELF_end>ELF_base # ph_filesz
%ELF_end>ELF_base # ph_memsz
07 00 00 00 # ph_flags: PF-X|PF-W|PF-R = 7
00 00 01 00 # alignment
:ELF_text
mescc-tools-Release_1.3/elf_headers/elf32-debug.hex2 0000664 0000000 0000000 00000005677 14126326331 0022315 0 ustar 00root root 0000000 0000000 ### Copyright (C) 2016 Jeremiah Orians
### Copyright (C) 2017 Jan Nieuwenhuizen
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see 1 byte relative
### $ 2 byte address
### @ 2 byte relative
### & 4 byte address
### % 4 byte relative
### local_ function-local
### string_ string #
### elf32-header-exit-42.hex2: 32 bit elf header in hex2 for `exit 42'
:ELF_base
7F 45 4C 46 # e_ident[EI_MAG0-3] ELF's magic number
01 # e_ident[EI_CLASS] Indicating 32 bit
01 # e_ident[EI_DATA] Indicating little endianness
01 # e_ident[EI_VERSION] Indicating original elf
03 # e_ident[EI_OSABI] Set at 3 because FreeBSD is strict
00 # e_ident[EI_ABIVERSION] See above
00 00 00 00 00 00 00 # e_ident[EI_PAD]
02 00 # e_type Indicating Executable
03 00 # e_machine Indicating AMD64
01 00 00 00 # e_version Indicating original elf
&_start # e_entry Address of the entry point
%ELF_program_headers>ELF_base # e_phoff Address of program header table
%ELF_section_headers>ELF_base # e_shoff Address of section header table
00 00 00 00 # e_flags
34 00 # e_ehsize Indicating our 52 Byte header
20 00 # e_phentsize size of a program header table
01 00 # e_phnum number of entries in program table
28 00 # e_shentsize size of a section header table
05 00 # e_shnum number of entries in section table
02 00 # e_shstrndx index of the section names
:ELF_program_headers
:ELF_program_header__text
01 00 00 00 # ph_type: PT-LOAD = 1
00 00 00 00 # ph_offset
&ELF_base # ph_vaddr
&ELF_base # ph_physaddr
%ELF_end>ELF_base # ph_filesz
%ELF_end>ELF_base # ph_memsz
07 00 00 00 # ph_flags: PF-X|PF-W|PF-R = 7
01 00 00 00 # ph_align
:ELF_text
mescc-tools-Release_1.3/elf_headers/elf32.hex2 0000664 0000000 0000000 00000005717 14126326331 0021224 0 ustar 00root root 0000000 0000000 ### Copyright (C) 2016 Jeremiah Orians
### Copyright (C) 2017 Jan Nieuwenhuizen
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see 1 byte relative
### $ 2 byte address
### @ 2 byte relative
### & 4 byte address
### % 4 byte relative
### elf32.hex2: 32 bit elf header in hex2
### if you wish to use this header, you need to add :ELF_end to the end of your
### M1 or hex2 files.
## ELF Header
:ELF_base
7F 45 4C 46 # e_ident[EI_MAG0-3] ELF's magic number
01 # e_ident[EI_CLASS] Indicating 32 bit
01 # e_ident[EI_DATA] Indicating little endianness
01 # e_ident[EI_VERSION] Indicating original elf
03 # e_ident[EI_OSABI] Set at 3 because FreeBSD is strict
00 # e_ident[EI_ABIVERSION] See above
00 00 00 00 00 00 00 # e_ident[EI_PAD]
02 00 # e_type Indicating Executable
03 00 # e_machine Indicating x86
01 00 00 00 # e_version Indicating original elf
&_start # e_entry Address of the entry point
%ELF_program_headers>ELF_base # e_phoff Address of program header table
00 00 00 00 # e_shoff Address of section header table
00 00 00 00 # e_flags
34 00 # e_ehsize Indicating our 52 Byte header
20 00 # e_phentsize size of a program header table
01 00 # e_phnum number of entries in program table
00 00 # e_shentsize size of a section header table
00 00 # e_shnum number of entries in section table
00 00 # e_shstrndx index of the section names
## Program Header
:ELF_program_headers
:ELF_program_header__text
01 00 00 00 # ph_type: PT-LOAD = 1
00 00 00 00 # ph_offset
&ELF_base # ph_vaddr
&ELF_base # ph_physaddr
%ELF_end>ELF_base # ph_filesz
%ELF_end>ELF_base # ph_memsz
07 00 00 00 # ph_flags: PF-X|PF-W|PF-R = 7
01 00 00 00 # ph_align
:ELF_text
mescc-tools-Release_1.3/elf_headers/elf64-ARM.hex2 0000664 0000000 0000000 00000006316 14126326331 0021642 0 ustar 00root root 0000000 0000000 ### Copyright (C) 2016 Jeremiah Orians
### Copyright (C) 2017 Jan Nieuwenhuizen
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see
### This file is part of stage0.
###
### stage0 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.
###
### stage0 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 stage0. If not, see
#include
#include
int match(char* a, char* b);
#define TRUE 1
//CONSTANT TRUE 1
#define FALSE 0
//CONSTANT FALSE 0
/* Standard C main program */
int main(int argc, char **argv)
{
int exact = FALSE;
int override = FALSE;
char* override_string;
int option_index = 1;
struct utsname* unameData = calloc(1, sizeof(struct utsname));
uname(unameData);
while(option_index <= argc)
{
if(NULL == argv[option_index])
{
option_index = option_index + 1;
}
else if(match(argv[option_index], "--exact"))
{
exact = TRUE;
option_index = option_index + 1;
}
else if(match(argv[option_index], "--override"))
{
override = TRUE;
override_string = argv[option_index + 1];
option_index = option_index + 2;
}
else if(match(argv[option_index], "--os") || match(argv[option_index], "--OS"))
{
if(override) fputs(override_string, stdout);
else fputs(unameData->sysname, stdout);
fputc('\n', stdout);
exit(EXIT_SUCCESS);
}
else if(match(argv[option_index], "--blood"))
{
if(override) fputs(override_string, stdout);
else if(match("aarch64", unameData->machine)
|| match("amd64", unameData->machine)
|| match("ppc64le", unameData->machine)
|| match("riscv64", unameData->machine)
|| match("x86_64", unameData->machine)) fputs("--64", stdout);
fputc('\n', stdout);
exit(EXIT_SUCCESS);
}
else if(match(argv[option_index], "-V") || match(argv[option_index], "--version"))
{
fputs("get_machine 1.1.0\n", stdout);
exit(EXIT_SUCCESS);
}
else if(match(argv[option_index], "-h") || match(argv[option_index], "--help"))
{
fputs("If you want exact architecture use --exact\n", stderr);
fputs("If you want to know the Operating system use --OS\n", stderr);
fputs("If you wish to override the output to anything you want use --override\n", stderr);
exit(EXIT_SUCCESS);
}
else
{
fputs("Unknown option\n", stderr);
exit(EXIT_FAILURE);
}
}
if(override) fputs(override_string, stdout);
else if(!exact)
{
if(match("i386", unameData->machine) ||
match("i486", unameData->machine) ||
match("i586", unameData->machine) ||
match("i686", unameData->machine) ||
match("i686-pae", unameData->machine)) fputs("x86", stdout);
else if(match("x86_64", unameData->machine)) fputs("amd64", stdout);
else fputs(unameData->machine, stdout);
}
else fputs(unameData->machine, stdout);
fputs("\n", stdout);
return EXIT_SUCCESS;
}
mescc-tools-Release_1.3/guix.scm 0000664 0000000 0000000 00000006461 14126326331 0016735 0 ustar 00root root 0000000 0000000 ;;; guix.scm -- Guix package definition
;;; mescc-tools
;;; Copyright © 2017 Jan Nieuwenhuizen
;;; Copyright 2016 Jeremiah Orians
;;; Also borrowing code from:
;;; guile-sdl2 --- FFI bindings for SDL2
;;; Copyright © 2015 David Thompson
;;;
;;; guix.scm: This file is part of mescc-tools.
;;;
;;; mescc-tools 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.
;;;
;;; mescc-tools 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 mescc-tools. If not, see
* This file is part of mescc-tools
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
* This file is part of mescc-tools
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
#include
#include
#include
#include
#include "M2libc/bootstrappable.h"
#define max_string 4096
#define TRUE 1
#define FALSE 0
#define KNIGHT 0
#define X86 0x03
#define AMD64 0x3E
#define ARMV7L 0x28
#define AARM64 0xB7
#define PPC64LE 0x15
#define RISCV32 0xF3
#define RISCV64 0x100F3 /* Because RISC-V unlike all other architectures does get a seperate e_machine when changing from 32 to 64bit */
#define HEX 16
#define OCTAL 8
#define BINARY 2
struct input_files
{
struct input_files* next;
char* filename;
};
struct entry
{
struct entry* next;
unsigned target;
char* name;
};
mescc-tools-Release_1.3/hex2_globals.h 0000664 0000000 0000000 00000003206 14126326331 0017771 0 ustar 00root root 0000000 0000000 /* -*- c-file-style: "linux";indent-tabs-mode:t -*- */
/* Copyright (C) 2017 Jeremiah Orians
* Copyright (C) 2017 Jan Nieuwenhuizen
* This file is part of mescc-tools
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
* This file is part of mescc-tools
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
* This file is part of mescc-tools
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
;;; Copyright 2016 Jeremiah Orians
;;; guix.scm: This file is part of mescc-tools.
;;;
;;; mescc-tools 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.
;;;
;;; mescc-tools 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 mescc-tools. If not, see
# Copyright (C) 2019 Jeremiah Orians
#
# This file is part of mescc-tools
#
# mescc-tools 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.
#
# mescc-tools 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 mescc-tools. If not, see
* This file is part of mescc-tools.
*
* mescc-tools 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.
*
* mescc-tools 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 mescc-tools. If not, see
// CONSTANT HEX 16
#define HEX 16
// CONSTANT OCTAL 8
#define OCTAL 8
// CONSTANT BINARY 2
#define BINARY 2
/***********************************************************
* Needed for current implementation of little endian *
* Can be used to support little bit endian instruction *
* sets if we ever find one that might be useful *
* But I seriously doubt it *
***********************************************************/
void reverseBitOrder(char* c, int ByteMode)
{
if(NULL == c) return;
if(0 == c[1]) return;
int hold = c[0];
if(HEX == ByteMode)
{
c[0] = c[1];
c[1] = hold;
reverseBitOrder(c+2, ByteMode);
}
else if(OCTAL == ByteMode)
{
c[0] = c[2];
c[2] = hold;
reverseBitOrder(c+3, ByteMode);
}
else if(BINARY == ByteMode)
{
c[0] = c[7];
c[7] = hold;
hold = c[1];
c[1] = c[6];
c[6] = hold;
hold = c[2];
c[2] = c[5];
c[5] = hold;
hold = c[3];
c[3] = c[4];
c[4] = hold;
reverseBitOrder(c+8, ByteMode);
}
}
void LittleEndian(char* start, int ByteMode)
{
char* end = start;
char* c = start;
while(0 != end[0]) end = end + 1;
int hold;
for(end = end - 1; start < end; start = start + 1)
{
hold = start[0];
start[0] = end[0];
end[0] = hold;
end = end - 1;
}
/* The above makes a reversed bit order */
reverseBitOrder(c, ByteMode);
}
int hex2char(int c)
{
if((c >= 0) && (c <= 9)) return (c + 48);
else if((c >= 10) && (c <= 15)) return (c + 55);
else return -1;
}
int stringify(char* s, int digits, int divisor, int value, int shift)
{
int i = value;
if(digits > 1)
{
i = stringify(s+1, (digits - 1), divisor, value, shift);
}
s[0] = hex2char(i & (divisor - 1));
return (i >> shift);
}
mescc-tools-Release_1.3/test.sh 0000775 0000000 0000000 00000001524 14126326331 0016566 0 ustar 00root root 0000000 0000000 #! /bin/sh
## Copyright (C) 2017 Jeremiah Orians
## This file is part of stage0.
##
## stage0 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.
##
## stage0 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 stage0. If not, see 1 byte relative
## $ 2 byte address
## @ 2 byte relative
## % 4 byte relative
## & 4 byte address
## label_ function-local
## string_ string
##
#.text
:main
55 89 e5 83 ec 40
# eputs("Hello, Mescc!\n");
68 &string_0
e8 %eputs 83 c4 04
85 c0
b8 2a 00 00 00
c9 c3
#.data
:g_environment
00 00 00 00
:g_stdin
00 00 00 00
:g_stdout
00 00 00 00
:string_0
48 65 6c 6c 6f 2c 20 4d 65 73 63 63 21 0a 00
:ELF_end
mescc-tools-Release_1.3/test/test0/hello.sh 0000775 0000000 0000000 00000002232 14126326331 0020725 0 ustar 00root root 0000000 0000000 #! /bin/sh
## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see 1 byte relative
## $ 2 byte address
## @ 2 byte relative
## % 4 byte relative
## & 4 byte address
## label_ function-local
## string_ string
##
#.text
:_start
55 89 e5 83 ec 40
e8 %main 83 c4 00
89 45 fc
# exit(r);
ff 75 fc
e8 %exit 83 c4 04
85 c0
c9 c3
:_env
55 89 e5 83 ec 40
8b 45 08
c9 c3
:exit
55 89 e5 83 ec 40
# asm(".byte 0x8b 0x5d 0x08");
8b 5d 08
# asm(".byte 0xb8 0x01 0x00 0x00 0x00");
b8 01 00 00 00
# asm(".byte 0xcd 0x80");
cd 80
c9 c3
:write
55 89 e5 83 ec 40
# asm(".byte 0x8b 0x5d 0x08");
8b 5d 08
# asm(".byte 0x8b 0x4d 0x0c");
8b 4d 0c
# asm(".byte 0x8b 0x55 0x10");
8b 55 10
# asm(".byte 0xb8 0x04 0x00 0x00 0x00");
b8 04 00 00 00
# asm(".byte 0xcd 0x80");
cd 80
c9 c3
:strlen
# while (s[i]) ...
55 89 e5 83 ec 40
c7 45 fc 00 00 00 00
e9 09 00 00 00
8b 45 fc
83 45 fc 01
85 c0
8b 45 fc
89 c2
8b 55 08
01 d0
0f b6 00
85 c0
85 c0
84 c0 74 05
e9 dd ff ff ff
8b 45 fc
c9 c3
:eputs
55 89 e5 83 ec 40
ff 75 08
e8 %strlen 83 c4 04
89 45 fc
# write(2, s, i);
ff 75 fc
ff 75 08
b8 02 00 00 00
50
e8 %write 83 c4 0c
85 c0
b8 00 00 00 00
c9 c3
#.data
:g_stdin
00 00 00 00
:g_environment
00 00 00 00
mescc-tools-Release_1.3/test/test1/ 0000775 0000000 0000000 00000000000 14126326331 0017265 5 ustar 00root root 0000000 0000000 mescc-tools-Release_1.3/test/test1/.gitignore 0000664 0000000 0000000 00000001436 14126326331 0021261 0 ustar 00root root 0000000 0000000 # Ignore the files created by scrip
## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see
48 83 f8 30 # cmp $0x30,%rax
7c 6f # jl 6000f3
48 83 f8 3a # cmp $0x3a,%rax
7c 5a # jl 6000e4
48 83 f8 41 # cmp $0x41,%rax
7c 63 # jl 6000f3
48 83 f8 47 # cmp $0x47,%rax
7c 58 # jl 6000ee
48 83 f8 61 # cmp $0x61,%rax
7c 57 # jl 6000f3
48 83 f8 67 # cmp $0x67,%rax
7c 47 # jl 6000e9
eb 4f # jmp 6000f3
## Purge Comment
48 c7 c2 01 00 00 00 # mov $0x1,%rdx
48 c7 c6 99 01 60 00 # mov $0x600199,%rsi
48 c7 c7 00 00 00 00 # mov $0x0,%rdi
48 c7 c0 00 00 00 00 # mov $0x0,%rax
0f 05 # syscall
48 85 c0 # test %rax,%rax
0f 84 be 00 00 00 # je 600189
8a 04 25 99 01 60 00 # mov 0x600199,%al
48 0f b6 c0 # movzbq %al,%rax
48 83 f8 0a # cmp $0xa,%rax
75 c8 # jne 6000a4
48 c7 c0 ff ff ff ff # mov $0xffffffffffffffff,%rax
c3 # retq
## ascii num
48 83 e8 30 # sub $0x30,%rax
c3 # retq
## ascii low
48 83 e8 57 # sub $0x57,%rax
c3 # retq
## ascii high
48 83 e8 37 # sub $0x37,%rax
c3 # retq
## ascii other
48 c7 c0 ff ff ff ff # mov $0xffffffffffffffff,%rax
c3 # retq
## start
49 c7 c7 ff ff ff ff # mov $0xffffffffffffffff,%r15
49 c7 c6 00 00 00 00 # mov $0x0,%r14
## Loop
48 c7 c2 01 00 00 00 # mov $0x1,%rdx
48 c7 c6 99 01 60 00 # mov $0x600199,%rsi
48 c7 c7 00 00 00 00 # mov $0x0,%rdi
48 c7 c0 00 00 00 00 # mov $0x0,%rax
0f 05 # syscall
48 85 c0 # test %rax,%rax
74 5d # je 600189
8a 04 25 99 01 60 00 # mov 0x600199,%al
48 0f b6 c0 # movzbq %al,%rax
e8 3c ff ff ff # callq 600078
48 83 f8 00 # cmp $0x0,%rax
7c c7 # jl 600109
49 83 ff 00 # cmp $0x0,%r15
7d 0c # jge 600154
49 89 c6 # mov %rax,%r14
49 c7 c7 00 00 00 00 # mov $0x0,%r15
eb b5 # jmp 600109
## print
49 c1 e6 04 # shl $0x4,%r14
4c 01 f0 # add %r14,%rax
88 04 25 9a 01 60 00 # mov %al,0x60019a
49 c7 c7 ff ff ff ff # mov $0xffffffffffffffff,%r15
48 c7 c2 01 00 00 00 # mov $0x1,%rdx
48 c7 c6 9a 01 60 00 # mov $0x60019a,%rsi
48 c7 c7 01 00 00 00 # mov $0x1,%rdi
48 c7 c0 01 00 00 00 # mov $0x1,%rax
0f 05 # syscall
eb 80 # jmp 600109
## Done
48 c7 c7 00 00 00 00 # mov $0x0,%rdi
48 c7 c0 3c 00 00 00 # mov $0x3c,%rax
0f 05 # syscall
## Place for input, This actually isn't required but here it is
02 00 00
mescc-tools-Release_1.3/test/test1/hex1.hex0 0000664 0000000 0000000 00000027047 14126326331 0020732 0 ustar 00root root 0000000 0000000 ## Copyright (C) 2017 Jeremiah Orians
## This file is part of stage0.
##
## stage0 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.
##
## stage0 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 stage0. If not, see
48 83 f8 30 # cmp $0x30,%rax
7c 6f # jl 6000f3
48 83 f8 3a # cmp $0x3a,%rax
7c 5a # jl 6000e4
48 83 f8 41 # cmp $0x41,%rax
7c 63 # jl 6000f3
48 83 f8 47 # cmp $0x47,%rax
7c 58 # jl 6000ee
48 83 f8 61 # cmp $0x61,%rax
7c 57 # jl 6000f3
48 83 f8 67 # cmp $0x67,%rax
7c 47 # jl 6000e9
eb 4f # jmp 6000f3
## Purge Comment
48 c7 c2 01 00 00 00 # mov $0x1,%rdx
48 c7 c6 99 01 60 00 # mov $0x600199,%rsi
48 c7 c7 00 00 00 00 # mov $0x0,%rdi
48 c7 c0 00 00 00 00 # mov $0x0,%rax
0f 05 # syscall
48 85 c0 # test %rax,%rax
0f 84 be 00 00 00 # je 600189
8a 04 25 99 01 60 00 # mov 0x600199,%al
48 0f b6 c0 # movzbq %al,%rax
48 83 f8 0a # cmp $0xa,%rax
75 c8 # jne 6000a4
48 c7 c0 ff ff ff ff # mov $0xffffffffffffffff,%rax
c3 # retq
## ascii num
48 83 e8 30 # sub $0x30,%rax
c3 # retq
## ascii low
48 83 e8 57 # sub $0x57,%rax
c3 # retq
## ascii high
48 83 e8 37 # sub $0x37,%rax
c3 # retq
## ascii other
48 c7 c0 ff ff ff ff # mov $0xffffffffffffffff,%rax
c3 # retq
## start
49 c7 c7 ff ff ff ff # mov $0xffffffffffffffff,%r15
49 c7 c6 00 00 00 00 # mov $0x0,%r14
## Loop
48 c7 c2 01 00 00 00 # mov $0x1,%rdx
48 c7 c6 99 01 60 00 # mov $0x600199,%rsi
48 c7 c7 00 00 00 00 # mov $0x0,%rdi
48 c7 c0 00 00 00 00 # mov $0x0,%rax
0f 05 # syscall
48 85 c0 # test %rax,%rax
74 5d # je 600189
8a 04 25 99 01 60 00 # mov 0x600199,%al
48 0f b6 c0 # movzbq %al,%rax
e8 3c ff ff ff # callq 600078
48 83 f8 00 # cmp $0x0,%rax
7c c7 # jl 600109
49 83 ff 00 # cmp $0x0,%r15
7d 0c # jge 600154
49 89 c6 # mov %rax,%r14
49 c7 c7 00 00 00 00 # mov $0x0,%r15
eb b5 # jmp 600109
## print
49 c1 e6 04 # shl $0x4,%r14
4c 01 f0 # add %r14,%rax
88 04 25 9a 01 60 00 # mov %al,0x60019a
49 c7 c7 ff ff ff ff # mov $0xffffffffffffffff,%r15
48 c7 c2 01 00 00 00 # mov $0x1,%rdx
48 c7 c6 9a 01 60 00 # mov $0x60019a,%rsi
48 c7 c7 01 00 00 00 # mov $0x1,%rdi
48 c7 c0 01 00 00 00 # mov $0x1,%rax
0f 05 # syscall
eb 80 # jmp 600109
## Done
48 c7 c7 00 00 00 00 # mov $0x0,%rdi
48 c7 c0 3c 00 00 00 # mov $0x3c,%rax
0f 05 # syscall
## Place for input, This actually isn't required but here it is
02 00 00
mescc-tools-Release_1.3/test/test2/proof.answer 0000664 0000000 0000000 00000000123 14126326331 0021630 0 ustar 00root root 0000000 0000000 a9a48fdbff46b4d7e1596bae4bd44c23f554a285b404dc151b63a073b2efce62 test/test2/proof
mescc-tools-Release_1.3/test/test3/ 0000775 0000000 0000000 00000000000 14126326331 0017267 5 ustar 00root root 0000000 0000000 mescc-tools-Release_1.3/test/test3/.gitignore 0000664 0000000 0000000 00000001374 14126326331 0021264 0 ustar 00root root 0000000 0000000 # Ignore the files created by script
## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see "
:writeobj_PRIMOP
LOADUI R0 $PRIMOP_String ; Using the desired string
CALLI R15 @Print_String ; Write it to output
JUMP @writeobj_done ; Be Done
:PROC_String
"#"
:writeobj_PROC
LOADUI R0 $PROC_String ; Using the desired string
CALLI R15 @Print_String ; Write it to output
JUMP @writeobj_done ; Be Done
:writeobj_STRING
LOAD32 R0 R3 4 ; Get HEAD->CAR
CALLI R15 @Print_String ; Write it to output
JUMP @writeobj_done ; Be Done
:writeobj_CHAR
LOADU8 R0 R3 7 ; Using bottom 8 bits of HEAD->CAR
FPUTC ; We write our desired output
:writeobj_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; strcmp
;; A simple string compare function
;; Receives string pointers in R0 and R1
;; Returns result of comparision in R0
:strcmp
;; Preserve registers
PUSHR R2 R15
PUSHR R3 R15
PUSHR R4 R15
;; Setup registers
MOVE R2 R0
MOVE R3 R1
LOADUI R4 0
:cmpbyte
LOADXU8 R0 R2 R4 ; Get a byte of our first string
LOADXU8 R1 R3 R4 ; Get a byte of our second string
ADDUI R4 R4 1 ; Prep for next loop
CMP R1 R0 R1 ; Compare the bytes
CMPSKIPI.E R0 0 ; Stop if byte is NULL
JUMP.E R1 @cmpbyte ; Loop if bytes are equal
;; Done
MOVE R0 R1 ; Prepare for return
;; Restore registers
POPR R4 R15
POPR R3 R15
POPR R2 R15
RET R15
;; findsym
;; Attempts to find a symbol in a CONS list
;; Receives a string in R0
;; Returns Cell or NIL in R0
:findsym
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
COPY R3 R0 ; Protect String
LOADR R2 @all_symbols ; Get all_symbols
:findsym_loop
LOADUI R0 $NIL ; Using NIL
CMPSKIP.NE R0 R2 ; Check if we reached the end
JUMP @findsym_done ; Use NIL as our result
LOAD32 R0 R2 4 ; Get symlist->CAR
LOAD32 R0 R0 4 ; Get symlist->CAR->CAR
COPY R1 R3 ; Prepare string to find
CALLI R15 @strcmp ; See if we have a match
JUMP.E R0 @findsym_found ; We have a match
LOAD32 R2 R2 8 ; symlist = symlist->CDR
JUMP @findsym_loop ; Keep looping
:findsym_found
MOVE R0 R2 ; We want symlist as our result
:findsym_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; intern
;; Either find symbol or make it
;; Receives string pointer in R0
;; Returns a Cell pointer in R0
:intern
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
COPY R1 R0 ; Protect String
CALLI R15 @findsym ; Lookup Symbol
CMPSKIPI.NE R0 $NIL ; Determine if Symbol was found
JUMP @intern_found ; And if so, use it
MOVE R0 R1 ; Using our string
CALLI R15 @make_sym ; Make a SYM
COPY R2 R0 ; Protect Cell
LOADR32 R1 @all_symbols ; Get all_symbols
CALLI R15 @make_cons ; CONS together
STORER32 R0 @all_symbols ; Update all_symbols
MOVE R0 R2 ; Restore Cell
JUMP @intern_done ; R0 has our result
:intern_found
LOAD32 R0 R0 4 ; Use op->CAR as our result
:intern_done
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; extend
;; CONS up symbols with an environment
;; Receives an environment in R0, symbol in R1 and Value in R2
;; Returns a CONS of CONS in R0
:extend
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
SWAP R2 R0 ; Protect the env until we need it
SWAP R0 R1 ; Put Symbol and Value in Correct Order
CALLI R15 @make_cons ; Make inner CONS
MOVE R1 R2 ; Get env now that we need it
CALLI R15 @make_cons ; Make outter CONS
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; multiple_extend
;; Receives an environment in R0, symbol in R1 and Values in R2
;; Returns an extended environment in R0
:multiple_extend
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
PUSHR R5 R15 ; Protect R5
LOADUI R5 $NIL ; We will need NIL
:multiple_extend_0
CMPJUMPI.E R1 R5 @multiple_extend_done
LOAD32 R3 R1 8 ; Protect SYMS->CDR
LOAD32 R4 R2 8 ; Protect VALS->CDR
LOAD32 R1 R1 4 ; Using SYMS->CAR
LOAD32 R2 R2 4 ; Using VALS->CAR
CALLI R15 @extend ; Extend Environment
MOVE R1 R3 ; USING SYMS->CDR
MOVE R2 R4 ; VALS->CDR
JUMP @multiple_extend_0 ; Iterate until fully extended
:multiple_extend_done
POPR R5 R15 ; Restore R5
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; extend_env
;; Receives a Symbol in R0, a Value in R1 and an environment pointer in R2
;; Returns Value in R0 after extending top
:extend_env
PUSHR R1 R15 ; Protect Val
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
CALLI R15 @make_cons ; Make a cons of SYM and VAL
MOVE R3 R0 ; Put safely out of way
LOAD32 R0 R2 4 ; Using ENV->CAR
LOAD32 R1 R2 8 ; And ENV->CDR
CALLI R15 @make_cons ; Make a cons of old environment
STORE32 R0 R2 8 ; SET ENV->CDR to old environment
STORE32 R3 R2 4 ; SET ENV->CAR to new CONS
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore Val
COPY R0 R1 ; Return Val
RET R15
;; assoc
;; Receives a Key in R0 and an alist in R1
;; Returns Value if Found or NIL in R0
:assoc
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOADUI R4 $NIL ; Using NIL
LOAD32 R0 R0 4 ; Using KEY->CAR
:assoc_0
CMPJUMPI.E R1 R4 @assoc_done
LOAD32 R2 R1 4 ; ALIST->CAR
LOAD32 R3 R2 4 ; ALIST->CAR->CAR
LOAD32 R3 R3 4 ; ALIST->CAR->CAR->CAR
LOAD32 R1 R1 8 ; ALIST = ALIST->CDR
CMPSKIP.E R0 R3 ; If ALIST->CAR->CAR->CAR != KEY->CAR
JUMP @assoc_0 ; Iterate using ALIST->CDR
;; Found KEY
MOVE R4 R2 ; Set ALIST->CAR as our return value
:assoc_done
MOVE R0 R4 ; Use whatever in R4 as our return
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; evlis
;; Receives Expressions in R0 and an Environment in R1
;; Returns the result of Evaluation of those Expressions
;; in respect to the given Environment in R0
:evlis
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
COPY R3 R1 ; Protect ENV
LOAD32 R2 R0 4 ; Protect EXPRS->CAR
LOAD32 R0 R0 8 ; Using EXPRS->CDR
CALLI R15 @evlis ; Recursively Call self Down Expressions
SWAP R0 R2 ; Using EXPRS->CDR
MOVE R1 R3 ; Restore ENV
CALLI R15 @eval ; EVAL
MOVE R1 R2 ; Using result of EVAL and EVLIS
CALLI R15 @make_cons ; Make a CONS of it all
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; progn
;; Receives Expressions in R0 and an Environment in R1
;; Returns the result of Evaluation of those Expressions
;; in respect to the given Environment in R0
:progn
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
:progn_0
LOAD32 R2 R0 8 ; Protect EXPS->CDR
LOAD32 R0 R0 4 ; Using EXPS->CAR
CALLI R15 @eval ; EVAL
CMPSKIP.E R2 R3 ; If EXPS->CDR NOT NIL
MOVE R0 R2 ; Use EXPS->CDR for next loop
JUMP.Z R2 @progn_0 ; Keep looping if EXPS->CDR isn't NIL
;; Finally broke out of loop
;; Desired result is in R0
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; Apply
;; Receives a Procedure in R0 and Values in R1
;; Applies the procedure to the values and returns the result in R0
:apply
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOAD32 R3 R0 0 ; Get PROC->TYPE
;; Deal with PRIMOPs
CMPSKIPI.E R3 64 ; If Not PRIMOP
JUMP @apply_0 ; Check NEXT
LOAD32 R3 R0 4 ; Using PROC->CAR
MOVE R0 R1 ; Apply to VALs
CALL R3 R15 ; Call PROC->CAR with VALs
JUMP @apply_done ; Simply Pass the results
;; Deal with Procedures
:apply_0
CMPSKIPI.E R3 32 ; If Not PROC
JUMP @apply_1 ; Abort with FIRE
MOVE R2 R1 ; Protect VALUE and put in future correct place
MOVE R3 R0 ; Protect PROC
LOAD32 R0 R3 12 ; Get PROC->ENV
LOAD32 R1 R0 8 ; Get PROC->ENV->CDR
LOAD32 R0 R0 4 ; Get PROC->ENV->CAR
CALLI R15 @make_cons ; ENV = MAKE_CONS(PROC->ENV->CAR, PROC->ENV->CDR)
LOAD32 R1 R3 4 ; Get PROC->CAR
CALLI R15 @multiple_extend ; R0 = MULTIPLE_EXTEND(ENV, PROC->CAR, VALS)
MOVE R1 R0 ; Put Extended_Env in the right place
LOAD32 R0 R3 8 ; Get PROC->CDR
CALLI R15 @progn ; PROGN(PROC->CDR, R0)
JUMP @apply_done ; Simply Pass the results
;; Deal with unknown shit
:apply_1
LOADUI R0 $apply_error ; Using designated Error Message
FALSE R1 ; Using TTY
CALLI R15 @Print_String ; Write Message
HALT ; And bring the FIRE
:apply_error
"Bad argument to apply"
;; Clean up and return
:apply_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; evcond
;; Receives an Expression in R0 and an Environment in R1
;; Walks down conditions until true one is found and return
;; Desired expression's result in R0
;; if none of the conditions are true, and the result of
;; the COND is undefined
:evcond
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOADUI R4 $TEE ; Using TEE
;; Truth Evaluation
:evcond_0
LOAD32 R3 R0 8 ; Protect EXP->CDR
LOAD32 R2 R0 4 ; Protect EXP->CAR
LOAD32 R0 R2 4 ; Using EXP->CAR->CAR
CALLI R15 @eval ; EVAL
CMPJUMPI.E R0 R4 @evcond_1 ; Its true !
MOVE R0 R3 ; Using EXP->CDR
CALLI R15 @evcond ; Recurse
JUMP @evcond_done ; Bail with just NIL
;; Expression Evaluation
:evcond_1
LOAD32 R0 R2 8 ; Get EXP->CAR->CDR
LOAD32 R0 R0 4 ; Using EXP->CAR->CDR->CAR
CALLI R15 @eval ; EVAL
;; Clean up and return
:evcond_done
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; eval
;; Receives an Expression in R0 and an Environment in R1
;; Evaluates the expression in the given environment and returns
;; The result in R0
:eval
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOAD32 R4 R0 0 ; Get EXP->TYPE
;; Deal with special case of Integers
CMPSKIPI.NE R4 4 ; If EXP->TYPE is Integer
JUMP @eval_done ; Simply return what was given
;; Deal with special case of Symbols
CMPSKIPI.E R4 8 ; If EXP->TYPE is NOT Symbol
JUMP @eval_cons ; Move onto next Case
CALLI R15 @process_sym ; process the symbol
JUMP @eval_done ; Return it
;; Deal with special cases of CONS
:eval_cons
CMPSKIPI.E R4 16 ; If EXP->TYPE is NOT CONS
JUMP @eval_proc ; Move onto next Case
CALLI R15 @process_cons ; Deal with all CONS
JUMP @eval_done ; Simply return the result
:eval_proc
CMPSKIPI.E R4 32 ; If EXP->TYPE is NOT PROC
JUMP @eval_primop ; Move onto next Case
JUMP @eval_done
:eval_primop
CMPSKIPI.E R4 64 ; If EXP->TYPE is NOT PRIMOP
JUMP @eval_char ; Move onto next Case
:eval_char
CMPSKIPI.E R4 128 ; If EXP->TYPE is NOT CHAR
JUMP @eval_string ; Move onto next Case
JUMP @eval_done
:eval_string
CMPSKIPI.E R4 256 ; If EXP->TYPE is NOT STRING
JUMP @eval_error ; Move onto next Case
JUMP @eval_done
:eval_error
LOADUI R0 $eval_error_Message ; Use a specific message to aid debugging
FALSE R1 ; Written to TTY
CALLI R15 @Print_String ; Write NOW
HALT
:eval_error_Message
"EVAL Received unknown Object"
;; Result must be in R0 by this point
;; Simply Clean up and return result in R0
:eval_done
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; process_sym
;; Receives Expression in R0 and an Environment in R1
;; Returns symbol in R0
:process_sym
CALLI R15 @assoc ; ASSOC to get tmp
CMPSKIPI.NE R0 $NIL ; If NIL is returned
JUMP @process_bad_Symbol ; Burn with FIRE
LOAD32 R0 R0 8 ; Return tmp->CDR
RET R15
:process_bad_Symbol
LOADUI R0 $sym_unbound ; Using the designated Error message
FALSE R1 ; Using TTY
CALLI R15 @Print_String ; Written for the user
HALT ; Simply toss the rest into the fire
:sym_unbound
"Unbound symbol"
;; process_if
;; Receives Expression in R0 and an Environment in R1
;; Returns the evaluation of the expression if true in R0
;; Or the evaluation of the CDR of the expression
:process_if
PUSHR R2 R15 ; Protect R2
LOAD32 R2 R0 8 ; Protect EXP->CDR
LOAD32 R0 R2 4 ; Using EXP->CDR->CAR
CALLI R15 @eval ; Recurse to get truth
CMPSKIPI.NE R0 $NIL ; If Result was NOT NIL
LOAD32 R2 R2 8 ; Update to EXP->CDR->CDR
LOAD32 R0 R2 8 ; Get EXP->CDR->CDR
LOAD32 R0 R0 4 ; Using EXP->CDR->CDR->CAR
CALLI R15 @eval ; Recurse to get result
POPR R2 R15 ; Restore R2
RET R15
;; process_setb
;; Receives Expression in R0 and an Environment in R1
;; Sets the desired variable to desired value/type
;; Returns the value/type in R0
:process_setb
PUSHR R2 R15 ; Protect R2
LOAD32 R2 R0 8 ; Protect EXP->CDR
LOAD32 R0 R2 8 ; Get EXP->CDR->CDR
LOAD32 R0 R0 4 ; Using EXP->CDR->CDR->CAR
CALLI R15 @eval ; Recurse to get New value
SWAP R0 R2 ; Protect New Value
LOAD32 R0 R0 4 ; Using EXP->CDR->CAR
CALLI R15 @assoc ; Get the associated Symbol
STORE32 R2 R0 8 ; SET Pair->CDR to New Value
MOVE R0 R2 ; Using New Value
POPR R2 R15 ; Restore R2
RET R15
;; process_let
;; Receives Expression in R0 and an Environment in R1
;; Creates lexical closure and evaluates inside of it
;; Returns the value/type in R0
:process_let
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
PUSHR R5 R15 ; Protect R5
LOADUI R4 $NIL ; Get NIL
MOVE R3 R1 ; Get ENV out of the way
MOVE R2 R0 ; Protect EXP
LOAD32 R5 R2 8 ; Get EXP->CDR
LOAD32 R5 R5 4 ; LETS = EXP->CDR->CAR
:process_let_0
CMPJUMPI.E R5 R4 @process_let_1
LOAD32 R0 R5 4 ; Get LETS->CAR
LOAD32 R0 R0 8 ; Get LETS->CAR->CDR
LOAD32 R0 R0 4 ; Get LETS->CAR->CDR->CAR
COPY R1 R3 ; Using ENV
CALLI R15 @eval ; CELL = EVAL(LETS->CAR->CDR->CAR, ENV)
MOVE R1 R0 ; Put CELL in the right place
LOAD32 R0 R5 4 ; Get LETS->CAR
LOAD32 R0 R0 4 ; Get LETS->CAR->CAR
CALLI R15 @make_cons ; CELL = MAKE_CONS(LETS->CAR->CAR, CELL)
COPY R1 R3 ; Using ENV
CALLI R15 @make_cons ; CELL = MAKE_CONS(CELL, ENV)
MOVE R3 R0 ; ENV = CELL
LOAD32 R5 R5 8 ; LETS = LETS->CDR
JUMP @process_let_0 ; Iterate through bindings
:process_let_1
MOVE R1 R3 ; Using ENV
LOAD32 R0 R2 8 ; Get EXP->CDR
LOAD32 R0 R0 8 ; Using EXP->CDR->CDR
CALLI R15 @progn ; Process inside of Closure
;; Cleanup
POPR R5 R15 ; Restore R5
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; process_cons
;; Receives Expression in R0 and an Environment in R1
;; Returns the evaluation of whatever special used or
;; The application of the evaluation in R0
:process_cons
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOAD32 R4 R0 4 ; Using EXP->CAR
LOADUI R3 $s_if ; Using s_if
CMPJUMPI.NE R4 R3 @process_cons_cond
CALLI R15 @process_if ; deal with special case of If statements
JUMP @process_cons_done ; Return it
:process_cons_cond
LOADUI R3 $s_cond ; Using s_cond
CMPJUMPI.NE R4 R3 @process_cons_begin
;; Deal with special case of COND statements
LOAD32 R0 R0 8 ; Using EXP->CDR
CALLI R15 @evcond ; EVCOND
JUMP @process_cons_done ; Simply use it's result
:process_cons_begin
LOADUI R3 $s_begin ; Using s_begin
CMPJUMPI.NE R4 R3 @process_cons_lambda
;; Deal with special case of BEGIN statements
LOAD32 R0 R0 8 ; Using EXP->CDR
CALLI R15 @progn ; PROGN
JUMP @process_cons_done ; Simply use it's result
:process_cons_lambda
LOADUI R3 $s_lambda ; Using s_lambda
CMPJUMPI.NE R4 R3 @process_cons_quote
;; Deal with special case of lambda statements
MOVE R2 R1 ; Put ENV in the right place
LOAD32 R1 R0 8 ; Get EXP->CDR
LOAD32 R0 R1 4 ; Using EXP->CDR->CAR
LOAD32 R1 R1 8 ; Using EXP->CDR->CDR
CALLI R15 @make_proc ; MAKE_PROC
JUMP @process_cons_done ; Simply return its result
:process_cons_quote
LOADUI R3 $s_quote ; Using s_quote
CMPJUMPI.NE R4 R3 @process_cons_define
;; Deal with special case of quote statements
LOAD32 R0 R0 8 ; Get EXP->CDR
LOAD32 R0 R0 4 ; Using EXP->CDR->CAR
JUMP @process_cons_done ; Simply use it as the result
:process_cons_define
LOADUI R3 $s_define ; Using s_define
CMPJUMPI.NE R4 R3 @process_cons_set
;; Deal with special case of Define statements
LOAD32 R2 R0 8 ; Using EXP->CDR
LOAD32 R0 R2 8 ; Get EXP->CDR->CDR
LOAD32 R0 R0 4 ; Using EXP->CDR->CDR->CAR
CALLI R15 @eval ; Recurse to figure out what it is
SWAP R2 R1 ; Put Environment in the right place
SWAP R1 R0 ; Put Evaluation in the right place
LOAD32 R0 R0 4 ; Using EXP->CDR->CAR
CALLI R15 @extend_env ; EXTEND_ENV
JUMP @process_cons_done ; Simply use what was returned
:process_cons_set
LOADUI R3 $s_setb ; Using s_setb
CMPJUMPI.NE R4 R3 @process_cons_let
CALLI R15 @process_setb ; Deal with special case of SET statements
JUMP @process_cons_done ; Simply Return Result
:process_cons_let
LOADUI R3 $s_let ; Using s_let
CMPJUMPI.NE R4 R3 @process_cons_apply
CALLI R15 @process_let ; Deal with special case of LET statements
JUMP @process_cons_done ; Simply Return Result
:process_cons_apply
;; Deal with the last option for a CONS, APPLY
LOAD32 R2 R0 4 ; Protect EXP->CAR
LOAD32 R0 R0 8 ; Using EXP->CDR
CALLI R15 @evlis ; EVLIS
SWAP R0 R2 ; Protect EVLIS result
CALLI R15 @eval ; Recurse to figure out what to APPLY
MOVE R1 R2 ; Put EVLIS result in right place
CALLI R15 @apply ; Apply what was found to the EVLIS result
:process_cons_done
POPR R4 R15 ; Restore R2
POPR R3 R15 ; Restore R2
POPR R2 R15 ; Restore R2
RET R15
;; prim_apply
;; Receives arglist in R0
;; Returns result of applying ARGS->CAR to ARGS->CDR->CAR
:prim_apply_String
"apply"
:prim_apply
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
LOAD32 R1 R0 8 ; Get ARGS->CDR
LOAD32 R1 R1 4 ; Get ARGS->CDR->CAR
LOAD32 R0 R0 4 ; Get ARGS->CAR
CALLI R15 @apply ; Use backing function
;; Cleanup
POPR R1 R15 ; Restore R1
RET R15
;; nullp
;; Receives a CELL in R0
;; Returns NIL if not NIL or TEE if NIL
:nullp_String
"null?"
:nullp
PUSHR R1 R15 ; Protect R1
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOADUI R1 $NIL ; Using NIL
CMPSKIPI.NE R0 $NIL ; If NIL Expression
LOADUI R1 $TEE ; Return TEE
MOVE R0 R1 ; Put result in correct register
POPR R1 R15 ; Restore R1
RET R15
;; prim_sum
;; Receives a list in R0
;; Adds all values and returns a Cell with result in R0
:prim_sum_String
"+"
:prim_sum
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
FALSE R2 ; Initialize our SUM at 0
:prim_sum_0
CMPJUMPI.E R0 R3 @prim_sum_done
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
ADD R2 R2 R1 ; sum = sum + value
JUMP @prim_sum_0 ; Go to next list item
:prim_sum_done
MOVE R0 R2 ; Put SUM in right spot
CALLI R15 @make_int ; Get our Cell
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_sub
;; Receives a list in R0
;; Subtracts all of the values and returns a Cell with the result in R0
:prim_sub_String
"-"
:prim_sub
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting SUM
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_sub_0
CMPJUMPI.E R0 R3 @prim_sub_done
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
SUB R2 R2 R1 ; sum = sum - value
JUMP @prim_sub_0 ; Go to next list item
:prim_sub_done
MOVE R0 R2 ; Put SUM in right spot
CALLI R15 @make_int ; Get our Cell
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_prod
;; Receives a list in R0
;; Multiplies all of the values and returns a Cell with the result in R0
:prim_prod_String
"*"
:prim_prod
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOADUI R2 1 ; Initialize our Product at 1
:prim_prod_0
CMPJUMPI.E R0 R3 @prim_prod_done
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
MUL R2 R2 R1 ; sum = sum + value
JUMP @prim_prod_0 ; Go to next list item
:prim_prod_done
MOVE R0 R2 ; Put SUM in right spot
CALLI R15 @make_int ; Get our Cell
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_div
;; Receives a list in R0
;; Divides all of the values and returns a Cell with the result in R0
:prim_div_String
"/"
:prim_div
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting SUM
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_div_0
CMPJUMPI.E R0 R3 @prim_div_done
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
DIV R2 R2 R1 ; sum = sum - value
JUMP @prim_div_0 ; Go to next list item
:prim_div_done
MOVE R0 R2 ; Put result in right spot
CALLI R15 @make_int ; Get our Cell
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_mod
;; Receives a list in R0
;; Remainders all of the values and returns a Cell with the result in R0
:prim_mod_String
"mod"
:prim_mod
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting SUM
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_mod_0
CMPJUMPI.E R0 R3 @prim_mod_done
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
MOD R2 R2 R1 ; sum = sum - value
JUMP @prim_mod_0 ; Go to next list item
:prim_mod_done
MOVE R0 R2 ; Put result in right spot
CALLI R15 @make_int ; Get our Cell
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_and
;; Receives a list in R0
;; ANDs all of the values and returns a Cell with the result in R0
:prim_and_String
"and"
:prim_and
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOADUI R4 $TEE ; Using TEE
LOADUI R3 $NIL ; Using NIL
:prim_and_0
CMPJUMPI.E R0 R3 @prim_and_done
LOAD32 R2 R0 4 ; Get ARGS->CAR
CMPJUMPI.NE R2 R4 @prim_and_1
LOAD32 R0 R0 8 ; Get ARGS->CDR
JUMP @prim_and_0 ; Go to next list item
:prim_and_1
COPY R2 R3 ; Return NIL
:prim_and_done
MOVE R0 R2 ; Put result in correct location
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_or
;; Receives a list in R0
;; ORs all of the values and returns a Cell with the result in R0
:prim_or_String
"or"
:prim_or
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOADUI R4 $TEE ; Using TEE
LOADUI R3 $NIL ; Using NIL
:prim_or_0
CMPJUMPI.E R0 R3 @prim_or_1
LOAD32 R2 R0 4 ; Get ARGS->CAR
CMPJUMPI.E R2 R4 @prim_or_done
LOAD32 R0 R0 8 ; Get ARGS->CDR
JUMP @prim_or_0 ; Go to next list item
:prim_or_1
COPY R2 R3 ; Couldn't find a true
:prim_or_done
MOVE R0 R2 ; Put result in correct location
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_not
;; Receives a list in R0
;; NOTs first of the values and returns a Cell with the result in R0
:prim_not_String
"not"
:prim_not
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
CMPSKIPI.E R0 $TEE ; If not TEE
JUMP @prim_not_0 ; Return TEE
LOADUI R0 $NIL ; Otherwise return NIL
JUMP @prim_not_done ; Return our NIL
:prim_not_0
LOADUI R0 $TEE ; Make TEE
:prim_not_done
RET R15
;; prim_numgt
;; Receives a list in R0
;; Compares values and returns a Cell with the result in R0
:prim_numgt_String
">"
:prim_numgt
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting Value
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_numgt_0
CMPJUMPI.E R0 R3 @prim_numgt_1
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
CMPJUMPI.LE R2 R1 @prim_numgt_2
MOVE R2 R1 ; Prepare for next loop
JUMP @prim_numgt_0 ; Go to next list item
:prim_numgt_1
LOADUI R0 $TEE ; Return TEE
JUMP @prim_numgt_done ; Be done
:prim_numgt_2
LOADUI R0 $NIL ; Return NIL
:prim_numgt_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_numge
;; Receives a list in R0
;; Compares values and returns a Cell with the result in R0
:prim_numge_String
">="
:prim_numge
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting Value
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_numge_0
CMPJUMPI.E R0 R3 @prim_numge_1
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
CMPJUMPI.L R2 R1 @prim_numge_2
MOVE R2 R1 ; Prepare for next loop
JUMP @prim_numge_0 ; Go to next list item
:prim_numge_1
LOADUI R0 $TEE ; Return TEE
JUMP @prim_numge_done ; Be done
:prim_numge_2
LOADUI R0 $NIL ; Return NIL
:prim_numge_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_numeq
;; Receives a list in R0
;; Compares values and returns a Cell with the result in R0
:prim_numeq_String
"="
:prim_numeq
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting Value
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_numeq_0
CMPJUMPI.E R0 R3 @prim_numeq_1
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
CMPJUMPI.NE R2 R1 @prim_numeq_2
MOVE R2 R1 ; Prepare for next loop
JUMP @prim_numeq_0 ; Go to next list item
:prim_numeq_1
LOADUI R0 $TEE ; Return TEE
JUMP @prim_numge_done ; Be done
:prim_numeq_2
LOADUI R0 $NIL ; Return NIL
:prim_numeq_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_numle
;; Receives a list in R0
;; Compares values and returns a Cell with the result in R0
:prim_numle_String
"<="
:prim_numle
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting Value
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_numle_0
CMPJUMPI.E R0 R3 @prim_numle_1
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
CMPJUMPI.G R2 R1 @prim_numle_2
MOVE R2 R1 ; Prepare for next loop
JUMP @prim_numle_0 ; Go to next list item
:prim_numle_1
LOADUI R0 $TEE ; Return TEE
JUMP @prim_numle_done ; Be done
:prim_numle_2
LOADUI R0 $NIL ; Return NIL
:prim_numle_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_numlt
;; Receives a list in R0
;; Compares values and returns a Cell with the result in R0
:prim_numlt_String
"<"
:prim_numlt
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADUI R3 $NIL ; Using NIL
LOAD32 R2 R0 4 ; Get ARGS->CAR
LOAD32 R2 R2 4 ; Using ARGS->CAR->CAR as starting Value
LOAD32 R0 R0 8 ; Using ARGS->CDR as args
:prim_numlt_0
CMPJUMPI.E R0 R3 @prim_numlt_1
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R1 R1 4 ; Get ARGS->CAR->CAR
LOAD32 R0 R0 8 ; Set ARGS to ARGS->CDR
CMPJUMPI.GE R2 R1 @prim_numlt_2
MOVE R2 R1 ; Prepare for next loop
JUMP @prim_numlt_0 ; Go to next list item
:prim_numlt_1
LOADUI R0 $TEE ; Return TEE
JUMP @prim_numlt_done ; Be done
:prim_numlt_2
LOADUI R0 $NIL ; Return NIL
:prim_numlt_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_listp
;; Receives a list in R0
;; Compares values and returns a Cell with the result in R0
:prim_listp_String
"list?"
:prim_listp
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R0 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R0 16 ; If CONS
JUMP @prim_listp_0 ; Return TEE
LOADUI R0 $NIL ; Otherwise return NIL
JUMP @prim_listp_done ; Return our NIL
:prim_listp_0
LOADUI R0 $TEE ; Make TEE
:prim_listp_done
RET R15
;; prim_charp
;; Receives argslist in R0
;; Returns #t if CHAR else NIL
:prim_charp_String
"char?"
:prim_charp
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R0 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R0 128 ; If CHAR
JUMP @prim_charp_0 ; Return TEE
LOADUI R0 $NIL ; Otherwise return NIL
JUMP @prim_charp_done
:prim_charp_0
LOADUI R0 $TEE ; Make TEE
:prim_charp_done
RET R15
;; prim_numberp
;; Receives argslist in R0
;; Returns #t if NUMBER else NIL
:prim_numberp_String
"number?"
:prim_numberp
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R0 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R0 4 ; If NUMBER
JUMP @prim_numberp_0 ; Return TEE
LOADUI R0 $NIL ; Otherwise return NIL
JUMP @prim_numberp_done
:prim_numberp_0
LOADUI R0 $TEE ; Make TEE
:prim_numberp_done
RET R15
;; prim_symbolp
;; Receives argslist in R0
;; Returns #t if SYMBOL else NIL
:prim_symbolp_String
"symbol?"
:prim_symbolp
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R0 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R0 8 ; If SYMBOL
JUMP @prim_symbolp_0 ; Return TEE
LOADUI R0 $NIL ; Otherwise return NIL
JUMP @prim_symbolp_done
:prim_symbolp_0
LOADUI R0 $TEE ; Make TEE
:prim_symbolp_done
RET R15
;; prim_stringp
;; Receives argslist in R0
;; Returns #t if CHAR else NIL
:prim_stringp_String
"string?"
:prim_stringp
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R0 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R0 256 ; If CHAR
JUMP @prim_stringp_0 ; Return TEE
LOADUI R0 $NIL ; Otherwise return NIL
JUMP @prim_stringp_done
:prim_stringp_0
LOADUI R0 $TEE ; Make TEE
:prim_stringp_done
RET R15
;; prim_output
;; Receives argslist in R0
;; Outputs to whatever is specified in R12 and returns TEE
:prim_output
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOADUI R4 $NIL ; Using NIL
COPY R1 R12 ; Set to use desired output
:prim_output_0
CMPJUMPI.E R0 R4 @prim_output_done
LOAD32 R3 R0 4 ; Get ARGS->CAR
LOAD32 R2 R3 0 ; Get ARGS->CAR->TYPE
SWAP R0 R3 ; Protect ARGS
CMPSKIPI.NE R2 4 ; If INT
CALLI R15 @prim_output_INT ; Print the value
CMPSKIPI.NE R2 8 ; If SYM
CALLI R15 @prim_output_SYM ; Print the string
CMPSKIPI.NE R2 16 ; If CONS
CALLI R15 @prim_output ; Recurse
CMPSKIPI.NE R2 128 ; If CHAR
CALLI R15 @prim_output_CHAR ; Just print the last Char
LOAD32 R0 R3 8 ; Get ARGS->CDR
JUMP @prim_output_0 ; Loop until we hit NIL
:prim_output_done
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
LOADUI R0 $TEE ; Return TEE
RET R15
;; prim_output_INT
;; Receives an INT CELL in R0 and desired Output in R1
;; Outputs value and returns
:prim_output_INT
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
LOAD32 R0 R0 4 ; Get ARG->CAR
CALLI R15 @Write_Int ; Write it
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; prim_output_SYM
;; Receives a SYM CELL in R0 and desired Output in R1
;; Outputs string and returns
:prim_output_SYM
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
LOAD32 R0 R0 4 ; Get ARG->CAR
CALLI R15 @Print_String ; Print the string
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; prim_output_CHAR
;; Receives an CHAR CELL in R0 and desired Output in R1
;; Outputs Last CHAR and returns
:prim_output_CHAR
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
LOADU8 R0 R0 7 ; Get ARG->CAR [bottom 8 bits]
FPUTC ; Display desired CHAR
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; prim_stringeq
;; Receives a list in R0
;; Compares strings and returns a Cell with the result in R0
:prim_stringeq_String
"string=?"
:prim_stringeq
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOADUI R3 $NIL ; Using NIL
LOAD32 R1 R0 4 ; Get ARGS->CAR
LOAD32 R4 R1 4 ; Using ARGS->CAR->CAR as TEMP
LOAD32 R2 R0 8 ; Using ARGS->CDR as args
:prim_stringeq_0
CMPJUMPI.E R2 R3 @prim_stringeq_1
LOAD32 R0 R2 4 ; Get ARGS->CAR
LOAD32 R0 R0 4 ; Get ARGS->CAR->CAR
COPY R1 R4 ; Restore TEMP for string comparison
CALLI R15 @strcmp ; Compare the strings
JUMP.NE R0 @prim_stringeq_2 ; Stop if not equal
LOAD32 R2 R2 8 ; Set ARGS to ARGS->CDR
JUMP @prim_stringeq_0 ; Go to next list item
:prim_stringeq_1
LOADUI R0 $TEE ; Return TEE
JUMP @prim_stringeq_done ; Be done
:prim_stringeq_2
LOADUI R0 $NIL ; Return NIL
:prim_stringeq_done
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_display
;; Receives argslist in R0
;; Outputs to TTY R12 and returns TEE
:prim_display_String
"display"
:prim_display
CALLI R15 @prim_output
RET R15
;; prim_write
;; Receives argslist in R0
;; Write to Tape_02 and returns TEE
:prim_write_String
"write"
:prim_write
LOADUI R12 0x1101 ; Write to Tape_02
CALLI R15 @prim_output ; Use shared prim_output
FALSE R12 ; Revert to TTY
RET R15
;; prim_freecell
;; Receives either NIL or a list in R0
;; If NIL displays header, otherwise just returns number of free cells in R0
:prim_freecell_String
"free_mem"
:prim_freecell
PUSHR R1 R15 ; Protect R1
CMPSKIPI.E R0 $NIL ; If NOT NIL
JUMP @prim_freecell_0 ; Skip message
LOADUI R0 $prim_freecell_Message
COPY R1 R12 ; Using Selected Output
CALLI R15 @Print_String ; Display our header
:prim_freecell_0
CALLI R15 @cells_remaining ; Get number of remaining Cells
CALLI R15 @make_int ; Convert integer in R0 to a Cell
:prim_freecell_done
POPR R1 R15 ; Restore R1
RET R15
:prim_freecell_Message
"Remaining Cells: "
;; prim_integer_to_char
;; Receives a list in R0
;; Converts INT to CHAR
:prim_integer_to_char_String
"integer->char"
:prim_integer_to_char
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
LOADUI R2 128 ; Using Type CHAR
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R1 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R1 4 ; If Type INT
STORE32 R2 R0 0 ; Update ARGS->CAR->TYPE
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_char_to_integer
;; Receives a list in R0
;; Converts CHAR to INT
:prim_char_to_integer_String
"char->integer"
:prim_char_to_integer
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
LOADUI R2 4 ; Using Type INT
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R1 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R1 128 ; If Type CHAR
STORE32 R2 R0 0 ; Update ARGS->CAR->TYPE
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; string_to_list
;; Receives a pointer to string in R0
;; Returns a list of chars
:string_to_list
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
MOVE R1 R0 ; Put string safely out of the way
LOAD8 R0 R1 0 ; Get string[0]
JUMP.Z R0 @string_to_list_null
CALLI R15 @make_char ; Make seperate CHAR
SWAP R0 R1 ; Protect RESULT
ADDUI R0 R0 1 ; Increment to next iteration
CALLI R15 @string_to_list ; Recurse down STRING
SWAP R0 R1 ; Put RESULT and TAIL in right spot
CALLI R15 @make_cons ; Combine into a Cons
JUMP @string_to_list_done ; And simply return result
:string_to_list_null
LOADUI R0 $NIL ; Nil terminate list
:string_to_list_done
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_string_to_list
;; Receives a pointer to a CONS whose CAR should be a STRING
;; Returns a list of CHARs in R0
:prim_string_to_list_String
"string->list"
:prim_string_to_list
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R1 R0 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.E R1 256 ; If Not Type STRING
JUMP @prim_string_to_list_fail
LOAD32 R0 R0 4 ; Get ARGS->CAR->STRING
CALLI R15 @string_to_list ; Convert to List
JUMP @prim_string_to_list_done
:prim_string_to_list_fail
LOADUI R0 $NIL ; Nil terminate list
:prim_string_to_list_done
POPR R1 R15 ; Restore R1
RET R15
;; list_to_string
;; Receives an index in R0, a String pointer in R1
;; And a list of arguments in R2
;; Alters only R0
:list_to_string
CMPSKIPI.NE R2 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
:list_to_string_0
CMPSKIPI.NE R2 $NIL ; If NIL Expression
JUMP @list_to_string_done ; We are done
LOAD32 R4 R2 4 ; Get ARGS->CAR
LOAD32 R3 R4 0 ; Get ARGS->CAR->TYPE
CMPSKIPI.NE R3 128 ; If Type CHAR
CALLI R15 @list_to_string_CHAR ; Process
;; Guess CONS
SWAP R2 R4 ; Put i->CAR in i's spot
CMPSKIPI.NE R3 16 ; If Type CONS
CALLI R15 @list_to_string ; Recurse
SWAP R2 R4 ; Undo the Guess
;; Everything else just iterate
LOAD32 R2 R2 8 ; i = i->CDR
JUMP @list_to_string_0 ; Lets go again
:list_to_string_CHAR
LOAD32 R3 R4 4 ; Get ARGS->CAR->VALUE
STOREX8 R3 R0 R1 ; STRING[INDEX] = i->CAR->VALUE
ADDUI R0 R0 1 ; INDEX = INDEX + 1
RET R15 ; Get back in there
:list_to_string_done
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_list_to_string
;; Receives a list in R0
;; Returns a String CELL in R0
:prim_list_to_string_String
"list->string"
:prim_list_to_string
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
MOVE R2 R0 ; Put Args in correct location and Zero R0
CALLI R15 @malloc ; Get where space is free
MOVE R1 R0 ; Put String pointer in correct location and Zero R0
CALLI R15 @list_to_string ; Call backing function
ADDUI R0 R0 1 ; NULL Terminate string
CALLI R15 @malloc ; Correct malloc
CALLI R15 @make_string ; Use pointer to make our string CELL
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; prim_halt
;; Simply HALTS
:prim_halt_String
"HALT"
:prim_halt
LOADUI R0 0x1101 ; Clean up after ourselves
FCLOSE ; Close our write tape
HALT
;; prim_list
;; Simply returns the argument list passed to it in R0
:prim_list_String
"list"
:prim_list
RET R15
;; prim_cons
;; Receives an arglist in R0 and returns a CONS in R0
:prim_cons_String
"cons"
:prim_cons
PUSHR R1 R15 ; Protect R1
LOAD32 R1 R0 8 ; Get ARGS->CDR
LOAD32 R1 R1 4 ; Use ARGS->CDR->CAR
LOAD32 R0 R0 4 ; Use ARGS->CAR
CALLI R15 @make_cons ; MAKE_CONS
POPR R1 R15 ; Restore R1
RET R15
;; prim_car
;; Receives an arglist in R0 and returns the CAR in R0
:prim_car_String
"car"
:prim_car
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R0 R0 4 ; Using ARGS->CAR->CAR
RET R15
;; prim_cdr
;; Receives an arglist in R0 and returns the CDR in R0
:prim_cdr_String
"cdr"
:prim_cdr
CMPSKIPI.NE R0 $NIL ; If NIL Expression
RET R15 ; Just get the Hell out
LOAD32 R0 R0 4 ; Get ARGS->CAR
LOAD32 R0 R0 8 ; Using ARGS->CAR->CDR
RET R15
;; spinup
;; Receives a symbol in R0 and a primitive in R1
;; Returns nothing but CONS both to all_symbols and top_env
:spinup
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
COPY R3 R0 ; Protect SYM
MOVE R2 R1 ; Put PRIM in right Spot
LOADR R1 @all_symbols ; Get ALL_SYMBOLS
CALLI R15 @make_cons ; MAKE_CONS
STORER R0 @all_symbols ; Update ALL_SYMBOLS
MOVE R1 R3 ; Restore SYM
LOADR R0 @top_env ; Get TOP_ENV
CALLI R15 @extend ; EXTEND
STORER R0 @top_env ; Update TOP_ENV
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; Special symbols
;; NIL Object
:NIL
'00000008' ; A Symbol
&NIL_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:NIL_String
"nil"
;; TEE Object
:TEE
'00000008' ; A Symbol
&TEE_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:TEE_String
"#t"
;; Quote Object
:s_quote
'00000008' ; A Symbol
&s_quote_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_quote_String
"quote"
;; IF Object
:s_if
'00000008' ; A Symbol
&s_if_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_if_String
"if"
;; COND Object
:s_cond
'00000008' ; A Symbol
&s_cond_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_cond_String
"cond"
;; Lambda Object
:s_lambda
'00000008' ; A Symbol
&s_lambda_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_lambda_String
"lambda"
;; Define Object
:s_define
'00000008' ; A Symbol
&s_define_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_define_String
"define"
;; SET Object
:s_setb
'00000008' ; A Symbol
&s_setb_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_setb_String
"set!"
;; LET Object
:s_let
'00000008' ; A Symbol
&s_let_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_let_String
"let"
;; Begin Object
:s_begin
'00000008' ; A Symbol
&s_begin_String ; Pointer to string
'00000000' ; NUL CDR
'00000000' ; NUL ENV
:s_begin_String
"begin"
;; Globals of interest
:all_symbols
&all_symbols_init
:all_symbols_init
'00000010' ; A CONS
&NIL ; Pointer to NIL
&NIL ; Pointer to NIL
'00000000' ; NULL
:top_env
&top_env_init_1
:top_env_init_0
'00000010' ; A CONS
&NIL ; Pointer to NIL
&NIL ; Pointer to NIL
'00000000' ; NULL
:top_env_init_1
'00000010' ; A CONS
&top_env_init_0 ; Pointer to CONS of NIL
&NIL ; Pointer to NIL
'00000000' ; NULL
:free_cells
NOP ; Start with NULL
;; Global init function
;; Receives nothing
;; Returns nothing
;; sets up all_symbols and top_env
:init_sl3
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
;; Add Eval Specials
LOADUI R0 $TEE ; Get TEE
COPY R1 R0 ; Duplicate TEE
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_quote ; Get s_quote
COPY R1 R0 ; Duplicate s_quote
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_if ; Get s_if
COPY R1 R0 ; Duplicate s_if
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_cond ; Get s_cond
COPY R1 R0 ; Duplicate s_cond
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_lambda ; Get s_lambda
COPY R1 R0 ; Duplicate s_lambda
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_define ; Get s_define
COPY R1 R0 ; Duplicate s_define
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_setb ; Get s_setb
COPY R1 R0 ; Duplicate s_setb
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_let ; Get s_let
COPY R1 R0 ; Duplicate s_let
CALLI R15 @spinup ; SPINUP
LOADUI R0 $s_begin ; Get s_begin
COPY R1 R0 ; Duplicate s_if
CALLI R15 @spinup ; SPINUP
;; Add Primitive Specials
LOADUI R0 $prim_apply ; Using PRIM_APPLY
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_apply_String ; Using PRIM_APPLY_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $nullp ; Using NULLP
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $nullp_String ; Using NULLP_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_sum ; Using PRIM_SUM
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_sum_String ; Using PRIM_SUM_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_sub ; Using PRIM_SUB
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_sub_String ; Using PRIM_SUB_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_prod ; Using PRIM_PROD
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_prod_String ; Using PRIM_PROD_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_div ; Using PRIM_DIV
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_div_String ; Using PRIM_DIV_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_mod ; Using PRIM_MOD
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_mod_String ; Using PRIM_MOD_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_and ; Using PRIM_AND
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_and_String ; Using PRIM_AND_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_or ; Using PRIM_OR
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_or_String ; Using PRIM_OR_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_not ; Using PRIM_NOT
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_not_String ; Using PRIM_NOT_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_numgt ; Using PRIM_NUMGT
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_numgt_String ; Using PRIM_NUMGT_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_numge ; Using PRIM_NUMGE
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_numge_String ; Using PRIM_NUMGE_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_numeq ; Using PRIM_NUMEQ
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_numeq_String ; Using PRIM_NUMEQ_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_numle ; Using PRIM_NUMLE
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_numle_String ; Using PRIM_NUMLE_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_numlt ; Using PRIM_NUMLT
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_numlt_String ; Using PRIM_NUMLT_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_listp ; Using PRIM_LISTP
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_listp_String ; Using PRIM_LISTP_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_charp ; Using PRIM_CHARP
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_charp_String ; Using PRIM_CHARP_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_numberp ; Using PRIM_NUMBERP
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_numberp_String ; Using PRIM_NUMBERP_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_symbolp ; Using PRIM_SYMBOLP
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_symbolp_String ; Using PRIM_SYMBOLP_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_stringp ; Using PRIM_STRINGP
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_stringp_String ; Using PRIM_STRINGP_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_display ; Using PRIM_DISPLAY
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_display_String ; Using PRIM_DISPLAY_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_write ; Using PRIM_WRITE
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_write_String ; Using PRIM_WRITE_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_freecell ; Using PRIM_FREECELL
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_freecell_String ; Using PRIM_FREECELL_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_integer_to_char ; Using PRIM_INTEGER_TO_CHAR
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_integer_to_char_String ; Using PRIM_INTEGER_TO_CHAR_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_char_to_integer ; Using PRIM_CHAR_TO_INTEGER
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_char_to_integer_String ; Using PRIM_CHAR_TO_INTEGER_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_string_to_list ; Using PRIM_STRING_TO_LIST
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_string_to_list_String ; Using PRIM_STRING_TO_LIST_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_list_to_string ; Using PRIM_LIST_TO_STRING
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_list_to_string_String ; Using PRIM_LIST_TO_STRING_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_halt ; Using PRIM_HALT
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_halt_String ; Using PRIM_HALT_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_list ; Using PRIM_list
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_list_String ; Using PRIM_LIST_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_stringeq ; Using PRIM_STRINGEQ
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_stringeq_String ; Using PRIM_STRINGEQ_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_cons ; Using PRIM_CONS
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_cons_String ; Using PRIM_CONS_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_car ; Using PRIM_CAR
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_car_String ; Using PRIM_CAR_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
LOADUI R0 $prim_cdr ; Using PRIM_CDR
CALLI R15 @make_prim ; MAKE_PRIM
MOVE R1 R0 ; Put Primitive in correct location
LOADUI R0 $prim_cdr_String ; Using PRIM_CDR_STRING
CALLI R15 @make_sym ; MAKE_SYM
CALLI R15 @spinup ; SPINUP
;; Clean up
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; Left_to_take
;; The number of cells_remaining
:left_to_take
NOP
;; cells_remaining
;; Receives nothing and returns number of remaining cells in R0
:cells_remaining
LOADR R0 @left_to_take ; Get number of cells left
RET R15
;; update_remaining
;; Receives nothing
;; Returns nothing
;; Updates left_to_take via counting
:update_remaining
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
LOADR R0 @free_cells ; Get FREE_CELLS
FALSE R1 ; Set Count to 0
:update_remaining_0
JUMP.Z R0 @update_remaining_done
ADDUI R1 R1 1 ; Increment by 1
LOAD32 R0 R0 8 ; get I->CDR
JUMP @update_remaining_0 ; Keep looping til NULL
:update_remaining_done
STORER R1 @left_to_take ; update left_to_take
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; gc_block_start
:gc_block_start
&Start_CONS
;; top_allocated
:top_allocated
'000FFFF0'
;; insert_ordered
;; Receives a cell and a list of cells in R0 and R1
;; Inserts cell into the list from lowest to highest
;; Returns resulting list in R0
:insert_ordered
CMPSKIPI.NE R1 0 ; If List is NULL
RET R15 ; Just return CELL
CMPJUMPI.GE R0 R1 @insert_ordered_0
STORE32 R1 R0 8 ; Set I->CDR to LIST
RET R15 ; Simply return I
:insert_ordered_0
PUSHR R1 R15 ; Protect List from recursion
LOAD32 R1 R1 8 ; Using LIST->CDR
CALLI R15 @insert_ordered ; Recurse
POPR R1 R15 ; Restore LIST
STORE32 R0 R1 8 ; Set LIST->CDR to the result of recursion
MOVE R0 R1 ; Prepare for return
RET R15
;; reclaim_marked
;; Receives nothing
;; Returns nothing
;; Reclaims and updates free_cells
:reclaim_marked
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADR R3 @gc_block_start ; Using GC_BLOCK_START
LOADR R2 @top_allocated ; Using TOP_ALLOCATED
:reclaim_marked_0
CMPJUMPI.LE R2 R3 @reclaim_marked_done
LOAD32 R1 R2 0 ; Get I->TYPE
ANDI R1 R1 2 ; AND with MARKED
JUMP.Z R1 @reclaim_marked_1 ; Deal with MARKED CELLS or jump on NULL
;; Deal with Marked
LOADUI R0 1 ; Using FREE
STORE32 R0 R2 0 ; Set I->TYPE to FREE
FALSE R0 ; USING NULL
STORE32 R0 R2 4 ; SET I->CAR to NULL
STORE32 R0 R2 12 ; SET I->ENV to NULL
COPY R0 R2 ; Prepare for INSERT_ORDERED
LOADR R1 @free_cells ; Get FREE_CELLS
CALLI R15 @insert_ordered ; Get New FREE_CELLS Pointer
STORER R0 @free_cells ; Update FREE_CELLS to I
;; Deal with unmarked
:reclaim_marked_1
SUBUI R2 R2 16 ; Decrement I by the size of a CELL
JUMP @reclaim_marked_0 ; Iterate on next CELL
:reclaim_marked_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; mark_all_cells
;; Receives nothing
;; Returns nothing
;; Marks all unfree cells
:mark_all_cells
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
LOADR R0 @gc_block_start ; Using GC_BLOCK_START
LOADR R1 @top_allocated ; Using TOP_ALLOCATED
:mark_all_cells_0
CMPJUMPI.GE R0 R1 @mark_all_cells_done
LOAD32 R2 R0 0 ; Get I->TYPE
CMPSKIPI.NE R2 1 ; If NOT FREE
JUMP @mark_all_cells_1 ; Move onto the Next
;; Mark non-free cell
ORI R2 R2 2 ; Add MARK
STORE32 R2 R0 0 ; Write out MARK
:mark_all_cells_1
ADDUI R0 R0 16 ; Increment I by the size of a CELL
JUMP @mark_all_cells_0 ; Iterate on next CELL
:mark_all_cells_done
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; unmark_cells
;; Receives a List in R0 and R1 and a Count in R2
;; Returns nothing
;; Unmarks all connected Cells
:unmark_cells
CMPSKIPI.LE R2 2 ; If Greater than 1
RET R15 ; Just return
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
PUSHR R3 R15 ; Protect R3
PUSHR R4 R15 ; Protect R4
LOADUI R4 2 ; GET MARKED
NOT R4 R4 ; Use ~MARKED
:unmark_cells_0
JUMP.Z R0 @unmark_cells_done
CMPSKIP.NE R0 R1 ; If LIST == STOP
ADDUI R2 R2 1 ; Increment Count
LOAD32 R3 R0 0 ; Get I->TYPE
AND R3 R3 R4 ; Remove MARK
STORE32 R3 R0 0 ; Store the cleaned type
;; Deal with CONS
CMPSKIPI.NE R3 16 ; If A CONS
JUMP @unmark_cells_cons ; Deal with it
;; Deal with PROC
CMPSKIPI.NE R3 32 ; If A PROC
JUMP @unmark_cells_proc ; Deal with it
;; Everything else
JUMP @unmark_cells_1 ; Move onto NEXT
:unmark_cells_proc
LOAD32 R3 R0 12 ; Using list->ENV
CMPSKIPI.NE R3 0 ; If NULL
JUMP @unmark_cells_cons ; Skip
SWAP R0 R3 ; Protect list
CALLI R15 @unmark_cells ; Recurse until the ends
SWAP R0 R3 ; Put list back
:unmark_cells_cons
LOAD32 R3 R0 4 ; Using list->CAR
SWAP R0 R3 ; Protect list
CALLI R15 @unmark_cells ; Recurse until the ends
SWAP R0 R3 ; Put list back
:unmark_cells_1
LOAD32 R0 R0 8 ; Get list->CDR
JUMP @unmark_cells_0 ; Keep going down list
:unmark_cells_done
POPR R4 R15 ; Restore R4
POPR R3 R15 ; Restore R3
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; relocate_cell
;; Receives a current, target and List in R0, R1 and R2
;; Returns nothing
;; Relocate all references to a cell and walks down list
:relocate_cell
PUSHR R3 R15 ; Protect R3
:relocate_cell_0
JUMP.Z R2 @relocate_cell_done
;; Fix CAR References
LOAD32 R3 R2 4 ; Get LIST->CAR
CMPSKIP.NE R0 R3 ; If match with Current
STORE32 R1 R2 4 ; Fix LIST->CAR
;; Fix CDR References
LOAD32 R3 R2 8 ; Get LIST->CDR
CMPSKIP.NE R0 R3 ; If match with Current
STORE32 R1 R2 8 ; Fix LIST->CDR
;; Fix ENV References
LOAD32 R3 R2 12 ; Get LIST->ENV
CMPSKIP.NE R0 R3 ; If match with Current
STORE32 R1 R2 12 ; Fix LIST->ENV
LOAD32 R3 R2 0 ; Get LIST->TYPE
;; Deal with CONS
CMPSKIPI.NE R3 16 ; If A CONS
JUMP @relocate_cell_proc ; Deal with it
;; Deal with PROC
CMPSKIPI.NE R3 32 ; If A PROC
JUMP @relocate_cell_proc ; Deal with it
;; Everything else
JUMP @relocate_cell_1 ; Move onto NEXT
:relocate_cell_proc
PUSHR R2 R15 ; Protect LIST
LOAD32 R2 R2 4 ; Using list->CAR
CALLI R15 @relocate_cell ; Recurse until the ends
POPR R2 R15 ; Restore LIST
:relocate_cell_1
LOAD32 R2 R2 8 ; Get list->CDR
JUMP @relocate_cell_0 ; Keep going down list
:relocate_cell_done
POPR R3 R15 ; Restore R3
RET R15
;; compact
;; Receives a List in R0
;; Returns nothing
;; Finds cells to relocate and has all references updated
:compact
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
:compact_0
JUMP.Z R0 @compact_done
LOAD32 R2 R0 0 ; Get LIST->TYPE
CMPSKIPI.NE R2 1 ; If LIST->TYPE == FREE
JUMP @compact_1 ; Not worth relocating
LOADR R1 @free_cells ; Get FREE_CELLS
CMPJUMPI.LE R0 R1 @compact_1 ; Don't bother to relocate if Low
;; Found a better place for cell
SWAP R0 R1 ; Get LIST out of the way
CALLI R15 @pop_cons ; Get our New location
SWAP R0 R1 ; Put in correct order
;; Update temp to LIST
LOAD32 R2 R0 0 ; Get LIST->TYPE
STORE32 R2 R1 0 ; Set TEMP->TYPE
LOAD32 R2 R0 4 ; GET LIST->CAR
STORE32 R2 R1 4 ; Set TEMP->CAR
LOAD32 R2 R0 8 ; GET LIST->CDR
STORE32 R2 R1 8 ; Set TEMP->CDR
LOAD32 R2 R0 12 ; GET LIST->ENV
STORE32 R2 R1 12 ; Set TEMP->ENV
;; Fix Reference in Symbols list
LOADR R2 @all_symbols
CALLI R15 @relocate_cell
;; Fix References in Environment list
LOADR R2 @top_env
CALLI R15 @relocate_cell
LOAD32 R2 R0 0 ; Get LIST->TYPE
:compact_1
;; Deal with CONS
CMPSKIPI.NE R2 16 ; If A CONS
JUMP @compact_proc ; Deal with it
;; Deal with PROC
CMPSKIPI.NE R2 32 ; If A PROC
JUMP @compact_proc ; Deal with it
;; Everything else
JUMP @compact_2 ; Move onto NEXT
:compact_proc
PUSHR R0 R15 ; Protect LIST
LOAD32 R0 R0 4 ; Using list->CAR
CALLI R15 @compact ; Recurse until the ends
POPR R0 R15 ; Restore LIST
:compact_2
LOAD32 R0 R0 8 ; Get list->CDR
JUMP @compact_0 ; Keep going down list
:compact_done
POPR R2 R15 ; Restore R2
POPR R1 R15 ; Restore R1
RET R15
;; garbage_collect
;; Receives nothing
;; Returns nothing
;; The Core of Garbage Collection
:garbage_collect
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
PUSHR R2 R15 ; Protect R2
CALLI R15 @mark_all_cells ; MARK_ALL_CELLS
LOADR R0 @all_symbols ; Using ALL_SYMBOLS
COPY R1 R0 ; Using it as STOP
FALSE R2 ; Setting Counter to 0
CALLI R15 @unmark_cells ; UNMARK ALL_SYMBOLS
LOADR R0 @top_env ; Using TOP_ENV
COPY R1 R0 ; Using it as STOP
FALSE R2 ; Setting Counter to 0
CALLI R15 @unmark_cells ; UNMARK TOP_ENV
CALLI R15 @reclaim_marked ; RECLAIM_MARKED
CALLI R15 @update_remaining ; Fix the Count
LOADR R0 @all_symbols ; Using Symbols list
CALLI R15 @compact ; Compact
LOADR R0 @top_env ; Using TOP_ENV
CALLI R15 @compact ; Compact
FALSE R0 ; Using NULL
STORER R0 @top_allocated ; Clear TOP_ALLOCATED
POPR R2 R15 ; Restore R
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; garbage_init
;; Receives nothing
;; Returns nothing
;; Initializes Garbage Heap
:garbage_init
PUSHR R0 R15 ; Protect R0
PUSHR R1 R15 ; Protect R1
LOADR R0 @gc_block_start ; Get Starting Offset
ANDI R0 R0 0xF ; We only need the buttom 4 Bits
LOADR R1 @top_allocated ; Get End Address
ADD R1 R1 R0 ; Add the Offset
SUBUI R1 R1 16 ; Shift Back Down
STORER R1 @top_allocated ; Update Block End
CALLI R15 @mark_all_cells ; MARK_ALL_CELLS
CALLI R15 @reclaim_marked ; RECLAIM_MARKED
CALLI R15 @update_remaining ; Fix the Count
FALSE R0 ; Using NULL
STORER R0 @top_allocated ; Clear TOP_ALLOCATED
POPR R1 R15 ; Restore R1
POPR R0 R15 ; Restore R0
RET R15
;; pop_cons
;; Receives nothing
;; Returns a Free CONS in R0
;; Updates left_to_take
:pop_cons
PUSHR R1 R15 ; Protect R1
LOADR R0 @free_cells ; Get First Free Cell
JUMP.Z R0 @pop_cons_error ; If NULL BURN with FIRE
LOAD32 R1 R0 8 ; Get I->CDR
STORER R1 @free_cells ; Update FREE_CELLS
FALSE R1 ; Using NULL
STORE32 R1 R0 8 ; SET I->CDR to NULL
LOADR R1 @top_allocated ; Get top allocation
CMPSKIP.LE R0 R1 ; Skip if I <= TOP_ALLOCATED
STORER R0 @top_allocated ; Update TOP_ALLOCATED to new highest allocation
LOADR R1 @left_to_take ; Get LEFT_TO_TAKE
SUBUI R1 R1 1 ; Decrement by 1
STORER R1 @left_to_take ; Update LEFT_TO_TAKE
POPR R1 R15 ; Restore R1
RET R15
:pop_cons_error
LOADUI R0 $pop_cons_Message ; Using Message
FALSE R1 ; Using TTY
CALLI R15 @Print_String ; Display ERROR
HALT ; Burn with FIRE
:pop_cons_Message
"OOOPS we ran out of cells"
;; make_int
;; Receives an Integer in R0
;; Returns a CELL in R0
:make_int
PUSHR R1 R15 ; Protect R1
MOVE R1 R0 ; Protect Integer
CALLI R15 @pop_cons ; Get a CELL
STORE32 R1 R0 4 ; Set C->CAR
LOADUI R1 4 ; Using INT
STORE32 R1 R0 0 ; Set C->TYPE
POPR R1 R15 ; Restore R1
RET R15
;; make_char
;; Receives a CHAR in R0
;; Returns a CELL in R0
:make_char
PUSHR R1 R15 ; Protect R1
MOVE R1 R0 ; Protect Integer
CALLI R15 @pop_cons ; Get a CELL
STORE32 R1 R0 4 ; Set C->CAR
LOADUI R1 128 ; Using CHAR
STORE32 R1 R0 0 ; Set C->TYPE
POPR R1 R15 ; Restore R1
RET R15
;; make_string
;; Receives a string pointer in R0
;; Returns a CELL in R0
:make_string
PUSHR R1 R15 ; Protect R1
MOVE R1 R0 ; Protect Integer
CALLI R15 @pop_cons ; Get a CELL
STORE32 R1 R0 4 ; Set C->CAR
LOADUI R1 256 ; Using STRING
STORE32 R1 R0 0 ; Set C->TYPE
POPR R1 R15 ; Restore R1
RET R15
;; make_sym
;; Receives a string pointer in R0
;; Returns a Cell in R0
:make_sym
PUSHR R1 R15 ; Protect R1
MOVE R1 R0 ; Protect String Pointer
CALLI R15 @pop_cons ; Get a CELL
STORE32 R1 R0 4 ; Set C->CAR
LOADUI R1 8 ; Using SYM
STORE32 R1 R0 0 ; Set C->TYPE
POPR R1 R15 ; Restore R1
RET R15
;; make_cons
;; Receives a Cell in R0 and R1
;; Returns a combined Cell in R0
:make_cons
PUSHR R2 R15 ; Protect R2
MOVE R2 R0 ; Protect CELL A
CALLI R15 @pop_cons ; Get a CELL
STORE32 R2 R0 4 ; Set C->CAR
STORE32 R1 R0 8 ; SET C->CDR
LOADUI R2 16 ; Using CONS
STORE32 R2 R0 0 ; Set C->TYPE
POPR R2 R15 ; Restore R2
RET R15
;; make_proc
;; Receives Cells in R0, R1 and R2
;; Returns a combined Cell in R0
:make_proc
PUSHR R3 R15 ; Protect R3
MOVE R3 R0 ; Protect CELL
CALLI R15 @pop_cons ; Get a CELL
STORE32 R3 R0 4 ; Set C->CAR
STORE32 R1 R0 8 ; Set C->CDR
STORE32 R2 R0 12 ; Set C->ENV
LOADUI R3 32 ; Using PROC
STORE32 R3 R0 0 ; Set C->TYPE
POPR R3 R15 ; Restore R3
RET R15
;; make_prim
;; Receives pointer to function in R0
;; Returns a Cell in R0
:make_prim
PUSHR R1 R15 ; Protect R1
MOVE R1 R0 ; Protect Function Pointer
CALLI R15 @pop_cons ; Get a CELL
STORE32 R1 R0 4 ; Set C->CAR
LOADUI R1 64 ; Using PRIMOP
STORE32 R1 R0 0 ; Set C->TYPE
POPR R1 R15 ; Restore R1
RET R15
;; CONS starts at the end of the program
:Start_CONS
mescc-tools-Release_1.3/test/test4/ 0000775 0000000 0000000 00000000000 14126326331 0017270 5 ustar 00root root 0000000 0000000 mescc-tools-Release_1.3/test/test4/.gitignore 0000664 0000000 0000000 00000001426 14126326331 0021263 0 ustar 00root root 0000000 0000000 # Ignore the files created by scrip
## Copyright (C) 2017 Jeremiah Orians
## This file is part of mescc-tools.
##
## mescc-tools 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.
##
## mescc-tools 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 mescc-tools. If not, see
###
### This file is part of Mes.
###
### Mes 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.
###
### Mes 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 Mes. If not, see