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 .