;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


;		G B A S I C   -   R E L .  7 . 5


;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;       COPYRIGHT 1981..97 BY ING. GIANNI BECATTINI - FIRENZE


;	17.2.97
;
;	Nota sul watchdog
;
;	Ho di fatto eliminato la frase DOG (anche se resta per compatibilita')
;	in quanto adesso il wd viene rinfrescato ad ogni interpretazione
;	di frase BASIC. La cosa e' pero' alquanto macchinosa in seguito
;	ad una mia cavolata fatta in M5 dove ho fatto comandare il wd da DTR
;	del canale B, che viene usato per la GLAN. Ora, poiche' nello
;	stesso registro da cui si comanda il DTR si comanda anche RTS,
;	che a sua volta controlla il driver 485, accade che NON POSSO
;	manovrare il DTR da B7 in quanto interferirei con il funzionamento
;	della rete. Allora faccio cosi':
;
;	- per rinfrescare il wd chiamo una funzione il cui indirizzo sta nella
;	  variabile WDFUN con B (codice chiamata) = 91H
;	- detto indirizzo viene inizializzato al driver di console, che sta
;	  sempre a LASTRO+13
;	- ho aggiunto una funzione SYS #25 che serve per installare una
;	  funzione alternativa a quella di default
;
;	In questo modo il driver della rete puo' facilmente sostituire una
;	propria funzione a quella di default, mantenendo una copia in RAM
;	del registro della SIO e quindi comandando a ragion veduta DTR e RTS.
;


	LIST CASE
	CSEG

;---------------------------------------------------------------------------
;	OPZIONI DI ASSEMBLAGGIO
;---------------------------------------------------------------------------
REDUCED	EQU 	0		;versione a 4 cifre sign. (no trigonom. ecc)
USE_C	EQU 	0		;se si vuole supporto C
DRVSPC	EQU	2048		;HOW MUCH RAM TO RESERVE FOR EXT DRIVERS

;---------------------------------------------------------------------------
;	DEFINITIONS
;---------------------------------------------------------------------------

;	MISC

MAXFILES EQU	12		;MAXIMUM # OF ALLOWED OPEN FILES
MAXLEV	EQU	3		;INTERRUPT MAXIMUM LEVEL
SYSYES	EQU	55H		;SYS INSTALLED FLAG
MAXTSK	EQU	4		;MAXIMUM # OF CALLABLE ROUTINES (FOR MMT)
TOTOSC	EQU	4		;MAXIMUM # OF OSCS (SEE NOTE AT VECOSCILLS)

;	LENGHTS

LINLEN	EQU	140		;# CHARS IN LEGAL INPUT LINE
INTMAX 	EQU	48		;INTERRUPT STACK LENGHT
PSHLEN	EQU	10		;MEAN LENGHT OF EACH PUSH INTO USER FIFO
				;(USER FIFO LENGHT = INTMAX * PSHLEN)

;	FP & OTHERS

	IF REDUCED
FPSIZ	EQU	2+2		;NUMERO DI BYTES PER OGNI NUMERO FP
	ELSE
FPSIZ	EQU	7		;NUMERO DI BYTES PER OGNI NUMERO FP
	ENDIF

FP123	EQU	FPSIZ-2		;DIMENSIONE DELLA MANTISSA (?) (5)
FPNIB	EQU	FP123*2		;NUMERO DI NIBBLE DELLA MANTISSA (10)
DIGIT	EQU	FPNIB/2		;E' UGUALE A FP123

STESIZ	EQU	2+FPSIZ		;SYMBOL TABLE ELEMENT SIZE
FTYPE	EQU	1		;CONTROL STACK FOR ENTRY TYPE
FORSZ	EQU	FPSIZ*2+2+2+1	;'FOR' CONTROL STACK ENTRY SIZE
GTYPE	EQU	2		;CONTROL STACK GOSUB ENTRY TYPE
ETYPE	EQU	0		;CONTROL STACK UNDERFLOW TYPE

	IF USE_C
STKSIZE EQU 1000		;dimensione dello stack di sistema
	ELSE
STKSIZE EQU 100			;dimensione dello stack di sistema
	ENDIF


;	DELAYS

TIMK	EQU	56		;TIMER SOFTWARE DEFAULT PRESCALER CONSTANT

;	SEPARATORS AND PREFIXES

SEPRW	EQU	96H		;RW TO SEPARATE ELEMENTS IN RWT
PREFIX	EQU	27		;PREFIX FOR DUAL BYTES STATEMENTS RW
FPREFIX	EQU	0D7H		;PREFIX FOR DUAL BYTES FUNCTIONS RW
FIP	EQU	'_'		;FAST INTEGER PREFIX
OPBASE	EQU	'('


	INCLUDE	B7.H
	INCLUDE B7.CNF
	INCLUDE	DRIVER.H

;	ABSOLUTE RAM LOC USED FOR POWER DEFAULT


	IF	Z90.OR.SZ.OR.EOL
NBYT	EQU	2		;BYTE INTERVAL FOR STATIST.CHEKSUM COUNT
CKEND	EQU	0FFFFH-4096	;END OF CHECKSUM AREA
	ELSE
CKEND	EQU	0FFFFH		;END OF CHECKSUM AREA
NBYT	EQU	200		;BYTE INTERVAL FOR STATIST.CHEKSUM COUNT
	ENDIF

;	OTHER PUBLIC DEFINITIONS


;---------------------------------------------------------------------------
;	SYSTEM ENTRY JUMPS
;---------------------------------------------------------------------------
START0:	JP	START1		;KERNEL ENTRY POINT

	ORG	5
	JP	SYS		;SYSTEM ENTRY POINT
	JP	START1		;serve per sistemi con spaginazione
				;con stato indeterminato al powerup (es.CUB2)
	ORG	66H
	IF	Z90
	IF	TCZ
	ELSE
	JP	NMI0		;JUMP TO NMI ROUTINE (POWER FAULT)
	ENDIF
	ELSE
	JP	NMI0		;JUMP TO NMI ROUTINE (POWER FAULT)
	ENDIF
DOPWDN:

;---------------------------------------------------------------------------
;	CUSTOMIZING FILE SPACE
;---------------------------------------------------------------------------

	INCLUDE	CUSTOM.FIL	;CUSTOMIZING FILE

	ORG	100H

;---------------------------------------------------------------------------
;	KERNEL START
;---------------------------------------------------------------------------

START1:	DI

;---------------------------------------------------------------------------
;	HARDWARE PARTICOLARI
;---------------------------------------------------------------------------
;	QUESTA SEZIONE DEVE ESSERE RIVISTA AL FINE DI PORTARE ALL'ESTERNO
;	LE PARTICOLARITA' DEI VARI HW
;...........................................................................
	IF	Z90
	IF	TCZ
;	MANCA: TEST CHECKSUM EPROM
;	CALCOLA CHECKSUM EPROM 0-6000H
	LD	HL,0		;--(IF TCZ)
	LD	BC,6000H-1	;--
	LD	E,0		;--
CKS1:	LD	A,E		;--
	ADD	A,(HL) 		;--
	LD	E,A		;--SALVA RISULTATO IN E
	INC	HL		;--
	DEC	BC		;--
	LD	A,B		;--
	OR	C		;--
	JR	NZ,CKS1		;--
	LD	A,E		;--NON POSSIAMO ANCORA USARE LA RAM
	EX	AF,AF'		;--SI METTE IL RISULTATO IN AF'
	ENDIF			;-- FINE DI IF TCZ
;	SIAMO SEMPRE NELLA IF Z90
;	BOOT GBASIC
	LD	HL,0
	LD	DE,0
	LD	BC,6000H
	LDIR
	LD	A,0FFH
	OUT	(1FH),A		;PIO B CONTROLLO
	LD	A,020H
	OUT	(1FH),A
	LD	A,90H		;NO AUTOKILL - MIRROR
	OUT	(1EH),A
	IF	TCZ		;--(IF TCZ) INTERESSA SOLO PER TEST CZ90+TCZ
;	TEST FUNZIONAMENTO RAM	 --
	LD	A,1FH		;--ACCENDI LED DI ERRORE - SARA' SPENTO SE OK
	OUT	(USERPORT),A	;--
	LD	A,55H		:--
	LD	(7000H),A	;--7000H E' FUORI DAL RANGO DEL CHECKSUM
	XOR	A		:--
	LD	A,(7000H)	;--
	CP	55H		:--
NORAME:	JR	NZ,NORAME	;--NO RAM ERROR?
;	ADESSO SI RICALCOLA IL CHECKSUM DELL'AREA DEL CODE GBASIC IN
;	RAM E SI VERIFICA CHE SIA UGUALE A QUELLO CALCOLATO IN EPROM
	LD	A,2FH		;ACCENDI LED DI ERRORE - SARA' SPENTO SE OK
	OUT	(USERPORT),A	;--
	LD	HL,0		;--
	LD	BC,6000H-1	;--
	LD	E,0		;--
CKS2:	LD	A,E		;--
	ADD	A,(HL) 		;--
	LD	E,A		;SALVA RISULTATO IN E
	INC	HL		;--
	DEC	BC		;--
	LD	A,B		;--
	OR	C		;--
	JR	NZ,CKS2		:--
	EX	AF,AF'		;--RIPRENDIAMO CHECKSUM EPROM
	CP	E		;--
RAME:	JR	NZ,RAME		;--RAM ERROR
	LD	A,0FH		;--TUTTO OK
	OUT	(USERPORT),A	:--
	ENDIF			;FINE DI IF TCZ
	ENDIF			;IF Z90
;...........................................................................
;	queste schede usano tutte la stessa assegnazione di bit su PIOB
;	anche se ad indirizzi differenti

	IF	G10HP.OR.EOL.OR.SZ

	IF	G10HP		;queste in custom.fil non sono state definite
KIO	EQU	20H		;poich� G10HP usa la scheda HPOW
PIOAD	EQU	KIO
PIOAC	EQU	PIOAD+1
PIOBD	EQU	PIOAD+2
PIOBC	EQU	PIOAD+3
	ENDIF

;	ACCELERA UN PO'
;	EMETTO IL DATO PRIMA DI INIZIALIZZARE - COSI' LO TROVO
;	GIA' PRONTO DOPO LA PROGRAMMAZIONE DELLA PORTA
	LD	A,0FFH
	OUT	(PIOBC),A	;PIO B CONTROLLO
	LD	A,80H
	OUT	(PIOBC),A	;TUTTE USCITE MENO BIT 7 (AUTOSTART)
	LD	A,40H		;CLOCK :4 - /MIRROR PRESENTE
	OUT	(PIOBD),A
	LD	HL,0		;COPIA IL BASIC IN RAM
	LD	DE,0
	LD	BC,6000H
	LDIR
	LD	A,50H		;CLOCK :4 - TOGLI /MIRROR
	OUT	(PIOBD),A

;	SIAMO IN RAM - METTI IL TURBO
	LD	A,10H		;CLOCK DIRETTO - TOGLI /MIRROR
	OUT	(PIOBD),A
	ENDIF

;...........................................................................
	IF	MTB
;	CODICE MODIFICATO - SE NON VA QUALCOSA GUARDA QUI
;WTTDBE:	IN	A,(0FEH)
;	BIT	3,A
;	JR	Z,WTTDBE
;	IN	A,(0E9H)
;	SET	1,A
;	OUT	(0E9H),A
	ENDIF

;...........................................................................
	IF	CPM
	JR	RAMFAI		;IN CPM CONSIDER ALWAYS AN 8K RAM
	ENDIF

;...........................................................................
	IF	MPAGE

	IF	PUMAKEY
PAGEB	EQU	14	;PAGINA BASE
PAGEX	EQU	15	;PAGINA ESTESA
	XOR	A
;	LD	(PAGE),A
	OUT	(PAGEB),A
	ENDIF

	IF	FMD
PGPORT	EQU	60H	;PAGE PORT
PAGEB	EQU	0	;DATO PER SELEZIONARE PAGINA BASE
PAGEX	EQU	80H	;DATO PER SELEZIONARE PAGINA ESTESA

	LD	A,PAGEB
;	LD	(PAGE),A
	SET	KILBIT,A	;RISPETTA KILBIT SULLA STESSA PAGINA
	OUT	(PGPORT),A	;SELEZIONA PAGINA BASE
	ENDIF

	ENDIF	:if MPAGE

;---------------------------------------------------------------------------
;	DETERMINE THE AMOUNT OF AVAILABLE RAM (8 O 32K)
;---------------------------------------------------------------------------
;	LAST USABLE RAM LOC IN (LSTRAM)

	LD	HL,0FFFFH	;TEST ONLY THE LAST LOC
	LD	A,(HL)
	LD	B,A		;SAVE CONT_ IN B
	LD	A,0FFH		;WRITE FF TEST
	LD	(HL),A
	LD	A,0
	LD	A,(HL)
	CP	0FFH
	JR	NZ,RAMFAI	;RAM FAIL?
	LD	A,0		;WRITE 0 TEST
	LD	(HL),A
	LD	A,0FFH
	LD	A,(HL)
	CP	0
	JR	NZ,RAMFAI	;RAM FAIL?

	LD	A,B		;RESTORE OLD CONT.
	LD	(HL),A

	IF	Z90.OR.SZ.OR.EOL
	LD	HL,0EFFFH-DRVSPC ;32K RAM (8000-FFFF)
	ELSE
	LD	HL,0FFFFH-DRVSPC ;32K RAM (8000-FFFF)
	ENDIF

	JR	RAMSET

RAMFAI:	LD	HL,09FFFH-DRVSPC ;8K RAM (8000-9FFF)

RAMSET:	LD	(LSTRAM),HL	;SAVE LAST PHIS.RAM ADDRESS

	XOR	A
	LD	(DIAGCO),A	;CLEAR ERROR CODE FOR 'DIAG' FUNCTION

	LD	SP,STACK1	;USA LO STACK RISERVATO ALLA LOC 8010H
	CALL	INIPOW		;ABSOLUTE ADDRESS OF POWER DOWN INIT ROUTINE

;---------------------------------------------------------------------------
;	RAM CHECK - CHECK THE FIRST RAM LOC BY WRITING AND READING
;---------------------------------------------------------------------------

CORAM:	LD	HL,CKST

CKLIP:	LD	A,55H
	LD	D,(HL)
	LD	(HL),A
	CP	(HL)
	LD	(HL),D
	JP	NZ,ERRAMZ
	CPL
	LD	(HL),A
	CP	(HL)
	LD	(HL),D
	JP	NZ,ERRAMZ
	LD	A,D
	CP	(HL)
	JP	NZ,ERRAMZ

	JP	RA_CKSUM	;CHECK OK - GO ON

ERRAMZ:	LD	B,4		;CODE WEIGHT 4 - RAM FAULT
	CALL	ADDERCO

;---------------------------------------------------------------------------
;	RAM CHECKSUM CHECK
;---------------------------------------------------------------------------

RA_CKSUM:
	LD	HL,(CKSUM)	;salva in HL vecchio cksum
	PUSH	HL
	LD	HL,0		;azzera cksum (per non sbagliarlo)
	LD	(CKSUM),HL
	CALL	CALCIK		;ricalcola cksum
	EX	DE,HL
	POP	HL
	LD	(CKSUM),HL
	SBC	HL,DE		;sottrae i 2 cksum
	JP	Z,CKCRIT	;salta se cksum ok!
	CALL	ERRAM
	JR	CKCRIT

ERRAM:	LD	B,1		;CODE WEIGHT 1 - RAM DATA LOST
	CALL	ADDERCO
	RET
;---------------------------------------------------------------------------
;	CHECK IF LAST CRITIC SEGMENT (IF ANY) WAS EXITED BEFORE
;---------------------------------------------------------------------------

;	EFFECTIVE POWER DOWN

CKCRIT:	LD	A,(CRITIC)
	OR	A
	JR	Z,OKCRIT

	LD	B,2
	CALL	ADDERCO

OKCRIT:	XOR	A		;ANYCASE INIT FLAG
	LD	(CRITIC),A

;	END OF TESTS

	LD	SP,CMNDSP

	CALL	INIINT		;INIT INTERRUPT SYSTEM

	CALL	INIVAR		;INITIALIZE VAR AND COSTANTS

;	INITIALIZE RANDOM NUMBER

	LD	DE,FRAND
	LD	HL,RANDS
	CALL	VCOPY		;FRAND=RANDOM NUMBER SEED

INIDONE:LD	HL,RETN1	;ESEGUI UN RETN
	PUSH	HL
	RETN
RETN1:
	LD	HL,SIMRET	;FALSI RETI PER SBLOCCO DAISY CHAIN
	LD	B,32
SIPDO1:	PUSH	HL
	RETI
SIMRET:	DJNZ	SIPDO1
	EI

	LD	A,(AUTOST)	;IF AUTOSTART IS REQUESTED..
	CP	1		;DO NOT PRINT HEADER MESSAGES
	JR	Z,AUTO_1

	LD	HL,HEAD		;OUTPUT HEADER MESSAGES
	CALL	PRNT
	CALL	CRLF

	LD	A,1		;OUTPUT DRIVER LIST TO CONSOLE
	LD	(LSTDRV),A
	LD	HL,LASTRO+1	;START SEARCH OF DRIVERS PAST THE INTERPRETER
	LD	DE,NONAME
	CALL	SRC_DRV		;SEARCH DRIVER - RETURNS HL=DRIVER ADDRESS
	XOR	A
	LD	(LSTDRV),A

AUTO_1:	LD	A,(SYSOK)	;IF SYS IS NOT INSTALLED
	CP	SYSYES		;NO DOUBT - GO DIRECTLY TO
	JR	NZ,CMOSNEW	;ALL-RESETTING START - era CMOS1

	LD	A,(AUTOST)	;AUTOSTART REQUESTED?
	CP	1
	JR	NZ,NEWOLD	;NO, INITIAL DIALOGUE

	LD	HL,(BOFA)	;FIRST INSTRUCTION IN RAM WS IS 'REM'?
	INC	HL		;(THIS INDICATES THAT A PROGRAM IS RESIDENT
	INC	HL		;IN RAM AND MAY BE IT HAS TO BE EXECUTED)
	INC	HL
	LD	A,(HL)
	CP	REMRW
	JR	NZ,CMOSNEW	;ERA CMOS1 - NO, JUMP TO SCRATCH
	JR	CMND1		;YES, DO NOT DESTROY WS

NEWOLD:	LD	HL,HEAD2	;PRINT SCRATCH REQUEST
	CALL	PRNT
	CALL	LDEVIN		;GET NEW OR OLD ANSWER
	CALL	CHOUT		;ERA CONOUT
	LD	A,B		;GET CHAR AGAIN
	AND	0DFH		;CONVERT TO UPPER-CASE
	CP	'N'		;NEW
	JR	NZ,CMND1	;IN DOUBT GO TO NON DESTRUCTIVE START

CMOS1:	CALL	CRLF

CMOSNEW:CALL	CSCR		;SCRATCH THE WS
	LD	C,0		;NOW ASK FOR SPECIAL FUNCTION '89'
	LD	B,89H		;FOR AUX USER INIT
	CALL	DRIVER

;---------------------------------------------------------------------------
;	COMMAND PROCESSOR
;---------------------------------------------------------------------------

CMND1:	LD	A,2*FPNIB	;SET # OF DECIMALS TO PRINT
	LD	(INFES),A

	LD	A,(AUTOST)	;IF AUTOSTART DO NOT OUT 'OK'
	CP	1
	JR	Z,CMNDR

	CALL	CRLF
	LD	HL,RDYS		;PRINT READY MESSAGE
	CALL	PRNT

CMNDR:	XOR	A		;RESET LOGIC OUT TO CON:
	LD	(LOGDEVO),A
	LD	(LOGDEVI),A
	LD	(PICTF),A	;AND NO PICTURE
	LD	(PRIVIL),A	;AND RESET PRIVILEGED FLAG
	LD	(IGNORE),A	;NO 'IGNORE ' MODE

	INC	A		;SET DIRECT INPUT FLAG
	LD	(DIRF),A

	INC	A		;IGNORE BASIC INT REQUESTS
	LD	(INT_ENA),A	;DISABLE INTERRUPTS

	LD	SP,CMNDSP
CMND2:	CALL	CLINTA		;CLEAR INTERRUPT TABLE  AND TIMERS

	LD	A,SYSYES	;SYS OK FLAG
	LD	(SYSOK),A

	LD	A,(AUTOST)	;AUTOSTART REQUESTED
	CP	1
	JR	NZ,CMND2A	;NO, JUMP

	CALL	REINIT0
	CALL	COPYRUN		;AUTOSTART - COPY 'RUN' INTO IBUF

	LD	A,2		;DO AUTOSTART FIRST TIME ONLY
	LD	(AUTOST),A

	JR	CMND2B

CMND2A:	CALL	REINIT0

	CALL	CRLF		;ERA CRLF2
	CALL	INLINE		;GET INPUT FROM OPERATOR

CMND2B:	CALL	PP		;PRE-PROCESS IT
	JP	C,CMND3		;NO LINE NUMBER

	LD	A,(ROEXFG)	;ARE YOU EXECUTING A ROM PROGRAM
	OR	A
	JP	NZ,E8		;EDITING NOT ALLOWED

	CALL	LINE		;LINE NUMBER _ _ _ GO EDIT
	CALL	CCLEAR		;CLEAR FROM EOFA TO MEMTOP (ALL VARS)
	JP	CMND2		;LOOP BUT NOT PRINT CRLF AND RDYS
;
CMND3:	CALL	CMND4		;COME HERE IF NO LINE NUMBER
	JP	CMNDR		;LOOP

CMND4:	LD	HL,IBUF		;POINT TO COMMAND OR STATEMENT
	LD	(TXA),HL
CMND4B:	CALL	GC
	AND	240Q
	CP	240Q		;CHECK FOR COMMAND
	LD	DE,CMNDD
	JP	Z,ISTA1		;PROCESS COMMAND
	CALL	ISTAT		;PROCESS STATEMENT (IF ALLOWED)

	CALL	GCI
	CP	CR
	RET	Z
	CP	':'		;CHAINED COMMANDS?
	JR	Z,CMND4B
	JP	E1

REINIT0:XOR	A
	LD	(LOGDEVO),A	;RESET LOGIC DEVICE TO CON:
	LD	(LOGDEVI),A
	LD	HL,(DKBASE)
	LD	(SAPOINT),HL
	LD	A,32
	LD	(STORELEN),A
	RET

NONAME:	DB	':'
;---------------------------------------------------------------------------
;	STATEMENT INTERPRETER
;---------------------------------------------------------------------------

INTERPR:LD	HL,(TXA)
	LD	(RETADD),HL

ILOOP:	CALL	PCHECK		;BREAK CONTROL (CONTROL/C)
	CALL	INTCHK		;TEST FOR EXTERNAL INTERRUPTS PENDING

;	CHIAMATA AL WATCHDOG - PER CAPIRE LEGGI NOTA AD INIZIO FILE

	LD	HL,WDRET	;PREPARA INDIRIZZO DI RITORNO
	PUSH	HL

	LD	B,91H		;CODICE FUNZIONE 91H

  	LD	HL,(WDFUN)	;PRENDI INDIRIZZO FUNZIONE WD
	JP	(HL)

WDRET:	CALL	GC		;TEST FOR PRIVILEGED INSTRUCTION
	CP	'^'
	JR	NZ,ILO3
	CALL	GCI
	LD	A,1
	LD	(PRIVIL),A	;IF PRIVILEGED SET FLAG
ILO3:	CALL	ISTAT		;INTERPRET CURRENT STATEMENT
	CALL	JOE		;TEST FOR JUNK ON END
	LD	(RETADD),HL	;SAVE RETURN ADDRESS FOR INTERRUPT GOSUB
	JP	NC,ILOOP	;CONTINUE IF NOT AT END OF PROGRAM
	JP	CEND		;EXECUTE END STATEMENT

;
;	PREF(IX) PSEUDO STATEMENT FOR DUAL BYTE RW
;	(THIS IS EXECUTED AS A NORMAL STATEMENT WHEN ISTAT ENCOUNTERS
;	THE "PREFIX" RW)
;
PREF:	LD	HL,(TXA);GET NEXT BYTE
	LD	A,(HL)
	INC	HL
	LD	(TXA),HL
	LD	DE,STA2
	JP	NOCOM

;	***************** SUBROUTINES ***************************

;----------------------------------------------------------------------------
;	* * ISTAT
;----------------------------------------------------------------------------

ISTAT:	CALL	GC
	CP	CR
	JP	Z,CMND1		;OUTPUT 'READY' IF BLANK LINE

	CP	ENDIFRW		;ENDIF IS ALWAYS EXECUTED
	JR	Z,ISTA0

	CP	ELSERW		;ELSE IS ALWAYS EXECUTED
	JR	Z,ISTA0

	LD	E,A		;SAVE RW

	LD	A,(IGNORE)	;'IGNORE' MODE?
	OR	A
	JP	NZ,PREREM	;IGNORE THIS STATEMENT?

ISTA0:	CP	IRWLIM		;IT MUST BE AN INITIAL RW
	JP	NC,E1		;(NOT BEYOND IRWLIM)
	LD	DE,STATD	;STATEMENT DISPATCH TABLE BASE
ISTA1:	CALL	GCI		;ADVANCE TEXT POINTER
	CP	0A0H
	JP	C,NOCOM
	AND	1FH
NOCOM:	LD	L,A
	LD	H,0
	ADD	HL,HL
	ADD	HL,DE
	CALL	LHLI
	JP	(HL)		;BRANCH TO STATEMENT OR COMMAND

PREREM:	LD	A,E		;GET BACK RW
	CP	IFRW		;IF STATEMENT?
	JP	NZ,REM		;NO, IGNORE IT

;	IS IT A STRUCTURED IF? SCAN IT TO KNOW - SEARCH 'THEN'

SCANIF:	CALL	GCI
	CP	CR		;END OF LINE? 'THEN' IS MISSING
	JP	Z,E1
	CP	THENRW
	JR	NZ,SCANIF

	CALL	GC
	CP	CR
	JP	NZ,REM		;THIS IF IS NOT STRUCTURED - IGNORE

;	STRUCTURED IF

	CALL	PUSHIGN		;SAVE 'IGNORE' FLAG STATUS
	JP	REM

;----------------------------------------------------------------------------
;	INTCHECK - CHEKS FOR INTERRUPT REQUEST PENDING AND EXECUTES THEM
;----------------------------------------------------------------------------

;	FIRST CHECK IF INTERRUPTS ARE TO BE SERVICED

;	MODIF.22/12/91 - PRIVIL CHECK MOVED TO BEFORE INT_ENA CHK
;	ELSEWHERE NO FLAG RESET COULD HAPPEN WHEN INTERRUPTS WERE DISABLED

INTCHK:	LD	A,(PRIVIL)	;PRIVILEGED INSTRUCTION EXECUTED LAST?
	OR	A
	JR	Z,NOPRIVI
	XOR	A		;CLEAR PRIVILEGED INSTR FLAG
	LD	(PRIVIL),A	;WITHOUT SERVICING INTERRUPTS
	RET

NOPRIVI:LD	A,(INT_ENA)	;ARE INTERRUPTS ENABLED?
	OR	A
	RET	Z		;NO, JUST RET

	CP	2		;IF IN STATUS '2' NO SERVICE IS
	RET	Z		;PERFORMED

;	NOW SEE IF THERE ARE ANY PENDING INTERRUPTS
;	CHECK IS DONE LOOKING AT THE FREE SPACE IN INTERRUPTS REQ. STACK

	LD	A,(INTSPFR)	;TEST IF INTERR. IS PENDING (INT SPACE FREE)
	CP	INTMAX		;STACK IS EMPTY? RETURN
	RET	Z		;NO INTERRUPT REQUEST ON THE QUEUE - RETURN

;	INTERRUPTS MUST TO BE SERVICED AND ONE OR MORE REQS ARE IN THE STACK

;	SERVICE THE FIRST INTERRUPT REQUEST

	DI
	INC	A		;FREE SPACE BECOMES WIDER
	LD	(INTSPFR),A

;	DETERMINE WHICH INTERRUPT IS INTERRUPTING

	LD	A,(INTSPRD)	;LOAD INT SP FOR READ OPS FROM FIFO
	LD	HL,INT_STK
	LD	B,0
	LD	C,A
	ADD	HL,BC
	INC	A		;INCREMENT INT SP
	CP	INTMAX		;QUEUE IS BECOME EMPTY?
	JP	NZ,INTCK1
	XOR	A		;YES, FLAG IT BY SETTING SPRD = 0
INTCK1:	LD	(INTSPRD),A	;IN ANY CASE UPDATE SP

	LD	A,(HL)		;POP ENTRY FROM FIFO

	LD	E,A		;FOR IX
	LD	D,0
	CALL	SETIX		;GET FIRST ENTRY

	LD	L,(IX+0)	;GET BASIC VECTOR INTO HL
	INC	IX
	LD	H,(IX+0)
	INC	IX
	INC	IX
	LD	A,2		;SET STATUS TO 'ON SERVICE'
	LD	(IX+0),A

	LD	(INTLINE),HL	;INTLINE IS THE # OF ISR ROUTINE

;	WE ARE ABOUT TO SERVICE A GBASIC INT

	CALL	PUSHIGN		;SAVE STRUCT IF STATE

	XOR	A
	LD	(IGNORE),A	;EXECUTE INSTRUCTIONS NORMALLY
	LD	(INT_ENA),A	;DISABLE FURTHER INTERRUPTS
	INC	A
	LD	(INTGSUB),A	;FLAG FOR GOSUB (SEE 'GOSUB')
	EI
	JP	GOSUB		;RETURNS DIRECTLY FROM GOSUB




;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 5 - EXPRESSION EVALUATOR		*
;	*		               				*
;	*							*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *





;	EVALUATE AN EXPRESSION FROM TEXT
;	HL TAKE OP TABLE ADDR OF PREVIOUS OPERATOR (NOT CHANGED)
;	RESULT VALUE LEFT ON TOP OF ARG STACK, ARGF LEFT TRUE
;
;	IF OPERANDS ARE STRINGS, ON RETURN STRFLG<>0 AND HL CONTAINS
;	THE ADDRESS OF THE STRING AND STLEN ITS LENGHT;
;
;
EXPRB:	LD	B,0
EXPB1:	XOR	A
	LD	(STRFLG),A

	IF	FASTF
	LD	(FASTFLG),A
	ENDIF

	CALL	GC

	IF	FASTF
	CP	'{'
	JP	Z,EXPRF
	ENDIF

	CP	STR@RW
	JP	Z,STR@
	CP	NGET@RW
	JP	Z,NGET@
	CP	HEX@RW
	JP	Z,HEX@
	CP	CHR@RW
	JP	Z,CHR@
	CP	SUBSTR@RW
	JP	Z,SUBSTR@
	CP	CONCAT@RW
	JP	Z,CONCAT@
	CP	TIME@RW
	JP	Z,TIMEX@
	CP	DATE@RW
	JP	Z,DATEX@
	CP	'"'		;TEST FOR ALPHA CONSTANT
	JP	NZ,EXPBS1	;NO STRING FUNCTIONS ---->FOLLOW MAIN PATH

;---------------------------------------------------------------------------
;	PROCESS A STRING CONSTANT
;---------------------------------------------------------------------------

	CALL	GCI		;IF SO, GOBBLE QUOTES
	PUSH	HL		;SAVE START OF STRING ADDRESS
	LD	C,0		;C REG COUNTS THE LENGHT
KCOUNT:	CALL	GCIAB		; AB=ANTI BLANK
	CP	'"'
	JP	Z,KDONE
	INC	C
	JP	KCOUNT
KDONE:	LD	A,C
	LD	(STLEN),A
	LD	A,1
	LD	(STRFLG),A
	POP	HL
	RET

	IF	FASTF

EXPRF:	LD	A,1
	LD	(FASTFLG),A
	LD	HL,FSTACK		;
	LD	(FSP),HL
FAST2:
	CALL	GCI

FAST1:
	CALL	GC		;OPERATOR?

	CP      FIP
	JP      Z,ABSDIG        ;ABSOLUTE DIGIT

	CP	'^'		;ENTER
	JP	Z,FAST2

	CP	'}'
	JP	Z,FAST9

	CP	EQRW
	JP      Z,FAST_EQ

	CP	LT_RW
	JP	Z,FAST_LT

	CP	GT_RW
	JP	Z,FAST_GT

	CP	'@'
	JP	Z,FASSIGN	;ASSIGN

	CP	PLSRW
	JP	Z,FASTADD

	CP	MINRW
	JP	Z,FASTSUB

	CP	MPY_RW
	JP	Z,FASTMPY

	CP	'&'
	JP	Z,FASTAND

	CP	'|'
	JP	Z,FASTOR

	CP	'.'
	JP	Z,FASTIN

	CP	'['
	JP	Z,STDEXP

	CP	'?'
	JP	Z,FAST_IF

	CP	':'
	JR	NZ,FAST8
	CALL	GCI
	JR	FAST1


FAST8:	AND	0F0H

	CP	40H		;VARIABLE?
	JP	Z,FVAR

	CP	50H		;VARIABLE?
	JP	Z,FVAR

	CP	30H		;DIGIT?
	JP	Z,FDIG

	JP	E1		;SINTAX ERROR

FAST9:	CALL	GCI
	CALL	FPOP
	EX	DE,HL
	JP	ACALX

FVAR:	CALL	GCI		;GET VAR NAME
	LD	C,A
	LD	B,0
	LD	HL,FVTAB-('A'+'A')	;BASE OF RAM FAST VARS TABLE
	ADD	HL,BC
	ADD	HL,BC		;HL HAS VAR ADDRESS
	LD	A,(HL)		;LOW HALF OF VARIABLE
	LD	E,A
	INC	HL
	LD	A,(HL)		;HI PART OF VAR
	LD	D,A		;DE HAS VARIABLE CONTENT NOW
	CALL	FPUSH
	JP	FAST1

FDIG:	CALL	INTGER
FDIG1:	EX	DE,HL
	CALL	FPUSH
	JP      FAST1

ABSDIG: CALL    FINTGR
	JP      FDIG1

FASSIGN:
	CALL	GCI		;EAT '@'
	CALL	GCI		;GET THE SINGLE LETTER ID
	LD	C,A
	LD	B,0
	LD	HL,FVTAB-('A'+'A')+1	;'+1' TO GO ON THE 2,ND BYTE
	ADD	HL,BC
	ADD	HL,BC		;ADDRESS OF VAR
	EX	DE,HL		;IN DE
	LD	HL,(FSP)
	DEC	HL

	LD	A,(HL)
	LD	(DE),A
	DEC	HL
	DEC	DE
	LD	A,(HL)
	LD	(DE),A
	JP	FAST1

FASTADD:CALL	GCI		;EAT '+'
	CALL	FPOP		;TO DE
	PUSH	DE
	CALL	FPOP
	POP	HL
	ADD	HL,DE
FAADD1:	EX	DE,HL
FAADD2:
;	PUSH	HL
	CALL	FPUSH
;	POP	HL
	JP	FAST1

FASTSUB:CALL	GCI		;EAT '-'
	CALL	FPOP		;TO DE
	PUSH	DE
	CALL	FPOP
	POP	HL
	EX	DE,HL
	OR	A
	SBC	HL,DE
	JP	FAADD1

FASTAND:CALL	GCI		;EAT '&'
	CALL	FPOP		;TO DE
	PUSH	DE
	CALL	FPOP
	POP	HL
	LD	A,H
	AND	D
	LD	D,A
	LD	A,L
	AND	E
	LD	E,A
	JP	FAADD2

FASTOR:	CALL	GCI		;EAT '|'
	CALL	FPOP		;TO DE
	PUSH	DE
	CALL	FPOP
	POP	HL
	LD	A,H
	OR	D
	LD	D,A
	LD	A,L
	OR	E
	LD	E,A
	JP	FAADD2

FASTIN:	CALL	GCI		;EAT '?'
	CALL	FPOP		;TO DE
	LD	C,E
	IN	A,(C)
	LD	D,0
	LD	E,A
	JP	FAADD2

FASTMPY:CALL	GCI
	CALL	FPOP
	PUSH	DE
	CALL	FPOP		;DE IS MULTIPLIER
	POP	HL		;HL IS MULTIPLICAND

	LD	B,16
	LD	C,D
	LD	A,E
	EX	DE,HL
	LD	HL,0
FMLOOP:	SRL	C
	RRA
	JP	NC,FNOADD
	ADD	HL,DE
FNOADD:	EX	DE,HL
	ADD	HL,HL
	EX	DE,HL
	DJNZ	FMLOOP
	JP	FAADD1

STDEXP:	CALL	GCI
	CALL	EXPRB
	CALL	PFIX
	CALL	FPUSH
	LD	B,']'
	CALL	EATC
	JP	FAST1

FAST_GT:CALL	GCI		;EAT '>'
	CALL	FPOP		;TO DE
	PUSH	DE
	CALL	FPOP
	POP	HL
	OR	A
	EX	DE,HL
	SBC	HL,DE
	JP	Z,PUSH0
	JP	C,PUSH0
	JP	PUSH1

FAST_LT:CALL	GCI		;EAT '<'
	CALL	FPOP		;TO DE
	PUSH	DE
	CALL	FPOP
	POP	HL
	OR	A
	SBC	HL,DE
	JP	Z,PUSH0
	JP	C,PUSH0
PUSH1:	LD	DE,1
	CALL	FPUSH
	JP	FAST1
PUSH0:	LD	DE,0
	CALL	FPUSH
	JP	FAST1

FAST_EQ:CALL	GCI		;EAT '='
	CALL	FPOP		;TO DE
	PUSH	DE
	CALL	FPOP
	POP	HL
	OR	A
	SBC	HL,DE
	JP	NZ,PUSH0
	JP	PUSH1

FAST_IF:CALL	GCI		;eat '?'
	CALL	FPOP		;RISULTATO PRECEDENTE E' ZERO?
	LD	A,E
	OR	D
	JP	NZ,FAST1	;SI, ESEGUI COME SE NULLA FOSSE

CHOMP:	CALL	GCI		;MANGIA TUTTO FINO A ':'
	CP	':'		;INCLUSI
	JR	NZ,CHOMP	;OCCHIO! NON FA CONTROLLI!
	JP	FAST1
;
;	PUSH DE INTO FAST STACK
;
FPUSH:
	LD	HL,(FSP)
	LD	(HL),E
	INC	HL
	LD	(HL),D
	INC	HL
	LD	(FSP),HL
	RET

;
;	POP DE FROM FAST STACK
;
FPOP:	LD	HL,(FSP)
	DEC	HL
	LD	D,(HL)
	DEC	HL
	LD	E,(HL)
	LD	(FSP),HL
	RET









	ELSE		;IF FAST
EXPRF:
	ENDIF

;
;----------------------------------------------------------------------------
;	'NGET@(A@)' - INPUTS A STRING THRU A NUMERIC KEYBOARD
;----------------------------------------------------------------------------
;		      SETUP STRING IS A@
;		      USE AFTER DISPLAY n,BLANK TO PRESET AND
;		      SELECT THE DISPLAY
;
;	ANNOTAZIONE DI LAVORO: QUESTA ROUTINE FUNZIONA SOLO CON
;	=====================  I DISPLAY LCD DI FMD_
;	TUTTAVIA NON ESEGUE ACCESSI DIRETTI AL DISPLAY MA USA
;	INVECE SOLO DEI CARATTERI DEI CONTROLLO ATTRAVERSO IL
;	DISPOSITIVO LOGICO AUXOUT_
;	E' CIOE' PREDISPOSTA PER UNA EVENTUALE TRASFORMAZIONE
;	PER ESSERE IMPIEGATA ANCHE SU VIDEO_
;	NOTARE SOLO CHE E' STATO USATO IL CARATTERE HOME (0BH)
;	PER ESEGUIRE QUELLO INVECE CHE E' IN REALTA' UN 'LINE HOME'_
;
;	COPY TO THE BUFFER THE SETUP STRING
NGET@:	CALL	GCI
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC

	CALL	EXPRB
	CALL	EFFLEN		;HL=ADDRESS, C=EFFECTIVE LENGHT
	JP	Z,E19		;NO STRING ERROR
	LD	A,20		;DISPLENG
	CP	C
	JP	C,E19		;STRING LENGHT>DISPLAY LENGHT
	LD	DE,STGBUF
	LD	B,0
	PUSH	BC		;SAVE STRING LENGHT FOR FUTURE USAGE
	LDIR
NGET9:	LD	A,0
	LD	(DE),A

;	DISPLAY THE STRING AND HOME CURSOR
	POP	BC		;GET BACK LENGTH
	LD	A,C
	LD	(STLEN),A	;STORE STRING LENGTH
	LD	B,C
	LD	HL,STGBUF
	CALL	STGAUX		;DISPLAY STRING

	LD	A,0BH		;SWITCH ON AND HOME CURSOR
	CALL	AUXOUT

	LD	A,1		;SET RAM POINTER
	LD	(CPOINT),A


;	GET A COMMAND AND EXECUTE IT
NGET2:	CALL	CONIN
	CP	CMLCH		;CURSOR-MOVE-LEFT
	JR	Z,CLEFT
	CP	CMRCH		;CURSOR-MOVE-RIGHT
	JR	Z,CRIGHT
	CP	CHPLCH		;CHARACTER-PLUS
	JR	Z,CPLUS
	CP	CHMICH		;CHARACTER-MINUS
	JP	Z,CMINUS
	LD	IX,CLEARCH
	CP	(IX+0)
	JR	Z,CLR_DISP
	CP	CR
	JP	Z,NGETEND
	JP	NGET2

CLR_DISP:
	LD	HL,STGBUF
	LD	DE,STGBUF+1
	LD	A,' '
	LD	(HL),A
	LD	B,0
	LD	A,(STLEN)
	LD	C,A
	PUSH	BC		;A 'POP' FOLLOWS
	LDIR
	INC	DE
	LD	A,0BH		;SWITCH ON AND HOME CURSOR
	CALL	AUXOUT
	JR	NGET9

CLEFT:	LD	A,(CPOINT)	;TEST IF ALREADY AT BEGINNING OF LINE
	CP	1
	JR	Z,NGET2
	DEC	A
	LD	(CPOINT),A
	LD	A,8
	CALL	AUXOUT
	JR	NGET2
CRIGHT:
	LD	A,(STLEN)	;MOVE CURSOR RIGHT
	LD	B,A		;BUT NOT BEYOND STRING LIMIT
	LD	A,(CPOINT)
	CP	B
	JR	Z,NGET2
	INC	A
	LD	(CPOINT),A
	LD	A,14
	CALL	AUXOUT
	JR	NGET2


CPLUS:	LD	HL,STGBUF
	LD	A,(CPOINT)
	LD	C,A
	LD	B,0
	ADD	HL,BC
	DEC	HL
	LD	A,(HL)		;GET CHAR
	INC	A
CPLUS00:LD	IX,CLEARCH
	CP	(IX+0)
	JR	NZ,CPLUS1A
	INC	A
	JR	CPLUS00
CPLUS1A:CP	','
	JR	NZ,CPLUS2
	INC	A
	JR	CPLUS00
CPLUS2:	CP	'"'
	JR	NZ,CPLUS3
	INC	A
	JR	CPLUS00
CPLUS3:	CP	60H		;DONT GO BEYOND 64 CHAR SET
	JR	NZ,CPLUS1
	LD	A,20H		;RESTART FROM SPACE
CPLUS1:	LD	(HL),A		;STORE NEW CHAR
	LD	A,12		;CLEAR DISPLAY
	CALL	AUXOUT
	LD	HL,STGBUF
	LD	A,(STLEN)
	LD	B,A
	CALL	STGAUX		;DISPLAY MODIFIED STRING
	CALL	CURTOPNT	;MOVE CURSOR TO (CPOINT)
	JP	NGET2

CMINUS:	LD	HL,STGBUF
	LD	A,(CPOINT)
	LD	C,A
	LD	B,0
	ADD	HL,BC
	DEC	HL
	LD	A,(HL)		;GET CHAR
	DEC	A

CMIN00:	LD	IX,CLEARCH
	CP	(IX+0)
	JR	NZ,CMIN1A
	DEC	A
	JR	CMIN00
CMIN1A:	CP	','
	JR	NZ,CMIN2
	DEC	A
	JR	CMIN00
CMIN2:	CP	'"'
	JR	NZ,CMIN3
	DEC	A
	JR	CMIN00
CMIN3:	CP	1FH		;DONT GO BELOW 64 CHAR SET
	JR	NZ,CMINUS1
	LD	A,5FH		;RESTART FROM TOP
CMINUS1:LD	(HL),A		;STORE NEW CHAR
	LD	A,12		;CLEAR DISPLAY
	CALL	AUXOUT
	LD	HL,STGBUF
	LD	A,(STLEN)
	LD	B,A
	CALL	STGAUX		;DISPLAY MODIFIED STRING
	CALL	CURTOPNT	;MOVE CURSOR TO (CPOINT)
	JP	NGET2


;
;	MOVE CURSOR TO (CPOINT)
;
CURTOPNT:
	LD	A,0BH		;HOME CURSOR
	CALL	AUXOUT

	LD	A,(CPOINT)
CTP1:	DEC	A		;MAKE (CPOINT) STEPS
	RET	Z
	PUSH	AF
	LD	A,0EH		;CURSOR STEP
	CALL	AUXOUT
	POP	AF
	JR	CTP1



;	LEAVE ADDRESS AND LENGHT OF THE STRING
NGETEND:
	LD	A,0FH		;SWITCH OFF THE CURSOR
	CALL	AUXOUT
	LD	A,1
	LD	(STRFLG),A
	LD	B,')'
	CALL	EATC
	LD	HL,STGBUF	;ADDRESS
	RET
;
;	* STGAUX - EMITS B BYTES FROM HL THRU AUX OUT PORT
;
STGAUX:	PUSH	BC
	LD	A,(HL)
	CALL	AUXOUT
	INC	HL
	POP	BC
	DJNZ	STGAUX
	RET

;----------------------------------------------------------------------------
;	'SUBSTR$'
;----------------------------------------------------------------------------

SUBSTR@:CALL	GCI
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB
	PUSH	HL		;ADDRESS OF ARGUMENT STRING
	CALL	TSTST
	JP	Z,E3		;FIRST ARG MUST BE A STRING
				;NOW ADDR OF THE STRING IN HL
				;LENGHT IN (STLEN)
	LD	B,','
	CALL	EATC
	CALL	BYTARG		;GET START POINT
	PUSH	DE
	LD	B,','
	CALL	EATC
	CALL	BYTARG		;GET LENGHT
	POP	BC		;C=START POINT (PUSHED AS DE)
				;E=LENGHT OF THE STRING TO PICK
	XOR	A
	ADD	A,C
	ADD	A,E
	LD	B,A		;B=START POINT+LENGHT
	LD	A,(STLEN)
	INC	A
	CP	B
	JP	C,E19		;STRING ERROR

	POP	HL		;ADDRESS OF ARGUMENT STRING
	LD	B,0		;BC=LENGHT
	ADD	HL,BC		;HL POINTS TO THE BEGINNING OF THE NEW STRG
	LD	A,E
	LD	(STLEN),A	;NEW STRING LENGHT
	LD	A,1
	LD	(STRFLG),A
	PUSH	HL
	LD	B,')'
	CALL	EATC
	POP	HL
	DEC	HL
	RET

;----------------------------------------------------------------------------
;	'CONCAT$'
;----------------------------------------------------------------------------

CONCAT@:
	CALL	GCI
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB		;GET LENGHT AND ADDRESS OF THE FIRST STRING
	PUSH	HL		;ADDRESS OF THE 1_ST STRING
	CALL	EFFLEN		;LOOK FOR TYPE MISMATCH ERRORS
	JP	Z,E19
	POP	HL		;ADDRESS OF THE 1_ST STRING
	PUSH	BC		;C=LEN OF 1_ST STRING
	LD	DE,STGBUF	;ADDRESS OF TEMPORARY AREA
	CALL	COPYSTR
	POP	BC

	PUSH	DE		;ADDRESS WHERE TO PLACE THE 2_ND STRING
	PUSH	BC

	LD	B,','
	CALL	EATC

	CALL	EXPRB		;GET LENGHT AND ADDRESS OF THE SECOND STRING
	CALL	EFFLEN		;LOOK FOR TYPE MISMATCH ERRORS
	JP	Z,E19
	POP	DE		;(PUSHED AS BC) GET INTO E THE LENGHT OF 1_ST
	LD	A,E
	ADD	A,C		;ACC HAS NOW THE TOTAL LENGHT
	LD	(STLEN1),A
	CP	255		;MAXIMUM LENGHT FOR A STRING
	JP	NC,E19

				;HL HAS STILL ADDRESS OF 2_ND AND BC HAS LENGHT
	POP	DE		;TEMPORARY AREA POINTER
	CALL	COPYSTR		;COPY 2_ND STRING
	XOR	A
	LD	(DE),A		;STORE END OF STRING MARK

	LD	A,(STLEN1)	;STLEN1 IS USED TO MAKE QUASI-REENTRANT
	LD	(STLEN),A	;THE EXPRB ROUTINE
	LD	A,1
	LD	(STRFLG),A
	LD	B,')'
	CALL	EATC
	LD	HL,STGBUF
	RET


;----------------------------------------------------------------------------
;	DATE$ - RETURNS DATE (ITALIAN FORMAT)
;----------------------------------------------------------------------------
DATEX@:	LD	E,2
	JR	TIMDA

;----------------------------------------------------------------------------
;	TIME$() - RETURNS TIME
;----------------------------------------------------------------------------
TIMEX@:	LD	E,1
TIMDA:	PUSH	DE
	CALL	GCI
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC

	LD	A,(CLKBYTE)
	CP	0FFH
	JP	Z,NOTOP

	POP	DE		;E=DATE OR TIME
	LD	C,A		;CH #
	LD	B,1		;BLOCK READ
	LD	HL,DMAREA
	CALL	DRIVER

	XOR	A
	LD	(DMAREA+9),A	;END OF STRING
	LD	HL,DMAREA
TIME@1:	PUSH	HL
	LD	A,8
	LD	(STLEN),A
	LD	A,1
	LD	(STRFLG),A
	LD	B,')'
	CALL	EATC
	POP	HL
	RET
;----------------------------------------------------------------------------
;	HEX$ - RETURNS HEX STRING OF A VALUE
;----------------------------------------------------------------------------
HEX@:	CALL	GCI
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB
	CALL	PFIX		;CONVERT TO INTEGER IN DE
	CALL	TSTST		;ARGUMENT TO DE
	JP	NZ,E3		;NO STRING AS ARGUMENT

	LD	A,1
	LD	(STRFLG),A	;RESULT IS A STRING
	LD	(RAMDEV),A	;PREPARE TO OUT INTO THE BUFFER (NOT CONSOLE)

	LD	HL,(UBUPO)
	LD	(UBUTMP),HL	;SAVE CURRENT UBUPO

	LD	HL,VALTEM0	;HL SAYS WHERE TO SEND OUTPUT
	LD	(UBUPO),HL

	LD	A,VALTEM1-VALTEM0 ;FOR BUFFER OVFL CHECK
	LD	(MAXBUF),A

;	MODIFICATION NOV 7 89 - SET MAXIMUM STRING LENGHT

	LD	A,4
	LD	(STLEN),A
	LD	A,D
	OR	A
	JR	Z,PNIBBLE
	LD	B,D
	CALL	DBYTE
PNIBBLE:LD	B,E
	CALL	DBYTE
	JR	STR@Z


;----------------------------------------------------------------------------
;	STR$ - RETURNS STRING OF A NUMERIC VALUE
;----------------------------------------------------------------------------


STR@:	CALL	GCI
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB
	CALL	TSTST
	JP	NZ,E3		;NO STRING AS ARGUMENT
	LD	DE,FPSINK	;GET RESULT TO FPSINK
	CALL	POPA1
	XOR	A
	INC	A
	LD	(RAMDEV),A	;PREPARE TO OUT INTO THE BUFFER (NOT CONSOLE)
	LD	(STRFLG),A	;RESULT IS A STRING

	LD	HL,(UBUPO)
	LD	(UBUTMP),HL	;SAVE CURRENT UBUPO

	LD	HL,VALTEM0	;HL SAYS WHERE TO SEND OUTPUT
	LD	(UBUPO),HL

	LD	A,VALTEM1-VALTEM0 ;FOR BUFFER OVFL CHECK
	LD	(MAXBUF),A

	LD	HL,FPSINK	;HL SAYS FROM WHERE GET STRING
	CALL	FPOUT		;OUTPUT THE RESULTING STRING
STR@Z:	LD	HL,MAXBUF	;CHECK IF THERE IS SPACE FOR THE TERMINATOR
	DEC	(HL)
	JP	Z,E19

	XOR	A		;ADD TERMINATOR
	LD	HL,(UBUPO)
	LD	(HL),A

	LD	(RAMDEV),A	;RESET OUTPUT REDIRECTION FLAG

	LD	HL,(UBUTMP)	;RESTORE OLD UBUPO
	LD	(UBUPO),HL	;SEE NOTE AT OTOBUF
STR@1:
	LD	B,')'
	CALL	EATC
	LD	HL,VALTEM0	;LEAVE ADDRESS OF THE RESULTING STRING
	LD	A,' '		;SKIP TRAILING SPACE IF ANY
	CP	(HL)
	JR	NZ,NOTRSP	;NO TRAILING SPACE
	INC	HL
NOTRSP:	CALL	EFFLEN		;CALCULATE EFFECTIVE LENGHT
	LD	A,C
	LD	(STLEN),A
	RET
;
;----------------------------------------------------------------------------
;	CHA$ - RETURNS DESCRIPTION OF A CHAR
;----------------------------------------------------------------------------

;	RETURNS 'x' IF x CHAR IS PRINTABLE
;	RETURNS A 3-CHAR DESCRIPTION IF CHAR IS NOT PRINTABLE

CHA@:	CALL	GCI		;EAT $
	CALL	EXPRB
	CALL	TSTST
	JP	NZ,E3
	CALL	PFIX
	LD	A,E
	CP	'!'		;LESS THAN '!' ?
	JP	NC,CH8BIT	;JUMP IF GREATER

	LD	HL,CTRLCTAB	;CONVERT TO STRING
	LD	D,0
	LD	E,A
	ADD	HL,DE
	ADD	HL,DE
	ADD	HL,DE
CHA@4:	LD	DE,VALTEM0	;DESTINATION
	LD	BC,3		;3 CHARS TO COPY
	LDIR
	XOR	A
	LD	(DE),A		;TERMINATOR

CHA@5:	LD	A,4
	LD	(STLEN),A
	LD	(STRFLG),A
	LD	B,')'
	CALL	EATC
	LD	HL,VALTEM0
	RET

CTRLCTAB:
	DB	'NUL','SOH','STX','ETX','EOT','ENQ','ACK','BEL'
	DB	'BS ','HT.','LF.','VT.','FF.','CR.','SO.','SI.'
	DB	'DLE','DC1','DC2','DC3','DC4','NAK','SYN','ETB'
	DB	'CAN','EM.','SUB','ESC','FS.','GS.','RS.','US.'
	DB	'SPC'
CBOH:	DB	'???'

CH8BIT:	CP	80H		;8 BIT VALUE?
	JP	C,NORMCH	;JUMP IF LESS
	LD	HL,CBOH
	JP	CHA@4
NORMCH:				;NORMAL CHARACTER INSERT QUOTES
	LD	HL,VALTEM0
	PUSH	AF
	LD	A,27H		;SINGLE QUOTES
	LD	(HL),A
	INC	HL
	POP	AF
	LD	(HL),A		;CHARACTER
	LD	A,27H
	INC	HL
	LD	(HL),A		;SINGLE QUOTES
	XOR	A
	INC	HL
	LD	(HL),A		;TERMINATOR
	JP	CHA@5

;----------------------------------------------------------------------------
;	CHR$() - RETURNS A CHAR OF ASSIGNED CODE
;----------------------------------------------------------------------------
CHR@:	CALL	GCI
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC
	CALL	GC
	CP	'$'
	JP	Z,CHA@		;SEE IF WE WANT ONLY PRINTABLE CHARS
	CALL	EXPRB
	CALL	TSTST
	JP	NZ,E3
	CALL	PFIX
	LD	A,E
CHR@1:	LD	(VALTEM0),A
	XOR	A
	LD	(VALTEM1),A
	LD	A,1
	LD	(STLEN),A
	LD	(STRFLG),A
	LD	B,')'
	CALL	EATC
	LD	HL,VALTEM0
	RET

;
;	MODIFICA SPERIMENTALE

EXPBS1:				;<----- MAIN PATH

;	MOD.08.01.94 - BUG - SE GUARDA CASO LA LINEA SEGUENTE INIZIA PER 24H
;	------------------   SI CADE NELL'ERRORE DI RITENERE LA VAR. ALFANUM.

;	PRIMA DI VEDERE SE SEGUE UN $, VEDI SE C'E' UNA POSSIBILE VARIABILE

	LD	A,(HL)
	CP	'A'
	JR	C,NUMEXPR	;NO, SALTA
	CP	'Z'+1
	JR	NC,NUMEXPR	;NO, SALTA

;	C'E' UNA POSSIBILE VARIABILE - SARA� ALFANUMERICA?

	INC	HL		;TEST FOR STRING VARIABLE NOW
	LD	A,(HL)
	CP	'$'
	JR	Z,STREXP	;IF STRING IS "A$" TYPE
	CP	CR		;SE LA VAR E' SEGUITA DA CR...
	JR	Z,NUMEXPR	;...NESSUN CONTROLLO ULTERIORE
	INC	HL
	LD	A,(HL)
	CP	'$'		;IF STRING IS "A1$" TYPE
	JP	NZ,NUMEXPR	;-----> MAIN PATH
STREXP:	CALL	VARX
	RET

NUMEXPR:			;<----- MAIN PATH
	LD	HL,OPBOL	;OPERATORS TABLE
	XOR	A
	LD	(RELTYP),A
;
;	ZERO IN B MEANS PRINCIPAL OPERATOR MAY NOT BE RELATIONAL
;
EXPR:	PUSH	BC
	PUSH	HL		;PUSH OPTBA
	XOR	A
	LD	(ARGF),A
EXPR1:	LD	A,(ARGF)
	OR	A
	JP	NZ,EXPR2
	CALL	VARX		;LOOK FOR VARIABLE PERHAPS SUBSCRIPTED
	CALL	NC,PSHAS	;IF NC THEN IT WAS A VARIABLE
	JP	NC,EXPR2
	CALL	CONST		;IF C THEN MAY BE A CONSTANT
	JP	NC,EXPR2
	CALL	GC		;NOT A VAR NOR A COST - LEFT PARENTH?
	CP	LPARRW
	LD	HL,OPLPAR
	JP	Z,XLPAR		;GO TO PROCESS PARENTHESIS
;
;	ISN'T OR SHOULDN'T BE AN ARGUMENT
;
EXPR2:	CALL	GC
	CP	0E0H		;CHECK FOR RESERVED WORD OPERATOR
	JP	NC,XOP		;IF > E0 THEN IS AN OPERATOR
	CP	0C0H		;CHECK FOR BUILT IN FUNCTION
	JP	NC,XBILT	;IF >C0 AND >E0 THEN IT IS A BUILT-IN FUNCT
;
;	ILLEGAL EXPRESSION CHARACTER
;
	POP	HL		;GET OPTABA
	LD	A,(ARGF)
	OR	A
	JP	Z,E1
XDON1:	POP	AF
	LD	HL,RELTYP	;CHECK IF LEGAL PRINCIPAL OPERATOR
	CP	(HL)
	RET	Z
	JP	E1
;
XOP:	AND	37Q		;CLEANS OFF RW BITS
	LD	HL,(ARGF)	;TEST FOR ARGF TRUE
	DEC	L
	JP	Z,XOP1
;
;	ARGF WAS FALSE, UNARY OPS ONLY POSSIBILITY
;
	CP	'*'-OPBASE
	JR	Z,DEREFOP
	CP	'-'-OPBASE
	JP	Z,XOPM
	CP	'+'-OPBASE
	JP	NZ,E1

	CALL	GCI		;EAT THE '+'
	JP	EXPR1

DEREFOP:LD	A,29		;indirizzo di DEREF in tabella
	JR	XOP1

;	qui si passa solo per l'unary minus
XOPM:	LD	A,UMINU-OPBASE	;risultato 9 - nono operatore della OPTAB

;	qui si passa per qualunque operatore
XOP1:	CALL	OPADR		;indirizzo ritornato in HL
	POP	DE		;PREVIOUS OPTAB
	LD	A,(DE)		;prendi precedenza del precedente
	CP	(HL)		;confrontala con l'attuale
	JP	NC,XDON1	;NON-INCREASING PRECEDENCE
;
;	INCREASING PRECEDENCE CASE
;
	PUSH	DE		;SAVE PREVIOUS OPTBA
	PUSH	HL		;SAVE CURRENT OPTBA
	CALL	GCI		;TO GOBBLE OPERATOR
	POP	HL
	PUSH	HL
	LD	B,0		;SPECIFY NON-RELATIONAL
	CALL	EXPR
	POP	HL
;
;	HL HAS OPTBA ADDR
;	SET UP ARGS AND PERFORM OPERATION ACTION
;
XOP2:	PUSH	HL
	LD	A,(HL)		;FUNCTION TYPE EX TABLE
	LD	HL,(ASTKA)
	LD	B,H
	LD	C,L
	AND	1
	JP	NZ,XOP21
;
;	DECREMENT SP BY 1 VALUE BINARY CASE
;
	LD	DE,FPSIZ
	ADD	HL,DE
	LD	(ASTKA),HL
	LD	D,H
	LD	E,L
XOP21:	LD	HL,EXPR1
	EX	(SP),HL		;CHANGE RETURN LINK
	INC	HL		;SKIP OVER PRECEDENCE
	CALL	LHLI		;LOAD ACTION ADDR
	JP	(HL)		;EFFECTIVE JUMP TO ACTION ROUTINE
;
;	HERE BUILT-IN FUNCTIONS ARE PROCESSED
;	^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;
;	(ACTION ROUTINE CONVENTION:
;	DE LEFT  ARG AND RESULT FOR BINARY
;	BC RIGHT ARG FOR BINARY, ARG AND RESULT FOR UNARY)
;
XBILT:	CALL	GCI		;EAT TOKEN
	AND	77Q		;CLEAN OFF RW BITS
	LD	HL,(ARGF)	;BUILT IN FUNCTION MUST COME AFTER OPERATOR
	DEC	L
	JP	Z,E1
	CALL	OPADR		;RETURNS THE ADDRESS OF ACTION ROUTINE
				;IN HL (GIVEN RW IN ACC)
XLPAR:	LD	A,1
	LD	(ARGNUM),A	;SET # OF ARGS TO 1 AS DEFAULT
	PUSH	HL		;ADDRESS OF TABLE ACTION ROUTINE PUSHED
	LD	B,LPARRW
	CALL	EATC
	LD	A,(SPECFUN)
	OR	A
	JP	Z,NOSPECF
	XOR	A
	LD	(SPECFUN),A
	CALL	VARX		;PROCESS ADDROF()
	LD	A,(STRFLG)
	OR	A
	JP	NZ,E3		;NOT ALLOWED FOR STRINGS
	JP	C,E3		;NOT DEFINED - ARG ERROR
	CALL	ACALX		;CONVERT TO FLOAT AND PUSH
	JR	SPREENT		;REENTER NORMAL FLOW


NOSPECF:CALL	EXPRB		;EVALUATE THE ARGUMENT OF THE FUNCTION
	LD	(VALTEMP-1),HL	;SAVE STRING ADDRESS
SPREENT:CALL	GC
	CP	','
	JP	Z,TWOARG	;REL 4.00 ALLOWS TWO OP FUNCT
	LD	B,')'
	CALL	EATC
TWOARG2:
	POP	HL		;POP ADDRESS FOR BUILT IN FUNCTION
	JP	XOP2
TWOARG:	LD	A,2
	LD	(ARGNUM),A	;SET NUMBER OF ARGUMENTS
	JR	TWOARG2
;
;	COMPUTE OP TABLE ADDR FOR OPERATOR IN ACC
;	DISTINGUISH BETWEEN DUAL BYTE AND DUAL OPERANDS FUNCTION
;
OPADR:	CP	17H		;17H = FPREFIX AND 77Q - DUAL BYTE ?
	JR	NZ,FSING
	CALL	GCI		;DUAL BYTE - GET NEXT RW
	PUSH	AF		;SAVE
	CP	ADDROFRW	;IS IT ADDROF SPECIAL FUNCTION?
	LD	A,0		;ADD HERE NEW SPECIAL FUNCTIONS
	JR	NZ,OPADR1	;A SPECIAL FUNCTION IS A FUNCTION THAT
	INC	A		;REQUIRES TO PROCESS ARGUMENT AS A STATEMENT
OPADR1:	LD	(SPECFUN),A	;SET SPECIAL FUN  FLAG
	POP	AF
	AND	77Q
	LD	HL,OPTAB2	;SEARCH IN OPTAB2
	JR	FDUAL
FSING:	LD	HL,OPTAB	;SINGLE BYTE - SEARCH IN OPTAB1
FDUAL:	LD	C,A
	LD	B,0
	ADD	HL,BC
	ADD	HL,BC
	ADD	HL,BC		;OPTAB ENTRY ADDR IS 3*OP+BASE
	RET
;
;
;
;
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 6 - ERRORS PROCESSING			*
;	*							*
;	*							*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;
;
;

ERROR:	PUSH	HL
	LD	A,(DIRF)	;CHECK INPUT MODE
	OR	A
	JP	NZ,ERRO1	;IF DIRECT INPUT MODE NO TRAP CHECK IS DONE

	LD	HL,(TRPSP)	;CHECK FOR TRAPS SET
	LD	BC,TRPSTK	;IF (TRPSP) = TRPSTK
	OR	A		;THERE IS NO ENTRY
	SBC	HL,BC

;	LD	A,B
;	CPL
;	LD	B,A
;	LD	A,C
;	CPL
;	LD	C,A
;	INC	BC
;	ADD	HL,BC
;	LD	A,H
;	OR	L

	JP	Z,ERRO1		;IF TRAP STACK EMPTY

;---------------------------------------------------------------------------
;	IN CASE OF 'ON ERROR' HAS BEEN EXECUTED
;---------------------------------------------------------------------------

	LD	HL,(TRPSP)	;POP LINE NUMBER
	INC	HL
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;TO DE

	LD	(TRPSP),HL	;STORE NEW STACK POINTER

	CALL	FINDLN		;FIND THE LINE
	INC	HL		;ADVANCE POINTER BEYOND LINE # AND COUNT
	INC	HL
	INC	HL
	LD	(TXA),HL	;UPDATE TXA
	LD	SP,CMNDSP 	;CLEAN UP
	JP	ILOOP		;CONTINUE EXECUTION FROM TRAP LINE

;---------------------------------------------------------------------------
;	PREPARE TO PRINT OUT ERROR MESSAGE
;---------------------------------------------------------------------------

ERRO1:	LD	A,(ERRCON)	;SET CONSOLE I/O TO PRESET DEVICE
	LD	(IBYTE),A
	LD	(OBYTE),A

	LD	A,3		;OUTPUT TO ERR:
	LD	(LOGDEVO),A

	CALL	CRLF
	LD	HL,ERS		;PRINT 'ERR' MESSAGE
	CALL	PRNT

	POP	HL		;PRINT SPECIFIC ERROR MESSAGE
ERM1:	CALL	PRNT

	LD	A,(DIRF)	;IF IN DIRECT MODE DO NOT PRINT LINE NUMBER
	OR	A
	JR	NZ,ERRO2

	LD	HL,INS		;PRINT 'LN' MESSAGE
	CALL	PRNT

;	FIND LINE NUMBER

	LD	HL,(BOFA)
ERM2:	LD	B,H
	LD	C,L
	LD	E,(HL)
	LD	D,0
	ADD	HL,DE
	EX	DE,HL
	LD	HL,TXA
	CALL	DCMP
	EX	DE,HL
	JP	C,ERM2
	INC	BC
	LD	A,(BC)
	LD	L,A
	INC	BC
	LD	A,(BC)
	LD	H,A
	LD	DE,IBUF		;USE IBUF TO ACCUMULATE LINE NO_ STRING
	CALL	CNS
	LD	A,'"'
	LD	(DE),A
	LD	HL,IBUF		;STRING IS IN IBUF
	CALL	PRNT		;PRINT TO '"' (EXCLUDED)

ERRO2:	CALL	CRLF
	XOR	A		;RESET LOGIC DEV TO CON:
	LD	(LOGDEVO),A
	LD	(LOGDEVI),A

	EI
	JP	CMND1

;	HEXD - FUNZIONE AUSILIARIA PER PROVE

HEXD:	RET

;	HEXW - WORD HEX DISPLAY

HEXDW:	LD	B,H
	CALL	DBYTE
	LD	B,L
	CALL	DBYTE
	LD	A,20H
	CALL	VOUT
	RET

	IF	ERRLONG

SYNTX:	DB	'SINT"'
E1:	LD	HL,SYNTX
	JR	ERRJP1

CRITMS:	DB	'CRIT"'
CRITER:	LD	HL,CRITMS
	JR	ERRJP1

ARGUM:	DB	'FUN/VAL"'
E3:	LD	HL,ARGUM
	JR	ERRJP1
;
CSTAK:	DB	'F/NXT/RET 1"'	;FOR/NEXT/RET
E4:	LD	HL,CSTAK
	JR	ERRJP1

E4AM:	DB	'FOR/NXT"'
E4A:	LD	HL,E4AM
	JR	ERRJP1

E4BM:	DB	'F/NXT/RET 2"'	;FOR/NEXT/RET
E4B:	LD	HL,E4BM
	JR	ERRJP1

E4CM:	DB	'RET"'
E4C:	LD	HL,E4CM
ERRJP1:	JR	ERRJP2

E4DM:	DB	'CTL STK OF"'	;OVERFLOW
E4D:	LD	HL,E4DM
	JR	ERRJP2


;
BOUND:	DB	'IDX"'		;INDICE/ARGOMENTO
E5:	LD	HL,BOUND
	JR	ERRJP2
;
DIMEN:	DB	'DIM"'
E6:	LD	HL,DIMEN
	JR	ERRJP2

STOVL:	DB	'MEM"'		;FUORI MEMORIA
E8:	LD	HL,STOVL
	JR	ERRJP2

ERRINT:	DB	'INT NON PRED"'
E9:	LD	HL,ERRINT	;INTERRUPT ERROR MESSAGE
	JR	ERRJP2

ERRINTC:DB	'INT#"'
E9C:	LD	HL,ERRINTC	;INTERRUPT ERROR MESSAGE
ERRJP2:	JR	ERRJP3

ERRINTD:DB	'I STK OF"'
E9D:	LD	HL,ERRINTD	;INTERRUPT STACK OVERFLOF
	JR	ERRJP3

MISM:	DB	'STG"'		;STRINGA
E19:	LD	HL,MISM
	JR	ERRJP3

RDERR:	DB	'READ"'
READERR:
	LD	HL,RDERR
	JR	ERRJP3

INPER:	DB	'INPUT"'
INERR:	LD	HL,INPER
	JR	ERRJP3

ISTAK:	DB	'STK"'
STKERR:	LD	HL,ISTAK
ERRJP3:	JR	ERRJP4


NGSQR:	DB	'RAD NEG"'
NEGERR:	LD	HL,NGSQR
	JR	ERRJP4		;NEG ARG

LNUMB:	DB	'NUM LIN"'
LERROR:	LD	HL,LNUMB
	JR	ERRJP4


DIRIN:	DB	'MODO"'		;MODO DIRETTO O XWS
DIRERR:	LD	HL,DIRIN
	JR	ERRJP4

LENGHT:	DB	'LN LUNGA"'
LONGERR:
	LD	HL,LENGHT
	JR	ERRJP4

CHMSG:	DB	'LOGDEV"'	;CANALE I/O (ERA CH)
CHANERR:
	LD	HL,CHMSG
	JR	ERRJP4

FLOAT:	DB	'ARITM"'
OVER:	LD	HL,FLOAT
	JR	ERRJP4

PDERRM:	DB	'DEV INES"'
PDERR:	LD	HL,PDERRM
	JR	ERRJP4

D0MSG:	DB	'DIV PER 0"'
DIVZ:	LD	HL,D0MSG
ERRJP4:	JR	ERRJP5


ALREMSG:DB	'GIA` OPEN"'
ALREOP:	LD	HL,ALREMSG
	JR	ERRJP5

NOTOMSG:DB	'NON OPEN"'
NOTOP:	LD	HL,NOTOMSG
	JR	ERRJP5

TOOLMSG:DB	'NOME"'
TOOLONG:LD	HL,TOOLMSG
ERRJP5:	JP	ERROR

DRVMSG: DB	'DRV"'
DRVERR:	LD	HL,DRVMSG
	JR	ERRJP5

IVMSG:	DB	'VETT INT"'
IVERR:	LD	HL,IVMSG
	JR	ERRJP5

BUGMSG:	DB	'BUG"'
BUGERR:	LD	HL,IVMSG
	JR	ERRJP5

CSMSG:	DB	'C STG"'	;CONFIG STRING
CSERR:	LD	HL,CSMSG
	JR	ERRJP5

MMTMSG:	DB	'MMT"'
MMTERR:	LD	HL,MMTMSG
	JR	ERRJP5

	ELSE

SHORTERR:
	DB	'MESS ERR NON DISP "'

E1:
E3:
E4:
E4A:
E4B:
E4C:
E4D:
E5:
E6:
E8:
E9:
E19:
READERR:
INERR:
STKERR:
NEGERR:
LERROR:
DIRERR:
CHANERR:
LONGERR:
OVER:
DIVZ:
RVERR:
EEPERR:
PDERR:
IVERR:
BUGERR:
TOOLONG:
ALREOP:
E9C:
CRITER:
MMTERR:
DRVERR:
E9D:
NOTOP:
CSERR:
	LD	HL,SHORTERR
	JP	ERROR

	ENDIF

ERS:	DB	'ERR "'

;	ERRORS ENDS HERE
;
;
;
;
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 7 - OPTIONAL MODULES			*
;	*							*
;	*							*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;
;
;

	IF	FMD
;
;	NOTA: LE SEGUENTI ROUTINES HANNO INDIRIZZI ASSOLUTI DELLE PORTE
;	      POICHE' SI TRATTA DI FRASI ESCLUSIVAMENTE RISERVATE AL FMD
;	      CHE HA UNA CONFIGURAZIONE DEI BIT PARTICOLARE
;	      E NON SI ADATTEREBBERO AD ALTRE PORTE

MOTOR:	CALL	BYTARG		;GET MOTOR #
	LD 	A,E
	CALL	CK1_3
	PUSH	DE
	LD	B,','
	CALL	EATC
	CALL	BYTARG		;GET ON OR OFF (0/1)
	LD	A,E
	POP	DE		;DE IS MOTOR #
	CP	0
	JR	Z,MOT_OFF
	CP	1
	JR	Z,MOT_ON
	JP	E3
MOT_ON:	LD	HL,MOT_BIT	;BIT TABLE
	DEC	DE
	ADD	HL,DE
	LD	A,(HL)		;GET BIT MASK
	LD	B,A		;STORE TO B
	LD	A,(P70H_IMA)	;RAM PORT 70H CONTENT IMAGE
	OR	B		;SET THE BIT THAT SWITCHES THAT MOTOR ON
	OUT	(70H),A
	LD	(P70H_IMA),A	;UPDATE IMAGE
	RET
MOT_OFF:LD	HL,MOT_BIT	;BIT TABLE
	DEC	DE
	ADD	HL,DE
	LD	A,(HL)		;GET BIT MASK
	CPL			;PREPARE FOR BIT RESET
	LD	B,A		;STORE TO B
	LD	A,(P70H_IMA)	;RAM PORT 70H CONTENT IMAGE
	AND	B		;RESET THE BIT THAT SWITCHES THAT MOTOR OFF
	OUT	(70H),A
	LD	(P70H_IMA),A	;UPDATE IMAGE
	RET

MOT_BIT:			;MOTOR BIT TABLE
	DB	10000000B	;MOTOR 1
	DB	01000000B	;MOTOR 2
	DB	00100000B	;MOTOR 3


LAMP:
	CALL	BYTARG		;GET LAMP #
	LD 	A,E
	CALL	CK1_3
	PUSH	DE
	LD	B,','
	CALL	EATC
	CALL	BYTARG		;GET ON OR OFF (0/1)
	LD	A,E
	POP	DE		;DE IS LAMP #
	CP	0
	JR	Z,LAMP_OFF
	CP	1
	JR	Z,LAMP_ON
	JP	E3
LAMP_ON:LD	A,E
	CP	3
	JR	Z,LP_ON3
	LD	HL,LAMP_BIT	;BIT TABLE
	DEC	DE
	ADD	HL,DE
	LD	A,(HL)		;GET BIT MASK
	LD	B,A		;STORE TO B
	LD	A,(P70H_IMA)	;RAM PORT 70H CONTENT IMAGE
	OR	B		;SET THE BIT THAT SWITCHES THAT LAMP ON
	OUT	(70H),A
	LD	(P70H_IMA),A	;UPDATE IMAGE
	RET
LAMP_OFF: LD	A,E
	CP	3
	JR	Z,LP_OFF3
	LD	HL,LAMP_BIT	;BIT TABLE
	DEC	DE
	ADD	HL,DE
	LD	A,(HL)		;GET BIT MASK
	CPL			;PREPARE FOR BIT RESET
	LD	B,A		;STORE TO B
	LD	A,(P70H_IMA)	;RAM PORT 70H CONTENT IMAGE
	AND	B		;RESET THE BIT THAT SWITCHES THAT LAMP OFF
	OUT	(70H),A
	LD	(P70H_IMA),A	;UPDATE IMAGE
	RET
LP_ON3: LD	A,(PKILPORT_IMA)
	SET	5,A
	LD	(PKILPORT_IMA),A
	OUT	(KILPORT),A
	RET
LP_OFF3:LD	A,(PKILPORT_IMA)
	RES	5,A
	LD	(PKILPORT_IMA),A
	OUT	(KILPORT),A
	RET
LAMP_BIT:			;LAMP BIT TABLE
	DB	00000010B	;LAMP 1
	DB	00000001B	;LAMP 2

VALVE:	CALL	BYTARG		;GET VALVE #
	LD 	A,E
	CALL	CK1_3
	PUSH	DE
	LD	B,','
	CALL	EATC
	CALL	BYTARG		;GET ON OR OFF (0/1)
	LD	A,E
	POP	DE		;DE IS VALVE #
	CP	0
	JR	Z,VALV_OFF
	CP	1
	JR	Z,VALV_ON
	JP	E3
VALV_ON:LD	HL,VALV_BIT	;BIT TABLE
	DEC	DE
	ADD	HL,DE
	LD	A,(HL)		;GET BIT MASK
	LD	B,A		;STORE TO B
	LD	A,(P70H_IMA)	;RAM PORT 70H CONTENT IMAGE
	OR	B		;SET THE BIT THAT SWITCHES THAT VALVE ON
	OUT	(70H),A
	LD	(P70H_IMA),A	;UPDATE IMAGE
	RET
VALV_OFF: LD	HL,VALV_BIT	;BIT TABLE
	DEC	DE
	ADD	HL,DE
	LD	A,(HL)		;GET BIT MASK
	CPL			;PREPARE FOR BIT RESET
	LD	B,A		;STORE TO B
	LD	A,(P70H_IMA)	;RAM PORT 70H CONTENT IMAGE
	AND	B		;RESET THE BIT THAT SWITCHES THAT VALVE OFF
	OUT	(70H),A
	LD	(P70H_IMA),A	;UPDATE IMAGE
	RET

VALV_BIT:			;VALVE BIT TABLE
	DB	00010000B	;VALVE 1
	DB	00001000B	;VALVE 2
	DB	00000100B	;VALVE 3

	ELSE
VALVE:
LAMP:	RET

	ENDIF




;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 8 - STANDARD STATEMENTS AND COMMANDS	*
;	*							*
;	*							*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *

;--------------------------------------------------------------------------
;	'AUTOSTART' - SETS ON OR OFF THE AUTORESTART ON BREAK
;--------------------------------------------------------------------------

AUTSTA:	CALL	BYTARG
	LD	A,E
	OR	A
	JP	M,E3
	CP	2
	JP	NC,E3
	LD	(AUTOST),A
	RET


;--------------------------------------------------------------------------
;	'BEEP'
;--------------------------------------------------------------------------

BEEP:	XOR	A		;OUT TO LOGICAL DEV CON:
	LD	(LOGDEVO),A
	LD	B,BELL
	CALL	CHOUT
	RET

;--------------------------------------------------------------------------
;	'DOG' - ACTIVATE WATCHDOG
;--------------------------------------------------------------------------
;	2/97 - MODIFICA DELLA LOGICA DI FUNZIONAMENTO DELLA FRASE DOG
;	ADESSO LA FUNZIONE DOG E' IMPLICITA NELL'INTERPRETAZIONE DELLE
;	FRASI, IN QUANTO VIENE AUTOMATICAMENTE CHIAMATA LA FUNZIONE 91H
;	DEL DRIVER DI CONSOLE

DOG:	LD	C,0		        ;DRIVER 0
	LD	B,91H			;ASK FOR SPECIAL FUNCTION '91H'
	CALL	DRIVER
	RET

;--------------------------------------------------------------------------
;	'ERASE' COMMAND
;--------------------------------------------------------------------------

CSCR:	LD	HL,(BOFA)
	LD	(HL),EOF
	LD	(EOFA),HL
	JR	CCLEAR

;--------------------------------------------------------------------------
;	'BACKSP'
;--------------------------------------------------------------------------

;	SET THE RUBOUT CHAR (DEFAULT IS 8)

BACKSP:	LD	B,ISRW
	CALL	EATC
	CALL	BYTARG		;GET CODE
	LD	A,E
	LD	(RUBOUT),A
	RET

;--------------------------------------------------------------------------
;	'CLEAR'
;--------------------------------------------------------------------------
;
STMCLR:	CALL	GC
	CP	ISRW
	JR	Z,SETCLRC	;SET CLEAR CHAR?

CCLEAR:	LD	HL,(EOFA)	;CLEAR FROM EOFA TO MEMTOP
	INC	HL
	LD	(MATA),HL
	EX	DE,HL
	LD	HL,MEMTOP	;END OF ASSIGNED MEMORY
	LD	(STB),HL
CCLR1:	XOR	A
	LD	(DE),A
	CALL	DCMP
	INC	DE
	JP	NZ,CCLR1
	LD	HL,(MEMTOP)
	LD	(STB),HL
	LD	HL,CSTKL+CSTKSZ-1
	LD	(HL),ETYPE
	LD	(CSTKA),HL
INIASTK:LD	HL,ASTKL+ASTKSZ+FPSIZ-1
	LD	(ASTKA),HL
	RET

;	SET THE CLEARCH USED BY VARIOUS INPUT ROUTINES

SETCLRC:CALL	GCI
	CALL	EXPRB
	CALL	EFFLEN
	LD	A,1
	CP	C
	JP	NZ,E3		;ARGUMENT MUST HAVE LENGHT 1
	LD	A,(HL)
	LD	(CLEARCH),A
	RET


;--------------------------------------------------------------------------
;	PUSHIGN - PUSH CURRENT IGNORE FLAG STATUS
;--------------------------------------------------------------------------

PUSHIGN:LD	HL,(IGNSP)	;LOAD STACK POINTER

	PUSH	HL
	LD	DE,IGNSTKE	;CHECK FOR OVERFLOW
	OR	A		;RESET CARRY
	SBC	HL,DE
	JP	NC,E4D		;CONTROL STACK OVFL
	POP	HL

	LD	A,(IGNORE)
	LD	(HL),A		;AND SAVE IT
	INC	HL
	LD	(IGNSP),HL
	RET

;--------------------------------------------------------------------------
;	POPIGN - POP AND RESTORE IGNORE FLAG STATUS
;--------------------------------------------------------------------------
POPIGN:	LD	HL,(IGNSP)	;LOAD STACK POINTER
	DEC	HL

	PUSH	HL
	LD	DE,IGNSTKB	;CHECK FOR UNDERFLOW
	OR	A		;RESET CARRY
	SBC	HL,DE
	JP	C,E4D
	POP	HL

	LD	A,(HL)
	LD	(IGNORE),A	;RESTORE BASIC INTERRUPT STATUS
	LD	(IGNSP),HL
	RET


;--------------------------------------------------------------------------
;	'CRITSEG' - BEGINNING OF A POWER DOWN-CRITICAL SEGMENT
;--------------------------------------------------------------------------

;	NOTE - ALTOUGHT A STACK IS PROVIDED FOR CRITICAL SEGMENTS
;	CURRENTLY JUST THE FIRST LEVEL IS USED BECAUSE HW AND BASIC INTS
;	ARE DISABLED DURING A CRITICAL SEG

CRITON:	PUSH	DE
	PUSH	HL
	LD	HL,(CRITSP)	;LOAD STACK POINTER

	PUSH	HL
	LD	DE,CRTSTKE	;CHECK FOR OVERFLOW
	OR	A		;RESET CARRY
	SBC	HL,DE
	JP	NC,CRITER	;TOO MANY CRITSEGS
	POP	HL

	CALL	GETIFF		;GET CURRENT HW INT STATUS AND DIS.INT
	LD	(HL),A		;AND SAVE IT
	INC	HL

	LD	A,(CRITIC)	;SAVE CURRENT 'CRITIC' STATE
	LD	(HL),A
	INC	HL

	LD	A,(INT_ENA)	;SAVE CURRENT INTERRUPT ENABLE STATUS
	LD	(HL),A
	INC	HL

	LD	(CRITSP),HL	;SAVE NEW SP

	XOR	A		;DISABLE BASIC INTERRUPTS
	LD	(INT_ENA),A
	INC	A
	LD	(CRITIC),A	;SET CURRENT STATE TO 'CRITIC'
	POP	HL
	POP	DE
	RET

;--------------------------------------------------------------------------
;	'ENDCRIT' - END OF A POWER DOWN-CRITICAL SEGMENT
;--------------------------------------------------------------------------

CRITOF:	PUSH	HL
	PUSH	DE

	LD	HL,(CRITSP)	;LOAD STACK POINTER
	DEC	HL

	PUSH	HL
	LD	DE,CRTSTKB	;CHECK FOR UNDERFLOW
	OR	A		;RESET CARRY
	SBC	HL,DE
	JP	C,CRITER
	POP	HL

	LD	A,(HL)
	LD	(INT_ENA),A	;RESTORE BASIC INTERRUPT STATUS
	DEC	HL

	LD	A,(HL)
	LD	(CRITIC),A	;RESTORE 'CRITIC' STATUS
	DEC	HL

	LD	A,(HL)		;RESTORE HW INT STATUS

	LD	(CRITSP),HL	;SAVE NEW SP
	CALL	SETIFF


	LD	A,(PDOWN)	;HAS A POWER FAULT HAPPENED DURING
	OR	A		;CRITICAL SEGMENT?
	JP	NZ,DOPWDN0	;YES, DO WHAT YOU MUST - DONT WORRY ABOUT
				;STACK - IT WILL BE REINITIALIZED
CRITOFQ:POP	DE
	POP	HL
	RET			;NO, RET


;--------------------------------------------------------------------------
;	'LOCK' - LOCK SYSTEM AND DO NOTHING (USED FOR TEST)
;--------------------------------------------------------------------------

;	USED TO FREEZE SYSTEM STATUS

LOCKSYS:DI
	LD	A,1		;DISABLE ANY FURTHER RESTART OF SYSTEM
	LD	(LOCKED),A
LOCKS1:	JR	LOCKS1

;--------------------------------------------------------------------------
;	'OSC'	(FORMERLY 'CLOCK') - DETERMINE TIME CONSTANT FOR AN OSC
;--------------------------------------------------------------------------
;	USED AS A CLOCK FOR THE SIO CHANNEL

;	E.G.: OSC 1,33
;	      OSC 1,25 FOR SWITCH

CLOCK:	CALL	BYTARG
	LD	A,E
	CALL	CKOSCN		;CHECK RANGE
	PUSH	DE
	CALL	EATCOM

	CALL	BYTARG		;GET CONSTANT
	LD	A,D
	OR	A
	JP	NZ,E3		;ALLOWED ONLY IN 0-255 RANGE
	POP	BC		;PUSHED AS DE - OSCILLATOR #
	LD	A,7		;NO INT - PRESC = 16
	CALL	WRIOSC
	OR	A
	JP	NZ,NOTOP
	LD	A,E		;TIME CONST
	CALL	WRIOSC

	CALL	GC		;CHECK "FOR" CLAUSE
	CP	FORRW
	RET	NZ

	PUSH	BC		;OSC #
	CALL	GCI		;EAT "FOR"
	LD	B,SWITCHRW
	CALL	EATC		;EAT "SWITCH"
	POP	BC

	LD	A,E		;STORE TIME CONSTANT FOR USER'S QUERIES
	LD	(MMTK),A

	DI
	LD	A,0A1H		;ENA INT - TIMER - PRESC=256 - AUTO - NO K
	CALL	WRIOSC		;CONTINUE - CONTROL WORD
	CALL	INIMMT		;INIT MMT
	EI
	RET

;--------------------------------------------------------------------------
;	'xxx:'	SELECT PHISICAL DEVICE FOR A LOGICAL DEVICE
;--------------------------------------------------------------------------
CON:	LD	HL,OBYTE
	JR	XXX2

AUX:	LD	HL,AUXOBYTE
	JR	XXX2

LSTDEV:	LD	HL,LOBYTE
	JR	XXX1

ERRDEV:	LD	HL,ERRBYTE
	JR	XXX1

CLK:	LD	HL,CLKBYTE	;TIMDAT: STATEMENT
;	JR	XXX1

XXX1:	PUSH	HL
	LD	B,':'
	CALL	EATC
	JR	XXX1B

;	FIRST CASE: FOR AN I/O DEVICE DETERMINE ADDRESS OF I/O BYTE

XXX2:	PUSH	HL
	LD	B,':'
	CALL	EATC
	CALL	BYTARG
	LD	A,E
	PUSH	AF		;ACC=0=OUT =1 INPUT
	OR	A
	JR	Z,XXX2B
	CP	1
	JR	Z,XXX2B
	JP	E3		;ARGUMENT ERROR

XXX2B:	POP	AF		;INP OR OUT
	POP	HL		;GET I/O BYTE BASE ADDRESS
	LD	B,0
	LD	C,A
	ADD	HL,BC		;I/O BYTE EFFECTIVE ADDRESS
	PUSH	HL

;	EVERYBODY COMES HERE: HL HAS ADDRESS OF I/O BYTE

XXX1B:	CALL	EATISCH		;EAT "IS CH"
	CALL	BYTARG		;GET CHANNEL #
	LD	A,E
	CALL	TESTOPEN	;CHANNEL MUST BE OPEN
	JP	Z,NOTOP
	POP	HL		;GET I/O BYTE ADDRESS
	LD	(HL),E		;AND SAVE VALUE

;	MODIF. 1/1/92 - TIMDAT IS CH.. NOW AUTOMATICALLY DO A CLOCK
;	FREQUENCY MEASUREMENT - DRIVER MUST SUPPORT READ CALL FROM
;	RECORD #3 AND RETURN THE RESULT DIVIDED BY 100000 IN HL

;	IF DRIVER CANNOT DO MEASURE, IT SHOULD RETURN HL=0

	LD	A,.HIGH.CLKBYTE	;TIMDAT STATEMENT EXECUTED?
	CP	H
	RET	NZ

	LD	A,.LOW.CLKBYTE
	CP	L
	RET	NZ

;	MEASURE CLOCK FREQ. - CALL CCAL DRIVER AND READ REC.#3

	LD	C,E		;C  - CHANNEL CODE
	LD	B,1		;B  - OPERATION CODE 1 (FOR READ)
	LD	DE,3		;READ FROM RECORD #3
	CALL	DRIVER		;DOES WHAT DRIVER WANTS

	OR	A		;CHECK FOR ANY ERROR
	JP	NZ,DRVERR

	LD	A,L		;STORE THE RESULT
	LD	(FREQ),A
	RET

EATISCH:LD	B,ISRW
	CALL	EATC
	LD	B,CHRW
	CALL	EATC
	RET

;--------------------------------------------------------------------------
;	'DATA' AND 'REM'
;--------------------------------------------------------------------------
;
DATAX:	CALL DIRT	;DATA STATEMENT ILLEGAL AS DIRECT
REM:	CALL	GCI
	CP	CR
	JP	NZ,REM
	DEC	HL	;BACKUP POINTER SO NORMAL JOE WILL WORK
	LD	(TXA),HL
	RET



;
;--------------------------------------------------------------------------
;	'DIMENSION'
;--------------------------------------------------------------------------
;
DIM:
	XOR	A
	LD	(STRFLG),A
	CALL	NAME		;LOOK FOR VARIABLE NAME
	JP	C,E1
	LD	A,C		;PREPARE TURN ON 200Q BIT TO SIGNIFY MATRIX
	OR	200Q
	LD	C,A
	CALL	GCI
	CP	'$'
	JP	NZ,NOSTR

	CALL	GCI		;STRING DIMENSION
	SET	7,B		;IF STR SET MSB OF ALPHA PART
	CALL	STLK
	LD	A,1		;SET LATER TO HAVE NO ERR FROM STLK
	LD	(STRFLG),A
	JR	DIMSTR

NOSTR:	CALL	STLK
DIMSTR:	JP	NC,E6		;ERROR IF NAME ALREADY EXISTS
	LD	A,(STRFLG)	;PRESERVE FLAG FOR DIMS
	PUSH	AF
	PUSH	HL		;SYMBOL TABLE ADDR
DIM1:	CALL	EXPRB
	LD	B,')'
	CALL	EATC
	CALL	PFIX		;RETURN INTEGER IN DE
	LD	HL,MATUB	;MAX SIZE FOR MATRIX
	CALL	DCMP
	JP	NC,E6
	POP	HL		;SYMBOL TABLE ADDR
	POP	AF
	LD	(STRFLG),A
	CALL	DIMS
	CALL	GC		;SEE IF MORE TO DO
	CP	','
	RET	NZ
	CALL	GCI		;EAT THE COMMA
	JP	DIM
;
;--------------------------------------------------------------------------
;	DOG	- ACTIVATE WATCHDOG
;--------------------------------------------------------------------------
;

;
;--------------------------------------------------------------------------
;       'DO' - DOPPIO USO
;--------------------------------------------------------------------------
;	DO senza argomenti memorizza la locazione fisica della
;	   frase successiva per essere usata  con LOOP
;	DO con una espressione fast la valuta senza fare altro
DO:	IF	FASTF
	CALL	GC
	CP	CR
	JR	NZ,EVALF
	LD	HL,(TXA)
	LD	(DOADR),HL
	RET

EVALF:	CALL	EXPRB
	LD	HL,(ASTKA)	;ADDR OF BOOLEAN VALUE ON ARG STACK
	INC	(HL)		;SETS ZERO CONDITION IF RELATIONAL WAS TRUE
	CALL	POPAS		;REMOVE VALUE FROM ARG STACK COPY TO SELF
	ENDIF
	RET

;--------------------------------------------------------------------------
;       LOOP - valuta una espressione - se � vera ritorna alla precedente
;--------------------------------------------------------------------------
;	frase DO - n.b. e' pensata per la velocit� - non fa controlli
;
WHILE:	IF	FASTF
	CALL    EXPRB
	LD	A,(FASTFLG)
	OR	A
	JP	Z,E1

	LD	HL,FTEMP	;per non lasciare lo stack sporco
	CALL	POPAS

	LD	HL,(FSP)
	LD	A,(HL)		;OLD RESULT
	INC	HL
	OR	(HL)
	RET	Z		;risultato 0 - esci

	LD	HL,(DOADR)	;torna alla DO precedente
	LD	A,H
	OR	L
	JP	Z,E4AM		;nessun DO in precedenza
	LD	(TXA),HL
	ENDIF
	RET





;--------------------------------------------------------------------------
;	'BREAK' - ENABLE / DISABLE KEYBOARD BREAK
;--------------------------------------------------------------------------

KEYBRK:	CALL	BYTARG
	LD	A,E
	OR	A
	JP	M,E3
	CP	2
	JP	NC,E3
	LD	(BRKENA),A
	RET


;--------------------------------------------------------------------------
;	'NOVRAM' - SET DELAY FOR NOVRAM WRITE (0=NO DELAY 255=MAX DELAY)
;--------------------------------------------------------------------------

NOVDLY:	CALL	BYTARG
	LD	A,E
	OR	A
	JP	M,E3
	CP	255
	JP	NC,E3
	LD	(RITARDO1),A
	RET


;--------------------------------------------------------------------------
;	EIDI - EI/DI 'INTERRUPT'
;--------------------------------------------------------------------------

EIDI:	CALL	GC
	CALL	BYTARG
	LD	A,E
	OR	A
	JP	M,E3
	CP	6
	JP	NC,E3
	JR	NZ,EIDI1
	LD	A,1			;'INTERRUPT 3' ENABLES HW INT
	EI
EIDI1:	CP	4			;AGGIUNTA 15/3/97
	JR	NZ,EIDI2		;4=DISABILITA INT HW
	DI
	RET
EIDI2:	CP	5			;AGGIUNTA 15/3/97
	JR	NZ,EIDI3		;5=DISABILITA INT HW
	EI
	RET
EIDI3:	LD	(INT_ENA),A
	RET

;--------------------------------------------------------------------------
;	'END'
;--------------------------------------------------------------------------
;
CEND	EQU	CMND1


;
;--------------------------------------------------------------------------
;	'FOR' + 'NEXT'
;--------------------------------------------------------------------------

SFOR:	LD	A,1
	LD	(PRIVIL),A	;FOR IS PRIVILEGED
				;NO INTERRUPT CAN BE ACCEPTED FOLLOWING IT

NFOR:	CALL	DIRT
	CALL	VARX	;CONTROL VARIABLE
	JP	C,E1
	PUSH	HL	;CONTROL VARIABLE VALUE ADDRESS
	LD	B,EQRW
	CALL	EATC
	CALL	EXPRB	;INITIAL VALUE
	POP	DE	;VARIABLE VALUE ADDRESS
	PUSH	DE	;SAVE
	CALL	POPA1	;SET INITIAL VALUE
	LD	B,TORW	;RW FOR 'TO'
	CALL	EATC
	CALL	EXPRB	;LIMIT VALUE COMPUTATION
	CALL	GC	;CHECK NEXT CHARACTER FOR POSSIBLE STEP EXPRESSION
	CP	STEPRW
	JP	Z,FOR1
;
;	USE STEP OF 1
;
	LD	DE,FPONE
	CALL	PSHA1
	JP	FOR2
;
;	COMPUTE STEP VALUE
;
FOR1:	CALL	GCI		;EAT THE STEP RW
	CALL	EXPRB		;THE STEP VALUE
;
;	HERE THE STEP AND LIMIT ARE ON ARG STACK
;
FOR2:	LD	DE,-2		;PREPARE TO ALLOCATE 2 BYTES ON CONTROL STACK
	CALL	PSHCS		;RETURNS ADDRESS OF THOSE 2 BYTES IN HL
	EX	DE,HL
	CALL	JOE		;TEST FOR JUNK ON END
	JP	C,E4		;NO 'FOR' STATEMENT AT END OF PROGRAM
	EX	DE,HL		;DE HAS LOOP TEXT ADDR, HL HAS CONTROL STACK ADDR
	LD	(HL),D		;HIGH ORDER TEXT ADDRESS BYTE
	DEC	HL
	LD	(HL),E		;LOW ORDER TEXT ADDRESS BYTE
	LD	DE,-FPSIZ	;ALLOCATE SPACE FOR LIMIT ON CONTROL STACK
	CALL	PSHCS
	PUSH	HL		;ADDR ON CONTROL STACK FOR LIMIT
	LD	DE,-FPSIZ	;ALLOCATE SPACE FOR STEP ON CONTROL STACK
	CALL	PSHCS
	CALL	POPAS		;COPY STEP VALUE TO CONTROL STACK
	POP	DE		;CONTROL STACK ADDR FOR LIMIT VALUE
	CALL	POPA1		;LIMIT VALUE TO CONTROL STACK
	LD	DE,-3		;ALLOCATE SPACE FOR TEXT ADDR AND CS ENTRY
	CALL	PSHCS
	POP	DE		;CONTROL VARIABLE ADDR
	LD	(HL),D		;HIGH ORDER BYTE OF CONTROL VARIABLE ADDR
	DEC	HL
	LD	(HL),E		;LOW ORDER BYTE OF CONTROL VARIABLE ADDR
	DEC	HL
	LD	(HL),FTYPE	;SET CONTROL STACK ENTRY TYPE FOR 'FOR'
	JP	NEXT5		;GO FINISH OFF CAREFULLY
;
;	NEXT
;
NEXT:	CALL	DIRT
	LD	HL,(CSTKA)	;CONTROL STACK ADDR
	LD	A,(HL)		;STACK ENTRY TYPE BYTE
	DEC	A		;MUST BE FOR TYPE ELSE ERROR
	JP	NZ,E4A		;IMPROPER NESTING ERROR
	INC	HL		;CONTROL STACK POINTER TO CONTROL VARIABLE ADDR
	PUSH	HL
	CALL	VARX		;CHECK VARIABLE, IN CASE USER WANTS
	JP	C,NEXT1		;SKIP CHECK IF VAR NOT THERE
	EX	DE,HL
	POP	HL		;CONTROL VARIABLE ADDRESS
	PUSH	HL		;SAVE IT AGAIN
	CALL	DCMP
	JP	NZ,E4B		;IMPROPER NESTING IF NOT THE SAME
NEXT1:	POP	HL		;CONTROL VARIABLE ADDR
	PUSH	HL
	PUSH	HL
	LD	DE,FPSIZ+2-1 	;COMPUTE ADDR TO STEP VALUE
	ADD	HL,DE
	EX	(SP),HL		;NOW ADDR TO VAR IN HL
	CALL	LHLI		;VARIABLE ADDR
	LD	B,H		;COPY VAR ADDR TO BC
	LD	C,L
	POP	DE		;STEP VALUE ADDR
	PUSH	DE
	CALL	FADD		;DO INCREMENT
	POP	HL		;STEP VALUE
	DEC	HL		;POINT TO SIGN OF STEP VALUE
	LD	A,(HL)		;SIGN 0=POS, 1=NEG
	LD	DE,FPSIZ+1
	ADD	HL,DE		;PUTS LIMIT ADDR IN HL
	EX	DE,HL
	POP	HL		;VARIABLE ADDR
	CALL	LHLI		;GET ADDR
	PUSH	DE		;SAVE CONTROL STACK POINTER TO GET TEXT ADDR
	OR	A		;SET CONDITIONS BASED ON SIGN OF STEP VALUE
	JP	Z,NEXT2		;REVERSE TEST ON NEGATIVE STEP VALUE
	EX	DE,HL
NEXT2:	LD	B,H		;SET UP ARGS FOR COMPARE
	LD	C,L
	CALL	RELOP		;TEST <=
	POP	DE		;TEXT ADDR
	JP	M,NEXT3		;STILL SMALLER?
	JP	Z,NEXT3		;JUMP IF WANT TO CONTINUE LOOP
;
;	TERMINATE LOOP
;
	LD	HL,3		;REMOVE CSTACK ENTRY
	ADD	HL,DE
	LD	(CSTKA),HL
	RET
;
NEXT3:	INC	DE		;TEXT ADDR
	EX	DE,HL
	CALL	LHLI		;GET TEXT ADDR IN HL

;
;	ITERATE, SKIPPING NORMAL JUNK ON END TEST AT ILOOP
;
NEXT4:	EX	DE,HL		;SAVE NEW TEXT ADDR IN DE
	CALL	JOE
	EX	DE,HL
NEXT6:	LD	(TXA),HL
	LD	(RETADD),HL
NEXT5:	LD	HL,ILOOP
	EX	(SP),HL
	RET			;TO DISPATCHER SKIPPING JOE CALL THERE


;--------------------------------------------------------------------------
;	'GOSUB'
;--------------------------------------------------------------------------

GOSUB:	CALL	DIRT		;DIRECT MODE NOT ALLOWED
	LD	DE,-3		;CREATE CONTROL STACK ENTRY
	CALL	PSHCS
	PUSH	HL		;SAVE STACK ADDRESS

	LD	A,(INTGSUB)	;TEST IF THIS GOSUB IS ISSUED BY
	OR	A		;AN EXTERNAL INTERRUPT
	JP	Z,NOINT		;EXECUTE INTERRUPT

;	INTERRUPT ISR CALL - GET NUMBER FROM INTLINE

	LD	HL,(INTLINE)	;LOAD LINE NUMBER TO EXECUTE
	EX	DE,HL
	LD	HL,(RETADD)	;PRESET RETURN ADDRESS
	XOR	A
	LD	(INTGSUB),A
	JR	ANYGSB

;	PROGRAMM SUB CALL - GET NUMBER FROM TEXT

NOINT:	PUSH	DE
	CALL	INTGER
	PUSH	HL

	CALL	GC
	CP	LPARRW
	JR	NZ,NOPROC

MOREARGS:
	CALL	EXPRB
	CALL	GC
	CP	','
	JR	NZ,EATPAR
	CALL	EATCOM
	JR	MOREARGS

EATPAR:	LD	B,')'
	CALL	EATC

NOPROC:	POP	HL
	POP	DE
	EX	DE,HL		;LINE NUMBER TO DE

	LD	A,(REMFLG)	;DISCARD REAMINDER OF LINE AS REMARKS?
	OR	A		;(USATO PER ON..GOSUB)
	JR	Z,NOSKIP
	CALL	REM
	XOR	A
	LD	(REMFLG),A
NOSKIP:	CALL	JOE		;GET RETURN ADDRESS FROM NEW LINE TO HL

;	COMMON PART OF GOSUB

ANYGSB:	LD	B,H
	LD	C,L
	POP	HL		;STACK ADDR
	LD	(HL),B		;STACK RETURN ADDR RETURNED BY JOE
	DEC	HL
	LD	(HL),C
	DEC	HL
	LD	(HL),GTYPE	;MAKE CONTROL STACK ENTRY TYPE 'GOSUB'
	CALL	FINDLN
	INC	HL
	INC	HL
	INC	HL
	JP	NEXT6

;--------------------------------------------------------------------------
;	'GOTO'
;--------------------------------------------------------------------------
;
SGOTO:  XOR     A
	LD	(DIRF),A	;CLEAR DIRECT STATEMENT FLAG
GOTO3:	CALL	INTGER
	PUSH	HL
	CALL	REM
	POP	HL
GOTO1:	EX	DE,HL		;LINE IN DE
	CALL	FINDLN		;RETURNS TEXT ADDR POINTS TO COUNT VALUE
GOTO2:	INC	HL
	INC	HL
	INC	HL		;ADVANCE TEXT POINTER PAST LINE NUMBER AND COUNT
	JP	NEXT4


;--------------------------------------------------------------------------
;	'IF'
;--------------------------------------------------------------------------
;
SIF:	LD	B,1	;SPECIFY PRINCIPAL OPERATOR IS RELATIONAL
	CALL	EXPB1

	IF	FASTF
	LD	A,(FASTFLG)
	OR	A
	JP	Z,NOFASTIF
	LD	HL,(FSP)
	LD	A,(HL)		;OLD RESULT
	INC	HL
	OR	(HL)
	PUSH	AF
	CALL	POPAS
	POP	AF
	JR	Z,NOTRUE	;ERA REM
	JP	SIF1B
NOFASTIF:
	ENDIF

	CALL	EFFLEN
	JP	NZ,ALFIF
	LD	HL,(ASTKA)	;ADDR OF BOOLEAN VALUE ON ARG STACK
	INC	(HL)		;SETS ZERO CONDITION IF RELATIONAL WAS TRUE
	PUSH	AF		;SAVE CONDITIONS TO TEST LATER
	CALL	POPAS		;REMOVE VALUE FROM ARG STACK COPY TO SELF
	POP	AF
SIF1:	JP	NZ,NOTRUE	;ERA REM - IF TEST FALSE TREAT REST OF STATEMENT AS REM
;
;	TEST SUCCEEDED
;
SIF1B:
	LD	B,THENRW
	CALL	EATC
	CALL	GC		;STRUCTURED IF?
	CP	CR
	JR	Z,STRUIF	;YES, JUMP

	CALL	INTGER		;CHECK IF LINE NUMBER IS DESIRED ACTION
	JP	C,ISTAT
	JP	GOTO1

STRUIF:	CALL	PUSHIGN		;SAVE IGNORE FLAG STATUS
	RET

NOTRUE:	LD	B,THENRW	;EAT 'THEN'
	CALL	EATC
	CALL	GC		;ANY FURTHER TEXT ON THIS LINE?
	CP	CR
	JP	NZ,REM		;IGNORE IT

;	NO MORE TEXT - THIS IF IS STRUCTURED

	CALL	PUSHIGN		;SAVE IGNORE FLAG STATUS

	LD	A,0FFH		;NO MORE TEXT - STRUCTURED IF
	LD	(IGNORE),A	;SET MODE TO 'IGNORE' (IGNORE ALL TEXT)
	RET

ALFIF:	PUSH	HL		;FIRST STRING ADDRESS
	PUSH	BC		;AND LENGHT
	CALL	GCI		;GET OPERATOR
	PUSH	AF
	CALL	EXPRB
	CALL	EFFLEN	;SECOND STRING
	JP	Z,E19	;IF NO STRING
	POP	AF	;REL OP IN B
	LD	B,A
	POP	DE	;LENGHT C1
	LD	A,E
	POP	DE	;FIRST STRING ADDRESS
			;IN HL THE SEC STRING ADDRESS;
	CALL	RELSTR
	JP	SIF1
;
;	RELSTR - IN ENTRY TO THIS ROUTINE WE HAVE
;
;		- FIRST STRING:
;			ADDRESS IN DE
;			EFF LENGHT IN ACC
;
;		- SECOND STRING:
;			ADDRESS IN HL
;			EFF LENGHT IN C
;
;		-RELATIONAL OPERATOR:
;			IN B
;
;	ON RETURN:
;
;		FLAG Z SET IF RELATION IS TRUE
;		FLAG Z RESET IF FALSE
;
RELSTR:
	PUSH	AF		;LEN STR 1 (C1)
	PUSH	BC		;LEN STR 2 (C2)
	LD	A,B

	CP	EQRW
	JP	Z,STREQ

	CP	NE_RW
	JP	Z,STRNEQ

	CP	LT_RW		;MINOR OPERATOR
	JP	Z,STMIN

	CP	GT_RW
	JP	Z,STMAJ

	JP	E19

;--------------------------------------------------------------------------
;	STRING COMPARE - NOT EQUAL
;--------------------------------------------------------------------------

STRNEQ:	POP	BC
	POP	AF
	CALL	STREQ2		;GO AS FOR EQUAL
	JR	NZ,REVE1	;IF NOT ZERO, JUMP AND  REVERSE RESULT TO ZERO
	INC	A		;IF ZERO REVERSE RESULT TO NONZERO
	RET

REVE1:	XOR	A
	RET

;--------------------------------------------------------------------------
;	STRING COMPARE - EQUAL
;--------------------------------------------------------------------------

STREQ:	POP	BC		;C2
	POP	AF		;C1

STREQ2:	CP	C
	JP	NZ,STFAL	;IF EFFECTIVE LENGHTS ARE DIFFERENT, NOT EQUAL
	INC	C
STREQ1:	DEC	C
	JP	Z,STTRU
	LD	A,(DE)
	CP	0
	JP	Z,STTRU
	CP	(HL)
	JP	NZ,STFAL
	INC	HL
	INC	DE
	JP	STREQ1
;
;--------------------------------------------------------------------------
;	STRING COMPARE - GREATER THAN
;--------------------------------------------------------------------------

STMAJ:	EX	DE,HL
	POP	AF
	POP	BC
	JP	STMINX

;--------------------------------------------------------------------------
;	STRING COMPARE - LESS THAN
;--------------------------------------------------------------------------

STMIN:	POP	BC
	POP	AF
STMINX:	LD	B,A	;B=C1  C=C2
STMIN1:	LD	A,(DE)
	CP	(HL)
	JP	C,STTRU	;JMP TO TRUE IF CHAR(ST1)<CHAR(ST2)
	EX	DE,HL
	LD	A,(DE)
	CP	(HL)
	JP	C,STFAL	;JMP TO FALSE IF CHAR(ST2)<CHAR(ST1)
	EX	DE,HL
	DEC	B	;IF FIRST STRING ENDS BEFORE
	JP	Z,STMIN2	;TEST THE SECOND ONE TOO
	DEC	C
	JP	Z,STFAL	;IF SECOND STRING ENDS BEFORE,
			;ST2 IS A SUBSTRING OF ST1 --> FALSE
	INC	HL
	INC	DE
	JP	STMIN1

STMIN2:	DEC	C	;IF FIRST STRING ENDS, TEST IF SECON TOO ENDS
	JP	Z,STFAL	;IF SO, NO TRUE WAS REVEALED --> FALSE
	JP	STTRU	;ELSE, ST1 IS A SUBSTRING OF ST2 --> TRUE
;
STTRU:	XOR	A
	RET
STFAL:	XOR	A
	INC	A
	RET

;--------------------------------------------------------------------------
;	'ELSE'
;--------------------------------------------------------------------------
;
ELSEX:	LD	A,(IGNORE)	;GET CURRENT STATUS
	LD	B,A		;AND SAVE IT

	CALL	POPIGN		;SEE PREVIOUS STATE
	CALL	PUSHIGN

	LD	A,(IGNORE)	;IF WE ARE INSIDE A NO-EXEC BLOCK
	OR	A
	RET	NZ		;DO NOTHING

	LD	A,B		;OTHERWISE COMPLEMEMT STATE
	CPL
	LD	(IGNORE),A
	RET

;--------------------------------------------------------------------------
;	'ENDIF'
;--------------------------------------------------------------------------
;
ENDIFX:
;	XOR	A		;EXIT 'IGNORE' MODE
;	LD	(IGNORE),A
	CALL	POPIGN
	RET

;--------------------------------------------------------------------------
;	'INPUT'
;--------------------------------------------------------------------------

INPUT:	LD	HL,(SAPOINT)	;PRESET THE EFFECTIVE POINTER
	LD	(SAPTMP),HL	;????

;	PRESET EVERY OPTION TO THE DEFAULT VALUE

	XOR	A
	LD	(NOMODIF),A	;MODIFY VARS ON NO INPUT
	LD	(PICTF),A	;NO PICTURED INPUT
	LD	(ECHOM),A	;ECHO MODE = NORMAL ECHO
	LD	(AUTOCR),A	;NO AUTOCR AT FIELD FILLED
	LD	(LOGDEVO),A	;PROMPT TO CON:
	LD	(LOGDEVI),A	;GET INPUT FROM CONSOLE
	LD	(PROMPTF),A	;NO PROMPT STRING MET UNTIL NOW

	LD	A,CR		;DEFAULT IS TO EXIT BY CR
	LD	(EXICHA),A

;	NOW SCAN THE LINE TO SET ANY REQUESTED OPTION

ISCANOPT:CALL	GC		;LOOK AT NEXT CHAR

	CP	NOCLRRW		;'NOCLEAR' OPTION?
	JR	Z,I_NOCLR

	CP	LDEVRW		;'LDEV' OPTION?
	JR	Z,I_LDEV

	CP	PICRW		;'PICTURE' OPTION?
	JR	Z,I_PICT

	CP	'"'		;USER-DEFINED PROMPT OPTION?
	JP	Z,I_UDP

	CP	CHRW		;'CH' OPTION?
	JP	Z,I_CH

	JP	DO_INP

;---------------------------------------------------------- NOCLEAR OPTION
;	DOES NOT CLEAR VARS ON AN EMTY INPUT
;--------------------------------------------------------------------------

I_NOCLR:LD	(NOMODIF),A
	CALL	GCI		;EAT 'NOCLEAR' RW
	CALL	EATCOM
	JR	ISCANOPT

;-------------------------------------------------------------- LDEV OPTION
;	REQUEST FOR INPUT FROM A DIFFERENT LOGIC DEVICE
;--------------------------------------------------------------------------

;	(FORMERLY CH OPTION)
;	NOTE! PROMPT GOES ALWAYS TO THE SCREEN

I_LDEV:	CALL	GCI
	CALL	BYTARG		;GET LDEV # (TESTED LATER BY LDEVIN)
	LD	A,E
	LD	(LOGDEVI),A	;SET LDEV TO REQUESTED LOGICAL DEVCE

;--------------------------------------------------------------------------
IREAD:	CALL	EATCOM
	JR	ISCANOPT

;----------------------------------------------------------- PICTURE OPTION
;	PICTURED INPUT
;--------------------------------------------------------------------------

I_PICT:	CALL	GCI		;GET THE PICTURE STRING
	CALL	EXPRB
	CALL	EFFLEN		;HL=ADDRESS, C=EFFECTIVE LENGHT
	JP	Z,E19		;NO STRING ERROR

PICTLOP:LD	A,(HL)		;SCAN PICT STRING AND SET RELATIVE OPTIONS

	CP	'*'
	JR	Z,CTL_ECHO	;MASKED ECHO

	CP	'!'
	JR	Z,CTL_ECHO	;NO ECHO

	CP	'>'
	JR	Z,CTL_AUTOCR	;AUTO CR ON END OF FIELD

	CP	'/'
	JR	Z,CTL_SETNBESC	;SET EXIT CHAR 'NON BREAK ESC'

	CP	'&'
	JR	Z,CTL_SETCNFRM	;SET EXIT CHAR 'CONFIRM'

	JR	IMASTR		;GET THE IMAGE STRING

CTL_X:	INC	HL		;AND EXCLUDE CONTROL CHARACTERS
	DEC	C		;OFF THE PICTURE STRING
	JR	PICTLOP

;	SET ECHO MODE

CTL_ECHO:
	LD	(ECHOM),A	;SET ECHO MODE
	JR	CTL_X

;	SET AUTOCR

CTL_AUTOCR:
	LD	(AUTOCR),A	;SET AUTOCR MODE ON FIELD FILLED
	JR	CTL_X

;	SET NON BREAK ESCAPE CHAR

CTL_SETNBESC:
	INC	HL		;AND EXCLUDE CONTROL CHARACTERS
	DEC	C		;OFF THE PICTURE STRING
	LD	A,(HL)		;GET NON BREAK ESCAPE CHAR
	LD	(NBESC),A
	JR	CTL_X

;	SET CONFIRM CHAR

CTL_SETCNFRM:
	INC	HL		;AND EXCLUDE CONTROL CHARACTERS
	DEC	C		;OFF THE PICTURE STRING
	LD	A,(HL)		;GET CONFIRM CHAR
	LD	(CONFIRM),A
	JR	CTL_X

;	GET IMAGE STRING

IMASTR:	LD	A,1
	LD	(PICTF),A	;FLAG PICTURED INPUT
	LD	A,C
	LD	(PICLEN),A	;SET COUNTER
	LD	(PICLEN0),A	;SET LENGHT
	LD	(PICSTG),HL	;SET ADDRESS OF CURRENT CHAR
	LD	(PICSTG0),HL	;SET ADDRESS OF THE STRING
	CALL	EATCOM
	JP	ISCANOPT

;------------------------------------------------------	REDIRECTION OPTION
;	INPUT DIRECTLY FROM A SPECIFIED CHARACTER DRIVER
;--------------------------------------------------------------------------

;	AUX: DEV IS USED TEMPORARY

I_CH:	CALL	GCI
	CALL	BYTARG		;GET DRIVER #
	LD	A,(AUXIBYTE)	;USE AUX: - SAVE CURRENT VALUE
	LD	(AUXITEMP),A
	LD	A,E		;SET AUX: TO REQUESTED FILE #
	LD	(AUXIBYTE),A
	LD	A,7		;AND SELECT AUX: AS LOGICAL DEVICE
	LD	(LOGDEVI),A
	CALL	EATCOM
	JP	ISCANOPT


;------------------------------------------------------	USER DEFINED PROMPT
;
;--------------------------------------------------------------------------

I_UDP:	LD	(PROMPTF),A	;SET PROMPT FLAG
	CALL	GCI
	CALL	PRNT		;OUTPUT PROMPT
	INC	HL		;UPDATE TXA
	LD	(TXA),HL
	CALL	EATCOM
	JP	ISCANOPT

;--------------------------------------------------------------------------
;	OPTION REQUEST ACCEPTED - NOW DO REAL INPUT
;--------------------------------------------------------------------------

DO_INP:	LD	A,(LOGDEVI)	;INPUT FROM LDEV 4? ("ON-THE-FLY")
	CP	4		;SINGLE CHAR/NO CR DIRECT INPUT?
	JP	Z,ILDEV4	;YES, JUMP

	OR	A		;LDEV = CON:?
	JP	NZ,LINP		;NO, SKIP PROMPT

	LD	A,(PROMPTF)	;USER DEFINED PROMPT?
	OR	A
	JR	NZ,LINP

	LD	B,'?'		;NO, OUT QUESTION MARK
	CALL	CHOUT

LINP:	CALL	INLINE		;GET THE LINE

;--------------------------------------------------------------------------
;	PROCESS 'NOCLEAR' OPTION
;--------------------------------------------------------------------------

	LD	A,(NOMODIF)	;THE 'NOCLEAR' OPTION WAS REQUESTED?
	OR	A
	JR	Z,PROIBUF	;NO, GO TO PROCESS INPUT BUFFER

I_NOMOD:LD	A,C		;DID THE USER TYPE ANYTHING?
	CP	LINLEN
	JR	NZ,PROIBUF	;YES, GO TO PROCESS INPUT BUFFER

;	NOCLEAR OPTION AND NO INPUT - LOOK AT NEXT CHAR

NOCLIN:	CALL	GC		;LOOK AT NEXT CHAR

	CP	','		;COMMA? - OTHER VARIABLES ARE TO BE INPUTTED
	JR	Z,IN5_1

	CP	CR		;CR? - AT THE END OF THE 'INPUT' STATEMENT
	JP	Z,INDONE	;YES, 'INPUT' IS DONE

	CALL	GCI		;EAT ANY OTHER CHAR
	JR	NOCLIN		;AND LOOP UNTIL COMMA OR CR

;--------------------------------------------------------------------------
;	DATA INPUTTED - PROCESS BUFFER
;--------------------------------------------------------------------------

PROIBUF:LD	DE,IBUF

I_LOP:	PUSH	DE		;SAVE FOR FPIN
	CALL	VARX		;FIND THE ADDRESS OF THE VAR IN 'INPUT' STATM.
	JP	C,E1

	POP	DE		;DE POINTS TO IBUF

	PUSH	BC		;VEDI "NOTA 1" ALLA FINE
	PUSH	HL

	CALL	TSTST		;STRING INPUT?
	JP	NZ,STRINP	;YES, JUMP

;	NUMERIC INPUT

;	(VEDERE SE IN CERTI CASI PUO' ESSERE CONVENIENTE
;	SKIPPARE UN PO' DI CONTROLLI, AD ESEMPIO PER FILES O DRIVERS)

	POP	HL
	POP	BC

	LD	B,0
	LD	A,(DE)		;GET CHAR

	CP	'+'		;LEADING PLUS?
	JP	Z,I_PLUS	;YES, JUMP

	CP	'-'		;LEADING MINUS?
	JP	NZ,IN3		;NO, JUMP
	LD	B,1		;YES, B=1
I_PLUS:	INC	DE		;PLUS OR MINUS, SKIP IT

IN3:	PUSH	BC
	PUSH	HL

	CALL	INSZERO		;INSERT AT LEAST A ZERO IN THE BUFFER

	LD	A,(LOGDEVI)	;IF LDEV=6 THEN PRE-PROCESS IBUF
	CP	6		;TO STRIP OUT NON-NUMERIC CHARS
	CALL	Z,PREIBUF

	CALL	JUSTDPS		;PREVENT ERRORS FOR JUST DP'S ENTRY

	CALL	FPIN		;AT LAST! INPUT FP NUMBER
	JP	C,INERR

	POP	HL
	DEC	HL
	POP	AF
	LD	(HL),A

IN5:	CALL	GC		;MORE VARS TO INPUT?
	CP	','
	JP	NZ,INDONE	;NO, DONE

;	ANOTHER VAR(S) HAS TO BE PROCESSED - LOOK IF ITS VALUE IS ALREADY
;	IN THE INPUT BUFFER

IN5_1:	CALL	GCI		;EAT THE COMMA FROM TEXT

	LD	A,B		;GET THE TERMINATOR FROM THE BUFFER
	CP	','
	JP	Z,I_LOP		;MORE VALUES ENETERED - LOOP TO PROCESS THEM

;	INPUT DATA ARE NOT SUFFICENT

	LD	B,'?'		;ASK FOR MORE INPUT
	CALL	CHOUT
	JP	DO_INP

;--------------------------------------------------------------------------
;	END OF 'INPUT' STATEMENT - EXIT
;--------------------------------------------------------------------------

INDONE:	XOR	A
	LD	(PICTF),A
	LD	(LOGDEVI),A

	LD	A,(AUXITEMP)	;AUX: MODIFIED FOR REDIRECTION?
	CP	0FFH
	RET	Z		;NO, RET

	LD	(AUXIBYTE),A
	LD	A,0FFH
	LD	(AUXITEMP),A

	RET

NCRLF:	CALL	GCI
	JP	LINP		;NOW GET LINE

;--------------------------------------------------------------------------
;	INPUT A STRING
;--------------------------------------------------------------------------
STRINP:	EX	DE,HL		;CLEAR DEST. VAR (DE)
	CALL	CLRDEST
	EX	DE,HL
	INC	C

STRINP1:DEC	C		;DECREMENT LENGHT
	JR	Z,STRINP3	;RETURN IF DEST_ SPACE AT END

	LD	A,(DE)		;LOAD CHAR FROM IBUF

	LD	B,','

	CP	','		;COMMA? END OF FIELD
	JP	Z,STRINP4

	LD	B,CR

	CP	CR		;CR? STRING INPUT DONE
	JP	Z,STRINP3

	LD	B,'"'
	CP	'"'		;QUOTES? ILLEGAL INSIDE A STRING
	SCF
	JP	Z,STRINP3

	LD	(HL),A		;MOVE CHAR IN STRING SPACE
	INC	HL
	INC	DE
	JP	STRINP1		;AND CONTINUE READING MORE CHARS


STRINP4:INC	DE		;CORREZIONE NON BEN MEDITATA
				;DE DOVREBBE ESSERE IL PUNTATORE A IBUF

STRINP3:JP	C,INERR
	POP	HL
	POP	AF
	JP	IN5		;STEP TO NEXT VARIABLE TO READ IF ANY

;--------------------------------------------------------------------------
;	PROCESS 'INPUT LDEV 4'
;--------------------------------------------------------------------------

;	COME HERE TO PROCESS SINGLE CHAR DIR INPUT

ILDEV4:	LD	A,CR		;PRESET A'CR' IN IBUF ('NO CHAR INPUTTED')
	LD	(IBUF),A
	CALL	CONSTAT		;TEST IF ANY CHAR IN THE BUFFER
	OR	A
	JP	Z,PROIBUF	;NO CHAR - EXIT DIRECTLY

TESTZ:	CALL	CONIN		;A CHAR IS PRESENT - READ IT

	CP	'"'		;YOU CANNOT GET DOUBLE QUOTES THIS WAY
	JP	Z,PROIBUF

	OR	A		;NEITHER NULL
	JP	Z,PROIBUF

	LD	B,A		;SAVE CHAR

	LD	A,(ECHOM)	;SEE WHICH TYPE OF ECHO
	OR	A		;MODE 0, DO NORMAL ECHO
	JR	Z,CH4ECHO

	CP	'!'		;MODE '!' - DO NOT ECHO
	JR	Z,CH4_NOE

	CP	'*'		;MODE '*' - ECHO AN ASTERISK
	JP	NZ,E19		;UNKNOWN MODE - STRING ERROR

	PUSH	BC		;ECHO ASTERISK
	LD	B,'*'
	CALL	CHOUT
	POP	BC
	JR	CH4_NOE

CH4ECHO:CALL	CHOUT		;ERA LD	A,B E CALL  CONOUT

CH4_NOE:LD	A,(BRKENA)	;IS BREAK ENABLED?
	OR	A
	LD	A,B		;GET CHAR AGAIN
	JR	Z,NO_BRK	;NO, JUMP

	CP	ESC		;ESC - STOP RUNNING
	JP	Z,BREAK

NO_BRK:	CP	CR		;SOBSTITUTE CR
	JR	NZ,NO_CR	;WITH A PRINTABLE ASCII CHAR
	LD	A,'\'

NO_CR:	LD	(IBUF),A	;STORE CHAR TO BUFFER
	LD	A,CR
	LD	(IBUF+1),A	;AND APPEND THE FINAL CR
	JP	PROIBUF

;--------------------------------------------------------------------------
;	ROUTINES USED BY 'INPUT'
;--------------------------------------------------------------------------

;--------------------------------------------------------------------------
;	JUSTDPS
;--------------------------------------------------------------------------

;	CHECKS FOR AN ENTRY WITH ONLY DECIMAL POINT(S)
;	IF SO, ENTRY A 0 AND CR

JUSTDPS:PUSH	BC
	PUSH	DE
	LD	DE,IBUF
	LD	C,0
JDPS1:	LD	A,(DE)
	CP	'.'		;WHEN A DP IS FOUND
	JR	NZ,JDPS2
	SET	7,C		;SET BIT 7 OF C REG
	INC	DE
	JR	JDPS1
JDPS2:	CP	CR
	JR	Z,JDPS9
	SET	6,C		;ANY OTHER CHAR, SET BIT 6,C
	INC	DE
	JR	JDPS1
JDPS9:	BIT	7,C
	JR	Z,JDPS10	;NO DP'S - SIMPLY EXIT
	BIT	6,C
	JR	NZ,JDPS10	;DP'S + CHARS - SIMPLY EXIT
	CALL	INSZERO		;DP'S AND NO CHAR - INSERT A ZERO
JDPS10:	POP	DE
	POP	BC
	RET

;--------------------------------------------------------------------------
;	INSZERO - INSERT A '0' IN THE BUFFER IF IT IS EMPTY
;--------------------------------------------------------------------------
;	IF (DE) POINTS TO A CR, THEN SET A '0','CR' INTO IBUF
;	ELSE RETURN
:
INSZERO:LD	A,(DE)		;SET AT LEAST A "0" IN IBUF
	CP	CR
	RET	NZ
	PUSH	AF		;IF NO INPUT SET ENTRY TO 0
	PUSH	HL
	LD	HL,IBUF
	LD	A,'0'
	LD	(HL),A
	LD	A,CR
	INC	HL
	LD	(HL),A
	POP	HL
	POP	AF
	RET

;--------------------------------------------------------------------------
;	PREIBUF - PREPROCESS INPUT BUFFER
;--------------------------------------------------------------------------
;	NEW BUFFER CONTENT = OLD CONTENT WITHOUT NON-NUMERIC CHARACTERS
;	UP TO CR OR '.'

PREIBUF:PUSH	DE
PREIB1:	LD	A,(DE)
	CP	CR		;END OF BUFFER
	JR	Z,PREIB2
	CP	'.'
	JR	Z,PREIB2
	CP	'9'+1		;NC=  >"9"
	JR	NC,STRIP
	CP	'0'		;C =  <"0"
	JR	C,STRIP
	INC	DE
	JR	PREIB1
PREIB2:	POP	DE
	CALL	INSZERO
	RET

;	STRIP CHARACTER CURRENTLY POINTED BY DE OUT OF BUFFER
;	UNTIL CR IS FOUND

STRIP:	PUSH	HL		;SAVE HL
	PUSH	DE		;SAVE DE
	PUSH	DE		;COPY DE->HL
	POP	HL
STRIP1:	INC	HL		;HL POINTS TO NEXT CHAR
	LD	A,(HL)
	LD	(DE),A		;SHIFT ALL CHARS DOWN
	CP	CR
	JR	Z,STRIPXIT	;END OF JOB
	INC	DE
	JR	STRIP1
STRIPXIT:
	POP	DE
	POP	HL
	JR	PREIB1
;

;--------------------------------------------------------------------------
;	NOTA 1 - SPOSTATA DA SOPRA PER CHIAREZZA DEL LISTATO
;--------------------------------------------------------------------------

;	MODIFICA ALLA MODIFICA - LA STRANA CONFIGURAZIONE DI PUSH E POP
;	CHE SEGUONO SERVONO PER OVVIARE AD UN PROBLEMA FIGLIO DELLA SOLU-
;	ZIONE AD UN PROBLEMA PRECEDENTE:

;	PROBLEMA 1 - LE ISTRUZIONI QUI POCO SOTTO SERVONO PER SKIPPARE
;	IL SEGNO PIU' O MENO INIZIALE NEGLI INPUT NUMERICI (SETTANDO
;	B A SECONDA DEL + O DEL -). QUESTO NON DEVE AVVENIRE PER LE STRINGHE.

;	ERA STATO AGGIUNTO UN LD DE,IBUF ALL'INIZIO DI STRINP MA..

;	PROBLEMA 2 - IN CASO DI INPUT DI DUE STRINGHE CONSECUTIVE (CON
;	LA MEDESIMA INPUT) SI AVEVA IL RESTORE DEL PUNTATORE AD IBUF (DE)
;	E QUINDI TUTTE LE VARIABILI DELLA LISTA PRENDEVANO IL PRIMO
;	VALORE

;	LA SOLUZIONE (IN PROVA) E' QUELLA DI ANTICIPARE IL TEST DI STRINGA
;	IN MODO DA SALTARE L'EVENTUALE SKIP DEL SEGNO. I PUSH/POP CERCANO
;	DI NON INTRODURRE ALTERAZIONI NELLA INTRICATA ARCHITETTURA PRE
;	ESISTENTE

;--------------------------------------------------------------------------
;	'NOT IMPLEMENTED STATEMENT'
;--------------------------------------------------------------------------

N:	JP	E1

;--------------------------------------------------------------------------
;	'LET'
;--------------------------------------------------------------------------
;
LET:	CALL	GC
	CP	MPY_RW
	JR	NZ,LET0

;	indirezione - per velocit� non si testa se e' stringa o meno
	CALL	GCI
	CALL	VARX	;indirizzo della var. in HL
	JP	C,E1
	CALL	PSHAS	;ficca la var. nello stack
	CALL	PFIX	;prendila e convertila in intero
	EX	DE,HL	;passa il risultato in hl come VARX
	JR	LET01	;riprendi la via normale

LET0:	CALL	VARX	;CHECK FOR VARIABLE
	JP	C,E1
	CALL	TSTST	;CHECK FOR STRING
	JP	NZ,LET1
LET01:	PUSH	HL	;SAVE VALUE ADDRESS
	LD	B,EQRW
	CALL	EATC

	CALL	EXPRB

	CALL	TSTST	;CHECK FOR STRING
	JP	NZ,E19

	POP	DE	;DESTINATION ADDRESS
	CALL	POPA1	;COPY EXPRESSION VALUE TO VARIABLE
	RET

;	STRING ASSIGN

LET1:	PUSH	HL	;SAVE DEST_ ADDRESS
	PUSH	BC	;SAVE STLEN
	LD	B,EQRW
	CALL	EATC	;GOBBLE "="
	CALL	EXPRB
	CALL	EFFLEN	;ERA TSTST	;LOOK FOR TYPE MISMATCH ERRORS
	JP	Z,E19
	LD	A,C	;LEN OF EXPR (SOURCE) IN A
	POP	BC
	CP	C	;LEN OF VAR (DEST) IN C
	JP	Z,LET2
	JP	NC,E19	;IF DESTINATION IS SMALLER THEN SOURCE
LET2:
	POP	DE
;	PUSH	AF
;	CALL	CLRDEST
;	POP	AF
	LD	C,A	;USE SOURCE LENGHT FOR COPYSTR
	CALL	COPYSTR
	RET



;
;--------------------------------------------------------------------------
;	'LIST'
;--------------------------------------------------------------------------
;
CLIST:
	LD	A,19
	LD	(LSTCNT),A
	CALL	GC
	CP	CR
	LD	DE,0		;FIRST LINE TO LIST
	JP	Z,CL0		;JUMP IF NO ARGUMENT SUPPLIED
	CALL	INTGER		;ERROR DEFAULT IS LIST
	PUSH	DE
	CALL	GC
	CP	CR
	JP	NZ,LKLIMIT	;LOOK FOR LIMIT IN LIST
	POP	DE
CL0:	LD	HL,(BOFA)
CL1:	LD	A,(HL)
	DEC	A
	RET	Z		;IF =1 THEN RETURN
	INC	HL
	CALL	DCMP		;COMPARE DE AGAINST (HL)
				;TO SEE IF THIS IS THE FIRST LINE TO LIST OR NOT
	DEC	HL		;POINT TO COUNT CHAR AGAIN
	JP	C,CL2
	JP	Z,CL2
;
;	INCREMENT TO NEXT LINE
;
	LD	A,(HL)
	CALL	ADR		;HL=HL+A
	JP	CL1

CL2:	PUSH	DE		;START TO LIST - DE=LINE #
	LD	DE,IBUF		;AREA TO UNPREPROCESS TO
	CALL	UPPL		;UNPROCESS LINE STARTING AT HL TO IBUF
	INC	HL
	PUSH	HL		;HL POINTS AFTER CR NOW
	LD	HL,IBUF
	CALL	PRNTCR		;PRINT TO CR
	CALL	PCHECK
	CALL	CRLF
	POP	HL		;HL POINT AFTER CR
	POP	DE		;DE=LINE#
	PUSH	AF		;??? DEVO AVERLA MESSA IO PER PRUDENZA MA
				;NON SEMBRA UTILE
	LD	A,(LSTCNT)
	CP	255
	JP	Z,UNLIM
	DEC	A
	JP	Z,LSTEXT
	LD	(LSTCNT),A
UNLIM:	POP	AF
	JP	CL1		;JP TO CL1 TO INCLUDE END OF LIST TEST
LKLIMIT:
	LD	B,','
	CALL	EATC
	CALL	BYTARG
	LD	A,E
	LD	(LSTCNT),A
	POP	DE
	JP	CL0
LSTEXT:	POP	AF
	RET



;
;--------------------------------------------------------------------------
;	'LLIST'
;--------------------------------------------------------------------------
;
LLIST:	LD	A,2	;SWITCH OUTPUT TO LINE PRINTER
	LD	(LOGDEVO),A
	CALL	CRLF2
	CALL	CLIST	;CALL NORMAL LIST ROUTINE
	CALL	CRLF2
	XOR	A	;SWITCH OUTPUT BACK TO CONSOLE
	LD	(LOGDEVO),A
	RET




;
;--------------------------------------------------------------------------
;	'LOAD'
;--------------------------------------------------------------------------
;
CLOAD:	CALL	GC

	CP	TIMRW		;TIMER
	JP	Z,LDTIMER

	CP	ABSRW		;LOAD ABS
	JP	Z,NEWLDE

	CP	HEX@RW		;LOAD HEX PROGRAM
	JP	Z,DOWNLD

	JP	E1		;SYNT ERR

LDTIMER:
	CALL	GCI
	CALL	BYTARG		;TIMER # IN DE
	LD	A,E
	CALL	CK1_3		;RANGE 1-3

	LD	C,E		;TIMER # IN C
	PUSH	BC

	LD	B,WITHRW	;WITH
	CALL	EATC

	CALL	BYTARG		;BASIC TIME CONST IN E

	POP	BC		;GET AGAIN TIMER #
	PUSH	BC

	DI			;PREVENTS TO STORE ERRONEUS VALUE
				;DURING POW DEFAULT ?????

	LD	A,0A7H		;CONTROL WORD FOR CTC
	CALL	WRITIM		;WRITE
	OR	A
	JP	NZ,PDERR	;UNOPENED?
	XOR	A		;USE ALWAYS LONGEST TIME CONSTANT
				;FOR ALL TIMERS
	CALL	WRITIM		;USELESS TO CHECK ERROR AGAIN

	POP	BC		;C=INT# - NOW STORE BACKUP VALUES TO RAM
	PUSH	BC

	PUSH	HL
	LD	B,0
	LD	HL,TIMER1B-1	;MINIMUM VALUE FOR TIMERS IDENT_ IS 1
	ADD	HL,BC
	LD	A,0A7H
	LD	(HL),A
	POP	HL
	EI

	POP	BC
	LD	A,C
	CP	2

;	NOTA $$$$$$$ SPRECO DI MEMORIA $$$$$$$$$$$


	JR	Z,LDTM2
	CP	3
	JR	Z,LDTM3

	LD	A,E
	LD	(TIM1BU),A	;STORE TO BASIC USER VALUE
	LD	(TIM1B),A	;STORE TO BASIC COUNTER
	LD	A,(TIMKA)	;LOAD PRESCALER
	LD	(TIM1),A
	XOR	A		;CLEAR FREERUN FLAG
	LD	(TIM1FR),A
	CALL	GC
	CP	CR
	RET	Z
	LD	B,FRERW		;'FREERUN'?
	CALL	EATC
	LD	A,1		;SET FLAG
	LD	(TIM1FR),A
	RET

LDTM2:	LD	A,E
	LD	(TIM2BU),A	;STORE TO BASIC USER VALUE
	LD	(TIM2B),A	;STORE TO BASIC COUNTER
	LD	A,(TIMKA)	;LOAD PRESCALER
	LD	(TIM2),A
	XOR	A		;CLEAR FREERUN FLAG
	LD	(TIM2FR),A
	CALL	GC
	CP	CR
	RET	Z
	LD	B,4		;'FREERUN'?
	CALL	EATC
	LD	A,1		;SET FLAG
	LD	(TIM2FR),A
	RET

LDTM3:	LD	A,E
	LD	(TIM3BU),A	;STORE TO BASIC USER VALUE
	LD	(TIM3B),A	;STORE TO BASIC COUNTER
	LD	A,(TIMKA)	;LOAD PRESCALER
	LD	(TIM3),A
	XOR	A		;CLEAR FREERUN FLAG
	LD	(TIM3FR),A
	CALL	GC
	CP	CR
	RET	Z
	LD	B,4		;'FREERUN'?
	CALL	EATC
	LD	A,1		;SET FLAG
	LD	(TIM3FR),A
	RET

DELAY:	CALL	BYTARG		;TIMER # IN DE
	LD	A,E
	CALL	CK1_3		;RANGE 1-3

	LD	C,E		;TIMER # IN C
	PUSH	BC

	CALL	EATCOM
	CALL	EXPRB
	CALL	PFIX		;BASIC TIME CONST IN DE

	POP	BC		;GET AGAIN TIMER #
	LD	A,03H		;CONTROL WORD FOR CTC - NO INTERRUPT
	CALL	WRITIM		;RESET - NO K
	OR	A
	JP	NZ,PDERR	;UNOPENED?

	LD	HL,TIM_A_TAB
	CALL	ADDRESS		;GET CTC PORT ADDRESS

DLY0:	LD	A,27H		;NO INT
	OUT	(C),A

	LD	A,195+1		;TIME K
	OUT	(C),A

DLY1:	IN	A,(C)		;WAIT UNTIL TIMER EXPIRES
	CP	1
	JR	NZ,DLY1
	DEC	DE
	LD	A,D
	OR	E
	JR	NZ,DLY0

	LD	A,3		;STOP CTC
	OUT	(C),A

	RET

;--------------------------------------------------------------------------
;	NEWLDE	- LOAD A PROGRAM
;--------------------------------------------------------------------------

;	LOADS A PROGRAM STORED IN MEMORY FROM THE ADDRESS SPECIFIED BY
;	THE EXPRESSION THAT FOLLOWS THE 'LOAD ABS' STATEMENT

NEWLDE:	CALL	GCI		;EAT 'LOAD' RESERVED WORD

	CALL	EXPRB		;GET ADDRESS
	CALL	PFIX		;CONVERT TO INTEGER
	PUSH	DE		;SOURCE ADDRESS IN DE - SAVE IT
	POP	HL

	LD	DE,(BOFA)	;DESTINATION AREA
	CALL	APPENC		;LOAD FIRST LINE (NO LEADING CR)
	JR	C,NEWLDE2

NEWLDE1:CALL	APPCHK		;APPEND LINE
	JR	NC,NEWLDE1

NEWLDE2:LD	(EOFA),DE
	RET

;--------------------------------------------------------------------------
;	APPENC	APPEND AN ENCODED LINE FROM SOURCE AREA TO WS
;--------------------------------------------------------------------------
;	AT EOF (EOF (01) ONLY COPIED) RETURNS WITH CY SET
;	ON INPUT:
;		HL POINTS TO THE FIRST BYTE (LENGHT) OF THE LINE TO COPY
;		DE POINTS TO THE FIRST FREE BYTE OF WS

APPCHK:	DEC	HL
	CALL	LDIHLX		;LD A,(HL) FROM EXT PAGE
	CP	0DH
	JP	NZ,LDLL_ERR	;LOAD LINE LENGHT ERROR
	INC	HL

APPENC:	CALL	LDIHLX		;LD A,(HL) FROM EXT PAGE
	CP	1
	JR 	Z,APEN2
	LD	C,A		;BYTE COUNTER
	LD	B,0
	CALL	XLDIR
	OR	A		;CLEAR CY
	RET
APEN2:	LD	(DE),A
	SCF
	RET

LDLL_ERR:
	CALL	HEXDW		;HL CONTAINS ADDRESS OF THE WRONG LINE
	LD	B,' '
	CALL	CHOUT
	JP	LERROR

;----------------------------------------------------------------------------
;	XLDIR - SPECIAL LDIR
;----------------------------------------------------------------------------

;	AN 'LDIR' DONE BY CALLING CONSOLE TO LOAD BYTES FROM AN EXTENDED PAGE
;	(OR FROM STANDARD PAGE OR FROM ELSEWHERE)

;	SET REGISTERS AS BEFORE A 'LDIR'

XLDIR:	LD	B,C		;TO USE DJNZ - B IS ALWAYS ZERO

LDLOP:	CALL	LDIHLX		;LD A,(HL) FROM EXT PAGE
	LD	(DE),A

	INC	HL
	INC	DE
	DJNZ	LDLOP

	RET

;----------------------------------------------------------------------------
;	LDIHLX - LD A,(HL) DONE BY CONSOLE SPECIAL FUNCTION 90H
;----------------------------------------------------------------------------
;	IN THIS WAY CONSOLE CAN GET BYTES FROM EXTENDED PAGES OR FROM
;	A DISK BOARD ETC.

LDIHLX:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	C,0		;CALL CONSOLE DRIVER (0)
	LD	B,90H		;ASK FOR SPECIAL FUNCTION '90'
	CALL	DRIVER		;THAT RETURNS A BYTE FROM EXTENDED PAGE
	LD	A,E

	POP	HL
	POP	DE
	POP	BC
	RET

;----------------------------------------------------------------------------
;	'LOAD HEX' COMMAND
;----------------------------------------------------------------------------

;	LOAD A PROGRAM FROM THE CONSOLE IN INTEL FORMAT

DOWNLD:	CALL	GCI		;EAT HEX
	CALL	CSCR		;SCRATCH THE WS
DOWNLD1:CALL	INLINE		;GET A LINE
	LD	DE,IBUF		;CHECK FIRST CHAR
	LD	A,(DE)
	CP	':'		;INTEL RECORD BEGINS?
	RET	NZ 		;NO, RETURN
	INC	DE		;SKIP ':'
	CALL	CVTLINE
	LD	A,(ERR)		;ANY ERROR?
	CP	1		;CHECKSUM ERROR
	JP	Z,READERR
	CP	2		;END OF FILE RECORD
	JR	NZ,DOWNLD1

;	NOW WE NEED TO RESTORE THE CR THAT FOLLOWED LOAD HEX COMMAND

	LD	A,CR
	LD	(IBUF+3),A

	LD	HL,(BOFA)	;SEARCH THE '01' EOF MARK

	LD	B,0		;FIND EOF

LHFIND1:LD	C,(HL)
	LD	A,C
	CP	EOF
	JP	Z,QLHF
	ADD	HL,BC
	JP	LHFIND1

QLHF:	LD	(EOFA),HL	;ADJUST BOFA
	RET

;----------------------------------------------------------------------------
;	CONVERT A LINE FROM THE INTEL FORMAT AND STORE TO MEMORY
;----------------------------------------------------------------------------

CVTLINE:XOR	A
	LD	(CHK),A		;CLEAR CHECKSUM
	LD	(BYTCNTR),A	;CLEAR BYTES COUNTER

	LD	A,2		;SET EOF ERROR UNTIL OTHERWISE
	LD	(ERR),A

	CALL	RDBYTE		;READ # OF BYTES IN THIS RECORD
	OR	A		;ZERO BYTES TO READ?
	RET	Z		;RETURN IMMEDIATELY
	LD	(BYTCNTR),A

	XOR	A
	LD	(ERR),A		;CLEAR CHECKSUM ERROR FLAG

	CALL	RDWORD		;READ STORE ADDRESS
	PUSH	DE
	LD	DE,(BOFA)	;ADD OFFSET
	ADD	HL,DE
	POP	DE
	PUSH	HL		;SAVE ADDRESS

	CALL	RDBYTE		;RECORD TYPE

DWN1:	CALL	RDBYTE		;READ DATA

	POP	HL		;GET BACK DEST ADDRESS
	LD	(HL),A		;STORE DATA TO ADDRESS
	INC	HL
	PUSH	HL

	LD	A,(BYTCNTR)	;INCREMENT BYTE COUNTER
	DEC	A
	LD	(BYTCNTR),A

	JR	NZ,DWN1		;ALL BYTES READ?

	CALL	RDBYTE		;READ CHECKSUM
	LD	A,(CHK)
	OR	A
	JR	Z,DWN3		;CK OK? JUMP

	LD	A,1
	LD	(ERR),A

DWN3:	POP	HL
	RET

RDBYTE:	CALL	RDHEX		;READ MS NIBBLE
	SLA	A		;MAKE ROOM
	SLA	A
	SLA	A
	SLA	A
	LD	L,A
	CALL	RDHEX		;READ LSN
	OR	L
	LD	L,A
	LD	A,(CHK)		;UPDATE CHECKSUM
	ADD	A,L
	LD	(CHK),A
	LD	A,L		;LEAVE RESULT ALSO IN A
	RET

RDWORD:	CALL	RDBYTE
	LD	H,L
	CALL	RDBYTE
	RET


;
;
;--------------------------------------------------------------------------
;	'LPRINT'
;--------------------------------------------------------------------------
;
LPRINT:	LD	A,2	;SWITCH OUTPUT TO LINE PRINTER
	LD	(LOGDEVO),A
	JP	PRINT1


;--------------------------------------------------------------------------
;	'ON'
;--------------------------------------------------------------------------
;
AON:	CALL	GC		;READ NEXT CHAR
	CP	ERRRW		;'ERROR'
	JP	Z,STRAPX
	CP	TIMRW		;'TIMER'
	JP	Z,TIMER
	CP	INTRW		;'INTERRUPT'
	JP	Z,INTERR
	CALL	BYTARG
	PUSH	DE		;SAVE LINE #
	CALL	GCI		;GET NEXT CHAR ("GOTO" OR "GOSUB" RW)
	POP	DE
	PUSH	AF		;SAVE IT
	LD	A,E		;GET LINE# AGAIN
	INC	A		;ZERO MEANS FIRST LINE#
	PUSH	AF		;PUSH ORDER #
ONG2:	POP	AF		;AND GET IT
	DEC	A
	JP	Z,ONG3
	PUSH	AF
ONG1:	CALL	GCI
	CP	','
	JP	Z,ONG2
	CP	CR
	JP	Z,E5
	JP	ONG1
ONG3:
	POP	AF
	CP	GOTRW		;'GOTO'
	JP	Z,SGOTO

	PUSH	AF
	LD	A,1		;ASK 'GOSUB' TO SKIP THE REMAINDER OF THE LINE
	LD	(REMFLG),A
	POP	AF

	CP	GOSURW
	JP	Z,GOSUB
	JP	E1

;--------------------------------------------------------------------------
;	'ON ERROR' AND 'ON ERROR CON:'
;--------------------------------------------------------------------------

STRAPX:	CALL	GCI		;EAT 'ERROR' RW
	CALL	GC		;ON ERROR CON:..?
	CP	27
	JP	NZ,STRAP
	CALL	GCI		;EAT PREFIX
	LD	B,CON_RW
	CALL	EATC		;EAT CON_RW
	LD	B,':'
	CALL	EATC
	LD	B,ISRW
	CALL	EATC
	LD	B,CHRW
	CALL	EATC
	CALL	BYTARG		;GET BYTE
	LD	A,E
	LD	(ERRCON),A	;STORE
	RET

;
;	GENERAL STRUCTURE OF TABINT:
;
;	IX+0	LINE # LOW
;	IX+1	"    " HI
;	IX+2	REQUEST FLAG
;	IX+3	STATUS: 0 = INACTIVE
;			1 = PRESET
;			2 = ON SERVICE
;
;	* * ON TIMER/INTERRUPT GOSUB
;
TIMER:
	CALL	GCI
	CALL	BYTARG
	LD	A,E
	CALL	CK1_3		;RANGE 1-3
	ADD	A,5		;REPORT TO EFFECTIVE INT#
	LD	E,A
	JR	INTER1
INTERR:
	CALL	GCI
	CALL	BYTARG
	LD	A,E
	OR	A
;	CP	1		;EXTERNAL INTERRUPT # ALLOWED ONLY
	JP	M,E9C
	CP	5		;IN 0-3 RANGE
	JP	NC,E9C
INTER1:	PUSH	DE		;SAVE INTERRUPT #
	CALL	GC		;TEST NEXT CHAR
	CP	CR		;RETURN MEANS CLEAR INTERRUPT VECTOR
	JP	Z,CLEAINT
	CP	GOSURW		;'GOSUB' RW
	JP	Z,ASSVEC 	;ASSOCIATE VECTOR TO INT #

	POP	DE
	JP	E1		;ANYELSE : SINTAX ERROR


ASSVEC:	CALL	GCI		;EAT GOSUB RW
	CALL	INTGER		;GET VECTOR LINE NUMBER TO HL
	POP	DE		;INT#
	LD	A,1		;PREPARE STATUS LEVEL FOR FUTURE USAGE TO 'PRESET'
	PUSH	AF
ASSVE1:	CALL	SETIX		;SET IX TO 4*INT# + TABINT
	LD	(IX+0),L	;STORE LINE # TO TABLE
	INC	IX
	LD	(IX+0),H
	INC	IX
	XOR	A		;STORE (NO) REQUEST FLAG (REQF)
	LD	(IX+0),A
	POP	AF		;GET STATUS
	INC	IX
	LD	(IX+0),A	;STATUS LEVEL TO 1
	RET
CLEAINT:
	CALL	GCI
	LD	HL,0		;STORE LINE # VEC = 0
	POP	DE
	LD	A,0		;SET STATUS TO INACTIVE
	PUSH	AF
	JR	ASSVE1
;
;	* SETIX - SET IX TO THE ADDRESS OF ENTRY #DE OF TABINT
;
SETIX:	PUSH	HL
	PUSH	DE
	PUSH	DE
	POP	HL		;DE->HL
	ADD	HL,DE		;HL=2*DE	;USE ADD TO EASE FUTURE
	ADD	HL,HL		;HL=4*DE	;MODIFICATION
	PUSH	HL
	POP	DE		;DE = 4 TIMES ORIGINAL DE
	LD	IX,TABINT
	ADD	IX,DE
	POP	DE
	POP	HL
	RET


;
;--------------------------------------------------------------------------
;	'OUT'	TO OUTPUT BYTES TO OUTPUT PORTS
;--------------------------------------------------------------------------
;
COUT:	CALL	GC
	CP	EQRW	;'=' MEANS 'SET POBUF'
	JP	Z,SETPOB

;	mod.26.10.96 - si accettano indirizzi maggiori di 256 ma si suppone
;	che siano destinati ad un driver

	CALL	EXPRB		;GET PORT NUMBER
	CALL	PFIX		;CONVERT TO INTEGER
	PUSH	DE		;SOURCE ADDRESS IN DE - SAVE IT

;	SE LA PARTE ALTA E' ZERO, CONTINUA VECCHIA MANIERA

	LD	A,D
	OR	A
	JR	Z,OLDOUT

;	SE NESSUN DRIVER INSTALLATO, NOPPA

	LD	A,(IODRV)
	OR	A
	JP	Z,QOUT

;	VICEVERSA DOBBIAMO GESTIRE L'OUTPUT DA DRIVER
;	A CONTIENE IL NUMERO DEL DRIVER

	PUSH	AF
	LD	B,','
	CALL	EATC
	CALL	BYTARG		;GET DATA TO OUTPUT

	LD	H,0		;DATA TO OUT IN HL
	LD	L,E

	POP	AF
	POP	DE		;DE - RECORD NUMBER
	LD	D,0		;TOGLI OFFSET 255
	LD	C,A		;C  - CHANNEL NUMBER
	LD	B,0		;B  - OPERATION CODE 0 (FOR WRITE)
	CALL	DRIVER		;DOES WHAT DRIVER WANTS
	JP	QOUT

OLDOUT:
;	era :
;	CALL	BYTARG	;GET PORT NUMBER
;	LD	C,E
;	PUSH	BC

	LD	B,','
	CALL	EATC
	CALL	BYTARG	;GET DATA TO OUTPUT
	LD	A,E
	PUSH	AF
	CALL	GC
	CP	','
	JR	NZ,COUT3
	LD	B,','
	CALL	EATC
	CALL	BYTARG	;GET BIT #
	LD	A,E

;	LOAD REG E WITH THE BIT PATTERN CORRESPONDING TO THE REQUESTED BIT

	PUSH	HL
	LD	HL,INPTAB
	AND	7
	LD	E,A
	LD	D,0
	ADD	HL,DE
	LD	A,(HL)
	LD	E,A
	POP	HL
;				;E CONTAINS NOW BIT PATTERN - A DESTROYED
	POP	AF		;RESTORE DATA TO OUT
	POP	BC		;RESTORE PORT ADDRESS
	PUSH	BC		;AND SAVE IT AGAIN
	AND	1		;CONSIDER ONLY LSB
	CP	0		;SET OR RESET BIT?
	JR	NZ,SEBIT

;	IN CASE OF PIO, WE READ BACK THE OUTPUT PORT BEFORE OUTPUTTING
;	ELSEWHERE WE RESET SET OTHER BITS TO ZERO

RESEBIT:LD	A,E
	CPL
	LD	E,A		;E CONTAINS COMPLEMENTED BIT PATTERN
	LD	A,(OUTMOD)	;WORKING WITH A PIO?
	OR	A
	JR	Z,NOPIOR	;IN CASE OF JUMP ACC IS ZERO

	CP	1
	JR	Z,PIOR

	CALL	OLDPORT		;BUFFERD PORT - GET OLD CONTENT
	LD	A,(HL)		;GET OLD DATA
	JR	NOPIOR

PIOR:	IN	A,(C)		;GET OLD PORT DATA
NOPIOR:	AND	E
	JR	COUT4
;
SEBIT:	LD	A,(OUTMOD)	;WORKING WITH A PIO?
	OR	A
	JR	Z,NOPIOS	;IN CASE OF JUMP ACC IS ZERO

	CP	1
	JR	Z,PIOS

	CALL	OLDPORT		;BUFFERD PORT - GET OLD CONTENT
	LD	A,(HL)		;GET OLD DATA
	JR	NOPIOS

PIOS:	IN	A,(C)		;PIO, LEGGI PORTA
NOPIOS:	OR	E
COUT4:	PUSH	AF
;
COUT3:	POP	AF		;RESTORE DATA TO OUT
	POP	BC		;RESTORE PORT ADDRESS

	PUSH	AF		;SAVE DATA TO OUT
	LD	A,0		;OUT TO PORT 0?
	CP	C
	JR	NZ,NOPIOSET

;	PORT ZERO CANNOT BE USED UNDER BASIC SO WE USE IT TO SET THE PIO
;	FLAG

	POP	AF		;GET DATA TO OUT
	LD	(OUTMOD),A	;SET FLAG
	JR	QOUT		;AND QUIT

NOPIOSET:
	POP	AF
	LD	E,A		;SAVE DATA TO OUT

	LD	A,(OUTMOD)	;BUFFERED MODE?
	CP	2
	JR	NZ,STDOUT

	CALL	OLDPORT		;YES, SAVE NEW VALUE
	LD	(HL),E

STDOUT:	LD	A,E
	OUT	(C),A

QOUT:	LD	B,0
	RET

SETPOB:	CALL	GCI	;GOBBLE '='
	CALL	EXPRB
	CALL	PFIX
	LD	(POBUF),DE
	RET

;	OLDPORT - GET OLD PORT POINTER CONTENT - C IS PORT ADDRESS

OLDPORT:LD	HL,(POBUF)
	LD	B,0
	ADD	HL,BC
	RET

;
;--------------------------------------------------------------------------
;	'POKE' ROUTINE TO WRITE BYTES INTO MEMORY
;--------------------------------------------------------------------------
;
CPOKE:	CALL	EXPRB	;EVALUATE ADDR EXPRESSION
	CALL	PFIX	;CONVERT TO INTEGER
	PUSH	DE	;SAVE ADDR
	LD	B,'['	;FIND '['
	CALL	EATC
CPOK1:	CALL	BYTARG	;CONVERT NEXT EXPRESSION TO BYTE
	POP	HL	;RETRIEVE ADDR
	LD	(HL),E	;WRITE BYTE
	INC	HL
	PUSH	HL	;SAVE NEW ADDR
	LD	HL,CPOK2;SET UP RETURN ADDR IF NEXT NON-BLANK<>','
	PUSH	HL
	CALL	EATCOM
	POP	HL	;CHAR=','
	JP	CPOK1
;
CPOK2:	LD	B,']'	;TEST FOR ']'
	CALL	EATC
	POP	HL	;CLEAN OUT STACK IN CASE DONE
	CALL	EATCOM
	PUSH	HL
	JP	CPOKE


;
;--------------------------------------------------------------------------
;	'PRESCALE' - SET TIME CONSTANT FOR TIMERS
;--------------------------------------------------------------------------
;
PRESCA:	CALL	BYTARG
	LD	A,E
	LD	(TIMKA),A
	RET
;
;--------------------------------------------------------------------------
;	'DISPLAY'	"PRINT" LIKE  FOR LCD DISPLAY
;--------------------------------------------------------------------------

;			DISPLAY n,<exp list>
;			DISPLAY n,BLANK
;			n=1 FOR UPPER DISPLAY
;			n=2 FOR LOWER DISPLAY
DISPLAY:

	CALL	BYTARG		;GET DISPLAY #
	LD	A,E
	CP	1
	JR	Z,ANYLCD	;UPPER DISPLAY?
	CP	2
	JP	NZ,PDERR

ANYLCD:	CALL	AUXOUT		;1 SELECTS DISPLAY 1 AND
				;2 SELECTS DISPLAY 2



	LD	A,12		;CLEAR SCREEN
	CALL	AUXOUT

	LD	B,15		;SWITCH OFF THE CURSOR
	CALL	AUXOUT

ALCD2:	CALL	GC		;EXPLORE NEXT
	CP	CR
	RET	Z

	LD	B,','		;IF NOT A CR, COMMA MUST FOLLOW
	CALL	EATC

PREPRINT:
	LD	A,(LOGDEVO)	;SAVE CURRENT CHANNEL
	LD	(TMPDEV),A	;(MECCANISMO FORSE INUTILE)
	LD	A,7		;USE AUX: LOGIC DEVICE FOR DISPLAY
	LD	(LOGDEVO),A
	JP	PRNCON

;--------------------------------------------------------------------------
;	'OVERPRINT'
;--------------------------------------------------------------------------

;	SYNTAX: OVERPRINT <STRINGVAR>, <STARTPOSITION>, <STRINGEXP>

OVPRINT:CALL	VARX		;CHECK FOR VARIABLE
	JP	C,E1
	CALL	TSTST		;CHECK FOR STRING
	JP	Z,E19

	LD	A,C
	PUSH	AF		;SAVE DEST LENGHT FOR ERROR CHECKING
	PUSH	HL		;SAVE DEST STRING ADDRESS

	CALL	EATCOM

	CALL	BYTARG		;GET OFFSET
	LD	D,0
	DEC	DE
	POP	HL
	ADD	HL,DE		;HL HAS DESTINATION CHAR ADDRESS
	PUSH	HL
	PUSH	DE		;SAVE OFFSET

	CALL	EATCOM

	CALL	EXPRB		;GET ADDRESS OF THE STRING TO PRINT OVER
	CALL	EFFLEN
	JP	Z,E19		;ZERO MEANS THIS IS NOT A STRING

	POP	DE		;OFFSET
	LD	A,E
	ADD	A,C		;ACC HAS SOURCE STRING LENGHT + OFFSET

	POP	DE		;PUSHED AS HL - EFFECTIVE DEST ADDRESS
	LD	B,A		;SAVE IN B
	POP	AF
	CP	B
	JP	C,E19		;TOO LONG

	LD	B,0		;HL HAS THE SOURCE ADDRESS - BC BYTES TO COPY
	LDIR
	RET
;--------------------------------------------------------------------------
;	'PRINTS'
;--------------------------------------------------------------------------

;	LIKE 'PRINT' BUT OUTPUTS INTO A STRING
;	SYNTAX: PRINT A$,..... WHERE A$ IS DEST STRING

PRINTS:	LD	A,(LOGDEVO)	;SAVE CURRENT CHANNEL
	LD	(TMPDEV),A	;(MECCANISMO FORSE INUTILE)
	LD	A,1
	LD	(LOGDEVO),A
	CALL	VARX		;CHECK FOR VARIABLE
	JP	C,E1
	CALL	TSTST		;CHECK FOR STRING
	JP	Z,E19

	LD	(UBUPO),HL	;USER BUFFER POINTER
	LD	A,C		;SAVE MAX ALLOWABLE STORAGE SPACE
	LD	(MAXBUF),A

	CALL	PRINTS1		;AND USE NORMAL PRINT

	LD	HL,MAXBUF	;ADD TERMINATOR 0
	DEC	(HL)		;IF YOU HAVE NO SPACE
	JP	Z,E19		;STRING ERROR

	LD	HL,(UBUPO)
	XOR	A		;TERMINATOR
	LD	(HL),A

	LD	HL,0		;RESET UBUPO (SEE NOTE AT OTOBUF)
	LD	(UBUPO),HL

	RET

;--------------------------------------------------------------------------
;	'PRINT'
;--------------------------------------------------------------------------

PRINT:	LD	HL,(SAPOINT)	;PRESET THE EFFECTIVE POINTER
	LD	(SAPTMP),HL

	LD	A,(LOGDEVO)	;SAVE CURRENT CHANNEL
	LD	(TMPDEV),A	;(MECCANISMO FORSE INUTILE)
	XOR	A		;OUT TO CON:
	LD	(LOGDEVO),A
	CALL	GC
	CP	LDEVRW		;REQUEST FOR A DIFFERENT CHANNEL?
	JP	NZ,DEVSEL
;------------------------------------------------------------LDEV SELECT
;	(FORMERLY CH OPTION)

	LD	B,A
	CALL	EATC
	CALL	BYTARG		;GET CHANN #
	LD	A,E
	CP	8		;NOT BEYOND LDEV 7
	JP	NC,E1
	LD	(LOGDEVO),A	;UPDATE REQUEST
	JR	PRINTS1
;------------------------------------------------------------DEVICE SELECT
DEVSEL:	CP	CHRW		;REDIRECTING?
	JR	NZ,PRNCON	;NO, JUMP

	CALL	GCI
	CALL	BYTARG		;GET DRIVER #
	LD	A,(AUXOBYTE)	;USE AUX: - SAVE CURRENT VALUE
	LD	(AUXOTEMP),A
	LD	A,E		;SET AUX: TO REQUESTED FILE #
	LD	(AUXOBYTE),A
	LD	A,7		;AND SELECT AUX: AS LOGICAL DEVICE
	LD	(LOGDEVO),A

;---------------------------------------------------------------------------
;			EVERYBODY COMES HERE
;---------------------------------------------------------------------------

PRINTS1:CALL	EATCOM
PRINT1:	CALL	GC		;EXPLORE NEXT CHAR

;---------------------------------------------------------STAND ALONE PRINT
PRNCON:
	CP	CR		;CHECK FOR STAND ALONE PRINT
	JP	Z,PREXI
;---------------------------------------------------------TAB OR SET FORMAT
PRIN0:
	CP	TABRW
	JP	Z,PTAB		;TABULATION

	CP	'%'
	JP	Z,PFORM		;SET FORMAT

	CP	CR
	JR	Z,PREXIT
;----------------------------------------------------------------EXPRESSION
	CALL	EXPRB		;MUST BE EXPRESSION TO PRINT
	CALL	TSTST
	JP	Z,NOPSTR
	CALL	PSTR
	JP	PR1

NOPSTR:	LD	DE,FPSINK
	CALL	POPA1		;POP VALUE TO FPSINK
	LD	A,(PHEAD)
	LD	HL,LWID
	CP	(HL)
;TEST ONLY	CALL	NC,CRLF		;IF PRINT HEAD PAST LINE WIDTH LIMIT
	LD	HL,FPSINK
	CALL	FPOUT
	LD	B,' '
	CALL	CHOUT
;-----------------------------------------------------------------DELIMITER
PR1:	CALL	GC		;GET DELIMITER
	CP	','
	JR	Z,OTAB
	CP	'!'
	JR	Z,OCRLF
	CP	';'
	JR	Z,PR0
PREXI:	CALL	CRLF
PREXIT:	LD	A,(TMPDEV)
	LD	(LOGDEVO),A	;RESTORE CHANNEL BEFORE EXIT
	LD	A,(AUXOTEMP)	;AUX: MODIFIED FOR REDIRECTION?
	CP	0FFH
	RET	Z		;NO, RET
	LD	(AUXOBYTE),A
	LD	A,0FFH
	LD	(AUXOTEMP),A
	RET

PR0:	CALL	GCI
	CALL	GC
	JP	PRIN0

OTAB:	LD	A,(LOGDEVO)	;IF OUTPUTING TO CH 5 SEPARATOR
	CP	5		;MUST BE COMMA, NOT TAB
	JR	Z,OCOMMA
	LD	B,9
	CALL	CHOUT
	JR	PR0

OCRLF:	CALL	CRLF
	JR	PR0

OCOMMA:	LD	B,','
	CALL	CHOUT
	JR	PR0
;
;------------------------------------------------------------PRINT STRING

;	NEW VERSION - WORKS AS A SUBROUTINE

PSTR:	CALL	EFFLEN
	INC	C
PSTR1:	DEC	C
	RET	Z
	LD	A,(HL)
	OR	A
	RET	Z
	LD	B,A
	CALL	CHOUT
	INC	HL
	JP	PSTR1

;------------------------------------------------------------PRINT STRING
PFORM:	CALL	GCI		;GOBBLE '%'

	LD	B,'"'
	CALL	EATC

	LD	A,2*FPNIB
	LD	(INFES),A
PFRM1:	CALL	GCI
	LD	HL,INFES

	CP	'"'		;DELIMITER
	JP	Z,PR1

	LD	B,80H		;200Q
	CP	'D'		;FISSA IL NUMERO DI ZERI IN CODA
	JR	Z,PF1		;(POI DIREMO QUANTI)

	LD	B,1
	CP	'E'		;SCIENTIFIC NOTATION?
	JR	Z,PF1

	CP	'N'
	JR	Z,PFRM1

PFRM2:	CP	'I'		;SET NUMBER OF INTEGER DIGITS
	JR	Z,SETDIG

	CP	'F'		;SET FILLER
	JR	Z,SETFILL

	CALL	NMCHK
	JP	NC,E1
	SUB	'0'		;NUMBER OF DECIMAL PLACES

	RLCA

	LD	B,A		;INSERISCE NUMERO IN INFES
	LD	A,(HL)
	AND	0C1H		;301Q
	LD	(HL),A

PF1:	LD	A,(HL)
	OR	B
	LD	(HL),A
	JR	PFRM1

SETDIG:	CALL	GCI		;SET INTEGER DIGIT NUMBER
	CALL	NMCHK
	JP	NC,E1
	SUB	'0'		;NUMBER OF DECIMAL PLACES
	LD	(INTDIG),A	;SET INTDIG
	JR	PFRM1

SETFILL:CALL	GCIAB		;GET THE FILLER CHAR
	LD	(FILLCH),A
	JR	PFRM1

;	PRINT TAB() FUNCTION

PTAB:	CALL	GCI		;GOBBLE TAB RW
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB
	LD	B,')'
	CALL	EATC
	CALL	PFIX
PTAB1:	LD	A,(PHEAD)
	CP	E
	JP	NC,PR1
	LD	B,' '
	CALL	CHOUT
	JP	PTAB1


;--------------------------------------------------------------------------
;	'PROCEDURE'
;--------------------------------------------------------------------------
PROC:
	RET

;--------------------------------------------------------------------------
;	'OPEN' - OPEN A DRIVER OR A FILE
;--------------------------------------------------------------------------
OPEN:	LD	A,1
	LD	(PRIVIL),A
	CALL	GC
	CP	CHRW
	JP	NZ,INTERN_DR	;INTERNAL DRIVER?

	CALL	GCI		;EAT "CH"
	CALL	BYTARG		;GET FILE NUMBER
	LD	A,E
	PUSH	AF

	CP	MAXFILES
	JP	NC,PDERR

;	CALL	GC		;REOPEN ALLOWED?
;	CP	RESTORW
;	JR	NZ,DOTEST	;YES, DONT JUMP

;	CALL	GCI
;	JR	NOTEST

DOTEST:	CALL	TESTOPEN	;TEST IF FILE IS ALREADY OPEN

	JP	NZ,ALREOP	;FILE ALREADY OPEN

NOTEST:	CALL	EATCOM
	CALL	EXPRB		;GET FILE NAME
	CALL	EFFLEN

	LD	A,8		;FILE NAME MAXIMUM LENGHT
	CP	C

	JP	C,TOOLONG	;STRING ERROR

	LD	DE,LASTRO+1	;START SEARCH OF DRIVERS PAST THE INTERPRETER
	EX	DE,HL		;DE POINTS TO THE STRING TO SEARCH FOR

	CALL	SRC_DRV		;SEARCH DRIVER - RETURNS HL=DRIVER ADDRESS

	JP	NZ,DRVERR	;NO MATCH

	POP	AF		;FILE #
	PUSH	AF
	PUSH	HL		;DRIVER ADDRESS

	CALL	DIRENTRY

	POP	DE		;DRIVER ADDRESS
	LD	(HL),E
	INC	HL
	LD	(HL),D
	INC	HL

	LD	A,1		;FILE OPEN FLAG
	LD	(HL),A

	INC	HL
	INC	HL		;SET HL TO TYPE FIELD

	PUSH	HL
	EX	DE,HL		;HL HAS THE ADDRESS OF THE 1.ST EXECUTABLE
				;LOC OF THE DRIVER
	LD	DE,9
	OR	A
	SBC	HL,DE
	EX	DE,HL		;DE POINTS TO DRIVER TYPE
	POP	HL

	LD	A,(DE)		;MOVE TYPE TO DIRTAB, 'TYPE' FIELD
	LD	(HL),A

	CALL	GC		;SEE FOR A CONFIG STRING
	CP	','
	LD	E,0		;NO CONFIG STRING FLAG
	JR	NZ,NO_CS	;NO CONFIG STRING OR NO.OF RECORDS

	CALL	GCI		;EAT COMMA

	CALL	CONFISTR	;GET CONFIG STRING ADDRESS
	JR	Z,CFSTG		;JUMP IF THE CONFIG STRING IS PRESENT

;	PROCESS THE CASE OF FILE DATA FOLLOWING COMMA INSTEAD OF CONFIG STG

	PUSH	DE		;SAVE NO. OF RECS
	LD	B,DATARW	;EAT 'DATA' RW
	CALL	EATC

	LD	B,EQRW
	CALL	EATC		;EAT '='

	CALL	BYTARG
	POP	HL
	EX	DE,HL
				;DE=NO OF RECS - HL=LENGHT OF RECORD
	JR	NO_CS

CFSTG:	LD	E,1		;CONFIG STRING PRESENT
NO_CS:	POP	AF		;FILE #

;	PERFORMS INIT OF DRIVER MODULE

	LD	C,A
	LD	B,2		;INIT
	CALL	DRIVER
	OR	A
	JP	NZ,DRVERR
	RET

;	DIRENTRY - SET HL TO THE ENTRY #ACC OF DIRTAB

DIRENTRY:
	CP	MAXFILES	;CHECK FILE #
	JP	NC,E3

	LD	HL,DIRTAB
	LD	C,A
	LD	B,0

	ADD	HL,BC		;EACH ENTRY IS FIVE BYTES
	ADD	HL,BC
	ADD	HL,BC
	ADD	HL,BC
	ADD	HL,BC
	RET

;	DRVTYP - RETURNS THE TYPE OF A DRIVER #ACC IN ACC
;		 0=CHAR 1=BLOCK 2=SPECIAL

DRVTYP:	PUSH	DE
	CALL	DIRENTRY
	LD	DE,4
	ADD	HL,DE
	LD	A,(HL)
	POP	DE
	RET


;	TESTOPEN - TEST FOR A FILE # IF OPEN
;		   IF OPEN RETURNS NONZERO
;		   IF FREE RETURNS ZERO
;		   FILE # IN ACC

TESTOPEN:
	OR	A		;TEST IF FILE # IS CORRECT
	JP	M,E3

	CP	MAXFILES
	JP	NC,E3

	CALL	DIRENTRY
	INC	HL
	INC	HL
	LD	A,(HL)
	OR	A
	RET

;	SRC_DRV - SEARCH THE DRIVER NAMED ACCORDING THE STRING
;		  ADDRESSED BY DE
;		  CALLED WITH HL POINTING THE THE FIRST LOC AFTER
;		  THE INTERPRETER
;		  IF NO DRIVER IS FOUND RETURNS WITH ZERO RESET
;		  IF DRIVER IS FOUND RETURNS WITH ZERO SET AND
;		  HL CONTAINING THE ADDRESS OF THE EXECUTABLE DRIVER

SRC_DRV:
	PUSH	HL		;SAVE DRIVER HEADING ADDRESS
	LD	A,(HL)
	CP	DRVMARK
	JP	NZ,NODRFND
	INC	HL		;POINT TO NEXT DRIVER ADDRESS
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	PUSH	BC
	INC	HL		;POINT TO TYPE
	INC	HL		;POINT TO NAME, 1.ST LOC
	PUSH	DE		;ADDRESS OF THE STRING TO FIND

	LD	A,(LSTDRV)
	OR	A
	JR	Z,SDRV1

	PUSH	BC
	PUSH	DE
	PUSH	HL

	LD	C,':'
	CALL	PRN1
	LD	B,':'
	CALL	CHOUT
	CALL	CRLF

	POP	HL
	POP	DE
	POP	BC


SDRV1:	LD	B,8		;8 CHARS TO TEST
DRLOP:	LD	A,(DE)
	CP	(HL)
	JR	NZ,NXTDRV	;NO MATCH, TEST NEXT DRIVER
	CP	':'
	JR	Z,DRMATCH
	INC	HL
	INC	DE
	DJNZ	DRLOP

DRMATCH:LD	(FNAME),DE
	POP	DE
	POP	BC		;MATCH - CLEAR STACK
	POP	HL		;GET HEADER ADDRESS
	LD	DE,12		;SKIP HEADER
	ADD	HL,DE		;RETURN ADDRESS OF ACTION ROUTINE
	XOR	A		;SET ZERO FLAG
	RET

NXTDRV:	POP	DE
	POP	BC		;OFFSET
	POP	HL		;BASE
	ADD	HL,BC
	JR	SRC_DRV		;START OVER

NODRFND:POP	HL
	XOR	A		;RESET ZERO FLAG
	INC	A
	RET

;--------------------------------------------------------------------------
;	SETUPRD - SETUP DRIVER SYSTEM AND INIT SYSTEM DRIVERS
;--------------------------------------------------------------------------

;	INTITS BRG, CONSOLE SIO AND PREPARE AUTOSTART

SETUPDR:LD	HL,DIRTAB
	LD	DE,DIRTAB+1
	LD	BC,(DIRTAB1-DIRTAB)*MAXFILES
	XOR	A
	LD	(HL),A
	LDIR
	LD	HL,LASTRO+13	;CONSOLE DRIVER ENTRY POINT
	LD	(DIRTAB),HL
	LD	HL,DIRTAB+2
	INC	A
	LD	(HL),A		;CONSOLE IS OPEN, NOW, ON CH 0

	LD	HL,CON_STUP	;CONFIG STRING
	LD	(TXA_CS),HL
	LD	E,1		;STRING PRESENT
	LD	B,2		;INIT CONSOLE
	LD	C,0		;NON C'ERA MA FUNZIONAVA (?) # CH (0=CONS)
	CALL	DRIVER

	LD	C,0		;NOW ASK FOR SPECIAL FUNCTION '88'
	LD	B,88H		;THAT RETURN AUTOSTART REQUEST FLAG
	CALL	DRIVER
	LD	A,E		;SET OR RESET AUTOSTART REQ
	LD	(AUTOST),A
	LD	(AUTOSTG),HL	;ADDRESS OF STRING WITH "RUN xxx" COMMAND

	LD	HL,OSC_A_TAB	;CLEAR OSCILL TABLE
	LD	B,TOTOSC
	XOR	A
CLROSC:	LD	(HL),A
	INC	HL
	DJNZ	CLROSC

	LD	HL,BRG_STUP	;SEE IF BAUD RATE GEN IS TO BE INITIALIZED
	LD	A,'C'
	CP	(HL)
	JR	NZ,CKSYSR	;NO CTC TO SET - JUMP

	LD	(TXA_CS),HL	;PRESET TXA_CS

	LD	D,'C'		;LOOK FOR A STANDARD CTC STRING
	LD	E,1		;STRING PRESENT TO AVOID ERROR
	CALL	TRIPLEX		;B=TABLE D=DATA

	LD	HL,OSC_A_TAB	;OPEN OSCILLATOR #1
	LD	(HL),D

	LD	C,D		;STARTUP TIMER

	LD	A,7
	OUT	(C),A

;--------------------------------------------------------------------------
;	CHECK SYS RECORD FOR A USER SPECIFIED BAUD RATE
;--------------------------------------------------------------------------

CKSYSR:	PUSH	BC

	LD	A,(STSYSF)	;SYS RECORD IS VALID?
	OR	A
	JR	Z,ROMVAL	;NO, USE STRING IN ROM

	LD	HL,(TXASYS)	;YES, USE SYS STORAGE
	LD	DE,BRGSTG
	CALL	CMPSTG		;"BAUDK:" RW?
	JR	NZ,ROMVAL	;NO, USE VALUE IN ROM

	INC	HL		;NOW POINTS TO ASCII VALUE
	LD	(TXA_CS),HL
	CALL	PARSE_CS
	CP	2		;EXIT CODE MEANS NUMERIC VALUE?
	JR	NZ,ROMVAL	;NO, USE VALUE IN ROM

	LD	A,B		;GET BAUD RATE CONST FROM SYS STORAGE
	POP	BC
	OUT	(C),A
	LD	HL,(TXA_CS)
	LD	(TXASYS),HL	;UPDATE TXA SYS
	JR	CKAUTO

ROMVAL:	POP	BC		;GET BAUD RATE CONST FROM ROM
	LD	A,(BRG_K)
	OUT	(C),A

;--------------------------------------------------------------------------
;	CHECK SYS RECORD FOR A USER SPECIFIED AUTOSTART ADDRESS
;--------------------------------------------------------------------------

CKAUTO:	LD	A,(AUTOST)	;AUTOSTART IS REQUESTED?
	CP	1
	RET	NZ		;NO, RETURN

	LD	A,(STSYSF)	;SYS RECORD IS VALID?
	OR	A
	RET	Z		;NO, RETURN

	LD	HL,(TXASYS)	;YES, USE SYS STORAGE
	LD	DE,AUTOSTR
	CALL	CMPSTG		;"AUTO:" RW?
	RET	NZ		;NO, RETURN
	INC	HL		;NOW POINTS TO STARTUP STRING
	LD	(AUTOSTG),HL	;SAVE THE ADDRESS OF THE STARTUP STRING
CKA1:	LD	A,(HL)
	CP	CR
	INC	HL
	JR	NZ,CKA1
	LD	(TXASYS),HL	;UPDATE TXA SYS
	RET


;--------------------------------------------------------------------------
;	OPEN INTERNAL DRIVERS
;--------------------------------------------------------------------------
INTERN_DR:
;--------------------------------------------------------------------------
;	OPEN TIMER
;--------------------------------------------------------------------------

;	E.G.: OPEN TIMER 1,"CTC 1 DATA 24"

	CP	TIMRW
	JP	NZ,OP_CNT
	LD	HL,VECTIMERS
	LD	DE,TIM_A_TAB
	JR	DO_CTC

VECTIMERS:
	DW	TSR1
	DW	TSR2
	DW	TSR3

;--------------------------------------------------------------------------
;	OPEN COUNTER
;--------------------------------------------------------------------------

;	E.G.: OPEN COUNTER 1,"CTC 1 DATA 24"


OP_CNT:	CP	PULSERRW
	JP	NZ,OP_OSC
	LD	HL,VECCOUNTERS
	LD	DE,CNT_A_TAB
	JR	DO_CTC

VECCOUNTERS:
	DW	CSR1
	DW	CSR2
	DW	CSR3

;--------------------------------------------------------------------------
;	OPEN OSCILLATOR
;--------------------------------------------------------------------------

;	E.G.: OPEN OSC 1,"CTC 1 DATA 24"

OP_OSC:	CP	OSCRW
	JP	NZ,E1
	LD	HL,VECOSCILLS
	LD	DE,OSC_A_TAB
	PUSH	DE		;SAVE X_A_TAB ADDRESS
	PUSH	HL		;SAVE VECTOR TO INSTALL ADRESS

	CALL	GCI		;EAT "TIMER", "COUNTER" ECC.

	CALL	BYTARG		;GET TIMER NUMBER
	LD	A,E

	CALL	CKOSCN		;RANGE 1-3
	JR	DO_CTC1

;	OSC'S USE INTERRUPTS ONLY IF USED FOR MMT
;	IN THIS CASE THERE IS JUST ONE SERVICE ROUTINE
;	ADD AN ENTRY FOR EACH OSCILLATOR
;	SE VAI OLTRE QUATTRO GUARDA COSA SUCCEDE COL CTC!

VECOSCILLS:
	DW	MMTSR
	DW	MMTSR
	DW	MMTSR
	DW	MMTSR

;--------------------------------------------------------------------------
;	DO_CTC - PROCESS A WHOLE OPEN TIMER/COUNTER
;--------------------------------------------------------------------------

;	CALL WITH HL=ADDRESS OF VECTORS TABLE TO BE PROGRAMMED
;		  DE=X_A_TAB ADDRESS (TABLE OF PHISICAL PORT ADDRESSES)

;	ALSO PROGRAMS THE CTC VECTOR

;	NO VALUE RETURNED

DO_CTC:
	PUSH	DE		;SAVE X_A_TAB ADDRESS
	PUSH	HL		;SAVE VECTOR TO INSTALL ADRESS

	CALL	GCI		;EAT "TIMER", "COUNTER" ECC.

	CALL	BYTARG		;GET TIMER NUMBER
	LD	A,E

	CALL	CK1_3		;RANGE 1-3

DO_CTC1:PUSH	AF

	CALL	EATCOM

	CALL	CONFISTR	;GET CONFIG STRING ADDRESS IN (TXA_CS)

	CALL	PARSEP		;GET CTC AND TABLE
	JP	NZ,E1		;PAIR IS FOUND AND VALID?

	LD	A,E		;KEY LETTER IS 'C' FOR CTC?
	CP	'C'
	JP	NZ,E1

	POP	AF		;TIMER # (B IS ALREADY REQ TABLE #)
	DEC	A
	POP	HL		;GET VECTOR TO INSTALL TABLE BASE ADDR
	PUSH	AF
	LD	E,A
	LD	D,0
	ADD	HL,DE
	ADD	HL,DE		;HL POINTS TO THE VECTOR TO INSTALL
	LD	E,1		;E=1=CTC
				;(B IS STILL TABLE #)
	CALL	INSTVEC
	OR	A
	JP	NZ,DRVERR

	POP	AF
	PUSH	BC		;C IS VECTOR FOR CTC CONTROL PORT
	PUSH	AF

	CALL	PARSEP		;GET DATA PORT ADDRESS
	JP	NZ,E1		;PAIR IS FOUND AND VALID?

	LD	A,E
	CP	'D'
	JP	NZ,E1		;KEY LETTER IS 'C' FOR CTC?
				;B HAS PORT #

	POP	AF		;TIMER # -1

	POP	DE		;REALLY THIS IS BC
	POP	HL		;PUSHED AS DE - X_A_TAB
	PUSH	DE		;BC RETURNS WHERE IT WAS

	LD	E,A
	LD	D,0
	ADD	HL,DE

	LD	A,(HL)
	OR	A
	JP	NZ,ALREOP	;IT WAS ALREADY OPEN?

	LD	(HL),B		;STORE TIMER ADDRESS

	LD	A,B

;	BUG TOLTO IN DATA 28/9/91 ERA:
;	AND	0F8H		;MAKE ADDRESS THE CONTROL PORT (INUTILE?)
;	ORA:

	AND	0FCH		;MAKE ADDRESS THE CONTROL PORT
	POP	BC		;C=VECTOR FOR THE DEVICE

	LD	B,C		;TEMPORARY STORAGE
	LD	C,A		;DEVICE ADDRESS
	LD	A,B		;VECTOR FOR THE DEVICE
	OUT	(C),A		;AND PROGRAM VECTOR INTO DEVICE
	RET

;	PARSE_CS - PARSES A CONFIG STRING

;	CAN PARSE A STRING, RETURNING THE LEADING CHAR
;	OR AN INTEGER VALUE, RETURNING A BYTE

;		   ON INPUT:
;			(TXA_CS) POINTS TO THE STRING TO PARSE
;		   ON OUTPUT:
;			(TXA_CS) UPDATED
;			ACC = 0 = END OF STRING - NO PARSE
;			ACC = 1 = PARSED A STRING
;			ACC = 2 = PARSED A BYTE VALUE
;			B   = PARSED VALUE (LEADING CHAR OR VALUE)

PARSE_CS:
	LD	HL,(TXA_CS)

PCS2:	LD	A,(HL)
	CP	' '		;SPECIAL CHARS
	JR	Z,PARSE_NXT
	CP	'"'
	JR	Z,NO_PARSE
	OR	A
	JR	Z,NO_PARSE

	AND	70H		;SEE IF A CHAR OR A DIGIT
	CP	30H
	LD	A,(HL)		;RESTORE CHAR
	JR	Z,PARSE_DIG

;	CHAR STRING

	LD	B,A		;SAVE LEADING CHAR
PCS3:	INC	HL
	LD	A,(HL)
	CP	' '		;SPECIAL CHARS
	JR	Z,PARSE_END_S
	CP	'"'
	JR	Z,PARSE_END_S
	OR	A
	JR	Z,PARSE_END_S
	JR	PCS3

PARSE_NXT:
	INC	HL
	LD	(TXA_CS),HL
	JR	PCS2

PARSE_END_S:
	LD	(TXA_CS),HL
	LD	A,1		;B HAS CHAR
	RET

PARSE_DIG:
	LD	HL,(TXA)	;USE BYTARG TO DO THE JOB
	PUSH	HL		;SAVE CURRENT TXA

	LD	HL,(TXA_CS)	;SET TXA TO TXA_CS
	LD	(TXA),HL

	CALL	BYTARG

	LD	HL,(TXA)	;UPDATE TXA_CS WITH NEW VALUE
	LD	(TXA_CS),HL

	POP	HL		;RESTORE TXA
	LD	(TXA),HL

	LD	B,E		;PARSED VALUE
	LD	A,2		;2=NUM VALUE
	RET

NO_PARSE:
	LD	A,0
	RET

;--------------------------------------------------------------------------
;	'CLOSE' - MAKE FREE A DIRECTORY ENTRY
;--------------------------------------------------------------------------
CLOSE:	CALL	GCI		;EAT "CH" OR OTHER RW

	CP	CHRW
	JR	Z,CLOCH

	CP	OSCRW
	JR	Z,CLOOSC

	CP	TIMRW
	JR	Z,CLOTIM

	JP	E1

CLOOSC:	LD	HL,OSC_A_TAB
	JR	CLOTOSC

CLOTIM:	LD	HL,TIM_A_TAB
CLOTOSC:PUSH	HL
	CALL	BYTARG		;DEVICE #
	LD	A,E
	CALL	CK1_3		;CHECK NUMBER
	DEC	A
	POP	HL
	LD	D,0
	LD	E,A
	ADD	HL,DE
	XOR	A		;MARK AS FREE
	LD	(HL),A
	RET


CLOCH:	CALL	BYTARG		;GET FILE NUMBER
	LD	A,E
	PUSH	AF

	CP	MAXFILES
	JP	NC,PDERR

	CALL	TESTOPEN	;TEST IF FILE IS ALREADY OPEN

	JP	Z,NOTOP		;FILE NOT OPEN

	POP	AF		;FILE #
	PUSH	AF

	LD	C,A		;FILE #
	LD	B,3		;CLOSE
	CALL	DRIVER
	OR	A
	JP	NZ,DRVERR

	POP	AF
	CALL	DIRENTRY
	INC	HL
	INC	HL
	XOR	A
	LD	(HL),A
	RET

;--------------------------------------------------------------------------
;	ADD - somma direttamente un'espressione ad una variabile
;--------------------------------------------------------------------------
;	n.b. e' pensata per la velocita' - esegue pochissimi controlli

ADD2:	CALL	VARX	;CHECK FOR VARIABLE
	JP	C,E1
	PUSH	HL	;SAVE VALUE ADDRESS
	CALL	EATCOM
	CALL	EXPRB	;ADDENDO

;	copia valore variabile in FTEMP
	POP	HL
	PUSH	HL
	LD	DE,FTEMP
	CALL	VCOPY

	LD	HL,FTEM1
	CALL	POPAS

	LD	HL,FTEM1
	LD	DE,FTEMP
	POP	BC		;indirizzo della variabile (dest)
	CALL	FADD
	RET

;--------------------------------------------------------------------------
;	'WRITEC' - WRITE A CHAR TO A FILE
;--------------------------------------------------------------------------
;	WRITEC CH driver, char

WRITEC:	CALL	GC
	CP	CHRW
	JP	NZ,E1

	CALL	GCI		;EAT CH RW
	CALL	BYTARG		;GET FILE NUMBER
	LD	A,E
	PUSH	AF

	CALL	EATCOM		;EAT COMMA
	CALL	GC

	CALL	BYTARG		;VALUE TO OUT INTO DE

;	CALL DRIVER NOW

	POP	AF
	LD	C,A		;C  - CHANNEL NUMBER
	LD	B,4		;B  - OPERATION CODE 4 (FOR WRITE CH)

	CALL	DRIVER		;DOES WHAT DRIVER WANTS

	RET


;--------------------------------------------------------------------------
;	'WRITE' - WRITE A RECORD TO A FILE
;--------------------------------------------------------------------------

;	NEW VERSION FOR USE WITH FDM

WRITE:	LD	A,(LOGDEVO)	;SAVE LOGDEVO
	PUSH	AF

	LD	A,77H		;77 MEANS TO (RECO_PO)
	LD	(LOGDEVO),A

	LD	HL,DMAREA
	LD	(RECO_PO),HL

	CALL	GC
	CP	CHRW
	JP	NZ,E1

	CALL	GCI		;EAT CH RW
	CALL	BYTARG		;GET FILE NUMBER
	LD	A,E
	PUSH	AF

	CALL	EATCOM		;EAT COMMA
	CALL	EXPRB		;GET RECORD NUMBER
	CALL	PFIX
	PUSH	DE

	CALL	EATCOM		;EAT COMMA
	CALL	GC

FILEPRINT:

	CP	EQRW		;NO-CONVERSION INTEGER WRITE?
	JR	Z,INTWRI

	CP	CR		;STAND ALONE PRINT
	JP	Z,E1		;NOT ALLOWED

;--------------------------------------------------------------------------
;	ASCII FILE PRINT - NUMERIC VALUES ARE CONVERTED TO STRING
;	BEFORE CALLING THE DRIVER

	CALL	EXPRB		;MUST BE EXPRESSION TO PRINT
	CALL	TSTST
	JP	Z,NOPSTRF
	CALL	PSTR		;PRINT A STRING
	JP	PRF1

;	COME HERE TO PRINT A NUMERIC VALUE

NOPSTRF:LD	DE,FPSINK
	CALL	POPA1		;POP VALUE TO FPSINK
	LD	HL,FPSINK
	CALL	FPOUT

;	COMMON PART FOR NUMERIC OR STRING FILE PRINT

PRF1:	CALL	GC		;GET DELIMITER
	CP	CR		;END OF FIELDS
	JR	Z,PROCREC
	CP	','		;ONLY COMMA IS ALLOWED
	JR	Z,NXT_FIELD
	JP	E1

NXT_FIELD:
	CALL	CHOUT		;OUTPUT SEPARATOR
	CALL	GCI		;EAT COMMA
	CALL	GC
	JP	FILEPRINT

;--------------------------------------------------------------------------
;	NO-CONVERTED INTEGER WRITE - EXPRESSION IS EVALUATED AND
;	THE RESULT IS PASSED TO THE DRIVER BY HL

INTWRI:	CALL	GCI		;'='
	CALL	EXPRB
	CALL	PFIX
	EX	DE,HL		;PUT THE VALUE INTO HL
	JR	PROCR2

;--------------------------------------------------------------------------
;	NOW PROCESS RECORD CALLING DRIVER

PROCREC:LD	B,0		;ADD TERMINATOR
	CALL	CHOUT		;AND PROCESS RECORD
	LD	HL,DMAREA	;HL - POINTS TO BUFFER WHERE RECORD IS

PROCR2:	POP	DE		;DE - RECORD NUMBER
	POP	AF
	LD	C,A		;C  - CHANNEL NUMBER
	LD	B,0		;B  - OPERATION CODE 0 (FOR WRITE)

	CALL	DRIVER		;DOES WHAT DRIVER WANTS

	POP	AF		;RESTORE LOGDEVO
	LD	(LOGDEVO),A
	RET

;--------------------------------------------------------------------------
;	DRIVER CALLER
;--------------------------------------------------------------------------

;	CALLS THE DRIVER WHOSE FILE # IS IN C
;	IF FILE IS NOT OPEN JUMPS TO ERROR

DRIVER:	PUSH	HL		;SAVE HL, BC, DE FOR THE DRIVER ITSELF
	PUSH	DE
	PUSH	BC

	CALL	DRADDR		;GET DRIVER ADDRESS INTO IY

	POP	BC
	POP	DE
	POP	HL

	LD	IX,DRVRET	;PRESET RETURN ADDRESS
	PUSH	IX
	LD	IX,(FNAME)	;ONLY FOR OPEN
	INC	IX		;FILENAME ADDRESS (FMS)

	JP	(IY)

;	DRIVER RETURNS HERE

DRVRET:	OR	A		;TEST FOR ANY DRIVER ERROR
	JP	NZ,DRVERR
	RET

;--------------------------------------------------------------------------
;	'READ'
;--------------------------------------------------------------------------

READ:	CALL	GC
	CP	CHRW		;'CH' FOLLOWS?
	JP	NZ,NORMREA	;NO, JUMP TO 'READ FROM DATA'

;--------------------------------------------------------------------------
;	'READ FROM CH' - READS FROM A DRIVER OR A FILE
;--------------------------------------------------------------------------

	CALL	GCI		;EAT CH RW
	CALL	BYTARG		;GET FILE NUMBER
	LD	A,E
	PUSH	AF

	CALL	EATCOM		;EAT COMMA
	CALL	EXPRB		;GET RECORD NUMBER
	CALL	PFIX		;DE - RECORD NUMBER

	POP	AF
	LD	C,A		;C  - CHANNEL CODE
	LD	HL,DMAREA	;HL - POINTS TO BUFFER WHERE TO PUT RECORD
	LD	(RECO_PO),HL	;USED LATER BY LDEVIN (SERVE ANCORA?-10/7/92)

;	MODIFICA SPERIMENTALE 10/7/92 - SPOSTATA LA PUSH HL (ERA DOPO LA
;	CHIAMATA AL DRIVER) PER IMPEDIRE AL DRIVER DI DANNEGGIARLO

	PUSH	HL		;SAVE ADDRESS OF SOURCE DATA OR READ VALUE

	LD	B,1		;B  - OPERATION CODE 1 (FOR READ)
	CALL	DRIVER		;DOES WHAT DRIVER WANTS

	OR	A
	JP	NZ,DRVERR

	PUSH	HL
	CALL	EATCOM		;AFTER THIS COMMA THE VAR NAME FOLLOWS

	CALL	GC
	CP	EQRW		;DOES '=' FOLLOW?
	POP	HL
	JR	NZ,STREAD

;	INTEGER VALUE READ

	POP	DE
	PUSH	HL
	CALL	GCI		;EAT '='

	CALL	VARX		;CHECK FOR VARIABLE
	JP	C,E1

	CALL	TSTST		;CHECK FOR STRING
	JP	NZ,E19		;NOT ALLOWED

	POP	DE		;PUSHED AS HL - READ VALUE
	PUSH	HL		;SAVE ADDRESS OF THE VARIABLE

	EX	DE,HL		;READ VALUE IN HL
	CALL	ACALX		;PUSH IT ON THE STACK

	POP	DE		;DESTINATION ADDRESS
	CALL	POPA1		;COPY EXPRESSION VALUE TO VARIABLE
	RET

;	STRING READ

STREAD:	CALL	VARX		;READ VAR ADDRESS INTO HL
	JP	C,E1

	POP	DE		;SOURCE ADDR IN DE (PUSHED AS HL)

;	MODIFICA SPERIMENTALE 18/11/91 - NON USA INPUT MA COPIA DIRETTAMENTE
;	CORRETTA PER BUG 19/12/91

RDLOP:	LD	A,(DE)		;COPY THE STRING
	LD	(HL),A

	OR	A		:MOD. 14/2/93 - ACCETTA ANCHE NULL COME TERMIN.
	JR	Z,QRDL

	CP	CR		;CR COPYED LAST? EXIT
	JR	Z,QRDL

	INC	HL
	INC	DE

	JR	RDLOP

QRDL:	XOR	A		;SOSTITUISCI TERMINATORE
	LD	(HL),A
	RET


;	LD	A,77H		;77H MEANS FROM (HL)
;	LD	(LOGDEVI),A

;	JP	IREAD		;GO AS NORMAL INPUT

;--------------------------------------------------------------------------
;	'READ FROM DATA' - READS FROM A 'DATA' STATEMENT
;--------------------------------------------------------------------------

NORMREA:CALL	DIRT
	LD	HL,(TXA)
	PUSH	HL	;SAVE TXA TEMPORARILY
	LD	HL,(RTXA);THE 'READ' TXA
READ0:	LD	(TXA),HL
	CALL	GCI
	CP	','
	JP	Z,READ2	;PROCESS INPUT VALUE
	CP	DATARW
	JP	Z,READ2
	DEC	A
	JP	Z,READ4
;
;	SKIP TO NEXT LINE
;
	CALL	REM	;LEAVES ADDR OF LAST CR IN HL
	INC	HL
	LD	A,(HL)
	DEC	A
	JP	Z,READ4
	INC	HL
	INC	HL
	INC	HL	;HL NOW POINTS TO FIRST BYTE OF NEXT LINE
	JP	READ0
;
;	PROCESS VALUE
;
READ2:	CALL	EXPRB
	CALL	GC
	CP	','	;SKIP JOE TEST IF COMMA
	JP	Z,READ3
;
;	JUNK ON END TEST
;
	CALL	JOE
READ3:	LD	HL,(TXA)
	LD	(RTXA),HL;SAVE NEW 'READ' TEXT ADDR
	POP	HL
	LD	(TXA),HL
	CALL	VARX
	JP	C,E1
	CALL	POPAS	;PUT READ VALUE INTO VARIABLE
	CALL	GC
	CP	','	;CHECK FOR ANOTHER VARIABLE
	RET	NZ
	CALL	GCI	;EAT THE COMMA
	JP	NORMREA
;
READ4:	POP	HL	;PROGRAM TXA
	LD	(TXA),HL
	JP	READERR




;--------------------------------------------------------------------------
;	'CH' - SET INTERRUPT LEVEL
;--------------------------------------------------------------------------
DOCH:	LD	A,1
	LD	(PRIVIL),A
	CALL	BYTARG		;GET CHANNEL #
	LD	A,E
	PUSH	AF

	LD	B,TORW		;EAT 'TO'
	CALL	EATC

	LD	B,INTRW		;EAT 'INTERRUPT'
	CALL	EATC

	POP	AF
	CALL	DIRENTRY

	INC	HL
	INC	HL
	LD	A,(HL)
	OR	A
	JP	Z,NOTOP		;FILE HAS TO BE OPEN

	INC	HL		;HL TO INT LEV FIELD OF DIR TAB
	PUSH	HL

	CALL	BYTARG
	POP	HL
;	CP	MAXLEV+1	;GIA' CONTROLLATO DA ISRX2
;	JP	NC,E3
	LD	(HL),E
	RET


;--------------------------------------------------------------------------
;	'REM' - SEE 'DATA'
;--------------------------------------------------------------------------


;--------------------------------------------------------------------------
;	'RESTORE'
;--------------------------------------------------------------------------
;
RESTOR:	LD	HL,(BOFA);BEGINNING OF FILE POINTER
	INC	HL
	INC	HL
	INC	HL
	LD	(RTXA),HL
	RET

;--------------------------------------------------------------------------
;	'RETURN'
;--------------------------------------------------------------------------

RETRN:	CALL	GC

	CP	CR		;END OF LINE?
	JP	Z,GSBRET	;NORMAL GOSUB RETURN

	CP	CLRRW		;CLEAR RW?
	JP	Z,RETCLR	;JUST POP A RETURN ADDRESS FROM THE STACK

	PUSH	HL
	CP	INTRW		;INTERRUPT RW?
	JR	Z,RETINT	;RETURN FROM AN INTERRUPT ISR

	CP	TIMRW		;TIMER RW?
	JR	Z,RETIM		;RETURN FROM A TIMER ISR

	JP	E1		;SINTAX ERROR

;	RETURN FROM A TIMER ISR

RETIM:	CALL	GCI
	CALL	BYTARG		;GET TIMER # FROM WHICH RETURN
	LD	A,E
	CALL	CK1_3		;RANGE 1-3
	ADD	A,5		;REPORT TO EFFECTIVE INT#
	LD	E,A
	JR	RETU1

;	RETURN FROM AN INTERRUPT ISR

RETINT:	CALL	GCI
	CALL	BYTARG		;GET INT # FROM WHICH RETURN
	LD	A,E
	OR	A		;CHECK RANGE
	JP	M,E9C
	CP	5
	JP	NC,E9C

;	COMMON PART FOR TIMER OR INTERRUPT ISR RETURN

RETU1:	LD	D,0
	CALL	SETIX		;LOCATE IN TABINT
	INC	IX
	INC	IX
	INC	IX		;POINT TO STATUS
	LD	A,(IX+0)

	CP	0		;STATUS 'INACTIVE'?
	JP	Z,E19		;INTERRUPT ERROR

	CP	1		;STATUS 'PRESET'?
	POP	HL
	JP	Z,GSBRET	;DO NOTHING

	LD	A,(MIDDLE)	;WAS IT A MIDDLE-STATEMENT CALL?
	OR	A
	LD	A,0		;PREPARE FLAG FOR NORMAL RET
	JR	Z,RETU2

	INC	A		;SPECIAL MIDDLE-OF-STATEMENT RETURN

RETU2:	LD	(SPECRET),A

	LD	A,1		;NOW IT MUST TO BE IN 'ON SERVICE' STATUS
	LD	(IX+0),A	;RESET STATUS TO 'PRESET'
	LD	(INT_ENA),A	;RE ENABLE INTERRUPTS

	CALL	POPIGN		;RESTORE 'IGNORE' FLAG STATE SAVED ON INT SERV

;	NORMAL RETURN FROM GOSUB - USED ALSO FOR ANY ISR

GSBRET:	CALL	DIRT
	LD	(DIRF),A	;CLEARS DIRF IF ACC IS CLEAR
	LD	HL,(CSTKA)
RET1:	LD	A,(HL)
	OR	A		;CHECK FOR STACK EMPTY
	JP	Z,E4C
	CP	GTYPE		;CHECK FOR GOSUB TYPE
	JP	Z,RET2

;	REMOVE ANY 'FOR' TYPE ENTRY FROM THE STACK
;	(THIS IS USEFUL IF AN USER DO 'RETURN' FROM INSIDE A FOR/NEXT LOOP)

	LD	DE,FORSZ
	ADD	HL,DE
	JP	RET1

;	FOUND A GTYPE STACK ENTRY

RET2:	INC	HL
	LD	E,(HL)		;LOW ORDER TEXT ADDR
	INC	HL
	LD	D,(HL)		;HIGH ORDER TEXT ADDR

	INC	HL		;ADDR OF PREVIOUS CONTROL STACK ENTRY
	LD	(CSTKA),HL	;UPDATE CSTKA

	LD	A,(SPECRET)	;RETURN FROM A MIDDLE-OF-STATEMNT INT?
	OR	A
	JR	NZ,MIDRET	;YES, JUMP

	EX	DE,HL		;PUT RETURN TEXT ADDR IN HL
	LD	A,(HL)		;ADDR POINTS TO EOF IF GOSUB WAS LAST LINE
	DEC	A		;END OF FILE?
	JP	NZ,NEXT4	;NO, JUMP

	JP	CEND

MIDRET:	XOR	A		;RESET FLAG
	LD	(SPECRET),A
	POP	HL		;DUMMY FOR THE CALL TO 'RETURN'
	RET			;EXIT CALL TO ILOOP

;	RETURN CLEAR - POPS AN ENTRY FROM THE STACK

RETCLR:	CALL	GCI		;EAT 'CLEAR' RW
	LD	HL,(CSTKA)
	LD	A,(HL)
	OR	A		;EMPTY STACK?
	JP	Z,E4C
	CP	GTYPE
	JP	NZ,E4C		;RETURN SENZA GOSUB
	INC	HL
	INC	HL
	INC	HL
	LD	(CSTKA),HL
	RET

;--------------------------------------------------------------------------
;	'RUN'
;--------------------------------------------------------------------------

CRUN:	CALL	CCLEAR
	PUSH	HL
	LD	HL,MEMTOP+2	;RESTORE BOFA TO RAM IF MODIFIED
	LD	(BOFA),HL
	POP	HL
	CALL	GC
	CP	CR		;RUN A ROM PROGRAM?
	JR	Z,CRUN01
	CALL	EXPRB		;YES
	CALL	PFIX
	LD	(BOFA),DE
	LD	A,1
	JR	CRUN02

CRUN01:	XOR	A
CRUN02:	LD	(ROEXFG),A	;RES/SET FLAG FOR EXECUTION IN RAM/ROM
	LD	HL,(BOFA)
	LD	A,(HL)
	DEC	A		;CHECK FOR NULL PROGRAM
	JP	Z,CEND
	INC	HL
	INC	HL
	INC	HL
	LD	(TXA),HL
	LD	(RTXA),HL	;POINTER FOR 'READ' STATEMENT
	XOR	A
	LD	(DIRF),A	;CLEAR DIRECT FLAG AND GO TO EXECUTE STATMTS_
	LD	A,(AUTOST)
	OR	A
	JP	NZ,INTERPR
	CALL	CRLF
	JP	INTERPR

	IF	MPAGE
;
;--------------------------------------------------------------------------
;	'CHAIN'
;--------------------------------------------------------------------------
;
CHAIN:
	CALL	INTGER		;GET LINE NUMBER
	PUSH	HL

	LD	B,','
	CALL	EATC
	CALL	BYTARG
	PUSH	DE		;SAVE PAGE #

	LD	B,','
	CALL	EATC
	CALL	INTGER		;GET ADDRESS
	EX	DE,HL

	LD	(BOFA),DE
	LD	HL,(BOFA)
	LD	A,(HL)
	DEC	A		;CHECK FOR NULL PROGRAM
	JP	Z,CEND

	POP	DE

	IF	PUMAKEY
	LD	A,E		;GET PAGE #
	OR	A
	JR	NZ,PAGE2
	OUT	(PAGEB),A
	JR	ANYPAGE
PAGE2:	OUT	(PAGEX),A
ANYPAGE:
	ENDIF


	IF	FMD
	LD	A,E		;GET PAGE #
	OR	A
	JR	NZ,PAGE2
	LD	A,PAGEB		;BASE PAGE
	JR	ANYPAGE

PAGE2:	LD	A,PAGEX		;EXTENDED PAGE

ANYPAGE:SET	KILBIT,A	;RISPETTA KILBIT
	OUT	(PGPORT),A
	ENDIF

	POP	DE		;GET LINE #
	CALL	FINDLN
	INC	HL
	INC	HL
	INC	HL
	LD	(TXA),HL
	JP	INTERPR
	ELSE
CHAIN:	RET
	ENDIF

;--------------------------------------------------------------------------
;	'SIOSET' - SET SIO PARAMETERS
;--------------------------------------------------------------------------

;	FORMAT:
;		SIOSET <CTLP>,<#DATABITS>,<PARITY>,<#STOPBITS>

;	<CTLP>		- CONTROL PORT ADDRESS
;	<#DATABITS> 	- 7 OR 8
;	<PARITY>	- 0=NONE 1=ODD 2=EVEN
;	<#STOPBITS>	- 1 OR 2


SIOSET:	CALL	GC
	CP	CHRW		;CH RW?
	JR	NZ,SIOABS	;NO, JUMP FOR AN ABSOLUTE ADDRESS

	CALL	GCI		;EAT 'CH'
	CALL	BYTARG		;GET CHANN # INTO E
	PUSH	DE		;SAVE DRIVER #
	LD	C,E
	LD	E,0		;REQUEST MAIN SIO CONTROL PORT #
	LD	B,7		;DRIVER FUNCT #7 INFO(E)
	CALL	DRIVER
	JR	SIOSET0		;AND GO ON WITH E=PHISICAL PORT #


SIOABS:	CALL	BYTARG		;GET PORT ADDRESS
SIOSET0:LD	C,E

;	SET 7 / 8 DATA BITS

	PUSH	BC
	LD	B,','
	CALL	EATCOM
	CALL	BYTARG		;GET # OF DATA BIT
	LD	A,E
	POP	BC		;GET BACK PORT ADDRESS
	CP	7
	JR	Z,SEVNBIT
	CP	8
	JR	Z,EIGTBIT
	JP	E3		;VAL ERROR

SEVNBIT:LD	A,41H		;7 BIT - NO AUTO - RX ENA
	LD	(TEMP3),A

	LD	A,2AH		;NO DTR - 7 BIT - TX ENA - RTS

	JR	SIOSET1

EIGTBIT:LD	A,0C1H 		;7 BIT - NO AUTO - RX ENA
	LD	(TEMP3),A

	LD	A,6AH		;NO DTR - 7 BIT - TX ENA - RTS

SIOSET1:LD	(TEMP5),A

;	SET PARITY

	PUSH	BC
	LD	B,','
	CALL	EATCOM
	CALL	BYTARG		;GET PARITY CODE
	LD	A,E
	POP	BC		;GET BACK PORT ADDRESS
	CP	0
	JR	Z,NOPAR
	CP	1
	JR	Z,PARODD
	CP	2
	JR	Z,PAREVE
	JP	E3		;VAL ERROR

NOPAR:	LD	D,0		;PREPARE VALUE FOR REG #4
	JR	SIOSET2

PARODD:	LD	D,1
	JR	SIOSET2

PAREVE:	LD	D,3
SIOSET2:PUSH	DE


;	SET 1 / 2 STOP BITS

	PUSH	BC
	LD	B,','
	CALL	EATCOM
	CALL	BYTARG		;GET PARITY CODE
	LD	A,E
	POP	BC		;GET BACK PORT ADDRESS
	POP	DE		;AND PRESET VALUE FOR REG #4
	CP	0
	JR	Z,ONESTP
	CP	1
	JR	Z,TWOSTP
	JP	E3		;VAL ERROR

ONESTP:	LD	A,44H		;ONE STOP BIT
	JR	SIOSET3

TWOSTP:	LD	A,04CH		;TWO STOP BIT
SIOSET3:OR	D
	LD	(TEMP4),A	;SET REG. #4

;	CALL DRIVER TO SET NEW VALUES

	POP	DE		;E=DRIVER #
	LD	C,E

	LD	A,(TEMP3)
	LD	D,A

	LD	A,(TEMP4)
	LD	E,A

	LD	A,(TEMP5)
	LD	H,A

	LD	B,SETSIO        ;B=FUNCTION CODE
	CALL	DRIVER

	RET

;--------------------------------------------------------------------------
;	'SAVE'
;--------------------------------------------------------------------------

CSAVE:	CALL	GC

	CP	ABSRW
	JP	Z,NEWSVE

	JP	E1

;	DOES AN ABSOLUTE SAVE TO THE SPECIFIED LOC
;	THE USER MUST BE CAREFUL AND NOT OVERLAP AREAS USED FOR OTHER
;	PURPOSES

NEWSVE:	CALL	GCI		;EAT THE 'ABS'
	CALL	EXPRB		;GET DEST ADDRESS
	CALL	PFIX
	LD	A,D		;NOVRAM AREA TEST FOR SLOW-DOWN
	CP	0C0H
	JP	NC,SVEEPR
	CALL	NEWSV1		;PRESET REGISTERS
	LDIR
	RET
;
;	UTILITY ROUTINE - LEAVES DE=DEST ADDRESS
;			  EXITS WITH HL=(BOFA) AND BC=PROGRAM LENGHT
;
NEWSV1:	PUSH	DE
	OR	A		;CLEAR CARRY
	LD	HL,(EOFA)
	LD	DE,(BOFA)
	SBC	HL,DE
	INC	HL
	PUSH	HL
	POP	BC		;BC CONTAINS # OF BYTES
	LD	HL,(BOFA)	;SOURCE ADDRESS
	POP	DE		;RESTORE DEST ADDRESS
	RET

SVEEPR:	CALL	NEWSV1		;PRESET REGISTERS
EELOP:	LD	A,(HL)
	LD	(DE),A
	CALL	EEWAIT		;WAIT FOR NOVRAM PROGRAMMED
	INC	HL
	INC	DE
	DEC	BC
	LD	A,B
	CP	0
	JR	NZ,EELOP
	LD	A,C
	CP	0
	JR	NZ,EELOP
	RET
;
;	USED FOR NOVRAM WRITE DELAY
;
EEWAIT:	PUSH	AF

	LD	A,(RITARDO1)
	OR	A
	JR	NZ,EEWT4	;NO WAIT - NOVRAN IS RAM AND NOT EPROM

	POP	AF
	RET

EEWT4:	PUSH	BC

EEWT1:	LD	A,(RITARDO1)
	LD	C,A

EEWT3:	LD	B,0FFH
EEWT2:
	DEC	B
	JP	NZ,EEWT2
	DEC	C
	JP	NZ,EEWT3
	POP	BC
	POP	AF
	RET


;	'PUSH' - PUSHES A STRING ONTO THE USER STRING STACK

SPUSH:	CALL	VARX
	JP	C,E1
	CALL	TSTST
	JP	Z,E19
	CALL	EFFLEN
	LD	B,0		;HL HAS VARIABLE ADDRESS - BC LENGHT
	CALL	PSH_USTK	;PUSH
	RET

;	'POP' - POP A STRING FROM THE USER STRING STACK

SPOP:	CALL	VARX
	JP	C,E1
	CALL	TSTST
	JP	Z,E19
	PUSH	HL
	LD	HL,(USP_RD)	;POINT TO ENTRY LENGH LSBYTE
	LD	A,C		;C IS STRING ALLOWABLE SPACE
	CP	(HL)
	JP	C,E19
	POP	DE		;PUSHED AS HL
	CALL	POP_USTK
	RET



;
;--------------------------------------------------------------------------
;	'STORAGE' - SET POINTER TO MEMORY #
;--------------------------------------------------------------------------
;
MEM:	CALL	GC
	CP 	EQRW
	JP	Z,STORLEN	;SET SINGLE STORAGE LENGHT
	CP	GT_RW
	JP	Z,STORREAD
	CP	LT_RW
	JP	Z,STORSTOR
	CP	ABSRW
	JP	Z,STBUFST	;SET BUFFER START ADDRESS (FOR USAGE WITH
				;CH1 INPUT)

	CP	SYSRW		;"SYS" STORAGE?
	JR	NZ,MEM1
	CALL	GCI		;EAT SYS RW
	LD	HL,STSYS	;SET SAPOINT TO SYS AREA
	JR	MEMLP1

MEM1:	LD	A,1		;MODIF.22/12/91 - UPGRADED TO PRIVILEGED
	LD	(PRIVIL),A

	CALL	EXPRB		;GET STORAGE #
	CALL	PFIX
	PUSH	DE
	POP	BC		;COPY STORAGE# TO BC
	LD	HL,(DKBASE)	;BASE OF NOVRAM TABLE
	LD	A,(STORELEN)
	LD	D,0		;DE = LENGHT OF STORE
	LD	E,A
				;BC HAS COPY OF STORAGE #
	XOR	A
	CP	B
	JR	NZ,MEMLP	;STORAGE 0 REQUESTED?
	CP	C		;YOU HAVE ALREADY THE RIGHT ADDRESS - JUMP
	JR	Z,MEMLP1

MEMLP:	ADD	HL,DE		;COME HERE ONLY IF BC<>00
	DEC	BC		;AND COMPUTE HL=HL+DE*BC
	LD	A,B
	OR	C
	JR	NZ,MEMLP

MEMLP1:	LD	(SAPOINT),HL
	CALL	GC
	CP	CR
	RET	Z
	LD	B,','
	CALL	EATC
	CALL	GC
	CP	LT_RW		;'<' STORE DIRECT FP VALUE
	JR	Z,STORSTOR	;STORE VALUE
	CP	GT_RW		;'>' READ DIRECT FP VALUE
	JR	Z,STORREAD	;READ VALUE
	JP	E1

;	COME HERE TO PROCESS A STORAGE WRITE IN QUICK MODE
;	DATA ARE STORED BACKWARD DOWN FROM THE TOP OF THE STORAGE AREA

STORSTOR:
	CALL	GCI
	LD	DE,(SAPOINT)
	LD	HL,(STORELEN)	;START FROM END OF STORAGE

	LD	H,0		;NEL RESTO DEL PROGRAMMA PER ORA
				;STORELEN E' CONSIDERATO AD 8 BIT, NON A 16
	DEC	HL
	ADD	HL,DE		;BECAUSE FP VALUES ARE THREATED BACKWARD
	EX	DE,HL		;DE HAS TOP OF STORAGE ADDRESS NOW

STORST1:PUSH	DE
	CALL	VARX		;CHECK FOR VARIABLE
	JP	C,E1
	CALL	EFFLEN		;ERA TSTST
	JP	NZ,STSTG	;GO TO PROCESS STRING

	POP	DE		;PROCESS NUMERIC VARIABLE

	CALL	VCOPY		;COPY SPECIFIED VAR TO STORAGE
				;DE DECREMENTED DOWN TO TOP OF THE FREE
				;AREA FOR THE NEXT VARIABLE

STORQ:	CALL	GC
	CP	CR
	RET	Z
	LD	B,','		;NO CHECK IS DONE FOR OVERFLOW
	CALL	EATC		;SO THAT USER CAN COMBINE STORAGES
	JR	STORST1

STSTG:	POP	DE		;HL=STRING ADDRESS - C = STRING LENGHT
	CALL	REVCPY1		;COPY BACKWARD
	XOR	A		;ADD TERMINATOR
	LD	(DE),A
	DEC	DE
	JR	STORQ

STORREAD:
	CALL	GCI
	LD	DE,(SAPOINT)
	LD	HL,(STORELEN)	;START FROM END OF STORAGE
	LD	H,0		;NEL RESTO DEL PROGRAMMA PER ORA
				;STORELEN E' CONSIDERATO AD 8 BIT, NON A 16
	DEC	HL
	ADD	HL,DE		;BECAUSE FP VALUES ARE THREATED BACKWARD
	EX	DE,HL		;DE HAS TOP OF STORAGE ADDRESS NOW
STORRD1:
	PUSH	DE
	CALL	VARX		;CHECK FOR VARIABLE
	JP	C,E1
	CALL	TSTST
	JP	NZ,RDSTG
	POP	DE

	EX	DE,HL		;DIRECTION OF COPY IS FROM HL TO DE
	CALL	VCOPY		;COPY STORAGE TO SPECIFIED VAR
	EX	DE,HL
READQ:	CALL	GC
	CP	CR
	RET	Z
	LD	B,','		;NO CHECK IS DONE FOR OVERFLOW
	CALL	EATC		;SO THAT USER CAN COMBINE STORAGES
	JR	STORRD1

STORLEN:CALL	GCI		;EAT '='
	CALL	BYTARG
	LD	A,E
	LD	(STORELEN),A
	RET

STBUFST:CALL	GCI
	CALL	INTGER
	LD	(UBUPO),DE
	LD	HL,0		;DONT CHECK ANY LIMIT
	LD	(MAXBUF),HL
	RET

RDSTG:	POP	DE		;HL=STRING ADDRESS
	CALL	REVCPY2
	DEC	DE
	JR	READQ
;
;--------------------------------------------------------------------------
;	'STOP'
;--------------------------------------------------------------------------
;
STOP:	CALL	DIRT
STOP1:	CALL	GC
	CP	ERRRW
	JR	NZ,NORMSTP
	CALL	CRLF2
	LD	A,(ERRCON)
	LD	(IBYTE),A
	LD	(OBYTE),A
	LD	A,3
	LD	(LOGDEVO),A
	LD	HL,BRKMSG
	JR	TOERM1

NORMSTP:CALL	CRLF2
	LD	HL,STOPS
TOERM1:	JP	ERM1



;--------------------------------------------------------------------------
;	DATE@	(AS A STATEMENT) SET M3003 DATE
;--------------------------------------------------------------------------

DATE@SET:
	LD	E,2
	JR	TDSET

;--------------------------------------------------------------------------
;	TIME@	(AS A STATEMENT) SET CLOCK TIME
;--------------------------------------------------------------------------

TIME@SET:
	LD	E,1
TDSET:	PUSH	DE
	LD	B,'$'
	CALL	EATC
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB		;GET LENGHT AND ADDRESS OF THE TIME STRING
	CALL	EFFLEN		;LOOK FOR ERRORS
	JP	Z,E19
	LD	A,8
	CP	C
	JP	NZ,E19

	PUSH	HL		;STRING ADDRESS

	LD	B,')'
	CALL	EATC

	LD	A,(CLKBYTE)
	CP	0FFH
	JP	Z,NOTOP
	LD	C,A		;CH #

	POP	HL		;STRING ADDRESS
	POP	DE		;E=TIME OR DATE
	LD	B,0		;BLOCK WRITE
	CALL	DRIVER
	RET


;--------------------------------------------------------------------------
;	'RESET'
;--------------------------------------------------------------------------
;
VRESET:
	CALL	GC
	CP	PULSERRW	;RESET A COUNTER
	JP	Z,RESPULS

	CP	INTRW		;RESET INTERRUPT
	JP	Z,RESINTERR

	CP	OSCRW		;RESET AN OSCILLATOR
	JR	Z,RESOSC

	CP	TIMRW		;RESET A TIMER
	JP	Z,RESETIM

	JP	E1

;--------------------------------------------------------------------------
;	RESET A TIMER
;--------------------------------------------------------------------------

RESETIM:CALL	GCI
	CALL	BYTARG		;GET TIMER #
	LD	A,E
	CALL	CK1_3		;RANGE 1-3
	PUSH	DE
	LD	C,E		;TIMER #
	LD	A,3		;RESET CTC
	CALL	WRITIM
	OR	A
	JP	NZ,NOTOP
	POP	DE
	LD	HL,SECS1	;RESET ELAPSED TIME COUNTER
	ADD	HL,DE
	ADD	HL,DE
	XOR	A
	LD	(HL),A
	INC	HL
	LD	(HL),A
	RET


;--------------------------------------------------------------------------
;	RESET A PULSER
;--------------------------------------------------------------------------

RESPULS:CALL	GCI
	CALL	BYTARG		;GET PULSER #
	LD	A,E
	CALL	CK1_3		;RANGE 1-3

	LD	C,A		;PULSER #
	LD	A,3		;RESET CTC

	CALL	WRICNT
	OR	A
	JP	NZ,NOTOP

				;CLEAR TOTAL NOW (C IS PULSER #)
	LD	B,0
	DEC	BC
	LD	HL,VPULS_1
	ADD	HL,BC
	ADD	HL,BC
	XOR	A
	LD	(HL),A
	INC	HL
	LD	(HL),A
	RET

;--------------------------------------------------------------------------
;	RESET AN OSCILLATOR
;--------------------------------------------------------------------------

RESOSC:	CALL	GCI
	CALL	BYTARG
	LD	A,E
	CALL	CKOSCN		;CHECK RANGE
	LD	C,A
	LD	A,3
	CALL	WRIOSC
	RET

;--------------------------------------------------------------------------
;	'COUNTER' - SWITCH ON OR OFF A PULSER
;--------------------------------------------------------------------------


PULSER:	CALL	BYTARG		;GET PULSER #
	LD	A,E
	CALL	CK1_3		;RANGE 1-3
	LD	C,A		;PULSER #
	PUSH	BC

	LD	B,','
	CALL	EATC
	CALL	BYTARG		;GET ON OR OFF (0/1)
	LD	A,E
	POP	BC		;C IS PULSER #
	CP	0
	JR	Z,PULS_OFF
	CP	1
	JR	Z,PULS_ON
	JP	E3

PULS_ON:LD	A,11000111B	;INTERRUPT ON - COUNTER MODE - RESET
	CALL	WRICNT
	LD	A,1		;LOAD VALUE = 1
	CALL	WRICNT
	RET
PULS_OFF:
	LD	A,3		;RESET CTC
	CALL	WRICNT
	RET


;-------------------------------------------------------------------------
;	RESET INTERRUPT
;-------------------------------------------------------------------------

RESINTERR:
	CALL	GCI		;EAT 'INTERRUPT'
	CALL	GC

	CP	CLRRW		;DOES 'CLEAR' FOLLOW?
	JP	Z,PRECLINTA	;YES, JUMP

	CP	CHRW		;DOES 'CH' FOLLOW?
	JP	Z,RESCHANN	;YES, JUMP

	JP	CLINSTK		;JUST 'RESET INTERRUPT' - CLEAR FIFOS

PRECLINTA:			;EAT 'CLEAR'
	CALL	GCI
	CALL	CLINSTK		;CLEAR FIFOS
	JP	CLINTA		;AND TABLES

RESCHANN:			;?????
	JP	REM




;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 9 - OPTIONAL (CUSTOM) STATEMENTS 	*
;	*							*
;	*		    AND COMMANDS			*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *

;
;
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 10 - CONSTANTS AND TABLES	 	*
;	*							*
;	*		    					*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_1 MESSAGES		*
;	*      			*
;	*      			*
;	*      			*
;	* * * * * * * * * * * * *
;
;
;
HEAD:	DB	12
	DB	'GBASIC 7.5 (c)IGB"'

HEAD2:	DB	'N to clear all->"'
RDYS:	DB	'OK"'

RNING:	DB	'EXEC"'
INS:	DB	' LN "'
STOPS:	DB	'STOP "'
BRKMSG:	DB	'BRK "'

;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_2 SINE AND COSINE	*
;	*      			*
;	* COEFFICIENT LIST      *
;	*      			*
;	* * * * * * * * * * * * *
;
;

;	DB	1*16
;	DW	0
;	DW	0
;	DW	0
;	DB	1
;FPNONE:	DB	129



	IF	REDUCED

	DB	0FFH	;FLAGS END OF SINE COEFFICIENT LIST
	DB	0
	DB	1*16
	DW	0
FPONE:	DB	129	;EXPONENT

	DB	1*16
	DB	0
	DB	1
FPMINONE:
	DB	129	;EXPONENT

	ELSE

	DB	0FFH	;FLAGS END OF SINE COEFFICIENT LIST
	DB	0
	DB	1*16
	DW	0
	DW	0
	DB	0
FPONE:	DB	129	;EXPONENT

	DB	1*16
	DW	0
	DW	0
	DB	1
FPMINONE:
	DB	129	;EXPONENT
	ENDIF
;
;	SINE COEFFICIENT LIST
;	NOTE:  THE FLOATING PNT 1 ABOVE IS A PART OF THIS TABLE
;
	DB	1*16+6
	DB	6*16+6
	DB	6*16+6
	DB	6*16+6
	DB	6*16+7
	DB	1
	DB	128	;-_166667 E 0 (-1/3 FACTORIAL)
	DB	8*16+3
	DB	3*16+3
	DB	3*16+3
	DB	3*16+3
	DB	3*16+3
	DB	0
	DB	128-2	;_833333 E-2 (1/5 FACT)
	DB	1*16+9
	DB	8*16+4
	DB	1*16+2
	DB	6*16+9
	DB	8*16+4
	DB	1
	DB	128-3	;-_198413 E-3 (-1/7 FACT)
	DB	2*16+7
	DB	5*16+5
	DB	7*16+3
	DB	1*16+9
	DB	2*16+2
	DB	0
	DB	128-5	;_275573 E-5 (1/9 FACT)
	DB	2*16+5
	DB	0*16+5
	DB	2*16+1
	DB	0*16+8
	DB	3*16+9
	DB	1
SINX:	DB	128-7	;-_250521 E-7 (-1/11 FACT)
;
;	COSINE COEFFICIENT LIST
;
	DB	0FFH	;MARKS END OF LIST
	DB	0
	DB	1*16+0
	DB	0
	DW	0
	DB	0
	DB	0
	DB	128+1	;_100000 E 1 (1/1 FACT)
	DB	5*16+0
	DB	0
	DW	0
	DB	0
	DB	1
;
;
MATUB:	DB	128	;-_500000 E 0 (-1/2 FACT)
;
;
	DB	4*16+1
	DB	6*16+6
	DB	6*16+6
	DB	6*16+6
	DB	6*16+7
	DB	0
RANDS:	DB	128-1	;_416667 E-1 (1/4 FACT)
	DB	1*16+3
	DB	8*16+8
	DB	8*16+8
	DB	8*16+8
	DB	8*16+9
	DB	1
	DB	128-2	;_138889 E-2 (-1/6 FACT)
	DB	2*16+4
	DB	8*16+0
	DB	1*16+5
	DB	8*16+7
	DB	3*16+0
	DB	0
	DB	128-4	;_248016 E-4 (1/8 FACT)
	DB	2*16+7
	DB	5*16+5
	DB	7*16+3
	DB	1*16+9
	DB	2*16+2
	DB	1
;
;
COSX:	DB	128-6	;_275573 E-6 (-1/10 FACT)
	DB	2*16
	DW	0
	DW	0
	DB	0
FPTWO:	DB	129
;
;
	DB	1*16+5
	DB	7*16+0
	DB	7*16+9
	DB	6*16+3
	DB	2*16+7
	DB	0
PIC2:	DB	128+1	;PI/2  _157080 E 1
	DB	6*16+3
	DB	6*16+6
	DB	1*16+9
	DB	7*16+7
	DB	2*16+3
	DB	0
PIC1:	DB	128	;2/PI  _636620 E 0
;
;
LCSTKA:	DW	CSTKL
	DB	25H
	DB	50H
	DW	0
	DW	0
FP255:	DB	83H
	DW	0
	DW	0
	DW	0
FP0:	DB	0
;

;	* * * * * * * * * * * * *
;	*      			*
;	* 10_3 COMMANDS 	*
;	*      			*
;	* ADDRESS TABLE		*
;	*      			*
;	* * * * * * * * * * * * *
;
;
;
CMNDD:	DW	CRUN	;0
	DW	LLIST	;1 LIST ON LINE PRINTER
	DW	N	;2
	DW	CSCR	;3
	DW	N	;4
	DW	N	;5
	DW	N	;6
	DW	N	;7
	DW	N	;8
	DW	N	;9
	DW	CLIST	;10 LIST



;	* * * * * * * * * * * * *
;	*      			*
;	* 10_4 BASIC STATEMENTS *
;	*      			*
;	* ADDRESS TABLE		*
;	*      			*
;	* * * * * * * * * * * * *
;
;
STATD:
	DW	N	;0
	DW	N	;1 	RESERVED FOR EOF
	DW	N	;2 	ERA INK - ORA NGET$
	DW	N	;3	USATA
	DW	N	;4	USATA
	DW	ELSEX	;5	ELSE (IF)
	DW	ENDIFX	;6	ENDIF (IF)
	DW	N	;7	NOCLEAR
	DW	N	;8 	ERA VORG - ORA PICTURE
	DW	VRESET	;9
	DW	CLOCK	;10 	ERA PLOT - ORA IS - ORA UNPLOT - ORA OSC
	DW	N	;11	ERA UNPLOT - ORA IS
	DW	PULSER	;12 	ERA AVRAM
	DW	N	;13
	DW	N	;14	RISERVATA PER SWITCH
	DW	N	;15	RISERVATA PER LDEV
	DW	DATE@SET ;16 	ERA SPFORM
	DW	N	;17
	DW	N	;18
	DW	N	;19
	DW	N	;20	ERA CSAVE - ORA SUBSTR@
	DW	CLOAD	;21
	DW	TIME@SET ;22	ERA CVERIFY
	DW	N	;23	ERROR NON-INITIAL RW
	DW	N	;24
	DW	N	;25	ERA MOTOR - ORA CONCAT@
	DW	DELAY	;26	TIMER
	DW	PREF	;27	PREFIX FOR 2-BYTES RW
	DW	EIDI	;28	INTERRUPT RW - USED FOR ENABLE DISABLE INT
	DW	DOCH	;29	CH
	DW	N	;30
	DW	N	;31
;
;	PREFIXED
;
STA2:	DW	N	;PREFIX +0
	DW	N	;RESERVED FOR EOF
	DW	PRESCA	;+2
	DW	N	;+3
	DW	N	;+4
	DW	N	;+5
	DW	N	;+6 	;FREE FOR USE
	DW	N	;+7
	DW	N	;+8
	DW	N	;+9
	DW	N	;+10
	DW      N	;+11
	DW	N
	DW	N	;+13
	DW	LSTDEV	;+14
	DW	CON	;+15
	DW	N	;+16
	DW	N	;+17
	DW	HEXD	;+18
	DW	MEM	;+19
	DW	N	;+20	ERA TESTCOM
	DW	N	;+21
	DW	CLK	;+22	TIMDAT
	DW	START0 	;+23	BOOT
	DW	ERRDEV	;+24	ERRDEV
	DW	N	;+25	SCOPE
	DW	N	;+26	SAMPLE
	DW	N	;+27
	DW	N	;+28	FLUSH
	DW	AUX	;+29
	DW	DISPLAY	;+30
	DW	DOG	;+31
	DW	BEEP	;+32

	IF	FMD
	DW	MOTOR	;+33
	ELSE
	DW	N
	ENDIF

	DW	CSAVE	;+34
	DW	N	;+35
	DW	N	;+36
	DW	N	;+37
	DW	N	;+38
	DW	LAMP
	DW	VALVE	;+40
	DW	N	;+41
	DW	DO	;+42
	DW      WHILE  	;+43
	DW	SPUSH	;+44
	DW	SPOP	;+45
	DW	CHAIN	;+46
	DW	WRITE	;+47
	DW	OPEN	;+48
	DW	CLOSE	;+49
	DW	KEYBRK	;+50
	DW	NOVDLY	;+51
	DW	PRINTS	;+52
	DW	BACKSP	;+53
	DW	SIOSET	;+54
	DW	AUTSTA	;+55
	DW	CRITON	;+56
	DW	CRITOF	;+57
	DW	LOCKSYS	;+58
	DW	OVPRINT	;+59
	DW	WRITEC	;+60
	DW	ADD2	;+61
	DW	PROC	;+62
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N	;+70
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N	;+80
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N	;+90
	DW	N
	DW	N
	DW	N
	DW	N
	DW	N
	DW	LET	;0
	DW	NEXT	;1
	DW	SIF	;2
	DW	SGOTO	;3
	DW	GOSUB	;4
	DW	RETRN	;5
	DW	READ	;6
	DW	DATAX	;7
	DW	SFOR	;8
	DW	LPRINT	;9
	DW	INPUT	;10
	DW	DIM	;11
	DW	STOP	;12
	DW	CEND	;13
	DW	RESTOR	;14
	DW	REM	;15
	DW	STMCLR	;16
	DW	AARG	;17
	DW	CPOKE	;18
	DW	COUT	;19
	DW	AON	;20
	DW	N	;21
	DW	N	;22
	DW	PRINT	;23
	DW	4000H	;EXTERNAL REMOTE DEBUGGER>>>>>>>SPECIFICARE COME VARIABILE	;24



;	* * * * * * * * * * * * *
;	*      			*
;	* 10_6 STATEMENT 	*
;	*      			*
;	* TRANSLATE TABLE	*
;	*      			*
;	* INITIAL RESERV_ WORDS *
;	*      			*
;	* * * * * * * * * * * * *
;
;
;	R/W WORD TABLE FORMAT IS RESERVED WORD FOLLOWED BY CHR
;	OF RESERVED WORD_  LAST ENTRY IS FOLLOWED BY A FFH
;	RW'S THAT ARE SUBSTRINGS OF OTHER RW'S (E.G. >) MUST
;	FOLLOW THE LARGER WORD_
;
;
;
RWT:	DB	2H
	DB	'NGET'
NGET@RW	EQU	2
	DB	SEPRW

	DB	3
	DB	'SYS'
SYSRW	EQU	3
	DB	SEPRW

	DB	4
	DB	'FREERUN'
FRERW	EQU	4	;FREERUN RW
	DB	SEPRW

	DB	5
	DB	'ELSE'
ELSERW	EQU	5	;ELSE RW
	DB	SEPRW

	DB	6
	DB	'ENDIF'
ENDIFRW	EQU	6	;ENDIF RW
	DB	SEPRW

	DB	7
	DB	'NOCLEAR'
NOCLRRW	EQU	7
	DB	SEPRW

	DB	8
	DB	'PICTURE'
PICRW	EQU	8
	DB	SEPRW

	DB	9
	DB	'RESET'
RESRW	EQU	9
	DB	SEPRW

	DB	10
	DB	'OSC'
OSCRW	EQU	10
	DB	SEPRW

	DB	11
	DB	'IS'
ISRW	EQU	11
	DB	SEPRW

	DB	12
	DB	'COUNTER'	;ERA 'VRAM'
PULSERRW EQU	12
	DB	SEPRW

	DB	14
	DB	'SWITCH'
SWITCHRW EQU	14
	DB	SEPRW

	DB	15
	DB	'LDEV'
LDEVRW EQU	15
	DB	SEPRW

	DB	16
	DB	'DATE'	;ERA 'SPFORM'
DATE@RW	EQU	16

	DB	SEPRW
	DB	20
SUBSTR@RW	EQU	20
	DB	'SUBSTR'	;ERA 'SAVE'
	DB	SEPRW

	DB	21
	DB	'LOAD'
	DB	SEPRW

	DB	23
	DB	'ERROR'
ERRRW	EQU	23
	DB	SEPRW

	DB	24
	DB	'CHR'
CHR@RW	EQU	24;
	DB	SEPRW

	DB	25
	DB	'CONCAT'	;ERA 'MOTOR'
CONCAT@RW	EQU	25
	DB	SEPRW

	DB	26
	DB	'TIMER'
TIMRW	EQU	26
	DB	SEPRW

	DB	22
	DB	'TIME'	;'VERIFY'
TIME@RW	EQU	22
	DB	SEPRW

	DB	28
	DB	'INTERRUPT'
INTRW	EQU	28
	DB	SEPRW

	DB	29
	DB	'CH'
CHRW	EQU	29
	DB	SEPRW

	DB	30
	DB	'WITH'
WITHRW	EQU	30
	DB	SEPRW

	DB	27
	DB	2
	DB	'PRESCALE'
	DB	SEPRW

	DB	27
	DB	14
	DB	'LST'
	DB	SEPRW

	DB	27
	DB	15
	DB	'CON'
CON_RW	EQU	15
	DB	SEPRW

	DB	27
	DB	18
	DB	'HEXD'
	DB	SEPRW

	DB	27
	DB	19
	DB	'STORAGE'
	DB	SEPRW

	DB	27
	DB	22
	DB	'TIMDAT'
	DB	SEPRW

	DB	27
	DB	23
	DB	'BOOT'
	DB	SEPRW

	DB	27
	DB	24
	DB	'ERR'
	DB	SEPRW

	DB	27
	DB	29
	DB	'AUX'
	DB	SEPRW

	DB	27
	DB	30
	DB	'DISPLAY'
	DB	SEPRW

	DB	27
	DB	31
	DB	'DOG'
	DB	SEPRW

	DB	27
	DB	32
	DB	'BEEP'
	DB	SEPRW

	DB	27
	DB	34
	DB	'SAVE'
	DB	SEPRW

	DB	27
	DB	33
	DB	'MOTOR'
	DB	SEPRW

	DB	27
	DB	39
	DB	'LAMP'
	DB	SEPRW

	DB	27
	DB	40
	DB	'VALVE'
	DB	SEPRW

	DB	27
	DB	42
	DB	'DO'
	DB      SEPRW


	DB	27
	DB	43
	DB	'WHILE'
	DB      SEPRW


	DB      27
	DB      44
	DB      'PUSH'
	DB      SEPRW

	DB      27
	DB      45
	DB      'POP'
	DB      SEPRW

	DB      27
	DB      46
	DB      'CHAIN'
	DB      SEPRW

	DB      27		;per precedere write
	DB      60
	DB      'WRITEC'
	DB      SEPRW

	DB      27
	DB      61
	DB      'IADD'
	DB      SEPRW

	DB      27
	DB      47
	DB      'WRITE'
	DB      SEPRW

	DB      27
	DB      48
	DB      'OPEN'
	DB      SEPRW

	DB      27
	DB      49
	DB      'CLOSE'
	DB      SEPRW

	DB      27
	DB      50
	DB      'BREAK'
	DB      SEPRW

	DB      27
	DB      51
	DB      'NOVRAM'
	DB      SEPRW

	DB      27
	DB      52
	DB      'PRINTS'
	DB      SEPRW

	DB      27
	DB      53
	DB      'BACKSP'
	DB      SEPRW

	DB      27
	DB      54
	DB      'SIOSET'
	DB      SEPRW

	DB      27
	DB      55
	DB      'AUTOSTART'
	DB      SEPRW

	DB      27
	DB      56
	DB      'CRITSEG'
	DB      SEPRW

	DB      27
	DB      57
	DB      'ENDCRIT'
	DB      SEPRW

	DB      27
	DB      58
	DB      'LOCK'
	DB      SEPRW

	DB      27
	DB      59
	DB      'OVERPRINT'
	DB      SEPRW

;	DB      27		;quello vero e' piu' su per precedere write
;	DB      60
;	DB      'WRITEC'
;	DB      SEPRW

	DB      27
	DB      62
	DB      'PROCEDURE'
	DB      SEPRW

	DB	200Q
	DB	'LET'
	DB	201Q
	DB	'NEXT'

	DB	202Q
	DB	'IF'
IFRW:	EQU	202Q

	DB	203Q
	DB	'GOTO'
GOTRW	EQU	203Q

	DB	204Q
	DB	'GOSUB'
GOSURW	EQU	204Q

	DB	205Q
	DB	'RETURN'
	DB	206Q
	DB	'READ'
	DB	207Q
	DB	'DATA'
DATARW	EQU	207Q

	DB	210Q
	DB	'FOR'
FORRW	EQU	210Q

	DB	211Q
	DB	'LPRINT'
	DB	212Q
	DB	'INPUT'
	DB	213Q
	DB	'DIM'
	DB	214Q
	DB	'STOP'
	DB	215Q
	DB	'ENDPGM'

	DB	216Q
	DB	'RESTORE'
RESTORW	EQU	216Q

	DB	217Q
	DB	'REM'
REMRW	EQU	217Q

	DB	220Q
	DB	'CLEAR'
CLRRW	EQU	220Q
	DB	221Q
	DB	'ARG'
	DB	222Q
	DB	'POKE'
	DB	223Q
	DB	'OUT'
	DB	224Q
	DB	'ON'

	DB	225Q
	DB	'STR'
STR@RW	EQU	225Q

	DB	227Q
	DB	'PRINT'
IRWLIM	EQU	231Q	;LAST INITIAL RESERVED WORD VALUE+1

;	IRW TABLE ENDS HERE
;
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_7 STATEMENT 	*
;	*      			*
;	* TRANSLATE TABLE	*
;	*      			*
;	* NON INITIAL RESDWS *
;	*      			*
;	* * * * * * * * * * * * *
;
	DB	237Q
	DB	'STEP'
STEPRW	EQU	237Q
	DB	236Q
	DB	'TO'
TORW	EQU	236Q
	DB	235Q
	DB	'THEN'
THENRW	EQU	235Q
	DB	234Q
	DB	'TAB'
TABRW	EQU	234Q
	DB	233Q
	DB	'HEX'
HEX@RW	EQU	233Q



;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_8 STATEMENT 	*
;	*      			*
;	* TRANSLATE TABLE	*
;	*      			*
;	* COMMANDS		*
;	*      			*
;	* * * * * * * * * * * * *
;
;
;
	DB	240Q
	DB	'RUN'
RUNRW	EQU	240Q
	DB	241Q
	DB	'LLIST'
	DB	243Q
	DB	'ERASE'
SCRRW	EQU	243Q

	DB	252Q
	DB	'LIST'
LISTRW	EQU	252Q
;
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_9 STATEMENT 	*
;	*      			*
;	* TRANSLATE TABLE	*
;	*      			*
;	* OPERATORS 		*
;	*      			*
;	* * * * * * * * * * * * *
;
;
LPARRW	EQU	'('-OPBASE+340Q
	DB	LPARRW
	DB	'('
MPY_RW	EQU	'*'-OPBASE+340Q
	DB	'*'-OPBASE+340Q
	DB	'*'
PLSRW	EQU	'+'-OPBASE+340Q
	DB	PLSRW
	DB	'+'
MINRW	EQU	'-'-OPBASE+340Q
	DB	MINRW
	DB	'-'
DIV_RW	EQU	'/'-OPBASE+340Q
	DB	'/'-OPBASE+340Q
	DB	'/'
	DB	67Q-OPBASE+340Q
	DB	'>='
	DB	70Q-OPBASE+340Q
	DB	'<='

NE_RW	EQU	71Q-OPBASE+340Q
	DB	71Q-OPBASE+340Q
	DB	'<>'

	DB	62Q-OPBASE+340Q
	DB	'=>'

	DB	63Q-OPBASE+340Q
	DB	'=<'

LT_RW	EQU	'<'-OPBASE+340Q
	DB	'<'-OPBASE+340Q
	DB	'<'

EQRW	EQU	'='-OPBASE+340Q
	DB	EQRW
	DB	'='

GT_RW	EQU	'>'-OPBASE+340Q
	DB	'>'-OPBASE+340Q
	DB	'>'




;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_10 		*
;	*      			*
;	* TRANSLATE TABLE	*
;	*      			*
;	* BUILT-IN FUNCTIONS	*
;	*      			*
;	* * * * * * * * * * * * *
;

	DB	301Q
	DB	'ABS'	;C1
ABSRW	EQU	301Q
	DB	306Q
	DB	'INT'	;C6
	DB	314Q
	DB	'ARG'	;CC
	DB	315Q
	DB	'CALL'	;CD
	DB	316Q
	DB	'RND'	;CE
	DB	322Q
	DB	'SGN'	;D2
	DB	323Q
	DB	'SIN'	;D3
	DB	304Q
	DB	'SQR'	;C4
	DB	330Q
	DB	'COS'	;D8
	DB	331Q
	DB	'VAL'	;D9
	DB	332Q
	DB	'PEEK'	;DA
	DB	333Q
	DB	'INP'	;DB
	DB	334Q
	DB	'LEN'	;DC
	DB	337Q
	DB	'INFO'	;DF
;	DB	377Q	;END OF TABLE

;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_11 		*
;	*      			*
;	* TRANSLATE TABLE	*
;	*      			*
;	* PREFIXED B_I_FUNCTIONS*
;	*      			*
;	* * * * * * * * * * * * *
;
	DB	SEPRW
	DB	FPREFIX
	DB	301Q
	DB	'NOT'	;C1

	DB	SEPRW
	DB	FPREFIX
	DB	302Q
	DB	'EXIT'	;C2

	DB	SEPRW
	DB	FPREFIX
	DB	306Q
	DB	'AND'	;C6

	DB	SEPRW
	DB	FPREFIX
	DB	313Q
	DB	'BINP'	;CB

	DB	SEPRW
	DB	FPREFIX
	DB	314Q
	DB	'OR'	;CC

	DB	SEPRW
	DB	FPREFIX
	DB	315Q
	DB	'XOR'	;CD

	DB	SEPRW
	DB	FPREFIX
	DB	327Q
	DB	'TAN'	;D7

	DB	SEPRW
	DB	FPREFIX
	DB	316Q
	DB	'&H'	;CE

	DB	SEPRW
	DB	FPREFIX
	DB	0D0H
	DB	'COUNT'

	DB	SEPRW
	DB	FPREFIX
	DB	0D1H
	DB	'DIAG'

	DB	SEPRW
	DB	FPREFIX
	DB	0D2H
	DB	'CKTIM'

	DB	SEPRW
	DB	FPREFIX
	DB	0D3H
	DB	'CKDAT'

	DB	SEPRW
	DB	FPREFIX
	DB	0D4H
	DB	'SECS'

	DB	SEPRW
	DB	FPREFIX
	DB	0D6H
	DB	'ADDROF'

	DB	SEPRW
	DB	FPREFIX
	DB	0D8H
	DB	'ASC'

	DB	SEPRW
	DB	FPREFIX
	DB	0D9H
	DB	'CKSUM'

	DB	SEPRW
	DB	FPREFIX
	DB	0DAH
	DB	'NIBBLES'

	DB	SEPRW
	DB	FPREFIX
	DB	0DBH
	DB	'DRVST'

	DB	SEPRW
	DB	FPREFIX
	DB	0DCH
	DB	'TIMCNT'

	DB	SEPRW
	DB	FPREFIX
	DB	0DDH
	DB	'SHUTDN'

	DB	SEPRW
	DB	FPREFIX
	DB	0DEH
	DB	'BIOS'

	DB	SEPRW
	DB	FPREFIX
	DB	0DFH
	DB	'INSTR'

ADDROFRW EQU	0D6H

	DB	377Q	;END OF TABLE


;
;	* * * * * * * * * * * * *
;	*      			*
;	* 10_12 OPERAT_AND FUNCT*
;	*      			*
;	* ADDRESS TABLE		*
;	*      			*
;	* * * * * * * * * * * * *
;
;	NOTE THAT OPERATORS AND ADDRESS SHARE LAST 7 BIT (LSB) OF CODE
;	THIS WAY THEY CANNOT HAVE THE LAST 7 BIT EQUALS EACH OTHER
;	THIS LIMITS THE MAX NUMBER OF OPERATORS+BUILT-IN FUNCTIONS TO 32
;

OPTAB:	DB	15	;0 (
OPLPAR	EQU	OPTAB
	DW	ALPAR
	DB	15	;1 ABS()
	DW	AABS
	DB	10	;2 *
	DW	AMUL
	DB	6	;3 +
	DW	AADD
	DB	15	;4 SQR()
	DW	ASQR
	DB	6	;5 -
	DW	ASUB
	DB	15	;6 INT()
	DW	AINT
	DB	10	;7 /
	DW	ADIV
OPBOL:	DB	1	;8 ???-??? e questo 0?
	DW	0
	DB	13	;9  UNARY MINUS
	DW	ANEG
	DB	4	;10 >=
	DW	AGE
	DB	4	;11 <=
	DW	ALE
	DB	15	;12 ARG()
	DW	AARG
	DB	15	;13 CALL()
	DW	ACALL
	DB	15	;14 RND()
	DW	ARND
	DB	4	;15 =>
	DW	AGE
	DB	4	;16 =<
	DW	ALE
	DB	4	;17 <>
	DW	ANE
	DB	15	;18 SGN()
	DW	ASGN
	DB	15	;19 SIN()
	DW	ASIN
	DB	4	;20 <
	DW	ALT
	DB	4	;21 =
	DW	AEQ
	DB	4	;22 >
	DW	AGT
	DB	15	;23 THIS ENTRY IS USED AS A DUAL BYTE RW PREFIX
	DW	N
	DB	15	;24 COS()
	DW	ACOS
	DB	15	;25 VAL()
	DW	VALST
	DB	15	;26 PEEK()
	DW	APEEK
	DB	15	;27 INP()
	DW	AIN
	DB	15	;28 LEN()
	DW	FLEN
	DB	15	;29 DEREF (in prova)
	DW	DEREF
	DB	15	;30
	DW	N
	DB	15	;31 INFO()
	DW	ATOP



;	* * * * * * * * * * * * *
;	*      			*
;	* 10_13 PREFIXED FUNCT	*
;	*      			*
;	* ADDRESS TABLE		*
;	*      			*
;	* * * * * * * * * * * * *

OPTAB2:	DB	15	;0
	DW	N
	DB	15	;1 (C1H) NOT()
	DW	ANOT
	DB	15	;2 (C2H) EXIT()
	DW	EXIFUN
	DB	15	;3
	DW	N
	DB	15	;4
	DW	N
	DB	15	;5
	DW	N
	DB	15	;6 (C6H) AND()
	DW	AAND
	DB	15	;7
	DW	N
	DB	15	;8
	DW	N
	DB	15	;9
	DW	N
	DB	15	;10
	DW	N
	DB	15	;11 (CBH) BINP()
	DW	BAIN
	DB	15	;12 (CCH) OR()
	DW	AOR
	DB	15	;13 (CDH) XOR()
	DW	AXOR
	DB	15	;14 (CEH) &H()
	DW	GHEX
	DB	15	;15 (CFH)
	DW	N
	DB	15	;16 (D0H) PULSER()
	DW	FPULSER
	DB	15	;17 (D1H) DIAGNOSTIC
	DW	DIAG
	DB	15	;18 (D2H) CHKTIM()
	DW	CHKTIM
	DB	15	;19 (D3H) CHKDAT()
	DW	CHKDAT
	DB	15	;20 (D4H) SECS(0)
	DW	FSECS
	DB	15	;21
	DW	N
	DB	15	;22 (D6H) ADDROF()
	DW	ADDROF
	DB	15	;23 (D7H) TAN()
	DW	ATAN
	DB	15	;24 (D8H) ASC()
	DW	FASC
	DB	15	;25 (D9H) CKSUM()
	DW	FCKSUM
	DB	15	;26 (DAH) NIBBLES()
	DW	FNIBBLES
	DB	15	;27 (DBH) DRVST()
	DW	FINKEY
	DB	15	;28 (DCH) TIMCNT()
	DW	TIMCNT
	DB	15	;29 (DDH) SHUTDN()
	DW	SHUTDN
	DB	15	;30 (DEH) BIOS
	DW	BIOS
	DB	15	;31 (DFH) INSTR
	DW	INSTR


;	ATTENZIONE - IL SEPARATORE '15' HA UN SENSO ED E' CONTROLLATO
;	ALMENO A XOP2


;
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 11 - ACTION ROUTINES FOR OPERATORS	*
;	*							*
;	*		     AND BUILT IN FUNCTIONS		*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 11_1 RELATIONAL OPER_	*
;	*      			*
;	* 			*
;	*      			*
;	* * * * * * * * * * * * *
;
AGT:	CALL	RELOP
	JP	Z,RFALSE
	JP	M,RTRUE
RFALSE:	XOR	A
	LD	(DE),A
	RET
ALT:	CALL	RELOP
	JP	Z,RFALSE
	JP	M,RFALSE
RTRUE:	LD	A,377Q
	LD	(DE),A
	RET
AEQ:	CALL	RELOP
	JP	Z,RTRUE
	JP	RFALSE
;
ANE:	CALL	RELOP
	JP	Z,RFALSE
	JP	RTRUE
;
AGE:	CALL	RELOP
	JP	Z,RTRUE
	JP	M,RTRUE
	JP	RFALSE
;
ALE:	CALL	RELOP
	JP	Z,RTRUE
	JP	M,RFALSE
	JP	RTRUE
;
;	COMMON ROUTINE FOR RELATIONAL OPERATOR ACTION
;
;	LEFT ARG ADDR IN DE, SAVED
;	RIGHT ARG ADDR IN BC
;	ON RETURN, SIGN SET=GT, ZERO SET=EQUAL
;
RELOP:	PUSH	DE
	DEC	BC
	DEC	DE
	LD	H,B
	LD	L,C
	LD	A,(DE)
	SUB	(HL)
	INC	HL
	INC	DE
	JP	NZ,RLOP1	;TEST SIGNS OF ARGS IF DIFFERENT THEN RET
	LD	BC,FPSINK
	CALL	FSUB
	LD	A,(FPSINK);CHECK FOR ZERO RESULT
	OR	A
	JP	Z,RLOP1
	LD	A,(FPSINK-1);SIGN OF FPSINK
	RLCA
	DEC	A
RLOP1:	LD	A,1
	LD	(RELTYP),A;SET RELTYPE TRUE
	POP	DE
	RET
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 11_2 ARITHMETIC OPER_ *
;	*      			*
;	* 			*
;	*      			*
;	* * * * * * * * * * * * *
;
;
;	ACTION ROUTINES FOR ARITHMETIC OPERATORS
;		(CODE WASTERS)
;
AADD:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
AADD1:	CALL	FADD
	JP	FPETST
;
ASUB:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
ASUB1:	CALL	FSUB
	JP	FPETST
;
AMUL:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
AMUL1:	CALL	FMUL
	JP	FPETST
;
ADIV:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
ADIV1:	CALL	FDIV
FPETST:	XOR	A
	LD	(RELTYP),A
	LD	A,(ERRI)
	OR	A
	RET	Z
	LD	HL,(ASTKA);ZERO RESULT ON UNDERFLOW
FPET1:	LD	(HL),0
ALPAR:	RET
;
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 11_3 BUILT-IN FUNCIONS*
;	*      			*
;	* 			*
;	*      			*
;	* * * * * * * * * * * * *
;
;	UNARY AND BUILT IN FUNCTION ACTION ROUTINES
;


;
;	'*' AS DEREFERENCE OPERATOR - TOS IN BC
;
DEREF:	CALL	PFIX
	CALL	PSHA1
	RET


;	'-' AS AN UNARY FUNCTION
;
ANEG:	LD	A,(BC)
	OR	A
	JP	Z,ANEG1
	DEC	BC
	LD	A,(BC)
	XOR	1
	LD	(BC),A
ANEG1:	XOR	A
	LD	(RELTYP),A
	RET


;	'ADDROF()' - ADDRESS OF A VARIABLE OR MATRIX ELEMENT
;
ADDROF:	RET			;DO NOTHING - VALUE ALREADY PUSHED


;
;	'ABS()'
;
AABS:	DEC	BC
	XOR	A
	LD	(BC),A
	JP	ANEG1
;



;
;	'AND()'
;
AAND:	CALL	LOGI0		;COMMON SECTION TO LOGIC FUNCTIONS
	LD	A,B
	AND	D
	LD	B,A
	LD	A,C
	AND	E		;LET RESULT IN B-ACC

LOGIEXI:PUSH	AF
	PUSH	BC
	LD	B,')'
	CALL	EATC
	POP	BC
	POP	AF
	JP	ACAL1		;PUT BYTE ON ARG STACK


LOGI0:	CALL	PFIX		;GET FIRST OPERAND IN E
	PUSH	DE
	LD	A,(ARGNUM)	;HOW MANY ARGUMENTS?
	CP	2
	JP	NZ,E3		;ARGUMENT ERROR
	LD	B,','		;TWO ARGUMENTS
	CALL	EATC
	CALL	EXPRB
	CALL	PFIX		;GET SECOND OPERAND
	PUSH	DE
	POP	BC		;LOAD IT INTO BC
	POP	DE		;1ST OP IN DE
	RET



;	'OR()'
;
AOR:	CALL	LOGI0
	LD	A,B
	OR	D
	LD	B,A
	LD	A,C
	OR	E		;LET RESULT IN B-ACC
	JR	LOGIEXI



;	'XOR()'
;
AXOR:	CALL	LOGI0
	LD	A,B
	XOR	D
	LD	B,A
	LD	A,C
	XOR	E		;LET RESULT IN B-ACC
	JR	LOGIEXI


;
;	'NOT()'
;
ANOT:	CALL	PFIX
	LD	A,D
	CPL
	LD	B,A
	LD	A,E
	CPL
	JP	ACAL1


;
;	'SGN()'
;
ASGN:	CALL	ANEG1
	LD	D,B
	LD	E,C
	LD	A,(BC)		;GET EXPONENT
	OR	A
	JP	NZ,ASGN1
	LD	(DE),A		;MAKE ARGUMENT ZERO
	RET
;
ASGN1:	DEC	BC
	LD	A,(BC)
	OR	A
	LD	HL,FPONE
	JP	Z,VCOPY
	LD	HL,FPMINONE
	JP	VCOPY



;
;	'SIN()'
;
;	COMPUTE SINE(X) X=TOP OF ARG STACK
;	RETURN RESULT IN PLACE OF X
;
ASIN:	CALL	QUADC	;COMPUTE QUADRANT
	LD	HL,(ASTKA)
	LD	D,H
	LD	E,L
	LD	BC,FTEMP
	CALL	AMUL1	;FTEMP = X*X
	POP	AF
	PUSH	AF	;A=QUADRANT
	RRA
	JP	C,SIN10	;QUAD ODD_ COMPUTE COSINE
;
;	COMPUTE X*P(X*X) -- SINE
;
	LD	DE,FTEM1
	LD	HL,(ASTKA)
	CALL	VCOPY	;FTEM1=X*X
	LD	BC,SINX
	CALL	POLY	;P(X*X)
	CALL	PREPOP
	LD	HL,FTEM1
	CALL	AMUL1	;X*P(X*X)
;
;	COMPUTE SIGN OF RESULT
;	POSITIVE FOR QUADRANT 0,1_  NEGATIVE FOR 2,3
;	NEGATE ABOVE FOR NEGATIVE ARGUMENTS
;
SIN5:	POP	AF	;QUADRANT
	LD	B,A
	POP	AF	;SIGN
	RLCA		;SIGN, 2 TO THE 1ST BIT
	XOR	B	;QUADRANT, MAYBE MODIFIED FOR NEGATIVE ARG
	LD	HL,(ASTKA)
	DEC	HL	;PTR TO SIGN
	SUB	2
	RET	M 	;QUADRANT 0 OR 1
	INC	(HL)	;ELSE SET RESULT NEGATIVE
	RET
;
;	COMPUTE P(X*X) -- COSINE
;
SIN10:	LD	BC,COSX
	CALL	POLY	;P(X*X)
	JP	SIN5




;
;	'COS()'
;
;	COMPUTE COS(X)   X=TOP OF ARGUMENT STACK
;	RETURN RESULT IN PLACE OF X
;	COS(X)=SIN(X+PI/2)
;
ACOS:	CALL	PREPOP
	LD	HL,PIC2	;PI/2
	CALL	AADD1	;TOS=TOS+PI/2
	JP	ASIN



;
;	'TAN()'
;
;	COMPUTE TAN(X) X=TOP OF ARGUMENT STACK
;	RETURN RESULT IN PLACE OF X
;	TAN(X)=SIN(X)/COS(X)
;
ATAN:	LD	HL,(ASTKA)
	CALL	PSHAS	;PUSH COPY OF X ONTO ARG STACK
	CALL	ACOS	;COS(X)
	LD	DE,FTEM2
	CALL 	POPA1	;FTEM2=COS(X)
	CALL	ASIN
	CALL 	PREPOP
	LD	HL,FTEM2
	JP	ADIV1	;SIN(X)/COS(X)



;
;	'SQR'
;
;	COMPUTE SQR(X) X=TOP OF ARGUMENT STACK
;	RETURN RESULT IN PLACE OF X
;
ASQR:	LD 	HL,(ASTKA)
	LD	DE,FTEMP
	CALL	VCOPY	;SAVE X IN FTEMP
;
;	COMPUTE EXPONENT OF FIRST GUESS AS EXPONENT OF X/2
;
	LD	HL,(ASTKA)
	LD	A,(HL)
	OR	A
	RET	Z ;	X=0
	SUB	128
	JP	M,SQR5	;NEGATIVE EXPONENT
	RRCA
	AND	127
	JP	SQR6
;
SQR5:	CPL
	INC	A
	RRCA
	AND	127
	CPL
	INC	A
SQR6:	ADD	A,128
	LD	(HL),A
;
;	TEST FOR NEGATIVE ARGUMENT
	DEC	HL
	LD	A,(HL)
	OR	A
	JP	NZ,NEGERR	;NEG ARG
;
;	DO NEWTON ITERATIONS
;	NEWGUESS=(X/OLDGUESS+OLDGUESS)/2
;
	LD	A,6	;DO 6 ITERATIONS
SQR20:	PUSH	AF	;SET NEW ITERATION COUNT
	LD	BC,FTEM1
	LD	DE,FTEMP;FTEMP IS 'X'
	LD	HL,(ASTKA);GUESS
	CALL	ADIV1	;FTEM1 = X/GUESS
	LD	DE,FTEM1
	LD	HL,(ASTKA)
	LD	B,H
	LD	C,L
	CALL	AADD1	;TOS=(X/GUESS)+GUESS
	CALL	PREPOP
	LD	HL,FPTWO
	CALL	ADIV1	;TOS=(X/GUESS+GUESS)/2
	POP	AF
	DEC	A	;DECREMENT COUNT
	JP	NZ,SQR20	;DO ANOTHER ITERATION
	RET



;
;	'RND()'
;
;	COMPUTE RND(X)  X=TOP OF ARG STACK
;	FRAMD IS UPDATED TO NEW RANDOM VALUE
;	A RANDOM NUMBER IN THE RANGE 0<RND<1 IS RETURNED IN PLACE
;
ARND:	CALL	PREPOP
	LD	DE,FRAND
	LD	HL,FRAND
	CALL	AMUL1	;TOS= FRAND*FRAND
;
;	SET EXPONENT = 0
;
	LD	HL,(ASTKA)
	LD	(HL),128;EXPONENT=128  (0 IN EXTERNAL FORM)
;
;	PERMUTE DIGITS OF X AS
;	123456 INTO 345612
;
	LD	BC,-4
	ADD	HL,BC
	LD	B,(HL)	;SAVE 12
	INC	HL
	INC	HL
	CALL	PERMU
	CALL	PERMU
	CALL	PERMU	;56=12
	CALL	PERMU	;34=56
	CALL	PERMU	;12=34
;
;	NORMALIZE NUMBER
;
RND5:	LD	HL,(ASTKA);TOS
	LD	BC,-FPSIZ+1
	ADD	HL,BC
	LD	A,(HL)	;FIRST DIGIT PAIR
	AND	15*16
	JP	NZ,RND10	;NUMBER IS NORMALIZED
;
;	SHIFT LEFT 1 DIGIT
;
	LD	HL,(ASTKA)
	LD	A,(HL)	;EXPONENT
	DEC	A
	LD	(EXP),A
	CALL	LOAD	;TOS INTO TEMP
	LD	B,4
	CALL	LEFT	;SHIFT LEFT
	CALL	PREPOP
	CALL	STORE
	JP	RND5	;TEST IF NORMALIZED
;
;	SAVE NEW RANDOM NUMBER FRAND CELL
;
RND10:	LD	DE,FRAND
	LD	HL,(ASTKA)
	CALL	VCOPY	;FRAND=TOS
	RET
;
;	PERMUTE PAIR OF DIGIT PAIRS
;
PERMU:	LD	A,(HL)
	LD	(HL),B
	LD	B,A
	DEC	HL
	RET
;
;	EVALUATE P(X) USING HORNERS METHOD (X IS IN FTEMP)
;	COEFFICIENT LIST POINTER IS IN BC
;	RESULT REPLACES NUMBER ON TOP OF ARG STACK (Y)
;
POLY:	LD	HL,(ASTKA)
	EX	DE,HL;	DE=PTR TO Y
	LD	H,B
	LD	L,C	;HL PTR TO COEFFICIENT LIST
	CALL	VCOPY	;Y=FIRST COEFFICIENT
;
;	MULTIPLY BY X
;
POLY1:	PUSH	HL	;SAVE COEFF_ LIST POINTER
	CALL	PREPOP
	LD	HL,FTEMP
	CALL	AMUL1	;Y=Y*X
;
;	ADD NEXT COEFFICIENT
;
	CALL	PREPOP
	POP	HL
	PUSH	HL	;HL=COEFF_ LIST POINTER
	CALL	AADD1	;Y=Y+COEFF
;
;BUMP POINTER TO NEXT COEFFICIENT
;
	POP	HL	;COEFF POINTER
	LD	BC,-FPSIZ-1
	ADD	HL,BC	;NEXT COEFF SIGN
	LD	A,(HL)
	INC	HL	;PTR TO EXPONENT
	OR	A
	JP	P,POLY1	;PROCESS NEXT COEFF
	RET	;	NEGATIVE SIGN (-1) ENDS LIST
;
;	PREPARE FOR OPERATION
;
PREPOP:	LD	HL,(ASTKA)
	EX	DE,HL;	DE=ASTKA
	LD	B,D
	LD	C,E
	RET
;
;	QUADRANT COMPUTATION
;	POPS TOP OF ARGUMENT STACK
;	COMPUTE/GETS SIGN OF ARGUMENT,QUADRANT OF ARGUMENT
;	AND INDEX INTO QUADRANT
;
;	EXITS WITH
;	SP POINTING TO QUADRANT,MOD 4
;	SP+2 POINTING TO SIGN OF ARGUMENT
;	TOP OF ARGUMENT STACK HAS INDEX INTO QUADRANT
;
QUADC:	LD	HL,(ASTKA)
	DEC	HL	;POINT TO SIGN
	LD	B,(HL)
	XOR	A
	LD	(HL),A	;ARG SIGN=0
	LD	H,B
	EX	(SP),HL;	PUT SIGN ON STACK, POP RETURN
	PUSH	HL	;PUSH RETURN
;
;	COMPUTE QUADRANT OF ABS(X)
;
	LD	HL,(ASTKA)
	CALL	PSHAS	;PUT COPY OF ARG ONTO STACK
	CALL	PREPOP
	LD	HL,PIC1	;2/PI
	CALL	AMUL1	;TOS=X*2/PI
	CALL	PREPOP
	CALL	AINT	;TOS=INT(X*2/PI)
	LD	HL,(ASTKA)
	CALL	PSHAS	;ANOTHER COPY
	CALL	PFIX	;POPS TOS TO DE
	LD	A,E
	PUSH	AF	;QUADRANT
	CALL	PREPOP
	LD	HL,PIC2
	CALL	AMUL1	;TOS=INT(X*2/PI)
	LD	DE,FTEMP
	CALL	POPA1	;FTEMP=TOS
	CALL	PREPOP
	LD	HL,FTEMP
	CALL	ASUB1	;TOS=TOS-FTEMP
	POP	AF
	AND	3	;MOD 4
	POP	HL
	PUSH	AF	;SAVE QUADRANT ON STACK
	JP	(HL);	RETURN



;	'ARG'	- E' FINITA QUI PER ERRORE - NON E' UNA FUNZIONE
;
;	SET UP ARG FOR USER CALL
;
AARG:	CALL	EXPRB
	CALL	PFIX
	LD	(CALLA1),DE
	CALL	GC
	CP	CR
	RET	Z
	CALL	EATCOM
	CALL	EXPRB
	CALL	PFIX
	LD	(CALLA2),DE
	RET



;
;	'CALL()'
;
;	USED TO CALL USER ROUTINE
;
ACALL:	CALL	EFFLEN		;STRING OR VALUE?
	JR	Z,ACALL1
	LD	HL,(VALTEMP-1)
	LD	A,10
	CP	C
	JP	C,E19		;NAME TOO LONG
	LD	DE,PASSNAME
	LD	B,0		;C HAS ALREADY THE LENGHT
	LDIR
	XOR	A
	LD	(DE),A		;CLOSE STRING WITH \0
	LD	HL,PASSNAME	;KEYWORD NAME TO PASS
	LD	DE,(CALLA1)	;USER ARGUMENT ARGUMENT TO PASS
	LD	BC,(CALLA2)
	XOR	A
	LD	(STRFLG),A	;CLEAR STRING FLAG
	LD	B,H
	LD	A,L
	JP	ACAL1

ACALL1:	CALL	PFIX		;GET THE ADDRESS
	LD	HL,(CALLA1)	;GET THE USER ARGUMENT
	LD	BC,ACALX	;RETURN LINK FOR USER ROUTINE
	PUSH	BC
	LD	B,H		;MOVE ARG TO BC (PL/M CONVENTION)
	LD	C,L
	EX	DE,HL
	JP	(HL)

ACAL1:	LD	H,B		;CONVERT FROM PL/M TO BASIC
	LD	L,A
ACALX:	LD	DE,CALST
	CALL	CNS
	LD	A,CR
	LD	(DE),A
	LD	DE,CALST
	LD	HL,FPSINK
	CALL	FPIN
	LD	DE,FPSINK
	JP	PSHA1		;PUT THE RETURNED USER VALUE ON ARG STACK



;
;	'POP' UNUSED OLD FUNCTION - MA DA RIVEDERE, FORSE UTILE
;
;	- ARGPOP - SUBROUTINE TO POP 16-BIT WORDS FROM STACKS
;		AND DO BOUNDS CHECKING ON STACKS
;	ENTRY - HL IS STACK POINTER, BC IS NEGATIVE OF STACK BASE
;	EXIT - BC IS POPPED WORD, HL IS UPDATED STACK POINTER
;
ARGPOP:	PUSH	HL	;SAVE VALUE OF SP
	ADD	HL,BC	;CHECK FOR STACK EMPTY
	XOR	A
	OR	H
	JP	M,ARGP1	;IF STACK NOT EMPTY
	JP	STKERR

;
ARGP1:	POP	HL	;RETRIEVE SP
	INC	HL	;POP	WORD
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	RET
;
;	- ARGPA - ARGPOP AUXILIARY SUBROUTINE
;		DECREMENTS A COUNT IN DE
;		JUMPS TO ACAL1 IF COUNT=0, RETURNS IF NOT
;	ENTRY - BC CONTAINS WORD TO PASS TO ACAL1, DE IS COUNT
;	EXIT - BA CONTAINS WORD
;
ARGPA:	DEC	DE
	LD	A,D
	OR	E
	RET	NZ
	LD	A,C
	POP	HL
	JP	ACAL1



;
;	'PEEK()'
;
;	- APEEK - FUNCTION TO READ CONTENTS OF MEMORY
;
APEEK:	CALL	PFIX	;SET MEMORY ADDR
	LD	A,(DE)	;FETCH BYTE
	LD	B,0
	JP	ACAL1	;PUT BYTE ON ARGUMENT STACK


;	'DIAG()'
;
;	- DIAG - FUNCTION TO RETURN THE RESULT OF THE INITIAL CHECK UP
;
DIAG:	CALL	PFIX		;SET DUMMY ARGUMENT
	LD	A,1		;DIAG(1) CALLED?
	CP	E
	JR	Z,DIAG1

	LD	A,(DIAGCO)	;FETCH DIAG CODE
	LD	B,0
	JP	ACAL1		;PUT BYTE ON ARGUMENT STACK

;	RETURN THE STATUS OF THE POWER DOWN FLAG - THIS IS 0 IF WE ARE
;	ARRIVING FROM A STARTUP POST POWER DOWN - IS > 0 IF THIS STARTUP
;	IS DUE TO THE PRESSURE OF THE RESET BUTTON

DIAG1:	LD	A,(PDFLG)
	LD	B,0
	JP	ACAL1

;	'SHUTDN()'
;
;	- SHUTDN - RETURNS 1 IF A POWER DOWN IS PENDING, 0 OTHERWISE
;
SHUTDN:	CALL	PFIX		;SET DUMMY ARGUMENT
	LD	A,(PDOWN)	;FETCH FLAG
	LD	B,0
	JP	ACAL1		;PUT BYTE ON ARGUMENT STACK

;
;	'COUNT(X)'
;
;	RETURNS THE ACTUAL COUNT OF X COUNTER
;
FPULSER:
	CALL	BYTAR1		;GET PULSER #

	LD	A,E
	DEC	E		;PULSER 1 HAS OFFSET 0 OVER VPULS_1
	LD	D,0
	LD	HL,VPULS_1
	ADD	HL,DE
	ADD	HL,DE
	LD	A,(HL)
	INC	HL
	LD	B,(HL)
	JP	ACAL1	;PUT BYTE ON ARGUMENT STACK

;
;	'SECS(X)'
;
;	RETURNS ELAPSED SECONDS SINCE THE START OF A TIMER

FSECS:	CALL	BYTAR1		;GET TIMER #
	LD	A,E
	CALL	CK1_3		;1-3 RANGE
	DEC	E
	LD	HL,SECS1
	ADD	HL,DE
	ADD	HL,DE
	LD	A,(HL)		;GET VALUE - LSB
	INC	HL
	LD	B,(HL)		; MSB
	JP	ACAL1


;	'TIMCNT(X)

;	RETURNS THE ACTUAL COUNT OF A TIMER

TIMCNT:	CALL	BYTAR1		;GET TIMER #
	LD	A,E
	CALL	CK1_3		;1-3 RANGE
	DEC	E
	LD	HL,TIM1B
	ADD	HL,DE
	LD	A,(HL)
	LD	B,0
	JP	ACAL1


;	'BINP()'

;	versione buffered della funzione INP - rilegge il buffer delle uscite
;	usabile solo se uscite operano in modo buffered (OUT 0,2)

BAIN:	LD	A,(OUTMOD)	;BUFFERED MODE?
	CP	2
	JP	NZ,E3		;ammessa solo in modo buffered

	CALL	BYTAR1		;GET PORT ADDR
	LD	C,E
	CALL	OLDPORT
	LD	A,(HL)
	JR	AIN1

;----------------------------------------------------------------------------
;	'INP()'
;	FUNCTION TO INPUT BYTE FROM PORT
;----------------------------------------------------------------------------

;	mod.26.10.96 - si accettano indirizzi maggiori di 256 ma si suppone
;	che siano destinati ad un driver

AIN:	CALL	PFIX		;GET PORT ADDR

;	SE LA PARTE ALTA E' ZERO, CONTINUA VECCHIA MANIERA

	LD	A,D             ;OLTRE 255?
	OR	A
	JR	Z,OLDIN

;	SE NESSUN DRIVER INSTALLATO...

	LD	A,(IODRV)
	OR	A
	JP	NZ,INPDRV

	LD	A,0		;...RITORNA ZERO
	LD	B,0
	JP	ACAL1		;PUT BYTE ON ARGUMENT STACK

;	VICEVERSA DOBBIAMO GESTIRE L'OUTPUT DA DRIVER
;	A CONTIENE IL NUMERO DEL DRIVER
;	DE CONTIENE ANCORA IL NUMERO DELLA PORTA

INPDRV:	LD	C,A		;C  - CHANNEL NUMBER
	LD	D,0		;TOGLI OFFSET 255

	LD	B,1		;B  - OPERATION CODE 1 (FOR READ)
	CALL	DRIVER		;DOES WHAT DRIVER WANTS
	LD	A,L		;RETURN VALUE INTO HL
	LD	B,0
	JP	ACAL1		;PUT BYTE ON ARGUMENT STACK

OLDIN:	LD	C,E
	IN	A,(C)

;	entry point ausiliario utilizzato da BINP()
AIN1:	PUSH	AF		;SAVE READ VALUE
	LD	A,(ARGNUM)	;HOW MANY ARGUMENTS?
	CP	1
	JR	Z,AIN3
	LD	B,','		;TWO ARGUMENTS
	CALL	EATC
	CALL	BYTARG		;GET BIT #
	LD	A,E
	AND	7		;SET OFF MSB'S
	LD	E,A
	PUSH	HL		;CONVERT TO BIT PATTERN USING A TABLE
	LD	HL,INPTAB
	ADD	HL,DE
	LD	A,(HL)		;GET BIT PATTERN
	LD	E,A		;AND SAVE IT IN E
	POP	HL
	POP	AF		;RESTORE READ VALUE
	AND	E		;MASK OFF ALL BITS LESS THE INTERESTED
	OR	A		;TEST RESULT IS ZERO
	LD	A,0
	JR	Z,AIN2		;SET RESULT TO ZERO
	LD	A,1		;SET RESULT TO 1
AIN2:	PUSH	AF
	LD	B,')'
	CALL	EATC
AIN3:	POP	AF
	LD	B,0
	JP	ACAL1		;PUT BYTE ON ARG STACK
;
INPTAB:	DB	00000001B
	DB	00000010B
	DB	00000100B
	DB	00001000B
	DB	00010000B
	DB	00100000B
	DB	01000000B
	DB	10000000B



;	'INFO()'
;
ATOP:
	CALL	BYTAR1
	LD	A,E
	CALL	FINDA		;FIND THE ADDRESS OF DESIRED VARIABLE
	LD	B,H
	LD	A,L
	JP	ACAL1
;
FINDA:	LD	HL,(BOFA)
	CP	0
	RET	Z
	LD	HL,(EOFA)
	CP	1
	RET	Z
	LD	HL,(MATA)
	CP	2
	RET	Z
	LD	HL,(STB)
	CP	3
	RET	Z
	LD	HL,(MEMTOP)
	CP	4
	RET	Z
	LD	HL,750		;VERSION
	CP	5
	RET	Z
	LD	HL,IBUF
	CP	6
	RET	Z

	LD	HL,(NOVST)
	CP	8
	RET	Z

	LD	HL,(LSTRAM)	;DIMENSIONE AREA STORAGES
	LD	DE,(DKBASE)
	OR	A
	SBC	HL,DE

	CP	9
	RET	Z

	CP	10		;# OF INTERRUPTS QUEUING
	JR	NZ,INFO15
	LD	HL,INTSPFR
	LD	A,INTMAX	;MAXIMUM SPACE
	SUB	(HL)		;LESS FREE SPACE
	LD	L,A		;AND RETURN RESULT IN HL
	LD	H,0

	RET

INFO15:	LD	HL,(SAPOINT)
	CP	15
	RET	Z

;	INFO (16) - FREE RAM

	CP	16
	JR	NZ,INFO18
	LD	HL,(STB)		;FREE RAM
	LD	DE,(MATA)
	OR	A
	SBC	HL,DE
	RET

;	INFO (18) - SIZEOF(FLOAT)

INFO18:	CP	18
	JR	NZ,INFERR
	LD	H,0
	LD	L,FPSIZ
	RET

INFERR:	JP	E3




;
;	'VAL()'  RETURNS THE NUMERIC VALUE OF A STRING
;
VALST:
	CALL	TSTST
	JP	Z,E19
	LD	HL,(VALTEMP-1)
	EX	DE,HL
	LD	HL,VALTEMP
	CALL	FPIN
	JP	NC,VALST1
	LD	HL,FPMINONE
	JR	VALST2
VALST1:	LD	HL,VALTEMP
VALST2:	XOR	A
	LD	(STRFLG),A	;THE RESULT IS NO LONGER A STRING
	JP	PSHAS

;
;	&H() - GET HEXADECIMAL CONSTANT (STRING->VALUE)
;
GHEX:
	CALL	TSTST
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)	;GET THE ADDRESS OF THE ARGUMENT STRING
	EX	DE,HL
	CALL	RDNUM		;CONVERT HEX STRING TO CONST
	XOR	A
	LD	(STRFLG),A
	LD	B,H
	LD	A,L
	JP	ACAL1

;
;	ASC() - RETURNS ASCII CODE OF A CHAR
;
FASC:
	CALL	TSTST
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)
	CALL	EFFLEN
	JP	Z,E19
	XOR	A
	LD	(STRFLG),A	;IT IS A NUMBER NOW
	LD	A,(HL)		;FIRST CHAR OF THE STRING
	LD	B,0
	JP	ACAL1
;
;	NIBBLES() - RETURNS A VALUE FROM FIRST TWO CHARS OF A STRING
;		    TWO CHARS ARE ASCII# CODED (30-3FH)
;
FNIBBLES:
	CALL	TSTST
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)
	CALL	EFFLEN
	JP	Z,E19
	XOR	A
	LD	(STRFLG),A	;IT IS A NUMBER NOW
	LD	A,(HL)		;FIRST CHAR OF THE STRING
	SLA	A
	SLA	A
	SLA	A
	SLA	A
	LD	B,A
	INC	HL
	LD	A,(HL)		;SECOND BYTE
	AND 	0FH
	OR	B		;COMPOSE RESULT
	LD	B,0
	JP	ACAL1

;
;	'DRVST(n)' OR DRVST(n,m) - RETURNS STATUS FROM DEVICE DRIVER n
;

FINKEY:	CALL	BYTAR1
	LD	C,E		;FILE #

	LD	A,(ARGNUM)	;HOW MANY ARGUMENTS?
	CP	1
	LD	E,0FFH		;IN CASE OF ONE ARG ONLY (FFH = NO PARAM)
	JR	Z,DRVST1	;JUST ONE, JUMP

	PUSH	BC		;SAVE READ VALUE

	LD	B,','		;TWO ARGUMENTS
	CALL	EATC

	CALL	EXPRB		;GET PARAM FOR THE DRIVER
	CALL	PFIX		;DE=PARAM

	LD	B,')'
	CALL	EATC		;DOES NOT CLOBBER E

	POP	BC		;C HAS DRIVER #

DRVST1:	LD	B,6		;B=6=STATUS REQUEST
	CALL	DRIVER
	LD	B,0
	LD	A,E		;E=RETURN CODE
	JP	ACAL1



;
;	'BIOS (n,m)' -  CALL DIRECTLY DRIVER n FOR FUNCTION m
;

BIOS:	CALL	BYTAR1
	LD	C,E		;FILE #

	LD	A,(ARGNUM)	;HOW MANY ARGUMENTS?
	CP	2
	JP	NZ,E3		;MUST BE TWO

	PUSH	BC		;SAVE READ VALUE

	LD	B,','		;TWO ARGUMENTS
	CALL	EATC

	CALL	EXPRB		;GET PARAM FOR THE DRIVER
	CALL	PFIX		;DE=PARAM

	LD	B,')'
	CALL	EATC		;DOES NOT CLOBBER E

	POP	BC		;C HAS DRIVER #

	LD	B,E		;E = WHAT FUNCTION IS REQUESTED
	CALL	DRIVER
	LD	B,0
	LD	A,E		;E=RETURN CODE
	JP	ACAL1


;
;	'INSTR (n$,m)' -  CALL DIRECTLY DRIVER n FOR FUNCTION m
;

INSTR:	CALL	EFFLEN
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)
	LD	A,(ARGNUM)	;HOW MANY ARGUMENTS?
	CP	2
	JP	NZ,E3		;MUST BE TWO

	PUSH	HL		;SAVE THE ADDRESS OF THE STRING TO BE SEARCHED
	PUSH	BC		;AND THE LENGHT

	CALL	EATCOM

	CALL	EXPRB		;GET PARAM FOR THE DRIVER
	CALL	EFFLEN
	JP	Z,E19		;MUST BE A STRING

	LD	A,1		;ITS LENGHT MUST BE 1
	CP	C
	JP	NZ,E19

	LD	A,(HL)		;THE CHAR TO SEARCH
	POP	BC		;HOW FAR TO GO
	LD	E,C		;SAVE STRING LENGHT
	POP	HL		;WHERE TO SEARCH
	LD	B,0

	CPIR			;DO SEARCH
	LD	A,0		;DONT TOUCH FLAGS
	JR	NZ,INSTR2

	LD	A,E		;STRING LENGHT
	SUB	C		;RESULT INTO ACC (0 = NO MATCH)
INSTR2:	PUSH	AF

	LD	B,')'
	CALL	EATC		;DOES NOT CLOBBER E

	XOR	A
	LD	(STRFLG),A	;IT IS A NUMBER NOW

	POP	AF
	LD	B,0
	JP	ACAL1




;	CKSUM () - RETURNS THE CHECK SUM (XOR) OF A STRING
;
FCKSUM:
	CALL	TSTST
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)
	CALL	EFFLEN
	JP	Z,E19
	XOR	A
	LD	(STRFLG),A	;IT IS A NUMBER NOW

	XOR	A

CKSU2:	PUSH	AF		;SALVA RISULTATO PROGRESSIVO
	LD	A,(HL)
	CP	0		;FINE DEL BUFFER?
	JP	Z,CKSU1
	CP	'"'		;FINE DEL BUFFER?
	JP	Z,CKSU1
	POP	AF
	XOR	(HL)		;CALCOLA SOMMA LOGICA
	INC	HL
	JP	CKSU2

CKSU1:	POP	AF
	LD	B,0
	JP	ACAL1

;
;	'LEN(X@)'  RETURNS THE LENGHT OF THE X@ STRING
;
FLEN:	CALL	TSTST
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)
	CALL	EFFLEN
	JP	Z,E19
	XOR	A
	LD	(STRFLG),A
	LD	B,0
	LD	A,C
	JP	ACAL1


;	'EXIT(0)'  RETURNS THE CHARACTER USED TO LEAVE LAST INPUT STATEMENT
;
EXIFUN:	CALL	BYTAR1		;ARGUMENT IS IGNORED
	LD	B,0
	LD	A,(EXICHA)
	JP	ACAL1

;
;	'CKTIM(X@)'  RETURNS 1 IF X@ IS A CORRECT TIME STRING
;		      RETURNS 0 OTHERWISE
;
CHKTIM:	CALL	TSTST
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)
	CALL	EFFLEN
	JP	Z,E19
	XOR	A		;RESULT IS NOT A STRING
	LD	(STRFLG),A

;	CHECK LENGHT

	LD	A,8		;LENGHT HAS TO BE 8
	CP	C
	JR	NZ,CTIM_0

;	CHECK SEPARATORS

	PUSH	HL
	POP	DE		;COPY HL TO DE
	INC	HL
	INC	HL
	LD	A,':'
	CP	(HL)
	JR	NZ,CTIM_0	;CHECK FIRST SEPARATOR
	INC	HL
	INC	HL
	INC	HL
	CP	(HL)		;CHECK SECOND SEPARATOR
	JR	NZ,CTIM_0
	PUSH	DE		;RESTORE HL TO ITS ORIGINAL VALUE
	POP	HL		;POINTING TO THE BEGINNING OF THE STRING

	CALL	PACK_2		;GET HOURS
	JR	C,CTIM_0	;ERROR IN VALUE
				;LOWER LIMIT (0) IS IMPLICITLY TESTED
	CP	24H		;DATA ARE BCD
	JR	NC,CTIM_0

	INC	HL		;SKIP ":"
	CALL	PACK_2
	JR	C,CTIM_0
	CP	60H
	JR	NC,CTIM_0

	INC	HL		;SKIP ":"
	CALL	PACK_2
	JR	C,CTIM_0
	CP	60H
	JR	NC,CTIM_0

CTIM_1:	LD	B,0
	LD	A,1
	JP	ACAL1
CTIM_0:	LD	B,0
	LD	A,0
	JP	ACAL1
;
;	PACK_2 - PACKS TO ACC TWO ASCII NUMERIC DIGIT AT (HL), (HL+1)
;		 IF NON-NUMERICS ARE FOUND, RETURNS WITH CY SET
PACK_2:
	LD	A,(HL)
	CALL	CK_NUM		;NUMERIC ASCII?
	RET	C		;NO, RET
	SLA	A		;MAKE ROOM
	SLA	A
	SLA	A
	SLA	A
	INC	HL
	LD	B,A
	LD	A,(HL)		;GET NEXT CHAR
	INC	HL
	CALL	CK_NUM
	RET	C
	AND	0FH
	OR	B		;THIS ALSO CLEARS CY
	RET
;
;	CK_NUM - RETURNS WITH CY SET IF ACC IS NON NUMERIC ASCII CHAR
;
CK_NUM:	CP	'0'
	JR	C,PK2_1
	CP	'9'+1
	JR	NC,PK2_1
	OR	A		;CLEAR CY
	RET

PK2_1:	SCF
	RET


;
;	'CKDAT(X@)'  RETURNS 1 IF X@ IS A CORRECT DATE STRING
;		      RETURNS 0 OTHERWISE
;		      DOES NOT CHECK FEB, 29
;
CHKDAT:	CALL	TSTST
	JP	Z,E19		;MUST BE A STRING
	LD	HL,(VALTEMP-1)
	CALL	EFFLEN
	JP	Z,E19
	XOR	A		;RESULT IS NOT A STRING
	LD	(STRFLG),A

;	CHECK LENGHT

	LD	A,8		;LENGHT HAS TO BE 8
	CP	C
	JR	NZ,CTIM_0

;	CHECK SEPARATORS

	PUSH	HL
	POP	DE		;COPY HL TO DE
	INC	HL
	INC	HL
	LD	A,'/'
	CP	(HL)
	JR	NZ,CDAT_0	;CHECK FIRST SEPARATOR
	INC	HL
	INC	HL
	INC	HL
	CP	(HL)		;CHECK SECOND SEPARATOR
	JR	NZ,CDAT_0
	PUSH	DE		;RESTORE HL TO ITS ORIGINAL VALUE
	POP	HL		;POINTING TO THE BEGINNING OF THE STRING


	INC	HL		;SKIP DAY AND "/"
	INC	HL
	INC	HL

	CALL	PACK_2		;CHECK MONTH FIRST
	JR	C,CDAT_0
	CP	1
	JR	C,CDAT_0
	CP	13H		;MONTH
	JR	NC,CDAT_0
	LD	C,A		;SAVE MONTH

	INC	HL		;SKIP "/"
	CALL	PACK_2
	JR	C,CDAT_0
	CP	99H		;YEAR
	JR	NC,CDAT_0
	CP	86H
	JR	C,CDAT_0

	PUSH	DE
	POP	HL		;CHECK DAY NOW

	CALL	PACK_2		;GET DAY
	JR	C,CDAT_0	;ERROR IN VALUE
	CP	1
	JR	C,CDAT_0
	LD	HL,DAYTAB-1
	LD	B,0
	ADD	HL,BC
	CP	(HL)		;DATA ARE BCD
	JR	NC,CDAT_0

CDAT_1:	LD	B,0
	LD	A,1
	JP	ACAL1
CDAT_0:	LD	B,0
	LD	A,0
	JP	ACAL1

DAYTAB:	DB	32H,30H,32H,31H,32H,31H,32H,32H,31H
;		GG ,FF ,MM ,AA ,MM ,GG ,LL ,AA ,SS
;		1   2   3   4   5   6   7   8   9
	DB	00H,00H,00H,00H,00H,00H,32H,31H,32H
;		NU  NU  NU  NU  NU  NU ,OO ,NN ,DD
;		A   B   C   D   E   F   10  11  12

;	'INT()'
;
AINT:	LD	A,(BC)
	SUB	129
	JP	P,AINT1
;
;	ZERO IF VALUE LESS THAN ONE
;
	LD	D,FPSIZ
	XOR	A
AINT0:	LD	(BC),A
	DEC	BC
	DEC	D
	JP	NZ,AINT0
	RET
;
;	EXP>0
;
AINT1:	SUB	FPNIB-1
	RET	NC
	LD	D,A	;COUNT
	DEC	BC
AINT2:	DEC	BC
	LD	A,(BC)
	AND	360Q
	LD	(BC),A
	INC	D
	RET	Z
	XOR	A
	LD	(BC),A
	INC	D
	JP	NZ,AINT2
	RET


;
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 13 - MISCELLANEUS ROUTINES 		*
;	*							*
;	*		    					*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;---------------------------------------------------------------------------
;	ADD_ERR_COD ROUTINE - COMBINE ERROR CODE BITS
;---------------------------------------------------------------------------

ADDERCO:
	LD	A,(DIAGCO)
	ADD	A,B
	LD	(DIAGCO),A
	RET

;---------------------------------------------------------------------------
;	RAM CHECKSUM COUNT
;---------------------------------------------------------------------------

CALCIK:	LD	HL,CKST	;byte iniziale area da controllare
	LD	DE,NBYT
;	LD	BC,(CKEND-CKST)/NBYT	;n_ bytes da controllare
	LD	BC,(CKEND-8010H)/NBYT	;n_ bytes da controllare
	EXX			;usa registri tampone
	LD	HL,0		;azzera registro cksum 16 bits
	LD	D,0
	EXX
CALCI1:	LD	A,(HL)
	EXX
	LD	E,A
	ADD	HL,DE
	EXX
	ADD	HL,DE
	DEC	BC
	LD	A,B
	OR	C
	JP	NZ,CALCI1	;prosegue calcolo cksum
	EXX
	RET

;---------------------------------------------------------------------------
;	RAM CHECKSUM COUNT (POWER DOWN ONLY)
;---------------------------------------------------------------------------

;	cksum di tipo statistico:
;	somma a 16 bits un byte ogni NBYT
;	esce con HL=cksum a 16 bits

CALCEK:	CALL	CALCIK
	PUSH	HL
	EXX
	POP	HL		;riprende cksum in HL
	RET



;---------------------------------------------------------------------------
;	INIVAR - INIT VARIABLES AND COSTANTS
;---------------------------------------------------------------------------

;	DOES ALSO ROM AND RAM SETUP

INIVAR:

;---------------------------------------------------------------------------
;	SEE IF WE HAVE TO COPY SETUP FROM ROM
;---------------------------------------------------------------------------

	LD	HL,SETUPS
	LD	A,(HL)
	OR	A
	JR	Z,DOSETUP

	LD	DE,STSYS

SUCPY:	LD	A,(HL)
	LD	(DE),A
	INC	DE
	INC	HL
	OR	A		;ZERO COPIED?
	JR	NZ,SUCPY

;---------------------------------------------------------------------------
;	CHECK IF SYS RECORD IS VALID
;---------------------------------------------------------------------------

DOSETUP:
;	XOR	A		;ACC IS ALWAYS ZERO NOW
	LD	(STSYSF),A	;SYS STORAGE IS INVALID

	LD	HL,STSYS	;DOES STSYS CONTAIN 'SYS:' STRING?
	LD	(TXASYS),A

	LD	DE,SYSSTG
	CALL	CMPSTG
	JP	NZ,AUTO_RAM	;NO, ASSIGN RAM AUTOMATICALLY

	LD	A,1		;SYS STORAGE IS VALID
	LD	(STSYSF),A

	INC	HL
	INC	HL

	LD	(TXASYS),HL	;SAVE CURRENT SYSTEM TXA

	LD	DE,STOSTG	;'STOR:'?
	CALL	CMPSTG
	JR	NZ,AUTO_RAM	;NO, ASSIGN RAM AUTOMATICALLY

	INC	HL		;EXPECT 2 DIGITS NOW (ALWAYS)
	LD	A,(HL)
	CALL	CK_NUM		;GET TENTHS
	JR	C,AUTO_RAM
	AND	0FH
	CALL	MPY10

	LD	C,A
	INC	HL
	LD	A,(HL)
	CALL	CK_NUM		;GET UNITS
	JR	C,AUTO_RAM
	AND	0FH
	ADD	A,C
	LD	C,A		;SAVE RESULT

	INC	HL
	LD	A,(HL)
	CP	'K'
	JR	NZ,AUTO_RAM

	INC	HL
	INC	HL
	LD	(TXASYS),HL	;SAVE CURRENT SYSTEM TXA

	LD	H,C		;*256
	LD	L,0
	SLA	H		;*512
	SLA	H		;*1024

	EX	DE,HL		;DE CONTAINS NOW N.OF BYTES FOR STORAGE
	LD	HL,(LSTRAM)	;LAST AVAILABLE RAM LOC
	OR	A		;SUBTRACT DIM FOR STORAGE
	SBC	HL,DE

	JP	ANYSET

;---------------------------------------------------------------------------
;	CMPSTG - COMPARE THE STRING AT (HL) WITH THE STRING AT (DE)
;---------------------------------------------------------------------------
;	RETURNS WITH ZERO SET IF STRINGS MATCH FOR 8 CHARS OR UNTIL ':'
;	RETURNS WITH ZERO RESET IF NO MATCH - NO REGISTER SAVED

CMPSTG:	LD	B,8		;8 CHARS TO TEST
CPLOP:	LD	A,(DE)
	CP	(HL)
	RET	NZ		;NO MATCH
	CP	':'
	RET	Z		;MATCH
	INC	HL
	INC	DE
	DJNZ	CPLOP
	INC	B		;TO RESET ZERO FLAG
	RET			;NO MATCH

;---------------------------------------------------------------------------
;	MPY10 - MULTIPLY ACC * 10
;---------------------------------------------------------------------------
MPY10:	LD	B,A
	SLA	A		;*2
	SLA	A		;*4
	ADD	A,B		;=*5
	SLA	A		;*10
	RET

SYSSTG:	DB	'SYS:'
STOSTG:	DB	'STOR:'
BRGSTG:	DB	'BRG:'
AUTOSTR:DB	'AUTO:'

;--------------------------------------------------------------------------
;	DRADDR - GIVEN FILE # IN C RETURNS DRIVER ADDRESS - DOES ERR CHECK
;--------------------------------------------------------------------------
DRADDR:	LD	A,C		;GET CHANN #
	CP	MAXFILES
	JP	NC,PDERR

	CALL	DIRENTRY	;SET HL
	LD	E,(HL)		;GET DRIVER ADDRESS
	INC	HL
	LD	D,(HL)		;DE HAS THE ADDRESS WHERE TO JUMP
	INC	HL

	LD	A,(HL)		;TEST STATUS - FILE MUST BE OPEN
	OR	A
	JP	Z,NOTOP

	PUSH	DE		;COPY ADDRESS TO IY
	POP	IY

	RET


;	(THIS IS STILL 'INIVAR')

;---------------------------------------------------------------------------
;	AUTO_RAM - ASSIGN THE AVAILABLE RAM 50%-50% BETWEEN WS AND STORAGE
;---------------------------------------------------------------------------


AUTO_RAM:LD	HL,(LSTRAM)	;LAST RAM LOC FOR GBASIC
	LD	DE,MEMTOP+2	;FIRST WORKSPACE LOC
	OR	A		;CLEAR CARRY
	SBC	HL,DE		;HL HAS NOW THE LENGHT OF TOTAL RAM
				;(WORKSPACE+RAM DISK)
	SRL	H		;DIVIDE THE RESULT BY TWO
	RR	L		;SO THAT ONE HALF IS ASSIGNED TO WS
				;AND THE OTHER HALF TO THE RAM DISK
	ADD	HL,DE		;ADD OFFSET FOR GBASIC INTERNAL VARS

ANYSET:	LD	(MEMTOP),HL	;END OF WORKSPACE
	LD	(STB),HL	;INITIALIZE END OF SYMBOL TABLE

	INC	HL

	LD	(NOVST),HL	;NOVRAM BEGINS JUST ABOVE WORKSPACE
	LD	(DKBASE),HL	;INITIALLY ALL THE NOVRAM IS RESERVED
				;FOR RAM DISK

	LD	HL,CRTSTKB	;CRITICAL STATUS STACK
	LD	(CRITSP),HL

	LD	HL,IGNSTKB	;STRUCTURED IF STACK
	LD	(IGNSP),HL

	LD	A,80H		;DEFAULT LINE WIDTH
	LD	(LWID),A

	LD	A,8		;DEFAULT RUBOUT IS STANDARD RUBOUT
	LD	(RUBOUT),A

	LD	A,NBESC0	;DEFAULT VALUE FOR NON BREAK ESCAPE
	LD	(NBESC),A

	LD	A,CONFIR0	;DEFAULT VALUE FOR CONFIRMATION CHAR
	LD	(CONFIRM),A

	XOR	A
	LD	(RITARDO1),A	;NO DELAY FOR NOVRAM WRITE
	LD	(TTYFLG),A	;SET AUTO CONVERT LOWER TO UPPER CASE
	LD	(TRPSTK),A
;	LD	(CMNDSP),A	;a che mai serviva?
	LD	(LOGDEVO),A	;SET OUTPUT CHANNEL TO CON:
	LD	(RAMDEV),A	;IF RAMDEV <> INTERNAL OUT - IGNORE LOGDEVO
	LD	(LOGDEVI),A	;SET INPUT CHANNEL TO KEYBOARD
	LD	(PICTF),A	;PICTURE FLAG FOR INPUT STATEMENT
	LD	(CLEARCH),A	;DISABLE CLEARCH UNTIL USER COMMND
	LD	(IBYTE),A	;CONSOLE STARTS ALWAYS AS CH 0
	LD	(OBYTE),A
	LD	(ERRBYTE),A	;ERROR MESSAGES TO CONSOLE
	LD	(ERRCON),A	;AFTER AN ERROR USE CONSOLE
	LD	(PDOWN),A	;POWER DOWN FLAG
	LD	(CRITIC),A	;AT FIRST, SEGMENT NON CRITIC
	LD	(ROEXFG),A	;EXECUTE RAM PGM
	LD	(INTDIG),A	;FORMAT FOR OUTPUT FIELDS (NO FORMAT)
	LD	(MIDDLE),A	;NOT IN THE MIDDLE OF A STATEMENT
	LD	(SPECRET),A	;NORMAL RETURN
	LD	(MMTK),A	;NO MMT STILL USED
	LD	(FREQ),A	;NO FREQ MEASURED
	LD	(SPECFUN),A	;NO SPECIAL FUNCTION
	LD	(REMFLG),A	;EXECUTE ALSO THE REMAIND. OF GOSUB STAT
	LD	(LSTDRV),A
	LD	(IODRV),A	;USA IN/OUT VERE

	INC	A
	LD	(BRKENA),A	;BREAKS ARE ENABLED
	LD	(ARGNUM),A
	LD	(OUTMOD),A	;DEFAULT IS PIO PORT

	LD	A,(PDFLG)	;INCREMENT POWER DOWN FLAG
	CP	254
	JR	Z,NOINC_PD	;NOT MORE THAN 254
	INC	A
NOINC_PD:
	LD	(PDFLG),A

	LD	A,0FFH
	LD	(AUXIBYTE),A	;AUX TO NO DEVICE
	LD	(AUXOBYTE),A	;AUX TO NO DEVICE
	LD	(AUXOTEMP),A
	LD	(AUXITEMP),A
	LD	(CLKBYTE),A	;CLOCK TO NO DEVICE
	LD	(LOBYTE),A	;LST TO NO DEVICE
	LD	(DIRF),A	;INITIALIZE DIRECT INPUT FLAG

	IF	FMD
	LD	(P70H_IMA),A	;PORT 70H RAM IMAGE
	XOR	A		;PER AUTOKILL
	SET	KILBIT,A
	LD	(PKILPORT_IMA),A ;PORT KILPORT RAM IMAGE
	XOR	A
	ENDIF

	LD	A,'0'		;FILL CHAR FOR FORMATTED OUT
	LD	(FILLCH),A

	LD	HL,TRPSTK
	LD	(TRPSP),HL
	LD	HL,MEMTOP+2
	LD	(BOFA),HL	;START OF USER ASSIGNED MEMORY

	LD	HL,0		;ELAPSED SECS FOR TIMERS
	LD	(SECS1),HL
	LD	(SECS2),HL
	LD	(SECS3),HL
	LD	(UBUPO),HL	;USER BUFFER POINTER

	LD	HL,LASTRO+13	;VEDI NOTA SUL WATCHDOG AD INIZIO FILE
	LD	(WDFUN),HL

	IF	FASTF
	LD	(DOADR),HL
	ENDIF

	CALL	INIASTK		;INIT STACK TO LET BYTARG TO WORK

	CALL	SETUPDR		;CLEAR DIRECTORY TABLE

	RET


;---------------------------------------------------------------------------
;	INIINT - INITIALIZE INTERRUPT SYSTEM
;---------------------------------------------------------------------------
INIINT:	DI
	LD	A,.HIGH.VECTAB		;HIGH VECTAB
	LD	I,A
	IM	2
	RETI				;TO ALLOW COMPLETION OF ALL INITS


;	* * DIMENSION MATRIX
;	SYMTAB ADDR IN HL, HL NOT CLOBBERED
;	DE CONTAINS SIZE IN NUMBER OF ELEMENTS
;
DIMS:	PUSH	HL		;SYMTAB ADDRESS FOR THIS ELEMENT
	INC	DE
	PUSH	DE

	LD	HL,0		;
	LD	C,1		;EACH STRING ELEMENT IS 1 BYTE LONG
	LD	A,(STRFLG)	;IS A STRING DIM?
	OR	A
	JP	NZ,DIM2		;YES, SKIP NEXT

	LD	C,FPSIZ		;EACH FP (NUMERIC) ELEMENT IS FPSIZ LONG

DIM2:	CALL	RADD		;MULTIPLY NELTS BY BYTES PER VALUE

	EX	DE,HL
	LD	HL,(MATA)	;HL = MATRIX BASE ADDRESS
	LD	B,H		;COPY HL TO BC
	LD	C,L
	PUSH	HL		;SAVE THIS MATRIX BASE ADDRESS

	ADD	HL,DE		;HL = ADDR. OF 1ST LOC. AFTER THIS MATRIX
MATCLR:	XOR	A		;CLEAR STORAGE FOR THIS MATRIX
	INC	BC
	LD	(BC),A
	LD	A,C		;END LOOP WHEN BC=HL
	SUB	L
	LD	A,B
	SBC	A,H
	JP	NZ,MATCLR

	CALL	STOV		;CHECK THAT STORAGE NOT EXHAUSTED
	LD	(MATA),HL	;UPDATE MATRIX FREE AREA POINTER

	POP	BC		;GET BACK BASE ADDR OF THIS ELEMENT
	POP	DE		;NELTS
	POP	HL		;SYMTAB ADDR
	PUSH	HL
	LD	(HL),D		;SAVE # OF ELEMENTS IN SYMTAB
	DEC	HL
	LD	(HL),E
	DEC	HL		;SAVE ADDRESS OF THIS ARRAY IN SYMTAB
	LD	(HL),B
	DEC	HL
	LD	(HL),C		;SYMTAB ENTRY NOW SET UP
	NOP
	NOP
	NOP
	NOP
	NOP
	POP	HL
	RET

;---------------------------------------------------------------------------
;	COPYRUN - COPY 'RUN addr' INTO INPUT BUFFER
;---------------------------------------------------------------------------

COPYRUN:PUSH	HL
	PUSH	DE
	PUSH	AF

	LD	DE,IBUF		;DEST
	LD	HL,(AUTOSTG)	;SOURCE

CPYRU1:	LD	A,(HL)
	LD	(DE),A
	INC	HL
	INC	DE
	CP	CR		;CR STORED?
	JR	NZ,CPYRU1	;NO, LOOP

	POP	AF
	POP	DE
	POP	HL
	RET

;---------------------------------------------------------------------------
;	LINE - LINE EDITOR
;---------------------------------------------------------------------------

LINE:	LD	HL,(BOFA);CHECK FOR EMPTY FILE
FIN:	LD	A,(HL)	;CHECK IF APPENDING LINE AT END
	DEC	A
	JP	Z,APP
	EX	DE,HL
	INC	DE
	LD	HL,(IBLN);GET INPUT LINE NUMBER
	EX	DE,HL
	CALL	DCMP	;COMPARE WITH FILE LINE NUMBER
	DEC	HL
	JP	C,INSR	;LESS THAN
	JP	Z,INSR	;EQUAL
	LD	A,(HL)	;LENGTH OF LINE
	CALL	ADR	;JUMP FORWARD
	JP	FIN
;
;	APPEND LINE AT END CASE
;
APP:	LD	A,(IBCNT);DONT APPEND NULL LINE
	CP	4
	RET	Z
	CALL	FULL	;CHECK FOR ROOM IN FILE
	LD	HL,(EOFA);PLACE LINE IN FILE
	CALL	IMOV
	LD	(HL),EOF
	LD	(EOFA),HL
	RET
;
;	INSERT LINE IN FILE CASE
;
INSR:	LD	B,(HL)	;OLD LINE COUNT
	LD	(INSA),HL;INSERT LINE POINTER
	LD	A,(IBCNT);NEW LINE COUNT
	JP	C,LTX	;JMP IF NEW LINE #<>OLD LINE #
	SUB	4
	JP	Z,LT1	;TEST IF SHOULD DELETE NULL LINE
	ADD	A,4
LT1:	SUB	B
	JP	Z,LIN1	;LINE LENGTHS EQUAL
	JP	C,GTX
;
;	EXPAND FILE FOR NEW OR LARGER LINE
;
LTX:	LD	B,A
	LD	A,(IBCNT)
	CP	4	;DON'T INSERT NULL LINE
	RET	Z
	LD	A,B
	CALL	FULL
	LD	HL,(INSA)
	CALL	NMOV
	LD	HL,(EOFA)
	EX	DE,HL
	LD	(EOFA),HL
	INC	BC
	CALL	RMOV
	JP	LIN1
;
;	CONTRACT FILE FOR SMALLER LINE
;
GTX:	CPL
	INC	A
	CALL	ADR
	CALL	NMOV
	EX	DE,HL
	LD	HL,(INSA)
	CALL	NZ,LMOV
	LD	(HL),EOF
	LD	(EOFA),HL
;
;	INSERT CURRENT LINE INTO FILE
;
LIN1:	LD	HL,(INSA)
	LD	A,(IBCNT)
	CP	4
	RET	Z
;
;	INSERT CURRENT LINE AT ADDR HL
;
IMOV:	LD	DE,IBCNT
	LD	A,(DE)
	LD	C,A
	LD	B,0
;
;	COPY BLOCK FROM BEGINNING
;	HL IS DESTIN ADDR, DE IS SOURCE ADDR, BC IS COUNT
;
LMOV:	LD	A,(DE)
	LD	(HL),A
	INC	DE
	INC	HL
	DEC	BC
	LD	A,B
	OR	C
	JP	NZ,LMOV
	RET
;
;	COPY BLOCK STARTING AT END
;	HL IS DESTIN ADDR, DE IS SOURCE ADDR, BC IS COUNT
;
RMOV:	LD	A,(DE)
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	BC
	LD	A,B
	OR	C
	JP	NZ,RMOV
	RET
;
;	COMPUTE FILE MOVE COUNT
;
;	BC GETS (EOFA)-(HL), RET Z SET MEANS ZERO COUNT
;
NMOV:	LD	A,(EOFA)
	SUB	L
	LD	C,A
	LD	A,(EOFA+1)
	SBC	A,H
	LD	B,A
	OR	C
	RET
;
;	ADD A TO HL
;
ADR:	ADD	A,L
	LD	L,A
	RET	NC
	INC	H
	RET
;
;	CHECK FOR FILE OVERFLOW, LEAVES NEW EOFA IN DE
;	A HAS INCREASE IN SIZE
;
FULL:	LD	HL,(EOFA)
	CALL	ADR
	EX	DE,HL
	LD	HL,MEMTOP
	CALL	DCMP
	JP	NC,E8
	RET

;---------------------------------------------------------------------------
;	PP - LINE PREPROCESSOR / UN-PREPROCESSOR
;---------------------------------------------------------------------------

;	PREPROCESS LINE IN IBUF BACK INTO IBUF
;	SETS CARRY IF LINE HAS NO LINE NUMBER
;	LEAVES CORRECT LENGTH OF LINE AFTER PREPROCESSING IN IBCN
;	IF THERE IS A LINE NUMBER, IT IS LOCATED AT IBLN=IBUF-2
;	TXA IS CLOBBERED
;

PP:	LD	HL,IBUF		;FIRST CHARACTER OF INPUT LINE
	LD	(TXA),HL	;SO GCI WILL WORK
	CALL	INTGER		;SETS CARRY IF NO LINE NUMBER
	LD	(IBLN),HL	;STORE LINE NUMBER VALUE (EVEN IF NONE)
	PUSH	AF		;SAVE STATE OF CARRY BIT
	LD	HL,(TXA)	;ADDRESS OF NEXT CHARACTER IN IBUF
	LD	C,4		;SET UP INITIAL VALUE FOR COUNT
	LD	DE,IBUF		;INITIALIZE WRITE POINTER
;
;	COME HERE TO CONTINUE PREPROCESSING LINE
;
PPL:	PUSH	DE
PPLNX:	LD	DE,RWT		;BASE OF RWT

PPL1:	PUSH	HL		;SAVE TEXT ADDRESS
	LD	A,(DE)		;RW VALUE FOR THIS ENTRY IN RWT
	LD	B,A		;SAVE IN B IN CASE OF MATCH
	CP      PREFIX          ;TEST IF RW IS DUAL BYTE
	JR	Z,PRFX		;STATEMENT PREFIX
	CP	FPREFIX
	JR	NZ,NOPRFX
PRFX:	INC	DE
	LD	A,(DE)		;SKIP PREFIX AND GET RW
	LD	(POSTFIX),A	;IN POSTFIX IS STORED SECOND BYTE OF RW
NOPRFX:
PPL2:	INC	DE		;ADVANCE ENTRY POINTER TO NEXT BYTE
	LD	A,(DE)		;GET NEXT CHARACTER FROM ENTRY
	CP	(HL)		;COMPARE WITH CHARACTER IN TEXT
	JP	NZ,PPL3
	INC	HL		;ADVANCE TEXT POINTER
	JP	PPL2
;
;	COME HERE WHEN COMPARISON OF BYTE FAILED
;	(THIS HAPPENS ALWAYS - MUST SEE NOW IF RW FOUND)
;
PPL3:	OR	A
	JP	M,PPL6		;JUMP IF FOUND MATCH
;
;	SCAN TO BEGINNING OF NEXT ENTRY
;
PPL4:	INC	DE		;ADVANCE ENTRY POINTER
	LD	A,(DE)		;NEXT BYTE IS EITHER CHARACTER OR RW BYTE
	OR	A
	JP	P,PPL4		;KEEP SCANNING IF NOT RW BYTE
;
;	NOW SEE IF AT END OF TABLE, AND FAIL OR RETURN CONDITION
;
	CP	96H
	JP	NZ,OLD
	INC	DE
OLD:	POP	HL		;RECOVER ORIGINAL TEXT POINTER
	XOR	377Q		;CHECK FOR END OF TABLE BYTE
	JP	NZ,PPL1		;CONTINUE SCAN OF TABLE
;
;	DIDN'T FIND AN ENTRY AT THE GIVEN TEXT ADDR
;
	POP	DE
	LD	A,(HL)		;GET TEXT CHARACTER
	CP	CR		;CHECK FOR END OF LINE
	JP	Z,PPL8		;GO CLEAN UP AND RETURN
	LD	(DE),A
	INC	DE
	INC	C
	INC     HL      	;ADVANCE TEXT POINTER

	IF	FASTF
	CP      FIP             ;FAST INTEGER PREFIX?
	JR      NZ,PPL4B
	LD      (TXA),HL
	PUSH    DE
	PUSH    BC
	CALL    INTGER		;CONVERTI IN INTERO LA K FAST
	POP     BC
	POP     DE
	CALL	MAKEROOM	;ALLARGA BUFFER PER NON SOVRASCR.
	LD      A,L
	LD      (DE),A		;REGISTRALA A (DE)
	INC     DE
	INC     C		;INCREMENTANDO IL CONTACARATT.
	LD      A,H
	LD      (DE),A
	INC     DE
	INC     C
	LD      HL,(TXA)	;PER COMPENSARE MAKEROOM
	INC	HL
	LD	(TXA),HL
	JP      PPL
	ENDIF

PPL4B:	CP	'"'	;CHECK FOR QUOTED STRING POSSIBILITY
	JP	NZ,PPL	;RESTART RWT SEARCH AT NEXT CHARACTER POSITION
;
;	HERE WE HAVE A QUOTED STRING, SO EAT TILL ENDQUOTE
;
PPL5:	LD	A,(HL)	;NEXT CHARACTER
	CP	CR
	JP	Z,PPL8	;NO STRING ENDQUOTE, LET INTERPRETTER WORRY
	LD	(DE),A
	INC	DE
	INC	C
	INC	HL	;ADVANCE TEXT POINTER
	CP	'"'
	JP	Z,PPL	;BEGIN RWT SCAN FROM NEW CHARACTER POSITION
	JP	PPL5
;
;	FOUND MATCH SO PUT RW VALUE IN TEXT
;
PPL6:   POP     AF      ;REMOVE UNNEEDED TEST POINTER FROM STACK
	POP	DE
	LD	A,B
	LD	(DE),A
	INC	DE
	INC     C
	CP      PREFIX          ;STORED RW WAS PREFIX?
	JR	Z,PRFX1		;NO, SINGLE BYTE RW
	CP	FPREFIX
	JR	NZ,NOPRFX1

PRFX1:	LD	A,(POSTFIX)	;GET SECOND BYTE
	LD	(DE),A		;AND STORE IT
	INC	DE
	INC	C
NOPRFX1:
	AND	240Q		;TEST FOR COMMAND RW
	CP	240Q
	JP	NZ,PPL		;IF NOT COMMAND
	LD	A,B		;TEST FOR BIT 6 SET
	AND	100Q
	JP	NZ,PPL		;IF SET
	JP	PPL5		;END PREPROCESSING OF COMMAND LINE
;
;	COME HERE WHEN DONE
;
PPL8:	LD	A,CR
	LD	(DE),A
	LD	HL,IBCNT	;SET UP COUNT IN CASE LINE OF LINE NUMBER
	LD	(HL),C
	POP	AF		;RESTORE CARRY (LINE NUMBER FLAG)
	RET

;	RICEVE INDIRIZZO DEL TESTO DA SPOSTARE IN DE
;	MUOVE FINO A CR
MAKEROOM:
	PUSH	AF
	PUSH	BC
	PUSH	HL
	LD	HL,(TXA)
	LD	A,(HL)
MKR1:	LD	B,A		;SALVA CARATTERE DA SPOSTARE IN B
	INC	HL
	LD	A,(HL)		;SALVA CARATTERE SUCCESSIVO
	LD	C,A
	LD	A,B		;METTI VECCHIO CARATTERE
	LD	(HL),A
	CP	CR		;HAI SPOSTATO CR?
	LD	A,C
	JR	NZ,MKR1

	POP	HL
	POP	BC
	POP	AF
	RET
;
;	-------- HERE STARTS UNPRE-PROCESS
;
;	UN-PREPROCESS LINE ADDRESSES IN HL TO DE BUFFER
;	RETURN SOURCE ADDRESS OF CR IN HL ON RETURN
;
UPPL:	INC	HL	;SKIP OVER COUNT BYTE
	PUSH	HL	;SAVE SOURCE TEXT POINTER
	CALL	LHLI	;LOAD LINE NUMBER VALUE
	CALL	CNS	;CONVERT LINE NUMBER
	LD	A,' '
	LD	(DE),A	;PUT BLANK AFTER LINE NUMBER
	INC	DE	;INCREMENT DESTINATION POINTER
	POP	HL
	INC	HL	;INCREMENT H PAST LINE NUMBER
UPP0:	INC	HL
	LD	A,(HL)	;NEXT TOKEN IN SOURCE
	OR	A
	JP	M,UPP1	;JUMP IF TOKEN IS RW
	CP	0DH
	JP	Z,PROVA1
	CP	20H
	JP      C,UPP1

	IF	FASTF
	CP      FIP     ;FAST INTEGER PREFIX
	JR      NZ,PROVA1

	LD      (DE),A
	INC     DE
	INC     HL
	PUSH    HL
	CALL    LHLI
	CALL    CNS
	POP     HL
	INC     HL
	JP      UPP0
	ENDIF

PROVA1:
	LD	(DE),A		;PUT CHARACTER IN BUFFER
	CP	CR		;CHECK FOR DONE
	RET	Z
	INC	DE		;ADVANCE DESTINATION BUFFER ADDRESS
	JP	UPP0
;
;	COME HERE WHEN RW BYTE DETECTED IN SOURCE
;
UPP1:	PUSH	HL		;SAVE SOURCE POINTER
	PUSH	AF
UPPNX:	POP	AF
	LD	HL,RWT		;BASE OF RWT
UPP2:	CP	(HL)		;SEE IF RW MATCHED RWT ENTRY
	INC	HL		;ADVANCE RWT POINTER
	JP	NZ,UPP2		;CONTINUE LOOKING IF NOT FOUND
;
;	FOUND MATCH, ENTRY POINTER LOCATES FIRST CHARACTER
;
UPP3:	CP	PREFIX		;RW WAS PREFIX OF A DUAL BYTE?
	JR	Z,UPP51
	CP	FPREFIX
	JR	NZ,UPP5

UPP51:	LD	(CURPREF),A
	POP	BC		;GET SOURCE POINTER IN BC
	INC	BC		;INCREMENT
	PUSH	BC		;AND UPDATE

	LD	A,(BC)		;GET SECOND BYTE FROM SOURCE TO ACC
	CP	(HL)		;COMPARE ALSO SECOND BYTE
	INC	HL
	JP	Z,UPP5		;MATCH FIRST AND SECOND

				;IF NO MATCH
	LD	A,(CURPREF)	;PREPARE TO SEARCH ANOTHER PREFIX

	POP	BC		;AND DECREMENT SOURCE POINTER
	DEC	BC
	PUSH	BC

	JP	UPP2		;NOMATCH

UPP5:	LD	A,(HL)		;CHARACTER OF RW
	OR	A		;CHECK FOR DONE
	JP	M,UPP4
	LD	(DE),A
	INC	DE
	INC	HL
	JP	UPP3
;
;	COME HERE IF DONE WITH RW TRANSFER
;
UPP4:	POP	HL	;SOURCE POINTER
	JP	UPP0
;
;
;
;
;


;
;	* * VARX
;
;	FIND VARIABLE OPTIONALLY SUBSCRIPTED IN TEXT
;	SETS CARRY IF NOT FOUND
;	RETURNS ADDR OF VARIABLE IN HL
;	UPDATES TXA IF FOUND
;
;	IF THE VARIABLE IS ALPHANUMERIC, THEN STRFLG IS SET TO NON ZERO
;	HL POINTS TO STRING BASE ADDRESS AND STLEN CONTAINS THE LENGHT
;
;	VARIABLE NAME FORMAT: B=ALPHA PART C=DIGIT PART (0 IF NO DIGIT)
;
;	IF MSB OF ALPHA PART (B) = 1 THEN THE VARIABLE IS A STRING
;	IF MSB OF DIGIT PART (C) = 1 THEN THE VARIABLE IS A MATRIX

;	Le variabili sono memorizzate all'indietro. Partono dalla parte
;	alta della memoria e vengono in giu'. A partire dall'alto si ha:
;		- lettera
;		- cifra o 0
;		- dato contenuto
;	I numeri sono registrati come segue:

;	FORMATO DI UN '1' FLOATING POINT:
;	(low mem)
;	DB	1*16	;1*16 E' IL NIBBLE PIU' ALTO - E' MSD IN BCD
;	DB	0
;	DB	0
;	DB	0
;	DB	0	;ULTIME DUE FIFRE DELLA MANTISSA
;	DB	0	;SEGNO DELLA MANTISSA 1=NEGATIVO
;FPONE:	DB	129	;ESPONENTE E1 (128 E' E0, 128+1=E+1 ECC.)
;	(high mem)

VARX:	CALL	ALPHA
	RET	C
	CALL	NAME2		;GET NAME FROM TEXT
	XOR	A
	LD	(STRFLG),A	;CLEAR STRING FLAG
	CALL	GC
	CP	'$'		;TEST FOR STRING VARIABLE
	JP	NZ,VARNUM	;NO STRING, JUMP

	LD	(STRFLG),A	;SET STRING FLAG
	JP	VAR1		;AND GO AS A MATRIX

VARNUM:	CP	LPARRW
	JP	Z,VAR1		;TEST IF SUBSCRIPTED
;
;	MUST BE SCALAR VARIABLE
;
	CALL	STLK		;RETURNS ENTRY ADDR IN HL
	OR	A		;CLEAR CARRY
	RET
;
;	MUST BE SUBSCRIPTED
;
VAR1:	CALL	GCI		;GOBBLE LEFT PAREN OR $
	CP	'$'
	JP	NZ,VAR1ST	;NO STRING, JUMP

	LD	A,80H		;SET TYPE TO STRING
	OR	B
	LD	B,A

VAR1ST:	LD	A,80H		;200Q
	OR	C
	LD	C,A		;SET TYPE TO MATRIX
	CALL	STLK
	PUSH	HL		;SYMBOL TABLE
	DEC	HL
	LD	A,(HL)
	LD	(STLEN),A
	INC	HL
	LD	DE,10		;DEFAULT MATRIX SIZE
	CALL	C,DIMS		;DEFAULT DIMENSION MATRIX
	LD	A,(STRFLG)	;IF STRING VARIABLE
	OR	A
	JP	Z,NOSTG

	CALL	GC		;indice specificato?
	CP	LPARRW
	JR	NZ,NOIDX
;	stringa ad indice
	CALL	GCI
	CALL	EXPRB
	LD	B,')'
	CALL	EATC		;GOBBLE RIGHT PAREN
	CALL	PFIX
	DEC	DE		;indici partono da 1
	LD	A,1
	LD	(STRFLG),A	;ripristina flag danneggiato da EXPRB
	LD	(STLEN),A	;lunghezza sempre 1
	JR	STGVAR1
NOIDX:	LD	DE,0
STGVAR1:POP	HL
	DEC	HL
	DEC	HL
	DEC	HL
	CALL	LHLI	;GET BASE ADDR
	ADD	HL,DE
	OR	A	;clear carry
	RET



NOSTG:	CALL	EXPRB	;EVALUATE SUBSCRIPT EXPRESSION
	CALL	PFIX	;DE NOW HAS INTEGER
	CALL	TSTST
	JP	NZ,VAR3
	LD	B,')'
	CALL	EATC	;GOBBLE RIGHT PAREN
VAR3:	POP	HL
	DEC	HL
	CALL	DCMP	;BOUNDS CHECK INDEX
	JP	NC,E5
VAR2:	DEC	HL
	DEC	HL
	CALL	LHLI	;GET BASE ADDR
	LD	C,FPSIZ
	INC	DE	;BECAUSE BASE ADDR IS TO ELEMENT -1
	CALL	RADD	;ADD INDEX, CLEAR CARRY (RADD = ADD DE TO HL C TIMES)
	RET




;
;
;	* * TSTST - TEST STRING - IF STRFLG <> 0 THEN RESET Z-BIT
;	            AND SET C=STLEN
;
TSTST:
	LD	A,(STRFLG)
	OR	A
	RET	Z
	LD	A,(STLEN)
	LD	C,A
	RET



;
;	* * EFFLEN - SIMILAR TO TSTST BUT RETURNS THE EFFECTIVE LENGHT IN C
;	             OF THE STRING PROVIDED ITS ADDRESS IN HL
;          	     STLEN NOT MODIFIED

;	MODIFICATION 14 Maggio 1989
;	IF REG C > (STLEN) THEN (STLEN)->C
;	(EFFECTIVE LENGHT MUST BE LESS OR EQUAL GLOBAL LENGHT
;	I_E_ INCLUDING ZEROES)

;	NOTE 7 NOV 89 - DONT FORGET TO SET STLEN BEFORE!
;			WHEN THE DEST IS NOT A VAR, USE THE MAXIMUM
;			LENGHT THAT THE STRING MAY HAVE
;

EFFLEN:	LD	A,(STRFLG)	;NO STRING?
	OR	A
	RET	Z 		;RETURN

	PUSH	HL		;SAVE STRING ADDRESS
	LD	C,0		;NOW COUNT CHARS UNTIL 0 OR "
EFFL2:	LD	A,(HL)
	CP	0
	JP	Z,EFFL1
	CP	'"'
	JP	Z,EFFL1
	INC	HL
	INC	C
	JP	EFFL2

EFFL1:	LD	A,(STLEN)
	CP	C		;C > (STLEN) ?
	JR	NC,EFFL3	;NC=NO, C <= (STLEN)
	LD	C,A		;C <-- (STLEN)
EFFL3:	POP	HL
	XOR	A
	INC	A		;RESET ZERO FLAG
	RET



;
;	* * NAME
;
;	GET NAME FROM TEXT
;	SETS CARRY IF NAME NOT FOUND
;	IF SUCCEEDS RETURNS NAME IN BC, C=0 IF NO DIGIT IN NAME
;
;	VARIABLE NAME FORMAT: B=ALPHA PART C=DIGIT PART (0 IF NO DIGIT)
;
NAME:	CALL	ALPHA
	RET	C
NAME2:	LD	B,A
	LD	C,0
	CALL	DIG
	CCF
	RET	NC
	LD	C,A
	OR	A	;CLEAR CARRY
	RET




;
;	* * STLK
;
;	SYMBOL TABLE LOOKUP
;	BC CONTAIN NAME AND CLASS
;	IF NOT FOUND THEN CREATE ZERO'ED ENTRY AND SET CARRY
;	HL HAS ADDRESS ON RET
;
STLK:	LD	A,C
	LD	HL,(MEMTOP)
	LD	DE,-STESIZ 	;SET UP BASE AND INCREMENT FOR SEARCH LOOP
STLK0:	LD	A,(HL)
	OR	A
	JP	Z,STLK2		;TEST IF END OF TABLE
	CP	B
	JP	NZ,STLK1	;TEST IF ALPHA COMPARES
	DEC	HL
	LD	A,(HL)		;LOOK FOR DIGIT
	CP	C
	DEC	HL
	RET	Z	 	;CARRY CLEAR SO RET
	INC	HL
	INC	HL
STLK1:	ADD	HL,DE		;DIDN'T COMPARE, DECREMENT POINTER
	JP	STLK0
;
;	ADD ENTRY TO SYMTAB
;
STLK2:	LD	A,(STRFLG)	;STRING MUST BE DEFINED BEFORE
	OR	A
	JP	NZ,E19
	LD	(HL),B
	DEC	HL
	LD	(HL),C
	INC	HL
	EX	DE,HL
	ADD	HL,DE
	LD	(STB),HL	;STORE NEW END OF SYMTAB POINTER
	DEC	DE
	DEC	DE
	EX	DE,HL
	SCF
	RET




;
;	* * ALPHA
;
;	GOBBLES NEXT CHARACTER IF ALPHABETIC
;	SETS CARRY IF NOT
;	NEXT CHAR IN ACC ON FAILURE
;
ALPHA:	CALL	GC
	CP	'A'
	RET	C
	CP	'Z'+1
	CCF
	RET	C
	JP	DIGT1



;
;	* * DIG
;
;	GOBBLES NEXT TEXT CHAR IF DIGIT
;	SETS CARRY IF NOT
;	NEXT CHAR IN ACC ON FAILURE
;
DIG:	CALL	GC
	CP	RESVAR	;TEST TO ACCEPT RESERVED VARIABLE NAMES
	JP	Z,DIGT1
	CP	'0'
	RET	C
	CP	'9'+1
	CCF
	RET	C
DIGT1:	INC	HL
	LD	(TXA),HL
	RET



;
;	* * VCOPY
;
;	COPYS FPSIZ BYTES AT ADDR HL TO ADDR DE
;	ON EXIT HL POINTS TO ADR-1 OF LAST BYTE COPIED
;
VCOPY:	LD	C,FPSIZ
VCOP1:	LD	A,(HL)
	LD	(DE),A
	DEC	HL
	DEC	DE
	DEC	C
	JP	NZ,VCOP1
	RET

;---------------------------------------------------------------------------
;	* * REVCPY1
;---------------------------------------------------------------------------
;
;	COPYS C BYTES AT ADDR HL TO ADDR DE
;	HL IS INCREMENTED / DE IS DECREMENTED
;	ON EXIT DE POINTS TO LAST CHAR - 1
;
REVCPY1:LD	A,(HL)
	LD	(DE),A
	INC	HL
	DEC	DE
	DEC	C
	JP	NZ,REVCPY1
	RET

;---------------------------------------------------------------------------
;	* * REVCPY2
;---------------------------------------------------------------------------
;
;	COPYS A REVERSE STRING AT ADDR DE TO ADDR HL
;	HL IS INCREMENTED / DE IS DECREMENTED
;	STOPS ON NULL TERMINATOR - TERMINATOR ALSO IS COPIED
;
REVCPY2:LD	A,(DE)
	LD	(HL),A
	OR	A
	RET	Z
	INC	HL
	DEC	DE
	DEC	C
	JP	NZ,REVCPY2
	RET




;---------------------------------------------------------------------------
;	JOE - JUNK ON END OF STATEMENT
;---------------------------------------------------------------------------

;	TESTS IF AT END OF FILE
;	EATS CHARACTER AND LINE COUNT AFTER CR
;	LEAVES NEW TXA IN HL
;	SETS CARRY IF END OF FILE

;	DOES NOT CLOBBER DE

JOE:	CALL	GCI		;MULTI STATEMENT LINE? RETURN
	CP	':'
	RET	Z

	CP	CR		;WE MUST THE END OF THE CURRENT LINE
	JP	NZ,E1		;IF WE AREN'T, ERROR

	LD	A,(HL)		;CHECK IF END OF FILE FOLLOWS ("01")
	DEC	A
	JP	Z,JOE2		;YES, SCF AND RET

	INC	HL		;SKIP LINE LENGHT AND LINE NUMBER
	INC	HL
	INC	HL		;SKIP OVER COUNT AND LINE NUMBER
JOE1:	LD	(TXA),HL
	RET

JOE2:	SCF
	JP	JOE1


;	* * COPYSTR - COPY THE STRING FROM ADDRESS HL TO DE
;		      N_ OF BYTES TO COPY IN C REG


;	LA MODIFICA HA LO SCOPO DI VELOCIZZARE (EVITANDO CLRDEST)
;	E DI CONSENTIRE LET A$=SUBSTR$(A$,...
;	(PRIMA IMPOSSIBILE PERCHE' PRIMA DELL'ASSEGNAZIONE VENIVA FATTA
;	CLRDEST)


COPYSTR:
;	CALL	CLRDEST		;MOD SPERIMENTALE 12/9/90

	XOR	A		;MOD 18/10/90
	CP	C		;NULL STRING?
	JR	Z,COPYST2	;YES, JUMP TO SET THE TERMINATOR ONLY

COPYST1:LD	A,(HL)
	LD	(DE),A		;MODIFICA 27/12/91 - PRIMA DELLA MODIFICA
	CP	'"'		;LA COPIA SI ARRESTAVA PRIMA DI AVERE
	RET	Z		;COPIATO IL TERMINATORE
	OR	A
	RET	Z
	INC	HL
	INC	DE
	DEC	C
	JP	NZ,COPYST1

COPYST2:PUSH	AF		;MOD SPERIMENTALE 12/9/90
	XOR	A		;MOD SPERIMENTALE 12/9/90
	LD	(DE),A		;MOD SPERIMENTALE 12/9/90
	POP	AF		;MOD SPERIMENTALE 12/9/90

	RET



;
;	* * CLRDEST - FILLS DESTINATION STRING WITH ZEROES
;
CLRDEST:
	PUSH	DE
	PUSH	BC
	XOR	A
	INC	C
CDEST1:	DEC	C
	JP	Z,CDEST2
	LD	(DE),A
	INC	DE
	JP	CDEST1
CDEST2:	POP	BC
	POP	DE
	RET



;	STRAP - ROUTINE TO PUSH LINE NUMBERS ON TRAP STACK
;	(USED BY 'ON ERROR')

STRAP:	CALL	INTGER		;GET LINE NUMBER
	JP	C,E1		;IF INVALID
	EX	DE,HL
	LD	HL,(TRPSP)	;SET UP BOUNDS CHECK
	LD	BC,-(TRPSTK-TRPSIZ)
	CALL	ARGPSH		;PUSH LINE NUMBER (IF ROOM)
	LD	(TRPSP),HL	;UPDATE STACK POINTER
	CALL	EATCOM		;CHECK FOR MORE
	JP	STRAP		;IF MORE

;
;
;	* * BYTARG - 	ROUTINE TO EVALUATE TEXT EXPRESSIONS, CONVERT
;			RESULT TO INTEGER, AND MAKE SURE INTEGER IS A
;			BYTE VALUE
;
BYTARG:	CALL	EXPRB
BYTAR1:	CALL	PFIX
	CALL	TSTST	;MUST NOT TO BE A STRING
	JP	NZ,E19
	XOR	A
	OR	D
	RET	Z
	JP	E3



;
;	* * ARGPSH  	ROUTINE TO PUSH 16-BIT VALUES ON STACKS
;			AND DO BOUNDS CHECKING ON STACKS
;			ENTRY - HL IS STACK POINTER, BC IS NEGATIVE OF UPPER LIMIT
;				OF STACK
;			EXIT - HL IS UPDATED STACK POINTER
;
ARGPSH:	PUSH	HL	;SAVE SP
	ADD	HL,BC	;DO BOUNDS CHECK
	LD	A,H
	OR	L
	JP	NZ,ARPS1	;IF ROOM ON STACK
	JP	STKERR
;
ARPS1:	POP	HL	;RETRIEVE SP
	LD	(HL),D	;PUSH WORD
	DEC	HL
	LD	(HL),E
	DEC	HL
	RET



;
;	* * EATCOM  	ROUTINE TO CHECK NEXT NON-BLANK FOR ','
;			IF ',' THEN EAT IT AND ADVANCE TO NEXT NON-BLANK
;			RETURN TO CALLER
;			IF NOT ',' THEN POP ONE WORD OFF STACK AND RETURN
;			TO CALLER OF CALLER
;
EATCOM:	CALL	GC
	CP	','
	JP	Z,ETCO1
	POP	HL
	RET
;
ETCO1:	CALL	GCI
	CALL	GC
	RET


;
;	* * PSHAS
;
;	PUSH VALUE ADDRESSED BY HL ONTO ARG STACK
;	SETS ARGF, CLEARS CARRY
;
PSHAS:	EX	DE,HL
PSHA1:	LD	HL,(ASTKA)
	LD	BC,-FPSIZ
	ADD	HL,BC
	LD	(ASTKA),HL;DECREMENT ARG STACK POINTER
	EX	DE,HL
	CALL	VCOPY
	LD	A,1
	LD	(ARGF),A;CLEAR ARGF
	OR	A	;CLEAR CARRY
	RET


;
;	* * POPAS
;
;	POP ARG STACK
;	HL CONTAINS ADDRESS TO PUT POPPED VALUE AT
;
POPAS:	EX	DE,HL
POPA1:	LD	HL,(ASTKA)
	PUSH	HL
	LD	BC,FPSIZ
	ADD	HL,BC
	LD	(ASTKA),HL	;INCREMENT STACK POINTER
	POP	HL
	JP	VCOPY



;
;	* * PSHCS
;
;	PUSH FRAME ONTO CONTROL STACK
;	TAKES MINUS AMOUNT TO SUB FROM CSTKA IN DE
;	DOES OVERFLOW TEST AND RETURNS OLD CSTKA-1
;
PSHCS:	LD	HL,(CSTKA)
	PUSH	HL
	ADD	HL,DE
	LD	(CSTKA),HL
	EX	DE,HL
	LD	HL,LCSTKA	;ADDR CONTAINS CSTKL
	CALL	DCMP
	JP	C,E4D
	POP	HL
	DEC	HL
	RET



;
;	* * STOV
;
;	STORAGE OVERFLOW TEST
;	TEST THAT VALUE IN HL IS BETWEEN MATA AND STB
;	DOES NOT CLOBBER HL
;
STOV:	EX	DE,HL
	LD	HL,MATA
	CALL	DCMP
	JP	C,E8
	LD	HL,STB
	CALL	DCMP
	EX	DE,HL
	RET	C
	JP	E8



;	PSH_CH	- PUSH A CHAR INTO THE USER FIFO

PSH_CH:	LD	DE,(USP_WR)
	LD	(DE),A
	INC	DE

	LD	A,.HIGH.USP_LIM
	CP	D
	JP	NZ,NOLIM1
	LD	A,.LOW.USP_LIM
	CP	E
	JP	NZ,NOLIM1
	LD	DE,USTACK
NOLIM1:	LD	(USP_WR),DE
	RET


;	POP_USTK - POP A STRING FROM THE USER STACK TO DE
;		   IT APPENDS A NULL TERMINATOR
POP_USTK:
	CALL	SAVIFF
	PUSH	DE
	LD	HL,(USP_FR)	;TEST FOR AN EMPTY STACK
	LD	DE,USP_LIM-USTACK
	OR	A
	SBC	HL,DE
	JP	Z,STKERR

	CALL	POP_CH		;GET STRING LENGHT
	LD	C,A
	CALL	POP_CH
	LD	B,A
	INC	BC		;INCLUDE TWO BYTES OF STRING LENGHT
	INC	BC

	LD	HL,(USP_FR)
	ADD	HL,BC		;FREE SPACE BECOMES WIDER
	LD	(USP_FR),HL
	POP	DE
	DEC	BC		;STRING LENGHT ALREADY POPPED
	DEC	BC
POP_1:
	CALL	POP_CH
	LD	(DE),A

	INC	DE
	DEC	BC
	XOR	A
	OR	C
	JP	NZ,POP_1
	OR	B
	JP	NZ,POP_1

	LD	(DE),A		;APPEND TERMINATOR
	CALL	RESIFF
	RET

;	POP_CH	- POP A CHAR FROM THE USER FIFO

POP_CH:	LD	HL,(USP_RD)
	LD	A,(HL)
	PUSH	AF
	INC	HL
	LD	A,.LOW.USP_LIM
	CP	L
	JP	NZ,NOLIM2
	LD	A,.HIGH.USP_LIM
	CP	H
	JP	NZ,NOLIM2
	LD	HL,USTACK
NOLIM2:	LD	(USP_RD),HL
	POP	AF
	RET


;
;	* * EATC
;
;	INCREMENT TXA IF NEXT NON-BLANK CHAR IS EQUAL TO B
;	ELSE SYNTAX ERROR
;
EATC:	CALL	GCI
	CP	B
	RET	Z
	JP	E1


;
;	* * GC
;
;	GET NEXT NON-BLANK CHAR INTO ACC
;	INCREMENT PAST BLANKS ONLY
;
GC:	CALL	GCI
	DEC	HL
	LD	(TXA),HL
	RET


;
;	* * GCI
;
;	GET NEXT NON-BLANK TEXT CHAR AND INCREMENT TXA
;	DOES NOT CLOBBER DE, BC
;	RETURN CHAR IN ACC
;
GCI:	LD	HL,(TXA)
GCI0:	LD	A,(HL)
	INC	HL
	CP	' '
	JP	Z,GCI0
	LD	(TXA),HL
	RET



;
;	* * GCIAB - SIMILAR TO GCI, DOES NOT IGNORE BLANKS (AB=ANTIBLANK)
;
GCIAB:	LD	HL,(TXA)
	LD	A,(HL)
	INC	HL
	LD	(TXA),HL
	RET



;
;	* * RADD
;
;	REPEAT ADD
;	ADDS DE TO HL C TIMES
;
RADD:	ADD	HL,DE
	DEC	C
	JP	NZ,RADD
	RET


;
;	* * PRNT
;
;	PRINT MESSAGE ADDRESSED BY HL
;	ENDS WITH CHARACTER PROVIDED IN C
;	RETURN IN HL ADDRESS OF TERMINATOR
;
PRNTCR:	LD	C,CR
	JP	PRN1
;
PRNT:	LD	C,'"'
PRN1:	LD	A,(HL)	;GET NEXT CHAR
	LD	B,A	;FOR CHOUT
	CP	C	;END OF MESSAGE TEST
	RET	Z
	CP	CR
	JP	Z,E1	;NEVER PRINT A CR IN THIS  ROUTINE
	CALL	CHOUT
	INC	HL
	JP	PRN1



;	* * DCMP
;
;	16 BIT UNSIGNED COMPARE
;	COMPARE DE AGAINST VALUE (2 BYTES) ADDRESSED BY HL
;	CLOBBERS A ONLY
;
DCMP:	LD	A,E
	SUB	(HL)
	INC	HL
	LD	A,D
	SBC	A,(HL)
	DEC	HL
	RET	NZ
	LD	A,E
	SUB	(HL)
	OR	A	;CLEAR CARRY
	RET


;
;	* * LHLI
;
;	INDIRECT LOAD HL THRU HL
;
LHLI:	PUSH	AF
	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,A
	POP	AF
	RET


;
;	* * CONST
;
;	GET FP CONSTANT FROM TEXT
;	PUSHES VALUE ON ARG STACK AND SETS ARGF FLAG
;	SETS CARRY IF NOT FOUND
;
CONST:	LD	HL,(TXA);PREPARE CALL FPIN
	EX	DE,HL
	LD	HL,FPSINK
	CALL	FPIN
	RET	C
	DEC	DE
	EX	DE,HL
	LD	(TXA),HL;NOW POINTS TO TERMINATOR
	LD	DE,FPSINK
	CALL	PSHA1
	XOR	A
	INC	A	;SET A TO 1 AND CLEAR CARRY
	LD	(ARGF),A
	RET



;
;	* * DIRT DIRECT STATEMENT CHECKING ROUTINE
;
DIRT:	LD	A,(DIRF)
	OR	A
	RET	Z
	JP	DIRERR




;	* * FINDLN
;
;	FIND TEXT LINE WITH LINE NUMBER GIVEN IN DE
;	RETURNS ADDRESS OF COUNT BYTE OF REQ LINE IN HL

FINDLN:	LD	(PASSNAME),DE	;TEST ONLY
	LD	HL,(BOFA)
	LD	B,0

FIND1:	LD	C,(HL)
	LD	A,C
	CP	EOF
	JP	Z,LERROR
	INC	HL
	CALL	DCMP
	DEC	HL
	RET	Z
	ADD	HL,BC
	JP	FIND1



;
;	* * BIT		SET BIT N IN ACC; N ARE THE LEAST SB OF
;			E REG - IF N=0 ACC=80H - IF N=7 ACC=1
;
;BIT:	LD	A,D
;	AND	7
;	INC	A
;	LD	D,A
;	LD	A,1
;SHAGAIN:
;	RRCA
;	DEC	D
;	JP	NZ,SHAGAIN
;	RET

;------------------------------------------------------------------------
;	CONFISTR - SEARCH TEXT FOR A STRING AND RETURNS ITS ADDRESS IN
;------------------------------------------------------------------------
;	(TXA_CS) - TXA UPDATED - CHECKS STRING LENGHT TO 40

;	MOD. 10/NOV/91: RETURNS WITH ZERO FLAG RESET IF, INSTEAD OF
;	A STRING, THERE IS A NUMERIC EXPR - ITS INTEGER VALUE IS RETURNED
;	IN DE

CONFISTR:
	CALL	EXPRB		;GET CONFIG STRING ADDRESS
	CALL	TSTST		;IS IT A STRING?
	JR	NZ,CNF1		;YES, JUMP

	CALL	PFIX
	XOR	A
	INC	A
	RET

CNF1:	CALL	EFFLEN

	LD	A,40		;MAXIMUM LENGHT
	CP	C
	JP	C,E19

	LD	(TXA_CS),HL	;PREPARE TO USE PARSE_CS
	XOR	A
	RET


;	* * FIX
;
;	FIX FLOATING TO POSITIVE INTEGER
;	RETURN INTEGER VALUE IN DE
;	FP VALUE FROM TOP OF ARG STACK, POP ARG STACK
;
PFIX:
	XOR	A
	LD	(NEGINT),A;CLEAR NEGINT
	LD	HL,(ASTKA)
	LD	B,H
	LD	C,L
	PUSH	HL
	CALL	AINT
	LD	HL,FPSINK
	CALL	POPAS
	POP	HL
	LD	C,(HL)	;EXPONENT
	DEC	HL
	LD	A,(HL)	;SIGN
	OR	A
	JP	Z,PFIX2	;NO NEGATIVE SIGN, JUMP
	LD	A,80H
	LD	(NEGINT),A;SET NEGATIVE RESULT
PFIX2:	LD	DE,-FPSIZ+1
	ADD	HL,DE
	LD	DE,0
	LD	A,C
	OR	A
	RET	Z
	DEC	C	;SET UP FOR LOOP CLOSE TEST
PFIX1:	INC	HL
	LD	A,(HL)
	RRCA
	RRCA
	RRCA
	RRCA
	CALL	MUL10
	JP	C,E3
	DEC	C
	RET	P
	LD	A,(HL)
	CALL	MUL10
	JP	C,E3
	DEC	C
	JP	M,PFIX1
	RET


;
;	* * MUL10
;
;	TAKE NEXT  DIGIT IN A (MASK TO 0FH), ACCUMULATE TO DE
;	PRESERVES ALL BUT A, DE
;
MUL10:	CALL	SAVIFF	;SAVE INTERRUPT STATUS
	PUSH	HL
	INC	SP
	INC	SP
	LD	H,D	;GET ORIGINAL VALUE TO HL
	LD	L,E
	ADD	HL,HL	;DOUBLE IT
	JP	C,MULXIT
	ADD	HL,HL	;AGAIN
	JP	C,MULXIT
	ADD	HL,DE	;PLUS ORIGINAL MAKES 5 TIMES ORIG
	JP	C,MULXIT
	ADD	HL,HL	;TIMES TWO MAKES TEN
	JP	C,MULXIT
	EX	DE,HL
	DEC	SP
	DEC	SP
	POP	HL
	AND	17Q
	ADD	A,E
	LD	E,A
	LD	A,D
	ADC	A,0	;PROPOGATE THE CARRY
	LD	D,A
MULXIT:	CALL	RESIFF	;RESTORE INTERRUPT STATUS
	RET


;----------------------------------------------------------------------------
;	SAVIFF - SAVE CURRENT INT ENABLE STATUS AND DISABLE INT
;----------------------------------------------------------------------------

;	USE SAVIFF / RESIFF IF YOU WANT TO NOT DESTROY ANY REG

;	SAVIFF / RESIFF CANNOT BE NESTED

SAVIFF:	PUSH	AF
	XOR	A		;CLEAR CARRY AND ACC
	PUSH	AF		;STACK BOTTOM = 00xxH
	POP	AF
	LD	A,I		;PARITY FLAG = IFF2
	JP	PE,ENA		;JUMP IF ENABLED
	DEC	SP		;MAY BE DISABLED
	DEC	SP		;HAS STACK BOTTOM BE OVERWRITTEN?
	POP	AF
	AND	A		;IF NOT 00xxH INTS WERE ACTUALLY ENABLED
	JR	Z,DISA		;NO, DISABLED

ENA:	LD	A,1		;SET FLAG (INTERRUPTS WERE ENABLED)
DISA:	LD	(IFF2),A
	DI
	POP	AF
	RET


;	VALE SOLO PER CPU Z80 SENZA BACHI
;	(DOVREBBERO ESSERE LE CMOS MA MI SEMBRA CHE FACCIANO UGUALE,
;	TOSHIBA ALMENO)

	IFDEF 	Z80OK
SAVIFF:	PUSH	AF
	LD	A,I
	DI
	LD	A,1		;SET FLAG (INTERRUPTS WERE ENABLED)
	JP	PE,ANYENA

	XOR	A		;RESET FLAG (INTS WERE DISABLED)

ANYENA:	LD	(IFF2),A
	POP	AF
	RET
	ENDIF

;----------------------------------------------------------------------------
;	RESIFF - RESTORE INT STATUS SAVED BY SAVIFF
;----------------------------------------------------------------------------

RESIFF:	PUSH	AF
	LD	A,(IFF2)	;SEE SAVED STATUS
	OR	A
	DI
	JR	Z,QSETIF	;ZERO, INTS WERE DISABLED - RETURN
	EI			;NON ZERO - RE-ENABLE
QSETIF:	POP	AF
	RET

;----------------------------------------------------------------------------
;	GETIFF - GET IFF2 STATUS INTO ACC AND DISABLE INTS
;----------------------------------------------------------------------------


;	SETS ACC=1 IF INT ARE ENABLED AND =0 OTHERWISE
;	PUSH AF MUST FOLLOW



GETIFF:	XOR	A		;CLEAR CARRY AND ACC
	PUSH	AF		;STACK BOTTOM = 00xxH
	POP	AF
	LD	A,I		;PARITY FLAG = IFF2
	JP	PE,ENA1		;JUMP IF ENABLED
	DEC	SP		;MAY BE DISABLED
	DEC	SP		;HAS STACK BOTTOM BE OVERWRITTEN?
	POP	AF
	AND	A		;IF NOT 00xxH INTS WERE ACTUALLY ENABLED
	JR	Z,DISA1		;NO, DISABLED

ENA1:	LD	A,1		;SET FLAG (INTERRUPTS WERE ENABLED)
DISA1:	DI
	RET

;	VALE SOLO PER CPU Z80 SENZA BACHI
;	(DOVREBBERO ESSERE LE CMOS MA MI SEMBRA CHE FACCIANO UGUALE,
;	TOSHIBA ALMENO)

	IFDEF 	Z80OK
GETIFF:	LD	A,I		;PARITY FLAG = IFF2
	DI
	LD	A,1
	RET	PE		;JUMP IF ENABLED

	XOR	A
	RET
	ENDIF


;----------------------------------------------------------------------------
;	SETIFF - RESTORE INT STATUS ACCORDING TO ACC
;----------------------------------------------------------------------------

;	IF ACC=1 THEN SETS INT - IF ACC=0 THEN DISABLE INT
;	MUST FOLLOW POP AF

SETIFF:	OR	A
	JR	Z,DIX		;ZERO - DISABLE
	EI			;NON ZERO - RE-ENABLE
	RET

DIX:	DI
	RET

;
;	* * INTGER
;
;	GET INTEGER FROM TEXT
;	SET CARRY IF NOT FOUND
;	RETURN INTEGER VALUE IN HL
;       RETURN TERMINATOR IN ACC
;
INTGER:
	IF	FASTF
	CALL    GC
	CP      FIP
	JP      NZ,INTG3
FINTGR: CALL    GCI             ;EAT FIP (FAST INTEGER PREFIX)
	LD      HL,(TXA)

	LD      E,(HL)		;GET FIRST BYTE (LOW) OF THE ADDRESS
	INC     HL
	LD      D,(HL)
	INC     HL
	LD      (TXA),HL	;UPDATE HL
	CALL    GC		;GET TERMINATOR TO RETURN
	EX      DE,HL		;INTEGER VALUE INTO HL
	OR      A
	RET
	ENDIF

;	INTG3 IS A SECONDARY ENTRY POINT

INTG3:  CALL    DIG
	RET	C
	LD	DE,0
	JP	INTG2
;
INTG1:	CALL	DIG
	LD	H,D
	LD	L,E
	CCF
	RET	NC
INTG2:	SUB	'0'
	CALL	MUL10
	JP	NC,INTG1
	RET


;	* * CNS
;
;	CONVERT INTEGER TO STRING
;	DE CONTAINS ADDR OF STRING, RETURN UPDATED VALUE IN DE
;	HL CONTAINS VALUE TO CONVERT
;
CNS:	XOR	A		;SET FOR NO LEADING ZEROES
	LD	BC,-10000
	CALL	RSUB
	LD	BC,-1000
	CALL	RSUB
	LD	BC,-100
	CALL	RSUB
	LD	BC,-10
	CALL	RSUB
	LD	BC,-1
	CALL	RSUB
	RET	NZ
	LD	A,'0'
	LD	(DE),A
	INC	DE
	RET


;----------------------------------------------------------------------------
;	RSUB
;----------------------------------------------------------------------------
;
;	TAKE VALUE IN HL
;	ADD NEGATIVE NUMBER IN BC THE MOST POSSIBLE TIMES
;	PUT VALUE ON STRING AT DE
;	IF A=0 THEN DONT PUT LEADING ZERO ON STRING
;	RETURN NON-ZERO IN A IF PUT ON STRING
;
RSUB:	PUSH	IX
	PUSH	DE
	LD	D,0FFH		;-1 - IT SHAL BE INCREMENTED AT LEAST 1 TIME


RSUB1:	PUSH	HL		;COPY HL TO IX
	POP	IX		;SAVE BEFORE SUB
	INC	D
	ADD	HL,BC		;'SUBTRACT' BC
	JP	C,RSUB1		;MORE TO GO? LOOP

	LD	B,D
	POP	DE		;RESTORE DE
	PUSH	IX
	POP	HL		;SET HL = IX

	POP	IX

	OR	B		;ACC GETS 0 IF ACC WAS 0 AND B IS 0
	RET	Z

	LD	A,'0'		;TRANSFORM TO ASCII AND WRITE
	ADD	A,B
	LD	(DE),A
	INC	DE

	RET



;	* * DBYTE -	EMETTE IN HEX IL CONTENUTO DI B

DBYTE:	LD	A,B
	SRL	A
	SRL	A
	SRL	A
	SRL	A
	CALL	CVTAS	;EMISSIONE PRIMA CIFRA HEX
	LD	A,B
	CALL	CVTAS	;EMISSIONE SECONDA CIFRA
	RET

;	* * CVTAS - CONVERTE UN NUMERO BINARIO CONTENUTO
;		    NEI 4 BIT MENO SIGNIFICATIVI DI ACC
;		    IN UN CARATTERE ASCII CHE NE RAPPRESENTA
;		    IL VALORE IN ASCII E QUINDI LO FA USCIRE
;		    SU VIDEO

CVTAS:
	AND	0FH	;TIRA VIA I 4 BIT PIU' SIGNIF_
	ADD	A,'0'	;CONVERTI IN ASCII
	CP	'9'+1	;GUARDA SE ERA 0__9
	JP	C,VOUT
	ADD	A,'A'-'0'-10 ;CONVERTI A__F

VOUT:	PUSH	AF
	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	B,A
	CALL	CHOUT
	POP	HL
	POP	DE
	POP	BC
	POP	AF
	RET


;
;	* * RDNUM - READS AN ASCII HEX NUMBER AT DE
;		AND CONVERTS TO BINARY INTO HL
;		ONLY LAST FOUR DIGITS ARE CONSIDERED
;		RETURNS WITH CARRY SET ON FIRST NON ASCII CHAR
;		IF THIS IS = CR THEN ACC=FF
;
RDNUM:
	LD	HL,0	;INIZIA CON VALORE 0
	CALL	RDHEX	;LEGGI UNA CIFRA
	JR	NC,RDNXT
	CP	CR
	RET	NZ
	LD	A,0FFH
	RET
RDNXT:	ADD	HL,HL	;SHIFTA HL DI 4 A SINISTRA
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	OR	L	;COMBINA CON LA NUOVA CIFRA
	LD	L,A
	CALL	RDHEX	;PRENDI UN'ALTRA CIFRA
	RET	C	;SE CARRY=1 LAVORO FINITO
	JR	RDNXT
;
;
;	* * RDHEX - LEGGE UN CARATTERE ASCII DAL TESTO, GLI
;		    TOGLIE IL BIT PIU' SIGNIFICATIVO E LO ESA-
;		    MINA PER VEDERE SE APPARTIENE AL SET DELLE
;	            CIFRE ESADECIMALI (0-9 A-F)_ SE SI, VIENE
;		    LASCIATO IL CORRISPONDENTE VALORE BINARIO
;		    IN ACC_ ED IL CARRY=0_ SE NO, OGNI ALTRO
;		    CARATTERE E' LASCIATO INTATTO ED IL CARRY
;		    E' POSTO AD 1_
;

RDHEX:	LD	A,(DE)	;LEGGI UN CARATTERE
	INC	DE
	CP	'0'	;MENO DI 0 ASCII? (NON CERTO HEX)
	RET	C
	CP	'9'+1	;E' NEL RANGO 0-9?
	JR	C,RDDIG
	CP	'A'	;E' COMPRESO TRA 9 ED A (ASCII)?
	RET	C
	CP	'F'+1	;E' MAGGIORE DI F?
	CCF
	RET	C
	SUB	'A'-10	;TRADUCI A-F
	RET
RDDIG:	SUB	'0'	;TRADUCI '0'__'9'
	RET



;	* * CK1_3 - CHECKS ACC IS IN 1-3 RANGE
;		    IF NOT, GIVES AN ARGUMENT ERROR

CK1_3:	CP	1		;PULSER # ALLOWED ONLY
	JP	C,E3
	CP	4		;IN 1-3 RANGE
	JP	NC,E3
	RET

;	* * CKOSCN - CHECKS ACC IS IN 1..TOTOSC RANGE
;		    IF NOT, GIVES AN ARGUMENT ERROR

CKOSCN:	CP	1		;PULSER # ALLOWED ONLY
	JP	C,E3
	CP	TOTOSC+1	;IN 1-TOTOSC RANGE
	JP	NC,E3
	RET

;----------------------------------------------------------------------------
;	CHOUT - GENERIC CHAR OUTPUT ROUTINE
;----------------------------------------------------------------------------

;	PROGRAMS SHOULD NOT CALL OTHER ROUTINES TO OUTPUT CHARS

;	NEW REVISION SEPT, 15, 1990

;	LOGDEVO CONTAINS THE LOGIC DEVICE TO BE USED AS FOLLOW

;		0 - CON:
;		1 - USER RAM BUFFER - USED BY PRINTS STATEMENT
;		2 - LST:
;		3 - ERR:
;		4 - RESERVED FOR FUTURE USE
;		5 - FILE OUTPUT FOR PRINT STATEMENT
;		6 - RESERVED FOR FUTURE USE
;		7 - AUX:
;	       77H- FDM (FILE DRIVER MANAGER) OUTPUT

;	B = CHAR TO BE OUPTUT
;
;	FOR COMPATIBILITY WITH OLDER PROGRAMS
;	OUTPUT CAN BE ALTERNATIVELY DIRECTED TO BUFFER
;	CALLING THIS ROUTINE WITH RAMDEV<>0_
;	SAME AS LOGDEVO=1
;
CHOUT:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	A,(RAMDEV)	;FIRST TEST IF THIS IS AN INTERNAL
	CP	0		;EMISSION TO BUFFER
	JR	NZ,OTOBUF
	LD	A,(LOGDEVO)	;TEST WICH OUTPUT CHANNEL IS TO BE
				;USED
	CP	0
	JR	Z,OTOCON	;CON:

	CP	1
	JR	Z,OTOBUF	;USER BUFFER OUT - SEE NOTE BELOW

	CP	2
	JR	Z,OTOPRINT	;LST:

	CP	3
	JR	Z,OTOERR	;ERR:

	CP	5
	JR	Z,OTOSA		;OUT TO SAVE AREA

	CP	7
	JR	Z,OTOAUX	;OUT TO AUX:

	CP	77H		;OUTPUT TO (RECO_PO)
	JR	Z,FDM_OUT	;USED BY FDM (FILE DRIVER MANAGER)

	JP	CHANERR		;CHANNEL ERROR

;----------------------------------------------------------------------------
;	CHOUT (0) - OUTPUT TO CON:
;----------------------------------------------------------------------------

OTOCON:	LD	A,B
	CALL	CONOUT

CHOX1:	POP	HL
	POP	DE
	POP	BC

	LD	A,B
CHCHK:	CP	CR
	JR	NZ,CHLF		;NOT CR IS IT LF?
	XOR	A
	JR	PSTOR		;RETURN PHEAD TO ZERO

CHLF:	CP	20H		;NO PHEAD INC IF CONTROL CHAR
	RET	C

	LD	A,(PHEAD)
	INC	A
PSTOR:	LD	(PHEAD),A
	RET

;----------------------------------------------------------------------------
;	CHOUT (1) - USER RAM BUFFER
;----------------------------------------------------------------------------

;	(MAXBUF) IS DECREMENTED BEFORE WRITING - IF IT COMES TO ZERO
;	STRING ERROR IS GENERATED
;	DATA IS WRITTEN AT ADDRESS STORED IN UBUPO (USER BUFFER POINTER)
;	IF .HIGH.UBUPO=0 THEN BUG ERROR - THIS IS DONE TO SEE IF THE OLD
;	WRITE POINTER SYSTEM (IX) IS STILL IN USE BY ANY ROUTINE

;	USER MUST RESTORE UBUPO TO ZERO AFTER USE TO LET BUG ERROR CHECK

OTOBUF:	PUSH	AF
	PUSH	HL		;DECREMENT MAXBUF TO SEE IF THERE IS
	LD	HL,MAXBUF	;SPACE FOR A NEW CHAR
	LD	A,H
	OR	L
	JR	Z,NOCK
	DEC	(HL)
	JP	Z,E19		;NO, STRING ERROR

NOCK:	LD	HL,(UBUPO)	;IF HIGH.UBUPO = 0 THEN ERR
	XOR	A
	CP	H
	JP	Z,BUGERR

	LD	(HL),B		;OUTPUT TO BUFFER ADDRESSED BY UBUPO
	INC	HL
	LD	(UBUPO),HL	;INC HL

	POP	HL
	POP	AF
	JR	OTOEX

;----------------------------------------------------------------------------
;	CHOUT (2) - OUTPUT TO LST:
;----------------------------------------------------------------------------

OTOPRINT:
	LD	A,B
	CALL	LST
	JR	CHOX1


;----------------------------------------------------------------------------
;	CHOUT (3) - OUTPUT TO ERR:
;----------------------------------------------------------------------------

OTOERR:	LD	A,B
	CALL	ERROUT
	JR	CHOX1


;----------------------------------------------------------------------------
;	CHOUT (5) - FILE OUTPUT FOR PRINT STATEMENT
;----------------------------------------------------------------------------

OTOSA:	LD	HL,(SAPTMP)	;LOAD HL WITH SAVE AREA POINTER
	OR	A		;CLEAR CARRY
	LD	DE,(LSTRAM)
	PUSH	HL
	SBC	HL,DE
	JP	NC,E8		;OUT OF MEMORY ERROR?
	POP	HL
	LD	A,B
	LD	(HL),A
	CALL	EEWAIT		;WAIT NOVRAM
	INC	HL
	LD	(SAPTMP),HL	;INCREMENT SAPTMP

OTOEX:	POP	HL
	POP	DE
	POP	BC
	RET

;----------------------------------------------------------------------------
;	CHOUT (7) - OUTPUT TO AUX:
;----------------------------------------------------------------------------

OTOAUX:	LD	A,B
	CALL	AUXOUT
	JR	CHOX1

;----------------------------------------------------------------------------
;	CHOUT (77) - OUTPUT TO (RECO_PO) - USED BY FDM (FILE DRIVER MANAGER)
;----------------------------------------------------------------------------

FDM_OUT:LD	HL,(RECO_PO)
	LD	A,B
	LD	(HL),A
	INC	HL
	LD	(RECO_PO),HL
	JR	OTOEX

;----------------------------------------------------------------------------
;	CRLF AND SIMILARS - USE CHOUT
;----------------------------------------------------------------------------

CRLF2:	CALL	CRLF
CRLF:	LD	B,CR
	CALL	CHOUT

LFONLY:	LD	B,LF
	JP	CHOUT


;----------------------------------------------------------------------------
;	LDEVIN - INPUT A CHAR FROM A LOGIC DEVICE
;----------------------------------------------------------------------------

;	GENERIC CHAR INPUT ROUTINE (PREVIOUSLY 'INCHAR' AND, LATER, CHINP)

;	PROGRAMS SHOULD NOT CALL OTHER ROUTINES TO INPUT CHARS

;	NEW REVISION SEPT, 15, 1990
;	UPDATED NOV, 17, 1991

;	LOGDEVI CONTAINS THE LOGIC DEVICE TO BE USED AS FOLLOW

;		0 - CON:
;		1 - USER RAM BUFFER
;		2 - RESERVED FOR FUTURE USE
;		3 - RESERVED FOR FUTURE USE
;		4 - CONSOLE SINGLE CHAR "ON FLY"
;		5 - FILE INPUT FOR INPUT CH STATEMENT
;		6 - CONSOLE WITH NON NUMERIC CHARACTERS STRIP OFF
;		7 - AUX:
;	       77H- FDM (FILE DRIVER MANAGER) INPUT

;	INPUT CHARACTER IS LEFT IN B AND ACC

LDEVIN:	PUSH	HL
	PUSH	DE

INCHA14:LD	A,(LOGDEVI)	;WHICH CHANNEL?

	CP	0
	JR	Z,IFROCON	;INPUT FROM CON:

	CP	1
	JP	Z,IFROBUF	;RAM BUFFER (USED WITH 'STORAGE ABS')

	CP	5
	JP	Z,IFROSA	;IN FROM A STORAGE

	CP	6		;CHANNEL SIX READS FROM CON:
	JR	Z,IFROCON	;BUT STRIPS NON NUMERIC CHARS

	CP	7
	JR	Z,IFROAUX	;IN FROM AUXILIARY DEVICE

	CP	77H
	JP	Z,FDM_IN	;IN FROM A FILE OR DRIVER

	JP	CHANERR

;----------------------------------------------------------------------------
;	LDEVIN (0) - INPUT FROM CON:
;----------------------------------------------------------------------------

IFROCON:CALL	CONIN

	LD	B,A
	CP	TYLKC		;TTY LOCK CHATACTER?
	JR	NZ,INCHA10	;NO, JUMP

	LD	A,(TTYFLG)	;PROCESS TTY LOCK
	CPL			;BY COMPLEMENTIG FLAG
	LD	(TTYFLG),A
	JP	IFROCON		;AND IGNORE IT

INCHA10:LD	A,(TTYFLG)	;IF TTYLOCK IS SET
	OR 	A		;CONVERT FROM LOWER TO UPPER CASE
	LD	A,B
	JR	NZ,INCHA11
	CP	7BH
	JR	NC,INCHA11
	CP	61H
	JR	C,INCHA11
	SUB	20H

INCHA11:
	LD	B,A		;SAVE CHAR
	LD	A,(BRKENA)	;IS BREAK ENABLED?
	OR	A
	LD	A,B		;GET CHAR AGAIN
	JR	Z,NO_BRK1	;NO, JUMP

	CP	ESC		;ESC - STOP RUNNING
	JP	Z,BREAK

NO_BRK1:CP	CR		;CR IS VALID
	JR	Z,CHGOOD

	LD	IX,RUBOUT	;RUBOUT IS VALID
	CP	(IX)
	JR	Z,CHGOOD

	CP	' '
	JR	NC,CHGOOD	;IGNORE OTHER CTRL CHARS

	LD	B,BELL		;WHICH RING THE BELL
	CALL	CHOUT
	JR	IFROCON		;ASK FOR A NEW CHAR

CHGOOD:	LD	B,A
	POP	DE
	POP	HL
	RET

;----------------------------------------------------------------------------
;	LDEVIN (1) - INPUT FROM RAM BUFFER
;----------------------------------------------------------------------------

IFROBUF:LD	HL,(UBUPO)
	LD	A,(HL)
	INC	HL
	LD	(UBUPO),HL
FILTLF:	CP	LF		;DUBBIA UTILITA'
	JR	Z,INCHA14
	JR	CHGOOD

;----------------------------------------------------------------------------
;	LDEVIN (5) - FILE INPUT FOR INPUT CH STATEMENT
;----------------------------------------------------------------------------

IFROSA:	LD	HL,(SAPTMP)
	LD	A,(HL)
	INC	HL
	LD	(SAPTMP),HL
	JR	FILTLF

;----------------------------------------------------------------------------
;	LDEVIN (7) - INPUT FROM AUX:
;----------------------------------------------------------------------------
IFROAUX:CALL	AUXIN
	JR	CHGOOD

;----------------------------------------------------------------------------
;	LDEVIN (77H) - FILE INPUT FOR FDM
;----------------------------------------------------------------------------

FDM_IN:	LD	HL,(RECO_PO)
	LD	A,(HL)
	INC	HL
	LD	(RECO_PO),HL
	JR	CHGOOD


;----------------------------------------------------------------------------
;	INLINE - READS A LINE THRU THE CURRENT LOGDEVI INTO IBUF
;----------------------------------------------------------------------------
;	SPECIAL CHARS:
;		RUBOUT 	- DELETE LAST CHAR
;		CR 	- EXIT
;
;	ON INPUT:	PICTF = 0 NORMAL OPERATION
;			PICTF <> 0 PICTURE MODE
;			PICTF = '!' NO ECHO
;			PICTF = '*' MASKED ECHO

;	IF PICTF=1 THEN (PICSTG) POINTS TO THE PICTURE STRING CHAR AND
;	(PICLEN) = PICTURE STRING LENGHT

;	NOTE THAT ENTRY POINT IS BELOW


CLRENT:	LD	B,12
	CALL	CHOUT		;ERA CONOUT
	LD	A,(PICLEN0)	;RESTORE COUNTER AND POINTER
	LD	(PICLEN),A
	LD	HL,(PICSTG0)
	LD	(PICSTG),HL
	LD	B,'?'
	CALL	CHOUT		;ERA CONOUT


INLINE:	LD	HL,IBUF		;PRESET DEST. BUFFER
	LD	C,LINLEN	;AND MAXIMUM LINE LENGHT

;	CHAR ACQUISITION LOOP

INLOP:	CALL	LDEVIN		;READ A CHAR
	LD	B,A		;SAVE CHAR

;	SPECIAL CHARACTERS CHECK

	LD	IX,RUBOUT	;'RUBOUT' IS PROGRAMMABLE
	CP	(IX)		;SEE CURRENT VALUE
	JP	Z,DO_RUB		;AND EVENTUALLY RUBOUT LAST CHAR

	LD	IX,NBESC	;INPUT ESCAPE? (SEE NOTE AT ESC EQU..)
	CP	(IX)
	JR	Z,INL1A

	LD	IX,CONFIRM	;INPUT CONFIRM? (SEE NOTE AT CONFIR0)
	CP	(IX)
	JR	Z,INL1A

	CP	CR
	JR	Z,INL1A		;CR - NO MORE TESTS

	LD	A,(CLEARCH)	;CHECK IF TYPED THE PROGRAMMABLE 'CLEAR'
	OR	A
	JR	Z,CKPICT	;IF ZERO, NO 'CLEAR' CHECK - JUMP

	CP	B		;TEST FOR THE SPECIAL CHARACTER
	JR	Z,CLRENT	;USED TO CLEAR ALL

CKPICT:	LD	A,(PICTF)	;PICTURED INPUT IS PROCESSED SEPARATELY
	OR	A		;CHECK IF PICTURE-D INPUT
	JP	NZ,PICTUIN	;YES, JUMP

;----------------------------------------------------------------------------
;	A VALID CHAR ARRIVED - DO ECHO IF LOGDEVI IS CON:
;----------------------------------------------------------------------------

INL1A:	LD	A,(LOGDEVI)
	OR	A
	JR	NZ,STO_CH

	LD	IX,NBESC	;NO ECHO FOR NON BREAKING ESC
	CP	(IX)
	JR	Z,STO_CH

	LD	IX,CONFIRM	;NO ECHO FOR CONFIRM CHAR
	CP	(IX)
	JR	Z,STO_CH

	CALL	CHOUT		;ERA CONOUT

;----------------------------------------------------------------------------
;	STORE INPUTTED CHAR INTO THE BUFFER
;----------------------------------------------------------------------------

STO_CH:	LD	A,B
	LD	(HL),A		;STORE CHARACTER TO BUFFER

;----------------------------------------------------------------------------
;	REPLACE STORED CONFIRM OR NBESC WITH CR
;----------------------------------------------------------------------------

	LD	IX,CONFIRM	;IF CONFIRM0 THEN REPLACE IT WITH CR
	CP	(IX)
	JR	NZ,NOREPL

	LD	A,(CONFIRM)	;GET CONFIRM CHAR
	LD	(EXICHA),A	;AND SAVE FOR LATER USE

	LD	A,CR		;LEAVE ACC WITH CR
	LD	(HL),A
	JR	CKAUTCR


NOREPL:	LD	IX,NBESC	;IF NBESC THEN REPLACE IT WITH CR
	CP	(IX)
	JR	NZ,CKAUTCR

	LD	A,(NBESC)	;GET NBESC
	LD	(EXICHA),A	;AND SAVE FOR LATER USE

	LD	A,CR		;LEAVE ACC WITH CR
	LD	(HL),A

;----------------------------------------------------------------------------
;	CHECK IF AUTOCR REQUESTED AND DUE
;----------------------------------------------------------------------------

CKAUTCR:LD	A,(AUTOCR)	;IS AUTO CR IS REQUESTED?
	CP	'>'
	JR	NZ,CKIEND	;NO, JUMP

	LD	A,(PICLEN)	;SEE IF PICTURE STRING AT END
	OR	A
	JR	NZ,CKIEND	;NO, JUMP

	INC	HL		;INCREMENT BUFFER POINTER
	DEC	C		;DECREMENT REMAINING LINE LENGHT

	XOR	A		;RESET FLAG
	LD	(AUTOCR),A

	LD	A,CR		;PUT CR INTO THE BUFFER
	LD	(HL),A
	PUSH	AF
	LD	B,A
	CALL	CHOUT		;ERA CONOUT
	POP	AF
	JR	DO_LF		;AND GO ON TOWARD CHOUT EXIT

;----------------------------------------------------------------------------
;	CHECK IF INPUT END
;----------------------------------------------------------------------------

CKIEND:	LD	A,B

DO_LF:	LD	B,LF		;PRESET LF FOR CHOUT IN CASE OF END OF INPUT

	LD	IX,NBESC	;INPUT ESCAPE? (SEE NOTE AT ESC EQU..)
	CP	(IX)
	JP	Z,CHOUT		;YES, PRINT LF AND EXIT

	LD	IX,CONFIRM	;CONFIRM CHAR? (SEE NOTE AT CONFIR0)
	CP	(IX)
	JP	Z,CHOUT		;YES, PRINT LF AND EXIT

	CP	CR		;CR?
	JR	NZ,ISNOTCR

	LD	A,(LOGDEVI)	;FDM INPUT?
	CP	77H
	RET	Z		;YES, NO LF AT END

	JP	CHOUT		;CR AND NOT FDM - PRINT LF AND EXIT

ISNOTCR:INC	HL		;INCREMENT STORE POINTER
	DEC	C		;LINE AT END?
	JP	NZ,INLOP	;NO, LOOP WAITING ANOTHER CHAR

	JP	LONGERR		;LINE TOO LONG ERR

;----------------------------------------------------------------------------
;	SPECIAL CASES OF INPUT
;----------------------------------------------------------------------------

;----------------------------------------------------------------------------
;	EXECUTE RUBOUT (I.E. BACKSPACE)
;----------------------------------------------------------------------------

DO_RUB:	LD	A,C
	LD	B,BELL
	CP	LINLEN
	JP	NZ,DORUB1		;IF DELETION NOT BEFORE BEGINNING OF LINE
	JP	INLOP

DORUB1:	DEC	HL
	INC	C
	LD	B,(HL)
	LD	A,(PICTF)		;IF DOING A PICTURED INPUT
	OR	A
	JR	Z,DORUB2
	PUSH	HL
	LD	HL,(PICSTG)		;ADJUST POINTER
	DEC	HL
	LD	(PICSTG),HL
	LD	A,(PICLEN)		;AND COUNTER
	INC	A
	LD	(PICLEN),A
	POP	HL

DORUB2:	PUSH	BC
	PUSH	HL
	LD	A,(RUBOUT)
	LD	B,A
	CALL	CHOUT
	LD	B,20H
	CALL	CHOUT
	LD	A,(RUBOUT)
	LD	B,A
	CALL	CHOUT
	POP	HL
	POP	BC
	JP	INLOP


;----------------------------------------------------------------------------
;	PICTURED INPUT
;----------------------------------------------------------------------------

PICTUIN:LD	A,(PICLEN)	;CHECK RESIDUE PICTURE LENGHT
	OR	A		;AT THE END OF THE PICTURE STRING?
	JP	Z,INLOP		;IGNORE ALL CHARS LESS CR,RUBOUT,CLEARCH ECC.

	PUSH	HL
	LD	HL,(PICSTG)	;GET PICTURE STRING POINTER
	LD	A,'X'		;'X' IN FORMAT STRING MEANS THAT
	CP	(HL)		;EVERY CHAR IS GOOD
	JR	Z,CHOK

	LD	A,B		;RESTORE INPUT CHAR
	CALL	CH_CATEG	;DETERMINE CATEGORY OF INPUT CHAR
	LD	HL,(PICSTG)	;GET PICTURE STRING POINTER
	CP	(HL)
CHOK:	POP	HL
	JP	NZ,INLOP		;IGNORE INPUT IF ERRONEUS

	PUSH	HL
	LD	HL,(PICSTG)	;RESTORE HL
	INC	HL		;INCREMENT POINTER IF OK

	LD	A,(ECHOM)	;SEE WHICH TYPE OF ECHO
	OR	A		;MODE 0, DO NORMAL ECHO
	JR	Z,PICTU1

	CP	'!'		;MODE '!' - DO NOT ECHO
	JR	Z,PICTU2

	CP	'*'		;MODE '*' - ECHO AN ASTERISK
	JP	NZ,E19		;UNKNOWN MODE - STRING ERROR

	PUSH	BC		;ECHO ASTERISK
	LD	B,'*'
	CALL	CHOUT
	POP	BC
	JR	PICTU2

PICTU1:	CALL	CHOUT		;ERA CONOUT		;DO ECHO

PICTU2:	LD	(PICSTG),HL	;UPDATE POINTER
	POP	HL
	LD	A,(PICLEN)
	DEC	A
	LD	(PICLEN),A	;AND COUNTER
	LD	A,B
	JP	STO_CH


;----------------------------------------------------------------------------
;	CH_CATEG - CLASSIFY A CHAR (IN ACC)
;----------------------------------------------------------------------------

;	RETURNS THE CATEGORY CHAR IN ACC AS FOLLOWS

;		0..9 	  - 9
;		A..Z 	  - A
;		OTHERWISE - '-'

CH_CATEG:
	CP	'.'
	JR	Z,CC_NUM	;DP IS CONSIDERED NUMERIC
	CP	'9'+1
	JR	NC,CC_NONUM	;MORE THAN 39H - NON NUMERIC
	CP	'0'
	JR	C,CC_NONUM	;LESS THAN 30H - NON NUMERIC
CC_NUM:	LD	A,'9'
	RET
CC_NONUM:
	CP	'Z'+1
	JR	NC,CC_NOALPH	;MORE THAN Z - NON ALPHA
	CP	'A'
	JR	C,CC_NOALPH	;LESS THAN A - NON ALPHA
CC_ALPH:LD	A,'A'
	RET
CC_NOALPH:			;NONE OF THE ABOVE
	LD	A,'-'
	RET



;	* * PCHECK - TEST IF PANIC BUTTON PRESSED
;
PCHECK:	LD	A,(BRKENA)	;IF BREAKS ARE DISABLED
	OR	A
	RET	Z		;RETURN WITH ZERO

	CALL	CONSTAT
	OR	A
	RET	Z
	CP	ESC
	RET	NZ

BREAK:	XOR	A
	LD	(LOGDEVO),A	;TURN OFF THE PRINT FLAG IN CASE
				;PRINTING IN PROGRESS
				;RESET OUT TO CON:
	LD	(IBYTE),A
	LD	(OBYTE),A
	JP	NORMSTP
;
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 14 - FLOATING POINT PACKAGE 		*
;	*							*
;	*		    					*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 14_1 FPOUT		*
;	*      			*
;	* 			*
;	*      			*
;	* * * * * * * * * * * * *
;

;	FORMATO DI UN '1' FLOATING POINT:

;	DB	1*16	;1*16 E' IL NIBBLE PIU' ALTO - E' MSD IN BCD
;	DB	0
;	DB	0
;	DB	0
;	DB	0	;ULTIME DUE FIFRE DELLA MANTISSA
;	DB	0	;SEGNO DELLA MANTISSA 1=NEGATIVO
;FPONE:	DB	129	;ESPONENTE E1 (128 E' E0)

;	BYTE INFES:	BIT 0 	 - SE = 1 FORMATO ESPONENZIALE
;			BIT 4..1 - NUMERO DI CIFRE DA STAMPARE
;			BIT 7    - SE = 1 LASCIA ZERI IN CODA

;	OUTPUT FP NUMBER ADDRESSED BY HL
;
FPOUT:	LD	BC,-DIGIT-1	;DIGIT NEL NS.CASO VALE 5
	ADD	HL,BC		;HL PUNTA AL BYTE PIU' BASSO DELLA MANTISSA
	LD	B,H		;COPIA QUESTO INDIRIZZO IN BC
	LD	C,L

	LD	HL,ABUF		;OUTPUT BUFFER

	LD	A,(INFES)	;OUTPUT FORMAT
	LD	(FES),A		;STORE IT

	LD	E,DIGIT
	LD	(HL),0		;CLEAR ROUND OFF OVERFLOW BUFFER
	INC	HL		;ABUF+1

;	PRENDE I BYTES DELLA MANTISSA A COMINCIARE DAL PRIMO (MSB)
;	E LI REGISTRA NEL BUFFER DI USCITA ABUF 'SPACCANDOLI', OSSIA
;	METTENDO UNA CIFRA BCD IN OGNI BYTE DI ABUF

NXT:	LD	A,(BC)		;GET DIGIT AND UNPACK
	LD	D,A
	RRA			;PRENDI NIBBLE PIU' SIGNIF.
	RRA
	RRA
	RRA
	AND	0FH		;17Q ;REMOVE BOTTOM DIGIT

	LD	(HL),A		;STORE TOP DIGIT IN OUTPUT BUFFER (ABUF)
	INC	HL
	LD	A,D		;NOW GET BOTTOM DIGIT
	AND	0FH		;17Q
	LD	(HL),A		;STORE IT


	INC	HL		;PUNTATORE DI ABUF
	INC	BC		;PUNTATORE ALLA MANTISSA
	DEC	E		;CONTA IL NUMERO DELLE COPPIE 'SPACCATE'
	JR	NZ,NXT		;PROCESSALE TUTTE

;	TUTTA LA MANTISSA SI TROVA ORA 'SPACCATA' IN ABUF
;	ADESSO PROCESSA IL SEGNO DELLA MANTISSA

	LD	A,(BC)		;SEGNO
	LD	(FSIGN),A	;STORE SIGN OF NUMBER

	XOR	A		;METTE ZERO NEL PROSSIMO BYTE DI ABUF
	LD	(HL),A		;CLEAR ROUND-OFF BUFFER (ABUF+13 (??))
				;12 DIG NO RND (??)

	LD	HL,XSIGN	;EXPONENT SIGN STORE
	LD	(HL),A		;CLEAR XSIGN

;	ADESSO PROCESSA L'ESPONENTE RIPORTANDOLO AL FORMATO VERO:

;		- SE E' ZERO  	XSIGN = 0 EXPO = 1
;		- SE E' 128 	XSIGN = 1 EXPO = 1
;		- SE E' < 128 	XSIGN = 1 EXPO = -(ESPONENTE-128)
;		- SE E' > 128 	XSIGN = 0 EXPO = ESPONENTE-128

FIX:	INC	BC		;GET EXPONENT
	LD	A,(BC)
	OR	A		;EXPONENT ZERO?
	JR	Z,ZRO		;SI, SALTA

	SUB	128		;REMOVE NORMALIZING BIAS
	JR	NZ,FIX2		;E' ZERO? NO, SALTA

	INC	(HL)		;INCREMENT XSIGN TO NEGATIVE FLAG (1)
				;LATER ZERO

FIX2:	JP	P,CHK13
	CPL			;ITS A NEGATIVE EXPONENT
	INC	(HL)		;INCREMENT XSIGN TO NEGATIVE (1)
ZRO:	INC	A
CHK13:	LD	HL,EXPO		;EXPONENT TEMP STORE
	LD	(HL),A

;	CONTROLLA SE L'ESPONENTE E' MAGGIORE DEL NUMERO DI CIFRE
;	DA STAMPARE (PER IL PASSAGGIO AUTOMATICO ALLA NOTAZIONE EXP)

	LD	E,A		;VALORE DI EXPO
	CP	DIGIT*2
	LD	HL,FES		;FORMAT TEMP BYTE
	JR	C,CHKXO

CHK40:	LD	A,1		;FORCE EXPONENTIAL PRINTOUT
	OR	(HL)		;SET FORMAT FOR XOUT
	LD	(HL),A

;	IL FORMATO ESPONENZIALE PUO' ESSERE STATO FISSATO METTENDO AD 1
;	IL BIT 0 DI INFES O PER FORZATURA - ADESSO SI CONTROLLA

CHKXO:	LD	A,(HL)		;CHECK IF EXPONENTIAL PRINTOUT
	RRA
	JR	NC,CHKX3	;NO, SALTA

;	PREDISPONI LA STAMPA DEL FORMATO EXP

;	IL NUMERO MASSIMO DELLE CIFRE DA STAMPARE PUO' ESSERE FISSATO
;	INSERENDO IL NUMERO DESIDERATO NEI BIT 4..1 DI INFES - ADESSO
;	SI CONTROLLA SE E' STATO APPUNTO POSTO UN LIMITE

	AND	0FH		;ACC E' STATO RRA-ATO
	CP	DIGIT*2
	JR	C,CHKX2
	LD	A,DIGIT*2-1 	;MAX DIGITS

CHKX2:	LD	D,A		;NUMERO DI CIFRE DA STAMPARE
	INC	A		;PIU' IL SEGNO (FORSE)
	JR	ROUND

;	STAMPA IN FORMATO NORMALE (NON ESPONENZIALE)


CHKX3:	AND	0FH		;ACC = FES - ADD EXPONENT AND DECIMAL PLACES
	LD	D,A		;NUMERO DI CIFRE DA STAMPARE
	ADD	A,E		;CONTENEVA EXPO
	CP	DIGIT*2+1
	LD	B,A
	JR	C,CHKXN

	LD	A,(HL)		;RIPRENDI FES
	AND	40H		;100Q
	JR	NZ,CHK40	;SE BIT 6 E' SETTATO TORNA A CHK40 (???)
;
CHKXN:	LD	A,(XSIGN)	;CHECK EXPONENT SIGN
	OR	A
	JR	NZ,XNEG		;ITS NEGATIVE

	LD	A,B
	JR	ROUND

;	STAMPA NORMALE - ESPONENTE NEGATIVO
				;SUBTRACT EXPONENT AND DECIMAL PLACE COUNT
XNEG:	LD	A,D		;D = NUMERO DI CIFRE DA STAMPARE
	SUB	E		;E = EXPO
	JR	NC,XN2

XN1:	LD	A,(INFES)	;FORZATURA DEL NUMERO DEGLI ZERI IN CODA?
	OR	A
	JP	P,ZERO		;NO, VAI AD EMETTERE LO ZERO E BASTA

;	BIT 7 DI INFES = 1 - LASCIA ZERI IN CODA - MA QUANTI NE SONO STATI
;	RICHIESTI?

	AND	0EH		;NESSUNO?
	JR	Z,CKFILL

	RRCA
	LD	E,A
	DEC	E
	LD	C,1
	LD	HL,ABUF-1
	JP	NRND
;
XN2:	JR	Z,XN1
	JR	ROUND

;	MODIFICA 5/1/92 - EMETTI IL FILLER PRIMA DELLO ZERO

CKFILL:	LD	A,(INTDIG)	;# OF DIGITS FOR INTEGER PART
	OR	A		;ZERO MEANS NO FORMAT TO DO
	JP	Z,ZERO		;JUMP IF NO FORMAT
;	DEC	A		;UNA SOLA CIFRA (LO ZERO) DEVE ESSERE STAMP.
;	JR	Z,NOFO1		;NUMBER OF DIGITS EQUAL   THAN FIELD LENGHT
				;PRINT WITHOUT LEADING FILLERS
	CALL	PRIFILL		;PRINT #ACC FILLERS

	JP	ZERO

;----------------------------------------------------------------------------
;	CLEAN -
;----------------------------------------------------------------------------

;	VERIFICA CHE ACC (BIT 4..0) SIA MINORE DI DIGIT*2 - SE NON LO
;	E' LO PONE A DIGIT*2+1

CLEAN:	LD	B,1FH		;37Q	;CLEAR FLAGS
	AND	B
	CP	DIGIT*2+1
	RET	C
	LD	A,DIGIT*2+1 	;MAX DIGITS OUT
	RET


;	THIS ROUTINE (???) IS USED TO ROUND DATA TO THE
;	SPECIFIED DECIMAL PLACE

;	SI ARRIVA QUI CON ACC=NUMERO DELLE CIFRE DA STAMPARE

ROUND:	CALL	CLEAN		;VERIFICA/AGGIUSTA N.DELLE CIFRE DA STAMPARE
	LD	C,A		;SALVA DETTO NUMERO IN BC
	LD	B,0

	LD	HL,ABUF+1	;CREA UN PUNTATORE ALL'AREA DI ROUND-OFF
	ADD	HL,BC		;GET ROUND-OFF ADDRESS

	LD	(ADDT),HL	;E SALVALO IN ADDT

	LD	A,(HL)		;SOLO SE ADDT > 5 SI ESEGUE ROUND-OFF
	CP	5		;ROUND IF >=5
	JR	C,TRL2_1

;	ESECUZIONE MATERIALE DEL ROUND-OFF

LESS1:	DEC	HL
	INC	(HL)		;ROUND UP
	LD	A,(HL)
	OR	A
	JR	Z,TRL2
	CP	10		;CHECK IF ROUNDED NUMBER >9
	JR	NZ,TRAIL
	LD	(HL),0
	JR	LESS1

;	THIS ROUTINE IS USED TO ELIMINATE TRAILING ZERO'S

TRAIL:	LD	HL,(ADDT)
TRL2_1:	DEC	HL		;PUNTA AL BUFFER DI USCITA - ALLA CODA

TRL2:	LD	A,(FES)		;CHECK IF TRAILING ZERO'S ARE WANTED
	RLA
	JR	C,FPRNT		;YES- GO PRINT DATA

;	RISALE LA CODA FINO A TROVARE QUALCOSA CHE NON SIA ZERO

TRL3:	LD	A,(HL)
	OR	A		;IS IT ZERO?
	JR	NZ,FPRNT	;NO- GO PRINT
	DEC	HL
	DEC	C		;YES- FIX OUTPUT DIGIT COUNT
	JP	M,PREZERO
	JR	TRL3

PREZERO:CALL	SPACE		;PROVA PROVA PROVA<<<<<<<<<<<<
	LD	A,(INTDIG)	;SEE IF WE HAVE TO PRINT FILLER
	OR	A
	JR	Z,NOFI
	DEC	A		;INCLUDE NEXT CALL TO ZERO IN COUNT
	CALL	PRIFILL		;AND PRINT FILLER
NOFI:	JP	ZERO

;	ADESSO IL BUFFER DI USCITA E' PRONTO

;	C = NUMERO DELLE CIFRE DA STAMPARE   E = EXPO

;	HERE STARTS THE PRINT FORMAT ROUTINES

FPRNT:	LD	HL,ABUF
	LD	A,(HL)		;CHECK IF ROUNDED UP TO 1
	OR	A
	JR	Z,NRND		;JUMP IF NOT

	LD	B,1
	LD	A,(XSIGN)	;IS EXPONENT NEGATIVE?
	OR	A
	JR	Z,POSR
	LD	B,0FFH		;B=FF SIGNIFICA ESPONENTE NEGATIVO
;
POSR:	LD	A,(EXPO)	;GET EXPONENT
	OR	A
	JR	NZ,PO2		;IS IT ZERO?	(E+0)

	LD	(XSIGN),A
	LD	B,1
PO2:	ADD	A,B		;FIX EXPONENT COUNT
	LD	(EXPO),A
	INC	E
	INC	C
	DEC	HL

NRND:	INC	HL
	LD	A,C
	CP	DIGIT*2+1	;CHECK FOR MAX DIGITS OUT
	JR	NZ,NRND1	;DEVI STAMPARLE TUTTE
	DEC	C		;SI, CONTANE UNA IN MENO (SEGNO?)

;	ADESSO SI EMETTE IL SEGNO (SE NEGATIVO) OPPURE UNO SPAZIO

NRND1:	LD	A,(FSIGN)	;CHECK IF NEGATIVE NUMBER
	RRA
	JR	NC,PRIN2	;GO OUTPUT RADIX AND NUMBER
	CALL	NEG		;OUTPUT (-)
	JR	PRI21

PRIN2:	CALL	SPACE		;OUTPUT A SPACE

;	VEDI SE E' RICHIESTO IL FORMATO ESPONENZIALE

PRI21:	LD	A,(FES)		;GET OUTPUT FORMAT
	RRA			;CHECK IF EXPONENTIAL OUTPUT FORMAT
	JR	C,XPRIN		;SI, SALTA

;	EMISSIONE IN FORMATO NORMALE (NON EXP)

	LD	A,(XSIGN)	;GET EXPONENT SIGN
	OR	A		;CHECK IF NEGATIVE EXPONENT
	JR	Z,POSIT

	CALL	ZERO
	LD	A,C
	OR	A
	JP	NZ,PRIN4	;OUTPUT RADIX AND NUMBER
	CALL	ZERO		;NO DIGITS AFTER RADIX, OUTPUT ZERO AND DONE
	RET
;
PRIN4:	CALL	RADIX		;PRINT DECIMAL POINT
PRIN43:	XOR	A
	OR	E
	JP	Z,PRIN5		;JUMP IF NO ZEROS TO PRINT
	CALL	ZERO		;FORCE PRINT A ZERO
	DEC	E
	JP	NZ,PRIN43 	;ERA PRIN4+3
;
PRIN5:	CALL	NOUT		;PRINT ASCII DIGIT
	JP	NZ,PRIN5
	RET

;	MODIFICA FATTA DA ME PER FORMATTAZIONE USCITA

POSIT:	PUSH	AF
	PUSH	DE
	LD	A,(INTDIG)	;# OF DIGITS FOR INTEGER PART
	OR	A		;ZERO MEANS NO FORMAT TO DO
	JR	Z,NOFO
	SUB	E		;SUBTRACT # OF DIGITS READY FOR OUTPUT
	JR	C,NOFO		;NUMBER OF DIGITS GREATER THAN FIELD LENGHT
	JR	Z,NOFO		;NUMBER OF DIGITS EQUAL   THAN FIELD LENGHT
				;PRINT WITHOUT LEADING FILLERS
	CALL	PRIFILL		;PRINT #ACC FILLERS


NOFO:
	POP	DE
	POP	AF
POSIT1:	CALL	NOUT
	DEC	E		;BUMP EXPONENT COUNT
	JP	NZ,POSIT1
	LD	A,C		;CHECK IF MORE DIGITS TO OUTPUT
	OR	A
	RET	Z 		;NO, DONE
	RET	M
	JP	PRIN4		;NOW PRINT DECIMAL POINT

;	PRIFILL - PRINTS #ACC FILLER CHARS AS DEFINED IN (FILLCH)

PRIFILL:PUSH	BC
	PUSH	HL
	LD	HL,FILLCH
	LD	B,A
LEADZ:	PUSH	BC
	LD	B,(HL)		;EMIT LEADING CHARS
	CALL	CHOUT
	POP	BC
	DJNZ	LEADZ
	POP	HL
	POP	BC
	RET

;	GET HERE FOR EXPONENTIAL OUTPUT FORMAT
;
XPRIN:	CALL	NOUT
	JP	Z,NDEC		;INTEGER?
	CALL	RADIX	;NO_____PRINT DECIMAL POINT
XPRI2:	CALL	NOUT
	JP	NZ,XPRI2
;
NDEC:	LD	B,'E'	;OUTPUT 'E'
	CALL	CHOUT
	LD	A,(XSIGN)
	OR	A
	JP	Z,XPRI3
	CALL	NEG	;PRINT EXPONENT SIGN (-)
	LD	A,(EXPO)
	INC	A
	JP	XOUT2
;
XPRI3:	LD	B,'+'	;EXPONENT (+)
	CALL	CHOUT
;
;	THIS ROUTINE IS USED TO CONVERT THE EXPONENT
;	FROM BINARY TO ASCII AND PRINT THE RESULT
;
XOUT:	LD	A,(EXPO)
	DEC	A
XOUT2:	LD	C,100
	LD	D,0
	CALL	CONV
	CP	'0'	;SKIP LEADING ZEROES
	JP	Z,XO21
	INC	D
	CALL	CHOUT
XO21:	LD	A,E
	LD	C,10
	CALL	CONV
	CP	'0'
	JP	NZ,XO3
	DEC	D
	JP	NZ,XO4
XO3:	CALL	CHOUT
XO4:	LD	A,E
	ADD	A,'0'	;ADD ASCII BIAS
	LD	B,A
	CALL	CHOUT
	RET
;
CONV:	LD	B,'0'-1
	INC	B
	SUB	C
	JP	NC,CONV+2
	ADD	A,C
	LD	E,A
	LD	A,B
	RET
;
;	THIS ROUTINE ADDS ASCII BIAS TO A BCD DIGIT
;	AND CALLS THE OUTPUT ROUTINE
;
NOUT:	LD	A,(HL)
	ADD	A,'0'
	LD	B,A
	CALL	CHOUT
	INC	HL
	DEC	C	;DECREMENT TOTAL DIGITS OUT COUNT
	RET
;
;	COMMON SYMBOL LOADING ROUTINES
;
NEG:	LD	B,'-'
	JP	CHOUT
ZERO:	LD	B,'0'
	JP	CHOUT
SPACE:	LD	B,' '
	JP	CHOUT
RADIX:	LD	B,'.'
	JP	CHOUT








;
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 14_2 FPIN		*
;	*      			*
;	* 			*
;	*      			*
;	* * * * * * * * * * * * *
;

;
;	CONVERTS FP STRING AT DE, UPDATE DE PAST TERMINATOR
;	PUTS TERMINATOR IN B, PUTS FP NUMBER AT ADDR IN HL
;	SETS CARRY IF NOT FOUND
;
FPIN:	PUSH	HL
	PUSH	DE
	EX	DE,HL
	DEC	HL
	LD	(ADDS),HL
	LD	HL,OPST		;CLEAR TEMP STORAGE AREAS AND BC BUFFER
	LD	C,DIGIT+6
	CALL	CLEAR
;
SCANC:	LD	DE,0
	LD	HL,XXBC		;BC=PACK BUFFER
SCAN0:	LD	(BCADD),HL	;PACK BUFFER POINTER
SCANP:	LD	HL,SCANP
	PUSH	HL		;USED FOR RETURN FROM OTHER ROUTINES
	XOR	A
	LD	(XSIGN),A	;CLEAR EXPONENT SIGN BYTE
;
SCANG:	CALL	IBSCN
	JP	C,SCANX		;FOUND A NUMBER, GO PACK IT
	CP	'.'		;RADIX?
	JP	Z,SCAN5		;PROCESS RADIX POINTERS
	CP	'^'		;EXPONENT?
	JP	Z,EXCON		;FOUND 'E', GO PROCESS EXPONENT NUMBER
;
;	NOT A CHARACTER LEGAL IN NUMBER
;
	LD	B,A		;MOVE TERMINATOR TO B
	LD	A,(OPST)	;CHECK IF ANY DIGITS YET
	AND	20Q
	JP	NZ,ENTR2
;
;	GET HERE IF LEGAL FP NUMBER NOT FOUND
;
FPIN1:	POP	HL		;SCANP LINK
	POP	DE		;TEXT POINTER
	POP	HL		;FP # ADDR
	SCF
	RET
;
;	FOUND DECIMAL POINT
;
SCAN5:	XOR	A	;FOUND RADIX PROCESS RADIX POINTERS FOR EXP
	OR	D	;ANY DIGITS YET?
	JP	NZ,SCAN6
	ADD	A,300Q	;SET ECNT - STOP COUNTING DIGITS
	OR	E	;NO INT DIGITS, BIT 7 IS COUNT/DONT COUNT FLAG
	LD	E,A	;BIT 6 IS NEGATIVE EXPONENT FLAG
	RET
;
SCAN6:	LD	A,200Q	;SET ECNT TO COUNT DIGITS
	OR	E
	LD	E,A
	RET
;
SCANX:	AND	17Q	;FOUND NUMBER-REMOVE ASCII BIAS
	LD	B,A
	LD	HL,OPST	;SET FIRST CHARACTER FLAG
	LD	A,60Q
	OR	(HL)
	LD	(HL),A
	XOR	A
	OR	B	;IS CHAR ZERO?
	JP	NZ,PACK
	OR	D	;LEADING ZERO I_ E_ ANY INT DIGITS?
	JP	NZ,PACK
	OR	E
	LD	E,A
	RET	Z 	;IF COUNTING YET,
	INC	E	;ECNT+1-COUNT ZEROS FOR EXPONENT COUNT
	RET
;
;	THIS SUBROUTINE BCD PACKS DIGITS INTO REG BC
;
PACK:	LD	A,E
	RLA
	JP	C,PACK1
	INC	E
PACK1:	LD	A,E
	LD	(ECNT),A;DIGIT COUNT FOR EXPONENT COUNT
	INC	D	;TOTAL DIGIT COUNT (D ALSO HAS TOP/BOTM FLAG BIT 7
	LD	A,D
	AND	177Q	;REMOVE TOP/BOTTOM FLAG
	CP	DIGIT*2+1 ;LIMIT INPUT DIGITS
	RET	NC
	XOR	A
	OR	D
	JP	M,BOTM
;
TOP:	OR	200Q	;SET MSB FOR TOP FLAG
	LD	D,A
	LD	A,B
	LD	HL,(BCADD);GET BC ADDRESS
	RLCA
	RLCA
	RLCA
	RLCA
	LD	(HL),A	;SAVE CHR IN BC
	RET
;
BOTM:	AND	177Q	;STRIP MSB (BOTTOM FLAG)
	LD	D,A
	LD	A,B
	LD	HL,(BCADD)
	OR	(HL)	;OR IN TOP NUMBER
	LD	(HL),A	;PUT NUMBER BACK IN BC
	INC	HL
	POP	BC
	JP	SCAN0
;
IBSCN:	LD	HL,(ADDS);INPUT BUFFER POINTER
	INC	HL	;GET NEXT BYTE
	LD	A,(HL)
	CP	' '
	JP	Z,IBSCN+3
	LD	(ADDS),HL;NOTE:  THIS ROUTINE FALLS THROUGH TO BELOW
;
;	THIS ROUTINE CHECKS FOR ASCII NUMBERS (0-9)
;
NMCHK:	CP	'9'+1
	RET	NC
	CP	'0'
	CCF
	RET
;
;	THIS ROUTINE IS USED TO ADJUST A NUMBER IN BC BUFFER
;	AND RETURNS VALUE
;
ENTR2:	LD	DE,0
ENT1:	PUSH	BC	;TERMINATOR
	CALL	FIXE	;NORMALIZE FLOATING POINT NUMBER
	POP	BC	;TERMINATOR
	POP	DE	;SCANP LINK
	POP	DE	;OLD TEXT ADDR
	POP	DE	;RETURN ADDR
	LD	C,DIGIT+2
	LD	HL,XXBC+DIGIT+1
	CALL	VCOPY
	LD	HL,(ADDS)
	EX	DE,HL
	INC	DE
	OR	A
	RET
;
;	THIS ROUTINE IS USED TO CLEAR STORAGE AREAS
;	THE STARTING ADDRESS IS IN HL AND THE COUNT
;	IS IN REG C
;
CLEAR:	XOR	A
	LD	(HL),A
	INC	HL
	DEC	C
	JP	NZ,CLEAR+1
	RET
;
;	THIS ROUTINE CONVERTS THE ASCII EXPONENT OF
;	NUMBER IN THE INPUT BUFFER TO BINARY, AND
;	NORMALIZES EXPONENT ACCORDING TO THE INPUT
;	FORMAT OF THE NUMBER
;
EXCON:	CALL	IBSCN	;GET CHARACTER
	JP	C,EXC3
	CP	PLSRW	;CHECK FOR UNARY SIGNS
	JP	Z,EXC4
	CP	'+'
	JP	Z,EXC4
	CP	'-'
	JP	Z,EXC2
	CP	MINRW
	JP	NZ,FPERR	;NO SIGN OR NUMBER?
EXC2:	LD	A,1
	LD	(XSIGN),A;SAVE SIGN
EXC4:	CALL	IBSCN
	JP	NC,FPERR	;NO NUMBER?
EXC3:	CALL	ASCDC	;CONVERT ASCII TO BINARY
	JP	ENT1	;NORMALIZE NUMBER AND RETURN
;
;	THIS ROUTINE CONVERTS ASCII TO BINARY
;	THREE CONSECUTIVE NUMBERS <128 MAY BE CONVERTED
;
ASCDC:	EX	DE,HL
	LD	HL,0
ASC1:	LD	A,(DE)	;GET CHR FROM INPUT BUFFER, NO SPACES ALLOWED
	CALL	NMCHK	;CHECK IF NUMBER
	JP	NC,ASC2
	SUB	'0'	;REMOVE ASCII BIAS
	LD	B,H
	LD	C,L
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,BC
	ADD	HL,HL
	LD	C,A
	LD	B,0
	ADD	HL,BC
	INC	DE
	JP	ASC1
;
ASC2:	EX	DE,HL
	LD	B,A	;SAVE TERMINATOR
	LD	(ADDS),HL;SAVE IBUF ADDR
	LD	A,D
	OR	A
	JP	NZ,FPERR	;TOO BIG >255
	LD	A,E
	RLA
	JP	C,FPERR	;TOO BIG >127
	RRA
	RET
;
FPERR:	POP	BC	;ASCDC RET LINK
	JP	FPIN1
;
;	THIS ROUTINE NORMALIZES THE INPUT NUMBER
;
FIXE:	EX	DE,HL
	LD	A,(XXBC)
	OR	A	;IS IT ZERO
	JP	Z,ZZ2
	CALL	CHKPN	;SET EXPONENT POSITIVE/NEGATIVE
	ADD	A,200Q	;ADD EXPONENT BIAS
ZZ2:	LD	(XXBC+DIGIT+1),A ;STORE NORMALIZED EXPONENT IN BC
	RET
;
CHKPN:	LD	A,(ECNT);GET EXPONENT COUNT-SET IN 'SCAN' ROUTINE
	LD	E,A
	AND	77Q	;STRIP BITS 7 AND 8
	LD	B,A
	LD	A,(XSIGN)
	OR	A
	JP	Z,LPOS	;EXPONENT IS POSITIVE
	INC	H	;SET SIGN IN H **THIS SHOULD BE INR H NOT INX H
	LD	A,100Q	;L IS NEGATIVE
	AND	E	;CHECK IF E IS NEGATIVE
	JP	Z,EPOS
	LD	A,L	;BOTH E AND L NEGTIVE
	LD	L,B
	CALL	BPOS+1
	CPL
	INC	A
	RET		;BACK TO FIXE
;
EPOS:	LD	A,L	;E AND L NEGATIVE
	CPL
	INC	A
	ADD	A,B
	RET		;TO FIXE
;
LPOS:	LD	A,100Q	;EXPONENT POSITIVE
	AND	E
	JP	Z,BPOS	;IF E POSITIVE
	LD	A,B
	LD	B,L
	JP	EPOS+1
;
BPOS:	LD	A,B	;E AND L POSITIVE
	ADD	A,L
	RET	P
;
	POP	HL
	JP	FPERR






;
;
;	* * * * * * * * * * * * *
;	*      			*
;	* FP 4 FUNCTIONS	*
;	*      			*
;	* MATH PACKAGE		*
;	*      			*
;	* * * * * * * * * * * * *
;

;	THIS PROGRAM IS A FOUR FUNCTION FLOATING POINT BCD
;	MATH PACKAGE
;	EACH FUNCTION MAY BE EXPRESSED AS:  BC=DE # HL
;	<BC> = ADDR OF RESULT
;	<DE> = ADDR OF 1ST ARGUMENT
;	<HL> = ADDR OF 2ND ARGUMENT
;	# IS ONE OF THE FUNCTIONS:  +, -, *, /
;	ALL ADDRESSES ON ENTRY, POINT TO THE EXPONENT PART OF
;	THE FLOATING POINT NUMBER
;	EACH FLOATING POINT NUMBER CONSISTS OF (2*DIGIT) PACKED
;	DECIMAL DIGITS, A SIGN AND A BIASED BINARY EXPONENT_  THE
;	EXPONENT RANGE IS 10**-127 TO 10**127_
;	THE NUMBER ZERO IS REPRESENTED BY THE EXPONENT 0_
;	THE NUMBERS ARE STORED IN MEMORY AS (DIGIT) BYTES OF
;	DECIMAL DIGITS_
;	STARTING AT THE LOW ORDER ADDRESS
;	ALL NUMBERS ARE ASSUMED TO BE NORMALIZED_  THAT IS EACH
;	NUMBER CAN BE REPRESENTED AS F**E_
;	WHERE .1<=F<=1.0 AND F IS THE EXPONENT_
;
;	FLOATING POINT ADDITION
;
FADD:	PUSH	BC
	CALL	EXPCK	;FETCH ARGUMENTS
	LD	C,0
ADSUM:	DEC	DE
	EX	DE,HL
	LD	A,(SIGN)
	XOR	(HL)	;FORM SIGN OF RESULT
	LD	B,A
	EX	DE,HL
	LD	A,(DE)
	DEC	DE
	XOR	C
	LD	(SIGN),A
	LD	HL,RCTRL;ROUNDING CONTROL FLAG
	LD	A,(HL)
	OR	A
	INC	HL
	LD	A,(HL)	;GET ROUNDING DIGIT
	JP	Z,ADS8
	RLCA
	RLCA
	RLCA
	RLCA
ADS8:	ADD	A,0B0H	;FORCE CARRY IF DIGIT > 5
	LD	A,B
	RRA
	JP	C,ADS1	;HAVE SUBTRACTION
	RLA		;RESTORE CARRY
	CALL	ADDF	;PERFORM ADDITION
	JP	NC,ADS2
	LD	B,4
	CALL	RIGHT
	LD	HL,EXP
	INC	(HL)	;INCREMENT EXPONENT
	JP	Z,OVER
ADS2:	POP	BC	;GET RESULTS ADDRESS
	CALL	STORE	;SAVE RESULTS
	RET
;
ZEREX:	POP	HL
	JP	ADS2
;
ADDF:	LD	HL,BUF+DIGIT-1
	LD	B,DIGIT
ADD1:	LD	A,(DE)
	ADC	A,(HL)
	DAA
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	B
	JP	NZ,ADD1
	RET	NC
	INC	(HL)
	RET
;
;	FLOATING POINT SUBTRACTION
;
FSUB:	PUSH	BC
	CALL	EXPCK	;GET ARGUMENTS
	LD	A,(SIGN)
	XOR	1	;COMPLEMENT SIGN
	LD	(SIGN),A
	JP	ADSUM
;
ADS1:	RLA		;RESTORE CARRY
	CCF		;COMPLEMENT FOR ROUNDING
	CALL	SUBF	;SUBTRACT ARGUMENTS
	LD	HL,SIGN
	JP	C,ADS4
	LD	A,(HL)	;GET SIGN
	XOR	1	;COMPLEMENT
	LD	(HL),A
ADS7:	DEC	HL
	LD	B,DIGIT
ADS3:	LD	A,9AH
	SBC	A,(HL)	;COMPLEMENT RESULT
	ADD	A,0
	DAA
	LD	(HL),A
	DEC	HL
	DEC	B
	CCF
	JP	NZ,ADS3
ADS4:	LD	HL,BUF
	LD	BC,DIGIT
ADS5:	LD	A,(HL)
	OR	A
	JP	NZ,ADS6
	INC	HL
	INC	B
	INC	B
	DEC	C
	JP	NZ,ADS5
	XOR	A
	LD	(EXP),A
	JP	ADS2
;
ADS6:	CP	10H
	JP	NC,ADS9
	INC	B
ADS9:	LD	HL,EXP
	LD	A,(HL)
	SUB	B
	JP	Z,UNDER
	JP	C,UNDER
	LD	(HL),A
	LD	A,B
	RLCA
	RLCA
	LD	B,A
	CALL	LEFT
	JP	ADS2
;
SUBF:	LD	HL,BUF+DIGIT-1
	LD	B,DIGIT
SUB1:	LD	A,99H
	ADC	A,0
	SUB	(HL)
	EX	DE,HL
	ADD	A,(HL)
	DAA
	EX	DE,HL
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	B
	JP	NZ,SUB1
	RET
;
;	FLOATING POINT MULTIPLY
;
FMUL:	PUSH	BC
	LD	A,(HL)
	OR	A	;ARGUMENT=0?
	JP	Z,FMUL1+2
	LD	A,(DE)
	OR	A	;ARGUMENT=0?
	JP	Z,FMUL1+2
	ADD	A,(HL)	;FORM RESULT EXPONENT
	JP	C,FMOVR
	JP	P,UNDER
	JP	FMUL1
;
FMOVR:	JP	M,OVER
FMUL1:	SUB	128	;REMOVE EXCESS BIAS
	LD	(EXP),A	;SAVE EXPONENT
	DEC	DE
	DEC	HL
	LD	A,(DE)
	XOR	(HL)	;FORM RESULT SIGN
	DEC	HL
	DEC	DE
	PUSH	HL
	LD	HL,SIGN	;GET SIGN ADDRESS
	LD	(HL),A
	DEC	HL
	XOR	A
	LD	B,DIGIT+2
FMUL2:	LD	(HL),A	;ZERO WORKING BUFFER
	DEC	HL
	DEC	B
	JP	NZ,FMUL2
	LD	A,(EXP)
	OR	A
	JP	Z,ZEREX
	LD	C,DIGIT
	LD	HL,HOLD1+DIGIT
;
;	GET MULTIPLIER INTO HOLDING REGISTER
;
FMUL3:	LD	A,(DE)
	LD	(HL),A	;PUT IN REGISTER
	DEC	HL
	DEC	DE
	DEC	C
	JP	NZ,FMUL3
	LD	(HL),C
	DEC	HL
	LD	B,250	;SET LOOP COUNT
FMUL4:	LD	DE,DIGIT+1
	LD	C,E
	ADD	HL,DE
	EX	DE,HL
	ADD	HL,DE	;HL=NEXT HOLDING REGISTER
	INC	B
	JP	P,FMUL8	;FINISHED
FMUL5:	LD	A,(DE)	;GET DIGITS
	ADC	A,A	;TIMES 2
	DAA
	LD	(HL),A	;PUT IN HOLDING REGISTER
	DEC	DE
	DEC	HL
	DEC	C
	JP	NZ,FMUL5
	INC	B	;INCREMENT LOOP COUNT
	JP	NZ,FMUL4
;
;	FORM 10X BY ADDING 8X AND 2X
;	FIRST GET 8X
;
	INC	HL
	LD	DE,HOLD5;NEXT HOLDING REGISTER
	LD	C,DIGIT+1
	LD	B,C
FMUL6:	LD	A,(HL)
	LD	(DE),A
	INC	HL
	INC	DE
	DEC	C
	JP	NZ,FMUL6
	LD	HL,HOLD2+DIGIT ;GET 2X
	DEC	DE
FMUL7:	LD	A,(DE)
	ADC	A,(HL)	;FORM 10X
	DAA
	LD	(DE),A
	DEC	DE
	DEC	HL
	DEC	B
	JP	NZ,FMUL7
	LD	B,249
	EX	DE,HL
	JP	FMUL4
;
FMUL8:	EX	DE,HL
	INC	HL
	LD	(HL),DIGIT+1 ;SET NEXT LOOP COUNT
;
;	PERFORM ACCUMULATION OF PRODUCT
;
FMUL9:	POP	BC	;GET MULTIPLIER
	LD	HL,HOLD8+DIGIT+1
	DEC	(HL)	;DECREMENT LOOP COUNT
	JP	Z,FMU14	;FINISHED
	LD	A,(BC)
	DEC	BC
	PUSH	BC
	DEC	HL
	EX	DE,HL
FMU10:	ADD	A,A	;CHECK FOR BIT IN CARRY
	JP	C,FMU11	;FOUND A BIT
	JP	Z,FMU12	;ZERO- FINISHED THIS DIGIT
	LD	HL,-DIGIT-1
	ADD	HL,DE	;POINT TO NEXT HOLDING REGISTER
	EX	DE,HL
	JP	FMU10
;
FMU11:	LD	C,A
	OR	A	;CLEAR CARRY
	CALL	ADDF	;ACCUMULATE PRODUCT
	LD	A,(DE)
	ADD	A,(HL)
	DAA
	LD	(HL),A
	LD	A,C
	DEC	DE
	JP	FMU10
;
;	ROTATE RIGHT 1 BYTE
;
FMU12:	LD	B,8
	CALL	RIGHT
	JP	FMUL9
;
FMU14:	LD	A,(BUF)
	AND	0F0H	;CHECK IF NORMALIZED
	JP	Z,FMU17
	LD	A,D
	AND	0F0H
	LD	HL,SIGN-1
	JP	FMU18
;
FMU17:	LD	B,4
	LD	HL,EXP
	DEC	(HL)
	JP	Z,UNDER
	CALL	LEFT	;NORMALIZE
	LD	A,D	;GET DIGIT SHIFTED OFF
;
;	PERFORM ROUNDING
;
	RRCA
	RRCA
	RRCA
	RRCA
FMU18:	CP	50H
	JP	C,FMU16
	INC	A
	AND	0FH
	LD	C,DIGIT
FMU15:	ADC	A,(HL)
	DAA
	LD	(HL),A
	LD	A,0
	DEC	HL
	DEC	C
	JP	NZ,FMU15
;
;	CHECK FOR ROUNDING OVERFLOW
;
	JP	NC,ADS2	;NO OVERFLOW
	INC	HL
	LD	(HL),10H
	LD	HL,EXP
	INC	(HL)
	JP	NZ,ADS2
	JP	OVER
;
;	ROUNDING NOT NEEDED
;
FMU16:	AND	0FH
	ADD	A,(HL)
	LD	(HL),A
	JP	ADS2
;
;	FLOATING POINT DIVISION
;
FDIV:	PUSH	BC
	LD	A,(HL)	;FETCH DIVISOR EXP
	OR	A	;DIVIDE BY 0?
	JP	 Z,DIVZ
	LD	A,(DE)
	OR	A	;DIVIDEND=0?
	JP	Z,INSP
	SUB	(HL)
	JP	C,DIVUN
	JP	M,OVER
	JP	FDI1
;
DIVUN:	JP	P,UNDER
FDI1:	ADD	A,129	;FORM QUOTIENT EXP
	LD	(EXPD),A
	EX	DE,HL
	PUSH	DE
	CALL	LOAD	;FETCH DIVIDEND
	POP	DE
	EX	DE,HL
	LD	A,(SIGN)
	DEC	HL
	XOR	(HL)	;FORM QUOTIENT SIGN
	LD	(SIGND),A
	EX	DE,HL
	DEC	DE
	LD	BC,HOLD1
DIV0:	LD	L,DIGIT+DIGIT
DIV1:	PUSH	BC
	PUSH	HL
	LD	C,0	;QUOTIENT DIGIT=0
DIV3:	SCF		;SET CARRY
	LD	HL,BUF+DIGIT-1
	LD	B,DIGIT
DIV4:	LD	A,99H
	ADC	A,0
	EX	DE,HL
	SUB	(HL)
	EX	DE,HL
	ADD	A,(HL)
	DAA
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	B
	JP	NZ,DIV4
	LD	A,(HL)
	CCF
	SBC	A,0
	LD	(HL),A
	RRA
	LD	HL,DIGIT
	ADD	HL,DE
	EX	DE,HL
	INC	C	;INCREMENT QUOTIENT
	RLA
	JP	NC,DIV3
	OR	A	;CLEAR CARRY
	CALL	ADDF	;RESTORE DIVIDEND
	LD	HL,DIGIT
	ADD	HL,DE
	EX	DE,HL
	PUSH	BC
	LD	B,4
	CALL	LEFT	;SHIFT DIVIDEND
	POP	BC
	DEC	C
	POP	HL
	LD	H,C
	POP	BC
	LD	A,L
	JP	NZ,DIV5
	CP	DIGIT+DIGIT
	JP	NZ,DIV5
	LD	HL,EXPD
	DEC	(HL)
	CALL	Z,UNDER
	JP	DIV0
;
DIV5:	RRA
	LD	A,H
	JP	NC,DIV6
	LD	A,(BC)
	RLCA
	RLCA
	RLCA
	RLCA
	ADD	A,H
	LD	(BC),A	;STORE QUOTIENT
	INC	BC
	JP	DIV7
;
DIV6:	LD	(BC),A	;STORE QUOTIENT
DIV7:	DEC	L	;DECREMENT DIGIT COUNT
	JP	NZ,DIV1
	LD	HL,EXPD
	POP	BC
	CALL	STORO
	RET
;
;	FETCH AND ALIGN ARGUMENTS FOR
;	ADDITION AND SUBTRACTION
;
EXPCK:	LD	A,(DE)
	SUB	(HL)	;DIFFERENCE OF EXPS
	LD	C,0
	JP	NC,EXPC1
	INC	C
	EX	DE,HL
	CPL
	INC	A
EXPC1:	LD	B,A
	LD	A,(DE)
	LD	(EXP),A
	LD	A,B
	CP	DIGIT+DIGIT
	JP	C,EXPC2
	LD	A,DIGIT+DIGIT
EXPC2:	RLCA
	RLCA
	LD	B,A
	AND	4
	LD	(RCTRL),A;SET ROUNDING CONTROL
	PUSH	BC
	PUSH	DE
	CALL	LOAD	;LOAD SMALLER VALUE
	LD	A,8*DIGIT+16
	SUB	B
	CP	8*DIGIT+16
	JP	Z,EXPC3
	AND	0F8H
	RRA
	RRA
	RRA
	ADD	A,E
	LD	E,A
	LD	A,D
	ADC	A,0
	LD	D,A
	LD	A,(DE)	;GET ROUNDING DIGIT
	LD	(RDIGI),A;SAVE
EXPC3:	CALL	RIGHT	;ALIGN VALUES
	POP	DE
	POP	BC
	RET
;
;	LOAD ARGUMENT INTO BUFFER
;
LOAD:	LD	DE,SIGN
	LD	C,DIGIT+1
	DEC	HL
LOAD1:	LD	A,(HL)
	LD	(DE),A
	DEC	HL
	DEC	DE
	DEC	C
	JP	NZ,LOAD1
	XOR	A
	LD	(DE),A
	DEC	DE
	LD	(DE),A
	LD	(RDIGI),A;ZERO ROUNDING DIGIT
	RET
;
;	STORE RESULTS IN MEMORY
;
STORE:	LD	HL,EXP
STORO:	LD	E,DIGIT+2
STOR1:	LD	A,(HL)
	LD	(BC),A
	DEC	BC
	DEC	HL
	DEC	E
	JP	NZ,STOR1
	RET
;
;	SHIFT RIGHT NUMBER OF DIGITS
;	IN B/4
;
RIGHT:	LD	C,DIGIT+1
RIGH1:	LD	HL,BUF-1
	LD	A,B
	SUB	8	;CHECK IF BYTE CAN BE SHIFTED
	JP	NC,RIGH3
	DEC	B
	RET	M
	OR	A
RIGH2:	LD	A,(HL)
	RRA
	LD	(HL),A
	INC	HL
	DEC	C
	JP	NZ,RIGH2
	JP	RIGHT
;
;	SHIFT RIGHT ONE BYTE
;
RIGH3:	LD	B,A
	XOR	A
RIGH4:	LD	D,(HL)
	LD	(HL),A
	LD	A,D
	INC	HL
	DEC	C
	JP	NZ,RIGH4
	JP	RIGHT
;
;	SHIFT LEFT NUMBER OF DIGITS
;	IN B/4
;
LEFT:	LD	C,DIGIT+1
	LD	HL,SIGN-1
LEF1:	LD	A,B
	SUB	8
	JP	NC,LEF3
	DEC	B
	RET	M
	OR	A
LEF2:	LD	A,(HL)
	RLA
	LD	(HL),A
	DEC	HL
	DEC	C
	JP	NZ,LEF2
	JP	LEFT
;
;	SHIFT LEFT ONE BYTE
;
LEF3:	LD	B,A
	XOR	A
LEF4:	LD	D,(HL)
	LD	(HL),A
	LD	A,D
	DEC	HL
	DEC	C
	JP	NZ,LEF4
	JP	LEFT
;
;	SET FLAGS FOR OVERFLOW, UNDERFLOW,
;	AND DIVIDE BY ZERO
;
UNDER:	LD	A,0FFH
	LD	(ERRI),A
INSP:	DI
	INC	SP
	INC	SP
	EI
	RET

;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 15 - SYSTEM 				*
;	*							*
;	*		    					*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *

;	ACC CONTAINS FUNCTION CODE - EACH FUNCTION HAS ITS OWN
;	CALLING SEQUENCE - SEE BELOW

;	IN ANY CASE REG. IY CANNOT BE USED IN THE CALL SEQUENCE
;	(SPERO CHE QUESTO NON FACCIA GUAI - DA PROVARE)


SYS:	CP	26		;ALLOWED IN THE 0-25 RANGE ONLY
	JP	NC,E3

	PUSH	IY
	PUSH	HL
	PUSH	DE

	LD	HL,SYSJT	;ADDRESS OF THE JUMP TABLE
	LD	E,A		;BUILD ADDRESS OF THE ROUTINE TO CALL
	LD	D,0
	ADD	HL,DE
	ADD	HL,DE

	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;DE HAS THE ADRRESS OF THE ROUTINE TO CALL

	PUSH	DE
	POP	IY		;NOW IN IY

	POP	DE		;RESTORE DE
	LD	HL,SYSRET
	EX	HL,(SP)		;RESTORE HL AND PRESET RETURN ADDRESS

	JP	(IY)

SYSRET:	POP	IY
	RET

;	SYS VECTOR TABLE

SYSJT:	DW	PSH_USTK	;0
	DW	ISRX2		;1
	DW	ASKMYLEV	;2
	DW	INSTVEC		;3
	DW	PARSEP		;4
	DW	PARSEP2		;5
	DW	CSERR		;6
	DW	TRIPLEX		;7
	DW	RPLDRV		;8
	DW	RPLBKSP		;9
	DW	NEWTASK		;10
	DW	N		;11 - ERA STOPALL
	DW	DOCKSUM		;12
	DW	CRITON		;13
	DW	CRITOF		;14
	DW	INFBOFA		;15
	DW	INFEOFA		;16
	DW	N		;17
	DW	CNS		;18
	DW	INTMON		;19
	DW	QRYMMT		;20
	DW	QRYFREQ		;21
	DW	DRADDR		;22
	DW	POPTASK		;23
	DW	SETIODRV	;24
	DW	SETWDFUN	;25

;------------------------------------------------------------------------
;	SYSTEM FUNCTIONS
;------------------------------------------------------------------------


;------------------------------------------------------------------------
;	FUNCTION #0 - PSH_USTK
;------------------------------------------------------------------------

;	PUSH BC ASCII CHARACTERS AT HL INTO THE USER STACK
;	DO NOT PUSH TERMINATOR - IT SHALL BE DONE BY POP_USTK

PSH_USTK:
	LD	A,(INT_ENA)	;IF = 2
	CP	2
	RET	Z		;DO NOT ENQUEUE REQUESTS

	PUSH	HL		;FIRST DO OVFL TEST
	LD	HL,(USP_FR)
	DEC	HL
	DEC	HL
	OR	A
	SBC	HL,BC
	JP	C,STKERR
	LD	(USP_FR),HL	;UPDATE FREE SPACE COUNTER

	LD	A,C
	CALL	PSH_CH
	LD	A,B
	CALL	PSH_CH
	POP	HL		;HL IS SOURCE ADDR


PSH_1:				;PUSH STRING
	LD	A,(HL)
	CALL	PSH_CH

	INC	HL
	DEC	BC

	XOR	A
	OR	C
	JP	NZ,PSH_1
	OR	B
	JP	NZ,PSH_1
	RET


;------------------------------------------------------------------------
;	FUNCTION #2 - ASKMYLEV - RETURNS THE INT # OF FILE # ACC IN ACC.
;------------------------------------------------------------------------

ASKMYLEV:
	LD	A,E
	CALL	DIRENTRY
	INC	HL
	INC	HL
	INC	HL
	LD	A,(HL)
	RET

;---------------------------------------------------------------------------
;	FUNCTION #3 - INSTVEC - INTERRUPT VECTORS INSTALLER
;---------------------------------------------------------------------------

;	ON INPUT:
;		HL - POINTS TO TABLE OF VECTORS TO INSTALL
;		B - TABLE # WHERE TO INSTALL VECTORS
;		E - TABLE TYPE:
;			0=SIO - FOUR VECTORS
;			1=CTC - ONE VECTOR
;			2=PIO - ONE VECTOR

;	ON OUTPUT:
;		A  - 0=OK 1=ERROR
;		C  - VECTOR TO PROGRAM INTO DEVICE (.LOW.)

INSTVEC:PUSH	HL
	LD	A,E
	OR	A
	JR	Z,INSTSIO
	CP	1
	JR	Z,INSTCTC
	CP	2
	JR	Z,INSTPIO
	JP	IVERR

INSTSIO:LD	HL,VTDTSIO
	JR	INST1

INSTCTC:LD	HL,VTDTCTC	;VECTOR TABLE DESCRIPTOR X CTC
	JR	INST1

INSTPIO:LD	HL,VTDTPIO

INST1:	LD	A,(HL)		;BYTES TO TRANSFER

	INC	HL

	LD	C,B		;B = TABLE # WHERE TO INSTALL VECTORS
	LD	B,0

	ADD	HL,BC
	ADD	HL,BC
	ADD	HL,BC

	LD	E,(HL)
	INC	HL

	LD	D,(HL)		;DE HAS DEST ADDRESS
	INC	HL

	LD	C,(HL)		;C HAS VECTOR TO PROGRAM INTO DEVICE

	POP	HL		;HL HAS SOURCE ADDR

	PUSH	BC		;SAVE VECTOR FOR THE DEVICE

	LD	C,A
	LD	B,0

	LDIR			;COPY TO DEST

	POP	BC

	XOR	A
	RET


;	VECTOR TABLE DESCRIPTOR TABLES

VTDTSIO:DB	8		;BYTES TO TRANSFER

	DW	SIO0		;TABLE ADDRESS - PORT A
	DB	.LOW.SIO1	;VECTOR TO PROGRAM INTO DEVICE
	DW	SIO1		;TABLE ADDRESS - PORT B
	DB	.LOW.SIO1	;VECTOR TO PROGRAM INTO DEVICE

	DW	SIO2		;TABLE ADDRESS - PORT A
	DB	.LOW.SIO3	;VECTOR TO PROGRAM INTO DEVICE
	DW	SIO3		;TABLE ADDRESS - PORT B
	DB	.LOW.SIO3	;VECTOR TO PROGRAM INTO DEVICE

	DW	SIO4		;TABLE ADDRESS - PORT A
	DB	.LOW.SIO5	;VECTOR TO PROGRAM INTO DEVICE
	DW	SIO5		;TABLE ADDRESS - PORT B
	DB	.LOW.SIO5	;VECTOR TO PROGRAM INTO DEVICE

VTDTCTC:DB	2

	DW	CTC0
	DB	.LOW.CTC0
	DW	CTC1
	DB	.LOW.CTC0
	DW	CTC2
	DB	.LOW.CTC0
	DW	CTC3
	DB	.LOW.CTC0

	DW	CTC4
	DB	.LOW.CTC4
	DW	CTC5
	DB	.LOW.CTC4
	DW	CTC6
	DB	.LOW.CTC4
	DW	CTC7
	DB	.LOW.CTC4

	DW	CTC8
	DB	.LOW.CTC8
	DW	CTC9
	DB	.LOW.CTC8
	DW	CTC10
	DB	.LOW.CTC8
	DW	CTC11
	DB	.LOW.CTC8

VTDTPIO:DB	2

	DW	PIO0
	DB	.LOW.PIO0
	DW	PIO1
	DB	.LOW.PIO1

	DW	PIO2
	DB	.LOW.PIO2
	DW	PIO3
	DB	.LOW.PIO3

	DW	PIO2
	DB	.LOW.PIO2
	DW	PIO3
	DB	.LOW.PIO3

;------------------------------------------------------------------------
;	FUNCTION #4 - PARSEP - PARSE PAIR
;------------------------------------------------------------------------
;		  PARSES THE CONFIG STRING TO GET OUT THE NEXT KEY LETTER
;		  AND RELATIVE ADDRESS
;		  ON INPUT: (TXA_CS) TO CONFIG STRING
;
;		  ON OUTPUT:
;			ZERO = 1 = OK
;			ZERO = 0 = NO PAIR FOUND
;			E   = KEY LETTER
;			B   = VALUE

PARSEP:	CALL	PARSE_CS
	CP	1		;CHAR?
	JP	NZ,PARSERR
	LD	E,B		;SAVE KEY LETTER IN E
	PUSH	DE

	CALL	PARSE_CS	;WHICH VALUE?
	CP	2		;VALUE?
	POP	DE		;GET BACK KEY LETTER
	JP	NZ,PARSERR
	XOR	A
	RET

PARSERR:LD	A,1		;RESET ZERO FLAG
	OR	A
	RET

;------------------------------------------------------------------------
;	FUNCTION #5 - PARSEP2 - PARSE PAIR - 2
;------------------------------------------------------------------------
;		  PARSES THE CONFIG STRING TO GET OUT THE NEXT KEY LETTER
;		  AND RELATIVE ADDRESS
;		  ON INPUT: (TXA_CS) TO CONFIG STRING
;			    E = EXPECTED LETTER - IF NOT FOUND THEN CSERR
;		  ON OUTPUT:
;			B   = VALUE
PARSEP2:PUSH	DE
	CALL	PARSEP
	JP	NZ,CSERR
	POP	HL		;PUSHED AS DE
	LD	A,L
	CP	E		;CONTROLLA LETTERA
	JP	NZ,CSERR
	RET


;------------------------------------------------------------------------
;	FUNCTION #7 - TRIPLEX - PARSE A WHOLE CONFIG STRING
;------------------------------------------------------------------------

;	PARSES A COMMON CONFIG STRING (SIO / CTC /PIO)

;	INPUT: D=EXPECTED DEVICE LETTER (S=SIO C=CTC P=PIO)
;	       E=1 IF STRING IS PRESENT - 0 OTHERWISE

;	RETURNS D=DATA C=CONTROL E=VEC B=TABLE

TRIPLEX:LD	A,E		;CHECK FOR STRING PRESENT
	OR	A
	JP	Z,CSERR

	LD	E,D
	LD	A,D
	CP	'C'		;CTC?
	JR	Z,TRICTC
	CP	'P'		;PIO?
	JR	Z,TRIPIO
	CP	'S'		;MUST BE SIO
	JP	NZ,CSERR

	CALL	PARSEP2		;PARSE TABLE
	PUSH	BC		;SAVE TABLE ADDRESS

	LD	E,'D'		;DATA PORT PAIR
	CALL	PARSEP2
	LD	D,B		;SAVE DATA PORT
	PUSH	DE

	LD	E,'C'		;CONTROL PORT PAIR
	CALL	PARSEP2
	POP	DE
	LD	A,B
	POP	BC
	LD	C,A
	PUSH	BC		;BC IS COMPLETE
	PUSH	DE

	LD	E,'V'		;CONTROL PORT PAIR
	CALL	PARSEP2
	POP	DE
	LD	E,B		;DE IS COMPLETE
	POP	BC
	RET

TRICTC:	CALL	PARSEP2		;PARSE TABLE
	PUSH	BC		;SAVE TABLE ADDRESS

	LD	E,'D'		;DATA PORT PAIR
	CALL	PARSEP2
	LD	D,B		;SAVE DATA PORT
	POP	BC		;TABLE ADDRESS
	RET

TRIPIO:	CALL	PARSEP2		;PARSE TABLE
	PUSH	BC		;SAVE TABLE ADDRESS

	LD	E,'D'		;DATA PORT PAIR
	CALL	PARSEP2
	LD	D,B		;SAVE DATA PORT
	PUSH	DE

	LD	E,'C'		;CONTROL PORT PAIR
	CALL	PARSEP2
	POP	DE
	LD	A,B
	POP	BC
	LD	C,A		;CONTROL PORT
	LD	E,A		;VECTOR PORT HAS CONTROL PORT ADDRESS
	RET

;------------------------------------------------------------------------
;	FUNCTION #8 - RPLDRV - REPLACE A DRIVER
;------------------------------------------------------------------------

;	NOTA: DEVE ESSERE MODIFICATA PER AGGIORNARE ANCHE IL TIPO (BLOCK ECC.)


;	SUBSTITUTE A DRIVER ADDRESS IN DIRTAB WITH A NEW ONE
;	ONLY ONE CHECK IS MADE - DRIVER MUS BE OPEN
;	USER MUST KNOW WHAT HE'S DOING

;	ON INPUT: E = CHANNEL #
;		  HL = ADDRESS OF NEW DRIVER

RPLDRV:	LD	A,E
	EX	DE,HL		;NEW DRV ADDR IN DE
	CALL	DIRENTRY	;SET HL AT DIR ENTRY
	INC	HL		;GO TO CHECK IF DRV IS OPEN
	INC	HL
	XOR	A
	CP	(HL)
	JP	Z,DRVERR	;IT MUST BE
	DEC	HL
	DEC	HL
	LD	(HL),E		;STORE NEW ADDRESS OVER THE OLD ONE
	INC	HL
	LD	(HL),D
	RET

;------------------------------------------------------------------------
;	FUNCTION #9 - RPLBKSP - REPLACE BACKSPACE KEY
;------------------------------------------------------------------------

;	REPLACE BACKSPACE KEY WITH THE ONE IN E REG

RPLBKSP:LD	A,E
	LD	(RUBOUT),A
	RET

;------------------------------------------------------------------------
;	FUNCTION #10 - NEWTASK
;------------------------------------------------------------------------

;	INSTALL A NEW TASK
;	ON ENTRY:
;		HL - ADDRESS OF ROUTINE THAT PERFORM THE TASK
;		B  - PRESCALE FACTOR (NOT USED CURRENTLY)
;		C  - PRIORITY LEVEL (0=MAX) (NOT USED CURRENTLY)
;		D  - MAXIMUM CPU TIME (IN TICS) FOR THIS TASK (NOT USED CURR)
NEWTASK:JP	INSTTSK

;------------------------------------------------------------------------
;	FUNCTION #11 - STOPALL - STOPS TIMERS AND OSCS
;------------------------------------------------------------------------

;STOPALL:CALL	STOPTIMS
;	CALL	STOPOSCS
;	RET

;------------------------------------------------------------------------
;	FUNCTION #12 - DOCKSUM - EVALUATE AND STORE RAM CHECKSUM
;------------------------------------------------------------------------

DOCKSUM:LD	HL,0		;CONTROLLA CHECKSUM RAM
	LD	(CKSUM),HL	;AZZERA VALORE INIZIALE
	CALL	CALCEK		;CALCOLA CHECKSUM
	LD	(CKSUM),HL	;E REGISTRA PER RICONTROLLARLO ALL'ACCENSIONE
	RET

;------------------------------------------------------------------------
;	FUNCTION #15 - INFBOFA - RETURN BOFA ADDRESS
;------------------------------------------------------------------------
INFBOFA:LD	HL,BOFA
	RET

;------------------------------------------------------------------------
;	FUNCTION #16 - INFEOFA - RETURN EOFA ADDRESS
;------------------------------------------------------------------------

INFEOFA:LD	HL,BOFA
	RET

;------------------------------------------------------------------------
;	FUNCTION #19 - INTMON - MONITOR GBASIC INTERRUPT REQUESTS
;------------------------------------------------------------------------

;	IT IS CALLED BY AN EXTERNAL PROGRAM THAT WANTS TO MONITOR ANY
;	ARRIVING INTERRUPT REQUEST (NORMALLY INTERRUPTS ARE ACKNOWLEDGED
;	ONLY AT THE BEGINNING OF A STATEMENT)

;	IF AN INTERRUPT REQUEST IS DETECTED (AND INTERRUPTS ARE ENABLED)
;	THE RELATIVE ISR IS EXECUTED UNTIL RETURN INTERRUPT OR RETURN TIMER

;	INTMON WAS CREATED TO ALLOW INTS DURING NORMAL INPUT STATEMENT

;	CALLS TO INTMON CANNOT BE NESTED

INTMON:	LD	A,(DIRF)	;ARE WE RUNNING?
	OR	A
	RET	NZ		;NO, RET


	LD	A,(INT_ENA)	;ARE INTERRUPTS ENABLED?
	OR	A
	RET	Z		;NO, JUST RET

	CP	2		;IF IN STATUS '2' NO SERVICE IS
	RET	Z		;PERFORMED


;	NOW SEE IF THERE ARE ANY PENDING INTERRUPTS
;	CHECK IS DONE LOOKING AT THE FREE SPACE IN INTERRUPTS REQ. STACK

	LD	A,(INTSPFR)	;TEST IF INTERR. IS PENDING (INT SPACE FREE)
	CP	INTMAX		;STACK IS EMPTY? RETURN
	RET	Z		;NO INTERRUPT REQUEST ON THE QUEUE - RETURN

	LD	A,(MIDDLE)	;DO NOT PROCESS NEXT INT UNTIL END OF THIS
	OR	A
	JP	NZ,E4C

	INC	A		;NOW WE ARE IN THE MIDDLE
	LD	(MIDDLE),A

	PUSH	AF
	PUSH	BC
	PUSH	DE
	PUSH	HL
	PUSH	IX
	PUSH	IY

	LD	HL,(TXA)
	PUSH	HL

;	XOR	A
;	LD	(PRIVIL),A

	CALL	ILOOP

	POP	HL
	LD	(TXA),HL
	POP	IY
	POP	IX
	POP	HL
	POP	DE
	POP	BC
	POP	AF

	XOR	A
	LD	(MIDDLE),A

	RET

;------------------------------------------------------------------------
;	FUNCTION #20 - QRYMMT - RETURNS TIME CONSTANT USED IN MMT OSC
;------------------------------------------------------------------------
;	IF NO MMT OSC IS PROGRAMMED THEN RETURNS 0

QRYMMT:	LD	A,(MMTK)
	RET

;------------------------------------------------------------------------
;	FUNCTION #21 - QRYFREQ - RETURNS THE SYS CLOCK FREQUENCY
;------------------------------------------------------------------------
;	DIVIDED BY 100000 OR 0 IF DATA IS NOT AVAILABLE

QRYFREQ:LD	A,(FREQ)
	ADD	A,4		;ROUND IT TO NEAREST 5 MULTIPLE
	LD	D,0

DIV5B:	INC	D		;DIVIDE VALUE BY 5
	SUB	5
	JP	P,DIV5B
	DEC	D

MUL5:	LD	A,D
	SLA	A		;x2
	SLA	A		;x4
	ADD	A,D		;x5

	RET

;------------------------------------------------------------------------
;	FUNCTION #23 - POPTASK - ELIMINATE LAST TASK INSERTED IN MMT LIST
;------------------------------------------------------------------------
;POPTASK:JP	POPTASK

;------------------------------------------------------------------------
;	FUNCTION #24 - SETIODRV - INSTALL AN INP/OUT DRIVER
;------------------------------------------------------------------------

;	THE NUMBER OF THE DRIVER IS IN E REG - ZERO MENAS NO DRIVER

SETIODRV:
	LD	A,E
	LD	(IODRV),A
	RET


;------------------------------------------------------------------------
;	FUNCTION #25 - SETWDFUN  - INSTALL WATCHDOG FUNCTION
;------------------------------------------------------------------------

;	THE WD FUN ADDRESS MUST BE SET INTO HL BEFORE CALLING

SETWDFUN:
	LD	(WDFUN),HL
	RET

;---------------------------------------------------------------------------
;	NMI ROUTINE (POWER FAULT)
;---------------------------------------------------------------------------

NMI0:	PUSH	AF
	LD	A,(CRITIC)	;ARE YOU RUNNING A CRITICAL SEGMENT?
	OR	A
	JR	Z,DOPWDN0	;NO, EXECUTE PDN NORMALLY

	LD	(PDOWN),A	;SET POWER DOWN REQUEST FLAG
	POP	AF
	RETN			;AND SIMPLY RETURN

DOPWDN0:			;HERE YOU CAN DESTROY ANY REG AND SP
				;AS THEY SHALL BE REINITIALIZED
	LD	HL,OSC_A_TAB+1	;STOP OSCILLATORS LESS #1 THAT IS
				;USED FOR CONSOLE BRG
	LD	B,TOTOSC-1

DOPD01:	LD	C,(HL)
	LD	A,3
	OUT	(C),A
	INC	HL
	DJNZ	DOPD01

	LD	A,0FFH		;SET PDFLG = -1
	LD	(PDFLG),A

	JP	DOPWDN

; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

;			    MINI MULTI TASK

; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

;	THIS IS A MINI MULTI TASK KERNEL - PRESENTLY IT SIMPLY CALLS A
;	LIST OF ROUTINES REQUESTED BY THE USER THRU THE DRIVER AT ASSY LEVEL
;	AT EVERY CLOCK TIC

;	MMT MAY BE EXPANDED AT A LATER TIME

;---------------------------------------------------------------------------
;	INIMMT - CALLED BY OSC STATEMENT WITH "FOR SWITCH CLAUSE"
;---------------------------------------------------------------------------

INIMMT:	XOR	A
	LD	(NXTTSK),A
	RET

;---------------------------------------------------------------------------
;	MMTSR - INTERRUPT SERVICE ROUTINE FOR MMT
;---------------------------------------------------------------------------

MMTSR:
	EX	AF,AF'
	EXX
	PUSH	IX
	PUSH	IY

	XOR	A		;FIRST TASK IS #0

TSKLOP:	LD	HL,NXTTSK	;SEE WHOSE TURN IS THIS
	CP	(HL)		;CURRENT TASK = NEXT TASK TO INSTALL?
	JR	Z,QMMT		;YES, END OF WORK - JUMP TO QUIT

	PUSH	AF		;SAVE TASK #

	LD	HL,RETMMT	;PRESET RETURN ADDRESS SO THAT THE USER
	PUSH	HL		;ROUTINE CAN RETURN WITH A "RET"

	LD	C,A		;FIND THE ENTRY
	LD	B,0
	LD	HL,TSKTBL
	ADD	HL,BC
	ADD	HL,BC

	LD	E,(HL)		;GET THE ADDRESS TO CALL
	INC	HL
	LD	D,(HL)
	EX	DE,HL		;AND PASS IT IN HL
	JP	(HL)		;CALL THE USER ROUTINE

RETMMT:	POP	AF		;RESUME TASK #
	INC	A
	JR	TSKLOP

QMMT:
	POP	IY
	POP	IX
	EX	AF,AF'
	EXX
	EI
	RETI

;---------------------------------------------------------------------------
;	INSTTSK - INSTALL TASK - CALLED BY SYS FUNCTION #10 (SEE)
;---------------------------------------------------------------------------

INSTTSK:CALL	GETIFF
	PUSH	AF
	LD	A,(NXTTSK)	;GET NEXT TASK #
	CP	MAXTSK		;TABLE OVERFLOW?
	JP	Z,MMTERR
	INC	A		;INCREMENT POINTER
	LD	(NXTTSK),A

	DEC	A		;COUNTER IS INCREMENTED

	LD	C,A
	LD	B,0
	PUSH	HL		;SAVE ADDRESS FOR THE TABLE
	LD	HL,TSKTBL
	ADD	HL,BC
	ADD	HL,BC
	POP	DE		;PUSHED AS HL - VALUE TO WRITE
	LD	(HL),E
	INC	HL
	LD	(HL),D		;ADDRESS STORED
	POP	AF
	CALL	SETIFF
	RET


;---------------------------------------------------------------------------
;	POPTASK - POP (ELIMINATE) LAST TASK FROM MMT TASK LIST
;---------------------------------------------------------------------------

POPTASK:CALL	GETIFF
	PUSH	AF
	LD	A,(NXTTSK)	;GET NEXT TASK #
	OR	A		;ALREADY 0?
	JR	Z,QPOPT
	DEC	A
	LD	(NXTTSK),A
QPOPT:	POP	AF
	CALL	SETIFF
	RET

;---------------------------------------------------------------------------
;	WRITIM	- WRITE A BYTE TO A TIMER
;---------------------------------------------------------------------------

;	ON INPUT: C=TIMER #   ACC=BYTE TO OUT
;	IF THE TIMER IS NOT OPEN RETURNS ACC<>0

WRITIM:	PUSH	HL
	PUSH	BC
	PUSH	AF

	LD	HL,TIM_A_TAB

WTIM1:	LD	B,0		;BC - ITEM #
	DEC	C
	ADD	HL,BC
	LD	A,(HL)		;GET PHISICAL PORT ADDR
	OR	A
	JP	Z,WTERR
	LD	C,A

	POP	AF
	OUT	(C),A
	XOR	A

WTOK:	POP	BC
	POP	HL
	RET

WTERR:	POP	AF
	LD	A,1
	JR	WTOK

;	ADDRESS - ON ENTRY SET HL TO TABLE START AND C TO ELEMENT
;	RETURNS IN C THE PORT ADDRESS

ADDRESS:LD	B,0		;BC - ITEM #
	DEC	C
	ADD	HL,BC
	LD	A,(HL)		;GET PHISICAL PORT ADDR
	OR	A
	JP	Z,NOTOP
	LD	C,A
	RET

;---------------------------------------------------------------------------
;	WRICNT	- WRITE A BYTE TO A COUNTER
;---------------------------------------------------------------------------
;	ON INPUT: C=CNT #   ACC=BYTE TO OUT
;	IF THE COUNTER IS NOT OPEN RETURNS ACC<>0

WRICNT:	PUSH	HL
	PUSH	BC
	PUSH	AF

	LD	HL,CNT_A_TAB
	JR	WTIM1

;---------------------------------------------------------------------------
;	WRIOSC	- WRITE A BYTE TO AN OSCILLATOR
;---------------------------------------------------------------------------
;	ON INPUT: C=OSC #   ACC=BYTE TO OUT
;	IF THE OSC IS NOT OPEN RETURNS ACC<>0

WRIOSC:	PUSH	HL
	PUSH	BC
	PUSH	AF

	LD	HL,OSC_A_TAB
	JR	WTIM1

;---------------------------------------------------------------------------
;	STOPTIMS - STOPS ALL PROGRAMMED TIMERS
;---------------------------------------------------------------------------
STOPTIMS:
	LD	B,3		;TOTAL TIMERS TO STOP

STT1:	LD	A,3		;WORD TO STOP A TIMER
	LD	C,B		;RESET TIMERS FROM 3 TO 1
	CALL	WRITIM		;NON PROGRAMMED TIMERS ARE NOT WRITTEN
	DJNZ	STT1
	RET

;---------------------------------------------------------------------------
;	STOPOSCS - STOPS ALL PROGRAMMED OSCILLATORS
;---------------------------------------------------------------------------
;STOPOSCS:
;	LD	B,TOTOSC	;TOTAL OSCS TO STOP

;STO1:	LD	A,3		;WORD TO STOP A TIMER
;	LD	C,B		;RESET TIMERS FROM 3 TO 1
;	CALL	WRIOSC		;NON PROGRAMMED TIMERS ARE NOT WRITTEN
;	DJNZ	STO1
;	RET

;	* * * * * * * * * * * * *
;	*      			*
;	* 0_3 INTERRUPT 	*
;	*      			*
;	* SERVICE ROUTINES	*
;	*      			*
;	* * * * * * * * * * * * *


;	EXTERNAL INTERRUPT SERVICE ROUTINES

;---------------------------------------------------------------------------
;	MMTSR - MINI MULTI TASK SERVICE ROUTINE
;---------------------------------------------------------------------------

;	SEE MMT

;---------------------------------------------------------------------------
;	CSRx - COUNTER INT SERVICE
;---------------------------------------------------------------------------

CSR1:	EXX
	EX	AF,AF'
	LD	HL,(VPULS_1)
	INC	HL
	LD	(VPULS_1),HL
	LD	C,1

CSRX:	LD	A,0C7H		;REPROGRAM CTC
	CALL	WRICNT
	LD	A,1
	CALL	WRICNT
	EXX
	EX	AF,AF'
	EI
	RETI

CSR2:	EXX
	EX	AF,AF'
	LD	HL,(VPULS_2)
	INC	HL
	LD	(VPULS_2),HL
	LD	C,2
	JR	CSRX

CSR3:	EXX
	EX	AF,AF'
	LD	HL,(VPULS_3)
	INC	HL
	LD	(VPULS_3),HL
	LD	C,3
	JR	CSRX

;
;	* * TSR1	TIMER 1
;	========
TSR1:

;	ENTRY TO TIMER ROUTINES IS NOT DIRECT
;	AND IS DONE ONLY AFTER COUNT DOWN
;
	DI
	PUSH	AF
	LD	A,(TIM1)	;TEST FOR PRESCALER TIMEOUT
	DEC	A
	LD	(TIM1),A
	JP	NZ,TIMRETX
	LD	A,(TIMKA)	;RELOAD PRESCALER
	LD	(TIM1),A

	PUSH	HL
	LD	HL,(SECS1)
	INC	HL
	LD	(SECS1),HL
	POP	HL

	LD	A,(TIM1B)	;IF PRESCALER WENT TO TIMEOUT
	DEC	A		;DECREMENT BASIC COUNTER
	LD	(TIM1B),A
	JP	Z,TMEOUT1

TIMRETX:POP	AF		;NO BASIC INTERRUPT
	EI
	RETI

TMEOUT1:LD	A,(TIM1FR)	;TEST FREE RUN FLAG
	OR	A
	JP	Z,SNGRUN1	;SINGLE RUN
	LD	A,(TIM1BU)	;RELOAD BASIC COUNTER WITH USER VALUE
	LD	(TIM1B),A
	JP	FRERUN1

SNGRUN1:PUSH	BC
	LD	C,1
	LD	A,3		;RESET CTC
	CALL	WRITIM
	LD	(TIMER1B),A
	POP	BC

FRERUN1:POP	AF
	PUSH	DE
	LD	E,6		;INTERRUPT #
	JP	ISRX

;
;	* * TSR2	TIMER 2
;	========
TSR2:	DI
	PUSH	AF
	LD	A,(TIM2)	;TEST FOR PRESCALER TIMEOUT
	DEC	A
	LD	(TIM2),A
	JP	NZ,TIMRETX
	LD	A,(TIMKA)	;RELOAD PRESCALER
	LD	(TIM2),A

	PUSH	HL
	LD	HL,(SECS2)
	INC	HL
	LD	(SECS2),HL
	POP	HL

	LD	A,(TIM2B)	;IF PRESCALER WENT TO TIMEOUT
	DEC	A		;DECREMENT BASIC COUNTER
	LD	(TIM2B),A
	JP	Z,TMEOUT2

	JR	TIMRETX		;NO BASIC INTERRUPT

TMEOUT2:LD	A,(TIM2FR)	;TEST FREE RUN FLAG
	OR	A
	JP	Z,SNGRUN2	;SINGLE RUN
	LD	A,(TIM2BU)	;RELOAD BASIC COUNTER WITH USER VALUE
	LD	(TIM2B),A
	JP	FRERUN2

SNGRUN2:PUSH	BC
	LD	C,2
	LD	A,3		;RESET CTC
	CALL	WRITIM
	LD	(TIMER2B),A
	POP	BC

FRERUN2:POP	AF
	PUSH	DE
	LD	E,7		;INTERRUPT #
	JP	ISRX

;
;	* * TSR3	TIMER 3
;	========
TSR3:	DI
	PUSH	AF
	LD	A,(TIM3)	;TEST FOR PRESCALER TIMEOUT
	DEC	A
	LD	(TIM3),A
	JP	NZ,TIMRETX
	LD	A,(TIMKA)	;RELOAD PRESCALER
	LD	(TIM3),A

	PUSH	HL
	LD	HL,(SECS3)
	INC	HL
	LD	(SECS3),HL
	POP	HL

	LD	A,(TIM3B)	;IF PRESCALER WENT TO TIMEOUT
	DEC	A		;DECREMENT BASIC COUNTER
	LD	(TIM3B),A
	JP	Z,TMEOUT3

	JP	TIMRETX		;NO BASIC INTERRUPT

TMEOUT3:LD	A,(TIM3FR)	;TEST FREE RUN FLAG
	OR	A
	JP	Z,SNGRUN3	;SINGLE RUN
	LD	A,(TIM3BU)	;RELOAD BASIC COUNTER WITH USER VALUE
	LD	(TIM3B),A
	JP	FRERUN3

SNGRUN3:PUSH	BC
	LD	C,3
	LD	A,3		;RESET CTC
	CALL	WRITIM
	LD	(TIMER3B),A
	POP	BC

FRERUN3:POP	AF
	PUSH	DE
	LD	E,8		;INTERRUPT #
	JP	ISRX

;-----------------------------------------------------------------------


;
;
;	* * * * * * * * * * * * *
;	*      			*
;	* 0_3 LOGICAL DEVICE	*
;	*      			*
;	* DRIVERS		*
;	*      			*
;	* * * * * * * * * * * * *
;
;
;	* * CONIN 	READS A CHARACTER INTO ACC
;	=========	FROM THE CURRENT CONSOLE CHANNEL
;			SELECTED BY IBYTE
;			AT BOOT CONSOLE IS CH 0

CONIN:	PUSH	BC
	PUSH	DE
	PUSH	HL
	CALL	CONIN1
	POP	HL
	POP	DE
	POP	BC
	LD	B,A
	RET

CONIN1:	LD	A,(IBYTE)	;SEE WHICH CHANNEL USE AS CONSOLE

	LD	C,A
	LD	B,5		;READ / CHAR
	CALL	DRIVER
	OR	A
	JP	NZ,DRVERR

	LD	A,E
	LD	B,A		;?? SERVE ??

CINXIT:	RET




;	* * CONSTAT	TEST CONSOLE STATUS
;	===========	IF NO CHAR TYPED RETURNS A 00
;			ELSE RETURNS THE CHAR WITHOUT DISTURBING THE BUFFER
;			(CP/M VERSION RETURNS FF WHEN CHARS TYPED)
;			BUFFER OR POINTERS NOT DISTURBED
;			CONSIDER THE CURRENT CONSOLE CHANNEL
;			SELECTED BY IBYTE
;			AT BOOT CONSOLE IS CH 0


CONSTAT:PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	A,(IBYTE)
	LD	C,A
	LD	B,6		;STATUS
	CALL	DRIVER
	OR	A
	JP	NZ,DRVERR
	LD	A,E
	POP	HL
	POP	DE
	POP	BC
	RET

;
;	* * ERROUT 	OUTPUTS A CHARACTER FROM ACC
;	==========	TO THE CURRENT ERROR DEVICE
;			SELECTED BY ERRBYTE
;			AT BOOT ERR: IS CH 0

ERROUT:	PUSH	AF		;SAVE CHAR
	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	E,A
	LD	A,(ERRBYTE)	;SEE WHICH CHANNEL USE

	JR	ANY_OUT


;	* * CONOUT 	OUTPUTS A CHARACTER FROM ACC
;	==========	TO THE CURRENT CONSOLE CHANNEL
;			SELECTED BY OBYTE
;			AT BOOT CONSOLE IS CH 0

CONOUT:	PUSH	AF		;SAVE CHAR
	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	E,A
	LD	A,(OBYTE)	;SEE WHICH CHANNEL USE AS CONSOLE

ANY_OUT:LD	C,A		;DRIVER # - E HAS CHAR TO OUT
	LD	B,4		;FUNCTION #4 WRITE / CHAR
	CALL	DRIVER
	OR	A
	JP	NZ,DRVERR
	POP	HL
	POP	DE
	POP	BC
	POP	AF
	RET

;
;	* * AUXOUT 	OUTPUTS A CHARACTER FROM ACC
;	==========	TO THE CURRENT AUX DEVICE
;			SELECTED BY AUXOBYTE
;			DEVICE MUST BE ASSIGNED WITH AUX:

AUXOUT:
	PUSH	AF		;SAVE CHAR
	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	E,A
	LD	A,(AUXOBYTE)	;SEE WHICH CHANNEL USE AS AUX

	CP	0FFH		;UNASSIGNED?
	JP	Z,DRVERR
	JR	ANY_OUT


;	* * AUXIN 	READS A CHARACTER INTO ACC
;	=========	FROM THE CURRENT AUX DEVICE
;			SELECTED BY AUXIBYTE
;			DEVICE MUST BE ASSIGNED WITH AUX:

AUXIN:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	A,(AUXIBYTE)	;SEE WHICH CHANNEL USE AS AUX

	LD	C,A
	LD	B,5		;READ / CHAR
	CALL	DRIVER
	OR	A
	JP	NZ,DRVERR
	LD	A,E
	LD	B,E		;?? SERVE ??
	POP	HL
	POP	DE
	POP	BC
	LD	B,A
	RET


;
;	* * LST 	OUTPUTS A CHARACTER FROM ACC
;	=======		TO THE CURRENT LST DEVICE
;			SELECTED BY LOBYTE
;			DEVICE MUST BE ASSIGNED WITH LST:

LST:
	PUSH	AF		;SAVE CHAR
	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	E,A		;CHAR TO OUT

	LD	A,(LOBYTE)	;SEE WHICH DRIVER TO USE AS LST
	CP	0FFH		;UNASSIGNED?
	JP	Z,DRVERR

	CALL	DRVTYP		;SEE IF BLOCK OR CHAR

	OR	A		;TYPE 0=CHAR
	LD	A,(LOBYTE)	;RESET DRIVER #
	JR	Z,ANY_OUT	;GO AS FOR CONSOLE

	JP	DRVERR		;OTHER TYPES NOT SUPPORTED CURRENTLY



;	* * * * * * * * * * * * *
;	*      			*
;	* 0_4 BIOS ROUTINES	*
;	*      			*
;	* CALLABLE BY PGMS_	*
;	*      			*
;	* * * * * * * * * * * * *


;	* * ISRX - COMMON INPUT FOR ALL INTERRUPTS

ISRX:	PUSH	AF
	PUSH	BC
	PUSH	HL
	PUSH	IX

	LD	A,(INT_ENA)	;ENABLE = 2 ?
	CP	2
	JR	Z,ISRXIT	;DO NOT ENQUEUE REQUESTS

	LD	D,0
	CALL	SETIX		;GET ENTRY ADDRESS

	INC	IX
	INC	IX
	INC	IX
	LD	A,(IX+0)	;GET STATUS

				;MULTIPLE REQUESTS ON THE SAME LEVEL
				;ARE ALLOWED BECAUSE OF STACKING

	CP	0		;STATUS MUST TO BE 'PRESET' OR 'ON SERVICE'
	JP	Z,E9		;IF INACTIVE GO TO ERROR

	CALL	PUSHREQ

ISRXIT:	POP	IX
	POP	HL
	POP	BC
	POP	AF
	POP	DE
	EI
	RETI


;	* * ISRX2 - SIMILAR TO ISRX BUT DOES NOT REENABLE INTERRUPTS
;		    CALLED LIKE A SUBROUTINE

;	MFJ 2/12/89 - STACKED INTERRUPTS

;	CALL WITH E=INTERRUPT CODE TO REQUEST

;	NO REGISTER IS SAVED
ISRX2:

	LD	A,(INT_ENA)	;ENABLE = 2 ?
	CP	2
	RET	Z		;DO NOT ENQUEUE REQUESTS

	PUSH	IX
	LD	A,E		;CHECK LEVEL #
	CP	MAXLEV+1	;NOT MORE THAN MAXLEV
	JP	NC,E3
	OR	A		;NOT NEGATIVE
	JP	M,E3

	LD	D,0
	CALL	SETIX		;GET ENTRY ADDRESS

	INC	IX
	INC	IX
	INC	IX
	LD	A,(IX+0)	;GET STATUS

				;MULTIPLE REQUESTS ON THE SAME LEVEL
				;ARE ALLOWED BECAUSE OF STACKING

	CP	0		;STATUS MUST TO BE 'PRESET' OR 'ON SERVICE'
	JP	Z,E9		;IF INACTIVE GO TO ERROR

	CALL	PUSHREQ

	POP	IX
	RET

;	PUSHREQ - PUSHES AN INTERRUPT REQ OF CODE E INTO INT FIFO

PUSHREQ:LD	A,(INTSPFR)	;OVERFLOW TEST
	DEC	A		;DECREMENT FREE SPACE
	JP	M,E9D		;STACK OVERFLOW?
	LD	(INTSPFR),A


	LD	A,(INTSPWR)	;PUSH REQUEST ON STACK

	LD	HL,INT_STK	;PUSH NEW ENTRY
	LD	B,0
	LD	C,A
	ADD	HL,BC
	LD	(HL),E		;EFFECTIVE STORE OF INT# TO BE SERVICED

	INC	A
	CP	INTMAX
	JR	NZ,ISRX2B
	XOR	A
ISRX2B:	LD	(INTSPWR),A
	RET



;----------------------------------------------------------------------------
;	CLINSTK - CLEARS INTERRUPT UNINITIALIZED AREA (FIFOS)
;----------------------------------------------------------------------------

CLINSTK:XOR	A		;RESET INTERRUPTS STACK
	LD	(INTSPWR),A
	LD	(INTSPRD),A

	LD	A,INTMAX	;FREE SPACE
	LD	(INTSPFR),A

	LD	HL,USTACK	;AND USER (DATA) FIFO
	LD	(USP_RD),HL
	LD	(USP_WR),HL

	LD	HL,USP_LIM-USTACK
	LD	(USP_FR),HL
	RET

;----------------------------------------------------------------------------
;	CLINTA - CLEARS THE INTERRUPT TABLE AND RESETS TIMERS
;----------------------------------------------------------------------------

;	DOES NOT CLEAR UNINITIALIZED AREA

CLINTA:	LD	B,ENDINT-BEGINT	;CLEAR INITIALIZED AREA

	LD	HL,BEGINT
	XOR	A

CLINT1:	LD	(HL),A		;WILL WITH ZEROES
	INC	HL
	DJNZ	CLINT1

	LD	HL,0
	LD	(INTLINE),HL

	DI
	CALL	STOPTIMS	;IF PROGRAMMED

	LD	A,3
	LD	(TIMER1B),A
	LD	(TIMER2B),A
	LD	(TIMER3B),A

	EI

	LD	A,TIMK		;TIME CONSTANT FOR ALL TIMERS
	LD	(TIMKA),A	;EXCEPT TIMER 0
	RET



LASTRO:	DB	0

;
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;	*							*
;	*	SECTION 16 - RAM DATA AREA 			*
;	*							*
;	*		    					*
;	*							*
;	*							*
;	* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;
	DSEG

FSTRAM:			;FIRST RAM LOC

CKSUM:	DS	2	;RAM CHECKSUM
DIAGCO:	DS	1	;DIAGNOSTIC CODE FROM STARTUP ROUTINE
	DS	13	;TEMPORARY STACK FOR STARTUP AND POWER DOWN
STACK1:

;	THIS SECTION MUST BEGIN AT LOC $+16 ANYWAY

CKST:			;START OF CHECKSUM MONITORED AREA
VECTAB:
SIO1:	DS	8	;B PORT
SIO0:	DS	8
SIO3:	DS	8	;B PORT
SIO2:	DS	8
SIO5:	DS	8	;B PORT
SIO4:	DS	8

;	ORG 	40H	;CTC VECTORS MUST STAY AT A 8-MULTIPLE ADDRESS

CTC0:	DS	2	;CHAN 0
CTC1:	DS	2
CTC2:	DS	2
CTC3:	DS	2

CTC4:	DS	2	;CHAN 0
CTC5:	DS	2
CTC6:	DS	2
CTC7:	DS	2

CTC8:	DS	2	;CHAN 0
CTC9:	DS	2
CTC10:	DS	2
CTC11:	DS	2

;	ORG 		;PIO VECTORS MUST STAY AT AN EVEN ADDRESS

PIO0:	DS	2
PIO1:	DS	2

PIO2:	DS	2
PIO3:	DS	2

PIO4:	DS	2
PIO5:	DS	2

RECO_PO:DS	2		;POINTER TO RECORD FOR FDM
DMAREA:	DS	256		;BUFFER AREA FOR DRIVERS COMMUNICATION
DIRTAB:	DS	2		;ADDRESS OF DRIVER
	DS	1		;0=FREE 1=OPEN
	DS	1		;INTERRUPT LEVEL
	DS	1		;TYPE:
				;	0 - CHAR ORIENTED
				;	1 - BLOCK ORIENTED
				;	2 - SPECIAL DEVICE


DIRTAB1:
	DS	(DIRTAB1-DIRTAB)*MAXFILES


HOLD1:	DS	DIGIT+1
HOLD2:	DS	DIGIT+1
HOLD3:	DS	DIGIT+1
HOLD4:	DS	DIGIT+1
HOLD5:	DS	DIGIT+1
HOLD6:	DS	DIGIT+1
HOLD7:	DS	DIGIT+1
HOLD8:	DS	DIGIT+1
	DS	1
ERRI:	DS	1	;ERROR FLAG
	DS	1
BUF:	DS	DIGIT	;WORKING BUFFER
SIGN:	DS	1	;SIGN BIT
EXP:	DS	1	;EXPONENT
RCTRL:	DS	1	;ROUNDING CONTROL FLAG 1=MSD
RDIGI:	DS	1	;ROUNDING DIGIT
SIGND	EQU	HOLD1+DIGIT
EXPD	EQU	HOLD1+DIGIT+1
;
;	SYSTEM RAM
;
LWID:	DS	1		;LINE WIDTH LIMIT

;	LA PARTE BASSA DELLO STACK PUO' ESSERE USATA PER SCOPI VARI
;	A RISCHIO E PERICOLO DI CHI LA USA

TMPAREA:DS	0
	DS	STKSIZE
CMNDSP:	DS	1
TRPSIZ	EQU	5
TRPSP:	DS	2
	DS	TRPSIZ-1
TRPSTK:	DS	1
PHEAD:	DS	1
RELTYP:	DS	1

RAMDEV:	DS	1	;OUT SWITCH- 0=NORMAL 1=TO BUFFER - IGNORE LOGDEVO
			;(PREVIOUSLY OUTFLG)
LOGDEVO:DS	1	;LOGIC OUTPUT DEVICE TO BE USED IN CHOUT
			;(PREVIOUSLY OCHANN)
LOGDEVI:DS	1	;LOGIC INPUT DEVICE TO BE USED IN LDEVIN
			;(PREVIOUSLY ICHANN)
TMPDEV:	DS	1	;TEMPORARY STORAGE FOR LOGIC DEVICE
			;(PREVIOUSLY TMPCHANN)

ARGF:	DS	1
DIRF:	DS	1
TXA:	DS	2
CSTKSZ	EQU	100
ASTKSZ	EQU	FPSIZ*LINLEN/2
CSTKL:	DS	CSTKSZ		;CONTROL STACK
ASTKL:	DS	ASTKSZ		;ARGUMENT STACK
RTXA:	DS	2
STB:	DS	2
CSTKA:	DS	2		;CONTROL STACK ADDRESS
SINK:	DS	FPSIZ-1
FPSINK:	DS	1
	DS	FPSIZ-1
FTEMP:	DS	1
	DS	FPSIZ-1
FTEM1:	DS	1
	DS	FPSIZ-1
FTEM2:	DS	1
	DS	FPSIZ-1
FRAND:	DS	1
IBCNT:	DS	1
IBLN:	DS	2
IBUF:	DS	LINLEN
ASTKA:	DS	2
MATA:	DS	2
ADDS:	DS	2
ADDT:	DS	2
BCADD:	DS	2
OPST:	DS	1
OPSTR:	DS	1
ECNT:	DS	1
FSIGN:	DS	1
XXBC:	DS	DIGIT+2	;"XXBC" SI CHIAMAVA "BC" NELLA VECCHIA VERSIONE 8080
ABUF:	DS	DIGIT*2+2
XSIGN:	DS	1
EXPO:	DS	1
FES:	DS	1
INFES:	DS	1
MAXL:	DS	2
INSA:	DS	2
STRFLG:	DS	1	;STRING FLAG - STRING IF NON ZERO (TIP_ @)
LSTCNT:	DS	1	;LINE COUNTER FOR LIST COMMAND
STLEN:	DS	1
VALTEM0:
	DS	15
VALTEM1:
	DS	1
VALTEMP:
	DS	1	;TEMPORARY STORAGE FOR FP VALUES
TTYFLG:	DS	1
NEGINT:	DS	0	;NEGATIVE INTEGER FLAG FROM PFIX

;CI:	DS	1
POSTFIX:
	DS	1



DATALEN:
	DS	2
DATATYP:
	DS	2
RECNUM:	DS	1
OPNAME:
NAM0:	DS	2
NAM2:	DS	2
NAM4:	DS	2
AUXD:	DS	2
BLKST:	DS	2
BLKEND:	DS	2
SPEED:	DS	1


;------------------------------------------------------------------------
;	INTERRUPTS - UNINITIALIZED AREA
;------------------------------------------------------------------------

;	THIS AREA IS NOT CLEARED AT RESET

USP_RD:	DS	2	;USER FIFO READ ABSOLUTE POINTER
USP_WR:	DS	2	;USER FIFO WRITE ABSOLUTE POINTER
USP_FR: DS	2	;USER FIFO FREE SPACE
USTACK:	DS	INTMAX*PSHLEN ;USER FIFO START (A MEAN OF PSHLEN ENTRY
			;LENGHT IS ASSUMED)
USP_LIM:		;USER FIFO END

INTSPFR:DS	1	;INTERRUPT FIFO NUMBER OF FREE ENTRIES
INTSPRD:DS	1	;INTERRUPT FIFO RELATIVE STACK POINTER (READ)
INTSPWR:DS	1	;INTERRUPT FIFO RELATIVE STACK POINTER (WRITE)
INT_STK:DS	INTMAX 	;INTERRUPT FIFO

;------------------------------------------------------------------------
;	INTERRUPTS - INITIALIZED AREA
;------------------------------------------------------------------------

;	THIS AREA UP TO 'ENDINT' IS CLEARED AT RESET

BEGINT:

TIMKA:	DS	1

INTLINE:DS	2	;LINE # OF ISR ROUTINE TO EXECUTE
INT_ENA:DS	1	;INTERRUPT ENABLE FLAG
			;1=ENABLED 0=ENQUEUED 2=NOT ENQUEUED
INTGSUB:DS	1	;INTERRUPT 'GOSUB' FLAG
RETADD:	DS	2	;RETURN ADDRESS

;	TABLE OF INTERRUPTS STATUS

TABINT:	DS	2	;INTERRUPT #0 LINE VECTOR
INTREQ:	DS	1	;INTERRUPT #0 REQUEST FLAG
INTSTUS:DS	1	;INTERRUPT #0 STATUS BYTE
	DS	32

TIM1:	DS	1	;PRESCALER
TIM2:	DS	1
TIM3:	DS	1

TIM1B:	DS	1	;BASIC USER VALUE COUNTER
TIM2B:	DS	1
TIM3B:	DS	1

TIM1BU:	DS	1	;BASIC USER VALUE
TIM2BU:	DS	1
TIM3BU:	DS	1

TIM1FR:	DS	1	;FREE/SINGLE  RUN FLAG
TIM2FR:	DS	1	;0=FREE
TIM3FR:	DS	1

SECS1:	DS	2	;ELAPSED SECONDS SINCE THE START OF A TIMER
SECS2:	DS	2
SECS3:	DS	2

;	TIMER ADDRESS TABLE
;	IF AN ADDRESS IS 0 THE ADDRESS IS INVALID

TIM_A_TAB:
	DS	1		;PHISICAL PORT ADDRESS FOR TIMER 1
	DS	1		;PHISICAL PORT ADDRESS FOR TIMER 2
	DS	1		;PHISICAL PORT ADDRESS FOR TIMER 3

;	COUNTER ADDRESS TABLE
;	IF AN ADDRESS IS 0 THE ADDRESS IS INVALID

CNT_A_TAB:
	DS	1		;PHISICAL PORT ADDRESS FOR CNT 1
	DS	1		;PHISICAL PORT ADDRESS FOR CNT 2
	DS	1		;PHISICAL PORT ADDRESS FOR CNT 3

PRIVIL:	DS	1		;PRIVILEGED INSTRUCTION FLAG
ENDINT:

;	OSCILL ADDRESS TABLE
;	IF AN ADDRESS IS 0 THE ADDRESS IS INVALID

OSC_A_TAB:
	DS	TOTOSC		;PHISICAL PORT ADDRESS FOR OSCS

SAPOINT:DS	2		;POINTER TO NOVRAM SAVE AREA FOR PRINT & INPUT CH5
SAPTMP:	DS	2		;EFFECTIVE POINTER USED AND ALTERED BY INPUT & PRINT CH5
STORELEN: DS	1		;LENGHT OF EACH STORAGE
TXA_CS:	DS	2		;POINTER USED TO PARSE CONFIG STRINGS

RITARDO1:
	DS	1
ARGNUM:	DS	1
CURPREF:DS	1		;CURRENT PREFIX

TIMER1B:
	DS	1
TIMER2B:
	DS	1
TIMER3B:
	DS	1
;PUMPOB:	DS	1

;	INPUT BYTES, IF PRESENT, MUST FOLLOW OUTPUT BYTES

OBYTE:	DS	1		;CONSOLE OUTPUT "	"
IBYTE:	DS	1		;CONSOLE INPUT CONTROL BYTE
AUXOBYTE:DS	1		;AUX OUT OUTPUT	"	"
AUXIBYTE:DS	1		;AUX DEV INPUT	"	"
LOBYTE:	DS	1		;LIST OUTPUT	"	"
CLKBYTE:DS	1		;CLOCK I/O 	"	"
ERRBYTE:DS	1		;ERR.MSG OUT 	"	"
AUXOTEMP:DS	1		;TEMPORARY STORAGE FOR AUXOBYTE DURING REDIR
AUXITEMP:DS	1		;TEMPORARY STORAGE FOR AUXIBYTE DURING REDIR


ERRCON:	DS	1		;HOW TO SET CONSOLE I/O IN CASE OF ERROR
TXABUF:	DS	2		;TXA FOR CH1 INPUT
STGBUF:	DS	258		;TEMPORARY AREA FOR STRING COMPUTING
STLEN1:	DS	1
NOMODIF:DS	1		;"NOT-MODIFY-VARIABLES ON NO INPUT"
				;INPUT STATEMENT OPTION FLAG

PICTF:	DS	1		;PICTURE FLAG - 0=NORMAL INPUT 1=PICTURED
PICSTG:	DS	2		;ADDRESS OF PICTURE STRING (CURRENT CHAR)
PICLEN:	DS	1		;CURRENT RESIDUE LENGHT OF PICTURE STRING
				;BACK UP VALUES FOR RESTORE AT CLEAR
PICSTG0:DS	2		;ADDRESS OF PICTURE STRING (CURRENT CHAR)
PICLEN0:DS	1		;CURRENT RESIDUE LENGHT OF PICTURE STRING
ECHOM:	DS	1		;ECHO MODE 0=ECHO '!'=NO ECHO '*'=MASKED ECHO
AUTOCR:	DS	1		;AUTO CR OF FILLED FIELD 0=NO 1=YES
CLEARCH:DS	1		;SPECIAL CLEAR CHARACTER


CPOINT:	DS	1		;CHAR POINTER FOR NGET@

	IF	FMD
P70H_IMA: DS	1		;PORT 70H RAM IMAGE
PKILPORT_IMA:
	DS	1		;PORT KILPORT RAM IMAGE
	ENDIF

;	IF	MPAGE
;PAGE:	DS	1
;	ENDIF

VPULS_1:DS	2		;PULSER TOTAL COUNT
VPULS_2:DS	2		;PULSER TOTAL COUNT
VPULS_3:DS	2		;PULSER TOTAL COUNT

PASSNAME: DS	12	;EXTERNAL INTERFACE
SPECFUN:  DS	1	;SPECIAL FUNCTION FLAG (SEE XBILT, OPADR)
BRKENA:	DS	1	;1=KEYB BREAK ENABLED -- 0=DISABLED
AUTOST:	DS	1	;AUTOSTART REQ FLAG (0=NO AUTOST)
SYSOK:	DS	1	;SYS INSTALLED FLAG (55H=INSTALLED)
			;USED TO KNOW IF SYSTEM HAS BEEN INITIALIZED
AUTOSTG:DS	2	;ADDRESS OF STARTUP STRING ("RUN xxx")
UBUPO:	DS	2	;USER BUFFER POINTER (SEE NOTE AT OTOBUF
UBUTMP:	DS	2	;USER BUFFER POINTER TEMPORARY STORAGE
MAXBUF:	DS	1	;COUNTDOWN FOR USER BUFFER OUTPUT WITH CHOUT
RUBOUT:	DS	1	;CHARACTER USED AS RUBOUT
NBESC:	DS	1	;NON BREAK ESCAPE (ALTERNATE EXIT FROM INPUT FIELDS)
CONFIRM:DS	1	;CONFIRM CHAR (ALTERNATE EXIT FROM INPUT FIELDS)
LSTRAM:	DS	2	;LAST PHISICAL RAM ADDRESS
NOVST:	DS	2	;BASE ADDRESS OF NOVRAM AREA - CURRENTLY
			;(NOVST) = (MEMTOP) + 1
DKBASE:	DS	2	;BASE OF RAM DISK ("STORAGES" AREA)

NXTTSK:	DS	1	;NEXT TASK TO INSTALL
TSKTBL:	DS	2*MAXTSK	;TABLE OF TASKS TO CALL AT EVERY TIC
			;00XXH MEANS END OF TABLE
PDOWN:	DS	1	;POWER DOWN FLAG - SET BY NMI TO POWER DOWN
CRITIC:	DS	1	;FLAG SET DURING EXECUTION OF A CRITIC SEGMENT
CRITSP:	DS	2	;STACK POINTER TO CRITSTK
CRTSTKB:DS	9	;STACK USED BY CRITSEG/ENDCRIT (BEGINNING)
CRTSTKE:		;(END)

IGNORE:	DS	1	;WHEN THIS FLAG IS SET, ALL TEXT IS SKIPPED AS REM
IGNSP:	DS	2	;NESTED STRUC IF STACK POINTER
IGNSTKB:DS	9	;STACK USED BY NESTED STRUCT IF (BEGINNING)
IGNSTKE:		;(END)


IFF2:	DS	1	;INTERRUPT STATUS - SEE SAVIFF / RESIFF
LOCKED:	DS	1	;USED FOR TEST ONLY

PROMPTF:DS	1	;PROMPT FLAG - SET TO NONZERO  IN INPUT STATEMENT
			;WHEN A PROMPT STRING IS MET (USED TO SKIP THE
			;OUTPUTTING OF THE QUESTION MARK)
INTDIG:	DS	1	;#OF DIGIT FOR OUTPUT FIELD  - IF NO FORMAT SET TO 0
FILLCH:	DS	1	;FILL CHAR FOR FORMATTED OUT
OUTMOD:	DS	1	;INDICATES TYPE OF OUTPUT PORT:0=NORMAL 1=PIO
			;2=BUFFERED NON-PIO
PDFLG:	DS	1	;POWER DOWN FLAG - SEE DIAG(1)

EXICHA:	DS	1	;CHARACTER USED TO LEAVE LAST INPUT STATEMENT
ROEXFG:	DS	1	;EXECUTION IN ROM FLAG (IF <>0)
CALST:	DS	6
CALLA1:	DS	2
CALLA2:	DS	2
IODRV:	DS	1	;DRIVER DA USARE PER L'I/O DA DRIVER (PORTA > 255)

;	VARIABLES USED FOR LOAD HEX COMMAND

BYTCNTR:DS	1		;BYTE COUNTER
CHK:	DS	1		;CHECKSUM
ERR:	DS	1		;ERROR FLAG
TXAI:	DS	2		;INPUT BUFFER POINTER

	IF	FASTF
;FSP:	EQU	0FF00H		;FAST STACK POINTER
;FVTAB: EQU	FSP+2		;FAST VARIABLES AREA
;FSTACK:EQU	FSP+2+26*2	;FAST STACK
;FASTFLG:EQU	FSP+2+26*2+2*10	;FAST FLAG - SET AFTER A FAST EXPRESSION

FSP:	DS	2		;FAST STACK POINTER
FVTAB: 	DS	26*2		;FAST VARIABLES AREA
FSTACK:	DS	20		;FAST STACK
FASTFLG:DS	1		;FAST FLAG - SET AFTER A FAST EXPRESSION
DOADR:	DS	2		;RETURN ADDRESS FOR DO/WHILE
	ENDIF

;	'SYS' STORAGE

STSYS:	DS	50		;SYS STORAGE FOR KEEPING CONFIGURATION
STSYSF:	DS	1		;SYS STORAGE FLAG - IF NOT 0 SYS STOR IS VALID
TXASYS:	DS	2		;TXA FOR STSYS

FNAME:	DS	2		;ADDRESS OF THE FILENAME TO PASS TO DRIVER
MIDDLE:	DS	1		;FLAG 'MIDDLE OF A STATEMENT' (SEE INTMON)
SPECRET:DS	1		;FLAG 'SPECIAL RET' (SEE 'RETURN')

MMTK:	DS	1		;TIME CONSTANT USED BY MMT OSC
FREQ:	DS	1		;CLOCK FREQUENCY DIVIDED BY 100000
REMFLG:	DS	1		;IF <>0 NEXT 'GOSUB' WILL SKIP WHAT FOLLOWS
				;LINE NUMBER UNTILL CR

WDFUN:	DS	2		;INDIRIZZO DELLA FUNZIONE DI WATCHDOG

TEMP1:	DS	1		;TEMPORARY VAR - GENERAL USE
TEMP2:	DS	1		;TEMPORARY VAR - GENERAL USE
TEMP3:	DS	1		;TEMPORARY VAR - GENERAL USE
TEMP4:	DS	1		;TEMPORARY VAR - GENERAL USE
TEMP5:	DS	1		;TEMPORARY VAR - GENERAL USE

	 IF	USE_C
ActPt_:	 DEFS    2	;Activation record ptr = Disp_[0]; init 0
Disp_:	 DEFS    20      ;Display registers, 10 entries
ActLn_:	 DEFS    2       ;Current Line Number

HEAPORG_ DEFS	2       ;DW MEMORY  begining of heap, end of stack
HEAPEND_ DEFS   2       ;DW STACK   end of heap, init value of SP
HEAPFRE_ DEFS   2       ;DW MEMORY  starting block of free list
			;(used differently for C)
HEAPLIM_ DEFS 	2       ;DW MEMORY  current limit of allocated heap

avail_   DEFS   2 	;HEADER *avail_ = &membase_
			;ptr to free block list
membase_ DEFS 	4    	;{HEADER *next; unsigned size;}
    			;= {&membase_, 0}; head of free block list
badlist_ DEFS   1    	;char badlist_ = 0;  non-zero if list is
			;corrupted
lastp_   DEFS   2    	;char *lastp_ = NULLPTR (strtok in CSTRX)

UGFL:	 DEFS   1	;FF: empty;  otherwise: char from ungetc
	 ENDIF


POBUF:	DS	2		;POINTER TO OUTPUT PORT BUFFER
LSTDRV:	DS	1		;FLAG TO LIST DRIVERS TO CONSOLE ON OPEN
EOFA:	DS	2		;END OF FILE ADDRESS
BOFA:	DS	2		;START OF WORKSPACE ADDRESS
MEMTOP:	DS	2		;END OF WORKSPACE ADDRESS


	END

