COVLAY2 * /--- FILE TYPE = E * /--- BLOCK COVLAY2 00 000 81/07/28 02.24 IDENT COVLAY2 LCC OVERLAY(1,1) * TITLE ASSORTED OVERLAYS FOR CONDENSOR * * CST * * COVLY2$ OVFILE * * * ERROR EXITS EXT ERRTAGS,ERRNAME,ERRSTOR EXT ERRXYTG,ERR2MNY,ERR2FEW EXT ERRTERM,ERRUARG,ERRVTYP EXT ERROUTR,ERRCNTD,ERRXORQ EXT ERRBAL * FOLLOWING EXTERNALS ARE FOR COMMON,COMMONX,STORAGE EXT COMPILE,COMPNAM,LNGUNIT EXT ERRORC,NXTNAM,NXTLINE EXT SYSTEST,SYSONE EXT VARFIN,PAUSE2,TWOBITS,TAGXACT * * FOLLOWING EXTERNALS FOR PUT, PUTD EXT PUTCODE,PUT= * * FOLLOWING EXTERNALS FOR DRAW EXT GETLINE,KEYTYPE,QUIKCMP,COMPSYM EXT VARFINS,COMCONT * * FOLLOWING EXTERNALS FOR CHANGE COMMAND EXT COMNAMS EXT CONTEST,CONTAB IN FILE CONTENT * * FOLLOWING EXTERNALS FOR INITIALIZATIONS EXT COMNAMS EXT CSYMADD EXT UERRSET * * FOLLOWING EXTERNALS FOR -WRITEC- EXT BRVAR,CONV2,CONV3,CONUL4 * * FOR INITIALIZATION EXT CONTAB IN FILE CONTEN * * * /--- BLOCK LIB(CALL) 00 000 79/02/07 16.14 TITLE LIBCALL AND CALL COMMANDS * LIBCOV OVRLAY * SA1 OVARG1 SB3 X1 JP B3+*+1 * + EQ LIBIN LIBCALL + EQ CALLIN CALL * * -LIBCALL- AND -CALL- COMMAND READIN * FIRST ARGUMENT IS -SYSLIB- UNIT NAME * MAY HAVE 3 MORE OPTIONAL ARGUMENTS * * -CALL- RESTRICTS COMMAND TO THE FOLLOWING * -SYSLIB- UNITS'; * ASK, CALC, KERMIT, TALK, TIME * LIBIN RJ SYSTEST THIS IS THE ONLY CHECK CALLIN MX6 0 PRE-CLEAR SA6 VARBUF SA6 VARBUF+2 SA6 VARBUF+3 SA6 VARBUF+4 CALL NXTNAM GET UNIT NAME ZR X6,ERRNAME MX0 8*6 UNIT NAME CANNOT EXCEED 8 CHARS BX0 -X0*X6 NZ X0,ERRNAME SA6 VARBUF+1 SAVE UNIT NAME SA3 OVARG1 GET ARG FROM -COMNDS- ZR X3,LIBCHK IF -LIBCALL-, SKIP SA2 CASK FIRST TERM TO CHECK SB3 5 NUMBER OF TERMS TO CHECK LIBTERM BX2 X2-X6 ZR X2,LIBCHK IF EQUAL TO TERM NAME, OK SB3 B3-1 DECREMENT CHECK ZR B3,ERRNAME IF NOT VALID NAME, ERROR OUT SA2 A2+1 GET NEXT TERM EQ LIBTERM GO CHECK AGAIN LIBCHK ZR X1,LIBCIN1 JUMP IF END-OF-LINE ZR X3,LIBINLP IF -LIBCALL-, SKIP SA2 CTALK GET *TALK* UNIT NAME BX2 X2-X6 SEE IF *TALK* UNIT ZR X2,LIBINLP IF *TALK*, SKIP SA2 CKERMIT GET *KERMIT* UNIT NAME BX2 X2-X6 SEE IF *KERMIT* UNIT ZR X2,LIBINLP IF *KERMIT*, SKIP EQ ERR2MNY TO MANY PARAMS PASSED * * /--- BLOCK LIB(CALL) 00 000 79/02/07 16.11 LIBINLP CALL COMPILE GET NEXT ARGUMENT BX6 X1 SA2 VARBUF SA6 X2+VARBUF+2 SA1 LASTKEY SEE IF END-OF-LINE ZR X1,LIBCIN1 SX6 X2+1 INCREMENT NUMBER OF CODES SA6 A2 SX6 X6-3 ALLOW THREE ARGUMENTS NG X6,LIBINLP EQ ERRTAGS * LIBCIN1 SA1 INX INDEX IN EXTRA STORAGE SX6 X1+2 SA6 A1 SA2 VARBUF+1 MOVE UNIT NAME TO EXTRA STORAGE BX6 X2 SA6 X1+INFO SA2 VARBUF+2 -GETVAR- CODE FOR 1ST ARGUMENT LX2 60-XCODEL SA3 VARBUF+3 -GETVAR- CODE FOR 2ND ARGUMENT LX3 60-XCODEL-XCODEL BX6 X2+X3 SA2 VARBUF+4 -GETVAR- CODE FOR 3RD ARGUMENT LX2 60-XCODEL-XCODEL-XCODEL BX6 X2+X6 SA6 X1+INFO+1 MOVE TO EXTRA STORAGE BX6 X1 LX6 XCMNDL POSITION INDEX IN XSTOR EQ PUTCODE * CASK DATA 0LASK CCALC DATA 0LCALC CKERMIT DATA 0LKERMIT CTALK DATA 0LTALK CTIME DATA 0LTIME * ENDOV * /--- BLOCK EXACTC 00 000 76/01/26 14.44 TITLE EXACTC * -EXACTC- * THIS READ-IN ROUTINE IS ESSENTIALLY THE ANCIENT * READ-IN FOR THE ORIGINAL -WRITEC- COMMAND BEFORE * EMBEDDING, ETC. * * * FORMAT OF COMMAND WORD -- * * TOP *XCODEL* BITS = -GETVAR- CODE FOR VARIABLE * NEXT XX BITS = UNUSED * NEXT 12 BITS = NUMBER OF ENTRIES IN TABLE * NEXT 12 BITS = RELATIVE ADDRESS OF LAST WORD OF TABLE * LAST *XCMNDL* BITS = COMMAND CODE NUMBER * * * THE TABLE ENTRIES ARE IN BACK-TO-FRONT ORDER--I.E., THE LAST * WORD OF THE TABLE CONTAINS THE INFO FOR THE FIRST ENTRIES. * THERE ARE TWO ENTRIES PER WORD, EACH HOLDING THE FOLLOWING -- * * TOP 12 BITS = RELATIVE ADDRESS OF FIRST WORD OF TEXT INFO * NEXT 6 BITS = SHIFT COUNT TO POSITION 1ST CHAR AT LEFT * NEXT 4 BITS = NUMBER OF CHARACTERS IN 1ST TEXT WORD * NEXT 8 BITS = NUMBER OF CHARACTERS IN FOLLOWING WORDS * /--- BLOCK EXACTC 00 000 76/07/24 21.29 * * WRITCOV OVRLAY RJ COMPILE DECODE ONE VARIABLE BX7 X1 LX7 60-XCODEL LEFT-ADJUST GETVAR CODE SA7 BRVAR SAVE * /--- BLOCK EXACTC 00 000 76/07/25 07.57 SA1 INX BX6 X1 MX7 0 SA6 CONV2 RELATIVE STARTING ADDRESS OF TEXT SA2 ICX SX6 X2-1 SA6 WCTADR INITIALIZE TABLE ADDRESS POINTER SA7 CONV3 NUMBER OF TABLE ENTRIES = 0 SA7 INFO+X1 CLEAR 1ST TEXT WORD SA7 INFO+X6 CLEAR 1ST TABLE WORD SX7 54 SA7 WCSHFT INITIALIZE SHIFT COUNT MARKER SA2 LASTKEY NZ X2,WRTCIN3 JUMP IF LINE NOT EXHAUSTED * WRTCIN1 SA3 NEXTCOM CHECK IF CONTINUATION SA4 COMCONT BX3 X3-X4 ZR X3,WRTCIN2 JUMP TO GET NEXT LINE IF CONTINUED * SA1 CONV3 X1 = NUMBER OF TABLE ENTRIES ZR X1,ERR2FEW SA2 WCTADR X2 = CURRENT RELATIVE TABLE ADDRESS SA3 ICX X3 = NEXT RELATIVE ADDRESS FOLLOWING TABLE SA4 CONV2 X4 = RELATIVE ADDRESS OF LAST WORD OF TEXT SA1 INFO-1+X2 A1 = ADDRESS PRECEDING TABLE SB2 INFO+X4 B2 = ADDRESS OF LAST WORD OF TEXT IX3 X3-X2 X3 = LENGTH OF TABLE SB3 B2+X3 B3 = END TEST FOR TRANSFER WCTRANS SA1 A1+B1 MOVE TABLE AFTER TEXT BX6 X1 SB2 B2+B1 SA6 B2 LT B2,B3,WCTRANS SB2 INFO SX7 B3-B2 X7 = RELATIVE ADDRESS OF LAST WORD OF TABLE SA7 CONV2 STORE IN CONVENTIONAL LOCATION SX6 X7 UPDATE EXTRA STORAGE POINTER SA6 INX +++ NOTE +++ STANDARD EXIT INCREMENTS IT SA4 COMNUM BX6 X4 SET UP TO USE THIS COMMAND NUMBER EQ CONUL4 --- EXIT VIA CONDITIONAL BRANCH PACK-UP * * WRTCIN2 RJ GETLINE READ IN NEXT LINE * /--- BLOCK EXACTC 00 000 76/01/26 14.44 WRTCIN3 SA2 WORDPT X2 = STARTING ADDRESS FOR TAG SEARCH SA1 X2 X1 = 1ST CHARACTER OF TAG ZR X1,WRTCIN1 JUMP TO LOOK FOR CONTINUATION IF BLANK LINE * WTCLOOP SB1 1 B1 = CONSTANT 1 SB3 6 B3 = SHIFT COUNT DECREMENT SA3 LASTKEY GET EXPRESSION TERMINATOR SB4 X3 * /--- BLOCK EXACTC 00 000 76/07/24 21.31 SB4 -B4 COMPLEMENT OF TERMINATOR SA3 CONV2 X3 = RELATIVE ADDRESS OF CURRENT TEXT WORD SA4 INFO+X3 X4 = CURRENT TEXT INFO WORD SA5 WCSHFT SB2 X5 B2 = SHIFT COUNT FOR NEXT CHARACTER * /--- BLOCK EXACTC 00 000 76/07/24 21.02 WTC200 SA1 A1-B1 RESET FOR LOOP WTCPACK SA1 A1+B1 X1 = NEXT CHARACTER LX2 X1,B2 ZR X1,WTCFIN TEXT COMPLETE IF END-OF-LINE SX6 X1+B4 COMPARE TERMINATOR ZR X6,WTCFIN TEXT COMPLETE IF COMMA OR SEMICOLON BX4 X4+X2 ADD CHARACTER TO CURRENT TEXT WORD SB2 B2-B3 PL B2,WTCPACK JUMP TO CONTINUE IF NOT YET A FULL WORD BX7 X4 SA7 A4 STORE COMPLETED WORD OF TEXT INFO SX3 X3+1 INCREMENT TEXT STORAGE POINTER SA4 A4+B1 INCREMENT TEXT WORD ADDRESS MX4 0 CLEAR NEXT TEXT STORAGE WORD SB2 54 RESET SHIFT COUNT EQ WTCPACK * * /--- BLOCK EXACTC 00 000 76/01/26 14.44 WTCFIN BX7 X4 SA7 A4 STORE CURRENT TEXT INFO WORD BX4 X3 X4 = CURRENT TEXT WORD ADDRESS SA3 A3 X3 = ORIGINAL TEXT WORD ADDRESS BX6 X4 SA6 A3 UPDATE ADDRESS OF CURRENT TEXT WORD SX6 B2 X6 = CURRENT SHIFT COUNT (ORIGINAL IN X5) SA6 A5 UPDATE SHIFT COUNT BX7 X3 BEGIN BUILDING INFO PACKAGE IN X7 SX2 54 IX2 X2-X5 COMPUTE SHIFT COUNT NEEDED FOR EXECUTION LX7 6 BX7 X7+X2 ADD SHIFT COUNT TO INFO PACKAGE BX2 X5 BEGIN TRICKY EQUIVALENT OF DIVIDE BY 6 LX2 1 *2 IX5 X5+X2 *3 LX2 2 *8 IX5 X5+X2 *11 AX5 6 /64 X5 = ORIGINAL SHIFT COUNT / 6 BX2 X6 DO ANOTHER TRICKY DIVIDE LX2 1 IX6 X6+X2 LX2 2 IX6 X6+X2 AX6 6 X6 = FINAL SHIFT COUNT / 6 IX4 X4-X3 X4 = FINAL STORAGE WORD POINTER - ORIGINAL IX3 X5-X6 X3 = 1ST WORD CHAR COUNT IF ALL IN ONE WORD ZR X4,WCSTOR JUMP IF ALL TEXT IN ONE WORD BX2 X4 LX4 3 *8 LX2 1 *2 IX4 X4+X2 X4 = DIFFERENCE IN TEXT POINTERS * 10 * /--- BLOCK EXACTC 00 000 76/07/24 20.52 SX4 X4-1 IX4 X4-X6 X4 = COUNT OF CHARACTERS IN FOLLOWING WORDS SX3 X5+B1 X3 = COUNT OF CHARACTERS IN 1ST WORD WCSTOR LX7 4 BX7 X7+X3 ADD CHARACTER COUNT FOR 1ST WORD LX7 8 BX7 X7+X4 ADD CHARACTER COUNT FOR FOLLOWING WORDS SA2 WCTADR X2 = CURRENT TABLE ADDRESS SA3 INFO+X2 X3 = CURRENT TABLE WORD SA4 CONV3 X4 = CURRENT NUMBER OF TABLE ENTRIES BX6 X3+X7 ADD NEW ENTRY LX4 59 NG X4,WCODD JUMP OF ODD NUMBERED TABLE ENTRY LX6 30 POSITION AT TOP SA6 A3 STORE UPPER (EVEN) ENTRY WCNEXT LX4 1 SX7 X4+B1 INCREMENT NUMBER OF TABLE ENTRIES SA7 A4 ZR X1,WRTCIN1 JUMP IF AT END-OF-LINE SA1 A1+B1 NZ X1,WTCLOOP JUMP TO MAIN LOOP IF NEXT CHAR NOT E-O-L EQ WRTCIN1 OTHERWISE, CHECK FOR CONTINUATION * WCODD SA6 A3 STORE COMPLETED TABLE WORD (ODD ENTRY) SX7 X2-1 DECREMENT TABLE ADDRESS SA7 A2 MX6 0 SA6 A3-B1 CLEAR NEXT TABLE WORD EQ WCNEXT * * WCTADR BSS 1 CURRENT TABLE ADDRESS (RELATIVE) WCSHFT BSS 1 SHIFT COUNT FOR NEXT CHARACTER LFTFLG DATA 0 LEFT WRITING FLAG * ENDOV * /--- BLOCK INITIAL-1 00 000 81/06/07 02.16 TITLE INITIALIZATIONS * EXT MESSBUF DAYFILE MESSAGE BUFFER * INITOV OVRLAY SA5 APLACOM (X5) = COMMUNICATION AREA SX0 PC.ACC IX0 X0+X5 SA0 ACCOUNT RE 2 READ ACCOUNT AND LESSON NAME RJ ECSPRTY MX0 6 SA1 LESSON CHECK FOR VALID LESSON NAME BX1 X0*X1 ZR X1,CABORT2 SX0 PC.SYS IX0 X0+X5 SA0 SYSFLG SYSTEM/NON-SYSTEM FLAG + RE 1 RJ ECSPRTY SX0 PC.STOR PACKED DESCRIPTORS OF CONDEN IX0 X0+X5 RETURN INFO SA0 COPTION CONDENSOR OPTIONS RE 1 RJ ECSPRTY SX0 PC.SRCA IX0 X0+X5 SA0 WORK RE 2 READ SOURCE FILE NAME RJ ECSPRTY SX0 PC.BADR IX0 X0+X5 SA0 CONBUFF ADDRESS OF BUFFER FOR BINARY + RE 1 RJ ECSPRTY SX0 PC.BLTH IX0 X0+X5 SA0 CBLTH LENGTH OF BINARY BUFFER + RE 1 RJ ECSPRTY * SA1 LESSON SET UP B-DISPLAY MESSAGE BX7 X1 SA7 MESSBUF CALL S=BMSG,MESSBUF * * SA1 SYSCLOK STORE TIME AT START OF CONDENS BX6 X1 SA6 RTBEG STORE REAL TIME CLOCK CALL S=CTIME,CTBEG STORE CPU CLOCK * * SET UP FILE POINTERS / OPEN FILE * SB2 FREQ OPEN THE FILE SA0 CBUF SA1 AFILEBF SA2 WORK RETRIEVE SOURCE FILE NAME SA3 WORK+1 (TWO WORDS) RJ =XOPEN NZ X6,CABORT2 IF CANNOT OPEN FILE SA1 COPTION SET CSTOADR = ECS ADDR OF USERS * STORAGE FOR RETURN INFORMATION FROM CONDENSOR BX2 X1 AX2 XCODEAL MX3 -24 BX6 -X3*X2 SA6 CSTOADR BX0 X6 ZERO OUT S1 (WHICH CONTAINS * BUFFER LENGTH POINTERS) ZR X6,NOCSTO UNLESS NO -STORAGE- * MX6 0 WX6 X0 NOCSTO BSS 0 BX6 X2 CSTOLEN = LENGTH OF STORAGE AX6 24 SA6 CSTOLEN * /--- BLOCK INITIAL-1 00 000 81/07/28 01.50 IX6 X6+X0 CSTOLWA = LWA OF STORAGE SA6 CSTOLWA * * OPEN OPTION BITS INTO FULL WORDS FOR FAST * CHECKS DURING CONDENSE * SB3 COPTNUM B3 = NUMBER OF OPTIONS SB2 B0 B2 = OPTION POINTER SB1 1 B1 = 1 MX2 -1 COPTLP BX6 -X2*X1 ISOLATE NEXT OPTION BIT SA6 COPTS+B2 STORE IN NEXT OPTION ELEMENT SB2 B2+B1 AX1 B1 POSTION NEXT OPTION BIT NE B2,B3,COPTLP IF MORE OPTIONS BITS TO OPEN * * * * GET TRUE COPY OF COMMANDS AND HASH INFO INTO CM * SA1 CMNDTBL BX0 X1 SA0 COMNAMS SA1 CMNDINF + RE =XCOMNAML READ COMMAND NAME TABLE RJ ECSPRTY BX0 X1 SA0 =XCOMINFO + RE =XCOMINFL READ HASHED INFO TABLE RJ ECSPRTY * * * -ERRINIT- (INITIALIZE BUFFER POINTERS) * * SA1 ACEBUF ABSOLUTE ADDRESS OF CEBUF SX6 MAINHDL LENGTH OF MAIN HEADER IX6 X1+X6 SA6 PCEBUF NEXT AVAILABLE LOC IN CEBUF SX6 B0 SA6 ERRCNT SA6 ERRTOT SA6 ZCONDOK =0 NOTSET ZCONDOK,=1 SET IT SX6 1 SA6 UBLKNM SA6 ULINENM RJ UERRSET INTIALIZE *HEAD* WORD SX6 VARLIM-MAINHDL SA6 LCEBUF SPACE LEFT FOR SUBROUTINES * SX7 0 SA7 TSPECS CLEAR SPECS FLAG SA7 SAYFLAG CLEAR SAY FLAG SA3 ACLSTAT SX1 SCLESNS IX0 X3+X1 SA0 SCONTMP READ FROM ECS,TOTAL NUMBER OF LESSON CONDEN + RE 1 RJ =XECSPRTY SA1 SCONTMP SX3 1 IX6 X1+X3 INCREMENT TOTAL COUNT SA6 A1 + WE 1 WRITE BACK IN ECS RJ =XECSPRTY * /--- BLOCK INITIAL-2 00 000 81/06/07 02.18 * SA1 CONBUFF ADDRESS OF BINARY BUFFER SX6 LESHEAD IX0 X1+X6 SA0 ACCOUNT WE 2 WRITE OUT LESSON/ACCOUNT NAMES RJ ECSPRTY SX7 2 IX6 X0+X7 POINT TO NEXT WORD IN ECS SA6 CONDPNT INIT NEXT AVAIL WORD IN FORMING BINARY * SA1 AZERBUF ZEROED ECS BUFFER BX0 X1 SA0 WORK + RE 1000 RJ ECSPRTY SA1 AGROUP INITIALIZE -GROUP- TABLES BX0 X1 + WE 4*NKGROUP RJ ECSPRTY SX7 0 X7 = 0 SA7 ECSARGS NO ECS ARGS YET SA7 UEFLAG CLEAR TO CURRENTLY DOING UNIT (NOT ENTRY) SA7 CUNITS ZERO UNIT SO FAR SA7 COMPNAM SA7 CSYMADD SA7 JJVOCU SET TO NO VOCABULARY YET SA7 TERMS NUMBER OF TERMS IN LESSON RESET SA7 NDEFN NUMBER OF DEFNS SA7 NOUNIT NO UNIT COMMANDS YET SA7 COMREFF SA7 CCDFLG SA7 CCOMX CLEAR -COMMONX- WORD SA7 XSTORL CLEAR XSTOR LENGTH SA7 RVARL CLEAR ROUTER VARIABLE LENGHT SA7 LVARL CLEAR LOCALS STACK SIZE SA7 LVARN CLEAR NUMBER OF LOCALS SA7 LOCAL CLEAR LOCALS FLAG SA7 CCOMLES SET TO NO COMMON SA7 CCOMACT SA7 CCOMNAM SA7 CCOMLTH SA7 CCOMBIT SA7 USEBCNT NUMBER OF BLOCKS USED SA7 =XPPTMF PPT COMMAND MESSAGE FLAG * SX6 VARS SA6 PVARS BASE LOCATION FOR DEFINED NAMES SX6 -1 SA6 SSSTOP SET START/STOP SWITCH SA6 DSET INITIALIZE DEFINE SET NUMBER SB1 1 SB2 TOKADDS DEFINE DIRECTORY INITIALIATIONS SB3 NAMADDS SB4 TOKLENS SB5 NAMLENS SB6 SETNAMS SB7 -1 INITIALIZE NULL SET ALSO SA1 ADEFNEC ADDR OF ECS DEFINE BUFFER BX6 X1 SX1 DECSLTH LENGTH OF DEFINED BUFFER IX6 X6+X1 (X6) = END OF ECS DEF BUFF + 1 MX7 0 * * /--- BLOCK INITIAL-3 00 000 81/06/07 02.18 DFADLP BSS 0 SA6 B2+B7 TOKADDS SA6 B3+B7 NAMADDS SA7 B4+B7 TOKLENS SA7 B5+B7 NAMLENS SA7 B6+B7 SETNAMS SA7 UNTLENS+B7 NUMBER OF DEFINED UNITS SB7 B7+B1 SX5 B7-MAXSET NZ X5,DFADLP * SA1 ADEFNEC ADDR OF ECS DEFINE BUFFER BX6 X1 SA6 TOKADDS-1 NULL SET OPEN * * FAKE UNIT 0 = TERMS * FAKE UNIT 1 = DEFNS * FAKE UNIT 2 = JUDGING SYMBOLS * UNIT 3 = INITIAL ENTRY UNIT * SA1 KOIEU GET PROPER NAME FOR INITIAL ENTRY UNIT BX7 X1 SA7 UNAME+IEUNUM STORE AWAY IN UNIT-NAME-TABLE SX6 IEUNUM X6 = UNIT NUMBER SA0 A7 SA1 AUNAME AND WRITE OUT TO ECS-UNIT-NAME-TABLE IX0 X1+X6 + WE 1 RJ ECSPRTY * * SA6 UNUMON SET UNIT WORKING ON POINTER SA6 UNIT LAST UNIT OR ENTRY CONDENSED MX7 1 SET TOP BIT TO MARK NOT IN SA7 ULOC+X6 SX6 X6+1 SA6 UNUMIN COUNT OF UNITS PROCESSED * SA1 BLANK8 BX6 X1 SA6 =XOLDCMND INITIALIZE OLDCMND TO 8 BLANKS * * INITIALIZE FOR ENTRY UNIT * SX6 INFOLTH SA6 ICX INITIALIZE COMMAND POINTER SX7 0 SA7 INX EXTRA STORAGE POINTER SA7 LOCARO ARROW LOCATION (*INFO* OFFSET) SA7 =XCALCACT SET TO NO -CALC- ACTIVE SA7 NGLOBAL NUMBER OF GLOBAL SYMBOLS SA7 MAKESYM FOR FAKE STATEMENT LABELS SA7 NDOOFF NUMBER OF DEFERRED -DOTO- SA7 DOBFPNT -DOTO- ECS POINTER SA7 NDEFERR NUMBER OF DEFERRED REFERENCES SA7 =XNLABELS NUMBER OF LABELS SA7 GSYMERR1 GLOBAL SYMBOL ERROR FLAGS SA7 GSYMERR2 * /--- BLOCK INITIAL-4 00 000 76/11/11 01.38 * * ZERO OUT ECS ENDINGS BUFFERS * SA1 AZERBUF GET ADDRESS OF ZERO BUFFER BX0 X1 SA0 WORK + RE 80 ZERO OUT THE ENDINGS BUFFER RJ ECSPRTY SA1 XBEND ADDRESS OF ENDINGS BUFFER BX0 X1 + WE 80 RJ ECSPRTY * * GET TRUE COPY OF CHARACTER SYMBOL TABLE FOR CONTENT * SA0 CONTAB READ CONTENT SYMBOL TABLE TO CM BUFFER SA1 ACONTAB GET ADDRESS OF ECS BUFFER BX0 X1 + RE 129 TWO 64-WORD TABLES + 1 INFO WORD RJ ECSPRTY * MX6 0 CLEAR DUMMY UNIT FOR JUDGING SYMBOLS SX2 JSYMNUM SA6 UNAME+X2 HENCE USE SYSTEM SYMBOLS SA6 ULOC+X2 * * * CHECK ECS COMMAND CONDEN STATISTICS INFO BANK AND * SET ITS CM FLAG (TSCOMFG) ACCORDINGLY. SINCE TURN * ON/OFF OF COMMAND CONDEN STATISTICS IS CHECKED HERE ONLY AT * ENTRY (TO MINIMIZE OVERHEAD) IT DOES NOT TAKE EFFECT UNTIL * NEXT START OF LESSON CONDENSING (OR FINISHING OF * CONDENSING IN CASE OF TURNING OFF). * CSIST SA3 ACDSTAT (X3) = ECS ADDR OF STATS BUFFER ZR X3,SETCFG1 EXIT IF NO STATS BUFFER BX0 X3 (X0) = ECS ADDR OF STATS BUFFER SA0 SCONTMP (A0) = ADDR OF CM COPY RE SCOMNDH READ PARAMETERS FROM PLATO RJ =XECSPRTY SA1 SCONTMP+SCOMFG1 SEE IF STATS DESIRED ZR X1,SETCFG1 IF NOT REQUESTED SA1 SCONTMP+SCOMLES SEE IF FOR SPECIFIC LESSON SX7 1 ZR X1,SETCFG2 IF 0, GET STATS FOR ALL LESSONS CALL FCOMPAR,(SCONTMP+SCOMACT),ACCOUNT ZR X6,SETCFG2 IF YES SETCFG1 MX7 0 NO STATISTICS SETCFG2 SA7 TSCOMFG SET CM FLAG ACCORDINGLY ZR X7,INI300 IF NOT TAKING STATISTICS SA1 SCONTMP+SCOMZER SEE IF SHOULD ZERO BUFFER ZR X1,INI300 IF BUFFER NOT TO BE ZEROED SA1 AZERBUF (X1) = ADDR OF ZERO ECS BUFFER BX0 X1 SA0 ZBUFFER (A0) = ADDR OF CM SCRATCH SPACE RE CMNDMAX ZERO CM BUFFER RJ ECSPRTY SX1 SCOMNDS (X1) = OFFSET TO STATS IX0 X1+X3 (X0) = WHERE TO START ZEROING WE CMNDMAX ZERO THE BUFFER RJ ECSPRTY * /--- BLOCK INITIAL-4 00 000 76/11/11 01.38 MX6 0 SX1 SCOMZER IX1 X1+X3 WX6 X1 ZERO REQUEST TO ZERO BUFFER SX1 SCOMNDN IX1 X1+X3 WX6 X1 ZERO TOTAL COMMANDS SX1 SCOMNDT IX1 X1+X3 WX6 X1 ZERO TOTAL TIME * GO THROUGH THE PRELIMINARY CHECKS AGAIN IN CASE * PLATO CHANGED THE PARAMETERS WHILE THESE CHECKS * WERE IN PROGRESS. OTHERWISE WE COULD TAKE STATS * ON THE WRONG LESSON, AND THE BUFFER WOULD NOT BE * CLEARED AGAIN. EQ CSIST * /--- BLOCK INITIAL 00 000 81/05/08 04.28 * * INITIALIZE PPT-TUTOR BUFFERS/VARIABLES * INI300 MX6 0 SA6 PPTF MARK NOT CONDENSING PPT-TUTOR SA6 CVUF MARK CALC OVERLAYS NOT ASSIGNED SA6 PPTVERS INITIALIZE VERSION SA6 PUNITN UNIT COUNTER SA6 PISTU 1ST PHYSICAL UNIT NUMBER SA6 IUNUM CURRENT UNIT NUMBER SA6 PDEFNS NUMBER OF DEFINED NAMES SA6 PSETNAM CURRENT DEFINE SET NAME SA6 PVARSIZ CURRENT VARIABLE SIZE SA6 NVBYTES NUMBER VARIABLE BYTES ALLOCATED SA6 DEFP DEFINE BYTE/SHIFT/ADDR WORD SX6 777B SA6 PCHRLIM MARK CHARSET LIMIT NOT SET YET SA1 AZERBUF X1 = ADDRESS OF ZEROED ECS BUFF BX0 X1 SA0 UNITTAB+2 + RE PUNITL PRE-ZERO UNIT NAME TABLE RJ ECSPRTY * * /--- BLOCK INITIAL-5 00 000 81/06/29 12.33 * * THE FOLLOWING CODE HANDLES THE SPECIAL * PROCESSING REQUIRED ON FIRST READ OF A LESSON. * SX7 0 SA7 USEINFO CLEAR USE FILE COUNT SA7 USEFLAG NOT PROCESSING -USE-D CODE SA7 BLKCNT INITIALIZE BLKCNT AND LINECNT SA7 LINECNT SA7 STOPFLG ZERO MEANS *CSTART* SA7 INDENT LAST LINE HAD NO INDENTING SA7 PISTACK INITIALIZE STACK POINTER SA7 ISTACK CLEAR FIRST ELEMENT OF STACK SX6 -1 SA6 NEWBLK FIRST LINE MAY NOT BE INDENTED SA0 CBUF BUFFER SA1 AFILEBF BX0 X1 RE BLKLTH DIRECTORY FOR CURRENT LESSON RJ =XECSPRTY * * INITIALIZE MICRO-TUTOR RELEASE LEVEL FROM LESSON * DIRECTORY * SX2 4 X2 = BIAS TO BASE OF INFO SB2 X2+O.APRIV BIAS TO ACCESS PRIVILEGE WORD SA1 A0+B2 LX1 60-OPV.MR+OPV.MRN-1 MX6 -6 FORM MASK FOR M-TUTOR RELEASE BX6 -X6*X1 MASK OFF M-TUTOR RELEASE LEVEL + NZ X6,*+1 SX6 1 SET RELEASE 0 = RELEASE 1 + SA6 MTREL INITIALZE RELEASE LEVEL SX6 400B BX6 X6*X1 SET M-TUTOR CENTRAL SYSTEM SA6 MTCENF EXECUTION FLAG SX6 200B SET THE CENTRAL MICRO PLATO FLAG BX6 X1*X6 SA6 CMPF * * * INITIALIZE FILE UPDATE LEVEL * SB2 X2+O.UPD8 OFFSET TO UPDATE LEVEL SA1 A0+B2 SX6 X1-MINUPD8 CHECK FOR OBSOLESCENCE NG X6,=XOBSFILE BX6 X1 SA6 FLEVEL STORE FILE UPDATE LEVEL * * /--- BLOCK INITIAL-5 00 000 80/08/19 04.17 * ****** HOPEFULLY TEMPORARY CODE FOR PPT-COMMANDS MX6 -1 MARK PPT-COMMANDS LEGAL SA6 =XPPTACC * GET ACCOUNT NAME OF FILE SB2 X2+O.ACNAM OFFSET TO ACCOUNT NAME SA1 A0+B2 MX7 42 BX7 X7*X1 * NON-SERVICE SYSTEMS SA1 CSYSNAM BX6 X1 SA1 PPTNAMS+0 BX1 X6-X1 NZ X1,PPTM2 IF NOT FSU SYSTEM SA1 ACCNAMS+0 CHECK GOOD ACCOUNTS BX1 X7-X1 ZR X1,PPTM1 SA1 ACCNAMS+1 BX1 X7-X1 ZR X1,PPTM1 SA1 ACCNAMS+2 BX1 X7-X1 ZR X1,PPTM1 EQ PPTM3 PPTM2 SA1 PPTNAMS+1 BX1 X6-X1 NZ X1,PPTM3 IF NOT UOFDEL SYSTEM SA1 ACCNAMS+3 BX1 X7-X1 ZR X1,PPTM1 * ALLOW IN SYSTEM LESSONS AND SPECIAL LESSONS PPTM3 SA1 SYSFLG LX1 ZPPTSHF NG X1,PPTM1 * MARK ILLEGAL ELSEWHERE MX6 0 SA6 =XPPTACC EQ PPTM1 * /--- BLOCK INITIAL-5 00 000 81/07/29 02.50 PPTNAMS DATA 3LFSU DATA 3LDL1 ACCNAMS DATA 7LARAMEAU DATA 6LAMUSIC DATA 6LAUIMUS DATA 6LUOFDEL PPTM1 BSS 0 ****** HOPEFULLY TEMPORARY CODE FOR PPT-COMMANDS SA1 A0+1 GET TYPE WORD SA2 ROUTYPE BX2 X1-X2 MX6 0 PRESET NOT A ROUTER NZ X2,SETROUT SX6 1 * SETROUT SA6 ROUTER SET ROUTER LESSON FLAG SA1 A0+EXTRAI+51 GET SPECIAL TYPE WORD SX2 APPTYPE MX6 0 PRESET NOT AN APPLIC LESSON MX0 -6 TYPE IN BOTTOM 6 BITS BX1 -X0*X1 ISOLATE SPECIAL TYPE IX1 X1-X2 TEST TYPE NZ X1,SETAPPL SX6 1 SETAPPL SA6 APPLESS SET APPLIC. LESSON FLAG * * SEE FILE GETLIN FOR MORE COMPLETE COMMENTS * A5 = POINTS TO SOURCE WORD BEING PROCESSED * B5 = BLOCK END TEST MARKER (ONE PAST LAST WORD) * SB1 1 -GETCMD- ASSUMES B1 SET SB5 CBUF+1 B5 = END TEST MARKER SA5 B5-1 SET TO FORCE READ OF NEXT BLOCK CALL GETCMD GET 1ST COMMAND (SETS *IEND*) SX6 A5 SA6 IST SAVE POINTER TO NEXT COMMAND EQ NXTLINE * /--- BLOCK -ABORTC- 00 000 81/06/07 03.07 CABORT2 SX6 1 1 = BAD LESSON NAME SA6 IOBUFF SA1 LESSON BX6 X1 SA6 A6+1 RJ =XABORTC EQ =XCONDENS * * /--- BLOCK FCOMPAR 00 000 80/07/14 15.01 TITLE -FCOMPAR- COMPARE FILE NAMES * * -FCOMPAR- * * COMPARES TWO 2-WORD FILE NAMES. * * THE ACCOUNT PORTION OF A FILE NAME STORED WITHIN * PLATO HAS THE FOLLOWING FORMAT'; * * 42/ACCOUNT NAME, 6/ATTRIBUTE FLAGS, 12/UNDEFINED * * THE TOP ATTRIBUTE FLAG INDICATES AN ORIGINAL (OLD-STYLE) * FILE. THE OTHER ATTRIBUTES ARE NOT YET USED. * * THE SECOND NAME PASSED TO -FCOMPAR- MUST BE COMPLETE. * I.E., FILE NAME, ACCOUNT NAME, AND ALL ATTRIBUTES * MUST BE KNOWN. THE FIRST NAME MAY BE INCOMPLETE, BUT * THE FILE NAME MUST BE SPECIFIED. IN ORDER FOR A * MATCH TO BE INDICATED, ALL KNOWN PROPERTIES OF THE * SECOND NAME MUST MATCH THOSE OF THE FIRST NAME. * I.E., THE FILE NAMES MUST MATCH, THE ACCOUNT NAME OF * THE SECOND FILE (IF NON-ZERO) MUST MATCH THE FIRST * ACCOUNT NAME, AND ALL ATTRIBUTE FLAGS SET FOR THE * SECOND NAME MUST ALSO BE SET FOR THE FIRST NAME. * * ENTRY - B1 = ADDRESS OF FIRST FILE NAME * B2 = ADDRESS OF SECOND FILE NAME * * EXIT - X6 = 0 IF MATCH, NON-ZERO IF NOT * * USES - A1, A2 * X0, X1, X2, X6 * * /--- BLOCK FCOMPAR 00 000 80/07/14 15.01 * * FCOMPAR EQ * SA1 B1+1 LOAD FIRST FILE NAME SA2 B2+1 LOAD SECOND FILE NAME IX6 X1-X2 COMPARE NZ X6,FCOMPAR --- EXIT IF NO MATCH * SA1 B1 X1 = FIRST ACCOUNT WORD SA2 B2 X2 = SECOND ACCOUNT WORD MX0 48 MASK FOR NAME + ATTRIBUTES BX1 X0*X1 ELIMINATE JUNK IN LOW 12 BITS BX2 X0*X2 BX6 X1-X2 COMPARE ACCOUNT WORDS ZR X6,FCOMPAR --- EXACT MATCH * BX6 X1*X2 MASK ACCOUNT WORDS TOGETHER BX6 X6-X1 COMPARE RESULT WITH 1ST WORD NZ X6,FCOMPAR --- NO MATCH * MX0 42 MASK FOR ACCOUNT NAMES ONLY BX6 X0*X1 1ST ACCOUNT NAME ZR X6,FCOMPAR --- MATCH IF 1ST NAME IS ZERO * BX2 X0*X2 2ND ACCOUNT NAME BX6 X6-X2 COMPARE NAMES EQ FCOMPAR * * * BLANK8 VFD 60/55555555555555550000B TO INITIALIZE OLDCMND ROUTYPE VFD 60/10LROUTER A APPTYPE EQU 2 APPLICATION LESSON TYPE EXTRAI EQU 4 OFFSET INTO DIRECTORY EXTRA INFO KOIEU VFD 12/0,48/3RIEU * ZBUFFER OVDATA CMNDMAX * ENDOV * /--- BLOCK LESLIST 00 000 77/03/19 17.00 * * TITLE -LESLIST- ORIENTED COMMANDS * * LISTOV OVRLAY SA1 OVARG1 SB3 X1 JP B3+* * + EQ * UNUSED AS OF 3/14/77 --M4 + EQ ADDLC + EQ LNAMEC + EQ FINDLC * * * * -ADDLST- COMMAND * ADDS A LESSON NAME TO *LESLIST* * * ADDLC SB1 FSADDLS -ADDLST- IS PUBLISH ERROR RJ =XPUBERRS RJ COMPILE EVALUATE NAME VARIABLE NZ B1,ERRSTOR ERROR IF NOT STOREABLE BX6 X1 LX6 60-XCODEL POSITION -GETVAR- CODE SA2 LASTKEY ZR X2,PUTCODE EXIT IF ONLY ONE ARGUMENT MX2 1 BX6 X2+X6 SET BIT FOR TWO ARGUMENT SA6 VARBUF CALL COMPILE EVALUATE INDEX LX1 60-XCODEL-XCODEL SA2 VARBUF BX6 X1+X2 MERGE -GETVAR- CODES EQ PUTCODE * * /--- BLOCK LESLIST 00 000 76/07/25 07.58 * * * -LNAME- COMMAND * RETURNS DISPLAY FORMATTED NAME FROM *LESLIST* * * LNAMEC CALL COMPILE EVALUATE NAME VARIABLE NZ B1,ERRSTOR MUST BE STOREABLE LX1 60-XCODEL POSITION -GETVAR- CODE BX6 X1 SA6 VARBUF CALL COMPILE EVALUATE INDEX VARIABLE LX1 60-XCODEL-XCODEL SA2 VARBUF BX6 X1+X2 COMBINE -GETVAR- CODES EQ PUTCODE * * * * -FINDL- COMMAND * CHECKS TO SEE IF LESSON IS ENTERED IN LESLIST * * FINDLC CALL COMPILE GET FIRST ARGUMENT NZ B1,ERRSTOR BX6 X1 SAVE -GETVAR- CODE SA6 VARBUF CALL PUTCOMP COMPILE CODE TO STORE 2ND ARG LX1 60-XCODEL-XCODEL SA2 VARBUF LOAD FIRST -GETVAR- CODE LX2 60-XCODEL BX6 X1+X2 COMBINE -GETVAR-/-PUTVAR- CODES EQ PUTCODE * * * ENDOV * /--- BLOCK CHANGE 00 000 76/10/06 03.01 TITLE CHANGE * * CHANGE COMMAND---ONLY IN CONDENSOR * * CHGOV OVRLAY * RJ NXTCH GET FIRST ENTITY CHG1 ZR X6,ERRNAME * SA6 CHTABX STORE THIS WORD AT END OF SEARCH SB1 1 SA4 CHTAB-1 * CHLP SA4 A4+B1 FIND WHAT TYPE OF CHANGE COMMAND BX2 X4-X6 NZ X2,CHLP LOOP THRU ALL POSSIBLILIES SB1 A4-CHTAB GET INDEX JP CHJP+B1 JUMP TO PROPER ROUTINE * CHJP EQ CHCMD COMMAND EQ CHSYM SYMBOL .CLANG IFGT CLANGS,1 EQ CHLANG LANGUAGE EQ CHENDL PUT IN SET OF NEW LANGUAGE COMMANDS .CLANG ENDIF EQ ERRNAME NO FIND * CHTAB DATA 8LCOMMAND TUTOR COMMANDS CHTABSL DATA 8LSYMBOL CHARACTER SYMBOLS IN JUDGING .CLANG IFGT CLANGS,1 DATA 8LCOMMANDS CHANGE COMMANDS TO DIFFERENT LANGUAGE DATA 8LENDCMNDS PUT IN NEW SET OF COMMAND FOR DIFF LANGUAGE .CLANG ENDIF CHTABX DATA 0 * SPACE 6 * CHANGE COMMAND X TO Y * CHANGE THE NORMAL NAME OF A TUTOR COMMAND * TO SOMETHING ELSE FOR THIS CONDENSE * WHERE X IS NORMAL TUTOR COMMAND AND Y IS NEW NAME * (THE WORD -TO- IS OPTIONAL) * * /--- BLOCK CH-COMMAND 00 000 81/07/17 15.09 * CHCMD RJ NXTCH GET NEXT WORD ZR X6,ERRNAME * * CHCMD1 SA6 CHGTEMP SA6 CHGTEMP NO DEFAULT CASE NOW.LAW7/18/76 RJ NXTCH GET NEXT ENTITY ZR X6,ERRNAME SA1 LTO =8LTO BX2 X1-X6 FORMAT IS -CHANGE X TO Y NZ X2,CHGIT BUT -CHANGE X Y - IS ALSO OK RJ NXTCH GET NEXT ENTITY ZR X6,ERRNAME CHGIT SA2 CHGTEMP * COME HERE WITH X2 AND X6 SET (I.E. CHANGE X2 TO X6). *CALL MACROS ADR MICRO 1,,/A0/ A0 = START OF HASH TABLE COM MICRO 1,,/COMNAMS/ SA0 =XCOMINFO COMINFO IS HASH TABLE LIST G * LOCATE OLD NAME IN TABLE HASH X2,X1,A3 X1 = HASH CODE FOR *FROM* NAME FIND X2,X1,CHGITA,B2,X0,B1,B3,B4,A3 EQ ERRNAME ERROR IF NAME NOT FOUND * MAKE SURE NEW NAME IS NOT IN TABLE CHGITA HASH X6,X5,A3 X5 = HASH CODE FOR *TO* NAME FIND X6,X5,ERRORC,B6,X4,B5,B3,B4,A3 * STORE NEW NAME IN NAME TABLE SA6 =XCOMNAMS+B1 * REMOVE LINKS TO OLD HASH INFO DELLINK B2,B3,X3,B4,B5,A4,A7 * ADD LINKS TO NEW HASH INFO SB5 X5 HASH CODE FOR NEW NAME ADDLINK B5,B3,X3,B7,A4,A7 * SA2 UNUMON WARN THAT ALL CHANGE COMMANDS SX3 IEUNUM MUST BE IN IEU BX3 X2-X3 ZR X3,NXTLINE SB1 69 ERROR NUMBER FOR -CONDERR- RJ =XRJERR EQ NXTLINE * NXTCH EQ * FIND THE NEXT ENTITY SA1 WORDPT SB1 X1 SB2 60 SB3 6 MX6 0 * NXSK SA1 B1 SKIP LEADING SPACES SX2 X1-1R SPACE NZ X2,CNLL SB1 B1+1 EQ NXSK * CNLL SA1 B1 LOAD NEXT CHAR ZR X1,CNLL5 SB1 B1+1 SX2 X1-1R TEST FOR SPACE ZR X2,CNLL5 SB2 B2-B3 GE B3,B2,ERRNAME BAD IF OVER 8 CHARS LX1 X1,B2 BX6 X6+X1 ADD TO WORD-A-BUILDING EQ CNLL CNLL5 ZR X6,CNLL8 CNLL6 SB2 B2-B3 NOW FILL REST WITH SPACES TO 8 CHARS GE B3,B2,CNLL8 SX1 1R SPACE LX1 X1,B2 BX6 X6+X1 EQ CNLL6 CNLL8 SX7 B1 SA7 WORDPT EQ NXTCH * LTO DATA 8LTO LFTO VFD 60/75241755555555550000B (FONT)TO CHGTEMP BSS 1 TEMP STORAGE * /--- BLOCK CH-SYMBOL 00 000 78/02/13 22.38 TITLE CHANGE SYMBOL X TO Y * * * CHANGE SYMBOL X TO Y * * ALTERS THE STANDARD JUDGING VALUES OF CHARACTERS * CHSYM SA2 UNUMON CHANGE SYMBOLS ONLY IN IEU SX3 IEUNUM BX3 X2-X3 NZ X3,CHSERR1 SA2 CONTEST THIS MUST BE FIRST SYMBOL CHANGE SA3 CONTAB BX3 X2-X3 NZ X3,CHSERR2 SA2 LESSON SET JUDGING SYMBOL FLAG TO THIS LESSON BX6 X2 SA6 A3 SA2 COMMAND SAVE NAME OF THIS COMMAND FOR BX6 X2 LATER TESTING OF CONTINUED ADDITIONAL SA6 CHGNAME CHANGE COMMANDS ... THIS METHOD * ALLOWS FOR -CHANGE CHANGE TO WOW- CHSYM1 RJ NXTCH GET NEXT ENTITY MX5 0 INITIALIZE FONT FLAG RJ SYMBL GET FIRXT SYMBOL BX4 X1 SAVE CHARACTER TO CHANGE SB4 B2 AND SAVE SHIFT * RJ NXTCH GET NEXT ENTITY SA1 LTO SEE IF -TO- BX2 X1-X6 ZR X2,CHSYM3 SA1 LFTO SEE IF -(FONT)TO- BX2 X1-X6 NZ X2,CHSYM4 IF NOT, TRY FOR SECOND SYMBOL SX2 100B BX5 X2-X5 TOGGLE FONT * CHSYM3 RJ NXTCH GET NEXT ENTITY * * /--- BLOCK CH-SYMBOL 00 000 77/12/07 12.19 CHSYM4 ZR X6,ERRNAME THERE MUST BE SOMETHING THERE SA6 SYMTABX STORE INTO END OF SEARCH LIST SA1 SYMTAB-1 INITIALIZE START SB1 1 SYMLP SA1 A1+B1 LOAD SEARCH WORDS BX2 X1-X6 NZ X2,SYMLP CONTINUE UNTIL FIND MATCH SB1 A1-SYMTAB CALCULATE NUMBER MATCH JP SYMJP+B1 SYMJP SX1 COPLET SET TO LETTER (CONSONANT) EQ SYMDO + SX1 COPVOWL SET TO LETTER (VOWEL) EQ SYMDO + SX1 COPPUNC SET TO MISC. PUNCTUATION EQ SYMDO + SX1 COPPUWD SET TO PUNCTUATION AND WORD EQ SYMDO + SX1 COPNULL SET TO NULL CODE EQ SYMDO + SX1 COPDIAC SET TO DIACRITIC EQ SYMDO + EQ CHSYM5 NO FIND...TRY DIRECT CHANGE * SYMTAB DATA 8LLETTER CHANGE TO LETTER (CONSONANT) DATA 8LVOWEL CHANGE TO LETTER (VOWEL) DATA 8LPUNC CHANGE TO PUNCTUATION DATA 8LPUNCWORD CHANGE TO PUNC AND WORD DATA 8LNULL CHANGE TO NULL CODE DATA 8LDIACRIT CHANGE TO DIACRITIC CODE SYMTABX DATA 0 * SYMDO SA2 CONTAB+1+X4 GET OLD 15-BIT ENTRY LX2 X2,B4 GET 15-BITS TO TOP MX3 6 BX3 -X3*X2 BLANK OUT OPERATION CODE LX1 54 GET NEW OP CODE BX6 X1+X3 PUT NEW OP CODE WITH OLD INFO BITS EQ CHSUB NOW FINISH SUBSTITUTION * * CHSYM5 RJ SYMBL GET SECOND SYMBOL * SA2 CONTAB+1+X1 GET SUBSTITUTE WORD LX6 X2,B2 SHIFT TO GET 15-BITS TO TOP CHSUB MX7 15 NOW SUBSTITUTE NEW ENTITY FOR OLD BX6 X6*X7 GET 15-BITS SA4 X4+CONTAB+1 GET WORD TO CHANGE IN USER TABLE SB3 60 SB4 B3-B4 LX7 X7,B4 LX6 X6,B4 BX4 -X7*X4 ZERO OUT CODE TO CHANGE BX6 X4+X6 ADD NEW SYMBOL SA6 A4 AND RESTORE IN CURRENT USER TABLE * /--- BLOCK CH-SYMBOL 00 000 77/03/31 21.43 * SA2 WORDPT MAKE SURE THAT THE LINE IS EXHAUSTED SA2 X2 NZ X2,ERRTERM * CKSYMON SA1 NEXTCOM SEE IF NEXT COMMAND ANOTHER SYMBOL CHANGE SA2 COMCONT TEST AGAIN A BLANK COMMAND BX2 X1-X2 ZR X2,CHGOON SA2 CHGNAME GET NAME OF CHANGE COMMAND BX2 X1-X2 ZR X2,CHGOON * SA1 CONDPNT GET CURRENT READ-IN ECS POINTER BX0 X1 SA0 CONTAB GET ADDRESS OF CHANGED JUDGING SYMBOLS + WE 129 PUT SYMBOLS OUT AS DUMMY UNIT RJ ECSPRTY SX2 129 LENGTH = 1 LABEL + 2-64 WORD TABLES IX6 X1+X2 INCREMENT TO GET NEW LENGTH SA6 A1 AND STORE NEW LENGTH SA3 CONBUFF GET START OF CONDENSE BUFFER IX6 X1-X3 GET RELATIVE START OF TABLE LX6 ULOC2 BX6 X6+X2 PUT BIAS AND LENGTH TOGETHER LX6 ULOC3+ULOC4 BX6 X6+X2 AND AGAIN FOR TOTAL LENGTH LX6 60-ULOC1-ULOC2-ULOC3-ULOC4 SX3 JSYMNUM GET DUMMY UNIT NUMBER SA6 ULOC+X3 STORE RELATIVE ADDRESS AS UNIT NAME SA4 KJUDSYM SET UNIT NAME TO -JUDGESYM- BX6 X4 SA6 UNAME+X3 EQ NXTLINE ONTO NEXT COMMAND * KJUDSYM VFD 12/0,48/8LJUDGESYM * CHGOON RJ GETLINE GET NEXT LINE RJ NXTCH GET NEXT ENTITY ZR X6,ERRNAME SA2 CHTABSL SEE IF SYMBOL BX2 X2-X6 ZR X2,CHSYM1 GO ONTO NEXT SYMBOL CHANGE EQ CHG1 SEE IF ANOTHER TYPE OF CHANGE COMMAND * * CHSERR1 SB1 67 ONLY IN IEU EQ =XERR NO RETURN * CHSERR2 SB1 68 ALL SYMBOL CHANGES TOGETHER EQ =XERR NO RETURN * /--- BLOCK CH-SYMBOL 00 000 76/05/14 01.30 * SPACE 6 * SYMBL...RETURNS X1 WITH CHARACTER FROM 0-127 * AND B2 WITH SHIFT TO 15-BIT PACKAGE * SYMBOLS ARE CHECKED FOR LEGALITY SYMBL EQ * GET NEXT SYMBOL * SA6 SYMBLD SEE IF SPECIAL WORD CASE SA1 SYMBLT-1 PRE-SET FOR FIRST WORD TO SEARCH SB1 1 * SYMBLP SA1 A1+B1 GET NEXT WORD BX2 X1-X6 NZ X2,SYMBLP LOOP UNTIL MATCH SB1 A1-SYMBLT GET INDEX OF FOUND WORD SA1 SYMBLTD+B1 GET INFO WORD ZR X1,SYM0 ZERO MEANS TRY EXPLICIT CHARACTER OPTION SB2 X1 SET SHIFT COUNT AX1 30 AND SET CHARACTER EQ SYMBL * SYMBLT DATA 8LSPACE TABLE OF SPECIAL WORDS OF INVISIBLE CHARS DATA 8LSUP DATA 8LSUB DATA 8LSUPLOCK DATA 8LSUBLOCK DATA 8LBKSP DATA 8LCR * DATA 8LFSPACE F=ALTERNATE FONT CASE DATA 8LFSUP DATA 8LFSUB DATA 8LFSUPLOCK DATA 8LFSUBLOCK DATA 8LFBKSP DATA 8LFCR SYMBLD DATA 0 HOLDS PLANTED END TEST WORD * SYMBLTD VFD 30/55B,30/0 TABLE OF CHARACTER CODE AND SHIFT VFD 30/67B,30/0 THAT IS IN ONE-ONE CORRESPONDENCE VFD 30/66B,30/0 TO THE PREVIOUS TABLE VFD 30/67B,30/15 VFD 30/66B,30/15 VFD 30/74B,30/0 VFD 30/71B,30/0 * VFD 30/155B,30/0 VFD 30/167B,30/0 VFD 30/166B,30/0 VFD 30/167B,30/15 VFD 30/166B,30/15 VFD 30/174B,30/0 VFD 30/171B,30/0 DATA 0 * /--- BLOCK CH-SYMBOL 00 000 76/10/06 04.08 * SYM0 SB2 B0 NO SHIFT OR ACCESS YET MX0 54 * SYM1 LX6 6 GET NEXT CHARACTER BX1 -X0*X6 BX6 X0*X6 CLEAR OUT OF X6 ZR X1,SYMBLRR THERE MUST BE SOMETHING THERE SX2 X1-FONT SEE IF FONT NZ X2,SYM2 SX2 100B TOGGLE FONT BX5 X5-X2 EQ SYM1 * SYM2 SX2 X1-KUP SEE IF SHIFT CODE NZ X2,SYM3 NZ B2,SYM2A SEE IF ACCESS-SHIFT SB2 15 SET SHIFT SHIFT EQ SYM1 SYM2A SX2 B2-30 MAKE SURE ONLY ACCESS BEFORE NZ X2,SYMBLRR SB2 45 EQ SYM1 * SYM3 SX2 X1-ACCESS SEE IF ACCESS CODE NZ X2,SYM4 SB2 30 SET FOR ACCESS SHIFT EQ SYM1 * SYM4 IX1 X1+X5 ADD IN FONT TOGGLE * SYM5 LX6 6 ONLY SPACES LEFT BX2 -X0*X6 ZR X2,SYMBL SX3 X2-1R ZR X3,SYMBL SX3 X2-FONT ALLOW FONT AND DO TOGGLE NZ X3,SYMBLRR SX2 100B BX5 X5-X2 EQ SYM5 * * SYMBLRR SB1 66 SET TO SPECIAL MESSAGE RJ =XRJERR EQ CKSYMON AND CONTINUE TO NEXT LINE * CHGNAME BSS 1 THIS IS STORED INTO NEAR CHSYM * /--- BLOCK CH-LANGS 00 000 76/10/07 00.57 .CLANG IFGT CLANGS,1 TITLE CHANGE COMMANDS TO LANGUAGEX * * CHANGE ENDCMNDS LANGUAGEX * CHENDL RJ NXTCH GET NAME OF LANGUAGE ZR X6,ERRORC * SA3 LESSON SA4 KS0LANG LEGAL ONLY IN LESSON S0LANG BX4 X3-X4 NZ X4,ERRORC SA4 ACCOUNT LX4 42 SHIFT TO OLD-STYLE FLAG PL X4,ERRORC MUST BE AN OLD-STYLE FILE * CHEND1 SA1 CMNDLGS GET ECS ADDRESS OF LANGUAGE NAMES BX0 X1 SA0 CHWORK SB1 1 SB2 CLANGS NUMBER OF POSSIBLE LANGUAGES SX7 B1 MX2 0 BIAS TO THIS LANGUAGES TABLES SX3 CMNDMAX * CHENDLP RE 1 GET LANGUAGE NAME RJ ECSPRTY SA4 A0 ZR X4,CHENDF SEE IF FIND EMPTY SPOT BX4 X4-X6 SEE IF SHOULD CHANGE EXISTING TABLES ZR X4,CHENDF IX2 X2+X3 INCREMENT BIAS INTO TABLES SB2 B2-B1 IX0 X0+X7 INCREMENT NZ B2,CHENDLP EQ ERRORC * CHENDF SA6 A0 NOW STORE AWAY NEW LANGUAGE NAME + WE B1 RJ ECSPRTY SA1 CMNDTBL AND STORE AWAY CURRENT TABLES IX0 X1+X2 WITH PROPER BIAS SA0 COMNAMS + WE =XCOMNAML RJ ECSPRTY SA1 CMNDINF IX0 X1+X2 SA0 =XCOMINFO + WE =XCOMINFL RJ ECSPRTY * * NOW GET TRUE COPY OF COMMANDS AND HASH INFO INTO CM * SO WE GO ON WITH FRESH ENGLISH TABLES * SA1 CMNDTBL BX0 X1 SA0 COMNAMS + RE =XCOMNAML READ COMMAND NAME TABLE RJ ECSPRTY SA1 CMNDINF BX0 X1 SA0 =XCOMINFO + RE =XCOMINFL READ HASHED INFO TABLE RJ ECSPRTY EQ NXTLINE AND ONTO NEXT LINE * * CHWORK BSS 1 * /--- BLOCK CH-LANGS 00 000 76/10/06 23.15 TITLE CHANGE COMMANDS TO LANGUAGEX * CHLANG RJ NXTCH GET NEXT ENTITY ZR X6,ERRORC SA1 LTO SEE IF -TO- BX2 X1-X6 NZ X2,CHLANG1 RJ NXTCH ZR X6,ERRORC * * NOW SEARCH FOR DESIRED LANGUAGE NAME * CHLANG1 SA1 CMNDLGS GET ECS ADDRESS OF LANGUAGE NAMES BX0 X1 SA0 CHWORK SX7 1 MX2 0 BIAS TO THIS LANGUAGES TABLES SX3 CMNDMAX * CHLANGL RE 1 GET NEXT LANGUAGE NAME RJ ECSPRTY SA4 A0 ZR X4,ERRORC CANNOT FIND NAME...ZERO GUARANTEED END TEST BX4 X4-X6 SEE IF NAME LOOKING FOR ZR X4,CHLANG3 IX2 X2+X3 INCREMENT BIAS INTO TABLES IX0 X0+X7 INCREMENT EQ CHLANGL * CHLANG3 SA1 CMNDTBL NOW GET TABLES FOR THIS LANGUAGE IX0 X1+X2 WITH PROPER BIAS SA0 COMNAMS + RE =XCOMNAML RJ ECSPRTY SA1 CMNDINF IX0 X1+X2 SA0 =XCOMINFO + RE =XCOMINFL RJ ECSPRTY * EQ NXTLINE NOW ON WITH NEW COMMANDS .CLANG ENDIF * ENDOV * /--- BLOCK DRAW 00 000 79/12/15 22.06 TITLE CONDENSE DRAW COMMANDS * * DRAW P1;P2;P3;P4 -OR- DRAW ;P1;P2;P3 WHICH IS * EQUIVALENT TO DRAW WHERE;P1;P2;P3 . THIS CONTINUED * DRAW IS FLAGGED WITH SIGN BIT OF COMMAND WORD. * ALSO USED FOR GDRAW -- FROM -ORIGIN- AND SCALED. * ALSO USED FOR RDRAW -- RELATIVE, ROTATED, AND SIZED. * OVARG1 = 0 FOR DRAW * 1 FOR GDRAW * 2 FOR RDRAW * * THE VERTICES ARE PACKED UP INTO ONE OR TWO 20 BIT * PACKAGES. THE FIRST TWO PACKAGES ARE IN THE COMMAND * WORD, THE REST ARE IN EXTRA STORAGE. THE FIRST PACKAGE * CONTAINS THE NUMBER OF PACKAGES. * THE FIRST PACKAGE HAS LEFT BIT SET IF CONTINUED * COMMAND, NEXT BIT SET IF ALL VERTICES ARE PACKED 9BIT * CODES. REST OF PACKAGES ARE 2 BITS OF TYPE, 18 BITS * OF GETVAR CODE. 2BIT TYPE CODE AS FOLLOWS'; * 00=COARSE GRID -GETVAR- CODE * 01=FINE GRID -GETVAR- CODE (ONLY X-COORD MARKED) * 10=18 BIT CODE IS 9BIT-X,9BIT-Y * 11=SKIP * EXT RCTOXY * DRAWOV OVRLAY SA2 WORDPT SKIP OVER LEADING BLANKS SA1 X2-1 SX2 1R SB1 1 DRAWC1 SA1 A1+B1 LOOK AT NEXT CHARACTER IX7 X1-X2 ZR X7,DRAWC1 LOOP TILL NON BLANK * ZR X1,ERR2FEW IF NO TAGS SX7 A1 X7 = NEW VALUE FOR WORDPT MX6 0 ASSUME NOT CONTINUED DRAW SX2 X1-KSEMIC NZ X2,DRAWC2 IF NOT CONTINUED SX7 X7+B1 MOVE WORDPT PAST TERMINATOR MX6 1 CONTINUED DRAW LX6 XCODEL DRAWC2 SA6 TDRAW TYPE OF DRAW COMMAND SA7 A2 UPDATE WORDPT * RJ CONDRAW GETVAR CODES INTO VARBUF * SA1 LASTYPE NG X1,ERRXYTG -- ERROR, FINE X WITHOUT Y ZR X1,DRAWC3 -- OK, COARSE GRID * -SKIP- IS LAST TAG, BACKUP COUNTERS TO IGNORE IT SA1 VARBUF NUMBER OF GETVAR CODES SA2 VERTEX NUMBER OF VERTICES SX6 X1-1 SX7 X2-1 SA6 A1 SA7 A2 DRAWC3 BSS 0 * SA1 VERTEX LX1 1 TWICE THE VERTICES SX2 X1-SHAREL BUFFER FOR (X,Y) VALUES PL X2,ERR2MNY NOT ENOUGH EXECUTION ROOM * SA4 VARBUF A4 HOLDS ADR OF FIRST 20 BIT PACKAGE SX2 X1-2 SA1 TDRAW FLAG FOR FIRST ARG BLANK NZ X2,DRAWIN2 JUMP IF MORE THAN ONE VERTEX NZ X1,DRAWIN2 JUMP IF FIRST ARG BLANK * * IF ONLY ONE VERTEX, NEED TO DRAW A LINE FROM STARTING * POINT TO ENDING POINT (THAT IS, A DOT). FOLLOWING * CODE CAUSES PROBLEMS IF THE ARGUMENTS SPECIFYING THE * DOT CONTAIN ASSIGNMENTS, FOR THE ASSIGNMENTS WILL BE * /--- BLOCK DRAW 00 000 79/12/15 22.06 * EXECUTED TWICE. PROCEDURE SHOULD BE CHANGED. * SX2 X4-1 * /--- BLOCK DRAW 00 000 76/08/21 17.05 ZR X2,DDOTC JUMP IF COARSE SINGLE VERTEX SA2 A4+1 MOCKUP DRAW X1,Y1;X1,Y1 BX7 X2 SA7 A4+3 SA2 A4+2 BX7 X2 SA7 A4+4 SX4 4 EQ DRAWIN2 DDOTC SA2 A4+1 MOCKUP DRAW RC1;RC1 BX7 X2 SA7 A4+2 SX4 2 DRAWIN2 SX2 X4+1 X2 HOLDS COUNT OF 20 BIT PACKAGES BX4 X1+X4 SA1 SFFLAG FLAG FOR ALL PACKED TAGS BX4 X4+X1 BX1 X2 ALLOW ANY NUMBER OF VARIABLES RJ VARFINS USE STANDARD VARFIN PROCESSOR EQ NXTLINE * * - - - - SUBROUTINE TO HANDLE DRAW COMMAND - - - - * USES SEMICOLON FOR ARG TERMINATOR * FORMAT IS -- DRAW P1;P2;P3;P4 * WHERE P2 MAY BE COARSE (1512) OR FINE (100,200). * * VARBUF(0) RETURNED WITH NUMBER OF VARIABLES * VARBUF(N) RETURNED WITH -GETVAR- CODE FOR NTH VARIABLE * * ****NOTE**** WORDPT IS ASSUMED TO POINT TO * THE CHAR TO PROCESS FIRST. * * THE SUBROUTINE VARFIN WILL HANDLE THE PACKING UP OF THESE VARS * * 20-BIT CODE FOR EACH VAR IS AS FOLLOWS-- * TOP 2 BITS'; 0=COARSE,1=FINE,2=PACKED FINE,3=SKIP * LOWER 18 BITS -- GETVAR CODE OR PACKED FINE GRID * * CONDRAW EQ * MX6 0 SA6 VARBUF ZERO VARBUF(0) - NO VARS YET SA6 VERTEX COUNT NUMBER OF VERTICES SA6 LASTYPE INDICATE DONE WITH LAST VERTEX SA1 OVARG1 0 IF WANT TO PACK (-DRAW-) NZ X1,NOPACK SX6 1 LX6 XCODEL-2 NEXT TO TOP BIT IF ALL PACKED NOPACK SA6 SFFLAG WILL BE MERGED INTO CMND WORD CDRAW RJ CONDRAW2 GET CODE FOR NEXT VARIABLE SA1 WORDPT CHECK FOR END-OF-LINE SA1 X1 NZ X1,CDRAW JUMP IF NOT EOL SA1 NEXTCOM CHECK FOR CONTINUATION SA2 COMCONT BX3 X1-X2 NZ X3,CONDRAW --- EXIT IF NOT CONTINUED RJ GETLINE READ IN NEXT LINE EQ CDRAW * * * /--- BLOCK DRAW 00 000 76/08/21 17.12 * * - - - - SUBROUTINE TO GET NEXT VARIABLE - - - - * USES STANDARD LEXICAL SEPARATORS * CONDRAW2 EQ * CODRW0 BSS 0 SA1 WORDPT POINTER TO FIRST CHARACTER SA1 X1 ZR X1,CONDRAW2 IF END-OF-LINE SX2 X1-1R NZ X2,CODRW1 IF NOT BLANK SA1 WORDPT ADVANCE CHARACTER POINTER SX6 X1+1 SA6 A1 EQ CODRW0 CODRW1 BSS 0 SA1 X1+KEYTYPE GET TYPE OF FIRST CHARACTER NZ X1,CODRW2 JUMP IF NOT NUMERIC CALL QUIKCMP FOR QUICK COMPILE OF NUMBER EQ CODRW3 * CODRW2 CALL COMPSYM,SKIP,1 WILL CHANGE CODE LATER CODRW3 SA2 VARBUF X2 HOLDS CURRENT NO. OF ARGS SX7 X2+1 X7 HOLDS NEW NO. OF ARGUMENTS SX2 X7-VARBUFL SUBTRACT OFF SIZE OF VARBUF PL X2,ERR2MNY EXIT IF READINBF FULL SA7 A2 NEW VARIABLE COUNT IN VARBUF(0) * X1=GETVAR CODE, X7=OFFSET IN VARBUF TO PLACE CODE SA3 VERTEX COUNT VERTICES SX6 X3+1 SA6 A3 * SA2 LASTKEY CHECK FOR TERMINATOR TYPE SX2 X2-1R, SA4 LASTYPE PICK UP PREVIOUS GETVAR TYPE BX0 X1 AX0 XCODEAL CHECK FOR -SKIP- OPTION SX6 X0-7 NZ X6,CODRW4 IF NOT -SKIP- OPTION * * -SKIP- OPTION --- ZR X2,ERRTERM COMMA MUST NOT FOLLOW SKIP NZ X4,ERRXYTG -,SKIP- AND -SKIP;SKIP- ILLEGAL * (IF ONLY WANT -,SKIP- ILLEGAL, MAKE IT -NG X4,ERRXYTG-) SX6 1 INDICATE SKIP SA6 A4 MX1 2 SKIP HAS TOP TWO BITS SET LX1 XCODEL EQ CODRW9 * CODRW4 NZ X2,CODRW5 IF DOESNT TERMINATE WITH -,- * * NOT -SKIP-, AND TERMINATES WITH -,- NG X4,ERRXYTG IF LAST WAS ALSO -X- COORD MX6 -1 INDICATE X OF FINE GRID SA6 A4 MX6 1 LX6 XCODEL-1 NEXT TO TOP BIT FOR X-COORD BX1 X1+X6 EQ CODRW9 * * /--- BLOCK DRAW 00 000 76/08/21 21.46 CODRW5 MX6 0 SA6 A4 INDICATE DONE WITH VERTEX NG X4,CODRW6 IF LAST WAS -X- COORD * * CURRENT ARG IS COARSE GRID --- SA2 OVARG1 = 1 FOR GDRAW SX6 X2-1 ZR X6,ERRXYTG GDRAW CANNOT HAVE COARSE GRID NZ X0,CODRW8 ALL DONE IF NOT SHORT LITERAL NZ X2,CODRW9 C/F CONVERSION ONLY FOR DRAW BX0 X7 SAVE POINTER INTO VARBUF RJ RCTOXY X6=X, X7=Y, X0-X1 UNCHANGED BX3 X7 Y-COORDINATE BX7 X0 RESTORE VARBUF OFFSET MX4 -9 BX0 X4*X6 NZ X0,CODRW8 IF WONT FIT IN 9 BITS BX0 X4*X3 NZ X0,CODRW8 IF WONT FIT IN 9 BITS LX6 9 THEY FIT, PACK THEM UP BX1 X6+X3 MX6 1 INDICATE X-Y PACKED FORMAT LX6 XCODEL BX1 X1+X6 EQ CODRW9 * * -Y- COORDINATE. SEE IF CAN PACK WITH -X- COORDINATE CODRW6 SA2 VERTEX SX6 X2-1 SA6 A2 NZ X0,CODRW8 NOPE, -Y- IS NOT SHORT LITERAL SA2 OVARG1 0 FOR DRAW NZ X2,CODRW8 SA2 VARBUF+X7-1 GETVAR CODE FOR -X- COORD MX0 -18 IGNORE BIT 'I PUT ON BX2 -X0*X2 MX4 -9 ONLY USE 9 BITS NOW BX0 X4*X1 NZ X0,CODRW8 IF WONT FIT IN 9 BITS BX0 X4*X2 NZ X0,CODRW8 IF WONT FIT IN 9 BITS LX2 9 THEY FIT, PACK THEM UP BX1 X1+X2 MX6 1 INDICATE X-Y PACKED FORMAT LX6 XCODEL BX1 X1+X6 SA2 VARBUF DECREMENT VARBUF COUNT SX7 X2-1 SA7 A2 EQ CODRW9 AND OUTPUT * CODRW8 SX6 0 INDICATE NOT ALL PACKED UP SA6 SFFLAG * CODRW9 BX6 X1 SA6 X7+VARBUF STORE IN NEXT LOC OF VARBUF EQ CONDRAW2 * LASTYPE BSS 1 -1=X OF FINE, 0=OK, 1=SKIP TDRAW BSS 1 TEMP FOR DRAW COMMAND VERTEX BSS 1 COUNT NUMBER OF VERTICES SFFLAG BSS 1 FLAG FOR ALL PACKED UP SKIP VFD 42/4LSKIP,1/1,17/0 -JUMP-TYPE GETVAR CODE * * ENDOV * /--- BLOCK PUT 00 000 76/07/25 08.08 TITLE PUT AND PUTD COMMANDS PUTOV OVRLAY * SA1 OVARG1 SB3 X1 * JP *+B3 * + EQ PUT + EQ PUTD * ********* * * -PUT- (CODE=26) * * PUT SA1 TAGCNT ZR X1,ERR2FEW ERROR IF BLANK TAG * SB1 1 SX2 1R= * ENTRY FOR PUT WITH DELIMITERS PUTDENT SB2 B0 START SEARCH AT 2ND CHAR VORN SB2 B2+B1 SA1 B2+TAG ZR X1,ERRPUT WILL BE PUTS ON VARIABLES JUMP IX3 X2-X1 NZ X3,VORN GO SEE IF EQUALS IS LATER * * * * B2=CHAR COUNTER * B3=CHAR PER WORD COUNTER * B7=XTRA STORAGE WORD COUNTER * * CONSTRUCT IN STRING * SA3 INX X3=XTRA STORAGE POINTER BX6 X3 LX6 12 START COMMAND WORD WITH XTRA POINTER--INADD LX2 54 LEFT JUSTIFY *=* MX0 6 SB3 10 CHAR/WORD PRESET SB2 B0 SB7 X3+INFO GET ABSOLUTE START OF XTRA STORAGE SX3 B7 AND PUT IN X3 SB7 B0 SET OFFSET FROM HERE TO ZERO SX7 B0 CLEAR X7 * * PEQLP SA1 B2+TAG LOAD CHAR SB2 B2+B1 LX1 54 LEFT JUSTIFY BX1 X1*X0 MAKE SURE THAT IS ONLY BITS BX7 X1+X7 AND ADD TO EXISTING WORD LX7 6 PUT IN RIGHT OF EXISTING WORD SB3 B3-B1 CHAR/WORD DECREMENT IX4 X2-X1 ZR X4,PEQJUS DONE IF *=* FOUND NZ B3,PEQLP GO TILL WORD FULL SA7 X3+B7 STORE FULL WORD SB7 B7+B1 SB3 10 RESET CHAR/WORD SX7 B0 EQ PEQLP GO DO NEXT WORD * * PEQJUS ZR B3,PINLTH LX7 6 LEFT JUSTIFY LAST WORD SB3 B3-B1 EQ PEQJUS PINLTH SX1 B7+B1 SA5 INX IX1 X1+X5 POINTER TO OUTSTR IN 2ND BYTE BX6 X6+X1 OF COMMAND WORD LX6 12 * /--- BLOCK PUTD 00 000 76/07/25 08.27 SX1 B2-B1 X1=CHAR CNT-1 FOR *=* BX6 X6+X1 3RD BYTE OF COMMAND WORD = INLTH LX6 12 SA7 X3+B7 STORE LAST IN WORD SB7 B7+B1 SB4 B2 SAVE INLTH+1 TO CALCULATE OUTLTH SB3 10 SX7 B0 * * * CONSTRUCT OUT STRING * PUTSLP SA1 TAG+B2 LOAD CHAR SB2 B2+B1 LX1 54 BX1 X1*X0 CLEAN EXTRANEOUS BITS BX7 X1+X7 LX7 6 SB3 B3-B1 ZR X1,POUTJUS CHECK FOR ZERO TERMINATOR NZ B3,PUTSLP LOOP IF WORD NOT FULL SA7 X3+B7 STORE WORD SX7 B0 CLEAR X7 SB7 B7+B1 SB3 10 EQ PUTSLP * * POUTJUS ZR B3,POUTLTH LX7 6 SB3 B3-B1 EQ POUTJUS * POUTLTH SA7 X3+B7 STORE LAST OUT WORD SB7 B7+B1 SET INX TO POINT AT NEXT WORD SA1 INX SX2 B7 IX7 X1+X2 SA7 INX UPDATED INX STORED SB2 B2-B1 SUTRACT ONE FOR TERMINATOR SX1 B2-B4 OUTLTH TO X1 BX6 X6+X1 PUT OUTLTH IN COMMAND WORD LX6 12 EQ PUTCODE GO TACK ON COMMAND CODE AND STORE * ***************** * -PUTD- COMMAND * * *PUTD* PUTD SA1 TAGCNT SB3 X1-4 NG B3,ERRPUT ERROR IF LESS THAN 4 CHARS IN TAG SB3 X1-1 SB1 1 UNIVERSAL INCREMENT CONSTANT TO B1 * SX6 PUT= *** NUMBER OF *PUT* COMMAND *** SA6 COMNUM FAKE OUT PUTCODE * SA2 TAG LOAD FIRST DELIMITER SA3 B3+TAG LOAD LAST DELIMITER IX3 X2-X3 NZ X3,ERRPUT DELIMITER DISAGREEMENT ERROR SX6 B0 SA6 A3 STORE FINAL ZERO OVER LAST DELIMITER SB2 B1 * PUTDLP SA1 B2+TAG LOAD CHAR BX6 X1 SA6 A1-B1 AND STORE IT ONE BACK SB2 B2+B1 NZ X6,PUTDLP EQ PUTDENT DONE--FINAL ZERO FOUND * ERRPUT SB1 87 EQ =XERR * ENDOV * * /--- BLOCK COMMON 00 000 80/08/07 01.50 TITLE COMMON, STORAGE, ROUTVAR * * COMMOV OVRLAY SA1 OVARG1 SB3 X1 JP *+B3 * + EQ COMM -COMMON- (NON-EX) + EQ NONSYS -COMMONX- + EQ STOR -STORAGE- + EQ RVAR -ROUTVAR- + EQ SCOMX -SYSCOMX- + EQ LVAR -LVARS- * * /--- BLOCK COMMON 00 000 80/10/16 21.34 TITLE COMMON * * -COMMON- (NOT EXECUTEABLE) * * MAY HAVE ONE TO FIVE ARGUMENTS * * IF ONE ARGUMENT - * SPECIAL COMMON IS SET UP - ECS RESIDENT ONLY * ARGUMENT IS THE LENGTH * * IF MULTIPLE ARGUMENTS - * 1ST ARGUMENT = ACCOUNT NAME * 2ND ARGUMENT = LESSON NAME * 3RD ARGUMENT = COMMON BLOCK NAME * 4TH ARGUMENT = LENGTH OF COMMON * * LAST ARGUMENT MAY INDICATE SPECIAL OPTIONS * * SETS *CCOMACT* = ACCOUNT NAME * *CCOMLES* = LESSON NAME * *CCOMNAM* = COMMON NAME * *CCOMLTH* = LENGTH OF COMMON * *CCOMBIT* = SPECIAL OPTION BITS * COMM BSS 0 SA1 CCOMLES SEE IF ALREADY A COMMON NZ X1,ERRCOMM ERROR IF SO SA1 TAGCNT ZR X1,ERR2FEW ERROR IF NO TAG SA1 COMACNT SX1 X1-2 NG X1,TEMPCOM CALL ACCFILE,COMACT,-1 GET ACCOUNT;FILE NZ X1,COMHAV JUMP IF LESSON SPECIFIED SA1 ACCOUNT ACCOUNT OF THIS LESSON SA2 LESSON NAME OF THIS LESSON MX6 1 LX6 18 SET ORIGINAL FILE FLAG BX6 X1+X6 BX7 X2 SA6 COMACT SA7 COMLES * COMHAV BSS 0 RJ BLKNAM GET SECOND ARGUMENT ZR X6,ERRNAME SA6 COMNAM RJ GETCLTH GET COMMON LENGTH NZ X6,ERRNAME BX7 X1 SX1 MAXCOM+1 IX1 X7-X1 NG X7,ERRNAME ZR X7,ERRNAME PL X1,ERRNAME SA7 COMLTH SA1 COMACNT SX1 X1-3 NG X1,COMM3 EQ COMLAST PROCESS LAST ARGUMENT * /--- BLOCK COMMON 00 000 80/08/16 18.25 * TEMPCOM MX6 0 CLEAR 2ND WORD OF NAME SA6 COMNAM RJ GETCLTH GET LENGTH OF COMMON NZ X6,ERRNAME BX7 X1 SX1 TCLTH+1 IX1 X7-X1 NG X7,ERRNAME ZR X7,ERRNAME PL X1,ERRNAME SA7 COMLTH SA1 TMPCMNM LESSON NAME FOR TEMP COMMON BX6 X1 SA6 COMLES SA1 COMACNT ZR X1,COMM3 * COMLAST CALL NXTNAME GET OPTION NAME(S) **** ZR X6,ERRNAME SB1 B0 * COMM1 SA1 B1+COMOLST LOAD NEXT OPTION NAME ZR X1,ERRNAME BX2 X6-X1 SEE IF NAMES MATCH ZR X2,COMM2 SB1 B1+1 EQ COMM1 KEEP SEARCHING * COMM2 SA1 B1+COMBLST LOAD BIT PATTERN SA2 COMBIT BX6 X1+X2 MERGE COMMON OPTION BITS SA6 A2 SA1 WORDPT SA1 X1 LOAD ENDING CHARACTER NZ X1,COMLAST * TRANSFER ARGUMENTS TO GLOBAL VARIABLES COMM3 SB1 1 SA1 COMACT SA2 A1+B1 *COMLES* BX6 X1 SA1 A2+B1 *COMNAM* BX7 X2 SA6 CCOMACT SA7 CCOMLES SA2 A1+B1 *COMLTH* BX6 X1 BX7 X2 SA1 A2+B1 *COMBIT* SA6 CCOMNAM SA7 CCOMLTH BX6 X1 SA6 CCOMBIT EQ NXTLINE SPACE 3 * BLKNAM - GET BLOCK NAME FOR -COMMON- BLKNXIT SX7 A1 UPDATE WORDPT SA7 WORDPT * BLKNAM EQ * SA1 WORDPT GET POINTER TO FIRST CHARACTER * BLKN100 SA2 X1 LOAD NEXT CHARACTER SX0 X2-1R STRIP OFF LEADING SPACES NZ X0,BLKN110 SX1 X1+1 ADVANCE CHARACTER POINTER EQ BLKN100 * * COLLECT CHARACTERS OF ALPHA LITERAL * BLKN110 SB1 60 INITIALIZE SHIFT MX6 0 INITIALIZE WORD BUILDING SA1 X1-1 INITIALIZE READ REGISTER * BLKN120 SA1 A1+1 LOAD NEXT CHARACTER ZR X1,BLKNXIT IF END-OF-LINE SA2 X1+KEYTYPE SX0 X2-OPCOMMA CHECK IF COMMA ZR X0,BLKN140 SB1 B1-6 DECREMENT SHIFT COUNT PL B1,BLKN130 MX6 0 RETURN ZERO NAME FOR ERROR EQ BLKNXIT * BLKN130 LX1 X1,B1 POSITION NEXT CHARACTER BX6 X1+X6 MERGE WITH WORD BUILDING EQ BLKN120 * * /--- BLOCK COMMON 00 000 80/08/16 18.25 BLKN140 SX7 A1+1 UPDATE *WORDPT* FOR COMMA SA7 WORDPT EQ BLKNAM * /--- BLOCK COMMON 00 000 80/08/07 01.54 SPACE 3 * GETCLTH - GET LENGTH FOR -COMMON- * GETCLTH EQ * CALL COMPILE BX5 X1 SAVE -GETVAR- CODE MX6 0 SET NO ERROR AX1 XCODEAL MX0 -XCODEAL ZR X1,GETCL1 JUMP IF SHORT LITERAL SX2 X1-1 ZR X2,GETCL2 JUMP IF LONG INTEGER LITERAL SX2 X1-9 ZR X2,GETCL3 JUMP IF FLOATING LITERAL MX6 -1 ERROR RETURN EQ GETCLTH * GETCL1 BX1 -X0*X5 MASK OFF SHORT LITERAL EQ GETCLTH * GETCL2 BX1 -X0*X5 SA1 X1+INFO LOAD LONG LITERAL EQ GETCLTH * GETCL3 BX1 -X0*X5 SA1 X1+INFO LOAD LONG LITERAL SA2 HALF PL X1,GETCL3A BX2 -X2 SUB .5 IF ARGUMENT NEGATIVE GETCL3A RX3 X1+X2 UX3 X3,B1 FIX THE ARGUMENT LX3 X3,B1 MX6 0 ZERO FOR NO ERROR IX1 X3+X6 CHANGE -0 TO +0 EQ GETCLTH * * * THE ORDER OF THE FOLLOWING CELLS IS IMPORTANT * COMACT BSSZ 1 COMLES BSSZ 1 COMNAM BSSZ 1 COMLTH BSSZ 1 COMBIT BSSZ 1 * * COMOLST DATA 2LNL DATA 2LRO DATA 4LRONL DATA 7LNO LOAD DATA 9LREAD ONLY DATA 0LCHECKPT DATA 0 * COMBLST VFD 12/4000B,48/0 + VFD 12/2000B,48/0 + VFD 12/6000B,48/0 + VFD 12/4000B,48/0 + VFD 12/2000B,48/0 + VFD 12/1000B,48/0 * * HALF DATA .5 * ERRCOMM SB1 86 EQ =XERR * * /--- BLOCK SYSCOMX 00 000 80/02/15 22.06 * TITLE -SYSCOMX- COMMAND * -SYSCOMX- * EXECUTABLE -COMMON- COMMAND * SCOMX BSS 0 CALL SYSTEST SYSTEM LESSONS ONLY SA1 TAGCNT ZR X1,PAUSE2 SET SIGN BIT FOR BLANK TAG SA1 CXDROP CALL TAGXACT CHECK FOR ',DROP', TAG NG X1,TWOBITS IF DROP, GO SET TOP 2 BITS * CALL FILEBLK GET ACCOUNT';FILE, BLOCK * SA1 LASTKEY CHECK FOR END-OF-LINE ZR X1,COMX05 CALL COMPILE GET THIRD ARGUMENT (LENGTH) * COMX05 BX6 X1 SA6 VARBUF+4 SA1 LASTKEY CHECK FOR END-OF-LINE ZR X1,COMX06 CALL COMPILE GET 4TH ARGUMENT (FILE TYPE) COMX06 BX6 X1 SA6 VARBUF+5 SX6 5 5 ARGUMENTS IN BUFFER SA6 VARBUF SA1 LASTKEY MAKE SURE NO MORE ARGUMENTS NZ X1,ERR2MNY BX1 X6 5 ARGUMENTS LEGAL FOR VARFIN EQ VARFIN -- EXIT TO PACK UP AND STORE * CXDROP DATA 4LDROP * * /--- BLOCK COMMONX 00 000 80/02/15 22.06 * TITLE -COMMONX- CONDENSE ROUTINE * * ALLOWABLE FORMS ARE'; * * COMMONX (BLANK TAG) * COMMONX ACCOUNT';LESSON,BLOCK,LENGTH * COMMONX ,BLOCK,LENGTH (THIS LESSON) * * NOTE--LENGTH ARGUMENT IS OPTIONAL. * NONSYS SX6 -1 SA6 CCOMX MARK COMMONX ENCOUNTERED * CALL FILEBLK GET ACCOUNT';FILE, BLOCK ZR X1,PAUSE2 JUMP IF BLANK TAG * * SA1 LASTKEY CHECK FOR END-OF-LINE ZR X1,NS350 JUMP IF E-O-L SA1 WORDPT X1 = POINTER TO NEXT CHARACTER SA2 X1 GET NEXT CHARACTER SX2 X2-1R, CHECK FOR COMMA NZ X2,NS360 JUMP IF 3RD ARGUMENT NON-BLANK SX6 X1+1 ADVANCE WORDPT SA6 A1 * NS350 MX6 0 SET LENGTH ARGUMENT 0 EQ NS400 * NS360 CALL COMPILE GET THIRD ARGUMENT (LENGTH) BX6 X1 * /--- BLOCK COMMONX 00 000 80/02/15 22.06 * NS400 SA6 VARBUF+4 MX6 0 FAKE UP 5TH ARG (FILE TYPE) SA6 VARBUF+5 SA1 LASTKEY SEE IF MORE ARGUMENTS ZR X1,NS500 BLANK CODEWORD * SA1 WORDPT NEXT CHAR POINTER SA2 X1 GET CHARACTER SA2 X2+KEYTYPE CHECK FOR COMMA - NO CODE SX0 X2-OPCOMMA NZ X0,NS450 CODEWORD INCLUDED SX6 X1+1 INCREMENT WORDPT SA6 A1 MX1 0 PUT 0 FOR CODEWORD EQ NS500 * NS450 CALL COMPNAM GET CODEWORD NS500 BX6 X1 SA6 VARBUF+6 STORE CODEWORD * * * NOW SET OPTION BITS FOR READ ONLY, NO LOAD * MX7 0 CLEAR OPTION BITS SA7 COMOPT * NS590 CALL NXTNAME GET OPTION NAME ZR X6,NSFIN NO OPTIONS SPECIFIED * SB1 0 NS600 SA1 COMOLST+B1 ZR X1,ERRNAME NOT ON LIST BX2 X6-X1 LOOK FOR MATCH ZR X2,NS610 FOUND MATCH SB1 B1+1 EQ NS600 KEEP LOOKING * NS610 SA1 COMOPT GET CURRENT OPTION BITS SA2 B1+COMBLST GET NEW OPTION BITS BX6 X2+X1 MERGE SA6 A1 STORE EQ NS590 SEE IF MORE OPTIONS * NSFIN SA1 COMOPT GET OPTION BITS BX6 X1 LX6 12 SHIFT TO LOWER BITS SA6 VARBUF+7 STORE BITS SX6 7 SPECIFY 7 ARGUMENTS SA6 VARBUF BX1 X6 7 ARGUMENTS LEGAL FOR VARFIN EQ VARFIN GO PACK UP AND STORE * COMOPT BSS 1 COMMON OPTION BITS * * /--- BLOCK LVARS 00 000 80/05/20 11.15 * * * * -LVARS- * * SPECIFY NUMBER OF WORDS IN LOCAL VAR STACK * LVAR BSS 0 SA1 LVARL ONLY ONE -LVARS- COMMAND NG X1,LVARERR -LVAR- ILLEGAL HERE * NZ X1,ERRCOMM * CALL GETCLTH NG X6,ERRCOMM EXIT IF NOT LITERAL * NG X1,ERRCOMM OR 0 OR - * ZR X1,ERRCOMM * GET MAXIMUM NUMBER OF LOCAL VARIABLES. SX6 X1-LVMAX-1 PL X6,ERRCOMM * BX6 X1 SA6 LVARL SAVE SIZE OF LOCALS STACK EQ NXTLINE * LVARERR SB1 774 ILLEGAL -LVAR- EQ =XERR * /--- BLOCK ++STORAGE 00 000 80/05/20 23.53 * * * * -STORAGE- (CODE=128) * * SYSTEM LESSON EXECUTABLE COMMAND FORMAT -- * * STORAGE (AMOUNT) * * USER LESSON COMMAND FORMAT, WHICH SETS INFO * IN LESSON HEADER -- * * STORAGE (AMOUNT) * STORAGE (AMOUNT),EXACTLY * STORAGE (AMOUNT),MINIMUM * * STOR SA1 SYSFLG SEE IF SYSTEM LESSON LX1 ZSLDSHF NG X1,SYSONE IF YES SA1 XSTORL NZ X1,ERRCOMM ONE -STORAGE- PER LESSON RJ GETCLTH GET LENGTH OF STORAGE NZ X6,ERRCOMM IF NOT LITERAL NG X1,ERRCOMM IF - ZR X1,ERRCOMM IF 0 SX2 MAXSTO MAXIMUM STORAGE SIZE IX2 X2-X1 NG X2,ERRCOMM IF TOO BIG BX7 X1 SA7 XSTOTMP SAVE TEMPORARILY SA1 LASTKEY SEE IF ADDITIONAL TAG ZR X1,STOSET -- EXIT IF E-O-L (X7 = LENGTH) SX1 X1-1R, NZ X1,ERRCOMM -- ERROR IF NOT A COMMA CALL NXTNAME GET TAG ZR X6,ERRCOMM -- ERROR IF NOTHING THERE SX7 4 ASSUME -EXACTLY- TAG SA1 TCEXACT BX1 X1-X6 ZR X1,STOGO SA1 TCMIN OR MAYBE -MINIMUM- BX1 X1-X6 NZ X1,ERRCOMM -- ERROR IF FUNNY TAG SX7 2 STOGO LX7 SEXACTF-2 MOVE OPTION BITS TO LSTOUSE LOC SA1 XSTOTMP BX7 X1+X7 X7 = LENGTH PLUS OPTION BITS * * SAVE RESULTS -- X7 = LENGTH + OPTION BITS, AS * WILL BE -OR-ED INTO *LSTOUSE* * STOSET SA7 XSTORL SAVE STORAGE LENGTH / FLAGS EQ NXTLINE * TCEXACT DATA 7LEXACTLY TCMIN DATA 7LMINIMUM XSTOTMP BSS 1 SAVED STORAGE LENGTH * * /--- BLOCK ROUTVAR 00 000 76/07/25 08.34 * * * * -ROUTVAR- COMMAND * SPECIFIES NUMBER OF ROUTER VARIABLES (NR1-NR(N)) * * RVAR SA1 ROUTER SEE IF -ROUTER- LESSON ZR X1,ERROUTR SA1 RVARL ONLY ONE -ROUTVAR- COMMAND NZ X1,ERRCOMM CALL GETCLTH NG X6,ERRCOMM EXIT IF NOT LITERAL NG X1,ERRCOMM OR 0 OR - ZR X1,ERRCOMM SX6 RVARLIM+1 IX6 X1-X6 SEE IF TOO MANY VARIABLES PL X6,ERRCOMM BX6 X1 SA6 RVARL SAVE NUMBER OF ROUTER VARIABLES EQ NXTLINE * ENDOV * /--- BLOCK SORT 00 000 76/08/16 22.33 TITLE -SORT- / -SORTA- COMMAND READ-INS * * * * SORT LIST,LENGTH,INCREMENT,1ST BIT,NUM BITS,MASK * LIST,INCREMENT * * SORTA LIST,LENGTH,INC,1ST CHAR,NUM CHARS,MASK * LIST,INCREMENT * * MASK IS OPTIONAL. 'NOTE THAT MASK IS PUT IN THIRD WORD * OF GVAR CODES, OUT OF ORDER. * * SORTOV OVRLAY SA1 WORDPT SAVE *WORDPT* BX6 X1 SA6 OLDPT MX6 0 PRE-SET ASSOCIATED LIST FLAG SA6 SASSOC SA6 SORTMSK SORT MASK SA6 VARBUF+5 SA6 VARBUF+6 * * EVALUATE LIST TYPE / LOCATION * CALL NXTNAM GET FIRST ENTRY SX0 X1-1R, NZ X0,SORT150 JUMP IF MAY BE CM BUFFER MX0 42 SA1 SORTLST-1 SET UP FOR BUFFER TYPE SEARCH * SORT110 SA1 A1+1 LOAD NEXT LIST ENTRY ZR X1,SORT150 CHECK IF CM BUFFER BX2 X0*X1 MASK OFF BUFFER TYPE NAME IX2 X2-X6 NZ X2,SORT110 SX6 X1 PICK UP BUFFER TYPE CODE LX6 60-6 SA6 SORTWK CALL COMPILE EVALUATE POSITION EXPRESSION LX1 60-6-XCODEL POSITION -GETVAR- CODE SA2 SORTWK BX6 X1+X2 MERGE TYPE/POSITION SA6 A2 SA1 LASTKEY MUST END WITH A SEMI-COLON SX0 X1-KSEMIC ZR X0,SORT200 EQ ERRORC * * /--- BLOCK SORT 00 000 76/08/16 22.56 * SORT150 SA1 OLDPT RESTORE *WORDPT* BX6 X1 SA6 WORDPT CALL COMPILE EVALUATE BUFFER EXPRESSION NZ B1,ERRSTOR ERROR IF NOT STOREABLE BX6 X1 LX6 60-6-XCODEL POSITION -GETVAR- CODE SA6 SORTWK SA1 LASTKEY MUST END WITH A SEMI-COLON SX0 X1-KSEMIC NZ X0,ERRTERM * * PROCESS REMAINING ARGUMENTS * SORT200 CALL VARDO EVALUATE ARGUMENTS SA1 VARBUF SX1 X1-4 MUST BE 4 OR 5 TAGS NG X1,ERR2FEW NOT ENOUGH TAGS ZR X1,SORT210 EXACTLY 4 TAGS * SX1 X1-1 NZ X1,ERR2MNY TOO MANY TAGS * * PROCESS MASK GETVAR CODE * SA1 VARBUF+5 MX0 -XCODEL BX6 -X0*X1 MASK OFF GETVAR CODE ZR X6,ERRORC ERROR IF MASK IS ZERO ('.) LX6 60-XCODEL LEFT JUST GVAR CODE SA6 SORTMSK AND STORE IT * SX6 4 SA6 VARBUF THEN RESET VARBUF COUNTER * * * CHECK IF COMMAND CONTINUED * SORT210 SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED BX2 X1-X2 NZ X2,SORT300 CALL GETLINE GET NEXT LINE OF TEXT SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED BX2 X1-X2 ZR X2,ERRCNTD ERROR IF CONTINUED FURTHER * * PROCESS ASSOCIATED LIST TYPE / LOCATION * SA1 WORDPT SAVE *WORDPT* BX6 X1 SA6 OLDPT CALL NXTNAM GET FIRST ENTRY SX0 X1-1R, NZ X0,SORT250 JUMP IF MAY BE CM BUFFER MX0 42 SA1 SORTLST-1 SET UP FOR BUFFER TYPE SEARCH * SORT220 SA1 A1+1 LOAD NEXT LIST ENTRY ZR X1,SORT250 CHECK IF CM BUFFER BX2 X0*X1 MASK OFF BUFFER TYPE NAME IX2 X2-X6 NZ X2,SORT220 SX6 X1+40B PICK UP BUFFER TYPE CODE SA6 SASSOC CALL VARDO2 EVALUATE LOCATION ARGUMENT EQ SORT260 * * /--- BLOCK SORT 00 000 76/07/25 08.42 * SORT250 SA1 OLDPT RESTORE *WORDPT* BX6 X1 SA6 WORDPT SX6 40B SET BUFFER TYPE CODE SA6 SASSOC CALL VARDO2 EVALUATE BUFFER EXPRESSION SA1 VARBUF SA1 X1+VARBUF LOAD BUFFER -GETVAR- CODE NG X1,ERRSTOR MUST BE STORE-ABLE * SORT260 SA1 LASTKEY MUST END WITH A SEMI-COLON SX0 X1-KSEMIC NZ X0,ERRTERM * * EVALUATE ENTRY DIMENSION EXPRESSION * CALL VARDO2 EVALUATE DIMENSION EXPRESSION SA1 LASTKEY NZ X1,ERRTERM ERROR IF NOT END-OF-LINE SA1 SORTWK SA2 SASSOC ATTACH ASSOC BUFFER TYPE TO LX2 XCMNDL COMMAND WORD BX6 X1+X2 SA6 A1 * * ATTACH INDEX IN XSTOR TO COMMAND WORD * SORT300 SA1 INX GET INDEX IN EXTRA STORAGE BX6 X1 LX6 60-6-XCODEL-12 POSITION XSTOR INDEX SA2 SORTWK BX6 X2+X6 X6 = PARTIAL COMMAND WORD * * /--- BLOCK SORT 00 000 76/08/18 16.00 * * PACK UP REMAINING -GETVAR- CODES * MX0 -XCODEL SA2 VARBUF+1 LOAD LENGTH -GETVAR- CODE SA3 VARBUF+2 LOAD INCREMENT -GETVAR- CODE SA4 VARBUF+3 LOAD IST CHAR -GETVAR- CODE BX2 -X0*X2 BX3 -X0*X3 BX4 -X0*X4 LX2 60-XCODEL POSITION -GETVAR- CODES LX3 60-2*XCODEL LX4 60-3*XCODEL BX7 X2+X3 COMBINE -GETVAR- CODES BX7 X4+X7 SA7 X1+INFO STORE 1ST XSTOR WORD SA2 VARBUF+4 LOAD NUM CHARS -GETVAR- CODE SA3 VARBUF+5 LOAD ASSOC BUFF -GETVAR- CODE SA4 VARBUF+6 LOAD INCREMENT -GETVAR- CODE BX2 -X0*X2 BX3 -X0*X3 BX4 -X0*X4 LX2 60-XCODEL POSITION -GETVAR- CODES LX3 60-2*XCODEL LX4 60-3*XCODEL BX7 X2+X3 COMBINE -GETVAR- CODES BX7 X4+X7 SA7 X1+INFO+1 STORE 2ND XSTOR WORD * SA2 SORTMSK GET MASK GETVAR CODE BX7 X2 SA7 X1+INFO+2 AND STORE IT * SX7 X1+3 SA7 INX INCREMENT *INX* SA1 ICX IX1 X7-X1 CHECK FOR UNIT BUFFER OVERFLOW PL X1,LNGUNIT EQ PUTCODE EXIT * * SORTLST VFD 42/0LSTORAGE,18/2 + VFD 42/0LS,18/2 + VFD 42/0LCOMMON,18/1 + VFD 42/0LC,18/1 DATA 0 * SORTWK BSS 1 SORTMSK BSS 1 SASSOC BSS 1 * ENDOV * * * /--- BLOCK TALKREQ 00 000 81/03/23 00.29 TITLE -TALKREQ- READIN * ** -TALKREQ- (CODE=374) * * HANDLE TERM-TALK AND OTHER OUTPUT MASTER-SLAVE * REQUESTS, USING PROCESS INTERLOCK *I.TALK* AND * STATUS BUFFER *ATALK* * * TALKREQ [KEYWORD] $$ OWN STATN ACTION * TALKREQ [KEYWORD],STATN $$ OTHER STATN ACTION * TALKREQ STATUS,STATN,RETRN $$ OTHER STATN STATUS * * CERTAIN REQUESTS CAN ONLY BE PERFORMED ON YOUR * OWN STATION; OTHERS CAN BE DONE TO ANY STATION; * AND -STATUS- RETURNS THE STATUS TO A SPECIFIED * VARIABLE. * * COMMAND WORD FORMAT -- * 20 / GETVAR CODE FOR STATN * 20 / GETVAR CODE FOR BUFFER * 11 / REQUEST TYPE * 9 / -TALKREQ- COMMAND * * TRQCOV OVRLAY CALL SYSTEST SYSTEM LESSONS ONLY * * GET REQUEST TYPE KEYWORD * CALL NXTNAME MX0 42 LIMIT TO 7 CHARACTERS BX1 -X0*X6 NZ X1,ERRTAGS * * SEARCH FOR KEYWORD IN TABLE * SA1 TRQNAMS TRQLP BX2 X0*X1 X2 = POSSIBLE KEYWORD BX2 X2-X6 COMPARE ZR X2,TRQFND -- FOUND IT SA1 A1+1 GET NEXT KEYWORD NZ X1,TRQLP AND LOOP UNTIL WE RUN OUT EQ ERRTAGS -- ERROR EXIT IF NOT FOUND * * SAVE KEYWORD ORDINAL IN COMMAND WORD, AND * CHECK FOR REQUIRED ARGUMENTS * TRQFND SX6 A1-TRQNAMS LX6 XCMNDL PUT IN INFO POINTER FIELD BX7 -X0*X1 ISOLATE KEYWORD TYPE (0,1,2) ZR X7,TRQFIN TYPE 0 = KEYWORD ONLY SA7 TRQATYP SAVE TYPE SA6 TRQCMND SAVE BUILDING COMMAND SA1 WORDPT CHECK FOR TAG PRESENT SA1 X1 ZR X1,ERR2FEW -- IF NOT ENOUGH TAGS * /--- BLOCK TALKREQ 00 000 81/04/19 16.56 * * GET SECOND ARGUMENT (TARGET STATION) * CALL COMPILE LX1 -XCODEL ALIGN AS TOP GETVAR CODE SA2 TRQCMND BX6 X1+X2 ADD IN TO COMMAND WORD SA1 TRQATYP SX1 X1-1 CHECK FOR TYPE 1 KEYWORD ZR X1,TRQFIN -- DONE IF TYPE 1 SA6 TRQCMND SAVE BUILDING COMMAND * * GET THIRD ARGUMENT (WHERE APPLICABLE) * CALL COMPILE NZ B1,ERRSTOR ARGUMENT MUST BE STOREABLE LX1 60-XCODEL-XCODEL ALIGN AS 2ND GETVAR CODE SA2 TRQCMND BX6 X1+X2 ADD INTO COMMAND WORD * * COMPLETE -TALKREQ- READIN -- MAKE SURE NOTHING * LEFT IN TAG. X6 = FINAL COMMAND WORD * TRQFIN SA1 WORDPT SA1 X1 X1 = NEXT CHARACTER NZ X1,ERR2MNY -- ERROR IF MORE IN TAG EQ PUTCODE GO STORE COMMAND WORD * * KEYWORD TABLE * * EACH ENTRY IS OF THE FORM * * 42/KEYWORD * 18/TYPE -- 0 = KEYWORD ONLY * 1 = KEYWORD,STATN * 2 = KEYWORD,STATN,BUFFER * * NOTE -- THIS TABLE MUST MATCH CORRESPONDING * ==== EXECUTION-TIME TABLE IN -EXEC6- * TRQNAMS VFD 42/0LREQUEST,18/1 0 VFD 42/0LCANCEL,18/0 1 VFD 42/0LANSWER,18/0 2 VFD 42/0LSETSLIB,18/0 3 VFD 42/0LMONITOR,18/1 4 VFD 42/0LMASTER,18/1 5 VFD 42/0LTLK2MON,18/0 6 VFD 42/0LMON2TLK,18/0 7 VFD 42/0LSTATUS,18/1 8 VFD 42/0LJOIN,18/1 9 VFD 42/0LCONFER,18/1 10 VFD 42/0LPAGE,18/1 11 VFD 42/0LUNPAGE,18/1 12 VFD 42/0LPASS,18/1 13 DATA 0 * * STORAGE * TRQCMND DATA 0 COMMAND WORD BEING BUILT TRQATYP DATA 0 KEYWORD TYPE ENDOV * /--- BLOCK END 00 000 77/07/30 01.33 * TITLE FONT COMMAND * FONTCOV OVRLAY * MX6 0 PRE-CLEAR SA6 VARBUF+1 SA6 VARBUF+2 SA6 VARBUF+3 SX6 3 NUMBER OF ARGUMENTS FOR FONT SA6 VARBUF CALL NXTNAM GET FONT NAME ZR X6,ERR2FEW IF NO TAGS, TOO FEW MX0 8*6 FONT NAME CANNOT EXCEED 8 CHARS BX0 -X0*X6 NZ X0,ERRNAME SA2 FONTNAM FIRST TERM TO CHECK SB3 NFONTS NUMBER OF FONTS TO CHECK FONTLP1 BX2 X2-X6 ZR X2,FONTOK IF EQUAL TO FONT NAME, OK SB3 B3-1 DECREMENT CHECK ZR B3,ERRNAME IF NOT VALID NAME, ERROR OUT SA2 A2+1 GET NEXT TERM EQ FONTLP1 GO CHECK AGAIN FONTOK SX6 B3 GET FONT SLOT NUMBER SA6 VARBUF+1 SAVE FONT SLOT NUMBER ZR X1,FONTDEF IF NO SEPARATOR, DEFAULT CALL COMPILE GET NEXT ARGUMENT BX6 X1 SAVE -GETVAR- CODE SA6 VARBUF+2 SA2 LASTKEY SEE IF END-OF-LINE ZR X2,FONTREG IF ONLY TWO PARAMS, DEFAULT SX6 NMODES MAX EXTRA ARGS SA6 FARGMAX SAVE MAX ARGS FONTLP2 CALL NXTNAM GET LITERAL TAG IN X6 ZR X6,FONTGO IF END OF ARGS, GO STORE BX0 X6 SAVE NAME IN *X0* SA2 FARGMAX GET REMAINING ARG COUNT SX6 X2-1 SUBTRACT ONE SA6 A2 REPLACE IT NG X6,ERR2MNY TOO MANY ARGUMENTS SX1 1 SET BIT 0 SA2 FONTMOD FIRST MODE TO CHECK SB3 NMODES NUMBER OF MODES TO CHECK FONTLP3 BX2 X2-X0 ZR X2,FONTOK2 IF EQUAL TO FONT MODE, OK SB3 B3-1 DECREMENT CHECK ZR B3,ERRNAME IF NOT VALID NAME, ERROR OUT SA2 A2+1 GET NEXT TERM LX1 1 POSITION TO NEXT BIT EQ FONTLP3 GO CHECK AGAIN FONTOK2 SA2 VARBUF+3 GET CURRENT MODE WORD BX0 X1*X2 SEE IF BIT ALREADY SET NZ X0,ERR2MNY DUPLICATE TAG BX6 X2+X1 SET BIT SA6 A2 SAVE NEW SETTING EQ FONTLP2 * /--- BLOCK FONT 00 000 79/07/19 23.36 FONTDEF SX6 0 DEFAULT FONT SIZE SA6 VARBUF+2 FONTREG SX6 0 DEFAULT FONT MODE SA6 VARBUF+3 FONTGO BSS 0 SA1 VARBUF GET NUMBER OF ARGS FOR -VARFIN- EQ VARFIN GO PACK AND STORE ARGS NFONTS EQU 19 NUMBER OF FONT SLOTS FONTNAM BSS 0 DATA 0LMSSANS FONT 19 DATA 0LSCRIPT FONT 18 DATA 0LNTROMAN FONT 17 DATA 0LARIAL FONT 16 CON 0 FONT 15 CON 0 FONT 14 CON 0 FONT 13 CON 0 FONT 12 CON 0 FONT 11 CON 0 FONT 10 CON 0 FONT 9 CON 0 FONT 8 CON 0 FONT 7 DATA 0LCOURNEW FONT 6 DATA 0LCOURIER FONT 5 DATA 0LUOL816 FONT 4 DATA 0LUOL814 FONT 3 DATA 0LTERMINAL FONT 2 DATA 0LDEFAULT FONT 1 * NMODES EQU 4 FONTMOD BSS 0 DATA 6LITALIC DATA 4LBOLD DATA 6LSTRIKE DATA 7LUNDERLN * FARGMAX BSS 1 MAXIMUM ARGUMENT COUNT * ENDOV * /--- BLOCK END 00 000 77/07/30 01.33 * * OVTABLE * * END COVLY2$