SamForth-B

Description of the page content

SamForth-B disassembled.

Tags:

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:

SamForth-BSamForth-B

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

Tools and other related project files can be downloaded from the download section of SamForth.

Related pages

SamForth disassembled
Disassembling of SamForth.
SamForth-A
SamForth-A disassembled.
Development history of SamForth disassembled
Development history of the SamForth disassembling project
SamForth documentation
Edited documentation of SamForth, a Forth system for the SAM Coupé computer.