IBM Version 4 Testfile, Value LOW-VALUE, Oflag PIC, Oflag-Read Pic, Omode PIC, Test-Data Pic

ð1	TESTFILE.
	ð5 TEST-FILE	PIC	X(ð9)	VALUE "test.file".
	ð5 NULL-TERMINATE	PIC	X(ð1)	VALUE LOW-VALUE.
ð1	OFLAG	PIC	X(ð4)	VALUE X"ðððððð1A".
ð1	OFLAG-READ	PIC	X(ð4)	VALUE X"ððððððð1".
ð1	OMODE	PIC	X(ð4)	VALUE X"ððððð1Cð".
ð1	TEST-DATA	PIC	X(12)	VALUE "Hello World!".
ð1 SIZE-TEST-DATA		PIC S9(ð9)		BINARY VALUE 12.
ð1	FILE-DESCRIPTOR	PIC S9(ð9)		BINARY.
ð1	BYTES-READ	PIC S9(ð9)		BINARY.
ð1	BYTES-WRITTEN	PIC S9(ð9)		BINARY.
ð1	RETURN-INT	PIC S9(ð9)		BINARY.
ð1	RETURN-PTR	POINTER.

\

\Beginning of mainline

PROCEDURE DIVISION. MAIN-LINE.

OPEN OUTPUT LISTING.

\Get and print the real user id with the getuid function.

CALL "getuid" GIVING RETURN-INT.

\Check for error and report status.

\

IF RETURN-INT = -1 MOVE "Error getting real user id"

TO LIST-LINE, PERFORM ERROR-FOUND,

ELSE MOVE RETURN-INT TO USER, WRITE LIST-LINE FROM REALID.

\

\Get the current working directory and store it in BUFFER

CALL "getcwd" USING BY VALUE ADDRESS OF BUFFER,

BY VALUE LENGTH-OF-BUFFER, GIVING RETURN-PTR.

\

\Check for error and report status.

IF RETURN-PTR = NULL MOVE "Error getting real current dir"

TO LIST-LINE, PERFORM ERROR-FOUND,

ELSE MOVE BUFFER TO INITIALDIR, WRITE LIST-LINE FROM CURDIR.

\

\Create the file test.file for writing. If it does not exist,

\give the owner authority to read, write, and execute.

\

CALL "open" USING BY VALUE ADDRESS OF TESTFILE, BY VALUE OFLAG,

BY VALUE OMODE,

GIVING FILE-DESCRIPTOR.

\

\Check for error and report status.

IF FILE-DESCRIPTOR = -1 MOVE "Could not create file"

TO LIST-LINE,

B-180System API Programming V4R1