Google
 

Trailing-Edge - PDP-10 Archives - BB-H138A-BM - 3a-sources/macsym.mac
There are 70 other files named macsym.mac in the archive. Click here to see a list.
;<3A.UTILITIES>MACSYM.MAC.2, 11-Feb-78 11:48:25, EDIT BY MILLER
;USE OPDEF'S FOR EXTENDED INSTRUCTION DEFS
;<3A.UTILITIES>MACSYM.MAC.1, 11-Feb-78 11:30:00, EDIT BY MILLER
;DEFINE USEFUL EXTENDED ADDRESSING INSTRUCTIONS
;<3-UTILITIES>MACSYM.MAC.6,  8-Nov-77 10:47:32, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-UTILITIES>MACSYM.MAC.5, 26-Oct-77 11:06:30, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>MACSYM.MAC.4, 21-Sep-77 15:49:41, EDIT BY OSMAN
;MOVE "PURGE" TO AFTER DEFINITION OF .RLEND
;<3-UTILITIES>MACSYM.MAC.3, 21-Sep-77 15:35:48, EDIT BY OSMAN
;ADD .RLEND
;<3-UTILITIES>MACSYM.MAC.2, 22-Jun-77 15:40:57, EDIT BY MURPHY
;ADDED SETMI (XMOVEI) TO SAVEAC
;<2-UTILITIES>MACSYM.MAC.7, 27-Dec-76 17:06:19, EDIT BY HURLEY
;<2-UTILITIES>MACSYM.MAC.6, 11-Oct-76 13:01:04, EDIT BY MURPHY
;<2-UTILITIES>MACSYM.MAC.5,  6-Oct-76 11:45:47, EDIT BY MURPHY
;<2-UTILITIES>MACSYM.MAC.4,  6-Oct-76 10:41:20, EDIT BY MILLER
;<2-UTILITIES>MACSYM.MAC.3,  6-Oct-76 10:30:31, EDIT BY MILLER
;CHECK FOR ALREADY DEFINED STKVAR'S AND TRVAR'S
;<2-UTILITIES>MACSYM.MAC.2, 15-Sep-76 14:21:57, EDIT BY MURPHY
;ADDED FMSG, PERSTR, SAVEAC
;<1A-UTILITIES>MACSYM.MAC.54, 10-MAY-76 14:01:20, EDIT BY HURLEY
;<1A-UTILITIES>MACSYM.MAC.50,  8-APR-76 11:16:25, EDIT BY HURLEY
;<1A-UTILITIES>MACSYM.MAC.49,  8-APR-76 11:11:35, EDIT BY HURLEY
;TCO 1244 - ADD .DIRECT .XTABM FOR MACRO 50 ASSEMBLIES




;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;VERSION 1

IFNDEF REL,<REL==0>		;UNIVERSAL UNLESS OTHERWISE DECLARED
   IFE REL,<
	UNIVERSAL MACSYM	COMMON MACROS AND SYMBOLS
   >
   IFN REL,<
	TITLE MACREL		SUPPORT CODE FOR MACSYM
	SEARCH MONSYM
	SALL
	IFNDEF .PSECT,<
	.DIRECT .XTABM>
   >

;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=:137		;;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==:777777B35		;Edit number
;ADDED VI%XXX
	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 CIRCONFLEX
.CHCUN==:037			;CONTROL UNDERLINE

.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	MACROS FOR FIELD MASKS

;STANDARD MACROS

;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)>>

;MAKE VALUE BE RIGHT JUSTIFIED IN WORD.

DEFINE .RTJST(VAL,MSK)<<VAL>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>>

;MODULE - GIVES REMAINDER OF DEND DIVIDED BY DSOR

DEFINE MOD. (DEND,DSOR)<<DEND-<DEND/DSOR>*DSOR>>
	SUBTTL MOVX

;MOVX - LOAD AC WITH CONSTANT

DEFINE MOVX (AC,MSK)<
   ..MX1==MSK			;;EVAL EXPRESSION IF ANY
IFDEF .PSECT,<
   .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
	>>

IFNDEF .PSECT,<
	..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
>
	PURGE ..MX1,..MX2>
;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
IFDEF .PSECT,<
   .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 STILL HAVEN'T DONE IT,
	  TD'MT AC,[..TX1]>	;;MUST GIVE UP AND USE LITERAL
	PURGE ..TX1,..TX2>>
IFNDEF .PSECT,<
	..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 STILL HAVEN'T DONE IT,
	  TD'MT AC,[..TX1]>	;;MUST GIVE UP AND USE LITERAL
	PURGE ..TX1,..TX2>>
;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
	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
IFDEF .PSECT,<
	.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>>>
	PURGE ..JX1>
IFNDEF .PSECT,<
	.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>>>
	PURGE ..JX1>

DEFINE JXN (AC,MSK,BA)<
	..JX1==MSK		;;EVAL EXPRESSION IF ANY
IFDEF .PSECT,<
	.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>>>
	PURGE ..JX1>
IFNDEF .PSECT,<
	.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>>>
	PURGE ..JX1>
DEFINE JXO (AC,MSK,BA)<
	..JX1==MSK		;;EVAL EXPRESSION
IFDEF .PSECT,<
	.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>>>
	PURGE ..JX1>
IFNDEF .PSECT,<
	.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>>>
	PURGE ..JX1>

DEFINE JXF (AC,MSK,BA)<
	..JX1==MSK		;;EVAL EXPRESSION
IFDEF .PSECT,<
	.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>>>
	PURGE ..JX1>
IFNDEF .PSECT,<
	.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>>>
	PURGE ..JX1>
	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)<
	IFNDEF .PSECT,<
	SYM==0			;;ASSUME NOT AC UNLESS...
	..TSA1==<Z LOC>		;;LOOK AT LOC
	  IFE ..TSA1&^O777777777760,<SYM==1> ;;AC IF VALUE IS 0-17
	>
	IFDEF .PSECT,<
	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
	PURGE ..TSA1>>

;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
; 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)<
	OP (<AC>,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)<
	OP (<AC>,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
;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,[POINTR (LOC,MSK)]>>>

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,[POINTR (LOC,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

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.

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

;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 CALL, RET, JSERR

   IFE REL,<
	EXTERN JSERR0,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]

DEFINE RETSKP <
	JRST RSKP>

;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

DEFINE JSERR<
	CALL JSERR0>

;MACRO FOR FATAL JSYS ERROR, PRINTS MSG THEN HALTS

DEFINE JSHLT<
	CALL JSHLT0>

;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>>>>
;USEFUL EXTENDED ADDRESSING DEFINITIONS

OPDEF XJRSTF [JRST 5,0]		;RESTORE FLAGS AND PC
OPDEF XSFM [JRST 14,0]		;SAVE PC FLAGS IN MEMORY
OPDEF XMOVEI [SETMI 0,0]	;EXTENDED MOVEI

DEFINE XBLT (A)<
	EXTEND A,[020000,,0]>
	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 USE