EXEC5 * /--- FILE TYPE = E * /--- BLOCK EXEC5 00 000 78/12/15 10.55 IDENT PLAT4$ LCC OVERLAY(PLATO,1,0) END IDENT EXEC5 TITLE EXEC5 OVERLAYS FOR COMMAND EXECUTION * * CST * * EXEC5$ OVFILE * * EXT ECSPRTY,ILOC,INAME,PROCO,ERXNAME EXT BOUNDS,WORDS,PROCESS,PROCESX,PROC,ERXMXLW EXT CKPROC,RETPROC,RETPROS,RETPRO EXT ERROROF,XSLICE EXT ERXROLC,ERXBADL,ERXROLV,ERXINDL,ERXINDH EXT ERXPOS,ERXNOCS,ERXVAL,ERXECSB,ERXSTN EXT GET2 EXT GETN EXT FODTAB,STSTUD,DST EXT CHKSET EXT RCTOXY EXT LSNADDR * * * /--- BLOCK NOTES 00 000 77/09/13 15.45 TITLE HISTORY ************************************************************ * * THE ORIGINAL IDEA FOR, AND IMPLEMENTATION OF, * THIS SEARCH ROUTINE IS DUE TO JIM PARRY. THE * CODE WAS MODIFIED AS TO REGISTER USAGE AND * CALLING PROCEDURE TO CONFORM TO TUTOR EXECUTION * CONVENTIONS BY RICK BLOMME, JULY 10, 1972. * * MULTIPLE SEARCH BY KIM MAST * * REVERSE SEARCH AND GENERAL CLEANUP 9/77 BY * PAUL KONING. * ************************************************************ TITLE NOTES * * REGISTER USAGE IN ACTUAL SEARCH ROUTINE IS * A MESS. THE PRIME REGISTER USAGE IS GIVEN * BELOW'; * * X0 = OBJECT TO SEARCH FOR * X1 = TEMPORARY * X2 = CURRENT WORD BEING CHECKED * X3 = FOLLOWING WORD * X4 = 10 COPIES OF COMPLEMENT OF 1ST CHARACTER * X5 = 10 COPIES OF COMPLEMENT OF 2ND CHARACTER * X6 = SPECIAL MASK (',SPIKES',) * X7 = FLAG WORD MARKING POSITIONS WHOSE FIRST * TWO CHARACTERS MATCH SPECIFIED OBJECT STRING * * A0 = BASE ADDRESS OF SEARCH (WORD 1 OF STRING) * A2 = ADDRESS OF CURRENT WORD BEING CHECKED * A4 = ADDRESS OF LAST RESULT + 1 * A7 = ADDRESS OF WORD WHERE OBJECT WAS PLANTED * TO STOP SEARCH FOR INTERRUPT OR TERMINATION * * B0 = 0 * B1 = 1 * B2 = 2 * B3 = CHAR POSITION COUNTER * B4 = TEMPORARY * B5 = SHIFT COUNT (60-6*OBJECT LENGTH) * B6 = ^$ SPACES LEFT IN RESULT BUFFER * B7 = ADDRESS TO STOP SEARCHING ON (MAY BE * END + 2 OR START - 1 DEPENDING ON DIRECTION) * * THE SEARCH ROUTINE INTERRUPTS WHEN THE TIME * SLICE IS EXCEEDED. IT DOES THIS BY PLANTING * THE OBJECT EVERY 70 WORDS AND CHECKING THE CLOCK * WHEN THE PLANTED OBJECT IS HIT. THIS LENGTH OF * 70 IS DETERMINED BY SYMBOL *NWORDS* AND CAN BE * CHANGED TO MAKE CHECKS MORE OR LESS FREQUENT. * * FORMAT OF THE SEARCH COMMAND'; * * SEARCH OBJ,OBJLEN,STRING,LEN,START,BUFF[,NUMBER] * * OBJ = OBJECT TO SEARCH FOR * OBJLEN = LENGTH OF OBJECT (1^ MAX IX2 X1-X2 MAX POSSIBLE CHAR POSITION -1 NG X2,NOSRCH --- IF NO SEARCH POSSIBLE SB1 X2 TO B1 SX3 B3 X3 = CHAR POS. TO START ON SA1 TENTH BRING UP 1/10 SA4 TSRCEND GET DIRECTION FLAG PL X4,SRCHX4 BRANCH IF FORWARD SEARCH * * SET UP DATA FOR BACKWARD SEARCH * X2 = ENDING CHAR POSITION (0-BASED) * X3 = INITIAL CHAR POSITION (0-BASED) * X6 = STARTING WORD OFFSET (SET LATER) * X7 = WORD OFFSET FOR END TEST (END+2 OR END-1) * SX7 -1 SEARCH END ADDRESS (RELATIVE) MX2 0 LAST CHAR POSITION -1 LE B3,B1,SRCHX5 --- IF OFFSET SMALL ENOUGH SX3 B1 CORRECT OFFSET EQ SRCHX5 CONTINUE IN COMMON CODE * * SAME FOR FORWARD SEARCH * SRCHX4 GT B3,B1,NOSRCH --- IF NO SEARCH POSSIBLE * (X2 ALREADY SET) PX7 X2 FLOAT ENDING CHAR POSITION FX7 X1*X7 COMPUTE WORD ENDING OFFSET SX7 X7+2 SEARCH END ADDRESS (RELATIVE) * /--- BLOCK SETUP END 00 000 77/09/13 00.00 * * NOW PACK UP EVERYTHING INTO TBINTSV BUFFER * SRCHX5 SX2 X2+1 MAKE CHAR POSITIONS 1-BASED LX2 18 SHIFT END POSITION OVER PX6 X3 FLOAT STARTING CHAR POSITION SX3 X3+1 ADJUST THIS ONE TOO BX2 X2+X3 PACK UP FOR TSRCMXM FX6 X1*X6 COMPUTE WORD OFFSET SX6 X6 TOSS EXPONENT SA3 TSRCST READ UP BASE ADDRESS IX6 X6+X3 MAKE STARTING ADDRESS ABSOLUTE IX7 X7+X3 LIKEWISE FOR ENDING ADDRESS SA6 A3 STORE STARTING ADDRESS SA3 TSRCEND GET END ADDRES ETC. WORD MX0 -18 BX7 -X0*X7 CLEAR SIGN EXTEND BX7 X7+X3 MERGE WITH ENDING ADDRESS SA7 A3 AND STORE BACK SA1 TSRCMXM GET FIRST ASSORTED THINGS WORD BX6 X1+X2 MERGE IN CHARACTER BOUNDS SA2 SRCHSV2 READ UP SECOND ARG. WORD LX2 XFBIT SEE IF ARG. 6 WAS FLOATING MX0 1 BX2 X0*X2 ISOLATE FLOATING ARG. FLAG BX6 X6+X2 MERGE WITH TSRCMXM SA6 A1 STORE EVERYTHING BACK * * /--- BLOCK POSTINT 00 000 78/01/07 19.22 * * ENTER HERE AFTER SETUP OR UPON RETURN FROM INTERRUPT. * TUTOR'7S B REGISTERS ARE SAVED AND ALL REGISTERS ARE * SET UP FOR THE MAIN SEARCH LOOP. * POSTINT SX6 B5 SX7 B7 SA6 SAVEB5 SA7 SAVEB7 * * NOW SET UP REGISTERS FOR SEARCH * SA1 TSRCINX GET NUMBER OF TIMES LEFT SA2 TSRCEND SEARCH ENDING ADDRESS SB6 X1 NUMBER LEFT INTO B6 SB7 X2 ENDING ADDRESS INTO B7 AX2 18 MOVE UP BASE ADDRESS OF SEARCH SA0 X2 INTO A0 AX2 18 MOVE UP BUFFER END ADDRESS SA4 X2 INTO A4 (...) AX2 18 MOVE UP SHIFT COUNT/2 LX2 1 NOW TRUE SHIFT COUNT SA1 TSRCTC1 TEN COPIES OF COMP. OF CHAR 1 SA3 TSRCOBJ AND SEARCH OBJECT BX4 X1 CHAR 1 TO X4 BX0 X3 OBJECT TO X0 SA1 TSRCTC2 LIKEWISE FOR CHAR 2 BX5 X1 INTO THE PROPER REGISTER NG X2,BINIT BRANCH IF REVERSE SB5 X2 SET UP SHIFT COUNT IN B5 * * ENTER HERE AFTER OK TIME CHECK (INTERRUPT NOT PERFORMED) * NLOOP SB1 1 B1 = 1 (STANDARD INCREMENT) SA1 TSRCST GET STARTING ADDRESS * SB4 X1+NWORDS SA2 X1-1 A2 = STARTING ADDRESS -1 SB2 B1+B1 B2 = 2 (FOR COMBINING BITS) LT B4,B7,SETEND JUMP IF NEED INTERRUPT TEST SB4 B7 B4 = END TEST = LAST SEARCH * ADDRESS +2 SETEND SX6 B4-B1 RESTART IN WORD PRECEDING END TEST SA6 A1 STORE BACK FOR NEXT TIME * * STORE WORD AT END TO GUARANTEE EXIT * SA1 B4 BX6 X1 SA6 SAVWORD BX7 X0 X7 HAS OBJECT SA7 B4 STORE AT END * * NOTE - - A7 HAS END TEST ADDRESS, (MUST BE SAVED FOR END TEST) * SA1 SPIKES READ UP MASK WITH EVERY 6TH BIT ON BX6 X1 X6 = SPIKE MASK * **************************************************** ************ REPEATED SEARCH LOOP ****************** **************************************************** * NSRCH SX1 B5-54 EXAMINE SHIFT COUNT ZR X1,SINGLE JUMP IF SINGLE CHAR LOOKUP * /--- BLOCK F-SEARCHLP 00 000 79/10/31 12.14 ****************************************** ********** SEARCH LOOP ************* ****************************************** * NXTWORD SA2 A2+B1 X2 = NEXT WORD TO SEARCH **** * TRAP 10/31/79 FRYE SB4 A2-B7 SEE IF WE WENT PAST END CHECK SA3 B1-B4 AND BLOW AWAY IF SO * **** BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE 1ST CHARACTER WAS LX3 X1,B1 SHIFT A COPY 1 BIT BX1 X1*X3 COMBINE EVEN AND ODD BITS LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS BX3 X1*X3 COMBINE AGAIN LX1 X3,B2 SHIFT THIS COMBO 2 BITS BX7 X1*X3 COMBINE ONCE AGAIN BX7 X6*X7 CLEAR THE JUNK WITH SPIKES * * X7 HAS THE TOP BIT OF EACH CHAR THAT MATCHED THE * 1ST CHAR OF THE STRING SET * ZR X7,NXTWORD LOOP IF NO MATCHES * * SPECIAL CHECK FOR CHAR IN POSITION 10 * BX1 X7 LX1 54 MOVE FLAG TEN TO SIGN BIT OF X1 PL X1,CHAR2ND JUMP OVER IF NOT * * IF YES THEN SEE IF NEXT WORD HAS 2ND CHAR AT TOP * SA3 A2+B1 X3 = FOLLOWING WORD BX1 -X5-X3 GET 6 ZEROS TO TOP IF MATCH AX1 54 SHIFT OFF THE REST OF THE JUNK ZR X1,INORDER JUMP IF MATCH (SKIP INTERMEDIATE TEST) MX1 54 ELSE WIPE OUT TENTH CHARACTER FLAG BX7 X1*X7 ZR X7,NXTWORD SEE IF THERE WERE ANY OTHER THAN NO. 10 * * SEE IF 2ND CHARACTER IS ALSO THERE * CHAR2ND BX1 X2-X5 MAKE 6 1-S EVERYWHERE THE 2ND CHARACTER WAS LX3 X1,B1 SHIFT A COPY 1 BIT BX1 X1*X3 COMBINE EVEN AND ODD BITS LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS BX3 X1*X3 COMBINE AGAIN LX1 X3,B2 SHIFT THIS COMBO 2 BITS BX3 X1*X3 COMBINE ONCE AGAIN LX3 6 MOVE REMAINING BITS FROM CHAR 2 BX7 X3*X7 ZR X7,NXTWORD IF NOT IN SEQUENCE GO TO NEXT WORD * /--- BLOCK F-IN ORDER 00 000 77/09/04 08.36 ********************************************************** ***** FIRST 2 CHARS ARE PRESENT AND IN ORDER ************* ********************************************************** SA3 A2+B1 X3 = FOLLOWING WORD * * IF IN CHAR POSITION 0, NO SHIFTING NECESSARY * INORDER SB3 B0 PRESET CHAR POSITION COUNTER BX1 X2 SET COMPARE WORD (X1) NG X7,COMPARE JUMP IF CHAR POSITION 0 * * LOOP TO DETERMINE OTHER 2 CHARACTER MATCHES * OCCLOOP SB3 B3+B1 B3 = CHAR POSITION (0-9) LX7 6 SHIFT FLAG WORD PL X7,OCCLOOP LOOP IF SIGN BIT OFF * * WHEN FLAG COMES INTO SIGN BIT CREATE COMPARE WORD * SB4 B3+B3 SB4 B4+B3 SB4 B4+B4 B4 = MASK LENGTH (B3*6) * SB4 B4-B1 SUBTRACT INITIAL MASK LENGTH MX1 1 INITIAL MASK AX1 X1,B4 FORM MASK IN X1, B4 BITS BX2 -X1*X2 CLEAR UNEEDED CHARS FROM WORD BX1 X1*X3 AND UNEEDED CHARS FROM WORD +1 BX1 X1+X2 PUT THEM TOGETHER SB4 B4+1 RESET B4 LX1 X1,B4 SHIFT TO PROPER POSITION * * NOW COMPARE WITH OBJECT * COMPARE LX7 1 AX7 1 CLEAR SIGN BIT (OCCLOOP END TEST) BX1 X1-X0 COMPARE WITH OBJECT AX1 X1,B5 ONLY AFTER SHIFTING OFF JUNK ZR X1,FOUNDIT IF PERFECT MATCH ZR X7,NXTWORD IF NO MORE TO TEST, GO TO NEXT WORD EQ OCCLOOP OTHERWISE LOOP * /--- BLOCK F-FOUNDOBJ 00 000 77/09/04 08.42 ********************************************************* *************** FOUND FULL STRING MATCH ***************** ********************************************************* * * CALCULATE CHARACTER LENGTH FROM BASE ADDRESS * FOUNDIT SB4 A0 A0 HAS BASE ADDRESS SX1 A2-B4 X1 = WORD COUNT SB4 X1 SB4 B4+X1 MULTIPLY BY 2 TO B4 LX1 3 MULTIPLY BY 8 TO X1 SB4 X1+B4 B4 = WORD COUNT * 10 SB4 B4+B3 SB4 B4+B1 B4 = CHAR LENGTH FROM BASE * * TEST TO MAKE SURE IT IS GREATER THAN OFFSET * SA1 TSRCMXM RESTORE CHECK WORD SB2 X1 AX1 18 LT B4,B2,RESRCH1 SEARCH MORE IF NOT * * TEST TO SEE IF GREATER THAN MAXIMUM CHAR LENGTH * SB2 X1 B2 HAS MAX CHAR COUNT SX6 -B1 X6 = SET FOR NOT FOUND GT B4,B2,NOTFND IF NOT FOUND, GO AND EXIT * * TEST TO SEE IF PLANTED INTERRUPT TEST (OR WORD BEFORE) * SX6 B4 X6 = CHARACTER POSITION OF FOUND MATCH SB2 A7-B1 SO WILL TEST FOR WORD BEFORE SB2 A2-B2 SUBTRACT FROM CURRENT ADDRESS GE B2,B0,TIMETST * /--- BLOCK F-STO/SNGL 00 000 77/09/04 08.39 * OKFIND SB6 B6-B1 DECREMENT COUNTER NG B6,RESRCH IF ONLY COUNT SEARCH * * * STORE NZ B6,RESRCH * * * SA1 A1 RESTORE FLAG WORD LX1 1 NG X1,EXIT * * GET READY TO SEARCH AGAIN * RESRCH SA1 SPIKES BRING UP SPIKED WORD BX6 X1 RESRCH1 SB2 B1+B1 RESET B2 ZR X7,NSRCH SX1 B5-54 NZ X1,OCCLOOP RETURN TO LOOP IF MULTIPLE CHAR SEARCH EQ SINGLP OTHERWISE GOTO SINGLE LOOP * * ********************************************************** ************ SINGLE CHARACTER SEARCH ********************* ********************************************************** * SINGLE SA2 A2+B1 X2 = NEXT WORD TO BE CHECKED BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE CHARACTER WAS LX3 X1,B1 SHIFT A COPY 1 BIT BX1 X1*X3 COMBINE EVEN AND ODD BITS LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS BX3 X1*X3 COMBINE AGAIN LX1 X3,B2 SHIFT THIS COMBO 2 BITS BX7 X1*X3 COMBINE ONCE AGAIN BX7 X6*X7 CLEAR THE JUNK WITH SPIKES * * NOW HAVE A 1 IN TOP BIT OF ANY CHAR POSITION WHICH * MATCHED FIRST CHARACTER OF STRING * ZR X7,SINGLE LOOP IF NO MATCHES SB3 B0 PRESET CHAR POSITION COUNT BX1 X7 SO CAN TEST X1 INSTEAD OF X7 LX7 1 AX7 1 GET RID OF SIGN BIT NG X1,FOUNDIT IF FOUND IN 1ST CHAR POSITION * SINGLP SB3 B3+B1 INCREMENT CHAR POSITION COUNT LX7 6 SHIFT FLAG REGISTER PL X7,SINGLP LOOP IF NO SIGN BIT NOT ON MX1 1 BX7 -X1*X7 GET RID OF SIGN BIT (FOR LOOP END TEST) EQ FOUNDIT SEEK AND STORE RESULT * * * /--- BLOCK B-NO INTER 00 000 77/09/14 05.42 TITLE REVERSE SEARCH LOOP * * ENTER HERE AFTER INTERRUPT OR SETUP * BINIT SX1 76B MASK FOR SHIFT COUNT BX2 X1*X2 CLEAR OUT JUNK BITS SB5 X2 MOVE SHIFT COUNT TO B5 * * ENTER HERE AFTER OK TIME CHECK (INTERRUPT NOT PERFORMED) * BNLOOP SB1 1 B1 = 1 (STANDARD INCREMENT) SA1 TSRCST GET STARTING ADDRESS * SB4 X1-NWORDS SA2 X1+1 A2 = STARTING ADDRESS +1 SB2 B1+B1 B2 = 2 (FOR COMBINING BITS) GT B4,B7,BSETEND JUMP IF NEED INTERRUPT TEST SB4 B7 B4 = END TEST = LAST SEARCH * ADDRESS - 1 BSETEND SX6 B4 TO RESTART AT PLANTED WORD SA6 A1 STORE RESTART ADDRESS * * STORE WORD AT END TO GUARANTEE EXIT * SA1 B4 BX6 X1 SA6 SAVWORD BX7 X0 X7 HAS OBJECT SA7 B4 STORE AT END * * NOTE - - A7 HAS END TEST ADDRESS, (MUST BE SAVED FOR END TEST) * SA1 SPIKES READ UP MASK WITH EVERY 6TH BIT ON BX6 X1 X6 = SPIKE MASK * **************************************************** ************ REPEATED SEARCH LOOP ****************** ***************************************************** * BNSRCH SX1 B5-54 EXAMINE SHIFT COUNT ZR X1,BSINGLE JUMP IF SINGLE CHAR LOOKUP * /--- BLOCK B-SEARCHLP 00 000 77/09/04 08.42 ****************************************** ********** SEARCH LOOP ************* ****************************************** * BNXTWRD SA2 A2-B1 X2 = NEXT WORD TO SEARCH BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE 1ST CHARACTER WAS LX3 X1,B1 SHIFT A COPY 1 BIT BX1 X1*X3 COMBINE EVEN AND ODD BITS LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS BX3 X1*X3 COMBINE AGAIN LX1 X3,B2 SHIFT THIS COMBO 2 BITS BX7 X1*X3 COMBINE ONCE AGAIN BX7 X6*X7 CLEAR THE JUNK WITH SPIKES * * X7 HAS THE TOP BIT OF EACH CHAR THAT MATCHED THE * 1ST CHAR OF THE STRING SET * ZR X7,BNXTWRD LOOP IF NO MATCHES * * SPECIAL CHECK FOR CHAR IN POSITION 10 * BX1 X7 LX1 54 MOVE FLAG TEN TO SIGN BIT OF X1 PL X1,BCHR2ND JUMP OVER IF NOT * * IF YES THEN SEE IF NEXT WORD HAS 2ND CHAR AT TOP * SA3 A2+B1 X3 = FOLLOWING WORD BX1 -X5-X3 GET 6 ZEROS TO TOP IF MATCH AX1 54 SHIFT OFF THE REST OF THE JUNK ZR X1,BINORDR JUMP IF MATCH (SKIP INTERMEDIATE TEST) MX1 54 ELSE WIPE OUT TENTH CHARACTER FLAG BX7 X1*X7 ZR X7,BNXTWRD SEE IF THERE WERE ANY OTHER THAN NO. 10 * * SEE IF 2ND CHARACTER IS ALSO THERE * BCHR2ND BX1 X2-X5 MAKE 6 1-S EVERYWHERE THE 2ND CHARACTER WAS LX3 X1,B1 SHIFT A COPY 1 BIT BX1 X1*X3 COMBINE EVEN AND ODD BITS LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS BX3 X1*X3 COMBINE AGAIN LX1 X3,B2 SHIFT THIS COMBO 2 BITS BX3 X1*X3 COMBINE ONCE AGAIN LX3 6 MOVE REMAINING BITS FROM CHAR 2 BX7 X3*X7 ZR X7,BNXTWRD IF NOT IN SEQUENCE GO TO NEXT WORD * /--- BLOCK B-IN ORDER 00 000 78/01/12 00.59 ********************************************************** ***** FIRST 2 CHARS ARE PRESENT AND IN ORDER ************* ********************************************************** SA3 A2+B1 X3 = FOLLOWING WORD * BINORDR SB3 10 PRESET CHAR POSITION COUNTER * * LOOP TO FIND 2 CHARACTER MATCHES FROM THE END BACKWARDS * BOCLOOP SB3 B3-B1 B3 = CHAR POSITION (0-9) LX7 -6 SHIFT FLAG WORD PL X7,BOCLOOP LOOP IF SIGN BIT OFF ZR B3,B1ST JUMP IF IN 1ST CHAR POSITION * * WHEN FLAG COMES INTO SIGN BIT CREATE COMPARE WORD * SB4 B3+B3 SB4 B4+B3 SB4 B4+B4 B4 = MASK LENGTH (B3*6) * SB4 B4-B1 SUBTRACT INITIAL MASK LENGTH MX1 1 INITIAL MASK AX1 X1,B4 FORM MASK IN X1, B4 BITS BX3 X1*X3 CLEAR UNNEEDED BITS FROM WORD 2 BX1 -X1*X2 AND FROM WORD 1 BX1 X1+X3 PUT THEM TOGETHER SB4 B4+1 RESET B4 LX1 X1,B4 SHIFT TO PROPER POSITION * * NOW COMPARE WITH OBJECT * BCOMPAR LX7 1 AX7 1 CLEAR SIGN BIT (BOCLOOP END TEST) BX1 X1-X0 COMPARE WITH OBJECT AX1 X1,B5 ONLY AFTER SHIFTING OFF JUNK ZR X1,BFOUND IF PERFECT MATCH ZR X7,BNXTWRD IF NO MORE TO TEST, GO TO PRECEDING WORD EQ BOCLOOP OTHERWISE LOOP * B1ST BX1 X2 GET COMPARISON WORD EQ BCOMPAR NOW DO COMPARE * /--- BLOCK B-FOUNDOBJ 00 000 77/09/12 12.10 ********************************************************* *************** FOUND FULL STRING MATCH ***************** ********************************************************* * * CALCULATE CHARACTER LENGTH FROM BASE ADDRESS * BFOUND SB4 A0 A0 HAS BASE ADDRESS SX1 A2-B4 X1 = WORD COUNT SB4 X1 SB4 B4+X1 MULTIPLY BY 2 TO B4 LX1 3 MULTIPLY BY 8 TO X1 SB4 X1+B4 B4 = WORD COUNT * 10 SB4 B4+B3 SB4 B4+B1 B4 = CHAR LENGTH FROM BASE * * TEST TO MAKE SURE IT IS LESS THAN OFFSET * SA1 TSRCMXM RESTORE CHECK WORD SB2 X1 AX1 18 GT B4,B2,BRSRCH1 IF TOO FAR, SEARCH MORE * * TEST TO SEE IF LESS THAN LOWEST VALUE * SB2 X1 B2 HAS MAX CHAR COUNT SX6 -B1 X6 = SET FOR NOT FOUND LT B4,B2,NOTFND EXIT IF TOO SMALL * * TEST TO SEE IF PLANTED INTERRUPT TEST * DON'7T NEED TO CHECK PRECEDING WORD LIKE FORWARD... * SX6 B4 X6 = CHARACTER POSITION OF FOUND MATCH SB2 A7 SB2 A2-B2 SUBTRACT FROM CURRENT ADDRESS EQ B2,B0,TIMETST * /--- BLOCK B-STO/SNGL 00 000 77/09/12 12.09 * BOKFIND SB6 B6-B1 DECREMENT COUNTER NG B6,BRESRCH IF ONLY COUNT SEARCH * * * STORE NZ B6,BRESRCH * * * SA1 A1 RESTORE FLAG WORD LX1 1 NG X1,EXIT * * GET READY TO SEARCH AGAIN * BRESRCH SA1 SPIKES BRING UP SPIKED WORD BX6 X1 BRSRCH1 SB2 B1+B1 RESET B2 ZR X7,BNSRCH SX1 B5-54 NZ X1,BOCLOOP RETURN TO LOOP IF MULTIPLE CHAR SEARCH EQ BSINGLP OTHERWISE GOTO SINGLE LOOP * * ********************************************************** ************ SINGLE CHARACTER SEARCH ********************* ********************************************************** * BSINGLE SA2 A2-B1 X2 = PREVIOUS WORD BEING CHECKED BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE CHARACTER WAS LX3 X1,B1 SHIFT A COPY 1 BIT BX1 X1*X3 COMBINE EVEN AND ODD BITS LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS BX3 X1*X3 COMBINE AGAIN LX1 X3,B2 SHIFT THIS COMBO 2 BITS BX7 X1*X3 COMBINE ONCE AGAIN BX7 X6*X7 CLEAR THE JUNK WITH SPIKES * * NOW HAVE A 1 IN TOP BIT OF ANY CHAR POSITION WHICH * MATCHED FIRST CHARACTER OF STRING * ZR X7,BSINGLE LOOP IF NO MATCHES SB3 10 PRESET CHAR POSITION COUNT BSINGLP SB3 B3-B1 DECREMENT CHAR POSITION COUNT LX7 -6 SHIFT FLAG REGISTER PL X7,BSINGLP LOOP IF NO SIGN BIT NOT ON MX1 1 BX7 -X1*X7 GET RID OF SIGN BIT (FOR LOOP END TEST) EQ BFOUND SEEK AND STORE RESULT * * * /--- BLOCK FINISH/TIM 00 000 80/04/22 01.21 * * NOT FOUND * NOTFND SB6 B6-B1 DECREMENT COUNTER NG B6,CNTCALC IF COUNT ONLY WAS CALCULATED STORE SA1 A1 RESTORE FLAG WORD LX1 1 NG X1,EXIT CNTCALC SB6 B6+B1 SET COUNT BACK AGAIN SA1 A1 RESTORE FLAG WORD AX1 36 X2 = INITIAL RESULT ADDRESS * SB2 X1 SB3 A4-B6 SX6 B3-B2 * PL X1,STORCNT IF NOT FLOATING, STORE AS INT PX6 X6 NX6 X6 PACK AND NORMALIZE STORCNT SA6 X1 STORE COUNT * * CLEAN UP AND EXIT * EXIT SA2 A7 IX2 X2-X0 NZ X2,NOREST SA1 SAVWORD BX6 X1 SA6 A7 NOREST SA1 SAVEB5 AND B REGISTERS SA2 SAVEB7 SB5 X1 SB7 X2 EQ PROCESX -- AND EXIT * * COME HERE AFTER HITTING THE PLANTED OBJECT TO SEE * IF TIME SLICE IS OVER AND SEARCH SHOULD BE INTERRUPTED * TIMETST SA1 A7 FETCH WORD USED FOR END TEST BX1 X0-X1 COMPARE WITH OBJECT NZ X1,NOREST2 DONT RESTORE IF NOT EQUAL SA1 SAVWORD BX6 X1 SA6 A7 RESTORE WORD DESTROYED BY END TEST * NOREST2 SA1 XSLCLOK GET RUNNING CPU CLOCK SA2 MAXCLOK GET END OF TIME-SLICE IX2 X1-X2 SA1 TSRCEND GET DIRECTION INDICATION PL X2,AUTOBRK INTERRUPT IF TOO MUCH TIME PL X1,NLOOP CONTINUE FORWARD SEARCH EQ BNLOOP ... OR BACKWARD SEARCH * /--- BLOCK INTERRUPT 00 000 78/05/17 20.51 * * PACK UP ALL VITAL REGISTERS TO SAVE DURING INTERRUPT * AUTOBRK SX6 B6 NEED TO SAVE STORE INDEX SA6 TSRCINX SO DO IT * * RESTORE B REGISTERS * SA1 SAVEB5 SA2 SAVEB7 SB5 X1 SB7 X2 * * * PERFORM INTERRUPT * RETURN DO THE INTERRUPT * * OUT OF LINE ROUTINES, LITERALS AND STORAGE LOCATIONS * SPIKES VFD 60/40404040404040404040B SRCHSAV BSS 1 STORES FIRST ARGUMENT WORD SRCHSV2 BSS 1 STORES SECOND ARGUMENT WORD SRCHLEN BSS 1 LENGTH OF SEARCH IN CHARS SRCHOBL BSS 1 LENGTH OF SEARCH OBJECT SAVEB5 BSS 1 SAVES B5 SAVEB7 BSS 1 SAVES B7 SAVWORD BSS 1 CONTAINS WORD USED FOR END TEST SRCHADR BSS 1 RESULT BUFFER ADDRESS * * EXEC ERROR FOR OFFSET TOO LARGE * SERX SX2 B3+1 SET UP FOR EXEC ERROR ROUTINE EXECERR 101 * * EXIT IF NO SEARCH * NOSRCH MX6 -1 SA1 TSRCMXM GET WORD CONTAINING RESULT ADDR BX2 X1 LX2 1 GET MULTIPLE SEARCH BIT TO TOP AX1 36 BRING ADDRESS DOWN PL X1,NOSRCH2 BRANCH IF STORING INTEGERS PX6 X6 NX6 X6 FLOAT THE -1 NOSRCH2 NG X2,NOSRCH3 BRANCH IF SINGLE SEARCH MX7 0 SA7 X1 SET COUNTER TO 0 SX1 A7+1 UPDATE STORAGE ADDRESS SA2 TSRCINX CHECK IF COUNT ONLY DESIRED ZR X2,PROCESX EXIT IF SO NOSRCH3 SA6 X1 STORE -1 FOR NOT FOUND EQ PROCESX AND EXIT * * ENDOV * /--- BLOCK ABORT 00 000 80/07/16 01.35 TITLE -ABORT- COMMAND * * -ABORT- COMMAND * ABORT VARIOUS SYSTEM FUNCTIONS * * ABORTOV OVRLAY PL X5,ABORTR SEE IF ABORT COMMON * * * ABORT RETURN OF COMMON TO DISK * SA1 TBCOMLS GET COMMON LESSON NUMBER SX0 X1 ZR X0,ABRTER1 EXIT IF NO COMMON LX1 1 NG X1,ERXROLC EXIT IF READ-ONLY COMMON SX1 X0 GET *LESNUM* CALL LSNADDR SX1 1 IX0 X0+X1 ADVANCE TO LESSON NAME WORD SA1 CABORT GET *ABORT* CODE WORD WX1 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*) * * /--- BLOCK ABORT 00 000 79/04/07 01.15 ABORTR LX5 1 SEE IF ABORT RECORD PL X5,ABORTN MX6 6 MASK TO CHECK TOP CHARACTER SA1 TTYPE USER TYPE SA2 TYPETAB+UT.STUD BX2 X2-X1 BX2 X2*X6 CHECK ONLY FIRST CHARACTER NZ X2,ABORTN --- IGNORE IF NOT STUDENT SA2 KABORT X2 = 6LSABORT BX6 X2 SA6 A1 SET RECORDS TO -SABORT- EQ ABORTN1 NOW SET CHECKPOINT OFF FLAG * * 'NOW USER PART OF RECORDS WILL NOT BE UPDATED * ON DISK, BUT LAST DATE, CPU USE, ETC. WILL. * ABORTN LX5 1 SEE IF ABORT AUTO-CHECK-POINT PL X5,ABORTL SA1 TTYPE USER TYPE SA2 TYPETAB+UT.STUD BX2 X2-X1 NZ X2,ABORTL --- IGNORE IF NOT STUDENT SA2 KNOCKPT X2 = 7LSNOCKPT BX6 X2 SA6 A1 SET RECORDS TO -SNOCKPT- * ABORTN1 SA1 TRECBIT GET WORD HOLDING CHECKPT FLAG MX6 1 LX6 60-CCHKSHF POSITION CHECKPOINT BIT BX6 -X6*X1 CLEAR BIT (TURN CHECKPOINT OFF) MX1 1 LX1 60-DCHKSHF POSITION BIT FOR DEFAULT BX6 -X1*X6 CLEAR CHECKPT DEFAULT SA6 A1 CALL CHKSET SET OVERALL CHECKPT STATUS * ABORTL LX5 1 SEE IF ABORT LESLIST PL X5,ABORTZ SA1 TBLLIST GET LESLIST LESSON NUMBER SX0 X1 ZR X0,ABRTER3 EXIT IF NO LESLIST SX1 X0 GET *LESNUM* CALL LSNADDR SX1 1 IX0 X0+X1 ADVANCE TO LESSON NAME WORD SA1 CABORT GET *ABORT* CODE WORD WX1 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*) * ABORTZ EQ PROC * * ABRTER1 EXECERR 53 *NO COMMON* * ABRTER3 EXECERR 55 *NO LESLIST* * * CABORT VFD 60/9L**ABORT** * * ENDOV * /--- BLOCK CHECKPT 00 000 80/03/11 03.01 TITLE -CHECKPT- COMMAND * * * -CHECKPT- COMMAND * TURN STUDENT RECORD CHECKPOINTING ON OR OFF * * AFTER EXECUTION OF -CHECKPT- COMMAND, * * ZRETURN = -1 = IT WORKED * = 0 = WRONG USER TYPE * * CKPTOV OVRLAY SX6 0 SA6 TRETURN PRESET *ZRETURN* FOR FAILURE SA1 TTYPE GET USER TYPE SA2 TYPETAB+UT.STUD BX2 X1-X2 ZR X2,CKPT0 --- OK IF STUDENT SA2 TYPETAB+UT.INST BX2 X1-X2 NZ X2,PROC --- IGNORE IF NOT INSTRUCTOR CKPT0 NGETVAR MX6 1 LX6 60-CCHKSHF POSITION CHECKPOINT BIT SA2 TRECBIT WORD HOLDING CHECKPOINT FLAG NZ X1,CKPTON --- JUMP IF -CHECKPT ON- * BX6 -X6*X2 CLEAR BIT (CHECKPOINT OFF) EQ CKPT1 * CKPTON BX6 X6+X2 SET BIT (CHECKPOINT ON) * CKPT1 CALL INROUTE PL X1,CKPT2 IF NOT EXECUTING ROUTER BX1 X6 LX1 CCHKSHF SHIFT CURRENT STATUS TO SIGN MX0 1 BX1 X0*X1 X1 = CURRENT CHECKPT STATUS LX0 60-DCHKSHF SHIFT BIT TO DEFAULT STATUS BX6 -X0*X6 CLEAR DEFAULT STATUS LX1 60-DCHKSHF SHIFT CURRENT STATUS TO DEFAULT BX6 X1+X6 RESET DEFAULT STATUS CKPT2 SA6 A2 UPDATE *TRECBIT* CALL CHKSET SET OVERALL CHECKPT STATUS SX6 -1 SA6 TRETURN SET *ZRETURN* TO ALL OK EQ PROC * ENDOV * /--- BLOCK STOLOAD 00 000 76/08/17 16.40 TITLE -STOLOAD- COMMAND * * * -STOLOAD- COMMAND * SETS AUTOMATIC LOADING OF -STORAGE- * * STOLOV OVRLAY SA1 OVARG1 NZ X1,COMLOD JUMP IF -COMLOAD- COMMAND * SA1 TBXSTOR SEE IF ANY -STORAGE- ZR X1,SCLONO CALL READLES,LHEADER,1 SX6 2 IX6 X0+X6 BIAS TO STORAGE SA6 LLECSAD SA1 INHIBS MX6 1 CLEAR -UNLOAD- BIT LX6 60-UNLOSHF BX6 -X6*X1 SA6 A1 LX1 UNLOSHF SEE IF INHIBIT -UNLOAD- NG X1,STOLO1 SA1 TSTOSET ZR X1,STOLO1 JUMP IF NO STORAGE AUTO-LOAD SA2 TBXSTOR STORAGE LESSON NUMBER SX3 2 BIAS FOR STORAGE HEADER CALL LESSADD RJ ULOADER DO FIRST UNLOAD SA1 TSTOSET+1 ZR X1,STOLO1 RJ ULOADER DO SECOND UNLOAD SA1 TSTOSET+2 ZR X1,STOLO1 RJ ULOADER DO THIRD UNLOAD * STOLO1 MX6 0 SA6 TSTOSET CLEAR CURRENT SELECTIONS SA6 TSTOSET+1 SA6 TSTOSET+2 SX6 TSTOSET SA6 LBUFF CALL LOADSET MX6 1 SA1 INHIBS CLEAR -INHIBIT LOAD- BIT LX6 60-LOADSHF BX6 -X6*X1 SA6 A1 EQ PROCESS * * * /--- BLOCK COMLOAD 00 000 77/07/21 20.50 TITLE -COMLOAD- COMMAND * * * -COMLOAD- COMMAND * SETS AUTOMATIC LOADING OF -COMMON- * * COMLOD SA1 TBCOMLS SEE IF ANY -COMMON- SX1 X1 ZR X1,SCLONO CALL READLES,LHEADER,1 SX6 COMHEAD IX6 X0+X6 BIAS TO COMMON SA6 LLECSAD SA1 INHIBS MX6 1 CLEAR -UNLOAD- BIT LX6 60-UNLOSHF BX6 -X6*X1 SA6 A1 LX1 UNLOSHF SEE IF INHIBIT -UNLOAD- NG X1,COMLO1 SA1 TCOMSET ZR X1,COMLO1 JUMP IF NO COMMON AUTO-LOAD SA3 TBCOMLS SX2 X3 PICK OFF LESSON NUMBER LX3 1 NG X3,COMLO1 JUMP IF READ-ONLY COMMON SX3 COMHEAD CALL LESSADD GET ADDRESS OF COMMON LESSON RJ ULOADER DO FIRST UNLOAD SA1 TCOMSET+1 ZR X1,COMLO1 RJ ULOADER DO SECOND UNLOAD SA1 TCOMSET+2 ZR X1,COMLO1 RJ ULOADER DO THIRD UNLOAD * COMLO1 MX6 0 SA6 TCOMSET CLEAR CURRENT SELECTIONS SA6 TCOMSET+1 SA6 TCOMSET+2 SX6 TCOMSET SA6 LBUFF CALL LOADSET MX6 1 SA1 INHIBS CLEAR -INHIBIT LOAD- BIT LX6 60-LOADSHF BX6 -X6*X1 SA6 A1 EQ PROCESS * * SCLONO MX0 XCODEL COMES HERE IF NO COMMON/STORAGE BX6 X0*X5 MASK OFF NUMBER OF ARGUMENTS ZR X6,PROCESS OKAY IF BLANK TAG EQ ERXNOCS * * /--- BLOCK LOADSET 00 000 79/02/09 13.56 * TITLE -LOADSET- * * * -LOADSET- * EXECUTION OF -STOLOAD- AND -COMLOAD- COMMANDS * * LOADSET EQ * MX0 XCODEL BX6 X0*X5 MASK OFF NUMBER OF ARGUMENTS ZR X6,LOADSET LX6 XCODEL SA6 NLOADS MX0 -12 AX5 XCMNDL BX6 -X0*X5 MASK OFF XSTOR ADDRESS SX6 X6+B5 SA6 GVADD SAVE ABSOLUTE ADDRESS * LOLOOP SA1 GVADD SA1 X1 LOAD WORD OF -GETVAR- CODES BX5 X1 NGETVAR SX6 A1 SAVE CM ADDRESS FOR LOADING SA6 VBUFF SX1 NCVRBUF IX6 X6-X1 CANNOT LOAD INTO STUDENT BANK NG X6,LDERR1 OR ROUTER VARIABLES SA1 GVADD SA1 X1 LX1 XCODEL POSITION NEXT -GETVAR- CODE BX5 X1 NGETVAR GET ECS ADDRESS FOR LOADING SX6 X1-1 EXECERR USES X1 NG X6,ERXINDL INDEX ERROR ON LOWER BOUND SA6 VBUFF+1 SA1 GVADD SX7 X1+1 ADVANCE POINTER SA7 A1 SA1 X1 LOAD WORD OF -GETVAR- CODES LX1 2*XCODEL BX5 X1 NGETVAR GET LENGTH TO LOAD/UNLOAD ZR X1,LDSKIP IF LENGTH 0, IGNORE NG X1,ERXBADL EXECERR USES X1 * SA2 VBUFF LOAD CM ADDRESS FOR LOADING SA0 X2 CALL BOUNDS CM BOUNDS CHECK SX6 X1 SA1 LHEADER SX1 X1 LENGTH OF -STORAGE- SA2 VBUFF+1 STARTING ECS ADDRESS OF LOAD IX0 X2+X6 IX0 X1-X0 DO ECS BOUNDS CHECK NG X0,ERXECSB1 EXCEEDING BOUNDS * /--- BLOCK LOADSET 00 000 77/08/07 21.26 * BX0 X2 LX2 18 POSITION ECS ADDRESS SB1 X6 LX6 18+18 POSITION LENGTH BX6 X2+X6 SA1 VBUFF SA0 X1 BX6 X1+X6 ATTACH CM ADDRESS SA1 INHIBS LX1 LOADSHF SEE IF -INHIBIT- LOAD NG X1,LOLP1 SA1 LLECSAD IX0 X0+X1 COMPUTE ECS ADDRESS + RE B1 DO THE LOAD RJ ECSPRTY * LOLP1 SA1 NLOADS SX7 X1-1 NUMBER OF SETS TO DO SA7 A1 SA1 LBUFF *TSTOSET* / *TCOMSET* POINTER SA6 X1 SX6 X1+1 SA6 A1 UPDATE POINTER NG X7,LOADSET ZR X7,LOADSET EQ LOLOOP * LDSKIP SA1 NLOADS IF LENGTH=0, SKIP IT SX7 X1-1 SA7 A1 RESET NLOADS SB1 X7 LE B1,LOADSET EQ LOLOOP * * LDERR1 EXECERR 67 *NOT NC OR VC VARIABLES* * ERXECSB1 BX3 X1 LTH OF ECS COM/STO BX1 X2 START ADDRESS SX1 X1+1 BX2 X6 TOTAL LTH REQUESTED EQ ERXECSB * * /--- BLOCK LOADSET 00 000 80/02/22 23.37 LOADER EQ * SA0 X1 PICK OFF CM ADDRESS AX1 18 SX2 X1 PICK OFF ECS BIAS AX1 18 SB1 X1 PICK OFF LENGTH TO LOAD IX0 X2+X7 + RE B1 RJ ECSPRTY EQ LOADER * * ULOADER EQ * SA0 X1 PICK OFF CM ADDRESS AX1 18 SX2 X1 PICK OFF ECS BIAS AX1 18 SB1 X1 PICK OFF LENGTH TO UNLOAD IX0 X2+X7 + WE B1 RJ ECSPRTY EQ ULOADER * LBUFF EQU VARBUF LLECSAD EQU LBUFF+1 LHEADER EQU LLECSAD+1 NLOADS EQU LHEADER+1 GVADD EQU NLOADS+1 VBUFF EQU GVADD+1 * * ENDOV * /--- BLOCK TRANSFER 00 000 78/05/17 20.51 TITLE TIMING COMMANDS * * TIMOV OVRLAY * * * ENSURE THAT THERE IS ENOUGH SPACE IN THE ACTION * * REQUEST BUFFER--AS OUTPUT OVERFLOW IS FATAL * EXT RETRNZ SA1 AOUTLOC CHECK WHETHER THERE IS SX1 X1-AOUTLTH+8 ROOM FOR TWO TIMING REQUESTS PL X1,RETRNZ RE-START THIS COMMAND NEXT TIME * * * IT SHOULD NO LONGER BE POSSIBLE TO GET AN OUTPUT * * BUFFER OVERFLOW FROM -TIME- COMMANDS. A NUMBER OF * * USERS LOOPING ON -TIME- COMMANDS CAN INTEFERE WITH * * THE ORDERLY PROCESSING OF ACTION BUFFER REQUESTS * * BY FILLING UP THE BUFFER (THERE WILL BE 4 WORDS LEFT) * * CORRECTION BY B. RADER /DMA 3/2/77 * SA1 OVARG1 SB1 X1 JP B1+*+1 * + EQ TIMEX + EQ TIMELX + EQ TIMERX * * * /--- BLOCK TIME 00 000 81/06/24 21.45 * * -TIME- * INITIATES TIMING FOR SPECIFIED NUMBER OF SECONDS. * TIMEX NG X5,TIMEOFF TURN OFF TIMING IN BLANK TAG FGETVAR GET TIMING VALUE NG X1,TIMEOFF TURN OFF TIMING IF NEGATIVE TAG SA2 TK1000 CONVERT TO MILLISECONDS FX7 X1*X2 UX7 X7,B1 CONVERT TO INTEGER LX7 X7,B1 SX2 750 CONVERT SHORTER THAN 3/4 SEC. IX2 X7-X2 TO 3/4 SECONDS + PL X2,*+1 SX7 750 + SA3 AOUTLOC THEN PUT IN TIMING REQUEST SX6 X3+4 TAKES FOUR WORDS SX2 X3-AOUTLTH OVERFLOW CHECK PL X2,ERROROF SA6 A3 UPDATE NUMBER OF OUTPUT WORDS SX6 RQTIMNG PUT IN TIMING REQUEST CODE SA6 X3+ACTOUT SA7 A6+1 PUT IN TIME SX6 TK.TUP KEY = PTIMEUP SA6 A7+1 PUT IN KEY SX6 TRT.TIM -TIME- COMMAND REQUEST SA6 A6+1 PUT IN REQUEST TYPE * SA2 TIMING TURN ON TIMING FLAG MX6 1 BX2 X2+X6 LX6 TMEDONE-59 CLEAR -TIME- UNPROCESSED FLAG BX6 -X6*X2 SA6 A2 EQ PROCESS * TIMEOFF SA2 TIMING SEE IF TIMING IN PROGRESS PL X2,PROCESS EXIT IF NOT MX6 1 TURN OFF TIMING FLAG BX2 -X6*X2 LX6 TMEDONE-59 CLEAR -TIME- UNPROCESSED BIT BX6 -X6*X2 SA6 A2 * SA3 AOUTLOC PUT IN CLEAR TIMING REQUEST SX6 X3+2 TAKES TWO WORDS SX2 X3-AOUTLTH OVERFLOW CHECK PL X2,ERROROF SA6 A3 UPDATE NUMBER OF OUTPUT WORDS SX6 RQTIMCL SA6 X3+ACTOUT SX6 TRT.TIM CLEAR -TIME- REQUEST SA6 A6+1 EQ PROCESS * /--- BLOCK TIMEL 00 000 81/06/24 21.46 TITLE -TIMEL- * * -TIMEL- COMMAND * * SPECIFIES UNIT OF LESSON TO GO TO AFTER * SPECIFIED NUMBER OF SECONDS. * * TIMELX NG X5,TMLOFF TURN OFF TIMEL'/ MX0 -XCODEL LX5 XCODEL POSITION UNIT NUMBER BX6 -X0*X5 SA6 ILOC SAVE UNIT NUMBER * FGETVAR GET NUMBER OF SECONDS NG X1,TMLOFF TURN OFF IF NEGATIVE SA2 TK1000 CHANGE SECONDS TO MILLISECONDS FX1 X2*X1 UX1 X1,B1 UNPACK TO INTEGER LX6 X1,B1 SX2 750 3/4 SECOND IX1 X6-X2 CONVERT TIMES LESS THAN .75 SEC + PL X1,*+1 SX6 750 TO .75 SECONDS + SA6 ILOC+1 SAVE TIME AMOUNT * SA1 ILOC CALL UEXIST CHECK IF UNIT EXISTS ZR X6,TMLOFF IF DONT, TURN TIMEL OFF SA2 TIMING IF EXISTS, SAVE UNIT NUMBER MX6 -12 TURN OFF OLD UNIT NUMBER BX2 X2*X6 BX2 X2+X1 .OR. IN NEW UNIT NUMBER MX6 1 CLEAR -TIMEL- UNPROCESSED BIT LX6 TMLDONE-59 BX6 -X6*X2 SA6 A2 * * SET UP TIMING REQUEST FOR [ILOC+1] MILLISECONDS, SA3 AOUTLOC SX6 X3+4 TAKES FOUR WORDS SX2 X3-AOUTLTH OVERFLOW CHECK PL X2,ERROROF SA6 A3 UPDATE NUMBER OF OUTPUT WORDS SX6 RQTIMNG PUT IN TIMING REQUEST CODE SA6 X3+ACTOUT SA1 ILOC+1 GET TIME AMOUNT BX6 X1 SA6 A6+1 PUT IN TIME SX6 TK.LUP KEY = PLONGUP SA6 A6+1 PUT IN KEY SX6 TRT.TML -TIMEL- COMMAND REQUEST SA6 A6+1 EQ PROCESS * * TMLOFF SA3 AOUTLOC PUT IN CLEAR TIMING REQUEST SX6 X3+2 TAKES TWO WORDS SX2 X3-AOUTLTH OVERFLOW CHECK PL X2,ERROROF SA6 A3 UPDATE NUMBER OF OUTPUT WORDS SX6 RQTIMCL SA6 X3+ACTOUT SX6 TRT.TML CLEAR -TIMEL- REQUEST SA6 A6+1 * * CLEAR -TIMEL- UNIT NUMBER FROM *TIMING* SA2 TIMING MX6 -12 BOTTOM 12 BITS BX2 X6*X2 MX6 1 CLEAR -TIMEL- UNPROCESSED FLAG LX6 TMLDONE-59 BX6 -X6*X2 SA6 A2 EQ PROCESS * /--- BLOCK TIMER 00 000 81/06/24 21.47 TITLE -TIMER- * * -TIMER- COMMAND * * SPECIFIES UNIT OF ROUTER TO BRANCH TO AFTER * SPECIFIED NUMBER OF SECONDS. * * TIMERX CALL INROUTE PL X1,PROC IF NOT IN ROUTER LESSON NG X5,TMROFF TURN OFF TIMER'/ MX0 -XCODEL LX5 XCODEL POSITION UNIT NUMBER BX6 -X0*X5 SA6 ILOC SAVE UNIT NUMBER * FGETVAR GET NUMBER OF SECONDS NG X1,TMROFF TURN OFF IF NEGATIVE SA2 TK1000 CHANGE SECONDS TO MILLISECONDS FX1 X2*X1 UX1 X1,B1 UNPACK TO INTEGER LX6 X1,B1 SA2 TK1MIN 1 MINUTES (IN MILLISECONDS) IX1 X6-X2 CONVERT TIMES LESS THAN 1 MIN + PL X1,*+1 BX6 X2 TO 1 MIN + SA6 ILOC+1 SAVE TIME AMOUNT * SA1 ILOC CALL UEXIST CHECK IF UNIT EXISTS ZR X6,TMROFF IF DONT, TURN TIMER OFF SA2 TIMING IF EXISTS, SAVE UNIT NUMBER MX6 -12 TURN OFF OLD UNIT NUMBER LX1 12 -TIMER- UNIT NEXT TO BOTTOM 12 LX6 12 MOVE MASK UP TOO BX2 X2*X6 BX2 X2+X1 .OR. IN NEW UNIT NUMBER MX6 1 CLEAR -TIMER- UNPROCESSED FLAG LX6 TMRDONE-59 BX6 -X6*X2 SA6 A2 * * SET UP TIMING REQUEST FOR [ILOC+1] MILLISECONDS, SA3 AOUTLOC SX6 X3+4 TAKES FOUR WORDS SX2 X3-AOUTLTH OVERFLOW CHECK PL X2,ERROROF SA6 A3 UPDATE NUMBER OF OUTPUT WORDS SX6 RQTIMNG PUT IN TIMING REQUEST CODE SA6 X3+ACTOUT SA1 ILOC+1 GET TIME AMOUNT BX6 X1 SA6 A6+1 PUT IN TIME SX6 TK.RUP KEY = PROUTUP SA6 A6+1 PUT IN KEY SX6 TRT.TMR -TIMER- COMMAND REQUEST SA6 A6+1 EQ PROCESS * * /--- BLOCK TIMERX 00 000 81/06/24 21.47 * TMROFF SA3 AOUTLOC PUT IN CLEAR TIMING REQUEST SX6 X3+2 TAKES TWO WORDS SX2 X3-AOUTLTH OVERFLOW CHECK PL X2,ERROROF SA6 A3 UPDATE NUMBER OF OUTPUT WORDS SX6 RQTIMCL SA6 X3+ACTOUT SX6 TRT.TMR CLEAR -TIMER- REQUEST SA6 A6+1 * * CLEAR -TIMER- UNIT NUMBER FROM *TIMING* SA2 TIMING MX6 -12 NEXT TO BOTTOM 12 BITS LX6 12 BX2 X6*X2 MX6 1 CLEAR -TIMER- UNPROCESSED FLAG LX6 TMRDONE-59 BX6 -X6*X2 SA6 A2 EQ PROCESS * TK1000 DATA 1000.0 TK1MIN DATA 60000 EQUALS 1 MINUTE (IN MSEC) * * ENDOV * /--- BLOCK READECS 00 000 78/07/05 01.23 TITLE -READECS/WRITECS- * * * -READECS/WRITECS- COMMANDS * * READS OR WRITES ECS RELATIVE TO PLATO * * ON ENTRY, * * OVARG1 = 0 FOR -READECS- * 1 FOR -WRITECS- * READECS OVRLAY NGETVAR A1 = VARIABLE STORAGE ADDRESS SX6 A1 SA6 RVADDR SAVE STARTING VARIABLE ADDRESS SA5 A5 RETRIEVE ORIGINAL COMMAND WORD LX5 XCODEL NGETVAR X1 = ECS ADDRESS BX6 X1 SA6 RABSA SAVE ABSOLUTE ADDRESS SA5 A5 RETRIEVE ORIGINAL COMMAND WORD MX0 2*XCODEL BX5 -X0*X5 AX5 XCMNDL SA1 B5+X5 GET ADDITIONAL INFO WORD BX5 X1 MOVE TO REQUIRED X5 NGETVAR X1 = TRANSFER LENGTH ZR X1,PROCESS IGNORE ZERO LENGTH SA2 RVADDR SA0 X2 A0 = STARTING ADDRESS CALL BOUNDS CHECK WITHIN BOUNDS SA4 RABSA GET ECS ADDRESS NG X4,RERXVAL MX0 -24 BX0 X0*X4 CHECK FOR REASONABLE ECS ADDR NZ X0,RERXVAL IX5 X1+X4 (X5) = LWA+1 OF ECS TRANSFER SX3 1 IX5 X5-X3 (X5) = LWA OF ECS TRANSFER SA3 NLENGTH (X3) = ECS LWA OF PLATO IX3 X3-X5 SEE IF BEYOND TUTOR ECS NG X3,RERXVAL BX0 X4 SB1 X1 PICK UP LENGTH TO READ SA1 OVARG1 NZ X1,WRTECS JUMP IF -WRITECS- + RE B1 RJ ECSPRTY EQ PROCESS * RERXVAL BX1 X4 EQ ERXVAL * WRTECS WE B1 RJ ECSPRTY EQ PROCESS * RVADDR BSS 1 ADDRESS OF STARTING VARIABLE RABSA BSS 1 ECS ADDRESS * * ENDOV * /--- BLOCK SBREAD 00 000 77/11/11 05.43 TITLE -SBREAD/SBWRITE- * * -SBREAD- (CODE=148) * -SBWRITE- (CODE=149) * * -SBREAD- READS SPECIFIED WORDS FROM STUDENT BANK * -SBWRITE- WRITES SPECIFIED WORDS TO STUDENT BANK * * BOTH COMMANDS HAVE FOLLOWING FORMAT'; * * FOUR ARGUMENTS'; * ARG1 = STATION WHOSE BANK IS TO BE READ (WRITTEN) * ARG2 = OFFSET INTO STUDENT BANK * ARG3 = STARTING VAR TO READ INTO (WRITE FROM) * ARG4 = NUMBER OF WORDS TO READ (WRITE) * * RETURNS SYSTEM VARIABLE ERROR = * -1 IF SUCCESSFUL READ/WRITE * 0 IF NO SUCH STUDENT BANK * * ON ENTRY, * * OVARG1 = 0 FOR -SBREAD- * 1 FOR -SBWRITE- * SBREAD OVRLAY MX7 2*XCODEL MX6 0 SA6 SOWNFLG MARK NOT OWN STATION * * GET AND STORE EXTRA STORAGE WORD BX1 -X7*X5 MASK OUT VARIABLE CODES AX1 XCMNDL SHIFT OFF COMMAND CODE SA1 B5+X1 X1 = EXTRA STORAGE WORD BX6 X1 SA6 SAVE1 STORE EXTRA STORAGE WORD * /--- BLOCK SBREAD 00 000 81/03/10 01.42 * * PROCESS ARG1 NGETVAR X1 = STATION * * CHECK FOR STATION OUT OF RANGE * NEED TO LEAVE ORIGINAL ARGUMENT IN X1 AS * EXECERR STUFF EXPECTS IT TO BE THERE MX0 42 BX2 X0*X1 CATCH NEGATIVES AND > 18 BITS NZ X2,ERXSTN --- STATION OUT OF RANGE BX2 -X0*X1 USE ONLY 18 BITS SX3 NUMSTAT TOTAL STATIONS DEFINED IX3 X2-X3 PL X3,ERXSTN --- STATION OUT OF RANGE * CHECK FOR OWN STATION SA3 STATION IX3 X2-X3 NZ X3,SBRX10 JUMP IF NOT OWN STATION MX6 -1 SA6 SOWNFLG MARK OWN STATION EQ SBRX15 * SBRX10 SX0 BANKADD-STSTART SA1 NSYSBNK ADDRESS OF STATION BANKS IX0 X0+X1 SA1 NSYSLTH LENGTH OF STATION BANKS IX1 X1*X2 X1 = OFFSET INTO STATION BANKS IX0 X0+X1 X0 = ADDRESS OF STATION BANK RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) CALL BANKLOC COMPUTE ADDRESS OF BANK BX6 X0 SA6 SBADD SAVE ADDRESS OF STUDENT BANK * * PROCESS ARG2 SBRX15 SA5 A5 RESET COMMAND WORD LX5 XCODEL NGETVAR X1 = OFFSET SX6 X1 NG X6,ERXVAL --- OFFSET OUT OF RANGE SA6 STOFFS * * PROCESS ARG4 SA1 SAVE1 EXTRA STORAGE WORD BX5 X1 LX5 XCODEL NGETVAR X1 = LENGTH TO READ SX6 X1 18 BITS ONLY SA6 STLTH * * PROCESS ARG3 SA1 SAVE1 EXTRA STORAGE WORD BX5 X1 NGETVAR A1 = STARTING ADDRESS * * CHECK IF OWN STUDENT BANK SA2 SOWNFLG ZR X2,SBRX20 JUMP IF NOT OWN BANK SA2 ATEMPEC BX0 X2 ADDRESS OF ECS SCRATCH BUFFER SA0 SBSTART + WE SBMAX COPY BANK TO TEMP ECS BUFFER RJ ECSPRTY BX6 X2 SET ADDRESS OF BANK SA6 SBADD * * PERFORM CHECK FOR VARIABLE OUT OF RANGE SBRX20 SA0 A1 FOR BOUNDS CHECKER SA1 STLTH CALL BOUNDS --- EXITS IF OUT OF RANGE SB1 X1 RESTORE LENGTH TO READ/WRITE * /--- BLOCK SBREAD 00 000 81/03/10 01.49 * * CHECK FOR STUDENT BANK OUT OF RANGE SA2 STOFFS RESTORE OFFSET INTO BANK SX1 X2+B1 ADD OFFSET AND LENGTH SX1 X1-TBLTH-1 SUBTRACT LENGTH OF STUDENT BANK PL X1,SERXOOR --- ERROR IF OUT OF RANGE * * ERROR CHECKS ON STUDENT BANK ADDRESS SA1 SBADD RESTORE SB RELATIVE ADDRESS SX6 0 SET ERROR FLAG FOR NO SB ZR X1,SBRX3 NG X1,SBRX3 SX6 -1 SET ERROR FLAG FOR SUCCESS * * READ/WRITE OF STUDENT BANK IX0 X1+X2 ADD OFFSET TO SB ADDRESS SA2 OVARG1 GET READ/WRITE FLAG NZ X2,SBRX2 JUMP IF TO WRITE RE B1 RJ ECSPRTY EQ SBRX3 JUMP TO EXIT SBRX2 WE B1 RJ ECSPRTY SA2 SOWNFLG CHECK IF WROTE OWN STUDENT BANK ZR X2,SBRX3 IF NOT OWN BANK * UPDATE CM COPY OF OWN STUDENT BANK SA2 STOFFS (X2) = OFFSET INTO STUDENT BANK SA0 SBSTART+X2 RE B1 UPDATE CM COPY RJ ECSPRTY * SBRX3 SA6 TERROR STORE ERROR FLAG EQ PROCESS +++ EXIT TO CONTINUE PROCESSING * SERXOOR SA1 STOFFS OFFSET INTO STUDENT BANK SX2 B1 LENGTH SX3 TBLTH LENGTH OF STUDENT BANK EXECERR 117 SBREAD OUT OF RANGE * * SOWNFLG BSS 1 FLAG FOR OWN STUDENT BANK SAVE1 BSS 1 STORAGE FOR EXTRA STORAGE WORD SBADD BSS 1 STORAGE FOR RELATIVE SB ADDRESS STOFFS BSS 1 STORAGE FOR OFFSET STLTH BSS 1 STORAGE FOR LENGTH * * ENDOV * /--- BLOCK SBCHANG 00 000 80/08/28 09.33 TITLE -SBCHANG- / -STCHANG- ** SBCHANG - CHANGE A WORD IN A STUDENT BANK * * STCHANG - CHANGE A WORD IN A STATION BANK * * SBCHANG STATION,OFFSET,SOURCE,OPERATION * * OPERATION - '7AND'7, '7OR'7, OR '7SET'7 SBCHNG OVRLAY CALL MXTEST,-1,XR.THR GUARD AGAINST REQ OVRFLOW NG X6,=XRETRNZ TRY AGAIN NEXT TIMESLICE * GET STATION NUMBER NGETVAR NG X1,ERXSTN IF STATION ILLEGAL SX2 NUMSTAT IX2 X1-X2 PL X2,ERXSTN IF STATION ILLEGAL SA2 OVARG1 SET EXECUTOR REQUEST CODE SA2 SBCC+X2 LX1 42 BX6 X1+X2 SA6 MASRQ SAVE STATION NUMBER * FETCH OFFSET LX5 XCODEL NGETVAR NG X1,ERXVAL IF OFFSET OUT OF RANGE SA2 OVARG1 SA2 SBCA+X2 IX2 X1-X2 PL X2,ERXVAL IF OFFSET OUT OF RANGE SX6 X1 SA6 MASRQ+2 SAVE OFFSET * FETCH VALUE TO SET SA5 A5 RESTORE COMMAND WORD MX6 2*XCODEL BX1 -X6*X5 (X1) = EXTRA STORAGE POINTER AX1 XCMNDL SA1 X1+B5 (X1) = EXTRA STORAGE WORD BX5 X1 NGETVAR BX6 X1 SA6 MASRQ+3 SAVE VALUE TO USE * FETCH OPERATION TO PERFORM LX5 XCODEL NGETVAR SA2 SBCB SEARCH FOR OPERATION MX0 42 SBC1 BX6 X2*X0 BX6 X6-X1 ZR X6,SBC2 IF OPERATION FOUND SA2 A2+1 NZ X2,SBC1 IF MORE ENTRIES IN TABLE EQ ERXVAL UNKNOWN OPERATION SBC2 SX6 X2 SA6 MASRQ+1 SAVE OPERATION * /--- BLOCK SBCHANG 00 000 81/03/10 02.00 * CHECK EXECUTOR FOR STATION SA3 MASRQ AX3 42 CALL GETEXID,X3 ZR X1,SBC3 IF ON THIS EXECUTOR CALL SETEXID CALL MXREQ POST EXECUTOR REQUEST SX6 -1 (X6) = SUCCESSFUL EQ SBC6 * HANDLE REQUEST FOR THIS EXECUTOR SBC3 SA4 STATION BX6 X3-X4 ZR X6,SBC4 IF FOR THIS STATION SA1 NSYSBNK COMPUTE ADDRESS OF /STATION/ SX2 PSYSLTH IX2 X2*X3 IX0 X1+X2 SA0 SBCE RE PSYSLTH READ STATION BANK RJ ECSPRTY SA1 OVARG1 SA2 SBCA+X1 SB2 X2 (B2) = LENGTH OF BANK NZ X1,SBC5 IF -STCHANG- SA1 A0+BANKADD-STSTART BX6 X1 SA6 SBBNKA SAVE *BANKADD* IMAGE CALL BANKLOC SX6 0 (X6) = NO STUDENT BANK NG X0,SBC6 IF NO STUDENT BANK ZR X0,SBC6 SA0 SBCE RE SBMAX RJ ECSPRTY SA4 A0+STATION-SBSTART (X4) = STATION NUMBER EQ SBC5 PERFORM OPERATION SBC4 SA1 OVARG1 SA1 SBCD+X1 SA0 X1 (A0) = BASE ADDRESS OF TABLE MX0 0 (X0) = MARK THIS STATION SBC5 CALL MXCST UPDATE STATION/STUDENT BANK SX6 -1 (X6) = NO ERRORS ZR X0,SBC6 IF FOR THIS STATION SA1 OVARG1 NZ X1,SBC5.1 IF -STCHANG- * WRITE CHANGED WORDS TO ECS WE B2 RJ ECSPRTY EQ SBC6 * /--- BLOCK SBCHANG 00 000 81/03/10 01.55 * DO NOT WRITE OUT READ-ONLY PART OF STATION BANK SBC5.1 SX2 PSYSRLN IX0 X0+X2 SA0 A0+PSYSRLN SB2 B2-PSYSRLN WE B2 RJ ECSPRTY SBC6 SA6 TERROR SET ERROR FLAG EQ PROCESS SBBNKA BSSZ 1 HOLD TARGET *BANKADD* IMAGE SBCA BSS 0 CON SBMAX LENGTH OF STUDENT BANK CON PSYSLTH LENGTH OF STATION BANK SBCB BSS 0 VFD 42/0LSET,18/0 VFD 42/0LOR,18/1 VFD 42/0LAND,18/2 VFD 42/0LXOR,18/3 VFD 42/0LTALK,18/4 DATA 0 SBCC BSS 0 CON XR.WRTSB CON XR.WRTST SBCD BSS 0 CON SBSTART CON STSTART .1 MAX SBMAX,PSYSLTH SBCE OVDATA .1 TEMPORARY BUFFER ENDOV * /--- BLOCK USERLOC 00 000 79/10/04 03.56 TITLE -USERLOC- (CODE = 150) * USERLOC NAME,GROUP * * LOCATES USER *NAME* IN GROUP *GROUP* * * *NAME* MUST BE STOREABLE AND TWO WORDS LONG. * * AFTER EXECUTION, *ERROR* IS SET TO * * -1 IF THE USER IS NOT SIGNED ON, OR * THE STATION WHERE THE USER IS SIGNED ON * * *ZRETURN* IS NOT SET BY THIS COMMAND. USERLOC OVRLAY SA5 A5 (X5) = COMMAND WORD LX5 XCODEL POSITION GETVAR FOR GROUP NAME NGETVAR (X1) = GROUP NAME ZR X1,NOFIND IF NO GROUP NAME MX6 48 BX6 X6*X1 BOTTOM 48 BITS ONLY SA6 ULGROUP SAVE GROUP NAME SA5 A5 (X5) = COMMAND WORD NGETVAR (A1) = ADDR OF USER NAME SX6 A1 (X6) = ADDR OF USER NAME SA6 TEMP SAVE OVER CALL TO *WORDS* SA0 A1 (A0) = ADDR OF USER NAME SX1 18 (X1) = LENGTH OF NAME CALL WORDS CHECK BOUNDS ON USER NAME SA1 TEMP (X1) = ADDR OF USER NAME SA1 X1 (X1) = FIRST WORD OF USER NAME BX6 X1 ZR X1,NOFIND EXIT IF NO NAME SA6 ULNAME SAVE FIRST WORD OF NAME SA1 A1+1 (X1) = SECOND WORD OF USER NAME MX6 48 ONLY WANT 8 CHARACTERS OF IT BX6 X6*X1 (X6) = CHARS 11 - 18 OF NAME SA6 A6+1 SAVE SECOND WORD OF NAME MX7 -1 SA7 JJSTORE MARK *INFO* BUFFER OVERWRITTEN SB1 1 (B1) = 1 SB2 0 (B2) = STARTING STATION NUMBER SB4 NUMSTAT-1 (B4) = MAX POSSIBLE STATION NO * SEARCH GROUP NAME BUFFER FOR SAME GROUP. ULOC1 SB3 B2+INFOLTH-1 (B3) = LAST STATION THIS PASS LE B3,B4,ULOC2 IF IN RANGE SB3 B4 ADJUST IF NOT IN RANGE ULOC2 SB4 B3-B2 SB4 B4+B1 (B4) = NO. OF STATIONS TO CHECK SA1 AGROUP (X1) = ECS ADDR OF GROUP BUFFER SX0 B2 (X0) = FIRST STATION TO CHECK * /--- BLOCK USERLOC 00 000 79/10/04 03.56 IX0 X0+X1 (X0) = ADDR OF FIRST GROUP NAME SA0 INFO RE B4 READ GROUP NAMES TO INFO BUFFER RJ ECSPRTY SA1 ULGROUP (X1) = NAME OF GROUP SA2 INFO-1 (A2) = BIAS TO INFO BUFFER MX0 48 * ULOC10 SA2 A2+1 (X2) = NEXT GROUP NAME BX2 X0*X2 MASK OUT TALK OPTIONS BX3 X1-X2 CHECK IF CORRECT GROUP NZ X3,ULOC40 IF NOT CORRECT GROUP * /--- BLOCK USERLOC 00 000 79/10/04 03.56 * GROUP NAME MATCHED -- SEE IF NAME MATCHES. SX6 B2 SAVE CURRENT STATION NUMBER SX7 B3 SAVE ENDING STATION NUMBER SA6 SAVE.B2 SA7 SAVE.B3 SX6 A2 SAVE ADDRESS OF GROUP NAME SA6 SAVE.A2 CALL READSBK,UNAME,SAVE.B2,(TNAME-SBSTART),2 PL X6,ULOC30 IF NO STUDENT BANK SA1 ULNAME SA2 UNAME BX1 X1-X2 CHECK IF NAMES MATCH NZ X1,ULOC30 IF NAMES DIFFERENT NG X1,ULOC30 TREAT -0 AS NO MATCH SA1 ULNAME+1 SA2 UNAME+1 BX1 X1-X2 MX0 48 BX1 X0*X1 NZ X1,ULOC30 IF NAMES DIFFERENT * IF MATCH, FETCH STATION NUMBER AND JUMP TO EXIT. SA1 SAVE.B2 SX6 X1+ (X6) = STATION NUMBER EQ ULEXIT * IF NOT THE ONE WE WANT, RESTORE REGISTERS AND * PROCEED TO NEXT STATION. ULOC30 SA2 SAVE.B2 SA3 SAVE.B3 SB2 X2 RESTORE CURRENT STATION NUMBER SB3 X3 RESTORE LAST STATION NUMBER SA2 SAVE.A2 SA2 X2 RESTORE ADDRESS OF GROUP NAME SB1 1 (B1) = 1 AGAIN MX0 48 (X0) = MASK FOR GROUP NAME SA1 ULGROUP (X1) = GROUP NAME * END OF LOOPS. ULOC40 SB2 B2+1 INCREMENT STATION NUMBER LE B2,B3,ULOC10 RELOOP IF NOT YET DONE SB4 NUMSTAT-1 (B4) = MAX POSSIBLE STATION NO LE B2,B4,ULOC1 * USER IS NOT SIGNED ON -- RETURN *ERROR* = -1. NOFIND SX6 -1 * SET ERROR AND EXIT TO NEXT COMMAND ULEXIT SA6 TERROR EQ PROCESS ULNAME OVDATA 2 NAME OF USER TO SEARCH FOR UNAME OVDATA 2 NAME READ FROM STUDENT BANK ULGROUP OVDATA NAME OF GROUP TO SEARCH FOR SAVE.B2 OVDATA CURRENT STATION SAVE.B3 OVDATA LAST STATION FOR THIS PASS * /--- BLOCK USERLOC 00 000 79/10/04 03.56 SAVE.A2 OVDATA ADDRESS OF CURRENT GROUP NAME TEMP OVDATA SCRATCH ENDOV * /--- BLOCK READTCM 00 000 78/07/05 01.24 TITLE -READTCM- READ TUTOR CENTRAL MEMORY * * -READTCM- -WRITTCM- * READS OR WRITES CENTRAL INSIDE PLATO*S FL * * * ON ENTRY, * OVARG1 = 0 IF READ, 1 IF WRITE * READTCM OVRLAY NGETVAR SX6 A1 SA6 READTC1 SA5 A5 LX5 XCODEL NGETVAR SX6 X1 SA6 READTC2 SA5 A5 MX0 2*XCODEL BX5 -X0*X5 AX5 XCMNDL SA1 B5+X5 BX5 X1 NGETVAR X1 = LENGTH SA2 READTC1 X2 = TO ADDRESS (READ) SA3 READTC2 X3 = FROM ADDRESS (READ) SA0 X2 CALL BOUNDS SEE IF IT WILL FIT SA4 CMFL LX4 30 SB2 X4 SB1 X3 NG B1,RERXTCM ERROR IF NEGATIVE ADDRESS SB1 X1+B1 GT B1,B2,ERXBADL ERR IF MORE THAN FL SA4 ATEMPEC BX0 X4 SB1 X1 SA4 OVARG1 SEE IF READ OR WRITE NZ X4,WRTTCM JUMP IF -WRITE- SA0 X3 WE B1 RJ ECSPRTY SA0 X2 RE B1 RJ ECSPRTY EQ PROC * RERXTCM SX1 B1 EQ ERXVAL * WRTTCM SA0 X2 FROM ADDRESS WE B1 RJ ECSPRTY SA0 X3 TO ADDRESS RE B1 RJ ECSPRTY EQ PROC * READTC1 BSS 1 READTC2 BSS 1 * * ENDOV * /--- BLOCK HIDDEN 00 000 78/02/16 00.32 TITLE -HIDDEN- COMMAND * * -HIDDEN- COMMAND * * * THIS COMMAND WILL DISPLAY TEXT ON THE SCREEN IN THE * ',HIDDEN', FORMAT. CHARACTERS CHANGED LISTED BELOW * !^O = ZERO (O00) SUB ACCESS O * '6 = BLANK (O55) SHIFT 6 * '" = SUBSCRIPT (O66) SHIFT MULTIPLY * '# = SUPERSCRIPT (O67) SHIFT DIVIDE * ^'W = SHIFT (O70) ACCESS SHIFT W * ^'X = CARRIAGE RETURN (O71) ACCESS SHIFT X * ^'A = BACKSPACE (O74) ACCESS SHIFT A * ^,@^'A = FONT (O75) ACCESS 'F * '#@'" = ACCESS (O76) ACCESS 'O * - NOTE - * A VARIATION OF THIS ROUTINE AND A COPY OF ITS * TABLE IS USED INTERNAL TO THE -PACK- COMMAND FOR * EMBEDDED -HIDDEN- COMMANDS. SEE PACKOV / EXEC8. * * HIDDEN OVRLAY SA1 MOUTLOC SEE IF MOUT BUFFER PRETTY FULL SX1 X1-MOUTLTH+70 SEE IF A SHORT ONE WILL FIT NG X1,HIDEX IF ROOM SA5 A5+1 BACK UP COMMAND POINTER EQ XSLICE END THIS TIME SLICE * HIDEX MX0 1 BX5 -X0*X5 NGETVAR GET FIRST ARGUMENT SX6 A1 SAVE ADDRESS SA6 HIDADD BX6 X1 SA6 HIDLIT SAVE INCASE OF LITERAL SA5 A5 RESTORE COMMAND LX5 XCODEL NGETVAR GET CHARACTER COUNT ZR X1,PROCESS NG X1,ERXBADL * EXECERR USES X1 * CHECK TO SEE IF MAXIMUM EXPANSION WILL FIT IN MOUT BUFFER * INSURE THAT (X1) IS IN LOW 18 BITS. SX0 X1 IX0 X0-X1 NZ X0,ERXBADL IF NOT IN LOW 18 BITS SX0 X1-1 CONVERT TO WORDS SA2 SIXTEN TO GET [(N-1)/10]*6 PX0 X0 FX0 X0*X2 X0=(N-1)*(6/10) AND SOME GARBAGE EXPONENT SX0 X0+1 X0 = LENGTH (IN WORDS) SA2 MOUTLOC IX6 X2+X0 OPPPS SX3 X6-MOUTLTH+1 PL X3,PROCESS JUST SKIP IF NOT ENOUGH ROOM *ABOVE ABORTS OUTPUT IF IT DON'7T FIT SX2 X1-11 SEE IF ONE WORD(LITERAL STUFF) PL X2,HIDCHKR OTHERWISE CHECK IF IN BOUNDS SA0 HIDLIT EQ HIDEDO * HIDCHKR SA2 HIDADD SA0 X2 CALL WORDS BOUNDS CHECK * * /--- BLOCK HIDDEN 00 000 78/01/07 19.24 * COMING HERE * A0 = ADDRESS OF FIRST WORD * X1 = NUMBER OF CHARACTERS TO DISPLAY * * REGISTER USAGE'; * A0 NUMBER OF CHARACTERS IN MOUT WORD * A5 RESERVED FOR PLATO USE * A6 POINT TO OUTPUT WORD * * X0 77B SINGLE CHARACTER MASK * X1 INPUT WORD * X2 = CHARACTER(S) TO PUT IN OUTPUT WORD * X3 = NUMBER OF CHARACTERS IN X2 * X4 = TEMP REGISTER * X6 OUTPUT WORD * X7 = NEW MOUTLOC * * B1 UNIVERSAL INCREMENT REGISTER * B2 CHARACTER LOOKING AT IN INPUT WORD * B3 NUMBER OF CHARACTERS LEFT TO DO * B5,B7 RESERVED FOR PLATO USE * HIDEDO BSS 0 BX6 X1 SA6 HIDCHR SAVE FOR XYFIX SA2 MOUTLOC FIRST WORD IS A HEADER SA3 X2+MOUT SX7 X2+1 SAVE MOUTLOC + HEADER BX6 X3 SA6 A3 SET UP OUTPUT STORING SB3 X1 NUMBER OF CHARACTERS SA1 A0 GET FIRST WORD SA0 B0 POSITION OF CHAR BEFORE MOUTPLAC MX6 0 ZERO OUTPUT WORD SB1 1 UNIVERSAL INCREMENT REGISTER SB2 B0 STARTING CHARACTER MX0 54 ONE CHARACTER MASK BX0 -X0 LESS TYPING SX3 B1 NUMBER OF CHARACTERS IN OUTPUT HIDGO LX1 6 GET NEXT CHARACTER BX2 X1*X0 ZR X2,HIDNUL IF ZERO, MUST CHANGE SX4 X2-55B IF LESS THAN SPACE, CHAR OK MI X4,HIDOK ZR X4,HIDSPC JUMP IF SPACE SX4 X4-11B CHECK FOR SUB MI X4,HIDOK SA4 X4+HIDTAB BX3 X4*X0 CHARACTER COUNT IN X3 BX2 -X0*X4 GET RID OF CHAR COUNT EQ HIDOK1 * HIDNUL SA2 HIDNULC SX3 3 SUB ACCESS O EQ HIDOK1 * HIDSPC SA2 HIDSPCC SX3 2 SHIFT 6 EQ HIDOK1 * HIDOK1 LX2 6 HIDOK BX4 X2*X0 GET CHAR TO MERGE LX6 6 BX6 X6+X4 SA0 A0+B1 SX4 A0-10 NZ X4,HIDCNT IF WORD NOT FULL SA6 A6+B1 STORE MOUT WORD SX7 X7+B1 UPDATE MOUTLOC MX6 0 SA0 B0 HIDCNT SX3 X3-1 ZR X3,HIDGO1 IF DONE WITH THIS MOVE LX2 6 EQ HIDOK PUT IN NEXT CHAR HIDGO1 SX3 B1 SB3 B3-B1 ZR B3,HIDONE CHECK IF DONE SB2 B2+B1 SX4 B2-10 NZ X4,HIDGO GET NEXT CHARACTER SA1 A1+B1 SB2 B0 EQ HIDGO * * /--- BLOCK HIDDEN 00 000 78/03/07 17.00 * HIDONE SX4 A0 ZR X4,HIDON1 BX4 -X4 POSITION LAST WORK CORRECTLY SX4 X4+10 10-X4 LX4 1 *2 SB2 X4 *2 LX4 1 *4 SB2 B2+X4 *6 LX6 X6,B2 SX7 X7+B1 UPDATE MOUTLOC SA6 A6+B1 STORE IN MOUT * HIDON1 SA1 MOUTLOC GET ORIGINAL MOUTLOC SA7 A1 STORE NEW COUNT IX5 X7-X1 GET NUMBER OF WORDS SX3 X5-1 REMOVE HEADER WORD COUNT LX2 X3,B1 *2 LX3 3 *8 IX2 X2+X3 *10 LX2 24 SHIFT INTO PLACE IN HEADER LX5 12 SHIFT HEADER ADVANCE INTO PLACE SX4 WRSCODE GET WRITE CODE BX5 X5+X4 BX7 X2+X5 PUT ALL PARTS TOGETHER SA7 X1+MOUT AND OUTPUT HEADER SA1 HIDCHR CALL XYFIX EQ PROCO * SIXTEN CON 17174631463146314631B * HIDLIT BSS 1 HIDADD BSS 1 HIDCHR BSS 1 * * -- WARNING -- * A COPY OF THE FOLLOWING SUBTITUTION CHARS AND * TABLE IS USED IN PACKOV / EXEC8 TO ALLOW -HIDDEN- * TO BE EMBEDDED IN THE -PACK/C-,-SAY/C- COMMANDS. * IF YOU CHANGE THIS HERE, BE SURE TO CHANGE IT * THERE ALSO. * HIDNULC DATA 66761700000000000000B !^O HIDSPCC DATA 70410000000000000000B '6 * HIDTAB DATA 70640000000000000002B 66B '" DATA 70600000000000000002B 67B '# DATA 76702700000000000003B 70B ^'W DATA 76703000000000000003B 71B ^'X DATA 72000000000000000001B 72B=< DATA 73000000000000000001B 73B=> DATA 76700100000000000003B 74B ^'A * DATA 76567476700100000006B 75B ^,@^'A DATA 76700600000000000003B 75B ^'F * DATA 70607470640000000005B 76B '#@'" DATA 76701700000000000003B 76B ^'O DATA 77000000000000000001B 77B=; * * ENDOV * /--- BLOCK SEND 00 000 80/03/22 05.48 TITLE -SEND- COMMAND EXECUTION OVERLAY * * -SEND- COMMAND (CODE = 274) * * SENDS OUTPUT TO ANOTHER TERMINAL * * * SEND STATION,WHERE,BUFFER,LENGTH * SEND STATION,BEEP * SEND STATION,ERASE * * SEND STATION,ON,WHERE,BUFFER,LENGTH * SEND STATION,OFF,WHERE,BUFFER,LENGTH * SEND STATION,ALL,WHERE,BUFFER,LENGTH * * SEND STATION,ON,BEEP * SEND STATION,OFF,BEEP * SEND STATION,ALL,BEEP * * SEND STATION,ON,ERASE * SEND STATION,OFF,ERASE * SEND STATION,ALL,ERASE * * * AFTER EXECUTION, * * (TERROR) = -1 = IT DID NOT WORK * 0 = IT WORKED * N = OUTPUT SENT TO N STATIONS * * (TRETURN) = -1 = IT WORKED * 0 = BAD STATION NUMBER * 1 = NOT SIGNED ON * 2 = (UNUSED) * 3 = NON-BEEP-ABLE TERMINAL * * * /--- BLOCK SEND 00 000 80/03/22 05.48 SENDXV OVRLAY FINISH ILLEGAL IN -FINISH- UNIT SX6 0 PRESET FOR NO ERROR SA6 TERROR SA6 SSTATS NO. OF STATIONS SENT TO SA6 NSTATN PRESET FOR 1 STATION SA6 SSTATUS NO SAVLES/INTRCLR YET SX6 -1 SA6 TRETURN *ZRETURN* PRESET TO OK * * GET STATION NUMBER TO SEND TO (-1 = ALL STATIONS) * NGETVAR (X1) = STATION NUMBER NG X1,SENDALL -1 = ALL STATIONS BX6 X1 SA6 SSTATN SAVE STATION NUMBER SA6 LSTATN LAST STATION = FIRST STATION SX0 HRDSTAT CHECK FOR PSEUDO-STATIONS IX0 X1-X0 PL X0,SENDERR0 --- ERROR IF FOR RUNNERS SX0 LSTUD CHECK FOR CONSOLE IX0 X1-X0 ZR X0,SENDERR0 --- ERROR IF FOR CONSOLE SENDX0 SA2 STATION IX0 X1-X2 CHECK FOR THIS STATION NZ X0,SENDX1 --- OK IF FOR OTHER STATION EQ SENDERR0 --- ERROR IF OWN STATION SENDALL SX6 1 SA6 SSTATN START AT STATION 1 SX6 HRDSTAT-1 SA6 LSTATN LAST STATION NUMBER SX6 X6-1 SA6 NSTATN NUMBER OF STATIONS - 1 * /--- BLOCK SEND 00 000 80/03/22 05.48 * * FIND OUT WHAT TYPE OF -SEND- (-1 = TEXT, * 0 = BEEP, 1 = ERASE) AND WHETHER ACTIVE OR * INACTIVE STATIONS SHOULD RECEIVE THE * OUTPUT (-1 = ACTIVE, 0 = BOTH, 1 = INACTIVE) * SENDX1 SA5 A5 RESTORE COMMAND WORD AX5 XCODEL SHIFT 2ND GETVAR CODE DOWN MX0 -5 BX6 -X0*X5 (X6) = ACTIVE/INACTIVE/BOTH AX5 5 BX7 -X0*X5 (X7) = TEXT/BEEP/ERASE INFO SX6 X6-1 -1=ACTIVE, 0=BOTH, 1=INACTIVE SX7 X7-1 -1=TEXT, 0=BEEP, 1=ERASE SA6 SWHO STORE DESIRED STATION STATUS SA7 STYPE STORE OUTPUT TYPE PL X7,SENDGO --- IF NOT TEXT * /--- BLOCK SEND 00 000 80/03/22 05.48 * * FETCH EXTRA STORAGE WORD * SA5 A5 RESTORE COMMAND WORD MX0 -11 AX5 9 POSITION INDEX IN XSTOR BX5 -X0*X5 SA1 X5+B5 LOAD XSTOR WORD BX6 X1 SA6 STEMP SAVE FOR LATER GETVAR CALLS BX5 X6 * * GET SCREEN POSITION * NGETVAR DECODE SECOND VARIABLE CALL RCTOXY CONVERT TO FINE GRID MX0 -9 BX6 -X0*X6 LIMIT X TO 9 BITS BX7 -X0*X7 LIMIT Y TO 9 BITS LX6 9 BX6 X6+X7 MERGE X AND Y SA6 SAT SAVE SCREEN POSITION * * GET ADDRESS OF TEXT BUFFER * SA1 STEMP (X1) = EXTRA STORAGE WORD BX5 X1 LX5 XCODEL POSITION SECOND GETVAR CODE NGETVAR DECODE THIRD VARIABLE SX6 A1 SA6 SBUFFER SAVE BUFFER ADDRESS * * GET LENGTH OF TEXT IN CHARACTERS * SA1 STEMP (X1) = EXTRA STORAGE WORD BX5 X1 LX5 2*XCODEL POSITION THIRD GETVAR CODE NGETVAR DECODE FOURTH VARIABLE SX1 X1 ZR X1,PROCESS --- IF NOTHING TO SEND BX6 X1 SA6 SCHARS * * CHECK BOUNDS ON TEXT * SA2 SBUFFER BUFFER ADDRESS SA0 X2 CALL WORDS CHECK BUFFER BOUNDS * /--- BLOCK SENDGO 00 000 80/03/22 05.49 * * PREPARE FOR MAIN -SEND- LOOP * SENDGO CALL EFORMAT DUMP OWN OUTPUT CALL SAVLES UNLOAD COMMON, STORAGE, ETC. SX6 -1 SA6 SSTATUS MARK SAVLES/INTRCLR IN EFFECT * * LOOP THROUGH STATIONS SENDING THE OUTPUT TO * THE SPECIFIED STATIONS * SENDLOOP SA1 SSTATN (X1) = NO. OF NEXT STATION SA2 STATION CHECK FOR OWN STATION IX2 X1-X2 ZR X2,SENDL99 --- SKIP OWN STATION * SKIP STATIONS IN TEKTRONIX MODE. CALL READTBK,STEMP,SSTATN,(STFLAG1-STSTART) SA1 STEMP (X1) = *STFLAG1* FOR RECEIVER LX1 60-TEKBIT NG X1,SENDL99 SKIP IF IN TEKTRONIX MODE * * CALL *READSBK* TO SEE IF STATION IS ACTIVE * OR NOT -- (X6) = -1 IF ACTIVE, 0 IF INACTIVE * * SET UP REGISTERS FOR OTHER CHECKS * CALL READSBK,STEMP,SSTATN,0,0 SA6 SACTIVE -1 = ACTIVE, 0 = INACTIVE SA1 NSTATN (X1) > 0 IF MULTI-STATION SA2 STYPE (X2) = TYPE OF OUTPUT SA3 SWHO (X3) = ACTIVE/BOTH/INACTIVE * /--- BLOCK SENDGO 00 000 80/03/22 05.49 * * CHECK IF ACTIVE/INACTIVE STATUS OF STATION * MATCHES THE DESIRED STATUS * ZR X3,SNDCIU1 --- SKIP CHECK IF BOTH DESIRED MX0 1 BX3 X0*X3 AX3 58 -1 = ACTIVE, 0 = INACTIVE BX4 X3-X6 CHECK IF CORRECT STATUS ZR X4,SNDCIU1 --- IF STATUS MATCHES NZ X1,SENDL99 --- IF MULTI-STATION -SEND- EQ SENDERR1 --- ERROR IF INCORRECT STATUS * * IF INACTIVE STATION, ONLY SEND MESSAGE IF ON CIU * SNDCIU1 NG X6,SENDL1 NO NEED TO CHECK IF ACTIVE SA3 SSTATN NEXT STATION SX4 C0SITE CHECK RANGE OF 1ST CIU SITES LX4 5 1ST CIU STATION IX0 X3-X4 NG X0,SNDCIU2 NOT THIS CIU SX4 NC0SITE LX4 5 IX0 X0-X4 NG X0,SENDL1 IF IN RANGE, CONTINUE SNDCIU2 SX4 C1SITE CHECK RANGE OF 2ND CIU SITES LX4 5 IX0 X3-X4 NG X0,SENDL99 NOT ON CIU, SKIP THIS STATION SX4 NC1SITE LX4 5 IX0 X0-X4 NG X0,SENDL1 IF IN RANGE, CONTINUE EQ SENDL99 NOT ON CIU, SKIP THIS STATION * * ONLY ACTIVE BEEP-ABLE STATIONS CAN BE BEEPED * SENDL1 NZ X2,SENDL20 --- IF NOT BEEP OPTION NG X6,SENDL2 --- IF STATION IS ACTIVE NZ X1,SENDL99 --- IF MULTI-STATION -SEND- EQ SENDERR3 --- ERROR IF NOT BEEP-ABLE * * COMPUTE ADDRESS OF STATION BANK * SENDL2 SA3 SSTATN (X3) = STATION NUMBER SX4 PSYSLTH (X4) = STATION BANK LENGTH IX3 X3*X4 COMPUTE OFFSET FROM BANK 0 SA4 NSYSBNK GET ABSOLUTE ADDRESS OF BANK 0 IX3 X3+X4 COMPUTE REAL ADDRESS OF BANK * * CHECK FOR ATTEMPT TO BEEP UN-BEEP-ABLE TERMINAL * SX0 STFLAG1-STSTART IX0 X0+X3 (X3) = REAL ADDR OF *STFLAG1* SA0 STEMP RE 1 READ *STFLAG1* TO *STEMP* RJ ECSPRTY SA3 A0 (X3) = *STFLAG1* AX3 4 MX0 -4 BX3 -X0*X3 (X3) = TERMINAL TYPE SA3 X3+PPTINFO (X3) = TERMINAL ATTRIBUTES LX3 1 SHIFT TO BEEP-ABILITY FLAG NG X3,SENDL20 --- IF BEEP-ABLE NZ X1,SENDL99 --- IF MULTI-STATION SEND EQ SENDERR3 --- UN-BEEP-ABILITY ERROR * /--- BLOCK SENDGO 00 000 80/08/11 02.55 * * SWITCH OUTPUT TO OTHER STATION AND SEND IT * SENDL20 MX1 60 -0 OUTCODE SWTCODE SA1 STYPE (X1) = TYPE OF OUTPUT ZR X1,SBEEP --- IF BEEP OPTION PL X1,SERASE --- IF ERASE OPTION SX1 1 OUTCODE WEFCODE SET TO MODE -REWRITE- SA1 SAT (X1) = SCREEN POSITION SA2 SACTIVE (X2) = NEG. IF ACTIVE NG X2,SENDL25 --- IF STATION IS ACTIVE OUTCODE WFMCODE SET MARGINS IF INACTIVE EQ SENDL27 SENDL25 OUTCODE WFCODE LEAVE MARGINS ALONE IF ACTIVE SENDL27 SA1 SBUFFER ADDRESS OF BUFFER SB1 X1 SB2 SCHARS CHARACTER COUNT CALL AWTOUT WRITE IN STANDARD FONT EQ SENDL30 SBEEP SA1 BEEPCOD OUTCODE S19CODE PUT IN MOUT BUFFER EQ SENDL30 SERASE CALL ERSOUT,0 FSERASE--DONT CHANGE SBANK * WE/COLOR DATA * * DUMP OUTPUT * SENDL30 MX1 -1 OUTCODE SWTCODE SA1 SSTATN BX6 X1 SA6 FORCSTN FORCE DUMPING OF MOUT BUFFER CALL EFORMAT * /--- BLOCK SENDGO 00 000 80/04/22 01.22 * * INCREMENT STATS IF MULTI-STATION -SEND- * SA1 NSTATN ZR X1,SENDL40 --- IF NOT MULTI-STATION SA1 SSTATS SX6 X1+1 SA6 A1 * * IF END OF TIME-SLICE, TAKE A SHORT BREAK * * UPON RETURN FROM TUTIMING, THE LESSON/COMMON/ * STATION INTERLOCKS ARE RESTORED * * MUST KEEP CLEARING COMMON INTERLOCK TO AVOID * DEADLOCK BETWEEN YOUR OWN EXECUTOR HAVING A * COMMON INTERLOCKED WHEN ASKING TO INTERLOCK * ANOTHER STATION BANK, WITH THE OTHER PERSON * SIMULTANEOUSLY (ON A DIFFERENT EXECUTOR) TRYING * TO INTERLOCK YOUR OWN COMMON * SENDL40 SA1 XSLCLOK GET RUNNING CPU CLOCK SA2 MAXCLOK GET END OF TIME-SLICE IX2 X1-X2 NG X2,SENDL99 SA1 KEY BX6 X1 SA6 TOKEY SAVE *KEY* TUTIM 250,,,STOPCHK SA1 TOKEY BX6 X1 SA6 KEY RESTORE *KEY* CALL RESTLES ENSURE *NC* VARS VALID CALL SAVLES RE-SAVE *NC* VARIABLES * * EXIT IF DONE, ELSE ADVANCE TO NEXT STATION * SENDL99 SA1 SSTATN (X1) = CURRENT STATION SX6 X1+1 (X6) = NEXT STATION SA2 LSTATN (X2) = LAST STATION IX2 X2-X6 CHECK IF DONE NG X2,SENDFIN --- IF FINISHED SA6 A1 STORE NEXT STATION EQ SENDLOOP * /--- BLOCK SENDEND 00 000 80/03/22 05.49 * * -SEND- COMMAND EXITS * SENDFIN SA1 NSTATN (X1) = NO. OF STATIONS ZR X1,SENDEXIT --- IF NOT MULTI-STATION SA1 SSTATS (X1) = STATIONS SENT TO BX6 X1 SA6 TERROR RETURN IN *TERROR* SENDEXIT SA1 SSTATUS CHECK FOR SAVLES/INTRCLR PL X1,PROCO --- IF NOT IN EFFECT CALL RESTLES RESTORE COMMON, STORAGE, ETC. EQ PROCO * * SET RETURNS FOR ERRORS * SENDERR0 MX6 0 0 = BAD STATION NUMBER MX7 -1 EQ SENDERR SENDERR1 SX6 1 1 = NOT SIGNED ON (OR OFF) SX7 -1 EQ SENDERR SENDERR3 SX6 3 3 = NOT BEEP-ABLE SX7 -1 SENDERR SA6 TRETURN SET *ZRETURN* SA7 TERROR SET *ERROR* EQ SENDEXIT * * DATA DEFINITIONS * SSTATN EQU TBINTSV CURRENT STATION NUMBER LSTATN EQU SSTATN+1 LAST STATION NUMBER NSTATN EQU LSTATN+1 NUMBER OF STATIONS - 1 SSTATS EQU NSTATN+1 NUMBER OF STATIONS SENT TO SAT EQU SSTATS+1 SCREEN LOCATION SBUFFER EQU SAT+1 ADDRESS OF TEXT BUFFER SCHARS EQU SBUFFER+1 LENGTH OF TEXT (CHARS) STYPE EQU SCHARS+1 -1=NORMAL, 0=SEND, 1=ERASE SWHO EQU STYPE+1 -1=ON, 0=BOTH, 1=OFF SACTIVE EQU SWHO+1 NEG. IF ACTIVE, POS. IF NOT SSTATUS EQU SACTIVE+1 -1 IF THINGS TO RESTORE ERRPL SSTATUS-TBINTSV-TINTSVL BEEPCOD VFD 42/0,3/3B,8/0,7/173B STEMP OVDATA SCRATCH ENDOV * /--- BLOCK BEEP 00 000 80/02/08 23.37 TITLE -BEEP- * BEEPOV OVRLAY SA1 STFLAG1 AX1 4 MX0 -4 BX1 -X0*X1 MASK OFF TERMINAL TYPE CODE SA1 X1+PPTINFO GET TERMINAL DESCRIPTION WORD LX1 1 CHECK IF BEEP-ABLE PL X1,PROCESS SA1 BEEPCOD OUTCODE S19CODE OUTPUT BEEP REQUEST EQ PROCESS * BEEPCOD VFD 42/0,3/3B,8/0,7/173B * ENDOV * /--- BLOCK ACCESS 00 000 80/04/30 18.55 TITLE -ACCESS- AND -SYSACC- COMMAND EXECUTION. ACCESS SPACE 5,11 *** ACCESS - EXECUTION ROUTINE FOR -ACCESS- COMMAND. * * ACCESS LESSON,RETURNVARIABLE * ACCESS FILE,RETURNVARIABLE * ACCESS ACCOUNT';FILE,BLOCK,RETURNVARIABLE * * OVARG1 = 0 FOR -ACCESS- * OVARG1 = 1 FOR -SYSACC- * * ENTRY (A5) = ADDRESS OF COMMAND WORD * (OVARG1) = COMMAND TYPE * * EXIT - (TRETURN) = ZRETURN * STUDENT BANK HAS USERS ACCESS BITS * * USES X - 0, 1, 2, 3, 4, 5, 6, 7. * A - 0, 1, 2, 3, 4, 6, 7. * B - 1, 2, 3. * * CAN NOT CHANGE B4,B5,B6,B7. * * MACROS - NGETVAR. * * CALLS SAVLES, GETCODX, GETACN, SYSACC * GETACC, PUTACC, ACTFILE, RETPROC. * * * * SUMMARY OF STATE TABLE * ------------------------ * S1) SEARCH FOR SYSTEM * S2) SEARCH FOR GROUP * S3) SEARCH FOR ACCOUNT * S4) SEARCH FOR NAME (NAME/GROUP/SYSTEM) * S5) SEARCH FOR TYPE (TYPE/GROUP/SYSTEM) * S6) SEARCH FOR OTHER (OTHER/GROUP/SYSTEM) * S7) SEARCH FOR TYPE (TYPE/ACCOUNT/SYSTEM) * S8) SEARCH FOR OTHER (OTHER/ACCOUNT/SYSTEM) * S9) SEARCH FOR ACCOUNT = OTHER * S10) SEARCH FOR TYPE (TYPE/OTHER/SYSTEM) * S11) SEARCH FOR OTHER (OTHER/OTHER/SYSTEM) * * * /--- BLOCK ACCESS 00 000 81/01/12 21.50 EJECT *** FLOW-CHART OF THE ALGORITHM USED TO DECIDE ACCESS * * START (ACHECK) * V * ------ ---------- --------- ---------- * I I NO I ACH13 I NO I BIT 0 I YES I RETURN I * I S1 I--->I RID=A1 I----->I SET I---->I O/O/L I * ------ ---------- --------- ---------- * I YES V YES NO V V * I ---------- ---------- -------- * I<-----I SET TO I I RETURN I I I * I I LOCAL I I ZEROS I--->I EXIT I * I ---------- ---------- -------- * V * ------ ------ ------ ------ * I I YES I I NO I I NO I I * I S2 I---->I S4 I---->I S5 I---->I S6 I * ------ ------ ------ ------ * I NO I YES I YES YES I I NO * I V V V I * I ----------------------- I * I I RETURN USERS ACCESS I I * I I (ACH11) I I * I ----------------------- I * I A A A I * I <---------I-----------I--------I--I * V I YES I YES I * ------ ------ ------ I * I I YES I I NO I I I * I S3 I---->I S7 I---->I S8 I I * ------ ------ ------ I * NO I NO I I * I <-------------------- I * I I * I ---------------------- * V I YES I YES * ------ ------- ------- * I I YES I I NO I I NO * I S9 I---->I S10 I---->I S11 I---I * ------ ------- ------- I * I NO I * I <----------------------------- * V * ------------- ---------- * I STATION I YES I RETURN I * I =0 (ACH8) I---> I -0 I * ------------ ---------- * NO I I * V I * ------------ I * I RETURN 0 I I * ------------ I * /--- BLOCK ACCESS 00 000 81/01/12 21.50 * I I * I <-------------- * V * EXIT (ACHECK) EJECT * /--- BLOCK ACCESS 00 000 81/01/13 00.25 ACCESX OVRLAY ACW8 EQU TBINTSV NUMBER OF WORDS TO RETURN ACW14 EQU TBINTSV+1 GETVAR CODE OF WORDS RETURNED ACW15 EQU TBINTSV+2 GETVAR CODE OF RETURNED ACCESS * CHECK FOR AVAILABLE JUDGE BUFFERS - USED TO SAVE * INFO OVER INTERRUPT IN *GETACC* SUBOVERLAY. INTLOK X,I.JUDG,W SA1 AJBSTAT (X1) = EM FWA OF JBUFF STATS BX0 X1 SA0 JBUFCNT + RE 4 RJ ECSPRTY SA2 A0 NUMBER JUDGE BUFFERS IN USE SX1 =XJBANKS-1 CHECK FOR 2 LEFT IX2 X2-X1 NG X2,ACC0 IF AVAILABLE SA1 JMAXCNT+1 INCREMENT OVERFLOW COUNT SX6 1 IX6 X1+X6 SA6 A1 + WE 4 RJ ECSPRTY INTCLR X,I.JUDG SA5 A5+1 BACK UP COMMAND POINTER EQ =XXSLICE END TIME-SLICE * SAVE COMMON ACC0 BSS 0 INTCLR X,I.JUDG CALL SAVLES SAVE COMMON PROBABLY NOT NEED * CHECK FOR -SYSACC- COMMAND FORM SA1 OVARG1 NZ X1,SYSACC 1 FOR SYSACC * STORE A ZERO AS THE NAME AS A FLAG TO GETACC * TO USE CURRENT PERSON EXECUTING INFO BX6 X6-X6 SA6 ACP2 SX7 1 SA7 ACP8 MAXIMUM WORDS TO RETURN TO USER SA7 ACW8 * MOVE GETVAR CODES INTO *VARBUF* SX6 5 CALL GETCODX 5 ARGUMENTS TOTAL * CHECK IF 3 TAG COMMAND FORM SA1 VARBUF GET FIRST GETVAR CODE; TOP BIT PL X1,ACC4 SET IF LESSON/FILE KEYWORD * TWO TAG -ACCESS- COMMAND * THE TOP TWO BITS OF THE *GETVAR* CODE ARE SET TO * 1 = KEYWORD -FILE- 2 = KEYWORD -LESSON- LX1 XCODEL SX6 X1-2 (X5) = 0 IF KEYWORD -FILE- SA1 VARBUF+3 GET 4TH ARGUMENT (RETURN) BX7 X1 SA7 ACW15 STORE RETURN LOCATION ZR X6,ACC2 IF KEYWORD LESSON * IF A *FILE* KEYWORD IS BEING PROCESSED, FETCH * THE ACTUAL FILE NAME AND FILE NODE LESSON NUMBER AFTJMP ACC3,X,ACC1 BRANCH ON ACTIVE FILE TYPE SA1 TDSPARM (X1) = NAMESET/DATASET INFO EQ ACC1.1 ACC1 SA1 TAFINF2 (X1) = TUTOR-TYPE FILE INFO ACC1.1 BX7 X1 SAVE OVER *ACTFILE* CALL CALL ACTFILE,ACP9 GET ACCOUNT/FILE NAMES SX1 X7 (X1) = LESSON NUMBER * KEYWORD FILE * /--- BLOCK ACCESS 00 000 81/01/13 00.25 RJ GETACN READ ACCESS LESSON FROM HEADER EQ ACC5 * /--- BLOCK ACCESS 00 000 81/01/13 00.25 * KEYWORD LESSON * GET NAME OF ACCESS LIST ASSOCIATED * WITH THIS LESSON FROM LESSON DIRECTORY ACC2 SA1 TBLESSN GET CURRENT LESSON NAME SA2 ILESUN LESSON NUMBER AX2 18 SHIFT FOR LESSON NUMBER BX6 X1 SA6 ACP10 STORE LESSON NAME SX1 X2 (X1) = LESSON NUMBER RJ GETACN READ ACCESS LESSON FROM HEADER EQ ACC5 ACC3 SX6 1 NO FILE ATTACHED SA6 TRETURN EQ CKPROC EXIT * /--- BLOCK ACCESS 00 000 81/01/18 20.04 * LESSON AND BLOCK NAME SPECIFIED ACC4 CALL FILEBLK,VARBUF,ACP9 SA1 VARBUF+3 GET 4TH ARGUMENT BX6 X1 SA6 ACW15 ACC5 BX6 X6-X6 SA6 ACP1 RETURN USER BITS ONLY SA1 KEY BX6 X1 SA6 TOKEY SA1 XSSTATS *** TEMP STATS SX6 1 *** IX6 X1+X6 *** SA6 A1 *** X GETACC,B0 SEARCH ACCESS LIST BY NAME RJ PUTACC STORE USERS ACCESS EQ CKPROC EXIT * /--- BLOCK SYSACC 00 000 80/04/30 19.06 SYSACC SPACE 5,11 *** SYSACC - BEGIN -SYSACC- COMMAND PROCESSING. * * IF INFO IS PASSED SET UP *ACP* BUFFER ELSE SET * *ACP2* = 0 (NAME) AS FLAG FOR GETACC TO SUPPLY * THE CURRENTLY EXECUTING USERS INFO, I.E. NAME. * * SYSACC ACCOUNT';FILE,BLOCK,BUFFER,RETURN,MAXL,RETURNL * * ACCOUNT ACCOUNT OF FILE WITH ACCESS BLOCK * FILE NAME OF FILE WITH ACCESS BLOCK * BLOCK NAME OF ACCESS BLOCK * BUFFER USER SUPPLIED BUFFER TO READ * NAME (2 WORDS) * GROUP * ACCOUNT * USER TYPE * SYSTEM * RETURN VARIABLE TO RETURN BITS IN * RETURNL NUMBER OF BITS RETURNED * MAXL MAXIMUM LENGTH TO RETURN * * EXIT - (TRETURN) = ZRETURN * (TERROR) = TYPE OF ACCESS BLOCK SYSACC SX6 7 GET 7 ARGUMENTS CALL GETCODX UNPACK ARGUMENTS TO VARBUF CALL FILEBLK,VARBUF,ACP9 MX6 0 SA6 SRCHTYP SET SEARCH TYPE / NAME SEARCH * GET VALUES FROM PASSED-OFF USER BUFFER SA1 VARBUF+3 GET BUFFER LOCATION BX5 X1 NGETVAR BX6 X1 SA6 ACP2 STORE NAME ZR X1,SYSAC1 IF USE THIS USERS INFO SA0 A1 SX1 6 CALL BOUNDS AT LEAST 6 WORDS TO READ FROM SA1 A0+1 INCREMENT POINTER INTO BUFFER BX6 X1 SA6 ACP3 STORE SECOND PART OF NAME SA1 A1+1 GET GROUP BX6 X1 SA6 ACP4 STORE GROUP NZ X6,SYSAC0 IF GROUP=0, MAY BE LESSON SRCH SA2 ACP2 GET FIRST WORD OF NAME/LESSON NG X2,SYSAC0 IF CAPITALIZED, 'OTHER OR 'USER SX6 1 SA6 SRCHTYP SET SEARCH TYPE / LESSON SEARCH SYSAC0 SA1 A1+1 GET ACCOUNT BX6 X1 SA6 ACP5 STORE ACCOUNT NAME SA1 A1+1 GET USER TYPE BX6 X1 SA6 ACP6 STORE TYPE SA1 A1+1 GET SYSTEM MX0 18 BX1 X1*X0 SYSAC1 SX6 1 * THE RIGHTMOST 18 BITS OF ACP1 ARE 1 IF -SYSACC- BX6 X1+X6 * /--- BLOCK SYSACC 00 000 80/04/30 19.06 SA6 ACP1 STORE SYSTEM * /--- BLOCK SYSACC 00 000 81/01/18 20.06 * STORE REST OF TAGS FROM COMMAND SA1 VARBUF+4 FWA TO RETURN BITS IN BX6 X1 SA6 ACW15 SA1 VARBUF+5 MAXIMUM LENGTH TO RETURN BX5 X1 NGETVAR BX6 X1 SA6 ACP8 SA6 ACW8 SA1 VARBUF+6 GETVAR TO STORE LENGTH RETURNED BX6 X1 SA6 ACW14 WORDS RETURNED SA1 KEY BX6 X1 SA6 TOKEY SA1 XSSTATS+1 *** TEMP STATS SX6 1 *** IX6 X1+X6 *** SA6 A1 *** SA1 SRCHTYP X1 = SEARCH TYPE (0/1) X GETACC,X1 SEARCH ACCESS LIST * SET ERROR TO CONTAIN BLOCK TYPE, GETACC STORES IT * IN *ACP1* IN THE LEFTMOST 6 BITS. SA1 ACP1 GET TYPE OF ACCESS BLOCK MX2 6 ITS IN THE TOP 6 BITS BX6 X2*X1 LX6 6 SA6 TERROR SET *ERROR* IN STUDENT BANK RJ PUTACC RETURN USERS BITS EQ CKPROC EXIT SRCHTYP BSSZ 1 SEARCH TYPE (TEMP HOLDING CELL) * /--- BLOCK GETACN 00 000 80/04/30 18.02 GETACN SPACE 5,11 ** GETACN - GET USERS ACCESS LIST NAME. * * THIS ROUTINES READS A LESSON HEADER * DECIDES THE TYPE OF THE LESSON HEADER * AND RETURNS THE NAME OF THE ASSOCIATED * ACCESS LESSON AND BLOCK NAME. * * ENTRY - (X1) = LESSON NUMBER * * EXIT - ACCESS LIST NAME IN *ACACCT*, *ACFILE*, *ACBLOCK* * * USES X - 1, 2, 6, 7. * A - 1, 2, 6, 7. * B - 1. * * CALLS READLES. * * CALLED BY ACCESX. GETACN PS READ LESSON HEADER FOR NAMES SX6 0 ALWAYS ZERO ACCOUNT NAME FOR NOW SA6 ACP9 CALL READLES,LHBUFF,LPRMLTH SA1 A0 CHECK LESON TYPE MX2 12 BX1 X2*X1 LX1 12 (X1) = LESSON TYPE ZR X1,GETA1 IF LESSON SX1 X1-9 ZR X1,GETA2 IF DATASET FILE NODE SX1 X1-10+9 ZR X1,GETA3 IF TUTOR FILENODE SA2 -1 ABORT * PROCESS LESSON GETA1 RE LESHEAD RJ ECSPRTY SA1 A0+LACCLN SAVE ACCESS FILE / BLOCK NAME SA2 A0+LACCBN EQ GETA4 * PROCESS DATASET FILE NODE GETA2 SA0 DSH SX1 DSHEAD IX0 X0+X1 RE FPRMLTH RJ ECSPRTY SA1 ACCLNW SA2 ACCBNW EQ GETA4 * PROCESS TUTOR FILE NODE GETA3 SX1 TUTHEAD+4+O.ACCLN IX0 X0+X1 BIAS PAST HEADER RX1 X0 SX2 O.ACCBN-O.ACCLN IX0 X0+X2 RX2 X0 GETA4 ZR X2,GETA5 BX6 X2 SA6 ACP11 ZR X1,GETACN BX6 X1 SA6 ACP10 EQ GETACN GETA5 BX6 X6-X6 ZERO X6 SA6 ACP10 SA6 ACP11 EQ GETACN * /--- BLOCK PUTACC 00 000 80/05/01 14.16 PUTACC SPACE 5,11 ** PUTACC - RETURN ACCESS BITS TO USER. * * ENTRY - EXIT FROM GETACC OVERLAY PUTACC PS SA1 TOKEY RESTORE *KEY* BX6 X1 SA6 KEY * RESTORE NC VARS BEFORE WRITTING IN NEW VALUES CALL RESTLES SB1 1 B1=1 SA1 TRETURN PL X1,PUTACC ERROR / NO CHANGE STUDENT VARS SA1 ACP1 CHECK FOR MORE THAN ONE WORD AX1 18+18 SX1 X1 NG X1,PAC4 IF NO WORDS TO RETURN ZR X1,PAC4 SX1 X1-1 NZ X1,PAC1 IF MORE THAN ONE WORD TO STORE SA2 ACP2 GET ACCESS WORD BX6 X2 (X6) = VALUE TO STORE SA1 ACW15 (X1) = GETVAR CODE BX5 X1 NPUTVAR EQ PAC3 PAC1 SA1 ACW15 (X1) = GETVAR CODE TO STORE BX5 X1 NGETVAR SA0 A1 SA1 ACP1 AX1 18+18 SX1 X1 CALL BOUNDS MAKE SURE LEGAL ADDRESS SB2 A0 (B2) = FWA TO STORE SA1 ACP2 PAC2 BX6 X1 SA6 B2 SB2 B2+1 SA1 A1+1 LT B2,B1,PAC2 IF MORE TO STORE PAC3 SA1 ACP1 SX1 X1 ZR X1,PUTACC IF NON-SYSTEM VERSION * RETURN NUMBER OF WORDS RETURNED SA1 ACP1 AX1 18+18 SX1 X1 SA2 ACW14 BX6 X1 BX5 X2 NPUTVAR RETURNED WORD COUNT EQ PUTACC EXIT PAC4 SX6 0 ERROR = 0 = NO ACCESS BITS SA6 TRETURN EQ PUTACC ENDOV * /--- BLOCK GETACC 00 000 80/05/01 10.30 GETACC TITLE SEARCH ACCESS LIST. GETACC SPACE 5,11 ** GETACC - GET ACCESS ACCESS BITS FOR USER. * * SEARCH ACCESS LIST. * * TBINTSV IS SAVED DURING EXECUTION * * ENTRY - (ACP1) = 18/SYSTEM NAME, * 24/0, * 18/1 IF SYSTEM SEARCH * (ACP2) = USERS NAME OR LESSON ACCOUNT * (ACP3) = USERS NAME OR LESSON NAME * (ACP4) = USERS GROUP * (ACP5) = USERS ACCOUNT * (ACP6) = USERS TYPE * (ACP7) = 0 * (ACP8) = NUMBER OF WORDS TO RETURN * (ACP9) = ACCOUNT OF ACCESS LIST * (ACP10)= FILE OF ACCESS LIST * (ACP11)= BLOCK OF ACCESS LIST * (OVARG1) = 0 IF SEARCH BY NAME * 1 IF SEARCH BY LESSON * * EXIT - (ACP1) = 6/ACCESS LIST TYPE * 18/NUMBER OF WORDS RETURNED * 18/ * 18/1 IF SYSTEM SEARCH * (ACP2) = ACCESS BIT FOR (ACP8) WORDS * (ZRETURN) = -2 - NO ERRORS, OWNER FOUND * -1 - NO ERRORS * 0 - NO ACCESS BITS * 1 - ACCESS LESSON NOT FOUND * 2 - ACCESS BLOCK NOT FOUND * 3 - SYSTEM (SUBFILE) ERROR * * /--- BLOCK GETACC 00 000 80/05/01 14.23 GETACC OVRLAY CALL GJBUF NG X6,=XNJBMSG IF NO BUFFER AVAILABLE SA1 TJDBUF1 SAVE JUDGE BUFFER NUMBER MX0 -18 BX1 X0*X1 BX6 X1+X6 SA6 A1 CALL GBA GET JUDGE BUFFER ADDRESS SA0 TBINTSV WE TINTSVL RJ ECSPRTY SA1 TIOECS SAVE SUBFILE BUFFER BX6 X1 SA6 A0 SA1 OVRETRN SAVE OVERLAY RETURN INFO BX6 X1 SA6 A0+1 CALL SSTACK,A0+2 SX1 TINTSVL IX0 X0+X1 WE TINTSVL RJ ECSPRTY * MOVE PARAMETER BLOCK TO *TBINTSV* SA0 ACP1 SA1 ATEMPEC BX0 X1 WE TINTSVL RJ ECSPRTY SA0 ACW1 RE TINTSVL RJ ECSPRTY SA1 OVARG1 MX7 -1 BX6 X1 SA7 ACW12 SHOW NO ACCESS BLOCK SA6 ACW16 CALL IOSAV SAVE / CLEAR SUBFILE BUFFER BX6 X6-X6 SA6 TIOECS SA1 ACFILE ZR X1,AERR1 IF NO ACCESS LESSON TUTIM 1 SX6 11 SET ACCESS LIST TYPE LX6 48 SA6 ACTYPE * /--- BLOCK GETACC 00 000 80/05/01 14.23 * GET USER INFO AND STORE IN *ACW* BUFFER SA1 ACW16 ZR X1,GETN IF SEARCH BY NAME * CHECK IF LESSON NAME SPECIFIED SA1 ACW3 NZ X1,GET8 IF LESSON SPECIFIED SA2 TBLESAC SA3 A2+1 BX6 X2 BX7 X3 SA6 ACW2 SA6 ACW6 SET ACCOUNT / OTHER SEARCH SA2 OTHER SA7 A1 BX6 X2 SA6 A6+1 EQ GET8 * CHECK IF NAME SPECIFIED GETN SA1 ACW2 NZ X1,GET0 SA1 TNAME GET USERS NAME SA2 TNAME1 MX3 48 BX6 X1 BX7 X3*X2 MASK OUT DISK BLOCK NUMBER SA6 ACW2 STORE FIRST PART OF NAME SA7 ACW3 STORE SECOND PART SA2 AGROUP ECS ADDRESS OF GROUP BUFFER SA1 STATION ADD BIAS OF THIS STATION IX0 X2+X1 RX1 X0 BX6 X1*X3 THROW AWAY DISK BLOCK NUMBER SA6 ACW4 SAVE GROUP NAME SA1 TACCNAM PICK UP ACCOUNT NAME OF USER BX6 X1 SA6 ACW5 STORE ACCOUNT NAME SA1 TTYPE GET USER TYPE BX6 X1 SA6 ACW6 STORE USER TYPE SA1 =XHOMERID GET SYSTEM NAME SA2 ACW1 TO SAVE SYSTEM FLAG BX6 X1+X2 SA6 A2 STORE SYSTEM NAME * /--- BLOCK GETACC 00 000 80/05/01 14.21 * SET USER TYPE TO PSEUDO TYPE STORED ON DISK GET0 SA1 ACW6 GET USER TYPE ALREADY STORED AX1 56 SB2 X1 NG B2,GET3 IF INVALID TYPE SB3 B2-4 GT B3,GET3 IF INVALID TYPE JP GET1+B2 GET1 EQ GET2 AUTHOR + EQ GET3 ERROR TYPE DOES NOT EXIST + EQ GET4 INSTRUCTOR + EQ GET5 MULTIPLE + EQ GET6 STUDENT GET2 SA2 AUTHOR PSEUDO TYPE AUTHOR BX3 X3-X3 EQ GET7 GET3 BX2 X2-X2 INVALID TYPE OF USER BX3 X3-X3 EQ GET7 GET4 SA2 INSTRUC PSEUDO TYPE INSTRUCTOR SA3 INSTRU1 EQ GET7 GET5 SA2 MULTIP PSEUDO MULTIPLE SA3 MULTIP1 EQ GET7 GET6 SA2 STUDENT PSEUDO STUDENT BX3 X3-X3 GET7 BX6 X2 STORE THE RESULTS BX7 X3 SA6 ACW6 SA7 ACW7 * /--- BLOCK GETACC 00 000 81/03/22 01.12 * CHECK TO SEE IF ACCESS BLOCK BEING LOADED GET8 INTLOK X,I.SIGN,W INTERLOCK CALL IOSRCH,ACACCT,ACLIOT NG X6,GET10 JUMP IF NOT * WAIT FOR I/O TO COMPLETE OR FOR STORAGE GET9 INTCLR X,I.SIGN CALL IOREL RELEASE BUFFER IF ASSIGNED TUTIM 250 EQ GET8 * CHECK IF LIST ALREADY IN ECS GET10 CALL FINDLES,ACACCT,ACW12 SA2 ACW12 PL X2,GET13 * RESERVE I/O BUFFER. CALL IORES,ACACCT,ACLIOT PL X6,GET9 JUMP IF NONE AVAILABLE * PREPARE TO READ DIRECTORY SA1 ACACCT GET ACCOUNT NAME BX6 X1 SA6 ACCNTF SA1 ACFILE GET FILE NAME BX6 X1 SA6 LESSONF SA1 ACBLOCK GET BLOCK NAME BX6 X1 SA6 BLOCKF SA1 ACW1 CHECK COMMAND TYPE SX1 X1 CLEAR SYSTEM NAME MX6 -1 (X6) = ANY FILE TYPE NZ X1,GET11 IF SYSTEM VERSION BX6 X6-X6 (X6) = TUTOR FILE ONLY GET11 SA6 FILETF SX6 1 1 = READ DIRECTORY ONLY SA6 IOCODEF SX6 10 ACCESS BLOCK SA6 BLKTF ACCESS BLOCK TYPE INTCLR X,I.SIGN * READ LESSON DIRECTORY CALLX SUBFILE SA1 NERROR GET ERROR RETURN NZ X1,AERR0 IF ERROR OCCURRED * CHECK NUMBER OF BLOCKS IN SUB-FILE SA1 LTHF (X1) = EM LENGTH OF ACCESS LIST ZR X1,AERR3S --- IF GARBAGENOUS NG X1,AERR3S --- DITTO SX2 8000+1 MAXIMUM SIZE IS 8000 WORDS IX2 X1-X2 CHECK THAT SIZE .LE. 8000 WORDS PL X2,AERR3S --- IF ACCESS LIST TOO LARGE SA2 DSKLTHF (X2) = DISK LTH OF ACCESS LIST IX2 X1-X2 COMPARE EM AND DISK LENGTHS NZ X2,AERR3S --- ERROR IF LENGTHS DIFFERENT * GET FULL ACCOUNT NAME RETURNED BY SUBFILE SA1 ACCNTF BX6 X1 SA6 ACACCT * /--- BLOCK GETACC 00 000 80/07/08 02.41 * CALCULATE SIZE OF ECS BUFFER NEEDED INTLOK X,I.SIGN,W SA1 SFNSETF (X1) = NAMESET / TUTOR FLAG NG X1,GET11.1 --- IF ACCESS LIST IN NAMESET SA1 NBLKF SX6 BLKLTH COMPUTE LENGTH OF BUFFER NEEDED IX6 X1*X6 EQ GET11.2 GET11.1 SA1 LTHF (X1) = LENGTH OF ACCESS LIST SX6 X1+ * WORKS WITH 64 WORD SUBFILE REQUESTS * ALLOCATE ECS BUFFER GET11.2 CALL XSTOR,ACACCT,X6 GET EM BUFFER SA1 LESNUM NG X1,GET9 JUMP IF NO ECS AVALIABLE GET12 BX6 X1 SA6 ACW12 SAVE LESSON NUMBER * /--- BLOCK GETACC 00 000 82/10/28 16.24 * SET UP TO READ FROM DISK SA1 LESLOC GET ECS ADDRESS OF BUFFER SX2 ACCHEAD IX6 X1+X2 BIAS PAST HEADER SA6 ECSF SET ECS ADDRESS FOR DISK READ SX6 2 SA6 IOCODEF READ - DIRECTORY AVAILABLE * SET BUFFER STATUS TO I/O PENDING CALL IOLESSN,ACW12,4000B INTCLR X,I.ADDL RELEASE LESNAM INTERLOCK INTCLR X,I.SIGN * CHANGE FROM 320 WORD TO 64 WORD REQUEST SA1 SFNSETF (X1) = NAMESET / TUTOR FLAG NG X1,GET12.1 --- IF ACCESS LIST IN NAMESET SX6 5 SA1 NBLKF IX6 X6*X1 SA6 A1 * READ ACCESS LIST INTO ECS GET12.1 CALLX SUBFILE * UNLOCK ECS BUFFER INTLOK X,I.SIGN,W INTERLOCK SIGNIN PROCESS CALL IOLESSN,ACW12,-4000B * INTCLR X,I.SIGN CALL IOREL * CHECK SUBFILE RETURN SA1 NERROR NZ X1,AERR0 IF ERROR OCCURRED * SIGN USER INTO LIST * GET13 INTLOK X,I.SIGN,W GET13 SA1 ACW12 GET LESSON NUMBER CALL ALTLES,1 INTCLR X,I.SIGN * READ IN DISK DIRECTORY FROM ECS INTO * A CM BUFFER SA1 ACW12 GET LESSON NUMBER CALL READLES,B0,B0 SX1 ACCHEAD IX0 X0+X1 SA0 DWD1 RE DWORDS+1 GET DIRECTORY AND LOCAL SYSTEM RJ ECSPRTY BX7 X0 SA7 ECSDIR STORE LOCATION OF ECS DIRECTORY * /--- BLOCK GETACC 00 000 80/05/01 12.12 * INITIALIZE STATE TABLES * SET WORDS / ENTRY AND WORDS / ENTRY OF NEXT TABLE SA1 DWD3 SET WORDS / SYSTEM LX1 29 MX0 -2 BX6 -X0*X1 SA6 S1+SWPE SET WORDS / SYSTEM LX1 2 BX6 -X0*X1 SA6 S2+SWPE WORDS PER GROUP SA6 S3+SWPE WORDS PER ACCOUNT SA6 S9+SWPE WORDS PER ACCOUNT SA6 S1+SNWE WORD PER ENTRY OF NEXT TABLE MX0 -4 SET WORDS / NAME LX1 4 BX6 -X0*X1 SA6 S2+SNWE WORDS PER GROUP SA6 S3+SNWE WORDS PER NEXT ACCOUNT SA6 S9+SNWE WORDS PER NEXT ACCOUNT SA6 S4+SWPE NAME SA6 S5+SWPE TYPE SA6 S6+SWPE OTHER SA6 S7+SWPE TYPE SA6 S8+SWPE OTHER SA6 S10+SWPE TYPE SA6 S11+SWPE TYPE MX0 -3 LX1 3 BX6 -X0*X1 SA6 S12+SWPE WORDS / LESSON SA6 S13+SWPE SA6 S14+SWPE * /--- BLOCK GETACC 00 000 80/05/01 12.22 * SET FWA AND LWA OF NEXT TABLE SX1 DWORDS GET BIAS IX6 X7+X1 SA6 S1+SFWA STORE FWA OF SYSTEMS SA1 DWD1 MX0 -13 LX1 6+13 BX6 -X0*X1 IX6 X7+X6 SA6 S12+SLWA SET LWA OF LESSONS SA6 S13+SLWA SA6 S14+SLWA LX1 13 BX6 -X0*X1 SX6 X6-1 IX6 X7+X6 SA6 S1+SLWA SET LWA OF SYSTEMS SA6 S2+SFWA SET FWA OF GROUPS / ACCOUNTS SA6 S3+SFWA SA6 S9+SFWA BX2 X6 LX1 13 BX6 -X0*X1 SET FWA OF NAMES SX6 X6-1 IX6 X7+X6 SA6 S4+SFWA SA6 S5+SFWA SA6 S6+SFWA SA6 S7+SFWA SA6 S8+SFWA SA6 S10+SFWA SA6 S11+SFWA SA6 S2+SLWA SET LWA OF GROUPS SA6 S3+SLWA SA6 S9+SLWA BX3 X6 IX6 X6-X2 SA6 S1+SNWA SET LWA OF NEXT TABLE LX1 13 BX6 -X0*X1 SET LWA OF NAMES SX6 X6-1 IX6 X7+X6 SA6 S4+SLWA SA6 S5+SLWA SA6 S6+SLWA SA6 S7+SLWA SA6 S8+SLWA SA6 S10+SLWA SA6 S11+SLWA SA6 S12+SFWA SET FWA OF LESSONS SA6 S13+SFWA SA6 S14+SFWA IX6 X6-X3 SA6 S2+SNWA SET LWA OF NEXT TABLE SA6 S3+SNWA SA6 S9+SNWA * INITIALIZE FIRST STATE SA1 ACW16 NZ X1,GET14 IF SEARCH BY LESSON SA1 DWD2 GET NUMBER OF SYSTEMS LX1 13 MX0 -13 SX6 1 SA6 ACHB SET LOWER LIMIT BX6 -X0*X1 SX6 X6-1 SA6 A6+1 SET LIMIT FOR FIRST SEARCH * /--- BLOCK GETACC 00 000 80/05/01 12.22 SX6 S1 (X6) = FIRST STATE EQ GET15 GET14 BX6 X6-X6 SET LOWER LIMIT FOR SEARCH MX0 -13 SA1 DWD2 SA6 ACHB LX1 2*13+12+13 BX6 -X0*X1 (X6) = NUMBER OF LESSONS SA6 A6+1 SX6 S12 GET15 SA6 ACHA SET FIRST STATE RJ ACHECK GET ACCESS CHECK * /--- BLOCK GETACC 00 000 80/07/08 00.39 * SETUP ZRETURN AND DETACH ECS BUFFER AND RETURN * * THIS CODE ASSUMES THAT YOU HAVE AN ECS COPY * OF THE LIST ALREADY ATTACHED BY YOU, YOU CAN * NOT CALL THIS ROUTINE IF YOU DO NOT HAVE ONE. AEXIT SA1 ACW1 SET ACCESS BLOCK TYPE SA2 DWD1 SA3 ACW8 SET NUMBER OF WORDS MX6 6 BX2 X6*X2 (X2) = ACCESS LIST TYPE MX6 6+18 BX1 -X6*X1 LX3 18+18 BX6 X2+X1 BX6 X3+X6 SA6 ACP1 SET RETURN VALUE MX6 -1 FOR ZRETURN SA1 ACW1 AX1 18 SX1 X1 IX6 X6-X1 EQ AERR4 EXIT PROCESSING * /--- BLOCK GETACC 00 000 80/07/08 02.37 AERR0 SX1 X1+2 ZR X1,AERR2 IF BLOCK NOT FOUND NG X1,AERR3 IF OTHER ERROR AERR1 SX6 1 1 = ACCESS LESSON NOT FOUND EQ AERR4 AERR2 SX6 2 2 = ACCESS BLOCK NOT FOUND EQ AERR4 AERR3S SX6 5 (X6) = TERMINATE I/O REQUEST SA6 IOCODEF CALLX SUBFILE TERMINATE NAMESET I/O AERR3 SX6 3 3 = SYSTEM ERROR AERR4 SA6 TRETURN * RELEASE I/O BUFFER CALL IOREL * DECREMENT COUNT SA1 ACW12 NG X1,AERR5 IF NOT LOCATED INTLOK X,I.SIGN,W SA1 ACW12 CALL ALTLES,-1 INTCLR X,I.SIGN * RESTORE TBINTSV, OVERLAY STACK * RELEASE JUDGE BUFFER AERR5 CALL GBA (X0) = BUFFER ADDRESS SA0 TBINTSV SX1 TINTSVL IX0 X0+X1 RE TINTSVL RJ ECSPRTY SA1 A0 RESTORE SUBFILE BUFFER BX6 X1 SA6 TIOECS SA1 A0+1 RESTORE OVERLAY RETURN INFO BX6 X1 SA6 OVRETRN CALL RSTACK,A0+2 SX1 TINTSVL RESTORE *TBINTSV* IX0 X0-X1 RE TINTSVL RJ ECSPRTY CALL IORST SA1 TJDBUF1 MX6 42 CLEAR ACCESS BUFFER NUMBER BX6 X6*X1 SA6 A1 SX1 X1 NG X1,"CRASH" ZR X1,"CRASH" CALL RJBUF AERR6 RETURN * /--- BLOCK ACHECK 00 000 80/04/30 19.42 ACHECK SPACE 5,11 ** ACHECK - CHECK USERS ACCESS * * PROCESS STATE TABLES TO LOCATE USERS ACCESS BITS. * * ENTRY (ACHA) = CURRENT STATE * (ACHB) = BIAS INTO TABLE * AND STATE TABLES ARE SET UP * * /--- BLOCK ACHECK 00 000 80/04/30 19.42 * TEST TO SEE IF ANY SYSTEMS IN LIST * (X0) CONTAINS ECS FWA OF DIRECTORY ACHECK PS ACCESS CHECKING SB1 1 B1=1 * PROCESS NEXT STATE ACH1 SA4 ACHA (X4) = ADDRESS OF CURRENT STATE SA1 X4+SITM SA1 X1 (X1) = ITEM TO SEARCH FOR SA2 A1+B1 (X2) = SECOND WORD OF ITEM SA3 X4+SFWA (X5) = FWA OF TABLE BX5 X3 SA3 X4+SWPE SB2 X3 (B2) = WORDS / ENTRY SA3 ACHB (X3) = BIAS INTO TABLE IX5 X5+X3 SA3 A3+B1 (X3) = NUMBER OF ENTRIES SA4 X4+SMSK BX6 X4 (X6) = FIRST WORD OF MASK SA4 A4+B1 BX7 X4 (X7) = SECOND HALF OF MSK RJ EBCHOP PERFORM BINARY CHOP SA4 ACHA PL X0,ACH3 IF ENTRY FOUND SA4 X4+SNFS GET NOT FOUND STATE NG X4,ACH2 IF NEXT STATE DEFINED SB3 X4 JP B3 ACH2 BX6 -X4 SET NEXT STATE SA6 ACHA EQ ACH1 PROCESS NEXT STATE * PROCESS ITEM FOUND ACH3 SA1 X4+SFWA (X1) = FWA OF TABLE SA2 X4+SLWA (X2) = LWA OF TABLE SX3 B2 (X3) = WORDS / ENTRY IX2 X2-X3 SB3 B2+B2 RE B3 READ NEXT TWO ENTRIES RJ ECSPRTY SA1 A0 MX5 -12 BX7 -X5*X1 SA7 ACHB SET BIAS INTO TABLE IX1 X0-X2 ZR X1,ACH4 IF LAST ENTRY IN TABLE SA1 A0+B2 BX1 -X5*X1 LWA OF BIAS EQ ACH5 ACH4 SA1 X4+SNWA LWA OF NEXT TABLE ACH5 IX6 X1-X7 SA3 X4+SNWE (X3) = WORDS/ENTRY OF NEXT TAB PX6 IX6 X6/X3 PX3 NX6 NX3 FX6 X6/X3 UX6 X6,B3 LX6 B3 SA6 A7+B1 SET NUMBER OF ENTRIES * /--- BLOCK ACHECK 00 000 80/04/30 19.42 SX1 X4-S1 CHECK LIMITS SHOULD BE SAVED NZ X1,ACH6 IF NOT AT HIGHEST LEVEL SA7 ACHC SAVE LIMITS SA6 A7+B1 ACH6 SA4 X4+SFS GET FOUND STATE NG X4,ACH7 IF STATE DEFINED SB3 X4 JP B3 PROCESS STATE ACH7 BX6 -X4 SA6 ACHA EQ ACH1 PROCESS NEXT STATE * /--- BLOCK ACHECK 00 000 80/04/30 19.45 * NOT FOUND ROUTINE ACH8 SA1 ACW1 SET SYSTEM ERROR SX6 -4 MX2 -18 LX6 18 LX2 18 BX1 X2*X1 BX6 -X2*X6 BX6 X1+X6 SA6 A1 EQ ACHECK * SYSTEM NOT FOUND ACH10 SA1 AZERBUF RETURN ACCESS OF ZERO SB2 377777B RETURN USER SPECIFIED WORD CNT BX0 X1 * FOUND ACH11 RJ DIRCHK SA0 ACP2 SX1 B1 IX0 X0+X1 BIAS PAST NAME / ACCOUNT SB2 B2-B1 SA2 ACW16 ZR X2,ACH11.1 IF SEARCH BY NAME IX0 X0+X1 SB2 B2-B1 ACH11.1 SA2 ACW1 CHECK COMMAND TYPE SX2 X2 NZ X2,ACH12 IF SYSTEM VERSION IX0 X0+X1 BIAS PAST SYSTEM BITS SB2 B2-B1 ACH12 SX6 B2 SA1 ACW8 ACW8 = MIN(ACW8,X6) IX3 X1-X6 AX3 59 BX1 X3*X1 BX6 -X3*X6 BX6 X1+X6 SA6 A1 SB2 X6 LE B2,ACHECK IF NO WORDS TO RETURN RE B2 RJ ECSPRTY ZR X2,ACHECK IF NON-SYSTEM VERSION SA1 A0 MASK OUT ACCESS BITS MX6 -12 BX6 -X6*X1 SA6 A1 EQ ACHECK * SET TO LOCAL SYSTEM ACH13 SA1 ACW1 (X1) = PASSED SYSTEM NAME MX4 18 BX1 X4*X1 GET SYSTEM FROM LEFT 18 BITS SA4 =XHOMERID BX1 X4-X1 ZR X1,ACH15 PROCESS AS LOCAL SYSTEM SA1 DWD1 GET FIRST WORD LX1 59-0 RIGHTMOST BIT IS FLAG PL X1,ACH10 IF OTHER/OTHER/LOCAL OFF * CLEAR NAME / GROUP / ACCOUNT / TYPE * CAUSE A SEARCH FOR LOCAL / OTHER / OTHER * /--- BLOCK ACHECK 00 000 80/04/30 19.45 BX6 X6-X6 SA6 ACW2 SA6 A6+B1 SA6 A6+B1 SA6 A6+B1 SA6 A6+B1 SA6 A6+B1 EQ ACH15 * RESET LIMITS, GO ONTO NEXT STATE ACH14 SA1 ACHC FETCH SAVED LIMITS SA2 A1+B1 BX6 X1 BX7 X2 SA6 ACHB SET AS NEW LIMITS SA7 A6+B1 AX4 30 GET NEXT STATE BX6 X4 SA6 ACHA EQ ACH1 ACH15 SX0 DWORDS DIRECTORY LENGTH SA1 ECSDIR LOCATION OF DIRECTORY IN ECS IX0 X0+X1 SA4 ACHA EQ ACH3 PROCESS AS FOUND SYSTEM * /--- BLOCK DIRCHK 00 000 80/04/30 19.46 DIRCHK SPACE 5,11 ** DIRCHK - CHECK TO SEE IF THIS USER IS OWNER * * DECIDES IF NAME IS DIRECTOR AND IF SO SETS A FLAG * IN ACW1 * * (ACW1) = 18/SYSTEM,6/0,18/FLAG IF DIR,18/SYS FLAG * * ENTRY (B1) = 1 * * USES A - 1, 2, 6 * X - 1, 2, 6 DIRCHK PS CHECK FOR DIRECTOR SA1 DWD5 CHECK FIRST PART OF NAME SA2 ACW2 BX2 X2-X1 NZ X2,DIRCHK SA1 A1+B1 CHECK SECOND PART OF NAME SA2 A2+B1 BX2 X2-X1 NZ X2,DIRCHK SA1 A1+B1 CHECK GROUP SA2 A2+B1 BX2 X2-X1 NZ X2,DIRCHK * NAME/GROUP MATCH, CHECK SYSTEMS SA2 DWD11 NZ X2,DIR1 IF ACCESS LIST DEFINES A SYSTEM SA2 HOMERID USE THIS SYSTEMS ID DIR1 SA1 ACW1 MX6 18 BX6 X1*X6 BX6 X6-X2 NZ X6,DIRCHK IF SYSTEMS TO DO NOT MATCH * SET THIS USER AS A DIRECTOR SX2 B1 LX2 18 BX6 X1+X2 SA6 A1 EQ DIRCHK EXIT * /--- BLOCK STATE 00 000 79/09/04 17.31 STATE SPACE 5,11 ** STATE - STATE TABLES TO DEFINE NEXT SEARCH. * * THESE CONSTANTS DEFINE WHAT IS TO BE SEARCHED * FOR AND WHERE TO GO APON COMPLETION OF THE SEACH * THE RESULTS OF THE SEARCH DETERMINE WHERE TO GO * RESUME PROCESSING. IF THE STORED CONSTANT IS * NEGITIVE THEN THE LOCATION IS THE ADDRESS OF THE * NEXT STATE TABLE. THE NON-TERMINAL STATES CONTAIN * INFORMATION ABOUT THE NEXT PHYSICAL TABLE, THIS * IS TO ALLOW CALCULATING LENGTH OF THE NEXT TABLE * TO SEARCH SWPE EQU 0 WORDS /ENTRY SFWA EQU 1 ECS FWA OF TABLE SLWA EQU 2 LENGTH OF TABLE SNWA EQU 3 LENGTH OF NEXT TABLE SNWE EQU 4 WORDS / ENTRY OF NEXT TABLE SITM EQU 5 ADDRESS OF ITEM TO SEARCH SMSK EQU 6 MASK TO USE * SECOND WORD OF MASK SFS EQU 8 SNFS EQU 9 NEXT STATE IF NOT FOUND * SEARCH FOR SYSTEM S1 CON 0 WORDS / ENTRY CON 0 ECS FWA CON 0 LWA + 1 OF THIS TABLE CON 0 LENGTH OF NEXT TABLE CON 0 WORDS / ENTRY OF NEXT TABLE CON ACW1 SYSTEM NAME VFD 18/-0,42/0 MASK FOR FIRST WORD VFD 60/0 MASK FOR SECOND WORD CON -S2 NEXT STATE IF FOUND CON ACH13 SET TO LOCAL SYSTEM S2 CON 0 SEARCH TABLE FOR GROUP CON 0 CON 0 CON 0 CON 0 CON ACW4 GROUP NAME VFD 1/0,47/-0,12/0 VFD 60/0 CON -S4 CON -S3 S3 CON 0 SEARCH TABLE FOR ACCOUNTS CON 0 CON 0 CON 0 CON 0 CON ACW5 ACCOUNT NAME VFD 1/0,47/-0,12/0 VFD 60/0 CON -S7 CON -S9 * /--- BLOCK STATE 00 000 80/05/01 11.03 S4 CON 0 SEARCH FOR NAMES CON 0 CON 0 CON 0 CON 0 CON ACW2 SEARCH FOR NAME VFD 60/-0 VFD 48/-0,12/0 CON ACH11 CON -S5 S5 CON 0 SEARCH FOR USER TYPE FOR GROUP CON 0 CON 0 CON 0 CON 0 CON ACW6 USERS TYPE VFD 60/-0 VFD 48/-0,12/0 CON ACH11 CON -S6 S6 CON 0 SEARCH TABLE FOR OTHER (GROUP) CON 0 CON 0 CON 0 CON 0 CON OTHER2 SEARCH FOR OTHER/GROUP VFD 60/-0 VFD 48/-0,12/0 CON ACH11 VFD 30/S3,30/ACH14 S7 CON 0 SEARCH FOR TYPE OF ACCOUNT CON 0 CON 0 CON 0 CON 0 CON ACW6 USER TYPE VFD 60/-0 VFD 48/-0,12/0 CON ACH11 CON -S8 S8 CON 0 SEARCH FOR OTHER OF ACCOUNT CON 0 CON 0 CON 0 CON 0 CON OTHER2 OTHER VFD 60/-0 VFD 48/-0,12/0 CON ACH11 VFD 30/S9,30/ACH14 S9 CON 0 SEARCH FOR OTHER / OTHER CON 0 CON 0 CON 0 CON 0 CON OTHER OTHER VFD 1/0,47/-0,12/0 VFD 60/0 CON -S10 CON ACH8 S10 CON 0 SEARCH FOR TYPE OF ACCOUNT CON 0 CON 0 CON 0 CON 0 CON ACW6 USER TYPE VFD 60/-0 VFD 48/-0,12/0 CON ACH11 CON -S11 S11 CON 0 SEARCH FOR OTHER OF ACCOUNT CON 0 CON 0 CON 0 * /--- BLOCK STATE 00 000 80/05/01 11.03 CON 0 CON OTHER2 OTHER VFD 60/-0 VFD 48/-0,12/0 CON ACH11 CON ACH8 * /--- BLOCK STATE 00 000 80/05/01 11.12 * SEARCH BY LESSON S12 CON 0 SEARCH FOR ACCOUNT/LESSON CON 0 CON 0 CON 0 CON 0 CON ACW2 LESSON NAME VFD 42/-0,18/0 VFD 60/-0 CON ACH11 CON -S13 S13 CON 0 SEARCH FOR ACCOUNT/OTHER CON 0 CON 0 CON 0 CON 0 CON ACW6 ACCOUNT / OTHER VFD 42/-0,18/0 VFD 60/-0 CON ACH11 CON -S14 S14 CON 0 SEARCH FOR OTHER/OTHER CON 0 CON 0 CON 0 CON 0 CON AOTHER LESSON OTHER VFD 42/-0,18/0 VFD 60/-0 CON ACH11 CON ACH8 * /--- BLOCK EBCHOP 00 000 79/08/10 10.02 EBCHOP SPACE 5,11 ** EBCHOP - ECS BINARY CHOP. * * PERFORMS A BINARY CHOP IN ECS OF A LIST. * ALLOWS PASSING THE LENGTH OF A RECORD. THE * SEARCH ALLOWS UP TO A TWO WORD OBJECT TO * LOCATE. IT ALSO REQUIRES A TWO WORD MASK. * IT RETURNS THE ADDRESS OF THE OBJECT IN ECS IN * X0, A0 CONTAINS THE ADDRESS OF THE CELL IN CM * WHICH HAS A COPY OF THE LOCATED OBJECT FROM ECS. * * ENTRY (B1) = 1 * (B2) = WORDS PER RECORD * * (X1) = FIRST WORD OF OBJECT TO LOACTE * (X2) = SECOND WORD OF OBJECT TO LOCATE * (X3) = NUMBER OF LOGICAL RECORDS TO SEARCH * (X5) = FWA TO SEARCH FROM * (X6) = FIRST WORD OF MASK * (X7) = SECOND WORD OF MASK * * EXIT (X0) = ADDRESS OF LOCATION OF OBJECT IN ECS * = -1 IF NOT LOCATED * (A0) = ADDRESS OF COPY OF OBJECT IN CM * * USES A - 0, 1, 2, 4, 6, 7. * B - 1, 2, 3. * X - 0, 1, 2, 3, 4, 5, 6, 7. * * CALLED BY ACHECK. * * USAGE X0 = ECS ADDRESS TO TRANSFER FROM * X1 = OBJECT TO LOCATE * X2 = LOGICAL RECORD NUMBER * X3 = MIDDLE POINTER * X4 = MASK * X5 = FWA-1 TO SEARCH FROM * X6 = BOTTOM POINTER * X7 = TOP POINTER * * B1 = 1 * B2 = WORDS PER RECORD (1,2) * * TEMPORARY CM CELLS * (OBJECT) = FIRST WORD TO SEARCH FOR * (OBJECT2) = SECORD WORD TO SEARCH FOR * (MASK) = MASK FOR FIRST WORD TO LOCATE * (MASK2) = MASK FOR SECOND WORD TO LOCATE * (CMLOC) = HOLD ECS TRANSFERD RECORD * (CMLOC2) = SECOND WORD OF ECS TRANSFER EJECT * /--- BLOCK EBCHOP 00 000 79/08/10 10.02 EX0 SX0 -1 (X0) = NOT FOUND EBCHOP PS ECS BINARY CHOP * SET UP CM CELLS BX1 X1*X6 BX2 X2*X7 SA6 MASK STORE MASK USE TO COMPARE SA7 MASK2 BX4 X6 (X4) = MASK BX6 X1 (X1) = OBJECT BX7 X2 SA6 OBJECT STORE OBJECT SA7 OBJECT2 * INITIALIZE LOOP PARAMETERS SX6 B0 STARTING RECORD NUMBER (0) SA0 CMLOC SX7 X3-1 (X7) = NUMBER OF RECORDS - 1 * MAIN LOOP FOR CHOP EX1 IX2 X7-X6 NG X2,EX0 ENDLOOP; OBJECT NOT FOUND * CALCULATE NEXT GUESS X3 = INT((X6+X7)/2) IX3 X6+X7 AX3 1 DIVIDE BY 2 * COMPUTE NEXT ECS ADDRESS X0=B2*X3+X5 SX0 B2 IX0 X3*X0 IX0 X0+X5 STARTING ECS ADDRESS * READ RECORD FROM ECS RE B2 RJ ECSPRTY SA2 A0 BX2 X2*X4 MASK OFF WORD FROM CM * NG X2,EX4 IF TABLE NEGATIVE NG X1,EX3 IF OBJECT NEGATIVE EX2 IX4 X2-X1 PL X4,EX5 IF OBJECT < ECS RECORD EX3 SX6 X3+B1 RAISE BOTTOM POINTER EQ EX14 EX4 NG X1,EX2 IF BOTH NEGATIVE EQ EX6 EX5 ZR X4,EX7 IF ECS RECORD = OBJECT EX6 SX7 X3-1 LOWER TOP POINTER EQ EX14 EX7 SA4 MASK2 FIRST WORDS MATCH SA2 A0+B1 SECOND WORD OF ECS RECORD BX2 X2*X4 SA1 OBJECT2 FETCH SECOND WORD OF OBJECT NG X2,EX10 IF TABLE NEGATIVE NG X1,EX9 IF OBJECT NEGATIVE EX8 IX4 X2-X1 PL X4,EX11 IF OBJECT2 > ECS2 EX9 SX6 X3+B1 RAISE BOTTOM EQ EX14 * /--- BLOCK EBCHOP 00 000 79/08/10 10.02 EX10 NG X1,EX8 IF BOTH NEGATIVE EQ EX12 EX11 ZR X4,EX13 IF ECS2 = OBJECT2 EX12 SX7 X3-1 LOWER TOP EQ EX14 EX13 EQ EBCHOP FOUND OBJECT, EXIT EX14 SA1 OBJECT RESTORE OBJECT SA4 MASK RESTORE MASK EQ EX1 EJECT * /--- BLOCK GBA 00 000 80/04/30 17.18 GBA SPACE 5,11 ** GBA - GET JUDGE BUFFER ADDRESS * * ENTRY - (TJDBUF1) = JUDGE BUFFER NUMBER * * EXIT - (X0) = ADDRESS OF JUDGE BUFFER * (X1) = JUDGE BUFFER NUMBER GBA PS SA1 TJDBUF1 SX1 X1 NG X1,"CRASH" ZR X1,"CRASH" SX0 JBXSAVE (X0) = LENGTH OF EACH BUFFER SX2 X1-1 IX0 X2*X0 SA2 XJBANKS IX0 X2+X0 EQ GBA * /--- BLOCK STORAGE 00 000 80/05/01 11.08 * EQU-ED TO LOCATIONS IN USERS STUDENT BANK ACW1 EQU TBINTSV 42/SYSTEM NAME 18/ZERO IF USER BITS ONLY ACW2 EQU TBINTSV+1 NAME TO LOOK UP ACW3 EQU TBINTSV+2 NAME CONTINUED ACW4 EQU TBINTSV+3 GROUP ACW5 EQU TBINTSV+4 ACCOUNT ACW6 EQU TBINTSV+5 USER TYPE / OTHER ACCOUNT ACW7 EQU TBINTSV+6 SECOND WORD OF USER TYPE ACW8 EQU TBINTSV+7 NUMBER OF WORDS TO RETURN ACACCT EQU TBINTSV+8 ACCOUNT NAME ACFILE EQU TBINTSV+9 FILE NAME ACBLOCK EQU TBINTSV+10 BLOCK NAME ACTYPE EQU TBINTSV+11 BLOCK TYPE (11) ACW12 EQU TBINTSV+12 NUMBER OF ACCESS LESSON ACW14 EQU TBINTSV+13 GETVAR OF COUNT OF RETURN WORDS ACW15 EQU TBINTSV+14 FWA TO RETURN ACCESS IN ACW16 EQU TBINTSV+15 SEARCH TYPE * DUMMY USER TYPES (ORDER DEPENDENT) AOTHER VFD 60/0 OTHER VFD 6/0,54/0L'OTHER VFD 60/0 OTHER2 VFD 12/0,48/0L'OTHER VFD 60/0 AUTHOR VFD 6/0,54/0L'AUTHORS VFD 60/0 INSTRUC VFD 6/0,54/0L'INSTRUCT INSTRU1 VFD 60/0LORS STUDENT VFD 6/0,54/0L'STUDENTS VFD 60/0 MULTIP VFD 6/0,54/0L'MULTIPLE MULTIP1 VFD 60/0LS * DISK DIRECTORY DEFINES AND TEMPORARY INFO CELLS DWORDS EQU 10 DWD0 OVDATA 1 DWD1 OVDATA 1 DWD2 OVDATA 1 DWD3 OVDATA 1 DWD4 OVDATA 1 DWD5 OVDATA 1 DWD6 OVDATA 1 DWD7 OVDATA 1 DWD8 OVDATA 1 DWD9 OVDATA 1 DWD10 OVDATA 1 DWD11 OVDATA 4 ECSDIR OVDATA 1 CMLOC OVDATA 10B FIRST WORD OF OBJECT (2 WORDS) MASK OVDATA 1 MASK FOR OBJECT MASK2 OVDATA 7 OBJECT OVDATA 1 OBJECT TO LOCATE OBJECT2 OVDATA 7 * TEMP CELLS FOR STATE TABLES ACHA OVDATA 1 INITIAL STATE ACHB OVDATA 2 LOWER/UPPER BOUND (2 WORDS) ACHC OVDATA 2 LOWER/UPPER BOUND (2 WORDS) ENDOV * /--- BLOCK REPLACE DF 00 000 78/02/11 22.50 TITLE -REPLACE- COMMAND EXECUTION COMPROV OVRLAY *** -REPLACE- COMMAND * * FORMAT-- * REPLACE IN,LTH,OUT,LTH,TABLE,LTH,CHARS,MODE * * IN INPUT BUFFER, *LTH* WORDS * OUT OUTPUT BUFFER, *LTH* WORDS * TABLE REPLACEMENT TABLE, *LTH* WORDS * LTH MUST BE ODD; LAST WORD IS SET * TO ZERO. TABLE CONTAINS PAIRS-- * 60/0LOLDNAME,54/0LNEWNAME,6/NEWLTH * CHARS ON RETURN, SET TO CHAR COUNT IN OUTPUT * MODE -1 FOR EXPRESSION * 0 FOR WRITE * +N FOR WRITE PRECEDED BY *N* EXPRESSIONS * * ON EXIT-- * CHARS NUMBER OF CHARACTERS IN OUTPUT BUFFER * (REST OF LAST WORD IS ZERO, FOLLOWING * WORDS LEFT ALONE) * ZRETURN = 0 IF NO CHANGE * =-1 IF SOMETHING CHANGED * SPACE 3 ** REGISTER USAGE * * A0 CHANGE FLAG * X0 CHARACTER MASK * * A1 INPUT POINTER * X1 INPUT WORD * B1 INPUT CHARACTER COUNT * * X2 INPUT CHARACTER ASSEMBLY * B2 CHARACTER ASSEMBLY CODE * * X3 SCRATCH * B3 SCRATCH * * X4 NAME ASSEMBLY * B4 NAME ASSEMBLY COUNTER * * X5 MODE * B5 FONT FLAG * * B6 SCRATCH * X6 TEMPORARY * * A7 OUTPUT POINTER * X7 OUTPUT WORD ASSEMBLY * B7 OUTPUT CHARACTER COUNT * SPACE 3 XW1 EQU TBINTSV XW2 EQU TBINTSV+1 TABLTH EQU TBINTSV+2 ACOUNT EQU TBINTSV+3 RMODE EQU TBINTSV+4 AOUT EQU TBINTSV+5 AIN EQU TBINTSV+6 INLTH EQU TBINTSV+7 OUTLTH EQU TBINTSV+8 ATABLE EQU TBINTSV+9 BREGS EQU TBINTSV+10 * /--- BLOCK MACROS 00 000 78/02/10 11.32 GETCHAR MACRO REG GET 6 BITS, RIGHT JUSTIFIED LOCAL AA,BB NZ B1,AA SA1 A1+1 SB1 10 AA LX1 6 B_REG -X0*X1 SB1 B1-1 SX3 REG-FONT NZ X3,BB SB5 B5-1 SB5 -B5 FLIP FONT FLAG BB BSS 0 ENDM PUTCHAR MACRO REG PUT 6 BITS, RIGHT JUSTIFIED LOCAL AA NZ B7,AA SA7 A7+1 SB7 10 SX7 0 AA LX7 6 BX7 X7+REG SB7 B7-1 ENDM * /--- BLOCK MACROS 00 000 78/02/10 08.35 GETCODE MACRO REG,BREG GET CHARACTER RIGHT JUSTIFIED LOCAL AA,BB GETCHAR REG S_BREG 1 BX6 X2 EQ BB AA L_REG 6 S_BREG BREG+1 GETCHAR X6 B_REG REG+X6 BB SX3 X6-KUP ZR X3,AA SX3 X6-ACCESS ZR X3,AA ENDM PUTCODE MACRO REG,BREG PUT CHARACTER RIGHT JUSTIFIED LJUST REG,BREG PUTSTR REG,BREG ENDM PUTSTR MACRO REG,BREG PUT STRING LEFT JUSTIFIED LOCAL AA,BB AA ZR BREG,BB S_BREG BREG-1 L_REG 6 BX6 -X0*REG PUTCHAR X6 EQ AA BB BSS 0 ENDM LJUST MACRO REG,BREG LEFT JUSTIFY STRING SB6 BREG+BREG SB6 B6+B6 SB6 BREG-B6 SB6 B6+B6 SB6 B6+60 L_REG B6 ENDM * /--- BLOCK REPLACE 00 000 78/02/11 00.50 MX0 2*XCODEL BX1 -X0*X5 AX1 XCMNDL GET LINK TO EXTRA STORAGE SA1 X1+B5 SA2 A1+1 BX6 X1 BX7 X2 SA6 XW1 SA7 XW2 SAVE EXTRA STORAGE WORDS BX5 X2 NGETVAR GET ARGUMENT 6 (TABLE LTH) BX6 X1 SA6 TABLTH LX6 59 PL X6,=XERXVAL MUST BE ODD SA1 XW2 LX1 XCODEL BX5 X1 NGETVAR GET ARG. 7 (CHAR COUNT RETURN) SX6 A1 SA6 ACOUNT SAVE ADDRESS SA1 XW2 LX1 2*XCODEL BX5 X1 NGETVAR GET ARG. 8 (MODE) BX6 X1 SA6 RMODE SA1 XW1 BX5 X1 NGETVAR GET ARG. 3 (OUT ADDRESS) SX6 A1 SA6 AOUT SAVE ADDRESS SA1 XW1 LX1 XCODEL BX5 X1 NGETVAR GET ARG. 4 (OUT LENGTH) BX6 X1 SA6 OUTLTH SA1 XW1 LX1 2*XCODEL BX5 X1 NGETVAR GET ARG. 5 (TABLE ADDRESS) SX6 A1 SA6 ATABLE SAVE ADDRESS SA5 A5 RESTORE COMMAND WORD NGETVAR GET ARG. 1 (IN ADDRESS) SX6 A1 SA6 AIN SAVE ADDRESS SA5 A5 LX5 XCODEL NGETVAR GET ARG. 2 (IN LENGTH) BX6 X1 SA6 INLTH * /--- BLOCK REPLACE 00 000 78/02/11 01.14 SA1 INLTH SA2 AIN SA0 X2 SET UP FOR *BOUNDS* CALL BOUNDS MX0 -6 SA1 B1-1 PICK UP LAST WORD BX6 X0*X1 GUARANTEE AN EOL SA6 A1 STORE IT BACK SA1 OUTLTH SA2 AOUT SA3 INLTH IX3 X3-X1 CHECK OUTLTH>INLTH PL X3,=XERXBADL IF NOT SA0 X2 CALL BOUNDS SA1 TABLTH SA2 ATABLE SA0 X2 CALL BOUNDS MX6 0 SA6 B1-1 CLEAR LAST WORD OF TABLE MX0 -18 SX6 B5 BX6 -X0*X6 18 BIT LIMIT SX1 B7 BX1 -X0*X1 LX6 18 BX6 X1+X6 MERGE SA6 BREGS PRESERVE B5, B7 SA1 RMODE BX5 X1 SET MODE SB5 B0 CLEAR FONT SA1 AOUT SA1 X1-1 GET WORD PRECEDING OUT BUFFER BX7 X1 SA7 A1 INIT OUTPUT POINTER SA1 AIN SA1 X1-1 INIT INPUT POINTER SA0 B0 SB1 B0 MX7 0 CLEAR OUTPUT ASSEMBLY SB7 10 INIT CHAR COUNTERS, CHANGE FLAG MX0 -6 INIT MASK ZR X5,WLOOP EQ NLOOP * /--- BLOCK REPLACE 00 000 78/02/11 01.49 NLP0 PUTCODE X2,B2 NLOOP GETCODE X2,B2 NLP0.5 ZR X2,EOL BX3 -X0*X2 SX3 X3-1RZ-1 PL X3,NLP2 BX4 X2 ASSEMBLE NAME IN X4 SB4 B2 NLP1 GETCODE X2,B2 ZR X2,NLP1.2 BX3 -X0*X2 SX3 X3-1RZ-1 CHECK LETTER NG X3,NLP1.1 SX3 X2-2R'6 SPECIAL CASE ZR X3,NLP1.1 SX3 X2-1R. ANOTHER ONE ZR X3,NLP1.1 SX3 X2-1R9-1 DIGITS ONLY BY THEMSELVES PL X3,NLP1.2 NLP1.1 SB4 B4+B2 SB6 B4-10-1 PL B6,NLP1.5 SB6 B2+B2 SB6 B2+B6 SB6 B6+B6 LX4 B6 BX4 X4+X2 EQ NLP1 NLP1.2 LJUST X4,B4 SA3 ATABLE FETCH TABLE ADDRESS SA3 X3-2 INIT SEARCH POINTER NLP1.3 SA3 A3+2 ZR X3,NLP1.4 END TEST BX3 X3-X4 NZ X3,NLP1.3 (NOTE -0 IS NOT POSSIBLE) SA3 A3+1 GET NEW ENTRY BX4 X0*X3 REMOVE LENGTH BX3 -X0*X3 SB4 X3 SET LENGTH SA0 -1 SET CHANGE FLAG NLP1.4 PUTSTR X4,B4 EQ NLP0.5 NLP1.5 SB4 B4-B2 EQ NLP1.4 NLP2 SX3 X2-2R', ZR X3,NLP2.1 SX3 X2-2R'7 NZ X3,NLP3 NLP2.1 BX4 X2 SAVE QUOTE NLP2.2 PUTCODE X2,B2 GETCODE X2,B2 ZR X2,EOL BX3 X2-X4 SEE IF MATCHING QUOTE NZ X3,NLP2.2 IF NOT EQ NLP0 * /--- BLOCK REPLACE 00 000 78/02/11 01.31 NLP3 SX3 X2-1R, ZR X3,NLP3.1 SX3 X2-1R; ZR X3,NLP3.1 SX3 X2-2R^, NZ X3,NLP4 SB5 0 CLEAR FONT FLAG NLP3.1 NG X5,NLP0 IF NOT IN WRITEC MODE ZR X5,NLP0 SX5 X5-1 DECREMENT COUNT OF DELIMS LEFT ZR X5,WLP0 IF SWITCHING TO WRITE MODE EQ NLP0 NLP4 SX3 X2-2R^1 CHECK FOR CLOSE EMBED NZ X3,NLP0 NZ X5,NLP0 IF NOT IN WRITE MODE NZ B5,NLP0 IF FONTED * EQ WLP0 FALL THROUGH INTO -WRITE- LOOP SPACE 3,10 WLP0 PUTCODE X2,B2 WLOOP GETCODE X2,B2 ZR X2,EOL SX3 X2-2R^, NZ X3,WLP2 SB5 0 CLEAR FONT EQ WLP0 WLP2 SX3 X2-2R^0 CHECK FOR OPEN EMBED NZ X3,WLP0 EQ NLP0 TO PROCESSING LOOP SPACE 3,10 EOL SB6 B7+B7 SB6 B6+B7 SB6 B6+B6 LX7 B6 LEFT JUSTIFY LAST WORD SA7 A7+1 STORE IT SX1 10 SA2 AOUT SX7 A7 IX7 X7-X2 COMPUTE WORD COUNT IX7 X7*X1 COMPUTE CHAR COUNT SX1 B7-10 IX7 X7-X1 FINAL CHAR COUNT SA1 ACOUNT FETCH COUNTER ADDRESS SA7 X1 SX6 A0 SA6 TRETURN SET *ZRETURN* SA1 BREGS SB7 X1 AX1 18 SB5 X1 RESTORE B REGISTERS EQ PROCESS ENDOV * /--- BLOCK END 00 000 80/01/25 01.20 * * OVTABLE * * END EXEC5$