00020 * Direct Page definitions for BIF
00030 * BIF Copyright 1989 Joel Matthew Rees (see BIF/ASM)
00060 * This file is dependent on BIF/M definitions
00100 DPAGE	EQU *
00105 VDP	EQU DPAGE/256
00110 * ORG needs to leave space for this code
00120 	SETDP VDP
00130 * COLD needs to load VDP into DP register
00500 *
00510 * Direct Page variables
00600 UP	RMB 2
00610 	RMB 8 spares
01000 *
{	bifc_vm.c 
01010 * nest into icode list
01020 * call by JSR
01030 XCOL	LDX ,S	list ptr
01040 	STY ,S	nest old
01050 	TFR X,Y	interpret
01060 	NEXT
01070 *
}
{	symbol.c
01080 * PUSH FOLLOWING WORD
01090 * call by JSR for CONSTANT
01100 XCON	LDD [,S++]
01110 	PSHU D
01120 	NEXT
01130 *
01140 * push following address
01150 * call by JSR for VARIABLE address
01160 XVAR	PULS D
01170 	PSHU D
01180 	NEXT
01190 * (same code as R>, but in DP)
01200 *
01210 * push address of USER variable
01215 * call by JSR
01220 XUSER	LDB [,S++]	one byte offset
01225 	CLRA
01230 	ADDD <UP
01240 	PSHU D
01250 	NEXT
01260 *
01300 * push address of LINEAR array entry
01305 * call by JSR
01310 X1ARR	PULS X
01320 	LDD ,U index
01330 	SUBD ,X base
01340 	CMPD 2,X width
01350 	BLO X1ARRS
01360 	LDD #$0C
01365 	PSHU D
01370 	JMP ERROR
01380 X1ARRS	PSHS A
01390 	LDA 4,X size
01400 	MUL
01410 	STD ,U
01420 	PULS A ms byte
01430 	LDB 4,X
01440 	MUL
01450 	TFR B,A
01460 	ADDA ,U
01470 	LDB 1,U
01480 	LEAX 5,X past header
01490 	LEAX D,X
01500 	STX ,U
01510 	NEXT
01520 * LINEAR array header format:
01530 *	FDB BASE (lowest index)
01540 *	FDB WIDTH (# of elements)
01550 *	FCB SIZE (< 256 bytes / element)
01560 *	RMB SIZE*WIDTH (data)
01700 *
01710 * push content of USER variable
01715 * call by JSR
01720 XUCON	LDX <UP
01722 	LDB [,S++]	one byte offset
01725 	CLRA
01730 	LDD D,X
01740 	PSHU D
01750 	NEXT
01800 *
01802 * store VOCABULARY pointer in root
01805 * call by JSR
01810 XVOC	LDX <UP
01820 	PULS D
01830 	STD UROOT,X
01840 	NEXT
01850 *
01860 * indirect into icode list following
01870 * DOES> in defining definition
01880 * call by JSR
01890 XDOES	LDX ,S pfa
01900 	LDD ,X++	list ptr
01920 	PSHU X	parameters
01930 	STY ,S	nest old
01940 	TFR D,Y	interpret
01950 	NEXT
01960 *
02000 * push double constant
02010 * call by JSR
02020 XDCON	PULS X
02030 	LDD ,X++
02040 	LDX ,X++
02050 	PSHU D,X
02060 	NEXT
02070 *
}
40000 	ORG DPAGE+256 if code fits
40010 	SETDP 0 not yet valid