Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/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) DIGITAL EQUIPMENT CORPORATION 1977, 1986.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
; COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
; ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
; SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
; ITS SOFTWARE ON EQUIPMENT THAT 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
;Datatypes defined
;** Warning: These symbol values may change..
;[455] ** If they do, change the DTP$K_xxx symbols in RMSLIB.R36 as well!
;[455] These are used by RMSUTL and RMSM2
;
DT%SIX==0 ;SIXBIT data type
DT%ASC==1 ;ASCII data type
DT%EBC==2 ;EBCDIC data type
DT%PAC==3 ;PACKED decimal datatype ;A411
DT%IN4==4 ;INTEGER datatype ;A411
DT%FL1==5 ;FLOAT datatype ;A411
DT%FL2==6 ;DOUBLE FLOAT datatype ;A411
DT%GFL==7 ;GFLOAT datatype ;A411
DT%IN8==^D8 ;DOUBLE INTEGER datatype ;A411
DT%AS8==^D9 ;8-bit ASCII ;A411
DT%UN4==^D10 ;Unsigned Integer ;A411
; $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,MACTEN ;;DEP, SO GO APPROP SYMBOLS ;m572
.ERMAX==0 ;; ;a572
IFIW==:1B0> ;; ;a572
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.
61 RMSOPN(21) 20-17312
(RLUSK, 24-Feb-82) Repeated $OPENs on
a locked file can use up memory,
because space for an FST is allocated
and never freed.
62 RMSIDX(14) 20-17341
(RLUSK, 28-May-82) When doing a search,
a SIXBIT key "ABC" will be lexicographically
less than " BC", because a signed
comparison is done, so the first key appears
negative and the other positive. This is
causing all sorts of havoc. Use an unsigned
comparison in SINDEXBKT.
63 UTLUSE(1) 20-17546
(MBOUCHER, 2-Jun-82) RMSUTL fails with "?RMSOSE
JSYS 56 Failed" error when executing the RMSUTL
command "SET INDEX n BUCKET x" when the bucket
at page x is the root of index n.
64 RMSOSB(2) 10-32354
(RLUSK, 4-Jun-82) 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.
65 RMSASC(9) None
(RLUSK, 14-Apr-83) Edit 56 does not
correctly handle a word of nulls
occurring in a Line-Sequenced ASCII
file. It does not allow for a word of
nulls preceding a pagemark, nor does
it correctly handle a null word before
an LSN; rather than bump the pointer
by one word (as should be expected in
most cases) it gratuitously reads in a
new buffer, disposing of up to 3
blocks of data in a single stroke.
The routine logic is so flawed, then,
that it was rewritten.
66 RMSEVC(1) None
RMSDSP(4) (RL, 19-Apr-83) With the release of
LINK v5.1, the /START switch no longer
accepts a value whose left half is the
length of the entry vector and whose
right half is the address of the entry
vector. Definition of an entry vector
must, therefore, be by a MACRO-written
REL block. RMSEVC has been written to
generate the entry vector entry for
RMS; the entry vector entry is not
desired for RMS.REL, for that would
overwrite the user's start address.
***** END OF REVISION HISTORY *****
***** Start Version 2 Development *****
PRODUCT MODULE SPR
EDIT NAME & EDIT QAR (WHO, DATE) DESCRIPTION
====== =========== ===== =======================
300 RMSLIB(300) XXXXX (DAW,19-Jan-82) Fixup sources so DBUG=1
RMSFIL(300) will compile with no errors.
RMSOSB(300)
RMSDSI(300)
RMSDMP(300)
RMSFNX(300)
301 *ALL* XXXXX Support extended addressing.
302 RMSTAB(300) XXXXX Support new DEC standard for stream files:
ESC and CTRL/Z are no longer break characters.
303 RMSFND(300) XXXXX Fix Get for Relative files to advance NRP
pointer properly.
400 *ALL* XXXXX (RL,22-Apr-83) Clean up BLISS code.
401 RMSRSU(401) XXXXX (RL,1-May-83) Fix CBD initialization
402 RMSERR(1) XXXXX (RL,6-May-83) Stop printing messages to
RMSOSM(401) the terminal when an error occurs, especially
RMSSYM.MTB(1) the quota exceeded error from OKCREATE. Add
a new error code, ER$EXT (RMS$_EXT), File
extend error; return the JSYS error in the
STV field.
403 RMSASC,RMSFND, (AWN,Apr-83) Add RFA $GETs to stream/LSA files,
RMSOPN,RMSRSU fix LPT: output, add write-before-advancing,
write-after-advancing options.
404 RMSCNC(401) (RL,10-May-83) Add COBOTS SMU support: when
RMSDSI(401) SMU is set, do no locking and return number
RMSFND(1) of page containing record on relative $FIND.
RMSOPN(3)
405 RMSFNX (RL,11-May-83) Fix typo in FBYKEY; extra dot
in XCOPY macro call.
406 RMSLIB,RMSEXT,RMSREQ (RL,12-May-83) Remove external declarations
from RMSLIB, and put them in RMSEXT.R36.
Change RMSREQ to declare RMSEXT as a library.
407 RMSLIB,RMSUPD,RMSMSC (RL,24-May-83) Make CKEYUU use global pointers
when comparing things in the RMS section with
things in a user section. Make DOUPDIDX pass
a global address to CKEYUU if one is not given,
and make UPDUDR and UPDSQR use an XBLT for
copying things in nonzero sections. Finally,
put new macros into RMSLIB to support all
these good things.
410 RMSERR (RL,1-Jun-83) REMOVRECORD (in RMSERR) calls
DELUDR (in RMSUDR) with 3 arguments, when
DELUDR only takes 2. Thus, DELUDR never
quite gets hold of the correct record to
delete.
411 RMSDSI,RMSERR,RMSLIB, (AWN,6-Jun-83) Implement non-display keys
RMSMSC,RMSSYM,RMSTAB, PAC,IN4,IN8,FL1,FL2,GFL,AS8,UN4
RMSM2
412 RMSIDX (RL,20-Jun-83) An error in parameter binding
in GTNBKT caused a bucket to be locked when
it was not supposed to be locked.
413 RMSMSC (RL,23-Jun-83) Because byte-pointers were not
cleared before their fields were initialized
(in CKEYUU), the cruft left behind caused
equal keys to appear unequal, causing problems
on $UPDATEs.
414 RMSOPN (RL,24-Jun-83) Missing parentheses in IF
statement caused section of code to be
"optimized" out of DOOPEN.
415 RMSSDR (RL,5-Jul-83) Call to MOVEKEY from PUTSIDR
did not pass 30-bit address when needed.
Thus, the user's secondary key was ignored.
416 RMSGET,RMSPUT,RMSUPD (RL,7-Jul-83) Calls to MOVERECORD from
GETREC and UPDSQR did not pass 30-bit address
when it was needed. PUTREC needed some
cleanup around the MOVERECORD call.
417 RMSFIL (RL,8-Jul-83) A PMAP in PAGIN fails because
the caller, DOKEYBLOCKS, has incorrectly
set up the global destination page, zB.,
passing 2,,666 rather than 0,,2666. Fix
the page calculation expressions to shift
the section number down where it belongs.
420 RMSFND (RL,8-Jul-83) Make user's key buffer address
global before trying to fetch from it, in
FINDREL.
421 RMSUPD (RL,20-Jul-83) Allow changing the record
size on $UPDATE, when the record is
variable-length in a relative file, and
the new length is less than the maximum
record size.
422 RMSUPD (RL,25-Jul-83) In DOUPDIDX, when RMS checks
for duplicates on a key that has changed,
the MOVEBKTDESC macro is called with a
fetched value as an argument; it treats
this dotted name as a regular name, which
makes a dotted structure reference in the
macro cause an illegal read. BIND the
fetched value to a name, and pass that
name instead.
423 UTL??? (RL,26-Jul-83) All UTL??? modules cleaned
up and compiling/assembling normally.
Module UTLEXT has been created to contain
all external references.
424 RMSEVC (AN,20-Sep-83) Move spare copyright to loseg.
It is only needed for the REL file.
425 RMSLIB (RL,27-Sep-83) CKEYUU is unwittingly zeroing
a non-preserved register used by DOUPDIDX.
CSTRINGLE_EA uses AC12 without explicitly
naming it (by using a DMOVEM) and BLISS
assumes the AC is safe. Explicitly zero
AC7 and AC12 when safe to do so.
426 RMSLIB (RL,28-Sep-83) Make TRACE and RMSENTRY use
conditional compilation (under DBUG) to
avoid checking the debugging flags when not
needed.
427 RMSDSI (AN,5-Oct-83) SETKDB should not touch the KSDs
as they are mapped R/O to the file.
430 UTLACT (RL, 10-Oct-83) Open sequential and relative
UTLCMD files with RMSUTL; disallow use of FIX,
UTLENV UNCLUTTER and VERIFY commands with sequential
UTLIO and relative files; get the file prologue
UTLMSC correctly in BK$PROL; undefine some conversion
UTLTOP tables which are now in RMSM2.MAC; and fix
UTLUSE a memory manager bug.
431 UTLCMD (RL, 13-Oct-83) Check that file is open
UTLSYM for commands which need open file, and
set up record-to-use clause tables based
on file organization.
432 UTLCMD (RL, 19-Oct-83) Make changes to allow
UTLENV DEFINE command for relative and sequential
UTLSYM files. Also, fix the initialization code
UTLUSE for non-indexed files.
433 UTLCMD (AN, 31-Oct-83) Add new datatypes to RMSUTL
UTLACT
UTLENV
RMSFLO
RMSCNV
434 UTLCMD (RL, 31-Oct-83) Fix seq/rel files in RMSUTL
UTLACT (AN installed)
UTLUSE
UTLTOP
435 UTLCMD (1-Nov-83) Fix RMSUTL error messages
UTLTOP and report file default
436 UTLCMD (4-Nov-83) Data-type check off-by-one
437 UTLMSC (2-Dec-83) Initialize un-inited register
flagged by new BLISS compiler.
440 UTLTOP (2-DEC-83) Fix more RMSUTL error messages.
441 RMSASC,RMSEXT (8-Dec-83) The MOVST in GETASCII will insert
nulls into a record if the record has leading
nulls and crosses a page boundary.
442 RMSUDR (13-Dec-83) CHKDUP was erroneously marking
records inserted before a deleted record as
duplicate records. This corrupted the index.
443 RMSQUE (13-Dec-83) FILEQ was not creating separate
queue request blocks for UPD and DEL access.
444 RMSOPN (20-Dec-83) Because RMS always opens files
thawed, it is impossible to type or otherwise
non-RMS open a file which RMS is only reading.
Open the file Read-Unrestricted (OF%RDU) if
RMS is only reading.
445 RMSASC (20-Dec-83) After an RTB error, the code from
edit 441 reads to EOF, rather than just to the
end of record. Check MOVEFLAG when checking
buffer space left.
446 RMSINI (21-Dec-83) Currently, RMSINI maps UDDT.EXE in
whenever it maps XRMS into a non-zero section.
Instead, map DDT in only when DDT exists
in the user's section already.
447 RMSINI (21-Dec-83) Define RMSSEC (in RMSINI) to be
a global and allow the user to change it
to specify that RMS is to be loaded into
a specific non-zero section, rather than the
first free section.
450 RMSDSP,RMSGLB (RL,13-Jan-84) PA1050 keeps trapping RMS's page
creations. Turn off the non-existent page
interrupt channel with a DIC% when entering
RMS, and restore the original status when
leaving RMS. NOTE: Allow the user program
to disable this feature with the $NOMESSAGE
JSYS, which does nothing now.
451 RMSGLB,RMSFSM (RL,18-Jan-84) COBOL SMU requires COBOL to
RMSINI,RMS2X2.LNK perform two $CONNECTs on each file, which
doubles the buffer space used by each file.
XRMS at 600000 does not have enough free
memory to allow COBOL to open 8 files,
much less the ANSI maximum 16 files. Ergo,
make RMS2X2.LNK from RMS2S2.LNK and load
XRMS.EXE at 400000. Then, increase the
page table size in RMSGLB to cover the added
space. Finally, remove the crock code in
RMSFSM which caused RMS to call FUNCT. when
RMS was loaded below 600000.
452 RMSUSR (RL,24-Jan-84) Add ELS parameter to $RAB macros.
453 RMSOSB (RL,24-Jan-84) If SIN or SOUT wins a "Quota
exceeded" or "Disk full" error, make IOERROR
return ER$EXT.
454 UTLVFY Q345004 (RL,30-Jan-84) If a file contains a data
bucket in which all entries are deleted,
a VERIFY (with file opened for output) or
UNCLUTTER of that file will produce an
error message warning that "Bucket n points
at bucket x but succeeding index entry does
not." This happens because the final tests
of bucket consistency are performed against
the last bucket, if one exists; the last
bucket, however, is "refetched" using the
highest key found in the file. If the
previous bucket contained no data, the
bucket BEFORE that one is fetched, and
all sorts of evils arise. Thus, if we find
a bucket with all entries deleted and
expunged, do not leave a previous-bucket
pointer around for the next bucket to make
an erroneous consistency check with.
455 RMS2U2.LNK Q345008 (RL,2-Feb-84) Clean all references to RMSMES
RMSLIB.R36 out of RMSUTL, and change all calls to TX$TOUT
RMSM2 and TX$APP to use TX$OUT and TX$RPT in RMSM2.
RMSMAC Change UTLxxx modules to determine key type
UTLACT and to pass correct key or record datatype
UTLENV information to RMSM2 when the ^S control code
UTLEXT is used. Use other codes when possible.
UTLMSC Change all RMSMES format statements to control
UTLSYM strings for RMSM2. Modify RMSM2 to put out
UTLTOP any type of RMS key when called with the ^S
UTLUSE control code. Finally, fix a bug in UTLUSE
UTLVFY which was fixed in maintenance long ago (see
edit 63).
456 RMSM2 (RL,6-Feb-84) TXURFA writes RFAs backwards.
457 RMSASC (RL,23-Feb-84) The record reading loop in
GETASC subtracts 1 from the remaining buffer
space and then checks to see if it is LEQ 0.
This should be "LSS 0".
460 RMSSPT (RL,12-Mar-84) Edit 54 (in COMPRESS) does not
correctly check for duplicates as was intended.
461 RMSFRE (RL,8-May-84) Fix $FREE to setup the FST
correctly on entrance.
462 RMSUSR (RL,12-Jul-84) Fix reference to XABALL$K_BID
in $XABALL_INIT; should be XAB$K_BID.
; Version 3
501 RMSGET,RMSPUT,RMSOPN (AN, May-84) Put in Remote File Access Code.
RMSCNC,RMSUSR,RMSSYS
RMSSYM,RMSEXT,RMSRRE,
RMSROP,RMSDAP,RMSDSB,
RMSRCO
502 RMSOPN,RMSCLS,RMSGET (AN, Jun-84) Use new-style names
503 RMSRDW (AN, Jun-84) Implement Page Mode
504 RMSIMA,RMSOPN,RMSGLB (AN, Jul-84) Implement Image Mode
RMSDSI,RMSERR,RMSFND,
RMSOSB,RMSUAR,RMSIO,
RMSGET,RMSPUT,RMSEXT,
RMSLIB,RMSSYS,RMSUSR,
DAP
505 RMSSYM,DEBCMD,DEBTOP, (AN, Jul-84) Support RMSDEB
DEBCMD,DEBACT,DEBSYM
506 RMSDYN,RMSJCK,RMSZER, (AN, Aug-84) Implement dynamic library call
507 RMSDIR,RMSD20,RMSNXF, (AN, Sep-Oct-84) Implement $Parse and $Search
510 DEBACT,DEBCMD,DEBTOP, (AN, Sep-84) RMSDEB supports $Parse and $Search
RMSSYM,DEBSYM,RMSM2
511 RMSRRE (AN, 11-Oct-84) Fix VMS Ascii
512 DAPTRA, DAPSAI (AN, 11-Oct-84) Work around XPORT ext addr bug.
513 DAP, RMSROP (AN, Oct-84) Make $Display display
RMSSYS the right things
514 RMSD20 (AN, 30-Oct-84) Use MapCodes for all GTJFN errs
515 DAP (AN, 5-Nov-84) Use COD of XAB, not BID
516 RMSD20 (AN, 5-Nov-84) Ext addr fix (put in UADDR call)
517 RMSUAR (AN, 6-Nov-84) 0 pointer should stay 0
520 RMSUSR (AN, 8-Nov-84) Add NAM$V_SRCHFILL,
NAM$K_MAXRSS,
NAM$K_MAXESS
521 RMSDSP,RMSSYM.MPR (AN, 12-Nov-84) $Rename not compatable
RMSUSR,RMSZDS,RMSDYN
RMSRRE
522 RMSDIR (AN, 12-Nov-84) Remove EXTERNAL R$List
523 RMSUSR (AN, 14-Nov-84) Fix Fab$v_Ftn typo
524 RMSOPN,RMSGET,RMSFND (AN, 15-Nov-84) Add FFF call & FFFINT
RMSCLS,RMSCNC,RMSUIN
525 RMSDSP (AN, 19-Nov-84) Make XRMS stack global
526 DAPERR (AN, 3-Dec-84) DAPERR does not need RMSREQ,
and DIU needs to use DAPERR.
527 RMSD20 (AN, 5-Dec-84) Return resultant on $RENAME.
530 RMSOSB (AN, 7-Dec-84) Fix EOF calculation
531 RMSOPN (AN, 7-Dec-84) Return right error for
output-only device
532 RMSMSC (RL, 12-Dec-84) Extended addr enhancement for
RMSLOD
533 DAP, RMSROP, FALDAP (AN, 12-Dec-84) CRC checking
RMSRRE
534 DAPT20, FALDAP (AN, 12-Dec-84) Mount private strs (FAL)
535 RMSD20 (AN, 13-Dec-84) Correct Nam$v_Cha setting
536 RMSRSU, DEBCMD, DEBACT (AN, 14-Dec-84) RAC=TRA,BFT,BLK
537 RMSRDW (AN, 14-Dec-84) Ext Addr fix
540 RMSMSC (RL, 18-Dec-84) Ext Addr fixe
541 FALDO, FALDAP, DAP (AN, 21-Dec-84) FAL in page mode
RMSRRE
542 RMSD20 (AN, 21-Dec-84) CHA bits on first $Search
543 FALDAP, DAP (AN, 21-dec-84) fal bug
544 RMSLIB,DAP,RMSDIR (AN,27-Dec-84) seqadr should include RAC=TRA
RMSD20 $parse ext addr bug
545 DAP, FALDAP, RMSROP (AN,3-Jan-85) Fix Dap protocol errors w/ VMS
RMSDIR
546 RMSROP, DAP, RMSDIR (AN, 11-Jan-85) Fix resultant & expanded for
remote
547 RMSDIR, RMSD20, RMSERS (AN, 11-Jan-85) Fix $Erase & $Rename
RMSDPO, RMSCLS, RMSROP
550 RMSDSI, RMSEXT, RMSOPN, (RL, 14-Jan-85) Fix to make
RMSUIN FFF calling work:
DSI : use ORG = none for non-RMS files,
based on file class rather than
on the record format;
EXT : add R$NULL declaration;
OPN : pass FST in FAB, etc., when
calling F$OPEN;
UIN : declare a LINKAGE for $FFFINT in
order to access register arguments.
551 RMSUSR (RL, 15-Jan-85) Changes to RMSUSR to
make FFF compile cleanly. Add $FFFINT
calling macro, etc.
552 RMSSYM.MPR (AN, 15-Jan-85) Fix ancient bug in runtime
initialization of XABs from MACRO
553 RMSDIS (AN, 16-Jan-85) When setting up Config XAB
RMSUSR,RMSSYM.MTB for local files, do not step on the header
and make the cfg defs agree with each other
554 DEBACT,DEBCMD (AN,17-Jan-85) Make RMSDEB support CFG
RMSUSR and fix error in its definition
555 FALDAP,DAP,RMSRRE (AN,28-Jan-85) Fix rsz and $Find
RMSFND
556 RMSUIN (RL,30-Jan-85) Preserve ACs 3, 4, 5 in
FFFINT linkage, to mimic JSYS linkage for
RMS calls.
557 RMSCNC, RMSRRE, FALDAP, (AN,7-Feb-85) Fix multistream, $truncate
FALDO, RMSRCO, RMSTRN, and $Delete, and add some error codes
RMSDEL, DAP.REQ,DAPERR
560 FALDAP, RMSROP (AN,7-Feb-85) Refine datatype default further
561 FALDAP, DAP, RMSRRE (AN,14-Feb-85) Fix CRC, RFA, and RSZ errors
562 UTLTOP, UTLSET (RL,6-Mar-85) Create UTLSET.B36 with routine
UTLSET (called from RMSUTL in UTLTOP). This
routine merges RMS-SINGLE-SECTION.EXE into
the RMSUTL image and saves the RMS entry
vector address; it also sets up PDVs and a
few other things. One then SAVEs the file.
On subsequent runs, UTLSET sets up the RMS
entry vector with the SDVEC% JSYS.
This avoids the problems arising from RMS's
move into a non-zero section. RMSUTL needs
RMS in section zero, and this puts the code
together without collision between global
symbols.
563 RMSUSR (RL,28-Mar-85) Add TYP block classes for
FFF files to RMSUSR; they were previously
only in FFFUSR.R36.
564 BRMS20.CTL (RL,1-Apr-85) Update BRMS20.CTL to add
UTLSET to RMSUTL, build FFF dynamic library.
565 RMSCLS, RMSCNC, RMSFND (RL,5-Apr-85) Return the STV value from
RMSGET, RMSOPN calls to the FFF routines.
566 RMSDIR, RMSOPN, DAP (AN,5-Apr-85) Fix wildcard error recovery
RMSSYS, RMSROP, RMSRRE and map Record formats SCR & SLR into STM
RMSD20, RMSUSR
567 RMSRSU (AN,18-Jun-85) Allow relative access
to fixed sequential files
and clear RSL in NAM block on errors
570 FALDAP (AN,23-Jul-85) Fix Directory list to VMS
571 RMSROP,DAP (AN,6-Aug-85) Recompute MRS to 8-bit systems
and request 3-part name if supported
and try to parse remote spec if not.
572 RMSCLS,RMSCNC,RMSM2, (AN,19-Sep-85) Merge in TOPS-10 changes
RMSDIR,RMSDIS,RMSDSP, where practical
RMSEXT,RMSFFF,RMSGLB,
RMSIMA,RMSINI,RMSIO,
RMSLIB,RMSM11,RMSMAC,
RMSMSC,RMSOSM,RMSPUT,
RMSQUE,RMSRDW,RMSREQ,
RMSROP,RMSRRE,RMSSYS,
RMSUSR,DAP,DAPSAI,
DAPTRA,FFFISA,FFFJCK,
FFFOPN,FFFWIN,
BLISSNET.REQ
573 RMSROP,FALDAP,DAP (AN, 11-Oct-85) Fix extended attributes.
RMSSYM.MTB Add NA$MXE and NA$MXR to require file
RMSSYM.MPR Fix NAM$E and XAB$B CFG
574 RMSROP,FALDAP,DAP (AN, 17-Oct-85) Fix return attributes more
RMSIMA,RMSASC, Fix EOF checking & non-7-bit Ascii
RMSSYM.MPR Fix TYP$E
575 RMSSYM,DAPSAI Fix JFN problem and CFG$B,CFG$E, move nam$v_nod
576 RMSUSR.R36 (asp, 29-Oct-85) Add rfa to RAB_STORE keywords
577 DAP DAPERR DAPSAI (an, 1-Nov-85) Implement R/W Image Mode by RFA.
FALDAP RMSASC RMSD20 Work around GTJFN bug (SUP not enforced).
RMSDIR RMSERR RMSFLS Work around PRO bug
RMSFND RMSGET RMSIMA Update RMSDEB.
RMSOPN RMSRDW RMSROP
RMSRRE DEBACT DEBTOP
600 RMSDIR DAPSAI DAP (AN, 27-Nov-85) Fix $Parse
RMSROP FALDAP Prevent Datatype skew
601 DAPERR DAP.REQ (AN, Jan-86) Add missing error codes to
FALDAP translation routines
602 RMSRRE (AN, Jan-86) Fix $Update
603 FALDAP (AN, 20-Jan-86) Don't send extra attrs to VAX
on Directory-List function
604 RMSDIR (TGS, 14-Feb-86) Fix 'Bad JFN' bug: Don't
return JFN to FAB during $PARSE iff file
file is remote OR JFN is parse-only.
Partially supplanted by edit 615.
605 DAP,FALDAP,DAP.REQ (AN, 27-Jan-86) Handle oversize VMS RFA's
606 DAP,FALDAP (AN, 31-Jan-86) Fix IMR with more UAPointer()s
Fix TOPS10 datatype skew problem.
and make BSZ an input to $Open so programs get
bytes delivered the way they expect.
607 RMSOPN,RMSROP,RMSERR (TGS, 19-Feb-86) Prevent creation of dummy
files on OFP $PARSE followed by $OPEN, and
failing $CREATE of indexed file. Reset DAP
function code to Create for remote CIF.
610 DAP,FALDAP,RMSDIS (TGS, 7-Mar-86) Rewrite DAP extended key
RMSLIB XAB attributes so remote $CREATE works (also
added DAP KNM handling). If delete-on-close
and CRC-checking have been set during Access-
complete-close, do not compare checksums.
Fix directory/list from VMS when RMS thinks
the local file is LSA.
611 FALDAP (TGS, 24-Mar-86) Find lost RFAs, which weren't
getting returned in STATUS messages, and were
getting ignored in D$GCTL.
612 DAP.REQ (TGS, 25-Mar-86) Increased DAP$k_Buffer_Size
to 8192 (20000 octal)
613 RMSUSR.R36,DAP.B36, (SC, 27-Mar-86) Added DIL8 type class to
RMSOPN.B36,RMSRRE.B36, provide support for DIL formatted 8-bit
RMSSYM.MTB records generated (only) by DIU)
614 RMSTRN,RMSOSB (TGS, 1-Apr-86) BLK-mode $TRUNCATE.
RMSRDW
615 RMSDIR,RMSOSB (TGS, 14-Apr-86) Always release a SynChk
JFN, and do not return it to the user's FAB.
This is not overridden by DRJ.
616 RMSFNX,RMSUPD (TGS, 30-Apr-86) "Bad KSZ/RSZ" bug on remote
indexed $GET/$UPDATE.
617 DAP (TGS, 30-Apr-86) Old typo kdb$h psyched
out an oversmart macro, silently broke
secondary DUP/CHG attributes.
620 DAP,FALDAP (TGS, 1-May-86) Indexed $GETs/$PUTs brain-
damaged in various ways
621 RMSOPN (TGS, 4-Jun-86) FOP=SUP ignored on $CREATE
if file already exists and CIF is not set.
622 RMSTRN (TGS, 4-Jun-86) Old V2 bug truncating large
sequential files: the page count calaculation
goes negative, PMAP% fails.
623 DAP (TGS, 9-Jun-86) Fix remote keyed $GET.
624 RMSRRE (TGS, 10-Jun-86) Don't require fixed-length
remote $GET user buffers to be an even
number of words.
625 RMSD20 (GAS, 10-Jun-86) Dot bug caused low memory to
be trashed at the RNAMF in RL$RENAME.
626 RMSUSR (GAS, 12-Jun-86) Add FAB picture; fix NAM
picture; NAM$M_PWD and NAM$M_SYNCHK were
defined wrong; XABPRO masks defined wrong.
627 RMSROP (TGS, 11-Jun-86) Always request KEY display
on remote indexed $Open if partner supports
it.
630 FALDAP,DAPSUB (TGS, 12-Jun-86) Processing remote key
fields on $Get no longer assumes the
indexed dtp is unchanged from a previous
$Get.
631 RMSD20 (TGS, 13,Jun-86) Set GJ%FOU, not %NEW, on
$Rename's newfab JFN.
632 DAP.REQ,FALDAP (TGS, 16-Jun-86) Add some more RMS-to-DAP
error code conversions so normal errors
are not signalled as DPE's.
633 FALDAP (GAS, 17-Jun-86) Make wild deletes work for
PDP-11 system access to RMSFAL.
634 DEBCMD (asp, 17-Jun-86) Re-order TYP class values
so RMSDEB can have BYT mode.
635 FALDAP (GAS 20-Jun-86) Fix FALDAP so that filenames
of the form "FILE.TYPE;0" don't confuse RMSFAL.
Also make renames work from VMS and RSX.
636 DAP.REQ, DAP.B36 (GAS 25-Jun-86) Allow RSTS to read a STM file.
637 DAP, RMSROP, (GAS 25-Jun-86) Return config XAB to user as
FALDO, FALTOP soon as we read one from the link.
640 RMSROP (TGS, 26-Jun-86) Fix Internal RMS error
on explicit $Close after $Parse/$Search
loop. If no explicit $Open, return IFI.
641 DAP (TGS, 26-Jun-86) If Dap$k_Nametype_Nam
is received without preceeding volume
and directory NAME messages, eat message.
642 RMSMSC (TGS, 27-Jun-86) Old extended addressing
bug in MOVEKEY was randomly shuffling
user-section memory before a string
copy.
643 FALDAP (GAS 27-Jun-86) Always return main attributes
even though access msg didnt say to if it is a
OPEN, CREATE, or SUBMIT message (used by RT11),
and don't put extra acks in directory list if
talking pre v7 DAP.
644 RMSROP (GAS 27-Jun-86) Don't forget third argument to
DAP$GET_CONFIG. Lost edit(?)
645 RMSROP, DAP (GAS 27-Jun-86) If image mode to another 36 bit
system running old FALs, set block size 512 and
byte size 36 and undefined record format.
Work on image mode for TOPS-10 systems.
646 RMSCLS (TGS, 9-Jul-86) Clear RAB pntr on $Close
647 DAP, FALDAP, RMSUSR (GAS, 12-Jul-86) Fix image reads from TOPS-10
NFT (he does SEQ image access). When reading
an attributes message, default the datatype to
IMAGE, and if image from a LCG machine default
the BSZ to 36 and MRS to 512 if they weren't
given. Also fix FAB picture in RMSUSR.
650 RMSDIR (GAS, 17-Jul-86) DAP$SEARCH didn't update the
NAM block lengths and pointers properly for
remote files breaking DIU's directory command
and wildcards to/from remotes.
651 RMSDIR (GAS, 17-Jul-86) DAP$SEARCH and DAP$MERGE
didn't stop on a null causing it not to work
sometimes and in particular on TOPS-10
filenames.
652 DAP (GAS, 25-Jul-86) If we are talking to an old
non-RMS TOPS-20 program then add two to the MRS
if the RFM is STM and default the FOP to SUP if
none specified. This makes DIT (DIL) work.
>;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$)>
>
; $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
IFIW 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)
>
;DC$MS2 - GLOBAL SYMBOLS NEEDED BY RMSM2
DEFINE DC$MS2,<
DCL$GL ( NOCRFL, 1) ;Set to -1 if no crlf should be appended to string
DCL$GL ( NOOUTF, 1) ;Set to -1 if string is continued, don't output
DCL$GL ( STRBP, 1) ;BP to arg ASCIZ string
DCL$GL ( NARGS, 1) ;Number of args (besides the string itself).
DCL$GL ( TEMPBP, 1) ;Temporary BP
DCL$GL ( TEMPCC, 1) ; and temporary count
DCL$GL ( RETAD, 1) ;Return address to routine
DCL$GL ( TTYBP, 1) ;TTY byte ptr
DCL$GL ( TTYCC, 1) ;TTY char count
DCL$GL ( ALTBFP, 1) ;Alternate buffer pointer
DCL$GL ( ALTCC, 1) ;Alternate char count
DCL$GL ( DSTBP, 1) ;Bp to dest. buffer
DCL$GL ( DSTCC, 1) ;# chars left in dest. buffer
DCL$GL ( OUTBUF, ^D100) ;Output string buffer
DCL$GL ( TEMPBF, ^D20) ;Temp buffer for dates, MOVST
DCL$GL ( ALTOUT, 1) ;-1 if TX$RPT called
DCL$GL ( ALTBCC, 1) ;Address of user's BP, CC
DCL$GL ( BUFDMP, 1) ;User's routine to dump buffer
DCL$GL ( BUFINT, 1) ;Addr of user's routine to init buffer
DCL$GL ( SVT34, 2) ;Some saved acs
DCL$GL ( SVT56, 2)
>
;
; $ERR - CALL TX$OUT TO DISPLAY A MESSAGE
;
DEFINE $ERR(MSG$,REACT$)< ;;CALL ARGUMENTS AND LABEL
$CALL TX$OUT,<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
>
>
; $TYPE - TYPE AN ALL-TEXT MSG
;
DEFINE $TYPE(TXT$)<$CALLB TX$OUT,<[[ASCIZ/TXT$/]]>>
EXTERN RM$ASZ,TX$TOUT
$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 CONVERSELY
;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.
; Remember to change RMS$VER and VR%EDIT
RMS$VER==300,,652 ; USED BY DYNAMIC LIBRARY PDV SETUP
; THIS & BELOW SHOULD AGREE
DEFINE $VERS< ;;SET THE COMMON VERSION NUMBER FOR PROG
VR%CUS==0 ;;PROBABLY ALWAYS 0
VR%VERS==3 ;;MAJOR RELEASE CYCLE
VR%MAINT==0 ;;EG. ==1 WOULD IMPLY VERSION 1.1
VR%EDIT==652 ;;UPDATED EACH PUBLISHED PATCH
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$OUT,<MSG$,[$$CPON(0)'ERR$]> ;;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$OUT,<[$$CPON(0)'ERR$]>> ;PUT OUT MSG
IFNB <MSG$>,<$CALLB TX$OUT,<MSG$,[$$CPON(0)'ERR$]>> ;;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]
; 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