Trailing-Edge
-
PDP-10 Archives
-
AP-4172F-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