| 
*
* CHXCMDCPP, modifié pour manipuler le user space par pointeurs
*
* (les lignes modifiées sont marquées par '>>>>')
*================================================================
FCHXCMDD CF E WORKSTN INFDS(INFODS)
F SFILE(FMTSFL:RANG)
D CTX C CONST('LISTE DES CDES')
D MTX C CONST('Liste en cours..')
D MTX2 C CONST('Liste terminée ')
* RANG DU PREMIER ENREG AFFICHé (==> SFLRCDNBR)
D INFODS DS
D L2 378 379B 0
* ENTETE USER SPACE
>>>> Dspcptr s *
>>>> D RTVINF DS based(spcptr)
>>>> D decal 124
D FIN 9B 0
D TAILLE 9B 0
D NBOBJ 9B 0
D LGPOST 9B 0
* DEFINITION D'UN OBJET
>>>> Dlistptr s *
>>>> D LIST DS based(listptr)
D OBJNAM 1 10
D OBJLIB 11 20
D OBJQ 1 20
D OBJTYP 21 30
D TEXTE 42 91
* DECLARATION DE VARIABLES de travail
* (avant le programme utilisait OBJTYP et TAILLE)
>>>> Dwtyp s 10
>>>> Dwtaille s 9b 0
* DECLARATION DE VARIABLES BINAIRES
D BINDS DS
D DEBUT 1 4B 0
D LG 5 8B 0
D LGRCV 9 12B 0
* QUALIF/ USER SPACE ET CMDE
D QUALDS DS
D SPCNAM 1 10
D SPCLIB 11 20
D USRSPC 1 20
D CMDE 21 30
|
|
D BIBLI 31 40 D CMDQ 21 40 * CODE ERREUR API D ERRDS DS D LGDS 1 4B 0 D LGERR 5 8B 0 D MSGID 9 15 D RESERV 16 16 * VAR POUR API ENVOI DE MESSAGE D MSGDS DS D MSGF 1 10 D MSGL 11 20 D MSGFL 1 20 D LENTXT 21 24B 0 D STACK 25 28B 0 D KEY 29 32B 0 C *ENTRY PLIST C CMDQ PARM OBJBIB 20 * C CMDE IFEQ *BLANK C MOVEL '*ALL' CMDE C ENDIF C BIBLI IFEQ *BLANK C MOVEL '*USRLIBL' BIBLI C ENDIF >>>> C MOVEL '*CMD' WTYP * C WRITE CDE * ENVOI MESSAGE STATUS "LISTE EN COURS" C Z-ADD 16 LGDS C MOVEL 'QCPFMSG' MSGF C MOVEL '*LIBL' MSGL C MOVEL MTX MSGTXT C CALL 'QMHSNDPM' C PARM 'CPF9898' ID 7 C PARM MSGFL C PARM MSGTXT 50 C PARM 50 LENTXT C PARM '*STATUS' MSGTYP 10 C PARM '*EXT' PGMQ 10 C PARM 0 STACK C PARM KEY C PARM ERRDS * CHARGEMENT SOUS FICHIER |
|
C EXSR CHGT * C NBOBJ IFGT 0 * ENVOI MESSAGE STATUS "LISTE TERMINEE" C MOVEL MTX2 MSGTXT C CALL 'QMHSNDPM' C PARM 'CPF9898' ID 7 C PARM MSGFL C PARM MSGTXT 50 C PARM 50 LENTXT C PARM '*STATUS' MSGTYP 10 C PARM '*EXT' PGMQ 10 C PARM 0 STACK C PARM KEY C PARM ERRDS * C MOVE *ON *IN40 C MOVEL '*' SFLQ * C *IN03 DOUEQ *ON C WRITE ERRCTL C EXFMT FMTCTL C *IN03 IFEQ *OFF C Z-ADD L2 LIGNE * REMOVE DES MESSAGES RECUS C CALL 'QMHRMVPM' C PARM '*' PGMQ C PARM 0 STACK C PARM ' ' KEYC 4 C PARM '*OLD' RMVTYP 10 C PARM ERRDS C EXSR TRT C ENDIF C ENDDO C* USER SPACE NON VIDE C ENDIF C MOVE *ON *INLR C EXSR DLTUS * C CHGT BEGSR C MOVEL 'CHXCMD' SPCNAM C MOVEL 'QTEMP' SPCLIB C MOVEL 'LISTFMT ' EXT 10 >>>> C Z-ADD 1024 WTAILLE |
|
C MOVE ' ' INT 10 C MOVEL '*USE' AUT 10 C MOVEL CTX TXT 50 * dlt du user space si présent dans QTEMP C EXSR DLTUS * CREATION USER SPACE PAR API QUSCRTUS C CALL 'QUSCRTUS' C PARM USRSPC C PARM EXT >>>> C PARM WTAILLE C PARM INT C PARM AUT C PARM TXT * REMPLISSAGE DU USER SPACE VIA API (LISTE DES OBJETS) C CALL 'QUSLOBJ' 99 C PARM USRSPC C PARM 'OBJL0200' FMT 8 C PARM CMDQ >>>> C PARM WTYP C *IN99 IFEQ *OFF >>>> * retrouve pointeur de début >>>> C CALL 'QUSPTRUS' >>>> C PARM USRSPC >>>> C PARM spcptr >>>> C eval listptr = spcptr >>>> C eval listptr = listptr + fin C ENDIF C *IN99 IFEQ *OFF C NBOBJ ANDGT 0 C Z-ADD 0 RANG 4 0 C MOVEA '00' *IN(30) C WRITE FMTCTL C MOVE *ON *IN30 C Z-ADD 1 LIGNE * * BOUCLE SUR NOMBRE DE MEMBRES EXTRAITS * C DO NBOBJ >>>> * pas d'extraction (la strusture LIST "pointe" directement >>>> * sur un élément DANS le User Space.) C MOVE *ON *IN31 C ADD 1 RANG C WRITE FMTSFL * POSITIONNEMENT SUR PROCHAIN POSTE |
|
>>>> C eval listptr = listptr + lgpost C ENDDO * fin des modifs. C ENDIF C ENDSR * * C TRT BEGSR C READC FMTSFL 41 C *IN41 DOWEQ *OFF C SELECT C OPT WHENEQ '1' C '?' CAT(P) OBJLIB:1 EXEC 256 C CAT '/':0 EXEC C CAT OBJNAM:0 EXEC C CALL 'QCMDEXC' 97 C PARM EXEC C PARM 256 EXECL 15 5 C OPT WHENEQ '5' C '?' CAT(P) OBJLIB:1 EXEC 256 C CAT '/':0 EXEC C CAT OBJNAM:0 EXEC C CALL 'QCMDCHK' 97 C PARM EXEC C PARM 256 EXECL 15 5 C OPT WHENEQ '8' C 'DSPCMD' CAT(P) OBJLIB:1 EXEC 256 C CAT '/':0 EXEC C CAT OBJNAM:0 EXEC C CALL 'QCMDEXC' 97 C PARM EXEC C PARM 256 EXECL 15 5 C ENDSL C MOVE ' ' OPT C UPDATE FMTSFL C READC FMTSFL 41 C ENDDO C ENDSR * C DLTUS BEGSR * DLT DU USER SPACE (Y COMPRIS EN CAS DE PLANTUS) API QUSDLTUS C Z-ADD 16 LGDS C CALL 'QUSDLTUS' 99 C PARM USRSPC |
|
C PARM ERRDS C ENDSR * C *PSSR BEGSR C *IN98 IFEQ *ON C MOVE *ON *INLR C RETURN C ELSE C MOVE *ON *IN98 C EXSR DLTUS * RENVOI LE DERNIER MESSAGE *ESCAPE C CALL 'QMHRSNEM' C PARM ' ' KEYC C PARM ERRDS C ENDIF C ENDSR |
