|
midrange.com
Thanks for all the quick responses! Njal, great to know your still out
there solving problems!
I've included the entire program source this time, hopefully this
clarifies some of your questions. For the record I'm not sure if this was
caused by a PTF or not. The system is at 5.2 cume 4077 with all the
latest groups. Let me know if you need more info. Thanks!
?****************************************************************
?* edit help text mercator data ab 1988 **
?****************************************************************
?*--changes----------------------------------------------------------
?*
?* 7262-99/09/27-lch-increase rrn from 3/0 to 4/0 */
?*
?* 7778-cac-00/02/10-added the h specs for the date
?*
?* 10584-pbb-02/01/17-release 3.3.0
?* -commented out FREE statement
?*
?* 11112-02/09/18-pbb-Release 3.3.0 Item=09 Line Marker=33/09
?* -Corrected problem where %error and %eof were
?* using the same indicator.
?* 10185-02/10/28-dpc-Release 3.3.0
?* -for CLOSE *ALL Handle ILE Error
?*
?* 13359-04/01/21-TJR-Release 3.3.4B
?* -Commented out *PSSR routine
?********************************************************************
?***13359 Pdoc002 UF A E K Disk Infsr(*PSSR)
FPdoc002 UF A E K Disk
F Usropn
F Infds(Infds1)
?***13359 Pdocw02 IF E K Disk Infsr(*PSSR)
FPdocw02 IF E K Disk
F Usropn
F Rename(Fdoc002:Fdocw02)
F Infds(Infds2)
FPdoc014 CF E Special Pgmname('MDOC')
F Usropn
F Plist(Iolist)
FDdoc004 CF E Workstn Infds(Infds3)
F Usropn
?***13359 Infsr(*PSSR)
F Sfile(Fmt1S:Rrn1)
F Sfile(Fmt3S:Rrn3)
?*****************************************************************
D Ar1 S 1 Dim(66)
D Anam S 1 Dim(10)
D Atxt S 1 Dim(66) Ctdata Perrcd(66)
?*****************************************************************
D Infds1 DS
D Qfile 83 102
D Qlib 93 102
D Qmbr 129 138
D Qrcds 156 159B 0
D Infds2 DS
D Zfile 83 102
D Zmbr 129 138
D Infds3 DS
D Cloc 370 371B 0
D Screen DS
D Ascn 1 1920
D Dim(24)
D Dtxt DS
D Pic 3 64
D Right DS 2
D Hex20 1 1
D Char DS 1361
D Dpromt DS 1359
D Apmt 1 1359
D Dim(1359) Ascend
D Apmtd 1 1359
D Dim(1359) Descend
D Qdata DS
D Qpic 1 5
D Qpicdt 6 66
D Apic 6 66
D Dim(61) Ascend
D Qtxt 1 66
D Qout 67 67
?
*---------------------------------------------------------------------
?* Stand Alone Fields - TOP
?
*---------------------------------------------------------------------
D A S 3 0
D B S 3 0
D Byte S 1
D C S 3 0
D Chg S 1
D Ctlfld S 1
D Curent S 15 0
D Dummy S 1
D First S 15 0
D Fldlen S 5 0
D Functn S 1
D Hlplib S 10
D I S 5 0
D In03 S 1
D In99 S 1
D J S 5 0
D K S 5 0
D Lines S 3 0
D Mode S 1
D Offset S 3 0
D Picfmt S 10
D Picpgm S 10
D Qfid S 10
D Qpid S 10
D Refout S 1
D Rrn1 S 4 0
D Rrn3 S 5 0
D Spcnam S 30
D Tbl S 10
D Tbllib S 10
D Work S 5 0
?
*---------------------------------------------------------------------
?* Stand Alone Fields - BOTTOM
?
*---------------------------------------------------------------------
?*****************************************************************
C *LIKE Define Qlid Nxtlid
C *LIKE Define Qdata Savdta
C *LIKE Define Curent Cursav
?*
C *ENTRY Plist
C Parm Qpid
C Parm Qfid
C Parm Mode
C Parm Hlplib
C Parm *IN03 In03
?*
C Iolist Plist
C Parm Ctlfld
C Parm First
C Parm Curent
C Parm Spcnam
C *IN99 Parm *OFF In99
?*****************************************************************
?* main loop
?*****************************************************************
C Open Ddoc004
?*
B001 C If Mode <> '1'
B001 C Exsr Noaut
C Else
B001CC Eval *IN73 = Mode = '1'
B001CC If Mode = '1'
B001CC Exsr Allaut
C Endif
C Endif
?*
C Move *BLANK Ctlfld
10185?* handle close error
10185?* Close *ALL
10185C Close(e) *ALL
?*
C Call 'CDOC006 '
C Parm *IN73 Dummy
C Parm *IN55 Chg
C Parm Qlib
C Parm Qmbr
?***10584 Free 'MDOC014 '
?*
C Eval *INLr = *ON
?**************************************************************
?* authority to update text
?**************************************************************
BGSR C Allaut Begsr
?*
C Z-Add 4 Curlin
cursor line
C Z-Add 4 Curcol
cursor column
C Z-Add 1 Dleftm
left margin
C Z-Add 1 Dint
indent
?*
C Open Pdoc002 74
B001 C If *IN74 = *ON
C Eval *IN73 = *OFF
C Exsr Noaut
C Goto Endupd
E001 C Endif
?*
C Exsr Initsp
init space
C Eval *IN33 = *ON
?*
C Z-Add *ZERO Curent
C Move 'N' Ctlfld
n=read next
?*
B001 C Dou *IN12 = *OFF
B002 C Dou *IN03 = *ON
?*
C Exsr Readsp
read space
C Eval *IN31 = Wtxt <> *BLANK 'copy-text'
?*
B003 C Dou *IN26 = *OFF
B003CC And *IN27 = *OFF
C Write Fmt1F
C Exfmt Fmt1C
C Cloc Div 256 Curlin
C Mvr Curcol
B004 C If *IN26 = *ON
B004 C Exsr Rollup
C Else
B004CC If *IN27 = *ON
B004CC Exsr Rolldn
C Endif
C Endif
E003 C Enddo
?*
B003 C If *IN04 = *ON
B003 C Exsr Prompt
C Else
B003CC If *IN05 = *ON
B003CC Exsr Atr
C Else
B003CC If *IN06 = *ON
B003CC Exsr Atr
C Else
B003CC If *IN07 = *ON
B003CC Exsr Atr
C Else
B003CC If *IN08 = *ON
B003CC Exsr Copy
C Else
B003CC If *IN09 = *ON
B003CC Exsr Move
C Else
B003CC If *IN11 = *ON
B003CC Exsr Move
C Else
B003CC If *IN13 = *ON
B003CC Exsr Dspscn
C Else
B003CC If *IN14 = *ON
B003CC Exsr Dsplst
C Else
B003CC Exsr Updsp
C Endif
C Endif
C Endif
C Endif
C Endif
C Endif
C Endif
C Endif
C Endif
?*
C 1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
C Move 'C' Ctlfld
c=chain
E002 C Enddo
?*
C Exsr Term
E001 C Enddo
?*
EDSR C Endupd Endsr
?**************************************************************
?* no authority. display only
?**************************************************************
BGSR C Noaut Begsr
?*
C Z-Add *ZERO Offset
C Open Pdocw02 99
C Move Zfile Qfile
C Move Zmbr Qmbr
C Qfid Chain(E) Fdocw02
C Eval *IN99 = %ERROR
33/09C If *IN99 = *OFF
C Eval *IN99 = NOT%FOUND
33/09C Endif
B001 C Dow *IN99 = *OFF
B002 C If Qout = 'D'
B002CC And Qpic <> '*PIC '
B002CC Or Qout = *BLANK
B002CC And Qpic <> '*PIC '
B003 C If Qtxt <> '*PA '
C Movel Qtxt Dtxt
C Z-Add Qlid Rrn3
C Add Offset Rrn3 72
C Write Fmt3S
X003 C Else
C Qlid Add Offset Work
C Sub 1 Work
C Div 17 Work
C Mult 17 Work
C Add 17 Work
C Work Sub Qlid Offset
E003 C Endif
X002 C Else
C Sub 1 Offset
E002 C Endif
C Qfid Reade Fdocw02
C Eval *IN99 = %EOF
E001 C Enddo
C Close Pdocw02
?*
B001 C If Rrn3 = *ZERO
C Movea Atxt Dtxt
C Z-Add 9 Rrn3 72
C Write Fmt3S
E001 C Endif
?*
C Write Fmt3F
C Exfmt Fmt3C
?*
EDSR C Endsr
?*****************************************************************
?* initialize work space
?*****************************************************************
BGSR C Initsp Begsr
?*
C Movel Qfile Spcnam
C Move Qmbr Spcnam
?*
C Move *BLANK Ctlfld
C Open Pdoc014
C First Cabgt *ZERO Einit
?*
C Move 'A' Ctlfld
C Z-Add 2 Nxtlid
C Qfid Chain(E) Fdoc002
C Eval *IN99 = %ERROR
33/09C If *IN99 = *OFF
C Eval *IN99 = NOT%FOUND
33/09C Endif
B001 C Dow *IN99 = *OFF
B002 C If Nxtlid <= Qlid
C Move Qdata Savdta
C Move *BLANK Qdata
B003 C Nxtlid Do Qlid
C Write Workfmt
E003 C Enddo
C Move Savdta Qdata
E002 C Endif
C Write Workfmt
C Qlid Add 2 Nxtlid
C Qfid Reade Fdoc002
C Eval *IN99 = %EOF
E001 C Enddo
?*
EDSR C Einit Endsr
?*****************************************************************
?* read work area
?*****************************************************************
BGSR C Readsp Begsr
?*
C Eval *IN71 = *ON
C Write Fmt1C
C Eval *IN71 = *OFF
?*
B001 ?***** 7262 do 17 rrn1 30
<<<<<< Second time through this loop the MI program fails at statement 43
>>>>>>
7262 C Do 17 Rrn1
C Read Workfmt
C Eval *IN99 = %EOF
C Write Fmt1S
C Move 'N' Ctlfld
n=read next
E001 C Enddo
?*
EDSR C Endsr
?*****************************************************************
?* update work area
?*****************************************************************
BGSR C Updsp Begsr
?*
C Move 'U' Ctlfld
C Readc Fmt1S
C Eval *IN99 = %EOF
B001 C Dow *IN99 = *OFF
C Eval *IN54 = *ON
C Write Workfmt
C Readc Fmt1S
C Eval *IN99 = %EOF
E001 C Enddo
?*
EDSR C Endsr
?*****************************************************************
?* roll-up
?*****************************************************************
BGSR C Rollup Begsr
?*
C Exsr Updsp
update space
?*
C 17 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
C Eval *IN71 = *ON
C Write Fmt1C
C Eval *IN71 = *OFF
C Move 'N' Ctlfld
n=read next
B001 C Do 17 Rrn1
C Read Workfmt
C Eval *IN98 = %EOF
C Write Fmt1S
E001 C Enddo
C Read Workfmt
C Eval *IN98 = %EOF
C Move *IN99 *IN32
C Eval *IN33 = *OFF
?*
C Z-Add 4 Curlin
?*
EDSR C Endsr
?*****************************************************************
?* roll-down
?*****************************************************************
BGSR C Rolldn Begsr
?*
C Exsr Updsp
update space
?*
C 1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
C Eval *IN71 = *ON
C Write Fmt1C
C Eval *IN71 = *OFF
C Move 'P' Ctlfld
p=read prev
B001 C Do 17 I
C 18 Sub I Rrn1
C Read Workfmt
C Eval *IN98 = %EOF
C Write Fmt1S
E001 C Enddo
C Read Workfmt
C Eval *IN98 = %EOF
C Move *IN99 *IN33
C Eval *IN32 = *OFF
?*
C Z-Add 20 Curlin
?*
EDSR C Endsr
?*****************************************************************
?* terminate program
?*****************************************************************
BGSR C Term Begsr
?*
C *IN54 Cabeq *OFF Endtrm 03
?*
C Move 'Y' Update
C Exfmt Exit
C *IN12 Cabeq *ON Endtrm
C Update Cabne 'Y' Endtrm
?*
B001 C Dou *IN99 = *ON
C Qfid Delete Fdoc002
C Eval *IN99 = NOT%FOUND
E001 C Enddo
?*
C Z-Add *ZERO Qlid
C Z-Add *ZERO Curent
C Move 'E' Ctlfld
C Read Workfmt
C Eval *IN98 = %EOF
B001 C Dow *IN99 = *OFF
C Add 1 Qlid
B002 C If Qdata <> *BLANK
C Write Fdoc002
E002 C Endif
C Read Workfmt
C Eval *IN98 = %EOF
E001 C Enddo
?*
C Eval *IN55 = *ON
?*
EDSR C Endtrm Endsr
?*****************************************************************
?* atr set attribute in text starting at cursor pos
?*****************************************************************
BGSR C Atr Begsr
?*
C Exsr Updsp
?*
B001 C If Curlin >= 4
B001CC And Curlin <= 20
B001CC And Curcol >= 4
B001CC And Curcol <= 69
?*
C Curlin Sub 3 Rrn1
C Curcol Sub 3 I
C Rrn1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
?*
C Movea Qtxt Ar1
B002 C If Ar1(I) <= *BLANK
?*
C Eval *IN54 = *ON
C Bitoff '012347' Ar1(I)
C Biton '2' Ar1(I)
B003 C If *IN05 = *ON normal
C Bitoff '56' Ar1(I)
E003 C Endif
B003 C If *IN06 = *ON hi
C Biton '6' Ar1(I)
E003 C Endif
B003 C If *IN07 = *ON ul
C Biton '5' Ar1(I)
E003 C Endif
C Movea Ar1 Qtxt
C Move 'U' Ctlfld
C Write Workfmt
?*
B003 C If Curcol < 69
?***** add 1 i
?***** ar1,i ifle *blank
C Add 1 Curcol
?***** end
E003 C Endif
?*
E002 C Endif
?*
E001 C Endif
?*
EDSR C Endsr
?*****************************************************************
?* copy line under cursor to buffer
?*****************************************************************
BGSR C Copy Begsr
?*
C Exsr Updsp
?*
B001 C If Curlin >= 4
B001CC And Curlin <= 20
C Curlin Sub 3 Rrn1
C Rrn1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
C Move Qtxt Wtxt
X001 C Else
C Move *BLANK Wtxt
E001 C Endif
?*
EDSR C Endsr
?*****************************************************************
?* insert/delete line
?*****************************************************************
BGSR C Move Begsr
?*
C Exsr Updsp
?*
B001 C If Curlin >= 4
B001CC And Curlin <= 20
?*
C Curlin Sub 3 Rrn1
B002 C If *IN09 = *ON
C Rrn1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
C Move Wtxt Qtxt
C Move 'B' Ctlfld
C Write Workfmt
C Update Fmt1S
C Eval *IN54 = *ON
E002 C Endif
B002 C If *IN11 = *ON
C Rrn1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
C Move 'D' Ctlfld
C Write Workfmt
C Update Fmt1S
C Eval *IN54 = *ON
E002 C Endif
?*
E001 C Endif
?*
EDSR C Endsr
?*****************************************************************
?* prompt
?*****************************************************************
BGSR C Prompt Begsr
?*
C Exsr Updsp
?*
C Curlin Cablt 4 Endpmt
C Curlin Cabgt 20 Endpmt
?*
C Z-Add *ZERO Dlines
C Curlin Sub 3 Rrn1
C Rrn1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
C Move 'C' Ctlfld
C Read Workfmt
C Eval *IN99 = %EOF
C Move 'N' Ctlfld
B001 C Dow Qtxt <> *BLANK
B001CC And Dlines < 99
B001CC And *IN99 = *OFF
C Add 1 Dlines
C Read Workfmt
C Eval *IN99 = %EOF
E001 C Enddo
B001 C If Dlines = *ZERO
C Z-Add 1 Dlines
E001 C Endif
?* show pre-prompt
B001 C Dou *IN81 = *OFF
C Exfmt Prompt1
C *IN12 Cabeq *ON Endpmt
E001 C Enddo
?*
C Bitoff '01234567' Hex20
C Biton '2' Hex20
C Z-Add 1 I
C Move *BLANK Dpromt
C Move 'C' Ctlfld
C Rrn1 Chain Fmt1S
C Eval *IN99 = NOT%FOUND
?*
B001 C Do Dlines Lines
C Read Workfmt
C Eval *IN98 = %EOF
C Move 'N' Ctlfld
B002 C If *IN99 = *OFF
C Movea Qtxt Apmt(I)
X002 C Else
C Movea *BLANK Apmt(I)
C Lines Sub 1 Dlines
C Goto Pmt001
E002 C Endif
?*
B002 C Dou *IN97 = *OFF
B002CC And *IN98 = *OFF
C Z-Add I J
C Z-Add I K
C *BLANK Lookup Apmtd(J) 97
C *BLANK Lookup Apmt(K) 98
B003 C If *IN97 = *ON
B003CC Or *IN98 = *ON
?*
C Move *BLANK Char
B004 C If J < K
B004CC And *IN97 = *ON
B004CC Or *IN98 = *OFF
B005 C If I > 1
C Sub 1 I
E005 C Endif
C Movea Apmt(J) Char
X004 C Else
C Movea Apmt(K) Char
E004 C Endif
C Movea Char Apmt(I)
?*
C *BLANK Lookup Apmt(I)
99
C *IN99 Cabeq *OFF Pmt001
C I Sub 1 J
B004 C If Apmt(J) >= *BLANK
C Add 1 I
E004 C Endif
E003 C Endif
E002 C Enddo
?*
B002 C If I > 1
C Sub 1 I
C Move Hex20 Apmt(I)
C Add 1 I
E002 C Endif
E001 C Enddo
?* show prompt
C Pmt001 Tag
C Exfmt Prompt2
C *IN12 Cabeq *ON Endpmt
?* insert lines
C Eval *IN54 = *ON
C Rrn1 Chain Fmt1S
rtv previous
C Eval *IN99 = NOT%FOUND rtv previous
C Move 'P' Ctlfld
.
C Read Workfmt
.
C Eval *IN99 = %EOF .
B001 C If *IN99 = *ON .
C Z-Add *ZERO Cursav
.
X001 C Else
.
C Z-Add Curent Cursav
.
E001 C Endif
end
?*
C Rrn1 Chain Fmt1S
delete old
C Eval *IN99 = NOT%FOUND delete old
C Move 'D' Ctlfld
.
B001 C Do Dlines
.
C Write Workfmt
.
E001 C Enddo
end
?*
C Z-Add Cursav Curent
?*
C Z-Add 1 I
promt
C Dint Add 1 J
text
C Movea Apmt Char
B001 C Dow Char <> *BLANK
?*
B002 C Dow Apmt(I) = *BLANK
B002CC And I < 1359
B002CC Or Apmt(I) = Hex20
B002CC And I < 1359
C Add 1 I
E002 C Enddo
C I Cabeq 1359 Endpmt
B002 C If Apmt(I) < *BLANK
B002CC And J > 1
C Sub 1 J
E002 C Endif
C Movea *BLANK Atxt
C Movea Apmt(I) Atxt(J)
?*
C 67 Sub J K
C Add K I
B002 C If I <= 1359
B003 C If Apmt(I) > *BLANK
C Z-Add I J
C Z-Add 67 K
B004 C Dou Apmt(J) <= *BLANK
B004CC Or J <= 1
B004CC Or K <= 1
C Sub 1 J
C Sub 1 K
E004 C Enddo
B004 C If J > 1
B004CC And K > 1
C Z-Add J I
C Movea *BLANK Atxt(K)
C Move Hex20 Atxt(K)
E004 C Endif
E003 C Endif
E002 C Endif
?*
C Movea Atxt Qtxt
C Move 'A' Ctlfld
C Write Workfmt
?*
B002 C If Dlines = *ZERO
B002CC And Rrn1 = 1
C Update Fmt1S
C Add 1 Rrn1
E002 C Endif
?*
C Dleftm Add 1 J
C Move *BLANK Char
B002 C If I <= 1359
C Movea Apmt(I) Char
E002 C Endif
?*
E001 C Enddo
?*
C Z-Add 4 Curcol
?*
EDSR C Endpmt Endsr
?*****************************************************************
?* display screen layout
?*****************************************************************
BGSR C Dspscn Begsr
?*
C Exsr Updsp
C Move 'D' Refout
C Exsr Prevew
?*
EDSR C Endsr
?*****************************************************************
?* display list layout
?*****************************************************************
BGSR C Dsplst Begsr
?*
C Exsr Updsp
C Move 'L' Refout
C Exsr Prevew
?*
EDSR C Endsr
?*****************************************************************
?* preview
?*****************************************************************
BGSR C Prevew Begsr
?*
C Eval *IN71 = *ON
C Write Fmt3C
C Eval *IN71 = *OFF
C Z-Add *ZERO Rrn3 72
?*
C Z-Add *ZERO Curent
C Move 'E' Ctlfld
C Read Workfmt
C Eval *IN98 = %EOF
B001 C Dow *IN99 = *OFF
?*
B002 C If Qout = *BLANK
B002CC Or Qout = Refout
?*
B003 C If Qpic = '*PIC '
B004 C If Refout = 'L'
C Exsr Incpic
E004 C Endif
X003 C Else
B004 C If Qtxt = '*PA '
B005 C If Refout = 'L'
C Exsr Incpal
X005 C Else
C Exsr Incpad
E005 C Endif
X004 C Else
C Move Qtxt Dtxt
C Add 1 Rrn3 72
C Write Fmt3S
E004 C Endif
E003 C Endif
?*
E002 C Endif
?*
C Read Workfmt
C Eval *IN98 = %EOF
E001 C Enddo
?*
C Write Fmt3F
C Write Fmt3C
B001 C Dou *IN03 = *ON
B001CC Or *IN12 = *ON
C Read Fmt3C
C Eval *IN99 = %EOF
E001 C Enddo
?*
EDSR C Endsr
?*****************************************************************
?* include external picture
?*****************************************************************
BGSR C Incpic Begsr
?*
C Move Qpid Picpgm
C Move Qfid Picfmt
?*
B001 C If Qpicdt <> *BLANK
?*
C Movea *BLANK Anam
C Z-Add 1 A
C *BLANK Lookup Apic(A) 99
C Movea Apic(A) Anam(1)
C Z-Add A B
C ',' Lookup Apic(B)
99
B002 C If *IN99 = *OFF
C Z-Add A B
C *BLANK Lookup Apic(B)
99
E002 C Endif
C B Sub A C
C Add 1 C
B002 C If C <= 10
C Movea *BLANK Anam(C)
E002 C Endif
C Movea Anam Picpgm
B002 C If Picpgm = '*'
C Move Qpid Picpgm
E002 C Endif
?*
C Movea *BLANK Anam
C B Add 1 A
C *BLANK Lookup Apic(A) 99
B002 C If *IN99 = *ON
C Movea Apic(A) Anam(1)
C Z-Add A B
C *BLANK Lookup Apic(B)
99
C B Sub A C
C Add 1 C
B003 C If C <= 10
C Movea *BLANK Anam(C)
E003 C Endif
C Movea Anam Picfmt
E002 C Endif
?*
E001 C Endif
?*
C Call 'QDCXLATE' 99
C Parm 10 Fldlen
C Parm Picpgm
C Parm 'QCASE256' Tbl
C Parm 'QUSRSYS' Tbllib
C Call 'QDCXLATE' 99
C Parm Fldlen
C Parm Picfmt
C Parm Tbl
C Parm Tbllib
C Call 'MDOC014 '
C Parm 'R' Functn
C Parm Picpgm
C Parm Picfmt
C Parm Hlplib
C Parm *BLANK Screen
C *IN99 Parm *OFF In99
?*
C Bitoff '01234567' Hex20
C Biton '2' Hex20
C Move '|' Right
?*
C Move *ALL'-' Dtxt
C Movel '+' Dtxt
C Move '+' Dtxt
C Add 1 Rrn3 72
C Write Fmt3S
?*
C Move *BLANK Dtxt
C Movel '|' Dtxt
C Move Right Dtxt
C Add 1 Rrn3 72
C Write Fmt3S
?*
B001 C Do 24 A
C Movea Ascn(A) Pic
C Add 1 Rrn3 72
C Write Fmt3S
E001 C Enddo
?*
C Move *BLANK Dtxt
C Movel '|' Dtxt
C Move '|' Dtxt
C Add 1 Rrn3 72
C Write Fmt3S
?*
C Move *ALL'-' Dtxt
C Movel '+' Dtxt
C Move '+' Dtxt
C Add 1 Rrn3 72
C Write Fmt3S
?*
EDSR C Endsr
?*****************************************************************
?* include page advance mark
?*****************************************************************
BGSR C Incpal Begsr
?*
C Move *BLANK Dtxt
C Movel ' *PA ' Dtxt
C Bitoff '01234567' Byte
C Biton '27' Byte
C Movel Byte Dtxt
C Add 1 Rrn3 72
C Write Fmt3S
?*
EDSR C Endsr
?*****************************************************************
?* include page advance remark (display)
?*****************************************************************
BGSR C Incpad Begsr
?*
C Sub 1 Rrn3
C Div 17 Rrn3
C Mult 17 Rrn3
C Add 17 Rrn3
?*
EDSR C Endsr
?*****************************************************************
?* *pssr
?*****************************************************************
BGSR ?***13359 *PSSR Begsr
?*
EDSR ?***13359 Endsr '*CANCL'
?*****************************************************************
**
(Help text not defined)
/*********************************************************************/
/* HELP TEXT EDITOR WORK SPACE HANDLER */
/*********************************************************************/
ENTRY *(EXTPARM) EXT;
DCL SPCPTR XRQS-SPP PARM;
DCL SPCPTR XSTS-SPP PARM;
DCL SPCPTR XERRCODE-SPP PARM;
DCL SPCPTR XIOAREA-SPP PARM;
DCL SPCPTR XCTL-SPP PARM;
DCL SPCPTR XFIRST-SPP PARM;
DCL SPCPTR XCURRENT-SPP PARM;
DCL SPCPTR XSPCNAME-SPP PARM;
DCL SPCPTR XEOF-SPP PARM;
DCL OL EXTPARM(XRQS-SPP,XSTS-SPP,XERRCODE-SPP,XIOAREA-SPP,
XCTL-SPP,XFIRST-SPP,XCURRENT-SPP,XSPCNAME-SPP,
XEOF-SPP) PARM EXT;
DCL DD XRQS CHAR(1) BAS(XRQS-SPP);
DCL DD XSTS CHAR(1) BAS(XSTS-SPP);
DCL DD XERRCODE ZND(5,0) BAS(XERRCODE-SPP);
DCL DD XIOAREA CHAR(67) BAS(XIOAREA-SPP);
DCL DD XCTL CHAR(1) BAS(XCTL-SPP);
DCL DD XFIRST PKD(15,0) BAS(XFIRST-SPP);
DCL DD XCURRENT PKD(15,0) BAS(XCURRENT-SPP);
DCL DD XSPCNAME CHAR(30) BAS(XSPCNAME-SPP);
DCL DD XEOF CHAR(1) BAS(XEOF-SPP);
/********************************************************************/
/* START */
/********************************************************************/
CMPBLA(B) XRQS,'O'/EQ(OPEN);
CMPBLA(B) XRQS,'C'/EQ(CLOSE);
CMPBLA(B) XRQS,'R'/EQ(READ);
CMPBLA(B) XRQS,'W'/EQ(WRITE);
CPYBLA XSTS,'2';
CPYNV XERRCODE,90001;/* INVALID REQUEST */
RTX *;
/********************************************************************/
/* OPEN FILE: RESOLVE WROK SPACE (CREATE IF NOT EXIST) */
/********************************************************************/
DCL EXCM EXCM1 EXCID(H'2201') BP(CRTSPACE) SKP;
OPEN:
CMPBLA(B) XCTL,' '/NEQ(OPENEND);
RSLVSP CTX-SYP,CTX-ID,*,X'FF00';
CPYBLA WRKSPC-NAME,XSPCNAME;
MODEXCPD EXCM1,*ENABLE,X'01';
RSLVSP WRKSPC-SYP,WRKSPC-ID,CTX-SYP,X'FF00';
MODEXCPD EXCM1,*DISABLE,X'01';
SETSPPFP WRKSPC-SPP,WRKSPC-SYP;
CPYNV XFIRST,WRKSPC-FIRST;
CPYNV XCURRENT,0;
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
OPENEND: RTX *;
CRTSPACE:
MODEXCPD EXCM1,*DISABLE,X'01';
CPYBLA SPCTMPL-NAME,XSPCNAME;
Stmt 43: CRTS WRKSPC-SYP,SPCTMPL-SPP;
SETSPPFP WRKSPC-SPP,WRKSPC-SYP;
CPYNV WRKSPC-FIRST,0;
CPYNV WRKSPC-COUNT,0;
CPYNV XFIRST,0;
CPYNV XCURRENT,0;
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
RTX *;
/********************************************************************/
/* CLOSE FILE: DESTROY SPACE (IF REQUESTED) */
/********************************************************************/
CLOSE:
CMPBLA(B) XCTL,' '/NEQ(CLOSEEND);
DESS WRKSPC-SYP;
DEACTPG *;
CLOSEEND: RTX *;
/********************************************************************/
/* READ FILE */
/********************************************************************/
DCL DD CURRENT BIN(4) AUTO;
DCL DD OFFSET BIN(4) AUTO;
DCL DD FREE CHAR(8) AUTO INIT(X'FFFFFFFFFFFFFFFF');
READ:
CPYNV CURRENT,XCURRENT;
CPYBWP RECORD-SPP,WRKSPC-SPP;
SETSPPO RECORD-SPP,CURRENT;
CMPBLA(B) XCTL,'P'/EQ(READPREV);
CMPBLA(B) XCTL,'N'/EQ(READNEXT);
CMPBLA(B) XCTL,'C'/EQ(READOK);
CMPBLA(B) XCTL,'E'/EQ(READEND);
CPYBLA XSTS,'2';
CPYNV XERRCODE,90002; /* INVALID READ REQUEST */
RTX *;
READPREV:
CMPNV(B) CURRENT,0/EQ(EOF);
CMPNV(B) RECORD-PREV,0/EQ(EOF);
CPYNV CURRENT,RECORD-PREV;
SETSPPO RECORD-SPP,CURRENT;
B READOK;
READNEXT:
CMPNV(B) WRKSPC-COUNT,0/EQ(ADDRECORD);
CMPNV(B) RECORD-NEXT,0/EQ(ADDRECORD);
CMPNV(B) CURRENT,0/HI(TAG1);
CPYNV CURRENT,WRKSPC-FIRST;
B TAG2;
TAG1: CPYNV CURRENT,RECORD-NEXT;
TAG2: SETSPPO RECORD-SPP,CURRENT;
B READOK;
ADDRECORD:
CMPNV(B) WRKSPC-COUNT,3000/EQ(EOF);
CPYNV PREV,0;
CPYNV NEXT,0;
CMPNV(B) CURRENT,0/EQ(END51);
CPYNV PREV,CURRENT;
CPYNV NEXT,RECORD-NEXT;
END51:
/* NEW RECORD */
SEARCH CURRENT,WRKSPC-PTR,FREE,1;
MULT(S) CURRENT,75;
SUBN(S) CURRENT,59;
SETSPPO RECORD-SPP,CURRENT;
CPYNV RECORD-PREV,PREV;
CPYNV RECORD-NEXT,NEXT;
CPYBLAP RECORD-DATA,' ',' ';
CPYNV WRKSPC-LAST,CURRENT;
ADDN(S) WRKSPC-COUNT,1;
/* PREVIOUS RECORD */
CMPNV(B) RECORD-PREV,0/EQ(END52);
SETSPPO RECORD-SPP,RECORD-PREV;
CPYNV RECORD-NEXT,CURRENT;
SETSPPO RECORD-SPP,CURRENT;
B END53;
END52: CPYNV WRKSPC-FIRST,CURRENT;
END53: B READOK;
READEND:
CMPNV(B) CURRENT,0/HI(CONT1);
CMPNV(B) WRKSPC-FIRST,0/EQ(EOF);
CPYNV CURRENT,WRKSPC-FIRST;
B CONT2;
CONT1: CMPNV(B) RECORD-NEXT,0/EQ(EOF);
CPYNV CURRENT,RECORD-NEXT;
CONT2: SETSPPO RECORD-SPP,CURRENT;
CPYNV OFFSET,CURRENT;
CF: CMPBLAP(B) RECORD-DATA,' ',' '/NEQ(ENDREADEND);
CMPNV(B) RECORD-NEXT,0/EQ(EOF);
CPYNV OFFSET,RECORD-NEXT;
SETSPPO RECORD-SPP,OFFSET;
B CF;
ENDREADEND:SETSPPO RECORD-SPP,CURRENT;
READOK:
CPYBLA XIOAREA,RECORD-DATA;
CPYNV XFIRST,WRKSPC-FIRST;
CPYNV XCURRENT,CURRENT;
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
RTX *;
EOF:
CPYBLA XEOF,'1';
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
RTX *;
/********************************************************************/
/* WRITE FILE */
/********************************************************************/
DCL DD NEXT BIN(4) AUTO;
DCL DD PREV BIN(4) AUTO;
DCL DD BUFFER CHAR(75) AUTO;
WRITE:
CPYNV CURRENT,XCURRENT;
CPYBWP RECORD-SPP,WRKSPC-SPP;
SETSPPO RECORD-SPP,CURRENT;
CMPBLA(B) XCTL,'B'/EQ(ADDBEFORE);
CMPBLA(B) XCTL,'A'/EQ(ADDAFTER);
CMPBLA(B) XCTL,'U'/EQ(UPDATE);
CMPBLA(B) XCTL,'D'/EQ(DELETE);
CPYBLA XSTS,'2';
CPYNV XERRCODE,90003; /* INVALID WRITE REQUEST */
RTX *;
ADDBEFORE:
CPYNV PREV,0;
CPYNV NEXT,0;
CMPNV(B) CURRENT,0/EQ(END01);
CPYNV PREV,RECORD-PREV;
CPYNV NEXT,CURRENT;
END01:
/* NEW RECORD */
CMPNV(B) WRKSPC-COUNT,3000/EQ(END02); /* SPACE FULL */
SEARCH CURRENT,WRKSPC-PTR,FREE,1;
MULT(S) CURRENT,75;
SUBN(S) CURRENT,59;
SETSPPO RECORD-SPP,CURRENT;
CPYNV RECORD-PREV,PREV;
CPYNV RECORD-NEXT,NEXT;
CPYBLA RECORD-DATA,XIOAREA;
ADDN(S) WRKSPC-COUNT,1;
B END03;
END02: CPYNV CURRENT,WRKSPC-LAST;
SETSPPO RECORD-SPP,CURRENT;
CPYNV WRKSPC-LAST,RECORD-PREV;
SETSPPO RECORD-SPP,RECORD-PREV;
CPYNV RECORD-NEXT,0;
SETSPPO RECORD-SPP,CURRENT;
CPYNV RECORD-PREV,PREV;
CPYNV RECORD-NEXT,NEXT;
CPYBLA RECORD-DATA,XIOAREA;
END03:
/* PREVIOUS RECORD */
CMPNV(B) RECORD-PREV,0/EQ(END04);
SETSPPO RECORD-SPP,RECORD-PREV;
CPYNV RECORD-NEXT,CURRENT;
SETSPPO RECORD-SPP,CURRENT;
B END05;
END04: CPYNV WRKSPC-FIRST,CURRENT;
END05:
/* NEXT RECORD */
CMPNV(B) RECORD-NEXT,0/EQ(END06);
SETSPPO RECORD-SPP,RECORD-NEXT;
CPYNV RECORD-PREV,CURRENT;
SETSPPO RECORD-SPP,CURRENT;
B END07;
END06: CPYNV WRKSPC-LAST,CURRENT;
END07:
CPYNV XFIRST,WRKSPC-FIRST;
CPYNV XCURRENT,CURRENT;
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
RTX *;
ADDAFTER:
CPYNV PREV,0;
CPYNV NEXT,WRKSPC-FIRST;
CMPNV(B) CURRENT,0/EQ(END21);
CPYNV PREV,CURRENT;
CPYNV NEXT,RECORD-NEXT;
END21:
/* NEW RECORD */
CMPNV(B) WRKSPC-COUNT,3000/EQ(END22); /* SPACE FULL */
SEARCH CURRENT,WRKSPC-PTR,FREE,1;
MULT(S) CURRENT,75;
SUBN(S) CURRENT,59;
SETSPPO RECORD-SPP,CURRENT;
CPYNV RECORD-PREV,PREV;
CPYNV RECORD-NEXT,NEXT;
CPYBLA RECORD-DATA,XIOAREA;
ADDN(S) WRKSPC-COUNT,1;
B END23;
END22: CPYNV CURRENT,WRKSPC-LAST;
SETSPPO RECORD-SPP,CURRENT;
CPYNV WRKSPC-LAST,RECORD-PREV;
SETSPPO RECORD-SPP,RECORD-PREV;
CPYNV RECORD-NEXT,0;
SETSPPO RECORD-SPP,CURRENT;
CPYNV RECORD-PREV,PREV;
CPYNV RECORD-NEXT,NEXT;
CPYBLA RECORD-DATA,XIOAREA;
END23:
/* PREVIOUS RECORD */
CMPNV(B) RECORD-PREV,0/EQ(END24);
SETSPPO RECORD-SPP,RECORD-PREV;
CPYNV RECORD-NEXT,CURRENT;
SETSPPO RECORD-SPP,CURRENT;
B END25;
END24: CPYNV WRKSPC-FIRST,CURRENT;
END25:
/* NEXT RECORD */
CMPNV(B) RECORD-NEXT,0/EQ(END26);
SETSPPO RECORD-SPP,RECORD-NEXT;
CPYNV RECORD-PREV,CURRENT;
SETSPPO RECORD-SPP,CURRENT;
B END27;
END26: CPYNV WRKSPC-LAST,CURRENT;
END27:
CPYNV XFIRST,WRKSPC-FIRST;
CPYNV XCURRENT,CURRENT;
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
RTX *;
UPDATE:
CPYBLA RECORD-DATA,XIOAREA;
CPYNV XFIRST,WRKSPC-FIRST;
CPYNV XCURRENT,CURRENT;
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
RTX *;
DELETE:
CPYNV PREV,RECORD-PREV;
CPYNV NEXT,RECORD-NEXT;
CMPNV(B) PREV,0/EQ(END41);
SETSPPO RECORD-SPP,PREV;
CPYNV RECORD-NEXT,NEXT;
B END42;
END41: CPYNV WRKSPC-FIRST,NEXT;
END42:
CMPNV(B) NEXT,0/EQ(END43);
SETSPPO RECORD-SPP,NEXT;
CPYNV RECORD-PREV,PREV;
B END44;
END43: CPYNV WRKSPC-LAST,PREV;
END44:
SUBN(S) WRKSPC-COUNT,1;
SETSPPO RECORD-SPP,CURRENT;
CPYBLAP RECORD-BUFF,X'FFFFFFFFFFFFFFFF',X'00';
CPYNV CURRENT,NEXT;
SETSPPO RECORD-SPP,CURRENT;
CPYNV XFIRST,WRKSPC-FIRST;
CPYNV XCURRENT,CURRENT;
CPYBLA XSTS,'0';
CPYNV XERRCODE,0;
RTX *;
/********************************************************************/
DCL SYSPTR WRKSPC-SYP;
DCL SPCPTR WRKSPC-SPP;
DCL DD WRKSPC-FIRST BIN(4) BAS(WRKSPC-SPP) POS(1); /* FIRST LINE */
DCL DD WRKSPC-LAST BIN(4) BAS(WRKSPC-SPP) POS(5); /* LAST LINE */
DCL DD WRKSPC-COUNT BIN(4) BAS(WRKSPC-SPP) POS(13); /* LINE COUNT */
DCL DD WRKSPC-DUMMY CHAR(1) BAS(WRKSPC-SPP) POS(17);
DCL DD WRKSPC-PTR(3000) CHAR(8) DEF(WRKSPC-DUMMY) AEO(75);
DCL SPCPTR RECORD-SPP AUTO;
DCL DD RECORD-PREV BIN(4) BAS(RECORD-SPP) POS(1); /* PREV LINE */
DCL DD RECORD-NEXT BIN(4) BAS(RECORD-SPP) POS(5); /* NEXT LINE */
DCL DD RECORD-DATA CHAR(67) BAS(RECORD-SPP) POS(9); /* DATA */
DCL DD RECORD-BUFF CHAR(75) BAS(RECORD-SPP) POS(1);
DCL SPCPTR SPCTMPL-SPP AUTO INIT(SPCTMPL);
DCL DD SPCTMPL CHAR(160) AUTO;
DCL DD * BIN(4) DEF(SPCTMPL) POS(1) INIT(160);
DCL DD * CHAR(2) DEF(SPCTMPL) POS(9) INIT(X'19EE');
DCL DD SPCTMPL-NAME CHAR(30) DEF(SPCTMPL) POS(11);
DCL DD * CHAR(4) DEF(SPCTMPL) POS(41) INIT(X'E2000000');
DCL DD * CHAR(4) DEF(SPCTMPL) POS(45) INIT(X'00000000');
/* DCL DD * BIN(4) DEF(SPCTMPL) POS(49) INIT(127516);
*/
DCL DD * BIN(4) DEF(SPCTMPL) POS(49) INIT(225016);
DCL DD * CHAR(1) DEF(SPCTMPL) POS(53) INIT(X'FF');
DCL DD * CHAR(4) DEF(SPCTMPL) POS(54) INIT(X'03000000');
DCL DD * CHAR(1) DEF(SPCTMPL) POS(58) INIT(X'00');
DCL DD * CHAR(2) DEF(SPCTMPL) POS(59) INIT(X'FF00');
DCL DD * BIN(4) DEF(SPCTMPL) POS(61) INIT(0);
DCL SYSPTR CTX-SYP DEF(SPCTMPL) POS(65);
DCL DD WRKSPC-ID CHAR(34) AUTO;
DCL DD * CHAR(2) DEF(WRKSPC-ID) POS(1) INIT(X'19EE');
DCL DD WRKSPC-NAME CHAR(30) DEF(WRKSPC-ID) POS(3);
DCL DD * CHAR(2) DEF(WRKSPC-ID) POS(33) INIT(X'0000');
DCL DD CTX-ID CHAR(34) AUTO;
DCL DD * CHAR(2) DEF(CTX-ID) POS(1) INIT(X'0401');
DCL DD * CHAR(30) DEF(CTX-ID) POS(3) INIT('QRECOVERY');
DCL DD * CHAR(2) DEF(CTX-ID) POS(33) INIT(X'0000');
DCL CON *ENABLE CHAR(2) INIT(X'A000');
DCL CON *DISABLE CHAR(2) INIT(X'2000');
PEND;
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
