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<V.
* U, V, AND W ARE ALL N-PRECISION INTEGERS.
*
* ENTRY (B2) = FWA OF N-WORD U.
* (B3) = FWA OF N-WORD V.
* (B4) = FWA OF N-WORD W.
* (B5) = (N-1), WHERE N = OPERAND PRECISION.
* (B1) = 1.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 2, 7.
* B - 5.
*
* DEFINE (B2) = FWA OF U.
* (B3) = FWA OF V.
* (B4) = FWA OF W.
* (B5) = J; INDEX INTO BUFFERS.
* (X0) = MASK FOR BORROW.
* (X6) = K; BORROW.
* (X7) = W(J); BYTE SUBTRACTION RESULT.
*
MPSUB EQ *+1S17 ENTRY/EXIT
*
* J RUNS FROM (N-1)..0, ALTHOUGH THE DOCUMENTATION
* IS AS IF IT RUNS FROM N..1.
*
* BEGIN KNUTH-S ALGORITHM 4.3.1 A.
*
* (1) INITIALIZE.
*
SX6 1 K <-- 1
MX0 60-M MASK FOR BORROW
BX0 -X0 MASK OFF BORROW
*
* (2) SUBTRACT DIGITS. W(J) <-- (U(J)-V(J)+K) MOD 2**M.
*
MPS1 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
IX6 X6+X0 TO AVOID 1-S COMPLEMENT
BX7 X0*X6 MASK OFF BORROW
SA7 B4+B5 W(J) <-- U(J)-V(J)+K MOD 2**M
AX6 M-0 (X6) = BORROW = K
*
* (3) LOOP ON J.
*
SB5 B5-1 J <-- J-1
PL B5,MPS1 UNTIL J=0
EQ MPSUB EXIT
* /--- BLOCK PURDYOV 00 000 84/09/15 22.34
ENDOV
* /--- BLOCK END 00 000 81/08/20 23.07
*
*
OVTABLE
*
*
END EXEC6$