DPRT
* /--- FILE TYPE = E
* /--- BLOCK DEFINES 00 000 80/01/25 00.46
* OVERLAY(DPRINT,0,0)
PROGRAM DPRINT(INPUT,OUTPUT)
C
C
C PRINT TUTOR STUDENT DATA
C
C
IMPLICIT INTEGER (A-Z)
C
COMMON /GETLINE/ PRTDEN,INFO(3),LINE(64),BLOCK,NXT,END
C
COMMON /OUTPUT/ OUTBUF(11),LTH,TERMX(2),TIME,DATE
C
COMMON /DISK/ DISKF1,DISKF2,BUFF(320)
C
REAL V
C
EQUIVALENCE (PDEN,PRTDEN)
EQUIVALENCE (FILE,INFO(1))
EQUIVALENCE (BLOCKS,INFO(2))
EQUIVALENCE (TBLKS,INFO(3))
C
EQUIVALENCE (NAME,LINE(2))
EQUIVALENCE (NAME1,LINE(3))
EQUIVALENCE (LESSON,LINE(4))
EQUIVALENCE (AREA,LINE(5))
C
DIMENSION STATE(12)
DIMENSION ETYPE(14)
DIMENSION MESS1(4)
DIMENSION MESS2(2)
C
* /--- BLOCK STARTUP 00 000 80/02/01 00.46
C
1 ETYPE(1)=10LUNKNOWN ER
ETYPE(2)=10LROR
ETYPE(3)=10LILLEGAL CO
ETYPE(4)=10LMMAND
ETYPE(5)=10LMISSING UN
ETYPE(6)=10LIT
ETYPE(7)=10LTIME SLICE
ETYPE(8)=10L EXCEEDED
ETYPE(9)=10LTUTOR OUTF
ETYPE(10)=10LOW
ETYPE(11)=10LSTATION OU
ETYPE(12)=10LTFLOW
ETYPE(13)=10LILL ACTION
ETYPE(14)=10LREQUEST
C
STATE(1)=10LREG PRE-AR
STATE(2)=10LROW
STATE(3)=10LREG POST-A
STATE(4)=10LRROW
STATE(5)=10LJUDGING
STATE(6)=10L
STATE(7)=10LREG POST-J
STATE(8)=10LUDGE
STATE(9)=10LSEARCH
STATE(10)=10L
STATE(11)=10LUNKNOWN ST
STATE(12)=10LATE
C
MESS1(1)=10LCONTINUATI
MESS1(2)=10LON OF PREV
MESS1(3)=10LIOUS SESSI
MESS1(4)=10LON
C
C GET CM/ECS/TIME/DATE/NAME OF FILE
C
CALL SETUP
C
C
C 'IF PDEN = 0, SET HIGH DENSITY
C
IF (PDEN.EQ.0) PRINT 1007
C
C PAGE EJECT
7 PRINT 1000
C
C PRINT DAYFILE PRINT INFO IF ANY
C
IF (LINE(1).EQ.0) GOTO 8
CALL IBFILLB(LINE(1),20)
PRINT 1008,(LINE(I),I=1,4)
PRINT 1008,(LINE(I),I=5,8)
PRINT 1008,(LINE(I),I=9,12)
PRINT 1008,(LINE(I),I=13,16)
PRINT 1008,(LINE(I),I=17,20)
PRINT 1009
PRINT 1010
8 DO 9 I = 1,20
9 LINE(I) = 0
CALL FILL (10L**********)
PRINT 1001,(OUTBUF(I),I=1,11)
CALL ATTACH (FILE)
CALL IBFILL(FILE,TIME,DATE)
PRINT 1002,FILE,TIME,DATE
CALL DISKIN (0)
TBLKS=BUFF(3)
C NUMBER OF BLOCKS IN USE
BLOCKS = BUFF(4).AND.(77777B)
C PRINT FILE INFORMATION
CALL IBFILLB(BUFF(9),10)
PRINT 1005,(BUFF(J),J=9,13)
PRINT 1006,(BUFF(J),J=14,18)
PRINT 1001,(OUTBUF(I),I=1,11)
111 CALL ISTLIN
IF (END.NE.0)GOTO 90
C
* /--- BLOCK MAIN LOOP 00 000 78/07/02 17.11
C
C
C MAIN LOOP - PROCESS NEXT DATA RECORD
C
10 CALL GETLINE
IF(END.NE.0)GOTO 90
TYPE=LINE(1).AND.77B
LTH=(ISHR(LINE(1),6)).AND.77B
IF(TYPE.EQ.0)GOTO 90
IF(TYPE.GT.13)GOTO 10
C IF(TYPE-9)X,X,10
GOTO(100,200,300,400,500,600,700,800,900,550,560,10,1300)TYPE
C
C
C
C -OUTPUT- COMMAND DATA
C
100 II=ISHL(((ISHL(LINE(1),30)).AND.777777B),7)
V=II/60000.0
CALL IBFILL(NAME,NAME1,LESSON,AREA)
PRINT 2100,V,NAME,NAME1,LESSON,AREA
CALL OUTFORM
CALL IBFILLB(OUTBUF,11)
PRINT 2110,(OUTBUF(I),I=1,11)
GOTO 10
C
2100 FORMAT (3X,*OUTPUT*,4X,F5.1,4X,A10,A8,3X,A10,2X,
* *AREA *,A10)
2110 FORMAT (22X,11A10,/)
C
C
C
C STUDENT RESPONSE
C
200 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
V=II/60000.0
ARR=(ISHL(LINE(1),33)).AND.777B
N1=0
N2=0
IF((ISHL(LINE(1),36)).GE.0)GOTO 210
N1=10LUNRECOGNIZ
N2=10LED WORD
GOTO 220
C
210 IF(((ISHL(LINE(1),24)).AND.77B).NE.3)GOTO 220
N1=10HUNRECOGNIZ
N2=7HED -NO-
C
220 CALL IBFILL(NAME,NAME1,LESSON,AREA,LINE(6),N1,N2)
PRINT 2200,V,NAME,NAME1,LESSON,AREA,LINE(6),ARR,
* N1,N2
CALL ANSFORM
CALL IBFILLB(OUTBUF(1),11)
PRINT 2210,(OUTBUF(I),I=1,11)
GOTO 10
C
2200 FORMAT (3X,*RESPONSE *,F5.1,4X,A10,A8,3X,A10,
* 2X,*AREA *,A10,2X,*UNIT *,A8,3X,*ARROW*,I3,
* 10X,2A10)
2210 FORMAT (22X,11A10,/)
C
* /--- BLOCK AREA/TERM 00 000 77/11/12 01.38
C
C
C -AREA- COMMAND DATA
C
300 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
V=II/60000.0
IF((ISHL(LINE(8),18)).GE.0)GOTO 310
N6=8HCOMPLETE
GOTO 320
C
310 N6=10HINCOMPLETE
C
320 CALL IBFILL(NAME,NAME1,LESSON,AREA,N6)
PRINT 2300,V,NAME,NAME1,LESSON,AREA
N1=ISHL(((ISHL(LINE(8),18)).AND.777777B),7)
V=N1/60000.0
N1=LINE(6).AND.777B
N2=(ISHR(LINE(7),9)).AND.777B
N3=(ISHR(LINE(7),18)).AND.777B
PRINT 2310,V,N1,N2,N3
N1=(ISHR(LINE(6),36)).AND.777B
N2=(ISHR(LINE(6),27)).AND.777B
N3=LINE(7).AND.777B
N4=(ISHR(LINE(7),27)).AND.777B
PRINT 2320,N1,N2,N3,N4
N1=(ISHR(LINE(6),18)).AND.777B
N2=(ISHR(LINE(6),9)).AND.777B
PRINT 2330,N1,N2
IF((ISHL(LINE(8),19)).GE.0)GOTO 330
PRINT 2340,N6,MESS1(1),MESS1(2),MESS1(3),MESS1(4)
GOTO 10
330 PRINT 2345,N6
GOTO 10
C
2300 FORMAT (3X,*AREA*,6X,F5.1,4X,A10,A8,3X,A10,2X,
* *AREA *,A10)
2310 FORMAT (22X,*ELAPSED *,F5.1,8X,*ARROWS *,I4,5X,
* *ANSWERS OK*,I4,5X,*OK IST TRY*,I4)
2320 FORMAT (22X,*TERMS OK*,I4,9X,*TERMS NO*,I4,5X,
* *ANSWERS NO*,I4,5X,*UNRECOG NO*,I4)
2330 FORMAT (22X,*HELPS OK*,I4,9X,*HELPS NO*,I4)
C
2340 FORMAT (22X,A10,2X,4A10,/)
C
2345 FORMAT (22X,A10,/)
C
C
C
C TERM KEY DATA
C
400 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
V=II/60000.0
CALL IBFILL(NAME,NAME1,LESSON,AREA)
PRINT 2400,V,NAME,NAME1,LESSON,AREA
TERM=LINE(6).AND.77777777777777770000B
TERM1=(LINE(6).AND.1)+1
TERM1=TERMX(TERM1)
CALL IBFILL(TERM,TERM1)
PRINT 2410,TERM,TERM1
GOTO 10
C
2400 FORMAT (3X,*TERM*,6X,F5.1,4X,A10,A8,3X,A10,2X,
* *AREA *,A10)
2410 FORMAT (22X,A8,13X,A10,/)
C
* /--- BLOCK SIGN/OUTL 00 000 76/08/21 12.06
C
C
C STUDENT SIGN-ON
C
500 II=LINE(1).AND.77777 77777 00000 00000B
CALL IBFILL(NAME,NAME1,LESSON,LINE(5),II)
PRINT 2500,NAME,NAME1,LESSON,LINE(5),II
GOTO 10
C
2500 FORMAT (3X,*SIGNIN*,13X,A10,A8,3X,A10,
* 1X,A10,6X,A5,/)
C
C
C
C
C STUDENT SIGN-OFF
C
550 II=LINE(1).AND.77777 77777 00000 00000B
V=LINE(6)/60000.0
CALL IBFILL(NAME,NAME1,LESSON,LINE(5),II)
PRINT 2550,NAME,NAME1,LESSON,LINE(5),II,V
GOTO 10
C
2550 FORMAT (3X,*DATAOFF*,12X,A10,A8,3X,A10,
* 1X,A10,6X,A5,6X,F5.1,/)
C
C
C
C STUDENT SIGNOFF (2)
C
560 II=LINE(1).AND.77777 77777 00000 00000B
CALL IBFILL(NAME,NAME1,LESSON,LINE(5),II)
PRINT 2560,NAME,NAME1,LESSON,LINE(5),II
N3=LINE(6).AND.77777 77777B
IF(LINE(6).GE.0)GOTO 561
N1=10HNOT COMPLE
N2=3HTED
PRINT 2561,N3,N1,N2
GOTO 570
C
561 N1=10HCOMPLETION
N2=5H TIME
N4=(ISHL(LINE(6),30)).AND.77777 77777B
PRINT 2562,N3,N1,N2,N4
570 GOTO 10
C
2560 FORMAT (3X,*SIGNOFF*,12X,A10,A8,3X,A10,
* 1X,A10,6X,A5,6X)
2561 FORMAT (22X,*ELAPSED TIME*,3X,I4,6X,A10,A10,/)
2562 FORMAT (22X,*ELAPSED TIME*,3X,I4,6X,A10,A10,
* 3X,I4,/)
C
C
C
C -HELP- KEY DATA
C
600 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
V=II/60000.0
CALL IBFILL(NAME,NAME1,LESSON,AREA,LINE(6))
PRINT 2600,V,NAME,NAME1,LESSON,AREA,LINE(6)
N1=LINE(8).AND.(-777777B)
N2=LINE(7).AND.(-7777B)
IF(N2.NE.0)GOTO 610
N2=7LNO UNIT
C
610 CALL IBFILL(N1,N2)
PRINT 2610,N1,N2
GOTO 10
C
2600 FORMAT (3X,*HELP*,6X,F5.1,4X,A10,A8,3X,A10,
* 2X,*AREA *,A10,2X,*UNIT *,A8)
2610 FORMAT (22X,A7,3X,A8,/)
C
C
C
C -OUTPUTL- COMMAND DATA
C
700 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
V=II/60000.0
CALL IBFILL(NAME,NAME1,LESSON,AREA,LINE(6))
PRINT 2700,V,NAME,NAME1,LESSON,AREA,LINE(6)
II=LTH-6
IF(II.LE.0)GOTO 715
C
DO 710 I=1,II
N1=LINE(6+I)
CALL VFORM (N1,V)
N2=N1
CALL IBFILL(N2)
PRINT 2710,N2,N1,N1,V
C
710 CONTINUE
715 PRINT 1004
GOTO 10
C
2700 FORMAT (3X,*OUTPUT-L *,F5.1,4X,A10,A8,3X,A10,
* 2X,*AREA *,A10,2X,*LABEL *,A10)
2710 FORMAT (22X,A10,2X,I10,3X,O20,3X,F10.4)
C
* /--- BLOCK EXEC ERR 00 000 76/08/21 11.56
C
C
C EXECUTION ERROR DATA
C
800 CALL IBFILL(NAME,NAME1,LESSON,LINE(6))
PRINT 2800,NAME,NAME1,LESSON,LINE(6)
NERROR=(ISHL(LINE(1),6)).AND.77B
IF(NERROR.LE.0)GOTO 805
IF(NERROR.LE.6)GOTO 810
C
805 N1=ETYPE(1)
N2=ETYPE(2)
GOTO 812
C
810 II=2*NERROR+1
N1=ETYPE(II)
N2=ETYPE(II+1)
C
812 N3=(ISHL(LINE(1),21)).AND.777B
II=(ISHL(LINE(1),12)).AND.77B
IF(II.LE.4)GOTO 820
II=5
C
820 II=2*II+1
N4=STATE(II)
N5=STATE(II+1)
CALL IBFILL(N1,N2,LINE(7),LINE(8),N4,N5)
PRINT 2810,N1,N2,LINE(7),LINE(8),N3,N4,N5
N1=(ISHL(LINE(1),30)).AND.77B
IF(N1.LE.0)GOTO 870
N2=LINE(9).AND.(-7777B)
N3=LINE(9).AND.777B
CALL IBFILL(N2)
PRINT 2820,N2,N3
IF(N1.LE.1)GOTO 870
C
DO 850 II=2,N1
N2=LINE(8+II).AND.(-7777B)
N3=LINE(8+II).AND.777B
CALL IBFILL(N2)
PRINT 2830,N2,N3
850 CONTINUE
C
870 PRINT 1004
GOTO 10
C
2800 FORMAT (3X,*EXECUTION ERROR*,4X,A10,A8,3X,A10,
* 2X,*UNIT *,A8)
2810 FORMAT (22X,A10,A10,1X,A8,4X,A10,2X,*LINE *,I3,
* 3X,2A10)
2820 FORMAT (22X,*JOIN SEQUENCE *,A8,3X,*LINE *,I3)
2830 FORMAT (38X,A8,3X,*LINE *,I3)
C
C
C
C UNLABLED -OUTPUTL- DATA
C
900 PRINT 2900
II=LTH-1
IF(II.LE.0)GOTO 915
C
DO 910 I=1,II
N1=LINE(1+I)
CALL VFORM (N1,V)
N2=N1
CALL IBFILL(N2)
PRINT 2910,N2,N1,N1,V
C
910 CONTINUE
915 PRINT 1004
GOTO 10
C
2900 FORMAT (3X,*OUTPUT-L*,11X,*NO OUTPUT LABEL*)
2910 FORMAT (22X,A10,2X,I10,3X,O20,3X,F10.4)
* /--- BLOCK OUTPUTT 00 000 77/07/05 13.44
C
C
C -OUTPUTT- COMMAND DATA
C
C LINE(5) IS THE INFO TYPE (LABEL) LIMITED TO
C 7 CHARS MAX SPACE FILLED.
C
C THERE IS A NAME AND LESSON BUT NO AREA.
C
C LINE(6)-LINE(N) IS DISPLAYED IN -TEXT- FORMAT.
C
1300 CALL IBFILL(LINE(5),NAME,NAME1,LESSON)
PRINT 3300,LINE(5),NAME,NAME1,LESSON
STARTL=6
1310 IF (STARTL.GT.LTH) GOTO 1390
CALL FINDEOL(STARTL,ENDL)
LINELTH=ENDL-STARTL+1
TENDL=ENDL
IF (LINELTH.GT.10) TENDL=STARTL+11
CALL IBFILL(LINE(TENDL))
IF (LINELTH.GT.1) CALL IBFILL(LINE(TENDL-1))
PRINT 3310,(LINE(J),J=STARTL,TENDL)
STARTL=ENDL+1
GOTO 1310
*
1390 PRINT 1004
GOTO 10
*
*
3300 FORMAT(3X,A7,12X,A10,A8,3X,A10)
3310 FORMAT(22X,10A10)
* /--- BLOCK END 00 000 80/02/01 00.46
C
C
90 PRINT 1003
C
C DETACH FILE AND RELEASE ALL ECS
C
99 CALL DETACH
CALL RELECS
STOP
C
1000 FORMAT (1H1)
1001 FORMAT (3X,11A10,//)
1002 FORMAT (3X,*DATA FILE *,A10,5X,*PRINTED AT*,A10,
* * ON*,A10,//)
1003 FORMAT (//,3X,*+++++ END OF DATA +++++*)
1004 FORMAT (/)
1005 FORMAT (3X,5A10)
1006 FORMAT (3X,5A10,//)
1007 FORMAT (1HT)
1008 FORMAT (44X,4A10,1H*)
1009 FORMAT (44X,41(1H*))
1010 FORMAT (//)
C
END
* /--- BLOCK ITOA 00 000 76/08/21 12.01
SUBROUTINE ITOA (IIN,IOUT)
C
C
C INTEGER TO ALPHA CONVERSION
C
C
1 IF(IIN.EQ.0)GOTO 50
ENCODE (10,100,IOUT)IIN
C
10 IF(((ISHL(IOUT,6)).AND.77B).NE.55B)GOTO 90
IOUT=(ISHL(IOUT,6)).AND.(-77B)
GOTO 10
C
50 IOUT=1H0
C
90 RETURN
C
100 FORMAT (I10)
C
END
SUBROUTINE FTOA (IIN,IOUT)
C
C
C FLOATING POINT TO ALPHA CONVERSION
C
C
1 IF(IIN.EQ.0)GOTO 50
ENCODE (10,100,IOUT)IIN
I=0
C
10 IF(((ISHR(IOUT,(I*6))).AND.77B).NE.1R0)GOTO 20
IOUT=IOUT.AND.(ISHL((-77B),(I*6)))
I=I+1
IF(I.LT.3)GOTO 10
C
20 IF(((ISHL(IOUT,6)).AND.77B).NE.55B)GOTO 90
IOUT=(ISHL(IOUT,6)).AND.(-77B)
GOTO 20
C
50 IOUT=3H0.0
C
90 RETURN
C
100 FORMAT (F10.4)
C
END
* /--- BLOCK SHIFTS 00 000 76/08/13 14.55
IDENT SHIFTS
*
* FUNCTIONS FOR LEFT AND RIGHT SHIFTS.
* CALLABLE FROM FTN.
*
* LAWRENCE A. WHITE
* AUGUST 11, 1976
*
ENTRY ISHL
ISHL EQ *+400000B
SA2 X1 VALUE TO BE SHIFTED
SA1 A1+1
SA3 X1 AMOUNT TO SHIFT IT
SB2 X3
LX6 X2,B2
EQ ISHL
*
ENTRY ISHR
ISHR EQ *+400000B
SA2 X1
SA1 A1+1
SA3 X1
SB2 X3
AX6 X2,B2
EQ ISHR
*
*
END
* /--- BLOCK SETUP 00 000 80/05/17 19.42
IDENT SETUP
TITLE -SETUP-
LIST X
*CALL DPRTX
*CALL SYSCON
LIST *
SST
SYSCOM
*
TITLE LOAD TIME INITIALIZATIONS
*
* -SETUP-
*
ENTRY SETUP
EXT REQECS,GETARG,ECSPRTY
SETUP EQ *
* WRITE ACCOUNT, COURSE, NAME OF PRINT REQUESTOR
* TO ACCOUNT FILE
MESSAGE CCDR,5,RECALL
RJ GETARG GET THE FILE NAME
SA6 FILE AND, SAVE
IFCDC IFEQ CDC,0
IFCDC IFEQ CDC,0
RJ GETARG GET SECOND CONTROL CARD ARG
SA1 =4LHIGH SEE IF IT IS '7HIGH'7
IX6 X1-X6
IFCDC ELSE
MX6 59
ENDIF
IFCDC ELSE
MX6 59
ENDIF
SA6 PDEN STORE FOR FTN PROGRAM
SA1 65B NEXT AVAILABLE CM
SX6 X1+100B ROUND UP BY 100B
MX0 -6
BX6 X0*X6
LX6 30
SA6 CMFL SET CM FIELD LENGTH
MEMORY CM,CMFL,RECALL
SX6 ECSLTH SET ECS FIELD LENGTH
SA6 ECFL
CALL REQECS,ECFL REQUEST ECS
CLOCK TIME
DATE DATE
* /--- BLOCK SETUP 00 000 80/02/01 00.46
*
* LOOK FOR PRINT INFO IN DAYFILE. PASS TO FTN IN 1ST 20 WDS
* OF *LINE* BUFFER. LINE(1) = 0 IF NOT THERE. USES *BUFF*
* AS TEMP. STORAGE
*
CONTROL BUFF,1 GET CARD FOLLOWING DPRINT CARD
SA1 BUFF
SA2 =10L***** MAIL HEADER FOR MAILING INFO
MX6 0 PRESET NOT THERE
SA6 LINE
IX1 X1-X2 SEE IF INFO IS THERE
NZ X1,SETUP --- BRANCH IF NOT
MX0 0 ECS XFER ADDRESS
SX7 A0
SA7 SAVEA0 SAVE FOR FTN
SX5 A6 INITIAL CM TRANSFER ADDRESS
PRINFO CONTROL BUFF GET A LINE OF INFO (8 WDS MAX)
SA0 BUFF ONLY THE 1ST 4 WORDS ARE USED
WE 4 MOVE IT WHERE IT BELONGS
RJ ECSPRTY
SA0 X5 X5,A0,X0 SAVED OVER SYS CALLS
RE 4
RJ ECSPRTY
SX5 X5+4 ADDRESS OF NEXT LOCATION
SB1 LINE+20 CANNOT DO SB1 X5-LINE-20
SB2 X5 CUZ LOADER NO ALLOW
LT B2,B1,PRINFO --- IF NOT DONE YET
SA1 SAVEA0 RESTORE A0
SA0 X1
EQ SETUP
*
CMFL BSS 1
ECFL BSS 1
SAVEA0 BSS 1
*
END
* /--- BLOCK GETLINE 00 000 76/10/16 00.27
IDENT GETLINE
TITLE READ DATA FILE
*
*CALL DPRTX
*
EXT DISKIN
*
TITLE -GETLINE- GET NEXT DATA RECORD
*
*
* -GETLINE-
* READS NEXT DATA RECORD TO *LINE*
*
*
ENTRY GETLINE
GETLINE EQ *
SA1 NXT
SB1 X1 B1 = POINTER TO NEXT WORD
RJ ISTWORD
BX6 X1 STORE HEADER WORD
SA6 LINE
MX0 -6 MASK FOR RECORD LENGTH
AX1 6
BX1 -X0*X1 MASK OFF RECORD LENGTH
ZR X1,ENDFIL
SB2 1 INDEX IN *LINE*
SB3 X1 END TEST
*
GETLP GE B2,B3,ENDLIN
RJ NXTWORD GET NEXT WORD OF DATA
BX6 X1
SA6 B2+LINE MOVE TO *LINE* BUFFER
SB2 B2+1
SB4 B2-64
NG B4,GETLP
EQ ENDFIL
*
ENDLIN SX6 B1
SA6 NXT UPDATE WORD POINTER
EQ GETLINE
*
*
*
* -NXTWORD-
* GET NEXT WORD OF DATA RECORD
*
*
NXTWORD EQ *
SX1 B1-BLKLTH SEE IF AT END OF BUFFER
PL X1,NXTW1
SA1 B1+BUFF LOAD NEXT WORD
SB1 B1+1 ADVANCE POINTER
EQ NXTWORD
*
NXTW1 RJ NXTBLOK GET NEXT BLOCK
EQ NXTWORD
*
*
* /--- BLOCK GETLINE 00 000 77/01/20 16.30
*
* -ISTWORD-
* GET FIRST WORD OF DATA RECORD
*
ISTWORD EQ *
RJ NXTWORD GET NEXT WORD
NZ X1,ISTWORD
RJ NXTBLOK GET NEXT BLOCK
EQ ISTWORD
*
*
NXTBLOK EQ *
SX6 B2 SAVE REGISTERS
SA6 SAV1
SX6 B3
SA6 SAV2
SA1 BLOCK BLOCK CURRENTLY ON
SX7 X1+1
SA7 A1 UPDATE BLOCK COUNT
SA2 BLOCKS NUM FULL BLOCKS IN FILE
IX2 X1-X2
PL X2,ENDFIL JUMP IF END OF FULL BLOCKS
SA2 TBLKS NUM OF TOTAL BLOCKS IN FILE
IX2 X7-X2
PL X2,ENDFIL JUMP IF END-OF-FILE
SX1 BLOCK BLOCK NUMBER FOR -DISKIN-
CALL DISKIN
SB1 1 RESET WORD POINTER
SA1 SAV1
SB2 X1 RESTORE B2
SA1 SAV2
SB3 X1 RESTORE B3
SA1 BUFF LOAD NEXT WORD
EQ NXTBLOK
*
ENDFIL MX6 -1 SET END-OF-FILE FLAG
SA6 END
MX6 0
SA6 LINE CLEAR HEADER WORD
EQ GETLINE
*
*
TITLE -ISTLIN- INITIALIZATIONS
*
*
* -ISTLIN-
* INITIALIZE FOR -GETLINE-
*
*
ENTRY ISTLIN
ISTLIN EQ *
SX6 1 INITIALIZE BLOCK COUNTER
SA6 BLOCK
SA1 BLOCKS
NG X1,ISTEND
ZR X1,ISTEND
MX6 0
SA6 END INITIALIZE END-OF-FILE FLAG
SA6 NXT INITIALIZE WORD POINTER
SX1 BLOCK BLOCK NUMBER FOR -DISKIN-
CALL DISKIN
EQ ISTLIN
*
ISTEND MX6 -1 MARK END-OF-FILE
SA6 END
EQ ISTLIN
*
*
*
SAV1 BSS 1
SAV2 BSS 1
*
*
END
* /--- BLOCK DISKIN 00 000 80/02/01 00.46
IDENT DISKIN
TITLE -DISKIN-
*
*CALL DPRTX
*
EXT REQECS,OPF,CPF,READPF
*
TITLE ATTACH FILE
*
*
* -ATTACH-
* ATTACH SPECIFIED FILE
*
* ON ENTRY - X1 = ADDRESS OF FILE NAME
*
*
ENTRY ATTACH
ATTACH EQ *
SA2 X1 GET FILE NAME
BX6 X2
SA6 PFILE
CALL OPF,PFILE,READAC
NZ X1,ATTERR ERROR CHECK
EQ ATTACH
*
PFILE DATA 0 PLATO FILE NAME
DATA 0 EOL
*
ATTERR MESSAGE ATTMES,0,RECALL
MESSAGE PFILE,0,RECALL
CALL RELECS RELEASE ALL ECS
CALL DETACH
ABORT
*
TITLE DETACH PLATO FILE
*
*
* -DETACH-
* DETACH SPECIFIED FILE
*
*
ENTRY DETACH,ECSPRTY
DETACH EQ *
CALL CPF,PFILE
EQ DETACH
*
*
TITLE READ BLOCK FROM PLATO DISK FILE
*
*
* -DISKIN-
* READS SPECIFIED BLOCK FROM DISK AND TRANSFERS
* IT TO THE CM BUFFER *BUFF*
*
* ON ENTRY - X1 = ADDRESS OF BLOCK NUMBER
*
*
ENTRY DISKIN
DISKIN EQ *
CALL READPF,PFILE,X1,DISKBUF
NZ X1,DISKERR ERROR CHECK
*
SX6 A0 SAVE A0 FOR FTN
SA6 A0SAVE
SX0 DISKBUF ADDRESS OF ECS BUFFER
SA0 BUFF
+ RE BLKLTH BRING BLOCK TO CM
RJ ECSPRTY
SA1 A0SAVE RESTORE A0
SA0 X1
EQ DISKIN
*
DISKERR MESSAGE DISKMES,,RECALL
MX6 0
SA6 BUFF SET END-OF-FILE
SA6 BUFF+1
EQ DISKIN EXIT
*
ECSPRTY MESSAGE ECSMES,,RECALL
CALL RELECS RELEASE ALL ECS
CALL DETACH DETACH PLATO FILE
ABORT
*
*
ATTMES DIS ,*ATTACH ERROR*
DISKMES DIS ,$**** DISK ERROR ****$
ECSMES DIS ,$**** ECS ERROR ****$
*
A0SAVE DATA 0 FOR SAVING A0 FOR FTN
IECS VFD 60/DISKBUF
READAC DATA 4LREAD OPEN FILE WITH READ ACCESS
*
*
* OPL XTEXT COMCSYS
*
END
* /--- BLOCK ANSFORM 00 000 76/10/16 00.27
IDENT FORMAT
TITLE OUTPUT FORMATTING
*
*CALL DPRTX
*
*
TITLE -ANSFORM-
*
*
* -ANSFORM-
* FORMAT STUDENT RESPONSE AND JUDGEMENT
*
*
ENTRY ANSFORM
ANSFORM EQ *
SX1 =1H BLANK FILL *OUTBUF*
CALL FILL
SA1 LTH
SB2 X1-6 LENGTH OF STUDENT RESPONSE
SB1 B2-10
NG B1,ANSF1 JUMP IF ANSWER NOT TOO LONG
SB2 10
*
ANSF1 SB1 B0 INITIALIZE INDEX
*
AFLP GE B1,B2,ANSF2
SA1 B1+LINE+6 LOAD NEXT WORD OF ANSWER
BX6 X1
SA6 B1+OUTBUF MOVE TO OUTPUT BUFFER
SB1 B1+1
EQ AFLP
*
ANSF2 MX0 -4*6 4 CHARACTER MASK
SA2 BLANK4
NZ B1,ANSF3 CHECK FOR ZERO LTH ANSWER
SB1 1
EQ ANSF4
*
ANSF3 SA1 B1+OUTBUF-1
BX1 -X0*X1 MASK OFF BOTTOM 4 CHARS
ZR X1,ANSF4
BX0 X1-X2 SEE IF BLANK
ZR X0,ANSF4
SB1 B1+1 ADVANCE TO NEXT WORD
*
* /--- BLOCK ANSFORM 00 000 74/03/20 14.42
*
ANSF4 MX7 -6
SA1 LINE LOAD HEADER WORD
LX1 18+6 POSITION JUDGEMENT TYPE
BX1 -X7*X1
SA3 X1+JMENT-1 LOAD JUDGEMENT HOLLERITH
MX7 6
SA1 B1+OUTBUF-1 LOAD LAST WORD
SA2 =1L
SB2 60-24 INITIALIZE SHIFT COUNT
*
AFLP1 BX0 X7*X1 MASK OFF NEXT CHARACTER
ZR X0,ANSF5
BX0 X0-X2 SEE IF BLANK
ZR X0,ANSF5
SB2 B2-6
LX7 60-6 RE-POSITION MASK
LX2 60-6 RE-POSITION BLANK
EQ AFLP1
*
ANSF5 MX7 -4*6 MASK FOR 4 CHARACTERS
LX7 X7,B2 POSITION MASK
BX7 X7*X1
LX3 X3,B2 POSITION JUDGEMENT
BX7 X3+X7
SA7 A1 STORE WITH JUDGEMENT ATTACHED
EQ ANSFORM
*
*
JMENT VFD 36/0,24/4L OK
+ VFD 36/0,24/4L NO
+ VFD 36/0,24/4L NO
*
BLANK4 VFD 36/0,24/4L
*
*
* /--- BLOCK OUTFORM 00 000 76/08/21 13.19
TITLE -OUTFORM-
*
*
* -OUTFORM-
* FORMAT -OUTPUT- COMMAND DATA
*
*
ENTRY OUTFORM
OUTFORM EQ *
SX1 =1H BLANK FILL *OUTBUF*
CALL FILL
MX0 -6
SA1 LINE LOAD HEADER WORD
LX1 6
BX2 -X0*X1 MASK OFF NUMBER OF ENTRIES
ZR X2,OUTFORM
LX1 6
BX1 -X0*X1 MASK OFF LENGTH OF TABLE
SX6 X1+5 ADDRESS OF START OF DATA
SA6 IDAT
SX1 X2-21 CHECK NUMBER OF ENTRIES
NG X1,OUTF1
SX2 20 MAXIMUM OF 20 ENTRIES
*
OUTF1 SB3 X2 END TEST
MX0 -12 MASK FOR ONE TABLE ENTRY
SB1 B0 INITIALIZE INDEX
SB2 B0
*
OFLP SA1 B1+LINE+5 LOAD NEXT WORD OF TABLE
SB1 B1+1
SB4 5 5 TABLE ENTRIES/WORD
*
OFLP1 LX1 12 POSITION NEXT TABLE ENTRY
BX6 -X0*X1
SA6 B2+ITABLE
SB2 B2+1 ADVANCE TABLE INDEX
GE B2,B3,OUTF2
SB4 B4-1 SEE IF AT END OF WORD
NZ B4,OFLP1
EQ OFLP GET NEXT WORD
*
* /--- BLOCK OUTFORM 00 000 74/03/20 14.43
*
OUTF2 MX6 -1 SET TABLE END TEST
SA6 B2+ITABLE
MX6 0
SA6 TINDX INITIALIZE INDEX IN TABLE
SA6 IINDX INITIALIZE CHARACTER INDEX
*
OUTFLP SA1 TINDX CURRENT INDEX IN TABLE
SX6 X1+1
SA6 A1
MX0 -6
SA1 X1+ITABLE LOAD CURRENT TABLE ENTRY
NG X1,PACKUP
BX2 -X0*X1 MASK OFF LENGTH OF DATA
ZR X2,OUTFLP
AX1 6
BX1 -X0*X1 MASK OFF DATA TYPE (A,N,O,V)
SB1 X1
JP B1+*+1 JUMP BY DATA TYPE
*
+ EQ OFALPHA ALPHA
+ EQ OFINT INTEGER
+ EQ OFOCT OCTAL
+ EQ OFFLT FLOATING
*
*
* FORMAT ALPHA DATA
*
OFALPHA SB1 X2 SAVE LENGTH OF DATA ENTRY
*
OFALP SA1 IDAT POINTER TO NEXT WORD OF DATA
SX6 X1+1
SA6 A1
SA1 X1+LINE LOAD NEXT WORD OF DATA
ZR X1,OFALP2
MX0 6
*
OFALP1 BX2 X0*X1 MASK OFF NEXT CHARACTER
NZ X2,OFALP2
LX1 6 LEFT JUSTIFY
EQ OFALP1
*
* /--- BLOCK OUTFORM 00 000 76/08/21 12.48
*
OFALP2 CALL OPEN
SB1 B1-1 END TEST
ZR B1,OUTFLP
NG B1,OUTFLP
EQ OFALP
*
*
* FORMAT INTEGER DATA
*
OFINT SA1 IDAT POINTER TO NEXT WORD OF DATA
SX6 X1+1
SA6 A1
SX6 X1+LINE SET UP FOR CALL
SA6 ARGS
SX6 ITEMP
SA6 A6+1
SA1 ARGS
CALL ITOA CONVERT TO ALPHA
SA1 ITEMP
CALL OPEN
EQ OUTFLP
*
*
* FORMAT OCTAL DATA
*
OFOCT SA1 IDAT POINTER TO NEXT WORD OF DATA
SX6 X1+1
SA6 A1
SB1 X1+LINE SET UP FOR CALL
SB2 ITEMP
CALL OTOA CONVERT TO ALPHA
SA1 ITEMP
CALL OPEN
SA1 ITEMP1
CALL OPEN
EQ OUTFLP
*
*
* FORMAT FLOATING POINT DATA
*
OFFLT SA1 IDAT POINTER TO NEXT WORD OF DATA
SX6 X1+1
SA6 A1
SX6 X1+LINE SET UP FOR CALL
SA6 ARGS
SX6 ITEMP
SA6 A6+1
SA1 ARGS
CALL FTOA CONVERT TO ALPHA
SA1 ITEMP
CALL OPEN
EQ OUTFLP
*
* /--- BLOCK OUTFORM 00 000 74/03/20 14.45
*
PACKUP SA1 IINDX POINTER TO NEXT CHARACTER
MX6 0
SA6 X1+IOPEN END TEST
SB1 B0
SB2 B0
*
PACKLP SB3 60-6 INITIALIZE SHIFT COUNT
MX6 0
*
PACKLP1 SA1 B1+IOPEN LOAD NEXT CHARACTER
ZR X1,PACKED JUMP IF END OF STRING
SB1 B1+1
LX1 X1,B3
BX6 X1+X6 MERGE WITH WORD BUILDING
SB3 B3-6
PL B3,PACKLP1
SA6 B2+OUTBUF STORE COMPLETED WORD
SB2 B2+1
EQ PACKLP
*
PACKED SA6 B2+OUTBUF STORE LAST WORD
EQ OUTFORM
*
*
*
* -OPEN-
* OPEN NEXT WORD OF DATA (IN X1) TO *IOPEN*
*
*
OPEN EQ *
MX0 -6
SA2 IINDX CHARACTER POINTER IN *IOPEN*
*
OPLP LX1 6
BX6 -X0*X1 (X6) = NEXT CHARACTER
ZR X6,OPN1 IF NULL CHARACTER
SA6 X2+IOPEN
SX2 X2+1 INCREMENT INDEX
SX6 X2-100
PL X6,OPN2 IF BUFFER IS FULL
OPN1 BX1 X0*X1 CLEAR CHARACTER
NZ X1,OPLP IF MORE CHARACTERS
SX6 X2 UPDATE INDEX
SA6 IINDX
EQ OPEN
OPN2 SX6 X2-1 UPDATE INDEX
SA6 IINDX
EQ OPEN
*
* /--- BLOCK OTOA 00 000 76/08/13 14.57
TITLE OCTAL TO ALPHA CONVERSION
*
*
* -OTOA-
* OCTAL TO ALPHA CONVERSION
*
* ON ENTRY - B1 = ADDRESS OF WORD TO CONVERT
* B2 = WHERE TO PUT 2 WORD OUTPUT
*
*
ENTRY OTOA
OTOA EQ *
MX0 -3
SA1 B1 LOAD WORD TO CONVERT
SB3 2 END TEST - OUTPUT 2 WORDS
*
OLP1 SB1 54 INITIALIZE SHIFT COUNT
MX6 0
*
OLP2 LX1 3 POSITION NEXT OCTAL PLACE
BX2 -X0*X1
SX2 X2+1R0 CONVERT TO ALPHA
LX2 X2,B1
BX6 X2+X6 MERGE WITH REST OF WORD
SB1 B1-6
PL B1,OLP2 JUMP IF WORD NOT DONE
*
OLP3 SA6 B2 STORE COMPLETED WORD
SB3 B3-1
ZR B3,OTOA END TEST
SB2 B2+1
EQ OLP1
*
*
TITLE -VFORM-
*
*
ENTRY VFORM
VFORM EQ *
SA2 X1
BX6 X2
SA1 A1+1
SA6 X1
EQ VFORM
*
*
* /--- BLOCK FILL 00 000 76/08/21 10.12
TITLE -FILL- FILL -OUTBUF-
*
*
* -FILL-
* ON ENTRY - X1 = ADDRESS OF WORD TO FILL WITH
*
*
ENTRY FILL
FILL EQ *
SB2 10
SA2 X1 LOAD FILL WORD
BX6 X2
*
FLP SA6 B2+OUTBUF
SB2 B2-1
PL B2,FLP
EQ FILL
*
*
ITEMP BSS 2
ITEMP1 EQU ITEMP+1
*
IDAT BSS 1
IINDX BSS 1
TINDX BSS 1
ITABLE BSS 20+1 ALLOW 20 DATA ENTRIES
IOPEN BSS 100+1 ALLOW 100 CHARACTERS
ARGS BSS 2 ADDRESS OF 2 ARGUMENTS FOR A
* FTN SUBROUTINE
DATA 0 END OF ARGS FLAG
*
*
END
* /--- BLOCK BLANKFILL 00 000 76/08/21 09.47
IDENT BLFILL
TITLE ZERO TO BLANK ROUTINE
*
* -IBFILL-
*
* BLANK FILL ALL ARGUMENTS
* CALLABLE FROM FTN. CALL IBFILL(I,J,K,L,M,N)
* CONVERTS ALL 00B CHARS TO 55B
*
ENTRY IBFILL
IBFILL EQ *
SB1 1
FILLLP ZR X1,IBFILL END OF ARGUMENTS CHECK
SA5 X1 GET ARGUMENT
RJ BLFILL BLANK FILL
SA6 X1 RE-STORE BLANK FILLED VERSION
SA1 A1+1 GET ADDRESS OF NEXT ARGUMENT
EQ FILLLP GO FILL IT
*
* -IBFILLB-
*
* BLANK FILL A BUFFER (CALLABLE FROM FTN)
*
* CALL IBFILLB(BUFFER,NWORDS)
* BLANK FILLS *BUFFER* THROUGH *BUFFER+NWORDS-1*
*
ENTRY IBFILLB
IBFILLB EQ *
SB1 1
SA5 X1 GET FIRST WORD OF BUFFER
SA1 A1+1 GET ADDRESS OF NUMBER WORDS
SA1 X1 GET NUMBER WORDS
FILLBLP RJ BLFILL BLANK FILL WORD
SA6 A5 RE-STORE
SX1 X1-1 DECREMENT WORD COUNTER
ZR X1,IBFILLB ALL FILLED, ---RETURN
SA5 A5+1 GET NEXT WORD
EQ FILLBLP
*
* ENTRY X5 = 10 CHARACTER WORD
* EXIT X6 = SAME THING WITH 6/55B IN PLACE OF 6/0.
*
BLFILL PS
SA2 =40404040404040404040B
BX3 -X5
LX4 B1,X3
BX3 X3*X4
LX4 1
BX3 X3*X4
BX4 X3
LX4 3
BX3 X3*X4
BX3 X3*X2
BX4 X3
LX4 -2
BX3 X3+X4
BX4 X3
LX4 -3
BX3 X3+X4
BX6 X5+X3
EQ BLFILL
*
END
* /--- BLOCK FINDEOL 00 000 77/07/03 00.36
IDENT FINDEOL
TITLE FIND END OF LINE
*
*CALL DPRTX
*
*
ENTRY FINDEOL
*
* FIND END OF TEXT LINE
* (FTN CALLABLE)
* ON ENTRY - A1 = ADDRESS OF ARGUMENT ADDRESSES
* 1ST ARGUMENT = STARTING WORD NUMBER (INDEX
* INTO ARRAY *LINE*)
*
* ON EXIT - 2ND ARGUMENT = END WORD NUMBER (INDEX)
*
FINDEOL PS
MX0 -12 MASK FOR E-O-L TEST
SB7 1 FOR INCREMENT
SA2 X1 STARTING INDEX IN X1
SA2 X2+LINDEX-1
*
GLOOP SA2 A2+B7 GET NEXT WORD
BX2 -X0*X2 LOOK AT BOTTOM 12 BITS
NZ X2,GLOOP LOOK SOME MORE IF NON-ZERO
*
SX6 A2
SX7 LINDEX
IX6 X6-X7 CONVERT TO FORTRAN INDEX
SA1 A1+1 GET ADDRESS OF ARGUMENT
SA6 X1 STORE IN RETURN LOCATION
EQ FINDEOL AND RETURN
*
LINDEX EQU LINE-1
*
END