SamForth-B
This page contains the SamForth-B specific information, as part of the SamForth disassembled project. SamForth-B was written by John A. Avis in 1995. SamForth-B is freeware but unfortunately its source is lost.
Screenshot
Start screen of SamForth-B, showing a list of its words:
Source code
The BASIC loader pokes a routine at 50000 (c350h) and another routine an 50020 (c364h).
BASIC loader
The only change in the original loader is the name of the code file.
10 FORMAT "d3:DFORTH",2,40
15 PAPER 9
BORDER 9
CLS
20 LOAD "sf-b_code"CODE 65536
40 DEF KEYCODE 209,"goto warm"
41 setkeys
50 POKE &5A44,1
POKE &5C6A,0
70 LABEL cold
ON ERROR GO TO 380
74 PRINT "SAMFORTH-B by John Avis 1995"
75 POKE &5ABA,1
POKE &5A34,0
DPOKE &5C7D,16384
POKE &5C6A,8
80 GO TO 310
90 LABEL warm
ON ERROR GO TO 380
95 POKE &5ABA,1
POKE &5A34,0
100 GO TO 330
110 IF PEEK &10182=1 THEN fsave
GO TO 90
120 IF PEEK &10182=2 THEN fload
GO TO 90
130 IF PEEK &10182=3 THEN dr1
GO TO 90
140 IF PEEK &10182=4 THEN GO TO 90
141 IF PEEK &10182=11 THEN bload
GO TO 90
142 IF PEEK &10182=12 THEN bsave
GO TO 90
143 IF PEEK &10182=14 THEN dsave
GO TO 90
144 IF PEEK &10182=13 THEN dload
GO TO 90
150 ON ERROR STOP
160 STOP
170 DEF PROC dr1
180 SCROLL RESTORE
DIR PEEK &5A07 "*.F*"
190 END PROC
200 DEF PROC fload
210 LET b$=MEM$(&10226 TO &1022f)
220 LET a$=TRUNC$ b$ + ".FS"
235 LET b=(PEEK &1015D -1)*16384+DPEEK &10188
240 LOAD A$ CODE b
245 LET a=(PEEK 19314*16384)+(DPEEK 19315-32768)
DPOKE &10184,a
250 END PROC
260 DEF PROC fsave
270 LET b$=MEM$(&10226 TO &1022f)
LET a=(PEEK &1015D-1)*16384+DPEEK &10188
LET b=DPEEK &10184
280 LET a$=TRUNC$ b$ + ".FS"
290 SAVE A$ CODE a,b
300 END PROC
310 POKE 50000,&ed,&73,0,&f0,62,2,211,250,195,0,64
320 GO TO 340
330 POKE 50000,&ed,&73,0,&f0,62,2,211,250,195,3,64
340 POKE 50020,&ed,&7b,0,&f0,62,31,211,250,205,&66,1,201
350 POKE SVAR 520,0
360 CALL 50000
365 POKE &10146,0
370 GO TO 110
380 LET A= PEEK &5C3A
POKE &10146,a
IF A>83 THEN PRINT "DOS error ";A
ELSE PRINT "SAM error ";a
390 GO TO 90
400 DEF PROC bload
410 LET b$=MEM$(&10226 TO &1022f)
430 LET a$=TRUNC$ b$ + ".FC"
435 LET b=49152+DPEEK &10188
436 IF DPEEK &10188 >=32768 THEN LET b= (PEEK &1018E-1)*16384+DPEEK &10188
440 LOAD a$ CODE b
450 END PROC
460 DEF PROC bsave
470 LET b$=MEM$(&10226 TO &1022f)
LET a=49152+DPEEK &10188
LET b=DPEEK &10184
471 IF DPEEK &10188 >=32768 THEN LET a= (PEEK &1018E-1)*16384+DPEEK &10188
480 LET a$=TRUNC$ b$ + ".FC"
490 SAVE a$ CODE a,b
500 END PROC
510 DEF PROC dload
515 LET b$=MEM$(&10226 TO &1022f)
520 LET a$=TRUNC$ b$ + ".FD"
530 LET b=49152+DPEEK &10188
540 LOAD A$ CODE b
550 END PROC
560 DEF PROC dsave
570 LET b$=MEM$(&10226 TO &1022F)
LET a=49152+DPEEK &10188
LET b=DPEEK &10184
580 LET a$=TRUNC$ b$+ ".FD"
590 SAVE A$ CODE a,b
600 END PROC
610 DEF PROC setkeys
620 KEY 24,33
REM f7
630 KEY 15,64
REM f8
640 KEY 6,47
REM f9
650 KEY 25,42
REM f4
660 KEY 16,60
REM f5
670 KEY 7,62
REM f6
675 DEF KEYCODE 207, "goto warm"
680 END PROC
685 DEF PROC s
SAVE OVER "sf-b_orig" LINE 1
END PROC
Routine at 50000 (c350h)
This routine pages the proper RAM page in and starts SamForth. It's called from BASIC.
; z80dasm 1.1.3
; command line: z80dasm --origin=50000 --output=samforth-b_50000.z80s samforth-b_50000.bin
org 0c350h
ld (0f000h),sp ; save SP
ld a,002h ; RAM page 2
out (0fah),a ; allocate pages 2 & 3 to section A
jp 04000h ; start SamForth-B
There's a second version of this code, with just one difference: the jump is done to 4003h. It is also poked and called by the BASIC loader when needed.
Routine at 50020 (0c364h)
This routine is identical in both SamForth variants. It is called by SamForth only once, as part of the quit process.
org 0c364h
ld sp,(0f000h) ; restore SP
ld a,01fh ; RAM page 1
out (0fah),a ; allocate pages 1 & 2 to section A
call 00166h ; JKBFLUSH, flush keyboard buffer
ret
Main program at 16384 (4000h)
; SamForth-B for the SAM Coupé
; Copyright (C) 1995 John A. Avis
;
; This file is part of the
; "SamForth disassembled" project (2012-2013)
; (<http://programandala.net/en.program.samforth>),
; by Marcos Cruz (programandala.net).
;
; This file was created on 2013-02-01T19:53:06 CET.
;
; First, the binaries were searched for data with:
; SamForth2z80dasm, a Gforth program.
; Second, they were disassembled with:
; z80dasm 1.1.3
; command line: z80dasm --address --origin=16384 --labels --source --block-def=samforth-b.bin_blocks.txt --sym-input=samforth-b.bin_symbols.z80s --output=samforth-b.raw.z80s samforth-b.bin
; And third, the assembly was postprocessed with:
; z80dasm2tidySamForth, a Vim program.
org 0x4000
rst_10_rom_routine: equ 0x0010 ; Print char in A register to current stream
jsvin_rom_routine: equ 0x0103 ; Call parameter word with system variables page switched in
jsetstrm_rom_routine: equ 0x0112 ; Set the stream specified by the A register
jdrawto_rom_routine: equ 0x013f ; Draw a line from the current position C pixel horizontally and B pixels vertically
jput_rom_routine: equ 0x0133 ; Place a block of data on the screen at given coordinates
jgrab_rom_routine: equ 0x0136 ; Store a block of screen data from given coordinates to a buffer
jplot_rom_routine: equ 0x0139 ; Plot pixel at x coordinate in C and y coordinate in B
jfill_rom_routine: equ 0x0145 ; Fills an area at coordinates C,B with the pattern at DE
jblitz_rom_routine: equ 0x0148 ; Execute a string of graphics commands BC long at DE
jroll_rom_routine: equ 0x014b ; Move part of the screen (A=wrap/roll, B=pixels, C=direction, D=length, E=width, L=x, H=y
jclsbl_rom_routine: equ 0x014e ; Clear entire screen if A=0, else clear upper screen
jclslower_rom_routine: equ 0x0151 ; Clear lower screen and select channel K
jpalet_rom_routine: equ 0x0154 ; Put colours BC for palette colour E; A=y
jmode_rom_routine: equ 0x015a ; Set screen mode (0-3)
jkbflush_rom_routine: equ 0x0166 ; Flush keyboard buffer
jreadkey_rom_routine: equ 0x0169 ; Read keyboard; NZ/CY if pressed, A=key
jwaitkey_rom_routine: equ 0x016c ; Read next key into A from keyboard buffer; wait for a key if needed
jnchar_rom_routine: equ 0x0184 ; Try to match the char at line D, column E; CY=found?, A=char
lmpr: equ 0xfa ; Low Memory Page Register
hmpr: equ 0xfb ; High Memory Page Register
jp init
jp return_from_basic
jp_main_loop:
jp main_loop
jp_page_rampage_in:
jp page_rampage_in
jp_u_dot_code_field:
jp u_dot_code_field
sub_400fh:
jp l4f81h
jp_page_pageno_in_and_set_iy_to_flags:
jp page_pageno_in_and_set_iy_to_flags
jp_interpret_code_field:
jp interpret_code_field
jp_keyboard_input:
jp keyboard_input
jp_wait_for_keypress_and_return_it_in_a:
jp wait_for_keypress_and_return_it_in_a
jp_de_hl_slash_mod:
jp de_hl_slash_mod
jp_push_hl:
jp push_hl
jp_pop_hl:
jp pop_hl
jp_push_hl_de: ; xxx -- not used; the calls are direct
jp push_hl_de
jp_pop_hl_de:
jp pop_hl_de
jp_error_a:
jp error_a
jp_print_a_xxx_duplicated: ; xxx -- not used; the calls are direct
jp print_a_xxx_duplicated
jp_change_drive_to_tos:
jp change_drive_to_tos
jp_call_jplot:
jp call_jplot
jp_call_jdrawto:
jp call_jdrawto
jp_beep:
jp beep
jp_do_sound:
jp do_sound
jp_cls:
jp cls
jp_fetch_from_page_0:
jp fetch_from_page_0
jp_mode:
jp mode
jp_colour:
jp colour
jp_load:
jp load
jp_save:
jp save
jp_at:
jp at
jp_link:
jp link
jp_link_l:
jp link_l
jp_sam:
jp sam
jp_clear_lower_screen:
jp clear_lower_screen
jp_paper:
jp paper
jp_pen:
jp pen
jp_dir:
jp dir
jp_call_jpalette:
jp call_jpalette
jp_border:
jp border
jp_flash:
jp flash
jp_bright:
jp bright
jp_store_into_page_0:
jp store_into_page_0
jp_c_fetch_from_page_0:
jp c_fetch_from_page_0
jp_c_store_into_page_0:
jp c_store_into_page_0
jp_sound_off:
jp sound_off
jp_rols:
jp rols
jp_csize:
jp csize
jp_udgdef:
jp udgdef
jp_screen:
jp screen
jp_blitz:
jp blitz
jp_tab:
jp tab
jp_overp:
jp overp
jp_inverse:
jp inverse
jp_bload:
jp bload
jp_bsave:
jp bsave
jp_dload:
jp dload
jp_dsave:
jp dsave
jp_editor_command_p:
jp editor_command_p
jp_clear:
jp clear
jp_editor_command_l:
jp editor_command_l
jp_editor_command_f:
jp editor_command_f
jp_editor_command_to:
jp editor_command_to
jp_editor_command_n:
jp editor_command_n
jp_where:
jp where
jp_edit:
jp edit
jp_list:
jp list
jp_newl:
jp newl
sub_40c6h:
jp l4b15h
sub_40c9h:
jp l4b3dh
jp_editor_command_h:
jp editor_command_h
sub_40cfh:
jp l4b90h
sub_40d2h:
jp l4ba0h
jp_editor_command_from:
jp editor_command_from
sub_40d8h:
jp l493eh
jp_grab:
jp grab
jp_put:
jp put
jp_fill:
jp fill
xxx_unknown_zone_00b_start:
defs 80
flags_fvar:
; Various flags to control the system.
defb 0x02
lastk_fvar:
; ASCII code of last key pressed.
defb 0x00
bord_fvar:
; Current border colour.
defb 0x09
frames1_fvar:
; Counts television picture frames into a double number. Not used by SamForth-B.
defw 0x0000
frames2_fvar:
; Counts television picture frames into a double number. Not used by SamForth-B.
defw 0x0000
ycord_fvar:
; Last Y position plotted or drawn.
defb 0x00
xcord_fvar:
; Last X position plotted or drawn.
defw 0x0000
rstack_fvar:
; Address of return stack (Z80 stack).
defw return_stack_end
stp_fvar:
; Stack pointer to Forth stack.
defw data_stack_end
stack_fvar:
; Start of Forth stack.
defw data_stack_end
stkend_fvar:
; End of Forth stack.
defw data_stack_start
samerr_fvar:
; Holds SAM error number. Not used by SamForth-B, but used by the error trapping code of its BASIC loader.
defb 0x00
nmi_fvar:
; Address to jump to when NMI button pressed. Not used by SamForth-B.
defw 0x0000
clate_fvar:
; Address of last Forth word in dictionary at cold start.
defw expand_name
chere_fvar:
; Next vacant address in dictionary at cold start.
defw cold_here
latest_fvar:
; Address of last Forth word in dictionary.
defw expand_name
here_fvar:
; Next vacant address in dictionary.
defw cold_here
base_fvar:
; Current number base.
defw 0x000a
fence_fvar:
; Address below which FORGET will not operate. It is by hold in the variable FENCE.
defw cold_here
tib_fvar:
; Start address of the Terminal Input Buffer.
defw tib_start
pad_fvar:
; Start address of the temporary data holding area.
defw pad_start
st_fvar:
; Start address of source, usually 32768. The page holding the source file is paged in at C & D.
defw 0x8000
tempstk_fvar: ; xxx -- warning: this variable is used as temporary storage
; Used as temporary stack store.
defw 0x0000
rampage_fvar:
; Page number where source file will be held. Defaults to page 7.
defb 0x07
errsp_fvar:
; Address at which return stack is set upon an error.
defw return_stack_end
corestore_fvar: ; xxx -- not used: chere_fvar does its function
; Next vacant address in dictionary at cold start.
defw 0x0000
state_fvar:
; Flag showing compile or immediate mode.
defb 0x00
length_fvar:
; Used to test for the length of a word being looked for in the dictionary.
defb 0x00
leng_fvar:
; Used to test for the length of a word being looked for in the dictionary.
defb 0x00
ip_fvar:
; Address of interpreter pointer within source being compiled.
defw 0x0000
dubflag_fvar:
; Flag indicating double number.
defb 0x00
bastack_fvar:
; Holds stack pointer from SAM BASIC.
defw 0x0000
edits_fvar:
; Start address of source to be edited.
defw 0x0000
numbit_fvar:
; Temporary store used during number output.
defw 0x0000
part1_fvar:
; Temporary addresses used during number input.
defw 0x0000
part2_fvar:
; Temporary addresses used during number input.
defw 0x0000
endf_fvar:
; Temporary store used during number output.
defw 0x0000
nega_fvar:
; Flag for negative number during number output.
defw 0x0000
temp1_fvar:
; Temporary store for HERE during compiling.
defw 0x0000
temp2_fvar:
; Temporary store for LATEST during compiling.
defw 0x0000
il1_fvar:
; Length of input line before cursor.
defb 0x00
il2_fvar:
; Length of input line after cursor.
defb 0x00
etib_fvar:
; End address of Terminal Input Buffer.
defw tib_end
iflag_fvar:
; Flag indicating that characters may be inserted into the input line and existing input is not over written.
defb 0x01
ldflg_fvar:
; Flag showing that source is being compiled.
defb 0x00
errhld_fvar:
; Address of interpreter pointer position when an error occurred during source compilation.
defw 0x0000
svblk_fvar:
; Flag used during LOAD, SAVE and DIR commands.
defw 0x0000
slen_fvar:
; Length of source to be saved.
defw 0x0000
se_fvar:
; End address of source.
defw 0x8000
sadd_fvar:
; Address from where source will be LOADed or SAVEd.
defw 0x0000
hlds_fvar:
; Temporary store during number formatting.
defw 0x0000
pairs_fvar:
; Flags to indicate whether pairs such as DO-LOOP match up during compilation.
defw 0x0000
pageno_fvar:
; Holds number of page paged in at 32768 in sections C & D.
defw 0x0004
cur_fvar:
; Address of cursor in input buffer.
defw 0x0000
smode_fvar:
; Indicates SAM screen mode 1, 2, 3 or 4.
defw 0x0000
notused0_fvar:
defw 0x0000
notused1_fvar:
defw 0x0000
notused2_fvar:
defw 0x0000
len2_fvar:
; Used to increase or decrease length of source during editing.
defw 0x0000
len1_fvar:
; Used to increase or decrease length of source during editing.
defw 0x0000
lists_fvar:
; Start address of source list on screen, or of source to be SAVEd. Changed with T, N, FROM.
defw 0x8000
elist_fvar:
; End address of source list on screen or source to be SAVEd. Changed with N or ES.
defw 0x8000
blong_fvar:
; Used during source editing.
defw 0x0000
endline_fvar:
; Used during source editing.
defw 0x0000
tib_start:
defs 128
tib_end:
pad_start:
defs 128
pad_end:
data_stack_start:
defs 256
data_stack_end:
return_stack_start:
defs 258
return_stack_end:
rst 0x38
cls:
ld a,(flags_fvar)
bit 7,a
jp nz,jp_page_pageno_in_and_set_iy_to_flags
ld a,0x00
call jsvin_rom_routine
defw jclsbl_rom_routine
ld a,0xfe
call jsvin_rom_routine
defw jsetstrm_rom_routine
ret
print_a_xxx_duplicated:
call jsvin_rom_routine
defw rst_10_rom_routine
ret
mode:
call cls
call jp_pop_hl
ld a,l
ld (smode_fvar),a
dec a
call jsvin_rom_routine
defw jmode_rom_routine
ret
link:
call jp_pop_hl
link_l:
ld a,l
cp 0x03
jr nz,l44e3h
set 7,(iy+0x00)
jr link_a_not_to_channel_p
l44e3h:
res 7,(iy+0x00)
link_a_not_to_channel_p:
call jsvin_rom_routine
defw jsetstrm_rom_routine
ret
at:
ld a,0x16
call print_a_xxx_duplicated
call jp_pop_hl_de
push hl
ld a,e
call print_a_xxx_duplicated
pop hl
ld a,l
call print_a_xxx_duplicated
ret
border:
call jp_pop_hl
ld a,l
ld (bord_fvar),a
out (0xfe),a
ret
beep:
call jp_pop_hl
push hl
call jp_pop_hl
push hl
call jp_pop_hl
push hl
ld a,0x1c
ld l,0x01
call sound_out_a_l
ld a,0x14
ld l,0x3f
call sound_out_a_l
ld a,0x00
ld l,0xff
call sound_out_a_l
ld a,0x08
pop hl
call sound_out_a_l
pop hl
ld a,l
sla a
sla a
sla a
sla a
add a,l
ld l,a
ld a,0x10
call sound_out_a_l
pop hl
l4543h:
dec hl
ld de,0x2710
l4547h:
dec de
ld a,d
or e
jr nz,l4547h
ld a,h
or l
jr nz,l4543h
sound_off:
ld a,0x1c
ld l,0x00
call sound_out_a_l
ret
sound_out_a_l:
ld bc,0x01ff
out (c),a
ld bc,0x00ff
out (c),l
ret
do_sound:
call jp_pop_hl
push hl
call jp_pop_hl
ld a,l
pop hl
jp sound_out_a_l
sam:
ld a,0x00
ld (svblk_fvar),a
ld (smode_fvar),a
return_to_basic:
ld (tempstk_fvar),sp
ld sp,(bastack_fvar)
ld a,0x01
out (hmpr),a
jp 0xc364
sub_4586h:
ld hl,(elist_fvar)
ld de,(lists_fvar)
sbc hl,de
ld (slen_fvar),hl
ld hl,(lists_fvar)
ld (sadd_fvar),hl
sub_4598h:
ld hl,(ip_fvar)
l459bh:
inc hl
ld a,0x0d
cp (hl)
jp z,l45d1h
ld a,0x20
cp (hl)
jr nz,l45a9h
jr l459bh
l45a9h:
ld b,0x0e
ld de,(pad_fvar)
ld a,0x20
l45b1h:
ld (de),a
inc de
djnz l45b1h
ld de,(pad_fvar)
l45b9h:
ld a,(hl)
ld (de),a
cp 0x20
jr z,l45c7h
cp 0x0d
jr z,l45cch
inc hl
inc de
jr l45b9h
l45c7h:
dec hl
ld (ip_fvar),hl
ret
l45cch:
ld a,0x20
ld (de),a
jr l45c7h
l45d1h:
ld a,0x0c
jp jp_error_a
save:
call sub_4586h
ld a,0x01
ld (svblk_fvar),a
jp return_to_basic
l45e1h:
ld hl,(se_fvar)
ld (sadd_fvar),hl
call sub_4598h
ld a,0x02
ld (svblk_fvar),a
jp return_to_basic
xxx_unknown_zone_00_start:
defb 0xd6
defb 0x45
dir:
ld a,0x03
ld (svblk_fvar),a
jp return_to_basic
call_rom_address_in_iy: ; xxx -- not used
ex af,af'
ld a,0x01
out (hmpr),a
jp 0xc378
call_jplot:
call get_stack_coords_and_copy_to_bc
call jsvin_rom_routine
defw jplot_rom_routine
ret
call_jdrawto:
call get_stack_coords_and_copy_to_bc
call jsvin_rom_routine
defw jdrawto_rom_routine
ret
get_stack_coords_and_copy_to_bc:
call jp_pop_hl_de
ld b,l
ld a,b
ld (ycord_fvar),a
ld (xcord_fvar),de
ld c,e
ret
paper:
ld a,0x11
jr print_a_and_tos
pen:
ld a,0x10
jr print_a_and_tos
inverse:
ld a,0x14
jr print_a_and_tos
flash:
ld a,0x12
print_a_and_tos:
call print_a_xxx_duplicated
call jp_pop_hl
ld a,l
call print_a_xxx_duplicated
ret
bright:
ld a,0x13
jr print_a_and_tos
clear_lower_screen:
call jsvin_rom_routine
defw jclslower_rom_routine
ret
set_palette_l_to_e: ; xxx -- not used
ld a,0xff
call jp_pop_hl_de
ld b,e
ld c,e
ld e,l
call_jpalette:
call jsvin_rom_routine
defw jpalet_rom_routine
ret
change_drive_to_tos:
ld a,0x00
out (hmpr),a
call jp_pop_hl
ld a,l
ld (0x9a07),a
jp jp_page_pageno_in_and_set_iy_to_flags
store_into_page_0:
ld a,0x00
out (hmpr),a
call jp_pop_hl_de
ld bc,0x4000
add hl,bc
ld (hl),e
inc hl
ld (hl),d
jp jp_page_pageno_in_and_set_iy_to_flags
fetch_from_page_0:
ld a,0x00
out (hmpr),a
call jp_pop_hl
ld bc,0x4000
add hl,bc
ld e,(hl)
inc hl
ld d,(hl)
ex de,hl
call jp_push_hl
jp jp_page_pageno_in_and_set_iy_to_flags
c_store_into_page_0:
ld a,0x00
out (hmpr),a
call jp_pop_hl_de
ld bc,0x4000
add hl,bc
ld (hl),e
jp jp_page_pageno_in_and_set_iy_to_flags
c_fetch_from_page_0:
ld a,0x00
out (hmpr),a
call jp_pop_hl
ld bc,0x4000
add hl,bc
ld a,(hl)
ld l,a
ld h,0x00
call jp_push_hl
jp jp_page_pageno_in_and_set_iy_to_flags
colour:
call jp_pop_hl
push hl
call jp_pop_hl
ex de,hl
pop hl
ld a,0x00
out (hmpr),a
ld a,(0x9a40)
cp 0x01
jr z,l46c7h
cp 0x00
jr z,l46c7h
jr l46d4h
l46c7h:
ld a,e
rlca
rlca
rlca
add a,l
ld (0x9a45),a
ld (0x9c48),a
jr jp_jp_page_pageno_in_and_set_iy_to_flags
l46d4h:
push hl
push de
push af
ld a,e
rlca
rlca
rlca
rlca
add a,e
ld (0x9a30),a
ld e,a
ld a,l
rlca
rlca
rlca
rlca
add a,l
ld (0x9a31),a
ld l,a
pop af
cp 0x02
jr z,l46fch
ld a,l
ld (0x9a49),a
ld a,e
ld (0x9a48),a
pop de
pop hl
jr jp_jp_page_pageno_in_and_set_iy_to_flags
l46fch:
pop de
pop hl
ld a,e
rlca
rlca
add a,e
rlca
rlca
add a,e
rlca
rlca
add a,e
ld (0x9a48),a
ld a,l
rlca
rlca
add a,l
rlca
rlca
add a,l
rlca
rlca
add a,l
ld (0x9a49),a
jp_jp_page_pageno_in_and_set_iy_to_flags:
jp jp_page_pageno_in_and_set_iy_to_flags
ret
rols:
call jp_pop_hl
ld c,e
call jp_pop_hl
ld d,c
push de
call jp_pop_hl
ld c,e
call jp_pop_hl
ld d,e
ld e,c
push de
call jp_pop_hl
ld c,e
call jp_pop_hl
ld b,e
call jp_pop_hl
ld a,e
pop de
pop hl
call jsvin_rom_routine
defw jroll_rom_routine
ret
csize:
call jp_pop_hl_de
ld d,l
ld a,0x00
out (hmpr),a
ld hl,0x9a36
ld (hl),d
inc hl
ld (hl),e
ld l,d
ld h,0x00
ld de,0x00c0
call jp_de_hl_slash_mod
call jp_pop_hl
ld e,l
ld hl,0x9a3f
dec e
ld (hl),e
ld hl,0x9a3e
dec e
ld (hl),e
dec e
ld hl,0x9a3b
ld (hl),e
call jp_pop_hl
ld a,l
ld hl,0x9a5d
ld (hl),a
ld a,(pageno_fvar)
out (hmpr),a
ret
pop de
udgdef:
call jp_pop_hl
ld a,0x00
cp h
jr nz,l4789h
ld a,0xa8
cp l
jr nc,l4792h
l4789h:
ld de,0x00a8
sbc hl,de
ld a,0x01
jr l4794h
l4792h:
ld a,0x00
l4794h:
ld (tempstk_fvar),a
push hl
ld de,0x0008
ld hl,(pad_fvar)
add hl,de
ld b,0x08
l47a1h:
push hl
call jp_pop_hl
ex de,hl
pop hl
ld (hl),e
dec hl
djnz l47a1h
pop hl
add hl,hl
add hl,hl
add hl,hl
ld a,0x00
out (hmpr),a
ld a,(tempstk_fvar)
cp 0x00
jr z,l47c0h
ld de,(0x9c7d)
jr l47c4h
l47c0h:
ld de,(0x9c36)
l47c4h:
add hl,de
ld de,0x4000
add hl,de
ex de,hl
ld hl,(pad_fvar)
inc hl
ld bc,0x0008
ldir
jp jp_page_pageno_in_and_set_iy_to_flags
screen:
call jp_pop_hl_de
ld d,e
ld e,l
call jsvin_rom_routine
defw jnchar_rom_routine
ld l,a
ld h,0x00
call jp_push_hl
ret
blitz:
call jp_pop_hl_de
ld b,h
ld c,l
ld a,0x01
out (hmpr),a
ld h,d
ld l,e
push bc
ld de,0xc000
push de
ldir
pop de
pop bc
call jsvin_rom_routine
defw jblitz_rom_routine
ret
tab:
ld a,0x17
call print_a_xxx_duplicated
call jp_pop_hl
ld a,l
call print_a_xxx_duplicated
ld a,0x00
call print_a_xxx_duplicated
ret
overp:
ld a,0x15
jp print_a_and_tos
bload:
call jp_pop_hl
ld (sadd_fvar),hl
call sub_4598h
ld a,0x0b
ld (svblk_fvar),a
jp return_to_basic
bsave:
call jp_pop_hl_de
ld (slen_fvar),hl
ld (sadd_fvar),de
call sub_4598h
ld a,0x0c
ld (svblk_fvar),a
jp return_to_basic
dload:
ld hl,(chere_fvar)
ld de,0x0004
sbc hl,de
ld (sadd_fvar),hl
call sub_4598h
ld a,0x0d
ld (svblk_fvar),a
jp return_to_basic
dsave:
ld hl,(chere_fvar)
ld bc,(here_fvar)
ld de,(latest_fvar)
dec hl
ld (hl),d
dec hl
ld (hl),e
dec hl
ld (hl),b
dec hl
ld (hl),c
ld (sadd_fvar),hl
ex de,hl
ld h,b
ld l,c
sbc hl,de
ld (slen_fvar),hl
call sub_4598h
ld a,0x0e
ld (svblk_fvar),a
jp return_to_basic
editor_command_p:
call jp_page_rampage_in
ld hl,(ip_fvar)
ld de,(se_fvar)
l4887h:
inc hl
ld a,(hl)
ld (de),a
inc de
ld a,0x0d
cp (hl)
jr nz,l4887h
ld (se_fvar),de
ld (elist_fvar),de
dec hl
ld (ip_fvar),hl
jp jp_page_pageno_in_and_set_iy_to_flags
clear:
ld hl,(lists_fvar)
ld (se_fvar),hl
ld (elist_fvar),hl
ret
editor_command_l:
call cls
ld hl,(elist_fvar)
ld de,(st_fvar)
ld a,d
cp h
jr nz,l48bch
ld a,e
cp l
jr nz,l48bch
ret
l48bch:
call jp_page_rampage_in
l48bfh:
ld hl,(lists_fvar)
ld (elist_fvar),hl
ld b,0x01
l48c7h:
ld l,b
inc b
ld a,b
cp 0x11
jr z,l4903h
push bc
ld h,0x00
call jp_push_hl
call jp_u_dot_code_field
ld a,0x20
call print_a_xxx_duplicated
call jp_page_rampage_in
ld hl,(elist_fvar)
l48e2h:
ld a,(hl)
inc hl
ld (elist_fvar),hl
push af
call print_a_xxx_duplicated
call jp_page_rampage_in
pop af
cp 0x0d
jr nz,l48e2h
pop bc
push hl
ld de,(se_fvar)
and a
sbc hl,de
pop hl
jr z,l4903h
jr nc,l4903h
jr l48c7h
l4903h:
ld hl,(elist_fvar)
dec hl
ld (elist_fvar),hl
jp jp_page_pageno_in_and_set_iy_to_flags
editor_command_from:
ld hl,(lists_fvar)
ld de,(st_fvar)
ld a,e
cp l
jr nz,l491dh
ld a,h
cp d
jp z,l4a40h
l491dh:
call jp_page_rampage_in
dec hl
l4921h:
dec hl
ld a,e
cp l
jr nz,l492bh
ld a,h
cp d
jp z,l4938h
l492bh:
ld a,0x0d
cp (hl)
jr nz,l4921h
inc hl
ld (lists_fvar),hl
call jp_page_pageno_in_and_set_iy_to_flags
ret
l4938h:
ld (lists_fvar),hl
jp l4a40h
l493eh:
ld hl,(lists_fvar)
call jp_page_rampage_in
l4944h:
inc hl
ld a,0x0d
cp (hl)
jr nz,l4944h
ld de,(se_fvar)
ld a,e
cp l
jr nz,l4957h
ld a,d
cp h
jp z,l4a40h
l4957h:
inc hl
ld (lists_fvar),hl
call jp_page_pageno_in_and_set_iy_to_flags
ret
editor_command_f:
call sub_4bceh
ld hl,(sadd_fvar)
ld (lists_fvar),hl
ret
editor_command_to:
call sub_4bceh
call jp_page_rampage_in
ld hl,(sadd_fvar)
l4972h:
dec hl
ld a,0x0d
cp (hl)
jr nz,l4972h
inc hl
ld (elist_fvar),hl
call jp_page_pageno_in_and_set_iy_to_flags
ret
editor_command_n:
ld hl,(elist_fvar)
inc hl
push hl
ld de,(se_fvar)
sbc hl,de
pop hl
ret nc
ld (lists_fvar),hl
jp editor_command_l
load:
ld hl,(ip_fvar)
l4996h:
inc hl
ld a,(hl)
cp 0x0d
jr z,l49a3h
cp 0x20
jr z,l4996h
jp l45e1h
l49a3h:
ld hl,(lists_fvar)
ld (sadd_fvar),hl
l49a9h:
call jp_page_rampage_in
ld de,(tib_fvar)
l49b0h:
ld a,(hl)
ld (de),a
inc hl
inc de
cp 0x0d
jr nz,l49b0h
ld (endline_fvar),hl
call jp_page_pageno_in_and_set_iy_to_flags
call jp_interpret_code_field
ld hl,(endline_fvar)
ld (sadd_fvar),hl
ld de,(elist_fvar)
ld a,d
cp h
jr nz,l49a9h
ld a,e
cp l
jr nz,l49a9h
ld a,(ldflg_fvar)
cp 0x80
call z,sub_49e2h ; xxx -- why?
ld sp,(errsp_fvar)
jp jp_main_loop
sub_49e2h: ; xxx -- why?
ret
where:
ld hl,(errhld_fvar)
dec hl
ld de,(tib_fvar)
sbc hl,de
ex de,hl
ld hl,(sadd_fvar)
ld (lists_fvar),hl
add hl,de
call jp_page_rampage_in
ld (hl),0x83
jp l48bfh
edit:
call sub_4c41h
l4a00h:
call jp_page_rampage_in
ld hl,(edits_fvar)
ld de,(se_fvar)
sbc hl,de
jp z,l4a40h
ld hl,(edits_fvar)
call sub_4af5h
ld hl,(tib_fvar)
call jp_keyboard_input
ld a,(il1_fvar)
ld c,a
ld a,(il2_fvar)
add a,c
inc a
ld (len2_fvar),a
ld c,a
ld a,(len1_fvar)
cp c
jr z,l4a32h
jr nc,l4a37h
jr l4a3dh
l4a32h:
call sub_4a85h
jr l4a40h
l4a37h:
call sub_4aa7h
jp l4a40h
l4a3dh:
call sub_4a61h
l4a40h:
call jp_page_pageno_in_and_set_iy_to_flags
ld hl,0x0002
call link_l
call editor_command_l
ld sp,(errsp_fvar)
jp jp_main_loop
sub_4a53h:
ld hl,(se_fvar)
ld bc,(endline_fvar)
and a
sbc hl,bc
ld (blong_fvar),hl
ret
sub_4a61h:
call sub_4a53h
call jp_page_rampage_in
ld a,(len1_fvar)
ld c,a
ld a,(len2_fvar)
sub c
ld b,0x00
ld c,a
ld hl,(se_fvar)
push hl
and a
add hl,bc
ld (se_fvar),hl
ld d,h
ld e,l
pop hl
ld bc,(blong_fvar)
inc bc
lddr
sub_4a85h:
ld hl,(edits_fvar)
ld de,(edits_fvar)
call jp_page_rampage_in
ld a,(len2_fvar)
cp 0x00
jp z,l4a00h
ld c,a
ld b,0x00
add hl,bc
ld (endline_fvar),hl
ld hl,(tib_fvar)
ldir
ld hl,(endline_fvar)
ret
sub_4aa7h:
call sub_4a53h
call jp_page_rampage_in
ld a,(len2_fvar)
ld c,a
ld a,(len1_fvar)
sub c
ld c,a
ld b,0x00
ld hl,(se_fvar)
and a
sbc hl,bc
ld (se_fvar),hl
ld hl,(endline_fvar)
push hl
and a
sbc hl,bc
ld d,h
ld e,l
pop hl
ld bc,(blong_fvar)
ld a,b
or c
jr z,sub_4a85h
ldir
jr sub_4a85h
sub_4ad7h:
call jp_page_rampage_in
ld hl,(edits_fvar)
l4addh:
ld a,(hl)
cp 0x0d
jr z,l4ae5h
inc hl
jr l4addh
l4ae5h:
inc hl
ld (endline_fvar),hl
ld bc,(edits_fvar)
and a
sbc hl,bc
ld a,l
ld (len1_fvar),a
ret
sub_4af5h:
call sub_4ad7h
ld c,a
ld b,0x00
dec a
ld (il2_fvar),a
ld a,0x00
ld hl,(edits_fvar)
ld de,(tib_fvar)
ld (cur_fvar),de
ld (il1_fvar),a
ldir
call sub_400fh
ret
l4b15h:
call sub_4c41h
ld hl,(se_fvar)
call jp_page_rampage_in
ld bc,(endline_fvar)
sbc hl,bc
ld b,h
ld c,l
inc bc
ld hl,(se_fvar)
ld de,(se_fvar)
inc de
ld (se_fvar),de
lddr
ld hl,(endline_fvar)
ld (hl),0x0d
jp l4b86h
l4b3dh:
call sub_4c41h
call jp_page_rampage_in
ld hl,(edits_fvar)
l4b46h:
ld a,(hl)
cp 0x0d
jr z,l4b4eh
inc hl
jr l4b46h
l4b4eh:
inc hl
ld (endline_fvar),hl
ld bc,(edits_fvar)
and a
sbc hl,bc
ld a,l
ld (len1_fvar),a
ld hl,(se_fvar)
ld de,(endline_fvar)
sbc hl,de
ld b,h
ld c,l
ld a,(len1_fvar)
ld e,a
ld d,0x00
ld hl,(se_fvar)
sbc hl,de
ld (se_fvar),hl
ld hl,(endline_fvar)
push hl
sbc hl,de
ld (endline_fvar),hl
ex de,hl
pop hl
ldir
ld hl,(edits_fvar)
l4b86h:
call jp_page_pageno_in_and_set_iy_to_flags
ld hl,0x0002
call link_l
ret
l4b90h:
call jp_pop_hl
call jp_push_hl
call jp_push_hl
call l4b3dh
call l4b15h
ret
l4ba0h:
call jp_pop_hl
call jp_push_hl
call jp_push_hl
call l4b90h
call sub_4c41h
ld hl,(tib_fvar)
push hl
ld hl,(pad_fvar)
inc hl
ld (tib_fvar),hl
ld hl,(pad_fvar)
ld a,(hl)
ld (len2_fvar),a
ld a,0x01
ld (len1_fvar),a
call sub_4a61h
pop hl
ld (tib_fvar),hl
ret
sub_4bceh:
ld de,(ip_fvar)
call jp_page_rampage_in
l4bd5h:
inc de
ld a,(de)
cp 0x20
jr z,l4bd5h
cp 0x3a
jr z,l4bd5h
cp 0x0d
jr z,l4c39h
ld hl,(lists_fvar)
dec hl
l4be7h:
push hl
push de
dec de
l4beah:
inc de
inc hl
ld a,(de)
ld c,(hl)
cp c
jr nz,l4c23h
cp 0x0d
jr z,l4bfbh
cp 0x20
jr z,l4bfbh
jr l4beah
l4bfbh:
pop bc
pop hl
ld (sadd_fvar),hl
dec de
ld (ip_fvar),de
jp jp_page_pageno_in_and_set_iy_to_flags
l4c08h:
pop de
pop bc
l4c0ah:
push hl
ld bc,(se_fvar)
and a
sbc hl,bc
jr nc,l4c39h
jr z,l4c39h
pop hl
ld a,(hl)
cp 0x0d
jr z,l4be7h
cp 0x20
jr z,l4be7h
inc hl
jr l4c0ah
l4c23h:
cp 0x0d
jr nz,l4c2eh
ld a,c
cp 0x20
jr z,l4bfbh
jr l4c08h
l4c2eh:
cp 0x20
jr nz,l4c08h
ld a,c
cp 0x0d
jr z,l4bfbh
jr l4c08h
l4c39h:
call jp_page_pageno_in_and_set_iy_to_flags
ld a,0x0a
jp jp_error_a
sub_4c41h:
call jp_pop_hl
ld a,0x0f
cp l
jr c,l4c7dh
ld a,0x00
cp l
jr z,l4c7dh
ld b,l
ld hl,(lists_fvar)
ld a,b
ld (notused1_fvar),a
ld a,0x01
cp b
jr z,l4c77h
call jp_page_rampage_in
dec b
dec hl
l4c60h:
inc hl
push hl
ld de,(se_fvar)
sbc hl,de
pop hl
jp nc,l4c7dh
ld a,0x0d
cp (hl)
jr nz,l4c60h
djnz l4c60h
ld (endline_fvar),hl
inc hl
l4c77h:
ld (edits_fvar),hl
jp jp_page_pageno_in_and_set_iy_to_flags
l4c7dh:
ld a,0x0b
jp jp_error_a
newl:
ld a,(rampage_fvar)
out (hmpr),a
ld hl,(se_fvar)
ld b,0x10
l4c8ch:
ld (hl),0x0d
inc hl
djnz l4c8ch
ld (se_fvar),hl
ld (elist_fvar),hl
jp editor_command_l
list:
ld hl,(elist_fvar)
ld de,(st_fvar)
ld a,d
cp h
jr nz,l4caah
ld a,e
cp l
jr nz,l4caah
ret
l4caah:
ld a,(rampage_fvar)
out (hmpr),a
ld hl,(lists_fvar)
l4cb2h:
ld a,(hl)
call print_a_xxx_duplicated
ld a,(rampage_fvar)
out (hmpr),a
inc hl
ld bc,(elist_fvar)
push hl
and a
sbc hl,bc
pop hl
jr nc,l4cebh
jr z,l4cebh
ld a,(hl)
cp 0x3a
jr nz,l4cd3h
ld (lists_fvar),hl
jr l4cb2h
l4cd3h:
cp 0x3b
jr nz,l4cb2h
call print_a_xxx_duplicated
ld a,(rampage_fvar)
out (hmpr),a
inc hl
bit 7,(iy+0x00)
call z,jp_wait_for_keypress_and_return_it_in_a
cp 0x20
jr nz,l4cb2h
l4cebh:
jp jp_page_pageno_in_and_set_iy_to_flags
editor_command_h:
call sub_4c41h
call sub_4ad7h
ld hl,(edits_fvar)
ld a,(len1_fvar)
ld c,a
ld b,0x00
ld de,(pad_fvar)
inc de
ldir
ld hl,(pad_fvar)
ld (hl),a
jp jp_page_pageno_in_and_set_iy_to_flags
grab:
call jp_pop_hl_de
ld d,l
push de
call jp_pop_hl_de
ld c,l
ld b,e
pop de
call jsvin_rom_routine
defw jgrab_rom_routine
ret
put:
call jp_pop_hl_de
ld a,l
push de
call jp_pop_hl_de
ld b,l
ld c,e
pop hl
call jsvin_rom_routine
defw jput_rom_routine
ret
fill:
call jp_pop_hl_de
ld b,l
ld c,e
call jp_pop_hl
ex de,hl
ld a,0x00
call jsvin_rom_routine
defw jfill_rom_routine
ret
xxx_unknown_zone_01b_start:
defs 18
print_a:
call jsvin_rom_routine
defw rst_10_rom_routine
ret
pop_hl:
ld (rstack_fvar),sp
ld sp,(stp_fvar)
ld hl,(stack_fvar)
sbc hl,sp
jp z,error_0x01_stack_empty
pop hl
ld (stp_fvar),sp
ld sp,(rstack_fvar)
ret
push_hl:
push hl
ld (rstack_fvar),sp
ld sp,(stp_fvar)
push hl
ld hl,(stkend_fvar)
sbc hl,sp
jp nc,error_0x02_stack_full
ld (stp_fvar),sp
ld sp,(rstack_fvar)
pop hl
ret
pop_hl_de:
ld (rstack_fvar),sp
ld sp,(stp_fvar)
ld hl,(stack_fvar)
sbc hl,sp
jp z,error_0x01_stack_empty
ld hl,(stack_fvar)
dec hl
dec hl
sbc hl,sp
jp z,error_0x01_stack_empty
pop hl
pop de
ld (stp_fvar),sp
ld sp,(rstack_fvar)
ret
push_hl_de:
push hl
ld (rstack_fvar),sp
ld sp,(stp_fvar)
push de
push hl
ld hl,(stkend_fvar)
sbc hl,sp
jp nc,error_0x02_stack_full
ld (stp_fvar),sp
ld sp,(rstack_fvar)
pop hl
ret
wait_for_keypress_and_return_it_in_a:
call jsvin_rom_routine
defw jwaitkey_rom_routine
cp 0x00
jr z,wait_for_keypress_and_return_it_in_a
ret
restore_the_input_pointer:
ld hl,(tib_fvar)
ld (cur_fvar),hl
ld a,0x00
ld (il1_fvar),a
ld (il2_fvar),a
keyboard_input:
push hl
call l4f81h
call wait_for_keypress_and_return_it_in_a
pop hl
cp 0x08
jp z,keyboard_input_cursor_left
cp 0x09
jp z,keyboard_input_cursor_right
cp 0x0c
jp z,keyboard_input_backspace
cp 0x0e
jp z,keyboard_input_delete
cp 0xc3
jp z,l4f16h
cp 0xc2
jp z,restore_the_input_pointer
cp 0x07
jp z,keyboard_input_edit
cp 0x06
jr z,l4e73h
cp 0x0b
jp z,keyboard_input_up
cp 0x0a
jp z,keyboard_input_down
cp 0xc0
jp z,toggle_insert_mode
cp 0x0d
jr z,keyboard_input_cr
push af
ld a,(iflag_fvar)
cp 0x01
call z,sub_4f54h
pop af
ld (hl),a
inc hl
ld (cur_fvar),hl
ld a,(il1_fvar)
inc a
ld (il1_fvar),a
ld a,(iflag_fvar)
cp 0x01
jr z,keyboard_input
ld a,(il2_fvar)
dec a
cp 0xff
jr z,keyboard_input
ld (il2_fvar),a
jp keyboard_input
keyboard_input_edit:
ld (hl),0x20
inc hl
ld (hl),0x45
inc hl
ld (hl),0x44
inc hl
ld (hl),0x49
inc hl
ld (hl),0x54
inc hl
ld (hl),0x20
ld a,(il1_fvar)
add a,0x06
ld (il1_fvar),a
call keyboard_input_cr
call interpret_code_field
ret
l4e73h:
ld a,0x00
out (hmpr),a
ld a,(0x9c6a)
xor 0x08
ld (0x9c6a),a
call page_pageno_in_and_set_iy_to_flags
jp keyboard_input
keyboard_input_cr:
ld hl,(tib_fvar)
ld a,(il1_fvar)
ld c,a
ld a,(il2_fvar)
add a,c
ld c,a
ld b,0x00
add hl,bc
ld (hl),0x0d
ld (etib_fvar),hl
call sub_4fafh
print_cr: ; xxx -- duplicated code; already in the CR word
ld a,0x0d
call print_a
ret
keyboard_input_backspace:
ld a,(il1_fvar)
dec a
cp 0xff
jp z,keyboard_input
ld (il1_fvar),a
ld hl,(cur_fvar)
ld de,(cur_fvar)
dec de
ld (cur_fvar),de
ld a,(il2_fvar)
l4ebdh:
cp 0x00
jr z,l4ec6h
ld c,a
ld b,0x00
ldir
l4ec6h:
ld hl,(cur_fvar)
jp keyboard_input
keyboard_input_delete:
ld a,(il2_fvar)
dec a
cp 0xff
jp z,keyboard_input
ld (il2_fvar),a
ld hl,(cur_fvar)
inc hl
ld de,(cur_fvar)
jr l4ebdh
keyboard_input_cursor_left:
ld a,(il1_fvar)
dec a
cp 0xff
jp z,keyboard_input
ld (il1_fvar),a
ld a,(il2_fvar)
inc a
ld (il2_fvar),a
dec hl
ld (cur_fvar),hl
jp keyboard_input
keyboard_input_cursor_right:
ld a,(il2_fvar)
dec a
cp 0xff
jp z,keyboard_input
ld (il2_fvar),a
ld a,(il1_fvar)
inc a
ld (il1_fvar),a
inc hl
ld (cur_fvar),hl
jp keyboard_input
l4f16h:
ld a,0x00
ld (il2_fvar),a
jp keyboard_input
keyboard_input_up:
ld a,(il1_fvar)
ld c,a
ld a,(il2_fvar)
add a,c
ld (il2_fvar),a
ld a,0x00
ld (il1_fvar),a
ld hl,(tib_fvar)
ld (cur_fvar),hl
jp keyboard_input
keyboard_input_down:
ld a,(il1_fvar)
ld c,a
ld a,(il2_fvar)
add a,c
ld (il1_fvar),a
ld c,a
ld a,0x00
ld (il2_fvar),a
ld b,0x00
ld hl,(tib_fvar)
add hl,bc
ld (cur_fvar),hl
jp keyboard_input
sub_4f54h:
ld hl,(tib_fvar)
ld a,(il1_fvar)
ld c,a
ld a,(il2_fvar)
add a,c
ld c,a
ld b,0x00
add hl,bc
ld (etib_fvar),hl
ld a,(il2_fvar)
inc a
ld c,a
ld de,(etib_fvar)
inc de
lddr
ld hl,(cur_fvar)
ret
toggle_insert_mode:
ld a,(iflag_fvar)
xor 0x01
ld (iflag_fvar),a
jp keyboard_input
l4f81h:
ld hl,0x0001
call jp_link_l
call jp_clear_lower_screen
ld hl,(tib_fvar)
ld a,(il1_fvar)
cp 0x00
jr z,l4f9ah
ld c,a
ld b,0x00
call type_bc_chars_at_hl
l4f9ah:
ld a,0x5f
call print_a
ld hl,(cur_fvar)
ld a,(il2_fvar)
cp 0x00
ret z
ld c,a
ld b,0x00
call type_bc_chars_at_hl
ret
sub_4fafh:
ld hl,0x0002
call jp_link_l
ld hl,(tib_fvar)
ld a,(il1_fvar)
ld c,a
ld a,(il2_fvar)
add a,c
ld c,a
ld a,0x00
cp c
ret z
ld b,0x00
call type_bc_chars_at_hl
ret
type_bc_chars_at_hl:
ld a,(hl)
inc hl
push hl
push bc
call print_a
pop bc
pop hl
dec bc
ld a,b
or c
jr nz,type_bc_chars_at_hl
ret
return_from_basic:
di
ld (bastack_fvar),sp
ld sp,(tempstk_fvar) ; xxx -- warning: this variable is used as temporary storage
ei
ld a,(pageno_fvar)
out (hmpr),a
ld a,(svblk_fvar)
cp 0x02
jr nz,l5000h
ld de,(slen_fvar)
ld hl,(se_fvar)
add hl,de
ld (se_fvar),hl
ld (elist_fvar),hl
jr l501ah
l5000h:
cp 0x0d
jr nz,l501ah
ld hl,(chere_fvar)
dec hl
ld b,(hl)
dec hl
ld c,(hl)
dec hl
ld d,(hl)
dec hl
ld e,(hl)
ld (latest_fvar),bc
ld (here_fvar),de
call save_dictionary_pointers
l501ah:
xor a
main_loop:
call restore_the_input_pointer
call interpret_code_field
jr main_loop
error_0x01_stack_empty:
ld a,0x01
jr error_a
error_0x02_stack_full:
ld a,0x02
error_a:
ld hl,error_messages
error_message_not_found_yet:
bit 7,(hl)
inc hl
jr z,error_message_not_found_yet
dec a
jr nz,error_message_not_found_yet
next_error_message_char:
ld a,(hl)
bit 7,a
inc hl
jr nz,warm_restart
call print_a
jr next_error_message_char
warm_restart:
ld hl,(stack_fvar)
ld (stp_fvar),hl
ld (svblk_fvar),a
ld hl,(ip_fvar)
ld (errhld_fvar),hl
ld sp,(errsp_fvar)
ld hl,tib_start
ld (tib_fvar),hl
ld hl,tib_end
ld (pad_fvar),hl
call restore_dictionary_pointers_and_set_interpretation_mode
call print_cr
call page_pageno_in_and_set_iy_to_flags
ld a,0x00
ld (dubflag_fvar),a
jp main_loop
error_messages:
defb 0x80
defm "Stack empty" ; Error number 0x01
defb 0x8d
defm "Stack full" ; Error number 0x02
defb 0x8d
defm "Undefined word" ; Error number 0x03
defb 0x8d
defm "Colon definitions only" ; Error number 0x04
defb 0x8d
defm "Division by zero" ; Error number 0x05
defb 0x8d
defm "Return stack full" ; Error number 0x06
defb 0x8d
defm "Inside fence" ; Error number 0x07
defb 0x8d
defm "Break" ; Error number 0x08
defb 0x8d
defm "Incomplete form" ; Error number 0x09
defb 0x8d
defm "Not found" ; Error number 0x0a
defb 0x8d
defm "Editor error" ; Error number 0x0b
defb 0x8d
init:
ld (bastack_fvar),sp
ld (0xc34c),sp
ld sp,(errsp_fvar)
ld a,0x0d
call print_a
call page_pageno_in_and_set_iy_to_flags
call save_dictionary_pointers
ld a,0x00
ld (state_fvar),a
ld hl,0x0002
call jp_link_l
call print_cr
set 1,(iy+0x00)
jp main_loop
save_dictionary_pointers:
ld hl,(here_fvar)
ld (temp1_fvar),hl
ld hl,(latest_fvar)
ld (temp2_fvar),hl
ret
restore_dictionary_pointers_and_set_interpretation_mode:
ld hl,(temp1_fvar)
ld (here_fvar),hl
ld hl,(temp2_fvar)
ld (latest_fvar),hl
ld a,0x00
ld (state_fvar),a
ret
lit_link_field:
defw 0xffff
lit_name_field:
defb 0x03
lit_name:
defm "LIT"
lit_code_field:
pop hl
ld e,(hl)
inc hl
ld d,(hl)
inc hl
push hl
ex de,hl
call push_hl
ret
execute_link_field:
defw lit_name
execute_name_field:
defb 0x07
execute_name:
defm "EXECUTE"
execute_code_field:
call pop_hl
jp (hl)
branch_link_field:
defw execute_name
branch_name_field:
defb 0x06
branch_name:
defm "BRANCH"
branch_code_field:
pop hl
ld c,(hl)
inc hl
ld b,(hl)
push bc
ret
zero_branch_link_field:
defw branch_name
zero_branch_name_field:
defb 0x07
zero_branch_name:
defm "0BRANCH"
zero_branch_code_field:
call pop_hl
ld a,0x01
cp l
jr nz,branch_code_field
pop hl
inc hl
inc hl
jp (hl)
swap_link_field:
defw zero_branch_name
swap_name_field:
defb 0x04
swap_name:
defm "SWAP"
swap_code_field:
call pop_hl_de
ex de,hl
call push_hl_de
ret
dup_link_field:
defw swap_name
dup_name_field:
defb 0x03
dup_name:
defm "DUP"
dup_code_field:
call pop_hl
call push_hl
call push_hl
ret
drop_link_field:
defw dup_name
drop_name_field:
defb 0x04
drop_name:
defm "DROP"
drop_code_field:
call pop_hl
ret
interpret_link_field:
defw drop_name
interpret_name_field:
defb 0x09
interpret_name:
defm "INTERPRET"
interpret_code_field:
ld hl,(tib_fvar)
dec hl
skip_space:
inc hl
ld a,0x20
cp (hl)
jr z,skip_space
ld a,0x0d
cp (hl)
jr nz,first_char_to_interpret_found
ret
first_char_to_interpret_found:
ld (ip_fvar),hl
call paren_find_code_field
call pop_hl
ld a,h
or l
jr nz,l5247h
ld hl,(ip_fvar)
call push_hl
call number_code_field
ld hl,(numbit_fvar)
ld (ip_fvar),hl
call pop_hl
ld a,h
or l
jr z,l520ah
ld a,0x01
ld (dubflag_fvar),a
call push_hl
l520ah:
ld a,(state_fvar)
cp 0x00
jr z,l5242h
ld a,(dubflag_fvar)
cp 0x01
jr nz,l521fh
call pop_hl_de
ex de,hl
call push_hl_de
l521fh:
call pop_hl
ld b,h
ld c,l
ld hl,lit_code_field
call push_hl
call compile_call_tos
ld (hl),c
inc hl
ld (hl),b
inc hl
ld (here_fvar),hl
ld a,(dubflag_fvar)
cp 0x01
jr nz,l5242h
ld a,0x00
ld (dubflag_fvar),a
jr l521fh
l5242h:
ld hl,(ip_fvar)
jr skip_space
l5247h:
ld a,(leng_fvar)
bit 6,a
jr nz,l5264h
ld a,(state_fvar)
bit 7,a
jr nz,l5270h
ld a,(leng_fvar)
bit 7,a
jr z,l5264h
ld a,(state_fvar)
bit 7,a
jp z,error_0x04_colon_definitions_only_xxx_1
l5264h:
call push_hl
call execute_code_field
ld hl,(ip_fvar)
jp skip_space
l5270h:
ld a,(leng_fvar)
bit 7,a
jr nz,l5264h
call push_hl
call compile_call_tos
ld hl,(ip_fvar)
jp skip_space
compile_call_tos:
call pop_hl
ex de,hl
compile_call_de:
ld hl,(here_fvar)
ld (hl),0xcd
inc hl
ld (hl),e
inc hl
ld (hl),d
inc hl
ld (here_fvar),hl
ret
error_0x04_colon_definitions_only_xxx_1:
ld a,0x04
jp error_a
paren_find_link_field:
defw interpret_name
paren_find_name_field:
defb 0x06
paren_find_name:
defm "(FIND)"
paren_find_code_field:
ld de,(ip_fvar)
ld b,0x00
l52a9h:
ld a,(de)
cp 0x20
jr z,l52b6h
cp 0x0d
jr z,l52b6h
inc b
inc de
jr l52a9h
l52b6h:
ld a,b
ld (length_fvar),a
ld hl,(latest_fvar)
jr l52d5h
l52bfh:
pop hl
l52c0h:
dec hl
ld b,(hl)
dec hl
ld c,(hl)
ld h,b
ld l,c
ld a,0xff
cp l
jr nz,l52d5h
cp h
jr nz,l52d5h
ld hl,0x0000
call push_hl
ret
l52d5h:
dec hl
ld a,(length_fvar)
ld c,a
ld a,(hl)
res 7,a
res 6,a
cp c
jr nz,l52c0h
ld a,(hl)
ld (leng_fvar),a
push hl
ld de,(ip_fvar)
ld b,(hl)
res 7,b
res 6,b
l52f0h:
inc hl
ld c,(hl)
ld a,(de)
cp c
jr nz,l52bfh
inc de
djnz l52f0h
inc hl
dec de
ld (ip_fvar),de
call push_hl
pop hl
ret
u_mult_link_field:
defw paren_find_name
u_mult_name_field:
defb 0x02
u_mult_name:
defm "U*"
u_mult_code_field:
call pop_hl_de
ld b,h
ld a,l
call sub_5324h
push hl
ld h,a
ld a,b
ld b,h
call sub_5324h
pop de
ld c,d
add hl,bc
adc a,0x00
ld d,l
ld l,h
ld h,a
call push_hl_de
ret
sub_5324h:
ld hl,0x0000
ld c,0x08
l5329h:
add hl,hl
rla
jr nc,l5330h
add hl,de
adc a,0x00
l5330h:
dec c
jr nz,l5329h
ret
plus_link_field:
defw u_mult_name
plus_name_field:
defb 0x01
plus_name:
defm "+"
plus_code_field:
call pop_hl_de
and a
add hl,de
call push_hl
ret
d_plus_link_field:
defw plus_name
d_plus_name_field:
defb 0x02
d_plus_name:
defm "D+"
d_plus_code_field:
call pop_hl
push hl
pop bc
call pop_hl
push hl
call swap_code_field
call pop_hl
pop de
add hl,de
ex de,hl
push af
call pop_hl
pop af
adc hl,bc
call push_hl_de
ret
minus_link_field:
defw d_plus_name
minus_name_field:
defb 0x01
minus_name:
defm "-"
minus_code_field:
call pop_hl_de
ex de,hl
sbc hl,de
call push_hl
ret
do_minus_link_field:
defw minus_name
do_minus_name_field:
defb 0x05
do_minus_name:
defm "MINUS"
do_minus_code_field:
call pop_hl
ex de,hl
ld hl,0x0000
sbc hl,de
call push_hl
ret
d_do_minus_link_field:
defw do_minus_name
d_do_minus_name_field:
defb 0x06
d_do_minus_name:
defm "DMINUS"
d_do_minus_code_field:
call pop_hl_de
sub a
sub e
ld e,a
ld a,0x00
sbc a,d
ld d,a
ld a,0x00
sbc a,l
ld l,a
ld a,0x00
sbc a,h
ld h,a
call push_hl_de
ret
number_link_field:
defw d_do_minus_name
number_name_field:
defb 0x06
number_name:
defm "NUMBER"
number_code_field:
call pop_hl
ld a,0x2d
cp (hl)
jr nz,l53f1h
inc hl
ld a,0x01
ld (nega_fvar),a
jr l53f1h
l53beh:
ld hl,(part1_fvar)
ld de,(part2_fvar)
call push_hl_de
ld a,(nega_fvar)
cp 0x01
jr nz,l53ebh
ld a,h
or l
jr nz,l53d8h
ld a,0x80
ld (nega_fvar),a
l53d8h:
call d_do_minus_code_field
ld a,(nega_fvar)
cp 0x80
jr nz,l53ebh
call pop_hl
ld hl,0x0000
call push_hl
l53ebh:
ld a,0x00
ld (nega_fvar),a
ret
l53f1h:
ld a,0x00
ld (endf_fvar),a
ex de,hl
ld hl,0x0000
ld (part1_fvar),hl
ld (part2_fvar),hl
l5400h:
ld a,(de)
cp 0x30
jp c,error_0x03_undefined_word_xxx_1
ld c,a
ld a,(base_fvar)
ld b,0x0a
cp b
jr nc,l5415h
add a,0x30
cp c
jp c,error_0x03_undefined_word_xxx_1
l5415h:
ld a,c
cp 0x3a
jr nc,l5477h
sub 0x30
l541ch:
ld h,0x00
ld l,a
call push_hl
inc de
ld a,(de)
cp 0x20
jr z,l5470h
cp 0x0d
jr z,l5470h
l542ch:
dec de
ld (numbit_fvar),de
ld hl,(part1_fvar)
call push_hl
ld hl,(base_fvar)
call push_hl
call u_mult_code_field
call pop_hl
ld hl,(base_fvar)
call push_hl
ld hl,(part2_fvar)
call push_hl
call u_mult_code_field
call d_plus_code_field
call pop_hl
ld (part1_fvar),hl
call pop_hl
ld (part2_fvar),hl
ld a,(endf_fvar)
cp 0x01
jp z,l53beh
ld de,(numbit_fvar)
inc de
jr l5400h
l5470h:
ld a,0x01
ld (endf_fvar),a
jr l542ch
l5477h:
ld c,a
ld a,(base_fvar)
add a,0x37
cp c
jp c,error_0x03_undefined_word_xxx_1
ld a,c
sub 0x37
jr l541ch
error_0x03_undefined_word_xxx_1:
ld a,0x03
jp error_a
emit_link_field:
defw number_name
emit_name_field:
defb 0x04
emit_name:
defm "EMIT"
emit_code_field:
call pop_hl
ld a,l
call print_a
ret
u_dot_link_field:
defw emit_name
u_dot_name_field:
defb 0x02
u_dot_name:
defm "U."
u_dot_code_field:
ld hl,(stp_fvar)
push hl
l54a3h:
ld hl,(base_fvar)
call push_hl
call slash_mod_code_field
call swap_code_field
call pop_hl
ld a,0x09
cp l
jr c,l54cdh
ld a,0x30
l54b9h:
add a,l
ld l,a
call push_hl
call swap_code_field
call pop_hl
ld a,h
or l
jr z,l54d1h
call push_hl
jr l54a3h
l54cdh:
ld a,0x37
jr l54b9h
l54d1h:
pop hl
ld de,(stp_fvar)
sbc hl,de
srl l
ld b,l
inc b
l54dch:
call pop_hl
ld a,l
push bc
call print_a
pop bc
djnz l54dch
ld a,0x20
call print_a
ret
slash_mod_link_field:
defw u_dot_name
slash_mod_name_field:
defb 0x04
slash_mod_name:
defm "/MOD"
slash_mod_code_field:
call pop_hl_de
de_hl_slash_mod:
ex de,hl
ld a,d
or e
jp z,error_0x05_division_by_zero
and a
ld b,d
ld c,e
ld de,0xffff
l5503h:
inc de
sbc hl,bc
jr nc,l5503h
add hl,bc
ex de,hl
call push_hl_de
ret
error_0x05_division_by_zero:
ld a,0x05
jp error_a
jp jp_clear_lower_screen ; xxx -- not used
jp l59bah ; xxx -- not used; it looks forgotten code of SamForth-A
cls_link_field:
defw slash_mod_name
cls_name_field:
defb 0x03
cls_name:
defm "CLS"
cls_code_field:
jp jp_cls
create_link_field:
defw cls_name
create_name_field:
defb 0x06
create_name:
defm "CREATE"
create_code_field:
call create_header_with_name_from_the_input_stream
call save_dictionary_pointers
ret
create_header_with_name_from_the_input_stream:
ld de,(ip_fvar)
ld hl,(here_fvar)
l5539h:
inc de
ld a,(de)
cp 0x20
jr z,l5539h
ld bc,(latest_fvar)
ld (hl),c
inc hl
ld (hl),b
push de
ld b,0x00
l5549h:
ld a,(de)
cp 0x20
jr z,l5556h
cp 0x0d
jr z,l5556h
inc b
inc de
jr l5549h
l5556h:
ld a,b
inc hl
ld (hl),a
pop de
inc hl
ld (latest_fvar),hl
l555eh:
ld a,(de)
ld (hl),a
inc de
inc hl
djnz l555eh
ld (here_fvar),hl
dec de
ld (ip_fvar),de
ret
colon_link_field:
defw create_name
colon_name_field:
defb 0x41
colon_name:
defm ":"
colon_code_field:
ld a,(state_fvar)
bit 7,a
jr nz,error_0x04_colon_definitions_only_xxx_2
set 7,a
ld (state_fvar),a
call create_header_with_name_from_the_input_stream
ld hl,0x0001
call push_hl
ret
error_0x04_colon_definitions_only_xxx_2:
ld a,0x04
jp error_a
semicolon_link_field:
defw colon_name
semicolon_name_field:
defb 0x41
semicolon_name:
defm ";"
semicolon_code_field:
call pop_hl
ld a,0x01
cp l
jr nz,error_0x0a_not_found
ld hl,(here_fvar)
ld (hl),0xc9
inc hl
ld (here_fvar),hl
ld a,0x00
ld (state_fvar),a
call save_dictionary_pointers
ret
error_0x0a_not_found:
ld a,0x0a
jp error_a
cr_link_field:
defw semicolon_name
cr_name_field:
defb 0x02
cr_name:
defm "CR"
cr_code_field:
ld a,0x0d
call print_a
ret
mode_link_field:
defw cr_name
mode_name_field:
defb 0x04
mode_name:
defm "MODE"
mode_code_field:
jp jp_mode
vlist_link_field:
defw mode_name
vlist_name_field:
defb 0x05
vlist_name:
defm "VLIST"
vlist_code_field:
ld hl,(latest_fvar)
l55cfh:
dec hl
push hl
ld c,(hl)
res 7,c
res 6,c
ld b,0x00
inc hl
call type_bc_chars_at_hl
ld a,0x20
call print_a
pop hl
dec hl
ld b,(hl)
dec hl
ld c,(hl)
ld h,b
ld l,c
ld a,0xff
cp b
jr nz,l55cfh
cp c
jr nz,l55cfh
ld a,0x0d
call print_a
ret
base_link_field:
defw vlist_name
base_name_field:
defb 0x04
base_name:
defm "BASE"
base_code_field:
call pop_hl
ld a,l
base_a:
ld hl,base_fvar
ld (hl),a
ret
decimal_link_field:
defw base_name
decimal_name_field:
defb 0x07
decimal_name:
defm "DECIMAL"
decimal_code_field:
ld a,0x0a
jp base_a
hex_link_field:
defw decimal_name
hex_name_field:
defb 0x03
hex_name:
defm "HEX"
hex_code_field:
ld a,0x10
jp base_a
c_comma_link_field:
defw hex_name
c_comma_name_field:
defb 0x02
c_comma_name:
defm "C,"
c_comma_code_field:
call pop_hl
ld a,l
ld hl,(here_fvar)
ld (hl),a
inc hl
ld (here_fvar),hl
call save_dictionary_pointers
ret
comma_link_field:
defw c_comma_name
comma_name_field:
defb 0x01
comma_name:
defm ","
comma_code_field:
call pop_hl
ld de,(here_fvar)
ex de,hl
ld (hl),e
inc hl
ld (hl),d
inc hl
ld (here_fvar),hl
call save_dictionary_pointers
ret
allot_link_field:
defw comma_name
allot_name_field:
defb 0x05
allot_name:
defm "ALLOT"
allot_code_field:
call pop_hl
ld de,(here_fvar)
add hl,de
ld (here_fvar),hl
call save_dictionary_pointers
ret
store_link_field:
defw allot_name
store_name_field:
defb 0x01
store_name:
defm "!"
store_code_field:
call pop_hl_de
ld (hl),e
inc hl
ld (hl),d
ret
c_store_link_field:
defw store_name
c_store_name_field:
defb 0x02
c_store_name:
defm "C!"
c_store_code_field:
call pop_hl_de
ld (hl),e
ret
fetch_link_field:
defw c_store_name
fetch_name_field:
defb 0x01
fetch_name:
defm "@"
fetch_code_field:
call pop_hl
ld e,(hl)
inc hl
ld d,(hl)
ex de,hl
call push_hl
ret
c_fetch_link_field:
defw fetch_name
c_fetch_name_field:
defb 0x02
c_fetch_name:
defm "C@"
c_fetch_code_field:
call pop_hl
ld l,(hl)
ld h,0x00
call push_hl
ret
here_link_field:
defw c_fetch_name
here_name_field:
defb 0x04
here_name:
defm "HERE"
here_code_field:
ld hl,(here_fvar)
call push_hl
ret
latest_link_field:
defw here_name
latest_name_field:
defb 0x06
latest_name:
defm "LATEST"
latest_code_field:
ld hl,(latest_fvar)
call push_hl
ret
semicolon_code_link_field:
defw latest_name
semicolon_code_name_field:
defb 0x45
semicolon_code_name:
defm ";CODE"
semicolon_code_code_field:
call pop_hl
ld a,0x01
cp l
jr z,l56cch
ld (pairs_fvar),a
call push_hl
jr l56d1h
l56cch:
ld a,0x00
ld (pairs_fvar),a
l56d1h:
ld a,0x00
ld (state_fvar),a
call save_dictionary_pointers
ret
code_colon_link_field:
defw semicolon_code_name
code_colon_name_field:
defb 0x45
code_colon_name:
defm "CODE:"
code_colon_code_field:
ld a,0x80
ld (state_fvar),a
ld a,(pairs_fvar)
cp 0x00
ret nz
ld hl,0x0001
call push_hl
ret
in_link_field:
defw code_colon_name
in_name_field:
defb 0x02
in_name:
defm "IN"
in_code_field:
call pop_hl
ld b,h
ld c,l
in a,(c)
ld l,a
ld h,0x00
call push_hl
ret
out_link_field:
defw in_name
out_name_field:
defb 0x03
out_name:
defm "OUT"
out_code_field:
call pop_hl_de
ld b,h
ld c,l
out (c),e
ret
page_link_field:
defw out_name
page_name_field:
defb 0x04
page_name:
defm "PAGE"
page_code_field:
call pop_hl
ld a,l
ld (pageno_fvar),a
out (hmpr),a
ret
do_link_field:
defw page_name
do_name_field:
defb 0x82
do_name:
defm "DO"
do_code_field:
ld de,l573bh
call compile_call_de
call push_hl
ld hl,0x0002
call push_hl
ret
l573bh:
pop bc
call pop_hl_de
push hl
push de
push bc
ret
sub_5743h:
call pop_hl
cp l
jr nz,error_0x09_incomplete_form
ret
error_0x09_incomplete_form:
ld a,0x09
jp error_a
l574fh:
pop hl
pop de
pop bc
push hl
push bc
ld a,0x80
xor d
ld d,a
call pop_hl
ld b,h
ld c,l
pop hl
add hl,bc
rl b
push af
ld b,h
ld c,l
ld a,0x80
xor h
ld h,a
pop af
jr c,l5772h
and a
sbc hl,de
jr c,l5779h
jr l5785h
l5772h:
and a
sbc hl,de
jr c,l5785h
jr z,l5785h
l5779h:
pop hl
push bc
ld a,0x80
xor d
ld d,a
push de
ld c,(hl)
inc hl
ld b,(hl)
push bc
ret
l5785h:
pop hl
inc hl
inc hl
jp (hl)
l5789h:
jp l62cdh
plus_loop_link_field:
defw do_name
plus_loop_name_field:
defb 0x85
plus_loop_name:
defm "+LOOP"
plus_loop_code_field:
ld a,0x02
call sub_5743h
ld de,l574fh
call compile_call_de
call sub_57a3h
ret
sub_57a3h:
call pop_hl
ld b,h
ld c,l
ld hl,(here_fvar)
ld (hl),c
inc hl
ld (hl),b
inc hl
ld (here_fvar),hl
ret
loop_link_field:
defw plus_loop_name
loop_name_field:
defb 0x84
loop_name:
defm "LOOP"
loop_code_field:
ld a,0x02
call sub_5743h
ld de,l5789h
call compile_call_de
call sub_57a3h
ret
i_link_field:
defw loop_name
i_name_field:
defb 0x01
i_name:
defm "I"
i_code_field:
pop bc
pop de
pop hl
push hl
push de
push bc
call push_hl
ret
link_link_field:
defw i_name
link_name_field:
defb 0x04
link_name:
defm "LINK"
link_code_field:
jp jp_link
jp jp_link_l
at_link_field:
defw link_name
at_name_field:
defb 0x02
at_name:
defm "AT"
at_code_field:
jp jp_at
border_link_field:
defw at_name
border_name_field:
defb 0x06
border_name:
defm "BORDER"
border_code_field:
jp jp_border
beep_link_field:
defw border_name
beep_name_field:
defb 0x04
beep_name:
defm "BEEP"
beep_code_field:
jp jp_beep
dot_quote_link_field:
defw beep_name
dot_quote_name_field:
defb 0x82
dot_quote_name:
defb 0x2e,0x22 ; '."' string -- notation compatible with Pasmo and pyz80
dot_quote_code_field:
ld de,l582bh
call compile_call_de
ld de,(ip_fvar)
inc de
l5812h:
inc de
ld a,(de)
cp 0x22
jr z,l5820h
cp 0x0d
jr z,l5820h
ld (hl),a
inc hl
jr l5812h
l5820h:
ld (hl),0xff
inc hl
ld (here_fvar),hl
ld (ip_fvar),de
ret
l582bh:
pop hl
l582ch:
ld a,(hl)
cp 0xff
jr z,l5837h
call print_a
inc hl
jr l582ch
l5837h:
inc hl
jp (hl)
sc_store_link_field:
defw dot_quote_name
sc_store_name_field:
defb 0x03
sc_store_name:
defm "SC!"
sc_store_code_field:
in a,(0xfc)
and 0x1f
out (hmpr),a
call pop_hl_de
ld bc,0x8000
add hl,bc
ld (hl),e
jp page_pageno_in_and_set_iy_to_flags
sc_fetch_link_field:
defw sc_store_name
sc_fetch_name_field:
defb 0x03
sc_fetch_name:
defm "SC@"
sc_fetch_code_field:
in a,(0xfc)
and 0x1f
out (hmpr),a
call pop_hl
ld bc,0x8000
add hl,bc
ld l,(hl)
ld h,0x00
call push_hl
jp page_pageno_in_and_set_iy_to_flags
p_link_field:
defw sc_fetch_name
p_name_field:
defb 0x01
p_name:
defm "P"
p_code_field:
jp jp_editor_command_p
clear_link_field:
defw p_name
clear_name_field:
defb 0x05
clear_name:
defm "CLEAR"
clear_code_field:
jp jp_clear
l_link_field:
defw clear_name
l_name_field:
defb 0x01
l_name:
defm "L"
l_code_field:
jp jp_editor_command_l
b_link_field:
defw l_name
b_name_field:
defb 0x01
b_name:
defm "B"
b_code_field:
ld b,0x0f
l588bh:
call jp_editor_command_from
djnz l588bh
jp l_name ; xxx fixme -- wrong jump
r_link_field:
defw b_name
r_name_field:
defb 0x01
r_name:
defm "R"
r_code_field:
call sub_40d2h
jp jp_editor_command_l
c_link_field:
defw r_name
c_name_field:
defb 0x01
c_name:
defm "C"
c_code_field:
call swap_code_field
call jp_editor_command_h
call sub_40d2h
jp jp_editor_command_l
e_link_field:
defw c_name
e_name_field:
defb 0x01
e_name:
defm "E"
e_code_field:
call sub_40cfh
jp jp_editor_command_l
up_link_field:
defw e_name
up_name_field:
defb 0x02
up_name:
defm "UP"
up_code_field:
call pop_hl
ld b,l
l58c0h:
call sub_40d8h
djnz l58c0h
jp l_name ; xxx fixme -- wrong jump
dn_link_field:
defw up_name
dn_name_field:
defb 0x02
dn_name:
defm "DN"
dn_code_field:
call pop_hl
ld b,l
l58d1h:
call jp_editor_command_from
djnz l58d1h
jp l_name ; xxx fixme -- wrong jump
newl_link_field:
defw dn_name
newl_name_field:
defb 0x04
newl_name:
defm "NEWL"
newl_code_field:
jp jp_newl
list_link_field:
defw newl_name
list_name_field:
defb 0x04
list_name:
defm "LIST"
list_code_field:
jp jp_list
t_link_field:
defw list_name
t_name_field:
defb 0x01
t_name:
defm "T"
t_code_field:
ld hl,(st_fvar)
ld (lists_fvar),hl
ret
es_link_field:
defw t_name
es_name_field:
defb 0x02
es_name:
defm "ES"
es_code_field:
ld hl,(se_fvar)
ld (elist_fvar),hl
ret
from_link_field:
defw es_name
from_name_field:
defb 0x04
from_name:
defm "FROM"
from_code_field:
call jp_editor_command_f
jp jp_editor_command_from
f_link_field:
defw from_name
f_name_field:
defb 0x01
f_name:
defm "F"
f_code_field:
jp jp_editor_command_f
to_link_field:
defw f_name
to_name_field:
defb 0x02
to_name:
defm "TO"
to_code_field:
jp jp_editor_command_to
edit_link_field:
defw to_name
edit_name_field:
defb 0x04
edit_name:
defm "EDIT"
edit_code_field:
jp jp_edit
n_link_field:
defw edit_name
n_name_field:
defb 0x01
n_name:
defm "N"
n_code_field:
jp jp_editor_command_n
del_link_field:
defw n_name
del_name_field:
defb 0x03
del_name:
defm "DEL"
del_code_field:
call pop_hl
ld b,l
l593bh:
push bc
call dup_code_field
call sub_40c9h
pop bc
djnz l593bh
call drop_code_field
jp l_name ; xxx fixme -- wrong jump
d_link_field:
defw del_name
d_name_field:
defb 0x01
d_name:
defm "D"
d_code_field:
call sub_40c9h
jp jp_editor_command_l
ins_link_field:
defw d_name
ins_name_field:
defb 0x03
ins_name:
defm "INS"
ins_code_field:
call pop_hl
ld b,l
l595fh:
push bc
call dup_code_field
call sub_40c6h
pop bc
djnz l595fh
call drop_code_field
jp l_name ; xxx fixme -- wrong jump
s_link_field:
defw ins_name
s_name_field:
defb 0x01
s_name:
defm "S"
s_code_field:
call sub_40c6h
jp jp_editor_command_l
h_link_field:
defw s_name
h_name_field:
defb 0x01
h_name:
defm "H"
h_code_field:
jp jp_editor_command_h
load_link_field:
defw h_name
load_name_field:
defb 0x04
load_name:
defm "LOAD"
load_code_field:
jp jp_load
where_link_field:
defw load_name
where_name_field:
defb 0x05
where_name:
defm "WHERE"
where_code_field:
jp jp_where
star_link_field:
defw where_name
star_name_field:
defb 0x01
star_name:
defm "*"
star_code_field:
call u_mult_code_field
call pop_hl
ret
type_link_field:
defw star_name
type_name_field:
defb 0x04
type_name:
defm "TYPE"
type_code_field:
call pop_hl_de
ex de,hl
ld b,d
ld c,e
call type_bc_chars_at_hl
ret
sam_link_field:
defw type_name
sam_name_field:
defb 0x03
sam_name:
defm "SAM"
sam_code_field:
jp jp_sam
l59bah: ; xxx -- not used; it looks forgotten code of SamForth-A
push af
ld a,0x01
out (hmpr),a
pop af
jp 0xc378
ld a,0x01
out (hmpr),a
jp 0xc3b4
save_link_field:
defw sam_name
save_name_field:
defb 0x04
save_name:
defm "SAVE"
save_code_field:
jp jp_save
dir_link_field:
defw save_name
dir_name_field:
defb 0x03
dir_name:
defm "DIR"
dir_code_field:
jp jp_dir
equals_link_field:
defw dir_name
equals_name_field:
defb 0x01
equals_name:
defm "="
equals_code_field:
call pop_hl_de
ld a,l
cp e
jr nz,push_false
ld a,h
cp d
jr nz,push_false
push_true:
ld hl,0x0001
l59efh:
call push_hl
ret
push_false:
ld hl,0x0000
jr l59efh
slash_link_field:
defw equals_name
slash_name_field:
defb 0x01
slash_name:
defm "/"
slash_code_field:
call slash_mod_code_field
call swap_code_field
call pop_hl
ret
mod_link_field:
defw slash_name
mod_name_field:
defb 0x03
mod_name:
defm "MOD"
mod_code_field:
call slash_mod_code_field
call pop_hl
ret
begin_link_field:
defw mod_name
begin_name_field:
defb 0x85
begin_name:
defm "BEGIN"
begin_code_field:
ld hl,(here_fvar)
call push_hl
ld hl,0x0003
call push_hl
ret
until_link_field:
defw begin_name
until_name_field:
defb 0x85
until_name:
defm "UNTIL"
until_code_field:
ld a,0x03
call sub_5743h
ld de,zero_branch_code_field
call compile_call_de
call sub_57a3h
ret
less_than_link_field:
defw until_name
less_than_name_field:
defb 0x01
less_than_name:
defm "<"
less_than_code_field:
call pop_hl_de
ex de,hl
ld a,d
xor h
bit 7,a
jr nz,l5a4fh
sbc hl,de
l5a4fh:
bit 7,h
jp z,push_false
jp push_true
greater_than_link_field:
defw less_than_name
greater_than_name_field:
defb 0x01
greater_than_name:
defm ">"
greater_than_code_field:
call swap_code_field
call less_than_code_field
ret
to_r_link_field:
defw greater_than_name
to_r_name_field:
defb 0x02
to_r_name:
defm "R>"
to_r_code_field:
pop bc
pop hl
push bc
call push_hl
ret
r_from_link_field:
defw to_r_name
r_from_name_field:
defb 0x02
r_from_name:
defm ">R"
r_from_code_field:
call pop_hl
pop bc
push hl
push bc
ret
key_link_field:
defw r_from_name
key_name_field:
defb 0x03
key_name:
defm "KEY"
key_code_field:
call jsvin_rom_routine
defw jreadkey_rom_routine
cp 0x00
jr nz,key_code_field
l5a89h:
call jsvin_rom_routine
defw jwaitkey_rom_routine
cp 0x00
jr z,l5a89h
ld l,a
ld h,0x00
call push_hl
call jsvin_rom_routine
defw jkbflush_rom_routine
ret
over_link_field:
defw key_name
over_name_field:
defb 0x04
over_name:
defm "OVER"
over_code_field:
call pop_hl_de
call push_hl_de
ex de,hl
call push_hl
ret
rot_link_field:
defw over_name
rot_name_field:
defb 0x03
rot_name:
defm "ROT"
rot_code_field:
call pop_hl_de
ld b,h
ld c,l
call pop_hl
push hl
ld h,b
ld l,c
call push_hl_de
pop hl
call push_hl
ret
two_dup_link_field:
defw rot_name
two_dup_name_field:
defb 0x04
two_dup_name:
defm "2DUP"
two_dup_code_field:
call pop_hl_de
call push_hl_de
call push_hl_de
ret
pad_link_field:
defw two_dup_name
pad_name_field:
defb 0x03
pad_name:
defm "PAD"
pad_code_field:
ld hl,(pad_fvar)
call push_hl
ret
query_link_field:
defw pad_name
query_name_field:
defb 0x05
query_name:
defm "QUERY"
query_code_field:
ld hl,(tib_fvar)
push hl
ld hl,(pad_fvar)
inc hl
ld (tib_fvar),hl
call restore_the_input_pointer
pop hl
ld (tib_fvar),hl
ret
retype_link_field:
defw query_name
retype_name_field:
defb 0x06
retype_name:
defm "RETYPE"
retype_code_field:
ld hl,(tib_fvar)
push hl
ld hl,(pad_fvar)
inc hl
ld (tib_fvar),hl
call keyboard_input
pop hl
ld (tib_fvar),hl
ret
word_link_field:
defw retype_name
word_name_field:
defb 0x04
word_name:
defm "WORD"
word_code_field:
call pop_hl
ld a,l
ld hl,(pad_fvar)
ld d,0xff
l5b2eh:
inc hl
inc d
cp (hl)
jr nz,l5b2eh
ld hl,(pad_fvar)
ld (hl),d
call push_hl
ret
if_link_field:
defw word_name
if_name_field:
defb 0x82
if_name:
defm "IF"
if_code_field:
ld de,zero_branch_code_field
call compile_call_de
call push_hl
inc hl
inc hl
ld (here_fvar),hl
ld hl,0x0004
call push_hl
ret
else_link_field:
defw if_name
else_name_field:
defb 0x84
else_name:
defm "ELSE"
else_code_field:
ld a,0x04
call sub_5743h
ld de,branch_code_field
call compile_call_de
push hl
inc hl
inc hl
ld (here_fvar),hl
call pop_hl
ld bc,(here_fvar)
ld (hl),c
inc hl
ld (hl),b
pop hl
call push_hl
ld hl,0x0004
call push_hl
ret
endif_link_field:
defw else_name
endif_name_field:
defb 0x85
endif_name:
defm "ENDIF"
endif_code_field:
ld a,0x04
call sub_5743h
call pop_hl
ld bc,(here_fvar)
ld (hl),c
inc hl
ld (hl),b
ret
then_link_field:
defw endif_name
then_name_field:
defb 0x84
then_name:
defm "THEN"
then_code_field:
jp endif_code_field
builds_link_field:
defw then_name
builds_name_field:
defb 0x87
builds_name:
defm "<BUILDS"
builds_code_field:
ld de,create_header_with_name_from_the_input_stream
call compile_call_de
ld (hl),0x11
inc hl
call push_hl
inc hl
inc hl
ld (here_fvar),hl
ld de,compile_call_de
call compile_call_de
ld (hl),0x36
inc hl
ld (hl),0xc9
inc hl
ld (hl),0x23
inc hl
ld (hl),0x22
inc hl
ld bc,here_fvar
ld (hl),c
inc hl
ld (hl),b
inc hl
ld (here_fvar),hl
ld hl,0x0009
call push_hl
ret
does_link_field:
defw builds_name
does_name_field:
defb 0x85
does_name:
defm "DOES>"
does_code_field:
ld a,0x09
call sub_5743h
ld hl,(here_fvar)
ld (hl),0xc9
inc hl
ld (here_fvar),hl
ld d,h
ld e,l
call pop_hl
ld (hl),e
inc hl
ld (hl),d
ld hl,(here_fvar)
ld (hl),0xe1
inc hl
ld (hl),0xe5
inc hl
ld (hl),0x23
inc hl
ld (hl),0xcd
inc hl
ld bc,push_hl
ld (hl),c
inc hl
ld (hl),b
inc hl
ld (here_fvar),hl
ret
while_link_field:
defw does_name
while_name_field:
defb 0x85
while_name:
defm "WHILE"
while_code_field:
ld a,0x03
call sub_5743h
ld de,zero_branch_code_field
call compile_call_de
call push_hl
inc hl
inc hl
ld (here_fvar),hl
ld hl,0x0003
call push_hl
ret
repeat_link_field:
defw while_name
repeat_name_field:
defb 0x86
repeat_name:
defm "REPEAT"
repeat_code_field:
ld a,0x03
call sub_5743h
ld de,branch_code_field
call compile_call_de
push hl
inc hl
inc hl
ld (here_fvar),hl
ld b,h
ld c,l
call pop_hl
ld (hl),c
inc hl
ld (hl),b
call pop_hl
ld b,h
ld c,l
pop hl
ld (hl),c
inc hl
ld (hl),b
ret
variable_link_field:
defw repeat_name
variable_name_field:
defb 0x08
variable_name:
defm "VARIABLE"
variable_code_field:
call create_header_with_name_from_the_input_stream
ld de,l5c8fh
call compile_call_de
ld hl,(here_fvar)
ld (hl),0xc9
inc hl
ld (hl),0x00
inc hl
ld (hl),0x00
inc hl
ld (here_fvar),hl
call save_dictionary_pointers
ret
l5c8fh:
pop hl
push hl
inc hl
call push_hl
ret
constant_link_field:
defw variable_name
constant_name_field:
defb 0x08
constant_name:
defm "CONSTANT"
constant_code_field:
call create_header_with_name_from_the_input_stream
ld de,l5cbfh
call compile_call_de
call pop_hl
ex de,hl
ld hl,(here_fvar)
ld (hl),0xc9
inc hl
ld (hl),e
inc hl
ld (hl),d
inc hl
ld (here_fvar),hl
call save_dictionary_pointers
ret
l5cbfh:
pop hl
push hl
inc hl
ld e,(hl)
inc hl
ld d,(hl)
ex de,hl
call push_hl
ret
dot_link_field:
defw constant_name
dot_name_field:
defb 0x01
dot_name:
defm "."
dot_code_field:
call pop_hl
bit 7,h
jr z,l5ce0h
ex de,hl
ld hl,0x0000
sbc hl,de
ld a,0x2d
call print_a
l5ce0h:
call push_hl
jp u_dot_code_field
cmove_link_field:
defw dot_name
cmove_name_field:
defb 0x05
cmove_name:
defm "CMOVE"
cmove_code_field:
call pop_hl
ld a,h
or l
jr z,l5cfeh
ld b,h
ld c,l
call pop_hl_de
ex de,hl
ldir
ret
l5cfeh:
call pop_hl_de
ret
and_link_field:
defw cmove_name
and_name_field:
defb 0x03
and_name:
defm "AND"
and_code_field:
call pop_hl_de
ld a,e
and l
ld l,a
ld a,d
and h
ld h,a
call push_hl
ret
or_link_field:
defw and_name
or_name_field:
defb 0x02
or_name:
defm "OR"
or_code_field:
call pop_hl_de
ld a,e
or l
ld l,a
ld a,d
or h
ld h,a
call push_hl
ret
xor_link_field:
defw or_name
xor_name_field:
defb 0x03
xor_name:
defm "XOR"
xor_code_field:
call pop_hl_de
ld a,e
xor l
ld l,a
ld a,d
xor h
ld h,a
call push_hl
ret
not_link_field:
defw xor_name
not_name_field:
defb 0x03
not_name:
defm "NOT"
not_code_field:
call pop_hl
ld a,0x00
cp l
inc hl
jr z,l5d4bh
ld l,0x00
l5d4bh:
ld h,0x00
call push_hl
ret
find_link_field:
defw not_name
find_name_field:
defb 0x04
find_name:
defm "FIND"
find_code_field:
ld de,(ip_fvar)
l5d5ch:
inc de
ld a,(de)
cp 0x20
jr z,l5d5ch
cp 0x0d
jr z,l5d5ch
ld (ip_fvar),de
call paren_find_code_field
ret
cold_link_field:
defw find_name
cold_name_field:
defb 0x44
cold_name:
defm "COLD"
cold_code_field:
ld hl,(clate_fvar)
ld (latest_fvar),hl
ld hl,(chere_fvar)
ld (here_fvar),hl
ld (fence_fvar),hl
call save_dictionary_pointers
ld hl,(stack_fvar)
ld (stp_fvar),hl
ld a,0x00
ld (state_fvar),a
ld (ldflg_fvar),a
ret
fence_link_field:
defw cold_name
fence_name_field:
defb 0x05
fence_name:
defm "FENCE"
fence_code_field:
ld hl,fence_fvar
call push_hl
ret
u_slash_mod_link_field:
defw fence_name
u_slash_mod_name_field:
defb 0x05
u_slash_mod_name:
defm "U/MOD"
u_slash_mod_code_field:
call pop_hl
ld b,h
ld c,l
call pop_hl_de
ld a,l
sub c
ld a,h
sbc a,b
jr c,l5dc3h
ld hl,0xffff
ld de,0xffff
jr l5de3h
l5dc3h:
ld a,0x10
l5dc5h:
add hl,hl
rla
ex de,hl
add hl,hl
jr nc,l5dcdh
inc de
and a
l5dcdh:
ex de,hl
rra
push af
jr nc,l5dd7h
and l
sbc hl,bc
jr l5ddeh
l5dd7h:
and a
sbc hl,bc
jr nc,l5ddeh
add hl,bc
dec de
l5ddeh:
inc de
pop af
dec a
jr nz,l5dc5h
l5de3h:
ex de,hl
call push_hl_de
ret
less_number_sign_link_field:
defw u_slash_mod_name
less_number_sign_name_field:
defb 0x02
less_number_sign_name:
defm "<#"
less_number_sign_code_field:
call pad_code_field
call pop_hl
ld (hlds_fvar),hl
ret
number_sign_greater_link_field:
defw less_number_sign_name
number_sign_greater_name_field:
defb 0x02
number_sign_greater_name:
defm "#>"
number_sign_greater_code_field:
call pop_hl_de
ld hl,(hlds_fvar)
call push_hl
call pad_code_field
call over_code_field
call minus_code_field
ret
number_sign_link_field:
defw number_sign_greater_name
number_sign_name_field:
defb 0x01
number_sign_name:
defm "#"
number_sign_code_field:
ld hl,(base_fvar)
call push_hl
call sub_5fc2h
call rot_code_field
ld hl,0x0009
call push_hl
call over_code_field
call less_than_code_field
call zero_branch_code_field
defw branch_5e39
ld hl,0x0007
call push_hl
call plus_code_field
branch_5e39:
ld hl,0x0030
call push_hl
call plus_code_field
call hold_code_field
ret
number_sign_s_link_field:
defw number_sign_name
number_sign_s_name_field:
defb 0x02
number_sign_s_name:
defm "#S"
number_sign_s_code_field:
branch_5e4b:
call number_sign_code_field
call over_code_field
call over_code_field
call or_code_field
call zero_equals_code_field
call zero_branch_code_field
defw branch_5e4b
ret
d_dot_link_field:
defw number_sign_s_name
d_dot_name_field:
defb 0x02
d_dot_name:
defm "D."
d_dot_code_field:
call less_number_sign_code_field
call number_sign_s_code_field
call number_sign_greater_code_field
call type_code_field
ld a,0x20
call print_a
ret
hold_link_field:
defw d_dot_name
hold_name_field:
defb 0x04
hold_name:
defm "HOLD"
hold_code_field:
ld hl,(hlds_fvar)
dec hl
ld (hlds_fvar),hl
call pop_hl
ld a,l
ld hl,(hlds_fvar)
ld (hl),a
ret
sign_link_field:
defw hold_name
sign_name_field:
defb 0x04
sign_name:
defm "SIGN"
sign_code_field:
call rot_code_field
call zero_less_code_field
call zero_branch_code_field
defw branch_5ea9
ld hl,0x002d
call push_hl
call hold_code_field
branch_5ea9:
ret
call dup_code_field
call zero_less_code_field
call zero_branch_code_field
defw branch_5eb8
call d_do_minus_code_field
branch_5eb8:
ret
zero_equals_link_field:
defw sign_name
zero_equals_name_field:
defb 0x02
zero_equals_name:
defm "0="
zero_equals_code_field:
call pop_hl
ld a,l
or h
ld hl,0x0000
jr nz,l5ec9h
inc hl
l5ec9h:
call push_hl
ret
zero_less_link_field:
defw zero_equals_name
zero_less_name_field:
defb 0x02
zero_less_name:
defm "0<"
zero_less_code_field:
call pop_hl
bit 7,h
ld hl,0x0000
jr z,l5eddh
inc hl
l5eddh:
call push_hl
ret
inkey_link_field:
defw zero_less_name
inkey_name_field:
defb 0x05
inkey_name:
defm "INKEY"
inkey_code_field:
call jsvin_rom_routine
defw jreadkey_rom_routine
ld h,0x00
ld l,a
call push_hl
ret
forget_link_field:
defw inkey_name
forget_name_field:
defb 0x06
forget_name:
defm "FORGET"
forget_code_field:
call find_code_field
ex de,hl
call pop_hl
ld a,h
or l
jr z,error_0x03_undefined_word_xxx_2
ld hl,(fence_fvar)
sbc hl,de
jr nc,error_0x08_break
ex de,hl
dec hl
ld b,(hl)
dec hl
ld c,(hl)
ld (latest_fvar),bc
ld (here_fvar),hl
call save_dictionary_pointers
ret
error_0x03_undefined_word_xxx_2:
ld a,0x03
jp error_a
error_0x08_break:
ld a,0x08
jp error_a
error_link_field:
defw forget_name
error_name_field:
defb 0x05
error_name:
defm "ERROR"
error_code_field:
call pop_hl
ld a,l
jp error_a
paren_link_field:
defw error_name
paren_name_field:
defb 0x01
paren_name:
defm "("
paren_code_field:
ld hl,(ip_fvar)
l5f40h:
inc hl
ld a,0x29
cp (hl)
jr nz,l5f40h
ld (ip_fvar),hl
ret
pick_link_field:
defw paren_name
pick_name_field:
defb 0x04
pick_name:
defm "PICK"
pick_code_field:
call pop_hl
ld a,h
or l
ret z
ld e,l
dec e
rl e
ld hl,(stp_fvar)
ld d,0x00
add hl,de
ld c,(hl)
inc hl
ld b,(hl)
ld h,b
ld l,c
call push_hl
ret
roll_link_field:
defw pick_name
roll_name_field:
defb 0x04
roll_name:
defm "ROLL"
roll_code_field:
call pop_hl
ld a,h
or l
ret z
ld b,l
ld c,l
l5f79h:
call pop_hl
push hl
djnz l5f79h
pop de
ld b,c
dec b
l5f82h:
pop hl
call push_hl
djnz l5f82h
ld h,d
ld l,e
call push_hl
ret
ascii_link_field:
defw roll_name
ascii_name_field:
defb 0x45
ascii_name:
defm "ASCII"
ascii_code_field:
ld hl,(ip_fvar)
l5f99h:
inc hl
ld a,0x20
cp (hl)
jr z,l5f99h
ld a,(hl)
ld (ip_fvar),hl
ld l,a
ld h,0x00
call push_hl
ld a,(state_fvar)
bit 7,a
ret z
call pop_hl
ld b,h
ld c,l
ld de,lit_code_field
call compile_call_de
ld (hl),c
inc hl
ld (hl),b
inc hl
ld (here_fvar),hl
ret
sub_5fc2h:
call r_from_code_field
ld hl,0x0000
call push_hl
call to_r_code_field
call dup_code_field
call r_from_code_field
call u_slash_mod_code_field
call to_r_code_field
call swap_code_field
call r_from_code_field
call u_slash_mod_code_field
call to_r_code_field
ret
paper_link_field:
defw ascii_name
paper_name_field:
defb 0x05
paper_name:
defm "PAPER"
paper_code_field:
jp jp_paper
pen_link_field:
defw paper_name
pen_name_field:
defb 0x03
pen_name:
defm "PEN"
pen_code_field:
jp jp_pen
bright_link_field:
defw pen_name
bright_name_field:
defb 0x06
bright_name:
defm "BRIGHT"
bright_code_field:
jp jp_bright
flash_link_field:
defw bright_name
flash_name_field:
defb 0x05
flash_name:
defm "FLASH"
flash_code_field:
jp jp_flash
colour_link_field:
defw flash_name
colour_name_field:
defb 0x06
colour_name:
defm "COLOUR"
colour_code_field:
jp jp_colour
plot_link_field:
defw colour_name
plot_name_field:
defb 0x04
plot_name:
defm "PLOT"
plot_code_field:
jp jp_call_jplot
draw_link_field:
defw plot_name
draw_name_field:
defb 0x04
draw_name:
defm "DRAW"
draw_code_field:
jp jp_call_jdrawto
drawby_link_field:
defw draw_name
drawby_name_field:
defb 0x06
drawby_name:
defm "DRAWBY"
drawby_code_field:
call pop_hl_de
ex de,hl
ld bc,(xcord_fvar)
add hl,bc
ld a,(ycord_fvar)
add a,e
ld e,a
ex de,hl
call push_hl_de
jp jp_call_jdrawto
question_scroll_link_field:
defw drawby_name
question_scroll_name_field:
defb 0x07
question_scroll_name:
defm "?SCROLL"
question_scroll_code_field:
call pop_hl
ld a,0x00
out (hmpr),a
ld a,0x01
xor l
ld (0x9abb),a
jp page_pageno_in_and_set_iy_to_flags
palette_link_field:
defw question_scroll_name
palette_name_field:
defb 0x07
palette_name:
defm "PALETTE"
palette_code_field:
call pop_hl_de
ld a,l
push de
call pop_hl_de
ld c,l
ld b,e
pop de
jp jp_call_jpalette
drive_link_field:
defw palette_name
drive_name_field:
defb 0x05
drive_name:
defm "DRIVE"
drive_code_field:
jp jp_change_drive_to_tos
sv_fetch_link_field:
defw drive_name
sv_fetch_name_field:
defb 0x03
sv_fetch_name:
defm "SV@"
sv_fetch_code_field:
jp jp_fetch_from_page_0
sv_store_link_field:
defw sv_fetch_name
sv_store_name_field:
defb 0x03
sv_store_name:
defm "SV!"
sv_store_code_field:
jp jp_store_into_page_0
sv_c_fetch_link_field:
defw sv_store_name
sv_c_fetch_name_field:
defb 0x04
sv_c_fetch_name:
defm "SVC@"
sv_c_fetch_code_field:
jp jp_c_fetch_from_page_0
sv_c_store_link_field:
defw sv_c_fetch_name
sv_c_store_name_field:
defb 0x04
sv_c_store_name:
defm "SVC!"
sv_c_store_code_field:
jp jp_c_store_into_page_0
sound_link_field:
defw sv_c_store_name
sound_name_field:
defb 0x05
sound_name:
defm "SOUND"
sound_code_field:
jp jp_do_sound
soff_link_field:
defw sound_name
soff_name_field:
defb 0x04
soff_name:
defm "SOFF"
soff_code_field:
jp jp_sound_off
rols_link_field:
defw soff_name
rols_name_field:
defb 0x04
rols_name:
defm "ROLS"
rols_code_field:
jp jp_rols
csize_link_field:
defw rols_name
csize_name_field:
defb 0x05
csize_name:
defm "CSIZE"
csize_code_field:
jp jp_csize
udgdef_link_field:
defw csize_name
udgdef_name_field:
defb 0x06
udgdef_name:
defm "UDGDEF"
udgdef_code_field:
jp jp_udgdef
screen_link_field:
defw udgdef_name
screen_name_field:
defb 0x06
screen_name:
defm "SCREEN"
screen_code_field:
jp jp_screen
blitz_link_field:
defw screen_name
blitz_name_field:
defb 0x05
blitz_name:
defm "BLITZ"
blitz_code_field:
jp jp_blitz
blitz_dollar_link_field:
defw blitz_name
blitz_dollar_name_field:
defb 0x06
blitz_dollar_name:
defm "BLITZ$"
blitz_dollar_code_field:
call create_header_with_name_from_the_input_stream
ld de,l6149h
call compile_call_de
ld (hl),0xc9
inc hl
ld (here_fvar),hl
call dup_code_field
call c_comma_code_field
ld hl,(here_fvar)
dec hl
call push_hl
call swap_code_field
call allot_code_field
ld hl,(here_fvar)
dec hl
call push_hl
call l573bh
call i_code_field
call c_store_code_field
call lit_code_field
rst 0x38
rst 0x38
call l574fh
dec (hl)
ld h,c
call save_dictionary_pointers
ret
l6149h:
pop hl
push hl
inc hl
call push_hl
call push_hl
call c_fetch_code_field
call swap_code_field
call pop_hl
inc hl
call push_hl
call swap_code_field
jp jp_blitz
put_link_field:
defw blitz_dollar_name
put_name_field:
defb 0x03
put_name:
defm "PUT"
put_code_field:
jp jp_put
put_dollar_link_field:
defw put_name
put_dollar_name_field:
defb 0x04
put_dollar_name:
defm "PUT$"
put_dollar_code_field:
call pop_hl
push hl
ld a,(hl)
inc hl
ld c,(hl)
ld h,0x00
ld l,a
call push_hl
ld l,c
call push_hl
call star_code_field
call pop_hl
ld b,h
ld c,l
ld de,0xe001
pop hl
ld a,0x1e
out (hmpr),a
ldir
ld a,(pageno_fvar)
out (hmpr),a
ld hl,0xe001
call push_hl
call swap_code_field
jp jp_put
fill_link_field:
defw put_dollar_name
fill_name_field:
defb 0x04
fill_name:
defm "FILL"
fill_code_field:
jp jp_fill
grab_link_field:
defw fill_name
grab_name_field:
defb 0x04
grab_name:
defm "GRAB"
grab_code_field:
jp jp_grab
grab_dollar_link_field:
defw grab_name
grab_dollar_name_field:
defb 0x05
grab_dollar_name:
defm "GRAB$"
grab_dollar_code_field:
call jp_grab
call create_header_with_name_from_the_input_stream
ld de,l620dh
call compile_call_de
ld (hl),0xc9
inc hl
ld (here_fvar),hl
ld a,0x1e
out (hmpr),a
ld hl,0xe001
ld a,(hl)
inc hl
ld c,(hl)
ld h,0x00
ld l,c
call push_hl
ld l,a
call push_hl
call star_code_field
call pop_hl
inc hl
inc hl
ex de,hl
ld hl,(here_fvar)
push hl
add hl,de
ld (here_fvar),hl
ld b,d
ld c,e
pop de
ld hl,0xe001
ldir
ld a,(pageno_fvar)
out (hmpr),a
call save_dictionary_pointers
ret
l620dh:
pop hl
push hl
inc hl
call push_hl
ret
tab_link_field:
defw grab_dollar_name
tab_name_field:
defb 0x03
tab_name:
defm "TAB"
tab_code_field:
jp jp_tab
overp_link_field:
defw tab_name
overp_name_field:
defb 0x05
overp_name:
defm "OVERP"
overp_code_field:
jp jp_overp
inverse_link_field:
defw overp_name
inverse_name_field:
defb 0x07
inverse_name:
defm "INVERSE"
inverse_code_field:
jp jp_inverse
bload_link_field:
defw inverse_name
bload_name_field:
defb 0x05
bload_name:
defm "BLOAD"
bload_code_field:
jp jp_bload
bsave_link_field:
defw bload_name
bsave_name_field:
defb 0x05
bsave_name:
defm "BSAVE"
bsave_code_field:
jp jp_bsave
dload_link_field:
defw bsave_name
dload_name_field:
defb 0x05
dload_name:
defm "DLOAD"
dload_code_field:
jp jp_dload
dsave_link_field:
defw dload_name
dsave_name_field:
defb 0x05
dsave_name:
defm "DSAVE"
dsave_code_field:
jp jp_dsave
page_rampage_in:
ld a,(rampage_fvar)
out (hmpr),a
ret
push_hl_link_field:
defw dsave_name
push_hl_name_field:
defb 0x07
push_hl_name:
defm "PUSH-HL"
push_hl_code_field:
ld hl,push_hl
call_push_hl:
call push_hl
ret
pop_hl_link_field:
defw push_hl_name
pop_hl_name_field:
defb 0x06
pop_hl_name:
defm "POP-HL"
pop_hl_code_field:
ld hl,pop_hl
jr call_push_hl
push_de_link_field:
defw pop_hl_name
push_de_name_field:
defb 0x07
push_de_name:
defm "PUSH-DE"
push_de_code_field:
ld hl,push_hl_de
jr call_push_hl
pop_de_link_field:
defw push_de_name
pop_de_name_field:
defb 0x06
pop_de_name:
defm "POP-DE"
pop_de_code_field:
ld hl,pop_hl_de
jr call_push_hl
expand_link_field:
defw pop_de_name
expand_name_field:
defb 0x06
expand_name:
defm "EXPAND"
expand_code_field:
ld hl,(latest_fvar)
ld (clate_fvar),hl
ld hl,(here_fvar)
inc hl
inc hl
inc hl
inc hl
ld (chere_fvar),hl
ld (fence_fvar),hl
call save_dictionary_pointers
ret
page_pageno_in_and_set_iy_to_flags:
ld a,(pageno_fvar)
out (hmpr),a
ld iy,flags_fvar
ret
l62cdh:
pop de
pop hl
pop bc
inc bc
push hl
and a
sbc hl,bc
jr z,l62e0h
pop hl
push bc
push hl
ex de,hl
ld c,(hl)
inc hl
ld b,(hl)
push bc
ret
l62e0h:
pop bc
ex de,hl
inc hl
inc hl
jp (hl)
nop
nop
nop
nop
cold_here:
Downloads
- samforth-b.bin (16.00 KiB), the SamForth-B binary code.
- samforth-b.bin_blocks.txt (26.52 KiB), its blocks file, required by z80dasm and created by SamForth2z80dasm.
- samforth-b.bin_symbols.z80s (25.79 KiB), its symbols file, required by z80dasm and created by SamForth2z80dasm.
- samforth-b.z80s.gz (15.81 KiB), the SamForth-B disassembled code.
- samforth-b_50000.z80s (657 B), the SamForth-B routines at 50000 and 50020, disassembled.
Tools and other related project files can be downloaded from the download section of SamForth.