COVLAY1 * /--- FILE TYPE = E * /--- BLOCK IDENT 00 000 81/07/13 01.10 IDENT COVLAY1 LCC OVERLAY(1,1) * TITLE OVERLAYS FOR COMMAND READINS * * CST * * COVLY1$ OVFILE * * EXT ECSPRTY,PUTCODE,ERRORC EXT COMCONT,VARFIN,NXTLINE EXT NKLEND,NKLIST,KEYTYPE EXT CONDENS EXT LNGUNIT EXT ERRTAGS,ERRNAME,ERRSTOR EXT ERR2MNY,ERR2FEW,ERRBAL EXT ERRTERM,ERRUARG,ERRVTYP * * FOLLOWING FOR PACK EXT VARDO1 * * FOLLOWING FOR JUMPOUT,FROM EXT COMPNAM,GETARGS,ENDPNT,UNITFLG * * FOLLOWING FOR DATA COMMANDS EXT NXTNAM,GETLINE,DATAON= EXT CALCODE,VARDO2,MRKLAST EXT VARDO * * * /--- BLOCK ENABLE 00 000 75/11/08 13.08 TITLE -ENABLE/DISABLE- * EXT SCANNER * ENABOV OVRLAY SB1 ENTYPES START TABLE SB2 ENEND END TABLE MX5 60 FULL WORD MASK RJ SCANNER NZ X0,ERRNAME ZR X6,=XERROBS --- IF -ENABLE (BLANK)- EQ PUTCODE * * ENTYPES VFD 60/8LORIENTAL VFD 60/5LTOUCH VFD 60/3LEXT VFD 60/6LEXTMAP VFD 60/6LSTREAM ENEND BSS 1 HOLE FOR WORD CURRENTLY PROCESSING * ENDOV * /--- BLOCK PAUSOV 00 000 76/01/26 22.16 TITLE GROUP/PAUSE/KEYTYPE COMMAND READ-INS * * PAUSOV OVRLAY SA1 OVARG1 ZR X1,PAUSEIN IF 0 THIS IS PAUSE COMMAND SX2 X1-1 ZR X2,GROUPIN IF 1 THIS IS GROUP COMMAND EQ KEYTYIN OTHERWISE KEYTYPE COMMAND * * * * * /--- BLOCK TABLES 00 000 75/10/14 10.44 TITLE SYSTEM DEFINED GROUPS * * * LOW 3 BITS OF LAST WORD ARE SPECIAL FLAGS - * * 3RD BIT = SET ONLY FOR KEYS=ALL * 2ND = TOUCH * 1ST = EXT * * PURGMAC BITS BITS MACRO A,B,C,D,E,F,G,H,I,J VFD 1/A,1/B,1/C,1/D,1/E,1/F,1/G,1/H,1/I,1/J ENDM * * LIST G * G.ALPHA BITS 0,1,1,1,1,1,1,1,1,1 0-11 BITS 1,1,1,1,1,1,1,1,1,1 12-23 BITS 1,1,1,1,1,1,1,0,0,0 24-35 BITS 0,0,0,0,0,0,0,0,0,0 36-47 BITS 0,0,0,0,0,0,0,0,0,0 50-61 BITS 0,0,0,0,0,0,0,0,0,0 62-73 BITS 0,0,0,0,0,1,1,1,1,1 74-105 BITS 1,1,1,1,1,1,1,1,1,1 106-117 BITS 1,1,1,1,1,1,1,1,1,1 120-131 BITS 1,0,0,0,0,0,0,0,0,0 132-143 BITS 0,0,0,0,0,0,0,0,0,0 144-155 BITS 0,0,0,0,0,0,0,0,0,0 156-167 BSSZ 2 * * G.NUMER BITS 0,0,0,0,0,0,0,0,0,0 0-11 BITS 0,0,0,0,0,0,0,0,0,0 12-23 BITS 0,0,0,0,0,0,0,1,1,1 24-35 BITS 1,1,1,1,1,1,1,0,0,0 36-47 BITS 0,0,0,0,0,0,0,0,0,0 50-61 BITS 0,0,0,0,0,0,0,0,0,0 62-73 BSSZ 3 * * G.FUNCT BSSZ 2 BITS 0,0,0,0,0,0,0,0,1,1 170-201 BITS 1,1,1,1,1,1,1,1,1,1 202-213 BITS 1,1,1,1,1,1,1,1,1,1 214-225 BITS 1,1,1,1,1,1,1,1,1,1 226-237 BITS 1,1,1,1,1,1,1,1,1,1 240-251 BITS 1,1,1,1,1,1,1,1,1,0 252-263 BSSZ 1 * * /--- BLOCK TABLES 00 000 75/10/14 10.45 * G.EXT BSSZ 3 BITS 0,0,0,0,0,0,0,0,0,0 170-201 BITS 0,0,0,0,0,0,0,0,0,0 202-213 BITS 0,0,0,0,0,0,0,0,0,0 214-225 BITS 0,0,0,0,0,0,0,0,0,0 226-237 BITS 0,0,0,0,0,0,0,0,0,0 240-251 BITS 0,0,0,0,0,0,0,0,0,1 252-263 * * G.TOUCH BSSZ 3 BITS 0,0,0,0,0,0,0,0,0,0 170-201 BITS 0,0,0,0,0,0,0,0,0,0 202-213 BITS 0,0,0,0,0,0,0,0,0,0 214-225 BITS 0,0,0,0,0,0,0,0,0,0 226-237 BITS 0,0,0,0,0,0,0,0,0,0 240-251 BITS 0,0,0,0,0,0,0,0,1,0 252-263 * * G.ALL DATA -0,-0,-0,-0 ALL BITS SET * G.KEYSET DATA -0,-0,-0,-7 ALL KEYS EXCEPT FOR TOUCH/EXT * LIST * * * GROUPS VFD 42/5LALPHA,18/G.ALPHA + VFD 42/7LNUMERIC,18/G.NUMER + VFD 42/5LFUNCT,18/G.FUNCT + VFD 42/3LEXT,18/G.EXT + VFD 42/5LTOUCH,18/G.TOUCH + VFD 42/3LALL,18/G.ALL + VFD 42/6LKEYSET,18/G.KEYSET GEND DATA 0 * * * GRPDIM EQU 3 GRPDIM EQU 4 * GROUP EQU WORK+1 GROUP BIT TABLE GROUP1 EQU GROUP+GRPDIM GROUP BIT TABLE GROUPS1 EQU GROUP1+GRPDIM GROUP NAME TABLE GEND1 EQU GROUPS1+NKGROUP * * * /--- BLOCK KEYLIST 00 000 78/12/13 01.48 TITLE -KEYLIST- COMMAND READIN * * * * -KEYLIST- COMMAND * KEYLIST NAME,LIST OF KEYS * * GROUPIN CALL LOADG LOAD -KEYLIST- NAME TABLE * * GET GROUP NAME AND CHECK IF LEGAL * CALL NXTNAME GET GROUP NAME **** ZR X6,ERRNAME SX1 X1-1R, CHECK DELIMITER NZ X1,ERRTERM --- IF BAD DELIMITER GRP1 MX0 -18 FORM MASK FOR 7 CHARACTERS BX1 -X0*X6 NZ X1,ERRNAME LIMIT NAME TO 7 CHARACTERS MX2 6 BX1 X2*X6 CHECK NAME AT LEAST TWO CHARS LX1 6 SX1 X1-KUP CHECK IF FIRST CHAR IS SHIFT + NZ X1,*+1 AX2 6 EXTEND MASK + BX1 -X2*X6 ZR X1,ERRNAME ERROR IF NAME TOO SHORT SA6 GNAME * * CHECK FOR DUPLICATE GROUP NAME * SA1 GROUPS1-1 INITIALIZE FOR SEARCH MX7 0 INITIALIZE GROUP INDEX * GR20 SA1 A1+1 LOAD NEXT GROUP NAME ZR X1,GR30 SX7 X7+1 ADVANCE GROUP INDEX BX1 X1-X6 CHECK IF NAMES MATCH NZ X1,GR20 EQ ERRNAME ERROR IF GROUP ALREADY EXISTS * * INITIALIZE FOR NEW GROUP * GR30 SX1 X7-NKGROUP CHECK FOR OVERFLOW PL X1,ERR2MNY SA7 GINDX SAVE INDEX TO GROUP SB1 GRPDIM-1 MX7 0 * GR35 SA7 B1+GROUP1 INITIALIZE GROUP BIT TABLE SB1 B1-1 PL B1,GR35 * * /--- BLOCK KEYLIST 00 000 81/01/07 19.36 * * BUILD GROUP BIT TABLE * GR100 CALL NXT GET NEXT ENTRY SB1 X1 JP B1+*+1 * + EQ GR900 END-OF-LINE + EQ GR200 KEY VALUE + EQ GR300 GROUP + EQ ERRGRUP SPECIFIC TOUCH + EQ ERRGRUP SPECIFIC EXT + EQ ERRGRUP EXPRESSION * * * SET BIT IN GROUP TABLE FOR SPECIFIED KEY * GR200 SX1 X6 X1 = KEY VALUE NG X1,ERRGRUP CHECK IF LEGAL KEY CODE ZR X1,ERRGRUP SX0 X1-60*GRPDIM PL X0,ERRGRUP CALL SSETBIT,GROUP1 SET BIT IN GROUP TABLE EQ GR100 * * MERGE SPECIFIED GROUP WITH NEW GROUP * GR300 SB1 GRPDIM-1 INITIALIZE FOR END TEST SB2 X6 B2 = CM ADDRESS OF BIT TABLE * GR310 SA1 B1+B2 LOAD FROM SPECIFIED GROUP SA2 B1+GROUP1 LOAD FROM GROUP BUILDING BX6 X1+X2 SA6 A2 SB1 B1-1 END TEST PL B1,GR310 EQ GR100 * ERRGRUP SB1 85 ERROR IN GROUP NAME OR KEYCODE EQ =XERR * * MAKE ENTRY IN GROUP NAME DIRECTORY AND WRITE * COMPLETED GROUP BIT TABLE TO ECS * GR900 SA1 GINDX LOAD INDEX TO GROUP SA2 GNAME LOAD GROUP NAME BX6 X2 SA6 X1+GROUPS1 MAKE ENTRY IN GROUP NAME TABLE SA2 AGROUP BX0 X2 X0 = ADDRESS OF GROUP ECS AREA SA0 GROUPS1 + WE NKGROUP WRITE NAME TABLE BACK TO ECS RJ ECSPRTY SX2 NKGROUP IX0 X0+X2 BIAS PAST NAME TABLE SX2 GRPDIM DX1 X1*X2 COMPUTE BIAS TO GROUP IN ECS IX0 X0+X1 SA0 GROUP1 + WE GRPDIM WRITE BIT TABLE TO ECS RJ ECSPRTY EQ NXTLINE EXIT * * * /--- BLOCK PAUSE 00 000 81/01/07 19.36 TITLE -PAUSE- COMMAND READIN * * * * -PAUSE- COMMAND * PAUSE FOR SPECIFIED TIME OR FOR STUDENT KEYPRESS * * THE -PAUSE- COMMAND MAY TAKE THE FOLLOWING FORMS - * PAUSE * PAUSE KEYS=LIST * PAUSE N * PAUSE N,KEYS=LIST * * PAUSEIN MX6 0 SA6 PTYPE INITIALIZE PAUSE TYPE SA6 PCODE INITIALIZE GETVAR CODE SA6 PINX INITIALIZE XSTOR INDEX *** SX6 =XPAUSE= SA6 COMNUM *** SA1 WORDPT BX6 X1 SAVE POINTER TO FIRST CHARACTER SA6 OLDPT SA1 X1 CHECK IF NO TAG ZR X1,PAUS900 * * DETERMINE IF FIRST ENTRY IS TIME TO PAUSE OR * BEGINNING OF KEY LIST * CALL NXTNAME GET FIRST ITEM OF TAG **** SX0 X1-1R= NZ X0,PAUS100 EXIT IF NOT *KEYS=* SA1 KKEYS BX1 X1-X6 NZ X1,PAUS100 EXIT IF NOT *KEYS=* SX6 1 SA6 PTYPE TYPE 1 = PAUSE KEYS=LIST EQ PAUS300 * * * EVALUATE TIME TO PAUSE EXPRESSION * PAUS100 SA1 OLDPT RESET *WORDPT* FOR COMPILE BX6 X1 SA6 WORDPT CALL COMPILE EVALUATE TIME EXPRESSION BX6 X1 SA6 PCODE SAVE -GETVAR- CODE SA1 LASTKEY LOAD TERMINATING CHARACTER NZ X1,PAUS200 NEXT ENTRY MUST BE *KEYS=* SX6 2 SA6 PTYPE TYPE 2 = PAUSE N EQ PAUS900 * * CHECK THAT KEY LIST BEGINS WITH *KEYS=* * PAUS200 CALL NXTNAME GET NEXT TAG ENTRY **** SX0 X1-1R= NZ X0,ERRTERM SA1 KKEYS MUST BE *KEYS=* BX1 X1-X6 NZ X1,ERRNAME SX6 3 TYPE 3 = PAUSE N,KEYS=LIST SA6 PTYPE * * /--- BLOCK PAUSE 00 000 78/08/02 15.16 * * INITIALIZE FOR MAIN LOOP * PAUS300 CALL LOADG LOAD GROUP NAME DIRECTORY SB1 GRPDIM-1 MX6 0 * PAUS310 SA6 B1+GROUP1 INITIALIZE PAUSE BIT TABLE SB1 B1-1 PL B1,PAUS310 SA1 PTYPE SX2 X1-3 CHECK IF PAUSE WITH TIMING NZ X2,PAUS500 SX1 TIMEUP SET BIT FOR -TIMEUP- KEY CALL SSETBIT,GROUP1 * * * BUILD PAUSE BIT TABLE * PAUS500 CALL NXT GET NEXT ENTRY SB1 X1 JP B1+*+1 * + EQ PAUS800 END-OF-LINE + EQ PAUS520 KEY VALUE + EQ PAUS540 GROUP + EQ ERRGRUP SPECIFIC TOUCH + EQ ERRGRUP SPECIFIC EXT + EQ ERRGRUP EXPRESSION * * * SET BIT IN PAUSE BIT TABLE FOR SPECIFIED KEY * PAUS520 SX1 X6 X1 = KEY VALUE NG X1,ERRGRUP CHECK IF LEGAL KEY CODE ZR X1,ERRGRUP SX0 X1-60*GRPDIM PL X0,ERRGRUP CALL SSETBIT,GROUP1 SET BIT IN GROUP TABLE EQ PAUS500 * * MERGE SPECIFIED GROUP WITH BIT TABLE * PAUS540 SB1 GRPDIM-1 INITIALIZE FOR END TEST SB2 X6 B2 = CM ADDRESS OF BIT TABLE * * SPECIAL FUSSING SO THAT PAUSE KEYS=ALL,TOUCH DOES ENABLE * TOUCH, WHILE PAUSE KEYS=ALL DOES NOT (BUT ACCEPTS TOUCH * AND EXTERNAL BY MEANS OF THE ALL BIT IF PREVIOUS ENABLE) * SA1 B1+B2 LAST ENTRY OF GROUP SX6 4 KEYS=ALL BIT BX6 X6*X1 ZR X6,PAUS546 JUMP IF NOT KEYS=ALL MX6 -2 BX1 X6*X1 MASK OUT TOUCH/EXT BITS EQ PAUS546 * PAUS545 SA1 B1+B2 LOAD FROM SPECIFIED GROUP PAUS546 SA2 B1+GROUP1 LOAD FROM PAUSE BIT TABLE BX6 X1+X2 SA6 A2 SB1 B1-1 END TEST PL B1,PAUS545 EQ PAUS500 * * /--- BLOCK PAUSE 00 000 76/01/12 13.48 * * COPY COMPLETED BIT TABLE TO EXTRA STORAGE * PAUS800 SA1 INX GET POINTER IN EXTRA STORAGE BX6 X1 SAVE POINTER SA6 PINX SX7 X1+GRPDIM ADVANCE POINTER SA2 ICX IX2 X7-X2 CHECK FOR OVERFLOW OF UNIT BUFF PL X2,LNGUNIT SA7 A1 SB1 GRPDIM-1 SA2 GROUP1-1 INITIALIZE FOR TRANSFER * PAUS810 SA2 A2+1 LOAD NEXT WORD OF BIT TABLE BX6 X2 SA6 X1+INFO MOVE TO EXTRA STORAGE SX1 X1+1 SB1 B1-1 END TEST PL B1,PAUS810 * * FORM -PAUSE- COMMAND WORD * PAUS900 SA1 PTYPE GET -PAUSE- TYPE CODE SX6 X1+2000B ADD EXPONENT FOR UNPACK LX6 60-12 SA2 PCODE ADD -GETVAR- CODE IF ANY LX2 60-24-XCODEL BX6 X2+X6 SA2 PINX ADD EXTRA STORAGE POINTER LX2 60-24 BX6 X2+X6 EQ PUTCODE * * * /--- BLOCK KEYTYPE 00 000 78/11/07 11.29 TITLE -KEYTYPE- COMMAND READIN * * * * -KEYTYPE- COMMAND * SEARCHES LIST OF KEY CODES, GROUPS OR TOUCH/EXT * * KEYTYIN CALL PUTCOMP EVALUATE RESULT VARIABLE LX1 60-XCODEL BX6 X1 SAVE -GETVAR- CODE SA6 PCODE CALL LOADG LOAD GROUP NAME TABLE MX6 0 SA6 KINDX INITIALIZE NUMBER OF ENTRIES * KEY100 CALL NXT GET NEXT KEY LIST ENTRY SB1 X1 JP B1+*+1 * + EQ KEY500 END-OF-LINE + EQ KEY120 KEY VALUE + EQ KEY140 GROUP + EQ KEY200 SPECIFIC TOUCH + EQ KEY300 SPECIFIC EXT + EQ KEY310 EXPRESSION + EQ KEY250 FINE-GRID TOUCH * * * STORE KEY VALUE * KEY120 SA1 KINDX LOAD CURRENT NUMBER OF ENTRIES SX7 X1+1 SX0 X7-101 CHECK FOR OVERFLOW PL X0,ERR2MNY SA7 A1 SA6 X1+SHOWOUT X6 = ENTRY TO STORE EQ KEY100 * * /--- BLOCK KEYTYPE 00 000 78/11/07 11.29 * * PROCESS -GROUP- TYPE ENTRY * KEY140 SA1 INX LOAD POINTER IN EXTRA STORAGE BX5 X1 X5 = POINTER TO BIT TABLE SX7 X1+GRPDIM ADVANCE POINTER SA2 ICX IX2 X7-X2 CHECK FOR OVERFLOW OF UNIT BUFF PL X2,LNGUNIT SA7 A1 SB1 GRPDIM-1 INITIALIZE FOR MOVE LOOP SA2 X6-1 KEY145 SA2 A2+1 LOAD NEXT WORD OF BIT TABLE BX6 X2 SA6 X1+INFO MOVE TO EXTRA STORAGE SX1 X1+1 SB1 B1-1 END TEST PL B1,KEY145 SX6 X5+44000B X6 = ENTRY FOR GROUP EQ KEY120 * * * PROCESS SPECIFIC TOUCH ENTRY * KEY200 CALL ARGSCAN EVALUATE ARGUMENTS CALL LOADG RE-LOAD GROUP NAME TABLE SA1 INX X1 = INDEX IN EXTRA STORAGE SX0 X1+2 SA2 ICX IX2 X0-X2 CHECK FOR OVERFLOW OF UNIT BUFF PL X2,LNGUNIT * CALL TCHVARS PACK TOUCH LOCATION INFO * ** 50000B = TOUCH (BIT 14 SET + NEXT 3 BITS (O2) + 0) * SX6 X1+50000B X6 = ENTRY FOR SPECIFIC EXT EQ KEY120 * * * PROCESS SPECIFIC FGT ENTRY * KEY250 CALL ARGSCAN EVALUATE ARGUMENTS CALL LOADG RE-LOAD GROUP NAME TABLE SA1 INX X1 = INDEX IN EXTRA STORAGE SX0 X1+2 SA2 ICX IX2 X0-X2 CHECK FOR OVERFLOW OF UNIT BUFF PL X2,LNGUNIT * CALL TCHVARS PACK TOUCH LOCATION INFO * ** 64000B = FGT (BIT 14 SET + NEXT 3 BITS (O5) + 0) * SX6 X1+64000B X6 = ENTRY FOR SPECIFIC EXT EQ KEY120 * * /--- BLOCK KEYTYPE 00 000 78/11/07 11.31 * * PROCESS SPECIFIC EXT OR EXPRESSION TYPE ENTRY * KEY300 SX6 54000B SET TYPE CODE = EXT SA6 FTYPE EQ KEY320 * KEY310 SX6 60000B SET TYPE CODE = EXPRESSION SA6 FTYPE * KEY320 CALL ARGSCAN EVALUATE ARGUMENTS CALL LOADG RE-LOAD GROUP NAME TABLE SA1 AINDX SX0 X1-1 CHECK NUMBER OF ARGUMENTS = 1 NZ X0,ERRTAGS SA1 INX LOAD INDEX IN EXTRA STORAGE SX7 X1+1 SA2 ICX IX2 X7-X2 CHECK FOR OVERFLOW OF UNIT BUFF PL X2,LNGUNIT SA7 A1 ADVANCE XSTOR INDEX SA2 ACODES LX2 60-XCODEL BX6 X2 PLANT -GETVAR- CODE SA6 X1+INFO SA2 FTYPE LOAD TYPE CODE IX6 X1+X2 X6 = EXT OR EXPRESSION ENTRY EQ KEY120 * * * PACK UP KEY LIST AND FORM COMMAND WORD * KEY500 SA1 KINDX NUMBER OF ENTRIES IN LIST ZR X1,ERR2FEW MX6 0 PLANT FOR END TEST SA6 X1+SHOWOUT SA2 INX X2 = CURRENT XSTOR POINTER BX5 X2 X5 = INITIAL XSTOR POINTER SA4 ICX X4 = UNIT BUFFER END TEST SA1 SHOWOUT-1 * KEY520 MX6 0 CLEAR WORD BUILDING SB1 60-15 INITIALIZE SHIFT COUNT * KEY530 SA1 A1+1 LOAD NEXT ENTRY IN LIST LX1 X1,B1 BX6 X1+X6 MERGE WITH REST OF WORD ZR X1,KEY540 END TEST SB1 B1-15 DECREMENT SHIFT COUNT PL B1,KEY530 SA6 X2+INFO STORE COMPLETED WORD SX2 X2+1 ADVANCE EXTRA STORAGE POINTER IX0 X2-X4 PL X0,LNGUNIT UNIT BUFFER SPACE CHECK EQ KEY520 * KEY540 SA6 X2+INFO STORE FINAL WORD SX7 X2+1 IX0 X7-X4 UNIT BUFFER SPACE CHECK PL X0,LNGUNIT SA7 INX UPDATE EXTRA STORAGE POINTER SA1 PCODE LOAD -GETVAR- CODE LX5 60-XCODEL-12 BX6 X1+X5 ATTACH POINTER TO TABLE EQ PUTCODE EXIT * * * /--- BLOCK KEYTYPE 00 000 78/11/07 11.21 TITLE -TCHVARS- * * -TCHVARS- * LOAD TOUCH -GETVAR- CODES INTO EXTRA STORAGE * (USED BY *TOUCH* AND *FGT* OPTIONS FOR -KEYTYPE-) * TCHVARS EQ * * * DETERMINE IF COARSE OR FINE GRID ENTRY * BY NUMBER OF ARGUMENTS. 1 OR 3 IS COARSE. * 2 OR 4 IS FINE. * MX6 0 PRE-SET = COARSE GRID SA4 AINDX X4 = NUMBER OF ARGUMENTS LX4 59 NG X4,PCKVARS ODD, MUST BE 1 OR 3 (COARSE) MX6 1 SET = FINE GRID * * PACK UP -GETVAR- CODES * PCKVARS SA2 ACODES LX2 60-XCODEL BX6 X2+X6 SA2 ACODES+1 LX2 60-2*XCODEL BX6 X2+X6 SA2 ACODES+2 LX2 60-3*XCODEL BX6 X2+X6 SA6 X1+INFO STORE FIRST 3 -GETVAR- CODES SX7 X1+1 PL X6,TCOURSE IF COURSE GRID, NO MORE VARS SA2 ACODES+3 LX2 60-XCODEL BX6 X2 SA6 X7+INFO STORE LAST -GETVAR- CODE SX7 X7+1 * TCOURSE SA7 INX UPDATE INDEX IN EXTRA STORAGE EQ TCHVARS * * /--- BLOCK ARGSCAN 00 000 78/12/13 01.52 TITLE -ARGSCAN- * * * * -ARGSCAN- * EVALUATE ARGUMENT(S) FOR SPECIFIC TOUCH AND EXT * ENTRIES. SEPARATORS MUST BE COMMAS * * RETURNS *AINDX* = NUMBER OF ARGUMENTS MUST BE * .LE. 4 * *ACODES* = -GETVAR- CODES FOR ARGUMENTS * * ARGSCAN EQ * * * SEARCH FOR BALANCED PARENS = END OF ARGUMENTS * MX0 0 X0 = NO SPECIAL TERMINATOR SA1 WORDPT X1 = POINTER TO FIRST CHARACTER CALL PSCAN FIND END OF ARGUMENT(S) NZ B2,ERRBAL ERROR IF UNBALANCED PARENS SA3 B1-1 SA3 X3+KEYTYPE CHECK ENDED WITH RIGHT PAREN SX3 X3-OP) NZ X3,ERRTERM SX6 1R REPLACE RIGHT PAREN WITH SPACE SA6 B1-1 SX6 A6 SAVE FOR END TEST SA6 ENDPNT SA1 WORDPT SX6 X1+1 ADVANCE PAST LEFT PAREN SA6 A1 MX6 0 SA6 AINDX INITIALIZE NUMBER OF ARGUMENTS SB1 4 * ARG20 SA6 B1+ACODES INITIALIZE -GETVAR- CODES SB1 B1-1 PL B1,ARG20 END TEST * * /--- BLOCK ARGSCAN 00 000 81/01/07 18.42 * * EVALUATE ARGUMENTS * ARG100 CALL COMPILE EVALUATE NEXT ARGUMENT SA2 AINDX SX0 X2-4 CHECK IF TOO MANY ARGUMENTS PL X0,ERR2MNY BX6 X1 STORE CURRENT -GETVAR- CODE SA6 X2+ACODES SA1 LASTKEY CHECK SEPARATOR BX7 X1 STORE SEPARATOR SA7 X2+ASEPS SX6 X2+1 INCREMENT COUNTER SA6 A2 SA2 WORDPT SA3 ENDPNT IX2 X2-X3 NG X2,ARG100 GET NEXT ARG SX6 X6-1 ZR X6,ARGSCAN 1 ARG, NO SEP. * COMMAS SX6 X6-1 NG X6,ARGSCAN SA1 X6+ASEPS SX1 X1-1R, ZR X1,COMMAS COMMA EQ ERRTERM * * * AINDX EQU VARBUF ENDPNT EQU AINDX+1 ACODES EQU ENDPNT+1 ASEPS EQU ACODES+5 * * * /--- BLOCK LOADG 00 000 76/06/07 15.08 TITLE -LOADG- LOAD GROUP NAME TABLE * * * * -LOADG- * READ DIRECTORY TO AUTHOR DEFINED GROUPS FROM ECS * * LOADG EQ * SA1 AGROUP ADDRESS OF GROUP ECS BX0 X1 SA0 GROUPS1 + RE NKGROUP READ DIRECTORY RJ ECSPRTY MX7 0 CLEAR LAST WORD FOR END TEST SA7 GEND1 EQ LOADG * * * /--- BLOCK NXT 00 000 78/11/04 11.00 TITLE -NXT- OBTAIN NEXT KEY/GROUP ENTRY * * * * -NXT- * OBTAINS NEXT KEY LIST ENTRY FOR GROUP, PAUSE AND * KEYTYPE COMMANDS. * * RETURNS X1 = 0 IF END-OF-LINE * 1 IF KEY VALUE * 2 IF KEY GROUP * 3 IF SPECIFIC TOUCH * 4 IF SPECIFIC EXT * 5 IF EXPRESSION * 6 IF FINE-GRID TOUCH * * X6 = KEY VALUE OR ADDRESS OF GROUP TABLE * * NXT EQ * NXT1 SA1 WORDPT X1 = POINTER TO NEXT CHARACTER SA2 X1 X2 = CURRENT CHARACTER ZR X2,NXT20 EXIT IF END-OF-LINE * * CHECK FOR SIMPLE KEY OR SHIFTED KEY * BX5 X2 X5 = NAME BUILDING BX6 X2 X6 = KEY CODE SB1 60-6 B1 = SHIFT COUNT SX0 X2-KUP CHECK IF SHIFTED CHARACTER NZ X0,NXT10 SX1 X1+1 ADVANCE CHARACTER POINTER SA2 X1 ZR X2,NXT20 EXIT IF END-OF-LINE SB1 B1-6 ADJUST SHIFT COUNT LX5 6 BX5 X2+X5 MERGE WITH SHIFT CODE SX6 X2+100B CONVERT TO SHIFTED CHARACTER * * /--- BLOCK NXT 00 000 76/01/15 19.48 * NXT10 SX1 X1+1 ADVANCE CHARACTER POINTER SA2 X1 ZR X2,NXT15 EXIT IF END-OF-LINE SA3 X2+KEYTYPE SX0 X3-OPCOMMA CHECK FOR END OF ENTRY NZ X0,NXT100 JUMP IF KEY NAME OR GROUP NAME SX1 X1+1 ADVANCE CHARACTER POINTER * NXT15 SX7 X1 UPDATE *WORDPT* SA7 WORDPT SX1 1 1 = KEY CODE EQ NXT * NXT20 SA2 NEXTCOM CHECK IF CONTINUED COMMAND SA3 COMCONT BX3 X3-X2 NZ X3,NXT25 CALL GETLINE READ NEXT LINE OF SOURCE EQ NXT1 * NXT25 MX1 0 0 = END-OF-LINE EQ NXT * * CHECK FOR EXPRESSION * NXT100 MX3 -6 BX3 X3*X5 CHECK IF MORE THAN ONE CHAR NZ X3,NXT108 SA3 X5+KEYTYPE CHECK TYPE OF FIRST CHARACTER SX0 X3-OP( NZ X0,NXT108 SX1 5 5 = EXPRESSION EQ NXT * * /--- BLOCK NXT 00 000 76/07/25 07.43 * * BUILD FUNCTION KEY NAME OR GROUP NAME * NXT105 LX5 6 MERGE NEXT CHARACTER OF NAME BX5 X2+X5 SB1 B1-6 ADJUST SHIFT COUNT ZR B1,ERRNAME SX1 X1+1 ADVANCE CHARACTER POINTER SA2 X1 ZR X2,NXT112 JUMP IF END-OF-LINE * NXT108 SA3 X2+KEYTYPE SX0 X3-OPCOMMA CHECK FOR COMMA ZR X0,NXT110 SX0 X3-OP( CHECK FOR LEFT PAREN ZR X0,NXT200 EQ NXT105 MERGE THIS CHARACTER * NXT110 SX1 X1+1 ADVANCE CHARACTER POINTER NXT112 SX7 X1 SA7 WORDPT LX5 X5,B1 LEFT JUSTIFY KEY OR GROUP NAME MX0 -18 X0 = MASK BX1 -X0*X5 CHECK FOR LEGAL NAME NZ X1,ERRNAME * * CHECK IF USER DEFINED GROUP * MX7 0 SA7 NKLEND PLANT FOR END TEST SA7 GEND SA7 GEND1 SA1 GROUPS1-1 INITIALIZE FOR SEARCH SB1 NKGROUP-GRPDIM * NXT120 SA1 A1+1 LOAD NEXT GROUP NAME ZR X1,NXT130 SB1 B1+GRPDIM ADVANCE BIAS IN GROUP TABLES BX2 X0*X1 BX2 X2-X5 CHECK IF NAMES MATCH NZ X2,NXT120 SA1 AGROUP SX2 B1 BIAS TO SPECIFIED GROUP IX0 X1+X2 SA0 GROUP CM ADDRESS FOR GROUP + RE GRPDIM READ GROUP TABLE TO CM RJ ECSPRTY SX1 2 2 = GROUP SX6 A0 X6 = CM ADDRESS OF GROUP TABLE EQ NXT * * /--- BLOCK NXT 00 000 78/11/07 10.02 * * CHECK FOR SYSTEM DEFINED KEY NAME * NXT130 SB1 NKLIST SA1 B1-1 INITIALIZE FOR SEARCH MX0 -18 X0 = MASK * NXT135 SA1 A1+1 LOAD NEXT KEY NAME ZR X1,NXT140 BX2 X0*X1 BX2 X2-X5 CHECK IF NAMES MATCH NZ X2,NXT135 SX6 X1 X6 = KEY VALUE SX1 1 1 = KEY CODE EQ NXT * * CHECK FOR SYSTEM DEFINED GROUP * NXT140 SA1 GROUPS-1 INITIALIZE FOR SEARCH * NXT145 SA1 A1+1 LOAD NEXT GROUP NAME ZR X1,ERRNAME ERROR IF UNRECOGNIZED NAME BX2 X0*X1 BX2 X2-X5 CHECK IF NAMES MATCH NZ X2,NXT145 SX6 X1 X6 = CM ADDRESS OF GROUP TABLE SX1 2 2 = GROUP EQ NXT * * IDENTIFY SPECIFIC TOUCH, EXT, OR FGT ENTRY * NXT200 SX6 X1 UPDATE *WORDPT* SA6 WORDPT LX5 X5,B1 LEFT JUSTIFY KEY OR GROUP NAME SX1 3 TYPE = 3 = TOUCH SA2 KTOUCH BX2 X2-X5 CHECK IF *TOUCH* ZR X2,NXT SA2 KT CHECK IF *TOUCH* ABREVIATION BX2 X2-X5 ZR X2,NXT SX1 4 TYPE = 4 = EXT SA2 KEXT BX2 X2-X5 CHECK IF *EXT* ZR X2,NXT SX1 6 TYPE = 6 = FGT SA2 KFGT BX2 X2-X5 CHECK IF *FGT* ZR X2,NXT SA2 KF BX2 X2-X5 CHECK IF *FGT* ABBREVIATION ZR X2,NXT EQ ERRNAME * * TITLE STORAGE * * GNAME BSS 1 GINDX BSS 1 KINDX EQU GINDX FTYPE BSS 1 PTYPE BSS 1 PCODE BSS 1 PINX BSS 1 * KKEYS DATA 4LKEYS KTOUCH DATA 0LTOUCH KT DATA 0LT KEXT DATA 0LEXT KFGT DATA 0LFGT KF DATA 0LF * * ENDOV * * /--- BLOCK DIN/DOUT 00 000 75/06/04 10.13 TITLE -DIN- / -DOUT- COMMANDS * * * * -DIN- AND -DOUT- COMMANDS * 1ST ARGUMENT = DISK INFORMATION PACKAGE * 2ND = NUMBER BLOCKS (OPTIONAL) * * * DABSOV OVRLAY CALL SYSTEST CHECK FOR SYSTEM LESSON CALL COMPILE LX1 60-XCODEL POSITION -GETVAR- CODE BX6 X1 SA6 VARBUF SA1 LASTKEY CHECK ENDING CHARACTER ZR X1,DABS100 CALL COMPILE GET CODE FOR NUMBER OF BLOCKS LX1 60-XCODEL-XCODEL * DABS100 SA2 VARBUF LOAD FIRST -GETVAR- CODE BX6 X1+X2 EQ PUTCODE * * ENDOV * * * /--- BLOCK CONDFIN 00 000 77/08/15 21.11 TITLE CONDFIN * * -CONDFIN- * THIS ROUTINE SETS THE TERM AND DEFINE ENTRIES IN * THE ULOC TABLE, AND WRITES THE EXTERNAL, UNAM, AND ULOC TABLES * TO THE END OF THE LESSON BINARY. * IT ALSO SETS *CONDPRM* UP WITH THE CONDENSE PARAMETERS. * * * SEARCH FOR UNDEFINED UNITS * CFINOV OVRLAY * SX2 IEUNUM SWITCH UNALPHABETICIZED UNIT-NAME-TABLE SA0 UNAME+X2 INTO PLACE OF ALPHABETICIZED SA1 AUNAME GET ECS LOCATION IX0 X1+X2 START AT INITIAL ENTRY UNIT SA1 UNUMIN GET NUMBER OF UNITS IN LESSON IX3 X1-X2 GET NUMBER TO SWITCH SB1 X3 + RE B1 SWITCH RJ ECSPRTY * * SB4 IEUNUM PRE-START OF AUTHOR UNITS MX6 0 SA6 UNUMON SET FLAG FOR ERROR PLOTTING ROUTINE SA6 LOCAL TURN OFF LOCALS PROCESSING * EULOOP0 SA1 UNUMIN SB5 X1-1 B5 = NUMBER OF UNITS IN * EULOOP GE B4,B5,CNF1 JUMP IF DONE SB4 B4+1 SA1 ULOC+B4 LOAD ULOC ENTRY PL X1,EULOOP JUMP IF UNIT DEFINED LX1 1 NG X1,EULOOP JUMP IF EXTERNAL UNIT LX1 11 MX0 48 BX2 X0*X1 X2 = UNIT NAME MX0 36 SA1 KTUNIT CHECK FOR -TUNIT- BX1 X1-X2 BX1 X0*X1 NZ X1,CNFAA EXIT IF NOT 30/TUNIT,6/0 BX1 X2 AX1 12 POSITION -TUNIT- UNIT NUMBER SX1 X1 ZR X1,CNFAA -TUNIT- NUMBER MUST BE NON-ZERO NG X1,CNFAA SA2 X1+UNITTAB X2 = UNIT NAME * GET BLOCK AND LINE OF FIRST REFERENCE TO THIS UNIT CNFAA SA1 AFUREF SX6 B4 IX0 X6+X1 SA6 ITEMP SAVE B4 SA0 =XHEAD RE 1 RJ =XECSPRTY * SB1 904 UNIT CANNOT BE FOUND MX1 59 -1 SB2 X1 RJ =XRJERR2 X2 HAS UNIT NAME * SA1 ITEMP SB4 X1 RESTORE B4 EQ EULOOP0 * /--- BLOCK CONDFIN2 00 000 77/09/17 16.43 * CNF1 CALL MISAY CHECK FOR MISSING SAYLANG SA1 SYSFLG JUMP IF SYSTEM LESSON LX1 ZSLDSHF NG X1,TRM1 SA1 COMREFF SEE IF TEMP VARIABLE REF ZR X1,TRM1 SA1 CCOMLES SEE IF ANY -COMMON- NZ X1,TRM1 SA1 XSTORL SEE IF ANY -STORAGE- NZ X1,TRM1 SA1 CCOMX SEE IF ANY -COMMONX- NZ X1,TRM1 SB1 100 *WARNING* TEMPORARY VARIABLE REFERENCES SB2 -1 SX1 B0 SX2 B0 RJ =XRJERR2 EQ TRM1 * /--- BLOCK CONDFIN3 00 000 77/06/18 18.21 * * * READ TERM TABLE FROM ECS INTO INFO, AND ALPHABETIZE IT * TRM1 SA1 CONDPNT BUFFER POINTER BX7 X1 SAVE SA1 TERMS GET NUMBER OF TERMS BX6 X1 SA6 INFO FIRST WORD OF TERM TABLE IS NUMBER OF TERMS SB7 X1 NUMBER OF ENTRIES TO B7 FOR ECS READ SA2 TERMEND ENDING ECS ADDRESS OF TERMS SX0 X1-1 IX0 X2-X0 TERMS GO BACKWARDS INTO BUFFER SA0 INFO+1 + RE B7 READ TERM TABLE INTO CM - RJ ECSPRTY BX0 X7 RESET X0 SB1 INFO (B1) = ADDRESS OF TERM TABLE FOR CALL RJ TSORT ALPHABETIZE TERM TABLE * * WRITE OUT FAKE UNIT 0 WHICH IS TERM TABLE * SA2 INFO NUMBER OF TABLE ENTRIES TO X2 SA0 A2 ADDRESS OF TERM TABLE FOR ECS SX2 X2+1 LENGTH OF FAKE UNIT TO X2 SA1 CONBUFF ADDRESS OF CONDENSE BUFFER IX6 X0-X1 BIAS TO TERM UNIT LX6 ULOC2 BX6 X6+X2 UNIT LENGTH LX6 ULOC3+ULOC4 BX6 X6+X2 AND THIS TOTAL LENGTH ALSO LX6 60-ULOC1-ULOC2-ULOC3-ULOC4 SA6 ULOC STORE ENTRY AT UNIT ZERO OF UNIT LOC TABLE CALL WRITECS WRITE OUT FAKE UNIT * SA1 KOTERM PUT PROPER NAME OF TERM IN UNIT-NAME TABLE BX6 X1 SA6 UNAME TERM IS FIRST UNIT IN TABLE * * /--- BLOCK -CONDFIN 00 000 81/06/29 12.27 * * WRITE OUT PPT-TUTOR UNIT TABLE = UNIT 3 * 1ST WORD OF UNIT = * 1ST 6 BITS = UNUSED * NEXT 9 = MAXIMUM NUMBER OF CHARACTERS * NEXT 9 = 1ST PHYSICAL UNIT NUMBER * NEXT 18 = DIMENSION OF VARIABLE AREA * NEXT 18 = NUMBER UNITS * BX7 X0 SAVE X0 SA1 PUNITN GET NUMBER OF PPT UNITS ZR X1,PPTFN1 SX1 X1+2 X1 = NUMBER OF TUNITS SA2 NVBYTES GET NUMBER OF DEFINED BYTES LX2 18 BX6 X1+X2 SA2 PISTU GET 1ST PHYSICAL TUNIT NUMBER LX2 18+18 BX6 X2+X6 SA2 PCHRLIM GET CHARSET LIMIT LX2 9+18+18 BX6 X2+X6 SA6 INFO SET 1ST WORD OF UNIT * SA2 ATEMPEC BX0 X2 ADDRESS OF TEMP ECS BUFFER SB1 X1 SA0 UNITTAB + WE B1 WRITE UNIT TABLE TO ECS RJ ECSPRTY SA0 INFO+1 + RE B1 READ TABLE BACK TO *INFO* RJ ECSPRTY EQ PPTFN2 * PPTFN1 MX6 0 CLEAR 1ST WORD OF UNIT SA6 INFO * PPTFN2 SX5 X1+1 X5 = LENGTH OF UNIT SA1 CONBUFF IX6 X7-X1 GET RELATIVE ADDRESS OF UNIT LX6 60-ULOC1 X6 = ULOC ENTRY FORMING BX0 X7 X0 = ECS ADDRESS OF UNIT SA0 INFO A0 = CM ADDRESS OF UNIT BX2 X5 X2 = LENGTH OF UNIT BX3 X5 FORM CM LENGTH FIELD LX3 60-ULOC1-ULOC2 BX6 X3+X6 BX3 X5 FORM UNIT LENGTH FIELD LX3 60-ULOC1-ULOC2-ULOC3-ULOC4 BX6 X3+X6 SA6 ULOC+3 SET ULOC TABLE ENTRY CALL WRITECS WRITE FAKE UNIT TO BINARY * * /--- BLOCK -CONDFIN 00 000 81/06/29 12.30 * * WRITE MICRO-TUTOR RELEASE LEVEL AND CENTRAL SYSTEM * EXECUTION FLAG TO LESSON HEADER * BX7 X0 SAVE -X0- SA7 SVX0 MX0 -6 SA1 MTREL GET MICRO-TUTOR RELEASE LEVEL BX6 -X0*X1 LX6 60-6 POSITION RELEASE LEVEL SA1 MTCENF ZR X1,MTCF20 CHECK IF CENTRAL EXEC FLAG SET SX1 1 LX1 60-7 POSITION FLAG FOR *LMTUTWD* * MTCF20 BX6 X1+X6 MERGE CENTRAL EXECUTION FLAG SA6 ITEMP SA1 CONBUFF GET FWA OF BINARY BUFFER SX0 LMTUTWD BIAS TO MICRO-TUTOR WORD IX0 X0+X1 SA0 A6 + WE 1 WRITE OUT MICRO-TUTOR WORD RJ ECSPRTY * * /--- BLOCK DEFINES 00 000 81/01/07 18.46 * * WRITE OUT FAKE UNIT 1 WHICH IS DEFINE TABLE * RJ =XSETSET SET UP PARAMETERS FOR DSET SA1 KCSTUD BX6 X1 SEE IF SET -STUDENT- EXISTS CALL FINDSET NG B1,NODEFN JUMP IF NO SET -STUDENT- RJ =XGETSET SA1 NDEFN SA2 TOKWRD IX1 X1+X2 COMPUTE TOTAL LENGTH OF DEFINES SX1 X1-UNITLTH+2 CHECK IF DEFINE SET TOO BIG PL X1,DEFBIG * DEF2 SA2 ATEMPEC ADDRESS OF TEMPORARY ECS SA1 AVAR ADDRESS OF DEFINED NAMES SA3 NDEFN NUMBER OF DEFINED NAMES SA0 VARS LOC OF BUFFER FOR MOVE SB1 VARLONG LENGTH OF BUFFER FOR MOVE IX6 X2+X3 DESTINATION OF NEXT MVECS SA6 DESTAVE RJ =XMVECS MOVE NAMES INTO BUFFER * SA1 ATOKEN SOURCE ECS ADDRESS SA2 DESTAVE DESTINATION ECS ADDRESS SA3 TOKWRD LENGTH OF MOVE SA0 VARS LOC OF BUFFER FOR MOVE SB1 VARLONG LENGTH OF BUFFER FOR MOVE RJ =XMVECS MOVE TOKENS INTO BUFFER SA1 TOKWRD SB1 X1 SA2 NDEFN SB1 B1+X2 LENGTH OF STUDENT DEFINE SET SA3 ATEMPEC BX0 X3 SA0 INFO+1 LEAVE ROOM FOR HEADER WORD + RE B1 READ IN ENTIRE SET RJ ECSPRTY SB4 B1+1 LENGTH OF SET+HEADER=UNITLEN SB1 X2 NDEFN SB2 X1 TOKWRD * /--- BLOCK DEFINES 00 000 81/01/07 18.45 * DEFXX SA2 SVX0 BX0 X2 RESTORE -X0- SA2 CONBUFF ADDRESS OF CONDENSE BUFFER IX6 X0-X2 BIAS TO DEFINE UNIT LX6 ULOC2 SX2 B4 COMPUTE LENGTH OF DEFINE UNIT BX6 X6+X2 LX6 ULOC3+ULOC4 POSITION ULOC ENTRY BX6 X6+X2 AGAIN FOR TOTAL LENGTH LX6 60-ULOC1-ULOC2-ULOC3-ULOC4 SA6 ULOC+1 AND ADD TO ULOC TABLE SA1 KODEF GET PROPER NAME FOR THIS FAKE UNIT BX7 X1 SA7 UNAME+1 DEFINE IS ALWAYS SECOND UNIT IN TABLES SX7 B2 FORM HEADER WORD LX7 18 SX1 B1 NUMBER OF DEFINES BX7 X7+X1 ADD NUMBER OF TOKEN WORDS SA1 NDEFU NUMBER OF UNITS (DIMENSIONS) LX1 18+18 BX7 X1+X7 MERGE WITH REST OF HEADER WORD SA7 INFO STORE HEADER WORD SA0 A7 CALL WRITECS WRITE OUT UNIT BX7 X0 PRESERVE X0 SA1 CONBUFF SX2 LDEFNWD BIAS TO DEFINE INFO WORD IX0 X1+X2 SA0 INFO + WE 1 WRITE DEFINE INFO WD TO HEADER RJ ECSPRTY BX0 X7 RESTORE X0 EQ COMWRT DESTAVE BSS 1 * DEFBIG SB1 101 STUDENT DEFINE SET TOO BIG SB2 -1 SX1 B0 SX2 B0 RJ =XRJERR2 EQ NODEFN * NODEFN SB1 B0 CLEAR NAME COUNT SB2 B1 CLEAR TOKEN WORD COUNT SB4 1 ONE WORD FOR HEADER MX6 0 SA6 NDEFU CLEAR DEFINED NAMES COUNT EQ DEFXX WRITE OUT EMPTY UNIT * SVX0 BSS 1 * /--- BLOCK CONDFIN5 00 000 81/07/28 01.39 * * WRITE LESSON TABLES * COMWRT SA0 UNAME SA2 UNUMIN LENGTH OF UNIT TABLE TO X2 CALL WRITECS WRITE UNIT NAME TABLE SA0 ULOC CALL WRITECS WRITE UNIT LOC TABLE SA3 CONBUFF ADDRESS OF CONDENSE BUFFER IX7 X0-X3 LENGTH OF LESSON SA7 CONDPNT STORE FOR ERRORS PAGE IX6 X7-X2 BIAS TO ULOC TABLE LX6 12 BX6 X6+X2 LENGTH OF ULOC TABLE LX6 12 SA6 CONDPRM PUT INTO *CONDPRM* FOR RETURN SX2 CBWARN CHECK FOR BIN SIZE WARNING IX1 X2-X7 PL X1,CONDF2 JUMP IF NOT NEAR MAX LIMIT SB1 102 *WARNING* BINARY ALMOST TOO LONG SB2 -1 SX1 B0 SX2 B0 RJ =XRJERR2 * * -ERRFIN- (GENERATE MAIN HEADER FOR ERROR BUFFER) * * 1ST WORD IS NUMBER OF ERRORS SAVED IN CEBUF * 2ND WORD IS ACCOUNT NAME * 3RD WORD IS LESSON NAME * 4TH WORD IS 20/TOTAL NUMBER OF ERRORS * 20/NUMBER OF UNITS * 20/LESSON LENGTH * CONDF2 RJ =XEBH BUILD ERROR BUFFER HEADER * /--- BLOCK CONSTAT 00 000 81/02/24 16.45 * * FINISH UP COMMAND AND LESSON CONDENSING STATISTICS * SA1 TSCOMFG PL X1,STATCFN STATISTICS ON = -1 CALL PSTCMS1 TAKE COMMAND STATS STATCFN SB1 1 SA3 ACLSTAT ECS ADDR OF LESSON STAT BANK BX0 X3 SA0 VARBUF TEMPORARY BUFFER + RE SCLESL LENGTH OF STATISTICS BANK RJ =XECSPRTY * SX2 B1 SA1 A0+SCUNITS IX6 X1+X2 ADD 1 TO NUMBER OF UNITS CONDENSED SA2 CUNITS AND GET UNITS CONDENSED THIS LESSON IX6 X6+X2 SA6 A1 * SA1 A0+SCLINES SA2 =XCLINES IX6 X1+X2 ADD TO TOTAL LINES CONDENSED SA6 A1 SX6 B0 SA6 A2 CLEAR CLINES * SA1 A0+SCNFIO SA2 =XNFIOR ADD TO TOTAL FIO REQUESTS IX6 X1+X2 BX7 X7-X7 SA6 A1 SA7 A2 CLEAR FIO REQUESTS * SA1 A0+SCNBRQ ADD TO TOTAL BINARY BUF INCR SA2 =XWECSC IX6 X1+X2 BX7 X7-X7 SA6 A1 SA7 A2 CLEAR REQUEST COUNT SA1 A0+SCDSKS UPDATE DISK STATISTICS SA2 =XNFIOR+1 COUNT I/O REQUESTS IX6 X1+X2 SA6 A1 SA7 A2 SA1 A1+1 COUNT BLOCKS READ SA2 A2+1 IX6 X1+X2 SA6 A1 SA7 A2 * CALL S=CTIME,TWD GET CPU CLOCK SB1 1 (B1) = 1 SA1 SYSCLOK SA2 RTBEG SA3 A0+SRMILS IX2 X1-X2 (X2) = REAL TIME FOR CONDENSE IX6 X2+X3 SA6 A3 SA1 TWD SA3 CTBEG SA4 A0+SCMILS IX3 X1-X3 (X3) = CPU TIME FOR CONDENSE IX6 X3+X4 SA6 A4 * /--- BLOCK CONSTAT 00 000 81/02/24 16.46 * PUSH DOWN STACK OF LAST 5 CONDENSE CPU TIMES * SAVE RUNNING RATIO FOR STATS LX3 30 IX3 X3+X2 SB2 5-2 BX6 X3 (X6) = CPU RATIO STATFN0 SA1 CTIME+B2 IX6 X1+X6 BX7 X1 SA7 CTIME+1+B2 SB2 B2-B1 GE B2,STATFN0 IF MORE TO MOVE BX7 X3 SA7 CTIME PUT NEW ENTRY ON TOP OF STACK SA1 CONDN SAVE THIS CONDENSORS RATIO SB2 X1+SCPUA SA6 A0+B2 SA1 A0+CLESMAX IX1 X1-X2 PL X1,STATFN1 BX6 X2 SA6 A1 REPLACE WITH NEW MAX TIME SA1 LESSON GET LESSON NAME BX6 X1 SA6 A0+CMAXNAM THIS LESSSON TOOK MAX CONDENSE TIME * * STATFN1 SA1 A0+CLESMIN ZR X1,STATFN2 IX1 X2-X1 PL X1,STATFN3 STATFN2 BX6 X2 SA6 A1 REPLACE WITH NEW MIN TIME * STATFN3 SA2 USEBCNT ZR X2,STATFN9 EXIT IF NO -USE- COMMAND * SA1 A0+SCUSES SA3 USEINFO IX6 X1+X3 COUNT NUMBER OF FILES USE-D SA6 A1 * SA1 A0+SCUBLKS IX6 X1+X2 X2 HOLDS USEBCNT SA6 A1 * SA1 A0+SCUNFIO USE FILE FIO REQUESTS SA2 =XNFIOR+3 IX6 X1+X2 ADD USE FILE FIO REQUESTS BX7 X7-X7 SA6 A1 SA7 A2 CLEAR USE FILE FIO REQUESTS * * STATFN9 WE SCLESL EQ =XECSPRTY * * /--- BLOCK (N)CONDFIN 00 000 81/01/16 13.37 * * RETURN CONDENSE INFO TO PLATO * SA5 APLACOM (X5) = PLATO COMMUNICATION AREA SX0 PC.INFO IX0 X0+X5 SA0 CONDPRM RETURN CONDENSE INFO + WE 1 RJ ECSPRTY * SX0 PC.INF1 IX0 X0+X5 SA0 =XERRTOT WRITE OUT NUMBER CONDENSE ERRS + WE 1 RJ ECSPRTY * SX0 PC.INF2 IX0 X0+X5 SA0 =XZCONDOK WRITE OUT ZCONDOK FLAG + WE 1 RJ ECSPRTY * SX0 PC.COM IX0 X0+X5 SA0 CCOMACT RETURN COMMON INFO + WE 5 RJ ECSPRTY * COMBINE NUMBER OF STORAGE VARIABLES AND NUMBER * OF ROUTER VARIABLES. SAVE FOR MERGING WITH * THE ROUTER LESSON AND NC VARIABLES FLAGS. SA2 RVARL NUMBER OF ROUTER VARIABLES SA1 XSTORL NUMBER OF STORAGE VARIABLES LX2 RVARSH POSITION ROUTER VAR BANK SIZE BX0 X1+X2 SA1 LVARL SIZE OF LOCALS STACK PL X1,LVARL1 IF LVARL IS SPECIFIED * MX1 0 MAKE SURE NO NEGATIVE VALUES LVARL1 LX1 LVARSH POSITION LOCAL VAR STACK SIZE BX0 X0+X1 10LVARL/18RVARL/18XSTORL * /--- BLOCK CONDFIN 00 000 81/01/07 18.47 * GET AND POSITION ROUTER LESSON, -CCODE- COMMAND, * AND NC VARIABLES FLAG FOR THE LESSON HEADER. SA1 ROUTER ROUTER LESSON FLAG LX1 RVARF SA3 CCDFLG -CCODE- COMMAND SA4 COMREFF NC VARIABLES LX3 CCODEF SX7 PC.FLAG ZR X4,M200 IF NO NC VARIABLES MX4 1 LX4 NCVARF-59 M200 BX6 X1+X3 BX6 X4+X6 BX6 X0+X6 MERGE ROUTER / STORAGE VARS LTH * WRITE THE FLAGS, ROUTER VARIABLE LENGTH, * STORAGE VARIABLE LENGTH AND LOCALS STACK SIZE. IX0 X7+X5 WX6 X0 SX0 PC.DIR RETURN ADDRESS OF DIRECTORY SA0 AFILEBF IX0 X0+X5 WE 1 RJ ECSPRTY SX0 PC.ERR RETURN ADDRESS OF ERROR BUFFER SA0 ACEBUF IX0 X0+X5 WE 1 RJ ECSPRTY SX0 PC.USE SA0 USEINFO WRITE USE FILE INFORMATION IX0 X0+X5 WE USEINFL RJ ECSPRTY SX6 P.DONE SET PLATO REQUEST CODE SA6 PLREQC EQ CONDENS EXIT * * /--- BLOCK TSORT 00 000 81/01/07 18.48 * * * -TSORT- * ROUTINE TO SORT TERM TABLE AT END OF LESSON READIN. * * DOES BUBBLE SORT TO PUT TERM TABLE IN ORDER OF ASCENDING * NUMERICAL VALUE. * * AT ENTRY, * (B1) = ADDRESS OF TERM TABLE * * TERM TABLE IS ARRANGED SUCH THAT-- * 1) FIRST ENTRY IS NUMBER OF TERMS * 2) ALL FOLLOWING ENTRIES ARE TERMS * TERMS ARE 8 CHARS, RIGHT JUSTIFIED. * THE UPPER 12 BITS ARE THE UNIT NUMBER * THAT THE TERM IS TO BRANCH TO. * * IN CASE OF DOUBLE TERMS, BRANCHING IS UNPREDICTABLE. * * * THIS ROUTINE PRESERVES X0 * * * TSORT EQ * SA1 B1 LOAD NUMBER OF TERMS ZR X1,TSORT EXIT NO TERMS SB2 B1+1 ADDRESS OF FIRST ENTRY TO B2 SB1 1 UIC TO B1 SB7 X1-1 OFFSET OF LAST ENTRY TO B7 ZR B7,TSORT EXIT ONE TERM MX7 12 MASK OFF UNIT POINTER SB6 B1 SET MODIFY FLAG NON-ZERO * LOOP ZR B6,TSORT DONE IF NO MODIFICATION ON LAST PASS SB3 B0 SB6 B0 RESET FLAG FOR NEXT PASS * PASS EQ B3,B7,LOOP IF END OF PASS, GO START NEXT ONE SA1 B2+B3 LOAD TERM1 SB3 B3+B1 SA2 B2+B3 LOAD TERM2 BX3 -X7*X1 BX4 -X7*X2 IX5 X4-X3 PL X5,PASS IF TERMS IN INCREASING ORDER, GO ON TO NEXT * SB6 B6+B1 SET FLAG THAT MODIFICATION DONE THIS PASS BX6 X2 SA6 A1 SWITCH TERMS TO CORRECT ORDER BX6 X1 SA6 A2 EQ PASS GO DO NEXT SET * KCSTUD DATA 7LSTUDENT KCZER DATA 0 KOTERM VFD 12/0,48/4LTERM KODEF VFD 12/0,48/6LDEFINE KTUNIT DATA 0LTUNIT KBLANK DATA 10L BLANKS DATA 0 * ENDOV * /--- BLOCK JMPFOV 00 000 81/01/28 03.57 TITLE -JUMPOUT-, -FROM-, -ARGS- COMMANDS * JMPFOV OVRLAY SA1 OVARG1 SB3 X1 JP B3+* * + EQ JMPO 1 = -JUMPOUT- + EQ FRM 2 = -FROM- + EQ ARGS 3 = -ARGS- + EQ FILED 4 = -FILEDIT- * -FILEDIT- COMMAND IS CONDENSED AS -JUMPOUT- EXCEPT * THAT THE BLANK-TAG FORM IS NOT ALLOWED. FILED SA1 TAGCNT CHECK FOR BLANK TAG NZ X1,JMP1 TREAT AS -JUMPOUT- IF > 0 TAGS EQ =XERR2FEW CONDENSE ERROR IF BLANK TAG **** * * -JUMPOUT- COMMAND * JUMP TO SPECIFIED UNIT OF ANOTHER LESSON * JMPO SA1 TAGCNT CHECK FOR BLANK TAG ZR X1,JOUT0 JMP1 SX6 -1 FLAG -JUMPOUT- COMMAND EQ JMPI **** * * -FROM- COMMAND * DETERMINE WHICH LESSON LAST -JUMPOUT- WAS FROM * FRM SA1 TAGCNT CHECK FOR BLANK TAG ZR X1,ERR2FEW MX6 0 FLAG -FROM- COMMAND * * JMPI SA6 JOTYPE REMEMBER COMMAND TYPE SA1 NEXTCOM SA2 COMCONT CHECK FOR CONTINUED COMMAND BX2 X1-X2 ZR X2,JO100 MUST BE CONDITIONAL * SA1 WORDPT X1 = POINTER TO FIRST CHARACTER MX0 0 NO SPECIAL TERMINATORS CALL PSCAN FIND END OF FIRST TAG NZ B2,ERRBAL ERROR IF UNBALANCED PARENS NZ B3,ERRBAL ERROR IF UNBALANCED QUOTES * SX0 X1-1R; CHECK FOR CONDITIONAL COMMAND NZ X0,JOUT1 JUMP IF SURE NOT SA1 B1-1 DISCRIMINATE ; AND '; SX0 X1-KUP ZR X0,JOUT1 * * * /--- BLOCK JO100 00 000 81/01/12 17.56 * * CONDITIONAL -JUMPOUT- / -FROM- * JO100 MX6 0 INITIALIZE NUMBER OF ENTRIES SA6 NJNAM AND FLAG TO EXTRACT LITERALS * * EVALUATE FIRST ARGUMENT -- CONDITION / RETURN * SA1 JOTYPE NZ X1,JO102 JUMP IF NOT -FROM- COMMAND CALL PUTCOMP COMPILE CODE TO STORE INTO VAR EQ JO103 * JO102 CALL COMPILE EVALUATE EXPRESSION JO103 MX6 1 LX1 60-XCODEL POSITION -GETVAR- CODE BX6 X1+X6 SET SIGN BIT FOR CONDITIONAL SA6 JGCODE PARTIAL COMMAND WORD * * LOOP THROUGH EACH SET OF [ACCOUNT';]LESSON[,UNIT][(ARGS)] * JO200 SA1 WORDPT SA2 X1 ZR X2,JO300 CHECK IF AT EOL * CALL JOPARSE EVALUATE NEXT SET OF TAGS * * X1 = LAST TERMINATOR * JO250 SA2 NJNAM NUMBER OF ENTRIES SX0 X2-200 PL X0,ERR2MNY -- EXIT IF OVERFLOW SX7 X2+1 SA7 A2 LX2 1 X2 = OFFSET IN TABLE * SA3 JACCNAM FIRST WORD = ACCOUNT+LESSON SA4 JLESNAM LX3 XCODEL BX6 X3+X4 SA6 X2+JMPBUFF * SA3 JUNIT SECOND WORD = UNIT + ARGS SA4 JPARGFL MX0 6 CHECK FOR LITERAL UNIT NAME BX0 X0*X3 NZ X0,JO275 LX3 XCODEL SHIFT OVER IF NOT LITERAL * /--- BLOCK JO275 00 000 81/01/20 01.19 * * COME HERE WITH X1 = *LASTKEY* * JO275 BX6 X3+X4 SA6 X2+JMPBUFF+1 NZ X1,JO200 JUMP IF NOT END-OF-LINE * JO300 SA1 NEXTCOM CHECK FOR CONTINUED COMMAND SA2 COMCONT BX2 X1-X2 NZ X2,JO400 EXIT IF NOT CONTINUED CALL GETLINE READ-IN NEXT LINE EQ JO200 * JO400 SA1 NJNAM NUMBER OF ENTRIES LX1 1 SB1 X1 LENGTH OF LESSON/UNIT TABLE SA1 ATEMPEC BX0 X1 ADDRESS OF TEMP ECS BUFFER SA0 JMPBUFF + WE B1 MOVE TO TEMP ECS BUFFER RJ ECSPRTY SA4 INX EXTRA STORAGE POINTER SX7 X4+B1 UPDATE POINTER SA7 A4 SA0 X4+INFO + RE B1 MOVE TABLE TO *INFO* RJ ECSPRTY SA1 JGCODE LOAD -GETVAR- CODE LX4 60-XCODEL-12 BX6 X1+X4 MERGE CODE AND ADDRESS OF TABLE SA2 NJNAM SA3 JOTYPE ZR X3,JO410 CHECK FOR -FROM- COMMAND SX0 X2-2 MUST BE AT LEAST 2 ENTRIES NG X0,ERR2FEW * JO410 LX2 60-XCODEL-24 BX6 X2+X6 ATTACH NUMBER OF ENTRIES EQ PUTCODE * * /--- BLOCK JOUT0 00 000 81/01/20 02.56 * * BLANK-TAG -JUMPOUT- * JOUT0 MX6 0 EQ PUTCODE * * * UNCONDITIONAL -JUMPOUT- * JOUT1 SA1 JOTYPE CHECK FOR -FROM- COMMAND ZR X1,FOLD * SX6 -1 LEAVE LITERALS IN XSTOR SA6 NJNAM CALL JOPARSE GET TAGS SA1 LASTKEY CHECK TERMINATOR NZ X1,ERR2MNY -- ERROR IF MORE TAGS * SA1 JACCNAM RETRIEVE TAGS SA2 JLESNAM SA3 JUNIT SA4 JPARGFL * LX1 2*XCODEL FORM COMMAND WORD LX2 1*XCODEL BX6 X1+X2 X6 = ACCOUNT/LESSON CODES * MX0 6 FORM UNIT/ARGS WORD BX0 X0*X3 CHECK FOR LITERAL UNIT NAME NZ X0,JOUT1A LX3 XCODEL SHIFT OVER IF NOT LITERAL * JOUT1A BX7 X3+X4 X7 = UNIT/ARGS WORD ZR X7,PUTCODE -- EXIT IF NO UNIT OR ARGS SA1 INX GET INDEX IN XSTOR SA7 X1+INFO AND PUT UNIT/ARGS THERE SX7 X1+1 X7 = [XSTOR+1] SA7 A1 UPDATE INDEX LX7 XCMNDL PUT POINTER INTO COMMAND WORD BX6 X6+X7 EQ PUTCODE -- EXIT * * /--- BLOCK FOLD 00 000 81/01/15 04.45 * * VARIABLE -FROM- COMMAND * FOLD CALL PUBERRS,FSFROM * MX6 0 SA6 JLESNAM PRESET COMMAND WORD * CALL COLONCK CHECK FOR ACCOUNT NAME NZ X6,FOLD10 -- NO ACCOUNT NAME CALL COMPILE GET ACCOUNT *GETVAR* CODE NZ B1,ERRSTOR -- ERROR IF NOT STOREABLE BX6 X1 LX6 60-XCODEL POSITION IT SA1 INX SX7 X1+1 SA6 X1+INFO PUT IT IN XSTOR SA7 A1 AND UPDATE XSTOR POINTER LX7 XCMNDL SA7 JLESNAM STORE [XSTOR+1] OF ACCOUNT * FOLD10 CALL COMPILE GET LESSON -GETVAR- CODE NZ B1,ERRSTOR SA2 JLESNAM RECALL ACCOUNT ADDRESS (IF ANY) LX1 60-XCODEL BX6 X1+X2 X6 = COMMAND WORD SA2 LASTKEY SEE IF EOL ZR X2,PUTCODE JUMP IF ONLY ONE TAG SA6 JLESNAM SAVE WHAT WE HAVE SO FAR * CALL COMPILE UNIT -GETVAR- CODE NZ B1,ERRSTOR SA2 JLESNAM LX1 60-2*XCODEL BX6 X1+X2 MERGE LESSON AND UNIT CODES EQ PUTCODE * /--- BLOCK JOPARSE 00 000 81/01/17 20.49 * TITLE -JOPARSE- * * -JOPARSE- PROCESS NEXT SET OF TAGS * * OBTAINS THE NEXT ACCOUNT';LESSON,UNIT(ARGS) * * ENTER WITH * *WORDPT* = START OF TAG SET * *NJNAM* < 0 IF WANT *GETVAR* CODES * >= 0 IF WANT LITERALS * * SETS'; *JACCNAM*, *JLESNAM*, *JUNIT*, *JPARGFL* * * JOPARSE EQ * * * LOOK FOR ARGUMENTS -- SET *ENDPNT* IF FOUND * SB1 0 B1 = IF IN LESLIST REFERENCE SX4 1R; X4 = PREVIOUS CHAR MX5 0 X5 = PAREN DEPTH MX6 -1 X6 = NO ARGUMENTS PRESENT SA1 WORDPT SA1 X1-1 * JOP100 SA1 A1+1 EXAMINE NEXT CHAR SX0 X1-1R ZR X0,JOP100 SKIP SPACES SA2 X1+KEYTYPE SX0 X2-OP( CHECK FOR L-PAREN ZR X0,JOP150 SX0 X2-OP) CHECK FOR R-PAREN ZR X0,JOP160 SX0 X2-OPLT CHECK FOR LESS-THAN ZR X0,JOP170 SX0 X2-OPGT CHECK FOR GREATER-THAN ZR X0,JOP180 * ZR X1,JOP200 STOP AT EOL SX0 X1-1R; OR SEMI-COLON NZ X0,JOP110 SX0 X4-KUP MAKE SURE NOT A COLON NZ X0,JOP200 * JOP110 BX4 X1 REMEMBER THIS CHARACTER EQ JOP100 LOOP BACK * /--- BLOCK JOPARSE 00 000 81/01/20 02.38 * * HANDLE PARENS AND VARIABLE TAGS * JOP150 BSS 0 L-PAREN -- MIGHT BE ARGS NZ X5,JOP155 NOT IF ALREADY IN PARENS NZ B1,JOP155 OR IF IN LESLIST REFERENCE SA2 X4+KEYTYPE OR IF FIRST CHAR IN NEW TAG SX0 X2-OPCOMMA ZR X0,JOP155 PL X6,ERRUARG -- ERROR IF ALREADY HAVE ARGS SX7 1R, REPLACE PAREN WITH COMMA SA7 A1 SX6 A1 X6 = START OF ARGS JOP155 SX5 X5+1 INCREMENT PAREN DEPTH EQ JOP110 LOOP BACK * JOP160 SX5 X5-1 DECREMENT PAREN DEPTH NG X6,JOP110 AND LOOP BACK IF NOT IN ARGS NZ X5,JOP110 OR IF PARENS NOT BALANCED SX7 1R REPLACE PAREN WITH SPACE SA7 A1 SX7 A7 MARK THIS AS END OF ARGUMENTS SA7 ENDPNT EQ JOP200 AND CEASE PRE-SCANNING * * * HANDLE LESLIST REFERENCES * JOP170 NZ X5,JOP110 SKIP IF IN PARENS SA2 X4+KEYTYPE CHECK PREVIOUS CHAR SX0 X2-OPCOMMA NZ X0,JOP110 SKIP IF NOT FIRST CHAR IN TAG SB1 -1 MARK PROCESSING LESLIST EQ JOP110 * JOP180 NZ X5,JOP110 SKIP IF IN PARENS SB1 0 MARK NOT PROCESSING LESLIST EQ JOP110 * /--- BLOCK JOPARSE 00 000 81/01/20 02.42 * * COME HERE HAVING FINISHED PARSING SET OF TAGS * JOP200 SA6 JPARGFL STORE ARGUMENTS FLAG NZ X5,ERRBAL -- EXIT IF PARENS NOT BALANCED * * GET [ACCOUNT';]FILE *GETVAR* CODES * CALL ACCFILE,JACCNAM,0 * ZR X1,ERR2FEW -- NO LESSON NAME SX1 X1-1 NZ X1,JOP300 BRANCH IF ACCOUNT';LESSON * SA1 JLESNAM CHECK FOR LITERAL LESSON SA2 NJNAM AND EXTRACT LITERAL IF NEEDED CALL JLITEST,JLESNAM,X2 EQ JOP350 * JOP300 SA1 JLESNAM CHECK FOR LITERAL LESSON CALL JLITEST,JLESNAM,-1 * JOP350 SA1 JACCNAM CHECK FOR LITERAL ACCOUNT CALL JLITEST,JACCNAM,-1 * SA1 LASTKEY X1 = *LASTKEY* SX0 X1-1R, CHECK DELIMITER NZ X0,JOP750 NO MORE TAGS IN THIS SET * SA1 JPARGFL CHECK FOR ARGUMENTS NG X1,JOP400 NO ARGS -- GO FOR UNIT SA2 WORDPT ARE WE AT ARGS YET'/ IX0 X2-X1 NG X0,JOP400 NOT YET AT ARGS -- GO FOR UNIT MX6 0 MARK NO UNIT SA6 JUNIT EQ JOP500 GO GET ARGS * * /--- BLOCK JOPARSE 00 000 81/01/29 04.11 * * GET UNIT NAME * JOP400 MX6 0 ZERO-FILL FOR *COMPNAM* SA6 IFILL CALL COMPNAM RETURNS X1 = *GETVAR* CODE * CALL JLITEST,JUNIT,0 GET LITERAL IF POSSIBLE SA1 JUNIT MUST BE LESS THAN 9 CHARS MX0 6 CHECK IF LITERAL BX0 X0*X1 ZR X0,JOP450 NOT A LITERAL MX0 6*8 CHECK IF TOO LONG BX2 -X0*X1 ZR X2,JOP450 CONTINUE IF OK BX6 X0*X1 PATCH IT SA6 A1 */// SB1 3 GIVE CONDENSE WARNING CALL RJERNOZ */// * JOP450 SA2 JPARGFL CHECK FOR ARGUMENTS PL X2,JOP500 PROCESS IF PRESENT SA1 LASTKEY X1 = *LASTKEY* SX0 X1-1R, SHOULD BE NO MORE TAGS ZR X0,ERR2MNY -- ERROR IF MORE TAGS IN SET EQ JOP700 CONTINUE IF OK * * /--- BLOCK JOPARSE 00 000 81/01/28 02.48 * * GET ARGUMENTS * JOP500 SA1 JOTYPE CHECK FOR -FROM- ZR X1,ERRUARG -- ERROR IF ARGS ON -FROM- MX6 0 MARK NOT -UNIT- OR -ARGS- SA6 UNITFLG FOR *GETARGS* CALL SA6 VARBUF AND PRESET NO ARGUMENTS * CALL GETARGS PROCESS ARGUMENTS * MX6 0 NO UNIT NUMBER CALL APACK PACK UP ARGUMENTS MX0 -10 BX6 -X0*X6 MASK OFF XSTOR POINTER SA6 JPARGFL * SA1 LASTKEY X1 = *LASTKEY* SX0 X1-1R, SHOULD BE NO MORE TAGS ZR X0,ERRUARG -- ERROR IF MORE TAGS IN SET * * DONE PARSING TAGS -- *JPARGFL* IS EITHER * [ADDRESS OF XSTOR] (HAD ARGS) OR [-1] (NO ARGS) * JOP700 SA2 JPARGFL *JPARGFL* = (XSTOR+1) SX6 X2+1 [OR 0 IF NO ARGS ] SA6 JPARGFL EQ JOPARSE -- EXIT * * * HAD ONLY [ACCOUNT';]LESSON * JOP750 SX6 B0+0 CLEAR UNIT NAME AND ARGS FLAG SA6 JUNIT SA6 JPARGFL EQ JOPARSE -- EXIT * * /--- BLOCK JLITEST 00 000 81/01/12 15.52 * TITLE -JLITEST- * * -JLITEST- TEST *GETVAR* CODE FOR LITERAL * * ON ENTRY -- * X1 = *GETVAR* CODE * B1 = ADDRESS OF RESULT BUFFER * B2 < 0 IF TO LEAVE RESULT AS *GETVAR* CODE * * ON EXIT -- * (BUFFER) = LITERAL OR *GETVAR* CODE * JLITEST EQ * * BX6 X1 X6 = GETVAR CODE SA6 B1 INITIALIZE RESULT AX1 XCODEAL LOOK AT TYPE MX0 XCODEAL-XCODEL BX1 -X0*X1 SX1 X1-1 NG X1,JLITEST SHORT LITERAL -- EXIT ZR X1,JEXTRCT LONG LITERAL * * NON-LITERAL -JUMPOUT- REFERENCES ARE PUBLISHING ERRORS * CALL PUBERRS,FSJUMPO EQ JLITEST -- EXIT * * JEXTRCT NG B2,JLITEST -- EXIT IF SHOULD NOT EXTRACT MX0 -XCODEAL GET XSTOR OFFSET BX0 -X0*X6 SA1 INFO+X0 RECOVER LITERAL MX6 6 TEST IF LEFT JUSTIFIED BX6 X6*X1 ZR X6,JLITEST NOT LEFT JUSTIFIED LITERAL BX6 X1 SAVE FOR STORING SA1 INX SEE IF LAST ENTRY IN XSTOR SX7 X1-1 IX0 X0-X7 NZ X0,JLITEST -- EXIT IF NOT SA7 A1 UPDATE *INX* SA6 B1 STORE IN RESULT BUFFER EQ JLITEST -- EXIT TITLE -ARGS- COMMAND * * -ARGS- COMMAND * * ACCEPT -JUMPOUT- ARGUMENTS * ARGS SA1 TAGCNT CHECK FOR BLANK TAG ZR X1,ERR2FEW * SA1 WORDPT START AT BEGINNING OF TAG SA2 X1 ARGEND SA2 A2+1 FIND END OF TAG NZ X2,ARGEND SX6 A2 SA6 ENDPNT STORE END OF TAG FIELD SX6 1 SA6 UNITFLG MARK AS -ARGS- FOR *GETARGS* MX6 0 SA6 VARBUF INITIALIZE ARGUMENT COUNT * CALL GETARGS PROCESS ARGUMENTS * MX6 0 NO UNIT NUMBER CALL APACK PACK UP ARGUMENTS MX0 -10 MASK OFF XSTOR POINTER BX6 -X0*X6 LX6 48 POSITION IT MX1 1 MARK AS EXPLICIT -ARGS- BX6 X1+X6 EQ PUTCODE -- BUILD COMMAND WORD * * /--- BLOCK JLITEST 00 000 79/08/09 15.04 JOTYPE EQU INST+INSTLNG+10 -1=JUMPOUT, 0=FROM NJNAM EQU JOTYPE+1 NUMBER OF TABLE ENTRIES JGCODE EQU NJNAM+1 CONDITION CODE JACCNAM EQU JGCODE+1 ACCOUNT *GETVAR* CODE JLESNAM EQU JACCNAM+1 LESSON NAME / *GETVAR* CODE JUNIT EQU JLESNAM+1 UNIT NAME / *GETVAR* CODE JPARGFL EQU JUNIT+1 ARGUMENTS POINTER / FLAG JMPBUFF EQU JPARGFL+1 TABLE OF ALTERNATIVE TAGS * * ENDOV * /--- BLOCK DATAON 00 000 81/01/07 18.49 TITLE OVERLAY FOR VARIOUS DATA COMMANDS * CDATAOV OVRLAY * SA1 OVARG1 SB3 X1 GET INDEX JP B3+* * * * NOTE THAT THESE LABELS ARE NOT THE * ENTRY POINTS THAT THE COMMAND TABLE * USES. * + EQ DOFFIN -DATAOFF- + EQ DONIN -DATAON- + EQ AREAIN -AREA- + EQ OUTPIN -OUTPUT- + EQ OUTPLIN -OUTPUTL- + EQ RDDSIN -READSET- + EQ ERRNAME UNUSED * * TITLE -DATAON- AND -DATAOFF- COMMANDS * * * -DATAON- AND -DATAOFF- COMMANDS * DOFFIN MX6 1 SET BIT FOR -DATAOFF- SA6 VARBUF EQ DON10 * * DONIN SB1 FSDATON -DATAON- IS PUBLISH ERROR RJ =XPUBERRS MX6 0 SET FOR -DATAON- SA6 VARBUF * DON10 MX6 0 CLEAR OPTION BITS SA6 VARBUF+1 SA1 TAGCNT ZR X1,DON90 * DON20 CALL NXTNAME GET NEXT OPTION NAME TO X6**** ZR X6,DON70 MX0 -6 BX2 -X0*X6 SEE IF TOO MANY CHARACTERS NZ X2,ERRNAME SA6 ENDLST PLANT FOR END TEST SA2 OPTLST-1 * /--- BLOCK DATAON 00 000 81/01/07 18.49 * DON30 SA2 A2+1 LOAD NEXT OPTION NAME BX3 X0*X2 BX3 X3-X6 SEE IF FOUND A MATCH NZ X3,DON30 SB1 A2-ENDLST CHECK IF NOT LEGAL OPTION PL B1,ERRNAME SB1 A2-DSSYS CHECK IF SYSTEM LESSON TAG LT B1,DON50 BRANCH IF NOT SYSTEM TAG BX3 X1 X1 DESTROYED BY SYSTEST CALL SYSTEST BX1 X3 RESTORE X1 DON50 BX2 -X0*X2 MASK OFF SHIFT COUNT SB1 X2 MX6 1 LX6 X6,B1 POSITION BIT FOR THIS OPTION SA2 VARBUF+1 BX6 X2+X6 MERGE WITH REST OF BITS SA6 A2 NZ X1,DON20 JUMP IF NOT END-OF-LINE * DON70 NZ X1,ERR2MNY ERROR IF NOT END-OF-LINE SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED COMMAND BX2 X1-X2 NZ X2,DON90 JUMP IF NOT CALL GETLINE SA1 TAGCNT ERROR IF BLANK TAG ZR X1,ERR2FEW EQ DON20 * DON90 SA1 VARBUF GET -DATAON- / -DATAOFF- FLAG SA2 VARBUF+1 GET OPTION BITS BX6 X1+X2 SX7 DATAON= SA7 COMNUM SET COMMAND CODE EQ PUTCODE * * * OPTLST VFD 54/4LAREA,6/DSAREA + VFD 54/6LOUTPUT,6/DSOUTP + VFD 54/2LOK,6/DSOK + VFD 54/2LNO,6/DSNO + VFD 54/8LUNREC NO,6/DSUNO + VFD 54/5LVOCAB,6/DSVOCAB + VFD 54/4LHELP,6/DSHELP + VFD 54/7LHELP NO,6/DSHELPN + VFD 54/4LTERM,6/DSTERM + VFD 54/7LTERM NO,6/DSTERMN + VFD 54/6LERRORS,6/DSXERR + VFD 54/6LSIGNIN,6/DSDATON DSSYS VFD 54/8LNOSIGNIN,6/DSNODON NOTE -- THIS POINT * AND BEYOND ARE FOR SYSTEM LESSONS ONLY ENDLST BSS 1 * * /--- BLOCK AREA 00 000 75/10/25 21.28 TITLE AREA * * -AREA- COMMAND * DESIGNATES AREA OF LESSON FOR SUMARIZED DATA * * AREAIN SA1 TAGCNT SEE IF ANY TAG ZR X1,AIN1 MX6 0 SET TO ZERO FILL SA6 IFILL CALL COMPNAM EQ CALCODE * AIN1 MX1 0 0 = SHORT INTEGER 0 EQ CALCODE * /--- BLOCK OUTPUT 00 000 78/10/11 00.10 TITLE OUTPUT * * -OUTPUT- COMMAND * OUTPUTS VARIABLES AND/OR TEXT AS STUDENT DATA * * OUTPIN SB1 FSOUTP -OUTPUT- IS PUBLISH ERROR RJ =XPUBERRS SA1 TAGCNT SEE IF ANY TAG ZR X1,ERR2FEW MX6 0 INITIALIZE NUMBER OF ENTRIES SA6 VARBUF * LP SA1 INX SB2 X1 INITIALIZE XSTOR POINTER SB3 B0 INITIALIZE WORD COUNT SA1 WORDPT SX7 X1-1 INITIALIZE CHARACTER POINTER * LP0 MX6 0 CLEAR WORD BUILDING SB1 60 INITIALIZE SHIFT COUNT * LP1 SX7 X7+1 ADVANCE TO NEXT CHARACTER SA1 X7 ZR X1,ENDLIN JUMP IF END-OF-LINE SX2 X1-ACCESS NZ X2,LP2 JUMP IF CANNOT BE -EMBED- SA2 X7+1 SX2 X2-1R0 SEE IF -EMBED- (ACCESS 0) ZR X2,EMBED * LP2 SB1 B1-6 COMPUTE SHIFT COUNT LX1 X1,B1 POSITION THIS CHARACTER BX6 X1+X6 MERGE WITH WORD BUILDING NZ B1,LP1 SA6 B2+INFO STORE COMPLETED WORD SB2 B2+1 ADVANCE XSTOR POINTER (INX) SB3 B3+1 INCREMENT WORD COUNT EQ LP0 * EMBED ZR X6,EMB1 JUMP IF CURRENT WORD EMPTY SA6 B2+INFO SB2 B2+1 UPDATE XSTOR POINTER SB3 B3+1 INCREMENT WORD COUNT * EMB1 SA1 X7+2 LOAD TYPE SPECIFIER (A,N,O,V) MX6 0 SX2 X1-1RA SEE IF -A- ALPHA ZR X2,EMB2 SX6 X6+1 SX2 X1-1RN SEE IF -N- INTEGER ZR X2,EMB2 SX6 X6+1 SX2 X1-1RO SEE IF -O- OCTAL ZR X2,EMB2 SX6 X6+1 SX2 X1-1RV SEE IF -V- FLOATING ZR X2,EMB2 SX6 X6+1 SX2 X1-1RH SEE IF -H- HEXADECIMAL ZR X2,EMB2 SX7 X7+2 SA7 WORDPT UPDATE *WORDPT* SB1 154 EQ =XERR * EMB2 SA6 IWK SAVE TYPE SPECIFIER SA1 X7+3 SX1 X1-1R, NEXT CHARACTER MUST BE COMMA NZ X1,ERRTERM SX7 X7+4 SA7 WORDPT UPDATE *WORDPT* ZR B3,EMB3 JUMP IF NO WORDS IN ENTRY SA1 VARBUF SX7 X1+1 INCREMENT NUMBER OF ENTRIES SA7 A1 SA1 INX BEGINNING INDEX OF TEXT SX2 B3 NUMBER OF WORDS OF TEXT LX2 9 BX6 X1+X2 MERGE INDEX AND WORD COUNT * /--- BLOCK OUTPUT 00 000 78/10/11 00.10 SA6 X7+VARBUF * /--- BLOCK EMB3 00 000 76/07/25 07.53 * EMB3 SX7 B2 UPDATE XSTOR POINTER (INX) SA7 INX CALL COMPILE DECODE EXPRESSION SA2 WORDPT SA3 X2-2 MUST END WITH (ACCESS 1) SX3 X3-ACCESS NZ X3,ERRTERM SA3 X2-1 SX3 X3-1R1 NZ X3,ERRTERM MX0 -XCODEL BX1 -X0*X1 -GETVAR- CODE MX6 1 LX6 30 POSITION BIT FOR -EMBED- BX6 X1+X6 MERGE BIT AND -GETVAR- CODE SA1 IWK LX1 XCODEL POSITION TYPE SPECIFIER BX6 X1+X6 SA1 VARBUF SX7 X1+1 INCREMENT NUMBER OF ENTRIES SX1 X7-VARBUFL+2 PL X1,ERR2MNY ERROR IF TOO MANY ENTRIES SA7 A1 SA6 X7+VARBUF STORE INFO FOR -EMBED- EQ LP * ENDLIN ZR X6,ENDL1 JUMP IF NOTHING IN LAST WORD SA6 B2+INFO SB2 B2+1 ADVANCE XSTOR POINTER (INX) SB3 B3+1 INCREMENT WORD COUNT * ENDL1 ZR B3,ENDL2 JUMP IF NOTHING IN LAST ENTRY SA1 VARBUF SX7 X1+1 INCREMENT NUMBER OF ENTRIES SA7 A1 SA1 INX BEGINNING INDEX OF TEXT SX2 B3 NUMBER OF WORDS OF TEXT LX2 9 BX6 X1+X2 MERGE INDEX AND WORD COUNT SA6 X7+VARBUF * ENDL2 SA1 VARBUF LOAD NUMBER OF ENTRIES ZR X1,ERR2FEW MX6 0 CLEAR LAST WORD SA6 X1+VARBUF+1 SB3 B2 SAVE INDEX IN XSTOR SB4 X1-1 PICK UP END TEST SA2 VARBUF-1 INITIALIZE INDEX IN *VARBUF* * ENDL3 SA2 A2+2 LOAD NEXT -VARBUF- ENTRY LX2 30 SA3 A2+1 LOAD NEXT -VARBUF- ENTRY BX6 X2+X3 SA6 B2+INFO STORE NEXT TWO CODES SB2 B2+1 SB4 B4-2 DECREMENT ENTRY COUNT PL B4,ENDL3 SX6 B2 UPDATE XSTOR POINTER SA6 INX LX1 60-18 POSITION NUMBER OF ENTRIES SX6 B3 LX6 60-18-18 POSITION INDEX IN XSTOR BX6 X1+X6 EQ PUTCODE GO ATTACH COMMAND CODE * /--- BLOCK OUTPUTL 00 000 76/07/25 07.53 TITLE OUTPUTL * * -OUTPUTL- COMMAND LABLED OUTPUT * * FIRST ARGUMENT = NAME (LABLE) * 2ND ARGUMENT = STARTING VARIABLE TO OUTPUT * 3RD ARGUMENT = NUMBER OF VARIABLES TO OUTPUT * * OUTPLIN SB1 FSOUTPL -OUTPUTL- IS PUBLISH ERROR RJ =XPUBERRS MX6 0 ZERO FILL SA6 IFILL CALL COMPNAM FIRST ARGUMENT BX6 X1 ZR B1,OUTPL1 JUMP IF STOREABLE MX1 1 BX6 X1+X6 * OUTPL1 SA6 VARBUF+1 SAVE -GETVAR- CODE SX6 1 SA6 VARBUF NUMBER OF VARIABLES CALL VARDO2 GET NEXT ARGUMENT SA1 LASTKEY ZR X1,OPL2 JUMP IF TWO ARGUMENT CALL VARDO2 GET NEXT ARGUMENT SA1 VARBUF+2 NG X1,ERRSTOR ERROR IF 2ND NOT STOREABLE SX1 3 EQ VARFIN * OPL2 SA1 VARBUF+1 ERROR IF 1ST NOT STOREABLE NG X1,ERRSTOR MX6 1 LX6 XCODEL POSITION BIT TO FLAG 2 ARG BX6 X1+X6 SA6 A1 SX1 2 PACK UP 2 VARIABLES EQ VARFIN * * IWK BSS 1 * /--- BLOCK READSET 00 000 76/07/25 07.53 TITLE READSET * * -READSET- COMMAND * * TWO, THREE, OR FOUR ARGUMENTS -- * 1ST IS ACCOUNT NAME * 2ND IS FILE NAME * 3RD IS CODEWORD * 4TH IS RETURN VARIABLE * * RDDSIN CALL ACCFILF GET ACCOUNT AND FILE NAME ZR X1,ERR2FEW --- ERROR IF BLANK TAG * SA1 LASTKEY ZR X1,MRKLAST --- DONE IF END OF LINE CALL VARDO2 GET CODEWORD ARGUMENT SA1 LASTKEY ZR X1,MRKLAST --- DONE IF END OF LINE CALL VARDO2 GET RETURN VARIABLE NG X6,ERRSTOR --- ERROR IF NOT STOREABLE SA1 LASTKEY ZR X1,MRKLAST EQ ERR2MNY * * ENDOV * /--- BLOCK READDIN 00 000 76/07/25 07.55 * TITLE -READD- COMMAND READ DATA FROM DATAFILE * * * FIRST ARG'; TYPE (OUTPUT, AREA, DATAOFF) * SECOND ARG'; BUFFER * THIRD ARG'; LENGTH * READDOV OVRLAY CALL NXTNAME GET TYPE OF DATA **** SB1 1 SA1 RDDLST-1 INITIALIZE FOR SEARCH MX0 -6 RDDLIST SA1 A1+B1 GET NEXT ENTRY SB3 A1-RDEND PL B3,ERRTAGS NOT FOUND BX2 X6-X1 SEE IF LEGAL TAG BX2 X2*X0 MASK OFF LOWER 6 BITS NZ X2,RDDLIST BX6 -X0*X1 GET TYPE NUMBER LX6 XCMNDL SA6 RDDTEMP CALL COMPILE GET BUFFER START NZ B1,ERRSTOR ERROR IF NOT STOREABLE LX1 -XCODEL SA2 RDDTEMP BX6 X2+X1 SA6 RDDTEMP CALL COMPILE SX1 X1 LX1 60-XCODEL-XCODEL SA2 RDDTEMP BX6 X2+X1 EQ PUTCODE * * RDDLST VFD 54/4LAREA,6/1 + VFD 54/7LOUTPUTL,6/2 + VFD 54/7LSIGNOFF,6/3 RDEND BSS 1 * RDDTEMP BSS 1 * ENDOV * /--- BLOCK NOTES 00 000 86/02/21 14.16 TITLE NOTES COMMAND * * NOTES COMMAND -- ACCESS TERM-COMMENTS UNDER * PROGRAM CONTROL * * NO TAG CALL SYSLIB, COMMENTS MACHINERY * 1 ARG CALL SYSLIB, PASSING NOTE TITLE * 2 ARGS CALL SYSLIB, PASS BUFFER SPECIFIED * IN FIRST ARG, FOR LENGTH 2ND ARG, * FOR HEADER OF STUDENT COMMENT * 3 ARGS THIRD ARGUMENT SPECIFIES NOTE TITLE * 4 ARGS FOURTH ARGUMENT SPECIFIES LESSON NOTES * FILE TO BE USED FOR THIS NOTE; SYSTEM * LESSONS ONLY. * (SEND) OPTIONAL KEYWORD ',SEND', MAY FOLLOW * ABOVE ARGUMENTS; INDICATES THAT NOTE * SHOULD BE AUTOMATICALLY SENT WITHOUT * STUDENT INTERVENTION. * (LESSON) SAME AS ',SEND',, EXCEPT FORCED TO GO * LESSON NOTES FILE. * * FORMAT FOR COMMAND WORD -- * NEXT TO TOP BIT OF GETVAR1 = AUTO-SEND SELECTED * TOP TWO BITS OF GETVAR1 SET = ',LESSON', AUTO-SEND * NEXT TO TOP BIT OF GETVAR2 = * NOTE TITLE TO BE PASSED (IF MORE THAN ONE * ARGUMENT IS IN THE COMMAND) * * LAST GETVAR CODE MARKED USING -MRKLAST- * NNOTEOV OVRLAY SA1 TAGCNT MX6 0 ZR X1,PUTCODE NO ARGS MEANS SIMPLE CALL * CALL VARDO1 SA1 VARBUF+1 PICK UP THIS GETVAR CODE NG X1,ERRSTOR MUST BE STORABLE SA2 LASTKEY ZR X2,MRKLAST ONLY ARGUMENT IS TITLE * OTHERWISE, FIRST ARGUMENT IS BUFFER START CALL VARDO2 GET NEXT ARGUMENT * /--- BLOCK NOTES 00 000 86/02/21 14.17 * RJ KEYWORD CHECK FOR SEND/LESSON NZ X6,NOTES1 BRANCH IF NOT NULL ARGUMENT SX7 B1 SA7 WORDPT UPDATE WORDPT EQ NOTES2 * NOTES1 CALL VARDO2 GET TITLE SA1 VARBUF+3 PICK UP THIS GETVAR CODE NG X1,ERRSTOR MUST BE STORABLE SA1 VARBUF+2 MARK GETVAR CODE TO SHOW TITLE MX6 1 LX6 XCODEL-1 POSITION TO NEXT TO TOP BIT BX6 X6+X1 SET BIT OF GETVAR CODE SA6 A1 RJ KEYWORD * NOTES2 CALL SYSTEST SYSTEM LESSONS ONLY CALL ACCFILE,VARBUF+4,0 SA1 VARBUF GET NUMBER OF ARGUMENTS SX6 X1+2 ADD 2 (ACCOUNT AND FILE NAME) SA6 A1 RJ KEYWORD EQ ERRTAGS ILLEGAL FIFTH TAG * KEYWORD EQ * SA1 LASTKEY ZR X1,MRKLAST EXIT IF LAST ARG * CALL NXTNAMP NEXT TAG W/O UPDATING WORDPT ZR X6,KEYWORD RETURN IF NULL ARG SA2 KSEND SEE IF LITERAL ',SEND', MX7 1 PRESET FOR ',SEND', LX7 XCODEL-1 NEXT TO TOP BIT BX2 X6-X2 ZR X2,MARK SA2 KLESSON SEE IF LITERAL ',LESSON', MX7 2 SET FOR ',LESSON', LX7 XCODEL BX2 X6-X2 NZ X2,KEYWORD RETURN IF NEITHER MARK NZ X1,ERRTAGS TERMINATOR MUST BE EOL SA1 VARBUF+1 GET FIRST GETVAR CODE BX7 X7+X1 SET BIT OF GETVAR CODE SA7 A1 EQ MRKLAST --- EXIT * COMERR SB1 106 MUST BE N OR V VARIABLE EQ =XERR * KSEND DATA 4LSEND KLESSON DATA 6LLESSON * ENDOV * /--- BLOCK INTLOK 00 000 81/01/07 18.50 TITLE -INTLOK- AND -INTCLR- COMMANDS * * * * -INTLOK- AND -INTCLR- COMMANDS * ALLOW SYSTEM LESSONS TO ACCESS MULTI-EXECUTOR * INTERLOCK TABLES * * INTLOK TYPE,INDEX,(WRITE) * INTCLR TYPE,INDEX * INTLOKV OVRLAY CALL SYSTEST CHECK SYSTEM LESSON CALL NXTNAM GET TYPE ARGUMENT ZR X6,ERRORC MX0 42 X0 = MASK SA1 ITTAB-1 A1 = READ REGISTER * INT120 SA1 A1+1 LOAD NEXT OPTION NAME ZR X1,ERRORC BX2 X1-X6 BX2 X0*X2 CHECK IF FOUND A MATCH NZ X2,INT120 SX6 X1 PICK OFF TYPE CODE SA6 VARBUF+1 * CALL COMPILE EVALUATE INDEX EXPRESSION BX6 X1 SA6 VARBUF+2 SA1 OVARG1 DETERMINE INTLOK/INTCLR NZ X1,INT240 * * CALL NXTNAM GET READ/WRITE ARGUMENT SA1 ITTAB1 (X1) = DEFAULT TYPE ZR X6,INT170 IF NO ARGUMENT MX0 42 X0 = MASK SA1 ITTAB1-1 A1 = READ REGISTER * INT160 SA1 A1+1 LOAD NEXT OPTION NAME ZR X1,ERRORC BX2 X1-X6 BX2 X0*X2 CHECK IF FOUND A MATCH NZ X2,INT160 INT170 SX6 X1 SET INTERLOCK TYPE SA1 VARBUF+1 IX6 X1+X6 ADD TO INTERLOCK TYPE SA6 A1 * INT240 SX1 2 SET NUMBER OF *GETVAR* CODES BX6 X1 SA6 VARBUF EQ VARFIN COMPLETE COMMAND READ-IN * * ITTAB VFD 42/0LX,18/0 VFD 60/0 ITTAB1 VFD 42/0LW,18/0 VFD 42/0LWRITE,18/0 VFD 60/0 * ENDOV * * * /--- BLOCK -ATTACH- 00 000 79/12/15 21.26 TITLE -ATTACH- COMMAND CONDENSE ROUTINE * * -ATTACH- * * ATTACH ACCOUNT';FILE * ATTACH ACCOUNT';FILE,RO * ATTACH ACCOUNT';FILE,(N1),CODEWORD * ONLY IN SYSTEM LESSONS'; * ATTACH ACCOUNT';FILE,RW,CODEWORD,FILETYPE * * ATCHOV OVRLAY SA1 OVARG1 SEE WHICH COMMAND SX0 X1-2 ZR X0,IOSPGO --- BRIF -IOSPECS- SX0 X1-3 ZR X0,GETLGO --- BRIF -GETLINE- * * GET FILE AND ACCOUNT NAMES INTO VARBUF+1 AND VARBUF+2 * CALL ACCFILF ZR X1,ERR2FEW --- ERROR IF NO ARGUMENTS SA2 LASTKEY SEE IF EOL ZR X2,MRKLAST --- BRIF EOL ENCOUNTERED * * CHECK NEXT ARGUMENT FOR A LITERAL '7RO'7 OR '7RW'7 * CALL NXTNAMP GET LITERAL TAG IN X6 ZR X6,ATT130 --- BRIF NOT A NAME SB1 B7-3 POINT AT R IN RW OR RO SA2 LITRO COMPARE FOR READ-ONLY BX2 X6-X2 ZR X2,ATT110 --- BRIF SHOULD FAKE 0 SA2 LITRW COMPARE FOR READ-WRITE BX2 X6-X2 ZR X2,ATT120 --- BRIF SHOULD FAKE -1 ATT130 CALL VARDO2 COMPILE THIS ARGUMENT SA1 LASTKEY ZR X1,MRKLAST --- MARK LAST TAG FOUND EQ ATT250 --- GET CODEWORD ARGUMENT LITRO DATA 2LRO LITRW DATA 2LRW * * FAKE A 0 ARGUMENT FOR '7RO'7 LITERAL TAG * ATT110 SX6 1R0 SA6 B1 OVERWRITE R WITH 0 SA6 B1+1 OVERWRITE O WITH 0 EQ ATT130 --- DONE WITH KLUDGE * * FAKE A -1 ARGUMENT FOR '7RW'7 LITERAL TAG * ATT120 SX6 1R- SET UP LITERAL - SX7 1R1 SET UP LITERAL 1 SA6 B1 OVERWRITE R WITH - SA7 B1+1 OVERWRITE W WITH 1 EQ ATT130 --- DONE WITH KLUDGE * /--- BLOCK -ATTACH- 00 000 78/08/01 09.28 * * DONE WITH R/W TAG FIELD -- MRKLAST THE REST * ATT250 CALL VARDO2 COMPILE NEXT VAR TO VARBUF SA1 LASTKEY NZ X1,ATT250 CONTINUE IF NOT E-O-L SA1 VARBUF+4 MARK CODEWORD AS INTEGER TYPE MX7 60-XCODEL+XFBIT+1 BX7 -X7*X1 REMOVE I/F BIT FROM GETVAR CODE SA7 A1 SA1 VARBUF READ NO. OF ARGS SX0 X1-5 4 TAGS MAX FOR REGULAR LESS NG X0,MRKLAST --- EXIT IF .LE. 4 TAGS SX0 X1-6 5 TAGS MAX FOR SYSTEM LESSON PL X0,ERR2MNY --- TOO MANY TAGS CALL SYSTEST MUST BE SYSLESS FOR 5 TAGS EQ MRKLAST --- EXIT THIS COMMAND * ** * /--- BLOCK -IOSPECS- 00 000 77/12/21 14.00 TITLE -IOSPECS- CONDENSE ROUTINE * * -IOSPECS- * * IOSPECS OPTION,OPTION,OPTION... * * ALL OPTIONS ARE LITERALS WHICH ARE DECODED HERE * INTO BIT SHIFTS DEPENDING UPON THEIR POSITION * IN THE OPTION TABLE BELOW. 'THE TOP OF THE TABLE * IS THE TOP BIT IN THE COMMAND WORD, AND SO ON. * * IOSPGO SB1 IOLITS B1 = START OF LITERAL TABLE SB2 IOLEND B2 = END OF ABOVE TABLE MX5 60 ALLOW UP TO 10 CHAR LITS CALL SCANNER SCAN THE TAGS ZR X0,PUTCODE --- BRIF TAGS ARE LEGAL EQ ERRNAME --- EXIT IF BAD TAGS IOLITS DATA 0LMODS DATA 0LNOMODS DATA 0LTRUNCATE DATA 0LNOTRUNCATE DATA 0LDELETED DATA 0LNODELETED IOLEND DATA 0 * ** * /--- BLOCK -GETLINE- 00 000 77/11/10 17.46 TITLE -GETLINE- COMMAND CONDENSE ROUTINE * * -GETLINE- * * THE -GETLINE- COMMAND MUST HAVE EXACTLY THREE * ARGUMENTS OF WHICH THE FIRST AND THIRD MUST * BE STOREABLE. * * GETLGO RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 FIRST TAG MUST BE STOREABLE NG X1,ERRSTOR SA1 VARBUF+3 THIRD TAG MUST BE STOREABLE NG X1,ERRSTOR SX1 3 EQ VARFIN * ** ENDOV * /--- BLOCK END 00 000 76/07/21 20.33 TITLE KERMIT COMMAND * * * * KERMIT OPEN,FILENAM,MODE * FILENAM = N OR NC VARIABLE (7 WORDS) * (FULL FILE NAME ON DOS DISK) * MODE = '7WRITE'7 OR '7APPEND'7 * WRITE = OVERWRITE ENTIRE FILE * APPEND = APPEND TO END OF FILE * * * * KERMIT CLOSE * * * * KERMIT SEND,STOWORD,BYTES,TYPE * STOWORD = STARTING STO WORD ^$ * BYTES = NUM BYTES TO SEND * (6-BIT CHARS IF TYPE * EQUALS 6BIT) * TYPE = BYTE FORMAT * ASCII = ASCII 8-BIT * TEXT = 6-BIT * * * * KERMIT RECEIVE,STOWORD,BYTES,TYPE,RETURN * RETURN = NUMBER OF BYTES/6BIT * ITEMS RECEIVED * KERMCOV OVRLAY * SA1 TAGCNT NUM CHARS IN TAG PORTION ZR X1,ERR2FEW NO ARGS, BAD FORM OF COMMAND * CALL NXTNAME GET LITERAL TAG IN X6 ZR X6,ERRNAME --- BRIF NOT A NAME SX0 0 DEFAULT TO '7OPEN'7 SX5 2 3 ARGS REQUIRED (2 COMMAS) SA2 LOPEN SEE IF '7OPEN'7 OPTION BX2 X6-X2 COMPARE ZR X2,KARGSOK SX0 1 DEFAULT TO '7CLOSE'7 SX5 0 1 ARGS REQUIRED (0 COMMAS) SA2 LCLOSE SEE IF '7CLOSE'7 OPTION BX2 X6-X2 COMPARE ZR X2,KARGSOK SX0 2 DEFAULT TO '7SEND'7 SX5 3 4 ARGS REQUIRED (3 COMMAS) SA2 LSEND SEE IF '7SEND'7 OPTION BX2 X6-X2 COMPAIRE ZR X2,KARGSOK SX0 3 DEFAULT TO '7RECEIVE'7 SX5 4 5 ARGS REQUIRED (4 COMMAS) SA2 LRECVE SEE IF '7RECEIVE'7 BX2 X6-X2 COMPARE ZR X2,KARGSOK EQ ERRNAME INVALID TAG * * /--- BLOCK -KERMIT- 00 000 79/01/22 01.25 KARGSOK SA1 COMACNT NUM OF COMMAS IN TAGS IX1 X1-X5 SEE IF WE HAVE REQUIRED TAGS ZR X1,KRIGHT IF CORRECT NUMBER ARGS, GO ON NG X1,ERR2FEW NOT ENOUGH ARGS PL X1,ERR2MNY TOO MANY ARGS KRIGHT BX6 X0 TRANSFER TO WRITE REGISTER SA6 VARBUF+1 SX1 1 1 PACKAGE FOR '7CLOSE'7 SX6 X0-1 CHECK FOR '7RECEIVE'7 ZR X6,KDONE CALL COMPILE GET NEXT ARG (VAR) SA2 VARBUF+1 GET OP CODE NZ X2,KSKIP1 NOT '7OPEN'7, SKIP NZ B1,ERRSTOR ERROR IF NOT STOREABLE KSKIP1 BX6 X1 SA6 VARBUF+2 NZ X2,KSKIP2 NOT '7OPEN'7, SKIP * * * CHECK '7WRITE'7 OR '7APPEND'7 ON '7OPEN'7 COMMAND (3RD ARG) CALL NXTNAME ZR X6,ERRNAME --- BRIF NOT A NAME SX0 0 DEFAULT TO '7WRITE'7 SA5 LWRITE BX2 X5-X6 ZR X2,K3RDARG SX0 1 DEFAULT TO '7APPEND'7 SA5 LAPPEND BX2 X5-X6 ZR X2,K3RDARG EQ ERRNAME K3RDARG BX6 X0 SA6 VARBUF+3 SX1 3 3 PACKAGE FOR '7CLOSE'7 EQ KDONE * /--- BLOCK -KERMIT- 00 000 79/01/22 01.29 KSKIP2 CALL COMPILE GET NUMBER OF BYTES/CHARS BX6 X1 SA6 VARBUF+3 CALL NXTNAME ZR X6,ERRNAME --- BRIF NOT A NAME SX0 0 DEFAULT TO ASCII DATA SA2 LASCII BX2 X6-X2 ZR X2,KTYPE SX0 1 DEFAULT TO TEXT DATA SA2 LTEXT BX2 X6-X2 ZR X2,KTYPE EQ ERRNAME INVALID TAG KTYPE BX6 X0 SA6 VARBUF+4 * SEE IF WE NEED TO CHECK FOR 5TH ARGUMENT SA2 VARBUF+1 GET ORIGINAL OP CODE SX2 X2-2 CHECK AGAINST *SEND* CODE SX1 4 NUMBER OF 20-BIT PACKAGES ZR X2,KDONE EXIT -- SAVE CODE * COMPILE 5TH ARGUMENT (RECEIVE) CALL COMPILE NZ B1,ERRSTOR ERROR IF NOT STOREABLE BX6 X1 SA6 VARBUF+5 SX1 5 NUMBER OF 20-BIT PACKAGES KDONE BX6 X1 NUMBER PACKAGES EXPECTED SA6 VARBUF SAVE NUMBER OF 20-BIT PACKAGES EQ VARFIN EXIT -- SAVE CODE * LOPEN DATA 0LOPEN LCLOSE DATA 0LCLOSE LSEND DATA 0LSEND LRECVE DATA 0LRECEIVE LWRITE DATA 0LWRITE LAPPEND DATA 0LAPPEND LASCII DATA 0LASCII LTEXT DATA 0LTEXT * ENDOV * /--- BLOCK END 00 000 76/07/21 20.33 * * OVTABLE * * END COVLY1$