plato:source:plaopl:embed
Table of Contents
EMBED
Table Of Contents
- [00019] EMBED –EMBEDS COMMANDS IN TEXT
- [00188] COMMAND SCANNING ROUTINE FOR EMBED
- [00294] NXTNAMR
- [00334] SHOW –READIN FOR SHOW, SHOWT, SHOWE
- [00402] READIN FOR -COLOR-
Source Code
- EMBED.txt
- 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
plato/source/plaopl/embed.txt · Last modified: 2023/08/05 18:54 by Site Administrator