PMOD TITLE '**ENTRY** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * LOG * CHANGE LOG * * * ******************************************************************* * SPACE * LOG 10/02/84 *** RELEASE 5 NOW IN * 841003 "SEND SIGNAL__ ___ XXXXXXXX" COMMAND ADDED * 841003 SIGNAL EDIT CHECK SETS IMPLIED 00010000 DATA * 841210 BUG IN BIND COMMAND - BAD DISPLACMENT FIXED * 841217 ACCEPT "_" TO MEAN NOP * 850111 EDIT TEST EXPANDED FOR MOST COMMANDS * 850111 $DEF AND $X MACRO DEFINE AND USE * LOG 01/17/85 *** RELEASE 6 NOW FINALISED *** * 850430 CLEAR AID MEANS RESHOW NOT EXIT (PA1 INTERCEPT) * 850626 CNM OPEN/CLOSE IMPLIED IF ANY RTM/RQMS VERBS. * 850701 RTM OUTPUT LOGIC CODED * 850815 RTM/CNM RPL SHOWN BY "SHOW CNM" OR PF11 IN STEPPER * 860205 COND EB SUPPORTED AS "(>" AND "CB" * 860207 TEXT_SAVE AND READ_SAVE ALIASES TO SAVE_TEXT/READ * 860207 TEXT NNNN,DMOD=NAME ADDED * 860207 TEXT COMMAND ONLY USES DISK, NOT MEMORY NOR ARCHIVE * 860207 @XXX EDIT TIME MACRO FACILITY ADDED (READ,RTM,CCW...) * 860207 @*** EDIT TIME MACRO REFORMATS A LINE * 860710 SHOW READ/CHNS IN STEPPER CLOBBERED DATA * 860716 FIX THE HELP PROCESSOR * 860716 DROP CORE SEARCH ON A LOAD COMMAND OR STARTUP * 860729 PMODEDIT SUPPORTS ERASE EOF * 860730 SRSP COMMAND ADDED - CHANGES ISHDMCRO,DSCT,SUBS * 860731 LINE 21 IN EDIT HAS MESSAGE AREA FOR ADVISORIES * 860731 REFORMAT A LINE MACRO CHANGED TO BE EASIER * 860801 SRSP COMMAND CAN SEND IMMEDIATE LUSTAT NOW * 860807 SEND/TEXT EDIT TEST AND QUOTED EVOKES HELPFUL COMMENT * 860815 PF3 AT EXEC OR END WILL NO LONGER EXIT FROM PMOD * 861104 PSPC TEXTOUT/TEXTIN/SEND AND EDIT CHECKERS ETC STARTED * 861106 READ ON LU=* FIXED REAL DATA SIZE NOW PRINT OFF COPY ISHDMCRO MACRO &NAME K &A &NAME DC CL80&A MEND PRINT ON TITLE '**ENTRY*** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * ENTRY * PMOD INITIALISATION OF REGISTERS AND DYNAMIC DATA * * * ******************************************************************* * SPACE *********************************************************************** * * * I N N I TTTTTTT * * I NN N I T * * I N N N I T * * I N N N I T * * I N NN I T * * I N N I T * * * * AT THIS POINT WE ARE IN STARTUP REENTRANT CODE. * * * * AUTHOR: SIMON WHEATON-SMITH, * * INVOKED: ISHDLVL1 * * INVOKES: ISHDDBSA, DMODLVL2 * * REQUIRES: ISHDLVL0 * * INFO: ISHDINFO, ISHDMCRO, ISHDDSCT * * * *********************************************************************** SPACE PRINT NOGEN PMODLVL2 CSECT , *** ENTER HERE *** USING *,R12,R11,R10 R12 WILL BE A BASE SOON SAVE (14,12) 11 SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 10 AND NOW R12 IS THE BASE LA R11,4095(R12) GET LA R11,1(R11) NEXT BASE LA R10,4095(R11) GET LA R10,1(R10) NEXT BASE *** *** LOCATE THE "LUSRAREA" NEEDED FOR ALL XXXXIO CALLS *** LR R9,R1 R9 GET ADDRESS USING LUSRAREA,R9 SAY OK *** *** CHAIN SAVE AREAS GETTING A NEW ONE *** L R0,=A(DSASIZE+20) GET A GETMAIN R,LV=(0) SAVE AREA ST R13,4(1) SAVE OLD R13 IN NSAVE+4 ST R1,8(R13) SAVE NEW R13 IN OSAVE+8 LR R13,R1 R13 GET NEW SAVE USING SAVEAREA,R13 USABLE B PMODINIT ...NEXT PAGE TITLE '**INIT** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * INIT * INITIALISE DYNAMIC DATA, PROGRAM DATA AND SHOW HELP * * * ******************************************************************* * SPACE *** *** INITIALIZE ALL CONSTANTS IN THE DYNAMIC SAVE AREA (DSA) *** PMODINIT LR R1,R13 R1 = DSA AH R1,=AL2(DSASOVRN-SAVEAREA) PLUS DISP AS NOT ADDRESSABLE MVC 0(4,R1),=X'FF0000FF' BUILD OVERUN DETECTOR MVC SAVENODE(8),DRVRNODE */BLANK/LUNAME/DDN MVC SAVEBIND(8),DRVRDSCB TAKE THE DSC BIND AS DEFAULT MVC LOADNAME(8),=CL8' ' NO LOAD COMMAND ISSUED YET MVC LOADTYPE(8),=CL8'(N/A)' NO LOAD COMMAND ISSUED YET XC READSTAK,READSTAK SAY NO READ GETMAINED STACK XC DMODSIZE,DMODSIZE SAY NO DMOD GETMAINED SIZE XC DMODADDR,DMODADDR SAY NO DMOD GETMAINED ADDR MVC DMODNAME(8),=CL8' ' SAY NO DMOD NAME XC INDEX,INDEX SET INDEX TO 0 (LINE NUMBER) *** *** INITIALISE THE USER PROGRAM STEPS TO NULLS *** LA R3,LINE0 GET START LA R1,=C'0123456789ABCDEF' GET PAGE NUMBERS *_ LA R14,PAGES GET NUMBER OF PAGES INIT0101 LA R2,=C'0123456789ABCDEF' GET LINE NUMBERS _* LA R15,LINES GET NUMBER OF LINES IN A PAGE INIT0102 L R4,=A(HDR0) <-+ PREFORMAT MVC 0(80,R3),0(R4) ? WITH NON ADDRESSABLE DATA MVC 0(1,R3),0(R1) ? SAVE A PAGE NUMBER MVC 1(1,R3),0(R2) ? SAVE A LINE NUMBER LA R3,80(R3) ? GET NEXT LINE SLOT LA R2,1(R2) ? GET NEXT LINE NUMBER BCT R15,INIT0102 *--+ SO THERE LA R1,1(R1) GET NEXT PAGE NUMBER BCT R14,INIT0101 SO THERE *** *** ALLOW HIM SOME MACROS *** LR R1,R13 GET DEFINE TABLE AH R1,=AL2($DEFTABL-SAVEAREA) START ADDRESS XC 0(195,R1),0(R1) CLEAR FIRST 3 OF PRIOR VALUES XC 195(130,R1),195(R1) CLEAR LAST 2 OF PRIOR VALUES MVC 0(2,R1),=C'1X' DEFINE MVC 65(2,R1),=C'2X' ALL 5 MVC 65+65(2,R1),=C'3X' AS BAD MVC 65+65+65(2,R1),=C'4X' TILL HE MVC 65+65+65+65(2,R1),=C'5X' DEFINES THEM B INIT0200 DO MORE EJECT * **************************************************************** * * * INIT * SEND INITIAL REMINDER PANEL AND PRELOAD IF NEEDED * * * **************************************************************** * SPACE INIT0200 LM R2,R3,=A(HELP,LHELP) GET CHOICES BAL R14,SENDP SHOW CHOICES STAKIO GET,DATA=WORKDATA,SIZE=80,EMPTY=PAGE,ANSWER=INIT0201 CLI WORKDATA,X'6D' CLEAR BE INIT0200 YES SO RESEND CLI WORKDATA,X'7D' ENTER BNE PMODEXIT NO SO RETURN OC WORKDATA+6(8),=CL8' ' UPPER CASE IT MVC WORKDATA(8),WORKDATA+6 SHIFT DOWN INIT0201 MVC LOADNAME(8),WORKDATA LOAD NAME (IF ANY) IS SAVED *** *** IF NAME ENTERED THEN PRELOAD IT *** CLI WORKDATA,C' ' LOAD DATA FROM DISK BE PMODEDIT NO LA R2,LINE0 LOAD AREA L R3,=A(MEMSIZE) SIZE TO USE *** *** FIRST CHECK THE WORK DISK *** INIT0204 MVI WORKDATA+10,C'P' P FOR PMOD MVC WORKDATA+11(7),WORKDATA AND ITS NAME DISKIO READ,WORKDATA+10,OUT,0(R2),0(R3) MVC LOADTYPE(8),=CL8'(WORK)' LOAD SOURCE CLC 0(3,R2),=C'00 ' IS THIS A GOOD FILE BNE INIT0206 NO SO TRY ARCHIVE B PMODEDIT START EDIT PHASE *** *** DATA BASE RECOVERY AND THEN LOAD IT *** INIT0206 MVC WORKDATA(5),=C'DOR P' BUILD REQUIRED PREFIX MVC WORKDATA+5(8),LOADNAME PMOD NAME ALSO SERVIO LINK,LDMOD==CL8'ISHDDBAS',R1=LUSRAREA MVI WORKDATA,C'P' NOW REBUILD MVC WORKDATA+1(7),LOADNAME THE NAME AND DISKIO READ,WORKDATA,OUT,0(R2),0(R3) MVC LOADTYPE(8),=CL8'(ARCH)' LOAD SOURCE B PMODEDIT RESHOW TITLE '**EXIT** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * EXIT * PMOD TERMINATION AND MEMORY CLEAN UP * * * ******************************************************************* * SPACE *** *** FIRST SET SUBSIO BACK TO NORMAL ERROR LOGGING *** PMODEXIT L R8,LUSRTERM GET LUDFSRPL AND SET BIGH BIT MVI LUDFSRPL-LUDFAREA(R8),0 OFF, ALLOWS FULL LOGGING. *** *** NEXT SEE IF DMOD USED IN A SEND, IF SO FREE MEMORY *** EXIT0100 L R0,DMODSIZE GET DMOD SIZE L R1,DMODADDR GET DMOD ADDRESS LTR R0,R0 ANY SIZE BZ EXIT0200 NO SO EXIT LTR R1,R1 ANY ADDR BZ EXIT0200 NO SO EXIT FREEMAIN R,LV=(0),A=(1) FREEMAIN *** *** NEXT SEE IF A READ CHAIN HAS BEEN BUILT BY SUBSIO *** EXIT0200 L R1,READSTAK GET START OF READ STACK MVC READSTAK(4),0(R1) +0 -> GET ADDRESS OF NEXT ELEMENT LTR R1,R1 ANY ADDR BZ EXIT0300 NO SO EXIT L R0,4(R1) +4 -> GET SIZE OF THIS ELEMENT LTR R0,R0 ANY SIZE BZ EXIT0300 NO SO EXIT FREEMAIN R,LV=(0),A=(1) FREEMAIN B EXIT0200 LOOP TILL END OF CHAIN *** *** LAST FREE THE DYNAMIC SAVE AREA AND ITS WORKS *** EXIT0300 L R0,=A(DSASIZE+20) SIZE LR R1,R13 CORE TO FREE L R13,4(R13) GET LAST FREEMAIN R,LV=(0),A=(1) FREE SAVE AREA RETURN (14,12),RC=0 EXIT TITLE '**EDIT** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * EDIT * START OF THE GENERAL EDITER IS HERE * * * ******************************************************************* * SPACE *********************************************************************** * * * EEEEE DDDDD I TTTTTTT * * E D D I T * * EEEE D D I T * * E D D I T * * E D D I T * * EEEEEE DDDDDD I T * * * * * * * * AT THIS POINT WE ARE ABOUT TO START EDIT PHASE * * * *********************************************************************** SPACE 3 * ************************************************************** * +---*->___________________________________________________*TYPE * * ? * NN CMND () * OIC DR1 DATA FDBK * * ? * --------------------------------------------------------- * * ? * * * ? * 00 CMND OPERANDS IF NOT READ/SEND___________________ XXXX * * ? * 01 ____ __ _ ___ ___ _______________________________ XXXX * * ? * .. ____ __ _ ___ ___ _______________________________ XXXX * * ? * 0E ____ __ _ ___ ___ _______________________________ XXXX * * ? * 0F SEND __ _ ___ ___ _______________________________ XXXX * * ? * ? ? ? ? ? ? ? * * ? * ? ? ? ? ? +-RESPONSE........ SNA&DVC SENSE OR ? * * ? * ? ? ? ? +-----CHAIN........... VTAM CODES OR ? * * ? * ? ? ? +-------CHANGE DIRECTION ECB&CSW&SENSE ---+ * * ? * ? ? +----------BRACKETS........ * * ? * ? ? * * ? * ? +---------------EXECUTION COMMANDS (SEE VECTOR TABLE) * * ? * ? * * ? * +------------------LABEL (XY X=0-7, Y=0-F) * * ? * * * ? ************************************************************** * ? * ? * ? SEE FOLLOWING PAGE FOR "EDIT" COMMANDS AS SUCH AND FOR * V ACTUAL BYTE DISPLACMENTS INTO THE RECORD. TITLE '**EDIT** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * EDIT * START OF THE EDITING LOOP IS HERE * * * ******************************************************************* * SPACE * ? * +->FOLLOWING ARE EDIT COMMANDS NOTHING TO DO WITH TEST EXECUTION * ************************************************************* * * DMOD ___ ___ INVOKE THE DMOD EDITER * DBL ___ ___ LIST YOUR OWN PMOD FILES (BOTH DISK AND ARCH) * SAVE XXXX ___ SAVE THIS TO A DISK DATA BASE WITH THIS NAME. * ACTUALLY WE INSERT A "P" FOR PMOD. * LOAD XXXX ___ LOAD A SAVED PMOD PROGRAM (DISK, ARCH) * (PF1) TOP OF FILE (LABEL=00) * (PF3) QUIT WHOLE TEST * (PF7) SCROLL TO LOWER LABEL NUMBERS * (PF8) SCROLL TO HIGHER LABEL NUMBERS * __ __ ___ ___ BLANK WILL MOVE TO THE NEXT PHASE * * * DISPLACMENTS IN A COMMAND LINE ARE AS FOLLOWS: * ********************************************** * * +0 (2) 00 LINE NUMBER (PAGE AND LINE, A PAGE IS 16 LINES) * +3 (4) ____ COMMAND (FIRST 3 BYTES ARE USED, 4TH IS MOD) * +8 (2) () (IF VTAM) BRACKETS IF SEND OR RESULT IF RECEIVE * 11 (1) *?C (IF VTAM) *=NO CDI, C=SEND CDI (OR RESULT) * 13 (3) OIC (IF VTAM) CHAINS IF SEND OR RESULT IF RECEIVE * 17 (3) DR1 (IF VTAM) RESPONSE DESIRED IF SEND OR RESULT * 70 (8) 0000 (ACCESS METHOD) RESULTS OF OPERATION EJECT * **************************************************************** * * * EDIT * NOW EDIT OUT THE CURRENT PAGE OF 16 LINES * * * **************************************************************** * SPACE *** *** NORMAL EDIT PMOD MODE SO PROCEED *** PMODEDIT LA R3,LINE0 LINE0=START LINENN=END A R3,INDEX ADD PAGE NUMBER IN EFFECT LA R2,LINES THERE ARE 16 OF THEM LR R4,R13 R1 = DSA AH R4,=AL2(SCRN-SAVEAREA) R4=FULL SCREEN WORK AREA SR R6,R6 R6=SIZE TO SEND *** *** ERASE AND SEND HEADER *** L R1,=A(HDR1) ADDRESS HEADER MVC 0(LHDR1,R4),0(R1) COPY HEADER LA R4,LHDR1(R4) UP TO AREA LA R6,LHDR1(R6) UP TO SIZE PMOD1002 MVC 0(2,R4),=X'1D40' <--+ UNMODIFIED FIELD MVC 2(79,R4),0(R3) ? COPY ONE LINE LA R4,81(R4) ? UP ...> TO AREA 81 LA R3,80(R3) ? UP ...> FM AREA 80 LA R6,81(R6) ? UP ...> TO SIZE 81 BCT R2,PMOD1002 *----+ REPEAT 16 LINES MVC 0(2,R4),=X'1DF8' PROTECT BALANCE LA R6,2(R6) AND BUMP SIZE UP LR R4,R13 R1 = DSA AH R4,=AL2(SCRN-SAVEAREA) R4=FULL SCREEN WORK AREA TERMIO PUT,PAGE,ASIS,0(R4),0(R6) SHOW DATA L R4,=A(HDR2) GET TRAILER MVC HDR2LDNM-HDR2(8,R4),LOADNAME SAY NAME MVC HDR2TYPE-HDR2(8,R4),LOADTYPE SAY TYPE TERMIO PUT,PAGE,ASIS,0(R4),LHDR2 SHOW DATA XC HDR2INFO-HDR2(60,R4),HDR2INFO-HDR2(R4) *860731 *** *** CLEAR AND READ ANY REPLIES *** LR R4,R13 R1 = DSA AH R4,=AL2(SCRN-SAVEAREA) R4=FULL SCREEN WORK AREA LA R0,10 TEN LOOPS LR R1,R4 DATA START XC 0(150,R1),0(R1) CLEAR LA R1,150(R1) GET NEXT BCT R0,*-10 REPEAT TERMIO GET,PAGE,ASIS,0(R4),SCRNSIZE READ ANSWER EJECT * ******************************************************************* * * * EDIT * R4=FULL SCREEN BUFFER, IN=FIRST MODIFIED LINE * * * ******************************************************************* * SPACE *** *** R4 (SCRN AREA) HOLDS THE REPLY *** CLI 0(R4),X'6D' CLEAR BE PMODEDIT REDISPLAY CLI 0(R4),X'F1' PF1 BE PMOD2500 TOP CLI 0(R4),X'F2' PF2 BE PMODBIND RUN CLI 0(R4),X'F3' PF3 BE PMODEXIT QUIT CLI 0(R4),X'F7' PF7 BE PMOD2700 DOWN CLI 0(R4),X'F8' PF8 BE PMOD2600 UP LA R4,6(R4) BUMP OVER THE AID INFO *** *** FULL SCREEN LOOP IS HERE - BUILDING "IN" *** PMOD1005 MVC IN(79),0(R4) AID CSR CSR SBA FLDAD FLDAD OC IN(79),=80C' ' UPPER CASE MVI IN+79,C' ' FIXUP * LA R0,79 SET LIMIT *860729 LA R1,IN SET START * CLI 0(R1),X'11'+X'40' <----+ WAS THIS SBA * BE *+4+12 *-----+ ? YES * LA R1,1(R1) ? ? ELSE GET NEXT * BCT R0,*-12 *-----------+ * B PMOD1006 ? PROCEED * MVI 0(R1),C' ' <-----+<---+ MAKE BLANK * LA R1,1(R1) ? GET NEXT * BCT R0,*-8 *----------+ RETRY * PMOD1006 EQU * MORE NEXT PAGE * EJECT * ******************************************************************* * * * EDIT * PROCESS THE DISK LOAD COMMAND * * * ******************************************************************* * SPACE *** *** SET R2 AND R3 TO THE PROGRAM AREA FOR LOAD/SAVE *** CHECK IF LOAD COMMAND OR NOT *** LA R2,LINE0 MEMORY IN CASE FILE/READ L R3,=A(MEMSIZE) SIZE IN CASE FILE/READ CLC IN(4),=C'LOAD' LOAD A COPY FROM SOMEWHERE BNE NOTLOAD NO SO SKIP - ELSE TRY MEMORY CLI IN+5,C'*' IS THIS "LOAD *" BE *+10 YES SO USE OLD NAME MVC LOADNAME(8),IN+5 LOAD NAME IS SAVED BNE *+10 IF NOT * THEN SKIP BUT IF * MVC IN+5(8),LOADNAME THEN COPY NAME TO COMMAND *** *** CHECK IF A DISK COPY OR SAVE COMMAND *** NOTPGRM MVI IN+4,C'P' P FOR PMOD MVC LOADTYPE(8),=CL8'(WORK)' LOAD SOURCE DISKIO READ,IN+4,OUT,0(R2),0(R3) CLC 0(3,R2),=C'00 ' IS THIS A GOOD FILE BNE NOTDISK NO SO TRY ARCHIVE B PMODEDIT DO EDIT *** *** DATA BASE RECOVERY AND THEN LOAD IT *** NOTDISK MVC WORKDATA(5),=C'DOR P' BUILD REQUIRED PREFIX MVC WORKDATA+5(8),LOADNAME PMOD NAME ALSO MVC LOADTYPE(8),=CL8'(ARCH)' LOAD SOURCE SERVIO LINK,LDMOD==CL8'ISHDDBAS',R1=LUSRAREA MVI WORKDATA,C'P' NOW REBUILD MVC WORKDATA+1(7),LOADNAME THE NAME AND DISKIO READ,WORKDATA,OUT,0(R2),0(R3) B PMODEDIT RESHOW EJECT * ******************************************************************* * * * EDIT * PROCESS THE DISK SAVE COMMAND * * * ******************************************************************* * SPACE NOTLOAD CLC IN(4),=C'SAVE' SAVE DATA TO DISK BNE NOTSAVE NO MVI IN+4,C'P' P FOR PMOD CLI IN+5,C'*' DID HE CODE AN ASTERISK BNE *+10 NO SO SKIP MVC IN+5(8),LOADNAME YES SO USE DEFAULT CLI IN+5,C' ' DID HE CODE A NAME BNE *+10 YES SO SKIP MVC IN+5(8),LOADNAME NO SO USE DEFAULT MVC OUT(8),=CL8' ' USER HAS 8 INFO BYTES MVC OUT(4),LVL1USER USER ID FROM ISHDLVL1 *840907 DISKIO WRITE,IN+4,OUT,0(R2),0(R3) MVC LOADTYPE(8),=CL8'(WORK)' LOAD SOURCE NOT LONGER ARCH B PMODEDIT DO EDIT EJECT * ******************************************************************* * * * EDIT * THIS IS A DMOD, DBL, OR HELP PERHAPS? * * * ******************************************************************* * SPACE *** *** *** CHECK FOR DMOD, HELP AND DBL *** *** SPACE NOTSAVE CLC IN(4),=C'DMOD' DOES HE WANT DMOD RIGHT NOW BE PMOD2800 YES SO DO IT SPACE CLC IN(3),=C'DBL' DOES HE WANT DATA BASE LIST BE PMOD2900 YES SO DO IT SPACE CLI IN+2,C'?' REQUEST FOR HELP? BE EDITCHEK YES *860716 CLI IN+7,C'?' REQUEST FOR HELP? *860716 BE EDITCHEK YES *860716 CLI IN+8,C'?' REQUEST FOR HELP? BNE EDITSTOR NO IT IS NOT EDITCHEK L R1,=A(HELPCMND) GET HELP COMMAND LIST CLC IN+3(3),0(R1) MATCH BNE *+18 NO *860716 MVC IN+8(60),3(R1) COPY FORMAT AND ADVICE MVI IN+2,C'?' BUILD ? AS REASON TO *860716 B EDITSTOR BYPASS EDIT TEST *860716 LA R1,63(R1) GET NEXT CLI 0(R1),X'FF' END BNE EDITCHEK+4 RETRY B EDITSTOR PROCEED EJECT * ******************************************************************* * * * EDIT * NOT AN EDIT ORDER ... SO IT IS A PROGRAM.INSTRUCTION * * * ******************************************************************* * SPACE *** *** GET NUMBER IN COLUMN+0(2) WHICH IS 00-FF AND IS PAGE *** 0-F AND LINE 0-F, FOR 256 LINES. *** EDITSTOR PGLIN FROM=IN,ERROR=PMODEDIT R1=LINE IN MEMORY *860207 LR R0,R1 R0-->ACTUAL MEMORY START LA R1,IN R1-->IN (AREA TO CHECK UP) L R15,=V(EDITTEST) GET EDITOR BALR R14,R15 SYNTAX CHECKER PGLIN FROM=IN,ERROR=PMODEDIT R1=LINE NAMED IN MEMORY *** *** R1 POINTS TO THE RELEVANT LINE IN GETMAINED CORE *** MVC 0(79,R1),IN COPY OVER *** *** FULL SCREEN BUFFER USED R4 *** * LA R4,79(R4) OVER TEXT *860729 * CLI 0(R4),X'11' ANOTHER FIELD? * * BNE *+12 NO * * LA R4,3(R4) GO OVER SBA AND ADDRESS * * B PMOD1005 YES SO PROCESS IT * LA R0,80 LIMIT *860729 CLI 0(R4),X'11' <----------+ THIS AN SBA * BE *+4+12 *----+ ? YES SO PROCESS * LA R4,1(R4) ? ? ELSE GET NEXT * BCT R0,*-12 *----------+ RETRY * B PMODEDIT ? NOT FOUND IN 79 SO END * LA R4,3(R4) <----+ GET NEXT * B PMOD1005 AND DO IT * *** *** NO SO REDISPLAY *** B PMODEDIT RETRY FOR LINE NUMBERS DIFFERS EJECT * **************************************************************** * * * HANDLE TOP, SCROLL, DBASE AND DMOD COMMANDS * * * **************************************************************** * SPACE *** *** TOP *** PMOD2500 XC INDEX(4),INDEX INDEX=0 B PMODEDIT RESHOW *** *** PLUS *** PMOD2600 L R1,INDEX INDEX=N LA R1,16*80(R1) PLUS 16*80 ST R1,INDEX ******* SAVE IT C R1,=A(7*16*80) *PAGES* ARE WE ALREADY AT LAST PAGE BH PMOD2500 ******* YES SO SET INDEX=0 B PMODEDIT RESHOW *** *** MINUS *** PMOD2700 L R1,INDEX INDEX=N C R1,=A(16*80) ARE WE AT LEAST PAGE 2 BL PMOD2500 NO SO MAKE PAGE 0 S R1,=A(16*80) DOWN ON PAGE ST R1,INDEX SAVE B PMODEDIT RESHOW *** *** DMOD EXCURSION *** PMOD2800 STAKIO PUT,DATA=IN+5,SIZE=8,LU=LUSRLUNM SAVE NAME SERVIO CALL,LDMOD==CL8'DMODLVL2',R1=LUSRAREA B PMODEDIT RESHOW *** *** DIRECTORY LIST *** PMOD2900 DISKIO PLIST,LVL1USER DIRECTORY LIST MVC WORKDATA(4),=CL4'DOWP' DOW/P ) REFER TO "DO?" MVC WORKDATA+4(4),LVL1USER USERID ) LOGIC IN SERVIO LINK,LDMOD==CL8'ISHDDBAS',R1=LUSRAREA ) ISHDDBAS B PMODEDIT RESHOW TITLE '**DEVICE** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * DEVICE * PMOD INITIALISATION OF SESSION REQUIRMENTS * * * ******************************************************************* * SPACE *********************************************************************** * * * * * SSSSS EEEEEEE SSSSS SSSSS I OOO N N * * S E S S I O O NN N * * S E S S I O O N N N * * SSSSS EEEE SSSSS SSSSS I O O N N N * * S E S S I O O N N N * * S E S S I O O N NN * * SSSSS EEEEEEE SSSSS SSSSS I OOO N N * * * * AT THIS POINT WE ARE IN COMMON STARTUP CODE. * * * *********************************************************************** TITLE '**DEVICE** PROTOCOL MODIFIER PROGRAM ***' * ******************************************************************* * * * DEVICE * ASK FOR THE DEVICE AND THE SESSION PARMS * * * ******************************************************************* * SPACE * EDITING COMMANDS HAVE COMPLETED. WE NOW NEED TO KNOW WHAT * THE DEVICE WILL BE AND ITS SESSION PARAMETERS. THERE ARE * THREE PRACTICAL MODES WE RUN IN AND THEY ARE <1> USING * * WHERE WE RUN TO THIS TERMINAL, <2> USING XXXXX WHERE * WE USE EXCP AND CHANNEL PROGRAMS AND <3> WHERE WE HAVE A * LUNAME AND USE SUBSIO, WHICH IS MOST COMMONLY VTAM. * * * * LUNAME=* USE THIS TERMINAL, IN WHICH CASE WE IGNORE * THE SESSION PARMS AND ONLY SEND FIC OR OIC * DATA. * * * * LUNAME=DDDDDDDD USE AN O.S. DDNAME FOR EXCP COMMAND, WE * DETECT BETWEEN THIS AND LUNAME BASED ON * PRESENCE OF "EXCP" COMMAND IN 128 LINES. * * * LUNAME=AAAAAAAA THE SUBSESSION SUPPORT IS USED FOR TERMINAL * IO. * * BIND=____ BLANK BIND WILL USE THE DEFAULT * * BIND=XXX USE A NAMED SET OF PARMS * * BIND=*XXX USE A NAMED SET OF PARMS BUT SET THE FMH * ALLOWED BIT ON. EJECT * ******************************************************************* * * * DEVICE * SEND END OF EDIT, START OF EXECUTE MENU * * * ******************************************************************* * SPACE *** *** DECIDE TO SEND THIS DATA *** PMODBIND LM R2,R3,=A(MENU,LMENU) GET MENU LM R4,R5,=A(INLU,INBD,MENU) GET MENU MVC 3(8,R4),SAVENODE NODE MVC 3(8,R5),SAVEBIND BIND BAL R14,SENDP SEND THE MENU BAL R14,READP PAUSE MVI SAVEFLAG,0 NO TRACES L R8,LUSRTERM GET LUDFSRPL AND SET BIGH BIT MVI LUDFSRPL-LUDFAREA(R8),0 OFF, ALLOWS FULL LOGGING. *** *** CHECK IF CLEAR FOR QUIT - IF NOT PARSE THE INPUT *** CLI WORKDATA,X'6D' CLEAR BE PMODBIND YES SO REASK CLI WORKDATA,X'7D' ENTER BE PMOD3000 YES SO RUN CLI WORKDATA,X'F2' PF2 (ACCEPT IT AS IT WAS USED BE PMOD3000 IN EDIT PHASE TO MEAN RUN) CLI WORKDATA,X'F1' PF1=TRACE BNE PMODEDIT NO SO ASSUME EDIT *860815 MVI SAVEFLAG,X'FF' SO SET FLAG ON *** PMOD3000 LA R0,90 SEARCH LIMIT LA R1,WORKDATA START PMOD3005 CLC 0(3,R1),0(R4) OUR LU PARM BNE *+10 NO MVC SAVENODE(8),3(R1) SAVE IT CLC 0(3,R1),0(R5) OUR LU PARM BNE *+10 NO MVC SAVEBIND(8),3(R1) SAVE IT LA R1,1(R1) GET NEXT IN BYTE BCT R0,PMOD3005 RETRY OC SAVENODE(8),=CL8' ' UPPER CLI SAVENODE,C' ' BLANK ENTERED BNE *+8 NO MVI SAVENODE,C'*' MAKE US OC SAVEBIND(8),=CL8' ' UPPER *** *** PARSE COMPLETE SO RUN THE TEST FOR REAL *** B PMODEXEC NO SO READY TO RUN TITLE '*** NOW WE ARE IN EXECUTE PHASE ***' * ******************************************************************* * * * EXECUTE PHASE * * * ******************************************************************* * SPACE 3 SPACE 3 *********************************************************************** * * * EEEEE X X EEEEE CCCC U U TTTTTTT EEEEEE * * E X X E C U U T E * * E X X E C U U T E * * EEEE XXX EEEE C U U T EEEE * * E X X E C U U T E * * E X X E C U U T E * * EEEEE X X EEEEE CCCC UUUU T EEEEEE * * * * * * * * * * PMOD HAS FINISHED EDITING AND HAS GOT THE SESSION DETAILS. * * WE NOW START EXECUTING. FIRST WE MUST GET AN INSTRUCTION * * AND THEN PROCESS STEPPER LOGIC. * * * * * *********************************************************************** EJECT * ******************************************************************* * * * EXECUTE * INITIALISE THE VARIABLE CONSTANTS IN THE DSECT * * * ******************************************************************* * SPACE PMODEXEC TERMIO PUT,LINE,ASIS,=C'*START BIND*',12 *** *** INITIALISE VARIABLES COMMON TO ALL NODE TYPES *** MVC DRVRNODE(8),SAVENODE BUILD LUNAME MVC DRVRBIND(8),SAVEBIND BUILD BIND MVC LABEL(4),=A(0) SAY STARTING AT LABEL 0 MVC SETXVALU(4),=A(0) SET INDEX REG TO 0 MVC SETYVALU(4),=A(0) SET INDEX REG TO 0 MVC SETZVALU(4),=A(0) SET INDEX REG TO 0 MVI TRCESTMT,C' ' CLEAR THE MVC TRCESTMT+1(79),TRCESTMT LABEL TRACE ZAP LIMIT,=P'0' LIMIT FETCHING OF COMMANDS ZAP SETACNTR,DRVRDCTR LIMIT FOR LOOP IS LOOP CMND ZAP SETBCNTR,DRVRDCTR LIMIT FOR REPT IS LOOP CMND ZAP SETCCNTR,DRVRDCTR LIMIT FOR DO IS LOOP CMND MVI LISTAREA,C'0' INITIALISE LIST FOR 50 BYTES MVC LISTAREA+1(49),LISTAREA OF WHICH WE USE 48 MVC DMODNAME(8),=CL8' ' SAY NO DMOD NAME MVC CURRENT(4),=A(STARTMSG) SET NO COMMAND DONE YET MVC LASTCMND(4),=A(STARTMSG) SET NO COMMAND DONE YET *** *** INITIALISE AN EXCP DCB *** MVC DCB(LDCB),DCBM COPY MASTER DCB MVC DCB+X'28'(8),DRVRNODE GET DD NAME EJECT * ******************************************************************* * * * EXECUTE * OPEN UP TO THE RELEVANT NODE OR DDNAME OR WHATEVER * * * ******************************************************************* * SPACE *** *** PERFORM THE RELEVANT OPEN BASED ON NODE TYPE *** * IF ANY EXCP VERB THEN ASSUME DDNAME AND NOT A NODE * IF ANY RQMS/RTM THEN ASSUME CNM ACB LA R1,LINE0 GET FIRST LINE LA R0,128 NUMBER OF LINES CLC 3(4,R1),=C'EXCP' 00 EXCP BE EXCPOPEN YES SO ASSUME EXCP CLC 3(3,R1),=C'RQM' 00 RQMS BE CNMOPEN YES SO ASSUME CNM CLC 3(3,R1),=C'RTM' 00 RTM BE CNMOPEN YES SO ASSUME CNM LA R1,80(R1) GET NEXT BCT R0,*-14 RETRY SUBSOPEN CLI DRVRNODE,C'*' NO NODE BE PMODUSE SKIP OPEN SEND ETC ILLEGAL SUBSIO OPEN,DRVRNODE,DRVRBIND OPEN L R1,LUSRTERM GET PHYSICAL CONTROL BLOCK L R1,LUDFSRPL-LUDFAREA(R1) GET SUB SESSION RPL CLC 13(2,R1),=X'0000' RTNCD,FDBK2 ARE ALL OK BNE OPENFAIL NO B PMODUSE PROCESS COMMAND SPACE CNMOPEN TM ACB+48,B'00010000' IS ACB ALREADY OPEN BO OPENFAIL YES SO DONT FAIL THE TEST L R1,LUSRTERM GET LUDFAREA L R1,LUDFVCTR-LUDFAREA(R1) GET VECTOR TABLE L R1,88(R1) GET CNM APPLID MVC APPL+1(8),0(R1) COPY IT OVER OPEN ACB OPEN ACB FOR VTAM LTR 15,15 CHECK RETURN CODE BNZ OPENFAIL BAD SO FAIL L 1,NIB+4 GET CID ST 1,CID AND SAVE IT MVI TPEND+6,X'00' SAY NO LOST TERM B SUBSOPEN OPEN NODE IS ALLOWED SPACE EXCPOPEN LA R2,DCB GET DCB OPEN ((R2)) OPEN DCB TM DCB+48,X'10' DID IT OPEN BZ OPENFAIL NO B PMODUSE YES SPACE OPENFAIL TERMIO PUT,LINE,ASIS,=C'*OPEN FAIL*',11 BAL R14,PAUSE PAUSE B PMODOPER FAIL HIM EJECT * ******************************************************************* * * * EXECUTE * PROCESS LINE BASED ON LABEL * * * ******************************************************************* * SPACE *** *** GET NEXT SEQUENTIAL INSTRUCTION STORED IN LABEL *** PMODNSI LR R1,R13 GET CURRENT LABEL AH R1,=AL2(DSASOVRN-SAVEAREA) PLUS DISP AS NOT ADDRESSABLE CLC 0(4,R1),=X'FF0000FF' TEST OVERUN DETECTOR BNE PMODOVRN HE BLEW IT L R1,LABEL GET CURRENT LABEL A R1,=A(1) ADD 1 (NOT LA - SEE JUMPCSCT) CH R1,=AL2(8*16) CHECK 0 - 15 FOR 8 PAGES BH PMODNSIH WAS 17TH PAGE ST R1,LABEL SAVE IT B PMODUSE GET RELEVANT LINE *** *** GET A LINE BASED ON "LABEL" AND PROCESS IT *** PMODUSE L R2,CURRENT GET ADDRESS OF LAST EXECUTED ST R2,LASTCMND AND SAVE FOR POSSIBLE STEPPER L R2,LABEL ******* 00-FF IS INDEX TO A LINE CH R2,=AL2(8*16-1) *PAGES* PAGES*LINES-1 BH PMODLBER ******* EXCEEDS INTERNAL LIMIT MH R2,=AL2(80) 0,80,160 ETC LA R2,LINE0(R2) R2 NAMES CURRENT LINE MVC 70(8,R2),=CL8'*DONE*' SAY IT HAS BEEN DONE MVC IN(80),0(R2) IN IS A COPY OF THIS LINE LA R0,72 R0=SCAN FOR SYMBOLS LA R1,IN+2 IGNORE COLS 1, 2 AND LAST 8 CALL SYMBCSCT DO SYMBOL SUBSTUTUTE MVC TRCESTMT(76),TRCESTMT+4 SHUFFLE TRACE DOWN MVI TRCESTMT+76,C',' ADD A COMMA MVI TRCESTMT+79,C' ' AND A BLANK MVC TRCESTMT+77(2),IN ADD LABEL TO IT ST R2,CURRENT SAVED FOR RECEIVE AND ERRORS *** *** CHECK FOR LOOP LIMITING *** AP LIMIT,=P'1' UP 1 ON COMMANDS DONE * CP LIMIT,=P'9999999' *** LIMIT EXCEEDED *** * CP LIMIT,=P'999999' *** LIMIT EXCEEDED *** CP LIMIT,=P'99999' *** LIMIT EXCEEDED *** BH PMODLOOP SO STOP WITH LOOP MESSAGE B PMODVCTR ELSE PROCEED TO PROCESS EJECT * ******************************************************************* * * * EXECUTE * BEFORE EXECUTION WE QUICKLY CHECK FOR THE STEPPER * * * ******************************************************************* * SPACE * * *** INSTRUCTION STEPPER *** * SPACE PMODVCTR CLI SAVEFLAG,X'FF' ARE WE TO TRACE BNE PMODNOTR NO BAL R14,PMODDIAG FORMAT THE PANEL CLI WORKDATA,C'3' IS THIS PF3 BE PMODINTR YES B PMODNOTR PROCEED TITLE '*** NOW WE ARE IN EXECUTE PHASE ***' * ******************************************************************* * * * EXECUTE PHASE * * * ******************************************************************* * SPACE 3 SPACE 3 *********************************************************************** * * * EEEEE X X EEEEE CCCC U U TTTTTTT EEEEEE * * E X X E C U U T E * * E X X E C U U T E * * EEEE XXX EEEE C U U T EEEE * * E X X E C U U T E * * E X X E C U U T E * * EEEEE X X EEEEE CCCC UUUU T EEEEEE * * * * * * * * * * PMOD HAS FINISHED STEPPING AND WE CAN NOW PROCESS THE * * COMMAND. * * * * THEN... * * * * AFTER THE TEST HAS RUN WE GO BACK TO EDIT TO REVIEW THE * * UPDATED LINES AND SEE RETURNED STATUS (ULESS "Q" ENTERED) * * * *********************************************************************** EJECT * ******************************************************************* * * * EXECUTE * VALID COMMANDS ARE DEFINED BELOW * * * ******************************************************************* * SPACE * * *** UNCONDITIONAL BRANCHING *** * * 00 GOTO PL GO TO THIS LABEL 00-8F (P=PAGE,L=LINE) * 00 JUMP NAME GO TO LABEL 00 OF THIS NEW PMOD PROGRAM * * * *** CONDITIONAL BRANCHING *** * * 00 LSET ?,NNNN SET LOOP COUNTER 0 - 99999 (A,B,C COUNTERS) * 00 LOOP ›,PL LOOP TO PL (00-7F) TILL A,B,C COUNTER EQ 0 * 00 TEST ?(PL),XXXX,EQ,PL SEE "TESTCSCT" FOR DOCUMENTATION NOTES * 00 CMPR SIZE,CC,PL SEE "CMPRCSCT" FOR DOCUMENTATION NOTES EJECT * ******************************************************************* * * * EXECUTE * VALID COMMANDS ARE DEFINED BELOW * * * ******************************************************************* * SPACE * * *** MISC COMMANDS *** * * 00 $DEF=X=YYY.. DEFINE EXECUTE TIME MACRO WHERE X=1 TO 5 * 00 $X EXECUTE PREDEFINED COMMAND, X=1 TO 5 * 00 ERGO SAY GO ON ERRORS * 00 DBUG ON?OFF SET ON OR OFF THE STEPPER * 00 SUBS TERSE?VERBOSE DO OR DO NOT LOG DETAILED ERROR MESSAGES * 00 STOP STOP NOW * 00 SHOW PL DISPLAY NAMED LINE (P=PAGE,L=LINE) * 00 SHOW READ SHOW THE READ BUFFER STACK SUMMARY * 00 SHOW DATA SHOW THE READ BUFFER STACK AND 256 DATA * 00 SHOW RPL SHOW THE RPL (SEND AND READ USE ONE) * 00 SHOW TEXT SHOW THE SPECIAL DATA WHICH IS BUILT BY * TEXT DDDD,XXXXXXXX USED FOR CMPR (VTAM) * TEXT DDDD,XXXXXXXX USED FOR CCWN (EXCP) * CCWN ............. CCW MAY READ DATA IN * 00 SHOW IOB SHOW THE IOB (EXCP USES ONE) * 00 SHOW * DISPLAY THIS LINE (P=PAGE,L=LINE) * 00 INPT GET OPERATOR INPUT IN CHARS. THIS WILL BE * TESTED FOR THE WORD "STOP" IN WHICH CASE * EXECUTION STOPS. THIS ALSO SETS SOME IF THE * SSET VARIABLES SPECIFICALLY %I %J %K. * (SHOW AND INPT WITH TEST "A(PL),+D=V,..." * MAY BE USED TO INTELIGENTLY CONTROL THE * FLOW OF PROGRAM EXECUTION) * * * * 00 SAVE READ,DMOD=NAME SAVE THE READ BUFFER (1ST RU OF CHAIN) * 00 SAVE TEXT,DMOD=NAME SAVE THE TEXT BUFFER * * 00 TEXT DDDD,XXXXXXXXXX DEFINE HEX TEXT AT DISPLACMENT DDDD * 00 TEXT DDDD,'CCCCCCCC' DEFINE CHAR TEXT AT DISPLACMENT DDDD * ALSO SCAN FOR @=SBA,$=SF,#=IC,&=RA * 00 TEXT DMOD=NAME DEFINE TEXT FROM DMOD * 00 TEXT READ DEFINE TEXT FROM READ 1ST RU * 00 TEXT INS?DEL,N INSERT OR DELETE N BYTES EJECT * ******************************************************************* * * * EXECUTE * VALID COMMANDS ARE DEFINED BELOW * * * ******************************************************************* * SPACE * *** SEND/RECEIVE COMMANDS *** (VTAM) *** * * 00 SRSP __ _ ___ ___ ALTER RESPONSE TO NORMAL (DEFAULT) MODE * 00 SRSP XXXXYYYY ___ ALTER RESPONSE TO LU AFTER NEXT READ * 00 SRSP XXXXYYYY,LUS SEND IMMEDIATE LUSTAT * 00 READ __ _ ___ ___ READ DATA INTO A STACK AND SHOW FIC/OIC * PROTOCOL AND FIRST 24 HEX BYTES. THE FULL * CHAIN IS VIEWABLE WITH "SHOW READ?DATA" * IF NOT DATA BUT LUS/RTR ETC THEN TYPE IS * SAVED IN THE SENSE BYTE AREA. * 00 CAT TAKE LAST READS FIC+MIC+LIC AND MAKE ONE * CONTIGUOUS OIC. * 00 SEND (> * OIC DR1 SEND BB+CEB CD=NO OIC AND DR1 * 00 SEND () * OIC DR1 SEND BB+EB CD=NO OIC AND DR1 * 00 SEND )( C FIC DR2 SEND NBB+NEB CD=YES FIC AND DR2 * 00 SEND BB MIC EX SEND BB+NEB CD=NO MIC AND EX * 00 SEND EB LIC DR1 SEND NBB+EB CD=NO LIC AND DR1 (BAD SNA) * 00 SEND CB LIC DR1 SEND NBB+CEB CD=NO LIC AND DR1 * 00 SEND ... XXXXXXXXXX DATA IS HEX STRING * 00 SEND ... 'CCCCCCCC' DATA IS CHARACTER STRING * ALSO SCAN FOR @=SBA,#=IC,$=SF AND &=RA. * 00 SEND ... TEXT DATA IS THE TEXT BUFFER, SEE "TEXT" * 00 SEND ... DMOD=NAME DATA IS DMOD EDITED FILE OR A MEMORY FILE * IN DMOD FORMAT. * 00 SEND ............ ALSO SEE UNDER SESSION CONTROL. * 00 SALT .. . ... ... AS FOR SEND BUT THE ALTERNATE CODE IS USED * ADDITIONALLY THE USER MUST ENSURE THE * ALTERNATE CODE ALLOWED BIT IS ON IN THE * BIND. +06 MUST HAVE 08 BIT ON. (FIRST OF * THE TWO COMPROT BYTES). * * *** SESSION CONTROL COMMANDS *** (VTAM) *** * * 00 SEND BID SESSION BID * 00 SEND CLR SESSION CLEAR * 00 SEND SDT SESSION START DATA TRAFFIC * 00 SEND CSDT SESSION CLEAR+SDT * 00 SEND CHASE SESSION (ACTUALLY VTAM SEND) CHASE * 00 SEND CANCEL SESSION (ACTUALLY VTAM SEND) CANCEL * -- UNB SESSION UNBIND * -- BIND SESSION BIND AGAIN TO LAST LU * -- BIND D=DD,V=VV<,LU=> SESSION ALTER A FUTURE BIND TO PRESENT LU * * * *** EXECUTE CHANNEL PROGRAM *** (EXCP) *** * * 00 EXCP ............ EXECUTE CHANNEL PROGRAM USING CCW0 * 00 CCWN 0000000000000000 DEFINE CCW NUMBER N (0-F) EJECT * ******************************************************************* * * * EXECUTE * VALID COMMANDS ARE DEFINED BELOW * * * ******************************************************************* * SPACE * *** SYMBOLIC SUBSTITUTE *** * * 00 INPT SEE MISC COMMANDS. IF "STOP" ENTERED WE * STOP. ALSE SETS "%I, %J, %K" SYMBOLICS. * 00 SSET R,XX SET INDEX TO XX, INDEX (R) IS X, Y, Z FOR * %X, %XXX, %XXY, %Y, %YYY, %Z, %ZZZ SYMBOLS * 00 SSET R,+X ADD TO INDEX A VALUE OF 0 TO 9 * 00 SSET R,-X SUB FM INDEX A VALUE OF 0 TO 9 * 00 LIST XXXXXXXXXXXXXXXX CREATE A LIST OR CHARACTERS USED BY %L * * %L SELECTS THE FIRST OR NEXT PAIR FROM THE LIST AND SUBSTITUTES * IT THEN SHIFTS THE LIST DOWN. LIST BUILT BY "LIST" * %I THIS IS TWO CHARACTERS TAKEN FROM THE LAST "INPT" COMMAND. * %J THIS IS THE NEXT TWO FROM INPT. * %K THIS IS THE NEXT TWO AFTER THAT. * * %X LOADED BY SSET_X,XX INCREMENTED BY SSET_X,+X (0-9) AND * DECREMENTED BY SSET_X,-X (0-9) THIS IS SUBSTITUTED IN THE HEX * OR QUOTED CHARACTER STRINGS OF A "SEND" OR "SHOW" * COMMAND. ALLOWS A SYMBOL AND IS A NUMBER FROM 00-FF. * * %XXX THIS IS A VALUE TAKEN FROM %X FROM 0 TO FFFF SAVE AS 4 CHARS. * %XXY THIS IS A VALUE TAKEN FROM %X FROM 0 TO FFFF AND THEN ASSUMED * TO BE 14 BIT ADDRESS MODE CONVERTED TO 12 BIT. * * %Y LOADED BY SSET_Y,XX, INCREMENTED BY SSET_Y,+X (0-9) AND * DECREMENTED BY SSET_Y,-X (0-9) THIS IS SUBSTITUTED AS FOR * %X. * %YYY THIS IS A VALUE TAKEN FROM %Y FROM 0 TO FFFF SAVE AS 4 CHARS. * * %Z LOADED BY SSET_Z,XX, INCREMENTED BY SSET_Z,+X (0-9) AND * DECREMENTED BY SSET_Z,-X (0-9) THIS IS SUBSTITUTED AS FOR * %X. * %ZZZ THIS IS A VALUE TAKEN FROM %Z FROM 0 TO FFFF SAVE AS 4 CHARS. * * * * *** IMPORTANT NOTES *** * * SSET X,00 MAKES %X = 00, %XXX = 0000, %XXY = 4040 * SSET Y,00 MAKES %X = 00, %XXX = 0000 * SSET Z,00 MAKES %X = 00, %XXX = 0000 * * %X IS THE ONLY VARIABLE WITH A 14 TO 12 BIT ADDRESS * CONVERSION FOR NATIVE 3270 MODE. %XXY IS THAT SYMBOL. * %Y AND %Z DO NOT HAVE SUCH A FACILITY. * EJECT * ******************************************************************* * * * EXECUTE * IN IS FORMATTED AS FOLLOWS - PROCESS IT * * * ******************************************************************* * SPACE * +0(2) LABEL (00-FF) OR MAY BE A COMMAND (Q=QUIT)(R=RUN) * +3(4) COMMAND * +8(2) BRACKET DESIRES ---OR--- +8(NN) OPERANDS * +11(1) CHANGE DIRECTION * +13(2) CHAIN DESIRES * +17(2) RESP DESIRES * +21(N) 'CHARACTERS' * +21(N) XXXXXXXXXXXX * +70(4) UNPACKED SNA OR DEVICE SENSE OR RECEIVE TYPE * * *** NOTE *** * WE USE A 4 BYTE CONSTANT FOR ALIGNMENT BUT A 3 BYTE * COMPARE. WATCH OUT YOU DONT ADD A COMMAND WHERE ONLY * THE LAST BYTE DIFFERS (XXXA=XXXB ON A 3 BYTE COMPARE). * COMMANDS SUCH AS "CCWA", "CCWB" TO GO TO SAME ROUTINE. SPACE PMODNOTR L R1,=A(VECTOR) GET VECTOR TABLE CLI IN+3,C'_' IS THIS UNDERSCORE, IF SO BE PMODNSI IGNORE IT CLC IN+3(3),=C'NOP' IS THIS NOP BE PMODNSI YES SO IGNORE IT CLC IN+3(4),=C'$DEF' IS THIS MACRO BE PMOD$DEF YES SO DO IT CLI IN+3,C'$' IS THIS MACRO BE PMOD$USE YES SO DO IT CLC IN+3(3),=C'EXEC' IS THIS EXEC SIMULATION BE PMODXEQ YES SO PROCESS IT PMODVCT0 L R1,=A(VECTOR) GET VECTOR TABLE LA R14,PMODNSI DEFAULT RETURN POINT *--+ PMODVCT1 CLI 0(R1),X'FF' <----+ END ? BE PMODBADC ? YES SO ERROR ? CLC IN+3(3),0(R1) ? MATCHING ? L R15,4(R1) ? GET ADDRESS ? BE 0(R15) ? PROCESS *------------+ ? LA R1,8(R1) ? GET NEXT ? ? B PMODVCT1 *----+ RETRY --- SPACE PMODXEQ LA R0,IN SET R0 LA R1,LUSRAREA SET R1 CALL PMOD$XEQ PROCESS IT B PMODNSI NEXT INSTRUCTION EJECT * ******************************************************************* * * * MACRO DEFINE AND USE * * * ******************************************************************* * SPACE *** *** MACRO DEFINE PL $DEF=X=YYYYY *** PMOD$DEF LA R1,SAVEAREA GET DEFINE TABLE AH R1,=AL2($DEFTABL-SAVEAREA) START ADDRESS LA R0,5 ALLOWED 5 DEFINITIONS $DEF7001 CLC 0(1,R1),IN+8 TABLE MATCH THIS? BNE *+14 NO MVC 1(64,R1),IN+10 YES SO COPY OVER B PMODNSI PROCEED LA R1,65(R1) GET NEXT BCT R0,$DEF7001 RETRY B PMODBADC ERROR STOP *** *** MACRO USE PL $X *** PMOD$USE LA R1,SAVEAREA GET DEFINE TABLE AH R1,=AL2($DEFTABL-SAVEAREA) START ADDRESS LA R0,5 ALLOWED 5 DEFINITIONS $USE8001 CLC 0(1,R1),IN+4 MATCHING SLOT BNE *+14 YES MVC IN+3(64),1(R1) LOAD IT B PMODVCT0 EXIT LA R1,65(R1) GET NEXT BCT R0,$USE8001 RETRY B PMODBADC ERROR STOP EJECT * ******************************************************************* * * * SUBS TERSE?VERBOSE OR SUBS UNBIND * * * ******************************************************************* * SPACE *** *** REQUEST SUBSIO TO LOG OR NOT LOG ERROR MESSAGES *** * * SUBSIO CONVENTION USES HIGH BIT OF A(RPL) TO STOP * LOGGING MESSAGES. * SUBSCTL L R8,LUSRTERM GET LUDFAREA MVI LUDFSRPL-LUDFAREA(R8),0 SET ADDRESS TO 00XXXXXX * MEANS LOG MESSAGES (DEFAULT) CLI IN+8,C'T' DID HE REQUEST TERSE BNE PMODNSI NO SO QUIT MVI LUDFSRPL-LUDFAREA(R8),X'80' REQUEST NO LOG B PMODNSI THEN EXIT SPACE *** *** UNBIND *** UNB BAL R14,WHATTERM IGNORE IF * SUBSIO CLOSE CLOSE B PMODNSI DO NEXT COMMAND SPACE *** *** BIND TO OUR OLD TERMINAL OR TO A NEW ONE *** BINDNEWT MVC DRVRNODE(8),IN+8 COPY AS A NEW NAME BINDTHIS BAL R14,WHATTERM IGNORE IF * SUBSIO OPEN,DRVRNODE,DRVRBIND OPEN WITH NEW NAME L R1,LUSRTERM GET PHYSICAL CONTROL BLOCK L R1,LUDFSRPL-LUDFAREA(R1) GET SUB SESSION RPL CLC 13(2,R1),=X'0000' RTNCD,FDBK2 ARE ALL OK BE PMODNSI RESUME WORK TERMIO PUT,LINE,ASIS,=C'*OPEN FAIL*',11 BAL R14,PAUSE PAUSE B PMODOPER FAIL HIM EJECT * ******************************************************************* * * * SUBS SESSION CONTROL BIND * * * ******************************************************************* * SPACE *** *** BIND *** BIND CLI IN+8,C' ' BIND_ BE BINDTHIS BIND_NAME CLC IN+8(2),=C'D=' BIND_D=DD,V=VV BNE BINDNEWT BIND_D=DD,V=VV,LU=NAME * * ALTER SOME FUTURE BIND * MVC BINDRQST(8),DRVRNODE CREATE LUNAME CLC IN+18(3),=C'LU=' THIS A DIFF TERMINAL BNE *+10 NO *841210 MVC BINDRQST(8),IN+21 YES SO GET ITS NAME MVC BINDMESG+24(2),IN+15 VALUE MVC BINDMESG+15(2),IN+10 DISP MVC BINDMESG+34(8),BINDRQST LUNAME TERMIO LOG,DATA,ASIS,BINDMESG,L'BINDMESG LOG DATA CLI IN+10,C'0' NUMERIC BNL *+8 OK MVI IN+10,C'0' MAKE 0 CLI IN+11,C'0' NUMERIC BNL *+8 OK MVI IN+11,C'0' MAKE 0 PACK DWD(8),IN+10(2) GET DISPLACMENT CVB 1,DWD IN DECIMAL THEN BINARY STH 1,BINDRQST+8 SAVE DISPLACMENT CLI IN+15,C'0' 0 ETC IS OK BNL *+16 ELSE IC 1,IN+15 GET BYTE LA 1,9(1) UP BY 9 (A=C1=CA) STC 1,IN+15 PUT BYTE CLI IN+16,C'0' 0 ETC IS OK BNL *+16 ELSE IC 1,IN+16 GET BYTE LA 1,9(1) UP BY 9 (A=C1=CA) STC 1,IN+16 PUT BYTE PACK DWD(2),IN+15(3) PACK MVC BINDRQST+10(1),DWD COPY THIS VALUE TERMIO BIND,ASIS,ASIS,BINDRQST,0 DO BIND MODIFY B PMODNSI END EJECT * ******************************************************************* * * * SESSION CONTROL --> SEND_CANCEL?CHASE?CLR?SDT?CSDT * * * ******************************************************************* * SPACE *** *** SEND A BID *** BID BAL R14,WHATTERM VALIDATE SUBSIO BID SEND CONTROL=BID B SENDPOST DO SENSE POSTING *** *** SEND A CANCEL *** CANCEL BAL R14,WHATTERM VALIDATE SUBSIO CANCEL SEND CONTROL=CANCEL B PMODNSI DO NEXT COMMAND *** *** SEND A SHUTD *** SHUTD BAL R14,WHATTERM VALIDATE SUBSIO SHUTD SEND CONTROL=SHUTD B PMODNSI DO NEXT COMMAND *** *** SEND A CHASE *** CHASE BAL R14,WHATTERM VALIDATE SUBSIO CHASE SEND CONTROL=CHASE B PMODNSI DO NEXT COMMAND *** *** SDT *** SDT BAL R14,WHATTERM VALIDATE SUBSIO SDT SESSIONC START DATA TRAFFIC B PMODNSI DO NEXT COMMAND SPACE *** *** CLEAR AND START OF CLR+SDT *** CLR BAL R14,WHATTERM VALIDATE CSDT EQU CLR ALIAS SUBSIO CLEAR SESSIONC CLEAR CLC IN+8(4),=C'CSDT' DO WE NEED SDT NOW BE SDT YES B PMODNSI DO NEXT COMMAND SPACE *** *** IGNORE IF *, ALLOW IF LU ELSE ERROR *** WHATTERM CLI DRVRNODE,C'*' USING LOCAL TERMINAL BE PMODNSI YES SO IGNORE CLI DRVRNODE,C' ' BLANK IS NO NAME SO DROP BE PMODCMDD COMMAND DROPPED BR R14 DO IT EJECT * ******************************************************************* * * * EXECUTE A CHANNEL PROGRAM * * * ******************************************************************* * SPACE *** *** INITIALISE THE IOB *** EXCP MVC IOB(LIOB),IOBM COPY MASTER IOB LA R1,ECB * GET ECB ADDRESS STCM R1,7,IOB+5 AND SAVE LA R1,CCW * GET CCW ADDRESS IN DSECT STCM R1,7,IOB+17 AND SAVE LA R1,DCB * GET DCB ADDRESS STCM R1,7,IOB+21 AND SAVE BAL R14,LOOPTEST CHECK FOR CCW CHAIN LOOP LA R2,IOB LOCATE THE IOB EXCP (2) EXECUTE THE CHANNEL PROGRAM LA R2,ECB LOCATE THE ECB WAIT ECB=(2) WAIT *** *** PROCESS COMPLETION *** L R2,CURRENT GET REAL LINE IN MEMORY MVC 48(5,R2),=C'CSW->' CSW HI BYTE IS N/A L R1,IOB+8 GET CSW CCW END ADDRESS LA R1,0(R1) CLEAR ZONE LTR R1,R1 IS IT 0 (I.E. DE) BZ *+4+6 IF SO SKIP SR R1,R13 MINUS (DSA) SAVE AREA ADDRESS SH R1,=AL2(CCW-SAVEAREA) MINUS CCW START ST R1,DWD SAVE UNPK 53(7,R2),DWD+1(4) UNPACK DOWN DATED CCW ADDR TR 53(6,R2),TAB-240 PRINTABLE HEX MVI 59(R2),C' ' CLEAR BAD BYTE UNPK 60(5,R2),IOB+12(3) UNPACK STATUS UNPK 65(5,R2),IOB+14(3) UNPACK RES CNT TR 60(9,R2),TAB-240 PRINTABLE HEX MVI 64(R2),C' ' CLEAR BAD BYTE MVI 69(R2),C' ' CLEAR BAD BYTE * UNPK 70(3,R2),ECB(2) GET ECB COMPLETION CODE UNPK 72(3,R2),IOB+12(2) GET CSW DEVICE STATUS UNPK 74(5,R2),IOB+2(3) GET DECIVE SENSE MVC 76(2,R2),=C'00' MAKE ONLY ONE BYTE HOWEVER TR 70(8,R2),TAB-240 TRANSLATE MVI 78(R2),C' ' CLEAN IT MVC IN(80),0(R2) COPY TO IN (IN CASE IO ERR) EJECT * ******************************************************************* * * * EXCP - COMPLETION SEE IF ANY DATA READ IN * * * ******************************************************************* * SPACE LA R1,CCW GET CCW LA R0,16 LIMIT LOOP EXCP0000 CLI 0(R1),X'02' READ BE EXCP0100 YES CLI 0(R1),X'06' READ BE EXCP0100 YES TM 4(R1),X'40' ANY CHAINING BZ EXCP9600 NO SO STOP LA R1,8(R1) GET NEXT BCT R0,EXCP0000 TRY NEXT CCW B EXCP9600 END OF CHAIN * EXCP0100 L R14,0(R1) START OF TEXT LA R1,21(R2) START OF OUTPUT TO REAL LINE LA R0,12 JUST 12 BYTES EXCP0200 UNPK 0(3,R1),0(2,R14) <--+ UNPACK TWO BYTES MVI 2(R1),C' ' ? CLEAN IT LA R1,2(R1) ? GET NEXT LA R14,1(R14) ? GET NEXT BCT R0,EXCP0200 *--+ REPEAT TR 21(24,R2),TAB-240 FIX MVC 13(8,R2),=C'INDATA->' HEADER MVC IN(80),0(R2) COPY TO IN (IN CASE IO ERR) *** *** CHECK ANY ERRORS *** EXCP9600 CLI ECB,X'7F' WAS IT OK BE PMODNSI YES CLC DRVREROR(2),=C'GO' OK TO GO BE PMODNSI YES B PMODERSP HALT EJECT * ******************************************************************* * * * SEND A SHOT OF DATA IN+3-->S IN+21(24)=TEXT * * * * ALSO SEND SESSION CONTROL IN+8 SESSION CMD * * * ******************************************************************* * SPACE * THIS USES THE SUBSIO FACILITY. SUBSIO HAS TWO MODES, ONE WHERE * IT DOES WHAT YOU TELL IT, ONE WHERE IT FIXES YOUR ERRORS. * * DO IT () * OIC FR1 ) WE USE THE "DO IT" MODE * ***** BB C FIC FR2 ) BUT FOR DR1 AND DR2 WE * )( MIC EX ) READ DR1/DR2 THEN CHANGE * EB LIC ) THE D TO F FOR FR1/FR2. SPACE SALT SERVIO SYSTEM=BTAM,GOTO=SENDBGIN SKIP IF BTAM L R2,LUSRTERM GET LUSRTERM L R2,LUDFSRPL-LUDFAREA(R2) GET SUB SESSION RPL MODCB RPL=(2),AM=VTAM, THIS IS VTAM AND OUR RPL X CODESEL=ALT SET ASCII B SENDBGIN PROCEED SEND SERVIO SYSTEM=BTAM,GOTO=SENDBGIN SKIP IF BTAM L R2,LUSRTERM GET LUSRTERM L R2,LUDFSRPL-LUDFAREA(R2) GET SUB SESSION RPL MODCB RPL=(2),AM=VTAM, THIS IS VTAM AND OUR RPL X CODESEL=STANDARD SET EBCDIC SENDBGIN CLC =CL4'CSDT',IN+8 CLEAR AND START DATA TRAFFIC BE CSDT YES CLC =CL3'CLR',IN+8 CLEAR BE CLR YES CLC =CL3'BID',IN+8 BID BE BID YES CLC =CL3'SDT',IN+8 START DATA TRAFFIC BE SDT YES CLC =CL4'CHASE',IN+8 CHASE BE CHASE YES CLC =CL4'SHUTD',IN+8 SHUTD BE SHUTD YES CLC =CL4'CANCEL',IN+8 CANCEL BE CANCEL YES SENDSTRT LA R0,48 LOOK FOR 48 BYTES LA R1,IN+21 START HERE CLI DRVRNODE,C' ' BLANK IS NO NAME SO DROP BE PMODCMDD COMMAND DROPPED *** *** IS THIS SEND '...' ? XXXXXXXX ? DMOD=NAME *** CLC IN+21(4),=C'TEXT' TEXT MEANS SEND TEXT BUFFER BE SENDTEXT IN DMOD FORMAT CLC IN+21(5),=C'DMOD=' DMOD= MEANS USE A DMOD BE SENDDMOD EDITED DATA MODULE CLI IN+21,C'''' A QUOTE MEANS CHARACTER BNE SENDHEX NO IT IS HEX SO LOOK FOR FF EJECT * ******************************************************************* * * * THIS IS SEND 'TEXT' ..MAKE.. AREA=(3) SIZE=(2) * * * ******************************************************************* * SPACE MVC IN+21(48),IN+22 SHIFT DOWN ONE BYTE LOSES QUOTE LA R0,48 LIMIT LA R1,IN+21 START LA R2,0 BYTES TO SEND LA R3,IN+21 SET R3 TO DATA SENDQUOT CLI 0(R1),C'''' <--------+ GOT A QUOTE YET BE SENDNOW ? YES * ? CLI 0(R1),C'@' ? IS THIS "AT" MEANING AT.ADDRESS BNE *+8 ? NO MVI 0(R1),X'11' ? YES --- MAKE SBA CLI 0(R1),C'#' ? IS THIS "POUND" MEANING START BNE *+8 ? POUNDING AT THIS ADDRESS MVI 0(R1),X'13' ? YES --- MAKE IC CLI 0(R1),C'$' ? IS THIS START FIELD BNE *+8 ? NO MVI 0(R1),X'1D' ? YES --- SF CLI 0(R1),C'&&' ? IS THIS REPEAT TO ADDRESS BNE *+8 ? NO MVI 0(R1),X'3C' ? YES --- RA * ? LA R1,1(R1) ? GET NEXT LA R2,1(R2) ? ADD TO COUNT BCT R0,SENDQUOT *--------+ RETRY B SENDNOW OH WELL EJECT * ******************************************************************* * * * THIS IS TEXT (TEXT BUFFER) AREA=(3) SIZE=(2) * * * ******************************************************************* * SPACE SENDTEXT LA R3,SAVEAREA GET MAIN AREA A R3,=A(TEXT-SAVEAREA) GET START OF TEXT BUFFER LH R2,0(R3) GET SIZE SH R2,=AL2(2) BUT SUB 2 LA R3,2(R3) GET TEXT START B SENDNOW DO IT EJECT * ******************************************************************* * * * THIS IS DMOD (CHECK CORE) AREA=(3) SIZE=(2) * * * ******************************************************************* * SPACE SENDDMOD XC LOADADDR(4),LOADADDR CLEAR OLD ADDRESS *** *** NOW SEARCH THE LOAD LIST *** L R3,LUSRTERM GET LUDFAREA L R3,LUDFVCTR-LUDFAREA(R3) GET MASTER VECTOR L R3,24(R3) GET LOAD LIST START SEND0001 CLC IN+26(8),0(R3) CHECK IF MATCHING NAME BE SEND0002 NO LA R3,12(R3) GET NEXT SLOT CLI 0(R3),X'FF' END BNE SEND0001 NO SO RETRY B SEND0003 BYPASS SAVE *** *** WE FOUND IT OR WE DIDNT *** SEND0002 L R3,8(R3) GET ADDRESS OF THIS MODULE LA R3,0(R3) CLEAR ZONE ST R3,LOADADDR SAVE ADDRESS *** *** WELL HOW DID IT GO *** SEND0003 L R3,LOADADDR GET ADDRESS LTR R3,R3 FOUND BZ SEND0004 TRY DISK *** *** SET R3 TO DATA AND R2 TO SIZE *** LH R2,0(R3) SET R2=SIZE SH R2,=AL2(2) BACK OFF SIZE OF SIZE LA R3,2(R3) SET R3 TO DATA B SENDNOW SEND EJECT * ******************************************************************* * * * THIS IS SEND DMOD=NAME AREA=(3) SIZE=(2) * * * ******************************************************************* * SPACE SEND0004 CLC DMODADDR(4),=A(0) ANY SIZE YET BNE SEND0005 NO SO OK L R0,=A(8192) GET SIZE ST R0,DMODSIZE SAVE IT GETMAIN R,LV=(0) GET IT ST R1,DMODADDR SAVE ADDR *** *** WE NOW GO CORE (OK, MEMORY THEN) *** SEND0005 MVI DMODNAME,C'D' MAKE DMOD PREFIX CLC IN+26(7),DMODNAME+1 SAME AS LAST NAME BE SEND0006 NO MVC DMODNAME+1(7),IN+26 GET NAME L R2,DMODADDR GET ADDRESS L R3,DMODSIZE GET SIZE DISKIO READ,DMODNAME,OUT,0(R2),0(R3) * IF NOT FOUND THEN ARCHIVE? ADD CODE HERE ONE DAY *** *** EITHER WAY DATA IS IN CORE *** SEND0006 L R3,DMODADDR SET R3 TO DMOD DATA LH R2,0(R3) SET R2=SIZE SH R2,=AL2(2) BACK OFF SIZE OF SIZE LA R3,2(R3) SET R3 TO DATA B SENDNOW SEND EJECT * ******************************************************************* * * * THIS IS SEND XXXXXXXXXX__ AREA=(3) SIZE=(2) * * * ******************************************************************* * SPACE SENDHEX LA R0,24 LOOK AT 24 PAIRS LA R1,IN+21 START OF DATA LA R2,0 R2=BYTES SO FAR SENDHEX5 CLI 0(R1),C' ' BLANK = END BE SENDHEX7 YES CLI 0(R1),C'_' UNDERSCORE = END BE SENDHEX7 YES LA R1,2(R1) GET NEXT PAIR LA R2,1(R2) ADD TO SIZE BCT R0,SENDHEX5 REPEAT *** *** THIS IS SEND XXXXXX ..MAKE.. AREA=IN+21 *** SENDHEX7 PACKX FROM=IN+21,SIZE=48 PACK 48 TO 24 BYTES LA R3,IN+21 SET R3 TO DATA B SENDNOW SEND IT EJECT * ******************************************************************* * * * THIS IS SEND ????? AND AREA=(3) SIZE=(2) * * * ******************************************************************* * SPACE *** *** R2=BYTES TO SEND, R3(N)=DATA SO CHECK IT *** ************** SENDNOW CH R2,=AL2(8192) TOO BIG IS A BUG * SNA ALLOWS * BH PMODCNTH STATE ERROR * 0 LENGTH * *** ************** *** R2 = GOOD SIZE AND IN+21 IS THE START - GET PROTOCOL *** SEND0300 CLI DRVRNODE,C'*' * = THIS SO DO IT BE SENDTHIS COMMAND DROPPED CLC =CL4'SIGNAL',IN+8 IF THIS IS SIGNAL THEN BE SIGNAL GO FOR IT MVC SAVEBKTS(2),IN+8 GET BRACKET DESIRES MVC SAVEBKTS+2(1),IN+11 GET CHANGE DIRECTION DESIRES CLC SAVEBKTS(2),=C'()' BB+EB BE SEND0301 YES CLC SAVEBKTS(2),=C'(>' BB+CEB BE SEND0301 YES CLC SAVEBKTS(2),=C')(' NBB+NEB BE SEND0301 YES CLC SAVEBKTS(2),=C'BB' BB+NEB BE SEND0301 YES CLC SAVEBKTS(2),=C'EB' NEB+BB BE SEND0301 YES CLC SAVEBKTS(2),=C'CB' NEB+CEB BNE PMODBKTR NO * SEND0301 CLI SAVEBKTS+2,C'C' C=CHANGE DIRECTION BNE *+8 NO SO OK ELSE MAKE MVI SAVEBKTS+2,C'Y' Y=CHANGE DIRECTION CLI SAVEBKTS+2,C'*' *=DONT CHANGE DIRECTION BNE *+8 NO SO OK ELSE MAKE MVI SAVEBKTS+2,C'N' N=NO CHANGE DIRECTION MVC SAVECHNS(3),IN+13 GET CHAINING DESIRES CLC SAVECHNS(3),=C'FIC' FIRST BE SEND0302 YES CLC SAVECHNS(3),=C'MIC' MIDDLE BE SEND0302 YES CLC SAVECHNS(3),=C'LIC' LAST BE SEND0302 YES CLC SAVECHNS(3),=C'OIC' ONLY BNE PMODCHTR NO * SEND0302 MVC SAVERESP(3),IN+17 GET RESPONSE DESIRES CLC SAVERESP(3),=C'DR1' FME BE SEND0400 YES CLC SAVERESP(3),=C'DR2' RRN BE SEND0400 YES CLC SAVERESP(3),=C'EX ' EX BNE PMODRSTR NO EJECT *** *** R2 = GOOD SIZE AND R3(N) IS THE START - SEND IT *** SEND0400 CLI SAVERESP,C'D' DR1 OR DR2? BNE *+8 NO MVI SAVERESP,C'F' YES SO FORCE PLACE *** *** DR1 OR DR2 ARE NOW FR1 AND FR2 TO FOOL SUBSIO *** SUBSIO SEND,SAVEBKTS,SAVECHNS,0(R3),0(2),SAVERESP *** *** SAVE SENSE UPDATED INTO PROGRAM *** SENDPOST SUBSIO TEST,WORKDATA READ SENSE L R2,CURRENT GET REAL LINE IN PGM MVC IN(80),0(R2) HEX MAY BE DONEUP UNPK 70(9,R2),WORKDATA(5) UNPACK IT TR 70(8,R2),TAB-240 PRINTABLE MVI 78(R2),C' ' CLEAN IT *** *** *** CLC WORKDATA(4),=A(0) ANY ERRORS BE PMODNSI NO SO DO NSI * WERE SOME ERRORS CLC DRVREROR(2),=C'GO' AN ERROR SO WHAT BE PMODNSI GO SO PROCEED BAL R14,SHOWRPLS DUMP RPL B PMODERSP SKID TO A HALT SPACE *** *** R2 = GOOD SIZE AND IN+21 IS THE START - SEND IT *** SENDTHIS L R1,CURRENT GET REAL LINE IN PGM MVC 70(8,R1),=CL8'2002R IN+21(24)=FIC.TEXT * * * ******************************************************************* * SPACE * THIS USES SUBSIO (NODE.NE.*) AND TERMIO (NODE=*) * * EITHER WE CHECK IF ANY PRIOR READ GOT MEMORY, IF SO WE FREE * IT AND THEN GET THE FIRST OF A NEW CHUNK OF MEMORY, THEN WE * TEST THE NODE TYPE. * SPACE RECV L R1,READSTAK GET START OF READ STACK MVC READSTAK(4),0(R1) +0 -> GET ADDRESS OF NEXT ELEMENT LTR R1,R1 ANY ADDR BZ RECVCHEK NO SO EXIT L R0,4(R1) +4 -> GET SIZE OF THIS ELEMENT LTR R0,R0 ANY SIZE BZ RECVCHEK NO SO EXIT FREEMAIN R,LV=(0),A=(1) FREEMAIN B RECV LOOP TILL END OF CHAIN *** *** NOW GET MEMORY FOR THE FIRST CHAIN ELEMENT *** RECVCHEK LA R0,READSIZE GET GETMAIN R,LV=(0) CORE LR R2,R1 R2=AREA AVAILABLE *** *** R2 = GOOD SIZE AND IN+21 IS THE START - GET PROTOCOL *** RECV0300 CLI DRVRNODE,C'*' TERM TYPE BNE RECVSUBS SUB SESSION B RECVTHIS MAIN SESSION EJECT * ******************************************************************* * * * READ USING TERMIO * * * ******************************************************************* * SPACE *** *** ISSUE A PAGE RECEIVE AND FIX UP PROTOCOL *** RECVTHIS ST R2,READSTAK SAVE FOR READ STACK MVC 0(8,R2),=A(0,READSIZE) NEXT=0,SIZE=2500 (OR WHATEVER) XC 8(20,R2),8(R2) 20 BYTES FOR PROTOCOL XC 28(12,R2),28(R2) 12 BYTES FOR SENSE AND ETC XC 40(60,R2),40(R2) 60 BYTES FOR RPL XC 100(256,R2),100(R2) 100 BYTES CLEANED, 2400=DATA *???? TERMIO GET,PAGE,ASIS,100(R2),READSIZE-200,PA1=* NO PA INTCPT TERMIO GET,PAGE,ASIS,100(R2),READSIZE-200 READ PA INTERCEPT * +8(20) = PROTOCOL MVC 8(2,R2),=C'()' REFLECT BRACKETS MVC 10(1,R2),=C'*' REFLECT CHANGE DIRECTION MVC 11(3,R2),=C'OIC' REFLECT CHAINS MVC 14(3,R2),=C'DR1' REFLECT RESPONSE * +28(8) = SENSE MVC 28(4,R2),=C'RSP=' COPY RTYPE MVC 32(4,R2),=C'DATA' COPY RTYPE * 40(60) = RPL L R1,LUSRTERM GET LUDF L R1,LUDFARPL-LUDFAREA(R1) GET MAIN RPL MVC 40(60,R2),0(R1) COPY RPL * MVC 88(4,R2),=A(1920) SIMULATE A SIZE *861106 * ? LA R1,100(R2) START OF INAREA ? LA R0,2200 LIMIT ? SR R15,R15 TOTAL COUNT=0 ? CLI 0(R1),X'00' <--+ NULL ? BE *+16 *--------- ? --+ YES SO SAVE SIZE ? LA R1,1(R1) ? ? GET NEXT ? LA R15,1(R15) ? ? ADD TO BYTES ? BCT R0,*-16 *--+ ? RETRY ? ST R15,88(R2) <---------+ SAVE IN PSEUDO RPL * *** *** WE HAVE DONE A READ - THE SIMULATED PROTOCOL SAYS OIC *** BUT REMEMBER THE RPL IS AFTER THE FACT AND MAY NOT *** MATCH. *** B RECVSEND ONLY IN CHAIN EJECT * ******************************************************************* * * * READ USING SUBSIO * * * ******************************************************************* * SPACE *** *** START A READ --- R2 IS A BUFFER TO USE *** RECVSUBS ST R2,READSTAK SAVE FOR READ STACK RECV0101 MVC 0(8,R2),=A(0,READSIZE) NEXT=0,SIZE=2500 (OR WHATEVER) XC 8(20,R2),8(R2) 20 BYTES FOR PROTOCOL XC 28(12,R2),28(R2) 12 BYTES FOR SENSE AND ETC XC 40(60,R2),40(R2) 60 BYTES FOR RPL XC 100(256,R2),100(R2) 100 BYTES CLEANED, 2400=DATA SUBSIO READ,SAVEBKTS,SAVECHNS,100(R2),READSIZE-200,SAVERESP * +8(20) = PROTOCOL MVC 8(2,R2),SAVEBKTS REFLECT BRACKETS MVC 10(1,R2),SAVEBKTS+2 REFLECT CHANGE DIRECTION MVC 11(3,R2),SAVECHNS REFLECT CHAINS MVC 14(3,R2),SAVERESP REFLECT RESPONSE * +28(8) = SENSE SUBSIO TEST,WORKDATA READ SENSE MVC 28(4,R2),=C'RSP=' COPY RTYPE MVC 32(4,R2),WORKDATA COPY RTYPE * 40(60) = RPL L R1,LUSRTERM GET LUDF L R1,LUDFSRPL-LUDFAREA(R1) GET SUB RPL MVC 40(60,R2),0(R1) COPY RPL *** *** WE HAVE DONE A READ - BUT IS THIS LAST/ONLY IN CHAIN *** CLC SAVECHNS(3),=C'OIC' ONLY IN CHAIN BE RECVSEND EDIT RESULTS CLC SAVECHNS(3),=C'LIC' LAST IN CHAIN BE RECVSEND EDIT RESULTS *** *** RUN THE CHAIN TO KEEP VTAM HAPPY *** LA R0,READSIZE GET GETMAIN R,LV=(0) CORE ST R1,0(R2) CHAIN TO LAST AREA LR R2,R1 SET R2 TO THIS NEW BUFFER B RECV0101 DO MORE WORK EJECT * ******************************************************************* * * * COMPLETE THE READ USING SUB SESSION * * * ******************************************************************* * SPACE *** *** COMMON EXIT SHOWS SOME BYTES - R2 IS BIG BUFFER *** RECVSEND LA R0,24 EDIT 24 BYTES L R2,READSTAK GET VERY FIRST CHAIN MVC IN+8(2),8(R2) () MVC IN+11(1),10(R2) * MVC IN+13(3),11(R2) OIC MVC IN+17(3),14(R2) DR1 MVC IN+70(8),28(R2) RSP=DATA/LUS_/RTR_/ETC_ LA R1,IN+21 START OF INAREA LA R14,100(R2) START OF TEXT RECVSE00 UNPK 0(3,R1),0(2,R14) <--+ UNPACK TWO BYTES LA R1,2(R1) ? GET NEXT LA R14,1(R14) ? GET NEXT BCT R0,RECVSE00 *--+ REPEAT TR IN+21(48),TAB-240 FIX MVI IN+21+48,C' ' IT UP *** *** COPY HEX DATA BACK *** L R1,CURRENT GET REAL LINE IN PGM MVC 0(80,R1),IN COPY DATA BACK *** *** AND DONT FREE THE BIG BUFFER AS IT IS IN THE STACK *** * LA R0,READSIZE GET * LR R1,R2 CORE * FREEMAIN R,LV=(0),A=(1) CORE XC LVL1SUBS(4),LVL1SUBS SET STANDARD RESPONSE *860730 B PMODNSI DO NEXT INSTRUCTION EJECT * ******************************************************************* * * * SAVE THE 1ST RU ELEMENT READ TO DMOD * * * ******************************************************************* * SPACE *** *** CONCATENATE FIC+MIC+LIC TO A SIMULATED OIC *** CAT L R4,READSTAK GET READ STACK * IGNORE IF LTR R4,R4 IS THERE ANY NO READ BZ PMODNSI NO SO EXIT * IGNORE IF CLC 0(4,R4),=A(0) IS THIS AN OIC WAS OIC BE PMODNSI YES SO LEAVE IT SR R5,R5 SET NEW SIZE TO 0 *** *** THIS IS A REAL CHAIN *** L R0,=A(CATSIZE) GET 10K GETMAIN R,LV=(0) FOR SIMULATED OIC ST R1,READSTAK SAVE IT AS THE CHAIN STARTER MVC 4(4,R1),=A(CATSIZE) SAVE IT AS THE CHAIN STARTER MVC 8(92,R1),8(R4) COPY THE INITIAL RPL ETC MVC 11(3,R1),=C'OIC' BUT SAY OIC MVC 88(4,R1),=A(0) AND SAY RECLEN=0 LR R2,R1 SET R2 -------> NEW BUFFER *** *** R2=TO BUFFER R4=FROM BUFFER +40=RPL +100=DATA *** LA R2,100(R2) R1 NEXT FREE SLOT TO ADD DATA CAT0100 L R3,88(R4) GET SIZE * LA R15,0(R2) TO LA R14,100(R4) FROM MVC 0(1,R15),0(R14) <--+ COPY TEXT OVER LA R14,1(R14) ? UP FROM LA R15,1(R15) ? UP TO BCT R3,*-14 *-----------+ DO IT * A R2,88(R4) UP NEW POINTER - RPL+48=RECLEN A R5,88(R4) UP TOTAL NEW SIZE CH R5,=AL2(CATSIZE-2000) CHECK WITH 2000 PAD BNH *+8 NOT TOO BIG YET SH R5,88(R4) DROP THE INCREMENT * L R0,4(R4) GET SIZE OF CHUNK TO FREE LR R1,R4 AND ITS ADDRESS L R4,0(R4) GET NEXT ONE WHILE A CHANCE FREEMAIN R,LV=(0),A=(1) FREE IT UP * LA R4,0(R4) CLEAR ANY ZONE LTR R4,R4 WAS THERE A NEXT ONE BNZ CAT0100 YES * L R2,READSTAK GET START OF POOL AGAIN ST R5,88(R2) SAVE NEW SIZE B PMODNSI RESUME EJECT * ******************************************************************* * * * SAVE THE 1ST RU ELEMENT READ TO DMOD * * * ******************************************************************* * SPACE SAVE CLC IN+8(10),=C'READ,DMOD=' SAVE READ BUFFER? BNE SAVETXTB TRY SAVE TEXT L R2,READSTAK GET READ STACK LTR R2,R2 ANY DATA BZ SAVEFAIL NO L R3,4(R2) GET SIZE IF READ BUFFER SH R3,=AL2(100) AND LOSE 100 BYTES SAVEREAD MVI IN+17,C'D' MARK THIS AS A DMOD FILE MVC OUT(8),=CL8' ' USER ID FROM ISHDLVL1 *840907 MVC OUT(4),LVL1USER USER ID FROM ISHDLVL1 *840907 DISKIO WRITE,IN+17,OUT,100(R2),0(R3) MVI IN+17,C'=' RESET IT L R1,CURRENT GET CURRENT LINE MVC 70(8,R1),=C'*WRITTEN' ADVISE DONE B PMODNSI PROCEED SPACE SAVETXTB CLC IN+8(10),=C'TEXT,DMOD=' SAVE TEXT BUFFER? BNE PMODBADC ERROR LA R2,SAVEAREA GET SAVE AREA A R2,=A(TEXT-SAVEAREA) GET TEXT BUFFER SH R2,=AL2(100) MINUS SIZE BECAUSE OF WRITE L R3,=A(TEXTSIZE) GET SIZE OF TEXT BUFFER B SAVEREAD NO SPACE SAVEFAIL L R1,CURRENT GET CURRENT LINE MVC 70(8,R1),=C'*NO DATA' ADVISE DONE B PMODNSI PROCEED EJECT * ******************************************************************* * * * SET THE INDEX REGISTER IN+3 -->SSET IN+8-->R,XX * * * * IN+8-->R,+N * * * * (N=1-9 IN+8-->R,-N * * * ******************************************************************* * SPACE * THIS SSET A VALUE OF 00 TO FF IN THE INDEX REGISTER, IT CAN * BE INCREMENTED OVER FF TO FFFF. * * %X IN SEND OR SHOW WILL INSERT 00-FF * %XXX IN SEND OR SHOW WILL INSERT 0000-FFFF * %XXY IN SEND OR SHOW WILL INSERT 0000-FFFF IN 12 BIT MODE * %Y IN SEND OR SHOW WILL INSERT 00-FF * %YYY IN SEND OR SHOW WILL INSERT 0000-FFFF * %Z IN SEND OR SHOW WILL INSERT 00-FF * %ZZZ IN SEND OR SHOW WILL INSERT 0000-FFFF SPACE SSET CALL SSETCSCT CALL PROCESSOR CH R15,=AL2(4) CHECK RETURN CODE BL PMODNSI 0=OK B PMODBADC X=ILLEGAL FORM SPACE * ******************************************************************* * * * SET A LOOP COUNT IN+3 -->LSET IN+8-->X,NNNN * * * ******************************************************************* * SPACE * LSET A,N A,NN A,NNN A,NNNN * LSET B,N B,NN B,NNN B,NNNN * LSET C,N C,NN C,NNN C,NNNN * * THIS SSET ONE OF SEVERAL COUNTERS USED IN THE LOOP COMMAND SPACE LSET CALL LSETCSCT CALL PROCESSOR CH R15,=AL2(4) CHECK RETURN CODE BL PMODNSI 0=OK BE PMODNUMR 4=NOT NUMERIC B PMODBADC 8=ILLEGAL FORM SPACE * ******************************************************************* * * * BUILD THE LIST IN+3 -->LIST IN+8->NN * * * ******************************************************************* * SPACE LIST LA R1,LISTAREA R1 TO LISTAREA MVC 0(48,R1),IN+8 COPY OPERANDS OVER B PMODNSI PROCEED SPACE * ******************************************************************* * * * SET STEPPER ON OR STEPPER OFF ->DBUG IN+8->?? * * * ******************************************************************* * SPACE DBUG MVI SAVEFLAG,X'FF' SET STEPPER ON CLC IN+8(2),=C'ON' SET ON BE PMODNSI YES MVI SAVEFLAG,0 SET OFF B PMODNSI PROCEED EJECT * ******************************************************************* * * * READ FROM MAIN USER TERMINAL TO PROGRAM MEMORY * * * ******************************************************************* * SPACE INPT TERMIO PUT,LINE,ASIS,=C'*ENTER*',7 PROMPT HIM BAL R14,READL INPUT FROM OPERATOR *---+ MVI IN+21,C'''' SHROUD DATA ? MVC IN+22(46),WORKDATA COPY TO THIS LINE <---+ MVC SETIVALU(2),WORKDATA COPY TO VARIABLE ALSO MVC SETJVALU(2),WORKDATA+2 COPY TO VARIABLE ALSO MVC SETKVALU(2),WORKDATA+4 COPY TO VARIABLE ALSO MVI IN+22+46,C'''' SHROUD DATA *** *** COPY READ DATA BACK TO PROGRAM MEMORY *** L R1,CURRENT GET REAL LINE IN PGM MVC 0(80,R1),IN COPY DATA BACK CLC WORKDATA(4),=C'STOP' DID HE ENTER STOP BE PMODINTR YES CLC WORKDATA(4),=C'STEP' DID HE ENTER STEP BNE PMODNSI NO MVI SAVEFLAG,X'FF' SET STEPPER ON B PMODNSI NEXT INSTRUCTION EJECT * ******************************************************************* * * * SHOW THE SPECIFIED LINE IN+3 -->SHOW IN+8 -->NN * * * ******************************************************************* * SPACE SHOW CLC IN+8(3),=C'CNM' TEST FOR BE SHOWCNM DUMP CNM RPL CLC IN+8(3),=C'RPL' TEST FOR BE SHOWRPL DUMP RPL CLC IN+8(3),=C'IOB' TEST FOR BE SHOWIOB DUMP IOB CLC IN+8(3),=C'CCW' TEST FOR BE SHOWCCW DUMP CCW CLC IN+8(3),=C'READ' TEST FOR BE SHOWREAD DUMP READ STACK CLC IN+8(3),=C'DATA' TEST FOR BE SHOWDATA DUMP READ STACK FULLY CLC IN+8(3),=C'TEXT' TEST FOR BE SHOWTEXT DUMP CCW TEXT DATA LA R2,IN MAKE CURRENT CLI IN+8,C'*' SHOW CURRENT BE SHOWCRNT YES PGLIN FROM=IN+8,ERROR=PMODBADL DO CONVERSION * R0 = ACTUAL LINE NUMBER IF VALID (00-FF) * R1 = ACTUAL LINE TEXT IF LINE NUMBER VALID (00-FF_ LR R2,R1 GET LINE SHOWCRNT MVC OUT(80),0(R2) COPY RELEVANT LINE *** *** *** LA R0,75 LOOK FOR 48 BYTES LA R1,OUT+5 START HERE TERMIO PUT,LINE,ASIS,OUT,78 SHOW RELEVANT LINE B PMODNSI GET NEXT SPACE SHOWRPL BAL R14,SHOWRPLS DO IT B PMODNSI GET NEXT SEQUENTIAL INSTR SHOWCNM BAL R14,SHOWCNMS DO IT B PMODNSI GET NEXT SEQUENTIAL INSTR EJECT * ******************************************************************* * * * SHOW THE READ BUFFER ELEMENTS AND THE CCW DATA AREA * * * ******************************************************************* * SPACE *** *** SHOW THE TEXT AREA FOR THE CCWS *** SHOWTEXT BAL R14,SHOWTXTD SHOW THE CCW DATA B PMODNSI GET NEXT INSTRUCTION SPACE *** *** SHOW THE IOB *** SHOWIOB LA R2,SAVEAREA GET SAVE AREA A R2,=A(IOB-SAVEAREA) GET ADDRESS ST R2,TXTDDISP SAVE RELATIVE 0 MVC TXTDDISP+4(4),=CL4'IOB' SAY TYPE OF DATA BAL R3,TXTDDUMP SHOW THE CCW DATA B PMODNSI GET NEXT INSTRUCTION SPACE *** *** SHOW THE CCWS *** SPACE SHOWCCW LA R2,SAVEAREA GET SAVE AREA A R2,=A(CCW-SAVEAREA) GET ADDRESS ST R2,TXTDDISP SAVE RELATIVE 0 MVC TXTDDISP+4(4),=CL4'CCW' SAY TYPE OF DATA BAL R3,TXTDDUMP SHOW THE CCW DATA B PMODNSI GET NEXT INSTRUCTION *** *** SHOW THE READ BUFFER CHAIN *** SHOWREAD BAL R14,SHOWCHNS SHOW THE CHAINS B PMODNSI GET NEXT INSTRUCTION SPACE *** *** SHOW THE READ BUFFER CHAIN FULLY *** SHOWDATA BAL R14,SHOWSTCK SHOW THE CHAINS FULLY B PMODNSI GET NEXT INSTRUCTION EJECT * ******************************************************************* * * * DETAILED BYTE TESTER IN+3 ->TEST IN+8 -->TYPE * * * * IN+10-->PL IN+14-->VALU * * * * TEST T(PL),XXXX,EQ,PL IN+19-->EQ?NE IN+22-->PL * * * * TEST A(PL),+D=V,EQ,PL IN+19-->EQ?NE IN+22-->PL * * * ******************************************************************* * SPACE TEST LA R0,20 LETS LIMIT SCAN LA R1,IN+8 LETS ALLOW SYMBOLS CALL TESTCSCT PERFORM TEST CH R15,=AL2(4) SEE WHAT TO DO BL PMODNSI 0=NSI BE PMODUSE 4=GOTO B PMODBADL 8=BAD LABEL SPACE * ******************************************************************* * * * TEXT COMPARE IN+3 ->TEST IN+8 -->SIZE * * * * CMPR SIZE,EQ,PL IN+13-->EQ?NE IN+16-->PL * * * ******************************************************************* * SPACE CMPR LA R0,20 LETS LIMIT SCAN LA R1,IN+8 LETS ALLOW SYMBOLS CALL CMPRCSCT PERFORM TEST CH R15,=AL2(4) SEE WHAT TO DO BL PMODNSI 0=NSI BE PMODUSE 4=GOTO B PMODNUMR 8=BAD SIZE (<0 OR TOO BIG) SPACE * ******************************************************************* * * * UNCONDITIONAL GOTO IN+3 ->GOTO IN+8 -->NN * * * ******************************************************************* * SPACE GOTO CALL GOTOCSCT DO CONVERSION CH R15,=AL2(4) CHECK RETURN CODE BL PMODUSE 00 GOTO B PMODBADL XX ERROR SPACE * ******************************************************************* * * * GOTO NN IF IN LOOP IN+3-->LOOP IN+8-->X,NN * * * ******************************************************************* * SPACE LOOP CALL LOOPCSCT PROCESS CH R15,=AL2(4) CHECK RETURN CODE BL GOTO 00 LOOP BE PMODNSI 04 NSI B PMODBADC 08 BAD COMMAND TITLE '*** TERMINATION OF A RUN REQUEST ***' * ******************************************************************* * * * A RUN HAS ENDED FOR ONE REASON OR ANOTHER * * * ******************************************************************* * SPACE 3 SPACE 3 *********************************************************************** * * * EEEEE DDDDD I TTTTTTT / * * E D D I T / * * E D D I T / SSSSS TTTTTTTT OOOOO PPPPP * * EEEE D D I T / S T O O P P * * E D D I T / S T O O P P * * E D D I T / SSSS T O O PPPPPP * * EEEEE DDDDD I T / S T O O P * * S T O O P * * SSSSS T OOOOO P * * * * * * * *********************************************************************** EJECT * ******************************************************************* * * * ABENDS * THERE WAS AN ERROR DETECTED EXECUTING A PROGRAM * * * ******************************************************************* * SPACE *** *** PMOD ABNORMAL ENDS ARE HERE *** PMODBKTR L R2,=A(ERMSBKTR) BRACKET ERROR B PMODAEND PMODCHTR L R2,=A(ERMSCHTR) CHAIN ERROR B PMODAEND PMODRSTR L R2,=A(ERMSRSTR) RESPONSE ERROR B PMODAEND PMODLOOP L R2,=A(ERMSLOOP) IN A LOOP B PMODAEND PMODBADC L R2,=A(ERMSBADC) BAD COMMAND B PMODAEND PMODFUTR L R2,=A(ERMSFUTR) FUTURE FEATURE B PMODAEND PMODNUMR L R2,=A(ERMSNUMR) NUMERIC ERROR B PMODAEND PMODCMDD L R2,=A(ERMSCMDD) NO NODE YET NEEDED B PMODAEND PMODNLDR L R2,=A(ERMSNLDR) NAME NOT FOUND B PMODAEND PMODBADL L R2,=A(ERMSBADL) LINE NOT NUMERIC B PMODAEND PMODLBER L R2,=A(ERMSLBER) LABEL ERROR B PMODAEND PMODNSIH L R2,=A(ERMSNSIH) NSI GT 7F B PMODAEND PMODERSP L R2,=A(ERMSERSP) ERROR=STOP AND SENSE B PMODAEND PMODCNTZ L R2,=A(ERMSCNTZ) SEND COUNT 0 B PMODAEND PMODCNTH L R2,=A(ERMSCNTH) SEND COUNT GT 6144 B PMODAEND PMODINTR L R2,=A(ERMSINTR) INPT AND STOP B PMODAEND PMODOPER L R2,=A(ERMSOPEN) OPEN ERROR B PMODAEND PMODCCWL L R2,=A(ERMSCCWL) CCW CHAIN WILL LOOP B PMODAEND PMODOVRN L R2,=A(ERMSOVRN) MEMORY WAS OVERUN B PMODAEND EJECT * ******************************************************************* * * * CLEANUP * WE HAVE FINISHED THE TEST * * * ******************************************************************* * SPACE *** *** ABNORMAL END CLEAN UP IS HERE *** PMODAEND MVC IN(80),TRCESTMT+5 COPY TRACE LIST TO IN MVC IN+76(4),=CL4' ' LOSE GARBAGE DATA AT END MVC IN(20),0(R2) COPY ERROR MESSAGE TO "IN" MVC IN+20(10),=CL10'***STOP***' SAY SCREW UP BAL R14,PMODDIAG SHOW AND PAUSE TM DCB+48,X'10' DCB OPEN BO PMODAENX SKIP SUBSIO CLOSE AND DO O.S. TM ACB+48,B'00010000' IS ACB ALREADY OPEN BZ PMODAENC YES SO CLOSE IT LA R2,ACB GET THE ACB CLOSE ((R2)) CLOSE IT PMODAENC SUBSIO CLOSE CLOSE B PMODEDIT WHAT NOW PMODAENX LA R2,DCB GET THE DCB CLOSE ((R2)) CLOSE IT B PMODEDIT WHAT NOW *** *** PMOD NORMAL END IS HERE *** PMODNEND CLI SAVEFLAG,X'FF' ARE WE IN STEPPER BNE *+4+8 NO LA R2,=CL20'*** NORMAL ***' B PMODAEND STOP TM DCB+48,X'10' DCB OPEN BO PMODNENX SKIP SUBSIO CLOSE AND DO O.S. TM ACB+48,B'00010000' IS ACB ALREADY OPEN BZ PMODNENC YES SO CLOSE IT LA R2,ACB GET THE ACB CLOSE ((R2)) CLOSE IT B PMODNENQ WHAT NOW PMODNENC SUBSIO CLOSE CLOSE B PMODNENQ WHAT NOW PMODNENX LA R2,DCB GET THE DCB CLOSE ((R2)) CLOSE IT PMODNENQ TERMIO PUT,LINE,ASIS,=C'*END* (CLR/PF3=QUIT)',20 BAL R14,READP PAUSE * CLI WORKDATA,X'F3' PF3 *860815 * BE PMODEXIT EXIT *860815 B PMODEDIT ALLOW BRAND NEW EDIT TITLE '*** COMMON SUBROUTINES AND DATA ***' * ******************************************************************* * * * COMMON SUBROUTINES AND DATA NOW FOLLOW * * * ******************************************************************* * SPACE 3 SPACE 3 *********************************************************************** * * * * * CCCCC OOOO M M M M OOOOO N N * * C O O MM MM MM MM O O NN N * * C O O M M M M M M M M O O N N N * * C O O M M M M M M O O N N N * * C O O M M M M O O N N N * * C O O M M M M O O N NN * * CCCCC OOOO M M M M OOOOO N N * * * * * * THESE ARE B-DDD ADDRESSABLE AND INVOKED BY A "BAL" * * * * * *********************************************************************** EJECT * ******************************************************************* * * * BUILD STEPPER/AEND PANEL. IN=NSI OR ABEND MESSAGE * * * ******************************************************************* * SPACE PMODDIAG ST R14,SAVEDLNK SAVE LINKAGE PMODSTEP EQU * LOOP BACK LM R2,R3,=A(STEPMENU,STEPSIZE) GET INFO USING STEPMENU,R2 SAY OK L R1,LASTCMND GET ADDRESS OF LAST INSTRUCTION MVC STEPLC(78),0(R1) COPY WHAT WE JUST DID MVC STEPTC(78),IN COPY WHAT WE WILL DO * UNPK STEPCTR+16(5),LIMIT+1(3) GET THE OI STEPCTR+20,C'0' I COUNTER * UNPK STEPABC+16(5),SETACNTR+1(3) UNPK STEPABC+24(5),SETBCNTR+1(3) UNPK STEPABC+32(5),SETCCNTR+1(3) OI STEPABC+16+4,C'0' OI STEPABC+24+4,C'0' OI STEPABC+32+4,C'0' * UNPK STEPXYZ+16(5),SETXVALU+2(3) UNPK STEPXYZ+24(5),SETYVALU+2(3) UNPK STEPXYZ+32(5),SETZVALU+2(3) TR STEPXYZ+16(4),TAB-240 TR STEPXYZ+24(4),TAB-240 TR STEPXYZ+32(4),TAB-240 MVI STEPXYZ+16+4,C' ' MVI STEPXYZ+24+4,C' ' MVI STEPXYZ+32+4,C' ' * MVC STEPLLL+16(2),LISTAREA MVC STEPLLL+23(14),LISTAREA+2 * MVC STEPIJK+16(2),SETIVALU MVC STEPIJK+24(2),SETJVALU MVC STEPIJK+32(2),SETKVALU EJECT * ******************************************************************* * * * BUILD MORE OF IT (TEXT AND READ BUFFER CLUES) * * * ******************************************************************* * SPACE * LA R1,SAVEAREA GET MAIN AREA A R1,=A(TEXT-SAVEAREA) GET START OF TEXT BUFFER UNPK STEPTBX+17(9),0(5,R1) UNPK STEPTBX+17+8(9),4(5,R1) UNPK STEPTBX+17+8+8(9),8(5,R1) UNPK STEPTBX+17+8+8+8(9),12(5,R1) TR STEPTBX+17(32),TAB-240 MAKE PRESENTABLE MVI STEPTBX+17+32,C' ' CLEAN IT MVC STEPTBC(16),0(R1) GET CHARACTERS SERVIO VECTOR,FIELD=FIXTABL AND GET IT TR STEPTBC(16),0(R1) CLEANED * XC WORKDATA(16),WORKDATA CLEAR AN AREA IN CASE L R1,READSTAK GET READ AREA LTR R1,R1 1 ANY THERE LA R1,100(R1) 2 BUT FIRST SET R1 TO DATA BNZ *+8 3 NO SO SKIP LA R1,WORKDATA 4 GET A NULL AREA UNPK STEPRBX+17(9),0(5,R1) UNPK STEPRBX+17+8(9),4(5,R1) UNPK STEPRBX+17+8+8(9),8(5,R1) UNPK STEPRBX+17+8+8+8(9),12(5,R1) TR STEPRBX+17(32),TAB-240 MAKE PRESENTABLE MVI STEPRBX+17+32,C' ' CLEAN IT MVC STEPRBC(16),0(R1) GET CHARACTERS SERVIO VECTOR,FIELD=FIXTABL AND GET IT TR STEPRBC(16),0(R1) CLEANED *** *** SEND AND WAIT *** BAL R14,SENDP SEND PANEL BAL R14,READP READ REQUEST BAL R14,ERASE CLEAR THE SCREEN *** *** CHECK THE PF KEYS *** CLI WORKDATA,C'1' IS THIS PF1 * PF1 IS BNE STEP0200 NO * CANCEL TM DCB+48,X'10' DCB OPEN BO STEP0101 SKIP SUBSIO CLOSE AND DO O.S. SUBSIO CLOSE CLOSE B PMODEXIT WHAT NOW STEP0101 LA R2,DCB GET THE DCB CLOSE ((R2)) CLOSE IT B PMODEXIT WHAT NOW EJECT * ******************************************************************* * * * PROCESS STEPPER OR ABEND CHOICES * * * ******************************************************************* * SPACE STEP0200 CLI WORKDATA,C'2' IS THIS PF2 BNE *+4+8 NO MVI SAVEFLAG,0 YES SO SET OFF TRACES B PMODSTPX CHECK DATA ELSE RUN *** CLI WORKDATA,C'3' IS THIS PF3 BE PMODSTPX YES ***----------------------------------------------------------------*** CLI WORKDATA,C'4' IS THIS PF4 BNE *+4+8 NO BAL R14,SHOWRPLS YES SO SHOW RPL B PMODSTEP THEN RESHOW STEPPER *** CLI WORKDATA,C'5' IS THIS PF5 BNE *+4+20 NO *860710 MVC OT(78),IN SAVE *860710 BAL R14,SHOWCHNS SHOW CHAINS MVC IN(78),OT RESTORE *860710 B PMODSTEP THEN RESHOW STEPPER *** CLI WORKDATA,C'6' IS THIS PF6 BNE *+4+20 NO *860710 MVC OT(78),IN SAVE *860710 BAL R14,SHOWSTCK SHOW STACK MVC IN(78),OT RESTORE *860710 B PMODSTEP THEN RESHOW STEPPER ***----------------------------------------------------------------*** CLI WORKDATA,C'7' IS THIS PF7 BNE *+4+26 NO LA R2,SAVEAREA GET SAVE AREA A R2,=A(IOB-SAVEAREA) ADDRESS ST R2,TXTDDISP SAVE RELATIVE 0 MVC TXTDDISP+4(4),=CL4'IOB' SAY TYPE OF DATA BAL R3,TXTDDUMP SHOW THE CCW DATA B PMODSTEP RESHOW *** CLI WORKDATA,C'8' IS THIS PF8 BNE *+4+26 NO LA R2,SAVEAREA GET SAVE AREA A R2,=A(CCW-SAVEAREA) ADDRESS ST R2,TXTDDISP SAVE RELATIVE 0 MVC TXTDDISP+4(4),=CL4'CCW' SAY TYPE OF DATA BAL R3,TXTDDUMP SHOW THE CCW DATA B PMODSTEP RESHOW *** CLI WORKDATA,C'9' IS THIS PF9 BNE *+4+8 NO BAL R14,SHOWTXTD SHOW TEXT B PMODSTEP THE/ RESHOW STEPPER *** CLI WORKDATA,X'7A' IS THIS PF10 BNE *+4+8 NO BAL R14,SHOW$DEF SHOW MACROS B PMODSTEP THE/ RESHOW STEPPER *** CLI WORKDATA,X'7B' IS THIS PF11 BNE *+4+8 NO BAL R14,SHOWCNMS YES SO SHOW CNM RPL B PMODSTEP THEN RESHOW STEPPER *** EJECT * ******************************************************************* * * * COMPLETE STEPPER AND CHECK IF TO ALTER COMMAND * * * ******************************************************************* * SPACE PMODSTPX CLC WORKDATA+3(3),STEPMOD IS THIS OUR FIELD? BNE *+4+16 NO MVI IN,C' ' CLEAR THE AREA MVC IN+1(73),IN WITH BLANKS FOR UPPER CASE OC IN(74),WORKDATA+6 INSTRUCTION BACK *** *** WORKDATA+0(1) = AID RETURNED *** IN+0(NN) = ACTUAL LINE *** IN+3(NN) = DATA IF HE USED THE CURSOR *** L R14,SAVEDLNK LOAD LINKAGE BR R14 RETURN EJECT * **************************************************************** * * * RUN THE CCW CHAIN TO VERIFY NO LOOPS * * * **************************************************************** * SPACE *** *** *** LOOPTEST LR R3,R14 SAVE LINKAGE LA R1,CCW STARTING CCW LA R0,20 LIMIT (ACTUALLY 15) LOOPTSTC CLI 0(R1),X'08' IS THIS A TIC BNE *+12 NO L R1,0(R1) GET POINTED CCW B LOOPTSTF FOLLOW IT TM 4(R1),X'80'+X'40' ANY CHAINING AT ALL BZ LOOPTSTZ NO SO END OK LA R1,8(R1) GET NEXT LOOPTSTF BCT R0,LOOPTSTC CHECK NEXT TERMIO PUT,LINE,ASIS,=C'CCW TIC LOOP - NEED PASSWORD',28 TERMIO GET,LINE,ASIS,WORKDATA,20 L R1,LUSRTERM GET LUDEFINE L R1,LUDFVCTR-LUDFAREA(R1) GET MASTER VECTOR L R1,72(R1) GET A PASSWORD CLC WORKDATA(8),0(R1) TEST AGAINST MASTER BE LOOPTSTZ YES B PMODCCWL NO SO PASSWORD ERROR LOOPTSTZ BR R3 RETURN EJECT * **************************************************************** * * * SHOW_DATA IS WHOLE CHAIN, SHOW_READ IS A SUMMARY * * * **************************************************************** * SPACE SHOWSTCK L R2,READSTAK GET VERY FIRST CHAIN MVI SHOWMODE,X'FF' FULL MODE LR R3,R14 LOAD LINKAGE BAL R14,ERASE CLEAR B SHOWCH00 *---------+ DO IT * ? SHOWCHNS L R2,READSTAK *---+ ? GET VERY FIRST CHAIN MVI SHOWMODE,0 ? ? MINI MODE LR R3,R14 ? ? LOAD LINKAGE SHOWCH00 LTR R2,R2 <------+<-+ ANY DATA BZ SHOWCHEX RETURN LA R0,24 EDIT 24 BYTES MVI IN,C' ' CLEAR MVC IN+1(79),IN AREA MVC IN(8),=C'-- READ ' HEADER MVC IN+8(2),8(R2) () MVC IN+11(1),10(R2) * MVC IN+13(3),11(R2) OIC MVC IN+17(3),14(R2) DR1 MVC IN+70(4),=C'HEX=' ADVISE THE SIZE (IT RHYMS) UNPK IN+74(5),90(3,R2) RPL DATA SIZE TR IN+74(4),TAB-240 IN HEX MVI IN+78,C' ' CLEANED LA R1,IN+21 START OF INAREA LA R14,100(R2) START OF TEXT SHOWCH01 UNPK 0(3,R1),0(2,R14) <--+ UNPACK TWO BYTES LA R1,2(R1) ? GET NEXT LA R14,1(R14) ? GET NEXT BCT R0,SHOWCH01 *--+ REPEAT TR IN+21(48),TAB-240 FIX MVI IN+21+48,C' ' IT UP TERMIO PUT,LINE,ASIS,IN,78 SHOW THE DATA *** *** IF SHOWMODE=FF THEN DUMP BUFFER ELSE NEXT ELEMENT *** CLI SHOWMODE,0 MODE = 00 MEANS MINI EDIT BE SHOWCH99 SO SKIP TOWN LA R4,100(R2) POINT TO DUMPABLE DATA R4 ST R4,TXTDDISP SAVE RELADDR MVC TXTDDISP+4(4),=C'READ' SAY TYPE B SHOWCH03 FIRST TIME DONT REAPET HEADER SHOWCH02 TERMIO PUT,LINE,ASIS,IN,78 SHOW THE HEADER IF NOT 1ST TIME SHOWCH03 MVC OUT(44),=C'CHAIN (PF8=NEXT 256, PF12=NEXT.CH ELSE QUIT)' *** *** R4 IS THE AREA TO DUMP *** TERMIO PUT,LINE,ASIS,OUT,44 HEADER/REGISTER VALUE LA R5,16 FOR NN LINES R5 MVI OUT,C' ' CLEAN MVC OUT+1(79),OUT AREA EJECT * **************************************************************** * * * NOW SHOW 256 BYTES OF TEXT * * * **************************************************************** * SPACE SHOWCH06 LA R14,8 DO 16 BYTES 8 HWDS R14 LA R15,OUT+13 R4=OUT START OF PRINT R15 LR R1,R4 GET THIS ADDRESS S R1,TXTDDISP MAKE RELATIVE ST R1,WORK SAVE. REL TO THIS CHAIN * GOT A RELATIVE ADDRESS UNPK OUT(7),WORK+1(4) UNPACK TR OUT(6),TAB-240 IN HEX MVI OUT+6,C' ' CLEAN UP MVI OUT+7,C'.' FIX IT UP MVI OUT+54,C'*' GET ACTUAL MVC OUT+55(16),0(4) CHARACTER SERVIO VECTOR,FIELD=FIXTABL CLEAN UP TR OUT+55(16),0(R1) WIERD CODES MVI OUT+71,C'*' DATA SHOWCH07 UNPK 0(5,R15),0(3,4) ONE BYTE TR 0(4,R15),TAB-240 IN HEX MVI 4(R15),C' ' AND A BLANK LA 4,2(4) UP DISK LA R15,5(R15) UP TPUT AREA BCT R14,SHOWCH07 DO AN AREA TERMIO PUT,LINE,ASIS,OUT,78 DISPLAY BCT 5,SHOWCH06 ALLOW 16 LINES BAL R14,READP PAUSE BAL R14,ERASE ERASE CLI WORKDATA,X'F8' IF PLUS BE SHOWCH02 THEN MORE CLI WORKDATA,X'7C' WAS IT PF12 FOR NEXT IN CHAIN BNE SHOWCHEX NO SO SKIP CLC 1(3,R2),=X'000000' NO MORE DATA BE SHOWCHEX SO BYPASS ERASE AND PAUSE *** *** GET NEXT ELEMENT IN CHAIN *** SHOWCH99 L R2,0(R2) GET NEXT B SHOWCH00 AND SHOW IT OR EXIT SPACE SHOWCHEX BAL R14,PAUSE PAUSE IS NEEDED BR R3 RETURN EJECT * **************************************************************** * * * DISPLAY FROM THE STEPPER THE $DEF VALUES * * * **************************************************************** * SPACE SHOW$DEF LR R3,R14 SAVE LINKAGE LA R2,SAVEAREA GET DSA A R2,=A($DEFTABL-SAVEAREA) PLUS DATA AREA LA R4,5 FIVE LINES SHOW$DFL TERMIO PUT,LINE,ASIS,0(R2),65 SHOW IT LA R2,65(R2) GET NEXT BCT R4,SHOW$DFL DO MORE BAL R14,PAUSE PAUSE LR R14,R3 LOAD RETURN BR R14 RETURN EJECT * **************************************************************** * * * SHOW_TEXT WILL SHOW THE TEXT BUFFER * * * **************************************************************** * SPACE SHOWTXTD LA R2,SAVEAREA GET DSA A R2,=A(TEXT-SAVEAREA) PLUS DATA AREA ST R2,TXTDDISP SAVE RELATIVE 0 MVC TXTDDISP+4(4),=CL4'TEXT' SAY TYPE OF DATA LR R3,R14 LOAD LINKAGE *** *** +-------- ALSO BAL'D WITH R3 FROM THE IOB AND CCW DISPLAY *** V TXTDDUMP MVC OUT+4(38),=C' PF7=LAST 256, PF8=NEXT 256, ELSE EXIT' MVC OUT(4),TXTDDISP+4 SAY TYPE BAL R14,ERASE CLEAR TERMIO PUT,LINE,ASIS,OUT,42 HEADER/REGISTER VALUE LA R5,16 FOR NN LINES R5 LR R4,R2 SET R4 AS A WORK REG R4 MVI OUT,C' ' CLEAN MVC OUT+1(79),OUT AREA TXTDDUMA LA R14,8 DO 16 BYTES 8 HWDS R14 LR R15,R4 LOAD ADDRESS S R15,TXTDDISP LOSE START TO MAKE 0000 REL ST R15,WORK SAVE RELATIVE ADDRESS LA R15,OUT+13 R4=OUT START OF PRINT R15 * GOT A RELATIVE ADDRESS UNPK OUT(7),WORK+1(4) UNPACK TR OUT(6),TAB-240 IN HEX MVI OUT+6,C' ' CLEAN UP MVI OUT+7,C'.' FIX IT UP MVI OUT+54,C'*' GET ACTUAL MVC OUT+55(16),0(4) CHARACTER SERVIO VECTOR,FIELD=FIXTABL CLEAN UP TR OUT+55(16),0(R1) WIERD CODES MVI OUT+71,C'*' DATA TXTDDUMB UNPK 0(5,R15),0(3,4) ONE BYTE TR 0(4,R15),TAB-240 IN HEX MVI 4(R15),C' ' AND A BLANK LA 4,2(4) UP DISK LA R15,5(R15) UP TPUT AREA BCT R14,TXTDDUMB DO AN AREA TERMIO PUT,LINE,ASIS,OUT,78 DISPLAY EJECT * ***************************************************************** * * * TEXT ALLOWS LOTS OF SCROLLING, IOB AND CCW DO NOT * * * ***************************************************************** * SPACE *** *** IF DONE 8 LINES AND IF NOT TEXT THEN QUIT *** CLC TXTDDISP+4(4),=CL4'TEXT' IS THIS TEXT BE *+4+8 YES SO ALLOW MORE CH R5,=AL2(9) IF JUST DONE 8 LINES BE *+8 THEN ABORT LOOP BCT 5,TXTDDUMA ALLOW 16 LINES BAL R14,PAUSE PAUSE MVC WORKDATA(1),LUSRMODF COPY THE AID TO THE INAREA *** *** GET ANOTHER 256 OR LAST 256 ONLY IF TEXT (NOT IOB/CCW) *** CLC TXTDDISP+4(4),=CL4'TEXT' IS THIS AN IOB OR CCW, IF SO BNE 0(R3) NO SCROLL, ONLY SCROLL IF TEXT *** LA R2,256(R2) GET NEXT CLI WORKDATA,X'F8' WAS THIS + BE TXTDDUMP NO CLI WORKDATA,X'F7' WAS THIS LOWER BNE 0(R3) NO SO END SH R2,=AL2(512) DOWN 2 SLOTS B TXTDDUMP AND SHOW IT OR EXIT EJECT * **************************************************************** * * * DUMP COMMAND WILL EDIT THE SUB SESSION RPL * * * **************************************************************** * SPACE SHOWCNMS ST R14,RPLSAVER SAVE LINKAGE LA R5,6 R5 IS LIMITER L R3,=A(RPL) GET CNM RPL B RPLS0000 PROCEED SPACE SHOWRPLS ST R14,RPLSAVER SAVE LINKAGE LA R5,6 R5 IS LIMITER L R1,LUSRTERM R1 IS LUDF L R3,LUDFARPL-LUDFAREA(R1) R3 IS THE RPL (TERMIO) CLI DRVRNODE,C'*' WHAT IS THE NODE? BE *+8 OK L R3,LUDFSRPL-LUDFAREA(R1) R3 RPL (SUBSIO) ST R3,THISRPL R3 IS THE RPL UP WHICH WE INCR RPLS0000 MVI OUT,C' ' CLEAN MVC OUT+1(79),OUT AREA MVC OUT(8),DRVRNODE HEADER RPLS0002 LA 2,8 DO 16 BYTES 8 HWDS <------+ LA 4,OUT+13 R4=OUT START OF PRINT ? MVI OUT+54,C'*' GET ACTUAL ? MVC OUT+55(16),0(3) CHARACTER ? SERVIO VECTOR,FIELD=FIXTABL GET TABLE ? TR OUT+55(16),0(R1) CLEAN WIERD CODES ? MVI OUT+71,C'*' DATA ? RPLS0004 UNPK 0(5,4),0(3,3) ONE BYTE <----+ ? TR 0(4,4),TAB-240 IN HEX ? ? MVI 4(4),C' ' AND A BLANK ? ? LA 3,2(3) UP DISK ? ? LA 4,5(4) UP TPUT AREA ? ? BCT 2,RPLS0004 DO AN AREA *----+ ? TERMIO PUT,LINE,ASIS,OUT,78 DISPLAY ? MVI OUT,C' ' CLEAN ? MVC OUT+1(79),OUT AREA ? BCT 5,RPLS0002 ALLOW 16 LINES *---------+ *** *** *** EDIT THE MACRO TYPE *** L R3,THISRPL GET RPL MVC OUT(9),=CL9'MACRO = ?' HEADER CLI 2(R3),X'22' IS THIS BNE *+10 NO MVC OUT+8(7),=CL7'SEND ' CLI 2(R3),X'23' IS THIS BNE *+10 NO MVC OUT+8(7),=CL7'RECEIVE' * TERMIO PUT,LINE,ASIS,OUT,16 SAY MACRO EJECT *** *** EDIT THE BIT SIGNIFICANT DATA *** L R3,THISRPL GET RPL L R4,=A(RPLBIT) GET BIT TABLE RPL0101 CLI 0(R4),X'FF' END OF IT BE RPL0200 YES SO END * LR 14,R3 R14=RPL AH 14,0(R4) PLUS DISP MVC *+7(1),2(R4) BUILD MASK TM 0(14),*-* BIT ON BZ RPL0104 NO TERMIO PUT,LINE,ASIS,4(R4),20 SHOW IT B RPL0105 SKIP NEXT RPL0104 CLI 24(R4),C' ' DO WE HAVE A OFF BIT VALUE BE RPL0105 NO SO SKIP TERMIO PUT,LINE,ASIS,24(R4),20 RPL0105 LA R4,44(R4) NEXT MAP B RPL0101 REPEAT *** *** *** RPL0200 BAL R14,PAUSE PAUSE L R14,RPLSAVER GET LINKAGE BR R14 RETURN EJECT * **************************************************************** * * * TRIVIAL SUBROUTINES TO SAVE CORE ARE HERE * * * **************************************************************** * SPACE PAUSE ST R14,TPTSAVER SAVE LINK TERMIO PUT,LINE,ASIS,=C'***',3 L R14,TPTSAVER LOAD LINK READL ST R14,TPTSAVER SAVE LINK TERMIO GET,LINE,ASIS,WORKDATA,80 PAUSE OR READ L R14,TPTSAVER LOAD LINK BR R14 RETURN SPACE ERASE ST R14,TPTSAVER SAVE LINK TERMIO PUT,PAGE,ASIS,=X'F5C3',2 ERASE L R14,TPTSAVER LOAD LINK BR R14 RETURN SPACE SENDP ST R14,TPTSAVER SAVE LINK TERMIO PUT,PAGE,ASIS,0(2),0(3) SEND A PAGE L R14,TPTSAVER LOAD LINK BR R14 RETURN SPACE READP ST R14,TPTSAVER SAVE LINK TERMIO GET,PAGE,ASIS,WORKDATA,80 PAUSE OR READ L R14,TPTSAVER LOAD LINK BR R14 RETURN EJECT * **************************************************************** * * * CONSTANTS USED IN THIS PROGRAM * * * **************************************************************** * SPACE BINDRQST DC CL8' ',AL2(0),X'00',CL20' ' BINDMESG DC C'BIND PARM DISP=NN,VALUE=XX,LUNAME=XXXXXXXX PMOD' *** *** *** TAB DC C'0123456789ABCDEF' **** **** **** *** EXCP ON IOB WITH BTAM IOB EXTENSION WORKS WITH BTAM DCB *** BUT IT HANGS IF OPEN FINDS DEVICE NOT READY. *** EXCP ON IOB WITH BTAM IOB EXTENSION WORKS WITH PS DCB *** PS AS IT IS PS, DA AS IT GETS BIG DCB EXTENSION. *** OPEN DOES NOT HANG IF DEVICE NOT READY. *** EXCP ON IOB & NO BTAM IOB EXTENSION FAILS WITH PS DCB *** AS IT NEEDS THE UCB INDEX BYTE. ADDITIONALLY IOB+0 *** NEEDS 02 IN IT TO ALLOW PROCEEDING AFTER IO ERRORS *** DCBM DCB DSORG=PS,DDNAME=CMODS,MACRF=(E),DEVD=DA,IMSK=A BTA00970 IOBM DC 0D'0' ALIGNMENT ******** DC X'02',X'00',X'00',X'00' IO FLAGS AND SENSE TRIED ******** DC X'C2',X'00',X'00',X'00' IO FLAGS AND SENSE THEN THIS DC X'C3',X'00',X'00',X'00' IO FLAGS AND SENSE NOW THIS DC X'00',AL3(ECBM) CCODE AND A-ECB DC X'00',7X'00' FLAG AND CSW DC X'00',AL3(CCWM) SIO AND CCW DC X'00',AL3(DCBM) DCB * DC X'00',AL3(CCWM) ERP CCW START DC X'00',AL3(0) ERP CCW START DC AL2(0,0) MISC DC AL1(00),AL3(0) UCB INDEX MUST MUST BE 00 DC AL1(0),X'000000' FLAGS DC XL8'00' CCW ERP DC XL8'00' CCW ERP DC X'00',XL7'00' MISC DC 100X'00' CHAN PROG AREA * CCWM CCW 5,0,X'20',0 WRITE CCW ECBM DC A(0) ECB EJECT * ******************************************************************* * * * CNM ACB AND RPL AND VTAM CONTROL BLOCKS ARE HERE * * * ******************************************************************* * SPACE ACB ACB AM=VTAM, THIS IS VTAM X APPLID=APPL, *-------> APPLID X EXLST=EXLST, *-------> KEY EXITS X PARMS=(NIB=NIB) CNM MUST HAVE THIS X MACRF=LOGON END OF ACB APPL DC X'08',CL8'SHADOWC1' ID FOR TERMINAL ACB * EXLST EXLST AM=VTAM, X TPEND=TPEND * RPL RPL AM=VTAM,NIB=NIB,AREALEN=250,ACB=ACB, X AREA=0,RECLEN=130, *** BELOW FOR CNM *** X CHAIN=ONLY,CHNGDIR=(NCMD,NREQ),BRACKET=(NBB,NEB), X OPTCD=(FMHDR),CONTROL=DATA * NIB NIB PROC=TRUNC, X MODE=RECORD, X LOGMODE=0, CNM X BNDAREA=0, CNM * NAME=XXXXXXXX NOT ALLOWED FOR A CNM * CID DC A(0) CID AT OPEN TIME * *********************************************************************** * EXIT * NAME: TPEND EXIT * TPEND * *********************************************************************** SPACE * USING TPEND,15 SAY BASE FOR CODE TPEND MVI 6(R15),X'FF' SAY LOST BR R14 RETURN DC X'00' <----TPEND+6-------00 MEANS NOT LOST TERM EJECT * ******************************************************************* * * * LITERALS ARE DUMPED HERE * * * ******************************************************************* * SPACE LTORG EJECT * ******************************************************************* * * * NON BASE DISPLACMENT ADDRESSABLE DATA IS HERE * * * ******************************************************************* * SPACE NONADDRD CSECT , MUST USE AN ADCON FOR THESE *** *** *** HDR0 DC CL80'00 ____ __ * ___ ___ X RESULTS. ' *** *** *** HDR1 DC X'F5C31140401D4013',C'>',X'3CC14F40' 13 BYTES DC X'11C1501DF8',C'*',X'3CC25E',C'=',C'* ' 12 BYTES DC C' NM CMND <-OPERANDS-> 0.1.2.3.4.5.6.7.8.9.A.B.C.D.E.' DC C'F.0.1.2.3.4.5.6.7. *RESULT*' 79 DC X'11C3F0' ... 3 BYTES LHDR1 EQU *-HDR1 SIZE = 107 TOTAL *** *** *** HDR2 DC X'F1C3',X'11D940',X'1DF8' HDR2INFO DC CL60' ',C' ' INFORMATIONAL MESSAGE *860731 DC X'115B60',X'1DF8',C'P.' HDR2LDNM DC CL8'NO NAME' MODULE NAME DC X'115BF3',X'1DF8' DC C'PF1=TOP PF2=RUN PF3=QUIT PF7=LAST PF8=NEXT' DC X'115CF0',X'1DF8' HDR2TYPE DC CL8'(N/A)' MODULE SOURCE DC X'115DC3',X'1DF8' DC C'DMOD_XX DBL SAVE/LOAD XXXXX (NO UNDERSCORES)' LHDR2 EQU *-HDR2 SIZE *** *** *** MENU DC X'F5C3' ERASE AND KBD RESTORE DC X'115D7F',X'1DF8',X'114040' PROTECT WHOLE AREA DC CL10'PMODLVL2 ' SHIFT SCREEN 15 BYTES K '**************************************************************' K '* READY TO RUN. PF1=STEPPER, ENTER=PF2=RUN *' K '*------------------------------------------------------------*' K '* LUNAME ----> LUNAME__ -AND-> BLANK.... LU DEFAULT *' K '*-------------------------------+ XXXXXXXX. SPECIFIC CHOICE *' K '* THIS CRT---> *_______ ? *XXXXXXX FMH1 TO BE SET *' K '*-------------------------------+ ? *************' K '* CHANNEL----> DDNAME ? ? * CLEAR/PF3 *' K '*****************?*****************?**************************' DC C' V V' DC X'115B6A' K '*==================================IF LUNAME=================*' DC C'*----> LU?*?DD-> *_______ BIND -> ________ ' DC X'115D4A',X'1DC1',X'13' 24 27 INLU DC X'115D4B',CL8'*',X'1DF0' 24 28 DC X'115D5C',X'1DC1' 24 45 INBD DC X'115D5D',CL8' ',X'1DF0' 24 46 LMENU EQU *-MENU EJECT * ******************************************************************* * * * STEPPER FOR PMOD IS HERE (THE MENU ANYWAY) * * * ******************************************************************* * SPACE STARTMSG DC CL80'*** STARTING ***' SIMULATED LAST COMMAND SPACE STEPMENU DC X'F5C3',X'115D7F',X'1DF8',X'114040' DC C'*',X'3CC14D',C'-*',X'11C150' DC C'LAST COMMAND WAS....',X'11C260' STEPLC DC CL78'*** STARTING ***',X'11C3F0' * DC C'THIS COMMAND WILL BE',X'11C47F',X'1DC1' *860710 DC C'THIS COMMAND WILL BE',X'11C47F',X'1D40' DC X'11C5C3',X'13' SET CURSOR TO COMMAND STEPMOD DC X'11C540' BUFFER FOR NEXT LINE STEPTC DC CL78' ',X'1DF8',X'11C650' DC C'*',X'3CC75D',C'-*',X'11C8F0' DC X'114A40' DC X'114B50' DC X'114C60' STEPABC DC C'LOOP COUNTERS A=XXXXX B=XXXXX C=XXXXX ' DC C' PF1=QUIT PF2=RUN PF3=STOP',X'114DF0' STEPXYZ DC C'SYMBOLICS X=XXXX Y=XXXX Z=XXXX ' DC C' PF4=RPL PF5=READ PF6=DATA',X'114F40' STEPLLL DC C'LIST SYMBOL L=XX (XXYYXXYYXXYYXX..)' DC C' PF7=IOB PF8=CCW PF9=TEXT',X'115050' STEPIJK DC C'INPUT SYMBOL I=XX J=XX K=XX ' DC C' PFA=$DEF PFB=CNM',X'11D160' DC X'11D2F0' STEPCTR DC C'I-COUNTER *=XXXXX ' DC X'11D440' DC X'11D550' DC X'11D660' STEPTBX DC C'TEXT BUFFER 0000 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *' STEPTBC DC C'................* ',X'11D7F0' STEPRBX DC C'READ BUFFER 0000 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *' STEPRBC DC C'................* ',X'11D940' DC X'115A50' DC C'*** YOU MAY ALTER "NEXT COMMAND" EXCEPT AT "STOP" ***' DC X'115B60' DC C'*** PFKEYS ARE VALID EXCEPT AT "STOP" ***' DC X'115CF0' DC C'*** ENTER TO PROCEED *** PF3 TO ABORT ***' STEPSIZE EQU *-STEPMENU EJECT * ******************************************************************* * * * NON BASE DISPLACMENT ADDRESSABLE DATA IS HERE * * * ******************************************************************* * SPACE HELPCMND DC 0A(0) HELP FACILITY DC C'HEL? <--- PLACE "?" HERE AND PRECEDE WITH INSTRUCTION FOR HELP.' DC C'SRS____?XXXXYYYY?XXXXYYYY,LUS (RESET, DEFERRED RESP, IMMED LUS)' DC C'RQMREAD?TT,PRID,PU (*>810810,410304,TT,PRID,PU)(READS RECFMS)' DC C'RTMTEST,PUNAME (SENDS 810810,41038D TO PU USING TEXT BUFFR) ' DC C'EXEPOST?STAK LU,"A/B/.."?LOGON LUNM____,BIND____ (LIKE EXEC)' DC C'$DEDEFINE EXECUTE TIME MACRO $DEF=X=YYYY USED BY $X (X=1 TO 5)' DC C'DBUON?OFF (PROGRAM CONTROLS THE STEPPER)' DC C'CAT(THIS CONCATENATES LAST FIC+MIC+LIC ON READ TO ONE BIG OIC.)' DC C'CCWOP00ADDRFF00SIZE CCW0-CCW9 COMMAND, BUILDS NTH CCW FOR EXCP' DC C'EXC EXECUTES A CHANNEL PROGRAM BUILT BY CCW0-CCWF' DC C'SUBTERSE?VRBOSE ALTERS SUBSESSION MESSAGE LOGGING' DC C'SSES,+N?X,-N?NN WHERE S=X?Y?Z AND N=0-9 SETS SYMBOLS' DC C'LSER,N WHERE R=A?B?C AND N=1-9999 USED BY LOOP R,PL' DC C'TESS?D?V?T?A(PL),XXYY,EQ?NE,PL ' DC C'CMPSIZE,EQ?NE,PL TEXT:1ST RU FOR DECIMAL SIZE 0001-4000' DC C'LOOR,PL R=R-1; IF R>0 THEN GOTO PL ELSE NSI' DC C'JUMNAME READS PMOD FILE "NAME" IN AND STARTS EXECUTION AT 00' DC C'TEXNNNN,XX..?NNNN,"CC.."?DMOD=NAME?READ ' DC C'ERG THIS OVERIDES THE ERROR STOP MAIN DEFAULT' DC C'SHOPL?READ?DATA?RPL?CNM?TEXT?IOB?* ' DC C'INPREAD FROM CONTROLLING LU, SETS %I, %J, %K, TESTS STEP?STOP ' DC C'SALLIKE SEND BUT USES ALT CODE. BIND+6 08 BIT ON? (COMPROT+0) ' DC C'SENAB C DIC RRR AB=()?)(?BB?EB, C=C?N D=O?F?M?L RRR=DR1?DR2?EX' DC C'REAAB C DIC RRR (READS DATA TILL LIC?OIC) AND SHOWS 1ST RU NOW)' DC C'SAVREAD?TEXT,DMOD=NAME (SAVE TEXT OR 1ST RU OF READ TO DMOD)' DC C'LISAABBCCDD.... USED TO SET THE PERCENT L VARIABLE' DC C'BIND=DD,V=VV<,LU=>?__ CHANGE/BIND ' DC C'NODENAME (UNBIND THIS AND BIND TO A NEW TERMINAL)' DC C'UNBUNBIND THIS SUBSESSION, FOLLOWED BY A BIND COMMAND LATER' DC C'PSPTEXTOUT/TEXTIN/SEND PSPC SPECIFIC LOGIC (DIA/DCA ETC)' DC X'FFFFFFFFFFFFFFFF' END SPACE ERMSBKTR DC CL20'*BKTS* () )( BB EB* ' ERMSCHTR DC CL20'*FIC MIC LIC OIC* ' ERMSRSTR DC CL20'*RESP* DR1 DR2 EX* ' ERMSLOOP DC CL20'*LOOP>9999* ' ERMSBADC DC CL20'*BAD COMMAND* ' ERMSFUTR DC CL20'*FUTURE COMMAND* ' ERMSNUMR DC CL20'*NUM ERR OR TOO BIG*' ERMSCMDD DC CL20'*NO NODE SO ERR* ' ERMSNLDR DC CL20'*NAME NOT FOUND* ' ERMSBADL DC CL20'*REF DIGIT ERROR* ' ERMSLBER DC CL20'*REF LINE .GT. 7F* ' ERMSNSIH DC CL20'*NSI WOULD BE GT 7F*' ERMSERSP DC CL20'*SNS && ERROR=STOP* ' ERMSCNTZ DC CL20'*SEND COUNT = 0* ' ERMSCNTH DC CL20'*SEND COUNT > 6144* ' ERMSINTR DC CL20'*INPT DATA=STOP* ' ERMSOPEN DC CL20'*EXCP/VTAM OPEN ERR*' ERMSCCWL DC CL20'*CCW CHAIN MAY LOOP*' ERMSOVRN DC CL20'*MEMORY OVERUN*DSA* ' EJECT * ******************************************************************* * * * NON BASE DISPLACMENT ADDRESSABLE DATA IS HERE * * * ******************************************************************* * SPACE DC 0A(0) ALIGNMENT ******************** VECTOR DC CL4'GOTO',A(GOTO) GOTO * 4 BYTE CONSTANT * DC CL4'SUBS',A(SUBSCTL) SUBS * BUT 3 BYTE CLC.. * DC CL4'TEST',A(TEST) TEST * SO... * DC CL4'SHOW',A(SHOW) SHOW * AND WATCH OUT * DC CL4'INPT',A(INPT) INPUT * FOR CCWN * DC CL4'READ',A(RECV) READ ******************** DC CL4'CAT ',A(CAT) CAT DC CL4'SEND',A(SEND) SEND EBCDIC OR SESSION CONTROL DC CL4'SALT',A(SALT) SEND ASCII DC CL4'SSET',A(SSET) SSET (SET SYMBOLS X,Y,Z) DC CL4'LSET',A(LSET) LSET (SET LOOP A,B,C) DC CL4'LOOP',A(LOOP) LOOP DC CL4'ERGO',A(ERGO) ERROR GO DC CL4'STOP',A(PMODNEND) STOP DC CL4'SRSP',A(SRSPCSCT) SET FUTURE RESPONSE DC CL4'UNB',A(UNB) UNBIND DC CL4'BIND',A(BIND) BIND DC CL4'DBUG',A(DBUG) DEBUG FACILITY DC CL4'LIST',A(LIST) LIST DC CL4'CCW ',A(CCWBCSCT) CCW PROCESSOR DC CL4'JUMP',A(JUMPCSCT) LOAD A NEW PMOD PROGRAM DC CL4'TEXT',A(TXTBCSCT) TEXT BUILDER DC CL4'SAVE',A(SAVE) SAVE READ 1ST RU TO DISK DC CL4'EXCP',A(EXCP) EXECUTE CHANNEL PROGRAM DC CL4'CMPR',A(CMPR) COMPARE READ STACK::TEXT BUILT DC CL4'RQM ',A(PMODCNMP) CNM (RQMS/RTM PROCESSOR) DC CL4'RTM ',A(PMODCNMP) CNM (RQMS/RTM PROCESSOR) DC CL4'PSPC',A(PSPCCSCT) PSPC TEXTIN/OUT AND SEND * DC CL4'NOP ',A(PMODNSI) NULL * DC CL4'EXEC',A(PMODEXEC) SIMULATE EXEC PROCESSOR * DC CL4'$DEF',A(...) DEFINE MACRO DC X'FF' END OF VECTOR EJECT * ******************************************************************* * * * NON BASE DISPLACMENT ADDRESSABLE DATA IS HERE * * * ******************************************************************* * SPACE HELP DC X'F5C3' ERASE AND KBD RESTORE *860807 DC X'115D7F',X'1DF8',X'114040' PROTECT WHOLE AREA * DC CL10'PMODLVL2 ' SHIFT SCREEN 15 BYTES V K '*****************************************************************' K '* NM SEND () * OIC DR1 DATA?SHUTD?CLR?SDT?CSDT?CHASE?CANCEL?...*' K '* ? BB C FIC DR2 ? ...?SIGNAL........ *' K '* ? )( ? MIC EX DATA SOURCE IF QUOTED--+ ************' K '* ? EB ? LIC +---RESPONSE DESIRED ? * @=SBA=11 *' K '* ? ? ? +-------CHAINING DESIRED +-->* #=IC =13 *' K '* ? ? +---------C=CD, *=DONT * $=SF =1D *' K '* ? +------------BRACKETS * &&=RA =3C *' K '* NM SRSP/READ (GETS A CHAIN)(SEE SHOW READ?DATA) ************' K '* NM LSET/LOOP/SSET/GOTO/TEST/JUMP/UNB/BIND/SAVE/ * ENTER *' K '* 00 SHOW/INPT/STOP/ERGO/SUBS/CCWX/TEXT/EXCP/ ************' K '* 7F RQMS/RTM/PSPC/END_/CAT/DBUG/EXEC/$DEF/$X.. * PF3/CLEAR*' K '*****************************************************************' DC C'PRELOAD -->',X'1DC1',X'13',CL8' ',X'1DF8' LHELP EQU *-HELP MEMSIZE EQU 8*16*80 EJECT * ******************************************************************* * * * NON BASE DISPLACMENT ADDRESSABLE DATA IS HERE * * * ******************************************************************* * SPACE RPLBIT DC AL2(16),X'8000',CL20'BEGIN BRACKET',CL20' ' DC AL2(16),X'4000',CL20'END BRACKET ',CL20' ' DC AL2(16),X'2000',CL20'CHANGEDIR=CMD',CL20' ' DC AL2(16),X'1000',CL20'CHANGEDIR=REQ',CL20' ' DC AL2(17),X'4000',CL20'END BRACKET ',CL20' ' DC AL2(17),X'0800',CL20'RTYPE=RESP ',CL20' ' DC AL2(17),X'0400',CL20'RTYPE=NDFSYN ',CL20' ' DC AL2(17),X'0200',CL20'RTYPE=DFASY ',CL20' ' DC AL2(17),X'8000',CL20'STYPE=RESP ',CL20' ' DC AL2(18),X'8000',CL20'CHAIN=FIRST ',CL20' ' DC AL2(18),X'4000',CL20'CHAIN=MIDDLE ',CL20' ' DC AL2(18),X'2000',CL20'CHAIN=LAST ',CL20' ' DC AL2(18),X'1000',CL20'CHAIN=ONLY ',CL20' ' DC AL2(20),X'8000',CL20'POST=SCHED ',CL20'POST=RESPOND' DC AL2(20),X'0800',CL20'RESPOND=QRESP',CL20' ' DC AL2(20),X'0400',CL20'RESPOND=EX ',CL20'RESPOND=NEX' DC AL2(20),X'0200',CL20'RESPOND=NDR1 ',CL20'RESPOND=DR1' DC AL2(20),X'0100',CL20'RESPOND=DR2 ',CL20'RESPOND=NDR2' DC AL2(40),X'0800',CL20'OPTCD=ASY ',CL20'OPTCD=SYN' DC AL2(21),X'8000',CL20'CTL=DATA ',CL20' ' DC AL2(21),X'4000',CL20'CTL=CANCEL ',CL20' ' DC AL2(21),X'2000',CL20'CTL=QC ',CL20' ' DC AL2(21),X'1000',CL20'CTL=QEC ',CL20' ' DC AL2(21),X'0800',CL20'CTL=CHASE ',CL20' ' DC AL2(21),X'0400',CL20'CTL=RELQ ',CL20' ' DC AL2(22),X'8000',CL20'CTL=BID ',CL20' ' DC AL2(22),X'4000',CL20'CTL=RTR ',CL20' ' DC AL2(22),X'2000',CL20'CTL=LUS ',CL20' ' DC AL2(22),X'1000',CL20'CTL=SIGNAL ',CL20' ' DC AL2(22),X'0800',CL20'CTL=BIND ',CL20' ' DC AL2(22),X'0400',CL20'CTL=UNBIND ',CL20' ' DC AL2(22),X'0200',CL20'CTL=SBI ',CL20' ' DC AL2(22),X'0100',CL20'CTL=BIS ',CL20' ' DC AL2(23),X'8000',CL20'CTL=SDT ',CL20' ' DC AL2(23),X'4000',CL20'CTL=CLEAR ',CL20' ' DC AL2(23),X'2000',CL20'CTL=STSN ',CL20' ' DC AL2(23),X'1000',CL20'CTL=SHUTD ',CL20' ' DC AL2(23),X'0800',CL20'CTL=SHUTC ',CL20' ' DC AL2(23),X'0400',CL20'CTL=RQR ',CL20' ' DC AL2(23),X'0200',CL20'CTL=RSHUTD ',CL20' ' DC X'FF' EJECT * ******************************************************************* * * * NON ADDRESSABLE DATA IS HERE * * * ******************************************************************* * SPACE SCOTTABL DC C' ABCDEFGHI' * THIS TABLE IS DC X'4A4B4C4D4E4F' ? USED TO SET THE DC C'&&JKLMNOPQR' ? HIGH TWO ORDER DC X'5A5B5C5D5E5F' ? BITS OF EACH OF DC C'-/STUVWXYZ' ? THE TWO ADDRESS DC X'6A6B6C6D6E6F' ? BYTES TO SOME DC C'0123456789' ? VALUE THAT WONT DC X'7A7B7C7D7E7F' * LOOK LIKE A CTL CODE. EJECT * ******************************************************************* * * * SEPARATE CONTROL SECTIONS CALLED BY VECTOR * * * ******************************************************************* * SPACE * ENTER R15 BASE * R14 RETURN TO PMODNSI * R13 DYNAMIC SAVE AREA * R9 LUSRAREA * EXIT R14 RETURN TO PMODNSI SPACE FUTURE CSECT , USING *,R15 L R14,=A(PMODFUTR) STATE FUTURE COMMAND BR R14 RETURN LTORG , LITERALS TITLE '*** DUMMY SECTIONS - PMOD FACILITIES ONLY ***' *********************************************************************** * * * * * DDDDD U U M M M M Y Y * * D D U U MM MM MM MM Y Y * * D D U U M M M M M M M M Y Y * * D D U U M M M M M M Y * * D D U U M M M M Y * * D D U U M M M M Y * * DDDDD UUUU M M M M Y * * * * * * THESE ARE DSECTS. THESE ARE USED BY THIS PMOD * * PROGRAM ONLY. * * * *********************************************************************** SPACE * ******************************************************************* * * * NOTES ABOUT CERTAIN SIZE INTERACTIONS * * * ******************************************************************* * SPACE * * SCRNSIZE 1600 USED ONLY FOR FULL SCREEN I/O WHEN EDITING, * AND HAS NO INTERACTION, AND MUST HOLD 17 * LINES OF 79 PLUS AID+CSR+CSR = 1384+3 = 1387 * * READSIZE 2500 USED FOR READING CHAIN ELEMENTS AND EACH ONE * HAS 100 BYTES PREFIX, 100 BYTES SUFFIX AND * 2300 BYTES FOR READING. THUS THIS MUST BE * 200 BYTES BIGGER THAN ANY BOUND SLU->PLU * RU SIZE. SAVE_READ,DMOD=NAME USES THIS SIZE * MINUS 200. CMPR_NNNN,CX,PL USES THE SMALLEST * OF READSIZE AND TEXTSIZE FOR LIMITS. * * CATSIZE 6144 USED FOR CONCATENATING A CHAIN OF FIC+MIC+ * LIC TO A SIMULATED OIC FOR CMPR ETC. THE * LAST 2000 BYTES MAY BE REUSED, GUARENTEEING * 4000 BYTES OF PURE TEXT. 6144 USED AS IT IS * NICE CLEAN HEX NUMBER. * * TEXTSIZE 4096 USED TO COPY DMOD FILES TO CORE, TO COMPARE * WITH THE FIRST RU OF A CHAIN, FOR SEND AND * FOR EXCP'S. THE AIM IS FOR 4000 BYTES OF * USEFUL DATA, 4096 USED AS IT IS A NICE HEX * NUMBER. EJECT * ******************************************************************* * * * SAVE AREA IS ALSO DYNAMIC DATA * * * ******************************************************************* * SPACE SAVEAREA DSECT ***DSECT*** SAVEREGS DC 18A(0) SAVE REGS SAVEDLNK DC A(0) SAVE LINK FOR STEPPER/ABEND *** *** INFORMATION GLOBALLY RELATING TO THE TESTED SESSION *** LOADNAME DC CL8' ' PMOD LOAD COMMAND FOR SAVE * LOADTYPE DC CL8' ' SOURCE OF PROGRAM SAVENODE DC CL8' ' NODE SAVEBIND DC CL8' ' BIND SAVETEST DC CL8' ' TEST LASTCMND DC A(0) LAST COMMAND ADDRESS OR LITERAL TXTDDISP DC A(0),CL4' ' MAKE DUMPS REL 0000 AND TYPE *** *** READ USING SUBSIO MAY END UP USING A CHAIN. *** CATSIZE EQU 6144 SIZE OF CAT OPERATIONS READSIZE EQU 2500 SIZE OF EACH ELEMENT READSTAK DC A(0) FIRST OF MANY CHAIN ELEMENTS * ? * +--> A(NEXT),A(THIS_SIZE),DATA) +0=PROTOCOL * ? +40=RPL * A(NEXT),A(THIS_SIZE),DATA) +100=DATA * ? * A(0),A(THIS_SIZE),DATA) *** *** SEND DMOD=NAME CONTROL DATA *** DMODSIZE DC A(0) SIZE OF GETMAINED CORE DMODADDR DC A(0) ADDR OF GETMAINED CORE DMODNAME DC CL8' ' NAME OF SEND DMOD=NAME *** *** SEND DMOD=NAME (AND IT WAS IN FACT FOUND IN CORE) *** LOADADDR DC A(0) ADDR OF A LOAD MODULE *** *** COPIED OVER FROM LINE AND CONVERTED FOR SUBSIO *** SAVEBKTS DC CL3' ' ()_ BB_ )(_ EB_ SAVECHNS DC CL3' ' FIC MIC LIC SAVERESP DC CL3' ' DR1 DR2 EX *** *** *** SAVEFLAG DC X'00' 00=NORMAL, FF=TRACE DC X'00' SPARE DC X'00' SPARE EJECT * ******************************************************************* * * * EXCP INTERFACES ARE HERE * * * ******************************************************************* * SPACE *** *** CONTROL BLOCKS USED FOR EXCP IO *** DCB DCB DSORG=PS,DDNAME=CMODS,MACRF=(E),DEVD=DA LDCB EQU *-DCB SIZE IOB DC 0D'0' ALIGNMENT DC X'02',X'00',X'00',X'00' IO FLAGS AND SENSE DC X'00',AL3(ECBM) CCODE AND A-ECB DC X'00',7X'00' FLAG AND CSW DC X'00',AL3(CCWM) SIO AND CCW DC X'00',AL3(DCBM) DCB DC X'00',AL3(CCWM) ERP CCW START DC AL2(0,0) MISC DC AL1(00),AL3(0) UCB INDEX MUST BE 00 DC AL1(0),X'000000' FLAGS DC XL8'00',XL8'00' CCW ERP DC X'00',XL7'00' MISC DC 100X'00' CHAN PROG AREA LIOB EQU *-IOB SIZE *** *** CCW ELEMENTS ARE CCW0 TO CCWF *** CCW CCW 0,0,X'00',0 0 WRITE CCW CCW 0,0,X'00',0 1 WRITE CCW DC 14D'0' 2 SPARE CCW ECB DC A(0) ECB EJECT * ******************************************************************* * * * INTERNAL SYMBOLICS AND REGISTERS * * * ******************************************************************* * SPACE *** *** VALUES SET AND USED BY A "PMOD" PROGRAM *** SETACNTR DC PL4'0' LSET A,NNNN SETBCNTR DC PL4'0' LSET B,NNNN SETCCNTR DC PL4'0' LSET C,NNNN SETIVALU DC A(0) INPT+0 SSET THIS VALUE SETJVALU DC A(0) INPT+2 SSET THIS VALUE SETKVALU DC A(0) INPT+4 SSET THIS VALUE SETXVALU DC A(0) SSET X, %X %XXX %XXY FUNCTION SETYVALU DC A(0) SSET Y, %Y %YYY SETZVALU DC A(0) SSET Z, %Z %ZZZ LISTAREA DC CL48' ',CL2' ' LIST COMMAND AREA *** *** INTERNAL REGISTERS OF A "PMOD" PROGRAM *** TRCESTMT DC CL80' ' TRACE OF STATEMENTS *** *** INTERNAL REGISTERS OF A "PMOD" PROGRAM *** SHOWMODE DC X'00',AL3(0) 00=MINI MODE, FF=FULL MODE LIMIT DC PL4'0' 99 99 99 9 COMMAND FETCH LIMIT CURRENT DC A(0) A(ACUTAL LINE ITSELF) LABEL DC A(0) INDEX 0-F TO CURRENT LINE INDEX DC A(0) INDEX FOR SCROLLING PAGES EJECT *** *** TEMPORARY WORKING AREAS ARE HERE *** DWD DC D'0' WORK AREA WORK DC A(0,0) WORK AREA THISER DC A(0,0) ERROR CODES FROM SUBSIO THISRPL DC A(0) RPL ADDRESS BEING EDITED RPLSAVER DC A(0) RPL EDIT RETURN ADDRESS TPTSAVER DC A(0) PAUSE/ERASE RTN ADDRESS IN DC CL80' ' LAST IN OR COPY OF LINE1-16 OUT DC CL80' ' A GENERAL MESSAGE AREA OT DC CL78' ' FOR STEPPER - A TEMP AREA *** *** NUMBER OF PAGES AND LINES IN A PAGE *** PAGES EQU 8 NUMBER OF PAGES OF BELOW LINES EQU 16 NUMBER OF LINES BELOW *** *** ACTUAL PROGRAM AREA IS HERE *** LINE0 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE1 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE2 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE3 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE4 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE5 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE6 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE7 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE8 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE9 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE10 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE11 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE12 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE13 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE14 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' LINE15 DC CL80' 0 001 () OIC DR1 S XXXXXXXXXXXXXXXXXXXXXXX' DC (7*16*80)C' ' SEVEN MORE IS 8 PAGES *** *** TEXT BUFFER (SEND_TEXT, TEXT_, CMPR, EXCP) *** DC 16X'00' 1 TEST AREA PREFIX FOR TEXT INS,N TEXT DC 4096C' ' 2 TEXT AREA TEXTSIZE EQU *-TEXT 3 TEXT AREA SIZE DC 16X'00' 4 TEXT AREA PAD FOR OVERUNS *** *** AREA FOR FULL SCREEN I/O *** SCRN DC 1600C' ' FULL SCREEN IO SCRNSIZE EQU *-SCRN FULL SCREEN IO SIZE *** *** *** $DEFTABL DC 5CL65' ' 5 MACRO SLOTS *** *** PAD AREA AND FINALLY THE SIZE OF THIS DSECT FOR GETMAIN *** DSASOVRN DC X'FF0000FF' TESTED FOR SCREW UPS DSASPAR DC 20C' ' PAD FOR GETMAIN OVERUNS DSASIZE EQU *-SAVEAREA *** SIZE FOR GETMAIN *** TITLE '*** DUMMY SECTIONS - DOOMSDAY MACROS ONLY ***' *********************************************************************** * * * * * DDDDD U U M M M M Y Y * * D D U U MM MM MM MM Y Y * * D D U U M M M M M M M M Y Y * * D D U U M M M M M M Y * * D D U U M M M M Y * * D D U U M M M M Y * * DDDDD UUUU M M M M Y * * * * * * THESE ARE DSECTS. THESE ARE USED BY THE DOOMSDAY * * MACROS TERMIO/SUBSIO/DISKIO/STAKIO * * * *********************************************************************** COPY ISHDDSCT TITLE '*** COMMON SUBROUTINES AND DATA ***' * ******************************************************************* * * * COMMON SUBROUTINES AND DATA NOW FOLLOW * * * ******************************************************************* * SPACE 3 *********************************************************************** * * * * * CCCCC OOOO M M M M OOOOO N N * * C O O MM MM MM MM O O NN N * * C O O M M M M M M M M O O N N N * * C O O M M M M M M O O N N N * * C O O M M M M O O N N N * * C O O M M M M O O N NN * * CCCCC OOOO M M M M OOOOO N N * * * * * * THESE ARE CSECTS AND AS SUCH ARE INVOKED BY A "CALL" * * * * * *********************************************************************** TITLE '*** SSET X,Y, Z SET A SYMBOLIC VALUE ***' * ******************************************************************* * * * SSET * SET A SYMBOLIC VALUE * * * ******************************************************************* * SPACE * THIS SSET A VALUE OF 00 TO FF IN THE INDEX REGISTER, IT CAN * BE INCREMENTED OVER FF TO FFFF. * * %X IN SEND OR SHOW WILL INSERT 00-FF * %XXX IN SEND OR SHOW WILL INSERT 0000-FFFF * %XXY IN SEND OR SHOW WILL INSERT 0000-FFFF IN 12 BIT MODE * %Y IN SEND OR SHOW WILL INSERT 00-FF * %YYY IN SEND OR SHOW WILL INSERT 0000-FFFF * %Z IN SEND OR SHOW WILL INSERT 00-FF * %ZZZ IN SEND OR SHOW WILL INSERT 0000-FFFF * * THIS IS INVOKED BY THE FOLLOWING CALL SEQUENCE * * CALL SSETCSCT CALL PROCESSOR * CH R15,=AL2(4) CHECK RETURN CODE * BL PMODNSI 0=OK * B PMODBADC X=ILLEGAL FORM SPACE SSETCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED CLI IN+8,C'X' X REGISTER BNE *+12 NO LA R2,SETXVALU SET POINTER B SSETWORK DO IT CLI IN+8,C'Y' Y REGISTER BNE *+12 NO LA R2,SETYVALU SET POINTER B SSETWORK DO IT CLI IN+8,C'Z' Z REGISTER BNE *+12 NO LA R2,SETZVALU SET POINTER B SSETWORK DO IT B SSETRC04 ERROR EJECT * ******************************************************************* * * * SET THE INDEX REGISTER IN+3 -->SETX IN+8-->XX * * * * IN+8-->+N * * * * (N=1-9) IN+8-->-N * * * ******************************************************************* * SPACE SSETWORK CLI IN+10,C'+' INCREMENT BE SSETPLUS YES CLI IN+10,C'-' DECREMENT BE SSETMNUS YES CLI IN+11,C' ' 00 SSET X,05 IS FORMAT. IF BNE *+4+10 00 SSET X,5 THEN SHIFT AND FIX MVC IN+11(1),IN+10 SHIFT MVI IN+10,C'0' AND MAKE 0X PACKX FROM=IN+10,SIZE=10 PACK SOME BYTES XC 0(4,R2),0(R2) CLEAR MVC 3(1,R2),IN+10 STORE IT B SSETRC00 RETURN *** *** *** SSETPLUS L R1,0(R2) LOAD SR R0,R0 CLEAR NI IN+11,X'0F' LOSE ZONE IC R0,IN+11 LOAD VALUE AR R1,R0 ADD ST R1,0(R2) STORE IT B SSETRC00 GET NEXT SSETMNUS L R1,0(R2) LOAD SR R0,R0 CLEAR NI IN+11,X'0F' LOSE ZONE IC R0,IN+11 LOAD VALUE SR R1,R0 ADD ST R1,0(R2) STORE IT B SSETRC00 GET NEXT SSETRC04 RETURN (14,12),RC=04 NUMBER TOO BIG SSETRC00 RETURN (14,12),RC=0 EXIT OK LTORG , TITLE '*** LSET X,VVVVV SET A LOOP REGISTER ***' * ******************************************************************* * * * LSET * SET A LOOP REGISTER TO SOME VALUE * * * ******************************************************************* * SPACE * THIS SSET ONE OF SEVERAL LOOP COUNTERS. IT IS CALLED BY * * CALL LSETCSCT CALL PROCESSOR * CH R15,=AL2(4) CHECK RETURN CODE * BL PMODNSI 0=OK * BE PMODNUMR 4=NOT NUMERIC/TOO BIG * B PMODBADC 8=ILLEGAL FORM SPACE LSETCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED CLC IN+8(2),=C'A,' SET A COUNTER BNE *+12 NO LA R1,SETACNTR GET COUNTER B LSETVALU DO IT CLC IN+8(2),=C'B,' SET B COUNTER BNE *+12 NO LA R1,SETBCNTR GET COUNTER B LSETVALU DO IT CLC IN+8(2),=C'C,' SET C COUNTER BNE *+12 NO LA R1,SETCCNTR GET COUNTER B LSETVALU DO IT * NOT A, B NOR C COUNTER SO ERROR B LSETRC08 RETURN ON ERROR EJECT LSETVALU MVC IN+8(10),IN+10 SHIFT DOWN OVER THE L, D, R, CLI IN+8,C'0' VALIDATE A COLUMN BL LSETRC04 NUMERIC ERROR PACK 0(4,R1),IN+8(1) PACK AS IF ONE BYTE CLI IN+9,C' ' BLANK BE LSETRC00 GET NEXT CLI IN+9,C'0' VALIDATE A COLUMN BL LSETRC00 NUMERIC ERROR PACK 0(4,R1),IN+8(2) PACK AS IF TWO BYTES CLI IN+10,C' ' BLANK BE LSETRC00 GET NEXT CLI IN+10,C'0' VALIDATE A COLUMN BL LSETRC00 NUMERIC ERROR PACK 0(4,R1),IN+8(3) PACK AS IF THREE BYTES CLI IN+11,C' ' BLANK BE LSETRC00 GET NEXT CLI IN+11,C'0' VALIDATE A COLUMN BL LSETRC00 NUMERIC ERROR PACK 0(4,R1),IN+8(4) PACK AS IF FOUR BYTES CLI IN+12,C' ' BLANK BE LSETRC00 GET NEXT CLI IN+12,C'_' OR UNDERSCORE BE LSETRC00 OK LSETRC04 RETURN (14,12),RC=04 NUMBER TOO BIG LSETRC08 RETURN (14,12),RC=08 BAD COMMAND FORMAT LSETRC00 RETURN (14,12),RC=0 EXIT OK LTORG , TITLE '*** TEST TEST A RETURN CODE ***' * ******************************************************************* * * * TEST * TEST A RETURN CODE OR WHATEVER * * * ******************************************************************* * SPACE * DETAILED SENSE TEST OF SENSE, STATUS OR OTHER RETURNED DATA * * TEST ?(PL),XXXX,CX,PL TEST "T" (TYPE TO TEST) ON THE NAMED * PAGE AND LINE AGAINST A VALUE "XXXX" * FOR A CONDITION "CX" (EQ OR NE) AND * IF TRUE GO TO A NEW PAGE/LINE "PL" * * IN+3 ->TEST THE VERB * IN+8 -->X S=SNA SENSE XXXX * D=DEVICE SENSE XXXX * V=RTNCD/FDBK2 XXXX * A=ANSWER BYTE +D=V * A=ANSWER BYTE DDVV * * D=READ TYPE ALSO CCCC * D=SENSE IF EXCP XX00 * S=ECB+CSW XXYY * T=TEXT BUFFER DISP * * IN+10-->PL TEST FROM THIS LINE * UNLESS T(VV) SEE BELOW * IN+14-->XXXX MATCH AGAINST THIS OR * +D=C ANSWER DISP AND BYTE * IF "A" * DDXX ANSWER DISP AND BYTE * IF "A" * IN+19-->EQ?NE EQ IF = THEN GOTO * NE IF .NE. THEN GOTO * IN+22-->PL LINE TO GO TO * * * TEST T(VV),DISP,CC,PL TEST TEXT BUFFER FOR THIS VALUE AT * DISPLACMENT. NOTE THE REVERSE ORDER. * TEST A(PL),+D=C,CC,PL THIS WOULD BE A CHARACTER TEST OF 1 * BYTE AND * TEST A(PL),DDXX,CC,PL THIS WOULD BE A HEX TEST OF TWO BYTES * BUT... EITHER WAY WE GO TO THE DATA * AND IF A QUOTE WE ADD ONE, SO THIS * WORKS AFTER A READ OR INPT AND THE * USER NEED ONLY THINK IN TERMS OF DATA * AND BOTH TESTS ARE VALID ON BOTH READ * AND INPT. * * * THIS IS CALLED BY THE FOLLOWING SEQUENCE * * CALL TESTCSCT PERFORM TEST * CH R0,=AL2(4) SEE WHAT TO DO * BL PMODNSI 0=NSI * BE PMODUSE 4=GOTO * B PMODBADL 8=BAD LABEL TITLE '*** TEST TEST A RETURN CODE ***' * ******************************************************************* * * * TEST * TEST A RETURN CODE OR WHATEVER * * * ******************************************************************* * SPACE TESTCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED CLI IN+8,C'T' T = TEXT BUFFER? IF SO FORMAT IS BE TESTTEXT DIFFERENT PGLIN FROM=IN+10,ERROR=TESTRC08 DO CONVERSION * * R0=LINE NUMBER IF GOOD (00-7F), R1=TEXT OF LINE * LA R2,70(R1) R2->SNA SENSE BY DEFAULT CLI IN+8,C'S' S = DOES HE WANT SNA SENSE BNE *+12 NO LA R2,70(R1) R2->SNA SENSE B TEST4CLC COMPARE 4 BYTES CLI IN+8,C'D' D = DOES HE WANT DVC SENSE BNE *+12 YES LA R2,74(R1) R2->DVC SENSE B TEST4CLC COMPARE 4 BYTES CLI IN+8,C'V' V = DOES HE WANT VTAM RTNCD BNE *+12 YES LA R2,72(R1) R2->VTAM RTNCD/FDBK2 B TEST4CLC COMPARE 4 BYTES CLI IN+8,C'A' A = DOES HE WANT ACTUAL ANSWER BNE TEST4CLC NO * TESTA CLI IN+15,C'0' CHECK DECIMAL BL TESTRC08 NO LA R2,21(R1) R2->BYTE 00 CLI 0(R2),C'''' IF A QUOTE THEN ADD 1 BNE *+8 NOT QUOTE SO IS HEX ANSWER LA R2,1(R2) IS QUOTE SO AUTO ADD 1 CLI IN+14,C'+' A PLUS SIGN? BNE TESTA2 YES SO IS TEST A 1 BYTE TESTA1 CLI IN+16,C'=' AN EQUALS SIGN? BNE TESTRC08 NO CLI IN+15,C'0' CHECK DECIMAL BL TESTRC08 NO PACK DWD(8),IN+15(1) GET INDEX (DECIMAL) CVB R0,DWD IN HEX AR R2,R0 ADD INDEX TO GET CHARACTER B TEST1CLC PROCEED TESTA2 CLI IN+14,C'0' CHECK DECIMAL BL TESTRC08 NO PACK DWD(8),IN+14(2) GET INDEX (DECIMAL) CVB R0,DWD IN HEX AR R2,R0 ADD INDEX TO GET CHARACTER AR R2,R0 ADD INDEX TO GET PAIR B TEST2CLC PROCEED EJECT * ******************************************************************* * * * TEST * TEST A RETURN CODE OR WHATEVER * * * ******************************************************************* * SPACE *** IN+8 14 *** T(VV),DISP,CX,PL *** TESTTEXT PACKX FROM=IN+10,SIZE=2 PACK THE VALUE PACKX FROM=IN+14,SIZE=4 PACK THE VALUE LH R2,IN+14 GET DISPLACMENT CH R2,=AL2(TEXTSIZE-1) CHECK LIMIT BH TESTRC08 NOT LOOKING GOOD A R2,=A(TEXT-SAVEAREA) PLUS TEXT ADDRESS AR R2,R13 R2=====PLUS DSA ADDRESS=====DATA AREA CLC 0(1,R2),IN+10 TEXT BUFFER::COMMAND LINE B TESTEQNE EJECT * ******************************************************************* * * * TEST * TEST A RETURN CODE OR WHATEVER * * * ******************************************************************* * SPACE *** *** R2--->RELEVANT DATA *** TEST1CLC CLC 0(1,R2),IN+17 DOES IT MATCH HIS DATA B TEST4CLC+6 PROCEED TEST2CLC CLC 0(2,R2),IN+16 DOES IT MATCH HIS DATA B TEST4CLC+6 PROCEED TEST4CLC CLC 0(4,R2),IN+14 DOES IT MATCH HIS DATA *** *** PROCEED AS CONDITION CODE IS NOW SET *** TESTEQNE BE TESTEQ YES *** *** NAMED STATMENT AND HIS TEST ARE NOT EQUAL *** TESTNE CLC IN+19(2),=C'NE' NE SO DID HE WANT NE BE TESTBRCH NE AND WANTED NE SO BR B TESTRC00 NE AND WANTED EQ SO NSI * NAMED STATMENT AND HIS TEST ARE EQUAL TESTEQ CLC IN+19(2),=C'EQ' EQ SO DID HE WANT EQ BE TESTBRCH EQ AND WANTED EQ SO BR B TESTRC00 EQ AND WANTED NE SO NSI * TESTBRCH PGLIN FROM=IN+22,ERROR=TESTRC08 DO CONVERSION ST R0,LABEL SAVE IT * TESTRC04 RETURN (14,12),RC=04 GOTO TESTRC08 RETURN (14,12),RC=08 BAD COMMAND FORMAT TESTRC00 RETURN (14,12),RC=0 NSI LTORG , TITLE '*** CMPR COMPARE READ STACK:TEXT***' * ******************************************************************* * * * CMPR * COMPARE READ STACK AND THE TEXT BUILT WITH TEXT * * * ******************************************************************* * SPACE * CMPR SIZE,CX,PL COMPARE THE FIC/OIC IN THE READ STACK (READ * ? BUILT IT) AGAINST THE DATA AREA (BUILT BY * ? TEXT) FOR A SIZE WHICH IS DECIMAL. BASED ON * ? RESULTS GO TO OR NOT. * ? * RC=0..NSI IN+3 ->CMPR THE VERB * RC=4..GOTO IN+8 -->SIZE A 4 DIGIT DECIMAL SIZE * RC=8..ERROR 1 TO "TEXTSIZE" * IN+13-->EQ?NE EQ IF = THEN GOTO * NE IF .NE. THEN GOTO * IN+16-->PL LINE TO GO TO SPACE CMPRCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED *** *** GET THE SIZE AND CONVERT TO USABLE *** CLI IN+8,C'0' CHECK NUMERIC BL CMPRRC08 BAD CLI IN+9,C'0' CHECK NUMERIC BL CMPRRC08 BAD CLI IN+10,C'0' CHECK NUMERIC BL CMPRRC08 BAD CLI IN+11,C'0' CHECK NUMERIC BL CMPRRC08 BAD PACK DWD(8),IN+8(4) GET AS PACKED DECIMAL CVB R1,DWD GET AS BINARY LTR R1,R1 IF 0 THEN ASSUME BZ CMPREQ EQUAL CH R1,=AL2(TEXTSIZE) IF TOO BIG BH CMPRRC08 THEN ERROR HIM CH R1,=AL2(READSIZE) IF TOO BIG BH CMPRRC08 THEN ERROR HIM LR R15,R1 R15 IS THE SIZE ALSO *** *** R1,R15 ARE SET UP FOR CLCL INSTRUCTION *** L R0,READSTAK R0=READ STACK START AH R0,=AL2(100) THUS IS REAL ADDRESS OF TEXT LA R14,SAVEAREA R14 IS BASE OF DSA AH R14,=AL2(TEXT-SAVEAREA) THUS IS REAL ADDRESS OF TEXT EJECT *** *** R0,R14 ARE THE TWO DATA AREAS *** CLCL 0,14 COMPARE THEM BE CMPREQ YES *** *** READ STACK(SIZE),TEXT ARE NOT EQUAL *** CMPRNE CLC IN+13(2),=C'NE' NE SO DID HE WANT NE BE CMPRBRCH NE AND WANTED NE SO BR B CMPRRC00 NE AND WANTED EQ SO NSI * CMPREQ CLC IN+13(2),=C'EQ' EQ SO DID HE WANT EQ BE CMPRBRCH EQ AND WANTED EQ SO BR B CMPRRC00 EQ AND WANTED NE SO NSI * CMPRBRCH PGLIN FROM=IN+16,ERROR=CMPRRC08 DO CONVERSION ST R0,LABEL SAVE IT * CMPRRC04 RETURN (14,12),RC=04 GOTO CMPRRC08 RETURN (14,12),RC=08 BAD COMMAND FORMAT CMPRRC00 RETURN (14,12),RC=0 NSI LTORG , TITLE '*** GOTO GOT A NEW LINE ***' * ******************************************************************* * * * GOTO * GOTO A NEW LINE * * * ******************************************************************* * SPACE * UNCONDITIONAL GOTO IN+3 ->GOTO IN+8 -->NN * * THIS IS CALLED BY THE FOLLOWING SEQUENCE * * CALL TESTCSCT PERFORM TEST * CH R0,=AL2(4) SEE WHAT TO DO * BL PMODNSI 0=NSI * BE PMODUSE 4=GOTO * B PMODBADL 8=BAD LABEL SPACE GOTOCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED PGLIN FROM=IN+8,ERROR=GOTORC04 DO CONVERSION * R0 = ACTUAL LINE NUMBER IF VALID (00-7F) * R1 = ACTUAL LINE TEXT IF LINE NUMBER VALID (00-7F) ST R0,LABEL SAVE IT RETURN (14,12),RC=0 RETURN WITH A GOTO SPACE GOTORC04 RETURN (14,12),RC=04 NUMBER TOO BIG LTORG , TITLE '*** LOOP LOOP IF REGISTER GT 0 ***' * ******************************************************************* * * * LOOP * LOOP TO A LINE AFTER DECREMENT IF REGISTER GT 0 * * * ******************************************************************* * SPACE * LOOP IF REG GT 0 IN+3 ->LOOP IN+8 -->R, * IN+10 ->PL * * THIS IS CALLED BY THE FOLLOWING SEQUENCE * * CALL LOOPCSCT PROCESS * CH R15,=AL2(4) CHECK RETURN CODE * BL GOTO 00 LOOP * BE PMODNSI 04 NSI * B PMODBADC 08 BAD COMMAND SPACE LOOPCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED CLC IN+8(2),=C'A,' LOOP COUNTER BE LOOPACTR YES CLC IN+8(2),=C'B,' REPEAT COUNTER BE LOOPBCTR YES CLC IN+8(2),=C'C,' DO COUNTER BE LOOPCCTR YES * NOT L, D, NOR R, CODED SO ERROR B LOOPRC08 ERROR SPACE LOOPACTR SP SETACNTR(4),=P'1' LOOP COUNTER - 1 CP SETACNTR(4),=P'0' TEST TO 0 MVC IN+8(10),IN+10 SHIFT DOWN FOR GOTO BH LOOPRC00 HIGH STILL SO GOTO B LOOPRC04 GET NEXT SEQUENTIAL INSTR LOOPBCTR SP SETBCNTR(4),=P'1' LOOP COUNTER - 1 CP SETBCNTR(4),=P'0' TEST TO 0 MVC IN+8(10),IN+10 SHIFT DOWN FOR GOTO BH LOOPRC00 HIGH STILL SO GOTO B LOOPRC04 GET NEXT SEQUENTIAL INSTR LOOPCCTR SP SETCCNTR(4),=P'1' LOOP COUNTER - 1 CP SETCCNTR(4),=P'0' TEST TO 0 MVC IN+8(10),IN+10 SHIFT DOWN FOR GOTO BH LOOPRC00 HIGH STILL SO GOTO B LOOPRC04 GET NEXT SEQUENTIAL INSTR SPACE LOOPRC00 RETURN (14,12),RC=0 RETURN WITH A GOTO LOOPRC04 RETURN (14,12),RC=04 NSI LOOP NEGATIVE LOOPRC08 RETURN (14,12),RC=08 BAD REGISTER LTORG , TITLE '*** X, Y, X, L, I SYMBOL SUBSTITUTION ***' * ******************************************************************* * * * SYMB * SYMBOLIC SUBSTITUTION SUBROUTINE * * * ******************************************************************* * SPACE SYMBCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) *---> STM R14,R12,12(R13) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED L R5,=A(TAB-240) ADDRESS THE TABLE *** *** %XXX *** SYMBOLSA CLC 0(4,R1),=C'%XXX' <---+ FOUND INDEX SUBSTITUTE BNE *+4+18 ? UNPK WORK(5),SETXVALU+2(3) GET DATA TR WORK(4),0(R5) ? CLEAN IT MVC 0(4,R1),WORK ? COPY IT LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSA *---------+ REPEAT *** *** %XXY *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSB CLC 0(4,R1),=C'%XXY' <---+ FOUND INDEX SUBSTITUTE BNE *+4+4 ? BAL R14,SYM6BIT ? GET 6 BIT VERSION LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSB *---------+ REPEAT *** *** %X *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSC CLC 0(2,R1),=C'%X' <---+ FOUND INDEX SUBSTITUTE BNE *+4+18 ? UNPK WORK(3),SETXVALU+3(2) GET DATA TR WORK(2),0(R5) ? CLEAN IT MVC 0(2,R1),WORK ? COPY IT LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSC *---------+ REPEAT *** *** %YYY *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSD CLC 0(4,R1),=C'%YYY' <---+ FOUND INDEX SUBSTITUTE BNE *+4+18 ? UNPK WORK(5),SETYVALU+2(3) GET DATA TR WORK(4),0(R5) ? CLEAN IT MVC 0(4,R1),WORK ? COPY IT LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSD *---------+ REPEAT EJECT *** *** %Y *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSE CLC 0(2,R1),=C'%Y' <---+ FOUND INDEX SUBSTITUTE BNE *+4+18 ? UNPK WORK(3),SETYVALU+3(2) GET DATA TR WORK(2),0(R5) ? CLEAN IT MVC 0(2,R1),WORK ? COPY IT LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSE *---------+ REPEAT *** *** %L *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSF CLC 0(2,R1),=C'%L' <---+ FOUND INDEX SUBSTITUTE BNE *+4+12 ? NO MVC 0(2,R1),LISTAREA COPY LIST TO USER MVC LISTAREA(48),LISTAREA+2 SHIFT LIST DOWN LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSF *---------+ REPEAT *** *** %I *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSG CLC 0(2,R1),=C'%I' <---+ FOUND INDEX SUBSTITUTE BNE *+4+6 ? NO MVC 0(2,R1),SETIVALU COPY INPT TO USER CLC 0(2,R1),=C'%J' ? FOUND INDEX SUBSTITUTE BNE *+4+6 ? NO MVC 0(2,R1),SETJVALU COPY INPT TO USER CLC 0(2,R1),=C'%K' ? FOUND INDEX SUBSTITUTE BNE *+4+6 ? NO MVC 0(2,R1),SETKVALU COPY INPT TO USER LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSG *---------+ REPEAT EJECT *** *** %ZZZ *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSI CLC 0(4,R1),=C'%ZZZ' <---+ FOUND INDEX SUBSTITUTE BNE *+4+18 ? UNPK WORK(5),SETZVALU+2(3) GET DATA TR WORK(4),0(R5) ? CLEAN IT MVC 0(4,R1),WORK ? COPY IT LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSI *---------+ REPEAT *** *** %Z *** LM R14,R1,12(R13) LOAD REGISTERS AGAIN SYMBOLSH CLC 0(2,R1),=C'%Z' <---+ FOUND INDEX SUBSTITUTE BNE *+4+18 ? UNPK WORK(3),SETZVALU+3(2) GET DATA TR WORK(2),0(R5) ? CLEAN IT MVC 0(2,R1),WORK ? COPY IT LA R1,1(R1) ? GET NEXT BCT R0,SYMBOLSH *---------+ REPEAT *** *** END *** RETURN (14,12),RC=00 RETURN ALL DONE EJECT * **************************************************************** * * * SYMBOLIC SUBSTITUTE LOGIC R1->%XXY * * * **************************************************************** * SPACE * * SUBROUTINE WHEN %XXY IS FOUND * SPACE SYM6BIT MVC WORK+6(2),SETXVALU+2 GET THE VALUE LH R15,WORK+6 GET WHOLE THING SRL R15,6 SHIFT DOWN 6 STC R15,WORK+6 SAVE THIS NI WORK+6,X'3F' LOSE TOP 2 BITS NI WORK+7,X'3F' LOSE TOP 2 BITS L R15,=A(SCOTTABL) CONVERT TR WORK+6(2),0(R15) CONVERT UNPK WORK(5),WORK+6(3) CONVERT TR WORK(4),0(R5) MAKE HEX MVC 0(4,R1),WORK COPY TO SOURCE BR R14 SKIP BACK LTORG , TITLE '*** SET ERROR GO DEFAULT ***' * ******************************************************************* * * * ERGO * ERROR GO (JUST AS IF HE SAID SO EARLIER) * * * ******************************************************************* * SPACE ERGO CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED ***=================================================================*** MVC DRVREROR(4),=CL4'GO' SAY ERROR GO IS DEFAULT ***=================================================================*** RETURN (14,12),RC=0 EXIT LTORG , TITLE '*** SET FUTURE RESPONSE IS HERE ***' * ******************************************************************* * * * SRSP * BUILD A FUTURE RESPONSE * * * ******************************************************************* * SPACE SRSPCSCT CSECT , *** ENTER HERE *** *860730 USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED ***=================================================================*** XC LVL1SUBS(4),LVL1SUBS IF 00000000 THEN NORMAL MODE L R1,CURRENT GET CURRENT LINE MVC 70(7,R1),=CL7'DFR-NML' SAY SET ***=================================================================*** CLI IN+8,C'0' IF LOWER THAN 0, CANT BE SNS BL SRSPEXIT EXIT CLI IN+9,C'0' IF LOWER THAN 0, CANT BE SNS BL SRSPEXIT EXIT MVC 70(7,R1),=CL7'DFR-SNS' SAY SENSE WILL BE SENT PACKX FROM=IN+8,SIZE=8 PACK THE CCW MVC LVL1SUBS(4),IN+8 COPY CONVERTED SENSE OVER ***=================================================================*** CLI DRVRNODE,C'*' DO WE HAVE A NODE BE SRSPEXIT NO CLC IN+16(4),=C',LUS' DOES HE WISH AN LUSTAT BNE SRSPEXIT NO L R1,CURRENT GET CURRENT LINE MVC 70(7,R1),=CL7'NOW-LUS' SAY SENSE WILL BE SENT L R7,LUSRTERM GET PHYSICAL CONTROL BLOCK L R7,LUDFSRPL-LUDFAREA(R7) GET SUB SESSION RPL MVC X'64'(4,R7),LVL1SUBS GET SENSE BYTES TO SEND ST R13,WORKDATA+4 SAVE R13 LA R13,WORKDATA GET SAVE AREA SEND RPL=(R7),OPTCD=(SYN,NFMHDR),STYPE=RESP,CONTROL=LUS, X POST=SCHED,RESPOND=(EX,FME,NRRN),BRACKET=(NBB,NEB) XC LVL1SUBS(4),LVL1SUBS SET NORMAL MODE L R13,WORKDATA+4 GET LAST SAVE AREA ***=================================================================*** SRSPEXIT RETURN (14,12),RC=0 EXIT LTORG , TITLE '*** CCW BUILDER IS HERE ***' * ******************************************************************* * * * CCWB * BUILD A CCW BASED ON THE USER DESIRES * * * ******************************************************************* * SPACE CCWBCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED ***=================================================================*** SR R1,R1 CLEAR A REGISTER IC R1,IN+6 GET CCW NUMBER (0-9) CLI IN+6,C'0' IF LOWER ASSUME A-F BNL *+8 NO SO IS 0-9 LA R1,9(R1) ADD TO MAKE A=C1=CA N R1,=A(X'0F') MAKE 00 - 0F SLL R1,3 TIMES 8 LA R2,CCW(R1) GET NAMED CCW ***=================================================================*** PACKX FROM=IN+8,SIZE=16 PACK THE CCW MVC 0(8,R2),IN+8 COPY PACKED CCW OVER ***=================================================================*** L R1,0(R2) GET IOAREA ADDRESS CLI 0(R2),X'08' IS THIS A TIC BE *+12 YES SO ADD CCW START ADDRESS A R1,=A(TEXT-SAVEAREA) NO SO ADD TEXT START ADDR B *+8 THEN SKIP A R1,=A(CCW-SAVEAREA) TIC MEANS ADD CCW START AR R1,R13 PLUS DSA ADDRESS STH R1,2(R2) SAVE SRL R1,16 THE STC R1,1(R2) ADDRESS ***=================================================================*** ST R2,DWD SAVE ADDRESS OF THIS CCW L R1,CURRENT GET CURRENT LINE UNPK 70(7,R1),DWD+1(4) UNPACK ADDRESS TR 70(6,R1),TAB-240 HEX MVI 76(R1),C' ' CLEAN IT ***=================================================================*** RETURN (14,12),RC=0 EXIT LTORG , TITLE '*** JUMP TO ANOTHER PMOD PROGRAM ***' * ******************************************************************* * * * JUMP * JUMP TO LINE 00 OF A NEW PMOD PROGRAM * * * ******************************************************************* * SPACE * __ JUMP NAME SPACE JUMPCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED +========+ MVC LABEL(4),=A(-1) START AT LINE 0 - 1 ?SEE ? LA R8,SAVEAREA R8 BUT ALTER TO ?PMODNSI ? DROP R13 A NEW +========+ USING SAVEAREA,R8 REGISTER LA R0,200 GET A GETMAIN R,LV=(0) SAVE AREA ST R13,4(1) SAVE OLD R13 IN NSAVE+4 ST R1,8(R13) SAVE NEW R13 IN OSAVE+8 LR R13,R1 R13 GET NEW SAVE *** *** CHECK IF A DISK COPY OR SAVE COMMAND *** MVI IN+7,C'P' P FOR PMOD LA R2,LINE0 LOAD AREA L R3,=A(MEMSIZE) SIZE TO USE DISKIO READ,IN+7,OUT,0(R2),0(R3) LA R0,200 SIZE LR R1,R13 CORE TO FREE L R13,4(R13) GET LAST FREEMAIN R,LV=(0),A=(1) FREE SAVE AREA RETURN (14,12),RC=0 EXIT ***=================================================================*** LTORG , TITLE '*** TEXT BUILDER FOR CCWS IS HERE ***' * ******************************************************************* * * * TXTB * BUILD SOME TEXT FOR THE CCWS * * * ******************************************************************* * SPACE * __ TEXT_NNNN,XXXXX PLACE HEX AT DISPLACMENT NNNN * __ TEXT_NNNN,'CCC' PLACE CHARACTERS AT NNNN * __ TEXT_DMOD=NAME LOAD TEXT WITH DMOD * __ TEXT_READ LOAD TEXT WITH 1ST READ RU * __ TEXT_INS,N SHIFT LEFT N BYTES (NEVER MORE * THAN 16 AS UNDERUN PAD IS 16 * __ TEXT_DEL,* SHIFT RIGHT ONE "DMOD" STREAM * __ TEXT_DEL,N SHIFT RIGHT N BYTES SPACE TXTBCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED L R5,CURRENT GET CURRENT PROGRAM LINE MVC 70(6,R5),=C'*DONE*' SAY WHAT ANSWER/ERROR WAS LA R8,SAVEAREA R8 BUT ALTER TO DROP R13 A NEW USING SAVEAREA,R8 REGISTER LA R0,200 GET A GETMAIN R,LV=(0) SAVE AREA ST R13,4(1) SAVE OLD R13 IN NSAVE+4 ST R1,8(R13) SAVE NEW R13 IN OSAVE+8 LR R13,R1 R13 GET NEW SAVE *** *** WHAT WE GOT? *** CLC IN+8(4),=C'READ' IS THIS CORE COPY BE TXTBCOPY YES CLC IN+8(5),=C'DMOD=' VERIFY NN_TEXT_DMOD=NAME BE TXTBDMOD YES CLC IN+8(3),=C'INS' INSERT? BE TXTBINS YES CLC IN+8(3),=C'DEL' DELETE? BE TXTBDEL YES CLI IN+12,C',' VERIFY NN_TEXT_DDDD,XXXX BNE TXTBERR1 (HEX OR CHAR) EJECT * ******************************************************************* * * * TXTB * THIS IS TEXT DISP,XXXXXXXXX OR 'CCCCCCCCCCC' * * * ******************************************************************* * SPACE MVC OUT(80),IN SAVE A COPY PACKX FROM=IN+8,SIZE=4 PACK THE DISPLACMENT LH R2,IN+8 GET DISPLACMENT CH R2,=AL2(TEXTSIZE-48) CHECK LIMIT (48 BYTES PER LINE) BH TXTBERR2 NOT LOOKING GOOD A R2,=A(TEXT-SAVEAREA) PLUS TEXT ADDRESS AR R2,R8 R2=====PLUS DSA ADDRESS=====DATA AREA *** *** R2 IS THE LOCATION INTO WHICH DATA MUST BE STORED *** MVC IN(80),OUT LOAD A COPY CLC IN+13(5),=C'DMOD=' CHECK NN_TEXT_DDDD,DMOD=NAME BE TXTBDMDD YES SO GO DO IT CLI IN+13,C'''' VERIFY NN_TEXT_DDDD,"CCC" BE TXTBCHAR NO LA R0,27 LOOK AT 27 PAIRS LA R1,IN+13 START OF DATA LA R3,0 R2=BYTES SO FAR TXTBLOOP CLI 0(R1),C' ' BLANK = END BE TXTBREDY YES CLI 0(R1),C'_' UNDERSCORE = END BE TXTBREDY YES LA R1,2(R1) GET NEXT PAIR LA R3,1(R3) R3=====ADD TO SIZE (IN R3)=====SIZE BCT R0,TXTBLOOP REPEAT TXTBREDY PACKX FROM=IN+13,SIZE=54 PACK 54 TO 27 BYTES *** *** R2=TEXT BUFFER, R3=SIZE, IN+13=SOURCE DATA *** CH R3,=AL2(1) TEST TOO SMALL BL TXTBERR3 YES CH R3,=AL2(54) TEST TOO LARGE BH TXTBERR4 YES BCTR R3,0 CREATE SIZE VALUE B *+10 SKIP MVC 0(*-*,R2),IN+13 EXECUTED MOVE EX R3,*-6 MOVE DATA B TXTBEXIT EXIT EJECT * ******************************************************************* * * * TXTB * THIS IS TEXT DISP,'CCCCCCCCCCCCCCCC' * * * ******************************************************************* * SPACE TXTBCHAR LA R0,48 LOOK AT 48 BYTES LA R1,IN+14 START OF DATA TXTBCLUP CLI 0(R1),C'''' QUOTE = END BE TXTBEXIT YES CLI 0(R1),C'@' MATCH IS THIS "AT" MEANING AT.ADDRESS BNE *+8 ? NO MVI 0(R1),X'11' ? YES --- MAKE SBA CLI 0(R1),C'#' ? IS THIS "POUND" MEANING START BNE *+8 ? POUNDING AT THIS ADDRESS MVI 0(R1),X'13' ? YES --- MAKE IC CLI 0(R1),C'$' ? IS THIS START FIELD BNE *+8 ? NO MVI 0(R1),X'1D' ? YES --- SF CLI 0(R1),C'&&' ? IS THIS REPEAT TO ADDRESS BNE *+8 ? NO MVI 0(R1),X'3C' SEND YES --- RA MVC 0(1,R2),0(R1) COPY A CHARACTER LA R1,1(R1) GET NEXT SOURCE LA R2,1(R2) AND RESULT BYTE BCT R0,TXTBCLUP REPEAT B TXTBERR5 EXIT BUT ERROR EJECT * ******************************************************************* * * * TXTB * THIS IS TEXT INS,X OR DEL,X (TEXT SHIFT) * * * ******************************************************************* * SPACE TXTBDEL LA R2,SAVEAREA START CORE A R2,=A(TEXT-SAVEAREA) PLUS TEXT ADDRESS L R0,=A(TEXTSIZE) AND SIZE (SO FAR) * CLI IN+12,C'*' WAS IT DEL * BNE *+12 NO LH R1,0(R2) GET SIZE OF THIS PACKET B TXTBDEL0 PROCEED * SR R1,R1 CLEAR R1 NI IN+12,X'0F' MAKE BINARY IC R1,IN+12 GET SHIFT SIZE TXTBDEL0 LTR R1,R1 IS IT 0 BZ TXTBERR3 SCREW IT SR R0,R1 DECREMENT SIZE AR R1,R2 R1 IS THE FROM ADDRESS TXTBDEL1 MVC 0(1,R2),0(R1) MOVE A BYTE LA R1,1(R1) NEXT FROM LA R2,1(R2) NEXT TO BCT R0,TXTBDEL1 SHIFT LEFT B TXTBEXIT END *** *** *** TXTBINS LA R2,SAVEAREA START CORE R2 IS THE A R2,=A(TEXT-SAVEAREA) PLUS TEXT ADDRESS TO--> A R2,=A(TEXTSIZE) GO TO ITS END BCTR R2,0 BACK 1 TO VERY LAST BYTE L R0,=A(TEXTSIZE) AND SIZE (SO FAR) ADDRESS SR R1,R1 CLEAR R1 NI IN+12,X'0F' MAKE BINARY IC R1,IN+12 GET SHIFT SIZE LTR R1,R1 IS IT 0 BZ TXTBERR3 SCREW IT * SR R0,R1 DECREMENT SIZE ---+ R0=LOOP LR R3,R2 R3 IS TO ? SR R3,R1 R3 IS NOW FROM V R3=FROM TXTBINS1 MVC 0(1,R2),0(R3) MOVE A BYTE +------------------ BCTR R3,0 NEXT FROM ? DONT DECR AS LONG BCTR R2,0 NEXT TO ? AS SIZE IS LT 16 BCT R0,TXTBINS1 SHIFT RIGHT ? AS WE HAVE A 16 B TXTBEXIT END ? BYTE PREFIX OF 00 EJECT * ******************************************************************* * * * COPY THE 1ST RU ELEMENT READ TO THE TEXT BUFFER * * * ******************************************************************* * SPACE *** *** COPY 1ST RU FROM READ TO TEXT BUFFER *** TXTBCOPY L R3,READSTAK GET READ STACK * IGNORE IF LTR R3,R3 IS THERE ANY NO READ BZ TXTBERR3 NO SO EXIT * IGNORE IF L R2,88(R3) GET RPL LENGTH SIZE TOO C R2,=A(TEXTSIZE) CHECK MUCH BH TXTBERR4 ERROR BY FAR LTR R2,R2 CHECK 0 * IGNORE BZ TXTBERR3 NO GO IF NO DATA LA R3,100(R3) DATA START *** *** THIS IS REASONABLE DATA *** LA R1,SAVEAREA START CORE A R1,=A(TEXT-SAVEAREA) PLUS TEXT ADDRESS MVC 0(1,R1),0(R3) <--+ MOVE A BYTE LA R1,1(R1) ? UP LA R3,1(R3) ? UP BCT R2,*-14 *---------+ REPEAT B TXTBEXIT RESUME EJECT * ******************************************************************* * * * COPY A DMOD FILE TO THE TEXT BUFFER * * * ******************************************************************* * SPACE *** *** NN TEXT NNNN,DMOD=NNNN *** SPACE TXTBDMDD EQU * R2=PLACE TO ADD DATA L R3,=A(TEXTSIZE) R3=MAX SIZE LA R1,SAVEAREA TEMPORARY GET SAVE START A R1,=A(TEXT-SAVEAREA) TEMPORARY GET TEXT START LR R15,R2 TEMPORARY GET HIS DESIRED START SR R15,R1 TEMPORARY GET HIS DISPLACMENT SR R3,R15 R3=(MAX_SIZE-HIS_DISPLACMENT) MVI IN+17,C'D' D FOR DMOD DISKIO READ,IN+17,OUT,0(R2),0(R3) MVI IN+17,C'=' RESET = SIGN B TXTBEXIT EXIT SPACE *** *** NN TEXT DMOD=NNNN *** SPACE TXTBDMOD LA R2,SAVEAREA START CORE A R2,=A(TEXT-SAVEAREA) PLUS TEXT ADDRESS L R3,=A(TEXTSIZE) AND SIZE MVI IN+12,C'D' D FOR DMOD DISKIO READ,IN+12,OUT,0(R2),0(R3) MVI IN+12,C'=' RESET = SIGN *** *** *** TXTBEXIT LA R0,200 SIZE LR R1,R13 CORE TO FREE L R13,4(R13) GET LAST FREEMAIN R,LV=(0),A=(1) FREE SAVE AREA RETURN (14,12),RC=0 EXIT EJECT ***=================================================================*** TXTBERR1 MVC 70(6,R5),=C'BAD OP' NO , AND NOT DMOD B TXTBEXIT QUIT TXTBERR2 MVC 70(6,R5),=C'D>LIMT' BAD DISPLACMENT B TXTBEXIT QUIT TXTBERR3 MVC 70(6,R5),=C'SIZE<1' SIZE TO MOVE LESS THAN 1 B TXTBEXIT QUIT TXTBERR4 MVC 70(6,R5),=C'SZE>??' SIZE TO MOVE GTR 48 OR W.H.Y B TXTBEXIT QUIT TXTBERR5 MVC 70(6,R5),=C'ENDQT?' NO END QUOTE B TXTBEXIT QUIT ***=================================================================*** LTORG , EJECT SPACE 3 *********************************************************************** * * * * * PPPPPP SSSSS PPPPPP CCCCC * * P P S P P C C * * P P S P P C * * PPPPPP SSSSS PPPPPP C * * P S P C * * P S P C C * * P SSSSS P CCCCC * * * * * * * * * *********************************************************************** TITLE '*** PSPC COMMAND PROCESSOR ***' * ******************************************************************* * * * PSPC * COMMAND PROCESSOR IS HERE * * * ******************************************************************* * SPACE PSPCCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED LA R8,SAVEAREA R8 BUT ALTER TO DROP R13 A NEW USING SAVEAREA,R8 REGISTER LA R0,4000 GET A GETMAIN R,LV=(0) SAVE AREA ST R13,4(1) SAVE OLD R13 IN NSAVE+4 ST R1,8(R13) SAVE NEW R13 IN OSAVE+8 LR R13,R1 R13 GET NEW SAVE CLC IN+8(7),=C'TEXTOUT' IS THIS TEXT OUT COMMAND BE PSPCOT YES * CLC IN+8(10),=C'TEXTIN,TS=' IF TS= OMITTED ASSUMED TS=A CLC IN+8(6),=C'TEXTIN' IS THIS TEXT IN COMMAND BE PSPCIN YES CLC IN+8(8),=C'SEND,RU=' IS THIS SEND TEXT COMMAND BE PSPCSN YES ***=================================================================*** * CODE GOES HERE ***=================================================================*** PSPCERR0 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'OP BAD' SAY BAD B PSPCEXIT+10 AND EXIT PSPCERR1 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'SZ BAD' SAY BAD B PSPCEXIT+10 AND EXIT PSPCERR2 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'RU?ABC' SAY BAD B PSPCEXIT+10 AND EXIT PSPCERR3 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'NO BFR' SAY NO READ BUFFER PRESENT B PSPCEXIT+10 AND EXIT PSPCERR4 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'NO CAT' SAY NEEDED CONCATENATING B PSPCEXIT+10 AND EXIT PSPCERR5 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'(NULL(' SAY XYZBC NOT IN FRAME B PSPCEXIT+10 AND EXIT PSPCERR6 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'BCC=ER' SAY BCC ERROR B PSPCEXIT+10 AND EXIT PSPCERR7 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'NO (..' SAY B PSPCEXIT+10 AND EXIT PSPCERR8 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'NO ..(' SAY B PSPCEXIT+10 AND EXIT PSPCERR9 L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'INSIZE' SAY B PSPCEXIT+10 AND EXIT *** PSPCEXIT L R5,CURRENT GET CURRENT LINE MVC 70(6,R5),=C'*DONE*' SAY BAD LA R0,4000 SIZE LR R1,R13 CORE TO FREE L R13,4(R13) GET LAST FREEMAIN R,LV=(0),A=(1) FREE SAVE AREA RETURN (14,12),RC=0 EXIT TITLE '*** __ PSPC TEXTOUT ***' * ******************************************************************* * * * TAKE THE TEXT BUFFER AND WORK ON IT * * * ******************************************************************* * SPACE PSPCOT LA R0,105(R13) TO AREA ((((((((((((((((((((( LA R1,1024 .. SIZE (PSPC LIMIT IS 0 TO ( LA R14,SAVEAREA FM (512 SO WE ALLOW ( A R14,=A(TEXT-SAVEAREA) .. AREA (1024+ EXTRA FOR ( LH R15,0(R14) .. SIZE (NEGATIVE TESTING ( CH R15,=AL2(1024+2) TOO BIG ((((((((((((((((((((( BH PSPCERR1 SO EXIT CH R15,=AL2(2) TOO SML SIZE (ALLOW SIZE=2 FOR BL PSPCERR1 SO EXIT (NULL MESSAGES * RAW REGISTERS SET UP - NOW VALIDATE THEM LR R5,R15 GET ORIGINAL SIZE LA R5,3+2(R5) ADD 3(PREFIX)+2(SUFFIX) STH R5,100(R13) SAVE NEW SIZE MVC 102(3,R13),=X'000000' SPACE FOR X,Y,Z SH R15,=AL2(2) DROP 2 FROM ORIGINAL SIZE LA R14,2(R14) AND START UP 2 (SKIP SIZE) MVCL R0,R14 COPY TEXT+2(SZ-1)->NEW+5 LA R5,100(R13) AND GET NEW AREA START AH R5,100(R13) PLUS SIZE SH R5,=AL2(2) MINUS TWO MVC 0(2,R5),=X'FEFE' SPACE FOR BCC * 100(R13) NOW HAS (NEWSIZE),00 00 00 (OLD DATA) 00 00 MVC 102(1,R13),SETXVALU+3 GET X REG (SEQN) MVC 103(1,R13),SETYVALU+3 GET Y REG (CTL.1) MVC 104(1,R13),SETZVALU+3 GET Z REG (CTL.2) * 100(R13) NOW HAS (NEWSIZE),XX YY ZZ (OLD DATA) 00 00 LA R1,100(R13) GET AREA CALL ENBLKC ADD BLOCK CHECK * 100(R13) NOW HAS (NEWSIZE),XX YY ZZ (OLD DATA) BC BC LA R0,SAVEAREA SET R0 TO THE OUTPUT AREA. USE A R0,=A(TEXT-SAVEAREA) PLUS 3 SO THERE IS ROOM FOR LA R1,100(R13) SET R1 TO THE INPUT AREA CALL ENCODE DO THE ENCODE * TEXT NOW HAS 00 00 00 SS SS ?X ?Y ?Z ?TEXT ?B ?C LA R5,SAVEAREA NOW GET THE A R5,=A(TEXT-SAVEAREA) TEXT BUFFER LH R1,3(R5) GET SIZE LA R1,3+1(R1) ADD F5 C3 ( ...AND... ( STH R1,0(R5) SAVE IN TEXT MVC 2(3,R5),=C'5C(' PREFIX IS F5..C3..( AH R5,0(R5) GO TO END BCTR R5,0 BACK ONE MVI 0(R5),C'(' SAVE TRAILER B PSPCEXIT EXIT OK TITLE '*** __ PSPC TEXTIN ***' * ******************************************************************* * * * TAKE THE READ BUFFER AND DECODE IT TO TEXT BUFFER * * * ******************************************************************* * SPACE PSPCIN L R4,CURRENT GET CURRENT LINE MVC 21(48,R4),=C'XXXXX:XX,SN=ER,BC=ER,FR=ER SQ=XX,CF=XXXX,BC=XXXX' L R4,READSTAK GET READ STACK LTR R4,R4 IS THERE ANY BZ PSPCERR3 NO SO EXIT *NO BFR* CLC 0(4,R4),=A(0) IS THIS AN OIC BNE PSPCERR4 NO SO ERROR *NO CAT* CLC 88(4,R4),=A(10) A C C ( X Y Z B C ( BL PSPCERR9 NO SO ERROR *INSIZE* *** THIS IS A CAT CHAIN AND IS GOOD SO CHECK FOR TRAILING "(" LA R14,100(R4) FROM A R14,88(R4) SIZE OF FROM DATA BCTR R14,0 BACK ONE CLI 0(R14),C'(' IS LAST BYTE ( BNE PSPCERR8 EXIT NO TRAILING ( MVI 0(R14),X'00' DROP THE TRAILING PARENTHESIS L R14,88(R4) GET SIZE BCTR R14,0 LOSE ONE AS WE DROP ( ST R14,88(R4) PUT NEW SIZE *** THIS IS A CAT CHAIN AND HAS END "(". NOW LOCATE START "(" CHARACTER LA R14,100(R4) FROM +0 IS DATA START LA R15,102(R13) TO +2 IS DATA START L R0,88(R4) SIZE OF FROM DATA SR R1,R1 FINAL NEW OUTPUT COUNT PSPCIN00 CLI 0(R14),C'(' LOOK FOR BRACKET BE PSPCIN02 OK LA R14,1(R14) GET NEXT BCT R0,PSPCIN00 RETRY B PSPCERR7 EXIT SAY NO LEADING ( PSPCIN01 MVC 0(1,R15),0(R14) <---+ COPY (14)->(15) FOR (0) LA R1,1(R1) ? UP SIZE LA R15,1(R15) ? UP FROM PSPCIN02 LA R14,1(R14) ? UP TO BCT R0,PSPCIN01 *---+ DO IT LA R1,2(R1) ADD 2 FOR SIZE OF SIZE STH R1,100(R13) SAVE SIZE L R4,CURRENT GET CURRENT LINE MVC 45(2,R4),=C'OK' SAY FRAMING OK EJECT *** 100(NN,R13) IS DMOD FORMATTED WITH DATA BETWEEN THE (.....( PAIR CLC 100(2,R13),=AL2(2+3+2) 2=SIZE,3=X/Y/Z,2=BCC BL PSPCERR5 NO GOOD DATA IN FRAMING CHAR LA R0,SAVEAREA SET R0 TO THE OUTPUT AREA. USE A R0,=A(TEXT-SAVEAREA) PLUS 3 SO THERE IS ROOM FOR LA R1,100(R13) SET R1 TO THE INPUT AREA CALL DECODE DO THE DECODE *** TEXT BUFFER IS NOW DECODED DATA STREAM IN DMOD FORMAT LA R1,SAVEAREA GET AREA A R1,=A(TEXT-SAVEAREA) AND AH R1,0(R1) SIZE HENCE END SH R1,=AL2(2) BACK OFF SIZE OF BCC L R4,CURRENT GET CURRENT LINE L R15,=A(TAB-240) ADDRESS THE TABLE UNPK 65(5,R4),0(3,R1) GET BCC TR 65(4,R4),0(R15) TRANSLATE AND IT IS PRETTY MVI 69(R4),C' ' CLEAN IT *** TEXT BUFFER IS NOW DECODED DATA STREAM IN DMOD FORMAT LA R1,SAVEAREA GET AREA A R1,=A(TEXT-SAVEAREA) ADD SIZE HENCE END CALL DEBLKC ADD BLOCK CHECK LTR R15,R15 ANY ERRORS BNZ PSPCERR6 SAY BAD L R4,CURRENT GET CURRENT LINE MVC 39(2,R4),=C'OK' SAY BCC WAS OK *** TEXT BUFFER IS OK AND BCC CHECKED SO NOW WE DROP THE BCC LA R1,SAVEAREA GET AREA A R1,=A(TEXT-SAVEAREA) ADD SIZE HENCE END LR R4,R1 GET DATA START AH R4,0(R1) GO TO END SH R4,=AL2(2) BACK TO BCC XC 0(100,R4),0(R4) DROP THE BCC LH R4,0(R1) GET SIZE OF XYZ+DATA+BC SH R4,=AL2(2) LOSE SIZE OF BCC STH R4,0(R1) PUT SIZE OF XYZ+DATA EJECT *** TEXT BUFFER IS NOW DECODED DATA STREAM IN DMOD FORMAT LA R1,SAVEAREA GET AREA A R1,=A(TEXT-SAVEAREA) ADD SIZE HENCE END L R4,CURRENT GET CURRENT LINE L R15,=A(TAB-240) ADDRESS THE TABLE UNPK 57(5,R4),2+1(3,R1) GET CONTROL BYTES TR 57(4,R4),0(R15) TRANSLATE AND IT IS PRETTY MVI 61(R4),C' ' CLEAN IT UNPK 51(3,R4),2+0(2,R1) GET SEQN TR 51(2,R4),0(R15) TRANSLATE AND IT IS PRETTY MVI 53(R4),C' ' CLEAN IT *** CHECK SEQUENCE AGAINST NAMED REGISTER TM 2+1(R1),X'C0' TEST FOR 00...... BZ PSPCINA0 IF SO THEN SKIP SEQ TEST+SET CLI 18(R4),C'B' IS IT A, B OR C REGISTER BH PSPCIN05 *C* BE PSPCIN04 *B* PSPCIN03 ZAP DWD(8),SETACNTR(4) *A* GET IT AS DWD CVB R15,DWD NOW BINARY STC R15,DWD SAVE IT CLC DWD(1),2(R1) TEST A-CNTR TO IN-SEQN BNE *+10 NOT SAME MVC 33(2,R4),=C'OK' SAY OK XC DWD,DWD EITHER WAY CLEAR DWD MVC DWD+7(1),2(R1) THEN GET THIS SEQN L R15,DWD+4 GET IT LA R15,1(R15) ADD ONE TO IT CVD R15,DWD MAKE DECIMAL ZAP SETACNTR(4),DWD+4(4) SAVE IT BACK B PSPCINA0 PROCEED PSPCIN04 ZAP DWD(8),SETBCNTR(4) *B* GET IT AS DWD CVB R15,DWD NOW BINARY STC R15,DWD SAVE IT CLC DWD(1),2(R1) TEST A-CNTR TO IN-SEQN BNE *+10 NOT SAME MVC 33(2,R4),=C'OK' SAY OK XC DWD,DWD EITHER WAY CLEAR DWD MVC DWD+7(1),2(R1) THEN GET THIS SEQN L R15,DWD+4 GET IT LA R15,1(R15) ADD ONE TO IT CVD R15,DWD MAKE DECIMAL ZAP SETBCNTR(4),DWD+4(4) SAVE IT BACK B PSPCINA0 PROCEED PSPCIN05 ZAP DWD(8),SETCCNTR(4) *A* GET IT AS DWD CVB R15,DWD NOW BINARY STC R15,DWD SAVE IT CLC DWD(1),2(R1) TEST A-CNTR TO IN-SEQN BNE *+10 NOT SAME MVC 33(2,R4),=C'OK' SAY OK XC DWD,DWD EITHER WAY CLEAR DWD MVC DWD+7(1),2(R1) THEN GET THIS SEQN L R15,DWD+4 GET IT LA R15,1(R15) ADD ONE TO IT CVD R15,DWD MAKE DECIMAL ZAP SETCCNTR(4),DWD+4(4) SAVE IT BACK B PSPCINA0 PROCEED *** NOW CONVERT CONTROL BYTE 1 TO "TEST" FORMAT PSPCINA0 MVI 21(R4),C'C' 00...... ASSUME CONTROL FRAME TM 2+1(R1),X'C0' TEST BZ PSPCINA1 SKIP MVI 21(R4),C'I' 11...... ASSUME INVALID BO PSPCINA1 SKIP MVI 21(R4),C'Q' 01...... ASSUME REQUEST FRAME TM 2+1(R1),X'40' TEST BO PSPCINA1 SKIP MVI 21(R4),C'R' 10...... ASSUME RESPONSE FRAME PSPCINA1 MVI 22(R4),C'C' ..1..... ASSUME CHANGE DIRECTN TM 2+1(R1),X'20' TEST BO PSPCINA2 SKIP MVI 22(R4),C'*' ..0..... ASSUME NO CHANGE DIR PSPCINA2 MVI 23(R4),C'B' ...1.... ASSUME BAD RESPONSE TM 2+1(R1),X'10' TEST BO PSPCINA3 SKIP MVI 23(R4),C'G' ...0.... ASSUME GOOD RESPONSE PSPCINA3 MVI 24(R4),C'E' ......1. ASSUME ISSUE ERROR TM 2+1(R1),X'02' TEST BO PSPCINA4 SKIP MVI 24(R4),C'N' ......0. ASSUME NO ISSUE ERROR PSPCINA4 MVI 25(R4),C'T' .......1 ASSUME TRACE TM 2+1(R1),X'01' TEST BO PSPCINA5 SKIP MVI 25(R4),C'N' .......0 ASSUME NO TRACE *** NOW CONVERT CONTROL BYTE 2 TO "TEST" FORMAT PSPCINA5 MVI 26(R4),C':' START NEXT BYTE MVI 27(R4),C'N' 00...... NOT CNFM NOR CNFMD TM 2+2(R1),X'C0' TEST BZ PSPCINA6 SKIP MVI 27(R4),C'I' 11...... ASSUME INVALID BO PSPCINA6 SKIP MVI 27(R4),C'Q' 01...... ASSUME CNFRM REQUEST TM 2+2(R1),X'40' TEST BO PSPCINA6 SKIP MVI 27(R4),C'R' 10...... ASSUME CNFRM RESPONSE PSPCINA6 MVI 28(R4),C'N' ..00.... NOT DALOC NOR DALOCTD TM 2+2(R1),X'30' TEST BZ PSPCINA7 SKIP MVI 28(R4),C'I' ..11.... ASSUME INVALID BO PSPCINA7 SKIP MVI 28(R4),C'Q' ..01.... ASSUME ALOC REQUEST TM 2+2(R1),X'10' TEST BO PSPCINA7 SKIP MVI 28(R4),C'R' ..10.... ASSUME ALOC RESPONSE *** NOW IF CONTROL=RR THEN SET NEXT OUT SEQN TO 1 (IE X REGISTER) PSPCINA7 CLC 27(2,R4),=C'RR' IF CNFMD.RESP+DALLOC.RSP BNE *+10 NO SO SKIP MVC SETXVALU(4),=A(1) MAKE X REGISTER 1 *** NOW IF CONTROL=C THEN IGNORE SEQN TEST CLI 21(R4),C'C' IF CONTROL FRAME BNE *+10 NO SO SKIP MVC 33(2,R4),=C'OK' SAY SEQ WAS GOOD EVEN IF NOT *** TEXT BUFFER NEEDS SEQN+TWO CTL BYTES DROPPED LA R1,SAVEAREA GET AREA A R1,=A(TEXT-SAVEAREA) ADD SIZE HENCE END LH R4,0(R1) GET SIZE OF XYZ+DATA SH R4,=AL2(3) LOSE SIZE OF XYZ STH R4,0(R1) PUT SIZE OF XYZ+DATA MVC 2(256,R1),5(R1) SHIFT DOWN MVC 256+2(256,R1),256+5(R1) SOME MORE MVC 512+2(256,R1),512+5(R1) SOME MORE MVC 768+2(256,R1),768+5(R1) SOME MORE MVC 1024+2(256,R1),1024+5(R1) SOME MORE B PSPCEXIT EXIT OK TITLE '*** __ PSPC SEND ***' * ******************************************************************* * * * TAKE THE TEXT BUFFER AND SEND IT SNA RU SIZE RULES * * * ******************************************************************* * SPACE PSPCSN ZAP DWD(8),SETACNTR(4) LIMIT RUSIZE TO USE (DECIMAL) CLI IN+16,C'A' IS THIS THE A COUNTER BE PSPCSN1 YES ZAP DWD(8),SETBCNTR(4) LIMIT RUSIZE TO USE (DECIMAL) CLI IN+16,C'B' IS THIS THE A COUNTER BE PSPCSN1 YES ZAP DWD(8),SETCCNTR(4) LIMIT RUSIZE TO USE (DECIMAL) CLI IN+16,C'C' IS THIS THE A COUNTER BNE PSPCERR2 YES PSPCSN1 CVB R6,DWD R6-->LIMIT RUSIZE TO USE CH R6,=AL2(1) IS THE SIZE ZERO BNL *+8 NO LA R6,1 ASSUME 1 LA R7,SAVEAREA R7-->GET USERS IO AREA A R7,=A(TEXT-SAVEAREA) IE THE TEXT BUFFER LH R5,0(R7) R5-->SIZE OF SUBSEQUENT DATA SH R5,=AL2(2) DROP 2 FOR THE SIZE LA R7,2(R7) ACTUAL DATA IS AFTER THE SIZE *** GET A RELEVANT RPL L R1,LUSRTERM GET LUDFAREA USING LUDFAREA,R1 ADDRESSABLE *----- L R10,LUDFARPL RA-->RPL THAT WE WILL USE ) *----- CLI DRVRNODE,C'*' IS THIS OURSELVES )----+ *----- BE *+8 YES ) ? L R10,LUDFSRPL RPL THAT WE WILL USE *OR* DROP R1 DROP LUDFAREA ? CLI DRVRNODE,C'*' IS THIS US )----+ BE SENDHERE IF SO THEN TERMIO ) *** SEND NBB+NEB,FIC,EX - AND RUSIZE WORTH CR R5,R6 ARE WE CLOSE TO RUSZ BNH SENDSOIC NO SO DO A SIMPLE OIC SEND SEND RPL=(R10),OPTCD=(SYN,NFMHDR),STYPE=REQ,CONTROL=DATA, X BRACKET=(NBB,NEB),CHNGDIR=(NCMD,NREQ),POST=RESP, X RESPOND=(EX,FME,NRRN),CHAIN=FIRST,AREA=(R7),RECLEN=(R6) *** SEND )(,MIC,EX - AND RUSIZE OF DATA SENDSNAM AR R7,R6 UP DATA SR R5,R6 DN SIZE CR R5,R6 DO WE HAVE ENOUGH FOR SOME FICS BNH SENDSNAL NO SO SEND A LIC SEND RPL=(R10),OPTCD=(SYN,NFMHDR),STYPE=REQ,CONTROL=DATA, X BRACKET=(NBB,NEB),CHNGDIR=(NCMD,NREQ),POST=RESP, X RESPOND=(EX,FME,NRRN),CHAIN=MIDDLE,AREA=(R7),RECLEN=(R6) B SENDSNAM ANOTHER MIC OR A LIC? *** SEND )(,LIC,EX AND CDI AND RUSIZE OR LESS OF DATA SENDSNAL SEND RPL=(R10),OPTCD=(SYN,NFMHDR),STYPE=REQ,CONTROL=DATA, X BRACKET=(NBB,NEB),CHNGDIR=(CMD,NREQ),POST=RESP, X RESPOND=(EX,FME,NRRN),CHAIN=LAST,AREA=(R7),RECLEN=(R5) B PSPCEXIT EXIT *** SEND )(,OIC,EX AND CDI AND RUSIZE OR LESS OF DATA SENDSOIC SEND RPL=(R10),OPTCD=(SYN,NFMHDR),STYPE=REQ,CONTROL=DATA, X BRACKET=(NBB,NEB),CHNGDIR=(CMD,NREQ),POST=RESP, X RESPOND=(EX,FME,NRRN),CHAIN=ONLY,AREA=(R7),RECLEN=(R5) B PSPCEXIT EXIT SENDHERE TERMIO PUT,PAGE,SNA,0(R7),0(R5) SEND IF OURSELVES B PSPCEXIT EXIT LTORG , TITLE '*** ENCODE AN AREA ***' * ******************************************************************* * * * ENCODE AN AREA TO QUADRANT TEXT * * * ******************************************************************* * SPACE * RULE THE CODE POINT IS 00-FF AND IS BROKEN INTO 4 PARTS OR * QUADRANTS. THESE ARE NOT CLEAN CONTIGUOUS QUADRANTS SO * A SIMPLE ALGORITHM DOES NOT SUFFICE. INSTEAD WE HAVE A * TABLE INDEXED INTO, BEING TWO BYTES PER BYTE. THIS * METHOD IS AIMED AT 8 BITS ONE END LOOKING LIKE 8 BITS * ON THE OTHER END. SPACE ENCODE CSECT , *** ENTRY *** USING *,R12 SAY BASE OK SAVE (14,12) SAVE REGS LR R12,R15 GET NEW BASE * IN OUT LA R2,2(R1) GET FROM ********** LH R3,0(R1) GET AND SIZE AREA * 2 4 * LR R4,R0 GET TO SIZE * 3 5 * LA R5,0 GET AND SIZE ********** SH R3,=AL2(2) LOSE TWO FOR SIZE OF SIZE MVI ENCOLQAD,C'*' START WITH A BAD QUADRANT LA R6,3(R4) WHERE THE SIZE IS TO BE SAVED LA R4,5(R4) WHERE THE DATA IS TO GO *** *** FIRST BUILD THE QUADRANT CODE *** ENCOL001 SR R15,R15 CLEAR R15 IC R15,0(R2) GET THE CODE POINT AR R15,R15 DOUBLE IT LA R15,ENCOTABL(R15) ADD TABLE BASE MVC ENCOTQAD(1),0(R15) GET QUADRANT MVC 0(1,R2),1(R15) PUT CODE POINT TO FROM DATA *** *** THIRD BUILD THE QUADRANT CODE IF NEEDED *** CLC ENCOLQAD,ENCOTQAD DO QUADRANTS AGREE BE *+4+20 YES MVC ENCOLQAD,ENCOTQAD SAVE NEW QUADRANT MVC 0(1,R4),ENCOTQAD COPY QUADRANT LA R5,1(R5) UP SIZE LA R4,1(R4) UP AREA *** *** FOURTH BUILD THE ACTUAL CODE POINT *** ENCOL003 MVC 0(1,R4),0(R2) COPY THE NEW CODE POINT LA R4,1(R4) UP NEW AREA LA R5,1(R5) UP NEW SIZE *** LA R2,1(R2) UP IN AREA BCT R3,ENCOL001 REPEAT *** *** FINAL EXIT *** LA R5,2(R5) ADD TWO FOR SIZE OF THE SIZE STH R5,0(R6) SAVE NEW BYTES CONVERTED RETURN (14,12),RC=0 RETURN *** *** QUADRANT MEMORY *** ENCOLQAD DC C'*' LAST QUADRANT ENCOTQAD DC C'*' THIS QUADRANT *** *** WHERE DID THE USER HAVE A WORD FOR US *** ENCOADDR DC A(0) ADDR OF FWD OF OT BYTES *** *** CODE POINT CONVERSION - SC30-3332-0 PAGES 2-6 ETC *** ENCOTABL DC 0A(0) 00-3F DC C'0>1>2>3>4>5>6>7>8>9' DC X'4CA44CA54CA64CA74CA84CA9' DC C'? ' * DC 0A(0) 40-7F DC C'>A>B>C>D>E>F>G>H>I>J?.>L>M>N>O>P>Q>R>S>T>U>V>W>X>Y>Z' DC C'<0<1<2<3<4<5' DC X'6E816E826E836E846E856E866E876E886E89' DC X'6E916E926E936E946E956E966E976E986E99' DC X'6EA26EA36EA46EA56EA66EA76EA86EA9' DC C'<6<7<8<9<.' * DC 0A(0) 80-BF DC X'4C406F816F826F836F846F856F866F876F886F896ED2' DC C'@A@B@C@D@E@F' DC X'6F916F926F936F946F956F966F976F986F99' DC C'@G@H@I@J@K@L@M@N' DC X'6FA26FA36FA46FA56FA66FA76FA86FA9' DC C'@O@P@Q@R@S@T@U@V@W@X@Y@Z' DC X'7C817C827C837C847C857C867C877C887C897C91' * DC 0A(0) C0-FF DC X'7C92' DC C'?A?B?C?D?E?F?G?H?I' DC X'7C937C947C957C967C977C987C99' DC C'?J?K?L?M?N?O?P?Q?R' DC X'7CA27CA37CA47CA57CA67CA77CA87CA9' DC C'?S?T?U?V?W?X?Y?Z@0@1@2@3@4@5?0?1?2?3?4?5?6?7?8?9' DC C'@6@7@8@9@.@ ' ENCOSIZE EQU *-ENCOTABL *** MUST BE HEX 100 *** LTORG , TITLE '*** DECODE AN AREA ***' * ******************************************************************* * * * DECODE AN AREA TO QUADRANT TEXT * * * ******************************************************************* * SPACE * R1--> A(INAREA),A(INSIZE),A(OTAREA) * INAREA DC NC'...' INPUT TEXT * INSIZE DC F'INBYTES' BYTES TO EXAMINE * OTAREA DC 2NC'......' OUTPUT DECODED * OTSIZE DC F'OTBYTES' BYTES OUTPUTTED * * RULE THE CONVERSE OF ENCODE. SPACE DECODE CSECT , *** ENTRY *** USING *,R12 SAY BASE OK SAVE (14,12) SAVE REGS LR R12,R15 GET NEW BASE * IN OUT LA R2,2(R1) GET FROM ********** LH R3,0(R1) GET AND SIZE AREA * 2 4 * LR R4,0 GET TO SIZE * 3 5 * LA R5,0 GET AND SIZE ********** SH R3,=AL2(2) LOSE 2 FOR SIZE OF SIZE ST R4,DECOADDR SAVE ADDR OF OUT SIZE H-WORD LA R4,2(R4) AND GO TO DATA START *** R15 ----- TRIAL TABLE *** FIRST HANDLE QUADRANTS ===================== *** DECOQUAD - LAST TABLE DECOL001 LA R15,TABLEQ TRY FOR TABLE-Q CLI 0(R2),C'?' ? BE DECOL005 YES LA R15,TABLEA TRY FOR TABLE-A CLI 0(R2),C'@' @ BE DECOL005 YES LA R15,TABLEG TRY FOR TABLE-G CLI 0(R2),C'>' > BE DECOL005 YES LA R15,TABLEL TRY FOR TABLE-L CLI 0(R2),C'<' < BE DECOL005 YES *** *** PROCESS THE CODE POINT *** MVC DECOCODE(1),0(R2) COPY THE CODE POINT L R15,DECOQUAD GET ONE OF FOUR TABLES TR DECOCODE(1),0(R15) GET CORRECT CODE POINT *** *** FOURTH BUILD THE ACTUAL CODE POINT *** DECOL003 MVC 0(1,R4),DECOCODE COPY THE NEW CODE POINT LA R4,1(R4) UP NEW AREA LA R5,1(R5) UP NEW SIZE *** DECOL004 LA R2,1(R2) UP IN AREA BCT R3,DECOL001 REPEAT *** *** FINAL EXIT *** L R1,DECOADDR GET OUT SIZE WORD LA R5,2(R5) ADD 2 FOR THE SIZE OF SIZE STH R5,0(R1) SAVE NEW BYTES CONVERTED RETURN (14,12),RC=0 RETURN *** *** SAVE QUADRANT TABLE ADDRESS FOR LATER *** DECOL005 ST R15,DECOQUAD SAVE QUADRANT B DECOL004 PROCEED *** *** QUADRANT MEMORY *** DECOQUAD DC A(TABLEQ) LAST QUADRANT DECOCODE DC X'00' WORKING BYTE *** *** WHERE DID THE USER HAVE A WORD FOR US *** DECOADDR DC A(0) ADDR OF FWD OF OT BYTES *** *** CODE POINT CONVERSION - ACTUAL CODE POINT TABLE *** TABLEQ BYTE C' ',40 ? QUADRANT BYTE C'.',4B DOT BYTE X'81',818283848586878889 LITTLE A-I BYTE X'91',919293949596979899 LITTLE J-R BYTE X'A2',A2A3A4A5A6A7A8A9 LITTLE S-Z BYTE C'A',C1C2C3C4C5C6C7C8C9 A-I BYTE C'J',D1D2D3D4D5D6D7D8D9 J-R BYTE C'S',E2E3E4E5E6E7E8E9 S-Z BYTE C'0',F0F1F2F3F4F5F6F7F8F9 LTABLEQ EQU *-TABLEQ TABLEA BYTE C'A',8B8C8D8E8F90 @ QUADRANT BYTE C'G',9A9B9C GHI BYTE C'J',9D9E9FA0A1 JKLMN BYTE C'O',AAABACAD OPQR BYTE C'S',AEAFB0B1B2B3B4B5 S-Z BYTE X'81',B6B7B8B9BABBBCBDBE LITTLE A-I BYTE X'91',BFC0 LITTLE J,K BYTE X'93',CACBCCCDCECFD0 LITTLE L-R BYTE X'A2',DADBDCDDDEDFE0E1 LITTLE S-Z BYTE C'0',EAEBECEDEEEF 0-5 BYTE C'6',FAFBFCFD 6-9 BYTE C'.',FE BYTE C' ',FF LTABLEA EQU *-TABLEA TABLEL BYTE C'A',00 < QUADRANT BYTE C'B',0102030405060708 A-I BYTE C'J',090A0B0C0D0E0F1011 J-R BYTE C'S',1213141516171819 S-Z BYTE X'81',1A1B1C1D1E1F LITTLE A-F BYTE X'87',212223 LITTLE G,H,I BYTE X'91',2425262728292A2B2C LITTLE J-R BYTE X'A2',2D LITTLE S BYTE X'A3',2F LITTLE T BYTE X'A4',3A3B3C3D3E3F LITTLE U BYTE C'0',5B5C5D5E5F60 0-5 BYTE C'6',7B7C7D7E 6-9 BYTE C'.',7F . BYTE C' ',80 BLANK LTABLEL EQU *-TABLEL TABLEG BYTE C' ',20 > QUADRANT BYTE C'.',2E RESTART BYTE C'0',30313233343536373839 BYTE C'A',414243444546474849 A-I BYTE C'J',4A J BYTE C'L',4C4D4E4F505152 L-R BYTE C'S',535455565758595A S-Z BYTE X'81',616263646566676869 LITTLE A-I BYTE X'91',6A6B6C6D6E6F707172 LITTLE J-R BYTE X'A2',737475767778797A LITTLE S-Z BYTE C'K',8A K LTABLEG EQU *-TABLEG LTORG , TITLE '*** ENCODE THE BLOCK CHECK ***' * ******************************************************************* * * * ENCODE A BLOCK CHECK * * * ******************************************************************* * SPACE * R1 AREA TO WORK ON FORMATTED AS FOLLOWS:- * * +0(2) SIZE OF THIS 2 BYTES PLUS SUBSEQUENT DATA * +2(1) X REG - SEQN * +3(1) Y REG - CTL.1 * +4(1) Z REG - CTL.2 * +5(NNN) ORIGINAL DATA * +5+NNN(2) 00 00 SPACE FOR BLOCK CHECK * * EXIT RC=4=BAD SIZE SPACE ENBLKC CSECT , *** ENTRY *** USING *,R12 SAY BASE OK SAVE (14,12) SAVE REGS LR R12,R15 GET NEW BASE * IN LA R2,2(R1) GET FROM ***** LH R3,0(R1) AND SIZE AREA * 2 * CH R3,=AL2(3) CHECK LIMIT * 3 * BL ENBLKCXT EXIT IF SMALL ***** *** *** FIRST CALCULATE THE BCC *** SR R4,R4 BCC REGISTER SH R3,=AL2(2+2) LOSE 2=SIZE, 2=BCC ENBLKC01 SR R5,R5 ONE BYTE IC R5,0(R2) GET ITS VALUE AR R4,R5 ADD TO BCC REGISTER LA R2,1(R2) GET NEXT BYTE BCT R3,ENBLKC01 REPEAT *** *** NOW R2 POINTS TO WHERE THE BCC TWO BYTES ARE *** STC R4,1(R2) SAVE LOW BYTE SRL R4,8 AND STC R4,0(R2) SAVE HI BYTE *** *** FINAL EXIT *** RETURN (14,12),RC=0 RETURN THE GOOD BCC ENBLKCXT RETURN (14,12),RC=4 RETURN 4 FOR A BAD BLOCKSIZE LTORG , TITLE '*** DECODE THE BLOCK CHECK ***' * ******************************************************************* * * * DECODE THE BLOCK CHECK * * * ******************************************************************* * SPACE * R1--> A(INAREA),A(INSIZE) * INAREA DC NC'...' INPUT TEXT * INSIZE DC F'INBYTES' BYTES TO EXAMINE * * RULE THE SIZE MUST BE AT LEAST THREE BYTES. WE REQUIRE THE * BYTES FOR THE BCC. THE BCC IS A SIMPLE 16 BIT WRAPPED * BINARY SUM BYTE BY BYTE. * * EXIT RC=0=GOOD, RC=4=BAD SIZE, RC=8=BCC ERROR SPACE DEBLKC CSECT , *** ENTRY *** USING *,R12 SAY BASE OK SAVE (14,12) SAVE REGS LR R12,R15 GET NEW BASE * IN LA R2,2(R1) GET FROM ***** LH R3,0(R1) AND SIZE AREA * 2 * CH R3,=AL2(3) CHECK LIMIT * 3 * BL DEBLKCXT EXIT IF SMALL ***** *** *** FIRST CALCULATE THE BCC *** SR R4,R4 BCC REGISTER SH R3,=AL2(2+2) LOSE TWO BYTES ON SIZE AND BCC DEBLKC01 SR R5,R5 ONE BYTE IC R5,0(R2) GET ITS VALUE AR R4,R5 ADD TO BCC REGISTER LA R2,1(R2) GET NEXT BYTE BCT R3,DEBLKC01 REPEAT *** *** NOW R2 POINTS TO WHERE THE BCC TWO BYTES ARE *** SR R6,R6 CLEAR REGISTER 6 IC R6,0(R2) GET HIGH BYTE SLL R6,8 AND IC R6,1(R2) GET LOWER BYTE N R4,=A(X'0000FFFF') MAKE 16 BITS LIKE R6 * XC 0(100,R2),0(R2) LOSE THE BCC AND OTHER TRAILERS CR R6,R4 R6(ACTUAL)::R4(CALCULATED) BNE DEBLKCER ERROR *** *** FINAL EXIT *** RETURN (14,12),RC=0 RETURN AND GOOD BCC SAVED DEBLKCXT RETURN (14,12),RC=4 LOW SIZE DEBLKCER RETURN (14,12),RC=8 BCC ERROR LTORG , EJECT SPACE 3 *********************************************************************** * * * * * * * CCCCCC N N MM MM * * C NN N M M M M * * C N N N M M M M * * C N N N M M M * * C N N N M M * * C N N N M M * * CCCCCC N NN M M * * * * * * THIS HANDLES THE CNM RTM/REQMS LOGIC * * * *********************************************************************** TITLE '*** CNM PROCESSOR ***' * ******************************************************************* * * * VTAM CNM PROCESSOR * * ******************************************************************* * SPACE * GENERAL PROCEDURES USED IN THIS PROGRAM. * **************************************** * * (1) THIS PROGRAM DOES NOT MANAGE UNSOLICITED RECORDS (RECMS), * THIS PROGRAM DOES MANAGE SOLICITED RECORDS (REQMS)(RECFMS). * TO DO THIS WE NEED TO BE DEFINED AS FOLLOWS:-----------+ * ? * ISTMGC00 CSECT ? * ISTMGA00 CSECT LOGRECS ? * DC X'0002' 2 ENTRIES ? V * DC X'000C' 12 BYTES EACH ? STATS * DC XL8'00' FILLER ? ? * E1 DC X'00',X'010381',CL8'SHADOWC1' <--+ ? * E2 DC X'00',X'410384',CL8'........' <--------+ * END * * (2) THE FOLLOWING ARE THE AVAILABLE APPL NAMES * SHADOWC1 APPL AUTH=CNM * SHADOWC2 APPL AUTH=CNM * SHADOWC3 APPL AUTH=CNM * * (3) LET US GET SOME TERMS STRAIGHT RIGHT NOW * * ******** ******** ******* ****** ****** * * APPL *----* VTAM *----* NCP *----* PU *---* LU * * ******** ******** ******* ****** ****** * * 810810 *----REQMS=410304-------------->...... * . * 810812 <----RECFMS=410384-------------*...... * * * 810812 <-------+-RECMS=010381--* * ? * V * LOGREC * EJECT * ******************************************************************* * * * RESPONSE FORMAT IS AS FOLLOWS * * * ******************************************************************* * SPACE * THE FORMAT OF THE RESPONSE IS AS FOLLOWS:- * DLVR +0 X'810812' DELIVER RU * +6 AL2(L'NSRU) LENGTH OF NS RU * * NSRU +8 CL'NSRU NS RU * ? +8 X'410384' RECFMS TYPE DATA (PU) * ? +8+7 X'XX' ACTUAL TYPE 1,2,3,4,5 * OR * ? +8 CL'NSRU * ? +8 X'010381' RECMS TYPE DATA (NCP) * ? +8+7 X'XXYYZZ' ACTUAL TYPE * * LIST +8+L'NSRU NODE HIEARCHY LIST * * ******************************************************************* * * * RECFMS PAGE 180 ZZ05-0098-0 FOR SUB TYPES * * * * RECFMS PAGE 80 GA27-3136-3 * * * ******************************************************************* * * * TYPE=1,2,3,4,5 IN+15(1) 1 BYTE HEX * * ******************************************************************* * * * RECFMS 1=LINK TEST * * * ******************************************************************* * * * RCVD SDLC TEST CMD XXXX IN+22(2) 2 BYTES HEX * RCVD SDLC TEST CMD XXXX IN+24(2) 2 BYTES HEX * * ******************************************************************* * * * RECFMS 2=SUMMARY DATA * * * ******************************************************************* * * * MCK CNTR XXXX IN+25(2) IF IN+22=X'80' * COM " XXXX IN+27(2) IF IN+22=X'40' * SNA " XXXX IN+29(2) IF ? * * ******************************************************************* * * * RECFMS 3=COMM ADAPTER * * * ******************************************************************* * * * IN+23=> 8000 NON PROD TIMEOUT XX <=IN+26 * " 4000 IDLE TIMEOUT XX <=IN+27 * " 2000 WRITE RETRY *ERR* XX <=IN+28 * " 1000 OVERRUN XX <=IN+29 * " 0800 UNDERRUN XX <=IN+30 * " 0400 CONNECTION PROBLEM XX <=IN+31 * " 0200 FCS ERROR XX <=IN+32 * " 0100 PRIMARY STN ABORT XX <=IN+33 * " 0080 COMMAND REJECT XX <=IN+34 * " 0040 DCE ERROR COUNTER XX <=IN+35 * " 0020 WRITE TIMEOUT XX <=IN+36 EJECT * ******************************************************************* * * * CNM * PROCESS CNM COMMANDS * * * ******************************************************************* * SPACE * __ RQMS TT,PUNAME SEND TYPE "T" REQMS * __ RTM_ TEXT,PUNAME SEND RTM REQUEST * __ RQMS ___ READ RECFMS OR RTM INPUT * __ RTM_ ___ ALIAS OF RQMS COMMAND SPACE PMODCNMP CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED L R5,CURRENT R5 GET CURRENT PROGRAM LINE LA R8,SAVEAREA R8 BUT ALTER TO DROP R13 A NEW USING SAVEAREA,R8 REGISTER LA R0,200 GET A GETMAIN R,LV=(0) SAVE AREA ST R13,4(1) SAVE OLD R13 IN NSAVE+4 ST R1,8(R13) SAVE NEW R13 IN OSAVE+8 LR R13,R1 R13 GET NEW SAVE *** *** FREE ANY READ CHAINS SO FAR *** CNMPBUFR L R1,READSTAK GET START OF READ STACK MVC READSTAK(4),0(R1) +0 -> GET ADDRESS OF NEXT ELEMENT LTR R1,R1 ANY ADDR BZ CNMPGETM NO SO EXIT L R0,4(R1) +4 -> GET SIZE OF THIS ELEMENT LTR R0,R0 ANY SIZE BZ CNMPGETM NO SO EXIT FREEMAIN R,LV=(0),A=(1) FREEMAIN B CNMPBUFR LOOP TILL END OF CHAIN *** *** NOW GET MEMORY FOR THE CNM READ ELEMENT *** CNMPGETM LA R0,READSIZE GET GETMAIN R,LV=(0) CORE LR R2,R1 R2=AREA AVAILABLE *** *** R2 = GOOD SIZE AND IN+21 IS THE START - GET PROTOCOL *** ST R2,READSTAK SAVE FOR READ STACK MVC 0(8,R2),=A(0,READSIZE) NEXT=0,SIZE=2500 (OR WHATEVER) XC 8(20,R2),8(R2) 20 BYTES FOR PROTOCOL XC 28(12,R2),28(R2) 12 BYTES FOR SENSE AND ETC XC 40(60,R2),40(R2) 60 BYTES FOR RPL XC 100(256,R2),100(R2) 100 BYTES CLEANED, 2400=DATA * +8(20) = PROTOCOL MVC 8(2,R2),=C'()' REFLECT BRACKETS MVC 10(1,R2),=C'*' REFLECT CHANGE DIRECTION MVC 11(3,R2),=C'OIC' REFLECT CHAINS MVC 14(3,R2),=C'DR1' REFLECT RESPONSE * +28(8) = SENSE MVC 28(4,R2),=C'RSP=' COPY RTYPE MVC 32(4,R2),=C'DATA' COPY RTYPE * 40(60) = RPL L R1,=A(RPL) GET CNM RPL MVC 40(60,R2),0(R1) COPY RPL MVC 88(4,R2),=A(1920) SIMULATE A SIZE *** *** WHAT WE GOT? *** CLC IN+8(4),=C'READ' IS THIS READ RECFMS/RTM BE CNMI YES CLC IN+3(4),=C'RQMS' IS THIS SEND REQMS BE CNMO YES CLC IN+3(4),=C'RTM ' IS THIS SEND RTM BE RTMO YES B CNMEROR1 ERROR EJECT * ******************************************************************* * * * READ THE RESPONSE OR TIME OUT * * * ******************************************************************* * SPACE CNMI LA R4,10 ALLOW 10 TIMER UNITS * CNMILOOP L R0,=A(CNMITIMR) GET ROUTINE STIMER REAL,(0),DINTVL=CNMIVALU SET UP A PULSE L 2,=A(CNMITECB) GET AN ECB WAIT 1,ECB=(2) WAIT MVI 0(2),X'00' UNPOST THE ECB * L R2,READSTAK GET IO AREA LA R2,100(R2) DATA START XC 0(256,R2),0(R2) CLEAR IN AREA ********************************************************************** L R6,=A(RPL) GET RPL * L R3,=A(CID) GET CID * L R3,0(R3) GET CID * RECEIVE RPL=(6),AREA=(2),ARG=(3), DATA QUEUED UP ? * X AREALEN=800,RTYPE=(DFSYN,DFASY),OPTCD=(SYN,NQ) * ********************************************************************** LA R0,24 SIZE TO USE LA R1,IN+21 START OF INAREA LA R14,0(R2) START OF TEXT UNPK 0(3,R1),0(2,R14) <--+ UNPACK TWO BYTES LA R1,2(R1) ? GET NEXT LA R14,1(R14) ? GET NEXT BCT R0,*-14 *--+ REPEAT L R1,=A(TAB-240) GET TABLE TR IN+21(48),0(R1) FIX MVI IN+21+48,C' ' IT UP L R1,CURRENT GET REAL LINE IN PGM MVC 0(80,R1),IN COPY DATA BACK ********************************************************************** BAL 14,CNMANALZ ANAYLZE RESULT * CLI 0(R2),X'00' DATA IN? IF SO EDIT BNE CNMIDATA DATA SO STEP TO IT BCT 4,CNMILOOP ELSE RETRY B CNMEROR2 HALT SPACE * DC C'HHMMSSTH' HH MM SS TH CNMIVALU DC C'00000050' 5/10 TH SECONDS PAUSE EJECT * ******************************************************************* * * * FORMAT THE RESPONSE FROM THE PU INTO A HUMAN READABLE FORM * * * ******************************************************************* * SPACE CNMIDATA CLC 0(3,R2),=X'810812' SPECIFIC DELIVER RU? BNE CNMEROR3 ELSE DONT EDIT MVC 70(6,R5),=C'RECMS ' CHECK IF RECFMS CLC 8(3,R2),=X'010381' IS THIS A RECMS (NCP) BE CNMPEXIT YES MVC 70(6,R5),=C'RECFMS' CHECK IF RECFMS CLC 8(3,R2),=X'410384' IS THIS A RECFMS (PU) BE CNMPEXIT YES MVC 70(6,R5),=C'RTM ' CHECK IF RTM CLC IN+8(3),=X'41038D' IS THIS A RTM (PU/LU) BE CNMPEXIT YES B CNMEROR4 BOO BOO EJECT * ******************************************************************* * * * NOW SEND THE REQUEST OVER THE INTERFACE TO GET SOME ACTION * * * ******************************************************************* * SPACE CNMO LA 2,LCNMMSG CNM MESSAGE MVC CNMPU+2(8),IN+16 __ RQMS TT,PRID,PUNAME MVC CNMLU+2(8),IN+16 SAVE NODE PACK CNMPRID(3),IN+11(5) GET PRID - PACKED NO SIGN MVC CNMTYP(1),IN+9 GET TYPE - PACKED NO SIGN NI CNMTYP,X'0F' IN HEX --- LOWER NIBBLE CLI IN+8,C'8' RESET BIT WANTED? BNE *+8 NO OI CNMTYP,X'80' SET IBM RESET BIT ********************************************************************** L 6,=A(RPL) GET RPL * L 3,=A(CID) GET CID * L 3,0(3) GET CID * SEND RPL=(6),OPTCD=(SYN,FMHDR),ARG=(3), * X STYPE=REQ,CONTROL=DATA,BRACKET=(NBB,NEB), * X POST=RESP,RESPOND=(NEX,FME), * X CHAIN=ONLY,CHNGDIR=(NCMD,NREQ), * X RECLEN=(2),AREA=CNMMSG * ********************************************************************** BAL 14,CNMANALZ ANAYLZE RESULT B CNMPEXIT RETURN HAVING DONE THE SEND EJECT * ******************************************************************* * * * CNM OUTPUT - NS HEADER AND REQMS (TRIGGER RECFMS) * * * ******************************************************************* * SPACE * P 183 ZZ05-0098-0 NETWK ERR * CNM OUTPUT BLOCK P 2-316 LY38-3030-1 DATA AREAS * P F-7 SC27-0449-1 PRGRMNG CNMMSG DC 0A(0) P 53 GA27-3136-3 SNA REF DC X'81' +0 NETWORK SERVICES, LOGICAL SVCS DC X'08' +1 MANAGMENT SERVICES DC X'10' +2 REQUEST CODE DC X'00' +3 FORMAT 0 DC X'00' +4 02=0=REPLY NEEDED 1=NO REPLY * 01=0=CNM HEADER 1=NO CNM HDR DC X'00' +5 RESERVED DC AL2(3+5) +6 LENGTH OF NS RU *-------------+ * ? * NS RU ******************************************************* A ? DC X'410304' REQMS PAGE 179 ZZ05-0098-0 ** ? ? * CNM HDR ************************************************ ** ?<-+ DC X'00' TARGET ID ** ** ? DC X'00' TARGET ID ** ** ? CNMPRID DC X'0001' PRID=0001 ** ** ? CNMTYP DC X'04' SUMM ERRS ************* V * * SYMBOLIC NAMES USED FOR LETTING VTAM COMPLETE RU EARLIER * CNMPU DC X'F1' F1=PU DESTINATION DC X'08' 08=LENGTH DC CL8'BADPUNM' DESTINATION PU CNMLU DC X'F1' F3=LU TARGET DC X'08' 08=LENGTH DC CL8'BADPUNM' DESTINATION PU LCNMMSG EQU *-CNMMSG LENGTH EJECT * ******************************************************************* * * * NOW SEND THE REQUEST OVER THE INTERFACE TO GET SOME ACTION * * * ******************************************************************* * SPACE RTMO MVC RTMPU+2(8),IN+13 SAVE NODE MVC RTMLU+2(8),IN+13 SAVE NODE * LA R3,SAVEAREA GET MAIN AREA A R3,=A(TEXT-SAVEAREA) GET START OF TEXT BUFFER * CLC 0(2,R3),=AL2(100-(20+8)) CHECK SIZE LIMIT BH CNMEROR6 BAD CLC 0(2,R3),=AL2(3) CHECK SIZE LIMIT BL CNMEROR6 BAD CLC 2(3,R3),=X'41038D' IS THIS RTM FORMATTED BNE CNMEROR5 NO * MVC RTMMSGO(6),RTMMSG INITIAL NS HEADER + VTAM GOOP LH R1,0(R3) GET USER SIZE SH R1,=AL2(2) LOSE TWO FOR SIZE OF SIZE STH R1,RTMMSGO+6 SAVE SIZE BCTR R1,0 LOSE 1 FOR 370 STC R1,*+5 SAVE SIZE MVC RTMMSGO+8(*-*),2(R3) COPY RTM MESSAGE (AFTER SIZE) LA R2,8+1+20(R1) 8=NS+VTAM,1=370,20=VTAM.TRAILER LA R1,RTMMSGO+8+1(R1) POINT TO END OF TEXT MVC 0(20,R1),RTMPU COPY OVER MORE VTAM GOOP * ********************************************************************** L 6,=A(RPL) GET RPL * L 3,=A(CID) GET CID * L 3,0(3) GET CID * SEND RPL=(6),OPTCD=(SYN,FMHDR),ARG=(3), * X STYPE=REQ,CONTROL=DATA,BRACKET=(NBB,NEB), * X POST=RESP,RESPOND=(NEX,FME), * X CHAIN=ONLY,CHNGDIR=(NCMD,NREQ), * X RECLEN=(2),AREA=RTMMSGO * ********************************************************************** BAL 14,CNMANALZ ANAYLZE RESULT B CNMPEXIT RETURN HAVING DONE THE SEND EJECT * ******************************************************************* * * * RTM OUTPUT - NS HEADER AND RTM (TRIGGER RECFMS) * * * ******************************************************************* * SPACE RTMMSGO DC 25A(0) ACTUAL MESSAGE * P 183 ZZ05-0098-0 NETWK ERR * CNM OUTPUT BLOCK P 2-316 LY38-3030-1 DATA AREAS * P F-7 SC27-0449-1 PRGRMNG RTMMSG DC 0A(0) P 53 GA27-3136-3 SNA REF DC X'81' +0 NETWORK SERVICES, LOGICAL SVCS DC X'08' +1 MANAGMENT SERVICES DC X'10' +2 REQUEST CODE DC X'00' +3 FORMAT 0 DC X'00' +4 02=0=REPLY NEEDED 1=NO REPLY * 01=0=CNM HEADER 1=NO CNM HDR DC X'00' +5 RESERVED DC AL2(51) +6 LENGTH OF NS RU *-------------+ * ? * NS RU ******************************************************* A ? RTMRU DC X'41038D' REQMS P8-14 GA23-001-2 ** ? ? * RTM HDR ************************************************ ** ?<-+ * RU3 DC X'0000' IGNORED ** ** ? * RU5 DC X'0001' PRID=0001 ** ** ? * RU7 DC X'..... SUMM ERRS ** ** ? DC 48X'00' COMPLETE RU **---** V * * SYMBOLIC NAMES USED FOR LETTING VTAM COMPLETE RU EARLIER * RTMPU DC X'F1' F1=PU DESTINATION DC X'08' 08=LENGTH DC CL8'BADPUNM' DESTINATION PU RTMLU DC X'F1' F3=LU TARGET DC X'08' 08=LENGTH DC CL8'BADPUNM' DESTINATION PU LRTMMSG EQU *-RTMMSG LENGTH EJECT * ******************************************************************* * * * ANAL * SELECT ERROR HANDLER --OR-- ISSUE MESSAGE * * * ******************************************************************* * SPACE CNMANALZ MVC 70(8,R5),=C'RPL=00 ' SAY OK L R1,=A(TPEND) GET MAIN CNM EXIT LOGIC CLI 6(R1),X'00' 00=OK, FF=LOST IT BE *+4+8 ALL OK MVC 70(6,R5),=C'SESBAD' SAY FAILED BR R14 RETURN * * AT LEAST WE HAVE NOT PICKED UP AN EXIT FUNCTION * L 6,=A(RPL) GET RPL CLC 13(2,R6),=X'0000' ANY ERRORS AT ALL BE 0(14) NO ERRORS SO SKIP * * WE GOT A NON ZERO RETURN CODE SO THERE IS A PROBLEM. * UNPK 72(5,R5),88(3,R6) GET SNA CODES MVC 70(2,R5),=C'S=' SAY SNA CLC 72(2,R5),=C'00' ZERO? BNE *+16 NO UNPK 72(5,R5),13(3,R6) GET VTAM CODES MVC 70(2,R5),=C'V' SAY VTAM MVI 76(R5),C' ' CLEAR BAD BYTE L R1,=A(TAB-240) GET TABLE TR 72(4,R5),0(R1) CLEAN IT UP BR R14 RETURN EJECT *** *** *** CNMPEXIT LA R0,200 SIZE LR R1,R13 CORE TO FREE L R13,4(R13) GET LAST FREEMAIN R,LV=(0),A=(1) FREE SAVE AREA RETURN (14,12),RC=0 EXIT EJECT ***=================================================================*** CNMEROR1 MVC 70(6,R5),=C'BAD OP' NOT GOOD COMMAND B CNMPEXIT QUIT CNMEROR2 MVC 70(6,R5),=C'TIMOUT' NO DATA CAME IN DURING LOOP B CNMPEXIT QUIT CNMEROR3 MVC 70(6,R5),=C'NOT NS' NOT 810812 NS HEADER B CNMPEXIT QUIT CNMEROR4 MVC 70(6,R5),=C'BADTYP' NOT RECFMS, RECMS, RTM B CNMPEXIT QUIT CNMEROR5 MVC 70(6,R5),=C'TXTHDR' NOT FORMATTED AS RTM HEADER B CNMPEXIT QUIT CNMEROR6 MVC 70(6,R5),=C'TXTSIZ' BAD SIZE FOR RTM MSG B CNMPEXIT QUIT LTORG , SPACE *********************************************************************** * EXIT * NAME: TIMER PULSE * TIMER * * * FUNCTION: TO ALLOW FOR TIMER SETTINGS * * *********************************************************************** SPACE USING CNMITIMR,R15 SET BASE FOR CODE CNMITIMR STM 0,15,CNMITMSV SAVE REGISTERS DROP 15 NOW DROP REGISTER USING CNMITIMR,R12 STATE NEW REG IS OK LR 12,15 AND MAKE IT THUS POST CNMITECB POST ECB LM 0,15,CNMITMSV LOAD REGISTERS BR 14 RETURN TO VTAM CNMITMSV DC 16A(0) REGISTERS CNMITECB DC A(0) SET WHEN TIMER EXPIRES DROP 12 LOSE TEMPORARY BASE LTORG , EJECT SPACE 3 *********************************************************************** * * * * * EEEEE DDDD I TTTTTTT * * E D D I T * * EEEE D D I T * * E D D I T * * EEEEE DDDD I T CCCC H H EEEEE CCCC K K * * C H H E C K K * * C HHHH EEEE C KK * * C H H E C K K * * CCCC H H EEEEE CCCC K K * * * * THIS DOES TYPE IN TIME EDIT CHECKING * * * *********************************************************************** EJECT * ******************************************************************* * * * NOW-> PROCESS ERRORS CATCHABLE AT EDIT TIME AND * * * * FUTR> PROCESS MACROS * * * ******************************************************************* * SPACE EDITTEST CSECT , *** ENTRY *** IN+0(2) 00_ USING *,R15 SAY OK IN+3(5) VERB_ USING SAVEAREA,R13 USABLE IN+8(N) OPND SAVE (14,12) SAVE REGS IN+21 DATA LA R3,255 R3=0=ERRORS DETECTED,>0=OK MVC IN+70(8),=CL8' ' CLEAR PRIOR STATUS AREA CLI IN+2,C'?' IS HE REQUESTING HELP? *860716 BE CHEK9600 LEAVE HIM ASIS *** *** CHECK AND SEE IF S E N D S I G N A L *** CHEK0000 CLC IN+3(11),=C'SEND SIGNAL' IS THIS SEND SIGNAL BNE CHEK0100 NO CLI IN+21,C' ' DATA ? BE *+4+8 NO SO SIMULATE FOR HIM CLI IN+21,C'_' NO DATA ? BNE CHEK9500 YES SO EXIT OK MVC IN+21(12),=C'00010000____' SET UP SOME JUNK B CHEK9500 EXIT OK *860731 *** *** CHECK AND SEE IF S E N D X X X *** CHEK0100 CLC IN+3(4),=C'SEND' IS THIS SEND EBCDIC BE *+4+10 NO CLC IN+3(4),=C'SALT' IS THIS SEND ASCII BNE CHEK0200 NO CLC =CL4'CSDT',IN+8 CLEAR AND START DATA TRAFFIC BE CHEK9500 YES CLC =CL3'CLR',IN+8 CLEAR BE CHEK9500 YES CLC =CL3'BID',IN+8 BID BE CHEK9500 YES CLC =CL3'SDT',IN+8 START DATA TRAFFIC BE CHEK9500 YES CLC =CL4'CHASE',IN+8 CHASE BE CHEK9500 YES CLC =CL4'SHUTD',IN+8 SHUTD BE CHEK9500 YES CLC =CL4'CANCEL',IN+8 CANCEL BE CHEK9500 YES * THIS IS SEND DATA SO CHECK PROTOCOL CLC IN+8(2),=C'()' IS IT BB+EB BE CHEK0102 YES CLC IN+8(2),=C'(>' IS IT BB+CEB BE CHEK0102 YES CLC IN+8(2),=C')(' IS IT NBB+NEB BE CHEK0102 YES CLC IN+8(2),=C'BB' IS IT BB BE CHEK0102 YES CLC IN+8(2),=C'EB' IS IT EB BE CHEK0102 YES CLC IN+8(2),=C'CB' IS IT CEB BE CHEK0102 YES MVC IN+8(2),=C'??' BLEEP HIM SR R3,R3 ERROR DETECTED CHEK0102 CLI IN+11,C'*' IS IT NO-CDI BE CHEK0103 YES CLI IN+11,C'N' IS IT NO-CDI BE CHEK0103 YES CLI IN+11,C'C' IS IT CDI BE CHEK0103 YES CLI IN+11,C'Y' IS IT CDI BE CHEK0103 YES MVI IN+11,C'?' BLEEP HIM SR R3,R3 ERROR DETECTED CHEK0103 CLC IN+13(3),=C'OIC' IS IT OIC BE CHEK0104 YES CLC IN+13(3),=C'FIC' IS IT FIC BE CHEK0104 YES CLC IN+13(3),=C'MIC' IS IT MIC BE CHEK0104 YES CLC IN+13(3),=C'LIC' IS IT LIC BE CHEK0104 YES MVC IN+13(3),=C'?IC' BLEEP HIM SR R3,R3 ERROR DETECTED CHEK0104 CLC IN+17(3),=C'DR1' IS IT DR1 BE CHEK0105 YES CLC IN+17(3),=C'DR2' IS IT DR2 BE CHEK0105 YES CLC IN+17(2),=C'EX' IS IT EX BE CHEK0105 YES MVC IN+17(3),=C'???' BLEEP HIM SR R3,R3 ERROR DETECTED * END OF EDIT CHECK NOW TEST FOR NODE=* PROBLEMS *860731 CHEK0105 CLI IN+21,C'''' IS THIS TEXT *860807 BNE CHEK0106 NO SO OK * L R1,=A(HDR2INFO) ELSE GET ADVISORY V MVC 0(40,R1),=CL40'@=SBA,#=IC,$=SF,&&=RA (VALID IN SEND)' CHEK0106 CLC IN+8(12),=C'() * OIC DR1' IF NOT THIS THEN NODE.NE.* * BE CHEK9600 OK SO FAR * CLC IN+8(12),=C'EB * OIC DR1' IF NOT THIS THEN NODE.NE.* * BE CHEK9600 ADVISE ON NODE * B CHEK9500 SEND IS OK *** *** CHECK AND SEE IF L S E T *** CHEK0200 CLC IN+3(4),=C'LSET' IS THIS LOOP SET BNE CHEK0210 NO CLC =CL2'A,',IN+8 LOOP A, BE CHEK9600 YES CLC =CL2'B,',IN+8 LOOP B, BE CHEK9600 YES CLC =CL2'C,',IN+8 LOOP C, BE CHEK9600 YES MVC IN+8(2),=C'?,' BLEEP HIM SR R3,R3 ERROR DETECTED B CHEK9600 SEND IS OK *** *** CHECK AND SEE IF S R S P *** CHEK0210 CLC IN+3(4),=C'SRSP' IS THIS SET RESPONSE *860730 BNE CHEK0300 NO CLI IN+8,C'_' OK BE CHEK9500 YES CLI IN+8,C' ' OK BE CHEK9500 YES CLI IN+8,C'0' OK BL CHEK0211 YES CLI IN+9,C'0' OK BL CHEK0212 YES B CHEK9500 YES CHEK0211 MVI IN+8,C'?' BAD BYTE B CHEK0213 SKIP CHEK0212 MVI IN+9,C'?' BAD BYTE B CHEK0213 SKIP CHEK0213 MVC IN+20(41),=C' SRSP ____ (NML), SRSP XXXXYYYY (NEG/EX) ' SR R3,R3 ERROR DETECTED B CHEK9500 SEND IS OK *** *** CHECK AND SEE IF L O O P *** CHEK0300 CLC IN+3(4),=C'LOOP' IS THIS LOOP BNE CHEK0400 NO CLC =CL2'A,',IN+8 LOOP A, BE CHEK9600 YES CLC =CL2'B,',IN+8 LOOP B, BE CHEK9600 YES CLC =CL2'C,',IN+8 LOOP C, BE CHEK9600 YES MVC IN+8(2),=C'?,' BLEEP HIM SR R3,R3 ERROR DETECTED B CHEK9600 SEND IS OK *** *** CHECK AND SEE IF T E S T X(PL),XXXX,CX *** CHEK0400 CLC IN+3(4),=C'TEST' IS THIS TEST BNE CHEK0500 NO CLC =CL2'S(',IN+8 S(PL), BE CHEK0401 YES CLC =CL2'D(',IN+8 D(PL), BE CHEK0401 YES CLC =CL2'V(',IN+8 V(PL), BE CHEK0401 YES CLC =CL2'A(',IN+8 A(PL), BE CHEK0401 YES CLC =CL2'T(',IN+8 T(PL), BE CHEK0401 YES MVC IN+8(2),=C'?(' BLEEP HIM SR R3,R3 ERROR DETECTED CHEK0401 MVC IN+12(2),=C'),' FORCE CORRECT MVI IN+18,C',' FORCE CORRECT MVI IN+21,C',' FORCE CORRECT CLC IN+19(2),=C'EQ' IS IT EQ BE CHEK0402 YES CLC IN+19(2),=C'NE' IS IT NE BE CHEK0402 YES MVC IN+19(2),=C'??' BLEEP HIM SR R3,R3 ERROR DETECTED CHEK0402 B CHEK9600 OK *** *** CHECK AND SEE IF C M P R XXXX,CX,PL *** CHEK0500 CLC IN+3(4),=C'CMPR' IS THIS CMPR BNE CHEK0600 NO CLI IN+12,C',' CHECK COMMA BE *+10 YES MVI IN+12,C'?' BLEEP HIM SR R3,R3 ERROR DETECTED CLI IN+15,C',' CHECK COMMA BE *+10 YES MVI IN+15,C'?' BLEEP HIM SR R3,R3 ERROR DETECTED CLC IN+13(2),=C'EQ' IS IT EQ BE CHEK9600 YES CLC IN+13(2),=C'NE' IS IT NE BE CHEK9600 YES MVC IN+13(2),=C'??' BLEEP HIM SR R3,R3 ERROR DETECTED B CHEK9600 EXIT *** *** CHECK AND SEE IF S S E T *** CHEK0600 CLC IN+3(4),=C'SSET' IS THIS SYMBOL SET BNE CHEK0700 NO CLC =CL2'X,',IN+8 SSET X, BE CHEK9600 YES CLC =CL2'Y,',IN+8 SSET Y, BE CHEK9600 YES CLC =CL2'Z,',IN+8 SSET Z, BE CHEK9600 YES MVC IN+8(2),=C'?,' BLEEP HIM SR R3,R3 ERROR DETECTED B CHEK9600 SEND IS OK *** *** CHECK AND SEE IF B I N D *** CHEK0700 CLC IN+3(4),=C'BIND' IS THIS BIND BNE CHEK0800 NO CLI IN+9,C'=' IS THIS BIND D=XX,V=UU,LU=ZZ BNE CHEK0800 NO 8 12 18 CLI IN+8,C'D' D= BE *+10 YES MVI IN+8,C'?' BLEEP HIM SR R3,R3 ERROR DETECTED CLC IN+12(3),=C',V=' ENSURE SECOND OPERAND BE *+12 NO MVC IN+12(3),=C',?=' BLEEP HIM SR R3,R3 ERROR DETECTED CLI IN+17,C',' DID HE TRY A THIRD OPERAND BNE CHEK9500 NO CLC IN+18(3),=C'LU=' IF SO WAS IT OK BE CHEK9500 YES MVC IN+18(3),=C'??=' BLEEP HIM SR R3,R3 ERROR DETECTED B CHEK9500 SEND IS OK *** *** CHECK AND SEE IF S A V E *** CHEK0800 CLC IN+3(4),=C'SAVE' IS THIS SAVE BNE CHEK0900 NO READ CLC IN+12(6),=C',DMOD=' IS THIS SAVE ????,DMOD= BE *+10 YES TEXT MVC IN+12(8),=C',DMOD=? ' CLC IN+8(4),=C'READ' READ BE CHEK9600 NO CLC IN+8(4),=C'TEXT' TEXT BE CHEK9600 NO MVC IN+8(4),=C'????' BLEEP HIM SR R3,R3 ERROR DETECTED B CHEK9600 SEND IS OK *** *** CHECK AND SEE IF E X E C *** CHEK0900 CLC IN+3(4),=C'EXEC' IS THIS EXEC BNE CHEK1000 NO POST CLC IN+8(4),=C'POST' IS THIS EXEC STAK BE CHEK9600 YES LOGON CLC IN+8(5),=C'LOGON' LOGON BE CHEK9600 YES CLC IN+8(4),=C'STAK' STAK BE CHEK9600 YES MVC IN+8(4),=C'????' BLEEP HIM SR R3,R3 ERROR DETECTED B CHEK9600 SEND IS OK *** *** CHECK AND SEE $DEF=1=INFORMATION *** CHEK1000 CLC IN+3(5),=C'$DEF=' IS THIS DEFINE BNE CHEK1100 NO IT IS NOT CLI IN+8,C'1' CHECK 1-5 BL *+4+8 CLI IN+8,C'5' CHECK 1-5 BNH CHEK9600 OK MVI IN+8,C'?' SAY BAD CODE SR R3,R3 ERROR DETECTED B CHEK9600 EXIT *** *** CHECK AND SEE $X *** CHEK1100 CLI IN+3,C'$' IF $ THEN CANT BE $DEF BNE CHEK1200 NO IT IS NOT CLI IN+4,C'1' CHECK 1-5 BL *+4+8 CLI IN+4,C'5' CHECK 1-5 BNH CHEK9600 OK MVI IN+4,C'?' BAD VALUE SR R3,R3 ERROR DETECTED B CHEK9600 EXIT *** *** CHECK RTM *** CHEK1200 CLC IN+3(3),=C'RTM' IF NOT RTM THEN OK BNE CHEK1300 NO IT IS NOT CLC IN+8(5),=C'READ ' CORRECT? BE CHEK9600 YES CLC IN+8(5),=C'TEXT,' CORRECT? BNE *+4+10 MVC IN+30(13),=C'810810,41038D' B CHEK9600 OK MVC IN+8(21),=C'TEXT,PUNAME -OR- READ' SR R3,R3 ERROR DETECTED B CHEK9600 EXIT *** *** CHECK RQMS *** CHEK1300 CLC IN+3(3),=C'RQM' IF NOT RTM THEN OK BNE CHEK1400 NO IT IS NOT CLC IN+8(5),=C'READ ' CORRECT? BE CHEK9600 YES CLI IN+10,C',' CORRECT? BNE *+4+10 MVC IN+30(13),=C'810810,410304' B CHEK9600 OK MVC IN+8(37),=C'READ?TT,PRID,PUNAME (TT=01-05, 81-85)' SR R3,R3 ERROR DETECTED B CHEK9600 EXIT *** *** CHECK TEXT SCREW UP AND FIX IT *** CHEK1400 CLC IN+3(3),=C'TEXT' IF NOT TEXT THEN OK BNE CHEK1500 NO IT IS NOT CLI IN+13,C'''' IS THIS TEXT *860807 BNE CHEK1401 NO SO OK * L R1,=A(HDR2INFO) ELSE GET ADVISORY V MVC 0(40,R1),=CL40'@=SBA,#=IC,$=SF,&&=RA (VALID IN SEND)' CHEK1401 CLC IN+8(4),=C'SAVE' ILLEGAL BNE CHEK9600 YES MVC IN+3(4),=C'SAVE' ALTER COMMMAND MVC IN+8(4),=C'TEXT' AND OPERAND MVC IN+37(22),=C'OPCODE/OPERAND SWAPPED' B CHEK9600 EXIT *** *** CHECK READ SCREW UP AND FIX IT *** CHEK1500 CLC IN+3(3),=C'READ' IF NOT READ THEN OK BNE CHEK1600 NO IT IS NOT CLC IN+8(4),=C'SAVE' ILLEGAL BNE CHEK9600 YES MVC IN+3(4),=C'SAVE' ALTER COMMMAND MVC IN+8(4),=C'READ' AND OPERAND MVC IN+37(22),=C'OPCODE/OPERAND SWAPPED' B CHEK9600 EXIT *** *** CHECK SPECIAL FUNCTION TO EXPAND AS A BIG MACRO *** CHEK1600 CLI IN+3,C'@' IS THIS NN @XXX __ _ ___ ___ BNE CHEK1700 NO IT IS NOT CLI IN,C'6' ARE WE INTO 70-7F RANGE YET BH CHEK1700 IF SO REJECT LA R1,CHEKLIST GET LIST CHEK1601 CLI 0(R1),X'FF' AT END BE CHEK1605 NOT FOUND SO ASSUME CLOBBER CLC IN+4(3),0(R1) HIS COMMAND:OUR TABLE (3 BYTES) BE CHEK1602 YES LA R1,8(R1) GET NEXT B CHEK1601 RETRY * 20(4,R13)=ORIGINAL R0=START OF THIS LINE IN MEMORY CHEK1602 L R14,20(R13) GET START OF WHERE TO ADD DATA L R1,4(R1) GET START OF WHERE TO FIND """ MVC IN+3(CHEKSIZE),0(R1) SINCE THIS ONCE IS RECOPIED CHEK1603 MVC 3(CHEKSIZE,R14),0(R1) COPY A LINE LA R14,80(R14) UP NEXT REAL USER PROGRAM AREA LA R1,CHEKSIZE(R1) UP NEXT SOURCE CODE CLI 0(R1),X'FF' AT END YET BNE CHEK1603 RETRY B CHEK9600 END CHEK1605 L R14,=A(HDR0) GET FORMATTER ) IF MACRO NOT MVC IN+2(78),2(R14) MOVE IT ) FOUND ASSUME B CHEK9600 PROCEED ) REFORMAT LINE *** *** END OF (1) SYNTAX, (2) DEFINE, (3) USE *** CHEK1700 CLC IN+3(4),=C'EXCP' IS THIS EXCP BE CHEK9400 TEST DDNAME CLC IN+3(3),=C'CCW' IS THIS CCW BE CHEK9400 TEST DDNAME *** *** PSPC EDIT TESTER *** CHEK1800 CLC IN+3(4),=C'PSPC' IS THIS PSPC BNE CHEK1900 SKIP CLC IN+8(7),=C'TEXTOUT' TEXT OUT? BE CHEK9500 YES CLC IN+8(4),=C'SEND' TEXT SEND? BE CHEK1810 YES CLC IN+8(6),=C'TEXTIN' TEXT IN? BNE CHEK1805 NO CLC IN+14(4),=C',TS=' HOW ABOUT OPERANDS BE CHEK9500 YES - ALL IS OK MVC IN+14(6),=C',TS=A ' BUILD SAMPLE B CHEK9500 SKIP CHEK1805 MVC IN+8(38),=C'TEXTIN TS=A/B/C:TEXTOUT:SEND,RU=A/B/C ' B CHEK9500 SKIP CHEK1810 CLC IN+12(4),=C',RU=' REASONABLE OPERAND BE CHEK1812 YES CHEK1811 MVC IN+8(14),=C'SEND,RU=A/B/C ' B CHEK9500 PROCEED CHEK1812 CLI IN+16,C'A' RANGE GOOD? BL CHEK1811 TOO LOW CLI IN+16,C'C' RANGE GOOD? BH CHEK1811 TOO HIGH B CHEK9500 SKIP *** *** FUTURE CHECKS *** CHEK1900 NOPR 0 FUTURES B CHEK9600 SKIP *** *** 9400 - WARN IF NODE IS *, NEEDS EXCP DDNAME *** CHEK9400 CLI DRVRNODE,C'*' IS THIS TO US BNE CHEK9600 NO SO OK L R1,=A(HDR2INFO) ELSE GET ADVISORY MVC 20(20,R1),=CL20'NODE TO BE DDNAME' B CHEK9600 EXIT *** *** 9500 - WARN IF NODE IS *, NEEDS SNA LUNAME *** CHEK9500 CLI DRVRNODE,C'*' IS THIS TO US BNE CHEK9600 NO SO OK L R1,=A(HDR2INFO) ELSE GET ADVISORY MVC 0(20,R1),=CL20'NODE TO BE SNA LU' B CHEK9600 EXIT *** *** *** CHEK9600 LTR R3,R3 IF R3=0 THEN ERRORS BNZ *+4+10 NOT ZERO SO NO ERRORS L R1,=A(HDR2INFO) ELSE GET ADVISORY MVC 40(20,R1),=CL20'*** EDIT ERRORS ***' RETURN (14,12),RC=0 EXIT LTORG , EJECT * ******************************************************************* * * * DIRECTORY AND LIST AND ACTUAL EDIT TIME MACROS * * * ******************************************************************* * SPACE CHEKLIST DC 0A(0),CL4'HELP',A(CL1) HELP HAS THIS LIST ) DIRECTORY DC CL4'DIR ',A(CL1) DIR ALIAS OF HELP ) OF THE DC CL4'? ',A(CL1) "?" ALIAS OF HELP ) AVAILABLE DC CL4'?__ ',A(CL1) "?" ALIAS OF HELP ) FUNCTIONS. DC CL4'CCW ',A(CL2) CCW HAS THIS LIST ) ONLY 3 OF DC CL4'READ',A(CL3) READ LOGIC ) 4 BYTES DC CL4'RTM ',A(CL4) RTM LOGIC ) ARE TESTED DC X'FF' END ) CHEKSIZE EQU 45 SIZE OF ENTRIES BELOW * CL1 DC CL45'** VALID @EXPAND MACROS FOR LINES 00-6F **' DC CL45'HELP (THIS ONE) DIR (AS FOR HELP.)' DC CL45'CCW (A CCW) READ (SEND+READ+EB)' DC CL45'RTM (RTM SEND/READ) ' DC X'FF' CL2 DC CL45'TEXT 0000,01 OPCODE ' DC CL45'TEXT 0001,000100 AREA IN TEXT BUFFER' DC CL45'TEXT 0004,2000 SILI AND NULL ' DC CL45'TEXT 0006,0020 32 BYTE SIZE ' DC X'FF' CL3 DC CL45'SEND BB Y OIC DR1 F6 SEND READ COMMAND ' DC CL45'READ READ ANSWER ' DC CL45'SEND EB * OIC DR1 F182 EB AND RELEASE ' DC X'FF' CL4 DC C'TEXT 0000,0035 VV ' DC C'TEXT 0002,41038D0000000010002B80800A040100 ' DC C'TEXT 0012,00000000000204920000199400000000 <<' DC C'TEXT 0022,00000100000000000000040001000200 ' DC C'TEXT 0032,030004 ' DC C'RTM TEXT,%I%J%K 810810,41038D ' DC C'RQMS READ <-- COPY THIS LINE NUMBER TO ---+' DC C'SHOW *** TIME OUT *** TYPE STOP TO HALT *** ?' DC C'INPT ELSE WE PROCEED ?' DC C'TEST A(XX),+0=0,EQ,XX LOOP IF 00 XX <----+' DC X'FF' * * * * DC 80X'FF' END IT ALL TITLE '*** BASIC SUBROUTINE THAT DOES CALL ***' * ******************************************************************* * * * NCAL * BASIC MODEL FOR A SUBROUTINE THAT DOES CALL * * * ******************************************************************* * SPACE CALLCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED LA R8,SAVEAREA R8 BUT ALTER TO DROP R13 A NEW USING SAVEAREA,R8 REGISTER LA R0,200 GET A GETMAIN R,LV=(0) SAVE AREA ST R13,4(1) SAVE OLD R13 IN NSAVE+4 ST R1,8(R13) SAVE NEW R13 IN OSAVE+8 LR R13,R1 R13 GET NEW SAVE ***=================================================================*** * CODE GOES HERE ***=================================================================*** CALLRC00 LA R0,200 SIZE LR R1,R13 CORE TO FREE L R13,4(R13) GET LAST FREEMAIN R,LV=(0),A=(1) FREE SAVE AREA RETURN (14,12),RC=0 EXIT LTORG , TITLE '*** BASIC SUBROUTINE THAT DOES NO CALLS ***' * ******************************************************************* * * * NCAL * BASIC MODEL FOR A SUBROUTINE THAT DOES NO CALLS * * * ******************************************************************* * SPACE NCALCSCT CSECT , *** ENTER HERE *** USING *,R12 R12 WILL BE A BASE SOON SAVE (14,12) SAVE REGS (R1 EXTN IS SAVED) LR R12,R15 AND NOW R12 IS THE BASE USING LUSRAREA,R9 PREDEFINED USING SAVEAREA,R13 PREDEFINED ***=================================================================*** * CODE GOES HERE ***=================================================================*** NCALRC00 RETURN (14,12),RC=0 EXIT NCALRC04 RETURN (14,12),RC=4 EXIT NCALRC08 RETURN (14,12),RC=8 EXIT LTORG , END