├── .adr-dir ├── .dockerignore ├── .editorconfig ├── .github ├── dependabot.yml ├── release-drafter.yml └── workflows │ ├── main.yml │ ├── release-drafter.yml │ └── release.yml ├── .gitignore ├── .gitmodules ├── IKForth-linux.4th ├── IKForth-nt.4th ├── IKForth-test.4th ├── IKForth.4th ├── IKForth.4th.old ├── LICENSE ├── README.md ├── SConscript ├── SConstruct ├── SConstruct-config ├── app ├── ~ik │ └── chess.4th ├── ~jf │ └── CHESS.F └── ~tuz │ └── tt.fs ├── blocks ├── 00000001 └── 00000002 ├── bootdict ├── SConscript ├── bootdict-x86.asm ├── tc │ ├── bootstrap-interpret.asm │ ├── compile-comma.asm │ ├── digits.asm │ ├── except.asm │ ├── file.asm │ ├── forth-vm-notc.asm │ ├── ftable.asm │ ├── h-dot-2.asm │ ├── h-dot-8.asm │ ├── here.asm │ ├── interpret.asm │ ├── literal.asm │ ├── paren-type-paren.asm │ ├── parse.asm │ ├── postpone.asm │ ├── purpose.asm │ ├── recognizer-core.asm │ ├── recognizer-num.asm │ ├── recognizer-word.asm │ ├── search.asm │ ├── seh-handler.asm │ ├── sig-handler.asm │ ├── source.asm │ ├── tc-def.asm │ ├── tc-trace.asm │ ├── two-literal.asm │ ├── user.asm │ └── varconst.asm ├── x86-dtc │ ├── forth-vm-dtc.asm │ └── header-dtc.asm ├── x86-itc │ ├── forth-vm-itc.asm │ └── header-itc.asm ├── x86-wordlist │ ├── entry-create.asm │ ├── entry-flags.asm │ ├── entry-traverse.asm │ ├── forth-wordlist.asm │ ├── included-wordlist.asm │ ├── wordlist-create.asm │ ├── wordlist-def.asm │ ├── wordlist-search.asm │ └── wordlist-traverse.asm └── x86 │ ├── allot.asm │ ├── b-comma.asm │ ├── b-to-h.asm │ ├── bootdict-header.asm │ ├── c-comma.asm │ ├── call-comma.asm │ ├── call-ffl.asm │ ├── comma.asm │ ├── compare.asm │ ├── double.asm │ ├── excp-zero.asm │ ├── fcontrol.asm │ ├── forth-vm.asm │ ├── host.asm │ ├── init-user.asm │ ├── main-proc.asm │ ├── math.asm │ ├── memory.asm │ ├── paren-name-equals-paren.asm │ ├── paren-parse-paren.asm │ ├── primitives.asm │ ├── rstack.asm │ ├── s-to-d.asm │ ├── source-id-store.asm │ ├── source-id.asm │ ├── split-8.asm │ ├── stack.asm │ ├── string.asm │ ├── sys-upcase.asm │ ├── syslinux-thread.asm │ ├── sysnt-thread.asm │ ├── to-digit.asm │ └── to-number.asm ├── docker ├── build-ci.sh ├── centos-stream10 │ └── Dockerfile ├── centos-stream9 │ └── Dockerfile ├── fedora-39 │ └── Dockerfile ├── fedora-40 │ └── Dockerfile ├── fedora-41 │ └── Dockerfile ├── hide-logs.sh ├── install-fasm.sh ├── install-scons.sh ├── python-requirements.txt ├── rocky-8 │ └── Dockerfile ├── rocky-9 │ └── Dockerfile ├── ubuntu-18.04-lts │ └── Dockerfile ├── ubuntu-20.04-lts │ └── Dockerfile ├── ubuntu-22.04-lts │ └── Dockerfile ├── ubuntu-24.04-lts │ └── Dockerfile ├── ubuntu-24.10 │ └── Dockerfile └── ubuntu-25.04 │ └── Dockerfile ├── docs ├── _config.yml ├── adr │ ├── 0001-record-architecture-decisions.md │ └── 0002-32-bits-code.md ├── building.md ├── floating-point │ ├── Represent_20.txt │ ├── TruncToms.pdf │ ├── finalversion.pdf │ ├── fun_aprox.pdf │ ├── how-to-print-floating-point-numbers-accurately.pdf │ └── trig_approximations.pdf ├── hacking.md ├── index.md ├── unum │ ├── A Radical Approach to Computation with Real Numbers - 94-743-1-PB.pdf │ ├── Beating Floating Point at its Own Game- Posit Arithmetic - 137-897-1-PB.pdf │ └── Posits4.pdf └── x86 │ ├── Encoding Real x86 Instructions.pdf │ └── octal_x86.txt ├── lib ├── linconst.4th ├── meta │ └── Kernel.4th ├── template.4th ├── winconst.4th ├── ~be │ ├── float-test.f │ └── float.f ├── ~ik │ ├── fa-asm-x86-32.4th │ ├── fa-asm-x86-32 │ │ ├── op-adc.4th │ │ ├── op-add.4th │ │ ├── op-and.4th │ │ ├── op-bsf.4th │ │ ├── op-bsr.4th │ │ ├── op-bswap.4th │ │ ├── op-bt.4th │ │ ├── op-btc.4th │ │ ├── op-btr.4th │ │ ├── op-bts.4th │ │ ├── op-cmp.4th │ │ ├── op-cmpxchg.4th │ │ ├── op-dec.4th │ │ ├── op-div.4th │ │ ├── op-idiv.4th │ │ ├── op-imul.4th │ │ ├── op-inc.4th │ │ ├── op-mov-data.4th │ │ ├── op-movzx.4th │ │ ├── op-mul.4th │ │ ├── op-neg.4th │ │ ├── op-nop.4th │ │ ├── op-not.4th │ │ ├── op-or.4th │ │ ├── op-pop.4th │ │ ├── op-push.4th │ │ ├── op-rcl.4th │ │ ├── op-rcr.4th │ │ ├── op-rol.4th │ │ ├── op-ror.4th │ │ ├── op-sal.4th │ │ ├── op-sar.4th │ │ ├── op-sbb.4th │ │ ├── op-set-cond.4th │ │ ├── op-shl.4th │ │ ├── op-shr.4th │ │ ├── op-sub.4th │ │ ├── op-test.4th │ │ ├── op-xchg.4th │ │ └── op-xor.4th │ ├── float-ieee-binary.4th │ ├── float-ieee-binary │ │ ├── f-compare-zero.4th │ │ ├── f-compare.4th │ │ ├── f-exp.4th │ │ ├── f-hyptrig.4th │ │ ├── f-isqrt.4th │ │ ├── f-log.4th │ │ ├── f-plus-f-minus.4th │ │ ├── f-slash-goldschmidt.4th │ │ ├── f-slash-newton-raphson.4th │ │ ├── f-slash.4th │ │ ├── f-sqrt.4th │ │ ├── f-star-star.4th │ │ ├── f-star.4th │ │ ├── f-trig.4th │ │ ├── fused-mul-add.4th │ │ ├── represent.4th │ │ └── to-float.4th │ ├── float-output.4th │ ├── float.4th │ ├── fpout.4th │ ├── open-interpreter.4th │ ├── peimage.4th │ ├── quadruple.4th │ ├── tdasm-x86-32.4th │ ├── tdasm-x86-32 │ │ └── 8b-opcode.4th │ └── triple.4th ├── ~jp │ └── debugger.f └── ~js │ └── 486asm │ ├── 486ASM.F │ ├── 486ASM.TXT │ ├── 486READ.ME │ ├── ASMMAC.F │ ├── ASMWIN32.F │ ├── COPYASM.486 │ └── VCALL.F ├── product ├── ikforth-base-x86 │ └── product-dict.4th ├── ikforth-dev-x86 │ ├── SConscript │ ├── product-builder.4th │ └── product-dict.4th └── ikforth-dist │ └── SConscript ├── sysdict ├── S$.4th ├── SConstruct-config ├── args.4th ├── block.4th ├── case.4th ├── chain.4th ├── class.4th ├── console.4th ├── const.4th ├── constdict.4th ├── core-tools.4th ├── core.4th ├── double.4th ├── dynlib.4th ├── environment.4th ├── exception-ext.4th ├── exception.4th ├── fetchstore-ext.4th ├── file.4th ├── format.4th ├── hostenv.4th ├── int-slash-comp-colon.4th ├── literal-ext.4th ├── locals-ext.4th ├── locals-stack.4th ├── locals.4th ├── locate.4th ├── loop.4th ├── macro.4th ├── main.4th ├── marker.4th ├── misc.4th ├── platform.4th ├── primitives.4th ├── quit.4th ├── quotations.4th ├── recognizer.4th ├── required.4th ├── search-order.4th ├── see.4th ├── sformat.4th ├── source.4th ├── string-escape.4th ├── string-substitute.4th ├── string.4th ├── struct.4th ├── term │ ├── ansiterm.4th │ ├── linconsole.4th │ ├── linterm-ekey.4th │ └── winconsole.4th ├── tools.4th ├── trace.4th ├── value.4th ├── word.4th ├── x86-linux.4th ├── x86-linux │ ├── libc.4th │ ├── libreadline.4th │ ├── linconst.4th │ ├── lindynlib.4th │ └── linfile.4th ├── x86-windows.4th ├── x86-windows │ ├── kernel32.4th │ ├── winconst.4th │ ├── winerr.4th │ ├── winexception.4th │ ├── winfile.4th │ └── winmisc.4th ├── x86 │ ├── 486asm.4th │ ├── create.4th │ ├── exit.4th │ ├── i-tick.4th │ ├── i.4th │ ├── j.4th │ ├── leave.4th │ └── paren-do-paren.4th └── zchar.4th ├── test ├── forth2012-test.4th ├── fp-test.4th ├── hostenv-test.4th ├── literal-ext-test.4th ├── locals-test.4th ├── stdin-test.4th ├── string-test.4th └── winconst-test.4th └── tools ├── linconst-extract ├── SConscript ├── linconst-extract.c ├── linconst-publish.c ├── linconst-publish.i ├── linconst.h ├── regex-exclude ├── regex-exclude-names └── regex-include ├── loader ├── FKernel.cpp ├── FKernel.hpp ├── FKernel.winedbg ├── IKFCommon.hpp ├── IKFUtils.cpp ├── IKFUtils.hpp ├── IKFunc.cpp ├── IKFunc.hpp ├── SConscript ├── args.cpp ├── args.hpp ├── dictmem.hpp ├── filereadline.cpp ├── sysio.hpp ├── syslinux │ ├── dictmem.cpp │ ├── syserror.cpp │ ├── sysio.cpp │ ├── syslib.cpp │ ├── sysmem.cpp │ └── systhread.cpp └── sysnt │ ├── dictmem.cpp │ ├── syserror.cpp │ ├── sysio.cpp │ ├── syslib.cpp │ ├── sysmem.cpp │ └── systhread.cpp └── winconst-extract ├── SConscript ├── regex-exclude ├── regex-exclude-names ├── regex-include ├── winconst-extract.c └── winconst-publish.c /.adr-dir: -------------------------------------------------------------------------------- 1 | docs/adr 2 | -------------------------------------------------------------------------------- /.dockerignore: -------------------------------------------------------------------------------- 1 | .git 2 | .vscode 3 | .ionide 4 | .scon* 5 | build/* 6 | core.* 7 | *.log 8 | .fleet/* 9 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | root = true 2 | 3 | [*] 4 | indent_style = space 5 | indent_size = 4 6 | charset = utf-8 7 | trim_trailing_whitespace = true 8 | insert_final_newline = true 9 | 10 | [*.4th] 11 | indent_size = 3 12 | 13 | [{*.yml,*.md,*.sh}] 14 | indent_size = 2 15 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | # Please see the documentation for all configuration options: 2 | # https://docs.github.com/code-security/dependabot/dependabot-version-updates/configuration-options-for-the-dependabot.yml-file 3 | 4 | version: 2 5 | updates: 6 | - package-ecosystem: "github-actions" 7 | directory: "/" 8 | schedule: 9 | interval: daily 10 | time: "00:30" 11 | timezone: Europe/Paris 12 | open-pull-requests-limit: 2 13 | labels: 14 | - area/infra 15 | rebase-strategy: auto 16 | 17 | - package-ecosystem: "pip" 18 | directory: "/docker" 19 | schedule: 20 | interval: daily 21 | time: "00:30" 22 | timezone: Europe/Paris 23 | open-pull-requests-limit: 2 24 | labels: 25 | - area/infra 26 | rebase-strategy: auto 27 | -------------------------------------------------------------------------------- /.github/release-drafter.yml: -------------------------------------------------------------------------------- 1 | _extends: .github 2 | categories: 3 | - title: '🚀 Features' 4 | labels: 5 | - 'feature' 6 | - 'enhancement' 7 | - title: '🐛 Bug Fixes' 8 | labels: 9 | - 'fix' 10 | - 'bugfix' 11 | - 'bug' 12 | - title: '🧰 Maintenance' 13 | labels: 14 | - 'area/infra' 15 | - 'chore' 16 | - title: '⬆️ Dependencies' 17 | collapse-after: 5 18 | labels: 19 | - 'area/dependencies' 20 | - title: '🔬 Others' 21 | labels: 22 | - 'style' 23 | - 'refactor' 24 | - 'test' 25 | - 'ci' 26 | collapse-after: 5 27 | change-template: '- $TITLE @$AUTHOR (#$NUMBER)' 28 | change-title-escapes: '\<*_&' # You can add # and @ to disable mentions, and add ` to disable code blocks. 29 | autolabeler: 30 | - label: 'breaking change' 31 | title: 32 | - '/!:/i' 33 | - label: 'feature' 34 | title: 35 | - '/feat:/i' 36 | - label: 'bug' 37 | title: 38 | - '/fix:/i' 39 | - label: 'style' 40 | title: 41 | - '/style:/i' 42 | - label: 'refactor' 43 | title: 44 | - '/refactor:/i' 45 | - label: 'test' 46 | title: 47 | - '/test:/i' 48 | - label: 'chore' 49 | title: 50 | - '/chore:/i' 51 | - label: 'docs' 52 | title: 53 | - '/docs:/i' 54 | - label: 'ci' 55 | title: 56 | - '/ci:/i' 57 | - label: 'dependencies' 58 | title: 59 | - '/deps:/i' 60 | - '/dependencies:/i' 61 | - '/bump:/i' 62 | template: | 63 | ## Changes 64 | 65 | $CHANGES 66 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: CI 4 | 5 | # Controls when the action will run. 6 | on: 7 | push: 8 | pull_request: 9 | 10 | # Allows you to run this workflow manually from the Actions tab 11 | workflow_dispatch: 12 | 13 | schedule: 14 | # * is a special character in YAML so you have to quote this string 15 | - cron: "0 4 */7 * *" 16 | 17 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 18 | jobs: 19 | # This workflow contains a single job called "build" 20 | build: 21 | # The type of runner that the job will run on 22 | runs-on: ubuntu-latest 23 | 24 | strategy: 25 | fail-fast: false 26 | matrix: 27 | CI_OS: 28 | - centos-stream9 29 | # - centos-stream10 30 | - fedora-39 31 | - fedora-40 32 | - fedora-41 33 | # - rocky-8 34 | - rocky-9 35 | # - ubuntu-18.04-lts 36 | - ubuntu-20.04-lts 37 | - ubuntu-22.04-lts 38 | - ubuntu-24.04-lts 39 | - ubuntu-24.10 40 | - ubuntu-25.04 41 | 42 | # Steps represent a sequence of tasks that will be executed as part of the job 43 | steps: 44 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 45 | - uses: actions/checkout@v4 46 | 47 | - name: Prepare the build container 48 | env: 49 | DOCKER_FILE: docker/${{ matrix.CI_OS }}/Dockerfile 50 | run: | 51 | docker build --rm -f ${DOCKER_FILE} --build-arg RUNUID=$UID -t ikforth-build:latest . 52 | docker run --rm -i -v $PWD:/opt/ikforth ikforth-build:latest -c "scons -c linux all && scons -c win32 all" 53 | 54 | - name: Build IKForth 55 | run: | 56 | export GIT_DESC=`git describe --tags --always --abbrev=8 --dirty=-wip` 57 | ./docker/build-ci.sh 58 | -------------------------------------------------------------------------------- /.github/workflows/release-drafter.yml: -------------------------------------------------------------------------------- 1 | name: Release Drafter 2 | on: 3 | push: 4 | branches: 5 | - master 6 | workflow_dispatch: 7 | jobs: 8 | update_release_draft: 9 | runs-on: ubuntu-latest 10 | steps: 11 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 12 | - uses: actions/checkout@v4 13 | with: 14 | fetch-depth: 0 15 | fetch-tags: true 16 | 17 | - name: Generate Git Describe version 18 | id: git_describe_ver 19 | run: | 20 | export GIT_DESC=`git describe --tags --always --abbrev=8 --dirty=-wip` 21 | export BUILD_TAG=${GIT_DESC} 22 | export VERSION=${BUILD_TAG:1} 23 | echo "version=${VERSION}" >> $GITHUB_OUTPUT 24 | echo "tag=${BUILD_TAG}" >> $GITHUB_OUTPUT 25 | echo "name=IKForth ${VERSION}" >> $GITHUB_OUTPUT 26 | echo "Version set to ${VERSION}" 27 | - uses: release-drafter/release-drafter@v6 28 | with: 29 | tag: ${{ steps.git_describe_ver.outputs.tag }} 30 | name: ${{ steps.git_describe_ver.outputs.name }} 31 | version: ${{ steps.git_describe_ver.outputs.version }} 32 | env: 33 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 34 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | # Release Workflow 2 | 3 | name: Release 4 | 5 | # Controls when the action will run. 6 | on: 7 | push: 8 | tags: 9 | - 'v*' # Push events to matching v*, i.e. v1.0, v20.15.10' 10 | 11 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 12 | jobs: 13 | # This workflow contains a single job called "build" 14 | build: 15 | # The type of runner that the job will run on 16 | runs-on: ubuntu-latest 17 | 18 | env: 19 | DOCKER_FILE: docker/fedora-40/Dockerfile 20 | 21 | # Steps represent a sequence of tasks that will be executed as part of the job 22 | steps: 23 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 24 | - uses: actions/checkout@v4 25 | 26 | - name: Prepare the build container 27 | run: | 28 | docker build --rm -f ${DOCKER_FILE} --build-arg RUNUID=$UID -t ikforth-build:latest . 29 | docker run --rm -i -v $PWD:/opt/ikforth ikforth-build:latest -c "scons -c linux all && scons -c win32 all" 30 | 31 | - name: Set build environment variables 32 | run: | 33 | export GIT_DESC=`git describe --tags --always --abbrev=8 --dirty=-wip` 34 | export BUILD_TAG=${GIT_DESC} 35 | echo GIT_DESC=$GIT_DESC >> $GITHUB_ENV 36 | echo BUILD_TAG=$BUILD_TAG >> $GITHUB_ENV 37 | echo RELEASE_TAG=${BUILD_TAG:1} >> $GITHUB_ENV 38 | 39 | - name: Build IKForth 40 | run: | 41 | ./docker/build-ci.sh 42 | 43 | - name: Release 44 | uses: softprops/action-gh-release@v2 45 | with: 46 | name: IKForth ${{ env.RELEASE_TAG }} 47 | prerelease: true 48 | files: | 49 | build/ikforth-dist/ikforth-dist-${{ env.BUILD_TAG }}.tar.gz 50 | build/ikforth-dist/ikforth-dist-${{ env.BUILD_TAG }}.zip 51 | env: 52 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 53 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.err 2 | *.exe 3 | *.obj 4 | *.lnk 5 | *.log 6 | *.map 7 | *.img 8 | *.o 9 | *.lst 10 | *.sym 11 | .sconsign.dblite 12 | IKForth-* 13 | fatest1.txt 14 | FATEST2.TXT 15 | .vscode 16 | .ionide/ 17 | build/ 18 | !*.4th 19 | .fleet/ 20 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "test/forth2012-test-suite"] 2 | path = test/forth2012-test-suite 3 | url = https://github.com/ikysil/forth2012-test-suite.git 4 | -------------------------------------------------------------------------------- /IKForth-linux.4th: -------------------------------------------------------------------------------- 1 | #! ./IKForth-linux.elf -f 2 | -------------------------------------------------------------------------------- /IKForth-nt.4th: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/IKForth-nt.4th -------------------------------------------------------------------------------- /IKForth.4th: -------------------------------------------------------------------------------- 1 | REPORT-NEW-NAME OFF 2 | 3 | : debugger s" lib/~jp/debugger.f" included ; 4 | 5 | : load_chess s" app/~ik/chess.4th" included ; 6 | 7 | \ : a1 >r rp@ 1 type r> drop ; 8 | 9 | \ USER TYPE-RESULT 1 CELLS USER-ALLOC 10 | 11 | \ : type (s c-addr len - ) 12 | \ >R >R 13 | \ 0 14 | \ TYPE-RESULT 15 | \ R> R> SWAP 16 | \ STDOUT 17 | \ WriteConsole \ ( hOut, PChar( S ), Length( S ), Result, nil ); 18 | \ ; 19 | 20 | [DEFINED] RaiseException [IF] 21 | : NTHROW (S exc-id -- ) 22 | >R 0 0 0 R> RaiseException ; 23 | [THEN] 24 | 25 | : .RS RP@ DUP RDEPTH CELLS + SWAP 26 | ?DO I @ 1 CELLS - DUP HERE U< IF @ DUP CODE>NAME SWAP ." 0x" H.8 SPACE NAME>STRING TYPE CR 27 | ELSE DROP THEN 1 CELLS +LOOP ; 28 | 29 | : .RSV RP@ DUP RDEPTH CELLS + SWAP 30 | ?DO I @ 1 CELLS - ." 0x" H.8 CR 1 CELLS +LOOP ; 31 | 32 | : .RSVC RP@ DUP RDEPTH CELLS + SWAP 33 | ?DO I @ 1 CELLS - @ ." 0x" H.8 CR 1 CELLS +LOOP ; 34 | 35 | : .RS-DAB RP@ DUP RDEPTH CELLS+ SWAP 36 | ?DO I 37 | DUP ." @ 0x" H.8 SPACE 38 | @ CELL- 39 | DUP DATA-AREA-BASE HERE ROT WITHIN 40 | IF 41 | @ DUP CODE>NAME SWAP ." 0x" H.8 SPACE NAME>STRING TYPE CR 42 | ELSE 43 | ." 0x" H.8 CR 44 | THEN 45 | 1 CELLS 46 | +LOOP 47 | ; 48 | 49 | : t.rs2 .rs-dab ; 50 | : t.rs1 123 >r t.rs2 r> drop ; 51 | 52 | : st1 s" 123" s" 123" compare . ; 53 | : st2 s" 231" s" 123" compare . ; 54 | : st3 s" 123" s" 213" compare . ; 55 | : st4 s" " s" " compare . ; 56 | : st5 s" " s" 1" compare . ; 57 | : st6 s" 1" s" " compare . ; 58 | : st st1 st2 st3 st4 st5 st6 ; 59 | 60 | \ st 61 | 62 | requires" lib/~ik/open-interpreter.4th" 63 | requires" lib/~ik/peimage.4th" 64 | 65 | CR .( Startup ) CR 66 | STARTUP-CHAIN CHAIN.SHOW 67 | 68 | CR .( Shutdown ) CR 69 | SHUTDOWN-CHAIN CHAIN.SHOW 70 | -------------------------------------------------------------------------------- /IKForth.4th.old: -------------------------------------------------------------------------------- 1 | \ s" ext\unit.f" included 2 | ( 3 | s" ext\fetchstore-ext.f" included 4 | 5 | HEX 6 | 7 | : FS-TEST >IN @ PARSE-NAME TYPE 9 EMIT >IN ! ' EXECUTE ; 8 | 9 | VARIABLE A-TEST 10 | 11 | 44FF A-TEST ! 12 | 13 | A-TEST 14 | CR DUP FS-TEST U@16B 9 U.R 15 | CR DUP FS-TEST @16B 9 U.R 16 | CR DUP FS-TEST U@16L 9 U.R 17 | CR DUP FS-TEST @16L 9 U.R 18 | DROP 19 | ) 20 | : WT S" TEST\WORDSTEST.F" INCLUDED ; 21 | 22 | ( 23 | : kernel include" kernel.f\kernel.f" ; 24 | 25 | kernel 26 | 27 | CR 28 | 29 | : DW GET-ORDER 30 | >IN @ >R PARSE-NAME TYPE 31 | CR R@ >IN ! ONLY ' >BODY 64 DUMP 32 | CR R> >IN ! ALSO TARGET ' >BODY 64 DUMP 33 | SET-ORDER ; 34 | HEX 35 | cr 20000000 GET-BASE-ADDR h.8 36 | cr 20040000 GET-BASE-ADDR h.8 37 | cr 20080000 GET-BASE-ADDR h.8 38 | cr 200c0000 GET-BASE-ADDR h.8 39 | DECIMAL 40 | ) 41 | \ S" EXT\CLASS-NEW.F" INCLUDED 42 | \ S" test" GET/CREATE-FIELD-ID 43 | \ CR S" .name" GET/CREATE-METHOD-ID h.8 44 | \ CR S" .name" GET-METHOD-ID h.8 45 | cr 46 | object >members 12 dump 47 | 48 | object invoke .name 49 | class: test 50 | 1 cells field test 51 | 1 cells field test1 52 | M: t ;M 53 | 123 M-ID: ." Should print 123" ;M 54 | ;class 55 | 56 | class: test1 test 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ikforth 2 | 3 | **ikforth** is an idiomatic Forth implementation. 4 | 5 | [![Build Status](https://github.com/ikysil/ikforth/workflows/CI/badge.svg?action=push)](https://github.com/ikysil/ikforth/actions) 6 | 7 | A few facts: 8 | 9 | * 32 bits code 10 | * Runs on Linux and Windows (tested with Wine) 11 | * Supports Indirect and Direct Threaded Code representations 12 | * Image-based system 13 | * x86 assembler is used to bootstrap image capable of interpreting from files 14 | * Image is NOT relocatable - absolute 32 bits addresses are used in native and threaded code 15 | * CELL size is 32 bits 16 | * CHAR size is 8 bits 17 | * addressable unit - 1 byte (8 bits) 18 | 19 | ---- 20 | 21 | * 22 | * 23 | -------------------------------------------------------------------------------- /SConscript: -------------------------------------------------------------------------------- 1 | # ikforth 2 | import os 3 | 4 | Import('env', 'fkernelPath', 'productdict') 5 | senv = env.Clone() 6 | 7 | ikforthExec = senv.execname('IKForth-${TSYS}') 8 | ikforthDict = 'IKForth-${TSYS}.img' 9 | 10 | senv.Replace(RUN_CMD = '${RUN_LAUNCHER} ./' + ikforthExec) 11 | 12 | def run(source, target, env): 13 | env.Execute('${RUN_CMD}') 14 | 15 | def test(source, target, env): 16 | env.Execute('${RUN_CMD} -f IKForth-test.4th') 17 | 18 | def test_stdin(source, target, env): 19 | env.Execute('echo \'S\" fine!\" TYPE\' | ${RUN_CMD} -f test/stdin-test.4th') 20 | 21 | def ansitest(source, target, env): 22 | Execute(Mkdir('build/forth2012-test-blocks')) 23 | env.Execute('${RUN_CMD} -f test/forth2012-test.4th') 24 | 25 | def fptest(source, target, env): 26 | env.Execute('${RUN_CMD} -f test/fp-test.4th') 27 | 28 | senv.InstallAs(ikforthDict, productdict) 29 | senv.InstallAs(ikforthExec, fkernelPath) 30 | senv.NoClean([ikforthDict, ikforthExec]) 31 | 32 | senv.Alias('ikforth', [ikforthExec, ikforthDict]) 33 | 34 | senv.Alias('all', ['ikforth']) 35 | senv.Clean('all', [ 36 | '#build', 37 | "#.sconsign.dblite", 38 | "#.sconf_temp", 39 | "#config.log", 40 | ]) 41 | 42 | senv.Alias('run', [], run) 43 | senv.Alias('test', [], test) 44 | senv.Alias('test-stdin', [], test_stdin) 45 | senv.Alias('ansitest', [], ansitest) 46 | senv.Alias('fptest', [], fptest) 47 | 48 | senv.Depends('run', ['ikforth']) 49 | senv.Depends('test', ['ikforth']) 50 | senv.Depends('test-stdin', ['ikforth']) 51 | senv.Depends('ansitest', ['ikforth']) 52 | senv.Depends('fptest', ['ikforth']) 53 | 54 | senv.AlwaysBuild('run', 'test', 'test-stdin', 'ansitest', 'fptest') 55 | -------------------------------------------------------------------------------- /SConstruct: -------------------------------------------------------------------------------- 1 | import os 2 | 3 | env = Environment(ENV = os.environ) 4 | 5 | env.SConscriptChdir(0) 6 | env.SConscript('SConstruct-config', 7 | exports = ['env']) 8 | 9 | fkernelPath = env.SConscript(dirs = ['tools/loader'], 10 | exports = ['env'], 11 | variant_dir = 'build/loader-$TSYS', duplicate = 0) 12 | 13 | env_bootdict = env.Clone() 14 | env_bootdict['ARCH'] = 'x86' 15 | bootdict = env.SConscript(dirs = ['bootdict'], 16 | exports = ['env_bootdict'], 17 | variant_dir = 'build/bootdict', duplicate = 0) 18 | 19 | if 'winconst' in BUILD_TARGETS: 20 | env.SConscript(dirs = ['tools/winconst-extract'], 21 | exports = ['env'], 22 | variant_dir = 'build/winconst-extract', duplicate = 1) 23 | 24 | if 'linconst' in BUILD_TARGETS: 25 | env.SConscript(dirs = ['tools/linconst-extract'], 26 | exports = ['env'], 27 | variant_dir = 'build/linconst-extract', duplicate = 1) 28 | 29 | productdict = env.SConscript(dirs = ['product/ikforth-dev-x86'], 30 | exports = ['env', 'fkernelPath', 'bootdict'], 31 | variant_dir = 'build/ikforth-dev-$TSYS-$TERMINIT', duplicate = 1) 32 | 33 | env.SConscript('SConscript', 34 | exports = ['env', 'fkernelPath', 'productdict']) 35 | 36 | env.SConscript(dirs = ['product/ikforth-dist'], 37 | exports = ['env'], 38 | variant_dir = 'build/ikforth-dist', duplicate = 0) 39 | 40 | env.Default('all') 41 | -------------------------------------------------------------------------------- /app/~ik/chess.4th: -------------------------------------------------------------------------------- 1 | : scroll ; 2 | : cls page ; 3 | 4 | S" app/~jf/CHESS.F" included 5 | -------------------------------------------------------------------------------- /blocks/00000001: -------------------------------------------------------------------------------- 1 | .( Block #1 ) S" 123" EVALUATE 123 = . S" 124" EVALUATE 124 = . -------------------------------------------------------------------------------- /blocks/00000002: -------------------------------------------------------------------------------- 1 | \ 123 123 -------------------------------------------------------------------------------- /bootdict/SConscript: -------------------------------------------------------------------------------- 1 | Import('env_bootdict') 2 | senv = env_bootdict.Clone() 3 | senv['bootdictname'] = 'bootdict-${ARCH}' 4 | 5 | bootdict_src = [] 6 | bootdict_src.extend(senv.Glob('#bootdict/*.asm')) 7 | bootdict_src.extend(senv.Glob('#bootdict/tc/*.asm')) 8 | bootdict_src.extend(senv.Glob('#bootdict/${ARCH}/*.asm')) 9 | bootdict_src.extend(senv.Glob('#bootdict/${ARCH}-itc/*.asm')) 10 | bootdict_src.extend(senv.Glob('#bootdict/${ARCH}-dtc/*.asm')) 11 | bootdict_src.extend(senv.Glob('#bootdict/${ARCH}-wordlist/*.asm')) 12 | 13 | bootdict = senv.Command('${bootdictname}.img', 14 | bootdict_src, 15 | 'fasm -d CODE_THREADING=${CODE_THREADING_TYPE} -d DEBUG=${DEBUG} bootdict/${bootdictname}.asm -s ${TARGET.dir}/${bootdictname}.sym $TARGET') 16 | 17 | bootdict_listing = senv.Command('${bootdictname}.lst', 18 | ['${bootdictname}.sym', '${bootdictname}.img'], 19 | 'listing $SOURCE $TARGET') 20 | 21 | senv.Alias('bootdict-listing', bootdict_listing) 22 | 23 | senv.SideEffect('${bootdictname}.sym', bootdict) 24 | senv.Alias('bootdict', [bootdict, bootdict_listing]) 25 | 26 | Return('bootdict') 27 | -------------------------------------------------------------------------------- /bootdict/tc/bootstrap-interpret.asm: -------------------------------------------------------------------------------- 1 | $COLON 'BOOTSTRAP-INTERPRET',$BOOTSTRAP_INTERPRET,VEF_HIDDEN 2 | CW $INIT_USER 3 | CFETCH $SF 4 | CFETCH $HASH_SF 5 | CWLIT $INCLUDED 6 | CW $CATCH, $DUPE, $EXIT_CODE, $STORE, $QUESTION_DUPE 7 | _IF BSI_HAS_EXCEPTION 8 | $CR 9 | $CR 10 | $WRITE 'Exception caught while INCLUDing [' 11 | CFETCH $SF 12 | CFETCH $HASH_SF 13 | CW $TYPE 14 | $WRITE ']' 15 | $CR 16 | $WRITE 'Exception: H# ' 17 | CW $HOUT8 18 | $CR 19 | CW $TWO_DROP 20 | $WRITE 'HERE: H# ' 21 | CW $HERE, $HOUT8 22 | $CR 23 | $WRITE 'Latest word searched: ' 24 | CW $POCKET, $COUNT, $TYPE 25 | $CR 26 | $WRITE 'Latest vocabulary entry: ' 27 | CW $LATEST_NAME_FETCH, $NAME_TO_STRING, $DUPE, $ZERO_NOT_EQUALS 28 | _IF BSI_ERROR_HAS_NAME 29 | CW $TYPE 30 | _ELSE BSI_ERROR_HAS_NAME 31 | CW $TWO_DROP 32 | $WRITE '(nonamed)' 33 | _THEN BSI_ERROR_HAS_NAME 34 | $CR 35 | $WRITE 'Error in: ' 36 | CW $REPORT_SOURCE 37 | $CR 38 | $CR 39 | _THEN BSI_HAS_EXCEPTION 40 | CW $PBYE 41 | -------------------------------------------------------------------------------- /bootdict/tc/compile-comma.asm: -------------------------------------------------------------------------------- 1 | ; COMPILE, 2 | $COLON 'COMPILE,',$COMPILEC,VEF_COMPILE_ONLY 3 | CW $COMMA 4 | $END_COLON 5 | -------------------------------------------------------------------------------- /bootdict/tc/digits.asm: -------------------------------------------------------------------------------- 1 | ; DIGITS 2 | $CREATE 'DIGITS',$DIGITS 3 | DIGITS_TABLE: 4 | DB '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ',0 5 | -------------------------------------------------------------------------------- /bootdict/tc/forth-vm-notc.asm: -------------------------------------------------------------------------------- 1 | ;****************************************************************************** 2 | ; 3 | ; forth-vm-notc.asm 4 | ; IKForth 5 | ; 6 | ; Unlicense since 1999 by Illya Kysil 7 | ; 8 | ;****************************************************************************** 9 | ; Stop assembling if threading code model is not defined 10 | ;****************************************************************************** 11 | MACRO $CFA [ARGS] { 12 | DISPLAY "ERROR: CODE_THREADING not defined" 13 | ERR 14 | } 15 | 16 | MACRO $JMP [ARGS] { 17 | DISPLAY "ERROR: CODE_THREADING not defined" 18 | ERR 19 | } 20 | 21 | MACRO $NEXT [ARGS] { 22 | DISPLAY "ERROR: CODE_THREADING not defined" 23 | ERR 24 | } 25 | -------------------------------------------------------------------------------- /bootdict/tc/ftable.asm: -------------------------------------------------------------------------------- 1 | ;****************************************************************************** 2 | ; 3 | ; ftable.asm 4 | ; IKForth 5 | ; 6 | ; Unlicense since 1999 by Illya Kysil 7 | ; 8 | ;****************************************************************************** 9 | ; Functions provided by loader. 10 | ; Define these functions as stdcall. 11 | ; First argument is on the top of the data stack. 12 | ; Result ( if any ) is returned via EAX ( int ), EDX:EAX ( long int ). 13 | ;****************************************************************************** 14 | FUNC_NUM = 0 15 | MACRO FUNC_ALLOC SIZE { 16 | FUNC_NUM = FUNC_NUM + SIZE 17 | } 18 | 19 | MACRO $FUNC NAME { 20 | LABEL FUNC_#NAME DWORD AT FUNC_NUM 21 | FUNC_ALLOC 1 22 | } 23 | 24 | MACRO FUNC_ALIGN { 25 | FUNC_NUM = ( FUNC_NUM / CELL_SIZE + 1 ) * CELL_SIZE 26 | } 27 | 28 | FUNC_TABLE_VAR: 29 | DD 0 30 | $FUNC GET_LAST_ERROR 31 | $FUNC LOAD_LIBRARY 32 | $FUNC FREE_LIBRARY 33 | $FUNC GET_PROC_ADDRESS 34 | $FUNC BYE 35 | $FUNC EMIT 36 | $FUNC TYPE 37 | $FUNC FILE_CLOSE 38 | $FUNC FILE_CREATE 39 | $FUNC FILE_POSITION 40 | $FUNC FILE_OPEN 41 | $FUNC FILE_REPOSITION 42 | $FUNC FILE_READ_LINE 43 | $FUNC START_THREAD 44 | $FUNC ALLOCATE 45 | $FUNC FREE 46 | $FUNC REALLOCATE 47 | -------------------------------------------------------------------------------- /bootdict/tc/h-dot-2.asm: -------------------------------------------------------------------------------- 1 | ; Output the byte on the top of the data stack in hexadecimal representation. 2 | ; S: a -- 3 | $COLON 'H.2',$HOUT2 4 | CW $BTOH, $EMIT, $EMIT 5 | $END_COLON 6 | -------------------------------------------------------------------------------- /bootdict/tc/h-dot-8.asm: -------------------------------------------------------------------------------- 1 | ; Output the value on the top of the data stack in hexadecimal representation. 2 | ; S: a -- 3 | $COLON 'H.8',$HOUT8 4 | CW $SPLIT8, $HOUT2, $HOUT2, $HOUT2, $HOUT2 5 | $END_COLON 6 | -------------------------------------------------------------------------------- /bootdict/tc/here.asm: -------------------------------------------------------------------------------- 1 | ; 6.1.1650 HERE 2 | ; addr is the data-space pointer. 3 | ; D: -- addr 4 | $COLON 'HERE',$HERE 5 | CFETCH $DP 6 | $END_COLON 7 | -------------------------------------------------------------------------------- /bootdict/tc/literal.asm: -------------------------------------------------------------------------------- 1 | ; 6.1.1780 LITERAL 2 | $COLON 'LITERAL',$LITERAL,VEF_IMMEDIATE_COMPILE_ONLY 3 | CWLIT $LIT 4 | CW $COMPILEC, $COMMA 5 | $END_COLON 6 | -------------------------------------------------------------------------------- /bootdict/tc/paren-type-paren.asm: -------------------------------------------------------------------------------- 1 | ; (TYPE) 2 | ; Type counted string compiled just after XT of this word 3 | ; and continue execution with the next XT after the string. 4 | $COLON '(TYPE)',$PTYPE 5 | CW $R_FROM ; a 6 | CW $COUNT ; a+1 b 7 | CW $OVER ; a+1 b a+1 8 | CW $OVER ; a+1 b a+1 b 9 | CW $PLUS ; a+1 b a+1+b 10 | CW $TO_R ; a+1 b 11 | CW $TYPE 12 | $END_COLON 13 | -------------------------------------------------------------------------------- /bootdict/tc/postpone.asm: -------------------------------------------------------------------------------- 1 | ; 6.1.2033 POSTPONE 2 | ; Interpretation: 3 | ; Interpretation semantics for this word are undefined. 4 | ; Compilation: 5 | ; ( "name" -- ) 6 | ; Skip leading space delimiters. Parse name delimited by a space. Find name. 7 | ; Append the compilation semantics of name to the current definition. 8 | ; An ambiguous condition exists if name is not found. 9 | $COLON 'POSTPONE',,VEF_IMMEDIATE 10 | CW $PARSE_NAME 11 | CW $FORTH_RECOGNIZER, $DO_RECOGNIZER 12 | CW $DUPE, $TO_R, $R2POST, $EXECUTE, $R_FROM, $R2COMP, $COMPILEC 13 | $END_COLON 14 | -------------------------------------------------------------------------------- /bootdict/tc/purpose.asm: -------------------------------------------------------------------------------- 1 | ;****************************************************************************** 2 | ; 3 | ; purpose.asm 4 | ; IKForth 5 | ; 6 | ; Unlicense since 1999 by Illya Kysil 7 | ; 8 | ;****************************************************************************** 9 | ; Source documentation words. 10 | ;****************************************************************************** 11 | 12 | ; (PURPOSE) ( -- ) 13 | ; Parse till the end of the string and output to the terminal 14 | $COLON '(PURPOSE)',$PPURPOSEP 15 | CW $ZERO, $PARSE 16 | $CR 17 | CW $TYPE,$BL,$EMIT 18 | 19 | $END_COLON 20 | 21 | ; PURPOSE: ( -- ) IMMEDIATE 22 | ; Parse till the end of the string and output to the terminal. 23 | $DEFER 'PURPOSE:',,$PPURPOSEP,VEF_IMMEDIATE 24 | 25 | ; COPYRIGHT: ( -- ) IMMEDIATE 26 | ; Parse till the end of the string and output to the terminal. 27 | $DEFER 'COPYRIGHT:',,$PBSLASH,VEF_IMMEDIATE 28 | 29 | ; LICENSE: ( -- ) IMMEDIATE 30 | ; Parse till the end of the string and output to the terminal. 31 | $DEFER 'LICENSE:',,$PBSLASH,VEF_IMMEDIATE 32 | -------------------------------------------------------------------------------- /bootdict/tc/seh-handler.asm: -------------------------------------------------------------------------------- 1 | ; SEH-HANDLER 2 | ; D: win32-exc-id -- exc-id 3 | $DEFER 'SEH-HANDLER',$SEH_HANDLER,$PSEH_HANDLER 4 | 5 | ; (SEH-HANDLER) 6 | ; D: win32-exc-id -- exc-id 7 | $COLON '(SEH-HANDLER)',$PSEH_HANDLER,VEF_USUAL 8 | $END_COLON 9 | 10 | $USER 'WIN32-EXCEPTION-CONTEXT',$WIN32_EXCEPTION_CONTEXT,VAR_WIN32_EXCEPTION_CONTEXT 11 | -------------------------------------------------------------------------------- /bootdict/tc/sig-handler.asm: -------------------------------------------------------------------------------- 1 | ; SIG-HANDLER 2 | ; D: signal-id -- signal-id 3 | $DEFER 'SIG-HANDLER',$SIG_HANDLER,$PSIG_HANDLER 4 | 5 | ; (SIG-HANDLER) 6 | ; D: signal-id -- signal-id 7 | $COLON '(SIG-HANDLER)',$PSIG_HANDLER,VEF_USUAL 8 | $END_COLON 9 | -------------------------------------------------------------------------------- /bootdict/tc/two-literal.asm: -------------------------------------------------------------------------------- 1 | ; 8.6.1.0390 2LITERAL 2 | $COLON '2LITERAL',$2LITERAL,VEF_IMMEDIATE_COMPILE_ONLY 3 | CWLIT $2LIT 4 | CW $COMPILEC, $SWAP, $COMMA, $COMMA 5 | $END_COLON 6 | -------------------------------------------------------------------------------- /bootdict/x86-dtc/header-dtc.asm: -------------------------------------------------------------------------------- 1 | ;****************************************************************************** 2 | ; 3 | ; header-dtc.asm 4 | ; IKForth 5 | ; 6 | ; Unlicense since 1999 by Illya Kysil 7 | ; 8 | ;****************************************************************************** 9 | ; HEADER & support words - implementation for DTC (Direct Threaded Code) 10 | ;****************************************************************************** 11 | 12 | $CFA -IMAGE_BASE,TMPLT_START,TMPLT_CODE_ADDR_END,TMPLT_END 13 | 14 | ; CFA@ 15 | ; D: xt -- code-addr 16 | ; code-addr is the code address of the word xt 17 | $COLON 'CFA@',$CFAFETCH 18 | CCLIT CFA_EXECUTOR_OFFSET 19 | CW $PLUS, $FETCH 20 | $END_COLON 21 | 22 | ; CFA! 23 | ; D: code-addr xt -- 24 | ; Change a code address of the word xt to code-addr 25 | $COLON 'CFA!',$CFASTORE 26 | CCLIT CFA_EXECUTOR_OFFSET 27 | CW $PLUS, $STORE 28 | $END_COLON 29 | 30 | ; CODE-ADDRESS! 31 | ; D: code-addr xt -- 32 | ; Create a code field with code address code-addr at xt 33 | $COLON 'CODE-ADDRESS!',$CODE_ADDRESS_STORE 34 | CW $DUPE 35 | ; D: code-addr xt xt 36 | CWLIT TMPLT_START 37 | ; D: code-addr xt xt CFA_START 38 | CW $SWAP 39 | ; D: code-addr xt CFA_START xt 40 | CCLIT CFA_SIZE 41 | ; D: code-addr xt CFA_START xt CFA_SIZE 42 | CW $C_MOVE 43 | ; D: code-addr xt 44 | CW $CFASTORE 45 | $END_COLON 46 | 47 | $CONST 'HOST-ITC?',,F_FALSE 48 | 49 | $CONST 'HOST-DTC?',,F_TRUE 50 | -------------------------------------------------------------------------------- /bootdict/x86-itc/header-itc.asm: -------------------------------------------------------------------------------- 1 | ;****************************************************************************** 2 | ; 3 | ; header-itc.asm 4 | ; IKForth 5 | ; 6 | ; Unlicense since 1999 by Illya Kysil 7 | ; 8 | ;****************************************************************************** 9 | ; HEADER & support words - implementation for ITC (Indirect Threaded Code) 10 | ;****************************************************************************** 11 | 12 | ; CFA@ 13 | ; D: xt -- code-addr 14 | ; code-addr is the code address of the word xt 15 | $COLON 'CFA@',$CFAFETCH 16 | CW $FETCH 17 | $END_COLON 18 | 19 | ; CFA! 20 | ; D: code-addr xt -- 21 | ; Change a code address of the word xt to code-addr 22 | $COLON 'CFA!',$CFASTORE 23 | CW $STORE 24 | $END_COLON 25 | 26 | ; CODE-ADDRESS! 27 | ; D: code-addr xt -- 28 | ; Create a code field with code address code-addr at xt 29 | ; Alias to CFA! on ITC systems 30 | $COLON 'CODE-ADDRESS!',$CODE_ADDRESS_STORE 31 | CW $CFASTORE 32 | $END_COLON 33 | 34 | $CONST 'HOST-ITC?',,F_TRUE 35 | 36 | $CONST 'HOST-DTC?',,F_FALSE 37 | -------------------------------------------------------------------------------- /bootdict/x86-wordlist/entry-flags.asm: -------------------------------------------------------------------------------- 1 | ; PURPOSE: Wordlist entry flags modification 2 | ; LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | ; HFLAGS! 5 | ; D: x h-id -- 6 | ; Store flags specified by x to the flags field of the header 7 | $COLON 'HFLAGS!',$HFLAGS_STORE 8 | CW $NAME_TO_FLAGS, $C_STORE 9 | $END_COLON 10 | 11 | ; HFLAGS@ 12 | ; D: h-id -- x 13 | ; Get flags from the flags field of the header 14 | $COLON 'HFLAGS@',$HFLAGS_FETCH 15 | CW $NAME_TO_FLAGS, $C_FETCH 16 | $END_COLON 17 | 18 | ; SET-HFLAGS! 19 | ; D: flags -- 20 | $COLON 'SET-HFLAGS!' 21 | CW $LATEST_NAME_FETCH, $DUPE, $HFLAGS_FETCH, $ROTE, $OR, $SWAP, $HFLAGS_STORE 22 | $END_COLON 23 | 24 | ; RESET-HFLAGS! 25 | ; D: flags -- 26 | $COLON 'RESET-HFLAGS!' 27 | CW $LATEST_NAME_FETCH, $DUPE, $HFLAGS_FETCH, $ROTE, $INVERT, $AND, $SWAP, $HFLAGS_STORE 28 | $END_COLON 29 | 30 | ; INVERT-HFLAGS! 31 | ; D: flags -- 32 | $COLON 'INVERT-HFLAGS!' 33 | CW $LATEST_NAME_FETCH, $DUPE, $HFLAGS_FETCH, $ROTE, $X_OR, $SWAP, $HFLAGS_STORE 34 | $END_COLON 35 | -------------------------------------------------------------------------------- /bootdict/x86-wordlist/forth-wordlist.asm: -------------------------------------------------------------------------------- 1 | ; 16.6.1.1595 FORTH-WORDLIST 2 | $WORDLIST 'FORTH-WORDLIST',$FORTH_WORDLIST 3 | 4 | $DEFINITIONS $FORTH_WORDLIST 5 | -------------------------------------------------------------------------------- /bootdict/x86-wordlist/included-wordlist.asm: -------------------------------------------------------------------------------- 1 | $WORDLIST 'INCLUDED-WORDLIST',$INCLUDED_WORDLIST 2 | -------------------------------------------------------------------------------- /bootdict/x86-wordlist/wordlist-create.asm: -------------------------------------------------------------------------------- 1 | ; LATEST-NAME@ 2 | ; nt is the NAME TOKEN of the last compiled word in compilation wordlist. 3 | ; D: -- nt 4 | $CODE 'LATEST-NAME@',$LATEST_NAME_FETCH 5 | MOV EAX,DWORD [EDI + VAR_CURRENT] ; get CURRENT wid 6 | PUSHDS 7 | $NEXT 8 | 9 | ; LATEST-NAME! 10 | ; nt is the NAME TOKEN of the last compiled word in compilation wordlist. 11 | ; D: nt -- 12 | $CODE 'LATEST-NAME!',$LATEST_NAME_STORE 13 | MOV EAX,DWORD [EDI + VAR_CURRENT] ; get CURRENT wid 14 | POPDS 15 | $NEXT 16 | -------------------------------------------------------------------------------- /bootdict/x86/allot.asm: -------------------------------------------------------------------------------- 1 | ; 6.1.0710 ALLOT 2 | ; Allocates n memory cells on the top of vocabulary 3 | ; D: n -- 4 | $CODE 'ALLOT',$ALLOT 5 | POPDS EAX 6 | ADD DWORD [VAR_DP + IMAGE_BASE],EAX 7 | $NEXT 8 | -------------------------------------------------------------------------------- /bootdict/x86/b-comma.asm: -------------------------------------------------------------------------------- 1 | ; B, 2 | ; Reserve one byte of data space and store x in the byte 3 | ; D: x -- 4 | ; Used to compile machine code 5 | $CODE 'B,',$BCOMMA 6 | POPDS EAX 7 | MOV EBX,DWORD [VAR_DP + IMAGE_BASE] 8 | MOV BYTE [EBX],AL 9 | INC DWORD [VAR_DP + IMAGE_BASE] 10 | $NEXT 11 | -------------------------------------------------------------------------------- /bootdict/x86/b-to-h.asm: -------------------------------------------------------------------------------- 1 | ; Convert a byte to hex characters so that B>H EMIT EMIT sequence 2 | ; will print the representation of the value. 3 | ; S: a -- ca cb 4 | $CODE 'B>H',$BTOH 5 | LEA EDX,[DIGITS_TABLE + IMAGE_BASE] 6 | POPDS EAX 7 | XOR ECX,ECX 8 | MOV EBX,EAX 9 | AND EBX,0x0F 10 | MOV CL,BYTE [EDX + EBX] 11 | PUSHDS ECX 12 | SHR EAX,4 13 | MOV EBX,EAX 14 | AND EBX,0x0F 15 | MOV CL,BYTE [EDX + EBX] 16 | PUSHDS ECX 17 | $NEXT 18 | -------------------------------------------------------------------------------- /bootdict/x86/bootdict-header.asm: -------------------------------------------------------------------------------- 1 | format binary 2 | 3 | USE32 4 | 5 | ORG 0 6 | 7 | DESIRED_BASE_EQU EQU 20000000h 8 | 9 | IMAGE_BASE = DESIRED_BASE_EQU 10 | 11 | DESIRED_SIZE_EQU EQU 00040000h ; 256KB 12 | 13 | DATA_STACK_SIZE EQU 00001000h ; 4KB 14 | RETURN_STACK_SIZE EQU 00001000h ; 4KB 15 | EXCEPTION_STACK_SIZE EQU 00001000h ; 4KB 16 | 17 | USER_AREA_SIZE0 EQU 00020000h ; 128KB 18 | 19 | F_TRUE EQU 0FFFFFFFFh 20 | F_FALSE EQU 0 21 | 22 | CELL_SIZE EQU 4 23 | 24 | MAX_FILE_LINE_LENGTH EQU 1024 25 | 26 | ; Number of buffers supported by S" 27 | ; !!! SLSQINDEX MUST be power of 2 !!! 28 | SLSQINDEX EQU 8 29 | 30 | IF SLSQINDEX AND (SLSQINDEX - 1) <> 0 31 | DISPLAY "ERROR: SLSQINDEX MUST be power of 2" 32 | ERR 33 | END IF 34 | 35 | ; Size of a buffer supported by S" 36 | SLSQBUFFER EQU 1024 37 | 38 | ; Size of POCKET 39 | SLPOCKET EQU 256 40 | 41 | ;****************************************************************************** 42 | ; Header 43 | ;****************************************************************************** 44 | DB 'IKFI' ; MAX. 16 bytes !!! 45 | 46 | ALIGN 16 47 | 48 | DD DESIRED_BASE_EQU 49 | DESIRED_SIZE_VAR: 50 | DD DESIRED_SIZE_EQU 51 | DD START + IMAGE_BASE 52 | DD WIN32_THREAD_PROC + IMAGE_BASE 53 | DD LINUX_THREAD_PROC + IMAGE_BASE 54 | DD USER_AREA_SIZE0 + USER_AREA_SIZE 55 | DD DATA_STACK_SIZE 56 | -------------------------------------------------------------------------------- /bootdict/x86/c-comma.asm: -------------------------------------------------------------------------------- 1 | ; 6.1.0860 C, 2 | ; Reserve one character of data space and store x in the character 3 | ; D: x -- 4 | $CODE 'C,',$C_COMMA 5 | POPDS EAX 6 | MOV EBX,DWORD [VAR_DP + IMAGE_BASE] 7 | MOV BYTE [EBX],AL 8 | INC DWORD [VAR_DP + IMAGE_BASE] 9 | $NEXT 10 | -------------------------------------------------------------------------------- /bootdict/x86/call-comma.asm: -------------------------------------------------------------------------------- 1 | ; CALL, 2 | ; ( addr -- ) 3 | ; Compile CPU specific CALL instruction to call a procedure at specified address. 4 | $COLON 'CALL,' 5 | CCLIT 0E8h 6 | CW $BCOMMA,$HERE,$MINUS 7 | CCLIT 4 8 | CW $MINUS,$COMMA 9 | $END_COLON 10 | -------------------------------------------------------------------------------- /bootdict/x86/comma.asm: -------------------------------------------------------------------------------- 1 | ; 6.1.0150 , 2 | ; Reserve one cell of data space and store x in the cell 3 | ; D: x -- 4 | $CODE ',',$COMMA 5 | POPDS EAX 6 | MOV EBX,DWORD [VAR_DP + IMAGE_BASE] 7 | MOV DWORD [EBX],EAX 8 | ADD DWORD [VAR_DP + IMAGE_BASE],CELL_SIZE 9 | $NEXT 10 | -------------------------------------------------------------------------------- /bootdict/x86/double.asm: -------------------------------------------------------------------------------- 1 | ;****************************************************************************** 2 | ; 3 | ; double.asm 4 | ; IKForth 5 | ; 6 | ; Unlicense since 1999 by Illya Kysil 7 | ; 8 | ;****************************************************************************** 9 | ; Double number words 10 | ;****************************************************************************** 11 | 12 | ; 8.6.1.1040 D+ 13 | ; ( d1|ud1 d2|ud2 -- d3|ud3 ) 14 | ; Add d2|ud2 to d1|ud1, giving the sum d3|ud3. 15 | $CODE 'D+',$D_PLUS,VEF_USUAL 16 | POPDS ECX 17 | POPDS EBX 18 | POPDS EDX 19 | POPDS EAX 20 | ADD EAX,EBX 21 | ADC EDX,ECX 22 | PUSHDS EAX 23 | PUSHDS EDX 24 | $NEXT 25 | 26 | ; 8.6.1.1230 DNEGATE 27 | ; ( d1 -- d2 ) 28 | ; d2 is the negation of d1. 29 | $CODE 'DNEGATE',$D_NEGATE,VEF_USUAL 30 | POPDS EDX 31 | POPDS EAX 32 | SUB EAX,1 33 | SBB EDX,0 34 | NOT EAX 35 | NOT EDX 36 | PUSHDS EAX 37 | PUSHDS EDX 38 | $NEXT 39 | -------------------------------------------------------------------------------- /bootdict/x86/excp-zero.asm: -------------------------------------------------------------------------------- 1 | ; EXCP0 2 | ; S: -- excp0 3 | ; Return base address of exception stack 4 | $CODE 'EXCP0',$EXCP0,VEF_USUAL 5 | LEA EAX,DWORD [EDI + VAR_EXC_STACK] 6 | PUSHDS EAX 7 | $NEXT 8 | -------------------------------------------------------------------------------- /bootdict/x86/init-user.asm: -------------------------------------------------------------------------------- 1 | ; INIT-USER 2 | $CODE 'INIT-USER',$INIT_USER 3 | CLD 4 | MOV DWORD [EDI + VAR_BASE],10 5 | MOV DWORD [EDI + VAR_CURRENT],PFA_$FORTH_WORDLIST + IMAGE_BASE 6 | $NEXT 7 | -------------------------------------------------------------------------------- /bootdict/x86/main-proc.asm: -------------------------------------------------------------------------------- 1 | START: 2 | ; typedef struct _MainProcContext { 3 | ; int argc; 4 | ; char const ** argv; 5 | ; char const ** envp; 6 | ; char const * startFileName; 7 | ; int startFileNameLength; 8 | ; int const * exitCode; 9 | ; void const ** sysfunctions; 10 | ; } MainProcContext; 11 | ; 12 | ; typedef void __stdcall (* MainProc)(MainProcContext *); 13 | $STDCALL_SAVE 14 | MOV ESI,[EBP + 8] ; get address of MainProcContext 15 | MOV EBX,IMAGE_BASE 16 | CLD 17 | LEA EDI,[EBX + ARGC_VAR] 18 | MOVSD 19 | LEA EDI,[EBX + ARGV_VAR] 20 | MOVSD 21 | LEA EDI,[EBX + ENVP_VAR] 22 | MOVSD 23 | LEA EDI,[EBX + SF_VAR] 24 | MOVSD 25 | LEA EDI,[EBX + HASH_SF_VAR] 26 | MOVSD 27 | LEA EDI,[EBX + EXIT_CODE_VAR] 28 | MOVSD 29 | LEA EDI,[EBX + FUNC_TABLE_VAR] 30 | MOVSD 31 | MOV EAX,DWORD [EBX + MAIN_PROC_VAR] 32 | PUSH EAX 33 | PUSH F_FALSE 34 | PUSH 0 35 | $CSYSCALL START_THREAD 36 | $STDCALL_RESTORE 37 | RET 38 | -------------------------------------------------------------------------------- /bootdict/x86/paren-parse-paren.asm: -------------------------------------------------------------------------------- 1 | ; (PARSE) 2 | ; ( char c-addr1 u1 -- c-addr2 u2 ) 3 | ; Parse c-addr1 u1 delimited by the delimiter char. 4 | $CODE '(PARSE)',$PPARSE 5 | PUSHRS ESI 6 | POPDS ECX ; ECX - u1 7 | POPDS ESI ; ESI - c-addr1 - source address 8 | POPDS EDX ; EDX - char 9 | PUSHDS ESI ; c-addr2 10 | XOR EBX,EBX 11 | PPARSE_LOOP: 12 | DEC ECX 13 | JS SHORT PPARSE_EXIT 14 | LODSB 15 | OR AL,AL 16 | JZ SHORT PPARSE_EXIT 17 | CMP AL,DL 18 | JZ SHORT PPARSE_EXIT 19 | INC EBX 20 | JMP SHORT PPARSE_LOOP 21 | PPARSE_EXIT: 22 | PUSHDS EBX 23 | POPRS ESI 24 | $NEXT 25 | -------------------------------------------------------------------------------- /bootdict/x86/s-to-d.asm: -------------------------------------------------------------------------------- 1 | ; 6.1.2170 S>D 2 | ; Convert single cell value to double cell value 3 | ; D: a -- aa 4 | $CODE 'S>D',$S_TO_D 5 | POPDS EAX 6 | CDQ 7 | PUSHDS EAX 8 | PUSHDS EDX 9 | $NEXT 10 | -------------------------------------------------------------------------------- /bootdict/x86/source-id-store.asm: -------------------------------------------------------------------------------- 1 | ; SOURCE-ID! 2 | $CODE 'SOURCE-ID!',$SOURCE_ID_STORE,VEF_USUAL 3 | POPDS 4 | $NEXT 5 | -------------------------------------------------------------------------------- /bootdict/x86/source-id.asm: -------------------------------------------------------------------------------- 1 | ; 6.2.2218 SOURCE-ID 2 | ; Identifies the input source as follows: 3 | ; 4 | ; SOURCE-ID Input source 5 | ; -1 String (via EVALUATE) 6 | ; 0 User input device 7 | ; >0 File handle 8 | $CODE 'SOURCE-ID',$SOURCE_ID,VEF_USUAL 9 | PUSHDS 10 | $NEXT 11 | -------------------------------------------------------------------------------- /bootdict/x86/split-8.asm: -------------------------------------------------------------------------------- 1 | ; Split TOS into 4 bytes with most significant byte at TOS. 2 | ; S: a -- e d c b 3 | $CODE 'SPLIT-8',$SPLIT8 4 | POPDS EAX 5 | XOR ECX,ECX 6 | MOV CL,AL 7 | PUSH ECX 8 | MOV CL,AH 9 | PUSH ECX 10 | SHR EAX,16 11 | MOV CL,AL 12 | PUSH ECX 13 | MOV CL,AH 14 | PUSH ECX 15 | $NEXT 16 | -------------------------------------------------------------------------------- /bootdict/x86/sys-upcase.asm: -------------------------------------------------------------------------------- 1 | ; Convert character in AL to upper case, only ASCII a-z characters are supported 2 | LABEL UPCASE 3 | CMP AL,'a' 4 | JB SHORT @@UC ; jump if AH < 'a' 5 | CMP AL,'z' 6 | JA SHORT @@UC ; jump if AH > 'z' 7 | SUB AL,'a' - 'A' ; convert to uppercase 8 | @@UC: 9 | RET 10 | -------------------------------------------------------------------------------- /bootdict/x86/to-digit.asm: -------------------------------------------------------------------------------- 1 | ; >DIGIT 2 | ; ( c base -- n | -1 ) 3 | ; Convert symbol c to number n using specified base. 4 | ; Return -1 if symbol c is not a correct digit in the specified base. 5 | $CODE '>DIGIT',$TODIGIT 6 | POPDS EBX 7 | POPDS EAX 8 | CALL TODIGIT 9 | MOVSX EBX,AL 10 | PUSHDS EBX 11 | $NEXT 12 | 13 | ; In: AL - symbol to convert 14 | ; BL - base 15 | ; Out: AL - digit or FFh if not recognized 16 | LABEL TODIGIT 17 | PUSHDS ECX 18 | PUSHDS EDX 19 | XOR EDX,EDX 20 | DEC EDX 21 | MOV CL,10 ; correction is needed if symbol is not a decimal digit 22 | MOV AH,AL 23 | CMP AH,'z' 24 | CMOVA EAX,EDX 25 | SUB AH,'a' 26 | JAE SHORT TD_DONE ; jump if AL >= 'a' 27 | MOV AH,AL 28 | CMP AH,'Z' 29 | CMOVA EAX,EDX 30 | SUB AH,'A' 31 | JAE SHORT TD_DONE ; jump if AL >= 'A' 32 | XOR CL,CL ; no correction is needed for decimal digits 33 | MOV AH,AL 34 | CMP AH,'9' 35 | CMOVA EAX,EDX 36 | SUB AH,'0' 37 | TD_DONE: 38 | ADD AH,CL ; apply correction 39 | MOV AL,AH 40 | OR AL,AL 41 | CMOVS EAX,EDX 42 | CMP AL,BL 43 | CMOVAE EAX,EDX 44 | AND EAX,0FFh 45 | POPDS EDX 46 | POPDS ECX 47 | RET 48 | -------------------------------------------------------------------------------- /docker/build-ci.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # exit as soon as something fails 4 | set -o errexit 5 | set -o pipefail 6 | 7 | docker_run() { 8 | echo "------------------------------------------------------" 9 | echo ">>> Executing $*" 10 | echo "------------------------------------------------------" 11 | docker run --rm -i --env BUILD_TAG -v $PWD:/opt/ikforth ikforth-build:latest -c "$*" 12 | } 13 | 14 | check_command() { 15 | docker_run "command -v $1 >/dev/null 2>&1" 16 | } 17 | 18 | skip() { 19 | echo "$*" 20 | exit 0 21 | } 22 | 23 | docker_run "yes bye | docker/hide-logs.sh scons linux itc all ansitest" || exit 1 24 | docker_run "yes bye | docker/hide-logs.sh scons linux dtc all ansitest" || exit 1 25 | docker_run "yes bye | docker/hide-logs.sh scons linux fptest" || exit 1 26 | 27 | check_command "wine32" || skip ">>> wine32 not installed, skipping..." 28 | check_command "mingw32-g++" || skip ">>> mingw32-g++ not installed, skipping..." 29 | check_command "mingw32-gcc" || skip ">>> mingw32-gcc not installed, skipping..." 30 | 31 | docker_run "yes bye | docker/hide-logs.sh scons win32 itc term all ansitest" || exit 1 32 | docker_run "yes bye | docker/hide-logs.sh scons win32 dtc term all ansitest" || exit 1 33 | docker_run "yes bye | docker/hide-logs.sh scons win32 term fptest" || exit 1 34 | 35 | docker_run "scons dist" || exit 1 36 | -------------------------------------------------------------------------------- /docker/centos-stream10/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM tgagor/centos:stream10 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LANGUAGE=en_US:en \ 6 | LC_ALL=C.UTF-8 7 | 8 | RUN dnf -y --nobest install \ 9 | git \ 10 | wget \ 11 | gcc-c++ \ 12 | glibc-devel.i686 libgcc.i686 libstdc++.i686 readline.i686 \ 13 | glibc-devel libgcc libstdc++ readline \ 14 | python3 python3-pip \ 15 | && \ 16 | dnf clean all 17 | 18 | ADD docker /opt/docker 19 | 20 | RUN /opt/docker/install-scons.sh 21 | 22 | RUN /opt/docker/install-fasm.sh 23 | 24 | ARG RUNUSER=ikforth 25 | 26 | ARG RUNUID=1001 27 | 28 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 29 | 30 | USER ${RUNUSER} 31 | 32 | VOLUME ["/opt/ikforth"] 33 | 34 | WORKDIR /opt/ikforth 35 | 36 | ENTRYPOINT ["/bin/bash"] 37 | -------------------------------------------------------------------------------- /docker/centos-stream9/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM tgagor/centos:stream9 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LANGUAGE=en_US:en \ 6 | LC_ALL=C.UTF-8 7 | 8 | RUN dnf -y --nobest install \ 9 | git \ 10 | wget \ 11 | gcc-c++ \ 12 | glibc-devel.i686 libgcc.i686 libstdc++.i686 readline.i686 \ 13 | glibc-devel libgcc libstdc++ readline \ 14 | python3 python3-pip \ 15 | && \ 16 | dnf clean all 17 | 18 | ADD docker /opt/docker 19 | 20 | RUN /opt/docker/install-scons.sh 21 | 22 | RUN /opt/docker/install-fasm.sh 23 | 24 | ARG RUNUSER=ikforth 25 | 26 | ARG RUNUID=1001 27 | 28 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 29 | 30 | USER ${RUNUSER} 31 | 32 | VOLUME ["/opt/ikforth"] 33 | 34 | WORKDIR /opt/ikforth 35 | 36 | ENTRYPOINT ["/bin/bash"] 37 | -------------------------------------------------------------------------------- /docker/fedora-39/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM fedora:39 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LANGUAGE=en_US:en \ 6 | LC_ALL=C.UTF-8 7 | 8 | RUN dnf -y install \ 9 | git \ 10 | wget \ 11 | gcc-c++ \ 12 | glibc-devel.i686 libgcc.i686 libstdc++.i686 readline.i686 \ 13 | glibc-devel libgcc libstdc++ readline \ 14 | python3 python3-pip \ 15 | mingw32-gcc mingw32-gcc-c++ \ 16 | wine.i686 \ 17 | && \ 18 | dnf clean all 19 | 20 | ADD docker /opt/docker 21 | 22 | RUN ln -s /usr/bin/i686-w64-mingw32-g++ /usr/local/bin/mingw32-g++ \ 23 | && \ 24 | ln -s /usr/bin/i686-w64-mingw32-gcc /usr/local/bin/mingw32-gcc 25 | 26 | RUN /opt/docker/install-scons.sh 27 | 28 | RUN /opt/docker/install-fasm.sh 29 | 30 | ARG RUNUSER=ikforth 31 | 32 | ARG RUNUID=1001 33 | 34 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 35 | 36 | USER ${RUNUSER} 37 | 38 | ENV WINEARCH=win32 \ 39 | WINEPREFIX=/home/${RUNUSER}/.wine 40 | 41 | RUN winecfg 42 | 43 | VOLUME ["/opt/ikforth"] 44 | 45 | WORKDIR /opt/ikforth 46 | 47 | ENTRYPOINT ["/bin/bash"] 48 | -------------------------------------------------------------------------------- /docker/fedora-40/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM fedora:40 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LANGUAGE=en_US:en \ 6 | LC_ALL=C.UTF-8 7 | 8 | RUN dnf -y install \ 9 | git \ 10 | wget \ 11 | gcc-c++ \ 12 | glibc-devel.i686 libgcc.i686 libstdc++.i686 readline.i686 \ 13 | glibc-devel libgcc libstdc++ readline \ 14 | python3 python3-pip \ 15 | mingw32-gcc mingw32-gcc-c++ \ 16 | wine.i686 \ 17 | && \ 18 | dnf clean all 19 | 20 | ADD docker /opt/docker 21 | 22 | RUN ln -s /usr/bin/i686-w64-mingw32-g++ /usr/local/bin/mingw32-g++ \ 23 | && \ 24 | ln -s /usr/bin/i686-w64-mingw32-gcc /usr/local/bin/mingw32-gcc 25 | 26 | RUN /opt/docker/install-scons.sh 27 | 28 | RUN /opt/docker/install-fasm.sh 29 | 30 | ARG RUNUSER=ikforth 31 | 32 | ARG RUNUID=1001 33 | 34 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 35 | 36 | USER ${RUNUSER} 37 | 38 | ENV WINEARCH=win32 \ 39 | WINEPREFIX=/home/${RUNUSER}/.wine 40 | 41 | RUN winecfg 42 | 43 | VOLUME ["/opt/ikforth"] 44 | 45 | WORKDIR /opt/ikforth 46 | 47 | ENTRYPOINT ["/bin/bash"] 48 | -------------------------------------------------------------------------------- /docker/fedora-41/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM fedora:41 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LANGUAGE=en_US:en \ 6 | LC_ALL=C.UTF-8 7 | 8 | RUN dnf -y install \ 9 | git \ 10 | wget \ 11 | gcc-c++ \ 12 | glibc-devel.i686 libgcc.i686 libstdc++.i686 readline.i686 \ 13 | glibc-devel libgcc libstdc++ readline \ 14 | python3 python3-pip \ 15 | mingw32-gcc mingw32-gcc-c++ \ 16 | wine.i686 \ 17 | && \ 18 | dnf clean all 19 | 20 | ADD docker /opt/docker 21 | 22 | RUN ln -s /usr/bin/i686-w64-mingw32-g++ /usr/local/bin/mingw32-g++ \ 23 | && \ 24 | ln -s /usr/bin/i686-w64-mingw32-gcc /usr/local/bin/mingw32-gcc 25 | 26 | RUN /opt/docker/install-scons.sh 27 | 28 | RUN /opt/docker/install-fasm.sh 29 | 30 | ARG RUNUSER=ikforth 31 | 32 | ARG RUNUID=1001 33 | 34 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 35 | 36 | USER ${RUNUSER} 37 | 38 | ENV WINEARCH=win32 \ 39 | WINEPREFIX=/home/${RUNUSER}/.wine 40 | 41 | RUN winecfg 42 | 43 | VOLUME ["/opt/ikforth"] 44 | 45 | WORKDIR /opt/ikforth 46 | 47 | ENTRYPOINT ["/bin/bash"] 48 | -------------------------------------------------------------------------------- /docker/hide-logs.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | export workfile=`mktemp --tmpdir hide-logs.XXXXXXXXXX` 4 | 5 | "$@" > "${workfile}" 2>&1 6 | 7 | RESULT=$? 8 | 9 | if [ $RESULT -ne 0 ] ; then 10 | echo "$(<${workfile})" 11 | fi 12 | 13 | exit $RESULT 14 | -------------------------------------------------------------------------------- /docker/install-fasm.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # exit as soon as something fails 4 | set -o errexit 5 | set -o pipefail 6 | 7 | fasm_version=1.73.32 8 | workdir=`mktemp -d fasm.XXXXXXXXXX` 9 | 10 | chmod ugo+rwx "${workdir}" 11 | cd "${workdir}" 12 | 13 | wget http://flatassembler.net/fasm-${fasm_version}.tgz 14 | tar -x --no-same-owner --no-same-permissions -f fasm-${fasm_version}.tgz 15 | mv $PWD/fasm /opt/fasm-${fasm_version} 16 | ln -s /opt/fasm-${fasm_version}/fasm /usr/local/bin/fasm 17 | 18 | cd /opt/fasm-${fasm_version}/tools/libc 19 | 20 | fasm listing.asm 21 | gcc -m32 -o ../../listing listing.o 22 | chmod +x ../../listing 23 | ln -s $PWD/../../listing /usr/local/bin/listing 24 | 25 | rm -rvf "${workdir}" 26 | -------------------------------------------------------------------------------- /docker/install-scons.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # exit as soon as something fails 4 | set -o errexit 5 | set -o pipefail 6 | 7 | if [[ ! -f /usr/bin/python3 ]]; then 8 | echo "Python 3 is required, but not found" 9 | exit 1 10 | fi 11 | 12 | python3 -m venv /opt/scons 13 | PIP="/opt/scons/bin/pip" 14 | 15 | $PIP install --upgrade pip 16 | $PIP install -r /opt/docker/python-requirements.txt 17 | 18 | ln -s /opt/scons/bin/scons /usr/local/bin/scons 19 | 20 | if [[ ! -x "$(command -v scons)" ]]; then 21 | echo SCons installation failed 22 | exit 1 23 | fi 24 | -------------------------------------------------------------------------------- /docker/python-requirements.txt: -------------------------------------------------------------------------------- 1 | ##### Requirements with Version Specifiers ###### 2 | # See https://www.python.org/dev/peps/pep-0440/#version-specifiers 3 | 4 | scons >= 4.9 5 | -------------------------------------------------------------------------------- /docker/rocky-8/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM rockylinux:8 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LANGUAGE=en_US:en \ 6 | LC_ALL=C.UTF-8 7 | 8 | RUN dnf -y install \ 9 | epel-release \ 10 | && \ 11 | dnf -y install \ 12 | git \ 13 | wget \ 14 | gcc-c++ \ 15 | glibc-devel.i686 libgcc.i686 libstdc++.i686 readline.i686 \ 16 | glibc-devel libgcc libstdc++ readline \ 17 | python3 python3-pip \ 18 | && \ 19 | dnf clean all 20 | 21 | ADD docker /opt/docker 22 | 23 | RUN /opt/docker/install-scons.sh 24 | 25 | RUN /opt/docker/install-fasm.sh 26 | 27 | ARG RUNUSER=ikforth 28 | 29 | ARG RUNUID=1001 30 | 31 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 32 | 33 | USER ${RUNUSER} 34 | 35 | VOLUME ["/opt/ikforth"] 36 | 37 | WORKDIR /opt/ikforth 38 | 39 | ENTRYPOINT ["/bin/bash"] 40 | -------------------------------------------------------------------------------- /docker/rocky-9/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM rockylinux:9 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LANGUAGE=en_US:en \ 6 | LC_ALL=C.UTF-8 7 | 8 | RUN dnf -y install \ 9 | epel-release \ 10 | && \ 11 | dnf -y install \ 12 | git \ 13 | wget \ 14 | gcc-c++ \ 15 | glibc-devel.i686 libgcc.i686 libstdc++.i686 readline.i686 \ 16 | glibc-devel libgcc libstdc++ readline \ 17 | python3 python3-pip \ 18 | && \ 19 | dnf clean all 20 | 21 | ADD docker /opt/docker 22 | 23 | RUN /opt/docker/install-scons.sh 24 | 25 | RUN /opt/docker/install-fasm.sh 26 | 27 | ARG RUNUSER=ikforth 28 | 29 | ARG RUNUID=1001 30 | 31 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 32 | 33 | USER ${RUNUSER} 34 | 35 | VOLUME ["/opt/ikforth"] 36 | 37 | WORKDIR /opt/ikforth 38 | 39 | ENTRYPOINT ["/bin/bash"] 40 | -------------------------------------------------------------------------------- /docker/ubuntu-18.04-lts/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:18.04 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LC_ALL=C.UTF-8 \ 6 | DEBIAN_FRONTEND=noninteractive 7 | 8 | RUN yes | ( dpkg --add-architecture i386 && \ 9 | apt-get update && \ 10 | apt-get upgrade && \ 11 | apt-get dist-upgrade && \ 12 | apt-get clean && \ 13 | apt-get autoclean ) 14 | 15 | RUN yes | ( apt-get install --no-install-recommends \ 16 | git \ 17 | wget \ 18 | python3 python3-venv \ 19 | libreadline7 libreadline7:i386 \ 20 | libc6-dev libc6-dev-i386 libc6-i386 \ 21 | libgcc1 lib32gcc1 \ 22 | libstdc++-8-dev lib32stdc++-8-dev \ 23 | build-essential gcc-multilib g++-multilib \ 24 | && \ 25 | apt-get clean && \ 26 | apt-get autoclean ) 27 | 28 | ADD docker /opt/docker 29 | 30 | RUN /opt/docker/install-scons.sh 31 | 32 | RUN /opt/docker/install-fasm.sh 33 | 34 | ARG RUNUSER=ikforth 35 | 36 | ARG RUNUID=1001 37 | 38 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 39 | 40 | USER ${RUNUSER} 41 | 42 | VOLUME ["/opt/ikforth"] 43 | 44 | WORKDIR /opt/ikforth 45 | 46 | ENTRYPOINT ["/bin/bash"] 47 | -------------------------------------------------------------------------------- /docker/ubuntu-20.04-lts/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:20.04 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LC_ALL=C.UTF-8 \ 6 | DEBIAN_FRONTEND=noninteractive 7 | 8 | RUN yes | ( dpkg --add-architecture i386 && \ 9 | apt-get update && \ 10 | apt-get upgrade && \ 11 | apt-get dist-upgrade && \ 12 | apt-get clean && \ 13 | apt-get autoclean ) 14 | 15 | RUN yes | ( apt-get install --no-install-recommends \ 16 | git \ 17 | wget \ 18 | python3 python3-venv python-is-python3 \ 19 | libreadline8 libreadline8:i386 \ 20 | libc6-dev libc6-dev-i386 \ 21 | libgcc1 \ 22 | libstdc++-9-dev libstdc++-9-dev:i386 \ 23 | linux-libc-dev linux-libc-dev:i386 \ 24 | gcc-multilib g++-multilib \ 25 | build-essential \ 26 | && \ 27 | apt-get clean && \ 28 | apt-get autoclean ) 29 | 30 | ADD docker /opt/docker 31 | 32 | RUN /opt/docker/install-scons.sh 33 | 34 | RUN /opt/docker/install-fasm.sh 35 | 36 | ARG RUNUSER=ikforth 37 | 38 | ARG RUNUID=1001 39 | 40 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 41 | 42 | USER ${RUNUSER} 43 | 44 | VOLUME ["/opt/ikforth"] 45 | 46 | WORKDIR /opt/ikforth 47 | 48 | ENTRYPOINT ["/bin/bash"] 49 | -------------------------------------------------------------------------------- /docker/ubuntu-22.04-lts/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:22.04 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LC_ALL=C.UTF-8 \ 6 | DEBIAN_FRONTEND=noninteractive 7 | 8 | RUN yes | ( dpkg --add-architecture i386 && \ 9 | apt-get update && \ 10 | apt-get upgrade && \ 11 | apt-get dist-upgrade && \ 12 | apt-get clean && \ 13 | apt-get autoclean ) 14 | 15 | RUN yes | ( apt-get install --no-install-recommends \ 16 | git \ 17 | wget \ 18 | python3 python3-venv \ 19 | libreadline8 libreadline8:i386 \ 20 | libc6-dev libc6-dev-i386 \ 21 | libgcc1 libgcc1:i386 \ 22 | libstdc++-11-dev libstdc++-11-dev:i386 \ 23 | linux-libc-dev linux-libc-dev:i386 \ 24 | gcc-multilib g++-multilib \ 25 | build-essential \ 26 | && \ 27 | apt-get clean && \ 28 | apt-get autoclean ) 29 | 30 | ADD docker /opt/docker 31 | 32 | RUN /opt/docker/install-scons.sh 33 | 34 | RUN /opt/docker/install-fasm.sh 35 | 36 | ARG RUNUSER=ikforth 37 | 38 | ARG RUNUID=1001 39 | 40 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 41 | 42 | USER ${RUNUSER} 43 | 44 | VOLUME ["/opt/ikforth"] 45 | 46 | WORKDIR /opt/ikforth 47 | 48 | ENTRYPOINT ["/bin/bash"] 49 | -------------------------------------------------------------------------------- /docker/ubuntu-24.04-lts/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:24.04 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LC_ALL=C.UTF-8 \ 6 | DEBIAN_FRONTEND=noninteractive 7 | 8 | RUN yes | ( dpkg --add-architecture i386 && \ 9 | apt-get update && \ 10 | apt-get upgrade && \ 11 | apt-get dist-upgrade && \ 12 | apt-get clean && \ 13 | apt-get autoclean ) 14 | 15 | RUN yes | ( apt-get install --no-install-recommends \ 16 | git \ 17 | wget \ 18 | python3 python3-venv \ 19 | libreadline8 libreadline8:i386 \ 20 | libc6-dev libc6-dev-i386 \ 21 | libgcc1 libgcc1:i386 \ 22 | libstdc++-11-dev libstdc++-11-dev:i386 \ 23 | linux-libc-dev linux-libc-dev:i386 \ 24 | gcc-multilib g++-multilib \ 25 | build-essential \ 26 | && \ 27 | apt-get clean && \ 28 | apt-get autoclean ) 29 | 30 | ADD docker /opt/docker 31 | 32 | RUN /opt/docker/install-scons.sh 33 | 34 | RUN /opt/docker/install-fasm.sh 35 | 36 | ARG RUNUSER=ikforth 37 | 38 | ARG RUNUID=1001 39 | 40 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 41 | 42 | USER ${RUNUSER} 43 | 44 | VOLUME ["/opt/ikforth"] 45 | 46 | WORKDIR /opt/ikforth 47 | 48 | ENTRYPOINT ["/bin/bash"] 49 | -------------------------------------------------------------------------------- /docker/ubuntu-24.10/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:24.10 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LC_ALL=C.UTF-8 \ 6 | DEBIAN_FRONTEND=noninteractive 7 | 8 | RUN yes | ( dpkg --add-architecture i386 && \ 9 | apt-get update && \ 10 | apt-get upgrade && \ 11 | apt-get dist-upgrade && \ 12 | apt-get clean && \ 13 | apt-get autoclean ) 14 | 15 | RUN yes | ( apt-get install --no-install-recommends \ 16 | git \ 17 | wget \ 18 | python3 python3-venv \ 19 | libreadline8 libreadline8:i386 \ 20 | libc6-dev libc6-dev-i386 \ 21 | libgcc1 libgcc1:i386 \ 22 | libstdc++-11-dev libstdc++-11-dev:i386 \ 23 | linux-libc-dev linux-libc-dev:i386 \ 24 | gcc-multilib g++-multilib \ 25 | build-essential \ 26 | && \ 27 | apt-get clean && \ 28 | apt-get autoclean ) 29 | 30 | ADD docker /opt/docker 31 | 32 | RUN /opt/docker/install-scons.sh 33 | 34 | RUN /opt/docker/install-fasm.sh 35 | 36 | ARG RUNUSER=ikforth 37 | 38 | ARG RUNUID=1001 39 | 40 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 41 | 42 | USER ${RUNUSER} 43 | 44 | VOLUME ["/opt/ikforth"] 45 | 46 | WORKDIR /opt/ikforth 47 | 48 | ENTRYPOINT ["/bin/bash"] 49 | -------------------------------------------------------------------------------- /docker/ubuntu-25.04/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:25.04 2 | LABEL maintainer="Illya Kysil " 3 | 4 | ENV LANG=C.UTF-8 \ 5 | LC_ALL=C.UTF-8 \ 6 | DEBIAN_FRONTEND=noninteractive 7 | 8 | RUN yes | ( dpkg --add-architecture i386 && \ 9 | apt-get update && \ 10 | apt-get upgrade && \ 11 | apt-get dist-upgrade && \ 12 | apt-get clean && \ 13 | apt-get autoclean ) 14 | 15 | RUN yes | ( apt-get install --no-install-recommends \ 16 | git \ 17 | wget \ 18 | python3 python3-venv \ 19 | libreadline8 libreadline8:i386 \ 20 | libc6-dev libc6-dev-i386 \ 21 | libgcc1 libgcc1:i386 \ 22 | libstdc++-11-dev libstdc++-11-dev:i386 \ 23 | linux-libc-dev linux-libc-dev:i386 \ 24 | gcc-multilib g++-multilib \ 25 | build-essential \ 26 | && \ 27 | apt-get clean && \ 28 | apt-get autoclean ) 29 | 30 | ADD docker /opt/docker 31 | 32 | RUN /opt/docker/install-scons.sh 33 | 34 | RUN /opt/docker/install-fasm.sh 35 | 36 | ARG RUNUSER=ikforth 37 | 38 | ARG RUNUID=1001 39 | 40 | RUN useradd ${RUNUSER} --uid ${RUNUID} --user-group 41 | 42 | USER ${RUNUSER} 43 | 44 | VOLUME ["/opt/ikforth"] 45 | 46 | WORKDIR /opt/ikforth 47 | 48 | ENTRYPOINT ["/bin/bash"] 49 | -------------------------------------------------------------------------------- /docs/_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-minimal -------------------------------------------------------------------------------- /docs/adr/0001-record-architecture-decisions.md: -------------------------------------------------------------------------------- 1 | # 1. Record architecture decisions 2 | 3 | Date: 2020-04-30 4 | 5 | ## Status 6 | 7 | Accepted 8 | 9 | ## Context 10 | 11 | We need to record the architectural decisions made on this project. 12 | 13 | ## Decision 14 | 15 | We will use Architecture Decision Records, as [described by Michael Nygard](http://thinkrelevance.com/blog/2011/11/15/documenting-architecture-decisions). 16 | 17 | ## Consequences 18 | 19 | See Michael Nygard's article, linked above. For a lightweight ADR toolset, see Nat Pryce's [adr-tools](https://github.com/npryce/adr-tools). 20 | -------------------------------------------------------------------------------- /docs/adr/0002-32-bits-code.md: -------------------------------------------------------------------------------- 1 | # 2. 32 bits code 2 | 3 | Date: 2020-05-01 4 | 5 | ## Status 6 | 7 | Accepted 8 | 9 | ## Context 10 | 11 | 32-bits systems were all the rage when this project was concieved back in 1999. 12 | 64-bits systems were not available yet. 13 | 16-bits and 8-bit systems were not interesting. 14 | 15 | ## Decision 16 | 17 | IKForth is implemented as 32-bits code with 32-bits CELL size. 18 | 19 | ## Consequences 20 | 21 | The portability of 32-bits codebase is quite good over the past 21 years. 22 | There are concerns about the future of 32-bits systems in 2020. 23 | -------------------------------------------------------------------------------- /docs/floating-point/TruncToms.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/floating-point/TruncToms.pdf -------------------------------------------------------------------------------- /docs/floating-point/finalversion.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/floating-point/finalversion.pdf -------------------------------------------------------------------------------- /docs/floating-point/fun_aprox.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/floating-point/fun_aprox.pdf -------------------------------------------------------------------------------- /docs/floating-point/how-to-print-floating-point-numbers-accurately.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/floating-point/how-to-print-floating-point-numbers-accurately.pdf -------------------------------------------------------------------------------- /docs/floating-point/trig_approximations.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/floating-point/trig_approximations.pdf -------------------------------------------------------------------------------- /docs/hacking.md: -------------------------------------------------------------------------------- 1 | # ikforth hacking 2 | 3 | ## Code Conventions 4 | 5 | * Forth source files MUST use `.4th` extension (if produced by IKForth contributors) 6 | * File paths for `INCLUDED` (and family) MUST be relative to repository root 7 | * File paths MUST use `/` (forward slash) as file separator 8 | 9 | ## Repository Structure 10 | 11 | *Note*: The structure below is Work In Progress. 12 | 13 | * `/app` - applications 14 | * `/blocks` - filesystem root for `BLOCK` wordset implementations 15 | * `/bootdict` - Bootstrap dictionary, Flat Assembler sources 16 | * `/tc` - Forth VM threaded code 17 | * `/x86` - native x86 code 18 | * `/x86-dtc` - native x86 code, DTC specifics 19 | * `/x86-itc` - native x86 code, ITC specifics 20 | * `/x86-wordlist` - wordlist structures, x86 and Forth VM threaded code 21 | * `bootdict-x86.asm` - main module for x86 22 | * `/build` - build artifacts and temporary files 23 | * `/docs` - system documentation 24 | * `/adr` - Architecture Decision Records 25 | * `/docker` - definitions for Dockerized build environments 26 | * `/lib` - libraries 27 | * `/product` 28 | * `/ikforth-base-x86` - basic interactive system configuration, Forth 29 | * `/ikforth-dev-x86` - developer's interactive configuration, Forth 30 | * `/ikforth-dist` - release distribution 31 | * `/sysdict` - system dictionary, Forth 32 | * `/term` - terminal integration, Forth 33 | * `/x86` - x86-specific primitives, Forth 34 | * `/x86-linux` - Linux-specific definitions, Forth 35 | * `/x86-windows` - Windows-specific definitions, Forth 36 | * `*.4th` 37 | * `/test` 38 | * `/*` - tests, Forth 39 | * `/forth2012-test-suite` - Gerry Jackson's Test programs for Forth 2012 and ANS Forth 40 | * `*.4th` 41 | * `/tools` 42 | * `/linconst-extract` - tool for extracting constants from Linux headers, C sources 43 | * `/loader` - Loader for dictionaries, C/C++ sources 44 | * `/winconst-extract` - tool for extracting constants from Windows headers, C sources 45 | -------------------------------------------------------------------------------- /docs/index.md: -------------------------------------------------------------------------------- 1 | # ikforth 2 | 3 | **ikforth** is an idiomatic Forth implementation. 4 | 5 | [![Build Status](https://github.com/ikysil/ikforth/workflows/CI/badge.svg?action=push)](https://github.com/ikysil/ikforth/actions) 6 | 7 | A few facts: 8 | 9 | * 32 bits code 10 | * Runs on Linux and Windows (tested with Wine) 11 | * Supports Indirect and Direct Threaded Code representations 12 | * Image-based system 13 | * x86 assembler is used to bootstrap image capable of interpreting from files 14 | * Image is NOT relocatable - absolute 32 bits addresses are used in native and threaded code 15 | * CELL size is 32 bits 16 | * CHAR size is 8 bits 17 | * addressable unit - 1 byte (8 bits) 18 | 19 | ---- 20 | 21 | * 22 | * 23 | -------------------------------------------------------------------------------- /docs/unum/A Radical Approach to Computation with Real Numbers - 94-743-1-PB.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/unum/A Radical Approach to Computation with Real Numbers - 94-743-1-PB.pdf -------------------------------------------------------------------------------- /docs/unum/Beating Floating Point at its Own Game- Posit Arithmetic - 137-897-1-PB.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/unum/Beating Floating Point at its Own Game- Posit Arithmetic - 137-897-1-PB.pdf -------------------------------------------------------------------------------- /docs/unum/Posits4.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/unum/Posits4.pdf -------------------------------------------------------------------------------- /docs/x86/Encoding Real x86 Instructions.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikysil/ikforth/30b82245b15e00c2abb06838e4bd328e3409deba/docs/x86/Encoding Real x86 Instructions.pdf -------------------------------------------------------------------------------- /lib/template.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: TEMPLATE 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | ONLY FORTH DEFINITIONS 8 | 9 | VOCABULARY TEMPLATE-PRIVATE 10 | 11 | ALSO TEMPLATE-PRIVATE DEFINITIONS 12 | 13 | \ private definitions go here 14 | 15 | ONLY FORTH DEFINITIONS ALSO TEMPLATE-PRIVATE 16 | 17 | \ public definitions go here 18 | \ private definitions are available for use 19 | 20 | ONLY FORTH DEFINITIONS 21 | 22 | REPORT-NEW-NAME ! 23 | -------------------------------------------------------------------------------- /lib/~be/float-test.f: -------------------------------------------------------------------------------- 1 | 100 SET-PRECISION \ max precision for testing 2 | 3 | CR .( 1/7 = ) 1 s>f 7 s>f F/ R. 4 | CR .( 1/3 = ) 1 s>f 3 s>f F/ R. 5 | CR .( 2/3 = ) 2 s>f 3 s>f F/ R. 6 | CR .( 355/113 = ) 355 s>f 113 s>f F/ R. 7 | CR .( sqrt[2] = ) 2 s>f FSQRT R. 8 | CR .( 123/234 = ) 123 S>F 234 S>F F/ R. -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-bsf.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 BSF – Bit Scan Forward operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ BSF – Bit Scan Forward 5 | 6 | : BSF/RR, (S ra rb -- ) 7 | \G Compile operation BSF ra, rb without operand size prefix. 8 | B# 00001111 ASM8, 9 | B# 10111100 ASM8, 10 | SWAP 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : BSF/RR16, (S r16a r16b -- ) 15 | \G Compile operation BSF r16a, r16b. 16 | ?OP16, 17 | BSF/RR, 18 | ; 19 | 20 | : BSF/RR32, (S r32a r32b -- ) 21 | \G Compile operation BSF r32a, r32b. 22 | ?OP32, 23 | BSF/RR, 24 | ; 25 | 26 | \ EOF 27 | 28 | CR 29 | 30 | use32 .( use32 BSF) cr 31 | 32 | here cx dx BSF/RR16, 8 dump 33 | 34 | here ecx edx BSF/RR32, 8 dump 35 | 36 | use16 .( use16 BSF) cr 37 | 38 | here cx dx BSF/RR16, 8 dump 39 | 40 | here ecx edx BSF/RR32, 8 dump 41 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-bsr.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 BSR – Bit Scan Reverse operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ BSR – Bit Scan Reverse 5 | 6 | : BSR/RR, (S ra rb -- ) 7 | \G Compile operation BSR ra, rb without operand size prefix. 8 | B# 00001111 ASM8, 9 | B# 10111101 ASM8, 10 | SWAP 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : BSR/RR16, (S r16a r16b -- ) 15 | \G Compile operation BSR r16a, r16b. 16 | ?OP16, 17 | BSR/RR, 18 | ; 19 | 20 | : BSR/RR32, (S r32a r32b -- ) 21 | \G Compile operation BSR r32a, r32b. 22 | ?OP32, 23 | BSR/RR, 24 | ; 25 | 26 | \ EOF 27 | 28 | CR 29 | 30 | use32 .( use32 BSR) cr 31 | 32 | here cx dx BSR/RR16, 8 dump 33 | 34 | here ecx edx BSR/RR32, 8 dump 35 | 36 | use16 .( use16 BSR) cr 37 | 38 | here cx dx BSR/RR16, 8 dump 39 | 40 | here ecx edx BSR/RR32, 8 dump 41 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-bswap.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 BSWAP – Byte Swap operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ BSWAP – Byte Swap 5 | 6 | : BSWAP/R32, (S r32 -- ) 7 | \G Compile operation BSWAP r32. 8 | ?OP32, 9 | B# 00001111 ASM8, 10 | B# 11001000 OR ASM8, 11 | ; 12 | 13 | \ EOF 14 | 15 | CR 16 | 17 | use32 .( use32 BSWAP) cr 18 | 19 | here edx BSWAP/R32, 8 dump 20 | 21 | use16 .( use16 BSWAP) cr 22 | 23 | here edx BSWAP/R32, 8 dump 24 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-bt.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 BT – Bit Test operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ BT – Bit Test 5 | 6 | : BT/RR, (S ra rb -- ) 7 | \G Compile operation BT ra, rb without operand size prefix. 8 | B# 00001111 ASM8, 9 | B# 10100011 ASM8, 10 | 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : BT/RR16, (S r16a r16b -- ) 15 | \G Compile operation BT r16a, r16b. 16 | ?OP16, 17 | BT/RR, 18 | ; 19 | 20 | : BT/RR32, (S r32a r32b -- ) 21 | \G Compile operation BT r32a, r32b. 22 | ?OP32, 23 | BT/RR, 24 | ; 25 | 26 | 27 | : BT/RI8, (S r imm8 -- ) 28 | \G Compile operation BT r, imm8 without operand size prefix. 29 | B# 00001111 ASM8, 30 | B# 10111010 ASM8, 31 | SWAP B# 11100000 OR ASM8, 32 | ASM8, 33 | ; 34 | 35 | : BT/R16I8, (S r16 imm8 -- ) 36 | \G Compile operation BT r16, imm8. 37 | ?OP16, 38 | BT/RI8, 39 | ; 40 | 41 | : BT/R32I8, (S r32 imm8 -- ) 42 | \G Compile operation BT r32, imm8. 43 | ?OP32, 44 | BT/RI8, 45 | ; 46 | 47 | 48 | \ EOF 49 | 50 | CR 51 | 52 | use32 .( use32 BT) cr 53 | 54 | here cx dx BT/RR16, 8 dump 55 | 56 | here ecx edx BT/RR32, 8 dump 57 | 58 | here cx h# 56 BT/R16I8, 8 dump 59 | 60 | here ecx h# 56 BT/R32I8, 8 dump 61 | 62 | use16 .( use16 BT) cr 63 | 64 | here cx dx BT/RR16, 8 dump 65 | 66 | here ecx edx BT/RR32, 8 dump 67 | 68 | here cx h# 56 BT/R16I8, 8 dump 69 | 70 | here ecx h# 56 BT/R32I8, 8 dump 71 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-btc.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 BTC/RR – Bit Test and Complement operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ BTC – Bit Test and Complement 5 | 6 | : BTC/RR, (S ra rb -- ) 7 | \G Compile operation BTC ra, rb without operand size prefix. 8 | B# 00001111 ASM8, 9 | B# 10111011 ASM8, 10 | 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : BTC/RR16, (S r16a r16b -- ) 15 | \G Compile operation BTC r16a, r16b. 16 | ?OP16, 17 | BTC/RR, 18 | ; 19 | 20 | : BTC/RR32, (S r32a r32b -- ) 21 | \G Compile operation BTC r32a, r32b. 22 | ?OP32, 23 | BTC/RR, 24 | ; 25 | 26 | 27 | : BTC/RI8, (S r imm8 -- ) 28 | \G Compile operation BTC r, imm8 without operand size prefix. 29 | B# 00001111 ASM8, 30 | B# 10111010 ASM8, 31 | SWAP B# 11111000 OR ASM8, 32 | ASM8, 33 | ; 34 | 35 | : BTC/R16I8, (S r16 imm8 -- ) 36 | \G Compile operation BTC r16, imm8. 37 | ?OP16, 38 | BTC/RI8, 39 | ; 40 | 41 | : BTC/R32I8, (S r32 imm8 -- ) 42 | \G Compile operation BTC r32, imm8. 43 | ?OP32, 44 | BTC/RI8, 45 | ; 46 | 47 | 48 | \ EOF 49 | 50 | CR 51 | 52 | use32 .( use32 BTC) cr 53 | 54 | here cx dx BTC/RR16, 8 dump 55 | 56 | here ecx edx BTC/RR32, 8 dump 57 | 58 | here cx h# 56 BTC/R16I8, 8 dump 59 | 60 | here ecx h# 56 BTC/R32I8, 8 dump 61 | 62 | use16 .( use16 BTC) cr 63 | 64 | here cx dx BTC/RR16, 8 dump 65 | 66 | here ecx edx BTC/RR32, 8 dump 67 | 68 | here cx h# 56 BTC/R16I8, 8 dump 69 | 70 | here ecx h# 56 BTC/R32I8, 8 dump 71 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-btr.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 BTR – Bit Test and Reset operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ BTR – Bit Test and Reset 5 | 6 | : BTR/RR, (S ra rb -- ) 7 | \G Compile operation BTR ra, rb without operand size prefix. 8 | B# 00001111 ASM8, 9 | B# 10110011 ASM8, 10 | 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : BTR/RR16, (S r16a r16b -- ) 15 | \G Compile operation BTR r16a, r16b. 16 | ?OP16, 17 | BTR/RR, 18 | ; 19 | 20 | : BTR/RR32, (S r32a r32b -- ) 21 | \G Compile operation BTR r32a, r32b. 22 | ?OP32, 23 | BTR/RR, 24 | ; 25 | 26 | 27 | : BTR/RI8, (S r imm8 -- ) 28 | \G Compile operation BTR r, imm8 without operand size prefix. 29 | B# 00001111 ASM8, 30 | B# 10111010 ASM8, 31 | SWAP B# 11110000 OR ASM8, 32 | ASM8, 33 | ; 34 | 35 | : BTR/R16I8, (S r16 imm8 -- ) 36 | \G Compile operation BTR r16, imm8. 37 | ?OP16, 38 | BTR/RI8, 39 | ; 40 | 41 | : BTR/R32I8, (S r32 imm8 -- ) 42 | \G Compile operation BTR r32, imm8. 43 | ?OP32, 44 | BTR/RI8, 45 | ; 46 | 47 | 48 | \ EOF 49 | 50 | CR 51 | 52 | use32 .( use32 BTR) cr 53 | 54 | here cx dx BTR/RR16, 8 dump 55 | 56 | here ecx edx BTR/RR32, 8 dump 57 | 58 | here cx h# 56 BTR/R16I8, 8 dump 59 | 60 | here ecx h# 56 BTR/R32I8, 8 dump 61 | 62 | use16 .( use16 BTR) cr 63 | 64 | here cx dx BTR/RR16, 8 dump 65 | 66 | here ecx edx BTR/RR32, 8 dump 67 | 68 | here cx h# 56 BTR/R16I8, 8 dump 69 | 70 | here ecx h# 56 BTR/R32I8, 8 dump 71 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-bts.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 BTS – Bit Test and Set operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ BTS – Bit Test and Set 5 | 6 | : BTS/RR, (S ra rb -- ) 7 | \G Compile operation BTS ra, rb without operand size prefix. 8 | B# 00001111 ASM8, 9 | B# 10101011 ASM8, 10 | 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : BTS/RR16, (S r16a r16b -- ) 15 | \G Compile operation BTS r16a, r16b. 16 | ?OP16, 17 | BTS/RR, 18 | ; 19 | 20 | : BTS/RR32, (S r32a r32b -- ) 21 | \G Compile operation BTS r32a, r32b. 22 | ?OP32, 23 | BTS/RR, 24 | ; 25 | 26 | 27 | : BTS/RI8, (S r imm8 -- ) 28 | \G Compile operation BTS r, imm8 without operand size prefix. 29 | B# 00001111 ASM8, 30 | B# 10111010 ASM8, 31 | SWAP B# 11101000 OR ASM8, 32 | ASM8, 33 | ; 34 | 35 | : BTS/R16I8, (S r16 imm8 -- ) 36 | \G Compile operation BTS r16, imm8. 37 | ?OP16, 38 | BTS/RI8, 39 | ; 40 | 41 | : BTS/R32I8, (S r32 imm8 -- ) 42 | \G Compile operation BTS r32, imm8. 43 | ?OP32, 44 | BTS/RI8, 45 | ; 46 | 47 | 48 | \ EOF 49 | 50 | CR 51 | 52 | use32 .( use32 BTS) cr 53 | 54 | here cx dx BTS/RR16, 8 dump 55 | 56 | here ecx edx BTS/RR32, 8 dump 57 | 58 | here cx h# 56 BTS/R16I8, 8 dump 59 | 60 | here ecx h# 56 BTS/R32I8, 8 dump 61 | 62 | use16 .( use16 BTS) cr 63 | 64 | here cx dx BTS/RR16, 8 dump 65 | 66 | here ecx edx BTS/RR32, 8 dump 67 | 68 | here cx h# 56 BTS/R16I8, 8 dump 69 | 70 | here ecx h# 56 BTS/R32I8, 8 dump 71 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-cmpxchg.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 CMPXCHG – Compare and Exchange operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ CMPXCHG – Compare and Exchange 5 | 6 | : CMPXCHG/RR8, (S r8a r8b -- ) 7 | \G Compile operation CMPXCHG r8a, r8b. 8 | B# 00001111 ASM8, 9 | B# 10110000 ASM8, 10 | 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : CMPXCHG/RR, (S ra rb -- ) 15 | \G Compile operation CMPXCHG ra, rb without operand size prefix. 16 | B# 00001111 ASM8, 17 | B# 10110001 ASM8, 18 | 3 LSHIFT OR 19 | B# 11000000 OR ASM8, 20 | ; 21 | 22 | : CMPXCHG/RR16, (S r16a r16b -- ) 23 | \G Compile operation CMPXCHG r16a, r16b. 24 | ?OP16, 25 | CMPXCHG/RR, 26 | ; 27 | 28 | : CMPXCHG/RR32, (S r32a r32b -- ) 29 | \G Compile operation CMPXCHG r32a, r32b. 30 | ?OP32, 31 | CMPXCHG/RR, 32 | ; 33 | 34 | \ EOF 35 | 36 | CR 37 | 38 | use32 .( use32 CMPXCHG) cr 39 | 40 | here ch bl CMPXCHG/RR8, 8 dump 41 | 42 | here cx dx CMPXCHG/RR16, 8 dump 43 | 44 | here ecx edx CMPXCHG/RR32, 8 dump 45 | 46 | use16 .( use16 CMPXCHG) cr 47 | 48 | here ch bl CMPXCHG/RR8, 8 dump 49 | 50 | here cx dx CMPXCHG/RR16, 8 dump 51 | 52 | here ecx edx CMPXCHG/RR32, 8 dump 53 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-dec.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 DEC – Decrement by 1 operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ DEC – Decrement by 1 5 | 6 | : DEC/RR8, (S reg8 -- ) 7 | \G Compile operation DEC reg8. 8 | B# 11111110 ASM8, 9 | B# 11001000 OR ASM8, 10 | ; 11 | 12 | : DEC/RR16, (S reg16 -- ) 13 | \G Compile operation DEC reg16. 14 | ?OP16, 15 | B# 11111111 ASM8, 16 | B# 11001000 OR ASM8, 17 | ; 18 | 19 | : DEC/RR32, (S reg32 -- ) 20 | \G Compile operation DEC reg32. 21 | ?OP32, 22 | B# 11111111 ASM8, 23 | B# 11001000 OR ASM8, 24 | ; 25 | 26 | B# 01001000 CONSTANT OP-DEC-ALT 27 | 28 | : DEC/RR16a, (S reg16 -- ) 29 | \G Compile operation DEC reg16 (alternative encoding). 30 | ?OP16, 31 | OP-DEC-ALT OR ASM8, 32 | ; 33 | 34 | : DEC/RR32a, (S reg32 -- ) 35 | \G Compile operation DEC reg32 (alternative encoding). 36 | ?OP32, 37 | OP-DEC-ALT OR ASM8, 38 | ; 39 | 40 | \ EOF 41 | 42 | CR 43 | 44 | use32 .( use32 DEC) cr 45 | 46 | here dl DEC/RR8, 8 dump 47 | 48 | here dx DEC/RR16, 8 dump 49 | 50 | here edx DEC/RR32, 8 dump 51 | 52 | here dx DEC/RR16a, 8 dump 53 | 54 | here edx DEC/RR32a, 8 dump 55 | 56 | use16 .( use16 DEC) cr 57 | 58 | here dl DEC/RR8, 8 dump 59 | 60 | here dx DEC/RR16, 8 dump 61 | 62 | here edx DEC/RR32, 8 dump 63 | 64 | here dx DEC/RR16a, 8 dump 65 | 66 | here edx DEC/RR32a, 8 dump 67 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-div.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 DIV – Unsigned Divide operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ DIV – Unsigned Divide 5 | 6 | : DIV/AR8, (S r8 -- ) 7 | \G Compile operation DIV r8. 8 | B# 11110110 ASM8, 9 | B# 11110000 OR ASM8, 10 | ; 11 | 12 | : DIV/AR16, (S r16 -- ) 13 | \G Compile operation DIV r16. 14 | ?OP16, 15 | B# 11110111 ASM8, 16 | B# 11110000 OR ASM8, 17 | ; 18 | 19 | : DIV/AR32, (S r32 -- ) 20 | \G Compile operation DIV r32. 21 | ?OP32, 22 | B# 11110111 ASM8, 23 | B# 11110000 OR ASM8, 24 | ; 25 | 26 | \ EOF 27 | 28 | CR 29 | 30 | use32 .( use32 DIV) cr 31 | 32 | here dl DIV/AR8, 8 dump 33 | 34 | here dx DIV/AR16, 8 dump 35 | 36 | here edx DIV/AR32, 8 dump 37 | 38 | use16 .( use16 DIV) cr 39 | 40 | here dl DIV/AR8, 8 dump 41 | 42 | here dx DIV/AR16, 8 dump 43 | 44 | here edx DIV/AR32, 8 dump 45 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-idiv.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 IDIV – Signed Divide operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ IDIV – Signed Divide 5 | 6 | : IDIV/AR8, (S r8 -- ) 7 | \G Compile operation IDIV r8. 8 | B# 11110110 ASM8, 9 | B# 11111000 OR ASM8, 10 | ; 11 | 12 | : IDIV/AR16, (S r16 -- ) 13 | \G Compile operation IDIV r16. 14 | ?OP16, 15 | B# 11110111 ASM8, 16 | B# 11111000 OR ASM8, 17 | ; 18 | 19 | : IDIV/AR32, (S r32 -- ) 20 | \G Compile operation IDIV r32. 21 | ?OP32, 22 | B# 11110111 ASM8, 23 | B# 11111000 OR ASM8, 24 | ; 25 | 26 | \ EOF 27 | 28 | CR 29 | 30 | use32 .( use32 IDIV) cr 31 | 32 | here dl IDIV/AR8, 8 dump 33 | 34 | here dx IDIV/AR16, 8 dump 35 | 36 | here edx IDIV/AR32, 8 dump 37 | 38 | use16 .( use16 IDIV) cr 39 | 40 | here dl IDIV/AR8, 8 dump 41 | 42 | here dx IDIV/AR16, 8 dump 43 | 44 | here edx IDIV/AR32, 8 dump 45 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-imul.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 IMUL – Signed Multiply operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ IMUL – Signed Multiply 5 | 6 | : IMUL/AR8, (S r8 -- ) 7 | \G Compile operation IMUL r8. 8 | B# 11110110 ASM8, 9 | B# 11101000 OR ASM8, 10 | ; 11 | 12 | : IMUL/AR16, (S r16 -- ) 13 | \G Compile operation IMUL r16. 14 | ?OP16, 15 | B# 11110111 ASM8, 16 | B# 11101000 OR ASM8, 17 | ; 18 | 19 | : IMUL/AR32, (S r32 -- ) 20 | \G Compile operation IMUL r32. 21 | ?OP32, 22 | B# 11110111 ASM8, 23 | B# 11101000 OR ASM8, 24 | ; 25 | 26 | : IMUL/RR, (S ra rb -- ) 27 | \G Compile operation IMUL ra, rb without operand size prefix. 28 | B# 00001111 ASM8, 29 | B# 10101111 ASM8, 30 | SWAP 3 LSHIFT OR 31 | B# 11000000 OR ASM8, 32 | ; 33 | 34 | : IMUL/RR16, (S r16a r16b -- ) 35 | \G Compile operation IMUL r16a, r16b. 36 | ?OP16, 37 | IMUL/RR, 38 | ; 39 | 40 | : IMUL/RR32, (S r32a r32b -- ) 41 | \G Compile operation IMUL r32a, r32b. 42 | ?OP32, 43 | IMUL/RR, 44 | ; 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 IMUL) cr 51 | 52 | here dl IMUL/AR8, 8 dump 53 | 54 | here dx IMUL/AR16, 8 dump 55 | 56 | here edx IMUL/AR32, 8 dump 57 | 58 | here bx dx IMUL/RR16, 8 dump 59 | 60 | here ebx edx IMUL/RR32, 8 dump 61 | 62 | use16 .( use16 IMUL) cr 63 | 64 | here dl IMUL/AR8, 8 dump 65 | 66 | here dx IMUL/AR16, 8 dump 67 | 68 | here edx IMUL/AR32, 8 dump 69 | 70 | here bx dx IMUL/RR16, 8 dump 71 | 72 | here ebx edx IMUL/RR32, 8 dump 73 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-inc.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 INC – Increment by 1 operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ INC – Increment by 1 5 | 6 | : INC/R8, (S r8 -- ) 7 | \G Compile operation INC r8. 8 | B# 11111110 ASM8, 9 | B# 11000000 OR ASM8, 10 | ; 11 | 12 | : INC/R16, (S r16 -- ) 13 | \G Compile operation INC r16. 14 | ?OP16, 15 | B# 11111111 ASM8, 16 | B# 11000000 OR ASM8, 17 | ; 18 | 19 | : INC/R32, (S r32 -- ) 20 | \G Compile operation INC r32. 21 | ?OP32, 22 | B# 11111111 ASM8, 23 | B# 11000000 OR ASM8, 24 | ; 25 | 26 | B# 01000000 CONSTANT OP-INC-ALT 27 | 28 | : INC/R16a, (S r16 -- ) 29 | \G Compile operation INC r16 (alternative encoding). 30 | ?OP16, 31 | OP-INC-ALT OR ASM8, 32 | ; 33 | 34 | : INC/R32a, (S r32 -- ) 35 | \G Compile operation INC r32 (alternative encoding). 36 | ?OP32, 37 | OP-INC-ALT OR ASM8, 38 | ; 39 | 40 | \ EOF 41 | 42 | CR 43 | 44 | use32 .( use32 INC) cr 45 | 46 | here dl INC/R8, 8 dump 47 | 48 | here dx INC/R16, 8 dump 49 | 50 | here edx INC/R32, 8 dump 51 | 52 | here dx INC/R16a, 8 dump 53 | 54 | here edx INC/R32a, 8 dump 55 | 56 | use16 .( use16 INC) cr 57 | 58 | here dl INC/R8, 8 dump 59 | 60 | here dx INC/R16, 8 dump 61 | 62 | here edx INC/R32, 8 dump 63 | 64 | here dx INC/R16a, 8 dump 65 | 66 | here edx INC/R32a, 8 dump 67 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-mov-data.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 MOV – Move Data operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ MOV – Move Data 5 | 6 | B# 10001000 CONSTANT ALUOP-MOV 7 | 8 | ALUOP-MOV ALUOP-> 9 | ALU/RR8: MOV/RR8->, (S reg1 reg2 -- ) 10 | \G Append operation MOV reg2, reg1 between two 8 bit registers 11 | 12 | ALUOP-MOV ALUOP<- 13 | ALU/RR8: MOV/RR8<-, (S reg1 reg2 -- ) 14 | \G Append operation MOV reg1, reg2 between two 8 bit registers 15 | 16 | ALUOP-MOV ALUOP-> 17 | ALU/RR16: MOV/RR16->, (S reg1 reg2 -- ) 18 | \G Append operation MOV reg2, reg1 between two 16 bit registers 19 | 20 | ALUOP-MOV ALUOP<- 21 | ALU/RR16: MOV/RR16<-, (S reg1 reg2 -- ) 22 | \G Append operation MOV reg1, reg2 between two 16 bit registers 23 | 24 | ALUOP-MOV ALUOP-> 25 | ALU/RR32: MOV/RR32->, (S reg1 reg2 -- ) 26 | \G Append operation MOV reg2, reg1 between two 32 bit registers 27 | 28 | ALUOP-MOV ALUOP<- 29 | ALU/RR32: MOV/RR32<-, (S reg1 reg2 -- ) 30 | \G Append operation MOV reg1, reg2 between two 32 bit registers 31 | 32 | 33 | \ EOF 34 | 35 | CR 36 | 37 | use32 .( use32 MOV) cr 38 | 39 | here dl dh MOV/RR8->, 8 dump 40 | here dl dh MOV/RR8<-, 8 dump 41 | 42 | here dx bx MOV/RR16->, 8 dump 43 | here dx bx MOV/RR16<-, 8 dump 44 | 45 | here edx ebx MOV/RR32->, 8 dump 46 | here edx ebx MOV/RR32<-, 8 dump 47 | 48 | use16 .( use16 MOV) cr 49 | 50 | here dl dh MOV/RR8->, 8 dump 51 | here dl dh MOV/RR8<-, 8 dump 52 | 53 | here dx bx MOV/RR16->, 8 dump 54 | here dx bx MOV/RR16<-, 8 dump 55 | 56 | here edx ebx MOV/RR32->, 8 dump 57 | here edx ebx MOV/RR32<-, 8 dump 58 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-movzx.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 MOVZX – Move with Zero-Extend operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ MOVZX – Move with Zero-Extend 5 | 6 | : MOVZX/RR8, (S ra rb -- ) 7 | \G Compile operation MOVZX ra, rb without operand size prefix. 8 | B# 00001111 ASM8, 9 | B# 10110110 ASM8, 10 | SWAP 3 LSHIFT OR 11 | B# 11000000 OR ASM8, 12 | ; 13 | 14 | : MOVZX/R16R8, (S r16 r8 -- ) 15 | \G Compile operation MOVZX r16, r8. 16 | ?OP16, 17 | MOVZX/RR8, 18 | ; 19 | 20 | : MOVZX/R32R8, (S r32 r8 -- ) 21 | \G Compile operation MOVZX r32, r8. 22 | ?OP32, 23 | MOVZX/RR8, 24 | ; 25 | 26 | : MOVZX/R32R16, (S r32 r16 -- ) 27 | \G Compile operation MOVZX r32, r16. 28 | ?OP32, 29 | B# 00001111 ASM8, 30 | B# 10110111 ASM8, 31 | SWAP 3 LSHIFT OR 32 | B# 11000000 OR ASM8, 33 | ; 34 | 35 | \ EOF 36 | 37 | CR 38 | 39 | use32 .( use32 MOVZX) cr 40 | 41 | here cx dh MOVZX/R16R8, 8 dump 42 | 43 | here ecx dh MOVZX/R32R8, 8 dump 44 | 45 | here ebx dh MOVZX/R32R16, 8 dump 46 | 47 | use16 .( use16 MOVZX) cr 48 | 49 | here cx dh MOVZX/R16R8, 8 dump 50 | 51 | here ecx dh MOVZX/R32R8, 8 dump 52 | 53 | here ebx dh MOVZX/R32R16, 8 dump 54 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-mul.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 MUL – Unsigned Multiply operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ MUL – Unsigned Multiply 5 | 6 | : MUL/AR8, (S r8 -- ) 7 | \G Compile operation MUL r8. 8 | B# 11110110 ASM8, 9 | B# 11100000 OR ASM8, 10 | ; 11 | 12 | : MUL/AR16, (S r16 -- ) 13 | \G Compile operation MUL r16. 14 | ?OP16, 15 | B# 11110111 ASM8, 16 | B# 11100000 OR ASM8, 17 | ; 18 | 19 | : MUL/AR32, (S r32 -- ) 20 | \G Compile operation MUL r32. 21 | ?OP32, 22 | B# 11110111 ASM8, 23 | B# 11100000 OR ASM8, 24 | ; 25 | 26 | \ EOF 27 | 28 | CR 29 | 30 | use32 .( use32 MUL) cr 31 | 32 | here dl MUL/AR8, 8 dump 33 | 34 | here dx MUL/AR16, 8 dump 35 | 36 | here edx MUL/AR32, 8 dump 37 | 38 | use16 .( use16 MUL) cr 39 | 40 | here dl MUL/AR8, 8 dump 41 | 42 | here dx MUL/AR16, 8 dump 43 | 44 | here edx MUL/AR32, 8 dump 45 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-neg.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 NEG – Two's Complement Negation operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ NEG – Two's Complement Negation 5 | 6 | : NEG/R8, (S r8 -- ) 7 | \G Compile operation NEG r8. 8 | B# 11110110 ASM8, 9 | B# 11011000 OR ASM8, 10 | ; 11 | 12 | : NEG/R16, (S r16 -- ) 13 | \G Compile operation NEG r16. 14 | ?OP16, 15 | B# 11110111 ASM8, 16 | B# 11011000 OR ASM8, 17 | ; 18 | 19 | : NEG/R32, (S r32 -- ) 20 | \G Compile operation NEG r32. 21 | ?OP32, 22 | B# 11110111 ASM8, 23 | B# 11011000 OR ASM8, 24 | ; 25 | 26 | \ EOF 27 | 28 | CR 29 | 30 | use32 .( use32 NEG) cr 31 | 32 | here dl NEG/R8, 8 dump 33 | 34 | here dx NEG/R16, 8 dump 35 | 36 | here edx NEG/R32, 8 dump 37 | 38 | use16 .( use16 NEG) cr 39 | 40 | here dl NEG/R8, 8 dump 41 | 42 | here dx NEG/R16, 8 dump 43 | 44 | here edx NEG/R32, 8 dump 45 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-nop.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 NOP – No Operation operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ NOP – No Operation 5 | B# 10010000 6 | I1B: NOP, 7 | 8 | \ NOP – Multi-byte No Operation 1 9 | 10 | : NOP/R16, (S r16 -- ) 11 | \G Compile operation NOP r16. 12 | B# 00001111 ASM8, 13 | B# 00011111 ASM8, 14 | B# 11000000 OR ASM8, 15 | ; 16 | 17 | SYNONYM NOP/R32, NOP/R16, 18 | \G Compile operation NOP r32. 19 | 20 | \ EOF 21 | 22 | CR 23 | 24 | use32 .( use32 NOP) cr 25 | 26 | here NOP, 8 dump 27 | 28 | here dx NOP/R16, 8 dump 29 | 30 | here edx NOP/R32, 8 dump 31 | 32 | use16 .( use16 NOP) cr 33 | 34 | here NOP, 8 dump 35 | 36 | here dx NOP/R16, 8 dump 37 | 38 | here edx NOP/R32, 8 dump 39 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-not.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 NOT – One's Complement Negation operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ NOT – One's Complement Negation 5 | 6 | : NOT/R8, (S r8 -- ) 7 | \G Compile operation NOT r8. 8 | B# 11110110 ASM8, 9 | B# 11010000 OR ASM8, 10 | ; 11 | 12 | : NOT/R16, (S r16 -- ) 13 | \G Compile operation NOT r16. 14 | ?OP16, 15 | B# 11110111 ASM8, 16 | B# 11010000 OR ASM8, 17 | ; 18 | 19 | : NOT/R32, (S r32 -- ) 20 | \G Compile operation NOT r32. 21 | ?OP32, 22 | B# 11110111 ASM8, 23 | B# 11010000 OR ASM8, 24 | ; 25 | 26 | \ EOF 27 | 28 | CR 29 | 30 | use32 .( use32 NOT) cr 31 | 32 | here dl NOT/R8, 8 dump 33 | 34 | here dx NOT/R16, 8 dump 35 | 36 | here edx NOT/R32, 8 dump 37 | 38 | use16 .( use16 NOT) cr 39 | 40 | here dl NOT/R8, 8 dump 41 | 42 | here dx NOT/R16, 8 dump 43 | 44 | here edx NOT/R32, 8 dump 45 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-pop.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 POP – Pop a Word from the Stack operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ POP – Pop a Word from the Stack 5 | 6 | : POP/R16, (S reg16 -- ) 7 | \G Compile operation POP reg16. 8 | ?OP16, 9 | B# 10001111 ASM8, 10 | B# 11000000 OR ASM8, 11 | ; 12 | 13 | : POP/R32, (S reg32 -- ) 14 | \G Compile operation POP reg32. 15 | ?OP32, 16 | B# 10001111 ASM8, 17 | B# 11000000 OR ASM8, 18 | ; 19 | 20 | B# 01011000 CONSTANT OP-POP-ALT 21 | 22 | : POP/R16a, (S reg16 -- ) 23 | \G Compile operation POP reg16 (alternative encoding). 24 | ?OP16, 25 | OP-POP-ALT OR ASM8, 26 | ; 27 | 28 | : POP/R32a, (S reg32 -- ) 29 | \G Compile operation POP reg32 (alternative encoding). 30 | ?OP32, 31 | OP-POP-ALT OR ASM8, 32 | ; 33 | 34 | \ EOF 35 | 36 | CR 37 | 38 | use32 .( use32 POP) cr 39 | 40 | here dx POP/R16, 8 dump 41 | 42 | here edx POP/R32, 8 dump 43 | 44 | here dx POP/R16a, 8 dump 45 | 46 | here edx POP/R32a, 8 dump 47 | 48 | use16 .( use16 POP) cr 49 | 50 | here dx POP/R16, 8 dump 51 | 52 | here edx POP/R32, 8 dump 53 | 54 | here dx POP/R16a, 8 dump 55 | 56 | here edx POP/R32a, 8 dump 57 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-push.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 PUSH – Push Operand onto the Stack operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ PUSH – Push Operand onto the Stack 5 | 6 | : PUSH/R16, (S reg16 -- ) 7 | \G Compile operation PUSH reg16. 8 | ?OP16, 9 | B# 11111111 ASM8, 10 | B# 11110000 OR ASM8, 11 | ; 12 | 13 | : PUSH/R32, (S reg32 -- ) 14 | \G Compile operation PUSH reg32. 15 | ?OP32, 16 | B# 11111111 ASM8, 17 | B# 11110000 OR ASM8, 18 | ; 19 | 20 | B# 01010000 CONSTANT OP-PUSH-ALT 21 | 22 | : PUSH/R16a, (S reg16 -- ) 23 | \G Compile operation PUSH reg16 (alternative encoding). 24 | ?OP16, 25 | OP-PUSH-ALT OR ASM8, 26 | ; 27 | 28 | : PUSH/R32a, (S reg32 -- ) 29 | \G Compile operation PUSH reg32 (alternative encoding). 30 | ?OP32, 31 | OP-PUSH-ALT OR ASM8, 32 | ; 33 | 34 | 35 | : PUSH/I8, (S imm8 -- ) 36 | \G Compile operation PUSH imm8. 37 | B# 01101010 ASM8, 38 | ASM8, 39 | ; 40 | 41 | : PUSH/I16, (S imm16 -- ) 42 | \G Compile operation PUSH imm16. 43 | ?OP16, 44 | B# 01101000 ASM8, 45 | ASM16, 46 | ; 47 | 48 | : PUSH/I32, (S imm32 -- ) 49 | \G Compile operation PUSH imm32. 50 | ?OP32, 51 | B# 01101000 ASM8, 52 | ASM32, 53 | ; 54 | 55 | 56 | \ EOF 57 | 58 | CR 59 | 60 | use32 .( use32 PUSH) cr 61 | 62 | here dx PUSH/R16, 8 dump 63 | 64 | here edx PUSH/R32, 8 dump 65 | 66 | here dx PUSH/R16a, 8 dump 67 | 68 | here edx PUSH/R32a, 8 dump 69 | 70 | here h# 12345678 PUSH/I8, 8 dump 71 | here h# 12345678 PUSH/I16, 8 dump 72 | here h# 12345678 PUSH/I32, 8 dump 73 | 74 | use16 .( use16 PUSH) cr 75 | 76 | here dx PUSH/R16, 8 dump 77 | 78 | here edx PUSH/R32, 8 dump 79 | 80 | here dx PUSH/R16a, 8 dump 81 | 82 | here edx PUSH/R32a, 8 dump 83 | 84 | here h# 12345678 PUSH/I8, 8 dump 85 | here h# 12345678 PUSH/I16, 8 dump 86 | here h# 12345678 PUSH/I32, 8 dump 87 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-rcl.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 RCL – Rotate thru Carry Left operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ RCL – Rotate thru Carry Left 5 | 6 | B# 00010000 CONSTANT SHIFTOP-RCL 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-RCL 10 | SHIFT/R8: RCL/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-RCL 14 | SHIFT/R16: RCL/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-RCL 18 | SHIFT/R32: RCL/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-RCL 22 | SHIFT/R8: RCL/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-RCL 26 | SHIFT/R16: RCL/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-RCL 30 | SHIFT/R32: RCL/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-RCL 35 | SHIFT/R8I8: RCL/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-RCL 39 | SHIFT/R16I8: RCL/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-RCL 43 | SHIFT/R32I8: RCL/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 RCL/1) cr 51 | 52 | here dl RCL/R8, 8 dump 53 | 54 | here dx RCL/R16, 8 dump 55 | 56 | here edx RCL/R32, 8 dump 57 | 58 | use16 .( use16 RCL/1) cr 59 | 60 | here dl RCL/R8, 8 dump 61 | 62 | here dx RCL/R16, 8 dump 63 | 64 | here edx RCL/R32, 8 dump 65 | 66 | use32 .( use32 RCL/CL) cr 67 | 68 | here dl RCL/R8CL, 8 dump 69 | 70 | here dx RCL/R16CL, 8 dump 71 | 72 | here edx RCL/R32CL, 8 dump 73 | 74 | use16 .( use16 RCL/CL) cr 75 | 76 | here dl RCL/R8CL, 8 dump 77 | 78 | here dx RCL/R16CL, 8 dump 79 | 80 | here edx RCL/R32CL, 8 dump 81 | 82 | use32 .( use32 RCL/IMM) cr 83 | 84 | here dl h# 34 RCL/R8I8, 8 dump 85 | 86 | here dx h# 34 RCL/R16I8, 8 dump 87 | 88 | here edx h# 34 RCL/R32I8, 8 dump 89 | 90 | use16 .( use16 RCL/IMM) cr 91 | 92 | here dl h# 34 RCL/R8I8, 8 dump 93 | 94 | here dx h# 34 RCL/R16I8, 8 dump 95 | 96 | here edx h# 34 RCL/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-rcr.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 RCR – Rotate thru Carry Right operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ RCR – Rotate thru Carry Right 5 | 6 | B# 00011000 CONSTANT SHIFTOP-RCR 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-RCR 10 | SHIFT/R8: RCR/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-RCR 14 | SHIFT/R16: RCR/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-RCR 18 | SHIFT/R32: RCR/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-RCR 22 | SHIFT/R8: RCR/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-RCR 26 | SHIFT/R16: RCR/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-RCR 30 | SHIFT/R32: RCR/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-RCR 35 | SHIFT/R8I8: RCR/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-RCR 39 | SHIFT/R16I8: RCR/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-RCR 43 | SHIFT/R32I8: RCR/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 RCR/1) cr 51 | 52 | here dl RCR/R8, 8 dump 53 | 54 | here dx RCR/R16, 8 dump 55 | 56 | here edx RCR/R32, 8 dump 57 | 58 | use16 .( use16 RCR/1) cr 59 | 60 | here dl RCR/R8, 8 dump 61 | 62 | here dx RCR/R16, 8 dump 63 | 64 | here edx RCR/R32, 8 dump 65 | 66 | use32 .( use32 RCR/CL) cr 67 | 68 | here dl RCR/R8CL, 8 dump 69 | 70 | here dx RCR/R16CL, 8 dump 71 | 72 | here edx RCR/R32CL, 8 dump 73 | 74 | use16 .( use16 RCR/CL) cr 75 | 76 | here dl RCR/R8CL, 8 dump 77 | 78 | here dx RCR/R16CL, 8 dump 79 | 80 | here edx RCR/R32CL, 8 dump 81 | 82 | use32 .( use32 RCR/IMM) cr 83 | 84 | here dl h# 34 RCR/R8I8, 8 dump 85 | 86 | here dx h# 34 RCR/R16I8, 8 dump 87 | 88 | here edx h# 34 RCR/R32I8, 8 dump 89 | 90 | use16 .( use16 RCR/IMM) cr 91 | 92 | here dl h# 34 RCR/R8I8, 8 dump 93 | 94 | here dx h# 34 RCR/R16I8, 8 dump 95 | 96 | here edx h# 34 RCR/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-rol.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 ROL – Rotate Left operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ ROL – Rotate Left 5 | 6 | B# 00000000 CONSTANT SHIFTOP-ROL 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-ROL 10 | SHIFT/R8: ROL/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-ROL 14 | SHIFT/R16: ROL/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-ROL 18 | SHIFT/R32: ROL/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-ROL 22 | SHIFT/R8: ROL/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-ROL 26 | SHIFT/R16: ROL/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-ROL 30 | SHIFT/R32: ROL/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-ROL 35 | SHIFT/R8I8: ROL/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-ROL 39 | SHIFT/R16I8: ROL/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-ROL 43 | SHIFT/R32I8: ROL/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 ROL/1) cr 51 | 52 | here dl ROL/R8, 8 dump 53 | 54 | here dx ROL/R16, 8 dump 55 | 56 | here edx ROL/R32, 8 dump 57 | 58 | use16 .( use16 ROL/1) cr 59 | 60 | here dl ROL/R8, 8 dump 61 | 62 | here dx ROL/R16, 8 dump 63 | 64 | here edx ROL/R32, 8 dump 65 | 66 | use32 .( use32 ROL/CL) cr 67 | 68 | here dl ROL/R8CL, 8 dump 69 | 70 | here dx ROL/R16CL, 8 dump 71 | 72 | here edx ROL/R32CL, 8 dump 73 | 74 | use16 .( use16 ROL/CL) cr 75 | 76 | here dl ROL/R8CL, 8 dump 77 | 78 | here dx ROL/R16CL, 8 dump 79 | 80 | here edx ROL/R32CL, 8 dump 81 | 82 | use32 .( use32 ROL/IMM) cr 83 | 84 | here dl h# 34 ROL/R8I8, 8 dump 85 | 86 | here dx h# 34 ROL/R16I8, 8 dump 87 | 88 | here edx h# 34 ROL/R32I8, 8 dump 89 | 90 | use16 .( use16 ROL/IMM) cr 91 | 92 | here dl h# 34 ROL/R8I8, 8 dump 93 | 94 | here dx h# 34 ROL/R16I8, 8 dump 95 | 96 | here edx h# 34 ROL/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-ror.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 ROR – Rotate Right operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ ROR – Rotate Right 5 | 6 | B# 00001000 CONSTANT SHIFTOP-ROR 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-ROR 10 | SHIFT/R8: ROR/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-ROR 14 | SHIFT/R16: ROR/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-ROR 18 | SHIFT/R32: ROR/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-ROR 22 | SHIFT/R8: ROR/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-ROR 26 | SHIFT/R16: ROR/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-ROR 30 | SHIFT/R32: ROR/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-ROR 35 | SHIFT/R8I8: ROR/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-ROR 39 | SHIFT/R16I8: ROR/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-ROR 43 | SHIFT/R32I8: ROR/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 ROR/1) cr 51 | 52 | here dl ROR/R8, 8 dump 53 | 54 | here dx ROR/R16, 8 dump 55 | 56 | here edx ROR/R32, 8 dump 57 | 58 | use16 .( use16 ROR/1) cr 59 | 60 | here dl ROR/R8, 8 dump 61 | 62 | here dx ROR/R16, 8 dump 63 | 64 | here edx ROR/R32, 8 dump 65 | 66 | use32 .( use32 ROR/CL) cr 67 | 68 | here dl ROR/R8CL, 8 dump 69 | 70 | here dx ROR/R16CL, 8 dump 71 | 72 | here edx ROR/R32CL, 8 dump 73 | 74 | use16 .( use16 ROR/CL) cr 75 | 76 | here dl ROR/R8CL, 8 dump 77 | 78 | here dx ROR/R16CL, 8 dump 79 | 80 | here edx ROR/R32CL, 8 dump 81 | 82 | use32 .( use32 ROR/IMM) cr 83 | 84 | here dl h# 34 ROR/R8I8, 8 dump 85 | 86 | here dx h# 34 ROR/R16I8, 8 dump 87 | 88 | here edx h# 34 ROR/R32I8, 8 dump 89 | 90 | use16 .( use16 ROR/IMM) cr 91 | 92 | here dl h# 34 ROR/R8I8, 8 dump 93 | 94 | here dx h# 34 ROR/R16I8, 8 dump 95 | 96 | here edx h# 34 ROR/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-sal.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 SAL – Shift Arithmetic Left operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ SAL – Shift Arithmetic Left same instruction as SHL 5 | 6 | B# 00100000 CONSTANT SHIFTOP-SAL 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-SAL 10 | SHIFT/R8: SAL/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-SAL 14 | SHIFT/R16: SAL/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-SAL 18 | SHIFT/R32: SAL/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-SAL 22 | SHIFT/R8: SAL/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-SAL 26 | SHIFT/R16: SAL/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-SAL 30 | SHIFT/R32: SAL/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-SAL 35 | SHIFT/R8I8: SAL/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-SAL 39 | SHIFT/R16I8: SAL/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-SAL 43 | SHIFT/R32I8: SAL/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 SAL/1) cr 51 | 52 | here dl SAL/R8, 8 dump 53 | 54 | here dx SAL/R16, 8 dump 55 | 56 | here edx SAL/R32, 8 dump 57 | 58 | use16 .( use16 SAL/1) cr 59 | 60 | here dl SAL/R8, 8 dump 61 | 62 | here dx SAL/R16, 8 dump 63 | 64 | here edx SAL/R32, 8 dump 65 | 66 | use32 .( use32 SAL/CL) cr 67 | 68 | here dl SAL/R8CL, 8 dump 69 | 70 | here dx SAL/R16CL, 8 dump 71 | 72 | here edx SAL/R32CL, 8 dump 73 | 74 | use16 .( use16 SAL/CL) cr 75 | 76 | here dl SAL/R8CL, 8 dump 77 | 78 | here dx SAL/R16CL, 8 dump 79 | 80 | here edx SAL/R32CL, 8 dump 81 | 82 | use32 .( use32 SAL/IMM) cr 83 | 84 | here dl h# 34 SAL/R8I8, 8 dump 85 | 86 | here dx h# 34 SAL/R16I8, 8 dump 87 | 88 | here edx h# 34 SAL/R32I8, 8 dump 89 | 90 | use16 .( use16 SAL/IMM) cr 91 | 92 | here dl h# 34 SAL/R8I8, 8 dump 93 | 94 | here dx h# 34 SAL/R16I8, 8 dump 95 | 96 | here edx h# 34 SAL/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-sar.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 SAR – Shift Arithmetic Right operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ SAR – Shift Arithmetic Right 5 | 6 | B# 00111000 CONSTANT SHIFTOP-SAR 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-SAR 10 | SHIFT/R8: SAR/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-SAR 14 | SHIFT/R16: SAR/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-SAR 18 | SHIFT/R32: SAR/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-SAR 22 | SHIFT/R8: SAR/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-SAR 26 | SHIFT/R16: SAR/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-SAR 30 | SHIFT/R32: SAR/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-SAR 35 | SHIFT/R8I8: SAR/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-SAR 39 | SHIFT/R16I8: SAR/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-SAR 43 | SHIFT/R32I8: SAR/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 SAR/1) cr 51 | 52 | here dl SAR/R8, 8 dump 53 | 54 | here dx SAR/R16, 8 dump 55 | 56 | here edx SAR/R32, 8 dump 57 | 58 | use16 .( use16 SAR/1) cr 59 | 60 | here dl SAR/R8, 8 dump 61 | 62 | here dx SAR/R16, 8 dump 63 | 64 | here edx SAR/R32, 8 dump 65 | 66 | use32 .( use32 SAR/CL) cr 67 | 68 | here dl SAR/R8CL, 8 dump 69 | 70 | here dx SAR/R16CL, 8 dump 71 | 72 | here edx SAR/R32CL, 8 dump 73 | 74 | use16 .( use16 SAR/CL) cr 75 | 76 | here dl SAR/R8CL, 8 dump 77 | 78 | here dx SAR/R16CL, 8 dump 79 | 80 | here edx SAR/R32CL, 8 dump 81 | 82 | use32 .( use32 SAR/IMM) cr 83 | 84 | here dl h# 34 SAR/R8I8, 8 dump 85 | 86 | here dx h# 34 SAR/R16I8, 8 dump 87 | 88 | here edx h# 34 SAR/R32I8, 8 dump 89 | 90 | use16 .( use16 SAR/IMM) cr 91 | 92 | here dl h# 34 SAR/R8I8, 8 dump 93 | 94 | here dx h# 34 SAR/R16I8, 8 dump 95 | 96 | here edx h# 34 SAR/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-set-cond.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 SETcc – Byte Set on Condition operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ SETcc – Byte Set on Condition 5 | 6 | : SET?/R8, (S reg8 condition -- ) 7 | \G Compile operation SETcc reg. 8 | B# 00001111 ASM8, 9 | B# 10010000 OR ASM8, 10 | B# 11000000 OR ASM8, 11 | ; 12 | 13 | \ EOF 14 | 15 | CR 16 | 17 | .( SET?/R8,) cr 18 | 19 | here dl ?A SET?/R8, 8 dump 20 | 21 | here dl ?NLE SET?/R8, 8 dump 22 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-shl.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 SHL – Shift Left operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ SHL – Shift Left 5 | 6 | B# 00100000 CONSTANT SHIFTOP-SHL 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-SHL 10 | SHIFT/R8: SHL/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-SHL 14 | SHIFT/R16: SHL/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-SHL 18 | SHIFT/R32: SHL/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-SHL 22 | SHIFT/R8: SHL/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-SHL 26 | SHIFT/R16: SHL/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-SHL 30 | SHIFT/R32: SHL/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-SHL 35 | SHIFT/R8I8: SHL/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-SHL 39 | SHIFT/R16I8: SHL/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-SHL 43 | SHIFT/R32I8: SHL/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 SHL/1) cr 51 | 52 | here dl SHL/R8, 8 dump 53 | 54 | here dx SHL/R16, 8 dump 55 | 56 | here edx SHL/R32, 8 dump 57 | 58 | use16 .( use16 SHL/1) cr 59 | 60 | here dl SHL/R8, 8 dump 61 | 62 | here dx SHL/R16, 8 dump 63 | 64 | here edx SHL/R32, 8 dump 65 | 66 | use32 .( use32 SHL/CL) cr 67 | 68 | here dl SHL/R8CL, 8 dump 69 | 70 | here dx SHL/R16CL, 8 dump 71 | 72 | here edx SHL/R32CL, 8 dump 73 | 74 | use16 .( use16 SHL/CL) cr 75 | 76 | here dl SHL/R8CL, 8 dump 77 | 78 | here dx SHL/R16CL, 8 dump 79 | 80 | here edx SHL/R32CL, 8 dump 81 | 82 | use32 .( use32 SHL/IMM) cr 83 | 84 | here dl h# 34 SHL/R8I8, 8 dump 85 | 86 | here dx h# 34 SHL/R16I8, 8 dump 87 | 88 | here edx h# 34 SHL/R32I8, 8 dump 89 | 90 | use16 .( use16 SHL/IMM) cr 91 | 92 | here dl h# 34 SHL/R8I8, 8 dump 93 | 94 | here dx h# 34 SHL/R16I8, 8 dump 95 | 96 | here edx h# 34 SHL/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-shr.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 SHR – Shift Right operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ SHR – Shift Right 5 | 6 | B# 00101000 CONSTANT SHIFTOP-SHR 7 | 8 | ALUOP-SHIFT 9 | SHIFTOP-SHR 10 | SHIFT/R8: SHR/R8, 11 | 12 | ALUOP-SHIFT 13 | SHIFTOP-SHR 14 | SHIFT/R16: SHR/R16, 15 | 16 | ALUOP-SHIFT 17 | SHIFTOP-SHR 18 | SHIFT/R32: SHR/R32, 19 | 20 | ALUOP-SHIFT SHIFT/CL 21 | SHIFTOP-SHR 22 | SHIFT/R8: SHR/R8CL, 23 | 24 | ALUOP-SHIFT SHIFT/CL 25 | SHIFTOP-SHR 26 | SHIFT/R16: SHR/R16CL, 27 | 28 | ALUOP-SHIFT SHIFT/CL 29 | SHIFTOP-SHR 30 | SHIFT/R32: SHR/R32CL, 31 | 32 | 33 | ALUOP-SHIFT-IMM 34 | SHIFTOP-SHR 35 | SHIFT/R8I8: SHR/R8I8, 36 | 37 | ALUOP-SHIFT-IMM 38 | SHIFTOP-SHR 39 | SHIFT/R16I8: SHR/R16I8, 40 | 41 | ALUOP-SHIFT-IMM 42 | SHIFTOP-SHR 43 | SHIFT/R32I8: SHR/R32I8, 44 | 45 | 46 | \ EOF 47 | 48 | CR 49 | 50 | use32 .( use32 SHR/1) cr 51 | 52 | here dl SHR/R8, 8 dump 53 | 54 | here dx SHR/R16, 8 dump 55 | 56 | here edx SHR/R32, 8 dump 57 | 58 | use16 .( use16 SHR/1) cr 59 | 60 | here dl SHR/R8, 8 dump 61 | 62 | here dx SHR/R16, 8 dump 63 | 64 | here edx SHR/R32, 8 dump 65 | 66 | use32 .( use32 SHR/CL) cr 67 | 68 | here dl SHR/R8CL, 8 dump 69 | 70 | here dx SHR/R16CL, 8 dump 71 | 72 | here edx SHR/R32CL, 8 dump 73 | 74 | use16 .( use16 SHR/CL) cr 75 | 76 | here dl SHR/R8CL, 8 dump 77 | 78 | here dx SHR/R16CL, 8 dump 79 | 80 | here edx SHR/R32CL, 8 dump 81 | 82 | use32 .( use32 SHR/IMM) cr 83 | 84 | here dl h# 34 SHR/R8I8, 8 dump 85 | 86 | here dx h# 34 SHR/R16I8, 8 dump 87 | 88 | here edx h# 34 SHR/R32I8, 8 dump 89 | 90 | use16 .( use16 SHR/IMM) cr 91 | 92 | here dl h# 34 SHR/R8I8, 8 dump 93 | 94 | here dx h# 34 SHR/R16I8, 8 dump 95 | 96 | here edx h# 34 SHR/R32I8, 8 dump 97 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-test.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 TEST operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ TEST – Logical Compare 5 | 6 | B# 10000100 CONSTANT ALUOP-TEST 7 | B# 10101000 CONSTANT ALUOP-TEST-AI 8 | 9 | ALUOP-TEST 10 | ALU/RR8: TEST/RR8, (S reg1 reg2 -- ) 11 | \G Append operation TEST reg1, reg2 between two 8 bit registers 12 | 13 | ALUOP-TEST 14 | ALU/RR16: TEST/RR16, (S reg1 reg2 -- ) 15 | \G Append operation TEST reg1, reg2 between two 16 bit registers 16 | 17 | ALUOP-TEST 18 | ALU/RR32: TEST/RR32, (S reg1 reg2 -- ) 19 | \G Append operation TEST reg1, reg2 between two 32 bit registers 20 | 21 | 22 | ALUOP-TEST-AI 23 | ALU/AI8: TEST/AI8, (S imm8 -- ) 24 | \G Append operation TEST AL, imm8 25 | 26 | ALUOP-TEST-AI 27 | ALU/AI16: TEST/AI16, (S imm16 -- ) 28 | \G Append operation TEST AX, imm16 29 | 30 | ALUOP-TEST-AI 31 | ALU/AI32: TEST/AI32, (S imm32 -- ) 32 | \G Append operation TEST EAX, imm32 33 | 34 | 35 | \ EOF 36 | 37 | CR 38 | 39 | use32 .( use32 TEST) cr 40 | 41 | here dl dh TEST/RR8, 8 dump 42 | 43 | here dx bx TEST/RR16, 8 dump 44 | 45 | here edx ebx TEST/RR32, 8 dump 46 | 47 | here h# 12345678 TEST/AI8, 8 dump 48 | here h# 12345678 TEST/AI16, 8 dump 49 | here h# 12345678 TEST/AI32, 8 dump 50 | 51 | use16 .( use16 TEST) cr 52 | 53 | here dl dh TEST/RR8, 8 dump 54 | 55 | here dx bx TEST/RR16, 8 dump 56 | 57 | here edx ebx TEST/RR32, 8 dump 58 | 59 | here h# 12345678 TEST/AI8, 8 dump 60 | here h# 12345678 TEST/AI16, 8 dump 61 | here h# 12345678 TEST/AI32, 8 dump 62 | -------------------------------------------------------------------------------- /lib/~ik/fa-asm-x86-32/op-xchg.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: x86 XCHG operation encoding 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ XCHG – Exchange Register/Memory with Register 5 | 6 | B# 10000110 CONSTANT ALUOP-XCHG 7 | 8 | ALUOP-XCHG 9 | ALU/RR8: XCHG/RR8, (S reg1 reg2 -- ) 10 | \G Append operation XCHG reg1, reg2 between two 8 bit registers 11 | 12 | ALUOP-XCHG 13 | ALU/RR16: XCHG/RR16, (S reg1 reg2 -- ) 14 | \G Append operation XCHG reg1, reg2 between two 16 bit registers 15 | 16 | ALUOP-XCHG 17 | ALU/RR32: XCHG/RR32, (S reg1 reg2 -- ) 18 | \G Append operation XCHG reg1, reg2 between two 32 bit registers 19 | 20 | : XCHG/AR, (S reg -- ) 21 | \G Compile operation XCHG [E]AX, reg (without operand size prefix). 22 | B# 10010000 OR ASM8, 23 | ; 24 | 25 | : XCHG/AR16, (S reg -- ) 26 | \G Compile operation XCHG AX, reg. 27 | ?OP16, 28 | XCHG/AR, 29 | ; 30 | 31 | : XCHG/AR32, (S reg -- ) 32 | \G Compile operation XCHG EAX, reg. 33 | ?OP32, 34 | XCHG/AR, 35 | ; 36 | 37 | 38 | \ EOF 39 | 40 | CR 41 | 42 | use32 .( use32 XCHG) cr 43 | 44 | here dl dh XCHG/RR8, 8 dump 45 | 46 | here dx bx XCHG/RR16, 8 dump 47 | 48 | here edx ebx XCHG/RR32, 8 dump 49 | 50 | here cx XCHG/AR16, 8 dump 51 | 52 | here ecx XCHG/AR32, 8 dump 53 | 54 | use16 .( use16 XCHG) cr 55 | 56 | here dl dh XCHG/RR8, 8 dump 57 | 58 | here dx bx XCHG/RR16, 8 dump 59 | 60 | here edx ebx XCHG/RR32, 8 dump 61 | 62 | here cx XCHG/AR16, 8 dump 63 | 64 | here ecx XCHG/AR32, 8 dump 65 | -------------------------------------------------------------------------------- /lib/~ik/float-ieee-binary/f-compare-zero.4th: -------------------------------------------------------------------------------- 1 | \ DEBUG-ON 2 | : F0< (S -- flag ) (F r -- ) \ 12.6.1.1440 F0< 3 | (G flag is true if and only if r is less than zero.) 4 | 1 ?FPSTACK-UNDERFLOW 5 | ?FPX-NAN IF FDROP FALSE EXIT THEN 6 | ?FPX-SUBN IF FDROP FALSE EXIT THEN 7 | ?FPX0< FDROP 8 | ; 9 | 10 | : F0= (S -- flag ) (F r -- ) \ 12.6.1.1450 F0= 11 | (G flag is true if and only if r is equal to zero.) 12 | 1 ?FPSTACK-UNDERFLOW 13 | ?FPX-NAN IF FDROP FALSE EXIT THEN 14 | ?FPX-SUBN IF FDROP TRUE EXIT THEN 15 | ?FPX0= FDROP 16 | ; 17 | \DEBUG-OFF 18 | -------------------------------------------------------------------------------- /lib/~ik/float-ieee-binary/f-exp.4th: -------------------------------------------------------------------------------- 1 | \ DEBUG-ON 2 | 18 CONSTANT FEXPM1-ITERATIONS-DEFAULT 3 | 4 | : FEXPM1-APPROX (S +n -- ) (F r1 -- r2 ) 5 | \G Approximate exp(r1 - 1) using +n iterations. 6 | 1 ?FPSTACK-UNDERFLOW 7 | 3 ?FPSTACK-OVERFLOW 8 | FDUP FDUP 9 | 1 2>R 10 | BEGIN 11 | 2R> 1 + 12 | 2DUP > 13 | \ S: n i flag R: F: r2(i-1)' r1 (r1**(i-1))/(i-1)! 14 | WHILE 15 | DUP S>D 2SWAP 2>R 16 | \ S: di R: n i F: r2(i-1)' r1 (r1**(i-1))/(i-1)! 17 | FOVER F* 18 | D>F F/ 19 | \ S: R: n i F: r2(i-1)' r1 (r1**(i))/(i)! 20 | FROT FOVER F+ 21 | \ S: R: n i F: r1 (r1**(i))/(i)! r2'+(r1**(i))/(i)! 22 | FROT FROT 23 | \ S: R: n i F: r2(i)' r1 (r1**(i))/(i)! 24 | REPEAT 25 | 2DROP 26 | \ F: r2(i)' r1 (r1**(i))/(i)! 27 | FDROP FDROP 28 | ; 29 | 30 | : FEXPM1 (F r1 -- r2 ) \ 12.6.2.1516 FEXPM1 31 | \G Raise e to the power r1 and subtract one, giving r2. 32 | 1 ?FPSTACK-UNDERFLOW 33 | ?FPX-NAN IF EXIT THEN 34 | ?FPX-INF IF 35 | ?FPX0< IF FDROP FZERO THEN 36 | EXIT 37 | THEN 38 | \DEBUG S" FEXPM1-INPUT: " CR TYPE CR F.DUMP CR 39 | FEXPM1-ITERATIONS-DEFAULT FEXPM1-APPROX 40 | \DEBUG S" FEXPM1-RESULT: " CR TYPE CR F.DUMP CR 41 | ; 42 | 43 | : FEXP (F r1 -- r2 ) \ 12.6.2.1515 FEXP 44 | \G Raise e to the power r1, giving r2. 45 | 1 ?FPSTACK-UNDERFLOW 46 | 1 ?FPSTACK-OVERFLOW 47 | \DEBUG S" FEXP-INPUT: " CR TYPE CR F.DUMP CR 48 | ?FPX-NAN IF EXIT THEN 49 | ?FPX-INF IF 50 | ?FPX0< IF FDROP FZERO THEN 51 | EXIT 52 | THEN 53 | ?FPX0< FABS 54 | FEXPM1 FONE F+ 55 | IF FONE FSWAP F/ THEN 56 | \DEBUG S" FEXP-RESULT: " CR TYPE CR F.DUMP CR 57 | ; 58 | 59 | 1.E FEXP FCONSTANT FLNBASE 60 | \DEBUG-OFF 61 | -------------------------------------------------------------------------------- /lib/~ik/float-ieee-binary/f-isqrt.4th: -------------------------------------------------------------------------------- 1 | 16 CONSTANT FISQRT-ITERATIONS-DEFAULT 2 | 3 | 4 | : FISQRT-NEWTON-STEP (F r1 r2 -- r3 ) 5 | \G Perform step in Newton approximation for an inverse square root. 6 | \G Calculate next approximation r3 for an inverse square root of 7 | \G r1 given the previous approximation r2. 8 | ?FPX0= IF FNIP EXIT THEN 9 | \ r3 = r2 * (3 - r1 * r2**2) / 2 10 | FSWAP FOVER F* FOVER F* \ F: r2 r1*r2*r2 11 | [ -3. D>F ] FLITERAL F+ \ F: r2 r1*r2*r2-3 12 | F* FNEGATE 13 | FTWO F/ 14 | ; 15 | 16 | 17 | : FISQRT-APPROX (F r1 -- r2 ) 18 | \G r2 is the initial approximation of inverse square root of r1. 19 | 'FPX FPE@ DUP 20 | FPFLAGS>EXP 2/ FPV-EXP-MASK AND 21 | SWAP FPV-EXP-MASK INVERT AND OR 22 | 'FPX FPE! 23 | FONE FSWAP F/ 24 | ; 25 | 26 | 27 | : FISQRT (F r1 -- r2 ) 28 | \G r2 is the inverse square root of r1. An ambiguous condition exists if r1 is less than zero. 29 | ?FPX-NAN IF EXIT THEN 30 | ?FPX0= IF FPX-INF! EXIT THEN 31 | ?FPX0< IF FPX-NAN! EXIT THEN 32 | ?FPX-INF IF FDROP FZERO EXIT THEN 33 | FDUP FISQRT-APPROX 34 | FISQRT-ITERATIONS-DEFAULT ['] FISQRT-NEWTON-STEP FNEWTON 35 | ; 36 | 37 | 38 | [UNDEFINED] FSQRT [IF] 39 | : FSQRT (F r1 -- r2 ) \ 12.6.2.1618 FSQRT 40 | \G r2 is the square root of r1. An ambiguous condition exists if r1 is less than zero. 41 | 1 ?FPSTACK-UNDERFLOW 42 | 1 ?FPSTACK-OVERFLOW 43 | ?FPX-NAN IF EXIT THEN 44 | ?FPX0= IF EXIT THEN 45 | ?FPX0< IF FPX-NAN! EXIT THEN 46 | ?FPX-INF IF EXIT THEN 47 | FDUP FISQRT F* 48 | ; 49 | [THEN] 50 | -------------------------------------------------------------------------------- /lib/~ik/float-ieee-binary/f-sqrt.4th: -------------------------------------------------------------------------------- 1 | 32 CONSTANT FSQRT-ITERATIONS-DEFAULT 2 | 3 | 4 | : FSQRT-APPROX (F r1 -- r2 ) 5 | \G r2 is the initial approximation of square root of r1. 6 | 'FPX FPE@ DUP 7 | FPFLAGS>EXP 2/ FPV-EXP-MASK AND 8 | SWAP FPV-EXP-MASK INVERT AND OR 9 | 'FPX FPE! 10 | ; 11 | 12 | 13 | : FSQRT-NEWTON-STEP (F r1 r2 -- r3 ) 14 | \G Perform step in Newton approximation for a square root. 15 | \G Calculate next approximation r3 for the square root of 16 | \G r1 given the previous approximation r2. 17 | ?FPX0= IF FNIP EXIT THEN 18 | FSWAP FOVER \ F: r2 r1 r2 19 | F/ F+ 20 | FTWO F/ 21 | ; 22 | 23 | 24 | : FSQRT-NEWTON-STEP2 (F r1 r2 -- r3 ) 25 | \G Perform step in Newton approximation for a square root. 26 | \G Calculate next approximation r3 for the square root of 27 | \G r1 given the previous approximation r2. 28 | ?FPX0= IF FNIP EXIT THEN 29 | FSWAP FOVER FDUP F* \ F: r2 r1 r2**2 30 | FSWAP F- \ F: r2 r2**2-r1 31 | FOVER FTWO F* F/ \ F: r2 (r2**2-r1)/(2*r2) 32 | F- 33 | ; 34 | 35 | 36 | : FSQRT (F r1 -- r2 ) \ 12.6.2.1618 FSQRT 37 | \G r2 is the square root of r1. An ambiguous condition exists if r1 is less than zero. 38 | 1 ?FPSTACK-UNDERFLOW 39 | 1 ?FPSTACK-OVERFLOW 40 | ?FPX-NAN IF EXIT THEN 41 | ?FPX0= IF EXIT THEN 42 | ?FPX0< IF FPX-NAN! EXIT THEN 43 | ?FPX-INF IF EXIT THEN 44 | FDUP FSQRT-APPROX 45 | FSQRT-ITERATIONS-DEFAULT ['] FSQRT-NEWTON-STEP2 FNEWTON 46 | ; 47 | -------------------------------------------------------------------------------- /lib/~ik/float-ieee-binary/f-star-star.4th: -------------------------------------------------------------------------------- 1 | \ DEBUG-ON 2 | : F**-INTEGER (S ud -- ) (F r1 -- r2 ) 3 | \G Raise r1 to the integer power ud. 4 | \DEBUG CR ." F**-INTEGER-INPUT: " CR 2DUP H.8 H.8 CR F.DUMP CR 5 | 2DUP D0= IF 2DROP FDROP FONE EXIT THEN 6 | OVER 1 AND IF FDUP ELSE FONE THEN 7 | BEGIN 8 | 2DUP OR 0<> 9 | WHILE 10 | FSWAP FDUP F* FSWAP 11 | 1 DRSHIFT 12 | OVER 1 AND IF FOVER F* THEN 13 | REPEAT 14 | 2DROP 15 | FNIP 16 | \DEBUG CR ." F**-INTEGER-RESULT: " CR F.DUMP CR 17 | ; 18 | 19 | : F** (F r1 r2 -- r3 ) \ 12.6.2.1415 F** 20 | \G Raise r1 to the power r2, giving the product r3. 21 | 2 ?FPSTACK-UNDERFLOW 22 | 2 ?FPSTACK-OVERFLOW 23 | ?FP2OP-NAN IF EXIT THEN 24 | \DEBUG CR ." F**-INPUT: " CR F.DUMP CR 25 | ?FPX0< IF 26 | FNEGATE 27 | RECURSE 28 | FONE FSWAP F/ 29 | \DEBUG CR ." F**-RESULT: " CR F.DUMP CR 30 | EXIT 31 | THEN 32 | FDUP FDUP FLOOR F= IF 33 | 0 34 | BEGIN 35 | ['] F>D CATCH 36 | EXC-OUT-OF-RANGE = 37 | WHILE 38 | FPX2/ 39 | 1+ 40 | REPEAT 41 | F**-INTEGER 42 | 0 ?DO 43 | FDUP F* 44 | LOOP 45 | \DEBUG CR ." F**-RESULT: " CR F.DUMP CR 46 | EXIT 47 | THEN 48 | FOVER F0= IF 49 | FNIP 50 | FDUP F0= IF 51 | FDROP 52 | FONE 53 | ELSE 54 | F0< IF 55 | EXC-FLOAT-DIVISION-BY-ZERO THROW 56 | ELSE 57 | FZERO 58 | THEN 59 | THEN 60 | ELSE 61 | FDUP F0= IF 62 | FDROP FDROP 63 | FONE 64 | ELSE 65 | FSWAP 66 | FABS FLN F* FEXP 67 | THEN 68 | THEN 69 | \DEBUG CR ." F**-RESULT: " CR F.DUMP CR 70 | ; 71 | \DEBUG-OFF 72 | -------------------------------------------------------------------------------- /lib/~ik/float.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: FLOAT definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | DEFER (F IMMEDIATE ' ( IS (F 8 | \G Floating-stack comment 9 | 10 | DEFER ?INF (S -- flag ) (F r -- ) 11 | \G Flag true only if r represents special value infinity 12 | 13 | DEFER ?NAN (S -- flag ) (F r -- ) 14 | \G Flag true only if r represents special value Not a Number 15 | 16 | REQUIRES" lib/~ik/float-ieee-binary.4th" 17 | REQUIRES" lib/~ik/float-output.4th" 18 | 19 | REPORT-NEW-NAME ! 20 | -------------------------------------------------------------------------------- /lib/~ik/open-interpreter.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: OPEN INTERPRETER definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | : >TCODE (S xt -- acp ) 8 | >BODY 9 | ; 10 | 11 | : >RR (S cp -- ) (R -- cp ) 12 | R> SWAP >R >R 13 | ; COMPILE-ONLY 14 | 15 | : >RR< (S cp1 -- cp2 ) (R cp2 -- cp1 ) 16 | R> R> ROT >R SWAP >R 17 | ; COMPILE-ONLY 18 | 19 | : RR> (S -- cp ) (R cp -- ) 20 | R> R> SWAP >R 21 | ; COMPILE-ONLY 22 | 23 | : RR@ (S -- cp ) (R cp -- cp ) 24 | R> R@ SWAP >R 25 | ; COMPILE-ONLY 26 | 27 | : RRDROP (S -- ) (R cp -- ) 28 | R> R> DROP >R 29 | ; COMPILE-ONLY 30 | 31 | : RUSH (S i*x xt -- j*x ) 32 | RRDROP >TCODE >RR 33 | ; COMPILE-ONLY 34 | 35 | : COPY>RR (S cp -- cp ) (R -- cp ) 36 | DUP >RR 37 | ; 38 | 39 | : RADDR@ (S addr -- cp ) 40 | @ 41 | ; 42 | 43 | : RADDR! (S cp addr -- ) 44 | ! 45 | ; 46 | 47 | : RADDR+ (S addr1 -- addr2 ) 48 | CELL+ 49 | ; 50 | 51 | : RADDR- (S addr1 -- addr2 ) 52 | [ 1 CELLS ] LITERAL - 53 | ; 54 | 55 | REPORT-NEW-NAME ! 56 | -------------------------------------------------------------------------------- /lib/~ik/quadruple.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: QUADRUPLE definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | ONLY FORTH DEFINITIONS 8 | 9 | 10 | S" ADDRESS-UNITS-BITS" ENVIRONMENT? [IF] 11 | CELLS 4 * CONSTANT QUADRUPLE-BITS 12 | [THEN] 13 | 14 | 15 | : Q2* (S q1 -- q2 ) 16 | \G Multiply quadruple-cell value by 2 - shift left 17 | 0 T2* 3>R 18 | 0 T2* 0. 3R> 19 | T+ DROP 20 | ; 21 | 22 | 23 | : Q2/ (S q1 -- q2 ) 24 | \G Divide quadruple-cell value by 2 - shift right with sign extension 25 | 0 ROT ROT T2/ 2>R >R 26 | 0 T2/ DROP R> + 27 | 2R> 28 | ; 29 | 30 | 31 | : Q+C (S q1 q2 -- q3 n ) 32 | \G Add quadruple-cell values q1 and q2 producing sum q3 and carry n. 33 | 2>R 2SWAP 2>R 34 | 2>R 0 2R> 0 T+ 35 | 0. 36 | 2R> 0 T+ 37 | 2R> 0 T+ 38 | ; 39 | 40 | 41 | : Q+ (S q1 q2 -- q3 ) 42 | \G Add quadruple-cell values q1 and q2 producing sum q3. 43 | Q+C DROP 44 | ; 45 | 46 | 47 | : D>Q (S d -- q ) 48 | \G Sign-extend double-cell value d to quadruple-cell value q. 49 | S>D S>D 50 | ; 51 | 52 | 53 | : QNEGATE (S q1 -- q2 ) 54 | \G Negate quadruple-cell value q1 producing q2. 55 | DINVERT 2SWAP 56 | DINVERT 2SWAP 57 | 1. D>Q 58 | Q+ 59 | ; 60 | 61 | 62 | : UD* (S ud1 ud2 -- udlow udhigh ) 63 | \G Perform exact multiplication of unsigned double values. 64 | 2OVER ROT >R 2>R \ S: ud1 udl2 R: ud1 udh2 65 | UT* 0 \ S: utl1 utm1 uth1 0 R: ud1 udh2 66 | 2R> R> UT* \ S: utl1 utm1 uth1 0 utl2 utm2 uth2 67 | T+ 68 | ; 69 | 70 | 71 | : QSWAP (S q1 q2 -- q2 q1 ) 72 | 2>R \ S: q10 q11 q12 q13 q20 q21 R: q22 q23 73 | 2SWAP \ S: q10 q11 q20 q21 q12 q13 R: q22 q23 74 | 2ROT \ S: q20 q21 q12 q13 q10 q11 R: q22 q23 75 | 2R> \ S: q20 q21 q12 q13 q10 q11 q22 q23 76 | 2SWAP \ S: q20 q21 q12 q13 q22 q23 q10 q11 77 | 2ROT \ S: q20 q21 q22 q23 q10 q11 q12 q13 78 | ; 79 | 80 | 81 | REPORT-NEW-NAME ! 82 | -------------------------------------------------------------------------------- /lib/~ik/tdasm-x86-32.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: Table-Driven Assembler for x86 32 bits 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ Goals: 5 | \ * compile x86 32 bits instructions 6 | \ * self-hosting meta-compiler for IKForth 7 | \ Non-goals: 8 | \ * syntax compatibility with existing assemblers 9 | \ * support for full set of instructions 10 | \ References: 11 | \ * Intel® 64 and IA-32 Architectures Software Developer’s Manual Volume 2D: Instruction Set Reference 12 | \ Guidelines: 13 | \ * all words ending with COMMA (,) compile to the dictionary 14 | 15 | REPORT-NEW-NAME @ 16 | REPORT-NEW-NAME OFF 17 | 18 | ONLY FORTH DEFINITIONS 19 | 20 | VOCABULARY TDASM8632-PRIVATE 21 | 22 | ALSO TDASM8632-PRIVATE DEFINITIONS 23 | 24 | \ private definitions go here 25 | 26 | \ All OP codes are represented in the same byte order as they are layed out in memory, 27 | \ for example $8F41FF for POP DWORD [ECX-1] 28 | 29 | \G Chop the LSB of x as x1 and remaining higher bits as x2 30 | : /ASM8 (S x -- x1 x2 ) 31 | DUP 32 | H# FF AND 33 | SWAP 34 | 8 RSHIFT 35 | ; 36 | 37 | \G Compile a 8-bits value (S x -- ) 38 | DEFER ASM8, 39 | 40 | ' C, IS ASM8, 41 | 42 | : OP>CODE (S op-pfa -- opcode-addr ) 43 | [ 1 CELLS ] LITERAL + 44 | ; 45 | 46 | : OP>NAME (S op-pfa -- name-token ) 47 | [ 2 CELLS ] LITERAL + @ 48 | ; 49 | 50 | \G Define a word compiling 8-bit opcode 51 | : 8C: (S opcode8 -- ) 52 | CREATE 53 | 1 , \ opcode size in bytes 54 | , \ opcode 55 | LATEST-NAME@ , \ mnemonic name token 56 | 0 , \ number of parameter sections 57 | DOES> (S addr -- ) 58 | OP>CODE @ 59 | /ASM8 DROP 60 | ASM8, 61 | ; 62 | 63 | INCLUDE" lib/~ik/tdasm-x86-32/8b-opcode.4th" 64 | 65 | ONLY FORTH DEFINITIONS ALSO TDASM8632-PRIVATE 66 | 67 | \ public definitions go here 68 | \ private definitions are available for use 69 | 70 | ONLY FORTH DEFINITIONS 71 | 72 | REPORT-NEW-NAME ! 73 | -------------------------------------------------------------------------------- /lib/~ik/tdasm-x86-32/8b-opcode.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: 8bit x86 opcodes 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ Maintenance note: keep sorted by the opcode 5 | 6 | \ Registers 7 | \ - EAX, ECX, EDX, EBX, ESP, EBP, ESI, EDI 8 | \ - ES, CS, SS, DS, GS, FS 9 | 10 | H# 06 8C: push.es 11 | H# 07 8C: pop.es 12 | H# 0E 8C: push.cs 13 | 14 | H# 16 8C: push.ss 15 | H# 17 8C: pop.ss 16 | H# 1E 8C: push.ds 17 | H# 1F 8C: pop.ds 18 | 19 | H# 40 8C: inc.eax 20 | H# 41 8C: inc.ecx 21 | H# 42 8C: inc.edx 22 | H# 43 8C: inc.ebx 23 | H# 44 8C: inc.esp 24 | H# 45 8C: inc.ebp 25 | H# 46 8C: inc.esi 26 | H# 47 8C: inc.edi 27 | 28 | H# 48 8C: dec.eax 29 | H# 49 8C: dec.ecx 30 | H# 4A 8C: dec.edx 31 | H# 4B 8C: dec.ebx 32 | H# 4C 8C: dec.esp 33 | H# 4D 8C: dec.ebp 34 | H# 4E 8C: dec.esi 35 | H# 4F 8C: dec.edi 36 | 37 | H# 50 8C: push.eax 38 | H# 51 8C: push.ecx 39 | H# 52 8C: push.edx 40 | H# 53 8C: push.ebx 41 | H# 54 8C: push.esp 42 | H# 55 8C: push.ebp 43 | H# 56 8C: push.esi 44 | H# 57 8C: push.edi 45 | 46 | H# 58 8C: pop.eax 47 | H# 59 8C: pop.ecx 48 | H# 5A 8C: pop.edx 49 | H# 5B 8C: pop.ebx 50 | H# 5C 8C: pop.esp 51 | H# 5D 8C: pop.ebp 52 | H# 5E 8C: pop.esi 53 | H# 5F 8C: pop.edi 54 | 55 | H# 90 8C: nop 56 | H# 9C 8C: pushf 57 | H# 9D 8C: popf 58 | 59 | H# A5 8C: movsd 60 | H# AB 8C: stosd 61 | H# AD 8C: lodsd 62 | H# AF 8C: scasd 63 | 64 | H# C3 8C: ret 65 | 66 | H# F2 8C: repnz 67 | H# F3 8C: repz 68 | H# F4 8C: hlt 69 | H# FA 8C: cli 70 | H# FB 8C: sti 71 | H# FC 8C: cld 72 | H# FD 8C: std 73 | -------------------------------------------------------------------------------- /lib/~js/486asm/486READ.ME: -------------------------------------------------------------------------------- 1 | The file ``ASM486.ZIP'' contains the source for the version 1.26 486 and 2 | Pentium(tm) assembler for Andrew McKewan and Tom Zimmer's FORTH for 3 | Windows(tm) 95 and NT. The files in the distribution are copyright (c) 1994, 4 | 1995 by Jim Schneider, and distributed under the terms of the Free Software 5 | Foundation's General Public License, (See the file COPYASM.486 in the 6 | archive). This software is furnished ``as is'', with absolutely no warranty 7 | whatsoever. 8 | 9 | The documentation (such as it is) for the assembler is in the file 10 | ``486ASM.DOC'', a plain ascii text file. *PLEASE* read this file before 11 | using the assembler. 12 | -------------------------------------------------------------------------------- /lib/~js/486asm/VCALL.F: -------------------------------------------------------------------------------- 1 | ( vcall.f ) 2 | ( a virtual call and return mechanism to allow execution of a FORTH word from ) 3 | ( assembly language, for Win32FORTH by Andrew McKewan & Tom Zimmer ) 4 | ( copyright [c] 1994, by Jim Schneider ) 5 | 6 | ( This program is free software; you can redistribute it and/or modify ) 7 | ( it under the terms of the GNU General Public License as published by ) 8 | ( the Free Software Foundation; either version 2 of the License, or ) 9 | ( any later version. ) 10 | ( ) 11 | ( This program is distributed in the hope that it will be useful, ) 12 | ( but WITHOUT ANY WARRANTY; without even the implied warranty of ) 13 | ( MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ) 14 | ( GNU General Public License for more details. ) 15 | ( ) 16 | ( You should have received a copy of the GNU General Public License ) 17 | ( along with this program; if not, write to the Free Software ) 18 | ( Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ) 19 | 20 | also assembler current @ definitions base @ hex 21 | code vreturn ( the virtual return, FORTH's IP is pointed here ) 22 | forth here cell+ , assembler ( need to create a virtual CFA ) 23 | mov esi, [ebp] 24 | mov ecx, 4 [ebp] 25 | add ebp, # 8 26 | jmp ecx 27 | end-code 28 | 29 | subr: vcall ( the virtual call function, stack-> return addr, eax-> xt ) 30 | sub ebp, # 8 31 | pop ecx 32 | mov [ebp], esi 33 | mov 4 [ebp], ecx 34 | mov esi, # ' vreturn rel>abs 35 | exec 36 | end-code 37 | 38 | macro: fcall ( a macro to assemble a call to vcall ) 39 | /set-prefix >r 40 | mov eax, # ' 41 | call vcall 42 | r> reset-syntax 43 | endm 44 | base ! current ! previous 45 | -------------------------------------------------------------------------------- /product/ikforth-dev-x86/SConscript: -------------------------------------------------------------------------------- 1 | import os 2 | 3 | Import('env', 'fkernelPath', 'bootdict') 4 | senv = env.Clone() 5 | 6 | senv['productname'] = 'ikforth-dev-x86' 7 | senv['buildername'] = 'product-builder' 8 | 9 | fkernelExec = senv.execname('${buildername}') 10 | 11 | senv.InstallAs('${buildername}.img', bootdict) 12 | senv.InstallAs(fkernelExec, fkernelPath) 13 | 14 | sysdict_deps = senv.SConscript('#sysdict/SConstruct-config', exports = ['env']) 15 | 16 | product_src = [] 17 | product_src.extend(sysdict_deps) 18 | product_src.extend(senv.Glob('#lib/*.4th')) 19 | product_src.extend(senv.Glob('#lib/~ik/*.4th')) 20 | product_src.extend(senv.Glob('#lib/~js/486asm/*.F')) 21 | product_src.extend(senv.Glob('#lib/~js/486asm/*.4th')) 22 | 23 | product_deps = [] 24 | product_deps.extend(senv.Glob('*.4th')) 25 | product_deps.extend(senv.Glob('#product/ikforth-base-x86/*.4th')) 26 | product_deps.extend(product_src) 27 | 28 | productdict = senv.Command('${productname}.img', 29 | fkernelExec, 30 | 'IKFORTHTERMINIT=${TERMINIT} VERSION_STRING=${GIT_DESC} ${BUILD_LAUNCHER} ${SOURCE} --dict-size 2M -- ${TARGET}') 31 | senv.Depends('${productname}.img', ['${buildername}.img', fkernelExec, product_deps]) 32 | 33 | Return('productdict') 34 | -------------------------------------------------------------------------------- /product/ikforth-dev-x86/product-builder.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: ikforth-dev-x86 builder 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | HERE 5 | 6 | REPORT-NEW-NAME-DUPLICATE @ 7 | REPORT-NEW-NAME @ 8 | 9 | TRUE REPORT-NEW-NAME-DUPLICATE ! 10 | FALSE REPORT-NEW-NAME ! 11 | 12 | S" product/ikforth-dev-x86/product-dict.4th" INCLUDED 13 | 14 | \ ' _READ-LINE IS READ-LINE 15 | \ ' _INCLUDED IS INCLUDED 16 | \ ' _INCLUDE-FILE IS INCLUDE-FILE 17 | 18 | REPORT-NEW-NAME ! 19 | REPORT-NEW-NAME-DUPLICATE ! 20 | 21 | DECIMAL 22 | 23 | CR .( Total data area size ) DATA-AREA-SIZE @ 16 U.R .( bytes ) 24 | CR .( Unused data area size ) UNUSED 16 U.R .( bytes ) 25 | CR .( Compiled ) HERE SWAP - 16 U.R .( bytes ) 26 | CR .( New vocabulary size ) HERE DATA-AREA-BASE - 16 U.R .( bytes ) 27 | 28 | 0x00800000 DATA-AREA-SIZE ! 29 | 30 | 1 ARGV? INVERT [IF] S" ikforth-dev-x86.img" [THEN] 31 | 2DUP CR .( Writing ) TYPE 32 | 33 | W/O CREATE-FILE THROW 34 | DATA-AREA-BASE HERE OVER - 256 ( Page size ) TUCK / 1+ * 2 PICK WRITE-FILE THROW 35 | CLOSE-FILE THROW 36 | 37 | CR .( OK ) 38 | 39 | BYE 40 | -------------------------------------------------------------------------------- /product/ikforth-dev-x86/product-dict.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: ikforth-dev-x86 dictionary 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | S" product/ikforth-base-x86/product-dict.4th" INCLUDED 5 | 6 | REQUIRES" sysdict/see.4th" 7 | REQUIRES" sysdict/x86/486asm.4th" 8 | REQUIRES" sysdict/class.4th" 9 | \ REQUIRES" sysdict/float.4th" 10 | -------------------------------------------------------------------------------- /product/ikforth-dist/SConscript: -------------------------------------------------------------------------------- 1 | import os 2 | 3 | Import('env') 4 | senv = env.Clone() 5 | 6 | dist_src = [] 7 | dist_src.extend(senv.Glob('#app/**')) 8 | dist_src.extend(senv.Glob('#blocks/**')) 9 | dist_src.extend(senv.Glob('#lib/**')) 10 | dist_src.extend(senv.Glob('#docs/*.md')) 11 | dist_src.extend(senv.Glob('#/*.md')) 12 | dist_src.extend(senv.Glob('#/LICENSE')) 13 | dist_src.extend(senv.Glob('#/IKForth-*.elf')) 14 | dist_src.extend(senv.Glob('#/IKForth-*.exe')) 15 | dist_src.extend(senv.Glob('#/IKForth-*.img')) 16 | dist_src.extend(senv.Glob('#/IKForth*.4th')) 17 | senv.Replace(TARFLAGS = '-c -z') 18 | senv.Replace(TARSUFFIX = '.tar.gz') 19 | dist_tar = senv.Tar('${DIST_FILE_NAME}', dist_src) 20 | dist_zip = senv.Zip('${DIST_FILE_NAME}', dist_src) 21 | 22 | senv.Alias('dist', [dist_tar, dist_zip]) 23 | -------------------------------------------------------------------------------- /sysdict/S$.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: S$ definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | \ Match delimiters for string 8 | : (S-DELIM) ( c1 -- c2) 9 | CASE 10 | [CHAR] < OF [CHAR] > ENDOF 11 | [CHAR] { OF [CHAR] } ENDOF 12 | [CHAR] [ OF [CHAR] ] ENDOF 13 | [CHAR] ( OF [CHAR] ) ENDOF 14 | DUP \ use same character for all others 15 | ENDCASE 16 | ; 17 | 18 | \ run-time routine for string parsing 19 | : PARSE-S$ ( ccc -- addr u) 20 | >IN @ 21 | CHAR 22 | SWAP >IN ! 23 | DUP PARSE 2DROP 24 | (S-DELIM) \ determine second delimiter 25 | PARSE \ parse to second delimiter 26 | ; 27 | 28 | \ run-time routine for string parsing 29 | : PARSE-S\$ ( ccc -- addr u) 30 | >IN @ 31 | CHAR 32 | SWAP >IN ! 33 | DUP PARSE 2DROP 34 | (S-DELIM) \ determine second delimiter 35 | PARSE\ \ parse to second delimiter 36 | ; 37 | 38 | \ parse string; if compiling, compile it as a literal. 39 | :NONAME PARSE-S$ ; 40 | :NONAME PARSE-S$ POSTPONE SLITERAL ; 41 | INT/COMP: S$ 42 | 43 | \ parse string; if compiling, compile it as a literal. 44 | :NONAME PARSE-S\$ ; 45 | :NONAME PARSE-S\$ POSTPONE SLITERAL ; 46 | INT/COMP: S\$ 47 | 48 | \ parse string and print it 49 | : .$ ( ccc -- ) 50 | PARSE-S$ TYPE 51 | ; IMMEDIATE 52 | 53 | \ parse string and print it 54 | : .\$ ( ccc -- ) 55 | PARSE-S\$ TYPE 56 | ; IMMEDIATE 57 | 58 | REPORT-NEW-NAME ! 59 | -------------------------------------------------------------------------------- /sysdict/SConstruct-config: -------------------------------------------------------------------------------- 1 | import os 2 | 3 | Import('env') 4 | senv = env.Clone() 5 | 6 | sysdict_deps = [] 7 | sysdict_deps.extend(senv.Glob('*.4th')) 8 | sysdict_deps.extend(senv.Glob('term/*.4th')) 9 | sysdict_deps.extend(senv.Glob('x86/*.4th')) 10 | sysdict_deps.extend(senv.Glob('x86-linux/*.4th')) 11 | sysdict_deps.extend(senv.Glob('x86-windows/*.4th')) 12 | 13 | Return('sysdict_deps') 14 | -------------------------------------------------------------------------------- /sysdict/args.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: ARGS definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | : ARGV? (S n -- c-addr count true | false ) \ retrieve n-th argument as counted string 8 | DUP 0< IF DROP FALSE EXIT THEN 9 | DUP ARGC < IF CELLS ARGV + @ ZCOUNT TRUE EXIT THEN 10 | DROP FALSE 11 | ; 12 | 13 | USER CURRENT-ARG 1 CELLS USER-ALLOC 14 | 15 | : RESET-ARGS (S -- ) 16 | 0 CURRENT-ARG ! 17 | ; 18 | 19 | : NEXT-ARG (S -- c-addr count true | false ) \ retrieve next argument as counted string 20 | CURRENT-ARG @ ARGV? 21 | ; 22 | 23 | : SHIFT-ARG (S -- ) \ go to next argument 24 | 1 CURRENT-ARG +! 25 | ; 26 | 27 | REPORT-NEW-NAME ! 28 | -------------------------------------------------------------------------------- /sysdict/case.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: CASE definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | \ ----------------------------------------------------------------------------- 8 | \ CASE 9 | \ ----------------------------------------------------------------------------- 10 | 11 | VARIABLE OF-PAIRS 12 | VARIABLE ENDCASE-PAIRS 13 | 14 | : CASE 15 | 0 16 | ; IMMEDIATE/COMPILE-ONLY 17 | 18 | : (ENDCASE) 19 | DROP 20 | ; 21 | 22 | : ENDCASE 23 | POSTPONE (ENDCASE) 24 | BEGIN 25 | ?DUP 26 | WHILE 27 | ENDCASE-PAIRS ?PAIRS >RESOLVE 28 | REPEAT 29 | ; IMMEDIATE/COMPILE-ONLY 30 | 31 | : (ENDOF) 32 | R> @ >R 33 | ; 34 | 35 | : ENDOF 36 | OF-PAIRS ?PAIRS POSTPONE (ENDOF) >MARK SWAP >RESOLVE ENDCASE-PAIRS 37 | ; IMMEDIATE/COMPILE-ONLY 38 | 39 | : (OF) 40 | OVER = IF DROP R> CELL+ ELSE R> @ THEN >R 41 | ; 42 | 43 | : OF 44 | POSTPONE (OF) >MARK OF-PAIRS 45 | ; IMMEDIATE/COMPILE-ONLY 46 | 47 | : ( IF DROP R> CELL+ ELSE R> @ THEN >R 49 | ; 50 | 51 | : MARK OF-PAIRS 53 | ; IMMEDIATE/COMPILE-ONLY 54 | 55 | : (>OF) 56 | OVER < IF DROP R> CELL+ ELSE R> @ THEN >R 57 | ; 58 | 59 | : >OF 60 | POSTPONE (>OF) >MARK OF-PAIRS 61 | ; IMMEDIATE/COMPILE-ONLY 62 | 63 | : ( CELL+ ELSE R> @ THEN >R 65 | ; 66 | 67 | : MARK OF-PAIRS 69 | ; IMMEDIATE/COMPILE-ONLY 70 | 71 | REPORT-NEW-NAME ! 72 | -------------------------------------------------------------------------------- /sysdict/core-tools.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: CORE-TOOLS definitions - Debugging helpers 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | FALSE REPORT-NEW-NAME ! 6 | 7 | DECIMAL 8 | 9 | USER .S-PRINT-XT 1 CELLS USER-ALLOC 10 | 11 | : .PN.S (S n -- ) 12 | 14 .S-PRINT-XT @ EXECUTE 13 | ; 14 | 15 | : PN.S (S print-xt depth -- ) 16 | SWAP .S-PRINT-XT ! 17 | DEPTH 1- MIN 18 | DUP >R 19 | 0 ?DO 20 | DEPTH I - 1- PICK .PN.S 21 | \ 3 I OVER AND = IF CR THEN 22 | LOOP 23 | ." <- TOS" 24 | R> .PN.S ." cell" DUP 1 <> IF ." s" THEN 25 | ; 26 | 27 | : N.S (S print-xt -- ) 28 | DEPTH 1- PN.S 29 | ; 30 | 31 | : H.S.R (S n u -- ) 32 | 8 - SPACES H.8 33 | ; 34 | 35 | : H.S ['] H.S.R N.S ; 36 | 37 | : #HEX-DIGIT (S d -- char d' ) 38 | (G Extract least significant hex digit char from d 39 | and return remaining number as d' ) 40 | 16 0 UD/ 2SWAP DROP DIGITS + C@ -ROT 41 | ; 42 | 43 | REPORT-NEW-NAME ! 44 | -------------------------------------------------------------------------------- /sysdict/exception-ext.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: EXCEPTION-EXT definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | : (TRY) (S handler-addr -- ) 8 | R> SWAP >R (EXC-PUSH) >R 9 | ; 10 | 11 | : ()CATCH) 12 | R> (EXC-POP-CATCH) R> DROP >R 0 13 | ; 14 | 15 | VARIABLE CATCH(-PAIRS 16 | 17 | : CATCH( 18 | POSTPONE LIT >MARK 19 | POSTPONE (TRY) 20 | CATCH(-PAIRS 21 | ; IMMEDIATE/COMPILE-ONLY 22 | 23 | : )CATCH (S -- exc-id ) 24 | CATCH(-PAIRS ?PAIRS 25 | POSTPONE ()CATCH) 26 | >RESOLVE 27 | ; IMMEDIATE/COMPILE-ONLY 28 | 29 | REPORT-NEW-NAME ! 30 | -------------------------------------------------------------------------------- /sysdict/format.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: FORMAT definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | USER HLD 1 CELLS USER-ALLOC 8 | 9 | HLD-SIZE USER-ALLOC USER HLD0 10 | 11 | : <# HLD0 HLD ! ; 12 | 13 | : HOLD (S char -- ) 14 | HLD -1 OVER +! @ 15 | HLD0 OVER - HLD-SIZE >= IF EXC-HLD-OVERFLOW THROW THEN 16 | C! 17 | ; 18 | 19 | : # BASE @ 0 UD/ 2SWAP DROP DIGITS + C@ HOLD ; 20 | 21 | : #> 2DROP HLD @ HLD0 OVER - ; 22 | 23 | : SIGN 0< IF [CHAR] - HOLD THEN ; 24 | 25 | : #S BEGIN # 2DUP D0= UNTIL ; 26 | 27 | : (D.) 28 | 2DUP DABS <# #S ROT SIGN #> TYPE DROP 29 | ; 30 | 31 | : (D.R) 32 | \ 1- 33 | OVER 2SWAP DABS <# #S ROT SIGN #> 34 | ROT OVER - DUP 0> IF SPACES ELSE DROP THEN TYPE 35 | ; 36 | 37 | : D. 38 | (D.) [CHAR] . EMIT SPACE 39 | ; 40 | 41 | : D.R 42 | (D.R) [CHAR] . EMIT 43 | ; 44 | 45 | : (UD.) 46 | <# #S #> TYPE 47 | ; 48 | 49 | : (UD.R) 50 | >R <# #S #> R> OVER - DUP 0> IF SPACES ELSE DROP THEN 51 | TYPE 52 | ; 53 | 54 | : UD. 55 | (UD.) [CHAR] . EMIT SPACE 56 | ; 57 | 58 | : UD.R 59 | (UD.R) [CHAR] . EMIT 60 | ; 61 | 62 | : . S>D (D.) SPACE ; 63 | 64 | : .R SWAP S>D ROT (D.R) ; 65 | 66 | : U. 0 (UD.) SPACE ; 67 | 68 | : U.R SWAP 0 ROT (UD.R) ; 69 | 70 | : H. BASE @ HEX SWAP U. BASE ! ; 71 | 72 | : H.R BASE @ HEX ROT ROT U.R BASE ! ; 73 | 74 | : H.N BASE @ >R HEX 0 TUCK <# ?DO # LOOP #> TYPE ( SPACE ) R> BASE ! ; 75 | 76 | \ 6.2.1675 HOLDS 77 | : HOLDS (S addr u -- ) 78 | BEGIN DUP WHILE 1- 2DUP CHARS + C@ HOLD REPEAT 2DROP 79 | ; 80 | 81 | REPORT-NEW-NAME ! 82 | -------------------------------------------------------------------------------- /sysdict/hostenv.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: HOSTENV definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | USER XT?-ENVP-XT 1 CELLS USER-ALLOC 8 | 9 | : XT?-ENVP (S x*i xt -- x*j ) 10 | \ execute xt for each entry in ENVP 11 | \ xt stack effect: S: x*i -- x*j flag 12 | \ return flag FALSE to stop enumeration 13 | XT?-ENVP-XT ! 14 | ENVP >R 15 | BEGIN 16 | R@ @ DUP 17 | IF 18 | ZCOUNT 19 | XT?-ENVP-XT @ EXECUTE 20 | THEN 21 | WHILE 22 | R> CELL+ >R 23 | REPEAT 24 | R> DROP 25 | ; 26 | 27 | : .S-HOSTENV (S c-addr count -- true ) 28 | TYPE CR 29 | TRUE 30 | ; 31 | 32 | : .HOSTENV 33 | (G Print host environment variables ) 34 | ['] .S-HOSTENV XT?-ENVP 35 | ; 36 | 37 | : ENVP?=VALUE? 38 | KEY=VALUE? INVERT 39 | ; 40 | 41 | : ENVP? (S c-addr1 count1 -- c-addr2 count2 true | false ) 42 | (G seach host environment variable and return value as counted string ) 43 | ['] ENVP?=VALUE? XT?-ENVP 44 | 2DROP 45 | KEY-VALUE?-RESULT 2@ 46 | OVER 47 | \ S: c-addr count c-addr 48 | IF TRUE ELSE 2DROP FALSE THEN 49 | ; 50 | 51 | REPORT-NEW-NAME ! 52 | -------------------------------------------------------------------------------- /sysdict/int-slash-comp-colon.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: INT/COMP: definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ ----------------------------------------------------------------------------- 5 | \ IS-INT/COMP? INT/COMP>INT INT/COMP>COMP INT/COMP: 6 | \ ----------------------------------------------------------------------------- 7 | 8 | : IS-INT/COMP? 9 | \ S: xt -- flag 10 | CFA@ (DO-INT/COMP) = 11 | ; 12 | 13 | : INT/COMP>INT 14 | \ S: xt -- xt-int 15 | \ Return xt of interpretation semantics of INT/COMP: word 16 | >BODY @ 17 | ; 18 | 19 | : INT/COMP>COMP 20 | \ S: xt -- xt-comp 21 | \ Return xt of compilation semantics of INT/COMP: word 22 | >BODY CELL+ @ 23 | ; 24 | 25 | : INT/COMP: 26 | \ S: xt-int xt-comp "name" -- 27 | \ Skip leading space delimiters. Parse name delimited by a space. Create a definition for name with the execution semantics defined below. 28 | \ name Execution 29 | \ S: i*x -- j*y 30 | \ Execute xt-int if in interpretation state. 31 | \ Execute xt-comp if in compilation state. name is an immediate word. 32 | (DO-INT/COMP) &IMMEDIATE PARSE-CHECK-HEADER, DROP SWAP , , 33 | ; 34 | -------------------------------------------------------------------------------- /sysdict/locals-ext.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: LOCALS-EXT definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/locals.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | \ LOCAL (S x "name -- ) 10 | \ Parse name and create a local initialized with x. 11 | : LOCAL 12 | PARSE-NAME (LOCAL) 13 | ; IMMEDIATE/COMPILE-ONLY 14 | 15 | REPORT-NEW-NAME ! 16 | -------------------------------------------------------------------------------- /sysdict/locate.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: LOCATE definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRE-NAME INCLUDED-WORDLIST sysdict/required.4th 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | ONLY FORTH DEFINITIONS 10 | 11 | VOCABULARY LOCATE-PRIVATE 12 | 13 | ALSO LOCATE-PRIVATE DEFINITIONS 14 | 15 | \ private definitions go here 16 | 17 | : LOCATE@ \ S: locate-addr -- include-mark position line-number 18 | @+ SWAP \ S: include-mark locate-addr2 19 | @+ SWAP \ S: include-mark position locate-addr3 20 | @ \ S: include-mark position line-number 21 | ; 22 | 23 | ONLY FORTH DEFINITIONS ALSO LOCATE-PRIVATE 24 | 25 | \ public definitions go here 26 | \ private definitions are available for use 27 | 28 | \ ----------------------------------------------------------------------------- 29 | \ LOCATE 30 | \ ----------------------------------------------------------------------------- 31 | 32 | : LOCATE \ S: "name" -- 33 | \ Parse name and print the information on the source location 34 | ' CODE>NAME NAME>LOCATE DUP 0= 35 | IF ." No LOCATE information available" 2DROP EXIT THEN 36 | LOCATE@ 4 .R 4 .R 3 SPACES 37 | ?DUP IF @ CODE>NAME NAME>STRING ELSE S" " THEN 38 | TYPE 39 | ; 40 | 41 | ONLY FORTH DEFINITIONS 42 | 43 | REPORT-NEW-NAME ! 44 | -------------------------------------------------------------------------------- /sysdict/loop.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: LOOP definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/macro.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | MACRO #DO " 0 ?DO" COMPILE-ONLY 10 | 11 | : +DO POSTPONE OVER POSTPONE MIN POSTPONE ?DO ; IMMEDIATE/COMPILE-ONLY 12 | 13 | : UMIN 2DUP U> IF SWAP THEN DROP ; 14 | 15 | : U+DO POSTPONE OVER POSTPONE UMIN POSTPONE ?DO ; IMMEDIATE/COMPILE-ONLY 16 | 17 | : -LOOP POSTPONE NEGATE POSTPONE +LOOP 18 | POSTPONE ELSE POSTPONE 2DROP 19 | POSTPONE THEN ; IMMEDIATE/COMPILE-ONLY 20 | 21 | : -DO POSTPONE 2DUP POSTPONE < POSTPONE IF 22 | POSTPONE SWAP POSTPONE 1+ POSTPONE SWAP POSTPONE DO ; IMMEDIATE/COMPILE-ONLY 23 | 24 | : U-DO POSTPONE 2DUP POSTPONE U< POSTPONE IF 25 | POSTPONE SWAP POSTPONE 1+ POSTPONE SWAP POSTPONE DO ; IMMEDIATE/COMPILE-ONLY 26 | 27 | REPORT-NEW-NAME ! 28 | -------------------------------------------------------------------------------- /sysdict/macro.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: MACRO definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | : MACRO (S "name ccc" -- ) 8 | : CHAR PARSE POSTPONE SLITERAL POSTPONE EVALUATE POSTPONE ; IMMEDIATE 9 | ; 10 | 11 | REPORT-NEW-NAME ! 12 | -------------------------------------------------------------------------------- /sysdict/marker.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: MARKER definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | : MARKER 8 | CREATE DOES> DROP 9 | ; 10 | 11 | REPORT-NEW-NAME ! 12 | -------------------------------------------------------------------------------- /sysdict/platform.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: PLATFORM definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | : PLATFORM? (S -- c-addr count ) \ return string identifying platform 8 | S" PLATFORM" ENVIRONMENT? INVERT IF S" unknown" THEN 9 | ; 10 | 11 | REPORT-NEW-NAME ! 12 | -------------------------------------------------------------------------------- /sysdict/quotations.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: QUOTATIONS definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | ONLY FORTH DEFINITIONS 8 | 9 | VOCABULARY QUOTATIONS-PRIVATE 10 | 11 | DEFER SAVE-DEFINITION-STATE 12 | 13 | DEFER RESTORE-DEFINITION-STATE 14 | 15 | ALSO QUOTATIONS-PRIVATE DEFINITIONS 16 | 17 | \ private definitions go here 18 | 19 | :NONAME 20 | USE-LOCATE @ 21 | RECURSE-XT @ 22 | LATEST-NAME@ 23 | ; IS SAVE-DEFINITION-STATE 24 | 25 | :NONAME 26 | LATEST-NAME! 27 | RECURSE-XT ! 28 | USE-LOCATE ! 29 | ; IS RESTORE-DEFINITION-STATE 30 | 31 | ONLY FORTH DEFINITIONS ALSO QUOTATIONS-PRIVATE 32 | 33 | \ public definitions go here 34 | \ private definitions are available for use 35 | 36 | : ([:) 37 | ; 38 | 39 | : (;]) 40 | ; 41 | 42 | : [: 43 | \ C: -- quotation-sys \ compile time 44 | POSTPONE AHEAD POSTPONE ([:) SAVE-DEFINITION-STATE 45 | FALSE USE-LOCATE ! :NONAME 46 | ; IMMEDIATE/COMPILE-ONLY 47 | 48 | : ;] 49 | \ C: quotation-sys -- \ compile time 50 | \ S: -- xt \ run time 51 | POSTPONE EXIT POSTPONE (;]) >R RESTORE-DEFINITION-STATE 52 | POSTPONE THEN R> POSTPONE LITERAL 53 | ; IMMEDIATE/COMPILE-ONLY 54 | 55 | ONLY FORTH DEFINITIONS 56 | 57 | REPORT-NEW-NAME ! 58 | -------------------------------------------------------------------------------- /sysdict/recognizer.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: RECOGNIZER definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil - with contributions from http://amforth.sourceforge.net/pr/Recognizer-rfc-C.html 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | \ Patch FORTH-RECOGNIZER with VALUE VT 8 | VALUE-VT ' FORTH-RECOGNIZER >BODY ! 9 | 10 | : RECOGNIZER ( size -- stack-id ) 11 | 1+ ( size ) CELLS HERE SWAP ALLOT 12 | 0 OVER ! \ empty stack 13 | ; 14 | 15 | : SET-RECOGNIZERS ( rec-n .. rec-1 n stack-id -- ) 16 | 2DUP ! >R 17 | BEGIN 18 | DUP 19 | WHILE 20 | DUP CELLS R@ + 21 | ROT SWAP ! 1- 22 | REPEAT R> 2DROP 23 | ; 24 | 25 | : GET-RECOGNIZERS ( stack-id -- rec-n .. rec-1 n ) 26 | DUP @ DUP >R SWAP 27 | BEGIN 28 | CELL+ OVER 29 | WHILE 30 | DUP @ ROT 1- ROT 31 | REPEAT 2DROP 32 | R> 33 | ; 34 | 35 | \ create a simple 3 element structure 36 | : RECOGNIZER: ( XT-INTERPRET XT-COMPILE XT-POSTPONE "name" -- ) 37 | CREATE SWAP ROT , , , 38 | ; 39 | 40 | : .RECOGNIZER-NAME (S rec-xt -- ) 41 | DUP ." H# " H.8 SPACE CODE>NAME NAME>STRING 42 | DUP 0= IF 2DROP S" (nonamed)" THEN 43 | TYPE 44 | ; 45 | 46 | : .RECOGNIZERS (S stack-id -- ) 47 | (G Print names of recognizers configured in stack-id ) 48 | GET-RECOGNIZERS 0 ?DO 49 | .RECOGNIZER-NAME CR 50 | LOOP 51 | ; 52 | 53 | : .FORTH-RECOGNIZERS 54 | (G Print names of recognizers configured in FORTH-RECOGNIZER ) 55 | FORTH-RECOGNIZER .RECOGNIZERS 56 | ; 57 | 58 | REPORT-NEW-NAME ! 59 | -------------------------------------------------------------------------------- /sysdict/source.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: SOURCE definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | \ String address for EVALUATE 8 | USER EVAL 1 CELLS USER-ALLOC 9 | \ String length for EVALUATE 10 | USER #EVAL 1 CELLS USER-ALLOC 11 | 12 | \ 6.1.2216 SOURCE 13 | \ c-addr is the address of, and u is the number of characters in 14 | \ the input buffer. 15 | \ D: -- c-addr u 16 | :NONAME 17 | SOURCE-ID 0< 18 | IF EVAL @ #EVAL @ EXIT THEN 19 | SOURCE-ID 0> 20 | IF FILE-LINE #FILE-LINE @ EXIT THEN 21 | DEFERRED SOURCE 22 | ; IS SOURCE 23 | 24 | \ 6.2.2125 REFILL 25 | \ D: -- flag 26 | :NONAME 27 | SOURCE-ID 0< 28 | IF FALSE EXIT THEN 29 | SOURCE-ID 0> 30 | IF REFILL-FILE EXIT THEN 31 | DEFERRED REFILL 32 | ; IS REFILL 33 | 34 | (G EVALUATE 35 | Save the current input source specification. 36 | Store minus-one [-1] in SOURCE-ID if it is present. 37 | Make the string described by c-addr and u both the input source 38 | and input buffer, set >IN to zero, and interpret. 39 | When the parse area is empty, restore the prior input source specification. 40 | Other stack effects are due to the words EVALUATEd. ) 41 | : EVALUATE (S i*x c-addr u -- j*x ) 42 | INPUT>R RESET-INPUT -1 SOURCE-ID! 43 | #EVAL ! EVAL ! ['] INTERPRET CATCH 44 | R>INPUT THROW 45 | ; 46 | 47 | :NONAME 48 | 0 DUP 49 | #EVAL ! EVAL ! 50 | DEFERRED (RESET-INPUT) 51 | ; IS (RESET-INPUT) 52 | 53 | : RESTORE-INPUT-EVALUATE 54 | >R #EVAL ! EVAL ! R> 3 - SWAP EXECUTE 55 | ; 56 | 57 | : SAVE-INPUT-EVALUATE 58 | DEFERRED (SAVE-INPUT) 59 | >R EVAL @ #EVAL @ ['] RESTORE-INPUT-EVALUATE R> 3 + 60 | ; 61 | 62 | ' SAVE-INPUT-EVALUATE IS (SAVE-INPUT) 63 | 64 | : QUERY 65 | REFILL DROP 66 | ; 67 | 68 | REPORT-NEW-NAME ! 69 | -------------------------------------------------------------------------------- /sysdict/trace.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: TRACE definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | 8 | DEFER TRACE (S xt -- ) 9 | 10 | : TRACE-OFF (G Turn off tracing ) 11 | ['] DROP IS TRACE 12 | ; 13 | 14 | TRACE-OFF 15 | 16 | : .TRACE-WORD-NAME 17 | \ S: xt -- 18 | \ Print the name of the word or (noname) 19 | CODE>NAME NAME>STRING 20 | ?DUP IF TYPE ELSE DROP ." (noname)" THEN 21 | ; 22 | 23 | : .TRACE-WORD (S xt -- ) 24 | ." [" .TRACE-WORD-NAME ." ]" 25 | ; 26 | 27 | : TRACE-WORD (G Turn on word tracing - print name of every word executed ) 28 | ['] .TRACE-WORD IS TRACE 29 | ; 30 | 31 | : .TRACE-STACK (S xt -- ) 32 | ." [" .TRACE-WORD-NAME SPACE H.S ." ]" CR 33 | ; 34 | 35 | : TRACE-STACK (G Turn on stack tracing - print name of every word executed and contents of the stack ) 36 | ['] .TRACE-STACK IS TRACE 37 | ; 38 | 39 | : (NOTRACE-:) : ; 40 | 41 | : TRACE-: : RECURSE-XT @ POSTPONE LITERAL POSTPONE TRACE ; 42 | 43 | DEFER : 44 | ' (NOTRACE-:) IS : 45 | 46 | : TRACE-BEGIN ['] TRACE-: IS : ; 47 | 48 | : TRACE-END ['] (NOTRACE-:) IS : ; 49 | 50 | REPORT-NEW-NAME ! 51 | -------------------------------------------------------------------------------- /sysdict/value.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: VALUE definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | \ Layout of PFA for VALUE-like words 8 | \ +0 vt-addr address of table of methods 9 | \ +4 data 10 | \ 11 | \ table of methods layout 12 | \ +0 store-xt STATE-sensitive word to perform/compile store operation (!, 2!) 13 | \ +4 plus-store-xt STATE-sensitive word to perform/compile plus-store operation (+!, 2+!) 14 | 15 | : VALUE>DATA (S body-addr -- data-addr ) 16 | CELL+ 17 | ; 18 | 19 | : VALUE-METHOD-DOES 20 | DOES> (S value-xt value-method-body -- ) \ runtime semantics 21 | @ 22 | SWAP >BODY VALUE>DATA 23 | STATE @ 24 | IF 25 | POSTPONE LITERAL 26 | COMPILE, 27 | ELSE 28 | SWAP EXECUTE 29 | THEN 30 | ; 31 | 32 | : VALUE-METHOD 33 | CREATE ' , VALUE-METHOD-DOES 34 | ; 35 | 36 | VALUE-METHOD VALUE! ! 37 | VALUE-METHOD VALUE+! +! 38 | 39 | CREATE VALUE-VT 40 | ' VALUE! , ' VALUE+! , 41 | 42 | : VALUE>VT (S xt -- int-vt-addr ) 43 | >BODY @ 44 | ; 45 | 46 | : VALUE!VT@ (S vt-addr -- store-xt ) 47 | @ 48 | ; 49 | 50 | : VALUE+!VT@ (S vt-addr -- plus-store-xt ) 51 | CELL+ @ 52 | ; 53 | 54 | \ ----------------------------------------------------------------------------- 55 | \ VALUE TO +TO 56 | \ ----------------------------------------------------------------------------- 57 | 58 | : VALUE 59 | CREATE 60 | VALUE-VT , 61 | , 62 | DOES> VALUE>DATA @ 63 | ; 64 | 65 | : TO 66 | ' DUP VALUE>VT VALUE!VT@ EXECUTE 67 | ; IMMEDIATE 68 | 69 | : +TO 70 | ' DUP VALUE>VT VALUE+!VT@ EXECUTE 71 | ; IMMEDIATE 72 | 73 | REPORT-NEW-NAME ! 74 | -------------------------------------------------------------------------------- /sysdict/word.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: WORD definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | \ 6.1.2450 WORD 5 | \ ( char "ccc" -- c-addr ) 6 | \ Skip leading delimiters. Parse characters ccc delimited by char. 7 | \ An ambiguous condition exists if the length of the parsed string is greater than the implementation-defined length of a counted string. 8 | \ 9 | \ c-addr is the address of a transient region containing the parsed word as a counted string. 10 | \ If the parse area was empty or contained no characters other than the delimiter, 11 | \ the resulting string has a zero length. A program may replace characters within the string. 12 | : WORD ( char "ccc" -- c-addr ) 13 | SOURCE >IN @ /STRING 14 | OVER >R \ S: char c-addr u R: c-addr 15 | SKIP-BLANK \ S: char c-addr' u' R: c-addr 16 | OVER R> - >IN+ \ fix >IN over skipped spaces 17 | (PARSE) 18 | \DEBUG CR S" WORD-A:" TYPE 2DUP TYPE 19 | DUP CHAR+ >IN+ \ fix >IN over parsed characters and delimiter 20 | S">POCKET 21 | ; 22 | -------------------------------------------------------------------------------- /sysdict/x86-linux.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: Linux specific definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/dynlib.4th" 5 | REQUIRES" sysdict/x86-linux/linconst.4th" 6 | 7 | CR .( Probing for Linux host ) 8 | 9 | S" libc.so.6" (LoadLibrary) [IF] 10 | 11 | 16 | 17 | REQUIRES" sysdict/x86-linux/lindynlib.4th" 18 | REQUIRES" sysdict/x86-linux/libc.4th" 19 | REQUIRES" sysdict/x86-linux/libreadline.4th" 20 | REQUIRES" sysdict/x86-linux/linfile.4th" 21 | REQUIRES" sysdict/term/linconsole.4th" 22 | 23 | :NONAME 24 | S" ANSITERM-INIT" 25 | ; IS TERMINIT-DEFAULT 26 | 27 | [THEN] 28 | -------------------------------------------------------------------------------- /sysdict/x86-linux/libreadline.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: libreadline definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/dynlib.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | (S z-prompt -- z-addr ) 10 | \ readline will read a line from the terminal and return it, 11 | \ using prompt as a prompt. 12 | \ If prompt is NULL or the empty string, no prompt is issued. 13 | \ The line returned is allocated with malloc; the caller must free it when finished. 14 | \ The line returned has the final newline removed, so only the text of the line remains. 15 | DEFER libc-readline 16 | 17 | :NONAME 18 | CR ." FATAL: Can not initialize libreadline" CR 19 | 0 20 | ; IS libc-readline 21 | 22 | 0 VALUE LIBREADLINE.SO-ID 23 | 24 | 0 VALUE DS-libc-readline 25 | 26 | : (LIBREADLINE-FIND) (S -- library-id ) 27 | S" libreadline.so.8" (LoadLibrary) ?DUP ?EXIT 28 | S" libreadline.so.7" (LoadLibrary) ?DUP ?EXIT 29 | S" libreadline.so.6" (LoadLibrary) ?DUP ?EXIT 30 | 0 31 | ; 32 | 33 | : (LIBREADLINE-CALL-DS) (S z-prompt -- z-addr ) 34 | DS-libc-readline 35 | ?DUP 0= IF 36 | CR ." FATAL: Can not initialize libreadline" CR 37 | 0 38 | THEN 39 | 1 SWAP CALL-CDECL-C1 40 | ; 41 | 42 | : INIT-LIBREADLINE (S -- ) 43 | 0 TO LIBREADLINE.SO-ID 44 | 0 TO DS-libc-readline 45 | (LIBREADLINE-FIND) TO LIBREADLINE.SO-ID 46 | LIBREADLINE.SO-ID 0= IF EXIT THEN 47 | S" readline" LIBREADLINE.SO-ID (GetProcAddress) 48 | GetLastError THROW 49 | TO DS-libc-readline 50 | ['] (LIBREADLINE-CALL-DS) IS libc-readline 51 | ; 52 | 53 | ' INIT-LIBREADLINE DUP STARTUP-CHAIN CHAIN.ADD EXECUTE 54 | 55 | : DONE-LIBREADLINE 56 | LIBREADLINE.SO-ID 0= IF EXIT THEN 57 | LIBREADLINE.SO-ID FreeLibrary 58 | ; 59 | ' DONE-LIBREADLINE SHUTDOWN-CHAIN CHAIN.ADD 60 | 61 | 62 | REPORT-NEW-NAME ! 63 | -------------------------------------------------------------------------------- /sysdict/x86-linux/linconst.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: LINCONST definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/constdict.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | ONLY FORTH DEFINITIONS 10 | 11 | VOCABULARY LINCONST-PRIVATE 12 | 13 | ALSO LINCONST-PRIVATE DEFINITIONS 14 | 15 | \ private definitions go here 16 | 17 | ONLY FORTH DEFINITIONS ALSO LINCONST-PRIVATE 18 | 19 | \ public definitions go here 20 | \ private definitions are available for use 21 | 22 | BEGIN-CONST 23 | REQUIRES" lib/linconst.4th" 24 | END-CONST 25 | CONSTDICT-HASH LINCONST 26 | 27 | LINCONST SEARCH-CONSTDICT-HASH: LINCONST: 28 | 29 | ONLY FORTH DEFINITIONS 30 | 31 | REPORT-NEW-NAME ! 32 | -------------------------------------------------------------------------------- /sysdict/x86-linux/lindynlib.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: lindynlib definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/dynlib.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | :NONAME 10 | 0= IF 11 | CR ." Failed to load: " 12 | DYNLIB-PATH@ TYPE CR 13 | ELSE 14 | DROP 15 | THEN 16 | ; IS DYNLIB-INIT-CHECK 17 | 18 | REPORT-NEW-NAME ! 19 | -------------------------------------------------------------------------------- /sysdict/x86-windows.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: Win32 specific definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/dynlib.4th" 5 | REQUIRES" sysdict/x86-windows/winconst.4th" 6 | 7 | CR .( Probing for Win32 host ) 8 | 9 | S" kernel32.dll" (LoadLibrary) [IF] 10 | 11 | 16 | 17 | REQUIRES" sysdict/x86-windows/kernel32.4th" 18 | REQUIRES" sysdict/x86-windows/winerr.4th" 19 | REQUIRES" sysdict/x86-windows/winexception.4th" 20 | REQUIRES" sysdict/term/winconsole.4th" 21 | REQUIRES" sysdict/x86-windows/winfile.4th" 22 | REQUIRES" sysdict/x86-windows/winmisc.4th" 23 | 24 | :NONAME 25 | S" WINCONSOLE-INIT" 26 | ; IS TERMINIT-DEFAULT 27 | 28 | [THEN] 29 | -------------------------------------------------------------------------------- /sysdict/x86-windows/winconst.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: WINCONST definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/constdict.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | ONLY FORTH DEFINITIONS 10 | 11 | VOCABULARY WINCONST-PRIVATE 12 | 13 | ALSO WINCONST-PRIVATE DEFINITIONS 14 | 15 | \ private definitions go here 16 | 17 | ONLY FORTH DEFINITIONS ALSO WINCONST-PRIVATE 18 | 19 | \ public definitions go here 20 | \ private definitions are available for use 21 | 22 | BEGIN-CONST 23 | REQUIRES" lib/winconst.4th" 24 | END-CONST 25 | CONSTDICT-HASH WINCONST 26 | 27 | WINCONST SEARCH-CONSTDICT-HASH: WINCONST: 28 | 29 | ONLY FORTH DEFINITIONS 30 | 31 | REPORT-NEW-NAME ! 32 | -------------------------------------------------------------------------------- /sysdict/x86-windows/winerr.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: WINERR definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/x86-windows/winconst.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME OFF 8 | 9 | 10 | : WIN-ERR>IOR (S 0 -- ior | x -- 0 ) 11 | (G Check BOOL result and convert it to ior if failed ) 12 | 0= IF GetLastError ELSE 0 THEN 13 | ; 14 | 15 | : HANDLE-ERR>IOR (S INVALID_HANDLE_VALUE -- ior | x -- 0 ) 16 | (G Check HANDLE result and convert it to ior if failed ) 17 | WINCONST: INVALID_HANDLE_VALUE = IF GetLastError ELSE 0 THEN 18 | ; 19 | 20 | 21 | REPORT-NEW-NAME ! 22 | -------------------------------------------------------------------------------- /sysdict/x86-windows/winmisc.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: WINMISC definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | USER TIME&DATE-STRUC 16 USER-ALLOC 8 | 9 | :NONAME (S -- +n1 +n2 +n3 +n4 +n5 +n6 ) 10 | TIME&DATE-STRUC 11 | DUP GetLocalTime 12 | DUP 6 WORDS+ W@ SWAP 13 | DUP 5 WORDS+ W@ SWAP 14 | DUP 4 WORDS+ W@ SWAP 15 | DUP 3 WORDS+ W@ SWAP 16 | DUP 1 WORDS+ W@ SWAP 17 | DUP 0 WORDS+ W@ SWAP 18 | DROP 19 | ; IS TIME&DATE 20 | 21 | REPORT-NEW-NAME ! 22 | -------------------------------------------------------------------------------- /sysdict/x86/486asm.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: 486ASM definitions - needed to load Jim Schneider's 486asm.f under IKForth 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | ONLY FORTH DEFINITIONS ALSO ASSEMBLER DEFINITIONS 8 | 9 | : NOOP ; 10 | 11 | VARIABLE CSP 12 | 13 | : !CSP ( -- ) \ save current stack pointer for later stack depth check 14 | SP@ CSP ! ; 15 | 16 | : ?CSP ( -- ) \ check current stack pointer against saved stack pointer 17 | SP@ CSP @ XOR ABORT" stack changed" ; 18 | 19 | : COMPILE R> DUP @ SWAP CELL+ >R COMPILE, ; 20 | 21 | DEFER ENTER-ASSEMBLER ' NOOP IS ENTER-ASSEMBLER 22 | DEFER EXIT-ASSEMBLER ' NOOP IS EXIT-ASSEMBLER 23 | 24 | : DEFER@ 25 | ' STATE @ IF POSTPONE LITERAL POSTPONE DEFER@ ELSE DEFER@ THEN 26 | ; IMMEDIATE 27 | 28 | REQUIRES" lib/~js/486asm/486ASM.F" 29 | 30 | ALSO ASSEMBLER ALSO ASM-HIDDEN DEFINITIONS 31 | 32 | :NONAME ( start a native code definition ) 33 | code-header 0 (CFA,) DROP hide !csp init-asm 34 | ; IS CODE 35 | 36 | HOST-ITC? [IF] 37 | 38 | MACRO: JMP-NEXT 39 | MOV EBX , [EAX] 40 | JMP EBX 41 | ENDM 42 | 43 | [THEN] 44 | 45 | HOST-DTC? [IF] 46 | 47 | MACRO: JMP-NEXT 48 | MOV EBX , EAX 49 | JMP EBX 50 | ENDM 51 | 52 | [THEN] 53 | 54 | \ Last word in CODE definitions 55 | MACRO: NEXT 56 | LODSD 57 | JMP-NEXT 58 | ENDM 59 | 60 | ONLY FORTH DEFINITIONS 61 | 62 | REPORT-NEW-NAME ! 63 | -------------------------------------------------------------------------------- /sysdict/x86/create.4th: -------------------------------------------------------------------------------- 1 | BASE @ 2 | 16 BASE ! 3 | 4 | BASE ! 5 | -------------------------------------------------------------------------------- /sysdict/x86/exit.4th: -------------------------------------------------------------------------------- 1 | BASE @ 2 | 16 BASE ! 3 | 4 | \ 6.1.1380 EXIT 5 | CODE EXIT 6 | 8B B, 75 B, 00 B, \ MOV ESI,[DWORD PTR EBP] 7 | 83 B, C5 B, 1 CELLS B, \ ADD EBP,CELL_SIZE 8 | $NEXT 9 | END-CODE COMPILE-ONLY 10 | 11 | BASE ! 12 | -------------------------------------------------------------------------------- /sysdict/x86/i-tick.4th: -------------------------------------------------------------------------------- 1 | BASE @ 2 | 16 BASE ! 3 | 4 | \ I' 5 | \ Interpretation: Interpretation semantics for this word are undefined. 6 | \ Execution: ( -- n|u ) ( R: loop-sys -- loop-sys ) 7 | \ n|u is a copy of the current (innermost) loop limit. 8 | \ An ambiguous condition exists if the loop control parameters are unavailable. 9 | CODE I' 10 | 8B B, 45 B, 1 CELLS B, \ MOV EAX,[DWORD PTR EBP + 1 * CELL_SIZE] 11 | 50 B, \ PUSH EAX 12 | $NEXT 13 | END-CODE COMPILE-ONLY 14 | 15 | BASE ! 16 | -------------------------------------------------------------------------------- /sysdict/x86/i.4th: -------------------------------------------------------------------------------- 1 | BASE @ 2 | 16 BASE ! 3 | 4 | \ 6.1.1680 I 5 | \ Interpretation: Interpretation semantics for this word are undefined. 6 | \ Execution: ( -- n|u ) ( R: loop-sys -- loop-sys ) 7 | \ n|u is a copy of the current (innermost) loop index. 8 | \ An ambiguous condition exists if the loop control parameters are unavailable. 9 | CODE I 10 | 8B B, 45 B, 00 B, \ MOV EAX,[DWORD PTR EBP] 11 | 50 B, \ PUSH EAX 12 | $NEXT 13 | END-CODE COMPILE-ONLY 14 | 15 | BASE ! 16 | -------------------------------------------------------------------------------- /sysdict/x86/j.4th: -------------------------------------------------------------------------------- 1 | BASE @ 2 | 16 BASE ! 3 | 4 | \ 6.1.1730 J 5 | \ Interpretation: Interpretation semantics for this word are undefined. 6 | \ Execution: ( -- n|u ) ( R: loop-sys1 loop-sys2 -- loop-sys1 loop-sys2 ) 7 | \ n|u is a copy of the next-outer loop index. 8 | \ An ambiguous condition exists if the loop control parameters of the next-outer loop, loop-sys1, are unavailable. 9 | CODE J 10 | 8B B, 45 B, 3 CELLS B, \ MOV EAX,[DWORD PTR EBP + 3 * CELL_SIZE] 11 | 50 B, \ PUSH EAX 12 | $NEXT 13 | END-CODE COMPILE-ONLY 14 | 15 | BASE ! 16 | -------------------------------------------------------------------------------- /sysdict/x86/leave.4th: -------------------------------------------------------------------------------- 1 | BASE @ 2 | 16 BASE ! 3 | 4 | \ 6.1.1760 LEAVE 5 | \ Interpretation: Interpretation semantics for this word are undefined. 6 | \ Execution: ( -- ) ( R: loop-sys -- ) 7 | \ Discard the current loop control parameters. An ambiguous condition exists if they are unavailable. 8 | \ Continue execution immediately following the innermost syntactically enclosing DO ... LOOP or DO ... +LOOP. 9 | CODE LEAVE 10 | 83 B, C5 B, 2 CELLS B, \ ADD EBP,CELL_SIZE*2 11 | 8B B, 75 B, 00 B, \ MOV ESI,[DWORD PTR EBP] 12 | 83 B, C5 B, 1 CELLS B, \ ADD EBP,CELL_SIZE 13 | $NEXT 14 | END-CODE COMPILE-ONLY 15 | 16 | BASE ! 17 | -------------------------------------------------------------------------------- /sysdict/x86/paren-do-paren.4th: -------------------------------------------------------------------------------- 1 | BASE @ 2 | 16 BASE ! 3 | 4 | \ (DO) 5 | \ Run-time: ( n1|u1 n2|u2 -- ) ( R: -- loop-sys ) 6 | \ Set up loop control parameters with index n2|u2 and limit n1|u1. 7 | \ An ambiguous condition exists if n1|u1 and n2|u2 are not both the same type. 8 | \ Anything already on the return stack becomes unavailable until the loop-control parameters are discarded. 9 | \ loop-sys: leave-addr limit index 10 | CODE (DO) 11 | AD B, \ LODSD 12 | 83 B, ED B, 1 CELLS B, \ SUB EBP,CELL_SIZE 13 | 89 B, 45 B, 00 B, \ MOV [DWORD PTR EBP],EAX 14 | 58 B, \ POP EAX 15 | 5B B, \ POP EBX 16 | 83 B, ED B, 1 CELLS B, \ SUB EBP,CELL_SIZE 17 | 89 B, 5D B, 00 B, \ MOV [DWORD PTR EBP],EBX 18 | 83 B, ED B, 1 CELLS B, \ SUB EBP,CELL_SIZE 19 | 89 B, 45 B, 00 B, \ MOV [DWORD PTR EBP],EAX 20 | $NEXT 21 | END-CODE 22 | 23 | BASE ! 24 | -------------------------------------------------------------------------------- /sysdict/zchar.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: ZCHAR definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | : ZSTRLEN (S z-addr -- count ) 8 | DUP 9 | BEGIN 10 | DUP C@ 0<> 11 | WHILE 12 | CHAR+ 13 | REPEAT 14 | SWAP - 15 | ; 16 | 17 | : ZCOUNT (S z-addr -- z-addr count ) 18 | DUP ZSTRLEN 19 | ; 20 | 21 | : ZMOVE (S z-addr1 z-addr2 -- ) 22 | OVER ZSTRLEN CHAR+ CMOVE 23 | ; 24 | 25 | : ZPLACE (S c-addr u z-addr -- ) 26 | 2DUP + >R 27 | SWAP CMOVE 28 | 0 R> C! 29 | ; 30 | 31 | : Z+PLACE (S c-addr u z-addr -- ) 32 | ZCOUNT + ZPLACE 33 | ; 34 | 35 | : (Z") R> DUP ZCOUNT + CHAR+ ALIGNED >R ; 36 | 37 | \ compile zstring 38 | : ,Z" (S c-addr count -- ) 39 | HERE 40 | OVER CHAR+ ALLOT \ c-addr count here 41 | 2DUP + \ c-addr count here here+count 42 | >R 43 | SWAP CMOVE 44 | 0 R> C! 45 | ; 46 | 47 | \ compile zstring separated by " 48 | : Z" 49 | PARSE" 50 | POSTPONE (Z") ,Z" 51 | ; IMMEDIATE/COMPILE-ONLY 52 | 53 | : Z\" 54 | PARSE\" 55 | POSTPONE (Z") ,Z" 56 | ; IMMEDIATE/COMPILE-ONLY 57 | 58 | : S">Z" (S c-addr u -- z-addr ) 59 | \ z-addr FREE THROW 60 | DUP CHAR+ ALLOCATE THROW DUP >R SWAP 2DUP + >R CMOVE 0 R> C! R> 61 | ; 62 | 63 | : C">Z" (S c-addr -- z-addr ) 64 | \ z-addr FREE THROW 65 | COUNT S">Z" 66 | ; 67 | 68 | REPORT-NEW-NAME ! 69 | -------------------------------------------------------------------------------- /test/forth2012-test.4th: -------------------------------------------------------------------------------- 1 | \ ANS Forth tests - run all tests 2 | 3 | \ Adjust the file paths as appropriate to your system 4 | \ Select the appropriate test harness, either the simple tester.fr 5 | \ or the more complex ttester.fs 6 | 7 | CR .( Running ANS Forth and Forth 2012 test programs, version 0.13) CR 8 | 9 | : MARKER CREATE DOES> DROP ; 10 | 11 | DEFER TEST-ROOT (S -- c-addr count ) 12 | 13 | : DEFAULT-TEST-ROOT 14 | S" test/forth2012-test-suite/src/" 15 | ; 16 | 17 | ' DEFAULT-TEST-ROOT IS TEST-ROOT 18 | 19 | : TEST-BLOCK-ROOT 20 | S" build/forth2012-test-blocks/" 21 | ; 22 | 23 | ' TEST-BLOCK-ROOT IS BLOCK-ROOT 24 | 25 | : APPEND-TEST-ROOT (S c-addr1 u1 -- c-addr2 u2 ) 26 | TEST-ROOT >S"BUFFER \ S: f-addr f-u r-addr r-u 27 | 2SWAP 2OVER + SWAP \ S: r-addr r-u f-addr r-addr' f-u 28 | DUP >R MOVE R> + \ S: r-addr r-u' 29 | ; 30 | 31 | :NONAME 32 | APPEND-TEST-ROOT 33 | 2DUP CR ." INCLUDED-PATH: " TYPE CR 34 | ; IS INCLUDED-PATH 35 | 36 | REPORT-NEW-NAME OFF 37 | 38 | S" prelimtest.fth" INCLUDED 39 | \ S" tester.fr" INCLUDED 40 | S" ttester.fs" INCLUDED 41 | 42 | S" core.fr" INCLUDED 43 | S" coreplustest.fth" INCLUDED 44 | S" utilities.fth" INCLUDED 45 | S" errorreport.fth" INCLUDED 46 | S" coreexttest.fth" INCLUDED 47 | S" blocktest.fth" INCLUDED 48 | S" doubletest.fth" INCLUDED 49 | S" exceptiontest.fth" INCLUDED 50 | S" facilitytest.fth" INCLUDED 51 | S" filetest.fth" INCLUDED 52 | S" localstest.fth" INCLUDED 53 | S" memorytest.fth" INCLUDED 54 | S" toolstest.fth" INCLUDED 55 | S" searchordertest.fth" INCLUDED 56 | S" stringtest.fth" INCLUDED 57 | REPORT-ERRORS 58 | 59 | CR .( Forth tests completed ) CR CR 60 | 61 | .( Press any key to exit... ) KEY DROP 62 | 63 | BYE 64 | -------------------------------------------------------------------------------- /test/fp-test.4th: -------------------------------------------------------------------------------- 1 | \ Floating point tests - run all tests 2 | 3 | \ Adjust the file paths as appropriate to your system 4 | \ Select the appropriate test harness, either the simple tester.fr 5 | \ or the more complex ttester.fs 6 | 7 | cr .( Running FP Tests) cr 8 | 9 | requires" lib/~ik/float.4th" 10 | 11 | DEFER TEST-ROOT (S -- c-addr count ) 12 | 13 | : DEFAULT-TEST-ROOT 14 | S" test/forth2012-test-suite/src/fp/" 15 | ; 16 | 17 | ' DEFAULT-TEST-ROOT IS TEST-ROOT 18 | 19 | : APPEND-TEST-ROOT (S c-addr1 u1 -- c-addr2 u2 ) 20 | TEST-ROOT >S"BUFFER \ S: f-addr f-u r-addr r-u 21 | 2SWAP 2OVER + SWAP \ S: r-addr r-u f-addr r-addr' f-u 22 | DUP >R MOVE R> + \ S: r-addr r-u' 23 | ; 24 | 25 | :NONAME 26 | APPEND-TEST-ROOT 27 | 2DUP CR ." INCLUDED-PATH: " TYPE CR 28 | ; IS INCLUDED-PATH 29 | 30 | REPORT-NEW-NAME OFF 31 | 32 | s" [undefined]" pad c! pad char+ pad c@ move 33 | pad find nip 0= 34 | [if] 35 | : [undefined] ( "name" -- flag ) 36 | bl word find nip 0= 37 | ; immediate 38 | [then] 39 | 40 | s" ttester.fs" included 41 | s" ak-fp-test.fth" included 42 | 123 SET-PRECISION 43 | s" fatan2-test.fs" included 44 | s" ieee-arith-test.fs" included 45 | s" ieee-fprox-test.fs" included 46 | s" fpzero-test.4th" included 47 | \ s" fpio-test.4th" included 48 | s" to-float-test.4th" included 49 | 123 SET-PRECISION 50 | s" paranoia.4th" included 51 | 52 | cr cr 53 | .( FP tests finished) cr cr 54 | 55 | .( Press any key to exit... ) KEY DROP 56 | 57 | BYE 58 | -------------------------------------------------------------------------------- /test/hostenv-test.4th: -------------------------------------------------------------------------------- 1 | S" windirz" ENVP? CR H.S CR [IF] TYPE [ELSE] .( Not found ) [THEN] 2 | S" windir" ENVP? CR H.S CR [IF] TYPE [ELSE] .( Not found ) [THEN] 3 | -------------------------------------------------------------------------------- /test/locals-test.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: LOCALS-TEST definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REQUIRES" sysdict/locals.4th" 5 | 6 | REPORT-NEW-NAME @ 7 | REPORT-NEW-NAME ON 8 | 9 | ONLY FORTH DEFINITIONS 10 | 11 | ALSO LOCALS-HIDDEN 12 | 13 | CR 14 | H# ABCD >L 15 | LP@ 8 DUMP 16 | 17 | CR 18 | H# 1234 >L 19 | LP@ 8 DUMP 20 | 21 | CR 22 | L> H.8 CR 23 | L> H.8 CR 24 | LP@ 8 DUMP 25 | 26 | H# ABCD >L 27 | : TEST1 L0@ H# ABCD = IF ." OK" ELSE ." NOT OK" THEN CR ; 28 | 29 | .( TEST1 ) 30 | TEST1 31 | 32 | H# 1234 >L 33 | : TEST2 L0@ H# 1234 = IF ." OK" ELSE ." NOT OK" THEN CR ; 34 | 35 | .( TEST2 ) 36 | TEST2 37 | 38 | : TEST3 H# ABCD >L H# 1234 >L 39 | L0@ H# 1234 = IF ." OK" ELSE ." NOT OK" THEN CR 40 | L1@ H# ABCD = IF ." OK" ELSE ." NOT OK" THEN CR 41 | ; 42 | 43 | .( TEST3 ) 44 | TEST3 45 | 46 | LP0 LP! 47 | 48 | : TEST4 49 | 4 LOCALS-ALLOC 50 | LDEPTH DUP . 4 = IF ." OK" ELSE ." NOT OK" THEN CR 51 | LOCALS-DEALLOC 52 | ; 53 | 54 | .( TEST4 ) 55 | TEST4 56 | 57 | LDEPTH . CR 58 | 59 | : TEST5 60 | 4 LOCALS-ALLOC 61 | EXCP0 H.8 CR 62 | EXCP@ EXCP0 OVER - CELL+ DUMP 63 | -1 THROW 64 | ; 65 | 66 | .( TEST5 ) 67 | TEST4 68 | LP@ 8 DUMP CR 69 | ' TEST5 CATCH . CR 70 | LP@ 8 DUMP CR 71 | TEST4 72 | LP@ 8 DUMP CR 73 | 74 | .( TEST6 ) 75 | : TEST6-INNER 76 | EXCP@ EXCP0 OVER - DUMP 77 | 2 LOCALS-ALLOC 78 | LDEPTH . CR 79 | CATCH( 80 | 3 LOCALS-ALLOC 81 | EXCP@ EXCP0 OVER - DUMP 82 | -1 THROW 83 | LOCALS-DEALLOC 84 | )CATCH 85 | . CR 86 | LDEPTH . CR 87 | LOCALS-DEALLOC 88 | ; 89 | : TEST6 90 | 1 LOCALS-ALLOC 91 | LDEPTH . CR 92 | TEST6-INNER 93 | LDEPTH . CR 94 | LOCALS-DEALLOC 95 | ; 96 | .( Before TEST6 ) LDEPTH . CR 97 | TEST6 98 | .( After TEST6 ) LDEPTH . CR 99 | 100 | 101 | REPORT-NEW-NAME ! 102 | -------------------------------------------------------------------------------- /test/stdin-test.4th: -------------------------------------------------------------------------------- 1 | pad 64 stdin read-line 2 | throw 3 | pad 64 dump 4 | drop pad swap evaluate 5 | cr 6 | bye -------------------------------------------------------------------------------- /test/string-test.4th: -------------------------------------------------------------------------------- 1 | : TEST-STRING-PREFIX? 2 | S" windir" 3 | S" windir=123" 4 | STRING-PREFIX? 5 | IF ." OK " ELSE ." NOT OK " THEN CR 6 | 7 | S" windirz" 8 | S" windir=123" 9 | STRING-PREFIX? INVERT 10 | IF ." OK " ELSE ." NOT OK " THEN CR 11 | 12 | S" windirz" 13 | S" windirz=" DROP 3 14 | STRING-PREFIX? INVERT 15 | IF ." OK " ELSE ." NOT OK " THEN CR 16 | ; 17 | 18 | CR 19 | TEST-STRING-PREFIX? 20 | 21 | : TEST-KEY=VALUE? 22 | S" windir" 23 | S" windir=123" 24 | KEY=VALUE? 25 | IF ." OK " ELSE ." NOT OK " THEN TYPE CR 26 | 27 | S" windirz" 28 | S" windir=123" 29 | KEY=VALUE? INVERT 30 | IF ." OK " ELSE ." NOT OK " THEN TYPE CR 31 | 32 | S" windirz" 33 | S" windirz=" DROP 3 34 | KEY=VALUE? INVERT 35 | IF ." OK " ELSE ." NOT OK " THEN TYPE CR 36 | ; 37 | 38 | CR 39 | TEST-KEY=VALUE? 40 | 41 | -------------------------------------------------------------------------------- /test/winconst-test.4th: -------------------------------------------------------------------------------- 1 | PURPOSE: WINCONST-TEST definitions 2 | LICENSE: Unlicense since 1999 by Illya Kysil 3 | 4 | REPORT-NEW-NAME @ 5 | REPORT-NEW-NAME OFF 6 | 7 | ONLY FORTH DEFINITIONS 8 | 9 | VOCABULARY TEMPLATE-PRIVATE 10 | 11 | ALSO TEMPLATE-PRIVATE DEFINITIONS 12 | 13 | \ private definitions go here 14 | 15 | ONLY FORTH DEFINITIONS ALSO TEMPLATE-PRIVATE 16 | 17 | \ TRACE-STACK 18 | \ TRACE-WORD 19 | 20 | 21 | BEGIN-CONST 22 | INCLUDE" lib/winconst.4th" 23 | END-CONST 24 | CONSTDICT-HASH WINCONST 25 | 26 | WINCONST SEARCH-CONSTDICT-HASH: WINCONST: 27 | 28 | \ TRACE-STACK 29 | \ TRACE-WORD 30 | 31 | CR winconst 64 dump 32 | 33 | s" ABE_BOTTOM" 34 | winconst SEARCH-CONSTDICT-HASH CR H.8 SPACE H.8 35 | 36 | s" APPMODEL_ERROR_NO_APPLICATION" 37 | winconst SEARCH-CONSTDICT-HASH CR H.8 SPACE H.8 38 | 39 | s" ABE_BOTTOM1" 40 | winconst SEARCH-CONSTDICT-HASH CR H.8 41 | 42 | s" ALG_SID_DSS_PKCS2" 43 | winconst SEARCH-CONSTDICT-HASH CR H.8 44 | 45 | s" ABE_BOTTO" 46 | winconst SEARCH-CONSTDICT-HASH CR H.8 47 | 48 | s" ALG_SID_DSS_PKC" 49 | winconst SEARCH-CONSTDICT-HASH CR H.8 50 | 51 | s" ABE_BOTTOM" 52 | linconst SEARCH-CONSTDICT-HASH CR H.8 53 | 54 | s" ALG_SID_DSS_PKCS" 55 | linconst SEARCH-CONSTDICT-HASH CR H.8 56 | 57 | s" ABE_BOTTOM1" 58 | linconst SEARCH-CONSTDICT-HASH CR H.8 59 | 60 | s" ALG_SID_DSS_PKCS2" 61 | linconst SEARCH-CONSTDICT-HASH CR H.8 62 | 63 | winconst cdh{: ABS_AUTOHIDE :} CR H.8 64 | winconst cdh{: ABS_ALWAYSONTOP :} CR H.8 65 | winconst cdh{: ABS_AUTOHIDE ABS_ALWAYSONTOP :} CR H.8 66 | 67 | : test winconst cdh{: ABS_AUTOHIDE ABS_ALWAYSONTOP :} CR H.8 ; 68 | test 69 | 70 | CR H.S 71 | 72 | ONLY FORTH DEFINITIONS 73 | 74 | REPORT-NEW-NAME ! 75 | -------------------------------------------------------------------------------- /tools/linconst-extract/SConscript: -------------------------------------------------------------------------------- 1 | # extract 2 | 3 | Import('env') 4 | senv = env.Clone() 5 | senv['STATIC_AND_SHARED_OBJECTS_ARE_THE_SAME'] = True 6 | 7 | senv.Append(CCFLAGS = ['-m32', '-Wall', '-zq', '-fno-exceptions']) 8 | 9 | senv.Append(LINKFLAGS = ['-m32', '-Wl,--no-as-needed']) 10 | 11 | extractPreProcessSrc = ['linconst-extract.c'] 12 | 13 | extractRegExSrc = ['regex-include', 'regex-exclude', 'regex-exclude-names'] 14 | 15 | penv = senv.Clone() 16 | penv.Replace(CCFLAGS = []) 17 | extractProcessSrc = penv.PreProcess(extractPreProcessSrc) 18 | 19 | extractSrc0 = senv.Command('linconst-extract.E0', 20 | [extractProcessSrc, extractRegExSrc], 21 | "cat ${SOURCE} | grep -E --file build/linconst-extract/regex-include | grep -Ev --file build/linconst-extract/regex-exclude | sort -u > ${TARGET}") 22 | 23 | extractSrc1 = senv.Command('linconst-extract.E1', 24 | [extractSrc0, extractRegExSrc], 25 | "cat ${SOURCE} | cut --delimiter ' ' -f 2 | sort -u | grep -Ev --file build/linconst-extract/regex-exclude-names > ${TARGET}") 26 | 27 | extractSrc2 = senv.Command('linconst-extract.E2', 28 | [extractSrc1], 29 | "sort -u ${SOURCE} | sed -E 's/(.+)/CONSTANT\(\\1\)/' > ${TARGET}") 30 | 31 | publishExec = senv.Program('linconst-publish.elf', 'linconst-publish.c') 32 | senv.Depends(publishExec, [extractSrc2]) 33 | 34 | linconstForth = senv.Command('linconst.4th', 35 | publishExec, 36 | "${SOURCE} | sed 's/\\r//' > ${TARGET}") 37 | 38 | forthLib = senv.Install('#lib', linconstForth) 39 | senv.NoClean(forthLib) 40 | senv.Precious(forthLib) 41 | 42 | senv.Alias('linconst', [forthLib, publishExec]) 43 | -------------------------------------------------------------------------------- /tools/linconst-extract/linconst-extract.c: -------------------------------------------------------------------------------- 1 | #include "linconst.h" 2 | 3 | int main() { 4 | return 0; 5 | } 6 | -------------------------------------------------------------------------------- /tools/linconst-extract/linconst-publish.c: -------------------------------------------------------------------------------- 1 | #include "linconst.h" 2 | 3 | // Add entry to table 4 | #define CONSTANT(x) {#x, (int)x}, 5 | #define DEFINE(x,v) {#x, (int)v}, 6 | #define SIZEOF(x,v) DEFINE(x, sizeof(v)) 7 | #define OFFSETOF(x,s,f) DEFINE(x, offsetof(s,f)) 8 | 9 | typedef struct _Entry { 10 | char *name; 11 | int value; 12 | } Entry ; 13 | 14 | Entry entry[] = { 15 | #include "linconst-extract.E2" 16 | #include "linconst-publish.i" 17 | {NULL,0} 18 | }; 19 | 20 | int main() { 21 | printf("BASE @ HEX\n"); 22 | for (int i = 0; entry[i].name; i++) { 23 | printf("%08X CONSTANT %s\n", entry[i].value, entry[i].name); 24 | } 25 | printf("BASE !\n"); 26 | return 0; 27 | } 28 | -------------------------------------------------------------------------------- /tools/linconst-extract/linconst-publish.i: -------------------------------------------------------------------------------- 1 | OFFSETOF(OFFSETOF_C_CC, struct termios, c_cc) 2 | OFFSETOF(OFFSETOF_C_IFLAG, struct termios, c_iflag) 3 | OFFSETOF(OFFSETOF_C_LFLAG, struct termios, c_lflag) 4 | OFFSETOF(OFFSETOF_ST_MODE, struct stat, st_mode) 5 | OFFSETOF(OFFSETOF_ST_MODE64, struct stat64, st_mode) 6 | OFFSETOF(OFFSETOF_ST_SIZE, struct stat, st_size) 7 | OFFSETOF(OFFSETOF_ST_SIZE64, struct stat64, st_size) 8 | SIZEOF(SIZEOF_FD_SET, fd_set) 9 | SIZEOF(SIZEOF_PTHREAD_T, pthread_t) 10 | SIZEOF(SIZEOF_SIGSET_T, sigset_t) 11 | SIZEOF(SIZEOF_STRUCT_POLLFD, struct pollfd) 12 | SIZEOF(SIZEOF_STRUCT_RLIMIT, struct rlimit) 13 | SIZEOF(SIZEOF_STRUCT_STAT, struct stat) 14 | SIZEOF(SIZEOF_STRUCT_STAT64, struct stat64) 15 | SIZEOF(SIZEOF_STRUCT_TERMIOS, struct termios) 16 | SIZEOF(SIZEOF_STRUCT_TIMESPEC, struct timespec) 17 | SIZEOF(SIZEOF_STRUCT_TIMEVAL, struct timeval) 18 | -------------------------------------------------------------------------------- /tools/linconst-extract/linconst.h: -------------------------------------------------------------------------------- 1 | #define _DEFAULT_SOURCE 2 | #define _GNU_SOURCE 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | #include 30 | -------------------------------------------------------------------------------- /tools/linconst-extract/regex-exclude: -------------------------------------------------------------------------------- 1 | __attribute__ 2 | __attribute_artificial__ 3 | __DEC128 4 | __DEC32 5 | __DEC64 6 | __declspec 7 | __FLT_ 8 | __FLT128 9 | __FLT32 10 | __FLT64 11 | __LDBL_ 12 | _T_TYPE[[:space:]]+ 13 | ["] 14 | [[:space:]]+__[_[:alnum:]]+ 15 | [[:space:]]+__restrict 16 | [[:space:]]+__restrict[[:space:]]+ 17 | [[:space:]]+__sigaction_handler\. 18 | [[:space:]]+__sym_ 19 | [[:space:]]+__SYSCALL 20 | [[:space:]]+_sifields\. 21 | [[:space:]]+_sigev_un\. 22 | [[:space:]]+long[[:space:]]+ 23 | [[:space:]]+unsigned[[:space:]]+ 24 | [{}] 25 | #[[:space:]]*define[[:space:]]+[^[:space:]]+[[:space:]]+[(){}]+ 26 | #[[:space:]]*define[[:space:]]+[^[:space:]]+[[:space:]]+void 27 | cdecl 28 | -------------------------------------------------------------------------------- /tools/linconst-extract/regex-exclude-names: -------------------------------------------------------------------------------- 1 | _IOT_termios 2 | _LP64 3 | _POSIX[_[:alnum:]]+ 4 | _XBS5_LP64_OFF64 5 | _XBS5_LPBIG_OFFBIG 6 | [_[:alnum:]]+_H 7 | d_fileno 8 | GETLONG 9 | GETSHORT 10 | nsaddr 11 | PUTLONG 12 | PUTSHORT 13 | REG_R[_[:alnum:]]+ 14 | REG_CR2 15 | REG_CSGSFS 16 | REG_OLDMASK 17 | sched_priority 18 | SCM_SRCRT 19 | st_atime 20 | st_ctime 21 | st_mtime 22 | stderr 23 | stdin 24 | stdout 25 | TMP_MAX 26 | -------------------------------------------------------------------------------- /tools/linconst-extract/regex-include: -------------------------------------------------------------------------------- 1 | #[[:space:]]*define[[:space:]]+[^[:space:](]+[[:space:]]+[^[:space:](]+ 2 | -------------------------------------------------------------------------------- /tools/loader/FKernel.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include "FKernel.hpp" 5 | #include "args.hpp" 6 | 7 | bool CanExit = false; 8 | 9 | ImageHeader IHeader; 10 | 11 | int main(int const argc, char const ** argv, char const ** envp) { 12 | parsed_args * args = init_parsed_args(argc, argv); 13 | int returnCode = StartForth(args, envp); 14 | free_parsed_args(args); 15 | return returnCode; 16 | } 17 | -------------------------------------------------------------------------------- /tools/loader/FKernel.hpp: -------------------------------------------------------------------------------- 1 | #ifndef _FKernel_ 2 | #define _FKernel_ 3 | 4 | #include "IKFCommon.hpp" 5 | #include "IKFUtils.hpp" 6 | 7 | #endif 8 | -------------------------------------------------------------------------------- /tools/loader/FKernel.winedbg: -------------------------------------------------------------------------------- 1 | break * 0x00401790 2 | cont 3 | break * 0x200003b7 4 | cont 5 | 6 | ; SEARCH-WORDLIST 7 | break * 0x20001D83 8 | ; 9 | x/32b ($esi) 10 | 11 | ; $CONST '0' 12 | break * 0x2000047B 13 | 14 | ; >NUMBER 15 | break * 0x200023a1 16 | 17 | ; (DO-CONSTANT) 18 | break * 0x2000047B 19 | ; See the value of constant 20 | x/32b ($eax+4) 21 | 22 | ; POCKET 23 | x/32b 0x00120549 24 | x/32c 0x00120549 -------------------------------------------------------------------------------- /tools/loader/IKFCommon.hpp: -------------------------------------------------------------------------------- 1 | #ifndef _IKFCommon_ 2 | #define _IKFCommon_ 3 | 4 | #include 5 | 6 | #define MIN(a,b) (((a)<(b))?(a):(b)) 7 | #define MAX(a,b) (((a)>(b))?(a):(b)) 8 | 9 | typedef uint32_t CELL; 10 | 11 | #ifdef WIN32 12 | #include 13 | #include 14 | #else 15 | #define HANDLE CELL 16 | #define HMODULE CELL 17 | #define FARPROC CELL 18 | #define DWORD CELL 19 | #define LONG uint64_t 20 | #define __int64 uint64_t 21 | #define HLOCAL(x) (x) 22 | #endif 23 | 24 | #ifndef __stdcall 25 | #define __stdcall __attribute__((stdcall)) 26 | #endif 27 | 28 | #ifndef nullptr 29 | #define nullptr (0) 30 | #endif 31 | 32 | const CELL fFALSE = 0; 33 | const CELL fTRUE = 0xFFFFFFFF; 34 | 35 | const int MAX_FILE_PATH = 1024; 36 | 37 | typedef struct _MainProcContext { 38 | int argc; 39 | char const ** argv; 40 | char const ** envp; 41 | char const * startFileName; 42 | int startFileNameLength; 43 | int const * exitCode; 44 | void const ** sysfunctions; 45 | } MainProcContext; 46 | 47 | typedef void __stdcall (* MainProc)(MainProcContext *); 48 | typedef void __stdcall (* ForthThreadProc)(void *, CELL); 49 | 50 | typedef struct _ImageHeader { 51 | char Signature[16]; 52 | void * DesiredBase; 53 | CELL DesiredSize; 54 | MainProc MainProcAddr; 55 | ForthThreadProc Win32ThreadProcAddr; 56 | ForthThreadProc LinuxThreadProcAddr; 57 | CELL UserDataAreaSize; 58 | CELL DataStackSize; 59 | } ImageHeader; 60 | 61 | typedef struct _ForthThreadParams { 62 | void * UserDataAreaAddr; 63 | CELL ExecutionToken; 64 | } ForthThreadParams; 65 | 66 | extern bool CanExit; 67 | 68 | extern ImageHeader IHeader; 69 | 70 | extern void const * sysfunctions[]; 71 | 72 | #endif 73 | -------------------------------------------------------------------------------- /tools/loader/IKFUtils.hpp: -------------------------------------------------------------------------------- 1 | #ifndef _IKFUtils_ 2 | #define _IKFUtils_ 3 | 4 | #include "IKFCommon.hpp" 5 | #include "IKFunc.hpp" 6 | #include "args.hpp" 7 | 8 | void ShowLastError(char const * where); 9 | 10 | int StartForth(const parsed_args * args, char const * envp[]); 11 | 12 | #endif 13 | -------------------------------------------------------------------------------- /tools/loader/IKFunc.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #include "IKFunc.hpp" 7 | 8 | void const * sysfunctions[] = { 9 | // order MUST be the same as in ftable.asm FUNC_TABLE 10 | sys_GetLastError, 11 | fLoadLibrary, 12 | fFreeLibrary, 13 | fGetProcAddress, 14 | sys_Bye, 15 | sys_Emit, 16 | sys_Type, 17 | fFileClose, 18 | fFileCreate, 19 | fFilePosition, 20 | fFileOpen, 21 | fFileReposition, 22 | fFileReadLine, 23 | fStartThread, 24 | fAlloc, 25 | fFree, 26 | fReAlloc 27 | }; 28 | 29 | void initName(char * buffer, int bufferSize, char const * value, int valueSize) { 30 | if (bufferSize < 1) { 31 | perror("IKFE001: Invalid buffer size in initName"); 32 | abort(); 33 | } 34 | memset(buffer, 0, sizeof(char) * bufferSize); 35 | strncpy(buffer, value, MIN(bufferSize, MAX(0, valueSize))); 36 | // make sure buffer ALWAYS ends with \0 37 | buffer[bufferSize - 1] = '\0'; 38 | } 39 | 40 | void __stdcall sys_Bye() { 41 | CanExit = true; 42 | while (true) { usleep(100000); } 43 | } 44 | 45 | void __stdcall sys_Emit(char c) { 46 | write(STDOUT_FILENO, &c, sizeof(c)); 47 | } 48 | 49 | void __stdcall sys_Type(CELL sLen, char const * sAddr) { 50 | if (sLen < 1) { 51 | return; 52 | } 53 | write(STDOUT_FILENO, sAddr, sLen); 54 | } 55 | -------------------------------------------------------------------------------- /tools/loader/IKFunc.hpp: -------------------------------------------------------------------------------- 1 | #ifndef _IKFunc_ 2 | #define _IKFunc_ 3 | 4 | #include "IKFCommon.hpp" 5 | 6 | void initName(char * buffer, int bufferSize, char const * value, int valueSize); 7 | 8 | int __stdcall sys_GetLastError(); 9 | HMODULE __stdcall fLoadLibrary(CELL nameLen, char const * nameAddr); 10 | void __stdcall fFreeLibrary(HMODULE libID); 11 | FARPROC __stdcall fGetProcAddress(HMODULE libID, CELL nameLen, char const * nameAddr); 12 | void __stdcall sys_Bye(); 13 | void __stdcall sys_Emit(char c); 14 | void __stdcall sys_Type(CELL sLen, char const * sAddr); 15 | void __stdcall fFileClose(HANDLE fileID); 16 | HANDLE __stdcall fFileCreate(CELL fileAccessMethod, CELL nameLen, char const * nameAddr); 17 | __int64 __stdcall fFilePosition(HANDLE fileId); 18 | HANDLE __stdcall fFileOpen(CELL fileAccessMethod, CELL nameLen, char const * nameAddr); 19 | void __stdcall fFileReposition(HANDLE fileID, CELL HWord, CELL LWord); 20 | __int64 __stdcall fFileReadLine(HANDLE fileId, CELL cLen, char * cAddr); 21 | DWORD __stdcall fStartThread(void * ParentUserDataAreaAddr, DWORD CreateSuspended, DWORD XT); 22 | void * __stdcall fAlloc(DWORD size); 23 | void __stdcall fFree(void * addr); 24 | void * __stdcall fReAlloc(DWORD newSize, void * addr); 25 | 26 | #endif 27 | -------------------------------------------------------------------------------- /tools/loader/SConscript: -------------------------------------------------------------------------------- 1 | # loader 2 | 3 | Import('env') 4 | senv = env.Clone() 5 | 6 | senv.Append(CPPFLAGS = ['-mregparm=0', '-Wall', '-zq', '-march=i586', '-m32', '-fpermissive', '-pedantic', '-nodefaultlibs', '-fno-exceptions']) 7 | senv.Append(LINKFLAGS = ['-m32', '-Wl,--no-as-needed', '-pthread']) 8 | 9 | fkernelExec = senv.execname('FKernel'); 10 | 11 | if senv['DEBUG'] == 'TRUE': 12 | senv.Append(LINKFLAGS = ['-g3', '-Og']) 13 | else: 14 | senv.Append(LINKFLAGS = ['-Wl,--strip-all', '-g0', '-O3']) 15 | 16 | if senv['TSYS'] == 'nt': 17 | senv.Replace(tools = ['mingw']) 18 | senv.Replace(CXX = 'mingw32-g++') 19 | senv.Replace(LINK = 'mingw32-g++') 20 | senv.Append(CPPFLAGS = ['-mconsole']) 21 | senv.Append(LINKFLAGS = ['-static-libgcc', '-static-libstdc++']) 22 | 23 | if senv['TSYS'] == 'linux': 24 | senv.Append(CPPFLAGS = ['-pthread']) 25 | senv.Append(LINKFLAGS = ['-ldl']) 26 | 27 | loader_src = senv.Glob('*.cpp') 28 | loader_src.extend(senv.Glob('sys' + senv['TSYS'] + '/*.cpp')) 29 | 30 | fkernelPath = '#build/loader-$TSYS/' + fkernelExec 31 | senv.Program(fkernelExec, loader_src) 32 | senv.Alias('loader', [fkernelExec]) 33 | 34 | Return('fkernelPath') 35 | -------------------------------------------------------------------------------- /tools/loader/args.hpp: -------------------------------------------------------------------------------- 1 | #ifndef _args_ 2 | #define _args_ 3 | 4 | #include "IKFCommon.hpp" 5 | #include "IKFunc.hpp" 6 | 7 | typedef struct parsed_args_t { 8 | CELL dictionary_size; 9 | CELL data_stack_size; 10 | CELL return_stack_size; 11 | CELL user_data_area_size; 12 | char const * image_file; 13 | char const * forth_file; 14 | int forth_argc; 15 | char const ** forth_argv; 16 | } parsed_args; 17 | 18 | parsed_args * init_parsed_args(int const argc, char const ** argv); 19 | 20 | void free_parsed_args(parsed_args * args); 21 | 22 | #endif 23 | -------------------------------------------------------------------------------- /tools/loader/dictmem.hpp: -------------------------------------------------------------------------------- 1 | #ifndef _dictmem_ 2 | #define _dictmem_ 3 | 4 | // idea shamelessly borrowed from 5 | // http://blog.nervus.org/managing-virtual-address-spaces-with-mmap/ 6 | 7 | void * AllocateDictionaryAddressSpace(void * addr, size_t size); 8 | 9 | void * CommitDictionaryMemory(void * addr, size_t size); 10 | 11 | void DecommitDictionaryMemory(void * addr, size_t size); 12 | 13 | void FreeDictionaryAddressSpace(void * addr, size_t size); 14 | 15 | #endif 16 | -------------------------------------------------------------------------------- /tools/loader/sysio.hpp: -------------------------------------------------------------------------------- 1 | #ifndef _sysio_ 2 | #define _sysio_ 3 | 4 | #define _LARGEFILE64_SOURCE 1 5 | 6 | #include 7 | 8 | #include "IKFCommon.hpp" 9 | 10 | #ifndef INVALID_HANDLE_VALUE 11 | #define INVALID_HANDLE_VALUE (0) 12 | #endif 13 | 14 | #if defined(WIN32) 15 | #if defined(__MINGW32__) 16 | #if !defined(lseek) 17 | #define lseek _lseeki64 18 | #endif 19 | #endif 20 | #if defined(_MSC_VER) 21 | #define lseek lseek64 22 | #endif 23 | #endif 24 | 25 | void sys_initIo(); 26 | 27 | bool sys_ReadFile(HANDLE hFile, void *lpBuffer, DWORD nNumberOfBytesToRead, DWORD *lpNumberOfBytesRead); 28 | 29 | /* Rewind file identified with fileId by the specified distance (positive number of bytes). */ 30 | void sys_rewindFile(HANDLE fileId, CELL distance); 31 | 32 | /* Reset last error value. */ 33 | void sys_resetLastError(); 34 | 35 | void ShowLastError(char const *where); 36 | 37 | #endif 38 | -------------------------------------------------------------------------------- /tools/loader/syslinux/dictmem.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include "../dictmem.hpp" 3 | 4 | void * AllocateDictionaryAddressSpace(void * addr, size_t size) { 5 | void * ptr = mmap(addr, size, PROT_NONE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0); 6 | msync(ptr, size, MS_SYNC|MS_INVALIDATE); 7 | return ptr; 8 | } 9 | 10 | void * CommitDictionaryMemory(void * addr, size_t size) { 11 | void * ptr = mmap(addr, size, PROT_READ|PROT_WRITE|PROT_EXEC, MAP_FIXED|MAP_SHARED|MAP_ANONYMOUS, -1, 0); 12 | msync(addr, size, MS_SYNC|MS_INVALIDATE); 13 | return ptr; 14 | } 15 | 16 | void DecommitDictionaryMemory(void * addr, size_t size) { 17 | // instead of unmapping the address, we're just gonna trick 18 | // the TLB to mark this as a new mapped area which, due to 19 | // demand paging, will not be committed until used. 20 | mmap(addr, size, PROT_NONE, MAP_FIXED|MAP_PRIVATE|MAP_ANONYMOUS, -1, 0); 21 | msync(addr, size, MS_SYNC|MS_INVALIDATE); 22 | } 23 | 24 | void FreeDictionaryAddressSpace(void * addr, size_t size) { 25 | msync(addr, size, MS_SYNC); 26 | munmap(addr, size); 27 | } 28 | -------------------------------------------------------------------------------- /tools/loader/syslinux/syserror.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include "../IKFunc.hpp" 4 | 5 | void ShowLastError(char const * where) { 6 | perror(where); 7 | } 8 | 9 | int __stdcall sys_GetLastError() { 10 | return errno; 11 | } 12 | -------------------------------------------------------------------------------- /tools/loader/syslinux/syslib.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "../IKFCommon.hpp" 5 | #include "../IKFunc.hpp" 6 | 7 | CELL __stdcall fLoadLibrary(CELL nameLen, char const * nameAddr) { 8 | dlerror(); /* Clear any existing error */ 9 | errno = 0; 10 | char libName[MAX_FILE_PATH]; 11 | initName(libName, MAX_FILE_PATH, nameAddr, nameLen); 12 | CELL result = (CELL) dlopen(libName, RTLD_LAZY | RTLD_NOW); 13 | // perror(dlerror()); 14 | return result; 15 | } 16 | 17 | void __stdcall fFreeLibrary(CELL libId) { 18 | dlerror(); /* Clear any existing error */ 19 | errno = 0; 20 | if (libId != 0) { 21 | dlclose((void *) libId); 22 | } 23 | } 24 | 25 | FARPROC __stdcall fGetProcAddress(CELL libId, CELL nameLen, char const * nameAddr) { 26 | dlerror(); /* Clear any existing error */ 27 | errno = 0; 28 | char procName[MAX_FILE_PATH]; 29 | initName(procName, MAX_FILE_PATH, nameAddr, nameLen); 30 | CELL result = (CELL) dlsym((void *) libId, procName); 31 | return result; 32 | } 33 | 34 | -------------------------------------------------------------------------------- /tools/loader/syslinux/sysmem.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "../IKFCommon.hpp" 5 | 6 | void * __stdcall fAlloc(DWORD size) { 7 | errno = 0; 8 | void * result = (void *) malloc(size); 9 | return result; 10 | } 11 | 12 | void __stdcall fFree(void * addr) { 13 | errno = 0; 14 | free(addr); 15 | } 16 | 17 | void * __stdcall fReAlloc(DWORD newSize, void * addr) { 18 | void * result = (void *) realloc(addr, newSize); 19 | if (result == NULL) { 20 | result = addr; 21 | } 22 | else { 23 | errno = 0; 24 | } 25 | return result; 26 | } 27 | -------------------------------------------------------------------------------- /tools/loader/syslinux/systhread.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include "../IKFCommon.hpp" 6 | #include "../IKFunc.hpp" 7 | 8 | void * fThreadFunc(void * lpParameter) { 9 | ForthThreadParams * ftp = (ForthThreadParams *) lpParameter; 10 | IHeader.LinuxThreadProcAddr(ftp->UserDataAreaAddr, ftp->ExecutionToken); 11 | fFree(ftp->UserDataAreaAddr); 12 | fFree(ftp); 13 | return 0; 14 | } 15 | 16 | DWORD __stdcall fStartThread(void * ParentUserDataAreaAddr, DWORD CreateSuspended, DWORD XT) { 17 | //~ DWORD flags = 0; 18 | //~ if (CreateSuspended == fTRUE) { 19 | //~ flags |= CREATE_SUSPENDED; 20 | //~ } 21 | ForthThreadParams * ftp = (ForthThreadParams *) fAlloc(sizeof(ForthThreadParams)); 22 | ftp->ExecutionToken = XT; 23 | ftp->UserDataAreaAddr = fAlloc(IHeader.UserDataAreaSize); 24 | if (ParentUserDataAreaAddr != NULL) { 25 | memmove(ftp->UserDataAreaAddr, ParentUserDataAreaAddr, IHeader.UserDataAreaSize); 26 | } 27 | pthread_t threadId; 28 | pthread_create(&threadId, NULL, &fThreadFunc, ftp); 29 | return threadId; 30 | } 31 | -------------------------------------------------------------------------------- /tools/loader/sysnt/dictmem.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include "../dictmem.hpp" 4 | 5 | void * AllocateDictionaryAddressSpace(void * addr, size_t size) { 6 | return VirtualAlloc(addr, size, MEM_RESERVE , PAGE_NOACCESS); 7 | } 8 | 9 | void * CommitDictionaryMemory(void * addr, size_t size) { 10 | return VirtualAlloc(addr, size, MEM_COMMIT, PAGE_EXECUTE_READWRITE); 11 | } 12 | 13 | void DecommitDictionaryMemory(void * addr, size_t size) { 14 | VirtualFree(addr, size, MEM_DECOMMIT); 15 | } 16 | 17 | void FreeDictionaryAddressSpace(void * addr, size_t) { 18 | VirtualFree(addr, 0, MEM_RELEASE); 19 | } 20 | -------------------------------------------------------------------------------- /tools/loader/sysnt/syserror.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "../IKFunc.hpp" 5 | 6 | void ShowLastError(char const * where) { 7 | DWORD err = GetLastError(); 8 | char * errMessage; 9 | FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, 10 | NULL, err, 0, (LPTSTR)&errMessage, 0, NULL); 11 | if (where != NULL) { 12 | sys_Type(strlen(where), where); 13 | sys_Type(2, "\n\r"); 14 | } 15 | sys_Type(strlen(errMessage), errMessage); 16 | sys_Type(2, "\n\r"); 17 | LocalFree(HLOCAL(errMessage)); 18 | } 19 | 20 | int __stdcall sys_GetLastError() { 21 | return GetLastError(); 22 | } 23 | -------------------------------------------------------------------------------- /tools/loader/sysnt/syslib.cpp: -------------------------------------------------------------------------------- 1 | #include "../IKFCommon.hpp" 2 | #include "../IKFunc.hpp" 3 | 4 | HMODULE __stdcall fLoadLibrary(CELL nameLen, char const * nameAddr) { 5 | char libName[MAX_FILE_PATH]; 6 | initName(libName, MAX_FILE_PATH, nameAddr, nameLen); 7 | SetLastError(0); 8 | HMODULE result = LoadLibrary(libName); 9 | return result; 10 | } 11 | 12 | void __stdcall fFreeLibrary(HMODULE libId) { 13 | FreeLibrary(libId); 14 | } 15 | 16 | FARPROC __stdcall fGetProcAddress(HMODULE libId, CELL nameLen, char const * nameAddr) { 17 | char procName[MAX_FILE_PATH]; 18 | initName(procName, MAX_FILE_PATH, nameAddr, nameLen); 19 | SetLastError(0); 20 | return GetProcAddress(libId, procName); 21 | } 22 | 23 | -------------------------------------------------------------------------------- /tools/loader/sysnt/sysmem.cpp: -------------------------------------------------------------------------------- 1 | #include "../IKFCommon.hpp" 2 | 3 | void * __stdcall fAlloc(DWORD size) { 4 | void * result = (void *)GlobalAlloc(GPTR, size); 5 | if (result == NULL) { 6 | SetLastError(ERROR_NOT_ENOUGH_MEMORY); 7 | } 8 | else { 9 | SetLastError(0); 10 | } 11 | return result; 12 | } 13 | 14 | void __stdcall fFree(void * addr) { 15 | if (GlobalFree(HGLOBAL(addr)) == NULL) { 16 | SetLastError(0); 17 | } 18 | } 19 | 20 | void * __stdcall fReAlloc(DWORD newSize, void * addr) { 21 | void * result = (void *)GlobalReAlloc(HGLOBAL(addr), newSize, GMEM_ZEROINIT); 22 | if (result == NULL) { 23 | result = addr; 24 | } 25 | else { 26 | SetLastError(0); 27 | } 28 | return result; 29 | } 30 | -------------------------------------------------------------------------------- /tools/loader/sysnt/systhread.cpp: -------------------------------------------------------------------------------- 1 | #include "../IKFCommon.hpp" 2 | #include "../IKFunc.hpp" 3 | 4 | DWORD WINAPI fThreadFunc(LPVOID lpParameter) { 5 | ForthThreadParams * ftp = (ForthThreadParams *) lpParameter; 6 | IHeader.Win32ThreadProcAddr(ftp->UserDataAreaAddr, ftp->ExecutionToken); 7 | fFree(ftp->UserDataAreaAddr); 8 | fFree(ftp); 9 | return 0; 10 | } 11 | 12 | DWORD __stdcall fStartThread(void * ParentUserDataAreaAddr, DWORD CreateSuspended, DWORD XT) { 13 | DWORD flags = 0; 14 | ForthThreadParams * ftp = (ForthThreadParams *) fAlloc(sizeof(ForthThreadParams)); 15 | ftp->ExecutionToken = XT; 16 | ftp->UserDataAreaAddr = fAlloc(IHeader.UserDataAreaSize); 17 | if (ParentUserDataAreaAddr != NULL) { 18 | memmove(ftp->UserDataAreaAddr, ParentUserDataAreaAddr, IHeader.UserDataAreaSize); 19 | } 20 | if (CreateSuspended == fTRUE) { 21 | flags |= CREATE_SUSPENDED; 22 | } 23 | DWORD threadId = 0; 24 | CreateThread(NULL, IHeader.DataStackSize, &fThreadFunc, ftp, flags, &threadId); 25 | return threadId; 26 | } 27 | -------------------------------------------------------------------------------- /tools/winconst-extract/SConscript: -------------------------------------------------------------------------------- 1 | # extract 2 | 3 | Import('env') 4 | senv = env.Clone() 5 | senv['STATIC_AND_SHARED_OBJECTS_ARE_THE_SAME'] = True 6 | 7 | senv.Replace(tools = ['mingw']) 8 | senv.Replace(CC = 'mingw32-gcc') 9 | senv.Replace(LINK = 'mingw32-gcc') 10 | 11 | #senv.Append(CCFLAGS = ['-mconsole', '--verbose']) 12 | senv.Append(CCFLAGS = ['-m32', '-Wall', '-zq', '-fno-exceptions']) 13 | 14 | #senv.Append(LINKFLAGS = ['-mconsole']) 15 | senv.Append(LINKFLAGS = ['-Wl,--no-as-needed']) 16 | 17 | extractPreProcessSrc = ['winconst-extract.c'] 18 | 19 | extractRegExSrc = ['regex-include', 'regex-exclude', 'regex-exclude-names'] 20 | 21 | penv = senv.Clone() 22 | penv.Replace(CCFLAGS = []) 23 | extractProcessSrc = penv.PreProcess(extractPreProcessSrc) 24 | 25 | extractSrc0 = senv.Command('winconst-extract.E0', 26 | [extractProcessSrc, extractRegExSrc], 27 | "cat ${SOURCE} | grep -E --file build/winconst-extract/regex-include | grep -Ev --file build/winconst-extract/regex-exclude | sort -u > ${TARGET}") 28 | 29 | extractSrc1 = senv.Command('winconst-extract.E1', 30 | [extractSrc0, extractRegExSrc], 31 | "cat ${SOURCE} | cut --delimiter ' ' -f 2 | sort -u | grep -Ev --file build/winconst-extract/regex-exclude-names > ${TARGET}") 32 | 33 | extractSrc2 = senv.Command('winconst-extract.E2', 34 | [extractSrc1], 35 | "sort -u ${SOURCE} | sed -E 's/(.+)/CONSTANT\(\\1\)/' > ${TARGET}") 36 | 37 | publishExec = senv.Program('winconst-publish.exe', 'winconst-publish.c', LIBS=['urlmon']) 38 | senv.Depends(publishExec, [extractSrc2]) 39 | 40 | winconstForth = senv.Command('winconst.4th', 41 | publishExec, 42 | "${WINCONST_BUILD_LAUNCHER} ${SOURCE} | sed 's/\\r//' > ${TARGET}") 43 | 44 | forthLib = senv.Install('#lib', winconstForth) 45 | senv.NoClean(forthLib) 46 | senv.Precious(forthLib) 47 | 48 | senv.Alias('winconst', [forthLib, publishExec]) 49 | -------------------------------------------------------------------------------- /tools/winconst-extract/regex-exclude: -------------------------------------------------------------------------------- 1 | __attribute__ 2 | __DEC128 3 | __DEC32 4 | __DEC64 5 | __declspec 6 | __FLT128 7 | __FLT32 8 | __FLT64 9 | __inline 10 | __MIDL_CONST 11 | __mingw 12 | __MINGW 13 | __RPC_API 14 | ([_[:alnum:]]+)_A[[:space:]]+\1A 15 | ([_[:alnum:]]+)_W[[:space:]]+\1W 16 | ([_[:alnum:]]+)[[:space:]]+\1[AW] 17 | ([_[:alnum:]]+)[[:space:]]+Rtl\1 18 | [(][)][)=] 19 | [[:space:]]+_CRT 20 | [[:space:]]+' 21 | [[:space:]]+" 22 | [[:space:]]+GUID_ 23 | [[:space:]]+IID_ 24 | [[:space:]]+L" 25 | [[:space:]]+SID_ 26 | [{}] 27 | #define[[:space:]]+[^[:space:]]+[[:space:]]+void 28 | cdecl 29 | DECLSPEC_ 30 | dllimport 31 | fastcall 32 | POINTER_ 33 | STDAPICALLTYPE 34 | STDAPIVCALLTYPE 35 | stdcall 36 | STDMETHOD 37 | STDMETHODVCALLTYPE 38 | thiscall 39 | ua_[_[:alnum:]]+ 40 | WINAPI 41 | WINBASEAPI 42 | WINIMPM 43 | WINOLEAPI 44 | -------------------------------------------------------------------------------- /tools/winconst-extract/regex-include: -------------------------------------------------------------------------------- 1 | #define[[:space:]]+[_[:alnum:]]+([[:space:]]+[_[:alnum:]()~-]+)+ 2 | -------------------------------------------------------------------------------- /tools/winconst-extract/winconst-extract.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | // #include 5 | 6 | int main() { 7 | return 0; 8 | } 9 | -------------------------------------------------------------------------------- /tools/winconst-extract/winconst-publish.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | // #include 7 | 8 | #define CONSTANT(x) {#x, (int)x}, 9 | 10 | typedef struct _Entry { 11 | char *name; 12 | int value; 13 | } Entry ; 14 | 15 | Entry entry[] = { 16 | #include "winconst-extract.E2" 17 | {NULL,0} 18 | }; 19 | 20 | int main() { 21 | printf("BASE @ HEX\n"); 22 | for (int i = 0; entry[i].name; i++) { 23 | printf("%08X CONSTANT %s\n", entry[i].value, entry[i].name); 24 | } 25 | printf("BASE !\n"); 26 | return 0; 27 | } 28 | --------------------------------------------------------------------------------