COVLAY4 * /--- FILE TYPE = E * /--- BLOCK COVLAY4 00 000 75/10/04 11.48 IDENT COVLAY4 LCC OVERLAY(1,1) * TITLE OVERLAYS FOR COMMAND READINS * * CST * * EXT ERRORC,PUTCODE,DATAON=,CALCODE EXT COMCONT,VARFIN,NXTLINE,ALTCODE EXT ECSPRTY,KEYTYPE,NKLIST,NKLEND EXT LNGUNIT,COMPNAM,SCANNER,UARGS,CSSCAN EXT UNIT=,ARG=,DO=,DOJ=,DOC=,UNITOP= EXT STORE= EXT JOIN=,JOINC=,JDO=,IEUEND= EXT ITFFTI,DOVTYPE,ERRCALL EXT PSCAN,PAUSE2 EXT PUTTWO EXT ERRTAGS,ERRNAME,ERRSTOR EXT ERRXYTG,ERR2MNY,ERR2FEW EXT ERRTERM,ERRUARG,ERRVTYP EXT ERROUTR,ERRCNTD,ERRXORQ EXT ERRBAL EXT NOINDT,UDONE EXT ONETWO1,NOTAG,ERR EXT MRKLAST EXT RJERNOZ * * COVLY4$ OVFILE * * * /--- BLOCK COV4 00 000 80/06/24 21.42 TITLE -COV4- COMMAND OVERLAY * * * COV4 OVRLAY SA1 OVARG1 GET ARGUMENT SB1 X1 JP B1+*+1 * + EQ SLOADIN 0 = -STOLOAD- + EQ ABORTIN 1 = -ABORT- + EQ CLEANC 2 = -CLEAN- + EQ SENDC 3 = -SEND- + EQ MASREQC 4 = -MASREQ- + EQ RESERVC 5 = -RESERVE- + EQ SYSDIN 6 = -SYSDATA- + EQ FBITIN 7 = -FBIT- + EQ ADD1IN 8 = -ADD1- + EQ ZEROC 9 = -ZERO- + EQ * 10 = UNUSED + EQ ALLOWC 11 = -ALLOW- + EQ STEPC 12 = -STEP- + EQ LESSINC 13 = -LESSIN- + EQ * 14 = UNUSED + EQ * 15 = UNUSED + EQ INDENTC 16 = -INDENT- + EQ SETIN 17 = -SET- + EQ TEKTRON 18 = -TEKTRON- + EQ REPLACC 19 = -REPLACE- + EQ GETCDIN 20 = -GETCODE- + EQ PERMITC 21 = -PERMIT- + EQ TSTBINC 22 = -TESTBIN- + EQ LBC 23 = -FINDLB-, -DELLB-, -SYSABRT- + EQ ADDLBC 24 = -ADDLB- + EQ ERRORC * * * /--- BLOCK -STOLOAD- 00 000 77/04/24 20.48 TITLE -STOLOAD- AND -COMLOAD- * * * * -STOLOAD- AND -COMLOAD- COMMANDS * * SLOADIN MX6 0 SA1 TAGCNT SEE IF BLANK TAG ZR X1,SLBLANK SA6 NCONT CLEAR CONTINUE COUNT SA6 VARBUF+1 FIRST IS NUMBER OF LOADS SA6 VARBUF+2 SECOND IS UNUSED SX6 2 SA6 VARBUF INITIALIZE VARIABLE COUNT * SLOLP CALL VARDO2 GET FIRST VARIABLE SA1 VARBUF SA2 X1+VARBUF LOAD -GETVAR- CODE NG X2,ERRSTOR EXIT IF NOT STOREABLE MX0 -3 AX2 XCODEAL POSITION TYPE CODE BX2 -X0*X2 SX2 X2-2 SEE IF STUDENT BANK REFERENCE ZR X2,SLERR2 CALL VARDO2 GET NEXT TWO VARIABLES CALL VARDO2 SA1 LASTKEY NZ X1,ERR2MNY MUST BE E-O-L SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED BX2 X1-X2 ZR X2,ISSCONT JUMP IF CONTINUED SA1 NCONT SX6 X1+1 NUMBER OF LOAD SELECTIONS SA6 VARBUF+1 SA1 VARBUF NUMBER OF -GETVAR- CODES EQ VARFIN PACK UP -GETVAR- CODES * ISSCONT CALL GETLINE GET NEXT LINE OF COMMAND SA1 NCONT SX2 X1-2 SEE IF TOO MANY CONTINUES PL X2,SLERR1 SX6 X1+1 SA6 A1 EQ SLOLP * SLBLANK SA1 NEXTCOM SEE IF CONTINUED SA2 COMCONT BX2 X1-X2 ZR X2,ERRCNTD ERROR IF CONTINUED EQ PUTCODE * SLERR1 SB1 49 TOO MANY EQ =XERR * SLERR2 SB1 50 NOT COMMON EQ =XERR * NCONT BSS 1 * * * /--- BLOCK ABORT 00 000 80/02/15 22.08 TITLE -ABORT- COMMAND * * * -ABORT- COMMAND * ABORT VARIOUS SYSTEM FUNCTIONS * * ABORTIN SB1 ABLIST SB2 ABEND MX5 60 RJ SCANNER ZR X0,PUTCODE EQ ERRNAME * ABLIST VFD 60/6LCOMMON VFD 60/6LRECORD VFD 60/9LAUTOCHECK VFD 60/7LLESLIST ABEND BSS 1 * * * * CONDENSE ROUTINE FOR LESSON BUFFER COMMANDS * USED BY -FINDLB-, -DELLB-, -SYSABRT- * LBC CALL SYSTEST SYSTEM LESSONS ONLY CALL FILEBLK GET ACCOUNT';FILE, BLOCK ZR X1,ERR2FEW ERROR IF BLANK TAG CALL VARDOR GET LESSON BUFFER TYPE SX1 4 4 ARGUMENTS LEGAL EQ VARFIN * * * -ADDLB- COMMAND * ADDLBC CALL SYSTEST SYSTEM LESSONS ONLY CALL FILEBLK GET ACCOUNT';FILE, BLOCK ZR X1,ERR2FEW ERROR IF BLANK TAG CALL VARDOR GET BUFFER TYPE AND LENGTH SX1 5 5 ARGUMENTS LEGAL EQ VARFIN * * /--- BLOCK CLEAN 00 000 80/06/24 22.28 * * * -CLEAN- COMMAND * CLEANC RJ VARDO COMMA SEPARATED VARIABLES SX1 2 PRESET TO 2 ARGS FOR *VARFIN* SA2 VARBUF CHECK NUMBER OF ARGUMENTS ZR X2,ERR2FEW MUST BE AT LEAST 1 SA3 VARBUF+1 NG X3,ERRSTOR --- 1ST ARG MUST BE STOREABLE SX2 X2-2 CHECK IF 1 OR 2 ARGUMENTS ZR X2,VARFIN --- DONE IF 2 ARGUMENTS PL X2,ERR2MNY --- ERROR IF > 2 ARGUMENTS SX6 1 SA6 VARBUF+2 FAKE 2ND GETVAR CODE = 1 SX6 2 SA6 VARBUF SET NUMBER OF ARGUMENTS TO 2 EQ VARFIN --- FINISH UP * /--- BLOCK SEND 00 000 80/03/16 06.34 TITLE -SEND- * * -SEND- COMMAND * * SEND STATION,WHERE,BUFFER,LENGTH * SEND STATION,BEEP * SEND STATION,ERASE * * SEND STATION,ON,WHERE,BUFFER,LENGTH * SEND STATION,OFF,WHERE,BUFFER,LENGTH * SEND STATION,ALL,WHERE,BUFFER,LENGTH * * SEND STATION,ON,BEEP * SEND STATION,OFF,BEEP * SEND STATION,ALL,BEEP * * SEND STATION,ON,ERASE * SEND STATION,OFF,ERASE * SEND STATION,ALL,ERASE * * * -SEND- IS A SYSTEM COMMAND TO SEND TEXT, * BEEPS AND FULL-SCREEN ERASES TO ACTIVE OR * INACTIVE TERMINALS OR BOTH (ONLY ACTIVE * TERMINALS CAN BE BEEPED) * * THE GETVAR CODES ARE USED AS FOLLOWS -- * * CODE 1 -- STATION NUMBER (-1 IF OUTPUT * IS FOR ALL STATION) * CODE 2 -- 10/0,5/STYPE,5/SWHO * CODE 3 -- SCREEN POSITION IF TEXT OPTION * CODE 4 -- BUFFER WITH TEXT * CODE 5 -- LENGTH OF TEXT IN CHARACTERS * * STYPE = 0 = TEXT * 1 = BEEP * 2 = ERASE * * SWHO = 0 = ACTIVE STATIONS * 1 = BOTH * 2 = INACTIVE STATIONS * * AT EXECUTION TIME *STYPE* AND *SWHO* ARE * CHANGED TO DECREMENTED BY 1. * * /--- BLOCK SEND 00 000 80/03/16 06.44 SENDC CALL SYSTEST CALL VARDO1 DECODE FIRST ARGUMENT SX6 0 SA6 SWHO PRESET FOR ACTIVE STATIONS SA1 WORDPT BX6 X1 SA6 OLDPT SAVE CHAR POINTER SX6 2 SAVE 2ND VARBUF CODE SA6 VARBUF CALL NXTNAME NEXT TAG RETURNED IN X6 * SEPARATOR IN X1 ZR X1,SBEEP SA1 ONOFFTAB-1 PRESET (A1) FOR SEARCH MX0 48 ONOFFL SA1 A1+1 (X1) = NEXT KEYWORD ZR X1,SENORM OLD TEXT -SEND- IF END OF TABLE BX2 X0*X1 BX2 X2-X6 NZ X2,ONOFFL --- IF NO MATCH BX6 -X0*X1 (X6) = ACTIVE/INACTIVE CODE SA6 SWHO SA1 WORDPT BX6 X1 SA6 OLDPT ADVANCE SAVED CHAR POINTER CALL NXTNAME (X6) = PARAMETER, (X) = SEP. NZ X1,SENORM --- NORMAL TEXT IF NOT EOL SBEEP SA1 KBEEP BX2 X6-X1 SEE IF 4LBEEP NZ X2,SERASE --- IF NOT BEEP OPTION SX6 1 TYPE 1 = BEEP EQ SENDFIN SERASE SA1 KERASE BX2 X1-X6 SEE IF 5LERASE NZ X2,ERRTAGS --- IF NOT ERASE OPTION SX6 2 TYPE 2 = ERASE EQ SENDFIN * /--- BLOCK SEND 00 000 80/03/16 06.42 * BEEPCON VFD 20/0,1/1,19/1,20/0 KBEEP DATA 0LBEEP KERASE DATA 0LERASE * ONOFFTAB VFD 48/0LON,12/0 VFD 48/0LALL,12/1 VFD 48/0LOFF,12/2 DATA 0 MARK END OF TABLE * SWHO BSS 1 FOR ACTIVE/INACTIVE/BOTH INFO STYPE BSS 1 FOR TEXT/SEND/ERASE OPTION * * CONDENSE NORMAL TEXT -SEND- * SENORM SA1 OLDPT NORMAL SEND CONDENSE BX6 X1 SA6 WORDPT RESTORE WORDPT * SGETA CALL VARDO2 GET NEXT ARGUMENT SA1 LASTKEY NZ X1,SGETA CONTINUE IF NOT E-O-L * SA1 VARBUF SX1 X1-5 MUST BE 5 ARGUMENTS NZ X1,ERRTAGS SA1 VARBUF+4 4TH ARG MUST BE STOREABLE NG X1,ERRSTOR SX6 0 TYPE 0 = TEXT * * FORMAT SEND GETVAR CODE (10/0,5/STYPE,5/SWHO) * AND EXIT TO *VARFIN* * * COME HERE WITH (X6) = TYPE OF SEND * SENDFIN LX6 5 SA2 SWHO BX6 X6+X2 SA6 VARBUF+2 SA1 VARBUF (X1) = NUMBER OF VARBUF CODES EQ VARFIN MASREQC TITLE -MASREQ- READIN MSRQKEY SPACE 4,15 ** MSRQKEY - TABLE OF -MASREQ- KEYWORDS. * * MSRQKEY KEYWORD,NUMARGS,NUMPUTV,NUMSTOR * *T 42/7LKEYWORD,6/NUMARGS,6/NUMPUTV,6/NUMSTOR * * KEYWORD = VALID KEYWORD FOR -MASREQ- COMMAND * NUMARGS = TOTAL NUMBER OF ARGUMENTS REQUIRED * NUMPUTV = POSITION OF ARGUMENT REQUIRING A PUTVAR * CODE. IF = 0, NONE IS REQUIRED. * NUMSTOR = POSITION OF ARGUMENT WHICH MUST BE * STOREABLE. IF = 0, NONE IS REQUIRED. PURGMAC MSRQKEY MACREF MSRQKEY$ MSRQKEY MACRO KEYWORD,NUMARGS,NUMPUTV,NUMSTOR MACREF MSRQKEY IFC EQ,*KEYWORD** DATA 0 ELSE VFD 42/0L_KEYWORD,6/NUMARGS,6/NUMPUTV,6/NUMSTOR ENDIF ENDM MSRQTAB MSRQKEY ACTION,5,0,0 MSRQKEY CONSOLE,7,0,0 MSRQKEY JOBLIST,4,0,3 MSRQKEY JOBSTAT,4,4,0 MSRQKEY PPU,5,0,0 MSRQKEY SCR,3,0,3 MSRQKEY STATUS,3,3,0 MSRQKEY CONFIG,3,0,3 MSRQKEY END OF MSRQTAB MASREQC SPACE 4,25 * /--- BLOCK SEND 00 000 80/03/16 06.42 ** MASREQC - PROCESS -MASREQ- COMMAND. * * CALLS ERRSTOR, ERRTERM, ERR2FEW, ERR2MNY, MRKLAST, * NXTNAM, PUTDO2, SYSTEST, VARDO1, VARDO2. * * MACROS CALL MASREQC CALL SYSTEST CHECK FOR SYSTEM LESSON SA1 SYSFLG (X1) = SYSTEM LESSON ATTRIBUTES LX1 ZMASSHF SHIFT TO *MAS* PERMISSION BIT PL X1,ERRORC IF NO -MASREQ- PERMISSION CALL VARDO1 PROCESS *MFN* ARGUMENT SA1 WORDPT (X1) = POINTER TO CURRENT CHAR SA1 X1-1 (X1) = DELIMITER (PREVIOUS CHR) ZR X1,ERR2FEW IF END OF LINE SX6 X1-1R, NZ X6,ERRTERM IF NOT A COMMA CALL NXTNAM (X6) = NEXT TAG, (X1) = SEPARATOR ZR X6,ERR2FEW IF END OF LINE BX7 X1 SA7 LASTKEY SAVE LAST DELIMITER * SEARCH FOR KEYWORD IN TABLE. SA1 MSRQTAB-1 MX0 42 MAS1 SA1 A1+1 ZR X1,ERRNAME IF INVALID KEYWORD BX2 X1*X0 BX3 X2-X6 NZ X3,MAS1 IF KEYWORD NOT FOUND SX7 A1-MSRQTAB+1 STORE KEYWORD ORDINAL SA7 VARBUF+2 MX0 -6 STORE STOREABLE NUMBER BX7 -X0*X1 SA7 NUMSTOR LX1 -6 STORE PUTVAR NUMBER BX7 -X0*X1 SA7 NUMPUTV LX1 -6 STORE NUMBER OF ARGUMENTS BX7 -X0*X1 SA7 NUMARGS SX7 2 CURRENT ARGUMENT POSITION SA7 VARBUF SA7 ARGCNT MAS3 SA1 ARGCNT INCREMENT ARGUMENT COUNT SX7 X1+1 SA7 ARGCNT SA2 LASTKEY CHECK DELIMITER ZR X2,ERR2FEW IF END OF LINE SX6 X2-1R, NZ X6,ERRTERM IF NOT A COMMA SA2 NUMPUTV CHECK FOR PUTVAR REQUIRED BX6 X7-X2 ZR X6,MAS5 IF PUTVAR REQUIRED CALL VARDO2 GENERATE GETVAR CODE SA2 NUMSTOR CHECK IF STORE NEEDED SA3 ARGCNT BX6 X3-X2 NZ X6,MAS10 IF NO STORE NEEDED * /--- BLOCK SEND 00 000 80/03/16 06.42 NG X1,ERRSTOR IF NOT STOREABLE EQ MAS10 MAS5 CALL PUTDO2 GENERATE PUTVAR CODE MAS10 SA1 ARGCNT CHECK FOR LAST ARGUMENT SA2 NUMARGS BX3 X2-X1 NZ X3,MAS3 IF MORE ARGUMENTS SA1 WORDPT CHECK FOR END OF LINE SA1 X1 NZ X1,ERR2MNY IF TOO MANY ARGUMENTS EQ MRKLAST TERMINATE GETVAR TABLE ARGCNT OVDATA 1 CURRENT ARGUMENT NUMBER NUMARGS OVDATA 1 NUMBER OF ARGUMENTS REQUIRED NUMPUTV OVDATA 1 POSITION OF PUTVAR ARGUMENT NUMSTOR OVDATA 1 POSITION OF STOREABLE ARGUMENT * * * * /--- BLOCK RESERVE 00 000 80/03/12 01.03 * TITLE -RESERVE- / -RELEASE- COMMANDS * * * * -RESERVE- / -RELEASE- COMMANDS * * RESERVE COMMON * RESERVE FILE * RESERVE RECORDS,BLOCK (,NBLOCKS) * RESERVE NAME * RESERVE SIGNON (,PERMANENT) $$ SYSTEM LESSONS * RESERVE DIRECTORY $$ DATASETS, NAMESETS, GROUPS * RESERVE ATTACH * RESERVE LESLIST * * RESERVC CALL NXTNAME GET NAME IN X6, SEP. IN X1 SA3 KCOMM BX3 X3-X6 CHECK FOR *COMMON* ZR X3,RESVCOM SA3 KFILE BX3 X3-X6 CHECK FOR *FILE* ZR X3,RESVFIL SA3 KRECS BX3 X3-X6 CHECK FOR *RECORDS* ZR X3,RESVREC SA3 KNAME BX3 X3-X6 CHECK FOR *NAME* ZR X3,RESVNAM SA3 KSIGNON BX3 X3-X6 CHECK FOR *SIGNON* ZR X3,RESVSIG SA3 KDIRECT BX3 X3-X6 CHECK FOR *DIRECTORY* ZR X3,RESVDIR SA3 KATTACH BX3 X3-X6 CHECK FOR *ATTACH* ZR X3,RESVATT SA3 KLESLST IX3 X3-X6 CHECK FOR *LESLIST* ZR X3,RESVLST SA3 KSIGNO BX3 X3-X6 CHECK FOR *SIGNOUT* ZR X3,RESVSGN EQ ERRNAME * RESVCOM NZ X1,ERR2MNY MUST BE E-O-L MX6 0 0 = ENTIRE COMMON EQ PUTCODE * RESVFIL NZ X1,ERR2MNY MUST HAVE NO ARGUMENTS SX6 1 1 = ENTIRE FILE LX6 XCMNDL SHIFT PAST COMMAND CODE EQ PUTCODE * RESVNAM NZ X1,ERR2MNY MUST HAVE NO ARGUMENTS SX6 2 2 = ENTIRE NAME (IN NAMESET) LX6 XCMNDL EQ PUTCODE * /--- BLOCK RESERVE 00 000 80/08/07 02.17 * * RESVREC CALL VARDO SA1 VARBUF SX2 X1-2 ZR X2,RESVD2 PL X2,ERR2MNY SX2 X1-1 NZ X2,ERRTAGS * ONLY ONE ARG--SET DEFAULT VALUE SX7 1 SA7 VARBUF+2 IX7 X7+X7 SA7 VARBUF RESET ARGUMENT COUNT RESVD2 CALL VARFEM MX2 -XSPTRL THIS IS BECAUSE VARFEM ALWAYS LX2 XCMNDL INSERTS THE XSTOR POINTER BX6 X2*X6 ZERO OUT EXTRA STORAGE POINTER SX3 3 3 = DATASET RECORDS LX3 XCMNDL SHIFT PAST COMMAND CODE BX6 X6+X3 MARK AS A DATASET -RESERVE- EQ PUTCODE * RESVSIG NZ X1,ERR2MNY --- IF ADDITIONAL TAGS CALL SYSTST1 SYSTEM LESSONS ONLY SX6 4 4 = PLATO SIGNON LX6 XCMNDL EQ PUTCODE * RESVDIR NZ X1,ERR2MNY MUST HAVE NO ARGUMENTS SX6 5 5 = DIRECTORY LX6 XCMNDL EQ PUTCODE * RESVATT NZ X1,ERR2MNY MUST HAVE NO ARGUMENTS CALL SYSTEST SYSTEM LESSONS ONLY SX6 6 6 = ATTACH LX6 XCMNDL EQ PUTCODE * * RESVLST NZ X1,ERR2MNY MUST HAVE NO ARGUMENTS SX6 7 7 = LESLIST LX6 XCMNDL EQ PUTCODE * RESVSGN NZ X1,ERR2MNY MUST HAVE NO ARGUMENTS CALL SYSTST1 SPECIAL SYSTEM LESSONS ONLY SX6 8 6 = SIGNOUT LX6 XCMNDL EQ PUTCODE * KLESS DATA 0LLESSON KCOMM DATA 0LCOMMON KRECS DATA 0LRECORDS KFILE DATA 0LFILE KNAME DATA 0LNAME KSIGNON DATA 0LSIGNON KDIRECT DATA 0LDIRECTORY KATTACH DATA 0LATTACH KLESLST DATA 0LLESLIST KSIGNO DATA 0LSIGNOUT * * /--- BLOCK -SYSDATA- 00 000 81/01/08 01.08 TITLE READ-IN FOR -SYSDATA- COMMAND * * * * -SYSDATA- COMMAND * SYSDIN CALL SYSTEST SYSTEM LESSONS ONLY CALL NXTNAME DECODE OPTION NAME **** SA1 KSETF IX1 X1-X6 ZR X1,SDSET JUMP IF SETFILE SA1 KREW IX1 X1-X6 ZR X1,SDREW JUMP IF REWIND SA1 KCHECK IX1 X1-X6 ZR X1,SDCHK JUMP IF CHECKPT EQ ERRNAME ERROR IF UNRECOGNIZED OPTION * * GET ACCOUNT';FILE FOR -SETFILE- FORM * SDSET CALL ACCFILE,VARBUF+2,0 ZR X1,ERR2FEW ERROR IF NO FILE GIVEN SA1 LASTKEY NZ X1,ERR2MNY ERROR IF EXTRA ARGUMENTS SX6 0 SET OPTION NUMBER SA6 VARBUF+1 SX6 3 THREE ARGUMENTS SA6 VARBUF BX1 X6 EQ VARFIN * SDREW SX6 1 REWIND OPTION EQ SDRC * SDCHK SX6 2 CHECKPT OPTION * SDRC LX6 60-XCODEL POSITION OPTION NUMBER SA1 WORDPT POINTER TO LAST CHARACTER SA1 X1 ZR X1,PUTCODE EXIT IF END OF LINE EQ ERR2MNY ERROR IF EXTRA ARGUMENTS * * KSETF DATA 0LSETFILE KREW DATA 0LREWIND KCHECK DATA 0LCHECKPT * * TITLE READ-IN FOR -FBIT- COMMAND * * * * -FBIT- COMMAND * FIRST ARG = FILE NAME * SECOND = ON OR OFF * * FBITIN CALL SYSTEST SYSTEM LESSONS ONLY CALL COMPILE GET -GETVAR- CODE FOR FILE NAME LX1 60-XCODEL BX6 X1 SAVE SA6 VARBUF CALL COMPSYM,FBLST,2 LX1 60-2*XCODEL SA2 VARBUF BX6 X1+X2 EQ PUTCODE * FBLST VFD 42/0LON,18/1 + VFD 42/0LOFF,18/0 * * TITLE -TESTBIN- * * -TESTBIN- COMMAND * * CHECK FOR EXISTANCE OF BINARY * * TSTBINC CALL SYSTEST SYSTEM LESSONS ONLY CALL ACCFILF GET ACCOUNT';FILE NAME ZR X1,ERR2FEW ERROR IF BLANK TAG SA2 LASTKEY ZR X2,MRKLAST EXIT IF END OF LINE CALL VARDO2 SA2 LASTKEY ZR X2,MRKLAST EXIT IF END OF LINE EQ ERR2MNY NO MORE THAN 2 ARGUMENTS * * /--- BLOCK -ADD1- 00 000 77/04/24 20.21 TITLE ADD1, SUB1, ZERO AND ZERO* COMMANDS * * * -ADD1- AND -SUB1- COMMANDS * * ADD1IN CALL TAGSAVE SAVE *TAG* BUFFER SA1 WORDPT BX6 X1 SAVE *WORDPT* SA6 VARBUF+1 CALL COMPILE BX6 X1 SAVE -GETVAR- CODE SA6 VARBUF CALL TAGREST (COMPILE MAY MODIFY *TAG*) SA1 VARBUF+1 BX6 X1 SA6 WORDPT RESET *WORDPT* CALL PUTCOMP SA2 VARBUF LOAD FIRST -GETVAR- CODE LX2 60-XCODEL LX1 60-XCODEL-XCODEL BX6 X1+X2 MERGE READ/STORE -GETVAR- CODES EQ PUTCODE * * * * -ZERO- COMMAND * * ZEROC SA1 WORDPT POINTER TO FIRST CHARACTER MX0 0 NO SPECIAL TERMINATOR CALL PSCAN FIND END OF FIRST ELEMENT NZ X1,ZERO2A JUMP IF TWO ARGUMENT COMMAND CALL PUTCOMP BX6 X1 POSITION -GETVAR- CODE LX6 60-XCODEL EQ PUTCODE * * * *MUST TEST THAT THERE ARE NO MORE THAN 2 ARGS..... * ZERO2A CALL COMPILE DECODE FIRST VARIABLE NZ B1,ERRSTOR BX6 X1 SA6 VARBUF SAVE -GETVAR- CODE CALL COMPILE SA2 WORDPT CHECK FOR END-OF-LINE SA2 X2 DO INDIRECT ACCESS NZ X2,ERR2MNY ERROR IF NOT EOL SA2 VARBUF LX2 60-XCODEL POSITION -GETVAR- CODES LX1 60-XCODEL-XCODEL BX6 X1+X2 SA1 COMNUM SX1 X1+1 INCREMENT COMMAND NUMBER BX6 X1+X6 EQ ALTCODE * * * /--- BLOCK ALLOW 00 000 79/07/19 23.15 * TITLE -ALLOW- * * -ALLOW- COMMAND * * ALLOW ACCESS TO ROUTER LESSONS COMMON * * ALLOWC SA1 ROUTER MUST BE -ROUTER- LESSON ZR X1,ERROUTR CALL NXTNAME GET ALLOW TYPE **** NZ X1,ERR2MNY MUST BE END-OF-LINE SB1 B0 ZR X6,ALLW1 JUMP IF BLANK SB1 B1+1 SA1 KRD BX1 X1-X6 ZR X1,ALLW1 JUMP IF *READ* SB1 B1+1 SA1 KWT BX1 X1-X6 ZR X1,ALLW1 JUMP IF *WRITE* SB1 B1+1 SA1 RVREAD BX1 X1-X6 NZ X1,ERRNAME MUST BE *READ RVARS* * ALLW1 SX6 B1 PICK UP TYPE LX6 60-12 EQ PUTCODE --- ADD COMMAND CODE AND STORE * RVREAD DATA 10LREAD RVARS KRD DATA 0LREAD KWT DATA 0LWRITE * * TITLE -PERMIT- * * -PERMIT- COMMAND * * PERMIT VARIOUS THINGS IN A LESSON * * PERMITC CALL NXTNAME GET ALLOW TYPE **** NZ X1,ERR2MNY MUST BE END-OF-LINE SB1 B0 ZR X6,PRMT1 JUMP IF BLANK SB1 B1+1 SA1 KSR BX1 X1-X6 ZR X1,PRMT1 JUMP IF *SHORT RECS* SA1 KSRNS BX1 X1-X6 ZR X1,PRMT1 JUMP IF *SHORTRECS* NZ X1,ERRNAME MUST BE *SHORTRECS* * PRMT1 SX6 B1 PICK UP TYPE LX6 60-12 EQ PUTCODE --- ADD COMMAND CODE AND STORE * KSR DATA 10LSHORT RECS KSRNS DATA 0LSHORTRECS * * TITLE -STEP- * * -STEP- COMMAND * * INITIATE/TERMINATE STEP MODE EXECUTION * * STEPC CALL COMPSYM,STEPOPT,2 EQ CALCODE * STEPOPT VFD 42/2LON,18/1 + VFD 42/3LOFF,18/0 * /--- BLOCK -LESSIN- 00 000 80/02/02 22.08 TITLE -LESSIN- COMMAND * * * * -LESSIN- COMMAND * CHECKS TO SEE IF A LESSON IS IN ECS * * LESSINC BSS 0 * * CONDENSE FILE NAME AS NORMAL TUTOR EXPRESSION * CALL ACCFILE,VARBUF+1,1 ZR X1,ERR2FEW ERROR IF BLANK TAG SA2 LASTKEY NZ X2,ERR2MNY ERROR IF EXTRA ARGUMENTS SX1 2 2 ARGUMENTS LEGAL BX6 X1 SA6 VARBUF 2 ARGUMENTS FOUND EQ VARFIN * * * * /--- BLOCK INDENT 00 000 77/09/15 20.17 TITLE -INDENT- COMMAND READIN INDENTC CALL VARDO * MAKE SURE THAT ARGUMENTS 1,3,4,5,6 ARE STOREABLE SA1 VARBUF+1 NG X1,=XERRSTOR SA1 VARBUF+3 NG X1,=XERRSTOR SA1 VARBUF+4 NG X1,=XERRSTOR SA1 VARBUF+5 NG X1,=XERRSTOR SA1 VARBUF+6 NG X1,=XERRSTOR SX1 6 MUST HAVE EXACTLY SIX ARGUMENTS EQ =XVARFIN * * -COUNTLN- COMMAND * * FORMAT OF COMMAND * COUNTLN START,LENGTH,POS,COUNT,RETURN[,MODS] * MAKE SURE THAT ARGUMENTS 1 AND 5 ARE STORABLE * ******* REMOVED THE CONDENSE ROUTINE FOR -COUNTLN- SINCE ******* IT SEEMS DOUBTFUL THAT ANYONE WILL EVER FINISH ******* THIS FOUR YEAR OLD PROJECT. ******* D. WOOLLEY 81/08/10 * * CNTLNC BSS 0 * RJ SYSTEST SYSTEM LESSONS ONLY FOR NOW * CALL VARDO * SA1 VARBUF+1 * NG X1,=XERRSTOR * SA1 VARBUF+5 * NG X1,=XERRSTOR * SA1 VARBUF * SX2 X1-5 * ZR X2,CNTLNL JUMP IF NO 6TH * SX2 X1-6 * NZ X2,=XERRTAGS * CNTFIN SX1 6 MUST HAVE EXACTLY SIX ARGUMENTS * EQ =XVARFIN ** * CNTLNL SX6 0 * SA6 VARBUF+6 FAKE UP GETVAR CODE = 0. * SX6 6 * SA6 VARBUF * EQ CNTFIN * * /--- BLOCK -TEKTRON- 00 000 81/08/10 13.03 TITLE -TEKTRON- * * -TEKTRON- COMMAND * * TEKTRON ON TOP 2 BITS OF COMMAND WORD SET * TEKTRON OFF TOP 1 BIT OF COMMAND WORD SET * TEKTRON VAR,LTH JUST TWO NORMAL GETVAR CODES * * TEKTRON BSS 0 SA1 TEKON CALL TAGXACT MX6 2 NG X1,PUTCODE IF -TEKTRON ON- SA1 TEKOFF CALL TAGXACT MX6 1 NG X1,PUTCODE IF -TEKTRON OFF- EQ =XCOLLCTC GO GET TWO ARGUMENTS, 1ST MUST BE STORABLE TEKON DATA 2LON TEKOFF DATA 3LOFF * /--- BLOCK -REPLACE- 00 000 78/04/14 01.19 TITLE -REPLACE- COMMAND READIN * * FORMAT OF COMMAND * * REPLACE IN,LTH,OUT,LTH,TABLE,LTH,CHARS,MODE * * ARGUMENTS 1,3,5,7 MUST BE STOREABLE * REPLACC CALL SYSTEST CALL VARDO * MAKE SURE THAT ARGUMENTS 1,3,5,7 ARE STOREABLE SA1 VARBUF+1 NG X1,=XERRSTOR SA1 VARBUF+3 NG X1,=XERRSTOR SA1 VARBUF+5 NG X1,=XERRSTOR SA1 VARBUF+7 NG X1,=XERRSTOR SX1 8 MUST HAVE EXACTLY 8 ARGUMENTS EQ =XVARFIN * /--- BLOCK -GETCODE- 00 000 78/05/11 18.05 * * -GETCODE- * * FIRST TAG IS VARIABLE TO STORE THE CODEWORD IN. * NEXT (OPTIONAL) IS A LIST OF KEYS THAT TERMINATE * THE ENTRY. THE LIST IS PRECEDED BY ',ENDKEYS=', * EXT NKLIST EXT NKLEND * GETCDIN CALL COMPILE COMPILE FIRST TAG NZ B1,ERRSTOR MUST BE STOREABLE BX6 X1 SAVE -GETVAR- CODE SA6 VARBUF CALL NXTNAM SEE IF THERE IS ANYTHING ELSE ZR X6,GETCIN3 IF NO SECOND ARGUMENT SX1 X1-1R= TERMINATOR MUST BE ',=', NZ X1,ERRTERM WASN'7T SA1 GETCDA WORD MUST BE ',ENDKEYS', BX1 X1-X6 NZ X1,ERRNAME NOT SO MX4 0 SCAN CALL NXTNAM GET NEXT WORD ZR X6,GETCIN2 --- IF NO MORE SX5 1 SB1 -1 MX0 42 MASK FOR NAMES SA6 NKLEND PLANT FOR END TEST SCAN2 SB1 B1+1 SA1 NKLIST+B1 GET NEXT ENTRY BX1 X1-X6 BX1 X0*X1 MASK OUT SIGNIFICANT BITS NZ X1,SCAN2 --- IF NO MATCH SB2 NKLEND SB2 A1-B2 ZR B2,ERRNAME --- IF BAD KEY NAME LX5 B1 POSITION BIT BX4 X4+X5 MERGE IT IN EQ SCAN DO NEXT ONE * GETCIN2 SA2 VARBUF GET GETVAR CODE BACK LX2 2*XCODEL SHIFT INTO PLACE SX0 1 LX0 NEXT-FUNKEY FORM BIT FOR -NEXT- BX6 X4+X0 SET INTO KEYLIST LX6 XCMNDL MAKE ROOM FOR COMMAND CODE BX6 X6+X2 MOVE FIRST ARGUMENT IN EQ PUTCODE STORE IT * GETCIN3 MX4 0 EQ GETCIN2 ONE ARGUMENT CASE * GETCDA DATA L*ENDKEYS* * /--- BLOCK -SET- 00 000 80/02/15 22.08 * TITLE -SET- COMMAND * * SET ARRAY_ARG1,ARG2,ARG3,... * SET ARRAY(R,C)_ARGI,ARGJ,ARGK,... * SET V1_ARG1,ARG2,... * * FILLS CONSECUTIVE VARIABLES WITH ITEMS IN LIST * BEGINNING AT FIRST ARGUMENT AND GOING UP * GIVES ERROR MSG AT CONDENSE TIME (IF POSSIBLE) * OR EXEC TIME IF LIST RUNS OVER PERMISSIBLE BOUNDS * OF ARRAY OR STUDENT VARIABLES * EXT EQERR EXT VARSEP,VARLEX,VARFINM,VARDOC,VARDOCL EXT ARAYFLG,TSTERR,CPXERR EXT ECSPRTY * SETIN SA1 WORDPT BX6 X1 MX7 59 -1 SA6 VARBUF SAVE WORDPT HERE SA7 VSKMODE DONT EXPAND DEFINE * DO SEARCH FOR ASSIGN ARROW, CHANGE TO COMMA SA1 SEPASGN BX7 X1 SET TO DETECT ASSIGN ARROW SA7 VARSEP RJ VARLEX SEARCH FOR FIRST ARROW ZR X1,NOASSGN ERROR IF NOT FOUND SX6 1R, CHANGE TO COMMA SA6 X7 ADDR OF ARROW LEFT HERE CALL INITLEX CALL LEX GET FIRST LEXICAL ITEM SA4 VARBUF BX6 X4 SA6 WORDPT RESET FOR COMPILATION * SA2 OP ZR X2,SET20 JUMP IF ADTYPE LIKE N1,V1 SX6 X2-OPDEFN CHECK FOR DEFINED WORD NZ X6,SET20 JUMP IF SOME OTHER OP SA1 ADTYPE SET05 ZR X1,EQERR DEFINE MUST HAVE ADTYPE NG X1,EQERR ERROR IF UNKNOWN NAME MX0 -XCODEAL BX3 -X0*X1 ADDRESS AX1 XCODEAL GETVAR TYPE SX6 X1-6 NZ X6,SET20 JUMP IF NOT ARRAY DEFINE * SET10 SA2 ATOKEN ADDR OF TOKENS IX0 X3+X2 ECS ADDR OF LITERAL SA0 VARBUF+1 SAVE HERE AS FLAG FOR ARRAY + RE 1 READ LITERAL FROM ECS RJ ECSPRTY SX7 1 SA7 ARAYFLG ALLOW ARRAY COMPILE EQ SET30 * SET20 SX6 0 SA6 VARBUF+1 FLAG NOT ARRAY SA6 ARAYFLG DONT ALLOW ARRAY COMPILE * SET30 CALL COMPILE GET STARTING ADDR GETVAR NE B1,B0,SETER2 ERROR FROM -COMPILE- BX6 X1 SA6 VARBUF+2 2D ARG = START ADDR GETVAR SX7 2 SA7 VARBUF 2 ARGUMENTS SO FAR SA7 ARAYFLG ARAYS NOT ALLOWED IN LIST SA1 SET99 BX6 X1 PUT EQ SET40 IN RETURN SA6 VARDOC EQ VARDOCL CONTINUE READING LIST ITEMS * * /--- BLOCK SET30 00 000 80/02/15 22.08 * * CHECK IF LIST EXCEEDS MAX ADDR IF POSSIBLE SET40 SA1 VARBUF RETURN FROM PACKING UP LIST SX1 X1-2 NUMBER ITEMS IN LIST SA2 VARBUF+1 =0 OR =SIZE SA3 VARBUF+2 START GETVAR MX0 -XCODEAL ZR X2,SET50 JUMP IF NOT ARRAY BX6 -X0*X2 START RELATIVE ADDR SA4 ASVARS PL X2,SET45 JUMP IF STUDENT BANK SA4 ACVARS SET45 BX5 X2 AX5 45 MX7 -9 BX5 -X7*X5 SIZE IX7 X4+X6 ABS START ADDR IX7 X7+X5 +SIZE = MAX+1 ADDR SA7 VARBUF+1 PUT IN LIST MX7 -XCODEL BX7 -X7*X3 AX7 XCODEAL ISOLATE START GETVAR TYPE SX7 X7-6 =0 IF WHOLE ARRAY ZR X7,SET60 JUMP IF WHOLE ARRAY RJ SET80 ZR X7,VARFINM MUST CHECK BOUNDS AT EXEC TIME SET48 SA2 VARBUF+1 ABS MAX+1 IX5 X6+X4 ABS START IX5 X5+X1 +ITEMS IX6 X2-X5 MAX+1 - END NG X6,SETERR ERROR IF ITEMS RUN PAST MAX EQ VARFINM GO PACKUP COMMAND WORDS * SET50 RJ SET80 NZ X7,SET55 SA7 VARBUF+1 MUST FIND ENDLIMIT AT EXECTIME EQ VARFINM GO PACKUP WORDS * SET55 IX7 X4+X7 GET MAX ADDR IN STUD OR COM SA7 VARBUF+1 BANK +1 EQ SET48 * SET60 IX5 X5-X1 SIZE-ITEMS NG X5,SETERR JUMP IF TOO MANY ITEMS EQ VARFINM * SET80 EQ * FIND STUD/COM BANK LIMITS BX6 -X0*X3 GETVARCOD IN X3, PUT ADDR IN X6 AX3 XCODEAL MX5 -3 BX3 -X5*X3 DISCARD I/F BIT SA4 ASVARS SX7 VARLIM+1 SX5 X3-2 X3=2 IF STUD BANK ZR X5,SET80 RETURN STUD BANK LIMITS IF SO SA4 ACVARS SX7 NCVRLIM+1 SX5 X3-3 X3=3 IF COMMON ZR X5,SET80 RETURN COMMON BANK LIMITS IF SO SX7 0 CANT CHECK LIMIT AT CONDEN TIME EQ SET80 * SET99 EQ SET40 * NOASSGN SB1 45 NO ASSIGN EQ =XERR * SETERR SB1 58 EQ =XERR * SETER2 SB1 724 EQ =XERR * SEPASGN SX1 X1-KASSIGN USED IN VARLOC SEARCH * ENDOV * * /--- BLOCK COVL4A 00 000 79/07/06 05.18 TITLE -COV4A- VARIOUS COMMAND READINS COV4A OVRLAY * SA1 OVARG1 SB1 X1 JP B1+*+1 * + EQ COPYC -COPY- + EQ EDITIN -EDIT- + EQ STORUIN -STOREU- + EQ JKEYC -JKEY- + EQ BUMPC -BUMP- + EQ MOVEC -MOVE- + EQ CIRCLC -CIRCLE- -RCIRCLE- ETC. + EQ EXTOUTC -EXTOUT- + EQ STOREAC -STOREA- + EQ LOADAC -LOADA- -EXACTV- * /--- BLOCK COPY 00 000 79/07/06 02.56 TITLE -COPY- * -COPY- (CODE=130) * * SPECIFY CHAR STRING, CHAR COUNT FOR 'C'O'P'Y KEY * COPYC RJ VARDO COMMA SEPARATED VARIABLES SA2 VARBUF X2 = NUMBER OF VARIABLES SX1 X2-2 NZ X1,ERRTAGS JUMP IF NOT TWO ARGUMENTS SA1 VARBUF+1 NG X1,ERRSTOR ERROR IF 1ST VARIABLE CANNOT BE STORED INT MX0 61-XCODEL+XFBIT MASK OUT I/F BIT BX1 -X0*X1 BX6 X1 X6 = CLEANED AND POSITIONED -GETVAR- CODE AX1 XCODEAL CHECK FOR EXPLICIT COMMON ADDRESS SX1 X1-3 ZR X1,VCOMERR JUMP IF EXPLICIT COMMON REFERENCE SX1 X1+1 NZ X1,COPYC1 IF NOT STUDENT VAR MX2 -XCODEAL BX2 -X2*X6 SX1 VARLIM+1 IX1 X2-X1 PL X1,VCOMERR IF NOT STUDENT VAR COPYC1 LX6 60-XCODEL POSITION CODE SA2 VARBUF+2 X2 = 2ND VARIABLE MX0 60-XCODEL BX2 -X0*X2 LX2 60-2*XCODEL BX6 X6+X2 ADD 2ND CODE EQ PUTCODE * * * * EDIT COMMAND...2 CASES... * 1. NO ARG * 2. ONE ARG EDITIN SA1 TAGCNT ZR X1,PAUSE2 SEE IF NO ARG CASE RJ VARDO SA2 VARBUF X2 = NUMBER OF VARIABLES SX1 X2-1 NZ X1,ERR2MNY JUMP IF NOT ONE ARG SA1 VARBUF+1 NG X1,ERRSTOR ERROR IF 1ST VARIABLE CANNOT BE STOREDINTO MX0 61-XCODEL+XFBIT MASK OUT I/F BIT BX1 -X0*X1 BX6 X1 X6 = CLEANED AND POSITIONED -GETVAR- CODE AX1 XCODEAL CHECK FOR EXPLICIT COMMON ADDRESS SX1 X1-3 ZR X1,VCOMERR JUMP IF EXPLICIT COMMON REFERENCE SX1 X1+1 NZ X1,EDITIN1 IF NOT STUDENT VAR MX2 -XCODEAL BX2 -X2*X6 SX1 VARLIM+1 IX1 X2-X1 PL X1,VCOMERR IF NOT STUDENT VAR EDITIN1 LX6 60-XCODEL POSITION CODE EQ PUTCODE * * VCOMERR SB1 106 COMMON VARIABLE REFERENCE EQ ERR * /--- BLOCK STOREU 00 000 76/07/17 06.02 TITLE STOREU * * * STOREU NUMBER,UNITS * UNITS ARE THE (FLOATING-POINT) UNIT DIMENSIONS * STORUIN CALL PUTCOMP COMPILE CODE TO STORE X6 SA2 LASTKEY ZR X2,ERR2FEW ERROR IF END-OF-LINE LX1 60-XCODEL POSITION -GETVAR- CODE BX6 X1 SA6 VARBUF SAVE GETVAR CODE RJ COMPILE GET SECOND ARG NZ B1,ERRSTOR MUST BE ABLE TO STORE INTO BX6 X1 AX6 XCODEAL+3 SAVE I/F BIT ZR X6,ERRVTYP DIMENSIONS ARE FLOATING-PT SA2 VARBUF LX1 60-2*XCODEL POSITION 2ND GETVAR CODE BX6 X1+X2 SX1 STORE= USE -STORE- COMMAND CODE BX6 X1+X6 EQ ALTCODE * * /--- BLOCK JKEY-BUMP 00 000 75/10/04 11.49 * * -JKEY- * * TAG IS NAMES OF KEYS WHICH CAN INITIATE JUDGING * JKEYC SB1 NKLIST START OF TABLE OF LEGAL NAMES SB2 NKLEND END OF TABLE OF LEGAL NAMES MX5 42 MASK FOR NAMES---BOTTOM 18 BITS ARE KEYCODE * RJ SCANNER SCAN FOR KEY NAMES RJ CSSCAN SCAN FOR CASE-SENSITIVE NAMES ZR X0,PUTCODE EQ ERRNAME * * TITLE -BUMP- * -BUMP- (CODE=133) * * 'THE TAG OF A BUMP COMMAND MUST HAVE FROM 1 TO * 8 BCD CODES. 'THE STORAGE FORMAT OF THE COMMAND * IS TAG CHARS LEFT-JUSTIFIED IN COMMAND WORD WITH * ZERO FILL. * * BUMPC SA1 TAGCNT ZR X1,ERR2FEW ERROR IF NO TAG SB2 X1-9 PL B2,ERR2MNY TOO MANY CHAR CODES SB1 B0 CHAR NUMBER SB2 X1 NUMBER OF CHARS SB3 54 POST-SHIFT COUNT SB4 6 CHAR WIDTH MX6 0 COMMAND WORD BUMPLP SA1 TAG+B1 NEXT CHAR BX6 X6+X1 GET ANOTHER CODE LX6 6 MOVE OVER SB1 B1+1 SB3 B3-B4 POST-SHIFT DECR. NE B1,B2,BUMPLP LX6 X6,B3 LEFT JUSTIFY EQ PUTCODE ALL GONE * * /--- BLOCK MOVE 00 000 79/07/06 04.01 TITLE MOVE * -MOVE- * * * NORMAL 4 ARG MOVE COMMAND. * INADD,INPOS,OUTADD,OUTPOS * /// IF 5TH ARG GIVEN, IT IS NUMBER OF CHARS /// * * MOVEC RJ VARDO SET UP VARBUF SA1 VARBUF+1 FROM ADDRESS PL X1,MOVC1 MX0 1 LX0 XCODEL BX6 X1+X0 SA6 A1 MOVC1 SA1 VARBUF+3 *TO* ADDRESS MUST BE STOREABLE NG X1,ERRSTOR SA1 VARBUF X1 = NUMBER OF VARIABLES SX2 X1-6 PL X2,ERR2MNY --- FOUR OR FIVE ARGS ONLY SX2 X2+2 ZR X2,MOVC4 GO TO PACK UP IF NORMAL 4 ARG MOVE COMMAND NG X2,ERR2FEW OTHERWISE MUST BE 5 EQ VARFIN GO TO PACK UP VARIABLES * MOVC4 MX6 2*XCODEL+1 BIT IN 3RD FIELD ON SA6 VARBUF+5 EQ VARFIN GO PACK IT UP * * /--- BLOCK CIRCLE 00 000 77/08/04 04.18 TITLE CIRCLE * * * -CIRCLE R- * -CIRCLE R,THETA1,THETA2- * * IF ONLY ONE TAG, THE TOP BIT IS SET ON THE * SECOND GETVAR CODE. * * USED BY * -CIRCLE- * -RCIRCLE- * -GCIRCLE- * -CIRCLB- * CIRCLC RJ VARDO GET COMMA-SEPARATED VARS SA1 VARBUF SHOULD BE 1 OR 3 ARGUMENTS SX2 X1-3 ZR X2,VARFIN IF THREE ARGS SX2 X1-1 NZ X2,ERRTAGS IF WRONG NO. ARGS SA1 VARBUF+1 RETRIEVE FIRST TAG CODE MX2 1 MAKE SECOND TAG CODE LX2 XCODEL EQ PUTTWO AND COMPLETE COMMAND WORD * /--- BLOCK EXTOUT 00 000 79/07/06 04.30 TITLE -EXTOUT- * -EXTOUT- (CODE=186) * * 'SENDS 16 BITS OF DATA (EQUIVALENT TO EITHER * AUDIO OR EXT). 'OPTIONAL 2ND ARGUMENT SPECIFIES * LENGTH OF BUFFER TO SEND. * * EXTOUTC RJ VARDO COMMA SEPARATED VARIABLES SX1 2 2 VARIABLES REQUIRED SA2 VARBUF NUMBER OF VARIABLES FOUND SX3 X2-1 ZR X3,EXTO1 JUMP IF ONLY 1 ARGUMENT SA3 VARBUF+1 PL X3,VARFIN --- PACK UP, STORE COMMAND WORD EQ ERRSTOR --- ERROR EXIT IF CANNOT BE STORED INTO * EXTO1 BX6 X1 SA6 A2 RESET VARIABLE COUNT TO 2 SX7 1 CODE FOR 1 AS LENGTH SA7 VARBUF+2 STORE AS 2ND VARIABLE EQ VARFIN --- PACK UP, STORE COMMAND WORD * /--- BLOCK STOREA 00 000 76/10/01 03.42 TITLE STOREA * * -STOREA- (CODE=68) * * STOREAC RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 PICK UP FIRST GETVAR CODE NG X1,ERRSTOR MUST BE STOREABLE STOREA1 MX0 61-XCODEL+XFBIT MASK OUT I/F BIT BX1 -X0*X1 SA3 VARBUF X3 = NUMBER OF VARIABLES SX3 X3-1 SX2 10 -GETVAR- CODE FOR 10 CHARACTERS ZR X3,PUTTWO DONE IF ONLY ONE ARGUMENT SX3 X3-1 NZ X3,ERR2MNY IF WRONG NO. ARGUMENTS SA2 VARBUF+2 PICK UP SECOND GETVAR CODE EQ PUTTWO NOW COMPLETE COMMAND WORD * * * * -EXACTV- (CODE=134) * -LOADA- (CODE=226) * LOADAC RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 PICK UP FIRST GETVAR CODE EQ STOREA1 1ST ARG NEED NOT BE STOREABLE * /--- BLOCK ENDOV 00 000 79/07/06 02.46 * ENDOV * /--- BLOCK ACCESS 00 000 79/04/28 16.25 TITLE ACCESS, SYSACC COMMAND READINS ACCOV OVRLAY SA1 OVARG1 GET ARGUEMENT SB1 X1 JP B1+*+1 * + EQ SYSACCC 0 = -SYSACC- + EQ ACCESSC 1 = -ACCESS- * /--- BLOCK ACCESS 00 000 79/04/28 16.25 ** * * -SYSACC- COMMAND READ-IN * * SYSACC ACCOUNT';FILE,BLOCK,BUFFER,RETURN,MAXL,RETURNL * * ACCOUNT ACCOUNT OF FILE WITH ACCESS BLOCK * FILE NAME OF FILE WITH ACCESS BLOCK * BLOCK NAME OF ACCESS BLOCK * BUFFER USER SUPPLIED BUFFER TO READ * NAME (2 WORDS) * GROUP * ACCOUNT * USER TYPE * SYSTEM * RETURN VARIABLE TO RETURN BITS IN * RETURNL NUMBER OF BITS RETURNED * MAXL MAXIMUM LENGTH TO RETURN ** * SYSACCC CALL SYSTEST SEE IF SYSTEM LESSONS CALL FILEBLK GET ACCOUNT, FILE, AND BLOCK ARGUMENTS CALL VARDOR GET REMAINING ARGUMENTS * SA1 VARBUF GET NUMBER OF ARGUMENTS SX2 X1-7 NEEDS EXACTLY 7 ARGUMENTS NG X2,ERR2FEW NOT ENOUGH ARGUMENTS NZ X2,ERR2MNY TOO MANY ARGUMENTS SA2 VARBUF+5 5TH ARGUMENT MUST BE STOREABLE NG X2,ERRSTOR SA2 VARBUF+7 7TH ARGUMENT MUST BE STOREABLE NG X2,ERRSTOR EQ VARFIN EXIT WITH X1 STILL SET TO 7 * * /--- BLOCK + ACCESS 00 000 81/01/18 20.01 TITLE ACCESS COMMAND. ** * -ACCESS- COMMAND READ-IN * * ACCESS LESSON;RETURN VARIABLE * ACCESS FILE;RETURN VARIABLE * ACCESS ACCOUNT';FILE,BLOCK;RETURN ACCESSC BSS 0 * SAVE VALUE OF WORDPT TO ALLOW BACKUP SA1 WORDPT BX6 X1 SA6 SWORDPT * GET FIRST TAG ACGO CALL NXTNAM GET FIRST TAG * IF SEMICOLON PRESENT, THIS MIGHT BE SPECIAL FORM SX2 X1-KSEMIC NZ X2,ACRSET NOT ; -- MUST BE LESSON,BLOCK * SEE IF KEY WORDS -LESSON- OR -FILE- SA2 CFILE BX2 X6-X2 SEE IF KEYWORD OF -FILE- NZ X2,ACCLESS * SET TO KEY WORD FILE SX6 1 EQ ACTWO TWO TAG FORM FOR -FILE- ACCLESS SA2 CLESSON CHECK FOR KEYWORD -LESSON- BX2 X6-X2 NZ X2,ACRSET DUNNO; MAYBE IT WAS ACCT';FILE * SET TO KEY WORD LESSON SX6 2 * ACTWO SA6 SACTYPE SAVE KEYWORD TYPE CALL SYSTEST TWO-ARG FORM FOR SYSTEM LESSONS * SET UP FIRST -GETVAR- CODE TO MARK KEYWORD FORMAT MX1 1 LX1 XCODEL SA3 SACTYPE GET KEYWORD TYPE BX6 X1+X3 SA6 VARBUF+1 STORE AS FIRST CODE MX6 0 SA6 VARBUF+2 ZERO SECOND, THIRD GETVAR CODES SA6 VARBUF+3 SX6 3 SA6 VARBUF MARK 3 ARGS COMPILED SO FAR SA6 LASTKEY FAKE OUT -VARDOR- EQ ACRETRN PROCESS RETURN ARGUMENT(S) * /--- BLOCK + ACCESS 00 000 81/01/12 03.31 * LESSON,BLOCK FORMAT ACRSET SA1 SWORDPT RESTORE CHAR POINTER BX6 X1 SA6 WORDPT CALL FILEBLK GET ACCOUNT, FILE, AND BLOCK NAMES ZR X1,ERR2FEW ERROR IF BLANK TAG SA1 LASTKEY SX2 X1-KSEMIC NEXT CHAR SHOULD BE SEMICOLON NZ X2,ERRTAGS NOPE; SOMEONE IS CONFUSED * PROCESS RETURN ARGUMENT(S) * EXPECTING ONE OR TWO; FIRST MUST BE STORABLE ACRETRN CALL VARDOR GET REMAINING ARGUMENTS SA1 VARBUF SX1 X1-4 CHECK TOTAL GETVAR CODES SO FAR NG X1,ERR2FEW MUST BE AT LEAST 4 NZ X1,ACRET2 BUT MIGHT BE 5 * ONE RETURN ARGUMENT SPECIFIED; SET UP * DUMMY 5TH GETVAR CODE MX6 1 LX6 XCODEL SA6 VARBUF+5 SX6 5 SA6 VARBUF AND MARK 5 CODES TOTAL EQ ACRETST GO TO CHECK STOREABILITY * TWO OR MORE RETURN ARGUMENTS PRESENT ACRET2 SX1 X1-1 SEE IF 5 ARGUMENTS TOTAL NZ X1,ERR2MNY ERROR IF MORE THAN 5 * CALL SYSTEST ALLOWED IN SYSTEM LESSONS ONLY * MAKE SURE 4TH ARGUMENT IS STOREABLE ACRETST SA1 VARBUF+4 NG X1,ERRSTOR ERROR IF NOT * SX1 5 EQ VARFIN FINISHED WITH THIS COMMAND SWORDPT BSS 1 SAVE WORDPT SACTYPE BSS 1 SAVE TYPE OF KEYWORD CFILE DATA 0LFILE KEYWORDS CLESSON DATA 0LLESSON * ENDOV * /--- BLOCK JOINOV 00 000 77/04/24 20.47 TITLE -JOIN-, -JUMP-, -DO- COMMANDS * * * JOINOV OVRLAY SA1 OVARG1 GET ARGUMENT SB1 X1 JP B1+*+1 * + EQ JUMPIN 0 = -JUMP- + EQ BRANCHI 1 = BRANCHI + EQ BRANCHQ 2 = BRANCHQ + EQ GOTOIN 3 = -GOTO- + EQ JOININ 4 = -JOIN- + EQ DOIN 5 = -DO- + EQ FINISC 6 = -FINIS- + EQ PINIT 7 = FINISH UP BEFORE MTUTOR + EQ UNITC 8 = -UNIT- + EQ ENTRYIN 9 = -ENTRY- + EQ INITC 10 = -INITIAL- + EQ ROUTEC 11 = -ROUTE- + EQ TIMERC 12 = -TIMER- + EQ TIMELC 13 = -TIMEL- + EQ UDONE20 14 = RE-ENTRY FROM -DEFINE- + EQ UDONE10 15 = RE-ENTRY FROM PURGING SET * EXT UNITFLG,AUNUM,ENDPNT + EQ RETIN 16 = -NRET- + EQ RETIN1 17 = -RETURN- * * * /--- BLOCK JOININ 00 000 77/04/24 20.22 TITLE -JUMPIN- * * * -JUMPIN- * READIN ROUTINE FOR BRANCHING COMMANDS * * JUMPIN MX6 0 MARK UNIT -Q- NOT LEGAL SA6 QOK EQ JOININ0 * * JOININ0 MX6 -1 MARK UNITS WITH ARGUMENTS OK SA6 ARGOK * JOININ1 SA1 TAGCNT BLANK TAG IS SAME AS UNIT -Q- ZR X1,UNCJQ SA1 NEXTCOM CHECK FOR CONTINUED COMMAND SA2 COMCONT BX2 X1-X2 ZR X2,CJO CONDITIONAL IF CONTINUED SA1 WORDPT MX0 0 NO SPECIAL TERMINATOR CALL PSCAN SCAN FIRST ELEMENT ZR X1,UNCJ JUMP IF UNCONDITIONAL * CJO CALL COMPILE EVALUATE EXPRESSION BX7 X1 LX7 60-XCODEL SA7 BRVAR SAVE -GETVAR- CODE MX6 0 SA6 JCALL MARK NOT SPECIAL CALL (-GOTO-) SA6 SAMEU0 NO SPECIAL SAME UNIT TREATMENT * JOININ2 MX6 0 SA6 UBUFF INITIALIZE NUMBER OF UNITS * CJLP CALL UNAMA PROCESS NEXT UNIT NAME SA1 UARGS SEE IF ANY ARGUMENTS ZR X1,CJLP0 SA1 ARGOK SEE IF ARGUMENTS LEGAL ZR X1,ERRNAME * CJLP0 SX0 X6-UNQNUM NZ X0,CJLP1 CHECK FOR UNIT -Q- SA1 QOK ZR X1,ERRXORQ ERROR IF UNIT -Q- NOT LEGAL * CJLP1 CALL APACK PACK UP ANY ARGUMENTS SA1 SAMEU0 ZR X1,CJLP2 JUMP IF SAME UNIT NOT SPECIAL SA1 UNUMON BX1 X1-X6 CHECK FOR SAME UNIT NZ X1,CJLP2 MX6 0 RETURN 0 FOR SAME UNIT * CJLP2 SA1 UBUFF SX7 X1+1 INCREMENT UNIT COUNT SA7 A1 SX1 X1-100 ALLOW 100 UNITS PL X1,ERR2MNY SA6 X7+UBUFF STORE THIS UNIT NUMBER SA1 WORDPT SA1 X1 LOAD NEXT CHARACTER NZ X1,CJLP JUMP IF NOT END OF LINE SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED COMMAND BX2 X1-X2 NZ X2,CJTAB CALL GETLINE GET NEXT LINE OF TEST EQ CJLP * /--- BLOCK JOININ 00 000 76/07/24 16.27 * CJTAB SA4 INX UNIT EXTRA STORAGE POINTER SX7 X4 SA1 UBUFF NUMBER OF UNITS ZR X1,ERR2MNY SB1 X1 EQ CJTLP0 * CJTLP SA6 X7+INFO STORE COMPLETED WORD SX7 X7+1 * CJTLP0 MX6 0 CLEAR WORD BUILDING SB2 45 INITIALIZE SHIFT COUNT * CJTLP1 SB1 B1-1 DECREMENT UNIT COUNT NG B1,CJTFIN SA1 A1+1 LOAD NEXT UNIT NUMBER LX1 X1,B2 BX6 X1+X6 MERGE WITH REST OF WORD SB2 B2-15 DECREMENT SHIFT COUNT PL B2,CJTLP1 EQ CJTLP JUMP IF WORD COMPLETE * CJTFIN SB1 B2-45 SEE IF LAST WORD EMPTY PL B1,CJTFIN0 SA6 X7+INFO STORE LAST TABLE WORD SX7 X7+1 * CJTFIN0 SA7 INX UPDATE EXTRA STORAGE POINTER SA1 JCALL ZR X1,CJTFIN1 JUMP IF NOT SPECIAL CALL SB1 X1 JP B1 RETURN TO CALLING ROUTINE * CJTFIN1 LX4 12+XCMNDL POSITION INDEX IN XSTOR SA1 UBUFF NUMBER OF TABLE ENTRIES LX1 XCMNDL BX6 X1+X4 SA1 BRVAR -GETVAR- CODE FOR EXPRESSION BX6 X1+X6 SA1 COMNUM ADD 1 TO COMMAND NUMBER SX1 X1+1 BX6 X1+X6 EQ ALTCODE EXIT TO STORE COMMAND WORD * JCALL BSS 1 UBUFF EQU SHOWOUT MUST BE AT LEAST 100 LONG * * * /--- BLOCK JOININ 00 000 81/01/28 15.15 * * * READIN FOR UNCONDITIONAL BRANCHING COMMAND * UNCJ CALL UNAMA GET UNIT NUMBER TO X6 SX0 X6-UNXNUM CHECK FOR UNIT -X- ZR X0,ERRXORQ SX0 X6-UNQNUM CHECK FOR UNIT -Q- ZR X0,UNCJQ SA1 UARGS SEE IF ANY ARGUMENTS ZR X1,UNCJ1 SA1 ARGOK SEE IF ARGUMENTS LEGAL ZR X1,ERRUARG * UNCJ1 CALL APACK LX6 48 POSITION UNIT NUMBER EQ PUTCODE * UNCJQ SA1 QOK SEE IF UNIT -Q- LEGAL ZR X1,ERRXORQ MX6 0 UNIT NUMBER 0 = UNIT -Q- EQ PUTCODE * QOK BSS 1 ARGOK BSS 1 SAMEU0 BSS 1 * * BRANCHI SA1 COMNUM SEE IF -IFERROR- COMMAND SB1 X1 SB2 =XIFERR= NE B1,B2,BI09 IF NOT -IFERROR- COMMAND SB1 FSIFERR -IFERROR- IS PUBLISH ERROR RJ =XPUBERRS EQ BI10 * BI09 SB2 =XSTOP1= CHECK FOR STOP1 COMMAND NE B1,B2,BI10 BRANCH IF NOT SA1 SYSFLG CHECK FOR SYSTEM LESSON LX1 ZSLDSHF NG X1,BI10 BRANCH IF YES (STOP1 OK) SB1 150 ISSUE NON-FATAL WARNING RJ =XRJERNOZ BI10 MX6 -1 MARK UNIT -Q- LEGAL SA6 QOK MX6 0 MARK ARGUMENTS NOT LEGAL SA6 ARGOK EQ JOININ1 * BRANCHQ MX6 0 SA6 QOK MARK UNIT -Q- NOT LEGAL SA6 ARGOK MARK ARGUMENTS NOT LEGAL EQ JOININ1 * * * /--- BLOCK GOTOIN 00 000 77/04/24 20.24 TITLE -GOTO- COMMAND * * * -GOTO- AND -GOTO*- COMMANDS * * GOTOIN SA1 TAGCNT BLANK TAG IS SAME AS UNIT -Q- ZR X1,UNCGQ SA1 NEXTCOM CHECK FOR CONTINUED COMMAND SA2 COMCONT BX2 X1-X2 ZR X2,CGO CONDITIONAL IF CONTINUED SA1 WORDPT MX0 0 CALL PSCAN SCAN FIRST ELEMENT ZR X1,UNCG JUMP IF UNCONDITIONAL * * CONDITIONAL -GOTO- COMMAND * CGO CALL GCOMP COMPILE LX1 60-XCODEL+XFBIT PL X1,CGO1 JUMP IF INTEGER SX7 0100B LX7 18 FORM AN RJ TO FTOI CONVERTER SA1 LLFTOI ADDRESS OF FTOI ROUTINE BX7 X1+X7 CALL LONGI ADD TO INSTRUCTION STREAM CALL PAD FILL OUT REST OF WORD * CGO1 SA1 NINST POINTER TO CURRENT WORD SA2 X1 MX0 30 SEE IF 30 BITS LEFT BX7 X0*X2 ZR X7,CGO2 JUMP IF ROOM LEFT CALL PAD SA1 NINST POINTER TO NEXT FREE WORD * CGO2 SX7 X1+1 RESERVE ANOTHER WORD MX6 0 SA6 X7 CLEAR OUT LAST WORD SX7 X7+1 SA7 A1 UPDATE *NINST* CALL MOVCODE MOVE COMPILED CODE TO XSTOR BX7 X0 RELATIVE ADDR OF COMPILED CODE LX7 42 MOVE TO TOP 18 BITS SA7 BRVAR SA2 INX BX6 X2 SA6 GCODADD SAVE ENDING ADDRESS OF CODE MX6 -1 SA6 QOK MARK UNIT -Q- LEGAL SA6 SAMEU0 GOTO SAME UNIT SPECIAL SA6 ARGOK ARGUMENTS LEGAL SX6 GOTOFIN SA6 JCALL SET RETURN ADDRESS EQ JOININ2 * * /--- BLOCK GOTOIN 00 000 76/07/24 16.30 * * DONE -- ADD SETUP INSTRUCTIONS AND PACK UP * COMMAND WORD (X4 = ADDRESS OF TABLE) * GOTOFIN SA1 GCODADD SET UP INSTRUCTION POINTER SB1 X1+INFO-2 SX2 6125B COMPILE A SB2 B5+K LX2 18 BX7 X2+X4 ATTACH INDEX TO TABLE RJ IPACK SA2 UBUFF NUMBER OF ENTRIES IN TABLE ZR X2,ERR2FEW SX7 7120B COMPILE A SX2 B0+K LX7 18 BX7 X2+X7 ATTACH NUMBER OF ENTRIES RJ IPACK SX7 0400B SET UP BRANCH TO -GOTO- ROUTINE LX7 18 SA1 LLGOTO BX7 X1+X7 ATTACH ADDRESS OF ROUTINE RJ IPACK RJ ILJUST LEFT-ADJUST LAST WORD SA4 COMNUM SX6 X4+1 X6 = COMMAND NUMBER SA1 BRVAR ADDRESS OF CODE BX6 X6+X1 EQ ALTCODE STORE COMPLETED COMMAND WORD * * * * UNCONDITIONAL -GOTO- * UNCGQ SX6 UNQNUM SET FOR UNIT -Q- EQ UG1 * UNCG CALL UNAMA GET UNIT NUMBER CALL APACK SX0 X6-UNXNUM ZR X0,ERRXORQ ERROR IF UNIT -X- SA1 UNUMON BX1 X1-X6 SEE IF GOTO UNIT ALREADY IN NZ X1,UG1 MX6 0 SET FOR SAME UNIT UG1 LX6 48 PUT INTO TOP 12 BITS EQ PUTCODE * GCODADD BSS 1 * * * /--- BLOCK GOTOIN 00 000 73/11/11 00.33 * * * -IPACK- * ADD 30 BIT INSTRUCTION TO STREAM * IPACK EQ * MX0 30 SA1 B1 LOAD NEXT INSTRUCTION WORD BX2 X0*X1 ZR X2,IP1 JUMP IF ENOUGH ROOM MX0 15 BX2 X0*X1 SEE IF ROOM FOR 15 BIT INST NZ X2,IP0 SX6 46000B LX1 15 ADD A PASS INSTRUCTION BX6 X1+X6 SA6 B1 STORE COMPLETED WORD * IP0 SB1 B1+1 MX1 0 SET UP FOR NEW WORD * IP1 LX1 30 BX7 X1+X7 MERGE NEW INSTRUCTION SA7 B1 EQ IPACK * * * -ILJUST- * LEFT JUSTIFY LAST WORD OF INSTRUCTIONS * ILJUST EQ * MX0 15 SA1 B1 LOAD LAST INSTRUCTION WORD ILJ1 BX2 X0*X1 NZ X2,ILJ2 JUMP IF WORD LEFT-JUSTIFIED LX1 15 EQ ILJ1 ILJ2 BX6 X1 STORE LEFT-JUSTIFIED WORD SA6 B1 EQ ILJUST * * /--- BLOCK -DO- 00 000 77/04/24 20.24 TITLE -DO- COMMAND * * * -DO- COMMAND (REGULAR JOIN) * * THIS COMMAND MAY TAKE THE FOLLOWING FORMS - * DO UNIT * DO EXPR,UNIT,UNIT.....UNIT * DO UNIT,EXPR_EXPR,EXPR,(EXPR) * DO EXPR,UNIT,UNIT.....UNIT,EXPR_EXPR,EXPR,(EXPR) * DO EXPR,EXPR_EXPR,EXPR,(EXPR) * * JOININ MX6 -1 MARK -JOIN- COMMAND SA6 JOINFLG EQ DOIN1 * DOIN MX6 0 MARK NOT A -JOIN- COMMAND SA6 JOINFLG * DOIN1 BSS 0 SA1 WORDPT POINTER TO FIRST CHARACTER MX0 0 CALL PSCAN SCAN PAST FIRST ENTRY ZR X1,UNCDO SX1 B1+1 ADVANCE CHARACTER POINTER SX0 KASSIGN ACCEPT ASSIGNMENT AS TERMINATOR CALL PSCAN BX0 X0-X1 CHECK IF ENDED WITH ASSIGNMENT NZ X0,DOC SX6 1R, REPLACE ASSIGNMENT WITH COMMA SA6 B1 EQ DOIT UNCONDITIONAL ITERATED -DO- * * * UNCONDITIONAL -DO- COMMAND * UNCDO MX6 0 PRESET TO NO RETURN ARGS SA6 =XRARGFLG CALL UNAMA1 PROCESS UNIT NAME SX0 X6-UNXNUM ZR X0,ERRXORQ ERROR IF UNIT -X- SX0 X6-UNQNUM ZR X0,UNCDOQ SPECIAL FOR UNIT -Q- LX6 60-12 SX1 DOJ= PRE-SET FOR -DO- COMMAND SA2 JOINFLG SEE IF -JOIN- COMMAND + ZR X2,*+1 SX1 JOIN= SET COMMAND CODE = JOIN + BX6 X1+X6 EQ UALTC * UNCDOQ SX6 DOJ= GET COMMAND NUMBER UALTC SA1 =XRARGFLG SEE IF ANY RETURN ARGUMENTS ZR X1,ALTCODE IF NO RETURN ARGUMENTS * SA1 ICX ADD -DO-/-JOIN- COMMAND SX7 X1-1 SA7 A1 SA6 INFO+X7 STORE COMMAND WORD SX6 =XDOR= SET CODE FOR RETURN ARGS COMMAND SA1 JOINFLG + ZR X1,*+1 IF -JOIN- COMMAND * SX6 =XJOINR= EQ ALTCODE * * * * /--- BLOCK -DO- 00 000 76/07/25 06.35 * * * CONDITIONAL -DO- COMMAND READIN * DOC CALL COMPILE EVALUATE EXPRESSION BX6 X1 SA6 BRVAR SAVE -GETVAR- CODE MX6 0 SA6 UBUFF INITIALIZE UNIT COUNT SA6 ISITER PRE-SET NOT ITERATED CASE SA6 =XRARGFLG PRESET TO NO RETURN ARGUMENTS * DOULP SA1 WORDPT POINTER TO NEXT CHARACTER SA2 X1 ZR X2,DOEOL JUMP IF END-OF-LINE SX0 KASSIGN ACCEPT ASSIGNMENT AS TERMINATOR CALL PSCAN BX0 X0-X1 SEE IF ENDED WITH ASSIGNMENT ZR X0,DOCIT CALL UNAMA1 SA1 UBUFF SX7 X1+1 INCREMENT UNIT COUNT SA7 A1 SX1 X1-100 ALLOW 100 UNITS PL X1,ERR2MNY SA6 X7+UBUFF STORE THIS UNIT NUMBER SA1 WORDPT SA1 X1 NZ X1,DOULP JUMP IF NOT END OF LINE * DOEOL SA1 NEXTCOM SA2 COMCONT CHECK IF CONTINUED BX2 X1-X2 NZ X2,DOUPACK JUMP IF NOT CONTINUED CALL GETLINE EQ DOULP * DOCIT MX6 -1 MARK ITERATED -DO- SA6 ISITER SX6 1R, REPLACE ASSIGNMENT WITH COMMA SA6 B1 * * /--- BLOCK -DO- 00 000 76/07/25 06.36 * DOUPACK SA1 UBUFF GET NUMBER OF UNITS ZR X1,ERR2FEW SB1 X1 SA2 INX INITIALIZE XSTOR POINTER BX7 X2 SA7 DTABLOC SAVE ADDRESS OF UNIT TABLE * DOPACK MX6 0 CLEAR WORD BUILDING SB2 45 INITIALIZE SHIFT COUNT * DOPK1 SB1 B1-1 DECREMENT UNIT COUNT NG B1,DOPFIN SA1 A1+1 LOAD NEXT UNIT NUMBER LX1 X1,B2 BX6 X1+X6 MERGE WITH REST OF WORD SB2 B2-15 PL B2,DOPK1 JUMP IF WORD NOT FULL SA6 X7+INFO SX7 X7+1 INCREMENT XSTOR POINTER EQ DOPACK * DOPFIN SB1 B2-45 SEE IF LAST WORD EMPTY PL B1,DOPF1 SA6 X7+INFO STORE LAST WORD OF UNIT TABLE SX7 X7+1 * DOPF1 SA7 INX UPDATE EXTRA STORAGE POINTER SA1 DTABLOC LX1 12+XCMNDL POSITION ADDRESS OF TABLE SA2 UBUFF LX2 XCMNDL POSITION NUMBER OF UNITS BX6 X1+X2 SA1 BRVAR LX1 60-XCODEL POSITION -GETVAR- CODE BX6 X1+X6 SA1 ISITER NZ X1,DOPF2 JUMP IF ITERATED SX1 DOC= PRE-SET FOR -DO- COMMAND SA2 JOINFLG + ZR X2,*+1 CHECK FOR -JOIN- COMMAND SX1 JOINC= + BX6 X1+X6 ATTACH COMMAND NUMBER EQ UALTC UPDATE BINARY * DOPF2 SA6 X7+INFO SAVE UNIT TABLE INFO IN XSTOR SX6 7000B BX6 X6+X7 SET UP SPECIAL FAKE UNIT NUMBER LX6 48 SA6 VARBUF SX7 X7+1 SA7 INX UPDATE EXTRA STORAGE INDEX EQ DOITC PROCESS INDEX EXPRESSIONS * * /--- BLOCK -DO- 00 000 76/07/25 06.36 * * * UNCONDITIONAL ITERATED -DO- COMMAND READIN * DOIT CALL UNAMA1 GET UNIT NUMBER AND ARGS SX0 X6-UNXNUM ZR X0,ERRXORQ ERROR IF UNIT -X- SX0 X6-UNQNUM ZR X0,ERRXORQ ERROR IF UNIT -Q- LX6 48 PUT INTO TOP 12 BITS SA6 VARBUF * * CONDITIONAL ITERATED -DO- COMMAND READIN * DOITC SX6 DO= PRE-SET FOR -DO- COMMAND SA1 JOINFLG + ZR X1,*+1 CHECK FOR -JOIN- COMMAND SX6 JDO= + SA6 COMNUM SET COMMAND NUMBER SA1 WORDPT POINTER TO NEXT CHARACTER BX6 X1 SA6 WPTSAV1 SAVE ADDR OF INDEX EXPRESSION CALL TAGSAVE SAVE TAG IN ECS CALL GCOMP DECODE INDEX EXPRESSION AX1 XCODEAL+2 SX0 2 BX6 X0*X1 MASK OFF I/F BIT SA6 DOVTYPE ZR X6,DOIT0 JUMP IF INTEGER INDEX SA1 COMNUM SX6 X1+2 INCREMENT COMMAND NUMBER SA6 A1 * DOIT0 SX7 10610B CALL SHORT ADD A BX6 X1 SX7 5160B LX7 18 ADD A SA6 B0+COMPUSE SA1 LLCOUSE BX7 X1+X7 ATTACH ADDRESS OF *COMPUSE* CALL LONGI * /--- BLOCK -DO- 00 000 76/07/25 06.38 * SA1 WORDPT BX6 X1 SAVE *WORDPT* SA6 WPTSAV2 MX0 0 NO SPECIAL TERMINATOR CALL PSCAN ZR X1,ERRTERM SX6 B1+1 ADVANCE CHARACTER POINTER SA6 WORDPT CALL GCOMP1 EVALUATE END-TEST EXPRESSION RJ ITFFTI GENERATE I-F F-I INSTRUCTIONS SX7 10610B CALL SHORT ADD A BX6 X1 SX7 5160B LX7 18 ADD A SA6 B0+COMPUSE+1 SA1 LLCOUSE SX1 X1+1 *COMPUSE* +1 BX7 X1+X7 CALL LONGI SA1 LASTKEY SEE IF END OF LINE NZ X1,DOIT1 SX7 7110B FORM A SX1 B0+1 LX7 18 SX6 1 BX7 X6+X7 ASSUMED INCREMENT IS +1 CALL LONGI MX1 0 SET FOR INTEGER EQ DOIT2 * DOIT1 CALL GCOMP1 EVALUATE INCREMENT EXPRESSION * DOIT2 RJ ITFFTI GENERATE I-F F-I INSTRUCTIONS SX7 0100B FORM A RJ DOLOC LX7 18 SA1 LLDOLOC BX7 X1+X7 ATTACH ADDRESS OF *DOLOC* CALL LONGI CALL PAD FILL OUT REST OF WORD SA1 WPTSAV1 BX6 X1 SET POINTER TO INDEX EXPRESSION SA6 WORDPT CALL TAGREST RESTORE *TAG* BUFFER CALL PCOMP1 PRODUCE CODE TO STORE X6 SX7 0230B LX7 18 ADD A JP B3+B0 CALL LONGI CALL PAD CALL MOVCODE MOVE COMPILED CODE TO XSTOR BX6 X0 SA6 VARBUF+1 SAVE ADDRESS OF COMPILED CODE * * /--- BLOCK -DO- 00 000 77/04/24 20.25 * SA1 WPTSAV2 SET POINTER TO INITIAL VALUE BX6 X1 EXPRESSION SA6 WORDPT CALL COMPILE DECODE INITIAL EXPRESSION BX6 X1 LX6 60-12-18-XCODEL SA1 VARBUF BX6 X1+X6 ATTACH UNIT NUMBER SA1 VARBUF+1 LX1 60-12-18 POSITION ADDRESS OF CODE BX5 X1+X6 SA4 COMNUM BX6 X4+X5 ATTACH COMMAND NUMBER SA1 ICX SX7 X1-2 UPDATE COMMAND POINTER SA7 ICX SA6 X7+INFO+1 STORE 2 COMMAND WORDS SX4 X4+1 BX6 X4+X5 ATTACH INCREMENTED COMMAND NUM SA6 X7+INFO EQ NXTLINE * EXT ERRORC,PUTCODE,DATAON=,CALCODE EXT COMCONT,VARFIN,NXTLINE,ALTCODE EXT ECSPRTY,KEYTYPE,NKLIST,NKLEND EXT LNGUNIT,COMPNAM EXT UNIT=,ARGS=,DO=,DOJ=,DOC=,UNITOP= EXT JOIN=,JOINC=,JDO=,IEUEND= EXT ITFFTI,DOVTYPE,ERRCALL EXT PSCAN,PAUSE2 EXT ERRTAGS,ERRNAME,ERRSTOR EXT ERRXYTG,ERR2MNY,ERR2FEW EXT ERRTERM,ERRUARG,ERRVTYP EXT ERROUTR,ERRCNTD,ERRXORQ EXT ERRBAL * * /--- BLOCK UNIT 00 000 76/11/25 03.26 TITLE UNIT * * UNIT COMMAND FORMAT-- * FIRST 12 BITS = NEXT PHYSICAL UNIT * NEXT 12 = NEXT PHYSICAL UNIT * NEXT 36 = COMMAND NUMBER * * * UNITC SB1 FSUNIT -UNIT- FOR PUBLISH TEXT RJ =XPUBTEXT SA1 INDENT NZ X1,=XNOINDT INDENTING IS NOT PERMITTED CALL GLOBSYM FINISH UP GLOBAL CALC BRANCHES CALL ULONG CHECK FOR UNIT TOO LONG CALL SETARO,B0 PSEUDO -ENDARROW- CALL UNAM1 PROCESS UNIT NAME SX2 X6-UNXNUM CHECK FOR ILLEGAL UNIT -X- ZR X2,UNITCF JUMP IF UNIT X SX2 X6-UNQNUM CHECK FOR ILLEGAL UNIT -Q- ZR X2,UNITCF JUMP IF UNIT Q SA1 X6+ULOC PL X1,UNITCE ERROR IF DUPLICATE UNIT * RJ =XUNITLOC LOG UNIT NAME/LOCATION SA1 UNUMON SX2 X1-IEUNUM SEE IF INITIAL ENTRY UNIT NZ X2,UNI10 SA2 ICX GET COMMAND POINTER SX2 X2-1 SA3 INX IX3 X3-X2 CHECK FOR UNIT TOO LONG PL X3,LNGUNIT BX7 X2 SA7 A2 UPDATE FOR -IEUEND- COMMAND SX7 IEUEND= SA7 X2+INFO ADD AN -IEUEND- COMMAND * UNI10 IX7 X6-X1 UNIT A CONTAINING UNIT A ZR X7,UNITCE DUPLICATE UNIT NAME SA6 A1 SET UNIT WORKING ON POINTER * MX7 1 SET THAT A UNIT FOUND SA7 NOUNIT * * /--- BLOCK UNIT 00 000 81/07/16 04.19 * MX6 0 FLAG AS UNIT * SA1 COMNUM GET COMMAND NUMBER SX3 UNITOP= GET NUMBER OF UNITOP BX3 X1-X3 NZ X3,UDONE MX6 1 IF UNITOP, SET UNITOP BIT LX6 58 * * * FINISH UP CURRENT UNIT * UDONE SA6 NUEFLAG SAVE NEW UEFLAG NG X6,UDONE10 IF -ENTRY- * SA1 LOCAL ZR X1,UDONE10 IF NO LOCAL DEFINE SET TO PURGE * SX6 1 PURGE LOCAL SET/REACTIVATE GSET SA6 OVARG1 EXEC DEFOV RETURN TO *UDONE10* * UDONE10 SA1 NUEFLAG BX6 X1 X6 = UEFLAG FOR UWRITE CALL UWRITE WRITE UNIT TO ECS * SA1 CUNITS INCREMENT NUMBER OF UNITS/ENTRIES SX6 X1+1 SA6 A1 * * INITIALIZE FOR NEW UNIT * SA1 LINENUM SAVE LINE AND BLOCK NUMBERS SA2 BLKNUM IN CASE OF ERRORS BX6 X1 BX7 X2 SA6 =XULINENM SA7 =XUBLKNM * SX7 INFOLTH SA7 ICX INITIALIZE COMMAND POINTER SX7 -1 SA7 ANSABUF INITIALIZE ANSWERA BUFFER BIAS SX7 0 SA7 INX INITIALIZE XSTOR POINTER SA7 NGLOBAL NUMBER OF GLOBAL SYMBOLS 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 SA1 NUEFLAG X1 = -UNIT-/-ENTRY- FLAG NG X1,UDONE20 IF -ENTRY- * SA7 LOCAL FLAG END OF LOCAL SET ACTIVITY SA7 LVARN NUMBER OF LOCAL VARIABLES SA1 CONTFLG X1 = CONTINUATION FLAG PL X1,UDONE20 IF NO LOCAL SET * SX6 1 FLAG LOCAL SET PROCESSING SA6 LOCAL MX6 0 SA6 OVARG1 EXEC DEFOV PROCESS LOCAL SET * * RETURN TO UDONE20 * /--- BLOCK UNIT 00 000 80/03/28 00.28 * UDONE20 SA1 COMMAND SAVE COMMAND NAME BX6 X1 SA6 =XCMNDTMP SA1 UNITCMD SET COMMAND = UNIT SA2 NUEFLAG X2 = -1 IF -ENTRY PL X2,UDONE25 IF -UNIT- COMMAND * SA1 NTRYCMD SET COMMAND = ENTRY UDONE25 BX6 X1 SA6 COMMAND MX6 -1 SA6 UNITFLG FLAG -UNIT- COMMAND CALL UNAM2 PROCESS ANY ARGUMENTS SA1 =XCMNDTMP X1 = SAVED COMMAND NAME BX6 X1 SA6 COMMAND RESTORE COMMAND NAME MX6 0 SA6 A1 ZERO CMNDTMP SA1 LOCAL ZR X1,UDONE30 * SA1 NUEFLAG NG X1,UDONE30 IF -ENTRY- IN LOCALS UNIT * RJ =XRSTRTAG RESTORE TAG AFTER LOCAL SET SA1 VARBUF ZR X1,=XNXTC EXIT IF NO ARGUMENTS EQ UDONE40 * UDONE30 BSS 0 SA1 VARBUF ZR X1,NXTLINE EXIT IF NO ARGUMENTS * * /--- BLOCK UNIT 00 000 80/03/28 00.24 UDONE40 SA2 UEFLAG SET ARGS BIT IN UNAM TABLE WORD MX7 1 LX7 59 BX7 X2+X7 COMBINE WITH UNIT/ENTRY FLAG SA7 A2 * CALL APACK PACK UP -GETVAR- CODES MX0 -10 BX6 -X0*X6 MASK OFF EXTRA STORAGE POINTER LX6 48 SX1 ARGS= SET CODE FOR -ARG- COMMAND BX6 X1+X6 SA2 NUEFLAG NG X2,ALTCODE IF -ENTRY- COMMAND * SA2 LOCAL NZ X2,=XALTCOD1 SPECIAL ALTCODE FOR LOCAL VARS * EQ ALTCODE * UNITCE SB1 71 DUPLICATE UNIT NAME EQ =XERR UNITCF SB1 72 UNIT NAME MAY NOT BE -X- OR -Q- EQ =XERR * UNITCMD DATA 8LUNIT NTRYCMD DATA 8LENTRY * /--- BLOCK UWRITE 00 000 77/04/21 21.25 TITLE -UWRITE- * * -UWRITE- WRITE LAST UNIT TO ECS * UWRITE EQ * SA3 UEFLAG GET FLAG FOR PREVIOUS UNIT SA6 A3 SAVE FLAG FOR NEXT UNIT SA1 UNIT GET CURRENT UNIT NUMBER SA0 ABEND WORK BUFFER SA2 AUNAME GET UNORDERED UNIT NAME TABLE IX0 X1+X2 GET ENTRY OF CURRENT UNIT + RE 1 RJ ECSPRTY SA2 A0 READ UP UNIT NAME BX6 X2+X3 ADD IN BITS FOR'; ENTRY, ARGS SA1 UNUMON GET NEXT UNIT NUMBER LX1 48 BX6 X1+X6 PUT TOGETHER SA6 A0 + WE 1 AND OUT TO TABLE RJ ECSPRTY * * FOR FOLLOWING... * X0 HOLDS BINARY INSERT POINTER * X3 HOLDS FORMING TOTAL LENGTH OF UNIT * X6 HOLDS THE DEVELOPING UNIT-LOC WORD * * THE FORMAT OF THE UNIT LOCATION INFO WORD IS... * ULOC1 BITS RELATIVE BIAS TO UNIT IN BINARY * ULOC2 BITS LENGTH OF CENTRAL MEMORY PART OF UNIT * ULOC3 BITS NUMBER OF COMMANDS IN UNIT * ULOC4 BITS TOTAL LENGTH OF UNIT (CM PART PLUS ECS RES PART) * ULOC5 BITS NUMBER OF LOCAL VARS IN UNIT * * SA1 CONBUFF GET ADDRESS OF CONDENSE BUFFER SA2 CONDPNT CURRENT PLACE IN THIS BUFFER IX6 X2-X1 GET RELATIVE ADDRESS OF START OF UNIT LX6 60-ULOC1 AND PUT INTO ULOC WORD-A-MAKING BX0 X2 POINT AT WHICH TO INSERT IN BINARY * SA1 ICX SA0 X1+INFO CM ADDRESS OF COMMANDS SX4 INFOLTH IX2 X4-X1 GET NUMBER OF COMMANDS BX3 X2 BX5 X2 LX5 60-ULOC1-ULOC2-ULOC3 POSITION FOR ULOC WORD BX6 X6+X5 ADD NUMBER OF COMMANDS TO ULOC WORD NG X2,LNGUNIT TEST FOR UNIT TOO LONG CALL WRITECS WRITE COMMANDS TO BINARY-A-FORMING * SA2 INX GET LENGTH OF EXTRA STORAGE SA0 INFO CM ADDRESS OF EXTRA STORAGE IX3 X3+X2 ADD CM ARGS LENGTH TO FORMING TOTAL LENGTH BX4 X3 * /--- BLOCK UWRITE 00 000 77/04/21 21.25 LX4 60-ULOC1-ULOC2 PUT CM RES TOTAL LENGTH IN PLACE FOR BX6 X6+X4 ADDING TO FORMING UNIT LOC WORD CALL WRITECS PUT CM RES ARGS TO BINARY-A-FORMING * /--- BLOCK UWRITE 00 000 77/03/31 17.49 * SA4 ECSARGS GET NUMBER OF ECS RESIDENT ARGS * IX3 X3+X4 ADD AMOUNT TO TOTAL LENGTH OF UNIT * LX3 60-ULOC1-ULOC2-ULOC3-ULOC4 POSITION BX6 X6+X3 ADD TOTAL LENGTH TO UNIT-LOC WORD * SA1 LVARN X1 = NUMBER OF LOCALS IN UNIT LX1 60-ULOC1-ULOC2-ULOC3-ULOC4-ULOC5 BX6 X6+X1 X6 = ULOC ENTRY + LVARN * SA1 ECSRESB GET START OF ECS ARGS BUFFER SA0 INFO USE CM WORK BUF * COULD USE -WORK- AND -WORKLTH- FOR BIGGER TRANSFER BUFFERS * UWTOP ZR X4,UWDONE START OF LOOP TO RELOCATE ECS RES PART BX7 X0 SAVE CURRENT INSERT POINTER IN BINARY BX2 X4 LENGTH OF ECS RES PART OF UNIT SX4 X4-INFOLTH SEE IF WILL FIT INTO CM BUFFER BX0 X1 GET CONDENSOR ADDRESS OF ECS RES PART OF U NG X4,UWMID SEE IF CAN DO IN ONE PASS SX2 INFOLTH ELSE JUST DO CM BUFFER LENGTH UWMID SB1 X2 NOW TRANSFER TO CM + RE B1 RJ ECSPRTY IX1 X0+X2 AUGMENT ECS RES ADDRESS FOR NEXT MOVE BX0 X7 GET CURRENT INSERT PLACE IN BINARY CALL WRITECS MOVE INTO BINARY PL X4,UWTOP SEE IF EVERYTHING TRANSFERRED * * UWDONE BX7 X0 UPDATE POINTER OF CURRENT PLACE SA7 CONDPNT MATERIAL IS BEING ADDED TO BINARY SA1 UNIT SA6 X1+ULOC PUT OUT THIS UNIT-LOC INFORMATION SA2 UNUMON BX6 X2 SA6 A1 SET NEXT UNIT NUMBER MX6 0 SA6 ECSARGS INITIALIZE ECS ARGS TO ZERO EQ UWRITE * * * /--- BLOCK UNAMA 00 000 73/00/00 00.00 TITLE -UNAMA- * * * -UNAMA- * UNIT NAME AND ARGUMENT PROCESSOR * * RETURNS WITH X6 = UNIT NUMBER * VARBUF(0) = NUMBER OF ARGUMENTS * VARBUF(N) = -GETVAR- CODES FOR ARGUMENTS * * UNAMA EQ * CALL UNAM1 PROCESS UNIT NAME CALL UNAM2 PROCESS ARGUMENTS EQ UNAMA * * * /--- BLOCK UNAM1 00 000 76/07/25 06.40 TITLE -UNAM1- * * * -UNAM1- * COLLECT UNIT NAME AND CHECK FOR ARGUMENTS * * RETURNS X6 = UNIT NUMBER * *UARGS* = -1 IF ARGUMENTS * 0 IF NO ARGUMENTS * * UNAM1 EQ * SA1 WORDPT POINTER TO FIRST CHARACTER SB1 X1-1 SB2 60-6 INITIALIZE SHIFT COUNT MX6 0 INITIALIZE NAME BUILDING SA6 UNITFLG CLEAR -UNIT- FLAG * UNLP SB1 B1+1 ADVANCE CHARACTER POINTER SA1 B1 LOAD NEXT CHARACTER SX2 X1-1R NZ X2,UNLP0 JUMP IF NOT SPACE ZR X6,UNLP JUMP IF LEADING SPACE(S) SB3 B2-7 NG B3,UNLP POSSIBLE TRAILING SPACES * UNLP0 ZR X1,UNAGOT SA2 X1+KEYTYPE NG X2,UNLP1 JUMP IF ALPHANUMERIC ZR X2,UNLP1 SX3 X2-OPCOMMA CHECK FOR COMMA ZR X3,UNAGOT1 SX3 X2-OP( CHECK FOR RIGHT PAREN ZR X3,UNAGOT2 SX3 X2-OP) CHECK FOR LEFT PAREN ZR X3,ERRTERM * UNLP1 LX1 X1,B2 POSITION THIS CHARACTER BX6 X1+X6 MERGE WITH REST OF WORD SB2 B2-6 PL B2,UNLP EQ ERRNAME * /--- BLOCK UNAM1 00 000 76/07/25 06.41 * UNAGOT SX7 B1 UPDATE *WORDPT* SA7 WORDPT MX7 0 MARK NO ARGUMENTS EQ UAGOT * UNAGOT1 SX7 B1+1 UPDATE *WORDPT* SA7 WORDPT MX7 0 MARK NO ARGUMENTS EQ UAGOT * UNAGOT2 SX7 B1+1 UPDATE *WORDPT* SA7 WORDPT MX7 -1 MARK ARGUMENTS TO UNIT * UAGOT ZR X6,ERRNAME ERROR IF ZERO NAME SA7 UARGS BX7 X1 SAVE TERMINATOR IN *LASTKEY* SA7 LASTKEY BX1 X6 SET UP FOR -LJUST- CALL LJUST,(1R ),0 MX0 -12 BX0 -X0*X1 CHECK IF NAME TOO LONG NZ X0,ERRNAME BX6 X1 ZERO FILLED NAME SA2 UNX X2 = L.J. X BX2 X6-X2 ZR X2,UAX SA2 UNQ X2 = L.J. Q BX2 X6-X2 ZR X2,UAQ LX6 48 POSITION UNIT NAME CALL UNAMX FIND OR ADD TO UNIT TABLE SA6 AUNUM SAVE UNIT NUMBER EQ UNAM1 * UAX SX6 UNXNUM SET FOR UNIT -X- EQ UAXQ * UAQ SX6 UNQNUM SET FOR UNIT -Q- UAXQ SA6 AUNUM SA2 UARGS ZR X2,UNAM1 JUMP IF NO ARGUMENTS EQ ERRUARG * * /--- BLOCK UNAM2 00 000 81/01/08 01.10 TITLE -UNAM2- * * -UNAM2- * PROCESS ARGUMENTS OF UNIT * * RETURNS X6 = UNIT NUMBER * *VARBUF(0)* = NUMBER OF ARGUMENTS * *VARBUF(N)* = -GETVAR- CODES * UNAM2 EQ * MX0 0 FOR ARGS ENDING AT EOL RJ UNAM2A EQ UNAM2 * UNAM2A EQ * MX6 0 INITIALIZE ARGUMENT COUNT SA6 VARBUF SA1 UARGS SEE IF ANY ARGUMENTS ZR X1,UN290 SA1 WORDPT NG X0,UNA0 IF PROCESSING (PBV;RBV) * SX1 X1-1 BACK UP ONE CHARACTER CALL PSCAN FIND END OF ARGUMENT(S) NZ B2,ERRBAL ERROR IF UNBALANCED PARENS NZ B3,ERRBAL ERROR IF UNBALANCED QUOTES EQ UNA1 * UNA00 SX1 B1+1 SKIP COMMA UNA0 CALL PSCAN SB2 B2+1 ZR B2,UNA01 IF TERMINATED WITH ) * SX3 X1-1R, ZR X3,UNA00 IF , DELIMITER * SX3 X1-1R; NZ X3,ERRTERM IF BAD TERMINATOR * BX6 X1 SAVE TERMINATOR KEY SA6 ARGKEY EQ UN100 * UNA01 SB1 B1+1 EQ UNA1 * * * REMOVE TRAILING SPACES * UNA1 SA3 B1-1 SX6 X3-1R NZ X6,UNA2 NOT A SPACE SB1 B1-1 EQ UNA1 CONTINUE BACKSPACING UNA2 BX6 X3 SAVE TERMINATOR KEY SA6 ARGKEY SA3 X3+KEYTYPE CHECK ENDED WITH RIGHT PAREN SX3 X3-OP) NZ X3,ERRTERM SX6 1R REPLACE RIGHT PAREN WITH SPACE SA6 B1-1 UN100 SX6 B1 SA6 ENDPNT * CALL GETARGS PROCESS ARGUMENTS * UN290 SA1 AUNUM RETURN UNIT NUMBER IN X6 BX6 X1 EQ UNAM2A * * ABEND BSS 1 KCOMM DATA 0LCOMMON KLESS DATA 0LLESSON UNX DATA 1LX UNQ DATA 1LQ * /--- BLOCK FINIS 00 000 81/07/20 21.33 TITLE FINIS * * FINIS (CODE=50) * * END OF LESSON PROCESSING * * FINISC CALL GLOBSYM FINISH UP GLOBAL CALC BRANCHES CALL ULONG CHECK FOR UNIT TOO LONG CALL SETARO,B0 PSEUDO -ENDARROW- * SA1 NOUNIT SEE IF ANY UNIT FOUND NZ X1,FINON8 NON-ZERO MEANS UNIT FOUND ELSE MUST SA1 UNUMON CREATE A DUMMY UNIT AFTER THE IEU * THIS FIX ALLOWS A LESSON WITHOUT ANY * UNITS TO APPEAR AS A ONE UNIT LESSON * AND EXECUTE. SX2 X1-IEUNUM SEE IF DOING INITIAL ENTRY UNIT NZ X2,FINON5 ELSE MUST HAVE PASSED AN ENTRY COMMAND SA2 ICX GET COMMAND POINTER SX2 X2-1 SA3 INX IX3 X3-X2 CHECK FOR UNIT TOO LONG PL X3,LNGUNIT GIVE FATAL CONDENSE ERROR BX7 X2 SA7 A2 UPDATE FOR -IEUEND- COMMAND SX7 IEUEND= SA7 X2+INFO ADD AN -IEUEND- COMMAND * FINON5 SA1 UNUMIN GET LAST UNIT REFERENCED SX7 X1+1 INCREMENT BY 1 SX2 X7-UTABLTH ERROR TEST IF TOO MANY UNITS PL X2,=XBADIEU --- FATAL CONDENSE ERROR * SA7 A1 UPDATE NUMBER OF UNITS MX7 0 AND ZERO UNIT-LOCATION TABLE SA7 ULOC+X1 SX7 3RNOU SET TO NO UNIT LX7 30 LEFT-ADJUST UNIT NAME SA7 UNAME+X1 STORE IN UNIT NAME TABLE SA0 A7 AND PUT INTO NON-ALPHABETIZED TABLE SA2 AUNAME GET ADDRESS OF TABLE IN ECS IX0 X2+X1 NOW HAVE UNIT ENTRY + WE 1 WRITE OUT UNIT NAME RJ ECSPRTY BX6 X1 SA6 UNUMON AND SET THIS TO CURRENT UNIT EQ FINON9 FOR -UWRITE- TO PLUCK INTO UNAME TABLE * * PUT LAST UNIT INTO ECS * FINON8 MX6 0 CLEAR TO END CHAIN IN UNIT NAME TABLE SA6 UNUMON * FINON9 CALL UWRITE RETURN TITLE COMPLETE PREVIOUS CPU UNIT * /--- BLOCK PINIT 00 000 81/07/21 03.05 * COMPLETE PREVIOUS CPU UNIT * * FOLLOWING ENTERED DIRECTLY FROM OVERLAY CALL * JUMP TABLE AT BEGINNING OF FILE. COMPLETES * PREVIOUS CPU UNIT BEFORE BEGINNING CONDENSE OF * ^MTUTOR UNITS. CALLED ON FINDING ^MTUTOR COMMAND. * PINIT SA1 NOUNIT CHECK IF PREVIOUS CPU UNIT NZ X1,PINIT1 IF PREVIOUS CPU UNIT PRESENT SB1 152 EQ =XERR PINIT1 BSS 0 CALL GLOBSYM SATISFY GLOBAL CALC BRANCHES CALL ULONG CHECK FOR UNIT TOO LONG CALL SETARO,B0 PSEUDO -ENDARROW- MX6 0 SA6 UNUMON MARK LAST CPU UNIT CALL UWRITE WRITE UNIT TO ECS * * SETUP PPTVERS FOR LEVEL 1 MICROTUTOR - CHECK * CAN BE TAKEN OUT WHEN LEVEL 1 IS GONE. * * * SET UP PPTVERS INFO - USED TO BE IN MTUTC * PPTVERS = 0 FOR PRIMITIVE * 2 FOR -PPTVERS CUT22 * SA1 COMMAND SA2 =XMTUTNAM BX0 X1-X2 CHECK COMMAND NAME = ^MTUTOR ZR X0,MTUTORC SA1 MTREL SX0 X1-1 PRIMITIVE ONLY ALLOWED IN LEV 1 NZ X0,MTERR IF NOT LEVEL 1 MX6 0 SA6 PPTVERS SET FOR PRIMITIVE VERSION EQ =XMTLOAD * * PRIMITIVE LEVEL IS NOT ALLOWED IN RELEASE > 1 * MTERR SB1 123 PRIMITIVE LEVEL NOT ALLOWED RJ =XRJERR EQ =XMTFIN * MTUTORC SX6 2 FORCE NON-PRIMITIVE VERSION SA6 PPTVERS EQ =XMTLOAD * /--- BLOCK ENTRY 00 000 80/02/15 22.08 TITLE ENTRY * -ENTRY- (CODE=67) * * USED FOR WITHIN AND BETWEEN UNIT BRANCHING. * THIS COMMAND FINISHES UP THE CURRENT UNIT AND STARTS A NEW * ONE WITH THE NAME SPECIFIED IN THE TAG. THE -ENTRY- * COMMAND ITSELF FUNCTIONS LIKE A -GOTO- THAT IS LEGAL IN * ALL CONTINGENCIES--THUS THE TWO UNITS BEHAVE AS ONE. * * -ENTRY- COMMAND FORMAT * FIRST 12 BITS = ENTRY UNIT * NEXT 12 = NEXT PHYSICAL UNIT * NEXT 36 = COMMAND NUMBER * * ENTRYIN SA1 INDENT NZ X1,NOINDT INDENTING IS NOT PERMITTED CALL GLOBSYM FINISH UP GLOBAL CALC BRANCHES CALL ULONG CHECK FOR UNIT TOO LONG CALL SETARO,B0 PSEUDO -ENDARROW- CALL UNAM1 GET UNIT NUMBER SX2 X6-UNXNUM CHECK FOR ILLEGAL UNIT -X- ZR X2,UNITCF JUMP IF ENTRY -X- SX2 X6-UNQNUM CHECK FOR ILLEGAL UNIT -Q- ZR X2,UNITCF JUMP IF ENTRY -Q- SA1 X6+ULOC PL X1,UNITCE ERROR IF DUPLICATE ENTRY * RJ =XUNITLOC LOG ENTRY COMMAND LOCATION SA1 UNUMON SX2 X1-IEUNUM SEE IF INITIAL ENTRY UNIT NZ X2,ENTRY10 SA2 ICX GET COMMAND POINTER SX2 X2-1 BX7 X2 SA7 A2 UPDATE FOR -IEUEND- COMMAND SX7 IEUEND= SA7 X2+INFO ADD AN -IEUEND- COMMAND * ENTRY10 IX7 X6-X1 CHECK FOR UNIT ZONK CONTAINING UNIT ZONK ZR X7,UNITCE DUPLICATE ENTRY NAME SA6 A1 SET UNIT WORKING ON POINTER SA2 ICX GET CURRENT COMMAND STORAGE LOC SX7 X2-1 SA7 A2 RETURN CURRENT COMMAND COUNTER LX6 48 SHIFT UNIT NUMBER TO TOP 12 BITS SA1 COMNUM X1 = COMMAND NUMBER BX6 X6+X1 SA6 INFO+X7 STORE -ENTRY- COMMAND * MX6 1 FLAG AS ENTRY UNIT EQ UDONE AND GO TO FINISH UNIT * /--- BLOCK -INITIAL- 00 000 79/01/23 02.44 TITLE -INITIAL- COMMAND * * * * INITIAL LESSON,UNIT * INITIAL COMMON,UNIT * * EXECUTES SPECIFIED UNIT IF LESSON OR COMMON HAS * NOT BEEN INITIALIZED * * INITC CALL NXTNAM GET FIRST ENTRY ZR X6,ERRNAME MX7 0 INITIALIZE TYPE SA1 KLESS BX1 X1-X6 CHECK IF *LESSON* ZR X1,INITC1 SX7 X7+1 INCREMENT TYPE SA1 KCOMM BX1 X1-X6 CHECK IF *COMMON* NZ X1,ERRNAME * INITC1 LX7 60-12-18 POSITION TYPE CODE SA7 SHOWOUT CALL UNAMA GET UNIT NUMBER TO X6 SX0 X6-UNXNUM CHECK FOR UNIT -X- ZR X0,ERRXORQ SX0 X6-UNQNUM CHECK FOR UNIT -Q- ZR X0,ERRXORQ CALL APACK LX6 48 POSITION UNIT NUMBER SA1 SHOWOUT BX4 X1+X6 ATTACH TYPE CODE SA1 COMNUM BX6 X1+X4 ATTACH COMMAND NUMBER SA2 ICX SX7 X2-1 DECREMENT COMMAND INDEX SA7 A2 SA6 X7+INFO STORE COMPLETED COMMAND WORD SX1 X1+1 INCREMENT COMMAND NUMBER BX6 X1+X4 EQ ALTCODE STORE SECOND COMMAND * * /--- BLOCK ROUTEC 00 000 84/01/25 12.32 TITLE -ROUTE- * * -ROUTE- COMMAND * * SPECIFIES ROUTER EXITS FOR VARIOUS EXIT CONDITIONS * * POSSIBLE EXIT TYPES -- 0 (FINISH) * 1 (END LESSON) * 2 (ERROR) * 3 (RESIGNON) * 4 (CLEAR) * * RESIGNON HAS OPTIONAL SECOND ARGUMENT (UNIT), ALL * OTHER TYPES REQUIRE UNIT SPECIFICATION. * ROUTEC BSS 0 SA1 LESSON NAME OF LESSON BEING CONDENSED SA2 KPLATO LESSON *PLATO* SA3 KNPLATO LESSON *NPLATO* BX2 X1-X2 COMPARE CURRENT WITH *PLATO* BX3 X1-X3 COMPARE CURRENT WITH *NPLATO* ZR X2,ROUTEC0 -- OK IF LESSON *PLATO* ZR X3,ROUTEC0 -- OK IF LESSON *NPLATO* SA1 ROUTER CHECK FOR ROUTER LESSON STATUS ZR X1,ERRORC -- NOT A ROUTER, FLAG AS ERROR ROUTEC0 BSS 0 * * GET FIRST ARGUMENT AND CHECK IT FOR VALIDITY * CALL NXTNAME LIT STRING IN X6, DELIM IN X2 SA1 RLIST-1 THEN SEARCH *RLIST* FOR STRING RLOOK SA1 A1+1 READ NEXT ENTRY IN ROUTE TYPES ZR X1,ERRNAME -- END OF TABLE, NOT FOUND BX1 X1-X6 COMPARE WITH LITERAL STRING NZ X1,RLOOK -- NO MATCH, KEEP SEARCHING SX1 A1-RLIST ELSE COMPUTE INDEX INTO RLIST BX6 X1 LEAVE -ROUTE- TYPE IN X1 LX6 60-6 THEN MOVE IT TO HIGH ORDER 6 SA6 ILOC SAVE IT FOR MERGE INTO COMMAND * * CHECK DELIMITER FOR SECOND ARGUMENT * SX0 X2-EOL CHECK FOR SINGLE ARGUMENT ZR X0,ROUTEC2 SX0 X2-OPCOMMA MUST END WITH COMMA OR EQUIV NZ X0,ERRTERM * * GET UNIT ARGUMENT AND CHECK FOR SPECIAL UNITS * MX3 0 CALL UNAM1 GET UNIT NUMBER SA2 UARGS MAKE SURE NO ARGUMENTS NZ X2,ERRUARG SX0 X6-UNXNUM CHECK FOR UNIT -X- ZR X0,ERRXORQ -- ERROR, -X- NOT LEGAL SX0 X6-UNQNUM CHECK FOR UNIT -Q- NZ X0,ROUTEC1 -- GO AHEAD, NOT -Q- MX6 0 UNIT -Q- = UNIT NUMBER 0 * * ASSEMBLE COMMAND WORD WITH TAGS * ROUTEC1 LX6 60-6-12 SA1 ILOC GET TYPE CODE BX6 X1+X6 AND ATTACH IT EQ PUTCODE ADD COMMAND CODE AND STORE * /--- BLOCK ROUTEC 00 000 84/01/25 12.30 * * PROCESS SINGLE ARGUMENT -ROUTE- * ROUTEC2 BSS 0 SX6 0 UNIT '7Q'7 FOR SINGLE TAG SX0 X1-3 CHECK FOR '7RESIGNON'7 ZR X0,ROUTEC1 --- FINISH TAG IF RESIGNON * SX0 X1-4 CHECK FOR '7CLEAR'7 NZ X0,ERRORC --- MUST BE A 2-ARG WITH ONLY 1 SA1 ROUTER CHECK ROUTER STATUS NZ X1,ERRORC -- ERROR, (N)PLATO ONLY EQ ROUTEC1 --- WRAP-UP COMMAND WORD * * TABLE OF POSSIBLE -ROUTE- TYPES * RLIST DATA 6LFINISH DATA 10LEND LESSON DATA 5LERROR DATA 8LRESIGNON DATA 5LCLEAR DATA 0 * KPLATO DATA 5LPLATO KNPLATO DATA 6LNPLATO * ILOC BSS 1 FOR SAVING ROUTE TYPE * * /--- BLOCK TIMERC 00 000 81/01/08 01.06 TITLE TIMER, TIMEL * * * -TIMER- * SPECIFIES SECONDS AND UNIT TO RETURN TO AFTER * THOSE SECONDS ARE UP. * * -TIMEL- * SPECIFIES SECONDS AND UNIT TO GOTO AFTER * THOSE SECONDS ARE UP. * * TIMERC SA1 ROUTER MUST BE -ROUTER- LESSON ZR X1,ERROUTR TIMELC SA1 TAGCNT SEE IF BLANK TAG ZR X1,PAUSE2 IF BLANK, TURN OFF TIMING RJ COMPILE OTHERWISE GET CODE FOR TIME BX6 X1 SAVE -GETVAR- CODE SA6 BRVAR MX3 0 CALL UNAM1 GET UNIT NUMBER SA2 UARGS MAKE SURE NO ARGS NZ X2,ERRUARG SX0 X6-UNXNUM ZR X0,ERRXORQ ERROR IF UNIT -X- SX0 X6-UNQNUM ZR X0,ERRXORQ ERROR IF UNIT -Q- SA1 BRVAR RETREIVE -GETVAR- CODE LX6 60-XCODEL PLACE UNIT NO IN TOP LX1 60-2*XCODEL AND GETVAR IN SECOND BX6 X6+X1 EQ PUTCODE * BRVAR BSS 1 * * /--- BLOCK RETURN 00 000 81/01/08 01.08 * * -RETURN- COMMAND * * RETIN1 SA1 FLEVEL X1 = FILE UPDATE LEVEL SX1 X1-5 PL X1,RETIN2 -- BRANCH IF NEW -RETURN- * SA1 =XBRKCMD FAKE -BREAK- COMMAND BX6 X1 SA6 COMMAND EQ NXTC * RETIN SA1 FLEVEL X1 = UPDATE LEVEL SX1 X1-4 NZ X1,ERRORC IF -NRET- NO LONGER LEGAL * RETIN2 SA2 WORDPT X2 = ADDR OF FIRST WORD OF TAG SA1 TAGCNT NUMBER OF CHARACTERS IN TAG IX6 X1+X2 ADDR OF EOL SA6 =XENDPNT MX6 0 SA6 VARBUF SA6 =XUNITFLG FLAG NOT A UNIT TYPE ARG LIST ZR X1,RETIN10 IF BLANK TAG * CALL GETARGS PROCESS ARGUMENT LIST MX6 0 INITIALIZE X6 FOR APACK CALL APACK PACK UP THE ARGUMENTS LX6 61-12 AX6 1 CLEAR TOP BIT EQ PUTCODE RETIN10 MX6 1 NO ARGS; SET TOP BIT EQ PUTCODE * * -UNAMA1- * * GET UNIT AND ARGUMENTS FOR -DO- * * ON EXIT RARGFLG = -1 IF RARGS ENCOUNTERED * UNCHANGED IF NOT * X6 = COMMAND WORD WITHOUT COMMAND NUMBER * UNAMAZZ SA1 DOCWORD RESTORE THE COMMAND WORD BX6 X1 UNAMA1 EQ * CALL UNAM1 PROCESS UNIT NAME MX0 -1 SET TO LOOK FOR (;;) SYNTAX CALL UNAM2A CALL APACK PACK UP ANY ARGUMENTS SA6 DOCWORD SAVE THE COMMAND WORD FOR -DO- SA1 =XUARGS ZR X1,UNAMAZZ IF NO ARGUMENTS * /--- BLOCK RETURN 00 000 81/01/08 01.07 * SA1 =XARGKEY CHECK FOR RETURN ARGUMENTS SX2 X1-1R; NZ X2,UNAMAZZ IF NO RETURN ARGUMENTS * SA1 ENDPNT CHECK FOR EOL SA1 X1+1 NZ X1,UNAMA10 IF NOT EOL * SA2 CONTFLG PL X2,UNAMAZZ IF NOT CONTINUED * CALL GETLINE RARGS MIGHT BE ON NEXT LINE UNAMA10 BSS 0 SX6 1R( FAKE NORMAL CBV ARG LIST SA6 A1-1 SX6 -1 INDICATE RARGS ENCOUNTERED SA6 =XRARGFLG * SA1 WORDPT INCREMENT WORDPT * IX6 X1-X6 * SA6 A1 SX6 2000B CODE FOR RETURN ARGUMENTS SA1 DOCWORD BX6 X6+X1 SA6 A1 SA6 =XUNITFLG SA1 INX SAVE CURRENT INX POINTER SX6 X1+1 RESERVE POINTER TO RARGS SA6 A1 BX6 X1 SA6 SAVINX CALL UNAM2 PROCESS REST OF ARGUMENTS SA1 INX X1 = PTR TO RARGS SX7 X1 SA2 SAVINX X2 = ADDR OF PTR TO RARGS SA7 X2+INFO CALL APACK PACK THE ARGS UP EQ UNAMAZZ * RARGFLG BSS 1 FLAG RETURN ARGUMENTS FOUND DOCWORD BSS 1 TEMP STO FOR DO COMMAND WORD SAVINX BSS 1 TEMP STO FOR INX BEORE RETARGS * ISITER BSS 1 DTABLOC BSS 1 WPTSAV1 BSS 1 WPTSAV2 BSS 1 JOINFLG BSS 1 * ENDOV * /--- BLOCK COVL4B 00 000 79/07/20 03.21 COV4B OVRLAY SA1 OVARG1 GET ARGUMENT SB1 X1 JP B1+*+1 * + EQ ARROWC 0 = -ARROW- + EQ ENDAROC 1 = -ENDARROW- + EQ JARROWC 2 = -JARROW- + EQ WRITEIN 3 = -EXACT- + EQ FINDC 4 = -FIND- + EQ FINDAC 5 = -FINDALL- * * * /--- BLOCK ARROW 00 000 79/07/20 03.12 TITLE ARROW * * ARROW (CODE=11 OR 12) * * 'HOLDS (WHEN COMPLETE) ONE ARGUMENT IF COARSE * GRID OR TWO ARGUMENTS IF FINE GRID PLUS A * POINTER TO THE NEXT ARROW OR ENDARROW COMMAND, * OR TO THE END OF THE UNIT IF THERE IS NEITHER. * * ARROWC SA1 INDENT NZ X1,NOINDT INDENTING IS NOT PERMITTED RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF X1 = NUMBER OF VARIABLES SX1 X1-3 PL X1,ERR2MNY --- ERROR IF MORE THAN 2 TAGS CALL SETARO,B0 PSEUDO -ENDARROW- SA1 ICX CURRENT COMMAND POINTER SX7 X1-1 VALUE WHEN THIS COMMAND STORED SA7 LOCARO SAVE LOCATION OF THIS ARROW EQ ONETWO1 --- EXIT TO STORE COMMAND * * * * * ENDARROW (CODE=40) * * 'PUT PROPER POINTER VALUE IN PRECEDING ARROW * COMMAND IN THIS UNIT (IF THERE IS ONE). * * ENDAROC SA1 INDENT NZ X1,NOINDT INDENTING IS NOT PERMITTED RJ NOTAG BE SURE THERE IS NO TAG CALL SETARO,-1 REAL -ENDARROW- SX6 0 COMMAND NUMBER ONLY EQ PUTCODE --- EXIT TO STORE COMMAND * * * * JARROW * * 'INITIATE JUDGING WITHOUT AN ARROW. * * JARROWC SA1 INDENT NZ X1,NOINDT INDENTING IS NOT PERMITTED RJ NOTAG BE SURE THERE IS NO TAG CALL SETARO,B0 PSEUDO -ENDARROW- SA1 ICX CURRENT COMMAND POINTER SX7 X1-1 VALUE WHEN THIS COMMAND STORED SA7 LOCARO SAVE LOCATION OF THIS ARROW SX6 0 COMMAND NUMBER ONLY EQ PUTCODE --- EXIT TO STORE COMMAND * /--- BLOCK EXACT 00 000 76/07/24 20.01 TITLE EXACT * -EXACT- * * * FORMAT OF COMMAND WORD -- * * UPPER 18 BITS = RELATIVE ADDRESS OF START OF INFO * NEXT 18 BITS = NUMBER OF 6 BIT CODES * * WRITEIN SA1 INX XTRA STORAGE POINTER SB5 X1 SB1 B0 NUMBER 6 BIT CODES SA2 TAG CHECK FOR LEFT WRITING SA1 A2+1 RESET FOR LOOP LX2 6 BX6 X1+X2 SX1 X6-KUP*100B-1R0 CHECK FOR LEFT WRITING NZ X1,WRT100 IF NOT LEFT SX6 KUP*100B+1R1 SET TO NORMAL LEFT LX6 -12 POSITION TO UPPER BITS SB4 60-12 SB1 2 AND 6 6 BIT CODES EQ WRTLOOP * WRT100 SA1 TAG-1 PRESET FOR LOOP * WRT150 SB4 60 SHIFT COUNT SX6 B0 * WRTLOOP SA1 A1+1 GET NEXT CHARACTER ZR X1,WRTDONE JUMP IF END OF LINE * SB1 B1+1 NUMBER 6 BIT CODES SB4 B4-6 SHIFT COUNT LX1 X1,B4 BX6 X6-X1 ADD TO CURRENT WORD NZ B4,WRTLOOP JUMP WORD NOT DONE SA6 INFO+B5 PUT IN XTRA STORAGE SB5 B5+1 JP WRT150 * WRTDONE SA6 INFO+B5 SB5 B5+1 SA1 INX POINTER TO XTRA LX1 42 SX2 B1 NUM 6 BIT CODES LX2 24 BX6 X1+X2 SX7 B5 CURRENT XTRA POINTER SA7 INX EQ PUTCODE GO ATTACH CODE * /--- BLOCK FIND 00 000 79/07/20 04.24 TITLE -FIND- FINDC RJ VARDO SA1 VARBUF+2 NG X1,FINDCE1 IF START NOT STOREABLE SA1 VARBUF+4 NG X1,FINDCE -- ERROR IF RETURN IS NOT STOREABLE SA3 VARBUF X3 = NUMBER OF VARIABLES SX1 4 4 ARGS REQUIRED WITHOUT INCREMENT OR MASK IX2 X3-X1 ZR X2,VARFIN EXIT IF EXACTLY 4 MX2 1 LX2 XCODEL PREPARE SPECIAL FLAG SA1 VARBUF+3 BX6 X1+X2 SA6 A1 SX1 5 5 ARGS REQUIRED IF INCREMENT IX4 X3-X1 ZR X4,VARFIN EXIT IF EXACTLY 5 SA1 VARBUF+5 BX6 X1+X2 SA6 A1 SX1 6 7 ARGS REQUIRED IF MASK EQ VARFIN * -SEARCH- AND -FINDALL- ALSO COME HERE FINDCE SB1 70 NON-STOREABLE VARIABLE EQ ERR * FINDCE1 SB1 768 ILLEGAL USE OF SEGMENTS EQ ERR * TITLE -FINDALL- FINDAC RJ VARDO SA1 VARBUF+2 NG X1,FINDCE1 IF START NOT STOREABLE SA1 VARBUF+4 NG X1,FINDCE -- ERROR IF RETURN IS NOT STOREABLE SA3 VARBUF X3 = NUMBER OF VARIABLES SX1 5 5 ARGS REQUIRED WITHOUT INCREMENT OR MASK IX2 X3-X1 ZR X2,VARFIN EXIT IF EXACTLY 5 MX2 1 LX2 XCODEL PREPARE SPECIAL FLAG SA1 VARBUF+3 BX6 X1+X2 SA6 A1 SX1 6 6 ARGS REQUIRED IF INCREMENT IX4 X3-X1 ZR X4,VARFIN EXIT IF EXACTLY SIX SA1 VARBUF+6 BX6 X1+X2 SA6 A1 SX1 7 SEVEN ARGS REQUIRED IF MASK EQ VARFIN * /--- BLOCK ENDOV 00 000 79/07/20 03.13 ENDOV * /--- BLOCK END 00 000 77/04/24 20.01 * * OVTABLE * * END COVLY4$