From: IdrEASY [IdrEASY@bigfoot.com]
Sent: Wednesday, May 08, 2002 3:59 AM
To: Info-VAX@Mvb.Saic.Com
Subject: Read_verify

Hi!

I will be thankful if somebody modify this code for Alpha.
---------------------------------------------------------------------

        .TITLE READ_VERIFY - Read Verify Coding Example
        .IDENT  'V05-000'

        .SBTTL  DECLARATIONS
        .DISABLE        GLOBAL

;
; Declare the external system routines and MACRO libraries.
;
        .EXTERNAL       LIB$GET_EF
        .EXTERNAL       SCR$ERASE_PAGE

        .LIBRARY        'SYS$LIBRARY:LIB.MLB'
        .LIBRARY        'SYS$LIBRARY:STARLET.MLB'
;
; Include files:
;
        $IODEF
        $TRMDEF
;
; Macros:
;
.MACRO ITEM LEN=0,CODE,VALUE
        .WORD   LEN
        .WORD   TRM$_'CODE'
        .LONG   VALUE
        .LONG   0
.ENDM ITEM

;
; Equated symbols:
;
INBUF_LEN = 20
ESC = ^X1B

;
; Own storage:
;
; Build item lists for the read verify QIO
;

;
; Right-justified field
;
R_ITEM_LIST:
        ITEM    CODE    = MODIFIERS, -
                VALUE   = TRM$M_TM_R_JUST       ; Right justify

        ITEM    CODE    = EDITMODE, -
                VALUE   = TRM$K_EM_RDVERIFY     ; Enable read verify

        ITEM    CODE    = PROMPT, -
                VALUE   = R_PROMPT_ADDR, -
                LEN     = R_PROMPT_LEN          ; Set up prompt

        ITEM    CODE    = INISTRNG, -
                VALUE   = R_INISTR_ADDR, -
                LEN     = R_INISTR_LEN          ; Set up initial string

        ITEM    CODE    = INIOFFSET, -
                VALUE   = R_INISTR_LEN

        ITEM    CODE    = PICSTRNG, -
                VALUE   = R_PICSTR_ADDR, -
                LEN     = R_PICSTR_LEN          ; Set up picture string

        ITEM    CODE    = FILLCHR, -
                VALUE   = <^A/* />            ; clear = *, fill = space

R_ITEM_LIST_LEN = .-R_ITEM_LIST

R_PROMPT_ADDR:
        .ASCII  <ESC>/[12;12H$/
R_PROMPT_LEN = .-R_PROMPT_ADDR

R_INISTR_ADDR:
        .ASCII  /   ,   /
R_INISTR_LEN = .-R_INISTR_ADDR

MASK = TRM$M_CV_NUMERIC!TRM$M_CV_NUMPUNC

R_PICSTR_ADDR:
        .BYTE   MASK
        .BYTE   MASK
        .BYTE   MASK
        .BYTE   0               ; Marker character
        .BYTE   MASK
        .BYTE   MASK
        .BYTE   MASK
R_PICSTR_LEN = .-R_PICSTR_ADDR
;
; Left-justified field
;
L_ITEM_LIST:
        ITEM    CODE    = MODIFIERS, -
                VALUE   = TRM$M_TM_CVTLOW!TRM$M_TM_AUTO_TAB
                                                ; Upcase input and
                                                ; complete on field full

        ITEM    CODE    = EDITMODE, -
                VALUE   = TRM$K_EM_RDVERIFY     ; Enable read verify

        ITEM    CODE    = PROMPT, -
                VALUE   = L_PROMPT_ADDR, -
                LEN     = L_PROMPT_LEN          ; Set up prompt

        ITEM    CODE    = INISTRNG, -
                VALUE   = L_INISTR_ADDR, -
                LEN     = L_INISTR_LEN          ; Set up initial string

        ITEM    CODE    = INIOFFSET, -
                VALUE   = 0

        ITEM    CODE    = PICSTRNG, -
                VALUE   = L_PICSTR_ADDR, -
                LEN     = L_PICSTR_LEN          ; Set up picture string

        ITEM    CODE    = FILLCHR, -
                VALUE   = <^A/* />              ; clear = *, fill = space

L_ITEM_LIST_LEN = .-L_ITEM_LIST

L_PROMPT_ADDR:
        .ASCII  <ESC>/[13;12H Enter Date: /
L_PROMPT_LEN = .-L_PROMPT_ADDR

L_INISTR_ADDR:
        .ASCII  /  -   -  /
L_INISTR_LEN = .-L_INISTR_ADDR

MASK1 = TRM$M_CV_NUMERIC
MASK2 = TRM$M_CV_UPPER!TRM$M_CV_LOWER

L_PICSTR_ADDR:
        .BYTE   MASK1
        .BYTE   MASK1
        .BYTE   0               ; Marker character
        .BYTE   MASK2
        .BYTE   MASK2
        .BYTE   MASK2
        .BYTE   0               ; marker character
        .BYTE   MASK1
        .BYTE   MASK1
L_PICSTR_LEN = .-L_PICSTR_ADDR

IN_IOSB:        .BLKL   2
TT_CHAN:        .BLKW   1
INBUF:          .BLKB   INBUF_LEN
SYSINPUT:       .ASCID  /SYS$INPUT/
SYNC_EFN:       .BLKL   1

        .PAGE

        .ENTRY  READ_VERIFY     ^M < >

;
; Get the required event flags.
;

        PUSHAL  SYNC_EFN
        CALLS   # 1, G^ LIB$GET_EF
        BLBC    R0, ERROR                       ; Error - branch
;
; Assign the channel to SYS$INPUT
;

        $ASSIGN_S -
                CHAN = TT_CHAN -
                DEVNAM = SYSINPUT               ; SYS$INPUT
        BLBC    R0, ERROR                       ; Branch on error

;
; Clear the screen
;

        CLRQ    -(SP)
        CALLS   #2, G^ SCR$ERASE_PAGE
        BLBC    R0, ERROR

;
; Do the right-justified read operation
;

        PUSHL   #R_ITEM_LIST_LEN
        PUSHAB  R_ITEM_LIST
        CALLS   #2, DO_READ
        BLBC    R0, ERROR

;
; Do the left-justified read operation
;

        PUSHL   #L_ITEM_LIST_LEN
        PUSHAB  L_ITEM_LIST
        CALLS   #2, DO_READ
        BLBC    R0, ERROR

ERROR:
        RET

        .PAGE
;++
;
; DO_READ - do the actual QIO
;
; Inputs:
;
;       4(AP)   the address of the itemlist
;       8(AP)   the length of the itemlist
;
;--

        .ENTRY  DO_READ, ^M<>

        $QIOW_S EFN=SYNC_EFN, -
                CHAN = TT_CHAN, -
                FUNC = #<IO$_READVBLK!IO$M_EXTEND>, -
                IOSB = IN_IOSB, -
                p1 = inbuf, -
                p2 = #inbuf_len, -
                p5 = 4(AP), -
                P6 = 8(AP)
        BLBC    R0, 10$                 ; QIO error - branch
        MOVZWL  IN_IOSB, R0             ; Get the terminal driver status.
        BLBC    R0, 10$                 ; Terminal driver error - branch

;  Handle the input...

10$:
        RET

        .END READ_VERIFY