C	SET	          0
M	SET	          0
F	SET	          0
;TYPE
;$STRING0 = STRING 0;
;$STRING80= STRING 80;
;$STRING255 = STRING 255;
; 
;VAR
;NUMBER:REAL;
;DATA:$STRING80;
;
;PROCEDURE SETLENGTH(VARX:$STRING0;Y:INTEGER);EXTERNAL;
	EXTD	L156,SETLENGT
;FUNCTION LENGTH(X:$STRING255):INTEGER;EXTERNAL;
	EXTD	L157,LENGTH  
;
;{function to convert a string "str" to a real number...
;corresponds roughly to the VAL$ statement in BASIC}
;
;FUNCTION STRTOREAL (STR:$STRING80):REAL;
;LABEL 1;
;
;VAR
;DECVAL,SIGN,VAL:REAL;
;DECIMAL,ERROR:BOOLEAN;
;L,I,LEN:INTEGER;
;
;BEGIN
L158
	NAME STRTOREAL
	ENTRY STRTOREAL
STRTOREAL:
	ENTR	D,2,20
;VAL:=0;
	STMT	D,1
	CVTF	A,0
	LXI	H,3
	DADD	S
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-16
	DADD	B
	XCHG
	LXI	B,4
	LDDR
	POP	H
	POP	H
;DECVAL:=0;
	STMT	D,2
	CVTF	A,0
	LXI	H,3
	DADD	S
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-8
	DADD	B
	XCHG
	LXI	B,4
	LDDR
	POP	H
	POP	H
;LEN:=LENGTH(STR);
	STMT	D,3
	PUSH	IX
	POP	H
	LXI	B,88
	DADD	B
	SPSH	S,255
	CALL	L157
	STMT	M,3
	MOV	-6(IX),D
	MOV	-7(IX),E
;L:=LEN;
	STMT	D,4
	MOV	L,-7(IX)
	MOV	H,-6(IX)
	MOV	-4(IX),H
	MOV	-5(IX),L
;ERROR:=FALSE;
	STMT	D,5
	MOV	-1(IX),A
;DECIMAL:=FALSE;
	STMT	D,6
	MOV	0(IX),A
;I:=1;
	STMT	D,7
	MOV	-2(IX),A
	MVI	-3(IX),1
;SIGN:=1.0;
	STMT	D,8
	LXI	H,320
	MOV	D,A
	MOV	E,A
	PUSH	H
	PUSH	D
	LXI	H,3
	DADD	S
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-12
	DADD	B
	XCHG
	LXI	B,4
	LDDR
	POP	H
	POP	H
;
;IF LEN = 0 THEN 
	STMT	D,9
	MOV	L,-7(IX)
	MOV	H,-6(IX)
	MOV	D,A
	MOV	E,A
	DSB1	D,0
;	BEGIN
	JNZ	L215
	STMT	D,10
;	ERROR:=TRUE;
	STMT	D,11
	MVI	-1(IX),1
;	GOTO 1;
	STMT	D,12
	CTRL	M,12
	JMP	L159
;	END;
	STMT	D,13
L215
;
;WHILE (DECIMAL = FALSE) AND (I < LEN + 1) DO
	STMT	D,14
L236
	MOV	H,A
	MOV	L,0(IX)
	MOV	A,L
	CMPI	D,0
	MOV	A,H
	JNZ	L239
	MOV	L,-3(IX)
	MOV	H,-2(IX)
	MOV	E,-7(IX)
	MOV	D,-6(IX)
	INX	D
	LESS	D,0
;BEGIN
	JNC	L235
	STMT	D,15
;
;	CASE STR[I] OF
	STMT	D,16
	MOV	L,-3(IX)
	MOV	H,-2(IX)
	RCHK	H,1,80
	XCHG
	LXI	H,88
	ADDR	IX
;
;	 '-' : SIGN:=-1.0; 
	MOV	D,A
	MOV	E,M
	MOV	A,E
	CMPI	D,45
	JNZ	L270
L272
	XRA	A
	STMT	D,17
	LXI	H,448
	MOV	D,A
	MOV	E,A
	PUSH	H
	PUSH	D
	LXI	H,3
	DADD	S
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-12
	DADD	B
	XCHG
	LXI	B,4
	LDDR
	POP	H
	POP	H
;	 '.' : DECIMAL:=TRUE;
	JMP	L271
L270
	CMPI	D,46
	JNZ	L285
L286
	XRA	A
	STMT	D,18
	MVI	0(IX),1
;
;	'0','1','2','3','4','5','6','7','8','9':
	JMP	L271
L285
	CMPI	D,48
	JRZ	L300
	CMPI	D,49
	JRZ	L300
	CMPI	D,50
	JRZ	L300
	CMPI	D,51
	JRZ	L300
	CMPI	D,52
	JRZ	L300
	CMPI	D,53
	JRZ	L300
	CMPI	D,54
	JRZ	L300
	CMPI	D,55
	JRZ	L300
	CMPI	D,56
	JRZ	L300
	CMPI	D,57
	JNZ	L299
;		VAL:=(VAL * 10) + (ORD(STR[I]) - 48); {48 = ord of zero}
L300
	XRA	A
	STMT	D,19
	LXI	H,-4
	DADD	S
	SPHL
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-19
	DADD	B
	LXI	B,4
	LDIR
	CVTF	A,10
	MULT	D,-4
	MOV	L,-3(IX)
	MOV	H,-2(IX)
	RCHK	H,1,80
	XCHG
	LXI	H,88
	ADDR	IX
	MOV	D,A
	MOV	E,M
	STMT	M,19
	LXI	H,-48
	DADD	D,0
	PUSH	H
	CVTF	B
	DADD	D,-4
	LXI	H,3
	DADD	S
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-16
	DADD	B
	XCHG
	LXI	B,4
	LDDR
	POP	H
	POP	H
;       END; {OF CASE}
L299
	XRA	A
L271
;
;I:=I+1;
	STMT	D,20
	MOV	L,-3(IX)
	MOV	H,-2(IX)
	INX	H
	MOV	-2(IX),H
	MOV	-3(IX),L
;
;END; {of while}
	STMT	D,21
	CTRL	M,21
	JMP	L236
L235
L238	EQU	L235
L239	EQU	L238
;
;WHILE (DECIMAL = TRUE) AND (L > I-1 ) DO  {i-1 because of last while loop}
	STMT	D,22
L401
	MOV	H,A
	MOV	L,0(IX)
	MOV	A,L
	CMPI	D,1
	MOV	A,H
	JNZ	L404
	MOV	L,-5(IX)
	MOV	H,-4(IX)
	MOV	E,-3(IX)
	MOV	D,-2(IX)
	DCX	D
	GRET	D,0
;	BEGIN	
	JNC	L400
	STMT	D,23
;		IF STR[L] IN ['0'..'9'] THEN
	STMT	D,24
	MOV	L,-5(IX)
	MOV	H,-4(IX)
	RCHK	H,1,80
	XCHG
	LXI	H,88
	ADDR	IX
	MOV	D,A
	MOV	E,M
	PUSH	D
	CSET	D,0
	LXI	H,57
	LXI	D,48
	CSET	D,2
	MEMB
;			DECVAL:=(DECVAL * 0.1) + ((ORD(STR[L]) - 48) * 0.1);
	JNC	L422
	STMT	D,25
	LXI	H,-4
	DADD	S
	SPHL
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-11
	DADD	B
	LXI	B,4
	LDIR
	LXI	H,-666
	LXI	D,26214
	PUSH	H
	PUSH	D
	MULT	D,-4
	MOV	L,-5(IX)
	MOV	H,-4(IX)
	RCHK	H,1,80
	XCHG
	LXI	H,88
	ADDR	IX
	MOV	D,A
	MOV	E,M
	STMT	M,25
	LXI	H,-48
	DADD	D,0
	PUSH	H
	LXI	H,-666
	LXI	D,26214
	PUSH	H
	PUSH	D
	CVTF	C
	MULT	D,-4
	DADD	D,-4
	LXI	H,3
	DADD	S
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-8
	DADD	B
	XCHG
	LXI	B,4
	LDDR
	POP	H
	POP	H
L422
;		L:=L-1;
	STMT	D,26
	MOV	L,-5(IX)
	MOV	H,-4(IX)
	DCX	H
	MOV	-4(IX),H
	MOV	-5(IX),L
;	END;
	STMT	D,27
	CTRL	M,27
	JMP	L401
L400
L403	EQU	L400
L404	EQU	L403
;
;
;1: { Exit immediately upon detection of a fatal error.}
	STMT	D,28
L159
;
;STRTOREAL:=SIGN * (DECVAL + VAL);
	STMT	D,29
	LXI	H,-4
	DADD	S
	SPHL
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-15
	DADD	B
	LXI	B,4
	LDIR
	LXI	H,-4
	DADD	S
	SPHL
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-11
	DADD	B
	LXI	B,4
	LDIR
	LXI	H,-4
	DADD	S
	SPHL
	XCHG
	PUSH	IX
	POP	H
	LXI	B,-19
	DADD	B
	LXI	B,4
	LDIR
	DADD	D,-4
	MULT	D,-4
	LXI	H,3
	DADD	S
	XCHG
	PUSH	IX
	POP	H
	LXI	B,92
	DADD	B
	XCHG
	LXI	B,4
	LDDR
	POP	H
	POP	H
;END; {OF PROCEDURE}
	STMT	D,30
	EXIT	D,81
