Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-1-monitor/macsym.mac
There are 70 other files named macsym.mac in the archive. Click here to see a list.
;<6-1-SOURCES>MACSYM.MAC.2, 12-May-85 23:37:39, Edit by LOUGHEED
; Stanford changes:
; Fix G1BPT as per Stu Grossman
;
; 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, 1984.
;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 WHICH IS NOT SUPPLIED BY DIGITAL.
SUBTTL COPYRIGHT MACROS
DEFINE COPYRT (YEAR),<
ASCIZ /
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 'YEAR'.
ALL RIGHTS RESERVED.
/>
DEFINE .CPYRT (.YEAR),< ;;Don't assemble into .EXE
XLIST
LOC 0
COPYRT .YEAR
.IFN .,ABSOLUTE,<PRINTX ?.CPYRT, COPYRIGHT IS NOT ABSOLUTE>
IFGE .-^O22,<PRINTX %COPYRIGHT DOESN'T FIT IN SINGLE REL BLOCK>
RELOC
LIST
SALL
>
IFNDEF .MCVWH,<.MCVWH==0> ;WHO LAST CHANGED MACSYM
IFNDEF .MCVMA,<.MCVMA==6> ;MAJOR VERSION NUMBER
IFNDEF .MCVMI,<.MCVMI==0> ;MINOR VERSION NUMBER
IFNDEF .MCVED,<.MCVED==^D1002> ;EDIT NUMBER (INCREMENTED ON EACH EDIT)
MACVER==<<.MCVWH>B2!<.MCVMA>B11!<.MCVMI>B17!<.MCVED>B35>
IFNDEF REL,<REL==0> ;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 <1984>
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
.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<-<<MASK>_<^L<MASK>>>-1>>>
;COMPUTE POSITION OF MASK, I.E. BIT POSITION OF RIGHTMOST ONE IN MASK
DEFINE POS(MASK)<<^L<<MASK>&<-<MASK>>>>>
;CONSTRUCT BYTE POINTER TO MASK
DEFINE POINTR(LOC,MASK)<<POINT WID(<MASK>),LOC,POS(<MASK>)>>
;PUT RIGHT-JUSTIFIED VALUE INTO FIELD SPECIFIED BY MASK
DEFINE FLD(VAL,MSK)<<<<VAL>B<POS(<MSK>)>>&<MSK>>>
;MAKE VALUE BE RIGHT JUSTIFIED IN WORD.
DEFINE .RTJST(VAL,MSK)<<<<VAL>&<MSK>>B<^D70-POS(<MSK>)>>>
;CONSTRUCT MASK FROM BIT AA TO BIT BB. I.E. MASKB 0,8 = 777B8
DEFINE MASKB(AA,BB)<<1B<<AA>-1>-1B<BB>>>
;MODULO - GIVES REMAINDER OF DEND DIVIDED BY DSOR
DEFINE MOD.(DEND,DSOR)<<<DEND>-<<DEND>/<DSOR>>*<DSOR>>>
SUBTTL
;REPEAT WITH SUBSTITUTION OF NUMERIC INDEX
DEFINE FORN. (LOW,HIGH,ARGS,STRING,%MN1)<
DEFINE %MN1(ARGS)<STRING>
..FORN==LOW
REPEAT HIGH-LOW+1,<
.FORN1 (%MN1)
..FORN=..FORN+1>>
DEFINE .FORN1 (MACN)<
MACN (\..FORN)>
;REPEAT WITH GENERAL STRING SUBSTITUTION
DEFINE FORX. (ARGS,SYMS,STRING,%MN1)<
DEFINE %MN1 (SYMS)<STRING>
IRP ARGS,<
.FORX1 %MN1,ARGS>>
DEFINE .FORX1 (MACN,ARGS)<
MACN ARGS>
;DO WITH NUMERIC STRING SUBSTITUTION
DEFINE FORS. (NUM,ARG,STRING)<
DEFINE %MN1 (ARG)<STRING>
..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 <stuff> 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 (<STUFF>,)>
DEFINE %INT (NEW,OLD)<
DEFINE XX (STUFF)<
%INT (<STUFF>,<OLD'NEW>)>>
DEFINE YY <
DEFINE %INT (NEW,OLD)<OLD>
XX ()>
>
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,<STUFF>
MOVEM .SAC,DEST>
;VARIENT MNEMONICS FOR TX DEFINITIONS
DEFINE IORX (AC,MSK)<
TXO AC,<MSK>>
DEFINE ANDX (AC,MSK)<
TXZ AC,<^-<MSK>>>
DEFINE XORX (AC,MSK)<
TXC AC,<MSK>>
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,<MSK>)>>>>
..DOTX (<N,O,Z,C>,<,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 <MT><Z>,< ;;IF ZEROING WANTED
..TX2==1
ANDI AC,^-..TX1> ;;CAN DO IT WITH ANDI
IFIDN <MT><O>,< ;;IF SET TO ONES WANTED
..TX2==1
ORCMI AC,^-..TX1> ;;CAN DO IT WITH IORCM
IFIDN <MT><C>,< ;;IF COMPLEMENT WANTED
..TX2==1
EQVI AC,^-..TX1>> ;;CAN DO IT WITH EQV
;SPECIAL CASE OF WORD ALL ONES
DEFINE ..TX4 (MT,AC)<
IFIDN <MT><NN>,<
..TX2==1
CAIN AC,0> ;;CAN DO FULL WORD COMPARE
IFIDN <MT><NE>,<
..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,<PRINTX MSK NOT ABSOLUTE
..JX1==0>
.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,<PRINTX MSK NOT ABSOLUTE
..JX1==0>
.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,<PRINTX MSK NOT ABSOLUTE
..JX1==0>
.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,<PRINTX MSK NOT ABSOLUTE
..JX1==0>
.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),<OP%%CA (AC,VAL,)>
DEFINE CAXL (AC,VAL),<OP%%CA (AC,VAL,L)>
DEFINE CAXLE (AC,VAL),<OP%%CA (AC,VAL,LE)>
DEFINE CAXE (AC,VAL),<OP%%CA (AC,VAL,E)>
DEFINE CAXG (AC,VAL),<OP%%CA (AC,VAL,G)>
DEFINE CAXGE (AC,VAL),<OP%%CA (AC,VAL,GE)>
DEFINE CAXN (AC,VAL),<OP%%CA (AC,VAL,N)>
DEFINE CAXA (AC,VAL),<OP%%CA (AC,VAL,A)>
DEFINE OP%%CA (AC,VALUE,CODE),<
.XCREF
IFE <<VALUE>_-^D18>,<
.CREF
CAI'CODE AC,<VALUE>
.XCREF
>
IFN <<VALUE>_-^D18>,<
.CREF
CAM'CODE AC,[VALUE]
.XCREF
>
.CREF>
;GENERATE IMMEDIATE OR MEMORY CONSTANTS
DEFINE ADDX (AC,VAL),<OP%%IA (AC,VAL,ADD,SUB)>
DEFINE SUBX (AC,VAL),<OP%%IA (AC,VAL,SUB,ADD)>
DEFINE MULX (AC,VAL),<OP%%IN (AC,VAL,MUL)>
DEFINE IMULX (AC,VAL),<OP%%IN (AC,VAL,IMUL)>
DEFINE DIVX (AC,VAL),<OP%%IN (AC,VAL,DIV)>
DEFINE IDIVX (AC,VAL),<OP%%IN (AC,VAL,IDIV)>
DEFINE OP%%IA (AC,VALUE,CODE,ALT),<
.XCREF
TEST%%=0
IFE <<<VALUE>_-^D18>-^O777777>,<
IFN <<VALUE>&^O777777>,<
TEST%%=1
.CREF
ALT'I AC,-<VALUE>
.XCREF
>>
IFE TEST%%,<
OP%%IN AC,<VALUE>,CODE
>
PURGE TEST%%
.CREF>
DEFINE OP%%IN (AC,VALUE,CODE),<
.XCREF
IFE <<VALUE>_-^D18>,<
.CREF
CODE'I AC,<VALUE>
.XCREF
>
IFN <<VALUE>_-^D18>,<
.CREF
CODE AC,[VALUE]
.XCREF
>
.CREF>
;GENERATE IMMEDIATE OR MEMORY FOR FLOATING POINT
DEFINE FADRX (AC,VAL),<OP%%FP (AC,VAL,FADR)>
DEFINE FSBRX (AC,VAL),<OP%%FP (AC,VAL,FSBR)>
DEFINE FMPRX (AC,VAL),<OP%%FP (AC,VAL,FMPR)>
DEFINE FDVRX (AC,VAL),<OP%%FP (AC,VAL,FDVR)>
DEFINE OP%%FP (AC,VALUE,CODE),<
.XCREF
IFE <<VALUE>_^D18>,<
.CREF
CODE'I AC,(VALUE)
.XCREF
>
IFN <<VALUE>_^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,<FIRST,SECOND,...,NTH>)
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 <MSK>+1,<SYM=0> ;;FULL WORD IF MASK IS -1
IFE <MSK>-^O777777,<SYM==1> ;;RH IF MASK IS 777777
IFE <MSK>-^O777777B17,<SYM==2>> ;;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==<Z LOC> ;;LOOK AT LOC
.IF ..TSA1,ABSOLUTE,< ;;SEE IF WE CAN TEST VALUE
IFE ..TSA1&^O777777777760,<SYM==1>> ;;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 <STR><CH>,<
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==<<<-<MSK>>&<MSK>>&<1B<^L<MSK>>>>>
;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<POS>+1B<POS-SIZ>> ;;ASSIGN SYMBOL TO HOLD MASK
IF1,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
DEFINE %'NAM (OP,AC,Y,MSK)<
$'NAM==<Z LOCN> ;;LOCATION SYMBOL FOR DDT
OP (<AC>,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<POS>+1B<POS-SIZ>> ;;ASSIGN SYMBOL TO HOLD MASK
IF1,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
DEFINE %'NAM (OP,AC,Y,MSK)<
OP (<AC>,<@[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,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
DEFINE %'NAM (OP,AC,Y,MSK)<
$'NAM==<Z LOCN> ;;LOCATION SYMBOL FOR DDT
OP (<AC>,LOCN''Y,MSK)>> ;;DEFINE MACRO TO HOLD LOCATION
DEFINE EMSKST (NAM,LOCN,MASK)<
NAM==MASK ;;ASSIGN SYMBOL TO HOLD MASK
IF1,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
DEFINE %'NAM (OP,AC,Y,MSK)<
OP (<AC>,<@[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,<PRINTX ?STR IS NOT DEFINED
OP (<AC>,<Y>,.FWORD)> ;;RESERVE A WORD, ASSUME WORD MASK
IFDEF STR,<
IFNDEF %'STR,<
OP (<AC>,<Y>,STR)> ;;ASSUME NO OTHER LOCN
IFDEF %'STR,<
%'STR (OP,<AC>,<Y>,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,<PRINTX ?EMPTY STRUCTURE LIST, OP>
IFE ..NS-1,< ;;THE ONE CASE, CAN DO FAST
..STR0 (OP,<AC>,<STR>,<Y>)>
IFG ..NS-1,< ;;MORE THAN ONE, DO GENERAL CASE
..ICNS ;;INIT REMOTE MACRO
..CNS (<CLL (OP,<AC>,,>) ;;CONS ON CALL AND FIRST ARGS
IRP STR,< ;;DO ALL NAMES IN LIST
IFNDEF STR,<PRINTX STR NOT DEFINED>
IFDEF STR,<
IFNDEF %'STR,<
..CNS (<,STR,Y>)> ;;ASSUME NO OTHER LOCN
IFDEF %'STR,<
%'STR (..STR2,,<Y>,STR)> ;;STR MACRO WILL GIVE LOCN TO ..STR2
..CNS (<)>) ;;CLOSE ARG LIST
..GCNS ;;DO THIS AND PREVIOUS NAME
..ICNS ;;REINIT CONS
..CNS (<CLL (OP,<AC>>) ;;PUT ON FIRST ARGS
IFNDEF %'STR,<
..CNS (<,STR,Y>)> ;;ASSUME NO OTHER LOCN
IFDEF %'STR,<
%'STR (..STR2,,<Y>,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 <L1><L2>,<
IFNB <L1>,<
OP (<AC>,L1,..MSK) ;;DO ACCUMULATED STUFF
IFNB <L2>,<PRINTX S1 AND S2 ARE IN DIFFERENT WORDS>>
..MSK==0> ;;INIT MASK
IFNB <L2>,<
..MSK=..MSK!<S2>>>
;..STR4 -- COMPARE SUCCESSIVE ITEMS, DO SEPARATE OPERATION IF
;DIFFERENT WORDS ENCOUNTERED
DEFINE ..STR4 (OP,AC,S1,L1,S2,L2)<
IFDIF <L1><L2>,< ;;IF THIS DIFFERENT FROM PREVIOUS
IFNB <L1>,<
OP (<AC>,L1,..MSK)> ;;DO PREVIOUS
..MSK==0> ;;REINIT MASK
IFNB <L2>,<
..MSK=..MSK!<S2>>> ;;ACCUMULATE MASK
;..STR5 - SAME AS ..STR4 EXCEPT GIVES EXTRA ARG IF MORE STUFF TO
;FOLLOW.
DEFINE ..STR5 (OP,AC,S1,L1,S2,L2)<
IFDIF <L1><L2>,< ;;IF THIS DIFFERENT FROM PREVIOUS,
IFNB <L1>,<
IFNB <L2>,< ;;IF MORE TO COME,
OP'1 (AC,L1,..MSK)> ;;DO VERSION 1
IFB <L2>,< ;;IF NO MORE,
OP'2 (AC,L1,..MSK)>> ;;DO VERSION 2
..MSK==0> ;;REINIT MASK
IFNB <L2>,<
..MSK=..MSK!<S2>>> ;;ACCUMULATE MASK
;'REMOTE' MACROS USED TO BUILD UP ARG LIST
;INITIALIZE CONS -- DEFINES CONS
DEFINE ..ICNS <
DEFINE ..CNS (ARG)<
..CNS2 <ARG>,>
DEFINE ..CNS2 (NEW,OLD)<
DEFINE ..CNS (ARG)<
..CNS2 <ARG>,<OLD'NEW>>>
>
;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<BEG>),<
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<NUM>-<^D35-..FLG>>,<PRINTX ?FILL TOO BIG IN XX STRUCTURE>
...MSK==MASK.(^D<NUM>,<..FLG+^D<NUM>>)
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,<FIELDM(nam,.LHALF)
..FLG==1>
IFE ..FLG,<..MSK==..MSK!.LHALF
IFE ..MSK&.RHALF,<FIELDM(nam,.RHALF)
..FLG==1>
IFE ..FLG,<NXTWRD
FIELDM(nam,.LHALF) >
>
>
DEFINE FIELD(NAM,SIZ,POS),<
..FLG==0 ;;CLEAR THE "HAVE DEFINED FIELD" FLAG
IFB <POS>,<IFB <SIZ>,<
...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>,<.SIZ==^D<SIZ>> ;;IF WE HAVE A SIZE, USE IT
IFNB <POS>,< ;;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,<IFGE <^D<.SIZ>-^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,<PRINTX ?NO ROOM FOR BIT IN LAST FIELD>
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<LEN>,LSTNAM<LST>),<
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,<PRINTX ? MISSING BEGSTR>
IF2,<
IFDEF ...MSK,<SUPPRESS ...MSK>
IFDEF ..BITS,<SUPPRESS ..BITS>
IFDEF .SIZ,<SUPPRESS .SIZ>
IFDEF ..MSK,<SUPPRESS ..MSK>
IFDEF ..OFF,<SUPPRESS ..OFF>
IFDEF ..FLG,<SUPPRESS ..FLG>
IFDEF ..LOK,<SUPPRESS ..LOK>
IFDEF ..LOC,<SUPPRESS ..LOC>
IFDEF ..OLD,<SUPPRESS ..OLD>
IFDEF ...OLD,<SUPPRESS ...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,<RELOC ..LOC>>
;;END OF DEFINE ENDSTR
..MSK==0 ;;INITIALIZE THE MASK
..OFF==OFFSET ;;AND THE OFFSET
XX'.'BEGNAM==OFFSET ;;SYMBOL FOR BEGINNING OFFSET
IFDEF ..LOK,<IFL ..LOK,<PRINTX ? NEW BEGSTR WITHOUT ENDSTR>>
..LOK==-1
>;;END OF DEFINE BEGSTR
;Special macros for the BEGSTR macros to use
DEFINE LFTBT.(MASK) <1_<^D35-^L<MASK>>>
DEFINE MASK.(WID,POS),<<<<1_<WID>>-1>B<POS>>>
;;END OF DEFINE MASK.
DEFINE .RTMSK(MASK),<
<IFE <<FILIN.(<MASK>)&<^-MASK>>>,<MASK>>!<IFN <<FILIN.(<MASK>)&<^-MASK>
>><<FILIN.(<<<RGHBT.(<<FILIN.(<MASK>)&<^-MASK>>>)>_-1>>!<RGHBT.(MASK)>)>>>>
;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,<Y>)>
DEFINE ..LDB (AC,LOC,MSK)<
..TSIZ (..PST,MSK)
.CASE ..PST,<<
MOVE AC,LOC>,<
HRRZ AC,LOC>,<
HLRZ AC,LOC>,<
LDB AC,[POINT WID(<MSK>),LOC,POS(<MSK>)]>>>
;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,<Y>)>
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(<MSK>),LOC,POS(<MSK>)]
..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,<Y>)>
DEFINE ..DPB (AC,LOC,MSK)<
..TSIZ (..PST,MSK)
.CASE ..PST,<<
MOVEM AC,LOC>,<
HRRM AC,LOC>,<
HRLM AC,LOC>,<
DPB AC,[POINT WID(<MSK>),LOC,POS(<MSK>)]>>>
;SET TO ZERO
DEFINE SETZRO (STR,Y)<
..STR1 (..TQZ,,<STR>,<Y>,..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,,<STR>,<Y>,..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,,<STR>,<Y>,..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,,<STR>,<Y>)>
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,,<STR>,<Y>)>
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,<OP>,<STR>,<Y>)>
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,<OP>,<STR>,<Y>)>
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,<BA>,<STR>,<Y>,..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,<BA>)>>>,<
JXE (LOC,MSK,<BA>)>>
;JUMP IF NOT ALL FIELDS ARE 0 (ONE REGISTER AT MOST)
DEFINE JN (STR,Y,BA)<
..STR1 (..JN,<BA>,<STR>,<Y>,..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,<BA>)>>>,<
JXN (LOC,MSK,<BA>)>>
;JOR - JUMP ON 'OR' OF ALL FIELDS
DEFINE JOR (STR,Y,BA)<
..STR1 (..JN,<BA>,<STR>,<Y>,..STR4)>
;JNAND - JUMP ON NOT 'AND' OF ALL FIELDS
DEFINE JNAND (STR,Y,BA)<
..STR1 (..JNA3,<BA>,<STR>,<Y>,..STR4)>
DEFINE ..JNA3 (BA,LOC,MSK)<
..TSAC (..ACT,LOC)
.IF0 ..ACT,<
SETCM .SAC,LOC ;;NOT AC, GET COMPLEMENT OF WORD
JXN (.SAC,MSK,<BA>)>,< ;;JUMP IF ANY BITS ORIGINALLY OFF
JXF (LOC,MSK,<BA>)>> ;;DO AC CASE
;JAND - JUMP ON 'AND' OF ALL FIELDS
DEFINE JAND (STR,Y,BA,%TG)<
..STR1 (..JAN,<%TG,<BA>>,<STR>,<Y>,..STR5)
%TG:>
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,<BA2>)>,< ;;JUMP IF ALL BITS ORIGINALLY ONES
JXO (LOC,MSK,<BA2>)>> ;;DO AC CASE
;JNOR - JUMP ON NOT 'OR' OF ALL FIELDS
DEFINE JNOR (STR,Y,BA,%TG)<
..STR1 (..JNO,<%TG,<BA>>,<STR>,<Y>,..STR5)
%TG:>
DEFINE ..JNO1 (BA1,BA2,LOC,MSK)<
..JN (BA1,LOC,MSK)> ;;DO JUMP OR TO LOCAL TAG
DEFINE ..JNO2 (BA1,BA2,LOC,MSK)<
..JE (<BA2>,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,<STR>,<Y>,..STR3)>>>>
..DOTY (<N,O,Z,C>,<,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,,<STR>,<Y>,..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,,<STR>,<Y>,..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:! ;;DUMMY RETURNS COMES HERE
.POPX>> ;;RESTORE DEFS
DEFINE ..SVBK (%SY1)<
SYN ENDBK.,%SY1
.PSHX <
SYN %SY1,ENDBK.>>
;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:! ;;TOP OF LOOP
DEFINE OD. <
%TGE:! ;;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
.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 <NSCOD'SKCOD>,< ;;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 <NSCOD'SKCOD>,< ;;THE ALTERNATE FORM
JRST %TG1 ;;THE NOSKIP CASE
SKCOD
JRST %TG2
%TG1:! NSCOD
%TG2:!>>
;If JSYS Error
DEFINE IFJER. (NSCOD,SKCOD,%TG1,%TG2,%TG3)<
IFB <NSCOD'SKCOD>,< ;;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 <NSCOD'SKCOD>,< ;;THE ALTERNATE FORM
ERJMP %TG1 ;;THE NOSKIP CASE
SKCOD
JRST %TG2
%TG1:! NSCOD
%TG2:!>>
;VERSION OF JSYS ERROR HANDLER WHICH ALLOWS SPECIFICATION OF ERJMP TYPE.
DEFINE IFJE. (TYPE,NSCOD,SKCOD,%TG1,%TG2,%TG3)<
IFB <NSCOD'SKCOD>,< ;;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 <NSCOD'SKCOD>,< ;;THE ALTERNATE FORM
ERJMP'TYPE %TG1 ;;THE NOSKIP CASE
SKCOD
JRST %TG2
%TG1:! NSCOD
%TG2:!>>
;OBSOLETE NAME
DEFINE IFNES. (ARG1,ARG2)<
PRINTX % IFNES. should be changed to IFJER.
IFJER. <ARG1>,<ARG2>>
;"IF SKIP" CONSEQUENCE-CODE
;If the instruction(s) preceding the macro skips, the 'consequence
; code' will be executed.
DEFINE IFSKP. (SKCOD,%TG,%TG2)<
IFB <SKCOD>,< ;;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 <SKCOD>,<
JRST %TG
SKCOD
%TG:!>>
;If No JSYS Error
DEFINE IFNJE. (SKCOD,%TG,%TG2)<
IFB <SKCOD>,< ;;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 <SKCOD>,<
ERJMP %TG
SKCOD
%TG:!>>
;VERSION WHICH ALLOWS SPECIFICATION OF ERJMP TYPE
DEFINE IFJN. (TYPE,SKCOD,%TG,%TG2)<
IFB <SKCOD>,< ;;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 <SKCOD>,<
ERJMP'TYPE %TG
SKCOD
%TG:!>>
;OBSOLETE NAME
DEFINE IFESK. (ARG)<
PRINTX % IFESK. should be changed to IFNJE.
IFNJE. <ARG>>
;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
>
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
>
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
>
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
>
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
>
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
>
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
>
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
>
DEFINE IFQE. (STR,Y,%TG1,%TG2)<
JN <STR>,<Y>,%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
>
DEFINE IFQN. (STR,Y,%TG1,%TG2)<
JE <STR>,<Y>,%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
>
;GENERAL CASES WITHIN CONDITIONALS
;"AND SKIP"
DEFINE ANSKP. <
..TAGF (JRST,)> ;;JUMP TO 'FALSE'
DEFINE ANNSK. <
TRNA
..TAGF (JRST,)> ;;JUMP TO 'FALSE'
DEFINE ELSE. <....U> ;;UNDEFINED UNTIL BLOCK ENTERED
DEFINE ENDIF. <....U>
DEFINE ..TAGF <....U>
DEFINE ..TAGE <....U>
;"AND E" ETC.
DEFINE ANDE. (AC)<
..TAGF (<JUMPN AC,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDN. (AC)<
..TAGF (<JUMPE AC,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDG. (AC)<
..TAGF (<JUMPLE AC,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDGE. (AC)<
..TAGF (<JUMPL AC,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDLE. (AC)<
..TAGF (<JUMPG AC,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDL. (AC)<
..TAGF (<JUMPGE AC,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDXE. (AC,MASK)<
..TAGF (<JXN AC,MASK,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDXN. (AC,MASK)<
..TAGF (<JXE AC,MASK,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDQE. (STR,Y)<
..TAGF (<JN <STR>,<Y>,>,)> ;;JUMP IF NOT CONDITION
DEFINE ANDQN. (STR,Y)<
..TAGF (<JE <STR>,<Y>,>,)> ;;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
.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,<STUFF>)>
DEFINE .PSHX1 (WCH,STUFF)<
WCH (<STUFF>)>
DEFINE .PSHX2 (OLD)<
DEFINE .PSHX1 (WCH,STUFF)<
WCH (<<STUFF>,<OLD>>)>>
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 (<<STUFF>,<REST>>)>>
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 <JRST RSKP>
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[<CALL JSERR0>]
OPDEF EJSERR[<JUMP 17,JSERR0>] ;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[<CALL JSHLT0>]
OPDEF EJSHLT[<JUMP 17,JSHLT0>] ;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 <? TEXT>
JSHLT]
>
;MAKE SYMBOLS EXTERN IF NOT ALREADY DEFINED
DEFINE EXT (SYM)<
IF2,<
IRP SYM,<
IFNDEF SYM,<EXTERN SYM
SUPPRE 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 <V2>,<..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==<FLD(TYP,CM%FNC)>+FLGS+<0,,LST>
IFNB <HLPM>,<..XX=CM%HPP!..XX>
IFNB <DEFM>,<..XX=CM%DPP!..XX>
..XX
IFNB <DATA>,<DATA>
IFB <DATA>,<0>
IFNB <HLPM>,<POINT 7,[ASCIZ HLPM]>
IFB <HLPM>,<IFNB <DEFM>,<0>>
IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>>
;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK
DEFINE FLDBK. (TYP,FLGS,DATA,HLPM,DEFM,BRKADR,LST)<
..XX==<FLD(TYP,CM%FNC)>+FLGS+<Z LST>
IFNB <HLPM>,<..XX=CM%HPP!..XX>
IFNB <DEFM>,<..XX=CM%DPP!..XX>
IFNB <BRKADR>,<..XX=CM%BRK!..XX>
..XX
IFNB <DATA>,<DATA>
IFB <DATA>,<0>
IFNB <HLPM>,<POINT 7,[ASCIZ HLPM]>
IFB <HLPM>,<IFNB <DEFM'BRKADR>,<0>>
IFB <DEFM>,<IFNB <BRKADR>,<0>>
IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>
IFNB <BRKADR>,<BRKADR>
>
;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 <PROGRAM CANNOT CONTINUE
>
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 <VAR,SIZ>. 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 <A, B, C> will not work.
;TYPICAL USE: STKVAR <AA,BB,<QQ,5>,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 <ARGS>>
>
;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 <SIZ>,<..STKN==..STKN+1>
IFNB <SIZ>,<
...X==SIZ
IF2,<.IFN ...X,ABSOLUTE,<PRINTX ?STKVAR VAR, SIZ is not absolute>>
..STKN==..STKN+...X>
..STKQ==..STKN+1
.STKV3 (VAR,\..STKQ)>
;INNERMOST MACRO TO DEFINE VARIABLE
DEFINE .STKV3 (VAR,LOC)<
IFDEF VAR,<.IF VAR,SYMBOL,<PRINTX STKVAR VAR ALREADY DEFINED>>
DEFINE VAR<-^O'LOC(P)>
$'VAR==<Z 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 <VARS>>
>
DEFINE .TRV1 (VAR)<
.TRV2 (VAR)> ;;PEEL OFF ANGLEBRACKETS IF ANY
DEFINE .TRV2 (NAM,SIZ)<
.TRV3 (NAM,\..NV) ;;DEFINE VARIABLE
IFB <SIZ>,<..NV=..NV+1>
IFNB <SIZ>,<
...X==SIZ
IF2,<.IFN ...X,ABSOLUTE,<PRINTX ?TRVAR NAM, SIZ is not absolute>>
..NV=..NV+...X>>
DEFINE .TRV3 (NAM,LOC)<
IFDEF NAM,<.IF NAM,SYMBOL,<PRINTX TRVAR NAM ALREADY DEFINED>>
DEFINE NAM<^O'LOC(.FP)>
$'NAM==<Z 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,<PRINTX ?TOO MANY ARGUMENTS: ARGS>
JSP .A16,.ASSET ;;SETUP STACK
RADIX ..TRR ;;RESTORE RADIX
DEFINE ENDAS.<.ENSV1 <ARGS>>
>
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,<PRINTX ?TOO MANY ARGUMENTS: ARGS>
JSP .A16,.SASET ;;SETUP STACK
RADIX ..TRR ;;RESTORE RADIX
DEFINE ENDSA.<.ENSV1 <ARGS>>
>
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 <LIST>>>
DEFINE .ACV1 (ITEM)<
.ACV2 (ITEM)> ;;PEEL OFF ANGLEBRACKETS IF ANY
DEFINE .ACV2 (NAM,SIZ)<
IFDEF NAM,<.IF NAM,SYMBOL,<PRINTX ACVAR NAM ALREADY DEFINED>>
NAM==.FPAC+..NAC ;;DEFINE VARIABLE
$'NAM==NAM ;;FOR DDT
IFB <SIZ>,<..NAC=..NAC+1>
IFNB <SIZ>,<
...X==SIZ
IF2,<.IFN ...X,ABSOLUTE,<PRINTX ?ACVAR NAM, SIZ is not absolute>>
..NAC=..NAC+...X>>
DEFINE .ACV3 (N)<
IFG N-.NPAC,<PRINTX ?TOO MANY ACS USED>
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 <P1,P2> 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 <ACS>,<
IFG ACS-^D15,<PRINTX ?SAVEAC(ACS) IS ILLEGAL,
PRINTX ?SAVEAC CAN ONLY BE USED ON ACCUMULATORS>
IFE ACS-.SAC,<..SACC==1>
..SYAC==ACS
IFN ACS-.SAC,<IFE ..MASK&1B<..SYAC>,<
..MASK==..MASK!1B<..SYAC>
..NAC==..NAC+1>>
>
IFE ..SACC,<USRSAV> ;;..DONE SET BY SPCSAV IF IT SUCCEEDS
IFE ..DONE,<
IFLE ..SACC,<JSP .SAC,[>
IFG ..SACC,<CALL [EXCH .SAC,(P)>
IFG ..NAC-3,<DSAVAC>
IFLE ..NAC-3,<IFG ..NAC,<PSAVAC>>
PUSHJ P,(.SAC)
TRNA
AOS -..NAC-..SACC(P)
IFG ..NAC-3,<DRSTAC>
IFLE ..NAC-3,<IFG ..NAC,<PRSTAC>>
IFG ..SACC,<POP P,.SAC>
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 <ACS>,<
..SYAC==ACS
..SMSK==..SMSK!1B<..SYAC>>
IFE ..MASK-..SMSK,<JSP .SAC,ADDR
..DONE==1>
>
>;END OF SPCSAV
DEFINE DSAVAC,<
IFG ..NAC,<ADJSP P,..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,<ADJSP P,-..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 <ARGS>
.ENSV1 <VARS>> ;;SAVE SYMBOLS
JSP .A16,.ENTER
..NV-1,,..NV-1
RADIX ..TRR> ;;SETUP FRAME PTR
DEFINE .BLSU1 (ARG,LOC)<
DEFINE ARG<-^O'LOC(.FP)>
$'ARG==<Z 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, <BB,(X)>. 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 <ARG1><.>,<
XMOVEI .A16,ARG2 ;;IMMEDIATE ARG
PUSH P,.A16>
IFDIF <ARG1><.>,<
.IFATM <ARG1>,.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 <ARG2>,<
.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==<<Z ARG1>&17B17>-<P>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==<Z ARG1>&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",<IFLE "S"-"Z",<FLG=1>> ;;SET FLG IF LETTER OK
IFGE "S"-"0",<IFLE "S"-"9",<FLG=1>>
IFE "S"-"%",<FLG=1>
IFE "S"-"$",<FLG=1>
IFE "S"-".",<FLG=1>
IFE FLG,<STOPI>>>
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 -<n,,n>
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,<TEXT>)
PURGE ..MP.
>
;Macro to print current location and text
DEFINE EPRNTX (TEXT)<
DEFINE ..EP. (LOCN,PTEXT)
<PRINTX Location 'LOCN': PTEXT
>
..EP.(\.,<TEXT>)
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 <EXIND. ..I,>
IRPC ARG,<
..SC==0
IFE "ARG"-"@",<..I==1
..SC=1>
IFE "ARG"-"(",<..CON <,>
..SC=1
..X==1>
IFE "ARG"-")",<
IFE ..X,<PRINTX %UNEXPECTED RIGHT PAREN IN EP. MACRO>
..SC=1>
IFE ..SC,<
..CON <ARG>>>
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)<<<IND>B1+<IDX>B5+<YYY>>>
; 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 <<ADDR>&<^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>>&<ADDR>>> ;;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 <<SEC>&<^O<-1,,770000>>>,<
MPRNTX(GFIWM,Section greater than 12 bits: SEC)
..ERR.=1
>
IFN <<ADDR>&<^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.,<
<<<ADDR>_<^O14>>&<^O<370000,,0>>!<<ADDR>&<0,,-1>>!<<SEC>_<^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 <<ADDR>&<^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 <BPOS><>,<POINT .BSIZ.,ADDR>
IFDIF <BPOS><>,<POINT .BSIZ.,ADDR,.BPOS.>
>
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 <SIZ>,<
..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-8, <.%'SIZ'POS!<ADDR>>+
IFE 10-^D10,<.$'SIZ'POS!<ADDR>>>
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.,<MPRNTX (G1BPT,<Illegal P,S combination: BPOS, BSIZ>)>
IFN <<ADDR>&<-1,,0>>,<
MPRNTX (G1BPT,<Address indexed, indirect, or greater than 18 bits: ADDR>)>
IFN <<SEC>&<^O<-1,,770000>>>,<
MPRNTX (G1BPT,<Section greater than 12 bits: SEC>)>
<..ENC.>B5+<SEC>B17+<ADDR>> ;;GENERATE THE WORD
>
;IFE STANSW,<
;DEFINE G1BPT (SEC,BSIZ,ADDR,BPOS<^O44>)<<..OWGP (\<BSIZ>,<SEC>B17+<ADDR>,\<BPOS>)>>
;>;IFE STANSW
;IFN STANSW,<
DEFINE G1BPT (SEC,BSIZ,ADDR,BPOS<^O44>)<<..OWGP (\<BSIZ>,<SEC,,ADDR>,\<BPOS>)>>
;>;IFN STANSW
;ONE WORD GLOBAL - Where address includes section.
repeat 0,<
DEFINE OWGP. (SS,ADR,POS)<
..SS==<SS>
..PP==^O44
IFNB <POS>,<..PP==^D35-<POS>>
.GTBCD (..PP,..SS,..ENC) ;;GET OWGPB CODE
IFE ..ENC,<MPRNTX (OWGP.,<Illegal P,S combination: POS, SS>)>
<..ENC>B5+ADR> ;;GENERATE THE WORD
>
DEFINE OWGP. (SS,ADR,POS<^O44>)<<..OWGP (\<SS>,ADR,\<POS>)>>
;ONE WORD GLOBAL - Given mask as argument ala POINTR.
DEFINE OWGPR. (LOC,MASK)<OWGP. WID(MASK),LOC,POS(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 <<ADDR>&<^O<777740,,0>>>,<
MPRNTX(L2BPT,Bits 0 - 12 non-zero in address field: ADDR)
..ERR.=1
>
IFN <<OPT>&<-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 <BPOS><>,<<<POINT .BSIZ.,OPT,.BPOS.>!1B12>&<^O<777740,,-1>>>
IFIDN <BPOS><>,<<<POINT .BSIZ.,OPT>!1B12>&<^O<777740,,-1>>>
<1B0!<<^O<400037,,-1>>&<ADDR>>> ;;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 <<SEC>&<^O<-1,,770000>>>,<
MPRNTX(G2BPT,Section greater than 12 bits: SEC)
..ERR.=1
>
IFN <<ADDR>&<^O<777740,,0>>>,<
MPRNTX(G2BPT,Bits 0 - 12 non-zero in address field: ADDR)
..ERR.=1
>
IFN <<OPT>&<-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 <BPOS><>,<<<POINT .BSIZ.,OPT,.BPOS.>!1B12>&<^O<777740,,-1>>>
IFIDN <BPOS><>,<<<POINT .BSIZ.,OPT>!1B12>&<^O<777740,,-1>>>
;;Generate GFIW
<<<ADDR>_<^O14>>&<^O<370000,,0>>!<<ADDR>&<0,,-1>>!<<SEC>_<^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,<PURGE REL> ;FLUSH REL FROM UNIV FILE
.XCMSY
END ;End of MACSYM