mirror of https://github.com/mgcaret/of816.git
208 lines
7.7 KiB
ArmAsm
208 lines
7.7 KiB
ArmAsm
; Main Forth system stuff. System variable declaration/initialization, system init,
|
|
; etc.
|
|
|
|
; System variable numbers
|
|
; Be sure to update initialization table, below
|
|
DEF_SYSVAR 0, SV_STATE ; STATE
|
|
DEF_SYSVAR 1, SV_BASE ; BASE
|
|
DEF_SYSVAR 2, SV_OLDHERE ; (old here for exception during definition)
|
|
DEF_SYSVAR 3, SV_CURRENT ; $CURRENT
|
|
DEF_SYSVAR 4, SV_NLINE ; #LINE
|
|
DEF_SYSVAR 5, SV_NOUT ; #OUT
|
|
DEF_SYSVAR 6, SV_dCIB ; $CIB
|
|
DEF_SYSVAR 7, SV_PIN ; >IN
|
|
DEF_SYSVAR 8, SV_NIN ; #IN
|
|
DEF_SYSVAR 9, SV_SPAN ; SPAN
|
|
DEF_SYSVAR 10, SV_dPPTR ; $PPTR
|
|
DEF_SYSVAR 11, SV_HIMEM ; for alloc-mem & free-mem
|
|
DEF_SYSVAR 12, SV_CSBUF ; current interpretation temp string buffer
|
|
DEF_SYSVAR 13, SV_SBUF0 ; interpretation temp string buffer 1 of 2
|
|
DEF_SYSVAR 14, SV_SBUF1 ; interpretation temp string buffer 2 of 2
|
|
DEF_SYSVAR 15, SV_SOURCEID ; Input source ID, 0 = console, -1 = EVALUATE
|
|
DEF_SYSVAR 16, SV_dTIB ; terminal input buffer
|
|
DEF_SYSVAR 17, SV_dCSDEPTH ; Control-flow stack depth for temporary definitions
|
|
DEF_SYSVAR 18, SV_dSAVEHERE ; saved HERE for temporary definitions
|
|
DEF_SYSVAR 19, SV_pTMPDEF ; pointer to memory allocated for temp def
|
|
DEF_SYSVAR 20, SV_FORTH_WL ; Forth wordlist
|
|
DEF_SYSVAR 21, SV_FORTH_WL_XT ; Pointer to the "FORTH" word
|
|
DEF_SYSVAR 22, SV_ENV_WL ; last environmental word
|
|
DEF_SYSVAR 23, SV_ENV_WL_XT ; pointer to "$ENV?" word
|
|
DEF_SYSVAR 24, SV_dORDER ; Pointer to search order list
|
|
DEF_SYSVAR 25, SV_dCURDEF ; $CURDEF pointer to current colon, noname, etc. def
|
|
.if include_fcode
|
|
DEF_SYSVAR 26, SV_FCODE_IP ; FCode IP
|
|
DEF_SYSVAR 27, SV_FCODE_END ; FCode end, if true FCode evaluator will stop
|
|
DEF_SYSVAR 28, SV_FCODE_SPREAD ; Current FCode spread
|
|
DEF_SYSVAR 29, SV_FCODE_OFFSET ; if true, offsets are 16 bits
|
|
DEF_SYSVAR 30, SV_FCODE_FETCH ; XT of FCode fetch routine, usually C@
|
|
DEF_SYSVAR 31, SV_FCODE_TABLES ; Pointer to FCode table pointers
|
|
DEF_SYSVAR 32, SV_FCODE_LAST ; Last FCode# in NEW-, NAMED-, or EXTERNAL-TOKEN
|
|
DEF_SYSVAR 33, SV_FCODE_DEBUG ; whether FCode debugging is enabled
|
|
.endif
|
|
|
|
.proc _jtab
|
|
init: jmp __initialize
|
|
ui: jmp __ui
|
|
.endproc
|
|
.export _Forth_jmptab = _jtab
|
|
.export _Forth_initialize = _jtab::init
|
|
.export _Forth_ui = _jtab::ui
|
|
|
|
; Table of initialization values for system variables
|
|
.proc SVARINIT
|
|
.dword 0 ; STATE 0
|
|
.dword 16 ; BASE 4
|
|
.dword 0 ; OLDHERE 8 for exception during definition
|
|
.dword 0 ; $CURRENT - WID of the compiler word list
|
|
.dword 0 ; #LINE 16
|
|
.dword 0 ; #OUT 20
|
|
.dword 0 ; $CIB 24
|
|
.dword 0 ; >IN 28
|
|
.dword 0 ; #IN 32
|
|
.dword 0 ; SPAN 36
|
|
.dword 0 ; $PPTR 40
|
|
.dword 0 ; HIMEM 44 - for alloc-mem and free-mem
|
|
.dword 0 ; CSBUF
|
|
.dword 0 ; SBUF0
|
|
.dword 0 ; SBUF1
|
|
.dword 0 ; SOURCEID
|
|
.dword 0 ; $TIB
|
|
.dword 0 ; $CSDEPTH
|
|
.dword 0 ; $SAVEHERE
|
|
.dword 0 ; $>TMPDEF
|
|
.dword LAST_forth ; Forth wordlist
|
|
.dword FORTH ; "FORTH" word xt
|
|
.dword LAST_env ; environmental query wordlist
|
|
.dword ENVIRONMENTQ ; "ENVIRONMENT?" xt
|
|
.dword 0 ; search order pointer, if zero always uses Forth wordlist
|
|
.dword 0 ; $CURDEF
|
|
.if include_fcode
|
|
.dword 0 ; $FCODE-IP
|
|
.dword 0 ; $FCODE-END
|
|
.dword 1 ; $FCODE-SPREAD
|
|
.dword 0 ; $FCODE-OFFSET
|
|
.dword dRBFETCH ; $FCODE-FETCH
|
|
FCROM fc_romtab ; $FCODE-TABLES
|
|
.dword $7FF ; $FCODE-LAST last FCode# in NEW-, NAMED-, or EXTERNAL-TOKEN
|
|
.dword 0 ; FCODE-DEBUG?
|
|
.endif
|
|
.endproc
|
|
SYSVAR_INIT SVARINIT ; check size of initialize values
|
|
|
|
.proc _call_sysif
|
|
sta ZR+2 ; save function #
|
|
stx ZR ; calculate stack depth
|
|
lda STK_TOP
|
|
sec
|
|
sbc ZR
|
|
lsr
|
|
lsr
|
|
tay
|
|
lda SYSIF+2
|
|
sep #SHORT_A
|
|
pha
|
|
rep #SHORT_A
|
|
lda SYSIF
|
|
pha
|
|
lda ZR+2 ; get function #
|
|
rtl
|
|
.endproc
|
|
|
|
; Enter with direct page register pointing to direct page reserved for the system
|
|
; with enough space for the variables in equates.inc
|
|
; and the following parameters on the '816 stack:
|
|
; system memory high (32-bit)
|
|
; system memory low (32-bit)
|
|
; stack top (16-bit) - this the bank 0 address just after first usable cell, relative to D
|
|
; stack bottom (16-bit) - this is the bank 0 address of the last usable cell, relative to D
|
|
; return stack top (16-bit) - return stack top, to be used by all routines
|
|
; except initialize
|
|
; system interface function (32-bit) - vector to basic I/O, etc.
|
|
; each stack must have at least 64 32-bit cells, a total of 256+ bytes each.
|
|
.proc __initialize
|
|
; set up direct page
|
|
pla ; first, save caller address
|
|
sta WR
|
|
sep #SHORT_A
|
|
pla
|
|
sta WR+2
|
|
rep #SHORT_A
|
|
pla ; get address of system interface function
|
|
sta SYSIF
|
|
pla
|
|
sta SYSIF+2
|
|
lda SYSIF ; we are going call it via RTL, so decrement
|
|
bne :+
|
|
dec SYSIF+2
|
|
: dec SYSIF
|
|
pla
|
|
sta RSTK_TOP
|
|
sta RSTK_SAVE ; really a placeholder for completeness
|
|
pla
|
|
sta STK_BTM
|
|
pla
|
|
sta STK_TOP
|
|
pla
|
|
sta MEM_BTM
|
|
sta SYSVARS ; sysvars at memory bottom
|
|
pla
|
|
sta MEM_BTM+2
|
|
sta SYSVARS+2
|
|
pla
|
|
sta MEM_TOP
|
|
pla
|
|
sta MEM_TOP+2
|
|
sep #SHORT_A ; restore caller address
|
|
lda WR+2
|
|
pha
|
|
rep #SHORT_A
|
|
lda WR
|
|
pha
|
|
; okay, direct page is set up from stack, do the rest of it
|
|
tsc ; switch to Forth return stack
|
|
sta SYS_RSTK
|
|
lda RSTK_TOP
|
|
tcs
|
|
phb ; save data bank for caller
|
|
phk
|
|
plb ; make sure we can move SYSVARS & OF816
|
|
lda SYSVARS
|
|
clc
|
|
adc #.sizeof(SVARINIT)
|
|
sta DHERE
|
|
lda SYSVARS+2
|
|
adc #$00
|
|
sta DHERE+2
|
|
ldy #0
|
|
: lda SVARINIT,y
|
|
sta [SYSVARS],y
|
|
iny
|
|
iny
|
|
cpy #.sizeof(SVARINIT)
|
|
bcc :-
|
|
stz CATCHFLAG
|
|
; Now do forth-based initialization
|
|
ldx STK_TOP
|
|
lda #SI_PRE_INIT
|
|
jsl _call_sysif ; hope it works, because we don't check!
|
|
ENTER
|
|
.dword ddSYSINIT
|
|
CODE
|
|
; Remaining platform init platform if needed
|
|
lda #SI_POST_INIT
|
|
jsl _call_sysif ; carry flag propagates to RTL
|
|
plb ; restore caller data bank
|
|
lda SYS_RSTK ; and stack
|
|
tcs
|
|
rtl
|
|
.endproc
|
|
|
|
.proc __ui
|
|
tsc
|
|
sta SYS_RSTK
|
|
ldx STK_TOP
|
|
jmp __doquit
|
|
.endproc
|
|
|
|
|