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
* <CL8'FILENAME'> 00035000
* <CL8'FILETYPE'> 00036000
* <CL8'FILEMODE'> 00037000
* 00038000
* OPTIONS: 00039000
* <CL8'(' 00040000
* CL8'STD'|'NOSTD' STD IS DEFAULT 00041000
* CL8'CLEAR'> 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