github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-01-31 13:52:00 +00:00
Code Issues Projects Releases Wiki Activity
Files
6e18f5ebefd9acb0d718ef31a08f33a60fc9fca2
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/macsym/macsym.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

3409 lines
96 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
; *** Edit 7548 to MACSYM.MAC by RASPUZZI on 4-Jan-88
; Add .CHWL1 so GTJFN is happy.
; *** Edit 7546 to MACSYM.MAC by RASPUZZI on 29-Dec-87, for SPR #21716 (TCO 7.1168)
; Add new symbol .CHSEM (for semi-colon).
; 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, 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
;**;[7548] Add 1 line at .CHSPC==:+1L MDR 4-JAN-88
.CHWL1==:052 ;[7548] * or wildcard character
;**;[7546] Add 1 line at .CHSPC==:+1L MDR 28-DEC-87
.CHSEM==:073 ;[7546] 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<-<<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
>
DEFINE G1BPT (SEC,BSIZ,ADDR,BPOS<^O44>)<<..OWGP (\<BSIZ>,<SEC,,ADDR>,\<BPOS>)>>
;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
Reference in New Issue View Git Blame Copy Permalink