view release on metacpan or  search on metacpan

t/data/zx48_benchmark.asm  view on Meta::CPAN

;; L-NUMERIC

L_NUMERIC:
        push hl                 ; save the pointer.

; the value of variable is deleted but remains after calculator stack.

        rst $28                 ; ; FP-CALC
        defb $02                ; ;delete      ; delete variable value
        defb $38                ; ;end-calc

; DE (STKEND) points to start of value.

        pop hl                  ; restore the pointer.
        ld bc, $0005            ; start of number is five bytes before.
        and a                   ; prepare for true subtraction.
        sbc hl, bc              ; HL points to start of value.
        jr L_ENTER              ; forward to L-ENTER  ==>


; ---


; the jump was to here if the variable already existed.

;; L-EXISTS

L_EXISTS:
        bit 6, (iy+FLAGS-IY0)   ; test FLAGS - numeric or string result ?
        jr z, L_DELETE_         ; skip forward to L-DELETE$   -*->
                                ; if string result.

; A numeric variable could be simple or an array element.
; They are treated the same and the old value is overwritten.

        ld de, $0006            ; six bytes forward points to loc past value.
        add hl, de              ; add to start of number.
        jr L_NUMERIC            ; back to L-NUMERIC to overwrite value.


; ---

; -*-> the branch was here if a string existed.

;; L-DELETE$

L_DELETE_:
        ld hl, (DEST)           ; fetch DEST to HL.
                                ; (still set from first instruction)
        ld bc, (STRLEN)         ; fetch STRLEN to BC.
        bit 0, (iy+FLAGX-IY0)   ; test FLAGX - handling a complete simple
                                ; string ?
        jr nz, L_ADD_           ; forward to L-ADD$ if so.

; must be a string array or a slice in workspace.
; Note. LET a$(3 TO 6) = h$   will assign "hat " if h$ = "hat"
;                                  and    "hats" if h$ = "hatstand".
;
; This is known as Procrustean lengthening and shortening after a
; character Procrustes in Greek legend who made travellers sleep in his bed,
; cutting off their feet or stretching them so they fitted the bed perfectly.
; The bloke was hatstand and slain by Theseus.

        ld a, b                 ; test if length
        or c                    ; is zero and
        ret z                   ; return if so.

        push hl                 ; save pointer to start.

        rst $30                 ; BC-SPACES creates room.
        push de                 ; save pointer to first new location.
        push bc                 ; and length            (*)
        ld de, hl               ; set DE to point to last location.
        inc hl                  ; set HL to next location.
        ld (hl), $20            ; place a space there.
        lddr                    ; copy bytes filling with spaces.

        push hl                 ; save pointer to start.
        call STK_FETCH          ; routine STK-FETCH start to DE,
                                ; length to BC.
        pop hl                  ; restore the pointer.
        ex (sp), hl             ; (*) length to HL, pointer to stack.
        and a                   ; prepare for true subtraction.
        sbc hl, bc              ; subtract old length from new.
        add hl, bc              ; and add back.
        jr nc, L_LENGTH         ; forward if it fits to L-LENGTH.

        ld bc, hl               ; otherwise set
                                ; length to old length.
                                ; "hatstand" becomes "hats"

;; L-LENGTH

L_LENGTH:
        ex (sp), hl             ; (*) length to stack, pointer to HL.
        ex de, hl               ; pointer to DE, start of string to HL.
        ld a, b                 ; is the length zero ?
        or c
        jr z, L_IN_W_S          ; forward to L-IN-W/S if so
                                ; leaving prepared spaces.

        ldir                    ; else copy bytes overwriting some spaces.

;; L-IN-W/S

L_IN_W_S:
        pop bc                  ; pop the new length.  (*)
        pop de                  ; pop pointer to new area.
        pop hl                  ; pop pointer to variable in assignment.
                                ; and continue copying from workspace
                                ; to variables area.

; ==> branch here from  L-NUMERIC

;; L-ENTER

L_ENTER:
        ex de, hl               ; exchange pointers HL=STKEND DE=end of vars.
        ld a, b                 ; test the length
        or c                    ; and make a