EXEC6 * /--- FILE TYPE = E * /--- BLOCK EXEC6 00 000 81/08/26 21.47 IDENT PLAT5$ LCC OVERLAY(PLATO,1,0) END IDENT EXEC6 TITLE EXEC6 OVERLAYS FOR COMMAND EXECUTION * * CST * * EXEC6$ OVFILE * * EXT ECSPRTY,DOVRET,PROC,RETRNX,RETPRO EXT BOUNDS,PROCESS,ANSDAT EXT AREAOUT,HELPOUT,TERMOUT,ERRDATO,ERXDATO EXT OUTDATT EXT NKLIST,NKLEND,RLLOOP,RALOOP,SDSETX EXT SDCHKX,RSLOOP EXT ERXBADL,ERXVAL,ERXBOFF,ERXEODF EXT ERXBFT ERROR EXIT, -EXEC2- EXT DATAOUT,DATAO,DATAOA,DARG1,DARG2 EXT FINISH * * * /--- BLOCK OUTPUT 00 000 74/03/13 23.42 TITLE -OUTPUT- COMMAND * * * -OUTPUT- COMMAND * OUTPUTS AUTHOR GENERATED STUDENT DATA * * FIRST WORD - * IST 6 BITS = NUMBER OF ENTRIES * NEXT 6 = LENGTH OF ENTRY TYPE TABLE * NEXT 18 = ELAPSED TIME * NEXT 18 = UNUSED * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 2 WORDS = STUDENTS NAME * NEXT WORD = LESSON NAME * NEXT WORD = AREA NAME * NEXT N WORDS = DATA TYPE TABLE * NEXT N WORDS = AUTHOR GENERATED DATA * * OUTOV OVRLAY LX5 18 POSITION NUMBER OF ENTRIES SX6 X5 SA6 NENT SA6 NENTX LX5 18 POSITION BIAS TO TABLE SX7 X5+B5 SA7 NTAB MX6 0 SA6 INDX INITIALIZE INDEX IN TABLE SA6 INDX1 SA6 ILTH INITIALIZE TOTAL WORD COUNT SA6 INFO+5 SX6 60 SA6 SHFT1 INITIALIZE SHIFT COUNT * OD100 SA1 NENTX NUMBER OF ENTRIES TO PROCESS SX6 X1-1 NG X6,OD900 SA6 A1 MX0 -1 SA1 INDX SX6 X1+1 ADVANCE INDEX SA6 A1 BX5 -X0*X1 MASK OFF ODD/EVEN BIT AX1 1 SB1 X1 WORD COUNT SA2 NTAB SA1 X2+B1 LOAD PROPER WORD OF TABLE NZ X5,OD120 AX1 30 EXTEND SIGN EQ OD140 * OD120 LX1 30 AX1 30 EXTEND UPPER BIT OF ENTRY * /--- BLOCK OUTPUT 00 000 74/03/13 23.34 * OD140 NG X1,OD500 JUMP IF -EMBEDDED- VARIABLE MX0 -9 BX2 -X0*X1 MASK OFF BIAS TO TEXT SA0 X2+B5 CM ADDRESS OF TEXT AX1 9 SB1 X1 PICK UP NUMBER OF WORDS SA1 ILTH SX6 X1+B1 INCREMENT TOTAL WORD COUNT SA6 A1 SA2 ATEMPEC ADDRESS OF ECS BUFFER IX0 X1+X2 + WE B1 TRANSFER TEXT TO ECS RJ ECSPRTY SX7 B1 6/TYPE (0=ALPHA), 6/LENGTH RJ PUTTAB PUT NEXT ENTRY INTO TABLE EQ OD100 * OD500 BX5 X1 SET UP FOR -GETVAR- CALL LX5 60-XCODEL MX0 -6 MASK FOR TYPE CODE AX1 XCODEL BX7 -X0*X1 MASK OFF TYPE CODE SB3 X7-3 SAVE FOR FLOATING POINT CHECK LX7 6 SX7 X7+1 6/TYPE, 6/LENGTH RJ PUTTAB MAKE ENTRY IN TABLE ZR B3,OD520 JUMP IF FLOATING POINT NGETVAR EQ OD540 * OD520 FGETVAR * OD540 BX6 X1 STORE FOR ECS TRANSFER SA6 ITEMP SA1 ILTH SX6 X1+1 INCREMENT TOTAL WORD COUNT SA6 A1 SA2 ATEMPEC ADDRESS OF ECS BUFFER IX0 X1+X2 SA0 ITEMP TRANSFER WORD TO ECS + WE 1 RJ ECSPRTY EQ OD100 PROCESS NEXT ENTRY * /--- BLOCK OUTPUT 00 000 74/03/13 23.35 * OD900 SA1 ILTH NUMBER OF WORDS OF TEXT SA2 INDX1 SA3 SHFT1 SEE IF LAST TABLE WORD EMPTY SX3 X3-60 ZR X3,OD910 JUMP IF LAST WORD EMPTY SX2 X2+1 * OD910 SA0 X2+INFO+5 CM ADDRESS OF TEXT SB1 X1 SA3 ATEMPEC ECS ADDRESS OF TEXT BX0 X3 + RE B1 BRING TEXT INTO *INFO* RJ ECSPRTY IX6 X1+X2 COMPUTE TOTAL LENGTH OF DATA SX6 X6+5 ADD FOR HEADER AND NAME SB2 X6 SET UP FOR CALL LX6 6 SX6 X6+AUTHD ATTACH DATA TYPE CODE SA1 NENT LX1 60-6 POSITION NUMBER OF ENTRIES BX6 X1+X6 LX2 60-6-6 POSITION LENGTH OF TABLE BX6 X2+X6 MX0 -18 SA1 SYSCLOK LOAD RUNNING CLOCK SA2 TIMEARK IX1 X1-X2 ELAPSED TIME AT ENTRY AX1 7 KEEP TO ABOUT 1/10 SECOND BX1 -X0*X1 LX1 60-6-6-18 BX6 X1+X6 SA6 INFO STORE HEADER WORD SA1 TNAME BX6 X1 FIRST WORD OF STUDENT NAME SA6 INFO+1 MX0 48 SA1 TNAME1 BX6 X0*X1 SECOND WORD OF STUDENT NAME SA6 INFO+2 CALL FSQUISH,TBLESAC BX6 X1 SA6 INFO+3 SA1 TBAREA AREA NAME BX6 X1 SA6 INFO+4 EQ DOVRET * * /--- BLOCK OUTPUT 00 000 74/03/13 23.35 * * PUTTAB EQ * ENTRY / EXIT SA2 INDX1 CURRENT WORD IN NEW TABLE SA1 SHFT1 SX6 X1-12 COMPUTE SHIFT COUNT PL X6,PT1 SX6 60-12 RE-INITIALIZE SHIFT COUNT SA6 A1 SX6 X2+1 ADVANCE WORD COUNT SA6 A2 LX7 60-12 POSITION FIRST BYTE SA7 X6+INFO+5 EQ PUTTAB * PT1 SB1 X6 PICK UP SHIFT COUNT SA6 A1 LX7 X7,B1 SA1 X2+INFO+5 LOAD CURRENT WORD BX7 X1+X7 SA7 A1 STORE WITH NEW ENTRY EQ PUTTAB * * NENT EQU INFO+DATAMAX+5 NENTX EQU NENT+1 NTAB EQU NENTX+1 INDX EQU NTAB+1 INDX1 EQU INDX+1 SHFT1 EQU INDX1+1 ILTH EQU SHFT1+1 * * ENDOV * /--- BLOCK OUTPUTL 00 000 78/07/05 01.26 TITLE -OUTPUTL- COMMAND * * * -OUTPUTL- COMMAND * OUTPUTS AUTHOR GENERATED DATA WITH LABEL * * FIRST WORD - * IST 18 BITS = ELAPSED TIME * NEXT 30 = UNUSED * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 2 WORDS = STUDENTS NAME * NEXT WORD = LESSON NAME * NEXT WORD = AREA NAME * NEXT WORD = DATA LABEL * NEXT N WORDS = AUTHOR GENERATED DATA * * OUTLOV OVRLAY NG X5,OUTDLX NGETVAR GET OUTPUT LABEL CALL LJUST,(1R ),0 BX6 X1 SA6 INFO+5 SA5 A5 RESTORE X5 LX5 XCODEL NGETVAR GET STARTING ADDRESS SX6 A1 SA6 OLWK SA5 A5 RESTORE X5 AX5 XCMNDL MX2 2*XCODEL+XCMNDL BX5 -X2*X5 MASK OFF XSTOR POINTER SA2 X5+B5 BX5 X2 -GETVAR- CODE TO X5 FOR CALL NGETVAR GET NUMBER OF WORDS TO OUTPUT NG X1,ERXBADL NO NEGATIVE OR ZERO LENGTH ZR X1,ERXBADL EXECERR USES X1 FOR ERXBADL SB2 X1-21 PL B2,ERXBADL ERROR IF TOO MUCH DATA * /--- BLOCK OUTPUTL 00 000 74/03/13 23.46 * SA2 OLWK LOAD STARTING ADDRESS SA0 X2 CALL BOUNDS SB1 X1 RESTORE LENGTH SB2 B1+6 SAVE TOTAL LENGTH FOR LATER SA1 ATEMPEC BX0 X1 + WE B1 TRANSFER TO *INFO* VIA ECS RJ ECSPRTY SA0 INFO+6 + RE B1 RJ ECSPRTY MX0 -18 SA1 SYSCLOK LOAD CURRENT CLOCK SA2 TIMEARK IX1 X1-X2 COMPUTE ELAPSED TIME AX1 7 BX1 -X0*X1 KEEP TO 1/10 SECOND LX1 60-18 SX6 B2 PICK UP TOTAL LENGTH LX6 6 SX6 X6+AUTHDL LENGTH AND CODE BX6 X1+X6 SA6 INFO STORE HEADER WORD SA1 TNAME BX6 X1 STORE FIRST WORD OF NAME SA6 INFO+1 MX0 -12 SA1 TNAME1 BX6 X0*X1 STORE SECOND WORD OF NAME SA6 INFO+2 CALL FSQUISH,TBLESAC BX6 X1 SA6 INFO+3 SA1 TBAREA AREA NAME BX6 X1 SA6 INFO+4 EQ DOVRET * * /--- BLOCK OUTPUTL 00 000 78/07/05 01.26 * * -OUTPUTL- COMMAND * TWO ARGUMENT -OUTPUTL- MINIMUM HEADER INFO * * OUTDLX MX6 1 BX5 -X6*X5 CLEAR FLAG BIT NGETVAR SX6 A1 SAVE ADDRESS SA6 OLWK SA5 A5 GET NEXT -GETVAR- CODE LX5 XCODEL NGETVAR GET NUMBER OF WORDS TO OUTPUT NG X1,ERXBADL NO NEGATIVE OR ZERO LENGTH ZR X1,ERXBADL EXECERR USES X1 FOR ERXBADL SB2 X1-21 PL B2,ERXBADL ERROR IF TOO MUCH DATA SA2 OLWK LOAD STARTING ADDRESS SA0 X2 CALL BOUNDS SB1 X1 RESTORE LENGTH SB2 B1+1 SAVE TOTAL LENGTH FOR LATER SA1 ATEMPEC BX0 X1 + WE B1 TRANSFER TO *INFO* VIA ECS RJ ECSPRTY SA0 INFO+1 + RE B1 RJ ECSPRTY SX6 B2 PICK UP LENGTH OF RECORD LX6 6 SX6 X6+AUTHDX ATTACH DATA TYPE CODE SA6 INFO EQ DOVRET * * OLWK BSS 1 * ENDOV * /--- BLOCK OUTPUTT 00 000 78/07/05 01.27 TITLE -OUTPUTT- OUTPUT TEXT FORMAT DATA * * * -OUTPUTT- * OUTPUTS AUTHOR GENERATED TEXT * * FIRST WORD - * IST 48 BITS = UNUSED * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 'N WORDS = TEXT TO BE PUT INTO DATAFILE * * OUTTOV OVRLAY * NGETVAR GET ADDRESS OF CHARACTER STRING SX6 A1 SA6 VARBUF SAVE FOR LATER * SA5 A5 RE-FETCH COMMAND WORD LX5 XCODEL NGETVAR GET SECOND ARGUMENT * NG X1,ERXBADL BAD LTH, EXECERR USES X1 ZR X1,PROCESS JUST EXIT IF LENGTH UNSUITABLE SX6 X1-DATAMAX+1-1 1 WORD FOR HEADER PL X6,DERXBAD LIMIT OF *DATAMAX* WORDS * SA2 VARBUF RE-FETCH STARTING ADDRESS * SA0 X2 PREPARE FOR BOUNDS TEST RJ BOUNDS SEE IF ALL WITHIN BOUNDS * * SB1 X1 LTH OF BUFFER SX1 X1+1 LENGTH OF RECORD SB2 X1 SAVE FOR DATAOUT * LX1 6 POSITION LENGTH OF RECORD SX6 X1+DOUTT ATTACH DATA TYPE CODE SA6 INFO STORE HEADER WORD * SA1 ATEMPEC BX0 X1 ADDRESS OF SCRATCH ECS + WE B1 RJ ECSPRTY SA0 INFO+1 MOVE BUFFER SPECIFIED TO *INFO* + RE B1 RJ ECSPRTY * * EQ DOVRET * DERXBAD SX2 DATAMAX-1 POSSIBLY OFF BY ONE EXECERR 98 VALUE TOO HIGH * ENDOV * /--- BLOCK ANSDAT 00 000 76/04/26 04.55 TITLE -ANSDAT- OUTPUT STUDENTS ANSWER * * * -ANSDAT- * OUTPUTS STUDENT ANSWER AND RELATED INFORMATION * * FIRST WORD - * 1ST 18 BITS = ELAPSED TIME SINCE SIGN-ON * NEXT 6 = JUDGEMENT TYPE * NEXT 9 = ARROW NUMBER * NEXT 15 = ANSWER DUMP CAUSE BITS * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 2 WORDS = STUDENTS NAME * NEXT WORD = LESSON NAME * NEXT WORD = AREA NAME * NEXT WORD = UNIT NAME * NEXT N WORDS = STUDENTS ANSWER * * ANSDOV OVRLAY SA1 TBITS SEE IF -ERASEU- BIT SET LX1 ERSUBIT NG X1,ANSDAT EXIT IF PROCESSING -ERASEU- MX6 -1 MARK *INFO* BUFFER USED SA6 JJSTORE SA1 TJUDGED LOAD JUDGMENT NG X1,DANS1 JUMP IF -OK- ZR X1,DANS2 JUMP IF RECOGNIZED -NO- CALL AREAINC,1,27 MX7 1 LX7 DSUNO POSITION BIT FOR UNRECOGINZED SA1 TBLDATA+1 BX7 X1+X7 MERGE WITH REST OF DUMP BITS MX1 1 LX1 DSNO POSITION BIT FOR -NO- BX7 X1+X7 SA7 A1 EQ ANSXX * DANS1 CALL AREAINC,1,9 SA1 TBLDATA+1 MX7 1 LX7 DSOK SET BIT FOR -OK- BX7 X1+X7 SA7 A1 MX7 -9 BX7 -X7*X1 MASK OFF NUMBER OF TRIES SX7 X7-1 NZ X7,ANSXX JUMP IF NOT FIRST TRY CALL AREAINC,1,18 EQ ANSXX * /--- BLOCK ANSDAT 00 000 74/12/31 18.47 * DANS2 CALL AREAINC,1,0 SA1 TBLDATA+1 MX7 1 LX7 DSNO SET BIT FOR -NO- BX7 X1+X7 SA7 A1 * ANSXX SA1 TBLDATA SELECTED DATA OPTION BITS SB1 X1 SEE IF COLLECTING DATA SA2 TBTDATA NG X2,ANSDAT EXIT IF -SYSDATA- USAGE BX1 X1+X2 ATTACH LESSON-SELECTED BITS SA2 TBLDATA+1 MX0 -9 BX6 -X0*X2 CLEAR OUT ALL BUT TRY COUNTER SA6 A2 ZR B1,ANSDAT EXIT IF NOT COLLECTING DATA BX6 X1*X2 SEE IF SHOULD DUMP ANSWER AX6 18 ZR X6,ANSDAT MX0 15 ALLOW 15 BITS ONLY LX2 1 BX6 X0*X2 MASK OFF DUMP CAUSE BITS SA6 ADWK1 SA1 LESUN LOAD UNIT NUMBER SX6 X1 SA6 ADWK CONVERT NUMBER TO NAME CALL HOLUNIT,ADWK,ADWK MX0 -18 SA1 SYSCLOK LOAD CURRENT CLOCK SA2 TIMEARK IX1 X1-X2 COMPUTE ELAPSED TIME AX1 7 KEEP TO ABOUT 1/10 SECOND BX1 -X0*X1 LX1 60-18 POSITION ELAPSED TIME MX0 -6 SA2 TJUDGED LOAD ANSWER JUDGMENT SX6 X2+2 1=OK 2=NO 3=UNREC NO BX2 -X0*X6 LX2 60-18-6 BX6 X1+X2 BEGIN FORMING HEADER WORD * /--- BLOCK ANSDAT 00 000 76/05/17 22.12 * MX0 -9 SA1 AREADAT BX1 -X0*X1 MASK OFF ARROW COUNT LX1 60-18-6-9 BX6 X6+X1 MERGE WITH HEADER WORD SA1 LONG NUMBER OF 6 BIT CODES SX1 X1+9 PX1 X1 PACK CHARACTER COUNT SA2 ADK1 FX1 X1*X2 COMPUTE NUMBER OF WORDS SB1 X1 SX1 X1+6 INCREMENT FOR ADDITIONAL INFO SB2 X1 SAVE TOTAL COUNT FOR CALL LX1 6 POSITON WORD COUNT BX6 X6+X1 SA1 ADWK1 LOAD DUMP-CAUSE BITS LX1 6+6+15 BX6 X1+X6 SX1 STANS CODE FOR STUDENT ANSWER BX6 X6+X1 SA6 INFO STORE COMPLETED HEADER SA1 TNAME FIRST WORD OF STUDENTS NAME BX6 X1 SA6 INFO+1 MX0 48 SA1 TNAME1 SECOND WORD OF STUDENTS NAME BX6 X0*X1 SA6 INFO+2 CALL FSQUISH,TBLESAC BX6 X1 SA6 INFO+3 SA1 TBAREA AREA NAME BX6 X1 SA6 INFO+4 SA1 ADWK LOAD UNIT NAME BX6 X1 SA6 INFO+5 SA1 TBINPUT ADDRESS OF STUDENTS ANSWER SA0 X1 SA1 ATEMPEC ADDRESS OF ECS SCRATCH BUFFER BX0 X1 + WE B1 MOVE STUDENTS ANSWER RJ ECSPRTY SA0 INFO+6 + RE B1 RJ ECSPRTY EQ ADVEXIT * ADK1 DATA 17170631463146314632B (1/10)*2**-48 ADWK BSS 1 ADWK1 BSS 1 * ADVEXIT RETURN * * ENDOV * /--- BLOCK AREAOUT 00 000 74/12/31 18.47 TITLE -AREAOUT- OUTPUT -AREA- COMMAND DATA * * * -AREAOUT- * OUTPUTS DATA ASSOCIATED WITH -AREA- COMMAND * * FIRST WORD - * IST 18 BITS = CURRENT TIME * NEXT 30 = UNUSED * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 2 WORDS = STUDENTS NAME * NEXT WORD = LESSON NAME * NEXT WORD = AREA NAME * NEXT 3 WORDS = AREA DATA * * AREAOV OVRLAY SA1 TBLDATA SEE IF COLLECTING DATA SX2 X1 ZR X2,AREAOUT SA2 TBTDATA ATTACH LESSON-SELECTED BITS NG X2,AREAOUT EXIT IF -SYSDATA- BX1 X1+X2 LX1 60-DSAREA SEE IF SHOULD DUMP -AREA- PL X1,AREAOUT SA1 TBAREA SEE IF ANY -AREA- COMMAND ZR X1,AREAOUT BX6 X1 STORE -AREA- NAME SA6 INFO+4 MX0 -18 SA1 SYSCLOK LOAD CURRENT CLOCK SA2 TIMEARK IX2 X1-X2 COMPUTE ELAPSED TIME AX2 7 KEEP TO ABOUT 1/10 SECOND BX2 -X0*X2 LX2 60-18 POSITION ELAPSED TIME * /--- BLOCK AREAOUT 00 000 77/11/05 07.47 * MX0 18 SA1 AREADAT+1 GET TIME OF ENTRY TO AREA BX1 X0*X1 IX1 X2-X1 CURRENT TIME - ENTRY TIME SA3 AREADAT+2 GET PREVIOUS ELAPSED TIME BX6 X0*X3 IX6 X1+X6 ADD ON RECENT ELAPSED TIME BX6 X0*X6 BX3 -X0*X3 CLEAR OUT OLD ELAPSED TIME BX6 X3+X6 SA6 A3 SX6 1000B+DAREA LENGTH AND CODE BX6 X6+X2 SA6 INFO STORE HEADER WORD SA1 TNAME BX6 X1 FIRST WORD OF STUDENTS NAME SA6 INFO+1 MX0 48 SA1 TNAME1 SECOND WORD OF NAME BX6 X0*X1 SA6 INFO+2 CALL FSQUISH,TBLESAC BX6 X1 SA6 INFO+3 SA1 AREADAT AREA DATA WORD BX6 X1 SA6 INFO+5 SA1 AREADAT+1 SECOND AREA DATA WORD BX6 X1 SA6 INFO+6 SA1 AREADAT+2 THIRD AREA DATA WORD BX6 X1 SA6 INFO+7 LX1 18 CHECK IF LAST AREA WAS COMPLETE MX0 1 LX0 60-18-1 POSITION AREA CONTINUED BIT BX6 X0+X6 SET CONTINUATION BIT SA6 A1 WRITE TO INFO BUFFER PL X1,AOVEND MX6 0 SA6 TBAREA CLEAR OUT AREA NAME SA6 AREADAT MX0 -18 SA1 AREADAT+2 SAVE -DATAON- TIME BX6 -X0*X1 IN LOWER 18 BITS SA6 AREADAT+2 SA1 SYSCLOK LOAD RUNNING CLOCK SA2 TIMEARK IX1 X1-X2 ELAPSED TIME AT ENTRY AX1 7 KEEP TO ABOUT 1/10 SECOND BX6 -X0*X1 LX6 60-18 SA6 AREADAT+1 INITIALIZE DATA FOR THIS AREA * AOVEND RETURN * * ENDOV * /--- BLOCK HELPOUT 00 000 74/12/31 18.49 TITLE -HELPOUT- OUTPUT -HELP- KEY DATA * * * -HELPOUT- * OUTPUTS HELP-TYPE KEY DATA * * ON ENTRY - *OVARG1* = 0 IF HELP NOT FOUND * -1 IF HELP WAS FOUND * X5 = UNIT NUMBER * * FIRST WORD - * IST 18 BITS = CURRENT TIME * NEXT 30 = UNUSED * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 2 WORDS = STUDENTS NAME * NEXT WORD = LESSON NAME * NEXT WORD = AREA NAME * NEXT WORD = CURRENT UNIT NAME * NEXT WORD = HELP UNIT NAME (OR 0) * NEXT WORD = HELP KEY NAME * * HELPOV OVRLAY BX6 X5 SAVE X5 (UNIT NUMBER) SA6 HELPSAV SA1 OVARG1 NG X1,HLPA JUMP IF -HELP- WAS FOUND CALL AREAINC,0,9 SA1 TBLDATA SX2 X1 SEE IF COLLECTING DATA ZR X2,HELPOUT SA2 TBTDATA NG X2,HELPOUT EXIT IF -SYSDATA- BX1 X1+X2 ATTACH LESSON-SELECTED BITS LX1 60-DSHELPN SEE IF COLLECTING -HELP- DATA PL X1,HELPOUT MX6 0 SET FOR -HELP- NOT FOUND SA6 INFO+6 EQ HLPB * HLPA CALL AREAINC,0,18 SA1 TBLDATA SX2 X1 SEE IF COLLECTING DATA ZR X2,HELPOUT SA2 TBTDATA ATTACH LESSON-SELECTED BITS NG X2,HELPOUT EXIT IF -SYSDATA- BX1 X1+X2 LX1 60-DSHELP PL X1,HELPOUT SEE IF COLLECTING -HELP- DATA SA1 ILESUN BX5 X1 BE SURE LESSON POINTERS SET CALL SETLESN CALL HOLUNIT,HELPSAV,INFO+6 * /--- BLOCK HELPOUT 00 000 76/05/17 22.12 * HLPB SA1 KEY CONVERT KEY NUMBER TO NAME SA2 HK1 *NOSUCH* BX6 X1+X2 MAKE UP NAME IN CASE NO FIND SA6 NKLEND MX0 -18 MASK FOR KEY NUMBER SA2 NKLIST-1 * HKLP SA2 A2+1 LOAD NEXT KEY NAME/NUMBER BX3 -X0*X2 BX3 X1-X3 SEE IF NUMBERS MATCH NZ X3,HKLP BX6 X0*X2 MASK OFF KEY NAME SA6 INFO+7 SA1 SYSCLOK LOAD CURRENT CLOCK SA2 TIMEARK IX1 X1-X2 COMPUTE ELAPSED TIME AX1 7 BX1 -X0*X1 KEEP TO 1/10 SECOND LX1 60-18 SX6 1000B+HELPD BX6 X1+X6 FORM HEADER WORD SA6 INFO SA1 TNAME BX6 X1 FIRST WORD OF STUDENT NAME SA6 INFO+1 MX0 -12 SA1 TNAME1 BX6 X0*X1 SECOND WORD OF STUDENT NAME SA6 INFO+2 CALL FSQUISH,TBLESAC BX6 X1 STORE LESSON NAME SA6 INFO+3 SA1 TBAREA BX6 X1 STORE AREA NAME SA6 INFO+4 SA1 TUNAME BX6 X1 STORE CURRENT UNIT NAME SA6 INFO+5 EQ HOEXIT * HK1 DATA 6LNOSUCH * HOEXIT RETURN * * ENDOV * /--- BLOCK TERMOUT 00 000 76/05/29 00.23 TITLE -TERMOUT- OUTPUT -TERM- DATA * * * -TERMOUT- * OUTPUTS TERM REQUEST INFO * * ON ENTRY - *OVARG1* = 0 IF TERM NOT FOUND * -1 IF TERM WAS FOUND * * FIRST WORD - * IST 18 BITS = CURRENT TIME * NEXT 30 = UNUSED * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 2 WORDS = STUDENTS NAME * NEXT WORD = LESSON NAME * NEXT WORD = AREA NAME * NEXT WORD = TERM DATA * * TERMOV OVRLAY SA1 OVARG1 ZR X1,TRMOUT0 JUMP IF TERM NOT FOUND CALL AREAINC,0,36 SA1 TBLDATA SEE IF COLLECTING DATA SX2 X1 ZR X2,TERMOUT SA2 TBTDATA ATTACH LESSON-SELECTED BITS NG X2,TERMOUT EXIT IF -SYSDATA- BX1 X1+X2 LX1 60-DSTERM PL X1,TERMOUT SEE IF TERM DUMP SPECIFIED MX7 0 FLAG FOR TERM FOUND EQ TRMOUT1 * TRMOUT0 CALL AREAINC,0,27 SA1 TBLDATA SEE IF COLLECTING DATA SX2 X1 ZR X2,TERMOUT SA2 TBTDATA ATTACH LESSON-SELECTED BITS NG X2,TERMOUT EXIT IF -SYSDATA- BX1 X1+X2 LX1 60-DSTERMN PL X1,TERMOUT SEE IF TERM DUMP SPECIFIED SX7 1 * TRMOUT1 MX0 -18 SA1 SYSCLOK LOAD CURRENT CLOCK SA2 TIMEARK IX1 X1-X2 COMPUTE ELAPSED TIME AX1 7 BX1 -X0*X1 KEEP TO 1/10 SECOND LX1 60-18 SX6 600B+TERMD LENGTH AND CODE BX6 X1+X6 SA6 INFO STORE HEADER WORD SA1 TNAME BX6 X1 STORE FIRST WORD OF NAME SA6 INFO+1 MX0 -12 SA1 TNAME1 BX6 X0*X1 STORE SECOND WORD OF NAME SA6 INFO+2 CALL FSQUISH,TBLESAC BX6 X1 SA6 INFO+3 SA1 TBAREA AREA NAME BX6 X1 SA6 INFO+4 * SA1 TTERM TERM NAME BX6 X1+X7 STORE TERM NAME AND BIT SA6 INFO+5 RETURN * ENDOV * * * /--- BLOCK PARAMETERS 00 000 77/07/14 03.38 TITLE PARAMETERS FOR READL,READA,READD * * THE FOLLOWING BUFFER IS USED BY READL, READA, READD * OVERLAYS TO ASSEMBLE THE STUDENT DATA PACKAGE TO BE * WRITTEN TO ECS. * IIBUFF EQU INFO+DATAMAX+1 * * * /--- BLOCK READL 00 000 78/12/23 00.34 TITLE READL * * -READL- COMMAND * * READ NEXT -OUTPUTL- DATA RECORD * * ON EXIT-- * *TRETURN* = -1 IF OK * 0 IF END-OF-FILE ENCOUNTERED * (*TERROR* = REVERSE OF ABOVE) * * READLOV OVRLAY MX0 -6 SA1 INFO LOAD HEADER WORD ZR X1,RLEOF JUMP IF END-OF-FILE BX2 -X0*X1 SX6 X2-AUTHDL CHECK FOR -OUTPUTL- ZR X6,RLLPA SX6 X2-AUTHDX ZR X6,RDOLX JUMP IF TWO-ARG -OUTPUTL- EQ RLLOOP * RLLPA MX6 18 BX6 X6*X1 MASK OFF TIME LX6 18+7 SA6 IIBUFF+5 AX1 6 POSITION LENGTH OF RECORD BX1 -X0*X1 SX6 X1+1 LENGTH OF RE-FORMATTED RECORD SA6 IIBUFF SA1 INFO+2 SECOND WORD OF STUDENT NAME BX6 X1 SA6 IIBUFF+2 SA1 INFO+1 FIRST WORD OF STUDENT NAME * RLLP0 BX6 X1 SA6 IIBUFF+1 SA1 INFO+3 BX6 X1 LESSON NAME SA6 IIBUFF+3 SA1 INFO+4 BX6 X1 AREA NAME SA6 IIBUFF+4 SA1 INFO+5 BX6 X1 OUTPUT LABEL SA6 IIBUFF+6 SA1 IIBUFF LENGTH OF RECORD SB3 X1 SAVE TOTAL LENGTH OF RECORD SB1 X1-7 LENGTH OF AUTHOR DATA SA2 ATEMPEC BX0 X2 SA0 IIBUFF REFORM RECORD IN TEMP ECS WE 7 RJ ECSPRTY SA0 INFO+6 SX3 7 ADVANCE ECS ADDRESS IX0 X0+X3 WE B1 WRITE OUT AUTHOR DATA RJ ECSPRTY * RLLPB SA1 TBDFINF+1 SB2 X1 PICK OFF ADDRESS OF BUFFER AX1 18 SB1 X1 PICK OFF LENGTH OF BUFFER BX0 X2 ECS SCRATCH BUFFER SA0 B2 RE B1 MOVE DATA TO AUTHOR BUFFER RJ ECSPRTY GE B3,B1,RLLP1 SA0 B2+B3 SB3 B1-B3 SX1 A0 SAVE *A0* ZERO X1,B3 CLEAR OUT REST OF BUFFER * /--- BLOCK RLLP1 00 000 78/12/23 00.36 * RLLP1 MX6 -1 -1 = OK MX7 0 SA6 TRETURN SA7 TERROR EQ PROCESS --- RETURN * RDOLX AX1 6 POSITION LENGTH OF RECORD BX1 -X0*X1 SB1 X1-1 LENGTH OF AUTHOR DATA SX6 B1+7 LENGTH OF REFORMATED RECORD SA6 IIBUFF SB3 X6 MX6 0 CLEAR OUT NAME, LESSON ETC SA6 IIBUFF+1 SA6 IIBUFF+2 SA6 IIBUFF+3 SA6 IIBUFF+4 SA6 IIBUFF+5 SA6 IIBUFF+6 SA2 ATEMPEC BX0 X2 SA0 IIBUFF REFORM RECORD IN ECS WE 7 RJ ECSPRTY SX3 7 IX0 X0+X3 SA0 INFO+1 WE B1 WRITE OUT AUTHOR DATA RJ ECSPRTY EQ RLLPB * * RLEOF SA1 TBDFINF+1 LOAD BUFFER ADDRESS/LENGTH SA0 X1 PICK OFF ADDRESS AX1 18 SB1 X1 PICK OFF LENGTH SX1 A0 SAVE *A0* ZERO X1,B1 ZERO REST OF BUFFER SA1 TBDFINF SX1 X1 RELEASE DATA-READ BUFFER CALL ALTLES,-1 MX6 0 SA6 TBDFINF CLEAR OUT INFO WORDS SA6 TBDFINF+1 MX6 0 0 = END-OF-FILE ENCOUNTERED MX7 -1 SA6 TRETURN SA7 TERROR EQ PROCESS --- RETURN * * ENDOV * /--- BLOCK READA 00 000 75/11/27 20.27 TITLE READA * * -READA- COMMAND * * READ NEXT -AREA- DATA RECORD * * ON EXIT-- * *TRETURN* = -1 IF OK * 0 IF END-OF-FILE ENCOUNTERED * (*TERROR* = REVERSE OF ABOVE) * * READAOV OVRLAY MX0 -6 SA1 INFO LOAD HEADER WORD ZR X1,RAEOF JUMP IF END-OF-FILE BX2 -X0*X1 SX2 X2-DAREA CHECK FOR -AREA- DATA NZ X2,RALOOP SA1 INFO+2 SECOND WORD OF STUDENT NAME BX6 X1 SA6 IIBUFF+1 SA1 INFO+1 FIRST WORD OF STUDENT NAME * /--- BLOCK RALP0 00 000 78/12/23 00.37 * RALP0 BX6 X1 SA6 IIBUFF SA1 INFO+3 LESSON NAME BX6 X1 SA6 IIBUFF+2 SA1 INFO+4 AREA NAME BX6 X1 SA6 IIBUFF+3 MX6 18 SA1 INFO+7 ELAPSED TIME BX6 X6*X1 LX6 18+7 REPOSITION FOR MSEC TIME SA6 IIBUFF+4 BX6 X1 LX6 19 POSITION CONTINUATION BIT AX6 59 MX0 -1 -1 IF A CONTINUATION BX6 X6*X0 SA6 IIBUFF+15 LX1 18 POSITION -COMPLETE- BIT AX1 59 * MX6 -1 BX6 X1*X0 -1 = COMPLETE, 0 = INCOMPLETE SA6 IIBUFF+14 MX0 -9 SA1 INFO+5 BX6 -X0*X1 NUMBER OF ARROWS ENCOUNTERED SA6 IIBUFF+5 AX1 9 BX6 -X0*X1 NUMBER OF UNSUCESSFUL -HELPS- SA6 IIBUFF+11 AX1 9 BX6 -X0*X1 NUMBER OF SUCESSFUL -HELPS- SA6 IIBUFF+10 AX1 9 BX6 -X0*X1 NUMBER OF UNSUCESSFUL -TERMS- SA6 IIBUFF+13 AX1 9 BX6 -X0*X1 NUMBER OF SUCESSFUL -TERMS- SA6 IIBUFF+12 SA1 INFO+6 BX6 -X0*X1 NUMBER OF -NO- JUDGEMENTS SA6 IIBUFF+8 AX1 9 BX6 -X0*X1 NUMBER OF -OK- JUDGEMENTS SA6 IIBUFF+6 AX1 9 BX6 -X0*X1 NUMBER -OK- ON FIRST TRY SA6 IIBUFF+7 AX1 9 BX6 -X0*X1 NUMBER OF UNRECOGNIZED -NO- SA6 IIBUFF+9 * SA1 TBDFINF+1 SB2 X1 PICK OFF ADDRESS OF BUFFER AX1 18 SB1 X1 PICK OFF LENGTH OF BUFFER SB3 16 **** LENGTH OF DATA **** GE B3,B1,RALP1 SA0 B3+IIBUFF SB3 B1-B3 SX1 A0 SAVE *A0* ZERO X1,B3 CLEAR OUT REST OF BUFFER * /--- BLOCK RALP1 00 000 78/12/23 00.39 * RALP1 SA1 ATEMPEC BX0 X1 ECS SCRATCH BUFFER SA0 IIBUFF WE B1 MOVE DATA TO ECS SCRATCH RJ ECSPRTY SA0 B2 RE B1 MOVE DATA TO AUTHOR BUFFER RJ ECSPRTY MX6 -1 -1 = OK MX7 0 SA6 TRETURN SA7 TERROR EQ PROCESS --- RETURN * RAEOF SA1 TBDFINF+1 LOAD BUFFER ADDRESS/LENGTH SA0 X1 PICK OFF ADDRESS AX1 18 SB1 X1 PICK OFF LENGTH SX1 A0 SAVE *A0* ZERO X1,B1 ZERO REST OF BUFFER SA1 TBDFINF SX1 X1 RELEASE DATA-READ BUFFER CALL ALTLES,-1 MX6 0 SA6 TBDFINF CLEAR OUT INFO WORDS SA6 TBDFINF+1 MX6 0 0 = END-OF-FILE ENCOUNTERED MX7 -1 SA6 TRETURN SA7 TERROR EQ PROCESS --- RETURN * * ENDOV * /--- BLOCK SYSDATA 00 000 75/08/25 00.51 TITLE -SYSDATA- COMMAND * * * * -SYSDATA- COMMAND * PERFORMS VARIOUS SYSTEM FUNCTIONS FOR HANDLING * OF STUDENT DATA FILES * * SDATOV OVRLAY MX6 -1 MARK *INFO* BUFFER USED SA6 JJSTORE NGETVAR GET OPTION CODE SB1 X1 JP B1+*+1 * + EQ SDAT10 -SETFILE- + EQ SDAT20 -REWIND- + EQ SDAT30 -CHECKPT- * * * * SYSDATA SETFILE,FILE NAME * ACTIVATES DATA FOR THIS STUDENT WITH ONLY -OUTPUT- * AND -OUTPUTL- COMMAND DATA SELECTED * * SDAT10 SX6 3 CALL GETCODX UNPACK 3 ARGUMENTS TO VARBUF CALL ACCFILE,VARBUF+1,TBINTSV,0 SA1 TBINTSV+1 LOAD FILE NAME ZR X1,SDAT90 EXIT IF FILE NAME ZERO * SA1 TBLDATA SX0 X1 CHECK IF DATA ALREADY ON NZ X0,SDAT90 MX0 1 SET UP -SYSDATA- BIT MX6 1 LX6 DSOUTP SET UP BIT FOR -OUTPUT- COMMAND BX6 X0+X6 ATTACH -SYSDATA- BIT SA6 TBTDATA MX6 0 CLEAR -AREA- COMMAND INFO SA6 TBAREA SA6 AREADAT SA6 AREADAT+1 SA6 AREADAT+2 EQ SDSETX GO TO ACTIVATE DATA COLLECTION * * /--- BLOCK SYSDATA 00 000 77/10/20 01.38 * * * SYSDATA REWIND * REWINDS AND CHECKPOINTS DATA-FILE SPECIFIED BY * STUDENT BANK VARIABLE *TBLDATA* * * SDAT20 SA1 TBLDATA GET DATA BUFFER LESSON NUMBER SX1 X1 ZR X1,SDAT90 EXIT IF NO DATA FILE CALL SAVLES SAVE COMMON, STORAGE, ETC. CALL DATDATE GET HOLLERITH DATE AND TIME SA1 ITEMP BX6 X1 SAVE COMPRESSED DATE / TIME SA6 SDWK INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA GET BUFFER LESSON NUMBER SX1 X1 CALL READLES,IBUFF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH IX5 X0+X1 ECS ADDRESS OF DATA BUFFER SA1 IINF+DATSTAT LOAD BUFFER STATUS WORD BX0 X1 LX0 DINITSH CHECK IF FILE BEING INITIALIZED NG X0,SDAT96 BX0 X1 LX0 DWRITSH CHECK IF FILE BEING WRITTEN NG X0,SDAT96 BX0 X1 LX0 DERRSH CHECK IF ERROR HAS OCCURRED NG X0,SDAT97 MX0 1 LX0 -DFULLSH SET UP MASK FOR FILE FULL BIT BX6 -X0*X1 CLEAR FILE FULL BIT SA6 A1 SX6 1 RE-SET CURRENT BLOCK NUMBER SA6 IINF+DATBLOK SX6 0 RE-SET CURRENT WORD NUMBER SA6 IINF+DATWORD BX0 X5 ECS ADDRESS OF INFO SA0 IINF + WE DPRMLTH UPDATE BUFFER INFO WORDS RJ ECSPRTY * /--- BLOCK SYSDATA 00 000 78/12/23 00.45 * SX3 DDIRECT X3 = BIAS TO DIRECTORY AREA IX0 X5+X3 ECS ADDRESS OF DIRECTORY AREA SA0 BBUFF + RE BLKLTH READ IN DIRECTORY BLOCK RJ ECSPRTY SA1 BBUFF+2 LOAD NUMBER OF BLOCKS IN FILE SB1 X1-1 SUBTRACT 1 FOR DIRECTORY BLOCK ZERO BBUFF+64+128+1,B1 ZERO OUT BLOCK NAMES SA1 SDWK LOAD COMPRESSED DATE / TIME BX6 X1 SA6 A0 SET DATE FIRST BLOCK STARTED SA0 BBUFF+64+1 ADDRESS OF BLOCK INFO WORDS + 1 SB2 0 B2=POINTER SB3 1 B3=INCREMENT MX0 -9 LX0 9 SDAT22 SA1 A0+B2 BX6 X0*X1 CLEAR THE WORD COUNT SA6 A1 SB2 B2+B3 LT B2,B1,SDAT22 * SA1 BBUFF+3 FLAG / LAST BLOCK USED SX2 1 X2 = NEW LAST BLOCK MX6 -18 BX6 X6*X1 ONLY LAST 18 BITS ARE BLOCK BX6 X6+X2 PUT IN NEW BLOCK NUMBER (1) SA6 A1 * SDAT25 SA0 BBUFF IX0 X5+X3 ECS ADDRESS OF DIRECTORY AREA + WE BLKLTH RE-WRITE DIRECTORY RJ ECSPRTY ZERO BBUFF,BLKLTH ZERO *BBUFF* BUFFER SX1 DBLK1 BIAS TO CURRENT DATA BLOCK IX0 X5+X1 + WE BLKLTH ZERO CURRENT DATA BLOCK RJ ECSPRTY EQ SDAT35 * /--- BLOCK SYSDATA 00 000 81/08/19 03.59 * * * SYSDATA CHECKPT * CHECKPOINTS DATA FILE INDICATED BY *TBLDATA* * * SDAT30 CALL SAVLES SAVE COMMON, STORAGE, ETC. * SDAT35 INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA SX1 X1 DATA BUFFER LESSON NUMBER ZR X1,SDAT95 CALL READLES,IBUFF,(LPRMLTH+DPRMLTH) SA1 IINF+DATSTAT LOAD BUFFER STATUS WORD BX0 X1 LX0 DINITSH CHECK IF FILE BEING INITIALIZED NG X0,SDAT96 BX0 X1 LX0 DWRITSH CHECK IF FILE BEING WRITTEN NG X0,SDAT96 BX0 X1 LX0 DFULLSH CHECK IF FILE FULL NG X0,SDAT98 LX1 DERRSH CHECK IF ERROR HAS OCCURRED NG X1,SDAT97 EQ SDCHKX GO TO CHECKPOINT DATA FILE * * * * SDAT90 MX6 -1 MARK ERROR OCCURRED SA6 TERROR INTCLR X,I.DAT RELEASE INTERLOCK EQ PROC * SDAT95 MX6 -1 MARK ERROR OCCURRED SA6 TERROR EQ SDATX * SDAT96 SX6 -2 -2 = DATA FILE ACTIVE SA6 TERROR EQ SDATX * SDAT97 SX6 -3 -3 = DISK ERROR HAS OCCURRED SA6 TERROR EQ SDATX * SDAT98 SX6 -4 -4 = DATA FILE FULL SA6 TERROR EQ SDATX * SDAT99 MX6 0 MARK NO ERROR SA6 TERROR * SDATX INTCLR X,I.DAT RELEASE INTERLOCK EQ RETPRO * * IBUFF EQU INFO IINF EQU INFO+LPRMLTH BBUFF EQU IINF+DPRMLTH * SDWK BSS 1 * DBUFNAM BSS 1 DATA BUFFER NAME DATA 10LDATA + VFD 12/3,48/0 * * ENDOV * * * /--- BLOCK DATAON 00 000 79/08/18 18.46 TITLE -DATAON- COMMAND * * * -DATAON- COMMAND * TURN ON STUDENT DATA OR SELECTED DATA TYPES * * FIRST WORD - * IST 30 BITS = BCD TIME OF SIGN-ON * NEXT 18 = UNUSED * NEXT 6 = TOTAL NUMBER OF WORDS * NEXT 6 = DATA TYPE CODE * * NEXT 2 WORDS = STUDENTS NAME * NEXT WORD = LESSON NAME * NEXT WORD = BCD DATE * * DATONOV OVRLAY * ENTRY DATAONX * DATAONX MX6 -1 MARK *INFO* BUFFER USED SA6 JJSTORE MX0 60-18-1 LX0 59 POSITION MASK FOR OPTION BITS NG X5,DATAOFX JUMP IF -DATAOFF- COMMAND BX6 X0*X5 MX0 1 SA1 TBTDATA LOAD CURRENT OPTION BITS BX1 -X0*X1 CLEAR -SYSDATA- BIT BX6 X1+X6 SA6 A1 SA1 TBLDATA SX2 X1 SEE IF DATA ALREADY -ON- NZ X2,=XPROC SA1 TBDFILE SEE IF ANY DATA FILE ZR X1,=XPROC FINISH DON10 CHECK IF IN -FINISH- UNIT EQ DON15 * DON10 MX6 0 KILL ANY OUTPUT FOR -FINISH- SA6 MOUTLOC * * DON15 SA1 KEY BX6 X1 SA6 TOKEY SAVE ORIGINAL KEY * CALL SAVLES SAVE COMMON, STORAGE, ETC. * CALLX INITDAT,TBDFACC,TBDFILE INITIALIZE SA1 TBLDATA SX1 X1 CHECK IF DATA INITIALIZED NZ X1,DON20 TUTIM 250 PAUSE FOR A WHILE * /--- BLOCK DATAON 00 000 77/07/05 20.58 * DON20 CALL RESTLES RESTORE LESSON, COMMON, ETC. * CALL INROUTE PL X1,DON30 IF NOT IN ROUTER LESSON MX6 0 CLEAR OUT -AREA- DATA IF ROUTER SA6 TBAREA SA6 AREADAT SA6 AREADAT+1 SA6 AREADAT+2 * DON30 SA1 TBLDATA SX2 X1 SEE IF DATA COLLECTION -ON- ZR X2,DON90 * SA2 TBTDATA MERGE LESSON-SELECTED BITS SA3 TBTDATA+1 OPTIONS LESSON MAY TURN ON BX6 -X3*X2 SA6 A2 BX1 X1+X6 BX0 X1 LX1 60-DSDATON SEE IF -DATAON- SELECTED PL X1,DON90 LX0 60-DSNODON BIT SET IF NO OUTPUT NG X0,DON90 * CALL S=TDATE,ITEMP MX0 30 SA1 ITEMP LOAD CLOCK (BCD) LX1 6 BX1 X0*X1 SAVE HOURS AND MINUTES SX6 500B+DSIGNI BX6 X1+X6 STORE HEADER WORD SA6 INFO SA1 TNAME BX6 X1 FIRST 10 CHARS OF NAME SA6 INFO+1 MX0 -12 SA1 TNAME1 LAST 8 CHARS OF NAME BX6 X0*X1 SA6 INFO+2 CALL FSQUISH,TBLESAC BX6 X1 SA6 INFO+3 SA1 ITEMP+1 LOAD BCD DATE BX6 X1 SA6 INFO+4 CALLX DATAOUT,INFO,5 * DON90 SA1 SYSCLOK SA2 TIMEARK TIME OF ENTRY TO LESSON IX6 X1-X2 ELAPSED TIME AT -DATAON- AX6 7 KEEP TO ABOUT 1/10 SEC MX0 -18 SA2 AREADAT+2 BX2 X0*X2 CLEAR PREVIOUS ENTRY TIME BX6 -X0*X6 LIMIT TIME TO 18 BITS BX6 X6+X2 ADD IN REST OF DATA WORD SA6 A2 STORE LESSON ENTRY TIME SA1 TOKEY BX6 X1 SA6 KEY RESTORE ORIGINAL KEY EQ =XCKPROC TO PROCESS AFTER TIME CHECK * * * /--- BLOCK DATAOFF 00 000 79/08/18 18.46 TITLE -DATAOFF- COMMAND * * * -DATAOFF- COMMAND * TURN OFF STUDENT DATA OR SELECTED DATA TYPES * * DATAOFX BX6 X0*X5 MASK OFF OPTION BITS ZR X6,DATAOF1 JUMP IF BLANK TAG SA1 TBTDATA BX6 -X6*X1 CLEAR APPROPRIATE BITS SA6 A1 EQ =XPROC * DATAOF1 FINISH CHECK FOR -FINISH- UNIT CALL SAVLES SAVE COMMON, STORAGE, ETC. CALLX FINDAT CALLX DATAFIN TERMINATE DATA COLLECTION MX6 0 CLEAR DATA OPTION BITS SA6 TBTDATA SX6 NEXT SA6 KEY SWALLOW ANY KEY CALL RESTLES RESTORE LESSON, COMMON, ETC. EQ RETRNX PAUSE FOR A WHILE ENDOV * * * /--- BLOCK READD 00 000 76/02/13 16.19 TITLE READD * * -READD SIGNOFF- * * READ NEXT -SIGNOFF- DATA RECORD * * ON EXIT-- * *TRETURN* = -1 IF OK * 0 IF END-OF-FILE ENCOUNTERED * (*TERROR* = REVERSE OF ABOVE) * * READDOV OVRLAY MX0 -6 SA1 INFO LOAD HEADER WORD ZR X1,RDEOF JUMP IF END-OF-FILE BX2 -X0*X1 SX2 X2-DSIGNF CHECK FOR -SIGNOFF- DATA NZ X2,RSLOOP * SA1 INFO+1 FIRST WORD OF STUDENT NAME BX6 X1 SA6 IIBUFF SA1 INFO+2 SECOND WORD OF STUDENT NAME BX6 X1 SA6 IIBUFF+1 SA1 INFO+3 LESSON NAME BX6 X1 SA6 IIBUFF+2 * SA1 INFO+4 DATE BX6 X1 SA6 IIBUFF+5 MX0 30 SA1 INFO TIME BX6 X0*X1 SA6 IIBUFF+6 * SA1 INFO+5 BX6 -X0*X1 PICK OFF ELAPSED TIME (MIN) SA6 IIBUFF+3 MX6 -1 IF NOT COMPLETE NG X1,RDD01 SEE IF COMPLETED THIS TIME BX6 X0*X1 LX6 30 RDD01 SA6 IIBUFF+4 STORE COMPLETION TIME * /--- BLOCK RDD01 00 000 78/12/23 00.47 * SA1 TBDFINF+1 SB2 X1 PICK OFF ADDRESS OF BUFFER AX1 18 SB1 X1 PICK OFF LENGTH OF BUFFER SB3 7 **** LENGTH OF DATA **** GE B3,B1,RDD03 SA0 B3+IIBUFF SB3 B1-B3 SX1 A0 SAVE *A0* ZERO X1,B3 CLEAR OUT REST OF BUFFER * RDD03 SA1 ATEMPEC BX0 X1 ECS SCRATCH BUFFER SA0 IIBUFF WE B1 MOVE DATA TO ECS SCRATCH RJ ECSPRTY SA0 B2 RE B1 MOVE DATA TO AUTHOR BUFFER RJ ECSPRTY MX6 -1 -1 = OK MX7 0 SA6 TRETURN SA7 TERROR EQ PROCESS --- RETURN * RDEOF SA1 TBDFINF+1 LOAD BUFFER ADDRESS/LENGTH SA0 X1 PICK OFF ADDRESS AX1 18 SB1 X1 PICK OFF LENGTH SX1 A0 SAVE *A0* ZERO X1,B1 ZERO REST OF BUFFER SA1 TBDFINF SX1 X1 RELEASE DATA-READ BUFFER CALL ALTLES,-1 MX6 0 SA6 TBDFINF CLEAR OUT INFO WORDS SA6 TBDFINF+1 MX6 0 0 = END-OF-FILE ENCOUNTERED MX7 -1 SA6 TRETURN SA7 TERROR EQ PROCESS --- RETURN * * ENDOV * /--- BLOCK SETDAT 00 000 76/07/05 21.05 * TITLE -SETDAT- SET DATA RESERVED WORDS * * SETROV OVRLAY LX5 XCODEL GET CODE FOR RESERVED WORD SX6 X5 SA6 SRTEMP SAVE INDEX NGETVAR GET VALUE OF EXPRESSION SA3 SRTEMP SB1 X3+1 + JP *+B1 GO TO APPROPRIATE SUBROUTINE + EQ SR001 AARROWS + EQ SR002 AOK + EQ SR003 AOKIST + EQ SR004 ASNO + EQ SR005 AUNO + EQ SR006 AHELP + EQ SR007 AHELPN + EQ SR008 ATERM + EQ SR009 ATERMN + EQ SR010 AAREA + EQ SR011 ATIME * * /--- BLOCK SETDAT 00 000 77/05/30 03.55 * SR001 SB1 B0 WORD POSITION FOR *AARROWS* SB2 B0 SHIFT COUNT EQ SAREA * SR002 SB1 1 WORD POSITION FOR *AOK* SB2 9 SHIFT COUNT EQ SAREA * SR003 SB1 1 WORD POSITION FOR *AOKIST* SB2 18 SHIFT COUNT EQ SAREA * SR004 SB1 1 WORD POSITION FOR *ASNO* SB2 B0 SHIFT COUNT EQ SAREA * SR005 SB1 1 WORD POSITION FOR *AUNO* SB2 27 SHIFT COUNT EQ SAREA * SR006 SB1 B0 WORD POSITION FOR *AHELP* SB2 18 SHIFT COUNT EQ SAREA * SR007 SB1 B0 WORD POSITION FOR *AHELPN* SB2 9 SHIFT COUNT EQ SAREA * SR008 SB1 B0 WORD POSITION FOR *ATERM* SB2 36 SHIFT COUNT EQ SAREA * SR009 SB1 B0 WORD POSITION FOR *ATERMN* SB2 27 SHIFT COUNT EQ SAREA * * * EXECERR USES X1 SAREA NG X1,ERXVAL NEGATIVE NOT ALLOWED SA2 AREADAT+B1 READ APPROPRIATE DATA WORD SB1 60 SB3 B1-B2 LX2 X2,B3 GET RIGHT FIELD LOWER MX0 -9 BX2 X0*X2 CLEAR OUT CURRENT VALUE BX1 -X0*X1 LIMIT NEW VALUE TO 9 BITS BX6 X1+X2 MERGE WITH AREA WORD LX6 X6,B2 SHIFT BACK SA6 A2 REWRITE AREA WORD EQ PROCESS * * /--- BLOCK SETDAT 00 000 77/05/30 03.55 * SR010 CALL LJUST,(1R ),0 GET NEW AREA NAME BX6 X1 SA6 TBAREA STORE AS NEW AREA NAME EQ PROCESS * * EXECERR USES X1 SR011 NG X1,ERXVAL NEGATIVE NOT ALLOWED SA2 SYSCLOK GET CURRENT TIME SA3 TIMEARK TIME OF SIGNON IX2 X2-X3 CURRENT ELAPSED TIME IX3 X2-X1 SUBTRACT NEW FROM CURRENT NG X3,SR011A IF TOO LONG SET TO ENTRY SR011B AX3 7 KEEP TIME TO ABOUT 1/10 SEC MX0 18 SA2 AREADAT+1 GET ENTRY TIME TO AREA BX2 -X0*X2 CLEAR OUT ENTRY TIME LX3 -18 SHIFT TIME TO TOP 18 BITS BX3 X0*X3 LIMIT TO 18 BITS BX6 X2+X3 MERGE IN NEW ENTRY TIME SA6 A2 SA2 AREADAT+2 GET PREVIOUS ELAPSED TIME BX6 -X0*X2 CLEAR IT OUT SA6 A2 EQ PROCESS * SR011A MX3 0 AREA STARTED AT SIGNON TIME EQ SR011B * * SRTEMP BSS 1 * ENDOV * /--- BLOCK INITDAT 00 000 79/07/15 21.52 TITLE -INIDOV- INITIALIZE FOR DATA COLLECTION * * EXT DATAFIN,DBUFNAM,IDWK * * PURGMAC DISKI MACREF DISKI$ DISKI MACRO ADD,UNIT,BLOCK,ECS,N LOCAL AA,XX MACREF DISKI IFC EQ,*N**,1 SX3 K1 IFC NE,*N**,1 SX3 N CALL DISKXJ,ADD,UNIT,BLOCK,K1,ECS,X3 NZ X6,XX AA TUTIM -1,,IOKEY CALL POSTXJ,XX,AA,XX XX BSS 0 ENDM * * PURGMAC DISKO MACREF DISKO$ DISKO MACRO ADD,UNIT,BLOCK,ECS,N LOCAL AA,XX MACREF DISKO CALL DISKXJ,ADD,UNIT,BLOCK,K2,ECS,K1 NZ X6,XX AA TUTIM -1,,IOKEY CALL POSTXJ,XX,AA,XX XX BSS 0 ENDM * * * ENTRY - TBINTSV+1 = *EQ* TO RETURN TO CALLING ROUTINE * TBINTSV+2 = DATA FILE ACCOUNT NAME * TBINTSV+3 = DATA FILE NAME * * INIDOV OVRLAY (TBINTSV+15) EQ ID120 * ID110 INTCLR X,I.DAT RELEASE INTERLOCK TUTIM 250 PAUSE FOR A WHILE * * CHECK IF ECS DATA BUFFER ALREADY SET UP * ID120 SA1 TBINTSV+2 GET DATA FILE ACCOUNT NAME SA2 TBINTSV+3 GET FILE NAME BX6 X1 BX7 X2 SA6 DBUFNAM SET UP DATA ACCOUNT NAME SA7 DBUFNAM+1 AND FILE NAME INTLOK X,I.DAT,W INTERLOCK CALL FINDLES,DBUFNAM,LESNUM SA1 LESNUM NG X1,ID200 JUMP IF NO BUFFER EXISTS YET CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SA1 INF+DATSTAT LOAD DATA FILE STATUS WORD LX1 DINITSH POSITION FILE INITIALIZING BIT NG X1,ID110 EXIT IF FILE BEING INITIALIZED SA1 LESNUM SA2 TBLDATA BX6 X1+X2 SET DATA BUFFER LESSON NUMBER SA6 A2 CALL ALTLES,1 SIGN INTO DATA BUFFER EQ ID900 * * /--- BLOCK INITDAT 00 000 78/06/24 21.16 * * * CHECK THAT FILE EXISTS AND IS OF CORRECT TYPE * ID200 SA1 TBINTSV+3 LOAD DATA FILE NAME CALL FINDFN NG X7,ID900 EXIT IF FILE DOES NOT EXIST SA7 IDWK SAVE DISK UNIT NUMBER SA1 X7+FITS IX0 X1+X6 ECS ADDRESS OF FILE INFO WORD SA0 IDWK+1 + RE 1 READ FILE INFO WORD RJ ECSPRTY MX0 -6 MASK FOR FILE TYPE CODE SA1 A0 LOAD FILE INFO WORD AX1 30 BX1 -X0*X1 MASK OFF FILE TYPE CODE SX1 X1-4 CHECK FOR TYPE 4 = DATA FILE NZ X1,ID900 EXIT IF NOT A DATA FILE SA6 ITEMP SAVE FILE INDEX CALL FILMARK,IDWK,ITEMP MARK FILE ALTERED * * CREATE ECS DATA BUFFER * CALL XSTOR,DBUFNAM,DBUFLTH SA1 LESNUM NG X1,ID110 JUMP IF INSUFFICIENT ECS SA2 TBLDATA BX6 X1+X2 ATTACH DATA BUFFER LESSON NUM SA6 A2 CALL ALTLES,1 SIGN INTO DATA BUFFER CALL IOLESSN,TBLDATA,4000B INTCLR X,I.ADDL RELEASE LESNAM INTERLOCK * * /--- BLOCK INITDAT 00 000 78/06/24 21.39 * * INITIALIZE DATA BUFFER PARAMETERS * SA1 TBLDATA DATA BUFFER LESSON NUMBER CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH BIAS PAST HEADER RECORD IX0 X0+X1 ECS ADDRESS OF DATA BUFFER MX6 1 SET UP FILE INITIALIZING BIT LX6 60-DINITSH MX1 -18 CLEAR THE OLD STATION NUMBER BX6 X6*X1 SA1 STATION INSERT CURRENT STATION NUMBER BX6 X6+X1 SA6 INF+DATSTAT SET DATA FILE STATUS WORD SA1 TBINTSV+2 ACCOUNT NAME SA2 TBINTSV+3 FILE NAME BX6 X1 BX7 X2 SA6 INF+DFACCT SA7 INF+DFILNAM SA1 IDWK BX6 X1 SET DATA FILE DISK UNIT NUMBER SA6 INF+DDISKU SA1 IDWK+1 BX6 X1 SET DATA FILE INFO WORD SA6 INF+DFINF SA0 INF + WE DPRMLTH INITIALIZE ECS DATA PARAMETERS RJ ECSPRTY * * READ DATA FILE DIRECTORY TO ECS DIRECTORY AREA * SX1 DDIRECT BIAS TO FILE DIRECTORY AREA IX6 X0+X1 SA6 DECSLOC ECS ADDRESS OF DIRECTORY AREA INTCLR X,I.DAT DISKI (INF+DFINF),(INF+DDISKU),K0,DECSLOC NZ X6,ID750 EXIT IF DISK ERROR * * CHECK THAT FILE DIRECTORY IS INTACT * INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA RESTORE DATA BUFFER PARAMETERS CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH IX5 X0+X1 ECS ADDRESS OF DATA BUFFER SX1 DDIRECT BIAS TO FILE DIRECTORY AREA IX0 X1+X5 SA0 INFO READ FILE DIRECTORY TO *INFO* + RE BLKLTH RJ ECSPRTY * * /--- BLOCK INITDAT 00 000 78/06/24 21.40 * SA1 INFO LOAD FILE NAME SA2 INF+DFILNAM BX1 X1-X2 CHECK THAT FILE NAME IS CORRECT NZ X1,ID750 SA1 INFO+1 LOAD FILE TYPE SA2 KDATAD BX1 X1-X2 CHECK THAT FILE TYPE IS CORRECT NZ X1,ID750 * SA2 INF+DFINF LOAD FILE INFO WORD MX0 -6 AX2 24 POSITION NUMBER OF DISK SPACES BX2 -X0*X2 SX0 DSBLKS NUMBER OF BLOCKS PER PART IX6 X0*X2 COMPUTE NUMBER BLOCKS IN FILE SA6 DBLKLIM (X6=BLOCK COUNT--USED LATER) SX7 X6-1 SET MAXIMUM BLOCK NUMBER SA7 INF+DATBLIM * SA1 INFO+3 FLAG / LAST BLOCK USED SX2 X1 X2 = LAST BLOCK IX3 X6-X2 NG X2,ID750 --- EXIT IF UNREASONABLE BLOCK NG X3,ID750 --- EXIT IF UNREASONABLE BLOCK ZR X3,ID225 X3(WORD)=0 IF FILE FULL SA3 INFO+64+X2 APPROPRIATE INFO WORD MX0 -9 AX3 9 BX3 -X0*X3 X3 = LAST WORD ID225 BSS 0 NZ X2,ID250 SX2 1 DO NOT ALLOW BLOCK 0 ID250 IX0 X6-X2 NG X0,ID750 --- EXIT IF UNREASONABLE BLOCK SB1 B0 B1 = 0 = FILE NOT FULL NZ X0,ID300 JUMP IF FILE NOT FULL MX6 1 LX6 60-DFULLSH SET UP FILE FULL BIT SA1 INF+DATSTAT LOAD DATA FILE STATUS WORD BX6 X1+X6 SA6 A1 SET BIT TO MARK FILE FULL SB1 -1 B1 = -1 = FILE FULL * /--- BLOCK INITDAT 00 000 78/12/18 21.45 * ID300 BX6 X2 SET CURRENT BLOCK NUMBER SA6 INF+DATBLOK SA6 DBLOKN NG X3,ID750 --- EXIT IF UNREASONABLE WORD SX0 BLKLTH IX0 X3-X0 PL X0,ID750 --- EXIT IF UNREASONABLE WORD BX6 X3 SET CURRENT WORD POINTER SA6 INF+DATWORD NZ B1,ID800 EXIT IF FILE FULL ZR X3,ID400 JUMP IF CURRENT BLOCK EMPTY * * LOAD CURRENT DATA BLOCK TO CURRENT BLOCK AREA * BX0 X5 ECS ADDRESS OF DATA PARAMETERS SA0 INF + WE DPRMLTH UPDATE PARAMETERS RJ ECSPRTY SX1 DBLK1 BIAS TO CURRENT BLOCK AREA IX6 X1+X5 SA6 DECSLOC SET ECS ADDRESS OF BLOCK INTCLR X,I.DAT DISKI (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC NZ X6,ID750 JUMP IF DISK ERROR * * CORRECT POSSIBLE DAMAGE TO CURRENT WORD POINTER * INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH IX5 X0+X1 ECS ADDRESS OF DATA PARAMETERS SX1 DBLK1 IX0 X1+X5 ADDRESS OF CURRENT BLOCK SA0 INFO + RE 1 READ FIRST WORD OF DATA BLOCK RJ ECSPRTY SA1 A0 LOAD FIRST WORD OF DATA BLOCK NZ X1,ID800 JUMP IF DATA ACTUALLY PRESENT MX6 0 SA6 INF+DATWORD RE-SET WORD POINTER ZERO INFO,BLKLTH READ BOCK OF ZEROS TO CM SX1 DBLK1 BIAS TO CURRENT DATA BLOCK IX0 X1+X5 + WE BLKLTH ZERO OUT CURRENT BLOCK AREA RJ ECSPRTY EQ ID800 * /--- BLOCK INITDAT 00 000 77/10/20 01.04 * * PUT DATE BLOCK STARTED IN DIRECTORY IF 1ST BLOCK * ID400 SA1 DBLOKN CHECK IF ON FIRST BLOCK SX1 X1-1 NZ X1,ID800 BX6 X5 SAVE ECS ADDRESS OF BUFFER SA6 DECSLOC * CALL DATDATE GET HOLLERITH DATE / TIME * SA1 DECSLOC GET ECS ADDRESS OF BUFFER BX5 X1 BACK TO X5 SX1 DDIRECT+64+128 X1 = BIAS TO BLOCK NAMES SA2 DBLOKN IX1 X1+X2 ADD BIAS TO CURRENT BLOCK IX0 X1+X5 SA0 ITEMP CURRENT HOLLERITH DATE + WE 1 WRITE OUT DATE BLOCK STARTED RJ ECSPRTY EQ ID800 * /--- BLOCK INITDAT 00 000 78/06/24 23.02 * * FINAL PROCESSING * CLEAR INITIAL BIT AND SET ERROR BIT IF NECCESSARY * ID750 MX6 1 SET UP BIT FOR ERROR CONDITION LX6 60-DERRSH SA6 DERRFLG SET ERROR FLAG INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH IX5 X0+X1 BIAS TO DATA PARAMETER AREA EQ ID810 * ID800 MX6 0 MARK NO ERROR OCCURRED SA6 DERRFLG * ID810 MX6 1 SET UP MASK FOR INITIAL BIT LX6 60-DINITSH SA1 INF+DATSTAT LOAD STATUS WORD BX6 -X6*X1 CLEAR INITIAL BIT SA2 DERRFLG BX6 X2+X6 ATTACH ANY ERROR BIT SA6 A1 BX0 X5 ECS ADDRESS OF DATA BUFFER INFO SA0 INF + WE DPRMLTH UPDATE BUFFER INFO WORDS RJ ECSPRTY CALL IOLESSN,TBLDATA,-4000B * ID900 INTCLR X,I.DAT RELEASE INTERLOCK EQ TBINTSV+1 EXIT * * DECSLOC BSS 1 DWORD BSS 1 DBLOKN BSS 1 DBLKLIM BSS 1 DERRFLG BSS 1 ISYSF BSS 1 * DATINF BSS LPRMLTH+DPRMLTH INF EQU DATINF+LPRMLTH * DSLTH EQU 1+DATAMAX+DRJLTH * K0 DATA 0 K1 DATA 1 K2 DATA 2 KDATAD DATA 10LDATA D * * ENDOV * /--- BLOCK DATAFIN 00 000 81/08/20 02.38 TITLE -FINDOV- TERMINATE DATA COLLECTION SPACE 4 FINDOV OVRLAY (TBINTSV+15) INTLOK X,I.SIGN,W KEEP EM MANAGER AT BAY... INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA SX1 X1 CALL ALTLES,-1 SIGN OUT OF DATA FILE SA1 NSTUDS NUMBER OF STUDENTS USING FILE ZR X1,DF200 JUMP IF FILE NO LONGER IN USE * DF100 MX0 -18 SA1 TBLDATA CLEAR OUT BUFFER LESSON NUMBER BX6 X0*X1 SA6 A1 INTCLR X,I.DAT RELEASE INTERLOCK INTCLR X,I.SIGN RELEASE INTERLOCK EQ DATAFIN EXIT * DF110 SA1 TBLDATA DATA BUFFER LESSON NUMBER CALL DELETE DELETE DATA BUFFER EQ DF100 * DF200 SA1 TBLDATA DATA BUFFER LESSON NUMBER CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH LENGTH OF HEADER IX5 X0+X1 ADDRESS OF DATA BUFFER SA1 INF+DATSTAT BUFFER STATUS WORD BX2 X1 LX2 DERRSH CHECK IF ERROR HAS OCCURRED NG X2,DF110 BX2 X1 LX2 DFULLSH CHECK IF DATA FILE FULL NG X2,DF110 MX6 1 SET UP FILE WRITE BIT LX6 60-DWRITSH BX6 X1+X6 ATTACH TO STATUS WORD MX1 -18 CLEAR THE OLD STATION NUMBER BX6 X6*X1 SA1 STATION INSERT CURRENT STATION NUMBER BX6 X6+X1 SA6 INF+DATSTAT STORE FILE BUSY AND STATION * * /--- BLOCK DATAFIN 00 000 81/08/20 02.38 * * MOVE CURRENT DATA BLOCK TO DISK BUFFER AREA * SX1 DBLK1 BIAS TO CURRENT BLOCK AREA IX0 X1+X5 SA0 INFO TEMPORARY CM BUFFER + RE BLKLTH READ CURRENT DATA BLOCK RJ ECSPRTY SX1 DBLK2 BIAS TO DISK BUFFER AREA IX0 X1+X5 + WE BLKLTH MOVE DATA TO DISK BUFFER AREA RJ ECSPRTY BX6 X5 SAVE ECS ADDRESS OF DATA BUFFER SA6 DECSLOC * * GET FILE INFO WORD * SA1 INF+DFILNAM LOAD DATA FILE NAME CALL FINDFN GET POINTERS TO FILE INFO NG X7,DF110 SA7 INF+DDISKU SAVE DISK UNIT NUMBER SA1 X7+FITS IX0 X1+X6 ECS ADDRESS OF FILE INFO WORD SA0 INF+DFINF + RE 1 READ FILE INFO WORD RJ ECSPRTY MX0 -6 SA1 A0 LOAD FILE INFO WORD AX1 24 BX1 -X0*X1 MASK OFF NUMBER OF DISK SPACES SX2 DSBLKS IX2 X1*X2 COMPUTE NUMBER OF BLOCKS SA1 INF+DATBLOK LOAD CURRENT BLOCK NUMBER IX2 X1-X2 PL X2,DF110 EXIT IF BLOCK NUMBER TOO BIG + NZ X1,*+1 SX1 1 DO NOT ALLOW BLOCK 0 + BX6 X1 SET CURRENT BLOCK NUMBER SA6 DBLOKN * * /--- BLOCK DATAFIN 00 000 77/10/20 01.09 * * UPDATE BLOCK AND WORD COUNTS IN FILE DIRECTORY * SA1 DECSLOC ECS ADDRESS OF FILE BX5 X1 BACK TO X5 SX1 DDIRECT+3 BIAS TO FLAG / LAST BLOCK USED IX0 X5+X1 SA0 ITEMP + RE 1 RJ ECSPRTY SA1 A0 FLAG / LAST BLOCK USED SA2 DBLOKN X2 = CURRENT LAST BLOCK MX6 -18 BX6 X6*X1 ONLY LAST 18 BITS ARE BLOCK BX6 X6+X2 PUT IN NEW BLOCK NUMBER SA6 A0 + WE 1 UPDATE FLAG / LAST BLOCK USED RJ ECSPRTY SX1 DDIRECT+64+X2 BIAS TO BLOCK INFO WORD IX0 X5+X1 + RE 1 READ PROPER BLOCK INFO WORD RJ ECSPRTY SA1 A0 MX6 -9 LX6 9 BX6 X6*X1 CLEAR OLD WORD COUNT SA1 INF+DATWORD CURRENT LAST WORD LX1 9 BX6 X6+X1 SA6 A0 + WE 1 UPDATE BLOCK INFO WORD RJ ECSPRTY * * /--- BLOCK DATAFIN 00 000 78/06/24 21.50 * * RETURN CURRENT DATA BLOCK TO DISK * DF500 SA1 TBLDATA SIGN BACK INTO DATA BUFFER CALL ALTLES,1 CALL IOLESSN,TBLDATA,4000B * * CALL LINKS,WORK SAVE RETURN JUMP TRAIL SB1 WORK + RJ =XLINKS - VFD 30/DATAFIN * SA1 DECSLOC ECS ADDRESS OF DATA BUFFER BX5 X1 BACK TO X5 SX1 DRJSAVE BIAS TO RJ TRAIL SAVE AREA IX0 X1+X5 SA0 WORK CM ADDRESS OF RJ TRAIL + WE DRJLTH SAVE RETURN JUMP TRAIL RJ ECSPRTY SX1 DBLK2 BIAS TO DISK BUFFER AREA IX6 X1+X5 SA6 DECSLOC SET ECS ADDRESS OF BLOCK BX0 X5 ECS ADDRESS OF DATA PARAMETERS SA0 INF + WE DPRMLTH UPDATE DATA PARAMETERS RJ ECSPRTY * INTCLR X,I.DAT RELEASE INTERLOCK INTCLR X,I.SIGN DURING DISKIO, OK SINCE PINNED DISKO (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC SA6 DERRFLG SAVE DISK ERROR FLAG NZ X6,DF800 EXIT IF DISK ERROR * /--- BLOCK DATAFIN 00 000 78/06/24 23.04 * * RETURN DIRECTORY BLOCK TO DISK * SA1 TBLDATA RELOAD DATA PARAMETERS CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH+DDIRECT IX6 X0+X1 ECS ADDRESS OF DIRECTORY BLOCK SA6 DECSLOC DISKO (INF+DFINF),(INF+DDISKU),K0,DECSLOC SA6 DERRFLG SAVE DISK ERROR FLAG * DF800 INTLOK X,I.SIGN,W DISKIO DONE, BLOCK EM MANAGER INTLOK X,I.DAT,W INTERLOCK DIRECTORY CALL IOLESSN,TBLDATA,-4000B UNPIN SA1 TBLDATA RE-LOAD DATA BUFFER PARAMETERS CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH BIAS PAST HEADER RECORD IX0 X0+X1 MX6 1 FORM MASK FOR FILE WRITE BIT LX6 60-DWRITSH SA1 INF+DATSTAT LOAD BUFFER STATUS WORD BX6 -X6*X1 CLEAR FILE WRITE BIT SA1 DERRFLG CHECK IF ANY DISK ERROR ZR X1,DF810 MX1 1 SET UP DISK ERROR BIT LX1 60-DERRSH BX6 X1+X6 SET DISK ERROR BIT * DF810 SA6 INF+DATSTAT STORE UPDATED STATUS WORD SA0 INF + WE DPRMLTH UPDATE BUFFER PARAMETERS RJ ECSPRTY SX1 DRJSAVE BIAS TO SAVED RJ TRAIL IX0 X0+X1 SA0 WORK + RE DRJLTH READ SAVED RJ TRAIL TO CM RJ ECSPRTY * * CALL LINKR,WORK RESTORE RJ TRAIL SB1 WORK + RJ =XLINKR - VFD 30/DATAFIN * SA1 TBLDATA CALL ALTLES,-1 SIGN OUT OF DATA BUFFER AGAIN SA1 NSTUDS NZ X1,DF100 EXIT IF BUFFER IN USE AGAIN SA1 TBLDATA CALL DELETE DELETE ECS DATA BUFFER EQ DF100 EXIT * * DECSLOC BSS 1 DWORD BSS 1 DBLOKN BSS 1 DBLKLIM BSS 1 DERRFLG BSS 1 ISYSF BSS 1 * DATINF BSS LPRMLTH+DPRMLTH INF EQU DATINF+LPRMLTH * DSLTH EQU 1+DATAMAX+DRJLTH * K0 DATA 0 K1 DATA 1 K2 DATA 2 * * ENDOV * * /--- BLOCK DATAOUT 00 000 78/11/12 21.42 TITLE -DATOOV- OUTPUT TO DATA FILE * * * ON ENTRY - *OVARG1* = 0 = INITIAL ENTRY * 1 = ADVANCE TO NEXT FILE * 2 = NEXT DATA-FILE RE-ENTRY * *OVARG2* = LENGTH OF DATA RECORD * DATOOV OVRLAY (TBINTSV+15) SA1 OVARG1 GET RE-ENTRY INDEX SB1 X1 JP B1+*+1 * + EQ ENT 0 = INITIAL ENTRY + EQ DATNXT 1 = ADVANCE TO NEXT DATA-FILE + EQ REENT1 2 = ADVANCE FILE RE-ENTRY * * ENT SA1 TBLDATA SX1 X1 GET DATA BUFFER LESSON NUM CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH IX4 X0+X1 X4 = ECS ADDRESS OF INFO SA1 OVARG2 SB1 X1 B1 = LENGTH OF DATA RECORD * * /--- BLOCK DATAOUT 00 000 78/12/18 21.49 * * COPY CURRENT FULL BLOCK TO DISK BUFFER AREA AND * RE-INITIALIZE WITH CURRENT DATA RECORD * SA3 INF+DATSTAT LX3 DWRITSH CHECK IF FILE BEING WRITTEN NG X3,DATWAIT GO TO WAIT LOOP IF FILE BUSY MX6 1 BX6 X3+X6 SET FILE WRITE BIT LX6 60-DWRITSH MX1 -18 CLEAR THE OLD STATION NUMBER BX6 X6*X1 SA1 STATION INSERT CURRENT STATION NUMBER BX6 X6+X1 SA6 A3 SA1 INF+DATWORD LAST WORD FOR CURRENT BLOCK BX6 X1 SX7 B1 NEW WORD COUNT SA7 A1 SA6 DWORD SAVE OLD WORD COUNT SA1 DARG1 GET CM ADDRESS OF DATA RECORD SA0 X1 SA2 ATEMPEC ECS SCRATCH BUFFER BX0 X2 + WE B1 WRITE CURRENT RECORD TO SCRATCH RJ ECSPRTY SX3 DBLK1 BIAS TO CURRENT FILLED BLOCK IX0 X3+X4 SA0 INFO CM SCRATCH BUFFER + RE BLKLTH MOVE FILLED BLOCK TO CM RJ ECSPRTY SX1 DBLK2 BIAS TO DISK I/O BUFFER IX0 X1+X4 + WE BLKLTH MOVE FILLED BLOCK TO BUFFER RJ ECSPRTY ZERO INFO,BLKLTH PRE-ZERO *INFO* BX0 X2 ECS ADDRESS OF CURRENT RECORD + RE B1 READ RECORD TO *INFO* RJ ECSPRTY IX0 X3+X4 ADDRESS OF CURRENT BLOCK AREA + WE BLKLTH INITIALIZE NEW BLOCK RJ ECSPRTY BX6 X4 SAVE ADDRESS OF DATA LESSON SA6 DECSLOC * * /--- BLOCK DATAOUT 00 000 77/10/20 01.19 * * GET FILE INFO WORD AND CHECK IF DATA FILE NOW FULL * SA1 INF+DFILNAM CALL FINDFN GET POINTERS TO FILE INFO PL X7,DD120 JUMP IF FILE OK MX6 1 SET UP ERROR BIT LX6 60-DERRSH SA1 INF+DATSTAT LOAD BUFFER STATUS WORD BX6 X1+X6 MX1 -18 CLEAR THE OLD STATION NUMBER BX6 X6*X1 SA1 STATION INSERT CURRENT STATION NUMBER BX6 X6+X1 SA6 INF+DATSTAT STORE ERROR BIT AND STATION EQ DD130 * DD120 SA7 INF+DDISKU SAVE DISK UNIT NUMBER SA1 X7+FITS IX0 X1+X6 ECS ADDRESS OF FILE INFO WORD SA0 INF+DFINF + RE 1 READ FILE INFO WORD RJ ECSPRTY MX0 -6 SA1 A0 LOAD FILE INFO WORD AX1 24 POSITION NUMBER OF DISK SPACES BX1 -X0*X1 MASK OFF NUMBER OF PARTS SX2 DSBLKS NUMBER OF BLOCKS PER PART IX6 X1*X2 COMPUTE NUMBER OF BLOCKS SA6 DBLKLIM SX3 X6-1 LAST LEGAL BLOCK NUMBER SA1 INF+DATBLOK X1 = CURRENT BLOCK NUMBER IX2 X1-X3 CHECK IF FILE IS FULL NG X2,DD150 JUMP IF NOT FULL YET MX7 1 LX7 60-DFULLSH SET UP FILE FULL BIT SA3 INF+DATSTAT LOAD FILE STATUS WORD BX7 X3+X7 SA7 A3 MARK DATA FILE FULL IX2 X1-X6 NG X2,DD150 CHECK FOR LEGAL BLOCK NUMBER SA6 INF+DATBLOK RE-SET TO LAST BLOCK + 1 MX7 1 LX7 60-DWRITSH SET UP FILE WRITE BIT BX7 -X7*X3 CLEAR FILE WRITE BIT SA7 A3 * DD130 SA1 DECSLOC ECS ADDRESS OF DATA BUFFERS BX0 X1 SA0 INF CM ADDRESS OF DATA INFO + WE DPRMLTH UPDATE DATA INFO RJ ECSPRTY EQ DAT990 * * /--- BLOCK DATAOUT 00 000 77/01/29 21.42 * DD150 NZ X1,DD151 BLOCK NUMBER MUST NOT BE ZERO SX1 1 DD151 SX6 X1 SAVE NUMBER OF BLOCK TO RETURN SA6 DBLOKN SX6 X1+1 ADVANCE BLOCK NUMBER SA6 INF+DATBLOK * * UPDATE CURRENT BLOCK AND WORD POINTERS AND * DATE BLOCK BEGUN IN DIRECTORY AREA * CALL DATDATE GET HOLLERITH DATE / TIME SA1 DECSLOC BX5 X1 GET ECS ADDRESS OF DATA LESSON * /--- BLOCK DATAOUT 00 000 77/10/20 01.24 * SA0 ITEMP CURRENT HOLLERITH DATE SA1 DBLKLIM GET NUMBER OF BLOCKS IN LESSON SA2 INF+DATBLOK X2 = NEW BLOCK (USED LATER) SB1 1 B1 = LENGTH FOR LATER IX0 X2-X1 CHECK IF DATA FILE NOW FULL PL X0,DD165 SX1 DDIRECT+64+128 BIAS TO BLOCK NAMES IX1 X1+X2 ADD BIAS TO CURRENT BLOCK IX0 X5+X1 + WE 1 WRITE OUT DATE BLOCK STARTED RJ ECSPRTY SB1 2 GET BOTH PREVIOUS AND CURRENT * DD165 SA1 DBLOKN PREVIOUS BLOCK NUMBER SX1 DDIRECT+64+X1 BIAS TO BLOCK INFO WORD IX0 X5+X1 + RE B1 READ PROPER BLOCK INFO WORD(S) RJ ECSPRTY SA1 A0 MX3 -9 LX3 9 BX6 X3*X1 CLEAR OLD WORD COUNT SA1 DWORD PREVIOUS LAST WORD LX1 9 BX6 X6+X1 SA6 A0 SX1 B1-2 NG X1,DD170 JUMP IF FILE FULL SA1 A0+1 BX6 X3*X1 CLEAR OLD WORD COUNT SA1 INF+DATWORD CURRENT LAST WORD LX1 9 BX6 X6+X1 SA6 A0+1 * DD170 WE B1 UPDATE BLOCK INFO WORD(S) RJ ECSPRTY * SX1 DDIRECT+3 BIAS TO FLAG / LAST BLOCK USED IX0 X5+X1 MX6 -18 + RE 1 RJ ECSPRTY SA1 A0 FLAG / LAST BLOCK USED BX6 X6*X1 ONLY LAST 18 BITS ARE BLOCK BX6 X6+X2 PUT IN NEW BLOCK NUMBER SA6 A0 + WE 1 UPDATE FLAG / LAST BLOCK USED RJ ECSPRTY * DD175 BX0 X5 ECS ADDRESS OF DATA BUFFERS SA0 INF + WE DPRMLTH WRITE OUT STATUS WORDS RJ ECSPRTY * /--- BLOCK DATAOUT 00 000 78/11/12 21.33 * * SAVE STATUS / RJ TRAIL BEFORE BEGINNING I/O * CALL IOLESSN,TBLDATA,4000B SX6 B7 SAVE CURRENT CONTINGENCY SA6 NCTYPEP NG X6,DD200 JUMP IF NOT NORMAL EXECUTION CALL SAVLES SAVE COMMON, STORAGE, ETC. * * CALL LINKS,WORK SAVE RETURN JUMP TRAIL DD200 SB1 WORK + RJ =XLINKS - VFD 30/DATAOUT * * WRITE FILLED DATA BLOCK TO DISK * SA5 DECSLOC ECS ADDRESS OF DATA LESSON SX1 DRJSAVE IX0 X1+X5 ADDRESS FOR RJ TRAIL BUFFER SA0 WORK + WE DRJLTH WRITE OUT RJ TRAIL RJ ECSPRTY SX1 DBLK2 BIAS TO BLOCK TO WRITE IX6 X1+X5 ECS ADDRESS OF BLOCK TO WRITE SA6 DECSLOC * INTCLR X,I.DAT RELEASE INTERLOCK DISKO (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC SA6 DERRFLG SAVE ERROR RETURN NZ X6,DDEXIT EXIT IF DISK ERROR * * WRITE UPDATED DATA FILE DIRECTORY BLOCK TO DISK * SA1 TBLDATA RELOAD DATA BUFFER INFO WORDS CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH+DDIRECT IX6 X0+X1 ADDRESS OF DIRECTORY BLOCK SA6 DECSLOC DISKO (INF+DFINF),(INF+DDISKU),K0,DECSLOC SA6 DERRFLG SAVE ERROR RETURN NZ X6,DDEXIT EXIT IF DISK ERROR * /--- BLOCK DATAOUT 00 000 78/11/12 21.05 * * CLEAR DATA FILE WRITE BIT AND SET ERROR BIT IF * DISK ERROR OCCURRED * DDEXIT INTLOK X,I.DAT,W INTERLOCK CALL IOLESSN,TBLDATA,-4000B SA1 TBLDATA RESTORE DATA FILE PARAMETERS CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH BIAS PAST HEADER RECORD IX5 X0+X1 MX6 1 FORM MASK FOR WRITE BIT LX6 60-DWRITSH SA1 INF+DATSTAT DATA FILE STATUS WORD BX6 -X6*X1 CLEAR FILE WRITE BIT SA2 DERRFLG ZR X2,DD900 JUMP IF NO DISK ERROR OCCURRED MX2 1 LX2 60-DERRSH POSITION DISK ERROR BIT BX6 X2+X6 SET BIT TO MARK ERROR OCCURRED MX1 -18 CLEAR THE OLD STATION NUMBER BX6 X6*X1 SA1 STATION INSERT CURRENT STATION NUMBER BX6 X6+X1 * DD900 SA6 INF+DATSTAT STORE ERROR BIT AND STATION * * RESTORE STATUS / RJ TRAIL AFTER I/O * BX0 X5 ECS ADDRESS OF DATA INFO WORDS SA0 INF + WE DPRMLTH UPDATE DATA FILE PARAMETERS RJ ECSPRTY SX1 DRJSAVE BIAS TO RJ TRAIL SAVE AREA IX0 X1+X5 SA0 WORK + RE DRJLTH READ SAVED RJ TRAIL TO CM RJ ECSPRTY * CALL LINKR,WORK RESTORE RJ TRAIL SB1 WORK + RJ =XLINKR - VFD 30/DATAOUT SA1 NCTYPEP SB7 X1 RESTORE CONTINGENCY NG X1,DAT990 EXIT IF NOT IN NORMAL EXECUTION CALL RESTLES RESTORE LESSON, COMMON, ETC. EQ DAT990 * * * /--- BLOCK DATAOUT 00 000 78/11/12 21.06 TITLE -DATOOV- SET TO NEXT DATA FILE * * * GET NAME OF NEXT DATA FILE IF ANY * DATNXT SA1 TBLDATA DATA BUFFER LESSON NUMBER SX1 X1 CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SX1 LPRMLTH IX5 X0+X1 ECS ADDRESS OF DATA BUFFER * SX1 DDIRECT+4+O.NFNAM OFFSET TO NEXT FILE NAME SA0 TBINTSV+1 IX0 X5+X1 + RE 1 *TBINTSV(1)* = NEXT FILE NAME RJ ECSPRTY SA1 A0 CHECK IF ANY NEXT DATA FILE ZR X1,DAT990 EXIT IF NONE SA1 TBINTSV+3 SX6 X1-1 CHECK IF LOOPING THROUGH TOO NG X6,DAT990 MANY DATA FILES SA6 A1 * * SAVE STATUS / DATA RECORD / RJ TRAIL * SA1 DARG1 ADDRESS OF DATA RECORD SA0 X1 SA1 DARG2 LENGTH OF DATA RECORD SB1 X1 SA1 ADATAEC ADDRESS OF TEMPORARY ECS BUFFER BX0 X1 + WE B1 WRITE DATA RECORD TO TEMP ECS RJ ECSPRTY SX6 B7 SAVE CURRENT CONTINGENCY SA6 NCTYPEP NG X6,DATN10 JUMP IF NOT IN NORMAL EXECUTION * CALL SAVLES SAVE COMMON, STORAGE, ETC. * /--- BLOCK DATAOUT 00 000 78/11/12 21.25 * * CREATE STORAGE AREA FOR RJ TRAIL AND DATA RECORD * DATN10 CALL XSTOR,DSNAME,DSLTH SA1 LESNUM NG X1,DATW95 EXIT IF ECS IS NOT AVAILABLE SX6 X1 SA6 TBINTSV *TBINTSV(0)* = LESSON NUMBER CALL ALTLES,1 INTCLR X,I.ADDL RELEASE LESNAM INTERLOCK * * SAVE DATA RECORD AND RJ TRAIL IN STORAGE AREA * SA1 DARG2 GET LENGTH OF DATA RECORD BX6 X1 SA6 INFO MOVE TO CM BUFFER SB1 X1 SA1 ADATAEC ECS ADDRESS OF SAVED RECORD BX0 X1 SA0 INFO+1 ADDRESS OF CM BUFFER + RE B1 BRING IN DATA RECORD RJ ECSPRTY * CALL LINKS,(INFO+1+DATAMAX) SAVE RJ TRAIL SB1 INFO+1+DATAMAX + RJ =XLINKS - VFD 30/DATAOUT SA1 TBINTSV GET ECS ADDRESS OF STORAGE CALL READLES,0,0 SX1 LPRMLTH BIAS PAST HEADER RECORD IX0 X0+X1 SA0 INFO CM ADDRESS OF STUFF TO SAVE + WE DSLTH RJ ECSPRTY EQ DATAOA ADVANCE TO NEXT DATA-FILE * * RETURNS TO *REENT1* AFTER ADVANCE * REENT1 INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA SX1 X1 CHECK IF NEW DATA FILE SET ZR X1,DATW95 EQ DATW40 * * * /--- BLOCK DATAOUT 00 000 78/11/12 21.10 TITLE -DATOOV- WAIT FOR DATA FILE AVAILABLE * * * SAVE STATUS / DATA RECORD / RJ TRAIL BEFORE WAIT * ON DATA WRITE BUFFER AVAILABLE * DATWAIT SA1 DARG1 ADDRESS OF DATA RECORD SA0 X1 SA1 DARG2 LENGTH OF DATA RECORD SB1 X1 SA1 ADATAEC ADDRESS OF TEMPORARY ECS BUFFER BX0 X1 + WE B1 WRITE DATA RECORD TO TEMP ECS RJ ECSPRTY SX6 B7 SAVE CURRENT CONTINGENCY SA6 NCTYPEP NG X6,DATW10 JUMP IF NOT IN NORMAL EXECUTION CALL SAVLES SAVE COMMON, STORAGE, ETC. * * CREATE STORAGE AREA FOR RJ TRAIL AND DATA RECORD * DATW10 CALL XSTOR,DSNAME,DSLTH SA1 LESNUM NG X1,DATW95 EXIT IF ECS IS NOT AVAILABLE SX6 X1 SA6 TBINTSV SAVE STORAGE AREA LESSON NUM CALL ALTLES,1 INTCLR X,I.ADDL RELEASE LESNAM INTERLOCK * * SAVE DATA RECORD AND RJ TRAIL IN STORAGE AREA * SA1 DARG2 GET LENGTH OF DATA RECORD BX6 X1 SA6 INFO MOVE TO CM BUFFER SB1 X1 SA1 ADATAEC ECS ADDRESS OF SAVED RECORD BX0 X1 SA0 INFO+1 ADDRESS OF CM BUFFER + RE B1 BRING IN DATA RECORD RJ ECSPRTY * CALL LINKS,(INFO+1+DATAMAX) SAVE RJ TRAIL SB1 INFO+1+DATAMAX + RJ =XLINKS - VFD 30/DATAOUT SA1 TBINTSV GET ECS ADDRESS OF STORAGE CALL READLES,0,0 SX1 LPRMLTH BIAS PAST HEADER RECORD IX0 X0+X1 SA0 INFO CM ADDRESS OF STUFF TO SAVE + WE DSLTH RJ ECSPRTY * * /--- BLOCK DATAOUT 00 000 78/11/12 21.22 * * WAIT FOR DATA OUTPUT BUFFER AVAILABLE * DATW30 INTCLR X,I.DAT RELEASE INTERLOCK TUTIM 250 PAUSE FOR A WHILE INTLOK X,I.DAT,W INTERLOCK SA1 TBLDATA CALL READLES,DATINF,(LPRMLTH+DPRMLTH) SA1 INF+DATSTAT LOAD STATUS WORD LX1 DWRITSH CHECK IF FILE AVAILABLE NG X1,DATW30 * DATW40 SA1 NCTYPEP RESTORE CURRENT CONTINGENCY SB7 X1 NG B7,DATW45 JUMP IF NOT NORMAL EXECUTION CALL RESTLES RESTORE LESSON, COMMON, ETC. * DATW45 SA1 TBINTSV STORAGE LESSON NUMBER CALL ALTLES,-1 RELEASE STORAGE BLOCK SA1 TBINTSV CALL READLES,INFO,(LPRMLTH+DSLTH) * CALL LINKR,(INFO+LPRMLTH+1+DATAMAX) SB1 INFO+LPRMLTH+1+DATAMAX + RJ =XLINKR - VFD 30/DATAOUT SA1 INFO+LPRMLTH SB2 X1 LENGTH OF DATA RECORD SB1 INFO+LPRMLTH+1 ADDRESS OF DATA RECORD EQ DATAO GO BACK AND START OVER AGAIN * DATW95 SA1 NCTYPEP RESTORE CURRENT CONTINGENCY SB7 X1 NG X1,DAT990 EXIT IF NOT NORMAL EXECUTION CALL RESTLES RESTORE LESSON, COMMON, ETC. * DAT990 INTCLR X,I.DAT RELEASE INTERLOCK EQ DATAOUT * * K0 DATA 0 K1 DATA 1 K2 DATA 2 * DECSLOC BSS 1 DWORD BSS 1 DBLOKN BSS 1 DBLKLIM BSS 1 DERRFLG BSS 1 ISYSF BSS 1 * DATINF BSS LPRMLTH+DPRMLTH INF EQU DATINF+LPRMLTH * DSLTH EQU 1+DATAMAX+DRJLTH * DSNAME DATA 0 DATA 0LDATATEMP DATA 0LSTORAGE + VFD 12/1,48/0 * ENDOV * * /--- BLOCK BACKOUT 00 000 75/03/10 15.51 TITLE -BACKOUT- * * *BACKOUT*, *BACK ON* AND *BACKTST* FUNCTIONS * -BACKOUT (-1),STATION- OR -BACKOUT (-1)- * 'THIS COMMAND BACKS OUT EITHER A SINGLE STATION * OR ALL STATIONS. 'THE SAME BASIC PROCESS IS USED * IN BOTH CASES'; PRESSING KEY ',SSBKEY', ON A STATION * STARTS A PROCESS ON THAT STATION THAT * A) LOCKS OUT ALL KEYSET KEYS * B) PRESSES A SEQUENCE OF ',STOP1', AND ',BACK', KEYS * ON THE STATION, UNTIL EITHER THE STATION GIVES UP * ITS STUDENT BANK, OR THE SEQUENCE REACHES AN END * C) THE PROCESS (EVEN FOR ALL TERMINALS) SHOULD REACH * COMPLETION IN A FEW SECONDS. * D) IF THE BACKOUT PROCESS REACHES THE END OF THE * SEQUENCE AND THE STATION IS NOT YET OUT, THE * BACKOUT BIT IS TURNED OFF. * 'THE RESULTING STATUS OF A STATION IS DETERMINED * FROM THE FOLLOWING TABLE'; * * 'CONDITION-'STATUS BACKOUT BIT BANK ADDRESS * B.O. IN PROGRESS ON ON * B.O. COMPLETED ON OFF * B.O. UNSUCCESSFUL OFF ON * MAY HAVE LOST A * PRESS KEY, OR STATION * WAS SIGNED OUT AFTER * UNSUCCESSFUL B.O. OFF OFF * 'THE -BACKOUT- COMMAND WILL NOT BACK OUT THE EXECUTING STATION * -BACKON-'; * -BACKOUT (0),STATION- OR -BACKOUT (0)- * 'THIS COMMAND TURNS OFF THE STATION'7S BACKOUT FLAG, * THEREBY LETTING IT BACK ON. THE FLAG IS SIMPLY * CLEARED. * -BACKOUT (1),STATION OR -BACKOUT (1)- * 'THIS COMMAND RETURNS (IN ERROR)'; * SINGLE STATION'; ALL STATIONS * -1 STATION BACKED OUT -1 ALL BACKED OUT * 0 STATION ACTIVE 0 NOT RETURNED * 1 BEING BACKED OUT (N) NUMBER OF * 2 STATION INACTIVE, NOT STATIONS NOT * BACKED OUT BACKED OUT * 3 STATION LT 0 * 4 STATION GT MAX * * ERROR RETURNS FOR *BACKOUT* AND *BACKON* FUNCTIONS * * -1 FUNCTION REQUEST PERFORMED * 3 STATION LT 0 * 4 STATION GT MAX * 5 ACTION REQUEST OVERFLOW * IN *TERROR* * /--- BLOCK BACKOUX 00 000 79/07/15 21.39 BACKOTV OVRLAY EXT TEMP -BACKOUT- USED TO BE IN *IOPUT* BACKOUX SX7 -1 SA7 TERROR PRESET CALL SAVKEY NGETVAR SA5 A5 CHECK FOR 2ND ARG LX5 XCODEL ZR X1,BACKON JUMP IF -BACK ON- PL X1,BACKTST -BACKTST- PL X5,SBACKX BRANCH IF STATION SPECIFIED * CALL SAVLES SAVE COMMON, STORAGE, ETC. PAUSE FORMAT ANY OUTPUT SX6 RQBKOUT SA6 ACTOUT REQUEST BACKOUT SX6 1 SA6 AOUTLOC TUTIM -1,,IOKEY WAIT FOR IOKEY CALL RESTKEY EQ RETPRO TO PROCESSING, RELOAD COMMON,STO, ETC * /--- BLOCK SBACKX 00 000 77/12/01 23.16 SBACKX NGETVAR STATION NUMBER NG X1,SBERR0 SX2 NUMSTAT-1 MAX STATION NUMBER IX2 X2-X1 NG X2,SBERR1 SA2 STATION IX2 X1-X2 ZR X2,PROCESS EXIT IF THIS STATION * THE FOLLOWING CODE PRESSES THE BACKOUT KEY ON * THE DESIGNATED STATION SA2 AOUTLOC SX7 X2+3 SX3 X7-AOUTLTH PL X3,SBERR2 STANDARD CHECK FOR ROOM IN BUFFER SA7 A2 SX6 RQPRESS SA6 ACTOUT+X2 SX6 SSBKEY SA6 A6+1 BX6 X1 STATION SA6 A6+1 EQ PROCESS * * CLEAR ',BACKOUT', STATUS TO LET TERMINAL(S) BACK ON BACKON BSS 0 SA2 BCKOUT FLAG, STATION SET FOR GENERAL BACKOUT MX6 1 CLEAR FLAG BIT BX6 -X6*X2 SA6 A2 CLEARS GENERAL BACKOUT FLAG SA6 MASRQ+1 INTO REQUEST BUFFER SX6 XR.BKOU SA6 MASRQ SET INTER-EXEC REQUEST CODE CALL MXRQALL TELL OTHER EXECUTORS TO CLEAR FLAG BACKO2 PL X5,SBCKONX BRANCH IF SINGLE STATION SB1 B0 MX1 0 * /--- BLOCK SBACKX 00 000 77/04/04 23.46 * BOTH ALL AND SINGLE STATION ',BACKON', COMES HERE, * WITH B1 AND X1 SET APPROPRIATELY BCKONCX BSS 0 SX0 STFLAGS-STSTART SA3 NSYSBNK IX0 X0+X3 SA3 NSYSLTH IX1 X3*X1 BIAS FOR STATION (X1) SB2 NUMSTAT-1 SA0 TEMP IX0 X0+X1 ADD BIAS FOR SINGLE STATION MX1 1 LX1 SSBBIT MX2 1 LX2 SSCBIT BX2 X1+X2 CLEAR SSBBIT AND SSCBIT * THE FOLLOWING LOOP CLEARS THE BACKOUT BIT IN ALL * STATION BANKS, INCLUDING THE ECS COPY FOR THIS * STATION--WHICH DOES NO HARM BCKLP BSS 0 RE 1 RJ ECSPRTY SA1 A0 BX6 -X2*X1 SA6 A0 WE 1 RJ ECSPRTY IX0 X0+X3 SB1 B1+1 LE B1,B2,BCKLP EQ PROCESS SBCKONX NGETVAR GET STATION NUMBER NG X1,SBERR0 SX3 NUMSTAT-1 MAX STATION NUMBER IX2 X3-X1 NG X2,SBERR1 * THERE IS NO CHECK HERE FOR THIS STATION, AS IT * CAN NOT ARISE (EXCEPT THROUGH PRESS KEY ACTIONS) * NOR WOULD IT MATTER SB1 X3 SET B1 TO EXIT FROM LOOP EQ BCKONCX * SBERR0 MX7 0 STATION ^$ LT 0 EQ SBERR SBERR1 SX7 1 STATION ^$ GT MAX EQ SBERR SBERR2 SX7 2 ACTION REQUEST OVERFLOW SBERR SA7 TERROR EQ PROCESS * /--- BLOCK BACKTST 00 000 77/04/04 23.33 BACKTST BSS 0 PL X5,BKSSTST SB2 NUMSTAT SB1 1 CONSTANT MX6 0 TSTALLP BSS 0 SB2 B2-B1 DECREMENT STATION NUMBER LE B2,TSTQUIT SKIP CONSOLE SX1 B2 SA2 STATION IX2 X1-X2 ZR X2,TSTALLP CALL SSTST STATUS RETURNED IN X7 NG X7,TSTALLP SX6 X6+B1 EQ TSTALLP TSTQUIT BSS 0 SX7 -1 ZR X6,TSTSET BX7 X6 (N) NOT YET BACKED OUT TSTSET SA7 TERROR EQ PROCESS BKSSTST BSS 0 NGETVAR STATION NUMBER * * CHECK VALIDITY OF STATION NUMBER NG X1,SBERR0 SX2 NUMSTAT-1 IX2 X2-X1 NG X2,SBERR1 CALL SSTST SA7 TERROR EQ PROCESS ENDOV * /--- BLOCK SHOWE 00 000 81/01/14 11.42 TITLE SHOWE * -SHOWE- * * SHOWS TUTOR VARIABLE IN SCIENTIFIC NOTATION * THE SECOND ARGUMENT SPECIFIES THE NUMBER OF * SIGNIFICANT FIGURES. 'THERE IS ALWAYS A LEADING * BLANK OR MINUS SIGN; THE DEFAULT IS 4 SIG . FIGS * THIRD ARG IS 0 FOR REGULAR, NON-ZERO FOR ** * SHOWEOV OVRLAY EXT ARAYFLG,ASHOWE,SHOWFIN,ASHOWIN * ABOVE IS DUE TO OVERLAYING OF THIS COMMAND SHOWE SX7 0 SA7 ARAYFLG GETVAR SETS NONZERO IF ARRAY SA7 STARFLG CLEAR FLAG FGETVAR EVALUATE 1ST ARGUMENT BX7 X1 SA7 SHOWVAL SAVE IT SA5 A5 RESTORE COMMAND LX5 XCODEL LEFT-ADJUST 2ND ARG CODE NG X5,SHOWE2 NEG MEANS DEFAULT 2ND ARGUMENT (6.3 OR 2.0) NGETVAR DO THE CALC TO GET THE FORMAT BX6 X1 ZR X6,PROCESS OUT IF NOTHING TO DO * SHOWE1 SA5 A5 REFETCH COMMAND WORD LX5 2*XCODEL PL X5,SHOWE3 FOR THREE ARG SHOW * SHOWE1A SA6 NCHAR INTERFACE (SAVE FOR ASHOWE) MX7 0 SA7 SHOWOUT REQUEST LEADING BLANK/SIGN SX7 1 SA7 SUPPFLG NO ZERO SUPPRESSION SA1 ARAYFLG NZ X1,ASHOWE JUMP IF IS ARRAY RJ =XESHOW EQ SHOWFIN * **** SHOWE2 SX6 4 INTERFACE DEFAULT EQ SHOWE1 *** SHOWE3 SA6 NCHAR STORE NCHAR (KLUDGE) MX0 2*XCODEL+XCMNDL FLAG BIT NOT SET IFGETHERE LX5 60-2*XCODEL-XCMNDL POSITION ADDRESS BX5 -X0*X5 SA1 B5+X5 FETCH 3RD ARG BX5 X1 NGETVAR MX6 0 REMOVE -0 IX6 X6+X1 SA6 STARFLG * SA1 NCHAR BX6 X1 RESTORE NCHAR EQ SHOWE1A REENTER FLOW * ENDOV * * /--- BLOCK SHOWO 00 000 78/09/01 21.37 * TITLE SHOWO * -SHOWO- (CODE=32) * * SHOWS IN OCTAL FORMAT THE CONTENTS OF A TUTOR VARIABLE. * SHOWOOV OVRLAY EXT ARAYFLG,ASHOWE,SHOWFIN,ASHOW3,ASHOWIN * ABOVE IS DUE TO OVERLAYING OF THIS COMMAND SHOWOX SX7 0 SA7 ARAYFLG PREPARE FOR SHOWO(ARRAY) NGETVAR I/F BIT OUT AT CONDENSE TIME BX7 X1 SA7 SHOWVAL SAVE IT SA5 A5 RESTORE COMMAND LX5 XCODEL LEFT-ADJUST 2ND ARG CODE NGETVAR ROUNDS TO INTEGER IN X1 ZR X1,PROCESS OUT IF NOTHING TO DO BX6 X1 SA6 NCHAR SA1 ARAYFLG NZ X1,ASHOWO JUMP IF WHOLE ARRAY RJ =XOSHOW EQ SHOWFIN * ASHOWO SA3 SHOWO1 PLANT EQ SHOWO2 IN LOOP SX6 1 TYPE=1 FOR NGETVAR EQ ASHOWIN * SHOWO1 EQ SHOWO2 * SHOWO2 RJ OSHOW CALL XYFIX CALL TUTWRT SA1 NX SX7 X1+16 SA7 A1 ADJUST WHEREX SX7 5555B TWO SPACES LX7 48 SA7 SHOWVAL BETWEEN OCTAL VALUES SB1 A7 PTR TO STRING SX7 2 SA7 SHOWOUT SB2 A7 PTR TO COUNT EQ ASHOW3 CALL TUTWRT FOR SPACES + GO ON * ENDOV * * /--- BLOCK SHOWH 00 000 78/10/18 03.01 * TITLE SHOWH * -SHOWH- (CODE=43) * * 'SHOWS THE CONTENTS OF A 'T'U'T'O'R VARIABLE IN HEX. * * SHOWHOV OVRLAY EXT ARAYFLG,ASHOWE,SHOWFIN,ASHOW3,ASHOWIN * ABOVE IS DUE TO OVERLAYING OF THIS COMMAND SHOWHX SX7 0 SA7 ARAYFLG PREPARE FOR SHOWH(ARRAY) NGETVAR I/F BIT OUT AT CONDENSE TIME BX7 X1 SA7 SHOWVAL SAVE IT SA5 A5 RESTORE COMMAND LX5 XCODEL LEFT-ADJUST 2ND ARG CODE NGETVAR ROUNDS TO INTEGER IN X1 ZR X1,PROCESS --- EXIT IF NOTHING TO DO BX6 X1 SA6 NCHAR SA1 ARAYFLG NZ X1,ASHOWH JUMP IF WHOLE ARRAY RJ =XHSHOW EQ SHOWFIN --- FINAL EXIT ASHOWH SA3 SHOWH1 PLANT EQ SHOWH2 IN LOOP SX6 1 TYPE=1 FOR NGETVAR EQ ASHOWIN * SHOWH1 EQ SHOWH2 * SHOWH2 RJ HSHOW CALL XYFIX CALL TUTWRT SA1 NX SX7 X1+16 SA7 A1 ADJUST WHEREX SX7 5555B TWO SPACES LX7 48 SA7 SHOWVAL BETWEEN OCTAL VALUES SB1 A7 PTR TO STRING SX7 2 SA7 SHOWOUT SB2 A7 PTR TO COUNT EQ ASHOW3 CALL TUTWRT FOR SPACES + GO ON ENDOV * * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 TITLE -TALKREQ- DOCUMENTATION ** TALKREQ - TALK/MONITOR INITIATION/TERMINATION. * * ENTRY (OVARG1) = ZERO IF CALLED BY TUTOR COMMAND * NZ IF BY SIGNOUT PROCESS * * ALL THE VARIOUS FUNCTIONS ARE ACTUALLY OFF-SHOOTS * OF THE ABILITY OF THE FORMATTER TO SWITCH OUTPUT * BETWEEN TERMINALS. THE ',FORWARD POINTER', IS USED * BY THE FORMATTER TO RE-ROUTE OUTPUT (AFTER BEING * SENT TO IT'7S ORIGINATOR). FOR EXAMPLE'; TALK IS * ACTUALLY MONITOR MODE, BUT THE TWO USERS ARE HELD * AT THEIR INDIVIDUAL ARROWS. MONITOR AND TELECONF * ALLOW ONE USER TO MOVE AROUND THE SYSTEM WHILE THE * OTHER(S) ARE HELD. MASTER MODE ALLOWS BOTH USERS * TO MOVE AROUND (THOUGH ONE STATION IS USUALLY NOT * SIGNED IN). * * THE MOST IMPORTANT ASSOCIATED DECKS'; * EXECUTOR DECK TUTORX, ROUTINE (I)MODE7. * FORMATTER DECK FORMAT, ROUTINE FORMX. * CONDENSOR DECK COVLAY2, OVERLAY TRQCOV. * * * * *ATALK* -- TALK/MONITOR STATUS TABLE. * * PROTECTED BY PROCESS INTERLOCK *I.TALK*; * 1 WORD/STATION (CONFIGURED IN DECK MSUBS)'; * * 6/STATUS (SEE TRS. EQUATES) * 18/EXTRA INFO (PEOPLE LIST BUFFER NUMBER IN TLC) * 18/',BACK PTR', TO PREVIOUS STATION IN CHAIN * 18/',FORWARD PTR', TO NEXT STATION IN CHAIN * * * THE SIGN BIT OF *PSLAVE* (/STATION/ BANK) IS USED * TO FLAG MONITOR STATUS IS ACTIVE'; FORMATTER RE- * ROUTING INFORMATION IS IN THE *ATALK* STATUS WORD * FOR THIS STATION. THIS IS ALSO USED BY THE EXEC * WHEN THE 'T'E'R'M KEY IS PRESSED. * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 EJECT ** * EFFECTS OF VARIOUS -TALKREQ- FUNCTIONS WITH REGARDS TO * STATUS OF THE EXECUTING STATION AND THE TARGET STATION. * * NOTE - THE *PSLAVE* FLAG IS SET/CLEARED FOR THE EXECUTING * STATION ONLY. IF THE OTHER STATION ISN'7T ',WATCHING', FOR * A STATUS CHANGE (I.E. MONITOR, MASTER), THE INITIATING * STATION MUST USE THE -STCHANG- COMMAND TO SET/CLEAR THE * FLAG FOR HIM. ** * ------ BEFORE ----- ----- AFTER ------ * (US) (THEM) (US) (THEM) *----------------------------------------------------------- * REQUEST 0/SYSLIB 0 RTK RTK *----------------------------------------------------------- * CANCEL 0 N/A N/A N/A * TELE-MAS TELE-MON 0 0 * TELE-MON TELE-XXX 0 UNCHANGED * (ELSE) TELE-XXX 0 UNCHANGED * (ELSE) (ELSE) 0 0 *----------------------------------------------------------- * ANSWER RTK RTK TALK TALK *----------------------------------------------------------- * SETSLIB 0 SYSLIB *----------------------------------------------------------- * MONITOR 0 0 MONITOR MONITORED * MASTER 0 0 MASTER MASTER *----------------------------------------------------------- * TLK2MON TALK TALK MONITORED MONITOR * MON2TLK MONITORED MONITOR TALK TALK *----------------------------------------------------------- * STATUS N/A *----------------------------------------------------------- * JOIN 0/SYSLIB/RTK TELEXXX TELE-MON TELEXXX *----------------------------------------------------------- * CONFER 0 N/A TELE-MAS N/A *----------------------------------------------------------- * PAGE TELE-MAS 0 UNCHANGED RTK *----------------------------------------------------------- * UNPAGE N/A RTK N/A 0 *----------------------------------------------------------- * PASS TELE-MAS TELE-MON TELE-MON TELE-MAS *----------------------------------------------------------- * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 TITLE -TALKREQ- TALK/MONITOR FUNCTIONS TALKRQV OVRLAY * * STATUS EQUATES * TRS.0 EQU 0 0 = NOT BUSY TRS.RTK EQU 1 1 = REQUEST TALK/TELECONF TRS.TLK EQU 2 2 = TALKING TRS.SLB EQU 3 3 = IN NON-INTERRUPT SYSLIB FNC TRS.MTR EQU 4 4 = MONITORING TRS.MTB EQU 5 5 = BEING MONITORED TRS.MST EQU 6 6 = DUAL-STATION MASTER TRS.TLM EQU 7 7 = TELECONFERENCE MASTER TRS.TLC EQU 8 8 = TELECONFERENCE MONITOR * * MAIN ENTRY -- CHECK FOR SUBROUTINE VS. COMMAND * SA1 OVARG1 ZR X1,TRQCMND -- JUMP IF TUTOR COMMAND * * SUBROUTINE CALL DURING SIGNOUT PROCESS * INTLOK X,I.TALK,W CALL TRQBYE INTCLR X,I.TALK RETURN -- EXIT OVERLAY * * * * -TALKREQ- COMMAND EXECUTION * * ENTRY (X5) = 20/STATION GETVAR CODE * 20/2ND ARGUMENT (NOT USED) * 11/REQUEST TYPE CODE * 9/-TALKREQ- COMMAND CODE * TRQCMND BSS 0 TUTOR COMMAND PROCESSOR BX1 X5 MX0 -11 MASK FOR REQUEST TYPE AX1 XCMNDL SHIFT COMMAND CODE OFF BX1 -X0*X1 X1 = REQUEST TYPE SB1 X1 JP B1+TRQTAB JUMP TO SPECIFIC ROUTINE * * -TRQTAB- TALK REQUEST JUMP TABLE * * NOTE -- THIS TABLE MUST MATCH THE CORRESPONDING * ==== TABLE IN THE CONDENSOR (COVLAY2). * TRQTAB EQ TRQ0 0 = REQUEST EQ TRQ1 1 = CANCEL EQ TRQ2 2 = ANSWER EQ TRQ3 3 = SETSLIB EQ TRQ4 4 = MONITOR EQ TRQ5 5 = MASTER EQ TRQ6 6 = TLK2MON EQ TRQ7 7 = MON2TLK EQ TRQ8 8 = STATUS EQ TRQ9 9 = JOIN EQ TRQ10 10 = CONFER EQ TRQ11 11 = PAGE EQ TRQ12 12 = UNPAGE EQ TRQ13 13 = PASS * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 TITLE -TALKREQ- COMMAND, KEYWORD ROUTINES ************************************************************ * 0 = REQUEST ISSUE TERM-TALK REQUEST ************************************************************ * OUR STATUS SHOULD BE 0 OR -IN SYSLIB- * HIS STATUS SHOULD BE 0 TRQ0 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,STATION,S.WORD,S.STATUS ZR X6,TRQ0A -- OUR STATUS IS 0; OK SX1 X6-TRS.SLB NZ X1,TRQERR1 -- ERROR, OUR STATUS WRONG TRQ0A CALL RDSTAT,TARGET,T.WORD,T.STATUS NZ X6,TRQERR0 -- ERROR, HIS STATUS WRONG * SX6 TRS.RTK *REQUEST TALK* STATUS CODE SA6 S.STATUS SA6 T.STATUS SA1 SELF OUR STATION NUMBER SA2 TARGET HIS STATION NUMBER BX6 X1 BX7 X2 SA6 T.TARGET POINT TO EACH OTHER SA7 S.TARGET CALL WRTSTAT,SELF,S.WORD,S.STATUS CALL WRTSTAT,TARGET,T.WORD,T.STATUS EQ TRQDONE -- COMPLETE, EXIT * ************************************************************ * 1 = CANCEL CANCEL ANY EXISTING STATE ************************************************************ * OUR STATUS COULD BE ANYTHING TRQ1 INTLOK X,I.TALK,W CALL TRQBYE EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ************************************************************ * 2 = ANSWER ANSWER TERM-TALK REQUEST ************************************************************ * BOTH STATIONS SHOULD BE IN *REQUEST TALK* * AND POINTING AT EACH OTHER. TRQ2 INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS SX3 X6-TRS.RTK NZ X3,TRQERR1 -- NOT BEING PAGED CALL RDSTAT,S.TARGET,T.WORD,T.STATUS SX3 X6-TRS.RTK NZ X3,TRQERR0 SA1 SELF CHECK POINTERS SA2 T.TARGET IX3 X1-X2 COMPARE NZ X3,TRQERR0 SX6 TRS.TLK CHANGE TO *TALKING* SA6 S.STATUS SA6 T.STATUS CALL WRTSTAT,SELF,S.WORD,S.STATUS CALL WRTSTAT,S.TARGET,T.WORD,T.STATUS SA1 PSLAVE SET PSLAVE FLAG FOR SELF MX6 1 BX6 X1+X6 SA6 A1 EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ************************************************************ * 3 = SETSLIB IN NON-INTERRUPT SYSLIB FUNCTN ************************************************************ * OUR STATUS SHOULD BE 0 TRQ3 INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS NZ X6,TRQERR1 -- ALREADY DOING SOMETHING SX6 TRS.SLB SA6 S.STATUS CALL WRTSTAT,SELF,S.WORD,S.STATUS EQ TRQDONE * ************************************************************ * 4 = MONITOR MONITOR ANOTHER STATION ************************************************************ * BOTH STATIONS SHOULD HAVE STATUS = 0 TRQ4 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS NZ X6,TRQERR1 -- WE ARE DOING SOMETHING ELSE CALL RDSTAT,TARGET,T.WORD,T.STATUS NZ X6,TRQERR0 -- HE IS DOING SOMETHING ELSE SX6 TRS.MTR SET UP OUR STATUS FIRST SA6 S.STATUS SA1 TARGET SX6 X1 SA6 S.TARGET SX6 TRS.MTB NOW HIS STATUS SA6 T.STATUS SA1 SELF SX6 X1 SA6 T.TARGET CALL WRTSTAT,SELF,S.WORD,S.STATUS CALL WRTSTAT,TARGET,T.WORD,T.STATUS SA1 PSLAVE SET PSLAVE BIT FOR SELF MX6 1 BX6 X1+X6 SA6 A1 EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ************************************************************ * 5 = MASTER DUAL-STATION MASTER ************************************************************ * BOTH STATIONS SHOULD HAVE STATUS = 0 TRQ5 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS NZ X6,TRQERR1 -- WE ARE DOING SOMETHING ELSE CALL RDSTAT,TARGET,T.WORD,T.STATUS NZ X6,TRQERR0 -- HE IS DOING SOMETHING ELSE SX6 TRS.MST BOTH STATIONS TO *MASTER* SA6 S.STATUS SA6 T.STATUS SA1 TARGET POINT AT EACH OTHER SX6 X1 SA6 S.TARGET SA1 SELF SX6 X1 SA6 T.TARGET CALL WRTSTAT,SELF,S.WORD,S.STATUS CALL WRTSTAT,TARGET,T.WORD,T.STATUS SA1 PSLAVE SET PSLAVE FLAG FOR SELF MX6 1 BX6 X1+X6 SA6 A1 EQ TRQDONE * ************************************************************ * 6 = TLK2MON SWITCH FROM TALK TO MONITOR ************************************************************ * BOTH STATIONS SHOULD BE IN *TALK* STATE * AND POINTING TO EACH OTHER TRQ6 INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS SX3 X6-TRS.TLK NZ X3,TRQERR1 -- WE AREN'7T TALKING CALL RDSTAT,S.TARGET,T.WORD,T.STATUS SX3 X6-TRS.TLK NZ X3,TRQERR0 -- HE ISN'7T TALKING SA1 SELF OUR STATION NUMBER SA2 T.TARGET WHO IS HE TALKING TO IX3 X1-X2 COMPARE NZ X3,TRQERR0 -- NOT TALKING TO US SX6 TRS.MTB SET OUR STATUS TO *MONITORED* SA6 S.STATUS SX6 TRS.MTR SET HIS STATUS TO *MONITORING* SA6 T.STATUS CALL WRTSTAT,SELF,S.WORD,S.STATUS CALL WRTSTAT,S.TARGET,T.WORD,T.STATUS EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ************************************************************ * 7 = MON2TLK SWITCH FROM MONITOR TO TALK ************************************************************ * OUR STATUS SHOULD BE *MONITORED* * HIS STATUS SHOULD BE *MONITORING* * SHOULD BE POINTING AT EACH OTHER TRQ7 INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS SX3 X6-TRS.MTB NZ X3,TRQERR1 -- NOT BEING MONITORED CALL RDSTAT,S.TARGET,T.WORD,T.STATUS SX3 X6-TRS.MTR NZ X3,TRQERR0 -- NOT MONITORING SA1 SELF OUR STATION NUMBER SA2 T.TARGET HIS PARTNER IX3 X1-X2 COMPARE NZ X3,TRQERR0 -- MONITORING SOMEONE ELSE SX6 TRS.TLK SET BOTH STATUS TO *TALK* SA6 S.STATUS SA6 T.STATUS CALL WRTSTAT,SELF,S.WORD,S.STATUS CALL WRTSTAT,S.TARGET,T.WORD,T.STATUS EQ TRQDONE * ************************************************************ * 8 = STATUS RETURN STATUS IN *ERROR* ************************************************************ * READ TARGET STATUS AND RETURN VIA EXIT PROCESS TRQ8 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,TARGET,S.WORD,B0 EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ************************************************************ * 9 = JOIN JOIN A TELECONFERENCE ************************************************************ * OUR STATUS SHOULD BE 0, IN SYSLIB, OR REQUEST * IF REQUEST, WE MUST BE TARGETING OUR REQUESTOR. * HIS STATUS SHOULD BE EITHER TELE-MASTER/MONITOR. TRQ9 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS ZR X6,TRQ9A -- OK, NOT BUSY SX3 X6-TRS.SLB ZR X3,TRQ9A -- OK, IN SYSLIB SX3 X6-TRS.RTK NZ X3,TRQERR1 -- ERROR, NOT REQUESTED SA1 S.TARGET SA2 TARGET IX3 X1-X2 NZ X3,TRQERR1 -- REQUESTOR .NE. TARGET TRQ9A CALL RDSTAT,TARGET,T.WORD,T.STATUS SX3 X6-TRS.TLM ZR X3,TRQ9B -- TARGET IS TELE-MASTER SX3 X6-TRS.TLC NZ X3,TRQERR0 -- TARGET NOT IN TELECONF TRQ9B SA1 SELF SA2 T.OTHER SX6 X1 SA6 A2 SX6 X2 SA6 S.OTHER CALL WRTSTAT,TARGET,T.WORD,T.STATUS CALL RDSTAT,S.OTHER,O.WORD,O.STATUS SA1 SELF SA2 O.TARGET SX6 X1 SA6 A2 SX6 X2 SA6 S.TARGET CALL WRTSTAT,S.OTHER,O.WORD,O.STATUS SA1 T.PLIST SX6 X1 SA6 S.PLIST SX6 TRS.TLC SA6 S.STATUS CALL WRTSTAT,SELF,S.WORD,S.STATUS SA1 PSLAVE SET PSLAVE FLAG FOR SELF MX6 1 BX6 X1+X6 SA6 A1 EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ************************************************************ * 10 = CONFER START A TELECONFERENCE ************************************************************ * OUR STATUS SHOULD BE 0 OR *IN SYSLIB* * THE ARGUMENT IS THE LESSON NUMBER OF THE * PEOPLE LIST, NOT A STATION NUMBER. TRQ10 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS ZR X6,TRQ10A -- OK, NOT BUSY SX3 X6-TRS.SLB NZ X3,TRQERR1 -- ERR, ALREADY DOING SOMETHING TRQ10A SX6 TRS.TLM TELE-MASTER SA6 S.STATUS SA1 SELF SX6 X1+ SA6 S.OTHER SA6 S.TARGET SA1 TARGET SX6 X1+ SA6 S.PLIST CALL WRTSTAT,SELF,S.WORD,S.STATUS SA1 PSLAVE SET PSLAVE FLAG FOR SELF MX6 1 BX6 X1+X6 SA6 A1 EQ TRQDONE * ************************************************************ * 11 = PAGE PAGE SOMEONE FOR A TELECONF ************************************************************ * OUR STATUS SHOULD BE *TELE-MASTER* * HIS STATUS SHOULD BE 0 TRQ11 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS SX3 X6-TRS.TLM NZ X3,TRQERR1 -- WE ARE NOT TELE-MASTER CALL RDSTAT,TARGET,T.WORD,T.STATUS NZ X6,TRQERR0 -- ALREADY DOING SOMETHING SX6 TRS.RTK SA6 T.STATUS SA1 SELF SX6 X1 SA6 T.TARGET CALL WRTSTAT,TARGET,T.WORD,T.STATUS EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ************************************************************ * 12 = UNPAGE CLEAR SOMEONE'7S PAGING STATUS ************************************************************ * HIS STATUS SHOULD BE *REQUEST TALK* AND * HE SHOULD BE POINTING AT US. TRQ12 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,TARGET,T.WORD,T.STATUS SX3 X6-TRS.RTK NZ X3,TRQERR0 -- NOT BEING PAGED SA1 SELF SA2 T.TARGET IX3 X1-X2 NZ X3,TRQERR0 -- PAGED BY SOMEONE ELSE CALL ZEROSTAT,TARGET EQ TRQDONE * ************************************************************ * 13 = PASS PASS CONTROL OF TELECONF ************************************************************ * OUR STATUS SHOULD BE TELE-MASTER * HIS STATUS SHOULD BE TELE-MONITOR * AND HE SHOULD BE IN SAME TELECONF. TRQ13 CALL GETARG,TARGET INTLOK X,I.TALK,W CALL RDSTAT,SELF,S.WORD,S.STATUS SX3 X6-TRS.TLM NZ X3,TRQERR1 -- OUR STATUS IS WORNG CALL RDSTAT,TARGET,T.WORD,T.STATUS SX3 X6-TRS.TLC NZ X3,TRQERR0 -- HIS STATUS IS WRONG SA1 S.PLIST SA2 T.PLIST IX3 X1-X2 NZ X3,TRQERR0 -- NOT IN OUR TELECONF SX6 TRS.TLM MAKE HIM THE MASTER SA6 T.STATUS SX6 TRS.TLC AND US A MONITOR SA6 S.STATUS CALL WRTSTAT,SELF,S.WORD,S.STATUS CALL WRTSTAT,TARGET,T.WORD,T.STATUS EQ TRQDONE * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 TITLE -TALKREQ- *CANCEL* FUNCTION ** TRQBYE - COMMON TERMINATION FUNCTION. * * REMOVE EXECUTING STATION FROM ANY MONITORS. * DROP PEOPLE LIST IF LAST PERSON IN TELECONF. * TRQBYE EQ * ENTRY/EXIT * CLEAR OUR OWN PSLAVE FLAG SA1 PSLAVE MX6 1 BX6 -X6*X1 SA6 A1 CALL RDSTAT,SELF,S.WORD,S.STATUS ZR X6,TRQBYE -- NOTHING TO DO, EXIT SX3 X6-TRS.TLM CHECK FOR TELE-MASTER ZR X3,TRQB0 -- ADJOURN TELECON SA1 SELF X1 = EXECUTING STATION NUMBER SA2 S.TARGET X2 = FORWARD STATION IX3 X1-X2 COMPARE NZ X3,TRQB2 -- SOMEONE ELSE IS IN CHAIN * POINTING AT SELF SX3 X6-TRS.TLC NZ X3,TRQB1 -- NOT IN A TELECONF CALL S=LOG,TRQMSG,3 EQ TRQB1 -- CLEAR SELF AND EXIT TRQB0 BSS 0 ** ADJOURN TELECONFERENCE ** CALL ZEROSTAT,SELF SA1 S.TARGET SAVE NEXT STATION IN CHAIN SX6 X1 SA6 TARGET SA1 S.PLIST GET PEOPLE LIST LESSON NUMBER ZR X1,ADJRN1 -- NO PEOPLE LIST SA1 OVARG1 DO WE NEED TO SAVLES'/ + NZ X1,*+1 -- NO, NOT CALLED BY COMMAND RJ =XSAVLES SAVE COMMON/STORAGE/ETC SA1 S.PLIST GET PEOPLE LIST LESSON NUMBER CALL DELETE DELETE BUFFER SA1 OVARG1 DO WE NEED TO RESTLES'/ + NZ X1,*+1 -- NO, CALLED BY COMMAND RJ =XRESTLES RESTORE COMMON/STORAGE/ETC. ADJRN1 BSS 0 CALL RDSTAT,TARGET,T.WORD,T.STATUS ZR X6,TRQBYE -- EXIT, COMPLETED CHAIN CALL ZEROSTAT,TARGET SA1 T.TARGET SX6 X1 SA6 TARGET SAVE NEXT STATION NUMBER EQ ADJRN1 TRQB1 BSS 0 ** CLEAR OWN STATUS AND EXIT ** CALL ZEROSTAT,SELF EQ TRQBYE TRQB2 BSS 0 ** CHECK ON MONITOR'7S STATUS ** SX3 X6-TRS.TLC CHECK FOR TELECONFERENCE ZR X3,TRQB3 -- YES, WE ARE IN ONE CALL RDSTAT,S.TARGET,T.WORD,T.STATUS SX3 X6-TRS.TLM ZR X3,TRQB1 -- TELE-MASTER, JUST CLEAR SELF SX3 X6-TRS.TLC ZR X3,TRQB1 -- TELE-MON, JUST CLEAR SELF CALL ZEROSTAT,S.TARGET CLEAR HIS STATUS TOO EQ TRQB1 -- NOW CLEAR OUR STATUS * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 TRQB3 BSS 0 ** REMOVE SELF FROM TELECONF ** * CORRECT FORWARD LINK IN CHAIN CALL RDSTAT,S.TARGET,T.WORD,T.STATUS SX3 X6-TRS.TLM ZR X3,TRQB4 -- OK, HE'7S THE TELE-MASTER SX3 X6-TRS.TLC NZ X3,TRQB1 -- OOPS, JUST CLEAR AND EXIT TRQB4 SA1 S.OTHER READ OWN BACKWRD POINTER SX6 X1 SA6 T.OTHER STORE IT AS THEIR BACK PTR CALL WRTSTAT,S.TARGET,T.WORD,T.STATUS * CORRECT BACKWARD LINK IN CHAIN CALL RDSTAT,S.OTHER,O.WORD,O.STATUS SX3 X6-TRS.TLM ZR X3,TRQB5 -- OK, HE'7S THE TELE-MASTER SX3 X6-TRS.TLC NZ X3,TRQB1 -- OOPS, JUST CLEAR AND EXIT TRQB5 SA1 S.TARGET READ OWN FORWARD POINTER BX6 X1 SA6 O.TARGET STORE IT AS THEIR FORWRD PTR CALL WRTSTAT,S.OTHER,O.WORD,O.STATUS EQ TRQB1 -- NOW CLEAR OUR STATUS * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 TITLE -TALKREQ- SUBROUTINES *********************************************************** * SUBROUTINES FOR -TALKREQ- *********************************************************** ** RDSTAT - READ TALK/MONITOR STATUS FOR STATION. * * ENTRY (B1) = ADDR OF DESIRED STATION NUMBER. * (B2) = ADDRESS TO HOLD STATUS WORD. * (B3) = ADDRESS OF 4-WORD DETAILED BUFFER. * (ZERO MEANS WORD NOT BROKEN DOWN) * * EXIT (X1) = DESIRED STATUS WORD (ALSO IN CM). * (X6) = 6-BIT STATUS CODE, IF BROKEN DOWN. * * ERROR IF INVALID STATION, EXITS TO TRQERR2. * * USES A - 0, 1, 6. * B - NONE. * X - 0, 1, 6. * RDSTAT EQ * ENTRY/EXIT POINT SA1 B1 GET DESIRED STATION NUMBER SX0 X1 TRUNCATE TO 18, MOVE TO X0 NG X0,TRQERR2 -- ILLEGAL, NEG. STATION NUM. SX1 NUMSTAT NUMBER OF STATIONS ON SYSTEM IX1 X0-X1 COMPARE PL X1,TRQERR2 -- ILLEGAL, STATION TOO LARGE SA1 ATALK X1 = EM ADDR OF STATUS TABLE IX0 X0+X1 X0 = EM ADDR FOR DESIRED WORD SA0 B2 CELL TO HOLD STATUS WORD RE 1 READ STATUS WORD FROM EM TO CM RJ =XECSPRTY HALF-EXIT IFF HARDWARE ERROR SA1 A0 READ STATUS WORD FROM CM ZR B3,RDSTAT -- NO BREAK-DOWN BUFFER SPECIF. SX6 X1 X6 = FORWARD POINTER SA6 B3+3 SAVE IT AX1 18 SHIFT TO NEXT FIELD SX6 X1 X6 = BACKWARD POINTER SA6 B3+2 SAVE IT AX1 18 SHIFT TO NEXT FIELD SX6 X1 X6 = PEOPLE LIST NUMBER SA6 B3+1 SAVE IT AX1 18 SHIFT TO NEXT FIELD SX6 X1 X6 = STATUS SA6 B3 SAVE IT EQ RDSTAT -- RETURN TO CALLER * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ** WRTSTAT - WRITE STATUS WORD FOR STATION. * * ENTRY (B1) = ADDR OF STATION NUMBER. * (B2) = ADDR OF NEW STATUS WORD. * (B3) = ADDR OF DETAILED STATUS BUFFER. * (ZERO MEANS ALREADY IN STATUS WD.) * * ERROR IF INVALID STATION, EXITS TO TRQERR2. * * USES A - 0, 1, 6. * B - NONE. * X - 0, 1, 6. * WRTSTAT EQ * ENTRY/EXIT ZR B3,WRTS1 -- NO DETAILED BUFFER SPECIF. SA1 B3 GET 6-BIT STATUS CODE MX6 -6 MASK FOR STATUS CODE BX6 -X6*X1 TRUNCATE LX6 18 SHIFT SA1 B3+1 GET 18-BIT PEOPLE LIST NUMBER SX1 X1 TRUNCATE BX6 X1+X6 UNION LX6 18 SHIFT SA1 B3+2 GET 18-BIT BACKWARD POINTER SX1 X1 TRUNCATE BX6 X1+X6 UNION LX6 18 SHIFT SA1 B3+3 GET 18-BIT FORWARD POINTER SX1 X1 TRUNCATE BX6 X1+X6 UNION SA6 B2 STORE RESULT WRTS1 SA1 B1 READ STATION NUMBER SX0 X1 TRUNCATE TO 18, MOVE TO X0 NG X0,TRQERR2 -- ILLEGAL, NEG. STATION NUM. SX1 NUMSTAT NUMBER OF STATIONS ON SYSTEM IX1 X0-X1 COMPARE PL X1,TRQERR2 -- ILLEGAL, STATION TOO LARGE SA1 ATALK X1 = EM ADDR OF STATUS TABLE IX0 X0+X1 EM ADDR OF STATUS WORD SA0 B2 CELL HOLDING NEW STATUS WORD WE 1 WRITE STATUS WORD TO EM RJ =XECSPRTY HALF-EXIT IFF HARDWARE ERROR EQ WRTSTAT -- RETURN TO CALLER * ** ZEROSTAT - ZERO STATUS WORD FOR SPECIFIED STATION. * * ENTRY (B1) = ADDRESS OF STATION NUMBER. * * ERROR EXITS TO TRQERR2 IF BAD STATION NUMBER. * * USES A - 0, 1. * B - NONE. * X - 0, 1. * ZEROSTAT EQ * ENTRY/EXIT SA1 B1 READ STATION NUMBER SX0 X1 TRUNCATE TO 18, MOVE TO X0 NG X0,TRQERR2 -- ILLEGAL, NEG. STATION NUM. SX1 NUMSTAT NUMBER OF STATIONS ON SYSTEM IX1 X0-X1 COMPARE PL X1,TRQERR2 -- ILLEGAL, STATION TOO LARGE SA1 ATALK X1 = EM ADDR OF STATUS TABLE IX0 X0+X1 EM ADDR OF STATUS WORD SA0 KZERO CONSTANT ZERO WE 1 WRITE STATUS WORD TO EM RJ =XECSPRTY HALF-EXIT IFF HARDWARE ERROR EQ ZEROSTAT -- RETURN TO CALLER * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 ** GETARG - GET ARGUMENT FROM COMMAND WORD. * * ENTRY (B1) = ADDRESS TO STORE ARGUMENT * GETARG PS ENTRY/EXIT SX6 B1 SA6 CARG SAVE ADDR NGETVAR BX6 X1 SA1 CARG SA6 X1 EQ GETARG * * /--- BLOCK -TALKREQ- 00 000 82/08/20 06.00 TITLE -TALKREQ- EXITS AND STORAGE *********************************************************** * EXITS FOR -TALKREQ- *********************************************************** TRQERR0 SX6 0 0 = TARGET HAS WRONG STATUS SA1 T.WORD READ TARGET STATUS WORD EQ TRQEXIT TRQERR1 SX6 1 1 = OUR STATUS IS WRONG SA1 S.WORD READ OUR STATUS WORD EQ TRQEXIT TRQERR2 SX6 2 2 = BAD STATION NUMBER SX1 0 NO STATUS WORD TO RETURN EQ TRQEXIT TRQDONE SX6 -1 -1 = REQUEST PROCESSED OK SA1 S.WORD READ OUR STATUS WORD TRQEXIT SA6 TRETURN SET *ZRETURN* TO RETURN CODE BX6 X1 SA6 TERROR SET *ERROR* TO STATUS WORD INTCLR X,I.TALK CLEAR INTERLOCK SA1 OVARG1 COMMAND OR SIGNOUT'/ ZR X1,PROCESS -- EXIT TO NEXT COMMAND RETURN -- EXIT OVERLAY AS SUBR. *********************************************************** * STORAGE CELLS FOR -TALKREQ- *********************************************************** * * STATION NUMBER, STATUS WORD, DISASSEMBLED FIELDS. * SELF EQU STATION EXECUTING STATION S.WORD BSSZ 1 STATUS WORD FROM EM S.STATUS BSSZ 1 6-BIT STATUS CODE S.PLIST BSSZ 1 18-BIT PEOPLE LIST LESSON NUM. S.OTHER BSSZ 1 18-BIT BACKWARD POINTER S.TARGET BSSZ 1 18-BIT FORWARD POINTER * TARGET BSSZ 1 FORWARD STATION (COMMAND TAG) T.WORD BSSZ 1 STATUS WORD FROM EM T.STATUS BSSZ 1 6-BIT STATUS CODE T.PLIST BSSZ 1 18-BIT PEOPLE LIST LESSON NUM. T.OTHER BSSZ 1 18-BIT BACKWARD POINTER T.TARGET BSSZ 1 18-BIT FORWARD POINTER * OTHER BSSZ 1 BACKWARD STATION O.WORD BSSZ 1 STATUS WORD FROM EM O.STATUS BSSZ 1 6-BIT STATUS CODE O.PLIST BSSZ 1 18-BIT PEOPLE LIST LESSON NUM. O.OTHER BSSZ 1 18-BIT BACKWARD POINTER O.TARGET BSSZ 1 18-BIT FORWARD POINTER * KZERO CON 0 CONSTANT ZERO CARG BSSZ 1 COMMAND ARGUMENT ADDRESS TRQMSG DIS ,* UNSAFE TELECONF CLEANUP.* ENDOV * /--- BLOCK FASTKOV 00 000 81/09/01 03.45 * TITLE FASTKOV -- KEY COLLECTION (PIO TO STORAGE) * -FASTKEY- (CODE=360) * FASTKEY STORAGE,NUMKEYS * ON COMPLETION *TRETURN* IS SET AS FOLLOWS * -1 = I/O COMPLETED SUCCESSFULLY * 0 = BAD STORAGE ADDRESS * 1 = BAD NUMBER OF KEYS * 2 = NO STORAGE AVAILABLE * 3 = INSUFFICIENT STORAGE AVAILABLE FASTKOV OVRLAY FINISH ILLEGAL IN FINISH UNIT SA1 TBITS KILL ANY FORCE FIRSTERASE MX2 1 LX2 -FSTEBIT BX6 -X2*X1 SA6 A1 * SA1 AUTKEY CHECK IF NEED TO END TIMESLICE * NG X1,FKINT BRANCH IF IN BACKGROUND * CALL COMPTIM CHECK CPU USAGE * NG B2,FKINT BRANCH IF NO EXCESS * EQ FKBKUP * /--- BLOCK FASTKOV 00 000 81/09/02 02.38 * RESERVE THE PIO CONTROL BUFFER, IF POSSIBLE FKINT INTLOK X,I.SSON INTERLOCK SA1 APIOFKB CHK BUFFER FREE BX0 X1 SET FOR ECS READ SA0 CPIOFKB + RE 2 - RJ ECSPRTY SA1 A0+1 CHECK 10TH BYTE (12BITS/BYTE) MX2 -12 BX2 -X2*X1 ZR X2,FKRES BRANCH IF BUFFER AVAILABLE INTCLR X,I.SSON NOT AVAILABLE, CLEAR INTERLOCK FKBKUP SA5 A5+1 BACK UP COMMAND POINTER EQ =XXSLICE END TIME SLICE FKRES SA2 STATION RESERVE THE BUFFER WITH STATION BX6 X2 SA6 A1 + WE 2 - RJ ECSPRTY INTCLR X,I.SSON CLEAR INTERLOCK * GET ARGUMENTS NGETVAR GET STORAGE ADDRESS SX2 1 CHK LOWER BOUND IX6 X1-X2 NG X6,FKERR0 --- ERROR BAD STORAGE ADDR SA6 FKECSAD SAVE STORAGE ORDINAL SA5 A5 RETRIEVE COMMAND WORD LX5 XCODEL SHIFT TO SECOND GETVAR CODE NGETVAR GET NUMBER OF KEYS TO COLLECT ZR X1,FKNOERR --- DONE IF 0 NG X1,FKERR1 --- ERROR IF NEGATIVE BX6 X1 SA6 FKNUMKY SAVE NUMBER OF KEYS TO COLLECT * /--- BLOCK FASTKOV 00 000 81/09/03 01.33 SX2 X1+4 COMPUTE NUMBER OF WORDS PX2 X2 NX2 X2 SX3 5 PX3 X3 NX3 X3 FX4 X2/X3 NWORDS = (NKEYS+4)/5 UX4 X4,B2 LX4 X4,B2 BX6 X4 SA6 FKNUMWD SAVE NUMBER OF WORDS NEEDED SA1 TBXSTOR CHECK THAT STORAGE EXISTS ZR X1,FKERR2 --- ERROR IF NO STORAGE CALL SETSTOR X1 IS INPUT; X6 AND *STORWRD* * ARE OUTPUT = 24/ECSAD,18/LEN SA1 FKECSAD X1=RELATIVE ECS ADDRESS SA2 FKNUMWD X2=NUMBER OF WORDS IX3 X1+X2 LAST WORD AX6 18 GET LENGTH SX4 X6 18 BIT FIELD IX3 X4-X3 (LENGTH)-(LAST WORD) NG X3,FKERR3 --- ERROR IF BAD ECS ADDRESS * BUILD PIO COMMAND BUFFER AX6 18 GET STORAGE ECS ADDR SA1 FKECSAD GET RELATIVE START IX6 X6+X1 LX6 36 MOVE ADDR TO TOP TWO BYTES SA6 CPIOFKB FIRST WORD OF PIO COMMAND BUFF SA1 CPIOFKB+1 START WITH STATION IN LAST BYTE BX6 X1 LX6 -12 ALSO IN TOP BYTE BX6 X6+X1 SA1 FKNUMKY NUMBER OF KEYS LX1 12 BX6 X6+X1 SA6 CPIOFKB+1 SECOND WORD OF PIO COMMAND BUFF * WRITE COMMAND BUFFER BACK TO ECS SA1 APIOFKB BX0 X1 SA0 CPIOFKB + WE 2 - RJ ECSPRTY * /--- BLOCK FASTKOV 00 000 81/09/06 23.19 * UNLOAD COMMON/STORAGE AND SAVE LESSON POINTERS CALL SAVLES SAVE COMMMON, STORAGE, ETC. * CHECK FOR STEP MODE FKSTEP SA1 TBITS LX1 STEPBIT PL X1,FKIOLN CALL STEPXX PLOT '7WAITING FOR KEY'7 * MARK STORAGE AS NON-RELOCATABLE AND NON-DELETABLE FKIOLN CALL IOLESSN,TBXSTOR,4000B * TURN ON COLLECTION BIT IN KEYBUFFER SA1 NKEYECS X1 = STARTING ECS ADDR KEYBUFF SA2 STATION X2 = STATION LX2 NKEYSHF IX0 X1+X2 SET FOR ECS READ SA0 FKKEYBF + RE NKEYLTH - RJ ECSPRTY SA1 A0+1 X1 = SECOND WORK OF KEYBUFFER MX2 -1 X2 = ONE BIT MASK LX2 23 MOVE TO TOP BIT OF STOP1 BYTE BX6 -X2+X1 TURN ON THE BIT SA6 A1 SX1 1 WRITE ONLY 1 WORD BACK IX0 X0+X1 SA0 A0+1 + WE NKEYLTH-1 WRITE IT BACK TO ECS - RJ ECSPRTY * CHECK FOR VARIOUS UNPROCESSED TIMING KEYS SA2 TIMING X2 = TIMING FLAGS LX2 59-TMRDONE NG X2,FKTR BRANCH TO PROCESS -TIMER- LX2 TMRDONE-TMEDONE CHECK FOR UNPROS. TIME PL X2,FKTTL BRANCH IF NO MX6 1 CLEAR UNPROCESSED BIT BX6 -X6*X2 LX6 TMEDONE-59 SA6 A2 EQ FKLONG GO TO END PROCESSING * /--- BLOCK FASTKOV 00 000 81/09/06 22.55 * WAIT FOR REQUEST TO BE COMPLETED FKTTL TUTIM -1,,ANYKEY * PROCESS THE ENDING KEY SA1 KEY SX2 X1-STOP1 CHECK FOR STOP1 NG X2,FKDN BRANCH IF LESS THAN STOP1 ZR X2,FKSTP1 BRANCH IF STOP1 SX2 X1-LONGUP ZR X2,FKLONG BRANCH IF -TIMEL- SX2 X1-ROUTUP NZ X2,FKDN BRANCH IF NOT -TIMER- * PROCESS -TIMER- FKTR SA2 TIMING SEE IF A -TIMER- UNIT MX6 -12 LX6 12 BX1 -X6*X2 ZR X1,FKTTL IGNORE KEY IF NO -TIMER- UNIT MX1 1 TURN OFF -UNPROCESSED- BIT LX1 TMRDONE-59 IN *TMRDONE* POSITION BX2 -X1*X2 CALL INROUTE X1=-1(IN ROUTER),0(NO ROUTER), * 1(HAS ROUTER BUT NOT IN IT) PL X1,FKTR1 PROCESS IF NOT IN ROUTER NOW BX6 X6*X2 AM IN ROUTER-CLEAR UNIT NUMBER, SA6 A2 WRITE BACK TIMING WORD EQ FKLONG GO RESET KEY AND EXIT FKTR1 MX6 1 INDICATE -STOP1- KEY LX6 TMRSTOP-59 IS TO EXIT TO -TIMER- UNIT BX6 X6+X2 BY SETTING NEXT TO TOP BIT SA6 A2 IN TIMING WORD. SX6 STOP1 THEN PROCESS AS -STOP1- SA6 KEY * PROCESS STOP1 KEY FKSTP1 CALL STOPCHK SEE IF SPECIAL SYSTEM LESSON ZR X2,FKDN YES, SO TREAT AS NORMAL KEY CALL FKOKBB TURN OFF THE KEYBUFFER BIT PAUSE PAUSE TO MAKE SURE PIO IS DONE CALL FKRCB RELEASE FASTKEY COMMAND BUFFER CALL RTCLEAR REMOVE TIMING REQUESTS EQ FINISH AND DO FINISH PROCESSING * /--- BLOCK FASTKOV 00 000 81/09/06 23.20 FKLONG SX6 TIMEUP RESET KEY TO TIMEUP SA6 KEY * NORMAL EXIT PROCESSING FKDN CALL FKOKBB TURN OFF FASTKEY BIT IN KEYBUFF PAUSE WAIT TO BE SURE PIO IS DONE SA1 APIOFKB RETURN NUMBER OF KEYS COLLECTED BX0 X1 IN ERROR (CHANGE LATER) SA0 CPIOFKB + RE 2 - RJ ECSPRTY SA1 CPIOFKB LX1 -12 SX6 X1 SA6 TERROR CALL RTCLEAR REMOVE LEFTOVER TIMING REQUEST CALL IOLESSN,TBXSTOR,-4000B FREE STORAGE CALL RESTLES RESTORE COMMON, LESSON, ETC FKNOERR SX6 -1 SET *ZRETURN* TO NO ERROR FKERRX SA6 TRETURN CALL FKRCB RELEASE THE COMMAND BUFFER * RETURN TO PROCESS NEXT COMMAND SA1 TRETURN NG X1,=XCKPROC EQ PROCESS DONE * ERROR EXITS FKERR0 SX6 0 0 = BAD STORAGE ADDRESS EQ FKERRX FKERR1 SX6 1 1 = BAD NUMBER OF KEYS EQ FKERRX FKERR2 SX6 2 2 = NO STORAGE EQ FKERRX FKERR3 SX6 3 3 = TOO MANY KEYS EQ FKERRX * /--- BLOCK FASTKOV 00 000 81/09/06 16.49 * SUBROUTINES * SUBROUTINE TO TURN OFF FASTKEY BIT IN KEY BUFFER FKOKBB PS ENTRY / EXIT SA1 NKEYECS X1 = STARTING ECS ADDR KEYBUFF SA2 STATION X2 = STATION LX2 NKEYSHF IX0 X1+X2 SET FOR ECS READ SA0 FKKEYBF + RE NKEYLTH - RJ ECSPRTY SA1 A0+1 X1 = SECOND WORD OF KEY BUFFER MX2 -1 X2 = 1 BIT MASK LX2 23 POSITION TO TOP OF STOP1 BYTE BX6 X2*X1 TURN OFF SA6 A1 SX1 1 IX0 X0+X1 SA0 A0+1 + WE NKEYLTH-1 WRITE IT BACK TO ECS - RJ ECSPRTY EQ FKOKBB RETURN * SUBROUTINE TO RELEASE FASTKEY COMMAND BUFFER FKRCB PS ENTRY / EXIT MX6 0 ZERO OUT THE BUFFER SA6 CPIOFKB SA6 CPIOFKB+1 SA1 APIOFKB WRITE IT BACK TO ECS BX0 X1 SA0 CPIOFKB + WE 2 - RJ ECSPRTY EQ FKRCB RETURN * STORAGE, ETC. NKEYSHF EQU 1 NKEYLTH EQU 2 CPIOFKB OVDATA 2 FKECSAD OVDATA 1 FKNUMKY OVDATA 1 FKNUMWD OVDATA 1 FKKEYBF OVDATA 2 ENDOV * * /--- BLOCK HASHOV 00 000 84/09/23 15.11 TITLE -HASH- COMMAND EXECUTION. ** HASHOV - EXECUTE -HASH- COMMAND. * * COMMAND WORD FORMAT -- * 20 / GETVAR CODE FOR INPUT. * 20 / GETVAR CODE FOR RESULT. * 11 / POINTER TO EXTRA STORAGE (IF THIRD TAG) * 9 / -HASH- COMMAND. * * USES THE *MRKLAST* CONVENTION (TOP BIT OF LAST * GETVAR CODE IS SET). ALSO, THE SECOND BIT OF * THE RESULT GETVAR CODE IS SET IF THE *PASSWORD* * KEYWORD IS SPECIFIED. * * ENTRY (A5/X5) = COMMAND WORD. * * EXIT TO *PROCESS*. * * CALLS PURDYOV (LEVEL 1 OVERLAY). * HASHOV OVRLAY SX6 3 UP TO 3 ARGUMENTS CALL GETARGS SX1 X6-3 CHECK 2- OR 3- ARGUMENT FORM PL X1,OWNHASH -- GET USER SPECIFIED PRIME SX6 X6-2 CHECK FOR 1- OR 2- ARG FORMS PL X6,TWOHASH -- IF 2 ARGUMENT FORM SA1 VARBUF ELSE, COPY FIRST ARG TO SECOND BX6 X1 SA6 VARBUF+1 TWOHASH BSS 0 SX6 PWPRIME PRIME FOR SIGNON PASSWORDS SA5 A5 GET ORIGINAL COMMAND WORD LX5 XCODEL+1 SHIFT TO 2ND BIT OF 2ND CODE NG X5,SETHASH -- *PASSWORD* SPECIFIED SA1 LESSCM+LSTOUSE CHECK FOR SYSTEM LESSON SX6 SYSPRIME PRIME FOR SYSTEM LESSONS NG X1,SETHASH -- IT IS A SYSTEM LESSON SX6 USRPRIME PRIME FOR USER LESSONS SETHASH BSS 0 SA6 OVARG2 *OVARG2* = INPUT FOR PRIME SA1 VARBUF GET WORD TO BE HASHED BX5 X1 NGETVAR BX6 X1 SA6 OVARG1 *OVARG1* = WORD TO BE HASHED X PURDYOV LEVEL 1 OVERLAY SA1 VARBUF+1 RESULT VAR CODE SA2 OVRET1 RESULT FROM PURDYOV BX5 X1 BX6 X2 NPUTVAR STORE RESULT IN USER'7S VARS EQ PROCESS -- EXIT * * OWNHASH BSS 0 SA1 VARBUF+2 GET THIRD ARGUMENT (PRIME) BX5 X1 NGETVAR BX6 X1 AX1 59 SHIFT SIGN BIT THRU ENTIRE WORD BX6 X6-X1 ABSOLUTE VALUE SX1 X6-PWPRIME CHECK FOR RESTRICTED PRIME NZ X1,SETHASH -- NOT THE SAME, ALLOW VALUE SA1 BADPRIME SUBSTITUTE DIFF VALUE BX6 X1 EQ SETHASH -- STORE USER-SPECIFIED PRIME * * THE PRIME MODULUS IS ACTUALLY (2**60 - OVARG2). * THE FOLLOWING DEFINES ARE THE DEFAULTS FOR SYSTEM * AND NON-SYSTEM LESSONS, ACCORDINGLY. * * /--- BLOCK HASHOV 00 000 84/09/23 15.11 SYSPRIME EQU 2RFK SYSTEM LESSONS USRPRIME EQU 2RGE USER LESSONS BADPRIME DATA 377777B IF USER SPECIFIED *PWPRIME* * * ENDOV * /--- BLOCK PURDYOV 00 000 84/09/23 15.35 TITLE PURDY - IRREVERSIBLE ENCIPHERING. ** PURDYOV - APPLY A ONE-WAY HASHING ALGORITHM. * * ENTRY *OVARG1* = WORD TO ENCIPHER. * *OVARG2* = INPUT TO PRIME MODULUS, * ( 2**60 - OVARG2 ). * * EXIT *OVRET1* = ENCIPHERED RESULT. * A5, B5, AND B7 ARE SAVED AND RESTORED. * (X5) = COMMAND WORD. * * NOTES IT IS GUARANTEED THAT BITS 54-59 (THE * FIRST CHARACTER) OF THE RESULT ARE NOT * ALL 0. * * THE FUNCTION EVALUATED IS -- * * Y = [X**(2**19+5) + ACOEFF(1)*X**(2**18+3) * + ACOEFF(2)*X**3 + ACOEFF(3)*X**2 * + ACOEFF(4)*X + ACOEFF(5)] * MOD (2**60 - OVARG2). * * /--- BLOCK PURDYOV 00 000 84/09/23 15.31 PURDYOV OVRLAY * * SAVE REGISTERS. * SX6 A5 SX7 B5 SA6 PDY.SAV SAVE A5 SA7 PDY.SAV+1 SAVE B5 MX0 -30 MASK TO SPLIT INPUT SX6 B7 SA6 PDY.SAV+2 SAVE B7 * * SPLIT INPUT INTO TWO WORDS PRIOR TO *PURDY*. * SA1 OVARG1 (X1) = INPUT BX7 -X0*X1 SA7 PDY.BUF+1 LOWER HALF LX1 0-30 BX6 -X0*X1 SA6 PDY.BUF UPPER HALF * * SET UP PARAMETERS AND CALL *PURDY*. * SB1 A6 (B1) = VALUE TO ENCIPHER SB2 PDY.AC (B2) = COEFFICIENTS SB3 PDY.NM1 (B3) = (N-1) SB4 OVARG2 SPECIFIES PRIME MODULUS RJ PURDY RESULT IN *PDY.BUF* * * PUT THE RESULT TOGETHER. * SA1 PDY.BUF SA2 A1+1 LX1 30 BX6 X1+X2 * * ENSURE THAT THE FIRST CHARACTER IS NONZERO. * BX1 X6 AX1 -6 NZ X1,PDY1 IF NOT 00 NG X1,PDY1 IF NOT 00 MX0 1 BX6 X6+X0 SET TOP BIT PDY1 BSS 0 * * STORE RESULT, RESTORE REGISTERS, AND EXIT. * SA6 OVRET1 SA1 PDY.SAV (X1) = A5 SA2 A1+B1 (X2) = B5 SA3 A2+B1 (X3) = B7 SA5 X1 SB5 X2 SB7 X3 RETURN EXIT * * PARAMETER BUFFERS. * PDY.BUF OVDATA 2 INPUT AND RESULT PDY.AC DATA 7777777777B,7777777641B ACOEFF(1) DATA 7777777777B,7777777603B ACOEFF(2) DATA 7777777777B,7777777573B ACOEFF(3) DATA 7777777777B,7777777636B ACOEFF(4) DATA 7777777777B,7777777402B ACOEFF(5) PDY.NM1 CON 1S18+2 N = 2**18 + 3 PDY.SAV OVDATA 3 A5, B5, B7 * /--- BLOCK PURDY-DOC 00 000 84/09/15 22.11 DOCUMENT TITLE PURDY - IRREVERSIBLE ENCIPHERING. ** PURDY - EVALUATE PURDY-S IRREVERSIBLE ENCIPHERING * FUNCTION, F(X) = P(X) MOD PRIME, WHERE * P(X) IS A POLYNOMIAL OF LARGE DEGREE, AND * PRIME IS A LARGE PRIME NUMBER. * * MARK B. ZVILIUS 84/08/22 * * * IN GENERAL, P(X) HAS THE FORM, * P(X) = SUM(A(I) * X**N(I)), I = 1,2,...,NN. * WHERE THE A(I) ARE ARBITRARY COEFFICIENTS, AND * THE N(I) ARE ARBITRARY POWERS OF X. * * HOWEVER, FOR THE SAKE OF SPEED, THIS ROUTINE ONLY * EVALUATES POLYNOMIALS WITH THE FOLLOWING FORM. * * P(X) = X**(2*N-1) + ACOEFF(1)*X**N + * ACOEFF(2)*X**3 + ACOEFF(3)*X**2 + * ACOEFF(4)*X + ACOEFF(5). * * MULTI-PRECISION INTEGER ARITHMETIC IS USED * THROUGHOUT. THE FOLLOWING PARAMETERS DEFINE THE * MULTI-PRECISION FORMAT. * * NP THE NUMBER OF COMPUTER WORDS THAT MAKE UP * A MULTI-PRECISION NUMBER. *NP* IS AN * ASSEMBLY-TIME CONSTANT BECAUSE IT DEFINES * THE LENGTH OF WORKING BUFFERS. * * M IN EACH WORD OF A MULTI-PRECISION NUMBER * THE LOWER M BITS ARE SIGNIFICANT. SINCE * MULTIPLICATION MUST BE PERFORMED ON TWO * M-BIT NUMBERS, M MUST BE <= 48. M IS AN * ASSEMBLY-TIME CONSTANT, BUT COULD BE AN * EXECUTION-TIME PARAMETER WITH CHANGES TO * *MPMLT* AND *MPADD*. THE COST IS ABOUT * 0.5 MS PER EVALUATION. * * Q TOTAL NUMBER OF BITS IN A MULTI-PRECISION * NUMBER. Q = NP*M. Q IS NOT REFERENCED IN * THE CODE, BUT IS USED IN THE DOCUMENTATION. * * MULTI-PRECISION NUMBERS ARE STORED IN CONSECUTIVE * WORDS WITH THE HIGH-ORDER WORD FIRST. THE UPPER * 60-M BITS OF EACH WORD MUST BE 0. * * THE PRIME MODULUS HAS THE SPECIAL FORM, * PRIME = 2**Q - A * WHERE *A* IS A SINGLE-PRECISION NUMBER. THAT IS, * A < 2**M. * /--- BLOCK PURDY-DOC 00 000 84/09/23 14.56 DOCUMENT EJECT * THE PARAMETERS PASSED TO THIS ROUTINE ARE-- * X MULTI-PRECISION VALUE TO ENCIPHER. * ACOEFF(I) MULTI-PRECISION COEFFICIENTS. I = 1..5 * (N-1) WHERE N SPECIFIES THE FIRST TWO EXPONENTS. * A SINGLE-PRECISION NUMBER SPECIFYING THE * PRIME MODULUS. * * THE ENCIPHERED RESULT IS RETURNED IN THE SAME * BUFFER WHERE X WAS PASSED. * * * ENTRY (B1) = FWA OF NP-WORD X. * (B2) = FWA OF 5 BY NP-WORD ACOEFF(I) IN * ROW-MAJOR ORDER. * (B3) = ADDR OF (N-1). * (B4) = ADDR OF A. * * EXIT F(X) IS RETURNED IN THE BUFFER FOR X. * (B1) = 1. * * ERROR IF ANY OF THE PARAMETERS IS INVALID, F(X) * WILL BE UNPREDICTABLE. * * USES ALL REGISTERS ARE DESTROYED. * * CALLS EXPP, MULTP, ADDP, MPSUB. * * MACROS ZERO, MPSET, CALLL. * * DEFINE (B1) = 1. * * NOTES THIS ROUTINE WAS ADAPTED FROM ALGORITHM 536 * IN THE COLLECTED ALGORITHMS OF THE ACM. * THAT ALGORITHM WAS WRITTEN BY H. D. KNOBLE, * PENN STATE UNIVERSITY COMPUTATION CENTER, * JUNE 1977. * * THE PAPER DESCRIBING ALGORITHM 536 IS * KNOBLE, H. D., FORNEY, C., AND BADER, F. S. * AN EFFICIENT ONE-WAY ENCIPHERING ALGORITHM. * ACM TRANS. MATH. SOFTWARE 5, 1 * (MARCH 1979), 97-107. * * THE ALGORITHM WAS ORIGINALLY PROPOSED IN * PURDY, G. B. * A HIGH SECURITY LOG-IN PROCEDURE. * COMM. ACM 17, 8 (AUGUST 1974), 442-444. * * MULTI-PRECISION ARITHMETIC ROUTINES FROM * KNUTH, D. E. * THE ART OF COMPUTER PROGRAMMING, VOL. 2, * SEMINUMERICAL ALGORITHMS. * ADDISON-WESLEY, READING, MASS., 1969. * * /--- BLOCK PURDY-MAC 00 000 84/09/15 02.53 MACROS EJECT * * EQUATES. * NP EQU 2 WORDS IN MP NUMBERS M EQU 30 BITS PER WORD IN M-P NUMBERS Z= SPACE 4,20 ** Z= - OPDEFS TO SET B-REGISTER. * * Z= BREG,VAL * * ENTRY *BREG* = B-REGISTER TO SET. * *VAL* = A REGISTER TO SET *BREG* TO, OR A * VALUE TO LOAD INTO *BREG*. * (B1) = 1. * * NOTES THE FOLLOWING OPTIMIZATIONS ARE PERFORMED. * * IF *VAL* IS THE SAME REGISTER AS *BREG*, NO * CODE IS GENERATED. * * IF *VAL* IS A CONSTANT, A 15-BIT SET * INSTRUCTION WILL BE GENERATED, IF * POSSIBLE, USING (B1) = 1. * Z=B,Q OPDEF I,VAL * * IF NOT DEFINED YET, CANNOT DO OPTIMIZATION CHECKS. * IF -DEF,VAL,1 ELSE SKIP * IFEQ VAL,0,2 VAL = 0 SB.I B0 DONE SKIP * IFEQ VAL,1,2 VAL = 1 SB.I B1 DONE SKIP * IFEQ VAL,2,2 VAL = 2 SB.I B1+B1 DONE SKIP * IFEQ VAL,-1,2 VAL = -1 SB.I -B1 DONE SKIP * ELSE ENDIF * * VAL = ANYTHING ELSE. * SB.I VAL * DONE ENDIF ENDM Z=B,X OPDEF I,J SB.I X.J ENDM Z=B,A OPDEF I,J SB.I A.J ENDM Z=B,B OPDEF I,J IFC NE,*I*J*,1 SB.I B.J ENDM * /--- BLOCK PURDY-MAC 00 000 78/12/19 00.30 CALLL SPACE 4,15 ** CALLL - CALL LOCAL ROUTINE WITH PARAMETERS. * * CALLL NAME,P1,P2,P3,P4,P5 * * ENTRY *NAME* = NAME OF ROUTINE. * *PI* = OPTIONAL PARAMETERS PASSED IN B- * REGISTERS. P1 IN B2, P2 IN B3, ETC. * * EXIT TO ROUTINE *NAME* WITH PARAMETERS IN * B-REGISTERS. * * USES B - 2, 3, 4, 5, 6. * * MACROS Z=. * CALLL MACRO NAME,P1,P2,P3,P4,P5 MACREF CALLL * PARAMS ECHO ,PI=(P1,P2,P3,P4,P5),N=(2,3,4,5,6) IFC NE,*PI**,1 Z= B.N,PI PARAMS ENDD * RJ NAME CALLL ENDM ZEROL SPACE 4,25 ** ZEROL - ZERO A CM BUFFER (LOCAL TO *EXEC6*) * * ZEROL BUF,LTH * * ENTRY *BUF* = FWA OF BUFFER. * *LTH* = LENGTH OF BUFFER. * (B1) = 1. * * EXIT BUFFER ZEROED. * (A7) = *BUF* + *LTH* - 1 * (X7) = 0. * * USES X - 7. * A - 7. * B - 7. * * MACROS LOAD. * * NOTES IF *NP* IS GREATER THAN ABOUT 5, IT BECOMES * MORE EFFICIENT TO READ ZEROES FROM AN ESM * BUFFER. * ZEROL MACRO BUF,LTH MACREF ZEROL MX7 0 LOAD BUF,LTH ZEROL ENDM LOAD SPACE 4,20 ** LOAD - LOAD EACH WORD OF A CM BUFFER. * * LOAD BUF,LTH * * ENTRY *BUF* = FWA OF BUFFER. * *LTH* = LENGTH OF BUFFER. * (X7) = VALUE TO LOAD INTO EACH WORD. * (B1) = 1. * * EXIT EACH WORD IN *BUF* LOADED WITH VALUE IN X7. * (A7) = *BUF* + *LTH* - 1 * * USES A - 7. * B - 7. * * MACROS Z=. * LOAD MACRO BUF,LTH MACREF LOAD * * ERROR IF *LTH* IS LESS THAN 1 OR MORE THAN 100. * IFLE LTH,0,1 ERR IFGT LTH,100,1 ERR * * LOAD FIRST WORD. * SA7 BUF * * LOAD REMAINING WORDS. * LD1 IFNE LTH,1 * * IF 2 <= *LTH* <= 6 * LD2 IFLE LTH,6 DUP LTH-1,1 SA7 A7+B1 * * IF *LTH* > 6. * LD2 ELSE Z= B7,LTH-1 + SA7 A7+B1 SB7 B7-B1 NZ B7,* LD2 ENDIF LD1 ENDIF LOAD ENDM * /--- BLOCK PURDY-MAC 00 000 84/09/03 20.46 MPSET SPACE 4,20 ** MPSET - COPY ONE M-P NUMBER INTO ANOTHER. * * MPSET TO,FROM,LTH * * ENTRY *TO* = FWA OF DESTINATION BUFFER. * *FROM* = FWA OF SOURCE BUFFER. * *LTH* = NUMBER OF WORDS TO COPY. * (B1) = 1. * * USES X - 1, 7. * A - 1, 7. * B - 7. * * MACROS Z=. * * NOTES SINCE *LTH* IS *NP* FOR MOST CALLS, AND * SINCE *NP* IS SMALL, THIS ROUTINE COPIES * WORD BY WORD INSTEAD OF USING A SCRATCH * ESM BUFFER. * MPSET MACRO TO,FROM,LTH MACREF MPSET * * ERROR IF *LTH* IS LESS THAN 1 OR MORE THAN 100. * IFLE LTH,0,1 ERR IFGT LTH,100,1 ERR * * COPY FIRST WORD. * SA1 FROM BX7 X1 SA7 TO * * COPY REMAINING WORDS. * SET1 IFNE LTH,1 * * IF *LTH* = 2. * SET2 IFEQ LTH,2 SA1 A1+B1 BX7 X1 SA7 A7+B1 * * IF *LTH* > 2. * SET2 ELSE Z= B7,LTH-1 + SA1 A1+B1 BX7 X1 SA7 A7+B1 SB7 B7-B1 NZ B7,*-1 SET2 ENDIF SET1 ENDIF MPSET ENDM * /--- BLOCK PURDY-MAC 00 000 84/09/07 19.09 KOMP SPACE 4,20 ** KOMP - COMPARE TWO M-P NUMBERS. * * KOMP X,Y,N * * ENTRY *X* = FWA OF N-PRECISION NUMBER. * *Y* = FWA OF N-PRECISION NUMBER. * *N* = PRECISION OF INPUTS. * (B1) = 1. * * EXIT (X0) POSITIVE IF X >= Y, NEGATIVE IF X < Y. * * USES X - 0, 1, 2. * A - 1, 2. * B - 7. * * MACROS Z=. * KOMP MACRO X,Y,N LOCAL QUIT5678 MACREF KOMP * * ERROR IF *N* IS LESS THAN 1 OR MORE THAN 100. * IFLE N,0,1 ERR IFGT N,100,1 ERR * * COMPARE HIGH-ORDER WORDS. * SA1 X SA2 Y IX0 X1-X2 * * COMPARE REMAINING WORDS, HIGH-ORDER FIRST. * K1 IFNE N,1 NZ X0,QUIT5678 * * IF *N* = 2. * K2 IFEQ N,2 SA1 A1+B1 SA2 A2+B1 IX0 X1-X2 * * IF *N* > 2. * K2 ELSE Z= B7,N-1 + ZR B7,QUIT5678 SA1 A1+B1 SA2 A2+B1 IX0 X1-X2 SB7 B7-B1 ZR X0,*-1 K2 ENDIF QUIT5678 BSS 0 K1 ENDIF KOMP ENDM * /--- BLOCK PURDY 00 000 78/12/19 00.27 MAIN SPACE 4,25 * * MAIN ROUTINE. * PURDY EQ *+1S17 ENTRY/EXIT * * SAVE ADDRESSES. * SX6 B1 SX7 B2 SA6 PUR.AX SAVE FWA OF X SA7 PUR.AC SAVE FWA OF ACOEFF SX7 B4+ SA7 AA SAVE ADDR OF A * * (X4) = FWA OF X. * (X5) = ADDR OF (N-1). * THESE ARE PRESERVED OVER THE CALL TO *MPSUB*. * SX5 B3+ (X5) = ADDR OF (N-1) BX4 X6 (X4) = FWA OF X SB1 1 CONSTANT 1 * * COMPUTE PRIME = 2**Q - A. * * WORK1 <-- 0. (SINCE *MPSUB* IGNORES THE BORROW IT * IS AS IF WORK1 = 2**Q.) * ZEROL PUR.W1,NP * * WORK2 <-- A. (X7 IS ALREADY 0.) * LOAD PUR.W2,NP-1 SA1 B4 (X1) = A BX7 X1 SA7 A7+1 WORK2(NP) <-- A * * PRIME <-- WORK1-WORK2. * CALLL MPSUB,PUR.W1,PUR.W2,PRIME,NP-1 * /--- BLOCK PURDY 00 000 84/09/15 22.19 * * X**(2*N-1) + K*X**N * FACTORS INTO * ((X**(N-1) + K)*X**(N-1))*X * WHERE K = ACOEFF(1). * * WORK1 <-- X**(N-1) MOD PRIME. * CALLL EXPP,X4,X5,PUR.W1 * * (X4) = FWA OF ACOEFF(J). * PRESERVED OVER CALLS TO *ADDP* AND *MULTP*. * SA4 PUR.AC (X4) = FWA OF ACOEFF(1) * * WORK2 <-- (X**(N-1) + K) MOD PRIME. * CALLL ADDP,PUR.W1,X4,PUR.W2 * * WORK2 <-- (X**(N-1) + K)*X**(N-1) MOD PRIME. * CALLL MULTP,PUR.W2,PUR.W1,PUR.W2 * * WORK1 <-- (X**(N-1) + K)*X**(N-1)*X MOD PRIME. * SA1 PUR.AX (X1) = FWA OF X CALLL MULTP,PUR.W2,X1,PUR.W1 * * B*X**3 + C*X**2 + D*X + E * FACTORS INTO * ((B*X + C)*X + D)*X + E * WHERE B = ACOEFF(2), C = ACOEFF(3), ETC. * * WORK2 <-- ACOEFF(2), I <-- 3, J <-- 3 * REPEAT * WORK2 <-- WORK2 * X * WORK2 <-- WORK2 + ACOEFF(J) * I <-- I-1, J <-- J+1 * UNTIL I=0 * SX4 X4+NP (X4) = FWA OF ACOEFF(2) MPSET PUR.W2,X4,NP WORK2 <-- AC(2) * * (X5) = LOOP COUNT. * PRESERVED OVER CALLS TO *ADDP* AND *MULTP*. * SX5 3 I <-- 3 PURDY1 BSS 0 REPEAT SA1 PUR.AX (X1) = FWA OF X CALLL MULTP,PUR.W2,X1,B2 WORK2 <-- WORK2*X SX4 X4+NP (X4) = FWA OF ACOEFF(J) CALLL ADDP,PUR.W2,X4,B2 WORK2 <-- WORK2+AC(J) SX5 X5-1 I <-- I-1 NZ X5,PURDY1 UNTIL I=0 * * WORK1 HAS THE TWO HIGH-ORDER TERMS. WORK2 HAS THE * LOW-ORDER TERMS. ADD TOGETHER AND STORE OVER X. * SA1 PUR.AX (X1) = FWA OF X CALLL ADDP,PUR.W1,PUR.W2,X1 * * DONE. * EQ PURDY EXIT * * DATA DEFINITIONS. * PUR.AX OVDATA ADDR OF X PUR.AC OVDATA ADDR OF ACOEFF AA OVDATA ADDR OF A. USED GLOBALLY. PUR.W1 OVDATA NP M-P SCRATCH BUFFER PUR.W2 OVDATA NP M-P SCRATCH BUFFER * * USED IN CONJUNCTION WITH *PRIME*, *XPRIME* IS * AN (N+1)-WORD BUFFER WHOSE VALUE IS THE MODULUS. * ROUTINE MOD2Q REQUIRES THIS. * XPRIME DATA 0 PRIME BSS NP PRIME MODULUS. USED GLOBALLY. * /--- BLOCK EXPP 00 000 78/12/19 00.28 EXPP SPACE 4,25 ** EXPP - COMPUTE Y = X**K MOD PRIME. X AND Y ARE * M-P NUMBERS. K IS A ONE-WORD EXPONENT. * SEE KNUTH, ALGORITHM 4.6.3 A. * * ENTRY (B2) = FWA OF NP-WORD X. * (B3) = ADDR OF K. * (B4) = FWA OF NP-WORD Y. * *PRIME* = NP-WORD MODULUS. * *AA* = ADDR OF A. A = 2**Q MOD PRIME. * (B1) = 1. * * USES X - 0, 1, 4, 5, 7. * A - 1, 4, 7. * B - 2, 3, 4, 7. * * CALLS MULTP. * * MACROS MPSET, ZEROL, CALLL. * * DEFINE (X4) = K; THE EXPONENT. * (X5) = FWA OF Y. * BOTH ARE PRESERVED OVER *MULTP*. * EXPP EQ *+1S17 ENTRY/EXIT * * FORM SQUARES OF X IN SCRATCH BUFFER Z. Z <-- X. * MPSET EXP.Z,B2,NP * * INITIALIZE RESULT. Y <-- 1. * ZEROL B4,NP-1 SX7 B1 SA7 A7+1 Y(NP) <-- 1 * * MAIN LOOP. * SA4 B3 (X4) = K SX5 B4 (X5) = FWA OF Y ZR X4,EXPP IF ZERO EXPONENT EXP1 MX0 -1 BX1 -X0*X4 (X1) = BIT OF EXPONENT BX4 X0*X4 CLEAR IT LX4 -1 POSITION NEXT BIT * * IF BIT = 1 * Y <-- Y*Z MOD PRIME * EXIT IF K=0 * ENDIF * ZR X1,EXP2 IF BIT = 0 SB3 EXP.Z CALLL MULTP,X5,B3,X5 ZR X4,EXPP IF NO MORE BITS IN EXPONENT * * CONTINUE SQUARING Z. * EXP2 CALLL MULTP,EXP.Z,EXP.Z,EXP.Z EQ EXP1 CONTINUE LOOPING * * DATA DEFINITIONS * EXP.Z OVDATA NP M-P BUFFER TO FORM SQUARES OF X * /--- BLOCK MULTP/ADDP 00 000 84/09/15 22.22 MULTP SPACE 4,20 ** MULTP - COMPUTE RS = R*S MOD PRIME. RS, R, AND S * ARE M-P NUMBERS. * * ENTRY (B2) = FWA OF NP-WORD R. * (B3) = FWA OF NP-WORD S. * (B4) = FWA OF NP-WORD RS. * *PRIME* = NP-WORD MODULUS. * *AA* = ADDR OF A. A = 2**Q MOD PRIME. * (B1) = 1. * * USES A - 0. * B - 2, 3, 4. * * CALLS MPMLT, MOD2Q. * * MACROS CALLL. * MULTP EQ *+1S17 ENTRY/EXIT SA0 B4+ SAVE FWA OF RS OVER CALL * * WORK <-- R*S. WORK IS 2*NP-PRECISION. * CALLL MPMLT,B2,B3,MUL.WK * * RS <-- WORK MOD PRIME. * CALLL MOD2Q,MUL.WK,A0 EQ MULTP EXIT * * DATA DEFINITIONS. * MUL.WK OVDATA NP+NP MULTIPLICATION RESULT ADDP SPACE 4,20 ** ADDP - COMPUTE RPS = R+S MOD PRIME. RPS, R, AND S * ARE M-P NUMBERS. * * ENTRY (B2) = FWA OF NP-WORD R. * (B3) = FWA OF NP-WORD S. * (B4) = FWA OF NP-WORD RPS. * *PRIME* = NP-WORD MODULUS. * *AA* = ADDR OF A. A = 2**Q MOD PRIME. * (B1) = 1. * * USES A - 0. * B - 2, 3, 4. * * CALLS MPADD, MODQ1. * * MACROS CALLL. * ADDP EQ *+1S17 ENTRY/EXIT SA0 B4+ SAVE FWA OF RPS OVER CALL * * WORK <-- R+S. WORK IS NP+1-PRECISION. * CALLL MPADD,B2,B3,ADD.WK * * RPS <-- WORK MOD PRIME. * CALLL MODQ1,ADD.WK,A0 EQ ADDP EXIT * * DATA DEFINITIONS. * ADD.WK OVDATA NP+1 ADDITION RESULT * /--- BLOCK MOD2Q 00 000 84/09/15 22.23 MOD2Q SPACE 4,20 ** MOD2Q - COMPUTE R = W MOD PRIME, FOR 2Q-BIT W. * * ENTRY (B2) = FWA OF 2*NP-WORD W. * (B3) = FWA OF NP-WORD R. * *PRIME* = NP-WORD MODULUS. * *AA* = ADDR OF A. A = 2**Q MOD PRIME. * (B1) = 1. * * USES X - 0, 1, 2, 6. * A - 0, 1, 2, 6. * B - 2, 3, 4, 5, 6, 7. * * CALLS MPML, MPSUB, ADDP. * * MACROS CALLL, KOMP. * * DEFINE (A0) = FWA OF W0. * (B6) = FWA OF R. * BOTH ARE PRESERVED OVER *MPML* AND *MPSUB*. * MOD2Q EQ *+1S17 ENTRY/EXIT * * SAVE ADDRESSES. * SA0 B2+NP (A0) = FWA OF W0 SB6 B3+ (B6) = FWA OF R * * LET W = W0 + W1*2**Q. FORM U = A*W1. * SA1 AA (X1) = ADDR OF A CALLL MPML,B2,X1,M2Q.U * * USE KNUTH-S THEOREM 4.3.1 B AND LEADING DIGIT * THEOREM TO SOLVE FOR J SUCH THAT, * J*PRIME <= U < (J+1)*PRIME. * * U(1) UNDERESTIMATES J BY AT MOST 1. * SA1 M2Q.U (X1) = U(1) MX6 -1 IX6 X1-X6 SA6 M2Q.J J <-- U(1)+1 * * JP <-- J*PRIME. * CALLL MPML,PRIME,M2Q.J,M2Q.JP * * COMPARE U AND J*PRIME. RESULT IN X0. * KOMP M2Q.U,M2Q.JP,NP+1 PL X0,M2Q1 IF U >= J*PRIME * * IF U < J*PRIME, THEN J <-- J-1 AND JP <-- J*PRIME. * IN OTHER WORDS, JP <-- JP - PRIME. * CALLL MPSUB,M2Q.JP,XPRIME,M2Q.JP,NP M2Q1 BSS 0 * * R <-- U - J*PRIME. THAT IS, R = A*W1 MOD PRIME. * CALLL MPSUB,M2Q.U+1,M2Q.JP+1,B6,NP-1 * * HAVE R = A*W1 MOD PRIME. * WANT R = (W0 + (A*W1 MOD PRIME)) MOD PRIME. * NOTE THAT (B6) = (B4) = FWA OF R. * CALLL ADDP,A0,B6,B4 EQ MOD2Q EXIT * * DATA DEFINITIONS. * M2Q.U OVDATA NP+1 U = A*W1 M2Q.J OVDATA J M2Q.JP OVDATA NP+1 JP = J*PRIME * /--- BLOCK MODQ1 00 000 78/12/19 00.28 MODQ1 SPACE 4,20 ** MODQ1 - COMPUTE Y = S MOD PRIME, FOR (Q+1)-BIT S. * * ENTRY (B2) = FWA OF (NP+1)-WORD S. * (B3) = FWA OF NP-WORD Y. * *PRIME* = NP-WORD MODULUS. * *AA* = ADDR OF A. A = 2**Q MOD PRIME. * (B1) = 1. * * USES X - 1, 3, 7. * A - 1, 7. * B - 2, 3, 4, 6, 7. * * CALLS MODQ, MPADD. * * MACROS CALLL. * * DEFINE (X3) = S1; HIGH-ORDER WORD OF S. * (B6) = FWA OF Y. * BOTH ARE PRESERVED OVER *MODQ* AND *MPADD*. * MODQ1 EQ *+1S17 ENTRY/EXIT SA1 B2 BX3 X1 (X3) = HIGH-ORDER WORD OF S SB6 B3 (B6) = FWA OF Y * * LET S = S0 + S1*2**Q. THEN S1 IS EITHER 0 OR 1. * * Y <-- S0 MOD PRIME. * SB2 B2+B1 (B2) = FWA OF S0 CALLL MODQ,B2,B3 * * IF S1=0, THEN DONE. * ZR X3,MODQ1 EXIT SB3 MQ1.WK (B3) = FWA OF WORK * * HAVE Y = S0 MOD PRIME. * WANT Y = ((S0 MOD PRIME) + A) MOD PRIME. * ZEROL B3,NP-1 SA1 AA (X1) = ADDR OF A SA1 X1 (X1) = A BX7 X1 SA7 A7+B1 WORK(NP) <-- A CALLL MPADD,B6,B3,B3 WORK <-- Y + WORK * * WORK(1), THE HIGH-ORDER WORD, IS GUARANTEED ZERO. * SB2 B3+B1 (B2) = ADDR OF WORK(2) CALLL MODQ,B2,B6 EQ MODQ1 EXIT * * DATA DEFINITIONS. * MQ1.WK OVDATA NP+1 (NP+1)-PRECISION SCRATCH BUFFER * /--- BLOCK MODQ 00 000 84/09/08 23.11 MODQ SPACE 4,15 ** MODQ - COMPUTE Y = X MOD PRIME FOR Q-BIT X. * * ENTRY (B2) = FWA OF NP-WORD X. * (B3) = FWA OF NP-WORD Y. * *PRIME* = NP-WORD MODULUS. * (B1) = 1. * * USES X - 0, 1, 2, 7. * A - 1, 2, 7. * B - 3, 4, 5, 7. * * CALLS MPSUB. * * MACROS KOMP, MPSET, CALLL. * MOD1 BSS 0 * * X >= PRIME, THEREFORE Y = X - PRIME. * SB4 B3 (B4) = FWA OF Y CALLL MPSUB,B2,PRIME,B4,NP-1 MODQ EQ *+1S17 ENTRY/EXIT KOMP B2,PRIME,NP PL X0,MOD1 IF X >= PRIME * * X < PRIME, THEREFORE Y = X. * MPSET B3,B2,NP EQ MODQ EXIT * /--- BLOCK MPMLT 00 000 78/12/19 00.28 MPMLT SPACE 4,30 ** MPMLT - UNSIGNED, MULTI-PRECISION INTEGER * MULTIPLICATION. W = U*V. U AND V ARE * NP-PRECISION; W IS 2*NP-PRECISION. * * ENTRY (B2) = FWA OF NP-WORD U. * (B3) = FWA OF NP-WORD V. * (B4) = FWA OF 2*NP-WORD W. * (B1) = 1. * * USES X - 0, 1, 2, 3, 6, 7. * A - 1, 2, 6, 7. * B - 2, 3, 4, 5, 6, 7. * * MACROS ZERO1. * * DEFINE (B2) = FWA OF U. * (B3) = FWA OF V. * (B4) = FWA OF W. * (B5) = I; INDEX INTO U. * (B6) = J; INDEX INTO V. * (X3) = MASK TO SPLIT UP RESULT. * (X6) = K; CARRY. * (X7) = VALUE TO STORE BACK TO W(I+J). * * NOTES IF *NP* IS 4 OR MORE, IT BECOMES WORTHWHILE * TO PACK EACH WORD OF U AND V INTO FLOATING * POINT FORMAT BEFORE STARTING THE MAIN LOOP. * OF COURSE THIS REQUIRES 2, NP-WORD SCRATCH * BUFFERS. * MPMLT EQ *+1S17 ENTRY/EXIT * * BEGIN KNUTH-S ALGORITHM 4.3.1 M. * * (1) INITIALIZE. * ZEROL B4+NP,NP ZERO LOW HALF OF RESULT MX3 60-M SET UP MASK FOR LATER * * DECREMENT THE BUFFER ADDRESSES SO THE INDICES * CAN RUN FROM NP --> 1. * SB2 B2-B1 U SB3 B3-1 V SB4 B4-1 W SB6 NP J <-- NP * * (2) PROBABILITY OF V(J)=0 IS SMALL; SKIP STEP 2. * * (3) INITIALIZE I. * MLT1 BSS 0 REPEAT SB5 NP I <-- NP SX6 0 K <-- 0 * /--- BLOCK MPMLT 00 000 84/09/03 19.33 * * (4) MULTIPLY AND ADD. * COMPUTE T <-- U(I)*V(J) + W(I+J) + K. * T IS GUARANTEED TO BE LESS THAN 2**(2*M). * MLT2 BSS 0 REPEAT SA1 B2+B5 (X1) = U(I) SA2 B3+B6 (X2) = V(J) PX1 X1 PX2 X2 FX0 X1*X2 (X0) = HIGH 48 BITS OF UI*VJ DX7 X1*X2 (X7) = LOW 48 BITS OF UI*VJ * * IN ONE UNLIKELY CASE, AN AUTOMATIC NORMALIZE IS * DONE. OTHERWISE, NO SHIFTS ARE NECESSARY. * UX0 X0 UX7,B7 X7 (B7) = -1 IF SHIFT NEEDED ZR B7,MLT0 IF NO SHIFT NEEDED LX0 -1 UN-DO NORMALIZING SHIFT LX7 -1 UN-DO NORMALIZING SHIFT * * SHIFT LOW BIT OUT OF (X0) INTO HIGH BIT OF (X7). * MX2 1 BX2 X2*X0 PICK OFF BIT 59 (WAS BIT 0) BX0 -X2*X0 CLEAR IT IN HIGH-ORDER WORD LX2 47-59 POSITION TO BIT 47 BX7 X7+X2 MERGE INTO THE LOW-ORDER WORD MLT0 BSS 0 * * ADD IN W(I+J) AND K. NO OVERFLOW IS POSSIBLE. * SB7 B5+B6 (B7) = I+J SA1 B4+B7 (X1) = W(I+J) IX1 X1+X6 (X1) = W(I+J) + K IX6 X7+X1 (X6) = W(I+J)+K+(LOW ORDER WD) BX7 -X3*X6 (X7) = LOWER M BITS OF T SA7 A1 W(I+J) <-- LOWER HALF OF T AX6 M-0 CHOP OFF LOWER M BITS * * NOW X6 HAS THE LOWER (48-M) SIGNIFICANT BITS OF * THE UPPER HALF OF T. IT ALSO HAS CARRY BITS TO * ADD INTO THE OTHER (2*M-48) BITS WHICH ARE IN X0. * LX0 48-M POSITION UPPER (2*M-48) BITS IX6 X0+X6 (X6) = K = UPPER HALF OF T * * (5) LOOP ON I. * SB5 B5-B1 I <-- I-1 NZ B5,MLT2 UNTIL I=0 SA6 B4+B6 W(J) <-- K * * (6) LOOP ON J. * SB6 B6-B1 J <-- J-1 NZ B6,MLT1 UNTIL J=0 EQ MPMLT EXIT * /--- BLOCK MPML 00 000 84/09/08 23.11 MPML SPACE 4,30 ** MPML - UNSIGNED, MULTI-PRECISION INTEGER * MULTIPLICATION FOR THE SPECIAL CASE WHERE * ONE OPERAND IS SINGLE-PRECISION. * W <-- S*U, WHERE U IS NP-PRECISION; S IS * SINGLE PRECISION; W IS (NP+1)-PRECISION. * * ENTRY (B2) = FWA OF NP-WORD U. * (B3) = ADDR OF S. * (B4) = FWA OF (NP+1)-WORD W. * (B1) = 1. * * USES X - 0, 1, 2, 3, 6, 7. * A - 1, 2, 6, 7. * B - 2, 5, 7. * * DEFINE (B2) = FWA OF U. * (X1) = S. * (B4) = FWA OF W. * (B5) = I; INDEX INTO U. * (X3) = MASK TO SPLIT UP RESULT. * (X6) = K; CARRY. * (X7) = VALUE TO STORE BACK TO W(I+1). * * NOTES THIS IS DERIVED FROM KNUTH-S ALGORITHM * 4.3.1 M FOR THE SPECIAL CASE OF A SINGLE- * PRECISION MULTIPLIER. SEE KNUTH-S PROBLEM * 4.3.1-13. * * /--- BLOCK MPML 00 000 84/09/08 23.08 MPML EQ *+1S17 ENTRY/EXIT * * DECREMENT FWA OF U SO THAT I RUNS FROM NP --> 1. * BUT LEAVE FWA OF W ALONE, THUS TAKING CARE OF THE * OFFSET OF 1 IN W(I+1). * SB2 B2-B1 MX3 60-M SET UP MASK FOR LATER SA1 B3 (X1) = S PX1 X1 FLOATING POINT FORMAT * * (3) INITIALIZE I. * SB5 NP I <-- NP SX6 0 K <-- 0 * * (4) MULTIPLY AND ADD. COMPUTE T <-- U(I)*S + K. * ML1 BSS 0 REPEAT SA2 B2+B5 (X2) = U(I) PX2 X2 FLOATING POINT FORMAT FX0 X1*X2 (X0) = HIGH 48 BITS OF UI*VJ DX7 X1*X2 (X7) = LOW 48 BITS OF UI*VJ * * IN ONE UNLIKELY CASE, AN AUTOMATIC NORMALIZE IS * DONE. OTHERWISE, NO SHIFTS ARE NECESSARY. * UX0 X0 UX7,B7 X7 (B7) = -1 IF SHIFT NEEDED ZR B7,ML0 IF NO SHIFT NEEDED LX0 -1 UN-DO NORMALIZING SHIFT LX7 -1 UN-DO NORMALIZING SHIFT * * SHIFT LOW BIT OUT OF (X0) INTO HIGH BIT OF (X7). * MX2 1 BX2 X2*X0 PICK OFF BIT 59 (WAS BIT 0) BX0 -X2*X0 CLEAR IT IN HIGH-ORDER WORD LX2 47-59 POSITION TO BIT 47 BX7 X7+X2 MERGE INTO THE LOW-ORDER WORD ML0 BSS 0 * * ADD IN K. NO OVERFLOW IS POSSIBLE. * IX6 X6+X7 (X6) = K + (LOW ORDER WORD) BX7 -X3*X6 (X7) = LOWER M BITS OF T SA7 B4+B5 W(I+1) <-- LOWER HALF OF T AX6 M-0 CHOP OFF LOWER M BITS * * NOW X6 HAS THE LOWER (48-M) SIGNIFICANT BITS OF * THE UPPER HALF OF T. IT ALSO HAS CARRY BITS TO * ADD INTO THE OTHER (2*M-48) BITS WHICH ARE IN X0. * LX0 48-M POSITION UPPER (2*M-48) BITS IX6 X0+X6 (X6) = K = UPPER HALF OF T * * (5) LOOP ON I. * SB5 B5-1 I <-- I-1 NZ B5,ML1 UNTIL I=0 SA6 B4+ W(1) <-- K EQ MPML EXIT * /--- BLOCK MPADD 00 000 84/09/09 00.54 MPADD SPACE 4,25 ** MPADD - UNSIGNED, NP-PRECISION INTEGER ADDITION. * W = U+V. U AND V ARE NP-PRECISION; W IS * (NP+1)-PRECISION. * * ENTRY (B2) = FWA OF NP-WORD U. * (B3) = FWA OF NP-WORD V. * (B4) = FWA OF (NP+1)-WORD W. * (B1) = 1. * * USES X - 0, 1, 2, 6, 7. * A - 1, 2, 6, 7. * B - 4, 5. * * DEFINE (B2) = FWA OF U. * (B3) = FWA OF V. * (B4) = 1 + (FWA OF W). * (B5) = J; INDEX INTO BUFFERS. * (X0) = MASK FOR CARRY. * (X6) = K; CARRY. * (X7) = W(J+1); BYTE ADDITION RESULT. * MPADD EQ *+1S17 ENTRY/EXIT * * INCREMENT FWA OF W TO ACCOUNT FOR THE OFFSET OF 1 * IN W(J+1). J RUNS FROM (NP-1) --> 0, ALTHOUGH THE * DOCUMENTATION IS AS IF IT RUNS FROM NP --> 1. * SB4 B4+1 * * BEGIN KNUTH-S ALGORITHM 4.3.1 A. * * (1) INITIALIZE. * SB5 NP-1 J <-- NP MX6 0 K <-- 0 MX0 60-M MASK FOR CARRY * * (2) ADD DIGITS. W(J+1) <-- (U(J)+V(J)+K) MOD 2**M. * MPA1 BSS 0 REPEAT SA1 B2+B5 (X1) = U(J) SA2 B3+B5 (X2) = V(J) IX1 X1+X2 (X1) = U(J)+V(J) IX6 X1+X6 (X6) = U(J)+V(J)+K BX7 -X0*X6 MASK OFF CARRY SA7 B4+B5 W(J+1) <-- U(J)+V(J)+K MOD 2**M AX6 M-0 (X6) = CARRY = K * * (3) LOOP ON J. * SB5 B5-B1 J <-- J-1 PL B5,MPA1 UNTIL J=0 SA6 B4-1 W(1) <-- K EQ MPADD EXIT * /--- BLOCK MPSUB 00 000 84/09/09 00.54 MPSUB SPACE 4,25 ** MPSUB - UNSIGNED, N-PRECISION INTEGER SUBTRACTION, * W = U-V, IGNORING POSSIBLE BORROW IF U