![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to locals.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / fcode|
Return to locals.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / fcode |
1.1 ! root 1: \ ***************************************************************************** ! 2: \ * Copyright (c) 2011 IBM Corporation ! 3: \ * All rights reserved. ! 4: \ * This program and the accompanying materials ! 5: \ * are made available under the terms of the BSD License ! 6: \ * which accompanies this distribution, and is available at ! 7: \ * http://www.opensource.org/licenses/bsd-license.php ! 8: \ * ! 9: \ * Contributors: ! 10: \ * IBM Corporation - initial implementation ! 11: \ ****************************************************************************/ ! 12: \ * ! 13: \ * Support for old-fashioned local values in FCODE. ! 14: \ * ! 15: \ * There is one old FCODE tokenizer that uses the FCODE opcodes in the range ! 16: \ * of 0x407 to 0x41f for supporting Forth local values. Each locals stack ! 17: \ * frame contains 8 variables. The opcodes from 0x407 to 0x40f are used to ! 18: \ * push 0 up to 8 values from the normal data stack into the current locals ! 19: \ * stack frame. All other variables in the current stack frame are not ! 20: \ * pre-initialized. ! 21: \ * The opcodes from 0x410 to 0x417 can be used for reading the first, second, ! 22: \ * ... eighth value out of the locals stack frame, and the opcode from 0x418 ! 23: \ * to 0x41f can be used to set the first, second, ... eighth value in the ! 24: \ * stack frame respectively. ! 25: \ * ! 26: ! 27: 80 cells CONSTANT LOCALS-STACK-SIZE ! 28: ! 29: LOCALS-STACK-SIZE BUFFER: localsstackbuf ! 30: ! 31: localsstackbuf VALUE localsstack ! 32: ! 33: ! 34: : fc-local@ ( n -- val ) ! 35: cells localsstack swap - @ ! 36: ; ! 37: ! 38: : fc-local-1-@ 1 fc-local@ ; ! 39: : fc-local-2-@ 2 fc-local@ ; ! 40: : fc-local-3-@ 3 fc-local@ ; ! 41: : fc-local-4-@ 4 fc-local@ ; ! 42: : fc-local-5-@ 5 fc-local@ ; ! 43: : fc-local-6-@ 6 fc-local@ ; ! 44: : fc-local-7-@ 7 fc-local@ ; ! 45: : fc-local-8-@ 8 fc-local@ ; ! 46: ! 47: ! 48: : fc-local! ( val n -- ) ! 49: cells localsstack swap - ! ! 50: ; ! 51: ! 52: : fc-local-1-! 1 fc-local! ; ! 53: : fc-local-2-! 2 fc-local! ; ! 54: : fc-local-3-! 3 fc-local! ; ! 55: : fc-local-4-! 4 fc-local! ; ! 56: : fc-local-5-! 5 fc-local! ; ! 57: : fc-local-6-! 6 fc-local! ; ! 58: : fc-local-7-! 7 fc-local! ; ! 59: : fc-local-8-! 8 fc-local! ; ! 60: ! 61: ! 62: 0 VALUE uses-locals? ! 63: ! 64: \ Create space for the current function on the locals stack. ! 65: \ Pre-initialized the n first locals with the n top-most data stack items. ! 66: \ Note: Each function can use up to 8 (initialized or uninitialized) locals. ! 67: : (fc-push-locals) ( ... n -- ) ! 68: \ cr ." pushing " dup . ." locals" cr ! 69: 8 cells localsstack + TO localsstack ! 70: localsstack localsstackbuf - ! 71: LOCALS-STACK-SIZE > ABORT" Locals stack exceeded!" ! 72: ?dup IF ! 73: ( ... n ) 1 swap DO ! 74: i fc-local! \ Store pre-initialized locals ! 75: -1 +LOOP ! 76: THEN ! 77: ; ! 78: ! 79: : fc-push-locals ( n -- ) ! 80: \ cr ." compiling push for " dup . ." locals" cr ! 81: uses-locals? ABORT" Definition pushes locals multiple times!" ! 82: true TO uses-locals? ! 83: ( n ) ['] literal execute ! 84: ['] (fc-push-locals) compile, ! 85: ; ! 86: ! 87: : fc-push-0-locals 0 fc-push-locals ; ! 88: : fc-push-1-locals 1 fc-push-locals ; ! 89: : fc-push-2-locals 2 fc-push-locals ; ! 90: : fc-push-3-locals 3 fc-push-locals ; ! 91: : fc-push-4-locals 4 fc-push-locals ; ! 92: : fc-push-5-locals 5 fc-push-locals ; ! 93: : fc-push-6-locals 6 fc-push-locals ; ! 94: : fc-push-7-locals 7 fc-push-locals ; ! 95: : fc-push-8-locals 8 fc-push-locals ; ! 96: ! 97: ! 98: : fc-pop-locals ( -- ) ! 99: \ ." popping locals" cr ! 100: localsstack 8 cells - TO localsstack ! 101: localsstack localsstackbuf - 0 < ABORT" Locals stack undeflow!" ! 102: ; ! 103: ! 104: ! 105: : fc-locals-exit ! 106: uses-locals? IF ! 107: \ ." compiling pop-locals for exit" cr ! 108: ['] fc-pop-locals compile, ! 109: THEN ! 110: ['] exit compile, ! 111: ; ! 112: ! 113: : fc-locals-b(;) ! 114: uses-locals? IF ! 115: \ ." compiling pop-locals for b(;)" cr ! 116: ['] fc-pop-locals compile, ! 117: THEN ! 118: false TO uses-locals? ! 119: ['] b(;) execute ! 120: ; ! 121: ! 122: ! 123: : fc-set-locals-tokens ( -- ) ! 124: ['] fc-push-0-locals 1 407 set-token ! 125: ['] fc-push-1-locals 1 408 set-token ! 126: ['] fc-push-2-locals 1 409 set-token ! 127: ['] fc-push-3-locals 1 40a set-token ! 128: ['] fc-push-4-locals 1 40b set-token ! 129: ['] fc-push-5-locals 1 40c set-token ! 130: ['] fc-push-6-locals 1 40d set-token ! 131: ['] fc-push-7-locals 1 40e set-token ! 132: ['] fc-push-8-locals 1 40f set-token ! 133: ! 134: ['] fc-local-1-@ 0 410 set-token ! 135: ['] fc-local-2-@ 0 411 set-token ! 136: ['] fc-local-3-@ 0 412 set-token ! 137: ['] fc-local-4-@ 0 413 set-token ! 138: ['] fc-local-5-@ 0 414 set-token ! 139: ['] fc-local-6-@ 0 415 set-token ! 140: ['] fc-local-7-@ 0 416 set-token ! 141: ['] fc-local-8-@ 0 417 set-token ! 142: ! 143: ['] fc-local-1-! 0 418 set-token ! 144: ['] fc-local-2-! 0 419 set-token ! 145: ['] fc-local-3-! 0 41a set-token ! 146: ['] fc-local-4-! 0 41b set-token ! 147: ['] fc-local-5-! 0 41c set-token ! 148: ['] fc-local-6-! 0 41d set-token ! 149: ['] fc-local-7-! 0 41e set-token ! 150: ['] fc-local-8-! 0 41f set-token ! 151: ! 152: ['] fc-locals-exit 1 33 set-token ! 153: ['] fc-locals-b(;) 1 c2 set-token ! 154: ; ! 155: fc-set-locals-tokens
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.