//BCHJOB JOB(JNSTRPG) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source from www.neroni.it */ /* LA JOB DESCRIPTION "NERONI2/NERONI2" DEVE PREESISTERE. PUO' ESSERE */ /* IDENTICA A QBATCH E PUO' ESSERE SOSTITUITA DA QBATCH O SIMILE. */ /* From System: "S65D69DA" */ /* From Library: "NERONI2" */ /* Unload Time: 2016-04-04 11:58 */ /* To File : "JNSTRPG" */ /* To Library : "NERONI2" */ /* To Text : "Nest RPG source. Src" */ /********* INIZIO ISTRUZIONI *******************************************/ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI RICARICARE I SORGENTI. */ /* 1) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* CREARE UN FILE SORGENTE DI LUNGHEZZA RECORD 112: */ /* CRTSRCPF FILE(NERONI2/STRINGHE) RCDLEN(112) */ /* 2) SPOSTARE IL FILE "JNSTRPG.txt" NELL'INDIRIZZARIO */ /* DI UN PC CONNESSO IN RETE CON L'AS400 RICEVENTE */ /* (AD ES.: "c:\"). */ /* 3) DAL VIDEO COMANDI DEL PC CHIAMARE FTP: */ /* ftp nomeas400 */ /* 4) DIGITARE UTENTE E PASSWORD. */ /* 5) ESEGUIRE IL COMANDO DI COPIA DA FILE PC A MEMBRO AS400: */ /* put "c:\JNSTRPG.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JNSTRPG.mbr" */ /* 6) ABBANDONARE FTP: */ /* quit */ /* 7) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA COPIATA NEL MEMBRO SORGENTE: */ /* SBMDBJOB FILE(NERONI2/STRINGHE) MBR(JNSTRPG) JOBQ(QBATCH) */ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI CREARE L'UTILITY. */ /* 8) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA O LE STRINGHE SORGENTE DI TIPO SEU "CL" */ /* (IL CUI NOME TERMINA SEMPRE CON ".") */ /* PRESENTI NEL FILE RICARICATO "NERONI2/JNSTRPG" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JNSTRPG) MBR(JNSTRPG.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI *********************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Claudio Neroni Utility') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JNSTRPG) CRTSRCPF FILE(NERONI2/JNSTRPG) RCDLEN(112) + TEXT('Nest RPG source. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPG) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPG) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPG) + SRCTYPE(CMD) + TEXT('Nest RPG source. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPG.) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPG.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPG.) + SRCTYPE(CL) + TEXT('Nest RPG source. Cjs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPGC) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPGC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPGC) + SRCTYPE(CLLE) + TEXT('Nest RPG source. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPGD) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPGD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPGD) + SRCTYPE(RPGLE) + TEXT('Nest RPG source. UpdRpg') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPGE) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPGE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPGE) + SRCTYPE(RPGLE) + TEXT('Nest RPG source. UpdRpgle') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPGH) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPGH) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPGH) + SRCTYPE(COPY) + TEXT('Nest RPG source. UpdRpg&Rpgle/Copy') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPGP) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPGP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPGP) + SRCTYPE(PNLGRP) + TEXT('Nest RPG source. Help') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPGTST) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPGTST) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPGTST) + SRCTYPE(RPGLE) + TEXT('Nest RPG source. TestData') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JNSTRPGTS1) TOFILE(NERONI2/JNSTRPG) + TOMBR(JNSTRPGTS1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JNSTRPG) MBR(JNSTRPGTS1) + SRCTYPE(RPGLE) + TEXT('Nest RPG source. TestData') /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPG) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Nest RPG source. Cmd */ /* Claudio Neroni 08/12/2000 Creato. */ CMD PROMPT('Nest RPG source') PARM KWD(SRCFILE) TYPE(SRCFILE) MIN(1) + PROMPT('Source file') SRCFILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('library') PARM KWD(SRCMBR) TYPE(*NAME) MIN(1) PROMPT('Source + member') PARM KWD(UPDTYPE) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*NEST) VALUES(*NEST *ALIGN *BOTH) + PROMPT('Update type') PARM KWD(NESTLOC) TYPE(*CHAR) LEN(7) RSTD(*YES) + DFT(*END) VALUES(*BEG *COMBEG *END *EXT) + PMTCTL(NEST) PROMPT('Nest location') PARM KWD(NESTCONT) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*BLANK) VALUES('.' ':' '_' '=' '^' + '"' '+' '-' '!' '<' '>' '°' '*' '''' '/' + '%' N) SPCVAL((*BLANK ' ')) PMTCTL(NEST) + PROMPT('Nest continuation symbol') PARM KWD(NESTZERO) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*BLANK) SPCVAL((*BLANK ' ') (*ZERO + 00)) PMTCTL(NEST) PROMPT('Nest zero level + symbol') PARM KWD(NESTUSE) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*YES *NO) PMTCTL(NEST) + PROMPT('Nest use continuation') PARM KWD(NESTCLEAR) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NO) VALUES(*NO *YES) PMTCTL(NEST) + PROMPT('Nest clear') PARM KWD(ALIGNSTEP) TYPE(*DEC) LEN(3 0) DFT(3) + RANGE(0 10) PMTCTL(ALIGN) + PROMPT('Alignment step') PARM KWD(ALIGNCALC) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NO) VALUES(*NO *YES) PMTCTL(ALIGN) + PROMPT('Align "C* " specifications') DEP CTL(&NESTLOC *NE *END) PARM((&UPDTYPE *EQ + *NEST) (&UPDTYPE *EQ *BOTH)) NBRTRUE(*EQ + 1) MSGID(JNR1001) DEP CTL(&NESTCONT *NE ' ') PARM((&UPDTYPE *EQ + *NEST) (&UPDTYPE *EQ *BOTH)) NBRTRUE(*EQ + 1) MSGID(JNR1002) DEP CTL(&NESTZERO *NE ' ') PARM((&UPDTYPE *EQ + *NEST) (&UPDTYPE *EQ *BOTH)) NBRTRUE(*EQ + 1) MSGID(JNR1003) DEP CTL(&NESTUSE *NE *YES) PARM((&UPDTYPE *EQ + *NEST) (&UPDTYPE *EQ *BOTH)) NBRTRUE(*EQ + 1) MSGID(JNR1004) DEP CTL(&NESTCLEAR *NE *NO) PARM((&UPDTYPE *EQ + *NEST) (&UPDTYPE *EQ *BOTH)) NBRTRUE(*EQ + 1) MSGID(JNR1005) DEP CTL(&NESTCLEAR *NE *NO) PARM((&NESTCONT *EQ + ' ') (&NESTZERO *EQ ' ')) NBRTRUE(*EQ 2) + MSGID(JNR1006) DEP CTL(&ALIGNSTEP *NE 3) PARM((&UPDTYPE *EQ + *ALIGN) (&UPDTYPE *EQ *BOTH)) NBRTRUE(*EQ + 1) MSGID(JRN1007) DEP CTL(&ALIGNCALC *NE *NO) PARM((&UPDTYPE *EQ + *ALIGN) (&UPDTYPE *EQ *BOTH)) NBRTRUE(*EQ + 1) MSGID(JNR1008) NEST: PMTCTL CTL(UPDTYPE) COND((*EQ *NEST) (*EQ *BOTH)) + NBRTRUE(*EQ 1) ALIGN: PMTCTL CTL(UPDTYPE) COND((*EQ *ALIGN) (*EQ *BOTH)) + NBRTRUE(*EQ 1) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPG.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JNSTRPG.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 08/12/2000 Creato. */ /* JNSTRPG */ /* Nest RPG source. */ /* Prerequisiti: JAI, JCV, JRSNMSG */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JNSTRPG) DLTPNLGRP PNLGRP(NERONI2/JNSTRPGP) DLTPGM PGM(NERONI2/JNSTRPGC) DLTPGM PGM(NERONI2/JNSTRPGD) DLTPGM PGM(NERONI2/JNSTRPGE) DLTMSGF MSGF(NERONI2/JNSTRPG) /* Crea gli oggetti. */ CRTBNDCL PGM(NERONI2/JNSTRPGC) SRCFILE(JNSTRPG) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JNSTRPGD) SRCFILE(JNSTRPG) OPTION(*SHOWSKP + *SHOWCPY) DBGVIEW(*LIST) CRTBNDRPG PGM(NERONI2/JNSTRPGE) SRCFILE(JNSTRPG) OPTION(*SHOWSKP + *SHOWCPY) DBGVIEW(*LIST) CRTPNLGRP PNLGRP(NERONI2/JNSTRPGP) SRCFILE(JNSTRPG) CRTCMD CMD(NERONI2/JNSTRPG) PGM(JNSTRPGC) SRCFILE(JNSTRPG) + MSGF(JNSTRPG) HLPPNLGRP(JNSTRPGP) HLPID(CMD) PRDLIB(NERONI2) CRTMSGF MSGF(NERONI2/JNSTRPG) TEXT('Nest RPG source. Msgf') /* Messaggi del Ccp. */ ADDMSGD MSGID(JNR0001) MSGF(NERONI2/JNSTRPG) MSG('Il file &2/&1 non + è di tipo source.') SECLVL('Il file &1 nella libreria + &2 contente il membro &3 non è un file source.') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JNR0002) MSGF(NERONI2/JNSTRPG) MSG('Il membro &3 del + file &2/&1 è di tipo seu &4, diverso da RPG.') + SECLVL('Il membro &3 del file &1 nella libreria &2 ha + un tipo seu &4, diverso da RPG - RPG38 - RPGLE - + SQLRPG - SQLRPGLE, supportati dalla funzione + richiesta.') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10)) ADDMSGD MSGID(JNR0003) MSGF(NERONI2/JNSTRPG) MSG('Il membro &3 del + file &2/&1 è vuoto.') SECLVL('Il membro &3 del file &1 + nella libreria &2 non contiene record. Perciò + l''attività richiesta su di esso non ha significato.') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JNR0004) MSGF(NERONI2/JNSTRPG) MSG('Il file &2/&1 ha + lunghezza record insufficiente per &4.') SECLVL('Il + file &1 nella libreria &2 è di lunghezza record &3, + insufficiente per contenere le istruzioni di un + sorgente di tipo &4.') FMT((*CHAR 10) (*CHAR 10) (*DEC + 9 0) (*CHAR 10)) ADDMSGD MSGID(JNR0005) MSGF(NERONI2/JNSTRPG) MSG('Lunghezza record + insufficiente nel file &2/&1.') SECLVL('Il file &1 + nella libreria &2 è di lunghezza record &3, + insufficiente per annotarvi l''annidamento nella + posizione &4.') FMT((*CHAR 10) (*CHAR 10) (*DEC 9 0) + (*CHAR 7)) ADDMSGD MSGID(JNR0011) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 annidato in posizione &5.') SECLVL('Sulle + specifiche del membro &3 del file &1 nella libreria + &2, tipo seu &4, è stato annotato l''annidamento nella + posizione &5.') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 7) (*DEC 7 0)) ADDMSGD MSGID(JNR0012) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 pulito in posizione &5.') SECLVL('Sulle + specifiche del membro &3 del file &1 nella libreria + &2, tipo seu &4, è stato pulito il gruppo dei + caratteri destinati a contenere l''annidamento nella + posizione &5.') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 7) (*DEC 7 0)) ADDMSGD MSGID(JNR0013) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 allineato.') SECLVL('Sulle specifiche del + membro &3 del file &1 nella libreria &2, tipo seu &4, + sono stati allineati tutti i commenti.') FMT((*CHAR + 10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*DEC 7 0)) ADDMSGD MSGID(JNR0014) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 allineato parzialmente.') SECLVL('Sulle + specifiche del membro &3 del file &1 nella libreria + &2, tipo seu &4, sono stati allineati i commenti ad + eccezione di &6 non allineabili con i criteri + richiesti.') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 7) (*DEC 7 0)) ADDMSGD MSGID(JNR0015) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 annidato e allineato.') SECLVL('Sulle + specifiche del membro &3 del file &1 nella libreria + &2, tipo seu &4, è stato annotato l''annidamento nella + posizione &5 e sono stati allineati tutti i + commenti.') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 7) (*DEC 7 0)) ADDMSGD MSGID(JNR0016) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 annidato e parzialmente allineato.') + SECLVL('Sulle specifiche del membro &3 del file &1 + nella libreria &2, tipo seu &4, è stato annotato + l''annidamento nella posizione &5 e sono stati + allineati i commenti ad eccezione di &6 non + allineabili con i criteri richiesti.') FMT((*CHAR 10) + (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*DEC 7 0)) ADDMSGD MSGID(JNR0017) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 pulito e allineato.') SECLVL('Sulle + specifiche del membro &3 del file &1 nella libreria + &2, tipo seu &4, è stato pulito il gruppo dei + caratteri destinati a contenere l''annidamento nella + posizione &5 e sono stati allineati tutti i + commenti.') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 7) (*DEC 7 0)) ADDMSGD MSGID(JNR0018) MSGF(NERONI2/JNSTRPG) MSG('Membro &3 file + &2/&1 seu &4 pulito e parzialmente allineato.') + SECLVL('Sulle specifiche del membro &3 del file &1 + nella libreria &2, tipo seu &4, è stato pulito il + gruppo dei caratteri destinati a contenere + l''annidamento nella posizione &5 e sono stati + allineati i commenti ad eccezione di &6 non + allineabili con i criteri richiesti.') FMT((*CHAR 10) + (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*DEC 7 0)) /* Messaggi del Cmd. */ ADDMSGD MSGID(JNR1001) MSGF(NERONI2/JNSTRPG) MSG('NESTLOC permesso + solo se UPDTYPE eguale a *NEST o *BOTH.') ADDMSGD MSGID(JNR1002) MSGF(NERONI2/JNSTRPG) MSG('NESTCONT permesso + solo se UPDTYPE eguale a *NEST o *BOTH.') ADDMSGD MSGID(JNR1003) MSGF(NERONI2/JNSTRPG) MSG('NESTZERO permesso + solo se UPDTYPE eguale a *NEST o *BOTH.') ADDMSGD MSGID(JNR1004) MSGF(NERONI2/JNSTRPG) MSG('NESTUSE permesso + solo se UPDTYPE eguale a *NEST o *BOTH.') ADDMSGD MSGID(JNR1005) MSGF(NERONI2/JNSTRPG) MSG('NESTCLEAR permesso + solo se UPDTYPE eguale a *NEST o *BOTH.') ADDMSGD MSGID(JNR1006) MSGF(NERONI2/JNSTRPG) MSG('NESTCLEAR permesso + solo se assenti NESTCONT e NESTZERO.') ADDMSGD MSGID(JNR1007) MSGF(NERONI2/JNSTRPG) MSG('ALIGNSTEP permesso + solo se UPDTYPE eguale a *ALIGN o *BOTH.') ADDMSGD MSGID(JNR1008) MSGF(NERONI2/JNSTRPG) MSG('ALIGNCALC permesso + solo se UPDTYPE eguale a *ALIGN o *BOTH.') //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPGC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Nest RPG source. Cpp */ /* Claudio Neroni 08/12/2000 Creato. */ /* */ PGM PARM(&FILELIB &MBR &UPDTYPE &NESTLOC + &NESTCONT &NESTZERO &NESTUSE &NESTCLEAR + &ALIGNSTEP) /* File source qualificato. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Membro da modificare. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* Tipo di modifica. */ DCL VAR(&UPDTYPE) TYPE(*CHAR) LEN(6) /* Posizione dell'annidamento. */ DCL VAR(&NESTLOC) TYPE(*CHAR) LEN(7) /* Simbolo di continuazione dell'annidamento. */ DCL VAR(&NESTCONT) TYPE(*CHAR) LEN(1) /* Simbolo di livello zero dell'annidamento. */ DCL VAR(&NESTZERO) TYPE(*CHAR) LEN(2) /* Solo numeri possibili nell'annidamento. */ DCL VAR(&NESTUSE) TYPE(*CHAR) LEN(4) /* Pulizia della locazione di annidamento. */ DCL VAR(&NESTCLEAR) TYPE(*CHAR) LEN(4) /* Gradino dell'allineamento. */ DCL VAR(&ALIGNSTEP) TYPE(*DEC) LEN(3 0) /* Allinea specifiche di calcolo "C* ". */ DCL VAR(&ALIGNCALC) TYPE(*CHAR) LEN(4) /* File source. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Tipo di seu. */ DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) /* Tipo di file. */ DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) /* Lunghezza record del file. */ DCL VAR(&MRL) TYPE(*DEC) LEN(5 0) DCL VAR(&MRLA) TYPE(*CHAR) LEN(5) /* Numero di record nel membro. */ DCL VAR(&NR) TYPE(*DEC) LEN(10 0) /* Tipo di sentiero di accesso del file. */ DCL VAR(&APT) TYPE(*CHAR) LEN(2) /* Numero di overflow nell'allineamento commenti. */ DCL VAR(&OVFCNT) TYPE(*DEC) LEN(7 0) DCL VAR(&OVFCNTA) TYPE(*CHAR) LEN(4) /* Identificazione messaggio. */ DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Recupera le caratteristiche del file. */ JRTVFD FILE(&FILE) LIB(&LIB) MAXRCDLEN(&MRL) + ACCPTHTYP(&APT) /* Controlla l'esistenza e recupera le caratteristiche */ /* del membro da annidare. */ RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) + FILETYPE(&FILETYPE) SRCTYPE(&SRCTYPE) + NBRCURRCD(&NR) /* Se il file non è di tipo source, messaggia e rilascia. */ IF COND(&FILETYPE *NE *SRC) THEN(DO) SNDPGMMSG MSGID(JNR0001) MSGF(JNSTRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il TipoSeu non è RPG, messaggia e rilascia. */ IF COND((&SRCTYPE *NE RPG) *AND (&SRCTYPE *NE + RPG38) *AND (&SRCTYPE *NE RPGLE) *AND + (&SRCTYPE *NE SQLRPG) *AND (&SRCTYPE *NE + SQLRPGLE)) THEN(DO) SNDPGMMSG MSGID(JNR0002) MSGF(JNSTRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR *CAT &SRCTYPE) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il membro è vuoto, messaggia e rilascia. */ IF COND(&NR *EQ 0) THEN(DO) SNDPGMMSG MSGID(JNR0003) MSGF(JNSTRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se la Lunghezza record non è sufficiente a contenere l'istruzione, */ /* messaggia e rilascia. */ IF COND((&SRCTYPE *EQ RPG *OR &SRCTYPE *EQ + RPG38 *OR &SRCTYPE *EQ SQLRPG) *AND (&MRL + *LT 71) *OR (&SRCTYPE *EQ RPGLE *OR + &SRCTYPE *EQ SQLRPGLE) *AND (&MRL *LT + 92)) THEN(DO) CALL PGM(JCVPNPC) PARM(&MRL &MRLA 5) SNDPGMMSG MSGID(JNR0004) MSGF(JNSTRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MRLA *CAT &SRCTYPE) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se richiesto annidamento e */ /* se la Lunghezza record non è sufficiente a contenere l'annidamento, */ /* messaggia e rilascia. */ IF COND(&UPDTYPE *EQ *NEST *OR &UPDTYPE *EQ + *BOTH) THEN(DO) IF COND(&SRCTYPE *EQ RPG *OR &SRCTYPE *EQ RPG38 + *OR &SRCTYPE *EQ SQLRPG) THEN(DO) IF COND((&NESTLOC *EQ *EXT) *AND (&MRL *LT 95)) + THEN(GOTO CMDLBL(ERRLEN)) IF COND((&NESTLOC *EQ *END) *AND (&MRL *LT 92)) + THEN(GOTO CMDLBL(ERRLEN)) IF COND((&NESTLOC *EQ *COMBEG) *AND (&MRL *LT + 74)) THEN(GOTO CMDLBL(ERRLEN)) ENDDO IF COND(&SRCTYPE *EQ RPGLE *OR &SRCTYPE *EQ + SQLRPGLE) THEN(DO) IF COND((&NESTLOC *EQ *EXT) *AND (&MRL *LT + 115)) THEN(GOTO CMDLBL(ERRLEN)) IF COND((&NESTLOC *EQ *END) *AND (&MRL *LT + 112)) THEN(GOTO CMDLBL(ERRLEN)) IF COND((&NESTLOC *EQ *COMBEG) *AND (&MRL *LT + 95)) THEN(GOTO CMDLBL(ERRLEN)) ENDDO GOTO CMDLBL(ERRLENEND) ERRLEN: CALL PGM(JCVPNPC) PARM(&MRL &MRLA 5) SNDPGMMSG MSGID(JNR0005) MSGF(JNSTRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MRLA *CAT &NESTLOC) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ERRLENEND: ENDDO /* Dealloca e alloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000) ALCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) WAIT(5) /* Se il file non è in sequenza d'arrivo, riorganizza il membro. */ IF COND(&APT *NE AR) THEN(DO) RGZPFM FILE(&LIB/&FILE) MBR(&MBR) KEYFILE(*FILE) ENDDO /* Ridirige la lettura sul membro. */ OVRDBF FILE(SOURCE) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) /* Esegue l'annidamento sul membro. */ IF COND(&SRCTYPE *EQ RPG *OR &SRCTYPE *EQ RPG38 + *OR &SRCTYPE *EQ SQLRPG) THEN(DO) CALL PGM(JNSTRPGD) PARM(&UPDTYPE &NESTLOC + &NESTCONT &NESTZERO &NESTUSE &NESTCLEAR + &ALIGNSTEP &ALIGNCALC &OVFCNT) ENDDO IF COND(&SRCTYPE *EQ RPGLE *OR &SRCTYPE *EQ + SQLRPGLE) THEN(DO) CALL PGM(JNSTRPGE) PARM(&UPDTYPE &NESTLOC + &NESTCONT &NESTZERO &NESTUSE &NESTCLEAR + &ALIGNSTEP &ALIGNCALC &OVFCNT) ENDDO /* Manda un messaggio di completamento dell'esecuzione */ /* conforme alle funzioni svolte e al loro esito. */ IF COND(&UPDTYPE *EQ *NEST) THEN(DO) IF COND(&NESTCLEAR *EQ *NO) THEN(CHGVAR + VAR(&MSGID) VALUE(JNR0011)) IF COND(&NESTCLEAR *EQ *YES) THEN(CHGVAR + VAR(&MSGID) VALUE(JNR0012)) ENDDO IF COND(&UPDTYPE *EQ *ALIGN) THEN(DO) IF COND(&OVFCNT *EQ 0) THEN(CHGVAR VAR(&MSGID) + VALUE(JNR0013)) IF COND(&OVFCNT *GT 0) THEN(CHGVAR VAR(&MSGID) + VALUE(JNR0014)) ENDDO IF COND(&UPDTYPE *EQ *BOTH) THEN(DO) IF COND(&NESTCLEAR *EQ *NO) THEN(DO) IF COND(&OVFCNT *EQ 0) THEN(CHGVAR VAR(&MSGID) + VALUE(JNR0015)) IF COND(&OVFCNT *GT 0) THEN(CHGVAR VAR(&MSGID) + VALUE(JNR0016)) ENDDO IF COND(&NESTCLEAR *EQ *YES) THEN(DO) IF COND(&OVFCNT *EQ 0) THEN(CHGVAR VAR(&MSGID) + VALUE(JNR0017)) IF COND(&OVFCNT *GT 0) THEN(CHGVAR VAR(&MSGID) + VALUE(JNR0018)) ENDDO ENDDO CALL PGM(JCVPNPC) PARM(&OVFCNT &OVFCNTA 4) SNDPGMMSG MSGID(&MSGID) MSGF(JNSTRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR *CAT &SRCTYPE *CAT + &NESTLOC *CAT &OVFCNTA) MSGTYPE(*COMP) /* Label di esecuzione delle attività finali. */ RCLRSC: /* Dealloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000 MCH0000) /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JNSTRPG) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Label di errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Label di prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta alle attività finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPGD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Nest RPG source. UpdRpg&Rpgle * Claudio Neroni 08/12/2000 Creato. * Se attive le specifiche RPG: * Scrive annidamento e annida commenti su sorgente RPG. * Se attive le specifiche RPGLE: * Scrive annidamento e annida commenti su sorgente RPG ILE. * Claudio Neroni 17/10/2008 Modificato. * Gestito FOR in RPG ILE. Inutilmente definito anche in RPG * per non incorrere in asimmetrie. * Claudio Neroni 28/10/2008 Modificato. * Gestiti SQLRPG e SQLRPGLE. *--------------------------------------------------------------------- * Sorgente da annidare. RPGLEF**urce uf f 112 disk infds(Jfids) RPG Fsource uf f 95 disk infds(Jfids) *--------------------------------------------------------------------- * Lunghezza record della specifica F. RPGLED** lenf c 112 RPG D lenf c 92 *--------------------------------------------------------------------- * Interpreta il sorgente. D sourceds ds 95 * Istruzione. RPGLED**stm 13 112 RPG D stm 13 92 * Inizio dei Dati a tempo di compilazione. D ctd 13 15 * Tipo di riga. D typ 18 18 * Identificatore del commento. D idn 19 19 * Primo carattere dell'area istruzioni. D ais1 20 20 * Area istruzioni. RPGLED**ais 20 92 RPG D ais 20 71 * Codice operativo. RPGLED**do 38 39 RPG D do 40 41 RPGLED**if 38 39 RPG D if 40 41 RPGLED**when 38 41 RPG D when 40 41 RPGLED**cas 38 40 RPG D cas 40 42 RPGLED**end 38 40 RPG D end 40 42 RPGLED**else 38 41 RPG D else 40 43 RPGLED**select 38 43 RPG D select 40 44 RPGLED**other 38 42 RPG D other 40 44 RPGLED**begsr 38 42 RPG D begsr 40 44 RPGLED**endsr 38 42 RPG D endsr 40 44 RPGLED**kfld 38 41 RPG D kfld 40 43 RPGLED**parm 38 41 RPG D parm 40 43 RPGLED**for 38 40 RPG D for 40 42 *--------------------------------------------------------------------- * Costanti di comparazione. RPGLED**kwhen c 'WHEN' RPG D kwhen c 'WH' RPGLED**kselect c 'SELECT' RPG D kselect c 'SELEC' *--------------------------------------------------------------------- /COPY JNSTRPG,JNSTRPGH *--------------------------------------------------------------------- * Annota Etichetta sulla riga nella posizione richiesta. Osource e $updcal O 01 lbl 15 RPGLEO** 02 lbl 95 RPG O 02 lbl 74 RPGLEO** 03 lbl 112 RPG O 03 lbl 92 RPGLEO 04 lbl 95 * Allinea commento. Osource e $updcom RPGLEO** stm 112 RPG O stm 92 * Denuncia commento non allinealibile. Osource e $updnoa O 20 '?' *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPGE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Nest RPG source. UpdRpg&Rpgle * Claudio Neroni 08/12/2000 Creato. * Se attive le specifiche RPG: * Scrive annidamento e annida commenti su sorgente RPG. * Se attive le specifiche RPGLE: * Scrive annidamento e annida commenti su sorgente RPG ILE. * Claudio Neroni 17/10/2008 Modificato. * Gestito FOR in RPG ILE. Inutilmente definito anche in RPG * per non incorrere in asimmetrie. * Claudio Neroni 28/10/2008 Modificato. * Gestiti SQLRPG e SQLRPGLE. *--------------------------------------------------------------------- * Sorgente da annidare. RPGLEFsource uf f 115 disk infds(Jfids) RPG F**urce uf f 92 disk infds(Jfids) *--------------------------------------------------------------------- * Lunghezza record della specifica F. RPGLED lenf c 112 RPG D** lenf c 92 *--------------------------------------------------------------------- * Interpreta il sorgente. D sourceds ds 115 * Istruzione. RPGLED stm 13 112 RPG D**stm 13 92 * Inizio dei Dati a tempo di compilazione. D ctd 13 15 * Tipo di riga. D typ 18 18 * Identificatore del commento. D idn 19 19 * Primo carattere dell'area istruzioni. D ais1 20 20 * Area istruzioni. RPGLED ais 20 92 RPG D**ais 20 71 * Codice operativo. RPGLED do 38 39 RPG D**do 40 41 RPGLED if 38 39 RPG D**if 40 41 RPGLED when 38 41 RPG D**when 40 41 RPGLED cas 38 40 RPG D**cas 40 42 RPGLED end 38 40 RPG D**end 40 42 RPGLED else 38 41 RPG D**else 40 43 RPGLED select 38 43 RPG D**select 40 44 RPGLED other 38 42 RPG D**other 40 44 RPGLED begsr 38 42 RPG D**begsr 40 44 RPGLED endsr 38 42 RPG D**endsr 40 44 RPGLED kfld 38 41 RPG D**kfld 40 43 RPGLED parm 38 41 RPG D**parm 40 43 RPGLED for 38 40 RPG D**for 40 42 *--------------------------------------------------------------------- * Costanti di comparazione. RPGLED kwhen c 'WHEN' RPG D**kwhen c 'WH' RPGLED kselect c 'SELECT' RPG D**kselect c 'SELEC' *--------------------------------------------------------------------- /COPY JNSTRPG,JNSTRPGH *--------------------------------------------------------------------- * Annota Etichetta sulla riga nella posizione richiesta. Osource e $updcal O 01 lbl 15 RPGLEO 02 lbl 95 RPG O** 02 lbl 74 RPGLEO 03 lbl 112 RPG O** 03 lbl 92 RPGLEO 04 lbl 115 * Allinea commento. Osource e $updcom RPGLEO stm 112 RPG O** stm 92 * Denuncia commento non allinealibile. Osource e $updnoa O 20 '?' *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPGH) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *TITLE Nest RPG source. /copy * Claudio Neroni 08/12/2000 Creato. * Parte comune a RPG ed RPGLE. *--------------------------------------------------------------------- * File information data structure. D Jfids e ds *--------------------------------------------------------------------- * IndiceAnnidamentoIstruzioni. D nststm s 3 0 * IndiceAllineamentoCommenti. D alicom s 3 0 * Contatore di CompareAndExecuteSubroutine. D cntcas s 3 0 * EtichettaFunzione. D lblfnc s 1 * EtichettaAnnidamento. D lblnst s 2 * Etichetta. D lbl s 3 * SavedRelativeRecordNumber. D fidsrrsav s like(fidsrr) * RelativeRecordNumber inizio gruppo commenti. D grpbeg s like(fidsrr) * RelativeRecordNumber fine gruppo commenti. D grpend s like(fidsrr) * AllineamentoGruppoCommenti. D grpali s 3 0 * AllineamentoRecuperatoDelCommento. D rtvalicom s 3 0 *--------------------------------------------------------------------- * Dati del commento in overflow rispetto alla lunghezza record. D ovfdta s like(stm) * Inizio dei dati in overflow lungo il commento. D ovfbeg s 3 0 * Lunghezza dei dati in overflow a fine commento. D ovflen s 3 0 *--------------------------------------------------------------------- * Upper case. D uc c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' * Lower case. D lc c 'abcdefghijklmnopqrstuvwxyz' *--------------------------------------------------------------------- * Definisce i parametri per la subroutine rtva: * Recupera l'allineamento di un commento. * Riceve una stringa contenente un commento rpg. D rtvastr s like(stm) * Riceve il numero di caratteri del gradino di allineamento. D rtvastp s 3 0 * Restituisce l'allineamento del commento. * -2=Il commento è disallineato. * -1=Il commento è in bianco. * +0=Il commento inizia in posizione 9 * +1=Il commento inizia in posizione (9 + rtvastp * 1) * +2=Il commento inizia in posizione (9 + rtvastp * 2) * +n=Il commento inizia in posizione (9 + rtvastp * n) D rtvaali s 3 0 * Definisce i campi di lavoro per la subroutine rtva: * Recupera l'allineamento di un commento. * Posizione del primo carattere valorizzato dopo * l'identificazione del commento. D rtvapos s 3 0 * Intervallo di caratteri in bianco oltre il primo. D rtvabla s 3 0 * Disallineamento. D rtvadis s 3 0 *--------------------------------------------------------------------- * Definisce i parametri per la subroutine alcm: * Allinea un commento. * Riceve una stringa contenente un commento rpg. * Restituisce il commento allineato. D alcmstr s like(stm) * Riceve il numero di caratteri del gradino di allineamento. D alcmstp s 3 0 * Riceve l'allineamento da imporre al commento. * +0=Il commento inizierà in posizione 9 * +1=Il commento inizierà in posizione (9 + ppstp * 1) * +2=Il commento inizierà in posizione (9 + ppstp * 2) * +n=Il commento inizierà in posizione (9 + ppstp * n) D alcmali s 3 0 * Restituisce errore. D alcmerr s 1 * Definisce i campi di lavoro per la subroutine alcm: * Allinea un commento. * Stringa di transito. D alcmstr1 s like(alcmstr) * Stringa di transito grande almeno il doppio del transito 1. D alcmstr2 s 200 * Blank di comodo. D alcmblank s like(alcmstr) * Numero di blank da inserire. D alcmnrb s 3 0 * Posizione iniziale del testo del commento. D alcmpos s 3 0 *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve Tipo di modifica. C parm updtype 6 * Riceve Posizione dell'annidamento. C parm nestloc 7 * Riceve Simbolo di continuazione dell'annidamento. C parm nestcont 1 * Riceve Simbolo di livello zero dell'annidamento. C parm nestzero 2 * Riceve Solo numeri possibili nell'annidamento. C parm NESTUSE 4 * Riceve Pulizia della locazione dell'annidamento. C parm nestclear 4 * Riceve Gradino dell'allineamento. C parm alignstep 3 0 * Riceve Allinea specifiche di calcolo "C* ". C parm aligncalc 4 * Restituisce Contatore di allineamenti in overflow. C parm ovfcnt 7 0 * Pulisce i parametri di ritorno. C clear ovfcnt * Calcola la lunghezza del campo dati del commento. C lenf sub 19 cmle 3 0 * Sceglie la posizione di annidamento. C nestloc comp '*BEG' 01 C nestloc comp '*COMBEG' 02 C nestloc comp '*END' 03 C nestloc comp '*EXT' 04 * Azzera i campi di servizio dell'AllineamentoCommenti. C exsr allizero * Elabora tutte le righe del sorgente. C do *hival * Se è richiesto l'annidamento, C if updtype='*NEST' or updtype='*BOTH' * Legge una riga allocandola. C read source sourceds 50 * Se non è richiesto l'annidamento, C else * Legge una riga senza allocarla. C read(n) source sourceds 50 * Se non è richiesto l'annidamento, C endif * Se non ce ne sono altre, abbandona. C 50 leave * Se corre la prima riga dati a tempo di compilazione, abbandona. C if ctd='** ' C leave C endif * Rialza la riga. C lc:uc xlate sourceds sourceds * Il passaggio di una riga di tipo diverso dal calcolo * azzera i campi di servizio dell'AllineamentoCommenti. C if (typ='H' or typ='F' or typ='D' or !!! C typ='E' or C typ='I' or typ='O' or typ='P') and C idn<>'*' C exsr allizero C endif * Se corre un commento con interrogativo, * sbianca l'interrogativo * e annota AllineamentoGruppo in errore. C if idn='*' and ais1='?' C clear ais1 C z-add *loval grpali C endif * Se corre un'area istruzioni in bianco, ricicla. C if ais=*blank C iter C endif * Se corre un commento. C if idn='*' * Recupera l'allineamento del commento. C if 1=1 * Riceve una stringa contenente un commento rpg. C movel(p) stm rtvastr * Riceve il gradino di allineamento. C z-add alignstep rtvastp * Recupera l'allineamento del commento. C exsr rtva * Restituisce l'allineamento del commento. C z-add rtvaali rtvalicom * Recupera l'allineamento del commento. C endif * Se il commento è in bianco, ricicla. C if rtvalicom=-1 C iter C endif * Se l'AllineamentoGruppo non è ancora annotato, lo annota. C if grpali=*hival C z-add rtvalicom grpali C endif * Se l'Allineamento è diverso dall'AllineamentoGruppo, * annota AllineamentoGruppo in errore. C if rtvalicom<>grpali C z-add *loval grpali C endif * Se corre il primo commento di un gruppo, * ne annota il RelativeRecordNumber come primo del gruppo. C if grpbeg=*zero C z-add fidsrr grpbeg C endif * Annota il RelativeRecordNumber come ultimo del gruppo. C z-add fidsrr grpend * Ricicla. C iter * Se corre un commento. C endif * Se corre una riga diversa da calcolo, * o se corre una direttiva di compilazione, * o se corre una riga SQL, * ricicla. C if typ<>'C' or idn='/' or idn='+' C iter C endif * Se corre una istruzione diversa da CompareAndExecuteSubroutine, * ne azzera il contatore. C if cas<>'CAS' C clear cntcas C endif * Se corre una istruzione BeginSubroutine, * azzera IndiceAnnidamentoIstruzioni. C if begsr='BEGSR' C clear nststm C endif * Assume il SimboloContinuazione come EtichettaFunzione. C movel(p) nestcont lblfnc * Sceglie. C select * Se corre una istruzione di inizio. C when do='DO' or if='IF' or select=KSELECT C or for='FOR' * Incrementa IndiceAnnidamentoIstruzioni. C add 1 nststm * Assume Begin come EtichettaFunzione. C movel(p) 'B' lblfnc * Se corre una istruzione di alternativa. C when else='ELSE' or when=KWHEN or other='OTHER' * Assume X come EtichettaFunzione. C movel(p) 'X' lblfnc * Se corre una istruzione di fine. C when end='END' and endsr<>'ENDSR' * Assume End come EtichettaFunzione. C movel(p) 'E' lblfnc * Se corre una istruzione CompareAndExecuteSubroutine. C when cas='CAS' * Conta l'istruzione CAS. C add 1 cntcas * Se corre la prima CAS di un gruppo. C if cntcas=1 * Incrementa IndiceAnnidamentoIstruzioni. C add 1 nststm * Assume Begin come EtichettaFunzione. C movel(p) 'B' lblfnc * Se corre una CAS successiva nel gruppo. C else * Assume End come EtichettaFunzione. C movel(p) 'X' lblfnc * Se corre una CAS successiva nel gruppo. C endif * Sceglie. C endsl * Se l'IndiceAnnidamento è diverso da zero * o se l'EtichettaAnnidamento vale Inizio, Alternativa o Fine. C if nststm<>*zero or C (lblfnc='B' or lblfnc='X' or lblfnc='E') * Assume l'IndiceAnnidamentIstruzioni come EtichettaAnnidamento. C move(p) nststm lblnst * Negli altri casi. C else * Assume il SimboloLivelloZero come EtichettaAnnidamento. C move(p) nestzero lblnst * Negli altri casi. C endif * Per evitare la mezza Etichetta, * se corre EtichettaFunzione=SimboloContinuazione * ed EtichettaAnnidamento=blank, * pulisce anche EtichettaFunzione. C if lblfnc=nestcont and lblnst=*blank C clear lblfnc C endif * Se è richiesta eliminazione dei numeri * e se corre EtichettaFunzione=SimboloContinuazione=blank, * pulisce anche EtichettaFunzione. C if nestuse<>'*YES' and C lblfnc=nestcont and lblfnc=*blank C clear lblnst C endif * Compone Etichetta. C eval lbl=lblfnc+lblnst * Se richiesta pulizia, pulisce Etichetta. C if nestclear='*YES' C clear lbl C endif * Se è richiesto l'annidamento, * annota Etichetta sulla riga. C if updtype='*NEST' or updtype='*BOTH' C except $updcal C endif * Se è richiesto l'allineamento commenti * e se la riga congedata era preceduta da un gruppo di commenti. C if (updtype='*ALIGN' or updtype='*BOTH') C and grpbeg>*zero * Calcola l'AllineamentoCommenti. C select C when lblfnc='B' or lblfnc='X' or lblfnc='E' C nststm sub 1 alicom C when kfld='KFLD' or parm='PARM' C nststm add 1 alicom C other C z-add nststm alicom C endsl * Se l'AllineamentoCommenti calcolato è negativo, assume zero. C if alicom<*zero C clear alicom C endif * Se l'AllineamentoCommenti è diverso dall'AllineamentoGruppo, * allinea il gruppo commenti. C if alicom<>grpali C exsr alli C endif * Se è richiesto l'allineamento commenti * e se la riga congedata era preceduta da un gruppo di commenti. C endif * Azzera i campi di servizio dell'AllineamentoCommenti. C exsr allizero * Se EtichettaFunzione=End, decrementa IndiceAnnidamento. C if lblfnc='E' C sub 1 nststm C endif * Pulisce EtichettaFunzione. C clear lblfnc * Elabora tutte le righe del sorgente. C enddo * Predispone chiusura e ritorna. C seton lr *--------------------------------------------------------------------- * Allinea il gruppo commenti. C alli begsr * Salva il RelativeRecordNumber corrente. C z-add fidsrr fidsrrsav * Elabora il gruppo commenti. C grpbeg do grpend fidsrr * Legge un commento allocandolo. C fidsrr chain source sourceds 50 * Se non lo trova, ricicla. C 50 iter * Se corre un commento con interrogativo, sbianca l'interrogativo. C if idn='*' and ais1='?' C clear ais1 C endif * Se corre un commento con il primo carattere valorizzato, * ricicla. C if idn='*' and ais1<>*blank C iter C endif * Se corre una direttiva di compilazione, ricicla. C if idn='/' C iter C endif * Se corre una specifica di calcolo asteriscata "C* " * e non ne è richiesto l'allineamento, * ricicla. C if (typ='C' or typ='c') C and idn='*' C and ais1=*blank C and aligncalc<>'*YES' C iter C endif * Allinea il commento. C if 1=1 * Riceve una stringa contenente un commento rpg. C movel(p) stm alcmstr * Riceve il gradino di allineamento. C z-add alignstep alcmstp * Riceve l'allineamento da imporre al commento. C z-add alicom alcmali * Allinea il commento. C exsr alcm * Restituisce il commento allineato. C movel(p) alcmstr stm * Restituisce errore=*on. C movel(p) alcmerr pperr 1 * Allinea il commento. C endif * Esamina la parte di commento in overflow rispetto * alla capacità del record sorgente. * Se valorizzata, errore. C clear ovfdta C if fidsle*on and ovfdta=*blank * Ricalca il commento per allinearlo. C except $updcom * Se c'è overflow. C else * Denuncia commento non allineabile. C except $updnoa * Conta gli overflow. C add 1 ovfcnt * Se c'è overflow. C endif * Elabora il gruppo commenti. C enddo * Riposiziona la lettura oltre il SavedRelativeRecordNumber * per non interferire con il ciclo di elaborazione principale. C fidsrrsav setgt source C endsr *--------------------------------------------------------------------- * Azzera i campi di servizio dell'AllineamentoCommenti. C allizero begsr C clear grpbeg C clear grpend C eval grpali=*hival C endsr *--------------------------------------------------------------------- * Recupera l'allineamento di un commento. C rtva begsr * Pulisce i parametri di ritorno. C clear rtvaali * Esegue. C do * Cerca il primo carattere valorizzato dopo * l'identificazione del commento. C ' ' check rtvastr:8 rtvapos * Se il commento è vuoto. C rtvapos ifeq *zero * Restituisce un valore convenzionale per * CommentoVuoto. C z-add -1 rtvaali * Abbandona. C leave * Se il commento è vuoto. C endif * Calcola l'intervallo di caratteri in bianco oltre il primo. C rtvapos sub 9 rtvabla * Se il gradino vale zero. C if rtvastp=*zero * Se l'intervallo è nullo. C if rtvabla=*zero * Restituisce l'allineamento riscontrato. C z-add +0 rtvaali * Se l'intervallo non è nullo. C else * Restituisce un valore convenzionale per * CommentoDisallineato. C z-add -2 rtvaali * Se l'intervallo non è nullo. C endif * Abbandona. C leave * Se il gradino vale zero. C endif * Calcola l'allineamento. C rtvabla div rtvastp rtvaali * Calcola il disallineamento. C mvr rtvadis * Se esiste un disallineamento. C rtvadis ifne *zero * Restituisce un valore convenzionale per * CommentoDisallineato. C z-add -2 rtvaali * Abbandona. C leave * Se esiste un disallineamento. C endif * Esegue. C enddo C endsr *--------------------------------------------------------------------- * Allinea un commento. C alcm begsr * Pulisce i parametri di ritorno. C clear alcmerr * Esegue. C do * Cerca il primo carattere valorizzato dopo * l'identificazione del commento. C ' ' check alcmstr:8 alcmpos * Se il commento è vuoto, abbandona. C alcmpos ifeq *zero C leave C endif * Calcola il numero di caratteri in bianco da inserire * tra l'identificazione del commento e il testo del commento. C eval alcmnrb=1+alcmstp*alcmali * Compone il nuovo commento. C eval alcmstr2= C %subst(alcmstr:1:7)+ C %subst(alcmblank:1:alcmnrb) + C %trim(%subst(alcmstr:8:cmle)) * Accorcia il nuovo commento. C movel(p) alcmstr2 alcmstr1 * Se si perdono dati in fondo al commento. C if alcmstr1<>alcmstr2 * Segnala l'errore. C movel *on alcmerr * Abbandona. C leave * Se si perdono dati in fondo al commento. C endif * Restituisce il commento modificato. C movel(p) alcmstr1 alcmstr * Esegue. C enddo C endsr *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPGP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') :PNLGRP. .*--------------------------------------------------------------------- :HELP NAME=CMD. :H3.Comando JNSTRPG :H2.Annida le istruzioni RPG ed allinea i commenti :P.Il comando permette di annotare le etichette di annidamento del tipo B01 .01 .X01 .01 E01 in una posizione prefissata lungo le istruzioni dei sorgenti RPG, RPG38, SQLRPG, RPGLE o SQLRPGLE. :P.In aggiunta o in alternativa è possibile allineare le righe di commento presenti tra le istruzioni in modo che l'inizio di ogni commento sia allineato con criteri derivati all'annidamento. :P.Con la scelta :HP1.NESTCLEAR(*YES):EHP1. è possibile pulire sulle istruzioni le posizioni destinate alle etichette. :P.Si definisce :HP2.EtichettaAnnidamento:EHP2. il gruppo di caratteri :HP2.xyy:EHP2. dove :HP2.x=EtichettaFunzione:EHP2. e :HP2.yy=EtichettaLivello:EHP2. :P.Per la definizione operativa di EtichettaFunzione ed EtichettaLivello, vedi il parametro :HP1.UPDTYPE(*NEST):EHP1.. :P.Il sorgente esemplificato di seguito fa da base agli esempi successivi. :XMP. * Tergiversa. C ... * Se piove. C if * Il governo è ladro. C ... * Se non piove. C else * Ripete 10 volte. C do 10 * Un furto senza ombrello. C ... * Ripete 10 volte. C enddo * Se non piove. C endif :EXMP. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/srcfile'. :H3.Source file (SRCFILE) - file :P.Nome del file sorgente in cui risiede il membro da modificare. :P.Valori permessi: :PARML. :PT.nome-file-sorgente € :PD.Il valore è obbligatorio. :EPARML. :H3.Source file (SRCFILE) - library :P.Nome della libreria in cui risiede il file. :P.Valori permessi: :PARML. :PT.:PK DEF.*LIBL:EPK.€ :PD.Il file sorgente viene cercato in lista librerie. :PT.nome-libreria :PD.Il file sorgente viene cercato nella libreria richiesta. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/srcmbr'. :H3.Source member (SRCMBR) :P.Nome del membro sorgente da modificare. :P.Valori permessi: :PARML. :PT.nome-membro-sorgente € :PD.Il valore è obbligatorio. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/updtype'. :H3.Update type (UPDTYPE) :P.Tipo di modifica da apportare al sorgente. :P.Valori permessi: :PARML. :PT.:PK DEF.*NEST:EPK.€ :PD.Annida il sorgente scrivendo le EtichetteAnnidamento nella locazione richiesta. :P.Le etichette vengono generate usando le stesse regole delle liste di compilazione ottenibili con i comandi CRTRPGPGM o CRTBNDRPG, e, per SQL CRTSQLRPG o CRTSQLRPGI. :P.Si definiscono istruzioni di inizio e assumono B come EtichettaFunzione: IF, DO, SELECT e la prima CAS di un gruppo. :P.Si definiscono istruzioni di alternativa e assumono X come EtichettaFunzione: ELSE, WHEN, OTHER e le successive CAS di un gruppo. :P.Si definiscono istruzioni di fine e assumono E come EtichettaFunzione: tutte le END ad eccezione di ENDSR. :P.L'annidamento viene calcolato con le seguenti regole. :PC.  1) Parte da zero. :PC.  2) Si alza di uno prima di una istruzione di inizio. :PC.  3) Si abbassa di uno dopo una istruzione di fine. :PC.  4) Si azzera prima di una istruzione BEGSR. :PC.L'EtichettaLivello deriva dall'annidamento così calcolato con le eccezioni presentate nella parola chiave :HP1.NESTZERO:EHP1.. :P.La presenza di EtichetteLivello 0J, 0K, 0L, ... deriva dall'annidamento negativo provocato da una sequenza errata di istruzioni. Si fa notare che ad ogni inizio subroutine l'annidamento viene azzerato e che perciò un errore di annidamento non si trasmette oltre la subroutine in cui avviene. :P.Segue il sorgente di esempio manipolato secondo la presente opzione e presumendo :HP1.NESTLOC(*BEG):EHP1.. :XMP. * Tergiversa. C ... * Se piove. B01 C if * Il governo è ladro. 01 C ... * Se non piove. X01 C else * Ripete 10 volte. B02 C do 10 * Un furto senza ombrello. 02 C ... * Ripete 10 volte. E02 C enddo * Se non piove. E01 C endif :EXMP. :PT.*ALIGN :PD.Allinea i commenti conformemente all'annidamento purché non si perdano dati in coda ai commenti stessi. :P.Tutte le righe di un gruppo di commenti assumono un allineamento uguale all'annidamento calcolato per l'istruzione che segue immediatamente il gruppo di commenti. Fanno eccezione le istruzioni di inizio, di alternativa e di fine per le quali l'allineamento viene diminuito di 1. Altra eccezione per le istruzioni di campo chiave o parametro (kfld, parm), per le quali l'allineamento viene aumentato di 1. :P.Il numero di caratteri in bianco, da intromettere tra l'asterisco che identifica il commento e l'inizio del testo di commento, viene calcolato moltiplicando l'allineamento per il gradino specificato nella parola chiave :HP1.ALIGNSTEP:EHP1. e aggiungendo 1. :P.Il commento non allineabile viene contrassegnato con un interrogativo in posizione 8. Nei run successivi tale interrogativo viene trattato come se fosse un blank. :P.I commenti che hanno la posizione 8 diversa da blank e da "?" non vengono mai allineati. :P.Se l'allineamento commenti, a causa di annidamenti in errore, risulta negativo, viene assunto uguale a 0. Vedi la parola chiave :HP1.ALIGNSTEP:EHP1. per un esempio di allineamento 0. :P.Segue il sorgente di esempio manipolato secondo la presente opzione. :NOTE.Per una migliore comprensione delle regole di allineamento, consultare invece l'esempio relativo a :HP1.UPDTYPE(*BOTH):EHP1.. :ENOTE. :XMP. * Tergiversa. C ... * Se piove. C if * Il governo è ladro. C ... * Se non piove. C else * Ripete 10 volte. C do 10 * Un furto senza ombrello. C ... * Ripete 10 volte. C enddo * Se non piove. C endif :EXMP. :PT.*BOTH :PD.Esegue sia l'annidamento delle istruzioni che l'allineamento dei commenti. :P.Segue il sorgente di esempio manipolato secondo la presente opzione e presumendo :HP1.NESTLOC(*BEG):EHP1.. :XMP. * Tergiversa. C ... * Se piove. B01 C if * Il governo è ladro. 01 C ... * Se non piove. X01 C else * Ripete 10 volte. B02 C do 10 * Un furto senza ombrello. 02 C ... * Ripete 10 volte. E02 C enddo * Se non piove. E01 C endif :EXMP. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/nestloc'. :H3.Nest location (NESTLOC) :P.Locazione lungo l'istruzione ove annotare le EtichetteAnnidamento. :P.Valori permessi: :PARML. :PT.:PK DEF.*END:EPK.€ :PD.L'EtichettaAnnidamento verrà annotata in fondo all'istruzione nelle posizioni 78-80 per tipo seu RPG, RPG38 e SQLRPG e nelle posizioni 98-100 per tipo seu RPGLE e SQLRPGLE. :PT.*COMBEG :PD.L'EtichettaAnnidamento verrà annotata alll'inizio del campo commenti nelle posizioni 60-62 per tipo seu RPG, RPG38 e SQLRPG e nelle posizioni 81-83 per tipo seu RPGLE e SQLRPGLE. :PT.*BEG :PD.L'EtichettaAnnidamento verrà annotata alll'inizio dell'istruzione nelle posizioni 1-3 per tutti i tipi seu. :PT.*EXT :PD.L'EtichettaAnnidamento verrà annotata esternamente all'istruzione nelle posizioni 81-83 per tipo seu RPG, RPG38 e SQLRPG e nelle posizioni 101-103 per tipo seu RPGLE e SQLRPGLE. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/nestcont'. :H3.Nest continuation symbol (NESTCONT) :P.Simbolo di continuazione usato come primo carattere dell'etichetta (EtichettaFunzione) quando non sia già B=Inizio, X=Alternativa, E=Fine. :P.Valori permessi: :LINES. :HP3.*BLANK:EHP3. :HP2.. : _ = ^ " + - ! < > ° * ' / % N :EHP2. :ELINES. :NOTE.Per la visualizzazione completa e aggiornata dei valori permessi è preferibile consultare l'elenco ottenibile dal prompter battendo F4 invece che F1. :ENOTE. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/nestzero'. :H3.Nest zero level symbol (NESTZERO) :P.Simbolo da usare come secondo e terzo carattere dell'etichetta (EtichettaLivello) per significare il livello di annidamento zero. :P.Valori permessi: :PARML. :PT.:PK DEF.*BLANK:EPK.€ :PD.L'etichetta "x00" non viene scritta. :PT.*ZERO :PD.L'etichetta "x00" viene scritta. :EPARML. :NOTE."x" è il carattere scelto tramite NESTCONT come EtichettaFunzione. :ENOTE. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/nestuse'. :H3.Nest use continuation (NESTUSE) :P.Sceglie se scrivere l'EtichettaLivello anche sulle istruzioni senza l'EtichettaFunzione. :P.Valori permessi: :PARML. :PT.:PK DEF.*NO:EPK.€ :PD.L'EtichettaLivello viene scritta solo se scritta anche l'EtichettaFunzione. :PT.*YES :PD.L'EtichettaLivello viene scritta anche dove non è prevista l'EtichettaFunzione. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/nestclear'. :H3.Nest clear (NESTCLEAR) :P.Pulisce le istruzioni nella stessa posizione nella quale verrebbero annotate le EtichetteAnnidamento. :P.La posizione è quella specificata nella parola chiave :HP1.NESTLOC:EHP1.. :P.Valori permessi: :PARML. :PT.:PK DEF.*NO:EPK.€ :PD.La pulizia non viene eseguita. :PT.*YES :PD.La pulizia viene eseguita. Prerequisito è :HP1.UPDTYPE(*NEST):EHP1. oppure :HP1.UPDTYPE(*BOTH):EHP1.. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/alignstep'. :H3.Alignment step (ALIGNSTEP) :P.Gradino di allineamento dei commenti. :P.E' il numero di caratteri in bianco che diversificano due commenti con i livelli di allineamento differenti di una unità. :P.Ogni valore della lista è seguito da un esempio di tre commenti con allineamento 0, 1 e 2. :NOTE.Dagli esempi risulta che l'allineamento zero non risente del valore richiesto come gradino. :ENOTE. :P.Valori permessi: :PARML. :PT.:PK DEF.3:EPK.€ :PD.Il gradino di allineamento vale tre caratteri. :XMP. *..1....+....2....+....3....+ * Allineamento 0 * Allineamento 1 * Allineamento 2 :EXMP. :PT.0 :PD.Il valore 0 provoca l'allineamento uguale per tutti i livelli di commento alla posizione 9. :XMP. *..1....+....2....+....3....+ * Allineamento 0 * Allineamento 1 * Allineamento 2 :EXMP. :PT.1-10 :PD.Il gradino di allineamento vale il numero di caratteri richiesto. Segue esempio con gradino 5. :XMP. *..1....+....2....+....3....+ * Allineamento 0 * Allineamento 1 * Allineamento 2 :EXMP. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/aligncalc'. :H3.Align "C* " specifications (ALIGNCALC) :P.Allinea le specifiche di commento che nelle posizioni 6-8 portano "C* ". Tali specifiche potrebbero essere non commenti ma specifiche di calcolo asteriscate e perciò da non allineare. :P.Valori permessi: :PARML. :PT.:PK DEF.*NO:EPK.€ :PD.Non allinea le specifiche "C* " :PT.*YES :PD.Allinea anche le specifiche "C* " :EPARML. :EHELP. .*--------------------------------------------------------------------- :EPNLGRP. //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPGTST) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *ESEMPIO:INIZIO ....+ * A00::::::::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A00::::::::::::::....3....+....4....+....5....+....6....+....7....+° C DO *hival ....+ * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C IF a=b ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C SELECT ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C WHEN a=b ....+ * A03:::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C WHEN a=b ....+ * A03:::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C OTHER * 4444444...................................................° C if 4=4 * 4444444................................................° C z-add 4 a4 * 4444444...................................................° C else * Maramao. C if 4=4 * Maramao perché sei morto? C z-add 4 a4 * Pan e vin non ti mancavan. C else * L'insalata era nell'orto e una casa avevi tu. C endif * 4444444...................................................° C endif ....+ * A03:::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C ENDSL ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C ELSE ....+ * A02::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C ENDIF ....+ * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y ....+ * A00::::::::::::::....3....+....4....+....5....+....6....+....7....+° C ENDDO * Barabba. C eval x=y * Barabba. C ENDDO * Barabba. C end * Barabba. C ENDDO * Barabba. C eval x=y * Barabba. C eval x=y *---------------------------------------------------------------- * Barabba. C xx begsr * Barabba. C eval x=y * Barabba. C if 4=4 * Barabba. C if 4=4 * Barabba. C if 4=4 * Barabba. C eval x=y * Barabba. C ENDif * Barabba. C eval x=y * Barabba. C ENDif * Barabba. C eval x=y * Barabba. C ENDif * Barabba. C eval x=y * Barabba. * Barabba. C eval x=y * Barabba. * Barabba. C eval x=y * Barabba. C a CASEQ 1 SR1 * Barabba. C a CASEQ 2 SR2 * Barabba. C CAS SR9 * Barabba. C ENDCS * Barabba. C eval x=y * Barabba. C if 4=4 * Barabba. C z-add 4 a4 * Barabba. C else * Barabba. C z-add 4 a4 * Barabba. C endif * Barabba. C endsr *---------------------------------------------------------------- ** Schiere a tempo di compilazione abcdefghijklmnopqrstuvwxyz * Maramao. C if 4=4 * Maramao perché sei morto? C z-add 4 a4 * Pan e vin non ti mancavan. C else * L'insalata era nell'orto e una casa avevi tu. C endif //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JNSTRPGTS1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *ESEMPIO:INIZIO * A00::::::::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A00::::::::::::::....3....+....4....+....5....+....6....+....7....+° C DO *hival * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C IF a=b * A02::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A02::::::::....3....+....4....+....5....+....6....+....7....+° C SELECT * A02::::::::....3....+....4....+....5....+....6....+....7....+° C WHEN a=b * A03:::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A02::::::::....3....+....4....+....5....+....6....+....7....+° C WHEN a=b * A03:::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A02::::::::....3....+....4....+....5....+....6....+....7....+° C OTHER * 4444444...................................................° C if 4=4 * 4444444................................................° C z-add 4 a4 * 4444444...................................................° C else * Maramao. C if 4=4 * Maramao perché sei morto? C z-add 4 a4 * Pan e vin non ti mancavan. C else * L'insalata era nell'orto e una casa avevi tu. C endif * 4444444...................................................° C endif * A03:::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A02::::::::....3....+....4....+....5....+....6....+....7....+° C ENDSL * A02::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C ELSE * A02::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C ENDIF * A01:::::::::::....3....+....4....+....5....+....6....+....7....+° C eval x=y * A00::::::::::::::....3....+....4....+....5....+....6....+....7....+° C ENDDO * Barabba. C eval x=y * Barabba. C ENDDO * Barabba. C end * Barabba. C ENDDO * Barabba. C eval x=y * Barabba. C eval x=y *---------------------------------------------------------------- * Barabba. C xx begsr * Barabba. C eval x=y * Barabba. C if 4=4 * Barabba. C if 4=4 * Barabba. C if 4=4 * Barabba. C eval x=y * Barabba. C ENDif * Barabba. C eval x=y * Barabba. C ENDif * Barabba. C eval x=y * Barabba. C ENDif * Barabba. C eval x=y * Barabba. * Barabba. C eval x=y * Barabba. * Barabba. C eval x=y * Barabba. C a CASEQ 1 SR1 * Barabba. C a CASEQ 2 SR2 * Barabba. C CAS SR9 * Barabba. C ENDCS * Barabba. C eval x=y * Barabba. C if 4=4 * Barabba. C z-add 4 a4 * Barabba. C else * Barabba. C z-add 4 a4 * Barabba. C endif * Barabba. C endsr *---------------------------------------------------------------- ** Schiere a tempo di compilazione abcdefghijklmnopqrstuvwxyz * Maramao. C if 4=4 * Maramao perché sei morto? C z-add 4 a4 * Pan e vin non ti mancavan. C else * L'insalata era nell'orto e una casa avevi tu. C endif //ENDSRC //ENDBCHJOB