/* HLA: Invoke HLASM from within XEDIT to assemble the current */ /* file and write the Assembler output into the XEDIT ring. */ /* Melinda Varian, Princeton University */ Signal On Novalue Signal On Syntax Signal On Error /*********************************************************************/ /*********************************************************************/ /* */ /* Define Local Tailoring Here */ /* */ /*********************************************************************/ /*********************************************************************/ /* Name of default local control file: */ ctldef = 'PUCC' /* Default control file name. */ /* Local preferences for Assembler options: */ options = 'ASA NORLD SYSPARM(SUP)' /* Specify Assembler options. */ /* Issue local command to access High-Level Assembler, if needed: */ Signal Off Error 'SET CMSTYPE HT' 'ESTATE ASMAHL MODULE *' /* HLASM R2 available? */ saveRC = RC /* Remember. */ 'SET CMSTYPE RT' Signal On Error If saveRC <> 0 Then /* No, issue local command. */ Address Command 'EXEC GETHLASM' /* Access High-Level Assembler.*/ /*********************************************************************/ /*********************************************************************/ If Arg(1) = '?' Then Do 'MSG HLA: High-Level Assemble the current file in the XEDIT ring' 'MSG Usage: HLA <% Assembler options>' Exit End /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Verify that Pipes exists and supports "hlasm" and "hlasmerr". */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ Signal Off Error Address Command 'ESTATE PIPE MODULE *' Signal On Error If RC /= 0 Then Do xrc = RC 'MSG HLA: CMS Pipelines is not available.' 'MSG HLA: Please contact your support staff.' Exit xrc End Signal Off Error Address Command 'PIPE', /* Is it current enough to... */ 'literal resolve fplbloks |', /* ...have an HLASM and... */ 'pipcmd' /* ...HLASMERR that support... */ Signal On Error /* ...Release 2? */ If RC = 0 Then Do /* No, this won't work. */ xrc = RC 'MSG HLA: This function requires a more current level of CMS', 'Pipelines.' 'MSG HLA: Please contact your support staff.' Exit xrc End /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Verify that the current file in the ring is Assembler source. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 'EXTRACT /BASEFT' /* Find base file name. */ If Wordpos(baseft.1,'ASSEMBLE UPDTTEMP') = 0 /* Is this source file? */ Then Do /* No, look for it in ring. */ 'EXTRACT /RING' Do i = 2 to ring.0 Parse Var ring.i ringfn ringft ringfm . 'XEDIT' ringfn ringft ringfm 'EXTRACT /BASEFT' /* Find base file name. */ If Wordpos(baseft.1,'ASSEMBLE UPDTTEMP') > 0 Then Leave /* Found a source file. */ End If Wordpos(baseft.1,'ASSEMBLE UPDTTEMP') = 0 Then Do 'MSG HLA is useful only when editing an ASSEMBLE file.' Exit End End 'EXTRACT /FN/FT/FM' /* Remember source file name. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Determine the control file to be used and GLOBAL the MACLIBs. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ Parse Upper Arg ctlf . '%' useropts /* User may have specified. */ ctlread = '<' /* Assume on disk or EXECLOADed. */ If ctlf == '' Then Do /* If not, it may be in ring. */ 'EXTRACT /RING' Do i = 2 to ring.0 Parse Var ring.i ringfn ringft ringfm . If ringft == 'CNTRL' Then Do /* Is this a control file? */ ctlf = ringfn /* Yes, remember the filename. */ ctlread = 'xedit' /* And to read it from XEDIT. */ Leave End End End If ctlf == '' Then Do /* Or may be defined by file. */ Signal Off Error Address Command 'ESTATE CONTROL DEFAULT *' Signal On Error If RC = 0 Then Address Command 'PIPE < control default | var ctlf' End If ctlf == '' Then Do /* Else, as defined above. */ If Symbol('ctldef') /== 'LIT' Then ctlf = ctldef If ctlf == '' Then Do 'MSG Usage: HLA <% Assembler options>' Exit 28 End End If ctlread /== 'xedit' Then Do /* Is it in XEDIT ring? */ Signal Off Error Address Command 'ESTATE' ctlf 'CNTRL *' /* No, does it exist? */ Signal On Error If RC /= 0 Then Do /* No, exit with error. */ 'MSG HLA:' ctlf 'CNTRL not found.' Exit End End Else Do /* Control file in XEDIT ring. */ 'XEDIT' ctlf 'CNTRL' Signal Off Error ':0' /* Position to top of file. */ Signal On Error 'XEDIT' fname.1 ftype.1 fmode.1 /* Make source file current. */ End Signal Off Error Address Command 'PIPE (name SetMacs)',/* GLOBAL the MACLIBs: */ ctlread ctlf 'cntrl |', /* Pipe in the control file. */ 'nfind *|', /* Discard comments. */ 'pick word 2 == "MACS" |', /* Select MACS statements. */ 'specs words 3-* 1 |', /* Select only the MACLIBs. */ 'join * / / |', /* Join them into one string. */ 'specs', /* Build GLOBAL command: */ '/GLOBAL MACLIB/ 1', /* Literal; */ '1-* nextword |', /* Maclib list. */ 'command |', /* Issue GLOBAL command. */ 'insert /HLA: / before |', /* Mark as HLA message. */ 'xmsg' /* Display any error messages. */ Signal On Error /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Prepare the output files for the Assembler. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 'XEDIT' fname.1 'LISTING A' /* Prepare empty LISTING file. */ 'SET RECFM V' 'SET MSGMODE OFF' Signal Off Error ':0' 'DELETE *' Signal On Error 'XEDIT' fname.1 'ERRORS A (WIDTH 133' /* Prepare empty ERRORS file. */ 'SET LRECL 133' 'SET RECFM V' 'SET MSGMODE OFF' Signal Off Error ':0' 'DELETE *' Signal On Error /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Specify the options to be used in invoking the Assembler. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* On older releases of CMS, XEDIT becomes very unhappy if HLASM */ /* is allowed to default to SIZE(MAX), i.e., to take all available */ /* memory below the 16M line, so we take advantage of the Melinda */ /* Varian Memorial Option and set SIZE to leave one-fourth of the */ /* memory (either below or above the 16M line) available for other */ /* uses. */ Address Command 'PIPE (name SetSize)',/* Leave memory for others: */ 'cp QUERY VIRTUAL STORAGE |', /* Get virtual memory size. */ 'spec', /* Format SIZE option to... */ '/SIZE(MAX-/ 1', /* ..."SIZE(MAX-(vmsize/4)K)", */ 'v: substr 1;-2 of word -1 .', /* ..."SIZE(MAX-(vmsize/4)M)", */ 'k: -1 .', /* ..."SIZE(MAX-((vmsize-16), */ 'print (( v>19 & k^=="K" ? v-16 : v) % 4)', 'picture zzzz9 strip next', /* ....../4)M,ABOVE)". */ '-1 next', /* Append "K" or "M". */ 'if (v>19 & k^=="K")', /* Storage above 16M? */ 'then /,ABOVE/ next', /* Yes, use it above the line. */ 'endif', '/)/ next |', /* Append ")" or ")". */ 'var asmsize' /* Save SIZE option for HLASM. */ /* "hlasm" forces on the NODECK and OBJECT options, in addition to */ /* setting up the exits (INEXIT, OBJEXIT, PRTEXIT, and ADEXIT). In */ /* our case, we don't want to produce an object file (which would be */ /* written to the primary output of "hlasm"), so we suppress OBJECT, */ /* in addition to turning on LIST and ADATA (which cause output to */ /* be written for the secondary and tertiary output streams). */ If Symbol('options') == 'LIT' /* If tailoring not done, ... */ Then options = '' /* ... avoid Novalue hit. */ options = options useropts asmsize /* Defaults, overrides, SIZE. */ options = options 'ADATA LIST NOOBJECT NOERASE' /* And what we need. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Invoke the Assembler to read from the current file. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 'XEDIT' fname.1 ftype.1 fmode.1 /* Make source file current. */ 'PRESERVE' 'SET LINEND OFF' 'SET ESCAPE OFF' 'SET IMAGE OFF' 'SET CASE MIXED' 'SET MSGMODE OFF' /* Suppress messages. */ 'SET CMSTYPE HT' Signal Off Error ':0' /* Get to top of source file. */ Address Command 'PIPE (endchar ? name RunHLASM)', 'xedit' fname.1 ftype.1 fmode.1 '|', /* Pipe in the source. */ 'pad 80 |', /* Must be card-image format. */ 'a: hlasm' fname.1 options, /* Invoke High-Level Assembler.*/ '?', 'a: |', /* HLASM secondary output here.*/ 'xedit' fname.1 'listing a', /* Write to the LISTING file. */ '?', 'a: |', /* HLASM tertiary output here. */ 'hlasmerr |', /* Extract error messages. */ 'join 1 x00 |', /* Join statement and message. */ 'n: nlocate /ASMA435I/ |', /* Divert source origin lines. */ 'split at x00 |', /* Deblock. */ 'f: faninany |', /* Merge back source origins. */ 'xedit' fname.1 'errors a', /* Write to the ERRORS file. */ '?', 'n: |', /* Source origin lines here. */ 'nlocate /.pseudo.pipeline.(pipe)/ |', /* Discard if in base. */ 'not chop after x00 |', /* Else discard macro statemnt.*/ 'f:' /* But keep origin line. */ pipeRC = RC /* Remember results. */ Address Command 'FINIS * MACLIB *' /* Clean up. */ Signal On Error 'SET CMSTYPE RT' 'SET MSGMODE ON' ':1' /* Get to top of file again. */ 'RESTORE' /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Position in output files according to success or failure. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ Select When pipeRC = 144 Then Do /* PIPE got error from XEDIT. */ 'MSG HLA: XEDIT ran out of storage; increase virtual memory size.' 'XEDIT' fname.1 'ERRORS A' /* Discard ERRORS file. */ 'QQUIT' 'XEDIT' fname.1 'LISTING A' /* Discard LISTING file. */ 'QQUIT' End When pipeRC = 20 Then Do /* Assembler low memory error. */ 'MSG HLA: The Assembler ran out of storage; increase virtual', 'memory size.' 'XEDIT' fname.1 'ERRORS A' /* Discard ERRORS file. */ 'QQUIT' 'XEDIT' fname.1 'LISTING A' /* Discard LISTING file. */ 'QQUIT' End When pipeRC <> 0 Then Do /* Assembler produced errors. */ 'MSG HLA: Return code from assembly =' pipeRC'.' 'XEDIT' fname.1 'LISTING A' /* Position in LISTING to ... */ 'SET MSGMODE ON' /* ... first suitable error. */ ':1' 'SET ALT 0 0' 'MSG HLA: Return code from assembly =' pipeRC'.' Signal Off Error Do Forever /* Look for interesting error. */ 'LOCATE /*** ERROR ***/ | /** WARNING **/ | /*** MNOTE ***/' If RC <> 0 Then Do /* Must be at bottom. */ 'LOCATE -/Statements Flagged/' Leave /* Error doesn't show. */ End 'EXTRACT /CURLINE' If Substr(curline.3,2,8) /== 'ASMA425I' /* Option conflict. */ Then Leave /* First real problem found. */ End Signal On Error 'XEDIT' fname.1 'ERRORS A' /* Make ERRORS file current. */ 'SET MSGMODE ON' ':1' 'SET ALT 0 0' End Otherwise Do /* Assembler found no errors. */ 'MSG HLA: Return code from assembly = 0.' 'XEDIT' fname.1 'ERRORS A' /* Discard ERRORS file. */ 'QQUIT' 'XEDIT' fname.1 'LISTING A' /* Make LISTING file current. */ 'SET MSGMODE ON' ':1' 'SET ALT 0 0' 'MSG HLA: Return code from assembly = 0.' End End Exit /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Error routines */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ Error: Parse Source . . myfn myft . errRC = RC 'SET MSGMODE ON' 'MSG HLA: Unexpected error' 'MSG HLA:' Sourceline(Sigl) Exit errRC /* Exit with error setting. */ Novalue: Parse Source . . myfn myft . 'SET MSGMODE ON' 'MSG HLA: Novalue condition for symbol' Condition('D') 'on line' Sigl, 'of' myfn myft':' 'MSG HLA:' Sourceline(Sigl) Exit 20 /* Exit with error setting. */ Syntax: Parse Source . . myfn myft . 'SET MSGMODE ON' 'MSG HLA: Syntax error on line' Sigl 'of' myfn myft':' 'MSG HLA:' Sourceline(Sigl) Exit 24 /* Exit with error setting. */