Retro1.org codex

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