Better than that Denys, here is the whole program.
$Control Post85
$Define %Version=00.12#
$Define %BufferSize=8192#
Identification Division.
Program-Id. EDITST.
Environment Division.
Configuration Section.
Source-Computer. HP979-400.
Object-Computer. HP979-400.
Special-Names.
Condition-Code Is Intrinsic-Code.
Data Division.
Working-Storage Section.
$include MACROS.SOURCE
01 filesystem-intrinsics.
05 formaldesig Pic X(024) Value Spaces.
05 foptions Pic S9(04) Comp Value %40107.
05 aoptions Pic S9(04) Comp Value %0.
05 filenum Pic S9(04) Comp Value Zero.
05 lrecnum Pic S9(09) Comp Value Zero.
01 buffers-and-pointers.
05 read-buffer Pic X(%BufferSize)
Value Spaces.
05 read-length Pic S9(04) Comp Value Zero.
05 read-index Pic S9(04) Comp Value Zero.
05 display-buffer Pic X(128) Value Spaces.
05 display-index Pic S9(04) Comp Value Zero.
01 segment-status Pic X(001) Value "N".
88 segment-finished Value "F".
88 segment-not-finished Value "N".
Procedure Division.
The-Only Section.
Display "EDITST %Version#"
* Open the edi file and load read buffer.
%GetInfo(1#)
Move GETINFO-STRING(1:GETINFO-STRING-LENGTH)
To formaldesig
Call Intrinsic "FOPEN" Using formaldesig,
foptions,
aoptions
Giving filenum
End-Call
If Intrinsic-Code <> Zero Then
%FileSysError(2#,FOPEN#,filenum#)
End-If
%Fread(3#,filenum#,read-buffer#,-%BufferSize#,read-length#)
Display "Buffer [" read-buffer(1:read-length) "]"
Compute lrecnum
= lrecnum + read-length
End-Compute
Move Zero To display-index
Move 1 To read-index
* Loop until all segments have been read and displayed.
Perform
Until FREAD-END-OF-FILE
* Loop until all bytes in current segment have been read.
Set segment-not-finished To True
Perform
Until segment-finished
Or FREAD-END-OF-FILE
Add 1 To display-index
Move read-buffer(read-index:1)
To display-buffer(display-index:1)
Add 1 To read-index
* Have we found the segment end?
If read-index <= read-length then
If read-buffer(read-index:1) = "'" Then
Set segment-finished To True
End-If
Else
Display "-- read-index > read-length "
" reloading read buffer"
Call Intrinsic "FPOINT" Using filenum,
lrecnum
End-Call
If Intrinsic-Code <> Zero Then
%FileSysError(4#,FPOINT#,filenum#)
End-If
%Fread(5#,filenum#,read-buffer#,-%BufferSize#
,read-length#)
If Not FREAD-END-OF-FILE Then
Display "Buffer [" read-buffer(1:read-length) "]"
Move 1 To read-index
Else
Display "-- end of file found"
End-If
End-If
End-Perform
* Display the current segment.
Display "Segment [" display-buffer(1:display-index) "]"
* Reset display buffer and index.
Move Spaces To display-buffer
Move Zero To display-index
* Increment read index to skip past segment terminator.
Add 1 To read-index
End-Perform
* Close the edi file.
Call Intrinsic "FCLOSE" Using filenum,
0,
0
End-Call
* Return control to the operating system.
GoBack
.Z999-ABORT.
Display Space
Display "***************************************************"
Display "* PROGRAM HAS TERMINATED IN AN ERROR STATE *"
Display "*-------------------------------------------------*"
Display " Location : " FATALGOBACK-LOCATION
Display " SubLocation : " FATALGOBACK-SUBLOCATION
Display " SubSystem : " FATALGOBACK-SUBSYSTEM
Display " Message : " FATALGOBACK-MESSAGE
Display " Intrinsic : " FATALGOBACK-INTRINSIC
Display "***************************************************"
Display Space
Stop Run
.
regards,
Robert W.Mills
Systems Development Manager
Windsong Services
(020) 8309 3604
-----Original Message-----
From: HP-3000 Systems Discussion [mailto:[log in to unmask]] On
Behalf Of Denys Beauchemin
Sent: 07 October 2005 14:56
To: [log in to unmask]
Subject: Re: [HP3000-L] FSERR 40 when calling FPOINT
Could we see the portion of code doing the FPOINT, as well as the FOPEN.
AOPTION = 0 means that you have opened it for read only, and it's NOMR,
BUF, Nolock, so that should be ok.
Denys
-----Original Message-----
From: HP-3000 Systems Discussion [mailto:[log in to unmask]] On
Behalf Of Robert Mills
Sent: Friday, October 07, 2005 6:49 AM
To: [log in to unmask]
Subject: [HP3000-L] FSERR 40 when calling FPOINT
Environment: MPE/iX 6.5 and Cobol 85
FPOINT intrinsic is returning an "OPERATION INCONSISTENT WITH ACCESS
TYPE (FSERR 40)" against a bytestream file FOPENed with FOPTION =
%40107 and AOPTION = %0.
:LISTF,2 reports:
ACCOUNT= SYSDEV GROUP= QWERTYIW
FILENAME CODE ------------LOGICAL RECORD----------- ----SPACE----
SIZE TYP EOF LIMIT R/B SECTORS #X MX
FNAC1 1B BA 4605 2147483647 1 256 1 *
:LISTF,3 reports:
FILE: FNAC1.QWERTYIW.SYSDEV
FILE CODE : 0 FOPTIONS: ASCII,BYTESTREAM,NOCCTL,STD
BLK FACTOR: 1 CREATOR : **
REC SIZE: 1(BYTES) LOCKWORD: **
BLK SIZE: 1(BYTES) SECURITY--READ : ANY
EXT SIZE: 0(SECT) WRITE : ANY
NUM REC: 4605 APPEND : ANY
NUM SEC: 256 LOCK : ANY
NUM EXT: 1 EXECUTE : ANY
MAX REC: 2147483647 **SECURITY IS ON
FLAGS : NO ACCESSORS
NUM LABELS: 0 CREATED : WED, SEP 28, 2005, 11:54 AM
MAX LABELS: 0 MODIFIED: WED, SEP 28, 2005, 11:54 AM
DISC DEV #: 14 ACCESSED: FRI, OCT 7, 2005, 12:34 PM
SEC OFFSET: 0 LABEL ADDR: **
VOLCLASS : MPEXL_SYSTEM_VOLUME_SET:DISC
What am I doing wrong?
regards,
Robert W.Mills
Systems Development Manager
Windsong Services
(020) 8309 3604
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
