CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol064/str.src

Text File | 1984-04-29 | 5.1 KB | 436 lines

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