Trailing-Edge
-
PDP-10 Archives
-
BB-JR93N-BB_1990
-
10,7/rms10/rmssrc/rmsmac.mac
There are 11 other files named rmsmac.mac in the archive. Click here to see a list.
UNIVERSAL RMSMAC
SUBTTL SXB, SSC
;COPYRIGHT (C) 1977,1982,1988 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.
;THIS FILE CONTAINS ALL MACRO AND SYMBOL DECLARATIONS COMMON TO THE RMS PRODUCT.
;THE FORMAT OF A SOURCE-CODE MODULE IS AS FOLLOWS
; TITLE MODULE-NAME
; SEARCH RMSMAC
; $PROLOG [COMPONENT] (EG. $PROLOG (FDL))
; MODULE-WIDE DECLARATIONS
; $PROC ... $ENDPROC
; [MORE PROCEDURES]
; [MODULE-WIDE UTILITIES]
; END
; $PROLOG - ESTABLISH COMPONENT IDENTITY
;
DEFINE $PROLOG(PREF$<RMS>)< ;;SEARCHES LOCAL UNV, AND INITS MODULE PARAMS
SALL ;;SUPPRESS MACRO EXPANSIONS TO AVOID CLUTTERING LISTING
$ND(TOP$10,0) ;;PRESUME NO TOP$10 DEPS
$ND(TOP$20,0) ;;DITTO TOP$20
IFN TOP$10,<SEARCH UUOSYM> ;;DEP, SO GO APPROP SYMBOLS
IFN TOP$20,<SEARCH MONSYM> ;;DITTO TOP$20
IFDIF <RMS><PREF$>,<SEARCH PREF$'SYM> ;;IF PART OF A COMPONENT, SEARCH ITS UNIVERSAL FILE
DEFINE $$CPON(DUM$)<PREF$> ;;MAKE COMPON NAME AVAIL
DEFINE $CPERR<$'PREF$'ERR> ;; PRESUME THERE IS ERR MACRO
IFIDN <RMS><PREF$>,<DEFINE $CPERR<>> ;;DONT PUT $RMSERR OUT TWICE
IFNDEF $'PREF$'ERR,<DEFINE $CPERR<>> ;;DONT REQUIRE COMPON ERR FILE
$ND(U$GREG,CF) ;;IN CASE THIS COMPON HAS NO ADDIT GREGS OF ITS OWN
;;$ND(H$LOC,SZ%FH) ;;SET HIGH-WATER MARK FOR LOCALS IN PASS 1
$ND(H$LREG,U$TREG) ;;DITTO FOR LREG'S
;;IF2,<H$LOC==H$LOC+H$LREG-U$TREG> ;;REFLECT ACCUM OF AC SAVE-SLOTS DURING P.1
H$NEST==0 ;;SO FOR $$HW(NEST) WILL WORK
P$LLEV==0 ;;INDICS CURR LEVEL OF LOCALS' SCOPE
P$RLEV==0 ;;INDICS CURR LEVEL OF ROUTINE RECURSION
P$SCOPE==0 ;;CNT OF NUMBER OF TOP-LEVEL SCOPES
P$LOC==H$LREG-U$TREG+SZ%FH ;;LOCALS START AFTER SAVE-SLOTS FOR LREGS & FH
P$ARG==0 ;;INDIC HAVE SEEN NO PROC-LEVEL ARGS AS YET
P$SREG==U$TREG ;;ALSO NO PERM REGS HAVE BEEN SAVED AS YET
P$LREG==U$TREG ;;HIGHEST TREG INDICS NO LREGS AS YET
;;CF WILL DO AS LOWEST GREG
P$UTIL==10 ;;DRIVES UNIQUE LABEL GENERATION FOR
;;RETURNS FROM UTILS THAT SAVE REGS
P$CASE==0 ;;FOR CASE MACROS
P$IF==0 ;;FOR UNIQUE (NO)SKIP/JUMP/IFX LABELS
>
SUBTTL TABLE OF CONTENTS FOR RMSMAC
SUBTTL RMS REVISION HISTORY
; EACH MODULE ALSO CONTAINS A MORE COMPLETE EXPLANATION OF THE
; NATURE AND REASON FOR EACH INDIVIDUAL EDIT.
; EACH EDIT WHICH IS MADE TO RMS-20 SHOULD BE ASSIGNED
; TWO NUMBERS -- A PRODUCT EDIT NUMBER AND A LOCAL EDIT
; NUMBER. THE PRODUCT EDIT NUMBER IS ASSIGNED FROM THE LIST
; BELOW. THE LOCAL EDIT NUMBER IS ASSIGNED FROM THE ROUTINE
; IN WHICH THE EDIT WAS MADE.
; NOTE THAT PRIOR TO THE RELEASE OF RMS-20 VERSION 2, EACH
; MODULE HAD A NUMBERING SCHEME FOR ITS OWN EDITS WHICH BEGAN
; AT 1 AND WENT UP. THUS, IF A SPECIFIC MODULE
; DOES NOT HAVE A PRODUCT EDIT NUMBER (OR EVEN A COLUMN FOR IT),
; THAT MODULE HAS NOT HAD ANY EDITS SINCE THE RELEASE OF VERSION 2.
REPEAT 0,<
PRODUCT
EDIT DATE WHO MODULE(ROUTINE) COMMENT
==== ==== === =============== =======
[VERSION 1-A]
[VERSION 2]
1 4-OCT-77 SEB RMSCNC (DCNTRAB) CBD NOT SET UP
2 12-OCT-77 SEB RMSCNC (DCNTRAB) USE RST, NOT RABISI FIELD
3 18-OCT-77 SEB EXTEND.REQ TAKE TRANS TABLE OUT OF REQ FILE
RMSDTP (-) ADD TABLE TO RMSDTP AND CHANGE TO RMSTAB
4 22-DEC-77 SEB RMSTAB MAKE ^Z,ESC ABORT CHARS
5 5-JAN-78 SEB RMSFNX(FBYKEY) ADD ".J" INTO RECORDPTR
6 26-JAN-78 SEB RMSSDR(DOSIDR) FIX FREESPACE CHECK
TO COMPUTE SIDRELEMENT
7 27-JAN-78 EGM RMSCLS($CLOSE) USE CORRECT LINK TO NEXT
RST WHEN DEALLOCATING
10 28-Feb-78 JMT RMSSYM.BPR Fix macros with last
RMSSYM.BPS symbol prefixed by a ?
HEADER.REQ by adding a space before
the $.
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
PRODUCT MODULE SPR
EDIT NAME & EDIT QAR (WHO, DATE) DESCRIPTION
====== =========== ===== =======================
11 *ALL* (EGM, 3-APR-78) ADD NEW REVISION HISTORY TO
ALL MODULES, FLIP HISTORIES THAT RUN FROM
BOTTOM TO TOP, ADD GLOBAL BINDS TO ALL BLISS
MODULES, MAKE SURE AUTHOR, EDIT DATE, AND
COPYRIGHTS APPEAR IN ALL MODULES.
12 RMSSDR(8) 11439 (EGM, 3-APR-78) ALTERNATE KEY ROOT BUCKET
RMSSPT(22) IS INCORRECT CAUSING VALID FIND'S/GET'S TO
FAIL. (RST KEYBUFFER NOT BEING UPDATED AFTER
A SIDR BUCKET SPLIT.)
13 RMSBUF(5) (EGM, 5-APR-78) NO SYMPTOM, BUT CODE IS WRONG
IN PLACES (MISSING FETCH OPERATOR '.').
RMSMSC(8) NO FUNCTIONAL PROBLEM, BUT INDEX KEYS CONTAIN
EXTRA BITS (NOT PART OF THE KEY, IE. BIT 35)
MACROS(27) NO SYMPTOM, BUT MACRO CLEAR HAS CODE MISSING
FETCH OPERATOR.
14 RMSFSM(2) 11723 (EGM, 6-JUL-78) GMEM INCORRECTLY FAILS
WITH ERROR MSGLINK ONCE CORE BECOMES
FRAGMENTED.
15 RMSSPT(23) 11982 (EGM, 26-JUL-78) A PUT TO AN INDEXED
FILE THAT HAS ALTERNATE KEYS WITH
DUPLICATES CAN DESTROY BUCKET HEADERS
AND PRODUCE ERROR ER$UDF.
16 RMSFND(11) 11856 (EGM, 27-JUL-78) A GET FROM A SEQUENTIAL
FILE CAN PRODUCE AN ILLEGAL MEMORY READ
IF THE LAST RECORD IN THE FILE ENDS IN
THE LAST WORD OF THE LAST PAGE.
17 RMSOPN(19) XXXXX (EGM, 1-AUG-78) THE BYTE COUNT FOR A
STREAM FILE WILL BE 5 TIMES GREATER THAN
THE ACTUAL NUMBER OF BYTES IN THE FILE.
20 RMSFND(12) 12112 (EGM, 7-SEP-78) A DELETE OF AN INDEXED RECORD
CAN FIND THE DELETE FLAG ALREADY SET BECAUSE
OF RACE PROBLEMS IN THE FIND RECORD FLOW. THE
PROBLEM OCCURS BETWEEN THE TIME THE RECORD IS
FOUND AND IT IS LOCKED.
21 RMSOPN(20) XXXXX (EGM, 23-MAR-79) **** REFER TO EDIT 17 ****
STREAM FILES CAN NO LONGER BE OPENED FOR OUTPUT
ON DEVICE TTY:, SINCE A CHFDB IS BEING DONE ON
A CREATE.
22 RMSLIB 13341 (SSC,OCT-80) FIX CLEAR MACRO TO HANDLE 1 WD BLKS
23 RMSSPT 13449 (SSC,OCT-80) FIX COMPRESS/SPLIT
WHEN INSUFFICIENT ROOM COMPRESSED TO AVOID SPLIT
24 14172 SUPERSEDED BY DEVEL WORK TO RMSOPN
25 RMSIDX 14628 (SSC,OCT-80) SET DUPFLAG EVEN THO RRV PAGE INTERVENES
26-40 MISCEL DEVELOPMENT
41 RMSOSM QAR FIND FILE ON DSK: WHEN IT SFD
42 CPASCN QAR HANDLE ESCAPE AT END OF SELF-ENDING TOKEN (EG. QUOTED STRING)
43 CPASCN QAR DONT USE DEFAULT STRING WHEN BAD TOKEN AS OPPOSED TO NULL TOKEN
44 RMSGET/MSC/LIB QAR CREATE RSTRPSIDR. TENTATIVE SIDRELEM AFTER $FIND
45 UTLACT QAR ELIM AMBIG THAT MADE "CHANGE" THINK PROLOG BLK WAS RRV
46 RMSFIL COBOL DONT USE RST WHEN SETTING EOF OF IDX FILE
GROUP CONTAINING JUST PROLOG.
47 UTLVFY QAR SPURIOUS DUP KEY MSG FOR DELETED DUPS
50 RMSERR QAR PREVENT NON-BUG MONITOR ERR FROM DISPLAYING
INTERNAL ERROR MSG
51 RMSSPT QAR RMS INTERNAL ERR CAUSED BY NEWINNEWFLAG SET WHEN
WHEN NEW REALLY IN OLD (BUG SHOWS ONLY IF SEQ $PUT)
52 RMSOSM QAR ALLOW USER TO RECOV FROM "MORE DSK SPACE NEEDED"
************ Release of RMS-36 version 1.0 **************
PRODUCT MODULE SPR
EDIT NAME & EDIT QAR (WHO, DATE) DESCRIPTION
====== =========== ===== =======================
53 RMSOSM HOT RMSTACK incorrectly signed as local variable,
causing RMS to write to sharable page.
54 RMSSPT(24) 20-17022
(RLUSK, 24-Dec-81) COMPRESS not updating
DUPLICATES flag in record descriptor after
compressing bucket.
55 RMSERR(16) 20-16698
(RLUSK, 30-Dec-81) REMOVRECORD using
SDATABKT to search for record which may
not be in bucket specified; use POSRFA
instead to find bucket and record.
56 RMSASC(8) SWE (MBROWN)
(DAW, 12-Jan-81) In an LSA file, a word
of nulls is allowed before the LSN if the
LSN would be in a separate TOPS-10 buffer
than the following TAB. Instead of giving
error while reading, just skip the word.
57 RMSUPD(6) 20-17231
(RLUSK, 28-Jan-82) In updating an indexed
file when duplicates are not allowed,
DOUPDIDX calls FOLLOWPATH, allocating a
buffer, and never freeing that buffer.
This can eventually cause overflow of the
user count in the buffer descriptor and
yields a RMSBNA error, "Buffer not
allocated". Cure by releasing the bucket
after checking for duplicates.
60 RMSDSP(3) SWE (MBROWN)
(DAW, 1-Feb-82) Preserve user's registers
3 and 4, return STS in register 2.
************ Release of RMS-10 version 1.1 **************
******************** TOPS-10 ONLY **************************
PRODUCT MODULE SPR
EDIT NAME & EDIT QAR (WHO, DATE) DESCRIPTION
====== =========== ===== =======================
100 RMSCLS Dev (RMT, 10/22/85) Make all occurrences
RMSCNC of EXTERNAL and EXTERNAL ROUTINE match
RMSDEL so that RMS will compile. BLISS V4 does
RMSDIS not accept these as interchangeable.
RMSDSI Also, rewrite macro linkage routines in
RMSERR RMSLIB to work with BLISS V4.
RMSFIL
RMSFLS
RMSFND RMSFNX RMSFRE RMSFSM
RMSGET RMSIDX RMSIO RMSIXM
RMSLIB RMSMSC RMSOPN RMSPUT
RMSQUE RMSSDR RMSSPT RMSTRN
RMSUDM RMSUDR RMSUPD UTLIO
UTLMSC UTLVFY
101 All Dev (SG, 12/2/85) Update Copyrights.
102 RMSINI Dev (RMT, 12/2/85) Take out hard-coded checks
RMSFSM for RMS$$G at 643000 in the free storage
RMS1S1.LNK manager. Move RMS$$G up to accommodate
more symbols from BLISS V4 code.
103 RMSPUT Dev (RMT, 12/2/85) Make sure RMS only does
deferred writing when asked to do so.
104 RMSDSP Dev (RMT, 12/2/85) Do not use AC17 as BLT
pointer. PSI interrupts can trash the
stack pointer.
105 RMSDSP Dev (RMT, 12/2/85) Don't overwrite program's
version number in JOBDAT.
106 RMSOPN Dev (RMT, 12/2/85) Don't clobber other bits in
the RIB status word when setting RP$RMS.
107 RMSOSB 10-32354
(RMT, 12/2/85) TOPS-10 code in PAGOUT
incorrectly calculates size of block for
output, giving positive value in left half
of IOWD. This gives an address check and
illegal address in UUO message. V3 Edit 64.
110 UTLCMD Dev (RMT, 1/23/86) Search CMDPAR before $PROLOG.
UTLTOP
RMSDSP
111 UTLVFY Dev (WXD, 3/26/86) Incorporate RMS development
edit 454 to fix VERIFY problem with scanning
empty buckets.
112 RMSOSB Dev (WXD, 3/28/86) When paging in a file, clear
all pages rather than just a single page.
113 UTLVFY Dev (WXD, 3/31/86) Fix bug in UNCLUTTER that writes
an RFA over a secondary index id.
114 RMSOPN Dev (WXD, 4/2/86) RIBSTS revisited.
115 RMSMAC Dev (WXD, 4/2/86) .NODDT any OPDEF'd symbols.
116 RMSVER Dev (WXD, 4/2/86) Create new module to set version
number of RMS.EXE and RMSCOB.EXE.
117 RMSSPT 10-35371 (asp, 10/7/86) Edit 54 (in COMPRESS) does
not correctly check for duplicates as was
intended. Apply RL fix M460 12-Mar-84.
120 RMSOPN 10-35646 (asp, 12/6/86) In routine OFILE fix RENAME
block length and .FILOP argblk size.
121 RMSOPN 10-35025 (asp, 4/13/87) In routine OFILE release
channel if open fails.
122 RMSOPN 10-35723 (asp, 8/12/87) In routine OFILE (again).
Do lookup before open to avoid wipe of
ABU (Always Backup) bit.
123 RMSOTS (asp, 1/28/88) Remove SEARCH of MONSYM,MACSYM.
Change build file from RMS10B to RMS10. Embed
.LNK files and use MAKLIB
124 UTLVFY 10-35306 (SMW, 9/29/88) UNCLUTTER/VERIFY bombs:
RMSUDR 10-35629 CHKDUP in RMSUDR returned ER$DUP for NO DUPS
RMSUPD keys when called by SIDRSCAN in UTLVFY. This
caused massive confusion which was compounded
by edit 113 which apparently was put in to fix
this problem. While tracking this
down, found missing argument to movewords in
RMSUPD, missing dot in UTLVFY, edit 442 to
CHKDUP from RMS-20 was not applied, and CHKDUP
was looking at a wrong bit. Also, fixed some
code under DBUG switch.
Goes with RMS-20 edit 671.
125 RMSSPT 10-36171 (SMW, 11/12/88) In COMPRESS, check first for
end of bucket (page) so the check for RRV
flag doesn't try to touch a possibly
non existent page.
Goes with RMS-20 edit 673.
126 UTLENV 20-20998A (SMW, 1/11/89) RMSUTL was not checking for
UTLTOP DEFINEing a bucket size greater than 7. Since
UTLSYM the buffer descriptor only has a 3 bit field
RMSOPN for bucket size and uses a bucket size of zero
as a flag for unused buffer, this caused
PUTBUF errors when the file was used if a
multiple of 8 was given as the bucket size.
$CREATE was not checking the bucket size for
the default area. Make it do so. For better
errors, also check while parsing the DEFINE
command.
Goes with RMS-20 edit 674.
***** END OF REVISION HISTORY *****
>;END OF REPEAT 0
SUBTTL DATA DECLARATIVE MACROS (FOR ALLOCATING & INITIALIZING MEMORY)
;$ARRAY - ALLOCATE A TABLE THAT WILL BE ADDRESSED BY SUBSCRIPT (IE. INDEX REGISTER)
DEFINE $ARRAY(NAME$,LOWER$,UPPER$,VAL$<0>)< ;;THE ARRAY NAME AND BOUNDS
NAME$==.-LOWER$ ;;"ALIGN" REF TO 1ST ELEM OF ARRAY
T$ST==. ;;FOR TEST BELOW OF HOW MANY WORDS ALLOC
T$SIZ==UPPER$-LOWER$+1 ;;AMT OF STORAGE TO ALLOC
XLIST
REPEAT T$SIZ,< ;;GIVE THE ELEMS OF ARRAY INIT VALS
IRP VAL$,< ;;GEN IT WORD BY WORD
IFL .-T$ST-T$SIZ,<VAL$> ;;DO IT UNTIL ARRAY SPACE EXHAUSTED
>
>
LIST
>
; $DATA - ALLOCATE A DATA BLOCK FROM STORAGE
;
DEFINE $DATA(NAME$,SIZ$<1>,VAL$<0>)< ;;ALLOC SIZ$ WORDS AT CURR LOC AND LABEL THEM WITH NAME$
NAME$: VAL$ ;;OFF OF .PSECT IMPURE
T$=.-NAME$ ;;SEE WHAT HAS BEEN USED UP
XLIST
REPEAT SIZ$-T$,<0> ;;ALLOC THE RESIDUE IF ANY
LIST
>
; $GDATA - ALLOCATE A GLOBAL DATA STORAGE BLOCK
;
DEFINE $GDATA(NAME$,SIZ$<1>,VAL$<0>)< ;;ALLOC SIZ$ WORDS AT CURR LOC AND LABEL THEM WITH NAME$
NAME$:: VAL$ ;;OFF OF .PSECT IMPURE
T$=.-NAME$ ;;SEE WHAT HAS BEEN USED UP
XLIST
REPEAT SIZ$-T$,<0> ;;ALLOC THE RESIDUE IF ANY
LIST
>
; $IMPURE - CONTINUE GENERATION OF IMPURE PSECT
;
;DEFINE $IMPURE<.PSECT IMPURE,100000>
DEFINE $IMPURE< ;;DO THIS WAY BECAUSE OF MACRO-53 RESTRICTIONS
P$IMPURE==1 ;;TELL $PURE
TWOSEG U$PURE ;;MAKE PLENTY OF ROOM
RELOC 0 ;;START THE IMPURE "SEGMENT"
>
; $INIT - INITIALIZE A $BLOCK OF STORAGE
;
; (EXAMPLE) $INIT(LT,L1) ;;A LOGICAL TERMINAL, L1 OPTIONAL BY THE WAY
; $SET(LT.TYPE,SYM%LT) ;;OR SETN, WHICH WOULD SET L1.TYPE==.
; $ENDINIT ;;THE OTHER FIELDS ARE SET TO 0
;
DEFINE $INIT(STRUC$,OCC$,XOFFS$<0>)< ;;INITIALIZE AN OCCURRENCE OF A DATA STRUCTURE
DEFINE $$XOFF<XOFFS$> ;;FOR DURING $SETS TO STRUCTS THAT DONT ST AT 0
IFNB <OCC$>,<OCC$:> ;;OCC$ LABELS THE OCC OF THE STRUCTURE
DEFINE $$OCC(X$)<OCC$'X$> ;;IN CASE THE CODER WISHES TO NAME INDIV FIELDS
T$==0 ;;INITIALIZE THE MACROS
P$SIZE==SZ%'STRUC$ ;;NEEDED BY $ENDINIT
REPEAT SZ%'STRUC$,<
%PURGE(V$$,\T$) ;;PLAY SAFE, KEEP SYMBOL TABLE CLEAN
%ID(V$$,\T$)==0 ;;UNSPEC FIELDS WILL BE SET TO ZERO
T$==T$+1 ;;INIT THE MACRO FOR NEXT WORD
>
>
; $ENDINIT - GENERATE THE CONTENTS OF THE STORAGE $BLOCK
;
DEFINE $ENDINIT< ;;ACTUALLY GENERATE THE OCC OF THE DATA STRUCT
T$EI==0 ;;INIT FOR LOOP
T$ADDR==. ;;CALC HOW MANY WORDS ACTUALLY USED
REPEAT P$SIZE,<
IFG P$SIZE-T$EI,< ;;THIS MACRO WILL EXPAND TO THE INITIAL DATA
%ID(V$$,\T$EI) ;;IF V%ID IS A MACRO, IT MAY ALLOOC MORE THAN 1 WORD
T$EI==.-T$ADDR ;;INCR BY HOW MUCH ALLOC
>
>
>
; $MSET - MASK VERSION OF $SET
;
DEFINE $MSET(WORD$,MASK$,VAL$)< ;;SET PARTIC FIELD IN WORD$ TO VAL$ USING MASK$
T$1==WORD$ ;;IN CASE ITS AN EXPRESSION
T$==%ID(V$$,\T$1) ;;SAVE CURR VAL FOR MERGING WITH NEW 1
T$2==$MSETI(MASK$,VAL$) ;;GET EXISTING VAL OF THIS WORD
%ID(V$$,\T$1)==T$!T$2 ;;DO THE MERGE
>
; $PTS - ALLOCATE A BYTE PTR TO SPECIFIED STRING
;
DEFINE $PTS(STR$)<<POINT 7,[ASCIZ\STR$\]>> ;;ENCL IN ANGLE-BRACKETS SO 1 VAL
; $PURE - CONTINUE GENERATION OF PURE PSECT
;
;DEFINE $PURE<.PSECT PURE,140>
DEFINE $PURE< ;;DO THIS WAY FOR NOW
IFNDEF P$IMPUR,<TWOSEG U$PURE> ;;INDIC A PURE SEGMENT
RELOC U$PURE ;;AND START IT UP
>
; $SET - SET A VALUE INTO A FIELD WITHIN A STRUCTURE
;
DEFINE $SET(NAM$,VAL$)< ;;GIVE THE FIELD NAM$ THE VALUE VAL$
$$SETUP(NAM$-<$$XOFF>) ;;GET LOCATION DATA ON THE FIELD, ADJUSTING FOR NON-0 ST PT
IFE T$BITS,< ;;INDICS A BYTES FIELD
%PURGE(V$$,\T$ADDR) ;;PLAY SAFE, KEEP SYMBOL TABLE CLEAN
%MACRO(V$$,\T$ADDR)<VAL$> ;;CONSTRUCT A MACRO FOR USE AT $ENDINIT
>
IFN T$BITS,< ;;A NORMAL FIXED LENGTH FIELD
T$==%ID(V$$,\T$ADDR) ;;CREATE A TEMP TO MAKE THINGS MORE READABLE
%ID(V$$,\T$ADDR)==T$!<VAL$>B<^D35-T$POS> ;;ENCODE THE VALUE IN A MACRO
> ;;SUCH THAT EACH VALUE IS OR-ED IN V%ID
>
; $SETN - SET A VAL IN A STRUCT & DEFINE A SYMBOL TO DIRECTLY REF IT
;
DEFINE $SETN(NAM$,VAL$,DIR$)< ;;SAME AS $SET EXCEPT THAT THIS OCC OF FIELD WILL BE NAMED
$SET(NAM$,VAL$) ;;DO THE REAL WORK
IFNB <DIR$>,<DIR$==.+T$ADDR> ;;CREATE THE DIRECT REF SYMBOL
IFB <DIR$>,< ;;CONSTRUCT STRUCT.SUF FROM $INIT ARG & NAM$
DEFINE $$SUF<> ;;INIT THE SUFFIX MACRO
T$==0 ;;WILL BE SET TO 1 WHEN DOT SEEN
IRPC NAM$,< ;;FIND THE . VIA NITTY GRITTY
IFIDN <.><NAM$>,<T$==1> ;;DENOTE THAT A DOT HAS BEEN FOUND
IFN T$,< ;;HAVE PASSED DOT
DEFINE $$T<$$SUF> ;;CREATE A TEMP MACRO SO $$SUF NOT RECURS
DEFINE $$SUF<$$T'NAM$> ;;BUILD IT UP CHAR BY CHAR
>
> ;;END IRPC
$$OCC($$SUF)==.+T$ADDR ;;CREATE SYMBOL BY DEFAULT FOR THIS FIELD
>
>
SUBTTL DATA DECLARATIVE MACROS (FOR REGISTERS AND VALUES)
; $BPPOS - # OF BITS TO RIGHT OF RMOST BIT IN NAM$
;
DEFINE $BPPOS(NAM$)<<NAM$>_-^D30>
; $GREG - DEFINE GLOBAL PRESERVED AC
;
DEFINE $GREG(NAME$,NUM$)< ;;DECLARES A GLOBAL PRESERVED AC... DEFINED THRUOUT COMPONENT
IFNDEF U$GREG,<U$GREG==NUM$> ;;ANY GREG'S SHOULD GO IN A COMPONENT'S UNV FILE
NAME$==NUM$ ;;ASSIGN THE NAME TO A PARTIC REG
$$RINRANGE(NAME$,6,14) ;;BEING ASSIGNED A VALID VALUE?
IFL NUM$-U$GREG,<U$GREG==NUM$> ;;SO CAN VERIFY THAT GREGS WONT OVERLAP LREGS
>
; $LEN - COMPUTE LENGTH OF STRING
;
DEFINE $LEN(STR$,NAME$<P$LEN>)< ;;DETERM NUM OF CHARS IN STRING
NAME$==0 ;;START WITH NONE OBV
IRPC STR$,<NAME$==NAME$+1> ;;COUNT THEM 1 BY 1
>
; $LREG - DEFINE A LOCAL-REGISTER SYMBOL
;
DEFINE $LREG(NAME$)< ;;ASSIGN NEXT LREG IN SEQ
P$LREG==P$LREG+1 ;;INCR CURR HIGH LREG
IFGE P$LREG-U$GREG,<PRINTX ?GREGS OVERLAP LREGS>
NAME$==P$LREG ;;DONE
>
; $$MPOS - DETS BIT NUMBER OF 1ST 0 TO RIGHT OF MASK
;
DEFINE $$MPOS(MASK$)<^L<<-1_-<^L<MASK$>>^!<MASK$>>>>
; $MSETI - SAME AS $SETI EXCEPT THAT IT IS DRIVEN BY A MASK RATHER THAN A BP
;
; ??? DEFINE $MSETI(MASK$,VAL$<1>)< <VAL$>B<$$MPOS(MASK$)-1> >
DEFINE $MSETI(MASK$,VAL$<1>)< <<VAL$>_<WHOLE-<$$MPOS(MASK$)>>> >
; $ND - DEFINE A SYMBOL IF IT IS NOT ALREADY DEFINED
;
DEFINE $ND(SYM$,VAL$)<IFNDEF SYM$,<SYM$==VAL$>>
; $OFFS - ISOLATE OFFSET COMPONENT OF FIELD DESCRIPTOR
;
DEFINE $OFFS(NAM$)<RHMASK&NAM$> ;;OFFSET IS JUST 18 BITS
; $POS - POSIT OF NAM$ IN SENSE OF B<NUM>, EG. $POS(FIELD FROM B0 TO B8)=8
;
DEFINE $POS(NAM$)<WHOLE-1-<<NAM$>_-^D30>> ;;LEFTMOST 6 BITS
; $REG - DEFINE A SYMBOLIC NAME FOR A REGISTER
;
DEFINE $REG(NAME$,NUM$)< ;;CREATE A SYMBOLIC NAME FOR A REGISTER (POSSIBLY A SYNONYM)
NAME$==NUM$
$$RINRANGE(NAME$,0,17) ;;BEING ASSIGNED A VALID VALUE?
>
; $$RINRANGE - (INTERNAL) CHECK RANGE OF REGISTER SYMBOL
;
DEFINE $$RINRANGE(NAME$,LOW$,HI$)< ;;IS THIS SYMBOL IN RANGE LOW$ TO HI$
IFL NAME$-LOW$,<PRINTX ?REGISTER NAME$ IS OUT OF RANGE>
IFG NAME$-HI$,<PRINXT ?REGISTER NAME$ IS OUT OF RANGE>
>
; $SETI - IMMEDIATE $SET: CREATE A PROPERLY ALIGNED FIELD VALUE (NO OUT-OF-BOUNDS CHK MADE)
;
; FOR EXAMPLE: TXNE 1,$SETI(AA.BB) IS THE RIGHT WAY TO ADDRESS A 1-BIT FIELD
;
DEFINE $SETI(NAM$,VAL$<1>)< <VAL$>B<$POS(NAM$)> >
; $SYPRM - CREATE A COMMON SYMBOL FOR 10/20
;
;DEFINE $SYPRM(SYM$,V10$,V20$)<> ;;CREATE A COMMON SYMBOL FOR A FIELD (EG. IPCF) USED ON BOTH 10 AND 20
SUBTTL DATA DECLARATIVE MACROS (FOR STRUCTURES)
; $ALIGN - DCL A SUBSTRUCTURE WITHIN A $BLOCK
;
DEFINE $ALIGN(NAM$,SIZ$<1>)< ;;NAME THE SUBSTRUCT & STATE ITS SIZE IN WORDS
$WORD(NAM$,0) ;;ALIGN AT NEXT WORD AND CREATE OFFS FOR STRUCT SYM
P$ALIGN==SIZ$+NAM$ ;;FOR $ENDAL TO CHK
>
DEFINE $ENDAL< ;;TERMINATE A SUBSTRUCTURE
$WORD(T$ALN,0) ;;ALIGN AGAIN
IFG P$OFFS-P$ALIGN,<PRINTX ?SUBSTRUCTURE EXCEEDS BOUNDS>
P$OFFS=P$ALIGN ;;FOR ALIGN SIZ$ LARGER THAN THAT USED
>
; $$BINRANGE - (INTERNAL) MACRO USED TO CHECK RANGE OF FIELD VALUES
;
DEFINE $$BINRANGE(NAM$,BITS$)< ;;USED TO VERIFY ARG TO USER MACRO
T$BITS==BITS$ ;;MAKE IT GEN AVAIL
IFG BITS$-WHOLE,<PRINTX ?BYTE SIZE OF NAM$ LARGER THAN A WORD>
IFLE BITS$,<PRINTX ?BYTE SIZE OF NAM$ LE 0>
>
; $BLOCK - INITIALIZE A DATA STRUCTURE DECLARATION
;
DEFINE $BLOCK(NAM$,XOFFS$<0>)< ;;INITS DCL FOR A DATA STRUCTURE
P$MXOFF==0 ;;KEEP TRACK OF LARGEST TEMPLATE
P$TYPE==0 ;;START OF NEW GROUP OF CASES
P$FXOFF==0 ;;PRESUME NO VAR LEN FIELDS WILL FOLLOW
P$POS==WHOLE ;;ALWAYS WORD ALIGN A NEW BLK
P$IXOFF==XOFFS$ ;;KEEP INIT OFFSET AROUND
P$OFFS==XOFFS$ ;;MAKE 1ST WORD OF STRUCTURE THE (XOFF$)TH
DEFINE $$MAX(X$)<MX%'NAM$==X$> ;;BASICALLY FOR CASES STATEMENT
DEFINE $$SIZ(X$)<SZ%'NAM$==X$> ;;MAKE DEFAULT FOR SYM CONTAINING SIZE OF STRUCT, A FUNCT OF ITS NAME
>
; $EOB - TERMINATE DECLARATION OF DATA STRUCTURE
;
DEFINE $EOB(MYSIZ$)< ;;CLEANS UP THE DECLARATION OF THE DATA BLK
IFN P$FXOFF,< ;;ANY STUFF PAST END OF VAR LEN FIELDS?
IFN P$OFFS-P$FXOFF,<PRINTX ?NON-VARIABLE FIELD FOLLOWS VARIABLE LENGTH FIELDS>
P$OFFS=P$FXOFF ;;LET THE SIZE SYMBOL INDIC LEN OF FIXED PART OF BLK
>
T$BITS==WHOLE ;;GET PAST LAST ALLOC BYTE TO DET ACTU BLKSIZ
$$IBP(1) ;;NOW DO IT
$$MAX(P$OFFS-P$IXOFF-1) ;;PRESERVE THE LARGEST OFFSET USED
$$SIZ(P$OFFS-P$IXOFF) ;;ALWAYS USE THE DEFAULT SYMBOL FOR SIZE OF BLK
IFNB <MYSIZ$>,<
IFN P$MXOFF,<P$OFFS==P$MXOFF> ;;SET TO LARGEST TEMPLATE
MYSIZ$==P$OFFS-P$IXOFF ;;DONT USE DEFAULT...THE CALL CONTAINS A NAME TO USE
>
>
; $BYTE - DECLARE A BYTE FIELD AT CURRENT LOCATION IN DATA STRUC.
;
DEFINE $BYTE(NAM$,BITS$)< ;;DCL A BYTE AT THE CURR OFFSET IN THE BLOCK
;;A BYTE IS DECLARED SUCH THAT THE SYMBOL CANNOT BE USED IN A WORD INSTR...
;;MACRO WILL GIVE A Q ERROR BECAUSE THE POS/SIZ
;;OF THE BYTE ARE IN THE SYM'S LEFT HALF
IFDIF <BITS$><REST>,<T$BITS==BITS$> ;;MAKE THIS VALUE UPDATABLE
IFIDN <BITS$><REST>,<T$BITS==P$POS> ;;THE "REST" SPECIAL CASE
$$BINRANGE(NAM$,T$BITS) ;;WAS THE SPECIFIED ARG VALID
$$IBP(1) ;;POSITION TO THE SPECIFIED BYTE
$$SETSYM(NAM$) ;;ASSIGN NAM$ THE 36-BIT VALUE THAT WILL BE USED TO REF IT
>
; $BYTES - DECLARE A SERIES OF BYTES IN CURRENT DATA STRUCTURE
;
DEFINE $BYTES(NAM$,BITS$,COUNT$)< ;;DCL A BYTE STRING
;;A BYTE STRING DIFS FROM A BYTE IN THAT
;;IT IS REFFED WITH ILDB (AS OPPOSED TO LDB)
;;IE. NAM$ WILL POS=LEFT RATHER THAN POS=LEFT-BITS$
IFN P$POS-WHOLE,<P$OFFS=P$OFFS+1> ;;WORD ALIGN ARRAYS FOR NOW
P$POS==WHOLE ;;IE. LEFT JUSTIFY
$$BINRANGE(NAM$,BITS$) ;;VERIFY INPUT ARG
NAM$==P$OFFS ;;SET THE SAME WAY AS FOR $WORD
IFLE COUNT$,<
P$OFFS==P$OFFS+1 ;;INCL IN FIXED SIZE THE 1ST WORD OF VARLEN FIELD
P$FXOFF==P$OFFS ;;DENOTE HERE AS WHERE FIXEDNESS STOPS
> ;;0 = TOTALLY VARIABLE/-N = MAX OF N CHARS
IFG COUNT$,<
$$IBP(COUNT$) ;;BUMP IT PAST THE BYTE STRING
P$POS==0 ;;FORCE REST OF LAST WD TO BE UNAVAIL TO OTH FLD
>
>
; $HALF - DECLARE A HALF-WORD FIELD
;
DEFINE $HALF(NAM$),<
$BYTE(NAM$,^D18) ;;DEFINE AN 18-BIT FIELD
>
; $$IBP - (INTERNAL) INCREMENT PTR INTO CURRENT DATA STRUC.
;
DEFINE $$IBP(COUNT$)< ;;INCR CONCEP PTR INTO THE CURR DATA BLK
REPEAT COUNT$,< ;;INCR THE SPEC NUMBER OF TIMES
P$POS==P$POS-T$BITS ;;MOVE THE POS TO THE RIGHT BY THE BYTE SIZE
IFL P$POS,< ;;ENTER IFL IF HAVE FALLEN OFF RIGHT END OF WORD
P$POS==WHOLE-T$BITS ;;RESET TO LEFT END & GET TO RIGHT OF DESIRED BYTE
P$OFFS==P$OFFS+1 ;;AND GO TO NEXT WORD
>
>
>
; $LOCALS - DECLARE LOCAL STORAGE FOR A ROUTINE
;
DEFINE $LOCALS< ;;DECLARE VARIABLES THAT WILL BE REFFED OFF THE STACK (USING CF)
$BLOCK(L,P$LOC) ;;APPEND THESE NEW LOCALS TO END OF STACK (DENOTED BY P$LOC)
;;LOCAL SYMBOLS SHOULD ALWAYS BE INDEXED BY (CF)
;;...EXCEPT BEFOR PROC ARGS DECODED -- & THEN BY (P)
>
DEFINE $ENDLOC< ;;BETWEEN $L/$ENDL JUST PUT $BYTE(S) AND $WORDS AS USUAL
$EOB ;;END STRUCTURE & SET INCR SZ%L
P$LOC==P$LOC+SZ%L ;;...& P$LOC, THE TOTAL # OF $LOCAL WORDS
>
; $$SETSYM - (INTERNAL) CREATE SYMBOL FOR FIELD
;
DEFINE $$SETSYM(NAM$)<
NAM$==<P$POS>B5!<T$BITS>B11!P$OFFS ;;CREATE 36-BIT SYMBOL THAT WILL IDENT A FIELD
$$MAX(P$OFFS) ;;TENTA SET HI OFFSET
>
; $TEMPLATE - DECLARE TEMPLATE OF PORTION OF DATA STRUCTURE
;
DEFINE $TEMPLATE(TYPE$,TCSIZ$)< ;;ENABLES MULTIPLE OVERLAYS OF (THE REMAINDER OF) A DATA BLK
IFG P$TYPE,<
$EOB ;;GIVE EACH INDIV TEMPLATE A SIZE
IFG P$OFFS-P$MXOFF,<P$MXOFF==P$OFFS> ;;KEEP TRACK OF LARGEST TEMPLATE
P$OFFS==P$TPOFF ;;2ND OR LATER TEMPLATE, JUST RESET FIELD OFFSET
P$POS==P$TPPOS ;;RESTOR BYTE INFO ALSO
>
IFE P$TYPE,<
P$TPOFF==P$OFFS ;;INIT 1ST TIME
P$TPPOS==P$POS ;;SAVE BYTE INFO ALSO
>
IFNB <TCSIZ$>,< ;;GIVING EACH TEMPLATE A SIZE?
DEFINE $$MAX(X$)<MX%'TCSIZ$==X$> ;;YES, SETUP MAX SYMBOL
DEFINE $$SIZ(X$)<SZ%'TCSIZ$==X$> ;;... AND NOW THE #-OF-WORDS SYMBOL
>
TYPE$==P$TYPE ;;SET THE USER SYMBOL THAT INDICATES WHICH TEMPLATE APPLIES
MX%'TYPE$==P$TYPE ;;KEEP TRACK OF LARGEST DEFINED (KLUDGE: TYPE$ SHOULD START WITH 3 DESIRED CHARS)
P$TYPE==P$TYPE+1 ;;PREPARE FOR NEXT $TEMPL
>
; $WORD - DECLARE A WORD FIELD AT CURRENT LOCATION IN DATA STRUC.
;
DEFINE $WORD(NAM$,SIZ$<1>)< ;;DCL 1 OR MORE WORDS IN THE BLOCK
IFL SIZ$,<PRINTX ?INVALID SIZE FOR NAM$>
IFN P$POS-WHOLE,<P$OFFS==P$OFFS+1> ;;DONT OVERWRITE PARTIALLY USED WORD
P$POS==WHOLE ;;NOTE THAT NEXT FIELD WILL START AT WORD BOUNDARY
$$MAX(P$OFFS) ;;TENTA SET HI OFFSET
NAM$==P$OFFS ;;PLACE THIS FIELD AT CURR OFFSET
P$OFFS==P$OFFS+SIZ$ ;;UPDATE CURR OFFSET BY NUM WDS IN THIS FIELD
>
SUBTTL FIELD MANIPULATING MACROS
;NOTE THAT LOAD AND STOR ARE NOOPS IF AC$==FIELD$.
;FIELDS MAY BE ANY SUBSET OF @RELOC+OFFSET(INDEX).
;
;IMMEDIATE VALUES ARE DISTINGUISHED FROM REGISTERS BY THE "I" MACRO:
;$INCR 1,I 2 ADDS 2 TO AC1 $INCR 1,2 ADDS AC2 TO AC1.
;HOWEVER NEGATIVE IMMEDIATE VALUES (OR NEG OFFSETS) MUST BE MASKED BY 777777
;BEFORE THEY CAN BE USED IN THESE MACROS.
;
;LITERALS SHOULD BE PROCESSED BY THE "X" MODIFIER, VIA THE PRECODED MACROS $COPX/LOADX
;OR BY THE COMPOUND OPERATOR <LIT,X> (EG. LOAD 1,<1B17,X>==LOADX 1,1B17).
;
;IMPORTANT NOTE: THE DEFAULT WORK REGISTER FOR ALL FIELD MANIPULATING MACROS IS "AP".
; THUS ARGUMENT DECODING THAT USES $COP* (AND THE OTHERS) SHOULD
; SPECIFY AN EXPLICIT WORK REGISTER, OTHERWISE AP WILL BE CLOBBERED.
;IMPORTANT NOTE: THE WORK REGISTER SHOULD NOT BE USED IN SUBSEQUENT INSTRUCTIONS
; UNLESS IT WAS EXPLICITLY SPECIFIED IN THE FIELD-MANIP MACRO.
; ADR2PG - CONVERTS AN ADDRESS TO A PAGE NUMBER
;
DEFINE ADR2PG(AC$)<LSH AC$,-9> ;DIVIDE BY 512
; $$COPY - (INTERNAL) DO A 1-DIRECTION COPY (IE. EITHER AC TO MEM OR MEM TO AC)
;
DEFINE $$COPY(AC$,FIELD$)< ;;THE EITHER-DIR COPY, DRIVEN BY THE $$INST DONE ALREADY
$$SETUP(<FIELD$>) ;;GET THE CHARACTERISTICS OF THE FIELD
%IFI T$CASE,<$$IEXP(MOVEI AC$)> ;;SPECIAL IS IMMEDIATE SOURCE
%IFWM T$CASE,<$$IEXP($$WH AC$)> ;;THE WHOLE WORD CASE
%IFAC T$CASE,<IFN AC$-FIELD$,<$$WH AC$,FIELD$>>
;;BYPASS COPY ONLY IF SOURCE/DEST SAME
%IFOTH T$CASE,<$$ARB AC$,[FIELD$]> ;;NOT AN ALIGNED HALF WORD EITHER
%IFRH T$CASE,<$$IEXP($$RH AC$)>
%IFLH T$CASE,<$$IEXP($$LH AC$)>
>
; $COPC - COPY A CHAR FROM SOURCE TO DESTBP
;
DEFINE $COPC(DEST$,SOURC$,AC$<AP>)< ;;CHAR TO BYTE STRING VIA BP
LOAD (AC$,<SOURC$>) ;;MAKE IT ACCESSIBLE
DC AC$,DEST$ ;;STORE IT AWAY (IDPB)
>
; $COPX/$COPY - COPY DATA FROM SOURCE TO DESTINATION
;
DEFINE $COPX(DEST$,SOURC$,AC$<AP>)< ;;COPY FROM LITERAL TO ANY FIELD
LOADX (AC$,<SOURC$>) ;;GET SOURCE INTO REG
STOR (AC$,DEST$) ;;PUT IT AWAY
>
DEFINE $COPY(DEST$,SOURC$,AC$<AP>)< ;;COPY FROM ANY FIELD TO ANY OTHER FIELD
LOAD (AC$,<SOURC$>) ;;GET SOURCE INTO REG
STOR (AC$,DEST$) ;;PUT IT AWAY
>
; FLAGLD - LOADS A SPECIF FLAG FROM A FIELD
;
DEFINE FLAGLD(AC$,FIELD$,FLAG$)< ;;INTO AC$ FROM FIELD$ THE FLAG FLAG$
T$2==FIELD$ ;;GET THE FIELD SPEC
T$2==T$2 & U$EA ;;ISOL EFFECTIVE ADDR
T$1==$$MPOS($SETI(FIELD$,FLAG$)) ;;GIVES # OF BIT TO RIGHT OF MASK
T$1==WHOLE-T$1 ;;NOW HOW FAR FIELD FROM RIGHT OF WD
LDB AC$,[EXP <T$1>B5!1B11!T$2] ;;BYTE PTR TO THE SPECIF FLAG
>
; $FLAG* - OPERATIONS TO MANIPULATE FLAGS WITHIN AN ARBIT FIELD
; $FLAGZ - 0 THE SPEC FLAGS
; $FLAGO - SET THE SPEC FLAGS TO 1
; $FLAGC - COMPLEMENT THE SPEC FLAGS
;
DEFINE $FLAGC(FIELD$,FLAG$,AC$<TAP>)< ;;COMPLEM FLAG$ WITHIN FIELD$
$$FLAG(FIELD$,FLAG$,AC$,XORM)
>
DEFINE $FLAGO(FIELD$,FLAG$,AC$<TAP>)< ;;TURN ON FLAG$ WITHIN FIELD$
$$FLAG(FIELD$,FLAG$,AC$,IORM)
>
DEFINE $FLAGZ(FIELD$,FLAG$,AC$<TAP>)< ;;ZERO FLAG$
$$FLAG(FIELD$,FLAG$,AC$,ANDCAM)
>
DEFINE $$FLAG(FIELD$,FLAG$,AC$,INST$)<
T$GLOB==FIELD$ ;;CREATE SIMPLE FLD
.IF T$GLOB,GLOBAL,<LOADX AC$,FLAG$> ;;ASSUME WHOLE WORD
.IFN T$GLOB,GLOBAL,<LOADX AC$,$SETI(FIELD$,FLAG$)>
;;ALIGN AND LOAD FLAGS
INST$ AC$,EAMASK&FIELD$ ;;DO THE DESIRED OPERATION
PURGE T$GLOB ;;BE CLEAN ABOUT IT
>
; I - DEFINE IMMEDIATE BIT FOR INSTRUCTION (SEE SUBTTL COMMENT)
;
DEFINE I<1B12!> ;;INDICATE THAT FIELD IS IMMED VALUE, USAGE IS I(FIELD) OR I FIELD
; $$IEXP - (INTERNAL) GENERATES AN INSTRUCTION FROM EXPRESSION
;
DEFINE $$IEXP(INST$,EA$<T$ADDR>)<<INST$,>!<EA$>> ;; OR THE PARTS TOGETHER
; $INCR - INCREMENT THE CONTENTS OF A SINGLE FIELD
;
; AC$ SHOULD NOT BE TF.
; ALSO IMMED VALS ARE ASSUMED NEGATIVE IF B18 IS ON, BUT
; THE IMMED VAL MUST BE KNOWN TO BE SMALLER THAN THE VALUE IN FIELD$
;
DEFINE $INCR(FIELD$,INCR$,AC$)< ;;F$=F$+I$, AC$ WILL ALSO CONTAIN THE RESULT (DEFAULT=T1)
;;IF 2 REGS ARE USED, TF WILL ALWAYS BE 2ND REG
$$SETUP(FIELD$) ;;DETERM WHICH CASE APPLIES
T$FC==T$CASE ;;PRESERVE IT
T$FAD==T$ADDR ;;PRESERVE T$ADDR FOR FIELD$
IFNB <AC$>,<T$AC==AC$> ;;PUT AC$ IN ACCESSIBLE LOC
IFB <AC$>,<
T$AC==AP ;;THE DEFAULT
%IFAC T$FC,<T$AC==T$ADDR> ;;CHECK SPECIAL CASE THAT DESTINATION IS REG
>
$$SETUP(<INCR$>)
T$IC==T$CASE ;;DITTO
T$IAD==T$ADDR ;;KEEP ADDR FOR INCREM
%IFI T$FC,<PRINTX ?DESTINATION OF INCR AN IMMEDIATE VALUE>
%IFWM T$FC,< ;;FULL WORD DESTINATION
%IFI T$IC,< ;;IMMEDIATE VALUE FOR INCR
IFE T$IAD-1,<$$IEXP(AOS T$AC,T$FAD)> ;;ADD 1 IS A SPECIAL CASE
IFN T$IAD-1,<
$$IEXP(HRREI T$AC,T$IAD) ;;PREPARE TO ADD IT TO DEST
$$IEXP(ADDB T$AC,T$FAD) ;;FINISH UP
>
> ;;END WORD=WORD+IMMED
%IFNI T$IC,< ;;WORD=WORD+NOTIMMED
LOAD(T$AC,INCR$) ;;GET READY TO ADD IT TO DEST
$$IEXP(ADDB T$AC,T$FAD) ;;FINISH UP
>
> ;;END OF DEST IS WORD
%IFNW T$FC,< ;;DESTINATION IS NOT A WORD
LOAD T$AC,FIELD$ ;;MAKE IT ACCESSIBLE
%IFI T$IC,< ;;IS 2ND OPR IMMED VAL?
IFE T$IC&1B18,<$$IEXP(ADDI T$AC,T$IAD)> ;;IF IMMED OPD POSIT, JUST DO ADDI
IFN T$IC&1B18,< ;;NEGATIVE IMMED OPR
IFN 17B17&T$IC,<PRINTX ?CANT HANDLE NEGATIVE INDEXED IMMEDIATE OPD IN INCR>
$$IEXP(MOVEI T$AC,T$IAD(T$AC)) ;;MOVEI HANDLES OVFLOW TO B17 CORRECTLY
>
>
%IFWM T$IC,<$$IEXP(ADD T$AC,T$IAD)> ;;DITTO
%IFAC T$IC,<ADD T$AC,INCR$> ;;IN THIS CIRCUMSTANCE, AC IS SAME AS WORD IN MEM
%IFBYT T$IC,<
LOAD TF,INCR$ ;;MAKE INCR$ ACCESSIBLE
ADD T$AC,TF
>
STOR T$AC,FIELD$ ;;FINISH UP, PUT RESULT IN DEST
>
>
; $$INST, $$WH, $$ARB, $$RH, $$LH - (INTERNAL) SUPPORT MACROS FOR COPY
;
DEFINE $$INST(WHOLE$,ARB$,RH$,LH$)< ;;THE WAY IN WHICH $$COPY IS PARAMETERIZED
DEFINE $$WH<WHOLE$ >
DEFINE $$ARB<ARB$ >
DEFINE $$RH<RH$ >
DEFINE $$LH<LH$ >
>
; LOAD - FETCH CONTENTS OF FIELD IN DATA STRUCTURE
;
DEFINE LOAD(AC$,FIELD$,X$)< ;;FIELD$ MUST BE SUBSET OF @RELOC+FIELD(REG)
IFIDN <X$><X>,<LOADX(AC$,FIELD$)> ;;SOURCE IS A LITERAL
IFB <X$>,< ;;THE USUAL CASE
$$INST(MOVE,LDB,HRRZ,HLRZ) ;;ARGS TO GENERIC MACRO
$$COPY(AC$,<FIELD$>) ;;DO THE WORK
>
>
; LOADX - MOVE A LITERAL INTO AN AC IN OPTIMAL FASHION
;
DEFINE LOADX(AC$,LIT$)<
DEFINE %IFNO<IFE .-T$ADDR> ;;SHORTHAND TO FACIL GEN JUST ONCE
T$==LIT$ ;;GET CHARAC IN PLACE CAN CTL
.IFN T$,ABSOLUTE,<MOVE AC$,[LIT$]> ;;RELOCATABLE LITERAL
.IF T$,ABSOLUTE,< ;;THE NORMAL CASE
T$ADDR==. ;;BASIS FOR %IFNO
T$R==RHMASK&T$ ;;DETERM IF HALF-WORD SYMBOL
T$L==LHMASK&T$ ;;CHK OTHER HALF
IFE T$R,<MOVSI AC$,(T$L)> ;;LEFT-HALF FIELD
%IFNO,<IFE T$L,<MOVEI AC$,T$R>> ;;RIGHT-HALF FIELD
%IFNO,<IFE <T$L_-HALF>-777777,<HRROI AC$,T$R>> ;;LEFT SIDE IS A SPEC CASE
%IFNO,<IFE T$R-777777,<HRLOI AC$,(T$L)>> ;;RIGHT SIDE SPECIAL
%IFNO,<MOVE AC$,[LIT$]> ;;NOTHING ELSE WORKED, SO JUST USE THIS
>
>
; $$M2BP - (INTERNAL) CONVERTS MASK TO BYTE PTR, USING THE SYMBOL P$BP
;
DEFINE $$M2BP(MASK$,BASE$)< ;;FROM MLOAD OR MSTOR
P$OFFS==BASE$ ;;FINISH SETUP
;;.IF P$OFFS,LOCAL,<P$OFFS==P$OFFS&U$EA> ;;MAY BE BYTE FLD IF SYM LOCAL
T$R=$$MPOS(MASK$) ;;HAVE 1+BIT POS OF RIGHT MOST 1 IN MASK
T$L==^L<MASK$> ;;HAVE BIT POS OF LEFT MOST 1
T$BITS==T$R-T$L ;;# OF 1'S IN MASK
P$POS==WHOLE-T$R ;;P$POS = # OF BITS FROM RIGHT END OF WORD
$$SETSYM(P$BP) ;;DONE
>
; MLOAD - DOES A LOAD FOR A SYMBOL DEFINED WITH A BIT MASK
; GENERATES INSTRUC AC$,BASE$ WHERE INSTRUC IS FUNCTION OF MASK$
; AND BASE$ LOCATES THE WORD CONTAINING THE DATA
;
DEFINE MLOAD(AC$,MASK$,BASE$)< ;;BASE AND MASK MUST BE SEPARATE CAUSE MASK MAY BE IN RH
$$M2BP(MASK$,BASE$) ;;SETS BYTE DATA FOR MONITOR SYMBOL
LOAD(AC$,P$BP) ;;PUT OUT APPROP INST
>
; MSTOR - DOES A STOR FOR A SYMBOL DEFINED WITH A BIT MASK
;
DEFINE MSTOR(AC$,MASK$,BASE$)< ;;BASE AND MASK MUST BE SEPARATE CAUSE MASK MAY BE IN RH
$$M2BP(MASK$,BASE$) ;;SETS BYTE DATA FOR MONITOR SYMBOL
STOR(AC$,P$BP) ;;PUT OUT APPROP INST
>
; PG2ADR - CONVERTS A PAGE NUMBER TO AN ADDRESS
;
DEFINE PG2ADR(AC$)<LSH AC$,9> ;MULT BY 512
; STOR - STORE CONTENTS OF AC INTO FIELD IN DATA STRUCTURE
;
DEFINE STOR(AC$,FIELD$)<
$$INST(MOVEM,DPB,HRRM,HRLM) ;;ARGS TO GENERIC MACRO
$$COPY(AC$,FIELD$) ;;DO THE WORK
>
; $PUSH - STACK A SEQUENCE OF ITEMS
;
DEFINE $PUSH(REG$,LIST$)<
IRP LIST$,<PUSH REG$,LIST$>
>
; $POP - UNSTACK A SEQUENCE OF ITEMS
;
DEFINE $POP(REG$,LIST$)<
IRP LIST$,<POP REG$,LIST$>
>
;$ZERO - CLEAR THE CONTENTS OF A FIELD
;
DEFINE $ZERO(FIELD$,AC$<AP>)< ;;ZERO THIS FIELD AND AC$
$$SETUP(FIELD$) ;;DETERM IF ODD-SIZE BYTE
%IFOTH T$CASE,<SETZM AC$> ;;MUST HANDLE OFF-SIZE BYTE THIS WAY
$$INST(SETZB,DPB,HLLZS,HRRZS) ;;THE ACTUAL ZEROING INSTRUCT
$$COPY(AC$,FIELD$) ;;DO IT
>
SUBTTL FLOW OF CONTROL MACROS
; CASES - DISPATCH INTO A BRANCH TABLE
;
; (EXAMPLE) CASES AC,SYM%MAX
;$CASE(0) FAILURE PATH USUALLY
;$CASE(SYM%LT) CASE FOR LOGICAL TERMINALS
; :
; :
; JRST L$CASX
;$CASE(*) OTHER CASES, ETC.
;$CASF "ABORT" PROBABLY, $CASF GENERATES ALL THE UNSPEC $CASES
;$CASX COMMON EXIT CODE
;
DEFINE CASES(AC$,MAX$,INST$<JRST >)< ;;BRANCH TO A DISPATCH VECTOR OFF OF AC$
P$CASE==P$CASE+1 ;;IN CASE MULTIPLE CASE STATS IN PROG,
P$MAXC==0 ;;...OTHERWISE WOULDNT HAVE UNIQUE LABELS
SKIPL AC$ ;;LT 0 ILLEGAL
CAILE AC$,MAX$ ;;GTR THAN MAX ILLEG
ERRI (CVO) ;;CASE-VALUE OUT OF RANGE
INST$ @[ ;;DO THE DISPATCH
REPEAT MAX$+1,< ;;THE LABEL GENERATING LOOP
L$CASE(P$MAXC) ;;THE DISPATCH, USING LABELS CREATED BY $CASE
P$MAXC==P$MAXC+1 ;;KEEP LABELS UNIQUE
>
](AC$) ;;THE AC GUIDES THE DISPATCH
>
; $CASE - DEFINE THE START OF A CASE
;
DEFINE $CASE(CASE$)<L$CASE(CASE$):> ;;THE LABEL THAT INHERENTLY IDENTIFIES THE CASE
; $CASF - GENERATE ALL THE CASES NOT EXPLICITLY SPECIFIED
;
DEFINE $CASF< ;;ASSUMPTION IS THAT THESE ARE FAILURE CASES
T$==0 ;;START WITH (0)TH CASE
DEFINE L$$CAS(C$,CN$,L$,LN$)<IFNDEF C$'CN$'L$'LN$> ;BOO
REPEAT P$MAXC,< ;;GO THRU THEM ALL, GENERATING THE UNDEF 1'S
L$$CAS(C,\P$CASE,L,\T$),<L$CASE(T$)=.> ;;SET THE UNDEF 1'S TO CURR PC
T$==T$+1 ;;TRY THE NEXT CASE
>
>
; $CASX - DEFINE A COMMON EXIT FOR A SET OF CASES
;
DEFINE $CASX<L$CASX(0):> ;;GENERATES A UNIQUE LABEL
; $ENDIF - TERMINATE CONDITIONAL CODE SEQUENCE
;
; (EXAMPLE) TEST INSTRUCTION ;;EG. CAMN
; [$SKIP INSTRUCTIONS] ;;MUST BE FIRST IF PRESENT
; [$NOSKIP INSTRUCTIONS] ;;MUST BE 2ND IF BOTH PRESENT
; $$ENDIF ;;GENS L$IFX (& CLEANS UP)
;
; OR JUMP? ANY,L$JUMP/L$IFX ;;JUMP TO TRUE CODE OR END OF IF
; THE "NO-JUMP" INSTRUCTIONS
; [EG. END IN JRST L$IFX] ;;IF EXPLIC "JUMP" CODE
; [$JUMP INSTRUCTIONS] ;;DEFINES L$JUMP
; $ENDIF ;;DITTO ABOVE
;
DEFINE $ENDIF(N$<0>)< ;;SIGNALS END OF CONDITIONALLY EXECUTED CODE & LEV OF NESTING
$$LAB(N,\<P$IF+N$>),<L$NOSK(N$):> ;;IF NO NOSKIP L$NOSK=L$IFX
$$LAB(B,\<P$IF+N$>),<L$JUMP(N$):> ;;IF NO $JUMP, L$JUMP==L$IFX
L$IFX(N$): ;;IF EXIT LABEL
P$NEST==N$ ;;PUT IN PROPER PLACE
$$HW(NEST) ;;NESTING TO A HIGHER LEVEL?
IFE P$NEST,< ;;BACK OUT AT TOP LEVEL
P$IF==P$IF+H$NEST+1 ;;START NEXT GROUP OF LABELS AFTER HIGHEST NEST
H$NEST==0 ;;NOTE STARTING OVER
>
>
; $$LAB - (INTERNAL) TESTS SWITCH VARIABLES FOR SUPPORT OF $ENDIF
;
DEFINE $$LAB(ROOT$,N$)<IFNDEF P$'ROOT$'N$>
; MACRO - CALL CODE GENERATING MACRO AS A SUBROUTINE
;
DEFINE MACRO(ARG$)< ;; TRIVIAL STUFF SHOULD BE INLINE
PUSHJ P,[ARG$ ;; MAKE A CALL TO THE MACRO WHICH
POPJ P,] ;; IS EMBEDDED IN A LITERAL
>
; L$CASE, L$CASX - LABELS GENERATED TO SUPPORT $CASE & $CASX
DEFINE L$CASE(CASE$)<%ID(C,\P$CASE,L,\<CASE$>)>
DEFINE L$CASX(X$)<%ID(L.C,\P$CASE)> ;;UNIQUE LABEL THAT MAY BE DEFINED AFTER LAST $CASE PER CASES
; L$NOSK, L$SKIP, L$IFX, L$JUMP - GENERATE LABELS FOR CONDITIONAL CODE
;
DEFINE L$NOSK(N$<0>)<%ID(L.E,\<P$IF+N$>)> ;;UNIQUE LABEL FOR AN ELSE
DEFINE L$IFX(N$<0>)<%ID(L.X,\<P$IF+N$>)> ;;UNIQUE LABEL FOR END OF CONDITIONAL CODE
DEFINE L$SKIP(N$<0>)<%ID(L.T,\<P$IF+N$>)> ;;DITTO SKIP
SYN L$SKIP,L$JUMP ;;BOTH TRUE CASES
; $$NOSK - (INTERNAL) BEGIN ALTERNATE CODE SEQUENCE
;
DEFINE $$NOSK(N$)< ;;USED FOR NON-SKIP PATH
%ID(P$N,\<P$IF+N$>)==1 ;;NOTE ITS USE
$$LAB(B,\<P$IF+N$>),<
JRST L$NOSK(N$) ;;IF NO SKIP, CREATE ITS PROLOG
JRST L$IFX(N$) ;;THE CONSTRUCTED "$SKIP"
>
L$NOSK(N$): ;;WHERE THE ELSE CODE STARTS
>
DEFINE $NOSKIP<$$NOSK(0)> ;;TOP-LEVEL BRANCH
DEFINE $NOSK1<$$NOSK(1)> ;;1-LEVEL NESTING
DEFINE $NOSK2<$$NOSK(2)> ;;2ND NESTED BRANCH
DEFINE $NOSK3<$$NOSK(3)> ;;3RD NESTED BRACH
DEFINE $NOSK4<$$NOSK(4)> ;;4TH NESTED BRACH
DEFINE $NOSK5<$$NOSK(5)> ;;5TH NESTED BRACH
DEFINE $NOSK6<$$NOSK(6)> ;;6TH NESTED BRACH
DEFINE $NOSK7<$$NOSK(7)> ;;7TH NESTED BRACH
; $$SK - (INTERNAL) BEGIN PRIMARY CODE SEQUENCE
;
DEFINE $$SK(N$)< ;;USED FOR SKIP PATH
%ID(P$B,\<P$IF+N$>)==1 ;;NOTE ITS USE
JRST L$NOSK(N$) ;;HOP OVER THE $SKIP CODE
L$SKIP(N$): ;;LABEL PROB NEVER REFFED
>
DEFINE $SKIP<$$SK(0)> ;;TOP-LEVEL BRANCH
DEFINE $SKIP1<$$SK(1)> ;;1-LEVEL NESTING
DEFINE $SKIP2<$$SK(2)> ;;2ND NESTED BRANCH
DEFINE $SKIP3<$$SK(3)> ;;3RD NESTED BRACH
DEFINE $SKIP4<$$SK(4)> ;;4TH NESTED BRACH
DEFINE $SKIP5<$$SK(5)> ;;5TH NESTED BRACH
DEFINE $SKIP6<$$SK(6)> ;;6TH NESTED BRACH
DEFINE $SKIP7<$$SK(7)> ;;7TH NESTED BRACH
; $$JUMP - BEGIN PRIMARY CODE SEQUENCE
;
DEFINE $$JUMP(N$)< ;;USED FOR JUMP PATH
%ID(P$B,\<P$IF+N$>)==1 ;;NOTE ITS USE
L$JUMP(N$): ;;PROBABLY USED ONLY IN JUMP INSTRUCTIONS
>
DEFINE $JUMP<$$JUMP(0)> ;;TOP-LEVEL BRANCH
DEFINE $JUMP1<$$JUMP(1)> ;;1-LEVEL NESTING
DEFINE $JUMP2<$$JUMP(2)> ;;2ND NESTED BRANCH
DEFINE $JUMP3<$$JUMP(3)> ;;3RD NESTED BRACH
DEFINE $JUMP4<$$JUMP(4)> ;;4TH NESTED BRACH
DEFINE $JUMP5<$$JUMP(5)> ;;5TH NESTED BRACH
DEFINE $JUMP6<$$JUMP(6)> ;;6TH NESTED BRACH
DEFINE $JUMP7<$$JUMP(7)> ;;7TH NESTED BRACH
; $$TX - (INTERNAL) SUPPORT MACRO FOR TX PSEUDO-INSTRUCTION
;
DEFINE $$TX(TYPE$,AC$,BITS$)< ;;THE TX PSEUDO-INSTRUCTIONS
T$B==BITS$ ;;GET A TEMP
.IF T$B,ABSOLUTE,<IFE T$B,<PRINTX ?ZERO MASK IN TX MACRO>>
T$L==RHMASK&T$B ;;PREPARE FOR TESTS
T$R==LHMASK&T$B ;;DITTO
IFE T$L,<TL'TYPE$ AC$,(T$B)> ;;LEFT HAND SIDE BITS
IFE T$R,<TR'TYPE$ AC$,T$B> ;;RIGHT HAND SIDE BITS
IFN T$L,<IFN T$R,<TD'TYPE$ AC$,[T$B]>> ;;IN BOTH SIDES
>
; $$TXGEN - (INTERNAL) MACRO TO GEN THE ACTUAL TX MACROS
;
DEFINE $$TXGEN(MASK$,TEST$)< ;;GENERATE THE ACTUAL MACROS
IRP MASK$,<IRP TEST$,< ;;TWO-LEVEL LOOP
DEFINE TX'MASK$'TEST$(AC$,BITS$)< ;;THE USER-SEEN MACRO
$$TX(MASK$'TEST$,AC$,BITS$)
>
>> ;;END 2-LEVEL LOOP
>
$$TXGEN(<N,O,Z,C>,<,E,N,A>) ;;PUT THEM OUT
SUBTTL MESSAGE MANAGEMENT MACROS
; DC$MES - GLOBAL SYMBOLS NEEDED BY RMSMES
;
; DEFINE DCL$GL AS APPROP IN MODULE WHERE GLOBAL STORAGE IS ALLOC
;
DEFINE DC$MES<
DCL$GL( OV.CAS, 1)
DCL$GL( OV.DSIG, 1)
DCL$GL( OV.ACT, 1)
DCL$GL( OV.LEFT, 1)
DCL$GL( TXT$CC, 1)
>
; $$C - CAUSES MSG OUTPUTTER TO POSITION THE NEXT OUTPUT AT THE SPECIFIED COL
;
; USAGE IS $$C N / FOR EXAMPLE $FMT(ABC,$$C 10,XYZ) WOULD CAUSE
; ABC XYZ
;
DEFINE $$C(COL$)<-^D<COL$+CA%IVCOL>> ;;A "CASE" WITH MAGNITUDE GTR CA%IVCOL IS HANDLED AS COLUMN ACTION
; $ERR - CALL TX$TOUT TO DISPLAY A MESSAGE
;
DEFINE $ERR(MSG$,REACT$)< ;;CALL ARGUMENTS AND LABEL
$CALL TX$TOUT,<MSG$> ;;DO THE CALL
IFNB <REACT$>,<JRST REACT$> ;;RESUME EXEC AT DESIRED ADDR
>
; $FMT - FMT STAT FOR ENTIRE LINE
;
DEFINE $FMT(MNAME$,FMT$)< ;;SEE $$FMT
XLIST
$$FMT(MNAME$,<FMT$>) ;;TRANS PASS ARGS
IFNDEF $$FTX,<EXP -CA%EXIT> ;;GIVE EXPLIC END WORD
IFDEF $$FTX,< ;;UNPROC STRING?
$$FTX ;;YES, PUT IT OUT
PURGE $$FTX ;;GET RID OF IT
>
LIST
>
; $$FMT - BUILDS THE DESCRIPTION OF A WARNING/ERROR/MESSAGE
;
DEFINE $$FMT(MNAME$,FMT$)< ;;THE NAME/LABEL FOR FMT STAT & THE FMT
IFNB <MNAME$>,<MNAME$::> ;;MAKE IT DIRECTLY REFFABLE
IRP FMT$,< ;;GET EACH SUB-FIELD FROM FORMAT STAT
T$CTL==0 ;;INDICS IF TEXT OR FORMAT CODE
IFDEF $$FTX,< ;;UNPROC STRING?
[$$FTX] ;;YES, PUT IT OUT
PURGE $$FTX ;;GET RID OF IT
>
IRPC FMT$,<
IFIDN <$><FMT$>,< ;;$$ SPECIAL CASE
IFL T$CTL,<T$CTL==1> ;;YES, 2ND TIME THRU
IFE T$CTL,<T$CTL==-1> ;;NO, FORCE 2ND PASS THRU
>
IFDIF <$><FMT$>,<T$CTL==0> ;;HANDLE CASE OF $ FOLLOWED BY NOT $
IFIDN <-><FMT$>,<T$CTL==1> ;;FMT CODE STARTS WITH MINUS SIGN
IFGE T$CTL,<STOPI> ;;CAN ONLY BE 1ST CHAR
>
IFN T$CTL,<FMT$> ;;PUT OUT THE FMT CODE
IFE T$CTL,<DEFINE $$FTX<ASCIZ\FMT$\>> ;;SAVE TEXT
>
>
SYN $ERR,$MSG ;;HAVE SYNONYMS TO DOCUMENT WHY THE MSG IS PUT OUT
SYN $ERR,$WARN
; $MCASE - DENOTES START OF CODE TO PROCESS & CREATES THE CASE'S ID
;
DEFINE $MCASE(NAM$)< ;;NAM$ OUGHT TO BE OF FORM CC%---
NAM$==P$GC+CA%CCA ;;MAKE IT OFFICIAL
$CASE(P$GC) ;;DEFINE THE LABEL
P$GC==P$GC+1 ;;PREPARE FOR NEXT 1
>
; $MSCOPE - RECEIVES THE PUSHJ FROM MSG OUTPUTTER & DISPATCHES IT APPROPRIATELY
;
DEFINE $MSCOPE(LREGS$)< ;;THIS DISPATCH MAY NOT BE A LITERAL
P$GC==0 ;;DRIVES $MCASE
$SCOPE (COMPON-SPECIF CASES) ;;CREATE THE CASE-COMMON SCOPE
$LREG (CAP) ;;CURR ARG PTR
IRP LREGS$,<$LREG(LREGS$)> ;;PUT OUT A REG DCL
$PROC (C.CASES,<IDXCAS,ARGCAS>) ;;ALL THE NECES INFO
MOVE T1,@IDXCAS(AP) ;MATER THE INDEX
MOVE CAP,@ARGCAS(AP) ;MATER THE CURR ARG PTR
$ENDARG
CASES T1,MX%CCA-1 ;;DO THE DISPATCH (EACH CASE SHOULD END IN "RETURN")
>
DEFINE $ENDMS< ;;END THE $MSCOPE
$ENDPROC ;;END THE C-S CASES
$ENDSCOPE ;;...AND THEIR DCL CONTEXT
>
DEFINE NOCR<1B12+> ;;"DATA TYPE" OF MSG IS NO TRAILING CRLF
; $TYPE - TYPE AN ALL-TEXT MSG
;
DEFINE $TYPE(TXT$)<$CALLB TX$TOUT,<[RM$ASZ],[ASCIZ/TXT$/]>>
EXTERN RM$ASZ,TX$TOUT
; $$N - NUMeric field BLANK PADDED TO explic field size, usage anal to $$C
; $$Z - NUMeric field ZERO PADDED TO explic field size, usage anal to $$C
;
DEFINE $$N(NUM$)<-^D<NUM$+CA%IVNUM>>
DEFINE $$Z(NUM$)<-^D<NUM$+CA%ZVNUM>>
$BLOCK (CA) ;THE FORMAT CODE CASES
MX%CCA==10 ;MAX # OF COMPON SPECIFIC CASES
$WORD (CA%EXIT) ;AUTO CALLED AT END OF FMT PROCESSING
$WORD (CA%ASZ) ;SPECIFY THIS TO OUTPUT AN ASCIZ STRING
$WORD (CA%CMA) ;OUTPUT A COMMA
$WORD (CA%CRLF) ;OUTPUT A CRLF
$WORD (CA%DIR) ;OUTPUT A DIRECTORY STRING
$WORD (CA%DT) ;DATE & TIME
$WORD (CA%DTD) ;DATE ONLY
$WORD (CA%DTT) ;TIME ONLY
$WORD (CA%FIL) ;FILE NAME IS TO BE OUTPUT
$WORD (CA%JSE) ;JSYS ERROR: PUTS OUT ERSTR IF TCS.EC LT 0
$WORD (CA%MIN) ;OUTPUT A MINUS SIGN
$WORD (CA%NUM) ;UNPADDED NUMERIC FIELD
$WORD (CA%PNUM) ;PADDED NUMERIC (2 ARGS: # OF CHARS IN FIELD, THE NUMBER)
$WORD (CA%OCT) ;OCTAL NUM WITH LEADING 0'S STRIPPED
$WORD (CA%NOCR) ;SUPPRESS TERMINATING CRLF
$WORD (CA%SIX) ;A SIXBIT WORD
$WORD (CA%STP) ;STRING PTR
$WORD (CA%TCE) ;TCS ERROR STATUS MSG
$WORD (CA%VARY) ;VARYING STRING
$WORD (CA%JSM) ;JUST MSG ASSOC WITH JSYS
$WORD (CA%R50) ;RADIX50 WORD
$WORD (CA%RFA) ;AN RFA: P#/ID#
$WORD (CA%FLO) ;SING PREC FLO NUM
$WORD (CA%CCA,MX%CCA) ;THESE CASES CAN BE DIF PER COMPONENT
$EOB
CA%IVCOL==^D100 ;cases less than -100 are cols
CA%IVNUM==^D300 ;cases ltl -300 are padded nums
CA%ZVNUM==^D340 ;DITTO -340 & 0 PADDED
SUBTTL ONCE-ONLY CODE
;THESE MACROS WOULD BE PLACED IN 1 MODULE PER COMPONENT.
;THEY RESPECTIVELY GENERATE THE ENTRY AND EXIT SEQUENCE FOR EXTERNAL ROUTINE CALLS
;
;PRESUMABLY ONE WOULD PLACE THEM IN THE TOP LEVEL MODULE IN A COMPONENT.
;
;ALSO, NOTE THAT THEY ARE DRIVEN BY THE NUMBER OF GREGS, AND THAT CONVERS<ELY
;ANY AND ALL GREGS FOR A COMPONENT MUST BE DEFINED IN ITS SYM FILE.
; $PRENT - COMMON-CODE FOR $PROC ENTRY SEQUENCE
;
DEFINE $PRENT< ;;THIS CODE SHOULD APPEAR ONCE IN A COMPONENT
T$==U$SYS-1 ;;START 1 LOWER THAN LOWEST GREG
REPEAT U$SYS-U$TREG-1,< ;;JUST COVER THE MODULE REGS
%ID(EN..,\<T$-U$TREG>):: ;;ENT.N MEANS SAVE N LREGS
MOVEM T$,T$-U$TREG-1+SZ%FH(P) ;;THE SAVING INST (1ST LREG AT SZ%FH(P))
T$==T$-1 ;;DO DOWNWARDS SO CAN JSP TO RIGHT START PT
>
EN..0:: ;;LOC THAT SAVES NO REGS
MOVEM CF,FH.OCF(P) ;;CF ALWAYS GOES HERE
HRLZM TF,FH.UNW(P) ;;SET ENTRY ADDR & DEFAULT TO NO ERR HANDLER
JRST @TF ;;RETURN TO INLINE CODE
SV0..5:: ;;THE TEMP ACS
EXCH TF,0(P)
PUSH P,T1
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,T5
PUSH P,TF
MOVE TF,-6(P)
POPJ P,
RS5..0:: ;;RESTOR THE TEMPS
POP P,TF
POP P,T5
POP P,T4
POP P,T3
POP P,T2
POP P,T1
EXCH TF,0(P)
POPJ P,
>
; $PREXIT - COMMON-CODE FOR $PROC EXIT SEQUENCE
;
DEFINE $PREXIT< ;;INVERSE OF $PRENT
T$==0 ;;INIT FOR LOOP
XF..10::TDZA TF,TF ;;THE NOLOCALS SPECIAL CASE
XT..10::SETOM TF ;;DITTO FOR TRUE
EX..10::POPJ P, ;;DITTO FOR NO CARE
REPEAT U$SYS-U$TREG,< ;;DO THE RETT/RETF STUFF
%ID(XF..,\T$)::TDZA TF,TF ;;FALSE: TF=0
%ID(XT..,\T$)::SETOM TF ;;TRUE: TF=-1
JRST %ID(EX..,\T$) ;;MERGE WITH "POP" CODE AT RIGHT PT
T$==T$+1 ;;DO NEXT ONE
>
T$==U$SYS-1 ;;START 1 LOWER THAN LOWEST GREG
REPEAT U$SYS-U$TREG-1,< ;;JUST COVER THE MODULE REGS
%ID(EX..,\<T$-U$TREG>):: ;;EX.N MEANS RESTORE N LREGS
MOVE T$,T$-U$TREG-1+SZ%FH(CF) ;;THE RESTORING INST
T$==T$-1 ;;DO DOWNWARDS SO CAN JRST TO RIGHT START PT
>
EX..0:: ;;LOC THAT SAVES NO REGS
MOVE P,CF ;;HOP BACK OVER EVERYTHING
MOVE CF,FH.OCF(P) ;;ALWAYS AT SAME PLACE ON STACK
POPJ P, ;;RETURN TO CALLER
>
; $PRLABEL - EXTERNS FOR ALL THE ENTRY/EXIT SYMBOLS
; (NOT USED EXCEPT ONCE AT END OF RMSMAC)
DEFINE $PRLABEL(HI$)< ;;GEN LABELS FOR 0 THRU HI$
T$==0 ;;START PT
REPEAT HI$+1,< ;;DO IT
%ID(EXTERN EN..,\T$) ;;ENTRY
%ID(EXTERN EX..,\T$) ;;PRIMARY EXIT
%ID(EXTERN XT..,\T$) ;;TRUE EXIT
%ID(EXTERN XF..,\T$) ;;FALSE EXIT
T$==T$+1 ;;DO NEXT GROUP
>
>
; $VERS - UNIFORMLY SETS VERSION NUMBER OF A COMPONENT,
; SHOULD BE PLACED IN END STAT OF TOP-LEVEL MODULE IN EACH COMPON.
;
DEFINE $VERS< ;;SET THE COMMON VERSION NUMBER FOR PROG
VR%CUS==0 ;;PROBABLY ALWAYS 0
VR%VERS==1 ;;MAJOR RELEASE CYCLE
VR%MAINT==1 ;;EG. ==1 WOULD IMPLY VERSION 1A
VR%EDIT==126 ;;UPDATED EACH TIME PUBLISHED PATCHED
BYTE (3)VR%CUS(9)VR%VERS(6)VR%MAINT(18)VR%EDIT
>
SUBTTL PROCEDURAL CONTROL MACROS
;THE FORMAT OF A PROCEDURE IS AS FOLLOWS
; $SCOPE (TITLE)
; COMMENT DESCRIBING IT
; [$LREGS]
; [$LOCALS]
; $PROC
; THE CODE FOR THIS $PROC
; [ENCOMPASSED SCOPES, PROCEDURES, & UTILS]
; $ENDPROC
; [MORE $PROC ... $ENDPROCS]
; [ANY $UTIL ... $ENDUTILS]
; $ENDSCOPE
;
; [MORE $SCOPE ... $ENDSCOPES]
;A SCOPE MERELY DEFINES A SCOPE OF NAMES.
;A PROC DEFINES AN INDIVIDUAL CALLABLE ROUTINE.
;A UTIL DEFINES AN INTERNAL ROUTINE: IT SHARES THE SCOPES OF ANY $PROCS
;THAT PRECEDE IT. IN PARTICULAR IT MAY BE CALLED BY ANY $PROC (OR $UTIL)
;THAT IS ENCOMPASSED BY ITS IMMEDIATELY ENCOMPASSING SCOPE.
; DEFINE BEGINNING OF BLISS CALLED PROCEDURE
;
DEFINE $BLISS(NAME$,ARGS$)<
$$DECODE ;;MAKE SURE PREV GUY PROPERLY DONE
P$ARG==0 ;;INIT ARG OFFSET
IRP ARGS$,<
ARGS$=P$ARG ;;SET INDEX
P$ARG==P$ARG+1 ;;MOVE TO NEXT ARG
>
IRP ARGS$,<ARGS$==RHMASK&<ARGS$-P$ARG>> ;;MAKE ARG SYMBOLICALLY REFFABLE
;;ARGS$ MUST BE HALF WD SO THAT ARGS$(X)
;;DOESNT EVAL TO X-1,,ARGS$
$$PROC(NAME$) ;;DO ALL THE COMMON STUFF
>
; $CALLB - INVOKE A ROUTINE USING BLISS CALLING CONVENTION
;
; NAME$ = ROUTINE NAME
; ARGS$ = ARG LIST
; PUTED$ = NON-0 IF COMPUTED ROUTINE ADDR
;
DEFINE $CALLB(NAME$,ARGS$,PUTED$<0>)< ;;INVERSE OF AN $PROC OR $UTIL
IFNB <ARGS$>,< ;;BUILD ARG LIST (BY REF OFF OF AP)
T$ARG==0 ;;SETUP FOR LOOP
IRP ARGS$,<
T$ARG==T$ARG+1 ;;SO CNT WILL BE DEFINED WHEN LITERAL IS PUT OUT
PUSH P,ARGS$ ;;PUSH CURR ARG
>
>
IFE PUTED$,<IF2,< ;;NOT COMPUTED & AFT DEF
IFNDEF NAME$,<EXTERN NAME$> ;;YES, SO MAKE DEFINED
>>
PUSHJ P,NAME$
IFNB <ARGS$>,<ADJSP P,-T$ARG> ;;UNPUSH THE ARGS
>
; $CALL - INVOKE A SUBROUTINE
;
DEFINE $CALL(NAME$,ARGS$,PUTED$<0>)< ;;INVERSE OF AN $PROC OR $UTIL
IFE PUTED$,<IF2,< ;;NOT COMPUTED & AFT DEF
IFNDEF NAME$,<EXTERN NAME$> ;;YES, SO MAKE DEFINED
>>
IFNB <ARGS$>,< ;;BUILD ARG LIST (BY REF OFF OF AP)
T$ARG==0 ;;SETUP FOR LOOP
IRP ARGS$,<T$ARG==T$ARG+1> ;;SO CNT WILL BE DEFINED WHEN LITERAL IS PUT OUT
T$AP==[-T$ARG,,0 ;;THE ARG CNT EVENTUALLY
IRP ARGS$,<ARGS$>] ;;THE ACTUAL ARG PTRS IN THE LITERAL
MOVEI AP,T$AP+1 ;;PT AT 1ST ARG, NOT ARG CNT
>
PUSHJ P,NAME$
>
; $$DECODE - (INTERNAL) CHECK IF ARGS HAVE BEEN DECODED CORRECTLY
;
DEFINE $$DECODE< ;;CHECK IF REQUIRED $ENDARG WAS DONE
IFG P$ARG,<PRINTX ?"ENDARG" MACRO NOT SPECIFIED FOR ABOVE PROC>
>
; $$DHW - (INTERNAL) INIT A HIGH WATER MARK FOR A CONSTRUCTED SYMBOL
;
DEFINE $$DHW(SC$,LR$)<IFNDEF H$'LR$'S'SC$,<H$'LR$'S'SC$==P$LREG>>
; $ENDARG - MUST BE SPECIFIED AFTER ARGS OF $PROC HAVE BEEN DECODED
;
DEFINE $ENDARG< ;;INDICS ARGS HAVE BEEN DECODED & FINS CONTEXT SETUP
IFNDEF P$CF,<IFG P$ARG,< ;;NOOP IF NO CONTEXT TO SAVE OR ALREADY DONE IN NO ARGS CASE
MOVEM P,CF ;;SETUP CURR FRAME PTR
ADJSP P,P$LOC-1 ;;ADJUST THE STACK PTR, -1 CAUSE PUSHJ ADDS 1 AUTO
>>
$OKARG ;;INDIC $ENDARG WAS NOT ACCID OMITTED
;;NOTE, HOWEVER THAT SUPERF $ENDARGS ARE PERMITTED
>
; $ENTRY - CREATES A 2NDARY ENTRY PT TO A $PROC OR $UTIL
;
DEFINE $ENTRY(NAME$,ARGS$)< ;;SAME ARGS AS FOR $PROC AND $UTIL
IFE P$RLEV,<$PROC(NAME$,<ARGS$>)> ;;MEANS A $PROC CONTEXT
IFG P$RLEV,<$$UTEN(NAME$,<ARGS$>)> ;;MEANS A $UTIL CONTEXT
>
; $MAIN - DECLARE TOP LEVEL ENTRY POINT IN A COMPONENT
;
DEFINE $MAIN(NAME$,EH$,STACK$)< ;;PUT OUT TOP LEVEL ENTRY SEQ
XLIST
P$PROC==P$PROC+1 ;;BUMP CNT OF # OF PROCS SEEN THIS SCOPE
P$LROWN==P$PROC ;;ENCOMPASSED UTILS WILL BUMP THIS PROC'S REG CNT
$$DHW(\P$SCOPE,\P$LROWN) ;;GIVE INIT VAL TO HW VAL
P$SREG==P$LREG ;;BY DEF, IT SAVES ALL LREGS
$$HW(LREG) ;;GET HIGH-WATER MARK FOR LREG IN $PROC TOO
$PRENT ;;COMMON SAVE SEQ
$PREXIT ;;COMMON EXIT SEQ
$ERRV ;;PUT OUT DISPATCH VECTOR
$ERRT ;;TRAP NAME/TEXT VECTOR
IFNB <NAME$>,< ;;GEN ENTRY PT TOO?
NAME$: ;;THE ACTUAL ENTRY POINT
MOVE P,[STACK$] ;;SETUP STACK PTR
SETZM FH.OCF(P) ;;INDIC THAT THERE IS NO OLD CF
P$ARG==1 ;;FORCE $ENDARG TO WORK
$ENDARG ;;ADJUST STACK PTR
$EH(EH$) ;;SETUP THE TOP-LEVEL ERR-HANDLER
>
LIST
>
DEFINE $ENDMAIN(DUMMY$)< ;;DEFINE $ENDMAIN
$ENDPROC
>
; $NOCF - SUPPRESS USE OF CF FOR SMALL HIGH PERFORMANCE ROUTINES
; NOTE THAT "ABORT" IS INCOMPAT WITH SUPPRESSED CF
;
DEFINE $NOCF< ;;APPLIC ONLY IF LREGS OR LOCALS DONT DEMAND CF
T$==P$LOC-SZ%FH ;;GET LOCALS INFO, ELIMIN FRAM HDR
IF2,<T$==T$-<H$LREG-U$TREG>> ;;MAKE IT WELL DEFINED, ELIM PASS DEPENDS
IFE T$+P$LREG-U$TREG,<P$CF==1> ;;SUPPRESSION OK P$CF DEFINED HERE
>
; $OKARG - ALLOWS MERGES OF ENTRY PTS TO OMIT $ENDARG
;
DEFINE $OKARG<P$ARG==0> ;;MAKES $$DECODE HAPPY
; $$PROC - COMMON STUFF TO DECLARE A PROCEDURE
;
DEFINE $$PROC(NAME$)<
XLIST
P$PROC==P$PROC+1 ;;BUMP CNT OF # OF PROCS SEEN THIS SCOPE
P$LROWN==P$PROC ;;ENCOMPASSED UTILS WILL BUMP THIS PROC'S REG CNT
DEFINE $$DHW(SC$,LR$)<IFNDEF H$'LR$'S'SC$,<H$'LR$'S'SC$==P$LREG>>
$$DHW(\P$SCOPE,\P$LROWN) ;;GIVE INIT VAL TO HW VAL
P$SREG==P$LREG ;;BY DEF, IT SAVES ALL LREGS
$$HW(LREG) ;;GET HIGH-WATER MARK FOR LREG IN $PROC TOO
ENTRY NAME$ ;;SO IT WILL SATISFY A /SEARCH
NAME$:: ;;THE ACTUAL ENTRY POINT
$$SAVE ;;SETUP THIS GUY'S ENVIR
LIST
>
; $PROC - DECLARE ENTRY POINT AND ARGS FOR A PROCEDURE
;
DEFINE $PROC(NAME$,ARGS$)< ;;DCLS A ENTRY POINT AND ITS ARG LIST
$$DECODE ;;MAKE SURE PREV GUY PROPERLY DONE
P$ARG==0 ;;BUILD UP ARG SYMBOLS
IFNB <ARGS$>,<IRP ARGS$,<
ARGS$==P$ARG ;;THE ACTU ASSIGNMENT
P$ARG==P$ARG+1 ;;PREPARE FOR NEXT
>>
$$PROC(NAME$) ;;DO COMMON STUFF
>
DEFINE $ENDPROC(DUMMY$)< ;;TERMINATE PROC CONTEXT
P$LROWN==0 ;;RESUME TIEING REGS TO TOP-LEVEL UTILS
>
; $$SAVE - (INTERNAL) GENERATE CODE TO SAVE AC'S
;
DEFINE $$SAVE< ;;GENERATE THE INLINE CODE TO SAVE MODULE REGS
IFNDEF P$CF,< ;;ONLY GO TO COMMON SAVE CODE IF SOMETHING TO SAVE
P$P==%ID(H$,0,S,\P$SCOPE) ;;PREPARE TO DETERM MAX REG ASSOC TO THIS PROC
IFG %ID(H$,\P$LROWN,S,\P$SCOPE)-P$P, <P$P==%ID(H$,\P$LROWN,S,\P$SCOPE)>
P$P==P$P-U$TREG ;;NUM OF REGS IN ITS CONTEXT
DEFINE L$$RET(LAB$)<%ID(LAB$,\P$P)> ;;SETUP MACRO THAT DRIVES "RETURN" MACROS
JSP TF,%ID(EN..,\P$P) ;;BOP TO COMMON CODE TO DO IT
IFE P$ARG,<
P$ARG==1 ;;KLUDGY WAY TO FORCE $ENDARG TO DO ITS THING
$ENDARG ;;IF NO ARGS, PUT OUT END OF SAVE SEQ NOW
> ;;IN SAME WAY CODER WOULD DO IT
>
IFDEF P$CF,<
PURGE P$CF ;;MAKE SLATE CLEAN FOR NEXT PROC
DEFINE L$$RET(LAB$)<LAB$'10> ;;THE NO CF CASE
$OKARG ;;ENDARG INHER UNNEC IF NO CALLER CONTEXT TO SAVE
>
>
; $SCOPE - DECLARE BEGINNING OF SCOPE OF FOLLOWING LREGS AND LOCALS
;
DEFINE $SCOPE(PURP$)< ;;DENOTES BEGIN OF SCOPE OF THE LOCALS FOLLOWING AND STATES ITS NATURE
;;LREGS AND LOCALS IF ANY SHOULD FOLLOW IT
%SAVE(L,LREG) ;;SAVE STATE OF LREGS IN ENCOMPASSING LEVEL
%SAVE(L,LOC) ;;DITTO TOTAL LOCALS
;;...BUT NOTE THAT EXISTING VALS ARE BASIS FOR VALS AT NEW LEVEL
IFE P$LLEV,< ;;TOP-LEVEL SCOPE?
P$SCOPE==P$SCOPE+1 ;;YES, SO BUMP CNT OF TOP-LEVEL SCOPES
P$PROC==0 ;;PROCS ARE CNTED PER SCOPE
$$DHW(\P$SCOPE,0) ;;THE HW MARK FOR THE TOP-LEVEL UTILS
>
P$LLEV==P$LLEV+1 ;;BUMP RECURSION LEVEL
>
DEFINE $ENDSCOPE(DUMMY$)<
P$LLEV==P$LLEV-1 ;;BACK OUT A LEVEL
%RESTORE(L,LOC) ;;GO BACK TO ENCOMP LEVEL
%RESTORE(L,LREG) ;;DITTO
IFG P$SREG-P$LREG,<P$SREG==P$LREG> ;;DONT KEEP VALUE SREG IF INCR BY ENDED SCOPE
>
; TSAVE, TPOP - SAVE/RESTORE THE TEMPORARY AC'S
;
DEFINE TSAVE<PUSHJ P,SV0..5> ;;SAVE THE TEMP REGS
DEFINE TPOP<PUSHJ P,RS5..0> ;;RESTOR THEM
; $UTIL - DECLARE A LOCAL ROUTINE AND ITS ARGS
;
DEFINE $UTIL(NAME$,ARGS$)< ;;DECLARES A LOCAL ENTRY POINT
P$UTIL==P$UTIL+1 ;;INDIC HAVE SEEN ANOTHER
IFG P$LREG-%ID(H$,\P$LROWN,S,\P$SCOPE), <%ID(H$,\P$LROWN,S,\P$SCOPE)==P$LREG)>
;;SET MAX LREG FOR ENCOMPASSING PROC
$$HW(LREG) ;;GET HIGH-WATER MARK FOR LREG
;;$$HW(LOC) ;;CHECK IF NEW HIGH-WATER MARK FOR LOCALS
P$RNEW==P$LREG-P$SREG ;;MAKE ANY ADDIT REG SCOPE EASY TO PLAY WITH
IFE P$RNEW,<DEFINE L$$RET(LAB$)<LAB$'10>> ;;JUST JRST TO PRECODED QUICKIE EXIT SEQ
IFG P$RNEW,< ;;...UNLESS SOMETHING TO RESTORE
DEFINE L$$RET(LAB$)<%ID(LAB$,\P$UTIL)> ;;GEN REFERENCES AUTO WITH THIS
%ID(XF..,\P$UTIL):TDZA TF,TF ;;FAILURE PATH
%ID(XT..,\P$UTIL):SETOM TF ;;SUCCESS PATH
%ID(EX..,\P$UTIL): ;;THE TF-LESS CASE
T$==P$LREG ;;POP FROM HIGHEST DOWN
REPEAT P$RNEW,< ;;NOW GEN THEM
POP P,T$ ;;POP A REG
T$==T$-1 ;;POP NEXT LOWER
>
POPJ P, ;;DONT FALL THRU!
>
$$UTEN(NAME$,<ARGS$>) ;;DO THE STUFF THAT IS ENTRY SPECIFIC
%SAVE(R,SREG) ;;SAVE P$SREG WITH RESPECT TO ROUTINE LEVEL
P$RLEV==P$RLEV+1 ;;BUMP THE ROUTINE LEVEL
P$SREG==P$LREG ;;SO THAT ENCOMPASSED UTIL (IF ANY) WONT SAVE THEM ALSO
>
DEFINE $ENDUTIL(DUMMY$)< ;;RESET THE ROUTINE-LEVEL
P$RNEW==1 ;;GUARD AGAINST RETURN IN CODE AFTER $ENDUTIL (PREV GEN OF POPJ)
P$RLEV==P$RLEV-1 ;;DONE
%RESTOR(R,SREG) ;;GO BACK THE OLD CONTEXT
>
DEFINE $$UTEN(NAME$,ARGS$)< ;;SAME AS FOR $UTIL, $PROC, $ENTRY
NAME$: ;;THE ACTUAL ENTRY POINT
IFG P$RNEW,< ;;ADDIT SCOPE SINCE LAST $PROC OR $UTIL
T$==P$LREG-P$RNEW+1 ;;INIT PUSH
REPEAT P$RNEW,< ;;SO SAVE THESE REGS EXPLIC
PUSH P,T$ ;;START WITH ONE HIGHER THAN LAST SAVED
T$==T$+1 ;;TRY ANOTHER
>
>
$$DECODE ;;MAKE SURE PREV GUY PROPERLY DONE
T$ARG==0 ;;BUILD UP ARG SYMBOLS
IFNB <ARGS$>,<IRP ARGS$,<
ARGS$==T$ARG ;;THE ACTU ASSIGNMENT
T$ARG==T$ARG+1 ;;PREPARE FOR NEXT
>>
>
SUBTTL PROCEDURE EXITING MACROS
; ABORT - IGNORES CURRENT CONTEXT AND RETURNS TO CALLER OF EXTERNAL PROC
;
DEFINE ABORT<JRST L$ABORT> ;;USE THE STANDARD LABEL
; A PROCEDURE CAN MAKE ITSELF A TRAP HANDLER THRU THE $EH MACRO
; & DYNAMICALLY INFERIOR PROCEDURES THAT SIGNAL A TRAP WILL RETURN
; DIRECTLY TO IT.
;
; IF THE TRAP IS DEFINED VIA H$GO, THE ERROR WILL "GO TO" THE HANDLER ADDRESS
; IN THE APPROP PROC.
; IF THE TRAP IS DEFINE VIA H$RET, THE ERROR WILL RETF TO THE INST FOLLOWING
; THE $CALL IN THE HANDLER PROC THAT LED TO THE TRAP.H
; ER* - GROUP OF MACROS TO SIGNAL TRAPS
; ERRC - SIGNAL & SET ERR CODE
; ERRI - SIGNAL INTERNAL ERROR, SET ERR CODE, & OPT SAVE A MSG
; ERRU - SIGNAL USER ERROR, SET ERR CODE, & SAVE A MSG
; ARGUMENTS:
; ERR$ = NAME OF TRAP
; MSG$ = FMT STATEMENT ARGS TO USE TO GEN CA%TCE MSG
; TR$ = TRANSFER MECH (USUALLY PUSHJ P,)
;
DEFINE ERC(ERR$,MSG$)<ERRI(ERR$,<MSG$>,ERCAL)> ;;DO JSYS ERCAL
DEFINE ERCU(ERR$,MSG$)<ERRU(ERR$,<MSG$>,ERCAL)> ;;DO JSYS ERCAL
DEFINE $ERRC(ERR$)<EC%'ERR$> ;;HOW REFFED IN TESTS
DEFINE ERRC(ERR$,TR$<CALL>)< ;;JUST SIGNAL A CODE
TR$ EH.'ERR$ ;;DO IT
>
DEFINE ERRI(ERR$,MSG$,TR$<CALL>)< ;;PROCESS A TRAP
IFB <MSG$>,<TR$ EH.'ERR$> ;;CALL THE SPECIFIED ERR HANDLER
IFNB <MSG$>,< ;;USER SUPPLIED INFO
TR$ [ ;;CREATE ROOM TO PROC IT
$CALLB TX$TOUT,<[$$CPON(0)'ERR$],MSG$> ;;USER-SPEC MSG
JRST EH.'ERR$ ;;DO THE PUSHJ
] ;;TERM THE PUSHJ
>
>
DEFINE ERRU(ERR$,MSG$,TR$<CALL>)< ;;PROCESS A TRAP
TR$ [ ;;CREATE ROOM TO PROC IT
IFB <MSG$>,<$CALLB TX$TOUT,<[$$CPON(0)'ERR$]>> ;PUT OUT MSG
IFNB <MSG$>,<$CALLB TX$TOUT,<[$$CPON(0)'ERR$],MSG$>> ;;USER-SPEC ARGS
JRST EH.'ERR$] ;;DO THE PUSHJ
>
DEFINE L$ERRC(ERR$)<[ERRC(ERR$)]> ;;GEN ERRC FROM JUMP
DEFINE L$ERRI(ERR$,MSG$)<[ERRI(ERR$,<MSG$>)]> ;;GEN ERRI FROM JUMP
DEFINE L$ERRU(ERR$,MSG$)<[ERRU(ERR$,<MSG$>)]> ;;GEN ERRU FROM JUMP
DEFINE L$UNW<TRAP.U##> ;;JUST UNWIND, NO ERR CODE
DEFINE UNWIND<PUSHJ P,TRAP.U##> ;;DITTO
; $ERRD - DEFINE SYSERR ERR CODES, SHOULD APPEAR IMMED BEFORE $EHVEC IN UNV FILE
;
DEFINE $ERRD(CP$<RM$>,IV$<0>)< ;;CAUSES DEF OF ERR CODES
P$TRAP==-1 ;;DEFINE CASE
U$ERR==IV$ ;;DEFAULT IV$ IS APPROP FOR MAJ COMPON
DEFINE H$GO(ERR$,DUM$)< ;;SET EACH SYMBOL
EXTERN EH.'ERR$,CP$''ERR$ ;;MAKE EXTERN DEF AVAIL IF NECES
U$ERR==U$ERR+1 ;;ALLOC NEXT CODE
$ERRC(ERR$)==U$ERR ;;ASSIGN IT
>
SYN H$GO,H$RET ;;PUT SYS ERRS & USER ERRS IN SAME VEC
>
DEFINE $ERRT< ;;VECTOR OF ERR TEXT CODES
P$TRAP==0 ;;TEXT MESSAGES CASE
DEFINE H$GO(ERR$,FMT$)<
IFB <FMT$>,<XWD ''ERR$'',RM$'ERR$> ;;DISPATCH ERR FOR TRAP
IFNB <FMT$>,<XWD ''ERR$'',FMT$> ;;USE REQUESTED FMT
>
SYN H$GO,H$RET ;;PUT SYS ERRS & USER ERRS IN SAME VEC
TXFIRST: $RMSERR ;;PUT OUT ERRS ASSOC WITH RMSLIB
TX.0:: XWD 'NME',RM$NME## ;;RMSLIB ERRS LT 0, COMPON ERRS GT 0
;;REFFED BY MSG OUTPUTTER (NO MSG SET UP FOR ERROR)
DEFINE H$GO(ERR$,FMT$)<
IFB <FMT$>,<XWD ''ERR$'',$$CPON(0)'ERR$> ;;DISPATCH ERR FOR TRAP
IFNB <FMT$>,<XWD ''ERR$'',FMT$> ;;USE REQUESTED FMT
>
SYN H$GO,H$RET ;;PUT SYS ERRS & USER ERRS IN SAME VEC
$CPERR
>
DEFINE $ERRV< ;;DISPAT VEC ENTRY
P$TRAP==1 ;;DISP VECTOR CASE
DEFINE H$GO(ERR$,DUM$)<
EH.'ERR$::PUSHJ P,TRAP.H-2 ;;DISPATCH ERR FOR TRAP
>
DEFINE H$RET(ERR$,DUM$)<
EH.'ERR$::PUSHJ P,TRAP.H-1 ;;DISPATCH ERR FOR USER ERR
EC%==$ERRC(ERR$) ;;CAUSE SYMBOL TO BE AVAIL
>
EHFIRST: $RMSERR ;;PUT OUT ERRS ASSOC WITH RMSLIB
EH.0:: 0 ;;RMSLIB ERRS LT 0, COMPON ERRS GT 0
EH.1:: $CPERR ;;REFFED BY RMSERR
>
; $EH - SETS UP AN ERROR HANDLER FOR ALL CODE DYNAMICALLY ENCOMPASSED BY THIS PROC
;
; $EH(0) TURNS OFF ERR HANDLER
;
DEFINE $EH(LABEL$,AC$<TAP>)<
IFNB <LABEL$>,<
MOVEI AC$,LABEL$ ;;PREPARE TO PUT ERR HANDLER START ADDR ON STK
STOR AC$,FH.EH(CF) ;;DONE
>
IFB <LABEL$>,<HLLOS FH.UNW(CF)> ;;HANDLE ONLY ERRU'S AT THIS LEVEL
>
; L$ABORT - LABEL TO RETURN DIRECTLY TO CALLER OF EXTERNAL PROCEDURE
DEFINE L$ABORT<ABORT.> ;;GO DIRECTLY TO PROC EXIT CODE AND DO A RETF
; L$RET, L$RETT, L$RETF, L$RETV - DECLARE RETURN LABELS
;
DEFINE L$RET<L$$RET(EX..)> ;;LABEL OF LOCATION THAT WILL DO PROPER RETURN
DEFINE L$RETT<L$$RET(XT..)> ;;DITTO FOR RETT
DEFINE L$RETF<L$$RET(XF..)> ;;DITTO FOR RETF
DEFINE L$RETV(WITH$)<[ ;;SETUP VALUE REG AND RETURN
$$RVAL(<WITH$>) ;;SETUP THE RETVALS (LEFTMOST=AC1)
$$RET(EX..)] ;;THE RETURN
>
DEFINE L$RVAT(WITH$)<[ ;;AFTER SETTING VREG(S), DO A RETT THIS TIME
$$RVAL(<WITH$>) ;;SETUP THE RETVALS (LEFTMOST=AC1)
$$RET(XT..)]
>
DEFINE L$RVAF(WITH$)<[ ;;AFTER SETTING VREG(S), DO A RETF THIS TIME
$$RVAL(<WITH$>) ;;SETUP THE RETVALS (LEFTMOST=AC1)
$$RET(XF..)]
>
SYN L$RETV,V$RET
SYN L$RVAT,V$RETT
SYN L$RVAF,V$RETF
; RETURN - RETURN FROM ROUTINE WITH VALUE
;
DEFINE RETURN(WITH$)< ;;RESTORES LREGS AND DOES NOT SET TF
IFB <WITH$>,<$$RET(EX..)> ;;SIMPLE CASE, "EASILY" 1 INSTRUCT
IFNB <WITH$>,< ;;STORE A VALUE AWAY 1ST
JRST [$$RVAL(<WITH$>) ;;SETUP THE RETVALS (LEFTMOST=AC1)
$$RET(EX..)] ;;NOW RESTORE THE CALLER'S ENVIR
>
>
; RETT - RETURN FROM ROUTINE WITH "TRUE"
;
DEFINE RETT(WITH$)< ;;DITTO AND SETS TF TO TRUE
IFB <WITH$>,<$$RET(XT..)> ;;SIMPLE CASE, "EASILY" 1 INSTRUCT
IFNB <WITH$>,< ;;STORE A VALUE AWAY 1ST
JRST [$$RVAL(<WITH$>) ;;SETUP THE RETVALS (LEFTMOST=AC1)
$$RET(XT..)] ;;NOW RESTORE THE CALLER'S ENVIR
>
>
; RETF - RETURN FROM ROUTINE WITH "FALSE" STATUS
;
DEFINE RETF(WITH$)< ;;DITTO AND SETS TF TO FALS
IFB <WITH$>,<$$RET(XF..)> ;;SIMPLE CASE, "EASILY" 1 INSTRUCT
IFNB <WITH$>,< ;;STORE A VALUE AWAY 1ST
JRST [$$RVAL(<WITH$>) ;;SETUP THE RETVALS (LEFTMOST=AC1)
$$RET(XF..)] ;;NOW RESTORE THE CALLER'S ENVIR
>
>
; $$RET - (INTERNAL) GENERATE RETURNING INSTRUCTION
;
DEFINE $$RET(LAB$)< ;;LAB$ CTLS SUCC/FAIL/OR PLAIN RETURN
T$POPJ==0 ;;PRESUME DEFAULT
IFG P$RLEV,<IFE P$RNEW,<IFIDN <LAB$><EX..>,< ;;IF UTIL THEN IF NO REGS SAVED THEN IF PLAIN RET
T$POPJ==1 ;;DO THE OPT
POPJ P,
>>>
IFE T$POPJ,<JRST L$$RET(LAB$)> ;;GENERATE THE RETURNING INSTRUCTION
>
; $$RVAL - (INTERNAL) GEN CODE TO SETUP THE VREGS
;
DEFINE $$RVAL(WITH$)< ;;CAN BE MULTIPLE VALS
T$VREG==0
IRP WITH$,< ;;GO THRU EACH ONE
T$VREG==T$VREG+1 ;;NEXT REG
LOAD T$VREG,WITH$ ;;THE SETUP
>
>
SUBTTL $$MACROS USED BY MORE THAN 1 SECTION OF MACROS
; $$HW - (INTERNAL) EXTEND A HIGH-WATER MARK IF NECESSARY
;
DEFINE $$HW(SUF$)<IFL H$'SUF$-P$'SUF$,<H$'SUF$==P$'SUF$>>
; $$SETUP - (INTERNAL) DECODE SYMBOL WHICH IDENTIFIES THE FIELD
;
DEFINE $$SETUP(FIELD$)< ;;DECODE THE 36-BIT SYMBOL THAT IDENTIFIES THE FIELD
;;FORMAT==PPBBIA,,AAAAAA
T$POS==FIELD$ ;;ISOLATE POSITION BITS
T$POS=T$POS_-^D30
T$BITS==FIELD$ ;;ISOLATE BYTE SIZE
T$BITS==<T$BITS_-^D24>&77
T$ADDR==FIELD$ ;;ISOLATE EFFECTIVE ADDR
.IF T$BITS,GLOBAL,<T$BITS==WHOLE> ;;MAP UNRESOLVABLE SYM (IE. EXTERN) TO FULL WORD FIELD
IFE T$BITS-WHOLE,< ;;A FULL WORD BYTE AS OPPOSED TO $WORD
T$BITS==0 ;;SET TO DEFINED VALUE
T$POS==0 ;;DITTO
>
IFE T$BITS,<$$SETW(<FIELD$>)> ;;SPEED COMPILATION, WONT BE SCANNED UNLESS IFE ENTERED
IFN T$BITS,<$$SETB> ;;LH, RH, OR ODD
T$ADDR==T$ADDR & U$EA ;;ONLY NOW POTENT MAKE IT INTO POLISH EXPR
>
DEFINE $$SETW(FIELD$)< ;;WORD CASE
T$CASE==-1 ;;TENTATIVELY DENOTE FULL WORD
T$==FIELD$ ;;CHK FOR IMMED VALUE
IFN T$ & 1B12,<T$CASE==T$ADDR> ;;LET T$CASE GE 0 DENOTE IMMED VALUE
IFL T$CASE,< ;;CHK IF THE FULL WORD IS A REGISTER
.IF T$ADDR,ABSOLUTE,< ;;IF RELOCATABLE SYM, OBV NOT REGISTER
IFGE T$ADDR,<IFLE T$ADDR-17,<T$CASE==-2>>
>
>
>
DEFINE $$SETB< ;;BYTE CASE
T$CASE==-5 ;;PRESUME ODD SIZE BYTE
IFE T$BITS-HALF,< ;;COULD BE LH OR RH, CHK IF ALIGNED
IFE T$POS,<T$CASE==-4> ;;RIGHT HALF
IFE T$POS-HALF,<T$CASE==-3> ;;LEFT HALF
>
>
SUBTTL CREATE PSEUDO-OPS
;A PSEUDO-OP DIFFERS FROM A $$ MACRO IN THAT IT IS IN EFFECT
;AN EXTENSION TO THE COMPILE-TIME TOOLS OF MACRO
;IE. IT IS ANALOGOUS TO IFN, BLOCK, ETC.
; %ID - (INTERNAL) MAKE BACKSLASH OPER EASY TO USE, EG %ID(\1)==1
;
DEFINE %ID(A$,B$,C$,D$)<A$'B$'C$'D$> ;;FOR BUILDING SYMBOLS INVOLVING \ OPR
; %IFDOT - (INTERNAL) CHECK FOR EXTERNAL SYMBOL NAME
;
DEFINE %IFDOT(NAME$)< ;;IF THIS IS DOTTED SYMBOL, IT MAY BE EXTERNAL
T$==0
IRPC NAME$,<IFIDN <.><NAME$>,< ;;CHK FOR THE DOT
T$==1 ;;NOTE THAT A DOT HAS BEEN SEEN
STOPI ;;TERMINATE CHK LOOP
>>
IFN T$> ;;BECAUSE THIS IS PSEUDO-OP, TERMINATE IT THIS WAY
; %IFI - (INTERNAL) CHECK FOR IMMEDIATE VALUE
;
DEFINE %IFI(CASE$)<IFGE CASE$> ;;IS THE FIELD AN IMMEDIATE VALUE
; %IF** - (INTERNAL) MACROS TO CHECK FOR LOCATION OF ARGUMENT
;
DEFINE %IFNI(CASE$)<IFL CASE$> ;;IS THE FIELD ANY KIND OF MEM LOC
DEFINE %IFWM(CASE$)<IFE CASE$+1> ;;IS THE FIELD A WORD IN MEMORY
DEFINE %IFAC(CASE$)<IFE CASE$+2> ;;IS THE FIELD AN AC
DEFINE %IFW(CASE$)<IFG CASE$+2> ;;NOT %IFNW
DEFINE %IFNW(CASE$)<IFLE CASE$+2> ;;IS THE FIELD A BYTE OR AC
DEFINE %IFBYT(CASE$)<IFLE CASE$+3> ;;IS THE FIELD A BYTE (IE. A HALF WORD OR ODD FIELD)
DEFINE %IFLH(CASE$)<IFE CASE$+3> ;;IS THE FIELD THE LH OF A WORD
DEFINE %IFRH(CASE$)<IFE CASE$+4> ;;IS THE FIELD THE RH OF A WORD
DEFINE %IFOTH(CASE$)<IFE CASE$+5> ;;IS THE FIELD AN "ODD" SIZE BYTE
DEFINE %MACRO(NM$,IDX$)<DEFINE NM$'IDX$>;;PSEUDO-OP FOR DEFINING A MACRO NAME ON FLY
DEFINE %PURGE(NM$,IDX$)<PURGE NM$'IDX$> ;;DITTO FOR A PURGE
DEFINE %RESTOR(PDL$,NAM$)< ;;RESTORE A PREV SAVED FIELD
P$'NAM$==%ID(P,\<P$'PDL$'LEV>,$,NAM$) ;;COPY LEV-DEPENDENT SYM TO CURR VAL
>
DEFINE %SAVE(PDL$,NAM$)< ;;SAVE A FIELD FROM AN ENCOMPASSING LEVEL
%ID(P,\<P$'PDL$'LEV>,$,NAM$)==P$'NAM$ ;;SAVE REG CONTEXT OF ENCOMPASSING ROUTINE
>
SUBTTL REGISTER DECLARATIONS
;;; SYSTEM-WIDE REGISTER DEFINITIONS
$REG (TF,0) ;SUBPROGRAM TRUE/FALSE RETURN REGISTER
$REG (T1,1) ;REG 1 THRU 5 ARE TEMP REGISTERS
; (I.E., NOT SAVED ACROSS CALL)
;REG 1 IS ALSO THE PRIMARY RETURN-VALUE REGISTER
$REG (T2,2) ;TEMPORARY REGISTER
$REG (T3,3) ;TEMPORARY REGISTER
$REG (T4,4) ;TEMPORARY REGISTER
$REG (T5,5) ;TEMPORARY REGISTER
$REG (CF,15) ;CURRENT FRAME PTR, USED TO SUPPORT $LOCALS
$REG (AP,16) ;ARGUMENT REGISTER
$REG (TAP,AP) ;FOR USING AP AS TEMP
$REG (P,17) ;STACK PTR
SUBTTL MISCELLANEOUS SYMBOLS USED BY ALL COMPONENTS
; OPDEFS
OPDEF CALL [PUSHJ P,]
OPDEF GOTO [JRST]
OPDEF JUMPT [JUMPL TF,] ;STANDARD ACCESS MECHS FOR TF
OPDEF JUMPF [JUMPGE TF,]
OPDEF RET [POPJ P,]
OPDEF SKIPT [SKIPL TF]
OPDEF SKIPF [SKIPGE TF]
OPDEF LC [ILDB] ;LOAD CHAR
OPDEF DC [IDPB] ;DEPOSIT CHAR
.NODDT CALL,GOTO,JUMPT,JUMPF,RET,SKIPT,SKIPF,LC,DC
; INVISIBLE SYMBOLS NEEDED WHEN MACROS ARE USED
$PRLABEL(10) ;ALL THE EXTERNS FOR THE ENTRY/EXIT SEQS
EXTERN SV0..5,RS5..0 ;LABELS FOR SAVING & RESTORING TEMP ACS
EXTERN ABORT.,TRAP.H ;LABELS TO SUPPORT EXCEPTIONAL ERRS
U$EA=1B12-1 ;MASK FOR EFFECTIVE ADDRESS
U$PURE==400000 ;FOR NOW, USE TWOSEG & START HERE
U$TREG==T5 ;HIGHEST TEMP REG
U$SYS==15 ;DRIVES $PRENT/$PREXIT
; TO FACILITATE USE OF RMSMAC
WHOLE==^D36 ;BITS IN A WORD
HALF==^D18 ;HALF-WORD SIZE
QTR==^D9 ;1/4 OF A WORD
ASC==7 ;STANDARD BYTE SIZE
AS%BPW==5 ;ASCII CHARS/WORD
AS%BYT==7 ;BITS/ASCII CHAR
EAMASK==1B12-1 ;ALL THE BITS IN AN EFFECTIVE ADDR
RHMASK==777777 ;RHMASK&SYMBOL = 18 BIT FIELD
LHMASK==777777,,000000 ;LEFT-HALF MASK
; STACK FRAME HEADER
$BLOCK (FH) ;FRAME HDR
$WORD (FH.RET) ;RETURN ADDRESS
$WORD (FH.OCF) ;THE OLD CURR-FRAME PTR
$ALIGN (FH.UNW) ;INFO NEEDED TO SUPPORT STACK UNWINDING
$BYTE (FH.ENT,HALF) ;ADDR PAST THE JSP TO ENTRY CODE
$BYTE (FH.EH,HALF) ;ERR-HANDLER: 0=PASS THRU, -1=TREAT AS UNEXCEPTIONAL ERR
; IF NOT -1/0 IS TREATED AS ADDR OF ERR HANDLER
$ENDAL
$EOB
; COMMON WORD FORMATS
$BLOCK (ARG) ;ARGUMENT WORD IN ARG BLOCK
$BYTE (ARG.X,1) ;INSTRUCTION FORMAT OR EXTENDED FORMAT (=0)
$BYTE (ARG.UN,8) ;MUST BE ZERO
$BYTE (ARG.TYP,4) ;ARG TYPE, MAY CHANGE IN FUTURE
$BYTE (ARG.EA,^D23) ;EFFECTIVE ADDR OF ARGUMENT
$EOB
$BLOCK (BP) ;BYTE PTR
$BYTE (BP.POS,6) ;POSITION OF BYTE WITHIN ITS WORD
$BYTE (BP.SIZ,6) ;# OF BITS IN IT
$BYTE (BP.XTN,1) ;EXTENDED IF ON
$BYTE (BP.EA,^D23) ;EFFECTIVE ADDRESS
$EOB
$BLOCK (INS) ;INSTRUCTION FORMAT
$BYTE (INS.OPC,9) ;OP CODE
$BYTE (INS.AC,4) ;THE AC FIELD
$BYTE (INS.IND,1) ;INDIRECT BIT
$BYTE (INS.IX,4) ;INDEX REGISTER
$TEMPLATE(INS.1)
$BYTE (INS.MEM,HALF) ;MEMORY LOCATION
$TEMPLATE(INS.2)
$BYTE (INS.PAG,9) ;PAGE
$BYTE (INS.OFF,9) ;PAGE OFFSET
$EOB
; $RMSERR - REFFED HERE AND IN EACH componERR.MAC VIA $ERRV
;
; $ERRD ;SAYS DEFINE ERROR CODES
; $RMSERR ;DOES IT (SHOULD APPEAP HERE)
;
DEFINE $RMSERR< ;;$ERRD OR $ERRV MUST PRECEDE
H$RET (NIF,0) ;;NUMBER IMPROP FORMATTED
H$RET (SXD,0) ;;SIZE EXHAUSTED FOR WHOLE NUM PART OF FIELD
H$RET (TE1,0) ;;RESERVED
H$GO (TE2,0) ;;RESERVED
H$GO (TE3,0) ;;RESERVED
H$GO (TE4,0) ;;RESERVED
H$GO (ARG) ;;BAD ARG TO ROUTINE
H$GO (COP) ;;STRING COPY PROBLEM
H$GO (CVO) ;;CASE-VALUE OUT-OF-BNDS
H$GO (FRE) ;;FORM READ ERROR
H$GO (FWE) ;;FORM WRITE ERROR
H$GO (FPE) ;;FORM PAGE ERROR
H$GO (FRO) ;;FORM ROOT ERROR
H$GO (MBO) ;;FREE BLOCKS OVERLAP
H$GO (MDI) ;;M.QALC DESC INCONSIS
H$GO (MMI) ;;MEM MGR INIT ERROR
H$GO (MMX) ;;FREE MEM EXHAUSTED (OR PROB WHILE TRYING TO GET MEM)
H$GO (MPX) ;;PRIVATE LIST EXHAUSTED
H$GO (MSZ) ;;ILLEGAL SIZE ARG
H$GO (OAL) ;;TEXT OUTPUT ARG ERROR
H$GO (OOP) ;;TEXT OUTPUT, CANT OPEN FILE
H$GO (OST) ;;TEXT OUTPUT STACK ERROR
H$GO (OWE) ;;TEXT OUTPUT WRITE ERROR
H$GO (TAL) ;;SYMTAB ARG ERR
>
IF1,<T%ERR==0> ;;1ST PASS SETS LENGTH OF VECTOR
$ERRD(RM$,T%ERR) ;;PREPARE TO PUT OUT ERR CODE DEFS
$RMSERR ;;DO IT
T%ERR==-U$ERR-1 ;;CAUSES LAST TCSERR TO GET VAL OF -1
END ;OF RMSMAC