Accessing User Spaces Using Pointers and APIs
The following example shows how you can use pointers to access user spaces and to chain records together.
POINTA is a program that reads customer names and addresses into a user space, and then displays the information in a list. The program assumes that the customer information exists in a file called POINTACU.
The customer address field is a variable-length field, to allow for lengthy addresses.
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
A* THIS IS THE CUSTOMER INFORMATION FILE - POINTACUST
A
A
A R FSCUST TEXT('CUSTOMER MASTER RECORD')
A FS_CUST_NO 8S00 TEXT('CUSTOMER NUMBER')
A ALIAS(FS_CUST_NUMBER)
A FS_CUST_NM 20 TEXT('CUSTOMER NAME')
A ALIAS(FS_CUST_NAME)
A FS_CUST_AD 100 TEXT('CUSTOMER ADDRESS')
A ALIAS(FS_CUST_ADDRESS)
A VARLEN 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 2
S o u r c e
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
000100 PROCESS varchar 1
1 000200 ID DIVISION.
000300* This program reads in a file of variable length records
000400* into a user space. It then shows the records on
000500* the display.
2 000600 PROGRAM-ID. pointa.
3 000700 ENVIRONMENT DIVISION.
4 000800 CONFIGURATION SECTION.
5 000900 SPECIAL-NAMES. CONSOLE IS CRT,
7 001000 CRT STATUS IS ws-crt-status. 2
8 001100 INPUT-OUTPUT SECTION.
9 001200 FILE-CONTROL.
10 001300 SELECT cust-file ASSIGN TO DATABASE-pointacu
12 001400 ORGANIZATION IS SEQUENTIAL
13 001500 FILE STATUS IS ws-file-status.
14 001600 DATA DIVISION.
15 001700 FILE SECTION.
16 001800 FD cust-file.
17 001900 01 fs-cust-record.
002000* copy in field names turning underscores to dashes
002100* and using alias names
002200 COPY DDR-ALL-FORMATS-I OF pointacu.
18 +000001 05 POINTACU-RECORD PIC X(130). <-ALL-FMTS
+000002* I-O FORMAT:FSCUST FROM FILE POINTACU OF LIBRARY CBLGUIDE <-ALL-FMTS
+000003* CUSTOMER MASTER RECORD <-ALL-FMTS
19 +000004 05 FSCUST REDEFINES POINTACU-RECORD. <-ALL-FMTS
20 +000005 06 FS-CUST-NUMBER PIC S9(8). <-ALL-FMTS
+000006* CUSTOMER NUMBER <-ALL-FMTS
21 +000007 06 FS-CUST-NAME PIC X(20). <-ALL-FMTS
+000008* CUSTOMER NAME <-ALL-FMTS
22 +000009 06 FS-CUST-ADDRESS. 3 <-ALL-FMTS
+000010* (Variable length field) <-ALL-FMTS
23 +000011 49 FS-CUST-ADDRESS-LENGTH <-ALL-FMTS
+000012 PIC S9(4) COMP-4. <-ALL-FMTS
24 +000013 49 FS-CUST-ADDRESS-DATA <-ALL-FMTS
+000014 PIC X(100). <-ALL-FMTS
+000015* CUSTOMER ADDRESS <-ALL-FMTS
25 002300 WORKING-STORAGE SECTION.
26 002400 01 ws-file-status.
27 002500 05 ws-file-status-1 PIC X.
28 002600 88 ws-file-stat-good VALUE "0".
29 002700 88 ws-file-stat-at-end VALUE "1".
30 002800 05 ws-file-status-2 PIC X.
31 002900 01 ws-crt-status. 4
32 003000 05 ws-status-1 PIC 9(2).
33 003100 88 ws-status-1-ok VALUE 0.
34 003200 88 ws-status-1-func-key VALUE 1.
35 003300 88 ws-status-1-error VALUE 9.
36 003400 05 ws-status-2 PIC 9(2).
37 003500 88 ws-func-03 VALUE 3.
38 003600 88 ws-func-07 VALUE 7.
39 003700 88 ws-func-08 VALUE 8.
40 003800 05 ws-status-3 PIC 9(2). 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 3
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
41 003900 01 ws-params. 5
42 004000 05 ws-space-ptr POINTER. 6
43 004100 05 ws-space.
44 004200 10 ws-space-name PIC X(10) VALUE "MYSPACE".
45 004300 10 ws-space-lib PIC X(10) VALUE "QTEMP".
46 004400 05 ws-attr PIC X(10) VALUE "PF".
47 004500 05 ws-init-size PIC S9(5) VALUE 32000 BINARY.
48 004600 05 ws-init-char PIC X VALUE SPACE.
49 004700 05 ws-auth PIC X(10) VALUE "*ALL".
50 004800 05 ws-text PIC X(50) VALUE
004900 "Customer Information Records".
51 005000 05 ws-replace PIC X(10) VALUE "*YES".
52 005100 05 ws-err-data. 7
53 005200 10 ws-input-l PIC S9(6) BINARY VALUE 16.
54 005300 10 ws-output-l PIC S9(6) BINARY.
55 005400 10 ws-exception-id PIC X(7).
56 005500 10 ws-reserved PIC X(1).
005600
57 005700 77 ws-accept-data PIC X VALUE SPACE.
58 005800 88 ws-acc-blank VALUE SPACE.
59 005900 88 ws-acc-create-space VALUE "Y", "y".
60 006000 88 ws-acc-use-prv-space VALUE "N", "n".
61 006100 88 ws-acc-delete-space VALUE "Y", "y".
62 006200 88 ws-acc-save-space VALUE "N", "n".
006300
63 006400 77 ws-prog-indicator PIC X VALUE "G".
64 006500 88 ws-prog-continue VALUE "G".
65 006600 88 ws-prog-end VALUE "C".
66 006700 88 ws-prog-loop VALUE "L".
006800
67 006900 77 ws-line PIC 99.
007000* error message line
68 007100 77 ws-error-msg PIC X(50) VALUE SPACES.
007200* more address information indicator
69 007300 77 ws-plus PIC X.
007400* length of address information to display
70 007500 77 ws-temp-size PIC 9(2).
007600
71 007700 77 ws-current-rec PIC S9(4) VALUE 1.
72 007800 77 ws-old-rec PIC S9(4) VALUE 1.
73 007900 77 ws-old-space-ptr POINTER.
008000* max number of lines to display
74 008100 77 ws-displayed-lines PIC S99 VALUE 20.
008200* line on which to start displaying records
75 008300 77 ws-start-line PIC S99 VALUE 5.
008400* variables to create new record in space
76 008500 77 ws-addr-inc PIC S9(4) PACKED-DECIMAL.
77 008600 77 ws-temp PIC S9(4) PACKED-DECIMAL.
78 008700 77 ws-temp-2 PIC S9(4) PACKED-DECIMAL.
008800* pointer to previous record
79 008900 77 ws-cust-prev-ptr POINTER VALUE NULL.
80 009000 LINKAGE SECTION.
81 009100 01 ls-header-record. 8
82 009200 05 ls-hdr-cust-ptr USAGE POINTER.
009300* number of records read in from file 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 4
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
83 009400 05 ls-record-counter PIC S9(3) BINARY.
84 009500 05 FILLER PIC X(14). 9
85 009600 01 ls-user-space. 10
86 009700 05 ls-customer-rec.
009800* pointer to previous customer record
87 009900 10 ls-cust-prev-ptr USAGE POINTER.
88 010000 10 ls-cust-rec-length PIC S9(4) BINARY.
89 010100 10 ls-cust-name PIC X(20).
90 010200 10 ls-cust-number PIC S9(8).
010300* total length of this record including filler bytes
010400* to make sure next record on 16 byte boundary
91 010500 10 ls-cust-address-length PIC S9(4) BINARY.
92 010600 05 ls-cust-address-data PIC X(116).
010700
010800* Size of ls-user-space is 16 more than actually needed.
010900* This allows the start address of the next record
011000* to be established without exceeding the declared size.
011100* The size is 16 bigger to allow for pointer alignment.
011200
93 011300 PROCEDURE DIVISION.
011400* note no need for "USING" entry on PROC... DIV.
94 011500 DECLARATIVES.
011600 cust-file-para SECTION.
011700 USE AFTER ERROR PROCEDURE ON cust-file.
011800 cust-file-para-2.
95 011900 MOVE "Error XX on file pointacu" TO ws-error-msg.
96 012000 MOVE ws-file-status TO ws-error-msg(7:2).
012100 END DECLARATIVES.
012200
012300 main-program section.
012400 mainline.
012500* keep reading initial display until entered data correct
97 012600 SET ws-prog-loop TO TRUE.
98 012700 PERFORM initial-display THRU read-initial-display
012800 UNTIL NOT ws-prog-loop.
012900* if want to continue with program and want to create
013000* customer information area, fill the space with
013100* records from the customer file
99 013200 IF ws-prog-continue AND
013300 ws-acc-create-space THEN
100 013400 PERFORM read-customer-file
101 013500 MOVE 1 TO ws-current-rec
013600* set ptr to header record
102 013700 SET ADDRESS OF ls-header-record TO ws-space-ptr
013800* set to first customer record in space
103 013900 SET ADDRESS OF ls-user-space TO ls-hdr-cust-ptr
014000 END-IF.
104 014100 IF ws-prog-continue THEN
105 014200 PERFORM main-loop UNTIL ws-prog-end
014300 END-IF.
014400 end-program.
106 014500 PERFORM clean-up.
107 014600 STOP RUN.
014700
014800 initial-display. 11 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 5
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
108 014900 DISPLAY "Create Customer Information Area" AT 0118 WITH
015000 BLANK SCREEN REVERSE-VIDEO
015100 "Create customer information area (Y/N)=> <="
015200 AT 1015
015300 "F3=Exit" AT 2202.
109 015400 IF ws-error-msg NOT = SPACES THEN
110 015500 DISPLAY ws-error-msg at 2302 with beep highlight
111 015600 MOVE SPACES TO ws-error-msg
015700 END-IF.
015800
015900 read-initial-display. 12
112 016000 ACCEPT ws-accept-data AT 1056 WITH REVERSE-VIDEO
016100 ON EXCEPTION
113 016200 IF ws-status-1-func-key THEN
114 016300 IF ws-func-03 THEN
115 016400 SET ws-prog-end TO TRUE
016500 ELSE
116 016600 MOVE "Invalid Function Key" TO ws-error-msg
016700 END-IF
016800 ELSE
117 016900 MOVE "Unknown Error" TO ws-error-msg
017000 END-IF
017100 NOT ON EXCEPTION
118 017200 IF ws-acc-create-space THEN
119 017300 PERFORM create-space THRU set-space-ptrs
120 017400 SET ws-prog-continue TO TRUE
017500 ELSE
121 017600 IF ws-acc-use-prv-space THEN
122 017700 PERFORM get-space
123 017800 IF ws-space-ptr = NULL
124 017900 MOVE "No Customer Information Area" TO ws-error-msg
018000 ELSE
125 018100 PERFORM set-space-ptrs
126 018200 SET ws-prog-continue TO TRUE
018300 END-IF
018400 ELSE
127 018500 MOVE "Invalid Character Entered" TO ws-error-msg
018600 END-IF
018700 END-IF
018800 END-ACCEPT.
018900
019000 create-space.
128 019100 CALL "QUSCRTUS" USING ws-space, ws-attr, ws-init-size, 13
019200 ws-init-char, ws-auth, ws-text,
019300 ws-replace, ws-err-data.
019400
019500* checks for errors in creating the space could be added here
019600
019700 get-space.
129 019800 CALL "QUSPTRUS" USING ws-space, ws-space-ptr, ws-err-data. 14
019900
020000 set-space-ptrs.
020100* set header record to beginning of space
130 020200 SET ADDRESS OF ls-header-record 15
020300 ADDRESS OF ls-user-space 16 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 6
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
020400 TO ws-space-ptr.
020500* set first customer record after header record
131 020600 SET ADDRESS OF ls-user-space TO 17
020700 ADDRESS OF ls-user-space(LENGTH OF ls-header-record 18
020800 + 1:1).
020900* save ptr to first record in header record
132 021000 SET ls-hdr-cust-ptr TO ADDRESS OF ls-user-space.
021100
021200 delete-space.
133 021300 CALL "QUSDLTUS" USING ws-space, ws-err-data. 19
021400
021500 read-customer-file.
021600* read all records from customer file and move into space
134 021700 OPEN INPUT cust-file.
135 021800 IF ws-file-stat-good THEN
136 021900 READ cust-file AT END CONTINUE
022000 END-READ
138 022100 PERFORM VARYING ls-record-counter FROM 1 BY 1
022200 UNTIL not ws-file-stat-good
139 022300 SET ls-cust-prev-ptr TO ws-cust-prev-ptr
022400* Move information from file into space
140 022500 MOVE fs-cust-name TO ls-cust-name
141 022600 MOVE fs-cust-number TO ls-cust-number
142 022700 MOVE fs-cust-address-length TO ls-cust-address-length
143 022800 MOVE fs-cust-address-data(1:fs-cust-address-length)
022900 TO ls-cust-address-data(1:ls-cust-address-length)
023000* Save ptr to current record
144 023100 SET ws-cust-prev-ptr TO ADDRESS OF ls-user-space
023200* Make sure next record on 16 byte boundary
145 023300 ADD LENGTH OF ls-customer-rec 20
023400 ls-cust-address-length TO 1 GIVING ws-addr-inc
146 023500 DIVIDE ws-addr-inc BY 16 GIVING ws-temp
023600 REMAINDER ws-temp-2
147 023700 SUBTRACT ws-temp-2 FROM 16 GIVING ws-temp
023800* Save total record length in user space
148 023900 ADD ws-addr-inc TO ws-temp GIVING ls-cust-rec-length
149 024000 SET ADDRESS OF ls-user-space
024100 TO ADDRESS OF ls-user-space(ls-cust-rec-length + 1:1)
024200* Get next record from file
150 024300 READ cust-file AT END CONTINUE
024400 END-READ
024500 END-PERFORM
024600* At the end of the loop have one more record than really
024700* have
152 024800 SUBTRACT 1 FROM ls-record-counter
024900 END-IF.
153 025000 CLOSE cust-file.
025100
025200 main-loop. 21
025300* write the records to the display until F3 entered
154 025400 DISPLAY "Customer Information" AT 0124 WITH
025500 BLANK SCREEN REVERSE-VIDEO
025600 "Cust Customer Name Customer"
025700 AT 0305
025800 " Address" 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 7
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
025900 "Number" AT 0405
026000 "F3=Exit" AT 2202.
026100* if a pending error put on the display
155 026200 IF ws-error-msg NOT = SPACES THEN
156 026300 DISPLAY ws-error-msg at 2302 with beep highlight
157 026400 MOVE SPACES TO ws-error-msg
026500 END-IF.
026600* if in the middle of the list put F7 on the display
158 026700 IF ws-current-rec > 1 THEN 22
159 026800 DISPLAY "F7=Back" AT 2240
026900 END-IF.
027000* save the current record
160 027100 MOVE ws-current-rec TO ws-old-rec.
161 027200 SET ws-old-space-ptr TO ADDRESS OF ls-user-space. 23
027300* move each record to the display
162 027400 PERFORM VARYING ws-line FROM ws-start-line BY 1
027500 UNTIL ws-line > ws-displayed-lines or
027600 ws-current-rec > ls-record-counter
027700* if address is greater than display width show "+"
163 027800 IF ls-cust-address-length > 40 THEN
164 027900 MOVE "+" TO ws-plus
165 028000 MOVE 40 TO ws-temp-size
028100 ELSE
166 028200 MOVE ls-cust-address-length TO ws-temp-size
167 028300 MOVE SPACE TO ws-plus
028400 END-IF
168 028500 DISPLAY ls-cust-number at line ws-line column 5
028600 ls-cust-name ls-cust-address-data with
028700 size ws-temp-size ws-plus at line
028800 ws-line column 78
028900* get next record in the space
169 029000 ADD 1 TO ws-current-rec
170 029100 SET ADDRESS OF ls-user-space
029200 TO ADDRESS OF ls-user-space
029300 (ls-cust-rec-length + 1:1)
029400 END-PERFORM.
029500* if can go forward put F8 on the display
171 029600 IF ws-current-rec < ls-record-counter THEN 22
172 029700 DISPLAY "F8=Forward" AT 2250
029800 END-IF.
029900* check to see if continue, exit, or get next records or
030000* previous records
173 030100 SET ws-acc-blank to TRUE.
174 030200 ACCEPT ws-accept-data WITH SECURE 24
030300 ON EXCEPTION
175 030400 IF ws-status-1-func-key THEN
176 030500 IF ws-func-03 THEN
177 030600 SET ws-prog-end TO TRUE
030700 ELSE
178 030800 IF ws-func-07 THEN
179 030900 PERFORM back-screen
031000 ELSE
180 031100 IF ws-func-08 THEN
181 031200 PERFORM forward-screen
031300 ELSE 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 8
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
182 031400 MOVE "Invalid Function Key" TO ws-error-msg
183 031500 MOVE ws-old-rec TO ws-current-rec
184 031600 SET ADDRESS OF ls-user-space TO ws-old-space-ptr
031700 END-IF
031800 END-IF
031900 ELSE
185 032000 MOVE "Unknown Error" TO ws-error-msg
186 032100 MOVE ws-old-rec TO ws-current-rec
187 032200 SET ADDRESS OF ls-user-space TO ws-old-space-ptr
032300 END-IF
032400 NOT ON EXCEPTION
188 032500 MOVE ws-old-rec TO ws-current-rec
189 032600 SET ADDRESS OF ls-user-space TO ws-old-space-ptr
032700 END-ACCEPT.
032800
032900 clean-up.
033000* do clean up for program
033100* keep reading end display until entered data correct
190 033200 SET ws-prog-loop to TRUE.
191 033300 SET ws-acc-blank to TRUE.
192 033400 PERFORM final-display THRU read-final-display 25
033500 UNTIL NOT ws-prog-loop.
033600
033700 final-display.
193 033800 DISPLAY "Delete Customer Information Area" AT 0118 WITH 26
033900 BLANK SCREEN REVERSE-VIDEO
034000 "Delete customer information area (Y/N)=> <="
034100 AT 1015
034200 "F3=Exit" AT 2202.
194 034300 IF ws-error-msg NOT = SPACES THEN
195 034400 DISPLAY ws-error-msg at 2302 with beep highlight
196 034500 MOVE SPACES TO ws-error-msg
034600 END-IF.
034700
034800 read-final-display.
197 034900 ACCEPT ws-accept-data AT 1056 WITH REVERSE-VIDEO
035000 ON EXCEPTION
198 035100 IF ws-status-1-func-key THEN
199 035200 IF ws-func-03 THEN
200 035300 SET ws-prog-end TO TRUE
035400 ELSE
201 035500 MOVE "Invalid Function Key" TO ws-error-msg
035600 END-IF
035700 ELSE
202 035800 MOVE "Unknown Error" TO ws-error-msg
035900 END-IF
036000 NOT ON EXCEPTION
203 036100 IF ws-acc-delete-space THEN
204 036200 PERFORM delete-space
205 036300 SET ws-prog-continue TO TRUE
036400 ELSE
206 036500 IF ws-acc-save-space THEN
207 036600 SET ws-prog-continue TO TRUE
036700 ELSE
208 036800 MOVE "Invalid Character Entered" TO ws-error-msg 5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/POINTA ISERIES1 06/02/15 13:43:25 Page 9
STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE
036900 END-IF
037000 END-IF
037100 END-ACCEPT.
037200
037300 back-screen. 27
209 037400 IF ws-old-rec <= 1 THEN
210 037500 MOVE "Top of customer records" TO ws-error-msg
211 037600 MOVE ws-old-rec TO ws-current-rec 28
212 037700 SET ADDRESS OF ls-user-space TO ws-old-space-ptr
037800 ELSE
213 037900 MOVE ws-old-rec TO ws-current-rec 28
214 038000 SET ADDRESS OF ls-user-space TO ws-old-space-ptr
215 038100 PERFORM VARYING ws-line FROM ws-start-line BY 1
038200 UNTIL ws-line > ws-displayed-lines or
038300 ws-current-rec <= 1
038400* Back up one record at a time
216 038500 SET ws-cust-prev-ptr TO ls-cust-prev-ptr 29
217 038600 SET ADDRESS OF ls-user-space TO ws-cust-prev-ptr
218 038700 SUBTRACT 1 FROM ws-current-rec
038800 END-PERFORM
038900 END-IF.
039000
039100 forward-screen. 30
039200* if current record greater or equal to the max records
039300* print error, have reached max records
219 039400 IF ws-current-rec >= ls-record-counter
220 039500 MOVE "No more customer records" TO ws-error-msg
221 039600 MOVE ws-old-rec TO ws-current-rec
222 039700 SET ADDRESS OF ls-user-space TO ws-old-space-ptr
039800 ELSE
223 039900 MOVE ws-current-rec TO ws-old-rec
224 040000 SET ws-old-space-ptr TO ADDRESS OF ls-user-space
040100 END-IF.
040200
* * * * * E N D O F S O U R C E * * * * *- 2
- CRT STATUS IS specifies a data name into which a status value is placed after the termination of an extended ACCEPT statement. In this example, the STATUS key value is used to determine which function key was pressed.
- 3
- fs-cust-address is a variable-length field. To see meaningful names here rather than FILLER, specify *VARCHAR for the CVTOPT parameter of the CRTCBLMOD or CRTBNDCBL commands, or VARCHAR in the PROCESS statement, as shown in 1 . For more information about variable-length fields, refer to Declaring Data Items Using SAA Data Types.
- 4
- CRT STATUS as mentioned in 2 is defined here.
- 5
- The ws-params structure contains the parameters used when calling the APIs to access user spaces.
- 6
- ws-space-ptr defines a pointer data item set by the API QUSPTRUS. This points to the beginning of the user space, and is used to set the addresses of items in the Linkage Section.
- 7
- ws-err-data is the structure for the error parameter for the user space APIs. Note that the ws-input-l is zero, meaning that any exceptions are signalled to the program, and not passed in the error code parameter. For more information on error code parameters, refer to the CL and APIs section of the Programming category in the IBM i Information Center at this Web site -http://www.ibm.com/systems/i/infocenter/.
- 8
- The first data structure (ls-header-record) to be defined in the user space.
- 9
- FILLER is used to maintain pointer alignment, because it makes Is-header-record a multiple of 16 bytes long.
- 10
- The second data structure (ls-user-space) to be defined in the user space.
- 11
- initial-display shows the Create Customer Information Area display.
- 12
- read-initial-display reads the first display, and determines if the user chooses to continue or end the program. If the user continues the program by pressing Enter, then the program checks ws-accept-data to see if the customer information area is to be created.
- 13
- QUSCRTUS is an API used to create user spaces.
- 14
- QUSPTRUS is an API used to return a pointer to the beginning of a user space.
- 15
- Maps the first data structure (ls-header-record) over the beginning of the user space.
- 16
- Maps the second data structure (ls-user-space) over the beginning of the user space.
- 17
- Uses ADDRESS OF special register
- 18
- Uses ADDRESS OF, not the ADDRESS OF special register, because it is reference modified.
- 19
- QUSDLTUS is an API used to delete a user space.
- 20
- The following four arithmetic statements calculate the total length of each record, and ensure that each record is a multiple of 16 bytes in length.
- 21
- main-loop puts up the Customer Information display.
- 22
- These statements determine if the program should display function keys F7 and F8.
- 23
- Saves a pointer to the first customer record on the display.
- 24
- This ACCEPT statement waits for input from the Customer Information display. Based on the function key pressed, it calls the appropriate paragraph to display the next set of records (forward-screen), or the previous set of records (back-screen), or sets an indicator to end the routine if F3 is pressed.
- 25
- The clean up routine displays the Delete Customer Information Area display until an appropriate key is pressed.
- 26
- This statement puts up the Delete Customer Information Area display.
- 27
- Each record contains a pointer to the previous customer record.
The ADDRESS OF special register points to the current customer record.
By changing the ADDRESS OF special register, the current customer
record is changed.
back-screen moves the current record pointer backward one record at a time 29 , by moving the pointer to the previous customer record into the pointer to the current customer record (ADDRESS OF). Before moving backward one record at a time, the program sets the current customer record to the first record currently displayed 28 .
- 30
- forward-screen sets ws-old-space-ptr (which
points to the first record in the display) to point to the current
record (which is after the last record displayed.)
A user space always begins on a 16-byte boundary, so the method illustrated here ensures that all records are aligned. ls-cust-rec-length is also used to chain the records together.
When you run POINTA, you see the following displays:
CMDSTR Start Commands
Select one of the following:
Commands
1. Start QSH QSH
2. Start RPC Binder Daemon RPCBIND
4. Start AppDict Services/400 STRADS
7. Start AFP Utilities STRAFPU
8. Start Advanced Print Function STRAPF
10. Start BEST/1 Planner STRBEST
11. Start BGU STRBGU
12. Start Calendar Service STRCALSRV
13. Start COBOL Debug STRCBLDBG
14. Start CICS/400 STRCICS
More...
Selection or command
===>call pointa
F3=Exit F4=Prompt F9=Retrieve F12=Cancel F16=Major menu
(C) COPYRIGHT IBM CORP. 1980, 1998.
Output file POINTSCREE created in library HORNER. + Create Customer Information Area
Create customer information area (Y/N)=> y <=
F3=Exit
Customer Information
Cust Customer Name Customer Address
Number
00000001 Bakery Unlimited 30 Bake Way, North York
00000002 Window World 150 Eglinton Ave E., North York, Ontario
00000003 Jons Clothes 101 Park St, North Bay, Ontario, Canada
00000004 Pizza World 254 Main Street, Toronto, Ontario +
00000005 Marv's Auto Body 9 George St, Peterborough, Ontario, Cana +
00000006 Jack's Snacks 23 North St, Timmins, Ontario, Canada
00000007 Video World 14 Robson St, Vancouver, B.C, Canada
00000008 Pat's Daycare 8 Kingston Rd, Pickering, Ontario, Canad +
00000009 Mary's Pies 3 Front St, Toronto, Ontario, Canada
00000010 Carol's Fashions 19 Spark St, Ottawa, Ontario, Canada
00000011 Grey Optical 5 Lundy's Lane, Niagara Falls, Ont. Cana +
00000012 Fred's Forage 33 Dufferin St, Toronto, Ontario, Canada +
00000013 Dave's Trucking 15 Water St, Guelph, Ontario, Canada
00000014 Doug's Music 101 Queen St. Toronto, Ontario, Canada +
00000015 Anytime Copiers 300 Warden Ave, Scarborough, Ontario, Ca +
00000016 Rosa's Ribs 440 Avenue Rd, Toronto, Ontario, Canada
F3=Exit F8=Forward Customer Information
Cust Customer Name Customer Address
Number
00000017 Picture It 33 Kingston Rd, Ajax, Ontario, Canada
00000018 Paula's Flowers 144 Pape Ave, Toronto, Ontario, Canada
00000019 Mom's Diapers 101 Ford St, Toronto, Ontario, Canada
00000020 Chez Francois 1202 Rue Ste Anne, Montreal, PQ, Canada
00000021 Vetements de Louise 892 Rue Sherbrooke, Montreal E, PQ, Cana +
00000022 Good Eats 355 Lake St, Port Hope, Ontario, Canada
F3=Exit F7=Back
Customer Information
Cust Customer Name Customer Address
Number
00000001 Bakery Unlimited 30 Bake Way, North York
00000002 Window World 150 Eglinton Ave E., North York, Ontario
00000003 Jons Clothes 101 Park St, North Bay, Ontario, Canada
00000004 Pizza World 254 Main Street, Toronto, Ontario +
00000005 Marv's Auto Body 9 George St, Peterborough, Ontario, Cana +
00000006 Jack's Snacks 23 North St, Timmins, Ontario, Canada
00000007 Video World 14 Robson St, Vancouver, B.C, Canada
00000008 Pat's Daycare 8 Kingston Rd, Pickering, Ontario, Canad +
00000009 Mary's Pies 3 Front St, Toronto, Ontario, Canada
00000010 Carol's Fashions 19 Spark St, Ottawa, Ontario, Canada
00000011 Grey Optical 5 Lundy's Lane, Niagara Falls, Ont. Cana +
00000012 Fred's Forage 33 Dufferin St, Toronto, Ontario, Canada +
00000013 Dave's Trucking 15 Water St, Guelph, Ontario, Canada
00000014 Doug's Music 101 Queen St. Toronto, Ontario, Canada +
00000015 Anytime Copiers 300 Warden Ave, Scarborough, Ontario, Ca +
00000016 Rosa's Ribs 440 Avenue Rd, Toronto, Ontario, Canada
F3=Exit F8=Forward Delete Customer Information Area
Delete customer information area (Y/N)=> y <=
F3=Exit
CMDSTR Start Commands
Select one of the following:
Commands
1. Start QSH QSH
2. Start RPC Binder Daemon RPCBIND
4. Start AppDict Services/400 STRADS
7. Start AFP Utilities STRAFPU
8. Start Advanced Print Function STRAPF
10. Start BEST/1 Planner STRBEST
11. Start BGU STRBGU
12. Start Calendar Service STRCALSRV
13. Start COBOL Debug STRCBLDBG
14. Start CICS/400 STRCICS
More...
Selection or command
===> endcpyscn
F3=Exit F4=Prompt F9=Retrieve F12=Cancel F16=Major menu
(C) COPYRIGHT IBM CORP. 1980, 1998.