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^<OBJLEN^<10)
* STRING = STRING TO SEARCH IN (N OR NC VARS)
* LEN = LENGTH OF STRING, IN CHARS
* START = CHAR POSITION TO START AT (1^<START^<LEN)
* BUFF = BUFFER TO CONTAIN RESULTS (N, V, NC, VC)
* NUMBER = OPTIONAL COUNT OF NUMBER OF OCCURRENCES
* TO BE FOUND. IF OMITTED, ONLY ONE IF
* FOUND, AND SEARCH STOPS WHEN IT IS
* FOUND. OTHERWISE, OCCURRENCES ARE
* COUNTED, AND THE FIRST *NUMBER* ARE
* STORED.
*
* /--- BLOCK SEARCH DEF 00 000 79/11/01 22.57
TITLE CHARACTER STRING SEARCH ROUTINE
*
NWORDS EQU 70 WORDS TO SEARCH UNTIL INTERRUPT
*
STORE MACRO
LOCAL LB1,LB2,LB3
*
PL X1,LB1 FLOAT RESULT IF NECESSARY
PX6 X6
NX6 X6
*
*** NOTE THAT AN AUTHOR CAN HAVE HIS RETURN CELL IN
*** AS PART OF HIS SEARCH STRING (OR ONE WORD AWAY'/)
*** --SO MUST CHECK SO THAT DON'7T CHANGE THE END TEST
*
LB1 SB4 A4-B6
SB4 A7-B4 CHECK STORE ADDRESS AGAINST END TEST
NZ B4,LB2 B4=0 IF RESULT ADR = END TEST
*
SA6 SAVWORD STORE VALUE IN SAVED WORD
EQ LB3 AND CONTINUE
*
LB2 SA6 A4-B6 STORE VALUE IN RESULT BUFFER
BX6 X6 AND CONTINUE
*
LB3 BSS 0 FORCE TO NEXT WORD
ENDM
*
TSRCOBJ EQU TBINTSV SEARCH OBJECT
TSRCMXM EQU TBINTSV+1 ASSORTED JUNK, PART 1
TSRCTC1 EQU TBINTSV+2 TEN COPIES OF COMP. OF CHAR 1
TSRCTC2 EQU TBINTSV+3 TEN COPIES OF COMP. OF CHAR 2
TSRCST EQU TBINTSV+4 START OF THIS PART OF SEARCH
TSRCINX EQU TBINTSV+5 NUMBER OF OCCURRENCES LEFT TO FIND
TSRCEND EQU TBINTSV+6 ASSORTED JUNK, PART 2
*
* SPECIFICS ON ',ASSORTED JUNK', VARIABLES';
* TSRCMXM CONTAINS';
* 1/FP FLAG (1 MEANS STORE FLOATING)
* 1/REPEAT FLAG (1 MEANS NO REPEAT, 6 ARG FORM)
* 4/UNUSED
* 18/START OF RESULT AREA
* 18/CHAR POSITION TO STOP SEARCH ON
* 18/CHAR POSITION TO START SEARCH ON
*
* TSRCEND CONTAINS';
* 1/DIRECTION (1 MEANS BACKWARD SEARCH)
* 5/SHIFT COUNT/2 (30-3*OBJECT LENGTH)
* 18/RESULT BUFFER END
* 18/STRING BASE ADDRESS
* 18/STRING END + 2 OR START - 1
* (DEPENDING ON DIRECTION OF SEARCH)
*
* /--- BLOCK SEARCH 00 000 78/07/05 01.22
SEARCHO OVRLAY
SA1 OVARG1 SEE IF INTERRUPTED
NZ X1,POSTINT IF SO, CONTINUE FROM INT.
MX0 2*XCODEL
BX1 -X0*X5 MASK OUT ARGUMENTS 1 AND 2
AX1 XCMNDL SHIFT OFF COMMAND CODE
SA2 B5+X1 X2 = 1ST EXTRA ARG WORD
BX6 X2
SA3 A2+1 X3 = 2ND EXTRA ARG WORD
BX5 X3 SET FOR NGETVAR
BX7 X3
LX3 XCODEL BRING OPTIONAL ARG. 7 TO TOP
SA6 SRCHSAV STORE FIRST ARG. WORD
SA7 SRCHSV2 AND SECOND ONE
NG X3,SRCHX1 JUMP IF NO 7TH ARGUMENT
*
* CONTINUE IF 7 ARGUMENT FORM (REPEATED SEARCH)
*
NGETVAR 6 A1 = RESULT START ADDRESS
SX6 A1
SA6 SRCHADR SAVE RESULT ADDRESS
SA2 SRCHSV2 BRING 2ND ARG WORD BACK
BX5 X2
LX5 XCODEL
*
* GET NUMBER OF TIMES TO STORE (ARG. 7)
*
NGETVAR INC X1 = NUMBER OF TIMES TO STORE
SA2 SRCHADR
SA0 X2 A0 HAS STARTING ADDRESS
* SX1 X1 USE 18 BIT ARITHMETIC
* NG X1,ERXBADL DISALLOW NEGATIVE COUNT
* SB1 X1+1 B1 CONTAINS LENGTH FOR BOUNDS
NG X1,ERXBADL DISALLOW NEGATIVE COUNT
* EXECERR USES X1
SX6 1
IX1 X1+X6 CHECK BOUNDS FOR STORE COUNT+1
* ZR X1,ERXBADL CHECK THAT STORE COUNT NE -1
CALL BOUNDS PERFORM BOUNDS CHECK
SX6 B1-1 SET ADDRESS OF BUFFER END
* SX7 X1 MOVE STORE COUNT OVER (SMALL INTEGER)
SX7 X1-1 MOVE STORE COUNT OVER (SMALL INTEGER)
MX1 0 X1 = FLAG (0=REPEAT)
EQ SRCHX2
* /--- BLOCK SEARCH 00 000 78/05/02 21.38
*
* 6 ARGUMENT SEARCH - GET RESULT ADDRESS
*
SRCHX1 NGETVAR 6 A1 = RESULT ADDRESS
SX6 A1 COPY TO X6
SA0 A1 AND TO A0
SX7 1 NUMBER OF SEARCHES TO DO
MX1 1 SET FLAG FOR NO REPEAT
LX1 -1 MOVE INTO PROPER PLACE
SRCHX2 SA7 TSRCINX STORE REPEAT COUNT
MX0 -18
BX6 -X0*X6 AVOID EXTENDED SIGNS
LX6 36
SA6 TSRCEND STORE AWAY
SX6 A0 GET COUNTER ADDRESS (7ARG ONLY)
BX6 -X0*X6 WIPE OUT SIGN EXTENSION
LX6 36
BX6 X1+X6 MOVE IN REPEAT FLAG
SA5 A5 RESTORE COMMAND WORD
SA6 TSRCMXM AND STORE
* /--- BLOCK SEARCH 00 000 78/05/02 21.38
*
* GET SEARCH OBJECT (ARG 1)
*
NGETVAR 1 X1 = OBJECT
BX6 X1
SA6 TSRCOBJ STORE OBJECT
MX0 6 MASK FOR FIRST CHARACTER
BX6 X6*X0 X.........
BX2 X6 X.........
LX2 6 .........X
BX2 X2+X6 X........X
LX2 6 ........XX
BX6 X6+X2 X.......XX
LX2 12 ......XX..
BX6 X6+X2 X.....XXXX
BX2 -X6 C;;;;;CCCC
LX2 30 ;CCCCC;;;;
BX6 -X6*X2 GOT 10 COPIES OF CHAR 1 NOW
SA6 TSRCTC1 STORE THAT
LX1 6 REPEAT THIS FOR 2ND CHAR
BX6 X1*X0 X.........
BX2 X6 X.........
LX2 6 .........X
BX2 X2+X6 X........X
LX2 6 ........XX
BX6 X6+X2 X.......XX
LX2 12 ......XX..
BX6 X6+X2 X.....XXXX
BX2 -X6 C;;;;;CCCC
LX2 30 ;CCCCC;;;;
BX6 -X6*X2 GOT 10 COPIES OF CHAR 2
SA6 TSRCTC2 STORE THAT TOO
*
* GET ARGUMENT 2 (OBJECT LENGTH)
*
SA5 A5 GET COMMAND WORD BACK
LX5 XCODEL
NGETVAR INC LENGTH IN X1
SA2 SRCHSAV BRING UP 1ST EXTRA ARG WORD
BX5 X2 FOR NGETVAR
SX6 X1 LENGTH TO X6, 18 BIT ARITHMETIC
NG X6,ERXBADL ERROR IF NEGATIVE
ZR X6,NOSRCH DON'7T SEARCH FOR NOTHING
SX2 X6-11
PL X2,ERXBADL ERROR IF GREATER THAN 10
SA6 SRCHOBL SAVE OBJECT LENGTH
SA1 TSRCEND BRING UP INCOMPLETE TSRCEND
LX6 2 MULTIPLY LENGTH BY 4
SX2 X6-30 4*LENGTH-30
LX6 -2 NOW X6 = LENGTH AGAIN
IX6 X6-X2 X6 = 30-(LENGTH*3)
MX0 -5 MASK FOR SHIFT COUNT
BX6 -X0*X6
LX6 54 MOVE INTO PLACE
BX6 X1+X6 MERGE IN NEW DATA
SA6 A1 STORE RESULT
* /--- BLOCK SEARCH 00 000 78/05/02 21.39
*
* GET BASE ADDRESS OF SEARCH (ARG 3)
*
NGETVAR INC BASE ADDRESS TO A1
SX6 A1
SA6 TSRCST STORE FOR A WHILE
MX0 -18
BX6 -X0*X6 REDUCE TO 18 BITS
LX6 18 MOVE INTO PLACE
SA1 TSRCEND
BX6 X1+X6 MERGE WITH OLDER DATA
SA6 A1 AND STORE BACK
SA1 SRCHSAV GET 1ST ARG WORD AGAIN
BX5 X1
LX5 XCODEL
*
* GET LENGTH IN CHARACTERS (ARG. 4)
*
NGETVAR INC X1 = NUMBER OF CHAR
ZR X1,NOSRCH DON'7T SEARCH THROUGH NOTHING
SA3 SRCHSAV GET EXTRA ARG WORD BACK
SX6 X1 MOVE LENGTH, 18 BIT ARITHMETIC
PL X6,SRCHX3 BRANCH IF FORWARD SEARCH
BX6 -X6 GET ABSOLUTE VALUE
SA1 TSRCEND
MX0 1 FLAG BIT FOR REVERSE SEARCH
BX7 X1+X0 MERGE
SA7 A1 AND STORE THE RESULT
SRCHX3 SA6 SRCHLEN SAVE LENGTH IN CHARS
SA1 TSRCST
SA0 X1
BX1 X6 FOR *WORDS*
CALL WORDS
BX5 X3
LX5 2*XCODEL BRING UP ARGUMENT 5
* /--- BLOCK SEARCH 00 000 78/05/02 21.39
*
* GET STARTING OFFSET (ARGUMENT 5)
*
NGETVAR INC OFFSET TO X1
SB3 X1-1 MAKE 1-BASE INTO 0-BASE OFFSET
NG B3,ERXPOS ERROR IF OFFSET TOO SMALL
SA1 SRCHLEN READ SEARCH LENGTH IN CHARS
SA2 SRCHOBL AND OBJECT LENGTH
SB2 X1 COPY LENGTH
LE B2,B3,SERX ERROR IF OFFSET > 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$