vplus/VGETBUFFER.cbl at main · cloud3000/vplus · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
>>source format free.
*>*****************************************************************
*>                       V G E T B U F F E R                      *
*>*****************************************************************
 IDENTIFICATION DIVISION.
 PROGRAM-ID. VGETBUFFER.
 AUTHOR.     MICHAEL ANDERSON.
 ENVIRONMENT DIVISION.
 DATA DIVISION.
 WORKING-STORAGE SECTION.
 01  disp-err          pic ----9.
 01  MYLEN             PIC S9(4) COMP-5.
 01  MYBUFLEN          PIC S9(4) COMP-5.
 01  GLOBAL-ADDRESS1   USAGE POINTER.
 01  DebugBUF          pic x(256)  VALUE SPACES.

*>########################################################
 LINKAGE SECTION.
    COPY "vplus/COMAREA".
 01  FORM-FILE PIC X(36).
    COPY "vplus/VPLUSMEM".
 01  BUFFER.
     02 BUFSIZ PIC X OCCURS 1 TO 2000 DEPENDING ON BUFFER-LEN.
 01  BUFFER-LEN PIC S9(4) COMP-5.
*>########################################################
 PROCEDURE DIVISION USING COMAREA BUFFER, BUFFER-LEN.
 0000-BEGIN-VGETBUFFER.

     CALL "GetPtrVplusBlock1" USING GLOBAL-ADDRESS1.
     SET ADDRESS OF VPLUSMEM TO GLOBAL-ADDRESS1.
     move LOW-VALUES TO INTR-CALLNAME
     string "VGETBUFFER "
      delimited by " " into INTR-CALLNAME.

     Compute MYBUFLEN = function length (Buffer).

     If  Dbuflen < 1
      Go To VGETBUFFER-RETURN.

     If Dbuflen > 2000
      Move -2 To cstatus
      Go To VGETBUFFER-RETURN.

     If Buffer-Len < 1
      Move -3 To cstatus
      Go To VGETBUFFER-RETURN.

     If Buffer-Len > Dbuflen
      Move Dbuflen To mylen
     Else
      Move Buffer-Len To mylen.

     If mylen > MYBUFLEN
      Move MYBUFLEN To mylen.

     Move MM-CD-DATABUFFER(1:mylen) To Buffer.
*>-----------------------------------------------------------
 VGETBUFFER-RETURN.
     Goback.