DEFSUB
* /--- FILE TYPE = E
* /--- BLOCK IDENT 00 000 75/05/29 20.21
IDENT DEFSUB
TITLE SUBROUTINES USED BY -DEFINE- OVERLAY
*
CST
*
EXT ECSPRTY,KEYTYPE
*
*
* /--- BLOCK DEFSUB 00 000 81/07/16 04.24
TITLE DEFINE/SEGMENT/UNITS OVERLAY CALLS
*
*
*
ENTRY DEFREAD
DEFREAD SA1 LOCAL IF LOCAL SET ACTIVE, PURGE IT
ZR X1,DFRD10 IF LOCAL SET NOT ACTIVE
*
MX6 0 CLEAR LOCAL FLAG
SA6 A1
EXEC DEFOV,3 PURGE LOCAL SET FOR GLOBAL SET
*
ENTRY DFRD10
DFRD10 EXEC DEFOV,0 NORMAL DEFINE INTERPRETATION
*
*
*
ENTRY SEGREAD
SEGREAD EXEC SEGOV,0
*
*
*
ENTRY UNSREAD
UNSREAD EXEC SEGOV,1
*
*
*
ENTRY SEGFLG
SEGFLG BSS 1
*
*
* /--- BLOCK GETNAME 00 000 80/03/23 06.41
TITLE -GETNAME-
*
*
*
* -GETNAME- BUILD DEFINE NAME
* ON ENTRY - B1 = MAXIMUM NUMBER OF CHARACTERS
* ON RETURN - X6 = LEFT JUSTIFIED NAME
* X1 = TERMINATOR CHARACTER
* X2 = TERMINATOR KEYTYPE
* B1 = CHARACTER COUNT
* B2 = -1 IF COLON ENCOUNTERED
* 0 IF NORMAL DELIMITER
*
ENTRY GETNAME
GETNAM0 SX4 X4-70B CHECK FOR PRECEDING SHIFT
ZR X4,GETNAM2 IF COLON OR DOUBLE QUOTE
*
GETNAME EQ *
SB2 B0 FLAG NO COLON ENCOUNTERED
SB3 B1 GET LIMIT ON LENGTH OF NAME
SA1 WORDPT POINTER TO FIRST CHAR OF NAME
BX7 X1
SB1 B0 CHARACTER COUNT
SB2 54 INITIALIZE SHIFT COUNT
MX6 0 BUILD NAME IN X6
RJ NXTCODE GET FIRST CHAR OF NAME
PL X2,GETNAM0 MAY NOT BE NUMBER OR OP
*
GETNAM1 RJ NXTCODE GET NEXT CHARACTER
PL X3,GETNAM0 EXITWITH TERMINATOR IN X1
LT B3,B1,GNERR ERROR IF TOO MANY CHARACTERS
EQ GETNAM1
*
NXTCODE EQ *
NXTCD1 BX4 X1 SAVE LAST CHARACTER CODE
SA1 X7
SX7 X7+1
SA7 WORDPT ADVANCE / UPDATE POINTER
SX2 X1-1R CODE FOR SPACE
ZR X2,NXTCD1 IGNORE SPACES
SA2 X1+KEYTYPE
SX3 X2-1 SEE IF TERMINATOR (OP)
PL X3,NXTCODE
SB1 B1+1 INCREASE CHAR COUNT
LX0 X1,B2
SB2 B2-6 DECREASE SHIFT COUNT
BX6 X6+X0 ADD TO WORD BUILDING
EQ NXTCODE
*
GETNAM2 BX6 X6-X0 REMOVE SHIFT CODE
SB1 B1-1 DECREMENT CHARACTER COUNT
SB2 -1 FLAG COLON ENCOUNTERED
EQ GETNAME
*
*
GNERR SB1 29 BAD NAME
SA1 =10LBAD NAME
BX7 X1
SA7 CERROR1 STORE MESSAGE
SX7 11 CODE FOR DEFINE ERROR
SA7 TFORMOK
SA3 LOCAL
ZR X3,=XERR IF NOT PROCESING LOCAL SET
*
SA1 DSET
SA1 SETNAMS+X1 X1 = NAME OF CURRENT SET
SA2 KLOCAL X2 = NAME OF LOCAL SET
IX3 X1-X2
ZR X2,=XERR IF LOCAL SET PROCESSING OK
*
MX6 0 NO LOCAL SET IN EFFECT
* /--- BLOCK GETNAME 00 000 80/03/23 06.41
SA6 A3 ZERO LOCAL FLAG
EQ =XERR
*
ENTRY KLOCAL
KLOCAL DATA 00141703011400000000B
*
* /--- BLOCK DEFSUB 00 000 77/01/13 14.27
TITLE -SYMCHK-
*
*
*
* -SYMCHK-
* CHECK IF DEFINED NAME CONFLICTS WITH SYSTEM NAME
*
EXT FCTLIST,LASTFCT,NKLIST,NKLEND,ERRCALL
*
ENTRY SYMCHK
SYMCHK EQ *
SA1 B1 GET DEFINED NAME
BX6 X1
SA6 LASTFCT PLANT FOR END TEST
SA6 NKLEND
SA6 SYMMES1 PLANT FOR ERROR MESSAGE
MX0 42
SB1 1
SA1 FCTLIST-1 INITIALIZE READ REGISTER
*
SYMLP1 SA1 A1+B1 PICK UP NEXT FUNCTION NAME
BX1 X1-X6 SEE IF NAMES MATCH
BX2 X0*X1
NZ X2,SYMLP1 JUMP IF NO MATCH
NG X2,SYMLP1 CHECK FOR -0
SB2 A1
SB3 LASTFCT SEE IF A MATCH WAS FOUND
LT B2,B3,SYMDUP
SA2 LASTFCT GET DEFINED NAME AGAIN
SA1 NKLIST-1
*
SYMLP2 SA1 A1+B1 GET NEXT ENTRY
BX6 X1-X2 COMPARE
BX6 X0*X6 MASK FOR NAME
NZ X6,SYMLP2
SB1 NKLEND CHECK FOR NO MATCH
SB1 A1-B1
NZ B1,SYMDUP
SA1 NLIST-1 INITIALIZE READ REGISTER
*
SYMLP3 SA1 A1+1 LOAD NEXT NAME
ZR X1,SYMCHK EXIT IF END OF LIST
BX1 X1-X2
BX1 X0*X1
NZ X1,SYMLP3 JUMP IF DOES NOT MATCH
*
SYMDUP SB1 95 WARNING ERROR, SYSTEM VARIABLE RE-DEFINED
RJ =XRJERR
EQ SYMCHK
*
*
* EXTRA NAMES NOT RECOGNIZED AS FUNCTIONS, RESERVED
* WORDS OR KEY NAMES
*
NLIST DATA 4LSKIP DRAW 1010;SKIP;2010
DATA 0LBRANCH
DATA 0LDOTO
+ VFD 12/7620B,48/0 PI
+ VFD 12/7617B,48/0 DEGREE SIGN
DATA 0
*
SYMMES1 DATA 0
*
END