NNNNNN֫p NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNONNNNNNNNNNNNNNNNNNNNNN{G@`  @`! #@%`')+-/1 3@5`79;=?A C@E`GIKMOQ S@UWY[]_a c@e`gikmoq s@u`wy{} @` @ ` @ ` ` @ ` ǀ ɠ @ ` ׀ ٠  @ @`!Aa   /Aa!!#A%a')+-/1!3A5a79;=?A!CAEGIKMOQ!SA@`  @`! #@%`')+-/1 3@5`79;=?A C@E`GIKMOQ S@UWY[]_a c@e`gikmoq s@u`wy{} @` @ ` @ ` ` @ ` ǀ ɠ @ ` ׀ ٠  @ @`!Aa   /Aa!!#A%a')+-/1!3A5a79;=?A!CAEGIKMOQ!SASOFTVILLPDCPU68 BLKt EXTEND BLKt 8wKERNEL BLKt VwMETA BLKt TRAPS BLKt UTILITY BQKt FORTH DESt  4THF83 DOCt READ ME t META NOTt F83 TOSt vKERNEL TOSt 87UNSQUEEZTTPt F:SWSWL 156-l\ The Rest is Silence 30Jun86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** modified for Atari ST by: George Morison *** *** 70745,1411 CompuServe *** ************************************************************* ************************************************************* \ Load Screen for 68000 Dependent Code 24Jun86gem warning off ONLY FORTH ALSO DEFINITIONS DECIMAL 3 LOAD cr .( The Assembler ) 18 LOAD cr .( The Low Level for the Debugger ) 21 LOAD cr .( The Low Level for the MultiTasker ) 24 LOAD cr .( The Machine Dependent IO words ) CR .( 68000 Machine Dependent Code Loaded ) \ 68000 Assembler Load Screen 26Jun86gemONLY FORTH ALSO DEFINITIONS 1 14 +THRU : NEXT >NEXT bank L#) JMP ; : INIT [ ASSEMBLER ] WORD ; ONLY FORTH ALSO DEFINITIONS HEX 4EB9 CONSTANT DOES-OP DECIMAL 6 CONSTANT DOES-SIZE : DOES? (S IP -- IP' F ) DUP DOES-SIZE + SWAP @ DOES-OP = ; : LABEL CREATE ASSEMBLER [ ASSEMBLER ] INIT ; : CODE CODE [ ASSEMBLER ] INIT ; \ 68000 Assembler 06Jan86gemASSEMBLER ALSO DEFINITIONS : A?>MARK (S -- addr f ) HERE TRUE ; : A?>RESOLVE (S addr f -- ) ?CONDITION HERE OVER - SWAP 1- C! ; : A?MARK ' A?>MARK IS ?>MARK DEFER ?>RESOLVE ' A?>RESOLVE IS ?>RESOLVE DEFER ? @ SIZE @ AND OR ; 00300 SZ SZ3 00400 SZ SZ4 04000 SZ SZ40 30000 SZ SZ300 : LONG? SIZE @ 24600 = ; : -SZ1 LONG? IF 100 OR THEN ; \ addressing modes 06Jan86gem: REGS 10 0 DO DUP 1001 I * OR CONSTANT LOOP DROP ; : MODE CONSTANT DOES> @ SWAP 7007 AND OR ; 0000 REGS D0 D1 D2 D3 D4 D5 D6 D7 0110 REGS A0 A1 A2 A3 A4 A5 A6 A7 0220 MODE ) ( address register indirect ) 0330 MODE )+ ( adr reg ind post-increment ) 0440 MODE -) ( adr reg ind pre-decrement ) 0550 MODE D) ( adr reg ind displaced ) 0660 MODE DI) ( adr reg ind displaced indexed ) 0770 CONSTANT #) ( immediate address ) 1771 CONSTANT L#) ( immediate long address ) 2772 CONSTANT PCD) ( PC relative displaced ) 3773 CONSTANT PCDI) ( PC relative displaced indexed ) 4774 CONSTANT # ( immediate data ) \ fields and register assignments 06Jan86gem: FIELD CONSTANT DOES> @ AND ; 7000 FIELD RD 0007 FIELD RS 0070 FIELD MS 0077 FIELD EAS 0377 FIELD LOW : DN? (S ea -- ea flag ) DUP MS 0= ; : SRC (S ea instr -- ea instr' ) OVER EAS OR ; : DST (S ea instr -- ea instr' ) SWAP RD OR ; A7 CONSTANT SP ( Stack pointer ) A6 CONSTANT RP ( Return stack pointer ) A5 CONSTANT IP ( Interpreter pointer ) A4 CONSTANT W ( Working register ) \ extended addressing 06Jan86gem: DOUBLE? ( mode -- flag ) DUP L#) = SWAP # = LONG? AND OR ; : INDEX? ( {n} mode -- {m} mode ) DUP >R DUP 0770 AND A0 DI) = SWAP PCDI) = OR IF DUP RD 10 * SWAP MS IF 100000 OR THEN SZ40 SWAP LOW OR THEN R> ; : MORE? ( ea -- ea flag ) DUP MS 0040 > ; : ,MORE ( ea -- ) MORE? IF INDEX? DOUBLE? ?, ELSE DROP THEN ; \ extended addressing extras 06Jan86gemCREATE EXTRA HERE 5 DUP ALLOT ERASE \ temporary storage area : EXTRA? ( {n} mode -- mode ) MORE? IF >R R@ INDEX? DOUBLE? EXTRA 1+ SWAP IF 2! 2 ELSE ! 1 THEN EXTRA C! R> ELSE 0 EXTRA ! THEN ; : ,EXTRA ( -- ) EXTRA C@ ?DUP IF EXTRA 1+ SWAP 1 = IF @ , ELSE 2@ 2, THEN EXTRA 5 ERASE THEN ; \ immediates & address register specific 06Jan86gem: IMM CONSTANT DOES> @ >R EXTRA? EAS R> OR SZ3 , LONG? ?, ,EXTRA ; ( n ea ) 0000 IMM ORI 1000 IMM ANDI 2000 IMM SUBI 3000 IMM ADDI 5000 IMM EORI 6000 IMM CMPI : IMMSR CONSTANT DOES> @ SZ3 2, ; ( n ) 001074 IMMSR ANDI>SR 005074 IMMSR EORI>SR 000074 IMMSR ORI>SR : IQ CONSTANT DOES> @ >R EXTRA? EAS SWAP RS 1000 * OR R> OR SZ3 , ,EXTRA ; ( n ea ) 050000 IQ ADDQ 050400 IQ SUBQ : IEAA CONSTANT DOES> @ DST SRC SZ4 , ,MORE ; ( ea An ) 150300 IEAA ADDA 130300 IEAA CMPA 040700 IEAA LEA 110300 IEAA SUBA \ shifts, rotates, and bit manipulation 06Jan86gem: ISR CONSTANT DOES> @ >R DN? IF SWAP DN? IF R> 40 OR >R ELSE DROP SWAP 1000 * THEN RD SWAP RS OR R> OR 160000 OR SZ3 , ELSE DUP EAS 300 OR R@ 400 AND OR R> 70 AND 100 * OR 160000 OR , ,MORE THEN ; ( Dm Dn ) ( m # Dn ) ( ea ) 400 ISR ASL 000 ISR ASR 410 ISR LSL 010 ISR LSR 420 ISR ROXL 020 ISR ROXR 430 ISR ROL 030 ISR ROR : IBIT CONSTANT DOES> @ >R EXTRA? DN? IF RD SRC 400 ELSE DROP DUP EAS 4000 THEN OR R> OR , ,EXTRA ,MORE ; ( ea Dn ) ( ea n # ) 000 IBIT BTST 100 IBIT BCHG 200 IBIT BCLR 300 IBIT BSET \ branch, loop, and set conditionals 06Jan86gem: SETCLASS ' SWAP 0 DO I OVER EXECUTE LOOP DROP ; : IBRA 400 * 060000 OR CONSTANT ( label ) DOES> @ SWAP ?>MARK DROP 2+ - DUP ABS 200 < IF LOW OR , ELSE SWAP 2, THEN ; 20 SETCLASS IBRA BRA BSR BHI BLS BCC BCS BNE BEQ BVC BVS BPL BMI BGE BLT BGT BLE : IDBR 400 * 050310 OR CONSTANT ( label \ Dn - ) DOES> @ SWAP RS OR , ?>MARK DROP - , ; 20 SETCLASS IDBR DXIT DBRA DBHI DBLS DBCC DBCS DBNE DBEQ DBVC DBVS DBPL DBMI DBGE DBLT DBGT DBLE : ISET 400 * 050300 OR CONSTANT ( ea ) DOES> @ SRC , ,MORE ; 20 SETCLASS ISET SET SNO SHI SLS SCC SCS SNE SEQ SVC SVS SPL SMI SGE SLT SGT SLE \ moves 06Jan86gem: MOVE EXTRA? 7700 AND SRC SZ300 , ,MORE ,EXTRA ; ( ea ea ) : MOVEQ RD SWAP LOW OR 070000 OR , ; ( n Dn ) : MOVE>USP RS 047140 OR , ; ( An ) : MOVE EXTRA? EAS 044200 OR -SZ1 , , ,EXTRA ; ( n ea ) : MOVEM< EXTRA? EAS 046200 OR -SZ1 , , ,EXTRA ; ( n ea ) : MOVEP DN? IF RD SWAP RS OR 410 OR ELSE RS ROT RD OR 610 OR THEN -SZ1 2, ; ( Dm d An ) ( d An Dm ) : LMOVE 7700 AND SWAP EAS OR 20000 OR , ; ( long reg move ) \ odds and ends 06Jan86gem: CMPM RD SWAP RS OR 130410 OR SZ3 , ; ( An@+ Am@+ ) : EXG DN? IF SWAP DN? IF 140500 ELSE 140610 THEN >R ELSE SWAP DN? IF 140610 ELSE 140510 THEN >R SWAP THEN RS DST R> OR , ; ( Rn Rm ) : EXT RS 044200 OR -SZ1 , ; ( Dn ) : SWAP RS 044100 OR , ; ( Dn ) : STOP 47162 2, ; ( n ) : TRAP 17 AND 47100 OR , ; ( n ) : LINK RS 047120 OR 2, ; ( n An ) : UNLK RS 047130 OR , ; ( An ) : EOR EXTRA? EAS DST SZ3 130400 OR , ,EXTRA ; ( Dn ea ) : CMP 130000 DST SRC SZ3 , ,MORE ; ( ea Dn ) \ arithmetic and logic 06Jan86gem: IBCD CONSTANT DOES> @ DST OVER RS OR [ FORTH ] SWAP MS IF 10 OR THEN , ; ( Dn Dm ) ( An@- Am@- ) 140400 IBCD ABCD 100400 IBCD SBCD : IDD CONSTANT DOES> @ DST OVER RS OR [ FORTH ] SWAP MS IF 10 OR THEN SZ3 , ; ( Dn Dm ) ( An@- Am@- ) 150400 IDD ADDX 110400 IDD SUBX : IDEA CONSTANT DOES> @ >R DN? ( ea Dn ) ( Dn ea ) IF RD SRC R> OR SZ3 , ,MORE ELSE EXTRA? EAS DST 400 OR R> OR SZ3 , ,EXTRA THEN ; 150000 IDEA ADD 110000 IDEA SUB 140000 IDEA AND 100000 IDEA OR : IEAD CONSTANT DOES> @ DST SRC , ,MORE ; ( ea Dn ) 040600 IEAD CHK 100300 IEAD DIVU 100700 IEAD DIVS 140300 IEAD MULU 140700 IEAD MULS \ arithmetic and control 06Jan86gem: IEA CONSTANT DOES> @ SRC , ,MORE ; ( ea ) 047200 IEA JSR 047300 IEA JMP 042300 IEA MOVE>CCR 040300 IEA MOVESR 044000 IEA NBCD 044100 IEA PEA 045300 IEA TAS : IEAS CONSTANT DOES> @ SRC SZ3 , ,MORE ; ( ea ) 047200 IEA JSR 047300 IEA JMP 042300 IEA MOVE>CCR 041000 IEAS CLR 043000 IEAS NOT 042000 IEAS NEG 040000 IEAS NEGX 045000 IEAS TST : ICON CONSTANT DOES> @ , ; 47160 ICON RESET 47161 ICON NOP 47163 ICON RTE 47165 ICON RTS \ structured conditionals +/- 256 bytes 06Jan86gem: THEN ?>RESOLVE ; : IF , ?>MARK ; HEX : ELSE 6000 IF 2SWAP THEN ; : BEGIN ?MARK DROP [ FORTH ] SWAP ; : LOOP DBRA ; 6600 CONSTANT 0= 6700 CONSTANT 0<> 6A00 CONSTANT 0< 6B00 CONSTANT 0>= 6C00 CONSTANT < 6D00 CONSTANT >= 6E00 CONSTANT <= 6F00 CONSTANT > DECIMAL \ DEBUGGER 06Jan86gem1 2 +THRU \ Vocabulary, Range test * 26Jun86gemVOCABULARY BUG BUG ALSO DEFINITIONS VARIABLE VARIABLE CNT VARIABLE 'DEBUG LABEL FNEXT IP )+ D7 MOVE D7 W LMOVE HERE W )+ D7 MOVE D7 A0 LMOVE A0 ) JMP CONSTANT FNEXT1 FORTH DEFINITIONS CODE UNBUG (S -- ) BUG FNEXT ASSEMBLER bank L#) >NEXT bank L#) LONG MOVE WORD NEXT C; BUG DEFINITIONS \ Debug version of Next 30Jun86gemLABEL DEBNEXT HEX IP D0 MOVE = ) IF IP> bank L#) D0 CMP 6200 ( U<= ) IF CNT bank L#) D2 MOVE 1 D2 ADDQ D2 CNT bank L#) MOVE 2 # D2 CMP 0= IF CNT bank L#) CLR LONG FNEXT bank L#) >NEXT bank L#) MOVE WORD IP SP -) MOVE 'DEBUG bank L#) D7 MOVE D7 W LMOVE FNEXT1 bank L#) JMP THEN THEN THEN FNEXT bank L#) JMP C; DECIMAL LABEL JBUG DEBNEXT bank L#) JMP C; CODE PNEXT JBUG bank L#) >NEXT bank L#) LONG MOVE WORD NEXT C; \ Load Screen for the MultiTasker 06Jan86gemONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( MultiTasker Low Level Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The MultiTasker is loaded as an application on top of the regular Forth System. There is support for it in the nucleus in the form of USER variables and PAUSEs inserted inside of KEY EMIT and BLOCK. The Forth multitasking scheme is co-operative instead of interruptive. All IO operations cause a PAUSE to occur, and the multitasking loop looks around at all of the current task for something to do. \ Multitasking low level 26Jun86gemCODE (PAUSE) (S -- ) IP SP -) MOVE ( IP to stack ) RP SP -) MOVE ( RP to stack ) UP bank L#) D7 MOVE D7 A0 LMOVE SP A0 )+ MOVE ( SP to USER area ) 2 A0 LONG ADDQ WORD A0 ) D7 MOVE D7 A0 LMOVE A0 ) JMP ( to next task) C; LABEL RESTART (S -- ) SP )+ D7 MOVE ( drop SR ) SP )+ A0 LMOVE ( return address) 4 A0 SUBQ A0 UP bank L#) MOVE ( Set UP to new user ) A0 ) D7 MOVE D7 SP LMOVE ( Restore stack ) SP )+ D7 MOVE D7 RP LMOVE ( Return stack ) SP )+ D7 MOVE D7 IP LMOVE ( Restore IP ) NEXT C; HEX 4E47 ENTRY ! ( TRAP 7 ) DECIMAL ENTRY LINK ! ( only task points to itself ) \ Manipulate Tasks 06Jan86gemHEX : LOCAL (S base addr -- addr' ) UP @ - + ; : @LINK (S -- addr ) LINK @ ; : !LINK (S addr -- ) LINK ! ; : SLEEP (S addr -- ) 4EF8 SWAP ENTRY LOCAL ! ; : WAKE (S addr -- ) 4E47 SWAP ENTRY LOCAL ! ; : STOP (S -- ) UP @ SLEEP PAUSE ; : SINGLE (S -- ) ['] PAUSE >BODY ['] PAUSE ! ; : MULTI (S -- ) 0 9C ! RESTART 9E ! ['] (PAUSE) @ ['] PAUSE ! ; DECIMAL \ Load Screen for Machine Dependent IO Words 06Jan86gemONLY FORTH ALSO DEFINITIONS 1 1 +THRU CR .( Machine Dependent IO Words Loaded ) EXIT \ LC@, LC!, L@, L!, PC@, PC! 01Jul86gemCODE LC@ (S dadr -- char ) SP )+ A0 LMOVE D0 CLR BYTE A0 ) D0 MOVE WORD D0 SP -) MOVE NEXT C; CODE LC! (S char dadr -- ) SP )+ A0 LMOVE SP )+ D0 MOVE BYTE D0 A0 ) MOVE NEXT C; CODE L@ (S dadr -- n ) SP )+ A0 LMOVE BYTE A0 )+ D0 MOVE WORD 8 # D0 LSL BYTE A0 ) D0 MOVE WORD D0 SP -) MOVE NEXT END-CODE CODE L! (S n dadr -- ) SP )+ A0 LMOVE SP )+ D0 MOVE BYTE D0 1 A0 D) MOVE WORD 8 # D0 LSR BYTE D0 A0 ) MOVE NEXT END-CODE HEX 00FF CONSTANT IO-PAGE DECIMAL : PC@ (S port -- byte ) IO-PAGE LC@ ; : PC! (S byte port -- ) IO-PAGE LC! ; \ The Rest is Silence 06Jan86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for 68000 Dependent Code 06Jan86gem All of the machine dependent code for a particular Forth implementation is factored out and placed into this file. For the 68000 there are 3 different components. The 68k assembler, the run time debugger, which must have knowledge of how NEXT is implemented, and the MultiTasker, which uses code words to WAKE tasks and put them to SLEEP. \ 68000 Assembler Load Screen 06Jan86gem NEXT is a macro. It assembles a jump to >NEXT. Nearly all CODE words end with NEXT. DOES-OP is the call opcode compiled by DOES>. DOES-SIZE is the length of the call in bytes. DOES? (S IP -- IP' F ) test for DOES> word. Used by the decompiler. LABEL marks the start of a subroutine whose name returns its address. CODE creates a Forth code word. \ 68000 Assembler 06Jan86gem Deferring the definitions of the commas, marks, and resolves allows the same assembler to serve for both the system and the Meta-Compiler. \ 68000 Assembler 06Jan86gemC; is a synonym for END-CODE ?, compiles one or two numbers. 2, compiles two numbers. OCTAL is convenient for the bit fields in the 68000. Many 68000 instructions can operate on either 8, 16, or 32-bit data. Rather than specify the size individually for each inst- ruction, the variable SIZE contains the size information for any instruction which needs it. Size is set by BYTE, WORD, and LONG. SZ defines words which select certain bits from SIZE & install them into the instruction being assmbled. The size field moves around considerably. LONG? leaves a flag, true if SIZE is LONG. -SZ1 handles an special case where the size field is inverted with respect to all others. Nice job, Motorola! \ Assembler registers and addressing modes. 06Jan86gemNotice that REGS defines several words each time it is used. MODE defines modifiers which will follow an address register. Examples: D0 thru D7 are data registers. A0 thru A7 are address registers. D0 A1 ) MOVE Move contents of D0 to where A1 points. A7 )+ D1 MOVE pop item off stack pointed to by A7 into D1. D2 A6 -) MOVE push D2 onto stack pointed to by A6. 12 A3 D) CLR clear address 12 bytes past where A3 points. 34 D3 A4 DI) NEG negate contents of address at A4+D3+34. 1234 #) JMP jump to absolute address 1234.*NOTE* sign extends! 12.3456 L#) JMP jump to long absolute address 123456. 56 PCD) D4 MOVE get contents of address at PC+56 into D4. 78 D5 PCDI) NOT complement contents of address at PC+D5+78. 9876 # D6 MOVE put the value 9876 into D6. \ fields and register assignments 06Jan86gemFIELD defines words which mask off various bit fields. RS and RD select the source or destination register field. MS selects the source mode field. EAS selects the source effective address field. LOW selects the low byte. DN? tests for data register mode. SRC merges the source register and mode into the instruction DST merges the destination register into the instruction. These are the register assgnmnts for the virtual Forth machine You can refer to the virtual machine registers, for example: RP )+ SP -) MOVE pops the top item from the return stack onto the data stack. NOTE: registers A4-A7 and D7 are used, all others are free. Registers which are used by Forth must be saved and restored by any routine which uses them. \ extended addressing 06Jan86gemMany of the 68000's addressing modes require additional bytes following the opcode. DOUBLE? leaves true if the given mode requires 32 bits of xtra addressing information. INDEX? does nothing unless the given mode is an indexed mode, in which case it packs the extra data into the required format MORE? tests for extra addressing words. ,MORE assembles the extra words. \ extended addressing extras 06Jan86gemEXTRA is a temporary storage area for extended addressing operands. EXTRA? tests a mode for extra words. If present, they are saved in EXTRA to get them out of the way until needed. ,EXTRA retrieves the words in EXTRA, if any, and assembles them. \ immediates & address register specific 06Jan86gemIMM defining word for immediate instructions. IMMSR defining word for immediate to ststus register instructions. IQ defining word for quick instructions. IEAA defining word for effective address to address register instructions. \ shifts, rotates, and bit manipulation 06Jan86gemISR defining word for shifts and rotates. IBIT defining word for bit manipulators. \ branch, loop, and set conditionals 06Jan86gem There are three classes of conditional instructions: branch, decrement and branch, and set. In each case there is a four bit field which contains the condition code. This field is the only difference between members of a class. Rather than explicitly define sixteen words for each class, the word SETCLASS is used to define all sixteen at once by re-executing the defining word with a different value for the condition code each time. Of the 48 words so defined, only DXIT and SNO are useless. Compiler directives like SETCLASS can be very useful. It would be better if there was a way to throw them away after use. I am planning to add a TRANSIENT definitions capability for this and other reasons. \ moves 06Jan86gemThese are the MOVE instructions in all their glory. Notice that I have added LMOVE. This is because the 68k treats addresses as signed numbers. When a 16 bit address is loaded into an address register, it is sign-extended. This is never what I want. Values loaded into data registers is not extended, so I often load 16 bits into a data register, then move all 32 bits into an address register to get an unextended address. Data register 7 is reserved in this system for this purpose. LMOVE lets me do the above nonsense without switching between LONG and WORD sizes constantly. To keep the assembler simple, some words use modified Motorola mnemonics. HEX FFFF SP -) MOVEM> will save all registers on the stack. ( pronounced MOVEM-OUT ). \ odds and ends 06Jan86gemExamples: A5 )+ A3 )+ CMPM D0 A3 EXG D2 EXT D1 SWAP 1234 STOP 3 TRAP 8 A6 LINK A6 UNLK D0 A5 ) EOR A7 )+ D0 CMP \ arithmetic and logic 06Jan86gemIBCD defining word for Binary Coded Decimal instructions. IDD defining word for extended instructions. e.g. A1 -) A2 -) ADDX D0 D1 ADDX IDEA defining word for some arithmetic and logical instructions. IEAD defining word for some arithmetic and logical instructions. \ arithmetic and control 06Jan86gemIEA defining word for instructions which take only an effective address. IEAS defining word for instructions which take only an effective address, and are affected by SIZE. ICON defining word for instructions which take no arguments. \ structured conditionals +/- 256 bytes 06Jan86gem These words implement structured conditionals for the assembler. This is a much cleaner way to express control flow than the usual technique of random jumps to nonsense labels. e.g. D0 D0 OR 0= IF 5 # D1 ADD ELSE 3 # D1 ADD THEN BEGIN A0 ) D0 MOVE 0<> WHILE D0 A0 MOVE REPEAT 5 D3 DO 1 D6 ADDQ LOOP The last is especially interesting. It will repeat the code between DO and LOOP 5 times using D3 as a counter. Note that any DBcc can replace LOOP. IF, WHILE, and UNTIL all expect a branch opcode on the stack. The most commonly used ones are defined here as constants named for the corresponding condition. \ 16 Bit Subtract Subroutine 06Jan86gemBUG The vocabulary that holds the Debugging Words The range of IP values we are interested in FNEXT A copy of next that gets exeucted instead of the normal one. FNEXT1 Ditto for execute. UNBUG restores Forth's Next to its original condition. Effectively disabling tracing. \ Debug version of Next 06Jan86gem DEBNEXT is the debugger's version of next If the IP is between then the contents of the execution variable 'DEBUG are executed. First the IP is pushed onto the parameter stack. The word pointed to by 'DEBUG can be any high or low level word so long as it discards the IP that was pushed before it is called, and it must end by calling PNEXT to patch next once again for more tracing. PNEXT patches Forth's Next to jump to DEBNEXT. This puts us into DEBUG mode and allows for tracing. \ Multitasking low level 06Jan86gem(PAUSE) (S -- ) Puts a task to sleep by storing the IP and the RP on the parameter stack. It then saves the pointer to the parameter stack in the user area and jumps to the code pointed at by USER+3, switching tasks. RESTART (S -- ) Sets the user pointer to point to a new user area and restores the parameter stack that was previously saved in the USER area. Then pops the RP and IP off of the stack and resumes execution. The inverse of PAUSE. Initialize current User area to a single task. \ Manipulate Tasks 06Jan86gemLOCAL Map a User variable from the current task to another task @LINK Return a pointer the the next tasks entry point !LINK Set the link field of the current task (perhaps relative) SLEEP makes a task pause indefinitely. WAKE lets a task start again. STOP makes a task pause indefinitely. SINGLE removes the multi-tasker's scheduler/dispatcher loop. MULTI installs the multi-tasker's scheduler/dispatcher loop. By patching the appropriate INT vector and enabling PAUSE. \ Machine dependent IO words 06Jan86gemLC@ get a byte from the 32 bit address on the stack. LC! store a byte into the 32 bit address on the stack. PC@ (S port# -- n ) Fetch the value at the given input port and push it onto the stack. PC! (S n port# -- ) Write the value to the specified port number. \ The Rest is Silence 30Jun86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** modified for Atari ST by: George Morison *** *** 70745,1411 CompuServe *** ************************************************************* ************************************************************* ( Load Screen to Bring up Standard System 03Jul86gem) CR .( Loading system extensions.) CR 2 VIEW# ! ( This will be view file# 2 ) WARNING OFF 3 LOAD ( BASICS ) 6 LOAD ( FILE-INTERFACE ) FROM TRAPS.BLK 1 LOAD ( Atari ST functions ) FROM CPU68000.BLK 1 LOAD ( Assembler ) FROM UTILITY.BLK 1 LOAD ( Utilities ) \ FROM ZEDIT.BLK 1 LOAD ( Full screen editor ) WARNING ON --> \ Load up the system 26Jun86gem: HELLO (S -- ) cr ." 68000 Forth 83 Model, Atari ST " cr ." Version 2.1.0 Modified 04Jul86 " [ EDITOR ] SET-ID WRAP START ONLY FORTH ALSO DEFINITIONS ; ' HELLO IS BOOT \ 13 LOAD ( Configuration: change and load as desired. ) : MARK (S -- ) CREATE DOES> (FORGET) FORTH DEFINITIONS ; MARK EMPTY HERE FENCE ! CR .( System has been loaded, Size = ) HERE U. SAVE-SYSTEM F83.TOS cr .( System saved as F83.TOS ) ( Commenting and Loading Words 16Oct83map) 64 CONSTANT C/L 16 CONSTANT L/SCR : \ ( -- ) >IN @ NEGATE C/L MOD >IN +! ; IMMEDIATE : (S ( -- ) [COMPILE] ( ; IMMEDIATE : ? (S adr -- ) @ . ; : ?ENOUGH (S n -- ) DEPTH 1- > ABORT" Not enough Parameters" ; : THRU (S n1 n2 -- ) 2 ?ENOUGH 1+ SWAP ?DO I LOAD LOOP ; : +THRU (S n1 n2 -- ) BLK @ + SWAP BLK @ + SWAP THRU ; : --> (S -- ) >IN OFF 1 BLK +! ; IMMEDIATE 1 2 +THRU ( Rest of Basic Utilities ) \ The ALSO and ONLY Concept 07Feb84mapCONTEXT DUP @ SWAP 2+ ! ( Make FORTH also ) VOCABULARY ROOT ROOT DEFINITIONS : ALSO (S -- ) CONTEXT DUP 2+ #VOCS 2- 2* CMOVE> ; : ONLY (S -- ) ['] ROOT >BODY CONTEXT #VOCS 1- 2* 2DUP ERASE + ! ROOT ; : SEAL (S -- ) ' >BODY CONTEXT #VOCS 2* ERASE CONTEXT ! ; : PREVIOUS (S -- ) CONTEXT DUP 2+ SWAP #VOCS 2- 2* CMOVE CONTEXT #VOCS 2- 2* + OFF ; \ The ALSO and ONLY Concept 28AUG83HHL: FORTH FORTH ; : DEFINITIONS DEFINITIONS ; : ORDER (S -- ) CR ." Context: " CONTEXT #VOCS 0 DO DUP @ ?DUP IF BODY> >NAME .ID THEN 2+ LOOP DROP CR ." Current: " CURRENT @ BODY> >NAME .ID ; : VOCS (S -- ) VOC-LINK @ BEGIN DUP #THREADS 2* - BODY> >NAME .ID @ DUP 0= UNTIL DROP ; ONLY FORTH ALSO DEFINITIONS \ Load Screen for DOS Interface 22Jun86gemDOS DEFINITIONS 1 6 +THRU FORTH DEFINITIONS CR .( File Interface Loaded ) \S The DOS interface consists of a set of words that access the TRAP functions of DOS, such as making, opening, and deleting files. There is also a word that parses a string and creates a file control block. Finally the word SAVE can be used to save the contents of memory as a DOS file. \ DOS Interface 26Jun86gemCREATE FCB2 B/FCB ALLOT hex : CLOSE (S fcb -- ) handle# @ 3E trap#1 2swap 2drop drop DOS-ERR? ABORT" Close error" ; : SEARCH0 (S attr fcb -- n ) bank 4E trap#1 drop >r 2drop 2drop r> ; : SEARCH (S fcb -- n ) drop 4F trap#1 rot 2drop ; : DELETE (S fcb -- ) bank 41 trap#1 drop >r 2drop drop r> ; \ DOS-ERR? ABORT" Delete error" ; : MAKE-FILE (S attr fcb -- ) dup -rot bank 3C trap#1 drop dup DOS-ERR? if ABORT" Can't MAKE File " then >r 2drop 2drop r> swap handle# ! ; : SELECT (S drive -- ) 0E trap#1 2drop 2drop ; decimal \ Create File Control Blocks 23Jun86gemhex : read (S daddr dlen fcb -- ) handle# @ 3F trap#1 2drop 2drop 2drop 2drop ; : write (S daddr dlen fcb -- ) handle# @ 40 trap#1 2drop 2drop 2drop 2drop ; decimal : (!FCB) (S Addr len FCB-addr -- ) dup b/fcb erase swap move ; : !FCB (S FCB-addr ) BL WORD COUNT CAPS @ IF 2DUP UPPER THEN ROT (!FCB) ; \ Save a Core Image as a File on Disk 26Jun86gemDEFER HEADER HEX : 68K-HEADER (S addr len -- addr-62 len+62 ) 3E + SWAP 3E - SWAP OVER DUP 1C ERASE 601A OVER ! 4 + HERE OVER ! 14 + 500 OVER ! 2+ ON HERE 500 1A - ! ; ' 68K-HEADER IS HEADER DECIMAL : SAVE (S Addr len --- ) FCB2 DUP !FCB DELETE DROP 0 FCB2 MAKE-FILE HEADER bank SWAP 0 FCB2 WRITE FCB2 CLOSE ; FORTH DEFINITIONS : MORE (S n -- ) [ DOS ] 1 ?ENOUGH CAPACITY SWAP DUP FILE @ MAXREC# +! BOUNDS ?DO I BLOCK ( BUFFER ) B/BUF BLANK UPDATE LOOP SAVE-BUFFERS EMPTY-BUFFERS FILE @ CLOSE ; : CREATE-FILE (S #blocks -- ) [ DOS ] FCB2 DUP !FILES DUP !FCB 0 SWAP MAKE-FILE MORE ; \ Display Directory 26Jun86gemDOS DEFINITIONS : .NAME (S n -- ) #OUT @ C/L > IF CR THEN DOS-ERR? NOT IF DMA 30 + 13 TYPE 3 SPACES THEN ; FORTH DEFINITIONS : DIR (S -- ) [ DOS ] " ????????.???" FCB2 (!FCB) CR DMA CLR-DMA DMA bank SET-DMA 0 FCB2 SEARCH0 BEGIN .NAME DMA 21 + 23 BLANK DMA bank SET-DMA FCB2 SEARCH DUP DOS-ERR? UNTIL DROP ; : DRIVE? (S -- ) 25 TRAP#1 DROP NIP ASCII A + EMIT ." : " ; : A: (S -- ) [ DOS ] 0 SELECT ; : B: (S -- ) [ DOS ] 1 SELECT ; DOS DEFINITIONS \ Define and Open files 25Jun86gem: FILE: (S -- fcb ) >IN @ CREATE >IN ! HERE DUP B/FCB ALLOT !FCB DOES> !FILES ; : ?DEFINE (S -- fcb ) >IN @ DEFINED IF NIP >BODY ELSE DROP >IN ! FILE: THEN ; FORTH DEFINITIONS : DEFINE (S -- ) [ DOS ] ?DEFINE DROP ; : OPEN (S -- ) [ DOS ] EMPTY-BUFFERS \ IN-FILE @ CLOSE ?DEFINE !FILES OPEN-FILE ; : FROM (S -- ) [ DOS ] EMPTY-BUFFERS \ IN-FILE @ CLOSE ?DEFINE IN-FILE ! OPEN-FILE ; : SAVE-SYSTEM (S -- ) [ DOS HEX ] 500 HERE SAVE ; DECIMAL \ Viewing Source Screens 03Jul86gemCREATE VIEW-FILES 32 ALLOT VIEW-FILES 32 ERASE : VIEWS (S n -- ) [ DOS ] ?DEFINE 2DUP 40 + ! BODY> SWAP 2* VIEW-FILES + ! ; 1 VIEWS KERNEL.BLK 2 VIEWS EXTEND.BLK 3 VIEWS TRAPS.BLK 4 VIEWS CPU68000.BLK 5 VIEWS UTILITY.BLK \ 6 VIEWS ZEDIT.BLK \ My normal configuration 07Apr84mapCAPS ON ' EPSON IS INIT-PR ' FORM-FEED IS PAGE ' (WHERE) IS WHERE EDITOR QUME FORTH 5 VIEWS CLOCK.BLK FROM CLOCK.BLK 1 LOAD ( Load Screen to Bring up Standard System 25Jun86gem) This is set so that definitions in this file can be VIEWed. BASICS are needed by everything else. FILE-INTERFACE allows convenient use of files. CPU68000.BLK Contains all of the 68000 machine dependent stuff such as the Assembler, the Debug Utility which patches NEXT, and the MultiTasker, which needs some code words in order to function efficiently. UTILITY.BLK Contains all of the standard utilities that are usually resident in a Forth system, such as the editor, the decompiler, a print utility, etc. \ Load up the system 07Apr84mapHELLO (S -- ) Gives the user the sign on message, making him foolishly believe that he is running an 83 Standard System. It also does all of the one time start up code required, such as relocating the heads and opening the screen file, if any. Load configuration. Personalize here. MARK (S -- ) A Defining word that allows you to restore the dictionary to a known state. EMPTY The current state of the dictionary. ( Commenting and Loading Words 25Jul83map) C/L The number of characters per line. L/SCR The number of lines per screen. \ A comment word. Ignores the rest of the line (S Used for Stack Comments. Behaves just like ( ? Displays the contents of an address. ?ENOUGH (S n -- ) Issue an error message if too few parameters on the stack. THRU (S n1 n2 -- ) Load a bunch of screens. +THRU (S n1 n2 -- ) Load a bunch of screens relative to the current screen. --> (S -- ) Load the next screen. \ The ALSO and ONLY Concept 03Apr84map ROOT A small vocabulary for controlling search order. ALSO (S -- ) Adds another vocabulary to the search order. ONLY Erases the search order and forces the ROOT vocabulary to be the first and last. SEAL Usage: SEAL FORTH will change the search order such that only FORTH will be searched. Used for turn-key applications. PREVIOUS The inverse of ALSO, removes the most recently referenced vocabulary from the search order. \ The ALSO and ONLY Concept 03Apr84mapWe initialize the ROOT vocabulary with a few definitions that allow us to do vocabulary related things. ORDER (S -- ) Displays the search order currently in effect. Also displays the CURRENT vocabulary, which is were definitions are placed. VOCS (S -- ) Lists all of the vocabularies that have been defined so far, in the order of their definition. \ DOS BDOS Interface 10Apr84mapFCB2 Space for a second FCB when needed. RESET Reset the DOS disk system CLOSE Close the given file, and report errors. SEARCH0 Search for the first occurance SEARCH Search for the next occurance. DELETE Remove an old file. READ Read the next sequential record, and report errors. WRITE Write the next sequential record, and report errors. MAKE-FILE create a directory entry for a new file, and report errors. \ Create File Control Blocks 11Apr84map(!FCB) (S Addr len FCB-addr --- ) Set up the filce control block per the specified string. This is the primitive file parse word, which breaks the drive/file name string into a drive specifier, file name, and extension, and leaves the parsed result in the given file control block address. !FCB (S FCB-addr ) Parse the next word in the input stream as a file. If CAPS is false, allow lower case names. SELECT make given drive the default. \ Save a Core Image as a File on Disk 22FEB84MAPHEADER This is different for CP/M-80, CP/M-86, and CP/M-68K. SAVE (S addr len -- ) Save the string specified as a CP/M file whose name is specified following the SAVE word. The current screen file is not disturbed. MORE Extend the size of the current file by n Blocks. CREATE-FILE creates a new file containing the given number of blocks. \ Display Directory 30Jun86gem .NAME prints one filename. DIR prints a normal directory of the current drive. DRIVE? prints currently selected drive. A: selects drive A as the default. B: selects drive B as the default. \ Open files and list directories 29Mar84mapFILE: (S -- fcb ) Define the next word as a file by allocating an FCB in the dictionary and parsing the next word as a file name. Leave the address of the file control block. ?DEFINE (S -- fcb ) Define the next word as a file if it does not already exist. Leave the address of the file control block. DEFINE (S -- ) Define the following word as a file name without opening it. OPEN (S -- ) Open the following file and make it the current file. FROM (S -- ) Open the following file and make it the current input file. SAVE-SYSTEM (S -- ) Usage: SAVE-SYSTEM NEWNAME.68K Saves an executable image of the system as a file. \ Set up VIEW-FILES table 30Jun86gemVIEW-FILES is an array of pointers to fcbs. VIEWS installs a file into the VIEW-FILES array, and sets the fcb to contain the matching view number. Now initialize the VIEW-FILES array: KERNEL.BLK was used to generate the precompile code. EXTEND.BLK was opened on the execute line, loads all extras. CPU68000.BLK has the machine dependent post-compile code. UTILITY.BLK has the machine independent post-compile code. \ The Rest is Silence 20Jun86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** modified for Atari ST by: George Morison *** *** 70745,1411 CompuServe *** ************************************************************* ************************************************************* \ Target System Setup 02Jul86gemONLY FORTH META ALSO FORTH 6 CONSTANT bank HEX A800 ' TARGET-ORIGIN >BODY ! IN-META DECIMAL 2 92 THRU ( System Source Screens ) HEX CR .( Unresolved references: ) CR .UNRESOLVED CR .( Statistics: ) CR .( Last Host Address: ) [FORTH] HERE U. CR .( First Target Code Address: ) META 500 THERE U. CR .( Last Target Code Address: ) META HERE-T THERE U. CR CR DOS HERE-T 500 3E - 4 + !-T HERE-T 500 1A - !-T META 500 3E - THERE HERE-T 100 + ONLY FORTH ALSO DOS SAVE A:KERNEL.TOS FORTH CR .( Now run KERNEL.TOS and type: ) CR .( EXTEND OK ) DECIMAL \ Declare the Forward References and Version # 26Jun86gem: ]] ] ; : [[ [COMPILE] [ ; FORTH IMMEDIATE META FORWARD: DEFINITIONS FORWARD: [ LABEL FILE-HEADER HEX 500 3E - DP-T ! 601A ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 0 ,-T 500 ,-T -1 ,-T LABEL LOADER -02 PCD) A1 LEA LONG FFFF. # D0 MOVE WORD 22 # D0 ADD 500 22 - bank L#) A0 LEA BEGIN 1 D0 SUBQ 0<> WHILE BYTE A1 )+ A0 )+ MOVE REPEAT 500 bank L#) JMP DECIMAL \ Boot up Vectors and NEXT Interpreter 26Jun86gemASSEMBLER LABEL ORIGIN -1 bank L#) JMP ( Low Level COLD Entry point ) -1 bank L#) JMP ( Low Level WARM Entry point ) LABEL >NEXT IP )+ D7 MOVE D7 W LMOVE W )+ D7 MOVE D7 A0 LMOVE A0 ) JMP ASSEMBLER >NEXT META CONSTANT >NEXT ASSEMBLER DEFINITIONS META H: NEXT META ASSEMBLER >NEXT bank L#) JMP ; IN-META HERE-T DUP 100 + CURRENT-T ! ( harmless ) VOCABULARY FORTH FORTH DEFINITIONS 0 OVER 2+ !-T ( link ) DUP 2+ SWAP 16 + !-T ( thread ) IN-META \ Run Time Code for Defining Words 06Jan86gemASSEMBLER LABEL NEST IP RP -) MOVE W IP LMOVE NEXT CODE EXIT (S -- ) RP )+ D7 MOVE D7 IP LMOVE NEXT END-CODE CODE UNNEST ' EXIT @-T ' UNNEST !-T END-CODE ASSEMBLER LABEL DODOES IP RP -) MOVE A7 )+ IP LMOVE ( fall through to DOCREATE ) LABEL DOCREATE W SP -) MOVE NEXT \ Run Time Code for Defining Words 26Jun86gemVARIABLE UP LABEL DOCONSTANT W ) SP -) MOVE NEXT LABEL DOUSER-VARIABLE W ) D0 MOVE UP bank L#) D0 ADD D0 SP -) MOVE NEXT CODE (LIT) (S -- n ) IP )+ SP -) MOVE NEXT END-CODE \ Meta Defining Words 06Jan86gemT: LITERAL (S n -- ) [TARGET] (LIT) ,-T T; T: DLITERAL (S d -- ) [TARGET] (LIT) ,-T [TARGET] (LIT) ,-T T; T: ASCII (S -- ) [COMPILE] ASCII [[ TRANSITION ]] LITERAL [META] T; T: ['] (S -- ) 'T >BODY @ [[ TRANSITION ]] LITERAL [META] T; : CONSTANT (S n -- ) RECREATE [[ ASSEMBLER DOCONSTANT ]] LITERAL ,-T DUP ,-T CONSTANT ; \ Identify numbers and forward References 19Jun86gemHEX FORWARD: <(;CODE)> T: DOES> (S -- ) [FORWARD] <(;CODE)> HERE-T 4EB9 ,-T 6 ,-T [[ ASSEMBLER DODOES ]] LITERAL ,-T T; : NUMERIC (S -- ) [FORTH] HERE [META] NUMBER DPL @ 1+ IF [[ TRANSITION ]] DLITERAL [META] ELSE DROP [[ TRANSITION ]] LITERAL [META] THEN ; : UNDEFINED (S -- ) HERE-T 0 ,-T IN-FORWARD [FORTH] CREATE [META] TRANSITION [FORTH] , FALSE , [META] DOES> FORWARD-CODE ; DECIMAL \ Meta Compiler Compiling Loop 06Jan86gem[FORTH] VARIABLE T-IN META : ] (S -- ) STATE-T ON IN-TRANSITION BEGIN >IN @ T-IN ! DEFINED IF EXECUTE ELSE COUNT NUMERIC? IF NUMERIC ELSE T-IN @ >IN ! UNDEFINED THEN THEN STATE-T @ 0= UNTIL ; T: [ (S -- ) IN-META STATE-T OFF T; T: ; (S -- ) [TARGET] UNNEST [[ TRANSITION ]] [ T; : : (S -- ) TARGET-CREATE [[ ASSEMBLER NEST ]] LITERAL ,-T ] ; \ Run Time Code for Control Structures 06Jan86gemCODE BRANCH (S -- ) LABEL BRAN1 IP ) D7 MOVE D7 IP LMOVE NEXT END-CODE CODE ?BRANCH (S f -- ) SP )+ TST BRAN1 BEQ IP )+ TST NEXT END-CODE \ Meta Compiler Branching Words 06Jan86gemT: BEGIN ?MARK T; T: THEN ?>RESOLVE T; T: ELSE [TARGET] BRANCH ?>MARK 2SWAP ?>RESOLVE T; T: WHILE [[ TRANSITION ]] IF T; T: REPEAT 2SWAP [[ TRANSITION ]] AGAIN THEN T; \ Run Time Code for Control Structures 06Jan86gem CODE (LOOP) (S -- ) 1 RP ) ADDQ BRAN1 BVC LONG RP )+ TST WORD RP )+ TST IP )+ TST NEXT END-CODE CODE (+LOOP) (S n -- ) SP )+ D0 MOVE D0 RP ) ADD BRAN1 BVC LONG RP )+ TST WORD RP )+ TST IP )+ TST NEXT END-CODE \ Run Time Code for Control Structures 19Jun86gemHEX CODE (DO) (S l i -- ) SP )+ D0 MOVE SP )+ D1 MOVE LABEL PDO IP )+ RP -) MOVE 8000 # D1 ADD D1 RP -) MOVE D1 D0 SUB D0 RP -) MOVE NEXT END-CODE CODE (?DO) (S l i -- ) SP )+ D0 MOVE SP )+ D1 MOVE D0 D1 CMP PDO BNE IP ) D7 MOVE D7 IP LMOVE NEXT END-CODE : BOUNDS (S adr len -- lim first ) OVER + SWAP ; DECIMAL \ Meta compiler Branching & Looping 06Jan86gemT: ?DO [TARGET] (?DO) ?>MARK T; T: DO [TARGET] (DO) ?>MARK T; T: LOOP [TARGET] (LOOP) OVER 2+ OVER ?RESOLVE T; T: +LOOP [TARGET] (+LOOP) OVER 2+ OVER ?RESOLVE T; \ Execution Control 26Jun86gemASSEMBLER >NEXT META CONSTANT >NEXT CODE EXECUTE (S cfa -- ) SP )+ D7 MOVE D7 W LMOVE W )+ D7 MOVE D7 A0 LMOVE A0 ) JMP END-CODE CODE PERFORM (S addr-of-cfa -- ) SP )+ D7 MOVE D7 W LMOVE W )+ D7 MOVE D7 W LMOVE W )+ D7 MOVE D7 A0 LMOVE A0 ) JMP END-CODE LABEL DODEFER (S -- ) ' PERFORM @-T 4 + bank L#) JMP LABEL DOUSER-DEFER W ) D7 MOVE UP bank L#) D7 ADD ' PERFORM @-T 2+ bank L#) JMP CODE GO (S addr -- ) RTS END-CODE CODE NOOP NEXT END-CODE CODE PAUSE NEXT END-CODE \ Execution Control 06Jan86gemCODE I (S -- n ) RP ) D0 MOVE 2 RP D) D0 ADD D0 SP -) MOVE NEXT END-CODE CODE J (S -- n ) 6 RP D) D0 MOVE 8 RP D) D0 ADD D0 SP -) MOVE NEXT END-CODE CODE (LEAVE) (S -- ) LABEL PLEAVE LONG RP )+ TST WORD RP )+ D7 MOVE D7 IP LMOVE NEXT END-CODE CODE (?LEAVE) (S f -- ) SP )+ TST PLEAVE BNE NEXT END-CODE T: LEAVE [TARGET] (LEAVE) T; T: ?LEAVE [TARGET] (?LEAVE) T; \ 16 and 8 bit Memory Operations 06Jan86gemCODE @ (S addr -- n ) SP ) D7 MOVE D7 A0 LMOVE BYTE A0 )+ D0 MOVE WORD 8 # D0 LSL BYTE A0 ) D0 MOVE WORD D0 SP ) MOVE NEXT END-CODE CODE ! (S n addr -- ) SP )+ D7 MOVE D7 A0 LMOVE SP )+ D0 MOVE BYTE D0 1 A0 D) MOVE WORD 8 # D0 LSR BYTE D0 A0 ) MOVE NEXT END-CODE CODE C@ (S addr -- char ) SP ) D7 MOVE D7 A0 LMOVE D0 CLR BYTE A0 ) D0 MOVE WORD D0 SP ) MOVE NEXT END-CODE CODE C! (S char addr -- ) SP )+ D7 MOVE D7 A0 LMOVE SP )+ D0 MOVE BYTE D0 A0 ) MOVE NEXT END-CODE \ Block Move Memory Operations 06Jan86gemCODE CMOVE (S from to count -- ) SP )+ D0 MOVE 1 D0 ADDQ SP )+ D7 MOVE D7 A0 LMOVE SP )+ D7 MOVE D7 A1 LMOVE BEGIN 1 D0 SUBQ 0<> WHILE BYTE A1 )+ A0 )+ MOVE REPEAT NEXT END-CODE CODE CMOVE> (S from to count -- ) SP )+ D0 MOVE SP )+ D7 MOVE D0 D7 ADD D7 A0 LMOVE SP )+ D7 MOVE D0 D7 ADD D7 A1 LMOVE 1 D0 ADDQ BEGIN 1 D0 SUBQ 0<> WHILE BYTE A1 -) A0 -) MOVE REPEAT NEXT END-CODE \ 16 bit Stack Operations 06Jan86gemCODE SP@ (S -- n ) SP SP -) MOVE NEXT END-CODE CODE SP! (S n -- ) SP )+ D7 MOVE D7 SP LMOVE NEXT END-CODE CODE RP@ (S -- addr ) RP SP -) MOVE NEXT END-CODE CODE RP! (S n -- ) SP )+ D7 MOVE D7 RP LMOVE NEXT END-CODE \ 16 bit Stack Operations 06Jan86gemCODE DROP (S n1 -- ) SP )+ D0 MOVE NEXT END-CODE CODE DUP (S n1 -- n1 n1 ) SP ) SP -) MOVE NEXT END-CODE CODE SWAP (S n1 n2 -- n2 n1 ) LONG SP ) D0 MOVE D0 SWAP D0 SP ) MOVE NEXT END-CODE CODE OVER (S n1 n2 -- n1 n2 n1 ) 2 SP D) SP -) MOVE NEXT END-CODE \ 16 bit Stack Operations 06Jan86gemCODE TUCK (S n1 n2 -- n2 n1 n2 ) LONG SP ) D0 MOVE D0 SWAP D0 SP ) MOVE WORD D0 SP -) MOVE NEXT END-CODE CODE NIP (S n1 n2 -- n2 ) SP )+ SP ) MOVE NEXT END-CODE CODE ROT (S n1 n2 n3 --- n2 n3 n1 ) SP )+ D1 MOVE SP )+ D2 MOVE SP ) D0 MOVE D2 SP ) MOVE D1 SP -) MOVE D0 SP -) MOVE NEXT END-CODE CODE -ROT (S n1 n2 n3 --- n3 n1 n2 ) SP )+ D2 MOVE SP )+ D0 MOVE SP ) D1 MOVE D2 SP ) MOVE D1 SP -) MOVE D0 SP -) MOVE NEXT END-CODE CODE FLIP (S n1 -- n2 ) ( byte swap ) SP )+ D0 MOVE 8 # D0 ROL D0 SP -) MOVE NEXT END-CODE : ?DUP (S n -- [n] n ) DUP IF DUP THEN ; \ 16 bit Stack Operations 06Jan86gemCODE R> (S -- n ) RP )+ SP -) MOVE NEXT END-CODE CODE >R (S n -- ) SP )+ RP -) MOVE NEXT END-CODE CODE R@ RP ) SP -) MOVE NEXT END-CODE CODE PICK (S nm ... n2 n1 k -- nm ... n2 n1 nk ) LONG D0 CLR WORD SP )+ D0 MOVE D0 D0 ADD 0 D0 SP DI) SP -) MOVE NEXT END-CODE : ROLL (S n1 n2 .. nk n -- wierd ) >R R@ PICK SP@ DUP 2+ R> 1+ 2* CMOVE> DROP ; \ 16 bit Logical Operations * 01Jul86gemCODE AND (S n1 n2 -- n3 ) SP )+ D0 MOVE D0 SP ) AND NEXT END-CODE CODE OR (S n1 n2 -- n3 ) SP )+ D0 MOVE D0 SP ) OR NEXT END-CODE CODE XOR (S n1 n2 -- n3 ) SP )+ D0 MOVE D0 SP ) EOR NEXT END-CODE CODE NOT (S n -- n' ) SP ) NOT NEXT END-CODE -1 CONSTANT TRUE 0 CONSTANT FALSE 6 CONSTANT BANK \ high word of where Forth will reside. \ important! \ 16 bit Logical Operations 06Jan86gemCODE CSET (S b addr -- ) SP )+ D7 MOVE D7 A0 LMOVE SP )+ D0 MOVE BYTE D0 A0 ) OR NEXT END-CODE CODE CRESET (S b addr -- ) SP )+ D7 MOVE D7 A0 LMOVE SP )+ D0 MOVE D0 NOT BYTE D0 A0 ) AND NEXT END-CODE CODE CTOGGLE (S b addr -- ) SP )+ D7 MOVE D7 A0 LMOVE SP )+ D0 MOVE BYTE D0 A0 ) EOR NEXT END-CODE CODE ON (S addr -- ) SP )+ D7 MOVE D7 A0 LMOVE TRUE # A0 ) MOVE NEXT END-CODE CODE OFF (S addr -- ) SP )+ D7 MOVE D7 A0 LMOVE A0 ) CLR NEXT END-CODE \ 16 bit Arithmetic Operations 06Jan86gemCODE + (S n1 n2 -- sum ) SP )+ D0 MOVE D0 SP ) ADD NEXT END-CODE CODE NEGATE (S n -- n' ) SP ) NEG NEXT END-CODE CODE - (S n1 n2 -- n1-n2 ) SP )+ D0 MOVE D0 SP ) SUB NEXT END-CODE CODE ABS (S n -- n ) SP ) TST 0< IF SP ) NEG THEN NEXT END-CODE CODE +! (S n addr -- ) SP )+ D7 MOVE D7 A0 LMOVE BYTE A0 )+ D0 MOVE WORD 8 # D0 LSL BYTE A0 ) D0 MOVE WORD SP )+ D0 ADD D0 D1 MOVE 8 # D1 LSR BYTE D0 A0 ) MOVE D1 A0 -) MOVE NEXT END-CODE 0 CONSTANT 0 1 CONSTANT 1 2 CONSTANT 2 3 CONSTANT 3 \ 16 bit Arithmetic Operations 06Jan86gemCODE 2* (S n -- 2*n ) SP ) ASL NEXT END-CODE CODE 2/ (S n -- n/2 ) SP ) ASR NEXT END-CODE CODE U2/ (S u -- u/2 ) SP ) LSR NEXT END-CODE CODE 8* (S n -- 8*n ) SP )+ D0 MOVE 3 # D0 ASL D0 SP -) MOVE NEXT END-CODE CODE 1+ 1 SP ) ADDQ NEXT END-CODE CODE 2+ 2 SP ) ADDQ NEXT END-CODE CODE 1- 1 SP ) SUBQ NEXT END-CODE CODE 2- 2 SP ) SUBQ NEXT END-CODE \ 16 bit Arithmetic Operations Unsigned Multiply 06Jan86gem CODE UM* (S n1 n2 -- d ) SP )+ D0 MOVE SP )+ D0 MULU LONG D0 SP -) MOVE NEXT END-CODE : U*D (S n1 n2 -- d ) UM* ; \ 16 bit Arithmetic Operations Unsigned Divide 06Jan86gemCODE UM/MOD (S d1 n1 -- Remainder Quotient ) SP )+ D0 MOVE LONG SP ) D1 MOVE D0 D1 DIVU D1 SWAP D1 SP ) MOVE NEXT END-CODE ASSEMBLER LABEL YES -1 # SP ) MOVE NEXT LABEL NO SP ) CLR NEXT \ 16 bit Comparison Operations 06Jan86gemmmCODE 0< (S n -- f ) SP ) TST YES BMI NO BRA END-CODE CODE 0= (S n -- f ) SP ) TST YES BEQ NO BRA END-CODE CODE 0> (S n -- f ) SP ) TST YES BGT NO BRA END-CODE CODE 0<> (S n -- f ) SP ) TST YES BNE NO BRA END-CODE CODE < (S n1 n2 -- f ) SP )+ D0 MOVE SP ) D0 CMP YES BGT NO BRA END-CODE CODE = (S n1 n2 -- f ) SP )+ D0 MOVE SP ) D0 CMP YES BEQ NO BRA END-CODE CODE > (S n1 n2 -- f ) SP )+ D0 MOVE SP ) D0 CMP YES BLT NO BRA END-CODE \ 16 bit Comparison Operations 06Jan86gemCODE U< (S n1 n2 -- f ) SP )+ D0 MOVE SP ) D0 CMP YES BHI NO BRA END-CODE CODE U> (S n1 n2 -- f ) SP )+ D0 MOVE SP ) D1 MOVE D0 D1 CMP YES BHI NO BRA END-CODE : <> (S n1 n2 -- f ) = NOT ; : ?NEGATE (S n1 n2 -- n3 ) 0< IF NEGATE THEN ; : MIN (S n1 n2 -- n3 ) 2DUP > IF SWAP THEN DROP ; : MAX (S n1 n2 -- n3 ) 2DUP < IF SWAP THEN DROP ; : BETWEEN (S n1 min max -- f ) >R OVER > SWAP R> > OR NOT ; : WITHIN (S n1 min max -- f ) 1- BETWEEN ; \ 32 bit Memory Operations 06Jan86gem: 2@ (S addr -- d ) DUP 2+ @ SWAP @ ; : 2! (S d addr -- ) TUCK ! 2+ ! ; \ 32 bit Memory and Stack Operations 06Jan86gemCODE 2DROP (S a b -- ) SP )+ D0 LMOVE NEXT END-CODE CODE 2DUP (S a b -- a b a b ) SP ) SP -) LONG MOVE NEXT END-CODE CODE 2SWAP (S a b c d -- c d a b ) LONG SP )+ D0 MOVE SP ) D1 MOVE D0 SP ) MOVE D1 SP -) MOVE NEXT END-CODE CODE 2OVER (S a b c d -- a b c d a b ) 4 SP D) SP -) LONG MOVE NEXT END-CODE : 3DUP (S a b c -- a b c a b c ) DUP 2OVER ROT ; : 4DUP (S a b c d -- a b c d a b c d ) 2OVER 2OVER ; : 2ROT (S a b c d e f --- c d e f a b ) 5 ROLL 5 ROLL ; \ 32 bit Arithmetic Operations 06Jan86gemCODE D+ (S d1 d2 -- dsum ) LONG SP )+ D0 MOVE D0 SP ) ADD NEXT END-CODE CODE DNEGATE (S d# -- d#' ) LONG SP ) NEG NEXT END-CODE CODE S>D (S n -- d ) SP )+ A0 MOVE A0 SP -) LMOVE NEXT END-CODE CODE DABS (S d# -- d# ) SP ) TST 0< IF LONG SP ) NEG THEN NEXT END-CODE \ 32 bit Arithmetic Operations 06Jan86gemCODE D2* (S d -- d*2 ) LONG SP )+ D0 MOVE 1 # D0 ASL D0 SP -) MOVE NEXT END-CODE CODE D2/ (S d -- d/2 ) LONG SP )+ D0 MOVE 1 # D0 ASR D0 SP -) MOVE NEXT END-CODE : D- (S d1 d2 -- d3 ) DNEGATE D+ ; : ?DNEGATE (S d1 n -- d2 ) 0< IF DNEGATE THEN ; \ 32 bit Comparison Operations 06Jan86gem: D0= (S d -- f ) OR 0= ; : D= (S d1 d2 -- f ) D- D0= ; : DU< (S ud1 ud2 -- f ) ROT SWAP 2DUP U< IF 2DROP 2DROP TRUE ELSE <> IF 2DROP FALSE ELSE U< THEN THEN ; : D< (S d1 d2 -- f ) 2 PICK OVER = IF DU< ELSE NIP ROT DROP < THEN ; : D> (S d1 d2 -- f ) 2SWAP D< ; : DMIN (S d1 d2 -- d3 ) 4DUP D> IF 2SWAP THEN 2DROP ; : DMAX (S d1 d2 -- d3 ) 4DUP D< IF 2SWAP THEN 2DROP ; \ Mixed Mode Arithmetic 06Jan86gem: *D (S n1 n2 -- d# ) 2DUP XOR >R ABS SWAP ABS UM* R> ?DNEGATE ; : M/MOD (S d# n1 -- rem quot ) ?DUP IF DUP >R 2DUP XOR >R >R DABS R@ ABS UM/MOD SWAP R> ?NEGATE SWAP R> 0< IF NEGATE OVER IF 1- R@ ROT - SWAP THEN THEN R> DROP THEN ; : MU/MOD (S d# n1 -- rem d#quot ) >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ; \ 16 bit multiply and divide 06Jan86gem: * (S n1 n2 -- n3 ) UM* DROP ; : /MOD (S n1 n2 -- rem quot ) >R S>D R> M/MOD ; : / (S n1 n2 -- quot ) /MOD NIP ; : MOD (S n1 n2 -- rem ) /MOD DROP ; : */MOD (S n1 n2 n3 -- rem quot ) >R *D R> M/MOD ; : */ (S n1 n2 n3 -- n1*n2/n3 ) */MOD NIP ; \ Task Dependant USER Variables 06Jan86gemUSER DEFINITIONS VARIABLE TOS ( TOP OF STACK ) VARIABLE ENTRY ( ENTRY POINT, CONTAINS MACHINE CODE ) VARIABLE LINK ( LINK TO NEXT TASK ) VARIABLE SP0 ( INITIAL PARAMETER STACK ) VARIABLE RP0 ( INITIAL RETURN STACK ) VARIABLE DP ( DICTIONARY POINTER ) VARIABLE #OUT ( NUMBER OF CHARACTERS EMITTED ) VARIABLE #LINE ( THE NUMBER OF LINES SENT SO FAR ) VARIABLE OFFSET ( RELATIVE TO ABSOLUTE DISK BLOCK 0 ) VARIABLE BASE ( FOR NUMERIC INPUT AND OUTPUT ) VARIABLE HLD ( POINTS TO LAST CHARACTER HELD IN PAD ) VARIABLE FILE ( POINTS TO FCB OF CURRENTLY OPEN FILE ) VARIABLE IN-FILE ( POINTS TO FCB OF CURRENTLY OPEN FILE ) VARIABLE PRINTING \ System VARIABLEs 06Jan86gemDEFER EMIT ( TO ALLOW PRINT SPOOLING ) META DEFINITIONS VARIABLE SCR ( SCREEN LAST LISTED OR EDITED ) VARIABLE PRIOR ( USED FOR DICTIONARY SEARCHES ) VARIABLE STATE ( COMPILATION OR INTERPRETATION ) VARIABLE WARNING ( GIVE USER DUPLICATE WARNINGS IF ON ) VARIABLE DPL ( NUMERIC INPUT PUNCTUATION ) VARIABLE R# ( EDITING CURSOR POSITION ) VARIABLE LAST ( POINTS TO NFA OF LATEST DEFINITION ) VARIABLE CSP ( HOLDS STACK POINTER FOR ERROR CHECKING ) VARIABLE CURRENT ( VOCABULARY WHICH GETS DEFINITIONS ) 8 CONSTANT #VOCS ( THE NUMBER OF VOCABULARIES TO SEARCH ) VARIABLE CONTEXT ( VOCABULARY SEARCHED FIRST ) HERE THERE #VOCS 2* DUP ALLOT ERASE \ System Variables 06Jan86gemVARIABLE 'TIB ( ADDRESS OF TERMINAL INPUT BUFFER ) VARIABLE WIDTH ( WIDTH OF NAME FIELD ) VARIABLE VOC-LINK ( POINTS TO NEWEST VOCABULARY ) VARIABLE BLK ( BLOCK NUMBER TO INTERPRET ) VARIABLE >IN ( OFFSET INTO INPUT STREAM ) VARIABLE SPAN ( NUMBER OF CHARACTERS EXPECTED ) VARIABLE #TIB ( NUMBER OF CHARACTERS TO INTERPRET ) VARIABLE END? ( TRUE IF INPUT STREAM EXHAUSTED ) \ Devices Strings 06Jan86gem 32 CONSTANT BL 8 CONSTANT BS 7 CONSTANT BELL VARIABLE CAPS CODE FILL ( start-addr count char -- ) SP )+ D0 MOVE SP )+ D1 MOVE SP )+ D7 MOVE D7 A0 LMOVE 1 D1 SUBQ D1 DO BYTE D0 A0 )+ MOVE LOOP NEXT END-CODE : ERASE (S addr len -- ) 0 FILL ; : BLANK (S addr len -- ) BL FILL ; CODE COUNT (S addr -- addr+1 len ) SP )+ D7 MOVE D7 A0 LMOVE D0 CLR BYTE A0 )+ D0 MOVE WORD A0 SP -) MOVE D0 SP -) MOVE NEXT END-CODE CODE LENGTH (S addr -- addr+2 len ) SP )+ D7 MOVE D7 A0 LMOVE A0 )+ D0 MOVE A0 SP -) MOVE D0 SP -) MOVE NEXT END-CODE : MOVE ( from to len -- ) -ROT 2DUP U< IF ROT CMOVE> ELSE ROT CMOVE THEN ; \ Devices Strings 06Jan86gemCODE UPC (S char -- upper-case-char ) SP )+ D6 MOVE BYTE ASCII a D6 CMPI >= IF ASCII z D6 CMPI <= IF BL D6 SUBI THEN THEN WORD D6 SP -) MOVE NEXT END-CODE : UPPER (S addr len -- ) BOUNDS ?DO I DUP C@ UPC SWAP C! LOOP ; : HERE (S -- addr ) DP @ ; : PAD (S -- addr ) HERE 80 + ; : -TRAILING (S addr len -- addr len' ) DUP 0 ?DO 2DUP + 1- C@ BL <> ?LEAVE 1- LOOP ; \ Devices Strings 06Jan86gemCODE COMP (S addr1 addr2 len -- -1 | 0 | 1 ) SP )+ D0 MOVE 1 D0 ADDQ SP )+ D7 MOVE D7 A0 LMOVE SP )+ D7 MOVE D7 A1 LMOVE BEGIN 1 D0 SUBQ 0<> WHILE BYTE A1 )+ A0 )+ CMPM WORD 0<> IF 0< IF 1 # SP -) MOVE ELSE -1 # SP -) MOVE THEN NEXT THEN REPEAT SP -) CLR NEXT END-CODE \ Devices Strings 26Jun86gemLABEL >UPPER ( D6 --> D6 ) BYTE ASCII a D6 CMPI >= IF ASCII z D6 CMPI <= IF BL D6 SUBI THEN THEN RTS CODE CAPS-COMP (S addr1 addr2 len -- -1 | 0 | 1 ) SP )+ D0 MOVE 1 D0 ADDQ SP )+ D7 MOVE D7 A0 LMOVE SP )+ D7 MOVE D7 A1 LMOVE BEGIN 1 D0 SUBQ 0<> WHILE BYTE A1 )+ D6 MOVE >UPPER bank L#) JSR D6 D1 MOVE A0 )+ D6 MOVE >UPPER bank L#) JSR D1 D6 CMP WORD 0<> IF 0< IF 1 # SP -) MOVE ELSE -1 # SP -) MOVE THEN NEXT THEN REPEAT SP -) CLR NEXT END-CODE : COMPARE (S addr1 addr2 len -- -1 | 0 | 1 ) CAPS @ IF CAPS-COMP ELSE COMP THEN ; \ Devices Terminal IO via CP/M BIOS 25Jun86gemCREATE REG-BUF 64 ALLOT ( Save registers ) CODE TRAP#1 (S n...n fun -- n...n fun d0.l ) 1 TRAP D0 SP -) LMOVE NEXT END-CODE CODE TRAP#13 (S n...n fun -- n...n fun d0.l ) 13 TRAP D0 SP -) LMOVE NEXT END-CODE CODE TRAP#14 (S n...n fun -- n...n fun d0.l ) 14 TRAP D0 SP -) LMOVE NEXT END-CODE : (KEY?) (S -- f ) 11 TRAP#1 DROP NIP 0<> ; : (KEY) (S -- char ) BEGIN PAUSE (KEY?) UNTIL 7 TRAP#1 DROP NIP ; : (CONSOLE) (S char -- ) PAUSE 6 TRAP#1 2DROP 2DROP 1 #OUT +! ; \ Devices Terminal Input and Output 19Jun86gemDEFER KEY? DEFER KEY DEFER CR : PR-STAT (S -- f ) 17 TRAP#1 DROP NIP 0<> ; : (PRINT) (S char -- ) BEGIN PAUSE PR-STAT UNTIL 5 TRAP#1 2DROP 1 #OUT +! ; : (EMIT) (S char -- ) PRINTING @ IF DUP (PRINT) -1 #OUT +! THEN (CONSOLE) ; : CRLF (S -- ) 13 EMIT 10 EMIT #OUT OFF 1 #LINE +! ; : TYPE (S addr len -- ) 0 ?DO COUNT EMIT LOOP DROP ; : SPACE (S -- ) BL EMIT ; : SPACES (S n -- ) 0 MAX 0 ?DO SPACE LOOP ; : BACKSPACES (S n -- ) 0 ?DO BS EMIT LOOP ; : BEEP (S -- ) BELL EMIT ; \ Devices System Dependent Control Characters 06Jan86gem: BS-IN (S n c -- 0 | n-1 ) DROP DUP IF 1- BS ELSE BELL THEN EMIT ; : (DEL-IN) (S n c -- 0 | n-1 ) DROP DUP IF 1- BS EMIT SPACE BS ELSE BELL THEN EMIT ; : BACK-UP (S n c -- 0 ) DROP DUP BACKSPACES DUP SPACES BACKSPACES 0 ; : RES-IN (S c -- ) FORTH TRUE ABORT" Reset" ; : P-IN (S c -- ) DROP PRINTING @ NOT PRINTING ! ; \ Devices Terminal Input 06Jan86gem: CR-IN (S m a n c -- m a m ) DROP SPAN ! OVER BL EMIT ; : (CHAR) (S a n char -- a n+1 ) 3DUP EMIT + C! 1+ ; DEFER CHAR DEFER DEL-IN VARIABLE CC CREATE CC-FORTH ] CHAR CHAR CHAR RES-IN CHAR CHAR CHAR CHAR BS-IN CHAR CHAR CHAR CHAR CR-IN CHAR CHAR P-IN CHAR CHAR CHAR CHAR BACK-UP CHAR CHAR BACK-UP CHAR CHAR CHAR CHAR CHAR CHAR CHAR [ \ Devices Terminal Input 06Jan86gem: EXPECT (S adr len -- ) DUP SPAN ! SWAP 0 ( len adr 0 ) BEGIN 2 PICK OVER - ( len adr #so-far #left ) WHILE KEY DUP BL < IF DUP 2* CC @ + PERFORM ELSE DUP 127 = IF DEL-IN ELSE CHAR THEN THEN REPEAT 2DROP DROP ; : TIB (S -- adr ) 'TIB @ ; : QUERY (S -- ) TIB 80 EXPECT SPAN @ #TIB ! BLK OFF >IN OFF ; \ Devices BLOCK I/O 19Jun86gem 4 CONSTANT #BUFFERS 1024 CONSTANT B/BUF 1024 CONSTANT B/REC 1 CONSTANT REC/BLK 44 CONSTANT B/FCB VARIABLE DISK-ERROR -2 CONSTANT LIMIT #BUFFERS 1+ 8 * 2+ CONSTANT >SIZE LIMIT B/BUF #BUFFERS * - CONSTANT FIRST FIRST >SIZE - CONSTANT INIT-R0 : >BUFFERS (S -- adr ) FIRST >SIZE - ; : >END (S -- adr ) FIRST 2- ; : BUFFER# (S n -- adr ) 8* >BUFFERS + ; : >UPDATE (S -- adr ) 1 BUFFER# 6 + ; \ Devices BLOCK I/O 19Jun86gemDEFER READ-BLOCK (S buffer-header -- ) DEFER WRITE-BLOCK (S buffer-header -- ) : .FILE (S adr -- ) BEGIN DUP C@ DUP 0<> WHILE EMIT 1+ REPEAT 2DROP ; : FILE? (S -- ) FILE @ .FILE ; : SWITCH (S -- ) FILE @ IN-FILE @ FILE ! IN-FILE ! ; VOCABULARY DOS DOS DEFINITIONS : !FILES (S fcb -- ) DUP FILE ! IN-FILE ! ; : DISK-ABORT (S fcb a n -- ) TYPE ." in " .FILE ABORT ; : ?DISK-ERROR (S fcb n -- ) DUP DISK-ERROR ! IF " Disk error" DISK-ABORT ELSE DROP THEN ; \ Devices BLOCK I/O 24Jun86gem CREATE DMA B/FCB ALLOT CREATE FCB1 B/FCB ALLOT : CLR-FCB (S fcb -- ) B/FCB ERASE ; : CLR-DMA (S dma -- ) B/FCB ERASE ; \ 16 bit adr only : SET-DMA (S daddr -- ) 26 TRAP#1 2DROP DROP 2DROP ; : HANDLE# (S fcb -- adr ) 30 + ; : RECORD# (S fcb -- adr ) 34 + ; : MAXREC# (S fcb -- adr ) 38 + ; : IN-RANGE (S fcb -- fcb ) DUP MAXREC# @ OVER RECORD# @ U< DUP DISK-ERROR ! IF 1 BUFFER# ON " Out of Range" DISK-ABORT THEN ; \ Devices BLOCK I/O 26Jun86gem: SET-IO (S buffer-header -- buffer-header ) DUP 2@ SWAP RECORD# ! DUP 2@ DROP IN-RANGE DROP ; : FILE-READ (S buffer-header -- ) SET-IO DUP 2@ SWAP HANDLE# @ SWAP 0 ( from beginning ) -ROT B/BUF *D 66 TRAP#1 2DROP DROP 2DROP 2DROP ( clean stack ) 2+ 2@ bank SWAP B/BUF SWAP 0 SWAP HANDLE# @ 63 TRAP#1 2DROP 2DROP 2DROP 2DROP ; : FILE-WRITE (S buffer-header -- ) SET-IO DUP 2@ SWAP HANDLE# @ SWAP 0 ( from beginning ) -ROT B/BUF *D 66 TRAP#1 2DROP DROP 2DROP 2DROP ( clean stack ) 2+ 2@ bank SWAP B/BUF SWAP 0 SWAP HANDLE# @ 64 TRAP#1 2DROP 2DROP 2DROP 2DROP ; : FILE-IO (S -- ) ['] FILE-READ IS READ-BLOCK ['] FILE-WRITE IS WRITE-BLOCK ; \ Devices BLOCK I/O 19Jun86gemFORTH DEFINITIONS : CAPACITY (S -- n ) [ DOS ] FILE @ MAXREC# @ 1+ ; : LATEST? (S n fcb -- fcb n | a f ) DISK-ERROR OFF SWAP OFFSET @ + 2DUP 1 BUFFER# 2@ D= IF 2DROP 1 BUFFER# 4 + @ FALSE R> DROP THEN ; : ABSENT? (S n fcb -- a f ) LATEST? FALSE #BUFFERS 1+ 2 DO DROP 2DUP I BUFFER# 2@ D= IF 2DROP I LEAVE ELSE FALSE THEN LOOP ?DUP IF BUFFER# DUP >BUFFERS 8 CMOVE >R >BUFFERS DUP 8 + OVER R> SWAP - CMOVE> 1 BUFFER# 4 + @ FALSE ELSE >BUFFERS 2! TRUE THEN ; \ Devices BLOCK I/O 06Jan86gem: UPDATE (S -- ) >UPDATE ON ; : DISCARD (S -- ) 1 >UPDATE ! ( 1 BUFFER# ON ) ; : MISSING (S -- ) >END 2- @ 0< IF >END 2- OFF >END 8 - WRITE-BLOCK THEN >END 4 - @ >BUFFERS 4 + ! ( buffer ) 1 >BUFFERS 6 + ! >BUFFERS DUP 8 + #BUFFERS 8* CMOVE> ; : (BUFFER) (S n fcb -- a ) PAUSE ABSENT? IF MISSING 1 BUFFER# 4 + @ THEN ; : BUFFER (S n -- a ) FILE @ (BUFFER) ; : (BLOCK) (S n fcb -- a ) (BUFFER) >UPDATE @ 0> IF 1 BUFFER# DUP READ-BLOCK 6 + OFF THEN ; : BLOCK (S n -- a ) FILE @ (BLOCK) ; : IN-BLOCK (S n -- a ) IN-FILE @ (BLOCK) ; \ Devices BLOCK I/O 06Jan86gem: EMPTY-BUFFERS (S -- ) FIRST LIMIT OVER - ERASE >BUFFERS #BUFFERS 1+ 8* ERASE FIRST 1 BUFFER# #BUFFERS 0 DO DUP ON 4 + 2DUP ! SWAP B/BUF + SWAP 4 + LOOP 2DROP ; : SAVE-BUFFERS (S -- ) 1 BUFFER# #BUFFERS 0 DO DUP @ 1+ IF DUP 6 + @ 0< IF DUP WRITE-BLOCK DUP 6 + OFF THEN 8 + THEN LOOP DROP ; : FLUSH (S -- ) SAVE-BUFFERS 0 BLOCK DROP EMPTY-BUFFERS ; : VIEW# (S -- addr ) FILE @ 40 + ; \ Devices BLOCK I/O 26Jun86gemDOS DEFINITIONS : FILE-SIZE (S fcb -- n ) DMA bank SET-DMA 0 ( normal ) OVER bank 78 TRAP#1 2DROP 2DROP 2DROP DMA 26 + 2@ B/BUF M/MOD NIP 1- DUP ROT MAXREC# ! ; : DOS-ERR? (S -- f ) 0< ; : OPEN-FILE (S -- ) 2 ( read & write ) IN-FILE @ bank 61 TRAP#1 DROP >R 2DROP 2DROP R> DUP DOS-ERR? IF DISK-ERROR ! IN-FILE @ " Open error" DISK-ABORT THEN IN-FILE @ HANDLE# ! IN-FILE @ FILE-SIZE DROP ; \ Devices BLOCK I/O * 26Jun86gem\ HEX 45C CONSTANT DOS-FCB DECIMAL FORTH DEFINITIONS \ : DEFAULT (S -- ) [ DOS ] FCB1 DUP IN-FILE ! DUP FILE ! \ CLR-FCB DOS-FCB 1+ C@ BL <> \ IF DOS-FCB FCB1 12 CMOVE OPEN-FILE THEN ; : EXTEND (S -- ) [ DOS ] FCB1 CLR-FCB " EXTEND.BLK" FCB1 SWAP CMOVE FCB1 DUP IN-FILE ! FILE ! OPEN-FILE ; : (LOAD) (S n -- ) FILE @ >R BLK @ >R >IN @ >R >IN OFF BLK ! IN-FILE @ FILE ! RUN R> >IN ! R> BLK ! R> !FILES ; DEFER LOAD \ Interactive Layer Number Input 06Jan86gemASSEMBLER LABEL FAIL SP -) CLR NEXT CODE DIGIT (S char base -- n true | char false ) SP )+ D0 MOVE SP ) D1 MOVE BYTE 48 # D1 SUB FAIL BMI 10 # D1 CMP 0>= IF 17 # D1 CMP FAIL BMI 7 D1 SUBQ THEN D0 D1 CMP FAIL BPL WORD D1 SP ) MOVE TRUE # SP -) MOVE NEXT END-CODE : DOUBLE? (S -- f ) DPL @ 1+ 0<> ; : CONVERT (S +d1 adr1 -- +d2 adr2 ) BEGIN 1+ DUP >R C@ BASE @ DIGIT WHILE SWAP BASE @ UM* DROP ROT BASE @ UM* D+ DOUBLE? IF 1 DPL +! THEN R> REPEAT DROP R> ; \ Interactive Layer Number Input 06Jan86gem: (NUMBER?) (S adr -- d flag ) 0 0 ROT DUP 1+ C@ ASCII - = DUP >R - -1 DPL ! BEGIN CONVERT DUP C@ ASCII , ASCII / BETWEEN WHILE 0 DPL ! REPEAT -ROT R> IF DNEGATE THEN ROT C@ BL = ; : NUMBER? (S adr -- d flag ) FALSE OVER COUNT BOUNDS ?DO I C@ BASE @ DIGIT NIP IF DROP TRUE LEAVE THEN LOOP IF (NUMBER?) ELSE DROP 0 0 FALSE THEN ; : (NUMBER) (S adr -- d# ) NUMBER? NOT ?MISSING ; DEFER NUMBER \ Interactive Layer Number Output 20Jun86gem: HOLD (S char -- ) -1 HLD +! HLD @ C! ; : <# (S -- ) PAD HLD ! ; : #> (S d# -- addr len ) 2DROP HLD @ PAD OVER - ; : SIGN (S n1 -- ) 0< IF ASCII - HOLD THEN ; : # (S -- ) BASE @ MU/MOD ROT 9 OVER < IF 7 + THEN ASCII 0 + HOLD ; : #S (S -- ) BEGIN # 2DUP OR 0= UNTIL ; : HEX (S -- ) 16 BASE ! ; : DECIMAL (S -- ) 10 BASE ! ; : OCTAL (S -- ) 8 BASE ! ; : BINARY (S -- ) 2 BASE ! ; \ Interactive Layer Number Output 06Jan86gem: (U.) (S u -- a l ) 0 <# #S #> ; : U. (S u -- ) (U.) TYPE SPACE ; : U.R (S u l -- ) >R (U.) R> OVER - SPACES TYPE ; : (.) (S n -- a l ) DUP ABS 0 <# #S ROT SIGN #> ; : . (S n -- ) (.) TYPE SPACE ; : .R (S n l -- ) >R (.) R> OVER - SPACES TYPE ; : (UD.) (S ud -- a l ) <# #S #> ; : UD. (S ud -- ) (UD.) TYPE SPACE ; : UD.R (S ud l -- ) >R (UD.) R> OVER - SPACES TYPE ; : (D.) (S d -- a l ) TUCK DABS <# #S ROT SIGN #> ; : D. (S d -- ) (D.) TYPE SPACE ; : D.R (S d l -- ) >R (D.) R> OVER - SPACES TYPE ; \ SKIP SCAN 06Jan86gemASSEMBLER LABEL DONE A0 SP -) MOVE D1 SP -) MOVE NEXT END-CODE CODE SKIP (S adr1 len1 char -- adr2 len2 ) SP )+ D0 MOVE SP )+ D1 MOVE 1 D1 ADDQ SP )+ D7 MOVE D7 A0 LMOVE BEGIN 1 D1 SUBQ 0<> WHILE BYTE A0 ) D2 MOVE D2 D0 CMP DONE BNE WORD 1 A0 ADDQ REPEAT DONE BRA END-CODE CODE SCAN (S adr1 len1 char -- adr2 len2 ) SP )+ D0 MOVE SP )+ D1 MOVE 1 D1 ADDQ SP )+ D7 MOVE D7 A0 LMOVE BEGIN 1 D1 SUBQ 0<> WHILE BYTE A0 ) D2 MOVE D2 D0 CMP DONE BEQ WORD 1 A0 ADDQ REPEAT DONE BRA END-CODE \ Interactive Layer Parsing 06Jan86gem: /STRING (S addr len n -- addr' len' ) OVER MIN ROT OVER + -ROT - ; : PLACE (S str-addr len to -- ) 3DUP 1+ SWAP MOVE C! DROP ; : (SOURCE) (S -- addr len ) BLK @ ?DUP IF BLOCK B/BUF ELSE TIB #TIB @ THEN ; DEFER SOURCE : PARSE-WORD (S char -- addr len ) >R SOURCE TUCK >IN @ /STRING R@ SKIP OVER SWAP R> SCAN >R OVER - ROT R> DUP 0<> + - >IN ! ; : PARSE (S char -- addr len ) >R SOURCE >IN @ /STRING OVER SWAP R> SCAN >R OVER - DUP R> 0<> - >IN +! ; \ Interactive Layer Parsing 06Jan86gem: 'WORD (S -- adr ) HERE ; : WORD (S char -- addr ) PARSE-WORD 'WORD PLACE 'WORD DUP COUNT + BL SWAP C! ( Stick Blank at end ) ; : >TYPE (S adr len -- ) TUCK PAD SWAP CMOVE PAD SWAP TYPE ; : .( (S -- ) ASCII ) PARSE >TYPE ; IMMEDIATE : ( (S -- ) ASCII ) PARSE 2DROP ; IMMEDIATE : \S (S -- ) END? ON ; IMMEDIATE \ Interactive Layer Dictionary 26Jun86gemCODE TRAVERSE (S addr direction -- addr' ) SP )+ D0 MOVE SP )+ D7 MOVE D7 A0 LMOVE D0 A0 ADDA BEGIN A0 ) 7 # BTST 0= WHILE D0 A0 ADDA REPEAT A0 SP -) MOVE NEXT END-CODE : DONE? (S n -- f ) STATE @ <> END? @ OR END? OFF ; : FORTH-83 (S -- ) FORTH DEFINITIONS CAPS OFF ." (almost) " ; \ Interactive Layer Dictionary 06Jan86gem: N>LINK 2- ; : L>NAME 2+ ; : BODY> 2- ; : NAME> 1 TRAVERSE 1+ ; : LINK> L>NAME NAME> ; : >BODY 2+ ; : >NAME 1- -1 TRAVERSE ; : >LINK >NAME N>LINK ; : >VIEW >LINK 2- ; : VIEW> 2+ LINK> ; CODE HASH (S str-addr voc-ptr -- thread ) SP )+ D1 MOVE SP )+ D7 MOVE D7 A0 LMOVE BYTE A0 )+ TST A0 )+ D0 MOVE WORD 3 # D0 AND D0 D0 ADD D0 D1 ADD D1 SP -) MOVE NEXT END-CODE \ Interactive Layer Dictionary 06Jan86gemCODE (FIND) (S string link -- code true | adr false ) HEX D7 D6 LMOVE D2 CLR SP )+ D7 MOVE BEGIN 0<> WHILE D7 A1 LMOVE SP ) D6 MOVE D6 A0 LMOVE A1 )+ TST BYTE A0 )+ D0 MOVE A1 )+ D1 MOVE D1 D2 MOVE D0 D1 EOR 3F # D1 AND ( mask flag bits ) 0= IF BEGIN A0 )+ D0 MOVE A1 )+ D1 MOVE D0 D1 EOR 0<> UNTIL 7F # D1 AND 0= ( found? ) WORD IF A1 SP ) MOVE 40 # D2 AND 0<> IF 1 # SP -) MOVE ELSE -1 # SP -) MOVE THEN NEXT THEN THEN D7 A1 LMOVE A1 ) D7 MOVE REPEAT SP -) CLR NEXT END-CODE DECIMAL \ Interactive Layer Dictionary 06Jan86gem4 CONSTANT #THREADS : FIND (S addr -- cfa flag | addr false ) DUP C@ IF PRIOR OFF FALSE #VOCS 0 DO DROP CONTEXT I 2* + @ DUP IF DUP PRIOR @ OVER PRIOR ! = IF DROP FALSE ELSE OVER SWAP HASH @ (FIND) DUP ?LEAVE THEN THEN LOOP ELSE DROP END? ON ['] NOOP 1 THEN ; : ?UPPERCASE (S adr -- adr ) CAPS @ IF DUP COUNT UPPER THEN ; : DEFINED (S -- here 0 | cfa [ -1 | 1 ] ) BL WORD ?UPPERCASE FIND ; \ Interactive Layer Interpreter 06Jan86gem: ?STACK (S -- ) ( System dependant ) SP@ SP0 @ SWAP U< ABORT" Stack Underflow" SP@ PAD U< ABORT" Stack Overflow" ; DEFER STATUS (S -- ) : INTERPRET (S -- ) BEGIN ?STACK DEFINED IF EXECUTE ELSE NUMBER DOUBLE? NOT IF DROP THEN THEN FALSE DONE? UNTIL ; \ Extensible Layer Compiler 06Jan86gem: ALLOT (S n -- ) DP +! ; : , (S n -- ) HERE ! 2 ALLOT ; : C, (S char -- ) HERE C! 1 ALLOT ; : ALIGN HERE 1 AND IF BL C, THEN ; : EVEN DUP 1 AND + ; : COMPILE (S -- ) R> DUP 2+ >R @ , ; : IMMEDIATE (S -- ) 64 ( Precedence bit ) LAST @ CSET ; : LITERAL (S n -- ) COMPILE (LIT) , ; IMMEDIATE : DLITERAL (S d# -- ) SWAP [COMPILE] LITERAL [COMPILE] LITERAL ; IMMEDIATE : ASCII (S -- n ) BL WORD 1+ C@ STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE : CONTROL (S -- n ) BL WORD 1+ C@ 31 AND STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE \ Extensible Layer Compiler 06Jan86gem: CRASH (S -- ) TRUE ABORT" Uninitialized execution vector." ; : ?MISSING (S f -- ) IF 'WORD COUNT TYPE TRUE ABORT" ?" THEN ; : ' (S -- cfa ) DEFINED 0= ?MISSING ; : ['] (S -- ) ' [COMPILE] LITERAL ; IMMEDIATE : [COMPILE] (S -- ) ' , ; IMMEDIATE : (") (S -- addr len ) R> COUNT 2DUP + EVEN >R ; : (.") (S -- ) R> COUNT 2DUP + EVEN >R TYPE ; : ," (S -- ) ASCII " PARSE TUCK 'WORD PLACE 1+ ALLOT ALIGN ; : ." (S -- ) COMPILE (.") ," ; IMMEDIATE : " (S -- ) COMPILE (") ," ; IMMEDIATE \ Interactive Layer Dictionary 06Jan86gemVARIABLE FENCE : TRIM (S faddr voc-addr -- ) #THREADS 0 DO 2DUP @ BEGIN 2DUP U> NOT WHILE @ REPEAT NIP OVER ! 2+ LOOP 2DROP ; : (FORGET) (S addr -- ) DUP FENCE @ U< ABORT" Below fence" DUP VOC-LINK @ BEGIN 2DUP U< WHILE @ REPEAT DUP VOC-LINK ! NIP BEGIN DUP WHILE 2DUP #THREADS 2* - TRIM @ REPEAT DROP DP ! ; : FORGET (S -- ) BL WORD ?UPPERCASE DUP CURRENT @ HASH @ (FIND) 0= ?MISSING >VIEW (FORGET) ; \ Extensible Layer Compiler 06Jan86gemDEFER WHERE DEFER ?ERROR : (?ERROR) (S adr len f -- ) IF >R >R SP0 @ SP! PRINTING OFF BLK @ IF >IN @ BLK @ WHERE THEN R> R> SPACE TYPE SPACE QUIT ELSE 2DROP THEN ; : (ABORT") (S f -- ) R@ COUNT ROT ?ERROR R> COUNT + EVEN >R ; : ABORT" (S -- ) COMPILE (ABORT") ," ; IMMEDIATE : ABORT (S -- ) TRUE ABORT" " ; \ Extensible Layer Structures 06Jan86gem: ?CONDITION (S f -- ) NOT ABORT" Conditionals Wrong" ; : >MARK (S -- addr ) HERE 0 , ; : >RESOLVE (S addr -- ) HERE SWAP ! ; : MARK (S -- f addr ) TRUE >MARK ; : ?>RESOLVE (S f addr -- ) SWAP ?CONDITION >RESOLVE ; : ?RESOLVE ; IMMEDIATE : DO COMPILE (DO) ?>MARK ; IMMEDIATE : ?DO COMPILE (?DO) ?>MARK ; IMMEDIATE : LOOP COMPILE (LOOP) 2DUP 2+ ?RESOLVE ; IMMEDIATE : +LOOP COMPILE (+LOOP) 2DUP 2+ ?RESOLVE ; IMMEDIATE : UNTIL COMPILE ?BRANCH ?MARK ; IMMEDIATE : ELSE COMPILE BRANCH ?>MARK 2SWAP ?>RESOLVE ; IMMEDIATE : WHILE [COMPILE] IF ; IMMEDIATE \ Extensible Layer Defining Words 06Jan86gem: ,VIEW (S -- ) BLK @ DUP IF VIEW# @ 4096 * + THEN , ; : "CREATE (S str -- ) COUNT HERE EVEN 4 + PLACE ALIGN ,VIEW HERE 0 , ( reserve link ) HERE LAST ! ( remember nfa ) HERE ( lfa nfa ) WARNING @ IF FIND IF HERE COUNT TYPE ." isn't unique " THEN DROP HERE THEN ( lfa nfa ) CURRENT @ HASH DUP @ ( lfa tha prev ) HERE 2- ROT ! ( lfa prev ) SWAP ! ( Resolve link field) HERE DUP C@ WIDTH @ MIN 1+ ALLOT ALIGN 128 SWAP CSET 128 HERE 1- CSET ( delimiter Bits ) COMPILE [ [FORTH] ASSEMBLER DOCREATE , META ] ; : CREATE (S -- ) BL WORD ?UPPERCASE "CREATE ; \ Extensible Layer Defining Words 26Jun86gem: !CSP (S -- ) SP@ CSP ! ; : ?CSP (S -- ) SP@ CSP @ <> ABORT" Stack Changed" ; : HIDE (S -- ) LAST @ DUP N>LINK @ SWAP CURRENT @ HASH ! ; : REVEAL (S -- ) LAST @ DUP N>LINK SWAP CURRENT @ HASH ! ; : (;USES) (S -- ) R> @ LAST @ NAME> ! ; VOCABULARY ASSEMBLER : ;USES (S -- ) ?CSP COMPILE (;USES) [COMPILE] [ REVEAL ASSEMBLER ; IMMEDIATE : (;CODE) (S -- ) R> LAST @ NAME> ! ; : ;CODE (S -- ) ?CSP COMPILE (;CODE) [COMPILE] [ REVEAL ASSEMBLER ; IMMEDIATE HEX : DOES> (S -- ) COMPILE (;CODE) 4EB9 , ( JSR.L ) [ DECIMAL ] [ [ASSEMBLER] DODOES META ] bank , LITERAL , ; IMMEDIATE \ Extensible Layer Defining Words 06Jan86gem: [ (S -- ) STATE OFF ; IMMEDIATE : ] (S -- ) STATE ON BEGIN ?STACK DEFINED DUP IF 0> IF EXECUTE ELSE , THEN ELSE DROP NUMBER DOUBLE? IF [COMPILE] DLITERAL ELSE DROP [COMPILE] LITERAL THEN THEN TRUE DONE? UNTIL ; : : (S -- ) !CSP CURRENT @ CONTEXT ! CREATE HIDE ] ;USES NEST , : ; (S -- ) ?CSP COMPILE UNNEST REVEAL [COMPILE] [ ; IMMEDIATE \ Extensible Layer Defining Words 06Jan86gem: RECURSIVE (S -- ) REVEAL ; IMMEDIATE : CONSTANT (S n -- ) CREATE , ;USES DOCONSTANT , : VARIABLE (S -- ) CREATE 0 , ;USES DOCREATE , : DEFER (S -- ) CREATE ['] CRASH , ;USES DODEFER , DODEFER RESOLVES : VOCABULARY (S -- ) CREATE #THREADS 0 DO 0 , LOOP HERE VOC-LINK @ , VOC-LINK ! DOES> CONTEXT ! ; RESOLVES : DEFINITIONS (S -- ) CONTEXT @ CURRENT ! ; \ Extensible Layer Defining Words 06Jan86gem: 2CONSTANT CREATE , , (S d# -- ) DOES> 2@ ; (S -- d# ) DROP : 2VARIABLE 0 0 2CONSTANT (S -- ) DOES> ; (S -- addr ) DROP VARIABLE AVOC : CODE (S -- ) CREATE HIDE HERE DUP 2- ! CONTEXT @ AVOC ! ASSEMBLER ; ASSEMBLER DEFINITIONS : END-CODE AVOC @ CONTEXT ! REVEAL ; FORTH DEFINITIONS META IN-META \ Extensible Layer Defining Words 06Jan86gemVARIABLE #USER VOCABULARY USER USER DEFINITIONS : ALLOT (S n -- ) #USER +! ; ' CREATE ( avoid recursion: leave address for , in CREATE ) : CREATE (S -- ) [ , ] #USER @ , ;USES DOUSER-VARIABLE , : VARIABLE (S -- ) CREATE 2 ALLOT ; : DEFER (S -- ) VARIABLE ;USES DOUSER-DEFER , FORTH DEFINITIONS META IN-META \ Extensible Layer ReDefining Words 06Jan86gem: >IS (S cfa -- data-address ) DUP @ DUP [ [ASSEMBLER] DOUSER-VARIABLE META ] LITERAL = SWAP DUP [ [ASSEMBLER] DOUSER-DEFER META ] LITERAL = SWAP DROP OR IF >BODY @ UP @ + ELSE >BODY THEN ; : (IS) (S cfa --- ) R@ @ >IS ! R> 2+ >R ; : IS (S cfa --- ) STATE @ IF COMPILE (IS) ELSE ' >IS ! THEN ; IMMEDIATE \ Initialization High Level 21Jun86gem: RUN (S -- ) STATE @ IF ] STATE @ NOT IF INTERPRET THEN ELSE INTERPRET THEN ; : QUIT (S -- ) SP0 @ 'TIB ! BLK OFF [COMPILE] [ BEGIN RP0 @ RP! STATUS QUERY RUN STATE @ NOT IF ." ok" THEN AGAIN ; DEFER BOOT : WARM (S -- ) TRUE ABORT" Warm Start" ; : COLD (S -- ) BOOT QUIT ; \ Initialization High Level 26Jun86gem1 CONSTANT INITIAL : OK (S -- ) INITIAL LOAD ; : START (S -- ) EMPTY-BUFFERS ; \ DEFAULT ; : BYE ( -- ) CR HERE 0 256 UM/MOD NIP 1+ DECIMAL U. ." Pages" 0 TRAP#1 ; \ Initialization Low Level 26Jun86gem [ASSEMBLER] bank ORIGIN 8 + !-T HERE ORIGIN 10 + !-T ( WARM ENTRY POINT ) ' WARM bank L#) W LEA W )+ D7 MOVE D7 A0 LMOVE A0 ) JMP bank ORIGIN 2 + !-T HERE ORIGIN 4 + !-T ( COLD ENTRY POINT ) INIT-R0 bank L#) RP LEA INIT-R0 256 - bank L#) SP LEA LONG 0 bank # D7 MOVE WORD ' COLD bank L#) W LEA W )+ D7 MOVE D7 A0 LMOVE A0 ) JMP \ Initialize User Variables 06Jan86gemHERE UP !-T ( SET UP USER AREA ) 0 , ( TOS ) 0 , ( ENTRY ) 0 , ( LINK ) INIT-R0 256 - , ( SP0 ) INIT-R0 , ( RP0 ) 0 , ( DP ) ( Must be patched later ) 0 , ( #OUT ) 0 , ( #LINE ) 0 , ( OFFSET ) 10 , ( BASE ) 0 , ( HLD ) 0 , ( FILE ) 0 , ( IN-FILE ) FALSE , ( PRINTING ) ' (EMIT) , ( EMIT ) \ Resident Tools 06Jan86gem: DEPTH (S -- n ) SP@ SP0 @ SWAP - 2/ ; : .S (S -- ) DEPTH ?DUP IF 0 DO DEPTH I - 1- PICK 7 U.R SPACE KEY? ?LEAVE LOOP ELSE ." Empty " THEN ; : .ID (S nfa -- ) DUP 1+ DUP C@ ROT C@ 31 AND 0 ?DO DUP 127 AND EMIT 128 AND IF ASCII _ 128 OR ELSE 1+ DUP C@ THEN LOOP 2DROP SPACE ; : DUMP (S addr len -- ) 0 DO CR DUP 6 .R SPACE 16 0 DO DUP C@ 3 .R 1+ LOOP 16 +LOOP DROP ; \ For Completeness 24Jun86gem: RECURSE (S -- ) LAST @ NAME> , ; IMMEDIATE \ Resolve Forward References 06Jan86gem ' (.") RESOLVES <(.")> ' (") RESOLVES <(")> ' (;CODE) RESOLVES <(;CODE)> ' (;USES) RESOLVES <(;USES)> ' (IS) RESOLVES <(IS)> ' (ABORT") RESOLVES <(ABORT")> [ASSEMBLER] DOCREATE META RESOLVES [ASSEMBLER] DOUSER-DEFER META RESOLVES [ASSEMBLER] DOUSER-VARIABLE META RESOLVES \ Resolve Forward References 06Jan86gem' SWAP RESOLVES SWAP ' DEFINITIONS RESOLVES DEFINITIONS ' + RESOLVES + ' OVER RESOLVES OVER ' [ RESOLVES [ ' 2+ RESOLVES 2+ ' 1+ RESOLVES 1+ ' 2* RESOLVES 2* ' 2DUP RESOLVES 2DUP ' ?MISSING RESOLVES ?MISSING ' RUN RESOLVES RUN ' ABORT RESOLVES ABORT ' QUIT RESOLVES QUIT \ Initialize DEFER words 06Jan86gem ' (LOAD) IS LOAD ' (KEY?) IS KEY? ' (KEY) IS KEY ' CRLF IS CR ' FILE-READ IS READ-BLOCK ' FILE-WRITE IS WRITE-BLOCK ' NOOP IS WHERE ' CR IS STATUS ' (SOURCE) IS SOURCE ' START IS BOOT ' (NUMBER) IS NUMBER ' (CHAR) IS CHAR ' (DEL-IN) IS DEL-IN ' (?ERROR) IS ?ERROR \ Initialize Variables 06Jan86gem' FORTH >BODY CURRENT !-T ' FORTH >BODY CONTEXT !-T ' CC-FORTH >BODY CC !-T HERE-T DP UP @-T + !-T ( INIT USER DP ) #USER-T @ #USER !-T ( INIT USER VAR COUNT ) TRUE CAPS !-T ( SET TO IGNORE CASE ) TRUE WARNING !-T ( SET TO ISSUE WARNINGS ) 31 WIDTH !-T ( 31 CHARACTER NAMES ) VOC-LINK-T @ VOC-LINK !-T ( INIT VOC-LINK ) \ The Rest is Silence 30Jun86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for Pre-Compile 25Jun86gemONLY FORTH ALSO DEFINITIONS DOS ' NOOP IS HEADER FENCE OFF FORGET OUT : NLOAD CR .S (LOAD) ; ' NLOAD IS LOAD WARNING OFF 3 21 THRU ( The Meta Compiler ) ONLY FORTH DEFINITIONS ALSO CR .( Meta Compiler Loaded ) FROM KERNEL.BLK 1 LOAD \ Vocabulary Helpers 06Jan86gemONLY FORTH ALSO VOCABULARY META META ALSO META DEFINITIONS VARIABLE DP-T : [FORTH] FORTH ; IMMEDIATE : [META] META ; IMMEDIATE : [ASSEMBLER] ASSEMBLER ; IMMEDIATE : SWITCH (S -- ) NOOP ( Context ) NOOP ( Current ) DOES> DUP @ CONTEXT @ SWAP CONTEXT ! OVER ! 2+ DUP @ CURRENT @ SWAP CURRENT ! SWAP ! ; SWITCH ( Redefine itself ) \ Memory Access Words 06Jan86gem0 CONSTANT TARGET-ORIGIN : THERE (S taddr -- addr ) TARGET-ORIGIN + ; : C@-T (S taddr -- char ) THERE C@ ; : @-T (S taddr -- n ) THERE @ ; : C!-T (S char taddr -- ) THERE C! ; : !-T (S n taddr -- ) THERE ! ; : HERE-T (S -- taddr ) DP-T @ ; : ALLOT-T (S n -- ) DP-T +! ; : C,-T (S char -- ) HERE-T C!-T 1 ALLOT-T ; : ,-T (S n -- ) HERE-T !-T 2 ALLOT-T ; : S,-T (S addr len -- ) 0 ?DO COUNT C,-T LOOP DROP ; : ALIGN (S -- ) HERE-T 1 AND IF BL C,-T THEN ; \ Define Symbol Table Vocabularies 06Jan86gemVOCABULARY TARGET VOCABULARY TRANSITION VOCABULARY FORWARD VOCABULARY USER ONLY DEFINITIONS FORTH ALSO META ALSO : META META ; : TARGET TARGET ; : TRANSITION TRANSITION ; : FORWARD FORWARD ; : USER USER ; : ASSEMBLER ASSEMBLER ; ONLY FORTH ALSO META ALSO DEFINITIONS \ Control Structures 06Jan86gem: ?>MARK (S -- addr f ) HERE-T TRUE 0 ,-T ; : ?>RESOLVE (S addr f -- ) ?CONDITION HERE-T SWAP !-T ; : ?MARK (S -- addr f ) HERE-T TRUE ; : M?>RESOLVE (S addr f -- ) ?CONDITION HERE-T OVER - [FORTH] SWAP 1- C!-T ; : M?MARK IS ?>MARK ' M?>RESOLVE IS ?>RESOLVE ' M? FORWARD-CODE ; \ Create Headers in Target Image 06Jan86gemVARIABLE WIDTH 31 WIDTH ! VARIABLE LAST-T VARIABLE CONTEXT-T VARIABLE CURRENT-T : HASH (S str-addr voc-addr -- thread ) SWAP 1+ C@ 3 AND 2* + ; : HEADER (S -- ) BL WORD C@ 1+ WIDTH @ MIN ?DUP IF ALIGN BLK @ 4096 + ,-T ( Lay down view field ) HERE CURRENT-T @ HASH DUP @-T ,-T HERE-T 2- SWAP !-T HERE-T HERE ROT S,-T ALIGN DUP LAST-T ! 128 SWAP THERE CSET 128 HERE-T 1- THERE CSET THEN ; \ Meta Compiler Create Target Image 06Jan86gem: TARGET-CREATE (S -- ) >IN @ HEADER >IN ! IN-TARGET CREATE IN-META HERE-T , TRUE , DOES> MAKE-CODE ; : RECREATE (S -- ) >IN @ TARGET-CREATE >IN ! ; : CODE (S -- ) TARGET-CREATE HERE-T 2+ ,-T ASSEMBLER !CSP [ ASSEMBLER ] WORD ; ASSEMBLER ALSO DEFINITIONS : END-CODE IN-META ?CSP ; META IN-META \ Force compilation of target & forward words 06Jan86gem: 'T (S -- cfa ) CONTEXT @ TARGET DEFINED ROT CONTEXT ! 0= ?MISSING ; : [TARGET] (S -- ) 'T , ; IMMEDIATE : 'F (S -- cfa ) CONTEXT @ FORWARD DEFINED ROT CONTEXT ! 0= ?MISSING ; : [FORWARD] (S -- ) 'F , ; IMMEDIATE \ Meta Compiler Branching & Defining Words 06Jan86gem: T: (S -- ) SWITCH TRANSITION DEFINITIONS CREATE SWITCH ] DOES> >R ; : T; (S -- ) SWITCH TRANSITION DEFINITIONS [COMPILE] ; SWITCH ; IMMEDIATE : DIGIT? (S CHAR -- F ) BASE @ DIGIT NIP ; : PUNCT? (S CHAR -- F ) ASCII . OVER = SWAP ASCII - OVER = SWAP ASCII / OVER = SWAP DROP OR OR ; : NUMERIC? (S ADDR LEN -- F ) DUP 1 = IF DROP C@ DIGIT? EXIT THEN 1 -ROT 0 ?DO DUP C@ DUP DIGIT? SWAP PUNCT? OR ROT AND SWAP 1+ LOOP DROP ; \ Meta Compiler Transition Words 06Jan86gemT: ( [COMPILE] ( T; T: (S [COMPILE] (S T; T: \ [COMPILE] \ T; : STRING,-T (S -- ) ASCII " PARSE DUP C,-T S,-T ALIGN ; FORWARD: <(.")> T: ." [FORWARD] <(.")> STRING,-T T; FORWARD: <(")> T: " [FORWARD] <(")> STRING,-T T; FORWARD: <(ABORT")> T: ABORT" [FORWARD] <(ABORT")> STRING,-T T; \ Meta Compiler Defining Words 06Jan86gemFORWARD: : CREATE RECREATE [FORWARD] HERE-T CONSTANT ; : VARIABLE (S -- ) CREATE 0 ,-T ; FORWARD: : DEFER (S -- ) TARGET-CREATE [FORWARD] 0 ,-T ; \ Meta Compiler Defining Words 06Jan86gemFORTH VARIABLE #USER-T META ALSO USER DEFINITIONS : ALLOT (S n -- ) #USER-T +! ; FORWARD: : VARIABLE (S -- ) SWITCH RECREATE [FORWARD] #USER-T @ DUP ,-T 2 ALLOT META DEFINITIONS CONSTANT SWITCH ; FORWARD: : DEFER (S -- ) SWITCH TARGET-CREATE [FORWARD] SWITCH #USER-T @ ,-T 2 ALLOT ; ONLY FORTH ALSO META ALSO DEFINITIONS \ Meta Compiler Transition Words 06Jan86gemFORTH VARIABLE VOC-LINK-T META FORWARD: : VOCABULARY (S -- ) RECREATE [FORWARD] HERE-T #THREADS 0 DO 0 ,-T LOOP HERE-T VOC-LINK-T @ ,-T VOC-LINK-T ! CONSTANT DOES> @ CONTEXT-T ! ; : IMMEDIATE (S -- ) WIDTH @ IF ( Headers present? ) 64 ( Precedence Bit ) LAST-T @ THERE CSET THEN ; \ Meta Compiler Transition Words 06Jan86gemFORWARD: <(;USES)> FORTH VARIABLE STATE-T META T: ;USES (S -- ) [FORWARD] <(;USES)> IN-META ASSEMBLER !CSP STATE-T OFF T; T: [COMPILE] 'T EXECUTE T; FORWARD: <(IS)> T: IS [FORWARD] <(IS)> T; : IS 'T >BODY @ >BODY !-T ; \ Display an unformatted Symbol Table 06Jan86gem: .SYMBOLS (S -- ) BASE @ HEX CR TARGET CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE 4 LARGEST DUP WHILE TUCK @ SWAP ! L>NAME DUP C@ 31 AND TUCK 5 + ?LINE DUP NAME> >BODY @ 0 4 D.R SPACE .ID 16 SWAP - SPACES KEY? IF BASE ! EXIT THEN REPEAT 2DROP BASE ! IN-META ; \ Meta Compiler Resolve Forward References 06Jan86gem: .UNRESOLVED (S -- ) FORWARD CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE ?CR DUP L>NAME NAME> >BODY RESOLVED? 0= IF DUP L>NAME .ID THEN @ SWAP ! REPEAT 2DROP IN-META ; : FIND-UNRESOLVED (S -- cfa f ) 'F DUP >BODY RESOLVED? ; : RESOLVE (S taddr cfa -- ) >BODY 2DUP TRUE OVER 2+ ! @ BEGIN DUP WHILE 2DUP @-T -ROT SWAP !-T REPEAT 2DROP ! ; : RESOLVES (S taddr -- ) FIND-UNRESOLVED IF >NAME .ID ." Already Resolved" DROP ELSE RESOLVE THEN ; \ Interpretive words for Meta 06Jan86gem: H: [COMPILE] : ; H: ' 'T >BODY @ ; H: , ,-T ; H: C, C,-T ; H: HERE HERE-T ; H: ALLOT ALLOT-T ; H: DEFINITIONS DEFINITIONS CONTEXT-T @ CURRENT-T ! ; \ The Rest is Silence 06Jan86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for Pre-Compile 06Jan86gemMeta Compiling is a term to describe the process of generating a Forth system by compiling itself. It is similar in idea to the ordinary notion of compiling in Forth, but has some important differences. First the code that is generated by the Meta Compiler is generally not immediately executable.This may be for a variety of reasons, such as that the object code generated physically resides at a different address from where it must be to execute correctly. Also, it is possible through Meta Compilation to generate a Forth System for a totally different CPU than the one the Meta Compiler is running on. In such a case, the object code of course is not executable on the Host System. This Screen is the load screen for the Meta Compiler itself. The purpose of this section of the Meta Compiler is to compile Code Words correctly. \ Target System Setup 06Jan86gem Make Room for HOST definitions Set up the address where Target Compiled Code begins Set up the address where the Target Headers begin Set up the HOST address where Target Image resides Load the Source Screens that define the System Save the System as a CP/M file, ready to be executed \ Vocabulary Helpers 06Jan86gem META The Meta Compiler Environment, many redefintions DP-T The dictionary Pointer while meta compiling [FORTH] For convenience, an immediate version [META] For convenience, an immediate version SWITCH Exchange the saved values of CONTEXT and CURRENT with themselves. This should be used in pairs, and is only really meaningful in the second occurance. Its purpose is to save and restore the CONTEXT and CURRENT vocabularies. Following the first occurance you should invoke a vocabulary and perhaps DEFINITIONS. \ Memory Access Words 06Jan86gemTARGET-ORIGIN The Offset where the Target Image resides THERE Map a Target address to a Host address C@-T Fetch a byte at the given Target address @-T Fetch a word at the given Target address C!-T Store a byte at the given Target address !-T Store a word at the given Target address HERE-T Target address of next available dictionary byte ALLOT-T Allocate more space in the Target dictionary C,-T Add a byte to the Target dictionary ,-T Add a word to the Target dictionary S,-T Add a string to the Target dictionary ALIGN Makes the dictionary even. \ Define Symbol Table Vocabularies 06Jan86gemTARGET The symbol table for Target definitions TRANSITION Holds special case compiling words, like ." and [ FORWARD Holds all forward references, not neccessary but nice USER Holds USER version of defining words We add all of the vocabulary names to the ONLY vocabulary so that they are always accessible. This is mainly a convienence during debugging, when something fails and we need to look at different words in various vocabularies to figure out what is going on. Now we are guaranteed that we can reference all of the vocabularies inside META without standing on our heads. \ 68000 Meta Assembler 06Jan86gem?>MARK Set up for a forward branch. ?>RESOLVE Resolve a forward branch. ? Run time forward reference for code compiled by ." ." Compile the unknown run time code, followed by the string. <(")> Run time forward reference for code compiled by " " Compile unknown run time code, followed by string. <(ABORT")> Run time forward ref. for code compiled by ABORT" ABORT" Compile the unknown run time code, followed by the string. \ Meta Compiler Transition Words 06Jan86gem Forward reference for run time of CREATE & VARIABLE CREATE Create a target word whose run time is the run time for VARIABLE. Also create a host word to rreturn Target Here addr VARIABLE Make a variable in the Target Image. Forward reference for run time of DEFER DEFER An execution vector in the Target System. \ Meta Compiler Transition Words 06Jan86gem#USER-T Counts the number of user variables defined so far. ALLOT Allocate space in the USER area. Forward reference for run time of USER vars. VARIABLE Create a User variable, which is task local. Forward reference for run time of USER vectors DEFER Create a task local execution vector. \ Meta Compiler Transition Words 06Jan86gemVOC-LINK-T Links defined Vocabularies together. Forward reference for run time of VOCABULARY VOCABULARY Create a target word that behaves like a vocabulary. Only one target vocabulary can contain definitions in this meta compiler, but several can be defined. IMMEDIATE If heads are compiled, flip the Target IMMEDIATE bit. \ Meta Compiler Transition Words 06Jan86gem<(;USES)> Forward reference for code compiled by ;USES STATE-T True if compiling inside : def. False if outside. ;USES This is a new syntax that can be used to compile a code field whose code already exists. Similar to ;CODE [COMPILE] Compile a TARGET word rather than execute its TRANSITION counterpart. <(IS)> Forward reference for run time of IS IS Compiles the unknown code field of <(IS)> IS The Meta Version of IS actually does the patch. \ Display an unformatted Symbol Table 06Jan86gem.SYMBOLS Print a primitive unformatted symbol table on the display. This is very useful if you ever need to debug with DDT, you have no idea where the addresses are. You can make it pretty if you like. \ Meta Compiler Resolve Forward References 06Jan86gem.UNRESOLVED Display all the words in the FORWARD vocabulary that have not already been resolved. You had better resolve them before saving a system, or else they will surely crash when you execute them. FIND-UNRESOLVED Search for a word in the FORWARD vocabulary and return status RESOLVE Run through the linked list of forward reference and resolve each of the with the given address. RESOLVES The user interface for resolving forward references. Used as follows: ' resolution-name RESOLVES forward-name \ Interpretive words for Meta 06Jan86gemH: Save a version of old : for later. Will be redefined. ' How ' should behave during Target Compilation. , How , should behave during Target Compilation. C, How C, should behave during Target Compilation. HERE How HERE should behave during Target Compilation. ALLOT How ALLOT should behave during Target Compilation. DEFINITIONS How DEFINITIONS should behave when interpreted. \ Meta Compiler Resolve Forward References 06Jan86gem.UNRESOLVED  >#SKIP$p02RA> GSAg fRH``>$fSCAN$02RA> GSAg gRH``?$/STRIN, Atari ST XBIOS routines (some) 03Jul86gem These are some of the xbios routines from the Hitchhiker's Guide to the BIOS. Feel free to add and experiment. \ xbios functions 30Jun86gem2variable save-ssp : supermode (S -- ) 0. 32 trap#1 save-ssp 2! 2drop drop ; : usermode (S -- ) save-ssp 2@ 32 trap#1 2drop drop 2drop ; : physbase (S -- d ) 2 trap#14 rot drop ; : logbase (S -- d ) 3 trap#14 rot drop ; : getres (S -- n ) 4 trap#14 rot 2drop ; : setscreen (S res phy log -- ) 5 trap#14 2drop 2drop 2drop 2drop ; : random (S -- d ) 17 trap#14 rot drop ; : settime (S d -- ) 22 trap#14 2drop drop 2drop ; : gettime (S -- d ) 23 trap#14 rot drop ; : setpalette (S daddr -- ) 6 trap#14 2drop drop 2drop ; : setcolor (S color color# -- ) 7 trap#14 2drop drop 2drop ; : setres (S res -- ) -1. -1. setscreen ; --> \ rsconf, midi, cursor functions 02Jul86gem: rsconf (S scr tsr rsr ucr flowctl speed -- ) 15 trap#14 2drop drop 2drop 2drop 2drop ; : setbaud (S n -- ) >r -1. -1. -1 r> rsconf ; : giaccess (S reg n -- n ) 28 trap#14 drop >r 2drop drop r> ; : offgibit (S bitno -- ) 29 trap#14 2drop 2drop ; : ongibit (S bitno -- ) 30 trap#14 2drop 2drop ; : dosound (S daddr -- ) 31 trap#14 2drop drop 2drop ; : cursor (S -- ) 27 emit ascii e emit ; : nocursor (S -- ) 27 emit ascii f emit ; : inverse (S -- ) 27 emit ascii p emit ; : normal (S -- ) 27 emit ascii q emit ; : wrap (S -- ) 27 emit ascii v emit ; : nowrap (S -- ) 27 emit ascii w emit ; : fcolor (S n -- ) 27 emit ascii b emit 15 and emit ; : bcolor (S n -- ) 27 emit ascii c emit 15 and emit ; --> \ rgb 30Jun86gem : rgb (S color color# -- ) \ takes decimal digits like on swap dup 100 / 256 * swap \ the control panel for color dup 100 mod 10 / 16 * swap 100 mod 10 mod + + swap setcolor ; .<I3> GN5 W3DEPT,R `XW4 .S,4 .4 $vUTILITY.BLK  o "!$#&%('*)+,-.0/123456798;:<=?>@ACBDEFGHJIKMLNOPQRSTUVWXYZ[]\^_a`bcdfeghikjlmnopqrtsuvwxy{z|~})<3X=mYrqw !&".*H2JQPTSZU\[c^hglj#8Q+asuIr*QKmu:_c:"ge%6qX Φm:syA:"G눜:H`ZRp$y#rıYXGcb[S{ΊU.^5gc#uDΊī')͇WosJNN:2u<6/5:"g;>68)-GN]2^9+:"G눜I9k:kO$y#rıYXGcfȾ0ώ%3_bqM4N:"G눜ZZ\];Nr2/^:uD8G|#o6Ȕ,H|8I__Թ?G&8+|<=PԒH_ifg?fj"$ت+q }#pV/SgTYf&)5XuR?gEy]a?qƪDGH#-'g?qƺz"}#pVQ?S'~;%:l7q'sw21&.]qoQ5un?V?uO&U[Μ^[8b)S8/G>/pLK%(iu}zrq~1=(8 GL( 5,%c ?tR8Z3B#kIߞUaiV?2}{^陆P?1|k4.kY8~RiEKhIe$+_|.OE^Ff#ӷu/GH$a~5ytOXp3r=,< B <]j/ʞ^0B$^S?u4޶_[ޣ9u/>'ql|u>OR8qV Qj`Uj8酢JF{49I/\+5v=BWysiNhyԟ'xwrJy ?i=BW/9+ }{V!#?!;t5&zgd2 1]BW[3kr<75W}~G?mU&?WMV~ILO(=bq GLPj #{?5X/I`mR8+y:DM諦oޣن |_x©8\5Yqpp?Y4jhtdE Zg urFsӟ&+JOXVF#u5y#p>NOp#b( 5li:G\/I`$Iak8bJUdK:%sUOhIg}JrLѡ(D5K>~<.BAZ)k40\㈉菉kk@_5PH^I"2U8/%3Od}J"|_8ڶH%|__|.7!П/sPק'N^#&cuVS~eB/(?]嬵>=!Q]A )#w͂{۔I::YSSR'/NgQjWM?'W~B 5/_ጪDsAJ2\&Pק'w2)q9O?#g.YYvŽxx!/u?]E_5\o$ ilW/8_~~#Y ?]Wpz R8k=o?#g.YYvŽxx!/utzI^_5I$pVovLKަpV+꣖ښ-~$_*G=i%oS蛸BuٷF|0i짭sfV y͂/yBt;kr|]pVƼcٹYИ7SX|<LcWXb[6#kWν1ww,;7 Sv5}7dV^X_9u[Ȧv7Uܻ7? &l~fWΩՔ*wqkHlC;& ;g>C0Y_6*v<}6,9xͮƮ&=7 i;7Ha~#q4m%?ٕI%¹Z\!f3[lK 7LY ;q5-yxxR7VDkޕ6R®4 7TokΊܾ;Yؕ3 jx/ \ۂ%7 b[1 )oή>b[؆k7U T˛9-8 f ,TYS¤~u"=әEƱ&Cω#gg8#g:3P+B #OHljiOWI/ω6tzHr63BJЧ \FsĻ}9k4pWV5̹{gIU'V#Li9Z&=~$=(8+W}~G?Vu?2IU)#LyMgY1=(8$تHy)[_MӓϷ3ӟu[rZП[<&]hOOeeF)WgWδmuJ0Xֻ֒&-e|kYXNgF^ T9O4gE~NwYS8uzV??SWzFQKsHdzeR8uǺB gS$X*=(ĥPowQ q~4ԕQ5Ί>=R8uoO)3BY!cU[C7?R89)pQ5Ίc?=¹^z<\˚:^l= 1=(8bo'|_:g6kuzsV?OI9hQQTKAQKYL8\>yBpo$=}W"<_H.Oo?O( ~WOԡ?gTY|q+I~U0Ek^(g~ gXI g5O$pL\ B#Gc=TQ\&ޣM gy|kfP~Gc3k9O?Xk[O)RoϳEVFc-l ?~ 5O$ lFj Io[E]pipP}9ѳ~OKӛ xx %9>5un?1=(8~ \>^>z}k9O?kg&xXyгzUpd#gG?&E[~3pǺw3u'` wc{{߿YqQ낭'R88iEaunfu'` wc{Ykk9O?-4 we{w?=NZgF#Zk지uEźw<}~ul?Hh5f%GLϴdH 5S7yIr2=9-(y~Gh Jzu#'2eZ3 gֳY-(I-(IB^_58ZfSE{럧$0[@ot )Q_I'eM[csPis~*H03B#Kӛa GL( 5hm?駢EFQ~YӫWM낭'87GL( 5سڧu~NWM?NO9O?.pV?(1=(8t;=zV LI[cO)3_ EIuI/?ϗ}fTS9O?z]5$¹jQ#gGω>+Yu"{/zVXy\>INzVH82?)3+G.a3İQjW2\t/|Sב9~!5un?~ Z =xPZc?(*XoO)Ih8bzFQqDޞg)5+qfi(8b2Z-5SYրf%=FUPק'?OWM?ޏ$ :G|OT}fTSyz$5`YI_Pj?O ӓ'+Z?u42㝵GsVuZyrgE5S7 INwOWNpGE5LpVE'lR8+Q~"=(8uj5֬aOD G㌚SWzFQqDik LIH}UUE{߿YV~֚`m?rzpFXr#[k[ST~*(1SE¹;{9bzFQq. ;zp+$~˛SwN*•}wH8ŗC!7P1_\Y? ;]?Ձ;J:7w`6)$[<&A GL ]5uj/X秲 ֫laY =}R89bzFQqD_VO1/pֶ5 <qĻHdʗ?u9Y_8Z[{?trl &/Pק'uI~~*֫laґ*W8$ IN"o?''1р>=I#]qownl%'Dz-Ǚ[U>*Qj>Vu0 +_|.VXGΊq i( 5Nb1\8c :G2#;6_flU!;*L*+]!鿧HN].0 FȎoXY5>==~\ oQƑT8bzFQqm[PE}i_Gl Gxfj F*89ֶ':|mfUlAOOd>˧7͜նlAOOQ.SOI gz޶,Ķ®_6d߯o#Li9V3B#~IUql~ia$gTm GU=$تӂpޏC \ub$IUNl GF>==Y#2 Z{~Y~?pϷ8!ZLGL( 5e&Vܤ*sV?>`E֫laґ*a} eޟ~N3 3+( 5˭3~ _flU!;~aHGc3B#~AOF5#W Eplk q,V Ec\Fգ_&V9b?Y$تCv4±'b}M5@ B# 2~ֶ&V2`IVaB 流~ \ k/֧TÞy>&N\ż2wŽ1K)RG-5c[J}dӟu@4Vm9s>`ϗ7OO#g=’ßg٩zwIJIj./©8+G_8bz&t.E!t55K |zSTI/$+9ԟ'pDu}zB gǹ2GLτEQ]kM?1y#/jk+S?#gBW(ܵm?ݟIʼ5HXϾ4O]ӟuIc?m֟3pP=~/3se^ 8~ )սU\+sWӒwnK%'/k_:3 gy#/gaO[I8=b#gEtOXq~e^  W2υtOX=C Uy6C E =j+S?As-ϕy#/T@a]\&ksĞ\5YlƑЕ 9B#& pY>D W2υ#1 H$aЕ ( 5uJ  _FudAA_/?B GN:3 &U[ΜLg |ˠzz՟:5LgyEQqD_NIu3PjgsAa|zS8Z'-|~/8bzFQq:#}]Yqw gEzFQqޏ#s∽GL|8w PZvz?G" V$y/[[yϽ4=9_G=Q9_L_Wk32}]弿l-;O]`(}9q~Zvr {F^e8[,#g'ֲӕ_p,Di׆/[;9]qopGQ??YEr-%yIG-5c[6ά*qsLjQjwZ[7Y&U"+[ޤp<ά*1=PjR̟ĵ෼˙[ޤpF3Qj1q--obrfoyC '̪ 9GL( 571t9S&q>g*GL( 5X6ekٙU%nN]97g嗭egV%;Y9rS̪ 9gE(CnIZvfUʁlH$pnBNl v;!0x\V*QKm#Xj#gkn,8rO¹}ɉXe~p uy J*υ2U2):㌮ן<#ghF_cF- 2_| )$3Z^~4GL_oGQRQ㼴=m8rL\rDjw u~8b"ӛfDNd|zg5UӏAx'2_>#&f:Gd7GR8+~rVgZ2-E%S㌕(|_ޣau4?#pdHϴdZ"BK+Ql Gj4?O $_Sc3_>ih} :G~rľ_8|&<6kth}]p6_>#&<6Z#tYq GLe) Pjd>H4 G|OѿŒsD'+Zҟ>&H}]pD<6GLh53qY B\r:8iu/q:)q>GL ]jj{?F"{/#/1y&.]qo:*m4$RÚ#>:.mҐ1KS6GVPÚ#WuR\͹ZN kjYi_ĹJs41]\M#+ kaqdis$RÚ#Sz08WisdI5G~>Yԥ͹ZdjXsnYiaZJs4ɩa)48Wis8B~\㱫x5e!7"?r;zbQ?פZ_'_gyOLo֟JgXiƑ}9q( 82ϳIBqde~goEiHE#-<{$5s( cSz>:' iG;uu$iB#=?)IBPz~q( IƑNtaqV&YGfEiqdgg?8IHH#-<{/JG[c?y4uqd_?sU '3*DY[4K^˚T}|8bz(8V(3OZz?(|_4Vmy=2U[*g9)|_/OV8SQqv}$u陞惢PԮ?#ӟ8+3=EƩ =UO+O8Z{fU$ 抌.XA GL8q3=EƩG3h/\y~'޶@"ӛfx_48oA+3=EƩG#|ќ2` S8k?2#gzB+2`-=y?2QpxޣY9{-1V1!v)ט,$˚:-L3=EQޣ&M/\y~'޶ߣgF{f$yjj<aL?EIG=O?I3~h(|_OmޣgF{f$yjuu}qLOAQq•~m T諦Wdt _ MMn; rHntfq^MY5U~=Gsi[$}a$>Z5-|~(Z/=nwym9b '7ȫ) 1ii>ՔO<]֤Z_gQU8¤jO3'S֜V6GLL#Zs&H9IH#Zs{?FӤ9W|扑hsd5hͩ #iN#ZsmhsFkq&U[*g948IƑYM*jYy)>?#ӟ8uKSG[4ӏiN#=O?E4ӏ4cSz\Y]j ̃]9wσih-1פ8L{S}L )I_>rS#g^>rwsb$GDC}]@ g5Gna\>rG~+&f6~kjMy√O8>=Iǹ8bz&tEI/>OVp ~.>=9_ݝY6̽Hb%kC %$^~1=3w%.sW2wQjѽD?˧7Aj#Dd0\뽗d%\>=}zd{VrYIJzVU\>ɉIDQo?P\&R`Ĺ陹+]ID9"5Nu/4sD}G;M3G/$-ylt(|_I8b_/1QY5Km&tŽa8gT$&5un?EY>Ey~~pu˧7%Z.#75̗OoAc'-~ǹ(]WGL( 5λk/4{4SvŚTԛŇpMpnEj?g4O9N'8Km&tŽa8gT$'eM[s)Qj򳟪CrĻ}9k4Vk3SrĹ;k4Gnbm\~©kOU‘Qje'=j {fUj?5H8rM1=(8e}SpĹ;R!y}a$جd$s+~4O9Hh5#7qP/̽]sww&q%BAHUӏĕ$q+~4O9Hh5h:gEzFQxPhϽݙQpVkBW[`|Gkd&9 swwf$W')^ 7] }]N$M]Q>+1cFp)m.]1Wq1%>-5O]G4Vm9s3/8bzK 1l'emA/?eV??W2\8:ب(l \~OOݝ|[rMOO}]h:Gnu}zrOUB @4Vm9s y6C EIu['#;GYTH^s|AuEՂl̼Εy#/@]՞{3#/`kSf@].?E#7>=SfU‘[Au>YG4Vm9s^z=S#gG^٪e@vupVk}殸7 dx{!kjʯEk_:#Li9dY9b;L߿@j$՟}+hΧ?~ڪ?g8bVXY |?US8 խLm{!ǯή% ֻ&-Q3Gʏ ~S?,Om q/SWyyǑs_o5 9˓/=j~mC_5s϶IzUӏ/h۽dI:_Pק'Gk˜i֝m5jOc$+a}MzgmobOӅ#~}])qIU2GL?;;( 5}a{>#9b1;8IUUӏIcs/8I~.ާHUӏ9bB炪ާڐkOOW}ԉ#gv wPj~WWM?IU2G|yyN7^񸝈LXڂKcYS|z/03B]G^3<קȾ|D4e)AWv wqV?O~a|!S1s-ㄿ1d]ׄʼBO ' ceW9p7fBvC*Η U\+*J)XrHmN}X2Ngp{?JI3Rہk-17H$pF=dr~690[˚:L;c_fWN{4v oP+/NLqߠV9rN{]kmBn\pV 9,ؕ5C M~s^ny7'I|Q sW Sr wlK, u~$M>_ԹV2?)7s^Kn4ĝM#.3M OO9VμcٹYИ+%oSKo_؆&tŽqV)5޾Y7S95Oxgnd)4ߜzʹŮm%w&g0q#Ƶxm %7 ҟHر-,4ù*7g%.{ 7v<ؕxgn=9bz恢P⩽+_k6RՔ<7ŷTZ`ߜ=uu$-EKޜ!Z|#NG‹Y!3MHʋ>o@1D˛3qvF ea]qoRmL7>~]9TM{{s֞f#ӷu;+~0ty+f¦xmx`;o=b|;uv7g愮7!6+/oN]=b#g-7b[x R<7۰pY푫swϮKꍯ_Ga!,;ly67tBl <8M{yɃӤ۽r[<V Ecʞ^T7yXr]9-`W#Nl M{<ؕC{3mr+'tNga Ix+oyy{oB®ƐY:Fys71UʚTur rty?7:I·US׮%v6 `WNglÿWooV=jx) bޑ/ƒ/6iSu©k{rtyP?櫗7noUu)@!D wʑ_9UGLwh( ÝJIz tŽrcWΒw;y+37Uy6C EIכߘ+-p#Y|{喛]9K.lmmcz_v卛]߼V&8j!o/|]9M{<_cKԥ1䰕`9wT:GQT:VJ8WY1]lHQur y_ĝf^ٕxعŝMh q<ؕӤ۽̃؆p'ߜN']rZi#bpz}is8tqk,96gc^ޜ$ϽSIU8>O%l*m/Knlif1򚃳Un7jxֹI]#] s dKˏŶyz1MK! ޸K~xPdX) ]r[ȋcʹ'쒛 ©A"9-4r`Wyr?`?r܂ؕs-ߤA0%vKm}Q̍ߜwo?|Z[n&0€)uU,^m}Q̍ߜm G^~lkRDi؁me^nI$p8^nޖ6?_x5e $˚:*gogWN1vtR)6CnFI߄7GTs∂]9T͐kE)faWNن3 H7sńiL!nvXWo&k:sV˜caWN{#ܜ]9T)o lS;_}F^&r["¤~jʢMl ]l;ŗ\۾pFN?VW{i嚇)%oSx5e oNs7MOCfW޴1*n[-#a3mؕxrzMaqw8'iS@l QgV›$Snm]x|W^ؕ޸,/T1pY`SN @1D U*r[r^+ߕD,/yfysVYlia欮|uvLKަX:SHmh-ylkRguifsX`ܜ[<9uW *96Q yIU4*m/A-7gUVrmwKn-7 ޜ/}fؕIxtR 7!lڛ}9P+JrstTOR+J M{ysdʩKΰ+-,CnN!نN*fYֳQL&.K0v<ؕ8u}fjf5qYy+Jw6Iu~Njf5qYy+-,T͐9ݏF~)`tU,^*N*LJr7GTS AW%pUn T)F{{s;=tyUn{ ~uo 9aDz-BWޖ7Gf%pXԹ.{r'+'tŽ]mb[rͤ%v RmXx[0.Y0~coΊ8 5pә-%ak7g(*y]M$쒛m,C&?SzV/*m/?.owlK, WCkp-ߤۛzk9O?Ukmz-L:8rKF`W ]y.tmo;UYofzxsVNw6bk0.n'c@ޘƮ!7Q̍]9T)Hሱ- ҒWޜڨIj{}|{@6ҦMn -YIj{}ښ# i0={cWN'` -$=Bn 9bn۰+'es/=^XW< ֜Q1ƒJNeM[åy]͵ -8ߔؕ0Ri恏Y!|~/k#Umb[PsfW9ЙyÀ%u"i;7H%1v儮7=7 rC&/Di[ܹpn- 9ruu|BnHÐF ҭ3 tŽK޹Y8,_˚:[U>*K!^vl/`L!nv)ցN*74 nvl/`Lav<rs6j-^^Krv 99pwE\&ҋlq~joNMnR[mb[&wa r:p -,qS:SW~pm$bqlx3bՉ/]B!N]:lwELwGk#F:r|B!*J]kLޘ+F56'#f!Ownv)˚:䝛EOw`W/y_v9Zmv儮7^cfȾhkrBWÝ75^c x)b[(~3_=mnqʒo(x^r|۔7<@l ŕq_]9G%m--Q\Yr`WN{{sjL|ޏmhR$ aDz%,oN4($ͯ*{zؕT:'tŽ0Zb[vYmʛ7Ր&Vن%ٕx8ᥘ:_8kg0qȿX~9;ig6)5fx)7G},X~ې~>y/Ŕ6qv)گyWLor۹Ym)lc{aWy<-Yx5e]_0pƮGn Eqf!v9*.敹+YMٜO˚:驂y9+c!tŽBenN'` %*gE7x,l`I(Fgh8YٕIx 6]BnvesyeBW0pDޜԟV¤|nv娫l%ɉl/RW/IҤHO$ͧѢX]9!ޜؕߜN'Y59o^ |<}.9u[T'rV9xM$%[I{/<0W_&7'i;# 9xMd1Y%otޜ/m -ovtU,^&C9Iw5g?k&"/,oΗ'GLe)(GƑ۟䱹x5eWKܑcٹY]9]~d_8R<7hr ]9qY@,9x6F"w<8Zz{a5r>_ )$YrI{/[]͒D^cYͩkΒi˛#vWCn^J%,浽Ʋ&ESٕ%ٕӤ۽7gxtۂ&~39_j5#pPr]9 ÂyY_[نOMn۰+g;7eg0v,9x欎 GLe) PjmA͔krcWNℿw}yZ9tqxׁ8WUZ{i+J񶹏a{Yk#g,euq۟p=7r߻ȾxĶ[WmBs̐EQqgWN{ܜ&`r:o$p8 Ψ|ΦŁ.gGnYx5e=1ըkR9#o#K?Pj)7ecyPb8^)8IrRL!Dm䀑6A}aٕ%|{}Xޜ/\ ]3MCWsmR<"5HCWB -Ł,Cxsj9_sG# SHL5T}<=ګqZ>rs)׼ܤwf̫/_ 9u_ y`; l~Ra +K#s KW" Ӝah+'S S8HNRi~ ŵٕ7v4vymAbjr[<5+I&o4_ޠV9rNr%8AlRY]x*1^MY8kR?=OS#jLyeËن;sY«)K^󚛅X)i5Y3s~N]`_qjB!^+ścD^MYm^ٕM5oxϾ83EXSԄC&j®3mې3%|oVo[JbMSrȫ) δs FnCn}ټ[W'U`_qj-v儿w9t18AOG|s՟JbMSr:y5e5m f!7oYx*1^MY8j5>Z8bzƾ(k48+yہo/b[(HN~a`1;ӅY/( ŚvR3m&9۰xgn<8fՔ͑[c?y#+=c_P55NM?k:oWSb[X )7'# 1cWjBnDw6Dz&-Q޷jO3Z3q0v儿w9t1x`Wqs9u[3|aɏo{Q SbFcʮx5e #|_8uŶ>"oM~+'4 m!rjBn*,HmvtӖ,xjUx?8ywo4_m?i ;vw`?8uە'wWi+obxjVLRi9 V# 1cWjBnDw6T~IOLo֟JgN*Km߼mؖr߻ڋwCnUxΔo؆85+_k6R`e}Tz<C0];ulv jtYj}Y,-7_fWι>ߔM#.f6]W^|y >9+v弚CbS|s87ȫ) 1ii>LL5T}HaO[晓Jr-/%?^m!Ք%ٕsZ3𚇁*e7hLcW 1m^n5rU?r«) RE]9YGa!m.oVj%vB7<S3ԗ7G} ~ڪ?^3ϜD)Fڹy`WqSŶ ή;s!lǮboP+fF mb[0:#Ltv3 Ӝ#+VX3<0Φ7vtC hfs*K_6NWywmy.L` /U5*[*Q'})˛:j ̃]9wσihM>tYj}NTqLQjx 6bϻrMg}XR<b[X3<7j17?r;F77l6ysVے=Z` lv弚v%os&Qjʑr^7;s ¾;4N'I$pV?Ux?x ٷ笝,5un?]ft'(kܶ!9U"[fs`?mU Kn ې* ҭAGMLY9Wj?8䶉rgZ9M{<r h7gT/.GZ9T?Z&N,οs9|&UoF7i?Z v߼mvYhqtBl Ńov 9M{!]9[I{/o4^L䶉,r߻Ⱦpz5eys TZ4~Ӭk o~.6t$sG0,_˚:ݑ^Oa*.敇)1b[Զv w›S 1mL;;}~SWmŽev& ;+;;^Sr\"lhM|m;ͮ7fŽΛ#6rߘ QaF Eӏ?MUCc䭍Nj' 7/qS{',i_=+'.K0; /ؕvya' b[xw)8I$qnq;5;N%?M[qxƛk[9K]0.n'Ý7zͮy)`7mT}ysdMn; 7sgwaޜ}ngbor^ޜZ}P<.lN3 1!7*6Kv6-7̓e!dK Ćafapmؕәʼns maޑ/o_}!߅q<`yŽݝ7'If/;Mn˛}zNCȖ OŽ۰+af3ksmx omIߜDdbwRp^,_˚:^Oa3vxN+;;?4lBRcs:y ;i;G֮󚛅,hO?xEr+";;x7fk!ؕIx 1 LOAD The meta-compiler will load itself and then load the kernel blocks with whatever changes you have made. When it's finished, it writes the new KERNEL.TOS to the disk. EXTENDING a new kernel is also easy. Make sure that you have EXTEND.BLK, TRAPS.BLK, CPU68000.BLK, and UTILITY.BLK on the same disk and from inside KERNEL.TOS type: EXTEND 1 LOAD After extending, a new version of Forth with the standard features and utilities will be saved to your disk as F83.TOS. ---- Potential Bugs This forth does have bugs in it. I will continue to try fixing the ones I know about or any new ones that are found. One reason for uploading these files was to allow others to help in the effort. Here is the list: MULTI No clue for this. DEBUG I have played with this code and tried to make all the addresses long but it still has problems. CREATE-FILE This works properly for creating files of 1 or 2 blocks. It drops 1 block for any file over that. MORE Most likely the reason for the problems in CREATE-FILE. Also, this could erase blocks starting with the block that was last accessed from the currently open file. Rather than use MORE to add blocks to a file, it would be safer to create a new file and convey the blocks to it. At least until this bug gets fixed. ---- Invitation There is something of a tradition among Forth users to offer help in fine-tuning public domain implementations. If you have any ideas, suggestions, and especially "fixes", I hope you will continue this tradition by uploading them to this SIG. Also, a 32-bit version of F83 for the Atari ST would be an outstanding contribution. But in lieu of that, we would like to see graphics and sound vocabularies as well as anything else specific to the ST. Finally, I have refrained from uploading the shadow screens for KERNEL.BLK because of the large size, but will do so as a separate file should anyone request. George Morison 70745,1411 CompuServe at can be used to compile a code field whose code already exists. Similar to ;CODE [COMPILE] Compile a TARGET word rather than execute its TRANSITION counterpart. <(IS)> Forward reference for run time of IS IS Compiles the unknown code field of <(IS)> IS The Meta Version of IS actually does the patch. WAACE ST Disk Library Disk #53 Forth Language There are twelve other files on this disk. The first two to take a look at are: FORTH.DES - a copy of the file descriptions from Compuserve 4THF83.DOC- the documentation supplied by the programmer There is only one squeezed file on the disk, UTILITY.BLK, and UNSQUEEZ.TTP is supplied to unsqeeze it. Please note that this file is about 142k when unsqueezed. ---- Meta-compiling the F83 kernel There is a small problem in meta-compiling the kernel using the F83.TOS that was uploaded. Everything stops after loading META.BLK #21. Meta-compiling is possible, however, by typing: 500 ALLOT OPEN META.BLK \ <-- must be on disk with KERNEL.BLK 1 LOAD The number of bytes you allot seems to be important. I found that 95 is the least number of bytes I can allot and still have it work using the Forth that was uploaded. Sorry for the inconvenience. George Morison 70745,1411  Run through the linked list of forward reference and resolve each of the with the given address. RESOLVES The user interface for resolving forward references. Used as follows: ' resolution-name RESOLVES forward-name `uC <u|"AS@g`NN4VN4J>(G> GNFORT1u6uut= *LN EXITB>*GN 8UNNESTB= *_? N NUP^4t?N 0yp?N (LIT?N  BRANCH>*GN  ?BRANCJ_gJ]N  (LOOP)RVhJJ^J]N  ҇(+LOOP0VhJJ^J]N  (DO)02=|=A=N  (?DO<02@f>*GN  BOUNDS, XP>NEXr hEXECUT>(G> GN2PERFOR>(G>(G> GNN>ypNGONufNOOPN PAUSN t0n?N ȁ0.n?N ڇ(LEAVE&J>*GN (?LEAVE)BJ_fN 4T> GH>N 쁡n> G0@HN C@> GB@>N C!> G0N CMOV0R@> G>"GS@g`N CMOVE>0>@ G>@"GR@S@g!`N ܃SP?N SP">.GN RP6?N .RPH>,GN NDROP^0N TDUp?N SWAP H@.N zOVER?/N hTUCK H@.?N @NI>N ƒRO240>??N h-ROT402>??N ԄFLIP 0X?N ?DUP,n 8nX R> D?N  <>R V=N  NR@ h?N PICK |B0@?7N  `ROLL, T f zn B N\XAN 0WN  &OR 0WN  rXO 0WN  NO FWN  ڄTRUEr FALSr BANKr ƄCSET 4> G0N  *CRESET P> G0F@N  DCTOGGL n> G0N  bON > G0N  ~OF > GBPN  0WN  NEGATE DWN  0WN  ԃAB JWjDWN  +! > GH_2IN  r 恱r r r 42* PN  H2/ bN  *U2 tN  8* 0@?N  l1+ RWN  Z2+ TWN  1- SWN  2- UWN  UM 0/N  ܃U*, X UM/MOD 0"HA.N >N BWN  ~0< 8JWk` 00= HJWg` @0> XJWn` P0< hJWf` ` v0Wn` 0Wg` ʁ 0Wm` U< 0Wbl`r U> 02@bT`Z p<>, X >?NEGAT, 6 X MI,  \X MA, t "\X BETWEE, T  B X WITHIN, 2X (2@,n RRX \2!,l lX r2DRO N  2DUP /N  2SWA "./N  2OVE //N  H3DUP,n X Є4DUP, X Ȅ2ROT,  X D+& їN  DNEGAT>DN  ރS>P0_/N  2DABSfJWjDN !\D2| /N !tD2 /N !D-,<$X!H?DNEGATE, 6<X"D0, FX"ʂD=,X"ڃDU,     X"D<, 8 z 6>\ tX"D>, "X"BDMIN, Hf X"RDMAX, " X#*D, T  BX# M/MO, .n T T Td f  B  B 6  f  B\X#MU/MOD, T $ f B T BX$, \X$/MOD, TN BX$",*X$MO,*\X$*/MO, T BX$V*/,^X%lTOz%FENTRz%|LINKz%8SPz%lRPz%DPz %#OUTz %ȅ#LINz%ֆOFFSETz%BASEz%HLz%FILEz%IN-FILz%PRINTINGz&EMIT&SC^&,PRIO^"&LSTAT^&fWARNIN^&XDP^&R#^&LAST^u&tCS^&CURREN^"&#VOCr&ƇCONTEX^""6|'Ԅ'TIB^'WIDT^'VOC-LINK^eV'BL^'">I^'SPAN^ ':#TIB^ '>END?^(.BLr (dBSr(pBELLr(HCAPS^(|FILL02> GSAQN (VERAS, $X(BLAN,jX(COUN> GB@??N (LENGTH> G0??N (MOVE, 6:X)UPF< am zn ?N )>UPPE,Z:nDrX)HERE,RX)PA,P X)b-TRAILIN,n $: j @ X*ބCOMP0R@> G>"GS@g gj?<`? G>"GS@g*NNgj?<`?SIZr*1FIRSr1INIT-Rr1&>BUFFERS,. X1D>END,. X1\BUFFER, P X1n>UPDAT, .x X2READ-BLOCK2WRITE-BLOCb2.FIL,nn fF  X2ƅFILE,RX2SWITCH,R&Rl&lX2 DO19f9B;>;j*2!FILES,nl&lX2DISK-ABORT,J* in ,X2?DISK-ERRO,nl* Disk error Z\X3LDM^UTILITY.BLK!`+6 UTILITY.BLK3FCB1^EXTEND.BLK 3nCLR-FC,X3CLR-DM,X3$SET-DM, \ X3HANDLE, X3؇RECORD," X32MAXREC,& X3IN-RANGE,nRtR nl .x * Out of Range ZX48SET-IO,n btln b\\X4jFILE-REA,n b^R $B \ b $ $^R? X4FILE-WRITE,n b^R $B \ b $ $^R@ X4TFILE-I,3b3X5CAPACITY,RR X5LATEST, R .x b$ .x R  B\X54ABSENT,  8b\ x b\ $^ B .xnP TPn  B  .x R P x X6(UPDATE, X6DISCAR, .lX6MISSIN,d R 6d d d RP l .P lPn  X6(BUFFER),2P .x RX6BUFFER,R8X6,(BLOCK,8R V .xn X6TBLOC,RtX6ЈIN-BLOCK,&RtX7EMPTY-BUFFER,. P . .x $n  l   X7ΌSAVE-BUFFERS, .x $lnR hn R 6bnn  :\X7FLUS,, $\X7rVIEW,R( X8FILE-SIZ, $B $ $N  b nlX8TDOS-ERR?, 6X8؉OPEN-FIL, 8&R $=\ T Bn @l&R* Open error Z&R^l&R\X9†EXTEND,* EXTEND.BLK n&ll X9j(LOAD),R T(R T4R T4 (l&Rl3T B4l B(l B<X9 LOAD BgN : ΅DIGI 02<0k< k<k_j>?, R X<"|SIGN, 6"-"VX<",R  t" 0 "VX<"#S," F"X<"jHE,lX<"DECIMA, lX<"څOCTA,lX<">BINARY, 8lX=#(U.), $"p""X= TU.,#RJhX=#`U., T#R B |JX=#J(.,n $"p"""X=#4,#JhX=#.R, T# B |JX=#(UD.,"p""X=#rUD,#JhX=#UD.R, T# B |JX=#҄(D.),d"p"""X=$D.,$JhX=$0D., T$ B |JX??N >#SKIP$p02RA> GSAg fRH``>$fSCAN$02RA> GSAg gRH``?$/STRIN,   X?$BPLAC, "\X?$Ј(SOURCE),(R .% %zPRX?$SOURCE$?$PARSE-WORD, T%4R$ f$n B$ T  Bn f 4lX?%$PARS, T%4R$ B$ T n B f 4 X@%'WOR,X@%WORD,%2%$%n jX@#>TYP,JX@%.(,)%n%X@%f,)%n X@%\S,^ XA& TRAVERSE&*0> Gf`?N A&DONE,nR ^R ^ XA%FORTH-83, 1 * (almost) XB&dN>LINK, XB&FL>NAME, XB&BODY, XB&NAME, .&( XB&LINK,&&XB&>BOD, XB&>NAM, &(XB&>LIN,&&XB' >VIE,' XB'VIEW, &XB&҄HASH'J2> GJ|@@?N C'@(FIND)'r,BB>gB"G< FJY<?f&g<f>|@g?<`?`BgN D%#THREADSrD'.FIND,n(:`  $(6\ N Rn(2n`R`l ($\ (2'HR'pn@'(F\^  .XD'Ɗ?UPPERCASE,R(hnjXD'fDEFINE,j%(X'XE(J?STACK,R ,hStack Underflow ,hStack Overflow XE(STATUSE#INTERPRE,((v(~)"H!" )\ &N(XF(؅ALLO, XF(l,l 8)XF(ȂC,, .)XF) ALIG, . )\j)6XF)DEVEN,n . XF)0COMPIL, Bn TR)"XF)`IMMEDIAT,@R 2XF)LITERA,))"XF)DLITERAL,))XF)ASCI,j% nR))XF)vCONTRO,j%  nR* )XG)CRAS, ,h Uninitialized execution vector. XG*$?MISSING,*x%J ,h ? XG*X,(v F*dXG*|[',*)XG*[COMPILE,*)"XG)ă(", B )h TXG*(."), B )h TJXG*ʂ,","%n%$ ))LXG'.",)**XG+,)**XH+FENC^uH*TRIM,' $+f R +ZR+Jl +F XH+4(FORGET),n+.R ,h Below fencenR +R+nln+ ' N +<R+\lXH+&FORGET,j%(XnR'HR'p F*d'$+xXI*WHERe$I+?ERROR, I+l(?ERROR),,V T TR 8 (R,F4R(R+ B BhJh3~,X XI,(ABORT"), f, B )h TXI)ABORT",),h*XI,ABOR, ,h XJ,?CONDITION, ,hConditionals Wrong XJ+̅>MAR, $)"XJ,ֈ>RESOLVE,lXJ,\MARK, ,XJ-&?>RESOLV,,,XJ-:?VOCABULARY,/\' $1 $)"1R)"l0BNZlXO1XDEFINITION,RlXP1p2CONSTAN,/\)")"0BNZ bXP1ʉ2VARIABL, $ $10BNZXP0AVOC^"P1&CODE,/\/n lR2l0XPEND-CODE,2Rl/XQ2#USE^Q2 USER122~220QALLO,2b XQCREATE,/\2bR)"/zQVARIABLE,2 82XQDEFE,2/R1>I,nRnz n \ 3 &RnR 3 &XR1(IS), fR2l B TXR2hIS,nR3D)33J*2lXS2ԃRU,nR3p0nR 3l(3r(XS3,QUIT,Rl( 0RF(3TnR 3* ok3XS3NBOOTu>S2ZWARM, ,h Warm Start XS3COLD,33~XT3vINITIArT3ނOK,3 XT4STAR,XT3BY, $  ##f*Pages $XI3> GNMO.<I3> GNNG4vu% v W3DEPT,R `XW4 .S,4 .4 $44 z#xh@44*Empty XW4.I,n n $:5<n F 52_ 58 n5 hXW4DUMP, $5n#h $5xn B# 5j5T\XX4RECURS,R&)"X 4C/r@ 5DL/SCr 5,4R 5L4 X 5(S,%X 5,R#X 5އ?ENOUG,4 ,hNot enough ParametersX 5ЄTHRU, 85 :68 60X 5+THR,(R (R 6"X 3--,4 .( X 5ROOT17&67X|2z ALSO,n  NX ONLY,6z& N  l6zX 6SEAL,*& NlX PREVIOUS,n  N N X FORT, X 6DEFINITION,1X 6ʅORDE,* Context:  $7tnR .7n&&4 7^\* Current: R&&4X 7VOCS,Rn' N &&4Rn F7\X FCB2^F83.TOS CLOS,^R> \,h Close errorX 7SEARCH, $N\ T BX 8$SEARCH,\O X DELETE, $A\ T \ BX MAKE-FIL,n $<\n8,hCan't MAKE File T B^lX 8FSELECT, X 7READ,^R? X 8΅WRIT,^R@ X 8b(!FCB),n"X 8!FCB,j%R9^ j92X 9(HEADER9 868K-HEADER,> > n`l l l  lX 9SAVE,7n9J8l\ $789p $ $7977X 6\MORE, .5nR Z::6:(,R7X 6SETSCREE," X0<$RANDOM,"\X0>*SETTIM," \ X0>dGETTIM,"\X0>SETPALETTE," \ X0>SETCOLOR," \ X0>SETRES,>6X0>JRSCONF," \ X0>؇SETBAU, T B?X0?GIACCESS,"\ T \ BX0?DOFFGIBIT," X0?fONGIBI," X0=DOSOUN," \ X0?CURSOR,FeFX0>NOCURSOR,FfFX0=INVERS,FpFX0?ԆNORMAL,FqFX0?WRAP,FvFX0@NOWRAP,FwFX0@DFCOLOR,FbF FX0@`BCOLOR,FcF FX0@RG,nd<ndL <dL L >X@2>A?>MAR, X@@A?>RESOLVE,,  X@AA?MARK@@Ap?>RESOLVA@A? B X@DINDEX?,n Tn CrD D4 ElnDfD~Ed BvD BX@E"MORE,nD~ X@E,MOR,EzEE,E AE\X@ ErEXTR^ @ EEXTRA?,EzE T fE,E E E x 8El .E BE $ElX@ E,EXTRA,E .F8E  . F,RAjF0 bAEX@ EIM,120BNZR TED B B\AjBAF X@ DORFH@ FSF<@ F؇EORI>SF <@ FORI>SRF<@ FIQ,120BNZR TEDDr B B\AjF X@ GADDQGP@ FSUBQGQ@ G~I4\X@ HIBRA,` 120BNZRAz\ n  tID AjIAX@ IBRI^`@ IBSI^a@ IBHI^b@ IBLI^c@ IBCI^d@ IBCI^e@ ĨBNI^f@ I؃BEI^g@ IBVI^h@ IBVI^i@ IBPI^j@ JBMI^k@ JBGI^l@ J BLI^m@ J,BGI^n@ J8BLI^o@ IDIDBR,P 120BNZRDr AjAz\ AjX@ H^DXITJjP@ JDBRAJjQ@ JDBHIJjR@ JDBLSJjS@ JDBCCJjT@ JDBCSJjU@ J̄DBNEJjV@ JڄDBEQJjW@ JDBVCJjX@ JDBVSJjY@ KDBPLJjZ@ KDBMIJj[@ K DBGEJj\@ K.DBLTJj]@ KUSP,DrN` AjX@ LMOVE,EDH BAjAjF X@ LȆMOVEM<,EDL BAjAjF X@ LMOVE,DM.DfDr  MCCRP$D@PNMOVESP$F@PBNBCDP$H@OPEP$H@@PTAP$J@PpIEAS,120BNZRDB\AjEX@PJSP$N@PȃJMP$N@PMOVE>CCRP$D@OԃCLPB@PԃNOPF@PNEPD@Q NEGXP@@PTSPJ@PICON,120BNZRAjX@QRESEQ>Np@QLNOQ>Nq@QZRTQ>Ns@QfRTQ>Nu@Q$THEN,AX@Q0IF,AjAzX@QELSE,`Q QX@QrBEGI,AX@QUNTI,AjAX@QƅAGAI,`QX@PWHIL,QX@QREPEAT, QQX@Q~DO,Az\X@RLOOP,JX@R$0=rf@R40<rg@R@0<rj@RL0>rk@RXrl@Q>=rm@Rd<=rn@Rnro@RNEXT,n $DPX@Q؄INIT,BX@?DOES-OrN@RDOES-SIZr@RƅDOES,nR RR X@R؅LABE,/\0RX@@*CODE,2"RX@@BU1sS:sVs6@(G> GN@SbFNEXT1rSp@?UNBUS#Sl N @S.DEBNEX^0 yS6e9S^(GNSpNSl@SxJBUG^NS@SPNEXT#T N @R(PAUSET8? ?>9p G0T> GN@SRESTAR^> _YH3p>.G>,G>*GN @T,LOCA,nR X@T|@LIN,RX@S!LIN,lX@SSLEE,NTlX@TWAKE,NGTlX@TЄSTOP,nRTX@TSINGLE,&lX@TMULT, $lTZlT6RlX@TLCUN _B@?N @UFLCUf _0N @U^L@U| _H?N @UtL!U _0@HN @UIO-PAGr@UPC,UULX@UPC,UUdXPTPFUDG^dPUMS, $:VUR $:VVUXPUU<, XPV U>, XPUʂ<=, XPUڂ>=, t XPV,0>, 6 XPVL0<, V XPV\HIDDEN1rLlXppS*PVlLMARGI^PV#AFTER,5] XP^R#REMAINING,] XP^h#END,^v] XP]JMODIFIED,]D XP^EOr^P^?TEX, T^%nn^ f5  f$^ BXP^C/PArTP^'INSER,^ XP^'FIN,_^ XP_'VIDEO,_^ XP].FRAME,*'J*'XP_8.BUF,*I __B*F __BXP_"?MISSING, F_\__B* not found 3~XP_zKEEP,^F5_$XP_,_^__^_^XP_,,XP_'C#A,^2^\^XP]؃(I,_^_XP`(TILL),_^_[_XP_'F,_ XP^ID-LENr P`@ID^ P`.STAM,`V^5 `J `J XP`f?STAMP,]DR``n]D XP`P,`\X]XP`,`\]XP`,_^\^F5^XP`,5]^F5^\X`XP`Ɓ,_^F^5\ ^XP`SPLI,5 ^2^v\X^XP_TJOIN,^F5 5_\XXPaWIPE,^^XP`ށ, ,hUse G !XPaF,5 5_$5 ]`5]XPa,BRIN, anava\XPaFIND,_^^2^v[XPa,a_`4]XPar, .5aa`4]@\ RRb:Y,]_^2^v[b(`4]\ $b*\,hBreak! b_XPa\,_n ]_\ XP`,abDXPaҁ,bD`XPbZTILL,_``4\ XPbh,_`\ XPaKT,^2``4_$XPbvDXrPbDYrPb.LIN,] 8#h^F]%^F^2^\%XPbʉREDISPLA, $b \n 8#hn5^ 5Jh#R\XPbCHANGED?,5n^ _, 5XPb.ALL,R Fcb $\VR\`5 $cc:cbc^_, $\b $\\ $\ XPb@EDIT-A,]5*b b \XPcTNE,5d]c4 BRd `db$]c]XPc.GET-ID,`V`J Fdf*Enter your ID: `J $d\.FdR`J`V`J XP\ЄDONE,]4Rd6]4 R5R 6 d*Un *modified `_ ] blXP\ED,d&]T\_,\c\XPdEDIT, .5Rl]dXP\FI,4R*Y .e N<  d4laXPdj(WHERE,R Fe>d ]%_$XP[SHADOW1e~fTr]PDISPLACEMENT,R $ 8 XPeZ(>SHADOW,ej te e XP>SHADO,ReXPe>IN-SHADOW,&ReXPdԁ,RReRlXPCOPY,z YeeYzXPeCONVEY, [ ee $e $e Zx [ XPf, ave5 ]eav`neXPeBRIN, fpnf6ff\XPb(AT), XPfv(BLOT),5 |XPf(DARK), $ffXPc.DUM,bXPfDUMB,(&] xf3]f~3\f3\3\f3\XPdSMAR,&&] xc\3]XPgST-A,FYF F FXPgn<n  < XPf"MONTHS",*$JanFebMayAprMarJunJulAugSepOctNovDec XPh""00", $"p"""XPgSET-ID,ghd`V Bh.\ `V BP hd`V *gem`V XPd.2, $"p"""JhXPeD.,Z:hhhXPe҅EMIT, nj~ 2 i$\.FXPhDL,n#x 8| hh hhZ:ijii`XPeB?., i*\/ \i 8#hXPin?., i*V\i .#XPhȅ.HEA,n  | $iitihjitih $jij XPi*DUMP,R"iZjHi0@j8lXPjDU,n@j&@ XPjPDL,5RR 5j&XP iOU,*Subscript out of range on n&&4* Max is 5* tried #3~XP hMA, R j  N jjXP jCASE,12/00BNZjXP!jڌASSOCIATIVE:,120BNZnRnR $kf R kb \ $ $$kJ XP"jj(SEEoP".WOR,nR&4 XP"kz.INLIN,knR# XP"k.BRANC,knR # XP"k.QUOTE,kkXP"kʇ.STRIN,k Jh )hXP#kވ.(;CODE),kRl *DOES> l$\ XP#k.UNNES,*; \ $XP#l(.FINIS,k\ $XP$EXECUTION-CLASk4)*,h0BX*:/P%lB.EXECUTION-CLASSkkkkkkkkkkll2kklLkXP&l.PFA,&VnRljln F l\XP&lƊ.IMMEDIATE,&@ m* IMMEDIATEXP'l.CONSTAN,n&5* CONSTANT &4XP'm.VARIABL,n&#* VARIABLE n&4*Value = &5XP'mD.:,*: n&4 8|lXP'm~.DOES>,*DOES> &lXP'm.USER-VARIABLE,n&5*USER VARIABLE n&4*Value = 25XP(m.DEFER,* DEFERRED n&4*IS 2RktXP(n.USER-DEFE,*USER DEFERRED n&4*IS 2RktXP(n..OTHER,n&4nR& n\*is Code@nRRnm\@ * is Unknown XP)DEFINITION-CLASSk4,r^zP)nf.DEFINITION-CLASkmm(mPmn n DC ssPR sPlF t\3Ts\RtQ ,hUnbug\TXP3sDEBU,* nsslXP3oRESUME,s\ $TXP5t*TASK,/\2bRTnRnlTn nld lnlTT2bR TlT)XP5rSET-TASK,nTR l TRlTlXP5oJACTIVATE, BtTXP6tBBACKGROUND,tbT t/r0X tZHELL,*68000 Forth 83 Model, Atari ST *Version 2.1.0 Modified 04Jul86 h~@246 61X tMARK,/\0BNZ+x 1X uEMPTuF83.TOS TEM $\ $\c $\\ $\ X`gINSERTIN^`h,TA30146System has been loaded, Size = CURSOR-1,^ vJ]dX`v0CURSOR+1,^ ] tvn .]dX`vPCURSOR, 6vv<vv\X`vEDGE+?,^  6v Fv] X`u>NONBLAN,^nj v\@nv~nvv\dX`v>BLANK,^nj w\@nv~nvv\dX`vtWORD,^nj w4nvnvVw@@v^nj wV .]dX`v(MFL!),d`0J^dX`vMFL!, Bwf& T TX`v.INSERTING,- $\vRw* INSERTINGw* $\P|dX`w\(MFY!),uwX`wvMFY!, Bw& T T^X`wWORD-LEF,w"dX`xWORD-RIGHT, .w"dX`x*CHAR-LEF,v<X`xDCHAR-RIGHT,v\X`wL1r`xXCHAR-U,5^ Fx\ $ ]dX`xzCHAR-DOW,5^xt x\ $]dX`wNEXT-LIN,^ xt ]dX`xnTAB-RIGH,^0vLv ]dX`xTAB-UP,^0^ $ ]]dX`yTAB-DOWN,^0^ xt ]]dX`y(TOP-LINE,^0ldX`xċBOTTOM-LIN,^05 ]]dX`wQUAS,_hX`yhREPAIN,ywdX`yNDROP-MOD,ywdX`yBACK-SCREE,Y|ywdX`yALT-SCREEN,fywdX`y̋NEXT-SCREE,YhywdX`xKEEP-MOD,` yzX`yINS-TG,vnR lwX`z8ALT-FC,w~ $^Bf^n5"f^n5"X`yLIN-FC,w~ $^B_hR ^n5"X`zDEL-LINE,wa8dX`zDELV y͂/yBt;kr|]pVƼcٹYИ7SX|<LcWXb[6#kWν1ww,;7 Sv5}7dV^X_9u[Ȧv7Uܻ7? &l~fWΩՔ*wqkHlC;& ;g>C0Y_6*v<}6,9xͮƮ&=7 i;7Ha~#q4m%?ٕI%¹Z\!f3[lK 7LY ;q5-yxxR7VDkޕ6R®4 7TokΊܾ;Yؕ3 jx/ \ۂ%7 b[1 )oή>b[؆k7U T˛9-8 f ,TYS¤~u"=әEƱ&Cω#gg8#g:3P+B #OH`5C <5|"AS@g`NN4VN4J>(G> GNFORT15D354= *LN EXITB>*GN 8UNNESTB= *_? N NUP^4t?N 0yp?N (LIT?N  BRANCH>*GN  ?BRANCJ_gJ]N  (LOOP)RVhJJ^J]N  ҇(+LOOP0VhJJ^J]N  (DO)02=|=A=N  (?DO<02@f>*GN  BOUNDS, XP>NEXr hEXECUT>(G> GN2PERFOR>(G>(G> GNN>ypNGONufNOOPN PAUSN t0n?N ȁ0.n?N ڇ(LEAVE&J>*GN (?LEAVE)BJ_fN 4T> GH>N 쁡n> G0@HN C@> GB@>N C!> G0N CMOV0R@> G>"GS@g`N CMOVE>0>@ G>@"GR@S@g!`N ܃SP?N SP">.GN RP6?N .RPH>,GN NDROP^0N TDUp?N SWAP H@.N zOVER?/N hTUCK H@.?N @NI>N ƒRO240>??N h-ROT402>??N ԄFLIP 0X?N ?DUP,n 8nX R> D?N  <>R V=N  NR@ h?N PICK |B0@?7N  `ROLL, T f zn B N\XAN 0WN  &OR 0WN  rXO 0WN  NO FWN  ڄTRUEr FALSr BANKr ƄCSET 4> G0N  *CRESET P> G0F@N  DCTOGGL n> G0N  bON > G0N  ~OF > GBPN  0WN  NEGATE DWN  0WN  ԃAB JWjDWN  +! > GH_2IN  r 恱r r r 42* PN  H2/ bN  *U2 tN  8* 0@?N  l1+ RWN  Z2+ TWN  1- SWN  2- UWN  UM 0/N  ܃U*, X UM/MOD 0"HA.N >N BWN  ~0< 8JWk` 00= HJWg` @0> XJWn` P0< hJWf` ` v0Wn` 0Wg` ʁ 0Wm` U< 0Wbl`r U> 02@bT`Z p<>, X >?NEGAT, 6 X MI,  \X MA, t "\X BETWEE, T  B X WITHIN, 2X (2@,n RRX \2!,l lX r2DRO N  2DUP /N  2SWA "./N  2OVE //N  H3DUP,n X Є4DUP, X Ȅ2ROT,  X D+& їN  DNEGAT>DN  ރS>P0_/N  2DABSfJWjDN !\D2| /N !tD2 /N !D-,<$X!H?DNEGATE, 6<X"D0, FX"ʂD=,X"ڃDU,     X"D<, 8 z 6>\ tX"D>, "X"BDMIN, Hf X"RDMAX, " X#*D, T  BX# M/MO, .n T T Td f  B  B 6  f  B\X#MU/MOD, T $ f B T BX$, \X$/MOD, TN BX$",*X$MO,*\X$*/MO, T BX$V*/,^X%lTOz%FENTRz%|LINKz%8SPz%lRPz%DPz %#OUTz %ȅ#LINz%ֆOFFSETz%BASEz%HLz%FILEz%IN-FILz%PRINTINGz&EMIT&SC^&,PRIO^&LSTAT^&fWARNIN^&XDP^&R#^&LAST^&tCS^&CURREN^"&#VOCr&ƇCONTEX^"'Ԅ'TIB^'WIDT^'VOC-LINK^2z'BL^'">I^'SPAN^':#TIB^'>END?^(.BLr (dBSr(pBELLr(HCAPS^(|FILL02> GSAQN (VERAS, $X(BLAN,jX(COUN> GB@??N (LENGTH> G0??N (MOVE, 6:X)UPF< am zn ?N )>UPPE,Z:nDrX)HERE,RX)PA,P X)b-TRAILIN,n $: j @ X*ބCOMP0R@> G>"GS@g gj?<`? G>"GS@g*NNgj?<`?SIZr*1FIRSr1INIT-Rr1&>BUFFERS,. X1D>END,. X1\BUFFER, P X1n>UPDAT, .x X2READ-BLOCK2WRITE-BLOCb2.FIL,nn fF  X2ƅFILE,RX2SWITCH,R&Rl&lX2 DO1*2!FILES,nl&lX2DISK-ABORT,J* in ,X2?DISK-ERRO,nl* Disk error Z\X3LDM^3FCB1^3nCLR-FC,X3CLR-DM,X3$SET-DM, \ X3HANDLE, X3؇RECORD," X32MAXREC,& X3IN-RANGE,nRtR nl .x * Out of Range ZX48SET-IO,n btln b\\X4jFILE-REA,n b^R $B \ b $ $^R? X4FILE-WRITE,n b^R $B \ b $ $^R@ X4TFILE-I,3b3X5CAPACITY,RR X5LATEST, R .x b$ .x R  B\X54ABSENT,  8b\ x b\ $^ B .xnP TPn  B  .x R P x X6(UPDATE, X6DISCAR, .lX6MISSIN,d R 6d d d RP l .P lPn  X6(BUFFER),2P .x RX6BUFFER,R8X6,(BLOCK,8R V .xn X6TBLOC,RtX6ЈIN-BLOCK,&RtX7EMPTY-BUFFER,. P . .x $n  l   X7ΌSAVE-BUFFERS, .x $lnR hn R 6bnn  :\X7FLUS,, $\X7rVIEW,R( X8FILE-SIZ, $B $ $N  b nlX8TDOS-ERR?, 6X8؉OPEN-FIL, 8&R $=\ T Bn @l&R* Open error Z&R^l&R\X9†EXTEND,* EXTEND.BLK n&ll X9j(LOAD),R T(R T4R T4 (l&Rl3T B4l B(l B<X9 LOAD BgN : ΅DIGI 02<0k< k<k_j>?, R X<"|SIGN, 6"-"VX<",R  t" 0 "VX<"#S," F"X<"jHE,lX<"DECIMA, lX<"څOCTA,lX<">BINARY, 8lX=#(U.), $"p""X= TU.,#RJhX=#`U., T#R B |JX=#J(.,n $"p"""X=#4,#JhX=#.R, T# B |JX=#(UD.,"p""X=#rUD,#JhX=#UD.R, T# B |JX=#҄(D.),d"p"""X=$D.,$JhX=$0D., T$ B |JX??N >#SKIP$p02RA> GSAg fRH``>$fSCAN$02RA> GSAg gRH``?$/STRIN,   X?$BPLAC, "\X?$Ј(SOURCE),(R .% %zPRX?$SOURCE$?$PARSE-WORD, T%4R$ f$n B$ T  Bn f 4lX?%$PARS, T%4R$ B$ T n B f 4 X@%'WOR,X@%WORD,%2%$%n jX@#>TYP,JX@%.(,)%n%X@%f,)%n X@%\S,^ XA& TRAVERSE&*0> Gf`?N A&DONE,nR ^R ^ XA%FORTH-83, 1 * (almost) XB&dN>LINK, XB&FL>NAME, XB&BODY, XB&NAME, .&( XB&LINK,&&XB&>BOD, XB&>NAM, &(XB&>LIN,&&XB' >VIE,' XB'VIEW, &XB&҄HASH'J2> GJ|@@?N C'@(FIND)'r,BB>gB"G< FJY<?f&g<f>|@g?<`?`BgN D%#THREADSrD'.FIND,n(:`  $(6\ N Rn(2n`R`l ($\ (2'HR'pn@'(F\^  .XD'Ɗ?UPPERCASE,R(hnjXD'fDEFINE,j%(X'XE(J?STACK,R ,hStack Underflow ,hStack Overflow XE(STATUSE#INTERPRE,((v(~)"H!" )\ &N(XF(؅ALLO, XF(l,l 8)XF(ȂC,, .)XF) ALIG, . )\j)6XF)DEVEN,n . XF)0COMPIL, Bn TR)"XF)`IMMEDIAT,@R 2XF)LITERA,))"XF)DLITERAL,))XF)ASCI,j% nR))XF)vCONTRO,j%  nR* )XG)CRAS, ,h Uninitialized execution vector. XG*$?MISSING,*x%J ,h ? XG*X,(v F*dXG*|[',*)XG*[COMPILE,*)"XG)ă(", B )h TXG*(."), B )h TJXG*ʂ,","%n%$ ))LXG'.",)**XG+,)**XH+FENC^H*TRIM,' $+f R +ZR+Jl +F XH+4(FORGET),n+.R ,h Below fencenR +R+nln+ ' N +<R+\lXH+&FORGET,j%(XnR'HR'p F*d'$+xXI*WHERI+?ERROR, I+l(?ERROR),,V T TR 8 (R,F4R(R+ B BhJh3~,X XI,(ABORT"), f, B )h TXI)ABORT",),h*XI,ABOR, ,h XJ,?CONDITION, ,hConditionals Wrong XJ+̅>MAR, $)"XJ,ֈ>RESOLVE,lXJ,\MARK, ,XJ-&?>RESOLV,,,XJ-:?.M/~;USE,/)/0/0XM/(;CODE, BR&lXM0;COD,/)0B0/0XM08DOES,)0BN)" $)"Z)"XN0R,n XN0,n ((vn0 V0~0)"0\"H!"0)0\) &N0XN/Ɓ,/rRl/\/0/,N0,/)X/0XO0RECURSIV,/XO0CONSTANT,/\)"/rO1VARIABLE,/\ $)"/^O0lDEFE,/\*,)"/O1>VOCABULARY,/\' $1 $)"1R)"l0BNZlXO1XDEFINITION,RlXP1p2CONSTAN,/\)")"0BNZ bXP1ʉ2VARIABL, $ $10BNZXP0AVOC^P1&CODE,/\/n lR2l0XPEND-CODE,2Rl/XQ2#USE^Q2 USER122~220QALLO,2b XQCREATE,/\2bR)"/zQVARIABLE,2 82XQDEFE,2/R1>I,nRnz n \ 3 &RnR 3 &XR1(IS), fR2l B TXR2hIS,nR3D)33J*2lXS2ԃRU,nR3p0nR 3l(3r(XS3,QUIT,Rl( 0RF(3TnR 3* ok3XS3NBOOT4S2ZWARM, ,h Warm Start XS3COLD,33~XT3vINITIArT3ނOK,3 XT4STAR,XT3BY, $  ##f*Pages $XI3> GNMO.<I3> GN5 W3DEPT,R `XW4 .S,4 .4 $44 z#xh@44*Empty XW4.I,n n $:5<n F 52_ 58 n5 hXW4DUMP, $5n#h $5xn B# 5j5T\XX4RECURS,R&)"XII - OVER = SWAP ASCII / OVER = SWAP DROP OR OR ; HmN}X2Ngp{?JI3Rہk-17H$pF=dr~690[˚:L;c_fWN{4v oP+/NLqߠV9rN{]kmBn\pV 9,ؕ5C M~s^ny7'I|Q sW Sr wlK, u~$M>_ԹV2?)7s^Kn4ĝM#.3`1J'*O*m#8Z - ЭЭм"ҍ¼.A// Bg?<JNA y8Z"h#8^E?/ NN"/0<NBNu o AdpNu#8^BNuNV0/"/ NB8^d0< A2l"NB0<NBN^Nu o2/0/ HSoQBNu o0/JfBNuf SNuNVHBG.2N ".2N ".2N ".2N ".2N ".3N "Bn nmt`dX n *P -f6`*H`32`By2``D`|ng|ug`R MJf`JGfJno n PJg >.-n Snf|l.3"/<5N DX>N:Bn` n2n.a,nRnnnJnfBW`>N:JL N^NuNVHaaBD.3;/.NpX#|g"3< y`$0G<29<|2A8>JGl0R@D@>|fp`0>0JLN^NuNVH.N d>|.N d@GJLN^NuNV`T nHHм48 @(g6 nHHм48 @(g nH| ` nH"nR nJfN^NuNV`" nHHм48 @(gp`R nJfB@N^Nu#8dNN/98dNu#8dNM/98dNu#8dNA/98dNuNVH*n(n BG`|lRG0&@50+|f|mB` wg Wf>?</ N:\<`p ag Af>>?</ N\<l>?</ N:\<`>B?NJ\`$ rg Rf>Bg/ N\<`B`@JFlB`8Bk 6B'@'@ rg Rf7|`7|Jnfk JL8N^NuNVBW/. /.aPN^NuNVBW/. /.aPN^NuNV>/. /.aPN^NuNVHN"BW/<2NX>/<2NX>/<2NX n2n B*n`&HHм7 @g H| `HRJf> /.N XJL N^NuNV. /./<5NPN^NuNV./. /.NPN^NuNVH*nSm m mH|R` `.N JL N^NuNVH*n-fp`-g m p`Jf&-f>N+@fm`m-g0Hм8h+@5f95g .5Nl-g>`>/-?N \;@ Jm n m fm0`m p`Sm +m mH|RJL N^NuNVH>N#*@ fp`b-gB@`V-g3 738b7p`8-gB0../. / N P``B0../. / N  ?/ /-/ N'=@Bn` L2n gRnB@0.neJng L2n f =nU >/ aPX=@B0.ѭB0.B0.Jo -g` -o+m .JL0N^NuNVH *n-M B2. Ё-@(M`  gRe JL0N^NuNVH *n(n ..> ?/ /-/ N'=@JnfU B0.ѭ -o+mB@0.JL0N^NuNVH BWN!4#8z#8~By8x.2{a*n`N`RJgHHм7 @fJg2 "g 'fFH>/ RNX(@ f.5:/ aVX H> M2GBRG.Ra`BG`RG M2GJg5pHHм7 @gJ5pg M2GBRGH`BWNBW/ RNXJ@g.R/<5LaX`l>N ->f@>/ TNX|f>B?<NJ\|f.R/<5Ya|X`$BW/ RNX|g.R/<5haVX`>?/ NXJf>*/ NXJg-|CB.8?<NT>/ ?<N$\<f.5w/ aX`^.H?/.aZ\.N&>RWN'6(@./ N&lX.a>/ ?<N$\<f`.a`|g`JfBaSy8x.8~Nz|f.5/<5a*XB/98z?98xN\>N:JL0N^NuNV|./N&lX. /N&BX.5/N&BX.?< NT>N:N^NuNVH*n y8~ X8~Ry8xJL N^NuNVH*n. (nGVfJL8N^NuNVHN">|fp`>N"08*@/.?N$\J@g3#738b7p`U0JL N^NuNVBW?. /.a:\N^NuNVBW?. /.a"\N^NuNV>?. /.a\N^NuNVNR>NN^NuNVHBG`0м5.NRG|mJLN^NuNVH*n0-|g*.Nl-g .NB@H+@+@Bm m>NJL N^NuNVH>.>N#*@ f3 738b7p`NBF0|f>?<>N(hT<l|>N">N"fJFf0``3738b7pJL N^NuNVN^NuNVH*n0-| |f, -<o >/-?N!\>Gg mp`J-gJg-g;| `;| `>0- D@H/?NJ\Bm +mB@JL N^NuNVHN">|fp`>N"08*@/.?N$\J@g>N"f3738b7p`0U>B-H?NJ\BWB-H?NJ\0JL N^NuNVBW?. /.a\N^NuNVBW?. /.a\N^NuNV>?. /.a\N^NuNVH>N#*@ f3 738b7p`$>?-/. ?<BN(hP+@U -JL N^NuNV>B?.a\N^NuNVH*nBnJ gh``BE-n `RRE nJg n %fJEo.?/. N\-n n n %@R DfBn n H|-@R Df n R Rn| <0fG n R =|<*f-M n=PT n R `8`*JnlBnH2. A|=@ n R <0m<9o|<.f BF n R <*f-M n<T n R `*`H2 A<| n R <0m<9oBn<lg<LfRn n R A-HH` RnJng < ` < #8.8?<?< // N Jngp`pH`RnJng < ` < #8.8Bg?< // N Jngp`pH`zRnJng < ` < #8.8Bg?<// N Jngp`pH`&RnJng < ` < #8.8Bg?<// N Jngp`pH`-M n-PX`-M n0|@B.T`H>?// N X|`~H>?// NH X|`XH>?// N X|`4.H?NrTRn``|C|5b@0@6v PN.N&:ElJFm:0.E=@JnfX .0f* n -f SE. nH?NrTRRn`..H?NrTRn0.SnJ@n.?/.N\n`..H?NrTRn0.SnJ@n`0.JL N^NuNVJnlp`0.=@ n -@>/. /.N(PN^NuNVJnlp`0.=@ n -@>/. /.N*PN^NuNV>/. /.a~P-@. N&2.^AAo>/. /.aP-@ .N^NuNVH *n>. (n,g$Bl >/ ?N!\Gg lp`*B@`&`.H?NrT|fp` 0SGJ@fB@JL0N^NuNVH. *n Sm mH"m|R``.H?NTJL N^NuNVH. *n BF:-fp`$JfV-fN>N+@+@fm`2m>NJ@gm@`;| H"mR`-gA+H +@ mR-gz>/-?N!\<Bm `n-g>< g -мb" -:>/-?N!\<+mBm `( -:>/-?N!\<;| +mFg mp`H|JL N^NuNVH>N#*@ fB@`-fB@`pJL N^NuNVH>N#*@ fB@`0|JL N^NuNV>aJ@g <2`BN^NuNVH>.^GORG>a*@ fB` >/ aXJL N^NuNVH (y7V*T`ZB@0-BA2-@F@J@g>NB`:B@0-ne `*7Vf>a*@ f>NB`(M*U`JL0N^NuNVH n*PB@0. X@me n `F(MB@0. HH@B@H@B@0-n 9@B@0,F@9@( n ;n B@0-F@;@#7V PJL0N^NuNVH >.|?GG0@>N!4*@fB`* R*@(M9GB@0,F@9@.Pa 97VJL0N^NuNVH *nQB@0-BA2-@F@J@g>Np`(y7Veeecd(T`e2 BA2-IHABAHAЁ" BB4,JHBBBHB҂b #7VB@`n BA2-IHABAHAЁf T0(mB@0-F@;@ T*`* BA2,IHABAHAЁfB@0-lB@0,F@9@(`(#7VB@JL0N^NuNVH *n.a>. ^GORG>a-@fB`J n(PPg2d`Sn Jn f`B0. B0. `%Sn Jn f>/.aXJL0N^NuNVN^NuNVN^NuNVH /?.?./ /. nN*@ мfB(n `%H|0|9o^G мfB JL0N^NuNVH-|8*n<.H n. nfz` |SEJgJEf`h nf$z ` |SEJgJEfJEf-`*n<.JngJGlB@0D@> n P-"n R`B0H@B0>JGf JL N^NuNVH >.HμgR*y8^(G8^.Nz|f3 738b7p`>Bg/ N\ JL0N^NuNVH>N#*@ fp`XJnfB@`N-g3 738b7p`0-g>/. / N#tP``>/. / N$PJL N^NuNVH|BG` 7Zf 7Z0`RG|m3738b7pJLN^NuNVp2.`F@H7ZB@N^NuNVHBG`>aRG|mJLN^NuNVH 0.8*@<0.@BUB-+| BB> Bg/ N\> ?< / N\JL0N^NuNVH>.|e3 738b7B`0B@08*@<-f3 738b7B` JL N^NuNVH *n(n >.B@=@=@``Rnnc L2n  fB@0.ncf>?.B@0.W B2.Ё//-/ N(,=@B0.ѭJnf3738b7p`^=n`8Rn>?</<7^/-/ N(,=@B0.ѭnb4 -o+mB@0.JL0N^NuNVH*n>?./. /-/ N(,=@Jnf3738b7p` B0.ѭ -o+mB@0.JL N^NuNVH*n 0.8м<-@~.a&M`RJg :fJgc .Am .On*K`K0.`BW/ ?<o n1GBG`BW/ ?<NN(h\JgB@`0<>`d>ON(hJgB@`0<>`J.?<=N(hT>o n1GBG`,.?<AN(hT>``||b@0@7` PN0JL8N^NuNV n am n zn n nHRJfN^NuNVH *n (n`RJff .JL0N^NuNVH *n (nf .JL0N^NuNVH *n(M`RJf HJL0N^NuNVN^NuNVH *n(n `$H>a0H>a&op`lp` JfJfB@JL0N^NuNVH>.|am |zn|0JLN^Nu0/J` _B0Z"y8^CCbNC NNVH..,. Jf#8 <`Hc #8B`:fzB`(xe 〼b`BJge`#8 JLN^NuJg .NuNV n=h.0n/0n/N(xP/?.?<?N(hPN^NuNV n=h.0n/0n/N(xP/?.?<@N(hPN^Nu#8NA/98NuNVBBJlDRBJ lD RB0. -@0.2. An=@ .gDN^NuNVH-n Jnnp` nop`0.R@8BGB/.N,Pl n -R /.N.tX-@B/.N,Po.`/<D/.N.TP-@SG/<A/.N,Pm`/<D/.N-P-@RG/<D/.N,PlG|0H/N- n -R 0H |0"n R 0H H@|0"n R n BR .JLN^NuNVH..,. N. LN^NuNVH..,. N/LN^NuNVH..,. N/ LN^NuNVHJl| .D-@`BFJfB`^~` .-@R .f` .-@S. g .-@޼@ JFg .JLN^NuNVH .м<JgJFlB`V .:|oJEg <` <`0..μ|`RFJFm`SFJFnJEg D. JLN^NuNVH..,. N0F LN^NuNVH..N. LN^NuNVH..,. N. LN^Nu<NuJg NugR kjklf`>k^g>k^g2k8<d,&B<ރeNuRid~S<Nu.NuJNu:ڼ.gNugRghEDvi^E]HE:BB8HD&HC؃HF&؃BDHDHGHFHEބj ޼gNuSiex@ބއdRgNu~NujJ<Numc68343 floating point firmware (c) copyright 1981 by motorola inc. Stack Overflow$C runtimeCON:LST: STUSQ - Version 1.01 - 10/85 Courtesy of: Computer Toobox, Inc. 1325 East Main Street Waterbury, Conn. 06705 (203) 597-0273 Usage: STUSQ rSTUSQ: can't open %s STUSQ: %s is not a SQueezed file! STUSQ: %s Internal Error #1! STUSQ: %s -> %s wSTUSQ: can't create %s usq: error in writing file: %s usq: Error writing file: %s usq: Error closing file: %s STUSQ: Internal Error #2 %s! ((((( H ((((( H : unmatched quoteCannot open Cannot append Cannot create : No matchStack Overflow $   Z$HHHHHHHHHHHHHXHHHHHHHHHH^$HHHHHHHHHHHHH\7N7N %&%~%%&&%\!!!!"CP/M-68K(tm), Version 1.2, Copyright (c) 1983, Digital Research XXXX-0000-6543216$ T0N :"    :       :$L&,2$   ," 4P& \& DN ,D( 0 <    >  h 0HN&  j^***`&$ D"V8*R$ZF \@(B4.J".86 Jp $""@2&"fHR"L(<@* T0^0 :   (203) 597-0273 --Usage: STSQ ,r߻Ⱦpz5eys TZ4~Ӭk o~.6t$sG0,_˚:ݑ^Oa*.敇)1b[Զv w›S 1mL;;}~SWmŽev& ;+;;^Sr\"lhM|m;ͮ7fŽΛ#6rߘ QaF Eӏ?MUCc䭍Nj' 7/qS{',i_=+'.K0; /ؕvya' b[xw)8I$qnq;5;N%?M[qxƛk[9K]0.n'Ý7zͮy)`7mT}ysdMn; 7sgwaޜ}ngbor^ޜZ}P<.lN3 1!7*6Kv6-7̓e!dK Ćafapmؕәʼns maޑ/o_}!߅q<`yŽݝ7'If/;Mn˛}zNCȖ OŽ۰+af3ksmx omIߜDdbwRp^,_˚:^Oa3vxN+;;?4lBRcs:y ;i;G֮󚛅,hO?xEr+";;x7fk!ؕIx