EXEC1 * /--- FILE TYPE = E * /--- BLOCK EXEC1 00 000 77/08/24 16.02 IDENT EXEC1 TITLE EXEC1 -- EXECUTION-INTERPRETER * * THIS IS THE DRIVER FOR EXECUTION OF ALL * TUTOR COMMANDS. * * * GET COMMON SYMBOL TABLE * CST * * TITLE PLATO EXECUTION REGISTER CONVENTIONS * * THE FOLLOWING REGISTERS ARE RESERVED DURING THIS * PROGRAM. THEY MUST BE SAVED AND RESTORED IF ANY * SUBPROGRAM USES THEM. * * A5 - ADDRESS OF COMMAND (X5 HOLDS COMMAND) * B4 - BASE ADDRESS OF STUDENT VARIABLES (V0) * B5 - BASE ADDRESS OF EXTRA STORAGE * B6 - BASE ADDRESS OF COMMON VARIABLES * B7 - STUDENT CONTINGENCY TYPE CODE * * * NCTYPE HOLDS CONTINGENCY (AS WELL AS B7) * * 0 = UNIT-C * 1 = ARROW-C * 2 = JUDGE-C * 3 = ANS-C * 4 = SEARCH-C * 5 = TERM FOUND-C * 6 = NEXT-NOW-C * 7 = ALL-OK-C * 8 = ARROW OK-C * 9 = INITIAL LESSON ENTRY-C * * /--- BLOCK ENTRY 00 000 79/02/09 22.12 TITLE ENTRY POINTS * * ENTRY BOUNDS,PROCESS,PROCO,PROC,GETN ENTRY VARCNT,GETCODX,ILOC ENTRY VARADD,XDATA,YDATA,EXECSAV ENTRY CUNIT,GETTAG ENTRY GET2 ENTRY GETN ENTRY GET2F ENTRY XDATA ENTRY YDATA ENTRY DOC= ENTRY DO= ENTRY JOINC= ENTRY DOR= ENTRY JOINR= * ENTRY POINTS NEED BY WRITE STATEMENT ENTRY WRITE5= ENTRY WRITE6= * ENTRY ARGS=,STORE=,ANSV=,WRONGV=,COMPUT= ENTRY TOUCHW= * ENTRY WRONG=,WRONGC= USED IN FILES ANSW1 ENTRY WRONGA= USED IN ANSW1 ENTRY MISCON= IN FILE ANS1 * * * /--- BLOCK EXTERNAL 00 000 79/01/20 13.11 TITLE EXTERNAL SYMBOL DEFINITIONS * EXT EXCHNX EXT JOINX,JOINCX,ARGSX,JUMPXX,JUMPXC EXT IEUENDX EXT GOTOX,GOTOCX,DOX,DOLX,DOFX,DOFLX EXT POSTCMS,TOOMUCH EXT ERXUNUS,ERXCNUM,ERXDFIN,ERXBADL,ERXPOS EXT ERXSTN,ERXJOIN,ERXOVRT,ERXMXLC EXT ERXINDL EXT FINDX,FINDAX,TSTBINX EXT BLOCKX,ADD1X,SUB1X EXT CODOUTX,COMMX,SCOMMX,TABX EXT COPYX,JKEYX,DATEX,CLOCKX * EXT PLAYX,MIKEX,EXCHANX,CONDENX,DISKX EXT PLAYX,MIKEX,EXCHANX,CONDENX EXT ENABLEX,DISABLX EXT DELAYX,AFONTX EXT CHECKX,NAMEX,GROUPX,DAYX,ZEROX,ZEROXX EXT RESTX,ITOAX,EDITX EXT BUMPX,CODEX EXT SYSLESX,CONTROX (EXEC2) EXT ERROROF,RETRNX,RETRNZ EXT OKWORDX,NOWORDX,CPULIMX EXT MODESEX,BITSOUX,ZFILLX,SIGNIX EXT ASCIIX EXT LOGICX,STOPCHK,CCLRXX EXT GETCX EXT PAUSEX,PAUSEH EXT COLLCTX (LOGICX) EXT DRAWX,RDRAWX,GDRAWX (EXEC2) EXT SETX EXT TWRTCX *** NEW -WRITEC- COMMAND EXT WRSOUT WRITE (KEYSIN) EXT MEMOUT LOAD MEMORY (KEYSIN) EXT ARRPLT PLOT SUPER BIG AND NICE ARROW (KEYSIN) EXT TUERASE SIZED ERASE (LINWRT) EXT FAKEPLT RESET X AND Y (KEYSIN) EXT FIRSTXY GET STARTING ARROW X AND Y (KEYSIN) EXT XYFIX UPDATE X-Y AND SAVE FOR ANS-C (TUTOUT) EXT WIPE ERASE ENTIRE ANSWER (KEYSIN) EXT LWIPE LARGE CHARS ERASE EXT SIZEX,ROTATEX (LINWRT) EXT SIMPLOT SIMULATE PLOTTING (SIMPLOT) * EXT STORAGX EXT CHARSET (MICROX) EXT CHARTST (MICROX) EXT RQPRINX EXT CONDRQX EXT OTOAX EXT CLEANX * /--- BLOCK EXTERNAL 00 000 79/01/20 13.23 EXT SYSLOX,AREAX,READSEX EXT PACKRX EXT OUTDATX,OUTDATL,SCOREX,LSNX,LSNCX,STLSTAT EXT OUTDATT EXT READDX EXT GETCHRX EXT REFONTX (IOPUT) EXT GETUNIT,UNITGOB (GETUNIT) EXT JOUTX EXT LINWRT LINE MODE OUTPUT (LINWRT) EXT RCTOXY USED BY TOUCH AND OTHERS (ARROW) EXT READRX,RDRINF (DATAX) EXT ATTACHX,DETACHX (FILEX) EXT DATAINX,DATOUTX (FILEX) EXT GETLINX,SETLINX (FILEX) EXT IOSPECX (FILEX) EXT MATCHX (ANSWER) EXT CLOSEX (ANSWER) EXT SPECX (ANSWER) EXT EXACTX EXACT STRING MATCH (ANSWER) EXT ANSXX (ANSWER) EXT ANSDOS (ANSWER) EXT WRONG (ANSWER) EXT WRONGS (ANSWER) EXT ANSVX (ANSWER) EXT PANSKEY (ANSWER) EXT ANSKEYX (ANSWER) EXT CNCEPTX CONCEPT JUDGER (ANSWER) EXT LOADAX (ANSWER) EXT WRONGVX (ANSWER) EXT OPENX (ANSWER) EXT STORENX STORE NUMERIC (ANSWER) EXT GETWDX,GETMKX,COMPX,GETLOCX (ANSWER) EXT EXACTVX (ANSWER) EXT EXACTCX CONDITIONAL EXACT EXT OKX (ANSWER) EXT ANSEND (ANSWER) EXT ANSMARK (ANSWER) EXT JOVER (ANSWER) * EXT SHOW SHOW SUBROUTINE (EXEC2) EXT SHOWT SHOWT SUBROUTINE EXT SHOWZ SHOWZ SUBROUTINE * EXT FGETVAR VARIABLE EVALUATION ROUTINE (GETVAR) EXT NGETVAR INTEGER GETVAR ROUTINE (GETVAR) * EXT ECSPRTY SYSTEM ECS PARITY ROUTINE (ECSPRT) EXT EXIT EXIT FROM EXECUTION (LOGIC) EXT PJUDGOO INITIATE JUDGING (LOGIC) EXT OUTFLOW,FINISH EXT MOVEX MOVE COMMAND (EXEC3) EXT TRANSX TRANSFR COMMAND (EXEC3) EXT KERMITX KERMIT PROTOCOL (EXEC3) EXT JMPOUTX JUMPOUT (TUTORX) EXT FEDITX FILEDIT (TUTORX) EXT FONTX FONT (EXEC3) EXT STORAGX STORAGE (TUTORX) EXT SIGNINX SIGNIN (TUTORX) EXT CONDENX CONDENS (TUTORX) EXT EXCHANX EXCHANGE (TUTORX) EXT CCLEARX CCLEAR (TUTORX) * /--- BLOCK EXTERNAL 00 000 78/12/18 21.19 * EXT SETRX SETRESV DATAX * * NEW DISK SYSTEM COMMANDS IN FILE IOPUT * EXT SETPACX SET PACK NAME EXT SETFILX SET FILE INFO WORD EXT ATTCHPX,DETCHPX ATTACH, DETACH FILE EXT ATTFX,DETFX ATTACHF,DETACHF EXT READFX,WRITEFX READF/WRITEF EXT RENAMFX RENAME FILE EXT RETYPFX RETYPE FILE EXT CREATEX,DESTROX CREATE, DESTROY FILE EXT DREADX,DWRITEX DISK I/O (RELATIVE) EXT DINX,DOUTX,DSTATX EXT DISKIX,DISKOX DISK I/O BY SECTORS (ABSOLUTE) EXT DSKREAX,DSKWRIX DISK I/O BY SECTORS (RELATIVE) * EXT DATASEX DATASET EXT ATTCHX,DETCHX ATTACH/DETACH FILES * EXT MOUTX0 WRITE COMMAND EXT MOUTIT WRITE COMMAND EXT MOUTX WRITE COMMAND EXT MOUTMX WRITE COMMAND EXT EWRITE WRITE COMMAND EXT EWRITEX WRITE COMMAND EXT OFFEBX WRITE COMMAND EXT NEXACTX NEW EXACTC IN ANSWER * EXT STEPX EXT RESIGNX IN FILE LCOMND EXT OUTACC IN MAIN (FOR USE BY -EXT-) * EXT MESSAGX * EXT RETARGX NEW -RETURN- COMMAND EXT DORX,JOINRX PSEUDO COMMANDS FOR RARGS * EXT ANSAXXX (ANSWERA) EXT COLORXX (EXEC7) EXT TWINDOW (GETVAR) * * /--- BLOCK JUMP MACRO 00 000 79/03/21 21.25 TITLE JUMP TABLE * * 'FOR COMMANDS WITH ONLY ONE BRANCH, THE BRANCH * IS EXPLICITLY GIVEN IN THE BOTTOM 18 BITS OF THE * TABLE ENTRY. 'IF BRANCHES DIFFER WITH CONTINGENCY, * THE BOTTOM 18 BITS POINT TO A SECONDARY BRANCH * TABLE. 'SEE BELOW FOR EXPLANATIONS REGARDING * THE JUMPOV MACRO. * JUMP MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L N1 MICRO 1,1, CONTG N2 MICRO 2,1, CONTG N3 MICRO 3,1, CONTG N4 MICRO 4,1, CONTG N5 MICRO 5,1, CONTG VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2 NN SET NN+1 ENDM * * JUMP1 AND ARG1 PERTAIN TO CONDENSE ROUTINE * AND JUMP2 AND ARG2 TO THE EXECUTION ROUTINE. * 'IN EACH CASE, IF JUMP IS ',CM', THEN ARG GIVES * THE CENTRAL MEMORY ADDRESS OF THE PROCESSING * ROUTINE; OTHERWISE, JUMP IS THE OVERLAY NUMBER * AND ARG CONTAINS ANY ARGUMENT TO BE PASSED IT. * JUMPOV MACRO NAME,NAM,TYPE,JUMP1,ARG1,CONTG,JUMP2,ARG2 N1 MICRO 1,1, CONTG N2 MICRO 2,1, CONTG N3 MICRO 3,1, CONTG N4 MICRO 4,1, CONTG N5 MICRO 5,1, CONTG VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",10/0 IFC NE,*JUMP2*CM* DD DECMIC JUMP2 IF DEF,D"DD"$,1 ERR NON-EXECUTABLE OVERLAY VFD 9/JUMP2,18/ARG2,18/PROCOV ELSE VFD 27/0,18/ARG2 ENDIF N6 MICRO 3,8, NAME_= "N6" EQU NN NN SET NN+1 ENDM * JUMPD MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L N1 MICRO 1,1, CONTG N2 MICRO 2,1, CONTG N3 MICRO 3,1, CONTG N4 MICRO 4,1, CONTG N5 MICRO 5,1, CONTG VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2 N6 MICRO 3,8, NAME_= "N6" EQU NN NN SET NN+1 ENDM * JUMP* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L N1 MICRO 1,1, CONTG N2 MICRO 2,1, CONTG N3 MICRO 3,1, CONTG N4 MICRO 4,1, CONTG N5 MICRO 5,1, CONTG VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2 NN SET NN+1 ENDM * JUMPD* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L N1 MICRO 1,1, CONTG N2 MICRO 2,1, CONTG N3 MICRO 3,1, CONTG N4 MICRO 4,1, CONTG N5 MICRO 5,1, CONTG VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2 N6 MICRO 3,8, NAME_= "N6" EQU NN NN SET NN+1 ENDM * JUMPF MACRO ENDM * JUMPI MACRO ENDM * * USED ONLY IN CONDENSOR FOR NON-EXECUTABLE * COMMANDS IN OVERLAYS * JUMPIO MACRO ENDM * * /--- BLOCK JUMP MACRO 00 000 79/03/21 21.25 JUMPP MACRO ENDM * * /--- BLOCK JUMP MACRO 00 000 79/03/21 21.25 JUMPPO MACRO ENDM * * * /--- BLOCK RETPROC 00 000 78/04/02 03.16 TITLE RETPROC -- RELOAD UNIT AFTER I/O COMMAND * * * * UNFINISHED BUSINESS... * THIS MIGHT BE A BIT MESSY HERE UNTIL OTHER * PLACES ARE CLEANED UP. THE IDEA IS THAT ALL * CHECKS FOR EXCESSIVE DISK ACCESSING SHOULD BE * HERE. PROBLEMS NEEDING WORK'; * * NEEDS EXCESSIVE 'D'A'P'M CHECK...LIKE IOCHK...HERE AND * NOT ALL OVER THE PLACE. * * * * RETPROC * * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS. * RETURN AFTER COMMANDS THAT DID DISK ACCESSES AND * THAT USED -SAVLES- (OR HAVE UNLOADED'; COMMON, * STORAGE, ANSWER-JUDGING BUFFERS, UNIT, ETC.). * -STOP1- KEY WILL BE CHECKED FOR. * EXCESSIVE PROCESSING WILL BE CHECKED FOR. * * * * ENTRY RETPROC RETPROC CALL RESTLES RESTORE COMMON, UNIT, ETC * INFO PREVIOUSLY SAVED BY * CALL TO SAVLES * /--- BLOCK CKPROC 00 000 79/10/09 23.45 TITLE CKPROC -- RETURN FROM INTERRUPT COMMANDS * * * * CKPROC * * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS. * RETURN AFTER COMMANDS THAT DO DISK ACCESSES. * -STOP1- KEY WILL BE CHECKED FOR. * TOO MUCH PROCESSING WILL BE CHECKED FOR. THIS * CAN COME ABOUT WHEN SERIES OF COMMANDS INTERNALLY * INTERRUPT (E.G., DISK ACCESSING) WITHOUT EVER * CAUSING A TIME-SLICE EXCEEDED BUT USE ENUF CPU * TIME FREQUENTLY ENUF TO GO OVER THE ALLOWED TIPS. * * ENTRY CKPROC CKPROC BSS 0 SA1 STFLAGS SEE IF -STOP1- PRESSED SINCE LX1 -ST1BIT STARTED RUNNING IN THIS LESSON NG X1,CKPROCA LX1 ST1BIT-SSBBIT TEST IF BACKOUT IN PROGRESS NG X1,CKPROC2 (IN SPECIAL STOP1 LESSON) * CHECK FOR UNPROCESSED OUTPUT IN THE PLATO TO * FORMAT BUFFERS. IF YES, END THIS TIME SLICE. SA1 OUTMOUT SA2 SUBMOUT IX1 X1-X2 ZR X1,CKPROC2 IF NO UNPROCESSED OUTPUT CALL TFIN ELSE, END THIS TIMESLICE EQ CKPROC TRY AGAIN CKPROCA BSS 0 * CALL STOPCHK X2=0 IF STOP1 HANDLING LESSON SX6 STOP1 SA6 KEY MAKE SURE KEY=STOP1 * ZR X2,CKPROC2 SEPARATE STOP1-LESSONS * SA1 STFLAGS SEE IF ALREADY IN FINISH UNIT LX1 60-FINBIT PL X1,FINISH --- BRANCH IF NOT FINISH UNIT * SA3 TDSKACC IN FINISH UNIT MX6 1 INCREMENT DISK ACCESS COUNT LX6 55 IX6 X3+X6 SA6 A3 LX6 6 MX3 54 BX3 -X3*X6 SX3 X3-10-1 NO MORE THAN 10 ACCESSES PL X3,ERXDFIN CANNOT ALLOW MORE IN FINISH U * CKPROC2 CALL COMPTIM CHECK FOR TOO MUCH PROCESSING NG B2,PROCESS CONTINUE EQ XSL2 END IF TOO MUCH PROCESSING * /--- BLOCK PROCESX 00 000 78/05/17 21.08 ENTRY PROCESX * PROCESS RETURN FOR COMMANDS THAT SET EXECERR * ARG NUMBER PROCESX SX6 0 SA6 ERXARGN EQ PROCESS * /--- BLOCK RETPRO 00 000 79/09/01 19.35 TITLE RETPRO -- RELOAD UNIT AND CONTINUE * * * * RETPROS,RETPRO * * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS. * RETURN AFTER COMMANDS THAT USED -SAVLES- (OR HAVE * UNLOADED'; COMMON,STORAGE,ANSWER-JUDGING BUFFERS, * UNIT (MUST CALL GETUNIT),ETC.) * THOSE THAT INTERRUPTED SHOULD USE -RETPROS- TO * IMMEDIATELY CATCH ANY -STOP1- KEYS THE USER MAY * HAVE PRESSED. * * * * * ENTRY RETPROS SOME INTERRUPT HAS OCCURRED * SO -STOP1- MUST BE CHECKED FOR. RETPROS SA1 STFLAGS SEE IF -STOP1- PRESSED LX1 -ST1BIT PL X1,RETPRO SX6 STOP1 MAKE SURE KEY=STOP1 SA6 KEY CALL STOPCHK SEE IF LESSON HANDLES STOP1 NZ X2,FINISH IF NOT, START FINISH UNIT * SA1 STFLAGS CLEAR -STOP1- BIT FOR SYSTEM * MX6 1 LESSONS THAT HANDLE IT * LX6 ST1BIT * BX6 -X6*X1 * SA6 A1 * ENTRY RETPRO RETPRO CALL RESTLES RESTORE COMMON, UNIT, ETC * INFO PREVIOUSLY SAVED BY * CALL TO SAVLES * ON TO PROCESS * /--- BLOCK PROCESS 00 000 80/04/22 00.55 TITLE PROCESS -- CHECK IF TIMESLICE OVER * * * * PROCESS * * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS. * ENTRY AFTER COMMANDS THAT DO NOT DO ANY DISK * ACCESSES BUT ARE LONG ENOUGH IN PROCESSING (SAY * OVER 0.1 MS) TO POSSIBLY CAUSE THE TIME-SLICE TO * BE EXCEEDED. THE STANDARD RETURN FOR COMMANDS. * * ENTRY PROCESS PROCESS SA1 XSLCLOK GET RUNNING MS CLOCK SA2 MAXCLOK GET END OF TIME-SLICE IX2 X1-X2 PL X2,XXSLICE EXIT IF TIME-SLICE OVER * /--- BLOCK PROC 00 000 80/04/22 00.56 TITLE PROC -- EXECUTE NEXT COMMAND * * * * PROC * * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS * ENTRY AFTER COMMANDS THAT TAKE PRACTICALLY NO * PROCESSING TIME (SAY A FEW MICROSECONDS) AND MAKE * NO DISK ACCESSES. A WHOLE UNIT FULL OF THESE * COMMANDS SHOULD NOT CONSUME A TIME-SLICE. * * * * ENTRY PROC,PROC1 PROC SA1 SCOMFLG STEP MODE OVERWRITES THIS WORD NZ X1,SPROC SEE IF COMMAND STAT FLAG IS ON PROC1 SA5 A5-1 LOAD NEXT COMMAND MX0 60-XCMNDL BX4 -X0*X5 GET ONLY COMMAND BITS SA1 X4+JTABLE LOAD COMMAND TABLE ENTRY SB1 X1 WHERE TO JUMP LX1 B7,X1 SHIFT TO PROPER CONTINGENCY BIT PL X1,PROC1 IGNORE IF NOT VALID IN THIS CONTINGENCY JP B1 JUMP TO EXECUTION ROUTINE * * * SPECIAL PROCESSOR FOR STATISTICS TAKING * SAVES TIME IN NORMAL NON-STAT LOOP * * SEE ALSO -- TUTIM PROCESSING IN TUTORX * SPROC PL X1,SPROC1 RJ POSTCMS TAKE COMMAND STAT IF FLAG SET SPROC1 SA5 A5-1 LOAD NEXT COMMAND MX0 60-XCMNDL BX4 -X0*X5 GET ONLY COMMAND BITS SA1 X4+JTABLE LOAD COMMAND TABLE ENTRY SB1 X1 WHERE TO JUMP LX1 B7,X1 SHIFT TO PROPER CONTINGENCY BIT PL X1,SPROC1 IGNORE IF NOT VALID IN THIS CONTINGENCY BX6 X4 SA6 SCOMNUM SAVE COMMAND NUMBER SA2 SCOMLES ZR X2,SPROC1A 0 INDICATES ALL LESSONS SA3 TBLESSN BX2 X2-X3 SEE IF NEEDED FOR THIS LESSON NZ X2,SPROC2 JUMP TO EXECUTION IF NOT NEEDED SPROC1A SA2 XSLCLOK BX6 X2 SA6 SCOMBEG SAVE BEGIN EXECUTION TIME SA2 SCOMFLG BX6 -X2 COMPLIMENT FLAG SA6 A2 SET COMMAND STATISTICS FLAG ON SPROC2 JP B1 JUMP TO EXECUTION ROUTINE * * * /--- BLOCK PROCO 00 000 78/04/02 03.02 TITLE PROCO -- RETURN FROM OUTPUT COMMANDS * * * * PROCO * * RETURN FOR COMMANDS THAT PUT OUTPUT INTO -MOUT- * IT CHECKS WHETHER -MOUT- IS GETTING FULL AND * DOES AN INTERRUPT IF SO. THIS RETURN AVOIDS * HAVING ALL THESE COMMANDS DO THIS TEST SOMEWHERE. * * * * ENTRY PROCO PROCO SA1 AOUTLOC SX1 X1-AOUTLTH/2 PL X1,PCO10 CHECK ACTION REQ BUFFER FILLING * IF THIS IS A DSN SITE CHECK IF TOO MUCH OUTPUT * IN MOUT BUFFER SO THAT PARCEL BUFFER OVERFLOW * WILL NOT OCCUR WHEN THE DSN OUTPUT SLOWS UP. DSNMOUT SA1 STATION AX1 5 SA2 AFRAMID IX0 X1+X2 RX2 X0 SB2 X2 SB1 DSN0FOD LT B2,B1,NAMMOUT SB1 B1+MXDSN GE B2,B1,NAMMOUT SA1 MOUTLOC SX1 X1-MOUTDSN EQ PCO05 * DO THE SAME IF NAM SITE NAMMOUT SB1 NAM0FOD LT B2,B1,CIUMOUT SB1 B1+MXNAM GE B2,B1,CIUMOUT SA1 MOUTLOC SX1 X1-MOUTNAM EQ PCO05 * OTHERWISE ITS A CIU SITE CIUMOUT SA1 MOUTLOC SX1 X1-MOUT200 PCO05 PL X1,PCO10 CHECK IF *MOUT* BUFFER FILLING CHKPRC SA1 PARCLCNT SX1 X1-PRCLIM CHECK FOR TOO MUCH ACCUMULATED NG X1,PROCESS * PCO10 SA1 INARGS NZ X1,PROC EXIT IF ARGUMENTS IN HAND SA1 TBITS LX1 BRKBIT CHECK IF AUTO-BREAK SURPRESSED NG X1,PROCESS SA1 INEMBED CHECK IF EMBEDDED WRITE ZR X1,XXSLICE CALL WINTRP INTERRUPT EQ PROCESS * /--- BLOCK PROCOV 00 000 78/04/02 03.01 TITLE PROCOV -- LOAD COMMAND OVERLAY AND EXECUTE * * -PROCOV- * * LOAD THE COMMAND EXECUTION OVERLAY AND BEGIN * EXECUTION. * * A1 = ADDRESS OF JUMP TABLE ENTRY * * PROCOV SA1 A1 RE-LOAD COMMAND TABLE ENTRY LX1 -36 SHIFT OVERLAY ARG TO TOP 18 BX6 X1 AX6 -18 EXTEND SIGN BIT OVER WORD * * SOME COMMANDS ENTER HERE WITH (X6) = ARGUMENT * AND (X1) = OVERLAY NUMBER * PROCOV1 SA6 OVARG1 MX7 -9 BX7 -X7*X1 MASK OFF OVERLAY NUMBER MX6 0 SA6 =XOVRSTAK CLEAR OVERLAY STACK CALL EXECOV0 LOAD AND EXECUTE OVERLAY (X7) EQ ERXOVRT OVERLAY SHOULD NOT RETURN HERE * /--- BLOCK XXSLICE 00 000 80/04/22 00.57 TITLE XXSLICE -- END TIME SLICE * XXSLICE SA1 INEMBED NZ X1,PROC EXIT IF IN EMBEDDED WRITE SA1 INARGS NZ X1,PROC EXIT IF ARGUMENTS IN HAND SA1 TBITS LX1 BRKBIT NG X1,TOOMUCH JUMP IF AUTO-BREAK SUPPRESSED * * ENTRY XSLICE * XSLICE SA1 SCOMFLG PL X1,XSL2 JUMP IF NO STATISTICS CALL POSTCMS TAKE COMMAND STATISTICS * XSL2 CALL TFIN END THIS TIME SLICE EQ PROCESS * * * TITLE PRE-CHECK FOR OUTPUT COMMANDS * * * -OPRECHK- * ENTRY OPRECHK OPRECHK EQ * SA1 RSIZE ZR X1,OPRE1 IF SIZE NOT 0 SA1 MOUTLOC SX2 X1-MOUT200 PL X2,OPREWT JUMP IF MUCH OUTPUT * OPRE1 SA1 XSLCLOK GET CPU USE CLOCK SA2 MAXCLOK GET END OF TIME SLICE IX2 X1-X2 NG X2,OPRECHK * * OPREWT SA1 TBITS LX1 BRKBIT CHECK IF AUTO-BREAK SUPPRESSED NG X1,OPRECHK SA5 A5+1 BACKSPACE COMMAND POINTER EQ XXSLICE * * TITLE COMMAND JUMP TABLE * * * COMMAND JUMP TABLE * THE TOP NTH BIT OF THE WORD IF SET MEANS THE COMMAND IS VALID * IN CONTINGENCY *N*. THE BOTTOM 18 BITS HOLD THE BRANCH ADDRESS * * * * ENTRY JTABLE JTABLE BSS 0 * NOREF NN NN SET 0 DEFINE NAMES * LIST X,G *CALL COMNDS * * ALLOW A FEW EXTRA ENTRIES SO NEW COMMANDS MAY * BE ADDED TO CONDENSOR WITHOUT REQUIRING A * RE-ASSEMBLY OF EXEC1 * JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS * LIST * ENTRY CREATE= DESTRY= EQU DESTROY= ENTRY DESTRY= RENAMF= EQU RENAMEF= ENTRY RENAMF= RETYPF= EQU RETYPEF= ENTRY RETYPF= SYSFIL= EQU SYSFILE= ENTRY SYSFIL= * /--- BLOCK SECONDARY 00 000 78/08/14 00.46 TITLE SECONDARY BRANCHING * ENTRY UNIT= COMPUT= EQU COMPUTE= * * ENTRY UNITJ * UNITJ SA1 THELPF CHECK IF IN ON-PAGE HELP NZ X1,UNITXH SA1 JOIN UNITJ0 NZ X1,UNJOIN UNJOIN IF IN JOIN JP B7+*+1 + EQ EXIT + EQ UNITAX1 + EQ ANSEND + SX6 EXIT - EQ CIA + EQ UNITSX1 * ENDARJ ZR B7,PROCESS NO PROCESSING YET IN UNIT-C JP B7+* + EQ UNITAX1 + EQ ANSEND + EQ ANSMARK + EQ ENDARRX * ARROWJ ZR B7,ARROWX JP B7+* + EQ UNITAX1 + EQ ANSEND + SX6 ARROWX - EQ CIA + EQ ARROWX ARROWFJ ZR B7,ARROWFX JP B7+* + EQ UNITAX1 + EQ ANSEND + SX6 ARROWFX - EQ CIA + EQ ARROWFX JARROWJ ZR B7,JARROWX JP B7+* + EQ UNITAX1 + EQ ANSEND + SX6 JARROWX - EQ CIA * STOREJ JP B7+* + EQ UNITAX1 + EQ STORE + EQ ANSMARK CLOSEJ JP B7+* + EQ UNITAX1 + EQ CLOSEX + EQ ANSMARK PUTJ JP B7+* + EQ UNITAX1 + EQ PUTX + EQ ANSMARK SPECSJ JP B7+* + EQ UNITAX1 + EQ SPECX + EQ ANSMARK EXACTJ JP B7+* + EQ UNITAX1 + EQ EXACTX + EQ ANSMARK STOREAJ JP B7+* + EQ UNITAX1 + EQ STOREAX + EQ ANSMARK * /--- BLOCK -SECONDARY 00 000 79/10/28 21.50 ANSVJP JP B7+* + EQ UNITAX1 + EQ ANSVX + EQ ANSMARK CONCEPTJ JP B7+* + EQ UNITAX1 + EQ CNCEPTX + EQ ANSMARK TOUCHJ JP B7+* + EQ UNITAX1 + EQ TOUCHX + EQ ANSMARK LOADAJ JP B7+* + EQ UNITAX1 + EQ LOADAX + EQ ANSMARK WRONGVJ JP B7+* + EQ UNITAX1 + EQ WRONGVX + EQ ANSMARK ANSKEYJ JP B7+* + EQ PANSKEY + EQ ANSKEYX + EQ ANSMARK OPENJ JP B7+* + EQ UNITAX1 + EQ OPENX + EQ ANSMARK OKJ JP B7+* + EQ UNITAX1 + EQ OKX + EQ ANSMARK STORENJ JP B7+* + EQ UNITAX1 + EQ STORENX + EQ ANSMARK EXACTVJ JP B7+* + EQ UNITAX1 + EQ EXACTVX + EQ ANSMARK BUMPJ JP B7+* + EQ UNITAX1 + EQ BUMPX + EQ ANSMARK ORJ JP B7+*-1 EQ DECANSCT DECREMENT ANSCNT IF STILL IN JUDGE-C * THE FOLLOWING IS TO MAKE SURE THE COMMAND WHICH * FOLLOWS THE -OR- IS A JUDGING COMMAND. SA1 A5-1 GET NEXT COMMAND WORD MX0 60-XCMNDL BX1 -X0*X1 COMMAND BITS SA2 X1+JTABLE MX0 5 BX2 X0*X2 MASK OFF CONTINGENCY BITS LX2 5 SX2 X2-16B CHECK IF JUDGING COMMAND NZ X2,PROCESS IGNORE THIS COMMAND IF NOT SA5 A1 SKIP NEXT COMMAND EQ PROCESS * DECANSCT SA3 TANSCNT DECREMENT ANSWER COUNTER SX7 X3-1 SA7 A3 EQ PROCESS * EXCJ JP B7+* + EQ UNITAX1 + EQ EXACTCX + EQ ANSMARK PUTVJ JP B7+* + EQ UNITAX1 + EQ PUTVX + EQ ANSMARK XMATCH JP B7+* + EQ UNITAX1 + EQ XMATCHX + EQ ANSMARK XANS JP B7+* + EQ UNITAX1 + EQ XANSX + EQ ANSMARK * /--- BLOCK SECONDARY 00 000 78/08/14 00.47 ANSCX JP B7+* + EQ UNITAX1 + EQ ANSCXX + EQ ANSMARK XANSA JP B7+* + EQ UNITAX1 + EQ XANSAX + EQ ANSMARK * /--- BLOCK GET2 00 000 74/09/05 15.53 TITLE GENERAL TWO AND MULTI-VARIABLE PROCESSORS * GENERAL ROUTINE TO DECODE TWO VARIABLES WHOSE * GETVAR CODES ARE PACKED IN THE TOP 2*XCODEL BITS * OF THE COMMAND WORD. THE RESULTANT VALUES ARE * STORED IN *XDATA* AND *YDATA* ON EXIT. * ALSO THE FIRST ARG IS IN X1 AND X6, SECOND IN X7. * GET2 EQ * NGETVAR BX7 X1 SA7 XDATA SA5 A5 RETRIEVE COMMAND WORD LX5 XCODEL MOVE 2ND VARIABLE TO TOP NGETVAR BX7 X1 SA7 YDATA SA1 XDATA BX6 X1 RETURN VALUES IN X1-X6, X7 EQ GET2 * * * SUBROUTINE TO GET TWO FLOATING POINT VARIABLES * GET2F EQ * BX6 X5 SAVE X5 IN CASE IS XSTOR WD SA6 VARBUF+9 FGETVAR BX7 X1 SA7 XDATA SA1 VARBUF+9 RETRIEVE COMMAND WORD BX5 X1 POSITION FOR GETVAR LX5 XCODEL MOVE 2ND VARIABLE TO TOP FGETVAR BX7 X1 SA7 YDATA EQ GET2F * XDATA BSS 1 YDATA BSS 1 * * * GENERAL ROUTINE TO DECODE MORE THAN TWO VARIABLES. THE * FIRST TWO VARIABLE CODES ARE ASSUMED PACKED IN THE TOP * 2*XCODEL BITS OF THE COMMAND WORD. THE REMAINING BITS OF * THE COMMAND WORD NOT USED BY THE COMMAND NUMBER ARE ASSUMED * TO POINT TO THE STARTING EXTRA STORAGE ADDRESS WHERE THE * REMAINING VARIABLE CODES ARE STORED. * * ENTER WITH X6 = NUMBER OF VARIABLES TO BE DECODED. ON EXIT * THE VECTOR *VARBUF* WILL CONTAIN THE ROUNDED INTEGER VALUES. * GETN EQ * RJ GETCODX GETVAR CODES IN VARBUF SX6 VARBUF SA6 VARADD INITIALIZE CURRENT VARIABLE ADDRESS SA1 X6 BX5 X1 GETN2 NGETVAR ROUNDS TO INTEGER IN X1 SA2 VARADD X2 = CURRENT *VARBUF* ADDRESS BX7 X1 SA7 X2 REPLACE VARIABLE CODE WITH VALUE SA1 VARCNT SX6 X1-1 DECREMENT COUNT OF VARIABLES TO BE DECODED ZR X6,GETN --- EXIT IF ALL VARIABLES DECODED SA6 A1 SX7 X2+1 INCREMENT *VARBUF* ADDRESS SA7 A2 SA1 X7 X1 = NEXT VARIABLE CODE WORD BX5 X1 EQ GETN2 * * * * /--- BLOCK GETCODX 00 000 80/02/07 02.32 GETCODX EQ * SA6 VARCNT SAVE VARIABLE COUNT SB1 1 B1 = 1 SB3 X6 B3 = COUNT BX7 X5 SA7 VARBUF STORE WITH 1ST VARIABLE CODE LEFT-JUSTIFIED LX7 XCODEL SA7 VARBUF+1 STORE WITH 2ND VARIABLE CODE LEFT-JUSTIFIED LX7 60-XCMNDL-XCODEL MX0 2*XCODEL+XCMNDL BX7 -X0*X7 X7 = EXTRA STORAGE POINTER SA1 B5+X7 X1 = 1ST WORD OF EXTRA STORAGE SB2 B1+B1 B2 = CURRENT STORAGE INDEX (2) GETCOD1 BX6 X1 SA6 VARBUF+B2 SB2 B2+B1 LX6 XCODEL SA6 VARBUF+B2 SB2 B2+B1 LX6 XCODEL SA6 VARBUF+B2 SB2 B2+B1 SA1 A1+B1 X1 = NEXT EXTRA STORAGE WORD LT B2,B3,GETCOD1 CONTINUE IF ANOTHER WORD REQUIRED EQ GETCODX * VARCNT BSS 1 NUMBER OF VARIABLES TO DECODE VARADD BSS 1 CURRENT *VARBUF* ADDRESS BEING PROCESSED * /--- BLOCK CHKSET/DEF 00 000 80/03/11 23.54 TITLE CHKSET -- SET RECORD CHECKPOINTING STATUS * * * CHKSET * * * * IF CHECKPOINTING IS ALLOWED, SET BIT IN *TRECBIT* * * THAT WILL PERMIT LESSON *CHECKPT* TO RETURN THE * * SIGNON RECORD TO DISK * ENTRY CHKSET EXT TCHECK IN FILE GETVAR CHKSET EQ * CALL TCHECK (X1) = -1 IF CHECKPOINTING OK SA2 TRECBIT (X2) = VARIOUS FLAGS MX0 1 LX0 60-CKPTSHF POSITION CHECKPOINTING BIT PL X1,CHKOFF --- IF CHECKPOINTING OFF BX6 X2+X0 TURN CHECKPOINTING ON SA6 A2 EQ CHKSET CHKOFF BX6 -X0*X2 TURN CHECKPOINTING OFF SA6 A2 EQ CHKSET TITLE CHKDEF -- REVERT TO DEFAULT CHECKPT STATUS * * * CHKDEF * * * * UPON EXIT FROM A NON-SYSTEM LESSON, REVERT TO * * THE DEFAULT CHECKPOINTING STATUS AS SPECIFIED * * BY THE ROUTER LESSON (OR BY LESSON *PLATO* IF * * THE USER IS UNROUTED); INSTRUCTORS ALWAYS REVERT * * TO THE DEFAULT CHECKPOINGINT STATUS * ENTRY CHKDEF CHKDEF EQ * SA1 TTYPE (X1) = USER TYPE SA2 TYPETAB+UT.INST BX1 X1-X2 CHECK IF INSTRUCTOR ZR X1,CHKDEF1 --- IF INSTRUCTOR SA1 LESSCM+LSTOUSE NG X1,CHKDEF --- DO NOTHING IF SYSTEM LESSON CHKDEF1 SA1 TRECBIT (X1) = VARIOUS FLAGS BX6 X1 SAVE COPY IN X6 LX1 DCHKSHF SHIFT CHECKPT DEFAULT TO SIGN MX0 1 BX1 X0*X1 (X1) = CHECKPT DEFAULT LX0 60-CCHKSHF SHIFT TO CURRENT CHECKPT STATUS BX6 -X0*X6 CLEAR CURRENT CHECKPT STATUS LX1 60-CCHKSHF BX6 X1+X6 AND RESET TO CHECKPT DEFAULT SA6 A1 CALL CHKSET SET OVERALL CHECKPT STATUS EQ CHKDEF * /--- BLOCK -WHERE- 00 000 80/02/07 02.34 * TITLE WHERE, WHERE(F) * -WHERE- (CODE=0) * * SINGLE VARIABLE (ROW-COLUMN POSITION) WHERE. * WHEREX NG X5,WHRCON JUMP IF PRE-CONVERTED NGETVAR ROUNDS TO INTEGER IN X1 RJ RCTOXY GET INTO FINE GRID WHRXX MX0 -18 LIMIT NX AND NY TO 18 BITS BX6 -X0*X6 BX7 -X0*X7 SA6 NX UPDATE WHEREX SA7 NY AND WHEREY MX0 -9 POSITION ON SCREEN BX6 -X0*X6 BX7 -X0*X7 SA6 TBMARG SET X-MARGIN LX6 9 SHIFT X UP 9 BITS BX1 X6+X7 COMBINE WITH Y BX4 X1 LX4 7+3 POSITION X/Y MARGIN FOR SIZE MX0 -18 LX0 7+3 POSITION MASK SA2 TBWRITE BX2 X0*X2 CLEAR OUT OLD X/Y MARGIN BX6 X2+X4 SA6 A2 SET NEW X/Y MARGIN OUTCODE WFMCODE FINE WHERE THAT SETS MARGINS EQ PROC * WHRCON LX5 10 POSITION X COORDINATE MX0 -9 BX6 -X0*X5 LX5 9 POSITION Y COORDINATE BX7 -X0*X5 EQ WHRXX * * * -WHERE(F)- (CODE=1) * * TWO VARIABLE (FINE GRID) WHERE. * WHEREFX RJ GET2 GET VALUES OF 2 VARIABLES EQ WHRXX * * * /--- BLOCK ATNM/UNIT 00 000 76/07/04 21.27 * * -ATNM- = -AT- WHICH USES OLD MARGINS * ATNMX NG X5,ATNM2 JUMP IF PRE-CONVERTED NGETVAR ROUNDS TO INTEGER IN X1 RJ RCTOXY GET INTO FINE GRID ATNM1 MX0 -18 BX6 -X0*X6 LIMIT X AND Y TO 18 BITS BX7 -X0*X7 SA6 NX STORE NX SA7 NY STORE NY MX0 -9 BX6 -X0*X6 BX7 -X0*X7 SCREEN SETTING CAN ONLY HAVE 9 LX6 9 SHIFT X UP 9 BITS BX1 X6+X7 COMBINE WITH Y OUTCODE WFCODE FINE WHERE DOES NOT SET MARGIN EQ PROC * ATNM2 LX5 10 POSITION X COORDINATE MX0 -9 BX6 -X0*X5 LX5 9 POSITION Y COORDINATE BX7 -X0*X5 EQ ATNM1 * * * -ATNM(F)- * * TWO VARIABLE (FINE GRID) AT--USES OLD MARGIN * ATNMFX RJ GET2 GET VALUES OF 2 VARIABLES EQ ATNM1 * * /--- BLOCK UNIT 00 000 79/05/16 16.00 * TITLE UNIT * -UNIT- (CODE=3) * * ARROW CONTINGENCY * ENTRY UNITAX1 * UNITAX1 SA2 TBITS CHECK TYPE OF ARROW SA1 TIARROW FOR NORMAL ARROW LX2 ARRTPBT SET IF ARROWA PL X2,UNITAXX IF ARROW SA1 TIARROWA UNITAXX ZR X1,UNITAX2 IF NO -IARROW/A- UNIT LX1 60-12 SET UP UNIT NUMBER FOR -JOIN- BX7 X1 SAVE UNIT NUMBER MX0 1 SET UP MASK FOR -IARROW- BIT LX0 -IARRBIT SA1 TBITS WORD CONTAINING -IARROW- BIT BX6 X0*X1 NZ X6,UNITAX2 JUMP IF UNIT ALREADY EXECUTED BX6 X0+X1 SA6 A1 SET BIT TO MARK UNIT EXECUTED SA5 A5+1 BACK UP FOR RETURN FROM JOIN BX5 X7 UNIT IN X5 EQ JOINX UNITAX2 SA1 TBARROW MX0 -18 MASK OFF X/Y COORDS BX1 -X0*X1 GET X/Y COORDINATES OUTCODE WFMCODE RESET -AT- FOR ARROW SA1 LIMIT GET -LONG- FOR ARROW CALL CLIENT,4500B,X1 SEND -ARROW- EXT + LONG SA1 TBARROW PL X1,UNITAX3 IF ARROW ALREADY PLOTTED, SKIP MX0 1 SET UP FOR NEGATIVE MASK BX6 -X0*X1 CLEAR PLOT BIT SA6 A1 SAVE IT OUTARR PLOT ARROW * START INPUT AT ARROW BY GOING INTO *JUDGEC* STATE UNITAX3 SB7 XJUDGEC ENTER JUDGE-C EQ EXIT * * SEARCH CONTINGENCY * UNITSX1 SB7 XALLOKC SET TO ALL-OK-CONTINGENCY SA1 TLVLESS ZR X1,EXIT IF NO LVARS, EXIT * SA5 A5+1 BACK UP A COMMAND EQ ENDARRX * /--- BLOCK UNIT 00 000 80/03/27 17.23 * * 'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL * INTERACTION PROBLEM * * ON-PAGE HELP * ENTRY UNITXH UNITXH SA1 JOIN GET CURRENT JOIN DEPTH NZ X1,UNJOIN BACK OUT ONE JOIN LEVEL JP B7+*+1 * + EQ UXH10 UNIT-C + EQ UNITAX1 ARROW-C + EQ ANSEND JUDGE-C + EQ ANSMARK ANSWER-C + EQ UXH10 SEARCH-C * * UXH10 SB1 JOINLTH LENGTH OF JOIN STACK UHJ SA1 B1+HJOIN LOAD SAVED JOIN STACK ENTRY BX6 X1 SA6 B1+JOIN RESTORE JOIN STACK SB1 B1-1 PL B1,UHJ END TEST SX6 X6 X6 = JOIN STACK POINTER ONLY SA6 A6 AX1 18 X1 = LVAR STACK POINTER SA2 TLVLESS RESTORE LVAR STACK POINTER AX2 18 LX2 18 BX6 X1+X2 SA6 A2 * SA4 THELPF LOAD ON-PAGE-HELP FLAG MX6 0 SA6 A4 CLEAR FLAG BX6 X4 MX0 -6 SA6 ILOC SAVE ON-PAGE-HELP FLAG BX1 -X0*X4 MASK OFF OLD CONTINGENCY SB7 X1 BX1 X4 GET ARROW ENCOUNTERED FLAG LX1 2 PL X1,UH150 JUMP IF NO ARROW ENCOUNTERED SB1 B7-XUNITC CHECK IF WERE IN UNIT-C ZR B1,UH100 SB1 B7-XNEXTLK OR NEXTNOW-C ZR B1,UH100 * SA2 JOIN LOAD CURRENT JOIN LEVEL ZR X2,UNERR1 SUPPOSED TO BE A JOIN STACK SX7 X2-1 BACK-UP ONE JOIN LEVEL SA7 A2 UH60 MX0 -12 SA1 X7+JOINL JOIN STACK ENTRY OF ARROW BX4 X0*X1 MASK ALL BUT COMMAND BIAS BX1 -X0*X1 SX1 X1-1 BACK-UP COMMAND PTR BY ONE NG X1,UNERR2 SHOULD BE A COMND FOLLOWING * EXECERR USES X1 BX4 X4+X1 RE-ATTACH COMMAND BIAS SB7 XUNITC RE-SET TO UNIT-C EQ UNJOIN1 GO TO RE-EXECUTE ARROW COMMAND * * /--- BLOCK UNIT 00 000 79/05/05 22.48 * * 'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL * INTERACTION PROBLEM * * UH100 SA1 TBARROW CHECK IF ANY ARROW TO ERASE ZR X1,UH150 MX6 0 CLEAR OUT ARROW FLAG SA6 A1 SA3 INHIBS CHECK FOR -INHIBIT ARRPLT- LX3 ARRSHIF NG X3,UH150 OUTCODE WFCODE OUTPUT WHERE OUTARR E ERASE ARROW * UH150 SB1 B7-XNEXTLK IF IN NEXTNOW-C, ZR B1,UH170 GO BACK TO ORIGINAL COMMAND SA1 ILOC LX1 1 POSITION -PAUSE- BIT PL X1,UH200 JUMP IF HELPOP NOT FROM PAUSE SB1 B7-XUNITC ZR B1,UH170 JUMP IF WERE IN UNIT-C MX6 0 SA6 JOIN CLEAR JOIN STACK POINTER SB1 B7-XANSC ANSWER-C ZR B1,JEXITX SB1 B7-XARROWC ARROW-C ZR B1,UNITAX1 EQ WRONGC ALL ELSE ARE ERRORS * * UH170 SX7 JOINLTH-1 SET TO LAST WORD OF JOIN STACK EQ UH60 GO TO RE-EXECUTE THE ORIGINAL PAUSE COMMAND * * UH200 JP B7+*+1 * + EQ UH300 UNIT-C + EQ WRONGC ARROW-C + EQ JEXITX JUDGE-C + EQ UH300 ANSWER-C + EQ WRONGC SEARCH-C + EQ WRONGC *** UNUSED *** + EQ WRONGC NEXT-NOW-C (SHOULDNT GET HERE) + EQ UH300 ALL-OK-C + EQ WRONGC *** UNUSED *** + EQ WRONGC INITIAL-ENTRY-C * * UH300 MX6 0 SA6 JOIN CLEAR JOIN STACK POINTER EQ EXIT * WRONGC SX1 B7 EXECERR 907 *WRONG CONTINGENCY* * UNERR1 EXECERR 916 NO JOIN STACK * * EXECERR USES X1 UNERR2 EXECERR 917 BAD COMND POINTER AFTER UNJOIN * /--- BLOCK WRITE 00 000 75/12/09 15.04 TITLE WRITE AND CALC * * * TUTOR WRITE ROUTINE * B1 = ADDRESS OF WRITE INFO * B2 = ADDRESS OF CHARACTER COUNT * ENTRY TUTWRT TUTWRTT RJ WRSOUT OUTPUT WRITING NORMAL SIZE TUTWRT EQ * SA1 RSIZE ZR X1,TUTWRTT IF SIZE 0 MX6 -7-3 SA2 TBWRITE CLEAR SIZE WRITE INFO BX6 X6*X2 SA6 A2 RJ LINWRT EQ TUTWRT * * * -CALC- (CODE=4) * CALC AX5 60-XCODEL PERFORM THE CALC SB1 X5+B5 SB3 PROCESS JP B1 GO DO CALC * * * /--- BLOCK CUNIT 00 000 73/00/00 00.00 TITLE -CUNIT- * * * -CUNIT- * GENERAL ROUTINE TO LOCATE UNIT FOR CONDITIONAL COMMANDS. * ON EXIT B1 = VALUE OF CONDITION INDEX * ENTRY CUNIT CUNIT EQ * NGETVAR ROUNDS TO INTEGER IN X1 PL X1,CUNIT1 IF NEGATIVE, MAKE -1 ZR X1,CUNIT1 PREVENT -0 FROM TAKING NEGATIVE BRANCH SX1 -1 CUNIT1 SX0 1 IX1 X1+X0 MAKE SO GOES FROM 0 TO N-1 SA5 A5 RELOAD COMMAND WORD RJ CUNIT1A EQ CUNIT * ENTRY CUNIT1A CUNIT1A EQ * ENTRY WITH X1 = NORMALIZED COND * AND A/X5 = COMMAND WORD MX0 48 SET FOR 12 BIT MASK AX5 XCMNDL BX2 -X0*X5 X2 = NUMBER OF ENTRIES IN TABLE AX5 12 BX3 -X0*X5 X3 = RELATIVE START OF TABLE SB2 B5+X3 B2 = ABSOLUTE START OF TABLE MX0 58 MASK TO EXTRACT 2 BITS OF INFO IX3 X1-X2 SEE IF NUMBER IN BOUNDS NG X3,CUNIT2 JUMP IF OK SX1 X2-1 ELSE SET FOR LAST ENTRY CUNIT2 BX2 -X0*X1 X2 = INTRA-WORD POSITION SB1 X1-1 B1 = -1 TO N-2 BX3 X2 LX2 4 *16 IX3 X2-X3 *15 SB3 X3 B3 = SHIFT COUNT AX1 2 GET WORD BIAS (4-15 BIT PACKS/WORD) SA3 X1+B2 X3 = PACKED WORD LX5 X3,B3 POSITION CORRECT 15 BIT PACKAGE AT TOP LX5 3 ONLY 12 BITS OF UNIT INFO PL X5,CUNIT1A EXIT IF NORMAL UNIT * MX0 12 BX3 X0*X5 MASK OFF UNIT NUMBER LX3 12 SX0 X3-UNXNUM ZR X0,PROCESS JUMP IF SPECIAL UNIT -X- SX0 X3-UNQNUM NZ X0,CUNIT1A EXIT IF NOT UNIT -Q- * MX5 0 CLEAR UNIT NUMBER EQ CUNIT1A * * * /--- BLOCK JLPACK 00 000 76/05/14 03.08 TITLE JLPACK * * PACK UP JOIN LIST INFO INTO X6 * ENTRY JLPACK * JLPACK EQ * SA4 ILESUN LESSON AND UNIT NUMBERS LX4 12 SB1 A5 SX3 B5-B1 COMMAND BIAS BX6 X3+X4 COMBINE PL X6,JLPACK --- RETURN IF ALL OK SA1 333333B /// ELSE BOMB OFF /// * /--- BLOCK UNJOIN 00 000 80/08/09 02.18 TITLE UNJOIN * * * BACK OUT OF ONE JOIN * ENTRY UNJOIN * UNJOIN SA1 JOIN GET JOIN COUNT SX6 X1-1 SUBTRACT ONE SA6 A1 AND PUT BACK SA4 JOINL+X6 GET LIST WORD * * * UNJOIN USING CONTENTS OF X4 * ENTRY UNJOIN1 * UNJOIN1 MX0 48 BX3 -X0*X4 PICK OFF COMMAND BIAS SB3 X3 FOR UNITGOB LX4 12 SHIFT OFF CONDITIONAL INDEX AX4 24 AND COMMAND BIAS BX6 X4 SA6 ILESUN CURRENT LESSON POINTER * * SET LOCAL VAR POP FLAG IN STUDENT BANK * SA4 TLVLESS LOCAL VAR LESSON + SP ZR X4,UNITGOB IF NO LOCALS * MX0 1 SIGN BIT = POP FLAG BX6 X0+X4 ADD FLAG TO WORD SA6 A4 STORE IN STUDENT BANK EQ UNITGOB GO EXECUTE TUTOR UNIT WITH B3 SET * ENTRY UNJXX UNJXX BSS 1 * /--- BLOCK STORE 00 000 80/04/22 00.59 TITLE STORE (AND STOREU) * -STORE- (CODE=10) AND -STOREU- * USTORE BSS 1 SAVE SECOND ARG OF STOREU * STORE SA1 XSLCLOK SAVE TIME ON ENTRY BX6 X1 SA6 STORTIM BX7 X5 LX7 XCODEL SECOND ARG AT TOP MX6 XCODEL BX7 X6*X7 SAVE SECOND ARG SA7 USTORE SA1 JJSTORE CHECK WHETHER STUDENT ANS ALREADY COMPILED PL X1,STREADY JUMP IF ALREADY COMPILED SX1 X1+1 JJSTORE=-1 IF NOT COMPILED ZR X1,STORE1 * JJSTORE = -2 MEANS STUDENT ANS WILL NOT COMPILE. * FORMOK CONTAINS WHATEVER WAS LEFT IN IT FROM LAST * COMPILATION ATTEMPT. STORNO SB7 XANSC PUT INTO ANSWER CONTINGENCY SX7 1 SA7 TJUDGED SET JUDGMENT=NO (UNIVERSAL) MX7 0 SET ANSCNT=0 SA7 TANSCNT EQ PROCESS STORE1 SX7 JUDGE INITIALIZE STRING ADDRESS SA7 WORDPT MX7 0 ZERO INX TO BEGIN EXTRA STORAGE IN INFO SA7 INX * EXT GETNDFU * RJ GETNDFU GET NDEFU INITIALIZED SA1 NDEFU SX7 -2 NO UNIT DIMENSIONS ZR X1,STORE1B JUMP IF NO UNITS SX7 -1 KEEP TRACK OF UNIT DIMENSIONS STORE1B SA7 NUNITS CALL QUIKCMP GENERATE MACHINE CODE IN INFO * GETVAR CODE RETURNED IN X1 * WILL EXIT THROUGH -CALCERR- IF COMPILATION ERROR * LEX CALLS POSTOR TO RESTORE PRESENT UNIT IF STUDENT * DEFINE SET WAS BROUGHT INTO CM BX7 X1 SAVE GETVAR CODE FOR POSSIBLE RE-USE SA7 JJSTORE SA5 A5 RESTORE X5 * /--- BLOCK STORE 00 000 80/04/22 00.58 STREADY SA2 USTORE CHECK FOR -STOREU- COMMAND ZR X2,STREDY2 BX5 X2 FGETVAR SET A1 TO STOREU ARRAY SA0 UADS SA2 ATEMPEC BX0 X2 SA2 NDEFU LENGTH OF UNITS ARRAY SB3 X2 + WE B3 RJ ECSPRTY SA0 A1 SX1 B3 LENGTH TO CHECK RJ BOUNDS USES B1 AND B2 + RE B3 RJ ECSPRTY SA5 A5 RESTORE X5 STREDY2 SA1 JJSTORE LX5 XFBIT I/F BIT OF -GETVAR- CODE TO TOP BX2 X5 PRESERVE IN X2 FOR LATER TEST LX1 60-XCODEL LEFT-ADJUST -GETVAR- CODE BX5 X1 MOVE TO REQUIRED X5 SB1 A5 SX7 B5-B1 SAVE COMMAND BIAS SA7 OLDB5 MX7 59 FORM -1 SA7 TFORMOK SET OK--WILL BE SET ZERO IF EXEC ERROR SB5 INFO SET UP B5 FOR EXTRA STORAGE IN INFO NG X2,FLTSTOR JUMP IF FLOATING POINT NGETVAR ROUND TO INTEGER BX7 X1 SA7 STORVAL SAVE RESULT RJ POSTOR2 SA1 STORVAL BX6 X1 NPUTVAR STORE EQ STOTIME * FLTSTOR FGETVAR EVALUATE STUDENT EXPRESSION BX7 X1 VALUE RETURNED IN X1 SA7 STORVAL SAVE VALUE RJ POSTOR2 SA1 STORVAL BX6 X1 FPUTVAR STORE STOTIME SA1 XSLCLOK SEE IF TOO MUCH PROCESSING GOING ON SA2 STORTIM IX2 X1-X2 COMPUTE TIME REQ TO COMPILE SX7 30 MAXIMUM ELAPSED TIME PX7 X7 FLOAT IT NX7 X7 SA1 CPSPD SCALE BY CPU-SPEED FACTOR FX1 X7/X1 UX1,B1 X1 LX1 B1 IX2 X2-X1 NG X2,PROCESS IF LESS THAN 30 MILLISECONDS SX7 16 SA7 TFORMOK TIME-SLICE ERROR, LONG COMPILE EQ STORNO * STORTIM BSS 1 * * * /--- BLOCK POSTOR 00 000 77/07/20 12.31 * * -POSTOR- * USED TO RESTORE A5 - B5 AFTER COMPILATION * ENTRY POSTOR * POSTOR EQ * SA5 ILESUN LOAD LESSON/UNIT NUMBERS CALL GETUNIT SA1 OLDB5 LOAD COMMAND BIAS MX6 59 -1 SA6 A1 SB1 X1 SA5 B5-B1 RELOAD COMMAND WORD EQ POSTOR * POSTOR2 EQ * RESTORE X5/B5'; UNIT ALREADY IN SA1 OLDB5 LOAD COMMAND BIAS MX6 59 -1 SA6 A1 SA5 A5 RESTORE X5 SB5 X1 SB5 A5+B5 EQ POSTOR2 * * * EXECSAV BSS 1 * * ENTRY CSPREAD ALSO USED BY -COMPUTE- * CSPREAD EQ * STRING STARTS AT A0, CHAR COUNT IN X1 *CHECK STRING BOUNDS AND SPREAD PACKED CHARS INTO SHOWOUT SX2 CSPWDS+1 ALLOW 100 CHARS IX2 X1-X2 CHECK FOR POSSIBLE SHOW BUFFER OVERFLOW PL X2,CSERXMX 101 SPREAD CHARS IS TOO MUCH * EXECERR USES X1 RJ WORDS CHECK STORE BOUNDS SB3 X1 END CHECK SB1 1 SA1 A0-B1 INITIALIZE READING REGISTER SA7 SHOWOUT-1 INITIALIZE WRITING REGISTER MX0 54 MASK FOR CHAR STORA0 SB2 10 CHARS PER WORD SA1 A1+B1 GET NEXT WORD STORA1 LX1 6 RIGHT-ADJUST NEXT CHAR BX7 -X0*X1 PICK OUT CHAR SA7 A7+B1 ADD CHAR TO BUFFER SB3 B3-B1 COUNT CHARACTERS ZR B3,STORA2 SB2 B2-B1 COUNT CHARS PER WORD NZ B2,STORA1 EQ STORA0 GET NEXT WORD STORA2 MX7 0 TERMINATE WITH 0 CHAR----END OF LINE SA7 A7+B1 SX7 SHOWOUT INITIALIZE WORDPT SA7 WORDPT EQ CSPREAD * CSERXMX SX2 CSPWDS MAXIMUM LIMIT EQ ERXMXLC MAXIMUM CHAR LIMIT EXCEEDED * STORVAL BSS 1 STUDENT RESULT TO STORE CSPWDS EQU 100 NUMBER OF CHARS MAX * * * /--- BLOCK ARROW 00 000 76/07/24 21.53 TITLE ARROW AND ARROW(F) * -ARROW- (CODE=11) * * SINGLE VARIABLE (ROW-COLUMN POSITION) ARROW. * SETS STARTING SCREEN POSITION FOR ENTRY OF * STUDENT ANSWER AND INITIALIZES ANSWER STORAGE * POINTERS. * * * ARROWX SA1 THELPF CHECK IF IN ON-PAGE HELP STATE ZR X1,AWX1 RJ ARROWUH AWX1 NGETVAR ROUNDS TO INTEGER IN X1 RJ RCTOXY GET INTO X AND Y ARROWXX MX0 -9 FORCE LEGAL SCREEN POSITION BX6 -X0*X6 BX7 -X0*X7 LX6 9 BX7 X6+X7 PACK UP THIS X AND Y OUTCODE WFCODE OUTPUT WHERE MX2 1 SET TOP BIT -- NOT PLOTTED BX7 X7+X2 SA1 TBARROW SEE IF ANY PRIOR ARROW TO ERASE SA7 A1 SET FINE GRID ARROW POSITION ZR X1,ARR25 IF ZERO, THIS IS FIRST ARROW SA3 INHIBS READ THE INHIBIT FLAG WORD LX3 ARRSHIF SHIFT IT TO THE SIGN BIT NG X3,ARR25 DONT BOTHER IF NO ARROW PLOTTED OUTCODE WFCODE OUTPUT WHERE OUTARR E ERASE ARROW * /--- BLOCK ARROW 00 000 80/08/04 22.56 * ARR25 SA5 A5 GET COMMAND MX2 -XCMNDL BX2 -X2*X5 MX1 60 SET TO ARROWA SX2 X2-ARROWA= ZR X2,ARR26 IF ARROWA SX2 X2-1 ZR X2,ARR26 IF ARROWA FINE GIRD MX1 0 FOR NORMAL ARROW ARR26 SA2 TBITS BIT IN TBITS MX6 1 LX6 -ARRTPBT SET TYPE OF ARROW BIT(1=ARROWA) BX1 X1*X6 PICK BIT BX2 -X6*X2 CLEAR BIT BX6 X1+X2 SA6 A2 SB7 XARROWC SET TO ARROW-C SA1 TBITS MX6 1 LX6 -JUDGBIT BX6 -X6*X1 JUDGING BIT = 0 FOR ARROW SA6 A1 SA1 RSIZE SAVE SIZE SA2 ROTATE AND ROTATE BX6 X1 BX7 X2 SA6 TBSIZE SA7 TBROTATE SA3 TBEDIT CLEAR ANY EDIT FEATURE MX6 36+1 LX6 36 BX6 -X6*X3 SA6 A3 NZ X6,ARROWED JUMP IF EDIT BUFFER ALREADY SET SX6 ANSINF+ANSLIM/2 MIDDLE OF ANS BUFFER LX6 36 SA6 A3 INITIALIZE TBEDIT ARROWED MX6 0 CLEAR COPY OPTION MX0 2 SA6 TBCOPY SA6 TJKEYS CLEAR JKEY SPECIFICATIONS SA6 TWCOUNT CLEAR WORD COUNT SA6 TBLDATA+1 CLEAR DATA FLAGS SA3 TBMICRO CLEAR MICRO SWITCHES BX6 -X0*X3 SA6 A3 * /--- BLOCK ARROWEXT 00 000 78/12/18 21.20 * * CLRFBIT ENABLT TOUCH * * SAVE JOIN STRUCTURE AT ARROW * RJ JLPACK PACK UP JOIN INFO IN X6 SB1 1 B1 = CONSTANT 1 SA1 JOIN SX0 X1-JOINLTH CHECK IF TOO DEEP IN JOINS PL X0,ERXJOIN --- ERROR EXIT SA6 AJOIN+1+X1 STORE AWAY THIS JOIN (THE ARROW) SB2 X1 B2 = CURRENT JOIN DEPTH SX6 X1+B1 INCREMENT JOIN COUNT BY 1 SA6 AJOIN AND STORE AWAY THE NEW JOIN COUNT ZR B2,AJDN DONE IF NO OTHER JOINS AJSAVE SA1 A1+B1 BRING UP NEXT JOIN WORD BX6 X1 SA6 A6+B1 STORE IN ARROW JOIN WORD SB2 B2-B1 NZ B2,AJSAVE EQ AJDN * SX7 X1+B1 ADD ONE TO JOIN COUNTER SA7 A1 STORE NEW COUNT SA7 AJOIN SET ARROW JOIN MARKER SA6 JOIN+X7 SAVE THE JOIN INFO FOR ARROW * AJDN SA1 TLVLESS SEE IF LOCAL VAR LESSON ZR X1,AJDN5 IF NO LOCAL VARS * SX6 X1 SAVE LOCAL VARIABLE SP SA2 LVUCNT X2 = LVARS IN ARROW UNIT IX6 X6+X2 SA1 AJOIN WITH ARROW JOIN SP LX6 18 BX6 X6+X1 SA6 A1 MX6 0 PSEUDO MAIN UNIT SA6 JOIN AJDN5 SX6 MAXLONG/2 HALF MAX LONG TO ALLOW EDIT SA6 LIMIT SX6 ANSINF SET TO POINT TO ANSWER BUFFER SA6 TBINPUT SX6 0 SA6 LONG SET INPUT TO ZERO SA6 TBANSWT MARK NO ANS-C WRITING SA6 THELPWT MARK NO ON-PAGE-HELP WRITING SX7 2 SA7 TJUDGED SET JUDGMENT=UNJUDGED * ZERO ANSINF,ANSLIM ZERO ANSWER BUFFER CALL AREAINC,0,0 **** DATA **** SA1 THELPF NZ X1,ARR40 JUMP IF IN ON-PAGE-HELP MX6 18 SA2 TBNARGS CLEAR OUT -PHELP- COUNTER BX6 -X6*X2 SA6 A2 * /--- BLOCK ARROW 00 000 77/03/19 20.35 * ARR40 SA2 CLRBITS CLEAR VARIOUS BITS IN TBITS SA1 TBITS BX6 -X2*X1 SA6 A1 SA1 TBARROW ALL NORMAL ARROWS ARE PLOTTED SA2 TBWRITE MX3 -18 BX6 X3*X2 CLEAR OLD MARGIN BX6 X1+X6 SET NEW MARGIN SA6 A2 OUTP WFCODE HERE. SYSTEM ARROWS USE ARRPLT SA1 TBARROW GET ARROW COORDINATES MX3 -9 BX7 -X3*X1 PICK NY AX1 9 BX6 -X3*X1 PICK NX SA6 TBMARG SET MARGIN NG X2,ARR42 SX6 X6+10B IF PLOTTING ARROW BX6 -X3*X6 ARR42 SA6 NX UPDATE NX, NY SA7 NY SA2 INHIBS LX2 ARRSHIF CHECK INHIBIT ARROW BIT PL X2,PROCESS IF ARROW NOT INHIBITED * CLEAR ARROW PLOT BECAUSE OF -INHIBIT ARROW- SA1 TBARROW GET -ARROW- INFO MX0 1 SET UP FOR NEGATIVE MASK BX7 -X0*X1 CLEAR ',PLOT', FLAG SA7 A1 SAVE IT EQ PROCESS CONTINUE * BITS TO CLEAR IARROW, IARROWA, AND QUIT IN TBITS * -CLRBITS- TELLS WHICH OF THE BITS OF -TBITS- * ARE TO BE CLEARED AT EACH NEW ARROW. CLRBITS BSS 0 POS 60-IARRBIT VFD 1/1 SET IARRBIT POS 60-QUITBIT VFD 1/1 SET QUIT BIT * POS 60-MTABBIT * VFD 1/1 CLEAR MICRO-TAB BIT POS 0 BSS 0 FORCE WORD OUT * /--- BLOCK ARROWFX 00 000 78/02/14 11.07 * * * -ARROW(F)- (CODE=12) * * TWO VARIABLE (FINE GRID) ARROW. * * ARROWFX SA1 THELPF CHECK IF IN ON-PAGE HELP STATE ZR X1,AWX2 RJ ARROWUH AWX2 RJ GET2 GET X AND Y EQ ARROWXX * * * ARROWUH EQ * BX2 X1 CHECK IF ALREADY ANOTHER ARROW LX2 2 NG X2,ARROWUH EXIT IF WAS ANOTHER MX6 1 LX6 58 POSITION ARROW ENCOUNTERED BIT BX6 X1+X6 SA6 A1 MARK ARROW ENCOUNTERED MX6 0 SA6 TBANSWT MARK NO ANS-C WRITING SA6 THELPWT MARK NO ON-PAGE-HELP WRITING SA1 TBARROW ZR X1,ARROWUH SA1 NX SAVE CURRENT X/Y POSITION LX1 18 SA2 NY BX6 X1+X2 SA6 TBINTSV+5 CALL OFFIT ERASE ANSWER MARK-UP SA5 A5 SA1 RSIZE SEE IF LARGE SIZE CHARACTERS NZ X1,AWUH100 CALL WIPE CALL OFFOKNO ERASE OK OR NO EQ AWUH200 * AWUH100 SA2 ARROWUH BX6 X2 SAVE RETURN ADDRESS * TBINTSV+0 - TBINTSV+3 ARE RESERVED FOR -LWIPE- SA6 TBINTSV+4 CALL LWIPE SA1 TBINTSV+4 RESTORE RETURN ADDRESS BX6 X1 SA6 ARROWUH * AWUH200 SA1 TBINTSV+5 LOAD NX/NY MX0 -9 BX6 -X0*X1 RESTORE NY SA6 NY AX1 18 BX6 -X0*X1 SA6 NX RESTORE NX EQ ARROWUH * * ACHARA TITLE SET THE ARROW CHARACTER FOR -ARROWA- * * NAME OF COMMAND HAS BEEN CHANGED TO -ARHEADA- * * SET UP USER ARROW CHARACTER FOR ARROWA * * ACHARAX AX5 XCMNDL GET BIAS SA1 B5+X5 MX0 30 SA2 ARRCHRS UPPER 30 BITS FOR NORMAL ARROW * LX1 30 POSITION FIRST 5 CHARS LOWER BX6 X0*X2 PICK NORMAL ARROW BX1 -X0*X1 CLEAN UP USER ARROW BX6 X1+X6 SA6 A2 EQ PROCESS * /--- BLOCK JARROW 00 000 80/08/04 20.22 TITLE JARROW * * JARROW * * 'MARKER FOR INITIATING JUDGING WITHOUT AN * ARROW. * JARROWX CALL NOJBUF MAKE SURE DO NOT HAVE ECS JUDGE BUF * 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 JBANKS MAXIMUM POSSIBLE IX2 X2-X1 NG X2,JARR1 IF ONE LEFT SA1 JMAXCNT UP OVERFLOW COUNT SX6 1 IX6 X1+X6 SA6 A1 + WE 4 RJ ECSPRTY INTCLR X,I.JUDG EQ RETRNZ RE-DO COMMAND A LITTLE LATER * JARR1 BSS 0 INTCLR X,I.JUDG SX6 0 SA6 TBARROW CLEAR SCREEN POSITION FOR ARROW SA6 LONG GUARANTEE CHAR COUNT = 0 SA1 TBITS MX6 1 LX6 -JUDGBIT BX6 X1+X6 JUDGING BIT = 1 FOR JARROW SA6 A1 * * SAVE CURRENT SIZE AND ROTATE SO THAT THE RESTORE * THAT OCCURS AT VARIOUS EXITS IS OK. * SA1 RSIZE SA2 ROTATE BX6 X1 BX7 X2 SA6 TBSIZE SA7 TBROTATE * /--- BLOCK JARROW 00 000 80/08/04 20.22 * * SAVE CURRENT JOIN STRUCTURE (USE STACK FOR ARROW) * RJ JLPACK PACK UP JOIN INFO IN X6 SB1 1 B1 = CONSTANT 1 SA1 JOIN SX0 X1-JOINLTH CHECK IF TOO DEEP IN JOINS PL X0,ERXJOIN --- ERROR EXIT * SA6 AJOIN+1+X1 STORE AWAY INFO (THE JARROW) SB2 X1 B2 = CURRENT JOIN COUNT SX6 X1+B1 INCREMENT JOIN COUNT BY 1 SA6 AJOIN STORE THE NEW JOIN COUNT ZR B2,JAGO --- GO ON LIKE REJUDGE MX7 0 SA7 A1 CLEAR CURRENT JOIN COUNT JSAVE SA1 A1+B1 BX6 X1 SA6 A6+B1 SB2 B2-B1 NZ B2,JSAVE EQ JAGO --- GO ON LIKE REJUDGE * SX7 X1+B1 ADD ONE TO JOIN COUNTER SA7 A1 STORE NEW COUNT SA7 AJOIN SET JARROW JOIN MARKER SA6 JOIN+X7 SAVE THE JOIN INFO FOR JARROW JAGO SA1 TLVLESS SEE IF LOCAL VARS LESSON ZR X1,PJUDGOO --- GO ON LIKE REJUDGE * SX6 X1 SAVE LOCALS SP SA2 LVUCNT X2 = LVARS IN ARROW UNIT IX6 X6+X2 SA1 AJOIN WITH ARROW JOIN SP LX6 18 BX6 X6+X1 SA6 A1 MX6 0 PSEUDO MAIN UNIT SA6 JOIN EQ PJUDGOO --- GO ON LIKE REJUDGE * /--- BLOCK JARROW 00 000 77/08/19 00.52 * * /--- BLOCK ENDARROW 00 000 79/06/06 02.32 TITLE ENDARROW * ENDARROW (CODE=40) * * 'THE ONLY PROCESSING NEEDED HERE IS TO ERASE * THE PREVIOUS ARROW, IF ANY, AND CLEAR SOME * STATUS INFORMATION. * * ENDARRX BSS 0 * END ARROW EXECUTION. RJ EAE EQ PROCESS EXIT CIA SPACE 4,10 ** CIA - CHECK INHIBIT ARETURN. * * IF -INHIBIT ARETURN- BIT IS SET, END ARROW * EXECUTION AND CONTINUE. OTHERWISE, PROCESS * NORMALLY. * * ENTRY (X6) = NEXT EXECUTION ADDRESS IF INHIBIT * ARROW IS IN EFFECT. CIA BSS 0 ENTRY * CHECK FOR -INHIBIT ARROW-. SA1 INHIBS LX1 ARETSHF PL X1,ANSMARK IF NO -INHIBIT ARETURN-. * END ARROW EXECUTION AND CONTUNUE. SA6 CIAA SAVE RETURN ADDRESS RJ EAE END ARROW EXECUTION SA1 CIAA (X1) = NEXT ADDRESS SB1 X1 JP B1 CONTINUE CIAA BSS 1 RETURN ADDRESS EAE SPACE 4,10 ** EAE - END ARROW EXECUTION. * * ERASE THE PREVIOUS ARROW AND CLEAR STATUS INFO. EAE PS ENTRY / EXIT SB7 XUNITC SET TO UNIT-C CALL NOJBUF DROP JUDGE BUFFERS * ERASE THE ARROW IF NECESSARY. SA1 TBARROW ZR X1,EAE1 IF NO ARROW TO ERASE MX6 0 SA6 A1 SA3 INHIBS LX3 ARRSHIF NG X3,EAE1 IF NO ARROW TO ERASE OUTCODE WFCODE OUTARR E ERASE ARROW * CLEAR STATUS INFORMATION. EAE1 SX6 0 SA6 TBANSWT CLEAR ANS-C ERASE SA1 TBLDATA+1 MX0 -9 BX6 -X0*X1 SA6 A1 CLEAR *NTRIES* CLRFBIT ENABLT TOUCH EQ EAE RETURN * /--- BLOCK LONG/MARKU 00 000 81/02/28 20.29 TITLE -LONG- * -LONG- (CODE=17) * LONGX NGETVAR ROUNDS TO INTEGER IN X1 NG X1,ERXBADL ERROR IF NEGATIVE * EXECERR USES X1 BX7 X1 SA7 LIMIT SX1 MAXLONG+1 IX1 X7-X1 PL X1,LERXMAX * EXECERR USES X7, X1 SX1 MAXLONG/2+1 IX1 X7-X1 NG X1,PROC SA1 TBEDIT LONG GT MAXLONG/2---CHECK FOR EDIT BUFFER AX1 36 ADDRESS OF EDIT BUFFER ZR X1,PROC SB1 X1 SB2 STUDVAR GE B1,B2,PROC MX7 0 WAS IN ANS BUFFER, SO CLEAR SA7 A1 TBEDIT=0 EQ PROC * LERXMAX BX1 X7 SX2 MAXLONG EQ ERXMXLC * * MARKUPY NGETVAR MARKUP-Y BIAS MX6 48 BX6 -X6*X1 LIMIT TO BOTTOM 12 BITS * * SA6 TMARKUY RESET ERROR MARKUP BIAS * LX6 48 SHIFT TO TOP OF WORD SA1 TBWHERE (X1)=12/MARKUP Y BIAS,48/OTHER MX0 12 BX7 -X0*X1 CLEAR OUT OLD MARKUP Y BIAS BX7 X6+X7 MERGE WITH NEW SA7 A1 STORE EQ PROC * /--- BLOCK EXT 00 000 80/08/22 02.06 * EXTMUCH EXECERR 124 TOO MANY -EXT-S IN FINISH UNIT * * CHECK IF WE ARE IN A FINISH UNIT. IF NOT, * RETURN X2=0. OTHERWISE, INCREMENT -EXT- * COUNT AND RETURN X2^=0. EXEC ERROR IF TOO * MANY -EXT-S OR WHATEVER. * THIS ROUTINE MAY NOT DESTROY X1. * ENTRY TESTFIN TESTFIN PS SA2 STFLAGS MX0 1 LX0 FINBIT BX2 X0*X2 TEST FINISH UNIT FLAG ZR X2,TESTFIN --- IF NOT SA2 AUTKEY LX2 60-18-18-6 BRING -EXT- COUNT DOWN MX0 -12 BX6 -X0*X2 SX6 X6+1 INCREMENT COUNT BX2 X0*X2 CLEAR OLD COUNT SX0 X6-21 CHECK AGAINST LIMIT OF 20 PL X0,EXTMUCH --- IF TOO MUCH BX6 X6+X2 RECOMBINE STUFF LX6 18+18+6 POSITION BACK SA6 A2 STORE BACK MX6 0 SA6 MOUTLOC DISCARD ANY PENDING OUTPUT MX2 -1 FLAG FINISH UNIT EQ TESTFIN * /--- BLOCK CATCH/LOCK 00 000 79/08/18 19.00 TITLE -LOCK- * -LOCK- (CODE=196) * FIRST ARG....STATION NUMBER * SECOND ARG...WORD TO STUFF INTO LOCK BUFFER LOCKX RJ GET2 GET TWO ARGS NG X1,ERXSTN STATION NUMBER IN X1,X6 * EXECERR USES X1 SX2 NUMSTAT IX2 X1-X2 PL X2,ERXSTN * EXECERR USES X1 SA7 ITEMP SA2 ALOCK ADDRESS OF *LOCK* BUFFER IX0 X1+X2 SA0 A7 + WE 1 REWRITE ENTRY RJ ECSPRTY EQ PROC * /--- BLOCK CALCC 00 000 78/05/18 21.45 TITLE CALCC AND CALCS * -CALCC- (CODE=34) * * CONDITIONAL CALC. COMMA SEPARATED EXPRESSIONS * ARE COMPUTATIONS. * CALCC LX5 XCODEL GET 2ND PACKAGE NGETVAR 1 SX6 X1+3 BIAS PROPERLY SA6 ERXARGN SET EXECERR ARGUMENT NUMBER SB2 -2 ARG. FOR CALCCJ RJ CALCCJ ACQUIRE APPROPRIATE GTVAR CODE IN X5 NG X5,PROCESX EXIT IF NO-OP FGETVAR DO CORRECT CALCULATION EQ PROCESX * ILOC BSS 2 FOR TEMP USE BY ANY INDIVIDUAL COMMAND * * * -CALCS- (CODE=35) * * COMMA SEPARATED EXPRESSIONS ARE (1) STORAGE * VARIABLE AND THEREAFTER THE VALUES TO BE STORED * IN THE VARIABLE. * CALCSX LX5 XCODEL GET 2ND PACKAGE NGETVAR 1 SX6 X1+4 BIAS PROPERLY SA6 ERXARGN SET EXECERR ARGUMENT NUMBER SB2 -1 ARG. FOR CALCCJ RJ CALCCJ ACQUIRE GETVAR CODE NG X5,PROCESX EXIT IF NO-OP SA4 A5 RESTORE COMMAND WORD AX4 XCMNDL MX2 2*XCODEL+XCMNDL BX2 -X2*X4 SA4 X2+B5 GET FIRST XSTO WORD BX6 X4 SA6 ILOC SAVE STORAGE ADDRESS GETVAR CODE LX4 XFBIT CHECK FOR STORE INTO I OR F VARIABLE PL X4,IGVAR JUMP IF INTEGER STORE FGETVAR GET ADR OF WHERE TO STORE RESULT EQ IGVAR2 * IGVAR NGETVAR GET ROUNDED RESULT IGVAR2 SA2 ILOC GET STORAGE GETVAR CODE BX5 X2 LX2 XFBIT POSITION I/F BIT BX6 X1 NG X2,IGVARF JUMP IF FLOATING POINT NPUTVAR 2 STORE EQ PROCESX * IGVARF FPUTVAR EQ PROCESX * * * SUBROUTINE FOR CALCS AND CALCC COMMANDS * * SET B2=-1 FOR CALCS COMMAND * SET B2=-2 FOR CALCC COMMAND * SET X1= VALUE OF CONDITIONAL VAR * * DOES CORRECT CONDITIONAL CALC AND RETURNS RESULT IN X1 * * COMMAND WORD CONTAINS ARGUMENT COUNT (XCODEL BITS), * CONDITIONAL VAR (XCODEL BITS), * EXTRA STORAGE POINTER (60-2*XCODEL-XCMNDL BITS), AND * THE COMMAND NO. (XCMNDL BITS). * * * ****NOTE**** READIN MUST GUARANTEE AT LEAST * 2 VARS FOR CALCC, 3 FOR CALCS. * * /--- BLOCK CALCCJ 00 000 76/05/17 20.58 CALCCJ EQ * MX2 0 IX1 X1+X2 TREAT -0 AS +0 SA5 A5 AX5 XCMNDL SHIFT OUT COMMAND NO. MX2 2*XCODEL+XCMNDL BX2 -X2*X5 X2 HOLDS X-STO POINTER SB1 1 B1 HOLDS INCREMENT OF 1 NG X1,CALCCJA USE FIRST X-STO WORD IF NEG. SB3 -3 B3 HOLDS INCREMENT OF -3 SB2 B2+B1 B2 HOLDS -1 FOR CALCC, 0 FOR CALCS SX4 B2 AX5 60-XCODEL-XCMNDL GET NO. OF VARS IX5 X5-X4 SX5 X5-4 X5 HOLDS END TEST VALUE + IX4 X5-X1 TEST IF PAST MAXIMUM PL X4,*+1 JUMP IF CONDITIONAL VAR IS IN RANGE BX1 X5 X1 HOLDS MAXIMUM VALUE + SB2 B2+X1 B2 HOLDS WHICH VAR PACKAGE TO GET LE B2,CALCCJA JUMP IF X2 HOLDS CORRECT X-STO POINTER + SB2 B2+B3 DECREMENT BY 3 SX2 X2+B1 INCREMENT X-STO POINTER GT B2,* CALCCJA SA4 X2+B5 CORRECT X-STO WORD TO X4 NE B2,*+1 B2=0 IF THIRD PACKAGE NEEDED LX4 2*XCODEL THIRD PACKAGE TO TOP OF X4 + SB2 B2+B1 NE B2,*+1 B2=-1 IF 2ND PACKAGE NEEDED LX4 XCODEL SHIFT TO 2ND PACKAGE OF WORD + BX5 X4 MOVE TO X5 FOR GETVAR EQ CALCCJ RETURN WITH X5 SET DO CALL GETVAR * /--- BLOCK LVCNTU 00 000 80/11/04 23.22 * * -LVCNTU- * * RETRIEVE NUMBER OF LOCAL VARIABLES FROM ULOC * ON ENTRY X4 = LESSON/UNIT * ON EXIT X4 = NUMBER OF LOCAL VARS * * USES A/0,4,5 * * -EXIT- PROCESSING DEPENDS ON X1 AND X2 NOT * BEING CHANGED BY THIS ROUTINE. * ENTRY LVCNTU LVCNTU EQ * SX4 X4 UNIT INFO ONLY SA5 ECSULOC GET ADDRESS OF -ULOC- TABLE IX0 X4+X5 INDEX TO THIS UNIT RX4 X0 (-RXX- 1 WD READ, MAY CHG *A4*) AX4 60-ULOC1-ULOC2-ULOC3-ULOC4-ULOC5 MX0 -ULOC5 BX4 -X0*X4 GET NUMBER OF LOCALS IN UNIT EQ LVCNTU * * /--- BLOCK ERASE 00 000 80/08/11 02.16 TITLE ERASE * -ERASE- (CODE=36) * * -ERASE N1- ERASES N1 CHARS IF N1 +, NONE IF N1=0 * DOES FULL-SCREEN ERASE IF N1 IS NEGATIVE. * -ERASE N1,N2- ERASES N1 CHARS ON NEXT N2 LINES * -ERASE BLANK- PRODUCES FULL-SCREEN ERASE, * -ERASE ABORT- DOES F.S. ERASE AND ALSO ABORTS * OUTPUT PENDING IN MOUT BUFFER. * ERASEX NG X5,ERASEFS TAG EITHER BLANK OR -ABORT- NGETVAR ROUNDS TO INTEGER IN X1 SX5 0 FLAG FOR NO ABORT OUTPUT ZR X1,PROC --- IGNORE IF ZERO NG X1,ERASEFS FS ERASE DONT ABORT OUTPUT SA2 RSIZE NZ X2,ERASEX2 IF NOT SIZE 0 BX6 X1 SA6 XDATA SAVE NUMBER OF SPACES SA2 A5 LX2 XCODEL 2D ARG CODE AT LEFT MX0 XCODEL BX2 X0*X2 ISOLATE 2D ARG NZ X2,ERASEY JUMP IF WAS A 2D ARGUMENT LX1 3 SPACES * 8 SA3 NX CURRENT X POSITION IX1 X1+X3 NEW X POSITION SX2 X1-513 CHECK FOR OVERFLOW MX1 0 SET LINE COUNT TO ZER NG X2,ERASEY1 JUMP IF NO OVERFLOW SA1 XDATA * ERASEX0 OUTCODE ERSCODE OUTPUT THE ERASE EQ ERASEY2 * * FULL SCREEN ERASE HAS +-0 TAG IN OUTPUT CODE ERASEFS LX5 1 SECOND BIT SET IF ABORTS AX5 59 EXTEND SIGN FOR ABORT FLAG * SETXBIT EXTOFF UPDATE *STFLAGS* NO EXT INPUT * CLEAR ENABLE TOUCH,PAUSE=TOUCH,PAUSE=EXT CLRFBIT ENABLT,ENABLPT,ENABLPX CALL DWECOLR RESET SBANK WE/COLOR TO DEFAULT BX1 X5 -0 FOR ABORT, 0 FOR NO ABORT EQ ERASEX0 * ERASEX2 RJ TUERASE GO ERASE BIG CHARACTERS EQ PROCO * ERASEY BX5 X2 NGETVAR X1_LINES SX2 X1-1 NG X2,PROC IGNORE IF LINES < 1 SX2 X1-33 NG X2,ERASEY1 IF LINES>32 SX1 32 ONLY ERASE 32 LINES ERASEY1 SA4 XDATA GET NUMBER OF SPACES LX4 18 POSITION CHARACTER COUNT BX1 X1+X4 COMBINE LINE AND CHAR. COUNTS OUTCODE BERCODE ERASE SPACES IN 1ST TAG * ERASEY2 BSS 0 SA1 NX RESET TERMINAL TO ORIGINAL SA2 NY POSITION. LX1 9 BX1 X1+X2 COMBINE X,Y OUTCODE WFCODE PUT CODE IN MOUT BUFFER. EQ PROCO * /--- BLOCK ERASE 00 000 79/04/23 01.21 * * -DWECOLR- * * SET MODE TO WRITE AND OUTPUT CURRENT DEFAULT * FOREGROUND AND BACKGROUND COLORS AS SPECIFIED * IN STATION BANK LOCATION *COLORS*. * J R SCHRAMM 83/03/04 * ENTRY DWECOLR DWECOLR EQ * MX6 -3 FORM MASK FOR CURRENT MODE LX6 6 SA1 TBNARGS BX6 X6*X1 CLEAR OLD MODE SX1 300B MODE WRITE BX6 X6+X1 SA6 A1 STORE MODE WRITE IN *TBNARGS* EQ DWECOLR -> EXIT ENTRY OUTCOLR OUTCOLR EQ * * * SEND COLORS TO COLOR TERMINAL * * ENTER'; X1 = COLORS -- 12/0,24/BGND COLOR,24/FGND COLOR * BX6 X1 (X6) = BGND/FGND COLORS SA6 XCOLORS SAVE EXECUTOR COLOR SETTINGS MX0 -24 COLOR MASK BX1 -X0*X1 X1 = FOREGROUND COLOR AX6 24D MOVE BGND COLOR TO LOW ORDER BX3 -X0*X6 X3 = BACKGROUND COLOR MX0 1 LX0 25D X0 = BACKGROUND FLAG BX3 X0+X3 ADD COLOR + FLAG OUTCODE RBGCODE SEND FOREGROUND (X3 PRESERVED) BX1 X3 X1 = BACKGROUND COLOR OUTCODE RBGCODE SEND BACKGROUND COLOR EQ OUTCOLR -> EXIT * /--- BLOCK DOT 00 000 77/06/06 20.54 * * -DOT- (CODE=44) * * SINGLE VARIABLE (ROW-COLUMN POSITION) DOT. * DOTX NGETVAR ROUNDS TO INTEGER IN X1 RJ RCTOXY GET INTO X -Y FORMAT BX1 X6 EQ DOTFXX * * * /--- BLOCK PLOT, CHAR 00 000 79/01/19 19.45 * -DOT(F)- (CODE=45) * * TWO VARIABLE (FINE GRID) DOT. * DOTFX RJ GET2 GET VALUES OF 2 VARIABLES **NXNY FIXED** DOTFXX MX0 -9 BX1 -X0*X1 BX7 -X0*X7 SA6 NX UPDATE NX,NY SA7 NY LX1 9 SHIFT UP 9 BX1 X1+X7 COMBINE WITH Y OUTCODE DFCODE EQ PROCO * * TITLE PLOT AND CHAR * -PLOT- (CODE=260) * * THE TAG SPECIFIES THE NUMBER (0-127) OF THE LOADABLE * CHARACTER TO BE PLOTTED. NUMBERS 0-62 REFERENCE CHARACTER * MEMORY 2, 64-126 REFERENCE CHARACTER MEMORY 3. * * SPECIAL ADDITION--RWB * NUMBERS 128-191 REFERENCE CHAR MEM 0 * NUMBERS 192-255 REFERENCE CHAR MEM 1 * PLOTX NGETVAR ROUNDS TO INTEGER IN X1 BX2 X1 AX2 8 *** CHANGED TO 8 FROM 7-RWB *** NOTE. IF YOU CHANGE THE 8 BITS, YOU WILL HAVE *** TO CHANGE THE EXECUTION ERROR MESSAGE NZ X2,PLERXLMT DO NOT ALLOW OVER 8 BITS NG X2,PLERXLMT DO NOT ALLOW NEGATIVE VALUES OUTCODE PLTCODE SA1 NX UPDATE NX SX2 8 IX1 X1+X2 MX7 51 BX7 -X7*X1 9-BIT NX SA7 A1 EQ PROCO **NXNY FIX NEEDED ABOVE** * PLERXLMT EXECERR 92 EXCEEDING 8 BIT LIMIT * * * -CHAR- (CODE=48) * * LOAD CHARACTER INTO CHARACTER MEMORY. * CHARX SX6 9 NUMBER OF VARIABLES TO DECODE RJ GETN GET 9 VALUES SA4 VARBUF X MTCHRV,1,X4 PROCESSING FOR PPT-TUTOR SA1 VARBUF GET CHARACTER NUMBER LX1 3 MULTIPLY BY 8 TO GET MEMORY ADDRESS BX6 X1 SA6 A1 SB1 A1 SB2 VARBUF+1 RJ MEMOUT MEMORY LOAD REQUEST TO OUTPUT BUFFER SA1 INHIBS LX1 CCLRSHF SEE IF SHOULD CLEAR CHARSET FLAGS NG X1,PROCO SX6 0 FLAG NO CHARACTER SET LOADED SA6 TBCSETA SA6 TBCSET SA6 TBCSET+1 EQ PROCO * /--- BLOCK END,MODE 00 000 76/11/09 09.40 TITLE -END- -MODE- * * * -END- (CODE=112) * ENDX NG X5,ENDLES JUMP IF END LESSON SA1 TBASE SEE WHETHER IN HELP SEQUENCE ZR X1,PROCESS IGNORE IF NOT IN HELP BX6 X1 ELSE SET TBNEXT SA6 TNEXT EQ UNITJ * ENDLES SA1 ILESUN PRESENT LESSON AND UNIT POINTERS MX0 42 BX6 X0*X1 LESSON NUMBER SA6 TNEXT SET TO UNIT ZERO MX0 5 SA2 TBSCORE BX6 -X0*X2 CLEAR OUT OLD *LDONE* INFO SX2 1 SET FOR -COMPLETED- LX2 -5 PUT IN UPPER 5 BITS BX2 X0*X2 LIMIT TO 5 BITS BX6 X6+X2 ADD IN TO *TBSCORE* SA6 TBSCORE EQ UNITJ * * * -MODE- (CODE=50) * * SELECTS TERMINAL WRITE/ERASE FUNCTION. * MODECX CALL GETTAG CONDITIONAL CASE, GET TAG MODEX LX5 XJDGL TOP XJDGL BITS OF COMMAND WORD= W/E FUN. MX0 60-XJDGL BX1 -X0*X5 SX2 X1-7 PL X2,PROC --- EXIT IF -X- OPTION * SX2 X1-4 CHECK IF XOR MODE NZ X2,MCWS0 NO, SO SKIP TERMINAL CHECK SX0 X1 SAVE MODE VALUE * * TWINDOW USES X1 AND X2 * RJ TWINDOW CHECK IF TERM SUPPORTS XOR NZ X1,MCWS2 XOR OK SX1 1 XOR NOT SUPPORTED, SET REWRITE EQ MCWS0 MCWS2 SX1 X0 RESTORE X1 * MCWS0 MX0 -3 LX0 6 POSITION MASK SA2 TBNARGS BX6 X0*X2 CLEAR OUT OLD MODE BX2 X1 LX2 6 POSITION NEW TERMINAL MODE BX6 X2+X6 SA6 A2 SAVE IN *TBNARGS* OUTCODE WEFCODE EQ PROCO * /--- BLOCK INHIBIT 00 000 77/04/28 23.56 TITLE INHIBIT * -INHIBIT- (CODE=66) * * INHIBITS CERTAIN STANDARD TUTOR FEATURES. * (FULL SCREEN ERASE, ANS-C ERASE, SHOWING ARROW) * INHIBX MX0 -XCMNDL MASK OUT COMMAND NUMBER BX5 X0*X5 RETAIN ONLY INHIBIT BITS MX2 LNGSHIF-1 MASK FOR INHIBIT BITS ONLY BX2 -X2 SA1 INHIBS READ UP THE OLD INHIBS FLAG WORD SB2 ICLRSHIF CHECK CLEAR BEFORE SET LX3 X5,B2 PL X3,INHIBX1 BX1 X2*X1 CLEAR FIRST INHIBX1 BX6 X5+X1 COMBINE NEW WITH OLD FLAGS NZ X5,INHIBX2 JUMP IF NON-BLANK INHIBIT BX6 X2*X6 BLANK CLEARS INHIBIT OR FORCE BITS INHIBX2 SA6 A1 PUT IT BACK IN INHIBS EQ PROC * * * -FORCE- COMMAND * * LIKE INHIBIT BUT IN A POSITIVE WAY * FORCEX MX0 -XCMNDL BX5 X0*X5 LX5 -LNGSHIF TO ADJUST FOR MULTIPLE USE OF -INHIBS- MX2 LNGSHIF-1 MASK FOR INHIBIT BITS ONLY SA1 INHIBS READ UP THE OLD INHIBS FLAG WORD SB2 FCLRSHIF CHECK CLEAR BEFORE SET LX3 X5,B2 PL X3,INHIBX1 BX1 X2*X1 CLEAR FIRST EQ INHIBX1 * /--- BLOCK STOREA 00 000 76/06/14 22.33 TITLE STOREA * -STOREA- (CODE=68) * * STORES ALPHANUMERIC CHARACTER STRING FROM JUDGE BUFFER. * STOREAX NGETVAR GET STORAGE ADDRESS SX6 A1 SAVE ADDRESS SA6 EXECSAV SA5 A5 RESTORE COMMAND WORD LX5 XCODEL NGETVAR X1 = NUMBER OF CHARS REQUESTED ZR X1,PROCESS --- EXIT IF NO CHARS SA2 EXECSAV SA0 X2 PICK UP ADDRESS RJ WORDS CHECK STORE BOUNDS SB1 1 SB3 X1-1 CHARS-1 SA2 JUDGE-1 A2 = ADDRESS OF STUDENT CHARS SA3 TJCOUNT X3 = COUNT OF STUDENT CHARS SX6 0 (NEEDED IN CASE NO CHARS) SB2 10 (NEEDED IN CASE NO CHARS) ZR X3,STA3 JUMP IF NO STUDENT CHARS BX1 -X1 X1 = -(CHARS REQUESTED) IX4 X3+X1 X4 = STUDENT CHAR COUNT - CHARS REQUESTED PL X4,STA2 JUMP IF STUDENT CHAR COUNT GREATER OR EQUAL BX1 -X3 X1 = -(STUDENT CHAR COUNT) STA1 SX6 0 CLEAR CHAR ACCUMULATING WORD SB2 10 B2 = CHARS LEFT TO GO IN WORD STA2 SA2 A2+B1 X2 = NEXT STUDENT CHAR LX6 6 BX6 X6+X2 SB2 B2-B1 DECREMENT COUNT OF CHARS TO PUT IN WORD SB3 B3-B1 DECREMENT COUNT OF CHARS REQUESTED SX1 X1+B1 INCREMENT END TEST MARKER PL X1,STA3 JUMP IF AT END NZ B2,STA2 JUMP IF WORD NOT COMPLETE SA6 A0 STORE PACKED CHARACTER STRING SA0 A0+B1 INCREMENT STORAGE ADDRESS EQ STA1 INITIALIZE FOR NEXT WORD STA3 ZR B2,STA5 JUMP IF WORD COMPLETE MX2 0 NEW ZERO FILL STA4 LX6 6 BX6 X6+X2 SB3 B3-B1 DECREMENT COUNT OF CHARS REQUESTED SB2 B2-B1 DECREMENT COUNT OF CHARS TO PUT IN WORD NZ B2,STA4 STA5 SA6 A0 STORE NEXT WORD NG B3,PROCESS --- EXIT IF DONE MX6 0 ZERO FILL STA6 SA6 A6+1 SB3 B3-10 PL B3,STA6 EQ PROCESS --- EXIT * /--- BLOCK SHOWA 00 000 77/07/20 13.47 TITLE SHOWA * -SHOWA- * * SHOWS VARIABLE(S) IN ALPHANUMERIC FORM. * * SHOWA EXPR[,LENGTH] * * INTERNALLY, THERE ARE TWO CASES. IF EXPR IS * NON-STORABLE (IN THE SENSE USED BY COMPILE), THEN * THE 60-BIT VALUE RETURNED BY GETVAR IS USED AS * THE DATA TO DISPLAY, AND LENGTH MUST BE ^<10. * IF EXPR IS STORABLE, THEN EXPR IS INTERPRETED AS * THE FIRST WORD OF A STRING WHICH CAN POTENTIALLY * EXTEND OVER MULTIPLE WORDS. * * IN THE LATTER CASE, ARRAYSEGV PRESENTS A PROBLEM * BECAUSE IT IS CONSIDERED STORABLE BY THE REST OF * THE CONDENSOR, YET IT SHOULD BEHAVE AS A SEGMENT * RATHER THAN A STRING. A KLUDGE IS USED TO HANDLE * ARRAYSEGV PROPERLY. * SHOWAX SX6 0 SA6 ARAYFLG PREPARE FOR ARRAY CHECK SA6 SHOWVAL PRE-CLEAR FOR LITERAL CHECK SA6 STORFLG SHOW NOT STORABLE MX0 1 BX5 -X0*X5 MASK OFF STORABLE BIT NGETVAR PROCESS FIRST SHOWA ARGUMENT SA5 A5 NG X5,SHALIT --- IF FIRST ARG NON-STORABLE SA2 A1 KLUDGE TO DISTINGUISH ARRAYSEGV BX2 X2-X1 NZ X2,SHALIT --- IF ARRAYSEGV MX6 -1 SA6 STORFLG SX6 A1 (X6) = ADDRESS OF FIRST ARG EQ SHARENT * SHOW LITERAL (NON-STORABLE 60-BIT EXPRESSION) SHALIT NG X1,SHOWA01 ZR X1,PROCO --- IF EXPR=0, NOTHING TO SHOW SHOWA01 BX6 X1 SA6 SHOWVAL SX6 A6 * PROCESS LENGTH ARGUMENT AND BOUNDS CHECK IT. SHARENT SA6 EXECSAV ADDRESS IN EXECSAV SA5 A5 READ COMMAND WORD LX5 XCODEL NGETVAR SECOND ARGUMENT ZR X1,PROCESS --- IF LENGTH = 0 SA2 EXECSAV (X2) = ADDRESS OF STRING SA3 ARAYFLG NZ X3,SHAREN1 --- IF ARRAY SHOWA SA3 STORFLG ZR X3,SHAREN1 --- IF NON-STORABLE SA0 X2 PICK UP ADDRESS RJ WORDS CHECK ADDRESS BOUNDS SB1 A0 ADDRESS OF STRING EQ SHAREN2 MORE COMMON CODE * SHAREN1 SB1 X2 SET B1 TO STRING ADDRESS NG X1,ERXBADL SX2 11 LIMIT TO 10 CHARACTERS IX2 X1-X2 PL X2,SHERXARR CANNOT SHOWA MORE THAN 10 * CHARS WITH ARRAY SHOWA * EXECERR USES X1 * /--- BLOCK SHOWA 00 000 77/07/20 13.46 SHAREN2 BX6 X1 SAVE NCHARS IN X1 FOR XYFIX SA6 NCHAR PLANT COUNT, SAVE X6 FOR LATER SB2 A6 ADDRESS OF CHARACTER COUNT SA4 ARAYFLG NZ X4,ASHOWA SA5 A5 RE-FETCH LX5 2*XCODEL NG X5,SHOWAS CHECK FOR EMBEDDED SHOWA(S) RJ XYFIX EQ SHOWAW * EXT ASHOW2,ASHOWIN,ARAYFLG EXT ASHOWEF * ASHOWA SA3 SHOWA1 PLANT EQ ASHOW2 IN LOOP BX1 X4 X1 MUST BE ARAYFLG SA6 ASHOWEF SAVE FORMAT IN X6 SX6 2 FLAG FOR NGETVAR ADDR EQ ASHOWIN SETUP LOOP * SHOWA1 EQ SHOWA2 SHOWA2 SA1 ASHOWEF X1 USED IN XYFIX BX6 X1 SA6 NCHAR RESTORE CHARCOUNT SB2 A6 PTR TO COUNT EQ ASHOW2 * SHOWAS SX7 B1 SAVE B1 SA7 SHOWOUT SX7 B2 SA7 SHOWOUT+1 SAVE B2 SA1 RSIZE NZ X1,SHOWAW IF NOT SIZE 0 RJ SIMPLOT UPDATE NX, NY CORRECTLY SA2 SHOWOUT RESTORE B1 SB1 X2 SA2 SHOWOUT+1 RESTORE B2 SB2 X2 EQ SHOWAW * /--- BLOCK SHOWA 00 000 80/04/22 01.00 * SHOWAW SA1 SHOWVAL CHECK FOR LITERAL SHOW NG X1,SW110 CHECK FOR -0 ZR X1,SW120 * SW110 CALL TUTWRT SHOW LITERAL EQ PROCO * SW120 SA1 RSIZE CHECK IF SIZED WRITTING NZ X1,SW200 SA4 B2 LOAD CHARACTER COUNT SX1 X4+9 ROUND FOR WORD COUNT PX1 X1 SA2 TENTH FX1 X1*X2 COMPUTE WORD COUNT SX1 X1 SA2 MOUTLOC IX1 X1+X2 CHECK IF ROOM IN *MOUT* BUFFER SX1 X1-MOUTLTH+1 NG X1,SW150 JUMP IF ENOUGH ROOM SX6 B1 SA6 SHARE+1 SAVE POINTER TO TEXT SX6 X4 SA6 SHARE+2 SAVE CHARACTER COUNT CALL WINTRP INTERRUPT SA1 SHARE+1 SB1 X1 RESTORE POINTER TO TEXT SB2 SHARE+2 RESTORE POINTER TO CHAR COUNT * SW150 CALL WRSOUT OUTPUT TO *MOUT* BUFFER EQ PROCO * SW200 MX6 -7-3 SA2 TBWRITE CLEAR SIZE WRITE INFO BX6 X6*X2 SA6 A2 SX6 B1 X6 = POINTER TO NEXT TEXT WORD SA6 SHARE+2 SA1 B2 BX7 X1 X7 = CHARACTER COUNTER SA7 SHARE+1 * SW210 SA1 MOUTLOC SEE HOW MUCH OUTPUT SO FAR SX1 X1-MOUT200 PL X1,SW250 SA1 XSLCLOK GET CPU USE CLOCK SA2 MAXCLOK IX2 X1-X2 PL X2,SW250 * SA1 PARCLCNT SEE IF TOO MUCH CUMULATIVE SX1 X1-PRCLIM PL X1,SW250 SB1 X6 POINTER TO NEXT WORD OF TEXT SB2 =10 PRE-SET CHARACTER COUNT SX0 X7-11 CHECK NUMBER CHARS LEFT TO DO + PL X0,*+1 SB2 SHARE+1 SPECIAL FOR LAST WORD + CALL LINWRT SA1 SHARE+1 SX7 X1-10 UPDATE CHARACTER COUNT NG X7,PROCO SA7 A1 SA1 SHARE+2 SX6 X1+1 UPDATE TEXT POINTER SA6 A1 EQ SW210 * SW250 CALL WINTRP INTERRUPT SA1 SHARE+1 SX7 X1 RESTORE X7 = CHARACTER COUNT SA1 SHARE+2 SX6 X1 RESTORE X6 = POINTER TO TEXT EQ SW210 * * SHERXARR EXECERR 93 TRYING TO SHOWA MORE THAN 10 * CHARS PER ARRAY ELEMENT STORFLG DATA 0 * /--- BLOCK SHOWK 00 000 80/04/22 01.00 SHOWK TITLE -SHOWK- * * -SHOWK- * * ARGUMENT = INTERNAL KEY CODE. * * DISPLAYS THE APPROPRIATE STRING, IF ANY, FOR THE * GIVEN KEY CODE AND TERMINAL TYPE. IF KEY CODE IS * NOT WITHIN THE RANGE OF THE TABLE, BUT IS A * DISPLAYABLE KEY, IT WILL BE PLOTTED. OTHERWISE, * NOTHING WILL BE SHOWN. THE VALUES IN THIS TABLE * CAN BE EDITED USING LESSON *S0TTYPE*. ENTRY SKPACK ENTRY FROM -PACK- COMMAND SKPACK EQ * ENTRY/EXIT FOR -PACK- COMMAND MX7 1 EQ SHOWK10 SHOWKX MX7 0 ENTRY FOR -SHOWK- EXECUTION SHOWK10 SA7 SKPTYPE FLAG TO INDICATE CALLER NGETVAR (X1) = INTERNAL KEY CODE BX7 X1 SA7 SHKKEY SAVE INTERNAL KEY CODE SX7 -1 DEFAULT TO NO COLOR SET SA1 SKPTYPE SEE IF -SHOWK- OR -PACK- NZ X1,SHOWK13 IF NOT -SHOWK-, SKIP LX5 XCODEL SHIFT TO NEXT PARAM SX7 -1 DEFAULT TO NO COLOR SET NG X5,SHOWK13 IF NEGATIVE, NO COLOR PASSED NGETVAR BX7 X1 SHOWK13 SA7 SHKCOLR SAVE COLOR TO DISPLAY KEY SA1 SHKKEY RESTORE *X1* NG X1,SHOWK70 IF NEGATIVE VALUE, IGNORE SB3 6 CHECK FOR 70XX KEY CODE AX3 X1,B3 SX2 X3-70B NZ X2,SHOWK15 IF NOT 70XX KEY CODE SX1 X1-6700B CONVERT TO INTERNAL CODE SHOWK15 BX7 X1 SAVE FOR LATER SA7 SHOWKEY SA1 TTPARAM+1 (X1) = 48/OTHER,12/TERM. CLASS MX0 -12 BX3 -X0*X1 (X3) = TERMINAL CLASS ORDINAL SX1 TTWPTT CALCULATE OFFSET IN TABLE IX2 X1*X3 (X2) = START OF PARAMETERS SX1 X2+TTPARMW (X1) = START OF POINTERS SA2 ATTPARM (X2) = EM KEY TABLE ADDRESS NG X2,SHOWK50 IF COMMON NOT LOADED, RETURN IX6 X1+X2 (X6) = KEY TABLE ENTRY ADDRESS SA6 SHOWTAB SAVE ENTRY ADDRESS * CHECK RANGE OF KEY AND CALCULATE OFFSET IN POINTER * TABLE. SX2 X7-KDIV SEE IF .LT. MINIMUM NG X2,SHOWK45 IF NO STRING FOR THIS CODE SX2 X7-TAB-1 SEE IF .GT. MAXIMUM PL X2,SHOWK45 IF NO STRING FOR THIS CODE SX2 X7-KSEMIC-1 PL X2,SHOWK20 IF NOT IN LOWER RANGE SX6 X7-KDIV (X6) = OFFSET IN POINTER TABLE EQ SHOWK30 GET POINTER SHOWK20 SX2 X7-KUNDER SEE IF IN UPPER RANGE NG X2,SHOWK45 IF NO STRING FOR THIS CODE SX6 X7-KUNDER+KSEMIC-KDIV+1 (X6) = OFFSET * /--- BLOCK SHOWK 00 000 83/09/14 08.42 * GET POINTER AND SEE IF DEFAULT OR ALTERNATE KEY * NAME IS TO BE PLOTTED. SHOWK30 SX3 TTPPW PX1 X6 PREPARE FOR FLOATING DIVIDE PX2 X3 NX1 X1 (X1) = POINTER OFFSET NX2 X2 (X2) = POINTERS PER WORD FX5 X1/X2 (X5) = FLOATING WORD OFFSET UX5 X5,B2 RETURN TO INTEGER LX5 B2 (X5) = INTEGER WORD OFFSET IX3 X5*X3 IX4 X6-X3 (X4) = REMAINDER SX3 TTWIDTH SX4 X4+1 IX3 X3*X4 (X3) = SHIFT COUNT SA1 SHOWTAB (X1) = START OF TABLE ENTRY IX0 X1+X5 (X0) = WORD FROM TABLE ENTRY RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) SB2 X3 LX1 B2 SHIFT POINTER TO LOWER BITS MX0 -TTWIDTH BX2 -X0*X1 (X2) = POINTER ZR X2,SHOWK35 IF DEFAULT STRING * GET ALTERNATE STRING FROM EM. SX2 X2-1 ORDINAL OF 1 = OFFSET OF ZERO LX2 1 COMPENSATE FOR 2-WORD ENTRIES SA1 ATTPARM (X1) = START OF EM TABLE SX2 X2+TTALT (X2) = OFFSET TO STRING IX0 X1+X2 SA0 SKTEMP + RE 2 RJ ECSPRTY EQ SHOWK37 PLOT STRING * GET DEFAULT STRING FROM EM. * /--- BLOCK SHOWK 00 000 83/09/14 08.59 SHOWK35 LX6 1 (X6) = ENTRY ORDINAL * 2 SX2 X6+TTDEFLT (X2) = OFFSET TO DEFAULT STRING SA1 ATTPARM (X1) = START OF EM TABLE IX0 X1+X2 (X0) = ADDRESS OF STRING IN EM SA0 SKTEMP + RE 2 RJ ECSPRTY * PLOT OR -PACK- THE ALTERNATE OR DEFAULT STRING. SHOWK37 SA1 SKTEMP CHECK FOR 1ST CHARACTER = 00 MX0 6 BX2 X0*X1 (X2) = 6/1ST CHAR, 54/0 NZ X2,SHOWK38 IF NOT ENCODED *SHIFT-* SX3 1R- REPLACE 00 WITH HYPHEN LX3 54 BX6 X3+X1 SA6 SKTEMP SAVE UPDATED WORD SX7 30D (X7) = STRING LENGTH SB3 0 (B3) = OFFSET FROM SKSHIFT SA7 SKCHARS SAVE STRING LENGTH EQ SHOWK39 SHOWK38 SX7 20D (X7) = STRING LENGTH SB3 1 (B3) = OFFSET FROM SKSHIFT SA7 SKCHARS SAVE STRING LENGTH * /--- BLOCK SHOWK 00 000 80/03/01 11.03 SHOWK39 SA2 SKPTYPE CHECK COMMAND TYPE NG X2,SHOWK40 IF -PACK- COMMAND SA1 SHKCOLR GET COLOR OF FUNCTION KEY NG X1,SHOK39Y IF NO COLOR SPECIFIED MX0 36 SEE IF COLOR OVERFLOWS BX0 X0*X1 ZR X0,SHOK39X IF COLOR OK, SEND IT OUT SX6 -1 NOTE COLOR NOT SENT SA6 A1 RESTORE NEW VALUE EQ SHOK39Y CONTINUE SHOK39X MX0 -3 MODE SA2 TBNARGS AX2 6 POSITION TERMINAL W/E MODE BX2 -X0*X2 SX2 X2-2 SEE IF -MODE ERASE- ZR X2,SHOK39Y IF ERASE, DONT CHANGE COLOR OUTCODE RBGCODE 12/0,24/COLOR,24/RBGCODE SHOK39Y SX6 B3 SAVE OFFSET SA6 SKOFF SB1 SKSHIFT+B3 (B1) = ADDRESS OF STRING SB2 SKCHARS (B2) = ADDRESS OF CHAR COUNT SA1 RSIZE NZ X1,SHOK39A IF SIZE NOT ZERO RJ SIMPLOT SA1 SKOFF SB1 SKSHIFT+X1 (B1) = ADDRESS OF STRING SB2 SKCHARS (B2) = ADDRESS OF CHAR COUNT SHOK39A CALL TUTWRT WRITE THE STRING SHOK39B SA1 SHKCOLR GET COLOR OF FUNCTION KEY NG X1,PROCO IF NO COLOR SPECIFIED SA1 XCOLORS EXECUTOR COLOR SETTINGS MX0 -3 MODE SA2 TBNARGS AX2 6 POSITION TERMINAL W/E MODE BX2 -X0*X2 SX2 X2-2 SEE IF -MODE ERASE- ZR X2,PROCO IF ERASE, GO TO PROCESS MX0 -24D BX1 -X0*X1 X1 = FOREGROUND COLOR OUTCODE RBGCODE 12/0,24/COLOR,24/RBGCODE EQ PROCO RETURN SHOWK40 SA1 SKSHIFT+B3 (A1) = ADDRESS OF STRING SA2 SKCHARS (X2) = CHARACTER COUNT SB2 X2 (B2) = CHARACTER COUNT SB3 -1 INDICATE JUMP TO *PACK2A* EQ SKPACK RETURN * /--- BLOCK SHOWK 00 000 83/09/07 09.36 * PLOT OR -PACK- KEY WHICH HAS NO STRING, CONVERTING * FROM INTERNAL TO EXTERNAL CODE, IF NECESSARY. SHOWK45 SB3 6 SA1 SHOWKEY (X1) = INTERNAL KEY CODE AX2 X1,B3 SEE WHAT CONVERSION NEEDED ZR X2,SHOWK60 IF 00XX CODE SX3 X2-70B ZR X3,SHOWK50 IF 70XX CODE SX3 X2-1 NZ X3,SHOWK70 IF NOT 01XX CODE, GIVE UP SX1 X1+6700B CONVERT 01XX CODE TO EXTERNAL SHOWK50 LX1 59-11 (X1) = 12/EXTERNAL CODE, 48/0 SX7 2 (X7) = CHARACTER COUNT EQ SHOWK65 PLOT KEY SHOWK60 LX1 59-5 (X1) = 6/KEY CODE, 54/0 SX7 1 (X7) = CHARACTER COUNT SHOWK65 SA2 SKPTYPE CHECK FOR COMMAND TYPE BX6 X1 (X6) = SHIFTED KEY CODE SA7 SKCHARS SA6 SHOWKEY NG X2,SHOWK67 IF -PACK- COMMAND SB1 A6 (B1) = ADDRESS OF CHARACTER SB2 A7 (B2) = ADDRESS OF CHAR COUNT SA1 RSIZE NZ X1,SHOK65A IF SIZE NOT ZERO RJ SIMPLOT SB1 SHOWKEY (B1) = ADDRESS OF CHARACTER SB2 SKCHARS (B2) = ADDRESS OF CHAR COUNT SHOK65A CALL TUTWRT WRITE THE CHARACTER EQ PROCO RETURN SHOWK67 SA1 SHOWKEY (A1) = ADDRESS OF CHARACTER SB2 X7 (B2) = CHARACTER COUNT SB3 -1 INDICATE JUMP TO *PACK2A* EQ SKPACK RETURN * FOR KEYS WHICH CANNOT BE PLOTTED, AND WHICH HAVE * NO STRINGS ATTACHED, RETURN AFTER DOING NOTHING. SHOWK70 SA1 SKPTYPE DETERMINE RETURN DESTINATION PL X1,PROC IF NOT PROCESSING -PACK- SB3 0 INDICATE JUMP TO *PACK1A* EQ SKPACK RETURN * MISCELLANEOUS VARIABLES. SHOWKEY BSS 1 INTERNAL KEY CODE SHOWTAB BSS 1 TABLE ENTRY ADDRESS SKSHIFT DATA 0L'S'H'I'F'T SKTEMP BSS 2 USED FOR EM READS SKPTYPE BSS 1 NEGATIVE IF -PACK- COMMAND SKCHARS BSS 1 NUMBER OF CHARACTERS TO PLOT SKOFF BSS 1 SHKKEY BSS 1 INTERNAL KEY TO BE SHOWN SHKCOLR BSS 1 COLOR TO DISPLAY KEY IN * * /--- BLOCK -TEXT- 00 000 83/09/07 09.37 TITLE -TEXT- COMMAND ** TEXT COMMAND PROCESSING. * * FORMAT'; TEXT BUFFER,LENGTH <,LINES> * * WHERE'; BUFFER = INPUT TEXT BUFFER ADDRESS * LENGTH = LENGTH OF BUFFER IN WORDS, * LINES = MAX NO. OF LOGICAL '# PHYSICAL LINES * TO BE DISPLAYED (OPTIONAL). * * THE PRESENCE OF THE *LINES* TAG IS REFERRED TO AS * THE NEW FORMAT, W/O *LINES* AS THE OLD FORMAT. * * THE OLD FORMAT DISPLAYS THE ENTIRE BUFFER. * * THE NEW FORMAT INVOKES *SIMPLOT* TO SIMULATE THE * PLOTTING OF EACH LINE, TO CHECK FOR THE PHYSICAL * (SCREEN) BOUNDARY. ONLY THE NEW FORMAT SETS * ZRETURN = -1 = DISPLAYED ENTIRE BUFFER. * 0 = DISPLAYED NOTHING. * +N = DISPLAYED *N* WORDS. * * * * NEED TO SET A LIMIT ON THE MAXIMUM LINE LENGTH, * OTHERWISE WE COULD BE DEADLOCKED WAITING TO PLACE * IT IN *MOUT* (IF IT WAS LARGER THAN *MOUTLTH*, * FOR INSTANCE). NOTE THAT WE'7LL TRY TO PUT LARGER * LINES IN, BUT IF WE RUN OUT OF ROOM, WE'7LL JUST * HEAVE WHAT WE'7VE GOT INTO *MOUT*. * * THIS IS PERFECTLY OK FOR THE OLD VERSION, BUT * WILL COUNT THE PARTIAL LINE AS A LOGICAL LINE * IN THE NEW VERSION. * * ALL THESE NUMBERS ARE ARBITRARY AT THIS TIME. * MAXLINE EQU 50 MAX LTH OF A LOG. LINE (WORDS) MXMXL. SET MOUTLTH/8 FRAC OF MOUT FOR SINGLE LINE ERRNG MXMXL.-MAXLINE MOUTLTH MAY BE TOO SMALL * * DATA CELL DEFINITIONS. * TXTYPE EQU TBINTSV+0 OLD/NEW FORMAT FLAG + LINE CNT TXBADDR EQU TXTYPE+1 CURRENT INPUT TEXT BUFFER ADDR TXSTART EQU TXBADDR+1 ORIG. INPUT TEXT BUFFER ADDR TXTLTH EQU TXSTART+1 INPUT TEXT LENGTH IN WORDS TXLLINE EQU TXTLTH+1 MAX NO. OF LOGICAL LINES TXYTARG EQU TXLLINE+1 LOWER BOUND FOR Y SCREEN POS. TXMHDR EQU TXYTARG+1 ORIG MOUTLOC = INDEX TO HEADER TXSAVB2 EQU TXMHDR+1 CELL TO SAVE B2 ACROSS SIMPLOT * * /--- BLOCK TEXT INIT 00 000 83/09/07 09.37 TEXTX BSS 0 ENTRY POINT FOR -TEXT- COMMAND SX6 3 MAXIMUM NUMBER OF ARGS (TAGS) CALL GETARGS MOVE ARGS TO VARBUF, GET COUNT SX6 X6-3 CHECK FOR OLD/NEW FORMAT SA6 TXTYPE -1 FOR OLD, 0 FOR NEW (SIMPLOT) NG X6,OTEXT0 -- DON'7T SET *ZRETURN* IF OLD SA6 TRETURN ZRETURN=0 = NOTHING DISPLAYED OTEXT0 BSS 0 SA1 VARBUF GET FIRST ARG -- BUFFER ADDRESS BX5 X1 MOVE TO X5 FOR GETVAR NGETVAR SX6 A1 SAVE ADDRESS OF BUFFER SA6 TXBADDR MOVING POINTER SA6 TXSTART CONSTANT SA1 VARBUF+1 GET SECOND ARG = LENGTH OF TEXT BX5 X1 NGETVAR NG X1,PROCESS -- NEGATIVE LENGTH ZR X1,PROCESS -- ZERO LENGTH BX6 X1 SAVE TEXT LENGTH (WORDS) SA6 TXTLTH SA2 TXBADDR GET BUFFER ADDRESS SA0 X2 A0=ADDR, X1=LTH CALL BOUNDS CHECK BUFFER VALIDITY SA1 TXTYPE CHECK OLD/NEW FORMAT NG X1,TXGO -- OLD FORMAT ALL SET SA1 VARBUF+2 ELSE GET THIRD ARG = MAX LINES BX5 X1 NGETVAR SX6 X1 USE 18-BIT ARITHMETIC NG X6,OTEXT1 -- NEGATIVE LINE COUNT ZR X6,OTEXT1 -- ZERO LINE COUNT SA6 TXLLINE SAVE AS MAX LOGICAL LINES ALSO SA1 NY GET CURRENT Y SCREEN POSITION LX6 4 LOG. LINES * 16 = DELTA Y IX6 X1-X6 CURRENT - DELTA = Y TARGET PL X6,TXDY0 -- STORE VALUE IF POSITIVE SX6 0 ELSE USE 0 AS LOWER BOUND TXDY0 BSS 0 SA6 TXYTARG STORE LOWER BOUND FOR *NY* EQ TXGO -- ALL SET, LET '7ER RIP * OTEXT1 BSS 0 MX6 -1 SA6 TXTYPE PROCESS AS OLD FORMAT -TEXT- SA6 TRETURN AND SET ZRETURN TO *ALL DONE* TXGO BSS 0 ARGUMENTS SET, FIRE AWAY CALL TXMIN SET UP FOR *MOUT* (B1=1 TOO) * /--- BLOCK TEXT LOOP 00 000 83/09/07 09.46 * * GET NEXT LINE TO BE DISPLAYED. (OUTER LOOP) * NOTE THAT ALL THE INFORMATION IS READ FROM * *TBINTSV* CELLS AND THE CURRENT *MOUTLOC* SINCE * WE MAY HAVE INTERRUPTED (*MOUT* WAS FULL). * TXLINE BSS 0 SA2 MOUTLOC CURRENT INDEX INTO *MOUT* SX1 MOUTLTH TOTAL LENGTH OF *MOUT* IX1 X1-X2 SUBTRACT CURRENT FROM TOTAL SB3 X1 B3 = REMAINING WORDS IN *MOUT* SB2 B3-B1 SO WE CAN CHECK FOR ZR/NG MX0 -12D MASK FOR END-OF-LINE BYTE NG B2,TXINTRP -- NO ROOM LEFT IN *MOUT* SX3 X2+MOUT X3 = ADDR OF NEXT WD IN *MOUT* SX4 KCR X4 = CARRIAGE RETURN SA2 TXBADDR X2 = INPUT TEXT BUFFER ADDRESS SA1 TXTLTH SB4 X1 B4 = REMAINING WDS OF INPUT SB2 B0 B2 = WORD INDEX INTO LINE * * GET NEXT WORD OF LINE (INNER LOOP). * EVERYTHING HERE IS IN REGISTERS, SO YOU CAN'7T * COME HERE FROM ANYWHERE BUT TXLINE. * TXWORD BSS 0 SA1 X2+B2 READ (LINE ADDR + INDEX) SB3 B3-B1 DECREMENT WORDS LEFT IN *MOUT* SB4 B4-B1 DECREMENT WORDS LEFT TO DISPLAY BX5 -X0*X1 MASK OF END-OF-LINE BYTE NZ X5,TXWD1 -- BRIF NOT END-OF-LINE BX1 X1+X4 ELSE INSERT CARRIAGE RETURN TXWD1 BSS 0 BX6 X1 MOVE WORD TO STORE REGISTER SA6 X3+B2 STORE IN *MOUT* SB2 B2+B1 INCREMENT LINE INDEX (LENGTH) ZR X5,TXEOB -- BRIF END-OF-LINE ZR B4,TXEOB -- BRIF END-OF-BUFFER NZ B3,TXWORD -- BRIF STILL ROOM IN *MOUT* SX1 B2-MAXLINE CHECK FOR HUGE LINE LENGTH PL X1,TXEOB -- TREAT IT AS A LOGICAL LINE TXINTRP BSS 0 WAIT FOR *MOUT* TO BE FLUSHED CALL TXMOUT SET UP *MOUT* HEADER CALL WINTRP INTERRUPT FOR DISPLAY CALL TXMIN INITIALIZE FOR *MOUT* EQ TXLINE -- TRY SAME LINE AGAIN * /--- BLOCK TEXT EOB 00 000 83/09/07 09.39 * * END-OF-LINE OR END-OF-BUFFER (NO DIFFERENCE). * WE HAVE NOT UPDATED ANY OF THE POINTERS YET, * SO WE CAN SKIP THIS LINE AFTER SIMPLOTTING * SIMPLY BY JUMPING TO THE EXIT PROCESSING. * TXEOB BSS 0 SA1 TXTYPE OLD/NEW -TEXT- FORMAT NG X1,OTEXT2 -- BRIF IF NOT SIMPLOTTING SX6 B2 SAVE B2 ACROSS SIMPLOT SA6 TXSAVB2 SB2 B2+B2 B2*2 LX6 3 B2*8 SB2 X6+B2 B2*10 = NO. OF CHARACTERS SA1 MOUTLOC CURRENT POSITION IN *MOUT* SB1 X1+MOUT = STARTING POSITION OF LINE CALL TEXTSTR *** SIMPLOT LINE *** SB1 1 RESTORE B1 SA1 TXSAVB2 RESTORE B2 SB2 X1 MX1 -9 MASK X,Y TO 9 BITS BX3 -X1*X3 VALUE OF *NX* IF LINE PLOTTED BX4 -X1*X4 VALUE OF *NY* IF LINE PLOTTED SA1 TXTYPE ABUSE OLD/NEW -TEXT- FLAG ZR X1,TXFIRST -- ALWAYS PLOT FIRST LINE SA1 TXYTARG LOWER BOUND FOR *NY* IX1 X4-X1 SUBTRACT TARGET FROM NEW NG X1,TXEND -- BRIF RUNS BELOW *Y* TARGET * * UPDATE NX,NY (*WHERE*) IN STUDENT BANK. * THIS IS CRITICAL, OR SIMPLOT WILL NOT SEE * THE ACCUMULATION OF LINES. WHEN SKIPPING, * THESE MUST NOT BE UPDATED OR IT WILL SEEM * THAT A PHANTOM LINE HAS BEEN PLOTTED. * TXFIRST BSS 0 BX6 X3 SA6 NX BX6 X4 SA6 NY * /--- BLOCK TEXT END 00 000 83/09/07 09.38 * * GOING TO DISPLAY THIS LINE, UPDATE POINTERS * OTEXT2 BSS 0 SA1 MOUTLOC INCREMENT *MOUTLOC* SX6 X1+B2 SA6 A1 SA1 TXBADDR INCR INPUT TEXT BUFFER ADDR SX6 X1+B2 SA6 A1 SA1 TXTLTH DECREMENT REMAINING TEXT SX6 B2 IX6 X1-X6 SA6 A1 ZR X6,TXEND -- NO TEXT REMAINING * * IF NEW FORMAT, COUNT LOGICAL LINES AND CHECK * FOR MAX LOGICAL LINES. (DONE HERE BECAUSE * FIRST LINE MUST ALWAYS BE DISPLAYED) * SA1 TXTYPE GET OLD/NEW FLAG (LOG. LINE) NG X1,TXLINE -- CONTINUE PLOTTING IF OLD SX6 X1+B1 ELSE INCR FLAG AS LOGICAL SA6 A1 LINE COUNTER SA1 TXLLINE MAX NO. OF LOGICAL LINES IX1 X6-X1 COMPARE WITH CURRENT COUNT NG X1,TXLINE -- NOT AT LIMIT, CONTINUE * * THAT'7S ALL FOLKS, FINISH IT UP AND EXIT. * TXEND BSS 0 CALL TXMOUT SET UP *MOUT* HEADER SA1 TXTYPE CHECK FOR OLD/NEW FORMAT NG X1,PROCO -- IF OLD, JUST EXIT W/OUTPUT MX6 -1 PREPARE FOR *ALL DONE* RETURN SA1 TXTLTH GET LENGTH OF REMAINING TEXT ZR X1,TXDONE -- NONE LEFT, SHOW *ALL DONE* SA1 TXBADDR ELSE FIND OUT HOW MUCH WAS SA2 TXSTART BY COMPARING CURRENT-START IX6 X1-X2 NUMBER OF WORDS OUTPUT TXDONE BSS 0 SA6 TRETURN SET *ZRETURN* EQ PROCO -- EXIT WITH OUTPUT * * * * /--- BLOCK TEXT SUBR 00 000 83/09/07 09.39 ** TXMIN - INIT FOR OUTPUT. * * PREPARE TO COPY LINES TO THE *MOUT* BUFFER * BY SAVING THE CURRENT *MOUTLOC*, WHICH WILL * BE THE HEADER LOCATION (SEE TXMOUT). ALSO * INITIALIZES B1=1. * TXMIN PS ENTRY/EXIT SB1 1 B1 = CONSTANT B1 SA1 MOUTLOC GET CURRENT *MOUT* INDEX BX6 X1 SA6 TXMHDR SAVE AS INDEX TO HEADER SX6 X1+B1 INCREMENT PAST HEADER WORD SA6 A1 REWRITE *MOUTLOC* EQ TXMIN -- EXIT * * ** TXMOUT - COMPLETE OUTPUT. * * CONSISTS MOSTLY OF COUNTING NUMBER OF WORDS * PLACED IN *MOUT* AND CHECKING FOR ZERO WORDS. * IF ZERO, MOUTLOC IS RESET TO WHAT IT WAS ON * ENTRY, AS IF WE HAD NEVER BEEN HERE. IF NOT * ZERO, THE NUMBER OF CHARACTERS IS COMPUTED * AND PLACED IN THE HEADER IN *MOUT*. * TXMOUT0 BSS 0 IF NOTHING OUTPUT SX6 X2 ORIGINAL VALUE OF *MOUTLOC* SA6 A1 RESET IT TXMOUT PS ENTRY/EXIT SA1 MOUTLOC GET CURRENT *MOUT* INDEX SA2 TXMHDR GET INDEX TO HEADER IN *MOUT* IX6 X1-X2 NUMBER OF WORDS WE'7VE OUTPUT SX6 X6-1 MINUS ONE WORD FOR THE HEADER ZR X6,TXMOUT0 -- NOTHING OUTPUT YET LX6 1 NUMBER OF WORDS OUTPUT * 2 BX1 X6 LX1 2 (NWORDS*2)*4 = (NWORDS*8) IX6 X1+X6 (*8)+(*2) = NUMBER OF CHARS SX1 WRSCODE MOUT CMND = WRITE, STD FONT LX6 24D SHIFT NCHARS TO PARAM FIELD BX6 X1+X6 MERGE NCHARS AND WRSCODE SA6 X2+MOUT WRITE HEADER TO *MOUT* EQ TXMOUT -- EXIT * * * /--- BLOCK TEXTN TABL 00 000 77/07/20 13.06 * * TABLE FOR TEXTN COMMAND * FIRST 6 CHARS = BORDER RETURN AND LINE NUMBER * NEXT 2 CHARS = MONTH/DAY CHARACTERS (LEADING 0) * NEXT 2 CHARS = YEAR SINCE 1973 (5 BITS, GOES TO 2004) * ENTRY SHLN0 USED IN FILE *FILEX* SHLN0 DATA 76655555555533334236B ACCESS-ASSIGN-4SP DATA 76655534555533344237B ACCESS-ASSIGN-NUM1-NUM2-SP-SP DATA 76655535555533354240B DATA 76655536555533364241B DATA 76655537555533374242B DATA 76655540555533404243B DATA 76655541555533414244B DATA 76655542555533424333B DATA 76655543555533434334B DATA 76655544555533444335B DATA 76653433555534334336B 10 -- 1983 DATA 76653434555534344337B DATA 76653435555534354340B DATA 76653436555534364341B DATA 76653437555534374342B DATA 76653440555534404343B DATA 76653441555534414344B DATA 76653442555534424433B DATA 76653443555534434434B DATA 76653444555534444435B DATA 76653533555535334436B 20 -- 1993 DATA 76653534555535344437B DATA 76653535555535354440B DATA 76653536555535364441B DATA 76653537555535374442B DATA 76653540555535404443B DATA 76653541555535414444B 1999 DATA 76653542555535423333B 2000 DATA 76653543555535433334B DATA 76653544555535443335B DATA 76653633555536333336B 30 -- 2003 DATA 76653634555536343337B 31 -- 2004 * * /--- BLOCK GETARGS 00 000 78/03/03 02.41 * * -GETARGS- * * ROUTINE TO UNPACK ALL GETVAR CODES FOR A * COMMAND INTO *VARBUF* FOR COMMANDS WHICH * USE ROUTINE *MRKLAST* TO MARK OFF THE LAST * GETVAR CODE OF A VARIABLE-ARGUMENT COMMAND * * ON ENTRY'; X6 = MAXIMUM NUMBER DESIRED * X5 = COMMAND WORD * ON EXIT '; X6 = NUMBER OF ARGUMENTS FOUND * * ENTRY GETARGS * GETARGS EQ * SB3 X6 B3 = NUMBER OF ARGS TO GET SB1 1 B1 = 1 BX6 X5 SB2 B0 B2 = CURRENT VARBUF BIAS NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND SA6 VARBUF STORE WITH 1ST VAR CODE LJUST SB2 B1 BIAS = 1 LX6 XCODEL NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND SA6 VARBUF+1 STORE WITH 2ND VAR CODE LJUST SB2 B2+B1 BIAS = 2 LX6 60-XCMNDL-XCODEL MX0 2*XCODEL+XCMNDL BX6 -X0*X6 X6 = EXTRA STORAGE POINTER SA1 B5+X6 X1 = 1ST WORD OF EXTRA STORAGE GETARG1 BX6 X1 NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND SA6 VARBUF+B2 SB2 B2+B1 NEXT ARGUMENT LX6 XCODEL NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND SA6 VARBUF+B2 SB2 B2+B1 NEXT ARGUMENT LX6 XCODEL NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND SA6 VARBUF+B2 SB2 B2+B1 NEXT ARGUMENT SA1 A1+B1 X1 = NEXT EXTRA STORAGE WORD LT B2,B3,GETARG1 LOOP IF MORE TO GO... MRKFND MX0 1 FORM SIGN BIT MASK BX6 -X0*X6 MASK TOP BIT OFF GETVAR CODE SA6 VARBUF+B2 STORE THE UNMARKED CODE SX6 B2+B1 CURRENT COUNT OF ARGUMENTS EQ GETARGS * * /--- BLOCK WORDS 00 000 80/07/19 22.18 *** *** NEW BOUNDS ROUTINES THAT USE X1 AS LENGTH PARAMETER *** *** TITLE BOUNDS CHECKERS * * WORDS (PERFORMS BOUNDS CHECK USING CHAR COUNT) * * ON ENTRY-- * A0 = INITIAL ADDRESS * X1 = CHARACTER POSITION OR COUNT * ON EXIT-- * B1 = ADDRESS OF LAST WORD + 1 * A2,B2,X0,X2 ARE DESTROYED * ** WARNING ** MOVE COMMAND USES THE CURRENT * VALUE OF X0 RETURNED (N-1)(1/10) * ENTRY WORDS * WORDS EQ * NG X1,ERXPOS --- IF NEGATIVE POSITION/COUNT ZR X1,ERXPOS --- IF ZERO POSITION/COUNT SB1 X1 AX1 18 CHECK FOR LENGTH > 18 BITS NZ X1,BOUERR0 RECONSTRUCT X1 FOR EXECERR SX0 B1-1 X0 = NCHARS-1 SA2 TENTH TO GET (N-1)/10 PX0 X0 FX0 X0*X2 X0=(N-1)*(1/10) AND SOME GARBAGE EXPONENT SX1 X0+1 ADD 1 FOR CORRECT LENGTH SX2 B1 SAVE ORIGINAL X1 RJ BOUNDS CHECK ADDRESS BOUNDS BX1 X2 RESTORE X1 EQ WORDS * /--- BLOCK BOUNDS 00 000 79/02/09 12.13 * * BOUNDS (CHECKS BOUNDS USING LENGTH IN WORDS) * * ON ENTRY-- * A0 = INITIAL ADDRESS * X1 = LENGTH (IN WORDS) * ON EXIT-- * B1 = FINAL ADDRESS + 1 * B2,B3,B4 ARE DESTROYED * * A0 DETERMINES WHETHER STUDENT OR COMMON. * NOTE THAT TUTOR WILL INSURE THAT A0 IS IN * BOUNDS, BUT WITH A LONG LENGTH A USER CAN * PRODUCE AN END ADDRESS WHICH IS NEGATIVE. * ENTRY BOUNDS * BOUNDS EQ * NG X1,ERXBADL --- ERROR IF NEGATIVE LENGTH SB1 X1 NG B1,ERXBADL --- ERROR IF NEGATIVE LENGTH AX1 18 CHECK FOR LENGTH > 18 BITS NZ X1,BOUERR0 SX1 B1 RESTORE X1 * SB2 NCVRBUF STARTING ADDR FOR NC VARS SB1 A0+B1 B1 = 1ST ADDRESS AFTER END SB2 A0-B2 CHECK STUDENT, ROUTER OR COMMON NG B1,BOUERR1 --- ERROR IF BAD ADDRESS PL B2,CBOUND COMMON VARS ARE AFTER LOCALS SB2 LVARBUF SB2 A0-B2 CHECK IF LOCAL VARIABLES PL B2,LBOUND LOCAL VARS ARE AFTER ROUTER SB2 RVARBUF SB2 A0-B2 CHECK FOR STUDENT OR ROUTER PL B2,RBOUND ROUTER VARS ARE AFTER STUDENT SB2 STUDVAR SB2 A0-B2 CHECK IF STUDENT NG B2,BOUERR2 --- ERROR IF NOT STUDENT * * 'STUDENT VARIABLE BOUNDS CHECKING SB2 STUDVAR+VARLIM LE B1,B2,BOUNDS * SB2 STUDVAR SX3 VARLIM MAXIMUM LIMIT OF VARIABLES SA4 =7LSTUDENT EQ BOUERR --- ERROR EXIT IF OUT-OF-BOUNDS * RBOUND SB2 RVARBUF+RVARLIM LE B1,B2,BOUNDS * SB2 RVARBUF SX3 RVARLIM MAXIMUM LIMIT OF VARIABLES SA4 =6LROUTER EQ BOUERR --- ERROR EXIT IF OUT-OF-BOUNDS * LBOUND SB3 X1 SAVE X1 SB4 A1 SAVE A1 SA1 LVUCNT X1 = NUM LV IN THIS UNIT SB2 X1+LVARBUF B2 = ADDR OF WORD AFTER LVARS SA1 B4 RESTORE A1 SX1 B3 RESTORE X1 LE B1,B2,BOUNDS * SB2 LVARBUF SA3 LVUCNT X3 = LVARS IN THIS UNIT SA4 =5LLOCAL EQ BOUERR --- ERROR EXIT IF OUT-OF-BOUNDS * CBOUND SB2 NCVRBUF+NCVRLIM LE B1,B2,BOUNDS * SB2 NCVRBUF STARTING ADDR FOR NC VARS SX3 NCVRLIM MAX LIMIT OF CM COMMON SA4 =5LNC/VC * /--- BLOCK BOUNDS 00 000 80/03/23 04.46 BOUERR SX1 A0-B2 STARTING LOCATION SX1 X1+1 START AT N1, NOT N0 SB2 A0 SX2 B1-B2 LENGTH EXECERR 52 * BOUERR2 SX1 B2 EQ ERXINDL INDEX TOO LOW BOUERR1 SX1 B1 EQ ERXINDL INDEX TOO LOW * BOUERR0 LX1 18 RECONSTRUCT X1 SX2 B1 BOTTOM 18 BITS BX1 X1+X2 MERGE EQ ERXBADL * /--- BLOCK JUDGE 00 000 78/07/18 14.43 TITLE JUDGE AND JUDGE* * -JUDGE- (CODE=70) * * 'MODIFIES JUDGMENT OR CONDITIONS OF JUDGING. * 'THE TOP *XJDGL* BITS OF THE COMMAND WORD HOLD THE * NUMBER OF THE JUDGE TYPE. 'THE FOLLOWING TAGS ARE * CURRENTLY PERMITTED-- * OK * WRONG * NO * CONTINUE * IGNORE * EXIT * REJUDGE * X * OKQUIT * NOQUIT * QUIT * * JUDGECX CALL GETTAG CONDITIONAL JUDGE...GET TAG JUDGEX SA1 TBITS DO NOT ALLOW -JUDGE- IN ERASE-UNIT-CONTNGY LX1 ERSUBIT NG X1,JERXERU --- EXECUTION ERROR IF SO LX5 XJDGL MX0 -XJDGL BX5 -X0*X5 EXTRACT CODE SB2 X5 JP JXTAB+B2 JUMP THROUGH TABLE TO PROPER ROUTINE * JXTAB EQ JOKX 0 OK EQ JWRONGX 1 NO (SPECIFIC) EQ JNOX 2 NO (UNIVERSAL) EQ JCONTX 3 CONTINUE EQ JIGNRX 4 IGNORE EQ JEXITX 5 EXIT EQ PJUDGOO 6 REJUDGE EQ PROCESS 7 X EQ JOKQ 8 OKQUIT EQ JNOQ 9 NOQUIT EQ JQUIT 10 QUIT * * JOKX SX6 -1 SET JUDGMENT=OK SA6 TJUDGED SA6 TANSOK SET ANSOK TRUE EQ PROCESS * JWRONGX SX6 0 SET JUDGMENT=NO (SPECIFIC) SA6 TJUDGED SA6 TANSOK SET ANSOK FALSE SA6 JJSBUFA KILL ANY JUDGEMENT ON WORDS EQ PROCESS * JNOX SX6 1 SET JUDGMENT=NO (UNIVERSAL) SA6 TJUDGED SX6 0 SA6 TANSOK SET ANSOK FALSE SA6 JJSBUFA KILL ANY JUDGEMENT ON WORDS EQ PROCESS * JCONTX SB7 XJUDGEC SWITCH TO JUDGE-C LEAVING BUFFERS INTACT SX7 -1 SA7 JJSTORE FLAG NO COMPILED CODE EQ PROCESS * JERXERU EXECERR 90 -JUDGE- NOT ALLOWED IN ERASEU * /--- BLOCK JIGNRX 00 000 78/11/08 20.44 * * ENTRY JIGNRX USED BY IGNORE COMMAND * JIGNRX CALL ARESET RESTORE ARROW SIZE AND ROTATE SA1 TBITS LX1 JUDGBIT NG X1,JOVER --- EXIT IF JARROW TYPE JUDGING SB7 XJUDGEC SET TO JUDGE CONTINGENCY SX6 0 SA6 TJUDGED SPECIFIC -NO- *** FOLLOWING LINE ADDED 3/15/76--'R'W'B SA6 TBANSWT MARK NO ANS-C WRITING (HELPOPS) CALL ANSDAT SA1 RSIZE NZ X1,JJ1 IF NOT SIZE 0 * *TBPAUSE* = NEGATIVE IF PAUSE ENCOUNTERED * = *MOUTLOC* OF OK/NO IF NO PAUSE SA1 TBPAUSE SEE IF PASSED THROUGH A PAUSE NG X1,JJ1 ZR X1,JJ1 SA1 LONG SEE IF JUDGING FORCED SA2 LIMIT IX3 X1-X2 NG X3,JJ1 SX3 X2-1 NZ X3,JJ1 EXIT IF NOT LONG 1 SX3 X1-3 PL X3,JJ1 EXIT IF MORE THAN 2 CHARS SA3 INHIBS LX3 FNTSHIF CHECK FOR -FORCE FONT- NG X3,JJ1 SA3 KEY SX3 X3-FUNKEY CHECK IF REALLY A LETTER PL X3,JJ1 (FOR JUDGE EXIT CASES) SA2 INHIBS LX2 FTESHIF SEE IF FORCE FIRSTERASE IN OPERATION NG X2,JJ1 MX6 0 CLEAR OUT -MOUT- SA6 MOUT CLEAR -AT- SA6 MOUT+1 CLEAR DIRECTION SA6 MOUT+2 SA6 MOUT+3 SA6 MOUT+4 SA6 MOUT+5 SA6 MOUT+6 SA6 A1 ALSO ZERO -LONG- EQ EXIT * JJ1 SA1 RSIZE NZ X1,JJ2 IF NOT SIZE 0 RJ WIPE EQ EXIT * JJ2 RJ LWIPE EQ EXIT * /--- BLOCK JEXITX 00 000 78/11/08 20.47 * * NOTE--THE CODE FOR -JUDGE EXIT- IS ALSO JUMPED TO AT THE * END OF -HELPOP- UNITS (AT ARROWS) AND -ERASEU- UNITS, SO * ANY CHANGES TO -JUDGE EXIT- WILL ALSO AFFECT -HELPOP-S * AND -ERASEU-S * ENTRY JEXITX * JEXITX CALL ARESET RESTORE ARROW SIZE AND ROTATE SA1 TBITS LX1 JUDGBIT NG X1,JOVER --- EXIT IF JARROW TYPE JUDGING SB7 XJUDGEC SWITCH TO JUDGE-C CALL SETLC SET SCREEN LOC TO LAST CHAR CALL ANSDAT EQ EXIT AND EXIT LEAVING ANS INTACT * * JOKQ SX6 -1 OKQUIT SA6 TJUDGED SA6 TANSOK EQ ANSMARK * JNOQ SX6 1 NOQUIT SA6 TJUDGED MX6 0 SA6 TANSOK EQ ANSMARK * JQUIT MX6 1 SET UP -QUIT- BIT LX6 -QUITBIT SA1 TBITS BX6 X1+X6 SET -QUIT- BIT SA6 A1 EQ ANSMARK * /--- BLOCK LANG 00 000 79/08/13 08.09 TITLE LANG * -LANG- COMMAND * SETS -ZLANG- FOR APPROPRIATE LANGUAGE * LANGXC CALL GETTAG CONDITIONAL -LANG- LANGX NG X5,PROCESS SKIP IF X-OPTION LX5 1 ADJUST FOR 1 BIT LESS THEN NORM MX2 LANGBTN LANGUAGE BITS FIELD LENGTH BX6 X5*X2 CLEAR OFF OTHER BITS LX2 LANGBTS MOVE BITS TO RIGHT PLACE LX6 LANGBTS SA1 STFLAG1 GET FLAG WORD BX1 -X2*X1 CLEAR OUT OLD LANG SETTING BX6 X6+X1 PUT IN NEW LANG SETTING SA6 A1 STORE EQ PROCESS ON TO NEXT COMMAND * * * GETTAG IS USED FOR GETTING THE SPECIFIC VALUE * FOR THE CONDITIONAL COMMANDS... * LANG,SAYLANG,MODE,JUDGE,LESSON * * GETTAG EQ * * NGETVAR EVALUATE CONDITION * ROUNDS TO INTEGER IN -X1- * * PL X1,GETTAG1 ZR X1,GETTAG1 TREAT -0 AS +0 SX1 -1 IF NEGATIVE, MAKE -1 GETTAG1 SX0 1 IX1 X1+X0 ADJUST VALUE TO RANGE FROM 0 TO N-1 SA5 A5 RETRIEVE COMMAND WORD MX0 48 X0 = MASK TO LIMIT INFO TO 12 BITS AX5 XCMNDL BX2 -X0*X5 X2 = NUMBER OF ENTRIES IN TABLE AX5 12 BX3 -X0*X5 X3 = RELATIVE START OF TABLE SB2 B5+X3 B2 = ABSOLUTE START OF TABLE IX3 X1-X2 SEE IF NUMBER IN BOUNDS NG X3,GETTAG2 JUMP IF OK SX1 X2-1 ELSE SET FOR LAST ENTRY GETTAG2 SB1 1 B1 = CONSTANT 1 SX2 XJDGL DX1 X1*X2 X1= TOTAL SHIFT COUNT REQUIRED SB2 B2-B1 DECREMENT BEFORE STARTING LOOP SX2 60 GETTAG3 IX1 X1-X2 SB2 B2+B1 ADVANCE WORD ADDRESS PL X1,GETTAG3 JUMP IF NOT IN THIS WORD IX1 X1+X2 RESTORE FINAL SHIFT COUNT SA3 B2 X3 = WORD HOLDING CODE SB2 X1 B2 = SHIFT COUNT LX5 X3,B2 POSITION PROPER CODE AT TOP EQ GETTAG RETURN * /--- BLOCK NEXTNOW 00 000 79/05/05 22.49 TITLE NEXTNOW * * 'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL * INTERACTION PROBLEM * * * * -NEXTNOW- (CODE=73,74*) * NXTLKCX RJ CUNIT GET CONDITIONAL UNIT NXTLKX AX5 48 NEXTNOW UNIT NUMBER SA1 ILESUN LOAD PRESENT LESSON AND UNIT POINTERS MX0 42 BX1 X0*X1 LESSON NUMBER BX6 X1+X5 COMBINE SA6 TNEXT STORE IN NEXT UNIT POINTER * * SAVE CURRENT LESSON/UNIT/COMMAND POINTER FOR * RE-EXECUTION FOLLOWING A -TIMEL- BRANCH THAT * MIGHT BREAK THROUGH THE -NEXTNOW-. * RJ JLPACK SA6 AJOIN+JOINLTH SAVE IN ARROW JSTACK SO IT * IS COPIED CORRECTLY * SX1 B7-XANSC SEE WHAT CONTINGENCY NOW IN SB7 XNEXTLK SET TO NEXT-NOW-C NZ X1,EXIT EXIT IF NOT IN ANS-C MX7 0 SA7 TSPLOC CLEAR SPECS POINTER EQ ANSMARK IF IN ANS-C GO ON TO MARK UP ANSWER * /--- BLOCK KEY BRANCH 00 000 76/07/02 23.18 TITLE KEY BRANCHING COMMANDS * NEXTCX RJ CUNIT GET CONDITIONAL UNIT NEXTX SB1 TNEXT SET NEXT KEY BRANCH EQ TSTUFF * NEXT1CX RJ CUNIT NEXT1X SB1 TNEXT1 SET NEXT1 KEY BRANCH EQ TSTUFF * BACKCX RJ CUNIT BACKX SB1 TBACK SET BACK KEY BRANCH EQ TSTUFF * BACK1CX RJ CUNIT BACK1X SB1 TBACK1 SET BACK1 KEY BRANCH EQ TSTUFF * STOPCX RJ CUNIT STOPX SB1 TSTOP SET STOP KEY BRANCH EQ TSTUFF * STOP1CX RJ CUNIT STOP1X SB1 TSTOP1 SET STOP1 KEY BRANCH EQ TSTUFF * * HELPCX RJ CUNIT HELPX SB1 THELP SET HELP KEY BRANCH EQ TSTUFF * HELP1CX RJ CUNIT HELP1X SB1 THELP1 SET HELP1 KEY BRANCH EQ TSTUFF * LABCX RJ CUNIT LABX SB1 TLAB SET LAB KEY BRANCH EQ TSTUFF * LAB1CX RJ CUNIT LAB1X SB1 TLAB1 SET LAB1 KEY BRANCH EQ TSTUFF * DATACX RJ CUNIT DATAX SB1 TDATA SET DATA KEY BRANCH EQ TSTUFF * DATA1CX RJ CUNIT DATA1X SB1 TDATA1 SET DATA1 KEY BRANCH EQ TSTUFF * * BASECX RJ CUNIT BASEX SB1 TBASE SET BASE UNIT EQ TSTUFF * * FINISCX RJ CUNIT FINISHX SB1 TFINISH SET FINISH UNIT EQ TSTUFF * * IMAINCX RJ CUNIT IMAINX SB1 TIMAIN EQ TSTUFF * IARROCX RJ CUNIT IARROWX SB1 TIARROW EQ TSTUFF * IARROCAX RJ CUNIT IARROWAX SB1 TIARROWA EQ TSTUFF * EARROCX RJ CUNIT EARROWX SB1 TEARROW EQ TSTUFF * * ERASUCX RJ CUNIT ERASUX SB1 TERASE EQ TSTUFF * /--- BLOCK KEY BRANCH 00 000 78/02/17 13.47 * * HELPOCX RJ CUNIT HELPOPX SB1 THELP EQ TSTUFF1 * HLP1OCX RJ CUNIT HELP1OX SB1 THELP1 EQ TSTUFF1 * * LABOPCX RJ CUNIT LABOPX SB1 TLAB EQ TSTUFF1 * LAB1OCX RJ CUNIT LAB1OPX SB1 TLAB1 EQ TSTUFF1 * * DATAOCX RJ CUNIT DATAOPX SB1 TDATA EQ TSTUFF1 * DAT1OCX RJ CUNIT DATA1OX SB1 TDATA1 EQ TSTUFF1 * * NEXTOCX RJ CUNIT NEXTOPX SB1 TNEXT EQ TSTUFF1 * NXT1OCX RJ CUNIT NEXT1OX SB1 TNEXT1 EQ TSTUFF1 * * BACKOCX RJ CUNIT BACKOPX SB1 TBACK EQ TSTUFF1 * BCK1OCX RJ CUNIT BACK1OX SB1 TBACK1 EQ TSTUFF1 * IFERRCX RJ CUNIT IFERROR COMMAND IFERRX SB1 ERRUNIT EQ TSTUFF * * * TSTUFF1 MX0 1 SET ON-PAGE UNIT BIT EQ TSTUFF2 * TSTUFF MX0 0 NOT ON-PAGE UNIT EQ TSTUFF2 * TSTUFF2 AX5 48 POINTER UNIT NUMBER ZR X5,TBZERO CLEAR POINTER IF UNIT 0 NG X5,TBZERO NO SPECIAL UNITS HERE BX5 X0+X5 MX0 42 SA1 ILESUN LOAD PRESENT LESSON AND UNIT POINTERS BX1 X0*X1 LESSON NUMBER BX6 X1+X5 COMBINE SA6 B1 AND STORE IN SPECIFIED WORD * BX1 X5 CALL UEXIST SEE IF UNIT REALLY EXISTS NG X6,PROC * TBZERO MX6 0 CLEAR POINTER SA6 B1 STORE EQ PROC --- RETURN * /--- BLOCK ANSWERC 00 000 76/10/12 17.29 TITLE ANSWERC/WRONGC * ANSCXX NGETVAR OBTAINS CONDITION AND ROUNDS TO INTEGER PL X1,ASC1 CLEAR UP NEGATIVE OUT OF BOUNDS ZR X1,ASC1 TREAT -0 AS +0 SX1 -1 MAKE ALL NEGATIVES -1 ASC1 SX0 1 IX1 X1+X0 MAKE RANGE GO FROM 0 TO N+1 MX0 48 SA5 A5 MAKE SURE HAVE COMMAND WORD AX5 12 BX2 -X0*X5 GET NUMBER OF ENTRIES IN TABLE AX5 12 BX3 -X0*X5 GET RELATIVE START OF TABLE SB2 B5+X3 ABSOLUTE START OF TABLE IX3 X1-X2 SEE IF MAXIMUM NUMBER IN BOUNDS NG X3,ANSC2 SX1 X2-1 IF NOT, SET TO END OF TABLE ANSC2 SA1 B2+X1 GET TABLE ENTRY BX5 X1 MAKE LIKE ANSWER CASE PL X5,ASC9 IF REAL, PROCESS LIKE ANSWER COMMAND * NEGATIVE FLAGS NULL CASE SA3 TANSCNT IF NULL, MUST INCREMENT ANSWER COMMAND SX7 X3+1 COUNTER SA7 A3 EQ PROCESS AND THEN EXIT * ASC9 X NANSOV * * /--- BLOCK SAY 00 000 78/07/18 22.32 * .SAYCMD IFNE SAYASSM,0 NSAYX SX6 2 -SAY- NSAYX1 SA1 TBNARGS LX1 51 POSITION LANGUAGE NUMBER LOWER MX0 54 BX7 -X0*X1 EXTRACT LANGUAGE NUMBER ZR X7,PROCESS 0 MEANS IGNORE SA7 OVARG2 SAVE HERE FOR RETURN SA1 MOUTLOC SEE IF MOUT HAS 100 WORDS LEFT SX1 X1-MOUTLTH+100 PL X1,RETRNZ END TIME SLICE (BACK UP A5) SA6 OVARG1 EXEC EXEC8,PACKOV * NSAYCX SX6 3 -SAYC- EQ NSAYX1 * * PACK ROUTINES RETURN HERE WITH OVARG1=CHAR COUNT, STRING * STARTING AT INFO+0, ENDING WITH ZERO. .SAYCMD ENDIF ENTRY NSAYDO .SAYCMD IFNE SAYASSM,0 NSAYDO SA1 OVARG2 SX2 X1-1 ZR X2,NSAYWES OVARG2=1 FOR WES (WORLD ENGLISH SPELLING) SX2 X1-2 ZR X2,NSAYESP =2 FOR ESPERANTO SX2 X1-3 ZR X2,NSAYIPA =3 FOR IPA SX2 X1-4 ZR X2,NSAYSP =4 FOR SPANISH EQ PROCESS **ADD MORE LANGUAGES HERE** NSAYWES EXEC SAYX,WSAYOV NSAYESP EXEC SAYX,ESAYOV NSAYIPA EXEC SAYX,IPSAYOV NSAYSP EXEC SAYX,SSAYOV * *PT 78/7/17 * SAYLX AX5 2*XCODEL GET LANGUAGE NUMBER (<64) *PT SAYLXC CALL GETTAG CONDITIONAL CASE SAYLX NG X5,PROCESS SEE IF -X- OPTION MX0 XJDGL BX5 X0*X5 CLEAR OFF OTHER BITS LX5 XJDGL *PT SA1 TBNARGS LX1 51 POSITION LANGUAGE NUMBER LOWER MX0 54 BX6 X0*X1 DELETE OLD NUMBER BX6 X6+X5 INSERT NEW NUMBER LX6 9 REPOSITION SA6 A1 .SAYCMD ELSE NSAYX BSS 0 NSAYCX BSS 0 NSAYDO BSS 0 SAYLXC BSS 0 SAYLX BSS 0 .SAYCMD ENDIF EQ PROCESS * /--- BLOCK OVERLAYS 00 000 80/02/10 05.10 * * -INITIAL*- * INIT1X SX6 1 SX1 INITXOV EQ PROCOV1 * * -PUT- -PUTV- * PUTX MX6 0 PUTX1 SX1 PUTOV EQ PROCOV1 * PUTVX SX6 1 EQ PUTX1 * * -SEARCH- * SEARCHX MX6 0 MARK FIRST CALL TO OVERLAY SEARCH1 SA6 OVARG1 X SEARCHO CALL TFIN INTERUPT MX6 -1 MARK NOT FIRST CALL EQ SEARCH1 * * -SORTA- -SORT- * * RETURN TO -TEKTRON- COMMAND AFTER INTERRUPT * ENTRY TEKBRK TEKBRK CALL TFIN SX1 TEKTROV SX6 1 VALUE FOR *OVARG1* EQ PROCOV1 * SORTAX MX6 0 -SORTA- EQ SORT1 * SORTX SX6 1 -SORT- SORT1 SA6 OVARG1 X SORTOV CALL TFIN INTERRUPT SX6 2 EQ SORT1 * * RETURN TO -LLFIND- OVERLAY AFTER INTERRUPT * ENTRY LLFBRK LLFBRK CALL TFIN SX1 LLFIND EQ PROCOV1 * * -COMPUTE- (LEVEL 1 OVERLAY) * -SETSITE- (LEVEL 1 OVERLAY) * -MATCH- * -ANSWER- * -CONTAIN- * -CANT- * -DISCARD- * COMPUTX X COMPTOV * SETSITX X SETSIOV * XMATCHX SX1 NMATOV EQ PROCOV1 * XANSX SX1 NANSOV EQ PROCOV1 * XANSAX SX1 ANSAOV EQ PROCOV1 * * -MARKUP- * MARKUPX SA1 TBERRMK ONLY NEGATIVE MEANS HOLDMARK NG X1,MARKXXX SA1 TSPECS OTHERWISE, CLEAR -SPECS HOLDMARK- BIT MX6 1 SO MARKUP APPEARS NORMALLY...THE LX6 60-HOLDMK MARKUP COMMAND OVER-RIDES ANY BX6 -X6*X1 -SPECS HOLDMARK- ENCOUNTERED SA6 A1 EQ PROCESS * MARKXXX SX1 MARKUP DELAYED MARKUP OF ANSWER EQ PROCOV1 * * -TOUCH(W)- * TOUCHX SX1 TOUCHOV EQ PROCOV1 */// * * -SUBMITM- * * /--- BLOCK OVERLAYS 00 000 81/04/30 21.55 SUBXX SX6 1 -SUBMITX- SA6 OVARG1 SUBX10 X SUBTMOV CALL XSTOR,SBXNAM,BLKLTH ALLOCATE ECS EQ SUBX10 * * * -NOBREAK- * NBREAKX X INTLOKV,2 * * * * -RECORDS RESTORE- * ENTRY RESTREC EXT AREAOUT RESTREC CALL AREAOUT SA5 A5 RESTORE CURRENT COMMAND WORD X RECORDS,1 FINISH -RECORDS RESTORE- * * VARIOUS GRAPHING COMMANDS * * -AXES- (FINE GRID) * -BOUNDS- (FINE GRID) * AXESXF SX6 3 EQ BOUND1 * BOUNDXF SX6 24 BOUND1 SX1 GRAFSOV EQ PROCOV1 * * INTERRUPT ROUTINES FOR GRAPHING OVERLAYS * ENTRY GRAFINT ENTRY LABLINT ENTRY BARINT GRAFINT RJ TFIN FUNCT INTERRUPT SX6 23 EQ BOUND1 * * LABLINT RJ TFIN LABEL INTERRUPT SX6 25 EQ BOUND1 * * BARINT RJ TFIN BAR INTERRUPT SX6 1 SX1 GRAF2OV EQ PROCOV1 * * * /--- BLOCK PPTX1 00 000 77/09/15 20.04 TITLE PLATO PROGRAMMABLE TERMINAL COMMANDS * * VARIOUS PPT-RELATED COMMANDS * PPTA SA6 OVARG1 X PPT1OV CALL TFIN INTERRUPT PROCESSING BX6 X1 PASS X1 AS AN ARGUMENT SA6 OVARG2 MX6 0 EQ PPTA * PPTADRX SX6 1 EQ PPTA * PPTDATX SX6 2 EQ PPTA * PPTRUNX SX6 3 EQ PPTA * EXTOUTX SX6 4 EQ PPTA * PPTOUTX SX6 5 EQ PPTA * PPTHLTX SX6 6 EQ PPTA * /--- BLOCK PPTX2 00 000 80/02/06 05.21 * PPTB SA6 OVARG1 X PPT2OV CALL TFIN INTERRUPT PROCESSING PPTRTNX BX6 X1 PASS X1 AS AN ARGUMENT SA6 OVARG2 MX6 0 EQ PPTB * PPTLDX SX6 1 EQ PPTB * PPTTSTX SX6 2 EQ PPTB * PPTCLRX SX6 3 EQ PPTB * * * -ASMBIT- * SET FLAG TO MARK ASSEMBLY LANGUAGE PROGRAM MAY * HAVE BEEN EXECUTED - CAUSES -CLEAR- KEY TO ACT * AS -STOP1- KEY * ENTRY ASMBIT ASMBIT EQ * MX6 1 LX6 ASMPBIT POSITION ASSEMBLY PROG BIT SA1 STFLAG1 BX6 X1+X6 SET BIT IN STATION BANK SA6 A1 EQ ASMBIT * ** * /--- BLOCK LIBXXXX 00 000 82/06/28 10.43 TITLE LIBCALL/LIBRET EXECUTION. * SET UP -SYSLIB- CALL. UNIT NAME RETURNED * IN (OVARG1). LIBCALX X LIBCALL PROCESS COMMAND ARGUMENTS CALL SYSLIB,OVARG1,-1 SX6 B1 SA6 TRETURN STORE ERROR STATUS EQ =XPROCESS LIBRETX X LIBRET EQ PROCESS TITLE LOADMX - LOAD ORIENTAL MODULE TO TERMINAL. ** LOADMX - LOAD ORIENTAL MODULE INTO TERMINAL. * * WORKS JUST LIKE *NTOSYS* IN DECK TUTORX. * LOADMX CALL SYSLIB,KLOADM,-1 EQ =XRETRNX FORCE TIME-SLICE AND EXIT KLOADM DATA 5LLOADM * * -SUBMITX- BUFFER -- LESNAM TABLE ENTRY. * SBXNAM DATA 0 -SUBMITX- BUFFER NAME DATA 0LSUBMITX + VFD 60/6RBUFFER + VFD 12/1,48/0 * * /--- BLOCK OUTPUT 00 000 79/04/23 10.06 SPACE 3 *** OUTARRX OUTPUT ARROW * * PLOTS THE ARROW FOR TUTOR LESSONS. * SHOULD NOT BE USED TO PLOT ARROWS FOR SYSTEM * CALLS (LIKE IN SYSLIB FOR TERM ETC.) * ENTRY OUTARRX OUTARRX EQ * ENTRY/EXIT SA1 TBITS CHECK ARROW/ARROWA LX1 ARRTPBT SA3 ARRCHRS GET ARROW SX2 5 PLOT 5 CHARS PL X1,OUTARRL IF ARROW LX3 30 OUTARRL SA4 INHIBS LX4 BLDSHIF CHECK FOR BOLD PL X4,OUTARRM MX4 30 BX3 X3*X4 CLEAN UP CHARS SX4 KUP*100B+1R8 BX3 X3+X4 LX3 -12 SX2 7 OUTARRM SA4 MOUTLOC SX6 X4+2 INCREMENT OUTPUT POINTER SA6 A4 NO OVERFLOW TESTS MADE LX2 24 SHIFT COUNT UP EQ OUTARRX -- EXIT SPACE 3 *** OUTNX OUTPUT WITH TRUNCATION * * IDENTICAL TO -OUTPUT- EXCEPT THAT IN * CASE OF OVERFLOW THE CODE IS SIMPLY * NOT PUT INTO THE OUTPUT BUFFER (RATHER THAN * BRANCHING TO AN ERROR EXIT) AND PROCESSING * CONTINUES. * * 'USES REGISTERS X1,X2,X6 AND A2,A6. * ENTRY OUTNX OUTNX EQ * ENTRY/EXIT SA2 MOUTLOC SX6 X2-MOUTLTH PL X6,OUTNX -- RETURN SX6 X2+1 SA6 A2 MX6 36 SETS *MOUT* CHECK OK (NEG) LX1 24 BX1 X1*X6 EQ OUTNX -- EXIT * /--- BLOCK OUTPUT 00 000 79/04/23 10.06 SPACE 3 *** OUTPX OUTPUT WITHOUT OVERFLOW CHECKS * * IDENTICAL TO -OUTPUT- EXCEPT THAT NO * OVERFLOW CHECK IS MADE AND NO MASKING * IS DONE FOR PROTECTION. 'FOR USE WHEN * EVERYTHING IS KNOWN TO BE OK. * * 'USES REGISTERS X1,X2,X6 AND A2,A6. * ENTRY OUTPX OUTPX EQ * ENTRY/EXIT SA2 MOUTLOC SX6 X2+1 SA6 A2 LX1 24 EQ OUTPX -- EXIT SPACE 3 *** OUTPUTX OUTPUT DATA TO FORMATTER * * 'EXPECTS X1 TO HOLD PARAMETER INFO TO COMBINE * WITH THE OUTPUT CODE -ARG- AND PUTS THE RESULTANT * CODE INTO THE OUTPUT BUFFER *MOUT*. * * 'THE FOLLOWING REGISTERS ARE USED-- * X1,X2,X6 AND A2,A6 (X1 IS SHIFTED UP 24 BITS * BY THIS ROUTINE). * ENTRY OUTPUTX OUTPUTX EQ * ENTRY/EXIT RJ OUTCODX SEND OUTPUT CODE EQ OUTPUTX -- EXIT SPACE 3 *** OUTCODX OUTPUT CODE TO FORMATTER * ENTRY OUTCODX OUTCODX EQ * ENTRY/EXIT SA2 MOUTLOC SX6 X2-MOUTLTH PL X6,=XERROROF SX6 X2+1 SA6 A2 MX6 36 LX1 24 BX1 X1*X6 EQ OUTCODX -- EXIT SPACE 3 *** OUTPTWX OUTPUT WORD TO FORMATTER * * OUTPUT A WORD TO THE FORMATTER. * * X2 HOLDS CHAR. COUNT TO OUTPUT (LESS THAN 11) * X3 HOLDS CHARS TO OUTPUT (LEFT JUSTIFIED) * ENTRY OUTPTWX OUTPTWX EQ * ENTRY/EXIT SA4 MOUTLOC SX6 X4+2 SA6 A4 LX2 24 SX6 20000B+WRTCODE BX6 X2+X6 SA6 MOUT+X4 BX6 X3 SA6 A6+1 EQ OUTPTWX -- EXIT * /--- BLOCK END 00 000 79/04/22 03.56 TITLE SEND EXT CODES TO CLIENT SOFTWARE *** CLIENT - SENDS EXT CODES TO CLIENT SOFTWARE * * USES A - 1 * B - 1,2 * X - 0,1 * * INPUT'; B1 = EXT CODE * B2 = VALUE TO BE ADDED TO EXT * * ENTRY CLIENT CLIENT EQ * ENTRY/EXIT SA1 STFLAG1 GET TERMINAL INFO 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,CLIENT IF NOT ASCII, EXIT SA1 BANKADD GET WORD HOLDING TERM SUBTYPE MX0 -TSBTN SET MASK TO GET DATA LX1 TSBTN-TSBTS POSITION DATA TO END OF WORD BX1 -X0*X1 MASK OUT TERM SUBTYPE SX0 X1-SBTWIN SEE IF WINDOWS TERMINAL ZR X0,CLIENT1 SEND -EXT- CODE SX0 X1-SBTMAC SEE IF MACINTOSH SYSTEM ZR X0,CLIENT1 SEND -EXT- CODE EQ CLIENT -- RETURN CLIENT1 SX1 B1 -EXT- CODE SX1 X1+B2 ADD ADDITIONAL VALUE TO -EXT- OUTCODE EXTCODE OUTPUT CODE TO FORMATTER EQ CLIENT RETURN * * /--- BLOCK END 00 000 79/04/22 03.56 TITLE MACRO ROUTINES *** GETSEG - GET SEGMENT FROM 15-BIT SEGMENT ARAY * * ROUTINE USED BY *DISKFIO*, *FILEX*, *NAMEX* * *RECORDX*, AND *RESERV* * ENTRY GETSEG GETSEG EQ * ENTRY/EXIT SX7 X1-1 RECORD NUMBER RELATIVE TO ZERO MX6 -2 BX2 -X6*X7 GET LOWER 2 BITS OF REC. NO. SX6 15 IX6 X2*X6 0,15,30,45 AX7 2 GET BIAS TO RAT WORD SX2 45 IX6 X2-X6 45,30,15,0 SB1 X7 SA2 A0+B1 GET ALLOCATION WORD SB1 X6 RETURN SHIFT COUNT TO CALLER AX2 X2,B1 NEXT POINTER TO LOWER 15 BITS MX7 -15 BX2 -X7*X2 EXTRACT NEXT RECORD NUMBER EQ GETSEG -- RETURN * * /--- BLOCK END 00 000 79/04/22 03.56 * END