CONDC * /--- FILE TYPE = E * /--- BLOCK INIT 00 000 81/08/05 21.27 IDENT CONDC LCC OVERLAY(1,0,O=OVERLAY) CST * * * CALL EITHER INITIAL ENTRY OR MTUTOR FINISH * CONDC LEVEL LEVEL0 + EQ INITC INITIAL ENTRY + EQ =XCONDFIN FINISH UP AFTER MICROTUTOR INITC X INITOV ENDS UP JUMPING TO NXTLINE END CONDC * /--- BLOCK ENTRY 00 000 81/07/16 09.27 IDENT CONDC1 TITLE CONDC1 CPU-TUTOR CONDENSOR TITLE ENTRY CST * * ENTRY POINTS * ENTRY SEPCMAS ENTRY VARDO ENTRY VARDO1 ENTRY VARDO2 ENTRY VARDOR ENTRY PUTDO2 ENTRY SYSTEST ENTRY VARFIN ENTRY VARFINM ENTRY MRKLAST ENTRY VARFINS ENTRY VARDOC ENTRY VARDOCL ENTRY VARFEM ENTRY VARLEX ENTRY VARONE ENTRY NOARG ENTRY VARSEP ENTRY CSTO ENTRY NXTLINE ENTRY NXTC ENTRY SHOWAGO ENTRY ATGO ENTRY PAUSE2 ENTRY ONETWO1,NOTAG * FOLLOWING FOR PACK OVERLAY ENTRY CONV2,BRVAR,CONUL4 ENTRY CONV3 ENTRY RGIN * /--- BLOCK ENTRY 00 000 81/07/16 01.47 * ENTRIES FOR TABC ENTRY SONE2IN,SEEDC,MASTORC,CALCCIN,OKIN ENTRY AFONTC,ONEARG,PUTVC,ONEPUT,ONESTOR ENTRY ANSUIN,ANSVIN,ONE2C,ONE2IN,ONE2IN0 ENTRY SYSONEP,SYSONES,CKPTC,OUTPTIN,SYSTRI ENTRY SYSTWO,ATIN,FORGNDI,AUDIOC,TEXTIN ENTRY TWOARG,GETCHRC,SAYCIN,BCKGNDI,BLOCKIN ENTRY BLOCKIN,GETMKC,USEEC,RECRDIN,SHOWHC ENTRY PERMIN,SSTARIN,GROUPIN,TERMC,PLAYC ENTRY PPTRUNC,CHECKIN,CHARIN,CHARTST ENTRY NOIN,PPTADDC,NAMEC,PPTOUTC,CODOUTC ENTRY COLLCTC,ENDIN,TERMOPC,TWOSTOR,LLISTIN ENTRY WRGUIN,CREATEC,EXTC,COMPARC,SLIDEC ENTRY SLISTIN,SAYLGIN,CSETIN,MDBITIN,CONDNIN ENTRY ONE0,ERASEC,SHOWAIN,SYSLOIN,ONETWO ENTRY WRTNSIN,SAYIN,REMOVLC,IGIN,SHOWOC ENTRY HASHIN * EXTERNALS FOR TABC EXT OVRLAYS EXT ERASEC= EXT BACKG= EXT WRONGV= EXT ANSV= EXT OK= EXT FINIS= EXT HOLFIN EXT COMNAMS EXT COMINFO * /--- BLOCK EXT 00 000 81/07/16 04.07 TITLE EXT * * EXTERNAL SYMBOLS * EXT KEYTYPE EXT ERRORC EXT ABORTC EXT GETLINE ROUTINE TO GET NEXT LINE OF TUTOR CODE * * EXTERNS IN COND EXT OLDCMND EXT CLINES * /--- BLOCK VARS 00 000 81/07/14 14.31 ENTRY COMCONT * COMCONT VFD 60/8L BLANK FOR CONTINUED COMMAND COMCONF VFD 60/8L\ \ FOR RUSSIAN (1-FONT,7-SPACES) * /--- BLOCK NXTLINE 00 000 81/07/17 15.04 TITLE -NXTLINE- MAIN LOOP * NXTLINE BSS 0 PROCESS NEXT LINE OF LESSON */// SA1 TMPCMNM HE WHO TRIES TO TRASH MY CELL SA2 TMPTRAP WILL JUST BE TOLD TO GO TO HELL BX1 X1-X2 IF THINGS DONT JIVE, ZR X1,NLTMPOK THE BOMB WILL DROP PS BY MEANS OF THIS HERE PROGRAM STOP TMPTRAP DATA 8L*TEMPCOM NLTMPOK BSS 0 */// SA1 TSCOMFG PL X1,NXTLIN JUMP IF STAT OFF RJ PSTCMS1 TAKE COMMAND STATISTICS NXTLIN RJ GETLINE GET NEXT LINE--*WORDPT*=1ST TAG CHAR ADDR. NXTC SA2 COMMAND X2 = CURRENT COMMAND NAME SA3 COMCONT SEE IF IT IS A BLANK (CONTINUED COMMAND) SA4 COMCONF SEE IF A FONT CONTINUED BX3 X2-X3 BX4 X2-X4 + ZR X3,*+1 SEE IF CONTINUED COMMAND NZ X4,NXTCOM NOT EQUAL MEANS NEW COMMAND SA2 OLDCMND GET PREVIOUS COMMAND NAME NXTCOM SA1 CLINES COMMANDS PROCESSED THIS LESSON SX6 X1+1 INCREMENT COUNT SA6 A1 * LIST X,G * *CALL MACROS * ADR MICRO 1,,/A0/ A0 = START OF HASH TABLE COM MICRO 1,,/B2/ B2 = START OF COMNAMS FOR FIND SA0 COMINFO COMINFO IS HASH TABLE * * HASH THE COMMAND NAME * HASH X2,X0,A1 X2 = CURRENT COMMAND (HOLERITH) * * FIND COMMAND IN NAME TABLE * SB2 COMNAMS FIND X2,X0,NXTCOMA,B1,X5,B5,B3,B4,A1 * LIST * * * TREAT POSSIBLE STATEMENT LABEL EXACTLY LIKE -CALC- * SA5 LABINFO X5 = LABEL INFO UX5,B5 X5 B5 = INDEX FOR STATISTICS LX5 16 POSITION PROPERLY EQ NXTCOMB * COMMAND NAME WAS FOUND NXTCOMA BX6 X2 SA6 OLDCMND SAVE COMMAND NAME LX5 16 BIT SET IF COMMAND MAY NOT BE INDENTED * /--- BLOCK NXTLINE2 00 000 81/07/13 20.33 * X5 HOLDS COMMAND INFO * B5 HOLDS NAME TABLE INDEX (FOR STATISTICS) * * CHECK IF THIS COMMAND CAN BE INDENTED NXTCOMB SA1 INDENT INDENT COUNT FOR THIS LINE SA2 PISTACK POINTER TO TOP OF INDENT STACK ZR X1,NXTCOMC OK IF NOT INDENTED NG X5,NOINDT ERROR IF CAN'7T HAVE INDENTING * VERIFY THAT THIS COMMAND IS INDENTED PROPERLY NXTCOMC LX5 -1 BIT SET IF COMMAND DOES ITS OWN VERIFYING IX2 X2-X1 COMPARE INDENT AND STACK LEVELS ZR X2,NXTCOMF JUMP IF INDENTING IS CORRECT NG X5,NXTCOMF JUMP IF SPECIAL COMMAND RJ =XCHKIND OUTPUT ERROR MESSAGES AND FIX THE STACK UP * CHECK IF NEED TO TERMINATE THE CALC NXTCOMF LX5 -1 BIT SET IF CALC-TYPE COMMAND SA1 =XCALCACT ZR X1,NXTCOMG JUMP IF NO CALC IS ACTIVE NG X5,NXTCOMG JUMP IF CALC-TYPE COMMAND RJ =XENDCALC TERMINATE CALC (SAVES X5,B5) NXTCOMG LX5 34 POSITION COMMAND INFO UX5,B1 X5 COMMAND NUMBER TO B1 SX6 B1 SB1 X5 B1 = JUMP ADDRESS SA6 COMNUM SAVE COMMAND NUMBER IN COMNUM SA1 TSCOMFG ZR X1,NXTCOMH IF NO STATISTICS SX6 B5 SA6 SCOMNUM SAVE COMMAND NUMBER FOR STAT MX6 59 SA6 A1 SET COMMAND STAT FLAG TO -1(ON) SA2 SYSCLOK BX6 X2 SA6 SCOMBEG SAVE BEGIN COMMAND CONDENSING TIME * NXTCOMH NG B1,NXTCOMI IF OVERLAY CALL JP B1 * * LOAD AND EXECUTE OVERLAY * NXTCOMI MX7 0 CLEAR OVERLAY STACK POINTER SA7 =XOVRSTAK SX7 B1 MX2 -8 BX6 -X2*X7 (X6)=OVERLAY ARGUMENT SA6 OVARG1 AX7 9 BX7 -X2*X7 (X7)=OVERLAY NUMBER SX7 X7+OVRLAYS RESTORE PROPER VALUE CALL EXECOV0 EXECUTE OVERLAY EQ ERRORC FOR THOSE WHO RETURN ON ERRORS * ENTRY LABINFO LABINFO DATA 0 HOLDS INFO FOR STATEMENT LABEL * /--- BLOCK STANDARDS 00 000 80/12/26 14.26 TITLE STANDARD COMMAND WORD STORAGE EXITS * * * THE -CALCODE- ENTRY POINT ASSUMES THAT THE * -GETVAR- OR -PUTVAR- CODE IS IN X1. THIS CODE * IS MOVED TO THE TOP *XCODEL* BITS AND ADDED TO * THE COMMAND CODE NUMBER, WITH THE RESULT STORED * AS THE COMMAND WORD. * ENTRY CALCODE * CALCODE MX0 -XCODEL ONLY WANT -GETVAR- CODE BX6 -X0*X1 LX6 -XCODEL LEFT-ADJUST -GETVAR- CODE * * * * THE -PUTCODE- ENTRY POINT ADDS THE COMMAND CODE * NUMBER TO THE CONTENTS OF REGISTER X6 AND STORES * THE RESULT AS THE COMMAND WORD. * ENTRY PUTCODE * PUTCODE SA1 COMNUM X1 = COMMAND NUMBER BX6 X6+X1 ADD REMAINDER OF COMMAND WORD * * * THE -ALTCODE- ENTRY POINT PROVIDES AN EXIT * BRANCH ADDRESS FOR USE BY COMMANDS THAT EMPLOY AN * ALTERNATE COMMAND CODE NUMBER. THE COMPLETED * COMMAND WORD IS ASSUMED TO BE IN X6. * ENTRY ALTCODE * ALTCODE SA1 ICX X1 = CURRENT CODES INDEX SX7 X1-1 DECREMENT CODES COUNT SA7 A1 SA6 INFO+X7 STORE COMMAND WORD EQ NXTLINE * * * THE -ALTCOD1- ENTRY POINT IS THE SAME AS * THE -ALTCODE- ENTRY POINT, EXCEPT IT ASSUMES * A CALL TO -GETLINE- HAS ALREADY BEEN DONE * ENTRY ALTCOD1 ALTCOD1 SA1 ICX X1 = CURRENT CODES INDEX SX7 X1-1 DECREMENT CODES COUNT SA7 A1 SA6 INFO+X7 STORE COMMAND WORD EQ NXTC * * * THE PUTTWO ENTRY POINT ASSUMES TWO -GETVAR- * CODES IN X1 AND X2. THEY ARE MOVED UP AND * COMBINED WITH THE COMMAND NUMBER TO FORM * THE COMMAND WORD. * ENTRY PUTTWO * PUTTWO MX0 -XCODEL BX6 -X0*X1 LX6 -XCODEL LEFT POSITION FIRST CODE BX2 -X0*X2 LX2 -2*XCODEL BX6 X6+X2 .OR. IN SECOND CODE EQ PUTCODE * * /--- BLOCK STANDARDS 00 000 80/12/26 14.26 TITLE NO ARGUMENT STANDARD READIN * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH EXACTLY NO ARGUMENTS. * ENTRY SYSNO * SYSNO RJ SYSTEST NOARG RJ NOTAG BE SURE THERE IS NO TAG SX6 0 COMMAND NUMBER ONLY EQ PUTCODE --- GO TO STORE COMMAND * * * 'ROUTINE TO CHECK THERE IS NO TAG (OR ONLY * SPACES IN THE TAG). 'EXITS TO ERRORC OTHERWISE. * NOTAG EQ * SA1 TAGCNT ZR X1,NOTAG --- OK IF NO TAG AT ALL * * ONLY ALLOW SPACES TO FOLLOW COMMAND * SA1 WORDPT PICK UP POINTER TO TAG SA1 X1 GET FIRST CHARACTER OF TAG NOTAG1 SX2 X1-1R IF SPACE THEN IGNORE NZ X2,NOTAG2 NON-SPACE, NEXT CHECK IF EOL SA1 A1+1 GET NEXT CHARACTER EQ NOTAG1 LOOP TILL NOT A SPACE * NOTAG2 ZR X1,NOTAG --- OK IF EOL EQ ERR2MNY --- OTHERWISE AN ERROR * /--- BLOCK ONEARG 00 000 77/09/03 11.49 TITLE ONE ARGUMENT STANDARD READINS * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH EXACTLY ONE ARGUMENT. * ENTRY SYSONE * SYSONE RJ SYSTEST CHECK IF REAL SYSTEM LESSON * ONEARG CALL COMPILE COMPILE -GETVAR- CODE SA2 LASTKEY NZ X2,ERR2MNY ONLY ALLOW ONE ARGUMENT EQ CALCODE * * * SAME AS -ONEARG- BUT CHECKS STOREABILITY * SYSONES RJ SYSTEST SEE IF SYSTEM LESSON ONESTOR CALL COMPILE COMPILE -GETVAR- CODE NZ B1,ERRSTOR MUST BE STOREABLE SA2 LASTKEY NZ X2,ERR2MNY ONLY ALLOW ONE ARGUMENT EQ CALCODE * * * THIS IS A GENERAL ONE-ARGUMENT, STOREABLE READIN * FOR USE BY A COMMAND DOING A FPUTVAR OR NPUTVAR * AT EXECUTION TIME. * ONEPUT CALL PUTCOMP COMPILE -PUTVAR- CODE SA2 LASTKEY NZ X2,ERR2MNY ALLOW ONLY ONE ARGUMENT EQ CALCODE * * * THIS IS A STANDARD READIN FOR COMMANDS THAT MAY * HAVE NONE OR EXACTLY ONE ARGUMENT. IF NO TAG, * THE SIGN BIT OF THE COMMAND WORD IS SET. * * USED BY * -CHECK- * -EXIT- * -SCORE- * -ROTATE- * -PAINT- * ** PAUSE2 ALSO USED BY -ERASE-, -POLAR-, -TIME-, ** -EDIT- AND -ONE2IN0-. CHECKIN RJ SYSTEST ONLY SYSTEM LESSONS CAN USE ONE0 SA1 TAGCNT SEE IF BLANK TAG NZ X1,ONEARG IF NOT, TREAT NORMALLY PAUSE2 MX6 1 SIGN BIT NEGATIVE FOR BLANK TAG *(NO GETVAR CODE SETS THE SIGN BIT OF THE COMMAND WORD.) EQ PUTCODE NOW ADD COMMAND CODE AND STORE * ENTRY TWOBITS * SET TOP 2 BITS OF COMMAND WORD. * USED BY ERASE AND COMMONX. TWOBITS MX6 2 EQ PUTCODE ADD COMMAND CODE AND STORE * /--- BLOCK TWOARG 00 000 80/07/12 03.59 TITLE TWO ARGUMENT STANDARD READINS * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH EXACTLY TWO ARGUMENTS. * SYSTWO RJ SYSTEST FOR 2 ARG SYSTEM COMMANDS TWOARG RJ TWODO GET TWO ARGS EQ PUTTWO COMPLETE COMMAND WORD * * * * TWO ARGUMENTS, FIRST MUST BE STOREABLE * * USED BY -COLLECT-, -TEXT-, -OUTPUTT-, -TEKTRON- * ENTRY COLLCTC * OUTPTIN RJ SYSTEST COLLCTC RJ TWODO GET TWO ARGS NG X1,ERRSTOR FIRST ARG MUST BE STOREABLE EQ PUTTWO COMPLETE COMMAND WORD * * * * TWO ARGUMENTS, SECOND MUST BE STOREABLE * * USED BY -GETMARK- AND -SYSLOC- * SYSLOIN RJ SYSTEST FOR SYSTEM COMMANDS GETMKC RJ TWODO GET TWO ARGS NG X2,ERRSTOR SECOND ARG MUST BE STOREABLE EQ PUTTWO COMPLETE COMMAND WORD * * * TWO ARGUMENTS -- BOTH MUST BE STOREABLE * * USED BY -RECNAME- (155) * TWOSTOR RJ TWODO GET TWO ARGS NG X1,ERRSTOR FIRST ARG MUST BE STOREABLE NG X2,ERRSTOR SECOND ARG MUST BE STOREABLE EQ PUTTWO COMPLETE COMMAND WORD * * * * COMPILE ARGUMENTS, CHECK FOR EXACTLY TWO * EXIT WITH GETVAR WORDS IN X1,X2 * TWODO EQ * RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF GET NO. OF VARIABLES SX2 X1-2 NG X2,ERR2FEW NZ X2,ERR2MNY MUST BE TWO TAGS SA1 VARBUF+1 GET FIRST CODE SA2 VARBUF+2 GET SECOND CODE EQ TWODO * /--- BLOCK ONETWO 00 000 76/07/17 05.45 TITLE ONE OR TWO ARGUMENT STANDARD READINS * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH ONE OR TWO ARGUMENTS. * IF THERE ARE TWO ARGUMENTS, THE FOLLOWING * COMMAND NUMBER IS USED. * * 'CURRENTLY USED BY THE FOLLOWING COMMANDS -- * * -ARROW- (CODE=11 OR 12) * -DOT- (CODE=44 OR 45) * SONETWO CALL SYSTEST ONETWO RJ VARDO COMMA SEPARATED VARIABLES ONETWO1 SA1 VARBUF+1 *** FROM ARROWC MX0 -XCODEL BX6 -X0*X1 GET 1ST -GETVAR- CODE LX6 -XCODEL PLACE IN FIRST POSITION SA1 VARBUF X1 = NUMBER OF VARIABLES SX1 X1-2 NG X1,PUTCODE DONE IF ONE TAG--CODE IN X6 NZ X1,ERR2MNY ERROR IF MORE THAN 2 TAGS SA2 VARBUF+2 GET SECOND -GETVAR- CODE ONETWOA BX2 -X0*X2 *** FROM PERMIN LX2 -2*XCODEL BX6 X6+X2 PLACE IN SECOND POSITION SA1 COMNUM SX1 X1+1 ADVANCE TO NEXT COMMAND BX6 X6+X1 EQ ALTCODE AND STORE COMMAND WORD * * * SAME AS -ONETWO- BUT SECOND ARG MUST BE STOREABLE * * 'CURRENTLY USED BY THE FOLLOWING COMMANDS -- * * -SETPERM- (CODE=60 OR 61) * -REMOVE- (CODE=64 OR 65) * PERMIN RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 GET FIRST -GETVAR- CODE MX0 -XCODEL BX6 -X0*X1 LX6 -XCODEL PLACE IN FIRST POSITION SA1 VARBUF X1 = NUMBER OF VARIABLES SX1 X1-2 NG X1,PUTCODE DONE IF ONE TAG--CODE IN X6 NZ X1,ERR2MNY ERROR IF MORE THAN 2 TAGS SA2 VARBUF+2 GET SECOND -GETVAR- CODE NG X2,ERRSTOR MUST BE STOREABLE EQ ONETWOA FINISH PROCESSING EJECT * /--- BLOCK ONETWO 00 000 77/09/10 18.29 * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH ONE OR TWO ARGUMENTS. * IF THERE IS ONLY ONE ARGUMENT, THE TOP * BIT OF THE SECOND TAG FIELD IS SET. * SONE2IN RJ SYSTEST ONE2IN MX6 1 SET UP FLAG FOR 2ND ARG LX6 XCODEL SA6 VARBUF+2 RJ VARDO SA1 VARBUF PICK NUMBER OF ARGS FOUND ZR X1,ERR2FEW SX2 X1-3 PL X2,ERR2MNY EQ VARFIN * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH NONE, ONE, OR TWO ARGUMENTS. * IF NO ARGUMENTS, THE SIGN BIT OF THE COMMAND * WORD IS SET. IF ONLY ONE ARG, THE SIGN BIT * OF THE SECOND TAG FIELD IS SET. * * -RORIGIN- -GORIGIN- -RAT- -RATNM- -SIZE- * -PPTRUN- -PPTADDR- * ENTRY SYS012 SYS012 RJ SYSTEST CHECK FOR SYSTEM LESSON ONE2IN0 SA1 TAGCNT ZR X1,PAUSE2 EQ ONE2IN * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH NONE, ONE, OR TWO ARGUMENTS. * IF NO ARGUMENTS, THE SIGN BIT OF THE COMMAND * WORD IS SET. IF ONLY ONE ARG, THE SECOND * IS CODED AS 0 (GETVAR CODE=0, GETVAR RETURNS 0). * * -ERASE- (CODE=36) * -POLAR- (CODE=187) * -TIME- (CODE=257) * * ERASEIN SA1 TAGCNT X1 = CHARS IN TAG * ZR X1,PAUSE2 IF BLANK TAG, SET SIGN BIT * EQ SCALIN 1OR2 ARGS (2D=0 IF OMITTED) * * /--- BLOCK ONE2C 00 000 80/08/04 10.29 * * FOLLOWING IS A STANDARD READING FOR COMMANDS * WITH NONE, ONE OR TWO ARGUMENTS * IF NONE, SIGN BIT OF COMMAND WORD IS SET * IF ONLY ONE, SECOND ARGUMENT FIELD IS ZEROED * USED BY -ERASE- -POLAR- -TIME- * ONE2C SA1 TAGCNT ZR X1,PAUSE2 IF BLANK TAG, SET SIGN BIT RJ VARDO COMPILE ARGUMENTS SA1 VARBUF GET NUMBER COMPILED SX2 X1-2 ZR X2,VARFIN IF TWO, GO COMPILE THEM PL X2,ERR2MNY ERROR IF MORE THAN 2 SA1 VARBUF+1 GET FIRST ARG EQ CALCODE GO PACK UP ONE ARG, 2D=0 * * /--- BLOCK TRIARG 00 000 79/12/15 01.18 TITLE THREE ARGUMENT STANDARD READINS * * THE FOLLOWING IS A STANDARD READIN FOR * COMMANDS WITH EXACTLY THREE ARGUMENTS. * ENTRY STRIARG STRIARG RJ SYSTEST SYSTEM LESSONS ONLY TRIARG RJ VARDO COMMA SEPARATED VARIABLES SX1 3 MUST BE EXACTLY 3 ARGUMENTS EQ VARFIN PACK AND STORE TAGFIELDS * * * -TRIARGS- CHECK FIRST ARG STOREABLE * SYSTRI CALL SYSTEST SYSTEM LESSONS ONLY TRIARGS RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 FIRST TAG MUST BE STOREABLE NG X1,ERRSTOR SX1 3 EQ VARFIN * * * SAME AS -TRIARGS- BUT FIRST AND SECOND ARGS * MUST BE STOREABLE. * * CURRENTLY USED BY -BLOCK- COMMAND (CODE=102) * BLOCKIN RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 FIRST TAG MUST BE STOREABLE NG X1,ERRSTOR SA1 VARBUF+2 SECOND TAG MUST BE STOREABLE NG X1,ERRSTOR SX1 3 EQ VARFIN * * * * SAME AS -TRIARG- BUT THIRD ARG MUST BE STOREABLE * * USED BY -COMPARE- COMMAND * COMPARC RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+3 THIRD ARG MUST BE STOREABLE NG X1,ERRSTOR SX1 3 EQ VARFIN * /--- BLOCK SYSIN 00 000 80/02/02 01.18 TITLE READIN OF SYSTEM COMMANDS * * * SYSTEM COMMAND WITH ONE NAME AS ARGUMENT * SYSONEN CALL SYSTEST SEE IF SYSTEM LESSON CALL COMPNAM EQ CALCODE * * * COMMANDS WITH ONE ACCOUNT';FILE NAME AS TAG * ENTRY ONEFILE,SYSONEF * SYSONEF CALL SYSTEST SEE IF SYSTEM LESSON ONEFILE CALL ACCFILF GET FILE NAME ZR X1,ERR2FEW ERROR IF BLANK TAG SX1 2 2 ARGUMENTS LEGAL SA2 LASTKEY ZR X2,VARFIN EQ ERR2MNY ERROR IF EXTRA ARGUMENTS * * * COMMANDS WITH ONE ACCOUNT';FILE NAME AS TAG * WHICH ALSO ALLOW A BLANK TAG * ENTRY ONEFILB * ONEFILB CALL ACCFILF GET FILE NAME ZR X1,PAUSE2 EXIT IF BLANK TAG SX1 2 2 ARGUMENTS LEGAL SA2 LASTKEY ZR X2,VARFIN EQ ERR2MNY ERROR IF EXTRA ARGUMENTS * * * SPECIAL FOR SETPACK--POSSIBLE BLANK TAG * SYSONEP RJ SYSTEST SEE IF SYSTEM LESSON SA1 TAGCNT BLANK TAG CHECK ZR X1,CALCODE JUST USE THE 0 CALL COMPILE EQ CALCODE * * CREATE COMMAND * CREATEC RJ SYSTEST CALL VARDO1 GET FIRST ARG CALL VARDO2 GET SECOND ARG CALL NXTNAM GET THIRD ARG, IF ONE MX3 0 CLEAR THIRD TAG FLAG ZR X6,CCRT0 IF NO THIRD TAG * * THIRD TAG (IF ONE) MUST BE STRING '7NPDWRITE'7 * SA1 =8LNPDWRITE BX2 X1-X6 NZ X2,ERRORC THIRD TAG WAS GARBAGE * MX3 1 SET TOP BIT OF GVAR IF THIRDARG LX3 XCODEL * CCRT0 SA1 VARBUF+1 GET FIRST GVAR CODE BX1 X1+X3 AND MERGE WITH THIRD ARG FLAG * SA2 VARBUF+2 AND GET SECOND ARG EQ PUTTWO COMPLETE COMMAND WORD * * * /--- BLOCK SCANNER 00 000 75/10/30 02.14 TITLE SCANNER ROUTINE * FINDS RECOGNIZED WORDS IN TAG FIELD AND SETS CORRESPONDING * BITS IN X6, X0 RETURNED ZERO IF ALL OK. * THIS ROUTINE SCANS ALL THE WAY TO THE END-OF-LINE, * WITH THE IDENTIFIED WORDS ENTERED IN THE BIT TABLE IN X6 * * CALLING ROUTINE MUST HAVE SET UP FOLLOWING * B1=FIRST OF LIST OF RECOGNIZED WORDS * B2=SCRATCH LOCATION AT END OF SAID LIST * X5=MASK TO BE APPLIED TO TABLE WORDS * ENTRY SCANNER * * SCANNER EQ * FOR RETURN JUMP ENTRY * /--- BLOCK SCANNER 00 000 75/10/30 03.16 SB7 1 STORE A CONSTANT ONE SB4 B2-B1 PUT THE LIST LNTH IN B4 MX0 0 CLEAR ERROR FLAG MX6 0 CLEAR ALL BITS IN WORDS FOUND MX4 1 SET UP FOR SHIFT BIT SB6 60 SET UP FOR FIRST OF 60 WORDS SA1 TAG-1 INITIALIZE TO BEFORE FIRST CH * SCA MX7 0 CLEAR WORD ACCUMULATOR SB5 60 INITIALIZE SHIFT FOR END SCANL SA1 A1+B7 GET NEXT CHARACTER ZR X1,SCANNER TEST FOR END OF LINE SX2 X1-1R+ ACCEPT LETTERS AND NUMBERS ONLY NG X2,SCBUILD SX2 X1-1R TEST FOR SPACES ZR X2,SCANL SX2 X1-1R, TEST OF COMMA ZR X2,SCANL EQ SCERR ANYTHING ELSE AN ERROR * SCBUILD LX7 6 SHIFT WORD A BUILDING BX7 X7+X1 ADD THIS NEW CHARACTER IN SB5 B5-6 DECREMENT END SHIFT COUNT NG B5,SCERR TEST FOR OVER 10 CHARACTERS SA1 A1+B7 GET NEXT CHARACTER * ZR X1,SCBLD1 TEST FOR END OF LINE SX2 X1-1R+ TEST FOR LETTERS AND NUMBERS NG X2,SCBUILD THEN BUILD UP WORD SX2 X1-1R, TEST FOR COMMA PUNC ZR X2,SCBLD1 SX2 X1-1R SPACES ALSO PUNCTUATION NZ X2,SCERR ANYTHING ELSE AN ERROR SCBLD1 LX7 B5,X7 SHIFT WORD INTO TOP-NOTCH SHAPE BX7 X5*X7 APPLY MASK TO GUARANTEE HIT SA7 B2 STORE IN END SCRATCH WORD SA3 B1-B7 SET A3 TO POINT TO START OF SEARCH WORD LST * SCNLOOP SA3 A3+B7 GET NEXT WORD BX3 X5*X3 MASK IT BX3 X3-X7 NZ X3,SCNLOOP SEE IF FOUND MATCH * SB5 A3-B1 HOW FAR INTO LIST EQ B5,B4,SCERR TEST FOR NO FIND SB5 B6-B5 SET UP SHIFT LX3 B5,X4 MOVE BIT SETTER BX6 X6+X3 SET AN X6 BIT ZR X1,SCANNER SEE IF DONE EQ SCA * SCERR MX0 59 SET ERROR FLAG ZR X1,SCANNER TEST IF DONE SX2 X1-1R, SEE IF AT COMMA ZR X2,SCA ON TO NEXT WORD SX2 X1-1R SPACE ALSO PUNC ZR X2,SCA SA1 A1+B7 GET NEXT CHARACTER EQ SCERR LOOP OVER ALL ELSE * /--- BLOCK CSSCAN 00 000 75/10/04 11.47 TITLE CASE-SENSITIVE SCANNER ROUTINE * FINDS RECOGNIZED WORDS IN TAG FIELD AND SETS CORRESPONDING * BITS IN X6, X0 RETURNED ZERO IF ALL OK. * THIS ROUTINE SCANS ALL THE WAY TO THE END-OF-LINE, * WITH THE IDENTIFIED WORDS ENTERED IN THE BIT TABLE IN X6 * * CALLING ROUTINE MUST HAVE SET UP FOLLOWING * B1=FIRST OF LIST OF RECOGNIZED WORDS * B2=SCRATCH LOCATION AT END OF SAID LIST * X5=MASK TO BE APPLIED TO TABLE WORDS * ENTRY CSSCAN * * CSSCAN EQ * FOR RETURN JUMP ENTRY * /--- BLOCK CSSCAN 00 000 75/10/04 12.07 SB7 1 STORE A CONSTANT ONE SB4 B2-B1 PUT THE LIST LNTH IN B4 MX0 0 CLEAR ERROR FLAG MX6 0 CLEAR ALL BITS IN WORDS FOUND MX4 1 SET UP FOR SHIFT BIT SB6 60 SET UP FOR FIRST OF 60 WORDS SA1 TAG-1 INITIALIZE TO BEFORE FIRST CH * CSA MX7 0 CLEAR WORD ACCUMULATOR SB5 60 INITIALIZE SHIFT FOR END CSCANL SA1 A1+B7 GET NEXT CHARACTER ZR X1,CSSCAN TEST FOR END OF LINE SX2 X1-KUP ZR X2,CSBUILD OK IF UPPER CASE SX2 X1-1R+ ACCEPT LETTERS AND NUMBERS ONLY NG X2,CSBUILD SX2 X1-1R TEST FOR SPACES ZR X2,CSCANL SX2 X1-1R, TEST OF COMMA ZR X2,CSCANL EQ CSERR ANYTHING ELSE AN ERROR * CSBUILD LX7 6 SHIFT WORD A BUILDING BX7 X7+X1 ADD THIS NEW CHARACTER IN SB5 B5-6 DECREMENT END SHIFT COUNT NG B5,CSERR TEST FOR OVER 10 CHARACTERS SA1 A1+B7 GET NEXT CHARACTER * ZR X1,CSBLD1 TEST FOR END OF LINE SX2 X1-KUP ZR X2,CSBUILD OK IF UPPER CASE SX2 X1-1R+ TEST FOR LETTERS AND NUMBERS NG X2,CSBUILD THEN BUILD UP WORD SX2 X1-1R, TEST FOR COMMA PUNC ZR X2,CSBLD1 SX2 X1-1R SPACES ALSO PUNCTUATION NZ X2,CSERR ANYTHING ELSE AN ERROR CSBLD1 LX7 B5,X7 SHIFT WORD INTO TOP-NOTCH SHAPE BX7 X5*X7 APPLY MASK TO GUARANTEE HIT SA7 B2 STORE IN END SCRATCH WORD SA3 B1-B7 SET A3 TO POINT TO START OF SEARCH WORD LST * * /--- BLOCK CSSCAN 00 000 75/10/04 12.04 CSNLOOP SA3 A3+B7 GET NEXT WORD BX3 X5*X3 MASK IT BX3 X3-X7 NZ X3,CSNLOOP SEE IF FOUND MATCH * SB5 A3-B1 HOW FAR INTO LIST EQ B5,B4,CSERR TEST FOR NO FIND SB5 B6-B5 SET UP SHIFT LX3 B5,X4 MOVE BIT SETTER BX6 X6+X3 SET AN X6 BIT ZR X1,CSSCAN SEE IF DONE EQ CSA * CSERR MX0 59 SET ERROR FLAG ZR X1,CSSCAN TEST IF DONE SX2 X1-1R, SEE IF AT COMMA ZR X2,CSA ON TO NEXT WORD SX2 X1-1R SPACE ALSO PUNC ZR X2,CSA SA1 A1+B7 GET NEXT CHARACTER EQ CSERR LOOP OVER ALL ELSE * /--- BLOCK DEBLANK 00 000 80/10/02 03.23 TITLE -DEBLANK- STRIP LEADING SPACES * * -DEBLANK- * * MOVE CHARACTER POINTER PAST SPACE CHARACTERS * * ON ENTRY -- *WORDPT* SET * * ON EXIT -- *WORDPT* SET TO FIRST NON-BLANK CHAR * A1 = *WORDPT* * X1 = CONTENTS OF *WORDPT* * X2 = FIRST NON-BLANK CHAR * * USES -- (A1,A2,A6) (X1,X2,X3,X6) * DEBLANK EQ * SA1 WORDPT X1 = CHAR POINTER DOBLP SA2 X1 X2 = THIS CHARACTER SX3 X2-1R IS IT A SPACE NZ X3,DEBLANK -- EXIT IF NOT SX1 X1+1 BX6 X1 ADVANCE CHAR POINTER SA6 A1 EQ DOBLP AND LOOK AT NEXT CHAR * * /--- BLOCK TAGXACT 00 000 76/09/13 13.33 TITLE CHECK FOR EXACT TAG MATCH * ENTRY TAGXACT * * CHECKS WHETHER TAG CONSISTS SOLELY AND EXACTLY OF A * SPECIFIED CHARACTER STRING. ENTER WITH COMPARISON * STRING LEFT-ADJUSTED AND ZERO-FILLED IN X1. (MAY BE UP * TO 9 CHARACTERS.) * ON EXIT, X1 = -1 IF MATCH, 0 IF NO MATCH. * * ALTERS A2, X0,X1,X2,X3,X4 * TAGXACT EQ * SA2 TAG GET FIRST CHAR OF TAG MX0 -6 MASK FOR BOTTOM CHAR TXLOOP LX1 6 POSITION NEXT CHARACTER BX3 -X0*X1 CHAR FROM STRING IN X3 BX4 X2-X3 COMPARE WITH CHAR FROM TAG NZ X4,TXNO FAILS IF NO MATCH ZR X3,TXYES DONE IF 00 CHARACTER SA2 A2+1 GET NEXT TAG CHARACTER EQ TXLOOP * TXNO MX1 0 NO MATCH EQ TAGXACT * TXYES MX1 -1 MATCH EQ TAGXACT * TITLE -COLONCK- CHECK FOR COLON AS NEXT SEPARATOR * * * -COLONCK- * * CHECKS WHETHER SEPARATOR FOLLOWING NEXT ARGUMENT * IS A COLON AND, IF SO, CONVERTS IT TO A SEMICOLON * FOLLOWED BY A BLANK. * * ENTER *WORDPT* SET * * EXIT (X6) = 0 IF NEXT SEPARATOR IS A COLON * (X6) .NE. 0 IF SOME OTHER SEPARATOR * * USES ALL * * CALLS PSCAN * ENTRY COLONCK COLONCK EQ * SA1 WORDPT GET POINTER TO NEXT CHARACTER SX0 0 NO SPECIAL TERMINATOR CALL PSCAN FIND END OF NEXT ARGUMENT SX6 X1-KSEMIC SEE IF ENDED ON SEMICOLON NZ X6,COLONCK EXIT IF NOT A SEMICOLON SA3 B1-1 (X3) = PREVIOUS CHARACTER SX6 X3-KUP SEE IF SHIFT CODE NZ X6,COLONCK EXIT IF NOT A COLON SX7 KSEMIC SA7 A3+ CHANGE SHIFT TO SEMICOLON SX7 1R SA7 A3+1 CHANGE SEMICOLON TO BLANK EQ COLONCK * /--- BLOCK CONDENS 00 000 81/07/10 01.03 * TITLE CONDENS * CONDENS ACCOUNT';LESSON,KEYWORDS * CONDNIN CALL SYSTEST SYSTEM LESSONS ONLY CALL ACCFILF GET ACCOUNT';FILE NAMES ZR X1,ERR2FEW ERROR IF BLANK TAG SX6 0 SA6 CONDMAP PRESET TO NO KEY WORDS SA1 LASTKEY CONDKW ZR X1,COND1 JUMP IF NO KEY WORDS * RJ =XNXTNAME ZR X6,=XERRNAME IF NO KEY WORD THERE * SB1 B0 POINT TO FIRST KEY WORD SB2 CKWEND-CKW NUMBER OF KEY WORDS CKWLP SA1 CKW+B1 X1 = NEXT KEY WORD IX1 X6-X1 ZR X1,CONDMP IF MATCHED KEY WORD * SB1 B1+1 NE B1,B2,CKWLP IF STILL MORE TO SEARCH * EQ =XERRNAME UNRECOGNIZED KEYWORD * CONDMP SA1 CONDMAP TURN ON CONDENSOR OPTION BIT SX2 1 LX2 B1 BX6 X1+X2 SA6 A1 SA1 WORDPT SA1 X1 X1 = NEXT CHARACTER EQ CONDKW LOOP BACK FOR MORE KEYWORDS * COND1 SX1 3 3 ARGUMENTS LEGAL SX6 X1+ SA6 VARBUF EQ VARFIN * CONDMAP EQU VARBUF+3 KEYWORD BITMAP IS 3RD ARGUMENT * * * * -MASTOR- COMMAND * MASTORC CALL SYSTST1 SPECIAL SYSTEM LESSONS ONLY EQ ONESTOR * * * -SYSTEST- SYSTEM LESSON CHECK * ENTRY SYSTEST SYSTEST EQ * SA1 SYSFLG CHECK IF SYSTEM LESSON LX1 ZSLDSHF NG X1,SYSTEST IF YES EQ ERRORC ERROR IF NOT * * * CHECK IF LESSON CAN WRITE ECS/CM * ENTRY SYSTST1 SYSTST1 EQ * CALL SYSTEST CHECK IF SYSTEM LESSON SA1 SYSFLG LX1 ZWLDSHF NG X1,SYSTST1 EQ ERRORC * * * /--- BLOCK +ERASE 00 000 80/10/02 02.52 * * -ERASE- (CODE=36) * * -ERASE BLANK- SETS TOP BIT, * -ERASE N1,N2- RETURNS 2ARG, -ERASE N1- 2D IS 0 * -ERASE ABORT- SETS TOP TWO BITS * ERASEC SA1 TAG FIRST TAG CHAR ZR X1,PAUSE2 BLANKTAG(F.S.ERASE) SETS TOPBIT * * CHECK FOR -ABORT- * SA1 ERABORT RJ TAGXACT SEE IF ',ABORT', TAG NG X1,TWOBITS IF ABORT, SET TOP 2 BITS EQ ONE2C --- ELSE SET UP ARGS * ERABORT DATA 5LABORT * * /--- BLOCK AT, COMMA 00 000 76/07/30 23.42 TITLE -AT- COMMAND * * -AT- COMMAND * ATIN RJ ATGO EQ PUTCODE * ATGO EQ * ENTRY/EXIT LINE CALL VARDO DECODE ONE OR TWO VARIABLES SA2 VARBUF SX2 X2-1 CHECK FOR 1 VARIABLE NZ X2,ONETWOB MX0 -XCODEL SA1 VARBUF+1 LOAD -GETVAR- CODE BX1 -X0*X1 MX0 -XCODEAL MASK FOR ADDRESS PORTION BX2 X0*X1 MUST BE SHORT LITERAL NZ X2,ONETWOB CALL RCTOXY CONVERT TO FINE GRID MX0 -9 BX1 X6+X7 MERGE X AND Y POSITIONS BX1 X0*X1 NZ X1,ERRXYTG ERROR IF ILLEGAL POSITION LX6 60-10 LX7 60-10-9 MX1 1 BX6 X6+X1 MERGE SIGN BIT AND X POSITION BX6 X6+X7 ATTACH Y POSITION EQ ATGO RETURN TO STORE COMMAND WORD * ONETWOB SB1 -1 CONSTANT SA1 VARBUF ONETWOB CALLED FROM TWO PLACES IN ATGO SA2 A1-B1 VARBUF+1 MX0 60-XCODEL TO PICK UP LOWEST 20 BITS BX6 -X0*X2 LX6 60-XCODEL SHIFT INTO PLACE SX1 X1+B1 ZR X1,ATGO ONE ARG--TO (PUTCODE) SX1 X1+B1 N-2 NZ X1,ERRTAGS NEITHER 1 OR 2 SA2 A2-B1 VARBUF+2 BX2 -X0*X2 LX2 60-2*XCODEL BX6 X6+X2 SA1 COMNUM SX7 X1+1 SA7 A1 EQ ATGO NOT SUBROUTINED, AS ONLY ATGO * USES THIS CODE... * /--- BLOCK ARROW 00 000 80/12/26 14.29 * ENTRY NOINDT NOINDT SB1 76 UNIT, ENTRY, ARROW, ENDARROW EQ =XERR MAY NOT BE INDENTED * * 'ROUTINE TO SET PROPER OFFSET INTO ARROW COMMAND. * * ENTRY SETARO * SETARO EQ * SA1 LOCARO X1 = LOCATION OF ARROW COMMAND ZR X1,SETARO5 IF NO PRECEDING -ARROW- * SA2 LVARL X2 = LOCAL VAR STACK LENGTH SX2 X2-1 NG X2,SETARO3 IF NO LOCALS IN LESSON * SX2 X2+1 RESTORE X2 IN CASE NO ERROR ZR B1,NOEARRO IF MISSING -ENDARROW- * SETARO3 BX7 X2 LVARL.LT.0 IF -LVARS- ILLEGAL SA7 A2 SA2 INFO+X1 X2 = ARROW COMMAND WORD SX6 INFOLTH SA3 ICX INDEX TO COMMAND BEFORE THIS IX6 X6-X3 RELATIVE COMMAND BIAS LX6 XCMNDL BX6 X2+X6 ADD POINTER TO ARROW COMMAND SA6 A2 RESTORE MX7 0 SA7 A1 CLEAR ARROW LOCATION EQ SETARO --- EXIT SETARO5 ZR B1,SETARO IF NO -ARROW-/-ENDARROW- * SA2 LVARL SX2 X2-1 NG X2,SETARO IF NO LOCALS IN LESSON * SB1 771 MISSING -ARROW- RJ =XRJERR EQ SETARO * NOEARRO MX7 0 MISSING -ENDARROW- SA7 A1 SB1 772 MISSING -ENDARROW- RJ =XRJERR EQ SETARO * /--- BLOCK UNAMX 00 000 80/12/26 14.30 * TITLE UNAMX * * * -UNAMX- * SUBROUTINE TO FIND UNIT OR ADD TO *UNAM* TABLE * ENTER WITH UNIT NAME IN X6 * * RETURNS WITH NAME IN X1 AND UNIT NUMBER IN X6 * * ENTRY UNAMX UNAMX EQ * SA3 UNUMIN LENGTH OF TABLE SX5 X3-IEUNUM NUMBER OF UNITS SB5 UNAME+IEUNUM SET BASE ADDRESS FOR SEARCH SB3 48 SB4 X5 SAVE SB6 B5 SAVE MX7 12 MX0 59 *** USED BOTH AS MASK AND -1 SB1 1 EQ ULOOK * UBEFORE SB5 A1+B1 RAISE BASE ADDRESS NZ X4,ULOOK JUMP IF ODD LENGTH TABLE IX5 X5+X0 ELSE SUBTRACT 1 FROM LENGTH ULOOK ZR X5,UNOTIN JUMP IF NOT IN TABLE BX4 -X0*X5 SAVE BOTTOM BIT AX5 1 NARROW SEARCH SA1 X5+B5 LOAD ENTRY BX2 -X7*X1 CLEAR TOP 12 BITS IX2 X2-X6 NG X2,UBEFORE JUMP IF BEFORE WHERE NAME WOULD BE NZ X2,ULOOK JUMP IF AFTER AX6 B3,X1 X6 = UNIT NUMBER EQ UNAMX * UNOTIN BX1 X6 X1 = UNIT NAME SX7 X3+B1 SX0 X7-UTABLTH PL X0,ERR2MNU ERROR EXIT IF BUFFER FULL SA7 A3 ELSE ADD 1 TO LENGTH BX6 X3 X6 = UNIT NUMBER SA3 LVARL NZ X3,UNOTIN1 IF LVARL ALREADY SET * MX2 6 X2 = MASK FOR TOP CHARACTER LX2 60-12 BX2 X1*X2 X2 = TOP CHARACTER ZR X2,UNOTIN1 IF PSEUDO UNIT * MX7 -1 FLAG -LVARS- ILLEGAL NOW SA7 A3 * /--- BLOCK UNAMX 00 000 80/12/26 14.31 UNOTIN1 BSS 0 * * SAVE LINE AND BLOCK OF WHERE FIRST REFERENCE OCCURRED SA0 UUTEMP SA2 LINENUM LX7 X2,B3 LEFT SHIFT 48 SA2 BLKNUM BX7 X7+X2 COMBINE BLOCK AND LINE NUMBERS LX7 36 POSITION SA7 A0 SA2 AFUREF FIRST UNIT REFERENCE BUFFER IX0 X2+X6 ADD UNIT NUMBER WE 1 RJ =XECSPRTY * SA2 ATEMPEC ADDRESS OF TEMPORARY ECS BUFFER BX0 X2 SA0 B5 WHERE ENTRY SHOULD GO IN TABLE SB7 B5-B6 SB4 B4-B7 NUMBER OF UNITS AFTER IN TABLE + WE B4 WRITE REST OF TABLE RJ =XECSPRTY SA0 A0+B1 RAISE ADDRESS LX7 X6,B3 POSITION UNIT NUMBER BX7 X7+X1 ADD UNIT NAME SA7 B5 PUT THIS WORD IN NAME TABLE + RE B4 AND READ REST OF TABLE BACK RJ =XECSPRTY * MX7 1 BX7 X7+X1 ADD UNIT NAME SA7 ULOC+X6 SET ULOC TO SHOW UNIT NOT IN * BX7 X1 GET UNIT NAME SA7 UUTEMP SA0 A7 FORM NON-ALPHABETIZED TABLE SA2 AUNAME GET ADDRESS OF TABLE IN ECS IX0 X2+X6 NOW HAVE UNIT ENTRY + WE 1 WRITE OUT UNIT NAME RJ ECSPRTY EQ UNAMX * UUTEMP BSS 1 * * DONE--PACK UP COMMAND WORD * * -WRITEC- COMMAND EXITS HERE WITH X6 SET * CONUL4 SA1 BRVAR X1 = -GETVAR- CODE, LEFT-ADJUSTED SA2 CONV2 X2 = START OF UNIT TABLE SA3 CONV3 X3 = NUMBER OF ENTRIES IN TABLE SA4 INX INCREMENT EXTRA STORAGE POINTER SX7 X4+1 SA7 A4 LX2 XCMNDL+12 POSITION TABLE START LX3 XCMNDL POSITION NUMBER OF ENTRIES BX6 X6+X1 BX6 X6+X2 BX6 X6+X3 EQ ALTCODE --- EXIT TO STORE COMPLETED COMMAND WORD * * BRVAR BSS 1 CONV2 BSS 1 START OF TABLE OF CONDITIONAL UNITS CONV3 BSS 1 COUNT OF UNITS IN TABLE CONV4 BSS 1 SHIFT FOR NEXT UNIT PACK * * /--- BLOCK SLIDE 00 000 79/08/06 01.09 TITLE -SLIDE- AND -ALTFONT- * * -SLIDE- COMMAND * * SLIDEC SB1 FSSLIDE -SLIDE- PUBLISH ERROR RJ =XPUBERRS CALL COMPSYM,SLDCON,1 EQ CALCODE * SLDCON VFD 42/7LNOSLIDE,18/1400B * * * * -ALTFONT- COMMAND * * AFONTC CALL COMPSYM,ALTNMS,4 EQ CALCODE * ALTNMS VFD 42/6LNORMAL,18/0 + VFD 42/3LALT,18/1 ONOFF VFD 42/2LON,18/1 + VFD 42/3LOFF,18/0 UPDATE VFD 42/6LUPDATE,18/2 * * * * -CHECKPT- COMMAND * * CKPTC CALL COMPSYM,ONOFF,2 EQ CALCODE * * * -WRITENS- COMMAND * WRTNSIN CALL SYSTEST CALL COMPSYM,ONOFF,3 EQ CALCODE * * * /--- BLOCK CALCCIN 00 000 79/12/15 01.18 * * -CALCC- (CODE=34) * * CALCCIN RJ VARDO1 GET FIRST VARIABLE X COVL3,13 EXECUTE OVERLAY * /--- BLOCK FINIS 00 000 81/07/20 21.38 TITLE FINIS * * FINIS (CODE=50) * * END OF LESSON PROCESSING * * FINISC X JOINOV,6 * RETURNS TO EXECUTE CONDFIN * * * SET TERM, DEFINE AND COMMON ENTRIES IN THE ULOC * TABLE AND WRITE THE EXTERNAL, UNAM AND ULOC TABLES * TO THE END OF THE LESSON BINARY. ALSO SETS * *CONDPRM* UP WITH THE CONDENSE PARAMETERS AND * SEARCHES FOR UNDEFINED UNITS * ENTRY CONDFIN CONDFIN EXEC CFINOV (IN COVLAY1) ENTRY MTINIT MTINIT BSS 0 SA1 CMPF SEE IF CMP LESSON ZR X1,MTINIT1 IF NOT CMP DONT NOTIFY * NOTIFY EXECUTOR WE ARE CONDENSING A CMP LESSON SX6 P.CMP PLATO REQUEST CODE FOR CMP SA1 APLACOM (X1) = PLATO COMUNICATION AREA SX0 PLREQF IX0 X0+X1 WX6 X0 WRITE REQUEST MTINIT1 EXEC JOINOV,7 FINISH UP, JUMP TO MTLOAD * /--- BLOCK CHAR 00 000 78/07/18 21.51 TITLE CHAR, END, AND MODE * -CHAR- (CODE=47) * * THE TAG SPECIFIES THE CHARACTER NUMBER (0-127) AND THE * 8 DATA WORDS OF 16 BITS EACH COMPOSING THE CHARACTER. * CHARIN RJ VARDOC CONTINUED COMMA SEPARATED VARIABLES SX1 9 9 VARIABLES REQUIRED EQ VARFIN PACK UP VARIABLES AND STORE * * * * -END- COMMAND (CODE=49) * ENDIN SA1 TAG X1 = 1ST CHAR OF TAG MX6 0 0 FOR SIMPLE END ZR X1,PUTCODE JUMP IF NO ARGUMENT (SIMPLE END COMMAND) * CALL NXTNAME GET TAG ***** BX1 X6 GET TAG INTO X1 MX6 0 SA2 =4LHELP BX2 X2-X1 CHECK FOR -HELP- ZR X2,PUTCODE SAME AS BLANK TAG SA2 =6LLESSON BX2 X2-X1 CHECK FOR -LESSON- NZ X2,ERRNAME JUMP IF NOT LEGAL TAG MX6 1 SET SIGN BIT IF END LESSON EQ PUTCODE * * * -MODE- (CODES=51 AND 52) * * THE LEGAL TAGS ARE THE WORDS -WRITE-, * -REWRITE-, -ERASE-, AND -X-. * * * MODEIN SX7 0 * SA7 JDORMD SET FOR -MODE- COMMAND * EQ JUDGEST --- USE ROUTINE SHARED WITH -JUDGE- COMMAN TITLE -BACKGND- -FOREGND- * * * * -BACKGND- -FOREGND- * SPECIFY BACKGROUND OR FOREGROUND PROCESSING MODE * * FORGNDI MX6 0 CLEAR BACKGROUND BIT EQ BCKG10 * BCKGNDI MX6 1 SET BACKGROUND BIT * BCKG10 SX7 BACKG= SET COMMAND CODE SA7 COMNUM EQ PUTCODE * * * /--- BLOCK SEED/HASH 00 000 86/05/27 13.54 * * -SEED- COMMAND READ-IN * SPECIFIES VARIABLE TO BE USED AS SEED FOR * RANDOM NUMBER GENERATOR; BLANK TAG FOR STANDARD * SYSTEM SEED WORD. * SEEDC SA1 TAGCNT ZR X1,PAUSE2 SET SIGN BIT IF NO TAG EQ ONESTOR ELSE ONE STOREABLE ARG * * * -HASH- COMMAND READ-IN * FORMAT IS'; HASH INPUT<,OUTPUT,PRIME> * IF *OUTPUT* IS OMITED, *INPUT* MUST BE STOREABLE. * *OUTPUT* MUST BE STOREABLE IF SPECIFIED. * *PRIME* IS EITHER KEYWORD OR SYMBOL. * HASHIN RJ VARDO1 INIT AND GET FIRST TAG SA1 LASTKEY CHECK FOR MORE TAGS NZ X1,HASH2 -- IF MORE TAGS NG X6,ERRSTOR -- IF ONLY TAG, MUST BE STORABL EQ MRKLAST -- ELSE OK, EXIT HASH2 BSS 0 RJ VARDO2 GET SECOND TAG NG X6,ERRSTOR -- MUST BE STOREABLE SA1 LASTKEY CHECK FOR OPTIONAL TAG ZR X1,MRKLAST -- 2-TAG FORMAT, EXIT SA1 SYSFLG CHECK FOR SYSTEM LESSON LX1 ZSLDSHF PL X1,HASH3 -- NOT A SYSTEM LESSON RJ NXTNAMP GET THE NEXT TOKEN SA2 HASHKEY LITERAL STRING *PASSWORD* MX1 48 MASK TO 8 CHARACTERS BX2 X2-X6 COMPARE BX2 X1*X2 NZ X2,HASH3 -- NOT *PASSWORD* KEYWORD SA1 VARBUF+2 RETRIEVE SECOND VAR CODE MX6 1 SET 2ND OF TOP TWO BITS TO LX6 XCODEL-1 INDICATE *PASSWORD* KEYWORD BX6 X1+X6 SA6 A1 REWRITE WORD IN VARBUF EQ MRKLAST -- EXIT HASH3 BSS 0 RJ VARDO2 GET THIRD TAG SA1 LASTKEY NZ X1,ERR2MNY -- TOO MANY ARGUMENTS EQ MRKLAST -- EXIT * HASHKEY DATA 8LPASSWORD KEYWORD FOR SIGNON PASSWORDS * * * /--- BLOCK SHOWA,O,H 00 000 78/09/02 00.28 TITLE SHOWA, SHOWO, AND SHOWH CONDENSE * EXT ARAYFLG * * SHOWAIN SB1 FSSHOWA -SHOWA- TEXT RJ =XPUBTEXT SX7 10 SET DEFAULT RJ SHOWAGO EQ PUTCODE * SHOWOC SX7 21 DEFAULT=21 RJ SHOWAGO MX0 1 BX6 -X0*X6 CLEAR LITERAL FLAG FOR SHOWO EQ PUTCODE * SHOWHC SX7 16 DEFAULT=16 RJ SHOWAGO MX0 1 BX6 -X0*X6 CLEAR LITERAL FLAG FOR SHOWH EQ PUTCODE * SHOWAGO EQ * ENTRY/EXIT LINE SX6 1 SA6 ARAYFLG ALLOW -SHOW ARRAY- SA7 OPTAO SAVE DEFAULT RJ VARDO SB1 -1 SA1 VARBUF SA2 A1-B1 VARBUF+1 BX3 X2 CHECK FOR LITERALS MX0 61-XCODEL+XFBIT MASK OUT I/F BIT BX2 -X0*X2 LX2 60-XCODEL SHIFT INTO PLACE MX0 1 BX0 X0*X3 PRESERVE STOREABLILITY FLAG BX2 X0+X2 FLAG BY SETTING SIGN BIT SX1 X1+B1 NUMBER OF ARGS -1 SA3 OPTAO ZR X1,SHOWA2 SX1 X1+B1 NZ X1,ERR2MNY MUST BE ONE OR TWO ARGS SA3 A2-B1 VARBUF+2 MX0 60-XCODEL BX3 -X0*X3 SHOWA2 LX3 60-2*XCODEL BX6 X2+X3 EQ SHOWAGO OPTAO EQU VARBUF+3 NO MORE THAN TWO ARGUMENTS * /--- BLOCK GROUP TEMP 00 000 83/06/13 11.03 TITLE TEMPORARY KLUDGE FORM OF -GROUP- * GROUPIN SB1 FSGROUP -GROUP- PUBLISH WARNING RJ =XPUBWARN RJ NXTNAMP GET FIRST WORD IN TAG SA1 INDENT INDENT COUNT FOR THIS LINE SA2 PISTACK POINTER TO TOP OF INDENT STACK IX2 X2-X1 COMPARE INDENT AND STACK LEVELS ZR X2,ONESTOR CONDENSE AS -COURSE- COMMAND CALL CHKIND OUTPUT ERROR MESSAGES AND FIX THE STACK UP EQ ONESTOR CONTINUE CONDENSE * * REMOVLC SB1 FSREMOV -REMOVL- PUBLISH ERROR RJ =XPUBERRS EQ ONEARG * NAMEC SB1 FSNAME -NAME- PUBLISH WARNING RJ =XPUBWARN EQ ONESTOR * PLAYC SB1 FSPLAY -PLAY- PUBLISH ERROR RJ =XPUBERRS EQ TRIARG * RECRDIN SB1 FSRECOR -RECORD- PUBLISH ERROR RJ =XPUBERRS EQ TRIARG * CODOUTC SB1 FSCODEO -CODEOUT- PUBLISH ERROR RJ =XPUBERRS EQ ONEARG * AUDIOC SB1 FSAUDIO -AUDIO- PUBLISH ERROR RJ =XPUBERRS EQ ONEARG * EXTC SB1 FSEXT -EXT- PUBLISH ERROR RJ =XPUBERRS EQ ONE2IN * TEXTIN SB1 FSTEXT -TEXT- TEXT RJ =XPUBTEXT * * PROCESS VARIABLE (2 OR 3) TAGS * + RJ VARDO SA1 VARBUF+1 CHECK FIRST ARG NG X1,ERRSTOR MUST BE STOREABLE LOCATION SA1 VARBUF GET NUMBER OF ARGS SX2 X1-2 2 ARGS IS OK ZR X2,MRKLAST SX2 X1-3 3 ARGS IS OK ZR X2,MRKLAST EQ ERRTAGS WRONG NUMBER OF TAGS * * /--- BLOCK ANSV 00 000 79/01/05 02.19 TITLE -ANSV- COMMAND READ-IN * * * * -ANSV- COMMAND READ-IN * * FORMAT OF COMMAND WORD - * TOP *XCODEL* BITS = -GETVAR- CODE FOR ANSWER * NEXT *XCODEL* BITS = -GETVAR- CODE FOR TOLERANCE * NEXT 1 BIT = 0/1 FOR ABS/PERCENT TOLERANCE * NEXT XX BITS = UNUSED BY -ANSV- * (FOR -ANSU-, THESE BITS ARE A POINTER+1 TO * THE DIMENSION ARRAY. POINTER HAS 1 ADDED TO * IT TO INSURE IT BE NZ, TO DISTINGUISH ANSU.) * LAST *XCMNDL* BITS = COMMAND CODE NUMBER * * EXT COMPILU COMPILE UNIT DIMENSIONS WRGUIN SX6 WRONGV= WRONGU SAME COMND NUM AS WRONGV EQ ANSVIN0 * ANSUIN SX6 ANSV= ANSU SAME COMMAND NUM AS ANSV EQ ANSVIN0 * ANSVIN MX6 0 ANSVIN0 SA6 OVARG2 NZ FOR -ANSU-/-WRONGU- X COVL3,4 * /--- BLOCK PUTV 00 000 81/07/08 03.30 TITLE PUTV * -PUTV- (CODE=210) * * 1ST TAG ENTRY = STARTING VARIABLE FOR CHAR * STRING TO SEARCH FOR, 2ND TAG ENTRY = NUMBER * OF CHARS, 3RD TAG ENTRY = STARTING VARIABLE * FOR REPLACEMENT CHAR STRING, 4TH TAG ENTRY = * NUMBER OF CHARS IN IT. * FIRST AND THIRD TAGS MUST BE VARIABLES * PUTVC RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 NG X1,ERRSTOR IF FIRST TAG NOT A VARIABLE SA1 VARBUF+3 NG X1,ERRSTOR IF THIRD TAG NOT A VARIABLE SX1 4 MUST BE 4 VARIABLES EQ VARFIN * * SSTARIN SX6 FINIS= SA6 COMNUM SET TO *FINIS* COMMAND NUMBER SA1 HOLFIN BX6 X1 SA6 COMMAND EQ FINISC TREAT LIKE *FINIS* * * * /--- BLOCK OK 00 000 79/12/15 01.18 TITLE OK,NO,IGNORE,STORAGE,GETCHAR * -OK- (CODE=127) * OKIN SX6 1 SET TO -OK- CODE * OKINN SX1 OK= NUMBER OF -OK- COMMAND LX6 XCMNDL UP OVER COMMAND CODE BX6 X1+X6 COMBINE COMMAND CODE WITH SPECIFIER SA1 TAG ZR X1,ALTCODE JUMP IF BLANK TAG EQ ERR2MNY ELSE ERROR * * THE -NO- AND -IGNORE- COMMANDS USE THE SAME * COMMAND CODE NUMBER AS THE -OK- COMMAND. * NOIN SX6 2 SET TO -NO- CODE EQ OKINN * IGIN SX6 3 SET TO -IGNORE- CODE EQ OKINN * -REGSTATE- COMMAND. RGIN RJ SYSTEST CHECK IF SYSTEM LESSON SX6 4 SET TO -REGSTATE- CODE EQ OKINN * * * -GETCHAR- COMMAND * GETCHRC CALL SYSTEST SYSTEM LESSONS ONLY CALL FILEBLK GET ACCOUNT, FILE, BLOCK CALL VARDOR GET LAST ARGUMENT SA1 VARBUF+4 NG X1,ERRSTOR 4TH ARGUMENT MUST BE STOREABLE SX1 4 4 ARGUMENTS LEGAL EQ VARFIN * /--- BLOCK CSETIN 00 000 80/02/02 01.18 TITLE CHARSET LINESET MICRO * * * * ROUTINE FOR COMMANDS WITH TAGS THAT SPECIFY * A LESSON AND BLOCK NAME ONLY, AND ALSO ALLOW * BLANK TAGS. * * USED BY CHARSET, LINESET, MICRO * * CSETIN BSS 0 CALL FILEBLK GET LESSON AND BLOCK NAME ZR X1,PAUSE2 IF BLANK TAG SA2 LASTKEY ZR X2,VARFIN IF END OF LINE EQ ERR2MNY ERROR IF MORE THAN 2 ARGUMENTS * * * * ROUTINE FOR COMMANDS WITH TAGS THAT SPECIFY * A LESSON AND BLOCK NAME ONLY. BLANK TAGS * ARE NOT ALLOWED. * * USED BY CHARTST * * CHARTST CALL FILEBLK GET LESSON AND BLOCK NAME ZR X1,ERR2FEW ERROR IF BLANK TAG SA2 LASTKEY ZR X2,VARFIN IF END OF LINE EQ ERR2MNY ERROR IF MORE THAN 2 ARGUMENTS * * /--- BLOCK CSETIN 00 000 80/02/02 01.18 * * * -LESLIST- AND -SYSLIST- COMMANDS * * FIRST TWO ARGUMENTS SPECIFY LESSON AND BLOCK NAME * OPTIONAL THIRD ARGUMENT SPECIFIES CODEWORD * SLISTIN CALL SYSTEST -SYSLIST- COMMAND * LLISTIN BSS 0 LESLIST, SYSLIST CALL FILEBLK GET LESSON AND BLOCK NAME ZR X1,PAUSE2 IF BLANK TAG SA2 LASTKEY ZR X2,MRKLAST IF ONLY 2 ARGUMENTS CALL VARDO2 GET CODEWORD ARGUMENT SA2 LASTKEY ZR X2,MRKLAST EQ ERR2MNY ERROR IF MORE THAN 3 ARGUMENTS * * -USE- *** WARNING *** THIS IS ONLY * FOR DISCARDING BAD -USE- COMMANDS * * THE ACTUAL PROCESSING FOR -USE- IS DONE IN * GETLINE,USEC * USEEC EQ NXTLINE IGNORE BAD -USE- COMMAND * * * /--- BLOCK PPT 00 000 79/12/15 01.18 * THE CONDENSE ROUTINES FOR OTHER *PPT* TYPE COM- * MANDS ARE IN OVERLAY *PPTC*. * -MODESET- AND -BITSOUT- MDBITIN RJ PPTMESS EQ ONEARG * -PPTOUT- PPTOUTC RJ PPTMESS X COV4A,7 EXECUTE OVERLAY * -PPTADDR- PPTADDC RJ PPTMESS EQ ONE2IN0 * -PPTRUN- PPTRUNC RJ PPTMESS EQ ONE2IN0 ** PPTMESS - ISSUE *PPT* ERROR MESSAGE. * * THE FIRST CHECK FOR ACCESS TO *PPT* COMMANDS IS * IN THE INITIALIZATION ROUTINES IN *COVLAY2*. THE * *PPTACC* FLAG IS SET AT THAT TIME. * * IF ACCESS IS ALLOWED, A WARNING MESSAGE IS ISSUED * AT THE FIRST OCCURANCE OF A PROGRAMMABLE TERMINAL * COMMAND, UNLESS THE LESSON HAS THE *SYS* OR *PPT* * ATTRIBUTE MARKED IN DECK *SYSLESS*. * * ENTRY (PPTACC) = -1 IF LESSON CAN USE PPT COMDS; * = 0 OTHERWISE. * (PPTMF) = 0 IF PPT WARNING MESSAGE HAS NOT * BEEN ISSUED YET; * = -1 OTHERWISE. * (SYSFLG) = WORD WITH *PPT* ATTRIBUTE BIT. * * ERROR TO *ERRORC* IF (PPTACC) = 0. * * CALLS RJERR. ENTRY PPTMESS PPTMESS PS SA1 PPTACC CHECK PPT ACCESS FLAG PL X1,ERRORC IF NOT ALLOWED SA1 PPTMF NZ X1,PPTMESS IF PPT MESSAGE ALREADY ISSUED MX6 -1 SA6 A1 * NOTE - LESSONS WITH THE *SYS* ATTRIBUTE ALWAYS * HAVE THE *PPT* ATTRIBUTE, SO ONLY THE *PPT* BIT * NEEDS TO BE CHECKED. SA1 SYSFLG LX1 ZPPTSHF SHIFT *PPT* BIT INTO POSITION NG X1,PPTMESS IF LESSON HAS *PPT* ATTRIBUTE SB1 767 RJ =XRJERR ISSUE THE PPT WARNING MESSAGE EQ PPTMESS ENTRY PPTACC,PPTMF PPTACC BSS 1 *PPT* COMMAND ACCESS FLAG PPTMF BSS 1 *PPT* WARNING MESSAGE FLAG * /--- BLOCK OVERLAYS 00 000 79/12/15 01.18 TITLE CONDENSOR OVERLAY CALLS * * -SAY- * SAYIN SB1 FSSAY -SAY- PUBLISH ERROR RJ =XPUBERRS .SAYCMD IFNE SAYASSM,0 SA1 SAYFLAG SX6 2 TO SET OVARG1 IN PCIN100 SAYIN1 SA3 SAYFLAG COLLECT OLD VALUE FROM SAYFLAG SX7 1 PUT A 1 IN X7 BX3 X3+X7 LOGICAL SUM SAYFLAG W/ BIT0 SET SX7 X3 ONLY 6,7 CAN WRITE CM SA7 A1 NEW VALUE OUT TO SAYFLAG SA6 OVARG1 X PACKOV USE -PACK- SUBCONDENSOR EQ ERRORC .SAYCMD ELSE SAYIN1 EQ =XNXTLINE IGNORE THIS COMMAND .SAYCMD ENDIF * SAYCIN SB1 FSSAY -SAY- PUBLISH ERROR RJ =XPUBERRS .SAYCMD IFNE SAYASSM,0 SA1 SAYFLAG SX6 3 TO SET OVARG1 IN PCIN100 .SAYCMD ENDIF EQ SAYIN1 * * -SAYLANG- * .SAYCMD IFNE SAYASSM,0 SAYLGIN SX6 1 SAYLANG SA1 SAYFLAG COLLECT CURRENT VALUE IN X1 SX7 2 MARK PRESENCE BX7 X1+X7 MERGE LOGICALLY SA7 A1 SHIP BACK OUT INTO SAYFLAG SA1 TAG SEE IF BLANK TAG NZ X1,TAGOVIN MX6 0 BLANK SAYLANG EQ PUTCODE * TAGOVIN SA6 OVARG1 X TAGOV .SAYCMD ELSE SAYLGIN EQ SAYIN1 .SAYCMD ENDIF * /--- BLOCK NXTNAM 00 000 80/12/26 14.34 TITLE -NXTNAM- * * -NXTNAM- * * ON EXIT, * X6 = NEXT TAG ENTRY (ZERO-FILLED) * X1 = SEPARATOR CHARACTER * X2 = SEPARATOR TYPE CODE (SEE LEX) * * WORDPT WILL POINT TO NEXT CHARACTER AFTER TAG * * ERROR CONDITIONS'; * MORE THAN 10 CHARACTERS--X1 IS SET TO * 11TH CHAR, X2 IS SET TO KEYTYPE OR * ELSE IS SET TO 0 (BLANK AND BACKSPACE). * ENTRY NXTNAM * NXTNAM EQ * CALL NXTNAMP GET NEXT TAG W/O WORDPT UPDATE SX7 B1 B1 HAS UPDATED WORDPT ADDRESS SA7 WORDPT UPDATE WORDPT EQ NXTNAM --- EXIT * * * -NXTNAMP- * * OBTAINS THE NEXT TAG (OR 10 CHARACTERS, WHICHEVER * COMES FIRST) WITHOUT UPDATING THE CURRENT LINE * POINTER, WORDPT. * * ON EXIT, * B1 = POINTER TO NEXT CHARACTER AFTER TAG * X6 = NEXT TAG ENTRY (ZERO-FILLED) * X1 = SEPARATOR CHARACTER * X2 = SEPARATOR TYPE CODE (SEE LEX) * B7 = POINTER TO FIRST CHAR OF NEXT TAG (IF THERE) * * ERROR CONDITIONS'; * MORE THAN 10 CHARACTERS--X1 IS SET TO * 11TH CHAR, X2 IS SET TO KEYTYPE OR * ELSE IS SET TO 0 (BLANK AND BACKSPACE). * ENTRY NXTNAMP * NXTNAMP EQ * SA1 WORDPT POINTER TO NEXT CHAR MX6 0 SB1 X1 SB2 60 INITIALIZE SHIFT SB7 1 CONSTANT * SKPSP SA1 B1 SKIP LEADING SPACES SX2 X1-1R CODE FOR SPACE NZ X2,NNLOOP JUMP IF NOT A SPACE SB1 B1+1 EQ SKPSP * NNLOOP SA1 B1 LOAD NEXT CHARACTER SB1 B1+B7 SX2 X1-1R ALLOW EMBEDDED SPACES ZR X2,NLL2 SX2 X1-KBKSP ZR X2,NLL2 SA2 X1+KEYTYPE GET CHARACTER TYPE SX3 X2-1 PL X3,NNDONE JUMP IF SEPARATOR * /--- BLOCK NXTNAM 00 000 80/12/26 14.34 * NLL2 SB2 B2-6 NG B2,NBADN EXIT IF NAME TOO BIG LX1 X1,B2 POSITION CHAR BX6 X6+X1 ADD TO WORD BUILDING EQ NNLOOP * NNDONE SB7 B1 FOR ROUTINES WHICH NEED EOL NZ X1,NXTNAMP --- EXIT IF NOT END-OF-LINE SB1 B1-1 BACKUP BEFORE END-OF-LINE EQ NXTNAMP --- EXIT * NBADN MX6 0 RETURN A 0 NAME EQ NNDONE * * * -NXTNAME- * GETS NEXT NAME IN X6, SEPARATOR CODE/TYPE IN X1,X2 * REMOVES EXTRA SPACES FROM END OF NXTNAM * ENTRY NXTNAME NXTNAME EQ * RJ NXTNAM SEE ABOVE LT B2,B0,NXTNAME EXIT IF TOO LONG NXTNAM2 MX7 -6 MASK FOR 1 CHAR LX7 X7,B2 SHIFT TO LAST CHAR POSITION SX3 1R SPACE LX3 X3,B2 ALSO SHIFT BX0 -X7*X6 EXTRACT CHAR IX3 X3-X0 TEST FOR SPACE NZ X3,NXTNAME EXIT IF NOT BX6 X7*X6 CLEAR OUT SPACE SB2 B2+6 SHIFT FOR PREVIOUS CHAR EQ NXTNAM2 TRY AGAIN * /--- BLOCK FILEACC 00 000 80/12/26 10.44 TITLE -ACCFILE- GET ACCOUNT AND FILE NAMES * * -ACCFILE- * * ROUTINE TO GET ACCOUNT AND FILE ARGUMENTS. * ENTER'; B1 = ADDRESS OF TWO-WORD BUFFER WHERE * GETVAR CODES WILL BE STORED * B2 INDICATES HOW TAGS SHOULD BE INTERPRETED * = -1 IF ONLY LITERALS ALLOWED (FOR CONDENSE-TIME COMMANDS) * 0 IF NAMES INTERPRETED AS LITERALS * 1 IF NORMAL TUTOR EXPRESSIONS * * RETURN INFORMATION CONSISTS OF EITHER GETVAR CODES * (IF B2 = 0 OR 1) OR ACTUAL NAMES (IF B2 = -1). ACCOUNT * IS STORED IN THE FIRST WORD OF THE RETURN BUFFER, FILE * IN THE SECOND WORD. ZEROES ARE RETURNED FOR BLANK * ARGUMENTS. * * EXIT'; X1 = NUMBER OF EXPLICIT ARGUMENTS FOUND * 0 IF BLANK TAG * 1 IF FILE NAME ONLY * 2 IF ACCOUNT';FILE OR LESLIST REFERENCE * * WARNING -- THE -RECORDS- AND -ATTACHF- COMMANDS * HAVE THEIR OWN ROUTINES FOR CONDENSING FILE NAMES. * * /--- BLOCK FILEACC 00 000 80/12/26 10.45 * ENTRY ACCFILE ACCFILE EQ * SX6 B1 SA6 ACFOUT SAVE ADDRESS OF RETURN BUFFER SX6 B2 SA6 ACFLIT SAVE LITERALS FLAG * * SKIP LEADING SPACES * SB1 1 SET UP INCREMENT FOR LOOPS SA1 WORDPT X1 = ADDRESS OF NEXT CHARACTER SX6 X1-1 ACF10 SX6 X6+B1 POINT TO NEXT CHARACTER SA2 X6 (X2) = NEXT CHARACTER SX0 X2-1R CHECK FOR BLANK ZR X0,ACF10 LOOP TO SKIP LEADING SPACES * ZR X2,ACF45 JUMP IF END OF LINE SA3 X2+KEYTYPE SX0 X3-OPCOMMA CHECK FOR SEPARATOR ZR X0,ACF40 JUMP IF SEPARATOR * LOG EXTERNAL REFERENCE FOR -CONDENS- COMMAND SA6 WORDPT SAVE CHARACTER POINTER SB2 TAG POINTER TO START OF LINE SB1 X6 SB1 B1-B2 (B1) = RELATIVE CHAR POSITION SB2 CEXTS CODE FOR EXTERNAL REFERENCE CALL PLOGLIN LOG THIS LINE SA3 ACFLIT RETRIEVE LITERALS FLAG NG X3,ACF20 SKIP LESLIST CHECK IF LITERALS ONLY SA1 WORDPT RETRIEVE POINTER SA2 X1+ (X2) = CURRENT CHARACTER SX0 X2-KLT CHECK FOR LESLIST BRACKET ZR X0,ACFLL JUMP IF LESLIST REFERENCE * * CHECK FOR COLON (INDICATES ACCOUNT ARG IS PRESENT) * ACF20 CALL COLONCK NZ X6,ACF30 IF ACCOUNT NOT SPECIFIED * *////// TEMPORARY -- ACCOUNT NAME LEGAL ONLY IN SYSTEM LESSONS SA1 SYSFLG LX1 ZSLDSHF PL X1,ERRNAME ERROR IF NOT SYSTEM LESSON *////// END TEMPORARY RJ ACFNAM COMPILE ACCOUNT NAME RJ ACCFILC CONVERT SPECIAL ACCOUNT NAMES SA1 ACFOUT X1 = ADDRESS OF RETURN BUFFER SA6 X1 STORE ACCOUNT GETVAR CODE * RJ ACFNAM COMPILE FILE NAME SA1 ACFOUT ADDRESS OF RETURN BUFFER SA6 X1+1 STORE FILE IN SECOND WORD * SX1 2 2 ARGUMENTS FOUND EQ ACCFILE * /--- BLOCK FILEACC 00 000 80/12/26 10.46 * * ACCOUNT NAME BLANK * ACF30 RJ ACFNAM GET FILE NAME SA1 ACFOUT ADDRESS OF RETURN BUFFER SA6 X1+1 STORE IN SECOND WORD MX6 0 SET ACCOUNT NAME TO ZERO RJ ACCFILC CONVERT ACCOUNT NAME SA6 X1 * SX1 1 1 ARGUMENT FOUND EQ ACCFILE * * ACCOUNT AND FILE BOTH BLANK * ACF40 SX6 X6+1 ADVANCE PAST SEPARATOR SA6 WORDPT ACF45 BX6 X2 GET LAST CHARACTER EXAMINED SA6 LASTKEY UPDATE *LASTKEY* SA1 ACFOUT ADDRESS OF RETURN BUFFER MX6 0 SA6 X1 STORE TWO ZERO CODES SA6 X1+1 SX1 0 NO ARGUMENTS EQ ACCFILE * * LESLIST REFERENCE -- STORE LESLIST INDEX AS FIRST GETVAR * CODE AND SPECIAL LESLIST INDICATOR AS SECOND GETVAR CODE * ACFLL SX1 X1+1 ADVANCE PAST LEFT BRACKET BX6 X1 SA6 WORDPT SX0 KGT SCAN FOR RIGHT BRACKET CALL PSCAN SX0 X1-KGT NZ X0,ERRTERM ERROR IF NO RIGHT BRACKET SX6 1R SA6 B1 BLANK OUT RIGHT BRACKET CALL COMPILE COMPILE LESLIST INDEX BX6 X1 SA1 ACFOUT ADDRESS OF RETURN BUFFER SA6 X1 STORE GETVAR CODE FOR INDEX SA1 ACFLLC X1 = SPECIAL LESLIST INDICATOR BX6 X1 SA6 A6+1 * SX1 2 PRETEND 2 ARGUMENTS FOUND EQ ACCFILE * * ACFLLC VFD 60/LLCODE SPECIAL GETVAR CODE FOR LESLISTS ACFOUT BSS 1 SAVED ADDRESS OF RETURN BUFFER ACFLIT BSS 1 LITERALS FLAG * * /--- BLOCK FILEACC 00 000 80/12/26 10.47 * * * ROUTINE CALLED BY -ACCFILE- TO COMPILE A NAME * CALLS NXTNAM, COMPNAM, OR COMPILE BASED ON THE * VALUE OF THE LITERALS FLAG. NAME OR GETVAR CODE * IS RETURNED IN X6. * ACFNAM EQ * SA1 ACFLIT RETRIEVE LITERALS FLAG NG X1,ACFNAM1 JUMP IF LITERALS ONLY ZR X1,ACFNAM2 JUMP IF LITERAL OR EXPRESSION * CALL COMPILE NORMAL EXPRESSION BX6 X1 EQ ACFNAM * ACFNAM1 CALL NXTNAM LITERALS ONLY (RETURN NAME) EQ ACFNAM * ACFNAM2 SX6 0 ZERO FILL NAME SA6 IFILL CALL COMPNAM LITERAL OR EXPRESSION BX6 X1 EQ ACFNAM * * /--- BLOCK FILEACC 00 000 80/12/26 10.47 * * * -ACCFILC- * * CONVERTS SPECIAL ACCOUNT NAMES TO A USEABLE FORM. * KEYWORD *'LESSON* IS CONVERTED TO THE ACCOUNT OF THE * CURRENT LESSON. KEYWORD *'OLD* IS CONVERTED TO A * NULL ACCOUNT NAME WITH THE ORIGINAL FILE FLAG SET. * ACCOUNT NAMES LONGER THAN 7 CHARACTERS ARE CONVERTED * TO ZERO. * * CONVERSIONS ARE DONE ONLY IF *ACCFILE* IS CALLED * IN LITERALS-ONLY MODE. * * ENTER'; X6 = ACCOUNT SPECIFIED BY USER * EXIT'; X6 = CONVERTED ACCOUNT NAME * * A SIMILAR ROUTINE BY THE SAME NAME EXISTS IN EXEC1. * ACCFILC EQ * SA2 ACFLIT GET LITERALS FLAG PL X2,ACCFILC EXIT IF GENERATING GETVAR CODES * ZR X6,ACFOLD FOR NOW, ZERO MEANS OLD-STYLE SA2 AKOLD KEYWORD OLD IX2 X6-X2 ZR X2,ACFOLD * SA2 AKLESS KEYWORD LESSON IX2 X6-X2 ZR X2,ACFLES * MX2 -18 BX2 -X2*X6 LOOK AT LOWER 18 BITS ZR X2,ACCFILC OKAY IF LOW 18 BITS ZERO SX6 0 DO NOT ALLOW MORE THAN 7 CHARS EQ ACCFILC * ACFOLD MX6 1 LX6 18 SET ORIGINAL FILE FLAG EQ ACCFILC * ACFLES SA1 ACCOUNT ACCOUNT OF CURRENT LESSON BX6 X1 EQ ACCFILC * * AKOLD DATA 0L'OLD FOR OLD-STYLE FILE REFERENCES AKLESS DATA 0L'LESSON FOR ACCOUNT OF CURRENT LESSON * * /--- BLOCK FILEACC 00 000 80/12/26 10.48 * * * -ACCFILF- * * ROUTINE TO GET ACCOUNT AND FILE NAMES FROM FIRST * TWO ARGUMENTS OF A COMMAND. INITIALIZES *VARBUF* * AND STORES GETVAR CODES IN FIRST TWO WORDS. * ENTRY ACCFILF ACCFILF EQ * SX6 2 2 ARGUMENTS SA6 VARBUF CALL ACCFILE,VARBUF+1,0 EQ ACCFILF * * * -FILEBLK- * * ROUTINE TO GET ACCOUNT, FILE, AND BLOCK NAMES * FROM FIRST 3 ARGUMENTS OF A COMMAND. INITIALIZES * *VARBUF* AND STORES GETVAR CODES IN FIRST THREE * WORDS. * * EXIT'; X1 = NUMBER OF ARGUMENTS * 0 IF BLANK TAG * 3 IF NON-BLANK * ENTRY FILEBLK FILEBLK EQ * CALL ACCFILE,VARBUF+1,0 SA2 LASTKEY CHECK FOR END OF LINE ZR X2,FBEOL JUMP IF SO * CALL COMPNAM COMPILE BLOCK NAME * FILEB1 BX6 X1 SA6 VARBUF+3 STORE GETVAR CODE SX1 3 INDICATE 3 ARGUMENTS BX6 X1 SA6 VARBUF EQ FILEBLK * FBEOL ZR X1,FILEBLK EXIT IF BLANK TAG (X1 SET BY ACCFILE) SX1 X1-2 SEE IF 2 ARGUMENTS FOUND IN ACCFILE ZR X1,ERR2FEW ERROR IF SO * * IF ONLY ONE ARGUMENT IT MUST BE BLOCK NAME * SA1 VARBUF+2 GET FILE CODE RETURNED BY ACCFILE MX6 0 SA6 A1 ZERO FILE NAME ARGUMENT EQ FILEB1 * * /--- BLOCK TERM 00 000 76/07/17 06.20 TITLE TERM * TERM (NOT AN EXECUTABLE COMMAND--BUILDS TABLE) * * TERM KEEPS TABLE BACKWARDS IN ECS (TERMBUF) * NOWTERM BSS 1 TERMFLG BSS 1 TOP BIT = 1 IF TERMOP * * TERMOPC MX6 1 TOP BIT FLAG FOR TERMOP EQ TERMC1 * TERMC MX6 0 CLEAR TOP BIT FLAG FOR TERM * TERMC1 SA6 TERMFLG SB1 FSTERM -TERM- IS PUBLISH ERROR RJ =XPUBERRS * SA1 TAGCNT X1 = TAG LENGTH SB1 X1-9 PL B1,ERRNAME --- ERROR IF MORE THAN 8 CHARS SB1 1 B1 = CONSTANT 1 SA5 TERMS PRESENT NUMBER OF TERMS TO X5 * BOUNDS CHECK TO BE MADE HERE IF DIFFERENT BUFFER USED SX7 X5+B1 SX6 X7-MAXTERM PL X6,TERMERR --- ERROR IF TOO MANY TERMS SA7 A5 STORE NEW TABLE LENGTH MX6 0 PRE-CLEAR TERM NAME ZR X1,TERMC2 CATCH-ALL TERM IF NO TAG SB2 0 * TERMLP SA1 TAG+B2 LOAD CHAR LX6 6 BX6 X6+X1 ADD ON CHAR SB2 B2+B1 NZ X1,TERMLP SB3 10 TLLP LX6 6 SB2 B2+B1 NE B2,B3,TLLP LEFT JUSTIFY TERM * * SET UP UNIT NUMBER TO BRANCH TO WHEN TERM USED. * TERMC2 SA1 UNUMON BX6 X6+X1 ADD ON UNIT NUM LX6 -12 12 UNIT BITS TO TOP SA2 TERMFLG TOP BIT FLAG FOR TERMOP BX6 X6+X2 SA6 NOWTERM PREPARE FOR SINGLE ECS WRITE SA2 TERMEND ADDRESS OF END OF BUFFER IX0 X2-X5 SA0 A6 + WE 1 WRITE OUT SINGLE TERM RJ ECSPRTY EQ NXTLINE * * TERMERR SX6 1 FLAG ERROR MESSAGE PRESENT SA6 TFORMOK SA1 =10LTOO MANY BX6 X1 SA6 CERROR1 SB1 51 TOO MANY EQ =XERR * /--- BLOCK VARDO 00 000 79/12/15 01.18 TITLE GENERAL SUBROUTINES FOR PROCESSING VARIABLES * - - - - SUBROUTINE TO HANDLE MULTIPLE VARIABLES - - - - - - - - - - - * USES STANDARD LEXICAL SEPARATORS * * VARBUF(0) RETURNED WITH NUMBER OF VARIABLES * VARBUF(N) RETURNED WITH -GETVAR- CODE FOR NTH VARIABLE * * ****NOTE**** WORDPT IS ASSUMED TO POINT TO * THE CHAR TO PROCESS FIRST. * * THE SUBROUTINE VARFIN WILL HANDLE THE PACKING UP OF THESE VARS * * 60-BIT CODE FOR EACH VAR IS CONSTRUCTED AS FOLLOWS-- * (1) TOP BIT -- SET IF EXPRESSION CANNOT BE STORED INTO * (2) LOWER 20 BITS -- CODE COMPILE RETURNS (-GETVAR- CODE) * VARDO EQ * SX6 0 SA6 VARBUF ZERO VARBUF(0) TO NO VARS PRESENT VARDOL RJ VARDO2 COMPILE NEXT VAR TO VARBUF ARRAY SA1 LASTKEY NZ X1,VARDOL CONTINUE IF NOT E-O-L EQ VARDO * * * * - - - - SUBROUTINE TO GET REMAINING VARIABLES - - - - - - - - - - - * SAME AS VARDO BUT ASSUMES THAT ONE OR MORE * ARGUMENTS HAVE ALREADY BEEN COMPILED INTO VARBUF. * VARDOR EQ * VARDOR1 SA1 LASTKEY ZR X1,VARDOR EXIT IF END OF LINE RJ VARDO2 COMPILE NEXT ARGUMENT EQ VARDOR1 * * /--- BLOCK VARDOC 00 000 79/01/18 04.20 * * * * - - - - SUBROUTINE FOR CONTINUED READ OF MULTIPLE VARIABLES - - - - - * USES STANDARD LEXICAL SEPARATORS * VARDOC EQ * SX6 0 SA6 VARBUF ZERO VARBUF(0) TO NO VARS PRESENT VARDOCL SA1 WORDPT X1 = POINTER TO NEXT CHARACTER OF TAG SA2 X1 ZR X2,VARDOCN JUMP IF AT END-OF-LINE RJ VARDO2 GET CODE FOR NEXT VARIABLE EQ VARDOCL VARDOCN SA1 NEXTCOM CHECK FOR CONTINUATION SA2 COMCONT BX3 X1-X2 NZ X3,VARDOC --- EXIT IF NOT CONTINUED RJ GETLINE READ IN NEXT LINE EQ VARDOCL * * * * - - - - SUBROUTINE TO GET FIRST VARIABLE - - - - - - - - - - - - - - - * USES STANDARD LEXICAL SEPARATORS * VARDO1 EQ * SX6 0 SA6 VARBUF ZERO VARBUF(0) TO NO VARS PRESENT RJ VARDO2 GET CODE FOR STORAGE VARIABLE EQ VARDO1 RETURN * * * * - - - - SUBROUTINE TO GET NEXT VARIABLE - - - - - - - - - - - - - - - * USES STANDARD LEXICAL SEPARATORS * ENTRY VARDO2 VARDO2 EQ * RJ COMPILE GET CODE FOR STRING IN X1 AND B1 RJ VARDO2A EQ VARDO2 * VARDO2A EQ * SA2 VARBUF X2 HOLDS CURRENT NO. OF ARGUMENTS SX7 X2+1 X7 HOLDS NEW NO. OF ARGUMENTS SX2 X7-VARBUFL SUBTRACT OFF SIZE OF VARBUF PL X2,ERR2MNY EXIT IF READINBF FULL ZR B1,VARDO2E JUMP IF VAR IS STOREABLE MX0 1 BX1 X1+X0 SET TOP BIT OF CODE IF NOT STOREABLE VARDO2E SA7 A2 STORE NEW VAR COUNT IN VARBUF(0) BX6 X1 MOVE -GETVAR- CODE TO X6 SB6 A2 MOVE ADR OF VARBUF SA6 B6+X7 STORE IN NEXT LOC OF VARBUF EQ VARDO2A * PUTDO2 EQ * RJ PUTCOMP RJ VARDO2A EQ PUTDO2 * * /--- BLOCK VARFIN 00 000 77/01/24 20.50 * * - - - - ROUTINE TO HANDLE PACKING OF VARBUF VARS - - - - - - - - - - - * * ON ENTRY, SET X1 TO THE NUMBER OF VARS LEGAL FOR THIS COMMAND * * THE COMMAND WORD IS AS FOLLOWS -- * 20 BITS -- FIRST VAR * 20 BITS -- SECOND VAR * 11 BITS -- EXTRA STORAGE POINTER * 9 BITS -- COMMAND NUMBER * * THE REMAINING VARS (IF ANY) ARE PACKED THREE PER * WORD IN EXTRA STORAGE * VARFIN SA2 VARBUF X2 HOLDS NO. OF 20 BIT PACKAGES SA4 VARBUF+1 A4 HOLDS ADR. OF FIRST 20 BIT PACKAGE RJ VARFINS EQ NXTLINE * * THE MAIN SUBROUTINE * ****NOTE**** OTHER THINGS ENTER HERE WITH X1,X2, AND A4 SET VARFINS EQ * SB2 X2 B2 HOLDS VAR COUNT BX2 X1-X2 NZ X2,ERRTAGS ERROR IF NOT CORRECT NO. OF VARS SB5 1 UNIVERSAL INCREMENT CONSTANT TO B5 MX0 60-XCODEL X0 HOLDS 40 BIT MASK BX3 -X0*X4 CLEAR TOP BITS OF FIRST VAR SA4 A4+B5 GET SECOND VAR BX4 -X0*X4 LX3 60-XCODEL POSITION FIRST VAR LX4 60-2*XCODEL POSITION SECOND VAR BX6 X3+X4 SB4 B5+B5 B4 HOLDS COUNT OF TWO SA2 INX NEXT FREE LOC OF EXTRA STORAGE LX2 XCMNDL POSITION LEFT OF COMMAND CODE BX6 X6+X2 X2 HOLDS POINTER TO NEXT EXTRA STORAGE WORD RJ CSTO STORE COMMAND WORD (USES A1,B1,X1,A6,B6,X6) VARFINT SB2 B2-3 DECREMENT VAR COUNT LT B2,VARFINS DONE IF LESS THAN THREE VARS VARFINL SA4 A4+B5 A4 STILL POINTS TO PREVIOUS VAR BX4 -X0*X4 X0 STILL HOLDS 40 BIT MASK LX6 XCODEL SHIFT PREVIOUS VAR(S) UP BX6 X0*X6 BX6 X6+X4 X6 HOLDS PACKED UP VARS SB4 B4-B5 DECREMENT BY ONE FOR END TEST PL B4,VARFINL JUMP IF THIS WORD NOT FULL YET SA2 INX GET EXTRA STORAGE POINTER SA6 INFO+X2 STORE EXTRA STORAGE WORD SB4 B5+B5 SX7 X2+B5 SA7 INX UPDATE EXTRA STORAGE POINTER EQ VARFINT * * * * - - - - ROUTINE TO PACK UP VARS WITH A CHAR COUNT - - - - - - - - - - * * INSERTS AN ADDITIONAL FIRST 20 BIT PACKAGE CONTAINING * VARBUF(0) (I.E. THE NO. OF VARS). * VARFINM SA4 VARBUF A4 HOLDS ADR OF FIRST 20 BIT PACKAGE SX2 X4+1 X2 HOLDS COUNT OF 20 BIT PACKAGES SX1 X2 ALLOW ANY NUMBER OF VARIABLES RJ VARFINS USE STANDARD VARFIN PROCESSOR EQ NXTLINE * /--- BLOCK MRKLAST 00 000 76/11/17 21.32 * * * - - - - ROUTINE TO PACK UP VARS WITH LAST ONE MARKED - - - - - - * * MARKS THE LAST 20 BIT PACKAGE BY SETTING THE TOP * BIT OF THE GETVAR CODE. ANY NUMBER OF ARGUMENTS * ARE LEGAL (NO CHECKING IS DONE). SHOULD BE USED * FOR COMMANDS WITH OPTIONAL TAGS. CHECKING FOR NUMBER * OF VALID ARGUMENTS SHOULD BE DONE IN THE READIN. * MRKLAST SA1 VARBUF SA2 VARBUF+X1 GET LAST ARGUMENT MX3 1 LX3 XCODEL TOP BIT OF GETVAR CODE BX6 X3+X2 SA6 A2 LAST ARGUMENT MARKED EQ VARFIN FINISH WITH X1 = NO. ARGS VALID * * * /--- BLOCK VARLEX 00 000 76/11/17 17.16 EJECT * - - - - SUBROUTINE TO DO NON-STANDARD LEXICAL SEARCH FOR VARS - - - - * * VARSEP AND VARONE MUST BE SET AS IN VARONE * VARONET RETURNED WITH ADDRESS OF ENDING SEP * VARONES HOLDS THE SEPARATOR FOUND (0 IF E-O-L) * VARLEX EQ * SA2 WORDPT X2 HOLDS ADR OF CHAR NOW WORKING ON SB2 1 B2 HOLDS INCREMENT OF ONE SX2 X2-1 DECREMENT CHAR POINTER INITIALLY VARONEL SX2 X2+B2 INCREMENT X2 TO NEXT CHAR SA1 X2 X1 HOLDS NEXT CHAR ZR X1,VARONEG JUMP IF E-O-L VARSEP DATA 0 ****ARGUMENT****, CHECKS IF X1 HOLDS SEP. VARONED NZ X1,VARONEL NOT A SEP., CONTINUE SEARCHING SA1 X2 SEPARATOR TO X1 VARONEG SX7 X1 SA7 VARONES SAVE ENDING SEPARATOR IN VARONES SX7 X2 MOVE ADR OF SEPARATOR SA7 VARONET SAVE ADR OF ENDING SEPARATOR IN VARONET EQ VARLEX * * * * - - - - SUBROUTINE TO COMPILE A SINGLE VAR AFTER USING -VARLEX - - - * * TO INITIALIZE -- * 1. SET VARBUF(0) TO NO. OF VARS ALREADY IN READINBF * 2. SET VARSEP TO INDICATE THE SEPARATOR(S) DESIRED * 3. SET WORDPT TO THE ADR OF THE FIRST CHAR IN STRING * * EACH CALL OF VARONE DOES THE FOLLOWING -- * 1. INCREMENTS VARBUF(0) BY ONE * 2. USES VARSEP TO DETERMINE THE END OF THE NEXT STRING * (VARSEP MUST BE A WORD OF INSTRUCTIONS WHICH SETS * X1 TO ZERO IF THE CONTENTS OF X1 IS A TERMINATOR) * (ZERO IS AN AUTOMATIC TERMINATOR) * (A1,B1,X1,A6,B6,X6 ARE THE ONLY REGISTERS WHICH * VARSEP MAY DESTROY) * 3. SENDS THAT STRING TO COMPILE FOR CODING * 4. UPDATES WORDPT TO ADDRESS OF CHAR FOLLOWING TERMINATOR * 5. STORES -GETVAR- CODE IN VARBUF(VARBUF(0)) * 6. RETURNS LASTKEY WITH TERMINATOR * VARONE EQ * SA1 VARONET ADDRESS OF ENDING CHAR SX7 1R, COMMA IS END-OF-LINE FOR COMPILE SA7 X1 RJ VARDO2 SA2 VARONET X2 HOLDS ADDRESS OF ENDING SEPARATOR SA1 VARONES X1 HOLDS ENDING SEPARATOR BX7 X1 SA7 X2 RESTORE ORIGINAL CHAR SA7 LASTKEY ALSO PUT INTO LASTKEY EQ VARONE * VARONES BSS 1 TEMP STORAGE FOR LASTKEY VARONET BSS 1 TEMP STORAGE FOR POINTER TO SEPARATOR * * * * * - - - - VARIOUS VALUES FOR VARSEP FOLLOW - - - - - - - - - - - - - - - * /--- BLOCK VARFEM 00 000 76/07/17 06.21 * SEPCMAS RJ SEPCMAS1 COMMA OR ASSIGNMENT ARROW WILL TERMINATE SEPCMAS1 EQ * SX1 X1-1R, ZR X1,SEPCMAS1 EXIT IF CHAR IS COMMA SX1 X1+1R,-KASSIGN EQ SEPCMAS1 * * * * - - - - SUBROUTINE TO STORE COMMAND WORD - - - - - - - - - - - - - - - * * WILL ONLY DESTROY (A1,B1,X1,A6,B6,X6) * * ASSUMES X6 TO HOLD COMMAND WORD, LOWER 10 BITS ZERO * * ATTACHES COMNUM TO X6 AND DECREMENTS ICX * STORES X6 IN INFO(ICX) * CSTO EQ * SA1 COMNUM GET COMMAND NUMBER BX6 X6+X1 SA1 ICX POINTS TO PREVIOUS COMMAND WORD SA6 INFO-1+X1 STORE IN NEXT OPEN SPACE SX6 X1-1 SA6 A1 STORE NEW COMMAND POINTER VALUE EQ CSTO * * ROUTINE TO DO FOR EMBEDDABLE COMMANDS WHAT * VARFIN DOES FOR NORMAL COMMANDS * NOTE THAT ON ENTRY, X1=NUMBER OF ARGUMENTS DESIRED * * VARFEM EQ * ENTRY/EXIT LINE SA2 VARBUF X2 HOLDS NO. OF 20 BIT PACKAGES SB5 1 UNIVERSAL INCREMENT CONSTANT TO B5 SA4 A2+B5 A4 HOLDS ADR. OF FIRST 20 BIT PACKAGE SB2 X2 B2 HOLDS VAR COUNT BX2 X1-X2 NZ X2,ERRTAGS ERROR IF NOT CORRECT NO. OF VARS MX0 60-XCODEL X0 HOLDS 40 BIT MASK BX3 -X0*X4 CLEAR TOP BITS OF FIRST VAR SA4 A4+B5 GET SECOND VAR BX4 -X0*X4 LX3 60-XCODEL POSITION FIRST VAR LX4 60-2*XCODEL POSITION SECOND VAR BX6 X3+X4 SB4 B5+B5 B4 HOLDS COUNT OF TWO SA2 INX NEXT FREE LOC OF EXTRA STORAGE LX2 XCMNDL POSITION LEFT OF COMMAND CODE BX6 X6+X2 X2 HOLDS POINTER TO NEXT EXTRA STORAGE WORD * COMMAND WORD STORED BY CALL-OR VARFEMT SB2 B2-3 DECREMENT VAR COUNT LT B2,VARFEM DONE IF LESS THAN THREE VARS VARFEML SA4 A4+B5 A4 STILL POINTS TO PREVIOUS VAR BX4 -X0*X4 X0 STILL HOLDS 40 BIT MASK LX7 XCODEL SHIFT PREVIOUS VAR(S) UP BX7 X0*X7 BX7 X7+X4 X7 HOLDS PACKED UP VARS SB4 B4-B5 DECREMENT BY ONE FOR END TEST PL B4,VARFEML JUMP IF THIS WORD NOT FULL YET SA2 INX GET EXTRA STORAGE POINTER SA7 INFO+X2 STORE EXTRA STORAGE WORD SB4 B5+B5 SX7 X2+B5 SA7 INX UPDATE EXTRA STORAGE POINTER EQ VARFEMT * /--- BLOCK NEWERROR 00 000 80/09/14 14.57 * * NEW STANDARD ERROR EXITS FOR ALL CONDENSE ROUTINES * ENTRY ERRTAGS,ERRNAME,ERRSTOR ENTRY ERRXYTG,ERR2MNY,ERR2FEW,ERR2MNU ENTRY ERRTERM,ERRUARG,ERRVTYP ENTRY ERROBS,ERROUTR,ERRCNTD ENTRY ERRXORQ,ERRBAL,FIPERR * ERROBS SB1 0 OBSOLETE COMMAND EQ =XERR ERRTAGS SB1 2 WRONG NUMBER TAG FIELDS EQ =XERR ERRNAME SB1 3 UNRECOGNIZABLE NAME OR TOO LONG EQ =XERR ERRSTOR SB1 4 ERROR IN TYPE OF STORE VARIABLE EQ =XERR ERRXYTG SB1 5 ERROR IN COARSE/FINE XY TAG EQ =XERR ERR2MNY SB1 6 TOO MANY TAGS FOR COMMAND FORM EQ =XERR ERR2FEW SB1 7 NOT ENOUGH TAGS FOR COMMANDFORM EQ =XERR ERRTERM SB1 8 WRONG TERMINATOR TYPE ,FOR; ETC EQ =XERR ERRUARG SB1 9 UNIT ARGUMENTS DONT MATCH EQ =XERR ERRVTYP SB1 10 WRONG VARIABLE TYPE, IE EQ =XERR VC NOT V OR V NOT N * FIPERR SB1 44 BAD FILE INFO PACKET EQ =XERR * ERRXORQ SB1 72 EQ =XERR ERROUTR SB1 79 ILLEGAL REF TO ROUTER (OR NONE) EQ =XERR ERRCNTD SB1 80 COMND NOT (OR SHOULD BE) CONTD. EQ =XERR ERRBAL SB1 84 UNBALANCED PARENS OR QUOTES EQ =XERR ERR2MNU SB1 105 TOO MANY UNIT NAMES (OVER 400) EQ =XERR * * * /--- BLOCK ULONG 00 000 75/10/09 10.23 * * * -ULONG- * CHECK FOR UNIT TOO LONG - GIVE WARNING * ENTRY ULONG ULONG EQ * SA1 INX EXTRA STORAGE POINTER SA2 ICX COMMAND STORAGE POINTER IX1 X1-X2 CHECK FOR UNIT TOO LONG PL X1,LNGUNIT FATAL ERROR EXIT * SX1 X1+25 SX1 X1+10 UNITLTH-10 = WARNING LIMIT NG X1,ULONG SA1 UNUMON SEE IF IN IEU SX1 X1-IEUNUM ZR X1,LNGUNIT JUST ABORT CALL UNNAM GET CURRENT UNIT NAME NG X1,LNGUNIT ABORT IF BAD UNIT NAME LX6 12 BX5 X6 UERRSET PRESERVES -X5- CALL UERRSET SET EDIT CONNECTION TO GO TO UNIT COMMAND SB1 900 *WARNING* UNIT ALMOST TOO LONG BX2 X5 SAVE UNIT NAME MX1 -1 DON'7T SAVE COMMAND NAME SB2 X1 NO BAD LINE TO SAVE RJ =XRJERR2 STORE ERROR INFO EQ ULONG * * * -MISAY- * CHECK FOR MISSING -SAYLANG- IF SAY(S) PRESENT * ENTRY MISAY MISAY EQ * .SAYCMD IFNE SAYASSM,0 SA3 SAYFLAG PUT VALUE OF SAYFLAG IN X3 ZR X3,MISAY IF NO SAY(LANG) COMNDS, RETURN SX3 X3-1 AREN'7T INTERESTED IF SAY THERE NZ X3,MISAY MUST HAVE BEEN A SAYLANG SB1 117 ',MISSING SAYLANG COMMAND', SB2 -1 SX1 B0 SX2 B0 RJ =XRJERR2 STORE ERROR INFORMATION .SAYCMD ENDIF EQ MISAY * * /--- BLOCK ABORTCON 00 000 81/06/15 11.44 TITLE ABORTCON--ABORT CONDENSE * * * TAG TOO LONG--PRESUMABLY NOT A SOURCE FILE * ENTRY BADTAG * BADTAG SX6 14 EQ ABORTCON * * * UNIT NAME TABLE FULL BUT IEU ONLY REAL ONE * ENTRY BADIEU BADIEU SX6 42 EQ ABORTCON * * * OBSOLETE LESSON -- MUST BE CONVERTED FIRST * ENTRY OBSFILE OBSFILE SX6 29 ERROR CODE SA6 IOBUFF EQ ABORT3 * * UNIT TOO LONG TO CONDENSE * ENTRY LNGUNIT * LNGUNIT SX6 6 EQ ABORTCON * * * TOO MANY BLOCKS BEING -USE-D * ENTRY TMNYUSE TMNYUSE SX6 30 EQ ABORTCON * * ABORT CONDENSE * ABORTCON SA6 IOBUFF * FIND THE UNIT NAME CALL UNNAM LX6 12 SA6 IOBUFF+1 STORE EXTRA INFORMATION ABORT2 SA3 ACLSTAT SX1 ABTCLES IX0 X1+X3 ECS ADDR OF STAT WORD SA0 SCONTMP + RE 1 RJ =XECSPRTY SA1 A0 SX2 1 IX6 X1+X2 INC NUMBER OF ABORTED CONDENSING SA6 A1 + WE 1 WRITE BACK IN ECS RJ =XECSPRTY SA1 TSCOMFG COMMAND STATISTICS PL X1,ABORT3 BX6 X2 TURN OFF FLAG TEMP SA6 A1 DONT INCLUDE IN STATISTICS ABORT3 RJ =XABORTC EQ =XCONDENS * /--- BLOCK TUTOR COMM 00 000 80/12/26 14.07 TITLE TUTOR COMMAND STATISTICS * ENTER THIS SUBROUTINE ONLY WHEN TSCOMFG IS -1, TO RECORD * STATISTICS ON EACH TUTOR COMMAND, ITS CONDENSING TIME AND * FREQUENCY COUNT. * ALL STATISTICS ARE KEPT IN ECS BANK CNDSTAT. * THE ROUTINE ASSUMES THAT THE COMMAND NUMBER IS IN SCOMNUM AND * CONDENSING BEGIN TIME (MSEC.) IN SCOMBEG. * TSCOMFG IS SET TO 1 UPON EXIT FROM THIS ROUTINE. * * ENTRY PSTCMS1 * PSTCMS1 EQ * SX6 1 SA6 TSCOMFG RESET FLAG TO 1 SA3 ACDSTAT ADDR OF CNDSTAT IN ECS SX1 SCOMNDN IX0 X1+X3 SA0 SCONTMP + RE 2 REAC TOTAL COUNT AND TOTAL TIME FROM ECS RJ =XECSPRTY SA1 A0 TOTAL COUNT IX6 X1+X6 SA6 A1 INCREMENT TOTAL COUNT SA1 SYSCLOK SA2 SCOMBEG IX2 X1-X2 CURRENT TIME - BEGIN TIME SA1 A0+1 TOTAL TIME IX6 X1+X2 SA6 A1 UPDATE TOTAL TIME + WE 2 WRITE BACK ECS,TOTAL COUNT AND TIME RJ =XECSPRTY SX1 SCOMNDS COMMAND NUMBER IX0 X1+X3 SA1 SCOMNUM IX0 X0+X1 ECS LOC OF STATISTICS WORD FOR THIS COMMAND + RE 1 READ FROM ECS RJ =XECSPRTY SA1 A0 LOAD COMMAND STATISTICS WORD IX2 X1+X2 ADD TO PROCESS TIME MX3 1 LX3 31 IX6 X2+X3 INC ITS COMMAND COUNT BY 1 SA6 A1 + WE 1 WRITE BACK IN ECS RJ =XECSPRTY EQ PSTCMS1 * * /--- BLOCK WRITECS 00 000 85/03/25 11.54 * SPACE 5,11 ** WRITECS - WRITE NEXT BLOCK OF BINARY TO ECS * * ENTRY - (X0) - ECS ADDRESS TO WRITE TO * (A0) - CM ADDRESS TO WRITE FROM * (X2) - NUMBER OF WORDS TO WRITE * * EXIT - (X0) - NEXT ECS ADDRESS TO WRITE TO * * MUST SAVE CONTENTS OF A - 0,1,6 * X - 1,3,4,6 * B - NONE * * (USED IN *UWRITE*/COVLAY4) ENTRY WRITECS WRITECS EQ * WECS1 SA5 CONBUFF (X5) = ADDRESS OF CONDEN BUFFER IX7 X0-X5 SA5 CBLTH (X5) = LENGTH OF BUFFER IX7 X7-X5 IX7 X7+X2 PL X7,WECS2 IF OVERFLOWING BUFFER SB7 X2 SET LENGTH OF WRITE WE B7 RJ ECSPRTY IX0 X0+X2 INCREMENT ECS ADDRESS EQ WRITECS * RATHER THAN ALLOCATE MAX SIZE BUFFER FOR BINARY, * WE TRY ROUGHLY 1/4 THEN 1/2 THEN FULL SIZE. WECS2 SX7 X5-CBLTH2 CHECK FOR 1/2 SIZE PL X7,WECS2.1 -- .GE. 1/2 SIZE SX7 CBLTH2 ELSE FIRST PASS, TRY 1/2 EQ WECS2.3 WECS2.1 NZ X7,WECS2.2 -- ALREADY AT MAX SIZE, ERROR SX7 CBINMAX ELSE, TRY MAX SIZE EQ WECS2.3 WECS2.2 SX6 15 THIRD PASS - *BINARY TOO BIG* EQ ABORTCON * /--- BLOCK WRITECS 00 000 85/03/25 11.48 * REQUEST A LARGER CONDENSE BUFFER WECS2.3 BSS 0 SA7 CBLTH STORE DESIRED BUFFER LENGTH SB7 1 SX7 A0 SAVE A0 SA7 WECSA BX7 X0 SAVE X0 SA7 A7+B7 SX7 A6 SAVE A6 SA7 A7+B7 SA6 A7+B7 SAVE X6 SX7 A1 SAVE A1 BX6 X1 SAVE X1 SA7 A6+B7 SA6 A7+B7 BX6 X3 SAVE X3 BX7 X4 SAVE X4 SA6 A6+B7 SA7 A6+B7 * MUST SAVE X2 BECAUSE *SYSTEM* MACRO IN *S=WAIT* USES * THAT REGISTER. CONTAINS LENGTH OF EM WRITE. BX6 X2 SA6 A7+B7 * SET THE RETRY COUNTER. SX6 3 WECS2.5 SA6 WECSD * BUILD THE REQUEST. MX6 1 MOVE LESSON REQUEST = 1 SA5 CONBUFF (X5) = ORIGINAL BUFFER ADDRESS SA1 CBLTH BX7 X1 (X7) = REQUESTED BUFFER LENGTH SA1 CONDN BIAS TO THIS CONDENSORS WORD SX0 X1+COECRQ LX5 24 LX6 -11 BX7 X7+X6 BX7 X7+X5 SA7 WECSB SET REQUEST WORD SA0 A7 SA1 WECSC INCREMENT ECS MOVE COUNT SX6 X1+B7 SA6 A1 WE 1 RJ ECSPRTY WECS3 SX7 B1 SAVE B1 OVER S=WAIT CALL S=WAIT,15 WAIT A BIT SB1 X7 RESTORE B1 RE 1 RJ ECSPRTY SA5 A0 PL X5,WECS3 IF NOT COMPLETE * /--- BLOCK WRITECS 00 000 85/03/25 11.50 * CHECK IF MOVE ACTUALLY OCCURRED. MX7 -24 BX7 -X7*X5 (X7) = NEW EM ADDRESS NZ X7,WECS5 IF MOVE OCCURRED * UPDATE RETRY COUNTER. SA1 WECSD SX6 X1-1 PL X6,WECS2.5 IF SHOULD TRY AGAIN * UNABLE TO GET THE LARGER BINARY BUFFER. * ABORT THIS CONDENSE. CALL S=MSG,(=C* EM REQUEST FAILURE.*) SX6 3 NO ECS AVAILABLE EQ ABORTCON WECS5 SA5 CONBUFF IX0 X7-X5 (X0) = DISTANCE OF MOVE SA7 A5 SA5 WECSA RESTORE A0 SB7 1 SA0 X5 SA5 A5+B7 UPDATE X0 TO NEW ADDRESS IX0 X5+X0 SA5 A5+B7 RESTORE A6 SA1 X5 BX6 X1 SA6 A1 SA5 A5+B7 RESTORE X6 BX6 X5 SA5 A5+B7 RESTORE A1 SA1 X5 SA5 A5+B7 RESTORE X1 BX1 X5 SA5 A5+B7 BX3 X5 SA5 A5+B7 BX4 X5 SA5 A5+B7 BX2 X5 EQ WECS1 WRITE AGAIN WECSA BSS 9 SAVE AREA (A0,X0,A6,X6,A1,X1,X3,X4,X2) WECSB DATA 0 ECS REQUEST WORD ENTRY WECSC WECSC DATA 0 NUMBER OF TIMES MOVE REQUESTED WECSD BSS 1 MOVE EM RETRY COUNTER * * /--- BLOCK PUBERRS 00 000 80/12/26 14.13 * * * -PUBERRS- * * STORE ERROR ORDINAL,LESSON,BLOCK,LINE * IN USERS STORAGE * * ON ENTRY B1 = PUBLISH ERROR NUMBER * ON EXIT PUBLISH ERROR IS LOGGED * * USES ALL REGISTERS * ENTRY PUBERRS PUBERRS EQ * SB2 CPUBE B2 = BUFFER NUMBER RJ =XPLOGLIN EQ PUBERRS * * -PUBWARN- * * STORE ERROR ORDINAL,LESSON,BLOCK,LINE * IN USERS STORAGE * * ON ENTRY B1 = PUBLISH WARNING NUMBER * ON EXIT PUBLISH WARNING IS LOGGED * * USES ALL REGISTERS * ENTRY PUBWARN PUBWARN EQ * SB2 CPUBW B2 = BUFFER NUMBER RJ =XPLOGLIN EQ PUBWARN * * * -PUBTEXT- * * STORE TEXT ORDINAL,LESSON,BLOCK,LINE * IN USERS STORAGE * * ON ENTRY B1 = TEXT COMMAND NUMBER * ON EXIT TEXT POSITION IS LOGGED * * USES ALL REGISTERS * ENTRY PUBTEXT PUBTEXT EQ * SB2 CTEXT B2 = BUFFER NUMBER RJ =XPLOGLIN EQ PUBTEXT * * * * -PLOGLIN- * * LOG ERROR/FILE/BLOCK/LINE NUMBER IN STORAGE BUFFER * * ON ENTRY B1 = PUBLISH ERROR TYPE * B2 = BUFFER NUMBER * PLOGLIN EQ * SA1 COPTS+B2 X1 = PUBLISH ERROR RETURN FLAG ZR X1,PLOGLIN * SX6 B1 LOG TYPE SA6 TEMP SA0 A6 SB1 B2 B1 = BUFFER NUMBER RJ APNDSTO APPEND CM(A0) TO BUFFER B1 RJ =XLOGLINE LOG FILE/LOGICAL BLOCK/LINE EQ PLOGLIN * * /--- BLOCK UNITLOC 00 000 81/07/28 03.42 * * -UNITLOC- * * APPEND UNIT NAME/FILE/BLOCK/LINE TO CUNTS BUFFER * * ON ENTRY, X6 = UNIT NUMBER * ON EXIT, X6 IS PRESERVED * ENTRY UNITLOC UNITLOC EQ * SA1 COPTS+CUNTS ZR X1,UNITLOC IF -UNITS- OPTION NOT SELECTED * SA6 SVX6 SAVE X6 RJ =XUNNAMX6 X6 = UNIT NAME NG X1,*+40000B KILL CONDENSOR IF BAD UNIT NUM SA6 TEMP SA0 A6 SB1 CUNTS RJ =XAPNDSTO APPEND UNIT NAME RJ =XLOGLINE APPEND FILE/BLOCK/LINE SA1 SVX6 BX6 X1 RESTORE X6 EQ UNITLOC * SVX6 BSS 1 SAVE X6 FROM UNIT CONDENSOR * TEMP BSS 1 * * * -LOGLINE- * * LOG FILE/BLOCK/LINE NUMBER IN STORAGE BUFFER * * ON ENTRY * B1 = BUFFER NUMBER * ENTRY LOGLINE LOGLINE EQ * SA0 TACCT ACCOUNT OF TAG RJ APNDSTO SA0 TFILE FILE OF TAG RJ APNDSTO SA1 TBLOCK BLOCK OF TAG SA2 TLINE LINE OF TAG LX1 18 18BLOCK/18LINE BX6 X1+X2 SA6 TEMP SA0 A6 RJ APNDSTO EQ LOGLINE * * /--- BLOCK APNDSTO 00 000 80/12/26 14.11 * * -APNDSTO- * * APPEND A WORD TO BUFFER IN USER STORAGE * * ON ENTRY * B1 = BUFFER ORDINAL * A0 = CM ADDRESS OF WORD TO APPEND * * ON EXIT * * B1 IS PRESERVED * * IF THE BUFFER FOR THE ORDINAL IN B1 DOES NOT EXIST * THE BUFFER IS CREATED. THE DATA STRUCTURE IS'; * * S1 = 6UNUSED/18OVFLMAP/18OVFLCOUNT/18BUFFCOUNT * S2 TO S(S1+1) = 24UNUSED/18BUFFORDINAL/18BUFFLEN * S(S1+2) TO S(LSTORAG) = CONTENTS OF BUFFERS * ENTRY APNDSTO APNDSTO EQ * SX6 A0 SAVE A0 SA6 SAVEA0 SB7 B1 B7 = BUFFER ORDINAL SB2 B0 B2 = LENGTH ALL BUFFERS SB3 B0 B3 = LENGTH UP TO BUFFER B7 SB4 B0 B4 = INDEX TO BUFFER B7 POINTER SB5 B0 B5 = BUFFER POINTER INDEX SA1 CSTOADR X1 = ECS ADDRESS OF STORAGE ZR X1,APNDSTO INTEGRITY CHECK * RX2 X1 SB6 X2 B6 = NUMBER OF BUFFERS APND10 SB5 B5+1 GT B5,B6,APND20 IF ALL BUFFER POINTERS SCANNED * SX2 B5 X2 = BUFFER POINTER IX2 X2+X1 RX2 X2 SX3 X2 X3 = BUFFER LENGTH SB2 B2+X3 B2 = TOTAL LENGTH AX2 18 SB1 X2 B1 = ORDINAL OF THIS BUFFER NE B1,B7,APND10 IF NOT LOOKING FOR THIS BUFFER * SB4 B5 SB3 B2 EQ APND10 * APND20 NZ B4,APND30 IF BUFFER ALREADY EXISTS * BX7 X1 X7 = ADDR OF STORAGE SX2 B5 IX1 X1+X2 X1 = SOURCE OF MOVE BX6 X1 SAVE X1 SX2 1 IX2 X2+X1 X2 = DESTINATION OF MOVE SX3 B2 X3 = LENGTH OF MOVE SA4 CSTOLWA X4 = LWA+1 OF BUFFER RJ =XOPENECS OPEN BUFFER IN ECS NG X5,APND40 IF NO ROOM TO APPEND WORD * BX1 X6 RESTORE X1 SX6 B7 X6 = BUFFER ORDINAL LX6 18 WX6 X1 ADD NEW BUFFER POINTER SB3 B2 POINT TO END OF LAST BUFFER SB4 B5 * /--- BLOCK APNDSTO 00 000 81/07/08 01.17 BX1 X7 RESTORE X1 RX2 X1 X2 = CURRENT NUMBER OF BUFFERS SX3 1 IX6 X2+X3 INCREMENT NUMBER OF BUFFERS SB6 X6 B6 = NUMBER OF BUFFERS WX6 X1 APND30 SX2 B6+1 SX2 X2+B3 STORAGE LOC FOR NEW ENTRY IX1 X1+X2 X1 = ADDR FOR NEW WORD BX7 X1 SAVE X1 SX2 1 IX2 X2+X1 X2 = NEXT BUFFER ADDRES SB1 B2-B3 SX3 B1 X3 = LENGTH OF FOLLOWING SPACE SA4 CSTOLWA X4 = LWA+1 OF STORAGE RJ =XOPENECS NG X5,APND40 IF NO MORE ROOM * SA1 SAVEA0 RESTORE A0 SA0 X1 BX0 X7 WE 1 RJ ECSPRTY SA1 CSTOADR INCREMENT BUFFER LENGTH SX2 B4 IX0 X1+X2 RX1 X0 SX2 1 IX6 X1+X2 WX6 X0 SB1 B7 RESTORE B1 EQ APNDSTO * APND40 SA1 CSTOADR MARK BUFFER OVERFLOW RX2 X1 X2 = S1 SX3 1 LX3 18 IX6 X3+X2 INCREMENT OVERFLOW COUNT LX3 18 LX3 B7 BX6 X3+X6 MARK BUFFER(B7) OVERFLOW WX6 X1 SB1 B7 RESTORE B1 EQ APNDSTO * SAVEA0 BSS 1 * /--- BLOCK TAGSAVE 00 000 73/11/10 23.19 * * * * -TAGSAVE- -TAGREST- * SAVE AND RESTORE *TAGCNT* AND *TAG* BUFFER * * ENTRY TAGSAVE TAGSAVE EQ * SA1 TAGCNT LENGTH OF TAG SB1 X1 BX6 X1 SAVE SA6 SAVTLTH SA1 ATAGECS BX0 X1 ECS TAG SAVE AREA SA0 TAG + WE B1 WRITE TAG TO ECS RJ ECSPRTY EQ TAGSAVE * * ENTRY TAGREST TAGREST EQ * SA1 SAVTLTH RESTORE TAG LENGTH BX6 X1 SA6 TAGCNT SB1 X1 SA1 ATAGECS ECS ADDRESS OF SAVED TAG BX0 X1 SA0 TAG + RE B1 READ BACK INTO *TAG* BUFFER RJ ECSPRTY EQ TAGREST * SAVTLTH BSS 1 * * * /--- BLOCK APACK 00 000 73/00/00 00.00 TITLE -APACK- * * * -APACK- * PACKS UP NUMBER OF ARGUMENTS, UNIT NUMBER AND * -GETVAR- CODES FOR ARGUMENTS * * ENTER WITH UNIT NUMBER IN X6 * RETURNS WITH X6 = CODE FOR UNIT WITH ARGUMENTS * * ENTRY APACK APACK EQ * SA1 VARBUF NUMBER OF ARGUMENTS ZR X1,APACK SB1 X1 LX1 10 BX6 X1+X6 COMBINE WITH UNIT NUMBER LX6 40 POSITION FIRST 20 BIT CODE SA4 INX SX7 X4 UNIT EXTRA STORAGE POINTER MX0 -XCODEL SB2 20 INITIALIZE SHIFT COUNT * APLP SB1 B1-1 DECREMENT ARGUMENT COUNT NG B1,APLP1 SA1 A1+1 LOAD NEXT -GETVAR- CODE BX1 -X0*X1 LX1 X1,B2 POSITION -GETVAR- CODE BX6 X1+X6 SB2 B2-20 DECREMENT SHIFT COUNT PL B2,APLP * APLP1 SA6 X7+INFO STORE COMPLETED WORD SX7 X7+1 SB2 40 RE-INITIALIZE SHIFT COUNT MX6 0 PL B1,APLP SX6 4000B CODE FOR UNIT WITH ARGUMENTS BX6 X4+X6 SA7 INX UPDATE EXTRA STORAGE POINTER EQ APACK * * ENTRY AUNUM ENTRY UARGS,ENDPNT,UNITFLG * UARGS BSS 1 UNITFLG BSS 1 SPECIAL FLAG FOR -UNIT- COMMAND ENTRY ENDPNT REFERENCED IN JOINOV ENDPNT BSS 1 POINTER TO END OF ARGUMENTS * AUNUM BSS 1 ENTRY ARGKEY ARGKEY BSS 1 TERMINATOR KEY FOR ARGS * * /--- BLOCK GETARGS 00 000 80/03/28 00.20 TITLE -GETARGS- * * -GETARGS- * PROCESS ARGUMENTS OF UNIT * * ENTER WITH *VARBUF* INITIALIZED TO ZERO * * ON EXIT -- * *VARBUF(0)* = NUMBER OF ARGUMENTS * *VARBUF(N)* = -GETVAR- CODES * ENTRY GETARGS GETARGS EQ * * GETLP SA1 WORDPT POINTER TO NEXT CHARACTER SA1 X1 * GET0 SX2 X1-1R CHECK FOR SPACE NZ X2,GET1 SA1 A1+1 GET NEXT CHARACTER EQ GET0 * GET1 SA2 X1+KEYTYPE GET CHARACTER TYPE SX3 X2-EOL ZR X3,GET2 JUMP IF END-OF-LINE SX3 X2-OPCOMMA NZ X3,GET3 GO COMPILE IF NOT COMMA SA1 A1+1 ADVANCE CHARACTER POINTER * GET2 SX7 A1 SA7 WORDPT UPDATE *WORDPT* SX7 X1 SA7 LASTKEY AND *LASTKEY* SA1 UNITFLG NZ X1,ERRSTOR ERROR IF -UNIT- OR -ARGS- MX1 1 LX1 20 SET UP SPECIAL 20 BIT CODE MX7 1 BX7 X1+X7 TOP BIT FOR NON-STOREABLE SA1 VARBUF SX6 X1+1 ADVANCE *VARBUF* POINTER SA6 A1 SA7 X6+VARBUF STORE SPECIAL CODE EQ GET4 * GET3 SX7 A1 UPDATE *WORDPT* SA7 WORDPT SA1 UNITFLG SEE IF -UNIT- COMMAND ZR X1,GET3A CALL PUTDO2 EVALUATE VARIABLE EQ GET4 * GET3A CALL VARDO2 EVALUATE NEXT ARGUMENT GET4 SA1 VARBUF GET ARGUMENT COUNT SX1 X1-UARGMAX-1 PL X1,ERRUARG ERROR IF TOO MANY ARGUMENTS SA1 WORDPT SA2 ENDPNT SEE IF AT END OF ARGUMENTS YET IX1 X1-X2 PL X1,GETARGS IF AT END OF ARGUMENTS * SA2 LASTKEY SX2 X2-1R; NZ X2,GETLP IF NICE DELIMITER * SA1 BDLIM BX7 X1 SA7 CERROR1 STORE MESSAGE SB1 99 ORDINAL FOR BAD DELIMITER ERROR SA1 CMNDTMP SAVED COMMAND NAME ZR X1,=XERR IF NONE SAVED, NORMAL ERROR * RJ =XRJERR MX6 0 NO ARGUMENTS SA6 VARBUF EQ GETARGS * BDLIM DATA 10LBAD DELIM ENTRY CMNDTMP CMNDTMP DATA 0 SAVE CMND NAME FOR UNIT ARGS * /--- BLOCK DUMP 00 000 79/12/10 11.40 TITLE -DUMP- COMMAND * * * -DUMP- COMMAND * BOMB CONDENSOR * ENTRY DUMPIN DUMPIN CALL SYSTEST MUST BE SYSTEM LESSON MX6 0 SA6 ITEMP SA6 ITEMP+1 SA1 APLACOM SX0 1 IX0 X1+X0 SA0 ITEMP + WE 2 RJ ECSPRTY BX0 X1 SA0 =3 3 = ABNORMAL TERMINATION + WE 1 RJ ECSPRTY SA1 -1 * * * /--- BLOCK END 00 000 81/07/17 12.12 * * * END * /--- BLOCK TABC 00 000 81/07/14 00.08 IDENT TABC TITLE TABC TITLE CENTRAL SUBOV TABLE CST * /--- BLOCK ENTRY 00 000 81/07/10 00.54 * ENTRIES FOR CONDC ENTRY OK=,ANSV=,FINIS=,BACKG= ENTRY HOLFIN,WRONGV= * /--- BLOCK COVLAY 00 000 81/07/14 00.04 * * ENTRY OVRLAYS FOR OFFSET IN COMMAND TABLE OVRLAYS BSS 0 * * COVLAY1 * SUBOV ENABOV SUBOV PAUSOV SUBOV DABSOV SUBOV CFINOV SUBOV JMPFOV -JUMPOUT- AND -FROM- SUBOV CDATAOV VARIOUS DATA COMMANDS SUBOV READDOV -READD- * SUBOV NOTEOV SUBOV NNOTEOV SUBOV INTLOKV SUBOV ATCHOV -ATTACH- AND -DETACH- COMMANDS SUBOV KERMCOV KERMIT PROTOCOL * * GRAFSC * SUBOV GRAFOV * * ANSIN * SUBOV ANSOV * * DEFINE * SUBOV DEFOV SUBOV SEGOV * * COVLAY2 * SUBOV LIBCOV LIBCALL/CALL COMMANDS SUBOV WRITCOV -WRITEC- SUBOV INITOV INITS FOR EACH CONDENSE SUBOV LISTOV LESLIST ORIENTED COMMANDS SUBOV CHGOV -CHANGE- COMMAND SUBOV DRAWOV -DRAW- SUBOV PUTOV -PUT- AND -PUTD- SUBOV COMMOV -COMMON- -STORAGE- -ROUTVAR- SUBOV SORTOV -SORT- SUBOV TRQCOV -TALKREQ- SUBOV FONTCOV -FONT- * * ANSWIN * SUBOV ANSWOV * * TOUCHOV * SUBOV TOUCHOV -TOUCH- * * * COVLAY3 * SUBOV PACKOV -PACK- SUBOV SETROV SETRESV SUBOV SUBMOV -SUBMITM- SUBOV FINDSOV -FINDS- SUBOV INSRTOV -INSERTS-/-DELETES- SUBOV COVL3 SUBOV TSLINKC SUBOV IPCC IPC / CHARACNV COMMANDS SUBOV NSETOV NAMESET COMMAND READINS SUBOV COVL3B VARIOUS COMMAND READINS SUBOV KEYWDOV -ATTACHF- * * RECORDC SUBOV RECOV RECORDS COMMAND * * SITEC SUBOV SITEOV -SITE- COMMANDS SUBOV STATIOV -STATION- COMMANDS SUBOV NSITEOV -NSITE/SUBSITE/NSTAT- COMMANDS * * PPTC SUBOV PPTOV -PPT- COMMANDS SUBOV MTUTOV CPU MICROTUTOR COMMANDS * * COVLAY4 SUBOV COV4 ASSORTED COMMANDS SUBOV COV4A MORE ASSORTED COMMANDS SUBOV JOINOV SUBOV ACCOV ACCESS COMMAND OVERLAYS SUBOV COV4B * * CWRITE SUBOV CWRTOV * * TAGOV SUBOV TAGOV * /--- BLOCK COMNDS 00 000 81/07/13 20.32 TITLE CENTRAL CONDENSE COMMAND NAME TABLE * * THE FOLLOWING TABLE CONTAINS AN ORDERED LIST OF * ALL THE LEGAL TUTOR COMMANDS. * * * EXAMPLE OF CONSTRUCTION OF JUMP TABLE -- *JUMP MACRO 8LSTORE,STORE,2,ONEPUT,01110,STOREJ * NAME,DISPLAY NAME,TYPE,CONDENSOR,CONTINGENCIES,EXECUTOR * * * FOR COMMANDS WITH ONLY ONE BRANCH, THE BRANCH * IS EXPLICITLY GIVEN IN THE BOTTOM 18 BITS OF THE * TABLE ENTRY. * JUMP MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2 VFD 60/NAME JMP1 RMT + VFD 12/0,13/0,5/TYPE,12/0,18/=X_JUMP1 JMP1 RMT NN SET NN+1 COUNTER FOR COMMAND NUMBER MM SET MM+1 COUNTER FOR REAL COMMANDS ENDM * * JUMP1 AND ARG1 PERTAIN TO CONDENSE ROUTINE * AND JUMP2 AND ARG2 TO THE EXECUTION ROUTINE. * 'IN EACH CASE, IF JUMP IS ',CM', THEN ARG GIVES * THE CENTRAL MEMORY ADDRESS OF THE PROCESSING * ROUTINE; OTHERWISE, JUMP IS THE OVERLAY NUMBER * AND ARG CONTAINS ANY ARGUMENT TO BE PASSED IT. * JUMPOV MACRO NAME,NAM,TYPE,JUMP1,ARG1,CONTG,JUMP2,ARG2 VFD 60/NAME NAM MICRO 3,8, NAME_= "NAM" EQU NN JMP1 RMT IFC EQ,*JUMP1*CM* VFD 12/0,13/0,5/TYPE,12/0,18/=X_ARG1 ELSE + VFD 12/0,13/0,5/TYPE,12/0 VFD 1/1,8/JUMP1-OVRLAYS,1/0,8/ARG1 ENDIF JMP1 RMT NN SET NN+1 COUNTER FOR COMMAND NUMBER MM SET MM+1 COUNTER FOR REAL COMMANDS ENDM * * JUMPD PERMITS REFERENCING THIS COMMAND NUMBER * JUMPD MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2 VFD 60/NAME NAM MICRO 3,8, NAME_= "NAM" EQU NN JMP1 RMT + VFD 12/0,13/0,5/TYPE,12/0,18/=X_JUMP1 JMP1 RMT NN SET NN+1 COUNTER FOR COMMAND NUMBER MM SET MM+1 COUNTER FOR REAL COMMANDS ENDM * /--- BLOCK COMNDS 00 000 81/07/14 10.58 * * JUMP* HOLDS A COMMAND NUMBER SLOT OPEN BUT THE COMMAND * NAME CANNOT ACTUALLY BE MATCHED (E.G., GOTOC) * JUMP* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2 NM MICRO 3,5,/NAME / VFD 6/0,54/5L"NM" JMP1 RMT + VFD 60/0 JMP1 RMT NN SET NN+1 COUNTER FOR COMMAND NUMBER ENDM * * JUMPD* IS COMBINATION OF JUMPD AND JUMP* * JUMPD* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2 NM MICRO 3,5,/NAME / VFD 6/0,54/5L"NM" NAM MICRO 3,8, NAME_= "NAM" EQU NN JMP1 RMT + VFD 60/0 JMP1 RMT NN SET NN+1 COUNTER FOR COMMAND NUMBER ENDM * * END THE JUMP TABLE * JUMPF MACRO LIST -L DUP 512-NN JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERRORX ENDD LIST * ENDM * * USED FOR NON-EXECUTABLE COMMANDS WHICH ARE IN CM * JUMPI MACRO NAME,TYPE,JUMP1 VFD 60/NAME JMP1 RMT + VFD 12/0,13/0,5/TYPE,12/0,18/=X_JUMP1 JMP1 RMT NN SET NN+1 COUNTER FOR COMMAND NUMBER MM SET MM+1 COUNTER FOR REAL COMMANDS ENDM * * USED FOR NON-EXECUTABLE COMMANDS IN OVERLAYS * JUMPIO MACRO NAME,TYPE,JUMP1,ARG1 VFD 60/NAME JMP1 RMT + VFD 12/0,13/0,5/TYPE,12/0 VFD 1/1,8/JUMP1-OVRLAYS,1/0,8/ARG1 JMP1 RMT NN SET NN+1 MM SET MM+1 ENDM * * /--- BLOCK COMNDS 00 000 81/07/14 00.07 ENTRY COMNAMS * COMNAMS BSS 0 * NOREF NN,MM NN SET 0 COMMAND NUMBER COUNTER MM SET 0 REAL COMMAND COUNTER * LIST X,G * *CALL COMNDS * LIST * * * ***** END OF TABLE OF REAL COMMANDS ********* * * ENTRY COMNAML,COMINFL COMNAML EQU *-COMNAMS LENGTH OF NAME TABLE COMINFL EQU 513 LENGTH OF INFO TABLE (2&N+1) * 2 ERRNG CMNDMAX-COMNAML FOR PECULIAR ERROR TEST.. * DUE TO ECS TABLE FOR TRUE COMMAND TABLE BEING IN * EXECUTER CONTROL POINT...WHICH SEE...THIS WILL * AUTOMATICALLY GIVE AN ERROR WHEN THE BUFFER IS * TOO SMALL FOR CONDENSOR CONTROL POINT. 2 ERRNG COMINFL-1-MM LEAVE ONE FREE WORD AT END OF COMINFO 2 ERRNG COMNAML-COMINFL ASSUME COMNAML IS NOT SMALLER * * TITLE READ-IN JUMP TABLE * FORMAT OF INFO TABLE WORDS (COMINFO) * 12 BITS -- LINK TO NEXT WORD WITH THIS HASH NUMBER * 1 BIT -- SET IF THIS IS FIRST WORD OF HASH CHAIN * 1 BIT -- SET IF THIS IS AN ELSE-TYPE COMMAND * 1 BIT -- SET IF THIS IS A CALC-TYPE COMMAND * 1 BIT -- SET IF INDENTING IS ALLOWED AFTER THIS COMMAND * 1 BIT -- SET IF THIS COMMAND MAY NOT BE INDENTED * 1 BIT -- FLAG FOR CONTINUED COMMAND * 12 BITS -- INDEX TO NAME TABLE FOR THIS COMMAND * 18 BITS -- ADDRESS OF CONDENSE ROUTINE * -- FOR OVERLAYED COMMANDS, THIS FIELD * CONTAINS THE OVERLAY NUMBER AND AN * ARGUMENT FOR THE OVERLAY. * 12 BITS -- COMMAND NUMBER FOR THIS COMMAND * THE COMMAND NUMBER AND INDEX TO NAME TABLE FIELDS * ARE INITIALIZED IN FILE DEFCCOM. SPACE 1 ENTRY COMINFO COMINFO BSS 0 LOC 0 DEFINE COMMAND NAMES LIST M,G JMP1 HERE LIST * LOC *O RETURN TO ORIGIN COUNTER * /--- BLOCK COMNDS 00 000 81/07/14 00.07 * * DATOT= EQU DATAOUT= NO 8 CHAR EXTERNAL SYMBOLS IFERR= EQU IFERROR= ZAT= EQU AT=+1 FOR EMBEDDED AT (LOADER PROB) SHOWS= EQU SHOW= BACKG= EQU BACKGND= ARHDA= EQU ARHEADA= * ENTRY BRKCMD ENTRY CALCNAM ENTRY HOLDEFN ENTRY USENAM ENTRY UNITNAM,UNITPNM,ENTRYNM ENTRY STPSNAM ENTRY STRTNAM ENTRY STOPNAM ENTRY MTUTNAM ENTRY DATAON=,IEUEND= ENTRY PAUSE= ENTRY KERMIT= ENTRY WRITE0= ENTRY WRITE1= ENTRY WRITE2= ENTRY WRITE3= ENTRY WRITE4= ENTRY WRITEC= ENTRY SHOW= ENTRY SHOWS= ENTRY SHOWT= ENTRY SHOWA= ENTRY SHOWO= ENTRY SHOWH= ENTRY SHOWE= ENTRY SHOWZ= ENTRY SHOWK= ENTRY HIDDEN= ENTRY ZAT= ENTRY ATNM= ENTRY SIZE= ENTRY ROTATE= ENTRY STORE= ENTRY ARHDA= $$ ARHEADA= IS TOO LONG ENTRY UNITOP= ENTRY ARGS=,CALC= ENTRY DO=,DOJ=,DOC=,JOIN=,JOINC=,JDO= * * FOLLOWING FOR PUT OVERLAY ENTRY PUT= ENTRY MISCON= NEEDED TO SEPARATE CONCEPT/MISCON IN ANSIN * FOR -DATAOUT- OVERLAY ENTRY DATOT= * FOR -IFERROR- OVERLAY ENTRY IFERR= ENTRY DOR= ENTRY JOINR= ENTRY STOP1= ENTRY COLOR= END