/************************************************************************/ /* File: GENFREE.QRPGLESRC Generator for /free /end-free entries */ /* Copyright (C) 2004 Dieter Bender */ /* */ /* This program is free software; you can redistribute it and/or modify */ /* it under the terms of the GNU General Public License as published by */ /* the Free Software Foundation. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU General Public License for more details. */ /* */ /* You should have received a copy of the GNU General Public License */ /* along with this program; if not, write to the Free Software */ /* Foundation, Inc., 59 Temple Place, */ /* Suite 330, Boston, MA 02111-1307 USA */ /* You might find a version at http://www.gnu.org */ /************************************************************************/ H copyright('Dieter Bender 02/2004 ') * compile with D*B OVRDBF SOURCE QRPGLESRC D*B+ OVRSCOPE(*JOB) D*B CRTSRCPF QTEMP/GENSRC D*B+ RCDLEN(112) D*B CRTRPGMOD GENFREE D*B+ DBGVIEW(*SOURCE) D*B+ REPLACE(*YES) D*B CRTPGM GENFREE D*B+ BNDDIR(QC2LE) D*B+ ACTGRP(GENFREE) D*B DLTOVR *ALL LVL(*JOB) FSource IF F 112 DISK USROPN FGenSrc O F 112 DISK USROPN DZeile E DS EXTNAME(QRPGLESRC) /*--- import Prototypes /COPY QRPGLEH,SYSTEM /COPY QRPGLEH,QMHSNDPM /COPY QRPGLEH,GENFREE /*--- local Prototypes D Work PR d init pr d exit pr d checkLine PR D getLine PR n d startFree PR d endFree PR D getType PR 1a D dummy like(line) /*--- Constants D TRUE C *ON D FALSE C *OFF * line Types D FREE C 'F' D CARD C 'P' D COMMENT C '*' D PREPROC C '/' D BLANK C ' ' /*--- statefull Variables D line s 128A D lineType s 1a D freeFlag s n INZ(FALSE) d dirty s n INZ(FALSE) /*--- Main Interface D GENFREE PI D FileName 10A CONST D Library 10A CONST D Member 10A CONST /*--- very unimportant procedure main ------------------------*/ /free Work(); return; /end-free /*============================================================*/ P Work B /*------------------------------------------------------------*/ D error s N INZ(FALSE) /free init(); dow getLine() and not error; checkLine(); write GenSrc Zeile; enddo; exit(); if not error; return; else; SendSysMsg( 'CPF9898' : 'QCPFMSG ' + '*LIBL ' : 'Problems GenFree' : 25 : '*ESCAPE ' : '*PGMBDY ' : 1 : QMHSNDPM_MSGKEY : QMHSNDPM_MSGERR ); endif; return; /end-free P Work E /*============================================================*/ P checkLine B D checkLine PI D up C 'DEFNR' D lo C 'defnr' /*------------------------------------------------------------*/ /free select; when lineType = BLANK; when lineType = PREPROC; select; when %xlate(up : lo : %subst(line : 7 : 5)) = '/free'; freeFlag = TRUE; when %xlate(up : lo : %subst(line : 7 : 9)) = '/end-free'; freeFlag = FALSE; other; if freeFlag; endFree(); endif; endsl; when lineType = FREE; if not freeFlag; startFree(); endif; other; if freeFlag; endfree(); endif; endsl; /end-free P checkLine E /*============================================================*/ P init B D init PI /*------------------------------------------------------------*/ /free system('OVRDBF Source ' + %trim(Library) + '/' + %trim(FileName) + ' ' + %trim(Member) + ' LVLCHK(*NO)' + ' OVRSCOPE(*JOB)'); open Source; system('CRTSRCPF ' + 'QTEMP/GENSRC ' + 'RCDLEN(112) ' + 'MBR(*FILE)'); system('CLRPFM ' + 'QTEMP/GENSRC '); system('OVRDBF GENSRC ' + 'QTEMP/GENSRC ' + ' LVLCHK(*NO)' + ' OVRSCOPE(*JOB)'); open GenSrc; /end-free P init E /*============================================================*/ P exit B D exit PI /*------------------------------------------------------------*/ /free close Source; close GenSrc; if dirty; system('CPYF ' + 'QTEMP/GENSRC ' + %trim(Library) + '/' + %trim(FileName) + ' ' + 'TOMBR(' + %trim(Member) + ') ' + 'FMTOPT(*MAP *DROP) ' + 'MBROPT(*REPLACE)'); endif; system('DLTOVR *ALL LVL(*JOB)'); /end-free P exit E /*============================================================*/ P startFree B D startFree PI d line E DS EXTNAME(GENSRC) /*------------------------------------------------------------*/ /free SRCDTA = ' /free'; write GenSrc line; freeFlag = TRUE; dirty = TRUE; /end-free P startFree E /*============================================================*/ P endFree B D endFree PI d line E DS EXTNAME(GENSRC) /*------------------------------------------------------------*/ /free SRCDTA = ' /end-free' ; write GenSrc line; freeFlag = FALSE; dirty = TRUE; /end-free P endFree E /*============================================================*/ P getLine B D getLine PI n /*------------------------------------------------------------*/ /free read Source Zeile; if %eof; return FALSE; endif; line = SRCDTA; getType(line); return TRUE; /end-free P getLine E /*============================================================*/ P getType B D getType PI 1a D Zeile like(line) D punchTyp s 1a D preMark s 1a /*------------------------------------------------------------*/ /free punchTyp = %subst(Zeile : 6 : 1); preMark = %subst(Zeile : 7 : 1); select; when preMark = '*'; lineType = COMMENT; when Zeile = *BLANK; lineType = BLANK; when preMark = '/'; lineType = PREPROC; when punchTyp = *BLANK; lineType = FREE; other; lineType = CARD; endsl ; return lineType; /end-free P getType E