DATAX
* /--- FILE TYPE = E
* /--- BLOCK IDENT 00 000 79/08/25 16.46
IDENT DATAX
TITLE STUDENT DATA ROUTINES
TITLE COMMENTS
*
CST
*
EXT ECSPRTY,NKLIST,NKLEND,RETPRO
EXT PROCESS,PROC,ERXBADL,RETRNX,CKPROC
EXT RETPROC
EXT ERXBREC ERROR EXIT, -EXEC2-
EXT ERXOPEN
*
*
* /--- BLOCK COMMENTS 00 000 80/02/03 05.17
TITLE COMMENTS
*
*
* FORMAT OF ECS DATA BUFFER
*
* FIRST *DPRMLTH* WORDS ARE BUFFER PARAMETERS
* *DATSTAT* = BUFFER STATUS BITS
* *DINITSH* = FILE INITIALIZATION BIT
* *DWRITSH* = FILE WRITE IN PROCESS BIT
* *DFULLSH* = DATA FILE FULL BIT
* *DERRSH* = ERROR BIT
* BOTTOM 18 BITS = STATION NUMBER WHICH LAST SET
* THE INITIALIZATION, WRITE, OR
* ERROR BITS.
* *DFACCT* = DATA FILE ACCOUNT NAME
* *DFILNAM* = DATA FILE NAME
* *DFINF* = FILE INFO WORD
* *DDISKU* = DISK UNIT NUMBER
* *DATBLOK* = CURRENT BLOCK NUMBER
* *DATWORD* = CURRENT WORD POSITION
*
* NEXT *BLKLTH* WORDS = FILE DIRECTORY BLOCK
* NEXT *BLKLTH* WORDS = CURRENT DATA BLOCK
* NEXT *BLKLTH* WORDS = DISK I/O BUFFER
* NEXT *RJLTH* WORDS = RJ TRAIL SAVE AREA
*
*
*
* FORMAT OF DATA READ (-READSET-) BUFFER
*
* FIRST *RPRMLTH* WORDS ARE BUFFER PARAMETERS
* *RFACCT* = DATA FILE ACCOUNT NAME
* *RFNAME* = DATA FILE NAME
* *RFINF* = DATA FILE INFO WORD
* *RDISKU* = DATA FILE DISK UNIT NUMBER
* *RBLKLIM* = MAXIMUM LEGAL BLOCK NUMBER
* *RBLOKN* = CURRENT BLOCK NUMBER
* *RWORD* = CURRENT WORD POINTER
*
* NEXT *BLKLTH* WORDS = CURRENT DATA BLOCK
* NEXT *BLKLTH* WORDS = NEXT DATA BLOCK
*
*
* /--- BLOCK DEFINITION 00 000 80/02/03 05.16
TITLE DEFINITIONS
*
* READSET BUFFER DEFINITIONS - CHANGE IN EXEC6 ALSO
*
RPARAMS EQU 0
RFACCT EQU RPARAMS -READSET- FILE ACCOUNT NAME
RFNAME EQU RFACCT+1 FILE NAME
RFINF EQU RFNAME+1 FILE INFO WORD
RDISKU EQU RFINF+1 DISK UNIT NUMBER
RBLKLIM EQU RDISKU+1 MAXIMUM BLOCK NUMBER
RBLOKN EQU RBLKLIM+1 CURRENT BLOCK NUMBER
RWORD EQU RBLOKN+1 CURRENT WORD POINTER
RPRMLTH EQU RWORD+1
*
RBLK1 EQU RPARAMS+RPRMLTH
RBLK2 EQU RBLK1+BLKLTH
*
RBUFLTH EQU RBLK2+BLKLTH
*
* /--- BLOCK DEFINITION 00 000 79/07/15 21.30
*
*
PURGMAC DISKI
DISKI MACRO ADD,UNIT,BLOCK,ECS,N
LOCAL AA,DD,XX
IFC EQ,*N**,1
DD SET =1
IFC NE,*N**,1
DD SET N
CALL DISKXJ,ADD,UNIT,BLOCK,=1,ECS,DD
NZ X6,XX
AA TUTIM -1,,IOKEY
CALL POSTXJ,XX,AA,XX
XX BSS 0
ENDM
*
*
PURGMAC DISKO
DISKO MACRO ADD,UNIT,BLOCK,ECS,N
LOCAL AA,XX
CALL DISKXJ,ADD,UNIT,BLOCK,=2,ECS,=1
NZ X6,XX
AA TUTIM -1,,IOKEY
CALL POSTXJ,XX,AA,XX
XX BSS 0
ENDM
*
*
* /--- BLOCK INITDAT 00 000 80/06/30 23.52
TITLE -INITDAT- INITIALIZE FOR DATA COLLECTION
*
*
*
* -INITDAT-
* INITIALIZE DATA COLLECTION FOR THIS STUDENT
*
* ON ENTRY - B1 = ADDRESS OF DATA FILE ACCOUNT NAME
* B2 = ADDRESS OF DATA FILE NAME
*
* USES TBINTSV(1), TBINTSV(2)
*
*
ENTRY INITDAT
INITDAT EQ *
SA1 TBLDATA CHECK ALREADY COLLECTING DATA
SX1 X1
NZ X1,INITDAT EXIT IF DATA ACTIVE
SA1 B2 LOAD DATA FILE NAME
ZR X1,INITDAT EXIT IF NO DATA FILE
BX6 X1
SA6 TBINTSV+3 SAVE DATA FILE NAME
SA1 B1 LOAD ACCOUNT NAME
BX6 X1
SA6 TBINTSV+2
SA1 INITDAT
BX6 X1 SAVE EXIT JUMP
SA6 TBINTSV+1
X INIDOV CALL OVERLAY
*
*
* /--- BLOCK DATAFIN 00 000 78/06/24 22.04
TITLE -DATAFIN- TERMINATE DATA COLLECTION
*
*
*
* -DATAFIN-
* END DATA COLLECTION FOR THIS STUDENT AND CLOSE
* DATA FILE IF NO ONE ELSE IS USING DATA FILE
*
*
ENTRY DATAFIN
DATAFIN EQ *
LINK DATAFIN
SA1 TBLDATA CHECK IF ANY DATA FILE
SX1 X1
ZR X1,DATAFIN EXIT IF NO DATA COLLECTION
X FINDOV CALL OVERLAY
*
*
* /--- BLOCK DATAOUT 00 000 78/11/12 21.21
TITLE -DATAOUT- OUTPUT TO ECS DATA BUFFER
*
*
*
* -DATAOUT- OUTPUT STUDENT DATA RECORD
*
* ON ENTRY - B1 = ADDRESS OF DATA RECORD
* B2 = LENGTH OF DATA RECORD
*
* USES TBINTSV(0) - TBINTSV(3)
*
*
ENTRY DATAOUT
DATAOUT EQ *
LINK DATAOUT
SX6 3 INITIALIZE FILE COUNTER
SA6 TBINTSV+3
*
* OUTPUT DATA RECORD TO ECS CURRENT BLOCK BUFFER
*
ENTRY DATAO
DATAO SA1 TBLDATA CHECK IF DATA COLLECTION ACTIVE
SX1 X1 PICK OFF DATA BUFFER LESSON NUM
ZR X1,DAT990
ZR B2,DAT990 EXIT IF NO DATA TO OUTPUT
SB3 DATAMAX
LT B3,B2,DAT990 EXIT IF TOO MUCH DATA
SX6 B1 SAVE ADDRESS OF DATA
SA6 DARG1
SX6 B2 SAVE LENGTH OF DATA
SA6 DARG2
INTLOK X,I.DAT,W INTERLOCK
SA1 TBLDATA GET BUFFER LESSON NUMBER
SX1 X1
CALL READLES,DATINF,(LPRMLTH+DPRMLTH)
* /--- BLOCK DATAOUT 00 000 77/10/20 01.17
SA1 INF+DATSTAT LOAD STATUS WORD
BX2 X1
LX1 DFULLSH CHECK IF DATA FILE FULL
NG X1,DATNXT
LX2 DERRSH CHECK IF DISK ERROR OCCURRED
NG X2,DAT990
SX1 LPRMLTH LENGTH OF HEADER RECORD
IX4 X0+X1 X4 = ECS ADDRESS OF DATA INFO
SA1 INF+DATWORD LOAD POINTER TO NEXT WORD
SA2 DARG2
SB1 X2 B1 = LENGTH OF DATA RECORD
IX6 X1+X2 COMPUTE ENDING WORD
SX3 BLKLTH LENGTH OF CURRENT BLOCK BUFFER
IX3 X6-X3 CHECK IF ROOM IN BLOCK
PL X3,DDISK JUMP TO SEND BLOCK TO DISK
SA6 A1 UPDATE CURRENT WORD POINTER
BX3 X6 SAVE A COPY OF *X6*
SX6 DATWORD BIAS TO WORD POINTER
IX0 X4+X6 ECS ADDRESS OF WORD POINTER
WX3 X0 (-WXX- 1 WD READ, MAY CHG *A6*)
SX1 X1+DBLK1 BIAS TO NEXT WORD
IX0 X1+X4
SA3 DARG1 ADDRESS OF DATA TO OUTPUT
SA0 X3
+ WE B1 WRITE OUT DATA RECORD
RJ ECSPRTY
* /--- BLOCK DATAOUT 00 000 77/10/20 01.18
*
* CHECK IF SHOULD PROCEED TO NEXT DATA FILE
*
SA1 INF+DATBLOK LOAD CURRENT BLOCK NUMBER
SA2 INF+DATBLIM LOAD MAXIMUM BLOCK NUMBER
IX2 X1-X2
NG X2,DAT990 EXIT IF NOT LAST BLOCK
*
SX1 DDIRECT+4+O.NFNAM OFFSET TO NEXT FILE NAME
IX0 X4+X1 CHECK IF ANY NEXT DATA FILE
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
ZR X1,DAT990 EXIT IF NONE
MX6 0
SA6 DARG2 SET RECORD LENGTH = 0
SB1 B0
EQ DDISK RETURN LAST BLOCK TO DISK
* /--- BLOCK DATAOUT 00 000 78/11/14 21.16
TITLE -DATAOUT- OUTPUT TO DATA FILE
*
*
*
* CALL OVERLAY TO WRITE DATA BLOCK TO DISK
*
DDISK MX6 0 SET INITIAL ENTRY TO OVERLAY
SA6 OVARG1
SX6 B1 SET LENGTH OF DATA RECORD
SA6 OVARG2
X DATOOV EXECUTE OVERLAY
*
ENTRY DATAOA
DATAOA CALL DATAFIN EXIT FROM CURRENT DATA FILE
SA1 TBINTSV+1 GET ONE-WORD FILE NAME
BX6 X1
SA6 TBINTSV+3 MOVE TO TWO-WORD BUFFER
CALL FEXPAND,TBINTSV+2 CONVERT TO TWO-WORD NAME
CALL INITDAT,TBINTSV+2,TBINTSV+3
SX6 2
SA6 OVARG1 SET TO RE-ENTER OVERLAY
X DATOOV
*
*
* CALL OVERLAY TO ADVANCE TO NEXT DATA-FILE
*
DATNXT SX6 1 SET TO ADVANCE TO NEXT FILE
SA6 OVARG1
X DATOOV
*
*
DAT990 INTCLR X,I.DAT RELEASE INTERLOCK
EQ DATAOUT
*
LINK 0
*
*
* /--- BLOCK DATDATE 00 000 75/11/21 03.40
TITLE -DATDATE- FORM DATE/TIME FOR DIRECTORY
*
*
*
* -DATDATE-
* FORM DATE/TIME WORD FOR DATA FILE BLOCK DIRECTORY
* RETURNS *ITEMP* = DATE AND TIME (MMDDYYHHMM)
*
*
ENTRY DATDATE
DATDATE EQ *
CALL S=TDATE,ITEMP
MX0 12 FORM TWO CHARACTER MASK
SA1 ITEMP+1 LOAD WORD CONTAINING DATE
LX1 6
BX6 X0*X1 MASK OFF MONTH
LX0 60-12 POSITION MASK FOR DAY
LX1 6
BX2 X0*X1 MASK OFF DAY
BX6 X2+X6 COMBINE MONTH AND DAY (MMDD)
LX0 60-12 POSITION MASK FOR YEAR
LX1 6
BX2 X0*X1 MASK OFF YEAR
BX6 X2+X6 COMBINE (MMDDYY)
SA1 ITEMP LOAD WORD CONTAINING HOUR/MIN
LX1 30
LX0 60-12 POSITION MASK FOR HOUR
BX2 X0*X1 MASK OFF HOUR
BX6 X2+X6 COMBINE (MMDDYYHH)
LX1 6
LX0 60-12 POSITION MASK FOR MINUTES
BX2 X0*X1 MASK OFF MINUTES
BX6 X2+X6 MONTH,DAY,YEAR,HOUR,MIN
SA6 ITEMP
EQ DATDATE
*
*
*
* /--- BLOCK DISKXJ 00 000 76/10/10 22.41
TITLE DISKXJ PERFORM DISK I/O EXCHANGE
*
* DISKXJ PERFORM DISK I/O EXCHANGE
*
* ON ENTRY - B1 = ADDRESS OF FILE INFO WORD
* B2 = ADDRESS OF DISK UNIT NUMBER
* B3 = ADDRESS OF BLOCK NUMBER
* B4 = ADDRESS OF I/O TYPE CODE
* 1 = READ 2 = WRITE
* B5 = ADDRESS OF ECS ADDRESS
* B6 = ADDRESS OF NUMBER BLOCKS
*
* ON EXIT - X6 = 0 IF OK
* = GE 1 (SET TO ERROR VALUE)
*
*
ENTRY DISKXJ
DISKXJ EQ *
MX6 0 PRESET FOR PXJERR BRANCHES
SA1 B1 LOAD FILE INFO WORD
MX0 -6
BX2 X1 GET LENGTH OF FILE
AX2 24
BX2 -X0*X2 MASK OFF NUMBER OF DISK SPACES
SX3 DSBLKS NUMBER OF BLOCKS/FILE SPACE
IX3 X2*X3 X3 = NUMBER OF BLOCKS IN FILE
SA2 B3 LOAD BLOCK NUMBER
NG X2,PXJERR EXIT IF BLOCK OUT OF RANGE
IX3 X2-X3
PL X3,PXJERR
SA3 B2 LOAD DISK UNIT NUMBER
CALL DISKADD *DISKINF* = DISK ADDRESS
SA1 DISKINF
SA2 B5 LOAD ECS ADDRESS
LX2 36 POSITION ECS ADDRESS
BX6 X1+X2
SA6 A1 UPDATE *DISKINF*
SA1 B4 LOAD DISK I/O CODE
SX1 X1+2 3/4 = NEW DISK READ/WRITE CODES
SX2 BLKLTH
SA3 B6 LOAD NUMBER OF BLOCKS TO DO
IX2 X2*X3 COMPUTE LENGTH OF TRANSFER
LX2 12
BX6 X2+X1 MERGE LENGTH AND I/O CODE
SA6 IOSW
*
CALL DSKSTAT,IOSW,SDSDATS,=1
*
SA1 DISKINF
SA2 IOSW
CALL SAVEDI SAVE INFO IN CASE OF DISK ERROR
DISKRQ DISKINF,IOSW
* DISKRQ RETURNS X6 NEG IF OK, GE 0 IF IN ERROR
PL X6,PXJERR JUMP IF ERROR IN EXCHANGE JP
SA1 POSTED INCREMENT NUMBER OF REQ POSTED
SX6 X1+1
SA6 A1
MX6 0 MARK NO ERROR
EQ DISKXJ
* /--- BLOCK DISKXJ 00 000 76/10/10 22.41
*
* * SET TO (STANDARD) ERROR RETURN VALUES
*
PXJERR SX6 X6+NPPUERR MARK ERROR IN EXCHANGE
EQ DISKXJ
* /--- BLOCK POSTXJ 00 000 76/06/30 17.16
TITLE POSTXJ CHECK DISK I/O COMPLETION
*
* POSTXJ
*
* POST EXCHANGE JUMP PROCESSING FOR -DISKXJ-
*
* ON ENTRY - B1 = JUMP ADDRESS IF I/O COMPLETE
* B2 = JUMP ADDRESS IF I/O INCOMPLETE
* B3 = JUMP ADDRESS IF DISK ERROR
* ON EXIT - X6 = 0 IF OK
* = GE 1 IF ERROR (=IORET)
*
*
ENTRY POSTXJ
*
POSTXJ EQ *
SA1 KEY
SX1 X1-IOKEY
NZ X1,POST20
SA1 POSTED DECREMENT COUNT OF REQ POSTED
SX6 X1-1
SA6 A1
SA1 IORET LOAD I/O RETURN CODE
BX6 X1
NZ X6,POST30 JUMP IF DISK ERROR OCCURRED
JP B1 DISK I/O COMPLETED SUCCESSFULLY
*
POST20 JP B2 DISK I/O NOT YET COMPLETE
*
POST30 JP B3 DISK I/O ERROR OCCURRED
* /--- BLOCK OUTPUT 00 000 79/08/18 18.47
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
*
*
ENTRY OUTDATX
*
OUTDATX MX6 -1 MARK *INFO* BUFFER USED
SA6 JJSTORE
SA1 TBLDATA SEE IF COLLECTING DATA
SX2 X1
ZR X2,PROC
SA2 TBTDATA MERGE LESSON-SELECTED BITS
BX1 X1+X2
LX1 60-DSOUTP SEE IF -OUTPUT- SELECTED
PL X1,PROC
*
* CALL -OUTPUT- COMMAND OVERLAY
EXEC EXEC6,OUTOV
*
*
* -OUTPUT- AND -OUTPUTL- OVERLAY CALLS RETURN HERE
*
ENTRY DOVRET
DOVRET FINISH DOVRET1 CHECK FOR -FINISH- UNIT
EQ DOVRET2
*
DOVRET1 MX6 0 KILL ANY OUTPUT FOR -FINISH-
SA6 MOUTLOC
*
*
DOVRET2 SA1 KEY
BX6 X1
SA6 TOKEY SAVE ORIGINAL KEY
SX6 NEXT SET *KEY* HARMLESSLY
SA6 A1
CALL DATAOUT,INFO
*
SA1 TOKEY
BX6 X1
SA6 KEY RESTORE ORIGINAL KEY
EQ CKPROC TO PROCESS AFTER TIME CHECK
* /--- BLOCK OUTPUTL 00 000 77/01/26 01.27
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
*
*
ENTRY OUTDATL
*
OUTDATL MX6 -1 MARK *INFO* BUFFER USED
SA6 JJSTORE
SA1 TBLDATA SEE IF COLLECTING DATA
SX2 X1
ZR X2,PROC
SA2 TBTDATA MERGE LESSON-SELECTED BITS
BX1 X1+X2
LX1 60-DSOUTP SEE IF -OUTPUT- SELECTED
PL X1,PROC
*
* CALL -OUTPUTL- COMMAND OVERLAY
EXEC EXEC6,OUTLOV
*
* /--- BLOCK OUTPUTT 00 000 77/06/25 02.36
TITLE -OUTPUTT- COMMAND
*
*
* -OUTPUTT- COMMAND
* 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
*
*
*
*
ENTRY OUTDATT
*
OUTDATT MX6 -1 MARK *INFO* BUFFER USED
SA6 JJSTORE
SA1 TBLDATA SEE IF COLLECTING DATA
SX2 X1
ZR X2,PROC
*
* CALL -OUTPUTT- COMMAND OVERLAY
EXEC EXEC6,OUTTOV
*
* /--- BLOCK AREA 00 000 79/08/18 18.48
TITLE -AREA- COMMAND
*
*
* -AREA- COMMAND
* SPECIFIES AREA FOR DATA COLLECTION
*
* 3 WORD BUFFER (AREADAT)
* 1ST WORD';
* 15/NOT USED, 9/TERMS FOUND, 9/TERMS NOT FOUND
* 9/HELPS FOUND, 9/HELPS NOT FOUND, 9/ARROWS
* 2D WORD';
* 18/ENTRY TIME, 6/NOT USED, 9/U-NO, 9/OK 1ST TRY
* 9/OK, 9/NO
* 3RD WORD';
* 18/ELAPSED TIME IN AREA, 1/COMPLETE,
* 23/NOT USED, 18/TIME OF ENTRY TO LESSON
*
*
ENTRY AREAX
AREAX FINISH
MX6 -1 MARK *INFO* BUFFER USED
SA6 JJSTORE
CALL IOCHK SEE IF DOING TOO MUCH I/O
NGETVAR GET AREA NAME
CALL LJUST,(1R ),0
BX6 X1
SA2 TBAREA X2 = PREVIOUS -AREA- NAME
BX1 X2-X6
ZR X1,PROC EXIT IF SAME AREA NAME
SA6 TBINTSV+9 SAVE AREA NAME
SA1 =0LCANCELLED
BX1 X1-X6 CHECK FOR *CANCELLED*
ZR X1,AR15
SA1 =0LINCOMPLETE
BX1 X1-X6 CHECK FOR *INCOMPLETE*
NZ X1,AR20
ZR X2,AR15 JUMP IF NO PREVIOUS -AREA-
CALL AREAOUT OUTPUT INCOMPLETE AREA
*
AR15 MX6 0
EQ AR100
*
AR20 ZR X2,AR100 JUMP IF NO PREVIOUS -AREA-
MX6 1
LX6 60-18 POSITION AREA COMPLETE BIT
SA1 AREADAT+2
BX6 X1+X6
SA6 A1
CALL AREAOUT
SA1 TBINTSV+9
BX6 X1 RESTORE AREA NAME
*
AR100 SA6 TBAREA SET AREA NAME
MX0 -18
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
MX6 0
SA6 AREADAT
MX6 -18
SA1 AREADAT+2 SAVE LESSON ENTRY TIME
BX6 -X6*X1 CLEAR OUT REST OF WORD
* /--- BLOCK AREA 00 000 75/06/11 14.11
SA6 A1
EQ PROCESS
*
*
* /--- BLOCK AREAINC 00 000 73/00/00 00.00
TITLE -AREAINC-
*
*
* -AREAINC-
* INCREMENTS SPECIFIED 9 BIT AREA DATA COUNT
*
* ON ENTRY - B1 = INDEX IN *AREADAT*
* B2 = SHIFT FOR PROPER COUNT
*
*
ENTRY AREAINC
AREAINC EQ *
MX0 -9 MASK FOR 9 BIT COUNT
SA1 B1+AREADAT
SB1 60 COMPUTE SHIFT COUNT
SB1 B1-B2
LX1 X1,B1 RIGHT JUSTIFY PROPER COUNT
BX6 X0*X1 MASK ALL BUT COUNT
BX1 -X0*X1
SX1 X1+1 INCREMENT COUNT
BX1 -X0*X1 LIMIT TO 9 BITS
BX6 X1+X6
LX6 X6,B2 REPOSITION *AREADAT* WORD
SA6 A1
EQ AREAINC
*
*
* /--- BLOCK ANSDAT 00 000 74/03/14 09.44
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
*
*
ENTRY ANSDAT
ANSDAT EQ *
LINK ANSDAT
EXEC EXEC6,ANSDOV
CALL DATAOUT,INFO
EQ ANSDAT
*
LINK 0
*
*
* /--- BLOCK AREAOUT 00 000 74/03/14 09.44
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
*
*
ENTRY AREAOUT
AREAOUT EQ *
LINK AREAOUT
EXEC EXEC6,AREAOV
CALL DATAOUT,INFO,8
EQ AREAOUT
*
LINK 0
*
*
* /--- BLOCK HELPOUT 00 000 74/03/14 09.44
TITLE -HELPOUT- OUTPUT -HELP- KEY DATA
*
*
* -HELPOUT-
* OUTPUTS HELP-TYPE KEY DATA
*
* ON ENTRY - B1 = 0 IF HELP NOT FOUND
* -1 IF HELP 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 = CURRENT UNIT NAME
* NEXT WORD = HELP UNIT NAME (OR 0)
* NEXT WORD = HELP KEY NAME
*
*
ENTRY HELPOUT
HELPOUT EQ *
LINK HELPOUT
SX6 B1 SAVE ARGUMENT
SA6 OVARG1
EXEC EXEC6,HELPOV
CALL DATAOUT,INFO,8
SA5 HELPSAV RESTORE X5
EQ HELPOUT
*
LINK 0
*
*
* /--- BLOCK TERMOUT 00 000 75/08/23 20.31
TITLE -TERMOUT- OUTPUT -TERM- DATA
*
*
* -TERMOUT-
* OUTPUTS TERM REQUEST INFO
*
* ON ENTRY - B1 = 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
*
*
ENTRY TERMOUT
TERMOUT EQ *
LINK TERMOUT
SX6 B1
SA6 OVARG1 PASS ARGUMENT TO OVERLAY
EXEC EXEC6,TERMOV
SB7 -1 MARK NOT EXECUTING
CALL DATAOUT,INFO,6
EQ TERMOUT
*
LINK 0
*
*
* /--- BLOCK FINDAT 00 000 77/07/05 21.00
TITLE -FINDAT- OUTPUT TIME IN LESSON DATA
*
*
* -FINDAT-
* OUTPUTS TIME IN LESSON DATA
*
* FIRST WORD -
* IST 30 BITS = HOLLERITH 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 = HOLLERITH DATE
* NEXT WORD = ELAPSED TIME IN LESSON (MSEC)
*
*
ENTRY FINDAT
FINDAT EQ *
LINK FINDAT
SA1 TBLDATA
SX2 X1 SEE IF DATA COLLECTION -ON-
ZR X2,FINDAT
SA2 TBTDATA MERGE LESSON-SELECTED BITS
NG X2,FINDAT CHECK IF -SYSDATA-
BX1 X1+X2
BX0 X1
LX1 60-DSDATON SEE IF -DATAOFF- SELECTED
PL X1,FINDAT
LX0 60-DSNODON BIT SET IF NO OUTPUT
NG X0,FINDAT
CALL S=TDATE,ITEMP
MX0 30
SA1 ITEMP LOAD CLOCK (BCD)
LX1 6
BX1 X0*X1 SAVE HOURS AND MINUTES
SX6 600B+DSIGNF
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
MX6 -18
SA1 SYSCLOK
SA2 TIMEARK TIME OF ENTRY TO LESSON
IX1 X1-X2 ELAPSED TIME SINCE ENTRY
AX1 7 KEEP TO ABOUT 1/10 SEC
SA2 AREADAT+2
BX2 -X6*X2 ELAPSED TIME AT -DATAON-
IX6 X1-X2 TIME SINCE -DATAON-
LX6 7 TIME IN MILLISECONDS
PX6 X6
NX6 X6
SA2 =60000.0
FX6 X6/X2 CONVERT TO MINUTES
SA3 =0.5
FX6 X6+X3 ROUND OFF
NX6 X6
UX6 X6,B1
LX6 X6,B1 CONVERT TO INTEGER AGAIN
MX3 30
BX6 -X3*X6
SA6 INFO+5
*
* /--- BLOCK FINDAT 00 000 75/09/20 21.10
*
SA1 TACCNT
NG X1,FININC ACOCOUNTING NOT ON
*
* SEE IF LESSON WAS COMPLETED THIS SESSION
*
MX0 5
SA3 TBSCORE LOAD CURRENT COMPLETION STATUS
BX3 X0*X3
LX3 5 POSITION COMPLETION FLAG
SX3 X3-1 1 = LESSON COMPLETED
NZ X3,FININC NOT NOW COMPLETED
LX1 1 SEE IF COMPLETION CLOCK RUNNING
PL X1,FININC IF NOT EXIT
LX1 1 SEE IF COMPLETED ON ENTRY
NG X1,FININC IF SO THEN EXIT
*
* UPDATE COMPLETION TIME
*
MX0 -9
SA1 TACCNT1
BX1 -X0*X1 GET COMPLETION TIME (MIN)
IX6 X6+X1 TOTAL COMPLETION TIME
MX3 30
BX6 -X3*X6 LIMIT TO 30 BITS
LX6 30
SA1 INFO+5
BX6 X6+X1 MERGE WITH ELAPSED TIME INFO
SA6 A1
EQ FINDAT1
*
FININC MX6 1 SET TOP BIT IF NOT COMPLETED
SA1 INFO+5
BX6 X6+X1
SA6 A1
*
*
FINDAT1 CALL DATAOUT,INFO,6
EQ FINDAT
*
LINK 0
*
* /--- BLOCK SYSDATA 00 000 77/08/25 21.31
TITLE -SYSDATA- TURN DATA ON FOR SPECIFIED FILE
*
*
*
* SYSDATA SETFILE,FILE NAME
* TURN ON STUDENT DATA INTO SPECIFIED DATA FILE
* CALLED FROM -SYSDATA- COMMAND OVERLAY
*
* ON ENTRY - TBINTSV = DATA FILE ACCOUNT NAME
* TBINTSV+1 = DATA FILE NAME
*
*
ENTRY SDSETX
SDSETX CALL SAVLES SAVE COMMON, STORAGE, ETC.
CALL INITDAT,TBINTSV,TBINTSV+1
SA1 TBLDATA
SX1 X1 CHECK IF SUCCESSFULL
MX6 0 OK FLAG
NZ X1,SDSX95 JUMP IF OK
MX6 -1 ERROR OCCURRED
SDSX95 SA6 TERROR
EQ =XRETPRO
*
*
* /--- BLOCK SYSDATA 00 000 77/10/20 01.31
TITLE -SYSDATA- CHECKPOINT DATA FILE
*
*
*
* SYSDATA CHECKPT
* CHECKPOINTS DATA FILE INDICATED BY *TBLDATA*
*
*
ENTRY SDCHKX
SDCHKX INTLOK X,I.DAT,W INTERLOCK
SA1 TBLDATA DATA BUFFER LESSON NUMBER
CALL READLES,DATINF,(LPRMLTH+DPRMLTH)
SX1 LPRMLTH
IX7 X0+X1 SAVE ECS ADDRESS OF BUFFER
SA7 DECSLOC
*
* GET FILE INFO WORD AND CHECK IF FILE FULL
*
SA1 INF+DFILNAM LOAD DATA FILE NAME
CALL FINDFN
NG X7,SDC93 EXIT IF FILE NO LONGER EXISTS
SA7 INF+DDISKU SET DISK UNIT NUMBER
SA1 X7+FITS
IX0 X1+X6 ECS ADDRESS OF FILE INFO WORD
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
BX6 X1 MAKE COPY OF *X1*
SA6 INF+DFINF SAVE FILE INFO WORD
MX0 -6
AX1 24 POSITION NUMBER OF DISK SPACES
BX1 -X0*X1
SX2 DSBLKS NUMBER OF BLOCKS PER PART
IX1 X1*X2 X1 = NUMBER OF BLOCKS IN FILE
SA2 INF+DATBLOK LOAD CURRENT BLOCK NUMBER
IX1 X2-X1
PL X1,SDC93 EXIT IF BLOCK OUT OF RANGE
SX6 X2
+ NZ X6,*+1 DONT ALLOW BLOCK ZERO
SX6 1
+ SA6 DBLOKN SET BLOCK NUMBER
*
* /--- BLOCK SYSDATA 00 000 77/10/20 01.33
*
* UPDATE BLOCK AND WORD POINTERS IN DIRECTORY
*
SA1 DECSLOC ECS ADDRESS OF DATA BUFFER
BX5 X1 BACK TO X5
SX1 DDIRECT+3 BIAS TO FLAG / LAST BLOCK USED
IX0 X5+X1
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
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
WX6 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*)
SX1 DDIRECT+64+X2 BIAS TO BLOCK INFO WORD
IX0 X5+X1
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
MX6 -9
LX6 9
BX6 X6*X1 CLEAR OLD WORD COUNT
SA1 INF+DATWORD CURRENT LAST WORD
LX1 9
BX6 X6+X1
WX6 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*)
*
* MOVE CURRENT DATA BLOCK TO DISK BUFFER AREA
*
SDC50 SX1 DBLK1 BIAS TO CURRENT DATA BLOCK
IX0 X5+X1
SA0 INFO
+ RE BLKLTH READ DATA BLOCK TO CM
RJ ECSPRTY
SX1 DBLK2 BIAS TO DISK BUFFER AREA
IX0 X5+X1
+ WE BLKLTH WRITE TO DISK BUFFER AREA
RJ ECSPRTY
* /--- BLOCK SYSDATA 00 000 77/10/20 01.34
*
* WRITE CURRENT DATA BLOCK TO DISK
*
BX6 X0 SAVE ECS ADDRESS OF BLOCK
SA6 DECSLOC
MX0 1 SET UP FILE WRITE BIT
LX0 60-DWRITSH
SA1 INF+DATSTAT DATA FILE STATUS WORD
BX6 X0+X1 SET FILE WRITE BIT
MX1 -18 CLEAR THE OLD STATION NUMBER
BX6 X6*X1
SA1 STATION INSERT CURRENT STATION NUMBER
BX6 X6+X1
SA6 INF+DATSTAT STORE WRITE BIT AND STATION
BX0 X5 ECS ADDR OF BUFFER INFO WORDS
SA0 INF
+ WE DPRMLTH UPDATE DATA BUFFER PARAMETERS
RJ ECSPRTY
CALL IOLESSN,TBLDATA,4000B FREEZE ECS BUFFER
INTCLR X,I.DAT RELEASE INTERLOCK
*
DISKO (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC
SA6 DERRFLG SAVE ERROR RETURN
NZ X6,SDC60 EXIT IF DISK ERROR
*
* WRITE DIRECTORY BLOCK TO DISK
*
SA1 TBLDATA
CALL READLES,DATINF,(LPRMLTH+DPRMLTH)
SX1 LPRMLTH+DDIRECT
IX6 X0+X1 ECS ADDRESS OF DIRECTORY
SA6 DECSLOC
MX6 0 SET BLOCK NUMBER
SA6 DBLOKN
*
DISKO (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC
SA6 DERRFLG SAVE ERROR RETURN
*
* /--- BLOCK SYSDATA 00 000 77/10/20 01.36
*
SDC60 INTLOK X,I.DAT,W INTERLOCK
CALL IOLESSN,TBLDATA,-4000B
SA1 TBLDATA RESTORE DATA FILE PARAMETERS
CALL READLES,DATINF,(LPRMLTH+DPRMLTH)
SX1 LPRMLTH
IX0 X0+X1 BIAS PAST LESSON HEADER
MX6 1
LX6 60-DWRITSH SET UP MASK FOR FILE WRITE BIT
SA1 INF+DATSTAT
BX6 -X6*X1 CLEAR FILE WRITE BIT
SA6 A1
SA0 INF
+ WE DPRMLTH UPDATE DATA BUFFER STATUS WORDS
RJ ECSPRTY
SA1 DERRFLG CHECK IF ANY ERROR OCCURRED
NZ X1,SDC93
MX6 0 MARK NO ERROR
EQ SDC95
*
SDC93 SX6 -3 -3 = ERROR HAS OCCURRED
EQ SDC95
*
SDC95 SA6 TERROR SAVE ERROR RETURN
INTCLR X,I.DAT RELEASE INTERLOCK
EQ RETPRO UN-SAVLES THEN PROCESS
*
*
* /--- BLOCK READSET 00 000 80/02/03 05.08
TITLE READSET
*
* -READSET- COMMAND
*
* 'INITIALIZE FOR READS OF SPECIFIED DATA FILE.
*
* ON EXIT--
* *TRETURN* = -1 IF OK (DATA FILE)
* 0 IF NOT A DATA FILE
* 1 IF CODE WORDS DO NOT MATCH
* 2 IF DATA FILE IS EMPTY
* 3 IF UNABLE TO GET ECS SPACE FOR
* DISK BUFFER
* 4 IF DISK ERROR
*
* *TERROR* = 0 OK
* -1 IF NOT A DATA FILE
* -2 IF NOT ENOUGH ECS FOR BUFFER
* -3 IF DISK ERROR
* -4 IF DATA FILE EMPTY
* -5 IF CODE WORDS DO NOT MATCH
*
*
ENTRY READSEX
*
READSEX FINISH ILLEGAL IN FINISH UNIT
*
SA1 TBDFINF
SX1 X1 SIGN OUT OF ANY OLD READ BUFFER
CALL ALTLES,-1
SX6 0 CLEAR OUT OLD LESSON NUMBER
SA6 TBDFINF
SA6 TBDFINF+1
* /--- BLOCK READSET 00 000 80/02/03 05.08
*
* THE FILE PARAMETERS (NAME, AND TWO INFO WORDS)
* ARE ZERO AT THIS POINT, FOR ALL FILE TYPES.
*
SA5 A5 RESTORE COMMAND WORD
SX6 4 UNPACK 4 ARGUMENTS
CALL GETARGS
SA6 RSARGS SAVE NUMBER OF ARGUMENTS
SX7 0
SA7 RSCODEW PRE-ZERO CODEWORD
SA7 RSRET PRE-ZERO RETURN ADDRESS
SX6 X6-3
NG X6,READ4 --- JUMP IF NO CODEWORD ARG
*
SA1 VARBUF+2 GET CODEWORD ARGUMENT
BX5 X1
NGETVAR
CALL LJUST,(1R ),0
BX6 X1
SA6 RSCODEW SAVE CODEWORD
*
SA1 RSARGS GET NUMBER OF ARGUMENTS
SX1 X1-4
NG X1,READ4 --- JUMP IF NO 4TH ARGUMENT
SA1 VARBUF+3 GET RETURN VARIABLE
BX5 X1
NGETVAR
SX6 A1 ADDRESS FOR RETURN
SA6 RSRET SAVE ADDRESS
*
* GET ACCOUNT AND FILE NAME
*
READ4 CALL ACCFILE,VARBUF,RSACCT,0
SA1 RSFILE
ZR X1,RSETE00 --- ERROR IF FILE NAME ZERO
*
* PAUSE TO AVOID FATAL LOOPS OR ABUSE
* 'NOTE--CANNOT PRECEDE NGETVAR UNLESS COMMON RELOADED
*
CALL SAVLES SAVE COMMON, STORAGE, ETC.
TUTIM 1000,,,STOPCHK PAUSE FOR 1 SECOND
* STOPCHK PROCESS -STOP1- KEY
*
* LOCATE FILE AND CHECK FILE TYPE
*
SA1 RSFILE GET FILE NAME
CALL FINDFN
NG X7,RSETE0 --- ERROR IF NO SUCH FILE
SA7 ILOC SAVE DISK UNIT NUMBER
SA1 X7+FITS
IX0 X1+X6 ECS ADDRESS OF FILE INFO WORD
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
BX6 X1 MAKE A COPY OF *X1*
SA6 ILOC1 SAVE VALUE READ FROM ECS
MX0 -6 MASK FOR FILE TYPE CODE
AX1 30
BX1 -X0*X1 MASK OFF FILE TYPE CODE
SX2 X1-4 CHECK FOR DATAFILE
NZ X2,RSETE0 --- ERROR IF NOT DATAFILE
* /--- BLOCK RDSTOR 00 000 86/05/13 06.42
*
* CREATE ECS BUFFER FOR READ OPERATIONS
*
CALL XSTOR,RBUFNAM,RBUFLTH
SA1 LESNUM CHECK IF OBTAINED ECS
NG X1,RSETE3 --- ERROR IF NO ECS
BX6 X1 SAVE BUFFER LESSON NUMBER
SA6 TBDFINF
CALL ALTLES,1 SIGN IN TO READ BUFFER
INTCLR X,I.ADDL RELEASE LESNAM INTERLOCK
CALL IOLESSN,TBDFINF,4000B
*
* INITIALIZE READ BUFFER PARAMETERS
*
SA1 TBDFINF READ BUFFER LESSON NUMBER
CALL READLES,DATINF,(LPRMLTH+RPRMLTH)
SX1 LPRMLTH
IX0 X0+X1 BIAS PAST HEADER RECORD
SA1 RSACCT GET ACCOUNT AND FILE NAME
SA2 RSFILE
BX6 X1
BX7 X2
SA6 INF+RFACCT SET ACCOUNT NAME
SA7 INF+RFNAME SET FILE NAME
SA1 ILOC
BX6 X1 SET DISK UNIT NUMBER
SA6 INF+RDISKU
SA1 ILOC1
BX6 X1 SET DATA FILE INFO WORD
SA6 INF+RFINF
SA0 INF
+ WE RPRMLTH RE-WRITE BUFFER INFO
RJ ECSPRTY
*
* READ DATAFILE DIRECTORY FROM DISK
*
SX1 RBLK1 BIAS TO FIRST BLOCK
IX6 X0+X1
SA6 DECSLOC SAVE ECS ADDRESS TO READ INTO
MX6 0
SA6 DBLOKN SET BLOCK NUMBER
DISKI (INF+RFINF),(INF+RDISKU),DBLOKN,DECSLOC
NZ X6,RSETE4 --- EXIT IF DISK ERROR
*
* /--- BLOCK RDSTOR 00 000 86/05/13 06.43
*
* READ DATAFILE DIRECTORY FROM EM
*
SA1 TBDFINF BUFFER LESSON NUMBER
CALL READLES,DATINF,(LPRMLTH+RPRMLTH)
SX1 LPRMLTH BIAS PAST HEADER RECORD
IX7 X0+X1
SA7 DECSLOC SAVE ECS ADDRESS OF BUFFER
SX1 RBLK1 BIAS TO DIRECTORY BLOCK
IX0 X1+X7
SA0 INFO
SX6 -1 MARK *INFO* BUFFER USED
SA6 JJSTORE
+ RE BLKLTH READ DIRECTORY BLOCK TO *INFO*
RJ ECSPRTY
*
* CHECK CODE WORDS
*
SA5 ILESUN
CALL SETLESN GET LESSON POINTERS
SA1 LESSCM+LSTOUSE BIT 59 = SYSTEM LESSON FLAG
MX6 -1
AX1 59
BX6 X1*X6 X6 = -1 IF SYSLESS, 0 IF NOT
SA6 ISYSF SAVE SYSTEM LESSON FLAG
SX1 4 X1 = BIAS TO BASE OF INFO
*
SA2 ISYSF SEE IF SYSTEM LESSON
NZ X2,READ5 DONT CHECK CODEWORDS
*
SA2 X1+INFO+2 DATAFILE CHANGE CODE
ZR X2,READ5 OK IF BLANK
SA3 X1+INFO+3 DATAFILE INSPECT CODE
ZR X3,READ5 OK IF BLANK
SA1 RSCODEW -READSET- COMMAND CODEWORD
IX0 X1-X2
ZR X0,READ5 OK IF CHANGE CODE MATCHED
IX0 X1-X3
ZR X0,READ5 OK IF INSPECT CODE MATCHED
SA4 NONECOD 'N'O'N'E CODEWORD
IX0 X2-X4
ZR X0,RSCODE1 JUMP IF CHANGE CODE 'N'O'N'E
SA1 LESSCM+LWCODE LESSON CHANGE CODE
IX0 X1-X2
ZR X0,READ5
RSCODE1 IX0 X3-X4
ZR X0,RSETE1 JUMP IF INSPECT CODE 'N'O'N'E
SA1 LESSCM+LRCODE LESSON INSPECT CODE
IX0 X1-X3
NZ X0,RSETE1 --- ERROR IF NO CODE WORD MATCH
*
* /--- BLOCK READ5 00 000 86/05/13 06.44
*
* CHECK DATA FILE DIRECTORY
*
READ5 SA1 INFO CHECK FILE NAME CORRECT
SA2 RSFILE
IX1 X1-X2
NZ X1,RSETE4 --- ERROR IF BAD DIRECTORY
*
SA1 INFO+3 FLAG / LAST BLOCK USED
SX2 X1 X2 = LAST BLOCK
NG X2,RSETE4 --- ERROR IF BLOCK NUMBER BAD
SX3 X2-BLKLTH
PL X3,RSETE4 --- ERROR IF BLOCK NUMBER BAD
SA3 INFO+64+X2 APPROPRIATE INFO WORD
MX6 -9
AX3 9
BX3 -X6*X3 X3 = LAST WORD
ZR X2,RSETE2 --- ERROR IF NO DATA IN FILE
SX6 X2-1 CHECK FOR FIRST BLOCK
NZ X6,RSET100
ZR X3,RSETE2 --- ERROR IF 1ST BLOCK EMPTY
*
RSET100 SA1 INFO+2 X1 = NUMBER OF BLOCKS
IX6 X1-X2
NG X6,RSETE4 --- ERROR IF BLOCK NUMBER BAD
NZ X6,RSET150 JUMP IF NOT LAST BLOCK
SX2 X1-1 SET TO LAST LEGAL BLOCK
*
RSET150 BX7 X2
SA7 INF+RBLKLIM SET LAST BLOCK NUMBER
SA1 RSRET GET ADDRESS FOR RETURN INFO
ZR X1,RSET400 --- JUMP IF NO RETURN REQUESTED
SX6 X6-1
SA6 X1
*
* INITIALIZE DATA BUFFER WITH FIRST TWO BLOCKS
*
RSET400 SX6 1 SET TO READ FIRST BLOCK
SA6 DBLOKN
SX6 2 SET CURRENT BLOCK NUMBER
SA6 INF+RBLOKN
SX1 RBLK1 BIAS TO FIRST BLOCK
SA2 DECSLOC ECS ADDRESS OF READ BUFFER
BX0 X2
IX6 X1+X2
SA6 DECSLOC SET ECS ADDRESS TO READ INTO
SA0 INF UPDATE BUFFER INFO IN ECS
WE RPRMLTH
RJ ECSPRTY
DISKI (INF+RFINF),(INF+RDISKU),DBLOKN,DECSLOC,=2
NZ X6,RSETE4 --- EXIT IF DISK ERROR
CALL IOLESSN,TBDFINF,-4000B
*
SX6 -1 -1 = OK, DATA FILE
SX7 0
* /--- BLOCK REXITS 00 000 80/02/03 05.05
*
SA6 TRETURN
SA7 TERROR
EQ RETPROC
*
*
RSETE00 MX6 0 0 = NOT A DATA FILE
MX7 -1
SA6 TRETURN
SA7 TERROR
EQ PROCESS --- RETURN
*
RSETE0 SX6 0 0 = NOT A DATA FILE
SX7 -1
EQ RSETEX
*
RSETE1 SX6 1 1 = CODE WORDS DO NOT MATCH
SX7 -5
EQ RSETEX
*
RSETE2 SX6 2 2 = DATA FILE EMPTY
SX7 -4
EQ RSETEX
*
RSETE3 SX6 3 3 = NO ECS AVAILABLE FOR BUFFER
SX7 -2
EQ RSETEX
*
RSETE4 SX6 4 4 = DISK ERROR
SX7 -3
EQ RSETEX
*
*
RSETEX SA6 TRETURN
SA7 TERROR
SA1 TBDFINF DELETE DATA READ BUFFER
ZR X1,RSETX
CALL DELETE
SX6 0
SA6 TBDFINF CLEAR LESSON NUMBER
*
*
RSETX EQ =XRETPRO UN-SAVLES THEN TO PROCESS
*
*
* STUDENT BANK VARIABLES
*
RSACCT EQU TBINTSV ACCOUNT NAME
RSFILE EQU TBINTSV+1 FILE NAME
RSCODEW EQU TBINTSV+2 CODEWORD
RSRET EQU TBINTSV+3 ADDRESS FOR RETURN INFO
RSARGS EQU TBINTSV+4 NUMBER OF ARGUMENTS
*
* /--- BLOCK READD 00 000 79/08/18 18.53
TITLE -READD- COMMAND (READ DATA FROM DATAFILE)
*
*
*
* -READD- COMMAND
* READ NEXT DATA RECORD
*
*
ENTRY READDX
*
READDX FINISH ILLEGAL IN -FINISH- UNIT
SX6 -1 MARK *INFO* BUFFER USED
SA6 JJSTORE
SA1 TBDFINF SEE IF -READSET- DONE
ZR X1,RDDERX1
NGETVAR GET BUFFER ADDRESS
SX6 A1
SA6 TBDFINF+1 SAVE BUFFER ADDRESS
SA5 A5 GET NEXT -GETVAR- CODE
LX5 XCODEL
NGETVAR GET MAXIMUM LENGTH OF BUFFER
SA2 TBDFINF+1 LOAD BUFFER ADDRESS
SA0 X2
CALL BOUNDS BOUNDS CHECK
SB2 X1-101 CHECK FOR BUFFER TOO LONG
PL B2,ERXBADL EXECERR USES X1
SX6 X1
LX6 18 POSITION BUFFER LENGTH
BX6 X2+X6
SA6 A2
*
SA5 A5
AX5 XCMNDL
MX6 -XSPTRL
BX6 -X6*X5 GET TYPE OF DATA RECORD
SB1 X6
JP *+B1
*
+ EQ RALOOP
+ EQ RLLOOP
+ EQ RSLOOP
*
ENTRY RSLOOP
RSLOOP CALL RECORD GET NEXT DATA RECORD
STOPCHK PROCESS -STOP1- KEY
EXEC EXEC6,READDOV
*
*
ENTRY RLLOOP
RLLOOP CALL RECORD GET NEXT DATA RECORD
STOPCHK PROCESS -STOP1- KEY
EXEC EXEC6,READLOV
*
*
ENTRY RALOOP
RALOOP CALL RECORD GET NEXT DATA RECORD
STOPCHK PROCESS -STOP1- KEY
EXEC EXEC6,READAOV
*
*
*
RDDERX1 EXECERR 64 *NO READSET SPECIFIED*
* /--- BLOCK RECORD 00 000 80/02/03 05.12
TITLE -RECORD- READ NEXT DATA RECORD
*
* -RECORD-
* READ NEXT DATA RECORD TO *INFO*
*
* USES *TBINTSV(0)* AND *TBINTSV(1)*
*
*
RECORD EQ *
REC1 SA1 TBDFINF DATA BUFFER LESSON NUMBER
SX1 X1
ZR X1,RREOF
CALL READLES,DATINF,(LPRMLTH+RPRMLTH)
SX1 LPRMLTH
IX5 X0+X1 SAVE ECS ADDRESS OF BUFFER
SA4 INF+RWORD LOAD POINTER TO NEXT WORD
SX1 X4-BLKLTH
PL X1,RNEXT JUMP IF BEYOND BLOCK BOUNDARY
SX2 X4+RBLK1 ADD BIAS TO BLOCK BUFFER
IX0 X2+X5
SA0 INFO
+ RE DATAMAX READ MAXIMUM REOCRD LENGTH
RJ ECSPRTY
MX0 -6
SA1 INFO LOAD HEADER WORD
AX1 6
BX1 -X0*X1 LENGTH OF RECORD
ZR X1,RNEXT TRY NEXT BLOCK IF NO LENGTH
IX6 X1+X4 ADVANCE WORD COUNT
SA6 A4
BX0 X5 ECS ADDRESS OF PARAMETERS
SA0 INF
+ WE RPRMLTH UPDATE WORD COUNT
RJ ECSPRTY
EQ RECORD
*
RREOF MX6 0 RETURN 0 FOR END-OF-FILE
SA6 INFO
EQ RECORD
*
*
* /--- BLOCK RECORD 00 000 74/12/11 23.06
*
RNEXT SX6 X4-BLKLTH COMPUTE NEW WORD COUNT
+ PL X6,*+1
MX6 0
+ SA6 A4 UPDATE WORD COUNT
SA1 INF+RBLOKN LOAD CURRENT BLOCK NUMBER
SA2 INF+RBLKLIM MAXIMUM BLOCK NUMBER
IX7 X2-X1
NG X7,RREOF EXIT IF ALL BLOCKS EXHAUSTED
SA7 ILOC
SX6 X1+1
SA6 A1 UPDATE BLOCK NUMBER
SA6 DBLOKN
SX1 RBLK2 BIAS TO SECOND BLOCK OF DATA
IX0 X1+X5 ECS ADDRESS OF SECOND BLOCK
SA0 INFO
+ RE BLKLTH READ SECOND BLOCK TO *INFO*
RJ ECSPRTY
SX1 RBLK1 BIAS TO FIRST BLOCK AREA
IX0 X1+X5
+ WE BLKLTH SHOVE DATA DOWN TO FIRST BLOCK
RJ ECSPRTY
BX6 X5 SAVE ECS ADDRESS OF BUFFER
SA6 DECSLOC
*
* CHECK THAT FILE STILL EXISTS - SET FILE INFO WORD
*
SA1 INF+RFNAME GET DATA FILE NAME
CALL FINDFN
NG X7,RREOF EXIT IF FILE DOES NOT EXIST
SA7 INF+RDISKU SET DISK UNIT NUMBER
SA1 X7+FITS
IX0 X1+X6 ECS ADDRESS OF FILE INFO WORD
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
BX6 X1 SAVE A COPY OF *X1*
SA6 INF+RFINF SAVE FILE INFO WORD
SA1 DECSLOC
BX0 X1
SA0 INF UPDATE BUFFER INFO WORDS
+ WE RPRMLTH
RJ ECSPRTY
SA2 ILOC CHECK IF ANY MORE BLOCKS
ZR X2,REC1
SX2 RBLK2 BIAS TO SECOND BLOCK AREA
IX6 X1+X2
SA6 DECSLOC SET ADDRESS TO READ INTO
*
* /--- BLOCK RECORD 00 000 79/09/04 22.35
*
* READ NEXT BLOCK OF DATA FROM DISK
*
SA1 RECORD
BX6 X1 SAVE EXIT JUMP
SA6 TBINTSV
CALL SAVLES SAVE COMMON, STORAGE, ETC.
*
CALL IOLESSN,TBDFINF,4000B
DISKI (INF+RFINF),(INF+RDISKU),DBLOKN,DECSLOC
SA6 TBINTSV+1 SAVE ERROR RETURN
CALL IOLESSN,TBDFINF,-4000B
*
CALL SYSTEST
NG X6,RN210 --- BRIF SYSTEM LESSON
TUTIM 1000,,,STOPCHK PAUSE FOR A WHILE
* STOPCHK PROCESS -STOP1- KEY
*
RN210 CALL RESTLES RESTORE LESSON, COMMON, ETC.
SA1 TBINTSV
BX6 X1 RESTORE EXIT JUMP
SA6 RECORD
SA1 TBINTSV+1 CHECK IF ANY ERROR OCCURRED
ZR X1,REC1
EQ RREOF TREAT DISK ERR AS END-OF-FILE
*
* /--- BLOCK END 00 000 78/11/12 21.21
TITLE STORAGE DEFINITIONS
*
*
ENTRY DARG1,DARG2
DARG1 BSS 1
DARG2 BSS 1
*
DECSLOC BSS 1
DBLOKN BSS 1
DERRFLG BSS 1
ISYSF BSS 1
*
DATINF BSS LPRMLTH+DPRMLTH
INF EQU DATINF+LPRMLTH
*
ENTRY IDWK
IDWK BSSZ 2
*
ENTRY DBUFNAM
DBUFNAM BSSZ 2 DATA BUFFER NAME
DATA 10LDATA
+ VFD 12/3,48/0
*
RBUFNAM DATA 0 -READSET- BUFFER NAME
DATA 0LDATAREAD
+ VFD 12/0,48/0LBUFFER
+ VFD 12/1,48/0
*
ILOC BSS 1
ILOC1 BSS 1
*
IRBUF EQU INFO+BLKLTH+1
*
END