SYN TITLE 'DMSSYN (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00006000 * 00007000 * 00008000 * 00009000 * 00010000 * MODULE NAME: 00011000 * 00012000 * DMSSYN (SYNONYM) 00013000 * 00014000 * FUNCTION: 00015000 * 00016000 * PROGRAM TO SET UP USER DEFINED COMMAND NAMES AND 00017000 * ABBREVIATIONS FOR CMS COMMANDS. 00018000 * 00019000 * ATTRIBUTES: 00020000 * 00021000 * TRANSIENT (WITH SYSTEM OPTION); SERIALLY REUSABLE. 00022100 * 00023000 * ENTRY POINTS: 00024000 * 00025000 * SYNONYM-WHEN USER ISSUES SYNONYM COMMAND 00026000 * 00027000 * ENTRY CONDITIONS: 00028000 * 00029000 * R15 ADDRESSABILITY 00030000 * R1 PLIST 00031000 * 00032000 * PLIST - 00033000 * CL8'SYNONYM' 00034000 * 00035000 * 00036000 * 00037000 * 00038000 * OPTIONS: 00039000 * 00043000 * XL8'FENCE' 00044000 * 00045000 * 00046000 * EXIT CONDITIONS: 00047000 * 00048000 * NORMAL 00049000 * 00050000 * GPR15 = 0 00051000 * 00052000 * RESPONSES MAY BE: 00053000 * 00054100 * 711I SYSTEM SYNONYMS NOT IN EFFECT 00055100 * A REQUEST HAS BEEN MADE TO PRINT THE SYSTEM 00056100 * ABBREVIATIONS WHILE A PREVIOUS NOSTD IS IN EFFECT 00057100 * 00058100 * 00059100 * 712I NO SYNONYMS (DMSINA NOT IN NUCLEUS) 00060000 * 00061000 * 00062000 * ERROR CODES (WITH MESSAGES) 00063000 * 00064000 * 00065000 * 24 INVALID OPTION 00066000 * 28 FILE NOT FOUND 00067000 * 32 FILE NOT FIXED 80 CHARS, OR INVALID FORMAT 00068000 * 100 DISK READ ERROR 00069000 * 00070000 * 00071000 * 00072000 * 00073000 * EXTERNAL REFERENCES: 00074000 * 00075000 * DMSNUC, DMSINA 00076000 * 00077000 * TABLES/WORKAREAS: 00078000 * 00079000 * FREE STORAGE IS OBTAINED FOR USER SPECIFIED COMMAND 00080000 * NAMES. 00081000 * 00082000 * REGISTER USAGE: 00083000 * 00084000 * R11 ABDSECT 00085000 * R12 BASE 00086000 * R0-8, 10, 12, 14-15 WORK 00087000 * 00088000 * CALLS TO OTHER ROUTINES: 00089000 * 00090000 * DMSFRE, DMSSTT, DMSRDB, DMSFNS, DMSCWR 00091000 * 00092000 * OPERATION: 00093000 * 00094000 * SYNONYM CHECKS IF THERE ARE ANY PARAMETERS OR OPTIONS, 00095100 * IF NONE AND THE NOABBREV FLAG IN THE NUCLEUS IS NOT ON SYSTEM 00096100 * ABBREVIATIONS ARE TYPED; IF ANY USER SYNONYMS, THOSE ARE 00097100 * TYPED ALSO. IF A FILE NAME IS GIVEN IT IS SAVED AND FLAGS 00098100 * ARE SET FOR ANY OPTIONS. IF GIVEN, THE FILEID SPECIFIED IS 00099000 * CHECKED (VIA STATE) FOR A FIXED 80 CHARACTER 00100000 * FORMAT. THE STORAGE FOR AN OLD USERS SYNONYM TABLE IS RELEASED 00101000 * IF ANY, AND STORAGE IS OBTAINED (VIA DMSFRE) FOR THE USER 00102000 * COMMAND NAMES. EACH USER SYNONYM IS READ (DMSBRD) AND THE 00103000 * RECORD IS FORMATTED (VIA A COPY OF SCAN) FOR EASE IN HAND- 00104000 * LING. THEN EACH COMMAND NAME, SYNONYM AND COUNT IS MOVED TO 00105000 * THE FREE STORAGE BLOCK. AT END-OF-FILE THE FILE IS CLOSED 00106000 * (FINIS) AND A POINTER TO THE FREE STORAGE BLOCK IS SET 00107000 * IN DMSINA. NEXT THE OPTIONS ARE HANDLED AS FOLLOWS: 00108000 * CLEAR - RELEASE (DMSFRE) THE OLD USER SYNOMYM TABLE, IF ANY 00109000 * NOTE: THIS HAS NO EFFECT IF A FILEID IS 00109200 * SPECIFIED SINCE THE OLD TABLE IS ALWAYS 00109400 * ERASED BEFORE THE NEW ONE IS BUILT 00109600 * STD - CLEAR NOABBREV FLAG IN NUCON 00110000 * NOSTD - SET NOABBREV FLAB IN NUCON 00111000 * 00112000 * FINALLY RETURN TO CALLER WITH RETURN CODE IN REGISTER 15. 00113000 * 00114000 * 00115000 * NOTES: 00116000 * 00117000 * USER-DEFINED SYNONYMS ARE LOCATED IN A FILE 00118000 * IDENTIFIED AS "FILENAME FILETYPE FILEMODE" IN THE 00119000 * FORMAT SHOWN. IF FILETYPE IS OMITTED, A FILETYPE OF 00120000 * SYNONYM IS ASSUMED; IF FILEMODE IS OMITTED, A MODE 00121000 * OF A1 IS ASSUMED. IF NO FILE IS SPECIFIED, NO 00122000 * USER-DEFINED SYNONYMS ARE SET UP, AND THE SYSTEM 00123000 * ABBREVIATIONS ARE USED IN THE MANNER DEFINED BY THE 00124000 * SPECIFIED OPTIONS. 00125000 * 00126000 * THE USER SYNONYM FILE "FILENAME FILETYPE FILEMODE" 00127000 * CONSISTS OF 80-BYTE FIXED-LENGTH RECORDS IN FREEFORM 00128000 * FORMAT WITH COLUMNS 73 TO 80 IGNORED. THE FORMAT FOR 00129000 * EACH RECORD IS: 00130000 * 00131000 * ----------------------------------------- 00132000 * | | | | 00133000 * | SYSTEM-COMMAND | USER-SYNONYM | COUNT | 00134000 * | | | | 00135000 * ----------------------------------------- 00136000 * 00137000 * WHERE COUNT IS THE NUMBER OF CHARACTERS NECESSARY FOR 00138000 * THE SYNONYM TO BE ACCEPTED. IF OMITTED, THE ENTIRE 00139000 * SYNONYM MUST BE ENTERED. SYNONYM BUILDS A TABLE FROM THE 00140000 * CONTENTS OF THIS FILE TO USE FOR COMMAND SYNONYMS. 00141000 * 00142000 * IF FILEID AND THE OPTION CLEAR ARE BOTH SPECIFIED THE 00143100 * USER SYNONYM TABLE WILL BE CREATED AND NOT CLEARED. 00144100 * 00145100 * 'SYNONYM' (WITH NO ADDITIONAL PARAMETERS) ASKS FOR 00146100 * ON-LINE LISTING OF SYSTEM SHORT-FORM ABBREVIATIONS 00147100 * (IF IN EFFECT), AND USER SYNONYMS (IF ANY). 00148100 * 00149100 * 00151000 * SEE CMS DMSINA ROUTINE FOR FURTHER INFORMATION. 00152000 *. 00153100 EJECT 00155000 SYNONYM START X'E000' (WILL BE TRANSIENT DISK-RESIDENT) 00156000 * 00157000 USING *,R12 ADDRESSABILITY 00158000 USING NUCON,R0 00159000 LR R12,R15 00160000 ST R14,SAVE14 SO YOU CAN GO HOME @VA02569 00160200 SR R15,R15 HANDY NUMBER ZERO @VA02569 00160400 STH R15,OURFLAG CLEAR THE FLAG @VA02569 00160600 ST R15,ERRCODE SET GOOD UNTIL PROVEN BAD @VA02569 00160800 L R11,AUSABRV WITHIN 'ABBREV' ROUTINE. 00161000 LTR R11,R11 MAKE SURE IT'S THERE, 00162000 BZ NOABB ERROR IF NOT. 00163000 USING ABDSECT,R11 REFERENCE EASILY 00164000 CLI 8(R1),X'FF' ANY PARAMETERS AT ALL ? 00165000 BE SHOWSYS IF NOT, JUST WANTS A LIST OF @V305032 00166200 * ABBREVIATIONS / SYNONYMS NOW IN EFFECT. 00166300 MVC STYPE(11),=CL11'SYNONYM A1' INITIALIZE STATE LIST P3070 00171000 CLI 8(R1),C'(' LEFT-PAREN OR FILE-NAME ? 00172000 BE SYN02 BE IF LEFT-PAREN. 00173000 MVC SNAME,8(R1) MUST BE FILENAME, SAVE IT. 00174000 OI OURFLAG+1,NAMEG SIGNAL THAT NAME WAS GIVEN 00175000 LA R1,8(,R1) NEXT PARAMETER, 00176000 CLI 8(R1),X'FF' END OF CALLER'S PARAMETER-LIST ? 00177000 BE SYN08 YES 00178000 CLI 8(R1),C'(' LEFT-PAREN OR FILE-TYPE ? 00179000 BE SYN02 BE IF LEFT-PAREN. 00180000 CLC 8(8,R1),=CL8'SYNONYM' IS TYPE SYNONYM 00181000 BNE ERR1 NO 00182000 MVC STYPE,8(R1) MUST BE FILETYPE, SAVE IT 00183000 LA R1,8(,R1) NEXT PARAMETER, 00184000 CLI 8(R1),X'FF' END OF CALLER'S PARAMETER-LIST ? 00185000 BE SYN08 YES 00186000 CLI 8(R1),C'(' LEFT-PAREN OR FILE-MODE ? 00187000 BE SYN02 BE IF LEFT-PAREN. 00188000 MVC SMODE,8(R1) MUST BE FILE-MODE, SAVE IT 00189000 LA R1,8(,R1) NEXT PARAMETER, 00190000 CLI 8(R1),X'FF' END OF CALLER'S PARAMETER-LIST ? 00191000 BE SYN08 YES 00192000 CLI 8(R1),C'(' BETTER BE LEFT-PAREN THEN. 00193000 BE SYN02 START OF OPTIONS P0684 00194000 LA R1,8(,R1) POINT TO BAD GUY P0684 00195000 B PLISTER GO TELL THE USER P0684 00196000 * LEFT-PAREN ENCOUNTERED... 00197000 SYN02 LA R4,8 SET UP INCREMENTER AND 00198000 LA R5,LASTOP LIMIT FOR BXLE LOOP BELOW 00199000 CLI 9(R1),C' ' BLANK IMMEDIATELY AFTER LEFT-PAREN ? 00200000 BE SYN03 BE IF YES, 1ST OPTION IN NEXT DBL-WORD 00201000 LA R1,9(,R1) SET UP FOR FIRST OPTION 00202000 LA R2,7 IN VERY NEXT BYTE. 00203000 B SYN05 ... 00204000 SYN03 LA R1,16(,R1) SET TO CHECK 1ST OPTION IN NEXT DBL-WORD 00205000 * 00206000 SYN04 LA R2,8 INCREMENTER = 8. 00207000 * 00208000 SYN05 LA R3,FIRSTOP SET FOR EXAMINING OPTIONS 00209000 SYN06 CLC 0(6,R1),0(R3) DOES IT MATCH ONE OF OUR OPTIONS ? 00210000 BE OPFOUND BE IF YES. 00211000 BXLE R3,R4,SYN06 ITERATE THRU OPTION-TABLE. 00212000 PLISTER DS 0H ERROR IN CALLER'S PARAMETER-LIST 00213000 LR R2,R1 CAUSE DMSERR DESTROYS IT.. 00214000 DMSERR NUM=3,LET=E,TEXT='INVALID OPTION ''........''', X00215100 SUB=(CHARA,(2)) 00216000 LA R15,24 MAKE THAT ERROR 24 00217000 B LR14 BACK TO CALLER. 00218000 * 00219000 OPFOUND OC OURFLAG(2),6(R3) 'OR' IN FLAG-BIT (OR BITS) 00220000 TM OURFLAG+1,EPLIST END OF P-LIST ? 00221000 BO SYN07 BO IF YES (NO MORE OPTIONS) 00222000 AR R1,R2 BUMP R1 FOR NEXT OPTION 00223000 B SYN04 AND CONTINUE CHECKING. 00224000 * 00225000 SYN07 TM OURFLAG,STD+NOSTD CHECKING FOR CONFLICTING OPTIONS 00226000 BNO SYN08 ERROR IF BOTH SET 00227000 * 00228000 B ERR066E PUT OUT ERROR MESSAGE @VA02969 00229100 * NO MORE PARAMETERS ... 00231000 SYN08 TM OURFLAG+1,NAMEG WAS NAME GIVEN ? 00232000 BZ SYN13 BZ IF NOT, MUST BE OPTIONS ONLY. 00233000 LA R1,SLIST STATE USER SYN FILE 00234000 L R15,ASTATE STATE @V305066 00235100 BALR R14,R15 ... @V305066 00235600 BNZ NOTFND ERROR IF NOT FOUND @V305066 00236100 LA R1,SNAME SET UP PRETTY FILEID P0685 00237000 BAL R0,SETUP P0685 00238000 L R2,AFST ACCESS FST-ENTRY (IN 'STATEFST') 00239000 CLI 30(R2),C'F' MUST BE FIXED-FILE 00240000 BNE BADUSYN WHOOPS. 00241000 CLC =H'80',34(R2) AND 80-BYTE RECORDS. 00242000 BNE BADUSYN ... 00243000 CH R15,26(,R2) AND > 0 ITEMS IN THE FILE 00244000 BE NOTFND TREAT NULL FILE SAME AS NOT FOUND 00245000 MVC RNAME(16),0(R2) LOOKS OK, SET UP NAME & TYPE 00246000 MVC RMODE,24(R2) ALSO MODE 00247000 LM R0,R1,USABRV ANY OLD-ONES TO GIVE BACK ? 00249000 LTR R1,R1 ... 00250000 BZ SYN10 BZ IF NOT. 00251000 DMSFRET DWORDS=(0),LOC=(1) 00252000 SYN10 LH R3,26(,R2) GET NUMBER OF ITEMS IN THE FILE 00253000 MH R3,=H'17' TIMES 17 BYTES PER ITEM 00254000 LA R0,7(,R3) ADD 7 FOR ROUNDING, 00255000 SRA R0,3 INTO DOUBLE-WORDS WE MUST GO 00256000 DMSFREE DWORDS=(0),TYPE=NUCLEUS GET STORAGE 00257000 STM R0,R1,SAVABR SAVE LOC AND AMOUNT 00258000 MVC USABRV(8),SAVABR MOVE TO LOW STORAGE @V305032 00259100 SH R3,=H'17' POINT TO LAST ITEM 00260000 A R3,SAVABR+4 NOW WE HAVE THE ADDRESS 00261000 ST R3,USABRV+12 STORE WHERE NEEDED. @V305032 00262100 L R2,SAVABR+4 R2 POINTS TO BEGINNING OF FREE STOR 00263000 * NOW READ USER-SYNONYM FILE AND PROCESS IT ... 00264000 SYN11 LA R1,RLIST READ A RECORD 00265000 L R15,ARDBUF ... @V305032 00266100 BALR R14,R15 ... @V305032 00266600 BNZ CHK12 ERROR SHOULD BE END OF FILE @V305032 00267100 LA R1,FORSCAN CALL COPY OF 'SCAN' WHICH MUST BE 00268000 LA R15,SCAN INCLUDED WITH THIS PROGRAM AND LET 00269000 BALR R14,R15 'SCAN' DO ALL THE WORK (WHY NOT ?) 00270000 CLI 0(R1),X'FF' MAKE SURE CMS-NAME REALLY THERE 00271000 BE BADATA ERROR IF NOT 00272000 CLI 8(R1),X'FF' DITTO FOR USER-SYNONYM ... 00273000 BE BADATA ERROR IF NOT 00274000 * COMPUTE NUMBER OF BYTES IN USER-SYNONYM ... 00275000 LA R4,7 START WITH 7, 00276000 LA R3,8(R1,R4) START WITH 8TH CHARACTER 00277000 BLOOP CLI 0(R3),C' ' IS 'LAST' CHARACTER BLANK ? 00278000 BNE CNTFND BNE IF NOT, WE'VE GOT R4. 00279000 BCTR R3,0 DECREMENT R3 FOR NEXT TIME 00280000 BCT R4,BLOOP ITERATE DOWN TO 1 CHARACTER 00281000 CNTFND LA R4,1(,R4) R4 NOW HOLDS ACTUAL BYTE-COUNT. 00282000 CLI 16(R1),C'1' CHECK 'COUNT' (IF THERE) IN USER-SYN 00284000 BL USER4 IF NOT GOOD, USE R4 VALUE. 00285000 CLI 16(R1),C'8' CHECK AGAIN ... 00286000 BH USER4 IF NOT GOOD, USE R4 VALUE. 00287000 SR R3,R3 OBTAIN THE 00288000 IC R3,16(,R1) COUNT WHICH WAS GIVEN, 00289000 SH R3,=X'00F0' BINARY PLEASE, FROM ALPHAMERIC 00290000 STC R3,16(,R2) STORE COUNT (TENTATIVELY) 00291000 CR R3,R4 COMPARE WITH ACTUAL COUNT 00292000 BNH SYN12 OK IF NOT 'TOO LARGE' 00293000 USER4 STC R4,16(,R2) USE ACTUAL COUNT IF NECESSARY 00294000 SYN12 MVC 0(16,R2),0(R1) MOVE CMS-NAME & USER-SYN THERE TOO 00295000 LA R2,17(,R2) INCREMENT FOR NEXT 17-BYTE CHUNK 00296000 B SYN11 AND KEEP READING USER SYN FILE. 00298000 * 00299000 CHK12 C R15,=F'12' READ ERROR IS HOPEFULLY EOF. 00300000 BE CLOSIT YES (OK SO FAR) 00301000 LA R1,100 ERROR CODE 00302000 ST R1,ERRCODE SAVE ERROR-CODE TO SHOW ON RETURN 00303000 DMSERR NUM=104,LET=S,TEXT='ERROR ''...'' READING FILE ''.......00304000 .............'' FROM DISK', P0685X00305000 SUB=(HEX,(15),CHAR8A,NNAME), P0685X00306000 RENT=NO P0685 00307000 BADSHOW LM R0,R1,USABRV GIVE BACK THE FREE STORAGE 00308000 DMSFRET DWORDS=(0),LOC=(1) GIVE BACK STORAGE 00309000 XC USABRV(8),USABRV CLEAR THE POINTERS @V305032 00310100 CLOSIT LA R1,RLIST NOW CLOSE THE FILE @V305032 00311100 L R15,AFINIS VIA 'FINIS' @V305032 00312100 BALR R14,R15 ... @V305032 00313100 L R15,ERRCODE CHECK ERROR-CODE 00315000 LTR R15,R15 ... 00316000 BZ SYN14 HOPEFULLY WE'RE OK. 00317000 LR14 L R14,SAVE14 IF NOT QUIT 00318000 BR R14 (IN DISGUST). 00319000 * 00320000 * IF NO FILE-NAME GIVEN, CHECK FOR 'CLEAR' OPTION ... 00321000 SYN13 TM OURFLAG,CLEAR IS 'CLEAR' WANTED ? 00322000 BZ SYN14 BZ IF NOT. 00323000 CLEARUSR LM R0,R1,USABRV SIZE/ADR OF OLD TAB (IF ANY) @VA02569 00324100 LTR R1,R1 ANYTHING THERE ? 00325000 BZ SYN14 BZ IF NOT. 00326000 DMSFRET DWORDS=(0),LOC=(1) GIVE BACK OLD TABLE 00327000 XC USABRV(8),USABRV ZERO OUT POINTERS @V305032 00328100 * 00329000 SYN14 TM OURFLAG,STD CLEAN UP NOW... 00330000 BZ SYN15 STD FLAG SET ? (BZ IF NOT) 00331000 SYN14A NI OPTFLAGS,255-NOSTDSYN CLEAR 'NOSYN'BIT IF STD @V305032 00332110 B SYN16 00333000 SYN15 TM OURFLAG,NOSTD NOSTD FLAG SET ? 00334000 BO SYN15A YES @VA02969 00335100 OI OURFLAG,STD DEFAULT TO STD @VA02969 00335300 B SYN14A SET STD @VA02969 00335500 SYN15A OI OPTFLAGS,NOSTDSYN SET FOR NO SYSTEM-ABBREVIATIO @V305032 00335710 SYN16 L R14,SAVE14 RESTORE R14 00337000 BR R14 AND RETURN TO CALLER. @V305032 00338000 * 00339000 OURFLAG DC H'00' FLAG FOR OUR USE 00340000 ERRCODE DC F'0' ERROR-CODE SAVED HERE 00341000 * 00342000 DS 0D (MIGHT AS WELL FOR BEST PERFORMANCE) 00343000 * TABLE FOR VARIOUS OPTIONS ... 00344000 * MIN AND EXACT OPTIONS ARE REMOVED.. 00345000 FIRSTOP DC 6X'FF',X'00',AL1(EPLIST) 00346000 DC CL6')',X'00',AL1(EPLIST) 00347000 DC CL6'STD',AL1(STD),AL1(0) 00348000 DC CL6'NOSTD',AL1(NOSTD),AL1(0) 00349000 DC CL6'CLEAR',AL1(CLEAR),AL1(0) 00350000 LASTOP EQU *-8 00352000 * 00353000 * BITS OF OURFLAG ... 00354000 PRINT EQU X'80' 'P' WAS SPECIFIED 00355000 STD EQU X'40' 'STD' WAS SPECIFIED 00356000 NOSTD EQU X'20' 'NOSTD' WAS SPECIFIED 00357000 MIN EQU X'10' 'MIN' WAS SPECIFIED 00358000 XACT EQU X'08' 'EXACT' WAS SPECIFIED 00359000 CLEAR EQU X'04' 'CLEAR' WAS SPECIFIED 00360000 PUSER EQU X'02' 'PUSER' WAS SPECIFIED 00361000 * (ROOM FOR ONE MORE OPTION HERE) 00362000 EPLIST EQU X'80' END OF OPTIONS THRU X'FF' OR RIGHT-PAREN 00363000 NAMEG EQU X'40' SIGNALS FILE-NAME WAS GIVEN 00364000 * 00365000 BADATA DS 0H ERROR IN USER SYN DATA 00366000 DMSERR TEXT='FILE ''....................'' CONTAINS X00367000 INVALID RECORD FORMATS',SUB=(CHAR8A,SNAME), X00368100 LET=E,NUM=56 P0685 00369000 MVC ERRCODE(4),=F'32' RETURN CODE OF 32 P0685 00370000 B BADSHOW GO GIVE BACK FREE STORAGE ETC. 00371000 * 00372000 NOTFND DS 0H USER SYN FILE NOT FOUND (OR NULL) 00373000 C R15,=F'28' WAS RESULT FILE NOT FOUND? P0685 00374000 BNE LR14 NO,THEN MSG ALL READY GIVEN P0685 00375000 DMSERR NUM=2,LET=E,TEXT='FILE ''....................'' NOT FOUN00376000 ND.',SUB=(CHAR8A,SNAME) P0685 00377000 LA R15,28 MAKE THAT ERROR 28 00378000 B LR14 GO EXIT. 00379000 * 00380000 BADUSYN DS 0H WRONG FORMAT OF USER SYN FILE 00381000 DMSERR NUM=7,LET=E,TEXT='FILE ''....................'' NOT FIXE00382000 ED,80 CHAR RECORDS.',SUB=(CHAR8A,NNAME) P0685 00383000 LA R15,32 RETURN CODE = 32 P0683 00384000 B LR14 GO EXIT. 00385000 ERR066E LA R2,=CL8'STD' STD IS ONE ERROR @VA02969 00385100 LA R3,=CL8'NOSTD' NOSTD IS ANOTHER ERROR @VA02969 00385200 DMSERR TEXT='''........'' AND ''........'' ARE CONFLICTING OPTX00385300 IONS',LET=E,NUM=66,SUB=(CHARA,(R2),CHARA,(R3)),RENT=NO 00385400 LA R15,24 SET RETURN CODE @VA02969 00385500 B LR14 EXIT @VA02969 00385600 EJECT 00386000 * COMES HERE TO TYPE OUT SYSTEM SHORT-FORM ABBREVIATIONS 00387000 SHOWSYS SSM =X'81' PERMIT TERMINAL INTERRUPTS; @V305032 00387500 LA R1,TYPCAR CARRIAGE-RETURN FIRST @V305032 00388000 SVC X'CA' @V305032 00388500 TM OPTFLAGS,NOSTDSYN ARE ABBREVS FLAGGED 'OFF'? @V305032 00389000 BZ OKPS BZ IF NOT, OK TO PRINT SYS ABB'S.@V305032 00389500 DMSERR NUM=711,LET=I,TEXT='NO SYSTEM SYNONYMS IN EFFECT' 00390000 * (NOTE -- NOT AN 'ERROR') 00390500 B CRAFTER @V305032 00391000 OKPS LA R1,TFIRST PRELIMINARY HEADER ... @V305032 00391500 SVC X'CA' ... @V305032 00392000 LA R1,TFIRST1 ... @V305032 00392500 SVC X'CA' ... @V305032 00393000 LA R1,TFIRST2 ... @V305032 00393500 SVC X'CA' ... @V305032 00394000 LA R1,TAFTER SET UP R1 FOR TYPEOUTS @V305032 00394500 SR R2,R2 CLEAR R2 (FOR 'IC' BELOW) @V305032 00395000 LM R3,R5,REGTABA PREPARE TO ACCESS SYS ABBREVS @V305032 00395500 * 00396000 SYSLOOP MVC SYSABB,BLANKS BLANK OUT ABBREVIATION @V305032 00396500 MVC SYSCOM(8),0(R3) MOVE IN SYSTEM COMMAND @V305032 00397000 IC R2,8(,R3) GET COUNT OF SHORTEST @V305032 00397500 BCTR R2,0 FORM (LESS 1) @V305032 00398000 EX R2,DMVC MOVE SHORTEST-FORM TO TYPEOUT, @V305032 00398500 SVC X'CA' CALL TYPLIN (DELS TERM'L BLANKS) @V305032 00399000 BXLE R3,R4,SYSLOOP ITERATE FOR ALL SYSTEM COMMANDS @V305032 00399500 CRAFTER LA R1,TYPCAR CARRIAGE-RETURN AFTERWARDS @V305032 00400000 SVC X'CA' ... @V305032 00400500 * 00401000 * 00401500 * COMES HERE TO TYPE OUT USER SYNONYMS (IF ANY) 00402000 SR R15,R15 CLEAR R15 (WILL BE ERROR-CODE) @V305032 00402500 LM R3,R5,USABRV+4 PREPARE TO ACCESS USER SYNONYMS @V305032 00403000 LTR R3,R3 (IF ANY) @V305032 00403500 BZ SYN17 EXIT (NOT AN ERROR) IF NONE. @V305032 00404000 LA R1,TSECOND PRELIMINARY HEADER FOR USER SYN'S@V305032 00404500 SVC X'CA' ... @V305032 00405000 LA R1,TSECOND1 ... @V305032 00405500 SVC X'CA' ... @V305032 00406000 LA R1,TSECOND2 ... @V305032 00406500 SVC X'CA' ... @V305032 00407000 LA R1,TAFTER2 SET UP R1 FOR TYPEOUTS @V305032 00407500 SR R2,R2 (FOR 'IC' BELOW) @V305032 00408000 * 00408500 USRLOOP MVC USERABB2,BLANKS BLANK OUT ABBREV (IF ANY) @V305032 00409000 MVC SYSCOM2(8),0(R3) MOVE IN SYSTEM-COMMAND, @V305032 00409500 MVC USERSYN2(8),8(R3) USER SYNONYM, @V305032 00410000 CLI 16(R3),00 DOES 'SHORT FORM' OF USER-SYN @V305032 00410500 BE NOSHRT EXIST ? @V305032 00411000 CLI 16(R3),07 ONLY YES I NUMBER FROM 1 TO 7 @V305032 00411500 BH NOSHRT ... @V305032 00412000 IC R2,16(,R3) LOOK AT (N+1)TH BYTE OF @V305032 00412500 LA R6,8(R3,R2) USER-SYNONYM @V305032 00413000 CLI 0(R6),C' ' IS IT BLANK ? @V305032 00413500 BE NOSHRT IF YES, IT CAN'T BE A SHORT-FORM @V305032 00414000 BCTR R2,0 IF NON-BLANK, MOVE IN SHORT-FORM @V305032 00414500 EX R2,DMVC2 OF USER-SYNONYM. @V305032 00415000 NOSHRT SVC X'CA' CALL TYPLIN (DELS TERM'L BLANKS) @V305032 00415500 BXLE R3,R4,USRLOOP ITERATE FOR ALL USER ABBREVS @V305032 00416000 LA R1,TYPCAR CARRIAGE-RETURN AFTERWARDS @V305032 00416500 SVC X'CA' ... @V305032 00417000 SYN17 SSM =X'00' REVERT TO USUAL SYSTEM MASK, @V305032 00417500 B SYN16 GO RETN TO CALLER (R15 ALREADY 0)@V305032 00418000 SPACE 3 00418500 NOABB DS 0H NO ABBREVIATIONS AT ALL... @V305032 00449000 DMSERR TEXT='NO SYNONYMS (DMSINA NOT IN NUCLEUS)',LET=I, X00450000 NUM=712 @V305032 00451000 LA R15,0 @V305032 00452000 BR R14 AND EXIT. @V305032 00453000 ERR1 LA R0,8(R1) POINT TO FILETYPE @V305032 00454000 DMSERR NUM=32,LET=E,TEXT='INVALID FILETYPE ''........''',SUB=(R00455000 CHARA,(0)) @V305032 00456000 LA R15,24 RETURN CODE @V305032 00457000 B LR14 AND RETURN @V305032 00458000 EJECT 00459000 DS 0F @V305032 00459500 TYPCAR DC CL8'TYPLIN' TO TYPE A CARRIAGE-RETURN @V305032 00460500 DC AL1(1),AL3(ONEBLNK) ... @V305032 00461500 DC C'B',AL3(1) ... @V305032 00462500 DS 0F @V305032 00463500 TFIRST DC CL8'TYPLIN',AL1(1),AL3(FIRST),C'B',AL3(L'FIRST) @V305032 00464500 TFIRST1 DC CL8'TYPLIN',AL1(1),AL3(FIRST1),C'B',AL3(L'FIRST1) 00465500 TFIRST2 DC CL8'TYPLIN',AL1(1),AL3(FIRST2),C'B',AL3(L'FIRST2) 00466500 * 00467500 TSECOND DC CL8'TYPLIN',AL1(1),AL3(SECOND),C'B',AL3(L'SECOND) 00468500 TSECOND1 DC CL8'TYPLIN',AL1(1),AL3(SECOND1),C'B',AL3(L'SECOND1) 00469500 TSECOND2 DC CL8'TYPLIN',AL1(1),AL3(SECOND2),C'B',AL3(L'SECOND2) 00470500 * 00471500 TAFTER DC CL8'TYPLIN' THEREAFTER @V305032 00472500 DC AL1(1),AL3(SYSCOM) @V305032 00473500 DC C'B',AL3(BLANKS-SYSCOM) @V305032 00474500 * 00475500 FIRST DC C'SYSTEM SHORTEST' @V305032 00476500 FIRST1 DC C'COMMAND FORM' @V305032 00477500 FIRST2 DC C'-------- --' @V305032 00478500 SYSCOM DC CL10' ' E.G. 'ACCESS' GOES HERE @V305032 00479500 SYSABB DC CL8' ' E.G. 'AC' GOES HERE @V305032 00480500 BLANKS DC CL8' ' (FOR INITIALIZING SYSABB ETC.) @V305032 00481500 * 00482500 DMVC MVC SYSABB(*-*),0(R3) (MOVES CORRECT NO. BYTES) @V305032 00483500 SPACE 3 00485000 SAVE14 DC F'0' (R14 SAVED HERE IF NECESSARY) @V305032 00486000 SAVABR DS 2F SAVE COUNT AND ADDRESS @V305032 00487000 SPACE 3 00488000 DS 0F @V305032 00488500 TAFTER2 DC CL8'TYPLIN' @V305032 00489500 DC AL1(1),AL3(SYSCOM2) @V305032 00490500 DC C'B',AL3(EUSERT-SYSCOM2) @V305032 00491500 * 00492500 SECOND DC C'SYSTEM USER SHORTEST' @V305032 00493500 SECOND1 DC C'COMMAND SYNONYM FORM (IF ANY)' @V305032 00494500 SECOND2 DC C'-------- -------- ----' @V305032 00495500 SYSCOM2 DC CL9' ' E.G. 'ERASE' GOES HERE @V305032 00496500 USERSYN2 DC CL9' ' E.G. 'DELETE' GOES HERE @V305032 00497500 USERABB2 DC CL8' ' E.G. 'DELET' GOES HERE @V305032 00498500 EUSERT EQU * (END OF THIS TYPEOUT) @V305032 00499500 * 00500500 ONEBLNK DC C' ' (TO TYPE ONE CARRIAGE-RETURN) @V305032 00501500 * 00502500 DMVC2 MVC USERABB2(*-*),8(R3) MOVE SHORT-FORM OF USER-SYN @V305032 00503500 * 00504500 DS 0F @V305032 00505500 SLIST DC CL8'STATE' STATE-PARAMETER-LIST 00507000 SNAME DC CL8'USER' FILENAME 00508000 STYPE DC CL8'SYN' FILETYPE 00509000 SMODE DC CL2'*' FILE-MODE 00510000 DC CL2' ' (UNUSED) 00511000 AFST DC A(*-*) ADDRESS OF 'STATEFST' 00512000 * 00513000 DS 0F FOR 'RDBUF' & 'FINIS' .. 00514000 RLIST DC CL8'RDBUF' ('FINIS' GOES HERE LATER) 00515000 RNAME DC CL8'USER' FILENAME 00516000 RTYPE DC CL8'SYNONYM' FILETYPE @V305032 00517000 RMODE DC CL2'A1' MODE @V305032 00518000 DC H'0' 'ITEM NUMBER' 00519000 DC A(INBUF) INPUT-BUFFER 00520000 DC F'80' 80 BYTES 00521000 DC CL2'F' FIXED MODE 00522000 DC H'1' ONE ITEM AT A TIME 00523000 DC A(*-*) SHOULD BE 80 BYTES READ 00524000 LTORG 00525000 * 00526000 * KEEP THE FOLLOWING TWO IN ORDER (FOR 'SCAN') .. 00527000 FORSCAN DC F'72' 00528000 INBUF DC CL80' ' RECORDS FOR 'USER SYN' READ IN HERE 00529000 NNAME EQU INBUF P0683 00530000 * 00531000 * PREPARE NEAT FILEID FOR TYPING 00532000 * 00533000 SETUP DS 0H P0683 00534000 MVC INBUF(18),0(R1) FILENAME,TYPE AND MODE P0683 00535000 LR R1,R0 P0683 00536000 BR R1 P0683 00537000 EJECT 00538000 ABDSECT DSECT (TO REFERENCE TABLES IN 'ABBREV') ... 00539000 SPACE 3 00540000 * TABLE GIVING WHEREABOUTS OF USER-DEFINED-ABBREVIATIONS, IF ANY 00541000 * 00542000 * PLEASE KEEP THE FOLLOWING SEVEN AD-CON'S IN ORDER ........ 00543000 * (SO THEY CAN BE REFERENCED FROM 'USABRV' IF NECESSARY) 00544000 USABRV DC F'0' NO. DBL-WORDS FREE-STORAGE IN USER-TABLE. 00545000 DC A(*-*) ADDRESS OF 1ST ITEM IN USER-ABRV-TABLE 00546000 DC F'17' (FOR BXLE) 00547000 DC A(*-*) ADDRESS OF LAST ITEM IN USER-ABRV-TABLE. 00548000 * 00549000 REGTABA DC A(FIRSTAB) REFERENCE 'REGULAR' TABLE ... 00550000 DC F'9' (FOR BXLE) 00551000 DC A(LASTAB) (FOR BXLE) 00552000 * 00553000 NOAB EQU X'80' 'NO ABBREVIATIONS' 00554000 EXACT EQU X'40' FOR 'EXACT' MATCH INSTEAD OF MINIMUM. 00555000 SPACE 2 00556000 * NOTE - USER-DEFINED ABBREVIATION TABLE (17 BYTES PER ITEM) 00557000 * IS A 'SYNONYM' TABLE, OF THE FOLLOWING FORM (FOR EACH ONE)... 00558000 * DC CL8'CMS-NAME' CMS SYSTEM COMMAND - E.G. ERASE 00559000 * DC CL8'USER-SYN' USER-SYNONYM FOR SAME - E.G. DELETE 00560000 * DC AL1(NUMBER) MINIMUM NO. OF BYTES ACCEPTABLE FOR MATCH 00561000 SPACE 2 00562000 FIRSTAB EQU * (REAL TABLE IS IN 'ABBREV') 00563000 LASTAB EQU FIRSTAB+9 (REAL TABLE IS IN 'ABBREV') 00564000 EJECT 00565000 NUCON 00566000 * 00567000 REGEQU 00568000 * 00569000 SPACE 2 00570000 DROP R11 00571000 SYNONYM CSECT (NECESSSARY FOR ADDRESSING 'SCAN' WHICH FOLL 00572000 DROP R12 00573000 EJECT 00574000 SCAN DS 0D COPY OF 'SCAN' ... 00575000 USING *,15 00576000 STM R2,R8,TEMP SAVE ONLY THE REGISTERS WE USE, 00577000 LA R8,COMBUF POINT TO START OF COMMAND BUFFER 00578000 SR 0,0 ZERO OUT THE BUFFER COUNT 00579000 L 4,0(,1) LOAD 4 WITH NO OF CHARACTERS IN LINE 00580000 LA 3,4(,1) AND REG. 3 WITH PTR. TO INFO. START 00581000 LTR 4,4 IS THE COUNT ZERO 00582000 BC 8,NOCHAR YES - NO LINE IN 00583000 BCTR 4,0 4 HOLDS CHAR. COUNT MINUS ONE 00584000 LR 5,4 POINT REG. 5 TO LAST CHARACTER 00585000 AR 5,3 IN INPUT LINE 00586000 BLNKLK EX 4,TRT1 LOOK FOR FIRST NON-BLANK CHARACTER 00587000 BC 8,NOCHAR NONE LEFT 00588000 LR 4,5 GET COUNT OF CHARACTERS STILL 00589000 SR 4,1 UNSCANNED IN INPUT LINE 00590000 LR 3,1 POINT REG. 3 TO NEW INFO BEGINNING 00591000 EX 4,TRT2 AND LOOK FOR NEXT BLANK CHARACTER 00592000 BC 7,GORND WE FOUND A BLANK 00593000 LA 1,1(,5) NO BLANK - POINT REG 1 PAST LINE 00594000 GORND LR 4,1 REG. FOUR HAS COUNT OF 00595000 SR 4,3 CHARACTERS TO MOVE FROM BUFFER 00596000 BCTR 4,0 00597000 EX 4,MVC GO MOVE CHARACTERS 00598000 LA 6,6 ARE ANY BLANKS NEEDED 00599000 SR 6,4 TO FILL IT 00600000 BC 4,FULINE NO 00601000 LA R7,1(R4,R8) YES - POINT TO EMPTY PART OF DBL-WORD 00602000 EX 6,MBLNK AND FILL IT WITH BLANKS 00603000 FULINE LA R8,8(,R8) SPACE UP TO NEXT BUFFER LINE 00604000 A 0,ONE ADD ONE TO COUNT OF BUFFERS USED 00605000 LR 4,5 GET NUMBER OF CHARACTERS LEFT IN LINE 00606000 SR 4,1 ARE THERE ANY 00607000 BC 4,NOCHAR NO - SCAN FINISHED 00608000 LR 3,1 YES - POINT REG. 3 TO NEW BUFFER START 00609000 BC 15,BLNKLK AND CONTINUE LINE SCAN 00610000 * 00611000 * 00612000 * FF-FILL REMAINDER OF LINE (24 JUNE 1968) ... 00613000 NOCHAR LM 2,3,ALLONE ALL ONES INTO R2 AND R3, 00614000 LA 4,8 8 INTO R4 FOR INCREMENTER, 00615000 LA 1,COMBUF SETUP R1 FOR CALLEE 00616000 LA R5,ECOMBUF-8 SET LIMIT FOR BXLE, 00617000 JSLP STM 2,3,0(R8) STORE A DOUBLE-WORD, 00618000 BXLE R8,4,JSLP ITERATE FOR REMAINDER OF COMBUF. 00619000 SLL 0,3 BUFFER AND PLACE NO. OF BYTES 00620000 A 0,FOUR IN BUFFER IN REGISTER ZERO 00621000 LM R2,R8,TEMP RESTORE THE REGISTERS WE USED, 00622000 SR R15,R15 CLEAR ERROR-CODE, 00623000 BR R14 AND RETURN TO CALLER. 00624000 EJECT 00625000 ********************************************************************* 00626000 * 00627000 * DATA AREA 00628000 * 00629000 ********************************************************************* 00630000 * 00631000 TRT1 TRT 0(1,3),NBLNKT SCAN FOR FIRST NON-BLANK CHAR. 00632000 TRT2 TRT 0(1,3),BLNKTB SCAN FOR FIRST BLANK CHARACTER 00633000 MVC MVC 0(1,R8),0(3) MOVE NON-BLANK PORTION INTO A BUFFER 00634000 MBLNK MVC 0(1,R7),BLNKS FILL BUFFER OUT WITH BLANKS 00635000 TEMP DS 7F (R2 THRU R8 SAVED AS NEEDED) 00636000 ONE DC F'1' 00637000 FOUR DC F'4' 00638000 ALLONE DC 4X'FF' 00639000 DC 4X'FF' 00640000 BLNKS DC 8C' ' 00641000 BLNKTB DC 64X'00' TRANSLATION TABLE WITH ONLY 00642000 DC X'01' BLANK TURNED ON 00643000 DC 63X'00' 00644000 DC 128X'00' 00645000 NBLNKT DC 64X'02' TRANSLATION TABLE WITH ONLY 00646000 DC X'00' BLANK TURNED OFF 00647000 DC 63X'02' 00648000 DC 128X'02' 00649000 COMBUF DS 37D (37 DBL-WRDS PLENTY FOR 72-BYTE INPUT) 00650000 ECOMBUF EQU * (THE END) 00651000 END 00652000