vplus/VPUTBUFFER.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
60
61
62
63
64
>>source format free.
*>******************************************************************
*>*                      V P U T B U F F E R                       *
*>******************************************************************
 IDENTIFICATION DIVISION.
 PROGRAM-ID. VPUTBUFFER.
 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 Authstart    PIC S9(4) COMP-5 VALUE 0.
 01 Ipstart      PIC S9(4) COMP-5 VALUE 0.
 01 DebugBUF     pic x(256)  VALUE SPACES.

*>*########################################################
 LINKAGE SECTION.
    COPY "vplus/COMAREA".
    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-VPUTBUFFER.

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

     Compute MYBUFLEN = function length (Buffer).
     If  Dbuflen < 1
      Go To VPUTBUFFER-RETURN.

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

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

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

     If mylen > MYBUFLEN
      Move MYBUFLEN To mylen.

     Move Buffer(1:mylen) To MM-CD-DATABUFFER(1:mylen).

     Compute Authstart = AF-AppBuf-Len + 1.
     Compute Ipstart = AF-AppBuf-Len + 49.

     MOVE MM-CD-DATABUFFER(1:mylen) TO LAST-BUFFER(1:mylen).
*>-----------------------------------------------------------
 VPUTBUFFER-RETURN.
     Goback.