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