;STAR:MACSYM.MAC.2, 13-Mar-2006 19:40:15, Edit by SLOGIN ;[T36] Don't cross-reference generated symbols in MACSYM; suppress DDT output ; Edit= 9162 to MACSYM.MAC on 9-Mar-90 by GSCOTT ;Add ANNJE. macro to jump to "false" on JSYS error. ; Edit= 8849 to MACSYM.MAC on 31-May-88 by RASPUZZI ;Add new mnemonics .CHDAS and .CHHYP for the '-' character. ; UPD ID= 59, RIP:<7.UTILITIES>MACSYM.MAC.5, 24-Mar-88 06:52:33 by LOMARTIRE ;More of TCO 7.1236 - Fix copyright year in MACREL ; UPD ID= 58, RIP:<7.UTILITIES>MACSYM.MAC.4, 8-Mar-88 10:56:58 by GSCOTT ;More of TCO 7.1236 - Fix copyright macro. ; UPD ID= 54, RIP:<7.UTILITIES>MACSYM.MAC.3, 19-Feb-88 18:14:29 by GSCOTT ;TCO 7.1236 - Update copyright notice. ; UPD ID= 35, RIP:<7.UTILITIES>MACSYM.MAC.2, 29-Dec-87 11:15:02 by RASPUZZI ;TCO 7.1168 - Add .CHSEM so we have semi colon mnemonic ; UPD ID= 124, SNARK:<6.1.UTILITIES>MACSYM.MAC.54, 6-May-85 20:23:19 by GROSSMAN ;TCO 6.1.1367 - Fix G1BPT to get section number into the correct place if ;using a symbolic section number. ; UPD ID= 609, SNARK:<6.UTILITIES>MACSYM.MAC.53, 16-Oct-84 09:12:47 by LOMARTIRE ;TCO 6.2243 - Fix SAVEAC so that numeric arguments produce the correct results ; UPD ID= 597, SNARK:<6.UTILITIES>MACSYM.MAC.52, 17-Sep-84 16:11:52 by PURRETTA ;Update copyright notice. ; UPD ID= 574, SNARK:<6.UTILITIES>MACSYM.MAC.51, 7-Aug-84 16:10:48 by PAETZOLD ;More of TCO 6.2132 - Add an N.B. in the structure macros about initialization ; UPD ID= 565, SNARK:<6.UTILITIES>MACSYM.MAC.50, 18-Jul-84 10:23:09 by PAETZOLD ;TCO 6.2132 - fix up ENDSTR to reuse FTSHOW words. ; UPD ID= 513, SNARK:<6.UTILITIES>MACSYM.MAC.49, 28-Mar-84 21:58:59 by MOSER ;TCO 6.1991 - REPLACE POINTR WITH ITS EXPANSION ; UPD ID= 502, SNARK:<6.UTILITIES>MACSYM.MAC.48, 15-Mar-84 09:28:06 by PAETZOLD ;Revoke edit 485. ; UPD ID= 501, SNARK:<6.UTILITIES>MACSYM.MAC.47, 11-Mar-84 16:16:36 by GROSSMAN ; CAXxx and ADDx & friends ; UPD ID= 486, SNARK:<6.UTILITIES>MACSYM.MAC.46, 20-Feb-84 22:36:22 by GROSSMAN ; Add TCO # to previous... ; UPD ID= 485, SNARK:<6.UTILITIES>MACSYM.MAC.45, 20-Feb-84 22:25:35 by GROSSMAN ; TCO 6.1974 - Purge generated labels produced by IFSKP., DO. and friends. ; UPD ID= 356, SNARK:<6.UTILITIES>MACSYM.MAC.44, 5-Oct-83 14:20:00 by MURPHY ;Remove obsolete PTLOC, PTLOCI, etc. ; UPD ID= 345, SNARK:<6.UTILITIES>MACSYM.MAC.43, 18-Aug-83 00:38:50 by GROSSMAN ; Make OWGP. work under radix ^D10. ; UPD ID= 339, SNARK:<6.UTILITIES>MACSYM.MAC.42, 8-Aug-83 08:28:19 by GROSSMAN ; More of TCO 6.1755 - Subtract P offsets from ^D36. ; UPD ID= 328, SNARK:<6.UTILITIES>MACSYM.MAC.41, 1-Aug-83 08:14:48 by GROSSMAN ;TCO 6.1755 - Re-do OWGBP generation. ; UPD ID= 326, SNARK:<6.UTILITIES>MACSYM.MAC.40, 27-Jul-83 14:33:00 by GROSSMAN ;Fix generation of 18 bit one-word globals (in .GTBCD macro) ; UPD ID= 318, SNARK:<6.UTILITIES>MACSYM.MAC.39, 11-Jul-83 08:56:07 by GRANT ;Change names of 8-bit BP macros added in UPD 306 ; UPD ID= 317, SNARK:<6.UTILITIES>MACSYM.MAC.38, 8-Jul-83 15:17:29 by WEETON ;TCO 6.1715 - Add VI%DEC ; UPD ID= 306, SNARK:<6.UTILITIES>MACSYM.MAC.37, 30-Jun-83 11:15:34 by GRANT ;More TCO 6.1641 - Add macros to generate 8-bit byte pointers ; UPD ID= 300, SNARK:<6.UTILITIES>MACSYM.MAC.36, 23-Jun-83 15:20:26 by PURRETTA ;Assemble copyright under REL conditional ; UPD ID= 299, SNARK:<6.UTILITIES>MACSYM.MAC.35, 23-Jun-83 13:18:09 by MURPHY ;More - check on pass 2 only. ; UPD ID= 298, SNARK:<6.UTILITIES>MACSYM.MAC.34, 22-Jun-83 17:26:57 by PURRETTA ;TCO 6.1701 - Define copyright macros COPYRT and .CPYRT ; UPD ID= 295, SNARK:<6.UTILITIES>MACSYM.MAC.33, 15-Jun-83 11:54:51 by MURPHY ;TCO 6.1686 - Check for absolute size args in STKVAR, etc. ; UPD ID= 289, SNARK:<6.UTILITIES>MACSYM.MAC.32, 24-May-83 09:23:08 by MCINTEE ;TYPO IN PREVIOUS EDIT - NAME SHOULD BE EMSKST NOT MSKSTR !!! ; UPD ID= 288, SNARK:<6.UTILITIES>MACSYM.MAC.31, 23-May-83 10:32:53 by MURPHY ;TCO 6.1661 - EDEFST, EMSKST, etc. ; UPD ID= 279, SNARK:<6.UTILITIES>MACSYM.MAC.30, 6-May-83 14:09:24 by HALL ;TCO 6.1641 - Add new byte pointers for 7-bit ASCII strings ; UPD ID= 278, SNARK:<6.UTILITIES>MACSYM.MAC.29, 5-May-83 16:16:46 by MURPHY ;TCO 6.1647 - Anglebrackets around Y in various calls internal to LOAD, etc. ; UPD ID= 246, SNARK:<6.UTILITIES>MACSYM.MAC.28, 4-Apr-83 12:42:30 by MURPHY ;TCO 6.1514 - New flavors of ERJMP, ERCAL. New macros IFJE. IFJN. to ; allow specification of ERJMP type. ; UPD ID= 242, SNARK:<6.UTILITIES>MACSYM.MAC.27, 25-Mar-83 16:40:06 by MURPHY ;TCO 6.1576 - Add tco number for OWGP., etc. ; UPD ID= 240, SNARK:<6.UTILITIES>MACSYM.MAC.26, 24-Mar-83 16:29:03 by MURPHY ;OWG. - Macro to construct one-word global byte pointers. ;EP., EXIND. - Macros to create extended format indirect words. ; UPD ID= 228, SNARK:<6.UTILITIES>MACSYM.MAC.25, 16-Mar-83 13:59:31 by MURPHY ;TCO 6.1551 - Fix DO., save ENDLP. definition over nesting. ; UPD ID= 223, SNARK:<6.UTILITIES>MACSYM.MAC.24, 12-Mar-83 17:33:10 by MILLER ;More TCO 6.1540 ; UPD ID= 222, SNARK:<6.UTILITIES>MACSYM.MAC.23, 11-Mar-83 13:08:44 by MILLER ;TCO 6.1540. Fix .ENTER for global stack ; UPD ID= 215, SNARK:<6.UTILITIES>MACSYM.MAC.22, 28-Feb-83 07:54:49 by MCINTEE ;TCO 6.1528 - In ENDSTR, purge all intermediate macro names ; UPD ID= 197, SNARK:<6.UTILITIES>MACSYM.MAC.21, 26-Jan-83 09:31:38 by HUIZENGA ;TCO 6.1477 - INCR/DECR warning about field overflows ; UPD ID= 193, SNARK:<6.UTILITIES>MACSYM.MAC.20, 18-Jan-83 23:30:33 by MURPHY ;More 6.1468 - Now make other variables work again. ; UPD ID= 192, SNARK:<6.UTILITIES>MACSYM.MAC.20, 17-Jan-83 16:48:28 by MURPHY ;TCO 6.1468 - Make STKVAR variables work in BLCAL. ; UPD ID= 149, SNARK:<6.UTILITIES>MACSYM.MAC.19, 1-Oct-82 08:45:37 by NEUSTAEDTER ;TCO 6.1293 - fancy up SAVEAC and LOADE ; UPD ID= 122, SNARK:<6.UTILITIES>MACSYM.MAC.18, 24-Aug-82 14:46:17 by MCINTEE ;More TCO 6.1139 - BEGSTR needs LFTBT. macro ; UPD ID= 100, SNARK:<6.UTILITIES>MACSYM.MAC.17, 15-Jul-82 18:27:56 by WALLACE ;TCO 6.1188 - Make computation of MACVER use new version number symbols ; UPD ID= 91, SNARK:<6.UTILITIES>MACSYM.MAC.16, 25-Jun-82 11:45:20 by PAETZOLD ;TCO 6.1177 - Make symbol names from from edit better more unique ; UPD ID= 90, SNARK:<6.UTILITIES>MACSYM.MAC.15, 23-Jun-82 10:13:00 by PAETZOLD ;TCO 6.1175 - Add version information to MACSYM ; UPD ID= 84, SNARK:<6.UTILITIES>MACSYM.MAC.14, 9-Jun-82 18:15:13 by MURPHY ;TCO 6.1163 - MAKRM. ; UPD ID= 83, SNARK:<6.UTILITIES>MACSYM.MAC.13, 9-Jun-82 15:25:40 by WALLACE ;TCO 6.1161 - Modify AC save and stack variable facilities to work ; with extended addressing. Also perform general clean up for listing ; sake. ; UPD ID= 62, SNARK:<6.UTILITIES>MACSYM.MAC.12, 26-May-82 10:36:26 by MCINTEE ;MASK. - must be on one line ; UPD ID= 58, SNARK:<6.UTILITIES>MACSYM.MAC.11, 25-May-82 16:25:13 by MCINTEE ;Add MASK. - used in BEGSTR ; UPD ID= 41, SNARK:<6.UTILITIES>MACSYM.MAC.10, 18-May-82 07:30:03 by GRANT ;TCO 6.1139 - BEGSTR, ENDSTR, LOADE ; UPD ID= 37, SNARK:<6.UTILITIES>MACSYM.MAC.9, 3-May-82 17:52:41 by MURPHY ;TCO 6.1124 - BLOCK., ENDBK. ; UPD ID= 32, SNARK:<6.UTILITIES>MACSYM.MAC.8, 5-Mar-82 10:58:39 by MCINTEE ;Add warning to STKVAR about blanks ; UPD ID= 31, SNARK:<6.UTILITIES>MACSYM.MAC.7, 22-Feb-82 17:38:19 by MURPHY ;IFJER., IFNJE. - new names for IFNES., IFESK. ;TCO 6.1061 - FORS. ; UPD ID= 26, SNARK:<6.UTILITIES>MACSYM.MAC.6, 27-Jan-82 15:57:01 by MCINTEE ;Add warning to DEFSTR about length of names !!! ; UPD ID= 20, SNARK:<6.UTILITIES>MACSYM.MAC.5, 15-Jan-82 10:43:41 by WALLACE ;TCO 5.1669 - Add Error JSERR (EJSERR) and Error JSHLT (EJSHLT) macros ;TCO 5.1666 - Add If Error Skip (IFESK.) and If No Error Skip (IFNES.) macros ; UPD ID= 13, SNARK:<6.UTILITIES>MACSYM.MAC.4, 17-Nov-81 11:57:56 by MURPHY ;Allow ANxxx. between ELSE. and ENDIF. ;ENDDO. equivalent to OD. for consistency. ; UPD ID= 12, SNARK:<6.UTILITIES>MACSYM.MAC.3, 12-Nov-81 13:42:14 by MURPHY ;FORN., FORX. ;Put file in U60: ; UPD ID= 34, SNARK:<5.UTILITIES>MACSYM.MAC.39, 18-Sep-81 13:35:40 by LEACHE ;Add comments ; UPD ID= 32, SNARK:<5.UTILITIES>MACSYM.MAC.38, 17-Sep-81 15:45:20 by MURPHY ;Fix STDAC. ; UPD ID= 28, SNARK:<5.UTILITIES>MACSYM.MAC.37, 8-Sep-81 17:38:36 by MURPHY ;Two PURGEs for ENDxx to get rid of both macro and symbol definition. ; UPD ID= 15, SNARK:<5.UTILITIES>MACSYM.MAC.36, 30-Jul-81 09:01:25 by LEACHE ;Remove unneeded ^O's from previous ; UPD ID= 13, SNARK:<5.UTILITIES>MACSYM.MAC.35, 29-Jul-81 09:22:17 by LEACHE ;Add macros MPRNTX,EPRNTX,LFIWM,GFIWM,L1BPT,L2BPT,G1BPT,G2BPT ; UPD ID= 2278, SNARK:<5.UTILITIES>MACSYM.MAC.34, 30-Jun-81 16:41:32 by MURPHY ;FIX IFXE. ; UPD ID= 2251, SNARK:<6.UTILITIES>MACSYM.MAC.14, 24-Jun-81 16:54:23 by MURPHY ;STDAC., DO. ; UPD ID= 2183, SNARK:<6.UTILITIES>MACSYM.MAC.13, 11-Jun-81 14:40:23 by MURPHY ;RENAME TQNx TO TMNx; TQNx WILL GENERATE EXACTLY ONE INSTRUCTION OR COMPLAIN ; UPD ID= 2158, SNARK:<6.UTILITIES>MACSYM.MAC.12, 9-Jun-81 15:13:39 by MURPHY ;IFXE., IFXN., IFQE., IFQN., ANDXE., ANDXN., ANDQE., ANDQN ;RESTRUCTURE IFE., IFN. ETC., ADD ELSE. CASE, ADD ANDE., ANDN., ETC. ; UPD ID= 2150, SNARK:<6.UTILITIES>MACSYM.MAC.11, 8-Jun-81 16:47:27 by MURPHY ;ANSKP., ANNSK., IFE., IFN., ETC. ; UPD ID= 2120, SNARK:<6.UTILITIES>MACSYM.MAC.9, 3-Jun-81 16:13:37 by MURPHY ;MORE ORNSK. ; UPD ID= 2052, SNARK:<6.UTILITIES>MACSYM.MAC.8, 20-May-81 17:47:33 by MURPHY ;Suppress one more generated tag in IFSKP. ; UPD ID= 2017, SNARK:<6.UTILITIES>MACSYM.MAC.7, 18-May-81 15:57:40 by MURPHY ;Alternate form of IFSKP., IFNSK. ; UPD ID= 1781, SNARK:<6.UTILITIES>MACSYM.MAC.6, 2-Apr-81 10:42:18 by HUIZENGA ;TCO 5.1275 - Explicitly define absolute value of .JBVER as octal. 20-15376. ; UPD ID= 1766, SNARK:<6.UTILITIES>MACSYM.MAC.4, 25-Mar-81 14:55:47 by MURPHY ;Suppress generated tags in IFSKP. etc. ;Provide optional variables in BLSUB. ; UPD ID= 1688, SNARK:<5.UTILITIES>MACSYM.MAC.26, 12-Mar-81 11:49:35 by GRANT ;Update Copyright ; UPD ID= 1629, SNARK:<5.UTILITIES>MACSYM.MAC.25, 2-Mar-81 14:47:00 by MURPHY ;FIX TO BLCAL. ;USE .SAC NOT CX ; UPD ID= 1592, SNARK:<5.UTILITIES>MACSYM.MAC.23, 26-Feb-81 17:52:17 by MURPHY ;MV., MVI. ; UPD ID= 1559, SNARK:<5.UTILITIES>MACSYM.MAC.22, 13-Feb-81 16:42:35 by MURPHY ;.IF, ORNSK. ; UPD ID= 1544, SNARK:<5.UTILITIES>MACSYM.MAC.21, 9-Feb-81 13:54:29 by MURPHY ;IFNSK., IFSKP. ; UPD ID= 1523, SNARK:<5.UTILITIES>MACSYM.MAC.20, 6-Feb-81 11:16:07 by MURPHY ;NAMES CHANGED TO BLCAL., BLSUB. ; UPD ID= 1513, SNARK:<5.UTILITIES>MACSYM.MAC.19, 3-Feb-81 17:40:52 by MURPHY ;ADD .IFATM, FIX BLCALL ; UPD ID= 1466, SNARK:<5.UTILITIES>MACSYM.MAC.18, 21-Jan-81 16:19:40 by MURPHY ;DITTO ; UPD ID= 1465, SNARK:<5.UTILITIES>MACSYM.MAC.17, 21-Jan-81 15:09:03 by MURPHY ;BLSUBR, BLCALL ; UPD ID= 1179, SNARK:<5.UTILITIES>MACSYM.MAC.16, 20-Oct-80 17:21:25 by MURPHY ;REVISE PREV EDIT IN DEFSTR ; UPD ID= 1165, SNARK:<5.UTILITIES>MACSYM.MAC.15, 15-Oct-80 12:08:44 by MURPHY ;EXTERN .SASET ; UPD ID= 1135, SNARK:<5.UTILITIES>MACSYM.MAC.14, 6-Oct-80 16:13:17 by MURPHY ;MAKE DEFSTR DEFINE A SYMBOL TO HOLD LOCATION INFO FOR DDT ; UPD ID= 1074, SNARK:<5.UTILITIES>MACSYM.MAC.13, 30-Sep-80 17:38:12 by MURPHY ;DITTO ; UPD ID= 1069, SNARK:<5.UTILITIES>MACSYM.MAC.12, 30-Sep-80 14:23:54 by MURPHY ;STKVAR, ACVAR ; SNARK:<5.UTILITIES>MACSYM.MAC.11, 5-Aug-80 09:07:15 by ELFSTROM ; change "circonflex" to "circumflex" ; UPD ID= 611, SNARK:<4.1.UTILITIES>MACSYM.MAC.10, 6-Jun-80 14:36:44 by MURPHY ; UPD ID= 602, SNARK:<4.1.UTILITIES>MACSYM.MAC.9, 4-Jun-80 22:44:54 by MURPHY ;ALLOW MEMORY LOC FOR TQNN AND TQNE ; UPD ID= 470, SNARK:<4.1.UTILITIES>MACSYM.MAC.8, 23-Apr-80 17:28:36 by MURPHY ; UPD ID= 469, SNARK:<4.1.UTILITIES>MACSYM.MAC.7, 23-Apr-80 16:41:36 by MURPHY ;ADD .XCMSY - MACRO TO SUPPRESS JUNK SYMBOLS USER HEREIN ;<4.1.UTILITIES>MACSYM.MAC.6, 14-Apr-80 16:29:47, EDIT BY OSMAN ;Change FLDDB. and FLDBK. to allow \ in help message ;<4.1.UTILITIES>MACSYM.MAC.5, 12-Nov-79 08:42:58, EDIT BY OSMAN ;more 4.2570 - Purge ..V1 and ..V22 after using them ;<4.1.UTILITIES>MACSYM.MAC.4, 12-Nov-79 08:34:38, EDIT BY OSMAN ;MORE 4.2570 - Change V22 to ..V22 ;<4.1.UTILITIES>MACSYM.MAC.3, 9-Nov-79 13:55:33, EDIT BY OSMAN ;tco 4.2570 - Change V1 to ..V1 ;<4.1.UTILITIES>MACSYM.MAC.2, 31-Oct-79 10:37:13, EDIT BY OSMAN ;tco 4.1.1003 - Add .CHSPC ;<4.UTILITIES>MACSYM.MAC.27, 19-Oct-79 13:39:11, EDIT BY ZIMA ;TCO 4.2536 - Make JSMSG0 external to prevent "undefined" errors ; from MACRO when attempting to use PERSTR macro. ;<4.UTILITIES>MACSYM.MAC.19, 2-Oct-79 15:05:45, EDIT BY OSMAN ;tco 4.2506 - allow BRKCH. "," ;<4.UTILITIES>MACSYM.MAC.18, 21-Sep-79 15:37:58, EDIT BY ENGEL ;UNDO MAKING RETSKP AN OPDEF ;<4.UTILITIES>MACSYM.MAC.17, 11-Sep-79 07:17:32, EDIT BY R.ACE ;TCO 4.2453 - PREFIX "symbol IS NOT DEFINED" WITH A QUESTION MARK ;<4.UTILITIES>MACSYM.MAC.16, 19-Aug-79 20:35:06, EDIT BY GILBERT ;MAKE RETSKP, JSHLT, ETC. OPDEFS FOR DDT TYPEOUT. ;<4.UTILITIES>MACSYM.MAC.15, 22-Jun-79 07:16:13, EDIT BY R.ACE ;TCO 4.2307 - CHANGE FLDDB. TO USE 0,,LST INSTEAD OF Z LST ;<4.UTILITIES>MACSYM.MAC.14, 10-Mar-79 14:01:35, EDIT BY KONEN ;UPDATE COPYRIGHT FOR RELEASE 4 ;<4.UTILITIES>MACSYM.MAC.13, 8-Feb-79 16:46:30, EDIT BY KIRSCHEN ;ADD ENTRY DECLARATION FOR .STKST FOR LIBRARY SEARCHING ;<4.UTILITIES>MACSYM.MAC.12, 6-Feb-79 10:59:13, EDIT BY GILBERT ;REPLACE XMOVEI -- MACRO DOESN'T KNOW ABOUT IT ;<4.UTILITIES>MACSYM.MAC.11, 5-Feb-79 00:51:10, EDIT BY GILBERT ;Remove extended addressing OPDEFs now in MACRO, change XBLT MACRO ; to XBLT. to avoid conflict with MACRO's definition of 020000,,0. ;<4.UTILITIES>MACSYM.MAC.10, 22-Jan-79 16:29:04, EDIT BY DNEFF ;Make POINTR macro take addresses with indexing again. ;<4.UTILITIES>MACSYM.MAC.9, 22-Jan-79 13:31:23, EDIT BY DBELL ;MAKE POINTR, FLD, .RTJST, MASKB, AND MOD. IMMUNE TO STRANGE ARGUMENTS ;<4.UTILITIES>MACSYM.MAC.8, 25-Oct-78 12:22:59, EDIT BY GILBERT ;Suppress CALLRET to DDT typeout. ;<4.UTILITIES>MACSYM.MAC.7, 12-Sep-78 15:52:12, EDIT BY OSMAN ;FIX FLDBK. ;<4.UTILITIES>MACSYM.MAC.4, 6-Sep-78 16:51:29, EDIT BY OSMAN ;ADD FLDDB. AND FLDBK. ;<4.UTILITIES>MACSYM.MAC.3, 6-Sep-78 16:28:36, EDIT BY OSMAN ;CHANGE BREAK SET MACROS TO HAVE DOTS IN THEM. ADD BRMSK. ;<4.UTILITIES>MACSYM.MAC.2, 3-Sep-78 12:35:16, EDIT BY OSMAN ;ADD MACROS FOR DEFINING 128-BIT CHARACTER BREAK MASKS ; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1990. ; ALL RIGHTS RESERVED. ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ; TRANSFERRED. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ; CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL. SUBTTL COPYRIGHT MACROS DEFINE COPYRT (YEAR),< ASCIZ / COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 'YEAR'. ALL RIGHTS RESERVED. /> ;[7.1236] DEFINE .CPYRT (.YEAR),< ;;Don't assemble into .EXE XLIST LOC 0 COPYRT .YEAR .IFN .,ABSOLUTE, IFGE .-^O22, RELOC LIST SALL > IFNDEF .MCVWH,<.MCVWH==7> ;[T36] WHO LAST CHANGED MACSYM IFNDEF .MCVMA,<.MCVMA==7> ;MAJOR VERSION NUMBER IFNDEF .MCVMI,<.MCVMI==0> ;MINOR VERSION NUMBER IFNDEF .MCVED,<.MCVED==^D1022> ;[T36] EDIT NUMBER (INCREMENTED ON EACH EDIT) MACVER==<<.MCVWH>B2!<.MCVMA>B11!<.MCVMI>B17!<.MCVED>B35> IFNDEF REL, ;UNIVERSAL UNLESS OTHERWISE DECLARED IFE REL,< UNIVERSAL MACSYM COMMON MACROS AND SYMBOLS .DIRECTIVE .NOBIN > IFN REL,< TITLE MACREL SUPPORT CODE FOR MACSYM SEARCH MONSYM COPYRT <1990> ;[9162][7.1236] SALL > ;THE STANDARD VERSION WORD CONSTRUCTION ; VERS - PROGRAM VERSION NUMBER ; VUPDAT - PROGRAM UPDATE NUMBER (1=A, 2=B ...) ; VEDIT - PROGRAM EDIT NUMBER ; VCUST - CUSTOMER EDIT CODE (0=DEC DEVELOPMENT, 1=DEC SWS, 2-7 CUST) DEFINE PGVER. (VERS,VUPDAT,VEDIT,VCUST)< ..PGV0==. ;;SAVE CURRECT LOCATION AND MODE .JBVER=:^O137 ;;WHERE TO PUT VERSION LOC .JBVER ;;PUT VERSION IN STANDARD PLACE BYTE (3)VCUST(9)VERS(6)VUPDAT(18)VEDIT .ORG ..PGV0 ;;RESTORE LOCATION AND MODE > ;MASKS FOR THE ABOVE VI%WHO==:7B2 ;Customer edit code VI%MAJ==:777B11 ;Major version number VI%MIN==:77B17 ;Minor version/update VI%EDN==:377777B35 ;Edit number VI%DEC==:1B18 ;Decimal ;ADDED VI%XXX SUBTTL COMMON DEFS ;DEFINE STANDARD AC'S DEFINE STDAC. < F=:0 T1=:1 T2=:2 T3=:3 T4=:4 Q1=:5 Q2=:6 Q3=:7 P1=:10 P2=:11 P3=:12 P4=:13 P5=:14 P6=:15 CX=:16 P=:17 > SUBTTL MISC CONSTANTS ;MISC CONSTANTS .INFIN==:377777,,777777 ;PLUS INFINITY .MINFI==:1B0 ;MINUS INFINITY .LHALF==:777777B17 ;LEFT HALF .RHALF==:777777 ;RIGHT HALF .FWORD==:-1 ;FULL WORD SUBTTL SYMBOLS FOR THE CONTROL CHARACTERS .CHNUL==:000 ;NULL .CHCNA==:001 .CHCNB==:002 .CHCNC==:003 .CHCND==:004 .CHCNE==:005 .CHCNF==:006 .CHBEL==:007 ;BELL .CHBSP==:010 ;BACKSPACE .CHTAB==:011 ;TAB .CHLFD==:012 ;LINE-FEED .CHVTB==:013 ;VERTICAL TAB .CHFFD==:014 ;FORM FEED .CHCRT==:015 ;CARRIAGE RETURN .CHCNN==:016 .CHCNO==:017 .CHCNP==:020 .CHCNQ==:021 .CHCNR==:022 .CHCNS==:023 .CHCNT==:024 .CHCNU==:025 .CHCNV==:026 .CHCNW==:027 .CHCNX==:030 .CHCNY==:031 .CHCNZ==:032 .CHESC==:033 ;ESCAPE .CHCBS==:034 ;CONTROL BACK SLASH .CHCRB==:035 ;CONTROL RIGHT BRACKET .CHCCF==:036 ;CONTROL CIRCUMFLEX .CHCUN==:037 ;CONTROL UNDERLINE .CHSPC==:040 ;SPACE .CHDAS==:055 ;[8849] Dash character (-) .CHHYP==:055 ;[8849] A.K.A. hyphen .CHSEM==:073 ;[7.1168] Semi-colon .CHALT==:175 ;OLD ALTMODE .CHAL2==:176 ;ALTERNATE OLD ALTMODE .CHDEL==:177 ;DELETE SUBTTL HARDWARE BITS OF INTEREST TO USERS ;PC FLAGS PC%OVF==:1B0 ;OVERFLOW PC%CY0==:1B1 ;CARRY 0 PC%CY1==:1B2 ;CARRY 1 PC%FOV==:1B3 ;FLOATING OVERFLOW PC%BIS==:1B4 ;BYTE INCREMENT SUPPRESSION PC%USR==:1B5 ;USER MODE PC%UIO==:1B6 ;USER IOT MODE PC%LIP==:1B7 ;LAST INSTRUCTION PUBLIC PC%AFI==:1B8 ;ADDRESS FAILURE INHIBIT PC%ATN==:3B10 ;APR TRAP NUMBER PC%FUF==:1B11 ;FLOATING UNDERFLOW PC%NDV==:1B12 ;NO DIVIDE SUBTTL ;THE FOLLOWING MACRO MAY BE USED TO SUPPRESS CREF ENTRIES FOR ;ALL THE JUNK SYMBOLS USED INTERNALLY WITHIN MACROS IN MACSYM DEFINE .XCMSY < .XCREF .XCRF1 <..ACT,..CSC,..CSN,..IFT,..JX1,..MSK,..MX1,..MX2> .XCRF1 <..NAC,..NRGS,..NS,..NV,..PST,..STKN,..STKQ,..STKR> .XCRF1 <..TRR,..TSA1,..TX1,..TX2,.FP,.FPAC,.NAC,.SAC,.SAV1> .XCRF1 <.SAV2,.SAV3,POINTR,POS,WID,..CAS1,..CNS,..CNS2> .XCRF1 <..DPB,..GNCS,..ICNS,..JE,..LDB,..STR0,..STR1,..STR2> .XCRF1 <..STR4,..TQO,..TQZ,..TSAC,..TSIZ,..TX,..TY,.ACV1,.ACV2> .XCRF1 <.ACV3,.CASE,.DECR0,.IF0,.INCR0,.OPST1,.OPST2,.STKV1> .XCRF1 <.STKV2,.STKV3,.TRV1,.TRV2,.TRV3> .CREF > DEFINE .XCRF1 (SYMS)< IRP SYMS,< IFDEF SYMS,< .XCREF SYMS>>> SUBTTL MACROS FOR FIELD MASKS ;STANDARD MACROS ;Macro to show binary value in assembly listing. Must be ;used as last thing in macro definition with no CR before ;closing bracket. DEFINE SHOW. (SYM)< ....Z=SYM> ;MACROS TO HANDLE FIELD MASKS ;COMPUTE LENGTH OF MASK, I.E. LENGTH OF LEFTMOST STRING OF ONES ;REMEMBER THAT ^L DOES 'JFFO', I.E. HAS VALUE OF FIRST ONE BIT IN WORD ;COMPUTE WIDTH OF MASK, I.E. LENGTH OF LEFTMOST STRING OF ONES DEFINE WID(MASK)<<^L<-<_<^L>>-1>>> ;COMPUTE POSITION OF MASK, I.E. BIT POSITION OF RIGHTMOST ONE IN MASK DEFINE POS(MASK)<<^L<&<->>>> ;CONSTRUCT BYTE POINTER TO MASK DEFINE POINTR(LOC,MASK)<),LOC,POS()>> ;PUT RIGHT-JUSTIFIED VALUE INTO FIELD SPECIFIED BY MASK DEFINE FLD(VAL,MSK)<<<B)>>&>> ;MAKE VALUE BE RIGHT JUSTIFIED IN WORD. DEFINE .RTJST(VAL,MSK)<<<&>B<^D70-POS()>>> ;CONSTRUCT MASK FROM BIT AA TO BIT BB. I.E. MASKB 0,8 = 777B8 DEFINE MASKB(AA,BB)<<1B<-1>-1B>> ;MODULO - GIVES REMAINDER OF DEND DIVIDED BY DSOR DEFINE MOD.(DEND,DSOR)<<-</>*>> SUBTTL ;REPEAT WITH SUBSTITUTION OF NUMERIC INDEX DEFINE FORN. (LOW,HIGH,ARGS,STRING,%MN1)< DEFINE %MN1(ARGS) ..FORN==LOW REPEAT HIGH-LOW+1,< .FORN1 (%MN1) ..FORN=..FORN+1> .XCREF %MN1 > ;;[T36] DEFINE .FORN1 (MACN)< MACN (\..FORN)> ;REPEAT WITH GENERAL STRING SUBSTITUTION DEFINE FORX. (ARGS,SYMS,STRING,%MN1)< DEFINE %MN1 (SYMS) IRP ARGS,< .FORX1 %MN1,ARGS> .XCREF %MN1 > ;;[T36] DEFINE .FORX1 (MACN,ARGS)< MACN ARGS> ;DO WITH NUMERIC STRING SUBSTITUTION DEFINE FORS. (NUM,ARG,STRING)< DEFINE %MN1 (ARG) ..FORN==NUM ;;EVALUATE EXPRESSION .FORN1 (%MN1)> ;;TRANSLATE AND EXPAND SUBTTL MAKRM. - Make remote macros. ;Macro to define a set of remote macros. You say MAKRM. (XX,YY). ;This defines macros called XX and YY and one other. ;Then, you say XX one ;or more times to save 'stuff'. Finally, you say YY, and that ;expands as all of the 'stuff' that you previously saved. DEFINE MAKRM. (XX,YY,%INT)< DEFINE XX (STUFF)< %INT (,)> DEFINE %INT (NEW,OLD)< DEFINE XX (STUFF)< %INT (,)>> DEFINE YY < DEFINE %INT (NEW,OLD) XX ()> .XCREF %INT ;;[T36] > SUBTTL MOVX ;MOVX - LOAD AC WITH CONSTANT DEFINE MOVX (AC,MSK)< ..MX1==MSK ;;EVAL EXPRESSION IF ANY .IFN ..MX1,ABSOLUTE,< MOVE AC,[MSK]> .IF ..MX1,ABSOLUTE,< ..MX2==0 ;;FLAG SAYS HAVEN'T DONE IT YET IFE <..MX1>B53,< ..MX2==1 MOVEI AC,..MX1> ;;LH 0, DO AS RH IFE ..MX2,< ;;IF HAVEN'T DONE IT YET, IFE <..MX1>B17,< ..MX2==1 MOVSI AC,(..MX1)>> ;;RH 0, DO AS LH IFE ..MX2,< ;;IF HAVEN'T DONE IT YET, IFE <<..MX1>B53-^O777777>,< ..MX2==1 HRROI AC,<..MX1>>> ;;LH -1 IFE ..MX2,< ;;IF HAVEN'T DONE IT YET, IFE <<..MX1>B17-^O777777B17>,< ..MX2==1 HRLOI AC,(..MX1-^O777777)>> ;;RH -1 IFE ..MX2,< ;;IF STILL HAVEN'T DONE IT, MOVE AC,[..MX1]> ;;GIVE UP AND USE LITERAL >> ;MV., MVI. - Move from memory to memory or immediate to memory DEFINE MV. (FROM,TOO)< MOVE .SAC,FROM MOVEM .SAC,TOO> DEFINE MVI. (STUFF,DEST)< MOVX .SAC, MOVEM .SAC,DEST> ;VARIENT MNEMONICS FOR TX DEFINITIONS DEFINE IORX (AC,MSK)< TXO AC,> DEFINE ANDX (AC,MSK)< TXZ AC,<^->> DEFINE XORX (AC,MSK)< TXC AC,> SUBTTL TX -- TEST MASK ;CREATE THE TX MACRO DEFINITIONS ;THIS DOUBLE IRP CAUSES ALL COMBINATIONS OF MODIFICATION AND TESTING ;TO BE DEFINED DEFINE ..DOTX (M,T)< IRP M,< IRP T,< DEFINE TX'M'T (AC,MSK)< ..TX(M'T,AC,)>>>> ..DOTX (,<,E,N,A>) ;DO ALL DEFINITIONS PURGE ..DOTX ;..TX ;ALL TX MACROS JUST CALL ..TX WHICH DOES ALL THE WORK DEFINE ..TX(MT,AC,MSK)< ..TX1==MSK ;;EVAL EXPRESSION IF ANY .IFN ..TX1,ABSOLUTE,< TD'MT AC,[MSK]> .IF ..TX1,ABSOLUTE,< ;;MASK MUST BE TESTABLE ..TX2==0 ;;FLAG SAYS HAVEN'T DONE IT YET IFE <..TX1&^O777777B17>,< ..TX2==1 ;;LH 0, DO AS RH TR'MT AC,..TX1> IFE ..TX2,< ;;IF HAVEN'T DONE IT YET, IFE <..TX1&^O777777>,< ..TX2==1 ;;RH 0, DO AS LH TL'MT AC,(..TX1)>> IFE ..TX2,< ;;IF HAVEN'T DONE IT YET, IFE <<..TX1>B53-^O777777>,< ;;IF LH ALL ONES, ..TX3 (MT,AC)>> ;;TRY Z,O,C SPECIAL CASES IFE ..TX2,< ;;IF HAVEN'T DONE IT YET, IFE <..TX1+1>,< ;;TRY WORD ALL ONES ..TX4 (MT,AC)>> IFE ..TX2,< ;;IF STILL HAVEN'T DONE IT, TD'MT AC,[..TX1]> ;;MUST GIVE UP AND USE LITERAL >> ;SPECIAL CASE FOR LH ALL ONES DEFINE ..TX3 (MT,AC)< IFIDN ,< ;;IF ZEROING WANTED ..TX2==1 ANDI AC,^-..TX1> ;;CAN DO IT WITH ANDI IFIDN ,< ;;IF SET TO ONES WANTED ..TX2==1 ORCMI AC,^-..TX1> ;;CAN DO IT WITH IORCM IFIDN ,< ;;IF COMPLEMENT WANTED ..TX2==1 EQVI AC,^-..TX1>> ;;CAN DO IT WITH EQV ;SPECIAL CASE OF WORD ALL ONES DEFINE ..TX4 (MT,AC)< IFIDN ,< ..TX2==1 CAIN AC,0> ;;CAN DO FULL WORD COMPARE IFIDN ,< ..TX2==1 CAIE AC,0>> SUBTTL JX -- JUMP ON MASK ;JXE -- JUMP IF MASKED BITS ARE EQUAL TO 0 ;JXN -- JUMP IF MASKED BITS ARE NOT EQUAL TO 0 ;JXO -- JUMP IF MASKED BITS ARE ALL ONES ;JXF -- JUMP IF MASKED BITS ARE NOT ALL ONES (FALSE) DEFINE JXE (AC,MSK,BA)< ..JX1==MSK ;;EVAL EXPRESSION IF ANY .IFN ..JX1,ABSOLUTE, .IF ..JX1,ABSOLUTE,< .IF0 <<..JX1>-1B0>,< ;;IF MASK IS JUST B0, JUMPGE AC,BA>,< .IF0 <<..JX1>+1>,< ;;IF MASK IF FULL WORD, JUMPE AC,BA>,< ;;USE GIVEN CONDITION TXNN (AC,..JX1) JRST BA>>>> DEFINE JXN (AC,MSK,BA)< ..JX1==MSK ;;EVAL EXPRESSION IF ANY .IFN ..JX1,ABSOLUTE, .IF ..JX1,ABSOLUTE,< .IF0 <<..JX1>-1B0>,< ;;IF MASK IS JUST B0, JUMPL AC,BA>,< .IF0 <<..JX1>+1>,< ;;IF MASK IF FULL WORD, JUMPN AC,BA>,< ;;USE GIVEN CONDITION TXNE (AC,..JX1) JRST BA>>>> DEFINE JXO (AC,MSK,BA)< ..JX1==MSK ;;EVAL EXPRESSION .IFN ..JX1,ABSOLUTE, .IF ..JX1,ABSOLUTE,< .IF0 <<..JX1>-1B0>,< JUMPL AC,BA>,< ..ONEB (..BT,MSK) ;;TEST MASK FOR ONLY ONE BIT ON .IF0 ..BT,< SETCM .SAC,AC ;;GENERAL CASE, GET COMPLEMENTS OF BITS JXE (.SAC,..JX1,BA)>,< ;;JUMP IF BITS WERE ORIGINALLY ONES TXNE AC,..JX1 ;;TEST AND JUMP JRST BA>>>> DEFINE JXF (AC,MSK,BA)< ..JX1==MSK ;;EVAL EXPRESSION .IFN ..JX1,ABSOLUTE, .IF ..JX1,ABSOLUTE,< .IF0 <<..JX1>-1B0>,< JUMPGE AC,BA>,< ..ONEB (..BT,MSK) ;;TEST MASK FOR ONLY ONE BIT ON .IF0 ..BT,< SETCM .SAC,AC ;;GENERAL CASE, GET COMPLEMENT OF BITS JXN (.SAC,..JX1,BA)>,< ;;JUMP IF SOME ZEROS ORIGINALLY TXNN AC,..JX1 ;;TEST AND JUMP JRST BA>>>> SUBTTL MACSYM Definitions -- CAXxx ;GENERATE CAI OR CAM AS APPROPRIATE DEFINE CAX (AC,VAL), DEFINE CAXL (AC,VAL), DEFINE CAXLE (AC,VAL), DEFINE CAXE (AC,VAL), DEFINE CAXG (AC,VAL), DEFINE CAXGE (AC,VAL), DEFINE CAXN (AC,VAL), DEFINE CAXA (AC,VAL), DEFINE OP%%CA (AC,VALUE,CODE),< .XCREF IFE <_-^D18>,< .CREF CAI'CODE AC, .XCREF > IFN <_-^D18>,< .CREF CAM'CODE AC,[VALUE] .XCREF > .CREF> ;GENERATE IMMEDIATE OR MEMORY CONSTANTS DEFINE ADDX (AC,VAL), DEFINE SUBX (AC,VAL), DEFINE MULX (AC,VAL), DEFINE IMULX (AC,VAL), DEFINE DIVX (AC,VAL), DEFINE IDIVX (AC,VAL), DEFINE OP%%IA (AC,VALUE,CODE,ALT),< .XCREF TEST%%=0 IFE <<_-^D18>-^O777777>,< IFN <&^O777777>,< TEST%%=1 .CREF ALT'I AC,- .XCREF >> IFE TEST%%,< OP%%IN AC,,CODE > PURGE TEST%% .CREF> DEFINE OP%%IN (AC,VALUE,CODE),< .XCREF IFE <_-^D18>,< .CREF CODE'I AC, .XCREF > IFN <_-^D18>,< .CREF CODE AC,[VALUE] .XCREF > .CREF> ;GENERATE IMMEDIATE OR MEMORY FOR FLOATING POINT DEFINE FADRX (AC,VAL), DEFINE FSBRX (AC,VAL), DEFINE FMPRX (AC,VAL), DEFINE FDVRX (AC,VAL), DEFINE OP%%FP (AC,VALUE,CODE),< .XCREF IFE <_^D18>,< .CREF CODE'I AC,(VALUE) .XCREF > IFN <_^D18>,< .CREF CODE AC,[VALUE] .XCREF > .CREF> SUBTTL SUBFUNCTION MACROS ;.IF0 CONDITION, ACTION IF CONDITION 0, ACTION OTHERWISE DEFINE .IF0 (COND,THEN,ELSE)< ..IFT==COND ;;GET LOCAL VALUE FOR CONDITION IFE ..IFT,< THEN ..IFT==0> ;;RESTORE IN CASE CHANGED BY NESTED .IF0 IFN ..IFT,< ELSE>> ;CASE (NUMBER,) DEFINE .CASE (NUM,LIST)< ..CSN==NUM ..CSC==0 IRP LIST,< IFE ..CSN-..CSC,< STOPI ..CAS1 (LIST)> ..CSC==..CSC+1>> DEFINE ..CAS1 (LIST)< LIST> ;TEST FOR FULL WORD, RH, LH, OR ARBITRARY BYTE DEFINE ..TSIZ (SYM,MSK)< SYM==3 ;;ASSUME BYTE UNLESS... IFE +1, ;;FULL WORD IF MASK IS -1 IFE -^O777777, ;;RH IF MASK IS 777777 IFE -^O777777B17,> ;;LH IF MAST IS 777777,,0 ;TEST FOR LOC BEING AN AC -- SET SYM TO 1 IF AC, 0 IF NOT AC DEFINE ..TSAC (SYM,LOC)< SYM==0 ;;ASSUME NOT AC UNLESS... ..TSA1== ;;LOOK AT LOC .IF ..TSA1,ABSOLUTE,< ;;SEE IF WE CAN TEST VALUE IFE ..TSA1&^O777777777760,> ;;AC IF VALUE IS 0-17 > ;TEST FOR SPECIFIC NTH CHARACTER OF ARG DEFINE ..TSNC (SYM,NTH,STR,CH)< SYM==0 ;;ASSUME NO ..TSA1==0 ;;COUNT CHARS IRPC STR,< ..TSA1=..TSA1+1 IFE ..TSA1-NTH,< IFIDN ,< SYM==1> ;;YES STOPI>>> ;FUNCTION TO TEST FOR MASK CONTAINING EXACTLY ONE BIT. RETURNS ;1 IFF LEFTMOST BIT AND RIGHTMOST BIT ARE SAME DEFINE ..ONEB (SYM,MSK)< SYM==<<<->&>&<1B<^L>>>> ;DEFAULT SCRACH AC .SAC=16 SUBTTL DEFSTR -- DEFINE DATA STRUCTURE ;DEFINE DATA STRUCTURE ; NAM - NAME OF STRUCTURE AS USED IN CODE ; ****** NOTE THAT THE NAMES OF STRUCTURES USED MUST BE ****** ; ****** UNIQUE IN THE FIRST 5 CHARACTERS, FOR BOTH DEFSTR & MSKSTR ****** ; LOCN - ADDRESS OF DATA ; POS - POSITION OF DATA WITHIN WORD (RIGHTMOST BIT NUMBER) ; SIZ - SIZE OF DATA (IN BITS) WITHIN WORD DEFINE DEFSTR (NAM,LOCN,POS,SIZ)< NAM==<-1B+1B> ;;ASSIGN SYMBOL TO HOLD MASK IF1,> DEFINE %'NAM (OP,AC,Y,MSK)< $'NAM== ;;LOCATION SYMBOL FOR DDT OP (,LOCN''Y,MSK)>> ;;DEFINE MACRO TO HOLD LOCATION ;EXTENDED DEFSTR - REQUIRED IF LOCATION IS IN DIFFERENT SECTION DEFINE EDEFST (NAM,LOCN,POS,SIZ)< NAM==<-1B+1B> ;;ASSIGN SYMBOL TO HOLD MASK IF1,> DEFINE %'NAM (OP,AC,Y,MSK)< OP (,<@[EP. LOCN''Y]>,MSK)>> ;;DEFINE MACRO TO HOLD LOCATION ;ALTERNATE FORM OF DEFSTR -- TAKES MASK INSTEAD OF POS,SIZ DEFINE MSKSTR (NAM,LOCN,MASK)< NAM==MASK ;;ASSIGN SYMBOL TO HOLD MASK IF1,> DEFINE %'NAM (OP,AC,Y,MSK)< $'NAM== ;;LOCATION SYMBOL FOR DDT OP (,LOCN''Y,MSK)>> ;;DEFINE MACRO TO HOLD LOCATION DEFINE EMSKST (NAM,LOCN,MASK)< NAM==MASK ;;ASSIGN SYMBOL TO HOLD MASK IF1,> DEFINE %'NAM (OP,AC,Y,MSK)< OP (,<@[EP. LOCN''Y]>,MSK)>> ;;DEFINE MACRO TO HOLD LOCATION ;..STR0 - PROCESS INSTANCE OF STRUCTURE USAGE, SINGLE STRUCTURE CASE. DEFINE ..STR0 (OP,AC,STR,Y)< IFNDEF STR,,,.FWORD)> ;;RESERVE A WORD, ASSUME WORD MASK IFDEF STR,< IFNDEF %'STR,< OP (,,STR)> ;;ASSUME NO OTHER LOCN IFDEF %'STR,< %'STR (OP,,,STR)>>> ;;DO IT ;..STR1, ..STR2, ..STR3, AND ..STR4 ARE INTERNAL MACROS FOR PROCESSING ;INSTANCES OF STRUCTURE USAGE. DEFINE ..STR1 (OP,AC,STR,Y,CLL)< ..NS==0 ;;INIT COUNT OF STR'S IRP STR,<..NS=..NS+1> ;;COUNT STR'S IFE ..NS, IFE ..NS-1,< ;;THE ONE CASE, CAN DO FAST ..STR0 (OP,,,)> IFG ..NS-1,< ;;MORE THAN ONE, DO GENERAL CASE ..ICNS ;;INIT REMOTE MACRO ..CNS (,,>) ;;CONS ON CALL AND FIRST ARGS IRP STR,< ;;DO ALL NAMES IN LIST IFNDEF STR, IFDEF STR,< IFNDEF %'STR,< ..CNS (<,STR,Y>)> ;;ASSUME NO OTHER LOCN IFDEF %'STR,< %'STR (..STR2,,,STR)> ;;STR MACRO WILL GIVE LOCN TO ..STR2 ..CNS (<)>) ;;CLOSE ARG LIST ..GCNS ;;DO THIS AND PREVIOUS NAME ..ICNS ;;REINIT CONS ..CNS (>) ;;PUT ON FIRST ARGS IFNDEF %'STR,< ..CNS (<,STR,Y>)> ;;ASSUME NO OTHER LOCN IFDEF %'STR,< %'STR (..STR2,,,STR)>>> ;;PUT ON THIS ARG, END IRP ..CNS (<,,)>) ;;CLOSE ARG LIST ..GCNS>> ;;DO LAST CALL ;..STR2 -- CALLED BY ABOVE TO APPEND STRUCTURE NAME AND LOC TO ARG LIST DEFINE ..STR2 (AA,LOC,STR)< ..CNS (<,STR,LOC>)> ;;CONS ON NEXT ARG PAIR ;..STR3 -- CHECK FOR ALL STRUCTURES IN SAME REGISTER DEFINE ..STR3 (OP,AC,S1,L1,S2,L2)< IFDIF ,< IFNB ,< OP (,L1,..MSK) ;;DO ACCUMULATED STUFF IFNB ,> ..MSK==0> ;;INIT MASK IFNB ,< ..MSK=..MSK!>> ;..STR4 -- COMPARE SUCCESSIVE ITEMS, DO SEPARATE OPERATION IF ;DIFFERENT WORDS ENCOUNTERED DEFINE ..STR4 (OP,AC,S1,L1,S2,L2)< IFDIF ,< ;;IF THIS DIFFERENT FROM PREVIOUS IFNB ,< OP (,L1,..MSK)> ;;DO PREVIOUS ..MSK==0> ;;REINIT MASK IFNB ,< ..MSK=..MSK!>> ;;ACCUMULATE MASK ;..STR5 - SAME AS ..STR4 EXCEPT GIVES EXTRA ARG IF MORE STUFF TO ;FOLLOW. DEFINE ..STR5 (OP,AC,S1,L1,S2,L2)< IFDIF ,< ;;IF THIS DIFFERENT FROM PREVIOUS, IFNB ,< IFNB ,< ;;IF MORE TO COME, OP'1 (AC,L1,..MSK)> ;;DO VERSION 1 IFB ,< ;;IF NO MORE, OP'2 (AC,L1,..MSK)>> ;;DO VERSION 2 ..MSK==0> ;;REINIT MASK IFNB ,< ..MSK=..MSK!>> ;;ACCUMULATE MASK ;'REMOTE' MACROS USED TO BUILD UP ARG LIST ;INITIALIZE CONS -- DEFINES CONS DEFINE ..ICNS < DEFINE ..CNS (ARG)< ..CNS2 ,> DEFINE ..CNS2 (NEW,OLD)< DEFINE ..CNS (ARG)< ..CNS2 ,>> > ;GET CONS -- EXECUTE STRING ACCUMULATED DEFINE ..GCNS < DEFINE ..CNS2 (NEW,OLD)< OLD> ;;MAKE ..CNS2 DO THE STUFF ..CNS ()> ;;GET ..CNS2 CALLED WITH THE STUFF ;Structure Definition Macros ; ; Usage: ; ; BEGSTR XX,OFFSET,INDEX ; ;This initializes the macros to define offset symbols of the form ;XX.NAM; where NAM is the name of the individual field defined by the ;following macro. INDEX specifies an optional index AC that the ;structure will always be referenced by. ; ; FIELD NAME,WID,POS ; ;This defines a field name (3 characters) which describes the field of ;width WID and position POS. POS indicates the position of the ;rightmost bit of the field, in decimal as for the POINT pseudo-op. If ;POS is left out, the macro will place the field in the next available ;position in the word. If it doesn't fit in the word, it will start a ;new word, leaving the rest of the previous word unassigned. ; ; FIELDM NAME,MASK ; ;This defines a field name just as FIELD, but with a specific mask. No ;attempt is made to reposition the field. ; ; BIT NAM ; ;BIT defines the next available bit in the previously defined field. In ;addition to the normal mask XXNAM, a right justified symbol XX%NAM is ;defined which may be useful when one LOADs the flags into an AC ;performs some operations on them (using the XX%NAM symbol) and later ;stores them. The field definition preceding the call to BIT must have ;allocated enough room for all the BIT definitions following (up to the ;next FIELD). ; ; FILLER NUM ; ;FILLER will generate a blank field of NUM bits. Useful for aligning ;fields. ; ; NXTWRD NUM ; ;NXTWRD tells the macros that the next field definition should start a ;new word unconditionally. Giving NXTWRD NUM as an argument will skip ;NUM words without defining anything. ; ; WORD NAM,NUM ; ;This will define a single word (or NUM words) entry for NAM. Any ;unused bits in the previous word are left unassigned. ; ; HWORD NAM ; ;This defines a half-word (18 bit field) at the next available ;half-word boundary. Any unused bits in the previous half-word are left ;unassigned. ; ; ENDSTR NAM ; ;This generates the symbol XX.NAM which is the length of the block. If ;NAM is omitted, XX.LEN is used. ; ; FTSHOW ; ;This symbol is a feature test switch. If non-zero, the structure ;definitions will show their offsets and masks to the left of the ;definitions in a compiled listing. See SHOW. macro for additional ;information and warnings. ; ;N.B. ;Data locations defined by these macros are not guaranteed to be ;initialized to zero especially if FTSHOW is used. FTSHOW==1 ;FTSHOW DEFAULTS TO TRUE DEFINE BEGSTR(XX,OFFSET<0>,INDEX,BEGNAM),< IFN FTSHOW,..LOC==. DEFINE WORD(NAM,NUMB<1>),< IFN <..MSK>,<..OFF==..OFF+1> ;;IF THE MASK IS PARTIALLY USED, BUMP IT ..MSK==0 ;;RE-INITIALIZE THE MASK FIELDM(NAM,<.FWORD>) ;;DEFINE THE MASK, OFFSET AND MACRO ..MSK==0 ;;RE-INITIALIZE THE MASK ..OFF==..OFF+NUMB ;;AND BUMP THE OFFSET >;; END OF DEFINE WORD DEFINE NXTWRD(NUMB<1>),< ..MSK==0 ..OFF=..OFF+NUMB >;;END OF DEFINE NXTWRD DEFINE FILLER(NUM),< ..FLG==POS(..MSK) IFE ..MSK,<..FLG==-1> IFG <^D-<^D35-..FLG>>, ...MSK==MASK.(^D,<..FLG+^D>) IFN FTSHOW,< PHASE ..OFF EXP ...MSK > ..MSK==..MSK!...MSK >;;END OF DEFINE FILLER DEFINE HWORD(nam),< ..FLG==0 ;;HAVENT GOT ONE YET IFE ..MSK&.LHALF, IFE ..FLG,<..MSK==..MSK!.LHALF IFE ..MSK&.RHALF, IFE ..FLG, > > DEFINE FIELD(NAM,SIZ,POS),< ..FLG==0 ;;CLEAR THE "HAVE DEFINED FIELD" FLAG IFB ,,< ...MSK==.RTMSK(<<^-<<..MSK>>>>) ;;GET THE END OF THE CURRENT MASK IFE ...MSK,<..OFF==..OFF+1 ;;IF NO BITS LEFT ..MSK==0 ;;USE ALL OF NEXT WORD ...MSK==-1 > FIELDM(NAM,<...MSK>) ;;IF NO SIZE, USE THE REST ..FLG==-1 ;;AND SAY WE HAVE ONE >> IFNB ,<.SIZ==^D> ;;IF WE HAVE A SIZE, USE IT IFNB ,< ;;HAVE A POSITION?? FIELDM(NAM,MASK.(.SIZ,POS)) ;;YES, MAKE THE THING ..FLG==-1 ;;SAY WE HAVE IT ..BITS==MASK.(.SIZ,POS) ;;SET UP BITS FOR ..OLD > IFE ..FLG,-^D36>,< ;;IS THIS A WORD?? WORD(NAM,<^D<.SIZ>/^D36>) ;;YES, DEFINE THE FIRST SECOND IFN <<^D<.SIZ>-<^D<.SIZ>/^D36>*^D36>>,< ;;IS THERE MORE?? FIELD(...,<<^D<.SIZ>-<^D<.SIZ>/^D36>*^D36>>) ;;YES, GENERATE IT > ..FLG==-1 ;;SET THE "HAVE IT" FLAG >> IFE ..FLG,< ;;HAVE A PLACE YET?? ..BITS==MASK.(^D<.SIZ>,<^D<.SIZ>-1>) ;;NO, GET A MASK REPEAT <^D36-^D<.SIZ>+1>,< ;;FIND A PLACE IN THE WORD IFE ..FLG,< ;;HAVE ONE YET?? IFE <..BITS&..MSK>,< ;;NO, THIS ONE WORK?? ..MSK==..MSK!..BITS ;;YES, SET THE MASK ..FLG==-1 ;;AND FLAG WE HAVE ONE > ;; END OF IFE <..BITS&..MSK> IFE ..FLG,..BITS==..BITS_<-1> ;;MOVE OVER ONE BIT > > IFE ..FLG,< ;;HAVE A MASK YET?? ..BITS==MASK.(^D<.SIZ>,<^D<.SIZ>-1>) ;;NO, GET THE MASK AGAIN ..OFF==..OFF+1 ;;POINT TO NEXT WORD ..MSK==..BITS ;;AND SET THE MASK > MSKSTR(XX''NAM,\..OFF'INDEX,..BITS) ;;DEFINE THE STRUCTURE XX'.'NAM==..OFF IFN FTSHOW,< PHASE XX'.'NAM EXP XX''NAM >> ..OLD==..BITS ;;SAVE THE LAST MASK FOR BIT ...OLD==..BITS ;; MACRO CALL >;;END OF DEFINE FIELD DEFINE BIT(NAM),< ..BITS==LFTBT.(..OLD) ;;GET THE LEFTMOST BIT (ONE I CAN USE) IFE ..BITS, XX'%'NAM==..BITS_<-<^D35-POS(...OLD)>> ;;MAKE RIGHT JUSTIFIED MASK XX'.'NAM==..OFF ;;MAKE UP LOC SYMBOL MSKSTR(XX''NAM,\..OFF'INDEX,..BITS) ;;DEFINE THE MASK AND MACRO IFN FTSHOW,< PHASE ..OFF EXP XX''NAM > ..OLD==..OLD&<^-<..BITS>> ;;SHRINK THE MASK BY THE BIT WE USED >;;END OF DEFINE BIT DEFINE FIELDM(NAM,MASK),< IFN MASK&..MSK,< ;;WILL THIS BYTE FIT IN THE CURRENT WORD?? ..MSK==0 ;;NO, ADVANCE TO THE NEXT ..OFF==..OFF+1 > ..MSK==..MSK!MASK ;;FLAG THE PART WE USED MSKSTR(XX''NAM,\..OFF'INDEX,MASK) ;;DEFINE IT XX'.'NAM==..OFF IFN FTSHOW,< PHASE XX'.'NAM EXP XX''NAM > >;;END OF DEFINE FIELDM DEFINE ENDSTR(LENNAM,LSTNAM),< IFN ..MSK,<..OFF==..OFF+1> ;;BUMP THE OFFSET IF THERES SOME LEFT XX'.'LSTNAM==..OFF ;;SYMBOL FOR LAST ENTRY IFN FTSHOW,DEPHASE ..LOK==..LOK+1 IFN ..LOK, IF2,< IFDEF ...MSK, IFDEF ..BITS, IFDEF .SIZ, IFDEF ..MSK, IFDEF ..OFF, IFDEF ..FLG, IFDEF ..LOK, IFDEF ..LOC, IFDEF ..OLD, IFDEF ...OLD, > IF1,< IFDEF ...MSK,<.XCREF ...MSK> IFDEF ..BITS,<.XCREF ..BITS> IFDEF .SIZ,<.XCREF .SIZ> IFDEF ..MSK,<.XCREF ..MSK> IFDEF ..FLG,<.XCREF ..FLG> IFDEF ..OFF,<.XCREF ..OFF> IFDEF ..LOK,<.XCREF ..LOK> IFDEF ..LOC,<.XCREF ..LOC> IFDEF ..OLD,<.XCREF ..OLD> IFDEF ...OLD,<.XCREF ...OLD> > PURGE WORD,NXTWRD,FILLER,HWORD,FIELD,BIT,FIELDM XX'.'LENNAM==..OFF-OFFSET IFN FTSHOW,> ;;END OF DEFINE ENDSTR ..MSK==0 ;;INITIALIZE THE MASK ..OFF==OFFSET ;;AND THE OFFSET XX'.'BEGNAM==OFFSET ;;SYMBOL FOR BEGINNING OFFSET IFDEF ..LOK,> ..LOK==-1 >;;END OF DEFINE BEGSTR ;Special macros for the BEGSTR macros to use DEFINE LFTBT.(MASK) <1_<^D35-^L>> DEFINE MASK.(WID,POS),<<<<1_>-1>B>> ;;END OF DEFINE MASK. DEFINE .RTMSK(MASK),< )&<^-MASK>>>,>!)&<^-MASK> >><)&<^-MASK>>>)>_-1>>!)>>>> ;SPECIFIC CASES ;LOAD, STORE ; AC - AC OPERAND ; STR - STRUCTURE NAME ; Y - (OPTIONAL) ADDITIONAL SPECIFICATION OF DATA LOCATION DEFINE LOAD (AC,STR,Y)< ..STR0 (..LDB,AC,STR,)> DEFINE ..LDB (AC,LOC,MSK)< ..TSIZ (..PST,MSK) .CASE ..PST,<< MOVE AC,LOC>,< HRRZ AC,LOC>,< HLRZ AC,LOC>,< LDB AC,[POINT WID(),LOC,POS()]>>> ;LOADE is to LOAD as HRRE is to HRR ;LOADE is skippable, like other LOADs, at great expense in the LDB case DEFINE LOADE (AC,STR,Y)< ..STR0 (..LDBE,AC,STR,)> DEFINE ..LDBE (AC,LOC,MSK)< ..TSIZ (..PST,MSK) .CASE ..PST,<< MOVE AC,LOC>,< HRRE AC,LOC>,< HLRE AC,LOC>,< JSP .SAC,[LDB AC,[POINT WID(),LOC,POS()] ..MSK==MASK.(WID(MSK),35) TXNE AC,LFTBT.(..MSK) ;;TEST SIGN BIT OF BYTE TXO AC,^-..MSK ;;NEG, ALL 1S IN REST PURGE ..MSK JRST (.SAC)]>>> DEFINE STOR (AC,STR,Y)< ..STR0 (..DPB,AC,STR,)> DEFINE ..DPB (AC,LOC,MSK)< ..TSIZ (..PST,MSK) .CASE ..PST,<< MOVEM AC,LOC>,< HRRM AC,LOC>,< HRLM AC,LOC>,< DPB AC,[POINT WID(),LOC,POS()]>>> ;SET TO ZERO DEFINE SETZRO (STR,Y)< ..STR1 (..TQZ,,,,..STR4)> DEFINE ..TQZ (AC,LOC,MSK)< ..TSIZ (..PST,MSK) ;;SET ..PST TO CASE NUMBER .CASE ..PST,<< SETZM LOC>,< ;;FULL WORD HLLZS LOC>,< ;;RH HRRZS LOC>,< ;;LH ..TSAC (..ACT,LOC) ;;SEE IF LOC IS AC .IF0 ..ACT,< MOVX .SAC,MSK ;;NOT AC ANDCAM .SAC,LOC>,< ..TX (Z,LOC,MSK)>>>> ;SET TO ONE DEFINE SETONE (STR,Y)< ..STR1 (..TQO,,,,..STR4)> DEFINE ..TQO (AC,LOC,MSK)< ..TSIZ (..PST,MSK) .CASE ..PST,<< SETOM LOC>,< HLLOS LOC>,< HRROS LOC>,< ..TSAC (..ACT,LOC) .IF0 ..ACT,< MOVX .SAC,MSK IORM .SAC,LOC>,< ..TX (O,LOC,MSK)>>>> ;SET TO COMPLEMENT DEFINE SETCMP (STR,Y)< ..STR1 (..TQC,,,,..STR4)> DEFINE ..TQC (AC,LOC,MSK)< ..TSIZ (..PST,MSK) .IF0 ..PST,< ;;IF FULL WORD, SETCMM LOC>,< ;;CAN USE SETCMM ..TSAC (..ACT,LOC) ;;OTHERWISE, CHECK FOR AC .IF0 ..ACT,< MOVX .SAC,MSK XORM .SAC,LOC>,< ..TX(C,LOC,MSK)>>> ;INCREMENT, DECREMENT FIELD ;***WARNING*** FIELD OVERFLOWS MAY OCCUR ******** DEFINE INCR (STR,Y)< ..STR0 (.INCR0,,,)> DEFINE .INCR0 (AC,LOC,MSK)< ..PST==MSK&<-MSK> ;;GET LOWEST BIT .IF0 ..PST-1,< AOS LOC>,< ;;BIT 35, CAN USE AOS MOVX .SAC,..PST ;;LOAD A ONE IN THE APPROPRIATE POSITION ADDM .SAC,LOC>> DEFINE DECR (STR,Y)< ..STR0 (.DECR0,,,)> DEFINE .DECR0 (AC,LOC,MSK)< ..PST==MSK&<-MSK> .IF0 ..PST-1,< SOS LOC>,< ;;BIT 35, CAN USE SOS MOVX .SAC,-..PST ;;LOAD -1 IN APPROPRIATE POSITION ADDM .SAC,LOC>> ;GENERAL DEFAULT, TAKES OPCODE DEFINE OPSTR (OP,STR,Y)< ..STR0 (.OPST1,,,)> DEFINE .OPST1 (OP,LOC,MSK)< ..TSIZ (..PST,MSK) .IF0 ..PST,< OP LOC>,< ;;FULL WORD, USE GIVEN OP DIRECTLY ..LDB .SAC,LOC,MSK ;;OTHERWISE, GET SPECIFIED BYTE OP .SAC>> DEFINE OPSTRM (OP,STR,Y)< ..STR0 (.OPST2,,,)> DEFINE .OPST2 (OP,LOC,MSK)< ..TSIZ (..PST,MSK) .IF0 ..PST,< OP LOC>,< ;;FULL WORD, USE OP DIRECTLY ..LDB .SAC,LOC,MSK OP .SAC ..DPB .SAC,LOC,MSK>> ;JUMP IF ALL FIELDS ARE 0 (ONE REGISTER AT MOST) DEFINE JE (STR,Y,BA)< ..STR1 (..JE,,,,..STR3)> DEFINE ..JE (BA,LOC,MSK)< ..TSAC (..ACT,LOC) ;;SEE IF AC .IF0 ..ACT,< ..TSIZ (..PST,MSK) ;;SEE WHICH CASE .CASE ..PST,<< SKIPN LOC ;;FULL WORD, TEST IN MEMORY JRST BA>,< HRRZ .SAC,LOC ;;RIGHT HALF, GET IT JUMPE .SAC,BA>,< HLRZ .SAC,LOC ;;LEFT HALF, GET IT JUMPE .SAC,BA>,< MOVE .SAC,LOC ;;NOTA, GET WORD JXE (.SAC,MSK,)>>>,< JXE (LOC,MSK,)>> ;JUMP IF NOT ALL FIELDS ARE 0 (ONE REGISTER AT MOST) DEFINE JN (STR,Y,BA)< ..STR1 (..JN,,,,..STR3)> DEFINE ..JN (BA,LOC,MSK)< ..TSAC (..ACT,LOC) ;;SEE IF AC .IF0 ..ACT,< ..TSIZ (..PST,MSK) .CASE ..PST,<< SKIPE LOC ;;FULL WORD, TEST IN MEMORY JRST BA>,< HRRZ .SAC,LOC ;;RIGHT HALF, GET IT JUMPN .SAC,BA>,< HLRZ .SAC,LOC ;;LEFT HALF, GET IT JUMPN .SAC,BA>,< MOVE .SAC,LOC ;;NOTA, GET WORD JXN (.SAC,MSK,)>>>,< JXN (LOC,MSK,)>> ;JOR - JUMP ON 'OR' OF ALL FIELDS DEFINE JOR (STR,Y,BA)< ..STR1 (..JN,,,,..STR4)> ;JNAND - JUMP ON NOT 'AND' OF ALL FIELDS DEFINE JNAND (STR,Y,BA)< ..STR1 (..JNA3,,,,..STR4)> DEFINE ..JNA3 (BA,LOC,MSK)< ..TSAC (..ACT,LOC) .IF0 ..ACT,< SETCM .SAC,LOC ;;NOT AC, GET COMPLEMENT OF WORD JXN (.SAC,MSK,)>,< ;;JUMP IF ANY BITS ORIGINALLY OFF JXF (LOC,MSK,)>> ;;DO AC CASE ;JAND - JUMP ON 'AND' OF ALL FIELDS DEFINE JAND (STR,Y,BA,%TG)< ..STR1 (..JAN,<%TG,>,,,..STR5) %TG:! .XCREF %TG > ;;[T36] DEFINE ..JAN1 (BA1,BA2,LOC,MSK)< ..JNA3 (BA1,LOC,MSK)> ;;DO JUMP NAND TO LOCAL TAG DEFINE ..JAN2 (BA1,BA2,LOC,MSK)< ..TSAC (..ACT,LOC) .IF0 ..ACT,< SETCM .SAC,LOC ;;NOT AC, GET COMPLEMENT OF WORD JXE (.SAC,MSK,)>,< ;;JUMP IF ALL BITS ORIGINALLY ONES JXO (LOC,MSK,)>> ;;DO AC CASE ;JNOR - JUMP ON NOT 'OR' OF ALL FIELDS DEFINE JNOR (STR,Y,BA,%TG)< ..STR1 (..JNO,<%TG,>,,,..STR5) %TG:! .XCREF %TG> ;;[T36] DEFINE ..JNO1 (BA1,BA2,LOC,MSK)< ..JN (BA1,LOC,MSK)> ;;DO JUMP OR TO LOCAL TAG DEFINE ..JNO2 (BA1,BA2,LOC,MSK)< ..JE (,LOC,MSK)> ;;DO JUMP NOR TO GIVEN TAG ;TEST AND MODIFY GROUP USING DEFINED STRUCTURES. TEST-ONLY AND ;MODIFY-ONLY PROVIDED FOR COMPLETENESS. ;GENERATES EXACTLY ONE INSTRUCTION DEFINE ..DOTY (M,T)< ;;MACRO TO DEFINE ALL CASES IRP M,< IRP T,< DEFINE TQ'M'T (STR,Y)< ..STR1 (..TY,M'T,,,..STR3)>>>> ..DOTY (,<,E,N,A>) ;DO 16 DEFINES PURGE ..DOTY ;SPECIAL DEFINE FOR THE TWO CASES WHICH CAN TAKE MEMORY ARG ;*NOTE* MAY GENERATE MORE THAN ONE INSTRUCTION - CANNOT BE SKIPPED DEFINE TMNE (STR,Y)< ..STR1 (..TYNE,,,,..STR3)> DEFINE ..TYNE (MT,LOC,MSK)< ..TSAC (..ACT,LOC) ;;SEE IF LOC IS AC .IF0 ..ACT,< ..JX1==MSK .IF0 <..JX1-1B0>,< SKIPGE LOC>,< .IF0 <..JX1+1>,< SKIPE LOC>,< MOVE .SAC,LOC TXNE .SAC,MSK>>>,< TXNE LOC,MSK>> DEFINE TMNN (STR,Y)< ..STR1 (..TYNN,,,,..STR3)> DEFINE ..TYNN (MT,LOC,MSK)< ..TSAC (..ACT,LOC) ;;SEE IF LOC IS AC .IF0 ..ACT,< ..JX1==MSK .IF0 <..JX1-1B0>,< SKIPL LOC>,< .IF0 <..JX1+1>,< SKIPN LOC>,< MOVE .SAC,LOC TXNN .SAC,MSK>>>,< TXNN LOC,MSK>> ;ALL TY MACROS CALL ..TY AFTER INITIAL STRUCTURE PROCESSING DEFINE ..TY (MT,LOC,MSK)< ..TSAC (..ACT,LOC) ;;SEE IF LOC IS AC .IF0 ..ACT,< PRINTX ?TQ'MT - LOC NOT IN AC>,< TX'MT LOC,MSK>> SUBTTL BLOCK MACROS ;MACROS TO PROVIDE SOME BLOCK HANDLING OF CODE ;BLOCK., ENDBK. - Creates block within which stack variables, AC ;saving macros, etc. may be used. ;Control must flow into and out of block through BLOCK. and ENDBK. macros. ;Within block, RET or equivalent may be used to exit block. DEFINE BLOCK. (%TGE)< ..SVBK ;;SAVE CURRENT BLOCK XMOVEI .A16,%TGE ;;PUT DUMMY RETURN ON STACK PUSH P,.A16 DEFINE ENDBK. < RET ;;POP STACK AND CONTINUE AT .+1 %TGE:! .XCREF %TGE ;;[T36] DUMMY RETURNS COMES HERE .POPX>> ;;RESTORE DEFS DEFINE ..SVBK (%SY1)< SYN ENDBK.,%SY1 .PSHX < SYN %SY1,ENDBK.> .XCREF %SY1 > ;;[T36] ;DO. - LOOP STRUCTURE, DECLARES TOP OF LOOP ; LOOP. - JUMPS TO TOP OF LOOP ; EXIT. - EXITS LOOP ; TOP. - TAG AT TOP OF LOOP FOR JUMPS, E.G. SOJG T4,TOP. ; ENDLP. - TAG AT END OF LOOP FOR JUMPS, E.G. SOJL T4,ENDLP. DEFINE DO. (%TGB,%TGE)< ..SVLD ;;SAVE CURRENT BLOCK %TGB:! .XCREF %TGB ;;[T36] TOP OF LOOP DEFINE OD. < %TGE:! .XCREF %TGE ;;[T36] END OF LOOP .POPX> ;;RESTORE DEFS DEFINE LOOP. < JRST %TGB> ;;LOOP TO TOP DEFINE TOP. <%TGB> ;;LABEL AT TOP FOR JUMPS DEFINE ENDLP. <%TGE> ;;LABEL AT END FOR JUMPS DEFINE EXIT. < JRST %TGE>> ;;EXIT LOOP DEFINE ENDDO. < OD.> DEFINE ..SVLD (%SY1,%SY2,%SY3,%SY4,%SY5)< SYN OD.,%SY1 SYN LOOP.,%SY2 SYN TOP.,%SY3 SYN EXIT.,%SY4 SYN ENDLP.,%SY5 .XCREF %SY1,%SY2,%SY3,%SY4,%SY5 ;;[T36] .PSHX < SYN %SY1,OD. SYN %SY2,LOOP. SYN %SY3,TOP. SYN %SY4,EXIT. SYN %SY5,ENDLP.> > ;IFNSK., IFSKP. - "IF NO SKIP", "IF SKIP" ;These macros cause the following code to be conditionally executed ;depending on whether the preceding instruction(s) skipped or not. ;The following code is ended with ENDIF., with ELSE. optional ;within the range. ;Note: both of these result in the same or fewer instructions than ;the use of literals to handle the same cases. ;Also, since the code is not in literals, the binary appears in the ;listing, and the code is easier to follow with DDT. ;If the preceding skip can be written in either sense, it is better ;to use IFSKP. because one fewer instructions will be generated. ;IFSKP. and IFNSK. have an alternate form where the consequence code ;is given as a macro argument. In the normal case, no macro argument is given. ;"IF NO SKIP" CONSEQUENCE-CODE ALTERNATIVE-CODE ;If the instruction(s) preceding the macro does not skip, the 'consequence ; code' will be executed; otherwise (i.e. if the instruction skips) the ; 'alternative code' will be executed. DEFINE IFNSK. (NSCOD,SKCOD,%TG1,%TG2)< IFB ,< ;;THE REGULAR FORM ..SVDF ;;SAVE DEFINITIONS OF OUTER BLOCK TRNA ;;SKIP JRST %TG1 ;;JUMP PAST CODE DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;SAVE THE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;SAVE THE END TAG > IFNB ,< ;;THE ALTERNATE FORM JRST %TG1 ;;THE NOSKIP CASE SKCOD JRST %TG2 %TG1:! NSCOD %TG2:! .XCREF %TG1,%TG2 ;;[T36] >> ;If JSYS Error DEFINE IFJER. (NSCOD,SKCOD,%TG1,%TG2,%TG3)< IFB ,< ;;THE REGULAR FORM ..SVDF ;;SAVE DEFINITIONS OF OUTER BLOCK ERJMP %TG3 ;;SKIP JRST %TG1 ;;JUMP PAST CODE %TG3:! DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;SAVE THE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;SAVE THE END TAG > IFNB ,< ;;THE ALTERNATE FORM ERJMP %TG1 ;;THE NOSKIP CASE SKCOD JRST %TG2 %TG1:! NSCOD %TG2:! .XCREF %TG1,%TG2,%TG3 ;;[T36] >> ;VERSION OF JSYS ERROR HANDLER WHICH ALLOWS SPECIFICATION OF ERJMP TYPE. DEFINE IFJE. (TYPE,NSCOD,SKCOD,%TG1,%TG2,%TG3)< IFB ,< ;;THE REGULAR FORM ..SVDF ;;SAVE DEFINITIONS OF OUTER BLOCK ERJMP'TYPE %TG3 ;;SKIP JRST %TG1 ;;JUMP PAST CODE %TG3:! DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;SAVE THE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;SAVE THE END TAG > IFNB ,< ;;THE ALTERNATE FORM ERJMP'TYPE %TG1 ;;THE NOSKIP CASE SKCOD JRST %TG2 %TG1:! NSCOD %TG2:! .XCREF %TG1,%TG2,%TG3 ;;[T36] >> ;OBSOLETE NAME DEFINE IFNES. (ARG1,ARG2)< PRINTX % IFNES. should be changed to IFJER. IFJER. ,> ;"IF SKIP" CONSEQUENCE-CODE ;If the instruction(s) preceding the macro skips, the 'consequence ; code' will be executed. DEFINE IFSKP. (SKCOD,%TG,%TG2)< IFB ,< ;;REGULAR FORM ..SVDF ;;SAVE DEFINITIONS OF OUTER BLOCK JRST %TG DEFINE ..TAGF (INST,PCT)< INST %TG''PCT> ;;SAVE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;SAVE END TAG > IFNB ,< JRST %TG SKCOD %TG:! .XCREF %TG ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined >> ;If No JSYS Error DEFINE IFNJE. (SKCOD,%TG,%TG2)< IFB ,< ;;REGULAR FORM ..SVDF ;;SAVE DEFINITIONS OF OUTER BLOCK ERJMP %TG DEFINE ..TAGF (INST,PCT)< INST %TG''PCT> ;;SAVE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;SAVE END TAG > IFNB ,< ERJMP %TG SKCOD %TG:! .XCREF %TG ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined >> ;VERSION WHICH ALLOWS SPECIFICATION OF ERJMP TYPE DEFINE IFJN. (TYPE,SKCOD,%TG,%TG2)< IFB ,< ;;REGULAR FORM ..SVDF ;;SAVE DEFINITIONS OF OUTER BLOCK ERJMP'TYPE %TG DEFINE ..TAGF (INST,PCT)< INST %TG''PCT> ;;SAVE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;SAVE END TAG > IFNB ,< ERJMP'TYPE %TG SKCOD %TG:! .XCREF %TG ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined >> ;OBSOLETE NAME DEFINE IFESK. (ARG)< PRINTX % IFESK. should be changed to IFNJE. IFNJE. > ;CONDITIONALS WHICH REPRESENT JUMP CASES - I.E. AC L, LE, G, ETC. ; IF CONDITION IS SATISFIED, DO BRACKETTED CODE DEFINE IFE. (AC,%TG1,%TG2)< JUMPN AC,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFN. (AC,%TG1,%TG2)< JUMPE AC,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFG. (AC,%TG1,%TG2)< JUMPLE AC,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFGE. (AC,%TG1,%TG2)< JUMPL AC,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFLE. (AC,%TG1,%TG2)< JUMPG AC,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFL. (AC,%TG1,%TG2)< JUMPGE AC,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFXE. (AC,MASK,%TG1,%TG2)< JXN AC,MASK,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFXN. (AC,MASK,%TG1,%TG2)< JXE AC,MASK,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFQE. (STR,Y,%TG1,%TG2)< JN ,,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > DEFINE IFQN. (STR,Y,%TG1,%TG2)< JE ,,%TG1 ;;JUMP IF NOT CONDITION ..SVDF ;;SAVE OUTER BLOCK DEFINE ..TAGF (INST,PCT)< INST %TG1''PCT> ;;DEFINE FALSE TAG DEFINE ..TAGE (INST,PCT)< INST %TG2''PCT> ;;DEFINE END TAG .XCREF %TG1 ;;[T36] IFDEF %TG2,<.XCREF %TG2> ;;[T36] Only purge if it is defined > ;GENERAL CASES WITHIN CONDITIONALS ;"AND SKIP" DEFINE ANSKP. < ..TAGF (JRST,)> ;;JUMP TO 'FALSE' DEFINE ANNSK. < TRNA ..TAGF (JRST,)> ;;JUMP TO 'FALSE' DEFINE ANNJE. < ..TAGF (ERJMP,)> ;;[9162] Jump to "false" on JSYS error DEFINE ELSE. <....U> ;;UNDEFINED UNTIL BLOCK ENTERED DEFINE ENDIF. <....U> DEFINE ..TAGF <....U> DEFINE ..TAGE <....U> ;"AND E" ETC. DEFINE ANDE. (AC)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDN. (AC)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDG. (AC)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDGE. (AC)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDLE. (AC)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDL. (AC)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDXE. (AC,MASK)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDXN. (AC,MASK)< ..TAGF (,)> ;;JUMP IF NOT CONDITION DEFINE ANDQE. (STR,Y)< ..TAGF (,,>,)> ;;JUMP IF NOT CONDITION DEFINE ANDQN. (STR,Y)< ..TAGF (,,>,)> ;;JUMP IF NOT CONDITION ;LOCAL WORKER MACROS ;THIS INITS THE DEFINITIONS OF ELSE. AND ENDIF. WHEN ENTERING A ;NEW BLOCK. DEFINE ..INDF < DEFINE ELSE. < ..TAGE (JRST,) ;;JUMP TO END ..TAGF (,<:!>) ;;DEFINE THE FALSE TAG SYN ..TAGE,..TAGF ;;MAKE FALSE EQUIVALENT TO END DEFINE ELSE. <....U>> ;;ELSE CAN APPEAR ONCE ONLY DEFINE ENDIF. < ..TAGF (,<:!>) ;;DEFINE FALSE TAG ..RSDF> ;;RESTORE DEFINITIONS OF OUTER BLOCK > ;SAVE DEFINITIONS DEFINE ..SVDF (%SY1,%SY2,%SY3,%SY4)< SYN ELSE.,%SY1 SYN ENDIF.,%SY2 SYN ..TAGF,%SY3 SYN ..TAGE,%SY4 .XCREF %SY1,%SY2,%SY3,%SY4 ;;[T36] .PSHX < SYN %SY1,ELSE. SYN %SY2,ENDIF. SYN %SY3,..TAGF SYN %SY4,..TAGE> ..INDF ;;REINIT DEFS > DEFINE ..RSDF < .POPX> ;MACROS TO PUSH/POP STRINGS DEFINE .PSHX (STUFF)< .PSHX1 (.PSHX2,)> DEFINE .PSHX1 (WCH,STUFF)< WCH ()> DEFINE .PSHX2 (OLD)< DEFINE .PSHX1 (WCH,STUFF)< WCH (<,>)>> DEFINE .POPX < .PSHX1 (.POPX2)> DEFINE .POPX2 (STUFF)< .POPX4 STUFF> DEFINE .POPX4 (JUNK,STUFF)< .POPX3 STUFF> DEFINE .POPX3 (TOP,REST)< TOP DEFINE .PSHX1 (WCH,STUFF)< WCH (<,>)>> SUBTTL CALL, RET, JSERR IFE REL,< EXTERN JSERR0,JSMSG0,JSHLT0,R,RSKP> ;CALL AND RETURN .AC1==1 ;ACS FOR JSYS ARGS .AC2==2 .AC3==3 .A16==16 ;TEMP FOR STKVAR AND TRVAR P=17 ;STACK POINTER OPDEF CALL [PUSHJ P,0] OPDEF RET [POPJ P,0] ;ABBREVIATION FOR CALL, RET, RETSKP OPDEF CALLRET [JRST] .NODDT CALLRET DEFINE RETSKP SUBTTL ;MACRO TO PRINT MESSAGE ON TERMINAL DEFINE TMSG ($MSG)< HRROI .AC1,[ASCIZ \$MSG\] PSOUT> ;MACRO TO OUTPUT MESSAGE TO FILE ; ASSUMES JFN ALREADY IN .AC1 DEFINE FMSG ($MSG)< HRROI .AC2,[ASCIZ \$MSG\] MOVEI .AC3,0 SOUT> ;MACRO TO PRINT MESSAGE FOR LAST ERROR, RETURNS +1 DEFINE PERSTR ($MSG)< IFNB <$MSG>,< TMSG <$MSG>> CALL JSMSG0> ;MACRO TO PRINT JSYS ERROR MESSAGE, RETURNS +1 ALWAYS OPDEF JSERR[] OPDEF EJSERR[] ;Since MACRO couldn't handle OPDEF of an OPDEF ; (i.e. ERCAL) defined elsewhere, use JUMP 17, ; instead ;MACRO FOR FATAL JSYS ERROR, PRINTS MSG THEN HALTS OPDEF JSHLT[] OPDEF EJSHLT[] ;Since MACRO couldn't handle OPDEF of an OPDEF ; (i.e. ERCAL) defined elsewhere, use JUMP 17, ; instead ;PRINT ERROR MESSAGE IF JSYS FAILS DEFINE ERMSG(TEXT),< ERJMP [TMSG JSHLT] > ;MAKE SYMBOLS EXTERN IF NOT ALREADY DEFINED DEFINE EXT (SYM)< IF2,< IRP SYM,< IFNDEF SYM,>>> ;MACRO TO ADD BREAK CHARACTER TO FOUR WORD BREAK MASK (W0., W1., W2., W3.) DEFINE BRKCH. (%%V,V2) < %%FOO==%%V BRK0 (%%FOO,V2,0) > ;MACRO TO REMOVE CHARACTER DEFINE UNBRK. (%%V,V2) < %%FOO==%%V BRK0 (%%FOO,V2,1) > DEFINE BRK0 (%%11,V2,FLAVOR) < ..V22==%%11 ..V1==%%11 IFNB ,<..V22==V2> REPEAT ..V22-<%%11>+1,< ;;BRACKETS AROUND %%11 IN CASE ITS AN EXPRESSION %%W==..V1/^D32 ;;DECIDE WHICH WORD CHARACTER GOES IN %%X==..V1-%%W*^D32 ;;CALCULATE BIT POSITION WITHIN WORD IFE FLAVOR,BRKC1 \"<%%W+"0"> ;;MODIFY CORRECT MASK WORD IFN FLAVOR,BRKC2 \"<%%W+"0"> ..V1==..V1+1 > > DEFINE BRKC1 (ARG1) < W'ARG1'.==W'ARG1'.!<1B<%%X>> > DEFINE BRKC2 (ARG1) < W'ARG1'.==W'ARG1'.&<-1-1B<%%X>> > ;MACRO TO INITIALIZE 4-WORD 12-BIT CHARACTER BREAK MASK DEFINE BRINI.(A0<0>,A1<0>,A2<0>,A3<0>) < W0.==A0 W1.==A1 ;INITIALIZE BREAK MASK W2.==A2 W3.==A3 > ;MACRO TO DEFINE A BREAK SET DEFINE BRMSK. (INI0,INI1,INI2,INI3,ALLOW,DISALW) < BRINI. INI0,INI1,INI2,INI3 ;;SET UP INITIAL MASK IRPC ALLOW,< UNBRK. "ALLOW"> ;;DON'T BREAK ON CHARS TO BE ALLOWED IN FIELD IRPC DISALW,< BRKCH. "DISALW"> ;;BREAK ON CHARACTERS NOT ALLOWED EXP W0.,W1.,W2.,W3. ;;STORE RESULTANT MASK IN MEMORY > ;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK ;THIS IS THE OLD ONE, BEFORE .CMBRK EXISTED. USE FLDBK. FOR SPECIFYING ;BREAK SETS DEFINE FLDDB. (TYP,FLGS,DATA,HLPM,DEFM,LST)< ..XX==+FLGS+<0,,LST> IFNB ,<..XX=CM%HPP!..XX> IFNB ,<..XX=CM%DPP!..XX> ..XX IFNB , IFB ,<0> IFNB , IFB ,,<0>> IFNB ,> ;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK DEFINE FLDBK. (TYP,FLGS,DATA,HLPM,DEFM,BRKADR,LST)< ..XX==+FLGS+ IFNB ,<..XX=CM%HPP!..XX> IFNB ,<..XX=CM%DPP!..XX> IFNB ,<..XX=CM%BRK!..XX> ..XX IFNB , IFB ,<0> IFNB , IFB ,,<0>> IFB ,,<0>> IFNB , IFNB , > ;USEFUL EXTENDED ADDRESSING DEFINITIONS OPDEF XMOVEI [SETMI] ;EXTENDED MOVE IMMEDIATE OPDEF XHLLI [HLLI] ;NOT YET IN MACRO DEFINE XBLT. (A)< EXTEND A,[XBLT]> SUBTTL SUPPORT CODE FOR JSERR IFN REL,< A=1 B=2 C=3 D=4 ;JSYS ERROR HANDLER ; CALL JSERR0 ; RETURNS +1: ALWAYS, CAN BE USED IN +1 RETURN OF JSYS'S JSERR0::MOVEI A,.PRIIN CFIBF ;CLEAR TYPAHEAD MOVEI A,.PRIOU DOBE ;WAIT FOR PREVIOUS OUTPUT TO FINISH TMSG < ? JSYS ERROR: > JSMSG0::MOVEI A,.PRIOU HRLOI B,.FHSLF ;SAY THIS FORK ,, LAST ERROR SETZ C, ERSTR JFCL JFCL TMSG < > RET ;FATAL JSYS ERROR - PRINT MESSAGE AND HALT ; CALL JSHLT0 ; RETURNS: NEVER JSHLT0::CALL JSERR0 ;PRINT THE MSG JSHLT1: HALTF TMSG JRST JSHLT1 ;HALT AGAIN IF CONTINUED > ;END OF IFN REL, SUBTTL STKVAR - STACK VARIABLE FACILITY ;MACRO FOR ALLOCATING VARIABLES ON THE STACK. ITS ARGUMENT IS ;A LIST OF ITEMS. EACH ITEM MAY BE: ; 1. A SINGLE VARIABLE WHICH WILL BE ALLOCATED ONE WORD ; 2. A VARIABLE AND SIZE PARAMETER WRITTEN AS . THE ; VARIABLE WILL BE ALLOCATED THE SPECIFIED NUMBER OF WORDS. ;RETURN FROM A SUBROUTINE USING THIS FACILITY MUST BE VIA ;RET OR RETSKP. A DUMMY RETURN WHICH FIXES UP THE STACK IS PUT ON ;THE STACK AT THE POINT THE STKVAR IS ENCOUNTERED. ;WITHIN THE RANGE OF A STKVAR, PUSH/POP CANNOT BE USED AS THEY WILL ;CAUSE THE VARIABLES (WHICH ARE DEFINED AS RELATIVE STACK LOCATIONS) ;TO REFERENCE THE WRONG PLACE. ;**note that the SAVE macros use PUSH & POP, so STKVAR macro must occur ; after any such in a routine. ;**also note that no blanks are allowed in the list, i.e., ; STKVAR will not work. ;TYPICAL USE: STKVAR ,ZZ> ; ENDSV. ;END OF SCOPE OF NAMES IFE REL,< EXTERN .XSTKS,.XSTKR> DEFINE STKVAR (ARGS)< ..STKR==10 ;;REMEMBER RADIX RADIX 8 ..STKN==0 IRP ARGS,< .STKV1 (ARGS)> JSP .A16,.XSTKS ;Call internal routine for allocation EXP ..STKN ;Size of block to allocate RADIX ..STKR DEFINE ENDSV.<.ENSV1 > > ;INTERMEDIATE MACRO TO PEAL OFF ANGLEBRACKETS IF ANY DEFINE .STKV1 (ARG)< .STKV2 (ARG)> ;INTERMEDIATE MACRO TO CALCULATE OFFSET AND COUNT VARIABLES DEFINE .STKV2 (VAR,SIZ)< IFB ,<..STKN==..STKN+1> IFNB ,< ...X==SIZ IF2,<.IFN ...X,ABSOLUTE,> ..STKN==..STKN+...X> ..STKQ==..STKN+1 .STKV3 (VAR,\..STKQ)> ;INNERMOST MACRO TO DEFINE VARIABLE DEFINE .STKV3 (VAR,LOC)< IFDEF VAR,<.IF VAR,SYMBOL,> DEFINE VAR<-^O'LOC(P)> $'VAR==> ;SYMBOL FOR DDT ;CLEANUP NAMES DEFINE .ENSV1 (ARGS)< IRP ARGS,< .ENSV2 (ARGS)>> DEFINE .ENSV2 (ARG)< .ENSV3 (ARG)> DEFINE .ENSV3 (ARG,SIZ)< DEFINE ARG<....U>> IFN REL,< ;COMMON ENTRY AND EXIT ROUTINE FOR STACK VARIABLE ENTRY .STKST ;This code assumes local format stack pointers which can detect only ; stack overflow (not stack underflow). This code is left intact ; because there may be old .REL files which contain a JSP to .STKST ; instead of the new way to .XSTKS and also expect the block size ; following the JSP to be in the form n,,n instead of just EXP n. This ; code is left purely for compatibility and may one day be removed. .STKST::ADD P,0(.A16) ;BUMP STACK FOR VARIABLES USED JUMPGE P,STKSOV ;TEST FOR STACK OVERFLOW STKSE1: PUSH P,0(.A16) ;SAVE BLOCK SIZE FOR RETURN PUSHJ P,1(.A16) ;CONTINUE ROUTINE, EXIT TO .+1 .STKRT::JRST STKRT0 ;NON-SKIP RETURN COMES HERE POP P,.A16 ;SKIP RETURN COMES HERE-RECOVER COUNT SUB P,.A16 ;ADJUST STACK TO REMOVE BLOCK AOS 0(P) ;NOW DO SKIP RETURN RET STKRT0: POP P,.A16 ;RECOVER COUNT SUB P,.A16 ;ADJUST STACK TO REMOVE BLOCK RET ;DO NON-SKIP RETURN STKSOV: SUB P,0(.A16) ;STACK OVERFLOW- UNDO ADD HLL .A16,0(.A16) ;SETUP TO DO MULTIPLE PUSH, GET COUNT STKSO1: PUSH P,[0] ;DO ONE PUSH AT A TIME, GET REGULAR SUB .A16,[1,,0] ; ACTION ON OVERFLOW TLNE .A16,777777 ;COUNT DOWN TO 0? JRST STKSO1 ;NO, KEEP PUSHING JRST STKSE1 ;This is the new internal routine for STKVAR which can work with both ; local and global format stack pointers because the ADJSP instruction ; is used. It differs from the previous code in two ways. 1) The block ; size for the allocation is NOT duplicated in BOTH halves of the word ; following the JSP. 2) The code does not check for stack overflow ; because ADJSP will set TRAP 2 for us. ENTRY .XSTKS .XSTKS::ADJSP P,@0(.A16) ;Adjust stack pointer for variables used PUSH P,0(.A16) ;Save block size for return PUSHJ P,1(.A16) ;Call routine and return following here .XSTKR::IFSKP. ;Skip return comes here so POP P,.A16 ; recover count, MOVNS .A16 ; get size for deallocation, ADJSP P,(.A16) ; adjust stack to remove block, AOS 0(P) ; and now adjust for skip return ELSE. ;Now for Non-Skip return so POP P,.A16 ; recover count, MOVNS .A16 ; get size for deallocation, ADJSP P,(.A16) ; and adjust stack to remove block ENDIF. RET ;Now just return > ;END OF IFN REL, SUBTTL TRVAR - TRANSIENT VARIABLE FACILITY ;TRANSIENT (STACK) VARIABLE FACILITY - EQUIVALENT TO STKVAR ;EXCEPT ALLOWS VARIABLES TO BE USED WITHIN LOWER LEVEL ROUTINES ;AND AFTER OTHER THINGS HAVE BEEN PUSHED ON STACK. ;N.B. USES .FP AS FRAME POINTER - MUST NOT BE CHANGED WHILE ;VARIABLES IN USE. .FP==15 ;DEFAULT FRAME POINTER IFE REL,< EXTERN .XTRST,.XTRRT> DEFINE TRVAR (VARS)< ..TRR==10 ;;REMEMBER CURRENT RADIX RADIX 8 ..NV==1 ;;INIT COUNT OF STACK WORDS IRP VARS,< .TRV1 (VARS)> ;;PROCESS LIST JSP .A16,.XTRST ;;ALLOCATE STACK SPACE, SETUP .FP EXP ..NV-1 ;Size of block to allocate RADIX ..TRR ;;RESTORE RADIX DEFINE ENDTV.<.ENSV1 > > DEFINE .TRV1 (VAR)< .TRV2 (VAR)> ;;PEEL OFF ANGLEBRACKETS IF ANY DEFINE .TRV2 (NAM,SIZ)< .TRV3 (NAM,\..NV) ;;DEFINE VARIABLE IFB ,<..NV=..NV+1> IFNB ,< ...X==SIZ IF2,<.IFN ...X,ABSOLUTE,> ..NV=..NV+...X>> DEFINE .TRV3 (NAM,LOC)< IFDEF NAM,<.IF NAM,SYMBOL,> DEFINE NAM<^O'LOC(.FP)> $'NAM==> ;;SYMBOL FOR DDT IFN REL,< ;SUPPORT ROUTINE FOR TRVAR ;This code assumes local format stack pointers which can detect only ; stack overflow (not stack underflow). This code is left intact ; because there may be old .REL files which contain a JSP to .TRSET ; instead of the new way to .XTRST and also expect the block size ; following the JSP to be in the form n,,n instead of just EXP n. This ; code is left purely for compatibility and may one day be removed. .TRSET::PUSH P,.FP ;PRESERVE OLD .FP MOVE .FP,P ;SETUP FRAME PTR ADD P,0(.A16) ;ALLOCATE SPACE JUMPGE P,TRSOV TRSET1: PUSHJ P,1(.A16) ;CONTINUE ROUTINE, EXIT VIA .+1 .TRRET::JRST [ MOVEM .FP,P ;CLEAR STACK POP P,.FP ;RESTORE OLD .FP POPJ P,] MOVEM .FP,P ;HERE IF SKIP RETURN POP P,.FP AOS 0(P) ;PASS SKIP RETURN POPJ P, TRSOV: MOVE P,.FP ;STACK OVERFLOW, UNDO ADD PUSH P,.A16 ;SAVE LOCAL RETURN HRRZ .A16,0(.A16) ;GET COUNT ADJSP P,-1(.A16) ;ADJUST STACK, GET TRAP HERE OR ON PUSH MOVE .A16,1(.FP) ;RESTORE LOCAL RETURN JRST TRSET1 ;NOW CHARGE AHEAD ;This is the new internal routine for TRVAR which can work with both ; local and global format stack pointers because the ADJSP instruction ; is used. It differs from the previous code in two ways. 1) The block ; size for the allocation is NOT duplicated in BOTH halves of the word ; following the JSP. 2) The code does not check for stack overflow ; because ADJSP will set TRAP 2 for us. .XTRST::PUSH P,.FP ;Save old frame pointer MOVE .FP,P ;Set up new frame pointer ADJSP P,@0(.A16) ;Adjust stack pointer for variables used PUSHJ P,1(.A16) ;Call routine and return following here .XTRRT::IFSKP. ;Skip return comes here so MOVEM .FP,P ; deallocate space for variables, POP P,.FP ; restore old frame pointer, AOS 0(P) ; and now adjust for skip return ELSE. ;Now for Non-Skip return so MOVEM .FP,P ; deallocate space for variables POP P,.FP ; and restore old frame pointer ENDIF. RET ;Now just return > ;END OF IFN REL, SUBTTL ASUBR - AC SUBROUTINE ;AC SUBROUTINE - ENTRY FOR SUBROUTINE CALLED WITH 1-4 ARGS IN ACS T1-T4. ;USES .FP AS FRAME PTR LIKE TRVAR IFE REL,< EXTERN .ASSET,.ASRET> DEFINE ASUBR (ARGS)< ..TRR==10 ;;SAVE RADIX RADIX 8 ..NV==1 ;;INIT ARG COUNT IRP ARGS,< .TRV1 (ARGS)> ;;DEFINE ARG SYMBOL IFG ..NV-5, JSP .A16,.ASSET ;;SETUP STACK RADIX ..TRR ;;RESTORE RADIX DEFINE ENDAS.<.ENSV1 > > IFN REL,< ;SUPPORT ROUTINE FOR ASUBR .ASSET::PUSH P,.FP ;SAVE .FP MOVE .FP,P ;SETUP FRAME POINTER ADJSP P,4 ;BUMP STACK DMOVEM A,1(.FP) ;SAVE ARGS DMOVEM C,3(.FP) PUSHJ P,0(.A16) ;CONTINUE ROUTINE .ASRET:: JRST [ MOVEM .FP,P ;NO-SKIP RETURN, CLEAR STACK POP P,.FP POPJ P,] MOVEM .FP,P ;SKIP RETURN, CLEAR STZCK POP P,.FP AOS 0(P) POPJ P, > ;END OF IFN REL, SUBTTL SASUBR - STACKED AC SUBROUTINE ;SAME AS ABOVE EXCEPT ALSO RESTORES T1-T4 FROM STACK IFE REL,< EXTERN .SASET,.SARET> DEFINE SASUBR (ARGS)< ..TRR==10 ;;SAVE RADIX RADIX 8 ..NV==1 ;;INIT ARG COUNT IRP ARGS,< .TRV1 (ARGS)> ;;DEFINE ARG SYMBOL IFG ..NV-5, JSP .A16,.SASET ;;SETUP STACK RADIX ..TRR ;;RESTORE RADIX DEFINE ENDSA.<.ENSV1 > > IFN REL,< ;SUPPORT ROUTINE FOR SASUBR .SASET::PUSH P,.FP ;SAVE .FP MOVE .FP,P ;SETUP FRAME POINTER ADJSP P,4 ;BUMP STACK DMOVEM A,1(.FP) ;SAVE ARGS DMOVEM C,3(.FP) PUSHJ P,0(.A16) ;CONTINUE ROUTINE .SARET:: JRST [ DMOVE A,1(.FP) ;RESTORE DMOVE C,3(.FP) MOVEM .FP,P ;NO-SKIP RETURN, CLEAR STACK POP P,.FP POPJ P,] DMOVE A,1(.FP) ;RESTORE DMOVE C,3(.FP) MOVEM .FP,P ;SKIP RETURN, CLEAR STACK POP P,.FP AOS 0(P) POPJ P, > ;END OF IFN REL, SUBTTL ACVAR - AC VARIABLE FACILITY IFE REL,< EXTERN .SAV1,.SAV2,.SAV3,.SAV4,.SAV8> .FPAC==5 ;FIRST PRESERVED AC .NPAC==10 ;NUMBER OF PRESERVED ACS DEFINE ACVAR (LIST)< ..NAC==0 ;;INIT NUMBER OF ACS USED IRP LIST,< .ACV1 (LIST)> ;;PROCESS ITEMS .ACV3 (\..NAC) ;;SAVE ACS USED DEFINE ENDAV.<.ENAV1 >> DEFINE .ACV1 (ITEM)< .ACV2 (ITEM)> ;;PEEL OFF ANGLEBRACKETS IF ANY DEFINE .ACV2 (NAM,SIZ)< IFDEF NAM,<.IF NAM,SYMBOL,> NAM==.FPAC+..NAC ;;DEFINE VARIABLE $'NAM==NAM ;;FOR DDT IFB ,<..NAC=..NAC+1> IFNB ,< ...X==SIZ IF2,<.IFN ...X,ABSOLUTE,> ..NAC=..NAC+...X>> DEFINE .ACV3 (N)< IFG N-.NPAC, IFLE N-4,< JSP .A16,.SAV'N> ;;SAVE ACTUAL NUMBER USED IFG N-4,< JSP .A16,.SAV8>> ;;SAVE ALL DEFINE .ENAV1 (ARGS)< IRP ARGS,< .ENAV2 (ARGS)>> DEFINE .ENAV2 (ARG)< .ENAV3 (ARG)> DEFINE .ENAV3 (NAM,SIZ)< PURGE NAM,NAM > SUBTTL SAVEAC - Save AC List ;SAVEAC is a macro to generate a JSP .SAC,xxx call to an AC saving ;co-routine and to generate the routine also, if necessary. SAVEAC ;generates the routines as literals so that MACRO will compress as ;many as possible. SAVEAC sorts the arguments so that routines which ;save the same ACs will always look the same to MACRO. ;When the there are four or more ACs to be saved, SAVEAC assumes that ;at least two of them will be adjacent and changes from multiple ;PUSHes and POPs to and ADJSP and MOVEMs or, if possible, DMOVEMs for ;efficiency. ;If .SAC is among the ACs being saved, it is saved before the JSP ;.SAC,xxx and then restored in the co-routine literal. ;ACs may be refered to by any currently valid name and in any order. ;A given set of ACs will always be recognized if its literal code has ;been generated before or if it is a special set handled by a system ;routine. ;If an AC is mentioned more than once, it will only be saved/restored ;once. ;Provision is made for detecting standard AC sets which are handled by ;user or system routines. The routines, if defined, must be entered ;with JSP .SAC,xxx. For example, SAVEAC will call the system ;routine .SAV2 instead of generating local code to do the same thing. ;See SPCMAC below. By redefining the macro USRSAV, the user can ;control the tests made for standard routines. DEFINE USRSAV,<> ;DEFAULT TO NO SPECIAL-CASE ROUTINES DEFINE SAVEAC(ACS),< ..DONE==0 ..SACC==0 ..NAC==0 ..MASK==0 IRP ,< IFG ACS-^D15, IFE ACS-.SAC,<..SACC==1> ..SYAC==ACS IFN ACS-.SAC,,< ..MASK==..MASK!1B<..SYAC> ..NAC==..NAC+1>> > IFE ..SACC, ;;..DONE SET BY SPCSAV IF IT SUCCEEDS IFE ..DONE,< IFLE ..SACC, IFG ..SACC, IFG ..NAC-3, IFLE ..NAC-3,> PUSHJ P,(.SAC) TRNA AOS -..NAC-..SACC(P) IFG ..NAC-3, IFLE ..NAC-3,> IFG ..SACC, POPJ P,] > PURGE ..NAC,..TNAC,..MASK,..TMSK,..SACC,..NUM,..SMSK,..DONE,..SYAC >;END OF DEFINE SAVEAC ;Helper macros for SAVEAC DEFINE SPCSAV(ADDR,ACS),< IFE ..DONE,< ..SMSK==0 IRP ,< ..SYAC==ACS ..SMSK==..SMSK!1B<..SYAC>> IFE ..MASK-..SMSK, > >;END OF SPCSAV DEFINE DSAVAC,< IFG ..NAC, ..TMSK==..MASK ..TNAC==..NAC-1 REPEAT ..NAC,< IFN ..TMSK,< ..NUM==^L<..TMSK> ..TMSK==..TMSK-1B<..NUM> IFE ..TMSK & 1B<..NUM+1>,< MOVEM ..NUM,-..TNAC(P) ..TNAC==..TNAC-1> IFN ..TMSK & 1B<..NUM+1>,< DMOVEM ..NUM,-..TNAC(P) ..TNAC==..TNAC-2 ..TMSK==..TMSK-1B<..NUM+1>> >> >;END OF DEFINE DSAVAC DEFINE DRSTAC,< ..TMSK==..MASK ..TNAC==..NAC-1 REPEAT ..NAC,< IFN ..TMSK,< ..NUM==^L<..TMSK> ..TMSK==..TMSK-1B<..NUM> IFE ..TMSK & 1B<..NUM+1>,< MOVE ..NUM,-..TNAC(P) ..TNAC==..TNAC-1> IFN ..TMSK & 1B<..NUM+1>,< DMOVE ..NUM,-..TNAC(P) ..TNAC==..TNAC-2 ..TMSK==..TMSK-1B<..NUM+1>> >> IFG ..NAC, >;END OF DEFINE DRSTAC DEFINE PSAVAC,< ..TMSK==..MASK REPEAT ..NAC,< ..NUM==^L<..TMSK> ..TMSK==..TMSK-1B<..NUM> PUSH P,..NUM > > DEFINE PRSTAC,< ..NUM==^D15 REPEAT ^D16,< IFN ..MASK & 1B<..NUM>,< POP P,..NUM> ..NUM==..NUM-1 > > IFN REL,< ;STANDARD RETURNS RSKP:: AOS 0(P) R:: RET > ;END OF IFN REL, IFN REL,< ;SUPPORT ROUTINES FOR AC VARIABLE FACILITY .SAV1:: PUSH P,.FPAC PUSHJ P,0(.A16) SKIPA AOS -1(P) POP P,.FPAC POPJ P, .SAV2:: PUSH P,.FPAC PUSH P,.FPAC+1 PUSHJ P,0(.A16) SKIPA AOS -2(P) POP P,.FPAC+1 POP P,.FPAC POPJ P, .SAV3:: .SAV4:: ADJSP P,4 DMOVEM .FPAC,-3(P) DMOVEM .FPAC+2,-1(P) PUSHJ P,0(.A16) SKIPA AOS -4(P) DMOVE .FPAC,-3(P) DMOVE .FPAC+2,-1(P) ADJSP P,-4 POPJ P, .SAV8:: ADJSP P,10 DMOVEM .FPAC,-7(P) DMOVEM .FPAC+2,-5(P) DMOVEM .FPAC+4,-3(P) DMOVEM .FPAC+6,-1(P) PUSHJ P,0(.A16) SKIPA AOS -10(P) DMOVE .FPAC+6,-1(P) DMOVE .FPAC+4,-3(P) DMOVE .FPAC+2,-5(P) DMOVE .FPAC,-7(P) ADJSP P,-10 POPJ P, > SUBTTL BLSUBR - BLISS-STYLE SUBROUTINE MECHANISM ;MACROS FOR STACK-STYLE (BLISS) SUBROUTINE ENTRY ;BLSUBR DEFINE A SUBROUTINE ENTRY POINT. IT TAKES THE LIST OF ;SYMBOLS WHICH WILL BE BOUND TO VALUES ON THE STACK AT ENTRY TO ;THE ROUTINE. A STACK FRAME POINTER IS SETUP IN .FP AND MUST ;BE UNDISTURBED THROUGH THE ROUTINE. OTHER MECHANISMS WHICH ;USE THE STACK (E.G. SAVEAC) CAN BE USED. ;AN OPTIONAL LIST OF VARIABLES IN THE SAME FORMAT AS FOR TRVAR CAN ;BE GIVEN TO ALLOCATE LOCAL DYNAMIC STORAGE. ;SUBROUTINES DEFINED HEREBY ARE CALLED WITH BLCALL. IFE REL,< EXTERN .ENTER> DEFINE BLSUB. (ARGS,VARS)< ;;ARGUMENTS, LOCAL VARIABLES ..TRR==10 ;;REMEMBER CURRENT RADIX RADIX 8 ;;SO BACKSLASH ARGS WILL WORK HEREIN ..NA==2 ;;INIT ARG COUNT IRP ARGS,< ..NA=..NA+1> ;;COUNT ARGS IRP ARGS,< .BLSU1(ARGS,\..NA) ;;DEFINE AN ARG ..NA=..NA-1> ..NV==1 ;;SETUP TO COUNT VARIABLE STORAGE IRP VARS,< .TRV1 (VARS)> ;;COUNT WORDS AND DEFINE SYMBOLS DEFINE ENDBS. <.ENBS1 .ENSV1 > ;;SAVE SYMBOLS JSP .A16,.ENTER ..NV-1,,..NV-1 RADIX ..TRR> ;;SETUP FRAME PTR DEFINE .BLSU1 (ARG,LOC)< DEFINE ARG<-^O'LOC(.FP)> $'ARG==> DEFINE .ENBS1 (ARGS)< IRP ARGS,< DEFINE ARGS<....U>>> ;CALL STACK-STYLE (BLISS) SUBROUTINE ;THIS MACRO TAKES THE NAME OF THE SUBROUTINE AND A LIST OF ARGUMENTS. ;EACH ARGUMENT IN THE ARG LIST IS ONE OF THE FOLLOWING: ; 1. A NORMAL EFFECTIVE ADDRESS SPECIFICATION, E.G. FOO, @FIE(X) ; 2. AN IMMEDIATE ADDRESS WRITTEN AS <.,ADR> WHERE ADR IS AN EFFECTIVE ; ADDRESS SPECIFICATION, E.G. FOO, @FIE(X). NOTE THAT THIS ; ADDRESS WILL BE COMPUTED BY AN XMOVEI AT THE TIME OF THE CALL ; SO SECTION INFORMATION WILL BE BOUND AT THAT TIME. NOTE ALSO ; THAT THIS FORM SHOULD *NOT* BE USED FOR A LITERAL CONSTANT ; WHERE YOU WOULD NOT WANT THE CURRENT SECTION PUT IN THE LEFT ; HALF. USE [CONST] INSTEAD. YES, THE DOT HERE IS LIKE NO-DOT IN BLISS ; AND VICE-VERSA. ; 3. A STRUCTURE REFERENCE SPECIFICATION, E.G. AAA, . IF ; THE LATTER FORM IS USED, THE BRACKETS ARE REQUIRED. DEFINE BLCAL. (NAME,ARGS)< ..NA==0 ;;INIT ARG COUNT IRP ARGS,< .BLCL2 ARGS> ;;COMPILE PUSH PUSH P,[..NA+1,,..NA+1] ;;COUNT OF ARGS AND SELF PUSHJ P,NAME ;;JUMP TO SUBR > ;SEPARATE PAIRED ARGS DEFINE .BLCL2 (ARGS)< .BLCL1 ARGS> DEFINE .BLCL1 (ARG1,ARG2)< IFIDN <.>,< XMOVEI .A16,ARG2 ;;IMMEDIATE ARG PUSH P,.A16> IFDIF <.>,< .IFATM ,.BLF4 ;;SEE IF ARG IS ATOMIC .BLF1==0 ;;SET TO 1 WHEN WE ASSEMBLE SOMETHING IFN .BLF4,< ;;SEE IF A STRUCTURE REF .IF %'ARG1,MACRO,< ;;CHECK RELATED STRUCTURE SYMBOL .BLF1==1> ;;IS A STRUCTURE IFNB ,< .BLF1==1> ;;SECOND ARG IMPLIES STRUCTURE TOO IFN .BLF1,< ;;'OR' OF ABOVE TWO CHECKS LOAD .A16,ARG1,ARG2 PUSH P,.A16>> IFE .BLF1,< ;IF WASN'T A STRUCTURE REF, IFN .BLF4,< ;;IF ARG IS ATOMIC... .BLF2==<&17B17>-

B17 ;;TRY TO GET VALUE .IF .BLF2,ABSOLUTE,< ;;IF WE NOW HAVE THE VALUE IFE .BLF2,< ;;SEE IF INDEXED BY P .BLF1==1 ;;NOTE WE DID SOMETHING .BLF3==&777777 PUSH P,.BLF3-..NA(P)>>>> ;;YES, MUST ADJUST BY PUSHES SO FAR IFE .BLF1,< ;;ELSE... PUSH P,ARG1>> ;;PUSH ONE ARG ..NA=..NA+1> ;MACRO TO SEE IF STRING IS AN ATOM, I.E. CONTAINS ONLY LEGAL SYMBOL ;CONSTITUENTS A-Z, 0-9, %, $, . ;IT IS PAINFULLY SLOW, BUT MACRO PROVIDES NO OTHER WAY ;FLAG WILL BE SET TO 1 IF STRING IS ATOM, 0 OTHERWISE DEFINE .IFATM (S,FLG)< IRPC S,< FLG==0 IFGE "S"-"A",> ;;SET FLG IF LETTER OK IFGE "S"-"0",> IFE "S"-"%", IFE "S"-"$", IFE "S"-".", IFE FLG,>> IFN REL,< ;SUPPORT CODE FOR BLSUBR .ENTER::PUSH P,.FP MOVE .FP,P ADD P,0(.A16) ;ALLOCATE LOCAL STORAGE JUMPGE P,ENTOV ;JUMP IF OVERFLOW ENTOV1: PUSHJ P,1(.A16) JRST [ MOVE P,.FP ;RESET STACK PTR JRST ENTX1] MOVE P,.FP AOS -1(P) ;PROPAGATE SKIP ENTX1: POP P,.FP MOVN .A16,-1(P) ;get - HRRZM .A16,-1(P) ;Store 0,,-n POP P,.A16 ;Recover return address ADJSP P,@0(P) ;Clean up the stack JRST 0(.A16) ;RETURN ENTOV: MOVE P,.FP ;STACK OVERFLOW, UNDO ADD PUSH P,.A16 ;SAVE LOCAL RETURN IN 1(.FP) HRRZ .A16,0(.A16) ;GET COUNT ADJSP P,-1(.A16) ;ALLOCATE SPACE, GET TRAP HERE OR ON PUSH MOVE .A16,1(.FP) ;RESTORE LOCAL RETURN JRST ENTOV1 ;CHARGE AHEAD > ;END IFN REL SUBTTL ERROR-MESSAGE SUPPORT FOR MACROS ;Macro to print current location, macro name, and text DEFINE MPRNTX (MNAME,TEXT)< DEFINE ..MP. (LOCN,MTEXT,PTEXT)< PRINTX Location 'LOCN', Macro 'MTEXT': PTEXT > ..MP.(\.,MNAME,) PURGE ..MP. > ;Macro to print current location and text DEFINE EPRNTX (TEXT)< DEFINE ..EP. (LOCN,PTEXT) ..EP.(\.,) PURGE ..EP. > SUBTTL MACROS TO SUPPORT EXTENDED ADDRESSING ;EP. - Build Extended Pointer (extended format indirect word). ;See format picture below. ;Allows standard syntax for indexing and indirection. ; ; EP. @ADR(X) ; ; where ; @ - indirection, may be omitted ; ADR - full address including section ; X - index, may be omitted. ;Examples: ; EP. @FOO ;indirection only ; EP. FOO(X) ;indexing only ; EP. @FOO(X) ;both ;These would generally be used in literals as indirect words, e.g. ; MOVE T1,@[EP. FOO(X)] ;No nested parentheses should be used. DEFINE EP. (ARG)< ..I==0 ..X==0 MAKRM. (..CON,..GET) ..CON IRPC ARG,< ..SC==0 IFE "ARG"-"@",<..I==1 ..SC=1> IFE "ARG"-"(",<..CON <,> ..SC=1 ..X==1> IFE "ARG"-")",< IFE ..X, ..SC=1> IFE ..SC,< ..CON >> IFE ..X,< ..CON <,0>> ..CON < > ..GET > ;Basic macro to construct EFIW with 30-bit Y. ; EXIND. (IND,YYY,XXX) ; where ; IND is 0 or 1 ; YYY is a 30-bit address ; XXX is an index DEFINE EXIND. (IND,YYY,IDX)<<B1+B5+>> ; Local format indirect word ; ================================================================= ; !1!0! Reserved ! I ! X ! ADDR ! ; ================================================================= ; !0!1!2 12! 13!14 17!18 35! ;Macro to generate local-format (instruction-format) indirect words ;Args: ; ADDR 18-bit in-section address (indexing or indirection ; may be specified) ;Generates Q errors on the following: ; Bits 0-12 non-zero in ADDR DEFINE LFIWM (ADDR)< ..ERR.=0 ;;Reset error flag IFN <&<^O<777740,,0>>>,< MPRNTX(LFIWM,Bits 0 - 12 non-zero in address field: ADDR) ..ERR.=1 > IFN ..ERR.,<-1,-1,-1> ;;Generate Q error IFE ..ERR.,<1B0!<<^O<400037,,-1>>&>> ;;Generate LFIW PURGE ..ERR. > ; Global format indirect word ; ================================================================= ; !0! I ! X ! SEC ! ADDR ! ; ================================================================= ; !0! 1 !2 5!6 17! 35! ;Macro to generate global-format (extended-format) indirect words ;Args: ; SEC 12-bit section number ; ADDR 18-bit in-section address (indexing or indirection ; may be specified) ;Generates Q errors on the following: ; Bits 0-12 non-zero in ADDR ; SEC greater than 12 bits DEFINE GFIWM (SEC,ADDR)< ..ERR.=0 ;;Reset error flag IFN <&<^O<-1,,770000>>>,< MPRNTX(GFIWM,Section greater than 12 bits: SEC) ..ERR.=1 > IFN <&<^O<777740,,0>>>,< MPRNTX(GFIWM,Bits 0 - 12 non-zero in address field: ADDR) ..ERR.=1 > IFN ..ERR.,<-1,-1,-1> ;;Generate Q error ;;Generate GFIW IFE ..ERR.,< <<_<^O14>>&<^O<370000,,0>>!<&<0,,-1>>!<_<^O22>>>> PURGE ..ERR. > ; The following macros generate all flavors of 1 and 2-word ; global and local byte pointers. They are similar to the ; POINT pseudo-op, with the following exceptions: ; 1. The basic argument triad of (bytesize,address,byte position) ; is maintained. However, some of the macros will prefix ; and-or postfix the triad with additional argument(s). ; 2. Numeric arguments are always interpreted in the current radix. ; Assuming the current radix is octal, note the following ; equivalences: ; a. POINT 10,200,36 ; b. L1BPT(12,200,44) ; c. L1BPT(^D10,200,^D36) ; 3. Strict field-limits are enforced. Any expression that ; will not fit into its appropriate field will generate ; an error message and cause a Q error. Thus: ; L1BPT (10,200,-1) will cause an error. (The correct effect ; is generated with: L1BPT (10,200).) ; Also, note that in those macros that generate global byte-pointers, ; section values and address values must always be specified as distinct ; arguments. If address symbol FOO resolves to 377,,123456 , then it ; would be specified in the macros as follows: ; G2BPT(FOO_-^D18,7,FOO&777777,36) ; Or (better): ; FOOSEC=FOO_-^D18 ; FOOADR=FOO&777777 ; G2BPT(FOOSEC,7,FOOADR,36) ; If runtime-generated values are needed, then any or all argument ; fields may be assembled as zero and filled in at runtime using an ; appropriate DPB instruction. (G1BPT will not allow a zero bytesize ; and will only allow a zero byte position if it is legal for that ; particular bytesize.) ; 1-word local byte pointer ; ================================================================= ; ! P ! S ! 0 ! I ! X ! ADDR ! ; ================================================================= ; !0 5!6 11! 12! 13!14 17!18 35! ;Macro to generate local, 1-word byte pointers ;Args: ; BSIZ Byte size ; ADDR 18-bit address (indexing or indirection ; may be specified) ; BPOS Optional byte position ;Generates Q errors on the following: ; Bits 0-12 non-zero in ADDR ; BSIZ or BPOS greater than 6 bits DEFINE L1BPT (BSIZ,ADDR,BPOS)< .BSIZ.=BSIZ ;;Convert args to numeric .BPOS.=BPOS ..ERR.=0 ;;Reset error flag IFN <&<^O<777740,,0>>>,< MPRNTX(L1BPT,Bits 0 - 12 non-zero in address field: ADDR) ..ERR.=1 > IFN <.BSIZ.&<^O<-1,,777700>>>,< MPRNTX(L1BPT,Bytesize greater than 6 bits: BSIZ) ..ERR.=1 > IFN <.BPOS.&<^O<-1,,777700>>>,< MPRNTX(L1BPT,Byte offset greater than 6 bits: BPOS) ..ERR.=1 > ;;Cause Q error IFN <..ERR.>,<-1,-1,-1> ;;Generate byte pointer IFE <..ERR.>,< IFIDN <>, IFDIF <>, > PURGE ..ERR.,.BSIZ.,.BPOS. > ; 1-word global byte pointer ; ================================================================= ; ! CODE ! SEC ! ADDR ! ; ================================================================= ; !0 5!6 17! 35! ;Macro to generate global, 1-word byte pointers ;Args: ; ; SEC 12-bit section address ; BSIZ Byte size ; ADDR 18-bit address (NO!! indexing or indirection ; may be specified) ; BPOS Optional byte position ;Generates Q errors on following: ; Illegal byte size or byte position ; Indirection or indexing specified with ADDR ; ADDR greater than 18 bits ; SEC greater than 12 bits ;Legal sizes and positions are as follows: ;Size Positions (Octal) ;6 44,36,30,22,14,6,0 ;7 44,35,26,17,10,1 ;8 44,34,24,14,4 ;9 44,33,22,11,0 ;18 44,22,0 ; Define (somewhat) mnemonic symbols for the P&S field of a one-word global ; byte pointer. These symbols have the form .Psspp where ss is the byte ; size in decimal, and pp is the byte position in decimal (just like the ; POINT pseudo-op in MACRO). There are also a group of symbols that ; generate ILDB style pointers for word aligned data. They are of the ; form .Pss. ; ; Example: ; ; If AC contains the 30 bit address of a buffer, then: ; TXO AC,.P0736 ; will generate a byte pointer that can be used for ILDB, IDPB ; operations. Equivalently, the symbol .P07 could have been used ; instead. DEFINE GENBPT (SIZ)< ..CC=45 ;; Initialize the P&S field ..R=10 ;; Save current radix IRP ,< ..PP=^D36 ;; Initialize the position field REPEAT ^O44/^D'SIZ+1,< RADIX 10 ;; Make \ generate base ^D10. GENBP1 (SIZ,\..PP) ;; Generate .Psspp symbols GENBP2 ($,SIZ,\..PP) ;; Generate base ^d10 .$sp symbols RADIX 8 ;; Make \ generate base 8. GENBP2 (%,\<^D'SIZ>,\..PP) ;; Generate base 8 .%sp symbols IFE ..PP-^D36,..PP=-1 ..PP=..PP+^D'SIZ ..CC=..CC+1> > RADIX ..R > ; Helper macro for GENBPT. Generates .Psspp symbols. Note that all numbers ; are in radix ^D10. DEFINE GENBP1 (SIZ,POS)< IFL SIZ-10,< IFL POS-10,.P0'SIZ'0'POS==:<..CC>B5 IFGE POS-10,.P0'SIZ'POS==:<..CC>B5 IFE POS-36,.P0'SIZ==:<..CC>B5 > IFGE SIZ-10,< IFL POS-10,.P'SIZ'0'POS==:<..CC>B5 IFGE POS-10,.P'SIZ'POS==:<..CC>B5 IFE POS-36,.P'SIZ==:<..CC>B5 > > ; Generate .% or .$ symbols for internal macro use. DEFINE GENBP2(TYP,SIZ,POS)<.'TYP'SIZ'POS==:<..CC>B5> lall GENBPT (<6,8,7,9,18>) ; Generate all one-word global symbols ; ..OWGP - internal macro used by other macros to generate .% symbols. Should ; be invoked using \ feature of macro arguments, and in radix 8 or 10. DEFINE ..OWGP (SIZ,ADDR,POS)>+  IFE 10-^D10,<.$'SIZ'POS!>> PURGE ..CC,..PP,GENBPT,GENBP1,GENBP2 ; Get rid of extra symbols repeat 0,< DEFINE G1BPT (SEC,BSIZ,ADDR,BPOS<^O44>)< .GTBCD (BPOS,BSIZ,..ENC.) ;;GET OWGBP CODE IFE ..ENC.,)> IFN <&<-1,,0>>,< MPRNTX (G1BPT,

)> IFN <&<^O<-1,,770000>>>,< MPRNTX (G1BPT,
)> <..ENC.>B5+B17+> ;;GENERATE THE WORD > DEFINE G1BPT (SEC,BSIZ,ADDR,BPOS<^O44>)<<..OWGP (\,,\)>> ;ONE WORD GLOBAL - Where address includes section. repeat 0,< DEFINE OWGP. (SS,ADR,POS)< ..SS== ..PP==^O44 IFNB ,<..PP==^D35-> .GTBCD (..PP,..SS,..ENC) ;;GET OWGPB CODE IFE ..ENC,)> <..ENC>B5+ADR> ;;GENERATE THE WORD > DEFINE OWGP. (SS,ADR,POS<^O44>)<<..OWGP (\,ADR,\)>> ;ONE WORD GLOBAL - Given mask as argument ala POINTR. DEFINE OWGPR. (LOC,MASK) repeat 0,< ;Internal macro to convert P and S to OWGPB code. ; Accepts: PP - P value ; SS - S value ; Returns (sets): ; CD - Code ;Code set to 0 if P,S combination not recognized. DEFINE .GTBCD (PP,SS,CD)< ..P==PP ..S==SS ..C==0 ;;INIT CODE ..Q==10 ;;SAVE RADIX RADIX ^D8 IFE ..S-6,< IFE ..P-44,<..C=45> IFE ..P-36,<..C=46> IFE ..P-30,<..C=47> IFE ..P-22,<..C=50> IFE ..P-14,<..C=51> IFE ..P-06,<..C=52> IFE ..P-00,<..C=53>> IFE ..S-10,< IFE ..P-44,<..C=54> IFE ..P-34,<..C=55> IFE ..P-24,<..C=56> IFE ..P-14,<..C=57> IFE ..P-04,<..C=60>> IFE ..S-7,< IFE ..P-44,<..C=61> IFE ..P-35,<..C=62> IFE ..P-26,<..C=63> IFE ..P-17,<..C=64> IFE ..P-10,<..C=65> IFE ..P-01,<..C=66>> IFE ..S-11,< IFE ..P-44,<..C=67> IFE ..P-33,<..C=70> IFE ..P-22,<..C=71> IFE ..P-11,<..C=72> IFE ..P-00,<..C=73>> IFE ..S-20,< IFE ..P-44,<..C=74> IFE ..P-22,<..C=75> IFE ..P-00,<..C=76>> RADIX ..Q ;;RESTORE RADIX CD==..C> > ; 2-word local byte pointer ; !0 5!6 11! 12! 13 17!18 35! ; ================================================================= ; ! P ! S ! 1 ! Reserved ! Available to User ! ; ================================================================= ; !1!0! Reserved ! I ! X ! ADDR ! ; ================================================================= ; !0!1!2 12! 13!14 17!18 35! ;Macro to generate local, 2-word byte pointers ;Args: ; ; BSIZ Byte size ; ADDR 18-bit address (Indexing or indirection ; may be specified) ; BPOS Optional byte position ; OPT Optional user field available in word 1, right half ;Generates Q errors on the following: ; Bits 0-12 non-zero in ADDR ; Bits 0-17 non-zero in OPT ; BSIZ or BPOS greater than 6 bits DEFINE L2BPT(BSIZ,ADDR,BPOS,OPT<0>)< ..ERR.=0 ;;Reset error flag .BSIZ.=BSIZ ;;Convert args to numeric .BPOS.=BPOS IFN <&<^O<777740,,0>>>,< MPRNTX(L2BPT,Bits 0 - 12 non-zero in address field: ADDR) ..ERR.=1 > IFN <&<-1,,0>>,< MPRNTX(L2BPT,Bits 0-17 non-zero in optional field: OPT) ..ERR.=1 > IFN <.BSIZ.&<^O<-1,,777700>>>,< MPRNTX(L2BPT,Bytesize greater than 6 bits: BSIZ) ..ERR.=1 > IFN <.BPOS.&<^O<-1,,777700>>>,< MPRNTX(L2BPT,Byte offset greater than 6 bits: BPOS) ..ERR.=1 > IFN ..ERR.,<-1,-1,-1> ;;Generate Q error ;;Generate the byte pointer IFE ..ERR.,< IFDIF <>,<<!1B12>&<^O<777740,,-1>>> IFIDN <>,<<!1B12>&<^O<777740,,-1>>> <1B0!<<^O<400037,,-1>>&>> ;;Generate LFIW > PURGE ..ERR.,.BSIZ.,.BPOS. > ; 2-word global byte pointer ; !0 5!6 11! 12! 13 17!18 35! ; ================================================================= ; ! P ! S ! 1 ! Reserved ! Available to User ! ; ================================================================= ; !0! I ! X ! SEC ! ADDR ! ; ================================================================= ; !0! 1 !2 5!6 17! 35! ;Macro to generate global, 2-word byte pointers ;Args: ; SEC 12-bit section address ; BSIZ Byte size ; ADDR 18-bit address (Indexing or indirection ; may be specified) ; BPOS Optional byte position ; OPT Optional user field available in word 1, right half ;Generates Q errors on the following: ; SEC greater than 12 bits ; Bits 0-12 non-zero in ADDR ; Bits 0-17 non-zero in OPT ; BSIZ or BPOS greater than 6 bits DEFINE G2BPT(SEC,BSIZ,ADDR,BPOS,OPT<0>)< ..ERR.=0 ;;Reset error flag .BSIZ.=BSIZ ;;Convert args to numeric .BPOS.=BPOS IFN <&<^O<-1,,770000>>>,< MPRNTX(G2BPT,Section greater than 12 bits: SEC) ..ERR.=1 > IFN <&<^O<777740,,0>>>,< MPRNTX(G2BPT,Bits 0 - 12 non-zero in address field: ADDR) ..ERR.=1 > IFN <&<-1,,0>>,< MPRNTX(G2BPT,Bits 0-17 non-zero in optional field: OPT) ..ERR.=1 > IFN <.BSIZ.&<^O<-1,,777700>>>,< MPRNTX(G2BPT,Bytesize greater than 6 bits: BSIZ) ..ERR.=1 > IFN <.BPOS.&<^O<-1,,777700>>>,< MPRNTX(G2BPT,Byte offset greater than 6 bits: BPOS) ..ERR.=1 > IFN ..ERR.,<-1,-1,-1> ;;Generate Q error ;;Generate the byte pointer IFE ..ERR.,< IFDIF <>,<<!1B12>&<^O<777740,,-1>>> IFIDN <>,<<!1B12>&<^O<777740,,-1>>> ;;Generate GFIW <<_<^O14>>&<^O<370000,,0>>!<&<0,,-1>>!<_<^O22>>> > PURGE ..ERR.,.BSIZ.,.BPOS. > SUBTTL Byte pointers for ASCII strings REPEAT 0,< ;SUPERCEDED BY .Psspp ;Macros to generate 7-bit byte pointers where AC already contains an address. ;NOTE: In the case of one-word globals, AC must contain ONLY a 30-bit ;address. That is, bits 0-5 must be zero. ;PTLOCI - One word local pointer to bits 28-34 of a word. Used when AC ; points to word preceding the one of interest. ILDB gets the byte ; from the first 7 bits of the next word ;PTGLBI - One-word global equivalent of PTLOCI ; Replaces HRLI AC,700 DEFINE PTLOCI (AC)< HRLI AC,(POINT 7,0,35)> LSTBYT==660000,,0 DEFINE PTGLBI (AC)< TXO AC,LSTBYT> ;PTLOC - One word local pointer to 7 bits preceding a word. Used when AC ; points to the word of interest. ILDB gets the byte ; from the first 7 bits of the word ;PTGLB - One-word global equivalent of PTLOC ;Replaces HRLI AC,440700 DEFINE PTLOC (AC),< HRLI AC,(POINT 7,0)> FRSBYT==610000,,0 DEFINE PTGLB (AC)< TXO AC,FRSBYT> > ;END REPEAT 0 ;Macros to generate 8-bit byte pointers where AC already contains an address. ;PTLC8. - generates 8-bit local byte pointer to beginning of word DEFINE PTLC8. (AC),< HRLI AC,(POINT 8,0)> ;PTGB8. - generates 8-bit global byte pointer to beginning of word .FR8BY==540000,,0 DEFINE PTGB8. (AC)< TXO AC,.FR8BY> SUBTTL LIT ;MAKE SURE LITERALS COME BEFORE END MARK IFN REL,< .RLEND==:.-1 ;MARK END OF CODE IN MACREL > IF2, ;FLUSH REL FROM UNIV FILE .XCMSY END ;End of MACSYM