COVLAY3 * /--- FILE TYPE = E * /--- BLOCK COVLAY3 00 000 81/07/13 01.09 IDENT COVLAY3 LCC OVERLAY(1,1) * TITLE OVERLAYS FOR COMMAND READINS * * CST * * COVLY3$ OVFILE * * EXT ECSPRTY EXT KEYTYPE,VARFIN,VARFINM EXT ERRORC,PUTCODE,ALTCODE,CALCODE EXT NXTNAM,SYSTEST,SYSTST1 EXT LNGUNIT EXT COMCONT EXT ERRTAGS,ERRNAME,ERRSTOR EXT ERRXYTG,ERR2MNY,ERR2FEW EXT ERRTERM,ERRUARG,ERRVTYP EXT ERROUTR,ERRCNTD,ERRXORQ EXT ERRBAL,ERR EXT NXTNAMP,MRKLAST EXT VARDO,VARDO1,COMPILE,NXTNAME EXT ADDLES= EXT ONE2IN * * * /--- BLOCK PACK 00 000 77/06/12 16.40 ** ** ** TITLE PACK COMMANDS * PACKOV OVRLAY SB1 FSPACK LOG TEXT FOR PUBLICATION RJ =XPUBTEXT * * TO DO'; * RETURN SCREEN LENGTH * ALLOW 5000 CHARS (MAYBE) BY PACKING IN *INFO* * MULTIPLE LINES FOR *PACK* * * PACK COMMAND WITH EMBEDS'; * * * FIRST *XCODEL* BITS ARE VAR STORING INTO * SECOND *XCODEL* BITS ARE CHAR COUNT (0 IF NO) * NEXT 11 BITS LOCATION OF TABLE IN EXTRA STORAGE * NEXT *XCMNDL* BITS ARE COMMAND CODE NUMBER * * TABLE ENTRIES ARE SET UP IN ROUTINE -PACKER- * SA1 TAGCNT MAKE SURE SOME TAG ZR X1,ERR2FEW * * OVARG1 = 0 (PACK), 1 (PACKC), 2 (SAY), 3 (SAYC) SA1 OVARG1 SB1 X1 JP PACKOJ+B1 PACKOJ EQ PACK00 PACK + EQ PACKC0 PACKC + EQ SAY00 SAY + EQ SAYC0 SAYC * SAY00 MX7 0 NO GETVAR CODES FOR -SAY- SA7 PCWORD EQ PACK0 * PACK00 CALL COMPILE EVALUATE FIRST TAG NZ B1,ERRSTOR MAKE SURE ITS STORABLE LX1 60-XCODEL LEFT JUSTIFY GETVAR CODE MX7 1 LX7 2*XCODEL FAKE GVAR CODE FOR SECOND ARG BX7 X1+X7 MERGE LOC GVAR + FAKE GVAR SA7 PCWORD SAVE CODES * * SEE IF TWO COMMAS NEXT TO EACH OTHER (TWO ARG COMMAND) * * SA1 WORDPT SAVE CURRENT POSITION BX6 X1 SA6 OLDPT CALL NEXTKEY SA1 X2+KEYTYPE LOAD KEYTYPE FOR NEXT KEY SX3 X1-OPCOMMA ZR X3,PACK0 IF SEPARATER * * SA1 OLDPT BX6 X1 RESTORE WORDPT SA6 WORDPT * CALL PUTCOMP NG B1,ERRSTOR MAKE SURE SECOND ARG STORABLE LX1 60-2*XCODEL AND PUT IN CENTER SA2 PCWORD FETCH LOC GVAR CODE MX7 XCODEL BX7 X7*X2 INCLUDE ONLY 1ST GETVAR CODE BX7 X7+X1 MERGE THEM SA7 PCWORD AND STORE * PACK0 CALL PACKER RETURNS START OF TABLE IN B3 ZR B2,ERR2FEW AND LENGTH IN B2 * SA1 PCWORD SX2 B3 GET SAVED START OF TABLE LX2 XCMNDL BX6 X2+X1 EQ PUTCODE AND PUT IN COMMAND CODE * * * /--- BLOCK PACKC0 00 000 77/06/19 12.56 * * PACKC COMMAND'; ( MAX OF 100 CHAR STRINGS ) * * COMMAND WORD'; * FIRST *XCODEL* BITS'; STRING DESTINATION * NEXT *XCODEL* BITS'; CHAR CNT RETURN * NEXT 11 BITS'; START OF TAG TABLE * LAST *XCMNDL* BITS'; COMMAND NUMBER ** * FIRST WORD OF TAG TABLE'; * FIRST *XCODEL* BITS'; CONDITIONAL EXPRESSSION GVAR * BOTTOM 10 BITS'; NUMBER OF TAG ENTRIES * * TAG TABLE ENTRIES'; * 30 BIT ENTRIES, TWO PER WORD * * BOTTOM 12 BITS'; ADDRESS OF SECONDARY TABLE * NEXT 9 BITS'; NUMBER OF ENTRIES IN SEC. TABLE * * TAG TABLE IS FORMATTED INTO BUFFER '7SHOWOUT'7 (100WDS LONG) * * (SECONDARY TABLE SET UP IN ROUTINE -PACKER-) * SAYC0 CALL COMPILE GET CONDITIONAL EXPRESSION BX6 X1 SA6 PCWORD EQ PACKC4 * PACKC0 CALL VARDO1 FIRST EXPRESSION CALL VARDO2 SECOND EXPRESSION * * CHECK FOR ADJACENT SEPARATORS'; NOT RETURNING CCOUNT * SA1 WORDPT SAVE CURRENT POSITION BX6 X1 SA6 OLDPT CALL NEXTKEY SA1 X2+KEYTYPE LOAD KEYTYPE FOR NEXT KEY * SX3 X1-OPCOMMA ZR X3,PACKC1 IF A SEPARATOR * SX3 X1-EOL NZ X3,PACKC2 IF NOT END OF LINE * PACKC1 BX7 X2 SA7 LASTKEY MX3 1 LX3 XCODEL FAKE GVAR CODE FOR THIRD ARG EQ PACKC3 * * RESTORE WORDPT AND PROCESS CHAR COUNT DESTINATION * PACKC2 SA1 OLDPT BX6 X1 SA6 WORDPT * CALL PUTCOMP NG B1,ERRSTOR MUST STORE INTO-ABLE BX3 X1 SAVE IT * * /--- BLOCK PACKC3 00 000 77/06/12 17.11 * * STORE THREE GVAR CODES IN *PCWORD* FOR NOW * PACKC3 SA1 VARBUF+1 CONDITIONAL EXPRESSION MX0 -XCODEL BX1 -X0*X1 MASK OFF TOP BIT * SA2 VARBUF+2 STRING DESTINATION NG X2,ERRSTOR CANNOT BE STORED INTO LX2 XCODEL+XCODEL PUT ON FAR LEFT SIDE * LX3 XCODEL PUT IN MIDDLE * BX6 X1+X2 NOW MERGE ALL THREE BX6 X6+X3 SA6 PCWORD * * DETERMINE STRING TERMINATOR * PACKC4 SA2 LASTKEY ZR X2,PACKC5 IF TERMINATOR IS END-OF-LINE * SA1 WORDPT POINTS JUST PAST LAST CHAR SA3 X1-2 CHAR PRECEDING LASTKEY SX4 X3-ACCESS NZ X4,PACKC5 IF ACCESS NOT PART OF TERMINATR * LX3 6 BX2 X2+X3 MERGE ACCESS+LAST CHAR * PACKC5 BX7 X2 SA7 TERMSAV AND STORE IT * * INITIALIZATIONS BEFORE MAIN LOOP * MX6 0 SA6 SHOWOUT INITIALIZE TAG TABLE COUNTER ZR X7,PLINE0 IF EOL TERMINATOR, NEXT LINE SA2 X1 GET LAST CHAR NZ X2,PLINE1 JUMP IF LINE NOT EXHAUSTED * * /--- BLOCK PACKC 00 000 76/07/25 08.46 * * BRINGS IN CONTINUATION LINE IF THERE IS ONE * PLINE0 SA1 NEXTCOM CHECK IF CONTINUATION SA2 COMCONT BX2 X1-X2 NZ X2,PCEND0 DONE PROCESSING IF NOT CONT. * CALL GETLINE READ IN NEXT LINE * * * MAIN LOOP. -PACKER- RETURNS'; B3=TABLE START, B2=LENGTH * * PLINE1 CALL PACKER EVALUATE NEXT CHAR STRING * SA1 SHOWOUT SX7 X1+1 INCREMENT SHOWOUT COUNTER SA7 SHOWOUT AND STORE INCREMENTED COUNTER * SX2 X1-100 LENGTH OF SHOWOUT = 100 WORDS PL X2,ERR2MNY TOO MANY TAGS * SX5 B3 START OF TABLE IN BOTTOM 12 BTS SX6 B2 LENGTH OF TABLE LX6 12 BX6 X5+X6 MERGE LENGTH + INDEX SA6 X7+SHOWOUT AND STORE ENTRY * * FIND OUT WHETHER IT NEEDS NEW LINE OR NOT * SA1 WORDPT SA2 X1 ZR X2,PLINE0 -PACKER- STOPPED ON EOL * SX7 X1+1 INCREMENT WORDPT SA2 X7 AND READ NEXT CHAR ZR X2,PLINE0 IF EMPTY, READ NEXT LINE SA7 WORDPT OTHERWISE, UPDATE WORDPT EQ PLINE1 * * * /--- BLOCK PACKC 00 000 76/07/25 08.47 * * ALL DONE'; STORE FIRST WORD OF TABLE, AND COMMAND WORD * PCEND0 SA1 PCWORD LX1 XCODEL+XCODEL GET COND. EXPR. ON TOP MX0 XCODEL BX6 X0*X1 AND PUT IT INTO X6 SA2 SHOWOUT BX7 X6+X2 MERGE GVAR + NUMBER OF ENTRIES SA2 INX SA7 X2+INFO STORE AS 1ST WORD OF TABLE SX7 X2+1 INCREMENT XSTOR POINTER SA7 INX * BX1 X1-X6 REMOVE GVAR CODE FROM CMND WD. LX1 XCODEL AND RESTORE WORD LX2 XCMNDL MERGE WITH LOC OF TABLE BX6 X1+X2 SA6 PCWORD AND STORE IT AGAIN * * NOW PUT TAG TABLE INTO XSTORAGE * SA1 ICX SA0 X1-1 MARKER FOR END OF UNIT SA1 SHOWOUT LOAD NUMBER OF ENTRIES ZR X1,ERR2FEW NOTHING THERE MX6 0 SA6 X1+SHOWOUT+1 CLEAR LAST WORD SB4 X1-1 B4=END TEST SA2 INX SB2 X2 B2=INDEX INTO XSTORAGE SA2 SHOWOUT-1 A2=INDEX INTO SHOWOUT BUFFER * * PCEND1 SA2 A2+2 LX2 30 SA3 A2+1 BX6 X2+X3 MERGE TWO TABLE ENTRIES SA6 B2+INFO B2 IS INDEX INTO XSTOR * SX3 A0-B2 NG X3,LNGUNIT * SB2 B2+1 INCREMENT POINTER INTO SHOWOUT SB4 B4-2 DECREMENT END TEST PL B4,PCEND1 AND LOOP BACK * * SX6 B2 SA6 INX UPDATE XSTOR POINTER * SA1 PCWORD BX6 X1 EQ PUTCODE DONE * * * /--- BLOCK PACKER 00 000 78/11/02 11.27 * * PACKER EVALUATES LAST TAG (TEXT) OR CONTINUATION LINE'; * RETURNS START OF TABLE IN B3, LENGTH IN B2 * * * TABLE ENTRIES'; 30 BITS APIECE'; * * FOR PACK, FIRST ENTRY IS NUMBER OF ENTRIES ( NOT SO,PACKC) * * * FOR TEXT'; * BOTTOM 12 BITS'; INDEX OF TEXT IN XSTORAGE * NEXT 6 BITS '; 0 ( AS FLAG THAT THIS IS TEXT ) * NEXT 9 BITS '; LENGTH OF TEXT * FOR SHOWS'; * BOTTOM 12 BITS'; INDEX OF GETVAR CODES IN XSTORAGE * NEXT 6 BITS '; TYPE OF SHOW (1 TO 6) * NEXT 6 BITS'; NUMBER OF GETVAR CODES IN XSTOR WORD * * GETVAR CODES IN XSTORAGE ARE THREE PER WORD * SIGN BIT ON MEANS GETVAR ENTITY CAN BE STORED INTO * NOTE ASSUMPTION THAT SHOW COMMANDS HAVE NO MORE * THAN THREE ARGUMENTS * * * OVARG1 = 0 (PACK), 1 (PACKC), 2 (SAY), 3 (SAYC) * PACKER EQ * MX6 0 SA6 VARBUF INITIALIZE ^$ OF ENTRIES * PL SA1 INX INX IS BUFFER SB2 X1 B2= XSTORAGE POINTER SB3 B0 B3= WORD COUNT SA1 WORDPT SX7 X1-1 X7= WORDPT POINTER SA1 OVARG1 MX0 59 BX0 -X0*X1 X0=0 (PACK,SAY), =1 (PACKC, SAYC) SA1 TERMSAV X1= TERMINATOR (FOR PACKC) SA2 ICX SA0 X2-1 A0= END OF UNIT SB7 1 B7=FONT FLAG, 1=NORM,-1=ALT * * /--- BLOCK PL0 00 000 78/11/01 11.17 * * NOW FOR MAIN LOOP * PL0 MX6 0 X6= WORD BUILDING VAR SB1 60 B1= SHIFT COUNTER * * PL1 SX7 X7+1 NEXT CHARACTER SA2 X7 X2=NEXT CHARACTER ZR X2,PEOL FOUND END OF LINE * * ZR X0,PL1B FOLLOWING CHECKS FOR TERMINATOR BX3 X1-X2 CHECK FOR SINGLE CHAR TERMNTR ZR X3,PEOL FOUND TERMINATOR * * PL1B SX3 X2-FONT CHECK FOR FONT NZ X3,PL1C SB7 -B7 FLIP FONT FLAG * PL1C SX3 X2-ACCESS START CHECK FOR EMBEDS NZ X3,PL2 SA3 X7+1 * NG B7,PL1D DO NOT CHECK FOR ^0 IN ALT.FONT * SX4 X3-1R0 LEFT EMBED SYMBOL ZR X4,PEMBED FOUND EMBED SYMBOL * PL1D ZR X0,PL2 FOR PACKC ONLY SX4 X2 COPY LX4 6 MOVE ACCESS OVER BX4 X3+X4 MERGE ACCESS + NEXT CHAR BX4 X4-X1 COMPARE WITH 2-CHAR TEMINATOR NZ X4,PL2 FOUND TERMINATOR'/ SX7 X7+1 INCREMENT WORDPT EQ PEOL * * PL2 SB1 B1-6 SHIFT COUNT LX2 X2,B1 SHIFT KEY OVER BX6 X2+X6 MERGE WITH WORD BUFFER NZ B1,PL1 GET NEXT KEY IF WORD NOT DONE * SX3 A0-B2 AT END OF UNIT'/ NG X3,LNGUNIT * SA6 B2+INFO STORE COMPLETED TEXT WORD SB2 B2+1 INCREMENT XSTOR POINTER SB3 B3+1 INCREMENT WORD COUNT EQ PL0 END OF MAIN LOOP * * * /--- BLOCK PEMBED 00 000 76/07/25 08.47 * * HIT EMBED SYMBOL'; PROCESS WHATEVER IS INSIDE * PEMBED SX7 X7+2 UPDATE WORDPT SA7 WORDPT CALL PTEXT UPDATES CURRENT TEXT * CALL NXTNAME GET TAG OF EMBED (RETURNS X6) ZR X6,BADEMB IF NO TAG SB4 0 LOOP COUNTER MX0 42 FIRST MASK MX1 6 SECOND MASK * * FIND MATCH IN SHOW TABLE OF FIRST TAG * PE2 SA2 PACKLST+B4 READ NEXT ENTRY ZR X2,BADEMB IF NO MATCH BX3 X0*X2 MASK OFF TOP 7 CHARS BX3 X6-X3 AND COMPARE WITH NXTNAM ZR X3,PE3 LX2 54 TAKE A LOOK AT BOTTOM CHAR BX2 X1*X2 MASK OFF ONE CHAR BX2 X6-X2 AND MATCH IT ZR X2,PE3 SB4 B4+1 EQ PE2 * * /--- BLOCK PE3 00 000 78/11/02 13.49 * PE3 SX6 B4+1 *SHOW* CODE FOR TABLE SA6 PSHOW SX6 0 GETVAR COUNT SA6 PCODES SA6 PTEMP GETVAR CODES SX6 60 SHIFT COUNT SA6 PSHFT * * PE4 CALL COMPILE EVALUATE NEXT TAG * SA2 LASTKEY ZR X2,ERRTERM HIT EOL INSTEAD OF R. EMBED * MX0 -XCODEL MASK BX2 -X0*X1 MASK OFF GETVAR CODE * ZR B1,PE5 WAS EXPRESSION STORABLE'/ MX1 1 LX1 XCODEL SET TOP BIT OF GVAR CODE BX2 X2+X1 AS A FLAG * PE5 SA1 PCODES GETVAR COUNTER SX6 X1+1 AND UPDATE IT SA6 PCODES * SA1 PSHFT SHIFT COUNTER SX6 X1-XCODEL UPDATE IT SB1 X6 AND SAVE IT IN B1 NG B1,ERRTAGS MORE THAN 3 TAGS SA6 PSHFT * SA1 PTEMP CONTAINS GETVAR CODES LX6 X2,B1 SHIFT CURRENT GETVAR CODE BX6 X6+X1 AND MERGE WITH OLD GVAR CODES SA6 A1 * * SA1 WORDPT CHECK IF HIT R. EMBED OR NOT SA2 X1-2 BACK UP TWO CHARS SX2 X2-ACCESS NZ X2,PE4 NEXT TO LAST SYMBOL NOT EMBED SA2 X1-1 SX2 X2-1R1 CHECK FOR ACCESS 1 (RT. EMBED) NZ X2,PE4 IF CHECKS, THEN DONE * * MAKE TABLE ENTRY FOR *SHOW* * SA1 PTEMP BX6 X1 SA1 INX SA6 X1+INFO ADD GETVAR CODES TO CM ARGS SX6 X1+1 INCREMENT CM ARG POINTER SA6 A1 * SX6 X1 BOTTOM 12 BITS'; ADDR OF GVARS * SA1 PSHOW NEXT 6 BITS'; TYPE OF SHOW LX1 12 BX6 X1+X6 * SA1 PCODES NEXT 6 BITS'; NUMBR OF GVARS LX1 12+6 BX6 X1+X6 * SA1 VARBUF SX7 X1+1 INCREMENT NUMBER OF TABLE ENTRY SA7 VARBUF * SA6 X7+VARBUF NOW WRITE WORD TO TABLE * SX1 X7-VARBUFL+2 PL X1,ERR2MNY MAKE SURE TABLE DOESNT OVERFLOW EQ PL * * /--- BLOCK PEOL 00 000 76/05/26 16.27 * * REACHED END OF LINE, OR TERMINATOR (FOR PACKC)'; PUT * VARBUF TABLE INTO XSTORAGE, TWO PER WORD * EXPECTS X0= PACKC FLAG, A0 = END OF UNIT MARKER * AND B2= XSTORAGE POINTER * PEOL SA7 WORDPT UPDATE WORDPT CALL PTEXT UPDATE TEXT * SA1 VARBUF LOAD NUMBER OF ENTRIES ZR X1,PO4 NOTHING HERE MX6 0 SA6 X1+VARBUF+1 CLEAR LAST WORD SB3 B2 B3= START OF TABLE SB4 X1 B4= END TEST SA2 VARBUF-2 A2= INDEX INTO VARBUF BUFFER * ZR X0,PO3 -PACK- COMMAND SA2 A2+1 DO NOT RETURN LENGTH SB4 B4-1 IN FIRST TABLE ENTRY * * PO3 SA2 A2+2 LX2 30 SA3 A2+1 BX6 X2+X3 MERGE TWO TABLE ENTRIES * SA6 B2+INFO B2= INDEX INTO XSTORAGE * SX3 A0-B2 STILL IN UNIT'/ NG X3,LNGUNIT * SB2 B2+1 SB4 B4-2 DECREMENT END TEST PL B4,PO3 AND LOOP BACK * * SX6 B2 UPDATE XSTOR POINTER SA6 INX * PO4 SA1 VARBUF GET NUMBER OF ENTRIES SB2 X1 EQ PACKER DONE * * * BAD FORMAT SPECIFICATION * BADEMB SB1 154 EQ =XERR * * * /--- BLOCK PTEXT 00 000 78/09/12 00.28 * * STORES LAST TEXT WORD, UPDATES TABLE ENTRY * * ENTERS WITH X6=LAST TEXT WD, B3=WORD CNT, B2=XSTORAGE INDX * A0= END OF UNIT MARKER, X0 = PACKC FLAG * PTEXT EQ * ZR X6,PT0 JUMP IF CURRENT WORD EMPTY * SX4 A0-B2 AT END OF UNIT'/ NG X4,LNGUNIT * SA6 B2+INFO DUMP CURRENT WORD INTO XSTOR SB2 B2+1 UPDATE XSTOR COUNTER SB3 B3+1 UPDATE WORD COUNTER * PT0 ZR B3,PT1 NO TEXT HERE SA1 VARBUF UPDATE NUMBER OF TABLE ENTRIES SX6 X1+1 SA6 A1 * SA1 INX BEGINNING INDEX OF TEXT SX2 B3 NUMBER OF WORDS OF TEXT LX2 12+6 BX7 X1+X2 MERGE INDEX AND LENGTH SA7 X6+VARBUF AND PUT INTO TABLE * SX1 X6-VARBUFL+2 PL X1,ERR2MNY MAKE SURE TABLE DOESNT OVERFLOW * PT1 SX6 B2 UPDATE XSTOR POINTER SA6 INX * EQ PTEXT * * PACKLST VFD 42/0LSHOWZ,18/1RZ VFD 42/0LSHOW,18/1RS VFD 42/0LSHOWT,18/1RT VFD 42/0LSHOWO,18/1RO VFD 42/0LSHOWE,18/1RE VFD 42/0LSHOWA,18/1RA VFD 42/0LSHOWH,18/1RH VFD 42/0LHIDDEN,18/0 VFD 42/0LSHOWK,18/1RK ZR DATA 0 * PCWORD BSS 1 COMMAND WORD PCODES BSS 1 NUMBER OF GETVAR CODES PSHFT BSS 1 SHIFT COUNT PSHOW BSS 1 SHOW CODE PTEMP BSS 2 TEMPORARIES TERMSAV BSS 1 SAVE TERMINATOR CODE(S) * * ENDOV * /--- BLOCK SETDAT 00 000 76/07/25 08.49 * TITLE -SETDAT- COMMAND * * SET VALUE OF STUDENT DATA RESERVED WORD * SETDAT WORD_EXPRESSION * SETROV OVRLAY CALL NXTNAME GET TAG **** * RETURNS TAG ENTRY IN X6, * SEPARATOR IN X1, SEPARATOR TYPE IN X2 SX1 X1-KASSIGN CHECK FOR ASSIGN ARROW NZ X1,ERRTERM IF NOT GIVE CONDENSE ERROR MX0 6*7 BX2 -X0*X6 CHECK FOR OVER 7 CHARS NZ X2,ERRNAME SA6 ENDLST PLANT END TEST FOR SEARCH SA2 RSVLST-1 INITIALIZE SEARCH RSV100 SA2 A2+1 IX3 X6-X2 NZ X3,RSV100 SB1 A2-ENDLST ZR B1,ERRNAME NOT FOUND IN LIST SB1 A2-RSVLST COMPUTE INDEX IN LIST SX7 B1 STORE INDEX IN LIST SA7 SRTEMP CALL COMPILE GET VALUE OF NEXT ARGUMENT MX0 -XCODEL BX6 -X0*X1 ONLY GETVAR CODE LX6 60-2*XCODEL SA1 SRTEMP PICK UP WORD NUMBER SX1 X1 LIMIT TO 18 BITS LX1 60-XCODEL PUT IN TOP BITS BX6 X6+X1 COMBINE WITH GETVAR CODE EQ PUTCODE * RSVLST DATA 7LAARROWS DATA 3LAOK DATA 6LAOKIST DATA 4LASNO DATA 4LAUNO DATA 5LAHELP DATA 6LAHELPN DATA 5LATERM DATA 6LATERMN DATA 5LAAREA DATA 5LATIME ENDLST BSS 1 * SRTEMP BSS 1 * ENDOV * /--- BLOCK SUBMITM 00 000 80/12/15 22.22 TITLE -SUBMITM- / -SUBMITX- COMMANDS * * * * -SUBMITM- COMMAND * 1ST ARGUMENT = MAIN-FRAME NUMBER * 2ND = ACCOUNT NAME * 3RD = FILE NAME * 4TH = BLOCK NAME * 5TH (OPT) = SECURITY INFORMATION BUFFER * * -SUBMITX- COMMAND * 1ST ARGUMENT = MAIN-FRAME NUMBER * 2ND = CONTROL CARD BUFFER * 3RD = LENGTH OF CONTROL CARD BUFFER * 4TH = (UNUSED) * 5TH (OPT) = SECURITY INFORMATION BUFFER * * SUBMOV OVRLAY CALL VARDO1 GET MAINFRAME ARGUMENT SX6 0 PRE-ZERO 4TH AND 5TH ARGUMENTS SA6 VARBUF+4 SA6 VARBUF+5 SA1 OVARG1 NZ X1,SUBMITX --- JUMP IF SUBMITX * * -SUBMITM- COMMAND * CALL ACCFILE,VARBUF+2,0 ZR X1,ERR2FEW CALL COMPNAM GET BLOCK NAME BX6 X1 SA6 VARBUF+4 EQ SECURE * * -SUBMITX- COMMAND * SUBMITX CALL VARDO2 CONTROL CARD BUFFER NG X6,ERRSTOR --- ERROR IF NOT STOREABLE CALL VARDO2 BUFFER LENGTH * * * CHECK FOR SECURITY INFORMATION BUFFER ARGUMENT * SECURE SX6 4 4 ARGUMENTS SO FAR SA6 VARBUF SA1 LASTKEY ZR X1,SBMEND --- IF END OF LINE CALL VARDO2 NG X6,ERRSTOR --- ERROR IF NOT STOREABLE SA1 LASTKEY NZ X1,ERR2MNY * SBMEND SX6 5 5 ARGUMENTS SA6 VARBUF BX1 X6 EQ VARFIN ENDOV * * * /--- BLOCK FINDS 00 000 76/08/29 21.54 * * TITLE -FINDS-/-FINDSA- COMMAND READINS * * -FINDS- * * READIN IS MODIFIED FROM -SORT- COMMAND READIN * * COMMAND WORD CONSISTS OF'; * 6 BITS TYPE'; 0 N,NC VAR * 1 ECS COMMON VAR * 2 ECS STORAGE VAR * *XCODEL* BITS LIST GETVAR CODE'; ADDRESS IN CM/ECS * 12 BITS POSITION OF EXTRA GETVAR CODES IN XSTORAGE * * 3 WORDS OF EXTRA STORAGE GVAR CODES'; * OBJECT,LENGTH,INCREMENT,1STBIT,NUMBITS,RETURN,MASK * * * FINDS OBJECT,LIST;LTH,INC,1ST BIT,NUM BITS,RETURN,MASK * FINDSA OBJECT,LIST;LTH,INC,1ST CHAR,NUM CHARS,RETURN,MASK * * NOTE THAT ONLY THE LAST ARGUMENT, *MASK*, IS OPTIONAL * * NOTE ALSO THAT TOP BIT OF OBJECT GETVAR CODE IS SET IF * IT IS NON-STORABLE * * FINDSOV OVRLAY * CALL VARDO1 EVALUATE OBJECT GVAR CODE * SA1 WORDPT SAVE *WORDPT* BX6 X1 SA6 OLDPT * MX6 0 SA6 VARBUF+7 INITIALIZE MASK ENTRY * * EVALUATE LIST TYPE / LOCATION * CALL NXTNAM GET FIRST ENTRY SX0 X1-1R, NZ X0,FIND150 JUMP IF MAY BE CM BUFFER MX0 42 SA1 FINDLST-1 SET UP FOR BUFFER TYPE SEARCH * FIND110 SA1 A1+1 LOAD NEXT LIST ENTRY ZR X1,FIND150 CHECK IF CM BUFFER BX2 X0*X1 MASK OFF BUFFER TYPE NAME IX2 X2-X6 COMPARE WITH NXTNAM RETURN NZ X2,FIND110 LOOP BACK * * PROCESS HERE IF FORM -FINDS S,3;- OR -FINDS C,10;- * SX6 X1 PICK UP BUFFER TYPE NAME LX6 60-6 AND LEFT-JUST IT SA6 FINDWK * CALL COMPILE EVALUATE POSITION EXPRESSION LX1 60-6-XCODEL POSITION GVAR CODE * SA2 FINDWK BX6 X1+X2 MERGE TYPE/POSITION SA6 A2 STORE IT * SA1 LASTKEY MUST END WITH SEMI-COLON SX0 X1-KSEMIC ZR X0,FIND200 EQ ERRTERM SEMICOLON NOT FOUND * /--- BLOCK FINDS 00 000 76/09/12 21.14 * * PROCESS HERE IF OF FORM -FINDS N1;- OR -FINDS NC1;- * FIND150 SA1 OLDPT RESTORE WORDPT BX6 X1 SA6 WORDPT * CALL COMPILE EVALUATE BUFFER EXPRESSION NZ B1,ERRSTOR ERROR IF NOT STORABLE LX1 60-6-XCODEL POSITION GVAR CODE * BX6 X1 SA6 FINDWK AND STORE IT * SA1 LASTKEY MUST END WITH SEMI-COLON SX0 X1-KSEMIC NZ X0,ERRTERM SEMI-COLON NOT FOUND * * * PROCESS REMAINING ARGUMENTS * FIND200 CALL VARDO2 LENGTH CALL VARDO2 INCREMENT CALL VARDO2 1ST BIT CALL VARDO2 NUM BITS * CALL PUTCOMP *RETURN* NG B1,ERRSTOR MUST BE STORABLE BX6 X1 STORE CODE IN VARBUF SA6 VARBUF+6 SX6 6 INCREMENT VARBUF SA6 VARBUF * SA1 LASTKEY SEE IF ANOTHER ARGMUENT ZR X1,FIND210 NO MORE ARGUMENTS CALL VARDO2 GET MASK GETVAR CODE * SA1 VARBUF+7 MX0 -XCODEL BX1 -X0*X1 GIVE ERROR IF MASK IS ZERO ZR X1,ERRORC * SA1 LASTKEY NZ X1,ERR2MNY TOO MANY TAGS * FIND210 SA1 VARBUF+1 FETCH OBJECT GVAR CODE MX0 1 SET TOP BIT IF NOT STORABLE BX2 X0*X1 GET TOP BIT LX2 XCODEL BX6 X1+X2 AND MERGE WITH GVAR CODE SA6 VARBUF+1 * * /--- BLOCK FINDS 00 000 76/09/12 21.09 * * NOW STORE ALL GVAR CODES AND WRAP IT UP * SA1 INX GET INDEX IN EXTRA STORAGE BX6 X1 X1 = INX LX6 60-6-XCODEL-12 POSITION XSTOR INDEX SA2 FINDWK BX6 X2+X6 X6 = COMMAND WORD MX0 -XCODEL X0 = XCODEL MASK * SA2 VARBUF+1 OBJECT GVAR CODE SA3 VARBUF+2 LENGTH GVAR CODE SA4 VARBUF+3 INCREMENT GVAR CODE * BX2 -X0*X2 MASK OFF BX3 -X0*X3 BX4 -X0*X4 * LX2 60-1*XCODEL AND POSITION THEM LX3 60-2*XCODEL LX4 60-3*XCODEL * BX7 X2+X3 NOW MERGE AND STORE BX7 X7+X4 SA7 X1+INFO STORE * SA2 VARBUF+4 1ST BIT GVAR CODE (1ST CHAR) SA3 VARBUF+5 NUM BITS GVAR CODE (NUM CHARS) SA4 VARBUF+6 *RETURN* GVAR CODE * BX2 -X0*X2 MASK BX3 -X0*X3 BX4 -X0*X4 * LX2 60-1*XCODEL POSITION LX3 60-2*XCODEL LX4 60-3*XCODEL * BX7 X2+X3 MERGE AND STORE BX7 X7+X4 SA7 X1+INFO+1 * SA2 VARBUF+7 FIND MASK GVAR CODE BX7 -X0*X2 MASK MASK CODE (HEHE) LX7 60-XCODEL POSITION IT SA7 X1+INFO+2 STORE * SX7 X1+3 INCREMENT INX POINTER SA7 INX SA1 ICX IX1 X7-X1 CHECK FOR UNIT BUFFER OVERFLOW PL X1,LNGUNIT EQ PUTCODE EXIT * * FINDLST IS USED BY FINDS,FINDSA,INSERTS,DELETES * FINDLST VFD 42/0LSTORAGE,18/2 VFD 42/0LS,18/2 VFD 42/0LCOMMON,18/1 VFD 42/0LC,18/1 DATA 0 * FINDWK BSS 1 * ENDOV * /--- BLOCK INSERTS 00 000 77/01/11 17.12 * TITLE -INSERTS- COMMAND * * READIN IS MODIFIED FROM -SORT- COMMAND READIN * *INSERTS BUFFER,LIST;LENGTH,INCREMENT,POSIT,NUMBER (OPT.) * BUFF2,LIST2;INC2 * * COMMAND WD'; 6 BITS LIST TYPE CODE * 20 BITS LIST GVAR CODE * 12 BITS XSTOR POSIT OF GVAR CDS * 6 BITS ASSOC. LIST TYPE CODE * * TYPE CODE IS 0=CM,1=ECS COMMON,2=ECS STORAGE * ASSOCIATED LIST TYPE CODE IS SAME AS ABOVE, EXCEPT TOP * BIT OF 6 BIT CODE IS SET AS FLAG THAT THERE IS ASSOC. LIST * *XSTOR GETVAR WORDS (3) * * WD1'; BUFFER,LENGTH,INCREMENT * WD2'; POSIT,NUMBER,BUFFER2 * WD3'; LIST2,INCREMENT2 * * INSRTOV OVRLAY * SA1 OVARG1 NZ X1,DELETOV FOR -DELETES- COMMAND * CALL VARDO1 EVALUATE OBJECT GVAR CODE SA1 VARBUF+1 NG X1,ERRSTOR BUFFER MUST BE LOCATION CALL SLINE1 EVALUATE REST OF LINE * * SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED BX2 X1-X2 NZ X2,INSRT10 NOT CONTINUED * CALL GETLINE GET NEXT LINE OF TEXT SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED BX2 X1-X2 ZR X2,ERRCNTD ERROR IF CONTINUED FURTHER * * CALL VARDO2 EVALUATE ASSOC. LIST OBJECT SA1 VARBUF SA1 X1+VARBUF NG X1,ERRSTOR BUFFER MUST BE LOCATION CALL SLINE2 EVALUATE REST OF ASSOC. LIST * INSRT10 EQ LSTFIN STORE GVAR CODES AND WRAP UP * * /--- BLOCK DELETES 00 000 77/01/11 17.15 * TITLE -DELETES- COMMAND * * READIN IS MODIFIED FROM -SORT- COMMAND READIN * *DELETES LIST;LENGTH,INCREMENT,POSIT,NUMBER (OPT.) * LIST2;INC2 * * COMMAND WD'; 6 BITS LIST TYPE CODE * 20 BITS LIST GVAR CODE * 12 BITS XSTOR POSIT OF GVAR CDS * 3 BITS 0 * 6 BITS ASSOC. LIST TYPE CODE * 9 BITS COMMAND NUMBER * * TYPE CODE IS 0=CM,1=ECS COMMON,2=ECS STORAGE * ASSOCIATED LIST TYPE CODE IS SAME AS ABOVE, EXCEPT TOP * BIT OF 6 BIT CODE IS SET AS FLAG THAT THERE IS ASSOC. LIST * *XSTOR GETVAR WORDS (3) * * WD1'; 0,LENGTH,INCREMENT * WD2'; POSIT,NUMBER,0 * WD3'; LIST2,INCREMENT2 * * THE 0 GETVAR CODES ARE SO FORMAT IS EXACTLY LIKE THE * -INSERTS- COMMAND * * * DELETOV SX6 1 SA6 VARBUF INCREMENT VARBUF CAUSE NO BUFF MX6 0 SA6 A6+1 ZERO BUFFER GVAR CODE CALL SLINE1 EVALUATE FIRST LINE * * SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED BX2 X1-X2 NZ X2,DELET10 NOT CONTINUED * CALL GETLINE GET NEXT LINE OF TEXT SA1 NEXTCOM SA2 COMCONT SEE IF CONTINUED BX2 X1-X2 ZR X2,ERRCNTD ERROR IF CONTINUED FURTHER * * SA1 VARBUF SX6 X1+1 INCREMENT VARBUF (NO BUFF2) SA6 VARBUF MX7 0 SB1 A6 SA7 X6+B1 STORE ZERO AS GVAR CODE CALL SLINE2 EVALUATE REST OF ASSOC. LIST * DELET10 EQ LSTFIN STORE XSTOR GVARS AND WRAP UP * * /--- BLOCK INSERTS-1 00 000 77/03/30 22.24 TITLE -INSERTS- ROUTINES * * PROCESS FIRST LINE OF INSERTS AND DELETES COMMANDS * SLINE1 EQ * * SA1 WORDPT BX6 X1 SA6 OLDPT SAVE WORDPT * CALL NXTNAM GET FIRST ENTRY SX0 X1-1R, NZ X0,SLIN150 JUMP IF MAY BE CM BUFFER MX0 42 SA1 INSTLST-1 SET UP FOR BUFFER TYPE SEARCH * SLIN110 SA1 A1+1 LOAD NEXT ENTRY ZR X1,SLIN150 CHECK IF CM BUFFER BX2 X0*X1 MASK OFF BUFFER TYPE NAME IX2 X2-X6 NZ X2,SLIN110 * SX6 X1 PICK UP BUFFER TYPE CODE LX6 60-6 SA6 CMNDWD STORE FOR NOW CALL COMPILE EVALUATE POSITION EXPRESSION LX1 60-6-XCODEL POSITION GVAR CODE SA2 CMNDWD BX6 X1+X2 MERGE TYPE/POSITION SA6 A2 SA1 LASTKEY MUST END WITH SEMICOLON SX0 X1-KSEMIC ZR X0,SLIN200 EQ ERRTERM * * SLIN150 SA1 OLDPT RESTORE WORDPT BX6 X1 SA6 WORDPT CALL COMPILE EVALUATE BUFFER EXPRESSION NZ B1,ERRSTOR ERROR IF NOT STORABLE BX6 X1 LX6 60-6-XCODEL POSITION GVAR CODE SA6 CMNDWD SAVE SA1 LASTKEY MUST END WITH A SEMI-COLON SX0 X1-KSEMIC NZ X0,ERRTERM * * PROCESS REMAINING ARGUMENTS * SLIN200 CALL VARDO2 LENGTH OF LIST CALL VARDO2 INCREMENT OF EACH ENTRY CALL VARDO2 POSITION TO ADD SA1 LASTKEY NZ X1,SLIN201 GET LAST ARGUMENT * SA1 VARBUF SX6 X1+1 INCREMENT VARBUF (NO NUMBER) SA6 VARBUF SX7 1 DEFAULT OF 1 ITEM TO INSERT SB1 A6 SA7 X6+B1 STORE ZERO FOR NUMBER EQ SLINE1 DONE * * SLIN201 CALL VARDO2 GET NUMBER GVAR CODE SA1 LASTKEY NZ X1,ERR2MNY TOO MANY TAGS EQ SLINE1 * * * /--- BLOCK INSERTS-2 00 000 76/09/13 13.45 * * PROCESS THE SECOND LINE FOR INSERTS AND DELETES * SLINE2 EQ * * SA1 WORDPT SAVE WORDPT BX6 X1 SA6 OLDPT * CALL NXTNAM GET FIRST ENTRY SX0 X1-1R, NZ X0,SLIN250 JUMP IF MAY BE CM BUFFER MX0 42 SA1 INSTLST-1 SET UP FOR BUFFER TYPE SEARCH * SLIN220 SA1 A1+1 LOAD NEXT LIST ENTRY ZR X1,SLIN250 CHECK IF CM BUFFER BX2 X0*X1 MASK OFF BUFFER TYPE NAME IX2 X2-X6 NZ X2,SLIN220 * SX6 X1+40B PICK UP BUFFER TYPE CODE LX6 XCMNDL SA1 CMNDWD PICK UP COMMAND WORD BX6 X1+X6 MERGE SA6 CMNDWD AND STORE CALL VARDO2 EVALUATE LOCATION ARGUMENT EQ SLIN260 * * SLIN250 SA1 OLDPT RESTORE WORDPT BX6 X1 SA6 WORDPT * SX6 40B SET BUFFER TYPE CODE LX6 XCMNDL MOVE OVER SA1 CMNDWD PICK UP COMMAND WORD BX6 X1+X6 MERGE SA6 CMNDWD AND STORE * CALL VARDO2 EVALUATE BUFFER EXPRESSION SA1 VARBUF SA1 X1+VARBUF LOAD BUFFER GETVAR CODE NG X1,ERRSTOR MUST BE STOREABLE * SLIN260 SA1 LASTKEY MUST END IWTH A SEMICOLON SX0 X1-KSEMIC NZ X0,ERRTERM * * EVALUATE ENTRY DIMENSION EXPRESSION * CALL VARDO2 EVALUATE DIMENSION EXPRESSION SA1 LASTKEY NZ X1,ERRTERM ERROR IF NOT END OF LINE EQ SLINE2 * * * * /--- BLOCK INSERTS-3 00 000 77/01/11 17.22 * * FINAL PROCESSING FOR INSERTS AND DELETES COMMANDS * LSTFIN SA1 INX GET INDEX IN EXTRA STORAGE BX6 X1 LX6 60-6-XCODEL-12 POSITION XSTOR INDEX SA2 CMNDWD BX6 X2+X6 X6 = PARTIAL COMMAND WORD * * PACK UP REMAINING GETVAR CODES * MX0 -XCODEL * SA2 VARBUF+1 LOAD BUFFER -GETVAR- CODE SA3 VARBUF+2 LOAD LENGTH -GETVAR- CODE SA4 VARBUF+3 LOAD INCREMENT -GETVAR- CODE BX2 -X0*X2 BX3 -X0*X3 BX4 -X0*X4 LX2 60-XCODEL POSITION -GETVAR- CODES LX3 60-2*XCODEL LX4 60-3*XCODEL BX7 X2+X3 COMBINE -GETVAR- CODES BX7 X4+X7 SA7 X1+INFO STORE 1ST XSTOR WORD * SA2 VARBUF+4 LOAD POSITION -GETVAR- CODE SA3 VARBUF+5 LOAD NUMBER -GETVAR- CODE SA4 VARBUF+6 LOAD ASSOC BUFF -GETVAR- CODE BX2 -X0*X2 BX3 -X0*X3 BX4 -X0*X4 LX2 60-XCODEL POSITION -GETVAR- CODES LX3 60-2*XCODEL LX4 60-3*XCODEL BX7 X2+X3 COMBINE -GETVAR- CODES BX7 X4+X7 SA7 X1+INFO+1 STORE 2ND XSTOR WORD * SA2 VARBUF+7 LOAD ASSOC LST -GETVAR- CODE SA3 VARBUF+8 LOAD ASSOC INCREMNT GETVAR CODE BX2 -X0*X2 BX3 -X0*X3 LX2 60-XCODEL POSITION -GETVAR- CODE LX3 60-2*XCODEL BX7 X2+X3 SA7 X1+INFO+2 AND STORE IT * SX7 X1+3 SA7 INX INCREMENT *INX* SA1 ICX IX1 X7-X1 CHECK FOR UNIT BUFFER OVERFLOW PL X1,LNGUNIT EQ PUTCODE EXIT * INSTLST VFD 42/0LSTORAGE,18/2 VFD 42/0LS,18/2 VFD 42/0LCOMMON,18/1 VFD 42/0LC,18/1 DATA 0 * CMNDWD BSS 1 PARTIAL COMMAND WORD * ENDOV * /--- BLOCK COVL3 00 000 80/10/01 03.12 TITLE COVL3 COMMAND READ-INS * * * COVL3 OVRLAY SA1 OVARG1 GET OVERLAY ARGUMENT SB1 X1 JP B1+*+1 JUMP TO APPROPRIATE COMMAND * + EQ INHIBC 0 = -INHIBIT- COMMAND + EQ FORCEIN 1 = -FORCE- COMMAND + EQ RANDUIN 2 = -RANDU- COMMAND + EQ RANDPIN 3 = -RANDP- COMMAND + EQ ANSVC 4 = -ANSV- COMMAND + EQ RESTIN 5 = -RESTART- COMMAND + EQ EXCHIN 6 = -EXCHANG- COMMAND + EQ STATSIN 7 = -STATS- COMMAND + EQ GETWDC 8 = -GETWORD- COMMAND + EQ GETLOCC 9 = -GETLOC- COMMAND + EQ SEARCHC 10 = -SEARCH- COMMAND + EQ COMPUIN 11 = -COMPUTE- COMMAND + EQ CALCSIN 12 = -CALCS- COMMAND + EQ CSLOOP 13 = *CSLOOP* ROUTINE + EQ COLORIN 14 = -COLOR- COMMAND + EQ CTIMEIN 15 = -CTIME-, -CDATE- COMMANDS * * * /--- BLOCK -INHIBIT- 00 000 79/01/05 01.47 TITLE -INHIBIT- COMMAND READ-IN * * * * -INHIBIT- COMMAND READ-IN * INHIBC SB1 HIBLIST SET UP ARGUMENTS SB2 HIBEND MX5 60 FULL WORD MASK CALL SCANNER SCAN INHIBIT NAME LIST NZ X0,ERRNAME SEE IF ANY ERROR * CHECK FOR SYSTEM-LESSON-ONLY KEYWORDS. SA1 SYSHIBS BX1 X1*X6 ZR X1,PUTCODE IF NO SYSTEM-LESSON-ONLY BITS * SYSTEM-LESSON-ONLY KEYWORDS SELECTED - MAKE SURE * THIS IS A SYSTEM LESSON. RJ SYSTEST EQ PUTCODE PURGMAC INHIB MACREF INHIB$ INHIB MACRO NAME,SYS MACREF INHIB + VFD 60/0L_NAME SYSHIB RMT SYSIF IFC EQ,*SYS** VFD 1/0 SYSIF ELSE VFD 1/1 SYSIF ENDIF SYSHIB RMT ENDM HIBLIST INHIB ERASE DONT DO FULL SCREEN ERASE INHIB ARROW DONT PLOT ARROW INHIB ANSERASE ANS CONTG WRITING ERASURE INHIB NEXT NEXT INHIB NOMOVE DONT MOVE ARROW UNTIL ANS OK INHIB BLANKS DISALLOW BLANK STUDENT INPUT INHIB CHARCLEAR DONT UNSET CHARSET FLAG ON -CHAR- COMMAND INHIB DROPSTOR DONT DROP XSTOR ON JUMPOUT INHIB UNLOAD DONT UNLOAD ON CON/STO LOAD INHIB LOAD DONT LOAD ON CON/STO LOAD INHIB JUMPCHK DONT DO ECS CHECK ON JUMPOUT INHIB EDIT DISABLE -EDIT- KEY FUNCTIONS INHIB FROM DONT SET *FROM* ON JUMPOUT INHIB TERM DISABLE -TERM- FUNCTIONS INHIB ADVANCE NO AUTO ADVANCE WHEN ARROW SATISFIED INHIB CLEAR CLEAR BEFORE SET INHIB DROPFILE DONT DROP DATASET/NAMESET INHIB DROPCOM DONT DROP COMMON INHIB DROPLIST,SYS DONT DROP LESLIST INHIB ARETURN,SYS DISABLE RETURNING TO ARROW HIBEND BSS 1 SCRATCH FOR SCANNER ROUTINE * SYSTEM-LESSON-ONLY FLAGS. SYSHIBS BSS 0 LIST G SYSHIB HERE LIST * * /--- BLOCK -INHIBIT- 00 000 81/07/22 20.52 * * * -FORCE- COMMAND READ-IN * SAME FORMAT AS -INHIBIT- BUT ENABLES RATHER THAN * DISABLES * FORCEIN SB1 FOLIST SB2 FOEND MX5 60 FULL WORD MASK RJ SCANNER ZR X0,PUTCODE SEE IF ANY ERROR EQ ERRNAME ELSE ERROR * FOLIST VFD 60/4LLONG FORCE JUDGING ON CHAR LIMIT VFD 60/4LFONT FORCE FONT AS CHAR 1 VFD 60/5LMICRO FORCE CONTINUOUS MICRO OPTION VFD 60/10LFIRSTERASE IF ANSWER WRONG, ERASE * ENTIRE INPUT WHEN NEXT CHARACTER IS ENTERED VFD 60/4LLEFT FORCE LEFT WRITING VFD 60/0LCLEAR CLEAR BEFORE SET VFD 60/0LBOLD FORCE BOLD WRITTING VFD 60/0LCAPS ALL CAPS FOEND BSS 1 * * /--- BLOCK -RANDU- 00 000 79/01/05 01.59 TITLE -RANDU- COMMAND READ-IN * * * * -RANDU- COMMAND READ-IN * IF ONE VARIABLE, SPECIFIES A VARIABLE * IN WHICH A RANDOM NUMBER IN (0,1) IS TO BE * STORED. IF TWO VARIABLES, THE FIRST IS * A STORAGE VARIABLE FOR AN INTEGER BETWEEN * ONE AND THE VALUE OF THE SECOND VARIABLE. * RANDUIN CALL PUTCOMP COMPILE FIRST TAG SA2 LASTKEY ZR X2,CALCODE DONE IF ONE TAG--CODE IN X1 BX6 X1 LX6 -XCODEL POSITION -PUTVAR- CODE SA6 VARBUF AND SAVE IT. CALL COMPILE COMPILE NEXT TAG RANDU1 SA2 LASTKEY *** ENTRY FROM RANDPIN NZ X2,ERR2MNY ERROR IF MORE THAN 2 TAGS SA2 VARBUF PREPARE COMMAND WORD LX1 -XCODEL-XCODEL BX6 X1+X2 WITH BOTH CODES SA1 COMNUM AND INCREMENTED COMMAND NUMBER SX1 X1+1 BX6 X6+X1 EQ ALTCODE * * * * -RANDP- COMMAND READ-IN * RANDPIN CALL PUTCOMP COMPILE FIRST TAG SA2 LASTKEY ZR X2,CALCODE DONE IF ONE TAG--CODE IN X1 BX6 X1 LX6 -XCODEL POSITION -PUTVAR- CODE SA6 VARBUF AND SAVE IT. CALL COMPILE COMPILE NEXT TAG NZ B1,ERRSTOR ERROR IF NON-STOREABLE EQ RANDU1 OTHERWISE FINISH COMPILING * * * /--- BLOCK -ANSV- 00 000 79/01/05 02.22 TITLE -ANSV- COMMAND READIN * * * * -ANSV- COMMAND READ-IN * ANSVC SA1 TAGCNT X1 = NUM CHARACTERS IN TAG ZR X1,ERR2FEW ERROR EXIT IF NO TAG SX6 0 SA6 APTSW PRE-SET TO ABS TOLERANCE SA2 TAG-1+X1 X2 = LAST CHARACTER SX3 X2-KPCT CHECK FOR PER CENT SIGN NZ X3,ANSVIN1 JUMP IF ABSOLUTE TOLERANCE MX7 0 SA7 A2 OVERWRITE PERCENT SIGN WITH EOL MX6 1 LX6 60-2*XCODEL SA6 A6 RE-SET TO PERCENT TOLERANCE ANSVIN1 SA1 OVARG2 CHECK FOR ANSU OR ANSV ZR X1,ANSVIN2 JUMP IF ANSV CALL COMPILU COMPILE UNIT DIMENSIONS EQ ANSVIN3 ANSVIN2 CALL COMPILE COMPILE WITHOUT UNIT DIMENSIONS ANSVIN3 SA2 LASTKEY LX1 60-XCODEL ZR X2,ANSVIN4 JUMP IF END OF LINE BX7 X1 SA7 VARBUF SAVE GETVAR CODE RJ COMPILE GET SECOND ARG (TOLERANCE) SA2 LASTKEY NZ X2,ERR2MNY TWO ARGS MAX SA2 VARBUF FIRST ARG LX1 60-2*XCODEL ANSVIN4 BX6 X1+X2 MERGE BOTH ARGS SA3 APTSW BX6 X6+X3 ADD ABS/PERCENT TOLERANCE FLAG SA1 OVARG2 ZR X1,PUTCODE JUMP IF ANSV BX6 X1+X6 MERGE COMMAND NUMBER SA1 NDEFU NUMBER OF UNITS DEFINED SB1 X1 SA1 ATEMPEC BX0 X1 SA0 UADS UNIT COEFFICIENTS + WE B1 RJ ECSPRTY SA1 INX SX7 X1+B1 INCREMENT INX SA7 A1 SA0 X1+INFO ADDRESS FOR UNIT COEFFS + RE B1 RJ ECSPRTY SX1 X1+1 INSURE NZ TO DISTINGUISH ANSU LX1 XCMNDL POSITION POINTER TO UNIT COEFFS BX6 X1+X6 MERGE WITH ARGS EQ ALTCODE * APTSW BSS 1 ABSOLUTE / PERCENT TOLER FLAG * * /--- BLOCK -RESTART- 00 000 80/02/02 23.45 TITLE -RESTART- COMMAND READ-IN * * * * -RESTART- COMMAND READ-IN * A. NO ARGS. MEANS USE CURRENT LESSON, CURRENT UNIT * B. ONE ARG. MEANS USE CURRENT LESSON, THIS UNIT * C. TWO ARGS. MEANS USE THIS LESSON, THIS UNIT * RESTIN CALL ACCFILE,VARBUF+1,0 ZR X1,=XPAUSE2 --- IF BLANK TAG SA2 LASTKEY NZ X2,REST2 --- IF MORE THAN ONE ARGUMENT * * SINGLE-ARGUMENT FORM (UNIT NAME ONLY) * SX0 X1-1 NZ X0,ERRTAGS ERROR IF ARGUMENT IS LESSON NAME SA2 VARBUF+2 LOAD GETVAR CODE LX2 60-XCODEL POSITION GETVAR CODE LX1 58 BX6 X1+X2 SET 2ND BIT OF GETVAR CODE EQ PUTCODE * * LESSON AND UNIT SPECIFIED * REST2 CALL COMPNAM GET UNIT NAME BX6 X1 SA6 VARBUF+3 SA1 LASTKEY NZ X1,ERR2MNY ERROR IF NOT END-OF-LINE SX6 3 SA6 VARBUF SET NUMBER OF ARGUMENTS BX1 X6 EQ VARFIN * * /--- BLOCK -STATS- 00 000 80/04/07 21.32 TITLE -STATS- COMMAND READ-IN * * * STATSIN CALL SYSTEST CALL VARDO1 GET TYPE OF STATISTICS SA2 LASTKEY SEE IF EOL NZ X2,STATS1 IF ACCOUNT';FILE PRESENT SA1 VARBUF+1 MX6 1 LX6 XCODEL BX6 X1+X6 SET TOP BIT IF ONLY ONE ARG. SA6 A1 SX1 1 ONE GETVAR CODE EQ =XVARFIN STATS1 CALL ACCFILE,(VARBUF+2),0 PROCESS ACCOUNT';FILE SA1 LASTKEY NZ X1,ERR2MNY ERROR IF NOT EOL SX6 3 SA6 VARBUF ADJUST NUMBER OF ARGUMENTS SX1 3 THREE GETVAR CODES EQ =XVARFIN * /--- BLOCK -EXCHANG- 00 000 80/05/15 20.20 TITLE -EXCHANG- COMMAND READ-IN * * * TAG ON -EXCHANG- COMMAND SPECIFIES IF THE * LOGICAL SITE CONTROLLER IS TO BE BYPASSED. * EXCHIN CALL SYSTEST SA1 LESSON SA2 KPLAT CHECK FOR LESSON -PLATO- BX2 X1-X2 ZR X2,EXCHANC SA2 KNPLAT BX2 X1-X2 CHECK FOR LESSON -NPLATO- NZ X2,ERRORC * EXCHANC MX6 0 PRESET X6 SA1 TAGCNT CHECK FOR BLANK TAG ZR X1,PUTCODE -- ASSUME BLANK = 0 EQ ONE2IN IN ',CONDC', EQ PUTCODE * KPLAT DATA 5LPLATO KNPLAT DATA 6LNPLATO * * * /--- BLOCK -GETWORD- 00 000 79/01/23 01.06 TITLE -GETWORD- COMMAND READ-IN * * * * -GETWORD- COMMAND READ-IN * GET THE N-TH WORD OUT OF THE STUDENT ANSWER * AND PUT INTO THE STATED BUFFER. * * GETWORD VAR1,VAR2,VAR3,VAR4 * VAR1 = WORD WANTED * VAR2 = ADDRESS TO PUT WORD PACKED 10 CHARS / WORD * VAR3 = RETURN ACTUAL CHARACTER COUNT * VAR4 = MAXIMUM ALLOWABLE NUMBER OF CHARACTERS * (IF ABSENT, SET TO DEFAULT 10) * GETWDC CALL VARDO GET COMMA SEPARATED VARS SA1 VARBUF+2 VAR2 MUST BE STORABLE NG X1,ERRSTOR SA1 VARBUF+3 DITTO FOR VAR3 NG X1,ERRSTOR SA1 VARBUF SEE IF RIGHT NUMBER OF ARGS SX2 X1-4 ZR X2,VARFIN GO TO STANDARD PACK-UP ROUTINE SX2 X1-3 SEE IF NEED TO GENERATE 4TH ARG NZ X2,ERRTAGS ALL ELSE AN ERROR IN FORM SX6 10 SET DEFAULT SMALL CONSTANT 10 SA6 VARBUF+4 AS FOURTH ARG SX6 4 AND RESET VARBUF TO 4 ARGS SA6 VARBUF BX1 X6 AND X1 ALSO SET TO 4 ARGS EQ VARFIN EXIT TO STANDARD PACK ROUTINE * * /--- BLOCK -GETLOC- 00 000 79/01/23 01.08 TITLE -GETLOC- COMMAND READ-IN * * * * -GETLOC- COMMAND READ-IN * GET THE SCREEN LOCATION OF STUDENT WORDS * * GETLOC ARG1,ARG2,ARG3,(ARG4,ARG5) * ARG1 = WORD WANTED * ARG2 = STARTING X * ARG3 = STARTING Y * ARG4 = ENDING X --OPTIONAL * ARG5 = ENDING Y --OPTIONAL * GETLOCC CALL VARDO GET COMMA SEPARATED VARS SA1 VARBUF+2 VAR2 MUST BE STORABLE NG X1,ERRSTOR SA1 VARBUF+3 DITTO FOR VAR3 NG X1,ERRSTOR SA1 VARBUF SEE IF RIGHT NUMBER OF ARGS SX2 X1-3 NZ X2,GETLC1 IF 3 ARGS MUST ADD DUMMY 2 MORE MX6 0 SA6 VARBUF+4 SA6 VARBUF+5 SX6 5 SA6 VARBUF BX1 X6 EQ VARFIN * GETLC1 SX2 X1-5 SEE IF ENDING LOCATION WANTED NZ X2,ERRTAGS ALL ELSE AN ERROR IN FORM SA2 VARBUF+4 VAR4 MUST BE STORABLE NG X2,ERRSTOR SA2 VARBUF+5 DITTO FOR VAR5 NG X2,ERRSTOR EQ VARFIN * * /--- BLOCK -SEARCH- 00 000 79/01/23 01.19 TITLE -SEARCH- COMMAND READ-IN * * * * -SEARCH- COMMAND READ-IN * * TAG HAS 6 (OR OPTIONALLY, 7) ENTRIES. * 1ST = OBJECT (LEFT-JUSTIFIED) * 2ND = OBJECT LENGTH IN CHARS * 3RD = BASE ADDRESS FOR SEARCH * 4TH = INFORMATION LENGTH IN CHARS * 5TH = STARTING CHAR FOR SEARCH (OFFSET FROM BASE) * 6TH = VARIABLE FOR STORAGE OF RETURN CODE-- * -1=NOT FOUND 1-N=FOUND STARTING AT CHAR N * 7TH = LENGTH OF RETURN LIST (REPEATED SEARCHES) * SEARCHC CALL VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+3 BASE ADDRESS NG X1,SCERR ERROR IF NOT STORE-ABLE SA1 VARBUF+6 CODE FOR RETURN VARIABLE NG X1,SCERR ERROR IF NOT STORE-ABLE SA1 VARBUF+1 CODE FOR STRING MX0 1 LX0 XCODEL-XFBIT BX6 -X0*X1 MASK OUT I/F BIT (SET INTEGER) SA6 A1 SX1 7 7 VARIABLES REQUIRED SA2 VARBUF X2 = NUMBER OF VARIABLES SX3 X2-6 NZ X3,VARFIN EXIT IF NOT 6 VARIABLES BX6 X1 SA6 A2 RESET VARIABLE COUNT TO 7 MX7 1 LX7 XCODEL PREPARE DUMMY CODE FOR 7TH ARG SA7 VARBUF+7 STORE AS 7TH ARGUMENT EQ VARFIN * SCERR SB1 70 NON-STOREABLE VARIABLE EQ ERR * * /--- BLOCK -COMPUTE- 00 000 79/07/15 15.19 TITLE -COMPUTE- COMMAND READ-IN * * * * -COMPUTE- COMMAND READ-IN * COMPUTE RESULT,STRING,CHAR COUNT,POINTER * (OPTIONAL) * * THE 4 TAG COMPUTE COMMAND IS SIMILAR TO A STORE COMMAND, * EXCEPT THE COMPILED MACHINE CODE IS SAVED IN AN ECS * BUFFER FOR LATER REUSE. POINTER IS SET TO POINT AT THIS * COMPILED CODE, AND SUCCEEDING EXECUTIONS OF THE COMPUTE * COMMAND WITH THIS POINTER WILL CAUSE SIMPLE FETCHES OF * THE MACHINE CODE FROM ECS. * * THE 3 TAG VERSION FUNCTIONS THE SAME AS THE 4 TAG VERSION, * EXCEPT THAT THE CODE IS NOT STORED FOR LATER REUSE. 'IT * PROVIDES A WAY OF EVALUATING EXPRESSIONS OUTSIDE OF JUDGE * STATE. COMPUIN CALL PUTCOMP DECODE FIRST VARIABLE BX6 X1 SA6 VARBUF+1 STORE FIRST -GETVAR- CODE SX6 1 SA6 VARBUF INITIALIZE *VARBUF* MX6 0 SA6 VARBUF+5 CALL VARDO2 DECODE REMAINING VARS CALL VARDO2 SA2 LASTKEY CHECK FOR E-O-L ZR X2,ONLY3 JUMP IF ONLY 3 ARGS CALL VARDO2 SA1 LASTKEY MUST BE END-OF-LINE NZ X1,ERR2MNY SB1 4 CHECK POINTER ADDRESS RJ JUSTAD CHECK FOR STORABILITY ALLDONE SB1 2 CHECK STRING ADDRESS RJ JUSTAD SX1 4 EQ VARFIN * ONLY3 SX6 4 SA6 VARBUF SET ARGUMENT COUNT IN VARBUF MX6 0 SET 4TH GETVAR CODE TO 0 TO SA6 VARBUF+4 INDICATE LACK OF 4TH ARGUMENT EQ ALLDONE * JUSTAD EQ * CHECK (VARBUF+B1) STORE-ABLE * AND CLEAN OUT I/F BIT, SINCE AT EXECUTION TIME WE NEED * ONLY THE ADDRESS, NOT THE VALUE. SA1 VARBUF+B1 GET THE CODE NG X1,ERRSTOR ERROR IF NOT STORE-ABLE MX6 61-XCODEL+XFBIT MASK OUT I/F BIT BX6 -X6*X1 SA6 A1 EQ JUSTAD * * * /--- BLOCK -CALCS- 00 000 80/10/01 04.18 TITLE -CALCS- COMMAND READ-IN * * * * -CALCS- COMMAND READ-IN * FOUR TO N VARS LEGAL * * EXAMPLE OF USAGE - * CALCS V2+2,V1= 5,7,V8 * V1 IS SET TO 5 IF (V2+2) IS NEQATIVE * V1 IS SET TO 7 IF (V2+2) IS ZERO * V1 IS SET TO V8 IF (V2+2) IS POSITIVE * CALCSIN CALL VARDO1 GET FIRST VAR SA1 WORDPT POINTER TO NEXT CHARACTER SX0 KASSIGN ACCEPT ASSIGNMENT AS TERMINATOR CALL PSCAN ZR X1,ERR2FEW ERROR IF END OF LINE SX6 1R, SA6 B1 REPLACE WITH COMMA CALL PUTCOMP DECODE VARIABLE TO STORE INTO BX6 X1 SA6 VARBUF+2 STORE -GETVAR- CODE SX6 2 SA6 VARBUF UPDATE NUMBER OF CODES * * -CSLOOP- * BUILD LIST OF EXPRESSIONS INTO *VARBUF*, ASSUMING * THAT 1) THE ARGUMENTS CAN BE BLANK, IN WHICH CASE * A SPECIAL BIT IS SET, AND 2) THE COMMAND MAY BE * CONTINUED ACROSS SOURCE LINES * * EXITS TO -VARFINM- WHEN DONE * CSLOOP CALL GETBARG GET (POSSIBLY BLANK) ARGUMENT NZ X3,CSLOOP AND LOOP WHILE ARGUMENTS FOUND ZR X2,CSNEXT GET NEW LINE IF E-O-L * * PUT DUMMY GETVAR CODE (1/1,19/0) INTO *VARBUF* * SA1 VARBUF SX6 X1+1 ADVANCE *VARBUF* POINTER SX1 X6-VARBUFL PL X1,ERR2MNY ERROR IF BUFFER FULL SA6 A1 MX7 1 SET UP SPECIAL GETVAR CODE LX7 XCODEL SA7 X6+VARBUF STORE IT EQ CSLOOP * CSNEXT SA1 NEXTCOM CHECK FOR CONTINUATION SA2 COMCONT BX3 X1-X2 NZ X3,CSEND JUMP IF NOT CONTINUED CALL GETLINE READ IN NEXT LINE EQ CSLOOP * CSEND SA1 VARBUF SX1 X1-3 MUST BE AT LEAST 3 VARS PL X1,VARFINM EQ ERR2FEW * * /--- BLOCK GETBARG 00 000 80/10/01 04.19 TITLE -GETBARG- GET POSSIBLY BLANK ARGUMENT * * -GETBARG- * READ NEXT EXPRESSION, WHICH MAY BE BLANK, AND * ASSEMBLE GETVAR CODE IN *VARBUF* IF PRESENT. * * ON ENTRY -- *WORDPT* SET * * ON EXIT -- X2 = NEXT CHARACTER (0 IF E-O-L) * X3 = 0 IF NO ARGUMENT COMPILED * * USES -- PRETTY MUCH EVERYTHING * GETBARG EQ * SX3 0 SET TO NO ARGUMENT COMPILED SA1 WORDPT X1 = POINTER TO NEXT CHARACTER GBA1 SA2 X1 X2 = NEXT CHARACTER ZR X2,GETBARG DONE IF E-O-L SX0 X2-1R IGNORE LEADING SPACES NZ X0,GBA2 SX1 X1+1 MOVE PAST SPACE EQ GBA1 AND CONTINUE * GBA2 SA3 X2+KEYTYPE SX0 X3-OPCOMMA CHECK FOR COMMA NZ X0,GBA3 COMPILE IT IF SOMETHING ELSE * SX6 X1+1 COMMA FOUND -- BLANK EXPRESSION SA6 A1 UPDATE *WORDPT* MX3 0 FLAG NO EXPRESSION FOUND EQ GETBARG -- EXIT * GBA3 CALL VARDO2 GET CODE FOR NEXT VARIABLE SA1 WORDPT SA2 X1 SET TO NEXT CHARACTER SX3 1 FLAG EXPRESSION COMPILED EQ GETBARG -- EXIT * * /--- BLOCK -CTIME- 00 000 80/10/01 03.05 TITLE -CTIME- COMMAND READIN * CONDENSE ROUTINE FOR -CTIME- (CODE = 180) * 1ST ARGS ARE INPUT PARAMETERS (UP TO 3) * 2ND ARG IS OUTPUT WORD TO HOLD RESULTS * 3RD ARG IS FORMAT FOR TRANSLATION (OPTIONAL) * 12=12 HOUR FORMAT * 24=24 HOUR FORMAT *** * THE FIRST GETVAR CODE CONTAINS NUMBER OF * INPUT PARAMETERS CTIMEIN SX6 1 SA6 VARBUF SET UP DUMMY FIRST ARGUMENT CALL VARDO2 GET FIRST REAL ARGUMENT CTIMES SA1 LASTKEY SX1 X1-KSEMIC (KSEMIC) = SEMI-COLON ZR X1,STORETC END OF INPUT PARAMS CALL VARDO2 SA2 VARBUF GET NUMBER OF TAGS SX2 X2-5 POSITIVE IF X2 .GT. MAX INPUT NG X2,CTIMES IS - IF MORE TAGS TO FETCH EQ ERR2MNY MAXIMUM OF 3 TAGS FOR INPUT STORETC SA3 VARBUF X3 = NUMBER TAGS SO FAR SX6 X3-1 DO NOT COUNT DUMMY ARGS SA6 VARBUF+1 SAVE NO. INPUT ARGS AS 1ST ARG CALL VARDO2 NG X6,ERRSTOR NOT STOREABLE SA1 VARBUF+1 GET NUMBER OF INPUT TAGS SX1 X1-1 NZ X1,CTNEXT MORE THEN ONE TAG * SA1 VARBUF+2 GET FIRST FLOATING POINT MX6 61-XCODEL+XFBIT BX6 -X6*X1 GET RID OF FLOATING POINT BIT SA6 A1 REWRITE WORD WITHOUT F BIT CTNEXT SA1 LASTKEY ZR X1,MRKLAST IF NO FORMAT TAG EXIT SX1 X1-KSEMIC NZ X1,ERR2MNY ONLY SEMI COLONS CALL VARDO2 SA1 LASTKEY ZR X1,MRKLAST THIS IS LAST LEGAL TAG EQ ERR2MNY TOO MANY TAGS * TITLE -COLOR- COMMAND READIN * * -COLOR- COMMAND (NUMBER 158) * * COLOR DEFINE;(VAR),REDVAL,GREENVAL,BLUEVAL * * READS IN THE VALUES SPECIFIED FOR * COLOR INTENSITIES IN THE RANGE 0..1, * CONVERTS THEM TO A 24-BIT INTEGER, * AND STORES THE RESULT IN THE SPECIFIED * VARIABLE. * * COLOR DISPLAY;FOREGND,BACKGND * COLOR DISPLAY;FOREGND * COLOR DISPLAY;,BACKGND * * TAKES THE 24-BIT COLOR VALUE(S) * SPECIFIED FOR FOREGROUND AND BACKGROUND * COLOR(S) AND SENDS THE INFORMATION TO * THE TERMINAL. * * COMMAND WORD FORMAT'; * 20/GETVAR,20/GETVAR,11/EXSTO ADDR,9/COMMAND NUMBER * * THE FIRST GETVAR CODE IS THE COMMAND EXECUTION * ROUTINE NUMBER -- * 0 = -COLOR DEFINE- * 1 = -COLOR DISPLAY- * * /--- BLOCK -CTIME- 00 000 80/10/01 03.05 * IF THE COMMAND IS -COLOR DISPLAY-, THE SECOND * GETVAR CODE IS THE FOREGROUND COLOR AND THE * THIRD GETVAR CODE (FIRST IN EXTRA STORAGE) IS * THE BACKGROUND COLOR. SINCE EITHER (BUT NOT * BOTH) MAY BE OMITTED, AN OMITTED COLOR IS * SIGNALLED BY THE GETVAR CODE 200 000B. * EJECT COLORIN BSS 0 * * PROCESS FIRST TAG -- TYPE OF -COLOR- REQUEST * RJ NXTNAM X6 = TAG, X1 = DELIMITER CHAR ZR X6,ERR2FEW -> NOT ENOUGH TAGS BX7 X1 SAVE DELIMITER SX2 X1-KSEMIC SEE IF DELIMITER = SEMICOLON SA7 LASTKEY SAVE DELIMITER NZ X2,ERRTERM -> BAD DELIMITER CHARACTER SB1 1 B1 = CONSTANT 1 SA2 KCDEF START OF KEYWORDS TAGCHEK ZR X2,ERRNAME -> KEYWORD NOT FOUND BX3 X2-X6 CHECK KEYWORD SA2 A2+B1 X2 = NEXT KEYWORD IN LIST NZ X3,TAGCHEK -> NOT A MATCH SB1 A2-KCDEF-1 B1 = JUMP TABLE INDEX SX6 B1 X6 = COMMAND TYPE SA6 VARBUF+1 SX6 1 ONE ENTRY IN VARBUF SA6 VARBUF + JP B1+*+1 + EQ CDEFINE -> PROCESS DEFINE KEYWORD + EQ CDISPLY -> PROCESS DISPLAY KEYWORD KCDEF DATA 0LDEFINE DATA 0LDISPLAY DATA 0 MUST END IN 0 WORD KCOMMA EQU 56B COMMA CHARACTER EJECT * * PROCESS DEFINE KEYWORD * CDEFINE BSS 0 RJ CARGS GET ARGUMENTS SA1 VARBUF MUST BE 4 ARGUMENTS + KEYWORD SX1 X1-5 NG X1,ERR2FEW -> NOT ENOUGH TAGS NZ X1,ERR2MNY -> TOO MANY TAGS SA1 VARBUF+2 X1 = VAR TAG GETVAR CODE NG X1,ERRSTOR -> MUST BE STOREABLE SA1 VARBUF+3 X1 = RED TAG GETVAR CODE RJ CHKVALU CHECK VALIDITY SA1 VARBUF+4 X1 = GREEN TAG GETVAR CODE RJ CHKVALU CHECK VALIDITY SA1 VARBUF+5 X1 = BLUE TAG GETVAR CODE RJ CHKVALU CHECK VALIDITY EQ CEND -> ALL OK; FINISH COMMAND * * PROCESS DISPLAY KEYWORD * CDISPLY BSS 0 MX6 1 PRESTORE BOTH ARGS OMITTED LX6 XCODEL SA6 VARBUF+2 SA6 VARBUF+3 RJ GETBARG GET FOREGROUND ARG ZR X2,CDISP1 -> ONLY ONE ARGUMENT NZ X3,CDISP0 -> CHECK BGND IF FGND COMPILED SA1 VARBUF ELSE INCREMENT *VARBUF* OVER SX6 X1+1 OMITTED FGND ARGUMENT SA6 VARBUF CDISP0 BSS 0 RJ GETBARG GET BACKGROUND ARG CDISP1 BSS 0 * /--- BLOCK -CTIME- 00 000 80/10/01 03.05 SA1 VARBUF CHECK FOR .LT. 4 ARGS SX1 X1-4 PL X1,ERR2MNY -> TOO MANY ARGUMENTS SX6 3 SET TO EXACTLY 3 ARGS SA6 VARBUF SA1 VARBUF+2 CHECK FOR BOTH ARGS OMITTED SA2 VARBUF+3 MX0 1 LX0 XCODEL X0 = OMITTED ARG MASK BX1 X0*X1 X1 .NZ. IF OMITTED BX2 X0*X2 X2 .NZ. IF OMITTED BX2 X1*X2 X2 .NZ. IF BOTH OMITTED NZ X2,ERR2FEW -> ERROR IF BOTH OMITTED CEND SA1 VARBUF X1 = NUMBE OF VARBUF ENTRIES EQ VARFIN -> BUILD COMMAND WORD * * CARGS -- GET ALL THE TAGS IN THE COMMAND. * IF A TAG IS OMITTED, INSERT A GETVAR CODE * OF 200 000B. * CARGS EQ * CGET RJ GETBARG GET NEXT TAG NZ X3,CGET -> NOT OMITTED, GET NEXT ZR X2,CARGS -> EOL; EXIT MX6 1 LX6 XCODEL X6 = OMITTED TAG CODE SA1 VARBUF X1 = CURRENT ENTRIES COUNT SX1 X1+1 INCREMENT COUNT SA6 VARBUF+X1 STORE OMITTED ARG BX6 X1 SA6 VARBUF STORE NEW COUNT EQ CGET GET NEXT TAG * * CHKVALU -- MAKE SURE CONSTANT IS IN * RANGE 0..1. * * ENTER'; X1 = GETVAR CODE FROM *VARBUF* * CHKVALU EQ * PL X1,CHKVALU -> STOREABLE; NO TEST MX0 1 LX0 XCODEL X0 = OMITTED TAG CODE BX2 X0*X1 X2 .NZ. IF OMITTED MX0 60-XCODEAL X0 = ADDRESS MASK NZ X2,ERRTAGS -> ERROR IN TAGS COUNT BX6 -X0*X1 X6 = SHORT LIT OR ADDRESS BX2 X1 SAVE ORIGINAL GETVAR CODE IN X1 AX2 XCODEAL MOVE TYPE CODE TO LOW ORDER BX0 -X0*X2 X0 = TYPE CODE (0 OR 1) SX0 X0-1 0 = SHORT LIT, 1 = LONG LIT PL X0,CHKLONG -> CHECK LONG LIT PX1 X6 ELSE FLOAT SHORT LIT NX1 X1 EQ CHKRANGE -> CHECK RANGE CHKLONG BSS 0 SA1 INFO+X6 GET LONG LIT FROM *INFO* CHKRANGE BSS 0 SA2 ONEP0 X2 = 1.0 NG X1,COLROOR -> COLOR NEGATIVE FX2 X2-X1 X2 <= 1.0 - COLOR PL X2,CHKVALU -> COLOR OK; EXIT COLROOR BSS 0 CONDENSE ERROR IF OOR SB1 500 B1 = CONDENSE ERROR NUMBER EQ =XERR -> GENERATE CONDENSE ERROR ONEP0 DATA 1.0 CONSTANT 1.0 * * /--- BLOCK ENDOV 00 000 79/01/05 02.22 * ENDOV ENDOV * * * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 TSLINKC SPACE 4,10 TITLE -TSLINK- COMMAND READIN ** COMMAND READIN FROM -TSLINK- * * 1ST ARG IS KEYWORD * 2ND - 4TH ARG EXTRA TAGS (ALL OPTIONAL) * * TSLINK LOGIN;MAINFRAME,PASSWORD * TSLINK RECOVER * TSLINK COMMAND;S,X;WORDS * TSLINK SEND;S,X;WORDS * TSLINK RECEIVE;S,X;MAX ALLOWED;WORDS RETURNED * TSLINK STATUS;WORD * TSLINK MESSAGE;MESSAGE * TSLINK CONTINUE * TSLINK STOP * TSLINK CSET;VALUE * TSLINK LOGOUT * TSLINK NOLOG * TSLINKC OVRLAY .TSL IFEQ 0,1 * FOR NOW -TSLINK- CAN BE USED IN NORMAL LESSONS * ON THE SYSTEMS SPECIFIED BELOW, AND IN SYSTEM * LESSONS ON ANY SYSTEM. SA1 CSYSNAM (X1) = THIS SYSTEMS ROUTING ID SA2 MNE BX2 X1-X2 ZR X2,TSOK IF MINNE SA2 PCA BX2 X1-X2 ZR X2,TSOK IF PCA SA2 PEA BX2 X1-X2 ZR X2,TSOK IF PEA SA2 PWA BX2 X1-X2 ZR X2,TSOK IF PWA SA2 S1 BX2 X1-X2 ZR X2,TSOK IF S1 CALL SYSTEST ELSE MUST BE SYSTEM LESSON TSOK BSS 0 CALL NXTNAM BX7 X1 SA7 LASTKEY * IDENTIFY KEYWORD SB2 B0 TLOOP SA2 TSTABLE+B2 FETCH TABLE ENTRY ZR X2,ERRNAME KEYWORD NOT IN TABLE IX3 X6-X2 ZR X3,FOUND =0 IF EXACT MATCH SB2 B2+1 INCREMENT LOOP POINTER EQ TLOOP * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 * FOUND SO FETCH DESCRIPTOR WORD FOUND SA2 TSDES+B2 SX6 B2 KEYWORD NUMBER SA6 VARBUF+1 SX6 1 SA6 VARBUF COUNT OF TAGS MX0 3 TAG DESCRIPTORS ARE 3 BITS BX3 X0*X2 (X3) = SYSTEM LESSON FLAG LX2 6 PUT 1ST TAG BITS IN BITS 2-0 BX6 X2 SA6 XTEMP ZR X3,FOUND.1 IF ALLOWED IN USER LESSONS CALL SYSTEST SA2 XTEMP RETRIEVE DESCRIPTOR WORD FOUND.1 MX0 -3 BX3 -X0*X2 * PROCESS DESCRIPTOR DLOOP ZR X3,LASTCHK CHECK IF END OF INPUT SA1 LASTKEY ZR X1,ERR2FEW IF NO MORE CHARS SA4 STORCO3 1R; IS ONLY LEGAL SEPERATOR IX1 X1-X4 NZ X1,ERRTERM IF NOT ; SX3 X3-1 NZ X3,NREAD (1) = READABLE CALL VARDO2 EQ STORE NREAD SX3 X3-1 NZ X3,NWRITE (2) = STOREABLE CALL VARDO2 SA1 VARBUF GET CURRENT NUMBER OF TAG SA1 VARBUF+X1 FETCH ENTRY NG X1,=XERRSTOR TEST IF STOREABLE EQ STORE NWRITE BSS 0 CALL NXTNAM GET NEXT LITERAL BX7 X1 SA7 LASTKEY SA2 STORCON IX4 X6-X2 SB1 155 BAD STORAGE LOCATION ZR X4,NWRITEY IS S, FORM SA2 STORCO4 NOW TRY STORAGE, IX4 X6-X2 * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 ZR X4,NWRITEY IS STORAGE FORM SO CONTINUE EQ ERR NWRITEY SA2 STORCO2 IX6 X1-X2 NZ X6,ERR IF NOT 2R SA1 LASTKEY ZR X1,ERR2FEW IF NO MORE CHARS CALL VARDO2 STORE SA2 XTEMP LX2 3 MX0 3 LX0 3 BX3 X2*X0 BX6 X2 SA6 XTEMP EQ DLOOP * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 LASTCHK SA3 LASTKEY NZ X3,ERR2MNY TOO MANY TAGS EQ MRKLAST MARK AS LAST FLAG * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 STORCON CON 1LS STORCO2 CON 1R, STORCO3 CON 1R; STORCO4 CON 0LSTORAGE XTEMP BSSZ 1 * * TO ADD A KEYWORD'; * * ADD THE LITERAL STRING TO THE *KEYWORD* TABLE AND * ADD THE DESCRIPTOR WORD TO THE *PROCESS WORD* * TABLE. (MATCHING THE OFFSET INTO EACH) * THE END OF TABLE IS LOCATED BY THE LAST ENTRY = 0 * * KEYWORD TABLE TSTABLE DATA 0LLOGIN DATA 0LRECOVER DATA 0LCOMMAND DATA 0LSEND DATA 0LRECEIVE DATA 0LSTATUS DATA 0LCONTINUE DATA 0LSTOP DATA 0LCSET DATA 0LLOGOUT DATA 0LNOLOG DATA 0LMESSAGE DATA 0 END OF TABLE * DESCRIPTOR WORD TABLE * * THE FORMAT OF EACH WORD IS * EACH COMMAND MUST HAVE SEMI-COLONS FOR EACH * TAG DIVISOR, EXCEPT FOR THE STORAGE, FORMAT * WHICH HAS A COMMA AFTER THE S OR STORAGE * 3/0, = NON-SYSTEM KEYWORD * 3/1, = SYSTEM LESSON ONLY KEYWORD * THE FOLLOWING 3 BIT FIELDS DESCRIBE THE * FORMAT OF THE USERS TAG * 0 = END OF TAGS * 1 = READABLE USER VARIABLE (I.E. WHERE) * 2 = STORABLE USER VARIABLE (I.E. N1) * 3 = STORAGE DEFINITION * THIS MEANS S, OR STORAGE, TSDES VFD 3/0,3/1,3/1,3/0,48/0 VFD 3/0,3/0,3/0,3/0,48/0 VFD 3/0,3/3,3/1,3/0,48/0 VFD 3/0,3/3,3/1,3/0,48/0 VFD 3/0,3/3,3/1,3/2,48/0 VFD 3/0,3/2,3/0,3/0,48/0 VFD 3/0,3/0,3/0,3/0,48/0 VFD 3/0,3/0,3/0,3/0,48/0 VFD 3/0,3/1,3/0,3/0,48/0 VFD 3/0,3/0,3/0,3/0,48/0 VFD 3/0,3/0,3/0,3/0,48/0 VFD 3/0,3/2,3/0,3/0,48/0 VFD 60/0 * SYSTEM NAMES FOR WHICH -TSLINK- IS ALLOWED MNE DATA 0LMNE PCA DATA 0LPCA PEA DATA 0LPEA PWA DATA 0LPWA S1 DATA 0LA02 .TSL ELSE SB1 73 BAD COMMAND NAME EQ =XERR .TSL ENDIF ENDOV IPCC TITLE -IPC- / -CHARCNV- COMMAND READ IN ** COMMAND READIN FOR -IPC- / -CHARCNV- * * IPC CONNECT * IPC DISCONNECT * IPC SEND,MESSAGE,LENGTH,ID,ADDRESS * IPC GET,MESSAGE,LENGTH,ID,ADDRESS * IPC STATUS,NUMBER,INMSG,OUTMSG * IPC RESET * * CHARCNV PLATO,BUF1,LEN1,BUF2,LEN2,LEN3 * CHARCNV ASCII,BUF1,LEN1,BUF2,LEN2,LEN3 * * LEN1 = SOURCE BUFFER LENGTH IN SOURCE CHARACTERS * LEN2 = MAXIMUM DESTINATION BUFFER LENGTH IN WORDS * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 * LEN3 = DESTINATION BUFFER LENGTH IN CHARACTERS SPACE 5,11 IPCC OVRLAY * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 CALL SYSTEST VERIFY A SYSTEM LESSON * DETERMINE IPC KEYWORD CALL NXTNAM BX7 X1 SA7 LASTKEY SB2 B0 SA2 IPCCA -IPC- KEYWORD TABLE SA1 OVARG1 ZR X1,IPCC1 IF IPC COMMAND SA2 IPCCB -CHARCNV- KEYWORD TABLE IPCC1 ZR X2,ERRNAME IF KEYWORD NOT FOUND IX3 X6-X2 ZR X3,IPCC2 IF KEYWORD FOUND SB2 B2+1 SA2 A2+2 EQ IPCC1 CHECK NEXT ENTRY IPCC2 SX6 1 COUNT TAGS IN VARBUF SA6 VARBUF SX6 B2 SA6 VARBUF+1 SET IPC COMMAND TYPE SA2 A2+1 (X2) = COMMAND DESCRIPTOR MX0 -6 LX2 6 BX6 X2 SA6 IPCCC SAVE DESCRIPTOR WORD BX6 -X0*X2 SA6 IPCCD SAVE ARGUMENT COUNT * PROCESS ARGUMENTS IPC3 SA1 IPCCD NZ X1,IPC4 IF MORE ARGUMENTS SA1 LASTKEY VERIFY NOT TOO MANY ARGUMENTS NZ X1,ERR2MNY IF MORE ARGUMENTS EQ MRKLAST PACK COMMAND ARGUMENTS IPC4 SX6 X1-1 DECREMENT ARGUMENTS LEFT SA6 A1 SA1 IPCCC MX0 -6 LX1 6 BX6 X1 SA6 A1 SAVE DESCRIPTOR WORD BX1 -X0*X1 SA2 LASTKEY ZR X2,ERR2FEW IF NO MORE ARGUMENTS SX2 X2-1R, NZ X2,ERRTERM IF NO A COMMA SEPARATOR ZR X1,IPC5 IF READ-ONLY ARGUMENT OKAY * PROCESS STOREABLE ARGUMENTS CALL VARDO2 SA1 VARBUF SA1 VARBUF+X1 (X1) = LAST ARGUMENT NG X1,ERRSTOR IF NOT STORABLE EQ IPC3 PROCESS NEXT ARGUMENT * PROCESS READ-ONLY ARGUMENTS IPC5 CALL VARDO2 EQ IPC3 * IPC KEYWORD / ARGUMENT TABLE * * 6/ARGUMENT COUNT * 6/0 - READ-ONLY, 1 - STORABLE IPCCA DATA 0LCONNECT VFD 6/0,54/0 DATA 0LDISCONNECT VFD 6/0,54/0 DATA 0LSEND VFD 6/4,6/1,6/0,6/0,6/0,30/0 DATA 0LGET VFD 6/4,6/1,6/1,6/1,6/1,30/0 DATA 0LSTATUS VFD 6/3,6/1,6/1,6/1,36/0 DATA 0LRESET VFD 6/0,54/0 DATA 0 IPCCB DATA 0LPLATO VFD 6/5,6/1,6/0,6/1,6/0,6/1,24/0 DATA 0LASCII VFD 6/5,6/1,6/0,6/1,6/0,6/1,24/0 DATA 0 * /--- BLOCK TSLINKC 00 000 80/08/28 09.33 IPCCC DATA 0 DESCRIPTOR WORD IPCCD DATA 0 ARGUMENT COUNT ENDOV * /--- BLOCK NSETOV 00 000 79/02/04 15.42 TITLE NAMESET COMMAND READINS * * NSETOV OVRLAY * SA1 OVARG1 GET OVARLAY ARGUMENT SB1 X1 JP B1+*+1 JUMP TO ROUTINE FOR COMMAND * + EQ SETNAMC 0 = -SETNAME- COMMAND + EQ GETNAMC 1 = -GETNAME- COMMAND + EQ RENAMEC 2 = -RENAME- COMMAND + EQ ADDNAMC 3 = -ADDNAME- COMMAND + EQ NAMESC 4 = -NAMES- COMMAND + EQ DELRECC 5 = -DELRECS- COMMAND + EQ ADDRECC 6 = -ADDRECS- COMMAND * /--- BLOCK SETNAME 00 000 79/02/04 15.35 * * SETNAME HAS THE FOLLOWING FORMS -- * * -SETNAME - VAR CONTAINS FIRST WORD OF NAME * -SETNAME NEXTNAME- SET TO NEXT NAME IN SEQUENCE * -SETNAME BACKNAME- SET TO PREVIOUS NAME IN SEQ. * -SETNAME (BLANK)- INDICATE NO NAME SELECTED * SETNAMC CALL NXTNAMP GET NEXT TAG IN X6 * X6 = TAG, WORDPT NOT UPDATED IN CASE TAG NOT -NEXTNAME- SX7 1 1 = NEXTNAME TAG SA1 NEXTNAME X1 = 8LNEXTNAME BX1 X6-X1 ZR X1,SETNAM2 --- IF SO, SET TYPE CODE SX7 2 2 = BACKNAME TAG SA1 BACKNAME X1 = 8LBACKNAME BX1 X6-X1 ZR X1,SETNAM2 --- IF SO, SET TYPE CODE SX7 3 3 = BLANK TAG SA1 TAGCNT GET NUMBER OF TAGS ZR X1,SETNAM2 --- IF NONE, SET TYPE CODE CALL VARDO1 GET ARGUMENT SA1 VARBUF+1 GET FIRST GETVAR CODE PL X1,SETNAM1 --- JUMP IF STOREABLE ADDRESS MX0 -XCODEL MASK FOR GETVAR CODE BX1 -X0*X1 MASK OFF STORABILITY FLAG MX6 1 LX6 XCODEL SHIFT TO TOP BIT OF GETVAR BX1 X6+X1 INSERT TOP BIT = NOT STORABLE * SETNAM1 BX6 X1 0 = NAME SPECIFIED LX6 -2*XCODEL SHIFT TO SECOND 20 BITS SA2 LASTKEY NZ X2,ERR2MNY ONLY ALLOW ONE ARGUMENT EQ PUTCODE * SETNAM2 BX6 X7 LX6 -XCODEL SHIFT TO TOP 20 BITS EQ PUTCODE * NEXTNAME DATA 8LNEXTNAME BACKNAME DATA 8LBACKNAME * /--- BLOCK GETNAME 00 000 79/02/04 15.35 * * * GETNAME HAS ONE OR TWO ARGUMENTS -- * 1ST = STARTING VARIABLE IN WHICH TO STORE NAME * 2ND = (OPTIONAL) LOCATION TO STORE EXTRA INFO * GETNAMC CALL VARDO GET ARGUMENTS SA1 VARBUF CHECK NUMBER OF TAGS SX2 X1-3 PL X2,ERR2MNY --- ERROR IF TOO MANY TAGS SA2 VARBUF+1 CHECK IF STORABLE NG X2,ERRSTOR --- 1ST ARG MUST BE STORABLE SX2 X1-2 CHECK IF TWO ARGUMENTS NG X2,MRKLAST --- PACK UP SINGLE ARGUMENT SA2 VARBUF+2 CHECK IF STORABLE NG X2,ERRSTOR --- 2ND ARG MUST BE STORABLE EQ MRKLAST EXIT TO PACK UP TAGS * * * * RENAME HAS ONE OR TWO ARGUMENTS -- * 1ST = STARTING VARIABLE IN WHICH TO STORE NAME * 2ND = (OPTIONAL) LOCATION OF NEW EXTRA INFO * RENAMEC CALL VARDO OBTAIN ARGUMENTS SA1 VARBUF CHECK NUMBER OF TAGS SX2 X1-3 NG X2,RENAME1 OK IF .LE. 2 ARGS SA2 SYSFLG (X2) = SYSTEM LESSON FLAGS LX2 ZSLDSHF POSITION SYSTEM COMMAND FLAG PL X2,ERR2MNY --- ERROR IF NOT SYSTEM LESSON SX2 X1-4 3 ARGS IS OK FOR SYSTEM LESSON PL X2,ERR2MNY --- ERROR IF .GT. 3 ARGS RENAME1 SA2 VARBUF+1 (X2) = FIRST ARG NG X2,ERRSTOR --- 1ST ARG MUST BE STORABLE EQ MRKLAST EXIT TO PACK UP TAGS * /--- BLOCK ADDNAME 00 000 79/09/11 03.13 * * ADDNAME HAS UP TO THREE ARGUMENTS-- * 1ST = STARTING VARIABLE CONTAINING NAME * 2ND = NUMBER OF RECORDS (OPTIONAL) * 3RD = EXTRA INFO (OPTIONAL) * ADDNAMC RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF GET NUMBER OF ARGS FOUND SX2 X1-4 NG X2,ADDNAM1 OK IF .LE. 3 ARGS SA2 SYSFLG (X2) = SYSTEM LESSON FLAGS LX2 ZSLDSHF POSITION SYSTEM COMMAND FLAG PL X2,ERR2MNY --- ERROR IF NOT SYSTEM LESSON SX2 X1-5 4 ARGS IS OK FOR SYSTEM LESSON PL X2,ERR2MNY --- ERROR IF .GT. 4 ARGS ADDNAM1 SA2 VARBUF+1 (X2) = FIRST ARG NG X2,ERRSTOR --- 1ST ARG MUST BE STOREABLE EQ MRKLAST FINISH PROCESSING * * -NAMES- HAS FOUR ARGUMENTS- * * 1ST = ORDINAL NUMBER OF FIRST NAME * ...OR IT CAN BE OMITTED. * 2ND = STARTING LOCATION OF USER BUFFER * 3RD = SIZE OF USER BUFFER IN WORDS * 4TH = VARIABLE TO RETURN COUNT * NAMESC RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF GET NUMBER OF ARGS FOUND SX2 X1-3 SEE IF 1ST ARG IS TO BE OMITTED NZ X2,NAMES4 --- BRIF IF NOT 3 ARG CASE SX6 X1+1 RESET *VARBUF* TO A 4 ARG CASE SA6 A1 * SA1 VARBUF+3 ... SHUFFLE OTHER ARGS DOWN SA2 A1-1 BX7 X1 BX6 X2 SA7 A1+1 VARBUF+4 _ VARBUF+3 SA6 A1 VARBUF+3 _ VARBUF+2 SA1 VARBUF+1 BX6 X1 SA6 A2 VARBUF+2 _ VARBUF+1 MX6 1 NOW MARK FIRST ARGUMENT OMITTED LX6 XCODEL SA6 VARBUF+1 STORE AS A DUMMY ARGUMENT SA1 VARBUF EQ NAMES2 ... NOW CHECK OTHER ARGUMENTS * NAMES4 SX2 X1-4 NZ X2,ERRTAGS --- IS NO GOOD IF NOT 3 OR 4 ARGS NAMES2 SA2 VARBUF+2 NG X2,ERRSTOR --- 2ND ARG MUST BE STOREABLE SA2 VARBUF+4 NG X2,ERRSTOR --- 4TH ARG MUST BE STOREABLE EQ VARFIN FINISH PROCESSING * * ADDRECS, DELRECS CAN HAVE 1 OR 2 ARGUMENTS-- * 1ST = NUMBER OF RECORDS TO ADD (AT END) * OR * 1ST = RECORD NUMBER THAT NEW RECORDS START AT * 2ND = NUMBER OF RECORDS * DELRECC BSS 0 ADDRECC RJ VARDO GET COMMA SEPARATED VARIABLES SA1 VARBUF GET NUMBER OF ARGS FOUND SX2 X1-3 PL X2,ERR2MNY EQ MRKLAST FINISH PROCESSING * /--- BLOCK ENDOV 00 000 79/02/04 15.39 * ENDOV * /--- BLOCK COVL3B 00 000 81/05/12 15.01 * COVL3B OVRLAY SA1 OVARG1 SB1 X1 JP B1+*+1 * + EQ SETSYSC 0 = -SETSYS- COMMAND + EQ FILNAMC 1 = -FILENAM- COMMAND + EQ NVERSC 2 = -NVERS- COMMAND + EQ NETIOC 3 = -NETIO- COMMAND + EQ ITOAC 4 = -ITOA- COMMAND + EQ OTOAIN 5 = -OTOA- -HTOA- COMMANDS + EQ DIOC 6 = -DREAD- -DWRITE- COMMANDS + EQ DATAIOC 7 = -DATAIN- -DATAOUT- COMMANDS + EQ FIOC 8 = -READF- -WRITEF- COMMANDS + EQ READIN 9 = -READECS- -READTCM- + EQ WREADIN 10 = -WRITECS- -WRITTCM- + EQ SBREADC 11 = -SBREAD- -READLES- + EQ SBWRITC 12 = -SBWRITE- -WRITLES- + EQ SBCHANC 13 = -SBCHANG- -STCHANG- + EQ SIZEC 14 = -SIZE- + EQ TEXTNIN 15 = TEXTN + EQ TRANSIN 16 = TRANSFR * /--- BLOCK SETSYS 00 000 85/07/29 15.37 TITLE -SETSYS- COMMAND * * -SETSYS- HAS THE FOLLOWING FORMS -- * * SETSYS NEXTSYS,(BUFFER),(LTH) * SETSYS BACKSYS,(BUFFER),(LTH) * SETSYS (SYSTEM),(BUFFER),(LTH)[,RID] * SETSYSC CALL SYSTEST MUST BE SYSTEM LESSON * SA1 TAGCNT ZR X1,ERR2FEW -- ERROR EXIT * CALL NXTNAMP GET FIRST TAG IN X6 * X6 = TAG, B1 = NEXT *WORDPT*, X1 = TERMINATOR CHARACTER * MX7 0 0 = NEXTSYS TAG SA2 NEXTSYS X2 = 7LNEXTSYS BX2 X6-X2 ZR X2,SETSYS2 * SX7 1 1 = BACKSYS TAG SA2 BACKSYS X2 = 7LBACKSYS BX2 X6-X2 NZ X2,SETSYS3 NOT *NEXTSYS* OR *BACKSYS* * SETSYS2 MX6 1 BUILD SPECIAL CODE LX6 XCODEL BX6 X6+X7 SX7 B1 UPDATE *WORDPT* SA6 VARBUF+1 SA7 WORDPT SX6 1 SA6 VARBUF SHOW ONE ARGUMENT SO FAR EQ SETSYS4 CONTINUE TO SECOND TAG * SETSYS3 CALL VARDO1 GET SYSTEM NAME AS FIRST ARG SA1 LASTKEY GET DELIMITER * SETSYS4 ZR X1,ERR2FEW --- ERROR IF NO BUFFER GIVEN * CALL VARDO2 GET BUFFER ADDRESS NZ B1,ERRSTOR -- ERROR IF NOT STORABLE SA1 LASTKEY CHECK IF DONE ZR X1,ERR2FEW -- MUST SPECIFY BUFFER LTH * CALL VARDO2 GET BUFFER LENGTH SA2 LASTKEY CHECK IF MORE ARGS MX7 0 ZR X2,SETSYS9 -- EXIT IF DONE * CALL NXTNAM CHECK FOR RID KEYWORD NZ X1,ERR2MNY --- ERROR IF MORE ARGS SA1 RIDTAG BX1 X1-X6 SX7 1 NZ X1,ERRNAME --- ERROR IF NOT -RID- SETSYS9 BSS 0 MX6 1 LX6 XCODEL FLAG SPECIAL ARG BX6 X6+X7 SA6 VARBUF+4 SX1 4 (VARFIN REQUIRES NUM OF TAGS) BX6 X1 SA6 VARBUF ALSO SET TO 4 EQ VARFIN -- EXIT * * NEXTSYS DATA 7LNEXTSYS BACKSYS DATA 7LBACKSYS RIDTAG DATA 3LRID * * * /--- BLOCK FILENAM 00 000 85/07/29 15.34 TITLE -FILENAM- COMMAND * * -FILENAM- HAS TWO POSSIBLE FORMS -- * * FILENAM ACCOUNT';FILE,ONEWORD (FORM 0) * FILENAM ONEWORD,ACCOUNT';FILE (FORM 1) * * THE FIRST GETVAR CODE IS SET UP AS A FAKE ARGUMENT * TO INDICATE WHICH FORM IS USED. * FILNAMC BSS 0 SA1 TAGCNT ZR X1,ERR2FEW IF BLANK TAG * LOOK FOR COLON TO DETERMINE WHICH FORM IS USED CALL COLONCK SEE IF COLON AFTER FIRST ARG ZR X6,FN10 IF FIRST SEPARATOR IS COLON SX6 1 SET TO FORM 1 FN10 SA6 VARBUF+1 SET UP FIRST GETVAR CODE SX6 1 SA6 VARBUF INITIALIZE TO 1 ARGUMENT SO FAR * COMPILE FIRST REAL ARGUMENT CALL VARDO2 SA1 LASTKEY CHECK FOR END OF LINE ZR X1,ERR2FEW IF ONLY ONE ARGUMENT CALL COLONCK SEE IF NEXT SEPARATOR IS COLON SA1 VARBUF+1 RETRIEVE COMMAND FORM ZR X1,FN15 IF FIRST SEPARATOR WAS COLON ZR X6,FN20 IF SECOND SEPARATOR WAS COLON EQ ERRTERM IF NO COLON AT ALL FN15 ZR X6,ERRTERM IF BOTH SEPARATORS ARE COLONS * COMPILE SECOND ARGUMENT CALL VARDO2 GENERATE GETVAR CODE EQ FN30 FN20 CALL PUTDO2 GENERATE PUTVAR CODE * COMPILE THIRD ARGUMENT FN30 SA1 LASTKEY CHECK FOR END OF LINE ZR X1,ERR2FEW IF NO THIRD ARGUMENT CALL PUTDO2 ALWAYS PUTVAR CODE FOR 3RD ARG SA1 LASTKEY NZ X1,ERR2MNY IF MORE THAN 3 ARGUMENTS SX1 4 NUMBER OF GETVAR CODES ALLOWED EQ VARFIN * /--- BLOCK NVERS 00 000 85/07/29 15.34 TITLE -NVERS- COMMAND * * -NVERS- COMMAND * * NVERS ACCOUNT';FILE,ACCOUNT';FILE * * CONVERTS SPECIFIED FILE NAME TO ITS N-VERSION FORM. * NVERSC BSS 0 CALL SYSTEST SYSTEM LESSONS ONLY CALL ACCFILE,VARBUF+1,0 GET FIRST FILE NAME SA1 LASTKEY ZR X1,ERR2FEW CALL COLONCK LOOK FOR COLON IN 2ND NAME NZ X6,NV20 IF NO COLON SX6 2 SA6 VARBUF 2 ARGUMENTS SO FAR CALL VARDO2 VAR FOR ACCOUNT NAME RETURN NG X6,ERRSTOR IF NOT STOREABLE NV10 CALL VARDO2 VAR FOR FILE NAME RETURN NG X6,ERRSTOR IF NOT STOREABLE SA1 LASTKEY NZ X1,ERR2MNY IF EXTRA ARGUMENTS SX1 4 4 ARGUMENTS EQ VARFIN NV20 SX6 0 FAKE UP 3RD ARGUMENT SA6 VARBUF+3 SX6 3 SA6 VARBUF EQ NV10 * /--- BLOCK NETIO 00 000 79/02/04 23.36 TITLE NETWORK I/O COMMAND - NETIO * * -NETIO- (CODE = 107) * * NETIO REQUEST,RESPONSE * * REQUEST AND RESPONSE MUST BE STOREABLE VAIABLES. * NETIOC BSS 0 * ALLOW ONLY SYSTEM LESSONS WITH -NETIO- PERMISSION. SA1 SYSFLG LX1 ZSLDSHF PL X1,ERRORC IF NOT A SYSTEM LESSON LX1 ZNIOSHF-ZSLDSHF PL X1,ERRORC IF NO -NETIO- PERMISSION * * * * COMPILE PARAMETERS CALL VARDO * * * * CHECK NUMBER OF ARGUEMENTS, MUST BE TWO SA1 VARBUF VARIABLE COUNT SX2 X1-2 NG X2,ERR2FEW JUMP IF NOT ENOUGH NZ X2,ERR2MNY JUMP IF TOO MANY * * * * BOTH ARGUEMENTS MUST BE STOREABLE SA2 VARBUF+1 FIRST VARIABLE NG X2,ERRSTOR JUMP IF NOT STOREABLE SA2 VARBUF+2 SECOND VARIABLE NG X2,ERRSTOR JUMP IF NOT STOREABLE * * * * PACK VARBUF VARIABLES (X1=VARIABLE COUNT) EQ VARFIN * * * /--- BLOCK OTOAIN 00 000 77/02/18 21.40 * * -ITOA- (CODE=220) * * 1ST ENTRY=INTEGER, * 2ND ENTRY=ALPHA STORAGE LOCATION * 3RD ENTRY=RETURN ALPHA CHARACTER COUNT * ITOAC RJ VARDO ENCODE VARIABLES SA1 VARBUF X1 = NUMBER OF VARIABLES SX2 X1-2 NZ X2,ITOAC1 JUMP IF NOT 2 VARIABLES SA1 VARBUF+1 SA2 VARBUF+2 NG X2,ERRSTOR MUST BE ABLE TO STORE INTO MX0 -XCODEL BX1 -X0*X1 BX2 -X0*X2 LX1 60-XCODEL LX2 60-2*XCODEL BX6 X1+X2 MX1 1 LX1 60-2*XCODEL BX6 X6+X1 SET BIT TO FLAG 2 ARGS EQ PUTCODE --- EXIT TO ADD COMMAND CODE AND STORE ITOAC1 SX2 X2-1 NZ X2,ERRTAGS --- ERROR EXIT IF NOT 3 VARIABLES SA2 VARBUF+2 NG X2,ERRSTOR MUST BE ABLE TO STORE INTO ALPHA STORAGE SA2 VARBUF+3 NG X2,ERRSTOR MUST BE ABLE TO STORE CHAR COUNT EQ VARFIN --- EXIT TO PACK UP VARIABLES * * TITLE OTOA/HTOA * * -OTOA- * -HTOA- * * FIRST ARG IS OCTAL WORD * 2ND ARG GIVES FWA OF 2 WORD STOREABLE BUFFER * TO CONTAIN THE 20 CHAR ALPHA STRING. * OPTIONAL 3RD ARGUMENT IS CHARACTER COUNT * * FORCES GETVAR CODE OF 1ST ARG TO INTEGER * CHECKS TO SEE THAT 2ND ARG IS STOREABLE * OTOAIN RJ VARDO SA1 VARBUF X1= NO. OF ARGS SX2 X1-2 ZR X2,OKTAGS --- IF 2 ARGS IT IS OK SX2 X1-3 NZ X2,ERRTAGS --- ERROR IF NOT 2 OR 3 TAGS OKTAGS SA2 VARBUF+1 MX0 1 LX0 18 2**17 BIT IS I/F FLAG BX6 -X0*X2 MAKE GETVAR CODE INTEGER SA6 A2 PUT IT BACK FOR VARFIN SA2 VARBUF+2 NG X2,ERRSTOR --- ERROR IF 2ND NOT STOREABLE EQ MRKLAST --- EXIT AND MARK LAST CODE * * * /--- BLOCK DREAD 00 000 79/07/12 04.51 TITLE DREAD, DWRITE * -DREAD- (CODE=193) * -DWRITE- (CODE=194) * * MAY HAVE 2 OR 3 ARGUMENTS * * DIOC RJ SYSTEST SYSTEM LESSON CHECK * DIOC1 SX6 1 SET UP SHORT LITERAL SA6 VARBUF+3 RJ VARDO DECODE VARIABLES TO *VARBUF* SA1 VARBUF SX2 X1-2 ZR X2,DIOC2 OK IF 2 ARGUMENTS SX2 X1-3 NZ X2,ERRTAGS --- ERROR IF NOT 3 ARGUMENTS * DIOC2 MX0 -XCODEL SA1 VARBUF+1 LOAD 1ST -GETVAR- CODE BX6 -X0*X1 LX6 60-XCODEL SA1 VARBUF+2 LOAD 2ND -GETVAR- CODE BX1 -X0*X1 LX1 60-2*XCODEL BX6 X1+X6 COMBINE SA1 VARBUF+3 LOAD 3RD -GETVAR- CODE BX1 -X0*X1 LX1 60-3*XCODEL BX6 X6+X1 FINISH UP XSTOR WORD SA1 INX SA6 X1+INFO PUT -GETVAR- CODES IN XSTOR SX6 X1+1 SA6 A1 UPDATE XSTOR POINTER BX6 X1 LX6 60-18 POSITION XSTOR POINTER EQ PUTCODE * /--- BLOCK DATAIOC 00 000 81/04/27 23.28 TITLE DATAIOC * * * CONDENSE ROUTINE FOR -DATAIN- AND -DATAOUT- * 1ST ARG = BLOCK NUMBER * 2ND ARG = DATA LOCATION * 3RD ARG = NUMBER OF RECORDS (OPTIONAL) * * DATA LOCATION CAN BE OF FOLLOWING TYPES - * * N1 STUDENT BANK (TYPE 0) * V1 STUDENT BANK (TYPE 0) * C,1 COMMON (TYPE 1) * COMMON,1 COMMON (TYPE 1) * S,1 STORAGE (TYPE 2) * STORAGE,1 STORAGE (TYPE 2) * NC1 CM VARIABLES (TYPE 3) * VC1 CM VARIABLES (TYPE 3) * * REFERENCES TO NC/VC VARIABLES (TYPE 3) ARE * CONDENSED AS N/V VARIABLES (TYPE 0). DURING THE * BOUNDS CHECKS AT EXECUTION TIME THE NC/VC * REFERENCES ARE DETECTED AND THE TYPE IS CHANGED. * THIS IS NECESSARY SINCE REFERENCES LIKE NC(N1) * ARE CONDENSED WITH COMPILED CODE AND CANNOT BE * DETECTED EASILY HERE. * * DATAIOC SA1 COMNUM -DATAOUT- IS PUBLISH ERROR SB1 =XDATOT= SB2 X1 NE B1,B2,DATIOC0 IF NOT -DATAOUT- * SB1 FSDATOT LOG PUBLISH ERROR RJ =XPUBERRS DATIOC0 CALL VARDO1 GET BLOCK NUMBER SA1 LASTKEY GET TERMINATOR SX1 X1-1R; INSIST ON PROPER SYNTAX NZ X1,ERRTERM ERROR IF BAD SEPARATOR SX7 DIO.SV PRESET FOR STUDENT VARIABLES SA7 VARBUF+2 PRESET TYPE IN 2ND ARG CALL NXTNAMR GET ANY SYMBOL SX4 X1-1R, CHECK FOR COMMA NZ X4,DATIOC3 JUMP IF NOT C,S SX7 DIO.COM PRESET FOR COMMON SA2 KCOM BX2 X3*X2 IX2 X2-X6 ZR X2,DATIOC2 IF COMMON SX7 DIO.STO PRESET FOR STORAGE SA2 KSTO BX2 X3*X2 IX2 X2-X6 NZ X2,DATIOC3 IF NOT STORAGE DATIOC2 SA7 VARBUF+2 STORE TYPE AS 2ND ARG SX7 B1 B1 HAS BEEN SAVED TO HERE SA7 WORDPT DATIOC3 SX6 2 SA6 VARBUF RESET ARGS TO 2 CALL VARDO2 GET DATA LOCATION SA2 VARBUF+2 TYPE CODE NZ X2,DATIOC4 IF NOT STUDENT BANK NZ B1,ERRSTOR ERROR IF NOT STOREABLE DATIOC4 SX6 1 CONSTANT 1 SA6 VARBUF+4 PRESET NUMBER OF RECORDS SA1 LASTKEY GET TERMINATOR ZR X1,DATIOC5 IF ONLY 2 ARGS SX1 X1-1R; INSIST ON PROPER SYNTAX NZ X1,ERRTERM ERROR IF BAD SEPARATOR CALL VARDO2 GET NUMBER OF RECORDS SA1 LASTKEY GET FINAL TERMINATOR * /--- BLOCK DATAIOC 00 000 81/04/27 23.28 NZ X1,ERR2MNY ERROR IF NOT E-O-L DATIOC5 SX1 4 4 ARGS REQUIRED BX6 X1 SA6 VARBUF AND GUARANTEED IN ALL CASES EQ VARFIN * KCOM DATA 6LCOMMON KSTO DATA 7LSTORAGE * * /--- BLOCK FIOC 00 000 77/03/10 00.15 EJECT * * -READF- (CODE = 450) * -WRITEF- (CODE = 451) * * READF FIP,BLOCK NUMBER,STORAGE ADDRESS,NO. BLOCKS * * NO. OF BLOCKS IS AN OPTIONAL PARAMETER WHICH IS * ASSUMED ONE IF MISSING. FILE INFORMATION * PACKET(FIP) MUST BE A STOREABLE VARIABLE. * FIOC BSS 0 * * * * MUST BE SYSTEM LESSON CALL SYSTEST * * * * INITIALIZE NO. OF BLOCKS AND NO. OF ARGUMENTS TO 1 SX6 1 SA6 VARBUF+4 PUT IN FOURTH PARAMETER SLOT SA6 VARBUF NUMBER OF ARGUMENTS * * * * EVALUATE THE FIRST ARGUMENT CALL COMPILE NZ B1,ERRSTOR ERROR IF NOT STOREABLE * * * * PUT GETVAR CODE INTO BUFFER. BX6 X1 SA6 VARBUF+1 * * * * COMPILE THE REMAINING ARGUMENTS FIOC1 BSS 0 SA1 LASTKEY WAS THAT THE LAST ONE ZR X1,FIOC2 JUMP IF NO MORE CALL VARDO2 COMPILE NEXT ARGUMENT EQ FIOC1 * * * * CHECK FOR CORRECT NUMBER OF ARGUMENTS FIOC2 BSS 0 SA1 VARBUF ARGUMENT COUNT SX2 X1-4 ZR X2,FIOC3 JUMP IF 4 SX2 X1-3 NZ X2,ERRTAGS ERROR IF NOT 3 OR 4 * * * * ONLY THREE ARGUMENTS FORCE TO FOUR SX1 X1+1 * * * * SET NUMBER OF VARIABLES AND GO PACK CODES FIOC3 BSS 0 BX6 X1 SA6 VARBUF EQ VARFIN * /--- BLOCK READECS 00 000 79/03/20 20.14 * TITLE -READECS- * -READECS- (CODE=182) * -READTCM- (CODE=248) * READIN RJ SYSTEST CHECK IF SYSTEM LESSON READIN1 RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 NG X1,ERRSTOR ERROR IF VARIABLE NOT STOREABLE SX1 3 MUST BE 3 VARIABLES EQ VARFIN --- EXIT TO STORE CODE * * * -WRITECS- (CODE=219) * -WRITTCM- (CODE=250) * WREADIN RJ SYSTST1 CHECK IF SPECIAL SYSTEM LESSON EQ READIN1 * * * * -SBREAD- (CODE=148) * -READLES- * SBREADC RJ SYSTEST CHECK IF SYSTEM LESSON SBREAD1 RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+3 NG X1,ERRSTOR 3RD ARG MUST BE STORABLE SX1 4 MUST BE 4 VARIABLES EQ VARFIN --- EXIT TO STORE CODE * * -SBWRITE- (CODE=149) * -WRITLES- * SBWRITC RJ SYSTST1 CHECK IF SPECIAL SYSTEM LESSON EQ SBREAD1 * -SBCHANG- (CODE = 314) * -STCHANG- (CODE = 315) SBCHANC RJ SYSTST1 CHECK IF SPECIAL SYSTEM LESSON RJ VARDO PROCESS COMMA-SEPARATED ARGS SX1 4 THERE MUST BE 4 ARGUMENTS EQ VARFIN PACK UP GETVAR CODES AND EXIT TITLE -SIZE- COMMAND. ** SIZEC - SIZE COMMAND CONDENSE ROUTINE. * * COMMAND SYNTAX - * SIZE * SIZE 2 * SIZE 2,1.5 * SIZE BOLD * CHECK FOR -BOLD- KEYWORD. IF NOT BOLD, JUMP * TO STANDARD CONDENSE ROUTINE ',ONE2IN0', TO * PROCESS ZERO TO TWO ARGUMENT COMMANDS. SIZEC RJ NXTNAMP SA1 BOLDNAM BX1 X6-X1 NZ X1,=XONE2IN0 IF NOT -BOLD- * MAKE SURE THERE ARE NO MORE TAGS. SX2 X2-EOL NZ X2,ERR2MNY IF NOT END OF LINE * SET BIT 58 TO INDICATE THAT THIS IS A -SIZE BOLD-. MX6 1 LX6 58-59+60 EQ PUTCODE BOLDNAM DATA 4LBOLD * /--- BLOCK TEXTN 00 000 83/06/13 11.57 TITLE TEXTN COMMAND READIN * * ALLOWS 4 OR 5 OR 6 OR 7 ARGUMENTS WITH LAST * ARGUMENT MARKED WITH SIGN BIT SET. * FIRST AND SECOND ARGUMENTS MUST BE STOREABLE. * * TEXTNIN RJ VARDO COMMA SEPARATED VARIABLES SA1 VARBUF+1 FIRST GETVAR WORD NG X1,ERRSTOR MUST BE STOREABLE SA1 VARBUF+2 SECOND GETVAR WORD NG X1,ERRSTOR MUST BE STOREABLE SA1 VARBUF X1= NO. OF ARGS SX2 X1-4 ZR X2,MRKLAST --- IF 4 ARGS IT IS OK SX2 X1-5 ZR X2,MRKLAST --- IF 5 ARGS IT IS OK SX2 X1-6 ZR X2,MRKLAST --- IF 6 ARGS IT IS OK SX2 X1-7 ZR X2,MRKLAST --- IF 7 ARGS IT IS OK EQ ERRTAGS --- EXIT TO CONDENSE ERROR * * /--- BLOCK TRANSFR 00 000 79/07/12 05.23 TITLE -TRANSFR- * * * * -TRANSFR- COMMAND READIN * TRANSIN SX6 2 SA6 VARBUF SET ARGS TO 2 MX6 0 SA6 VARBUF+2 CLEAR TRANSFER TYPE TO 0 CALL NXTNAMR GET FIRST SYMBOL ZR X1,SYNERR CHECK FOR PREMATURE EOL SX4 X1-1R, CHECK FOR COMMA NZ X4,TRANSFR GO GET -FROM- IF NOT C,S SB3 1 SET TYPE SA2 KCOM BX2 X3*X2 IX2 X2-X6 ZR X2,TRANSFC COMMON SB3 B3+B3 SA2 KSTO BX2 X3*X2 IX2 X2-X6 ZR X2,TRANSFC STORAGE SB3 B3+1 SA2 KROUT BX2 X3*X2 IX2 X2-X6 ZR X2,TFCR JUMP IF -ROUTER- SB3 B3+1 SA2 KROUTV BX2 X3*X2 IX2 X2-X6 NZ X2,TRANSFR NOT -ROUTVARS- * * /--- BLOCK TRANSFR 00 000 79/07/12 05.07 * TFCR SA2 ROUTER NZ X2,ERROUTR ERROR IF THIS IS A ROUTER * TRANSFC SX7 B3 PICK UP FLAG SA7 VARBUF+2 STORE IN SECOND ARGUMENT SX7 B1 B1 HAS BEEN SAVED TO HERE SA7 WORDPT * * TRANSFR CALL VARDO2 GET -FROM- VARIABLE SA1 LASTKEY GET TERMINATOR SX1 X1-1R; FORCE SYNTAX NZ X1,ERRTERM TO BE CLEAR EQ B1,B0,TRANST OK IF STOREABLE SA3 VARBUF+2 GET TYPE OF TRANSFER ZR X3,ERRSTOR ERROR IF -CM FROM- NOT A USER * ARRAY ADDRESS * TRANST CALL NXTNAMR SCAN FOR NEXT TERMINATOR ZR X1,SYNERR CHECK FOR PREMATURE EOL SX4 X1-1R, CHECK FOR COMMA NZ X4,TRANSTO GO GET -TO- IF NOT C,S SB3 1 SET TYPE SA2 KCOM BX2 X3*X2 IX2 X2-X6 ZR X2,TRANSTC COMMON SB3 B3+B3 SA2 KSTO BX2 X3*X2 IX2 X2-X6 ZR X2,TRANSTC STORAGE SB3 B3+1 SA2 KROUT BX2 X3*X2 IX2 X2-X6 NZ X2,TRANSTO NOT ROUTER SA2 ROUTER NZ X2,ERROUTR ERROR IF THIS IS A ROUTER * * /--- BLOCK TRANSFR 00 000 79/07/12 05.08 * TRANSTC SX7 B3 PICK UP TYPE SA3 VARBUF+2 LX7 3 MOVE -TO- TYPE INTO PLACE IX7 X7+X3 ADD IT IN SA7 A3 RE-STORE SX7 B1 B1 HAS BEEN PRESERVED SA7 WORDPT * TRANSTO RJ VARDO2 GET -TO- ARGUMENT SA1 LASTKEY GET TERMINATOR SX1 X1-1R; FORCE SYNTAX NZ X1,ERRTERM TO BE CLEAR EQ B1,B0,TRANSL OK IF STOREABLE SA3 VARBUF+2 GET TRANSFER TYPE AX3 3 OF -TO- ARG ZR X3,ERRSTOR ERROR IF -CM TO- ADDRESS NOT * STOREABLE * TRANSL RJ VARDO2 GET -LENGTH- SA1 LASTKEY CHECK FINAL TERMINATOR NZ X1,ERR2MNY SA1 VARBUF+5 PICK UP LENGTH BX6 X1 SA6 VARBUF+1 MOVE INTO SAVED SLOT SX1 4 HAVE 4 ARGUMENTS (SURE) BX6 X1 SA6 VARBUF ENSURE THAT ARG CHECK IS OK EQ VARFIN GO PACK IT ALL UP * SYNERR SX7 B1 UPDATE CHARACTER POINTER SA7 WORDPT EQ ERR2FEW * KROUT DATA 6LROUTER KROUTV DATA 8LROUTVARS * * /--- BLOCK ENDOV 00 000 79/02/04 23.39 * ENDOV * /--- BLOCK KEYWDOV 00 000 79/11/15 20.36 TITLE KEYWORD COMMAND OVERLAY KEYWDOV OVRLAY * * * OVERLAY TO CONDENSE KEYWORD-ORIENTED COMMANDS * * * * KEYWD MACRO * * * * KEYWD NUMBER,NAME,ADDRESS,FLPTFLG * * * * NUMBER = NUMBER OF KEYWORD * * NAME = NAME OF KEYWORD * * ADDRESS = ADDRESS OF ROUTINE TO PROCESS TAG * * FLPTFLG = ALPHA TO SUPPRESS F/I CONVERSION * PURGMAC KEYWD KEYWD MACRO NUMBER,NAME,ADDRESS,FLPTFLG LOCAL FICONV,UNUSED UNUSED SET 0 IFC EQ,*FLPTFLG*ALPHA* FICONV SET 1 ELSE FICONV SET 0 ENDIF DATA L*NAME* VFD 1/FICONV,14/UNUSED,9/0,18/ADDRESS,18/NUMBER ENDM * /--- BLOCK COMMANDS 00 000 80/02/08 23.45 SA1 OVARG1 SB1 X1 JP B1+*+1 JUMP TO ROUTINE FOR COMMAND + EQ ATTF 0 = -ATTACHF- + EQ DETF 1 = -DETACHF- + EQ FILEF 2 = -FILEF- + EQ SYSFILE 3 = -SYSFILE- * * * -ATTACHF- COMMAND * ATTF CALL SYSTEST CALL VARDO1 GET FIP NG X1,ERRSTOR --- ERROR IF NOT STORABLE CALL KEYWORDS,ATTFTAB,0 EQ MRKLAST --- PACK UP VARBUF AND EXIT ATTFTAB BSS 0 TABLE OF -ATTACHF- KEYWORDS KEYWD 0,FILE,FILE,ALPHA KEYWD 1,PACK,WORD,ALPHA KEYWD 2,MODE,WORD DATA 0 MARK END OF TABLE * * * -DETACHF- COMMAND * DETF CALL SYSTEST CALL VARDO1 GET FIP NG X1,ERRSTOR --- ERROR IF NOT STORABLE CALL KEYWORDS,DETFTAB,0 EQ MRKLAST --- PACK UP VARBUF AND EXIT DETFTAB BSS 0 TABLE OF -DETACHF- KEYWORDS KEYWD 0,FILE,FILE,ALPHA KEYWD 1,PACK,WORD,ALPHA KEYWD 2,STATION,NEXTKEYW KEYWD 3,MASTER,NEXTKEYW DATA 0 MARK END OF TABLE * * * -FILEF- COMMAND (KEYWORDS MUST CORRESPOND TO * * THE KEYWORDS FOR -ATTACHF-) * FILEF CALL SYSTEST CALL VARDO1 GET FIP NG X1,ERRSTOR --- ERROR IF NOT STORABLE CALL KEYWORDS,FILEFTAB,0 EQ MRKLAST --- PACK UP VARBUF AND EXIT FILEFTAB BSS 0 TABLE OF -FILEF- KEYWORDS KEYWD 0,FILE,FILE,ALPHA KEYWD 1,PACK,WORD,ALPHA DATA 0 MARK END OF TABLE EJECT * * * -SYSFILE- COMMAND * * * * PRIMARY FUNCTIONS - * * * * ATTACH * * DETACH * * CHECK EXISTENCE OF A FILE * * READ * * WRITE * * CREATE * * DESTROY * * RENAME * * CHANGE FILE TYPE * * * * EACH PRIMARY FUNCTION IS FOLLOWED BY SECONDARY * * KEYWORDS OR ARGUMENTS * SYSFILE CALL SYSTEST ERROR IF NOT SYSTEM LESSON CALL VARDO1 GET FIP NG X1,ERRSTOR --- ERROR IF NOT STORABLE CALL GET1ARG (X6) = PRIMARY KEYWORD ZR X6,ERR2FEW --- ERROR IF NO KEYWORD * /--- BLOCK COMMANDS 00 000 80/02/08 23.45 SA1 SYSFPTAB-1 (A1) = ADDR. OF 0TH KEYWORD MX0 48 (X0) = MASK FOR KEYWORD NAME SYSFIL1 SA1 A1+1 (X1) = NEXT KEYWORD TABLE ENTRY ZR X1,ERRNAME --- ERROR IF END OF TABLE BX2 X0*X1 (X2) = NEXT KEYWORD BX2 X2-X6 TEST IF SAME NZ X2,SYSFIL1 --- RELOOP IF NO MATCH BX1 -X0*X1 (X1) = TYPE OF KEYWORD SX6 A1-SYSFPTAB (X6) = PRIMARY KEYWORD NUMBER SA2 VARBUF (X2) = CURRENT VARBUF POINTER SX7 X2+1 UPDATE VARBUF POINTER SA7 A2+0 STORE INCREMENTED POINTER SA6 VARBUF+X7 STORE KEYWORD NUMBER NZ X1,SYSFIL2 --- READ/WRITE ARE SPECIAL SB1 SYSFSTAB (B1) = ADDR OF SECONDARY KEYWDS SB2 X6+13 (B2) = KEYWORD SHIFT RJ KEYWORDS PROCESS SECONDARY KEYWORDS EQ MRKLAST --- PACK UP VARBUF AND EXIT SYSFIL2 CALL NEXTARG GET STARTING SECTOR NUMBER CALL NEXTARG GET STORAGE INDEX SA1 LASTKEY (X1) = LAST CHARACTER PROCESSED ZR X1,SYSFIL3 --- IF END-OF-LINE REACHED SX1 X1-KSEMIC CHECK IF SEMI-COLON ZR X1,SYSFIL3 IF MORE KEYWORDS ARE PRESENT CALL NEXTARG PROCESS NUMBER OF SECTORS EQ SYSFIL4 SYSFIL3 CALL OMITTED MARK NO. OF SECTORS OMITTED SYSFIL4 CALL GET1ARG (X6) = NEXT KEYWORD ZR X6,MRKLAST IF NO MORE KEYWORDS SA1 KMSG (X1) = 7LMESSAGE IX6 X1-X6 NZ X6,ERRNAME IF NOT MESSAGE KEYWORD CALL NEXTARG GET VAR FOR ERROR MESSAGE SA1 LASTKEY (X1) = LAST KEY PROCESSED NZ X1,ERR2MNY ERROR IF NOT END-OF-LINE SYSFIL5 SA1 NEXTCOM (X1) = NEXT COMMAND SA2 COMCONT (X2) = CURRENT COMMAND BX1 X1-X2 TEST IF CONTINUED NZ X1,MRKLAST --- FINISH UP IF ALL OK EQ ERR2MNY --- ERROR IF CONTINUED COMMAND * * * PRIMARY -SYSFILE- KEYWORDS * * * * *SYSFIL* MACRO PARAMETERS -- * * * * PRIMARY = PRIMARY KEYWORD (ATTACH, ETC.) * * TYPE = 0 IF SECONDARY KEYWORDS, 1 IF * * SPECIAL HANDLING * PURGMAC SYSFIL MACREF SYSFIL$ SYSFIL MACRO PRIMARY,TYPE MACREF SYSFIL VFD 48/0L_PRIMARY,12/TYPE ENDM SYSFPTAB SYSFIL ATTACH,0 ATTACH FILE * /--- BLOCK COMMANDS 00 000 80/02/08 23.45 SYSFIL DETACH,0 DETACH FILE SYSFIL CHECK,0 CHECK EXISTENCE OF A FILE SYSFIL READ,1 READ FILE SYSFIL WRITE,1 WRITE FILE SYSFIL CREATE,0 CREATE FILE SYSFIL DESTROY,0 DESTROY FILE SYSFIL RENAME,0 RENAME FILE SYSFIL RETYPE,0 CHANGE FILE TYPE SYSFIL FBIT,0 SET/CLEAR BACKUP BIT SYSFIL RECREATE,0 DATA 0 MARK END OF TABLE PURGMAC SELECT MACREF SELECT$ SELECT MACRO ATR MACREF SELECT IRP ATR ATR SET 1 IRP ENDM PURGMAC CLEAR MACREF CLEAR$ CLEAR MACRO ATR MACREF CLEAR IRP ATR ATR SET 0 IRP ENDM * * * SECONDARY KEYWORD TABLE * * * * *SYSFKEY* MACRO PARAMETERS * * * * NUMBER = NUMBER OF KEYWORD * * NAME = NAME OF KEYWORD * * ADDRESS = ADDRESS OF ROUTINE TO PROCESS TAG * * FLPTFLG = ALPHA TO SUPPRESS F/I CONVERSION * * OPTS = COMMAND OPTIONS FOR WHICH THIS * * SECONDARY KEYWORD IS AVAILABLE * PURGMAC SYSFKEY SYSFKEY MACRO NUMBER,NAME,ADDRESS,FLPTFLG,OPTS LOCAL FICONV,UNUSED LOCAL FATTACH,FDETACH,FCHECK,FREAD,FWRITE LOCAL FCREATE,FDEST,FRENAME,FRETYPE LOCAL FFBIT LOCAL FRECRE UNUSED SET 0 IFC EQ,*FLPTFLG*ALPHA* FICONV SET 1 ELSE FICONV SET 0 ENDIF CLEAR (FATTACH,FDETACH,FCHECK,FREAD,FWRITE) CLEAR (FCREATE,FDEST,FRENAME,FRETYPE) CLEAR FFBIT CLEAR FRECRE IRP OPTS ALLIF IFC EQ,*OPTS*ALL* SELECT (FATTACH,FDETACH,FCHECK,FREAD,FWRITE) SELECT (FCREATE,FDEST,FRENAME,FRETYPE) SELECT FFBIT SELECT FRECRE ALLIF ELSE IFC EQ,*OPTS*ATTACH*,1 SELECT FATTACH * /--- BLOCK COMMANDS 00 000 80/02/08 23.45 IFC EQ,*OPTS*DETACH*,1 SELECT FDETACH IFC EQ,*OPTS*CHECK*,1 SELECT FCHECK * /--- BLOCK COMMANDS 00 000 80/02/08 23.45 IFC EQ,*OPTS*READ*,1 ERR NOT WITH THIS FUNCTION, TURKEY. IFC EQ,*OPTS*WRITE*,1 ERR NOT WITH THIS FUNCTION, TURKEY. IFC EQ,*OPTS*CREATE*,1 SELECT FCREATE IFC EQ,*OPTS*DESTROY*,1 SELECT FDEST IFC EQ,*OPTS*RENAME*,1 SELECT FRENAME IFC EQ,*OPTS*RETYPE*,1 SELECT FRETYPE IFC EQ,*OPTS*FBIT*,1 SELECT FFBIT IFC EQ,*OPTS*RECREATE*,1 SELECT FRECRE ALLIF ENDIF IRP DATA L*NAME* VFD 1/FICONV,12/UNUSED VFD 1/FATTACH,1/FDETACH,1/FCHECK,1/FREAD VFD 1/FWRITE,1/FCREATE,1/FDEST,1/FRENAME VFD 1/FRETYPE VFD 1/FFBIT VFD 1/FRECRE VFD 18/ADDRESS,18/NUMBER ENDM SYSFSTAB SYSFKEY 0,FILE,FILE,ALPHA,(ALL) SYSFKEY 1,PACK,WORD,ALPHA,(ALL) SYSFKEY 2,DIRECTORY,WORD,ALPHA,(ALL) SYSFKEY 3,MODE,WORD,,(ATTACH) SYSFKEY 4,STATION,NEXTKEYW,,(DETACH) SYSFKEY 5,MASTER,NEXTKEYW,,(DETACH) SYSFKEY 6,TYPE,WORD,,(ALL) SYSFKEY 7,LENGTH,WORD,,(CREATE,RECREATE) SYSFKEY 8,NPDWRITE,NEXTKEYW,,(CREATE) SYSFKEY 9,NEWNAME,FILE,ALPHA,(RENAME) SYSFKEY 9,(NEW NAME),FILE,ALPHA,(RENAME) SYSFKEY 10,DIRSIZE,WORD,,(CREATE,RECREATE) SYSFKEY 10,(DIR SIZE),WORD,,(CREATE,RECREATE) SYSFKEY 11,RMTSIZE,WORD,,(CREATE,RECREATE) SYSFKEY 11,(RMT SIZE),WORD,,(CREATE,RECREATE) SYSFKEY 12,ON,NEXTKEYW,,(FBIT) SYSFKEY 13,OFF,NEXTKEYW,,(FBIT) SYSFKEY 14,OLDPACK,WORD,ALPHA,(ALL) SYSFKEY 15,MESSAGE,WORD,ALPHA,(ALL) SYSFKEY 16,NOATTACH,NEXTKEYW,,(CHECK) SYSFKEY 17,ACCTRES,WORD,ALPHA,(ALL) SYSFKEY 18,SUBACCT,WORD,ALPHA,(CREATE,RECREATE,RENAME) SYSFKEY 19,ORIGINAL,WORD,,(CREATE,RECREATE,RENAME) DATA 0 MARK END OF TABLE * /--- BLOCK KEYWORDS 00 000 79/10/28 04.23 TITLE KEYWORD PROCESSING ROUTINES * * * -KEYWORDS- SUBROUTINE * * * * SEARCHES TABLE OF KEYWORDS AND JUMPS TO * * APPROPRIATE ROUTINES FOR PROCESSING * * * * ON ENTRY, B1 = ADDRESS OF KEYWORD TABLE * * B2 = PRIMARY KEYWORD SHIFT, 0 IF * * DOES NOT APPLY * KEYWORDS EQ * SX6 B1 SX7 B2 (X7) = PRIMARY KEYWORD SHIFT SA6 KEYWTAB SAVE ADDR. OF KEYWORD TABLE SA7 KEYWSHF STORE KEYWORD SHIFT NEXTKEYW CALL GET1ARG (X6) = NEXT KEYWORD ZR X6,KEYWORDS --- IF ALL KEYWORDS PROCESSED SA1 KEYWTAB X1 = ADDR. OF KEYWORD TABLE SA1 X1-2 INITIALIZE FOR KEYWORD SEARCH NEXTKEY2 SA1 A1+2 (X1) = NEXT KEYWORD ZR X1,ERRNAME --- ERROR IF END OF TABLE BX1 X1-X6 CHECK IF SAME NZ X1,NEXTKEY2 --- IF NO MATCH SA1 A1+1 X1 = KEYWORD INFO WORD SA2 KEYWSHF (X2) = KEYWORD SHIFT ZR X2,NEXTKEY3 --- IF NOT TO CHECK SB2 X2 LX2 X1,B2 SHIFT COMMAND BIT TO SIGN PL X2,ERRNAME --- IF THIS KEYWORD ILLEGAL NEXTKEY3 BX6 X1 (X6) = KEYWORD INFO WORD SA6 KEYWINFO SAVE A COPY SX6 X6 X6 = KEYWORD NUMBER SA2 VARBUF X2 = GETVAR CODE COUNTER SX7 X2+1 INCREMENT COUNTER SX3 X7-VARBUFL TEST IF VARBUF FULL PL X3,ERR2MNY --- ERROR IF VARBUF FULL SA7 A2 STORE UPDATE COUNTER SA6 VARBUF+X7 STORE KEYWORD NUMBER AX1 18 SHIFT TO ADDR. FIELD SB1 X1 B1 = ADDR OF PROCESSING ROUTINE JP B1 --- PROCESS KEYWORD ARGUMENT * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45 * * * ROUTINE TO PROCESS SINGLE ARGUMENT KEYWORDS * WORD CALL NEXTARG PROCESS NEXT ARGUMENT CALL CHKFLOAT FLOATING POINT CHECK EQ NEXTKEYW --- PROCESS NEXT KEYWORD * * * PROCESS ACCOUNT';FILE AND ARGUMENTS * FILE SB1 1 SA1 WORDPT X1 = ADDR OF NEXT CHAR SX1 X1-1 BACK UP FOR LOOP FILE1 SX1 X1+B1 X1 = ADDR OF NEXT CHAR SA2 X1 X2 = NEXT CHAR SX0 X2-1R CHECK IF BLANK ZR X0,FILE1 SKIP BLANKS ZR X2,ERR2FEW --- ERROR IF END OF LINE SX0 X2-KLT CHECK FOR LESLIST BRACKET ZR X0,FILE5 --- IF LESLIST BRACKET SA3 X2+KEYTYPE SX0 X3-OPCOMMA CHECK IF SEPARATOR ZR X0,ERR2FEW --- IF SEPARATOR REACHED SX0 0 X0 = 0 = NO SPECIAL TERMINATOR CALL PSCAN FIND END OF FIRST NAME SX0 X1-KSEMIC CHECK IF SEMI-COLON NZ X0,FILE2 --- IF NOT SEMI-COLON SA3 B1-1 X3 = PRECEDING CHAR SX0 X3-KUP CHECK IF SHIFT CODE NZ X0,FILE2 --- IF NOT SHIFT CODE EQ FILE3 --- IF ACCOUNT NAME PRESENT * * * ACCOUNT NAME OMITTED * FILE2 CALL OMITTED STORE OMITTED ARG GETVAR CODE EQ FILE4 --- PROCESS FILE NAME * * * PROCESS ACCOUNT NAME * FILE3 SX6 1R X6 = BLANK SA6 A3 REPLACE SHIFT CODE WITH BLANK *////// TEMPORARY -- ACCOUNT NAME LEGAL ONLY IN SYSTEM LESSONS SA1 SYSFLG LX1 ZSLDSHF PL X1,ERRNAME ERROR IF NOT SYSTEM LESSON *////// END TEMPORARY CALL NEXTARG PROCESS ACCOUNT NAME CALL CHKFLOAT MASK OUT FLOATING POINT BIT * * * PROCESS FILE NAME * FILE4 CALL NEXTARG PROCESS FILE NAME CALL CHKFLOAT MASK OUT FLOATING POINT BIT EQ NEXTKEYW --- ADVANCE TO NEXT KEYWORD * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45 * * * PROCESS REFERENCE * FILE5 SX1 X1+B1 ADVANCE PAST LEFT BRACKET BX6 X1 SA6 WORDPT UPDATE POINTER TO NEXT CHAR SX0 KGT SCAN FOR RIGHT BRACKET CALL PSCAN SX0 X1-KGT CHECK IF RIGHT BRACKET FOUND NZ X0,ERRTERM --- IF RIGHT BRACKET NOT FOUND SX6 1R SA6 B1 REPLACE RIGHT BRACKET W/BLANK SA1 VARBUF X1 = CURRENT VARBUF INDEX SX7 X1+1 SX2 X7-VARBUFL CHECK IF OVERFLOWING VARBUF PL X2,ERR2MNY --- IF VARBUF FULL SA7 A1 UPDATE VARBUF INDEX SA2 LESLCOD X2 = LESLIST GETVAR CODE BX6 X2 SA6 VARBUF+X7 STORE LESLIST CODE CALL NEXTARG EQ NEXTKEYW --- PROCESS NEXT KEYWORD LESLCOD VFD 60/LLCODE * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45 * * * -NEXTARG- * * * * PROCESSES NEXT VARIABLE ARGUMENT * NEXTARG EQ * SA1 WORDPT CURRENT POSITION SA1 X1 ZR X1,ERR2FEW --- IF END OF LINE REACHED CALL VARDO2 EQ NEXTARG * * * -GET1ARG- * * * * GET NEXT KEYWORD * * * * ON ENTRY, (WORDPT) = ADDR. OF NEXT CHARACTER * * (LASTKEY) = PREVIOUS DELIMITER * * * * ON EXIT, (X6) = NEXT KEYWORD, 0 IF NO MORE * GET1ARG EQ * SA1 WORDPT CHECK NEXT CHARACTER SA1 X1 (X1) = NEXT CHARACTER ZR X1,GET1ARG2 --- IF EOL, READ NEXT LINE SA1 LASTKEY (X1) = DELIMITER SX6 X1-KSEMIC CHECK FOR SEMI-COLON ZR X6,GET1ARG3 --- GO READ NEXT LINE EQ ERR2MNY --- ERROR IF NO DELIMITER GET1ARG2 SA1 NEXTCOM (X1) = COMMAND FOR NEXT LINE SA2 COMCONT (X2) = CURRENT COMMAND BX3 X1-X2 CHECK IF CONTINUED COMMAND NZ X3,GET1ARG4 --- IF NOT CONTINUED LINE CALL GETLINE READ NEXT LINE GET1ARG3 CALL NXTNAM (X6) = TAG, (X1) = SEPARATOR ZR X6,ERRNAME --- ERROR IF NONE OR TOO LONG BX7 X1 (X7) = SEPARATOR SA7 LASTKEY SAVE DELIMITER EQ GET1ARG --- RETURN GET1ARG4 MX6 0 (X6) = 0 IF NO MORE KEYWORDS EQ GET1ARG --- RETURN * * * CHKFLOAT MASKS OUT THE FLOATING POINT BIT SO THAT * * ALPHAMERIC FIELDS WILL NOT BE CONVERTED TO * * INTEGER IF DEFINED IN V-TYPE VARIABLES * CHKFLOAT EQ * SA1 KEYWINFO X1 = KEYWORD INFO WORD PL X1,CHKFLOAT --- IF NOT ALPHAMERIC SA1 VARBUF X1 = NO. OF GETVAR CODES SB2 X1 SA1 A1+B2 X1 = LAST GETVAR CODE MX0 61-XCODEL+XFBIT BX6 -X0*X1 GET RID OF FLOATING POINT BIT SA6 A1 PUT GETVAR CODE BACK IN PLACE EQ CHKFLOAT --- RETURN * * * STORE SPECIAL CODE FOR OMITTED ARGUMENTS * OMITTED EQ * MX6 1 LX6 19 SET 19TH BIT = OMITTED ARGUMENT SA1 VARBUF CURRENT VARBUF INDEX SX7 X1+1 * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45 SX2 X7-VARBUFL SUBTRACT OFF SIZE OF VARBUF PL X2,ERR2MNY EXIT IF VARBUF BUFFER FULL SA7 A1 SA6 VARBUF+X7 STORE DUMMY ARGUMENT EQ OMITTED * * * VARIABLES * KEYWTAB BSS 1 ADDRESS OF KEYWORD TABLE KEYWSHF BSS 1 PRIMARY KEYWORD NUMBER/SHIFT KEYWINFO BSS 1 1/ALPHA FLAG,23/0,18/ADDR,18/NO KMSG DATA 7LMESSAGE ENDOV * /--- BLOCK END 00 000 76/07/21 20.45 * * OVTABLE * * END COVLY3$