view release on metacpan or  search on metacpan

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

        or 0x20                 ; make lowercase - set bit 5.
        pop hl                  ; restore pointer to 2nd character.
        call L_FIRST            ; routine L-FIRST puts A in first character.
                                ; and returns with HL holding
                                ; new E_LINE-1  the $80 vars end-marker.

;; L-NUMERIC
L_NUMERIC:
        push hl                 ; save the pointer.

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

        rst 0x28                ; ; FP-CALC
        defb 0x02               ; ;delete      ; delete variable value
        defb 0x38               ; ;end-calc

; DE (STKEND) points to start of value.

        pop hl                  ; restore the pointer.
        ld bc,0x0005            ; 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+0x01)         ; 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,0x0006            ; 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,(0x5C4D)          ; fetch DEST to HL.
                                ; (still set from first instruction)
        ld bc,(0x5C72)          ; fetch STRLEN to BC.
        bit 0,(iy+0x37)         ; 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 0x30                ; BC-SPACES creates room.
        push de                 ; save pointer to first new location.
        push bc                 ; and length            (*)
        ld d,h                  ; set DE to point to last location.
        ld e,l
        inc hl                  ; set HL to next location.
        ld (hl),0x20            ; 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 b,h                  ; otherwise set
        ld c,l                  ; 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
        ret z                   ; return if zero (strings only).