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