EMBED
* /--- FILE TYPE = E
* /--- BLOCK EMBED 00 000 79/07/12 05.24
IDENT EMBED
*
* GET COMMON SYMBOL TABLE
*
CST
*
EXT ERRTAGS,ERRNAME,ERRSTOR
EXT ERRXYTG,ERR2MNY,ERR2FEW
EXT ERRTERM,ERRUARG,ERRVTYP
EXT ERROUTR,ERRCNTD,ERRXORQ
EXT ERRBAL,PUTCODE,VARDO
EXT KEYTYPE,VARFIN
EXT VARDO2
*
* /--- BLOCK EMBED 00 000 78/09/09 01.03
TITLE EMBED --EMBEDS COMMANDS IN TEXT
* THIS ROUTINE IS CALLED WITH WORDPT POINTING TO
* THE NEXT CHARACTER (AFTER SWALLOWING THE EMBEDDING
* CHARACTER)
*
* --> NOTE <--
* IF YOU ADD AN -EXT- TO THIS DECK, YOU MAY HAVE
* TO NAME THE ENTRY POINT TO THE *DUMMY* LIST IN
* DECK MCOND1. THIS IS BECAUSE MCOND1 USES EMBED,
* AND MUST SATISFY EXTERNAL REFERENCES TO KEEP THE
* LOADER HAPPY.
* J R SCHRAMM 83/02/08
*
* --> MORE NOTE <--
* IF YOU ARE ADDING AN EMBEDDED FUNCTION AND YOU
* WANT IT TO WORK IN THE -PACK- AND PACKC- COMMANDS,
* BE SURE TO ADD AN ENTRY TO THE *PACKLST* TABLE IN
* THE -PACK- OVERLAY (PACKOV) IN DECK COVLAY3. UGH.
* CHRIS JOHNSON. 83/03/24.
*
JUMP MACRO NAME,TAG,PROCED
VFD 60/0L_TAG
JMP RMT
SX7 =X_NAME_TAG_=
EQ PROCED
JMP RMT
JUMP ENDM
*
LIST G,M
EXT ZAT= GET AROUND LOADER
AT= EQU ZAT=-1
EXT COLOR=
C= EQU COLOR=
EXT HIDDEN=
ENTRY EMBED
* TABLE OF EMBED COMMAND NAMES
CLIST JUMP ,SHOW,SEMB
JUMP SHOW,A,SAEMB
JUMP SHOW,T,SEMB
JUMP SHOW,O,SOEMB
JUMP SHOW,H,SHEMB
JUMP SHOW,E,SEMB
JUMP SHOW,Z,SEMB
JUMP SHOW,S,SEMB
JUMP SHOW,K,SKEMB
JUMP ,SHOWK,SKEMB
JUMP ,AT,ATEMB
JUMP ,ATNM,ATEMB
JUMP ,SIZE,SIZEMB
JUMP ,ROTATE,ROTEMB
JUMP ,SHOWA,SAEMB
JUMP ,SHOWT,SEMB
JUMP ,SHOWO,SOEMB
JUMP ,SHOWH,SHEMB
JUMP ,SHOWE,SEMB
JUMP ,SHOWZ,SEMB
JUMP ,COLOR,COLREMB
JUMP ,C,COLREMB
JUMP ,HIDDEN,SAEMB
ENDLIST DATA 0 TEMPORARY
*
*
EMBED EQ * ENTRY/EXIT LINE
SB1 1 CONSTANT
SA1 WORDPT POINTS TO CURRENT CHARACTER
SA1 X1 GET 1ST CHAR
SX2 76B ACCESS CODE
EMLOOP BX3 X2-X1
ZR X3,HAVACC
EMLOOPR ZR X1,EMBERRC
SA1 A1+1 USE CONSTANT TO ELIM PASS
EQ EMLOOP
HAVACC SA1 A1+B1
SX0 1R1
BX3 X0-X1 SEE IF HAVE END-EMBED CODE
NZ X3,EMLOOPR
SX7 A1-B1 POINT TO ACCESS CODE
SA7 SAVACC
MX7 0
SA7 A1 ZERO THE 1
SA7 A1-B1 ZERO ACCESS CODE TOO
*** GET COMMAND NAME TO BE PROCESSED
SB1 CLIST
* /--- BLOCK EMBED 00 000 78/09/09 01.03
SB2 ENDLIST
RJ COMSCAN SCAN FOR COMMAND NAME
JP B3+CTABLE JUMP INTO COMMAND TABLE
**
CTABLE BSS 0
JMP HERE
+ SB1 154 BAD FORMAT DESCRIPTOR
EQ =XERR
* /--- BLOCK EXECEMBED 00 000 78/09/09 01.05
*
SIZEMB SA7 COMNUM
CALL VARDO
SA1 VARBUF+1 FIRST TAG
SA2 VARBUF+2 SECOND TAG
SA3 VARBUF
SX3 X3-2
ZR X3,SIZEC IF TWO TAG
PL X3,=XERR2MNY IF MORE THAN 2 TAGS
MX2 1 IF ONE TAG, SET SIGN OF 2ND
LX2 XCODEL
SIZEC MX6 -XCODEL
BX2 -X6*X2
BX6 -X6*X1
LX6 60-XCODEL
LX2 60-2*XCODEL
BX6 X6+X2
EQ ENDEMB DONE
*
ROTEMB SA7 COMNUM
CALL COMPILE GET -GETVAR- CODE
LX1 -XCODEL SHIFT TO CORRECT POSITION
BX6 X1 AND PUT IT IN X6
EQ ENDEMB DONE
*
ATEMB SA7 COMNUM
RJ =XATGO
EQ ENDEMB
*
SAEMB SA7 COMNUM
SX7 10 DEFAULT FOR SHOWA
RJ =XSHOWAGO
MX0 1
LX0 60-2*XCODEL
BX6 X6+X0 ADD FLAG--FOR SIMPLOT UPDATING
EQ ENDEMB
*
SOEMB SA7 COMNUM RESET COMMAND NUMBER
SX7 20 DEFAULT FOR SHOWO EMBEDDED
RJ =XSHOWAGO READIN FOR SHOWO
MX0 1
BX6 -X0*X6 CLEAR LITERAL FLAG FOR SHOWO
EQ ENDEMB END EMBEDDING
*
SHEMB SA7 COMNUM RESET COMMAND NUMBER
SX7 15 DEFAULT FOR SHOWH EMBEDDED
RJ =XSHOWAGO CONDENSE SHOWH
MX0 1
BX6 -X0*X6 CLEAR LITERAL FLAG FOR SHOWH
EQ ENDEMB END EMBEDDING
*
SKEMB SA7 COMNUM RESET COMMAND NUMBER
RJ =XSHOWKGO CONDENSE -SHOWK-
EQ ENDEMB END EMBEDDING
*
SEMB SA7 COMNUM
RJ =XSHOWGO
* FALL INTO ENDEMB
*** END EMBED PROCESSING
ENDEMB SB1 1
SA1 SAVACC
SX7 76B ACCESS CODE
SA7 X1
SX7 1R1 COMPLETE END-EMBED CODE
SA7 X1+B1
SX7 A7+B1
SA7 WORDPT RESET TO NEXT CHAR TO PROCESS
EQ EMBED
EMBERRC SX7 A1
SA7 WORDPT
EQ ERRTERM
SAVACC BSS 1 SAVE ACCESS CODE LOCATION
*
* /--- BLOCK COMSCAN 00 000 76/11/26 17.47
TITLE COMMAND SCANNING ROUTINE FOR EMBED
* FINDS RECOGNIZED WORDS IN TAG FIELD AND SETS B3 TO
* 0 IF FIRST ELEMENT, ETC., AND TO B2-B1 IF NOT FOUND
* (I.E., AT END-OF-LIST)
* ENTRY';
* B1 = FIRST OF LIST OF WORDS TO BE RECOGNIZED
* B2 = SCRATCH LOCATION AT END OF LIST
*
* EXIT';
* B3 = OFFSET INTO LIST FOR WORD FOUND (ADDRESS B1+B3)
*
* USES REGISTERS';
* A0,A1,A3,A7
* B3,B5,B7
* X1,X2,X3,X7
*
* ERRORS';
* NO SYMBOL, OR TOO MANY CHARACTERS--ERRNAME
* NO COMMA OR E-O-L AS TERMINATOR----ERRTERM
* NO MATCH FOR SYMBOL--RETURNS B3 SET AT
* END-OF-LIST
*
*
ENTRY COMSCAN
*
COMSCAN EQ * FOR RETURN JUMP ENTRY
*
* * INITIALIZE
*
SB7 1 STORE A CONSTANT ONE
MX7 0 CLEAR WORD ACCUMULATOR
SB4 B1 MOVE ADDRESS TO B4
SB5 60 INITIALIZE SHIFT FOR END
SA1 WORDPT GET POINTER TO FIRST -1 POINTER
SB1 X1-1 IN B1
*
* * STRIP LEADING BLANKS
*
CSCAN SB1 B1+B7 POINT TO NEXT CHARACTER
SA1 B1 GET NEXT CHARACTER
SX2 X1-1R CHECK FOR BLANK
ZR X2,CSCAN SKIP UNTIL FIRST NON-BLANK
SA2 X1+KEYTYPE CHECK LEXICAL TYPE FOR THIS CHARACTER
SX2 X2-1 (ALPHA=-1, NUM=0, EOL=1,...)
PL X2,TOERRN END OF SYMBOL BEFORE WE START
*
* * GET ALPHANUMERIC SYMBOL IN X7
* * USING (KEYTYPE) TO DEFINE ALPHANUMERIC
*
CSLOOP LX7 6 SHIFT WORD
BX7 X7+X1 ADD THIS NEW CHARACTER IN
SB5 B5-6 DECREMENT END SHIFT COUNT
NG B5,TOERRN TEST FOR OVER 10 CHARACTERS
SB1 B1+B7
SA1 B1 GET NEXT CHARACTER
SA2 X1+KEYTYPE
SX2 X2-1 (ALPH=-1,NUM=0,EOL=1,...)
NG X2,CSLOOP CONTINUE FORMING SYMBOL
*
* * LEFT-JUSTIFY SYMBOL
*
LX7 B5,X7 SHIFT WORD --LEFT JUSTIFIED
* /--- BLOCK SCANLOOP 00 000 76/11/26 17.51
*
* * SEARCH LIST FOR THIS SYMBOL
*
SA7 B2 STORE IN END SCRATCH WORD
SA0 B4-B7 SET POINTER TO ORIGIN OF SEARCH WORD LIST
CSCNLOO SA0 A0+B7 POINT TO NEXT WORD
SA3 A0 GET NEXT WORD
BX3 X3-X7
NZ X3,CSCNLOO SEE IF FOUND MATCH
*
* * SET B3 TO EXIT VALUE
*
SB3 A3-B4 HOW FAR INTO LIST
* B3 IS EQUAL TO B2-B1 IF NOT FOUND
*
* * STRIP TRAILING BLANKS
* * FORCE COMMA OR E-O-L
*
CSLP ZR X1,CSCEND
SX2 X1-1R, CHECK FOR COMMA
ZR X2,CSCEND SWALLOW A COMMA
* FORCE A CLEAR SYNTAX--REQUIRE COMMA
SX2 X1-1R CHECK FOR BLANK
NZ X2,CSTERM TERMINATOR ERROR
SB1 B1+B7
SA1 B1 LOOP TO END OF BLANKS
EQ CSLP
*
CSCEND NZ X1,*+1
SB1 B1-1
+ SX7 B1+B7
SA7 WORDPT
EQ COMSCAN
*
CSTERM SX7 B1
SA7 WORDPT
EQ ERRTERM
*
* TOERRN USED BY COMSCAN, NXTNAMR
TOERRN SX7 B1
SA7 WORDPT
EQ ERRNAME
* /--- BLOCK NXTNAMR 00 000 76/11/26 17.51
TITLE NXTNAMR
*
* NXTNAMR RETURNS THE NEXT SYMBOL IN X6, WITH ITS
* MASK IN X3. X1 CONTAINS THE TERMINATING CHARACTER.
*
* THIS ROUTINE SCANS FORWARD, SKIPPING BLANKS, UNTIL
* A TERMINATOR IS FOUND. THE NON-BLANK CHARACTERS
* ARE COLLECTED AS A SYMBOL IN X6. MORE THAN 10
* CHARACTERS IS AN ERROR. WORDPT IS NOT UPDATED,
* BUT B1 IS APPROPRIATELY SET.
* ERROR EXIT TO -ERRNAME- IF MORE THAN 10 CHARACTERS
* 10 CHARACTERS.
*
*
ENTRY NXTNAMR
NXTNAMR EQ *
SA1 WORDPT
SB1 X1
SB2 60
MX6 0
LPNXT SA1 B1
ZR X1,ENDLP
SB1 B1+1 POINT TO NEXT CHARACTER
SX2 X1-1R
ZR X2,LPNXT SKIP BLANKS
SA2 X1+KEYTYPE STANDARD SYNTAX
SX3 X2-1
PL X3,ENDLP CHECK FOR TERMINATOR
SB2 B2-6 SHIFT COUNT
LX1 B2,X1
BX6 X6+X1 FORM SYMBOL
EQ LPNXT
*
ENDLP LT B2,B0,TOERRN GT 10 CHARS IS ERROR
SB2 -B2 DO CALCULATION
SB2 B2+59
MX3 1
AX3 B2,X3
EQ NXTNAMR
* /--- BLOCK SHOWIN 00 000 77/04/23 21.26
TITLE SHOW --READIN FOR SHOW, SHOWT, SHOWE
*
* -SHOW- (CODE=9)
*
EXT ARAYFLG
EXT VARFEM
*
*
ENTRY SHOWIN
*
SHOWIN RJ SHOWGO USE RETURN JUMP--FOR EMBEDDER
EQ PUTCODE
*
*
SHOWGO EQ * ENTRY/EXIT LINE
SX6 1
SA6 ARAYFLG ALLOW -SHOW ARRAY-
MX6 0
SA6 VARBUF+2
SA6 VARBUF+3
RJ VARDO INITIALIZE VARBUF, GET ALL ARGS. COMPILED
SA1 VARBUF SEE HOW MANY ARGS
SX2 X1-3 CHECK IF HAVE
ZR X2,SHOWG3 THREE
PL X2,ERR2MNY OR MORE.
SX2 X1-2 CHECK IF HAVE TWO
ZR X2,SHOWG2 OR ONLY ONE
MX6 1
LX6 XCODEL
SA6 VARBUF+2 SET 2ND ARG TO DEFAULT
SHOWG2 RJ VARFEM
MX2 1
LX2 60-2*XCODEL SHIFT FLAG INTO PLACE
BX6 X6+X2 SET FLAG
EQ SHOWGO
*
SHOWG3 RJ VARFEM GET IT ALL READY
EQ SHOWGO
*
SHOWK TITLE READIN FOR -SHOWK-
*
* -SHOWK- (DISPLAY ALTERNATE KEY NAME)
*
ENTRY SHOWKIN ENTRY FOR NON-EMBEDDED -SHOWK-
SHOWKIN RJ SHOWKGO
EQ PUTCODE
*
*
SHOWKGO EQ * ENTRY/EXIT
RJ VARDO INITIALIZE VARBUF
SA1 VARBUF CHECK NUMBER OF ARGUMENTS
SX2 X1-1
NG X2,ERR2FEW IF NO ARGUMENTS
NZ X2,SHOWKG2 IF MORE THAN ONE ARGUMENT
MX6 1 DENOTE NO COLOR PASSED
LX6 XCODEL POSITION TO TOP BIT OF XCODEL
SA6 VARBUF+2 SAVE SETTING
SX1 2 SET NUMBER OF ARGUMENTS TO 2
SX6 X1 SET INTO WRITE REGISTER
SA6 VARBUF SAVE
SHOWKG2 SX2 X1-2
NZ X2,ERR2MNY IF TOO MANY ARGUMENTS
RJ VARFEM PACK UP VARBUF VARIABLES
EQ SHOWKGO EXIT
*
* /--- BLOCK SHOWIN 00 000 79/09/07 16.54
TITLE READIN FOR -COLOR-
COLREMB BSS 0 EMBEDDED -COLOR DISPLAY-
*
* FIRST ARG = FOREGROUND COLOR, SECOND ARG =
* BACKGROUND COLOR. EITHER IS OPTIONAL, BUT
* AT LEAST ONE MUST BE PRESENT.
*
SA7 COMNUM STORE COMMAND NUMBER
SX6 1 PLACE -COLOR DISPLAY- CODE IN
SA6 VARBUF INITIALIZE VARBUF,
SA6 VARBUF+1 SET FIRST ENTRY = -DISPLAY-
SA1 WORDPT X1 = ADDRESS OF NEXT CHARACTER
SA2 X1 X2 = NEXT CHARACTER
SX7 KCOMMA
IX2 X2-X7 SEE IF COMMA IS FIRST CHARACTER
NZ X2,FCOLOR --- GO GET FOREGROUND TAG
SA7 LASTKEY PLACE COMMA IN *LASTKEY* FOR -BCOLOR-
IX6 X6+X1 ADVANCE *WORDPT*
SA6 A1
RJ OMIT PLACE OMITTED TAG IN VARBUF
EQ BCOLOR --- GO CHECK FOR BACKGROUND TAG
FCOLOR BSS 0 GET FOREGROUND TAG
RJ VARDO2
BCOLOR BSS 0 GET BACKGROUND TAG
SA1 LASTKEY CHECK FOR DELIMITER = COMMA
SX1 X1-KCOMMA
NZ X1,BOMIT --- NOT COMMA; OMIT BGND TAG
*
* THIS MAKES THE BIG ASSUMPTION THAT -COMPILE-
* CATCHES BAD CRAZINESS LIKE ',,^1',
*
RJ VARDO2 GET BACKGROUND TAG
EQ COLREND --- FINISH COMMAND
BOMIT BSS 0 OMIT BACKGROUND TAG
*
* MIGHT HAVE TO DO SOME CHARACTER CHECKING HERE
* TO MAKE SURE *WORDPT* IS KOSHER. MAYBE CHECK
* TO SEE WHAT'7S IN (WORDPT) AND *LASTKEY* AND
* CONTINUE IF THE COMBINATION = CLOSING EMBED.
*
RJ OMIT
COLREND BSS 0
SA1 VARBUF SET X1 FOR CALL TO -VARFEM- (CONDC)
RJ VARFEM BUILD COMMAND WORD, EXTRA STORAGE
EQ ENDEMB --- FINISH EMBEDDED COMMAND
*
* OMIT -- SET SPECIAL OMITTED CODE
*
OMIT EQ *
MX6 1
LX6 XCODEL X6 = OMITTED ARG CODE
SA1 VARBUF CURRENT VARBUF INDEX
SX7 X1+1 INCREMENT INDEX
SX2 X7-VARBUFL CHECK FOR VARBUF OVERFLOW
PL X2,ERR2MNY --- VARBUF FULL
SA7 A1 STORE NEW VARBUF COUNT
SA6 VARBUF+X7 STORE OMITTED ARGUMENT
EQ OMIT
KCOMMA EQU 56B COMMA CHARACTER
*
END