Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/macsym.fai
There are no other files named macsym.fai in the archive.
;<ADMIN.LOUGHEED>MACSYM.FAI.18, 7-Sep-81 22:47:43, Edit by ADMIN.LOUGHEED
;TCO 5.1275 Explicitly define absolute value of .JBVER as octal.
;<B.BOMBADIL>MACSYM.FAI.6, 10-Aug-81 19:23:46, Edit by B.BOMBADIL
; Allow STKVAR expressions like 3+FOO (FOO+3 is hopless in FAIL)
; Fix break mask macros and FLDBK. to work correctly
; Use ADJSP instruction where appropriate
; Define if necessary, but don't use, the IFB and IFNB pseudo-ops from MACRO
; Miscellaneous cleanups
;<SUBSYS>MACSYM.FAI.2, 20-Apr-81 00:32:19, Edit by B.BOMBADIL
;add .CHSPC
;ACCT:<UTILITIES.UNSUPPORTED>MACSYM.FAI.2, 7-Nov-80 11:30:45, by J.JQJOHNSON
; remove ^D in BRK1. macros
;<SOURCES.UTILITIES>MACSYM.FAI.2, 26-Aug-79 18:49:58, Edit by ADMIN.JQJ
;incorporate changes from DEC 4 version
; ( <4.utilities>macsym.mac.15, 22 jun 79 edit by r.ace )
;ACCT:<SOURCES.CUSP>MACSYM.FAI.11, 3-Dec-78 10:30:34, Edit by J.JQJOHNSON
;changed some ADD and SUB to ADJSP; incorporated changes from DEC 3a version
;(<3a.utilities>macsym.mac.2, 11-feb-78 11:48:25, edit by miller)
;ACCT:<SOURCES.CUSP>MACSYM.FAI.2, 19-Sep-78 09:42:46, Edit by J.JQJOHNSON
;deleted most PURGEs to clean up Fail CREF listings
;ACCT:<SOURCES.CUSP>MACSYM.FAI.6, 19-Jul-78 13:05:27, Edit by J.JQJOHNSON
;added GENSYM to build symbols
;ACCT:<SOURCES.CUSP>MACSYM.FAI.4, 6-Jul-78 12:44:17, Edit by J.JQJOHNSON
;bug in trvar & stkvar -- too many brackets peeled off
;ACCT:<SOURCES.CUSP>MACSYM.FAI.2, 19-Jun-78 13:54:26, Edit by J.JQJOHNSON
;fixed bug in .case
;PS:<J.JQJOHNSON>MACSYM.FAI.1, 5-May-78 11:34:38, Edit by J.JQJOHNSON
;failized it. N.B. uses SAIL character set.
;<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
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORP., 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
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=:^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==: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
.CHSPC==:040 ;SPACE
.CHALT==:175 ;OLD ALTMODE
.CHAL2==:176 ;ALTERNATE OLD ALTMODE
.CHDEL==:177 ;DELETE
SUBTTL HARDWARE BITS OF INTEREST TO USERS
;PC FLAGS
PC%OVF==:1B0 ;OVERFLOW
PC%CY0==:1B1 ;CARRY 0
PC%CY1==:1B2 ;CARRY 1
PC%FOV==:1B3 ;FLOATING OVERFLOW
PC%BIS==:1B4 ;BYTE INCREMENT SUPPRESSION
PC%USR==:1B5 ;USER MODE
PC%UIO==:1B6 ;USER IOT MODE
PC%LIP==:1B7 ;LAST INSTRUCTION PUBLIC
PC%AFI==:1B8 ;ADDRESS FAILURE INHIBIT
PC%ATN==:3B10 ;APR TRAP NUMBER
PC%FUF==:1B11 ;FLOATING UNDERFLOW
PC%NDV==:1B12 ;NO DIVIDE
SUBTTL CORRECT DEFICIENCIES IN FAIL
IFNDEF IFB,<
DEFINE IFB (FOO,BAR) <
IFIDN <FOO> <> <BAR>
>
DEFINE IFNB (FOO,BAR) <
IFDIF <FOO> <> <BAR>
>
>;IFB
IFNDEF IF1,<
DEFINE IF1 (DUM) <DUM>
DEFINE IF2 (FOO) <PRINTX WARNING: IF2 ENCOUNTERED. IGNORED.>
>;IF1
IFDEF FOR,<
DEFINE GENSY1 (FOO,BAR) <
DEFINE FOO ' <..%'BAR>
>
DEFINE GENSYM (FOO) <
IFNDEF ..%00,<..%00==0>
..%00==..%00+1
GENSY1(FOO,\..%00)
>
>
IFNDEF .NODDT,<DEFINE .NODDT <;>
>
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 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)<<<-<<MASK><<MASK>>>-1>>>
;COMPUTE POSITION OF MASK, I.E. BIT POSITION OF RIGHTMOST ONE IN MASK
DEFINE POS(MASK)<<<<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>*1B<POS(MSK)>>&<MSK>>
;MAKE VALUE BE RIGHT JUSTIFIED IN WORD.
DEFINE .RTJST(VAL,MSK)<<<VAL>&<MSK>>*1B<=70-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><-=18>,<
..MX2==1
MOVEI AC,..MX1> ;;LH 0, DO AS RH
IFE ..MX2,< ;;IF HAVEN'T DONE IT YET,
IFE <..MX1><=18>,<
..MX2==1
MOVSI AC,(..MX1)>> ;;RH 0, DO AS LH
IFE ..MX2,< ;;IF HAVEN'T DONE IT YET,
IFE <<..MX1><-=18>-.lhalf>,<
..MX2==1
HRROI AC,<..MX1>>> ;;LH -1
IFE ..MX2,< ;;IF HAVEN'T DONE IT YET,
IFE <<..MX1><=18>-.lhalf>,<
..MX2==1
HRLOI AC,(..MX1-.rhalf)>> ;;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><-=18>,<
..MX2==1
MOVEI AC,..MX1> ;;LH 0, DO AS RH
IFE ..MX2,< ;;IF HAVEN'T DONE IT YET,
IFE <..MX1><=18>,<
..MX2==1
MOVSI AC,(..MX1)>> ;;RH 0, DO AS LH
IFE ..MX2,< ;;IF HAVEN'T DONE IT YET,
IFE <<..MX1><-=18>-.rhalf>,<
..MX2==1
HRROI AC,<..MX1>>> ;;LH -1
IFE ..MX2,< ;;IF HAVEN'T DONE IT YET,
IFE <<..MX1><=18>-.lhalf>,<
..MX2==1
HRLOI AC,(..MX1-.rhalf)>> ;;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
for @' M E {NOZC} <
for @\ T E { ENA} <
define TX'M'\T (AC,MSK) <
..TX(M'\T,AC,<MSK>) >>>
;..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&.lhalf>,<
..TX2==1 ;;LH 0, DO AS RH
TR'MT AC,..TX1>
IFE ..TX2,< ;;IF HAVEN'T DONE IT YET,
IFE <..TX1&.rhalf>,<
..TX2==1 ;;RH 0, DO AS LH
TL'MT AC,(..TX1)>>
IFE ..TX2,< ;;IF HAVEN'T DONE IT YET,
IFE <<..TX1><-=18>-.rhalf>,< ;;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&.lhalf>,<
..TX2==1 ;;LH 0, DO AS RH
TR'MT AC,..TX1>
IFE ..TX2,< ;;IF HAVEN'T DONE IT YET,
IFE <..TX1&.rhalf>,<
..TX2==1 ;;RH 0, DO AS LH
TL'MT AC,(..TX1)>>
IFE ..TX2,< ;;IF HAVEN'T DONE IT YET,
IFE <<..TX1><-=18>-.rhalf>,< ;;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>>>
>
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>>>
>
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>>>
>
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>>>
>
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>>>
>
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>>>
>
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>>>
>
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>>>
>
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>)
repeat 0,{
DEFINE .CASE (NUM,LIST)<
..CSN==NUM
..CSC==0
IRP LIST,<
IFE ..CSN-..CSC,<
STOPI
..CAS1 (LIST)>
..CSC==..CSC+1>
>
DEFINE ..CAS1 (LIST)<
LIST>
};repeat 0
define .case (num,list)<
ifdef ..csn,<printx NESTED CASE STATEMENT -- INVALID >
..csn==num
for ..csv in (list) <
ife <..csn>,<
..csv >
..csn==..csn-1 >
purge ..csn ;clean up
>
;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>-.rhalf,<SYM==1> ;;RH IF MASK IS 777777
IFE <MSK>-.lhalf,<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==< LOC> ;;LOOK AT LOC
IFE ..TSA1&=15,<SYM==1> ;;AC IF VALUE IS 0-17
>
IFDEF .PSECT,<
SYM==0 ;;ASSUME NOT AC UNLESS...
..TSA1==< loc> ;;LOOK AT LOC
.IF ..TSA1,ABSOLUTE,< ;;SEE IF WE CAN TEST VALUE
IFE ..TSA1&=15,<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<<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
for ..str in (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
for ..str in (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)<
gensym(%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)<
gensym(%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.
repeat 0,{
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
};repeat 0
for @\ ..m E {NOZC} <
for @' ..t E { ENA} <
define TQ\..M\'..T (STR,Y) <
..STR1 (..TY,..M\'..T,<STR>,<Y>,..STR3)
>
>
>
;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)<
FOR ..SYM IN (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)
< BRK1 (%%V,V2,0)
>
;MACRO TO REMOVE CHARACTER
DEFINE UNBRK. (%%V,V2)
< BRK1 (%%V,V2,1)
>
DEFINE BRK1 (%%V,V2,FLAVOR) ;;%%V IS FIRST CHAR, V2 IS LAST
<
HIGH==%%V
CHR==%%V
IFDIF <V2> <> <HIGH==V2>
REPEAT HIGH-<%%V>+1,<
%%W==CHR/=32 ;;DECIDE WHICH WORD CHARACTER GOES IN
%%X==CHR-%%W*=32 ;;CALCULATE BIT POSITION WITHIN WORD
IFE FLAVOR,<BRKC1 (\%%W)> ;;MODIFY CORRECT MASK WORD
IFN FLAVOR,<BRKC2 (\%%W)>
CHR==CHR+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,A1,A2,A3)
<
IFIDN <A0> <> <W0.==0> ;INITIALIZE BREAK MASK
IFDIF <A0> <> <W0.==A0>
IFIDN <A1> <> <W1.==0>
IFDIF <A1> <> <W1.==A1>
IFIDN <A2> <> <W2.==0>
IFDIF <A2> <> <W2.==A2>
IFIDN <A3> <> <W3.==0>
IFDIF <A3> <> <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
IFDIF <ALLOW> <> <
FOR CHAR IN (ALLOW),<UNBRK. (CHAR)> ;;DON'T BREAK ON ALLOWED CHARS
>
IFDIF <DISALW> <> <
FOR CHAR IN (DISALW),<BRKCH. (CHAR)>;;BREAK ON CHARACTERS NOT ALLOWED
>
W0.
W1.
W2.
W3. ;;STORE RESULTANT MASK IN MEMORY
>
;FLDDB. - FIELD DESCRIPTOR BLOCK WITHOUT BREAK MASK FIELD
DEFINE FLDDB. (TYP,FLGS,DATA,HLPM,DEFM,LST) <
..XX==0
IFDIF <FLGS> <> <..XX==FLGS>
..XX==<TYP>*1B8+..XX
IFDIF <HLPM> <> <..XX==CM%HPP!..XX>
IFDIF <DEFM> <> <..XX==CM%DPP!..XX>
IFDIF <LST> <> <..XX+LST >
IFIDN <LST> <> <..XX >
IFDIF <DATA> <> <DATA >
IFIDN <DATA> <> <IFDIF <HLPM'DEFM> <> <0> >
IFDIF <HLPM> <> <POINT 7,[ASCIZ \HLPM\] >
IFIDN <HLPM> <> <IFDIF <DEFM> <> <0> >
IFDIF <DEFM> <> <POINT 7,[ASCIZ \DEFM\] >
>;FLDDB.
;FLDDK. - FIELD DESCRIPTOR BLOCK WITH BREAK MASK FIELD
DEFINE FLDBK. ' (TYP,FLGS,DATA,HLPM,DEFM,BRKADR,LST) <
..XX==0
IFDIF <FLGS> <> <..XX==FLGS>
..XX==<TYP>*1B8+..XX
IFDIF <HLPM> <> <..XX==CM%HPP!..XX>
IFDIF <DEFM> <> <..XX==CM%DPP!..XX>
IFDIF <BRKADR> <> <..XX==CM%BRK!..XX>
IFDIF <LST> <> <..XX+LST >
IFIDN <LST> <> <..XX >
IFDIF <DATA> <> <DATA>
IFIDN <DATA> <> <IFDIF <HLPM'DEFM'BRKADR> <> <0> >
IFDIF <HLPM> <> <POINT 7,[ASCIZ \HLPM\] >
IFIDN <HLPM> <> <IFDIF <DEFM'BRKADR> <> <0> >
IFDIF <DEFM> <> <POINT 7,[ASCIZ \DEFM\] >
IFIDN <DEFM> <> <IFDIF <BRKADR> <> <0> >
IFDIF <BRKADR> <> <BRKADR>
>;FLDBK.
;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 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.
;TYPICAL USE: STKVAR <AA,BB,<QQ,5>,ZZ>
IFE REL,<
EXTERN .STKST,.STKRT>
DEFINE STKVAR (ARGS)<
..STKR==10 ;;REMEMBER RADIX
RADIX 8
..STKN==0
for ..arg in (ARGS) <
.STKV2 (..ARG)>
JSP .A16,.STKST
..STKN,,..STKN
RADIX ..STKR
>
;INTERMEDIATE MACRO TO PEAL OFF ANGLEBRACKETS IF ANY
DEFINE .STKV1 (ARG)< ;### not used in Fail version
.STKV2 (ARG)>
;INTERMEDIATE MACRO TO CALCULATE OFFSET AND COUNT VARIABLES
DEFINE .STKV2 (VAR,SIZ)<
IFB <SIZ>,<..STKN==..STKN+1>
IFNB <SIZ>,<..STKN==..STKN+SIZ>
..STKQ==..STKN+1
.STKV3 (VAR,\..STKQ)>
;INNERMOST MACRO TO DEFINE VARIABLE
DEFINE .STKV3 ' (VAR,LOC)<
IFDEF VAR,<PRINTX STKVAR VAR ALREADY DEFINED>
DEFINE VAR<<-LOC>(P)>
$'VAR==<VAR>> ;SYMBOL FOR DDT
IFN REL,<
;COMMON ENTRY AND EXIT ROUTINE FOR STACK VARIABLE
.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
> ;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 .TRSET,.TRRET,.ASSET,.ASRET>
DEFINE TRVAR (VARS)<
..TRR==10 ;;REMEMBER CURRENT RADIX
RADIX 8
..NV==1 ;;INIT COUNT OF STACK WORDS
for ..var in (vars) <
.TRV2 (..VAR)> ;;PROCESS LIST
JSP .A16,.TRSET ;;ALLOCATE STACK SPACE, SETUP .FP
..NV-1,,..NV-1
RADIX ..TRR ;;RESTORE RADIX
>
DEFINE .TRV1 (VAR)< ;###not used in Fail version
.TRV2 (VAR)> ;;PEEL OFF ANGLEBRACKETS IF ANY
DEFINE .TRV2 (NAM,SIZ)<
.TRV3 (NAM,\..NV) ;;DEFINE VARIABLE
IFB <SIZ>,<..NV=..NV+1>
IFNB <SIZ>,<..NV=..NV+SIZ>>
DEFINE .TRV3 ' (NAM,LOC)<
IFDEF NAM,<.ifdef NAM,<PRINTX TRVAR NAM ALREADY DEFINED>>
DEFINE NAM<LOC(.FP)>
$'NAM==<NAM>> ;;SYMBOL FOR DDT
;AC SUBROUTINE - ENTRY FOR SUBROUTINE CALLED WITH 1-4 ARGS IN ACS T1-T4.
;USES .FP AS FRAME PTR LIKE TRVAR
DEFINE ASUBR (ARGS)<
..TRR==10 ;;SAVE RADIX
RADIX 8
..NV==1 ;;INIT ARG COUNT
for ..arg in (args) <
.TRV1 (..ARG)> ;;DEFINE ARG SYMBOL
IFG <..NV-5>,<PRINTX TOO MANY ARGUMENTS: ARGS
>
JSP .A16,.ASSET ;;SETUP STACK
RADIX ..TRR ;;RESTORE RADIX
>
IFN REL,<
;SUPPORT ROUTINE FOR TRVAR
.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: SUB P,0(.A16) ;STACK OVERFLOW - UNDO ADD
HLL .A16,0(.A16) ;GET COUNT
TRSOV1: PUSH P,[0] ;DO ONE PUSH AT A TIME, GET REGULAR
SUB .A16,[1,,0] ; ACTION ON OVERFLOW
TLNE .A16,777777 ;COUNT TO 0?
JRST TRSOV1 ;NO, KEEP PUSHING
JRST TRSET1 ;CONTINUE SETUP
;SUPPORT ROUTINE FOR ASUBR
.ASSET^:PUSH P,.FP ;SAVE .FP
MOVE .FP,P ;SETUP FRAME POINTER
ADJSP P,4 ;ADJUST STACK
DMOVEM A,1(.FP) ;SAVE ARGS
DMOVEM C,3(.FP)
ASSET1: 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,
;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
for ..lis in (list) <
.ACV2 (..LIS)> ;;PROCESS ITEMS
.ACV3 (\..NAC)> ;;SAVE ACS USED
DEFINE .ACV1 (ITEM)< ;### not used in Fail version
.ACV2 (ITEM)> ;;PEEL OFF ANGLEBRACKETS IF ANY
DEFINE .ACV2 (NAM,SIZ)<
NAM=.FPAC+..NAC ;;DEFINE VARIABLE
IFB <SIZ>,<..NAC=..NAC+1>
IFNB <SIZ>,<..NAC=..NAC+SIZ>>
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
IFN REL,<
;SUPPORT ROUTINES FOR AC VARIABLE FACILITY
.SAV1^: PUSH P,.FPAC
PUSHJ P,0(.A16) ;CONTINUE PROGRAM
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^: PUSH P,.FPAC
PUSH P,.FPAC+1
PUSH P,.FPAC+2
PUSH P,.FPAC+3
PUSHJ P,0(.A16)
SKIPA
AOS -4(P)
POP P,.FPAC+3
POP P,.FPAC+2
POP P,.FPAC+1
POP P,.FPAC
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,
>
;AC SAVE FACILITY - COMPILES OPEN PUSH'S
; SAVEAC <LIST-OF-ACS>
;DUMMY ROUTINE PUT ON STACK TO CAUSE AUTOMATIC RESTORE. SUPPORTS
; +1 OR +2 RETURNS.
DEFINE SAVEAC (ACS)<
.NAC==0
for ..acs in (acs) <
PUSH P,..ACS ;;SAVE AN AC
.NAC=.NAC+1> ;;COUNT THEM
.N1==.NAC
SETMI .A16,[CAIA ;;STACK DUMMY RETURN
AOS -.N1(P) ;;HANDLE SKIP RETURN
FOR ..ACS IN (ACS) <
.N1=.N1-1
MOVE ..ACS,-.N1(P)> ;;RESTORE AN AC
ADJSP P,-.NAC
POPJ P,] ;;FINAL RETURN
PUSH P,.A16>
IFN REL,<
;STANDARD RETURNS
RSKP^: AOS 0(P)
R^: RET
> ;END OF IFN REL,
ifdef for,< purge rel>
ifndef for,<
IF2,<PURGE REL> ;FLUSH REL FROM UNIV FILE
>;not fail
END