Convert Apple 1 blocks to stream files
This commit is contained in:
Carsten Strotmann
parent
a0b5c2167e
commit
0478a47a95
|
|
@ -0,0 +1,11 @@
|
|||
|
||||
blk_files = $(wildcard *.fb)
|
||||
fth_files = $(patsubst %.fb, %.fth, $(blk_files))
|
||||
|
||||
# Target to convert all .fb blk sources into .fth files.
|
||||
fth: $(fth_files)
|
||||
|
||||
# Generic rule for converting .fb blk sources into .fth files.
|
||||
|
||||
%.fth: %.fb fb2fth.py
|
||||
../../../tools/fb2fth.py $< $@
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
Screen 0 not modified
|
||||
0 \ Additional definitions for 32bit values cas 26jan06
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ 2Words Loadscreen cas 26jan06
|
||||
1
|
||||
2 hex
|
||||
3 &2 &3 thru
|
||||
4 decimal
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 2 not modified
|
||||
0 \ 2! 2@ 2VARIABLE 2CONSTANT 08JUL85RE)
|
||||
1
|
||||
2 CODE 2! ( D ADR --)
|
||||
3 TYA SETUP JSR 3 # LDY
|
||||
4 [[ SP )Y LDA N )Y STA DEY 0< ?]
|
||||
5 1 # LDY POPTWO JMP END-CODE
|
||||
6
|
||||
7 CODE 2@ ( ADR -- D)
|
||||
8 SP X) LDA N STA SP )Y LDA N 1+ STA
|
||||
9 SP 2DEC 3 # LDY
|
||||
10 [[ N )Y LDA SP )Y STA DEY 0< ?]
|
||||
11 XYNEXT JMP END-CODE
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 3 not modified
|
||||
0 \
|
||||
1
|
||||
2 : 2VARIABLE ( --) CREATE 4 ALLOT ;
|
||||
3 ( -- ADR)
|
||||
4
|
||||
5 : 2CONSTANT ( D --) CREATE , , DOES> ( -- D) 2@ ;
|
||||
6
|
||||
7 \ 2DUP EXISTS
|
||||
8 \ 2SWAP EXISTS
|
||||
9 \ 2DROP EXISTS
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,204 @@
|
|||
Screen 0 not modified
|
||||
0 \ FORTH-6502 ASSEMBLER WFR ) cas 26jan06
|
||||
1 ( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
2
|
||||
3 Load from Screen 1 for the transient assembler:
|
||||
4 This 6502 Forth Assembler can be loaded into the heap
|
||||
5 and then not be saved in the final binary to save memory.
|
||||
6
|
||||
7 Load from Screen 2 for the regular assembler:
|
||||
8 This 6502 Forth Assembler will be loaded into normal
|
||||
9 memory and will be saved into the final binary.
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ TRANSIENT FORTH-6502 ASSEMBLER WFR ) er14dez88
|
||||
1 ( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
2
|
||||
3 ( INTERNAL LOADING 04MAY85BP/RE)
|
||||
4 hex
|
||||
5 \ HERE $200 HALLOT HEAP DP !
|
||||
6 &10 LOAD
|
||||
7 &11 LOAD
|
||||
8 3 &8 THRU
|
||||
9 &9 LOAD \ for System-Assembler
|
||||
10
|
||||
11 \ DP !
|
||||
12
|
||||
13 ONLYFORTH
|
||||
14 decimal
|
||||
15
|
||||
Screen 2 not modified
|
||||
0 \ FORTH-65 ASSEMBLER WFR ) er14dez88
|
||||
1 ( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
2 ONLYFORTH
|
||||
3 Vocabulary tassembler
|
||||
4 TASSEMBLER ALSO DEFINITIONS
|
||||
5 hex
|
||||
6
|
||||
7 8 +load \ relocate
|
||||
8 1 6 +THRU
|
||||
9 \ 7 +load \ System Assembler
|
||||
10 decimal
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 3 not modified
|
||||
0 \ FORTH-83 6502-ASSEMBLER ) er14dez88
|
||||
1 : END-CODE CONTEXT 2- @ CONTEXT ! ;
|
||||
2 CREATE INDEX
|
||||
3 09 c, 09 c, 05 c, 15 c, 15 c, 01 c, 11 c, 80 c,
|
||||
4 09 c, 80 c, 0D c, 1D c, 19 c, 80 c, 80 c, 80 c,
|
||||
5 80 c, 00 c, 04 c, 14 c, 14 c, 80 c, 80 c, 80 c,
|
||||
6 80 c, 80 c, 0C c, 1C c, 1C c, 80 c, 80 c, 2C c,
|
||||
7
|
||||
8 | VARIABLE MODE
|
||||
9
|
||||
10 : MODE: ( N -) CREATE C, DOES> ( -) C@ MODE ! ;
|
||||
11
|
||||
12 0 MODE: .A 1 MODE: # 2 | MODE: MEM 3 MODE: ,X
|
||||
13 4 MODE: ,Y 5 MODE: X) 6 MODE: )Y 0F MODE: )
|
||||
14 6 MODE: )Y 0F MODE: ) 6 MODE: )Y 0F MODE: )
|
||||
15 6 MODE: )Y 0F MODE: ) 6 MODE: )Y 0F MODE: )
|
||||
Screen 4 not modified
|
||||
0 \ UPMODE CPU ) er14dez88
|
||||
1 | : UPMODE ( ADDR0 F0 - ADDR1 F1)
|
||||
2 IF MODE @ 8 OR MODE ! THEN 1 MODE @ 0F AND ?DUP IF
|
||||
3 0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ;
|
||||
4
|
||||
5 : CPU ( 8B -) CREATE C, DOES> ( -) C@ >c, MEM ;
|
||||
6
|
||||
7 00 CPU BRK 18 CPU CLC D8 CPU CLD
|
||||
8 58 CPU CLI B8 CPU CLV CA CPU DEX
|
||||
9 88 CPU DEY E8 CPU INX C8 CPU INY
|
||||
10 EA CPU NOP 48 CPU PHA 08 CPU PHP
|
||||
11 68 CPU PLA 28 CPU PLP 40 CPU RTI
|
||||
12 60 CPU RTS 38 CPU SEC F8 CPU SED
|
||||
13 78 CPU SEI AA CPU TAX A8 CPU TAY
|
||||
14 BA CPU TSX 8A CPU TXA 9A CPU TXS
|
||||
15 98 CPU TYA
|
||||
Screen 5 not modified
|
||||
0 \ M/CPU ) er14dez88
|
||||
1
|
||||
2 : M/CPU ( MODE OPCODE -) CREATE C, , DOES>
|
||||
3 DUP 1+ @ 80 AND IF 10 MODE +! THEN OVER FF00 AND UPMODE UPMODE
|
||||
4 IF MEM TRUE ABORT" INVALID" THEN
|
||||
5 C@ MODE @ INDEX + C@ + >c, MODE @ 7 AND
|
||||
6 IF MODE @ 0F AND 7 < IF >c, ELSE >, THEN THEN MEM ;
|
||||
7
|
||||
8 1C6E 60 M/CPU ADC 1C6E 20 M/CPU AND 1C6E C0 M/CPU CMP
|
||||
9 1C6E 40 M/CPU EOR 1C6E A0 M/CPU LDA 1C6E 00 M/CPU ORA
|
||||
10 1C6E E0 M/CPU SBC 1C6C 80 M/CPU STA 0D0D 01 M/CPU ASL
|
||||
11 0C0C C1 M/CPU DEC 0C0C E1 M/CPU INC 0D0D 41 M/CPU LSR
|
||||
12 0D0D 21 M/CPU ROL 0D0D 61 M/CPU ROR 0414 81 M/CPU STX
|
||||
13 0486 E0 M/CPU CPX 0486 C0 M/CPU CPY 1496 A2 M/CPU LDX
|
||||
14 0C8E A0 M/CPU LDY 048C 80 M/CPU STY 0480 14 M/CPU JSR
|
||||
15 8480 40 M/CPU JMP 0484 20 M/CPU BIT
|
||||
Screen 6 not modified
|
||||
0 \ ASSEMBLER CONDITIONALS ) er14dez88
|
||||
1
|
||||
2 | : RANGE? ( BRANCH -- BRANCH )
|
||||
3 DUP ABS 07F U> ABORT" OUT OF RANGE " ;
|
||||
4
|
||||
5 : [[ ( BEGIN) >here ;
|
||||
6 : ?] ( UNTIL) >c, >here 1+ - RANGE? >c, ;
|
||||
7 : ?[ ( IF) >c, >here 0 >c, ;
|
||||
8 : ?[[ ( WHILE) ?[ SWAP ;
|
||||
9 : ]? ( THEN) >here OVER >c@ IF SWAP >!
|
||||
10 ELSE OVER 1+ - RANGE? SWAP >c! THEN ;
|
||||
11 : ][ ( ELSE) >here 1+ 1 JMP
|
||||
12 SWAP >here OVER 1+ - RANGE? SWAP >c! ;
|
||||
13 : ]] ( AGAIN) JMP ;
|
||||
14 : ]]? ( REPEAT) JMP ]? ;
|
||||
15
|
||||
Screen 7 not modified
|
||||
0 \ ASSEMBLER CONDITIONALS ) er14dez88
|
||||
1
|
||||
2 90 CONSTANT CS B0 CONSTANT CC
|
||||
3 D0 CONSTANT 0= F0 CONSTANT 0<>
|
||||
4 10 CONSTANT 0< 30 CONSTANT 0>=
|
||||
5 50 CONSTANT VS 70 CONSTANT VC
|
||||
6
|
||||
7 : NOT 20 [ FORTH ] XOR ;
|
||||
8
|
||||
9 : BEQ 0<> ?] ; : BMI 0>= ?] ;
|
||||
10 : BNE 0= ?] ; : BPL 0< ?] ;
|
||||
11 : BCC CS ?] ; : BVC VS ?] ;
|
||||
12 : BCS CC ?] ; : BVS VC ?] ;
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 8 not modified
|
||||
0 \ 2INC/2DEC WINC/WDEC KS 19 MAY 84 ) er14dez88
|
||||
1
|
||||
2 : 2INC
|
||||
3 DUP LDA CLC 2 # ADC DUP STA CS ?[ SWAP 1+ INC ]? ;
|
||||
4
|
||||
5 : 2DEC
|
||||
6 DUP LDA SEC 2 # SBC DUP STA CC ?[ SWAP 1+ DEC ]? ;
|
||||
7
|
||||
8 : WINC DUP INC 0= ?[ SWAP 1+ INC ]? ;
|
||||
9
|
||||
10 : WDEC DUP LDA 0= ?[ OVER 1+ DEC ]? DEC ;
|
||||
11
|
||||
12 : ;C: RECOVER JSR END-CODE ] 0 LAST ! 0 ;
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 9 not modified
|
||||
0 \ ;CODE CODE CODE> BP 03 02 85) er14dez88
|
||||
1 ONLYFORTH
|
||||
2
|
||||
3 : ASSEMBLER ASSEMBLER [ ASSEMBLER ] MEM ;
|
||||
4
|
||||
5 : ;CODE [COMPILE] DOES> -3 >allot
|
||||
6 [COMPILE] ; -2 >allot ASSEMBLER ; IMMEDIATE
|
||||
7
|
||||
8 : CODE CREATE >here DUP 2- >! ASSEMBLER ;
|
||||
9
|
||||
10 : >LABEL ( ADR -)
|
||||
11 >here | CREATE SWAP , 4 HALLOT
|
||||
12 HEAP 1 AND HALLOT ( 6502-ALIGN) HERE 4 - HEAP 4 CMOVE
|
||||
13 HEAP LAST @ COUNT 01F AND + ! DP ! DOES> ( - ADR) @ ;
|
||||
14
|
||||
15 : LABEL [ ASSEMBLER ] >here >LABEL ASSEMBLER ;
|
||||
Screen 10 not modified
|
||||
0 \ Code generating primitives er14dez88
|
||||
1
|
||||
2 Variable >codes
|
||||
3 | Create nrc ] c, , c@ here allot ! c! [
|
||||
4
|
||||
5 : nonrelocate nrc >codes ! ; nonrelocate
|
||||
6
|
||||
7 | : >exec Create c,
|
||||
8 Does> c@ >codes @ + @ execute ;
|
||||
9
|
||||
10 | 0 >exec >c, | 2 >exec >, | 4 >exec >c@
|
||||
11 | 6 >exec >here | 8 >exec >allot | $0A >exec >!
|
||||
12 | $0C >exec >c!
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 11 not modified
|
||||
0 \ FORTH-65 ASSEMBLER WFR ) er14dez88
|
||||
1 ( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
2 ONLYFORTH
|
||||
3
|
||||
4 ASSEMBLER ALSO DEFINITIONS
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
|
|
@ -0,0 +1,323 @@
|
|||
Screen 0 not modified
|
||||
0 \\ *** Assembler *** 25may86we
|
||||
1
|
||||
2 Dieses File enth„lt den 68000-Assembler f<>r volksFORTH-83.
|
||||
3 Der Assembler basiert auf dem von Michael Perry f<>r F83 entwik-
|
||||
4 kelten, enth„lt aber einige zus„tzliche Features.
|
||||
5 Wegen der Heap-Struktur im volksFORTH sind z.B. echte Labels
|
||||
6 verwendbar. Aus Geschwindigkeitsgr<67>nden enth„lt der Assembler
|
||||
7 kaum Fehler<65>berpr<70>fung, es empfiehlt sich daher, nach getaner
|
||||
8 Tat die Code-Worte mit einem Disassembler zu <20>berpr<70>fen.
|
||||
9
|
||||
10 Screen $11 enth„lt einen Loadscreen, mit dem man der kompletten
|
||||
11 Assembler auf den Heap laden kann, damit er w„hrend der Kompila-
|
||||
12 tionszeit zur Verf<72>gung steht, aber keinen Platz im Dictionary
|
||||
13 verbraucht. Mit CLEAR oder SAVE wird der Assembler entfernt,
|
||||
14 wenn er nicht mehr ben”tigt wird.
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ 68000 Assembler Load Screen 26oct86we
|
||||
1
|
||||
2 Onlyforth
|
||||
3 Vocabulary Assembler Assembler also definitions
|
||||
4
|
||||
5 : end-code context 2- @ context ! ;
|
||||
6 ' swap | Alias *swap
|
||||
7
|
||||
8 base @ 4 $11 +thru base !
|
||||
9
|
||||
10 : reg) size push .l 0 *swap FP DI) ;
|
||||
11 : Next .w IP )+ D7 move D7 reg) D6 move D6 reg) jmp
|
||||
12 >here next-link @ , next-link ! ;
|
||||
13
|
||||
14 2 3 +thru Onlyforth
|
||||
15
|
||||
Screen 2 not modified
|
||||
0 \ Internal Assembler 09sep86we
|
||||
1
|
||||
2 Onlyforth
|
||||
3
|
||||
4 here
|
||||
5 $1300 hallot heap dp ! -1 +load
|
||||
6 dp !
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 3 not modified
|
||||
0 \ Extended adressing modes 09sep86we
|
||||
1
|
||||
2 : R#) ( addr -- ) size push
|
||||
3 [ Forth ] dup 0< IF [ Assembler ] .w # D6 move D6 reg)
|
||||
4 [ Forth ] exit THEN .w FP D) ;
|
||||
5
|
||||
6
|
||||
7 | : inrange? ( addr -- offset f ) [ Forth ]
|
||||
8 >here 2+ - >here 0< IF dup $FFFE >here - < exit THEN
|
||||
9 dup >here negate > ;
|
||||
10 : pcrel) ( addr -- ) \ pc-relativ adressing mode
|
||||
11 inrange? [ Forth ] 0= abort" out of range" pcd) ;
|
||||
12
|
||||
13 : ;c: 0 recover R#) jsr end-code ] ;
|
||||
14
|
||||
15
|
||||
Screen 4 not modified
|
||||
0 \ Assembler Forth words 09sep86we
|
||||
1 Forth definitions
|
||||
2 : Assembler Assembler [ Assembler ] .w ;
|
||||
3 : Code Create here dup 2- ! Assembler ;
|
||||
4
|
||||
5 | : (;code r> last @ name> ! ;
|
||||
6 : ;Code 0 ?pairs compile (;code [compile] [ reveal
|
||||
7 Assembler ; immediate restrict
|
||||
8
|
||||
9 : >label ( addr -- ) here | Create swap , immediate
|
||||
10 4 hallot >here 4- heap 4 cmove
|
||||
11 heap last @ count $1F and + even ! dp !
|
||||
12 Does> ( -- addr ) @
|
||||
13 state @ IF [compile] Literal THEN ;
|
||||
14 : Label [ Assembler ] >here [ Forth ] 1 and
|
||||
15 [ Assembler ] >allot >here >label Assembler ;
|
||||
Screen 5 not modified
|
||||
0 \ Code generating primitives 26oct86we
|
||||
1
|
||||
2 Variable >codes
|
||||
3 | Create nrc ] c, , c@ here allot ! c! [
|
||||
4
|
||||
5 : nonrelocate nrc >codes ! ; nonrelocate
|
||||
6
|
||||
7 | : >exec Create c,
|
||||
8 Does> c@ >codes @ + @ execute ;
|
||||
9
|
||||
10 | 0 >exec >c, | 2 >exec >, | 4 >exec >c@
|
||||
11 | 6 >exec >here | 8 >exec >allot | $0A >exec >!
|
||||
12 | $0C >exec >c!
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 6 not modified
|
||||
0 \ 68000 Meta Assembler 04sep86we
|
||||
1
|
||||
2 | : ?, IF >, THEN >, ;
|
||||
3 | : 2, >, >, ;
|
||||
4 8 base !
|
||||
5 Variable size
|
||||
6 : .b 10000 size ! ;
|
||||
7 : .w 30100 size ! ; .w
|
||||
8 : .l 24600 size ! ;
|
||||
9
|
||||
10 | : Sz Constant Does> @ size @ and or ;
|
||||
11 00300 | Sz sz3 00400 | Sz sz4
|
||||
12 04000 | Sz sz40 30000 | Sz sz300
|
||||
13
|
||||
14 | : long? size @ 24600 = ;
|
||||
15 | : -sz1 long? IF 100 or THEN ;
|
||||
Screen 7 not modified
|
||||
0 \ addressing modes 09sep86we
|
||||
1
|
||||
2 | : Regs 10 0 DO dup 1001 I * or Constant LOOP drop ;
|
||||
3 | : Mode Constant Does> @ *swap 7007 and or ;
|
||||
4 0000 Regs D0 D1 D2 D3 D4 D5 D6 D7
|
||||
5 0110 Regs A0 A1 A2 A3 A4 A5 A6 A7
|
||||
6 0220 Mode ) \ address register indirect
|
||||
7 0330 Mode )+ \ adr reg ind post-increment
|
||||
8 0440 Mode -) \ adr reg ind pre-decrement
|
||||
9 0550 Mode D) \ adr reg ind displaced
|
||||
10 0660 Mode (DI) \ adr reg ind displaced indexed s.u.
|
||||
11 0770 Constant #) \ immediate address
|
||||
12 1771 Constant L#) \ immediate long address
|
||||
13 2772 Constant pcD) \ pc relative displaced
|
||||
14 3773 Constant (pcDI) \ pc relative displaced indexed
|
||||
15 4774 Constant # \ immediate data
|
||||
Screen 8 not modified
|
||||
0 \ fields and register assignments 08sep86we
|
||||
1
|
||||
2 | : Field Constant Does> @ and ;
|
||||
3 7000 | Field rd 0007 | Field rs
|
||||
4 0070 | Field ms 0077 | Field eas
|
||||
5 0377 | Field low
|
||||
6 | : dn? ( ea -- ea flag ) dup ms 0= ;
|
||||
7 | : src ( ea instr -- ea instr' ) over eas or ;
|
||||
8 | : dst ( ea instr -- ea instr' ) *swap rd or ;
|
||||
9
|
||||
10 | : ??dn ( mod -- mod ) dn? 0= abort" needs Data-Register" ;
|
||||
11 | : ??an ( mod -- mod ) dup ms 1 =
|
||||
12 abort" needs Adress-Register" ;
|
||||
13
|
||||
14 A6 Constant SP A5 Constant RP A4 Constant IP
|
||||
15 A3 Constant FP
|
||||
Screen 9 not modified
|
||||
0 \ extended addressing 09sep86we
|
||||
1 : DI) (DI) size @ *swap ;
|
||||
2 : pcDI) (pcDI) size @ *swap ;
|
||||
3
|
||||
4 | : double? ( mode -- flag) dup L#) = *swap
|
||||
5 # = long? and or ;
|
||||
6 | : index? ( {n} mode -- {m} mode )
|
||||
7 dup >r dup 0770 and A0 (DI) = *swap (pcDI) = or
|
||||
8 IF size @ >r size !
|
||||
9 dup rd 10 * *swap ms IF 100000 or THEN
|
||||
10 sz40 *swap low or r> size !
|
||||
11 THEN r> ;
|
||||
12
|
||||
13 | : more? ( ea -- ea flag ) dup ms 0040 > ;
|
||||
14 | : ,more ( ea -- ) more?
|
||||
15 IF index? double? ?, ELSE drop THEN ;
|
||||
Screen 10 not modified
|
||||
0 \ extended addressing extras 09sep86we
|
||||
1
|
||||
2 | Create extra here 5 dup allot erase \ temporary storage area
|
||||
3
|
||||
4 | : extra? ( {n} mode -- mode ) more?
|
||||
5 IF >r r@ index? double? extra 1+ *swap
|
||||
6 IF under ! 2+ ! 2 ELSE ! 1 THEN extra c! r>
|
||||
7 ELSE 0 extra !
|
||||
8 THEN ;
|
||||
9
|
||||
10 | : ,extra ( -- ) extra c@ ?dup
|
||||
11 IF extra 1+ *swap 1 =
|
||||
12 IF @ >, ELSE dup 2+ @ *swap @ 2, THEN extra 5 erase
|
||||
13 THEN ;
|
||||
14
|
||||
15
|
||||
Screen 11 not modified
|
||||
0 \ immediates & address register specific 15jan86we
|
||||
1 | : Imm Constant Does> @ >r extra? eas r> or
|
||||
2 sz3 >, long? ?, ,extra ; ( n ea)
|
||||
3 0000 Imm ori 1000 Imm andi
|
||||
4 2000 Imm subi 3000 Imm addi
|
||||
5 5000 Imm eori 6000 Imm cmpi
|
||||
6 | : Immsr Constant Does> @ sz3 2, ; ( n )
|
||||
7 001074 Immsr andi>sr
|
||||
8 005074 Immsr eori>sr
|
||||
9 000074 Immsr ori>sr
|
||||
10 | : Iq Constant Does> @ >r extra? eas *swap rs 1000 * or
|
||||
11 r> or sz3 >, ,extra ; ( n ea )
|
||||
12 050000 Iq addq 050400 Iq subq
|
||||
13 | : Ieaa Constant Does> @ dst src sz4 >, ,more ; ( ea an )
|
||||
14 150300 Ieaa adda 130300 Ieaa cmpa
|
||||
15 040700 Ieaa lea 110300 Ieaa suba
|
||||
Screen 12 not modified
|
||||
0 \ shifts, rotates, and bit manipulation 15jan86we
|
||||
1 | : Isr Constant Does> @ >r dn?
|
||||
2 IF *swap dn? IF r> 40 or >r ELSE drop *swap 1000 * THEN
|
||||
3 rd *swap rs or r> or 160000 or sz3 >,
|
||||
4 ELSE dup eas 300 or r@ 400 and or r> 70 and 100 * or
|
||||
5 160000 or >, ,more
|
||||
6 THEN ; ( dm dn ) ( m # dn ) ( ea )
|
||||
7 400 Isr asl 000 Isr asr
|
||||
8 410 Isr lsl 010 Isr lsr
|
||||
9 420 Isr roxl 020 Isr roxr
|
||||
10 430 Isr rol 030 Isr ror
|
||||
11 | : Ibit Constant does> @ >r extra? dn?
|
||||
12 IF rd src 400 ELSE drop dup eas 4000 THEN
|
||||
13 or r> or >, ,extra ,more ; ( ea dn ) ( ea n # )
|
||||
14 000 Ibit btst 100 Ibit bchg
|
||||
15 200 Ibit bclr 300 Ibit bset
|
||||
Screen 13 not modified
|
||||
0 \ branch, loop, and set conditionals 15jan86we
|
||||
1
|
||||
2 | : Setclass ' *swap 0 DO I over execute LOOP drop ;
|
||||
3 | : Ibra 400 * 060000 or Constant ( label )
|
||||
4 Does> @ *swap >here 2+ - dup abs 200 <
|
||||
5 IF low or >, ELSE *swap 2, THEN ;
|
||||
6 20 Setclass Ibra bra bsr bhi bls bcc bcs bne beq
|
||||
7 bvc bvs bpl bmi bge blt bgt ble
|
||||
8 | : Idbr 400 * 050310 or Constant ( label \ dn - )
|
||||
9 Does> @ *swap rs or >, >here - >, ;
|
||||
10 20 Setclass Idbr dxit dbra dbhi dbls dbcc dbcs dbne dbeq
|
||||
11 dbvc dbvs dbpl dbmi dbge dblt dbgt dble
|
||||
12 | : Iset 400 * 050300 or Constant ( ea )
|
||||
13 Does> @ src >, ,more ;
|
||||
14 20 Setclass Iset set sno shi sls scc scs sne seq
|
||||
15 svc svs spl smi sge slt sgt sle
|
||||
Screen 14 not modified
|
||||
0 \ moves 15jan86we
|
||||
1
|
||||
2 : move extra? 7700 and src sz300 >,
|
||||
3 ,more ,extra ; ( ea ea )
|
||||
4 : moveq ??dn rd *swap low or 070000 or >, ; ( n dn )
|
||||
5 : move>usp ??an rs 047140 or >, ; ( an )
|
||||
6 : move<usp ??an rs 047150 or >, ; ( an )
|
||||
7 : movem>
|
||||
8 extra? eas 044200 or -sz1 >, >, ,extra ; ( n ea )
|
||||
9 : movem<
|
||||
10 extra? eas 046200 or -sz1 >, >, ,extra ; ( n ea )
|
||||
11 : movep dn? IF rd *swap rs or 410 or
|
||||
12 ELSE rs rot rd or 610 or THEN -sz1 2, ;
|
||||
13 ( dm d an ) ( d an dm )
|
||||
14 : lmove 7700 and *swap eas or 20000 or >, ;
|
||||
15 ( long reg move )
|
||||
Screen 15 not modified
|
||||
0 \ odds and ends 15jan86we
|
||||
1
|
||||
2 : cmpm rd *swap rs or 130410 or sz3 >, ; ( an@+ am@+ )
|
||||
3 : exg dn? IF *swap dn? IF 140500 ELSE 140610 THEN >r
|
||||
4 ELSE *swap dn? IF 140610 ELSE 140510 THEN >r *swap
|
||||
5 THEN rs dst r> or >, ; ( rn rm )
|
||||
6 : ext ??dn rs 044200 or -sz1 >, ; ( dn )
|
||||
7 : swap ??dn rs 044100 or >, ; ( dn )
|
||||
8 : stop 47162 2, ; ( n )
|
||||
9 : trap 17 and 47100 or >, ; ( n )
|
||||
10 : link ??an rs 047120 or 2, ; ( n an )
|
||||
11 : unlk ??an rs 047130 or >, ; ( an )
|
||||
12 : eor extra? eas dst sz3 130400 or >, ,extra ; ( dn ea )
|
||||
13 : cmp ??dn 130000 dst src sz3 >, ,more ; ( ea dn )
|
||||
14
|
||||
15
|
||||
Screen 16 not modified
|
||||
0 \ arithmetic and logic 15jan86we
|
||||
1 | : Ibcd Constant Does> @ dst over rs or *swap ms
|
||||
2 IF 10 or THEN >, ; ( dn dm ) ( an@- am@- )
|
||||
3 140400 Ibcd abcd 100400 Ibcd sbcd
|
||||
4 | : Idd Constant Does> @ dst over rs or *swap ms
|
||||
5 IF 10 or THEN sz3 >, ; ( dn dm ) ( an@- am@- )
|
||||
6 150400 Idd addx 110400 Idd subx
|
||||
7 | : Idea Constant Does> @ >r dn? ( ea dn ) ( dn ea )
|
||||
8 IF rd src r> or sz3 >, ,more
|
||||
9 ELSE extra? eas dst 400 or r> or sz3 >, ,extra THEN ;
|
||||
10 150000 Idea add 110000 Idea sub
|
||||
11 140000 Idea and 100000 Idea or
|
||||
12 | : Iead Constant Does> @ >r ??dn r> dst src
|
||||
13 >, ,more ; ( ea dn)
|
||||
14 040600 Iead chk 100300 Iead divu 100700 Iead divs
|
||||
15 140300 Iead mulu 140700 Iead muls
|
||||
Screen 17 not modified
|
||||
0 \ arithmetic and control 15jan86we
|
||||
1
|
||||
2 | : Iea Constant Does> @ src >, ,more ; ( ea )
|
||||
3 047200 Iea jsr 047300 Iea jmp
|
||||
4 042300 Iea move>ccr
|
||||
5 040300 Iea move<sr 043300 Iea move>sr
|
||||
6 044000 Iea nbcd 044100 Iea pea
|
||||
7 045300 Iea tas
|
||||
8 | : Ieas Constant Does> @ src sz3 >, ,more ; ( ea )
|
||||
9 041000 Ieas clr 043000 Ieas not
|
||||
10 042000 Ieas neg 040000 Ieas negx
|
||||
11 045000 Ieas tst
|
||||
12 | : Icon Constant Does> @ >, ;
|
||||
13 47160 Icon reset 47161 Icon nop
|
||||
14 47163 Icon rte 47165 Icon rts
|
||||
15 47166 Icon trapv 47167 Icon rtr
|
||||
Screen 18 not modified
|
||||
0 \ structured conditionals +/- 256 bytes 15jan86we
|
||||
1 : THEN >here over 2+ - *swap 1+ >c! ;
|
||||
2 : IF >, >here 2- ; hex
|
||||
3 : ELSE 6000 IF *swap THEN ;
|
||||
4 : BEGIN >here ;
|
||||
5 : UNTIL >, >here - >here 1- >c! ;
|
||||
6 : AGAIN 6000 UNTIL ;
|
||||
7 : WHILE IF *swap ;
|
||||
8 : REPEAT AGAIN THEN ;
|
||||
9 : DO >here *swap ;
|
||||
10 : LOOP dbra ;
|
||||
11 6600 Constant 0= 6700 Constant 0<>
|
||||
12 6A00 Constant 0< 6B00 Constant 0>=
|
||||
13 6C00 Constant < 6D00 Constant >=
|
||||
14 6E00 Constant <= 6F00 Constant >
|
||||
15 6500 Constant CC 6400 Constant CS
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
Screen 0 not modified
|
||||
0 \ Crosscompile Script for 6502 Target cas 26jan06
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ loadscreen for cross-compiler cas 26jan06
|
||||
1
|
||||
2 include assemble.fb \ load 68000 assembler
|
||||
3 2 loadfrom as65.fb page \ load 6502 assembler
|
||||
4 include crostarg.fb page \ load target compiler
|
||||
5 include 6502f83.fb \ load Forth Kernel Source
|
||||
6
|
||||
7 save-target f6502.com \ save new forth as f6502.com
|
||||
8 key drop page .( Ready ) cr \ wait for keypress
|
||||
9 bye \ and exit forth
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
|
|
@ -0,0 +1,680 @@
|
|||
Screen 0 not modified
|
||||
0 \\ *** volksFORTH-84 Target-Compiler *** cas 26jan06
|
||||
1
|
||||
2 This Target Compiler can be used to create a new Forth System
|
||||
3 using the Sourcecode 6502F82.FB.
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ Target compiler loadscr 09sep86we
|
||||
1 \ Idea and first Implementation by ks/bp
|
||||
2 \ Implemented on 6502 by ks/bp
|
||||
3 \ ultraFORTH83-Version by bp/we
|
||||
4 \ Atari 520 ST - Version by we
|
||||
5 Onlyforth Assembler nonrelocate
|
||||
6 07 Constant imagepage \ Virtual memory bank
|
||||
7 Vocabulary Ttools
|
||||
8 Vocabulary Defining
|
||||
9 : .stat .blk .s ; ' .stat Is .status
|
||||
10 \ : 65( [compile] ( ; immediate
|
||||
11 : 65( ; immediate : ) ; immediate \ cpu-addressing|lbyte|hbyte|
|
||||
12 1 $14 +thru \ Target compiler
|
||||
13 $15 $17 +thru \ Target Tools
|
||||
14 $18 $1A +thru \ Redefinitions
|
||||
15 save $1B $24 +thru \ Predefinitions
|
||||
Screen 2 not modified
|
||||
0 \ Target header pointers bp05mar86we
|
||||
1
|
||||
2 Variable tdp : there tdp @ ;
|
||||
3 Variable displace
|
||||
4 Variable ?thead 0 ?thead !
|
||||
5 Variable tlast 0 tlast !
|
||||
6 Variable glast' 0 glast' !
|
||||
7 Variable tdoes>
|
||||
8 Variable >in:
|
||||
9 Variable tvoc 0 tvoc !
|
||||
10 Variable tvoc-link 0 tvoc-link !
|
||||
11 Variable tnext-link 0 tnext-link !
|
||||
12
|
||||
13 : c+! ( 8b addr -- ) dup c@ rot + swap c! ;
|
||||
14
|
||||
15
|
||||
Screen 3 not modified
|
||||
0 \ Image and byteorder 15sep86we
|
||||
1
|
||||
2 : >image ( addr1 - addr2 ) displace @ - ;
|
||||
3
|
||||
4 : >heap ( from quan - )
|
||||
5 heap over - 1 and + \ 68000-align
|
||||
6 dup hallot heap swap cmove ;
|
||||
7 \\
|
||||
8 : >ascii 2drop ; ' noop Alias C64>ascii
|
||||
9
|
||||
10 Code Lc@ ( laddr -- 8b )
|
||||
11 .l SP )+ A0 move .w D0 clr .b A0 ) D0 move
|
||||
12 .w D0 SP -) move Next end-code
|
||||
13 Code Lc! ( 8b addr -- )
|
||||
14 .l SP )+ A0 move .w SP )+ D0 move .b D0 A0 ) move
|
||||
15 Next end-code
|
||||
Screen 4 not modified
|
||||
0 \ Ghost-creating 05mar86we
|
||||
1
|
||||
2 0 | Constant <forw> 0 | Constant <res>
|
||||
3
|
||||
4 | : Make.ghost ( - cfa.ghost )
|
||||
5 here dup 1 and allot here
|
||||
6 state @ IF context @ ELSE current THEN @
|
||||
7 dup @ , name
|
||||
8 dup c@ 1 $1F uwithin not abort" inval.Gname"
|
||||
9 dup c@ 1+ over c!
|
||||
10 c@ dup 1+ allot 1 and 0= IF bl c, THEN
|
||||
11 here 2 pick - -rot
|
||||
12 <forw> , 0 , 0 ,
|
||||
13 swap here over - >heap
|
||||
14 heap swap ! swap dp !
|
||||
15 heap + ;
|
||||
Screen 5 not modified
|
||||
0 \ ghost words 05mar86we
|
||||
1
|
||||
2 : gfind ( string - cfa tf / string ff )
|
||||
3 dup count + 1+ bl swap c!
|
||||
4 dup >r 1 over c+! find -1 r> c+! ;
|
||||
5
|
||||
6 : ghost ( - cfa )
|
||||
7 >in @ name gfind IF nip exit THEN
|
||||
8 drop >in ! Make.ghost ;
|
||||
9
|
||||
10 : Word, ghost execute ;
|
||||
11
|
||||
12 : gdoes> ( cfa.ghost - cfa.does )
|
||||
13 4+ dup @ IF @ exit THEN
|
||||
14 here dup <forw> , 0 , 4 >heap
|
||||
15 dp ! heap dup rot ! ;
|
||||
Screen 6 not modified
|
||||
0 \ ghost utilities 04dec85we
|
||||
1
|
||||
2 : g' name gfind 0= abort" ?" ;
|
||||
3
|
||||
4 : '.
|
||||
5 g' dup @ <forw> case?
|
||||
6 IF ." forw" ELSE <res> - abort" ??" ." res" THEN
|
||||
7 2+ dup @ 5 u.r
|
||||
8 2+ @ ?dup
|
||||
9 IF dup @ <forw> case?
|
||||
10 IF ." fdef" ELSE <res> - abort" ??" ." rdef" THEN
|
||||
11 2+ @ 5 u.r THEN ;
|
||||
12
|
||||
13 ' ' Alias h'
|
||||
14
|
||||
15
|
||||
Screen 7 not modified
|
||||
0 \ .unresolved 05mar86we
|
||||
1
|
||||
2 | : forward? ( cfa - cfa / exit&true )
|
||||
3 dup @ <forw> = over 2+ @ and IF drop true rdrop exit THEN ;
|
||||
4
|
||||
5 | : unresolved? ( addr - f )
|
||||
6 2+ dup c@ $1F and over + c@ BL =
|
||||
7 IF name> forward? 4+ @ dup IF forward? THEN
|
||||
8 THEN drop false ;
|
||||
9
|
||||
10 | : unresolved-words
|
||||
11 BEGIN @ ?dup WHILE dup unresolved?
|
||||
12 IF dup 2+ .name ?cr THEN REPEAT ;
|
||||
13
|
||||
14 : .unresolved voc-link @
|
||||
15 BEGIN dup 4- unresolved-words @ ?dup 0= UNTIL ;
|
||||
Screen 8 not modified
|
||||
0 \ Extending Vocabularys for Target-Compilation 05mar86we
|
||||
1
|
||||
2 : Vocabulary Vocabulary 0 , here tvoc @ , tvoc ! ;
|
||||
3
|
||||
4 Vocabulary Transient 0 tvoc !
|
||||
5
|
||||
6 Only definitions Forth also
|
||||
7
|
||||
8 : T Transient ; immediate
|
||||
9 : H Forth ; immediate
|
||||
10
|
||||
11 definitions
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 9 not modified
|
||||
0 \ Transient primitives 05mar86we
|
||||
1
|
||||
2 Code byte> ( 8bh 8bl -- 16b )
|
||||
3 SP )+ D1 move SP ) D0 move 8 # D0 lsl .b D1 D0 move
|
||||
4 .w D0 SP ) move Next end-code
|
||||
5 Code >byte ( 16b -- 8bl 8bh )
|
||||
6 SP )+ D0 move D0 D1 move $FF D0 andi 8 # D1 lsr
|
||||
7 D0 SP -) move D1 SP -) move Next end-code
|
||||
8
|
||||
9 Transient definitions
|
||||
10 : c@ H >image imagepage lc@ ;
|
||||
11 : c! H >image imagepage lc! ;
|
||||
12 : @ dup T c@ swap 1+ T c@ 65( swap ) byte> ;
|
||||
13 : ! >r >byte 65( swap ) r@ T c! r> 1+ T c! ;
|
||||
14 : cmove ( from.mem to.target quan -)
|
||||
15 bounds ?DO dup H c@ I T c! H 1+ LOOP drop ;
|
||||
Screen 10 not modified
|
||||
0 \ Transient primitives bp05mar86we
|
||||
1
|
||||
2 : here there ;
|
||||
3 : allot Tdp +! ;
|
||||
4 : c, T here c! 1 allot H ;
|
||||
5 : , T here ! 2 allot H ;
|
||||
6
|
||||
7 : ," Ascii " parse dup T c,
|
||||
8 under there swap cmove
|
||||
9 .( dup 1 and 0= IF 1+ THEN ) allot H ;
|
||||
10
|
||||
11 : fill ( addr quan 8b -)
|
||||
12 -rot bounds ?DO dup I T c! H LOOP drop ;
|
||||
13 : erase 0 T fill ;
|
||||
14 : blank bl T fill ;
|
||||
15 : here! H Tdp ! ;
|
||||
Screen 11 not modified
|
||||
0 \ Resolving 08dec85we
|
||||
1 Forth definitions
|
||||
2 : resolve ( cfa.ghost cfa.target -)
|
||||
3 over dup @ <res> =
|
||||
4 IF space dup >name .name ." exists " ?cr 2+ ! drop exit THEN
|
||||
5 >r >r 2+ @ ?dup
|
||||
6 IF BEGIN dup T @ H 2dup = abort" resolve loop" r@ rot T !
|
||||
7 H ?dup 0= UNTIL
|
||||
8 THEN r> r> <res> over ! 2+ ! ;
|
||||
9
|
||||
10 : resdoes> ( cfa.ghost cfa.target -)
|
||||
11 swap gdoes> dup @ <res> = IF 2+ ! exit THEN swap resolve ;
|
||||
12 ] Does> [ here 4- 0 ] dup @ there rot ! T , H ;
|
||||
13 ' <forw> >body !
|
||||
14 ] Does> [ here 4- 0 ] @ T , H ;
|
||||
15 ' <res> >body !
|
||||
Screen 12 not modified
|
||||
0 \ move-threads 68000-align cas 26jan06
|
||||
1
|
||||
2 : move-threads Tvoc @ Tvoc-link @
|
||||
3 BEGIN over ?dup
|
||||
4 WHILE 2- @ over 2- T ! @ H swap @ swap REPEAT
|
||||
5 error" some undef. Target-Vocs left" drop ;
|
||||
6
|
||||
7 | : tlatest ( - addr) current @ 6 + ;
|
||||
8
|
||||
9 \\
|
||||
10 not used for the 6502 architecture
|
||||
11
|
||||
12 | : 68000-talign ( cfa -- ) 1 and IF 1 T allot H THEN ;
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 13 not modified
|
||||
0 \ save-target 09sep86we
|
||||
1
|
||||
2 Dos definitions
|
||||
3
|
||||
4 Code (filewrite ( buff len handle -- n)
|
||||
5 SP )+ D0 move .l D2 clr .w SP )+ D2 move
|
||||
6 .l 0 imagepage # D1 move .w SP )+ D1 move
|
||||
7 .l D1 A7 -) move \ buffer adress
|
||||
8 .l D2 A7 -) move \ buffer length
|
||||
9 .w D0 A7 -) move \ handle
|
||||
10 $40 # A7 -) move \ call WRITE
|
||||
11 1 trap $0C # A7 adda
|
||||
12 .w D0 SP -) move Next end-code Forth definitions
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 14 not modified
|
||||
0 \ save Target-System 09sep86we
|
||||
1
|
||||
2 : save-target [ Dos ]
|
||||
3 bl word count dup 0= abort" missing filename"
|
||||
4 over + off (createfile dup >r 0< abort" no device "
|
||||
5 T here $1C - 4 ! 0 , 0 , H [ Dos ] \ Programm header
|
||||
6 0 there r@ (filewrite there - abort" write error"
|
||||
7 r> (closefile 0< abort" close error" ;
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 15 not modified
|
||||
0 \\ 6502-ALIGN ?HEAD \ 08SEP84BP)
|
||||
1
|
||||
2 | : 6502-align/1 ( adr -- adr' ) dup 0FF and 0FF = - ;
|
||||
3
|
||||
4
|
||||
5 | : 6502-align/2 ( lfa -- lfa )
|
||||
6 there 0FF and 0FF =
|
||||
7 IF dup dup 1+ there over - 1+ cmove> \ lfa now invalid
|
||||
8 1 tlast +! 1 tallot THEN ;
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 16 not modified
|
||||
0 \\ WARNING CREATE 30DEC84BP)
|
||||
1
|
||||
2 VARIABLE WARNING 0 WARNING !
|
||||
3
|
||||
4 | : EXISTS?
|
||||
5 WARNING @ ?EXIT
|
||||
6 LAST @ CURRENT @ (FIND NIP
|
||||
7 IF SPACE LAST @ .NAME ." EXISTS " ?CR THEN ;
|
||||
8
|
||||
9 : CREATE HERE BLK @ , CURRENT @ @ ,
|
||||
10 NAME C@ DUP 1 020 UWITHIN NOT ABORT" INVALID NAME"
|
||||
11 HERE LAST ! 1+ ALLOT EXISTS? ?HEAD @
|
||||
12 IF 1 ?HEAD +! DUP 6502-ALIGN/1 , \ POINTER TO CODE
|
||||
13 HEAPMOVE 020 FLAG! 6502-ALIGN/1 DP !
|
||||
14 ELSE 6502-ALIGN/2 DROP THEN REVEAL 0 ,
|
||||
15 ;CODE DOCREATE JMP END-CODE
|
||||
Screen 17 not modified
|
||||
0 \ compiling names into targ. 05mar86we
|
||||
1
|
||||
2 : (theader
|
||||
3 ?thead @ IF 1 ?thead +!
|
||||
4 there $FF and $FF = IF 1 T allot H THEN exit THEN
|
||||
5 >in @ name swap >in !
|
||||
6 dup c@ 1 $20 uwithin not abort" inval. Tname"
|
||||
7 dup c@ 3 + there + $FF and $FF =
|
||||
8 there 2+ $FF and $FF = or IF 1 T allot H THEN
|
||||
9 blk @ T , H there tlatest dup @ T , H ! there dup tlast !
|
||||
10 over c@ 1+ .( even ) dup T allot cmove H ;
|
||||
11
|
||||
12 : Theader tlast off
|
||||
13 (theader Ghost dup glast' !
|
||||
14 there resolve ;
|
||||
15
|
||||
Screen 18 not modified
|
||||
0 \ prebuild defining words bp27jun85we
|
||||
1
|
||||
2 | : executable? ( adr - adr f ) dup ;
|
||||
3 | : tpfa, there , ;
|
||||
4 | : (prebuild ( cfa.adr -- )
|
||||
5 >in @ Create >in ! here 2- ! ;
|
||||
6
|
||||
7 : prebuild ( adr 0.from.: - 0 )
|
||||
8 0 ?pairs executable? dup >r
|
||||
9 IF [compile] Literal compile (prebuild ELSE drop THEN
|
||||
10 compile Theader Ghost gdoes> ,
|
||||
11 r> IF compile tpfa, THEN 0 ; immediate restrict
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 19 not modified
|
||||
0 \ code portion of def.words bp11sep86we
|
||||
1
|
||||
2 : dummy 0 ;
|
||||
3
|
||||
4 : DO> ( - adr.of.jmp.dodoes> 0 )
|
||||
5 [compile] Does> here 4- compile @ 0 ] ;
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 20 not modified
|
||||
0 \ the 68000 Assembler 11sep86we
|
||||
1
|
||||
2 Forth definitions
|
||||
3 | Create relocate ] T c, , c@ here allot ! c! H [
|
||||
4
|
||||
5 Transient definitions
|
||||
6
|
||||
7 : Assembler H [ Tassembler ] relocate >codes ! Tassembler ;
|
||||
8 : >label ( 16b -) H >in @ name gfind rot >in !
|
||||
9 IF over resolve dup THEN drop Constant ;
|
||||
10 : Label T .( here 1 and allot ) here >label Assembler H ;
|
||||
11 : Code H Theader there 2+ T , Assembler H ;
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 21 not modified
|
||||
0 \ immed. restr. ' \ compile bp05mar86we
|
||||
1
|
||||
2 : ?pairs ( n1 n2 -- ) H - abort" unstructured" ;
|
||||
3 : >mark ( - addr ) H there T 0 , H ;
|
||||
4 : >resolve ( addr - ) H there over - swap T ! H ;
|
||||
5 : <mark ( - addr ) H there ;
|
||||
6 : <resolve ( addr - ) H there - T , H ;
|
||||
7 : immediate H Tlast @ ?dup
|
||||
8 IF dup T c@ $40 or swap c! H THEN ;
|
||||
9 : restrict H Tlast @ ?dup
|
||||
10 IF dup T c@ $80 or swap c! H THEN ;
|
||||
11 : ' ( <name> - cfa ) H g' dup @ <res> - abort" ?" 2+ @ ;
|
||||
12 : | H ?thead @ ?exit ?thead on ;
|
||||
13 : compile H Ghost , ; immediate restrict
|
||||
14
|
||||
15
|
||||
Screen 22 not modified
|
||||
0 \ Target tools ks05mar86we
|
||||
1
|
||||
2 Onlyforth Ttools also definitions
|
||||
3
|
||||
4 | : ttype ( adr n -) bounds ?DO I T c@ H dup
|
||||
5 bl > IF emit ELSE drop Ascii . emit THEN LOOP ;
|
||||
6 : .name ( nfa -) ?dup IF dup 1+ swap T c@ H $1F and ttype
|
||||
7 ELSE ." ??? " THEN space ?cr ;
|
||||
8 | : nfa? ( cfa lfa - nfa / cfa ff)
|
||||
9 BEGIN dup WHILE 2dup 2+ dup T c@ H $1F and + 1+ .( even ) =
|
||||
10 IF 2+ nip exit THEN
|
||||
11 T @ H REPEAT ;
|
||||
12 : >name ( cfa - nfa / ff)
|
||||
13 Tvoc BEGIN @ dup WHILE under 2- @ nfa? ?dup
|
||||
14 IF nip exit THEN
|
||||
15 swap REPEAT nip ;
|
||||
Screen 23 not modified
|
||||
0 \ Ttools for decompiling ks05mar86we
|
||||
1
|
||||
2 | : ?: dup 4 u.r ." :" ;
|
||||
3 | : @? dup T @ H 6 u.r ;
|
||||
4 | : c? dup T c@ H 3 .r ;
|
||||
5
|
||||
6 : s ( addr - addr+ ) ?: space c? 3 spaces
|
||||
7 dup 1+ over T c@ H ttype dup T c@ H + 1+ ;
|
||||
8
|
||||
9 : n ( addr - addr+2 ) ?: @? 2 spaces
|
||||
10 dup T @ H [ Ttools ] >name .name H 2+ ;
|
||||
11
|
||||
12 : d ( addr n - addr+n ) 2dup swap ?: swap 0 DO c? 1+ LOOP
|
||||
13 2 spaces -rot ttype ;
|
||||
14
|
||||
15
|
||||
Screen 24 not modified
|
||||
0 \ Tools for decompiling bp05mar86we
|
||||
1
|
||||
2 : l ( addr -- addr+2 ) ?: 5 spaces @? 2+ ;
|
||||
3
|
||||
4 : c ( addr -- addr+1 ) 1 d ;
|
||||
5
|
||||
6 : b ( addr -- addr+1 ) ?: @? dup T @ H over + 5 u.r 2+ ;
|
||||
7
|
||||
8 : dump ( adr n -) bounds ?DO cr I $10 d drop
|
||||
9 stop? IF LEAVE THEN $10 +LOOP ;
|
||||
10
|
||||
11 : view T ' H [ Ttools ] >name ?dup
|
||||
12 IF 4- T @ H l THEN ;
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 25 not modified
|
||||
0 \ reinterpretation def.-words 05mar86we
|
||||
1
|
||||
2 Onlyforth
|
||||
3
|
||||
4 : redefinition
|
||||
5 tdoes> @ IF >in push [ ' >interpret >body ] Literal push
|
||||
6 state push context push >in: @ >in !
|
||||
7 name [ ' Transient 2+ ] Literal (find nip 0=
|
||||
8 IF cr ." Redefinition: " here .name
|
||||
9 >in: @ >in ! : Defining interpret THEN
|
||||
10 THEN 0 tdoes> ! ;
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 26 not modified
|
||||
0 \ Create..does> structure bp05mar86we
|
||||
1
|
||||
2 | : (;tcode
|
||||
3 Tlast @ dup T c@ .( dup 1 and - ) 1+ + ! H rdrop ;
|
||||
4 | : changecfa compile lit tdoes> @ , compile (;tcode ;
|
||||
5
|
||||
6 Defining definitions
|
||||
7
|
||||
8 : ;code 0 ?pairs changecfa reveal rdrop ;
|
||||
9 immediate restrict
|
||||
10
|
||||
11 Defining ' ;code Alias does> immediate restrict
|
||||
12
|
||||
13 : ; [compile] ; rdrop ; immediate restrict
|
||||
14
|
||||
15
|
||||
Screen 27 not modified
|
||||
0 \ redefinition conditionals bp27jun85we
|
||||
1
|
||||
2 ' DO Alias DO immediate restrict
|
||||
3 ' ?DO Alias ?DO immediate restrict
|
||||
4 ' LOOP Alias LOOP immediate restrict
|
||||
5 ' IF Alias IF immediate restrict
|
||||
6 ' THEN Alias THEN immediate restrict
|
||||
7 ' ELSE Alias ELSE immediate restrict
|
||||
8 ' BEGIN Alias BEGIN immediate restrict
|
||||
9 ' UNTIL Alias UNTIL immediate restrict
|
||||
10 ' WHILE Alias WHILE immediate restrict
|
||||
11 ' REPEAT Alias REPEAT immediate restrict
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 28 not modified
|
||||
0 \ clear Liter. Ascii ['] ." bp05mar86we
|
||||
1
|
||||
2 Onlyforth Transient definitions
|
||||
3
|
||||
4 : clear true abort" There are ghosts" ;
|
||||
5 : Literal ( n -) T compile lit , H ; immediate
|
||||
6 : Ascii H bl word 1+ c@ state @
|
||||
7 IF T [compile] Literal H THEN ; immediate
|
||||
8 : ['] T ' [compile] Literal H ; immediate restrict
|
||||
9 : " T compile (" ," H ; immediate restrict
|
||||
10 : ." T compile (." ," H ; immediate restrict
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 29 not modified
|
||||
0 \ Target compilation ] [ bp05mar86we
|
||||
1
|
||||
2 Forth definitions
|
||||
3
|
||||
4 : tcompile
|
||||
5 ?stack >in @ name find ?dup
|
||||
6 IF 0> IF nip execute >interpret THEN
|
||||
7 drop dup >in ! name
|
||||
8 THEN gfind IF nip execute >interpret THEN
|
||||
9 nullstring? IF drop exit THEN
|
||||
10 number? ?dup IF 0> IF swap T [compile] Literal THEN
|
||||
11 [compile] Literal H drop >interpret THEN
|
||||
12 drop >in ! Word, >interpret ;
|
||||
13
|
||||
14 Transient definitions
|
||||
15 : ] H state on ['] tcompile is >interpret ;
|
||||
Screen 30 not modified
|
||||
0 \ Target conditionals bp05mar86we
|
||||
1
|
||||
2 : IF T compile ?branch >mark H 1 ; immediate restrict
|
||||
3 : THEN abs 1 T ?pairs >resolve H ; immediate restrict
|
||||
4 : ELSE T 1 ?pairs compile branch >mark swap >resolve
|
||||
5 H -1 ; immediate restrict
|
||||
6 : BEGIN T <mark H 2 ; immediate restrict
|
||||
7 : WHILE T 2 ?pairs 2 compile ?branch >mark -2 H 2swap ;
|
||||
8 immediate restrict
|
||||
9 | : (repeat T 2 ?pairs <resolve H BEGIN dup -2 =
|
||||
10 WHILE drop T >resolve H REPEAT ;
|
||||
11 : UNTIL T compile ?branch (repeat H ; immediate restrict
|
||||
12 : REPEAT T compile branch (repeat H ; immediate restrict
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 31 not modified
|
||||
0 \ Target conditionals bp27jun85we
|
||||
1
|
||||
2 : DO T compile (do >mark H 3 ; immediate restrict
|
||||
3 : ?DO T compile (?do >mark H 3 ; immediate restrict
|
||||
4 : LOOP T 3 ?pairs compile (loop compile endloop
|
||||
5 >resolve H ; immediate restrict
|
||||
6 : +LOOP T 3 ?pairs compile (+loop compile endloop
|
||||
7 >resolve H ; immediate restrict
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 32 not modified
|
||||
0 \ predefinitions bp05mar86we
|
||||
1
|
||||
2 : abort" T compile (abort" ," H ; immediate
|
||||
3 : error" T compile (err" ," H ; immediate
|
||||
4
|
||||
5 Forth definitions
|
||||
6
|
||||
7 Variable torigin
|
||||
8 Variable tudp 0 Tudp !
|
||||
9
|
||||
10 : >user T c@ H torigin @ + ;
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 33 not modified
|
||||
0 \ Datatypes bp05mar86we
|
||||
1
|
||||
2 Transient definitions
|
||||
3 : origin! H torigin ! ;
|
||||
4 : user' ( -- n ) T ' >body c@ H ;
|
||||
5 : uallot ( n -- ) H tudp @ swap tudp +! ;
|
||||
6
|
||||
7 DO> >user ;
|
||||
8 : User prebuild User 2 T uallot c, ;
|
||||
9
|
||||
10 DO> ;
|
||||
11 : Create prebuild Create ;
|
||||
12
|
||||
13 DO> T @ H ;
|
||||
14 : Constant prebuild Constant T , ;
|
||||
15 : Variable Create 2 T allot ;
|
||||
Screen 34 not modified
|
||||
0 \ Datatypes bp05mar86we
|
||||
1
|
||||
2 dummy
|
||||
3 : Vocabulary
|
||||
4 H >in @ Vocabulary >in ! T prebuild Vocabulary 0 , 0 ,
|
||||
5 here H tvoc-link @ T , H tvoc-link ! ;
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 35 not modified
|
||||
0 \ target defining words bp08sep86we
|
||||
1
|
||||
2 Do> ;
|
||||
3 : Defer prebuild Defer 2 T allot ;
|
||||
4 : Is T ' H >body state @ IF T compile (is , H
|
||||
5 ELSE T ! H THEN ; immediate
|
||||
6 | : dodoes> T compile (;code H Glast' @
|
||||
7 there resdoes> there tdoes> ! ;
|
||||
8
|
||||
9 : ;code 0 T ?pairs dodoes> Assembler H [compile] [
|
||||
10 redefinition ; immediate restrict
|
||||
11
|
||||
12 : does> T dodoes> $04C C,
|
||||
13 compile (dodoes> H ; immediate restrict
|
||||
14
|
||||
15
|
||||
Screen 36 not modified
|
||||
0 \ : Alias ; bp25mar86we
|
||||
1
|
||||
2 : Create: T Create H current @ context ! T ] H 0 ;
|
||||
3
|
||||
4 dummy
|
||||
5 : : H tdoes> off >in @ >in: ! T prebuild :
|
||||
6 H current @ context ! T ] H 0 ;
|
||||
7
|
||||
8 : Alias ( n -- ) H Tlast off (theader Ghost over resolve
|
||||
9 tlast @ T c@ H $20 or tlast @ T c! , H ;
|
||||
10
|
||||
11 : ; T 0 ?pairs compile exit .( unnest gegen exit getauscht)
|
||||
12 [compile] [ H redefinition ; immediate restrict
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 37 not modified
|
||||
0 \ predefinitions bp11sep86we
|
||||
1
|
||||
2 : compile T compile compile H ; immediate restrict
|
||||
3 : Host H Onlyforth Ttools also ;
|
||||
4 : Compiler T Host H Transient also definitions ;
|
||||
5 : [compile] H Word, ; immediate restrict
|
||||
6 : Onlypatch H there 3 - 0 tdoes> ! 0 ;
|
||||
7
|
||||
8 Onlyforth
|
||||
9 : Target Onlyforth Transient also definitions ;
|
||||
10
|
||||
11 Transient definitions
|
||||
12 Ghost c, drop
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 38 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 39 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
|
|
@ -0,0 +1,187 @@
|
|||
Screen 0 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ loadscreen for system IO for Apple1 cas2013apr05
|
||||
1
|
||||
2
|
||||
3 1 9 +thru
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 2 not modified
|
||||
0 \ 65KEY? GETKEY cas2013apr05
|
||||
1 | $D010 Constant KBDDTA
|
||||
2 | $D011 Constant KBDCTL
|
||||
3
|
||||
4 | CODE 65KEY? ( -- FLAG) KBDCTL lda 0>= ?[ 0 # lda ][ 1 # lda ]?
|
||||
5 push0a jmp end-code
|
||||
6
|
||||
7 | CODE GETKEY ( -- 8B) KBDDTA lda $7F # AND
|
||||
8 push0a jmp end-code
|
||||
9
|
||||
10 | CODE CURON ( --) NEXT JMP END-CODE
|
||||
11
|
||||
12 | CODE CUROFF ( --) NEXT JMP END-CODE
|
||||
13
|
||||
14 : 65KEY ( -- 8B)
|
||||
15 CURON BEGIN PAUSE 65KEY? UNTIL CUROFF GETKEY ;
|
||||
Screen 3 not modified
|
||||
0 \ DECODE EXPECT KEYBOARD BP28MAY85) cs08aug05
|
||||
1 08 CONSTANT #BS $0D CONSTANT #CR &27 CONSTANT #ESC
|
||||
2
|
||||
3 : 65DECODE ( ADDR CNT1 KEY -- ADDR CNT2)
|
||||
4 #BS CASE? IF DUP IF DEL 1- THEN EXIT THEN
|
||||
5 #CR CASE? IF DUP SPAN ! EXIT THEN
|
||||
6 >R 2DUP + R@ SWAP C! R> EMIT 1+ ;
|
||||
7
|
||||
8 : 65EXPECT ( ADDR LEN1 -- ) SPAN ! 0
|
||||
9 BEGIN DUP SPAN @ U<
|
||||
10 WHILE KEY DECODE
|
||||
11 REPEAT 2DROP SPACE ;
|
||||
12
|
||||
13 INPUT: KEYBOARD [ HERE INPUT ! ]
|
||||
14 65KEY 65KEY? 65DECODE 65EXPECT [
|
||||
15
|
||||
Screen 4 not modified
|
||||
0 \ senden? (emit 65emit 25JAN85RE) cas2013apr05
|
||||
1
|
||||
2 | $D012 Constant DSP
|
||||
3
|
||||
4 | Code send? ( -- flg )
|
||||
5 DSP lda $80 # AND $80 # EOR push0a jmp end-code
|
||||
6
|
||||
7 Code (emit ( 8b -- )
|
||||
8 SP X) LDA DSP sta (drop jmp end-code
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 5 not modified
|
||||
0 \ EMIT CR DEL PAGE AT AT? 25JAN85RE) cas2013apr05
|
||||
1
|
||||
2 | Variable out 0 out ! | &40 Constant c/row
|
||||
3
|
||||
4 : 65emit ( 8b -- ) BEGIN pause send? UNTIL 1 out +! (emit ;
|
||||
5
|
||||
6 : 65CR #CR 65emit out @ c/row / 1+ c/row * out ! ;
|
||||
7
|
||||
8 : 65DEL ASCII _ 65emit -1 out +! ;
|
||||
9
|
||||
10 : 65PAGE &24 0 DO CR LOOP out off ;
|
||||
11
|
||||
12 : 65at ( row col -- ) .( at einf. ) swap c/row * + out ! ;
|
||||
13
|
||||
14 : 65AT? ( -- ROW COL ) out @ c/row /mod &24 min swap ;
|
||||
15
|
||||
Screen 6 not modified
|
||||
0 \ er14dez88
|
||||
1
|
||||
2 : 65type ( adr len -- ) bounds ?DO I c@ emit LOOP ;
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 7 not modified
|
||||
0 \ TYPE DISPLAY (BYE BP 28MAY85RE) er14dez88
|
||||
1
|
||||
2 OUTPUT: DISPLAY [ HERE OUTPUT ! ]
|
||||
3 65EMIT 65CR 65TYPE 65DEL 65PAGE 65AT 65AT? [
|
||||
4
|
||||
5
|
||||
6 | : (bye ;
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 8 not modified
|
||||
0 \ B/BLK DRIVE >DRIVE DRVINIT 28MAY85RE) er14dez88
|
||||
1
|
||||
2 $400 CONSTANT B/BLK
|
||||
3
|
||||
4 $0AA CONSTANT BLK/DRV
|
||||
5
|
||||
6 | VARIABLE (DRV 0 (DRV !
|
||||
7
|
||||
8 | : DISK ( -- DEV.NO ) (DRV @ 8 + ;
|
||||
9
|
||||
10 : DRIVE ( DRV# -- ) BLK/DRV * OFFSET ! ;
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 9 not modified
|
||||
0 \ er14dez88
|
||||
1 : >DRIVE ( BLOCK DRV# -- BLOCK' )
|
||||
2 BLK/DRV * + OFFSET @ - ;
|
||||
3 : DRV? ( BLOCK -- DRV# )
|
||||
4 OFFSET @ + BLK/DRV / ;
|
||||
5
|
||||
6 : DRVINIT NOOP ;
|
||||
7 .( fuer reads. u. writes. ist errorhandler erforderlich )
|
||||
8 | : readserial ( adr blk -- )
|
||||
9 &27 emit .( rb ) space base push decimal . cr
|
||||
10 $400 bounds DO key I c! LOOP ;
|
||||
11
|
||||
12 | : writeserial ( adr blk -- )
|
||||
13 &27 emit .( wb ) space base push decimal . cr
|
||||
14 $400 bounds DO I c@ emit LOOP ;
|
||||
15
|
||||
Screen 10 not modified
|
||||
0 \ (r/w er14decas
|
||||
1
|
||||
2 : (R/W ( ADR BLK FILE R/WF -- FLAG)
|
||||
3 swap abort" no file"
|
||||
4 IF readserial ELSE writeserial THEN false ;
|
||||
5
|
||||
6 ' (R/W IS R/W
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
|
|
@ -0,0 +1,170 @@
|
|||
Screen 0 not modified
|
||||
0 \ Multitasking Extension to volksFORTH cas 26jan06
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ Tasker Loadscreen
|
||||
1
|
||||
2 \NEEDS CODE abort( Assembler needed )
|
||||
3 hex
|
||||
4 1 5 +thru \ load Tasker
|
||||
5 7 load \ Task-Demo
|
||||
6 decimal
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 2 not modified
|
||||
0 \ MULTITASKER BP 13.9.84 )
|
||||
1
|
||||
2 CODE STOP
|
||||
3 SP 2DEC IP LDA SP X) STA IP 1+ LDA SP )Y STA
|
||||
4 SP 2DEC RP LDA SP X) STA RP 1+ LDA SP )Y STA
|
||||
5 6 # LDY SP LDA UP )Y STA INY SP 1+ LDA UP )Y STA
|
||||
6 1 # LDY TYA CLC UP ADC W STA
|
||||
7 TXA UP 1+ ADC W 1+ STA W 1- JMP END-CODE
|
||||
8
|
||||
9 | CREATE TASKPAUSE ASSEMBLER
|
||||
10 2C # LDA UP X) STA ' STOP @ JMP END-CODE
|
||||
11
|
||||
12 : SINGLETASK [ ' PAUSE @ ] LITERAL ['] PAUSE ! ;
|
||||
13
|
||||
14 : MULTITASK TASKPAUSE ['] PAUSE ! ;
|
||||
15
|
||||
Screen 3 not modified
|
||||
0 \ PASS ACTIVATE KS 8 MAY 84 )
|
||||
1
|
||||
2 : PASS ( N0 .. NR-1 TADR R -- )
|
||||
3 BEGIN [ ROT ( TRICK ! ) ]
|
||||
4 SWAP 02C OVER C! \ AWAKE TASK
|
||||
5 R> -ROT \ IP R ADDR
|
||||
6 8 + >R \ S0 OF TASK
|
||||
7 R@ 2+ @ SWAP \ IP R0 R
|
||||
8 2+ 2* \ BYTES ON TASKSTACK
|
||||
9 \ INCL. R0 & IP
|
||||
10 R@ @ OVER - \ NEW SP
|
||||
11 DUP R> 2- ! \ INTO SSAVE
|
||||
12 SWAP BOUNDS ?DO I ! 2 +LOOP ; RESTRICT
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 4 not modified
|
||||
0 \
|
||||
1
|
||||
2 : ACTIVATE ( TADR --)
|
||||
3 0 [ -ROT ( TRICK ! ) ] REPEAT ; -2 ALLOT RESTRICT
|
||||
4
|
||||
5 : SLEEP ( TADR --) 4C SWAP C! ; \ JMP-OPCODE
|
||||
6
|
||||
7 : WAKE ( TADR --) 2C SWAP C! ; \ BIT-OPCODE
|
||||
8
|
||||
9 | : TASKERROR ( STRING -)
|
||||
10 STANDARDI/O SINGLETASK ." TASK ERROR : " COUNT TYPE
|
||||
11 MULTITASK STOP ;
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 5 not modified
|
||||
0 \ BUILDING A TASK BP 13.9.84 )
|
||||
1
|
||||
2 : TASK ( RLEN SLEN -- )
|
||||
3 ALLOT \ STACK
|
||||
4 HERE 00FF AND 0FE =
|
||||
5 IF 1 ALLOT THEN \ 6502-ALIGN
|
||||
6 UP@ HERE 100 CMOVE \ INIT USER AREA
|
||||
7 HERE 04C C, \ JMP OPCODE TO SLEEP TASK
|
||||
8 UP@ 1+ @ ,
|
||||
9 DUP UP@ 1+ ! \ LINK TASK
|
||||
10 3 ALLOT \ ALLOT JSR WAKE
|
||||
11 DUP 6 - DUP , , \ SSAVE AND S0
|
||||
12 2DUP + , \ HERE + RLEN = R0
|
||||
13 UNDER + HERE - 2+ ALLOT ['] TASKERROR OVER
|
||||
14 [ ' ERRORHANDLER >BODY C@ ] LITERAL + ! CONSTANT ;
|
||||
15
|
||||
Screen 6 not modified
|
||||
0 \ MORE TASKS KS/BP 26APR85RE)
|
||||
1
|
||||
2 : RENDEZVOUS ( SEMAPHORADR -) DUP UNLOCK PAUSE LOCK ;
|
||||
3
|
||||
4 | : STATESMART STATE @ IF [COMPILE] LITERAL THEN ;
|
||||
5
|
||||
6 : 'S ( TADR - ADR.OF.TASKUSERVAR)
|
||||
7 ' >BODY C@ + STATESMART ; IMMEDIATE
|
||||
8
|
||||
9 \ SYNTAX: 2 DEMOTASK 'S BASE ! \ MAKES DEMOTASK WORKING BINARY
|
||||
10
|
||||
11 : TASKS ( -) ." MAIN " CR UP@ DUP 1+ @
|
||||
12 BEGIN 2DUP - WHILE
|
||||
13 DUP [ ' R0 >BODY C@ ] LITERAL + @ 6 + NAME> >NAME .NAME
|
||||
14 DUP C@ 04C = IF ." SLEEPING" THEN CR 1+ @ REPEAT 2DROP ;
|
||||
15
|
||||
Screen 7 not modified
|
||||
0 \ TASKDEMO 27APR85RE)
|
||||
1 : TASKMARK ;
|
||||
2
|
||||
3 VARIABLE COUNTER COUNTER OFF
|
||||
4
|
||||
5 100 100 TASK BACKGROUND
|
||||
6
|
||||
7 : >COUNT ( N -) BACKGROUND 1 PASS COUNTER !
|
||||
8 BEGIN COUNTER @ DUP 1- COUNTER ! ?DUP
|
||||
9 WHILE PAUSE 0 <# #S #> type REPEAT stop ;
|
||||
10
|
||||
11 : WAIT BACKGROUND SLEEP ;
|
||||
12
|
||||
13 : GO BACKGROUND WAKE ;
|
||||
14
|
||||
15
|
||||
Screen 8 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 9 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
|
|
@ -0,0 +1,255 @@
|
|||
Screen 0 not modified
|
||||
0 \ Development Tools cas 26jan06
|
||||
1
|
||||
2 Interactive Tracer
|
||||
3
|
||||
4 One-Step Debugger
|
||||
5
|
||||
6 Traps
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 1 not modified
|
||||
0 \ TOOLS LOADSCREEN 22MAR85RE)
|
||||
1
|
||||
2 ONLYFORTH
|
||||
3
|
||||
4 \NEEDS CODE abort( Assembler is needed )
|
||||
5
|
||||
6 VOCABULARY TOOLS
|
||||
7
|
||||
8 TOOLS ALSO DEFINITIONS
|
||||
9 hex
|
||||
10 1 &11 +THRU
|
||||
11 decimal
|
||||
12 ONLYFORTH
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 2 not modified
|
||||
0 \ HANDLE STEPS BP 10 02 85)
|
||||
1
|
||||
2 ASSEMBLER ALSO DEFINITIONS
|
||||
3
|
||||
4 ONLY FORTH ALSO TOOLS ALSO DEFINITIONS
|
||||
5 | VARIABLE (W | VARIABLE RPT
|
||||
6
|
||||
7 | CODE STEP
|
||||
8 RPT DEC RP X) LDA IP STA
|
||||
9 RP )Y LDA IP 1+ STA RP 2INC
|
||||
10 (W LDA W STA (W 1+ LDA W 1+ STA
|
||||
11 W 1- JMP END-CODE
|
||||
12
|
||||
13 | CREATE NEXTSTEP ] STEP [
|
||||
14
|
||||
15
|
||||
Screen 3 not modified
|
||||
0 \ THROW STATUS ON R-STACK B 23JUL85RE)
|
||||
1
|
||||
2 | CREATE NPULL 0 ]
|
||||
3 RP@ COUNT 2DUP + RP! R> SWAP CMOVE ;
|
||||
4
|
||||
5 : NPUSH ( ADDR LEN -)
|
||||
6 R> -ROT OVER >R RP@ OVER 1+ - DUP RP! PLACE
|
||||
7 NPULL >R >R ;
|
||||
8
|
||||
9 | : ONELINE .STATUS SPACE QUERY INTERPRET
|
||||
10 -82 ALLOT RDROP ( DELETE QUIT FROM TNEXT ) ;
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 4 not modified
|
||||
0 \ TRAP AND DISPLAY KS 26MAR85RE)
|
||||
1 LABEL TNEXT
|
||||
2 IP 2INC RP LDA RPT CMP 0<> ?[
|
||||
3 [[ W 1- JMP SWAP ]?
|
||||
4 RP 1+ LDA RPT 1+ CMP 0= ?]
|
||||
5 LABEL DOTRACE
|
||||
6 RPT INC ( DISABLE TRACER )
|
||||
7 W LDA (W STA W 1+ LDA (W 1+ STA
|
||||
8 ;C: R@ NEXTSTEP >R
|
||||
9 INPUT PUSH KEYBOARD
|
||||
10 OUTPUT PUSH DISPLAY
|
||||
11 CR 2- DUP 4 U.R @ DUP 5 U.R 2 SPACES
|
||||
12 >NAME .NAME 1C COL - 0 MAX SPACES .S
|
||||
13 STATE PUSH BLK PUSH >IN PUSH
|
||||
14 [ ' 'QUIT >BODY ] LITERAL PUSH
|
||||
15 [ ' >INTERPRET >BODY ] LITERAL PUSH
|
||||
Screen 5 not modified
|
||||
0 \
|
||||
1 #TIB PUSH TIB #TIB @ NPUSH R0 PUSH
|
||||
2 RP@ R0 ! 082 ALLOT
|
||||
3 ['] ONELINE IS 'QUIT QUIT ; -2 ALLOT
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 6 not modified
|
||||
0 \ TRACER COMMANDS BP 23JUL85RE)
|
||||
1
|
||||
2 | CODE (TRACE TNEXT 0 100 M/MOD
|
||||
3 # LDA NEXT 0C + STA
|
||||
4 # LDA NEXT 0B + STA
|
||||
5 04C # LDA NEXT 0A + STA NEXT JMP END-CODE
|
||||
6
|
||||
7 : TRACE' RP@ 2- RPT ! ' (TRACE EXECUTE END-TRACE ;
|
||||
8
|
||||
9 : BREAK RP@ 2+ RPT ! (TRACE ; RESTRICT
|
||||
10
|
||||
11 : TRACEL: CREATE , DOES> @ RPT +! ;
|
||||
12
|
||||
13 -6 TRACEL: +DO 6 TRACEL: -DO
|
||||
14 -2 TRACEL: +R 2 TRACEL: -R
|
||||
15 -6 TRACEL: +PUSH 6 TRACEL: -PUSH
|
||||
Screen 7 not modified
|
||||
0 \ WATCH TRAP BP 10 02 85 )
|
||||
1
|
||||
2 | VARIABLE WATCHPT 2 ALLOT
|
||||
3
|
||||
4 LABEL WNEXT IP 2INC
|
||||
5 WATCHPT LDA N STA WATCHPT 1+ LDA N 1+ STA
|
||||
6 N X) LDA WATCHPT 2+ CMP 0<> ?[
|
||||
7 [[ RP LDA RPT STA RP 1+ LDA RPT 1+ STA
|
||||
8 ( SET TO TNEXT) TNEXT 0 100 M/MOD
|
||||
9 # LDA NEXT 0C + STA # LDA NEXT 0B + STA
|
||||
10 DOTRACE JMP SWAP ]?
|
||||
11 N )Y LDA WATCHPT 3 + CMP 0= ?] W 1- JMP END-CODE
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 8 not modified
|
||||
0 \ WATCH COMMANDS BP 10 02 85 )
|
||||
1
|
||||
2 | CODE (WATCH WNEXT 0 100 M/MOD
|
||||
3 # LDA NEXT 0C + STA
|
||||
4 # LDA NEXT 0B + STA
|
||||
5 04C # LDA NEXT 0A + STA NEXT JMP END-CODE
|
||||
6
|
||||
7 : WATCH' ( ADR -- )
|
||||
8 DUP WATCHPT ! @ WATCHPT 2+ ! ' (WATCH EXECUTE END-TRACE ;
|
||||
9
|
||||
10 : CONT ( -) WATCHPT @ @ WATCHPT 2+ ! (WATCH ;
|
||||
11
|
||||
12 ( SYNTAX : <VARNAME> WATCH' <PROCEDURE> )
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 9 not modified
|
||||
0 \ TOOLS FOR DECOMPILING, KS 4 APR 83 )
|
||||
1 ( INTERACTIVE USE )
|
||||
2 | : ?: DUP 4 U.R ." :" ;
|
||||
3 | : @? DUP @ 6 U.R ;
|
||||
4 | : C? DUP C@ 3 .R ;
|
||||
5 | : BL 024 COL - 0 MAX SPACES ;
|
||||
6
|
||||
7 : S ( ADR - ADR+) ( PRINT LITERAL STRING)
|
||||
8 ?: SPACE C? 4 SPACES DUP COUNT TYPE
|
||||
9 DUP C@ + 1+ BL ; ( COUNT + RE)
|
||||
10
|
||||
11 : N ( ADR - ADR+2) ( PRINT NAME OF NEXT WORD BY ITS CFA)
|
||||
12 ?: @? 2 SPACES DUP @ >NAME .NAME 2+ BL ;
|
||||
13
|
||||
14 : L ( ADR - ADR+2) ( PRINT LITERAL VALUE) ?: @? 2+ BL ;
|
||||
15
|
||||
Screen 10 not modified
|
||||
0 \ TOOLS FOR DECOMPILING, INTERACTIVE )
|
||||
1
|
||||
2 : D ( ADR N - ADR+N) ( DUMP N BYTES)
|
||||
3 2DUP SWAP ?: 3 SPACES SWAP 0 DO C? 1+ LOOP
|
||||
4 4 SPACES -ROT TYPE BL ;
|
||||
5
|
||||
6 : C ( ADR - ADR+1) ( PRINT BYTE AS UNSIGNED VALUE) 1 D ;
|
||||
7
|
||||
8 : B ( ADR - ADR+2) ( PRINT BRANCH TARGET LOCATION )
|
||||
9 ?: @? DUP @ OVER + 6 U.R 2+ BL ;
|
||||
10
|
||||
11 ( USED FOR : )
|
||||
12 ( NAME STRING LITERAL DUMP CLIT BRANCH )
|
||||
13 ( - - - - - - )
|
||||
14
|
||||
15
|
||||
Screen 11 not modified
|
||||
0 \ DEBUGGING UTILITIES BP 19 02 85 )
|
||||
1
|
||||
2 : UNRAVEL \ UNRAVEL PERFORM (ABORT"
|
||||
3 RDROP RDROP RDROP CR ." TRACE DUMP IS " CR
|
||||
4
|
||||
5 BEGIN RP@ R0 @ -
|
||||
6 WHILE R> DUP 8 U.R SPACE 2- @ >NAME .NAME CR
|
||||
7 REPEAT (ERROR ;
|
||||
8
|
||||
9 ' UNRAVEL ERRORHANDLER !
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 12 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 13 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Screen 14 not modified
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
Loading…
Reference in New Issue