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