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

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

        DECLARE SUB      ISpush (ival%)  'put an item on the stack
        DECLARE FUNCTION ISpop% ()       'get an item off the stack
        DECLARE FUNCTION ISfree% ()      'TRUE if any room on stack
        DECLARE FUNCTION ISavail% ()     'TRUE if anything on stack
        DECLARE SUB      ISclear ()      'clear the stack
        |
                                                                        page +
        .model medium, basic
        .data

ISP     dw      0               ; DGROUP storage for stack pointer

        .code

MaxISP  equ     255             ; determines max items in stack

IStack  dw      (MaxISP + 1) dup (-1)
                                                                        page +
Iperr:: INT     4               ; report an "Overflow" to QB/BC

ISpush          PROC ival

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

        mov     bx, ival        ; get pointer to passed value
        mov     ax, [bx]        ; hold actual value
        mov     bx, ISP         ; get the current Integer Stack Pointer
        inc     bx              ; increment it first
        cmp     bx, MaxISP      ; test against the allowed maximum depth
        ja      Iperr           ; if stack already full, Overflow Error
        mov     ISP, bx         ; otherwise, save new SP
        shl     bx, 1           ; turn SP into a word pointer
        mov     IStack[bx], ax  ; place item on Integer Stack
        ret

ISpush          ENDP

ISpop           PROC

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

        mov     bx, ISP         ; get current Integer Stack Pointer
        or      bx, bx          ; is it zero?
        jz      Iperr           ; yes, stack is empty: Overflow error
        shl     bx, 1           ; turn ISP into a word pointer
        mov     ax, IStack[bx]  ; retrieve value from stack
        dec     ISP             ; decrement ISP
        ret                     ; and return retrieved value

ISpop           ENDP
                                                                        page +
ISclear         PROC

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

        mov     ISP, 0
        ret

ISclear         ENDP

ISfree          PROC

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

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

ISfree          ENDP

ISavail         PROC

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

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

ISavail         ENDP
                                                                        page +
        end