diff --git a/Makefile b/Makefile index f91739e..730fb78 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -# $Id: Makefile,v 5.67 2022/03/23 12:59:50 albert Exp $ +# $Id: Makefile,v 5.75 2024/04/21 17:54:09 albert Exp $ # Copyright(2013): Albert van der Horst, HCC FIG Holland by GNU Public License # @@ -38,7 +38,8 @@ M4=m4 -G ciforth.m4 M4_GNU=m4 ciforth.m4 FORTH=./lina # Our utility Forth. - +FASM=/usr/bin/fasm +#FASM=$(BIN)/fasm # ALL FILES STARTING IN ``ci86'' (OUTHER ``ci86.gnr'') ARE GENERATED INGREDIENTS = \ @@ -129,12 +130,18 @@ cifgen.mi \ ciforth.mi \ intro.mi \ manual.mi \ +optimiser.mi \ rational.mi \ # That's all folks! # Documentation files and archives DOC = \ COPYING \ +copyright \ +lina.1 \ +READMElina.txt \ +READMEwina.txt \ +howto.txt \ README.ciforth \ testreport.txt \ $(SRCMI) \ @@ -213,6 +220,7 @@ lina64.cfg # The usable files. RELEASELINA32USER = \ COPYING \ +copyright \ READMElina.txt \ lina32 \ forth.lab \ @@ -231,6 +239,7 @@ ci86.lina32.texinfo \ RELEASELINA64USER = \ COPYING \ +copyright \ READMElina.txt \ lina64 \ forth.lab \ @@ -267,7 +276,7 @@ TEMPFILE=/tmp/ciforthscratch %: %.frt ; $(FORTH) -c $< # Define fasm as *the* assembler generating binary files. -%:%.fas ; fasm $< -m256000 +%:%.fas ; $(FASM) $< -m256000 ; chmod +x $@ # Define NASM as an alternative for generating bin files. %.bin:%.asm ; nasm -fbin $< -o $@ -l $*.lst @@ -276,7 +285,7 @@ TEMPFILE=/tmp/ciforthscratch # allow to generate ci86.mina.bin etc. ci86.%.rawdoc ci86.%.rawtest : ci86.%.asm ; -VERSION : ; echo 'define({M4_VERSION},{'${VERSION}'})' >VERSION +VERSION : ; echo 'define({M4_VERSION},{'${VERSION}'})dnl' >VERSION ci86.%.asm : %.cfg VERSION nasm.m4 ci86.gnr cat $+ | $(M4) $(M4_DEBUG) - > $(TEMPFILE) @@ -333,17 +342,17 @@ toblk: toblk.frt $(FORTH) rm -f forth.lab forth.lab.lina # Canonical targets -lina : lina32 ; cp $< $@ -#lina32 : flina32 ; cp $< $@ -#lina64 : flina64 ; cp $< $@ -lina32 : glina32 ; cp $< $@ -lina64 : glina64 ; cp $< $@ +lina : lina64 ; cp $< $@ +lina32 : flina32 ; cp $< $@ +lina64 : flina64 ; cp $< $@ +#lina32 : glina32 ; cp $< $@ +#lina64 : glina64 ; cp $< $@ #lina: lina64 ; $< -g 8000 $@ # For MS-windows programs fasm demands an include directory with assorted # stuff. Use a symbolic link. Works on fasm 1.73.20 possibly not earlier. -wina32.exe: ci86.wina32.fas ; fasm $+ -m256000 ; mv ${<:.fas=}.exe $@ -wina64.exe: ci86.wina64.fas ; fasm $+ -m256000 ; mv ${<:.fas=}.exe $@ +wina32.exe: ci86.wina32.fas ; $(FASM) $+ -m256000 ; mv ${<:.fas=}.exe $@ +wina64.exe: ci86.wina64.fas ; $(FASM) $+ -m256000 ; mv ${<:.fas=}.exe $@ # Some of these targets make no sense and will fail all: $(TARGETS:%=ci86.%.asm) $(TARGETS:%=ci86.%.msm) $(BINTARGETS:%=ci86.%.bin) \ @@ -404,7 +413,8 @@ moreboot: forth.lab.wina ci86.alone.bin ci86.mina.bin allboot: boot filler moreboot forth.lab.lina : toblk options.frt errors.linux.txt blocks.frt - cat options.frt errors.linux.txt blocks.frt | ./toblk >$@ + $(M4) VERSION options.frt > optionscook.frt + cat optionscook.frt errors.linux.txt blocks.frt | ./toblk >$@ ln -f $@ forth.lab forth.lab.wina : toblk options.frt errors.dos.txt blocks.frt @@ -451,25 +461,19 @@ mslinks : forth.lab : forth.lab.lina forth.lab.wina LINA32ZIP : $(RELEASELINA32) - rm -f ci86.lina32-$(VERSION) forth.lab.lina + rm forth.lab.lina make forth.lab.lina ls $+ | sed s:^:ci86.lina32-$(VERSION)/: >MANIFEST + rm -rf ci86.lina32-$(VERSION) || true ln -sf . ci86.lina32-$(VERSION) tar -czvf ci86.lina32-$(VERSION).tar.gz `cat MANIFEST` rm ci86.lina32-$(VERSION) -LINA64DEB : $(RELEASELINA64) - echo $+ >MANIFEST - debian.sh $(VERSION) lina64 - -LINA32DEB : $(RELEASELINA32) - echo $+ >MANIFEST - debian.sh $(VERSION) lina32 - LINA64ZIP : $(RELEASELINA64) - rm -f ci86.lina64-$(VERSION) forth.lab.lina + rm forth.lab.lina make forth.lab.lina ls $+ | sed s:^:ci86.lina64-$(VERSION)/: >MANIFEST + rm -rf ci86.lina64-$(VERSION) || true ln -sf . ci86.lina64-$(VERSION) tar -czvf ci86.lina64-$(VERSION).tar.gz `cat MANIFEST` rm ci86.lina64-$(VERSION) @@ -496,13 +500,15 @@ nlina64 : ci86.lina64.o ; \ # Linux native forth by gnu tools # Linux native forth by gnu tools, only works on a 64 bit system -glina32 : ci86.lina32.s ; as --32 $+; ld a.out -melf_i386 -N -o $@ -glina64 : ci86.lina64.s ; as --64 $+; ld a.out -melf_x86_64 -N -o $@ +glina32 : ci86.lina32.s ; as --32 -a=$@.lst $+; ld a.out -melf_i386 -N -o $@ +glina64 : ci86.lina64.s ; as --64 -a=$@.lst $+; ld a.out -melf_x86_64 -N -o $@ # Linux native forth by fasm tools -flina32 : ci86.lina32.fas ; fasm $+ -m256000; mv ${<:.fas=} $@ -flina64 : ci86.lina64.fas ; fasm $+ -m256000; mv ${<:.fas=} $@ +# flina32 : ci86.lina32.fas ; $(FASM) $+ -m256000; mv ${<:.fas=} $@ +# flina64 : ci86.lina64.fas ; $(FASM) $+ -m256000; mv ${<:.fas=} $@ +flina32 : ci86.lina32 ; mv $< $@ +flina64 : ci86.lina64 ; mv $< $@ # Nowadays in the future the name constant.m4 has disappeared in # favour of constant_*.m4 @@ -539,16 +545,3 @@ LINA64_M4ZIP : $(RELEASELINA64_M4) VERSION ci86.gnr # Add temporary stuff for testing, docs, optims. include test.mak include optim.mak - -# not functional -# Obsolete, we don't yield for Debian pressure! -LINA32SRCZIPDEBIAN : $(RELEASELINA32_M4) VERSION ci86.gnr extract.mak - rm -f lina32-$(VERSION) forth.lab.lina - make forth.lab.lina - mkdir extract - cp ci86.gnr VERSION extract.mak $(EXTRACTORS) $(CONFIGURATIONS) extract - find $(RELEASELINA32USER) extract | \ - sed s:^:lina32-$(VERSION)/: >MANIFEST - ln -sf . lina32-$(VERSION) - tar -czvf lina32-$(VERSION).tar.gz `cat MANIFEST` - rm -r lina32-$(VERSION) extract diff --git a/READMElina.txt b/READMElina.txt index c6a3f76..0fa60de 100644 --- a/READMElina.txt +++ b/READMElina.txt @@ -1,31 +1,15 @@ CIFORTH CUSTOMIZATION FOR LINUX -COPYRIGHT (c) 2000-2022 Albert van der Horst , THE NETHERLANDS +COPYRIGHT (c) 2000-2024 Albert van der Horst , THE NETHERLANDS LICENSE This program is free software; you can redistribute it and/or modify it under the terms of version 2 of the GNU General Public License as published by the Free Software Foundation. -Forth is a tool for evolutionary programming. This is the binary -distribution of lina 5.# . The following applies to all versions 5.# -of lina in 32 or 64 bits. Contrary to what you expect from me, -this documentation is common to lina32 and lina64, because there -are virtually no differences except cell size. - -lina is the Linux native (= c-less) version of ciforth (common Intel -Forth), an interpret environment and compiler for Forth. It is (large -and by) compliant with the ISO Forth standard; the CORE wordset is -fully implemented. The small, classic, indirect threaded kernel -contains the essential, i.a. file access and exceptions. Its power is -multiplied by an extensive source library, that add i.a. a decompiler -and integrated 386 assembler. It is fully self contained; if you want -to understand a compiler in all details, this is your best, if not -only, choice. ciforth sports the highest documentation to binary -proportion in the EDP industry, barring m4 on Coherent. - RELEASE CONTENT Don't panic! ciforth is just two files, binary and library. The rest is documentation (plus examples and source). +## maybe 32 or 64. COPYING Copyright notice READMElina.txt This file @@ -46,20 +30,8 @@ The rest is documentation (plus examples and source). mywc Script example, old style. wc.script Script example, new style. -The script examples only runs once you have installed /usr/bin/lina. - -You can rebuild lina from the assembler file, instruction are in this -source. -The latest version and OSX and MS-windows versions can be fetched from - http://home.hccnet.nl/a.w.m.van.der.horst/ciforth.html -You have to change just one file, ci86.lina.fas. - -For making extensive changes, such as modifying the header fields or -making a version booting from a hard disk or adapting to a different -assembler, I recomment the compiler factory over modifying the -assembler file. It is present in - https://github.com/albertvanderhorst/ciforth +UNPACK AND RUN Unpack in the directory where you want to use it by : tar xfz ci86.lina##-#.#.#.gz @@ -69,8 +41,7 @@ or lina## -e or lina -After linking with so: -ln -s /usr/bin/lina /usr/bin/lina64 +after symbolic linking (see installation). Print the manual (150 pages) by : lpr ci86.lina##.ps @@ -84,22 +55,28 @@ View the same information in ci86.lina##.pdf with an appropriate tool Viewing the file ``ci86.lina##.html'' with a html viewer, gives a reference that is concise but has more cross links. +The executables, script's and hellow.frt run at once, +provided the current directory (.) is in your PATH. +After proper installation you can run lina and script's +everywhere. -For system wide installation (32-bit) the following is recommended: +INSTALLATION +For system wide installation (64-bit) the following is recommended: su - ./lina32 -g 60 lina32+ - ./lina32+ -i /usr/bin/lina32 /usr/lib/forth.lab - ln -s /usr/bin/lina32 /usr/bin/lina - chmod 755 /usr/bin/lina32 + ./lina64 -g 60 lina64+ + ./lina64+ -i /usr/bin/lina64 /usr/lib/forth.lab + ln -s /usr/bin/lina64 /usr/bin/lina + chmod 755 /usr/bin/lina64 chmod 644 /usr/lib/forth.lab mkdir /usr/share/doc/lina || true - cp ci86.lina32.* /usr/share/doc/lina - cp lina32.1 /usr/share/man/man1 + cp ci86.lina64.* /usr/share/doc/lina + cp lina.1 /usr/share/man/man1/lina.1 + cp ci86.lina64.info /usr/share/info/lina.info -The above increases Forth's dictionary space from 1 to 61 Mb. -Installing lina64 is similar, but now you may want to grow -by 8000 or 128000 Mbyte. +The above increases Forth's dictionary space with 60 Mb +(or beyond 4 Gbyte e.g. 8000 Mbyte. ) +Installing lina32 is similar. See also the -i option in the manual. Once installed you can use lina : @@ -108,17 +85,43 @@ Once installed you can use lina : Source package in debian format If you are installing from a deb file, all files are placed in the -appropriate directories. This solves the problem how to add the -.info file to the system, as this is difficult to do by hand. - -NOTE ON "info" -The "info" system for program documentation actively discourages -adding documentation to a system, by hiding how a .info file -can be installed. The nice folks of Debian had added a separate -program install-info , but as of 2015 that has been replaced by -ginstall-info that reinstates the former unworkable situation -with info files. -In a pinch you can do - info -f - -$Id: READMElina.txt,v 5.7 2022/03/12 12:42:15 albert Exp $ +appropriate directories. + +CHECK +If you run lina with -v you can check the version of the +executable and the library. They must agree. + +MODIFICATION +You can rebuild lina from the assembler file, instruction are in its +source. +The latest version and OSX and MS-windows versions can be fetched from + http://home.hccnet.nl/a.w.m.van.der.horst/ciforth.html +You have to change just one file, ci86.lina##.fas. + +For making extensive changes, such as modifying the header fields or +making a version booting from a hard disk or adapting to a different +assembler, I recommend the compiler factory over modifying the +assembler file. It is present in + https://github.com/albertvanderhorst/ciforth + +PROMOTION +Forth is a tool for evolutionary programming. This is the binary +distribution of lina 5.# . The following applies to all versions 5.# +of lina in 32 or 64 bits. Contrary to what you expect from me, +this README is common to lina32 and lina64, because there +are virtually no differences except cell size. +The default name is lina; this is the 64 bit version. The name +lina64 is only used if there is a lina32 version around. + +lina is the Linux native (= c-less) version of ciforth (common Intel +Forth), an interpret environment and compiler for Forth. It is (large +and by) compliant with the ISO Forth standard; the CORE wordset is +fully implemented. The small, classic, indirect threaded kernel +contains the essential, i.a. file access and exceptions. Its power is +multiplied by an extensive source library, that add i.a. a decompiler +and integrated 386 assembler. It is fully self contained; if you want +to understand a compiler in all details, this is your best, if not +only, choice. ciforth sports the highest documentation to binary +proportion in the EDP industry, barring m4 on Coherent. + +$Id: READMElina.txt,v 5.9 2024/04/21 16:22:40 albert Exp $ diff --git a/READMEwina.txt b/READMEwina.txt index 5fb6246..ff7634b 100644 --- a/READMEwina.txt +++ b/READMEwina.txt @@ -1,6 +1,6 @@ CIFORTH CUSTOMIZATION FOR MS-Windows, DLL. version 5.4.x -COPYRIGHT (c) 2000-2022 Albert van der Horst , THE NETHERLANDS +COPYRIGHT (c) 2000-2024 Albert van der Horst , THE NETHERLANDS LICENSE This program is free software; you can redistribute it and/or modify it under the terms of version 2 of the GNU General @@ -8,41 +8,6 @@ Public License as published by the Free Software Foundation. Apart from the GPL you have rights explicitly granted in the document wina.pdf. -DESCRIPTION -Forth is a tool for evolutionary programming. This is the binary -distribution of wina release 5.4.x. -wina is the Windows native version of ciforth (common Intel Forth), an -interpret environment and compiler for Forth. Native is to be -understood that only kernel32.dll facilities are used, no other dll's, -no other facilities, and no registry. -There is a major difference with releases 4.x.x : the interface with -the operating system is no longer DOS but via dll's. In particular -this means that you can import all libraries that are sufficiently -documented at a low level, in particular kernel.dll, and that long -filenames are no longer a problem. -wina is (large and by) compliant with the ISO Forth standard, -the CORE wordset is fully implemented. The small, classic, indirect -threaded kernel contains the essential, i.a. file access and -exceptions. Its power is multiplied by an extensive source library, -that add i.a. a decompiler and integrated 386 assembler. It is fully -self contained; if you want to understand a compiler in all details, -this is your best, if not only, choice. ciforth sports a very high -documentation to binary ratio. -The Forth is 64 or 32 bits, indicated by ## in the following. - -Unpack in the directory where you want to use it by : - pkunzip wina64-5.4.#.zip - -Now you can use wina interactively by : - wina64 - -You can compile a program `hellow.frt' to an executable `hellow.exe': - wina64 -c hellow.frt - -The Forth word defined latest in `hellow.frt' is the entry point. -The library contains facilities to access arguments passed to -a program. - RELEASE CONTENT Don't panic! ciforth is just two files, binary and library. The rest is documentation (plus examples and source). @@ -63,13 +28,26 @@ In the following ## means 64 or 32. 1) Adapt the name of the interpreter. -The latest version and OSX and Linux versions can be fetched via - http://home.hccnet.nl/a.w.m.van.der.horst/ciforth.html +UNPACK AND RUN +Unpack in the directory where you want to use it by : + pkunzip wina64-5.5.#.zip + +Now you can use wina interactively by : + wina32 or - https://github.com/albertvanderhorst/ciforth -(subdirectory releases). -This contains also the generic system that is recommended over -`wina##.fas' if you want to make extensive changes. + wina64 +or + wina +after installation. + +The executables run at once, if they are in the working directory. +After proper installation you can run wina and script's +everywhere. +You can compile a program `hellow.frt' to an executable `hellow.exe': + wina64 -c hellow.frt +The Forth word defined latest in `hellow.frt' is the entry point. +The library contains facilities to access arguments passed to +a program. DOCUMENTATION I The regular documentation is your choice of PostScript, PDF with @@ -87,7 +65,7 @@ After unpacking wina is ready to use, because the library is configured as sitting in the current directory, no path. Installation to a system wide directory is easy : -wina## -i C:\tools\wina##.exe C:\tools\wina.lab %COMSPEC% +wina## -i C:\tools\wina##.exe C:\tools\forth.lab %COMSPEC% If C:\tools is in the PATH , wina## now is usable from anywhere. On a XP system it is recommended to do : @@ -95,6 +73,9 @@ wina## -i C:\WINDOWS\system32\wina##.exe c:\WINDOWS\system32\wina.lab c:\WINDOWS The executable contains its own configuration information. All this is explained in detail in the documentation. +The dictionary is fixed to 4 Megabyte. The -g (grow) options is not +yet available for Microsoft. + If commands like DIR don't work (typically file not found errors), the third parameter, which is the command interpreter, is wrong. It has to agree with the variable ComSpec that can be inspected @@ -106,12 +87,50 @@ This Forth worked on windows version I never used or even heard of! And of course even the simplest manual installation weeds out the wimps. (Forth is not for wimps.) -NOTE +CHECK +If you run lina with -v you can check the version of the +executable and the library. They must agree. + +MODIFICATION The source file wina.fas can be assembled by fasm on MS-Windows 32-bit or 64-bit system, or fasmw. Instructions can be found in the source. +You have to change just one file, ci86.wina##.fas. On a a Linux system fasm can be used, provided that besides the Linux fasm version, the MS-Windows version of fasm must be decompressed to borrow its include subdirectory. The generic system can create the assembler file in gas, nasm or masm format. Linking can be a problem. + +The latest version and OSX and Linux versions can be fetched via + http://home.hccnet.nl/a.w.m.van.der.horst/ciforth.html + +For making extensive changes, such as modifying the header fields or +making a version booting from a hard disk or adapting to a different +assembler, I recommend the compiler factory over modifying the +assembler file. It is present in + https://github.com/albertvanderhorst/ciforth + +PROMOTION +Forth is a tool for evolutionary programming. This is the binary +distribution of wina release 5.# +wina is the Windows native version of ciforth (common Intel Forth), an +interpret environment and compiler for Forth. Native is to be +understood that only kernel32.dll facilities are used, no other dll's, +no other facilities, and no registry. +There is a major difference with releases 4.x.x : the interface with +the operating system is no longer DOS but via dll's. In particular +this means that you can import all libraries that are sufficiently +documented at a low level, in particular kernel.dll, and that long +filenames are no longer a problem. +wina is (large and by) compliant with the ISO Forth standard, +the CORE wordset is fully implemented. The small, classic, indirect +threaded kernel contains the essential, i.a. file access and +exceptions. Its power is multiplied by an extensive source library, +that add i.a. a decompiler and integrated 386 assembler. It is fully +self contained; if you want to understand a compiler in all details, +this is your best, if not only, choice. ciforth sports a very high +documentation to binary ratio. +The Forth is 64 or 32 bits, indicated by ## in the following. + +$Id: READMEwina.txt,v 5.5 2024/04/21 16:22:40 albert Exp $ diff --git a/blocks.frt b/blocks.frt index 5f233e9..d1d0458 100644 --- a/blocks.frt +++ b/blocks.frt @@ -1,4 +1,4 @@ - ciforth lab $Revision: 5.176 $ (c) Albert van der Horst + ciforth lab $Revision: 5.196 $ (c) Albert van der Horst : EMPTY STACK : DICTIONARY FULL : FIRST ARGUMENT MUST BE OPTION @@ -78,7 +78,9 @@ \ -( CONFIG ?LEAVE-SRC ?LEAVE-BLOCK ?16 ?32 ?64 ) \ B9dec03 +( CONFIG ?LEAVE-SRC ?LEAVE-BLOCK ?16 ?32 ?64 ) \ C4apr09 +\ BASE @ 1- 9 <> 13 ?ERROR + DECIMAL : ?LEAVE-SRC IF SRC CELL+ @ PP ! THEN ; : ?LEAVE-BLOCK ?LEAVE-SRC ; @@ -87,15 +89,13 @@ 0 CELL+ DUP 2 = CONFIG ?16 DUP 2 > CONFIG ?32+ DUP 4 = CONFIG ?32 DUP 8 = CONFIG ?64 DROP -ENVIRONMENT CPU PREVIOUS 6 6 * BASE ! DROP +ENVIRONMENT CPU PREVIOUS 36 BASE ! DROP DUP ARMV8 = CONFIG ?ARM - DUP AMDX86 = SWAP 80386 = OR CONFIG ?IL -DECIMAL -WANT ?LI -WANT ?RP1 + DUP AMDX86 = OVER 80386 = OR SWAP 8088. DROP = OR + CONFIG ?IL +WANT CONFIG] +( CONFIG] ?LI ?WI ?OSX ?PC ?MS ?FD ?HD ) -( ?LI ?WI ?OSX ?PC ?MS ?FD ?HD ) \ B9dec03 - WANT CONFIG @@ -110,22 +110,22 @@ WANT ?RP1 "LBAPAR" PRESENT DUP CONFIG ?HD \ Hard disk, modern "SEC-RW" PRESENT DUP CONFIG ?FD \ Floppy or hard disk old OR CONFIG ?SA -( ?RP1 ?OP1 ) \ B9dec03 -WANT CONFIG +( CONFIG] ?RP1 ?OP1 ?RV ) \ C2jul07 +DECIMAL \ For the moment all rasp's are type 1 ( A/B) \ and all oran's are type 1 ( Orange Pi 1+ ) -ENVIRONMENT CPU PREVIOUS 6 6 * BASE ! DROP ARMV8 = DECIMAL +ENVIRONMENT CPU PREVIOUS 36 BASE ! DROP 100 / ARM = DECIMAL 0 CELL+ 2DUP 4 = AND CONFIG ?RP1 2DUP 8 = AND CONFIG ?OP1 2DROP +ENVIRONMENT CPU PREVIOUS 36 BASE ! DROP 0RISCV = DECIMAL + CONFIG ?RV - - - +CREATE CONFIG] ( HELP ) CF: ?HS \ A5dec07 : HELP-WANTED? ." Press space to skip " TYPE ." , other key to confirm" CR KEY BL <> ; @@ -206,12 +206,12 @@ CREATE -syscalls- DECIMAL -( -legacy- $!-BD $S $I PRESENT? REQUIRE ) \ AvdH B9apr01 -\ This will make most old programs run. +( -legacy- $S $I PRESENT? REQUIRE ) \ C3oct2 AvdH +\ In behalf of old ciforth programs. "ALIAS" WANTED '$/ ALIAS $S '$^ ALIAS $I -: $!-BD 2DUP C! 1+ SWAP CMOVE ; + @@ -222,22 +222,38 @@ CREATE -syscalls- DECIMAL -( -legacy- IN >IN REFILL 0>IN ) \ AvdH B5jan7 +( -legacy- IN ) \ AvdH C3oct2 "ALIAS" WANTED \ Fake a parse area that starts at address 0. -'PP ALIAS >IN 'PP ALIAS IN -: SOURCE 0 SCR CELL+ @ ; -\ Set parse pointer at start of line. -: 0>IN BEGIN -1 PP +! PP @ 1- C@ ^J = PP @ SRC @ = OR UNTIL ; -\ Closest match to traditional line by line interpreting. -\ Set parse pointer at start of next line -: REFILL BEGIN PP @ 1- C@ ^J <> PP @ SRC CELL+ @ <> AND WHILE - +1 PP +! REPEAT PP @ SRC CELL+ @ <> ; +'PP ALIAS IN + + + + + + + \ UNCLEAR IF THIS EVER WORKED, KEEP FOR REFERENCE! \ \ Use L_>IN instead of >IN , don't store into it! \ : L_>IN PP @ SRC @ - (>IN) ! (>IN) ; \ 'L_>IN ALIAS >IN +( -traditional- >IN 0>IN ) \ AvdH C3oct2 + "ALIAS" WANTED +\ Fake a parse area that starts at address 0. +'PP ALIAS >IN + +\ Set parse pointer at start of line. +: 0>IN BEGIN -1 PP +! PP @ 1- C@ ^J = PP @ SRC @ = OR UNTIL ; +\ Closest match to traditional line by line interpreting. +\ Set parse pointer at start of next line, +\ e.g. 'next-line ALIAS REFILL +: next-line BEGIN PP @ 1- C@ ^J <> PP @ SRC CELL+ @ <> AND + WHILE +1 PP +! REPEAT PP @ SRC CELL+ @ <> ; + + + + ( -traditional- VOCABULARY ) \ AvdH B5dec01 \ Use replacing vocabularies instead of pushing namespaces. @@ -254,8 +270,11 @@ ALSO \ Start up with two FORTH namespaces. -\ -traditional- WORD FIND (WORD) (PARSE) \ AvdH B8feb11 - "ALIAS" WANTED "$!-BD" WANTED +\ -traditional- WORD FIND (WORD) (PARSE) $!-BD \ C3oct2 AvdH + "ALIAS" WANTED +\ Store a brain-dead string cs into s +: $!-BD 2DUP C! 1+ SWAP CMOVE ; + \ ISO : FIND DUP COUNT PRESENT DUP IF NIP DUP SWAP >FFA @ 4 AND -1 SWAP IF NEGATE THEN THEN ; @@ -267,9 +286,6 @@ ALSO \ Start up with two FORTH namespaces. 'NAME ALIAS (WORD) 'PARSE ALIAS (PARSE) - - - ( -traditional- ?LOADING ?EXEC TRIAD ABORT" ) \ AvdH C2feb22 \ Exceptions on compilation modes. @@ -286,12 +302,12 @@ ALSO \ Start up with two FORTH namespaces. : ABORT" ?COMP POSTPONE " '(ABORT") , ; IMMEDIATE \ -( -traditional- ) \ AvdH B8feb11 +( ) \ AvdH B8feb11 \ This last block belonging to traditional restores \ meta-behaviour that is traditionally expected. WANT INCLUDE-FILE -WANT -plain-control- + @@ -382,12 +398,44 @@ WANT _AH _allocate -( ,, ) \ AvdH B9jul12 -\ Allot sc . -: ,, HERE SWAP DUP ALLOT MOVE ; +( *s /s fix-scale -fixedpoint- ) \ AvdH C3nov06 +WANT ALIAS +8 CELLS 4 - CONSTANT fix-scale \ n represents n.2^-scale. +1 fix-scale LSHIFT CONSTANT 1/1 +1 fix-scale 1- LSHIFT CONSTANT 1/2 +\ As */ * / but scaled. +: */s >R UM* R> UM/MOD NIP ; +: *s 1/1 */s ; : /s 1/1 SWAP */s ; +\ Most other operators remain the same: +'+ ALIAS +s '- ALIAS -s '*/ ALIAS */s +\ For a RATIO (n/d) return an equivalent scaled NUMBER. +'/s ALIAS rat>s \ By accident. +\ Print a scaled double number +: .mantissa 0 DO BASE @ 1/1 */MOD &0 + EMIT LOOP DROP SPACE ; +: _D.s 1/1 UM/MOD 0 <# #S #> TYPE &. EMIT 20 .mantissa ; +: U.s 0 _D.s ; +( DSQRT SQRTs HYPOs -fixedpoint- ) \ AvdH C3oct10 +WANT *s + +\ For DOUBLE return FLOOR of its square root +: DSQRT 2DUP OR 0= IF DROP EXIT THEN + DUP IF -1 1 RSHIFT ELSE 1000 THEN >R + BEGIN 2DUP R@ SM/REM R@ + 1 RSHIFT DUP R@ < WHILE + RDROP >R DROP REPEAT + 2DROP 2DROP R> ; +: SQRTs 1/1 UM* DSQRT ; +: SQs DUP *s ; +\ For AS BS sides of rectangular triangle return hypothenusa CS +: HYPOs DUP UM* ROT DUP UM* D+ DSQRT ; +\ +( ,, CELL ) \ AvdH C3nov05 +\ Allot sc . +: ,, HERE SWAP DUP ALLOT MOVE ; +\ Complements CELL+ CELLS +0 CELL+ CONSTANT CELL @@ -414,23 +462,23 @@ WANT _AH _allocate -( NOT 0<> >= <= UMIN U> ) \ AvdH B5Mar9 +( NOT 0<> >= <= UMIN U> U.R ) \ AvdH C3Nov05 "ALIAS" WANTED -'0= ALIAS NOT : 0<> 0= NOT ; -: >= < NOT ; : <= > NOT ; +'0= ALIAS NOT \ Not ISO + : 0<> 0= NOT ; \ ISO +: U> SWAP U< ; \ ISO +: U.R SWAP 0 D.R ; \ ISO + + \ The remainder of the words are not ISO : UMIN 2DUP U< IF SWAP THEN NIP ; : UMAX 2DUP U< IF SWAP THEN DROP ; -: U> SWAP U< ; - - - - +: >= < NOT ; : <= > NOT ; -( D0= D0<> D0< D= D< D- M+ DRSHIFT DLSHIFT DU< ) \ AvdH B6Mar22 +( D0= D0<> D0< D= D< D- M+ DRSHIFT DLSHIFT DU< ) \ AvdH C4Apr12 "NOT" WANTED "0<>" WANTED : D0= OR 0= ; : D0<> OR 0<> ; @@ -439,22 +487,22 @@ WANT _AH _allocate : DU< ROT 2DUP <> IF U> NIP NIP ELSE 2DROP U< THEN ; : D> 2SWAP D< ; : D>= D< NOT ; : D<= D> NOT ; -: DLSHIFT >R SWAP DUP R@ LSHIFT SWAP 8 CELLS R@ - RSHIFT ROT R> - LSHIFT OR ; -: DRSHIFT >R DUP R@ RSHIFT SWAP 8 CELLS R@ - LSHIFT ROT R> - RSHIFT OR SWAP ; +: DLSHIFT 0 ?DO 2DUP D+ LOOP ; + +: DRSHIFT 0 ?DO 2 UDM/MOD ROT DROP LOOP ; + -: M+ S>D D+ ; -( PARSE-NAME SAVE-INPUT EXECUTE-PARSING --> ) \ B6oct16 +: M+ S>D D+ ; +( PARSE-NAME SAVE-INPUT ) \ AvdH C3oct2 "ALIAS" WANTED - \ New standard proposed -: EXECUTE-PARSING ROT ROT SAVE SET-SRC CATCH RESTORE THROW ; + + \ Remainder are all ISO words. : SAVE-INPUT SRC 2@ PP @ 3 ; : RESTORE-INPUT DROP PP ! SRC 2! -1 ; -: --> BLK @ DUP UNLOCK 1+ DUP LOCK - BLOCK B/BUF SET-SRC ; IMMEDIATE + + 'NAME ALIAS PARSE-NAME @@ -526,7 +574,7 @@ CURRENT @ 'ONLY >WID CURRENT ! '3 DUP ALIAS Y DUP ALIAS Z DROP CURRENT ! \ Use 'ONLY >WID CURRENT ! instead of DEFINITIONS -( TUCK -ROT PICK ROLL CS-ROLL AHEAD ) \ AvdH B6nov11 +( TUCK -ROT PICK ROLL CS-ROLL AHEAD ) \ C2Dec28 AvdH \ Obscure stack manipulations. : PICK 1+ CELLS DSP@ + @ ; \ ISO : TUCK SWAP OVER ; \ ISO @@ -534,15 +582,15 @@ DROP CURRENT ! : ROLL 1+ >R DSP@ DUP CELL+ R> 2 - CELLS \ ISO 2DUP + @ >R CELL+ MOVE DROP R> ; -\ -pedantic- required when used with DO-LOOP + : CS-ROLL 2* 1+ DUP >R ROLL R> ROLL ; \ ISO -: AHEAD 'BRANCH , (FORWARD ; IMMEDIATE \ ISO +: AHEAD 'BRANCH , (FORWARD 2 ; IMMEDIATE \ ISO -( -plain-control- ) \ AvdH B9jun22 +( -plain-control- ) \ C2Dec28 AvdH ( 'AHEAD HIDDEN ) : AHEAD 'BRANCH , (FORWARD ; IMMEDIATE 'IF HIDDEN : IF '0BRANCH , (FORWARD ; IMMEDIATE 'ELSE HIDDEN : ELSE 'BRANCH , (FORWARD SWAP FORWARD) ; @@ -555,8 +603,8 @@ DROP CURRENT ! 'UNTIL HIDDEN : UNTIL '0BRANCH , BACK) ; IMMEDIATE 'DO HIDDEN : DO '(DO) , (FORWARD (BACK ; IMMEDIATE '?DO HIDDEN : ?DO '(?DO) , (FORWARD (BACK ; IMMEDIATE -'+LOOP HIDDEN : +LOOP - '(+LOOP) , '0BRANCH , BACK) 'UNLOOP , FORWARD) ; IMMEDIATE +'+LOOP HIDDEN : +LOOP '(+LOOP) , '0BRANCH , BACK) 'UNLOOP , + FORWARD) ; IMMEDIATE : CS-ROLL ROLL ; 'LOOP HIDDEN : LOOP '1 , POSTPONE +LOOP ; IMMEDIATE ( 2>R 2R> 2R@ 2CONSTANT 2VARIABLE ) \ AvdH C1Apr21 @@ -606,7 +654,7 @@ DATA CR$ 1 , ^J C, \ Write a line from BUFFER COUNT characters to HANDLE. \ Leave actual ERROR. : WRITE-LINE '(WRITE-LINE) CATCH DUP IF >R 2DROP DROP R> THEN ; -( INCLUDE-FILE include ) \ AvdH B7dec20 +( -traditional- INCLUDE-FILE include ) \ C3Nov05 AvdH WANT R/W READ-LINE VARIABLE SOURCE-ID 0 SOURCE-ID ! @@ -620,7 +668,7 @@ VARIABLE SOURCE-ID 0 SOURCE-ID ! SOURCE-ID @ NEGATE DUP LOCK (BUFFER) 2 CELLS + SRC ! '(INCLUDE-FILE) CATCH SOURCE-ID @ NEGATE UNLOCK RESTORE R> SOURCE-ID ! THROW ; -: include NAME R/W OPEN-FILE THROW DUP >R +: include NAME R/O OPEN-FILE THROW DUP >R 'INCLUDE-FILE CATCH R> CLOSE-FILE SWAP THROW THROW ; ( COMPARE $= BOUNDS ALIGN UNUSED ) \ AvdH A1oct04 \ ISO @@ -718,12 +766,13 @@ DATA _value_jumps '@ , '! , '+! , @ EXECUTE FROM ; -( LOCAL ) \ AHCH B6jan23 -WANT VALUE {{ BAG DO-BAG +( LOCAL ) \ AHCH C3dec20 +\ These local's cannot be used recursively +WANT VALUE [{ BAG DO-BAG 16 BAG _locals _locals !BAG -: LOCAL POSTPONE {{ _ VALUE }} +: LOCAL POSTPONE [{ _ VALUE }] POSTPONE TO LATEST >LFA @ DUP _locals BAG+! POSTPONE LITERAL POSTPONE EXECUTE ; IMMEDIATE @@ -733,7 +782,6 @@ WANT VALUE {{ BAG DO-BAG IMMEDIATE - ( ORDER .WID .VOCS ) \ AvdH B9jan22 \ Print all namespace (voc) names in existence. : .VOCS 'ID. FOR-VOCS ; @@ -766,6 +814,54 @@ PREVIOUS DEFINITIONS "[7m" esc-seq REVERSE : PAGE HOME CLEAR ; \ ISO : AT-XY 1+ SWAP 1+ SWAP "%e [%dd ;%dd H" .FORMAT ; \ ISO +( -color- ESCAPE-COLOR ) \ AvdH C3oct08 +WANT ,, ESC +CREATE ESCAPE-COLOR ESC C, &[ C, HERE &4 C, &9 C, &; C, + HERE &3 C, &7 C, &; C, &1 C, &m C, +CONSTANT ESCAPE-FORE CONSTANT ESCAPE-BACK +: FORE-COLOR 0 <# # # #> CREATE ,, DOES> + 2 ESCAPE-FORE SWAP CMOVE ESCAPE-COLOR 10 TYPE ; +: BACK-COLOR 0 <# # # #> CREATE ,, DOES> + 2 ESCAPE-BACK SWAP CMOVE ESCAPE-COLOR 10 TYPE ; + + + + + + + +( -color- default-bw red bred ) \ AvdH C3oct08 +\ Set the foreground color of the screen in a loop. +: (f-c)s 0 DO DUP FORE-COLOR 1+ LOOP DROP ; +30 8 (f-c)s black red green yellow blue pink aqua grey + +\ Set the background color of the screen in a loop. +: (b-c)s 0 DO DUP BACK-COLOR 1+ LOOP DROP ; +40 10 (b-c)s bblack bred bgreen byellow bblue bpink baqua + bgrey b48 bwhite + +\ This is sufficient to reset colors to regular B&W +: default-bw ESC EMIT "[00m" TYPE ; + + + +\ +( EKEY ) \ AvdH C3oct08 +\ Assume that the next key is immediately available. +: EKEY KEY BEGIN KEY? WHILE 8 LSHIFT KEY OR REPEAT ; + + + + + + + + + + + + +\ ( BAG !BAG BAG? BAG+! BAG@- BAG-REMOVE BAG-HOLE BAG-INSERT ) \ Warning uses $@ as as @+ ( Build a bag with X items. ) @@ -1212,7 +1308,7 @@ VARIABLE SEED HEX ( RANDOM-SWAP ( R N -- ) -( 1 - CHOOSE 1+ CELLS OVER + @SWAP ;) DECIMAL +( 1 - CHOOSE 1+ CELLS OVER + @SWAP ) DECIMAL RANDOMIZE ( RAND ) CF: ?64 \ EDN 1991JAN21, pg 151 \ AvdH B2aug12 "TICKS" WANTED HEX @@ -1262,6 +1358,22 @@ We put here also reference implementations. +( TOKEN delimiters ) \ AvdHC4jan09 +\ Avoid nesting: : 0<> 0= 0= ; : NOT 0= ; +\ Characters ending previous token, in addition to blank. +DATA delimiters 0 , 128 ALLOT +\ For a char return : a token may start with this. +: ?START delimiters $@ ROT $^ 0= 0= ; +\ Return token , a string constant. +\ A name now starts with the next non-blank, but ends on a +\ blank or delimiter. Leaves token (a string constant). +\ If ?START leaves TRUE (-1), then `PP must backed up +\ because it points past not to the delimiter. +: TOKEN + _ BEGIN DROP PP@@ ?BLANK 0= OVER SRC CELL+ @ = OR UNTIL + _ _ BEGIN 2DROP PP@@ DUP ?BLANK OVER ?START OR UNTIL + ( -- start end char ) ?START PP +! OVER - ; +'TOKEN 'NAME 3 CELLS MOVE ( IMPORT GET-NAME ) \ AvdHC1apr18 WANT ALIAS \ Get a name from the input stream without advancing PP. @@ -1326,14 +1438,13 @@ TRIM \ -( DEPTH $@ $! $+! $C+ ) \ AvdH B5feb27 -: DEPTH S0 @ DSP@ - [ 0 CELL+ ] LITERAL / 1- ; +( $@ $! $, $+! $C+ ) \ C3oct2 AvdH \ Fetch a constant string c from s : $@ ( s -- cs ) DUP CELL+ SWAP @ ; \ Store a constant string cs into s : $! ( cs s -- ) 2DUP ! CELL+ SWAP CMOVE ; -\ Store a brain-dead string cs into s -: $!-BD ( cs s -- ) 2DUP C! 1+ SWAP CMOVE ; +\ Store a constant string cs in the dictionary. +: $, HERE >R DUP CELL+ ALLOT R@ $! R> ALIGN ; \ Append a constant string cs to s : $+! ( cs s -- ) DUP @ >R 2DUP +! CELL+ R> CHARS + SWAP CMOVE ; @@ -1342,25 +1453,25 @@ TRIM 1 R> +! ; -( OBSOLETE L! L@ ) \ AvdH A6may13 -\ Use of these words in modern programs, i.e. released -\ after 2006 may, may be risky. -\ ``want L!'' may not work, because L! is defined as 32 bit -\ : L! FAR! ; -\ : L@ FAR@ ; - +( $^ $/ $V $\ ) \ C3oct2 AvdH +\ Find a char in cs, return addr , forward ( cs c -- ad) +: $^ >R OVER 0= 0= AND OVER + SWAP BEGIN 2DUP <> WHILE DUP C@ + R@ = IF RDROP NIP EXIT THEN 1+ REPEAT RDROP 2DROP 0 ; +\ Split on boundary ( cs boundary -- first second ) +: ($\) >R OVER R@ SWAP - SWAP OVER - 1- R> 1+ SWAP ; +\ See glossary ( cs c -- cs2 cs1 ) +: $/ >R 2DUP R> $^ DUP IF ($\) ELSE 0 THEN 2SWAP ; +\ Find a char in cs, return addr , backward ( cs c -- ad) +: $V >R OVER 0= 0= AND OVER + BEGIN 2DUP <> WHILE 1- DUP C@ + R@ = IF RDROP NIP EXIT THEN REPEAT RDROP 2DROP 0 ; +\ As $\ backward. ( cs c -- cs1 cs2 ) +: $\ >R 2DUP R> $V DUP IF ($\) ELSE 0 2SWAP THEN ; - - - - -\ -( $-PREFIX #-PREFIX ESC ) \ AvdH A1apr15 - - +( 0x $-PREFIX #-PREFIX ESC ) \ C2Dec28 AvdH +WANT ALIAS \ ONLY DEFINITIONS ... PREVIOUS doesn't work because ONLY \ terminates the search order. @@ -1368,20 +1479,21 @@ TRIM \ Define $ as a prefix for hex. : $ BASE @ >R HEX (NUMBER) R> BASE ! POSTPONE SDLITERAL ; PREFIX IMMEDIATE +'$ ALIAS 0x \ Define # as a prefix for decimal. : # BASE @ >R DECIMAL (NUMBER) R> BASE ! POSTPONE SDLITERAL ; PREFIX IMMEDIATE DEFINITIONS $1B CONSTANT ESC -( +THRU ) \ AvdH A1oct05 +( -traditional- +THRU ) \ C3oct02 AvdH \ Load current block plus N1 to current block plus N2. : +THRU SRC @ 2 CELLS - @ >R R@ + SWAP R> + SWAP THRU ; - - +: --> BLK @ DUP UNLOCK 1+ DUP LOCK + BLOCK B/BUF SET-SRC ; IMMEDIATE @@ -1470,22 +1582,22 @@ $1B CONSTANT ESC \ -( TICKS PAST? ) CF: ?64 ?IL \ AvdH C2mar25 -\ We can't use the assembler in 64 bits. - "ASSEMBLER" WANTED HEX \ Just for using CODE - -CODE (TICKS) - 0F C, 31 C, \ RDTSC, - 50 C, 52 C, \ PUSH|X, AX| PUSH|X, DX| - 48 C, AD C, FF C, 20 C, \ NEXT, -END-CODE \ Code now in 2 32 bit things. +( TICKS PAST? ) CF: ?64 ?IL \ C3oct AvdH +\ AMD has RDSTSC available + "ASSEMBLERi86-HIGH" WANTED HEX + +\ Code now in 2 32 bit halves. +CODE (TICKS) RDTSC, PUSH|X, AX| PUSH|X, DX| NEXT, END-CODE \ Leave a DOUBLE value. : TICKS (TICKS) 20 LSHIFT OR 0 ; - +TRIM \ For a TIME in ticks: it IS in the past. : PAST? DNEGATE TICKS D+ NIP 0< 0= ; DECIMAL + + + ( TICKS PAST? ) CF: ?32 ?IL \ AvdH C2mar25 \ Assuming we run on an 486 or better, and a 32 bits Forth "ASSEMBLERi86-HIGH" WANTED HEX @@ -1751,38 +1863,38 @@ HEX "DROP-WORD" WANTED : ARGC ARG$ DUP 0 DO DUP 0= IF I LEAVE THEN DROP-WORD LOOP >R 2DROP R> ; \ Find argument INDEX, counting from one. Return as a STRING. -: ARG[] >R ARG$ R@ 1 < 0D ?ERROR +: ARG[] >R ARG$ R@ 0 < 0D ?ERROR R> 0 ?DO DROP-WORD LOOP -LEADING BL $/ 2SWAP 2DROP ; \ Shift the arguments, so as to remove argument 1. Keep cr! : SHIFT-ARGS ARG$ DROP-WORD DROP ARGS ! ; DECIMAL -( SRC>EXEC ) CF: ?WIMS \ AvdH B1aug16 -HEX +( SRC>EXEC _exename ) CF: ?WIMS \ AvdH C4apr21 +WANT ARG[] +DATA __pad 1024 ALLOT \ Given a source file NAME, return the binary file NAME. -: SRC>EXEC PAD $! PAD $@ + 4 - >R - R@ 4 + R@ 1 + DO I C@ 20 INVERT AND I C! LOOP \ Uppercase - R> ".FRT" CORA IF "AOUT.EXE" ELSE - -4 PAD +! ".EXE" PAD $+! PAD $@ THEN ; -DECIMAL - - - - +: SRC>EXEC &. $\ 2DROP __pad $! + ".EXE" __pad $+! __pad $@ ; +\ Get the executables name. +: _exename 0 ARG[] &" $/ DUP 0= IF 2DROP &" $/ THEN 2SWAP 2DROP + 2DUP &. $\ 3 <> NIP NIP SWAP 0= OR IF + $, DUP 1 ALLOT ALIGN ".EXE" ROT $+! $@ THEN ; +\ For buffer return the start of Forth + : BM' BEGIN DUP @ BM @ <> WHILE 1+ REPEAT ; \ -( SRC>EXEC ) CF: ?HS \ AvdH A3mar20 - +( SRC>EXEC _exename ) CF: ?LI \ AvdH C4apr21 +WANT ARG[] \ Given a source file NAME, return the binary file NAME. : SRC>EXEC 4 - 2DUP + ".frt" CORA IF 2DROP "a.out" THEN ; +: _exename 0 ARG[] ; - - - +\ For buffer return the start of Forth + : BM' BEGIN DUP @ BM @ <> WHILE 1+ REPEAT ; @@ -1870,54 +1982,54 @@ DECIMAL -( SAVE-SYSTEM TURNKEY ) CF: ?WI ?32 HEX \ AvdH B1oct1 -: _BOOT-SECTION BM 2000 - BM 400 - 200 MOVE ; -: _KERNEL-SECTION BM 1000 - BM 200 - 200 MOVE ; -: _FIXUP SAVE >R \ Fix up the kernel section at ADDRESS - R@ 0C + @ 1000 - R@ + DUP 200 + 1FF INVERT AND - OVER - SET-SRC NAME 2DROP R@ 10 + @ 1000 - R@ + - BEGIN NAME WHILE 2 - 1000 + R@ - OVER ! - CELL+ REPEAT DROP RDROP RESTORE ; -: SAVE-USER-VARS U0 @ 0 +ORIGIN 40 CELLS MOVE ; -: INCREMENT HERE 'DP >DFA @ +ORIGIN @ 'TASK DROP - ; -: SAVE-SYSTEM ( Save the system in a file with NAME ) - >R >R _BOOT-SECTION INCREMENT BM 400 - 1B0 + +! - _KERNEL-SECTION BM 200 - _FIXUP SAVE-USER-VARS - BM 400 - HERE OVER - 200 + R> R> PUT-FILE ; -: TURNKEY ( Save a system to do ACTION in a file witH NAME .) - ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; DECIMAL -( SAVE-SYSTEM TURNKEY ) CF: ?WI ?64 HEX \ AvdH B1oct1 -: _BOOT-SECTION BM 2000 - BM 600 - 200 MOVE ; -: _KERNEL-SECTION BM 1000 - BM 400 - 400 MOVE ; -: _FIXUP SAVE >R \ Fix up the kernel section at ADDRESS - R@ 0C + L@ 1000 - R@ + DUP 400 + 1FF INVERT AND - OVER - SET-SRC NAME 2DROP R@ 10 + @ 1000 - R@ + - BEGIN NAME WHILE 2 - 1000 + R@ - OVER ! - CELL+ REPEAT DROP RDROP RESTORE ; : L+! >R R@ L@ + R> L! ; -: SAVE-USER-VARS U0 @ 0 +ORIGIN 40 CELLS MOVE ; -: INCREMENT HERE 'DP >DFA @ +ORIGIN @ 'TASK DROP - ; -: SAVE-SYSTEM ( Save the system in a file with NAME ) - >R >R _BOOT-SECTION INCREMENT BM 600 - 1C0 + L+! - _KERNEL-SECTION BM 400 - _FIXUP SAVE-USER-VARS - BM 600 - HERE OVER - 200 + R> R> PUT-FILE ; -: TURNKEY ( Save a system to do ACTION in a file witH NAME .) - ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; DECIMAL -( SAVE-SYSTEM TURNKEY ) CF: ?WI HEX \ AvdH B1oct1 -: _BOOT-SECTION BM 2000 - BM 400 - 200 MOVE ; -: _KERNEL-SECTION BM 1000 - BM 200 - 200 MOVE ; -: _FIXUP SAVE >R \ Fix up the kernel section at ADDRESS - R@ 0C + @ 1000 - R@ + DUP 200 + 1FF INVERT AND - OVER - SET-SRC NAME 2DROP R@ 10 + @ 1000 - R@ + - BEGIN NAME WHILE 2 - 1000 + R@ - OVER ! - CELL+ REPEAT DROP RDROP RESTORE ; -: SAVE-USER-VARS U0 @ 0 +ORIGIN 40 CELLS MOVE ; -: INCREMENT HERE 'DP >DFA @ +ORIGIN @ 'TASK DROP - ; -: SAVE-SYSTEM ( Save the system in a file with NAME ) - >R >R _BOOT-SECTION INCREMENT BM 400 - 1B0 + +! - _KERNEL-SECTION BM 200 - _FIXUP SAVE-USER-VARS - BM 400 - HERE OVER - 200 + R> R> PUT-FILE ; -: TURNKEY ( Save a system to do ACTION in a file witH NAME .) - ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; DECIMAL +( SAVE-SYSTEM TURNKEY ) CF: ?WI \ AvdH C4apr15 +\ The magic number marking the start of an MZ header +HEX CREATE MAGIC &M C, &Z C, 80 C, 0 C, +\ Return the start of the ``MZ'' header. + : SM BM BEGIN DUP MAGIC 4 CORA WHILE 1- REPEAT ; +\ Save user variables into the bootup block. +: SAVE-USER-VARS U0 @ 0 +ORIGIN MAX-USER @ CELLS MOVE ; +: _PE PAD CELL+ DUP 2 + @ 0FFFF AND + ; + + + + + + + +DECIMAL +( SAVE-SYSTEM TURNKEY ) CF: ?WI ?64 \ AvdH C4apr21 +"_exename" WANTED HEX +: _isz1 _PE 20 + ; : _isz2 _PE 118 + ; \ field image size +: _ladr1 _PE 30 + ; : _ladr2 _PE 12A + ; \ field load address +\ Save the system with $name . +: SAVE-SYSTEM SAVE-USER-VARS + BM HERE OVER - \ get new executable + _exename GET-FILE \ get old binary + DROP DUP BM' ( DUP DP ! ) OVER - \ trim to header + PAD $! PAD $+! PAD $@ \ collate + DUP _isz1 L! DUP _isz2 L! \ SM _ladr1 L! SM _ladr2 L! + 1000 / 1+ 1000 * 2SWAP PUT-FILE ; +\ Save a system to do action in a file with $name . +: TURNKEY ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; + +DECIMAL +( SAVE-SYSTEM TURNKEY ) CF: ?WI ?32 HEX \ AvdH C4apr21 +"_exename" WANTED HEX +: _isz1 _PE 20 + ; : _isz2 _PE 108 + ; \ field image size +: _ladr1 _PE 34 + ; : _ladr2 _PE 11A + ; \ field load address +\ Save the system with $name . +: SAVE-SYSTEM SAVE-USER-VARS + BM HERE OVER - \ get new executable + _exename GET-FILE \ get old binary + DROP DUP BM' ( DUP DP ! ) OVER - \ trim to header + PAD $! PAD $+! PAD $@ \ collate + DUP _isz1 ! DUP _isz2 ! \ SM _ladr1 !SM _ladr2 ! + 1000 / 1+ 1000 * 2SWAP PUT-FILE ; +\ Save a system to do action in a file with $name . +: TURNKEY ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; + +DECIMAL ( SAVE-SYSTEM TURNKEY ) CF: ?LI ?32 HEX \ AvdH \ The magic number marking the start of an ELF header CREATE MAGIC 7F C, &E C, &L C, &F C, @@ -1973,8 +2085,8 @@ DECIMAL HERE BM - D-SIZE ! \ Fill in dict size (.text) U0 @ 0 +ORIGIN 40 CELLS MOVE \ Save user variables) \ Now write it. Consume NAME here. - SM HERE OVER - 2SWAP PUT-FILE ; - + SM HERE OVER - + 1000 / 1+ 1000 * 2SWAP PUT-FILE ; \ Save a system to do ACTION in a file with NAME . : TURNKEY ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; @@ -2004,8 +2116,8 @@ _ph_offset CELL+ CONSTANT _sof : SAVE-SYSTEM _prepare_header _correct_size U0 @ 0 +ORIGIN 40 CELLS MOVE \ Save user variables) \ Now write it. Consume NAME here. - SM HERE OVER - 2SWAP PUT-FILE ; - + SM HERE OVER - + 1000 / 1+ 1000 * 2SWAP PUT-FILE ; \ Save a system to do ACTION in a file with NAME . : TURNKEY ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; @@ -2045,7 +2157,7 @@ VARIABLE HEAD-DP \ Fill in pointer 0 SIZE RESTORE-NAME PUT-FILE RESTORE-PSP ; DECIMAL \ Actually this is the same than in Linux. \ Save a system to do SOMETHING in a file with NAME . -: TURNKEY ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; +: TURNKEY ROT >DFA @ 'ABORT >DFA ! SAVE-SYSTEM BYE ; ( CTA aux_for_threads ) \ AvdH B6jan23 \ Fails unless kernel prepared for threads WANT TASK-SIZE @@ -2174,7 +2286,7 @@ TASK-TABLE !BAG _ TASK-TABLE BAG+! SET-FIRST-TASK 'EXIT-COT >DFA @ R@ CELL+ CELL+ ! R> TASK-TABLE BAG+! ; \ -\ LINK-LATEST (( (s ({) :) \ AvdH B5feb11 +\ LINK-LATEST (( (s ({) (}) ([) (]) \ AvdH C3oct2 \ Isolate the latest word from the dictionary. Leave its DEA. : UNLINK-LATEST LATEST CURRENT @ >LFA DUP @ >LFA @ SWAP ! ; \ Link DEA into the dictionary, as the latest. @@ -2188,9 +2300,9 @@ TASK-TABLE !BAG _ TASK-TABLE BAG+! SET-FIRST-TASK \ (s s) save and restore STATE. : (s STATE @ ; : s) STATE ! ; \ Nest definitions -: ;) CSP @ UNLINK-LATEST 0 STATE ! ; -: (: LINK-LATEST CSP ! ; -( { } ) \ B8feb26 AvdH +: ([) CSP @ UNLINK-LATEST 0 STATE ! ; +: (]) LINK-LATEST CSP ! ; +( { } ) \ AvdH C3jan22 \ Denotation for lambda, ends with `} : { 'SKIP , (FORWARD HERE 'TASK @ , HERE CELL+ , @@ -2198,20 +2310,22 @@ TASK-TABLE !BAG _ TASK-TABLE BAG+! SET-FIRST-TASK : } '(;) , STATE ! >R FORWARD) R> POSTPONE LITERAL ; IMMEDIATE +\ : { (( (s ({) ; IMMEDIATE +\ : } >R (}) s) )) R> 'LITERAL EXECUTE ; IMMEDIATE +\ : [ (( (s [[) ; IMMEDIATE +\ : ] (]) s) )) ; IMMEDIATE - - - - -( [: ;] ) \ AvdH C1apr18 +( [: ;] EXECUTE-PARSING ) \ AvdH C3oct2 WANT ALIAS { '{ ALIAS [: \ ISO'12 '} ALIAS ;] \ ISO'12 +\ ISO'12 +: EXECUTE-PARSING ROT ROT SAVE SET-SRC CATCH RESTORE THROW ; @@ -2220,10 +2334,8 @@ WANT ALIAS { - - -( {{ }} [{ }] {{{ }}} ) \ AHCH B8feb17 -WANT UNLINK-LATEST ALIAS { +( [{ }] ) \ AvdH C3apr04 +WANT LINK-LATEST \ New context for definitions, maybe in the middle of a word. : [{ POSTPONE SKIP (FORWARD R> CSP @ >R DPL @ >R UNLINK-LATEST >R STATE @ >R @@ -2231,18 +2343,18 @@ WANT UNLINK-LATEST ALIAS { : }] FORWARD) R> R> STATE ! R> LINK-LATEST R> DPL ! R> CSP ! >R ; -'[{ ALIAS {{ '}] ALIAS }} \ For now, my version -\ Compact version of :NONAME .. ; not linked in. -: {{{ HERE 'TASK @ ( docol) , HERE CELL+ , ] ; -: }}} '(;) , POSTPONE [ ; IMMEDIATE +\ Previously named {{ }} + -( NESTED-COMPILE ) \ AvdH B5feb11 -WANT LINK-LATEST +( NESTED-COMPILE ) \ AvdH B5feb11 +WANT LINK-LATEST +\ This is used for AUTO-LOAD recovery where there is +\ an error in the middle of a word. @@ -2273,7 +2385,7 @@ DECIMAL \ LATEST-WORD (WORD-BACK) \ A2oct28 AvdH \ Trim a possible leading &' from a word. : TRIM' OVER C@ &' = IF 1- SWAP 1+ SWAP THEN ; -\ Fpr POINTER into/past word, return START of word. +\ For POINTER into/past word, return START of word. : (WORD-BACK) BEGIN 1- DUP C@ ?BLANK 0= UNTIL 1+ BEGIN 1- DUP C@ ?BLANK UNTIL 1+ ; \ Return SC the latest word in the input. @@ -2430,15 +2542,15 @@ Tools and utilities : break SAVE BEGIN '(ACCEPT) CATCH DUP -32 <> WHILE ?ERRUR SET-SRC INTERPRET REPEAT DROP RESTORE ; \ End by ^D DO-DEBUG -( DO-SECURITY NO-SECURITY NO-SECURITY: ) \ AH B2jun15 +( -traditional- DO-SECURITY NO-SECURITY NO-SECURITY: ) \ C3oct2 +\ Installs NO-SECURITY by default. "RESTORED" WANTED -\ + \ Want a high level definition, to replace ?PAIRS : ?NO-PAIRS 2DROP ; \ Install and de-install the security : NO-SECURITY '?NO-PAIRS >DFA @ '?PAIRS >DFA ! ; - : DO-SECURITY '?PAIRS RESTORED ; \ Install no-security with automatic recovery. @@ -2478,7 +2590,7 @@ NO-SECURITY -( C=-IGNORE CORA-IGNORE ~MATCH-IGNORE CI-DIGIT )\ AvdH B7dec22 +( C=-IGNORE CORA-IGNORE ~MATCH-IGNORE CI-DIGIT )\ AvdH C2jan17 HEX \ Characters ONE and TWO are equal, ignoring case. : C=-IGNORE DUP >R XOR DUP 0= IF 0= ELSE @@ -2490,10 +2602,10 @@ HEX \ Caseinsensitive version of ~MATCH : ~MATCH-IGNORE >R 2DUP R@ >NFA @ $@ ROT MIN CORA-IGNORE R> SWAP ; -\ Case-insensitive alternative for DIGIT -: CI-DIGIT SWAP 20 OR "0123456789abcdefghijklmnopqrstuvwxyz" - OVER >R ROT $^ R> - SWAP OVER > ; -DECIMAL +\ Case-insensitive alternative for DIGIT , till base 0x24. +: CI-DIGIT >R DUP &a &z 1+ WITHIN 20 AND XOR + "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" + OVER >R ROT $^ R> - DUP R> 24 MIN U< ; DECIMAL ( CASE-INSENSITIVE CASE-SENSITIVE ) \ AvdH B8feb7 WANT ~MATCH-IGNORE CI-DIGIT RESTORED @@ -2558,7 +2670,7 @@ VARIABLE L : SUPER-QUAD CONDENSED SUPER-DUPE 2 + SUPER-DUPE DROP ; -( FOR-BLOCKS SHOW-BLOCK .BL Testing_of_block ) \ AvdH A1oct09 +( FOR-BLOCKS SHOW-BLOCK .BL Testing_of_block ) \ AvdH C3oct2 "H." WANTED : FOR-BLOCKS >R _PREV @ BEGIN DUP R@ EXECUTE +BUF WHILE REPEAT R> DROP DROP ; @@ -2567,13 +2679,13 @@ VARIABLE L DUP CR H. DUP @ IF ." #" DUP ? - CELL+ DUP @ IF ." LOCKED" ELSE ." NOT LOCKED" THEN + CELL+ DUP @ 1 <> IF ." LOCKED" ELSE + ." NOT LOCKED" THEN CELL+ &| EMIT 50 TYPE &| EMIT ELSE ." FREE " DROP THEN ; : .BL 'SHOW-BLOCK FOR-BLOCKS ; - ( DB-INSTALL DB-UNINSTALL Show_block_properties) \ AvdH A1oc08 "ALIAS" WANTED : .CON &| EMIT 48 TYPE &| EMIT ; @@ -2638,16 +2750,16 @@ WANT SEE -( SEE -see2-simple-decompilers- ) \ AvdH B5Feb24 +( SEE -see2-simple-decompilers- ) \ AvdH C3OOct23 \ all -words: ( dip --dip' ) decompile pointer : -do CR ." DO " CELL+ CELL+ ; '(DO) by: -do : -qdo CR ." ?DO " CELL+ CELL+ ; '(?DO) by: -qdo : -pl CR ." +LOOP " 4 CELLS + ; '(+LOOP) by: -pl -: -pc CR ." ;CODE plus code (suppressed)" - ( DIRTY TRICK : make decompile pointer point to exit!) - DROP 'TASK >DFA @ ; ' (;CODE) by: -pc +\ : -pc CR ." ;CODE plus code (suppressed)" +\ ( DIRTY TRICK : make decompile pointer point to exit!) +\ DROP 'TASK >DFA @ ; ' (;CODE) by: -pc @@ -2671,8 +2783,6 @@ WANT SEE ( SEE -see4-auxiliary- ) -( For the DEA : it IS immediate / it IS a denotation ) -: ?IM >FFA @ 4 AND ; : ?DN >FFA @ 8 AND ; \ For DEA1 get DEA2 the word defined later then DEA1 : NEXT-DEA CURRENT @ BEGIN ( CR DUP ID.) 2DUP >LFA @ <> @@ -2686,6 +2796,8 @@ WANT SEE + + ( SEE -see5-does-objecten- ) \ For ADR: it IS a dea (heuristically). : HEAD? DUP >DFA @ SWAP >PHA = ; @@ -2719,6 +2831,8 @@ WANT BAG BAG-WHERE DUP @ 0< IF CR ." BEGIN " ELSE ." THEN " CR THEN targets BAG-REMOVE _ THEN DROP ( targets .BAG ) ; ( SEE -see6b-colon- ) +( For the DEA : it IS immediate / it IS a denotation ) +: ?IM >FFA @ 4 AND ; : ?DN >FFA @ 8 AND ; ( dip -- dip ) : ITEM DUP @ SEL@ IF EXECUTE ( special) ALIGNED ELSE DUP ?IM IF ." POSTPONE " THEN ID. CELL+ THEN ; @@ -2732,8 +2846,6 @@ WANT BAG BAG-WHERE - - ( SEE -inline-literals- ) ( dip -- dip ) : -lit DUP CELL+ @ DEA? IF '.+ ELSE H.+ THEN ; @@ -2798,12 +2910,14 @@ WANT HEX: -( ASSEMBLER CODE END-CODE C; ) \ AvdH A0oct21 +( ASSEMBLER CODE END-CODE C; ) \ AvdH C3oct23 NAMESPACE ASSEMBLER \ ISO standard words. : CODE NAME (CREATE) ASSEMBLER !CSP ; +: (;CODE) LATEST >CFA ! ; +\ {{: AAP ; 'DROP >CFA @ (;CODE) 5 7 AAP . },{5} }, : ;CODE -?CSP POSTPONE (;CODE) [COMPILE] [ ASSEMBLER + ?CSP POSTPONE (;CODE) [COMPILE] [ ASSEMBLER ; IMMEDIATE : END-CODE ?CSP PREVIOUS ; \ Non standard. A traditional alias for END-CODE . @@ -2811,8 +2925,6 @@ NAMESPACE ASSEMBLER - - \ ( ASSEMBLERi86-HIGH ) CF: \ B1oct16 AvdH WANT ASSEMBLER SWAP-DP ALIAS RESTORED @@ -3534,13 +3646,14 @@ CODE F>DATA TS, LEA, SP'| BO| [SP] -2 CELLS B, 'NEW-(NUMBER) '(NUMBER) 2 CELLS MOVE 'SDFLITERAL 'SDLITERAL 2 CELLS MOVE FINIT CREATE -fp- \ Completed! -( LOCATED LOCATE .SOURCEFIELD ) CF: \ AvdH A6jan31 +( LOCATED LOCATE .SOURCEFIELD ) CF: \ AvdH C4apr17 ">SFA" PRESENT 0= ?LEAVE-BLOCK \ Interpret a SOURCEFIELD heuristically. : .SOURCEFIELD DUP 0 = IF "Belongs to the kernel" TYPE CR DROP ELSE DUP 1000 U< IF LIST ELSE - DUP TIB @ 40000 WITHIN IF "Typed in" TYPE CR ELSE + DUP TIB @ DUP 16000 + WITHIN IF + DROP "Typed in" TYPE CR ELSE 50 - 200 TYPE THEN THEN THEN ; \ Show the screen or text how SC is defined : LOCATED FOUND DUP 0= 11 ?ERROR >SFA @ .SOURCEFIELD ; @@ -3549,7 +3662,6 @@ FINIT CREATE -fp- \ Completed! - ( OS-IMPORT cdED cd ) CF: \ AvdH A2feb05 "SYSTEM" PRESENT 0= ?LEAVE-BLOCK CREATE cmdbuf 1000 ALLOT diff --git a/boot.lab b/boot.lab index 8b6275c..41c2690 100644 --- a/boot.lab +++ b/boot.lab @@ -59,7 +59,7 @@ WANT ARG[] INCLUDE SRC>EXEC 'TASK '.SIGNON 3 CELLS MOVE \ No sign on. : REGRESS POSTPONE \ ; IMMEDIATE \ Turn off regression test ARGC 3 < 13 ?ERROR -2 ARG[] INCLUDED +2 ARG[] INCLUDED 4096 ALLOT LATEST 2 ARG[] SRC>EXEC TURNKEY ( -d :_This_option_is_available ) @@ -354,7 +354,7 @@ SECOND-PASS @ 0= ?LEAVE-BLOCK "CPU NAME VERSION" TYPE .SIGNON CR "LIBRARY FILE: " TYPE 0 MESSAGE -"$RCSfile: boot.lab,v $ $Revision: 5.2 $" TYPE CR +"$RCSfile: boot.lab,v $ $Revision: 5.3 $" TYPE CR CR 0 BLOCK B/BUF TYPE BYE @@ -766,7 +766,7 @@ BYE : No such process : No such file or directory : Operation not permitted - ciforth lab $Revision: 5.2 $ (c) Albert van der Horst + ciforth lab $Revision: 5.3 $ (c) Albert van der Horst : EMPTY STACK : DICTIONARY FULL : FIRST ARGUMENT MUST BE OPTION diff --git a/ci86.gnr b/ci86.gnr index fa7d917..5f15b37 100644 --- a/ci86.gnr +++ b/ci86.gnr @@ -1,10 +1,10 @@ _C{ ciforth : a generic I86 ISO FORTH by HCC FIG} -_C{ $Id: ci86.gnr,v 5.190 2022/04/06 14:41:12 albert Exp $} +_C{ $Id: ci86.gnr,v 5.205 2024/04/21 11:27:32 albert Exp $} _C{ Copyright (2012):} M4_SUPPLIER {by GNU Public License} _C _C{HCC FIG Holland : Hobby Computer Club, Forth Interest Group Holland} PAGE 66,106 - TITLE ciforth $Revision: 5.190 $ + TITLE ciforth $Revision: 5.205 $ _C _C{ For the generic system (to generate ciforth in an other configuration than this one):} _C{ http://home.hccnet.nl/a.w.m.van.der.horst/ci86gnr.html} @@ -353,6 +353,7 @@ EPIPE EQU 38 })_C{}_END_({ _PC_}) _HOSTED_X_({ + _C This applies to any elf-like binaries. _TEXT_ PAGE GLOBAL _start _C Entry point's guesses. @@ -364,7 +365,7 @@ _start: _C Entry point. _DLL_({ EPIPE EQU 109 _C{ " broken pipe " } _C - section '.idata' import data readable writeable + _IDATA_ dd 0,0,0,rva kernel_name,rva kernel_table dd 0,0,0,0,0 @@ -439,6 +440,7 @@ kernel_table: db 'SetConsoleMode',0 _Sleep dw 0 db 'Sleep', 0 + _ALIGN(_CELLS(1)) _TEXT_ _main: _ORIG: @@ -1179,6 +1181,7 @@ dnl ciforth: _main: start: })_C{}_END_({_HOSTED_X_}) + _TEXT_ COLD_ENTRY: CLD _C{ DIR = INC} _THREADS_({ @@ -1426,7 +1429,7 @@ _PC_({_NEWDEBUG_({ CALL DISPLAYSI})}) JMP _CELL_PTR[WOR] _C{ TO `CFA'} _C _C{ Dictionary starts here.} - + _DATA_ DP0: _C{ End of ONLY namespace. Namespaces all end in a link to 0.} define({_LINKOLD},0)dnl @@ -1604,7 +1607,7 @@ DENQ1: DC PPFET, LDUP, LIT, '"', EQUAL _C{ PP@@ DUP &" =} _0BRANCH(DENQ2) _C{ WHILE} DC TDROP, ONEP _C{ 2DROP 1+ R@ $+!} - DC LDUP, ALLOT, RR, SADD + DC LDUP, ALLOT, RR, SADD _C{ DUP ALLOT R@ $+!} _BRANCH(DENQ1) _C{ REPEAT} DENQ2: DC QBL, ZEQU @@ -1828,7 +1831,7 @@ forthcode({ELSE}) forthcode({AGAIN}) forthcode({REPEAT}) .}, {{ : GS1 1 BRANCH [ 0 CELL+ , ] BL BL ; GS1 . . }, {20 1}}, enddoc) -_HEADER({BRANCH},{BRAN}, {_VAR_FIELD(SKIP)}) +_HEADER({BRANCH},{BRAN}, {_LOW_CODE(SKIP)}) _C worddoc( {CONTROL},{SKIP},{skip},{},{C}, {Skip over an area in memory, where the length is given in the next cell, @@ -1938,6 +1941,7 @@ CODE_HEADER({(?DO)},{XQDO}) PUSH DX XCHG RPO,SPO _C{ GET PARAMETER STACK} _NEXT + _TEXT_ QXDO1: MOV HIP,AX _NEXT _C @@ -1947,9 +1951,8 @@ worddoc( {CONTROL},{I},{i},{--- n},{ISO,FIG,C}, { { : GS1 DO I . LOOP 0 . ; 2 -2 GS1},{-2 -1 0 1 0}, { : GS2 DO I . LOOP 0 . ; 4 0 GS2},{0 1 2 3 0} }, enddoc) -CODE_HEADER({I},{IDO}) - MOV AX,[RPO] _C{ GET INDEX VALUE} - _PUSH _C{ TO PARAMETER STACK} +_HEADER({I},{IDO},{_LOW_CODE(RR)}) +_C Fetch the top of the return stack. _C worddoc( {CONTROL},{J}, ,{--- n},{ISO,FIG,C}, {Used within a nested do-loop to copy the loop index of the @@ -2020,6 +2023,7 @@ _C{ Initialisation block for user variables through DOC-LINK} _C{ <<<<< must be in same order as user variables >>>>>} _C{ Still fig-compatible! Both entries take two cells.} _C + _TEXT_ LEA WOR,[COLD] JMP _CELL_PTR[WOR] _C{Hope stacks are still okay.} _ALIGN(_CELLS(1)) @@ -2028,6 +2032,7 @@ _C{ Make it possible to revector WARM. You can even make it low level. } LEA WOR,[WARM] JMP _CELL_PTR[WOR] _C{Hope stacks are still okay.} _ALIGN(_CELLS(1)) + _DATA_ USINI: DC STRUSA dnl _THREADS_( _C{ user area, copied before use in this threading Forth.}, @@ -2594,7 +2599,7 @@ current definition. The return stack must not be engaged. }, {EXIT}, { {: GS1 1 (;) 2 ; GS1 .},{1} }, enddoc) -_HEADER({(;)},{SEMIS},{_VAR_FIELD(EXIT)}) +_HEADER({(;)},{SEMIS},{_LOW_CODE(EXIT)}) _C worddoc( {CONTROL},{LEAVE},{leave},{},{ISO}, {Terminate a do-loop by branching to directly behind the @@ -2642,7 +2647,11 @@ worddocsafe( {STACKS},{R@@},{r_fetch},{--- n},{ISO}, {Copy the top of the return stack to the data stack.},{{>R},{R"},{Via >R}}, enddoc) -_HEADER({R@},{RR},{_VAR_FIELD(IDO)}) +CODE_HEADER({R@},{RR}) + MOV AX,[RPO] _C{ GET TOP OF RETURN STACK} + _PUSH _C{ TO PARAMETER STACK} + _DATA_ + _C worddoc( {LOGIC},{0=},{zero_equals},{n --- ff},{ISO,FIG}, {Leave a true flag forthvar({ff}) is the number forthvar({n}) @@ -3064,8 +3073,8 @@ worddoc( {DEFINING},{colon},{colon},{},{ISO,FIG,E}, forthexample({: cccc ... ;}) Creates a dictionary entry defining forthsamp({cccc}) as equivalent to the following sequence of Forth word definitions '...' until the next -forthcode({';'}) or forthcode({';CODE'}). The word is added as the latest -into the forthcode({CURRENT}) word list. +forthcode({';'}) (or possibly forthcode({';CODE'})). The word is +added as the latest into the forthcode({CURRENT}) word list. The compiling process is done by the text interpreter as long as forthcode({STATE}) is non-zero. Words with the forthdefi({immediate}) bit set, attribute forthvar({I}), @@ -3078,7 +3087,12 @@ _HEADER({:},{COLON},{DOCOL}) DC PCREAT DC LATEST, HIDDEN DC RBRAC - DC PSCOD + DC LIT, DOCOL + DC LATEST + DC TCFA + DC STOR + DC SEMIS + _TEXT_ DOCOL: LEA RPO,[RPO - _CELLS(1)] _C{Push HIP} MOV [RPO],HIP _C{R1 <- (IP)} MOV HIP,[WOR+_CELLS(D_HOFFSET - C_HOFFSET)] _C{(IP) <- (PFA)} @@ -3116,7 +3130,12 @@ _HEADER({CONSTANT},{LCONST},{DOCOL}) DC LNAME DC PCREAT DC LATEST, TDFA, STOR - DC PSCOD + DC LIT, DOCON + DC LATEST + DC TCFA + DC STOR + DC SEMIS + _TEXT_ DOCON: MOV AX,[WOR+_CELLS((D_HOFFSET))] _C{GET DATA FROM PFA} _PUSH _C @@ -3159,7 +3178,12 @@ enddoc) _HEADER({DATA},{LDATA},{DOCOL}) DC LNAME DC PCREAT - DC PSCOD + DC LIT, DOVAR + DC LATEST + DC TCFA + DC STOR + DC SEMIS + _TEXT_ DOVAR: MOV AX,[WOR+_CELLS((D_HOFFSET))] _C{(AX) <- PFA} _PUSH _C @@ -3190,7 +3214,12 @@ reflecting the current allocation in the user area. enddoc) _HEADER({USER},{USER},{DOCOL}) DC LCONST - DC PSCOD + DC LIT, DOUSE + DC LATEST + DC TCFA + DC STOR + DC SEMIS + _TEXT_ DOUSE: MOV BX,[WOR+_CELLS((D_HOFFSET))] _C{PFA } _THREADS_( { MOV AX, BP @@ -3474,9 +3503,9 @@ worddoc( {WORDLISTS~},{VOC-LINK},{voc_link},{--- addr},{U}, {A user variable containing the forthdefi({dictionary entry address}) of the word most recently created by forthcode({NAMESPACE}) . _VERBOSE_({{All namespace names are -linked by these fields to allow }forthcode({FORGET}){ to find all +linked to allow }forthcode({FORGET}){ to find all vocabularies.}})}, -{{NAMESPACE}}, +{{NAMESPACE}, {>VFA}}, {{VOC-LINK @ ' ENVIRONMENT = .},{_T_}}, enddoc) _HEADER({VOC-LINK},{VOCL},{DOUSE}, _CELLS(10)) @@ -3796,7 +3825,7 @@ the ISO standard has no way to address bytes.}}) },{{CELL+}}, {{123 CHAR+ .},{124}}, enddoc) -_HEADER({CHAR+}, {CHARP},{DOCOL}, {_VAR_FIELD(ONEP)}) +_HEADER({CHAR+}, {CHARP},{DOCOL}, {_HIGH_CODE(ONEP)}) _C worddoc( {MEMORY},{CHARS},{chars},{n1 --- n2},{ISO}, {Return the equivalent of forthvar({n1}) chars in bytes: @@ -4457,26 +4486,27 @@ _HEADER({DECIMAL},{DECA},{DOCOL}) DC STOR DC SEMIS _C -worddocsafe( {DEFINING~},{(;CODE)},{paren_semicolon_code},{},{WANT,C}, -{The run-time proceedure, compiled by forthcode({;CODE}), that rewrites the code -field of the most recently defined word to point to the following -machine code sequence. It is used after forthcode({CREATE}) instead of forthcode({DOES>}) if the code following -is assembler code instead of high level code. +worddocsafe( {DEFINING~},{(;CODE)},{paren_semicolon_code},{addr ---},{WANT,C}, +{The run-time proceedure, compiled by forthcode({;CODE}), that fills in the code +field of the most recently defined word with forthvar({addr}) . }, { {;CODE}}, -{{." No test"},{No test} }, +{{( See abort_quote)},{}}, enddoc) +_SUPPRESSED({{ _HEADER({(;CODE)},{PSCOD},{DOCOL}) - DC FROMR DC LATEST DC TCFA DC STOR DC SEMIS _C -_SUPPRESSED({{ +}})_C{}_END_({ _SUPPRESSED}) worddoc( {DEFINING~},{;CODE},{semicolon_code},{},{WANT,ISO,FIG,I,C}, {Used in the form: forthsamp({: cccc CREATE .... ;CODE assembly mnemonics }) +It can only be used if the code and the data are not separated. +It is used after forthcode({CREATE}) instead of forthcode({DOES>}) if the code following +is assembler code instead of high level code. Stop compilation and terminate a new defining word forthsamp({cccc}) by compiling forthcode({(;CODE)}). Set forthcode({ASSEMBLER}) to the top of the @@ -4495,10 +4525,11 @@ forthfile({forth.lab}) . Machine code must end in forthcode({NEXT,}) also available with the assembler. }, {{(;CODE)},{(CREATE)}}, -{{." Not present"},{Not present} }, +{{1 LOAD "ASSEMBLER" WANTED },{}, +{: AAP ; 'DROP >CFA @ (;CODE) 5 7 AAP . },{5} +}, enddoc) _C -}})_C{}_END_({ _SUPPRESSED}) worddoc( {DEFINING},{CREATE},{create},{},{ISO}, {A defining word used in the form: forthsamp({CREATE cccc}) @@ -4527,7 +4558,12 @@ _HEADER({CREATE},{LCREATE},{DOCOL}) DC LNAME DC PCREAT DC LIT, HLNOOP, COMMA - DC PSCOD + DC LIT, DODOE + DC LATEST + DC TCFA + DC STOR + DC SEMIS + _TEXT_ DODOE: LEA RPO,[RPO - _CELLS(1)] _C{Push HIP.} MOV [RPO],HIP MOV HIP,[WOR+_CELLS((D_HOFFSET))] _C{NEW IP } @@ -5360,7 +5396,7 @@ ERR2: DC BASE, FETCH DC DECA DC OVER - DC STOD, ZERO, PDDOTR _C{This is about (.) } + DC STOD, PDDOT _C{This is about (.) } DC ETYPE DC BASE, STOR DC LIT, M4_ERRORMIN, MAX @@ -5426,7 +5462,7 @@ THROW1: DC SEMIS _C _LOAD_({ -worddocsafe( {ERRORS~},{(ABORT")},{paren_abort_quote},{f ---},{}, +worddocsafe( {ERRORS~},{(ABORT")},{paren_abort_quote},{f ---},{WANT}, {The run time action of forthcode({ABORT"}) .}, {}, {{( See abort_quote)},{}}, @@ -5442,7 +5478,7 @@ PABQ1: DC TDROP PABQ2: DC SEMIS }})_C{}_END_({ _SUPPRESSED}) _C -worddocsafe( {ERRORS},{ABORT"},{abort_quote},{f ---},{ISO,I,C}, +worddocsafe( {ERRORS},{ABORT"},{abort_quote},{f ---},{WANT,ISO,I,C}, {Usage is forthsamp({: ... ABORT" " ... ;}). If ABORT" finds a non-zero forthvar({f}) on the stack, the forthsamp({}) is displayed and an @@ -5855,7 +5891,8 @@ forthdefi({word list associated with}) forthsamp({cccc})) to the top of the search order in forthcode({CONTEXT}). So it will be searched first by forthcode({INTERPRET}) . A word create by forthcode({NAMESPACE}) is not immediate. -_VERBOSE_({This is also different among Forth implementations.}) +_VERBOSE_({This may differ from forthcode({VOCABULARY}) that is +presen in many Forth implementations.}) A namespace 's data content field contains at first the dovoc pointer (like for any forthcode({DOES>}) word) , then follows @@ -6408,13 +6445,11 @@ worddoc( {DOUBLE},{S>D},{s_to_d},{n --- d},{ISO}, { -1 S>D D.},{-1} }, enddoc) CODE_HEADER({S>D},{STOD}) - POP DX _C{S1} - SUB AX,AX - OR DX,DX - JNS STOD1 _C{POS} - DEC AX _C{NEG} -STOD1: - _2PUSH + POP AX _C{S1} + _BITS64_({CQO}){}_BITS32_({CDQ}){}_BITS16_({CWD}) + PUSH AX + PUSH DX + _NEXT _C worddoc( {OPERATOR},{ABS},{abs},{n --- u},{ISO,FIG}, {Leave the absolute value of forthvar({n}) as forthvar({u}) .}, @@ -6479,6 +6514,8 @@ _C worddoc( {OPERATOR},{LSHIFT},,{u1 n --- u2},{ISO}, {Perform a forthemph({{logical {{{shift}}} }}) of the bits of forthvar({u1}) to the left by forthvar({n}) places. +It is an ambiguous condition if forthvar({u1}) is greater than or equal +to the number of bits in a cell. _VERBOSE_({{Put zero into the places uncovered by the {{{{shift}}}}.}}) }, {{RSHIFT},{2*}}, {{1 2 LSHIFT .},{4}}, @@ -6492,6 +6529,8 @@ _C worddoc( {OPERATOR},{RSHIFT},,{u1 n --- u2},{ISO}, {Perform a forthemph({{logical {{{shift}}} }}) of the bits of forthvar({u1}) to the right by forthvar({n}) places. +It is an ambiguous condition if forthvar({u1}) is greater than or equal +to the number of bits in a cell. _VERBOSE_({{Put zero into the places uncovered by the {{{{shift}}}}.}}) }, {{LSHIFT},{2/}}, {{4 2 RSHIFT .},{1}}, @@ -7082,7 +7121,7 @@ because mass storage is updated automatically in the background. },{{EMPTY-BUFFERS},{BLOCK}}, {{1 BLOCK DROP _PREV @ @ 0= . FLUSH _PREV @ @ 0= .},{0 _T_} }, enddoc) -_HEADER({FLUSH},{FLUSH}, {DOCOL}, _VAR_FIELD({MTBUF})) +_HEADER({FLUSH},{FLUSH}, {DOCOL}, _HIGH_CODE({MTBUF})) _C{ Unlock all buffers} DC _LIMIT @@ -7177,7 +7216,7 @@ _HEADER({RESTORE-INPUT},{RESTOI},{DOCOL}) }})_C{}_END_({ _SUPPRESSED}) _C })_C{}_END_({_LOAD_}) -worddoc( {SCREEN},{LOCK},{lock},{ n ---},{CI}, +worddoc( {BLOCKS},{LOCK},{lock},{ n ---},{CI}, {Lock the buffer with identification forthvar({n}), mostly a block number. Multiple locks are possible, and require multiple unlocks. @@ -7185,7 +7224,7 @@ _VERBOSE_({{Probably, it is to become the }forthdefi({current input source}){.}}) The result is that its buffer will not be reclaimed until an forthcode({UNLOCK}) occurs.}, -{{BLOCK},{(BUFFER}),{UNLOCK},{#BUFF}}, +{{BLOCK},{LOAD},{(BUFFER)},{UNLOCK},{#BUFF}}, { {EMPTY-BUFFERS 1 BLOCK DROP 1 LOCK dnl _PREV @ CELL+ @ . FLUSH _PREV @ CELL+ @ 0= .},{-1 _T_}, { : test #BUFF 1+ 0 DO I LOCK LOOP ; test }, @@ -7199,7 +7238,7 @@ _HEADER({LOCK},{LLOCK},{DOCOL}) DC LIT, -2, SWAP, PSTOR DC SEMIS _C -worddoc( {SCREEN},{UNLOCK},{unlock},{ n ---},{CI}, +worddoc( {BLOCKS},{UNLOCK},{unlock},{ n ---},{CI}, {Unlock the buffer with identification forthvar({n}), mostly a block number. _VERBOSE_({{Probably, because it @@ -7207,7 +7246,7 @@ is no longer the }forthdefi({current input source}){.}}) The result is that its buffer can again be reclaimed. Unlocking without a previous lock may lead to a crash. }, -{{LOCK},{(BUFFER)},{#BUFF}}, +{{LOCK},{(BUFFER)},{LOAD},{#BUFF}}, { {EMPTY-BUFFERS 1 BLOCK DROP 1 LOCK dnl _PREV @ CELL+ @ . 1 UNLOCK _PREV @ CELL+ @ .},{-1 1} }, @@ -9737,7 +9776,8 @@ This name is typically changed during installation and is used by the enddoc) _HEADER({BLOCK-FILE},{BLFL},{DOVAR}, ) _C{ Allow for some path, at most 80 char's} - _STRING({forth.lab }) + _STRING({forth.lab}) + _RESB(M4_FILENAMELENGTH-9) _C{ Allow for some path} worddoc( {BLOCKS},{BLOCK-HANDLE},{block_handle},{---n},{}, {Leave a file handle in forthvar({n}) . If it is negative there is no block file open, @@ -9896,14 +9936,19 @@ _HEADER({SHELL},{SHELL},{DOVAR}, ) _RESB(M4_FILENAMELENGTH)_C{ Allow for some path} _PC_({ _RESB(0x100) _C{ Double serve as stack at start up. }}) _C +_HOSTED_X_({ +worddoc( {OPERATINGSYSTEM},{FORK},{fork},{ --- pid/0/err},{}, +{Fork the process. We then run two processes. +The return value is 0 for the child process, and +forthvar({pid}) for the mother process. +If it is negative, it is an error. +}, {{SYSTEM}}, {}, enddoc ) +})_C{}_END_({_HOSTED_X_}) _HOSTED_OSX_({ -worddoc( {OPERATINGSYSTEM},{XOSFORK},{xosfork},{ --- flag},{}, -{Fork the process. If it is negative, it is an error. -Otherwise, if forthvar({flag}) is clear, we are the child else the -mother.}, {{SYSTEM}}, {}, enddoc ) -CODE_HEADER({XOSFORK},{XOSFORK}) +CODE_HEADER({FORK},{FORK}) _C{ This is coded in assembler because there is a return value in DX :} -_C{ 0 = parent 1 = child } +_C{ If it is negative, it is an error, otherwise 0 = parent 1 = child } +_C{ The return value in AX is the pid as usual.} MOV AX, fork _C{ Syscall with no parameters} PUSH AX INT 0x80 @@ -9933,10 +9978,14 @@ _DLL_({ }) ,enddoc) _LINUX_N_({ +_HEADER({FORK},{FORK},{DOCOL}) + DC X, X, X, LIT, fork, XOS + DC SEMIS +_C _HEADER({SYSTEM},{SYSTEM},{DOCOL}) DC LIT, COMBUF, SSTOR, ZERO, LIT, COMBUF, CHAPP DC ZERO, SHELL, CHAPP, LIT, -1, SHELL, PSTOR - DC X, X, X, LIT, fork, XOS + DC FORK DC LDUP, QERRUR DC LDUP, ZEQU _0BRANCH(SYSTEM1) @@ -9973,7 +10022,7 @@ _HOSTED_OSX_({ _HEADER({SYSTEM},{SYSTEM},{DOCOL}) DC LIT, COMBUF, SSTOR, ZERO, LIT, COMBUF, CHAPP DC ZERO, SHELL, CHAPP, LIT, -1, SHELL, PSTOR - DD XOSFORK + DD FORK DC LDUP, QERRUR DC LDUP, ZEQU _0BRANCH(SYSTEM1) @@ -10518,7 +10567,7 @@ forthcode({NAME}) and forthcode({FOUND}) (or forthcode({WORD}) and forthcode({FI {{ : APE 1 2 ; : GS1 ['] APE ; GS1 EXECUTE GS1 ID. . .},{APE 2 1}}, enddoc) dnl An alias header. CFA DFA are the same. -_HEADER({[']},{BTICK},{DOCOL}, _VAR_FIELD({TICK}), B_IMMED) +_HEADER({[']},{BTICK},{DOCOL}, _HIGH_CODE({TICK}), B_IMMED) _C })_C{}_END_({_LOAD_}) worddoc( {DICTIONARY~},{FORGET-VOC},{forget_voc},{addr wid --- addr },{}, @@ -11130,7 +11179,7 @@ field forthvar({n}) characters wide to the string forthvar({sc}). Enlarge the field, if needed. _VERBOSE_({{So a field length of 0 results effectively in free format.}}) }, -{{OUT},{D.},{D.R}}, +{{OUT},{D.},{D.R},{D.}}, {{-12. 41 EMIT 5 (D.R) 41 EMIT TYPE 41 EMIT},{AA -12A}}, enddoc) _HEADER({(D.R)},{PDDOTR},{DOCOL}) @@ -11154,6 +11203,24 @@ PDDOT1: DC EDIGS _C{Drop string instead of number.} DC SEMIS _C +worddocsafe( {OUTPUT},{(D.)},{paren_d_dot},{d ---sc},{}, +{Format a signed double number forthvar({d}) field to the +string forthvar({sc}). This a temporary string. +}, +{{OUT},{D.},{D.R}}, +{{-12. 41 EMIT (D.) 41 EMIT TYPE 41 EMIT},{AA-12A}}, +enddoc) +_HEADER({(D.)},{PDDOT},{DOCOL}) + DC SWAP + DC OVER + DC DABS + DC BDIGS + DC DIGS + DC ROT + DC SIGN + DC EDIGS + DC SEMIS +_C worddoc( {OUTPUT},{D.R},{d_dot_r},{d n ---},{ISO,FIG}, {Print a signed double number forthvar({d}) right aligned in a field forthvar({n}) characters wide. Enlarge the field, if @@ -11188,12 +11255,12 @@ worddoc( {OUTPUT},{D.},{d_dot},{d ---},{ISO,FIG}, {Print the signed double number forthvar({d}), observing the current forthcode({BASE}), followed by a blank. }, -{{OUT},{.},{D.R},{(D.R)}}, +{{OUT},{.},{(D.)},{D.R},{(D.R)}}, {{-12. D. 41 EMIT},{-12 A}}, enddoc) _HEADER({D.},{DDOT},{DOCOL}) - DC ZERO - DC DDOTR + DC PDDOT + DC LTYPE DC SPACE DC SEMIS _C @@ -11238,19 +11305,21 @@ _HEADER({U.},{UDOT},{DOCOL}) DC DDOT DC SEMIS _C -worddoc( {DICTIONARY~},{FOR-WORDS},{for_words},{x1...xn xt dea --- x1...xn},{}, +worddoc( {DICTIONARY~},{FOR-WORDS},{for_words},{x1...xn xt dea --- x1'...xm'},{}, {For all words starting with and including forthvar({dea}) execute forthvar({xt}) with as data forthvar({x1..xn}) plus the forthdefi({dea}) of those words by following the link fields. -forthvar({xt}) -must have the stack diagram forthvar({x1..xn dea' --- x1..xn}). Mostly the dea will identify a WID. +forthvar({xt}) +must have the stack diagram forthvar({x1..xn dea' --- x1'..xm'}). In that case all words of a wordlist are handled. If you don't want to include the WID itself, you can ignore it based on the dummy flag in its flag field. _VERBOSE_({{Note that you can use the forthdefi({dea}) of any word as a WID -and the remainder of the word list will be searched.}}) +and the remainder of the word list will be searched. +This word is similar to forthdefi({TRAVERSE-WORDLIST}) (ISO 2012), +but the forthvar({xt}) is not burdened by returning a goon-flag. }}) }, {{FOR-VOCS},{EXECUTE}}, {{( See MATCHING-WORDS)},{}}, @@ -11568,6 +11637,7 @@ _C{ PRINT CPU TYPE (8088)} DC LCPU, DDOT DC BASE,STOR _C + DC LENAME, LTYPE, SPACE DC LVERSION, LTYPE, SPACE DC CR @@ -11632,7 +11702,14 @@ _C{ No memory addresses should be arrived at through equates.} _C{ However now we must teach the linker to keep the} _C{ two sections together.} -FORTHSIZE EQU _AP_ - _main +_SEPARATED_( +{ _TEXT_ +FORTHSIZE1 EQU _AP_ - COLD_ENTRY + _DATA_ +FORTHSIZE2 EQU _AP_ - DP0 +FORTHSIZE EQU FORTHSIZE1 + FORTHSIZE2}, +{FORTHSIZE EQU _AP_ - _main}) + _BSS_ INITDP: _C{ It may be that it is not consecutive with TASK.} diff --git a/ci86.labtest b/ci86.labtest index 371b615..22b8a9d 100644 --- a/ci86.labtest +++ b/ci86.labtest @@ -1,5 +1,5 @@ 1 LOAD -dnl $Id: ci86.labtest,v 5.8 2022/06/12 13:54:08 albert Exp $ +dnl $Id: ci86.labtest,v 5.9 2023/10/03 11:22:11 albert Exp $ dnl Copyright(2013): Albert van der Horst, HCC FIG Holland by GNU Public License dnl formerly called ci86.lina.labtest divert(4)dnl @@ -53,13 +53,13 @@ wordtest( {TUCK}, { { "TUCK" WANTED},{}, {1 2 3 TUCK . . . . },{3 2 3 1 }, }) -wordtest( {REFILL}, -{ { "REFILL" WANTED}, {SOURCE : ISN'T UNIQUE }, +wordtest( next-line}, +{ { ">IN" WANTED}, {}, { : _G13 2DUP OVER + SWAP DO I C@ &| = IF ^J I C! THEN LOOP ;},{}, - { " 1 2 3 4 REFILL| 1 . 3 .| .| . . . . " _G13 EVALUATE },{1 3 -1 4 3 2 1 }, + { " 1 2 3 4 next-line| 1 . 3 .| .| . . . . " _G13 EVALUATE },{1 3 -1 4 3 2 1 }, }) wordtest( {0>IN}, -{ { "0>IN" WANTED}, {SOURCE : ISN'T UNIQUE }, +{ { "0>IN" WANTED}, {}, {: _G14 DUP IF 1- 0>IN THEN ;},{}, { : _G13 2DUP OVER + SWAP DO I C@ &| = IF ^J I C! THEN LOOP ;},{}, { " 4| DUP . _G14 | 9 + . " _G13 EVALUATE},{4 3 2 1 0 9}, diff --git a/cifgen.mi b/cifgen.mi index 800172f..b7e578f 100644 --- a/cifgen.mi +++ b/cifgen.mi @@ -1,5 +1,5 @@ dnl $ Id: $ -dnl Copyright{2000,2001}: Albert van der Horst, HCC FIG Holland by GNU Public License +dnl Copyright{2000,2024}: Albert van der Horst, HCC FIG Holland by GNU Public License undefine({worddoc}) \input texinfo @setfilename thisfilename @@ -19,7 +19,7 @@ Dutch Forth Workshop @page @c @vskip Opt plus 1fill -Copyright @copyright{{}} 2018 Albert van der Horst +Copyright @copyright{{}} 2024 Albert van der Horst Permission is granted to copy with attribution. Program is protected by the GNU Public License. @@ -463,11 +463,25 @@ belonging to the assembler used. _TEXT_ : This introduces the part of the Forth with the definitions. It is supposed to be stored on disk. +Normally it is modifiable, so e.g. VARIABLE's can be in here. + +In the circumstance that there is separation of code and data, +there is the another segment +_DATA_ : modifiable data, not machine-executable code +This is important if the underlying operating system doesnot +allow the modifiation of code. +In that case the _TEXT_ segment is non-writable. +Most Forth's to date can get by with this data in the _TEXT_ +segment. +This macro is conditional on _SEPARATED_. +So mostly _DATA_ is a void statement. _BSS_ : This part of the Forth imposes a layout without initialising the data. It agrees with a traditional bss segment in e.g. an a.out format. +_IDATA_ : As an exception extra segments has to be introduced. + @subsection Selection Selection, often one of alternatives, is in general done as follows diff --git a/ciforth.mi b/ciforth.mi index feb26e6..c06c53c 100644 --- a/ciforth.mi +++ b/ciforth.mi @@ -1,5 +1,5 @@ dnl $ Id: $ -dnl Copyright{2000,2015}: Albert van der Horst, HCC FIG Holland by GNU Public License +dnl Copyright{2000,2024}: Albert van der Horst, HCC FIG Holland by GNU Public License \input texinfo @setfilename thisfilename @dircategory Programming @@ -39,16 +39,17 @@ _LOAD_({forthitem the full ISO CORE set is present, possibly after loading}) _SOURCEFIELD_({forthitem headers with source fields}) +_THREADS_({forthitem +accommodates threads }) forthenditemize @author Albert van der Horst -Dutch Forth Workshop @page @c @vskip Opt plus 1fill -Copyright @copyright{{}} 2000,2015 Dutch Forth Workshop +Copyright @copyright{{}} 2000,2024 Albert van der Horst Permission is granted to copy with attribution. Program is protected by the GNU Public License. @@ -313,7 +314,8 @@ into case-insensitivity and back by issuing the words forthcode({CASE-INSENSITIV forthcode({CASE-SENSITIVE}). Case insensitivity applies to the words looked up in the dictionary, -not to hex digits. +as well as digits in numbers, preventing the use of forthcode({BASE}) +larger than 36. @subsection Error 8 or only error numbers If you get an error 8 as soon as you try to forthcode({LOAD}) or forthcode({LIST}) a screen @@ -717,6 +719,11 @@ It is based on a generic system available via http://home.hccnet.nl/a.w.m.van.der.horst/ciforth.html forthbreak +All stable versions are copied to + +https://github.com/albertvanderhorst/ciforth +forthbreak + The implementation of this Forth is indebted to FIGForth http://home.hccnet.nl/a.w.m.van.der.horst/figforth.html diff --git a/copyright b/copyright new file mode 100644 index 0000000..1f19f10 --- /dev/null +++ b/copyright @@ -0,0 +1,34 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: lina +Source: https://github.com/albertvanderhorst/ciforth + +Files: * +Copyright: 2000-2024 Albert van der Horst +License: GPL-2_or_LGPL + Whether GPL-2 or LPGPL applies is documented below. + +Files: extract/ci86.gnr +Copyright: 2000-2024 Albert van der Horst +License: GPL-2 + On Debian systems, the complete text of the GNU General + Public License version 2 can be found in "/usr/share/common-licenses/GPL-2". + lina itself is released under version 2 of the GNU General Public License. + However, this is a compiler and a substantial part of the package + are for all practical purposes libraries. + The GPL only applies to the compiler build as a derivative work of + the lina.s source and saved configurations of lina, not to compiled + programs. + All other usage, in particular of the library forth.lab and binaries + build by lina, are made available under the Lesser GNU General Public License. + This even applies to applications that have the Forth interpreter + exposed, provided they are truly applications. + +Files: forth.lab +Copyright: 2000-2024 Albert van der Horst +License: LGPL-2 + On Debian systems, the complete text of the lesser GNU General + Public License version 2 can be found in "/usr/share/common-licenses/LGPL-2". + . + [lina is an instance of a Forth build by the ciforth compiler factory. + Different conditions (essentially none) apply to a Forth that you + build yourself using that tool.] diff --git a/fasm.m4 b/fasm.m4 index 0a4b2e1..c1e6be7 100644 --- a/fasm.m4 +++ b/fasm.m4 @@ -1,4 +1,4 @@ -dnl $Id: fasm.m4,v 5.13 2017/11/10 18:33:43 albert Exp $ +dnl $Id: fasm.m4,v 5.16 2024/04/16 20:35:46 albert Exp $ dnl Copyright(2011): Albert van der Horst, HCC FIG Holland by GNU Public License dnl Macro's to adapt the source to Flat Assembler divert(-1) @@ -30,8 +30,10 @@ _DLL_( _BITS32_({FORMAT PE console})_BITS64_({ FORMAT PE64 console}) ; INCLUDE _BITS32_({'include/win32a.inc'})_BITS64_({'include/win64a.inc'}) ; ASCII windows definitions. +define({_IDATA_},{ section '.idata' import data readable writeable executable })dnl +define({_TEXT_}, {_SEPARATED_( { section '.text' code executable readable writable},{dnl})})dnl +define({_DATA_}, {_SEPARATED_( { section '.text' code executable readable writable},{dnl})})dnl define({_BSS_},{})dnl -define({_TEXT_}, { section '.text' code executable readable writable})dnl })_C{}_END_({ _DLL_}) _HOSTED_OSX_({ ; This version can be assembled on an OS X system (Apple): @@ -40,18 +42,21 @@ _HOSTED_OSX_({ ; ld xina.o -segprot __TEXT rwx rwx -segprot __DATA rwx rwx -o xina ; However as per 2016 dec 21 , it doesn't run. FORMAT ELF ; No macho, go via ELF object format. -define({_TEXT_},{ section '.text' executable })dnl +define({_TEXT_}, {_SEPARATED_( { section '.text' executable },{dnl})})dnl +define({_DATA_}, {_SEPARATED_( { section '.text' executable },{dnl})})dnl define({_BSS_},{ section '.bss' writable })dnl }) _LINUX_N_( {; fasm forth.asm forth _BITS32_({define({ELF_FORMAT},{ELF})}) _BITS64_({define({ELF_FORMAT},{ELF64})}) - ; fam generates executable, no separate linking. - FORMAT ELF_FORMAT EXECUTABLE + ; fam generates executable, no separate linking. 3 is linux + FORMAT ELF_FORMAT EXECUTABLE 3 + SEGMENT executable writable readable ; -define({_TEXT_}, { SEGMENT executable readable writable})dnl -define({_BSS_},{})dnl +define({_TEXT_}, {_SEPARATED_( { SEGMENT executable readable},{dnl})})dnl +define({_DATA_}, {_SEPARATED_( { SEGMENT writable readable},{dnl})})dnl +define({_BSS_}, {_SEPARATED_( { SEGMENT writable readable},{dnl})})dnl })_C{}_END_({ _LINUX_N_}) ;}) define({SET_16_BIT_MODE},{ use16 }) @@ -86,7 +91,7 @@ define({LONG},{DWORD}) define({QUAD},{QWORD}) dnl Handling large blocks of comment -dnl This just doesn't work, because fasm syntax checks the content. +dnl All lines are changed in line comment. define({_COMMENTED},{patsubst({$1},{^},{;})}) dnl Alternative if patsubst not available. dnl define({_COMMENTED},{_SUPPRESSED}) @@ -94,6 +99,9 @@ define({_ENDOFPROGRAM},{ _DLL_({ ENTRY $1 })_C{}_END_({ _DLL_}) +_LINUX_N_({ + ENTRY $1 +})_C{}_END_({ _LINUX_N_}) }) define({_ALIGN},{ALIGN M4_CELLWIDTH}) define({DSS},{DB}) diff --git a/gas.m4 b/gas.m4 index c5959db..933368f 100644 --- a/gas.m4 +++ b/gas.m4 @@ -1,4 +1,4 @@ -dnl $Id: gas.m4,v 5.19 2022/03/06 19:58:36 albert Exp $ +dnl $Id: gas.m4,v 5.21 2023/10/23 15:12:10 albert Exp $ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License divert(-1) @@ -15,6 +15,10 @@ define({_HEADER_ASM},{# # The -s (strip) is not necessary, and may even be detrimental. .Intel_syntax prefix + .section .forthx,"awx",@progbits + .section .forthd,"awx",@progbits + .section .dict,"awx",@nobits + .section .forthx }) define({_C},{{#}}) define({_O},{{0$1}}) @@ -56,8 +60,9 @@ dnl Handling large blocks of comment define({_COMMENTED}, { /* }$1{ */ }) dnl A nobits section takes no place in the object file. -define({_TEXT_},{ .section .forth,"awx",@progbits}) -define({_BSS_},{ .section .dict,"awx",@nobits}) +define({_TEXT_}, {_SEPARATED_( { .section .forthx},{dnl})})dnl +define({_DATA_}, {_SEPARATED_( { .section .forthd},{dnl})})dnl +define({_BSS_},{ .section .dict}) define({_ENDOFPROGRAM},{ END $1 }) diff --git a/glosshtml.m4 b/glosshtml.m4 index 849a21e..0467881 100644 --- a/glosshtml.m4 +++ b/glosshtml.m4 @@ -1,5 +1,5 @@ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License -dnl $Id: glosshtml.m4,v 5.4 2022/02/18 18:21:19 albert Exp $ +dnl $Id: glosshtml.m4,v 5.5 2023/10/18 11:53:49 albert Exp $ divert(-1) define({forall}, {ifelse(len({$2}),0,, {$1}({{{$2}}})   @@ -31,9 +31,9 @@ $2 STACKEFFECT: $4

-DESCRIPTION: +DESCRIPTION: [$5]

-($5) $6 +$6

GLOSSARY INDEX

diff --git a/header.m4 b/header.m4 index 8589fc6..fd8dfe9 100644 --- a/header.m4 +++ b/header.m4 @@ -1,4 +1,5 @@ -dnl $Id: header.m4,v 5.6 2019/07/22 10:14:31 albert Exp $ M4 file to handle the develish FIG headers. +dnl $Id: header.m4,v 5.9 2023/10/23 15:12:10 albert Exp $ M4 file to handle the develish FIG headers. + dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License dnl dnl _STRING : Lay down a string in memory. @@ -60,6 +61,8 @@ define({_CODE_FIELD},$1)dnl define({_DATA_FIELD},{($1+_CELLS(D_HOFFSET))})dnl define({_LINK_FIELD},{($1+_CELLS(L_HOFFSET))})dnl define({_VAR_FIELD},{($1+HEADSIZE)})dnl +define({_HIGH_CODE},{($1+HEADSIZE)})dnl +define({_LOW_CODE},{(X_$1)})dnl dnl Handle Branching define({_0BRANCH},dnl {DC ZBRAN @@ -81,9 +84,12 @@ dnl The field where a pointer to the latest entry of a vocabulary resides. define({CODE_HEADER}, {_HEADER({$1}, {$2}, +{X_$2}, {$2+HEADSIZE}, -{$2+HEADSIZE}, -$5)})dnl +$5) + _TEXT_ +X_$2: +})dnl define({JMPHERE_FROM_PROT},{})dnl define({JMPHERE_FROM_REAL},{})dnl define({JMPFAR},{DB 0x0EA})dnl @@ -97,7 +103,9 @@ define({_CELLS},(CW*($1)))dnl define({_NEXT},{JMP NEXT}) define({_NEXT_MACRO}, {LODS _C NEXT - JMP _CELL_PTR[WOR] } ) + JMP _CELL_PTR[WOR] + _DATA_ +} ) # See definition of PUSH in glossary. define({_PUSH},{JMP APUSH}) define({_PUSH_MACRO}, diff --git a/howto.txt b/howto.txt index 191d635..bef6936 100644 --- a/howto.txt +++ b/howto.txt @@ -232,23 +232,35 @@ Release of the full source, but also ready to run. make VERSION=5.6.7 clean VERSION LINA32SRC_M4 make VERSION=5.6.7 clean VERSION LINA64SRC_M4 +OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- 2022 mar 13 To make a source archive that can be converted to a debian archive. -make VERSION=5.6.7 clean VERSION LINA64DEB +make VERSION=5.6.7 clean VERSION LINA64dDEB - unpack the source archive giving lina64_#.#.# - run debmake from within - replace debian/ with an unpacked debianE.tar - run debuild from within You get an debian archive and some stuff that can be uploaded in principle ..orig..xz and ..#.#.#-1..xz +OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- OBSOLETE- 2022mar 22 OFficial releases -releasewina.bat works as follows - $1 wina32/wina64 - $2 9.8.7 +releasewina.bat works as follows + $1 wina32/wina64 + $2 9.8.7 make clean VERSION VERSION=5.4.0 LINA64ZIP +Result in ci86.lina64-$(VERSION).tar.gz +2022dec 27 + +To make a source archive that can be converted to a debian +archive. +make VERSION=5.6.7 clean VERSION LINA64ZIP +Follow the instructions in debbuild.sh + +2023apr 21 +releasewina64.bat is obsolete, use releasewina.bat. diff --git a/indexhtml.m4 b/indexhtml.m4 index addaeee..40c2ddf 100644 --- a/indexhtml.m4 +++ b/indexhtml.m4 @@ -1,5 +1,5 @@ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License -dnl $Id: indexhtml.m4,v 5.5 2018/01/18 19:37:28 albert Exp $ +dnl $Id: indexhtml.m4,v 5.6 2023/10/18 11:53:49 albert Exp $ define(divert,) divert(-1) changequote({,})dnl @@ -15,9 +15,14 @@ define({forthkey}, {$1}) define({forthexample},{

$1

}) define({forthcode}, {$1}) define({forthxref}, {See also $1}) +define({OldLetter},{_}) dnl ----------------------- worddoc ------------------------------------ define({worddoc}, {divert(2)dnl +define({newdef},translit({{$2}},{,()#},{____}))dnl +define({NewLetter}, substr(newdef,0,1))dnl +ifelse(OldLetter,NewLetter,,{

})dnl +define({OldLetter}, NewLetter)dnl forthcode({$2})     })dnl dnl ----------------------- worddocsafe ------------------------------------ define({worddocsafe}, diff --git a/intro.mi b/intro.mi index 9f75dd8..d32b779 100644 --- a/intro.mi +++ b/intro.mi @@ -1,5 +1,5 @@ dnl $ Id: $ -dnl Copyright{2000-2014}: Albert van der Horst, HCC FIG Holland by GNU Public License +dnl Copyright{2000-2024}: Albert van der Horst, HCC FIG Holland by GNU Public License A Forth system is a database of small programs. The database is called the dictionary. The programs are called forthdefi({word})'s, or definitions. diff --git a/lina.1 b/lina.1 index d341743..223c933 100644 --- a/lina.1 +++ b/lina.1 @@ -1,9 +1,9 @@ -.\" $Id: lina.1,v 5.6 2022/03/12 12:33:25 albert Exp $ -.TH LINA "1" "feb 2022 " "ciforth 5.4.0" HCC-FORTHIG +.\" $Id: lina.1,v 5.7 2024/04/16 21:28:51 albert Exp $ +.TH LINA "1" "apr 2024 " "ciforth 5.5.0" HCC-FORTHIG .SH "NAME" lina \- close to ISO Forth Language And Environment .SH "SYNOPSIS" -\fBlina\fR [\ \fB\-aehmrv\fR\ ] +\fBlina\fR [\ \fB\-aehmnrv\fR\ ] .br \fBlina\fR \ \fB\-c\fR\ .br @@ -30,7 +30,7 @@ kernel contains the essential, i.a. file access, exceptions and interfacing with Linux. Its power is multiplied by an extensive source library, that adds i.a. a number of standard words, floating point, -a decompiler, integrated 386 assembler, sort utilities, +a decompiler, integrated i86 assembler, sort utilities, binary search and numerous small functions. . @@ -76,7 +76,7 @@ Then start the interpreter. Execute the forthcode \fIwords\fR . Then start the interpreter. .TP -\fB\-g N \fIbinary-path\fR +\fB\-g \fIN binary-path\fR Expand the system by \fIN\fR Megabytes, then save it under the name \fIbinary-path\fR. \fIN\fR may be negative, @@ -94,20 +94,22 @@ The system is configured accordingly. .TP \fB\-l\fR \fIlibrary-path\fR [\fIarguments\fR] Close the default library, and open the library at -\fIlibrary-path\fR. Shift the arguments such as to make the \fB-L\fR +\fIlibrary-path\fR. Shift the arguments such as to make the \fB-l\fR option invisible. Process any other options, then start the interpreter. .TP +\fB\-n\fR +This starts the interpreter for newbies. +It is convenient but somewhat unsafe. +The interpreter is made case-insensitive. +The stack is printed after each command. +For unknown words an attempt is made to load it from the library. +.TP \fB\-s\fR \fIscript-path\fR [\fIarguments\fR] (Intended to be used in a script with ``\fB#!lina -s\fR'' as the first line.) Shift the arguments such as to make the \fB-s\fR option invisible. Interpret the file \fIscript-path\fR , ignoring its first line. -.TP -\fB\-t\fR \fIfile.frt\fR -Try to load the file \fIfile.frt\fR automatically, -by possibly unsafe means. -Report facilities that were required, -then start the interpreter. +The arguments are to appended to the script involation, not to the first line. .TP \fB\-m\fR, \fB\--\fR, \fB\-\-help\fR, \fB\-\-version\fR print help, version and copyright information. @@ -123,6 +125,11 @@ The generic system can be fetched from .PP MS-DOS, "windows" , stand alone and Alpha Linux binary versions are available. +.br +The Intel specific system can be fetched from +.IP +\fI https://github.com/albertvanderhorst/ciforth\fR +.PP .SH "ENVIRONMENT" Configuration is done fully internal. @@ -143,13 +150,14 @@ referenced. \fI/usr/share/doc/ci86.lina64/lina64.texinfo\fR allows you to generate the documentation in html, ps and pdf form. .br -\fI/usr/share/doc/lina.lina64/lina64.s\fR and \fIforth.lab\fR are source code and can be viewed. +\fI/usr/share/doc/lina.lina64/lina64.fasm\fR and \fIforth.lab\fR are source code and can be viewed. .br -\fIlina\fR comes also in cell-width 32; the filenames change accordingly. +\fIlina\fR comes also in cell-width 32, +the documentation corresponds. .br gforth(1) GNU Forth, a faster and more complicated Forth system. .br -as(1) The portable GNU assembler. +fasm(1) The flat assembler. .SH "DIAGNOSTICS" Uncaught exceptions will show the error number. @@ -175,7 +183,7 @@ language. The library has comments but no comprehensive documentation. .SH "AUTHOR" -Copyright \(co 2000-2022 +Copyright \(co 2000-2024 Albert van der Horst \fI albert@spenarnc.xs4all.nl\fR. -\fBciforth\fR is made available under the GNU Public License: +\fBciforth\fR is made available under the GNU Public License 2: quality, but NO warranty. diff --git a/lina32.cfg b/lina32.cfg index f52f2db..cc273b7 100644 --- a/lina32.cfg +++ b/lina32.cfg @@ -1,4 +1,4 @@ -dnl $Id: lina32.cfg,v 5.3 2022/03/01 22:14:07 albert Exp $ +dnl $Id: lina32.cfg,v 5.4 2024/04/20 11:35:02 albert Exp $ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License divert(-1)dnl @@ -14,10 +14,10 @@ dnl GNU-linux ungracefully mishandles this dnl Problems have been observed for moderate large values dnl too. Experience suggests a relation with the dnl size of the swap space. -dnl 2 Mbyte Lowest for -i option. -dnl define({M4_EM}, 0x00200000) +dnl 4 Mbyte Lowest for -i option. +define({M4_EM}, 0x00400000) dnl 64 Mbyte -define({M4_EM},(0x4000000)) +dnl define({M4_EM},(0x4000000)) dnl 2 Gbyte dnl define({M4_EM},(0x80000000)) define( {_TASK_}, _yes)dnl diff --git a/lina64.cfg b/lina64.cfg index 67a0e32..f9c3ac1 100644 --- a/lina64.cfg +++ b/lina64.cfg @@ -1,4 +1,4 @@ -dnl $Id: lina64.cfg,v 5.7 2017/10/29 13:46:29 albert Exp $ +dnl $Id: lina64.cfg,v 5.10 2024/04/20 11:35:02 albert Exp $ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License divert(-1)dnl @@ -7,6 +7,8 @@ divert(-1)dnl FOR NASM , GNU as , and fasm include(prelude.m4) +dnl define( {_SEPARATED_}, _yes)dnl +define( {_SEPARATED_}, _no)dnl define( {_BITS32_}, _no)dnl define( {_BITS64_}, _yes)dnl define( {_LINUX_N_}, _yes ) @@ -14,12 +16,12 @@ define( {_THREADS_}, _yes ) dnl If you want to increase memory size in the gigabyte range, dnl use the -g option. 12 Gbyte is not a problem on a 16 Gbyte system. dnl The following size can be handled by fasm with an -m256000 option. -dnl 2 Mbyte Lowest for -i option. -dnl define({M4_EM}, 0x00200000) +dnl 4 Mbyte Lowest for -i option. +define({M4_EM}, 0x00400000) dnl ugly value for test dnl define({M4_EM}, 0x00176500) dnl 64 Mbyte -define({M4_EM},(0x4000000)) +dnl define({M4_EM},(0x4000000)) dnl 8 Gbyte , doesn't work for fasm dnl define({M4_EM},(0x200000000)) dnl slightly under 2 Gbyte, doesn't work for fasm diff --git a/manual.mi b/manual.mi index 2d11d0d..10550a9 100644 --- a/manual.mi +++ b/manual.mi @@ -1,5 +1,5 @@ dnl $ Id: $ -dnl Copyright{2000-2014}: Albert van der Horst, HCC FIG Holland by GNU Public License +dnl Copyright{2000-2024}: Albert van der Horst, HCC FIG Holland by GNU Public License @section Getting started @subsection Hello world! @@ -112,17 +112,35 @@ Apparently, thisforth doesn't know about a forth word named forthcode({TUCK}), but after forthsamp({"TUCK" WANTED}) maybe it does. You may try again. +The library file must be organized for forthcode({WANTED}) in a +particular way to find something. It is in fact familiar. +It is divided into blocks of 16 lines. The convention about the way the library file must be organized for forthcode({WANTED}) to find something is simple. It is divided into blocks of 16 lines. -The first line is the header of the block. +The first line is the header of the block, the so called forthdefi({indexline}) If the word we are looking for is mentioned in the header, that block is compiled. -This continues until the word has been defined, -or the end of the search area is reached. -This is marked by a screen with an empty index line. -I tell you this not because you need to know, -but to show that there is nothing to it. +There may be several blocks that define a particular +word. +If the first block is terminated early, +the word is not yet defined and the next blocks is loaded. +E.g. a words like forthcode({?32}) mark 32-bits code and the +screen is terminated if the Forth is 64 bits. +This goes on until the word is defined, or the end of the +screens is reached. +The terminators that cut loading a screen short, are +defined by the the forthcode({CONFIG}) defining word. +The last screen is marked by an empty index line. +There may be names that represent a whole package. +Among those symbolic names are forthsamp({-fp- -fpwa- ASSEMBLERi86 +ASSEMBLERi86-HIGH -traditional- }). +After forthcode({WANT}) symbolic names may not be in the dictionary, +but note that they are not intended to be executed anyway. + +There is really nothing much to it. +The bottom line is that one library file serves a range +of operating systems and cell sizes. The library file contains examples for you to load using forthcode({WANT}) . @@ -226,34 +244,6 @@ SEE TUCK}) show you the source for TUCK if it is in the library or in the kernel, but without comment or usage information. -@section Configuring -For configuring your thisforth, -you may use forthcode({"newforth" SAVE-SYSTEM}) . -This will do most of the time, -but then you build in the forthcode({SAVE-SYSTEM}) command as well. -For configuring your thisforth, without enlarging the dictionary, -you may use the following sequence -forthexample({ S" myforth.lab" BLOCK-FILE $! \ Or any configuration command -1 LOAD -WANT SAVE-SYSTEM -: DOIT - '_pad 'FORTH FORGET-VOC - '_pad >NFA @@ DP ! - "newforth" SAVE-SYSTEM BYE ; -DOIT }) -Here forthvar({DOIT}) trims the dictionary just before -saving your system into a file. -forthcode({_pad}) is the first word of -the facilities in screen 1 that was loaded. -(This was different in previous version of ciforth.) - -forthcode({FAR-DP}) allows to have a disposable part of the -dictionary. -If you decide to use this facility for your own purposes, -make sure to always forthcode({FORGET}) the disposed off words. -The forthsamp({-c}) option uses this to avoid having -source files as part of an executable image. - @section Concepts A forth user is well aware of how the memory of his @@ -454,11 +444,13 @@ Files are not read line by line, but read in full and evaluated. _CIF_IN_({ forthitem -It uses forthcode({PP}) instead of the ISO forthcode({>IN}) -The forthcode({>IN}) that is available via the library is a fake, that can only be -read, but changing it has no effect. -forthcode({PP}) can be manipulated to have such effects as the familiar -forthcode({0 >IN !}) idiom. +It uses forthcode({PP}) instead of the ISO forthcode({>IN}). +The forthcode({>IN}) that is available via the library is to be +loaded only via forthcode({WANT -traditional-}) and then work as +in expected. +In particular forthcode({INCLUDED}) compiles a file line by line. +forthcode({PP}) could be manipulated to have such effects manipulating + forthcode({>IN}) }) dnl forthitem Counting in do loops do not wrap through the boundary between @@ -486,12 +478,14 @@ ciforth-specific and thisforth-specific -- but hopefully documented -- behaviour Understanding it requires some study of non-portable facilities. forthitem When a file is forthcode({INCLUDED}) it is read in as a whole, -so there is never a need for forthcode({REFILL}) . +so there is no need for forthcode({REFILL}) . After forthcode({ WANT REFILL}) a forthcode({REFILL}) is loaded that sets the parse pointer to the start of the next line. -In nearly all cases this will accomplish the effect described by the standard. -dnl The effect of forthcode({ 0 >IN !}) can be had by forthcode({UNFILL}). -dnl After forthcode({WANTREFILL }) +Moreover forthcode({0>IN}) will set the parse pointer to the start of +the current line. +In many cases this will accomplish the effect described by the standard. +If this doesn't help, use forthcode({-traditional-}) . +forthxref({Manual}), subsection forthsamp({REFILL}) . forthendenumerate @@ -536,7 +530,36 @@ where you want your code to run on. By using forthcode({CELL+}) it is easy to keep your code 16/32/64 bit clean. This means that it runs on 16, 32 and 64 bits systems. -@section Compatibility with thisforth 4.0.x +@subsection REFILL +Some programs rely on line by line loading by forthcode({REFILL}) . +This is substantially different from normal ciforth practice. +You want at least forthcode({REFILL}) forthcode({>IN}) , +and you probably use forthcode({WORD}) and forthcode({FIND}) and +the (traditional, but non standard) word of forthcode({VOCABULARY}) that +is different from forthcode({NAMESPACE}) . +This is accomplished by the symbolic target of forthdefi({-traditional-}). +forthexample( +{WANT -traditional- }) +All the words that are loaded by this command are in the library and +they are marked with forthsamp({-traditional-}) in the index line. +The word forthcode({-traditional-}) is not itself defined, expect to get +get a warning for that. +This is done in order to be able to reload (and forcibly redefine) all words +by forthcode({WANT -traditional-}) . + +It is recommended that this is the first facility loaded, +that way there is the least chance with interference. +The following sequence generates a traditional Forth: +forthexample({ +lina -a +WANT -traditional- SAVE-SYSTEM +.... +"traditionalforth" SAVE-SYSTEM +BYE +}) +It is of course possible to enhance this Forth with more words +at the place of the dots. +@subsection Compatibility with thisforth 4.0.x Since version 5.x changes have been made to increase compatibility with existing practice. By invoking forthcode({WANT -legacy-}) you load a screen that @@ -547,11 +570,13 @@ In either case, those programs have been tested with version 5.x What the legacy items are can be seen from the screen that has forthcode({-legacy-}) in its index line. -In particular forthcode({REQUIRE REQUIRED PRESENT? VOCABULARY -WORD FIND (WORD) (PARSE) SAVE-INPUT RESTORE-INPUT }) are +In particular forthcode({REQUIRE REQUIRED PRESENT? }) are to be found in those screens. Note that by using legacy items your code may be in conflict with upcoming standards. +It is also likely that in those programs traditional words are used +that are no longer present in the kernel such as forthcode({WORD FIND }). +These can be loaded by regular forthcode({WANT}) . The names forthcode({VOCABULARY}) and forthcode({REQUIRE}) are being proposed for standardisation. @@ -563,6 +588,34 @@ forthcode({VOCABULARY}) is renamed to forthcode({NAMESPACE}), with the difference that forthcode({NAMESPACE}) is not immediate. This allows to include the new standardised definitions in a loadable screen. +@section Configuring +For configuring your thisforth, +you may use forthcode({"newforth" SAVE-SYSTEM}) . +This will do most of the time, +but then you build in the forthcode({SAVE-SYSTEM}) command as well. +For configuring your thisforth, without enlarging the dictionary, +you may use the following sequence +forthexample({ S" myforth.lab" BLOCK-FILE $! \ Or any configuration command +1 LOAD +WANT SAVE-SYSTEM +: DOIT + '_pad 'FORTH FORGET-VOC + '_pad >NFA @@ DP ! + "newforth" SAVE-SYSTEM BYE ; +DOIT }) +Here forthvar({DOIT}) trims the dictionary just before +saving your system into a file. +forthcode({_pad}) is the first word of +the facilities in screen 1 that was loaded. +(This was different in previous version of ciforth.) + +forthcode({FAR-DP}) allows to have a disposable part of the +dictionary. +If you decide to use this facility for your own purposes, +make sure to always forthcode({FORGET}) the disposed off words. +The forthsamp({-c}) option uses this to avoid having +source files as part of an executable image. + @section Saving a new system We have said it before: ``Programming Forth is extending the Forth language.''. A facility to save your system after it has been extended is essential. @@ -636,10 +689,17 @@ The dictionary forthitem Free memory, available for dictionary, from below, and stacks, from above forthitem -Stacks and -the input buffer for the console -_HIGH_BUF_({and disk block buffers}) -. +The work area for each task with a total size of forthcode({TASK-SIZE}) +that must be a power of two. +This may be replicated for multi-tasking. +It is evenly divided into the data stack, the return stack and user variables, +the input buffer for the console, _HIGH_BUF_({and disk block buffers}). +The work area is initialised on startup. +_THREADS_({ +These areas have an alignment of 1/4 of the forthcode({TASK-SIZE}) . +This way the return stack pointer can serve double duty as a user pointer; +this is one register less to save for a task switch. +}) forthenditemize The lowest part of the free memory is used as a scratch area: forthcode({PAD}) . _LOW_BUF_({The disk block buffers are allocated in the dictionary, @@ -830,7 +890,7 @@ forthsamp({ "mysrc.frt" INCLUDED }) forthbreak })forthxref(Manual) Section Getting Started. forthbreak -In an installed system you will put forthsamp({WANT OS-IMPORT WANT INCLUDE}) +In an installed system you will put forthsamp({WANT OS-IMPORT INCLUDE}) in your electives screen (5), and just type forthsamp({vim mysrc.frt}) to edit a file, without leaving thisforth and load it with forthsamp({INCLUDE mysrc.frt}) @@ -1218,7 +1278,14 @@ name of the binary, otherwise the binary is called forthfile({a.out}). Upon invocation of the binary the word defined latest is executed, then Forth goes forthcode({BYE}) . _VERBOSE_({ forthfile({name}) {is a regular source file, not a block file.}}) -In addition forthcode({WANT}) and ARG[] are made available. +In addition forthcode({WANT}) and forthcode({ARG[]}) are made available. +The source of the source file is temporarily stored in a kind of far +forthcode({PAD}) . +The source is not part of the resulting binary, +as would be the case if it is built with forthcode({TURNKEY}). +A far forthcode({PAD}) can cause problems if during compilation the program +allocates a large amount of memory to touch that area; +in that case use the -g option that make a larger Forth. forthitem forthsamp({-d name }) @@ -1323,10 +1390,31 @@ forthsamp({ls more cat cd echo make }) can be typed to Forth as if it where a sh forthcode({OS-IMPORT}) is made available to add to this list. }) +forthitem +forthsamp({-n }) + +This is an option intended for newbies. +It loads forthcode({AUTOLOAD}) forthcode({WANT}) and prints the +stack after each command. +Autoload means that if you type in an unknown Forth word, +an attempt is made to load it from the library. +You can see the forthdefi({index lines }) of the facilities that are +loaded. +The definition that you are compiling is interrupted and a jump +is made over the space you are using for the new definition. +That works for smallish definitions, but not for complete +facilities like floating point or an assembler. +Thus this is for convenience only, and not absolutely reliable. +It may succeed right away, or you have to repeat the command you give. +If it fails, you can resort to forthsamp({WANT }). +After development you should never rely on forthcode({AUTOLOAD}) but paste the +lines with forthcode({WANT}) in your source. +They are printed for convenience. + forthitem forthsamp({-p}) -forthemph({Reserved option, not implemented.}) +forthemph({Reserved}) option, not implemented. forthbreak Be pedantic about ISO. Redefine some words to follow the standard as closely as possible. @@ -1352,15 +1440,6 @@ This follows the Unix conventions for script files. If you set the execute bit the file file becomes a command and accepts arguments. }) -forthitem -forthsamp({-t sourcefile}) - -Try to load the file forthfile({script}) automatically, by possibly unsafe means. -Report facilities that were required. -This is a first step in a porting activity. -_VERBOSE_({Redefinition messages are issued on the error channel that -can be redirected to /dev/nul leaving the report.}) - forthitem forthsamp({-v}) diff --git a/masm.m4 b/masm.m4 index 9ed750c..e7ff63c 100644 --- a/masm.m4 +++ b/masm.m4 @@ -1,4 +1,4 @@ -dnl $Id: masm.m4,v 5.6 2017/11/10 18:33:43 albert Exp $ +dnl $Id: masm.m4,v 5.7 2024/04/09 16:00:12 albert Exp $ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License divert(-1)dnl dnl Take care of embedded double quotes by using single quotes. @@ -46,6 +46,8 @@ define({_ENDOFPROGRAM},{ END $1 })dnl define({_ALIGN},{ALIGN $1})dnl +define({_CODE},{dnl}) +define({_DATA},{dnl}) define({DSS},{DB})dnl dnl Work around because of poor performance of .NET assembler. define({A32},{DB 0x67 diff --git a/nasm.m4 b/nasm.m4 index 5677dd8..300cd03 100644 --- a/nasm.m4 +++ b/nasm.m4 @@ -1,4 +1,4 @@ -dnl $Id: nasm.m4,v 5.18 2017/11/10 18:33:43 albert Exp $ +dnl $Id: nasm.m4,v 5.19 2024/04/09 16:00:12 albert Exp $ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License divert(-1) dnl Take care of embedded double quotes by using single quotes. @@ -99,6 +99,8 @@ define({SET_16_BIT_MODE},{BITS 16}) define({SET_32_BIT_MODE},{BITS 32}) define({SET_64_BIT_MODE},{BITS 64}) define({_ALIGN},{ALIGN M4_CELLWIDTH}) +define({_CODE_},{dnl}) +define({_DATA_},{dnl}) define({DSS},{DB}) dnl A nobits section takes no place in the object file. define({_TEXT_},{section .text}) diff --git a/optimiser.mi b/optimiser.mi index d6a31a6..ceea141 100644 --- a/optimiser.mi +++ b/optimiser.mi @@ -42,7 +42,7 @@ if it only pops, what it has pushed itself, and the stack is left with the same depth as before. A sequence is called stable if it is stable with respect to -anything that is relevant in the contest, mostly with respect to +anything that is relevant in the context, mostly with respect to everything. @subsection Notations @@ -461,7 +461,7 @@ of a basic block. Thereafter the code can be replaced by machine code as is found in the constituent words. This code is inspected by a peep hole optimiser, eliminating e.g. a push pop sequences. In exceptional cases Forth -calls to high level code, may need to be inserted, which block +calls to high level code, may need to be inserted. This blocks probably most possibilities for further optimisation. Originally a DO LOOP looks like diff --git a/options.frt b/options.frt index 7eae5c5..f7592d1 100644 --- a/options.frt +++ b/options.frt @@ -46,7 +46,7 @@ CREATE _pad 80 ALLOT \ Word surrounded by spaces \ -( -c PROGRAM :_compile_PROGRAM_to_binary ) \ AvdH C0jun03 +( -c PROGRAM :_compile_PROGRAM_to_binary ) \ AvdH C4apr05 "1 LOAD" "WANT" PRESENT 0= AND EVALUATE \ idempotent WANT OLD: TURNKEY SWAP-DP WANT ARG[] INCLUDE SRC>EXEC @@ -60,7 +60,7 @@ WANT ARG[] INCLUDE SRC>EXEC 'TASK '.SIGNON 3 CELLS MOVE \ No sign on. : REGRESS POSTPONE \ ; IMMEDIATE \ Turn off regression test ARGC 3 < 13 ?ERROR -2 ARG[] INCLUDED +2 ARG[] INCLUDED 4096 ALLOT \ one extra page LATEST 2 ARG[] SRC>EXEC TURNKEY ( -d :_add_defined_then_include ) \ Run a program that uses [DEFINED] to run on other Forths @@ -78,10 +78,10 @@ ARGC 3 < 13 ?ERROR \ -( -e :_Load_system_electives ) \ AvdH A3sep01 +( -e :_Load_system_electives ) \ C2Dec28 AvdH "1 LOAD" "WANT" PRESENT 0= AND EVALUATE \ Idempotent .SIGNON CR 0 MESSAGE CR 0 BLOCK B/BUF TYPE -\ "-legacy-" WANTED \ If you want this, it must be up front +\ WANT -traditional- \ If you want this, it must be up front WANT INCLUDE CONFIG ORDER WANT H. DUMP WANT HELP SEE LOCATE $. @@ -142,22 +142,22 @@ OK BYE \ -( -i BINARY-PATH LIBRARY-PATH SHELL-PATH ) \ C2jul10 -CREATE task 1 LOAD - "ARG[]" WANTED "SAVE-SYSTEM" WANTED +( -i BINARY-PATH LIBRARY-PATH SHELL-PATH ) \ C4apr21 +CREATE _task 1 LOAD +WANT ARG[] SAVE-SYSTEM _exename : INSTALL-LIB BLOCK-FILE $@ -TRAILING GET-FILE 3 ARG[] PUT-FILE 3 ARG[] BLOCK-FILE $! ; \ Trim back to before ``task''. Save system at binary path. \ Must be done all at once, because of forgetting. -: INSTALL-BIN 'task DUP 'FORTH FORGET-VOC >NFA @ DP ! - 2 ARG[] SAVE-SYSTEM BYE ; -\ Specify shell name. -: INSTALL-SHELL 4 ARG[] SHELL $! ; +\ : INSTALL-SHELL ; +: INSTALL-SHELL OVER BM' >R 4 ARG[] SHELL BM - R> + $! ; +: INSTALL-BIN _exename GET-FILE + ARGC 5 = IF INSTALL-SHELL THEN + 2 ARG[] PUT-FILE ; : DOIT ARGC 4 6 WITHIN 0= IF ." -i requires 2 or 3 arguments" CR BYE THEN - ARGC 5 = IF INSTALL-SHELL THEN INSTALL-LIB INSTALL-BIN ; + INSTALL-LIB INSTALL-BIN BYE ; DOIT -\ ( -j :_This_option_is_available ) @@ -222,14 +222,14 @@ SWITCH-LIBS \ -( -n :_This_option_is_available ) - - - - - - - +( -n : "newby" AUTOLOAD ) \ C3jan31 +"1 LOAD" "WANT" PRESENT 0= AND EVALUATE \ idempotent +WANT AUTOLOAD +WANT DO-DEBUG +WANT CASE-INSENSITIVE +.SIGNON CR 0 MESSAGE CR 0 BLOCK B/BUF TYPE +"autoload on, case insensitive " TYPE CR +"stack printing on, index lines printing on" TYPE CR @@ -254,10 +254,10 @@ SWITCH-LIBS \ -( -p :_Load_system_preferences ) \ AvdH A1oct02 +( -p :_pedantic ) \ C3nov06 AvdH 1 LOAD - "-legacy-" WANTED \ Must be first to WANT -"Pedantic is not implemented but ""-legacy-"" WANTED + "-traditional-" WANTED \ Preferably first +"Pedantic is not implemented but ""-traditional-"" WANTED goes a long way." TYPE @@ -318,21 +318,21 @@ SCRIPT-NAME $@ GET-FILE "-scripting-" WANTED ^J $/ 2DROP \ Line with #!lina EVALUATE BYE -( -t FILE :_Try_to_compile_FILE_by_all_means ) \ AvdH A1oct26 -.SIGNON 1 LOAD -\ Reload "with" WANTED new ``CORA'' but hide it direct after. - "CORA-IGNORE" WANTED -: CORA CORA-IGNORE ; 1 LOAD 'CORA HIDDEN +( -t :_This_option_is_available ) + + + + + + + + + + + + - "[IF]" WANTED "ARG[]" WANTED "PREFIX" WANTED - "CASE-INSENSITIVE" WANTED CASE-INSENSITIVE - "NO-SECURITY" WANTED NO-SECURITY - "AUTOLOAD" WANTED AUTOLOAD -ARGC 3 < 13 ?ERROR -2 ARG[] INCLUDED -SECOND-PASS @ 0= ?LEAVE-BLOCK -2 ARG[] INCLUDED \ ( -u :_This_option_is_available ) @@ -353,8 +353,8 @@ SECOND-PASS @ 0= ?LEAVE-BLOCK ( -v :_Version_and_copyright_information_) "CPU NAME VERSION" TYPE .SIGNON CR "LIBRARY FILE: " TYPE -0 MESSAGE -"$RCSfile: options.frt,v $ $Revision: 5.51 $" TYPE CR +" for M4_VERSION " TYPE 0 MESSAGE +"$RCSfile: options.frt,v $ $Revision: 5.55 $" TYPE CR CR 0 BLOCK B/BUF TYPE BYE diff --git a/prelude.m4 b/prelude.m4 index 69bfd08..799d9c8 100644 --- a/prelude.m4 +++ b/prelude.m4 @@ -1,4 +1,4 @@ -dnl $Id: prelude.m4,v 5.13 2015/06/02 12:44:47 albert Exp $ +dnl $Id: prelude.m4,v 5.14 2023/10/22 19:37:55 albert Exp $ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License divert(-1)dnl dnl @@ -277,6 +277,9 @@ dnl dnl The fields in the dictionary headers are aligned to a cell boundary. define( {_ALIGNED_}, _no)dnl dnl +dnl The code and data areas are separated. +define( {_SEPARATED_}, _no)dnl +dnl dnl ############## USER CHOICES END ######################################### diff --git a/rational.mi b/rational.mi index 0c5df87..4612e8d 100644 --- a/rational.mi +++ b/rational.mi @@ -1,5 +1,5 @@ dnl $ Id: $ -dnl Copyright{2000,2001}: Albert van der Horst, HCC FIG Holland by GNU Public License +dnl Copyright{2000,2024}: Albert van der Horst, HCC FIG Holland by GNU Public License @section Legalese This application currently is copyright by M4_SUPPLIER. This Forth is called ciforth and is made available by the diff --git a/wina32.cfg b/wina32.cfg index 19b58cd..c9b8f80 100644 --- a/wina32.cfg +++ b/wina32.cfg @@ -1,4 +1,4 @@ -dnl $Id: wina32.cfg,v 5.1 2022/02/21 11:38:10 albert Exp $ +dnl $Id: wina32.cfg,v 5.2 2024/04/20 11:40:01 albert Exp $ dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License dnl dnl CONFIGURATION FILE @@ -17,6 +17,7 @@ define( {_EXTRAFIELD_}, _yes)dnl define( {_THREADS_}, _yes) dnl 1 Mbyte dnl define({M4_EM}, 0x00100000) +dnl 4 Mbyte is the lowest for -i option. dnl 4 Mbyte dnl define({M4_EM}, 0x00400000) dnl 8 Mbyte diff --git a/wina64.cfg b/wina64.cfg new file mode 100644 index 0000000..c77a265 --- /dev/null +++ b/wina64.cfg @@ -0,0 +1,30 @@ +dnl $Id: wina64.cfg,v 5.2 2024/04/20 11:40:01 albert Exp $ +dnl Copyright(2000): Albert van der Horst, HCC FIG Holland by GNU Public License +dnl +dnl CONFIGURATION FILE +dnl FOR REGULAR 64-BIT WINDOWS (7+) VERSION +dnl FOR fas (+MASM +NASM +GNU_as) +dnl +dnl CONFIGURE THE COMMAND INTERPRETER DURING INSTALLATION +dnl +include(prelude.m4) +define( {_BITS64_}, _yes ) +define( {_DLL_}, _yes ) +define( {_MODERN_}, _no ) +define( {_ALIGNED_}, _yes) +define( {_EXTRAFIELD_}, _yes)dnl +define( {_THREADS_}, _yes) +dnl 1 Mbyte +dnl define({M4_EM}, 0x00100000) +dnl 4 Mbyte is the lowest for -i option. +dnl 4 Mbyte +dnl define({M4_EM}, 0x00400000) +dnl 8 Mbyte +dnl define({M4_EM}, 0x00800000) +dnl 32 Mbyte +dnl define({M4_EM},0x02000000) +dnl 64 Mbyte +define({M4_EM},0x04000000) +dnl 1Gbyte +dnl define({M4_EM},0x100000000) +include(postlude.m4)