From 2716f2d4f41839125c31a6c3cfcd43a0db94422d Mon Sep 17 00:00:00 2001 From: Albert van der Horst Date: Thu, 12 Jan 2017 11:24:26 +0100 Subject: [PATCH] A few missing files and usage of cvs fixed. --- hellow.frt | 1 + officialdecompilation | 2075 +++++++++++++++++++++++++++++++++++++++++ test.mak | 4 +- 3 files changed, 2078 insertions(+), 2 deletions(-) create mode 100644 hellow.frt create mode 100644 officialdecompilation diff --git a/hellow.frt b/hellow.frt new file mode 100644 index 0000000..3ac8915 --- /dev/null +++ b/hellow.frt @@ -0,0 +1 @@ +: hw ." Hello world!" CR ; diff --git a/officialdecompilation b/officialdecompilation new file mode 100644 index 0000000..7ef974e --- /dev/null +++ b/officialdecompilation @@ -0,0 +1,2075 @@ + +80386 ciforth beta $RCSfile$ $Revision$ + + +COPYRIGHT (c) 2000-2016 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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public +License along with this program; if not, write to the + Free Software Foundation, Inc., + 59 Temple Place, Suite 330, Boston, MA 02111, USA. + + OK +( data ) NAMESPACE ONLY +( data ) NAMESPACE ENVIRONMENT + +Code definition : NOOP + +Code definition : LIT + +Code definition : EXECUTE + +: RECURSE +LATEST , +; IMMEDIATE + +Can't handle : BRANCH + +Code definition : SKIP + +Code definition : 0BRANCH + +Code definition : (LOOP) + +Code definition : (+LOOP) + +Code definition : (DO) + +Code definition : (?DO) + +Code definition : I + +Code definition : J + +Code definition : UNLOOP + +: +ORIGIN +0804BLABLA + +; + +Code definition : DIGIT + +: ~MATCH +>R 2DUP R@ >NFA @ $@ ROT MIN CORA-IGNORE R> SWAP +; + +: ?BLANK +BL 1+ < +; + +: PP@@ +SRC CELL+ 2@ OVER = +0BRANCH [ C , ] ( between ? DUP ) 0 +BRANCH [ 14 , ] ( between +! (;) ) DUP C@ 1 PP +! +; + +: NAME +_ DROP PP@@ ?BLANK OVER SRC CELL+ @ - AND 0= +0BRANCH [ -30 , ] ( between _ DROP ) _ DROP PP@@ ?BLANK +0BRANCH [ -14 , ] ( between _ DROP ) OVER - +; + +: PARSE +SRC CELL+ 2@ OVER - ROT $/ 2SWAP 0= +0BRANCH [ 10 , ] ( between @ PP ) DROP SRC CELL+ @ PP ! +; + +6C USER SRC + +: SOURCE +SRC 2@ SWAP OVER - +; + +: CR +0000,000A EMIT 0 OUT ! +; + +Code definition : CMOVE + +Code definition : MOVE + +Code definition : FARMOVE + +Code definition : UM* + +Code definition : UM/MOD + +Code definition : AND + +Code definition : OR + +Code definition : XOR + +Code definition : INVERT + +Code definition : DSP@ + +Code definition : DSP! + +: DEPTH +S0 @ DSP@ - 0000,0004 / 1- +; + +: CLS +S0 @ DSP! +; + +Code definition : RSP@ + +Code definition : RSP! + +Code definition : EXIT + +Code definition : CO + +Can't handle : (;) + +: LEAVE +UNLOOP +; + +Code definition : >R + +Code definition : R> + +Code definition : RDROP + +Can't handle : R@ + +Code definition : 0= + +Code definition : 0< + +Code definition : + + +Code definition : D+ + +Code definition : NEGATE + +Code definition : DNEGATE + +Code definition : OVER + +Code definition : DROP + +Code definition : NIP + +Code definition : 2DROP + +Code definition : SWAP + +Code definition : DUP + +Code definition : 2DUP + +Code definition : 2SWAP + +Code definition : 2OVER + +Code definition : +! + +Code definition : TOGGLE + +Code definition : @ + +Code definition : C@ + +Code definition : 2@ + +Code definition : ! + +Code definition : C! + +Code definition : 2! + +: WITHIN +OVER - >R - R> U< +; + +Code definition : FAR@ + +Code definition : FAR! + +: : +!CSP NAME (CREATE) LATEST HIDDEN ] +;CODE plus code (suppressed) +; + +: ; +?CSP '(;) , LATEST HIDDEN POSTPONE [ +; IMMEDIATE + +: CONSTANT +NAME (CREATE) LATEST >DFA ! +;CODE plus code (suppressed) +; + +: VARIABLE +DATA 0 , +; + +: DATA +NAME (CREATE) +;CODE plus code (suppressed) +; + +: USER +CONSTANT +;CODE plus code (suppressed) +; + +Code definition : _ + +0000,0000 CONSTANT 0 + +0000,0001 CONSTANT 1 + +0000,0002 CONSTANT 2 + +0000,0020 CONSTANT BL + +Code definition : $@ + +: $! +2DUP ! CELL+ SWAP MOVE +; + +: $+! +DUP @ >R 2DUP +! CELL+ R> + SWAP MOVE +; + +: $C+ +DUP >R DUP @ + CELL+ C! 1 R> +! +; + +: $, +HERE >R DUP CELL+ ALLOT R@ $! R> ALIGN +; + +0000,0040 CONSTANT C/L + +0C04,5FA0 CONSTANT _FIRST + +0C04,7FE0 CONSTANT _LIMIT + +0C04,7FE0 CONSTANT EM + +0804BLABLA CONSTANT BM + +0001,0000 CONSTANT TASK-SIZE + +0000,0400 CONSTANT B/BUF + +04 USER U0 + +08 USER S0 + +0C USER R0 + +10 USER TIB + +14 USER RUBOUT + +1C USER WARNING + +20 USER FENCE + +24 USER DP + +28 USER VOC-LINK + +2C USER MAX-USER + +30 USER WHERE + +84 USER SCR + +48 USER STATE + +4C USER BASE + +50 USER DPL + +54 USER FLD + +58 USER CSP + +5C USER R# + +60 USER HLD + +64 USER OUT + +68 USER (BLK) + +74 USER PP + +78 USER (>IN) + +7C USER ARGS + +80 USER HANDLER + +88 USER CURRENT + +38 USER REMAINDER + +94 USER OFFSET + +98 USER CONTEXT + +: 1+ +1 + +; + +: CELL+ +0000,0004 + +; + +: CELLS +2 LSHIFT +; + +: CHAR+ +1 + +; + +: CHARS + +; + +: ALIGN +DP @ ALIGNED DP ! +; + +Code definition : ALIGNED + +: HERE +DP @ +; + +: ALLOT +DP +! +; + +: , +HERE 0000,0004 ALLOT ! +; + +: C, +HERE 1 ALLOT C! +; + +Code definition : - + +: = +- 0= +; + +Code definition : < + +Code definition : U< + +: > +SWAP < +; + +: <> +- 0= 0= +; + +Code definition : ROT + +: SPACE +BL EMIT +; + +: ?DUP +DUP +0BRANCH [ 4 , ] ( between DUP (;) ) DUP +; + +: LATEST +CURRENT @ >LFA @ +; + +: >CFA +0000,0000 + +; + +: >DFA +0000,0004 + +; + +: >FFA +0000,0008 + +; + +: >LFA +0000,000C + +; + +: >NFA +0000,0010 + +; + +: >SFA +0000,0014 + +; + +: >XFA +0000,0018 + +; + +: >PHA +0000,001C + +; + +: >BODY +>DFA @ CELL+ +; + +: BODY> +0000,0020 - +; + +: >WID +>BODY CELL+ +; + +: >VFA +>BODY +; + +: !CSP +DSP@ CSP ! +; + +: ?ERROR +SWAP +0BRANCH [ 24 , ] ( between ? DROP ) PP @ SRC @ WHERE 2! THROW +BRANCH [ 4 , ] ( between DROP (;) ) DROP +; + +: ?ERRUR +0 MIN DUP ?ERROR +; + +: ?DELIM +PP@@ ?BLANK 0= 0000,000A ?ERROR DROP +; + +: ?CSP +DSP@ CSP @ - 0000,0014 ?ERROR +; + +: ?COMP +STATE @ 0= 0000,0011 ?ERROR +; + +: ?PAIRS +- 0000,0013 ?ERROR +; + +: [ +0 STATE ! +; IMMEDIATE + +: ] +1 STATE ! +; + +: HIDDEN +>FFA 0000,0002 TOGGLE +; + +: HEX +0000,0010 BASE ! +; + +: DECIMAL +0000,000A BASE ! +; + +: (;CODE) +R> LATEST >CFA ! +; + +: CREATE +NAME (CREATE) 0804BLABLA , +;CODE plus code (suppressed) +; + +: DOES> +R> LATEST >DFA @ ! +; + +: COUNT +DUP 1+ SWAP C@ +; + +: -TRAILING +DUP 0 +?DO OVER OVER + 1 - C@ ?BLANK 0= +0BRANCH [ 4 , ] ( between LEAVE 1 ) LEAVE 1 - +LOOP +; + +: S" +POSTPONE " +; IMMEDIATE + +: ." +POSTPONE " STATE @ +0BRANCH [ 14 , ] ( between ? TYPE ) 'TYPE , +BRANCH [ 4 , ] ( between TYPE (;) ) TYPE +; IMMEDIATE + +: .( +0000,0029 PARSE TYPE +; IMMEDIATE + +: SET-SRC +OVER + OVER SRC 2! PP ! +; + +: EVALUATE +SAVE SET-SRC 'INTERPRET CATCH RESTORE THROW +; + +Code definition : FILL + +Code definition : CORA + +Code definition : $^ + +Code definition : $/ + +: ERASE +0 FILL +; + +: BLANK +BL FILL +; + +: HOLD +FFFF,FFFF HLD +! HLD @ C! +; + +: PAD +HERE 0000,0114 + +; + +: CHAR +NAME DROP C@ +; + +: [CHAR] +CHAR POSTPONE LITERAL +; IMMEDIATE + +: (NUMBER) +0 0 0 DPL ! PP@@ DUP 0000,002E = +0BRANCH [ 14 , ] ( between ? DUP ) DROP DPL ! +BRANCH [ -30 , ] ( between ! PP@@ ) DUP 0000,002C = +0BRANCH [ C , ] ( between ? DUP ) 2DROP +BRANCH [ -54 , ] ( between ! PP@@ ) DUP ?BLANK 0= +0BRANCH [ 50 , ] ( between ? 2DROP ) NIP BASE @ DIGIT 0= 0000,000A ?ERROR SWAP BASE @ UM* DROP ROT BASE @ UM* D+ +BRANCH [ -B8 , ] ( between ! PP@@ ) 2DROP +; + +: NUMBER +FFFF,FFFF PP +! (NUMBER) POSTPONE SDLITERAL +; + +: >NUMBER +2DUP + >R 0 +?DO DUP C@ BASE @ DIGIT 0= +0BRANCH [ 8 , ] ( between LEAVE SWAP ) DROP LEAVE SWAP >R SWAP BASE @ UM* DROP ROT BASE @ UM* D+ R> 1+ +LOOP R> OVER - +; + +: FOUND +CONTEXT >R R@ @ (FIND) DUP 0= +0BRANCH [ 38 , ] ( between 0 RDROP ) DROP R@ @ 0804BLABLA - +0BRANCH [ 14 , ] ( between ? 0 ) R> CELL+ >R +BRANCH [ -50 , ] ( between >R R@ ) 0 RDROP NIP NIP +; + +: PRESENT +DUP >R FOUND DUP +0BRANCH [ 1C , ] ( between AND RDROP ) DUP >NFA @ @ R@ = AND RDROP +; + +: OPT + +; + +: (FIND) +OPT DUP +0BRANCH [ AC , ] ( between ? (;) ) ~MATCH +0BRANCH [ 20 , ] ( between ? 2DUP ) >LFA @ DUP 0= +0BRANCH [ -34 , ] ( between ? OPT ) +BRANCH [ 80 , ] ( between ? (;) ) 2DUP >NFA @ @ < 0= +0BRANCH [ -40 , ] ( between ? >LFA ) 2DUP >NFA @ @ - +0BRANCH [ 20 , ] ( between ? DUP ) DUP >FFA @ 0000,0008 AND +0BRANCH [ -7C , ] ( between ? >LFA ) DUP >FFA @ 0000,0003 AND 0= +0BRANCH [ -A0 , ] ( between ? >LFA ) +; + +: ERROR +WHERE 2@ OVER +0BRANCH [ 40 , ] ( between ? OVER ) OVER 0000,0014 - MAX SWAP 1- DUP C@ ?BLANK 0= +0BRANCH [ C , ] ( between ? OVER ) 1+ +BRANCH [ -24 , ] ( between 1- DUP ) OVER - ETYPE +[ " ? ciforth ERROR # " ] DLITERAL ETYPE BASE @ DECIMAL OVER S>D 0 (D.R) ETYPE BASE ! FFFF,FF00 MAX 0000,003F MIN 'MESSAGE CATCH DROP +; + +: CATCH +DSP@ CELL+ >R HANDLER @ >R RSP@ HANDLER ! EXECUTE R> HANDLER ! RDROP 0 +; + +: THROW +DUP +0BRANCH [ 58 , ] ( between _ DROP ) HANDLER @ 0= +0BRANCH [ 14 , ] ( between QUIT HANDLER ) ERROR S0 @ DSP! QUIT HANDLER @ RSP! R> HANDLER ! R> SWAP >R DSP! R> _ DROP +; + +: (ABORT") +ROT +0BRANCH [ 10 , ] ( between ? 2DROP ) ETYPE ABORT +BRANCH [ 4 , ] ( between 2DROP (;) ) 2DROP +; + +: ABORT" +?COMP POSTPONE " '(ABORT") , +; IMMEDIATE + +: ID. +DUP >FFA @ 0000,0001 AND +0BRANCH [ C , ] ( between ? >NFA ) DROP +BRANCH [ 1C , ] ( between SPACE (;) ) >NFA @ $@ TYPE SPACE SPACE SPACE +; + +: HEADER +DUP 0= 0000,0005 ?ERROR 2DUP PRESENT DUP +0BRANCH [ 20 , ] ( between _ DROP ) >NFA @ $@ ETYPE 0000,0004 MESSAGE _ DROP ALIGN $, ALIGN HERE >R R@ >PHA , R@ >PHA , 0 , 0 , , BLK @ DUP 0= +0BRANCH [ C , ] ( between @ , ) DROP PP @ , 0 , R> +; + +: LINK +>LFA 2DUP @ SWAP >LFA ! ! +; + +: (CREATE) +HEADER CURRENT @ LINK +; + +: [COMPILE] +NAME PRESENT DUP 0= 0000,0010 ?ERROR >CFA , +; IMMEDIATE + +: POSTPONE +NAME PRESENT DUP 0= 0000,000F ?ERROR DUP >FFA @ 0000,0004 AND 0= +0BRANCH [ 18 , ] ( between , , ) 'LIT , , ', , +; IMMEDIATE + +: LITERAL +STATE @ +0BRANCH [ 10 , ] ( between , (;) ) 'LIT , , +; IMMEDIATE + +: DLITERAL +STATE @ +0BRANCH [ C , ] ( between LITERAL (;) ) SWAP POSTPONE LITERAL POSTPONE LITERAL +; IMMEDIATE + +: SDLITERAL +DPL @ +0BRANCH [ C , ] ( between ? DROP ) POSTPONE DLITERAL +BRANCH [ 8 , ] ( between LITERAL (;) ) DROP POSTPONE LITERAL +; IMMEDIATE + +: ?STACK +DSP@ S0 @ SWAP U< 1 ?ERROR DSP@ HERE 0000,0080 + U< 0000,0007 ?ERROR +; + +: INTERPRET +NAME DUP +0BRANCH [ A8 , ] ( between ? DROP ) OVER >R FOUND DUP 0= 0000,000C ?ERROR DUP >FFA @ DUP 0000,0008 AND +0BRANCH [ 20 , ] ( between ! RDROP ) OVER >NFA @ @ R@ + PP ! RDROP 0000,0004 AND STATE @ 0= OR +0BRANCH [ C , ] ( between ? , ) EXECUTE +BRANCH [ 4 , ] ( between , ?STACK ) , ?STACK +BRANCH [ -B8 , ] ( between ? NAME ) DROP DROP +; + +: IMMEDIATE +LATEST >FFA 0000,0004 TOGGLE +; + +: PREFIX +LATEST >FFA 0000,0008 TOGGLE +; + +: NAMESPACE +CREATE LATEST VOC-LINK @ , VOC-LINK ! 0 , 0 , 0000,0001 , 0 , 0804BLABLA , 0 , 0 , DOES> ALSO CELL+ CONTEXT ! +; + +: DEFINITIONS +CONTEXT @ CURRENT ! +; + +: ALSO +CONTEXT DUP CELL+ 0000,003C MOVE 0804BLABLA CONTEXT 0000,0040 + ! +; + +: PREVIOUS +CONTEXT DUP CELL+ SWAP 0000,0040 MOVE +; + +: ( +0000,0029 PARSE 2DROP +; IMMEDIATE + +: \ +FFFF,FFFF PP +! 0000,000A PARSE 2DROP +; IMMEDIATE + +: QUIT +POSTPONE [ R0 @ RSP! '(ACCEPT) CATCH DUP FFFF,FFE0 = +0BRANCH [ 4 , ] ( between BYE ?ERRUR ) BYE ?ERRUR 1+ SET-SRC INTERPRET OK +BRANCH [ -50 , ] ( between [ R0 ) +; + +: OK +STATE @ 0= +0BRANCH [ 24 , ] ( between CR (;) ) +[ " OK" ] DLITERAL TYPE CR +; + +: ABORT +S0 @ DSP! 0 HANDLER ! QUIT +; + +: WARM +_INIT .SIGNON ABORT +; + +: OPTIONS +ARGS @ CELL+ CELL+ @ DUP +0BRANCH [ 50 , ] ( between SWAP DROP ) COUNT 0000,002D <> +0BRANCH [ 1C , ] ( between BYE C@ ) 0000,0003 DUP ERROR EXIT-CODE ! BYE C@ 0000,001F AND LOAD 0 SWAP DROP +; + +: COLD +0804BLABLA 0804BLABLA @ 0000,0100 CMOVE _INIT 1 0 0000,5401 TERMIO 0000,0036 XOS 0< +0BRANCH [ 24 , ] ( between CMOVE OPTIONS ) DROP 0 'TASK 'OK 0000,000C CMOVE OPTIONS +0BRANCH [ 4 , ] ( between .SIGNON ABORT ) .SIGNON ABORT BYE +; + +: _INIT +S0 @ DSP! 0 HANDLER ! DECIMAL ONLY FORTH DEFINITIONS 0000,0000 BLOCK-INIT +; + +Code definition : S>D + +: ABS +DUP 0< +0BRANCH [ 4 , ] ( between NEGATE (;) ) NEGATE +; + +: DABS +DUP 0< +0BRANCH [ 4 , ] ( between DNEGATE (;) ) DNEGATE +; + +: MIN +2DUP > +0BRANCH [ 4 , ] ( between SWAP DROP ) SWAP DROP +; + +: MAX +2DUP < +0BRANCH [ 4 , ] ( between SWAP DROP ) SWAP DROP +; + +Code definition : LSHIFT + +Code definition : RSHIFT + +Code definition : M* + +Code definition : SM/REM + +Code definition : 2/ + +Code definition : 2* + +: 1- +1 - +; + +: FM/MOD +DUP >R 2DUP XOR >R SM/REM R> 0< +0BRANCH [ 2C , ] ( between ? RDROP ) OVER +0BRANCH [ 20 , ] ( between ? RDROP ) 1 - SWAP R> + SWAP +BRANCH [ 4 , ] ( between RDROP (;) ) RDROP +; + +: * +M* DROP +; + +: /MOD +>R S>D R> SM/REM +; + +: / +/MOD NIP +; + +: MOD +/MOD DROP +; + +: */MOD +>R M* R> SM/REM +; + +: */ +*/MOD NIP +; + +: M/MOD +>R 0 R@ UM/MOD R> SWAP >R UM/MOD R> +; + +: (LINE) +>R 0000,0040 M* B/BUF FM/MOD R> + BLOCK + 0000,003F +; + +( 0000,0030 ) VARIABLE ERRSCR + +: MESSAGE +WARNING @ +0BRANCH [ 18 , ] ( between _ DROP ) ERRSCR @ (LINE) 1+ ETYPE _ DROP +; + +Code definition : PC@ + +Code definition : PC! + +Code definition : PW@ + +Code definition : PW! + +( 0C04,63A8 ) VARIABLE _PREV + +0000,0008 CONSTANT #BUFF + +: +BUF +B/BUF CELL+ CELL+ + DUP _LIMIT = +0BRANCH [ 8 , ] ( between _FIRST DUP ) DROP _FIRST DUP _PREV @ - +; + +: UPDATE +_PREV @ DUP CELL+ CELL+ SWAP @ OFFSET @ + BLOCK-WRITE +; + +: EMPTY-BUFFERS +_FIRST _LIMIT OVER - ERASE _FIRST _PREV ! +; + +: (BUFFER) +_PREV @ >R R@ @ OVER = +0BRANCH [ C , ] ( between EXIT R> ) DROP R> EXIT R> +BUF 0= +0BRANCH [ -3C , ] ( between @ >R ) +BUF 0= 0000,0030 ?ERROR DUP CELL+ @ FFFF,FFFF > +0BRANCH [ -34 , ] ( between ? +BUF ) >R R@ ! 0 R@ CELL+ ! R@ _PREV ! R> +; + +: BLOCK +(BUFFER) DUP CELL+ @ 0= +0BRANCH [ 34 , ] ( between ! DUP ) DUP CELL+ CELL+ OVER @ OFFSET @ + BLOCK-READ 1 OVER CELL+ ! DUP _PREV ! CELL+ CELL+ +; + +: FLUSH +_FIRST _LIMIT OVER - ERASE _FIRST _PREV ! +; + +: SAVE +R> SRC 2@ PP @ >R >R >R >R +; + +: RESTORE +R> R> R> R> PP ! SRC 2! >R +; + +: LOCK +BLOCK 0000,0004 - FFFF,FFFE SWAP +! +; + +: UNLOCK +BLOCK 0000,0004 - 2 SWAP +! +; + +: LOAD +DUP THRU +; + +: THRU +SAVE 1+ SWAP +DO I 'LOCK CATCH ?DUP 0= +0BRANCH [ 30 , ] ( between ? RDROP ) I BLOCK B/BUF SET-SRC 'INTERPRET CATCH I UNLOCK ?DUP +0BRANCH [ 14 , ] ( between THROW (LOOP) ) RDROP RDROP RDROP RESTORE THROW +LOOP RESTORE +; + +: BLK +PP @ _FIRST _LIMIT WITHIN SRC 2@ - 0000,0400 = AND +0BRANCH [ 20 , ] ( between ? 0 ) SRC @ 2 CELLS - @ +BRANCH [ 4 , ] ( between 0 (BLK) ) 0 (BLK) ! (BLK) +; + +Code definition : XOS + +Code definition : XOS5 + +: MS +0000,03E8 000F,4240 */MOD 0804BLABLA 2! 0 0 0 0 0804BLABLA 0000,008E XOS5 ?ERRUR +; + +( 0000,000A ) VARIABLE RW-BUFFER + +: ZEN +RW-BUFFER $! 0 RW-BUFFER $C+ RW-BUFFER CELL+ +; + +: WRITE-FILE +ROT ROT 0000,0004 XOS 0 MIN +; + +: OPEN-FILE +>R ZEN R> _ 0000,0005 XOS DUP 0 MIN +; + +: CLOSE-FILE +_ _ 0000,0006 XOS +; + +: CREATE-FILE +>R 2DUP DELETE-FILE DROP ZEN R> _ 0000,0008 XOS DUP 0 MAX SWAP 0 MIN +; + +: DELETE-FILE +ZEN _ _ 0000,000A XOS +; + +: READ-FILE +ROT ROT 0000,0003 XOS DUP 0 MAX SWAP 0 MIN +; + +: REPOSITION-FILE +>R DROP R> SWAP 0000,0000 0000,0013 XOS 0 MIN +; + +: GET-FILE +2DUP $, DROP 654C,6946 , 0 OPEN-FILE THROW >R HERE DUP DSP@ HERE - 0000,0006 / DUP ALLOT 0000,03E8 - R@ READ-FILE THROW R> CLOSE-FILE THROW 2DUP + DP ! +; + +: PUT-FILE +0000,01ED CREATE-FILE THROW DUP >R WRITE-FILE THROW R> CLOSE-FILE THROW +; + +: INCLUDED +HERE >R 'GET-FILE CATCH DUP +0BRANCH [ 18 , ] ( between ? RDROP ) R> DP ! THROW +BRANCH [ 8 , ] ( between DROP EVALUATE ) RDROP DROP EVALUATE +; + +: REFILL-TIB +REMAINDER @ >R TIB @ R@ + 0000,4000 R@ - 0 READ-FILE ?ERRUR DUP 0= FFFF,FFE0 AND ?ERRUR TIB @ SWAP R> + REMAINDER 2! +; + +: ACCEPT +(ACCEPT) 2SWAP ROT MIN DUP >R MOVE R> +; + +: (ACCEPT) +REMAINDER 2@ 0000,000A $^ 0= +0BRANCH [ 38 , ] ( between ? REMAINDER ) REMAINDER 2@ TIB @ SWAP MOVE TIB @ REMAINDER CELL+ ! REFILL-TIB +BRANCH [ -58 , ] ( between ? REMAINDER ) REMAINDER 2@ 0000,000A $/ 2SWAP REMAINDER 2! +; + +: KEY +1 0000,000A SET-TERM 0 DSP@ 0 SWAP 1 0000,0003 XOS DUP ?ERRUR 0= FFFF,FFE0 AND ?ERRUR 1 0000,000A SET-TERM +; + +: KEY? +0 0000,000A SET-TERM 0 0 0804BLABLA 2! 1 0804BLABLA ! 1 0804BLABLA 0 0 0804BLABLA 0000,008E XOS5 DUP ?ERRUR NEGATE 0 0000,000A SET-TERM +; + +: TYPE +DUP OUT +! 1 WRITE-FILE THROW +; + +: ETYPE +2 WRITE-FILE THROW +; + +: EMIT +DSP@ 1 TYPE DROP +; + +( 0000,6D02 ) VARIABLE TERMIO + +: SET-TERM +0804BLABLA SWAP TOGGLE 0804BLABLA C! 0 0000,5402 TERMIO 0000,0036 XOS ?ERRUR +; + +( FFFF,FFFF ) VARIABLE DISK-ERROR + +( 0000,0009 ) VARIABLE BLOCK-FILE + +( 0000,0003 ) VARIABLE BLOCK-HANDLE + +: ?DISK-ERROR +0000,0008 ?ERROR +; + +: BLOCK-INIT +BLOCK-FILE $@ ROT OPEN-FILE 0= NEGATE WARNING @ MIN WARNING ! BLOCK-HANDLE ! EMPTY-BUFFERS +; + +: BLOCK-EXIT +FLUSH BLOCK-HANDLE @ CLOSE-FILE 0 WARNING ! FFFF,FFFF BLOCK-HANDLE ! ?DISK-ERROR +; + +: BLSEEK +B/BUF UM* BLOCK-HANDLE @ REPOSITION-FILE ?DISK-ERROR +; + +: BLOCK-READ +BLSEEK B/BUF BLOCK-HANDLE @ READ-FILE SWAP B/BUF <> OR ?DISK-ERROR +; + +: BLOCK-WRITE +BLSEEK B/BUF BLOCK-HANDLE @ WRITE-FILE ?DISK-ERROR +; + +( 0000,0007 ) VARIABLE SHELL + +: SYSTEM +0804BLABLA $! 0 0804BLABLA $C+ 0 SHELL $C+ FFFF,FFFF SHELL +! _ _ _ 0000,0002 XOS DUP ?ERRUR DUP 0= +0BRANCH [ 44 , ] ( between BYE DUP ) SHELL CELL+ 0804BLABLA ARGS @ $@ 1+ CELLS + 0000,000B XOS 0000,0031 ERROR BYE DUP 0804BLABLA 0 0000,0007 XOS DUP 0000,0004 = +BRANCH [ C , ] ( between ? ?ERRUR ) DROP +0BRANCH [ -40 , ] ( between BYE DUP ) ?ERRUR 2DROP +; + +: ' +NAME PRESENT DUP 0= 0000,000B ?ERROR +; + +: ['] +' POSTPONE LITERAL +; IMMEDIATE + +: FORGET-VOC +2DUP SWAP U< +0BRANCH [ 64 , ] ( between ? >VFA ) SWAP >R >WID DUP DUP >LFA @ DUP R@ U< +0BRANCH [ -1C , ] ( between DUP >LFA ) SWAP >LFA ! >LFA @ DUP 0= +0BRANCH [ -48 , ] ( between >WID DUP ) DROP R> +BRANCH [ 1C , ] ( between DEFINITIONS (;) ) >VFA @ VOC-LINK ! ONLY FORTH DEFINITIONS +; + +: FORGET +POSTPONE ' DUP FENCE @ < 0000,0015 ?ERROR 'FORGET-VOC FOR-VOCS >NFA @ DP ! +; + +: (BACK +HERE +; + +: BACK) +HERE CELL+ - , +; + +: (FORWARD +HERE _ , +; + +: FORWARD) +HERE OVER CELL+ - SWAP ! +; + +: BEGIN +(BACK ?COMP 1 +; IMMEDIATE + +: THEN +?COMP 2 ?PAIRS FORWARD) +; IMMEDIATE + +: DO +'(DO) , (FORWARD (BACK ?COMP 0000,0003 +; IMMEDIATE + +: ?DO +'(?DO) , (FORWARD (BACK ?COMP 0000,0003 +; IMMEDIATE + +: LOOP +?COMP 0000,0003 ?PAIRS '(LOOP) , BACK) FORWARD) +; IMMEDIATE + +: +LOOP +?COMP 0000,0003 ?PAIRS '(+LOOP) , BACK) FORWARD) +; IMMEDIATE + +: UNTIL +?COMP 1 ?PAIRS '0BRANCH , BACK) +; IMMEDIATE + +: AGAIN +?COMP 1 ?PAIRS 'BRANCH , BACK) +; IMMEDIATE + +: REPEAT +?COMP 1 ?PAIRS 'BRANCH , BACK) 0000,0004 ?PAIRS FORWARD) +; IMMEDIATE + +: IF +'0BRANCH , (FORWARD ?COMP 2 +; IMMEDIATE + +: ELSE +?COMP 2 ?PAIRS 'BRANCH , (FORWARD SWAP FORWARD) 2 +; IMMEDIATE + +: WHILE +?COMP DUP 1 ?PAIRS >R >R '0BRANCH , (FORWARD 0000,0004 R> R> +; IMMEDIATE + +: SPACES +0 MAX 0 +?DO SPACE +LOOP +; + +: <# +PAD HLD ! +; + +: #> +DROP DROP HLD @ PAD OVER - +; + +: SIGN +0< +0BRANCH [ C , ] ( between HOLD (;) ) 0000,002D HOLD +; + +: # +BASE @ M/MOD ROT 0000,0009 OVER < +0BRANCH [ C , ] ( between + LIT ) 0000,0007 + 0000,0030 + HOLD +; + +: #S +# OVER OVER OR 0= +0BRANCH [ -1C , ] ( between ? # ) +; + +: (D.R) +>R SWAP OVER DABS <# #S ROT SIGN #> R> OVER - 0 MAX 0 +?DO BL HOLD +LOOP #> +; + +: D.R +(D.R) TYPE +; + +: .R +>R S>D R> D.R +; + +: D. +0 D.R SPACE +; + +: . +S>D D. +; + +: ? +@ . +; + +: U. +0 D. +; + +: FOR-WORDS +SWAP >R >R R> R@ OVER >LFA @ >R EXECUTE R@ 0= +0BRANCH [ -2C , ] ( between >R R> ) RDROP RDROP +; + +: FOR-VOCS +>R VOC-LINK @ >R R> R@ OVER >VFA @ >R EXECUTE R@ 0= +0BRANCH [ -2C , ] ( between >R R> ) RDROP RDROP +; + +: WORDS +C/L OUT ! 0 'NOOP CONTEXT @ FOR-WORDS DUP +0BRANCH [ C , ] ( between ? DROP ) ID. +BRANCH [ -18 , ] ( between FOR-WORDS DUP ) DROP +; + +( 0000,0000 ) VARIABLE EXIT-CODE + +: BYE +EXIT-CODE @ _ _ 0000,0001 XOS +; + +: LIST +BASE @ >R DECIMAL SCR ! +[ "SCR # " ] DLITERAL TYPE SCR @ . SCR @ BLOCK B/BUF 0000,0010 0 +DO 0000,000A $/ CR I 0000,0002 .R SPACE TYPE +LOOP 2DROP R> BASE ! +; + +: INDEX +0000,000C EMIT CR 1+ SWAP +DO CR I 0000,0003 .R SPACE 0 I (LINE) TYPE +LOOP +; + +: .S +CR 0000,0053 EMIT 0000,005B EMIT SPACE DSP@ S0 @ OVER OVER - 0< +0BRANCH [ 20 , ] ( between ? DROP ) 0 CELL+ - DUP @ . +BRANCH [ -38 , ] ( between @ OVER ) DROP DROP 0000,005D EMIT +; + +: ENVIRONMENT? +'ENVIRONMENT >WID (FIND) >R 2DROP R> DUP +0BRANCH [ C , ] ( between ? (;) ) EXECUTE FFFF,FFFF +; + +: TRIAD +0000,000C EMIT 0000,0003 / 0000,0003 * 0000,0003 OVER + SWAP +DO CR I LIST +LOOP CR 0 MESSAGE +; + +: .SIGNON +CR BASE @ 0000,0024 BASE ! CPU D. BASE ! NAME TYPE SPACE VERSION TYPE SPACE CR +; + +: TASK + +; +( data ) CREATE _pad + +: FILL-pad + +[ " " ] DLITERAL _pad $! _pad $+! +[ " " ] DLITERAL _pad $+! +; + +: POSITION +_pad @ - 0 MAX OVER + SWAP +DO I _pad $@ CORA 0= +0BRANCH [ C , ] ( between EXIT (LOOP) ) I UNLOOP EXIT +LOOP 0 +; + +: #LOCATED +>R FILL-pad R> 0 OVER (LINE) -TRAILING DUP 0= 0000,0018 AND THROW POSITION 0= +0BRANCH [ C , ] ( between ? (;) ) 1+ +BRANCH [ -44 , ] ( between R> 0 ) +; + +: (WANTED) +ERRSCR @ 0000,0004 + >R 2DUP PRESENT 0= +0BRANCH [ 24 , ] ( between ? RDROP ) 2DUP R> #LOCATED DUP 1+ >R LOAD +BRANCH [ -38 , ] ( between >R 2DUP ) RDROP +; + +: WANTED +'(WANTED) CATCH DUP 0000,0018 = +0BRANCH [ 18 , ] ( between ? THROW ) >R ETYPE R> MESSAGE +BRANCH [ 8 , ] ( between 2DROP (;) ) THROW 2DROP +; + +: WANT +0000,000A PARSE SAVE SET-SRC NAME DUP +0BRANCH [ C , ] ( between ? 2DROP ) WANTED +BRANCH [ -1C , ] ( between SET-SRC NAME ) 2DROP RESTORE +; + +: CF: + +[ "CONFIG" ] DLITERAL WANTED +; + +: ?LEAVE-BLOCK + +0BRANCH [ 14 , ] ( between ! (;) ) SRC CELL+ @ PP ! +; + +: CONFIG +CREATE 0= , DOES> @ ?LEAVE-BLOCK +; +( data ) CONFIG ?16 +( data ) CONFIG ?32+ +( data ) CONFIG ?32 +( data ) CONFIG ?64 +( data ) CONFIG ?WI +( data ) CONFIG ?DP +( data ) CONFIG ?MS +( data ) CONFIG ?WIMS +( data ) CONFIG ?OSX +( data ) CONFIG ?LI +( data ) CONFIG ?HS +( data ) CONFIG ?PC +( data ) CONFIG ?HD +( data ) CONFIG ?FD +( data ) CONFIG ?SA + +: HELP-WANTED? + +[ "Press space to skip " ] DLITERAL TYPE TYPE +[ ", other key to confirm" ] DLITERAL TYPE CR KEY BL <> +; + +: HELP +1 0000,0014 INDEX CR +[ "I will try to start a help window" ] DLITERAL TYPE CR +[ "Press a key" ] DLITERAL TYPE CR KEY DROP +[ "XOS" ] DLITERAL PRESENT +0BRANCH [ 120 , ] ( between ? SKIP ) +[ "PDF" ] DLITERAL HELP-WANTED? +0BRANCH [ 38 , ] ( between EXIT SKIP ) +[ "acroread ci86.lina.pdf&" ] DLITERAL SYSTEM EXIT +[ "PostScript" ] DLITERAL HELP-WANTED? +0BRANCH [ 2C , ] ( between SYSTEM SKIP ) +[ "gv ci86.lina.ps&" ] DLITERAL SYSTEM +[ "info" ] DLITERAL HELP-WANTED? +0BRANCH [ 34 , ] ( between SYSTEM BRANCH ) +[ "info -f ci86.lina.info" ] DLITERAL SYSTEM +BRANCH [ 50 , ] ( between SYSTEM (;) ) +[ "BDOSN" ] DLITERAL PRESENT +0BRANCH [ 24 , ] ( between SYSTEM (;) ) +[ "wina.pdf" ] DLITERAL SYSTEM +; + +: .VOCS +'ID. FOR-VOCS +; + +: .WID +0 CELL+ - BODY> ID. +; + +: ORDER +CONTEXT $@ DUP 'ONLY >WID <> +0BRANCH [ C , ] ( between ? 2DROP ) .WID +BRANCH [ -2C , ] ( between CONTEXT $@ ) 2DROP 0000,005B EMIT SPACE CURRENT @ .WID 0000,005D EMIT +; + +: WORDLIST +HERE 0 , 0 , 1 , 0 , DUP , +; + +: CLEAN +BLOCK B/BUF OVER + SWAP +DO I C@ 0= +0BRANCH [ C , ] ( between C! (LOOP) ) BL I C! +LOOP +; + +: L-S +SCR @ LIST +; + +: LO-S +SCR @ LOAD +; + +: C-S +SWAP BLOCK SWAP BLOCK B/BUF CMOVE UPDATE FLUSH +; + +: LISTP +BASE @ 0000,000A - 0000,0019 ?ERROR LIST +; + +: OLD: +NAME FOUND >DFA @ POSTPONE LITERAL '>R , 'CO , +; IMMEDIATE + +: RESTORED +DUP >PHA SWAP >DFA ! +; + +: NAME-NEW +'NAME RESTORED +; + +: POSTFIX +'NAME-NEW >DFA @ 'NAME >DFA ! +; + +0000,000D CONSTANT __NR_time + +0000,002B CONSTANT __NR_times + +0000,0001 CONSTANT __NR_exit + +0000,0078 CONSTANT __NR_clone + +0000,0025 CONSTANT __NR_kill + +0000,0030 CONSTANT __NR_signal + +0000,000C CONSTANT __NR_chdir + +0000,0036 CONSTANT __NR_ioctl + +0000,008E CONSTANT __NR_select + +0000,002A CONSTANT __NR_pipe + +0000,0065 CONSTANT __NR_ioperm + +0000,006E CONSTANT __NR_iopl +( data ) CREATE -syscalls- + +: SET-TRAPS +0000,0020 1 +DO I OVER 0 __NR_signal XOS DROP +LOOP DROP +; + +: SET-TRAPS-WARM +FFFF,FFFE CELLS +ORIGIN SET-TRAPS +; + +: INSTALL-NO-TRAPS +0 SET-TRAPS +; + +: NEW-WARM +SET-TRAPS-WARM 0804BLABLA >R CO +; + +: INSTALL-TRAPS +SET-TRAPS-WARM 'NEW-WARM >DFA @ 'WARM >DFA ! +; + +: NEW-OK +.S +[ " OK " ] DLITERAL TYPE +; + +: .INDEX-LINE +CR DUP 0000,0004 .R 0 SWAP (LINE) -TRAILING TYPE +; + +: NEW-THRU +OVER .INDEX-LINE +[ " -- " ] DLITERAL TYPE DUP .INDEX-LINE CR 0804BLABLA >R CO +; + +: DO-DEBUG +INSTALL-TRAPS 'NEW-OK >DFA @ 'OK >DFA ! 'NEW-THRU >DFA @ 'THRU >DFA ! +; + +: NO-DEBUG +INSTALL-NO-TRAPS 'OK RESTORED 'WARM RESTORED 'THRU RESTORED +; + +: break +SAVE '(ACCEPT) CATCH DUP FFFF,FFE0 <> +0BRANCH [ 14 , ] ( between ? DROP ) ?ERRUR SET-SRC INTERPRET +BRANCH [ -38 , ] ( between SAVE LIT ) DROP RESTORE +; + +: HEX: +R> BASE @ >R >R HEX CO R> BASE ! +; + +: DEC: +R> BASE @ >R >R DECIMAL CO R> BASE ! +; + +: 4? +1+ 0000,0004 MOD 0= +0BRANCH [ C , ] ( between HOLD (;) ) 0000,002C HOLD +; + +: 3? +1+ 0000,0003 MOD 0= +0BRANCH [ C , ] ( between HOLD (;) ) 0000,002C HOLD +; + +: (DH.) +HEX: <# 1- 0 +?DO # I 4? +LOOP # #> +; + +: B. +S>D 2 (DH.) TYPE +; + +: H. +S>D 2 CELLS (DH.) TYPE +; + +: DH. +0000,0004 CELLS (DH.) TYPE +; + +: DEC. +0000,0005 CELLS DEC: <# 1- 0 +?DO # I 3? +LOOP # #> TYPE +; + +: BASE? +BASE @ B. +; + +: TO-PRINT +DUP DUP BL < SWAP 0000,007F > OR +0BRANCH [ C , ] ( between ? (;) ) DROP 0000,002E +; + +: .CHARS +0000,007C EMIT 0 +DO DUP I + C@ TO-PRINT EMIT +LOOP 0000,007C EMIT +; + +: BYTES +0 +DO DUP I + C@ B. I 2 MOD +0BRANCH [ 4 , ] ( between SPACE (LOOP) ) SPACE +LOOP +; + +: DUMP +OVER + SWAP +DO CR I H. +[ ": " ] DLITERAL TYPE I 0000,000F AND DUP 0000,0005 2 */ SPACES 0000,0010 SWAP - I OVER BYTES OVER .CHARS DROP DROP 0000,0010 I 0000,000F AND - ++LOOP CR +; + +: SLITERAL +'SKIP , $, $@ SWAP 'LIT , , 'LIT , , +; IMMEDIATE + +: $. +TYPE +; + +: $? +$@ $. +; + +: ."$" +0000,0022 $/ 0000,0022 EMIT TYPE 0000,0022 EMIT OVER 0= +0BRANCH [ -38 , ] ( between ? LIT ) 2DROP +; + +: HIDE +NAME FOUND DUP 0= 0000,000B ?ERROR HIDDEN +; + +: IVAR +DATA , +; + +: INCLUDE +NAME INCLUDED +; + +: BUILD-BAG +HERE CELL+ , CELLS ALLOT +; + +: BAG +CREATE HERE CELL+ , CELLS ALLOT DOES> +; + +: !BAG +DUP CELL+ SWAP ! +; + +: BAG? +$@ = 0= +; + +: BAG+! +DUP >R @ ! 0 CELL+ R> +! +; + +: BAG@- +0 CELL+ NEGATE OVER +! @ @ +; + +: BAG-REMOVE +>R DUP CELL+ SWAP OVER R@ @ SWAP - MOVE FFFF,FFFF CELLS R> +! +; + +: BAG-HOLE +>R DUP CELL+ OVER R@ @ SWAP - MOVE 0 CELL+ R> +! +; + +: BAG-INSERT +OVER SWAP BAG-HOLE ! +; + +: |BAG| +$@ SWAP - 0 CELL+ / +; + +: DO-BAG +'$@ , 'SWAP , POSTPONE ?DO +; IMMEDIATE + +: LOOP-BAG +0 CELL+ POSTPONE LITERAL POSTPONE +LOOP +; IMMEDIATE + +: .BAG +$@ SWAP +?DO I ? 0000,0004 ++LOOP +; + +: BAG-WHERE +$@ SWAP +?DO DUP I @ = +0BRANCH [ 10 , ] ( between EXIT LIT ) DROP I UNLOOP EXIT 0000,0004 ++LOOP DROP 0 +; + +: IN-BAG? +BAG-WHERE 0= 0= +; + +: BAG- +DUP >R BAG-WHERE R> BAG-REMOVE +; + +: SET+ +2DUP IN-BAG? +0BRANCH [ C , ] ( between ? BAG+! ) 2DROP +BRANCH [ 4 , ] ( between BAG+! (;) ) BAG+! +; + +: SET- +2DUP IN-BAG? +0BRANCH [ C , ] ( between ? 2DROP ) BAG- +BRANCH [ 4 , ] ( between 2DROP (;) ) 2DROP +; +( data ) BAG SELTAB + +: SEL! +SWAP SELTAB BAG+! SELTAB BAG+! +; + +: SEL@ +DUP SELTAB BAG-WHERE DUP +0BRANCH [ 14 , ] ( between ? (;) ) CELL+ @ NIP FFFF,FFFF +; + +: CRACKED +DUP @ SEL@ +0BRANCH [ C , ] ( between ? DROP ) EXECUTE +BRANCH [ 98 , ] ( between CR (;) ) DROP DUP >CFA @ OVER >PHA = +0BRANCH [ 3C , ] ( between ? CR ) CR +[ "Code definition : " ] DLITERAL TYPE +BRANCH [ 30 , ] ( between TYPE ID. ) CR +[ "Can't handle : " ] DLITERAL TYPE ID. CR +; + +: by: +' SEL! +; + +: example-by: +>CFA @ by: +; + +: H.. +H. SPACE +; + +: SH.. +HEX: . +; + +: ID.+ +$@ ID. +; + +: H.+ +CELL+ DUP @ H.. CELL+ +; + +: SH.+ +CELL+ DUP @ SH.. CELL+ +; + +: '.+ +CELL+ DUP @ 0000,0027 EMIT ID. CELL+ +; + +: -do +CR +[ "DO " ] DLITERAL TYPE CELL+ CELL+ +; + +: -qdo +CR +[ "?DO " ] DLITERAL TYPE CELL+ CELL+ +; + +: -lo +CR +[ "LOOP " ] DLITERAL TYPE CELL+ CELL+ +; + +: -pl +CR +[ "+LOOP " ] DLITERAL TYPE CELL+ CELL+ +; + +: -pc +CR +[ ";CODE plus code (suppressed)" ] DLITERAL TYPE DROP 'TASK >DFA @ +; + +: -sk +CELL+ CR +[ "[ " ] DLITERAL TYPE 0000,0022 EMIT DUP $@ TYPE 0000,0022 EMIT +[ " ] DLITERAL " ] DLITERAL TYPE $@ + 0000,0004 CELLS + +; + +: -co +DUP >DFA @ CR H.. +[ "CONSTANT " ] DLITERAL TYPE ID. CR +; + +: -va +DUP >DFA @ @ CR 0000,0028 EMIT SPACE H.. +[ ") VARIABLE " ] DLITERAL TYPE ID. CR +; + +: -us +DUP >DFA C@ CR B. +[ " USER " ] DLITERAL TYPE ID. CR +; + +: ?IM +>FFA @ 0000,0004 AND +; + +: ?DN +>FFA @ 0000,0008 AND +; + +: NEXT-DEA +CURRENT @ 2DUP >LFA @ <> +0BRANCH [ 2C , ] ( between ? NIP ) >LFA @ DUP 0= +0BRANCH [ C , ] ( between THROW BRANCH ) 0000,03E8 THROW +BRANCH [ -44 , ] ( between @ 2DUP ) NIP +; + +: DEA? +DUP BM < +0BRANCH [ 10 , ] ( between ? DUP ) DROP 0 +BRANCH [ 34 , ] ( between = (;) ) DUP 'NEXT-DEA CATCH +0BRANCH [ 10 , ] ( between ? >LFA ) 2DROP 0 +BRANCH [ C , ] ( between = (;) ) >LFA @ = +; + +: HEAD? +DUP >DFA @ SWAP >PHA = +; + +: FIND-HEAD +ALIGNED DUP HEAD? 0= +0BRANCH [ 14 , ] ( between ? (;) ) 1 CELLS - +BRANCH [ -28 , ] ( between ALIGNED DUP ) +; + +: TO-DOES +>DFA @ @ +; + +: -dd +DUP TO-DOES FIND-HEAD +[ "( data ) " ] DLITERAL TYPE ID. ID. CR +; + +: ITEM +DUP @ SEL@ +0BRANCH [ 10 , ] ( between ? DUP ) EXECUTE ALIGNED +BRANCH [ 40 , ] ( between CELL+ (;) ) DUP ?IM +0BRANCH [ 28 , ] ( between TYPE ID. ) +[ "POSTPONE " ] DLITERAL TYPE ID. CELL+ +; + +: CRACK-COLON +CR DUP @ '(;) <> +0BRANCH [ C , ] ( between ? DROP ) ITEM +BRANCH [ -28 , ] ( between CR DUP ) DROP +; + +: -hi +CR +[ ": " ] DLITERAL TYPE DUP DUP ID. >DFA @ CRACK-COLON CR +[ ";" ] DLITERAL TYPE DUP ?IM +0BRANCH [ 28 , ] ( between TYPE ?DN ) +[ " IMMEDIATE " ] DLITERAL TYPE ?DN +0BRANCH [ 24 , ] ( between TYPE CR ) +[ " PREFIX" ] DLITERAL TYPE CR +; + +: -lit +DUP CELL+ @ DEA? +0BRANCH [ C , ] ( between ? H.+ ) '.+ +BRANCH [ 4 , ] ( between H.+ (;) ) H.+ +; + +: TARGET +DUP 1 CELLS - @ + +; + +: .DEA? +DUP DEA? +0BRANCH [ C , ] ( between ? DROP ) ID. +BRANCH [ 24 , ] ( between TYPE (;) ) DROP +[ "? " ] DLITERAL TYPE +; + +: PRINT-TARGET +DUP +[ "( between " ] DLITERAL TYPE TARGET DUP 1 CELLS - @ .DEA? @ .DEA? +[ ") " ] DLITERAL TYPE +; + +: -0br +CR +[ "0BRANCH [ " ] DLITERAL TYPE SH.+ +[ ", ] " ] DLITERAL TYPE PRINT-TARGET +; + +: -br +CR +[ "BRANCH [ " ] DLITERAL TYPE SH.+ +[ ", ] " ] DLITERAL TYPE PRINT-TARGET +; + +: SEE +' CRACKED +; + +: CRACK +SEE +; + +: KRAAK +CRACK +; + +: CRACK-FROM +' DUP CRACKED 'NEXT-DEA CATCH +0BRANCH [ -1C , ] ( between ' DUP ) DROP +; + +: .SOURCEFIELD +DUP 0 = +0BRANCH [ 44 , ] ( between ? DUP ) +[ "Belongs to the kernel" ] DLITERAL TYPE CR DROP +BRANCH [ 8C , ] ( between TYPE (;) ) DUP 0000,03E8 U< +0BRANCH [ C , ] ( between ? DUP ) LIST +BRANCH [ 68 , ] ( between TYPE (;) ) DUP TIB @ 0000,9C40 WITHIN +0BRANCH [ 30 , ] ( between ? LIT ) +[ "Typed in" ] DLITERAL TYPE CR +BRANCH [ 18 , ] ( between TYPE (;) ) 0000,0032 - 0000,00C8 TYPE +; + +: LOCATED +FOUND DUP 0= 0000,000B ?ERROR >SFA @ .SOURCEFIELD +; + +: LOCATE +NAME LOCATED +; + +: C=-IGNORE +DUP >R XOR DUP 0= +0BRANCH [ C , ] ( between ? LIT ) 0= +BRANCH [ 48 , ] ( between WITHIN RDROP ) 0000,0020 <> +0BRANCH [ C , ] ( between ? R@ ) 0 +BRANCH [ 28 , ] ( between WITHIN RDROP ) R@ 0000,0020 OR 0000,0061 0000,007A 1+ WITHIN RDROP +; + +: CORA-IGNORE +0 +?DO OVER I + C@ OVER I + C@ C=-IGNORE 0= +0BRANCH [ 14 , ] ( between EXIT (LOOP) ) 2DROP FFFF,FFFF UNLOOP EXIT +LOOP 2DROP 0 +; + +: ~MATCH-IGNORE +>R 2DUP R@ >NFA @ $@ ROT MIN CORA-IGNORE R> SWAP +; + +: CASE-SENSITIVE? +'~MATCH DUP >DFA @ SWAP >PHA = +; + +: CASE-INSENSITIVE +'~MATCH-IGNORE >DFA @ '~MATCH >DFA ! +; + +: CASE-SENSITIVE +'~MATCH RESTORED +; +( data ) CREATE cmdbuf + +: OS-IMPORT +CREATE , , DOES> 2@ cmdbuf $! BL cmdbuf $C+ 0000,000A PARSE cmdbuf $+! cmdbuf $@ SYSTEM +; + +: cdED +ZEN HERE HERE __NR_chdir XOS ?ERRUR +; + +: cd +NAME cdED +; +( data ) OS-IMPORT cat +( data ) OS-IMPORT cp +( data ) OS-IMPORT echo +( data ) OS-IMPORT diff +( data ) OS-IMPORT grep +( data ) OS-IMPORT more +( data ) OS-IMPORT ls +( data ) OS-IMPORT make +( data ) OS-IMPORT man +( data ) OS-IMPORT rm +( data ) OS-IMPORT ed +( data ) OS-IMPORT !! + +: NEW-IF + +; + +( 0A04,7C80 ) VARIABLE FAR-DP + +: SWAP-DP +DP @ FAR-DP @ DP ! FAR-DP ! +; + +: TRIM +HERE 'FORGET-VOC FOR-VOCS DROP +; + +: T] +STATE @ 0= +0BRANCH [ 8 , ] ( between HERE STATE ) SWAP-DP HERE STATE @ ] +; + +: T[ +0= +0BRANCH [ 18 , ] ( between >R (;) ) '(;) , SWAP-DP POSTPONE [ >R +; IMMEDIATE + +: ALIAS +NAME (CREATE) LATEST 0000,0003 CELLS MOVE +; + +: :2 +PP @ NAME FOUND >R R@ HIDDEN PP ! : R> HIDDEN +; + +: :F +!CSP NAME (CREATE) LATEST HIDDEN ] +;CODE plus code (suppressed) +; + +: :R +PP @ NAME FOUND >R R@ HIDDEN PP ! : R@ HIDDEN LATEST >DFA @ R> >DFA ! +; + +: :I +CREATE IMMEDIATE ] LATEST HIDDEN !CSP DOES> STATE @ +0BRANCH [ 34 , ] ( between ? >R ) $@ DUP '(;) <> +0BRANCH [ C , ] ( between ? 2DROP ) , +BRANCH [ -28 , ] ( between ? $@ ) 2DROP +BRANCH [ 4 , ] ( between >R (;) ) >R +; + +: IF +T] POSTPONE IF +; IMMEDIATE + +: DO +T] POSTPONE DO +; IMMEDIATE + +: ?DO +T] POSTPONE ?DO +; IMMEDIATE + +: BEGIN +T] POSTPONE BEGIN +; IMMEDIATE + +: THEN +POSTPONE THEN POSTPONE T[ +; IMMEDIATE + +: LOOP +POSTPONE LOOP POSTPONE T[ +; IMMEDIATE + +: +LOOP +POSTPONE +LOOP POSTPONE T[ +; IMMEDIATE + +: REPEAT +POSTPONE REPEAT POSTPONE T[ +; IMMEDIATE + +: UNTIL +POSTPONE UNTIL POSTPONE T[ +; IMMEDIATE + +: AGAIN +POSTPONE AGAIN POSTPONE T[ +; IMMEDIATE +( data ) CREATE -scripting- + +: TASK + +; + +Can't handle : + OK diff --git a/test.mak b/test.mak index f8c28e0..40afb75 100644 --- a/test.mak +++ b/test.mak @@ -301,8 +301,8 @@ analysermain.frt \ analyserdebug.frt \ # That's all folks! -asgen.frt : RCS-as/asgen.frt,v ; co $< -asi386.frt : RCS-as/asi386.frt,v ; co $< +#asgen.frt : RCS-as/asgen.frt,v ; co $< +#asi386.frt : RCS-as/asi386.frt,v ; co $< # A Forth with the analyser built-in. lina-ana : lina32 asgen.frt asi386.frt $(ANASRC)