├── Makefile ├── README.md ├── prufh_term.c ├── prufh.4th ├── LICENSE └── prufh.pl /Makefile: -------------------------------------------------------------------------------- 1 | 2 | LIBDIR_APP_LOADER?=/home/linuxcnc/am335x_pru_package/pru_sw/app_loader/lib 3 | INCDIR_APP_LOADER?=/home/linuxcnc/am335x_pru_package/pru_sw/app_loader/include 4 | BINDIR?=. 5 | 6 | CFLAGS+= -Wall -I$(INCDIR_APP_LOADER) -D__DEBUG -O2 -mtune=cortex-a8 -march=armv7-a 7 | LDFLAGS+=-L$(LIBDIR_APP_LOADER) -lprussdrv -lpthread 8 | OBJDIR=obj 9 | TARGET=$(BINDIR)/prufh_term 10 | 11 | _DEPS = 12 | DEPS = $(patsubst %,$(INCDIR_APP_LOADER)/%,$(_DEPS)) 13 | 14 | _OBJ = prufh_term.o 15 | OBJ = $(patsubst %,$(OBJDIR)/%,$(_OBJ)) 16 | 17 | 18 | $(OBJDIR)/%.o: %.c $(DEPS) 19 | @mkdir -p obj 20 | gcc $(CFLAGS) -c -o $@ $< 21 | 22 | $(TARGET): $(OBJ) 23 | gcc $(CFLAGS) -o $@ $^ $(LDFLAGS) 24 | 25 | .PHONY: clean 26 | 27 | clean: 28 | rm -rf $(OBJDIR)/ *~ $(TARGET) 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | Prufh is a minimal 32 bit Forth language with 16 bit addresses 3 | for the pruss coprocessors found on TI chips such as those used 4 | on the beaglebone black. More properly, it is a threaded language 5 | for the pruss using Forth words and conventions. 6 | 7 | 8 | What is it 9 | 10 | It consists of a compiler, the forth system itself, and an 11 | optional program for loading and communicating with the forth 12 | code proper. 13 | 14 | Prufh is not intended as a general purpose language. It only 15 | supports those features that are useful for the pruss' intended 16 | functions. 17 | 18 | 19 | 20 | Why is it 21 | 22 | It is intended to provide an easier means of programing and 23 | debugging programs for the pru subsystem. It also may allow 24 | writing larger programs than would be feasible when programming 25 | directly in assembly language. 26 | 27 | It is Forth because of its ease of implementation. 28 | 29 | 30 | 31 | Getting Started 32 | 33 | As supplied Prufh is set up to be compiled on the BeagleBone black 34 | (although cross compiling would not be difficult). 35 | 36 | First the pruss drivers must be loaded. This can be a very fraught 37 | process and I can't help with this. 38 | Just do not proceed until /sys/class/uio/uio0 exists. 39 | 40 | After downloading change to the directory with your copy of Prufh. 41 | 42 | Run make which should compile prufh_term for you. 43 | 44 | Next run: 45 | 46 | ./prufh.pl -a "../am335_pru_package/pru_sw/utils/pasm -V3L" 47 | 48 | (Substitute the location of your pru assembler. Or ommit the 49 | assembler directive and manually run your assembler against 50 | prufh.prg) 51 | This will compile the default "prufh.4th" file into prufh.bin 52 | and prufh.dat files. 53 | 54 | Now run 55 | sudo ./prufh_term 56 | 57 | After some harmless chatter it should return: 58 | Reset: 0x01234567 59 | 60 | Now you can type in forth commands (one per line). For example: 61 | 4 62 | 2+ 63 | emit 64 | 65 | That should return: 66 | Got: 0x00000006 67 | 68 | Congratulations. the rest is up to you. 69 | Just add your forth or assembly code to prufh.4th file. 70 | 71 | If you wish to use prufh_term in your own project, it can be 72 | used as is via stdin and stdout, or you can ask it to use 73 | specified io. Use ./prufh_term -h for instructions. "-q" turns 74 | on quiet mode which has minimal output for easier parsing. 75 | 76 | 77 | 78 | Helpful information 79 | 80 | There should be no surprises in the way Prufh works if you are 81 | familiar with Forth. If you aren't familiar with Forth, there are 82 | a number of tutorials etc. online. 83 | 84 | The list of defined words may be found in the prufh.def file. For 85 | explaination of their meaning, refer to standard Forth documentation. 86 | 87 | A word must be defined called "main". "main" is executed on starting 88 | the pruss system or whenever it is reset. 89 | 90 | Prufh supports binary, octal, decimal, and hex numbers via the usual 91 | conventions (perl, C/C++). 92 | 93 | ";CODE" does two things, it terminates an assembly laguage word with 94 | a jump to next and it switches the compiler out of assembly mode. 95 | It may be omitted to save space if the definition ends in a branch 96 | statement AND the next intruction is :CODE 97 | 98 | The #include directive can be used to treat code in a separate file 99 | as if it were part of the including file. This is a good way to 100 | add your code to prufh. 101 | 102 | Exit prufh_term with "bye". 103 | 104 | Use the customary -h option for more information on the use of prufh.pl 105 | or prufh_term 106 | 107 | By default prufh runs on pru 0. To use pru 1, compile with prufh.pl 108 | using "-p 1". Also, run prufh_term with "-p 1". 109 | 110 | 111 | 112 | Differences from Forth 113 | 114 | It is a "headerless" forth, which means that, while it saves on 115 | memory, new words cannot be added or modified at run time. 116 | 117 | For speed and to conserve data memory, more words are written as 118 | primitives than might be the case otherwise. 119 | 120 | It does not support the full suite of compile time words of a 121 | true forth system. 122 | 123 | There is no support for strings. 124 | 125 | 126 | 127 | Current Limitations 128 | 129 | In the assembly language, the pseudo-op MVIx instructions are 130 | not handled. 131 | 132 | Assembly macros are not supported and generally won't work; 133 | but there isn't much need for them in prufh. 134 | 135 | In keeping with its intended use as a HW controller, only unsigned 136 | integers are recognized; no negative(!) or floating point numbers. 137 | 138 | In n 0 do ,,, -loop counting down to zero will wrap if the index 139 | never exactly equals 0. 140 | 141 | 142 | 143 | How it works (some understanding of Forth is helpful here) 144 | 145 | A prufh program, with the extension .4th, consists of primitives 146 | written in assembly language and forth colon definitions. This 147 | file is processed by a perl program, prufh.pl, which preprocess 148 | the assembly language and compiles the forth code. The assembly 149 | code is output as prufh.prg. The forth code is found in prufh.dat. 150 | 151 | prufh.dat is intended to be loaded into the pru data memory. 152 | At its simplest, prufh.dat consists of a series of 16-bit addresses 153 | each of which is the address of a forth word. That address may 154 | point to a primitive, written in assembly and located in program 155 | memory, or to another address in data memory. These are 156 | distinguished by the fact that the data memory address have their 157 | high bit set. 158 | 159 | When a program is run, "next" steps through the address table 160 | starting at the address of the word "main". As each address is 161 | read, if its high bit is clear, execution jumps to that address. 162 | If the high bit is set, the current address is saved on the return 163 | stack and "next" repeats its process at the new address. 164 | 165 | When execution reaches the end of a primitive, control jumps back 166 | to the begining of "next" which then looks at the next address. 167 | The end of a colon definition is marked by the primitive word 168 | "exit". "exit" retrieves the old address form the return stack 169 | and sends control back to "next" which increments the old address, 170 | etc. etc. 171 | 172 | This picture is complicated only a little by the fact that branching 173 | words, variables, constants, and literals also store information in 174 | the dictionary interleaved with the addresses. 175 | 176 | The prufh_term program has a dictionary of known words and 177 | translates them to their corresponding address before sending 178 | them to the pruss. As supplied, the prufh.4th program accepts 179 | address or numbers and executes them or places them on the stack 180 | respectively. 181 | 182 | The pruss has a hardware multiply unit so multiplies are very fast. 183 | It has no divide, however, so it is implemented in software and 184 | consequently is quite slow. 185 | 186 | 187 | 188 | Nonstandard words 189 | 190 | sleep ( n -- ) wait for n * 10 nanoseconds 191 | 192 | ?command ( -- flag ) is an incomming command ready? 193 | 194 | @command ( -- cmd ) fetch incomming command 195 | 196 | ?read ( -- flag ) has last output been acknowledged? 197 | 198 | echo ( n -- n ) output top of stack 199 | 200 | . ( n -- ) output top of stack 201 | 202 | exec ( addr -- ) execute word whose address is on stack 203 | 204 | oblige ( -- ) executes incomming request, if any 205 | 206 | * ( n1, n2 -- high, low) 32 bit multiply with 64 bit result 207 | 208 | setgpio ( n -- ) set pin #n high 209 | 210 | clrgpio ( n -- ) set pin #n low 211 | 212 | 213 | 214 | TODO 215 | Add HW configuration and interrupt words 216 | Multitasking ? 217 | 218 | -------------------------------------------------------------------------------- /prufh_term.c: -------------------------------------------------------------------------------- 1 | /* 2 | prufh_term.c 3 | 4 | Copyright 2013 John C Silvia 5 | 6 | This file is part of prufh. 7 | 8 | prufh is free software: you can redistribute it and/or modify 9 | it under the terms of the GNU General Public License as published by 10 | the Free Software Foundation, either version 3 of the License, or 11 | (at your option) any later version. 12 | 13 | prufh is distributed in the hope that it will be useful, 14 | but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | GNU General Public License for more details. 17 | 18 | You should have received a copy of the GNU General Public License 19 | along with prufh. If not, see . 20 | */ 21 | 22 | #include 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | #include 30 | 31 | #include "prussdrv.h" 32 | #include 33 | 34 | 35 | #define BUFFSIZE 32 36 | 37 | #define AM33XX 38 | 39 | #define TOPRU (0 + ((0x100 / 4) * pru_num)) 40 | #define TOPRU_F (1 + ((0x100 / 4) * pru_num)) 41 | #define FROMPRU (2 + ((0x100 / 4) * pru_num)) 42 | #define FROMPRU_F (3 + ((0x100 / 4) * pru_num)) 43 | 44 | #define CMD_FLAG 1 45 | #define LIT_FLAG 2 46 | 47 | #define RECEIVE_SLEEP 100 // usecs to wait between checking for pru output 48 | #define EXEC_SLEEP 1 // secs to wait between attempts to send command 49 | #define EXEC_LIMIT 60 // # of attempts before give up on sending command 50 | 51 | static int setupIO(int argc, char** argv); 52 | static int exec(uint32_t cmd_addr, uint32_t flag); 53 | static void* receive(void* param); 54 | static int pruInit(unsigned short pruNum); 55 | 56 | static int quiet_mode = 0; 57 | 58 | unsigned int inpipe=0; 59 | unsigned int outpipe=1; 60 | 61 | static void *pruSharedMem; 62 | static volatile uint32_t *pruSharedMem_int; 63 | 64 | static void *pruDataMem; 65 | static uint16_t *pruDataMem_int; 66 | 67 | static int pru_num = 0; 68 | static char filename[128]; 69 | static int namelen = 0; 70 | 71 | int main(int argc, char *argv[]) { 72 | char *word, *pEnd; 73 | int word_count, i, nread; 74 | uint32_t cmd_addr, flag; 75 | char *gap = " \n"; 76 | char buff[BUFFSIZE]; 77 | ENTRY definition, *wp; 78 | pthread_t receive_t; 79 | 80 | if (setupIO(argc, argv)) { 81 | return EXIT_FAILURE; 82 | } 83 | 84 | // if not given, use default filename 85 | if (namelen == 0) { 86 | strcpy(filename, "prufh"); 87 | namelen = 5; 88 | } 89 | strcat(filename, ".defs"); 90 | 91 | // open list of forth word addresses 92 | FILE *file = fopen(filename, "r"); 93 | if (file == NULL) { 94 | fprintf(stderr, "Unable to open definitions file, %s\n", filename); 95 | return EXIT_FAILURE; 96 | } 97 | 98 | // get number of definitions from begining of file 99 | fgets (buff, BUFFSIZE, file ); 100 | word_count = atoi(buff); 101 | 102 | // create hash for definition table 103 | hcreate(word_count); 104 | 105 | // fill hash with name-address pairs 106 | for (i=0; ikey, wp->data); 122 | } 123 | i++; 124 | } 125 | } 126 | fclose(file); 127 | 128 | if (pruInit(pru_num) == EXIT_SUCCESS) { 129 | 130 | // start seperate thread to handle forth output 131 | if (pthread_create(&receive_t, NULL, receive, (void*) &outpipe)) { 132 | } 133 | 134 | // main loop, relay input to pru 135 | for(;;) { 136 | nread = read(0, buff, BUFFSIZE); // wait here for input on stdin 137 | if (nread > 1) { 138 | word = strtok(buff, gap); 139 | 140 | // exit program on "bye" command 141 | if (strncmp(word, "bye", 3) == 0) break; 142 | 143 | // find address of word corresponding to input 144 | definition.key = word; 145 | wp = hsearch(definition, FIND); 146 | 147 | if (wp == NULL) { 148 | // if input not defined, see if it is a number 149 | cmd_addr = strtoul(word, &pEnd, 0); 150 | if (pEnd == word) { 151 | fprintf(stderr, "Unknown word, \"%s\"\n", word); 152 | continue; 153 | } else { 154 | // if a number was input, signal forth to push it 155 | flag = LIT_FLAG; 156 | if (!quiet_mode) 157 | printf("Pushing %d\n", cmd_addr); 158 | } 159 | } else { 160 | // signal that a command address is being sent 161 | flag = CMD_FLAG; 162 | // retrieve the address 163 | cmd_addr = (uint16_t)(intptr_t)(wp->data); 164 | if (!quiet_mode) 165 | printf("Executing %9.9s %x\n", word, cmd_addr); 166 | } 167 | 168 | // send message to pruss 169 | if (exec(cmd_addr, flag)) { 170 | fprintf(stderr, "Unable to issue command, \"%s\"\n", word); 171 | } 172 | } 173 | } 174 | } 175 | hdestroy(); 176 | 177 | pthread_cancel(receive_t); 178 | pthread_join(receive_t, NULL); 179 | 180 | /* shutdown pru */ 181 | prussdrv_pru_disable(pru_num); 182 | prussdrv_exit(); 183 | 184 | if (outpipe != 1) { 185 | close(outpipe); 186 | } 187 | if (inpipe != 0) { 188 | close(inpipe); 189 | } 190 | 191 | return EXIT_SUCCESS; 192 | } 193 | 194 | 195 | // On the pru, execute the command that corresponds to passed address 196 | // If still unable to exececute after one minute, fails. 197 | int exec(uint32_t cmd_addr, uint32_t flag) { 198 | int wait = 0; 199 | 200 | // wait for any previous command to be acknowledged 201 | while (pruSharedMem_int[TOPRU_F] > 0) { 202 | if (wait++ == EXEC_LIMIT) { 203 | return EXIT_FAILURE; 204 | } 205 | sleep(EXEC_SLEEP); 206 | } 207 | 208 | // write to pru memory 209 | pruSharedMem_int[TOPRU] = cmd_addr; 210 | pruSharedMem_int[TOPRU_F] = flag; 211 | 212 | return EXIT_SUCCESS; 213 | } 214 | 215 | 216 | // Relay output from pru to stdout 217 | void* receive(void* param) { 218 | int* val; 219 | int ready; 220 | FILE* output; 221 | 222 | pthread_setcancelstate(PTHREAD_CANCEL_ENABLE, NULL); 223 | pthread_setcanceltype(PTHREAD_CANCEL_ASYNCHRONOUS, NULL); 224 | 225 | val = (int*)param; //stupid, but compiler unhappy without this 226 | output = (FILE*)*val; 227 | if ((int)output == 1) output = stdout; 228 | 229 | // loop looking for output from pruss 230 | for(;;){ 231 | ready = pruSharedMem_int[FROMPRU_F]; 232 | if (ready != 0x00) { 233 | // check for special signal from pruss indicating a (re)start 234 | if (ready == 0x89abcdef) { 235 | if (quiet_mode) { 236 | fprintf(output, "reset\n"); 237 | } else { 238 | fprintf(output, "Reset: %#8x\n", pruSharedMem_int[FROMPRU]); 239 | } 240 | } else { 241 | if (quiet_mode) { 242 | fprintf(output, "%#8x\n", pruSharedMem_int[FROMPRU]); 243 | } else { 244 | fprintf(output, "Got: %#8x\n", pruSharedMem_int[FROMPRU]); 245 | } 246 | } 247 | // acknowledge message 248 | pruSharedMem_int[FROMPRU_F] = 0x00; 249 | } 250 | // don't use all our cpu cycles 251 | usleep(RECEIVE_SLEEP); 252 | } 253 | pthread_exit(NULL); 254 | } 255 | 256 | 257 | // Redirect stdin and stdout if requested at startup 258 | int setupIO(int argc, char *argv[]) { 259 | int i; 260 | 261 | for (i=1; i. 19 | // 20 | 21 | // REGISTERS: 22 | // tos -- top of stack 23 | // psp -- parameter stack pointer 24 | // rsp -- return stack pointer 25 | // ip -- instruction pointer 26 | // w -- working register used for address manipulation 27 | // x -- scratch register 28 | // y -- second scratch register (must be adjacent to x) 29 | // z -- third scratch register 30 | // limit -- inner do loop limit 31 | // index -- inner do loop index 32 | // incr -- do loop increment value 33 | // R25 to R29 -- used for hw multiply 34 | 35 | .origin 0 36 | .entrypoint STARTING_POINT 37 | 38 | #define data_address_flag 15 39 | 40 | #define shared_ram c28 41 | #define emit_avail 12 42 | #define emit_value 8 43 | #define cmd_avail 4 44 | #define cmd_value 0 45 | 46 | STARTING_POINT: 47 | jmp INITIALIZATION 48 | 49 | // forth "inner interpreter" called "next" 50 | // (headerless word at known location) 51 | add $ip, $ip, 2 52 | NEXT: 53 | lbbo $w, $ip, 0, 2 54 | qbbs DOCOLON, $w, data_address_flag 55 | jmp $w 56 | DOCOLON: 57 | sub $rsp, $rsp, 2 58 | sbbo $ip, $rsp, 0, 2 59 | clr $ip, $w, data_address_flag 60 | jmp NEXT 61 | 62 | INITIALIZATION: 63 | // clear STANDBY_INIT bit in SYSCFG to allow mem & pin access 64 | lbco R0, C4, 4, 4 65 | clr R0, R0, 4 66 | sbco R0, C4, 4, 4 67 | // init shared memory address in C28 68 | ldi R0, 0x0100 + pru_num 69 | ldi R1.w2, 0x0002 70 | ldi R1.w0, 0x2028 + (pru_num * 0x2000) 71 | sbbo R0, R1, 0, 4 72 | ldi R0, 0x0000 73 | ldi R1.w2, 0x0002 74 | ldi R1.w0, 0x2020 + (pru_num * 0x2000) 75 | sbbo R0, R1, 0, 4 76 | // turn on MAC unit (for multiplication) 77 | xor R25, R25, R25 78 | xout 0, R25, 1 79 | // now fall through to abort 80 | 81 | :CODE abort ( -- ) 82 | // clear input area in shared memory 83 | xor $x, $x, $x 84 | xor $y, $y, $y 85 | sbco $x, shared_ram, 0, 8 86 | // clear stacks 87 | xor $tos, $tos, $tos 88 | ldi $rsp, $rstackAddr 89 | ldi $psp, $stackAddr 90 | // clear instruction pointers 91 | xor $ip, $ip, $ip 92 | xor $w, $w, $w 93 | // signal that we have (re)started 94 | mov $x, 0x01234567 95 | mov $y, 0x89abcdef 96 | sbco $x, shared_ram, 8, 8 97 | // jump to main program 98 | ldi $ip, $mainCFA 99 | clr $ip, $ip, data_address_flag 100 | jmp NEXT 101 | 102 | :CODE halt ( -- ) 103 | halt 104 | 105 | :CODE exit ( -- ) // compiled by ; also can be used in recursion 106 | lbbo $ip, $rsp, 0, 2 107 | add $rsp, $rsp, 2 108 | ;CODE 109 | 110 | :CODE lit ( -- n ) 111 | PUSH 112 | lbbo $tos, $ip, 2, 4 // move lit value to top of stack 113 | add $ip, $ip, 4 // set instruction pointer past lit value 114 | ;CODE 115 | 116 | :CODE dovar ( -- addr ) 117 | PUSH 118 | add $ip, $ip, 2 119 | ldi $tos.w2, 0x0000 120 | lbbo $tos.w0, $ip, 0, 2 121 | ;CODE 122 | 123 | :CODE doconst ( -- n ) 124 | PUSH 125 | add $ip, $ip, 2 126 | ldi $tos.w2, 0x0000 127 | lbbo $tos.w0, $ip, 0, 2 128 | lbbo $tos, $tos, 0, 4 129 | ;CODE 130 | 131 | :CODE dup ( n1 -- n1 n1 ) 132 | PUSH 133 | ;CODE 134 | 135 | :CODE drop ( n -- ) 136 | POP 137 | ;CODE 138 | 139 | :CODE swap ( n1 n2 -- n2 n1 ) 140 | mov $x, $tos 141 | lbbo $tos, $psp, 0, 4 142 | sbbo $x, $psp, 0, 4 143 | ;CODE 144 | 145 | :CODE over ( n1 n2 -- n1 n2 n1 ) 146 | sbbo $tos, $psp, 4, 4 147 | lbbo $tos, $psp, 0, 4 148 | add $psp, $psp, 4 149 | ;CODE 150 | 151 | :CODE nip ( n1 n2 -- n2 ) 152 | sub $psp, $psp, 4 153 | ;CODE 154 | 155 | :CODE tuck ( n1 n2 -- n2 n1 n2 ) 156 | lbbo $x, $psp, 0, 4 157 | sbbo $tos, $psp, 0, 4 158 | add $psp, $psp, 4 159 | sbbo $x, $psp, 0, 4 160 | ;CODE 161 | 162 | :CODE 2drop ( n n -- ) 163 | sub $psp, $psp, 8 164 | lbbo $tos, $psp, 4, 4 165 | ;CODE 166 | 167 | :CODE 2dup ( n1 n2 -- n1 n2 n1 n2 ) 168 | sbbo $tos, $psp, 4, 4 169 | lbbo $x, $psp, 0, 4 170 | add $psp, $psp, 8 171 | sbbo $x, $psp, 0, 4 172 | ;CODE 173 | 174 | :CODE rot ( n1 n2 n3 -- n2 n3 n1 ) 175 | sub $x, $psp, 4 176 | lbbo $z, $x, 0, 4 177 | lbbo $y, $psp, 0, 4 178 | sbbo $y, $x, 0, 4 179 | sbbo $tos, $psp, 0, 4 180 | mov $tos, $z 181 | ;CODE 182 | 183 | :CODE -rot ( n1 n2 n3 -- n3 n1 n2 ) 184 | sub $x, $psp, 4 185 | lbbo $y, $x, 0, 4 186 | sbbo $tos, $x, 0, 4 187 | lbbo $tos, $psp, 0, 4 188 | sbbo $y, $psp, 0, 4 189 | ;CODE 190 | 191 | :CODE pick ( nu ... n0 u -- nu ... n0 nu ) 192 | lsl $tos, $tos, 2 193 | sub $x, $psp, $tos 194 | lbbo $tos, $x, 0, 4 195 | ;CODE 196 | 197 | :CODE roll ( nu ... n0 n -- nu-1 ... n0 nu ) 198 | lsl $tos, $tos, 2 199 | lsl $tos, $tos, 2 200 | sub $x, $psp, $tos.b0 201 | lbbo $tos, $x, 0, 4 202 | ROLLONE: 203 | lbbo $y, $x, 4, 4 204 | sbbo $y, $x, 0, 4 205 | add $x, $x, 4 206 | qbgt ROLLONE, $x, $psp 207 | sub $psp, $psp, 4 208 | ;CODE 209 | 210 | :CODE + ( n1 n2 -- n3 ) 211 | lbbo $x, $psp, 0, 4 212 | add $tos, $tos, $x 213 | sub $psp, $psp, 4 214 | ;CODE 215 | 216 | :CODE - ( n1 n2 -- n3 ) 217 | lbbo $x, $psp, 0, 4 218 | sub $tos, $x, $tos 219 | sub $psp, $psp, 4 220 | ;CODE 221 | 222 | :CODE @ ( a -- n ) 223 | lbbo $tos, $tos, 0, 4 224 | ;CODE 225 | 226 | :CODE ! ( n a -- ) 227 | lbbo $x, $psp, 0, 4 228 | sbbo $x, $tos, 0, 4 229 | sub $psp, $psp, 8 230 | lbbo $tos, $psp, 4, 4 231 | ;CODE 232 | 233 | :CODE C@ ( a -- n ) 234 | lbbo $tos, $tos, 0, 1 235 | ;CODE 236 | 237 | :CODE C! ( n a -- ) 238 | lbbo $x, $psp, 0, 4 239 | sbbo $x, $tos, 0, 1 240 | sub $psp, $psp, 8 241 | lbbo $tos, $psp, 4, 4 242 | ;CODE 243 | 244 | :CODE branch ( -- ) 245 | lbbo $ip, $ip, 2, 2 246 | jmp NEXT 247 | 248 | 249 | :CODE 0branch ( flag -- ) 250 | add $ip, $ip, 2 // set instr ptr to next actual instruction 251 | qbne BRANCHZERO, $tos, 0 252 | lbbo $ip, $ip, 0, 2 // override instr ptr to cfa of first branch instruction 253 | POP 254 | jmp NEXT 255 | BRANCHZERO: 256 | POP 257 | ;CODE 258 | 259 | // executeable for do 260 | :CODE (DO) // keep current index & limit in registers; outer ones on return stack 261 | DOLOOP: 262 | sub $rsp, $rsp, 8 263 | sbbo $limit, $rsp, 4, 4 264 | sbbo $index, $rsp, 0, 4 265 | lbbo $limit, $psp, 0, 4 266 | mov $index, $tos 267 | sub $psp, $psp, 8 268 | lbbo $tos, $psp, 4, 4 269 | ldi $incr, 1 270 | ;CODE 271 | 272 | // executeable for ?do 273 | :CODE (?DO) 274 | add $ip, $ip, 2 275 | lbbo $x, $psp, 0, 4 276 | qbne DOLOOP, $tos, $x 277 | sub $psp, $psp, 8 278 | lbbo $tos, $psp, 4, 4 279 | lbbo $ip, $ip, 0, 2 280 | jmp NEXT 281 | 282 | // executeable for +loop 283 | :CODE (+LOOP) 284 | mov $incr, $tos 285 | POP 286 | // fall through to (LOOP) 287 | 288 | // executeable for loop 289 | :CODE (LOOP) 290 | add $index, $index, $incr 291 | add $ip, $ip, 2 292 | qbge DODONE, $limit, $index 293 | LOOPBODY: 294 | lbbo $ip, $ip, 0, 2 295 | jmp NEXT 296 | DODONE: 297 | lbbo $limit, $rsp, 4, 4 298 | lbbo $index, $rsp, 0, 4 299 | add $rsp, $rsp, 8 300 | ;CODE 301 | 302 | // executeable for -loop 303 | :CODE (-LOOP) 304 | mov $incr, $tos 305 | POP 306 | sub $index, $index, $incr 307 | add $ip, $ip, 2 308 | qble DODONE, $limit, $index 309 | jmp LOOPBODY 310 | 311 | // pop do loop index and limit from return stack 312 | :CODE unloop ( -- ) // would mainly be used before "exit" 313 | lbbo $limit, $rsp, 4, 4 314 | lbbo $index, $rsp, 0, 4 315 | add $rsp, $rsp, 8 316 | ;CODE 317 | 318 | :CODE (LEAVE) 319 | lbbo $limit, $rsp, 4, 4 320 | lbbo $index, $rsp, 0, 4 321 | add $rsp, $rsp, 8 322 | add $ip, $ip, 2 323 | lbbo $ip, $ip, 0, 2 324 | jmp NEXT 325 | 326 | :CODE i ( -- i ) 327 | PUSH 328 | mov $tos, $index 329 | ;CODE 330 | 331 | :CODE j ( -- j ) 332 | PUSH 333 | lbbo $tos, $rsp, 0, 4 334 | ;CODE 335 | 336 | :CODE k ( -- k ) 337 | PUSH 338 | lbbo $tos, $rsp, 4, 4 339 | ;CODE 340 | 341 | :CODE and ( n1 n2 -- n3 ) 342 | lbbo $x, $psp, 0, 4 343 | and $tos, $tos, $x 344 | sub $psp, $psp, 4 345 | ;CODE 346 | 347 | :CODE or ( n1 n2 -- n3 ) 348 | lbbo $x, $psp, 0, 4 349 | or $tos, $tos, $x 350 | sub $psp, $psp, 4 351 | ;CODE 352 | 353 | :CODE xor ( n1 n2 -- n3 ) 354 | lbbo $x, $psp, 0, 4 355 | xor $tos, $tos, $x 356 | sub $psp, $psp, 4 357 | ;CODE 358 | 359 | :CODE not ( n1 -- n2 ) 360 | not $tos, $tos 361 | ;CODE 362 | 363 | :CODE lshift ( n1 n2 -- n3 ) 364 | lbbo $x, $psp, 0, 4 365 | lsl $tos, $x, $tos 366 | sub $psp, $psp, 4 367 | ;CODE 368 | 369 | :CODE rshift ( n1 n2 -- n3 ) 370 | lbbo $x, $psp, 0, 4 371 | lsr $tos, $x, $tos 372 | sub $psp, $psp, 4 373 | ;CODE 374 | 375 | :CODE = ( n1 n2 -- flag ) 376 | lbbo $x, $psp, 0, 4 377 | sub $psp, $psp, 4 378 | qbeq TRUE, $x, $tos 379 | 380 | FALSE: 381 | xor $tos, $tos, $tos 382 | ;CODE 383 | 384 | :CODE <> ( n1 n2 -- flag ) 385 | lbbo $x, $psp, 0, 4 386 | sub $psp, $psp, 4 387 | qbeq FALSE, $x, $tos 388 | 389 | TRUE: 390 | mov $tos, 0xffffffff 391 | ;CODE 392 | 393 | :CODE < ( n1 n2 -- flag ) 394 | lbbo $x, $psp, 0, 4 395 | sub $psp, $psp, 4 396 | qblt TRUE, $tos, $x 397 | jmp FALSE 398 | 399 | :CODE > ( n1 n2 -- flag ) 400 | lbbo $x, $psp, 0, 4 401 | sub $psp, $psp, 4 402 | qbgt TRUE, $tos, $x 403 | jmp FALSE 404 | 405 | :CODE >= ( n1 n2 -- flag ) 406 | lbbo $x, $psp, 0, 4 407 | sub $psp, $psp, 4 408 | qbge TRUE, $tos, $x 409 | jmp FALSE 410 | 411 | :CODE <= ( n1 n2 -- flag ) 412 | lbbo $x, $psp, 0, 4 413 | sub $psp, $psp, 4 414 | qble TRUE, $tos, $x 415 | jmp FALSE 416 | 417 | :CODE r@ ( -- n ) 418 | PUSH 419 | lbbo $tos, $rsp, 0, 4 420 | ;CODE 421 | 422 | :CODE >r ( n -- ) 423 | sub $rsp, $rsp, 4 424 | sbbo $tos, $rsp, 0, 4 425 | POP 426 | ;CODE 427 | 428 | :CODE r> ( -- n ) 429 | PUSH 430 | lbbo $tos, $rsp, 0, 4 431 | add $rsp, $rsp, 4 432 | ;CODE 433 | 434 | :CODE +! ( n a -- ) 435 | lbbo $y, $tos, 0, 4 436 | lbbo $x, $psp, 0, 4 437 | add $y, $y, $x 438 | sbbo $y, $tos, 0, 4 439 | sub $psp, $psp, 8 440 | lbbo $tos, $psp, 4, 4 441 | ;CODE 442 | 443 | :CODE 1+ ( n1 -- n2 ) 444 | add $tos, $tos, 1 445 | ;CODE 446 | 447 | :CODE 2+ ( n1 -- n2 ) 448 | add $tos, $tos, 2 449 | ;CODE 450 | 451 | :CODE 1- ( n1 -- n2 ) 452 | sub $tos, $tos, 1 453 | ;CODE 454 | 455 | :CODE 2- ( n1 -- n2 ) 456 | sub $tos, $tos, 2 457 | ;CODE 458 | 459 | :CODE 2/ ( n1 -- n2 ) 460 | lsr $tos, $tos, 1 461 | ;CODE 462 | 463 | :CODE 2* ( n1 -- n2 ) 464 | lsl $tos, $tos, 1 465 | ;CODE 466 | 467 | :CODE ?dup ( n|0 -- n n | 0 ) 468 | qbeq NODUP, $tos, 0 469 | PUSH 470 | NODUP: 471 | ;CODE 472 | 473 | :CODE max ( n1 n2 -- n1 | n2 ) 474 | lbbo $x, $psp, 0, 4 475 | max $tos, $tos, $x 476 | sub $psp, $psp, 4 477 | ;CODE 478 | 479 | :CODE min ( n1 n2 -- n1 | n2 ) 480 | lbbo $x, $psp, 0, 4 481 | min $tos, $tos, $x 482 | sub $psp, $psp, 4 483 | ;CODE 484 | 485 | 486 | :CODE * ( n1 n2 -- d ) 487 | lbbo R28, $psp, 0, 4 488 | mov R29, $tos 489 | and $tos, $tos, $tos // NOP to allow multiply 490 | xin 0, R26, 8 491 | mov $tos, R26 // low order 32 bits 492 | sbbo R27, $psp, 0, 4 // high-order 493 | ;CODE 494 | 495 | // long (unsigned) division -- worst-case ~= 1 microsec 496 | :CODE / ( n1 n2 -- n3 ) 497 | lbbo $z, $psp, 0, 4 498 | lmbd $x, $tos, 1 499 | lmbd $y, $z, 1 500 | sub $y, $y, $x 501 | ldi $x, 1 502 | lsl $x, $x, $y 503 | lsl $tos, $tos, $y 504 | xor $y, $y, $y 505 | ACCUM: 506 | qblt SKIP, $tos, $z 507 | sub $z, $z, $tos 508 | add $y, $y, $x 509 | SKIP: 510 | lsr $tos, $tos, 1 511 | lsr $x, $x, 1 512 | qbne ACCUM, $x, 0 513 | mov $tos, $y 514 | sub $psp, $psp, 4 515 | ;CODE 516 | 517 | // put current parameter stack address on stack 518 | :CODE sp@ ( -- addr ) 519 | PUSH 520 | mov $tos, $psp 521 | ;CODE 522 | 523 | // put current returns stack address on stack 524 | CODE rsp@ ( -- addr ) 525 | PUSH 526 | mov $tos, $rsp 527 | ;CODE 528 | 529 | // true and false here have same # of instructions as using constants 530 | // but use prg mem instead of data mem 531 | :CODE true ( -- flag ) 532 | PUSH 533 | xor $tos, $tos, $tos 534 | not $tos, $tos 535 | ;CODE 536 | 537 | :CODE false ( -- flag ) 538 | PUSH 539 | xor $tos, $tos, $tos 540 | ;CODE 541 | 542 | // sleep for top-of-stack 10s-of-nanoseconds 543 | // resolution only 20 nanoseconds however 544 | // also does not account for overhead (could fix this) 545 | :CODE sleep ( n -- ) 546 | qbgt WAKE, $tos, 2 547 | lsr $tos, $tos, 1 548 | xor $x, $x, $x 549 | SLEEP: 550 | qbge WAKE, $tos, $x 551 | add $x, $x, 2 552 | and $x, $x, $x 553 | jmp SLEEP 554 | WAKE: 555 | POP 556 | ;CODE 557 | 558 | // word provided to execute primitives 559 | : dummy ( ?? -- ?? ) 560 | halt // place holder, replaced by actual address at run time 561 | ; 562 | 563 | // execute arbitrary colon def given address on stack 564 | :CODE exec ( addr -- ) 565 | mov $w, $tos 566 | // if word is primitive, must wrap it in a colon def 567 | qbbs EXCOLON, $tos, data_address_flag 568 | ldi $w, $dummy, 569 | clr $x, $w, data_address_flag 570 | sbbo $tos, $x, 0, 2 571 | EXCOLON: 572 | POP 573 | jmp DOCOLON 574 | 575 | // Set and clear general purpose io pns 576 | :CODE setgpio ( bn -- ) 577 | set R30, R30, $tos 578 | POP 579 | ;CODE 580 | 581 | :CODE clrgpio ( bn -- ) 582 | clr R30, R30, $tos 583 | POP 584 | ;CODE 585 | 586 | // Is a new command available? 1 = cmd, 2 = literal 587 | :CODE ?command ( -- flag ) 588 | PUSH 589 | lbco $tos, shared_ram, cmd_avail, 4 590 | ;CODE 591 | 592 | :CODE @command ( -- addr ) 593 | PUSH 594 | lbco $tos, shared_ram, cmd_value, 4 595 | // clear command flag 596 | xor $x, $x, $x 597 | sbco $x, shared_ram, cmd_avail, 4 598 | ;CODE 599 | 600 | // Write top of stack to shared memory 601 | :CODE echo ( n -- n ) 602 | sbco $tos, shared_ram, emit_value, 4 603 | // flag new value 604 | ldi $x, 0x0001 605 | sbco $x, shared_ram, emit_avail, 4 606 | ;CODE 607 | 608 | // Has last emit been acknowleged? 609 | :CODE ?read ( -- flag ) 610 | PUSH 611 | lbco $tos, shared_ram, emit_avail, 4 612 | qbeq RED, $tos, 0 613 | sub $tos, $tos, 0x02 614 | RED: 615 | not $tos, $tos 616 | ;CODE 617 | 618 | 619 | 620 | : . ( n -- ) 621 | echo drop ; 622 | 623 | // run command, if any, from main system 624 | : oblige ( -- ) 625 | ?command ?dup if 626 | @command 627 | // if flagged as command, execute -- otherwise leave on stack 628 | swap 1 = if 629 | exec 630 | then 631 | then ; 632 | 633 | 634 | // *** Application code goes here *** 635 | 636 | // Use #include to keep your code in a separate file 637 | // #include myapp.4th 638 | 639 | 640 | // loop waiting for commands to execute 641 | : main ( -- ) 642 | begin 643 | oblige 644 | repeat 645 | halt ; 646 | 647 | 648 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | Programming language for the Programmable Realtime Unit Subsystem found on TI ARM processors. (BeagleBone black) 294 | Copyright (C) 2013 John C Silvia 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | {signature of Ty Coon}, 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | -------------------------------------------------------------------------------- /prufh.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ########################################################################## 3 | # # 4 | # prufh.pl # 5 | # # 6 | # Copyright 2013 John C Silvia # 7 | # # 8 | # This file is part of prufh. # 9 | # # 10 | # prufh is free software: you can redistribute it and/or modify # 11 | # it under the terms of the GNU General Public License as published by# 12 | # the Free Software Foundation, either version 3 of the License, or # 13 | # (at your option) any later version. # 14 | # # 15 | # prufh is distributed in the hope that it will be useful, # 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 18 | # GNU General Public License for more details. # 19 | # # 20 | # You should have received a copy of the GNU General Public License # 21 | # along with prufh. If not, see . # 22 | # # 23 | # # 24 | ########################################################################## 25 | use strict; 26 | use Getopt::Std; 27 | use FileHandle; 28 | 29 | # Register definitions 30 | our $tos = 'R4'; 31 | our $w = 'R5'; 32 | our $x = 'R6'; 33 | our $y = 'R7'; 34 | our $z = 'R8'; 35 | our $psp = 'R10'; 36 | our $rsp = 'R12'; 37 | our $ip = 'R14'; 38 | 39 | our $limit = 'R16'; 40 | our $incr = 'R17'; 41 | our $index = 'R18'; 42 | 43 | my $next = '0x0001'; # location of next 44 | 45 | our $primend = "jmp $next"; # def of ; for primitive 46 | 47 | # read entire file into array (impossible for it to be too big) 48 | my @lines; 49 | 50 | my %words = (); # hash of names -> addresses 51 | 52 | my $address = 0; # current program address 53 | my $here = 0x8000; # current data address (with high-bit flag set) 54 | 55 | my $linenum = 0; # source code line number 56 | 57 | my $curname; # name of current word 58 | my $assembling = -1; # assembler mode? (start in assembler for "next") 59 | my $compiling = 0; # compiling colon defs? 60 | 61 | my $variable = 0; # flag that a variable is being created 62 | my $constant = 0; # flag that a constant is being created 63 | my $alias = 0; # flag that a alias is being created 64 | my $tick = 0; # flag that a tick is being evaluated 65 | 66 | my $value = 0; # value of current constant 67 | my $ticked = ''; # name of last word marked by tick 68 | 69 | my @dictionary; # sequential array of word addresses (forth program) 70 | my @loop; # fifo stack for resolving loop addresses 71 | 72 | my $bflag = '0x&&&&'; # temporary place holder for "begin" loop addresses 73 | my $dflag = '0x!!!!'; # temporary place holder for "do loop" addresses 74 | my $iflag = '0x????'; # temporary place holder for "if else then" addresses 75 | 76 | my %vars = (); # hash of variable and constant names -> addresses 77 | 78 | my $naming = 0; # flag that a name is expected 79 | my $macrodef = 0; # flag that we are in an assembly macro definition 80 | 81 | 82 | our $opt_f = "prufh.4th"; # default program name 83 | our $opt_p = 0; 84 | 85 | my $assembler = ""; 86 | 87 | getopts("ha:f:p:"); 88 | 89 | my $file = $opt_f; 90 | my $assembler = our $opt_a; 91 | my $pru_num = our $opt_p; # which pru is being programed? 0 or 1 92 | 93 | if (our $opt_h) 94 | { 95 | print "Usage: prufh.pl [-p 0|1] [-a ASSEMBLER] [-f SOURCE]\n\n"; 96 | print "-p use pru # \n"; 97 | print "-f process file \n"; 98 | print "-a automatically run assembler at \n\n"; 99 | print " Example: ./prufh.pl -p 0 -a \"../utils/pasm -V2\" -f myprufh.4th\n\n"; 100 | exit; 101 | } 102 | 103 | # derive file names 104 | my $debug = $file =~ s/\.4th/.dbg/r; 105 | my $datafile = $file =~ s/\.4th/.dat/r; 106 | my $prgfile = $file =~ s/\.4th/.prg/r; 107 | my $deffile = $file =~ s/\.4th/.defs/r; 108 | 109 | 110 | # set up array of file handles 111 | my @files; 112 | 113 | open(TXT, "> $debug") or die "Can not open debug text file.\n"; 114 | 115 | push (@files, openInput($file)); 116 | 117 | while(scalar @files) { 118 | compile(); 119 | } 120 | 121 | 122 | close(TXT); 123 | 124 | # save data memory image to file 125 | open(DATAM, "> $datafile") or die "Can not open data memory file.\n"; 126 | foreach(@dictionary) { 127 | # print DATAM "$_ "; 128 | /^0x/ and do {print DATAM "$_\n"; next;}; 129 | printf(DATAM "%#0.4x\n", $_); 130 | } 131 | close(DATAM); 132 | 133 | $here -= 0x8000; # strip high bit to get actual address in data memory 134 | 135 | 136 | # Report memory usage 137 | print "here = $here\n"; 138 | my $dsize = @dictionary * 2; 139 | print "dictionary size = $dsize\n"; 140 | print "program lines = $address\n"; 141 | $address *= 4; 142 | print "program memory used = $address\n"; 143 | 144 | 145 | $here += 16; # provide buffer space between end of dict and start of stack 146 | $here = sprintf "%#0.4x", $here; # change here to hex string 147 | 148 | # get address of main program 149 | my $main = sprintf "%#0.4x", $words{'main'}; 150 | 151 | 152 | # Reprocess debug file to produce input for assembler 153 | open(PRGM, "> $prgfile") or die "Can not open program memory file.\n"; 154 | open(TXT, "< $debug") or die "Can not reopen debug text file.\n"; 155 | while() { 156 | # skip empty lines and data memory entries 157 | /^\s*\d*\s+\S*\s*$/ and next; 158 | /^f/ and next; 159 | 160 | # skip high-level forth definitions 161 | /^\s*\d*\s+\S*\s*>/ and next; 162 | 163 | 164 | # set entry point for forth program 165 | s/\$mainCFA/$main/; 166 | # set location of stack 167 | s/\$stackAddr/$here/; 168 | # set location of return stack 169 | s/\$rstackAddr/0x1ff0/; 170 | 171 | # write assembler input skipping comments 172 | /^\s*\d*\s*\S*\s*(.+)/ and do { print PRGM "$1\n" unless $1 =~ /^\/\// }; 173 | } 174 | close(TXT); 175 | close(PRGM); 176 | 177 | 178 | # Save table of word addresses 179 | open(TXT, "> $deffile") or die "Can not open words text file.\n"; 180 | my $sz = scalar keys %words; 181 | print TXT "$sz\n\n"; 182 | foreach my $key (sort(keys %words)) { 183 | printf(TXT "%-12s %#0.4x\n", $key, $words{$key}); 184 | } 185 | print TXT "\n\n"; 186 | foreach my $key (sort byAddr(keys %words)) { 187 | printf(TXT "%#0.4x %s\n", $words{$key}, $key); 188 | } 189 | close(TXT); 190 | 191 | 192 | # Optionally run assembler if location has been provided 193 | if($assembler) { 194 | exec "$assembler -b $prgfile\n" or 195 | print "\nError! $assembler not found\n\n"; 196 | } 197 | 198 | 199 | exit; 200 | 201 | # Add literal to dictionary 202 | sub dolit { 203 | my ($num) = @_; 204 | 205 | push(@dictionary, $words{'lit'}); 206 | $here += 2; 207 | 208 | donum($num, 'literal', 'lit'); 209 | } 210 | 211 | # Write number to dictionary 212 | sub donum { 213 | my ($num, $type, $name) = @_; 214 | my ($numL, $numH); 215 | 216 | # convert decimal, binary, octal, and hex formats 217 | $num = oct($num) if $num =~ /^0/; 218 | 219 | # split value into 2 16-bit hex numbers 220 | $num = sprintf("%0.8x", $num); 221 | 222 | $num =~ /(....)(....)/; 223 | $numL = "0x$2"; 224 | $numH = "0x$1"; 225 | 226 | printf(TXT "\n%0.4u %#0.4x > $type $numH $numL", 227 | $linenum, $words{$name}); 228 | 229 | # add to dictionary as little-endian 230 | push(@dictionary, $numL); 231 | push(@dictionary, $numH); 232 | $here += 4; 233 | } 234 | 235 | 236 | # resolve possible forward references used to exit do loops early 237 | sub fwdref { 238 | my ($addr, $do, $marker) = @_; 239 | my $start = 0; 240 | 241 | my $do = hex($do); 242 | 243 | # find begining index of do loop 244 | # -2 to cover address field of loop beginning 245 | # divide by two because every dict entry is 2 bytes 246 | if($do > 0) { 247 | $start = ($do - 2) / 2; 248 | } 249 | for my $i ($start .. $#dictionary) { 250 | $dictionary[$i] = strip($addr) if ($dictionary[$i] eq $marker); 251 | } 252 | } 253 | 254 | # Clear high-bit flag from data addresses and return as string 255 | sub strip { 256 | my ($addr) = @_; 257 | 258 | $addr -= 0x8000 if $addr >= 0x8000; 259 | 260 | return sprintf("%#0.4x", $addr); 261 | } 262 | 263 | # Used to sort dictionary by address value 264 | sub byAddr { 265 | $words{$a} <=> $words{$b}; 266 | } 267 | 268 | 269 | # return handle for input file 270 | sub openInput { 271 | my ($filename) = @_; 272 | my $fh = new FileHandle; 273 | 274 | $fh->open("< $filename") or die "Can not open input file, $file.\n"; 275 | return $fh; 276 | } 277 | 278 | 279 | # Parse soruce file 280 | # builds forth dictionary and preprocesses assembly code 281 | sub compile { 282 | my $fh = $files[-1]; 283 | 284 | while(<$fh>) { 285 | $linenum++; # keep track of input lines for debugging 286 | my $bump = 0; # flag assembly instruction found, will increase address 287 | my $pseudo = 0; # number of additional lines added by assembly pseudo op 288 | my $fstart = $here; 289 | printf TXT '%0.4u %#0.4x ', $linenum, $address; 290 | 291 | # include new source file 292 | /^#include\s+(.*)\s*$/ and do {push(@files, openInput($1)); 293 | $fh = $files[-1]; next;}; 294 | 295 | # ignore comments, blank lines, and assembler directives 296 | /^\s*$/ and do {print TXT "\n"; next;}; 297 | /^\s*\/\// and do {print TXT "$_"; next;}; 298 | /^\s*\.macro\s/ and do {$macrodef = -1; print TXT "$_"; next;}; 299 | /^\s*#\S+/ and do {print TXT $_; next;}; 300 | /^\s*\.(?!endm)\S+/ and do {print TXT $_; next;}; 301 | 302 | # eliminate stack comments 303 | s/\s+\((\s+.+\s+|\s+)--(\s+.+\s*|\s*)\)//; 304 | 305 | # substitute which pru is being used 306 | s/pru_num/$pru_num/g; 307 | 308 | # parse each line 309 | my @line = split(); 310 | foreach (@line) { 311 | # record name, location of new definition 312 | if($naming) { 313 | $naming = 0; 314 | $curname = $_; 315 | if ($assembling) { 316 | # def resides in program memory 317 | $words{$curname} = $address ; 318 | print TXT "// : $curname"; 319 | } else { 320 | # def resides in data memory 321 | $words{$curname} = $here; 322 | print TXT "> : $curname"; 323 | } 324 | next; 325 | } 326 | 327 | # handle forth "tick" 328 | /\'/ and do { $tick = -1; next;}; 329 | 330 | # forth tick object 331 | if($tick) { 332 | $tick = 0; 333 | $ticked = $_; 334 | next; 335 | } 336 | 337 | /^\/\// and last; # skip comment lines 338 | 339 | # compile start of new code definition 340 | /^:CODE$/ and do {$naming = -1; $assembling = -1; next;}; 341 | 342 | if($assembling) { 343 | # handle end of code definition by jumping to next 344 | /^;CODE$/ and do {print TXT $primend; $assembling = 0; 345 | $bump = -1; next;}; 346 | 347 | # pass assembler label on to output unchanged 348 | /^.+:$/ and do { print TXT "$_ "; next;}; 349 | 350 | # macros for pushing and popping parameter stack 351 | /^PUSH$/ and do { print TXT "add $psp, $psp, 4\n"; 352 | printf TXT "%0.4u %#0.4x sbbo $tos, $psp, 0, 4", 353 | $linenum, $address + 1; 354 | $address += 2; next;}; 355 | /^POP$/ and do { print TXT "lbbo $tos, $psp, 0, 4\n"; 356 | printf TXT "%0.4u %#0.4x sub $psp, $psp, 4", 357 | $linenum, $address + 1; 358 | $address += 2; next;}; 359 | 360 | # adjust address for mov pseudo op 361 | /^mov$/ and do { 362 | # if the source op is numeric, may require 2 ops 363 | if($line[2] =~ /^[\d|#]/ ) { 364 | my $src = join(' ', @line[2..$#line]); 365 | $src =~ s/#//; 366 | $src = eval $src; 367 | $pseudo++ if $src >= 0x00010000; 368 | } 369 | print TXT "$_ "; next;}; 370 | 371 | 372 | # substitute register values 373 | s/^\$tos(\.\S+$|,$|$)/$tos$1/; 374 | s/^\$ip(\.\S+$|,$|$)/$ip$1/; 375 | s/^\$psp(\.\S+$|,$|$)/$psp$1/; 376 | s/^\$rsp(\.\S+$|,$|$)/$rsp$1/; 377 | s/^\$w(\.\S+$|,$|$)/$w$1/; 378 | s/^\$x(\.\S+$|,$|$)/$x$1/; 379 | s/^\$y(\.\S+$|,$|$)/$y$1/; 380 | s/^\$z(\.\S+$|,$|$)/$z$1/; 381 | s/^\$limit(\.\S+$|,$|$)/$limit$1/; 382 | s/^\$index(\.\S+$|,$|$)/$index$1/; 383 | s/^\$incr(\.\S+$|,$|$)/$incr$1/; 384 | 385 | # don't add macros to dictionary 386 | if($macrodef) { 387 | /^\s*\.endm/ and $macrodef = 0; 388 | print TXT "$_ "; 389 | next; 390 | } 391 | 392 | # substitute address of special word used by "exec" 393 | s/^\$dummy(\.\S+$|,$|$)/$words{'dummy'}$1/; 394 | 395 | print TXT "$_ "; 396 | $bump = -1; # flag that instruction is using memory 397 | } elsif ($compiling) { 398 | # end of definition 399 | /^;\s*$/ and do { $_ = 'exit'; $compiling = 0;}; 400 | 401 | # handle literal values in definitions 402 | /^0x[0123456789abcdefABCDEF]+$/ and do { dolit($_); next;}; 403 | /^0b[01]+$/ and do { dolit($_); next;}; 404 | /^\d+$/ and do { dolit($_); next;}; 405 | 406 | # compile branching words 407 | /^begin$/ and do { push(@loop, strip($here)); 408 | print TXT "// BEGIN";next;}; 409 | /^until$/ and do { push(@dictionary, $words{'0branch'}); 410 | push(@dictionary, pop(@loop)); $here += 4; 411 | print TXT "// UNTIL"; next;}; 412 | /^repeat$/ and do { push(@dictionary, $words{'branch'}); 413 | $fstart = pop(@loop); 414 | push(@dictionary, $fstart); 415 | $here += 4; 416 | fwdref($here, $fstart, $bflag); 417 | print TXT "// REPEAT"; next;}; 418 | /^while$/ and do { push(@dictionary, $words{'0branch'}); 419 | push(@dictionary, $bflag ); $here += 4; 420 | print TXT "// WHILE"; next;}; 421 | 422 | /^do$/ and do { push(@dictionary, $words{'(DO)'}); 423 | $here += 2; 424 | push(@loop, strip($here)); 425 | print TXT "\t// DO"; next;}; 426 | /^\?do$/ and do { push(@dictionary, $words{'(?DO)'}); 427 | push(@dictionary, $dflag ); 428 | $here += 4; 429 | push(@loop, strip($here)); 430 | print TXT "\t// ?DO"; next;}; 431 | /^leave$/ and do { push(@dictionary, $words{'(LEAVE)'}); 432 | push(@dictionary, $dflag ); 433 | $here += 4; 434 | print TXT "\t// LEAVE"; next;}; 435 | /^loop$/ and do { push(@dictionary, $words{'(LOOP)'}); 436 | $fstart = pop(@loop); 437 | push(@dictionary, $fstart); 438 | $here += 4; 439 | fwdref($here, $fstart, $dflag); 440 | print TXT "\t// LOOP"; next;}; 441 | /^\+loop$/ and do { push(@dictionary, $words{'(+LOOP)'}); 442 | $fstart = pop(@loop); 443 | push(@dictionary, $fstart); 444 | $here += 4; 445 | fwdref($here, $fstart, $dflag); 446 | print TXT "\t// +LOOP"; next;}; 447 | /^\-loop$/ and do { push(@dictionary, $words{'(-LOOP)'}); 448 | $fstart = pop(@loop); 449 | push(@dictionary, $fstart); 450 | $here += 4; 451 | fwdref($here, $fstart, $dflag); 452 | print TXT "\t// -LOOP"; next;}; 453 | 454 | /^if$/ and do { push(@dictionary, $words{'0branch'}); 455 | push(@dictionary, $iflag); 456 | push(@loop, strip($here)); 457 | $here += 4; 458 | print TXT "\t// IF"; next;}; 459 | /^else$/ and do { $here += 4; fwdref($here, pop(@loop), $iflag); 460 | push(@dictionary, $words{'branch'}); 461 | push(@dictionary, $iflag); 462 | push(@loop, strip($here)); 463 | print TXT "\t// ELSE"; next;}; 464 | /^then$/ and do { fwdref($here, pop(@loop), $iflag); 465 | print TXT "\t// THEN"; next;}; 466 | 467 | # compile word addresses into dictionary 468 | exists $words{$_} or die "Undefined word, \"$_\", in line #$linenum\n"; 469 | push(@dictionary, $words{$_}); 470 | printf( TXT "\n%0.4u %#0.4x > $_", $linenum, $words{$_}); 471 | $here += 2; 472 | if(exists $vars{$_}) { 473 | push(@dictionary, $vars{$_}); 474 | $here += 2; 475 | } 476 | } else { # not inside colon def or code def 477 | 478 | # forth variable name 479 | if($variable) { 480 | $variable = 0; 481 | $words{$_} = $words{'dovar'}; 482 | $vars{$_} = strip($here); 483 | donum(0, 'variable', 'dovar'); 484 | next; 485 | } 486 | # forth constant name 487 | if($constant) { 488 | $constant = 0; 489 | $words{$_} = $words{'doconst'}; 490 | $vars{$_} = strip($here); 491 | donum($value, 'constant', 'doconst'); 492 | next; 493 | } 494 | 495 | # forth alias name 496 | if($alias) { 497 | $alias = 0; 498 | $words{$_} = $words{$ticked}; 499 | next; 500 | } 501 | 502 | # start of colon definition 503 | /^:\s*$/ and do {$naming = -1; $compiling = -1; next;}; 504 | 505 | # save numeric values for subsequent constant 506 | /^\d+$/ and do { $value = $_; next;}; 507 | /^0x[0123456789abcdefABCDEF]+$/ and do { $value = $_; next;}; 508 | /^0b[01]+$/ and do { $value = $_; next;}; 509 | 510 | # prepare to handle variable, constant, or alias name 511 | /^variable$/ and do {$variable = -1; next;}; 512 | /^constant$/ and do {$constant = -1; next;}; 513 | /^alias$/ and do {$alias = -1; next;}; 514 | } 515 | } 516 | $address++ if $bump; 517 | $address += $pseudo; 518 | print TXT "\n"; 519 | $bump = 0; 520 | $pseudo = 0; 521 | } 522 | $fh = pop(@files); 523 | $fh->close; 524 | } 525 | 526 | 527 | --------------------------------------------------------------------------------