page ,132
        title   LSTACK - Add a long-integer "stack" to BC/QB
        subttl  Copyright 1990, Editing Services Co.
        comment |

Implements a long-integer LIFO stack by adding five procedures to QB/BC:
two SUBs and three FUNCTIONs.  See LQUEUE for a FIFO stack.

        DECLARE SUB      LSpush (ival%)  'put an item on the stack
        DECLARE FUNCTION LSpop% ()       'get an item off the stack
        DECLARE FUNCTION LSfree% ()      'TRUE if any room on stack
        DECLARE FUNCTION LSavail% ()     'TRUE if anything on stack
        DECLARE SUB      LSclear ()      'clear the stack
        |
                                                                        page +
        .model medium, basic
        .data

LSP     dw      0               ; DGROUP storage for stack pointer

        .code

MaxLSP  equ     255             ; determines max items in stack

LStack  dw      (2 * (MaxLSP + 1)) dup (-1)
                                                                        page +
Iperr:: INT     4               ; report an "Overflow" to QB/BC

LSpush          PROC lval

; Accepts a long-integer value and places it onto our stack.
; Generates an Overflow Error in QB if there is no room on the stack.

        mov     bx, lval        ; get pointer to passed value
        mov     ax, [bx]        ; hold actual value
        mov     dx, 2[bx]       ; high part too
        mov     bx, LSP         ; get the current stack pointer
        inc     bx              ; increment it first
        cmp     bx, MaxLSP      ; test against the allowed maximum depth
        ja      Iperr           ; if stack already full, Overflow Error
        mov     LSP, bx         ; otherwise, save new SP
        shl     bx, 1           ; turn SP into a word pointer
        shl     bx, 1           ; then into a dword pointer
        mov     LStack[bx], ax  ; stack the low part of the item
        add     bx, 2
        mov     LStack[bx], dx  ; then the high part
        ret

LSpush          ENDP

LSpop           PROC

; Returns the most recently pushed value from our stack.
; Generates an Overflow Error if there are no values on the stack.

        mov     bx, LSP         ; get current stack pointer
        or      bx, bx          ; is it zero?
        jz      Iperr           ; yes, stack is empty: Overflow error
        shl     bx, 1           ; turn LSP into a word pointer
        shl     bx, 1           ; and then a dword pointer
        mov     ax, LStack[bx]  ; retrieve low half of value from stack
        add     bx, 2
        mov     dx, LStack[bx]  ; retrieve high part of value, too
        dec     LSP             ; decrement saved LSP
        ret                     ; and return value in DX:AX

LSpop           ENDP

LSclear         PROC

; "Clear" the stack by resetting our stack pointer to zero.

        mov     LSP, 0
        ret

LSclear         ENDP

LSfree          PROC

; Returns TRUE if there is any space left in the stack.

        xor     ax, ax          ; assume there's no room
        cmp     LSP, MaxLSP     ; set carry if room left
        sbb     ax, ax          ; adjust result to -1 if room
        ret

LSfree          ENDP

LSavail         PROC

; Returns TRUE if there are any data items on the stack

        xor     ax, ax          ; assume no items present
        cmp     ax, LSP         ; set carry if LSP non-zero
        sbb     ax, ax          ; adjust result to TRUE if stack used
        ret

LSavail         ENDP
                                                                        page +
        end