EXEC2 * /--- FILE TYPE = E * /--- BLOCK EXEC2 00 000 74/10/08 23.11 IDENT EXEC2 TITLE TUTOR EXECUTION-INTERPRETER * * GET COMMON SYMBOL TABLE * CST * * * /--- BLOCK ENTRY/EXT 00 000 78/12/18 21.20 TITLE ENTRY/EXTERNAL * * EXT ECSPRTY ECS PARITY ERROR RECOVERY EXT BOUNDS,WORDS,PROCESS,PROCO,PROC,RCTOXY,GETN EXT PROCESX EXT VARCNT,GETCODX,ILOC EXT VARADD,EXECSAV EXT GET2,CUNIT EXT XSLICE EXT FSTOTOA FOR *OTOA * COMMAND (TUTSUB) EXT TFIN EXT WINDOW EXT CLRFIO CLEAR FILE ACTIVITY MARKER EXT ERROROF EXT ERXMXL EXT ERXSTU EXT ERXFVAL EXT ERXVAL EXT ERXHSEG EXT TOOMUCH EXT ERXOUTP EXT ERXSTOL EXT ERXBADL EXT DEVSYS * * ENTRY DRAWX,RDRAWX,GDRAWX ENTRY BLOCKX ENTRY CODOUTX ENTRY TABX ENTRY COPYX,JKEYX,DATEX,CLOCKX ENTRY PLAYX,MIKEX ENTRY ENABLEX,DISABLX ENTRY DELAYX,AFONTX ENTRY CHECKX,NAMEX,GROUPX,DAYX,ZEROX,ZEROXX ENTRY EDITX ENTRY BUMPX,CODEX ENTRY SYSLESX ENTRY RETRNX,ZFILLX,CPULIMX ENTRY RETRN * /--- BLOCK DRAW 00 000 80/05/17 17.25 TITLE -DRAW- COMMAND * * * EXECUTION ROUTINE FOR -DRAW- COMMAND * * DRAWX SA1 MOUTLOC SEE IF MOUT BUFFER TOO FULL SX1 X1-MOUTLTH+133 TEMP FIX BY KELSO/S * 5/17/80 NG X1,DRAWX2 IF ROOM SA5 A5+1 BACK UP COMMAND POINTER EQ XSLICE END THIS TIME SLICE * DRAWX2 SA1 TBWNDOW WINDOWING IS SLOW AND NZ X1,DRAWINDO CANT USE THIS ROUTINE. BX6 X5 ALL PACKED UP FLAG=BIT 58 LX6 1 NG X6,SFDRAW IF CONSTANT, NON WINDOWED DRAW AX6 1+60-XCODEL GET NO. OF VARS TO DECODE SX6 X6+1 ADD 1 TO INCLUDE COUNT ITSELF RJ GETCODX GETVAR CODES IN VARBUF SA2 VARCNT SX7 X2-1 SA7 A2 CORRECT VARCNT * * MOUT HEADER SHOULD ALWAYS BE CORRECT, IN CASE THERE * IS AN EXEC ERROR IN EVALUATING A TAG, AND THE EXEC * ERROR ROUTINE DOESN'7T ZERO THE MOUT COUNT. * SA1 MOUTLOC SX7 10000B+SKPCODE LENGTH + HEADER CODE + PL X5,*+1 IF NOT CONTINUED SX7 10000B+CDWCODE CONTINUED DRAW HEADER + SA7 MOUT+X1 OUTPUT HEADER SX6 A7 SA6 ILOC ILOC -> HEADER FOR UPDATING SX6 X1+1 INCREMENT MOUT POINTER SA6 A1 SX6 0 1ST ARGUMENT SA6 ERXARGN SET EXECERR ARGUMENT NUMBER SX1 VARBUF+1 FIRST VARIABLE ADDRESS * * GET NEXT GETVAR CODE --- X1-> THE GETVAR CODE * DRAWX5 SA2 ERXARGN INC EXECERR ARG NUMBER SX6 X2+1 SA6 A2 SA2 X1 X2 = THIS GETVAR CODE SX6 X1+1 -> NEXT GETVAR CODE SA6 VARADD MX6 2 MASK AND SKIP FLAG BX5 -X6*X2 GETVAR CODE IN TOP OF X5 BX2 X6*X2 TYPE OF CODE BITS IN X2 LX2 2 SB2 X2 00=COARSE, 01=FINE, JP *+1+B2 10=PACKED FINE, 11=SKIP + EQ CGDRAW COARSE GRID VERTEX + EQ FGDRAW FINE GRID VERTEX + MX0 XCODEL PACKED FINE GRID BX6 X0*X5 ONLY WANT X/Y + LX6 18+2 POSITION SKIP AND PACKED FINE EQ DRAWX6 * * COARSE GRID VERTEX --- CGDRAW NGETVAR ROW-COLUMN ARGUMENT IN X1 CALL RCTOXY MX0 -9 BX6 -X0*X6 LX6 9 BX7 -X0*X7 BX6 X6+X7 EQ DRAWX6 * /--- BLOCK DRAW 00 000 78/05/17 20.53 * * FINE GRID VERTEX --- FGDRAW NGETVAR GET X VALUE BX6 X1 SA6 ILOC+1 SAVE X VALUE SA1 VARCNT DECREMENT VARIABLE COUNT SX6 X1-1 SA6 A1 SA1 VARADD X1 = CURRENT *VARBUF* ADDRESS SA2 X1 X2 = -GETVAR- CODE FOR Y-COORD SX6 X1+1 X6 -> NEXT -GETVAR- CODE SA6 A1 BX5 X2 NGETVAR GET Y VALUE MX0 -9 BX7 -X0*X1 SA1 ILOC+1 RETREIVE X VALUE BX6 -X0*X1 LX6 9 BX6 X6+X7 PUT X AND Y TOGETHER * EQ DRAWX6 * * X6= X/Y COORD, OR SKIP INDICATOR DRAWX6 SA1 MOUTLOC CURRENT OUTPUT POINTER SA6 MOUT+X1 STORE X/Y SX7 X1+1 UPDATE MOUTLOC POINTER SA7 A1 SA1 ILOC X1 -> MOUT HEADER SA1 X1 X1 = MOUT HEADER SX7 10001B ADD TO BOTH COUNTS LX7 12 IX7 X1+X7 SA7 A1 SA1 VARCNT UPDATE COUNT OF VARIABLES LEFT SX7 X1-1 ZR X7,DRAWX9 IF ALL DONE SA7 A1 SA1 VARADD X1->NEXT GETVAR CODE EQ DRAWX5 AND GET NEXT GETVAR CODE * * DONE WITH DRAW, X6=LAST X/Y POINT (MAY NOT BE SKIP) * DRAWX9 MX0 -9 UPDATE NX/NY BX7 -X0*X6 LX6 -9 BX6 -X0*X6 SA6 NX SA7 NY EQ PROCESX * ************************************************************ * /--- BLOCK SFDRAW 00 000 75/10/17 23.15 EJECT * * * * SUPER FAST DRAW --- JUST OUTPUT AND SET NX,NY * PRE EXECUTION FOR DRAW GUARANTEES NO MOUT OVERFLOW * * OUTPUT MOUT HEADER AND COUNT OF CODES --- * SFDRAW BX1 X5 LX1 XCODEL SX1 X1 X1 = COUNT SX0 SFDCODE HEADER CODE LX1 24 BX0 X0+X1 COMBINE COUNT WITH HEADER CODE LX1 -24 SHIFT BACK TO POSITION SA4 MOUTLOC X4 = POINTER INTO MOUT BUFFER SX2 X4+1 ADVANCE MOUT POINTER BX6 X5 LX6 2*XCODEL FIRST TAG IN LOW 20 BITS * CONTINUED DRAW FLAG=TOP BIT IN MIDDLE 20 SX1 X1+2-1 PRETEND 3 POINTS IN FIRST WORD LX5 -XCMNDL MX7 2*XCODEL+XCMNDL BX5 -X7*X5 X5 = EXTRA STORAGE POINTER * * WORDS FOLLOWING HEADER CONTAIN PACKED UP DRAW POINTS * SFDRAW1 SA6 MOUT+X2 OUTPUT NEXT SET OF WORDS SX2 X2+1 AND ADVANCE MOUT POINTER SX1 X1-3 NG X1,SFDRAW2 SA3 B5+X5 NEXT EXTRA STORAGE WORD BX6 X3 SX5 X5+1 EQ SFDRAW1 * SFDRAW2 BX7 X2 UPDATE MOUT POINTER SA7 A4 IX2 X2-X4 COMBINE COUNT OF WORDS LX2 12 BX7 X0+X2 WITH MOUT HEADER SA7 MOUT+X4 AND STORE OUTPUT HEADER SB1 X1+3 FIND WHERE IN WORD LAST TAG IS JP *+1+B1 + LX6 -XCODEL WAS IN TOP, NOW IN MIDDLE + LX6 -XCODEL WAS IN MIDDLE, + MX0 -9 NOW IN BOTTOM BX7 -X0*X6 NEW NY LX6 -9 BX6 -X0*X6 NEW NX SA7 NY SA6 NX EQ PROCESS * /--- BLOCK WINDBUF 00 000 86/12/08 08.36 TITLE WINDBUF - OUTPUT WINDOWED LINES * * WINDBUF --- OUTPUT A WHOLE BUFFER OF WINDOWED LINES * * ON ENTRY--- * TOP BIT OF X5 SET IF CONTINUED DRAW * X1 -> FIRST WORD OF BUFFER TO OUTPUT * X2 = NUMBER OF WORDS IN BUFFER * END POINTS OF LINES ARE IN PAIRS OF WORDS (X,Y) * -SKIP- IS INDICATED BY TOP TWO BITS 1, REST 0 * ON EXIT --- * LINES ARE PLACED IN THE MOUT BUFFER, MOUTLOC UPDATED * NX, NY UPDATED TO END OF DRAWN LINES * * CALLED FROM LINCHR AND DRAWS * ENTRY WINDBUF * WINDBUF EQ * ZR X2,WINDBUF NG X2,WINDBUF BX6 X1 SAVE -> BUFFER BX7 X2 SAVE COUNT OF ENTRIES SA6 WINDA SA7 WINDB NG X5,FIGF1 IF -AT- NOT NEEDED * FIGF0 SA1 WINDA SX7 X1+2 INCREMENT POINTER SA7 A1 SA1 X1 BX6 X1 SA6 NX SET BEGINNING X SA2 A1+1 BX6 X2 SA6 NY SET BEGINNING Y MX7 -9 BX1 -X7*X1 MASK TO 9BITS BX2 -X7*X2 MX4 2 CHECK FOR REDUNDANT -SKIP- BX4 X1-X4 ZR X4,FIGF1.1 IF -SKIP- LX1 9 BX1 X1+X2 PACK UP X AND Y OUTCODE WFCODE OUTPUT FINE WHERE SA2 WINDB SX7 X2-2 SA7 A2 ZR X7,WINDBUF * * /--- BLOCK WINDBUF 00 000 86/12/08 08.38 FIGF1 SA1 WINDA GET POINTER SX7 X1+2 INCREMENT POINTER SA7 A1 SA3 X1 GET NEXT VALUE MX4 2 CHECK FOR -SKIP- OPTION BX4 X3-X4 NZ X4,FIGF1S FIGF1.1 BSS 0 SA2 WINDB SX7 X2-2 GOING TO SKIP SA7 A2 NZ X7,FIGF0 EXECERR 115 CANNOT END WITH -SKIP- ('/'/) * FIGF1S SA4 A3+1 SA1 TBWNDOW GET WINDOWING FLAG BX0 X1 X0 = WINDOW INFO SA1 NX BEGINNING X SA2 NY BEGINNING Y BX6 X3 SA6 A1 UPDATE X BX6 X4 SA6 A2 UPDATE Y RJ WINDOW NZ X0,FIGF3 JUMP IF WINDOWED LINE DRAWN * LX3 9 BX1 X3+X4 PACK UP X AND Y OUTCODE LFCODE OUTPUT FINE LINE FIGF3 SA2 WINDB GET COUNT SX7 X2-2 SA7 A2 DECREMENT COUNT NZ X7,FIGF1 LOOP EQ WINDBUF * WINDA BSS 1 WINDB BSS 1 * * /--- BLOCK SINCOS 00 000 75/11/21 18.58 TITLE SINCOS * * FIND SIN AND COS OF AN ANGLE * * ON ENTRY -- * X6 = ANGLE (IN RADIANS) * * ON EXIT -- * X6 = SINE OF ANGLE * X7 = COSINE OF ANGLE * * CALLED FROM LINWRT AND DRAWS * ENTRY SINCOS SINCOS EQ * SA6 SINCOSA SAVE ANGLE BX1 X6 TSIN EXPECTS ARG IN X1 CALL TSINX BX7 X1 SINE COMPUTED SA1 SINCOSA RESTORE ANGLE SA7 A1 SAVE SINE CALL TCOSX BX7 X1 X7 = COSINE SA1 SINCOSA BX6 X1 X6 = SINE EQ SINCOS * SINCOSA BSS 1 TEMPORARY WORD * * /--- BLOCK RDRAW 00 000 85/01/31 13.30 TITLE -RDRAW- / -GDRAW- COMMANDS * * * * -RDRAW- COMMAND * RDRAWX MX6 -1 FLAG -RDRAW- EQ DRAWIN1 * * * * -GDRAW- COMMAND * GDRAWX SX6 1 FLAG -GDRAW- DRAWIN1 SA1 MOUTLOC SEE IF MOUT BUFFER TOO FULL SX1 X1-MOUTLTH+70 63 ARGS MAX NG X1,DRAWIN2 IF ROOM SA5 A5+1 BACK UP COMMAND POINTER EQ XSLICE END THIS TIME SLICE * * * * WINDOWED DRAW CANT USE THE FAST DRAW ROUTINE * DRAWINDO SX6 0 FLAG -DRAW- DRAWIN2 SA6 OVARG1 (ALREADY CHECKED FOR MOUT ROOM) EXEC DRAWS,NDRAWOV * * /--- BLOCK BLOCK 00 000 78/07/05 01.16 TITLE BLOCK * -BLOCK- (CODE=102) * * TRANSFER BLOCK OF VARIABLES * TRYING TO TRANSFER MORE THAN * TEMPLTH VARIABLES CAUSES AN * EXECUTION ERROR. * GETS LENGTH FIRST TO AVOID PHONY ARRAY * BOUNDS ERRORS WHEN LENGTH IS 0. * * BLOCKX AX5 XCMNDL MX0 -XSPTRL BX5 -X0*X5 SA1 B5+X5 GET XTRA WORD BX5 X1 NGETVAR ZR X1,PROCESS --- DONE IF LENGTH = 0 SB1 X1 LENGTH SB2 B1-TEMPLTH-1 PL B2,BERXBIG WILL IT FIT SA5 A5 BX6 X1 SA6 ILOC SAVE LENGTH NGETVAR SX6 A1 SA6 ILOC+1 SAVE FROM ADDRESS SA5 A5 LX5 XCODEL NGETVAR SX2 A1 (X2) = TO ADDRESS SA1 ILOC (X1) = LENGTH SA0 X2 RJ BOUNDS CHECK LEGALITY OF TO ADDRESSES SA3 ILOC+1 (X3) = FROM ADDRESS SA0 X3 RJ BOUNDS CHECK LEGALITY OF ADDRESSES SA4 ATEMPEC ADDRESS OF ECS TEMPORARY BUFFER BX0 X4 SB1 X1 LENGTH (A0=FROM ADDRESS) WE B1 RJ ECSPRTY SA0 X2 TO CENTRAL ADDRESS RE B1 RJ ECSPRTY EQ PROCESS --- DONE * BERXBIG SX2 TEMPLTH EXECERR 116 * /--- BLOCK ZERO 00 000 78/12/21 18.27 * TITLE ZERO, ADD1, SUB1 * -ZERO- * * ZERO SPECIFIED VARIABLE * ZEROX MX6 0 NPUTVAR STORE A ZERO IN SPECIFIED VAR EQ PROC * * * -ZERO- COMMAND * USES ZEROED ECS BUFFER TO CLEAR A BLOCK * ZEROXX NGETVAR SX6 A1 SAVE STARTING ADDRESS SA6 EXECSAV SA5 A5 LX5 XCODEL POSITION NEXT -GETVAR- CODE NGETVAR ZR X1,PROC --- EXIT IF LENGTH=0 SA2 EXECSAV SA0 X2 ADDRESS OF FIRST VAR TO ZERO RJ BOUNDS SB3 X1 LENGTH MUST BE CONST OR *B* REG SX1 A0 MOVE TO *X1* BECAUSE OF -ZERO- ZERO X1,B3 CLEAR OUT VARIABLES EQ PROC * /--- BLOCK CODEOUT 00 000 76/08/02 23.06 TITLE CODEOUT, WINDOW * -CODEOUT- (CODE=112) * * THE TAG SPECIFIES THE 6 BIT CODE TO BE OUTPUT * AFTER AN UNCOVER CODE. * CODOUTX NGETVAR ROUNDS TO INTEGER IN X1 OUTPUT CODCODE EQ PROC * * /--- BLOCK RETURN 00 000 80/02/15 22.12 TITLE -BREAK- * * -BREAK- (CODE=268) * ENTRY RETRNZ RETRNZ SA5 A5+1 BACK-UP COMMAND POINTER * RETRNX BSS 0 ENTRY POINT FOR -BREAK- RETRN SA1 SCOMFLG PL X1,RTX2 JUMP IF NO STATISTICS CALL POSTCMS TAKE COMMAND STATISTICS * RTX2 CALL TFIN END THIS TIME SLICE CALL USV UPDATE SCREEN VARIABLES EQ PROCESS TITLE -TABSET- COMMAND * * * -TABSET- (CODE=269) * TABX NGETVAR GET THE TABSETS BX6 X1 SA6 TBTAB STORE EQ PROC * /--- BLOCK COPY 00 000 77/10/20 20.23 TITLE -COPY- * -COPY- (CODE=130) * * ENABLE COPY KEY. * COPY UP TO COUNT SET BY SECOND ARGUMENT * OR UNTIL A ZERO IS FOUND. * COPYX NGETVAR GET THE COPY STRING ADDRESS SX6 A1 SX7 STUDVAR+VARLIM IX7 X6-X7 PL X7,ERXSTU ERROR IF NOT IN STUDENT VARS SA6 ILOC SAVE ADDRESS SA5 A5 RESTORE LX5 XCODEL NGETVAR GET NUMBER OF CHARS ZR X1,PROC SA3 ILOC RETRIEVE ADDRESS SA0 X3 SET UP FOR -WORDS- CALL WORDS DO BOUNDS CHECK LX3 18 SHIFT ADDRESS BX6 X1+X3 LX6 18 SA6 TBCOPY THEN STORE AWAY IN TBCOPY EQ PROC TITLE -JKEY- COMMAND * * * -JKEY- (CODE=131) * * SET BITS TO SPECIFY WHICH KEYS MAY INITIATE JUDGING * JKEYX MX7 60-XCMNDL DISCARD COMMAND BITS BX7 X7*X5 SA1 TJKEYS PICK UP PRESENT SETTING ZR X7,JKEYX1 CLEAR IF BLANK COMMAND BX7 X1+X7 JKEYX1 SA7 TJKEYS SET TERMINAL BANK WORD EQ PROC * /--- BLOCK BUMP 00 000 75/10/01 17.29 TITLE BUMP * -BUMP- (CODE=133) * * THE LOGIC OF THIS COMMAND IS-- * X5 HOLDS CHARS OF TAG L-JUS, ZEROS RIGHT. * COMMAND SEARCHES FOR MATCHES OF TAG CHARS * THROUGH JUDGE BUFFER. TAG CHARS ARE SHIFTED * CIRCULARLY, AND NEVER REQUIRE A MEMORY FETCH. * BUMPX MX7 48 BX5 X5*X7 8 CHARS MAX, 0 FOR END TEST SB1 1 UNIVERSAL INCREMENT CONSTANT SB2 B0 INDEX FOR LOADING SB3 B0 INDEX FOR STORING MX0 -6 MASK FOR CHAR BX4 X5 X4 = TAG CHARS FOR TESTING * BMP1 SA1 JUDGE+B2 NEXT CHAR FROM ANSWER ZR X1,BMP5 IF END OF ANSWER * BMP2 LX4 6 GET NEXT TAG CHAR BX6 -X0*X4 ZR X6,BMP3 IF END OF TAG CHARS BX6 X6-X1 CHECK CHAR NZ X6,BMP2 IF NO MATCH, TRY NEXT CHAR SB2 B2+B1 INCREMENT LOAD INDEX BX4 X5 RESTORE ORIGINAL TAG EQ BMP1 * BMP3 EQ B2,B3,BMP4 IF NOTHING FOUND YET SA2 JJCHAR+B2 BX6 X1 BX7 X2 SA6 JUDGE+B3 SA7 JJCHAR+B3 BMP4 SB2 B2+B1 INCREMENT LOAD INDEX SB3 B3+B1 INCREMENT STORE INDEX BX4 X5 RESTORE ORIGINAL TAG EQ BMP1 GET NEXT CHAR OF ANSWER * * END OF ANSWER * BMP5 EQ B2,B3,PROCESS --- RETURN IF NO CHANGE MX6 -1 MX7 0 SA6 JJSTORE TO TELL -STORE- COMMAND TO RECOMPILE ANSWER SA7 JJFBUF MARK ANSWER MODIFIED MX6 0 SX7 B3 SA6 JUDGE+B3 SET 0 FOR END TEST SA7 TJCOUNT RESET ANSWER LENGTH EQ PROCESS --- RETURN * /--- BLOCK EDIT 00 000 77/07/20 17.05 TITLE -EDIT- * EDIT COMMAND * THE AUTHOR ASSIGNS A BUFFER TO BE USED BY * STUDENT UPON PUSHING THE EDIT KEY. * NO ARG OPTION CLEARS THE FLAG TO NO ACTION. * ARG OPTION SETS ACTIVE AND POINTS TO BUFFER * IN TUTOR VARIABLES. * EDITX PL X5,EDITX1 SEPARATE CASES MX6 0 SA6 TBEDIT CLEAR TO INACTIVE EQ PROC EDITX1 NGETVAR GET THE EDIT BUFFER ADDRESS SX6 A1 SX7 STUDVAR+VARLIM LAST LEGAL ADDRESS + 1 IX7 X6-X7 PL X7,ERXSTU JUMP IF OUT OF STUDENT BANK LX6 36 SHIFT UP SA6 TBEDIT AND STORE FOR USE DURING EDIT OPTION EQ PROC * /--- BLOCK DATE 00 000 80/06/10 14.16 TITLE -DATE- * -DATE- (CODE=136) * * STORES THE CURRENT DATE (AS READ FROM NOS * LOWCORE ) IN THE SPECIFIED VARIABLE. * DATEX NGETVAR A1 = VARIABLE STORAGE ADDRESS SX6 A1 SA6 ILOC CALL S=TDATE,ITEMP READ TIME/DATE SA1 ITEMP+1 SA2 ILOC BX6 X1 SA6 X2 STORE DATE EQ PROCESS --- RETURN TITLE -CLOCK- COMMAND * * * * -CLOCK- (CODE=137) * CLOCKX NGETVAR A1 = VARIABLE STORAGE ADDRESS SX6 A1 SA6 ILOC CALL S=TDATE,ITEMP READ TIME/DATE SA1 ITEMP SA2 ILOC BX6 X1 SA6 X2 STORE TIME EQ PROCESS --- RETURN TITLE -DAY- COMMAND * * * -DAY- * * * DAY RETURNS THE NUMBER OF ELAPSED DAYS * FROM JAN. 1, 1973'; 2400 HOURS DEC 31,1972 * MARKS THE BEGINNING OF DAY 0. * * THE NUMBER OF ELAPSED DAYS + FRACTIONAL DAYS * IS STORED IN THE ADDRESS PROVIDED BY THE CALL. * * * DAYX CALL JULIAN GET JULIAN DATE TO X6 FPUTVAR STORE WHERE NEEDED, IN REQUIRED TYPE (I/F) EQ PROCESS * * * * -JULIAN- * RETURNS JULIAN DATE IN X6 (FLOATING) * * USES A - 2, 3, 4. * X - 2, 3, 4, 6. * * ENTRY JULIAN JULIAN EQ * SA2 MSCLCK0 *SYSCLOCK* VALUE AT LOAD TIME SA4 SYSCLOK GET MS CLOCK MX3 24D BX4 -X3*X4 MASK CLOCK TO 36 BIT INTEGER IX4 X4-X2 PX4 X4 FLOAT NX4 X4 AND NORMALIZE SA2 MSPDAY SA3 DAY0 *DAY* AS CALCULATED AT LOADTIME FX4 X4/X2 MS TO DAYS FX6 X4+X3 UPDATE (DAY) EQ JULIAN * * MSPDAY DATA 86400000. MILLISECONDS PER DAY * /--- BLOCK PLAY 00 000 84/01/09 16.55 TITLE -PLAY- -RECORD- * -PLAY- (CODE=140) * * PLAYS AUDIO MESSAGE STARTING AT TRACK/SECTOR * GIVEN BY 3D TAG FIELD * PLAYX SX6 3 DECODE 3 TAGFIELDS RJ GETN GET VALUES IN VARBUF(N-1) SX3 40000B PLAYBACK CODE PLAYX2 SA1 VARBUF GET STARTING TRACK AND SA2 VARBUF+1 SECTOR NUMBER INTO X1,X2 MX0 55 BX2 -X0*X2 MAKESURE ONLY 5BIT SECTOR MX0 53 BX1 -X0*X1 AND 7BIT TRACK FIELD LX1 5 SHIFT TRACK PAST SECTOR BX1 X1+X2 COMBINE TRACK,SECTOR, AND BX1 X1+X3 CODE INTO X1 OUTCODE AUDCODE SEND OUT AUDIO START WORD SA1 VARBUF+2 GET LENGTH TAG MX0 46 ALLOW BOTTOM 14 BITS IN SECOND WORD BX1 -X0*X1 SX0 1 AND KILL BIT 8 FOR SOME NEW AUDIOS LX0 7 BX1 -X0*X1 OUTCODE AUDCODE SEND OUT AUDIO LENGTH WORD EQ PROCESS * * * * -RECORD- (CODE=141) * * RECORDS AUDIO MESSAGE AT STARTING TRACK/SECTOR * MIKEX SX6 3 DECODE 3 TAGFIELDS RJ GETN GET VALUES IN VARBUF(N-1) SX3 60000B RECORD CODE EQ PLAYX2 SEND AUDIO START+LENGTH WORD * /--- BLOCK ENABLE 00 000 77/11/11 00.16 TITLE -ENABLE- -DISABLE- * * * * -ENABLE- AND -DISABLE- COMMANDS * ENABLEX MX6 3 CHOOSE ENABLE FUNCTION BITS BX1 X5*X6 ZR X1,ENA100 JUMP IF NEITHER TOUCH/EXT PL X1,ENA050 -- IF NOT -ORIENTAL- SA2 STFLAGS LX2 60-ORIBIT MOVE ORIENTAL MODULE TO SIGN PL X2,PROC -- IGNORE IF SHOULDN'7T ENABLE ENA050 LX1 ENABLO-24 POSITION BITS IN *ENABLBS* OUTCODE SETCODE * ENA100 SA5 A5 LX5 3 MOVE *EXTMAP* BIT TO SIGN PL X5,PROC EXIT IF *EXTMAP* NOT SELECTED MX6 1 LX6 EXTMBIT POSITION *EXTMAP* BIT SA1 STFLAG1 BX6 X1+X6 SET BIT IN /STATION/ WORD SA6 A1 EQ PROC * * DISABLX MX6 3 CHOOSE DISABLE FUNCTION BITS BX1 X5*X6 ZR X1,DISA100 JUMP IF NEITHER TOUCH/EXT LX1 ENABLO-24 POSITION BITS IN *ENABLBS* OUTCODE CLRCODE * DISA100 SA5 A5 LX5 3 MOVE *EXTMAP* BIT TO SIGN PL X5,PROC EXIT IF *EXTMAP* NOT SELECTED MX6 1 LX6 EXTMBIT POSITION *EXTMAP* BIT SA1 STFLAG1 BX6 -X6*X1 CLEAR BIT IN /STATION/ WORD SA6 A1 EQ PROC * * /--- BLOCK DELAY 00 000 78/04/25 20.18 TITLE DELAY * -DELAY- (CODE=181) * * SENDS NUMBER OF NO-OP CODES REQUIRED TO MAKE UP * SPECIFIED DELAY TIME * * DELAYX FGETVAR DELAY IN SECONDS BX6 X1 SAVE THE ARG FOR EXECERR SA6 DLYSAVE SA2 =57.1429 TERMINAL WORDS / SECOND FX1 X1*X2 COMPUTE NUMBER NO-OPS REQUIRED SA2 =.5 FX1 X1+X2 ROUND NX1 X1 UX1 X1,B1 LX1 X1,B1 NG X1,DERXVAL --- ERROR EXIT IF COUNT IS NEGATIVE *** NOTE'; IF YOU CHANGE THE TIME LIMIT, YOU MUST CHANGE *** THE EXECUTION ERROR MESSAGE SX2 64 SLIGHTLY OVER 1 SECOND IX2 X1-X2 PL X2,DLERXLNG --- LONG DELAYS ARE ILLEGAL SA2 DELAYED IX6 X1+X2 ACCUMULATE DELAY SA6 A2 OUTCODE NOPCODE SA1 DELAYED SX2 X1-228 SEE IF FOUR SECONDS OR MORE NG X2,PROCO EQ RETRNX WAIT FOR OUTPUT TO FINISH * * ENTRY DELAYED DELAYED BSS 1 TOTAL DELAY THIS TIME-SLICE * DLYSAVE BSS 1 FOR EXECUTION ERRORS * DLERXLNG SA1 DLYSAVE EXECERR 94 DELAY TOO LONG * DERXVAL SA1 DLYSAVE EQ ERXFVAL DELAY TOO SHORT * /--- BLOCK ALTFONT 00 000 84/01/09 16.57 TITLE -ALTFONT- * * * * -ALTFONT- (CODE=201) * * SETS *CSET* SO ALL FOLLOWING WRITING OCCURS * FROM ALTERNATE FONT (1) OR NORMAL FONT (0). * * ENTRY AFONTX * AFONTX NGETVAR SX0 1 LX0 3+7+18 FORM ALTFONT BIT FOR SIZE WRITE SA2 TBWRITE NZ X1,AF100 JUMP IF -ALTFONT ON- BX6 -X0*X2 CLEAR ALTFONT BIT EQ AF200 * AF100 BX6 X0+X2 SET ALTFONT BIT AF200 SA6 A2 OUTCODE AMSCODE 0=NORMAL, 1=ALTERNATE EQ PROC * * * /--- BLOCK CODE 00 000 85/01/31 13.30 TITLE -CODE- AND -CHECK- * * -CODE- COMMAND * CODEX NGETVAR BX6 X1 SA6 TAUCODE SAVE FOR REST OF SESSION EQ PROC * * /--- BLOCK CHECK 00 000 81/06/15 23.03 * * CHECK COMMAND * * CHECK (BLANK) RETURNS A VALUE OF -1 TO X * IN *ERROR* DEPENDING ON THE GROUP OF THE USER. * *ZRETURN* IS SET THE SAME AS *ERROR*. * * CHECK (ARG) RETURNS -1 IN *ERROR* IF THE USERS * CODEWORD, GROUP, OR ACCOUNT AGREES WITH THE * ARGUMENT; *ZRETURN* IS SET TO -1 ALSO. * IF THERE IS NO AGREEMENT, A LIST OF SPECIAL * STATIONS IS SEARCHED. IF THIS STATION IS FOUND * IN THE LIST, *ZRETURN* IS SET TO 0 AND *ERROR* * IS SET AS IN THE NO ARGUMENT CASE. IF THE STATION * IS NOT FOUND, *ZRETURN* IS 0 AND *ERROR* IS 100. * * CHECKX NG X5,CKNOARG BRANCH IF NO ARGUMENT NGETVAR * RJ CHECODE CODE IS IN X1 ZR X6,CHECK3 IF NO MATCH * SX6 -1 SA6 TERROR SA6 TRETURN EQ PROC * * * IF NO MATCH, SEE IF AT A SPECIAL STATION. * ZSSLST IS START OF SPECIAL STATIONS BIT TABLE IN ECS * ONE SITE PER WORD, MSB = STATION ZERO. * CHECK3 MX6 0 SA6 TRETURN SET ZRETURN 0 * SA1 STATION SX2 X1-LSTUD ZR X2,CKSCHK CONSOLE IS ALWAYS SPECIAL MX2 -5 BX2 -X2*X1 GET STATION IN X2 AX1 5 AND SITE IN X1 SA3 AZSSLST START OF BIT TABLE IN ECS IX0 X3+X1 RX3 X0 (-RXX- 1 WD READ, MAY CHG *A3*) SX6 100 ASSUME NOT SPECIAL SB2 X2 STATION NUMBER LX3 X3,B2 PL X3,CKSCHK2 NOPE, RETURN *ERROR* = 100 CKSCHK CALL SYSCOR ELSE CHECK FOR SYSTEM GROUP CKSCHK2 SA6 TERROR ZRETURN ALREADY SET TO 0 EQ PROC * * BLANK-TAG -CHECK- * -- LOOK FOR SYSTEM GROUP * CKNOARG CALL SYSCOR CHECK FOR SPECIAL GROUP SA6 TERROR SA6 TRETURN EQ PROC * * /--- BLOCK CHECODE 00 000 79/04/07 00.40 TITLE CHECK EDITING CODE * ** ROUTINE CHECODE * * CHECKS CODE IN X1 AGAINST AUTHORS EDITING CODE, * HIS GROUP, AND ACCOUNT. * * ON EXIT -- * X6 = -1 IF MATCH * 0 IF NO MATCH * * 'USES X0,X1,X2,X3,X6;A0,A2,A3 * ENTRY CHECODE * CHECODE EQ * ZR X1,CKX1 BRANCH IF BLANK CODE SA2 TAUCODE PICK UP AUTHORS EDITING CODE MX6 6 BX6 X6*X2 ZR X6,CKX2 DON'7T ALLOW LEADING ZERO CODES BX3 X1-X2 NZ X3,CKX2 NG X3,CKX2 CATCH COMPLEMENT CASE * CKX1 SX6 -1 MATCH EQ CHECODE * CKX2 RJ CHEKGRP CHECK FOR GROUP CODEWORD EQ CHECODE * * * * CHEKGRP * * 'THIS ROUTINE CHECKS THE CODEWORD SPECIFIED * TO SEE IF IT IS AN ACCEPTABLE GROUP CODEWORD-- * GROUP OR ACCOUNT OF USER (THE ACCOUNT NAME IS * RIGHT SHIFTED 18 BITS, THE GROUP NAME 12 BITS). * * 'ON ENTRY -- * X1 = CODEWORD * * 'ON EXIT -- * X6 = -1 IF MATCH * 0 IF NO MATCH * * 'USES X0,X1,X2,X3,X6;A0,A2,A3 (X4 ASSUMED NOT USED) * * ENTRY CHEKGRP * CHEKGRP EQ * SX6 0 PRESET TO NO MATCH MX0 6 BX2 X0*X1 CHECK TOP CHAR OF CODE NZ X2,CHEKGRP --- MUST BE 0 IF GROUP CODEWORD LX1 12 SEE IF GROUP BX2 X0*X1 MASK TOP CHAR ZR X2,CHKACC IF ZERO, MAYBE ACCOUNT NAME SA3 STATION GET GROUP OF USER SA2 AGROUP IX0 X3+X2 RX3 X0 (-RXX- 1 WD READ, MAY CHG *A3*) MX0 -12 BX2 X0*X3 MASK TO GET JUST GROUP NAME BX2 X2-X1 COMPARE WITH (SHIFTED) CODEWORD NZ X2,CHEKGRP --- EXIT IF NO MATCH CHKOK SX6 -1 MARK OK EQ CHEKGRP --- EXIT * CHKACC SA3 TACCNAM PICK UP ACCOUNT NAME OF USER LX1 6 TOTAL SHIFT NOW = 18 BX2 X3-X1 ZR X2,CHKOK EQ CHEKGRP --- EXIT IF NO MATCH * /--- BLOCK SYSCOR 00 000 78/11/14 08.10 TITLE -SYSCOR- CHECK FOR SPECIAL GROUP * * * ENTRY SYSCOR SYSCOR EQ * SA1 STATION SA2 AGROUP IX0 X1+X2 RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) SB1 1 MX2 -12 BX6 X1*X2 ZR X6,CKCON IF NO GROUP, CHECK FOR CONSOLE SA6 CHKFIND PLANT USER GROUP AS LAST ENTRY SA2 CKTYPE-1 CKLL SA2 A2+B1 BX3 X6-X2 NZ X3,CKLL SB1 A2 SB2 CKTYPE+1 SX6 B1-B2 EQ SYSCOR * CKCON SA1 STATION CHECK FOR CONSOLE SX2 X1-LSTUD NZ X2,CKNOTC NOT THE CONSOLE * * * * SET CONSOLE PRIVILEDGES SX6 -1 GROUP S FOR DEVELOPMENT SYSTEMS SA2 DEVSYS GET *DEVSYS* NZ X2,SYSCOR IF DEV SYSTEM, RETURN SX6 1 GROUP O FOR NON-DEV SYSTEMS EQ SYSCOR RETURN * CKNOTC SX6 CKLAST-CKTYPE-1 HIGHER THAN ANY SYS GROUP EQ SYSCOR * * CKTYPE DATA 1LS DATA 1LP DATA 1LO DATA 1LM DATA 6LCOSERV DATA 1RX $$ WAS ETSC DATA 3LPSO PRODUCT SERVICE ORGANIZATION CHKFIND CON 0 REQUIRED TO END SEARCH LOOP * CKLAST EQU CKTYPE+7 (CKTYPE + NUMBER ENTRIES) * * /--- BLOCK NAME AND C 00 000 79/10/04 03.52 TITLE -NAME- AND -GROUP- COMMANDS * THE NAME IS 18 CHARS + 12 BITS OF DISK BLOCK NAMEX NGETVAR A1=STARTING STORAGE ADDRESS SA2 TNAME BX6 X2 SA6 A1 SA3 TNAME1 MX7 48 BX7 X7*X3 MASK TO 8 CHARACTERS SA0 A1 SX1 2 RJ BOUNDS SEE THE 2ND WORD IN BOUNDS SA7 A1+1 EQ PROC * * THE GROUP IS 8 CHARS NAME PLUS 12 BITS OF FLAGS * GROUPX NGETVAR SA2 AGROUP ECS ADDRESS OF GROUP BUFFER SA3 STATION ADD BIAS OF THIS STATION IX0 X2+X3 SA0 A1 + RE 1 READ GROUP ENTRY INTO USERS WORD RJ ECSPRTY SA1 A1 MX7 48 BX7 X7*X1 MASK TO 8 CHARACTERS SA7 A1 EQ PROC * /--- BLOCK MODESET 00 000 78/10/27 09.31 TITLE MODESET AND BITSOUT * -MODESET- (CODE=241) * * OUTPUTS SPECIFIED MODE (0-7). INTENDED TO * PERMIT INVESTIGATION OF NEW MODES VIA PDP-11 * SIMULATED TERMINAL. * * ENTRY MODESEX * MODESEX NGETVAR OUTCODE MODCODE CALL ASMBIT SET ASSEMBLY PROGRAM BIT EQ PROC * * * * -BITSOUT- (CODE=249) * * OUTPUTS AN 18 BIT DATA WORD. USEFUL ONLY * IN TESTING NEW MODES (4-7), DATA IS NOT SENT * IF IN A STANDARD MODE (0-3). * * ENTRY BITSOUX * BITSOUX NGETVAR OUTCODE BITCODE EQ PROC * ***** * TITLE ASCII * * -ASCII- * * OUTPUTS AN ASCII CHARACTER. USEFUL ONLY * ON ASCII TERMINALS. * ENTRY ASCIIX ASCIIX BSS 0 SA1 STFLAG1 GET TERM TYPE WORD MX0 -TTBTN SET MASK FOR TERM TYPE FIELD LX1 TTBTN-TTBTS POSITION TERM TYPE FIELD BX0 -X0*X1 GET TERM TYPE SX0 X0-ASCTYPE SEE IF ASCII TERM (ZTTTYPE=12) NZ X0,PROC NOT ASCII TERM, DO NOT EXECUTE * ASEND BSS 0 NGETVAR GET BYTE TO BE SENT OUTCODE ASCCODE EQ PROC * * /--- BLOCK -SYSLESS 00 000 80/07/02 10.13 TITLE SYSLESS * * -SYSLESS- (CODE=288) * ONE ARGUMENT = LESSON TO BE CHECKED * * RETURNS ERROR = -1 IF A SYSTEM LESSON * 0 IF NOT * SYSLESX SX6 2 CALL GETCODX UNPACK GETVAR CODES TO VARBUF CALL ACCFILE,VARBUF,VARBUF,0 CALL PROSRCH,VARBUF LX2 ZSLDSHF GET SYSTEM LESSON BIT MX6 0 PL X2,SYSLEXT 0 = NON-SYSTEM LESSON SX6 -1 -1 = SYSTEM LESSON SYSLEXT SA6 TERROR SA6 TRETURN EQ PROC * * * /--- BLOCK SYSTEST 00 000 85/01/31 13.30 TITLE SYSTEM LESSON LIST SEARCHES * * SYSTEST * * RETURNS X6 = -1 FOR SYSTEM LESSON * 0 FOR NON-SYSTEM * ALSO RETURNS X2 = LESSON DESCRIPTOR BITS * * ENTRY SYSTEST * SYSTEST EQ * CALL PROSRCH,TBLESAC LX2 ZSLDSHF GET SYSTEM LESSON BIT NG X2,SYST1 IF YES LX2 -ZSLDSHF RESTORE BITS MX6 0 EQ SYSTEST * SYST1 SX6 -1 -1 = SYSTEM LESSON LX2 -ZSLDSHF RESTORE BITS EQ SYSTEST * * * /--- BLOCK AIDSLES 00 000 81/01/23 13.51 * * CHECK TO SEE IF CURRENT LESSON IS AN AIDS LESSON. * * THE FILE NAME OF ALL AIDS LESSONS BEGINS WITH * THE LETTER -A- FOLLOWED BY A DIGIT (0-9). * * EXIT (X1) NEGATIVE IF AIDS LESSON * POSITIVE IF NOT * * USES A - 1 * X - 1, 2 ENTRY AIDSLES AIDSLES EQ * SA1 TBLESAC (X1) = ACCOUNT OF CURRENT LESSON LX1 42 SHIFT TO OLD-STYLE FLAG PL X1,AIDSLES IF NOT OLD-STYLE SA1 TBLESSN (X1) = CURRENT LESSON NAME SX2 7777B LX1 12 POSITION 1ST 2 CHARS AT BOTTOM BX2 X2*X1 (X2) = FIRST 2 CHARACTERS SX1 X2-2RA+ SEE IF GREATER THAN -A9- PL X1,AIDSLES IF SO, NOT AN AIDS LESSON SX1 X2-2RA0 SEE IF -A0- OR GREATER BX1 -X1 EQ AIDSLES * * * /--- BLOCK STOPCHK 00 000 81/12/05 05.02 EJECT ** STOPCHK - CHECK FOR SPECIAL STOP1 PROCESSING * * THIS ROUTINE CHECKS TO SEE IF THE LESSON * SPECIFIED BY *TBLESSN* IS ONE OF THE SPECIAL * SYSTEM LESSONS THAT DOES ITS OWN STOP1 KEY * PROCESSING. * * IF PST1BIT IN STFLAG1 IS SET INDICATING A PRIORITY * STOP1, THEN STOP1 PROTECTION FOR THE LESSON IS * OVERRIDDEN (EXCEPT FOR LESSON SYSLIB). * * THE ST1BIT IN STFLAGS IS CLEARED IF THIS LESSON * IS A SPECIAL STOP1 LESSON. * * EXIT (X2) = 0 IF SPECIAL, NON-ZERO OTHERWISE. * * USES A - 2. * B - NONE. * X - 2. * * OTHER REGISTERS ARE USED BUT RESTORED. * * CALLS PROSRCH, SAVE0167, REST0167. * * MACROS NONE. ENTRY STOPCHK STOPCHK EQ * RJ SAVE0167 SAVE REGISTERS SA0 B1 SAVE ORIGINAL (B1) SB1 TBLESAC RJ PROSRCH SB1 A0 RESTORE (B1) ZR X2,NOSTOP IF LESSON NOT FOUND LX2 ZPLDSHF PL X2,NOSTOP SA2 STFLAG1 LX2 60-PST1BIT CHECK FOR PRIORITY STOP1 PL X2,STOPC2 JUMP IF NO SPECIAL PRIORITY CALL LIBTEST,TBLESAC PL X6,NOSTOP -- IF NOT IN SYSLIB LESSON STOPC2 SA1 STFLAGS CLEAR ST1BIT SINCE THIS IS A MX6 1 STOP1 INHIBITED LESSON LX6 ST1BIT BX6 -X6*X1 SA6 A1 RJ REST0167 RESTORE REGISTERS MX2 0 STOP1 OK EQ STOPCHK NOSTOP RJ REST0167 RESTORE REGISTERS MX2 59 EQ STOPCHK * /--- BLOCK SYSLES 00 000 81/12/05 05.03 EJECT ** SYSLES - CHECK FOR NON-DELETABLE SYSTEM LESSONS * * THIS ROUTINE SEARCHES THE PROTECTED LESSON TABLE * FOR A LESSON AND CHECKS TO SEE IF IT IS A SYSTEM * LESSON WITH DELETION PROTECTION. * * ENTRY (B1) = ADDR OF 2-WORD LESSON NAME TO CHECK. * * EXIT (X3) = 0 IF LESSON IS NOT A SYSTEM LESSON, * OR IS A SYSTEM LESSON WITH NO * DELETION PROTECTION. * = 1 IF LESSON IS NEVER TO BE DELETED * (HAS *D1* ATTRIBUTE). * = 2 IF LESSON CANNOT BE DELETED WHILE * IN USE (HAS *D2* ATTRIBUTE). * = 3 IF LESSON HAS *D3* ATTRIBUTE, AND * *SYSDL* = *ON*. * * USES A - 2, 3. * B - NONE. * X - 2, 3. * * OTHER REGISTERS ARE USED BUT RESTORED. * * CALLS PROSRCH, REST0167, SAVE0167. * * MACROS NONE. ENTRY SYSLES SYSLES EQ * RJ SAVE0167 SAVE REGISTERS RJ PROSRCH SEARCH SYSTEM LESSON LIST ZR X2,NOSYSL IF LESSON NOT FOUND SX3 X2 (X3) = TYPE CODE SX7 SYSDL (X7) = 0 IF OFF ZR X7,SYS20 IF *SYSDL* = *OFF* LX2 ZD3SHF (X2) = 1/*D3* BIT, 59/OTHER PL X2,SYS20 IF NO *D3* ATTRIBUTE SX3 3 INDICATE *D3* ACTIVE * SYS20 RJ REST0167 RESTORE REGISTERS EQ SYSLES RETURN * NOSYSL RJ REST0167 SX3 0 (X3) = 0 = DELETABLE EQ SYSLES * /--- BLOCK SYSLES1 00 000 78/11/12 21.30 EJECT ** SYSLES1 - CHECK DELETION PROTECTION AND ECS CHARGE * * THIS ROUTINES SEARCHES THE SYSTEM LESSON LIST AND * RETURNS INFO ABOUT THE ECS CHARGE FOR A SYSTEM * LESSON AND WHETHER OR NOT IT CAN BE DELETED. * * ENTRY (B1) = ADDRESS OF 2-WORD LESSON NAME. * * EXIT (X2) = 0 IF LESSON IS NOT A SYSTEM LESSON, * OR IS A SYSTEM LESSON WITH NO * DELETION PROTECTION. * = 1 IF LESSON IS NEVER TO BE DELETED * (HAS *D1* ATTRIBUTE). * = 2 IF LESSON CANNOT BE DELETED WHILE * IN USE (HAS *D2* ATTRIBUTE). * = 3 IF LESSON HAS *D3* ATTRIBUTE, AND * *SYSDL* = *ON*. * (X3) = ECS CHARGE. * * USES A - 2, 3. * B - NONE. * X - 2, 3. * * OTHER REGISTERS ARE USED BUT RESTORED. * * CALLS PROSRCH, REST0167, SAVE0167. * * MACROS NONE. ENTRY SYSLES1 SYSLES1 EQ * RJ SAVE0167 SAVE REGISTERS RJ PROSRCH SEARCH SYSTEM LESSON LIST ZR X2,NOSYSL1 IF LESSON NOT FOUND BX3 X2 SAVE OVER CALL TO *REST0167* SX7 SYSDL (X7) = 0 IF OFF ZR X7,SYSL20 IF *SYSDL* = *OFF* LX2 ZD3SHF (X2) = 1/*D3* BIT, 59/OTHER PL X2,SYSL20 IF NO *D3* ATTRIBUTE MX0 -18 CLEAR DELETE PROTECT FIELD BX7 X0*X3 (X7) = 42/FLAGS, ETC., 18/0 SX3 3 BX3 X3+X7 (X3) = 42/FLAGS, ETC., 18/3 * SYSL20 RJ REST0167 RESTORE REGISTERS SX2 X3 (X2) = PROTECTION TYPE AX3 18 SX3 X3 (X3) = ECS CHARGE EQ SYSLES1 NOSYSL1 RJ REST0167 RESTORE REGISTERS MX2 0 (X0) = NO PROTECTION MX3 -1 (X3) = NORMAL ECS CHARGE EQ SYSLES1 * /--- BLOCK /SAVEREG/ 00 000 81/12/05 05.04 EJECT QUAL SAVEREG * ** SAVE0167 - SAVE A0, A1, A6, A7, X0, X1, X6, X7 * * THIS ROUTINE SAVES SEVERAL REGISTERS THAT WERE * FORMERLY UNUSED IN ROUTINES WHICH DID A SEQUENTIAL * SEARCH OF THE PROTECTED LESSON TABLE WHEN IT WAS * CM-RESIDENT. * * ENTRY NONE. * * EXIT A0, A1, A6, A7, X0, X1, X6, X7 ARE SAVED. * * USES A - 2, 6, 7. * B - NONE. * X - 2, 6, 7. * * CALLS NONE. * * MACROS NONE. SAVE0167 EQ *+400000B SA2 A6 PRESERVE (A6) AND ((A6)) SA6 SAVE.X6 SAVE (X6) SX6 A2 SA6 SAVE.A6 SAVE (A6) BX6 X2 SA6 SAVE.A6X SAVE ((A6)) SA2 A7 PRESERVE (A7) AND ((A7)) SA7 SAVE.X7 SAVE (X7) SX7 A2 SA7 SAVE.A7 SAVE (A7) BX7 X2 SA7 SAVE.A7X SAVE ((A7)) SX6 A0 BX7 X0 SA6 SAVE.A0 SAVE (A0) SA7 SAVE.X0 SAVE (X0) SX6 A1 BX7 X1 SA6 SAVE.A1 SAVE (A1) SA7 SAVE.X1 SAVE (X1) EQ SAVE0167 * /--- BLOCK /SAVEREG/ 00 000 81/12/05 05.04 REST0167 SPACE 5,20 ** REST0167 - RESTORE A0, A1, A6, A7, X0, X1, X6, X7 * * THIS ROUTINE RESTORES SEVERAL REGISTERS THAT WERE * FORMERLY UNUSED IN ROUTINES WHICH DID A SEQUENTIAL * SEARCH OF THE PROTECTED LESSON TABLE WHEN IT WAS * CM-RESIDENT. * * ENTRY NONE. * * EXIT A0, A1, A6, A7, X0, X1, X6, X7 RESTORED. * * USES A - 0, 1, 2, 6, 7. * B - NONE. * X - 0, 1, 2, 6, 7. * * CALLS NONE. * * MACROS NONE. REST0167 EQ *+400000B SA2 SAVE.X0 BX0 X2 RESTORE (X0) SA2 SAVE.A0 SA0 X2+ RESTORE (A0) SA2 SAVE.A1 SA1 X2 RESTORE (A1) SA2 SAVE.X1 BX1 X2 RESTORE (X1) SA2 SAVE.A6X BX6 X2 SA2 SAVE.A6 SA6 X2 RESTORE (A6) AND ((A6)) SA2 SAVE.X6 BX6 X2 RESTORE (X6) SA2 SAVE.A7X BX7 X2 SA2 SAVE.A7 SA7 X2 RESTORE (A7) AND ((A7)) SA2 SAVE.X7 BX7 X2 RESTORE (X7) EQ REST0167 * /--- BLOCK /SAVEREG/ 00 000 81/12/05 04.20 * DEFINE CELLS USED BY *SAVE067* AND *REST067* SAVE.A0 BSS 1 FOR SAVING (A0) SAVE.A1 BSS 1 FOR SAVING (A1) SAVE.A6 BSS 1 FOR SAVING (A6) SAVE.A7 BSS 1 FOR SAVING (A7) SAVE.X0 BSS 1 FOR SAVING (X0) SAVE.X1 BSS 1 FOR SAVING (X1) SAVE.X6 BSS 1 FOR SAVING (X6) SAVE.X7 BSS 1 FOR SAVING (X7) SAVE.A6X BSS 1 FOR SAVING ((A6)) SAVE.A7X BSS 1 FOR SAVING ((A7)) QUAL * SAVE0167 EQU /SAVEREG/SAVE0167 REST0167 EQU /SAVEREG/REST0167 * /--- BLOCK PROSRCH 00 000 79/01/16 14.05 EJECT ** PROSRCH - SPECIAL SEARCH LESSON DESCRIPTOR TABLE * * THIS ROUTINE PERFORMS A BINARY CHOP SEARCH * OF THE SPECIAL LESSON DESCRIPTOR TABLE. * * ENTRY (B1) = ADDR OF 2-WORD LESSON NAME TO CHECK. * * EXIT (X1) = NAME OF LESSON. * (X2) = DESCRIPTOR WORD (0 IF NOT FOUND). * * USES A - 1, 2, 3. * B - NONE. * X - 0, 1, 2, 3, 4, 6, 7. * * OTHER REGISTERS ARE USED BUT RESTORED. * (X0, A1/X1, A2/X2, X7 ARE NOT RESTORED) * * CALLS NONE. * * MACROS NONE. ENTRY PROSRCH PROSRCH EQ *+400000B QUAL PROSRCH SA1 A6 PRESERVE (A6) AND (CM VALUE) SX6 A1 SA6 PROS.A6 SAVE (A6) BX6 X1 SA6 PROS.X6X SAVE VALUE AT ADDR *A6* BX6 X3 SA6 PROS.X3 SAVE (X3) BX6 X4 SA6 PROS.X4 SAVE (X4) SX6 A0 SA6 PROS.A0 SAVE (A0) SX6 A3 SA6 PROS.A3 SAVE (A3) SA1 B1+1 (X1) = LESSON NAME BX6 X1 COPY TO *X6* SA6 ORIGLSN SAVE ORIGINAL LESSON NAME SA2 B1 (X2) = ACCOUNT NAME LX2 42 SHIFT TO OLD-STYLE FLAG PL X2,PROSZ IF NOT OLD-STYLE SX6 1 LOOP COUNTER SA6 SRCHCNT SAVE IT MX4 60 CHECK ENTIRE WORD FOR LSN NAME PROS0 SA2 SYSLST BX6 X2 (X6) = EM ADDR OF TOP OF TABLE SA2 SYLEND BX7 X2 (X7) = EM ADDR OF END OF TABLE PROS1 IX3 X7-X6 GET DIFFERENCE AX3 2 TO DROP ONES BIT - 2 WORD CHOP LX3 1 IX0 X6+X3 ADDRESS OF NEXT WORD RX2 X0 (X2) = NEXT LESSON NAME BX2 X4*X2 MASK OFF ANY UNNECESSARY CHARS IX2 X2-X1 SEE IF THE SAME NZ X2,PROS2 NO MATCH SX2 1 IX0 X0+X2 (X0) = ADDR OF DESCRIPTOR WORD RX2 X0 (X2) = DESCRIPTOR WORD EQ PROS5 MATCH FOUND PROS2 ZR X3,PROS4 RUN OUT OF WORDS NG X2,PROS3 IF IN TOP HALF BX7 X0 RESET BOTTOM EQ PROS1 * /--- BLOCK PROSRCH 00 000 79/01/04 14.32 PROS3 BX6 X0 RESET TOP EQ PROS1 PROS4 SX2 0 NO FIND SA3 SRCHCNT SEE IF ANOTHER SEARCH NEEDED ZR X3,PROS7 NO MORE SEARCHING MX6 0 END SEARCH AFTER THIS LOOP SA6 A3 SAVE IT * * * * CHECK TO SEE FILE STARTS WITH ',N',. IF SO, * * * IT MAY BE AN ',N', VERSION FOR A SYSTEM LESSON * * * (SYSTEM OR LOCAL). IF FILE STARTS WITH ',N',, * * * SEE IF THERE IS AN ENTRY WITHOUT THE ',N',. * MX0 6 SET MASK FOR FIRST CHAR BX6 X0*X1 MASK OFF 1ST CHAR LX6 6 RIGHT JUSTIFY IT SX6 X6-16B SEE IF EQUAL TO ',N', NZ X6,PROS7 IF NOT ',N', FILE, END SEARCH LX1 6 MOVE ',N', TO END OF WORD MX4 54 SET MASK FOR 9 CHARS BX1 X4*X1 MASK OFF THE ',N', EQ PROS0 PROS5 SA3 SRCHCNT GET SEARCH COUNT NZ X3,PROS7 FOUND ORIGINAL LSN, SAVE BX3 X2 COPY TO *X3* LX3 ZNVSHF POSITION BIT TO TOP MX0 1 SET MASK TO TEST TOP BIT BX6 X0*X3 SEE IF *NV* SET NG X6,PROS5A IF SET, SET TO NVER SPECS SA3 DEVSYS GET *DEVSYS* STATUS ZR X3,PROSZ IF NOT DEV SYSTEM, ZERO BX3 X2 COPY TO *X3* LX3 ZSNVSHF POSITION BIT TO TOP BX6 X0*X3 SEE IF *SYSNV* SET ZR X6,PROSZ IF NOT SET, SET TO NO MATCH PROS5A MX0 1 SET MASK TO ZERO *BIN* BIT BX2 -X0*X2 KEEP EVERYTHING BUT *BIN* BIT MX0 42 SET MASK TO ZERO *DEL* FIELD BX2 X0*X2 ZERO LAST 18 BITS SX3 2 SET *DEL* FIELD TO 2 IX2 X2+X3 STORE IT BX7 X2 SAVE COPY OF *X2* SA1 ORIGLSN GET ORIGINAL LESSON SA2 NPLATO CHECK FOR LESSON -NPLATO- IX3 X1-X2 SEE IF IT IS =NPLATO= ZR X3,PROS6 HANDLE DIFFERENTLY SX3 -1 SET EM CHARGE TO FULL CHARGE BX3 X0*X3 KEEP ONLY BOTTOM 18 BITS LX3 18 POSITION TO *EM* PORTION LX0 18 POSITION 0'7S OVER 18 SPOTS BX2 X0*X7 ZERO EM CHARGE IX2 X2+X3 SET *EM* FIELD TO -1 EQ PROS7 GO RETURN SYSTEM LESSON INFO * /--- BLOCK PROSRCH 00 000 79/01/16 14.10 * * * * TURN OFF *S1P* BIT SO CAN SHIFT-STOP OUT OF LESSON * * * (LEAVE EM CHARGE AT 0) * PROS6 MX0 1 SET MASK FOR *S1P* BIT LX0 60-ZPLDSHF POSITION MASK FOR THAT BIT BX2 -X0*X7 TURN OFF *S1P* BIT EQ PROS7 CONTINUE PROSZ SX2 0 NO SYSTEM PRIVILEDGES PROS7 BX7 X2 SAVE DESCRIPTOR WORD SA1 PROS.X6X SA2 PROS.A6 BX6 X1 SA6 X2 RESTORE (A6) AND (CM VALUE) SA1 PROS.A0 SA0 X1 RESTORE (A0) SA1 PROS.A3 SA3 X1 RESTORE (A3) SA1 PROS.X3 BX3 X1 RESTORE (X3) SA1 PROS.X4 BX4 X1 RESTORE (X4) SA1 ORIGLSN RETURN (X1) = FILE NAME BX6 X1 STORE IT THERE (JUST IN CASE) BX2 X7 RETURN (X2) = DESCRIPTOR WORD EQ PROSRCH PROS.A0 BSS 1 FOR SAVING (A0) PROS.A3 BSS 1 FOR SAVING (A3) PROS.A6 BSS 1 FOR SAVING (A6) PROS.X6X BSS 1 FOR SAVING (CM VALUE OF *A6*) PROS.X3 BSS 1 FOR SAVING (X3) PROS.X4 BSS 1 FOR SAVING (X4) SRCHCNT BSS 1 NUMBER OF SEARCHES ORIGLSN BSS 1 ORIGINAL LESSON NAME NPLATO DATA 0LNPLATO NPLATO LESSON NAME QUAL * * /--- BLOCK PROLIST 00 000 81/12/05 03.53 ENTRY PROLIST,SYSLST,SYLEND PROLIST BSS 1 SYSLST EQU PROLIST SYLEND BSS 1 * /--- BLOCK ZFILL 00 000 78/05/01 22.21 TITLE -ZFILL- COMMAND * * * -ZFILL- COMMAND * CONVERTS ARGUMENT TO LEFT-JUSTIFIED ZERO-FILL * * ZFILLX NGETVAR GET ARGUMENT TO X1 CALL LJUST,(1R ),0 BX6 X1 SA6 A1 EQ PROC * * TITLE -CPULIM- COMMAND * * * -CPULIM- COMMAND * ALLOWS USERS TO CHANGE CPU MILLISECONDS PER * SECOND LIMITS WITH BOUNDS UP TO -MSLIMIT- * WHICH IS CURRENTLY 10 * CPULIMX NGETVAR GET DESIRED MSEC/SEC NG X1,ERXVAL BAD VALUE, EXECERR USES X1 ZR X1,ERXVAL BAD VALUE, EXECERR USES X1 ** SA2 STFLAGS LX2 60-FINBIT CHECK FOR IN-FINISH-UNIT NG X2,PROC ** SX2 MSLIMIT MAXIMUM PERMISSIBLE IX3 X2-X1 CHECK IF MSEC/SEC TOO HIGH * NG X3,CPERXUL EXECERR IF ABOVE 10 TIPS * EXECERR USES X1 CPUX2 SX2 X1-3 MAKE SURE AT LEAST 3 PL X2,CPUX3 TO GET PEOPLE FINALLY OUT OF SX1 3 FINISH UNIT CPUX3 PX1 X1 NX1 X1 CONVERT TO FLOATING POINT SA2 =1000.0 FX6 X2/X1 1000/CPU LIMIT UX6 X6,B1 LX6 X6,B1 SA6 TCPUMAX SET MAXIMUM MSEC/SEC EQ PROC * * CPERXUL SX2 MSLIMIT SA3 =70247011702070230000B 'T'I'P'S EQ ERXMXL * /--- BLOCK SHOWT 00 000 75/07/09 00.10 TITLE SHOWT * -SHOWT- COMMAND * * SHOWS TUTOR VARIABLE (CONVERTED TO FLOATING POINT FORMAT) * DEFAULT FORMAT IS 4.3 IF THE * VARIABLE IS FLOATING POINT AND 8.0 IF IT IS INTEGER. * ADDITIONS FOR -SHOW ARRAY- BY SHIRER 7/8/75 * EXT ARAYFLG * ENTRY SHOWT SHOWT BSS 0 SX7 0 SA7 ARAYFLG GETVAR SETS NONZERO IF ARRAY FGETVAR EVALUATE 1ST ARGUMENT BX7 X1 SA7 SHOWVAL SAVE IT SA5 A5 RESTORE COMMAND LX5 XCODEL LEFT-ADJUST 2ND ARG CODE NG X5,SHOWT2 DEFAULT IF NEGATIVE FGETVAR DO THE CALC TO GET THE FORMAT SA2 =.05 ROUND NUMBER OF DECIMAL PLACES RX1 X1+X2 UX6 X1,B1 GET INTEGER PART LX6 X6,B1 FIX IT SA6 NCHAR SA5 A5 REFETCH COMMAND WORD LX5 2*XCODEL PL X5,SHOWT3A FOR THREE ARG SHOW PX2 X6 REFLOAT IT NX2 X2 RX1 X1-X2 SUBTRACT FROM ORIGINAL FORMAT SA2 =10. RX6 X1*X2 MULTIPLY UP THE DECIMAL PLACE SPECIFIER UX6 X6,B1 LX6 X6,B1 FIX IT SHOWT1 SA6 NDECPL STORE NUMBER OF DEC. PLACES EQ SHOWT3 **** SHOWT2 SX6 4 DEFAULT FORMAT 4.3 SX7 3 DEFAULT NDECPL (FLOATING) SA5 A5 RETRIEVE ORIGINAL COMMAND WORD LX5 XFBIT NG X5,SHOWT4 JUMP IF FLOATING POINT MX7 0 NDECPL=0 FOR INTEGER LX6 1 GET AN 8 SHOWT4 SA6 NCHAR SA7 NDECPL SHOWT3 SA1 ARAYFLG NZ X1,ASHOWT JUMP IF ARRAY SHOW**DEBUG** SHOWT5 RJ =XTSHOW SHOWFIN CALL XYFIX A1, X1 SET BY SHOW SUBROUTINE CALL TUTWRT B1,B2 SET BY SHOW SUBROUTINE EQ PROCO * SHOWT3A MX0 2*XCODEL+XCMNDL FLAG BIT NOT SET IF GET HERE LX5 60-2*XCODEL-XCMNDL POSITION ADDRESS BX5 -X0*X5 SA1 B5+X5 FETCH 3RD ARG BX5 X1 NGETVAR MX6 0 REMOVE -0 IX6 X6+X1 EQ SHOWT1 RE-ENTER NORMAL FLOW * * * /--- BLOCK NUASHOW 00 000 77/07/26 21.58 * ARRAY SHOW PREPARATION * ENTER WITH X1=ARAYFLG=ADDR OF XSTOR ARAYWRD * ENTRY ASHOWIN,ASHOW1,ASHOW2 ENTRY ASHOWEF * MAXSCOLS EQU 64 MAX NUM COLUMNS TO SHOW MAXSROWS EQU 16 MAX NUM ROWS TO SHOW * ASHOWT SA3 SHOWT5 PLANT RJ=XTSHOW IN LOOP SX6 0 FGETVAR TYPE ASHOWIN SA6 ASHOTYP KEEP TYPE IN X6 FOR LATER TEST BX7 X3 SA7 ASHOW1 SA3 NX BX7 X3 SA7 ASHOWNX SAVE STARTING NX * * ARRAY SHOW ROUTINE USED FOR -SHOWT- AND -SHOWE- * ASHOW00 SA2 X1 GET ARAYWD IN X2 BX7 X2 SA7 ARAYWRD MX0 -9 AX2 27 (LATER WILL NEED PLANES TOO) BX7 -X0*X2 SA7 ASHOWC COLUMNS-1 SX7 X7-MAXSCOLS PL X7,SERXRC *JUMP IF COLS OVER LIMIT* * EXECERR USES X2 AX2 9 BX7 -X0*X2 SA7 ASHOWR ROWS-1 SX7 X7-MAXSROWS PL X7,SERXRC *LIMIT TO 16 ROW DISPLAY* * EXECERR USES X2 LX2 3+9+27 PL X2,ASHOW1 JUMP IF NOT SEGMENTED * SA5 A5 NGETVAR RE-EVALUATE INTEGER 1ST VALUE SA2 ARAYFLG SA2 X2+1 X2=2D ARAYWD RJ GETASEG EXTRACT SEGMENT FROM 1ST WORD SA2 ASHOTYP BX7 -X2 NEGATIVE TYPE INDICATES SEGMENT SA7 A2 NZ X2,ASHOW04 JUMP IF SHOWA OR SHOWO PX6 X6 NX6 X6 SHOWT, SHOWE NEED FLOATING VALU ASHOW02 SB1 SHOWVAL EQ ASHOW08 * ASHOW04 SX2 X2-1 JUMP IF -SHOWO- ZR X2,ASHOW02 BX6 X1 LEFT ADJSTD STRING FRM GETASEG SB1 STRING * ASHOW08 SA6 B1 STORE 1ST SHOW VALUE * * ARRAY SHOW LOOP * * /--- BLOCK NUASHOW 00 000 77/07/22 23.15 ASHOW1 RJ =XTSHOW CONVERT FLOAT TO ALPHA ASHOW2 SA2 ASHOWR =0 IF LAST ROW NZ X2,ASHOW3 IF NOT, SKIP OVER XYFIX CALL XYFIX ASHOW3 CALL TUTWRT WRITE THE STRING ASHOW4 SA2 ASHOWC =0 IF LAST COLUMN NZ X2,ASHOW8 IF NOT,DECREMENT COLUMN SA2 ASHOWR =0 IF LAST ROW ZR X2,PROCO EXIT IF DONE * *NEW ROW* * SA1 ARAYWRD RESET COLUMN INFO FOR NEW ROW AX1 27 MX0 -9 BX7 -X0*X1 EXTRACT MAX COLS AGAIN SA7 ASHOWC AND RESTORE SA3 NY SCREEN Y POSITION SX7 X3-32 PL X7,ASHOW5 JUMP IF ON SCREEN SX7 X7+512 IF NOT WRAP-AROUND ASHOW5 SA7 NY RESTORE NEW VALUE * * /--- BLOCK NUASHOW5 00 000 80/04/22 01.01 * SA1 ASHOWNX BX6 -X0*X1 SA6 NX RESET WHEREX TO MARGIN LX6 9 BX1 X6+X7 MERGE NX,NY OUTCODE WFCODE FINE WHERE TO START NEW ROW * SA1 XSLCLOK GET RUNNING MS CLOCK SA2 MAXCLOK IX1 X1-X2 PL X1,SINTRUP * SA1 MOUTLOC SX1 X1-MOUT150 PL X1,SINTRUP * ASHOW6 SA2 ASHOWR RESTORE ROW FOR DECREMENT ASHOW8 SX4 1 IX7 X2-X4 DECREMENT ROW/COL SA7 A2 RESTORE IT * ASHOW9 SA1 ARAYWRD IX7 X1+X4 INCREMENT GETVAR ADDRESS SA7 A1 AND RESTORE IT MX0 -18 BX5 -X0*X7 GETVAR CODE OF NEXT ELEMENT LX5 60-XCODEL LEFT JUSTIFY SA2 ASHOTYP NG X2,ASHOW70 JUMP IF SEGMENTED NZ X2,ASHOW95 JUMP IF SHOWO FGETVAR EVALUATE NEXT ARRAY ELEMENT ASHOW99 BX6 X1 SA6 SHOWVAL EQ ASHOW1 AND SHOW IT * ASHOW95 SX2 X2-2 ZR X2,ASHOW96 JUMP IF SHOWA ASHOW94 NGETVAR GET NEXT SHOWO VALUE EQ ASHOW99 ASHOW96 NGETVAR SB1 A1 NEXT SHOWA ADDRESS EQ ASHOW1 * ASHOW70 NGETVAR WORD CONTAINING SEGMENT IN X1 SA2 ARAYFLG ADDR OF INFO WD SA2 X2+1 GET 2D ARAY INFO WD RJ GETASEG EXTRACT SEGMENT SA2 ASHOTYP NZ X2,ASHOW76 JUMP IF SHOWA OR SHOWO PX6 X6 NX6 X6 FLOAT ASHOW74 SA6 SHOWVAL EQ ASHOW1 * ASHOW76 SX2 X2+1 X2 WAS -1 IF SHOWO ZR X2,ASHOW74 JUMP IF -SHOWO- BX6 X1 LEFT-JUSTIFY SEGMENT SA6 STRING SB1 A6 EQ ASHOW1 * STRING BSS 1 ASHOWR BSS 1 ARRAY ROW/COL INDICES ASHOWC BSS 1 ASHOWNX BSS 1 STARTING NX VALUE ASHOTYP BSS 1 T,E=TYPE0, O=TYPE1 ASHOWEF BSS 1 SHOWE FORMAT ARAYWRD BSS 1 SEGMENTED ARAYWD * * /--- BLOCK NUASHOWE 00 000 78/04/04 18.25 * * * ARRAY SHOWE PREPARATION * ASHOWE SA3 SHOWE5 PLANT EQ SHOWE6 IN LOOP SA6 ASHOWEF SAVE FORMAT WHICH WAS IN X6 SX6 0 TYPE=0 FOR FGETVAR EQ ASHOWIN * SHOWE5 EQ SHOWE6 * SHOWE6 SA1 ASHOWEF BX7 X1 RECOVER FORMAT MX6 0 SA6 SHOWOUT REQUEST LEADING BLANK/SIGN SA7 NCHAR RJ =XESHOW CALL TUTWRT SA1 NX SA2 NY SA3 ASHOWEF NUMB CHARS SX3 X3+10 +SPACE FOR EXPONENT,SIGN,ETC LX3 3 TIMES 8 FOR EQUIVALENT DOTS IX6 X1+X3 NX FOR NEXT WRITE SA6 A1 STORE NEW NX MX0 -9 BX1 -X0*X6 BX2 -X0*X2 LX1 9 BX1 X1+X2 FORM OUTPUT NX,NY OUTCODE WFCODE SEND OUT -WHERE- EQ ASHOW4 SKIP PAST TUTWRT * GETASEG EQ * ENTER WITH X1=WORD,X2=ARAYWD1 LX2 1 EXAMINE TYPE PL X2,ERXHSEG HORIZONTAL TYPE SEGMENT ILLEGAL LX2 59 RESTORE SIGN MX0 -6 AX2 42 BX3 -X0*X2 STARTBIT POSITION AX2 6 BX4 -X0*X2 BITS/BYTE SB1 X3-1 SB-1 = LEFT JUSTIFY SHIFT SB2 X4-1 BB-1 = MASK SHIFT RJ GETSEG EQ GETASEG * * * SUBROUTINE TO EXTRACT SEGMENT FROM WORD IN X1 * ENTER WITH B1 = LEFT-JUSTIFY SHIFT, X2 HAS SIGNBIT GETSEG EQ * AND B2=BITS/BYTE - 1 LX1 X1,B1 LEFT-JUSTIFY SEGMENT MX0 1 AX0 X0,B2 FORM MASK BX1 X0*X1 NG X2,GETSEG2 JUMP IF SIGNED SEGMENT SB2 B2+1 BITS/BYTE LX6 B2,X1 RIGHT JUSTIFY EQ GETSEG * GETSEG2 SB1 59 SB1 B1-B2 60-BB AX6 X1,B1 RIGHT-JUSTIFY, EXTENDING SIGN EQ GETSEG * SERXRC MX0 -9 SA2 ARAYWRD AX2 27 (LATER WILL NEED PLANES TOO) BX1 -X0*X2 NUMBER COLUMNS SPECIFIED AX2 9 BX2 -X0*X2 NUMBER ROWS SPECIFIED SX1 X1+1 MAKE CARDINAL SX2 X2+1 MAKE CARDINAL SX3 MAXSCOLS SX4 MAXSROWS EXECERR 120 * /--- BLOCK NUSINTRUP 00 000 79/12/21 22.12 SINTRUP SA1 TBITS ARRAY SHOW INTERRUPT ROUTINE LX1 BRKBIT NG X1,TOOMUCH JUMP IF AUTOBREAK SUPPRESSED SA1 INEMBED NZ X1,ERROROF ERROR IF IN EMBEDDED WRITE FINISH ERXOUTP NO OUTPUT ALLOWED IN -FINISH- SA1 ARAYFLG SA2 ASHOWR BX6 X1 BX7 X2 SA6 TBINTSV SA7 TBINTSV+1 SA1 ASHOWC SA2 NDECPL BX6 X1 BX7 X2 SA6 TBINTSV+2 SA7 TBINTSV+3 SA1 NCHAR SA2 ASHOW1 BX6 X1 BX7 X2 SA6 TBINTSV+4 SA7 TBINTSV+5 SA1 SHOWOUT SA2 SUPPFLG BX6 X1 BX7 X2 SA6 TBINTSV+6 SA7 TBINTSV+7 SA2 ASHOWNX SA3 ASHOWEF MX0 -9 KEEP ONLY 9 BITS OF NX BX7 -X0*X2 BX3 -X0*X3 AND FORMAT LX7 20 BX7 X7+X3 MERGE IN ASHOWEF SA7 TBINTSV+8 SA1 ARAYWRD BX6 X1 SA6 TBINTSV+9 SA1 =XWHATSIN+0 CURRENT OVERLAY NUMBER BX7 X1 SA7 TBINTSV+10 SA1 ASHOTYP BX6 X1 SA6 TBINTSV+11 * RJ TFIN GO DO INTERRUPT * SA1 TBINTSV+10 RESTORE ANY OVERLAY FIRST SA2 =XWHATSIN+0 BX7 X1 RJ =XLOADOV * SA1 TBINTSV SA2 TBINTSV+1 RESTORE VALUES BX6 X1 BX7 X2 SA6 ARAYFLG SA7 ASHOWR SA1 TBINTSV+2 SA2 TBINTSV+3 BX6 X1 BX7 X2 SA6 ASHOWC SA7 NDECPL SA1 TBINTSV+4 SA2 TBINTSV+5 BX6 X1 BX7 X2 SA6 NCHAR SA7 ASHOW1 SA1 TBINTSV+6 SA2 TBINTSV+7 BX6 X1 BX7 X2 SA6 SHOWOUT SA7 SUPPFLG SA1 TBINTSV+8 SX6 X1 AX1 20 SA6 ASHOWEF SX7 X1 SA7 ASHOWNX SA1 TBINTSV+9 BX6 X1 SA6 ARAYWRD SA1 TBINTSV+11 BX6 X1 SA6 ASHOTYP EQ ASHOW6 * * * /--- BLOCK SHOW 00 000 78/04/04 19.23 TITLE SHOW * -SHOW- * * SHOWS TUTOR VARIABLE IN (STANDARD) NOTATION, * THE SECOND ARGUMENT SPECIFIES THE NUMBER OF * SIGNIFICANT FIGURES DESIRED. * 'THE THIRD ARGUMENT SPECIFIES THE FLOOR * (=10&-&9 AS DEFAULT). * * ENTRY SHOW * SHOW BSS 0 FGETVAR EVALUATE 1ST ARGUMENT BX7 X1 SA7 SHOWVAL SAVE IT SA5 A5 RESTORE COMMAND LX5 XCODEL LEFT-ADJUST 2ND ARG CODE SX6 4 DEFAULT SHOW WIDTH NG X5,SHOW1 IF SHOULD USE DEFAULT NGETVAR DO THE CALC TO GET THE FORMAT BX6 X1 ZR X6,PROCESS OUT IF NOTHING TO DO SHOW1 SA6 NCHAR SAVE DISPLAY WIDTH SA5 A5 RETRIEVE ORIGINAL COMMAND LX5 XFBIT MX6 60 NEG 0 IF INTEGER PL X5,SHOW4 JUMP IF INTEGER LX5 2*XCODEL-XFBIT PL X5,SHOW5 CHECK FOR THIRD ARGUMENT SA1 =XEQTOLER GET DEFAULT TOLERANCE SHOW2 SA2 SHOWVAL GET X BX6 X2 GET AX6 60 ABSOLUTE BX2 X2-X6 VALUE OF X FX7 X2-X1 ABS(X)-FLOOR MX6 0 SET X=0 OR FLAG F.P. PL X7,SHOW4 SA6 SHOWVAL MX6 60 SET FOR INTEGER SHOW4 SA6 SHOWOUT INTEGER/FLOATING FLAG IN SHOWOUT SX7 1 SET TO SEE ZEROES BX7 X6*X7 SA7 SUPPFLG SET ZERO SUPPRESSION FLAG SA2 NCHAR GET NSIG SX3 4 IX7 X2+X3 NSIG+4 SA7 SUPPFLG+1 RANGE N SX7 3 SA7 SUPPFLG+2 RANGE M SX7 1 SA7 SUPPFLG+3 ALLOW TRANSFER TO -SHOWE- SX7 0 SA7 STARFLG FORCE SUP/SUB FORMAT, NOT ** * RJ =XZSHOW EQ SHOWFIN * SHOW5 AX5 2*XCODEL+XCMNDL AND SIGN BIT WAS OFF SA1 B5+X5 GET EXTRA STORAGE WORD BX5 X1 FGETVAR GET TOLERANCE PL X1,SHOW5B OK IF PLUS NZ X1,ERXSTOL ERROR IF NEGATIVE MX1 0 SET TO ZERO SHOW5B SA2 =1. GET A ONE FX2 X2-X1 MUST BE LESS THAN OR EQUAL ONE PL X2,SHOW2 EQ ERXSTOL * /--- BLOCK SHOWZ 00 000 78/01/19 01.07 TITLE SHOWZ * -SHOWZ- * * SHOWS TUTOR VARIABLE IN (STANDARD) NOTATION, * THE SECOND ARGUMENT SPECIFIES THE NUMBER OF * SIGNIFICANT FIGURES DESIRED. * * ** ENTRY SHOWZ * SHOWZ SX7 1 FLAG TO SEE TR. ZEROES SA7 SHOWOUT FGETVAR EVALUATE 1ST ARGUMENT BX7 X1 SA7 SHOWVAL SAVE IT SA5 A5 RESTORE COMMAND LX5 XCODEL LEFT-ADJUST 2ND ARG CODE SX6 4 DEFAULT SIGNIFICANT DIGITS NG X5,SHOWZ3 IF SHOULD USE DEFAULT NGETVAR DO THE CALC TO GET THE FORMAT ZR X1,PROCESS OUT IF NOTHING TO DO BX6 X1 AX6 6 CATCH IF GREATER THAN 64 NZ X6,ERXBADL SX6 X1 SET NUMBER OF SIG FIGS SHOWZ3 SA5 A5 RETRIEVE ORIGINAL COMMAND LX5 XFBIT SA6 NCHAR STORE NSIG FIGS MX6 60 NEG 0 IF INTEGER SX7 1 TURN OFF ZERO-SUPPRESSOR PL X5,SHOWZ4 JUMP IF INTEGER MX6 0 +0 IF FLOATING POINT SA1 SHOWOUT BX7 X1 SET TO PRESET VALUE * * SHOWZ4 SA6 SHOWOUT INTEGER/FLOATING FLAG IN SHOWOUT SA7 SUPPFLG ZERO SUPPRESS FLAG SA2 NCHAR GET NSIG SX3 4 IX7 X2+X3 NSIG+4 SA7 SUPPFLG+1 RANGE N SX7 3 SA7 SUPPFLG+2 RANGE M SX7 1 SA7 SUPPFLG+3 ALLOW TRANSFER TO -SHOWE- SX7 0 SA7 STARFLG FORCE SUP/SUB FORMAT, NOT ** * RJ =XZSHOW EQ SHOWFIN * ENTRY ASHOWE,SHOWFIN,ASHOW3,ASHOWIN * ABOVE ENTRIES ARE DUE TO OVERLAYING OF * -SHOWE-, -SHOWO- AND -SHOWH- * /--- BLOCK -ZERO- 00 000 79/01/03 13.35 ZEROSAV SPACE 5,11 ** ZEROSAV - SAVE REGISTERS *X4* AND *A4* ENTRY ZEROSAV ZEROSAV PS SA0 A7 SAVE *A7* SA7 ZBSAVX7 SAVE CURRENT *X7* BX7 X4 SA7 ZBSAVX4 SAVE *X4* SX7 A4 SA7 ZBSAVA4 SAVE *A4* SA4 A0 GET DATA AT *A7* BX7 X4 SA7 A0 WRITE IT BACK AND RESET *A7* SA4 ZBSAVX7 GET ORIGINAL *X7* BX7 X4 RESET *X7* EQ ZEROSAV -- EXIT ZERORST SPACE 5,11 ** ZERORST - RESTORE *X4* AND *A4* AFTER -ZERO- * * RESTORE *X4*, *A4* -- *X0* LOST ENTRY ZERORST ZERORST PS SA4 ZBSAVX4 GET *X4* BX0 X4 HOLD *X4* SA4 ZBSAVA4 GET *A4* SA4 X4 RESET *A4* BX4 X0 RESET *X4* EQ ZERORST RETURN * ZBSAVX7 BSS 1 ZBSAVX4 BSS 1 ZBSAVA4 BSS 1 * * /--- BLOCK END 00 000 78/09/01 21.41 * * END