ibm:vm370-lib:cms:dmssyn.assemble_src
Table of Contents
DMSSYN Source
References
- Fixes Applied : 0
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMSSYN.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmssyn.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator